begin








definition
  mode set;
end;

definition let x,y be set;
  pred x = y;
  reflexivity;
  symmetry;
end;

notation let x,y be set;
  antonym x <> y for x = y;
end;

definition let x,X be set;
  pred x in X;
  asymmetry;
end;















begin

 reserve x,y,z,u,N,M,X,Y,Z for set;

theorem 
 (for x holds x in X iff x in Y) implies X = Y;

 definition let y; func { y } -> set means

  x in it iff x = y;
  let z; func { y, z } -> set means

   x in it iff x = y or x = z;
   commutativity;
 end;

 definition let X,Y;
  pred X c= Y means

   x in X implies x in Y;
  reflexivity;
 end;

 definition let X;
   func union X -> set means

    x in it iff ex Y st x in Y & Y in X;
 end;

theorem 
 x in X implies ex Y st Y in X & not ex x st x in X & x in Y;

 scheme 
 Fraenkel { A()-> set, P[set, set] }:
  ex X st for x holds x in X iff ex y st y in A() & P[y,x]
  provided for x,y,z st P[x,y] & P[x,z] holds y = z;

  definition let x,y;
  func [x,y] equals

   { { x,y }, { x } };
 end;

 definition let X,Y;
  pred X,Y are_equipotent means

    ex Z st
       (for x st x in X ex y st y in Y & [x,y] in Z) &
       (for y st y in Y ex x st x in X & [x,y] in Z) &
        for x,y,z,u st [x,y] in Z & [z,u] in Z holds x = z iff y = u;
 end;

























theorem 
  ex M st N in M &
     (for X,Y holds X in M & Y c= X implies Y in M) &
     (for X st X in M ex Z st Z in M & for Y st Y c= X holds Y in Z) &
     (for X holds X c= M implies X,M are_equipotent or X in M);














begin

reserve X, Y, Z, x, y, z for set;

scheme 

  Separation { A()-> set, P[set] } :
  ex X being set st for x being set holds x in X iff x in A() & P[x];

definition
  let X be set;
  attr X is empty means


  not ex x being set st x in X;
end;

registration
  cluster empty for set;
end;

definition
  func {} -> set equals

  the empty set;
  let X,Y be set;
  func X \/ Y -> set means


  x in it iff x in X or x in Y;
  commutativity;
  idempotence;
  func X /\ Y -> set means


  x in it iff x in X & x in Y;
  commutativity;
  idempotence;
  func X \ Y -> set means


  x in it iff x in X & not x in Y;
end;

definition
  let X, Y be set;
  func X \+\ Y -> set equals

  (X \ Y) \/ (Y \ X);
  commutativity;
  pred X misses Y means


  X /\ Y = {};
  symmetry;
  pred X c< Y means


  X c= Y & X <> Y;
  irreflexivity;
  asymmetry;
  pred X,Y are_c=-comparable means

  X c= Y or Y c= X;
  reflexivity;
  symmetry;
  redefine pred X = Y means

  X c= Y & Y c= X;
end;

notation
  let X, Y be set;
  antonym X meets Y for X misses Y;
end;

theorem 
  x in X \+\ Y iff not (x in X iff x in Y);

theorem 
  (for x holds not x in X iff (x in Y iff x in Z)) implies X = Y \+\ Z;

registration
  cluster {} -> empty;
end;

registration
  let x1 be set;
  cluster { x1 } -> non empty;
  let x2 be set;
  cluster { x1, x2 } -> non empty;
end;

registration
  cluster non empty for set;
end;

registration
  let D be non empty set, X be set;
  cluster D \/ X -> non empty;
  cluster X \/ D -> non empty;
end;

theorem 
  X meets Y iff ex x st x in X & x in Y;

theorem 
  X meets Y iff ex x st x in X /\ Y;

theorem 
  X misses Y & x in X \/ Y implies x in X & not x in Y or x in Y & not x in X;

scheme 

  Extensionality { X,Y() -> set, P[set] } : X() = Y()
provided
 for x holds x in X() iff P[x] and
 for x holds x in Y() iff P[x];

scheme 

  SetEq { P[set] } :
  for X1,X2 being set st
    (for x being set holds x in X1 iff P[x]) &
    (for x being set holds x in X2 iff P[x]) holds X1 = X2;

begin 


theorem 
  X c< Y implies ex x st x in Y & not x in X;



theorem 
  X <> {} implies ex x st x in X;














begin








theorem 
  for X being set holds X \/ {} = X;

theorem 
  for X being set holds X /\ {} = {};

theorem 
  for X being set holds X \ {} = X;

theorem 
  for X being set holds {} \ X = {};

theorem 
  for X being set holds X \+\ {} = X;

reserve x,X for set;

theorem 
  for X being set st X is empty holds X = {};

theorem 
  for x, X being set st x in X holds X is non empty;

theorem 
  for X, Y being set st X is empty & X <> Y holds Y is non empty;
 



















begin

reserve x,A,B,X,X9,Y,Y9,Z,V for set;


theorem 
  X c= Y & Y c= Z implies X c= Z;

theorem 
  {} c= X;

theorem 
  X c= {} implies X = {};

theorem 
  (X \/ Y) \/ Z = X \/ (Y \/ Z);

theorem 
  (X \/ Y) \/ Z = (X \/ Z) \/ (Y \/ Z);

theorem 
  X \/ (X \/ Y) = X \/ Y;

theorem 
  X c= X \/ Y;

theorem 
  X c= Z & Y c= Z implies X \/ Y c= Z;

theorem 
  X c= Y implies X \/ Z c= Y \/ Z;

theorem 
  X c= Y implies X c= Z \/ Y;

theorem 
  X \/ Y c= Z implies X c= Z;

theorem 
  X c= Y implies X \/ Y = Y;

theorem 
  X c= Y & Z c= V implies X \/ Z c= Y \/ V;

theorem 
  (Y c= X & Z c= X & for V st Y c= V & Z c= V holds X c= V) implies X = Y \/ Z;

theorem 
  X \/ Y = {} implies X = {};

theorem 
  (X /\ Y) /\ Z = X /\ (Y /\ Z);

theorem 
  X /\ Y c= X;

theorem 
  X c= Y /\ Z implies X c= Y;

theorem 
  Z c= X & Z c= Y implies Z c= X /\ Y;

theorem 
  (X c= Y & X c= Z & for V st V c= Y & V c= Z holds V c= X) implies X = Y /\ Z;

theorem 
  X /\ (X \/ Y) = X;

theorem 
  X \/ (X /\ Y) = X;

theorem 
  X /\ (Y \/ Z) = X /\ Y \/ X /\ Z;

theorem 
  X \/ Y /\ Z = (X \/ Y) /\ (X \/ Z);

theorem 
  (X /\ Y) \/ (Y /\ Z) \/ (Z /\ X) = (X \/ Y) /\ (Y \/ Z) /\ (Z \/ X);

theorem 
  X c= Y implies X /\ Z c= Y /\ Z;

theorem 
  X c= Y & Z c= V implies X /\ Z c= Y /\ V;

theorem 
  X c= Y implies X /\ Y = X;

theorem 
  X /\ Y c= X \/ Z;

theorem 
  X c= Z implies X \/ Y /\ Z = (X \/ Y) /\ Z;

theorem 
  (X /\ Y) \/ (X /\ Z) c= Y \/ Z;

theorem 
  X \ Y = Y \ X implies X = Y;

theorem 
  X c= Y implies X \ Z c= Y \ Z;

theorem 
  X c= Y implies Z \ Y c= Z \ X;

theorem 
  X c= Y & Z c= V implies X \ V c= Y \ Z;

theorem 
  X \ Y c= X;

theorem 
  X \ Y = {} iff X c= Y;

theorem 
  X c= Y \ X implies X = {};

theorem 
  X \/ (Y \ X) = X \/ Y;

theorem 
  (X \/ Y) \ Y = X \ Y;

theorem 
  (X \ Y) \ Z = X \ (Y \/ Z);

theorem 
  (X \/ Y) \ Z = (X \ Z) \/ (Y \ Z);

theorem 
  X c= Y \/ Z implies X \ Y c= Z;

theorem 
  X \ Y c= Z implies X c= Y \/ Z;

theorem 
  X c= Y implies Y = X \/ (Y \ X);

theorem 
  X \ (X \/ Y) = {};

theorem 
  X \ X /\ Y = X \ Y;

theorem 
  X \ (X \ Y) = X /\ Y;

theorem 
  X /\ (Y \ Z) = (X /\ Y) \ Z;

theorem 
  X /\ (Y \ Z) = X /\ Y \ X /\ Z;

theorem 
  X /\ Y \/ (X \ Y) = X;

theorem 
  X \ (Y \ Z) = (X \ Y) \/ X /\ Z;

theorem 
  X \ (Y \/ Z) = (X \ Y) /\ (X \ Z);

theorem 
  X \ (Y /\ Z) = (X \ Y) \/ (X \ Z);

theorem 
  (X \/ Y) \ (X /\ Y) = (X \ Y) \/ (Y \ X);

theorem 
  X c< Y & Y c< Z implies X c< Z;

theorem 
  not (X c< Y & Y c< X);

theorem 
  X c< Y & Y c= Z implies X c< Z;

theorem 
  X c= Y & Y c< Z implies X c< Z;

theorem 
  X c= Y implies not Y c< X;

theorem 
  X <> {} implies {} c< X;

theorem 
  not X c< {};



theorem 
  X c= Y & Y misses Z implies X misses Z;

theorem 
  A c= X & B c= Y & X misses Y implies A misses B;

theorem 
  X misses {};

theorem 
  X meets X iff X <> {};

theorem 
  X c= Y & X c= Z & Y misses Z implies X = {};


theorem 
  for A being non empty set st A c= Y & A c= Z holds Y meets Z;

theorem 
  for A being non empty set st A c= Y holds A meets Y;

theorem 
  X meets Y \/ Z iff X meets Y or X meets Z;

theorem 
  X \/ Y = Z \/ Y & X misses Y & Z misses Y implies X = Z;

theorem 
  X9 \/ Y9 = X \/ Y & X misses X9 & Y misses Y9 implies X = Y9;

theorem 
  X c= Y \/ Z & X misses Z implies X c= Y;

theorem 
  X meets Y /\ Z implies X meets Y;

theorem 
  X meets Y implies X /\ Y meets Y;

theorem 
  Y misses Z implies X /\ Y misses X /\ Z;

theorem 
  X meets Y & X c= Z implies X meets Y /\ Z;

theorem 
  X misses Y implies X /\ (Y \/ Z) = X /\ Z;

theorem 
  X \ Y misses Y;

theorem 
  X misses Y implies X misses Y \ Z;

theorem 
  X misses Y \ Z implies Y misses X \ Z;

theorem 
  X \ Y misses Y \ X;

theorem 
  X misses Y iff X \ Y = X;

theorem 
  X meets Y & X misses Z implies X meets Y \ Z;

theorem 
  X c= Y implies X misses Z \ Y;

theorem 
  X c= Y & X misses Z implies X c= Y \ Z;

theorem 
  Y misses Z implies (X \ Y) \/ Z = (X \/ Z) \ Y;

theorem 
  X misses Y implies (X \/ Y) \ Y = X;

theorem 
  X /\ Y misses X \ Y;

theorem 
  X \ (X /\ Y) misses Y;

theorem 
  (X \+\ Y) \+\ Z = X \+\ (Y \+\ Z);

theorem 
  X \+\ X = {};

theorem 
  X \/ Y = (X \+\ Y) \/ X /\ Y;

theorem 
  X \/ Y = X \+\ Y \+\ X /\ Y;

theorem 
  X /\ Y = X \+\ Y \+\ (X \/ Y);

theorem 
  X \ Y c= X \+\ Y;

theorem 
  X \ Y c= Z & Y \ X c= Z implies X \+\ Y c= Z;

theorem 
  X \/ Y = X \+\ (Y \ X);

theorem 
  (X \+\ Y) \ Z = (X \ (Y \/ Z)) \/ (Y \ (X \/ Z));

theorem 
  X \ Y = X \+\ (X /\ Y);

theorem 
  X \+\ Y = (X \/ Y) \ X /\ Y;

theorem 
  X \ (Y \+\ Z) = X \ (Y \/ Z) \/ X /\ Y /\ Z;

theorem 
  X /\ Y misses X \+\ Y;

theorem 
  X c< Y or X = Y or Y c< X iff X,Y are_c=-comparable;

begin 

theorem 
  for X, Y being set st X c< Y holds Y \ X <> {};

theorem 
  X c= A \ B implies X c= A & X misses B;

theorem 
  X c= A \+\ B iff X c= A \/ B & X misses A /\ B;

theorem 
  X c= A implies X /\ Y c= A;

theorem 
  X c= A implies X \ Y c= A;

theorem 
  X c= A & Y c= A implies X \+\ Y c= A;

theorem 
  (X /\ Z) \ (Y /\ Z) = (X \ Y) /\ Z;

theorem 
  (X /\ Z) \+\ (Y /\ Z) = (X \+\ Y) /\ Z;

theorem 
  X \/ Y \/ Z \/ V = X \/ (Y \/ Z \/ V);

theorem 
  for A,B,C,D being set st A misses D & B misses D & C misses D holds A
  \/ B \/ C misses D;

theorem 
  not A c< {};

theorem 
  X /\ (Y /\ Z) = (X /\ Y) /\ (X /\ Z);

theorem 
  for P,G,C being set st C c= G holds P \ C = (P \ G) \/ (P /\ (G \ C));














begin

reserve x,x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,y,X,Z for set;

definition
  let x1,x2,x3;
  func { x1,x2,x3 } -> set means


  x in it iff x=x1 or x=x2 or x=x3;
end;

definition
  let x1,x2,x3,x4;
  func { x1,x2,x3,x4 } -> set means


  x in it iff x=x1 or x=x2 or x=x3 or x=x4;
end;

definition
  let x1,x2,x3,x4,x5;
  func { x1,x2,x3,x4,x5 } -> set means


  x in it iff x=x1 or x=x2 or x=x3 or x=x4 or x=x5;
end;

definition
  let x1,x2,x3,x4,x5,x6;
  func { x1,x2,x3,x4,x5,x6 } -> set means


  x in it iff x=x1 or x=x2 or x =x3 or x=x4 or x=x5 or x=x6;
end;

definition
  let x1,x2,x3,x4,x5,x6,x7;
  func { x1,x2,x3,x4,x5,x6,x7 } -> set means


  x in it iff x=x1 or x=x2 or x=x3 or x=x4 or x=x5 or x=x6 or x=x7;
end;

definition
  let x1,x2,x3,x4,x5,x6,x7,x8;
  func { x1,x2,x3,x4,x5,x6,x7,x8 } -> set means


  x in it iff x=x1 or x= x2 or x=x3 or x=x4 or x=x5 or x=x6 or x=x7 or x=x8;
end;

definition
  let x1,x2,x3,x4,x5,x6,x7,x8,x9;
  func { x1,x2,x3,x4,x5,x6,x7,x8,x9 } -> set means


  x in it iff x=x1 or
  x=x2 or x=x3 or x=x4 or x=x5 or x=x6 or x=x7 or x=x8 or x=x9;
end;

definition
  let x1,x2,x3,x4,x5,x6,x7,x8,x9,x10;
  func { x1,x2,x3,x4,x5,x6,x7,x8,x9,x10 } -> set means


  x in it iff x=x1
  or x=x2 or x=x3 or x=x4 or x=x5 or x=x6 or x=x7 or x=x8 or x=x9 or x=x10;
end;

theorem 
  { x1,x2 } = { x1 } \/ { x2 };

theorem 
  { x1,x2,x3 } = { x1 } \/ { x2,x3 };

theorem 
  { x1,x2,x3 } = { x1,x2 } \/ { x3 };

theorem 
  { x1,x2,x3,x4 } = { x1 } \/ { x2,x3,x4 };

theorem 
  { x1,x2,x3,x4 } = { x1,x2 } \/ { x3,x4 };

theorem 
  { x1,x2,x3,x4 } = { x1,x2,x3 } \/ { x4 };

theorem 
  { x1,x2,x3,x4,x5 } = { x1 } \/ { x2,x3,x4,x5 };

theorem 
  { x1,x2,x3,x4,x5 } = { x1,x2 } \/ { x3,x4,x5 };

theorem 
  { x1,x2,x3,x4,x5 } = { x1,x2,x3 } \/ { x4,x5 };

theorem 
  { x1,x2,x3,x4,x5 } = { x1,x2,x3,x4 } \/ { x5 };

theorem 
  { x1,x2,x3,x4,x5,x6 } = { x1 } \/ { x2,x3,x4,x5,x6 };

theorem 
  { x1,x2,x3,x4,x5,x6 } = { x1,x2 } \/ { x3,x4,x5,x6 };

theorem 
  { x1,x2,x3,x4,x5,x6 } = { x1,x2,x3 } \/ { x4,x5,x6 };

theorem 
  { x1,x2,x3,x4,x5,x6 } = { x1,x2,x3,x4 } \/ { x5,x6 };

theorem 
  { x1,x2,x3,x4,x5,x6 } = { x1,x2,x3,x4,x5 } \/ { x6 };

theorem 
  { x1,x2,x3,x4,x5,x6,x7 } = { x1 } \/ { x2,x3,x4,x5,x6,x7 };

theorem 
  { x1,x2,x3,x4,x5,x6,x7 } = { x1,x2 } \/ { x3,x4,x5,x6,x7 };

theorem 
  { x1,x2,x3,x4,x5,x6,x7 } = { x1,x2,x3 } \/ { x4,x5,x6,x7 };

theorem 
  { x1,x2,x3,x4,x5,x6,x7 } = { x1,x2,x3,x4 } \/ { x5,x6,x7 };

theorem 
  { x1,x2,x3,x4,x5,x6,x7 } = { x1,x2,x3,x4,x5 } \/ { x6,x7 };

theorem 
  { x1,x2,x3,x4,x5,x6,x7 } = { x1,x2,x3,x4,x5,x6 } \/ { x7 };

theorem 
  { x1,x2,x3,x4,x5,x6,x7,x8 } = { x1 } \/ { x2,x3,x4,x5,x6,x7,x8 };

theorem 
  { x1,x2,x3,x4,x5,x6,x7,x8 } = { x1,x2 } \/ { x3,x4,x5,x6,x7,x8 };

theorem 
  { x1,x2,x3,x4,x5,x6,x7,x8 } = { x1,x2,x3 } \/ { x4,x5,x6,x7,x8 };

theorem 
  { x1,x2,x3,x4,x5,x6,x7,x8 } = { x1,x2,x3,x4 } \/ { x5,x6,x7,x8 };

theorem 
  { x1,x2,x3,x4,x5,x6,x7,x8 } = { x1,x2,x3,x4,x5 } \/ { x6,x7,x8 };

theorem 
  { x1,x2,x3,x4,x5,x6,x7,x8 } = { x1,x2,x3,x4,x5,x6 } \/ { x7,x8 };

theorem 
  { x1,x2,x3,x4,x5,x6,x7,x8 } = { x1,x2,x3,x4,x5,x6,x7 } \/ { x8 };

theorem 
  { x1,x1 } = { x1 };

theorem 
  { x1,x1,x2 } = { x1,x2 };

theorem 
  { x1,x1,x2,x3 } = { x1,x2,x3 };

theorem 
  { x1,x1,x2,x3,x4 } = { x1,x2,x3,x4 };

theorem 
  { x1,x1,x2,x3,x4,x5 } = { x1,x2,x3,x4,x5 };

theorem 
  { x1,x1,x2,x3,x4,x5,x6 } = { x1,x2,x3,x4,x5,x6 };

theorem 
  { x1,x1,x2,x3,x4,x5,x6,x7 } = { x1,x2,x3,x4,x5,x6,x7 };

theorem 
  { x1,x1,x1 } = { x1 };

theorem 
  { x1,x1,x1,x2 } = { x1,x2 };

theorem 
  { x1,x1,x1,x2,x3 } = { x1,x2,x3 };

theorem 
  { x1,x1,x1,x2,x3,x4 } = { x1,x2,x3,x4 };

theorem 
  { x1,x1,x1,x2,x3,x4,x5 } = { x1,x2,x3,x4,x5 };

theorem 
  { x1,x1,x1,x2,x3,x4,x5,x6 } = { x1,x2,x3,x4,x5,x6 };

theorem 
  { x1,x1,x1,x1 } = { x1 };

theorem 
  { x1,x1,x1,x1,x2 } = { x1,x2 };

theorem 
  { x1,x1,x1,x1,x2,x3 } = { x1,x2,x3 };

theorem 
  { x1,x1,x1,x1,x2,x3,x4 } = { x1,x2,x3,x4 };

theorem 
  { x1,x1,x1,x1,x2,x3,x4,x5 } = { x1,x2,x3,x4,x5 };

theorem 
  { x1,x1,x1,x1,x1 } = { x1 };

theorem 
  { x1,x1,x1,x1,x1,x2 } = { x1,x2 };

theorem 
  { x1,x1,x1,x1,x1,x2,x3 } = { x1,x2,x3 };

theorem 
  { x1,x1,x1,x1,x1,x2,x3,x4 } = { x1,x2,x3,x4 };

theorem 
  { x1,x1,x1,x1,x1,x1 } = { x1 };

theorem 
  { x1,x1,x1,x1,x1,x1,x2 } = { x1,x2 };

theorem 
  { x1,x1,x1,x1,x1,x1,x2,x3 } = { x1,x2,x3 };

theorem 
  { x1,x1,x1,x1,x1,x1,x1 } = { x1 };

theorem 
  { x1,x1,x1,x1,x1,x1,x1,x2 } = { x1,x2 };

theorem 
  { x1,x1,x1,x1,x1,x1,x1,x1 } = { x1 };

theorem 
  { x1,x2,x3 } = { x1,x3,x2 };

theorem 
  { x1,x2,x3 } = { x2,x1,x3 };

theorem 
  { x1,x2,x3 } = { x2,x3,x1 };

theorem 
  { x1,x2,x3 } = { x3,x2,x1 };

theorem 
  { x1,x2,x3,x4 } = { x1,x2,x4,x3 };

theorem 
  { x1,x2,x3,x4 } = { x1,x3,x2,x4 };

theorem 
  { x1,x2,x3,x4 } = { x1,x3,x4,x2 };

theorem 
  { x1,x2,x3,x4 } = { x1,x4,x3,x2 };

theorem 
  { x1,x2,x3,x4 } = { x2,x1,x3,x4 };

theorem 
  { x1,x2,x3,x4 } = { x2,x1,x4,x3 };

theorem 
  { x1,x2,x3,x4 } = { x2,x3,x1,x4 };

theorem 
  { x1,x2,x3,x4 } = { x2,x3,x4,x1 };

theorem 
  { x1,x2,x3,x4 } = { x2,x4,x1,x3 };

theorem 
  { x1,x2,x3,x4 } = { x2,x4,x3,x1 };

theorem 
  { x1,x2,x3,x4 } = { x3,x2,x1,x4 };

theorem 
  { x1,x2,x3,x4 } = { x3,x2,x4,x1 };

theorem 
  { x1,x2,x3,x4 } = { x3,x4,x1,x2 };

theorem 
  { x1,x2,x3,x4 } = { x3,x4,x2,x1 };

theorem 
  { x1,x2,x3,x4 } = { x4,x2,x3,x1 };

theorem 
  { x1,x2,x3,x4 } = { x4,x3,x2,x1 };

theorem 
  { x1,x2,x3,x4,x5,x6,x7,x8,x9 } = { x1 } \/ { x2,x3,x4,x5,x6,x7,x8,x9 };

theorem 
  { x1,x2,x3,x4,x5,x6,x7,x8,x9 } = { x1,x2 } \/ { x3,x4,x5,x6,x7,x8,x9 };

theorem 
  { x1,x2,x3,x4,x5,x6,x7,x8,x9 } = { x1,x2,x3 } \/ { x4,x5,x6,x7,x8,x9 };

theorem 
  { x1,x2,x3,x4,x5,x6,x7,x8,x9 } = { x1,x2,x3,x4 } \/ { x5,x6,x7,x8,x9 };

theorem 
  { x1,x2,x3,x4,x5,x6,x7,x8,x9 } = { x1,x2,x3,x4,x5 } \/ { x6,x7,x8,x9 };

theorem 
  { x1,x2,x3,x4,x5,x6,x7,x8,x9 } = { x1,x2,x3,x4,x5,x6 } \/ { x7,x8,x9 };

theorem 
  { x1,x2,x3,x4,x5,x6,x7,x8,x9 } = { x1,x2,x3,x4,x5,x6,x7 } \/ { x8,x9 };

theorem 
  { x1,x2,x3,x4,x5,x6,x7,x8,x9 } = { x1,x2,x3,x4,x5,x6,x7,x8 } \/ { x9 };

theorem 
  { x1,x2,x3,x4,x5,x6,x7,x8,x9,x10 } = { x1,x2,x3,x4,x5,x6,x7,x8,x9 } \/
  { x10 };

begin 

theorem 
  for x, y, z being set st x <> y & x <> z holds {x, y, z} \ {x} = {y, z };



theorem 
  for x1,x2,x3 being set holds {x2,x1} \/ {x3,x1} = {x1,x2,x3};














begin 

reserve x,x1,x2,x3,x4,y,y1,y2,y3,y4,z,z1,z2,z2,z4 for set;

definition let x;
 attr x is pair means

 ex x1,x2 st x = [x1,x2];
end;

registration let x1,x2;
 cluster [x1,x2] -> pair;
end;

reserve X,Y for set;

theorem 
  [x1,x2] = [y1,y2] implies x1 = y1 & x2 = y2;

definition
  let x;
  assume x is pair;
  func x`1 means

 x = [y1,y2] implies it = y1;
  func x`2 means

 x = [y1,y2] implies it = y2;
end;

registration let x1,x2;
 reduce [x1,x2]`1 to x1;
 reduce [x1,x2]`2 to x2;
end;

registration
 cluster pair for set;
end;

registration let x be pair set;
 reduce [x`1,x`2] to x;
end;

theorem 
 for a,b being pair set st a`1 = b`1 & a`2 = b`2
  holds a = b;

begin 

definition
  let x1,x2,x3;
  func [x1,x2,x3] equals

  [[x1,x2],x3];
end;

definition let x;
 attr x is triple means

 ex x1,x2,x3 st x = [x1,x2,x3];
end;

registration let x1,x2,x3;
 cluster [x1,x2,x3] -> triple;
end;

theorem 
  [x1,x2,x3] = [y1,y2,y3] implies x1 = y1 & x2 = y2 & x3 = y3;

registration
 cluster triple for set;
 cluster triple -> pair for set;
end;

definition
  let x be set;
  func x`1_3 equals

x`1`1;
  func x`2_3 equals

x`1`2;
end;

notation
 let x be set;
 synonym x`3_3 for x`2;
end;

registration let x1,x2,x3;
 reduce [x1,x2,x3]`1_3 to x1;
 reduce [x1,x2,x3]`2_3 to x2;
 reduce [x1,x2,x3]`3_3 to x3;
end;

registration let x be triple set;
 reduce [x`1_3,x`2_3,x`3_3] to x;
end;

theorem 
 for a,b being triple set st a`1_3 = b`1_3 & a`2_3 = b`2_3 & a`3_3 = b`3_3
  holds a = b;

begin 

definition
  let x1,x2,x3,x4;
  func [x1,x2,x3,x4] equals

  [[x1,x2,x3],x4];
end;

definition let x;
 attr x is quadruple means

 ex x1,x2,x3,x4 st x = [x1,x2,x3,x4];
end;

registration let x1,x2,x3,x4;
 cluster [x1,x2,x3,x4] -> quadruple;
end;

theorem 
 [x1,x2,x3,x4] = [y1,y2,y3,y4]
   implies x1 = y1 & x2 = y2 & x3 = y3 & x4 = y4;

registration
 cluster quadruple for set;
 cluster quadruple -> triple for set;
end;

definition
 let x be set;
  func x`1_4 equals

x`1`1`1;
  func x`2_4 equals

x`1`1`2;
end;

notation let x be set;
 synonym x`3_4 for x`2_3;
 synonym x`4_4 for x`2;
end;

registration let x1,x2,x3,x4;
 reduce [x1,x2,x3,x4]`1_4 to x1;
 reduce [x1,x2,x3,x4]`2_4 to x2;
 reduce [x1,x2,x3,x4]`3_4 to x3;
 reduce [x1,x2,x3,x4]`4_4 to x4;
end;

registration let x be quadruple set;
 reduce [x`1_4,x`2_4,x`3_4,x`4_4] to x;
end;

reserve X,X1,X2,X3,X4,Y for set;



theorem 
 [x,y] in X implies x in union union X;

theorem 
 [x,y] in X implies y in union union X;



definition
  let X be set;
  func proj1 X -> set means


  x in it iff ex y st [x,y] in X;
  func proj2 X -> set means


  x in it iff ex y st [y,x] in X;
end;

theorem 
 X c= Y implies proj1 X c= proj1 Y;

theorem 
 X c= Y implies proj2 X c= proj2 Y;

definition
  let X be set;
  func proj1_3 X -> set equals

   proj1 proj1 X;
  func proj2_3 X -> set equals

   proj2 proj1 X;
end;

notation let X be set;
 synonym proj3_3 X for proj2 X;
end;

theorem 
 X c= Y implies proj1_3 X c= proj1_3 Y;

theorem 
 X c= Y implies proj2_3 X c= proj2_3 Y;

theorem 
 x in proj1_3 X implies ex y,z st [x,y,z] in X;

theorem 
 [x,y,z] in X implies x in proj1_3 X;

theorem 
 x in proj2_3 X implies ex y,z st [y,x,z] in X;

theorem 
 [x,y,z] in X implies y in proj2_3 X;

definition
  let X be set;
func proj1_4 X -> set equals

   proj1 proj1_3 X;
  func proj2_4 X -> set equals

   proj2 proj1_3 X;
end;

notation let X be set;
  synonym proj3_4 X for proj2_3 X;
  synonym proj4_4 X for proj2 X;
end;

theorem 
 X c= Y implies proj1_4 X c= proj1_4 Y;

theorem 
 X c= Y implies proj2_4 X c= proj2_4 Y;

theorem 
 x in proj1_4 X implies ex x1,x2,x3 st [x,x1,x2,x3] in X;

theorem 
 [x,x1,x2,x3] in X implies x in proj1_4 X;

theorem 
 x in proj2_4 X implies ex x1,x2,x3 st [x1,x,x2,x3] in X;

theorem 
 [x1,x,x2,x3] in X implies x in proj2_4 X;

theorem 
 for a,b being quadruple set
  st a`1_4 = b`1_4 & a`2_4 = b`2_4 & a`3_4 = b`3_4 & a`4_4 = b`4_4
  holds a = b;

begin 

registration let X be empty set;
 cluster proj1 X -> empty;
end;

registration let X be empty set;
 cluster proj2 X -> empty;
end;

registration let X be empty set;
 cluster proj1_3 X -> empty;
end;

registration let X be empty set;
 cluster proj2_3 X -> empty;
end;

registration let X be empty set;
 cluster proj1_4 X -> empty;
end;

registration let X be empty set;
 cluster proj2_4 X -> empty;
end;

theorem 
 proj1(X \/ Y) = proj1 X \/ proj1 Y;

theorem 
  proj1(X /\ Y) c= proj1 X /\ proj1 Y;

theorem 
  proj1 X \ proj1 Y c= proj1(X \ Y);

theorem 
  proj1 X \+\ proj1 Y c= proj1(X \+\ Y);

theorem 
 proj2(X \/ Y) = proj2 X \/ proj2 Y;

theorem 
  proj2(X /\ Y) c= proj2 X /\ proj2 Y;

theorem 
  proj2 X \ proj2 Y c= proj2(X \ Y);

theorem 
   proj2 X \+\ proj2 Y c= proj2(X \+\ Y);

theorem 
 proj1_3(X \/ Y) = proj1_3 X \/ proj1_3 Y;

theorem 
  proj1_3(X /\ Y) c= proj1_3 X /\ proj1_3 Y;

theorem 
  proj1_3 X \ proj1_3 Y c= proj1_3(X \ Y);

theorem 
  proj1_3 X \+\ proj1_3 Y c= proj1_3(X \+\ Y);

theorem 
 proj2_3(X \/ Y) = proj2_3 X \/ proj2_3 Y;

theorem 
  proj2_3(X /\ Y) c= proj2_3 X /\ proj2_3 Y;

theorem 
  proj2_3 X \ proj2_3 Y c= proj2_3(X \ Y);

theorem 
  proj2_3 X \+\ proj2_3 Y c= proj2_3(X \+\ Y);

theorem 
 proj1_4(X \/ Y) = proj1_4 X \/ proj1_4 Y;

theorem 
  proj1_4(X /\ Y) c= proj1_4 X /\ proj1_4 Y;

theorem 
  proj1_4 X \ proj1_4 Y c= proj1_4(X \ Y);

theorem 
  proj1_4 X \+\ proj1_4 Y c= proj1_4(X \+\ Y);

theorem 
 proj2_4(X \/ Y) = proj2_4 X \/ proj2_4 Y;

theorem 
  proj2_4(X /\ Y) c= proj2_4 X /\ proj2_4 Y;

theorem 
  proj2_4 X \ proj2_4 Y c= proj2_4(X \ Y);

theorem 
  proj2_4 X \+\ proj2_4 Y c= proj2_4(X \+\ Y);














begin

 reserve x,y,X1,X2,X3,X4,X5,X6,Y,Y1,Y2,Y3,Y4,Y5,Z,Z1,Z2,Z3,Z4,Z5 for set;
 reserve X for non empty set;




theorem 
  ex Y st Y in X & Y misses X;

theorem 
  ex Y st Y in X & for Y1 st Y1 in Y holds Y1 misses X;

theorem 
  ex Y st Y in X & for Y1,Y2 st Y1 in Y2 & Y2 in Y holds Y1 misses X;

theorem 
  ex Y st Y in X &
   for Y1,Y2,Y3 st Y1 in Y2 & Y2 in Y3 & Y3 in Y holds Y1 misses X;

theorem 
  ex Y st Y in X &
   for Y1,Y2,Y3,Y4 st Y1 in Y2 & Y2 in  Y3 & Y3 in Y4 & Y4 in Y
    holds Y1 misses X;

theorem 
  ex Y st Y in X &
   for Y1,Y2,Y3,Y4,Y5 st Y1 in Y2 &  Y2 in Y3 & Y3 in Y4 & Y4 in Y5 & Y5 in Y
    holds Y1 misses X;




theorem 
  not ( X1 in X2 & X2 in X3 & X3 in X1);

theorem 
  not ( X1 in X2 & X2 in X3 & X3 in X4 & X4 in X1);

theorem 
  not ( X1 in X2 & X2 in X3 & X3 in X4 & X4 in X5 & X5 in X1);

theorem 
  not ( X1 in X2 & X2 in X3 & X3 in X4 & X4 in X5 & X5 in X6 & X6 in X1);














begin

reserve v,x,x1,x2,y,y1,y2,z,A,B,X,X1,X2,X3,X4,Y,Y1,Y2,Z,N,M for set;

registration
  let x, y be set;
  cluster [x,y] -> non empty;
end;

definition
  let X;
  func bool X means


  Z in it iff Z c= X;
end;

definition
  let X1,X2;
  func [: X1,X2 :] means


  z in it iff ex x,y st x in X1 & y in X2 & z = [x,y];
end;

definition
  let X1,X2,X3;
  func [: X1,X2,X3 :] equals

  [:[:X1,X2:],X3:];
end;

definition
  let X1,X2,X3,X4;
  func [: X1,X2,X3,X4 :] equals

  [:[:X1,X2,X3:],X4:];
end;

begin





theorem 
  bool {} = { {} };

theorem 
  union {} = {};





theorem 
  {x} c= {y} implies x = y;

theorem 
  {x} = {y1,y2} implies x = y1;

theorem 
  {x} = {y1,y2} implies y1 = y2;

theorem 
  { x1,x2 } = { y1,y2 } implies x1 = y1 or x1 = y2;

theorem 
  {x} c= {x,y};

theorem 
  {x} \/ {y} = {x} implies x = y;

theorem 
  {x} \/ {x,y} = {x,y};

theorem 
  {x} misses {y} implies x <> y;

theorem 
  x <> y implies {x} misses {y};

theorem 
  {x} /\ {y} = {x} implies x = y;

theorem 
  {x} /\ {x,y} = {x};

theorem 
  {x} \ {y} = {x} iff x <> y;

theorem 
  {x} \ {y} = {} implies x = y;

theorem 
  {x} \ {x,y} = {};

theorem 
  x <> y implies { x,y } \ { y } = { x };

theorem 
  {x} c= {y} implies x = y;

theorem 
  {z} c= {x,y} implies z = x or z = y;

theorem 
  {x,y} c= {z} implies x = z;

theorem 
  {x,y} c= {z} implies {x,y} = {z};

theorem 
  {x1,x2} c= {y1,y2} implies x1 = y1 or x1 = y2;

theorem 
  x <> y implies { x } \+\ { y } = { x,y };

theorem 
  bool { x } = { {} , { x }};

theorem 
  union { x } = x;

theorem 
  union {{x},{y}} = {x,y};

canceled;

theorem 
  [x,y] in [:{x1},{y1}:] iff x = x1 & y = y1;

theorem 
  [:{x},{y}:] = {[x,y]};

theorem 
  [:{x},{y,z}:] = {[x,y],[x,z]} & [:{x,y},{z}:] = {[x,z],[y,z]};





theorem 
  {x} c= X iff x in X;

theorem 
  {x1,x2} c= Z iff x1 in Z & x2 in Z;





theorem 
  Y c= { x } iff Y = {} or Y = { x };

theorem 
  Y c= X & not x in Y implies Y c= X \ { x };

theorem 
  X <> {x} & X <> {} implies ex y st y in X & y <> x;

theorem 
  Z c= {x1,x2} iff Z = {} or Z = {x1} or Z = {x2} or Z = {x1,x2};





theorem 
  {z} = X \/ Y implies X = {z} & Y = {z} or X = {} & Y = {z} or X
  = {z} & Y = {};

theorem 
  {z} = X \/ Y & X <> Y implies X = {} or Y = {};

theorem 
  {x} \/ X c= X implies x in X;

theorem 
  x in X implies {x} \/ X = X;

theorem 
  {x,y} \/ Z c= Z implies x in Z;

theorem 
  x in Z & y in Z implies {x,y} \/ Z = Z;

theorem 
  {x} \/ X <> {};

theorem 
  {x,y} \/ X <> {};





theorem 
  X /\ {x} = {x} implies x in X;

theorem 
  x in X implies X /\ {x} = {x};

theorem 
  x in Z & y in Z implies {x,y} /\ Z = {x,y};

theorem 
  {x} misses X implies not x in X;

theorem 
  {x,y} misses Z implies not x in Z;

theorem 
  not x in X implies {x} misses X;

theorem 
  not x in Z & not y in Z implies {x,y} misses Z;

theorem 
  {x} misses X or {x} /\ X = {x};

theorem 
  {x,y} /\ X = {x} implies not y in X or x = y;

theorem 
  x in X & (not y in X or x = y) implies {x,y} /\ X = {x};

theorem 
  {x,y} /\ X = {x,y} implies x in X;





theorem 
  z in X \ {x} iff z in X & z <> x;

theorem 
  X \ {x} = X iff not x in X;

theorem 
  X \ {x} = {} implies X = {} or X = {x};

theorem 
  {x} \ X = {x} iff not x in X;

theorem 
  {x} \ X = {} iff x in X;

theorem 
  {x} \ X = {} or {x} \ X = {x};

theorem 
  {x,y} \ X = {x} iff not x in X & (y in X or x = y);

theorem 
  {x,y} \ X = {x,y} iff not x in X & not y in X;

theorem 
  {x,y} \ X = {} iff x in X & y in X;

theorem 
  {x,y} \ X = {} or {x,y} \ X = {x} or {x,y} \ X = {y} or {x,y} \ X = {x ,y};

theorem 
  X \ {x,y} = {} iff X = {} or X = {x} or X = {y} or X = {x,y};





theorem 
  A c= B implies bool A c= bool B;

theorem 
  { A } c= bool A;

theorem 
  bool A \/ bool B c= bool (A \/ B);

theorem 
  bool A \/ bool B = bool (A \/ B) implies A,B are_c=-comparable;

theorem 
  bool (A /\ B) = bool A /\ bool B;

theorem 
  bool (A \ B) c= { {} } \/ (bool A \ bool B);

theorem 
  bool (A \ B) \/ bool (B \ A) c= bool (A \+\ B);





theorem 
  X in A implies X c= union A;

theorem 
  union { X,Y } = X \/ Y;

theorem 
  (for X st X in A holds X c= Z) implies union A c= Z;

theorem 
  A c= B implies union A c= union B;

theorem 
  union (A \/ B) = union A \/ union B;

theorem 
  union (A /\ B) c= union A /\ union B;

theorem 
  (for X st X in A holds X misses B) implies union A misses B;

theorem 
  union bool A = A;

theorem 
  A c= bool union A;

theorem 
  (for X,Y st X<>Y & X in A \/ B & Y in A \/ B holds X misses Y) implies
  union(A /\ B) = union A /\ union B;





theorem 
  A c= [:X,Y:] & z in A implies ex x,y st x in X & y in Y & z = [ x,y];

theorem 
  z in [:X1, Y1:] /\ [:X2, Y2:] implies ex x,y st z = [x,y] & x
  in X1 /\ X2 & y in Y1 /\ Y2;

theorem 
  [:X,Y:] c= bool bool (X \/ Y);

theorem 
  [x,y] in [:X,Y:] iff x in X & y in Y;

theorem 
  [x,y] in [:X,Y:] implies [y,x] in [:Y,X:];

theorem 
  (for x,y holds [x,y] in [:X1,Y1:] iff [x,y] in [:X2,Y2:]) implies [:X1
  ,Y1:]=[:X2,Y2:];

theorem 
  [:X,Y:] = {} iff X = {} or Y = {};

theorem 
  X <> {} & Y <> {} & [:X,Y:] = [:Y,X:] implies X = Y;

theorem 
  [:X,X:] = [:Y,Y:] implies X = Y;

theorem 
  X c= [:X,X:] implies X = {};

theorem 
  Z <> {} & ([:X,Z:] c= [:Y,Z:] or [:Z,X:] c= [:Z,Y:]) implies X c= Y;

theorem 
  X c= Y implies [:X,Z:] c= [:Y,Z:] & [:Z,X:] c= [:Z,Y:];

theorem 
  X1 c= Y1 & X2 c= Y2 implies [:X1,X2:] c= [:Y1,Y2:];

theorem 
  [:X \/ Y, Z:] = [:X, Z:] \/ [:Y, Z:] & [:Z, X \/ Y:] = [:Z, X:] \/ [:Z, Y:];

theorem 
  [:X1 \/ X2, Y1 \/ Y2:] = [:X1,Y1:] \/ [:X1,Y2:] \/ [:X2,Y1:] \/ [:X2, Y2:];

theorem 
  [:X /\ Y, Z:] = [:X, Z:] /\ [:Y, Z:] & [:Z, X /\ Y:] = [:Z, X:] /\ [:Z , Y :]
;

theorem 
  [:X1 /\ X2, Y1 /\ Y2:] = [:X1,Y1:] /\ [:X2, Y2:];

theorem 
  A c= X & B c= Y implies [:A,Y:] /\ [:X,B:] = [:A,B:];

theorem 
  [:X \ Y, Z:] = [:X, Z:] \ [:Y, Z:] & [:Z, X \ Y:] = [:Z, X:] \ [:Z, Y:];

theorem 
  [:X1,X2:] \ [:Y1,Y2:] = [:X1\Y1,X2:] \/ [:X1,X2\Y2:];

theorem 
  X1 misses X2 or Y1 misses Y2 implies [:X1,Y1:] misses [:X2,Y2:];

theorem 
  [x,y] in [:{z},Y:] iff x = z & y in Y;

theorem 
  [x,y] in [:X,{z}:] iff x in X & y = z;

theorem 
  X <> {} implies [:{x},X:] <> {} & [:X,{x}:] <> {};

theorem 
  x <> y implies [:{x},X:] misses [:{y},Y:] & [:X,{x}:] misses [:Y,{y}:];

theorem 
  [:{x,y},X:] = [:{x},X:] \/ [:{y},X:] & [:X,{x,y}:] = [:X,{x}:] \/ [:X, {y} :]
;

theorem 
  X1 <> {} & Y1 <> {} & [:X1,Y1:] = [:X2,Y2:] implies X1 = X2 & Y1 = Y2;

theorem 
  X c= [:X,Y:] or X c= [:Y,X:] implies X = {};

theorem 
  ex M st N in M & (for X,Y holds X in M & Y c= X implies Y in M) & (for
  X holds X in M implies bool X in M) & for X holds X c= M implies X,M
  are_equipotent or X in M;

reserve e,X,X1,X2,Y1,Y2 for set;

theorem 
  e in [:X1,Y1:] & e in [:X2,Y2:] implies e in [:X1 /\ X2, Y1 /\ Y2:];

begin 


theorem 
  [:X1,X2:] c= [:Y1,Y2:] & [:X1,X2:] <> {} implies X1 c= Y1 & X2 c= Y2;



theorem 
  for A being non empty set, B,C,D being set st [:A,B:] c= [:C,D:] or [:
  B,A:] c= [:D,C:] holds B c= D;

theorem 
  x in X implies (X\{x})\/{x}=X;

theorem 
  not x in X implies (X\/{x})\{x}=X;



theorem 
  for x,y,z,Z being set holds Z c= {x,y,z} iff Z = {} or Z = {x} or Z =
  {y} or Z = {z} or Z = {x,y} or Z = {y,z} or Z = {x,z} or Z = {x,y,z};



theorem 
  N c= [:X1,Y1:] & M c= [:X2,Y2:] implies N \/ M c= [:X1 \/ X2,Y1 \/ Y2 :];

theorem 
  not x in X & not y in X implies X = X \ {x,y};

theorem 
  not x in X & not y in X implies X = X \/ {x,y} \ {x,y};



definition
  let x1, x2, x3 be set;
  pred x1, x2, x3 are_mutually_different means

  x1 <> x2 & x1 <> x3 & x2 <> x3;
end;

definition
  let x1, x2, x3, x4 be set;
  pred x1, x2, x3, x4 are_mutually_different means

  x1 <> x2 & x1 <> x3 & x1 <> x4 & x2 <> x3 & x2 <> x4 & x3 <> x4;
end;



definition
  let x1, x2, x3, x4, x5 be set;
  pred x1, x2, x3, x4, x5 are_mutually_different means

  x1 <> x2 & x1 <> x3 &
x1 <> x4 & x1 <> x5 & x2 <> x3 & x2 <> x4 & x2 <> x5 & x3 <> x4 & x3 <> x5 & x4
  <> x5;
end;



definition
  let x1, x2, x3, x4, x5, x6 be set;
  pred x1, x2, x3, x4, x5, x6 are_mutually_different means

  x1 <> x2 & x1 <> x3
& x1 <> x4 & x1 <> x5 & x1 <> x6 & x2 <> x3 & x2 <> x4 & x2 <> x5 & x2 <> x6 &
  x3 <> x4 & x3 <> x5 & x3 <> x6 & x4 <> x5 & x4 <> x6 & x5 <> x6;
end;

definition
  let x1, x2, x3, x4, x5, x6, x7 be set;
  pred x1, x2, x3, x4, x5, x6, x7 are_mutually_different means

  x1 <> x2 & x1
<> x3 & x1 <> x4 & x1 <> x5 & x1 <> x6 & x1 <> x7 & x2 <> x3 & x2 <> x4 & x2 <>
x5 & x2 <> x6 & x2 <> x7 & x3 <> x4 & x3 <> x5 & x3 <> x6 & x3 <> x7 & x4 <> x5
  & x4 <> x6 & x4 <> x7 & x5 <> x6 & x5 <> x7 & x6 <> x7;
end;



theorem 
  [:{x1,x2},{y1,y2}:] = {[x1,y1],[x1,y2],[x2,y1],[x2,y2]};



theorem 
  x <> y implies A \/ {x} \ {y} = A \ {y} \/ {x};



definition
  let X;
  attr X is trivial means

 x in X & y in X implies x = y;
end;

registration
  cluster empty -> trivial for set;
end;

registration
  cluster non trivial -> non empty for set;
end;

registration
  let x be set;
  cluster {x} -> trivial;
end;

registration
 cluster trivial non empty for set;
end;



theorem 
  for A,B,C,p being set st A c= B & B /\ C = {p} & p in A holds A /\ C = {p};



theorem 
  for A,B,C,p being set st A /\ B c= {p} & p in C & C misses B holds A
  \/ C misses B;

theorem 
  for A,B being set st for x,y being set st x in A & y in B holds x
  misses y holds union A misses union B;



registration
  let X be set, Y be empty set;
  cluster [:X, Y:] -> empty;
end;

registration
  let X be empty set, Y be set;
  cluster [:X, Y:] -> empty;
end;



theorem 
 not A in [:A,B:];

theorem 
 [x,{x}] in [:{x},[x,{x}]:];

theorem 
 B in [:A,B:] implies ex x st x in A & B = [x,{x}];

theorem 
 B c= A & A is trivial implies B is trivial;

registration
  cluster non trivial for set;
end;

theorem 
 X is non empty trivial implies ex x st X = {x};

theorem 
  for x being set, X being trivial set st x in X holds X = {x};



theorem 
  for a,b,c,X being set st a in X & b in X & c in X holds {a,b,c} c= X;



theorem 
 [x,y] in X implies x in union union X & y in union union X;

theorem 
  X c= Y \/ {x} implies x in X or X c= Y;

theorem 
  x in X \/ {y} iff x in X or x = y;

theorem 
  X \/ {x} c= Y iff x in Y & X c= Y;

theorem 
  for A, B, a being set st A c= B & B c= A \/ {a} holds A \/ {a} = B or A = B;















begin

reserve E,X,x,x1,x2,x3,x4,x5,x6,x7,x8,x9,x10 for set;

registration
  let X be set;
  cluster bool X -> non empty;
end;

registration
  let x1, x2, x3;
  cluster { x1, x2, x3 } -> non empty;
  let x4;
  cluster { x1, x2, x3, x4 } -> non empty;
  let x5;
  cluster { x1, x2, x3, x4, x5 } -> non empty;
  let x6;
  cluster { x1, x2, x3, x4, x5, x6 } -> non empty;
  let x7;
  cluster { x1, x2, x3, x4, x5, x6, x7 } -> non empty;
  let x8;
  cluster { x1, x2, x3, x4, x5, x6, x7, x8 } -> non empty;
  let x9;
  cluster { x1, x2, x3, x4, x5, x6, x7, x8, x9 } -> non empty;
  let x10;
  cluster { x1, x2, x3, x4, x5, x6, x7, x8, x9, x10 } -> non empty;
end;

definition
  let X;
  mode Element of X means

  it in X if X is non empty otherwise it is empty;
  sethood;
end;

definition
  let X;
  mode Subset of X is Element of bool X;
end;

registration
  let X be non empty set;
  cluster non empty for Subset of X;
end;

registration
  let X1,X2 be non empty set;
  cluster [: X1,X2 :] -> non empty;
end;

registration
  let X1,X2,X3 be non empty set;
  cluster [: X1,X2,X3 :] -> non empty;
end;

registration
  let X1,X2,X3,X4 be non empty set;
  cluster [: X1,X2,X3,X4 :] -> non empty;
end;

definition
  let D be non empty set, X be non empty Subset of D;
  redefine mode Element of X -> Element of D;
end;

registration
  let E;
  cluster empty for Subset of E;
end;

definition
  let E;
  func {}E -> Subset of E equals

  {};
  func [#] E -> Subset of E equals

  E;
end;

registration
  let E;
  cluster {}E -> empty;
end;

theorem 
  {} is Subset of X;

reserve A,B,C for Subset of E;

theorem 
  (for x being Element of E holds x in A implies x in B) implies A c= B;

theorem 
  (for x being Element of E holds x in A iff x in B) implies A = B;

theorem 
  A <> {} implies ex x being Element of E st x in A;

definition
  let E,A;
  func A` -> Subset of E equals

  E \ A;
  involutiveness;
  let B;
  redefine func A \/ B -> Subset of E;
  redefine func A \+\ B -> Subset of E;
end;

definition
  let X,Y be set;
  redefine func X \ Y -> Subset of X;
end;

definition
  let E,A,X;
  redefine func A \ X -> Subset of E;
end;

definition
  let E,A,X;
  redefine func A /\ X -> Subset of E;
end;

definition
  let E,X,A;
  redefine func X /\ A -> Subset of E;
end;

theorem 
  (for x being Element of E holds x in A iff x in B or x in C) implies A
  = B \/ C;

theorem 
  (for x being Element of E holds x in A iff x in B & x in C) implies A
  = B /\ C;

theorem 
  (for x being Element of E holds x in A iff x in B & not x in C)
  implies A = B \ C;

theorem 
  (for x being Element of E holds x in A iff not(x in B iff x in C))
  implies A = B \+\ C;

theorem 
  [#] E = ({} E)`;

theorem 
  A \/ A` = [#]E;

theorem 
  A \/ [#]E = [#]E;

theorem 
  A c= B iff B` c= A`;

theorem 
  A \ B = A /\ B`;

theorem 
  (A \ B)` = A` \/ B;

theorem 
  (A \+\ B)` = A /\ B \/ A` /\ B`;

theorem 
  A c= B` implies B c= A`;

theorem 
  A` c= B implies B` c= A;

theorem 
  A c= A` iff A = {}E;

theorem 
  A` c= A iff A = [#]E;

theorem 
  X c= A & X c= A` implies X = {};

theorem 
  (A \/ B)` c= A`;

theorem 
  A` c= (A /\ B)`;

theorem 
  A misses B iff A c= B`;

theorem 
  A misses B` iff A c= B;

theorem 
  A misses B & A` misses B` implies A = B`;

theorem 
  A c= B & C misses B implies A c= C`;





theorem 
  (for a being Element of A holds a in B) implies A c= B;

theorem 
  (for x being Element of E holds x in A) implies E = A;

theorem 
  E <> {} implies for B for x being Element of E st not x in B holds x in B`;

theorem 
  for A,B st for x being Element of E holds x in A iff not x in B holds A = B`;

theorem 
  for A,B st for x being Element of E holds not x in A iff x in B holds A = B`;

theorem 
  for A,B st for x being Element of E holds not(x in A iff x in B) holds A = B`
;

reserve x1,x2,x3,x4,x5,x6,x7,x8 for Element of X;

theorem 
  X <> {} implies {x1} is Subset of X;

theorem 
  X <> {} implies {x1,x2} is Subset of X;

theorem 
  X <> {} implies {x1,x2,x3} is Subset of X;

theorem 
  X <> {} implies {x1,x2,x3,x4} is Subset of X;

theorem 
  X <> {} implies {x1,x2,x3,x4,x5} is Subset of X;

theorem 
  X <> {} implies {x1,x2,x3,x4,x5,x6} is Subset of X;

theorem 
  X <> {} implies {x1,x2,x3,x4,x5,x6,x7} is Subset of X;

theorem 
  X <> {} implies {x1,x2,x3,x4,x5,x6,x7,x8} is Subset of X;

theorem 
  x in X implies {x} is Subset of X;

scheme 

  SubsetEx { A()-> set, P[set] } : ex X being Subset of A() st for x holds x
  in X iff x in A() & P[x];

scheme 

  SubsetEq {X() -> set, X1,X2()-> Subset of X(), P[set]}: X1() = X2()
provided
 for y being Element of X() holds y in X1() iff P[y] and
 for y being Element of X() holds y in X2() iff P[y];

definition
  let X, Y be non empty set;
  redefine pred X misses Y;
  irreflexivity;
end;

definition
  let X, Y be non empty set;
  redefine pred X meets Y;
  reflexivity;
end;

definition
  let S be set;
  func choose S -> Element of S equals

  the Element of S;
end;

begin 

reserve Y for set;



scheme 

  SubsetEx { A() -> non empty set, P[set] } : ex B being Subset of A() st for
  x being Element of A() holds x in B iff P[x];



scheme 

  SubComp{A() -> set, F1,F2() -> Subset of A(), P[set]}: F1() = F2()
provided
 for X being Element of A() holds X in F1() iff P[X] and
 for X being Element of A() holds X in F2() iff P[X];



theorem 
  A` = B` implies A = B;



registration
  let X be empty set;
  cluster -> empty for Subset of X;
end;



definition
  let E be set;
  let A be Subset of E;
  attr A is proper means

  A <> E;
end;

registration
  let E be set;
  cluster [#]E -> non proper;
end;

registration
  let E be set;
  cluster non proper for Subset of E;
end;

registration
  let E be non empty set;
  cluster non proper -> non empty for Subset of E;
  cluster empty -> proper for Subset of E;
end;

registration
  let E be non empty set;
  cluster proper for Subset of E;
end;

registration
  let E be empty set;
  cluster -> non proper for Subset of E;
end;



theorem 
  for X,Y,A being set, z being set st z in A & A c= [:X,Y:] ex x
  being Element of X, y being Element of Y st z = [x,y];



theorem 
  for X being non empty set, A, B being non empty Subset of X st A c< B
   ex p being Element of X st p in B & A c= B \ {p};

definition
  let X be non empty set;
  redefine attr X is trivial means

  for x,y being Element of X holds x = y;
end;

registration let X be non empty set;
 cluster non empty trivial for Subset of X;
end;

registration
  let X be trivial set;
  cluster -> trivial for Subset of X;
end;

registration
  let X be non trivial set;
  cluster non trivial for Subset of X;
end;

theorem 
  for D being set, A being Subset of D st A is non trivial
    ex d1,d2 being Element of D st d1 in A & d2 in A & d1 <> d2;

theorem 
 for X being trivial non empty set
  ex x being Element of X st X = {x};



theorem 
  for X being non empty set, A being non empty Subset of X holds A
  is trivial implies ex x being Element of X st A = {x};

theorem 
  for X be non trivial set, x being Element of X
   ex y be set st y in X & x <> y;















begin








theorem 
  for a, b being set st a in b holds a is Element of b;

theorem 
  for a, b being set st a is Element of b & b is non empty holds a in b;

theorem 
  for a, b being set holds a is Subset of b iff a c= b;

theorem 
  for a, b, c being set st a in b & b is Subset of c holds a is Element of c;

theorem 
  for a, b, c being set st a in b & b is Subset of c holds c is non empty;














begin

reserve X,Y,Z,Z1,Z2,D,x,y for set;

definition
  let X;
  func meet X means


  for x holds x in it iff for Y holds Y in X implies
  x in Y if X <> {} otherwise it = {};
end;



theorem 
  meet {} = {};

theorem 
  meet X c= union X;

theorem 
  Z in X implies meet X c= Z;

theorem 
  {} in X implies meet X = {};

theorem 
  X <> {} & (for Z1 st Z1 in X holds Z c= Z1) implies Z c= meet X;

theorem 
  X <> {} & X c= Y implies meet Y c= meet X;

theorem 
  X in Y & X c= Z implies meet Y c= Z;

theorem 
  X in Y & X misses Z implies meet Y misses Z;

theorem 
  X <> {} & Y <> {} implies meet (X \/ Y) = meet X /\ meet Y;

theorem 
  meet {x} = x;

theorem 
  meet {X,Y} = X /\ Y;

reserve SFX,SFY,SFZ for set;

definition
  let SFX,SFY;
  pred SFX is_finer_than SFY means

  for X st X in SFX ex Y st Y in SFY & X c= Y;
  reflexivity;
  pred SFY is_coarser_than SFX means

  for Y st Y in SFY ex X st X in SFX & X c= Y;
  reflexivity;
end;

theorem 
  SFX c= SFY implies SFX is_finer_than SFY;

theorem 
  SFX is_finer_than SFY implies union SFX c= union SFY;

theorem 
  SFY <> {} & SFY is_coarser_than SFX implies meet SFX c= meet SFY;

theorem 
  {} is_finer_than SFX;

theorem 
  SFX is_finer_than {} implies SFX = {};

theorem 
  SFX is_finer_than SFY & SFY is_finer_than SFZ implies SFX is_finer_than SFZ;

theorem 
  SFX is_finer_than {Y} implies for X st X in SFX holds X c= Y;

theorem 
  SFX is_finer_than {X,Y} implies for Z st Z in SFX holds Z c= X or Z c= Y;

definition
  let SFX,SFY;
  func UNION (SFX,SFY) means


  Z in it iff ex X,Y st X in SFX & Y in SFY & Z = X \/ Y;
  commutativity;
  func INTERSECTION (SFX,SFY) means


  Z in it iff ex X,Y st X in SFX & Y in SFY & Z = X /\ Y;
  commutativity;
  func DIFFERENCE (SFX,SFY) means


  Z in it iff ex X,Y st X in SFX & Y in SFY & Z = X \ Y;
end;

theorem 
  SFX is_finer_than UNION(SFX,SFX);

theorem 
  INTERSECTION(SFX,SFX) is_finer_than SFX;

theorem 
  DIFFERENCE(SFX,SFX) is_finer_than SFX;

theorem 
  SFX meets SFY implies meet SFX /\ meet SFY = meet INTERSECTION(SFX,SFY );

theorem 
  SFY <> {} implies X \/ meet SFY = meet UNION({X},SFY);

theorem 
  X /\ union SFY = union INTERSECTION({X},SFY);

theorem 
  SFY <> {} implies X \ union SFY = meet DIFFERENCE({X},SFY);

theorem 
  SFY <> {} implies X \ meet SFY = union DIFFERENCE ({X},SFY);

theorem 
  union INTERSECTION (SFX,SFY) = union SFX /\ union SFY;

theorem 
  SFX <> {} & SFY <> {} implies meet SFX \/ meet SFY c= meet UNION (SFX, SFY);

theorem 
  meet DIFFERENCE (SFX,SFY) c= meet SFX \ meet SFY;



definition
  let D be set;
  mode Subset-Family of D is Subset of bool D;
end;

reserve F,G for Subset-Family of D;
reserve P for Subset of D;

definition
  let D,F;
  redefine func union F -> Subset of D;
end;

definition
  let D,F;
  redefine func meet F -> Subset of D;
end;

theorem 
  (for P holds P in F iff P in G) implies F=G;

definition
  let D,F;

  func COMPLEMENT(F) -> Subset-Family of D means


  for P being Subset of D holds P in it iff P` in F;
  involutiveness;
end;

theorem 
  F <> {} implies COMPLEMENT(F) <> {};

theorem 
  F <> {} implies [#] D \ union F = meet (COMPLEMENT(F));

theorem 
  F <> {} implies union COMPLEMENT(F) = [#] D \ meet F;

begin 


theorem 
  for X being set, F being Subset-Family of X for P being Subset of X
  holds P` in COMPLEMENT F iff P in F;

theorem 
  for X being set, F,G being Subset-Family of X st COMPLEMENT F c=
  COMPLEMENT G holds F c= G;

theorem 
  for X being set, F,G being Subset-Family of X holds COMPLEMENT F c= G
  iff F c= COMPLEMENT G;

theorem 
  for X being set, F,G being Subset-Family of X st COMPLEMENT F =
  COMPLEMENT G holds F = G;

theorem 
  for X being set, F,G being Subset-Family of X holds COMPLEMENT(F \/ G)
  = COMPLEMENT F \/ COMPLEMENT G;

theorem 
  for X being set, F being Subset-Family of X st F = {X} holds
  COMPLEMENT F = {{}};

registration
  let X be set, F be empty Subset-Family of X;
  cluster COMPLEMENT F -> empty;
end;



definition
  let IT be set;
  attr IT is with_non-empty_elements means


  not {} in IT;
end;

registration
  cluster non empty with_non-empty_elements for set;
end;

registration
  let A be non empty set;
  cluster { A } -> with_non-empty_elements;
  let B be non empty set;
  cluster { A, B } -> with_non-empty_elements;
  let C be non empty set;
  cluster { A, B, C } -> with_non-empty_elements;
  let D be non empty set;
  cluster { A, B, C, D } -> with_non-empty_elements;
  let E be non empty set;
  cluster { A, B, C, D, E } -> with_non-empty_elements;
  let F be non empty set;
  cluster { A, B, C, D, E, F } -> with_non-empty_elements;
  let G be non empty set;
  cluster { A, B, C, D, E, F, G } -> with_non-empty_elements;
  let H be non empty set;
  cluster { A, B, C, D, E, F, G, H } -> with_non-empty_elements;
  let I be non empty set;
  cluster { A, B, C, D, E, F, G, H, I } -> with_non-empty_elements;
  let J be non empty set;
  cluster { A, B, C, D, E, F, G, H, I, J } -> with_non-empty_elements;
end;

registration
  let A,B be with_non-empty_elements set;
  cluster A \/ B -> with_non-empty_elements;
end;



theorem 
  union Y c= Z & X in Y implies X c= Z;



theorem 
  for A,B,X being set holds ( X c= union (A \/ B) & for Y being set st Y
  in B holds Y misses X ) implies X c= union A;



definition
  let M be set;
  let B be Subset-Family of M;
  func Intersect B -> Subset of M equals


  meet B if B <> {} otherwise M;
end;

theorem 
  for X, x being set, R being Subset-Family of X st x in X holds x
  in Intersect R iff for Y being set st Y in R holds x in Y;

theorem 
  for X being set for H, J being Subset-Family of X st H c= J holds
  Intersect J c= Intersect H;



registration
  let X be non empty with_non-empty_elements set;
  cluster -> non empty for Element of X;
end;



reserve E for set;

definition
  let E;
  attr E is empty-membered means


  not ex x being non empty set st x in E;
end;

notation
  let E;
  antonym E is with_non-empty_element for E is empty-membered;
end;

registration
  cluster with_non-empty_element for set;
end;

registration
  cluster with_non-empty_element -> non empty for set;
end;



registration
  let X be with_non-empty_element set;
  cluster non empty for Element of X;
end;



registration
  let D be non empty with_non-empty_elements set;
  cluster union D -> non empty;
end;



registration
  cluster non empty with_non-empty_elements -> with_non-empty_element for set;
end;



definition
  let X be set;
  mode Cover of X means


    X c= union it;
end;

theorem 
  for X being set, F being Subset-Family of X holds F is Cover of X iff
  union F = X;



theorem 
  {{}} is Subset-Family of X;



definition
  let X be set;
  let F be Subset-Family of X;
  attr F is with_proper_subsets means


  not X in F;
end;

theorem 
  for TS being set, F, G being Subset-Family of TS st F is
  with_proper_subsets & G c= F holds G is with_proper_subsets;

registration
  let TS be non empty set;
  cluster with_proper_subsets for Subset-Family of TS;
end;

theorem 
  for TS being non empty set, A, B being with_proper_subsets
  Subset-Family of TS holds A \/ B is with_proper_subsets;



registration
  cluster non trivial -> with_non-empty_element for set;
end;



definition
  let X be set;
  redefine func bool X -> Subset-Family of X;
end;



theorem 
  for A being non empty set, b being set st A <> {b} ex a being
  Element of A st a <> b;















begin

reserve A,X,X1,X2,Y,Y1,Y2,a,b,c,d,x,y,z for set;

definition
  let IT be set;
  attr IT is Relation-like means


  x in IT implies ex y,z st x = [y,z];
end;

registration
  cluster empty -> Relation-like for set;
end;

definition
  mode Relation is Relation-like set;
end;

reserve P,P1,P2,Q,R,S for Relation;

registration
  let R be Relation;
  cluster -> Relation-like for Subset of R;
end;

scheme 

  RelExistence{A,B() -> set, P[set,set]}: ex R being Relation st for x,y holds
  [x,y] in R iff x in A() & y in B() & P[x,y];

definition
  let P,R;
  redefine pred P = R means

  for a,b holds [a,b] in P iff [a,b] in R;
end;

registration
  let P,X;
  cluster P /\ X -> Relation-like;
  cluster P \ X -> Relation-like;
end;

registration
  let P,R;
  cluster P \/ R -> Relation-like;
end;

registration
  let R,S be Relation;
  cluster R \+\ S -> Relation-like;
end;

registration
  let a, b be set;
  cluster {[a,b]} -> Relation-like;
  cluster [:a,b:] -> Relation-like;
end;

registration
  let a, b, c, d be set;
  cluster {[a,b],[c,d]} -> Relation-like;
end;

definition
  let P,A;
  redefine pred P c= A means

  for a,b holds [a,b] in P implies [a,b] in A;
end;



notation
  let R be Relation;
  synonym dom R for proj1 R;
end;

theorem 
  dom(P \/ R) = dom P \/ dom R;

theorem 
  dom(P /\ R) c= dom P /\ dom R;

theorem 
  dom P \ dom R c= dom(P \ R);



notation
  let R be Relation;
  synonym rng R for proj2 R;
end;

canceled 3;

theorem 
  R c= [:dom R, rng R:];

theorem 
  R /\ [:dom R, rng R:] = R;

theorem 
  R = {[x,y]} implies dom R = {x} & rng R = {y};

theorem 
  R = {[a,b],[x,y]} implies dom R = {a,x} & rng R = {b,y};

theorem 
  P c= R implies dom P c= dom R & rng P c= rng R;

theorem 
  rng(P \/ R) = rng P \/ rng R;

theorem 
  rng(P /\ R) c= rng P /\ rng R;

theorem 
  rng P \ rng R c= rng(P \ R);



definition
 canceled 2;
  let R;
  func field R -> set equals

  dom R \/ rng R;
end;

theorem 
  [a,b] in R implies a in field R & b in field R;

theorem 
  P c= R implies field P c= field R;

theorem 
  field {[x,y]} = {x,y};

theorem 
  field(P \/ R) = field P \/ field R;

theorem 
  field(P /\ R) c= field P /\ field R;



definition
  let R;
  func R~ -> Relation means


  [x,y] in it iff [y,x] in R;
  involutiveness;
end;

theorem 
  rng R = dom(R~) & dom R = rng(R~);

theorem 
  field R = field(R~);

theorem 
  (P /\ R)~ = P~ /\ R~;

theorem 
  (P \/ R)~ = P~ \/ R~;

theorem 
  (P \ R)~ = P~ \ R~;



definition
  let P,R be set;
  func P(#)R -> Relation means


  [x,y] in it iff ex z st [x,z] in P & [z,y] in R;
end;

notation
  let P,R;
  synonym P*R for P(#)R;
end;

theorem 
  dom(P*R) c= dom P;

theorem 
  rng(P*R) c= rng R;

theorem 
  rng R c= dom P implies dom(R*P) = dom R;

theorem 
  dom P c= rng R implies rng(R*P) = rng P;

theorem 
  P c= R implies Q*P c= Q*R;

theorem 
  P c= Q implies P*R c= Q*R;

theorem 
  P c= R & Q c= S implies P*Q c= R*S;

theorem 
  P*(R \/ Q) = (P*R) \/ (P*Q);

theorem 
  P*(R /\ Q) c= (P*R) /\ (P*Q);

theorem 
  (P*R) \ (P*Q) c= P*(R \ Q);

theorem 
  (P*R)~ = R~*P~;

theorem 
  (P*R)*Q = P*(R*Q);



registration
  cluster non empty for Relation;
end;

registration
  let f be non empty Relation;
  cluster dom f -> non empty;
  cluster rng f -> non empty;
end;

theorem 
  (for x,y holds not [x,y] in R) implies R = {};

theorem 
  dom {} = {} & rng {} = {};

theorem 
  {}*R = {} & R*{} = {};

registration
  let X be empty set;
  cluster dom X -> empty;
  cluster rng X -> empty;
  let R;
  cluster X*R -> empty;
  cluster R*X -> empty;
end;

theorem 
  field {} = {};

theorem 
  dom R = {} or rng R = {} implies R = {};

theorem 
  dom R = {} iff rng R = {};

registration
  let X be empty set;
  cluster X~ -> empty;
end;

theorem 
  {}~ = {};

theorem 
  rng R misses dom P implies R*P = {};

definition
  let R be Relation;
  attr R is non-empty means


  not {} in rng R;
end;

registration
  cluster non-empty for Relation;
end;

registration
  let R be Relation, S be non-empty Relation;
  cluster R*S -> non-empty;
end;



definition
  let X;
  func id X -> Relation means


  [x,y] in it iff x in X & x = y;
end;

registration let X;
 reduce dom id X to X;
 reduce rng id X to X;
end;

theorem 
  dom id X = X & rng id X = X;

registration let X;
 reduce (id X)~ to id X;
end;

theorem 
  (id X)~ = id X;

theorem 
  (for x st x in X holds [x,x] in R) implies id X c= R;

theorem 
  [x,y] in (id X)*R iff x in X & [x,y] in R;

theorem 
  [x,y] in R*id Y iff y in Y & [x,y] in R;

theorem 
  R*(id X) c= R & (id X)*R c= R;

theorem 
  dom R c= X implies (id X)*R = R;

theorem 
  (id dom R)*R = R;

theorem 
  rng R c= Y implies R*(id Y) = R;

theorem 
  R*(id rng R) = R;

theorem 
  id {} = {};

theorem 
  rng P2 c= X & P2*R = id dom P1 & R*P1 = id X implies P1 = P2;

definition
  let R,X;
  func R|X -> Relation means


  [x,y] in it iff x in X & [x,y] in R;
end;

registration
  let R be Relation, X be empty set;
  cluster R|X -> empty;
end;

theorem 
  x in dom(R|X) iff x in X & x in dom R;

theorem 
  dom(R|X) c= X;

theorem 
  R|X c= R;

theorem 
  dom(R|X) c= dom R;

theorem 
  dom(R|X) = dom R /\ X;

theorem 
  X c= dom R implies dom(R|X) = X;

theorem 
  (R|X)*P c= R*P;

theorem 
  P*(R|X) c= P*R;

theorem 
  R|X = (id X)*R;

theorem 
  R|X = {} iff dom R misses X;

theorem 
  R|X = R /\ [:X,rng R:];

theorem 
  dom R c= X implies R|X = R;

registration let R;
 reduce R|dom R to R;
end;

theorem 
  R|dom R = R;

theorem 
  rng(R|X) c= rng R;

theorem 
  (R|X)|Y = R|(X /\ Y);

registration let R,X;
 reduce R|X|X to R|X;
end;

theorem 
  (R|X)|X = R|X;

theorem 
  X c= Y implies (R|X)|Y = R|X;

theorem 
  Y c= X implies (R|X)|Y = R|Y;

theorem 
  X c= Y implies R|X c= R|Y;

theorem 
  P c= R implies P|X c= R|X;

theorem 
  P c= R & X c= Y implies P|X c= R|Y;

theorem 
  R|(X \/ Y) = (R|X) \/ (R|Y);

theorem 
  R|(X /\ Y) = (R|X) /\ (R|Y);

theorem 
  R|(X \ Y) = R|X \ R|Y;

registration
  let R be empty Relation, X be set;
  cluster R|X -> empty;
end;

theorem 
  R|{} = {};

theorem 
  {}|X = {};

theorem 
  (P*R)|X = (P|X)*R;

definition
  let Y,R;
  func Y|`R -> Relation means


  [x,y] in it iff y in Y & [x,y] in R;
end;

registration
  let R be Relation, X be empty set;
  cluster X|`R -> empty;
end;

theorem 
  y in rng(Y|`R) iff y in Y & y in rng R;

theorem 
  rng(Y|`R) c= Y;

theorem 
  Y|`R c= R;

theorem 
  rng(Y|`R) c= rng R;

theorem 
  rng(Y|`R) = rng R /\ Y;

theorem 
  Y c= rng R implies rng(Y|`R) = Y;

theorem 
  (Y|`R)*P c= R*P;

theorem 
  P*(Y|`R) c= P*R;

theorem 
  Y|`R = R*(id Y);

theorem 
  Y|`R = R /\ [:dom R,Y:];

theorem 
  rng R c= Y implies Y|`R = R;

registration let R;
 reduce rng R|`R to R;
end;

theorem 
  rng R|`R=R;

theorem 
  Y|`(X|`R) = (Y /\ X)|`R;

registration let Y,R;
 reduce Y|`(Y|`R) to Y|`R;
end;

theorem 
  Y|`(Y|`R) = Y|`R;

theorem 
  X c= Y implies Y|`(X|`R) = X|`R;

theorem 
  Y c= X implies Y|`(X|`R) = Y|`R;

theorem 
  X c= Y implies X|`R c= Y|`R;

theorem 
  P1 c= P2 implies Y|`P1 c= Y|`P2;

theorem 
  P1 c= P2 & Y1 c= Y2 implies Y1|`P1 c= Y2|`P2;

theorem 
  (X \/ Y)|`R = (X|`R) \/ (Y|`R);

theorem 
  (X /\ Y)|`R = X|`R /\ Y|`R;

theorem 
  (X \ Y)|`R = X|`R \ Y|`R;

theorem 
  {}|`R = {};

theorem 
  Y|`{} = {};

theorem 
  Y|`(P*R) = P*(Y|`R);

theorem 
  (Y|`R)|X = Y|`(R|X);



definition
  let R,X;
  func R.:X -> set means


  y in it iff ex x st [x,y] in R & x in X;
end;

theorem 
  y in R.:X iff ex x st x in dom R & [x,y] in R & x in X;

theorem 
  R.:X c= rng R;

theorem 
  R.:X = R.:(dom R /\ X);

theorem 
  R.:dom R = rng R;

theorem 
  R.:X c= R.:(dom R);

theorem 
  rng(R|X) = R.:X;

registration let R; let X be empty set;
 cluster R.:X -> empty;
end;

registration let R be empty Relation; let X;
 cluster R.:X -> empty;
end;

canceled 2;

theorem 
  R.:X = {} iff dom R misses X;

theorem 
  X <> {} & X c= dom R implies R.:X <> {};

theorem 
  R.:(X \/ Y) = R.:X \/ R.:Y;

theorem 
  R.:(X /\ Y) c= R.:X /\ R.:Y;

theorem 
  R.:X \ R.:Y c= R.:(X \ Y);

theorem 
  X c= Y implies R.:X c= R.:Y;

theorem 
  P c= R implies P.:X c= R.:X;

theorem 
  P c= R & X c= Y implies P.:X c= R.:Y;

theorem 
  (P*R).:X = R.:(P.:X);

theorem 
  rng(P*R) = R.:(rng P);

theorem 
  (R|X).:Y c= R.:Y;

theorem 
  for R be Relation, X, Y be set st X c= Y holds (R|Y).:X = R.:X;

theorem 
  (dom R) /\ X c= (R~).:(R.:X);



definition
  let R,Y;
  func R"Y -> set means


  x in it iff ex y st [x,y] in R & y in Y;
end;

theorem 
  x in R"Y iff ex y st y in rng R & [x,y] in R & y in Y;

theorem 
  R"Y c= dom R;

theorem 
  R"Y = R"(rng R /\ Y);

theorem 
  R"rng R = dom R;

theorem 
  R"Y c= R"rng R;

registration let R; let Y be empty set;
 cluster R"Y -> empty;
end;

registration let R be empty Relation; let Y;
 cluster R"Y -> empty;
end;

canceled 2;

theorem 
  R"Y = {} iff rng R misses Y;

theorem 
  Y <> {} & Y c= rng R implies R"Y <> {};

theorem 
  R"(X \/ Y) = R"X \/ R"Y;

theorem 
  R"(X /\ Y) c= R"X /\ R"Y;

theorem 
  R"X \ R"Y c= R"(X \ Y);

theorem 
  X c= Y implies R"X c= R"Y;

theorem 
  P c= R implies P"Y c= R"Y;

theorem 
  P c= R & X c= Y implies P"X c= R"Y;

theorem 
  (P*R)"Y = P"(R"Y);

theorem 
  dom(P*R) = P"(dom R);

theorem 
  (rng R) /\ Y c= (R~)"(R"Y);

begin 

definition
  let R;
  attr R is empty-yielding means


  rng R c= {{}};
end;

theorem 
  R is empty-yielding iff for X st X in rng R holds X = {};



theorem 
  for f,g being Relation, A,B being set st f|A = g|A & f|B = g|B holds
  f|(A \/ B) = g|(A \/ B);

theorem 
  for X being set, f,g being Relation st dom g c= X & g c= f holds g c= f|X;

theorem 
  for f being Relation, X being set st X misses dom f holds f|X = {};



theorem 
  for f,g being Relation, A,B being set st A c= B & f|B = g|B holds f|A = g|A;



theorem 
  R|dom S = R|dom(S|dom R);



registration
  cluster empty -> empty-yielding for Relation;
end;

registration
  let R be empty-yielding Relation;
  let X be set;
  cluster R|X -> empty-yielding;
end;

theorem 
  R|X is non empty-yielding implies R is non empty-yielding;



definition
  let R be Relation, x be set;
  func Im(R,x) equals

  R.:{x};
end;





scheme 

  ExtensionalityR { A, B() -> Relation, P[set,set] }: A() = B()
provided
 for a, b being set holds [a,b] in A() iff P[a,b] and
 for a, b being set holds [a,b] in B() iff P[a,b];



theorem 
  dom (R | (dom R \ X)) = dom R \ X;

theorem 
  R | X = R | (dom R /\ X);



theorem 
  dom [:X,Y:] c= X;

theorem 
  rng [:X,Y:] c= Y;



theorem 
  X <> {} & Y <> {} implies dom [:X,Y:] = X & rng [:X,Y:] = Y;

theorem 
  dom R = {} & dom Q = {} implies R = Q;

theorem 
  rng R = {} & rng Q = {} implies R = Q;

theorem 
  dom R = dom Q implies dom(S*R) = dom (S*Q);

theorem 
  rng R = rng Q implies rng(R*S) = rng (Q*S);



definition
  let R be Relation, x be set;
  func Coim(R,x) equals

  R"{x};
end;



registration
  let R be trivial Relation;
  cluster dom R -> trivial;
end;

registration
  let R be trivial Relation;
  cluster rng R -> trivial;
end;



theorem 
  rng R c= dom (S|X) implies R*(S|X) = R*S;



theorem 
  Q|A = R|A implies Q.:A = R.:A;



definition
  let X,R;
  attr R is X-defined means


  dom R c= X;
  attr R is X-valued means


  rng R c= X;
end;

registration
  let X,Y;
  cluster X-defined Y-valued for Relation;
end;



theorem 
  for D being set, R being D-valued Relation for y being set st y in rng R
  holds y in D;



registration
  let X,A;
  let R be A-valued Relation;
  cluster R|X -> A-valued;
end;

registration
  let X,A;
  let R be A-defined Relation;
  cluster R|X -> A-defined X-defined;
end;

registration
  let X;
  cluster id X -> X-defined X-valued;
end;



registration
  let A be set;
  let R be A-valued Relation, S be Relation;
  cluster S*R -> A-valued;
end;

registration
  let A be set;
  let R be A-defined Relation, S be Relation;
  cluster R*S -> A-defined;
end;



theorem 
 x in X implies Im([:X,Y:],x) = Y;

theorem 
 [x,y] in R iff y in Im(R,x);

theorem 
  x in dom R iff Im(R,x) <> {};

theorem 
 {} is X-defined Y-valued;



registration
  cluster empty -> non-empty for Relation;
end;

registration let X be set, R be X-defined Relation;
  cluster -> X-defined for Subset of R;
end;

registration let X be set, R be X-valued Relation;
  cluster -> X-valued for Subset of R;
end;



theorem 
  X misses Y implies R|X|Y = {};



theorem 
  field {[x,x]} = {x};

registration let X; let R be X-defined Relation;
 reduce R|X to R;
end;

registration let Y; let R be Y-valued Relation;
 reduce Y|`R to R;
end;

theorem 
  for R being X-defined Relation holds R = R|X;

theorem 
  for S being Relation, R being X-defined Relation st R c= S holds R c= S|X;



theorem 
  dom R c= X implies R \ (R|A) = R|(X\A);

theorem 
  dom(R \ (R|A)) = dom R \ A;

theorem 
  dom R \ dom(R|A) = dom(R \ (R|A));

theorem 
  dom R misses dom S implies R misses S;

theorem 
  rng R misses rng S implies R misses S;

theorem 
  X c= Y implies (R \ R|Y)|X = {};

theorem 
 X c= Y implies
 for R being X-defined Relation holds R is Y-defined;

theorem 
 X c= Y implies
 for R being X-valued Relation holds R is Y-valued;

theorem 
  R c= S iff R c= S|dom R;

theorem 
  for R being X-defined Y-valued Relation holds R c= [:X,Y:];



theorem 
  dom(X|`R) c= dom R;

registration
  let A,X;
  let R be A-defined Relation;
  cluster X|`R -> A-defined;
end;

registration
  let X,A;
  let R be A-valued Relation;
  cluster X|`R -> A-valued X-valued;
end;

registration
 let X be empty set;
 cluster -> empty for X-defined Relation;
 cluster -> empty for X-valued Relation;
end;
















begin

reserve X,X1,X2,Y,Y1,Y2,p,x,x1,x2,y,y1,y2,z,z1,z2 for set;

definition
  let X be set;
  attr X is Function-like means


  for x,y1,y2 st [x,y1] in X & [x,y2] in X holds y1 = y2;
end;

registration
  cluster empty -> Function-like for set;
end;

registration
  cluster Function-like for Relation;
end;

definition
  mode Function is Function-like Relation;
end;

registration
  let a, b be set;
  cluster {[a,b]} -> Function-like;
end;

reserve f,g,g1,g2,h for Function,
  R,S for Relation;

scheme 

  GraphFunc { A()->set,P[set,set] } :
  ex f st for x,y holds [x,y] in f iff x in A() & P[x,y]
provided
 for x,y1,y2 st P[x,y1] & P[x,y2] holds y1 = y2;

definition
  let f,x;
  func f.x -> set means


  [x,it] in f if x in dom f otherwise it = {};
end;

theorem 
  [x,y] in f iff x in dom f & y = f.x;

theorem 
  dom f = dom g & (for x st x in dom f holds f.x = g.x) implies f = g;

definition
  let f;
  redefine func rng f means


  for y holds y in it iff ex x st x in dom f & y = f.x;
end;

theorem 
  x in dom f implies f.x in rng f;

theorem 
  dom f = {x} implies rng f = {f.x};

scheme 

  FuncEx { A()->set,P[set,set] } :
  ex f st dom f = A() & for x st x in A() holds P[x,f.x]
provided
 for x,y1,y2 st x in A() & P[x,y1] & P[x,y2] holds y1 = y2 and
 for x st x in A() ex y st P[x,y];

scheme 

  Lambda { A() -> set,F(set) -> set } :
  ex f being Function st dom f = A() & for x st x in A() holds f.x = F(x);

theorem 
  X <> {} implies for y ex f st dom f = X & rng f = {y};

theorem 
  (for f,g st dom f = X & dom g = X holds f = g) implies X = {};

theorem 
  dom f = dom g & rng f = {y} & rng g = {y} implies f = g;

theorem 
  Y <> {} or X = {} implies ex f st X = dom f & rng f c= Y;

theorem 
  (for y st y in Y ex x st x in dom f & y = f.x) implies Y c= rng f;

notation
  let f,g;
  synonym g*f for f*g;
end;

registration
  let f,g;
  cluster g*f -> Function-like;
end;

theorem 
  for h st (for x holds x in dom h iff x in dom f & f.x in dom g) & (for
  x st x in dom h holds h.x = g.(f.x)) holds h = g*f;

theorem 
  x in dom(g*f) iff x in dom f & f.x in dom g;

theorem 
  x in dom(g*f) implies (g*f).x = g.(f.x);

theorem 
  x in dom f implies (g*f).x = g.(f.x);

theorem 
  z in rng(g*f) implies z in rng g;

theorem 
  dom(g*f) = dom f implies rng f c= dom g;

theorem 
  rng f c= Y & (for g,h st dom g = Y & dom h = Y & g*f = h*f holds g = h
  ) implies Y = rng f;

registration
  let X;
  cluster id X -> Function-like;
end;

theorem 
  f = id X iff dom f = X & for x st x in X holds f.x = x;

theorem 
  x in X implies (id X).x = x;

theorem 
  dom(f*(id X)) = dom f /\ X;

theorem 
  x in dom f /\ X implies f.x = (f*(id X)).x;

theorem 
  x in dom((id Y)*f) iff x in dom f & f.x in Y;

theorem 
  (id X)*(id Y) = id(X /\ Y);

theorem 
  rng f = dom g & g*f = f implies g = id dom g;

definition
  let f;

  attr f is one-to-one means


  for x1,x2 st x1 in dom f & x2 in dom f & f.x1 = f.x2 holds x1 = x2;
end;

theorem 
  f is one-to-one & g is one-to-one implies g*f is one-to-one;

theorem 
  g*f is one-to-one & rng f c= dom g implies f is one-to-one;

theorem 
  g*f is one-to-one & rng f = dom g implies f is one-to-one & g is one-to-one;

theorem 
  f is one-to-one iff for g,h st rng g c= dom f & rng h c= dom f & dom g
  = dom h & f*g = f*h holds g = h;

theorem 
  dom f = X & dom g = X & rng g c= X & f is one-to-one & f*g = f implies
  g = id X;

theorem 
  rng(g*f) = rng g & g is one-to-one implies dom g c= rng f;

registration
  let X be set;
  cluster id X -> one-to-one;
end;

canceled;

theorem 
  (ex g st g*f = id dom f) implies f is one-to-one;

registration
  cluster empty -> one-to-one for Function;
end;

registration
  cluster one-to-one for Function;
end;

registration
  let f be one-to-one Function;
  cluster f~ -> Function-like;
end;

definition
  let f;
  assume
 f is one-to-one;
  func f" -> Function equals


  f~;
end;

theorem 
  f is one-to-one implies for g being Function holds g=f" iff dom
  g = rng f & for y,x holds y in rng f & x = g.y iff x in dom f & y = f.x;

theorem 
  f is one-to-one implies rng f = dom(f") & dom f = rng(f");

theorem 
  f is one-to-one & x in dom f implies x = (f").(f.x) & x = (f"*f) .x;

theorem 
  f is one-to-one & y in rng f implies y = f.((f").y) & y = (f*f") .y;

theorem 
  f is one-to-one implies dom(f"*f) = dom f & rng(f"*f) = dom f;

theorem 
  f is one-to-one implies dom(f*f") = rng f & rng(f*f") = rng f;

theorem 
  f is one-to-one & dom f = rng g & rng f = dom g & (for x,y st x in dom
  f & y in dom g holds f.x = y iff g.y = x) implies g = f";

theorem 
  f is one-to-one implies f"*f = id dom f & f*f" = id rng f;

theorem 
  f is one-to-one implies f" is one-to-one;

registration
  let f be one-to-one Function;
  cluster f" -> one-to-one;
  let g be one-to-one Function;
  cluster g*f -> one-to-one;
end;

theorem 
  f is one-to-one & rng f = dom g & g*f = id dom f implies g = f";

theorem 
  f is one-to-one & rng g = dom f & f*g = id rng f implies g = f";

theorem 
  f is one-to-one implies (f")" = f;

theorem 
  f is one-to-one & g is one-to-one implies (g*f)" = f"*g";

theorem 
  (id X)" = id X;

registration
  let f,X;
  cluster f|X -> Function-like;
end;

theorem 
  dom g = dom f /\ X & (for x st x in dom g holds g.x = f.x) implies g = f|X;

theorem 
  x in dom(f|X) implies (f|X).x = f.x;

theorem 
  x in dom f /\ X implies (f|X).x = f.x;

theorem 
  x in X implies (f|X).x = f.x;

theorem 
  x in dom f & x in X implies f.x in rng(f|X);

theorem 
  X c= Y implies (f|X)|Y = f|X & (f|Y)|X = f|X;

theorem 
  f is one-to-one implies f|X is one-to-one;

registration
  let Y,f;
  cluster Y|`f -> Function-like;
end;

theorem 
  g = Y|`f iff (for x holds x in dom g iff x in dom f & f.x in Y) &
  for x st x in dom g holds g.x = f.x;

theorem 
  x in dom(Y|`f) iff x in dom f & f.x in Y;

theorem 
  x in dom(Y|`f) implies (Y|`f).x = f.x;

theorem 
  dom(Y|`f) c= dom f;

theorem 
  X c= Y implies Y|`(X|`f) = X|`f & X|`(Y|`f) = X|`f;

theorem 
  f is one-to-one implies Y|`f is one-to-one;

definition
  let f,X;

  redefine func f.:X means


  for y holds y in it iff ex x st x in dom f & x in X & y = f.x;
end;

theorem 
  x in dom f implies Im(f,x) = {f.x};

theorem 
  x1 in dom f & x2 in dom f implies f.:{x1,x2} = {f.x1,f.x2};

theorem 
  (Y|`f).:X c= f.:X;

theorem 
  f is one-to-one implies f.:(X1 /\ X2) = f.:X1 /\ f.:X2;

theorem 
  (for X1,X2 holds f.:(X1 /\ X2) = f.:X1 /\ f.:X2) implies f is one-to-one;

theorem 
  f is one-to-one implies f.:(X1 \ X2) = f.:X1 \ f.:X2;

theorem 
  (for X1,X2 holds f.:(X1 \ X2) = f.:X1 \ f.:X2) implies f is one-to-one;

theorem 
  X misses Y & f is one-to-one implies f.:X misses f.:Y;

theorem 
  (Y|`f).:X = Y /\ f.:X;

definition
  let f,Y;
  redefine func f"Y means


  for x holds x in it iff x in dom f & f.x in Y;
end;

theorem 
  f"(Y1 /\ Y2) = f"Y1 /\ f"Y2;

theorem 
  f"(Y1 \ Y2) = f"Y1 \ f"Y2;

theorem 
  (R|X)"Y = X /\ (R"Y);

theorem 
  for f being Function, A,B being set st A misses B holds f"A misses f"B;

theorem 
  y in rng R iff R"{y} <> {};

theorem 
  (for y st y in Y holds R"{y} <> {}) implies Y c= rng R;

theorem 
  (for y st y in rng f ex x st f"{y} = {x}) iff f is one-to-one;

theorem 
  f.:(f"Y) c= Y;

theorem 
  X c= dom R implies X c= R"(R.:X);

theorem 
  Y c= rng f implies f.:(f"Y) = Y;

theorem 
  f.:(f"Y) = Y /\ f.:(dom f);

theorem 
  f.:(X /\ f"Y) c= (f.:X) /\ Y;

theorem 
  f.:(X /\ f"Y) = (f.:X) /\ Y;

theorem 
  X /\ R"Y c= R"(R.:X /\ Y);

theorem 
  f is one-to-one implies f"(f.:X) c= X;

theorem 
  (for X holds f"(f.:X) c= X) implies f is one-to-one;

theorem 
  f is one-to-one implies f.:X = (f")"X;

theorem 
  f is one-to-one implies f"Y = (f").:Y;



theorem 
  Y = rng f & dom g = Y & dom h = Y & g*f = h*f implies g = h;

theorem 
  f.:X1 c= f.:X2 & X1 c= dom f & f is one-to-one implies X1 c= X2;

theorem 
  f"Y1 c= f"Y2 & Y1 c= rng f implies Y1 c= Y2;

theorem 
  f is one-to-one iff for y ex x st f"{y} c= {x};

theorem 
  rng R c= dom S implies R"X c= (R*S)"(S.:X);

theorem 
  for f being Function st f " X = f " Y & X c= rng f & Y c= rng f holds X = Y;

begin 


reserve e,u for set,
  A for Subset of X;

theorem 
  (id X).:A = A;



definition
  let f be Function;
  redefine attr f is empty-yielding means

  for x st x in dom f holds f.x is empty;
end;



definition
  let F be Function;
  redefine attr F is non-empty means


  for n being set st n in dom F holds F.n is non empty;
end;



registration
  cluster non-empty for Function;
end;



scheme 

  LambdaB { D()->non empty set, F(set)->set } :
  ex f be Function st dom f = D() & for d be Element of D() holds f.d = F(d);



registration
  let f be non-empty Function;
  cluster rng f -> with_non-empty_elements;
end;



definition
  let f be Function;
  attr f is constant means


  x in dom f & y in dom f implies f.x = f.y;
end;

theorem 
  for A,B being set, f being Function st A c= dom f & f.:A c= B holds A c= f"B;



theorem 
  for f being Function st X c= dom f & f is one-to-one holds f"(f.:X) = X;



definition
  let f,g;
  redefine pred f = g means

  dom f = dom g & for x st x in dom f holds f.x = g.x;
end;



registration
  cluster non-empty non empty for Function;
end;



registration
  let a be non-empty non empty Function;
  let i be Element of dom a;
  cluster a.i -> non empty;
end;



registration
  let f be Function;
  cluster -> Function-like for Subset of f;
end;



theorem 
  for f,g being Function, D being set st D c= dom f & D c= dom g holds f
  | D = g | D iff for x being set st x in D holds f.x = g.x;



theorem 
  for f,g being Function, X being set st dom f = dom g & (for x being
  set st x in X holds f.x = g.x) holds f|X = g|X;



theorem 
  rng(f|{X}) c= {f.X};

theorem 
  X in dom f implies rng(f|{X}) ={f.X};



registration
  cluster empty -> constant for Function;
end;



registration
  let f be constant Function;
  cluster rng f -> trivial;
end;

registration
  cluster non constant for Function;
end;

registration
  let f be non constant Function;
  cluster rng f -> non trivial;
end;

registration
  cluster non constant -> non trivial for Function;
end;

registration
  cluster trivial -> constant for Function;
end;



theorem 
  for F,G be Function, X holds (G|(F.:X))*(F|X) = (G*F)|X;

theorem 
  for F,G be Function, X,X1 holds (G|X1)*(F|X) = (G*F)|(X /\ (F"X1));

theorem 
  for F,G be Function,X holds X c= dom (G*F) iff X c= dom F & F.:X c= dom G;



definition
  let f be Function;
  assume
 f is non empty constant;
  func the_value_of f means

  ex x being set st x in dom f & it = f.x;
end;



registration
  let X,Y;
  cluster X-defined Y-valued for Function;
end;

theorem 
  for X being set, f being X-valued Function for x being set st x in dom
  f holds f.x in X;



definition
  let IT be set;
  attr IT is functional means


  for x being set st x in IT holds x is Function;
end;

registration
  cluster empty -> functional for set;
  let f be Function;
  cluster { f } -> functional;
  let g be Function;
  cluster { f,g } -> functional;
end;

registration
  cluster non empty functional for set;
end;

registration
  let P be functional set;
  cluster -> Function-like Relation-like for Element of P;
end;

registration
  let A be functional set;
  cluster -> functional for Subset of A;
end;



definition let g,f be Function;
 attr f is g-compatible means

 x in dom f implies f.x in g.x;
end;

theorem 
  f is g-compatible & dom f = dom g implies g is non-empty;

theorem 
 {} is f-compatible;

registration
 let I be set, f be Function;
 cluster empty I-defined f-compatible for Function;
end;

registration let X be set;
 let f be Function, g be f-compatible Function;
 cluster g|X -> f-compatible;
end;

registration let I be set;
 cluster non-empty I-defined for Function;
end;

theorem 
 for g being f-compatible Function holds dom g c= dom f;

registration let X;
 let f be X-defined Function;
 cluster f-compatible -> X-defined for Function;
end;

theorem 
  for f being X-valued Function st x in dom f holds f.x is Element of X;



theorem 
  for f being Function,A being set st f is one-to-one & A c= dom f
  holds f".:(f.:A)=A;

registration
  let A be functional set, x be set;
  let F be A-valued Function;
  cluster F.x -> Function-like Relation-like;
end;



theorem 
 x in X & x in dom f implies f.x in f.:X;

theorem 
 X <> {} & X c= dom f implies f.:X <> {};

registration
  let f be non trivial Function;
  cluster dom f -> non trivial;
end;



theorem 
  for B being non empty functional set, f being Function
   st f = union B
  holds dom f = union { dom g where g is Element of B: not contradiction}
      & rng f = union { rng g where g is Element of B: not contradiction };

theorem 
 for M being set
   st for X st X in M holds X <> {}
  ex f being Function
  st dom f = M & for X st X in M holds f.X in X;

scheme 

  NonUniqBoundFuncEx { X() -> set, Y() -> set, P[set,set] }:
  ex f being Function st dom f = X() & rng f c= Y()
   & for x st x in X() holds P[x,f.x]
provided
 for x st x in X() ex y st y in Y() & P[x,y];

registration
  let f be empty-yielding Function;
  let x;
  cluster f.x -> empty;
end;















begin

reserve X,Y,p,x,x1,x2,y,y1,y2,z,z1,z2 for set;
reserve f,g,h for Function;

theorem 
  for G being set st G c= f holds G is Function;

theorem 
  f c= g iff dom f c= dom g & for x st x in dom f holds f.x = g.x;

theorem 
  dom f = dom g & f c= g implies f = g;

theorem 
  [x,z] in (g*f) implies [x,f.x] in f & [f.x,z] in g;

theorem 
  {[x,y]} is Function;

theorem 
  f = {[x,y]} implies f.x = y;

theorem 
  dom f = {x} implies f = {[x,f.x]};

theorem 
  {[x1,y1],[x2,y2]} is Function iff (x1 = x2 implies y1 = y2);

theorem 
  f is one-to-one iff for x1,x2,y st [x1,y] in f & [x2,y] in f holds x1 = x2;

theorem 
  g c= f & f is one-to-one implies g is one-to-one;

registration
  let f,X;
  cluster f /\ X -> Function-like;
end;

theorem 
  x in dom(f /\ g) implies (f /\ g).x = f.x;

theorem 
  f is one-to-one implies f /\ g is one-to-one;

theorem 
  dom f misses dom g implies f \/ g is Function;

theorem 
  f c= h & g c= h implies f \/ g is Function;

theorem 
  x in dom g & h = f \/ g implies h.x = g.x;

theorem 
  x in dom h & h = f \/ g implies h.x = f.x or h.x = g.x;

theorem 
  f is one-to-one & g is one-to-one & h = f \/ g & rng f misses rng g
  implies h is one-to-one;

canceled 2;

theorem 
  f is one-to-one implies for x,y holds [y,x] in f" iff [x,y] in f;

theorem 
  f = {} implies f" = {};

theorem 
  x in dom f & x in X iff [x,f.x] in f|X;

theorem 
  g c= f implies f|dom g = g;

theorem 
  x in dom f & f.x in Y iff [x,f.x] in Y|`f;

theorem 
  g c= f & f is one-to-one implies rng g|`f = g;

theorem 
  x in f"Y iff [x,f.x] in f & f.x in Y;

begin 


theorem 
  for X being set, f,g being Function st X c= dom f & f c= g holds f|X = g|X;



theorem 
  for f being Function, x being set st x in dom f holds f|{x} = {[ x,f.x]};



theorem 
  for f,g being Function, x being set st dom f = dom g & f.x = g.x
  holds f|{x} = g|{x};

theorem 
  for f,g being Function, x,y being set st dom f = dom g & f.x = g
  .x & f.y = g.y holds f|{x,y} = g|{x,y};

theorem 
  for f,g being Function, x,y,z being set st dom f = dom g & f.x = g.x &
  f.y = g.y & f.z = g.z holds f|{x,y,z} = g|{x,y,z};



registration
  let f be Function, A be set;
  cluster f \ A -> Function-like;
end;

theorem 
  for f, g being Function st x in dom f \ dom g holds (f \ g).x = f.x;



theorem 
  f c= g & f c= h implies g|dom f = h|dom f;



registration let f be Function, g be Subset of f;
 cluster g-compatible -> f-compatible for Function;
end;



theorem 
 g c= f implies g = f|dom g;

registration
 let f be Function, g be f-compatible Function;
 cluster -> f-compatible for Subset of g;
end;

theorem 
 g c= f & x in X & X /\ dom f c= dom g
  implies f.x = g.x;














begin

reserve X,a,b,c,x,y,z for set;
reserve P,R for Relation;

definition
  let R,X;
  pred R is_reflexive_in X means


  x in X implies [x,x] in R;
  pred R is_irreflexive_in X means


  x in X implies not [x,x] in R;
  pred R is_symmetric_in X means


  x in X & y in X & [x,y] in R implies [ y,x] in R;
  pred R is_antisymmetric_in X means


  x in X & y in X & [x,y] in R & [y, x] in R implies x = y;
  pred R is_asymmetric_in X means


  x in X & y in X & [x,y] in R implies not [y,x] in R;
  pred R is_connected_in X means


  x in X & y in X & x <>y implies [x,y] in R or [y,x] in R;
  pred R is_strongly_connected_in X means


  x in X & y in X implies [x,y] in R or [y,x] in R;
  pred R is_transitive_in X means


  x in X & y in X & z in X & [x,y] in R & [y,z] in R implies [x,z] in R;
end;

definition
  let R;
  attr R is reflexive means


  R is_reflexive_in field R;
  attr R is irreflexive means


  R is_irreflexive_in field R;
  attr R is symmetric means


  R is_symmetric_in field R;
  attr R is antisymmetric means


  R is_antisymmetric_in field R;
  attr R is asymmetric means


  R is_asymmetric_in field R;
  attr R is connected means


  R is_connected_in field R;
  attr R is strongly_connected means


  R is_strongly_connected_in field R;
  attr R is transitive means


  R is_transitive_in field R;
end;

registration
  cluster empty -> reflexive irreflexive symmetric antisymmetric asymmetric
          connected strongly_connected transitive for Relation;
end;

theorem 
  R is reflexive iff id field R c= R;

theorem 
  R is irreflexive iff id field R misses R;

theorem 
  R is_antisymmetric_in X iff R \ id X is_asymmetric_in X;

theorem 
  R is_asymmetric_in X implies R \/ id X is_antisymmetric_in X;

canceled 7;

registration
  cluster symmetric transitive -> reflexive for Relation;
end;

registration
  let X;
  cluster id X -> symmetric transitive antisymmetric;
end;

registration
  cluster irreflexive transitive -> asymmetric for Relation;
  cluster asymmetric -> irreflexive antisymmetric for Relation;
end;

registration
  let R be reflexive Relation;
  cluster R~ -> reflexive;
end;

registration
  let R be irreflexive Relation;
  cluster R~ -> irreflexive;
end;

theorem 
  R is reflexive implies dom R = dom(R~) & rng R = rng(R~);

theorem 
  R is symmetric iff R = R~;

registration
  let P,R be reflexive Relation;
  cluster P \/ R -> reflexive;
  cluster P /\ R -> reflexive;
end;

registration
  let P,R be irreflexive Relation;
  cluster P \/ R -> irreflexive;
  cluster P /\ R -> irreflexive;
end;

registration
  let P be irreflexive Relation;
  let R be Relation;
  cluster P \ R -> irreflexive;
end;

registration
  let R be symmetric Relation;
  cluster R~ -> symmetric;
end;

registration
  let P,R be symmetric Relation;
  cluster P \/ R -> symmetric;
  cluster P /\ R -> symmetric;
  cluster P \ R -> symmetric;
end;

registration
  let R be asymmetric Relation;
  cluster R~ -> asymmetric;
end;

registration
  let P be Relation;
  let R be asymmetric Relation;
  cluster P /\ R -> asymmetric;
  cluster R /\ P -> asymmetric;
end;

registration
  let P be asymmetric Relation;
  let R be Relation;
  cluster P \ R -> asymmetric;
end;

canceled 8;

theorem 
  R is antisymmetric iff R /\ (R~) c= id (dom R);

registration
  let R be antisymmetric Relation;
  cluster R~ -> antisymmetric;
end;

registration
  let P be antisymmetric Relation;
  let R be Relation;
  cluster P /\ R -> antisymmetric;
  cluster R /\ P -> antisymmetric;
  cluster P \ R -> antisymmetric;
end;

registration
  let R be transitive Relation;
  cluster R~ -> transitive;
end;

registration
  let P,R be transitive Relation;
  cluster P /\ R -> transitive;
end;

canceled 4;

theorem 
  R is transitive iff R*R c= R;

theorem 
  R is connected iff [:field R,field R:] \ id (field R) c= R \/ R~;

registration
  cluster strongly_connected -> connected reflexive for Relation;
end;

canceled;

theorem 
  R is strongly_connected iff [:field R, field R:] = R \/ R~;

theorem 
  R is transitive iff for x,y,z st [x,y] in R & [y,z] in R holds [x,z] in R;















begin

reserve X,Y,Z,X1,X2,X3,X4,X5,X6,x,y for set;

canceled 4;

theorem 
  Y in X implies not X c= Y;

definition
  let X;
  func succ X -> set equals

  X \/ { X };
end;

registration
  let X;
  cluster succ X -> non empty;
end;

theorem 
  X in succ X;

theorem 
  succ X = succ Y implies X = Y;

theorem 
  x in succ X iff x in X or x = X;

theorem 
  X <> succ X;





reserve a,b,c,X,Y,Z,x,y,z for set;

definition
  let X;
  attr X is epsilon-transitive means


  for x st x in X holds x c= X;
  attr X is epsilon-connected means


  for x,y st x in X & y in X holds x in y or x = y or y in x;
end;





definition
  let IT be set;
  attr IT is ordinal means


  IT is epsilon-transitive epsilon-connected;
end;

registration
  cluster ordinal -> epsilon-transitive epsilon-connected for set;
  cluster epsilon-transitive epsilon-connected -> ordinal for set;
end;

notation
  synonym number for set;
end;

registration
  cluster ordinal for number;
end;

definition
  mode Ordinal is ordinal number;
end;

reserve A,B,C,D for Ordinal;

theorem 
  for A,B being set, C being epsilon-transitive set st A in B & B in C
   holds A in C;

theorem 
  for x being epsilon-transitive set, A being Ordinal st x c< A holds x in A;

theorem 
  for A being epsilon-transitive set, B, C being Ordinal st A c= B & B
  in C holds A in C;

theorem 
  a in A implies a is Ordinal;

theorem 
  A in B or A = B or B in A;

definition
  let A,B;
  redefine pred A c= B means

  for C st C in A holds C in B;
  connectedness;
end;

theorem 
  A,B are_c=-comparable;

theorem 
  A c= B or B in A;

registration
  cluster empty -> ordinal for number;
end;

theorem 
  x is Ordinal implies succ x is Ordinal;

theorem 
  x is ordinal implies union x is ordinal;

registration
  cluster non empty for Ordinal;
end;

registration
  let A;
  cluster succ A -> non empty ordinal;
  cluster union A -> ordinal;
end;

theorem 
  (for x st x in X holds x is Ordinal & x c= X) implies X is ordinal;

theorem 
  X c= A & X <> {} implies ex C st C in X & for B st B in X holds C c= B;

theorem 
  A in B iff succ A c= B;

theorem 
  A in succ C iff A c= C;





scheme 

  OrdinalMin { P[Ordinal] } : ex A st P[A] & for B st P[B] holds A c= B
provided
 ex A st P[A];:$N Transfinite induction
scheme 

  TransfiniteInd { P[Ordinal] } : for A holds P[A]
provided
 for A st for C st C in A holds P[C] holds P[A];





theorem 
  for X st for a st a in X holds a is Ordinal holds union X is ordinal;

theorem 
  for X st for a st a in X holds a is Ordinal ex A st X c= A;

theorem 
  not ex X st for x holds x in X iff x is Ordinal;

theorem 
  not ex X st for A holds A in X;

theorem 
  for X ex A st not A in X & for B st not B in X holds A c= B;





definition
  let A be set;
  attr A is limit_ordinal means


  A = union A;
end;

theorem 
  for A holds A is limit_ordinal iff for C st C in A holds succ C in A;

theorem 
  not A is limit_ordinal iff ex B st A = succ B;

reserve F,G for Function;





definition
  let IT be set;
  attr IT is T-Sequence-like means


  proj1 IT is ordinal;
end;

registration
  cluster empty -> T-Sequence-like for set;
end;

definition
  mode T-Sequence is T-Sequence-like Function;
end;

registration
  let Z;
  cluster Z-valued for T-Sequence;
end;

definition
  let Z;
  mode T-Sequence of Z is Z-valued T-Sequence;
end;

theorem 
  {} is T-Sequence of Z;

reserve L,L1 for T-Sequence;

theorem 
  dom F is Ordinal implies F is T-Sequence of rng F;

registration
  let L;
  cluster dom L -> ordinal;
end;

theorem 
  X c= Y implies for L being T-Sequence of X holds L is T-Sequence of Y;

registration
  let L,A;
  cluster L|A -> rng L-valued T-Sequence-like;
end;

theorem 
  for L being T-Sequence of X for A holds L|A is T-Sequence of X;

definition

  let IT be set;
  attr IT is c=-linear means


  for x,y being set st x in IT & y in IT holds x,y are_c=-comparable;
end;

theorem 
  (for a st a in X holds a is T-Sequence) & X is c=-linear implies
  union X is T-Sequence;





scheme 

  TSUniq { A()->Ordinal, H(T-Sequence)->set, L1, L2() -> T-Sequence } : L1() =
  L2()
provided
 dom L1() = A() & for B,L st B in A() & L = L1()|B holds L1().B = H(L ) and
 dom L2() = A() & for B,L st B in A() & L = L2()|B holds L2().B = H(L );

scheme 

  TSExist { A()->Ordinal,H(T-Sequence)->set } : ex L st dom L = A() & for B,L1
  st B in A() & L1 = L|B holds L.B = H(L1);

scheme 

  FuncTS { L() -> T-Sequence, F(Ordinal)->set, H(T-Sequence)->set } : for B st
  B in dom L() holds L().B = H(L()|B)
provided
 for A,a holds a = F(A) iff ex L st a = H(L) & dom L = A & for B st B
in A holds L.B = H(L|B) and
 for A st A in dom L() holds L().A = F(A);

theorem 
  A c< B or A = B or B c< A;

begin 


definition
  let X;
  func On X -> set means


  x in it iff x in X & x is Ordinal;
  func Lim X -> set means

  x in it iff x in X & ex A st x = A & A is limit_ordinal;
end;


theorem 
  for D ex A st D in A & A is limit_ordinal;

definition
  func omega -> set means


  {} in it & it is limit_ordinal & it is
  ordinal & for A st {} in A & A is limit_ordinal holds it c= A;
end;

registration
  cluster omega -> non empty ordinal;
end;

definition
  let A be set;
  attr A is natural means


  A in omega;
end;

registration
  cluster natural for number;
end;

definition
  mode Nat is natural number;
end;

registration
 sethood of natural number;
end;



registration
  let A be Ordinal;
  cluster -> ordinal for Element of A;
end;



registration
  cluster natural -> ordinal for number;
end;



scheme 

  ALFA { D() -> non empty set, P[set,set] }: ex F st dom F = D() & for d being
  Element of D() ex A st A = F.d & P[d,A] & for B st P[d,B] holds A c= B
provided
 for d being Element of D() ex A st P[d,A];



theorem 
  succ X \ {X} = X;



registration
  cluster empty -> natural for number;
  cluster -> natural for Element of omega;
end;

registration
  cluster non empty natural for number;
end;



registration
  let a be natural Ordinal;
  cluster succ a -> natural;
end;



registration
 cluster empty -> c=-linear for set;
end;

registration let X be c=-linear set;
 cluster -> c=-linear for Subset of X;
end;















begin

reserve a,b,c,d,x,y,z,X,Y,Z for set;
reserve R,S,T for Relation;

definition
  let R,a;
  func R-Seg(a) equals

  Coim(R,a) \ {a};
end;

theorem 
  x in R-Seg a iff x <> a & [x,a] in R;

theorem 
  x in field R or R-Seg(x) = {};

definition
  let R;
  attr R is well_founded means


  for Y st Y c= field R & Y <> {} ex a st a in Y & R-Seg a misses Y;
  let X;
  pred R is_well_founded_in X means


  for Y st Y c= X & Y <> {} ex a st a in Y & R-Seg a misses Y;
end;

theorem 
  R is well_founded iff R is_well_founded_in field R;

definition
  let R;
  attr R is well-ordering means


  R is reflexive & R is transitive & R is
  antisymmetric & R is connected & R is well_founded;
  let X;
  pred R well_orders X means


  R is_reflexive_in X & R is_transitive_in X
  & R is_antisymmetric_in X & R is_connected_in X & R is_well_founded_in X;
end;

registration
  cluster well-ordering ->
          reflexive transitive antisymmetric connected well_founded
  for Relation;
  cluster reflexive transitive antisymmetric connected well_founded
          -> well-ordering for Relation;
end;

theorem 
  R well_orders field R iff R is well-ordering;

theorem 
  R well_orders X implies for Y st Y c= X & Y <> {} ex a st a in Y & for
  b st b in Y holds [a,b] in R;

theorem 
  R is well-ordering implies for Y st Y c= field R & Y <> {} ex a
  st a in Y & for b st b in Y holds [a,b] in R;

theorem 
  for R st R is well-ordering & field R <> {} ex a st a in field R & for
  b st b in field R holds [a,b] in R;

theorem 
  for R st R is well-ordering for a st a in field R holds (for b st b in
field R holds [b,a] in R) or ex b st b in field R & [a,b] in R & for c st c in
  field R & [a,c] in R holds c = a or [b,c] in R;

reserve F,G for Function;

theorem 
  R-Seg(a) c= field R;

definition
  let R,Y;
  func R |_2 Y -> Relation equals

  R /\ [:Y,Y:];
end;

theorem 
  R |_2 X = X|`R|X;

theorem 
  R |_2 X = X|`(R|X);

theorem 
  x in field(R |_2 X) implies x in field R & x in X;

theorem 
  field(R |_2 X) c= field R & field(R |_2 X) c= X;

theorem 
  (R |_2 X)-Seg(a) c= R-Seg(a);

theorem 
  R is reflexive implies R |_2 X is reflexive;

theorem 
  R is connected implies R |_2 Y is connected;

theorem 
  R is transitive implies R |_2 Y is transitive;

theorem 
  R is antisymmetric implies R |_2 Y is antisymmetric;

theorem 
  (R |_2 X) |_2 Y = R |_2 (X /\ Y);

theorem 
  (R |_2 X) |_2 Y = (R |_2 Y) |_2 X;

theorem 
  (R |_2 Y) |_2 Y = R |_2 Y;

theorem 
  Z c= Y implies (R |_2 Y) |_2 Z = R |_2 Z;

theorem 
  R |_2 field R = R;

theorem 
  R is well_founded implies R |_2 X is well_founded;

theorem 
  R is well-ordering implies R |_2 Y is well-ordering;

theorem 
  R is well-ordering implies R-Seg(a),R-Seg(b) are_c=-comparable;

theorem 
  R is well-ordering & b in R-Seg(a) implies (R |_2 (R-Seg(a)))
  -Seg(b) = R-Seg(b);

theorem 
  R is well-ordering & Y c= field R implies (Y = field R or (ex a
st a in field R & Y = R-Seg(a) ) iff for a st a in Y for b st [b,a] in R holds
  b in Y );

theorem 
  R is well-ordering & a in field R & b in field R implies ( [a,b]
  in R iff R-Seg(a) c= R-Seg(b) );

theorem 
  R is well-ordering & a in field R & b in field R implies ( R-Seg
  (a) c= R-Seg(b) iff a = b or a in R-Seg(b) );

theorem 
  R is well-ordering & X c= field R implies field(R |_2 X) = X;

theorem 
  R is well-ordering implies field(R |_2 R-Seg(a)) = R-Seg(a);

theorem 
  R is well-ordering implies for Z st for a st a in field R & R
  -Seg(a) c= Z holds a in Z holds field R c= Z;

theorem 
  R is well-ordering & a in field R & b in field R & (for c st c
  in R-Seg(a) holds [c,b] in R & c <> b) implies [a,b] in R;

theorem 
  R is well-ordering & dom F = field R & rng F c= field R & (for a
,b st [a,b] in R & a <> b holds [F.a,F.b] in R & F.a <> F.b) implies for a st a
  in field R holds [a,F.a] in R;

definition
  let R,S,F;
  pred F is_isomorphism_of R,S means


  dom F = field R & rng F = field S
& F is one-to-one & for a,b holds [a,b] in R iff a in field R & b in field R &
  [F.a,F.b] in S;
end;

theorem 
  F is_isomorphism_of R,S implies for a,b st [a,b] in R & a <> b
  holds [F.a,F.b] in S & F.a <> F.b;

definition
  let R,S;
  pred R,S are_isomorphic means


  ex F st F is_isomorphism_of R,S;
end;

theorem 
  id(field R) is_isomorphism_of R,R;

theorem 
  R,R are_isomorphic;

theorem 
  F is_isomorphism_of R,S implies F" is_isomorphism_of S,R;

theorem 
  R,S are_isomorphic implies S,R are_isomorphic;

theorem 
  F is_isomorphism_of R,S & G is_isomorphism_of S,T implies G*F
  is_isomorphism_of R,T;

theorem 
  R,S are_isomorphic & S,T are_isomorphic implies R,T are_isomorphic;

theorem 
  F is_isomorphism_of R,S implies ( R is reflexive implies S is
  reflexive ) & ( R is transitive implies S is transitive ) & ( R is connected
implies S is connected ) & ( R is antisymmetric implies S is antisymmetric ) &
  ( R is well_founded implies S is well_founded );

theorem 
  R is well-ordering & F is_isomorphism_of R,S implies S is well-ordering;

theorem 
  R is well-ordering implies for F,G st F is_isomorphism_of R,S &
  G is_isomorphism_of R,S holds F = G;

definition
  let R,S;
  assume that
 R is well-ordering and
 R,S are_isomorphic;
  func canonical_isomorphism_of(R,S) -> Function means


  it is_isomorphism_of R,S;
end;

theorem 
  R is well-ordering implies for a st a in field R holds
  not R,R |_2 (R-Seg(a)) are_isomorphic;

theorem 
  R is well-ordering & a in field R & b in field R & a <> b
  implies not R |_2 (R-Seg(a)),R |_2 (R-Seg(b)) are_isomorphic;

theorem 
  R is well-ordering & Z c= field R & F is_isomorphism_of R,S
  implies F|Z is_isomorphism_of R |_2 Z,S |_2 (F.:Z) & R |_2 Z,S |_2 (F.:Z)
  are_isomorphic;

theorem 
  F is_isomorphism_of R,S implies for a st a in field R ex b st b
  in field S & F.:(R-Seg(a)) = S-Seg(b);

theorem 
  R is well-ordering & F is_isomorphism_of R,S implies for a st a
  in field R ex b st b in field S & R |_2 (R-Seg(a)),S |_2 (S-Seg(b))
  are_isomorphic;

theorem 
  R is well-ordering & S is well-ordering & a in field R & b in
field S & c in field S & R,S |_2 (S-Seg(b)) are_isomorphic & R |_2 (R-Seg(a)),S
  |_2 (S-Seg(c)) are_isomorphic implies S-Seg(c) c= S-Seg(b) & [c,b] in S;

theorem 
  R is well-ordering & S is well-ordering implies R,S
  are_isomorphic or (ex a st a in field R & R |_2 (R-Seg(a)),S are_isomorphic )
  or ex a st a in field S & R,S |_2 (S-Seg(a)) are_isomorphic;

theorem 
  Y c= field R & R is well-ordering implies R,R |_2 Y are_isomorphic or
  ex a st a in field R & R |_2 (R-Seg(a)),R |_2 Y are_isomorphic;



theorem 
  R,S are_isomorphic & R is well-ordering implies S is well-ordering;














begin

reserve A,B,X,X1,Y,Y1,Y2,Z,a,x,y,z for set;





definition
  let X,Y;
  mode Relation of X,Y is Subset of [:X,Y:];
end;

registration
  let X,Y;
  cluster -> Relation-like for Subset of [:X,Y:];
end;

registration
  let X,Y;
  cluster -> X-defined Y-valued for Relation of X,Y;
end;

reserve P,R for Relation of X,Y;

definition
  let X,Y,R,Z;
  redefine pred R c= Z means

  for x being Element of X, y being Element of Y
  holds [x,y] in R implies [x,y] in Z;
end;

definition
  let X,Y,P,R;
  redefine pred P = R means

  for x being Element of X, y being Element of Y
  holds [x,y] in P iff [x,y] in R;
end;

theorem 
  A c= R implies A is Relation of X,Y;

theorem 
  a in R implies ex x,y st a = [x,y] & x in X & y in Y;

theorem 
  x in X & y in Y implies {[x,y]} is Relation of X,Y;

theorem 
  for R being Relation st dom R c= X & rng R c= Y holds R is Relation of X,Y;

theorem 
  dom R c= X1 implies R is Relation of X1,Y;

theorem 
  rng R c= Y1 implies R is Relation of X,Y1;

theorem 
  X c= X1 & Y c= Y1 implies R is Relation of X1,Y1;

registration
  let X;
  let R,S be X-defined Relation;
  cluster R \/ S -> X-defined;
end;

registration
  let X;
  let R be X-defined Relation, S be Relation;
  cluster R /\ S -> X-defined;
  cluster R \ S -> X-defined;
end;

registration
  let X;
  let R,S be X-valued Relation;
  cluster R \/ S -> X-valued;
end;

registration
  let X;
  let R be X-valued Relation, S be Relation;
  cluster R /\ S -> X-valued;
  cluster R \ S -> X-valued;
end;

definition let X; let R be X-defined Relation;
 redefine func dom R -> Subset of X;
end;

definition let X; let R be X-valued Relation;
 redefine func rng R -> Subset of X;
end;

theorem 
  field R c= X \/ Y;

theorem 
  (for x st x in X ex y st [x,y] in R) iff dom R = X;

theorem 
  (for y st y in Y ex x st [x,y] in R) iff rng R = Y;

definition
  let X,Y,R;
  redefine func R~ -> Relation of Y,X;
end;

definition
  let X,Y1,Y2,Z;
  let P be Relation of X,Y1;
  let R be Relation of Y2,Z;
  redefine func P*R -> Relation of X,Z;
end;

theorem 
  dom (R~) = rng R & rng (R~) = dom R;

theorem 
  {} is Relation of X,Y;

registration
  let A be empty set, B be set;
  cluster -> empty for Relation of A,B;
  cluster -> empty for Relation of B,A;
end;

theorem 
  id X c= [:X,X:];

theorem 
  id X is Relation of X,X;

theorem 
  id A c= R implies A c= dom R & A c= rng R;

theorem 
  id X c= R implies X = dom R & X c= rng R;

theorem 
  id Y c= R implies Y c= dom R & Y = rng R;

definition
  let X,Y,R,A;
  redefine func R|A -> Relation of X,Y;
end;

definition
  let X,Y,B,R;
  redefine func B|`R -> Relation of X,Y;
end;

theorem 
  R|X1 is Relation of X1,Y;

theorem 
  X c= X1 implies R|X1 = R;

theorem 
  Y1|`R is Relation of X,Y1;

theorem 
  Y c= Y1 implies Y1|`R = R;

definition
  let X,Y,R,A;
  redefine func R.:A -> Subset of Y;
  redefine func R"A -> Subset of X;
end;

theorem 
  R.:X = rng R & R"Y = dom R;

theorem 
  R.:(R"Y) = rng R & R"(R.:X) = dom R;

scheme 

  RelOnSetEx{A() -> set,B() -> set,P[set,set]}: ex R being Relation of A(),B()
  st for x,y holds [x,y] in R iff x in A() & y in B() & P[x,y];



definition
  let X;
  mode Relation of X is Relation of X,X;
end;

reserve D,D1,D2,E,F for non empty set;
reserve R for Relation of D,E;
reserve x for Element of D;
reserve y for Element of E;

registration
  let D be non empty set;
  cluster id D -> non empty;
end;

theorem 
  for x being Element of D holds x in dom R iff ex y being Element of E
  st [x,y] in R;

theorem 
  for y being set holds y in rng R iff ex x being Element of D st [x,y] in R;

theorem 
  dom R <> {} implies ex y being Element of E st y in rng R;

theorem 
  rng R <> {} implies ex x being Element of D st x in dom R;

theorem 
  for P being (Relation of D,E), R being Relation of E,F for x, z being
  set holds [x,z] in P*R iff ex y being Element of E st [x,y] in P & [y,z] in R
;

theorem 
  y in R.:D1 iff ex x being Element of D st [x,y] in R & x in D1;

theorem 
  x in R"D2 iff ex y being Element of E st [x,y] in R & y in D2;

scheme 

  RelOnDomEx{A,B() -> non empty set, P[set,set]}: ex R being Relation of A(),B
() st for x being Element of A(), y being Element of B() holds [x,y] in R iff P
  [x,y];

begin 


scheme 

  { N()-> set, M() -> Subset of N(), F(set)->set }: ex R being Relation of M()
  st for i being Element of N() st i in M() holds Im(R,i) = F(i)
provided
 for i being Element of N() st i in M() holds F(i) c= M();

theorem 
  for N being set, R,S being Relation of N st for i being set st i in N
  holds Im(R,i) = Im(S,i) holds R = S;



scheme 

  {A,B() -> set, P[set,set], P,R()->Relation of A(), B()}: P() = R()
provided
 for p being Element of A(), q being Element of B() holds [p,q] in P(
) iff P[p,q] and
 for p being Element of A(), q being Element of B() holds [p,q] in R(
) iff P[p,q];



registration
  let X,Y,Z;
  let f be Relation of [:X,Y:], Z;
  cluster dom f -> Relation-like;
end;

registration
  let X,Y,Z;
  let f be Relation of X, [:Y, Z:];
  cluster rng f -> Relation-like;
end;



theorem 
  A misses X implies P|A = {};



registration
  let R be non empty Relation, Y be non empty Subset of dom R;
  cluster R|Y -> non empty;
end;

registration
  let R be non empty Relation;
  let Y be non empty Subset of dom R;
  cluster R.:Y -> non empty;
end;



registration
  let X,Y be set;
  cluster empty for Relation of X,Y;
end;














begin

reserve x,x1,x2,y,y9,y1,y2,z,z1,z2,P,X,X1,X2,Y,Y1,Y2,V,Z for set;



theorem 
  for f,g being Function st for x st x in dom f /\ dom g holds f.x
  = g.x ex h being Function st f \/ g = h;

theorem 
  for f,g,h being Function st f \/ g = h for x st x in dom f /\ dom
  g holds f.x = g.x;

scheme 

  LambdaC{A()->set,C[set],F(set)->set,G(set)->set}:
   ex f being Function st dom f = A() &
    for x st x in A() holds (C[x] implies f.x = F(x)) &
    (not C[x] implies f.x = G(x));

registration
  let X,Y;
  cluster Function-like for Relation of X,Y;
end;

definition
  let X,Y;
  mode PartFunc of X,Y is Function-like Relation of X,Y;
end;

theorem 
  for f being PartFunc of X,Y st y in rng f ex x being Element of X st x
  in dom f & y = f.x;

theorem 
  for f being Y-valued Function st x in dom f holds f.x in Y;

theorem 
  for f1,f2 being PartFunc of X,Y st dom f1 = dom f2 & for x being
  Element of X st x in dom f1 holds f1.x = f2.x holds f1 = f2;

scheme 

  PartFuncEx{X,Y()->set,P[set,set]}: ex f being PartFunc of X(),Y() st (for x
holds x in dom f iff x in X() & ex y st P[x,y]) & for x st x in dom f holds P[x
  ,f.x]
provided
 for x,y st x in X() & P[x,y] holds y in Y() and
 for x,y1,y2 st x in X() & P[x,y1] & P[x,y2] holds y1 = y2;

scheme 

  LambdaR{X,Y()->set,F(set)->set,P[set]}: ex f being PartFunc of X(),Y() st (
for x holds x in dom f iff x in X() & P[x]) & for x st x in dom f holds f.x = F
  (x)
provided
 for x st P[x] holds F(x) in Y();

definition
  let X,Y,V,Z;
  let f be PartFunc of X,Y;
  let g be PartFunc of V,Z;
  redefine func g*f -> PartFunc of X,Z;
end;

theorem 
  for f being Relation of X,Y holds (id X)*f = f;

theorem 
  for f being Relation of X,Y holds f*(id Y) = f;

theorem 
  for f being PartFunc of X,Y st (for x1,x2 being Element of X st x1 in
  dom f & x2 in dom f & f.x1 = f.x2 holds x1 = x2) holds f is one-to-one;

theorem 
  for f being PartFunc of X,Y st f is one-to-one holds f" is PartFunc of Y,X;

theorem 
  for f being PartFunc of X,Y holds f|Z is PartFunc of Z,Y;

theorem 
  for f being PartFunc of X,Y holds f|Z is PartFunc of X,Y;

definition
  let X,Y;
  let f be PartFunc of X,Y;
  let Z be set;
  redefine func f|Z -> PartFunc of X,Y;
end;

theorem 
  for f being PartFunc of X,Y holds Z|`f is PartFunc of X,Z;

theorem 
  for f being PartFunc of X,Y holds Z|`f is PartFunc of X,Y;

theorem 
  for f being Function holds Y|`f|X is PartFunc of X,Y;

theorem 
  for f being PartFunc of X,Y st y in f.:X ex x being Element of X st x
  in dom f & y = f.x;



theorem 
  for f being PartFunc of {x},Y holds rng f c= {f.x};

theorem 
  for f being PartFunc of {x},Y holds f is one-to-one;

theorem 
  for f being PartFunc of {x},Y holds f.:P c= {f.x};

theorem 
  for f being Function st dom f = {x} & x in X & f.x in Y holds f is
  PartFunc of X,Y;



theorem 
  for f being PartFunc of X,{y} st x in dom f holds f.x = y;

theorem 
  for f1,f2 being PartFunc of X,{y} st dom f1 = dom f2 holds f1 = f2;



definition
  let f be Function;
  let X,Y be set;

  func <:f,X,Y:> -> PartFunc of X,Y equals

  Y|`f|X;
end;

theorem 
  for f being Function holds <:f,X,Y:> c= f;

theorem 
  for f being Function holds dom <:f,X,Y:> c= dom f & rng <:f,X,Y :> c= rng f;

theorem 
  for f being Function holds x in dom <:f,X,Y:> iff x in dom f & x
  in X & f.x in Y;

theorem 
  for f being Function st x in dom f & x in X & f.x in Y holds <:f
  ,X,Y:>.x = f.x;

theorem 
  for f being Function st x in dom <:f,X,Y:> holds <:f,X,Y:>.x = f .x;

theorem 
  for f,g being Function st f c= g holds <:f,X,Y:> c= <:g,X,Y:>;

theorem 
  for f being Function st Z c= X holds <:f,Z,Y:> c= <:f,X,Y:>;

theorem 
  for f being Function st Z c= Y holds <:f,X,Z:> c= <:f,X,Y:>;

theorem 
  for f being Function st X1 c= X2 & Y1 c= Y2 holds <:f,X1,Y1:> c= <:f, X2,Y2:>
;

theorem 
  for f being Function st dom f c= X & rng f c= Y holds f = <:f,X, Y:>;

theorem 
  for f being Function holds f = <:f,dom f,rng f:>;

theorem 
  for f being PartFunc of X,Y holds <:f,X,Y:> = f;

theorem 
  <:{},X,Y:> = {};

theorem 
  for f,g being Function holds (<:g,Y,Z:>*<:f,X,Y:>) c= <:g*f,X,Z :>;

theorem 
  for f,g being Function st rng f /\ dom g c= Y holds <:g,Y,Z:>*<:f,X,Y
  :> = <:g*f,X,Z:>;

theorem 
  for f being Function st f is one-to-one holds <:f,X,Y:> is one-to-one;

theorem 
  for f being Function st f is one-to-one holds <:f,X,Y:>" = <:f",Y,X:>;

theorem 
  for f being Function holds Z|`<:f,X,Y:> = <:f,X,Z /\ Y:>;



definition
  let X;
  let f be X-defined Relation;
  attr f is total means


  dom f = X;
end;

registration
  let X be empty set, Y be set;
  cluster -> total for Relation of X,Y;
end;

registration
  let X be non empty set, Y be empty set;
  cluster -> non total for Relation of X,Y;
end;

theorem 
  for f being Function st <:f,X,Y:> is total holds X c= dom f;

theorem 
  <:{},X,Y:> is total implies X = {};

theorem 
  for f being Function st X c= dom f & rng f c= Y holds <:f,X,Y:> is total;

theorem 
  for f being Function st <:f,X,Y:> is total holds f.:X c= Y;

theorem 
  for f being Function st X c= dom f & f.:X c= Y holds <:f,X,Y:> is total;



definition
  let X,Y;
  func PFuncs(X,Y) -> set means


  x in it iff ex f being Function st x = f & dom f c= X & rng f c= Y;
end;

registration
  let X,Y;
  cluster PFuncs(X,Y) -> non empty;
end;

theorem 
  for f being PartFunc of X,Y holds f in PFuncs(X,Y);

theorem 
  for f being set st f in PFuncs(X,Y) holds f is PartFunc of X,Y;

theorem 
  for f being Element of PFuncs(X,Y) holds f is PartFunc of X,Y;

theorem 
  PFuncs({},Y) = { {} };

theorem 
  PFuncs(X,{}) = { {} };

theorem 
  X1 c= X2 & Y1 c= Y2 implies PFuncs(X1,Y1) c= PFuncs(X2,Y2);



definition
  let f,g be Function;
  pred f tolerates g means


  for x st x in dom f /\ dom g holds f.x = g.x;
  reflexivity;
  symmetry;
end;

theorem 
  for f,g being Function holds f tolerates g iff ex h being
  Function st f \/ g = h;

theorem 
  for f,g being Function holds f tolerates g iff ex h being
  Function st f c= h & g c= h;

theorem 
  for f,g being Function st dom f c= dom g holds f tolerates g
  iff for x st x in dom f holds f.x = g.x;

theorem 
  for f,g being Function st f c= g holds f tolerates g;

theorem 
  for f,g being Function st dom f = dom g & f tolerates g holds f = g;

theorem 
  for f,g being Function st dom f misses dom g holds f tolerates g;

theorem 
  for f,g,h being Function st f c= h & g c= h holds f tolerates g;

theorem 
  for f,g being PartFunc of X,Y for h being Function st f tolerates h &
  g c= f holds g tolerates h;

theorem 
  for f being Function holds {} tolerates f;

theorem 
  for f being Function holds <:{},X,Y:> tolerates f;

theorem 
  for f,g being PartFunc of X,{y} holds f tolerates g;

theorem 
  for f being Function holds f|X tolerates f;

theorem 
  for f being Function holds Y|`f tolerates f;

theorem 
  for f being Function holds Y|`f|X tolerates f;

theorem 
  for f being Function holds <:f,X,Y:> tolerates f;

theorem 
  for f,g being PartFunc of X,Y st f is total & g is total & f
  tolerates g holds f = g;

theorem 
  for f,g,h being PartFunc of X,Y st f tolerates h & g tolerates
  h & h is total holds f tolerates g;

theorem 
  for f,g being PartFunc of X,Y st (Y = {} implies X = {}) & f
  tolerates g ex h being PartFunc of X,Y st h is total & f tolerates h & g
  tolerates h;

definition
  let X,Y;
  let f be PartFunc of X,Y;
  func TotFuncs f -> set means


  x in it iff ex g being PartFunc of X,Y st g = x & g is total & f tolerates g;
end;

theorem 
  for f being PartFunc of X,Y for g being set st g in TotFuncs(f)
  holds g is PartFunc of X,Y;

theorem 
  for f,g being PartFunc of X,Y st g in TotFuncs(f) holds g is total;

theorem 
  for f being PartFunc of X,Y for g being Function st g in
  TotFuncs(f) holds f tolerates g;

registration
  let X be non empty set, Y be empty set;
  let f be PartFunc of X,Y;
  cluster TotFuncs f -> empty;
end;

theorem 
  for f being PartFunc of X,Y holds f is total iff TotFuncs f = { f};

theorem 
  for f being PartFunc of {},Y holds TotFuncs f = {f};

theorem 
  for f being PartFunc of {},Y holds TotFuncs f = {{}};

theorem 
  for f,g being PartFunc of X,Y st TotFuncs f meets TotFuncs g holds f
  tolerates g;

theorem 
  for f,g being PartFunc of X,Y st (Y = {} implies X = {}) & f tolerates
  g holds TotFuncs f meets TotFuncs g;

begin

registration
  let X;
  cluster total reflexive symmetric antisymmetric transitive for Relation of X;
end;

registration
  cluster symmetric transitive -> reflexive for Relation;
end;

registration
  let X;
  cluster id X -> symmetric antisymmetric transitive;
end;

definition
  let X;
  redefine func id X -> total Relation of X;
end;

scheme 

  LambdaC9{ A() -> non empty set, C[set], F,G(set) -> set } :
   ex f being Function st dom f = A() &
    for x be Element of A() holds
     (C[x] implies f.x = F(x)) & (not C[x] implies f.x = G(x));

begin 


reserve A for set,
  f,g,h for Function;

theorem 
  f tolerates g & [x,y] in f & [x,z] in g implies y = z;

theorem 
  A is functional & (for f,g being Function st f in A & g in A holds f
  tolerates g) implies union A is Function;



definition
  let D be set, p be D-valued Function, i be set;
  assume
 i in dom p;
  func p/.i -> Element of D equals

 p.i;
end;



registration
  let X,Y be non empty set;
  cluster non empty for PartFunc of X,Y;
end;



registration
  let A, B be set;
  cluster PFuncs(A,B) -> functional;
end;



theorem 
  for f1,f2, g being Function st rng g c= dom f1 & rng g c= dom f2
  & f1 tolerates f2 holds f1*g = f2*g;



theorem 
 for f being Y-valued Function st x in dom(f|X)
  holds  (f|X)/.x = f/.x;














begin

reserve v,x,x1,x2,x3,x4,y,y1,y2,y3,y4,z,z1,z2, X,X1,X2,X3,X4,Y,Y1,Y2,Y3,Y4,Y5,
  Z,Z1,Z2,Z3,Z4,Z5 for set;

reserve p for pair set;









canceled 6;

theorem 
  [x,y]`1=x & [x,y]`2=y;

theorem 
  [p`1,p`2] = p;

theorem 
  X <> {} implies ex v st v in X & not ex x,y st (x in X or y in X) & v
  = [x,y];




theorem 
  z in [:X,Y:] implies z`1 in X & z`2 in Y;

theorem 
  (ex x,y st z=[x,y]) & z`1 in X & z`2 in Y implies z in [:X,Y:];

theorem 
  z in [:{x},Y:] implies z`1=x & z`2 in Y;

theorem 
  z in [:X,{y}:] implies z`1 in X & z`2 = y;

theorem 
  z in [:{x},{y}:] implies z`1 = x & z`2 = y;

theorem 
  z in [:{x1,x2},Y:] implies (z`1=x1 or z`1=x2) & z`2 in Y;

theorem 
  z in [:X,{y1,y2}:] implies z`1 in X & (z`2 = y1 or z`2 = y2);

theorem 
  z in [:{x1,x2},{y}:] implies (z`1=x1 or z`1=x2) & z`2 = y;

theorem 
  z in [:{x},{y1,y2}:] implies z`1 = x & (z`2 = y1 or z`2 = y2);

theorem 
  z in [:{x1,x2},{y1,y2}:] implies (z`1 = x1 or z`1 = x2) & (z`2 = y1 or
  z`2 = y2);

theorem 
  (ex y,z st x = [y,z]) implies x <> x`1 & x <> x`2;




reserve R for Relation;

theorem 
  x in R implies x = [x`1,x`2];

theorem 
  X <> {} & Y <> {} implies for x being Element of [:X,Y:] holds x
  = [x`1,x`2];

theorem 
  [:{x1,x2},{y1,y2}:] = {[x1,y1],[x1,y2],[x2,y1],[x2,y2]};

theorem 
  X <> {} & Y <> {} implies for x being Element of [:X,Y:] holds x
  <> x`1 & x <> x`2;





canceled;

theorem 
  X <> {} implies ex v st v in X & not ex x,y,z st (x in X or y in
  X) & v = [x,y,z];





canceled 3;

theorem 
  X <> {} implies ex v st v in X & not ex x1,x2,x3,x4 st (x1 in X
  or x2 in X) & v = [x1,x2,x3,x4];





theorem 
  X1 <> {} & X2 <> {} & X3 <> {} iff [:X1,X2,X3:] <> {};

reserve xx1 for Element of X1,
  xx2 for Element of X2,
  xx3 for Element of X3;

theorem 
  X1<>{} & X2<>{} & X3<>{} implies ( [:X1,X2,X3:] = [:Y1,Y2,Y3:]
  implies X1=Y1 & X2=Y2 & X3=Y3);

theorem 
  [:X1,X2,X3:]<>{} & [:X1,X2,X3:] = [:Y1,Y2,Y3:] implies X1=Y1 & X2=Y2 &
  X3=Y3;

theorem 
  [:X,X,X:] = [:Y,Y,Y:] implies X = Y;

theorem 
  [:{x1},{x2},{x3}:] = { [x1,x2,x3] };

theorem 
  [:{x1,y1},{x2},{x3}:] = { [x1,x2,x3],[y1,x2,x3] };

theorem 
  [:{x1},{x2,y2},{x3}:] = { [x1,x2,x3],[x1,y2,x3] };

theorem 
  [:{x1},{x2},{x3,y3}:] = { [x1,x2,x3],[x1,x2,y3] };

theorem 
  [:{x1,y1},{x2,y2},{x3}:] = { [x1,x2,x3],[y1,x2,x3],[x1,y2,x3],[y1,y2,
  x3] };

theorem 
  [:{x1,y1},{x2},{x3,y3}:] = { [x1,x2,x3],[y1,x2,x3],[x1,x2,y3],[y1,x2,
  y3] };

theorem 
  [:{x1},{x2,y2},{x3,y3}:] = { [x1,x2,x3],[x1,y2,x3],[x1,x2,y3],[x1,y2,
  y3] };

theorem 
  [:{x1,y1},{x2,y2},{x3,y3}:] = { [x1,x2,x3],[x1,y2,x3],[x1,x2,y3],[x1,
  y2,y3], [y1,x2,x3],[y1,y2,x3],[y1,x2,y3],[y1,y2,y3] };

registration
 let X1,X2,X3 be non empty set;
 cluster -> triple for Element of [:X1,X2,X3:];
end;

definition
 canceled 4;
  let X1,X2,X3 be non empty set;
  let x be Element of [:X1,X2,X3:];
  redefine func x`1_3 -> Element of X1 means


  x = [x1,x2,x3] implies it = x1;
  redefine func x`2_3 -> Element of X2 means


  x = [x1,x2,x3] implies it = x2;
  redefine func x`3_3 -> Element of X3 means


  x = [x1,x2,x3] implies it = x3;
end;

canceled;

theorem 
 for X1,X2,X3 being non empty set
  for x being Element of [:X1,X2,
  X3:] holds x = [x`1_3,x`2_3,x`3_3];

theorem 
  X c= [:X,Y,Z:] or X c= [:Y,Z,X:] or X c= [:Z,X,Y:] implies X =
  {};

canceled;

theorem 
 for X1,X2,X3 being non empty set
 for x being Element of [:X1,X2,X3:]
   holds x <> x`1_3 & x <> x`2_3 & x <> x`3_3;

theorem 
  [:X1,X2,X3:] meets [:Y1,Y2,Y3:] implies X1 meets Y1 & X2 meets Y2 & X3
  meets Y3;





theorem 
  [:X1,X2,X3,X4:] = [:[:[:X1,X2:],X3:],X4:];

theorem 
  [:[:X1,X2:],X3,X4:] = [:X1,X2,X3,X4:];

theorem 
  X1 <> {} & X2 <> {} & X3 <> {} & X4 <> {} iff [:X1,X2,X3,X4:] <>
  {};

theorem 
  X1<>{} & X2<>{} & X3<>{} & X4<>{} & [:X1,X2,X3,X4:] = [:Y1,Y2,Y3
  ,Y4:] implies X1=Y1 & X2=Y2 & X3=Y3 & X4=Y4;

theorem 
  [:X1,X2,X3,X4:]<>{} & [:X1,X2,X3,X4:] = [:Y1,Y2,Y3,Y4:] implies X1=Y1
  & X2=Y2 & X3=Y3 & X4=Y4;

theorem 
  [:X,X,X,X:] = [:Y,Y,Y,Y:] implies X = Y;

reserve xx4 for Element of X4;

registration
 let X1,X2,X3,X4 be non empty set;
 cluster -> quadruple for Element of [:X1,X2,X3,X4:];
end;

definition
  let X1,X2,X3,X4 be non empty set;
  let x be Element of [:X1,X2,X3,X4:];
  redefine func x`1_4 -> Element of X1 means


  x = [x1,x2,x3,x4] implies it = x1;
  redefine func x`2_4 -> Element of X2 means


  x = [x1,x2,x3,x4] implies it = x2;
  redefine func x`3_4 -> Element of X3 means


  x = [x1,x2,x3,x4] implies it = x3;
  redefine func x`4_4 -> Element of X4 means


  x = [x1,x2,x3,x4] implies it = x4;
end;

canceled;

theorem 
 for X1,X2,X3,X4 being non empty set
 for x being Element of
  [:X1,X2,X3,X4:] holds x = [x`1_4,x`2_4,x`3_4,x`4_4];

canceled;

theorem 
 for X1,X2,X3,X4 being non empty set
 for x being Element of [:X1,X2,X3,X4:]
  holds x <> x`1_4 & x <> x`2_4 & x <> x`3_4 & x <> x`4_4;

theorem 
  X1 c= [:X1,X2,X3,X4:] or X1 c= [:X2,X3,X4,X1:] or X1 c= [:X3,X4,X1,X2
  :] or X1 c= [:X4,X1,X2,X3:] implies X1 = {};

theorem 
  [:X1,X2,X3,X4:] meets [:Y1,Y2,Y3,Y4:] implies X1 meets Y1 & X2 meets
  Y2 & X3 meets Y3 & X4 meets Y4;

theorem 
  [:{x1},{x2},{x3},{x4}:] = { [x1,x2,x3,x4] };



theorem 
  [:X,Y:] <> {} implies for x being Element of [:X,Y:] holds x <>
  x`1 & x <> x`2;

theorem 
  x in [:X,Y:] implies x <> x`1 & x <> x`2;



reserve A1 for Subset of X1,
  A2 for Subset of X2,
  A3 for Subset of X3,
  A4 for Subset of X4;

reserve x for Element of [:X1,X2,X3:];

theorem 
 for X1,X2,X3 being non empty set
 for x being Element of [:X1,X2,X3:]
 for x1,x2,x3 st x = [x1,x2,x3] holds
  x`1_3 = x1 & x`2_3 = x2 & x`3_3 = x3;

theorem 
 for X1,X2,X3 being non empty set
 for x being Element of [:X1,X2,X3:]
  st for xx1 being Element of X1,xx2 being Element of X2,
             xx3 being Element of X3 st x = [xx1,xx2,xx3] holds y1 = xx1
 holds y1 =x`1_3;

theorem 
 for X1,X2,X3 being non empty set
 for x being Element of [:X1,X2,X3:]
  st for xx1 being Element of X1,xx2 being Element of X2,
             xx3 being Element of X3 st x = [xx1,xx2,xx3] holds  y2 = xx2
 holds y2 =x`2_3;

theorem 
 for X1,X2,X3 being non empty set
 for x being Element of [:X1,X2,X3:]
  st for xx1 being Element of X1,xx2 being Element of X2,
             xx3 being Element of X3 st x = [xx1,xx2,xx3] holds y3 = xx3
 holds y3 =x`3_3;

theorem 
  z in [: X1,X2,X3 :] implies ex x1,x2,x3 st x1 in X1 & x2 in X2 &
  x3 in X3 & z = [x1,x2,x3];

theorem 
  [x1,x2,x3] in [: X1,X2,X3 :] iff x1 in X1 & x2 in X2 & x3 in X3;

theorem 
  (for z holds z in Z iff ex x1,x2,x3 st x1 in X1 & x2 in X2 & x3 in X3
  & z = [x1,x2,x3]) implies Z = [: X1,X2,X3 :];

canceled;

theorem 
 for X1,X2,X3 being non empty set
 for A1 being non empty Subset of X1, A2 being non empty Subset of X2,
     A3 being non empty Subset of X3
  for x being Element of [:X1,X2,X3:] st x in [:A1,A2,A3:]
   holds x`1_3 in A1 & x`2_3 in A2 & x`3_3 in A3;

theorem 
  X1 c= Y1 & X2 c= Y2 & X3 c= Y3 implies [:X1,X2,X3:] c= [:Y1,Y2,
  Y3:];



reserve x for Element of [:X1,X2,X3,X4:];

theorem 
 for X1,X2,X3,X4 being non empty set
 for x being Element of [:X1,X2,X3,X4:]
 for x1,x2,x3,x4 being set st x = [x1,
  x2,x3,x4] holds x`1_4 = x1 & x`2_4 = x2 & x`3_4 = x3 & x`4_4 = x4;

theorem 
 for X1,X2,X3,X4 being non empty set
 for x being Element of [:X1,X2,X3,X4:]
 st for xx1 being Element of X1,
             xx2 being Element of X2,
             xx3 being Element of X3,
             xx4 being Element of X4 st x = [xx1,xx2,xx3,xx4] holds y1 = xx1
 holds y1 =x`1_4;

theorem 
 for X1,X2,X3,X4 being non empty set
 for x being Element of [:X1,X2,X3,X4:]
 st for xx1 being Element of X1,
             xx2 being Element of X2,
             xx3 being Element of X3,
             xx4 being Element of X4 st x = [xx1,
  xx2,xx3,xx4] holds y2 = xx2
 holds y2 =x`2_4;

theorem 
 for X1,X2,X3,X4 being non empty set
 for x being Element of [:X1,X2,X3,X4:]
 st for xx1 being Element of X1,
             xx2 being Element of X2,
             xx3 being Element of X3,
             xx4 being Element of X4 st x = [xx1,
  xx2,xx3,xx4] holds y3 = xx3
 holds y3 =x`3_4;

theorem 
 for X1,X2,X3,X4 being non empty set
 for x being Element of [:X1,X2,X3,X4:]
  st for xx1 being Element of X1,
             xx2 being Element of X2,
             xx3 being Element of X3,
             xx4 being Element of X4 st x = [xx1,
  xx2,xx3,xx4] holds y4 = xx4
 holds y4 =x`4_4;

theorem 
  z in [: X1,X2,X3,X4 :] implies ex x1,x2,x3,x4 st x1 in X1 & x2 in X2 &
  x3 in X3 & x4 in X4 & z = [x1,x2,x3,x4];

theorem 
  [x1,x2,x3,x4] in [: X1,X2,X3,X4 :] iff x1 in X1 & x2 in X2 & x3 in X3
  & x4 in X4;

theorem 
  (for z holds z in Z iff ex x1,x2,x3,x4 st x1 in X1 & x2 in X2 & x3 in
  X3 & x4 in X4 & z = [x1,x2,x3,x4]) implies Z = [: X1,X2,X3,X4 :];

canceled;

theorem 
 for X1,X2,X3,X4 being non empty set,
     A1 being non empty Subset of X1, A2 being non empty Subset of X2,
     A3 being non empty Subset of X3, A4 being non empty Subset of X4
  for x being Element of [:X1,X2,X3,X4:] st x in [:A1,A2,A3,A4:]
  holds x`1_4 in A1 & x`2_4 in A2 & x`3_4 in A3 & x`4_4 in A4;

theorem 
  X1 c= Y1 & X2 c= Y2 & X3 c= Y3 & X4 c= Y4
   implies [:X1,X2,X3,X4:] c= [:Y1,Y2,Y3,Y4:];

definition
  let X1,X2,A1,A2;
  redefine func [:A1,A2:] -> Subset of [:X1,X2:];
end;

definition
  let X1,X2,X3,A1,A2,A3;
  redefine func [:A1,A2,A3:] -> Subset of [:X1,X2,X3:];
end;

definition
  let X1,X2,X3,X4,A1,A2,A3,A4;
  redefine func [:A1,A2,A3,A4:] -> Subset of [:X1,X2,X3,X4:];
end;

begin 



definition
  let f be Function;
  func pr1 f -> Function means

  dom it = dom f & for x being set st x in dom f
  holds it.x = (f.x)`1;
  func pr2 f -> Function means

  dom it = dom f & for x being set st x in dom f
  holds it.x = (f.x)`2;
end;

definition
  let x be set;
  func x`11 equals

  x`1`1;
  func x`12 equals

  x`1`2;
  func x`21 equals

  x`2`1;
  func x`22 equals

  x`2`2;
end;

reserve x for set;

theorem 
  [[x1,x2],y]`11 = x1 & [[x1,x2],y]`12 = x2 & [x,[y1,y2]]`21 = y1 & [x,[
  y1,y2]]`22 = y2;



theorem 
  x in R implies x`1 in dom R & x`2 in rng R;



theorem 
 for R being non empty Relation, x being set
  holds Im(R,x) = { I`2 where I is Element of R: I`1 = x };

theorem 
 x in R implies x`2 in Im(R,x`1);

theorem 
 x in R & y in R & x`1 = y`1 & x`2 = y`2 implies x = y;

theorem 
 for R being non empty Relation, x,y being Element of R
   st x`1 = y`1 & x`2 = y`2
 holds x = y;



theorem 
   proj1 proj1 {[x1,x2,x3],[y1,y2,y3]} = {x1,y1};

theorem 
   proj1 proj1 {[x1,x2,x3]} = {x1};

scheme 

  BiFuncEx{A()->set,B()->set,C()->set,P[set,set,set]}: ex f,g being Function
  st dom f = A() & dom g = A() & for x st x in A() holds P[x,f.x,g.x]
provided
 x in A() implies ex y,z st y in B() & z in C() & P[x,y,z];















begin

reserve X,Y,Z for set,
  a,b,c,d,x,y,z,u for set,
  R for Relation,
  A,B,C for Ordinal;

definition
  let X;
  func RelIncl X -> Relation means


  field it = X & for Y,Z st Y in X & Z in X holds [Y,Z] in it iff Y c= Z;
end;

canceled 6;

registration
  let X;
  cluster RelIncl X -> reflexive;
  cluster RelIncl X -> transitive;
  cluster RelIncl X -> antisymmetric;
end;

registration
  let A;
  cluster RelIncl A -> connected;
  cluster RelIncl A -> well_founded;
end;

theorem 
  Y c= X implies (RelIncl X) |_2 Y = RelIncl Y;

theorem 
  for A,X st X c= A holds RelIncl X is well-ordering;

reserve H for Function;

theorem 
  A in B implies A = (RelIncl B)-Seg(A);

theorem 
  RelIncl A,RelIncl B are_isomorphic implies A = B;

theorem 
  R,RelIncl A are_isomorphic & R,RelIncl B are_isomorphic implies A = B;

theorem 
  for R st R is well-ordering & for a st a in field R ex A st R
  |_2 (R-Seg(a)),RelIncl A are_isomorphic ex A st R,RelIncl A are_isomorphic;

theorem 
  for R st R is well-ordering ex A st R,RelIncl A are_isomorphic;

definition
  let R;
  assume
 R is well-ordering;
  func order_type_of R -> Ordinal means


  R,RelIncl it are_isomorphic;
end;

definition
  let A,R;
  pred A is_order_type_of R means

  A = order_type_of R;
end;

theorem 
  X c= A implies order_type_of RelIncl X c= A;

reserve f,g for Function;

definition
  let X,Y;
  redefine pred X,Y are_equipotent means

  ex f st f is one-to-one & dom f = X & rng f = Y;
  reflexivity;
  symmetry;
end;

theorem 
  X,Y are_equipotent & Y,Z are_equipotent implies X,Z are_equipotent;

theorem 
  R well_orders X implies field(R|_2 X) = X & R|_2 X is well-ordering;
:$N Zermelo Theorem
theorem 
  for X ex R st R well_orders X;

reserve M for non empty set;


theorem 
  (for X st X in M holds X <> {}) & (for X,Y st X in M & Y in M & X <> Y
holds X misses Y) implies ex Choice being set st for X st X in M ex x st Choice
  /\ X = { x };

begin 

theorem 
  for X being set holds RelIncl X is_reflexive_in X;

theorem 
  for X being set holds RelIncl X is_transitive_in X;

theorem 
  for X being set holds RelIncl X is_antisymmetric_in X;



registration
  cluster RelIncl {} -> empty;
end;

registration
  let X be non empty set;
  cluster RelIncl X -> non empty;
end;

theorem 
  RelIncl {x} = {[x,x]};

theorem 
  RelIncl X c= [:X,X:];














begin 

reserve P,Q,X,Y,Z,p,x,x9,x1,x2,y,z for set;

definition
  let X,Y;
  let R be Relation of X,Y;
  attr R is quasi_total means


  X = dom R if Y <> {} otherwise R = {};
end;

registration
  let X,Y;
  cluster quasi_total for PartFunc of X,Y;
end;

registration
  let X,Y;
  cluster total -> quasi_total for Relation of X,Y;
end;

definition
  let X,Y;
  mode Function of X,Y is quasi_total PartFunc of X,Y;
end;

registration let X be empty set, Y be set;
 cluster quasi_total -> total for Relation of X,Y;
end;

registration let X be set, Y be non empty set;
 cluster quasi_total -> total for Relation of X,Y;
end;

registration let X be set;
 cluster quasi_total -> total for Relation of X,X;
end;

theorem 
  for f being Function holds f is Function of dom f, rng f;

theorem 
  for f being Function st rng f c= Y holds f is Function of dom f, Y;

theorem 
  for f being Function st dom f = X & for x st x in X holds f.x in Y
  holds f is Function of X,Y;

theorem 
  for f being Function of X,Y st Y <> {} & x in X holds f.x in rng f;

theorem 
  for f being Function of X,Y st Y <> {} & x in X holds f.x in Y;

theorem 
  for f being Function of X,Y st (Y = {} implies X = {}) & rng f c= Z
  holds f is Function of X,Z;

theorem 
  for f being Function of X,Y st (Y = {} implies X = {}) & Y c= Z holds
  f is Function of X,Z;

scheme 

  FuncEx1{X, Y() -> set, P[set,set]}: ex f being Function of X(),Y() st for x
  st x in X() holds P[x,f.x]
provided
 for x st x in X() ex y st y in Y() & P[x,y];

scheme 

  Lambda1{X, Y() -> set, F(set)->set}: ex f being Function of X(),Y() st for x
  st x in X() holds f.x = F(x)
provided
 for x st x in X() holds F(x) in Y();

definition
  let X,Y;
  func Funcs(X,Y) -> set means


  x in it iff ex f being Function st x = f & dom f = X & rng f c= Y;
end;

theorem 
  for f being Function of X,Y st Y = {} implies X = {} holds f in Funcs(X,Y);

theorem 
  for f being Function of X,X holds f in Funcs(X,X);

registration
  let X be set, Y be non empty set;
  cluster Funcs(X,Y) -> non empty;
end;

registration
  let X be set;
  cluster Funcs(X,X) -> non empty;
end;

registration
  let X be non empty set, Y be empty set;
  cluster Funcs(X,Y) -> empty;
end;

theorem 
  for f being Function of X,Y st for y st y in Y ex x st x in X & y = f.x
  holds rng f = Y;

theorem 
  for f being Function of X,Y st y in rng f ex x st x in X & f.x = y;

theorem 
  for f1,f2 being Function of X,Y st for x st x in X holds f1.x = f2.x
  holds f1 = f2;

theorem 
  for f being quasi_total Relation of X,Y for g being quasi_total
  Relation of Y,Z st Y = {} implies Z = {} or X = {} holds f*g is quasi_total;

theorem 
  for f being Function of X,Y for g being Function of Y,Z st Z <> {} &
  rng f = Y & rng g = Z holds rng(g*f) = Z;

theorem 
  for f being Function of X,Y, g being Function st Y <> {} & x in
  X holds (g*f).x = g.(f.x);

theorem 
  for f being Function of X,Y st Y <> {} holds rng f = Y iff for Z st Z
  <> {} for g,h being Function of Y,Z st g*f = h*f holds g = h;

theorem 
  for f being Relation of X,Y holds (id X)*f = f & f*(id Y) = f;

theorem 
  for f being Function of X,Y for g being Function of Y,X st f*g = id Y
  holds rng f = Y;

theorem 
  for f being Function of X,Y st Y = {} implies X = {} holds f is
  one-to-one iff for x1,x2 st x1 in X & x2 in X & f.x1 = f.x2 holds x1 = x2;

theorem 
  for f being Function of X,Y for g being Function of Y,Z st (Z = {}
  implies Y = {}) & g*f is one-to-one holds f is one-to-one;

theorem 
  for f being Function of X,Y st X <> {} & Y <> {} holds f is one-to-one
  iff for Z for g,h being Function of Z,X st f*g = f*h holds g = h;

theorem 
  for f being Function of X,Y for g being Function of Y,Z st Z <> {} &
  rng(g*f) = Z & g is one-to-one holds rng f = Y;

definition
  let Y be set;
  let f be Y-valued Relation;
  attr f is onto means


  rng f = Y;
end;

theorem 
  for f being Function of X,Y for g being Function of Y,X st g*f = id X
   holds f is one-to-one & g is onto;

theorem 
  for f being Function of X,Y for g being Function of Y,Z st (Z = {}
  implies Y = {}) & g*f is one-to-one & rng f = Y holds f is one-to-one & g is
  one-to-one;

theorem 
  for f being Function of X,Y st f is one-to-one & rng f = Y holds
  f" is Function of Y,X;

theorem 
  for f being Function of X,Y st Y <> {} & f is one-to-one & x in X
  holds (f").(f.x) = x;

theorem 
  for X be set, Y,Z be non empty set for f be Function of X,Y
  for g be Function of Y,Z holds f is onto & g is onto implies g*f is onto;

theorem 
  for f being Function of X,Y for g being Function of Y,X st X <> {} & Y
<> {} & rng f = Y & f is one-to-one & for y,x holds y in Y & g.y = x iff x in X
  & f.x = y holds g = f";

theorem 
  for f being Function of X,Y st Y <> {} & rng f = Y & f is one-to-one
  holds f"*f = id X & f*f" = id Y;

theorem 
  for f being Function of X,Y for g being Function of Y,X st X <> {} & Y
  <> {} & rng f = Y & g*f = id X & f is one-to-one holds g = f";

theorem 
  for f being Function of X,Y st Y <> {} & ex g being Function of Y,X st
  g*f = id X holds f is one-to-one;

theorem 
  for f being Function of X,Y st (Y = {} implies X = {}) & Z c= X
  holds f|Z is Function of Z,Y;

theorem 
  for f being Function of X,Y st X c= Z holds f|Z = f;

theorem 
  for f being Function of X,Y st Y <> {} & x in X & f.x in Z holds (Z|`f)
  .x = f.x;

theorem 
  for f being Function of X,Y st Y <> {} for y holds (ex x st x in X & x
  in P & y = f.x) implies y in f.:P;

theorem 
  for f being Function of X,Y holds f.:P c= Y;

canceled;

theorem 
  for f being Function of X,Y st Y <> {} for x holds x in f"Q iff x in X
  & f.x in Q;

theorem 
  for f being PartFunc of X,Y holds f"Q c= X;

theorem 
  for f being Function of X,Y st Y = {} implies X = {} holds f"Y = X;

theorem 
  for f being Function of X,Y holds (for y st y in Y holds f"{y} <> {})
  iff rng f = Y;

theorem 
  for f being Function of X,Y st (Y = {} implies X = {}) & P c= X
  holds P c= f"(f.:P);

theorem 
  for f being Function of X,Y st Y = {} implies X = {} holds f"(f.:X) = X;

theorem 
  for f being Function of X,Y for g being Function of Y,Z st (Z = {}
  implies Y = {}) holds f"Q c= (g*f)"(g.:Q);

theorem 
  for f being Function of {},Y holds f.:P = {};

theorem 
  for f being Function of {},Y holds f"Q = {};

theorem 
  for f being Function of {x},Y st Y <> {} holds f.x in Y;

theorem 
  for f being Function of {x},Y st Y <> {} holds rng f = {f.x};

theorem 
  for f being Function of {x},Y st Y <> {} holds f.:P c= {f.x};

theorem 
  for f being Function of X,{y} st x in X holds f.x = y;

theorem 
  for f1,f2 being Function of X,{y} holds f1 = f2;

theorem 
  for f being Function of X,X holds dom f = X;

registration
  let X,Y be set;
  let f be quasi_total PartFunc of X,Y;
  let g be quasi_total PartFunc of X,X;
  cluster f*g -> quasi_total for PartFunc of X,Y;
end;

registration
  let X,Y be set;
  let f be quasi_total PartFunc of Y,Y;
  let g be quasi_total PartFunc of X,Y;
  cluster f*g -> quasi_total for PartFunc of X,Y;
end;

theorem 
  for f,g being Relation of X,X st rng f = X & rng g = X holds rng (g*f) = X;

theorem 
  for f,g being Function of X,X st g*f = f & rng f = X holds g = id X;

theorem 
  for f,g being Function of X,X st f*g = f & f is one-to-one holds g = id X;

theorem 
  for f being Function of X,X holds f is one-to-one iff for x1,x2
  st x1 in X & x2 in X & f.x1 = f.x2 holds x1 = x2;

definition
  let X, Y;
  let f be X-defined Y-valued Function;
  attr f is bijective means


  f is one-to-one onto;
end;

registration
  let X, Y be set;
  cluster bijective -> one-to-one onto for PartFunc of X,Y;
  cluster one-to-one onto -> bijective for PartFunc of X,Y;
end;

registration
  let X;
  cluster bijective for Function of X,X;
end;

definition
  let X;
  mode Permutation of X is bijective Function of X,X;
end;

theorem 
  for f being Function of X, X st f is one-to-one & rng f = X
  holds f is Permutation of X;

theorem 
  for f being Function of X,X st f is one-to-one holds for x1,x2 st x1
  in X & x2 in X & f.x1 = f.x2 holds x1 = x2;

registration
  let X;
  let f,g be onto PartFunc of X,X;
  cluster f*g -> onto for PartFunc of X,X;
end;

registration
  let X;
  let f,g be bijective Function of X,X;
  cluster g*f -> bijective for Function of X,X;
end;

registration
  let X;
  cluster reflexive total -> bijective for Function of X,X;
end;

definition
  let X;
  let f be Permutation of X;
  redefine func f" -> Permutation of X;
end;

theorem 
  for f,g being Permutation of X st g*f = g holds f = id X;

theorem 
  for f,g being Permutation of X st g*f = id X holds g = f";

theorem 
  for f being Permutation of X holds (f")*f =id X & f*(f") = id X;

theorem 
  for f being Permutation of X st P c= X holds f.:(f"P) = P & f"(f .:P) = P;

reserve D for non empty set;

registration
  let X,D,Z;
  let f be Function of X,D;
  let g be Function of D,Z;
  cluster g*f -> quasi_total for PartFunc of X,Z;
end;

definition
  let C be non empty set, D be set;
  let f be Function of C,D;
  let c be Element of C;
  redefine func f.c -> Element of D;
end;

scheme 

  FuncExD{C, D() -> non empty set, P[set,set]}: ex f being Function of C(),D()
  st for x being Element of C() holds P[x,f.x]
provided
 for x being Element of C() ex y being Element of D() st P[x,y];

scheme 

  LambdaD{C, D() -> non empty set, F(Element of C()) -> Element of D()}: ex f
being Function of C(),D() st for x being Element of C() holds f.x = F(x);

theorem 
  for f1,f2 being Function of X,Y st for x being Element of X
  holds f1.x = f2.x holds f1 = f2;

theorem 
  for P being set for f being Function of X,Y for y holds y in f
  .:P implies ex x st x in X & x in P & y = f.x;

theorem 
  for f being Function of X,Y for y st y in f.:P ex c being Element of X
  st c in P & y = f.c;

begin 

theorem 
  for f being set st f in Funcs(X,Y) holds f is Function of X,Y;

scheme 

  Lambda1C{A, B() -> set, C[set], F(set)->set, G(set)->set}: ex f being
  Function of A(),B() st for x st x in A() holds (C[ x] implies f.x = F(x)) & (
  not C[ x] implies f.x = G(x))
provided
 for x st x in A() holds (C[ x] implies F(x) in B()) & (not C[ x]
implies G(x) in B());

theorem 
  for f being PartFunc of X,Y st dom f = X holds f is Function of X,Y;

theorem 
  for f being PartFunc of X,Y st f is total holds f is Function of X,Y;

theorem 
  for f being PartFunc of X,Y st (Y = {} implies X = {}) & f is Function
  of X,Y holds f is total;

theorem 
  for f being Function of X,Y st (Y = {} implies X = {}) holds
  <:f,X,Y:> is total;

registration
  let X; let f be Function of X,X;
  cluster <:f,X,X:> -> total;
end;

theorem 
  for f being PartFunc of X,Y st Y = {} implies X = {} ex g being
  Function of X,Y st for x st x in dom f holds g.x = f.x;

theorem 
  Funcs(X,Y) c= PFuncs(X,Y);

theorem 
  for f,g being Function of X,Y st (Y = {} implies X = {}) & f
  tolerates g holds f = g;

theorem 
  for f,g being Function of X,X st f tolerates g holds f = g;

theorem 
  for f being PartFunc of X,Y for g being Function of X,Y st Y =
  {} implies X = {} holds f tolerates g iff for x st x in dom f holds f.x = g.x
;

theorem 
  for f being PartFunc of X,X for g being Function of X,X holds f
  tolerates g iff for x st x in dom f holds f.x = g.x;

theorem 
  for f being PartFunc of X,Y st Y = {} implies X = {} ex g being
  Function of X,Y st f tolerates g;

theorem 
  for f,g being PartFunc of X,X for h being Function of X,X st f
  tolerates h & g tolerates h holds f tolerates g;

theorem 
  for f,g being PartFunc of X,Y st (Y = {} implies X = {}) & f tolerates
  g ex h being Function of X,Y st f tolerates h & g tolerates h;

theorem 
  for f being PartFunc of X,Y for g being Function of X,Y st (Y =
  {} implies X = {}) & f tolerates g holds g in TotFuncs f;

theorem 
  for f being PartFunc of X,X for g being Function of X,X st f tolerates
  g holds g in TotFuncs f;

theorem 
  for f being PartFunc of X,Y for g being set st g in TotFuncs(f)
  holds g is Function of X,Y;

theorem 
  for f being PartFunc of X,Y holds TotFuncs f c= Funcs(X,Y);

theorem 
  TotFuncs <:{},X,Y:> = Funcs(X,Y);

theorem 
  for f being Function of X,Y st Y = {} implies X = {} holds
  TotFuncs <:f,X,Y:> = {f};

theorem 
  for f being Function of X,X holds TotFuncs <:f,X,X:> = {f};

theorem 
  for f being PartFunc of X,{y} for g being Function of X,{y} holds
  TotFuncs f = {g};

theorem 
  for f,g being PartFunc of X,Y st g c= f holds TotFuncs f c= TotFuncs g;

theorem 
  for f,g being PartFunc of X,Y st dom g c= dom f & TotFuncs f c=
  TotFuncs g holds g c= f;

theorem 
  for f,g being PartFunc of X,Y st TotFuncs f c= TotFuncs g & (
  for y holds Y <> {y}) holds g c= f;

theorem 
  for f,g being PartFunc of X,Y st (for y holds Y <> {y}) & TotFuncs f =
  TotFuncs g holds f = g;



registration
  let A,B be non empty set;
  cluster -> non empty for Function of A,B;
end;

begin 


scheme 

  LambdaSep1{D, R() -> non empty set, A() -> Element of D(), B() -> Element of
R(), F(set) -> Element of R()}: ex f being Function of D(),R() st f.A() = B() &
  for x being Element of D() st x <> A() holds f.x = F(x);

scheme 

  LambdaSep2{D, R() -> non empty set, A1, A2() -> Element of D(), B1, B2() ->
Element of R(), F(set) -> Element of R()}: ex f being Function of D(),R() st f.
A1() = B1() & f.A2() = B2() & for x being Element of D() st x <> A1() & x <> A2
  () holds f.x = F(x)
provided
 A1() <> A2();



theorem 
  for A,B being set for f being Function st f in Funcs(A,B) holds dom f
  = A & rng f c= B;



scheme 

  FunctRealEx{X()->non empty set,Y()->set,F(set)->set}: ex f being Function of
  X(),Y() st for x being Element of X() holds f.x = F(x)
provided
 for x being Element of X() holds F(x) in Y();



scheme 

  KappaMD{X, Y() -> non empty set, F(set) -> set}: ex f being Function of X(),
  Y() st for x being Element of X() holds f.x = F(x)
provided
 for x being Element of X() holds F(x) is Element of Y();

definition
  let A,B,C be non empty set;
  let f be Function of A, [:B,C:];
  redefine func pr1 f -> Function of A,B means


  for x being Element of A holds it.x = (f.x)`1;
  redefine func pr2 f -> Function of A,C means


  for x being Element of A holds it .x = (f.x)`2;
end;

definition
  let A1 be set, B1 be non empty set, A2 be set, B2 be non empty set, f1 be
  Function of A1,B1, f2 be Function of A2,B2;
  redefine pred f1 = f2 means

  A1 = A2 & for a being Element of A1 holds f1.a = f2.a;
end;

definition
  let A,B be set, f1,f2 be Function of A,B;
  redefine pred f1 = f2 means

  for a being Element of A holds f1.a = f2.a;
end;



theorem 
  for N being set, f being Function of N, bool N ex R being Relation of
  N st for i being set st i in N holds Im(R,i) = f.i;



theorem 
  for A being Subset of X holds (id X)"A = A;



reserve A,B for non empty set;

theorem 
  for f being Function of A,B, A0 being Subset of A, B0 being Subset of
  B holds f.:A0 c= B0 iff A0 c= f"B0;

theorem 
  for f being Function of A,B, A0 being non empty Subset of A, f0 being
Function of A0,B st for c being Element of A st c in A0 holds f.c = f0.c holds
  f|A0 = f0;

theorem 
  for f being Function, A0, C being set st C c= A0 holds f.:C = (f|A0).: C;

theorem 
  for f being Function, A0, D being set st f"D c= A0 holds f"D = (f|A0)" D;

scheme 

  MChoice{A()-> non empty set, B()-> non empty set, F(set) -> set}: ex t being
  Function of A(),B() st for a being Element of A() holds t.a in F(a)
provided
 for a being Element of A() holds B() meets F(a);



theorem 
  for X, D be non empty set, p be Function of X,D, i be Element
  of X holds p/.i = p.i;

registration
  let X, D be non empty set, p be Function of X,D, i be Element of X;
  identify p/.i with p.i;
end;



theorem 
  for S,X being set, f being Function of S,X, A being Subset of X st X =
  {} implies S = {} holds (f"A)` = f"(A`);



theorem 
  for X,Y,Z being set, D being non empty set, f being Function of X,D st
  Y c= X & f.:Y c= Z holds f|Y is Function of Y,Z;



definition
  let T,S be non empty set;
  let f be Function of T,S;
  let G be Subset-Family of S;
  func f"G -> Subset-Family of T means


  for A being Subset of T holds A
  in it iff ex B being Subset of S st B in G & A = f"B;
end;

theorem 
  for T,S being non empty set, f being Function of T,S, A,B being
  Subset-Family of S st A c= B holds f"A c= f"B;

definition
  let T,S be non empty set;
  let f be Function of T,S;
  let G be Subset-Family of T;
  func f.:G -> Subset-Family of S means


  for A being Subset of S holds
  A in it iff ex B being Subset of T st B in G & A = f.:B;
end;

theorem 
  for T,S being non empty set, f being Function of T,S, A,B being
  Subset-Family of T holds A c= B implies f.:A c= f.:B;

theorem 
  for T,S being non empty set, f being Function of T,S, B being
  Subset-Family of S, P being Subset of S st f.:(f"B) is Cover of P holds B is
  Cover of P;

theorem 
  for T,S being non empty set, f being Function of T,S, B being
  Subset-Family of T, P being Subset of T st B is Cover of P holds f"(f.:B) is
  Cover of P;

theorem 
  for T,S being non empty set, f being Function of T,S, Q being
  Subset-Family of S holds union(f.:(f"(Q))) c= union Q;

theorem 
  for T,S being non empty set, f being Function of T,S, P being
  Subset-Family of T holds union P c= union(f"(f.:P));





definition
  let X,Z be set, Y be non empty set;
  let f be Function of X,Y;
  let p be Z-valued Function;
  assume
 rng f c= dom p;
  func p/*f -> Function of X,Z equals


  p*f;
end;

reserve Y for non empty set,
  f for Function of X,Y,
  p for PartFunc of Y,Z,
  x for Element of X;

theorem 
  X <> {} & rng f c= dom p implies (p/*f).x = p.(f.x);

theorem 
  X <> {} & rng f c= dom p implies (p/*f).x = p/.(f.x);

reserve g for Function of X,X;

theorem 
  rng f c= dom p implies (p/*f)*g = p/*(f*g);



theorem 
  for X,Y being non empty set, f being Function of X,Y holds f is
  constant iff ex y being Element of Y st rng f = {y};



theorem 
  for A,B being non empty set, x being Element of A, f being Function of
  A,B holds f.x in rng f;



theorem 
  for A,B being set, f being Function of A,B st y in rng f ex x
  being Element of A st y = f.x;



theorem 
  for A,B being non empty set, f being Function of A,B st for x being
  Element of A holds f.x in Z holds rng f c= Z;

reserve X,Y for non empty set,
  Z,S,T for set,
  f for Function of X,Y,
  g for PartFunc of Y,Z,
  x for Element of X;

theorem 
  g is total implies (g/*f).x = g.(f.x);

theorem 
  g is total implies (g/*f).x = g/.(f.x);

theorem 
  rng f c= dom (g|S) implies (g|S)/*f = g/*f;

theorem 
  rng f c= dom (g|S) & S c= T implies (g|S)/*f = (g|T)/*f;



theorem 
  for H being Function of D, [:A,B:], d being Element of D holds H.d = [
  pr1 H.d,pr2 H.d];



theorem 
  for A1,A2, B1,B2 being set for f being Function of A1,A2, g being
Function of B1,B2 st f tolerates g holds f /\ g is Function of A1 /\ B1, A2 /\
  B2;



registration
  let A, B be set;
  cluster Funcs(A,B) -> functional;
end;

definition
  let A, B be set;
  mode FUNCTION_DOMAIN of A,B -> non empty set means


    for x being Element of it holds x is Function of A,B;
end;

registration
  let A, B be set;
  cluster -> functional for FUNCTION_DOMAIN of A,B;
end;

theorem 
  for f being Function of P,Q holds { f } is FUNCTION_DOMAIN of P,Q;

theorem 
  Funcs(P,B) is FUNCTION_DOMAIN of P,B;

definition
  let A be set, B be non empty set;
  redefine func Funcs(A,B) -> FUNCTION_DOMAIN of A,B;
  let F be FUNCTION_DOMAIN of A,B;
  redefine mode Element of F -> Function of A,B;
end;

registration
  let I be set;
  cluster id I -> total for I-defined Function;
end;



definition
  let X,A;
  let F be Function of X,A;
  let x be set;
  assume
 x in X;
  redefine func F/.x equals

  F.x;
end;

theorem 
  for f being Function of X, X, g being X-valued Function
   holds dom(f*g) = dom g;

theorem 
  for X being non empty set, f being Function of X,X st for x being
  Element of X holds f.x = x holds f = id X;



definition
  let O,E be set;
  mode Action of O,E is Function of O, Funcs(E,E);
end;

theorem 
  for x being set, A being set
   for f,g being Function of {x}, A st f.x = g.x
   holds f = g;















begin

definition
  let f be Function;
  let a,b be set;
  func f.(a,b) -> set equals

  f.[a,b];
end;

reserve A for set;

definition
  let A,B be non empty set, C be set, f be Function of [:A,B:],C;
  let a be Element of A;
  let b be Element of B;
  redefine func f.(a,b) -> Element of C;
end;

reserve X,Y,Z,x,x1,x2,y,y1,y2,z,z1,z2 for set;

theorem 
  for X,Y,Z being set for f1,f2 being Function of [:X,Y:],Z st for
  x,y being set st x in X & y in Y holds f1.(x,y) = f2.(x,y) holds f1 = f2;

theorem 
  for f1,f2 being Function of [:X,Y:],Z st for a being Element of X for
  b being Element of Y holds f1.(a,b) = f2.(a,b) holds f1 = f2;

definition
  let A be set;
  mode UnOp of A is Function of A,A;
  mode BinOp of A is Function of [:A,A:],A;
end;

definition
  let A be set, f be BinOp of A;
  let a,b be Element of A;
  redefine func f.(a,b) -> Element of A;
end;

reserve u for UnOp of A,
  o,o9 for BinOp of A,
  a,b,c,e,e1,e2 for Element of A;

scheme 

  FuncEx2{X, Y, Z() -> set, P[set,set,set]}: ex f being Function of [:X(),Y()
  :],Z() st for x,y st x in X() & y in Y() holds P[x,y,f.(x,y)]
provided
 for x,y st x in X() & y in Y() ex z st z in Z() & P[x,y,z];

scheme 

  Lambda2{X, Y, Z() -> set, F(set,set)->set}: ex f being Function of [:X(),Y()
  :],Z() st for x,y st x in X() & y in Y() holds f.(x,y) = F(x,y)
provided
 for x,y st x in X() & y in Y() holds F(x,y) in Z();

scheme 

  FuncEx2D{X, Y, Z() -> non empty set, P[set,set,set]}: ex f being Function of
[:X(),Y():],Z() st for x being Element of X() for y being Element of Y() holds
  P[x,y,f.(x,y)]
provided
 for x being Element of X() for y being Element of Y() ex z being
Element of Z() st P[x,y,z];

scheme 

  Lambda2D{X, Y, Z() -> non empty set, F(Element of X(),Element of Y()) ->
Element of Z()}: ex f being Function of [:X(),Y():],Z() st for x being Element
  of X() for y being Element of Y() holds f.(x,y)=F(x,y);

definition
  let A,o;
  attr o is commutative means


  for a,b holds o.(a,b) = o.(b,a);
  attr o is associative means


  for a,b,c holds o.(a,o.(b,c)) = o.(o.(a,b ),c);
  attr o is idempotent means


  for a holds o.(a,a) = a;
end;

registration
  cluster -> empty associative commutative for BinOp of {};
end;

definition
  let A,e,o;
  pred e is_a_left_unity_wrt o means


  for a holds o.(e,a) = a;
  pred e is_a_right_unity_wrt o means


  for a holds o.(a,e) = a;
end;

definition
  let A,e,o;
  pred e is_a_unity_wrt o means

  e is_a_left_unity_wrt o & e is_a_right_unity_wrt o;
end;

theorem 
  e is_a_unity_wrt o iff for a holds o.(e,a) = a & o.(a,e) = a;

theorem 
  o is commutative implies (e is_a_unity_wrt o iff for a holds o.( e,a) = a);

theorem 
  o is commutative implies (e is_a_unity_wrt o iff for a holds o.( a,e) = a);

theorem 
  o is commutative implies (e is_a_unity_wrt o iff e is_a_left_unity_wrt o);

theorem 
  o is commutative implies (e is_a_unity_wrt o iff e is_a_right_unity_wrt o);

theorem 
  o is commutative implies (e is_a_left_unity_wrt o iff e
  is_a_right_unity_wrt o);

theorem 
  e1 is_a_left_unity_wrt o & e2 is_a_right_unity_wrt o implies e1 = e2;

theorem 
  e1 is_a_unity_wrt o & e2 is_a_unity_wrt o implies e1 = e2;

definition
  let A,o;
  assume
 ex e st e is_a_unity_wrt o;
  func the_unity_wrt o -> Element of A means

  it is_a_unity_wrt o;
end;

definition
  let A,o9,o;
  pred o9 is_left_distributive_wrt o means


  for a,b,c holds o9.(a,o.(b,c )) = o.(o9.(a,b),o9.(a,c));
  pred o9 is_right_distributive_wrt o means


  for a,b,c holds o9.(o.(a,b ),c) = o.(o9.(a,c),o9.(b,c));
end;

definition
  let A,o9,o;
  pred o9 is_distributive_wrt o means

  o9 is_left_distributive_wrt o & o9 is_right_distributive_wrt o;
end;

theorem 
  o9 is_distributive_wrt o iff for a,b,c holds o9.(a,o.(b,c)) = o.
  (o9.(a,b),o9.(a,c)) & o9.(o.(a,b),c) = o.(o9.(a,c),o9.(b,c));

theorem 
  for A being non empty set, o,o9 being BinOp of A holds o9 is
commutative implies (o9 is_distributive_wrt o iff for a,b,c being Element of A
  holds o9.(a,o.(b,c)) = o.(o9.(a,b),o9.(a,c)));

theorem 
  for A being non empty set, o,o9 being BinOp of A holds o9 is
commutative implies (o9 is_distributive_wrt o iff for a,b,c being Element of A
  holds o9.(o.(a,b),c) = o.(o9.(a,c),o9.(b,c)));

theorem 
  for A being non empty set, o,o9 being BinOp of A holds o9 is
commutative implies (o9 is_distributive_wrt o iff o9 is_left_distributive_wrt o
  );

theorem 
  for A being non empty set, o,o9 being BinOp of A holds o9 is
commutative implies (o9 is_distributive_wrt o iff o9 is_right_distributive_wrt
  o);

theorem 
  for A being non empty set, o,o9 being BinOp of A holds o9 is
  commutative implies (o9 is_right_distributive_wrt o iff o9
  is_left_distributive_wrt o);

definition
  let A,u,o;
  pred u is_distributive_wrt o means


  for a,b holds u.(o.(a,b)) = o.((u .a),(u.b));
end;














definition
 canceled 3;
  let A be non empty set, e be Element of A, o be BinOp of A;
  redefine pred e is_a_left_unity_wrt o means

  for a being Element of A holds o .(e,a) = a;
  redefine pred e is_a_right_unity_wrt o means

  for a being Element of A holds o.(a,e) = a;
end;

definition
  let A be non empty set, o9,o be BinOp of A;
  redefine pred o9 is_left_distributive_wrt o means

  for a,b,c being Element of A holds o9.(a,o.(b,c)) = o.(o9.(a,b),o9.(a,c));
  redefine pred o9 is_right_distributive_wrt o means

  for a,b,c being Element of A holds o9.(o.(a,b),c) = o.(o9.(a,c),o9.(b,c));
end;

definition
  let A be non empty set, u be UnOp of A, o be BinOp of A;
  redefine pred u is_distributive_wrt o means

  for a,b being Element of A holds u.(o.(a,b)) = o.((u.a),(u.b));
end;



theorem 
  for f being Function of [:X,Y:],Z st x in X & y in Y & Z <> {} holds f
  .(x,y) in Z;



theorem 
  for x, y, X, Y, Z being set, f being Function of [:X,Y:],Z, g being
  Function st Z <> {} & x in X & y in Y holds (g*f).(x,y) = g.(f.(x,y));



theorem 
  for f being Function st dom f = [:X,Y:] holds f is constant iff for x1
  ,x2,y1,y2 st x1 in X & x2 in X & y1 in Y & y2 in Y holds f.(x1,y1)=f.(x2,y2);



theorem 
  for f1,f2 being PartFunc of [:X,Y:],Z st dom f1 = dom f2 & for x,y st
  [x,y] in dom f1 holds f1.(x,y)=f2.(x,y) holds f1 = f2;

scheme 

  PartFuncEx2{X,Y,Z()->set,P[set,set,set]}: ex f being PartFunc of [:X(),Y():]
,Z() st (for x,y holds [x,y] in dom f iff x in X() & y in Y() & ex z st P[x,y,z
  ]) & for x,y st [x,y] in dom f holds P[x,y,f.(x,y)]
provided
 for x,y,z st x in X() & y in Y() & P[x,y,z] holds z in Z() and
 for x,y,z1,z2 st x in X() & y in Y() & P[x,y,z1] & P[x,y,z2] holds z1 = z2;

scheme 

  LambdaR2{X,Y,Z()->set,F(set,set)->set,P[set,set]}: ex f being PartFunc of [:
X(),Y():],Z() st (for x,y holds [x,y] in dom f iff x in X() & y in Y() & P[x,y]
  ) & for x,y st [x,y] in dom f holds f.(x,y) = F(x,y)
provided
 for x,y st P[x,y] holds F(x,y) in Z();



scheme 

  PartLambda2{X,Y,Z()->set,F(set,set)->set,P[set,set]}: ex f being PartFunc of
[:X(),Y():],Z() st (for x,y holds [x,y] in dom f iff x in X() & y in Y() & P[x,
  y]) & for x,y st [x,y] in dom f holds f.(x,y) = F(x,y)
provided
 for x,y st x in X() & y in Y() & P[x,y] holds F(x,y) in Z();

scheme 

  {X,Y()->non empty set,Z()->set,F(set,set)->set, P[set,set]}: ex f being
PartFunc of [:X(),Y():],Z() st (for x being Element of X(), y being Element of
  Y() holds [x,y] in dom f iff P[x,y]) & for x being Element of X(), y being
  Element of Y() st [x,y] in dom f holds f.(x,y) = F(x,y)
provided
 for x being Element of X(), y being Element of Y() st P[x,y] holds F
(x,y) in Z();



definition
  let A be set, f be BinOp of A, x,y be Element of A;
  redefine func f.(x,y) -> Element of A;
end;

definition
 let X,Y,Z be set; let f1,f2 being Function of [:X,Y:],Z;
 redefine pred f1 = f2 means

  for x,y being set st x in X & y in Y holds f1.(x,y) = f2.(x,y);
end;














begin

reserve a,b,c,d for set,
  D,X1,X2,X3,X4 for non empty set,
  x1,y1,z1 for Element of X1,
  x2 for Element of X2,
  x3 for Element of X3,
  x4 for Element of X4,
  A1,B1 for Subset of X1;



theorem 
  a in [:X1,X2:] implies ex x1,x2 st a=[x1,x2];

theorem 
  for x,y being Element of [:X1,X2:] st x`1=y`1 & x`2=y`2 holds x=y;

definition
  let X1,X2,x1,x2;
  redefine func [x1,x2] -> Element of [:X1,X2:];
end;

definition
  let X1,X2;
  let x be Element of [:X1,X2:];
  redefine func x`1 -> Element of X1;
  redefine func x`2 -> Element of X2;
end;



theorem 
  a in [: X1,X2,X3 :] iff ex x1,x2,x3 st a = [x1,x2,x3];

theorem 
  (for a holds a in D iff ex x1,x2,x3 st a = [x1,x2,x3]) implies D
  = [: X1,X2,X3 :];

theorem 
  D = [: X1,X2,X3 :] iff for a holds a in D iff ex x1,x2,x3 st a = [x1,
  x2,x3];

reserve x,y for Element of [:X1,X2,X3:];

definition
  let X1,X2,X3,x1,x2,x3;
  redefine func [x1,x2,x3] -> Element of [:X1,X2,X3:];
end;

theorem 
  a =x`1_3 iff for x1,x2,x3 st x = [x1,x2,x3] holds a = x1;

theorem 
  b =x`2_3 iff for x1,x2,x3 st x = [x1,x2,x3] holds b = x2;

theorem 
  c =x`3_3 iff for x1,x2,x3 st x = [x1,x2,x3] holds c = x3;

theorem 
  x`1_3=y`1_3 & x`2_3=y`2_3 & x`3_3=y`3_3 implies x=y;

theorem 
  a in [: X1,X2,X3,X4 :] iff ex x1,x2,x3,x4 st a = [x1,x2,x3,x4];

theorem 
  (for a holds a in D iff ex x1,x2,x3,x4 st a = [x1,x2,x3,x4])
  implies D = [: X1,X2,X3,X4 :];

theorem 
  D = [: X1,X2,X3,X4 :] iff for a holds a in D iff ex x1,x2,x3,x4 st a =
  [x1,x2,x3,x4];

reserve x for Element of [:X1,X2,X3,X4:];

definition
  let X1,X2,X3,X4,x1,x2,x3,x4;
  redefine func [x1,x2,x3,x4] -> Element of [:X1,X2,X3,X4:];
end;

theorem 
  a=x`1_4 iff for x1,x2,x3,x4 st x = [x1,x2,x3,x4] holds a = x1;

theorem 
  b=x`2_4 iff for x1,x2,x3,x4 st x = [x1,x2,x3,x4] holds b = x2;

theorem 
  c = x`3_4 iff for x1,x2,x3,x4 st x = [x1,x2,x3,x4] holds c = x3;

theorem 
  d=x`4_4 iff for x1,x2,x3,x4 st x = [x1,x2,x3,x4] holds d = x4;

theorem 
  for x,y being Element of [:X1,X2,X3,X4:]
   st x`1_4=y`1_4 & x`2_4=y`2_4 & x`3_4=y
  `3_4 & x`4_4=y`4_4 holds x=y;

reserve A2 for Subset of X2,
  A3 for Subset of X3,
  A4 for Subset of X4;

scheme 

  Fraenkel1 {P[set]}: for X1 holds { x1 : P[x1] } is Subset of X1;

scheme 

  Fraenkel2 {P[set,set]}: for X1,X2 holds { [x1,x2] : P[x1,x2] } is Subset of
  [:X1,X2:];

scheme 

  Fraenkel3 {P[set,set,set]}: for X1,X2,X3 holds { [x1,x2,x3] : P[x1,x2,x3] }
  is Subset of [:X1,X2,X3:];

scheme 

  Fraenkel4 {P[set,set,set,set]}: for X1,X2,X3,X4 holds { [x1,x2,x3,x4] : P[x1
  ,x2,x3,x4] } is Subset of [:X1,X2,X3,X4:];

scheme 

  Fraenkel5 {P[set],Q[set]}: for X1 st for x1 holds P[x1] implies Q[x1] holds
  { y1 : P[y1] } c= { z1 : Q[z1] };

scheme 

  Fraenkel6 {P[set],Q[set]}: for X1 st for x1 holds P[x1] iff Q[x1] holds { y1
  : P[y1] } = { z1 : Q[z1] };

scheme 

  SubsetD{D() -> non empty set,P[set]}: {d where d is Element of D() : P[d]}
  is Subset of D();

theorem 
  X1 = { x1 : not contradiction };

theorem 
  [:X1,X2:] = { [x1,x2] : not contradiction };

theorem 
  [:X1,X2,X3:] = { [x1,x2,x3] : not contradiction };

theorem 
  [:X1,X2,X3,X4:] = { [x1,x2,x3,x4] : not contradiction };

theorem 
  A1 = { x1 : x1 in A1 };

theorem 
  [:A1,A2:] = { [x1,x2] : x1 in A1 & x2 in A2 };

theorem 
  [:A1,A2,A3:] = { [x1,x2,x3] : x1 in A1 & x2 in A2 & x3 in A3 };

theorem 
  [:A1,A2,A3,A4:] = { [x1,x2,x3,x4] : x1 in A1 & x2 in A2 & x3 in A3 &
  x4 in A4 };

theorem 
  {} X1 = { x1 : contradiction };

theorem 
  A1` = { x1 : not x1 in A1 };

theorem 
  A1 /\ B1 = { x1 : x1 in A1 & x1 in B1 };

theorem 
  A1 \/ B1 = { x1 : x1 in A1 or x1 in B1 };

theorem 
  A1 \ B1 = { x1 : x1 in A1 & not x1 in B1 };

theorem 
  A1 \+\ B1 = { x1 : x1 in A1 & not x1 in B1 or not x1 in A1 & x1 in B1 };

theorem 
  A1 \+\ B1 = { x1 : not x1 in A1 iff x1 in B1 };

theorem 
  A1 \+\ B1 = { x1 : x1 in A1 iff not x1 in B1 };

theorem 
  A1 \+\ B1 = { x1 : not(x1 in A1 iff x1 in B1) };

definition
  let D be non empty set;
  let x1 be Element of D;
  redefine func {x1} -> Subset of D;
  let x2 be Element of D;
  redefine func {x1,x2} -> Subset of D;
  let x3 be Element of D;
  redefine func {x1,x2,x3} -> Subset of D;
  let x4 be Element of D;
  redefine func {x1,x2,x3,x4} -> Subset of D;
  let x5 be Element of D;
  redefine func {x1,x2,x3,x4,x5} -> Subset of D;
  let x6 be Element of D;
  redefine func {x1,x2,x3,x4,x5,x6} -> Subset of D;
  let x7 be Element of D;
  redefine func {x1,x2,x3,x4,x5,x6,x7} -> Subset of D;
  let x8 be Element of D;
  redefine func {x1,x2,x3,x4,x5,x6,x7,x8} -> Subset of D;
end;

begin 


scheme 

  SubsetFD { A, D() -> non empty set, F(set) -> Element of D(), P[set] }: { F(
  x) where x is Element of A(): P[x]} is Subset of D();

scheme 

  SubsetFD2 { A, B, D() -> non empty set, F(set,set) -> Element of D(), P[set,
  set] }: { F(x,y) where x is Element of A(), y is Element of B(): P[x,y]} is
  Subset of D();

definition
  let D1,D2,D3 be non empty set, x be Element of [:[:D1,D2:],D3:];
  redefine func x`11 -> Element of D1;
  redefine func x`12 -> Element of D2;
end;

definition
  let D1,D2,D3 be non empty set, x be Element of [:D1,[:D2,D3:]:];
  redefine func x`21 -> Element of D2;
  redefine func x`22 -> Element of D3;
end;



scheme 

  AndScheme{A()-> non empty set, P,Q[set]}: { a where a is Element of A(): P[a
  ] & Q[a] } = { a1 where a1 is Element of A(): P[a1] } /\ { a2 where a2 is
  Element of A(): Q[a2] };



registration
  let A be non empty set;
  cluster c=-linear non empty for Subset of A;
end;















begin

reserve p,q,x,x1,x2,y,y1,y2,z,z1,z2 for set;
reserve A,B,V,X,X1,X2,Y,Y1,Y2,Z for set;
reserve C,C1,C2,D,D1,D2 for non empty set;



theorem 
  A c= Y implies id A = (id Y)|A;

theorem 
  for f,g being Function st X c= dom(g*f) holds f.:X c= dom g;

theorem 
  for f,g being Function st X c= dom f & f.:X c= dom g holds X c= dom(g*f);

theorem 
  for f,g being Function st Y c= rng(g*f) & g is one-to-one holds g "Y c= rng f
;

theorem 
  for f,g being Function st Y c= rng g & g"Y c= rng f holds Y c= rng(g*f);

scheme 

  FuncEx3{A()->set,B()-> set,P[set,set,set]}: ex f being Function st dom f =
  [:A(),B():] & for x,y st x in A() & y in B() holds P[x,y,f.(x,y)]
provided
 for x,y,z1,z2 st x in A() & y in B() & P[x,y,z1] & P[x,y,z2] holds
z1 = z2 and
 for x,y st x in A() & y in B() ex z st P[x,y,z];

scheme 

  Lambda3{A()->set,B()->set,F(set,set)->set}: ex f being Function st dom f =
  [:A(),B():] & for x,y st x in A() & y in B() holds f.(x,y) = F(x,y);

theorem 
  for f,g being Function st dom f = [:X,Y:] & dom g = [:X,Y:] & for
  x,y st x in X & y in Y holds f.(x,y) = g.(x,y) holds f = g;



definition
  let f be Function;
  func .:f -> Function means


  dom it = bool dom f & for X st X c= dom f holds it.X = f.:X;
end;

theorem 
  for f being Function st X in dom(.:f) holds (.:f).X = f.:X;

theorem 
  for f being Function holds (.:f).{} = {};

theorem 
  for f being Function holds rng(.:f) c= bool rng f;

theorem 
  for f being Function holds (.:f).:A c= bool rng f;

theorem 
  for f being Function holds (.:f)"B c= bool dom f;

theorem 
  for f being Function of X,D holds (.:f)"B c= bool X;

theorem 
  for f being Function holds union((.:f).:A) c= f.:(union A);

theorem 
  for f being Function st A c= bool dom f holds f.:(union A) = union((.:f).:A);

theorem 
  for f being Function of X,D st A c= bool X holds f.:(union A) = union(
  (.:f).:A);

theorem 
  for f being Function holds union((.:f)"B) c= f"(union B);

theorem 
  for f being Function st B c= bool rng f holds f"(union B) = union((.:f
  ) " B );

theorem 
  for f,g being Function holds .:(g*f) = .:g*.:f;

theorem 
  for f being Function holds .:f is Function of bool dom f, bool rng f;

theorem 
  for f being Function of X,Y st Y = {} implies X = {} holds .:f
  is Function of bool X, bool Y;

definition
  let X,D;
  let f be Function of X,D;
  redefine func .:f -> Function of bool X, bool D;
end;



definition
  let f be Function;
  func "f -> Function means


  dom it = bool rng f & for Y st Y c= rng f holds it.Y = f"Y;
end;

theorem 
  for f being Function st Y in dom("f) holds ("f).Y = f"Y;

theorem 
  for f being Function holds rng("f) c= bool dom f;

theorem 
  for f being Function holds ("f).:B c= bool dom f;

theorem 
  for f being Function holds ("f)"A c= bool rng f;

theorem 
  for f being Function holds union(("f).:B) c= f"(union B);

theorem 
  for f being Function st B c= bool rng f holds union(("f).:B) = f"( union B );

theorem 
  for f being Function holds union(("f)"A) c= f.:(union A);

theorem 
  for f being Function st A c= bool dom f & f is one-to-one holds union(
  ("f)"A) = f.:(union A);

theorem 
  for f being Function holds ("f).:B c= (.:f)"B;

theorem 
  for f being Function st f is one-to-one holds ("f).:B = (.:f)"B;

theorem 
  for f being Function,A be set st A c= bool dom f holds ("f)"A c= (.:f).:A;

theorem 
  for f being Function,A be set st f is one-to-one holds (.:f).:A c= ("f)"A;

theorem 
  for f being Function,A be set st f is one-to-one & A c= bool dom f
  holds ("f)"A = (.:f).:A;

theorem 
  for f,g being Function st g is one-to-one holds "(g*f) = "f*"g;

theorem 
  for f being Function holds "f is Function of bool rng f, bool dom f;



definition
  let A,X;
  func chi(A,X) -> Function means


  dom it = X & for x st x in X holds (x
  in A implies it.x = 1) & (not x in A implies it.x = {});
end;

theorem 
  chi(A,X).x = 1 implies x in A;

theorem 
  x in X \ A implies chi(A,X).x = {};

theorem 
  A c= X & B c= X & chi(A,X) = chi(B,X) implies A = B;

theorem 
  rng chi(A,X) c= {{},1};

theorem 
  for f being Function of X,{{},1} holds f = chi(f"{1},X);

definition
  let A,X;
  redefine func chi(A,X) -> Function of X,{{},1};
end;

notation
  let Y;
  let A be Subset of Y;
  synonym incl A for id A;
end;

definition
  let Y;
  let A be Subset of Y;
  redefine func incl A -> Function of A,Y;
end;

theorem 
  for A being Subset of Y holds incl A = (id Y)|A;

theorem 
  for A being Subset of Y st x in A holds incl(A).x in Y;



definition
  let X,Y;

  func pr1(X,Y) -> Function means


  dom it = [:X,Y:] & for x,y st x in X & y in Y holds it.(x,y) = x;
  func pr2(X,Y) -> Function means


  dom it = [:X,Y:] & for x,y st x in X & y in Y holds it.(x,y) = y;
end;

theorem 
  rng pr1(X,Y) c= X;

theorem 
  Y <> {} implies rng pr1(X,Y) = X;

theorem 
  rng pr2(X,Y) c= Y;

theorem 
  X <> {} implies rng pr2(X,Y) = Y;

definition
  let X,Y;
  redefine func pr1(X,Y) -> Function of [:X,Y:],X;
  redefine func pr2(X,Y) -> Function of [:X,Y:],Y;
end;

definition
  let X;
  func delta(X) -> Function means


  dom it = X & for x st x in X holds it .x = [x,x];
end;

theorem 
  rng delta X c= [:X,X:];

definition
  let X;
  redefine func delta(X) -> Function of X,[:X,X:];
end;



definition
  let f,g be Function;
  func <:f,g:> -> Function means


  dom it = dom f /\ dom g & for x st x in dom it holds it.x = [f.x,g.x];
end;

registration
  let f be empty Function, g be Function;
  cluster <:f,g:> -> empty;
  cluster <:g,f:> -> empty;
end;

theorem 
  for f,g being Function st x in dom f /\ dom g holds <:f,g:>.x = [f.x,g.x];

theorem 
  for f,g being Function st dom f = X & dom g = X & x in X holds
  <:f,g:>.x = [f.x,g.x];

theorem 
  for f,g being Function st dom f = X & dom g = X holds dom <:f,g :> = X;

theorem 
  for f,g being Function holds rng <:f,g:> c= [:rng f,rng g:];

theorem 
  for f,g being Function st dom f = dom g & rng f c= Y & rng g c=
  Z holds pr1(Y,Z)*<:f,g:> = f & pr2(Y,Z)*<:f,g:> = g;

theorem 
  <:pr1(X,Y),pr2(X,Y):> = id [:X,Y:];

theorem 
  for f,g,h,k being Function st dom f = dom g & dom k = dom h & <:
  f,g:> = <:k,h:> holds f = k & g = h;

theorem 
  for f,g,h being Function holds <:f*h,g*h:> = <:f,g:>*h;

theorem 
  for f,g being Function holds <:f,g:>.:A c= [:f.:A,g.:A:];

theorem 
  for f,g being Function holds <:f,g:>"[:B,C:] = f"B /\ g"C;

theorem 
  for f being Function of X,Y for g being Function of X,Z st (Y =
{} implies X = {}) & (Z = {} implies X = {}) holds <:f,g:> is Function of X,[:Y
  ,Z:];

definition
  let X,D1,D2;
  let f1 be Function of X,D1;
  let f2 be Function of X,D2;
  redefine func <:f1,f2:> -> Function of X,[:D1,D2:];
end;

theorem 
  for f1 being Function of C,D1 for f2 being Function of C,D2 for c
  being Element of C holds <:f1,f2:>.c = [f1.c,f2.c];

theorem 
  for f being Function of X,Y for g being Function of X,Z holds rng <:f,
  g:> c= [:Y,Z:];

theorem 
  for f being Function of X,Y for g being Function of X,Z st (Y =
{} implies X = {}) & (Z = {} implies X = {}) holds pr1(Y,Z)*<:f,g:> = f & pr2(Y
  ,Z)*<:f,g:> = g;

theorem 
  for f being Function of X,D1 for g being Function of X,D2 holds pr1(D1
  ,D2)*<:f,g:> = f & pr2(D1,D2)*<:f,g:> = g;

theorem 
  for f1,f2 being Function of X,Y for g1,g2 being Function of X,Z st (Y
= {} implies X = {}) & (Z = {} implies X = {}) & <:f1,g1:> = <:f2,g2:> holds f1
  = f2 & g1 = g2;

theorem 
  for f1,f2 being Function of X,D1 for g1,g2 being Function of X,D2 st
  <:f1,g1:> = <:f2,g2:> holds f1 = f2 & g1 = g2;



definition
  let f,g be Function;
  func [:f,g:] -> Function means


  dom it = [:dom f, dom g:] & for x,y st
  x in dom f & y in dom g holds it.(x,y) = [f.x,g.y];
end;

theorem 
  for f,g being Function, x,y st [x,y] in [:dom f,dom g:] holds [:
  f,g:].(x,y) = [f.x,g.y];

theorem 
  for f,g being Function holds [:f,g:] = <:f*pr1(dom f,dom g),g*
  pr2(dom f,dom g):>;

theorem 
  for f,g being Function holds rng [:f,g:] = [:rng f,rng g:];

theorem 
  for f,g being Function st dom f = X & dom g = X holds <:f,g:> =
  [:f,g:]*(delta X);

theorem 
  [:id X, id Y:] = id [:X,Y:];

theorem 
  for f,g,h,k being Function holds [:f,h:]*<:g,k:> = <:f*g,h*k:>;

theorem 
  for f,g,h,k being Function holds [:f,h:]*[:g,k:] = [:f*g,h*k:];

theorem 
  for f,g being Function holds [:f,g:].:[:B,A:] = [:f.:B,g.:A:];

theorem 
  for f,g being Function holds [:f,g:]"[:B,A:] = [:f"B,g"A:];

theorem 
  for f being Function of X,Y for g being Function of V,Z holds [:
  f,g:] is Function of [:X,V:],[:Y,Z:];

definition
  let X1,X2,Y1,Y2;
  let f1 be Function of X1,Y1;
  let f2 be Function of X2,Y2;
  redefine func [:f1,f2:] -> Function of [:X1,X2:],[:Y1,Y2:];
end;

theorem 
  for f1 being Function of C1,D1 for f2 being Function of C2,D2 for c1
being Element of C1 for c2 being Element of C2 holds [:f1,f2:].(c1,c2) = [f1.c1
  ,f2.c2];

theorem 
  for f1 being Function of X1,Y1 for f2 being Function of X2,Y2 st (Y1 =
{} implies X1 = {}) & (Y2 = {} implies X2 = {}) holds [:f1,f2:] = <:f1*pr1(X1,
  X2),f2*pr2(X1,X2):>;

theorem 
  for f1 being Function of X1,D1 for f2 being Function of X2,D2 holds [:
  f1,f2:] = <:f1*pr1(X1,X2),f2*pr2(X1,X2):>;

theorem 
  for f1 being Function of X,Y1 for f2 being Function of X,Y2 holds <:f1
  ,f2:> = [:f1,f2:]*(delta X);

begin 


theorem 
  for f being Function holds pr1(dom f,rng f).:f = dom f;

theorem 
  for A,B,C being non empty set, f,g being Function of A,[:B,C:] st
  pr1(B,C)*f = pr1(B,C)*g & pr2(B,C)*f = pr2(B,C)*g holds f = g;

registration
  let F,G be one-to-one Function;
  cluster [:F,G:] -> one-to-one;
end;

registration let A be set;
 cluster idempotent for BinOp of A;
end;

registration let A be set, b be idempotent BinOp of A;
 let a be Element of A;
 reduce b.(a,a) to a;
end;














begin

reserve f,g,h for Function,
  A for set;

theorem 
  delta A = <:id A, id A:>;

reserve F for Function,
  B,x,y,y1,y2,z for set;

definition
  let f;
  func f~ -> Function means


  dom it = dom f & for x st x in dom f holds
(for y,z st f.x = [y,z] holds it.x = [z,y]) & (f.x = it.x or ex y,z st f.x =[y,
  z]);
  involutiveness;
end;

theorem 
  <:f,g:> = <:g,f:>~;

theorem 
  (f|A)~ = f~|A;

theorem 
  (delta A)~ = delta A;

theorem 
  <:f,g:>|A = <:f|A,g:>;

theorem 
  <:f,g:>|A = <:f,g|A:>;

definition
  let A, z be set;
  func A --> z -> set equals

  [:A, {z}:];
end;

registration
  let A, z be set;
  cluster A --> z -> Function-like Relation-like;
end;

theorem 
  x in A implies (A --> z).x = z;

theorem 
  A <> {} implies rng (A --> x) = {x};

theorem 
  rng f = {x} implies f = (dom f) --> x;

registration
  let x;
  cluster {} --> x -> empty;
end;

registration
  let x;
  let A be empty set;
  cluster A --> x -> empty;
end;

registration
  let x;
  let A be non empty set;
  cluster A --> x -> non empty;
end;

theorem 
  dom ({} --> x) = {} & rng ({} --> x) = {};

theorem 
  (for z st z in dom f holds f.z = x) implies f = dom f --> x;

theorem 
  (A --> x)|B = A /\ B --> x;

theorem 
  dom (A --> x) = A & rng (A --> x) c= {x};

theorem 
  x in B implies (A --> x)"B = A;

theorem 
  (A --> x)"{x} = A;

theorem 
  not x in B implies (A --> x)"B = {};

theorem 
  x in dom h implies h*(A --> x) = A --> h.x;

theorem 
  A <> {} & x in dom h implies dom(h*(A --> x)) <> {};

theorem 
  (A --> x)*h = h"A --> x;

theorem 
  (A --> [x,y])~ = A --> [y,x];

definition
  let F,f,g;
  func F.:(f,g) -> set equals

  F * <:f,g:>;
end;

registration
  let F,f,g;
  cluster F.:(f,g) -> Function-like Relation-like;
end;

theorem 
  for h st dom h = dom(F.:(f,g)) & for z being set st z in dom (F.:(f,g)
  ) holds h.z = F.(f.z,g.z) holds h = F.:(f,g);

theorem 
  x in dom (F.:(f,g)) implies (F.:(f,g)).x = F.(f.x,g.x);

theorem 
  f|A = g|A implies (F.:(f,h))|A = (F.:(g,h))|A;

theorem 
  f|A = g|A implies (F.:(h,f))|A = (F.:(h,g))|A;

theorem 
  F.:(f,g)*h = F.:(f*h, g*h);

definition
  let F,f,x;
  func F[:](f,x) -> set equals

  F * <:f, dom f --> x:>;
end;

registration
  let F,f,x;
  cluster F[:](f,x) -> Function-like Relation-like;
end;

theorem 
  F[:](f,x) = F.:(f, dom f --> x);

theorem 
  x in dom (F[:](f,z)) implies (F[:](f,z)).x = F.(f.x,z);

theorem 
  f|A = g|A implies (F[:](f,x))|A = (F[:](g,x))|A;

theorem 
  F[:](f,x)*h = F[:](f*h,x);

theorem 
  F[:](f,x)*id A = F[:](f|A,x);

definition
  let F,x,g;
  func F[;](x,g) -> set equals

  F * <:dom g --> x, g:>;
end;

registration
  let F,x,g;
  cluster F[;](x,g) -> Function-like Relation-like;
end;

theorem 
  F[;](x,g) = F.:(dom g --> x, g);

theorem 
  x in dom (F[;](z,f)) implies (F[;](z,f)).x = F.(z,f.x);

theorem 
  f|A = g|A implies (F[;](x,f))|A = (F[;](x,g))|A;

theorem 
  F[;](x,f)*h = F[;](x,f*h);

theorem 
  F[;](x,f)*id A = F[;](x,f|A);

reserve X for non empty set,
  Y for set,
  F for BinOp of X,
  f,g,h for Function
  of Y,X,
  x,x1,x2 for Element of X;

theorem 
  F.:(f,g) is Function of Y,X;

definition
  let X be non empty set, Z be set;
  let F be BinOp of X, f,g be Function of Z,X;
  redefine func F.:(f,g) -> Function of Z,X;
end;

reserve Y for non empty set,
  F for BinOp of X,
  f,g,h for Function of Y,X,
  x,
  x1,x2 for Element of X;

theorem 
  for z being Element of Y holds (F.:(f,g)).z = F.(f.z,g.z);

theorem 
  for h being Function of Y,X holds (for z being Element of Y
  holds h.z = F.(f.z,g.z)) implies h = F.:(f,g);

theorem 
  for g being Function of X,X holds F.:(id X, g)*f = F.:(f,g*f);

theorem 
  for g being Function of X,X holds F.:(g, id X)*f = F.:(g*f,f);

theorem 
  F.:(id X, id X)*f = F.:(f,f);

theorem 
  for g being Function of X,X holds F.:(id X, g).x = F.(x,g.x);

theorem 
  for g being Function of X,X holds F.:(g, id X).x = F.(g.x,x);

theorem 
  F.:(id X, id X).x = F.(x,x);

theorem 
  for A,B for x being set st x in B holds A --> x is Function of A
  , B;

definition
  let I,i be set;
  redefine func I --> i -> Function of I,{i};
end;

definition
  let B be non empty set, A be set, b be Element of B;
  redefine func A --> b -> Function of A,B;
end;

theorem 
  for A,X,x holds A --> x is Function of A, X;

reserve Y for set,
  F for BinOp of X,
  f,g,h for Function
  of Y,X,
  x,x1,x2 for Element of X;

theorem 
  F[:](f,x) is Function of Y,X;

definition
  let X be non empty set, Z be set;
  let F be BinOp of X, f be Function of Z,X, x be Element of X;
  redefine func F[:](f,x) -> Function of Z,X;
end;

reserve Y for non empty set,
  F for BinOp of X,
  f,g,h for Function of Y,X,
  x,
  x1,x2 for Element of X;

theorem 
  for y being Element of Y holds (F[:](f,x)).y = F.(f.y,x);

theorem 
  (for y being Element of Y holds g.y = F.(f.y,x)) implies g = F
  [:](f,x);

theorem 
  F[:](id X, x)*f = F[:](f,x);

theorem 
  F[:](id X, x).x = F.(x,x);

reserve Y for set,
  F for BinOp of X,
  f,g,h for Function
  of Y,X,
  x,x1,x2 for Element of X;

theorem 
  F[;](x,g) is Function of Y,X;

definition
  let X be non empty set, Z be set;
  let F be BinOp of X, x be Element of X;
  let g be Function of Z,X;
  redefine func F[;](x,g) -> Function of Z,X;
end;

reserve Y for non empty set,
  F for BinOp of X,
  f,g,h for Function of Y,X,
  x,
  x1,x2 for Element of X;

theorem 
  for y being Element of Y holds (F[;](x,f)).y = F.(x,f.y);

theorem 
  (for y being Element of Y holds g.y = F.(x,f.y)) implies g = F
  [;](x,f);

reserve Y for set,
  F for BinOp of X,
  f,g,h for Function
  of Y,X,
  x,x1,x2 for Element of X;

theorem 
  F[;](x, id X)*f = F[;](x,f);

theorem 
  F[;](x, id X).x = F.(x,x);

theorem 
  for X,Y,Z being non empty set for f being Function of X, [:Y,Z:] for x
  being Element of X holds f~.x =[(f.x)`2,(f.x)`1];

definition
  let X,Y,Z be non empty set;
  let f be Function of X, [:Y,Z:];
  redefine func rng f -> Relation of Y,Z;
end;

definition
  let X,Y,Z be non empty set;
  let f be Function of X, [:Y,Z:];
  redefine func f~ -> Function of X, [:Z,Y:];
end;

theorem 
  for X,Y,Z being non empty set for f being Function of X, [:Y,Z:] holds
  rng (f~) = (rng f)~;

reserve y for Element of Y;

theorem 
  F is associative implies F[:](F[;](x1,f),x2) = F[;](x1,F[:](f,x2));

theorem 
  F is associative implies F.:(F[:](f,x),g) = F.:(f,F[;](x,g));

theorem 
  F is associative implies F.:(F.:(f,g),h) = F.:(f,F.:(g,h));

theorem 
  F is associative implies F[;](F.(x1,x2),f) = F[;](x1,F[;](x2,f));

theorem 
  F is associative implies F[:](f, F.(x1,x2)) = F[:](F[:](f,x1),x2);

theorem 
  F is commutative implies F[;](x,f) = F[:](f,x);

theorem 
  F is commutative implies F.:(f,g) = F.:(g,f);

theorem 
  F is idempotent implies F.:(f,f) = f;

reserve Y for non empty set,
  F for BinOp of X,
  f for Function of Y,X,
  x for
  Element of X,
  y for Element of Y;

theorem 
  F is idempotent implies F[;](f.y,f).y = f.y;

theorem 
  F is idempotent implies F[:](f,f.y).y = f.y;



theorem 
  for F,f,g being Function st [:rng f, rng g:] c= dom F holds dom(F.:(f,
  g)) = dom f /\ dom g;



definition
  let IT be Function;
  attr IT is Function-yielding means


  for x being set st x in dom IT holds IT.x is Function;
end;

registration
  cluster Function-yielding for Function;
end;

registration
  let B be Function-yielding Function, j be set;
  cluster B.j -> Function-like Relation-like;
end;

registration
  let F be Function-yielding Function, f be Function;
  cluster F * f -> Function-yielding;
end;



registration
  let B;
  let c be non empty set;
  cluster B --> c -> non-empty;
end;



theorem 
  ([:X,Y:] --> z).(x,y) = z;



reserve a,b,c for set;

definition
  let a,b,c;
  func (a,b).-->c -> Function equals

  {[a,b]} --> c;
end;

theorem 
  ((a,b).-->c).(a,b) = c;



definition
  let x,y,a,b be set;
  func IFEQ(x,y,a,b) -> set equals


  a if x = y otherwise b;
end;

definition
  let D be set;
  let x,y be set, a,b be Element of D;
  redefine func IFEQ(x,y,a,b) -> Element of D;
end;

definition
  let x,y be set;
  func x .--> y -> set equals

  {x} --> y;
end;

registration
  let x,y be set;
  cluster x .--> y -> Function-like Relation-like;
end;

registration
  let x,y be set;
  cluster x .--> y -> one-to-one;
end;

theorem 
  for x,y be set holds (x .--> y).x = y;



theorem 
  for a,b being set, f being Function holds a.-->b c= f iff a in dom f &
  f.a = b;



notation
  let o,m,r be set;
  synonym (o,m) :-> r for (o,m) .--> r;
end;

definition
  let o,m,r be set;
  redefine func (o,m) :-> r -> Function of [:{o},{m}:],{r} means

  not contradiction;
end;



reserve x,y,z for set;

theorem 
  x in dom(x .--> y);

theorem 
  z in dom(x .--> y) implies z = x;



theorem 
  not x in A implies (x .--> y)|A = {};



notation
  let x,y;
  synonym x :-> y for x .--> y;
end;

definition
  let m,o be set;
  redefine func m :-> o -> Function of {m}, {o};
end;

theorem 
  for x being Element of {a} for y being Element of {b} holds ((a,b):->c
  ).(x,y) = c;



registration
  let f be Function-yielding Function, C be set;
  cluster f|C -> Function-yielding;
end;



registration
  let A be set;
  let f be Function;
  cluster A --> f -> Function-yielding;
end;



registration
  let X,a be set;
  cluster X --> a -> constant;
end;


registration
  cluster non empty constant for Function;
end;


registration
  let f be constant Function, X be set;
  cluster f|X -> constant;
end;


theorem 
  for f being non empty constant Function ex y st for x st x in dom f
  holds f.x = y;


theorem 
  for X being non empty set, x being set holds the_value_of (X --> x) =
  x;



theorem 
  for f being constant Function holds f = (dom f) --> the_value_of f;



registration
  let X be set, Y be non empty set;
  cluster total for PartFunc of X,Y;
end;



registration
  let I, A be set;
  cluster I --> A -> I-defined;
end;

registration
  let I, A be set;
  cluster I .--> A -> {I}-defined;
end;



theorem 
  (A --> x).:B c= {x};

registration
  let I be set, f be Function;
  cluster I .--> f -> Function-yielding;
end;



registration let I be set;
 cluster total for I-defined non-empty Function;
end;

theorem 
  x .--> y is_isomorphism_of {[x,x]},{[y,y]};

theorem 
  {[x,x]}, {[y,y]} are_isomorphic;

registration
  let I, A be set;
  cluster I --> A -> total for I-defined Function;
end;

theorem 
  for f being Function st x in dom f
   holds x .--> f.x c= f;

registration let A be non empty set;
 let x be set, i be Element of A;
 cluster x .--> i -> A-valued;
end;

reserve Y for set,
        f,g for Function of Y,X,
        x for Element of X,
        y for Element of Y;



theorem 
  F is associative implies F.:(F[;](x,f),g) = F[;](x,F.:(f,g));

registration let A be set, B be non empty set, x be Element of B;
 cluster A --> x -> B-valued;
end;

registration let A be non empty set, x be Element of A, y be set;
 cluster x .--> y -> A-defined;
end;

theorem 
 for x,y,A being set st x in A
 holds (x .--> y)|A = x .--> y;



registration
  let Y be functional set;
  cluster Y-valued -> Function-yielding for Function;
end;



definition
  let IT be Function;
  attr IT is Relation-yielding means

  for x be set st x in dom IT holds IT.x is Relation;
end;

registration
 cluster Function-yielding -> Relation-yielding for Function;
end;

registration
 cluster empty -> Function-yielding for Function;
end;



theorem 
  for X,Y,x,y being set holds X --> x tolerates Y --> y iff x = y or X misses Y
;

reserve x,y,z,A for set;

theorem 
 rng(x .--> y) = {y};

theorem 
 z in A implies (A --> x)*(y .--> z) = y .--> x;















begin 

reserve a,b,p,x,x9,x1,x19,x2,y,y9,y1,y19,y2,z,z9,z1,z2,X,X9,Y,Y9,Z,Z9 for set;
reserve A,D,D9 for non empty set;
reserve f,g,h for Function;

theorem 
  (for z st z in Z holds ex x,y st z = [x,y]) implies ex X,Y st Z
  c= [:X,Y:];

theorem 
  g*f = (g|rng f)*f;

theorem 
  id X c= id Y iff X c= Y;

theorem 
  X c= Y implies X --> a c= Y --> a;

theorem 
  X --> a c= Y --> b implies X c= Y;

theorem 
  X <> {} & X --> a c= Y --> b implies a = b;

theorem 
  x in dom f implies x .--> f.x c= f;



theorem 
  Y|`f|X c= f;

theorem 
  f c= g implies Y|`f|X c= Y|`g|X;

definition
  let f,g;
  func f +* g -> Function means


  dom it = dom f \/ dom g &
  for x st x in dom f \/ dom g holds
  (x in dom g implies it.x = g.x) &
  (not x in dom g implies it.x = f.x);
  idempotence;
end;

theorem 
  dom f c= dom(f+*g) & dom g c= dom(f+*g);

theorem 
  not x in dom g implies (f +* g).x = f.x;

theorem 
  x in dom(f +* g) iff x in dom f or x in dom g;

theorem 
  x in dom g implies (f+*g).x = g.x;

theorem 
  f +* g +* h = f +* (g +* h);

theorem 
  f tolerates g & x in dom f implies (f+*g).x = f.x;

theorem 
  dom f misses dom g & x in dom f implies (f +* g).x = f.x;

theorem 
  rng(f +* g) c= rng f \/ rng g;

theorem 
  rng g c= rng(f +* g);

theorem 
  dom f c= dom g implies f +* g = g;


registration let f; let g be empty Function;
 reduce g +* f to f;
 reduce f +* g to f;
end;

theorem 
  {} +* f = f;

theorem 
  f +* {} = f;

theorem 
  id(X) +* id(Y) = id(X \/ Y);

theorem 
  (f +* g)|(dom g) = g;

theorem 
  ((f +* g)|(dom f \ dom g)) c= f;

theorem 
  g c= f +* g;

theorem 
  f tolerates g +* h implies f|(dom f \ dom h) tolerates g;

theorem 
  f tolerates g +* h implies f tolerates h;

theorem 
  f tolerates g iff f c= f +* g;

theorem 
  f +* g c= f \/ g;

theorem 
  f tolerates g iff f \/ g = f +* g;

theorem 
  dom f misses dom g implies f \/ g = f +* g;

theorem 
  dom f misses dom g implies f c= f +* g;

theorem 
  dom f misses dom g implies (f +* g)|(dom f) = f;

theorem 
  f tolerates g iff f +* g = g +* f;

theorem 
  dom f misses dom g implies f +* g = g +* f;

theorem 
  for f,g being PartFunc of X,Y st g is total holds f +* g = g;

theorem 
  for f,g being Function of X,Y st Y = {} implies X = {} holds f +* g = g;

theorem 
  for f,g being Function of X,X holds f +* g = g;

theorem 
  for f,g being Function of X,D holds f +* g = g;

theorem 
  for f,g being PartFunc of X,Y holds f +* g is PartFunc of X,Y;



definition
  let f;
  func ~f -> Function means


  (for x holds x in dom it iff ex y,z st x =
  [z,y] & [y,z] in dom f) & for y,z st [y,z] in dom f holds it.(z,y) = f.(y,z);
end;

theorem 
  rng ~f c= rng f;

theorem 
  [x,y] in dom f iff [y,x] in dom ~f;

theorem 
  [y,x] in dom ~f implies (~f).(y,x) = f.(x,y);

theorem 
  ex X,Y st dom ~f c= [:X,Y:];

theorem 
  dom f c= [:X,Y:] implies dom ~f c= [:Y,X:];

theorem 
  dom f = [:X,Y:] implies dom ~f = [:Y,X:];

theorem 
  dom f c= [:X,Y:] implies rng ~f = rng f;

theorem 
  for f being PartFunc of [:X,Y:],Z holds ~f is PartFunc of [:Y,X:],Z;

theorem 
  for f being Function of [:X,Y:],Z st Z<>{} holds ~f is Function
  of [:Y,X:],Z;

theorem 
  for f being Function of [:X,Y:],D holds ~f is Function of [:Y,X:],D;

theorem 
  ~~f c= f;

theorem 
  dom f c= [:X,Y:] implies ~~f = f;

theorem 
  for f being PartFunc of [:X,Y:],Z holds ~~f = f;



definition
  let f,g;
  func |:f,g:| -> Function means


  (for z holds z in dom it iff ex x,y,x9
,y9 st z = [[x,x9],[y,y9]] & [x,y] in dom f & [x9,y9] in dom g) & for x,y,x9,y9
st [x,y] in dom f & [x9,y9] in dom g holds it.([x,x9],[y,y9]) = [f.(x,y),g.(x9,
  y9)];
end;

theorem 
  [[x,x9],[y,y9]] in dom |:f,g:| iff [x,y] in dom f & [x9,y9] in dom g;

theorem 
  [[x,x9],[y,y9]] in dom |:f,g:| implies |:f,g:|.([x,x9],[y,y9]) = [f.(x
  ,y),g.(x9,y9)];

theorem 
  rng |:f,g:| c= [:rng f,rng g:];

theorem 
  dom f c= [:X,Y:] & dom g c= [:X9,Y9:] implies dom|:f,g:| c= [:[:
  X,X9:],[:Y,Y9:]:];

theorem 
  dom f = [:X,Y:] & dom g = [:X9,Y9:] implies
  dom|:f,g:| = [:[:X,X9:],[:Y,Y9:]:];

theorem 
  for f being PartFunc of [:X,Y:],Z for g being PartFunc of [:X9,Y9:],Z9
  holds |:f,g:| is PartFunc of [:[:X,X9:],[:Y,Y9:]:],[:Z,Z9:];

theorem 
  for f being Function of [:X,Y:],Z for g being Function of [:X9,
Y9:],Z9 st Z <> {} & Z9 <> {} holds |:f,g:| is Function of [:[:X,X9:],[:Y,Y9:]
  :],[:Z,Z9:];

theorem 
  for f being Function of [:X,Y:],D for g being Function of [:X9,Y9:],D9
  holds |:f,g:| is Function of [:[:X,X9:],[:Y,Y9:]:],[:D,D9:];

definition
  let x,y,a,b be set;
  func (x,y) --> (a,b) -> set equals

  (x .--> a) +* (y .--> b);
end;

registration
  let x,y,a,b be set;
  cluster (x,y) --> (a,b) -> Function-like Relation-like;
end;

theorem 
  dom((x1,x2) --> (y1,y2)) = {x1,x2} & rng((x1,x2) --> (y1,y2)) c=
  {y1,y2};

theorem 
  (x1 <> x2 implies ((x1,x2) --> (y1,y2)).x1 = y1) & ((x1,x2) -->
  (y1,y2)).x2 = y2;

theorem 
  x1 <> x2 implies rng((x1,x2) --> (y1,y2)) = {y1,y2};

theorem 
  (x1,x2) --> (y,y) = {x1,x2} --> y;

definition
  let A,x1,x2;
  let y1,y2 be Element of A;
  redefine func (x1,x2) --> (y1,y2) -> Function of {x1,x2},A;
end;

theorem 
  for a,b,c,d being set, g being Function st dom g = {a,b} & g.a = c & g
  .b = d holds g = (a,b) --> (c,d);

theorem 
  for a,b,c,d being set st a <> c holds (a,c) --> (b,d) = { [a,b],
  [c,d] };

theorem 
  for a,b,x,y,x9,y9 being set st a <> b & (a,b) --> (x,y) = (a,b) --> (
  x9,y9) holds x = x9 & y = y9;

begin 



theorem 
  for f1,f2, g1,g2 being Function st rng g1 c= dom f1 & rng g2 c= dom f2
  & f1 tolerates f2 holds (f1+*f2)*(g1+*g2) = (f1*g1)+*(f2*g2);



reserve A,B for set;

theorem 
  dom f c= A \/ B implies f|A +* f|B = f;



theorem 
  for p,q being Function , A being set holds (p +* q)|A = p|A +* q|A;

theorem 
  for f,g being Function, A being set st A misses dom g holds
  (f +* g)|A = f|A;

theorem 
  for f,g being Function , A being set holds dom f misses A implies
  (f +* g)|A = g|A;

theorem 
  for f,g,h being Function st dom g = dom h holds f +* g +* h = f +* h;

theorem 
  for f being Function, A being set holds f +* f|A = f;

theorem 
  for f,g being Function, B,C being set st dom f c= B & dom g c= C & B
  misses C holds (f +* g)|B = f & (f +* g)|C = g;

theorem 
  for p,q being Function, A being set holds dom p c= A & dom q misses A
  implies (p +* q)|A = p;

theorem 
  for f being Function, A,B being set holds f|(A \/ B) = f|A +* f|B;



reserve x,y,i,j,k for set;

theorem 
  (i,j):->k = [i,j].-->k;

theorem 
  ((i,j):->k).(i,j) = k;



theorem 
  for a,b,c being set holds (a,a) --> (b,c) = a .--> c;

theorem 
  for x,y holds x .--> y = {[x,y]};



theorem 
  for f being Function, a,b,c being set st a <> c holds (f +* (a .-->b))
  .c = f.c;

theorem 
  for f being Function, a,b,c,d being set st a <> b holds
  (f +* ((a,b)-->(c,d))) .a = c & (f +* ((a,b)-->(c,d))) .b = d;



theorem 
  for a,b being set, f being Function st a in dom f & f.a = b
  holds a .--> b c= f;

theorem 
  for a,b,c,d being set, f being Function st
  a in dom f & c in dom f & f.a = b & f.c = d holds (a,c) --> (b,d) c= f;



theorem 
  for f,g,h being Function st f c= h & g c= h holds f +* g c= h;



theorem 
  for f, g being Function, A being set st A /\ dom f c= A /\ dom g holds
  (f+*g|A)|A = g|A;



theorem 
  for f be Function, a,b,n,m be set holds
    (f +* (a .--> b) +* (m .--> n)).m = n;

theorem 
  for f be Function, n,m be set holds (f +* (n .--> m) +* (m .--> n)).n=
  m;

theorem 
  for f be Function, a,b,n,m,x be set st x <> m & x <> a holds (f +* (a
  .--> b) +* (m .--> n)).x=f.x;



theorem 
  f is one-to-one & g is one-to-one & rng f misses rng g implies
  f+*g is one-to-one;

registration let f,g be Function;
 reduce f +* g +* g to f +* g;
end;



theorem 
  for f,g being Function holds f +* g +* g = f +* g;

theorem 
  for f,g,h being Function, D being set holds (f +* g)|D =h | D implies
  (h +* g) | D = (f +* g) | D;

theorem 
  for f,g,h being Function, D being set holds f | D =h | D implies (h +*
  g) | D = (f +* g) | D;



theorem 
  x .--> x = id{x};

theorem 
  f c= g implies f+*g = g;

theorem 
  f c= g implies g+*f = g;

begin 

definition
  let f,x,y;
  func f+~(x,y) equals

  f+*((x .--> y)*f);
end;

registration
  let f,x,y;
  cluster f+~(x,y) -> Relation-like Function-like;
end;

theorem 
  dom(f+~(x,y)) = dom f;

theorem 
  x <> y implies not x in rng(f+~(x,y));

theorem 
  x in rng f implies y in rng(f+~(x,y));

theorem 
  f+~(x,x) = f;

theorem 
  not x in rng f implies f+~(x,y) = f;

theorem 
  rng(f+~(x,y)) c= rng f \ {x} \/ {y};

theorem 
  f.z <> x implies (f+~(x,y)).z = f.z;

theorem 
  z in dom f & f.z = x implies (f+~(x,y)).z = y;



theorem 
  not x in dom f implies f c= f +*(x .--> y);

theorem 
  for f being PartFunc of X,Y, x,y st x in X & y in Y holds f+*(x .--> y
  ) is PartFunc of X,Y;



registration
  let f be Function, g be non empty Function;
  cluster f +* g -> non empty;
  cluster g +* f -> non empty;
end;



registration
  let f,g be non-empty Function;
  cluster f+*g -> non-empty;
end;

definition let X,Y be set;
  let f,g be PartFunc of X,Y;
  redefine func f+* g ->  PartFunc of X,Y;
end;



theorem 
  dom ((x --> y)+*(x .-->z)) = succ x;

theorem 
  dom ((x --> y)+*(x .-->z)+*(succ x .-->z)) = succ succ x;



registration let f,g be Function-yielding Function;
  cluster f+*g -> Function-yielding;
end;



registration
  let I be set;
  let f,g be I-defined Function;
  cluster f+*g -> I-defined;
end;

registration
  let I be set;
  let f be total I-defined Function;
  let g be I-defined Function;
  cluster f+*g -> total for I-defined Function;
  cluster g+*f -> total for I-defined Function;
end;

registration let I be set;
  let g,h be I-valued Function;
  cluster g+*h -> I-valued;
end;

registration let f be Function;
  let g,h be f-compatible Function;
  cluster g+*h -> f-compatible;
end;



theorem 
  f|A +* f = f;



theorem 
  for R being Relation st dom R = {x} & rng R = {y}
    holds R = x .--> y;

theorem 
  (f +* (x .-->y)).x = y;

theorem 
 f +* (x .--> z1) +* (x .--> z2) = f +* (x .--> z2);

registration let A be non empty set, a,b be Element of A, x,y be set;
  cluster (a,b) --> (x,y) -> A-defined;
end;

theorem 
  dom g misses dom h implies f +* g +* h +* g = f +* g +* h;

theorem 
  dom f misses dom h & f c= g +* h implies f c= g;

theorem 
  dom f misses dom h & f c= g implies f c= g +* h;

theorem 
 dom g misses dom h implies f +* g +* h = f +* h +* g;

theorem 
 dom f misses dom g implies (f +* g) \ g = f;

theorem 
  dom f misses dom g implies f \ g = f;

theorem 
  dom g misses dom h implies (f \ g) +* h = (f +* h) \ g;

theorem 
 for f1,f2,g1,g2 being Function
  st f1 c= g1 & f2 c= g2 & dom f1 misses dom g2
 holds f1 +* f2 c= g1 +* g2;

theorem 
  for f, g, h being Function st f c= g holds f +* h c= g +* h;

theorem 
  for f, g, h being Function st f c= g & dom f misses dom h holds f c= g +* h;

registration
  let x, y be set;
  cluster x .--> y -> trivial;
end;



theorem 
  for f,g,h being Function st f tolerates g & g tolerates h & h
  tolerates f holds f+*g tolerates h;















begin









theorem 
  {} is Element of omega;
 


















begin

reserve A,A1,A2,B,C,D for Ordinal,
  X,Y for set,
  x,y,a,b,c for set,
  L,L1,L2,L3 for T-Sequence,
  f for Function;

scheme 

  OrdinalInd { P[Ordinal] } : for A holds P[A]
provided
 P[{}] and
 for A st P[A] holds P[succ A] and
 for A st A <> {} & A is limit_ordinal & for B st B in A holds P[B]
holds P[A];

theorem 
  A c= B iff succ A c= succ B;

theorem 
  union succ A = A;

theorem 
  succ A c= bool A;

theorem 
  {} is limit_ordinal;

theorem 
  union A c= A;

definition
  let L;
  func last L -> set equals

  L.(union dom L);
end;

theorem 
  dom L = succ A implies last L = L.A;

theorem 
  On X c= X;

theorem 
  On A = A;

theorem 
  X c= Y implies On X c= On Y;

theorem 
  Lim X c= X;

theorem 
  X c= Y implies Lim X c= Lim Y;

theorem 
  Lim X c= On X;

theorem 
  (for x st x in X holds x is Ordinal) implies meet X is Ordinal;

registration
  cluster limit_ordinal for Ordinal;
end;

definition
  let X;

  func inf X -> Ordinal equals

  meet On X;
  func sup X -> Ordinal means


  On X c= it & for A st On X c= A holds it c= A;
end;

theorem 
  A in X implies inf X c= A;

theorem 
  On X <> {} & (for A st A in X holds D c= A) implies D c= inf X;

theorem 
  A in X & X c= Y implies inf Y c= inf X;

theorem 
  A in X implies inf X in X;

theorem 
  sup A = A;

theorem 
  A in X implies A in sup X;

theorem 
  (for A st A in X holds A in D) implies sup X c= D;

theorem 
  A in sup X implies ex B st B in X & A c= B;

theorem 
  X c= Y implies sup X c= sup Y;

theorem 
  sup { A } = succ A;

theorem 
  inf X c= sup X;

scheme 

  TSLambda { A()->Ordinal, F(Ordinal)->set } : ex L st dom L = A() & for A st
  A in A() holds L.A = F(A);

definition
  let f;
  attr f is Ordinal-yielding means


  ex A st rng f c= A;
end;

registration
  cluster Ordinal-yielding for T-Sequence;
end;

definition
  mode Ordinal-Sequence is Ordinal-yielding T-Sequence;
end;

registration
  let A;
  cluster -> Ordinal-yielding for T-Sequence of A;
end;

registration
  let L be Ordinal-Sequence;
  let A;
  cluster L|A -> Ordinal-yielding;
end;

reserve fi,psi for Ordinal-Sequence;

theorem 
  A in dom fi implies fi.A is Ordinal;

registration
  let f be Ordinal-Sequence, a be Ordinal;
  cluster f.a -> ordinal;
end;

scheme 

  OSLambda { A()->Ordinal, F(Ordinal)->Ordinal } : ex fi st dom fi = A() & for
  A st A in A() holds fi.A = F(A);

scheme 

  TSUniq1 { A()->Ordinal, B()->set, C(Ordinal,set)->set, D(Ordinal,T-Sequence)
  ->set, L1()->T-Sequence, L2()->T-Sequence } : L1() = L2()
provided
 dom L1() = A() and
 {} in A() implies L1().{} = B() and
 for A st succ A in A() holds L1().(succ A) = C(A,L1().A) and
 for A st A in A() & A <> {} & A is limit_ordinal holds L1().A = D(A,
L1()|A) and
 dom L2() = A() and
 {} in A() implies L2().{} = B() and
 for A st succ A in A() holds L2().(succ A) = C(A,L2().A) and
 for A st A in A() & A <> {} & A is limit_ordinal holds L2().A = D(A,
L2()|A);

scheme 

  TSExist1 { A()->Ordinal, B()->set, C(Ordinal,set)->set, D(Ordinal,T-Sequence
  )->set } : ex L st dom L = A() & ({} in A() implies L.{} = B() ) & (for A st
  succ A in A() holds L.(succ A) = C(A,L.A) ) & for A st A in A() & A <> {} & A
  is limit_ordinal holds L.A = D(A,L|A);

scheme 

  TSResult { L()->T-Sequence, F(Ordinal)->set, A()->Ordinal, B()->set, C(
Ordinal,set)->set, D(Ordinal,T-Sequence)->set } : for A st A in dom L() holds L
  ().A = F(A)
provided
 for A,x holds x = F(A) iff ex L st x = last L & dom L = succ A & L.
{} = B() & (for C st succ C in succ A holds L.succ C = C(C,L.C)) & for C st C
in succ A & C <> {} & C is limit_ordinal holds L.C = D(C,L|C) and
 dom L() = A() and
 {} in A() implies L().{} = B() and
 for A st succ A in A() holds L().(succ A) = C(A,L().A) and
 for A st A in A() & A <> {} & A is limit_ordinal holds L().A = D(A,L ()|A);

scheme 

  TSDef { A()->Ordinal, B()->set, C(Ordinal,set)->set, D(Ordinal,T-Sequence)->
set } : (ex x,L st x = last L & dom L = succ A() & L.{} = B() & (for C st succ
C in succ A() holds L.succ C = C(C,L.C)) & for C st C in succ A() & C <> {} & C
is limit_ordinal holds L.C = D(C,L|C) ) & for x1,x2 being set st (ex L st x1 =
last L & dom L = succ A() & L.{} = B() & (for C st succ C in succ A() holds L.
  succ C = C(C,L.C)) & for C st C in succ A() & C <> {} & C is limit_ordinal
holds L.C = D(C,L|C) ) & (ex L st x2 = last L & dom L = succ A() & L.{} = B() &
(for C st succ C in succ A() holds L.succ C = C(C,L.C)) & for C st C in succ A(
  ) & C <> {} & C is limit_ordinal holds L.C = D(C,L|C) ) holds x1 = x2;

scheme 

  TSResult0 { F(Ordinal)->set, B()->set, C(Ordinal,set)->set, D(Ordinal,
  T-Sequence)->set } : F({}) = B()
provided
 for A,x holds x = F(A) iff ex L st x = last L & dom L = succ A & L.
{} = B() & (for C st succ C in succ A holds L.succ C = C(C,L.C)) & for C st C
in succ A & C <> {} & C is limit_ordinal holds L.C = D(C,L|C);

scheme 

  TSResultS { B()->set, C(Ordinal,set)->set, D(Ordinal,T-Sequence)->set, F(
  Ordinal)->set } : for A holds F(succ A) = C(A,F(A))
provided
 for A,x holds x = F(A) iff ex L st x = last L & dom L = succ A & L.
{} = B() & (for C st succ C in succ A holds L.succ C = C(C,L.C)) & for C st C
in succ A & C <> {} & C is limit_ordinal holds L.C = D(C,L|C);

scheme 

  TSResultL { L()->T-Sequence, A()->Ordinal, F(Ordinal)->set, B()->set, C(
  Ordinal,set)->set, D(Ordinal,T-Sequence)->set } : F(A()) = D(A(),L())
provided
 for A,x holds x = F(A) iff ex L st x = last L & dom L = succ A & L.
{} = B() & (for C st succ C in succ A holds L.succ C = C(C,L.C)) & for C st C
in succ A & C <> {} & C is limit_ordinal holds L.C = D(C,L|C) and
 A() <> {} & A() is limit_ordinal and
 dom L() = A() and
 for A st A in A() holds L().A = F(A);

scheme 

  OSExist { A()->Ordinal, B()->Ordinal, C(Ordinal,Ordinal)->Ordinal, D(Ordinal
,T-Sequence)->Ordinal } : ex fi st dom fi = A() & ({} in A() implies fi.{} = B(
) ) & (for A st succ A in A() holds fi.(succ A) = C(A,fi.A) ) & for A st A in A
  () & A <> {} & A is limit_ordinal holds fi.A = D(A,fi|A);

scheme 

  OSResult { fi()->Ordinal-Sequence, F(Ordinal)->Ordinal, A()->Ordinal, B()->
Ordinal, C(Ordinal,Ordinal)->Ordinal, D(Ordinal,T-Sequence)->Ordinal } : for A
  st A in dom fi() holds fi().A = F(A)
provided
 for A,B holds B = F(A) iff ex fi st B = last fi & dom fi = succ A &
fi.{} = B() & (for C st succ C in succ A holds fi.succ C = C(C,fi.C)) & for C
st C in succ A & C <> {} & C is limit_ordinal holds fi.C = D(C,fi|C) and
 dom fi() = A() and
 {} in A() implies fi().{} = B() and
 for A st succ A in A() holds fi().(succ A) = C(A,fi().A) and
 for A st A in A() & A <> {} & A is limit_ordinal holds fi().A = D(A,
fi()|A);

scheme 

  OSDef { A()->Ordinal, B()->Ordinal, C(Ordinal,Ordinal)->Ordinal, D(Ordinal,
T-Sequence)->Ordinal } : (ex A,fi st A = last fi & dom fi = succ A() & fi.{} =
B() & (for C st succ C in succ A() holds fi.succ C = C(C,fi.C)) & for C st C in
succ A() & C <> {} & C is limit_ordinal holds fi.C = D(C,fi|C) ) & for A1,A2 st
(ex fi st A1 = last fi & dom fi = succ A() & fi.{} = B() & (for C st succ C in
succ A() holds fi.succ C = C(C,fi.C)) & for C st C in succ A() & C <> {} & C is
limit_ordinal holds fi.C = D(C,fi|C) ) & (ex fi st A2 = last fi & dom fi = succ
A() & fi.{} = B() & (for C st succ C in succ A() holds fi.succ C = C(C,fi.C)) &
for C st C in succ A() & C <> {} & C is limit_ordinal holds fi.C = D(C,fi|C) )
  holds A1 = A2;

scheme 

  OSResult0 { F(Ordinal)->Ordinal, B()->Ordinal, C(Ordinal,Ordinal)->Ordinal,
  D(Ordinal,T-Sequence)->Ordinal } : F({}) = B()
provided
 for A,B holds B = F(A) iff ex fi st B = last fi & dom fi = succ A &
fi.{} = B() & (for C st succ C in succ A holds fi.succ C = C(C,fi.C)) & for C
st C in succ A & C <> {} & C is limit_ordinal holds fi.C = D(C,fi|C);

scheme 

  OSResultS { B()->Ordinal, C(Ordinal,Ordinal)->Ordinal, D(Ordinal,T-Sequence)
  ->Ordinal, F(Ordinal)->Ordinal } : for A holds F(succ A) = C(A,F(A))
provided
 for A,B holds B = F(A) iff ex fi st B = last fi & dom fi = succ A &
fi.{} = B() & (for C st succ C in succ A holds fi.succ C = C(C,fi.C)) & for C
st C in succ A & C <> {} & C is limit_ordinal holds fi.C = D(C,fi|C);

scheme 

  OSResultL { fi()->Ordinal-Sequence, A()->Ordinal, F(Ordinal)->Ordinal, B()->
Ordinal, C(Ordinal,Ordinal)->Ordinal, D(Ordinal,T-Sequence)->Ordinal } : F(A())
  = D(A(),fi())
provided
 for A,B holds B = F(A) iff ex fi st B = last fi & dom fi = succ A &
fi.{} = B() & (for C st succ C in succ A holds fi.succ C = C(C,fi.C)) & for C
st C in succ A & C <> {} & C is limit_ordinal holds fi.C = D(C,fi|C) and
 A() <> {} & A() is limit_ordinal and
 dom fi() = A() and
 for A st A in A() holds fi().A = F(A);

definition
  let L;
  func sup L -> Ordinal equals

  sup rng L;
  func inf L -> Ordinal equals

  inf rng L;
end;

theorem 
  sup L = sup rng L & inf L = inf rng L;

definition
  let L;
  func lim_sup L -> Ordinal means

  ex fi st it = inf fi & dom fi = dom L & for
  A st A in dom L holds fi.A = sup rng (L|(dom L \ A));
  func lim_inf L -> Ordinal means

  ex fi st it = sup fi & dom fi = dom L & for
  A st A in dom L holds fi.A = inf rng (L|(dom L \ A));
end;

definition
  let A,fi;
  pred A is_limes_of fi means


  ex B st B in dom fi & for C st B c= C &
C in dom fi holds fi.C = {} if A = {} otherwise for B,C st B in A & A in C ex D
st D in dom fi & for E being Ordinal st D c= E & E in dom fi holds B in fi.E &
  fi.E in C;
end;

definition
  let fi;
  given A such that
 A is_limes_of fi;
  func lim fi -> Ordinal means


  it is_limes_of fi;
end;

definition
  let A,fi;
  func lim(A,fi) -> Ordinal equals

  lim(fi|A);
end;

definition
  let L be Ordinal-Sequence;
  attr L is increasing means

  for A,B st A in B & B in dom L holds L.A in L.B;
  attr L is continuous means

  for A,B st A in dom L & A <> {} & A is
  limit_ordinal & B = L.A holds B is_limes_of L|A;
end;

definition
  let A,B;
  func A +^ B -> Ordinal means


  ex fi st it = last fi & dom fi = succ B
& fi.{} = A & (for C st succ C in succ B holds fi.succ C = succ(fi.C)) & for C
  st C in succ B & C <> {} & C is limit_ordinal holds fi.C = sup(fi|C);
end;

definition
  let A,B;
  func A *^ B -> Ordinal means


  ex fi st it = last fi & dom fi = succ A
& fi.{} = {} & (for C st succ C in succ A holds fi.succ C = (fi.C)+^B) & for C
  st C in succ A & C <> {} & C is limit_ordinal holds fi.C = union sup(fi|C);
end;

registration
  let O be Ordinal;
  cluster -> ordinal for Element of O;
end;

definition
  let A,B;
  func exp(A,B) -> Ordinal means


  ex fi st it = last fi & dom fi = succ
B & fi.{} = 1 & (for C st succ C in succ B holds fi.succ C = A*^(fi.C)) & for C
  st C in succ B & C <> {} & C is limit_ordinal holds fi.C = lim(fi|C);
end;

theorem 
  A+^{} = A;

theorem 
  A+^succ B = succ(A+^B);

theorem 
  B <> {} & B is limit_ordinal implies for fi st dom fi = B & for
  C st C in B holds fi.C = A+^C holds A+^B = sup fi;

theorem 
  {}+^A = A;

theorem 
  A+^1 = succ A;

theorem 
  A in B implies C +^ A in C +^ B;

theorem 
  A c= B implies C +^ A c= C +^ B;

theorem 
  A c= B implies A +^ C c= B +^ C;

theorem 
  {}*^A = {};

theorem 
  (succ B)*^A = B*^A +^ A;

theorem 
  B <> {} & B is limit_ordinal implies for fi st dom fi = B & for
  C st C in B holds fi.C = C*^A holds B*^A = union sup fi;

theorem 
  A*^{} = {};

theorem 
  1*^A = A & A*^1 = A;

theorem 
  C <> {} & A in B implies A*^C in B*^C;

theorem 
  A c= B implies A*^C c= B*^C;

theorem 
  A c= B implies C*^A c= C*^B;

theorem 
  exp(A,{}) = 1;

theorem 
  exp(A,succ B) = A*^exp(A,B);

theorem 
  B <> {} & B is limit_ordinal implies for fi st dom fi = B & for
  C st C in B holds fi.C = exp(A,C) holds exp(A,B) = lim fi;

theorem 
  exp(A,1) = A & exp(1,A) = 1;

theorem 
  for A ex B,C st B is limit_ordinal & C is natural & A = B +^ C;



registration
  let X be set, o be Ordinal;
  cluster X --> o -> Ordinal-yielding;
end;

registration
  let O be Ordinal, x be set;
  cluster O --> x -> T-Sequence-like;
end;



definition
  let A,B be Ordinal;
  pred A is_cofinal_with B means

  ex xi being Ordinal-Sequence st dom xi = B &
  rng xi c= A & xi is increasing & A = sup xi;
  reflexivity;
end;

reserve e,u for set;

theorem 
  e in rng psi implies e is Ordinal;

theorem 
  rng psi c= sup psi;

theorem 
  A is_cofinal_with {} implies A = {};



scheme 

  OmegaInd {a()-> Nat, P[set]}:
   P[a()]
provided
 P[{}] and
 for a being Nat st P[a] holds P[succ a];

registration
  let a, b be Nat;
  cluster a +^ b -> natural;
end;



registration
  let x,y be set, a,b be Nat;
  cluster IFEQ(x,y,a,b) -> natural;
end;



scheme 
 LambdaRecEx{A() -> set,G(set,set) -> set}:
   ex f being Function st dom f = omega & f.{} = A() &
    for n being Nat holds f.succ n = G(n,f.n);

reserve n for Nat;

scheme 
 RecUn{A() -> set, F, G() -> Function, P[set,set,set]}:
 F() = G()
provided
 dom F() = omega and
 F().{} = A() and
 for n holds P[n,F().n,F().(succ n)] and
 dom G() = omega and
 G().{} = A() and
 for n holds P[n,G().n,G().(succ n)] and
 for n for x,y1,y2 being set st P[n,x,y1] & P[n,x,y2] holds y1 = y2;

scheme 
 LambdaRecUn{A() -> set, F(set,set) -> set, F, G() -> Function}:
   F() = G()
provided
 dom F() = omega and
 F().{} = A() and
 for n holds F().(succ n) = F(n,F().n) and
 dom G() = omega and
 G().{} = A() and
 for n holds G().(succ n) = F(n,G().n);














begin

reserve fi,psi for Ordinal-Sequence,
  A,B,C,D for Ordinal,
  X,Y for set,
  x,y for set;

theorem 
  X c= succ X;

theorem 
  succ X c= Y implies X c= Y;

theorem 
  A in B iff succ A in succ B;

theorem 
  X c= A implies union X is Ordinal;

theorem 
  union On X is Ordinal;

theorem 
  X c= A implies On X = X;

theorem 
  On {A} = {A};

theorem 
  A <> {} implies {} in A;

theorem 
  inf A = {};

theorem 
  inf {A} = A;

theorem 
  X c= A implies meet X is Ordinal;

registration
  let A,B;
  cluster A \/ B -> ordinal;
  cluster A /\ B -> ordinal;
end;

theorem 
  A \/ B = A or A \/ B = B;

theorem 
  A /\ B = A or A /\ B = B;

theorem 
  A in 1 implies A = {};

theorem 
  1 = {{}};

theorem 
  A c= 1 implies A = {} or A = 1;

theorem 
  (A c= B or A in B) & C in D implies A+^C in B+^D;

theorem 
  A c= B & C c= D implies A+^C c= B+^D;

theorem 
  A in B & (C c= D & D <> {} or C in D) implies A*^C in B*^D;

theorem 
  A c= B & C c= D implies A*^C c= B*^D;

theorem 
  B+^C = B+^D implies C = D;

theorem 
  B+^C in B+^D implies C in D;

theorem 
  B+^C c= B+^D implies C c= D;

theorem 
  A c= A+^B & B c= A+^B;

theorem 
  A in B implies A in B+^C & A in C+^B;

theorem 
  A+^B = {} implies A = {} & B = {};

theorem 
  A c= B implies ex C st B = A+^C;

theorem 
  A in B implies ex C st B = A+^C & C <> {};

theorem 
  A <> {} & A is limit_ordinal implies B+^A is limit_ordinal;

theorem 
  A+^B+^C = A+^(B+^C);

theorem 
  A*^B = {} implies A = {} or B = {};

theorem 
  A in B & C <> {} implies A in B*^C & A in C*^B;

theorem 
  B*^A = C*^A & A <> {} implies B = C;

theorem 
  B*^A in C*^A implies B in C;

theorem 
  B*^A c= C*^A & A <> {} implies B c= C;

theorem 
  B <> {} implies A c= A*^B & A c= B*^A;

theorem 
  A*^B = 1 implies A = 1 & B = 1;

theorem 
  A in B+^C implies A in B or ex D st D in C & A = B+^D;

definition
  let C,fi;

  func C+^fi -> Ordinal-Sequence means


  dom it = dom fi & for A st A in dom fi holds it.A = C+^(fi.A);
  func fi+^C -> Ordinal-Sequence means

  dom it = dom fi & for A st A in dom fi holds it.A = (fi.A)+^C;
  func C*^fi -> Ordinal-Sequence means

  dom it = dom fi & for A st A in dom fi holds it.A = C*^(fi.A);
  func fi*^C -> Ordinal-Sequence means


  dom it = dom fi & for A st A in dom fi holds it.A = (fi.A)*^C;
end;

theorem 
  {} <> dom fi & dom fi = dom psi & (for A,B st A in dom fi & B =
  fi.A holds psi.A = C+^B) implies sup psi = C+^sup fi;

theorem 
  A is limit_ordinal implies A*^B is limit_ordinal;

theorem 
  A in B*^C & B is limit_ordinal implies ex D st D in B & A in D*^ C;

theorem 
  dom fi = dom psi & C <> {} & sup fi is limit_ordinal & (for A,B
  st A in dom fi & B = fi.A holds psi.A = B*^C) implies sup psi = (sup fi)*^C;

theorem 
  {} <> dom fi implies sup (C+^fi) = C+^sup fi;

theorem 
  {} <> dom fi & C <> {} & sup fi is limit_ordinal implies sup (fi
  *^C) = (sup fi)*^C;

theorem 
  B <> {} implies union(A+^B) = A+^union B;

theorem 
  (A+^B)*^C = A*^C +^ B*^C;

theorem 
  A <> {} implies ex C,D st B = C*^A+^D & D in A;

theorem 
  for C1,D1,C2,D2 being Ordinal st C1*^A+^D1 = C2*^A+^D2 & D1 in A
  & D2 in A holds C1 = C2 & D1 = D2;

theorem 
  1 in B & A <> {} & A is limit_ordinal implies for fi st dom fi =
  A & for C st C in A holds fi.C = C*^B holds A*^B = sup fi;

theorem 
  (A*^B)*^C = A*^(B*^C);

definition
  let A,B;
  func A -^ B -> Ordinal means


  A = B+^it if B c= A otherwise it = {};
  func A div^ B -> Ordinal means


  ex C st A = it*^B+^C & C in B if B <> {} otherwise it = {};
end;

definition
  let A,B;
  func A mod^ B -> Ordinal equals

  A-^(A div^ B)*^B;
end;

theorem 
  A in B implies B = A+^(B-^A);

theorem 
  A+^B-^A = B;

theorem 
  A in B & (C c= A or C in A) implies A-^C in B-^C;

theorem 
  A-^A = {};

theorem 
  A in B implies B-^A <> {} & {} in B-^A;

theorem 
  A-^{} = A & {}-^A = {};

theorem 
  A-^(B+^C) = (A-^B)-^C;

theorem 
  A c= B implies C-^B c= C-^A;

theorem 
  A c= B implies A-^C c= B-^C;

theorem 
  C <> {} & A in B+^C implies A-^B in C;

theorem 
  A+^B in C implies B in C-^A;

theorem 
  A c= B+^(A-^B);

theorem 
  A*^C -^ B*^C = (A-^B)*^C;

theorem 
  (A div^ B)*^B c= A;

theorem 
  A = (A div^ B)*^B+^(A mod^ B);

theorem 
  A = B*^C+^D & D in C implies B = A div^ C & D = A mod^ C;

theorem 
  A in B*^C implies A div^ C in B & A mod^ C in C;

theorem 
  B <> {} implies A*^B div^ B = A;

theorem 
  A*^B mod^ B = {};

theorem 
  {} div^ A = {} & {} mod^ A = {} & A mod^ {} = A;

theorem 
  A div^ 1 = A & A mod^ 1 = {};

begin 


theorem 
  sup X c= succ union On X;



reserve e,u for set;

theorem 
  succ A is_cofinal_with 1;



theorem 
  for a,b being Ordinal st a+^b is natural holds a in omega & b in omega;

registration
  let a, b be natural Ordinal;
  cluster a -^ b -> natural;
  cluster a *^ b -> natural;
end;

theorem 
  for a,b being Ordinal st a*^b is natural non empty holds a in omega &
  b in omega;

definition
  let a,b be natural Ordinal;
  redefine func a+^b;
  commutativity;
end;

definition
  let a,b be natural Ordinal;
  redefine func a*^b;
  commutativity;
end;














begin

reserve a,b,x,y,z,z1,z2,z3,y1,y3,y4,A,B,C,D,G,M,N,X,Y,Z,W0,W00 for set,
  R,S,T, W,W1,W2 for Relation,
  F,H,H1 for Function;

theorem 
  x in field R iff ex y st ([x,y] in R or [y,x] in R);

theorem 
  X <> {} & Y <> {} & W = [: X,Y :] implies field W = X \/ Y;

scheme 

  RSeparation { A()-> set, P[Relation] } : ex B st for R being Relation holds
  R in B iff R in A() & P[R];

theorem 
  for x,y,W st x in field W & y in field W & W is well-ordering
  holds not x in W-Seg(y) implies [y,x] in W;

theorem 
  for x,y,W st x in field W & y in field W & W is well-ordering
  holds x in W-Seg(y) implies not [y,x] in W;

theorem 
  for F,D st (for X st X in D holds not F.X in X & F.X in union D)
ex R st field R c= union D & R is well-ordering & not field R in D & for y st y
  in field R holds R-Seg(y) in D & F.(R-Seg(y)) = y;

theorem 
  for N ex R st R is well-ordering & field R = N;














begin 

definition
  let f be Function;
  let a,b,c be set;
  func f.(a,b,c) -> set equals

  f.[a,b,c];
end;

reserve A,B,C,D,E for non empty set,
  a for Element of A,
  b for Element of B,
  c for Element of C,
  d for Element of D,
  X,Y,Z,S,x,y,z,s,t for set;

definition
  let A,B,C,D;
  let f be Function of [:A,B,C:],D;
  let a,b,c;
  redefine func f.(a,b,c) -> Element of D;
end;

theorem 
  for f1,f2 being Function of [:X,Y,Z:],D st for x,y,z st x in X &
  y in Y & z in Z holds f1.[x,y,z] = f2.[x,y,z] holds f1 = f2;

theorem 
  for f1,f2 being Function of [:A,B,C:],D st for a,b,c holds f1.[a,
  b,c] = f2.[a,b,c] holds f1 = f2;

theorem 
  for f1,f2 being Function of [:A,B,C:],D st for a being Element of A
for b being Element of B for c being Element of C holds f1.(a,b,c) = f2.(a,b,c)
  holds f1 = f2;

definition
  let A be set;
  mode TriOp of A is Function of [:A,A,A:],A;
end;

scheme 

  FuncEx3D { X,Y,Z,T() -> non empty set, P[set,set,set,set] } : ex f being
  Function of [:X(),Y(),Z():],T() st for x being Element of X() for y being
  Element of Y() for z being Element of Z() holds P[x,y,z,f.[x,y,z]]
provided
 for x being Element of X() for y being Element of Y() for z being
Element of Z() ex t being Element of T() st P[x,y,z,t];

scheme 

  TriOpEx { A()->non empty set, P[ Element of A(), Element of A(), Element of
A(), Element of A()] }: ex o being TriOp of A() st for a,b,c being Element of A
  () holds P[a,b,c,o.(a,b,c)]
provided
 for x,y,z being Element of A() ex t being Element of A() st P[x,y,z, t];

scheme 

  Lambda3D { X, Y, Z, T()->non empty set, F( Element of X(), Element of Y(),
Element of Z()) -> Element of T() }: ex f being Function of [:X(),Y(),Z():],T()
st for x being Element of X() for y being Element of Y() for z being Element of
  Z() holds f.[x,y,z]=F(x,y,z);

scheme 

  TriOpLambda { A,B,C,D()->non empty set, O( Element of A(), Element of B(),
Element of C()) -> Element of D() }: ex o being Function of [:A(),B(),C():],D()
  st for a being Element of A(), b being Element of B(), c being Element of C()
  holds o.(a,b,c) = O(a,b,c);



definition
  let f be Function;
  let a,b,c,d be set;
  func f.(a,b,c,d) -> set equals

  f.[a,b,c,d];
end;

definition
  let A,B,C,D,E;
  let f be Function of [:A,B,C,D:],E;
  let a,b,c,d;
  redefine func f.(a,b,c,d) -> Element of E;
end;

theorem 
  for f1,f2 being Function of [:X,Y,Z,S:],D st for x,y,z,s st x in
  X & y in Y & z in Z & s in S holds f1.[x,y,z,s] = f2.[x,y,z,s] holds f1 = f2;

theorem 
  for f1,f2 being Function of [:A,B,C,D:],E st for a,b,c,d holds f1
  .[a,b,c,d] = f2.[a,b,c,d] holds f1 = f2;

theorem 
  for f1,f2 being Function of [:A,B,C,D:],E st for a,b,c,d holds f1.(a,b
  ,c,d) = f2.(a,b,c,d) holds f1 = f2;

definition
  let A;
  mode QuaOp of A is Function of [:A,A,A,A:],A;
end;

scheme 

  FuncEx4D { X, Y, Z, S, T() -> non empty set, P[set,set,set,set,set] }: ex f
  being Function of [:X(),Y(),Z(),S():],T() st for x being Element of X() for y
  being Element of Y() for z being Element of Z() for s being Element of S()
  holds P[x,y,z,s,f.[x,y,z,s]]
provided
 for x being Element of X() for y being Element of Y() for z being
Element of Z() for s being Element of S() ex t being Element of T() st P[x,y,z,
s,t];

scheme 

  QuaOpEx { A()->non empty set, P[ Element of A(), Element of A(), Element of
A(), Element of A(), Element of A()] }: ex o being QuaOp of A() st for a,b,c,d
  being Element of A() holds P[a,b,c,d,o.(a,b,c,d)]
provided
 for x,y,z,s being Element of A() ex t being Element of A() st P[x,y, z,s,t];

scheme 

  Lambda4D { X, Y, Z, S, T() -> non empty set, F( Element of X(), Element of Y
(), Element of Z(), Element of S()) -> Element of T() }: ex f being Function of
[:X(),Y(),Z(),S():],T() st for x being Element of X() for y being Element of Y(
) for z being Element of Z() for s being Element of S() holds f.[x,y,z,s]=F(x,y
  ,z,s);

scheme 

  QuaOpLambda { A()->non empty set, O( Element of A(), Element of A(), Element
of A(), Element of A()) -> Element of A() }: ex o being QuaOp of A() st for a,b
  ,c,d being Element of A() holds o.(a,b,c,d) = O(a,b,c,d);














begin

reserve a,b,d for set;

scheme 

  Schemat0 {P[set]} : ex a st P[a]
provided
 for a holds P[a];

scheme 

  Schemat3 {S[set,set]} : for b ex a st S[a,b]
provided
 ex a st for b holds S[a,b];

scheme 

  Schemat8 {P[set],Q[set]} : (for a holds P[a]) implies for a holds Q[a]
provided
 for a holds P[a] implies Q[a];

scheme 

  Schemat9 {P[set],Q[set]} : (for a holds P[a]) iff for a holds Q[a]
provided
 for a holds P[a] iff Q[a];

scheme 

  Schemat17 {P[set],T[]} : (for a holds P[a]) implies T[]
provided
 for a holds P[a] implies T[];

scheme 

  Schemat18a {P[set],Q[set]} : ex a st for b holds P[a] or Q[b]
provided
 (ex a st P[a]) or for b holds Q[b];

scheme 

  Schemat18b {P[set],Q[set]} : (ex a st P[a]) or for b holds Q[b]
provided
 ex a st for b holds P[a] or Q[b];

scheme 

  Schemat20b {P[set],Q[set]} : ex a st for b holds P[a] or Q[b]
provided
 for b ex a st P[a] or Q[b];

scheme 

  Schemat22a {P[set],Q[set]} : for b ex a st P[a] & Q[b]
provided
 (ex a st P[a]) & for b holds Q[b];

scheme 

  Schemat22b {P[set],Q[set]} : (ex a st P[a]) & for b holds Q[b]
provided
 for b ex a st P[a] & Q[b];

scheme 

  Schemat23b {P[set],Q[set]} : ex a st for b holds P[a] & Q[b]
provided
 for b ex a st P[a] & Q[b];

scheme 

  Schemat28 {S[set,set]} : ex b st for a holds S[a,b]
provided
 for a,b holds S[a,b];

scheme 

  Schemat30 {S[set,set]} : ex a st S[a,a]
provided
 ex a st for b holds S[a,b];

scheme 

  Schemat31 {S[set,set]} : for a ex b st S[b,a]
provided
 for a holds S[a,a];

scheme 

  Schemat33 {S[set,set]} : for a ex b st S[a,b]
provided
 for a holds S[a,a];

scheme 

  Schemat36 {S[set,set]} : ex a,b st S[a,b]
provided
 for b ex a st S[a,b];














begin

 reserve x,y,z,t,X,Y,Z,W for set;
 reserve R,S,T for Relation;

theorem 
  dom (R /\ [:X,Y:]) c= X & rng (R /\ [:X,Y:]) c= Y;

theorem 
  X misses Y implies dom (R /\ [:X,Y:]) misses rng (R /\ [:X,Y:]);

theorem 
  R c= [:X,Y:] implies dom R c= X & rng R c= Y;

theorem 
  R c= [:X,Y:] implies R~ c= [:Y,X:];

theorem 
  [:X,Y:]~ = [:Y,X:];

theorem 
  (R \/ S) * T = (R * T) \/ (S * T);

theorem 
  (X misses Y & R c= [:X,Y:] \/ [:Y,X:] & [x,y] in R & x in X implies
    not x in Y & not y in X & y in Y) &
  (X misses Y & R c= [:X,Y:] \/ [:Y,X:] & [x,y] in R & y in Y implies
    not y in X & not x in Y & x in X) &
  (X misses Y & R c= [:X,Y:] \/ [:Y,X:] & [x,y] in R & x in Y implies
    not x in X & not y in Y & y in X) &
  (X misses Y & R c= [:X,Y:] \/ [:Y,X:] & [x,y] in R & y in X implies
    not x in X & not y in Y & x in Y);

theorem 
  R c= [:X,Y:] implies R|Z = R /\ [:Z,Y:] & (Z|`R) = R /\ [:X,Z:];

theorem 
  R c= [:X,Y:] & X = Z \/ W implies R = (R|Z) \/ (R|W);

theorem 
  X misses Y & R c= [:X,Y:] \/ [:Y,X:] implies R|X c= [:X,Y:];

theorem 
  R c= S implies R~ c= S~;

theorem 
  id(X) * id(X) = id X;

theorem 
  id({x}) = {[x,x]};

theorem 
  id(X \/ Y) = id(X) \/ id(Y) & id(X /\ Y) = id(X) /\ id(Y) &
  id(X \ Y) = id(X) \ id(Y);

theorem 
  X c= Y implies id X c= id Y;

theorem 
  id(X \ Y) \ id X = {};

theorem 
  R c= id dom R implies R = id dom R;

theorem 
  id X c= R \/ R~ implies id X c= R & id X c= R~;

theorem 
  id X c= R implies id X c= R~;



theorem 
  R c= [:X,X:] implies R \ id dom R = R \ id X & R \ id rng R = R \ id X;

theorem 
  (id(X) * (R \ id X) = {} implies dom (R \ id X) = dom R \ X) &
  ((R \ id X) * id X = {} implies rng (R \ id X) = rng R \ X);

theorem 
  (R c= R * R & R * (R \ id rng R) = {} implies id rng R c= R) &
  (R c= R * R & (R \ id dom R) * R = {} implies id dom R c= R);

theorem 
  (R c= R * R & R * (R \ id rng R) = {} implies R /\ (id rng R) = id rng R) &
  (R c= R * R & (R \ id dom R) * R = {} implies
    R /\ (id dom R) = id dom R);

theorem 
  (R * (R \ id X) = {} implies R * (R \ id rng R) = {}) &
  ((R \ id X) * R = {} implies (R \ id dom R) * R = {});



definition
  let R;
  func CL R -> Relation equals

  R /\ id dom R;
end;

theorem 
  [x,y] in CL R implies x in dom CL R & x = y;

theorem 
  dom CL R = rng CL R;

theorem 
  (x in dom CL R iff x in dom R & [x,x] in R) &
  (x in rng CL R iff x in dom R & [x,x] in R) &
  (x in rng CL R iff x in rng R & [x,x] in R) &
  (x in dom CL R iff x in rng R & [x,x] in R);

theorem 
  CL R = id dom CL R;

theorem 
  (R * R = R & R * (R \ CL R) = {} & [x,y] in R & x <> y implies
    x in (dom R \ dom CL R) & y in dom CL R) &
  (R * R = R & (R \ CL R) * R = {} & [x,y] in R & x <> y implies
    y in (rng R \ dom CL R) & x in dom CL R);

theorem 
  (R * R = R & R * (R \ id dom R) = {} & [x,y] in R & x <> y implies
    x in ((dom R) \ dom CL R) & y in dom CL R) &
  (R * R = R & (R \ id dom R) * R = {} & [x,y] in R & x <> y implies
    y in ((rng R) \ dom CL R) & x in dom CL R);

theorem 
  (R * R = R & R * (R \ id dom R) = {} implies dom CL R = rng R &
    rng CL R = rng R) &
  (R * R = R & (R \ id dom R) * R = {} implies dom CL R = dom R &
    rng CL R = dom R);

theorem 
  dom CL R c= dom R & rng CL R c= rng R & rng CL R c= dom R & dom CL R c= rng R
;

theorem 
  id dom CL R c= id dom R & id rng CL R c= id dom R;

theorem 
  id dom CL R c= R & id rng CL R c= R;

theorem 
  (id X c= R & id(X) * (R \ id X) = {} implies R|X = id X) &
  (id X c= R & (R \ id X) * id X = {} implies X|`R = id X);

theorem 
  (id(dom CL R) * (R \ id(dom CL R)) = {} implies R|(dom CL R) = id dom CL R &
    R|(rng CL R) = id dom CL R) &
  ((R \ id rng CL R) * id(rng CL R) = {} implies
    (dom CL R)|`R = id dom CL R &
    (rng CL R)|`R = id rng CL R);

theorem 
  (R * (R \ id dom R) = {} implies id(dom CL R) * (R \ id dom CL R) = {}) &
  ((R \ id dom R) * R = {} implies
    (R \ id dom CL R) * id dom CL R = {});

theorem 
  (S * R = S & R * (R \ id dom R) = {} implies S * (R \ id dom R) = {}) &
  (R * S = S & (R \ id dom R) * R = {} implies (R \ id dom R) * S = {});

theorem 
  (S * R = S & R * (R \ id dom R) = {} implies CL(S) c= CL(R)) &
  (R * S = S & (R \ id dom R) * R = {} implies CL(S) c= CL(R));

theorem 
  (S * R = S & R * (R \ id dom R) = {} & R * S = R &
    S * (S \ id dom S) = {} implies CL S = CL R) &
  (R * S = S & (R \ id dom R) * R = {} & S * R = R &
    (S \ id dom S) * S = {} implies CL S = CL R);














begin 

definition
  let a be set;
  func NOT1 a equals


  {} if a is non empty otherwise {{}};
end;

registration
  let a be empty set;
  cluster NOT1 a -> non empty;
end;

registration
  let a be non empty set;
  cluster NOT1 a -> empty;
end;

theorem 
  NOT1 {{}} = {} & NOT1 {} = {{}};

theorem 
  for a being set holds NOT1 a is non empty iff not a is non empty;

reserve a,b,c,d,e,f,g,h for set;

theorem 
  NOT1 {} is non empty;

definition
  let a,b be set;
  func AND2(a,b) equals


  NOT1 {} if a is non empty & b is non empty
  otherwise {};
  commutativity;
end;

registration
  let a,b be non empty set;
  cluster AND2(a,b) -> non empty;
end;

registration
  let a be empty set, b be set;
  cluster AND2(a,b) -> empty;
end;

theorem 
  AND2(a,b) is non empty iff a is non empty & b is non empty;

definition
  let a,b be set;
  func OR2(a, b) equals


  NOT1 {} if a is non empty or b is non empty
  otherwise {};
  commutativity;
end;

registration
  let a be set,b be non empty set;
  cluster OR2(a,b) -> non empty;
end;

registration
  let a,b be empty set;
  cluster OR2(a,b) -> empty;
end;

theorem 
  OR2(a,b) is non empty iff (a is non empty or b is non empty);

definition
  let a,b be set;
  func XOR2(a,b) equals


  NOT1 {} if a is non empty & not b is non empty
  or not a is non empty & b is non empty otherwise {};
  commutativity;
end;

registration
  let a be empty set,b be non empty set;
  cluster XOR2(a,b) -> non empty;
end;

registration
  let a,b be empty set;
  cluster XOR2(a,b) -> empty;
end;

registration
  let a,b be non empty set;
  cluster XOR2(a,b) -> empty;
end;

theorem 
  XOR2(a, b) is non empty iff a is non empty & not b is non empty or not
  a is non empty & b is non empty;

theorem 
  not XOR2(a,a) is non empty;

theorem 
  XOR2(a,{}) is non empty iff a is non empty;

theorem 
  XOR2(a,b) is non empty iff XOR2(b,a) is non empty;

definition
  let a,b be set;
  func EQV2(a, b) equals


  NOT1 {} if a is non empty iff b is non empty
  otherwise {};
  commutativity;
end;

registration
  let a be empty set,b be non empty set;
  cluster EQV2(a,b) -> empty;
end;

registration
  let a,b be empty set;
  cluster EQV2(a,b) -> non empty;
end;

registration
  let a,b be non empty set;
  cluster EQV2(a,b) -> non empty;
end;

theorem 
  EQV2(a, b) is non empty iff (a is non empty iff b is non empty);

theorem 
  EQV2(a,b) is non empty iff not XOR2(a,b) is non empty;

definition
  let a,b be set;
  func NAND2(a, b) equals


  NOT1 {} if not (a is non empty & b is non
  empty) otherwise {};
  commutativity;
end;

registration
  let a be empty set, b be set;
  cluster NAND2(a,b) -> non empty;
end;

registration
  let a,b be non empty set;
  cluster NAND2(a,b) -> empty;
end;

theorem 
  NAND2(a, b) is non empty iff not (a is non empty & b is non empty);

definition
  let a,b be set;
  func NOR2(a, b) equals


  NOT1 {} if not (a is non empty or b is non
  empty) otherwise {};
  commutativity;
end;

registration
  let a,b be empty set;
  cluster NOR2(a,b) -> non empty;
end;

registration
  let a be non empty set, b be set;
  cluster NOR2(a,b) -> empty;
end;

theorem 
  NOR2(a,b) is non empty iff not (a is non empty or b is non empty);

definition
  let a,b,c be set;
  func AND3(a,b,c) equals


  NOT1 {} if a is non empty & b is non empty &
  c is non empty otherwise {};
end;

registration
  let a,b,c be non empty set;
  cluster AND3(a,b,c) -> non empty;
end;

registration
  let a be empty set, b,c be set;
  cluster AND3(a,b,c) -> empty;
  cluster AND3(b,a,c) -> empty;
  cluster AND3(b,c,a) -> empty;
end;

theorem 
  AND3(a,b,c) is non empty iff a is non empty & b is non empty & c is
  non empty;

definition
  let a,b,c be set;
  func OR3(a,b,c) equals


  NOT1 {} if a is non empty or b is non empty or
  c is non empty otherwise {};
end;

registration
  let a,b,c be empty set;
  cluster OR3(a,b,c) -> empty;
end;

registration
  let a be non empty set, b,c be set;
  cluster OR3(a,b,c) -> non empty;
  cluster OR3(b,a,c) -> non empty;
  cluster OR3(b,c,a) -> non empty;
end;

theorem 
  OR3(a,b,c) is non empty iff a is non empty or b is non empty or c is
  non empty;

definition
  let a,b,c be set;
  func XOR3(a,b,c) equals


  NOT1 {} if ( a is non empty & not b is non
empty or not a is non empty & b is non empty ) & not c is non empty or not ( a
is non empty & not b is non empty or not a is non empty & b is non empty ) & c
  is non empty otherwise {};
end;

registration
  let a,b,c be empty set;
  cluster XOR3(a,b,c) -> empty;
end;

registration
  let a,b be empty set, c be non empty set;
  cluster XOR3(a,b,c) -> non empty;
  cluster XOR3(a,c,b) -> non empty;
  cluster XOR3(c,a,b) -> non empty;
end;

registration
  let a,b be non empty set, c be empty set;
  cluster XOR3(a,b,c) -> empty;
  cluster XOR3(a,c,b) -> empty;
  cluster XOR3(c,a,b) -> empty;
end;

registration
  let a,b,c be non empty set;
  cluster XOR3(a,b,c) -> non empty;
end;

theorem 
  XOR3(a,b,c) is non empty iff ( a is non empty & not b is non empty or
  not a is non empty & b is non empty ) & not c is non empty or not ( a is non
empty & not b is non empty or not a is non empty & b is non empty ) & c is non
  empty;

definition
  let a,b,c be set;
  func MAJ3(a,b,c) equals


  NOT1 {} if a is non empty & b is non empty
or b is non empty & c is non empty or c is non empty & a is non empty otherwise
  {};
end;

registration
  let a,b be non empty set, c be set;
  cluster MAJ3(a,b,c) -> non empty;
  cluster MAJ3(a,c,b) -> non empty;
  cluster MAJ3(c,a,b) -> non empty;
end;

registration
  let a,b be empty set, c be set;
  cluster MAJ3(a,b,c) -> empty;
  cluster MAJ3(a,c,b) -> empty;
  cluster MAJ3(c,a,b) -> empty;
end;

theorem 
  MAJ3(a,b,c) is non empty iff a is non empty & b is non empty or b is
  non empty & c is non empty or c is non empty & a is non empty;

definition
  let a,b,c be set;
  func NAND3(a,b,c) equals


  NOT1 {} if not (a is non empty & b is non
  empty & c is non empty) otherwise {};
end;

theorem 
  NAND3(a,b,c) is non empty iff not (a is non empty & b is non empty & c
  is non empty);

definition
  let a,b,c be set;
  func NOR3(a,b,c) equals


  NOT1 {} if not (a is non empty or b is non
  empty or c is non empty) otherwise {};
end;

theorem 
  NOR3(a,b,c) is non empty iff not (a is non empty or b is non empty or
  c is non empty);

definition
  let a,b,c,d be set;
  func AND4(a,b,c,d) equals


  NOT1 {} if a is non empty & b is non empty
  & c is non empty & d is non empty otherwise {};
end;

theorem 
  AND4(a,b,c,d) is non empty iff a is non empty & b is non empty & c is
  non empty & d is non empty;

definition
  let a,b,c,d be set;
  func OR4(a,b,c,d) equals


  NOT1 {} if a is non empty or b is non empty
  or c is non empty or d is non empty otherwise {};
end;

theorem 
  OR4(a,b,c,d) is non empty iff a is non empty or b is non empty or c is
  non empty or d is non empty;

definition
  let a,b,c,d be set;
  func NAND4(a,b,c,d) equals


  NOT1 {} if not (a is non empty & b is non
  empty & c is non empty & d is non empty) otherwise {};
end;

theorem 
  NAND4(a,b,c,d) is non empty iff not (a is non empty & b is non empty &
  c is non empty & d is non empty);

definition
  let a,b,c,d be set;
  func NOR4(a,b,c,d) equals


  NOT1 {} if not (a is non empty or b is non
  empty or c is non empty or d is non empty) otherwise {};
end;

theorem 
  NOR4(a,b,c,d) is non empty iff not (a is non empty or b is non empty
  or c is non empty or d is non empty);

definition
  let a,b,c,d,e be set;
  func AND5(a,b,c,d,e) equals


  NOT1 {} if a is non empty & b is non
  empty & c is non empty & d is non empty & e is non empty otherwise {};
end;

theorem 
  AND5(a,b,c,d,e) is non empty iff a is non empty & b is non empty & c
  is non empty & d is non empty & e is non empty;

definition
  let a,b,c,d,e be set;
  func OR5(a,b,c,d,e) equals


  NOT1 {} if a is non empty or b is non
  empty or c is non empty or d is non empty or e is non empty otherwise {};
end;

theorem 
  OR5(a,b,c,d,e) is non empty iff a is non empty or b is non empty or c
  is non empty or d is non empty or e is non empty;

definition
  let a,b,c,d,e be set;
  func NAND5(a,b,c,d,e) equals


  NOT1 {} if not (a is non empty & b is
  non empty & c is non empty & d is non empty & e is non empty) otherwise {};
end;

theorem 
  NAND5(a,b,c,d,e) is non empty iff not (a is non empty & b is non empty
  & c is non empty & d is non empty & e is non empty);

definition
  let a,b,c,d,e be set;
  func NOR5(a,b,c,d,e) equals


  NOT1 {} if not (a is non empty or b is
non empty or c is non empty or d is non empty or e is non empty) otherwise {};
end;

theorem 
  NOR5(a,b,c,d,e) is non empty iff not (a is non empty or b is non empty
  or c is non empty or d is non empty or e is non empty);

definition
  let a,b,c,d,e,f be set;
  func AND6(a,b,c,d,e,f) equals


  NOT1 {} if a is non empty & b is non
  empty & c is non empty & d is non empty & e is non empty &f is non empty
  otherwise {};
end;

theorem 
  AND6(a,b,c,d,e,f) is non empty iff a is non empty & b is non empty & c
  is non empty & d is non empty & e is non empty &f is non empty;

definition
  let a,b,c,d,e,f be set;
  func OR6(a,b,c,d,e,f) equals


  NOT1 {} if a is non empty or b is non
  empty or c is non empty or d is non empty or e is non empty or f is non empty
  otherwise {};
end;

theorem 
  OR6(a,b,c,d,e,f) is non empty iff a is non empty or b is non empty or
c is non empty or d is non empty or e is non empty or f is non empty;

definition
  let a,b,c,d,e,f be set;
  func NAND6(a,b,c,d,e,f) equals


  NOT1 {} if not (a is non empty & b is
  non empty & c is non empty & d is non empty & e is non empty &f is non empty)
  otherwise {};
end;

theorem 
  NAND6(a,b,c,d,e,f) is non empty iff not (a is non empty & b is non
  empty & c is non empty & d is non empty & e is non empty &f is non empty);

definition
  let a,b,c,d,e,f be set;
  func NOR6(a,b,c,d,e,f) equals


  NOT1 {} if not (a is non empty or b is
  non empty or c is non empty or d is non empty or e is non empty or f is non
  empty) otherwise {};
end;

theorem 
  NOR6(a,b,c,d,e,f) is non empty iff not (a is non empty or b is non
empty or c is non empty or d is non empty or e is non empty or f is non empty);

definition
  let a,b,c,d,e,f,g be set;
  func AND7(a,b,c,d,e,f,g) equals


  NOT1 {} if a is non empty & b is non
  empty & c is non empty & d is non empty & e is non empty & f is non empty & g
  is non empty otherwise {};
end;

theorem 
  AND7(a,b,c,d,e,f,g) is non empty iff a is non empty & b is non empty &
  c is non empty & d is non empty & e is non empty & f is non empty & g is non
  empty;

definition
  let a,b,c,d,e,f,g be set;
  func OR7(a,b,c,d,e,f,g) equals


  NOT1 {} if a is non empty or b is non
  empty or c is non empty or d is non empty or e is non empty or f is non empty
  or g is non empty otherwise {};
end;

theorem 
  OR7(a,b,c,d,e,f,g) is non empty iff a is non empty or b is non empty
or c is non empty or d is non empty or e is non empty or f is non empty or g is
  non empty;

definition
  let a,b,c,d,e,f,g be set;
  func NAND7(a,b,c,d,e,f,g) equals


  NOT1 {} if not (a is non empty & b
  is non empty & c is non empty & d is non empty & e is non empty & f is non
  empty & g is non empty) otherwise {};
end;

theorem 
  NAND7(a,b,c,d,e,f,g) is non empty iff not (a is non empty & b is non
  empty & c is non empty & d is non empty & e is non empty & f is non empty & g
  is non empty);

definition
  let a,b,c,d,e,f,g be set;
  func NOR7(a,b,c,d,e,f,g) equals


  NOT1 {} if not (a is non empty or b
is non empty or c is non empty or d is non empty or e is non empty or f is non
  empty or g is non empty) otherwise {};
end;

theorem 
  NOR7(a,b,c,d,e,f,g) is non empty iff not (a is non empty or b is non
  empty or c is non empty or d is non empty or e is non empty or f is non empty
  or g is non empty);

definition
  let a,b,c,d,e,f,g,h be set;
  func AND8(a,b,c,d,e,f,g,h) equals


  NOT1 {} if a is non empty & b is
non empty & c is non empty & d is non empty & e is non empty & f is non empty &
  g is non empty & h is non empty otherwise {};
end;

theorem 
  AND8(a,b,c,d,e,f,g,h) is non empty iff a is non empty & b is non empty
& c is non empty & d is non empty & e is non empty & f is non empty & g is non
  empty & h is non empty;

definition
  let a,b,c,d,e,f,g,h be set;
  func OR8(a,b,c,d,e,f,g,h) equals


  NOT1 {} if a is non empty or b is
  non empty or c is non empty or d is non empty or e is non empty or f is non
  empty or g is non empty or h is non empty otherwise {};
end;

theorem 
  OR8(a,b,c,d,e,f,g,h) is non empty iff a is non empty or b is non empty
or c is non empty or d is non empty or e is non empty or f is non empty or g is
  non empty or h is non empty;

definition
  let a,b,c,d,e,f,g,h be set;
  func NAND8(a,b,c,d,e,f,g,h) equals


  NOT1 {} if not (a is non empty &
  b is non empty & c is non empty & d is non empty & e is non empty & f is non
  empty & g is non empty & h is non empty) otherwise {};
end;

theorem 
  NAND8(a,b,c,d,e,f,g,h) is non empty iff not (a is non empty & b is non
  empty & c is non empty & d is non empty & e is non empty & f is non empty & g
  is non empty & h is non empty);

definition
  let a,b,c,d,e,f,g,h be set;
  func NOR8(a,b,c,d,e,f,g,h) equals


  NOT1 {} if not (a is non empty or
  b is non empty or c is non empty or d is non empty or e is non empty or f is
  non empty or g is non empty or h is non empty) otherwise {};
end;

theorem 
  NOR8(a,b,c,d,e,f,g,h) is non empty iff not (a is non empty or b is non
  empty or c is non empty or d is non empty or e is non empty or f is non empty
  or g is non empty or h is non empty);

begin 




theorem 
  for c1,x1,x2,x3,x4,y1,y2,y3,y4,c2,c3,c4,c5,n1,n2,n3,n4,n,c5b being set
  holds (MAJ3(x1,y1,c1) is non empty implies c2 is non empty) & (MAJ3(x2,y2,c2)
is non empty implies c3 is non empty) & (MAJ3(x3,y3,c3) is non empty implies c4
is non empty) & (MAJ3(x4,y4,c4) is non empty implies c5 is non empty) & (n1 is
non empty implies OR2(x1,y1) is non empty)& (n2 is non empty implies OR2(x2,y2)
  is non empty)& (n3 is non empty implies OR2(x3,y3) is non empty)& (n4 is non
empty implies OR2(x4,y4) is non empty)& (n is non empty implies AND5(c1,n1,n2,
n3,n4) is non empty)& (c5b is non empty iff OR2(c5,n) is non empty) implies (c5
  is non empty iff c5b is non empty);



definition
  let a,b be set;
  func MODADD2(a,b) equals


  NOT1 {} if (a is non empty or b is non
  empty) & not(a is non empty & b is non empty) otherwise {};
  commutativity;
end;

theorem 
  MODADD2(a,b) is non empty iff (a is non empty or b is non empty) & not
  (a is non empty & b is non empty);



notation
  let a,b,c be set;
  synonym ADD1(a,b,c) for XOR3(a,b,c);
  synonym CARR1(a,b,c) for MAJ3(a,b,c);
end;



definition
  let a1,b1,a2,b2,c be set;

  func ADD2(a2,b2,a1,b1,c) equals

  XOR3(a2,b2,CARR1(a1,b1,c));
end;

definition
  let a1,b1,a2,b2,c be set;
  func CARR2(a2,b2,a1,b1,c) equals

  MAJ3(a2,b2,CARR1(a1,b1,c));
end;



definition
  let a1,b1,a2,b2,a3,b3,c be set;
  func ADD3(a3,b3,a2,b2,a1,b1,c) equals

  XOR3(a3,b3,CARR2(a2,b2,a1,b1,c));
end;

definition
  let a1,b1,a2,b2,a3,b3,c be set;
  func CARR3(a3,b3,a2,b2,a1,b1,c) equals

  MAJ3(a3,b3,CARR2(a2,b2,a1,b1,c));
end;



definition
  let a1,b1,a2,b2,a3,b3,a4,b4,c be set;
  func ADD4(a4,b4,a3,b3,a2,b2,a1,b1,c) equals

  XOR3(a4,b4,CARR3(a3,b3,a2,b2,a1,
  b1,c));
end;

definition
  let a1,b1,a2,b2,a3,b3,a4,b4,c be set;
  func CARR4(a4,b4,a3,b3,a2,b2,a1,b1,c) equals

  MAJ3(a4,b4,CARR3(a3,b3,a2,b2,a1
  ,b1,c));
end;






theorem 
  for c1,x1,y1,x2,y2,x3,y3,x4,y4,c4, q1,p1,sd1,q2,p2,sd2,q3,p3,sd3,q4,p4
  ,sd4,cb1,cb2,l2,t2,l3,m3, t3,l4,m4,n4,t4,l5,m5,n5,o5,s1,s2,s3,s4 being set
  holds (q1 is non empty iff NOR2(x1,y1) is non empty)& (p1 is non empty iff
NAND2(x1,y1) is non empty)& (sd1 is non empty iff MODADD2(x1,y1) is non empty)&
(q2 is non empty iff NOR2(x2,y2) is non empty)& (p2 is non empty iff NAND2(x2,
  y2) is non empty)& (sd2 is non empty iff MODADD2(x2,y2) is non empty)& (q3 is
  non empty iff NOR2(x3,y3) is non empty)& (p3 is non empty iff NAND2(x3,y3) is
  non empty)& (sd3 is non empty iff MODADD2(x3,y3) is non empty)& (q4 is non
  empty iff NOR2(x4,y4) is non empty)& (p4 is non empty iff NAND2(x4,y4) is non
  empty)& (sd4 is non empty iff MODADD2(x4,y4) is non empty)& (cb1 is non empty
iff NOT1 c1 is non empty)& (cb2 is non empty iff NOT1 cb1 is non empty)& (s1 is
non empty iff XOR2(cb2,sd1) is non empty)& (l2 is non empty iff AND2(cb1,p1) is
  non empty)& (t2 is non empty iff NOR2(l2,q1) is non empty)& (s2 is non empty
iff XOR2(t2,sd2) is non empty)& (l3 is non empty iff AND2(q1,p2) is non empty)&
(m3 is non empty iff AND3(p2,p1,cb1) is non empty)& (t3 is non empty iff NOR3(
  l3,m3,q2) is non empty)& (s3 is non empty iff XOR2(t3,sd3) is non empty)& (l4
is non empty iff AND2(q2,p3) is non empty)& (m4 is non empty iff AND3(q1,p3,p2)
  is non empty)& (n4 is non empty iff AND4(p3,p2,p1,cb1) is non empty)& (t4 is
non empty iff NOR4(l4,m4,n4,q3) is non empty)& (s4 is non empty iff XOR2(t4,sd4
  ) is non empty)& (l5 is non empty iff AND2(q3,p4) is non empty)& (m5 is non
empty iff AND3(q2,p4,p3) is non empty)& (n5 is non empty iff AND4(q1,p4,p3,p2)
is non empty)& (o5 is non empty iff AND5(p4,p3,p2,p1,cb1) is non empty)& (c4 is
  non empty iff NOR5(q4,l5,m5,n5,o5) is non empty) implies (s1 is non empty iff
ADD1(x1,y1,c1) is non empty)& (s2 is non empty iff ADD2(x2,y2,x1,y1,c1) is non
  empty)& (s3 is non empty iff ADD3(x3,y3,x2,y2,x1,y1,c1) is non empty)& (s4 is
non empty iff ADD4(x4,y4,x3,y3,x2,y2,x1,y1,c1) is non empty)& (c4 is non empty
  iff CARR4(x4,y4,x3,y3,x2,y2,x1,y1,c1) is non empty);














begin 

reserve a,b,c,d for set;




theorem 
  for s0,s1,s2,s3,s4,s5,s6,s7,ns0,ns1,ns2,ns3,ns4,ns5,ns6,ns7,q1,q2,q3,
nq1, nq2,nq3 being set holds (s0 is non empty iff AND3(NOT1 q3,NOT1 q2,NOT1 q1)
is not empty)& (s1 is non empty iff AND3(NOT1 q3,NOT1 q2,q1) is not empty)& (s2
  is non empty iff AND3(NOT1 q3,q2,NOT1 q1) is not empty)& (s3 is non empty iff
AND3(NOT1 q3,q2,q1) is not empty)& (s4 is non empty iff AND3(q3,NOT1 q2,NOT1 q1
) is not empty)& (s5 is non empty iff AND3(q3,NOT1 q2,q1) is not empty)& (s6 is
non empty iff AND3(q3,q2,NOT1 q1) is not empty)& (s7 is non empty iff AND3(q3,
q2,q1) is not empty)& (ns0 is non empty iff AND3(NOT1 nq3,NOT1 nq2,NOT1 nq1) is
not empty)& (ns1 is non empty iff AND3(NOT1 nq3,NOT1 nq2,nq1) is not empty)& (
  ns2 is non empty iff AND3(NOT1 nq3,nq2,NOT1 nq1) is not empty)& (ns3 is non
empty iff AND3(NOT1 nq3,nq2,nq1) is not empty)& (ns4 is non empty iff AND3(nq3,
NOT1 nq2,NOT1 nq1) is not empty)& (ns5 is non empty iff AND3(nq3,NOT1 nq2,nq1)
is not empty)& (ns6 is non empty iff AND3(nq3,nq2,NOT1 nq1) is not empty)& (ns7
  is non empty iff AND3(nq3,nq2,nq1) is not empty)& (nq1 is non empty iff (NOT1
q1) is not empty)& (nq2 is non empty iff XOR2(q1,q2) is not empty)& (nq3 is non
empty iff OR2(AND2(q3, NOT1 q1), AND2(q1, XOR2(q2,q3))) is not empty) implies (
ns1 is non empty iff s0 is non empty)& (ns2 is non empty iff s1 is non empty)&
(ns3 is non empty iff s2 is non empty)& (ns4 is non empty iff s3 is non empty)&
(ns5 is non empty iff s4 is non empty)& (ns6 is non empty iff s5 is non empty)&
(ns7 is non empty iff s6 is non empty)& (ns0 is non empty iff s7 is non empty);

theorem 
  AND3(AND2(a,d),AND2(b,d),AND2(c,d)) is non empty iff AND2(AND3(a,b,c),
  d) is non empty;

theorem 
  (not AND2(a,b) is non empty iff OR2(NOT1 a, NOT1 b) is non empty)& (
OR2(a,b) is non empty & OR2(c,b) is non empty iff OR2(AND2(a,c),b) is non empty
) & (OR2(a,b) is non empty & OR2(c,b) is non empty & OR2(d,b) is non empty iff
OR2(AND3(a,c,d),b) is non empty)& (OR2(a,b) is non empty & (a is non empty iff
  c is non empty) implies OR2(c,b) is non empty );





theorem 
  for s0,s1,s2,s3,s4,s5,s6,s7,ns0,ns1,ns2,ns3,ns4,ns5,ns6,ns7,q1,q2,q3,
  nq1, nq2,nq3,R being set holds (s0 is non empty iff AND3(NOT1 q3,NOT1 q2,NOT1
q1) is non empty)& (s1 is non empty iff AND3(NOT1 q3,NOT1 q2,q1) is non empty)&
  (s2 is non empty iff AND3(NOT1 q3,q2,NOT1 q1) is non empty)& (s3 is non empty
  iff AND3(NOT1 q3,q2,q1) is non empty)& (s4 is non empty iff AND3(q3,NOT1 q2,
NOT1 q1) is non empty)& (s5 is non empty iff AND3(q3,NOT1 q2,q1) is non empty)&
  (s6 is non empty iff AND3(q3,q2,NOT1 q1) is non empty)& (s7 is non empty iff
AND3(q3,q2,q1) is non empty)& (ns0 is non empty iff AND3(NOT1 nq3,NOT1 nq2,NOT1
  nq1) is non empty)& (ns1 is non empty iff AND3(NOT1 nq3,NOT1 nq2,nq1) is non
  empty)& (ns2 is non empty iff AND3(NOT1 nq3,nq2,NOT1 nq1) is non empty)& (ns3
  is non empty iff AND3(NOT1 nq3,nq2,nq1) is non empty)& (ns4 is non empty iff
AND3(nq3,NOT1 nq2,NOT1 nq1) is non empty)& (ns5 is non empty iff AND3(nq3,NOT1
  nq2,nq1) is non empty)& (ns6 is non empty iff AND3(nq3,nq2,NOT1 nq1) is non
  empty)& (ns7 is non empty iff AND3(nq3,nq2,nq1) is non empty)& (nq1 is non
empty iff AND2(NOT1 q1,R) is non empty)& (nq2 is non empty iff AND2(XOR2(q1,q2)
  ,R) is non empty)& (nq3 is non empty iff AND2(OR2(AND2(q3, NOT1 q1), AND2(q1,
XOR2(q2,q3))),R) is non empty) implies (ns1 is non empty iff AND2(s0,R) is non
  empty)& (ns2 is non empty iff AND2(s1,R) is non empty)& (ns3 is non empty iff
AND2(s2,R) is non empty)& (ns4 is non empty iff AND2(s3,R) is non empty)& (ns5
is non empty iff AND2(s4,R) is non empty)& (ns6 is non empty iff AND2(s5,R) is
  non empty)& (ns7 is non empty iff AND2(s6,R) is non empty)& (ns0 is non empty
  iff OR2(s7,NOT1 R) is non empty);














begin 




theorem 
  for s0,s1,s2,s3,ns0,ns1,ns2,ns3,q1,q2,nq1,nq2 being set holds (s0 is
not empty iff AND2(NOT1 q2, NOT1 q1) is not empty)& (s1 is not empty iff AND2(
  NOT1 q2, q1) is not empty)& (s2 is not empty iff AND2( q2, NOT1 q1) is not
  empty)& (s3 is not empty iff AND2( q2, q1) is not empty) & (ns0 is not empty
iff AND2(NOT1 nq2,NOT1 nq1) is not empty)& (ns1 is not empty iff AND2(NOT1 nq2,
nq1) is not empty)& (ns2 is not empty iff AND2( nq2,NOT1 nq1) is not empty)& (
ns3 is not empty iff AND2( nq2, nq1) is not empty) & (nq1 is not empty iff NOT1
  q2 is not empty)& (nq2 is not empty iff q1 is not empty) implies (ns1 is not
empty iff s0 is not empty)& (ns3 is not empty iff s1 is not empty)& (ns2 is not
  empty iff s3 is not empty)& (ns0 is not empty iff s2 is not empty);






theorem 
  for s0,s1,s2,s3,ns0,ns1,ns2,ns3,q1,q2,nq1,nq2,R being set holds (s0 is
not empty iff AND2(NOT1 q2, NOT1 q1) is not empty)& (s1 is not empty iff AND2(
  NOT1 q2, q1) is not empty)& (s2 is not empty iff AND2( q2, NOT1 q1) is not
  empty)& (s3 is not empty iff AND2( q2, q1) is not empty) & (ns0 is not empty
iff AND2(NOT1 nq2,NOT1 nq1) is not empty)& (ns1 is not empty iff AND2(NOT1 nq2,
nq1) is not empty)& (ns2 is not empty iff AND2( nq2,NOT1 nq1) is not empty)& (
ns3 is not empty iff AND2( nq2, nq1) is not empty) & (nq1 is not empty iff AND2
  (NOT1 q2, R) is not empty)& (nq2 is not empty iff AND2( q1, R) is not empty)
implies (ns1 is not empty iff AND2(s0, R) is not empty)& (ns3 is not empty iff
  AND2(s1, R) is not empty)& (ns2 is not empty iff AND2(s3, R) is not empty)& (
  ns0 is not empty iff OR2(AND2(s2, R),NOT1 R) is not empty);






theorem 
  for s0,s1,s2,s3,s4,s5,s6,s7,ns0,ns1,ns2,ns3,ns4,ns5,ns6,ns7, q1,q2,q3,
nq1,nq2,nq3 being set holds (s0 is not empty iff AND3(NOT1 q3, NOT1 q2, NOT1 q1
) is not empty)& (s1 is not empty iff AND3(NOT1 q3, NOT1 q2, q1) is not empty)&
(s2 is not empty iff AND3(NOT1 q3, q2, NOT1 q1) is not empty)& (s3 is not empty
iff AND3(NOT1 q3, q2, q1) is not empty)& (s4 is not empty iff AND3( q3, NOT1 q2
  , NOT1 q1) is not empty)& (s5 is not empty iff AND3( q3, NOT1 q2, q1) is not
  empty)& (s6 is not empty iff AND3( q3, q2, NOT1 q1) is not empty)& (s7 is not
empty iff AND3( q3, q2, q1) is not empty) & (ns0 is not empty iff AND3(NOT1 nq3
,NOT1 nq2,NOT1 nq1) is not empty)& (ns1 is not empty iff AND3(NOT1 nq3,NOT1 nq2
, nq1) is not empty)& (ns2 is not empty iff AND3(NOT1 nq3, nq2,NOT1 nq1) is not
  empty)& (ns3 is not empty iff AND3(NOT1 nq3, nq2, nq1) is not empty)& (ns4 is
not empty iff AND3( nq3,NOT1 nq2,NOT1 nq1) is not empty)& (ns5 is not empty iff
  AND3( nq3,NOT1 nq2, nq1) is not empty)& (ns6 is not empty iff AND3( nq3, nq2,
  NOT1 nq1) is not empty)& (ns7 is not empty iff AND3( nq3, nq2, nq1) is not
empty) & (nq1 is not empty iff NOT1 q3 is not empty)& (nq2 is not empty iff q1
is not empty)& (nq3 is not empty iff q2 is not empty) implies (ns1 is not empty
iff s0 is not empty)& (ns3 is not empty iff s1 is not empty)& (ns7 is not empty
iff s3 is not empty)& (ns6 is not empty iff s7 is not empty)& (ns4 is not empty
  iff s6 is not empty)& (ns0 is not empty iff s4 is not empty) & (ns2 is not
  empty iff s5 is not empty)& (ns5 is not empty iff s2 is not empty);







theorem 
  for s0,s1,s2,s3,s4,s5,s6,s7,ns0,ns1,ns2,ns3,ns4,ns5,ns6,ns7, q1,q2,q3,
nq1,nq2,nq3,R being set holds (s0 is not empty iff AND3(NOT1 q3, NOT1 q2, NOT1
q1) is not empty)& (s1 is not empty iff AND3(NOT1 q3, NOT1 q2, q1) is not empty
  )& (s2 is not empty iff AND3(NOT1 q3, q2, NOT1 q1) is not empty)& (s3 is not
  empty iff AND3(NOT1 q3, q2, q1) is not empty)& (s4 is not empty iff AND3( q3,
NOT1 q2, NOT1 q1) is not empty)& (s5 is not empty iff AND3( q3, NOT1 q2, q1) is
  not empty)& (s6 is not empty iff AND3( q3, q2, NOT1 q1) is not empty)& (s7 is
not empty iff AND3( q3, q2, q1) is not empty) & (ns0 is not empty iff AND3(NOT1
nq3,NOT1 nq2,NOT1 nq1) is not empty)& (ns1 is not empty iff AND3(NOT1 nq3,NOT1
nq2, nq1) is not empty)& (ns2 is not empty iff AND3(NOT1 nq3, nq2,NOT1 nq1) is
not empty)& (ns3 is not empty iff AND3(NOT1 nq3, nq2, nq1) is not empty)& (ns4
is not empty iff AND3( nq3,NOT1 nq2,NOT1 nq1) is not empty)& (ns5 is not empty
  iff AND3( nq3,NOT1 nq2, nq1) is not empty)& (ns6 is not empty iff AND3( nq3,
nq2,NOT1 nq1) is not empty)& (ns7 is not empty iff AND3( nq3, nq2, nq1) is not
  empty) & (nq1 is not empty iff AND2(NOT1 q3, R) is not empty)& (nq2 is not
empty iff AND2( q1, R) is not empty)& (nq3 is not empty iff AND2( q2, R) is not
  empty) implies (ns1 is not empty iff AND2(s0, R) is not empty)& (ns3 is not
  empty iff AND2(s1, R) is not empty)& (ns7 is not empty iff AND2(s3, R) is not
empty)& (ns6 is not empty iff AND2(s7, R) is not empty)& (ns4 is not empty iff
AND2(s6, R) is not empty)& (ns0 is not empty iff OR2(AND2(s4, R),NOT1 R) is not
empty) & (ns2 is not empty iff AND2(s5, R) is not empty)& (ns5 is not empty iff
  AND2(s2, R) is not empty);







theorem 
  for s0,s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12,s13,s14,s15, ns0,ns1,ns2
,ns3,ns4,ns5,ns6,ns7,ns8,ns9,ns10,ns11,ns12,ns13,ns14,ns15, q1,q2,q3,q4,nq1,nq2
  ,nq3,nq4 being set holds (s0 is not empty iff AND4(NOT1 q4, NOT1 q3, NOT1 q2,
NOT1 q1) is not empty)& (s1 is not empty iff AND4(NOT1 q4, NOT1 q3, NOT1 q2, q1
  ) is not empty)& (s2 is not empty iff AND4(NOT1 q4, NOT1 q3, q2, NOT1 q1) is
not empty)& (s3 is not empty iff AND4(NOT1 q4, NOT1 q3, q2, q1) is not empty)&
(s4 is not empty iff AND4(NOT1 q4, q3, NOT1 q2, NOT1 q1) is not empty)& (s5 is
  not empty iff AND4(NOT1 q4, q3, NOT1 q2, q1) is not empty)& (s6 is not empty
  iff AND4(NOT1 q4, q3, q2, NOT1 q1) is not empty)& (s7 is not empty iff AND4(
  NOT1 q4, q3, q2, q1) is not empty)& (s8 is not empty iff AND4( q4, NOT1 q3,
  NOT1 q2, NOT1 q1) is not empty)& (s9 is not empty iff AND4( q4, NOT1 q3, NOT1
q2, q1) is not empty)& (s10 is not empty iff AND4( q4, NOT1 q3, q2, NOT1 q1) is
  not empty)& (s11 is not empty iff AND4( q4, NOT1 q3, q2, q1) is not empty)& (
s12 is not empty iff AND4( q4, q3, NOT1 q2, NOT1 q1) is not empty)& (s13 is not
empty iff AND4( q4, q3, NOT1 q2, q1) is not empty)& (s14 is not empty iff AND4(
q4, q3, q2, NOT1 q1) is not empty)& (s15 is not empty iff AND4( q4, q3, q2, q1)
  is not empty) & (ns0 is not empty iff AND4(NOT1 nq4, NOT1 nq3, NOT1 nq2, NOT1
  nq1) is not empty)& (ns1 is not empty iff AND4(NOT1 nq4, NOT1 nq3, NOT1 nq2,
  nq1) is not empty)& (ns2 is not empty iff AND4(NOT1 nq4, NOT1 nq3, nq2, NOT1
nq1) is not empty)& (ns3 is not empty iff AND4(NOT1 nq4, NOT1 nq3, nq2, nq1) is
  not empty)& (ns4 is not empty iff AND4(NOT1 nq4, nq3, NOT1 nq2, NOT1 nq1) is
  not empty)& (ns5 is not empty iff AND4(NOT1 nq4, nq3, NOT1 nq2, nq1) is not
empty)& (ns6 is not empty iff AND4(NOT1 nq4, nq3, nq2, NOT1 nq1) is not empty)&
(ns7 is not empty iff AND4(NOT1 nq4, nq3, nq2, nq1) is not empty)& (ns8 is not
  empty iff AND4( nq4, NOT1 nq3, NOT1 nq2, NOT1 nq1) is not empty)& (ns9 is not
empty iff AND4( nq4, NOT1 nq3, NOT1 nq2, nq1) is not empty)& (ns10 is not empty
  iff AND4( nq4, NOT1 nq3, nq2, NOT1 nq1) is not empty)& (ns11 is not empty iff
AND4( nq4, NOT1 nq3, nq2, nq1) is not empty)& (ns12 is not empty iff AND4( nq4,
nq3, NOT1 nq2, NOT1 nq1) is not empty)& (ns13 is not empty iff AND4( nq4, nq3,
NOT1 nq2, nq1) is not empty)& (ns14 is not empty iff AND4( nq4, nq3, nq2, NOT1
  nq1) is not empty)& (ns15 is not empty iff AND4( nq4, nq3, nq2, nq1) is not
empty) & (nq1 is not empty iff NOT1 q4 is not empty)& (nq2 is not empty iff q1
is not empty)& (nq3 is not empty iff q2 is not empty)& (nq4 is not empty iff q3
  is not empty) implies (ns1 is not empty iff s0 is not empty )& (ns3 is not
empty iff s1 is not empty )& (ns7 is not empty iff s3 is not empty )& (ns15 is
  not empty iff s7 is not empty )& (ns14 is not empty iff s15 is not empty)& (
ns12 is not empty iff s14 is not empty)& (ns8 is not empty iff s12 is not empty
  )& (ns0 is not empty iff s8 is not empty ) & (ns5 is not empty iff s2 is not
empty )& (ns11 is not empty iff s5 is not empty )& (ns6 is not empty iff s11 is
  not empty)& (ns13 is not empty iff s6 is not empty )& (ns10 is not empty iff
  s13 is not empty)& (ns4 is not empty iff s10 is not empty)& (ns9 is not empty
  iff s4 is not empty)& (ns2 is not empty iff s9 is not empty);








theorem 
  for s0,s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12,s13,s14,s15, ns0,ns1,ns2
,ns3,ns4,ns5,ns6,ns7,ns8,ns9,ns10,ns11,ns12,ns13,ns14,ns15, q1,q2,q3,q4,nq1,nq2
,nq3,nq4,R being set holds (s0 is not empty iff AND4(NOT1 q4, NOT1 q3, NOT1 q2,
NOT1 q1) is not empty)& (s1 is not empty iff AND4(NOT1 q4, NOT1 q3, NOT1 q2, q1
  ) is not empty)& (s2 is not empty iff AND4(NOT1 q4, NOT1 q3, q2, NOT1 q1) is
not empty)& (s3 is not empty iff AND4(NOT1 q4, NOT1 q3, q2, q1) is not empty)&
(s4 is not empty iff AND4(NOT1 q4, q3, NOT1 q2, NOT1 q1) is not empty)& (s5 is
  not empty iff AND4(NOT1 q4, q3, NOT1 q2, q1) is not empty)& (s6 is not empty
  iff AND4(NOT1 q4, q3, q2, NOT1 q1) is not empty)& (s7 is not empty iff AND4(
  NOT1 q4, q3, q2, q1) is not empty)& (s8 is not empty iff AND4( q4, NOT1 q3,
  NOT1 q2, NOT1 q1) is not empty)& (s9 is not empty iff AND4( q4, NOT1 q3, NOT1
q2, q1) is not empty)& (s10 is not empty iff AND4( q4, NOT1 q3, q2, NOT1 q1) is
  not empty)& (s11 is not empty iff AND4( q4, NOT1 q3, q2, q1) is not empty)& (
s12 is not empty iff AND4( q4, q3, NOT1 q2, NOT1 q1) is not empty)& (s13 is not
empty iff AND4( q4, q3, NOT1 q2, q1) is not empty)& (s14 is not empty iff AND4(
q4, q3, q2, NOT1 q1) is not empty)& (s15 is not empty iff AND4( q4, q3, q2, q1)
  is not empty) & (ns0 is not empty iff AND4(NOT1 nq4, NOT1 nq3, NOT1 nq2, NOT1
  nq1) is not empty)& (ns1 is not empty iff AND4(NOT1 nq4, NOT1 nq3, NOT1 nq2,
  nq1) is not empty)& (ns2 is not empty iff AND4(NOT1 nq4, NOT1 nq3, nq2, NOT1
nq1) is not empty)& (ns3 is not empty iff AND4(NOT1 nq4, NOT1 nq3, nq2, nq1) is
  not empty)& (ns4 is not empty iff AND4(NOT1 nq4, nq3, NOT1 nq2, NOT1 nq1) is
  not empty)& (ns5 is not empty iff AND4(NOT1 nq4, nq3, NOT1 nq2, nq1) is not
empty)& (ns6 is not empty iff AND4(NOT1 nq4, nq3, nq2, NOT1 nq1) is not empty)&
(ns7 is not empty iff AND4(NOT1 nq4, nq3, nq2, nq1) is not empty)& (ns8 is not
  empty iff AND4( nq4, NOT1 nq3, NOT1 nq2, NOT1 nq1) is not empty)& (ns9 is not
empty iff AND4( nq4, NOT1 nq3, NOT1 nq2, nq1) is not empty)& (ns10 is not empty
  iff AND4( nq4, NOT1 nq3, nq2, NOT1 nq1) is not empty)& (ns11 is not empty iff
AND4( nq4, NOT1 nq3, nq2, nq1) is not empty)& (ns12 is not empty iff AND4( nq4,
nq3, NOT1 nq2, NOT1 nq1) is not empty)& (ns13 is not empty iff AND4( nq4, nq3,
NOT1 nq2, nq1) is not empty)& (ns14 is not empty iff AND4( nq4, nq3, nq2, NOT1
  nq1) is not empty)& (ns15 is not empty iff AND4( nq4, nq3, nq2, nq1) is not
empty) & (nq1 is not empty iff AND2(NOT1 q4,R) is not empty)& (nq2 is not empty
iff AND2( q1,R) is not empty)& (nq3 is not empty iff AND2( q2,R) is not empty)&
  (nq4 is not empty iff AND2( q3,R) is not empty) implies (ns1 is not empty iff
AND2(s0,R) is not empty)& (ns3 is not empty iff AND2(s1,R) is not empty)& (ns7
is not empty iff AND2(s3,R) is not empty)& (ns15 is not empty iff AND2(s7,R) is
  not empty)& (ns14 is not empty iff AND2(s15,R) is not empty)& (ns12 is not
  empty iff AND2(s14,R) is not empty)& (ns8 is not empty iff AND2(s12,R) is not
  empty)& (ns0 is not empty iff OR2(AND2(s8,R),NOT1 R) is not empty) & (ns5 is
  not empty iff AND2(s2,R) is not empty)& (ns11 is not empty iff AND2(s5,R) is
not empty)& (ns6 is not empty iff AND2(s11,R) is not empty)& (ns13 is not empty
iff AND2(s6,R) is not empty)& (ns10 is not empty iff AND2(s13,R) is not empty)&
(ns4 is not empty iff AND2(s10,R) is not empty)& (ns9 is not empty iff AND2(s4,
  R) is not empty)& (ns2 is not empty iff AND2(s9,R) is not empty);














begin



















theorem 
  for g0,g1,g2,g3,g4,g5,g6,g7,g8,g9,g10,g11,g12, a0,a1,a2,a3,a4,a5,a6,a7
,a8,a9,a10,a11, b0,b1,b2,b3,b4,b5,b6,b7,b8,b9,b10,b11, p being set holds g12 is
not empty & (b0 is not empty iff XOR2(p,AND2(g0,a11)) is not empty)& (b1 is not
  empty iff XOR2(a0,AND2(g1,a11)) is not empty)& (b2 is not empty iff XOR2(a1,
AND2(g2,a11)) is not empty)& (b3 is not empty iff XOR2(a2,AND2(g3,a11)) is not
  empty)& (b4 is not empty iff XOR2(a3,AND2(g4,a11)) is not empty)& (b5 is not
  empty iff XOR2(a4,AND2(g5,a11)) is not empty)& (b6 is not empty iff XOR2(a5,
AND2(g6,a11)) is not empty)& (b7 is not empty iff XOR2(a6,AND2(g7,a11)) is not
  empty)& (b8 is not empty iff XOR2(a7,AND2(g8,a11)) is not empty)& (b9 is not
  empty iff XOR2(a8,AND2(g9,a11)) is not empty)& (b10 is not empty iff XOR2(a9,
AND2(g10,a11)) is not empty)& (b11 is not empty iff XOR2(a10,AND2(g11,a11)) is
not empty) implies (a11 is not empty iff AND2(g12,a11) is not empty) & (a10 is
not empty iff XOR2(b11,AND2(g11,a11)) is not empty)& (a9 is not empty iff XOR2(
b10,AND2(g10,a11)) is not empty)& (a8 is not empty iff XOR2(b9,AND2(g9,a11)) is
  not empty)& (a7 is not empty iff XOR2(b8,AND2(g8,a11)) is not empty)& (a6 is
not empty iff XOR2(b7,AND2(g7,a11)) is not empty)& (a5 is not empty iff XOR2(b6
,AND2(g6,a11)) is not empty)& (a4 is not empty iff XOR2(b5,AND2(g5,a11)) is not
  empty)& (a3 is not empty iff XOR2(b4,AND2(g4,a11)) is not empty)& (a2 is not
  empty iff XOR2(b3,AND2(g3,a11)) is not empty)& (a1 is not empty iff XOR2(b2,
AND2(g2,a11)) is not empty)& (a0 is not empty iff XOR2(b1,AND2(g1,a11)) is not
  empty)& (p is not empty iff XOR2(b0,AND2(g0,a11)) is not empty);

















theorem 
  for g0,g1,g2,g3,g4,g5,g6,g7,g8,g9,g10,g11,g12,g13,g14,g15,g16, a0,a1,
a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15, b0,b1,b2,b3,b4,b5,b6,b7,b8,b9,
b10,b11,b12,b13,b14,b15, p being set holds g16 is not empty & (b0 is not empty
  iff XOR2(p,AND2(g0,a15)) is not empty)& (b1 is not empty iff XOR2(a0,AND2(g1,
a15)) is not empty)& (b2 is not empty iff XOR2(a1,AND2(g2,a15)) is not empty)&
(b3 is not empty iff XOR2(a2,AND2(g3,a15)) is not empty)& (b4 is not empty iff
XOR2(a3,AND2(g4,a15)) is not empty)& (b5 is not empty iff XOR2(a4,AND2(g5,a15))
is not empty)& (b6 is not empty iff XOR2(a5,AND2(g6,a15)) is not empty)& (b7 is
not empty iff XOR2(a6,AND2(g7,a15)) is not empty)& (b8 is not empty iff XOR2(a7
,AND2(g8,a15)) is not empty)& (b9 is not empty iff XOR2(a8,AND2(g9,a15)) is not
empty)& (b10 is not empty iff XOR2(a9,AND2(g10,a15)) is not empty)& (b11 is not
empty iff XOR2(a10,AND2(g11,a15)) is not empty)& (b12 is not empty iff XOR2(a11
,AND2(g12,a15)) is not empty)& (b13 is not empty iff XOR2(a12,AND2(g13,a15)) is
  not empty)& (b14 is not empty iff XOR2(a13,AND2(g14,a15)) is not empty)& (b15
  is not empty iff XOR2(a14,AND2(g15,a15)) is not empty) implies (a15 is not
empty iff AND2(g16,a15) is not empty) & (a14 is not empty iff XOR2(b15,AND2(g15
  ,a15)) is not empty)& (a13 is not empty iff XOR2(b14,AND2(g14,a15)) is not
  empty)& (a12 is not empty iff XOR2(b13,AND2(g13,a15)) is not empty)& (a11 is
not empty iff XOR2(b12,AND2(g12,a15)) is not empty)& (a10 is not empty iff XOR2
(b11,AND2(g11,a15)) is not empty)& (a9 is not empty iff XOR2(b10,AND2(g10,a15))
is not empty)& (a8 is not empty iff XOR2(b9,AND2(g9,a15)) is not empty)& (a7 is
not empty iff XOR2(b8,AND2(g8,a15)) is not empty)& (a6 is not empty iff XOR2(b7
,AND2(g7,a15)) is not empty)& (a5 is not empty iff XOR2(b6,AND2(g6,a15)) is not
  empty)& (a4 is not empty iff XOR2(b5,AND2(g5,a15)) is not empty)& (a3 is not
  empty iff XOR2(b4,AND2(g4,a15)) is not empty)& (a2 is not empty iff XOR2(b3,
AND2(g3,a15)) is not empty)& (a1 is not empty iff XOR2(b2,AND2(g2,a15)) is not
  empty)& (a0 is not empty iff XOR2(b1,AND2(g1,a15)) is not empty)& (p is not
  empty iff XOR2(b0,AND2(g0,a15)) is not empty);

begin


























theorem 
  for g0,g1,g2,g3,g4,g5,g6,g7,g8,g9,g10,g11,g12, a0,a1,a2,a3,a4,a5,a6,a7
  ,a8,a9,a10,a11, b0,b1,b2,b3,b4,b5,b6,b7,b8,b9,b10,b11, z,p being set holds g0
  is not empty & not z is not empty & (b0 is not empty iff XOR2(p,a11) is not
  empty)& (b1 is not empty iff XOR2(a0,AND2(g1,b0)) is not empty)& (b2 is not
empty iff XOR2(a1,AND2(g2,b0)) is not empty)& (b3 is not empty iff XOR2(a2,AND2
(g3,b0)) is not empty)& (b4 is not empty iff XOR2(a3,AND2(g4,b0)) is not empty)
& (b5 is not empty iff XOR2(a4,AND2(g5,b0)) is not empty)& (b6 is not empty iff
  XOR2(a5,AND2(g6,b0)) is not empty)& (b7 is not empty iff XOR2(a6,AND2(g7,b0))
is not empty)& (b8 is not empty iff XOR2(a7,AND2(g8,b0)) is not empty)& (b9 is
not empty iff XOR2(a8,AND2(g9,b0)) is not empty)& (b10 is not empty iff XOR2(a9
  ,AND2(g10,b0)) is not empty)& (b11 is not empty iff XOR2(a10,AND2(g11,b0)) is
  not empty) implies (b11 is not empty iff XOR2(XOR2(a10,AND2(g11,a11)),XOR2(z,
AND2(g11,p))) is not empty) & (b10 is not empty iff XOR2(XOR2(a9,AND2(g10,a11))
,XOR2(z,AND2(g10,p))) is not empty) & (b9 is not empty iff XOR2(XOR2(a8,AND2(g9
  ,a11)),XOR2(z,AND2(g9,p))) is not empty) & (b8 is not empty iff XOR2(XOR2(a7,
  AND2(g8,a11)),XOR2(z,AND2(g8,p))) is not empty) & (b7 is not empty iff XOR2(
XOR2(a6,AND2(g7,a11)),XOR2(z,AND2(g7,p))) is not empty) & (b6 is not empty iff
XOR2(XOR2(a5,AND2(g6,a11)),XOR2(z,AND2(g6,p))) is not empty) & (b5 is not empty
  iff XOR2(XOR2(a4,AND2(g5,a11)),XOR2(z,AND2(g5,p))) is not empty) & (b4 is not
empty iff XOR2(XOR2(a3,AND2(g4,a11)),XOR2(z,AND2(g4,p))) is not empty) & (b3 is
not empty iff XOR2(XOR2(a2,AND2(g3,a11)),XOR2(z,AND2(g3,p))) is not empty) & (
b2 is not empty iff XOR2(XOR2(a1,AND2(g2,a11)),XOR2(z,AND2(g2,p))) is not empty
) & (b1 is not empty iff XOR2(XOR2(a0,AND2(g1,a11)),XOR2(z,AND2(g1,p))) is not
empty) & (b0 is not empty iff XOR2(XOR2(z, AND2(g0,a11)),XOR2(z,AND2(g0,p))) is
  not empty);

























theorem 
  for g0,g1,g2,g3,g4,g5,g6,g7,g8,g9,g10,g11,g12,g13,g14,g15,g16, a0,a1,
a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15, b0,b1,b2,b3,b4,b5,b6,b7,b8,b9,
  b10,b11,b12,b13,b14,b15, z,p being set holds g0 is not empty & not z is not
  empty & (b0 is not empty iff XOR2(p,a15) is not empty)& (b1 is not empty iff
  XOR2(a0,AND2(g1,b0)) is not empty)& (b2 is not empty iff XOR2(a1,AND2(g2,b0))
is not empty)& (b3 is not empty iff XOR2(a2,AND2(g3,b0)) is not empty)& (b4 is
not empty iff XOR2(a3,AND2(g4,b0)) is not empty)& (b5 is not empty iff XOR2(a4,
  AND2(g5,b0)) is not empty)& (b6 is not empty iff XOR2(a5,AND2(g6,b0)) is not
  empty)& (b7 is not empty iff XOR2(a6,AND2(g7,b0)) is not empty)& (b8 is not
empty iff XOR2(a7,AND2(g8,b0)) is not empty)& (b9 is not empty iff XOR2(a8,AND2
  (g9,b0)) is not empty)& (b10 is not empty iff XOR2(a9,AND2(g10,b0)) is not
empty)& (b11 is not empty iff XOR2(a10,AND2(g11,b0)) is not empty)& (b12 is not
empty iff XOR2(a11,AND2(g12,b0)) is not empty)& (b13 is not empty iff XOR2(a12,
  AND2(g13,b0)) is not empty)& (b14 is not empty iff XOR2(a13,AND2(g14,b0)) is
not empty)& (b15 is not empty iff XOR2(a14,AND2(g15,b0)) is not empty) implies
(b15 is not empty iff XOR2(XOR2(a14,AND2(g15,a15)),XOR2(z,AND2(g15,p))) is not
empty) & (b14 is not empty iff XOR2(XOR2(a13,AND2(g14,a15)),XOR2(z,AND2(g14,p))
  ) is not empty) & (b13 is not empty iff XOR2(XOR2(a12,AND2(g13,a15)),XOR2(z,
AND2(g13,p))) is not empty) & (b12 is not empty iff XOR2(XOR2(a11,AND2(g12,a15)
),XOR2(z,AND2(g12,p))) is not empty) & (b11 is not empty iff XOR2(XOR2(a10,AND2
(g11,a15)),XOR2(z,AND2(g11,p))) is not empty) & (b10 is not empty iff XOR2(XOR2
  (a9,AND2(g10,a15)),XOR2(z,AND2(g10,p))) is not empty) & (b9 is not empty iff
XOR2(XOR2(a8,AND2(g9,a15)),XOR2(z,AND2(g9,p))) is not empty) & (b8 is not empty
  iff XOR2(XOR2(a7,AND2(g8,a15)),XOR2(z,AND2(g8,p))) is not empty) & (b7 is not
empty iff XOR2(XOR2(a6,AND2(g7,a15)),XOR2(z,AND2(g7,p))) is not empty) & (b6 is
not empty iff XOR2(XOR2(a5,AND2(g6,a15)),XOR2(z,AND2(g6,p))) is not empty) & (
b5 is not empty iff XOR2(XOR2(a4,AND2(g5,a15)),XOR2(z,AND2(g5,p))) is not empty
) & (b4 is not empty iff XOR2(XOR2(a3,AND2(g4,a15)),XOR2(z,AND2(g4,p))) is not
empty) & (b3 is not empty iff XOR2(XOR2(a2,AND2(g3,a15)),XOR2(z,AND2(g3,p))) is
not empty) & (b2 is not empty iff XOR2(XOR2(a1,AND2(g2,a15)),XOR2(z,AND2(g2,p))
) is not empty) & (b1 is not empty iff XOR2(XOR2(a0,AND2(g1,a15)),XOR2(z,AND2(
g1,p))) is not empty) & (b0 is not empty iff XOR2(XOR2(z, AND2(g0,a15)),XOR2(z,
  AND2(g0,p))) is not empty);














begin



definition
  let x0,x1,y0,y1 be set;
  func MULT210(x1,y1,x0,y0) -> set equals

  AND2(x0,y0);
  func MULT211(x1,y1,x0,y0) -> set equals

  ADD1(AND2(x1,y0),AND2(x0,y1),{});
  func MULT212(x1,y1,x0,y0) -> set equals

  ADD2({},AND2(x1,y1),AND2(x1,y0),AND2
  (x0,y1),{});
  func MULT213(x1,y1,x0,y0) -> set equals

  CARR2({},AND2(x1,y1),AND2(x1,y0),
  AND2(x0,y1),{});
end;









theorem 
  for x0,x1,y0,y1,z0,z1,z2,z3,q00,q01,c01,q11,c11 being set holds (q00
is not empty iff AND2(x0,y0) is not empty)& (q01 is not empty iff XOR3(AND2(x1,
y0),AND2(x0,y1),{} ) is not empty)& (c01 is not empty iff MAJ3(AND2(x1,y0),AND2
(x0,y1),{} ) is not empty)& (q11 is not empty iff XOR3(AND2(x1,y1),{} ,c01) is
not empty)& (c11 is not empty iff MAJ3(AND2(x1,y1),{} ,c01) is not empty)& (z0
is not empty iff q00 is not empty)& (z1 is not empty iff q01 is not empty)& (z2
  is not empty iff q11 is not empty)& (z3 is not empty iff c11 is not empty)
  implies (z0 is not empty iff MULT210(x1,y1,x0,y0) is not empty)& (z1 is not
empty iff MULT211(x1,y1,x0,y0) is not empty)& (z2 is not empty iff MULT212(x1,
y1,x0,y0) is not empty)& (z3 is not empty iff MULT213(x1,y1,x0,y0) is not empty
  );







definition
  let x0,x1,x2,y0,y1 be set;
  func MULT310(x2,x1,y1,x0,y0) -> set equals

  AND2(x0,y0);
  func MULT311(x2,x1,y1,x0,y0) -> set equals

  ADD1(AND2(x1,y0),AND2(x0,y1),{});
  func MULT312(x2,x1,y1,x0,y0) -> set equals

  ADD2(AND2(x2,y0),AND2(x1,y1),
  AND2(x1,y0),AND2(x0,y1),{});
  func MULT313(x2,x1,y1,x0,y0) -> set equals

  ADD3({} ,AND2(x2,y1), AND2(x2,y0)
  ,AND2(x1,y1), AND2(x1,y0),AND2(x0,y1),{});
  func MULT314(x2,x1,y1,x0,y0) -> set equals

  CARR3({} ,AND2(x2,y1), AND2(x2,y0
  ),AND2(x1,y1), AND2(x1,y0),AND2(x0,y1),{});
end;




definition
  let x0,x1,x2,y0,y1,y2 be set;
  func MULT321(x2,y2,x1,y1,x0,y0) -> set equals

  ADD1(MULT312(x2,x1,y1,x0,y0),
  AND2(x0,y2),{});
  func MULT322(x2,y2,x1,y1,x0,y0) -> set equals

  ADD2(MULT313(x2,x1,y1,x0,y0),
  AND2(x1,y2), MULT312(x2,x1,y1,x0,y0),AND2(x0,y2),{});
  func MULT323(x2,y2,x1,y1,x0,y0) -> set equals

  ADD3(MULT314(x2,x1,y1,x0,y0),
AND2(x2,y2), MULT313(x2,x1,y1,x0,y0),AND2(x1,y2), MULT312(x2,x1,y1,x0,y0),AND2(
  x0,y2),{});
  func MULT324(x2,y2,x1,y1,x0,y0) -> set equals

  CARR3(MULT314(x2,x1,y1,x0,y0),
AND2(x2,y2), MULT313(x2,x1,y1,x0,y0),AND2(x1,y2), MULT312(x2,x1,y1,x0,y0),AND2(
  x0,y2),{});
end;






theorem 
  for x0,x1,x2,y0,y1,y2,z0,z1,z2,z3,z4,z5, q00,q01,q02,c01,c02,q11,q12,
  c11,c12,q21,q22,c21,c22 being set holds (q00 is not empty iff AND2(x0,y0) is
  not empty)& (q01 is not empty iff XOR3(AND2(x1,y0),AND2(x0,y1),{} ) is not
empty)& (c01 is not empty iff MAJ3(AND2(x1,y0),AND2(x0,y1),{} ) is not empty)&
(q02 is not empty iff XOR3(AND2(x2,y0),AND2(x1,y1),{} ) is not empty)& (c02 is
  not empty iff MAJ3(AND2(x2,y0),AND2(x1,y1),{} ) is not empty)& (q11 is not
empty iff XOR3(q02,AND2(x0,y2),c01) is not empty)& (c11 is not empty iff MAJ3(
q02,AND2(x0,y2),c01) is not empty)& (q12 is not empty iff XOR3(AND2(x2,y1),AND2
(x1,y2),c02) is not empty)& (c12 is not empty iff MAJ3(AND2(x2,y1),AND2(x1,y2),
c02) is not empty)& (q21 is not empty iff XOR3(q12,{} ,c11) is not empty)& (c21
  is not empty iff MAJ3(q12,{} ,c11) is not empty)& (q22 is not empty iff XOR3(
AND2(x2,y2),c21,c12) is not empty)& (c22 is not empty iff MAJ3(AND2(x2,y2),c21,
  c12) is not empty)& (z0 is not empty iff q00 is not empty)& (z1 is not empty
iff q01 is not empty)& (z2 is not empty iff q11 is not empty)& (z3 is not empty
iff q21 is not empty)& (z4 is not empty iff q22 is not empty)& (z5 is not empty
iff c22 is not empty) implies (z0 is not empty iff MULT310(x2, x1,y1,x0,y0) is
not empty)& (z1 is not empty iff MULT311(x2, x1,y1,x0,y0) is not empty)& (z2 is
  not empty iff MULT321(x2,y2,x1,y1,x0,y0) is not empty)& (z3 is not empty iff
MULT322(x2,y2,x1,y1,x0,y0) is not empty)& (z4 is not empty iff MULT323(x2,y2,x1
  ,y1,x0,y0) is not empty)& (z5 is not empty iff MULT324(x2,y2,x1,y1,x0,y0) is
  not empty);

begin 








theorem 
  for x0,x1,x2,y0,y1,y2,z0,z1,z2,z3,z4,z5, q00,q01,q02,q03,c01,c02,c03,
  q11,q12,q13,c11,c12,c13 being set holds (q00 is not empty iff AND2(x0,y0) is
not empty)& (q01 is not empty iff XOR3(AND2(x1,y0),AND2(x0,y1),{}) is not empty
  )& (c01 is not empty iff MAJ3(AND2(x1,y0),AND2(x0,y1),{}) is not empty)& (q02
is not empty iff XOR3(AND2(x2,y0),AND2(x1,y1),AND2(x0,y2)) is not empty)& (c02
is not empty iff MAJ3(AND2(x2,y0),AND2(x1,y1),AND2(x0,y2)) is not empty)& (q03
  is not empty iff XOR3(AND2(x2,y1),AND2(x1,y2),{}) is not empty)& (c03 is not
empty iff MAJ3(AND2(x2,y1),AND2(x1,y2),{}) is not empty)& (q11 is not empty iff
  XOR3(q02,c01,{}) is not empty)& (c11 is not empty iff MAJ3(q02,c01,{}) is not
  empty)& (q12 is not empty iff XOR3(q03,c02,c11) is not empty)& (c12 is not
empty iff MAJ3(q03,c02,c11) is not empty)& (q13 is not empty iff XOR3(AND2(x2,
y2),c03,c12) is not empty)& (c13 is not empty iff MAJ3(AND2(x2,y2),c03,c12) is
not empty)& (z0 is not empty iff q00 is not empty)& (z1 is not empty iff q01 is
not empty)& (z2 is not empty iff q11 is not empty)& (z3 is not empty iff q12 is
not empty)& (z4 is not empty iff q13 is not empty)& (z5 is not empty iff c13 is
not empty) implies (z0 is not empty iff MULT310(x2, x1,y1,x0,y0) is not empty)&
  (z1 is not empty iff MULT311(x2, x1,y1,x0,y0) is not empty)& (z2 is not empty
iff MULT321(x2,y2,x1,y1,x0,y0) is not empty)& (z3 is not empty iff MULT322(x2,
y2,x1,y1,x0,y0) is not empty)& (z4 is not empty iff MULT323(x2,y2,x1,y1,x0,y0)
  is not empty)& (z5 is not empty iff MULT324(x2,y2,x1,y1,x0,y0) is not empty);







notation
  let a1,b1,c be set;
  synonym CLAADD1(a1,b1,c) for XOR3(a1,b1,c);
  synonym CLACARR1(a1,b1,c) for MAJ3(a1,b1,c);
end;



definition
  let a1,b1,a2,b2,c be set;

  func CLAADD2(a2,b2,a1,b1,c) -> set equals

  XOR3(a2,b2,MAJ3(a1,b1,c));
  func CLACARR2(a2,b2,a1,b1,c) -> set equals

  OR2(AND2(a2,b2),AND2(OR2(a2,b2),
  MAJ3(a1,b1,c)));
end;



definition
  let a1,b1,a2,b2,a3,b3,c be set;
  func CLAADD3(a3,b3,a2,b2,a1,b1,c) -> set equals

  XOR3(a3,b3,CLACARR2(a2,b2,a1
  ,b1,c));
  func CLACARR3(a3,b3,a2,b2,a1,b1,c) -> set equals

  OR3(AND2(a3,b3),AND2(OR2(a3
  ,b3),AND2(a2,b2)), AND3(OR2(a3,b3),OR2(a2,b2),MAJ3(a1,b1,c)));
end;



definition
  let a1,b1,a2,b2,a3,b3,a4,b4,c be set;
  func CLAADD4(a4,b4,a3,b3,a2,b2,a1,b1,c) -> set equals

  XOR3(a4,b4,CLACARR3(a3
  ,b3,a2,b2,a1,b1,c));
  func CLACARR4(a4,b4,a3,b3,a2,b2,a1,b1,c) -> set equals

  OR4(AND2(a4,b4),AND2(
OR2(a4,b4),AND2(a3,b3)), AND3(OR2(a4,b4),OR2(a3,b3),AND2(a2,b2)), AND4(OR2(a4,
  b4),OR2(a3,b3),OR2(a2,b2),MAJ3(a1,b1,c)));
end;







theorem 
  for x0,x1,x2,y0,y1,y2,z0,z1,z2,z3,z4,z5, q00,q01,q02,q03,c01,c02,c03
  being set holds (q00 is not empty iff AND2(x0,y0) is not empty)& (q01 is not
empty iff XOR3(AND2(x1,y0),AND2(x0,y1),{}) is not empty)& (c01 is not empty iff
MAJ3(AND2(x1,y0),AND2(x0,y1),{}) is not empty)& (q02 is not empty iff XOR3(AND2
(x2,y0),AND2(x1,y1),AND2(x0,y2)) is not empty)& (c02 is not empty iff MAJ3(AND2
(x2,y0),AND2(x1,y1),AND2(x0,y2)) is not empty)& (q03 is not empty iff XOR3(AND2
(x2,y1),AND2(x1,y2),{}) is not empty)& (c03 is not empty iff MAJ3(AND2(x2,y1),
  AND2(x1,y2),{}) is not empty)& (z0 is not empty iff q00 is not empty)& (z1 is
  not empty iff q01 is not empty)& (z2 is not empty iff CLAADD1( q02,c01,{}) is
not empty)& (z3 is not empty iff CLAADD2( q03,c02,q02,c01,{}) is not empty)& (
z4 is not empty iff CLAADD3(AND2(x2,y2),c03,q03,c02,q02,c01,{}) is not empty)&
(z5 is not empty iff CLACARR3(AND2(x2,y2),c03,q03,c02,q02,c01,{}) is not empty)
implies (z0 is not empty iff MULT310(x2, x1,y1,x0,y0) is not empty)& (z1 is not
empty iff MULT311(x2, x1,y1,x0,y0) is not empty)& (z2 is not empty iff MULT321(
x2,y2,x1,y1,x0,y0) is not empty)& (z3 is not empty iff MULT322(x2,y2,x1,y1,x0,
y0) is not empty)& (z4 is not empty iff MULT323(x2,y2,x1,y1,x0,y0) is not empty
  )& (z5 is not empty iff MULT324(x2,y2,x1,y1,x0,y0) is not empty);














begin

definition
  let IT be set;
  attr IT is finite means


  ex p being Function st rng p = IT & dom p in omega;
end;

notation
  let IT be set;
  antonym IT is infinite for IT is finite;
end;

reserve A, B, X, Y, Z, x, y for set;
reserve f for Function;

registration
  cluster non empty finite for set;
end;

registration
  cluster empty -> finite for set;
end;

scheme 
 OLambdaC{A()->set,C[set],F(set)->set,G(set)->set}:
  ex f being Function st dom f = A() & for x being Ordinal st x in A() holds
  (C[x] implies f.x = F(x)) & (not C[x] implies f.x = G(x));

registration
  let x be set;
  cluster {x} -> finite;
end;

registration
  let x,y be set;
  cluster {x,y} -> finite;
end;

registration
  let x,y,z be set;
  cluster {x,y,z} -> finite;
end;

registration
  let x1,x2,x3,x4 be set;
  cluster {x1,x2,x3,x4} -> finite;
end;

registration
  let x1,x2,x3,x4,x5 be set;
  cluster {x1,x2,x3,x4,x5} -> finite;
end;

registration
  let x1,x2,x3,x4,x5,x6 be set;
  cluster {x1,x2,x3,x4,x5,x6} -> finite;
end;

registration
  let x1,x2,x3,x4,x5,x6,x7 be set;
  cluster {x1,x2,x3,x4,x5,x6,x7} -> finite;
end;

registration
  let x1,x2,x3,x4,x5,x6,x7,x8 be set;
  cluster {x1,x2,x3,x4,x5,x6,x7,x8} -> finite;
end;

registration
  let B be finite set;
  cluster -> finite for Subset of B;
end;

registration
  let X,Y be finite set;
  cluster X \/ Y -> finite;
end;

theorem 
  A c= B & B is finite implies A is finite;

theorem 
  A is finite & B is finite implies A \/ B is finite;

registration
  let A be set, B be finite set;
  cluster A /\ B -> finite;
end;

registration
  let A be finite set, B be set;
  cluster A /\ B -> finite;
  cluster A \ B -> finite;
end;

theorem 
  A is finite implies A /\ B is finite;

theorem 
  A is finite implies A \ B is finite;

registration
  let f be Function, A be finite set;
  cluster f.:A -> finite;
end;

theorem 
  A is finite implies f.:A is finite;

reserve O for Ordinal;

theorem 
  A is finite implies for X being Subset-Family of A st X <> {}
  ex x being set st x in X &
    for B being set st B in X holds x c= B implies B = x;

scheme 
 Finite{A()->set,P[set]} : P[A()]
provided
 A() is finite and
 P[{}] and
 for x,B being set st x in A() & B c= A() & P[B] holds P[B \/ {x}];

registration
  let A,B be finite set;
  cluster [:A,B:] -> finite;
end;

registration
  let A,B,C be finite set;
  cluster [:A,B,C:] -> finite;
end;

registration
  let A,B,C,D be finite set;
  cluster [:A,B,C,D:] -> finite;
end;

registration
  let A be finite set;
  cluster bool A -> finite;
end;

theorem 
  A is finite & (for X st X in A holds X is finite) iff union A is finite;

theorem 
  dom f is finite implies rng f is finite;

theorem 
  Y c= rng f & f"Y is finite implies Y is finite;

registration
  let X, Y be finite set;
  cluster X \+\ Y -> finite;
end;

registration
  let X be non empty set;
  cluster finite non empty for Subset of X;
end;

begin 


theorem 
  for f being Function holds dom f is finite iff f is finite;



theorem 
  for F being set st F is finite & F <> {} & F is c=-linear
  ex m being set st m in F & for C being set st C in F holds m c= C;



theorem 
  for F being set st F is finite & F <> {} & F is c=-linear
  ex m being set st m in F & for C being set st C in F holds C c= m;



definition
  let R be Relation;
  attr R is finite-yielding means


  for x st x in rng R holds x is finite;
end;



reserve a for set;

theorem 
  X is finite & X c= [:Y,Z:] implies
  ex A,B being set st A is finite & A c= Y & B is finite & B c= Z &
  X c= [:A,B:];

theorem 
  X is finite & X c= [:Y,Z:] implies
  ex A being set st A is finite & A c= Y & X c= [:A,Z:];



registration
  cluster finite non empty for Function;
end;

registration
  let R be finite Relation;
  cluster dom R -> finite;
end;



registration
  let f be Function, g be finite Function;
  cluster f*g -> finite;
end;



registration
  let A be finite set, B be set;
  cluster -> finite for Function of A, B;
end;



registration
  let x,y be set;
  cluster x .--> y -> finite;
end;



registration
  let R be finite Relation;
  cluster rng R -> finite;
end;



registration
  let f be finite Function, x be set;
  cluster f"x -> finite;
end;

registration
  let f, g be finite Function;
  cluster f +* g -> finite;
end;



definition
  let F be set;
  attr F is centered means

  F <> {} &
  for G being set st G <> {} & G c= F & G is finite holds meet G <> {};
end;

definition
 let f be Function;
  redefine attr f is finite-yielding means

 for i being set st i in dom f holds f.i is finite;
end;



definition
  let I be set;
  let IT be I-defined Function;
  redefine attr IT is finite-yielding means

  for i being set st i in I holds IT.i is finite;
end;



theorem 
  B is infinite implies not B in [:A,B:];



registration
 let I be set, f be I-defined Function;
 cluster finite I-defined f-compatible for Function;
end;

registration
 let X,Y be set;
 cluster finite X-defined Y-valued for Function;
end;

registration
 let X,Y be non empty set;
 cluster X-defined Y-valued non empty finite for Function;
end;

registration
  let A be set, F be finite Relation;
  cluster A|`F -> finite;
end;

registration
  let A be set, F be finite Relation;
  cluster F|A -> finite;
end;

registration
  let A be finite set, F be Function;
  cluster F|A -> finite;
end;

registration
  let R be finite Relation;
  cluster field R -> finite;
end;

registration
  cluster trivial -> finite for set;
end;

registration
  cluster infinite -> non trivial for set;
end;

registration
  let X be non trivial set;
  cluster finite non trivial for Subset of X;
end;



registration
  let x,y,a,b be set;
  cluster (x,y) --> (a,b) -> finite;
end;



definition
  let A be set;
  attr A is finite-membered means

 for B being set st B in A holds B is finite;
end;

registration
 cluster empty -> finite-membered for set;
end;

registration
  let A be finite-membered set;
  cluster -> finite for Element of A;
end;

registration
  cluster non empty finite finite-membered for set;
end;



registration
  let X be finite set;
  cluster {X} -> finite-membered;
  cluster bool X -> finite-membered;
  let Y be finite set;
  cluster {X,Y} -> finite-membered;
end;

registration
  let X be finite-membered set;
  cluster -> finite-membered for Subset of X;
  let Y be finite-membered set;
  cluster X \/ Y -> finite-membered;
end;

registration
  let X be finite finite-membered set;
  cluster union X -> finite;
end;

registration
  cluster non empty finite-yielding for Function;
  cluster empty -> finite-yielding for Relation;
end;

registration
  let F be finite-yielding Function, x be set;
  cluster F.x -> finite;
end;

registration let F be finite-yielding Relation;
 cluster rng F -> finite-membered;
end;














begin 

reserve X,Y,x for set;

definition
  let IT be set;
  attr IT is cup-closed means


  for X,Y being set st X in IT & Y in IT holds X \/ Y in IT;
  attr IT is cap-closed means

  for X,Y being set st X in IT & Y in IT holds X /\ Y in IT;
  attr IT is diff-closed means


  for X,Y being set st X in IT & Y in IT holds X \ Y in IT;
end;

definition
  let IT be set;
  attr IT is preBoolean means


  IT is cup-closed diff-closed;
end;

registration
  cluster preBoolean -> cup-closed diff-closed for set;
  cluster cup-closed diff-closed -> preBoolean for set;
end;

registration
  cluster non empty cup-closed cap-closed diff-closed for set;
end;

theorem 
  for A being set holds A is preBoolean iff for X,Y being set st X
  in A & Y in A holds X \/ Y in A & X \ Y in A;

reserve A for non empty preBoolean set;

definition
  let A;
  let X,Y be Element of A;
  redefine func X \/ Y -> Element of A;
  redefine func X \ Y -> Element of A;
end;

theorem 
  X is Element of A & Y is Element of A implies X /\ Y is Element of A;

theorem 
  X is Element of A & Y is Element of A implies X \+\ Y is Element of A;

theorem 
  for A being non empty set st for X,Y being Element of A holds X \+\ Y
  in A & X \ Y in A holds A is preBoolean;

theorem 
  for A being non empty set st for X,Y being Element of A holds X \+\ Y
  in A & X /\ Y in A holds A is preBoolean;

theorem 
  for A being non empty set st for X,Y being Element of A holds X \+\ Y
  in A & X \/ Y in A holds A is preBoolean;

definition
  let A;
  let X,Y be Element of A;
  redefine func X /\ Y -> Element of A;
  redefine func X \+\ Y -> Element of A;
end;

theorem 
  {} in A;

theorem 
  for A being set holds bool A is preBoolean;

registration
  let A be set;
  cluster bool A -> preBoolean;
end;

theorem 
  for A,B being non empty preBoolean set holds A /\ B is non empty preBoolean;



definition
  let A be set;
  func Fin A -> preBoolean set means


  for X being set holds X in it iff X c= A & X is finite;
end;

registration
  let A be set;
  cluster Fin A -> non empty;
end;

registration
  let A be set;
  cluster -> finite for Element of Fin A;
end;

theorem 
  for A, B being set st A c= B holds Fin A c= Fin B;

theorem 
  for A, B being set holds Fin (A /\ B) = Fin A /\ Fin B;

theorem 
  for A, B being set holds Fin A \/ Fin B c= Fin (A \/ B);

theorem 
  for A being set holds Fin A c= bool A;

theorem 
  for A being set st A is finite holds Fin A = bool A;

theorem 
  Fin {} = { {} };



definition
  let A be set;
  mode Finite_Subset of A is Element of Fin A;
end;

theorem 
  for A being set, X being Finite_Subset of A holds X is finite;

theorem 
  for A being set, X being Finite_Subset of A holds X is Subset of A;

theorem 
  for A being set, X being Subset of A st A is finite holds X is
  Finite_Subset of A;














begin

reserve X,Y for set,
  x,x1,x2,y,y1,y2,z for set,
  f,g,h for Function;





reserve M for non empty set;

definition
  let M;
  assume
 not {} in M;
  mode Choice_Function of M -> Function of M, union M means


    for X st X in M holds it.X in X;
end;

reserve D for non empty set;

definition
  let D be set;
  func BOOL D -> set equals

  bool D \ {{}};
end;

registration
  let D;
  cluster BOOL D -> non empty;
end;

theorem 
  not {} in BOOL D;

theorem 
  D c= X iff D in BOOL X;

reserve P for Relation;





definition
  let X;
  mode Order of X is total reflexive antisymmetric transitive Relation of X;
end;

reserve O for Order of X;

theorem 
  x in X implies [x,x] in O;

theorem 
  x in X & y in X & [x,y] in O & [y,x] in O implies x = y;

theorem 
  x in X & y in X & z in X & [x,y] in O & [y,z] in O implies [x,z] in O;

theorem 
  (ex X st X <> {} & X in Y) iff union Y <> {};

theorem 
  P is_strongly_connected_in X iff P is_reflexive_in X & P is_connected_in X;

theorem 
  P is_reflexive_in X & Y c= X implies P is_reflexive_in Y;

theorem 
  P is_antisymmetric_in X & Y c= X implies P is_antisymmetric_in Y;

theorem 
  P is_transitive_in X & Y c= X implies P is_transitive_in Y;

theorem 
  P is_strongly_connected_in X & Y c= X implies P is_strongly_connected_in Y;

theorem 
  for R being total Relation of X holds field R = X;

theorem 
  for A being set, R being Relation of A st R is_reflexive_in A
  holds dom R = A & field R = A;

begin 

reserve R,P for Relation,
  X,X1,X2,Y,Z,x,y,z,u for set,
  g,h for Function,
  O for Order of X,
  D for non empty set,
  d,d1,d2 for Element of D,
  A1,A2,B for Ordinal,
  L,L1,L2 for T-Sequence;





theorem 
  dom O = X & rng O = X;

theorem 
  field O = X;

definition
  let R;
  attr R is being_quasi-order means

  R is reflexive transitive;
  attr R is being_partial-order means


  R is reflexive transitive antisymmetric;
  attr R is being_linear-order means


  R is reflexive transitive antisymmetric connected;
end;

theorem 
  R is being_quasi-order implies R~ is being_quasi-order;

theorem 
  R is being_partial-order implies R~ is being_partial-order;

theorem 
  R is being_linear-order implies R~ is being_linear-order;

theorem 
  R is well-ordering implies R is being_quasi-order & R is
  being_partial-order & R is being_linear-order;

theorem 
  R is being_linear-order implies R is being_quasi-order & R is
  being_partial-order;

theorem 
  R is being_partial-order implies R is being_quasi-order;

theorem 
  O is being_partial-order;

theorem 
  O is being_quasi-order;

theorem 
  O is connected implies O is being_linear-order;

theorem 
  R is being_quasi-order implies R|_2 X is being_quasi-order;

theorem 
  R is being_partial-order implies R|_2 X is being_partial-order;

theorem 
  R is being_linear-order implies R|_2 X is being_linear-order;

registration let R be empty Relation;
 cluster field R -> empty;
end;

registration
 cluster empty ->  being_quasi-order being_partial-order
         being_linear-order well-ordering for Relation;
end;

registration let X;
 cluster id X -> being_quasi-order being_partial-order;
end;

definition
  let R,X;
  pred R quasi_orders X means


  R is_reflexive_in X & R is_transitive_in X;
  pred R partially_orders X means


  R is_reflexive_in X & R is_transitive_in X & R is_antisymmetric_in X;
  pred R linearly_orders X means

  R is_reflexive_in X & R is_transitive_in X &
  R is_antisymmetric_in X & R is_connected_in X;
end;

theorem 
  R well_orders X implies R quasi_orders X & R partially_orders X
  & R linearly_orders X;

theorem 
  R linearly_orders X implies R quasi_orders X & R partially_orders X;

theorem 
  R partially_orders X implies R quasi_orders X;

theorem 
  R is being_quasi-order implies R quasi_orders field R;

theorem 
  R quasi_orders Y & X c= Y implies R quasi_orders X;

theorem 
  R quasi_orders X implies R|_2 X is being_quasi-order;

theorem 
  R is being_partial-order implies R partially_orders field R;

theorem 
  R partially_orders Y & X c= Y implies R partially_orders X;

theorem 
  R partially_orders X implies R|_2 X is being_partial-order;

theorem 
  R is being_linear-order implies R linearly_orders field R;

theorem 
  R linearly_orders Y & X c= Y implies R linearly_orders X;

theorem 
  R linearly_orders X implies R|_2 X is being_linear-order;

theorem 
  R quasi_orders X implies R~ quasi_orders X;

theorem 
  R partially_orders X implies R~ partially_orders X;

theorem 
  R linearly_orders X implies R~ linearly_orders X;

theorem 
  O quasi_orders X;

theorem 
  O partially_orders X;

theorem 
  R partially_orders X implies R |_2 X is Order of X;

theorem 
  R linearly_orders X implies R |_2 X is Order of X;

theorem 
  R well_orders X implies R |_2 X is Order of X;

theorem 
  id X quasi_orders X & id X partially_orders X;

definition
  let R,X;
  pred X has_upper_Zorn_property_wrt R means


  for Y st Y c= X & R|_2 Y
  is being_linear-order ex x st x in X & for y st y in Y holds [y,x] in R;
  pred X has_lower_Zorn_property_wrt R means

  for Y st Y c= X & R|_2 Y is
  being_linear-order ex x st x in X & for y st y in Y holds [x,y] in R;
end;

theorem 
  X has_upper_Zorn_property_wrt R implies X <> {};

theorem 
  X has_lower_Zorn_property_wrt R implies X <> {};

theorem 
  X has_upper_Zorn_property_wrt R iff X has_lower_Zorn_property_wrt R~;

theorem 
  X has_upper_Zorn_property_wrt R~ iff X has_lower_Zorn_property_wrt R;

definition
  let R,x;
  pred x is_maximal_in R means


  x in field R & not ex y st y in field R & y <> x & [x,y] in R;
  pred x is_minimal_in R means


  x in field R & not ex y st y in field R & y <> x & [y,x] in R;
  pred x is_superior_of R means


  x in field R & for y st y in field R & y <> x holds [y,x] in R;
  pred x is_inferior_of R means


  x in field R & for y st y in field R & y <> x holds [x,y] in R;
end;

theorem 
  x is_inferior_of R & R is antisymmetric implies x is_minimal_in R;

theorem 
  x is_superior_of R & R is antisymmetric implies x is_maximal_in R;

theorem 
  x is_minimal_in R & R is connected implies x is_inferior_of R;

theorem 
  x is_maximal_in R & R is connected implies x is_superior_of R;

theorem 
  x in X & x is_superior_of R & X c= field R & R is reflexive implies X
  has_upper_Zorn_property_wrt R;

theorem 
  x in X & x is_inferior_of R & X c= field R & R is reflexive implies X
  has_lower_Zorn_property_wrt R;

theorem 
  x is_minimal_in R iff x is_maximal_in R~;

theorem 
  x is_minimal_in R~ iff x is_maximal_in R;

theorem 
  x is_inferior_of R iff x is_superior_of R~;

theorem 
  x is_inferior_of R~ iff x is_superior_of R;





reserve A,C for Ordinal;

theorem 
  for R,X st R partially_orders X & field R = X & X
  has_upper_Zorn_property_wrt R ex x st x is_maximal_in R;

theorem 
  for R,X st R partially_orders X & field R = X & X
  has_lower_Zorn_property_wrt R ex x st x is_minimal_in R;



theorem 
  for X st X <> {} & for Z st Z c= X & Z is c=-linear ex Y st Y
in X & for X1 st X1 in Z holds X1 c= Y ex Y st Y in X & for Z st Z in X & Z <>
  Y holds not Y c= Z;

theorem 
  for X st X <> {} & for Z st Z c= X & Z is c=-linear ex Y st Y
in X & for X1 st X1 in Z holds Y c= X1 ex Y st Y in X & for Z st Z in X & Z <>
  Y holds not Z c= Y;

theorem 
  for X st X <> {} & for Z st Z <> {} & Z c= X & Z is c=-linear
  holds union Z in X ex Y st Y in X & for Z st Z in X & Z <> Y holds not Y c= Z
;

theorem 
  for X st X <> {} & for Z st Z <> {} & Z c= X & Z is c=-linear holds
  meet Z in X ex Y st Y in X & for Z st Z in X & Z <> Y holds not Z c= Y;

scheme 

  ZornMax{A() -> non empty set, P[set,set]}: ex x being Element of A() st for
  y being Element of A() st x <> y holds not P[x,y]
provided
 for x being Element of A() holds P[x,x] and
 for x,y being Element of A() st P[x,y] & P[y,x] holds x = y and
 for x,y,z being Element of A() st P[x,y] & P[y,z] holds P[x,z] and
 for X st X c= A() & (for x,y being Element of A() st x in X & y in X
holds P[x,y] or P[y,x]) holds ex y being Element of A() st for x being Element
of A() st x in X holds P[x,y];

scheme 

  ZornMin{A() -> non empty set, P[set,set]}: ex x being Element of A() st for
  y being Element of A() st x <> y holds not P[y,x]
provided
 for x being Element of A() holds P[x,x] and
 for x,y being Element of A() st P[x,y] & P[y,x] holds x = y and
 for x,y,z being Element of A() st P[x,y] & P[y,z] holds P[x,z] and
 for X st X c= A() & (for x,y being Element of A() st x in X & y in X
holds P[x,y] or P[y,x]) holds ex y being Element of A() st for x being Element
of A() st x in X holds P[y,x];





theorem 
  R partially_orders X & field R = X implies ex P st R c= P & P
  linearly_orders X & field P = X;





theorem 
  R c= [:field R,field R:];

theorem 
  R is reflexive & X c= field R implies field(R|_2 X) = X;

theorem 
  R is_reflexive_in X implies R|_2 X is reflexive;

theorem 
  R is_transitive_in X implies R|_2 X is transitive;

theorem 
  R is_antisymmetric_in X implies R|_2 X is antisymmetric;

theorem 
  R is_connected_in X implies R|_2 X is connected;

theorem 
  R is_connected_in X & Y c= X implies R is_connected_in Y;

theorem 
  R well_orders X & Y c= X implies R well_orders Y;

theorem 
  R is connected implies R~ is connected;

theorem 
  R is_reflexive_in X implies R~ is_reflexive_in X;

theorem 
  R is_transitive_in X implies R~ is_transitive_in X;

theorem 
  R is_antisymmetric_in X implies R~ is_antisymmetric_in X;

theorem 
  R is_connected_in X implies R~ is_connected_in X;

theorem 
  (R|_2 X)~ = R~|_2 X;

theorem 
  R|_2 {} = {};

begin 


theorem 
  Z is finite & Z c= rng f implies ex Y st Y c= dom f & Y is finite & f .:Y = Z
;



theorem 
  field R is finite implies R is finite;

theorem 
  dom R is finite & rng R is finite implies R is finite;



registration
  cluster order_type_of {} -> empty;
end;

theorem 
 for O being Ordinal holds order_type_of RelIncl O = O;














begin 

reserve x,y,z,X,Y for set;

theorem 
  {x} c= {x,y,z};

theorem 
  {x,y} c= {x,y,z};

canceled 3;

theorem 
  for X,Y for f being Function holds f.:(Y \ f"X) = f.:Y \ X;

reserve X,Y for non empty set,
  f for Function of X,Y;

theorem 
  for x being Element of X holds x in f"{f.x};

theorem 
  for x being Element of X holds Im(f,x) = {f.x};



theorem 
  for B being Element of Fin X for x st x in B holds x is Element of X;

theorem 
  for A being (Element of Fin X), B being set for f being Function of X,
  Y st for x being Element of X holds x in A implies f.x in B holds f.:A c= B;

theorem 
  for X being set for B being Element of Fin X for A being set st
  A c= B holds A is Element of Fin X;

theorem 
  for B being Element of Fin X st B <> {} ex x being Element of X st x in B;

theorem 
  for A being Element of Fin X holds f.:A = {} implies A = {};

registration
  let X be set;
  cluster empty for Element of Fin X;
end;

definition
  let X be set;
  func {}.X -> empty Element of Fin X equals

  {};
end;

scheme 

  FinSubFuncEx{ A()->non empty set, B()->(Element of Fin A()), P[set,set] } :
ex f being Function of A(), Fin A() st for b,a being Element of A() holds a in
  f.b iff a in B() & P[a,b];



definition
  let X be non empty set, F be BinOp of X;
  attr F is having_a_unity means


  ex x being Element of X st x is_a_unity_wrt F;
end;

theorem 
  for X being non empty set, F being BinOp of X holds F is
  having_a_unity iff the_unity_wrt F is_a_unity_wrt F;

theorem 
  for X being non empty set, F being BinOp of X st F is
having_a_unity for x being Element of X holds F.(the_unity_wrt F, x) = x & F.(x
  , the_unity_wrt F) = x;



registration
  let X be non empty set;
  cluster non empty for Element of Fin X;
end;

notation
  let X be non empty set, x be Element of X;
  synonym {.x.} for {x};
  let y be Element of X;
  synonym {.x,y.} for {x,y};
  let z be Element of X;
  synonym {.x,y,z.} for {x,y,z};
end;

definition
  let X be non empty set, x be Element of X;
  redefine func {.x.} -> Element of Fin X;
  let y be Element of X;
  redefine func {.x,y.} -> Element of Fin X;
  let z be Element of X;
  redefine func {.x,y,z.} -> Element of Fin X;
end;

definition
  let X be set;
  let A,B be Element of Fin X;
  redefine func A \/ B -> Element of Fin X;
end;

definition
  let X be set;
  let A,B be Element of Fin X;
  redefine func A \ B -> Element of Fin X;
end;

scheme 

  FinSubInd1{ X() -> non empty set, P[set] } : for B being Element of Fin X()
  holds P[B]
provided
 P[{}.X()] and
 for B9 being (Element of Fin X()), b being Element of X() holds P[B9
] & not b in B9 implies P[B9 \/ {b}];

scheme 

  FinSubInd2{ X() -> non empty set, P[Element of Fin X()] } : for B being non
  empty Element of Fin X() holds P[B]
provided
 for x being Element of X() holds P[{.x.}] and
 for B1,B2 being non empty Element of Fin X() st P[B1] & P[B2] holds
P[B1 \/ B2];

scheme 

  FinSubInd3{ X() -> non empty set, P[set] } : for B being Element of Fin X()
  holds P[B]
provided
 P[{}.X()] and
 for B9 being (Element of Fin X()), b being Element of X() holds P[B9
] implies P[B9 \/ {b}];

definition
  let X, Y be non empty set;
  let F be BinOp of Y;
  let B be Element of Fin X;
  let f be Function of X,Y;
  assume that
 B <> {} or F is having_a_unity and
 F is commutative and
 F is associative;
  func F $$ (B,f) -> Element of Y means


  ex G being Function of Fin X, Y
st it = G.B & (for e being Element of Y st e is_a_unity_wrt F holds G.{} = e) &
(for x being Element of X holds G.{x} = f.x) & for B9 being Element of Fin X st
B9 c= B & B9 <> {} for x being Element of X st x in B \ B9 holds G.(B9 \/ {x})
  = F.(G.B9,f.x);
end;

theorem 
  for X, Y being non empty set for F being BinOp of Y for B being
Element of Fin X for f being Function of X,Y st (B <> {} or F is having_a_unity
) & F is idempotent & F is commutative & F is associative for IT being Element
of Y holds IT = F $$ (B,f) iff ex G being Function of Fin X, Y st IT = G.B & (
  for e being Element of Y st e is_a_unity_wrt F holds G.{} = e) & (for x being
Element of X holds G.{x} = f.x) & for B9 being Element of Fin X st B9 c= B & B9
  <> {} for x being Element of X st x in B holds G.(B9 \/ {x}) = F.(G.B9,f.x);

reserve X, Y for non empty set,
  F for (BinOp of Y),
  B for (Element of Fin X),
  f for Function of X,Y;

theorem 
  F is commutative & F is associative implies for b being Element
  of X holds F $$ ({.b.},f) = f.b;

theorem 
  F is idempotent & F is commutative & F is associative implies
  for a,b being Element of X holds F $$ ({.a,b.},f) = F.(f.a, f.b);

theorem 
  F is idempotent & F is commutative & F is associative implies
  for a,b,c being Element of X holds F $$ ({.a,b,c.},f) = F.(F.(f.a, f.b), f.c)
;



theorem 
  F is idempotent & F is commutative & F is associative & B <> {}
implies for x being Element of X holds F $$(B \/ {.x.}, f) = F.(F $$(B,f),f.x);

theorem 
  F is idempotent & F is commutative & F is associative implies
for B1,B2 being Element of Fin X st B1 <> {} & B2 <> {} holds F $$ (B1 \/ B2,f)
  = F.(F $$ (B1,f),F $$ (B2,f));

theorem 
  F is commutative & F is associative & F is idempotent implies for x
  being Element of X st x in B holds F.(f.x,F$$(B,f)) = F$$(B,f);

theorem 
  F is commutative & F is associative & F is idempotent implies for B,C
being Element of Fin X st B <> {} & B c= C holds F.(F$$(B,f),F$$(C,f)) = F$$(C,
  f);

theorem 
  B <> {} & F is commutative & F is associative & F is idempotent
implies for a being Element of Y st for b being Element of X st b in B holds f.
  b = a holds F$$(B,f) = a;

theorem 
  F is commutative & F is associative & F is idempotent implies
  for a being Element of Y st f.:B = {a} holds F$$(B,f) = a;

theorem 
  F is commutative & F is associative & F is idempotent implies
for f,g being Function of X,Y for A,B being Element of Fin X st A <> {} & f.:A
  = g.:B holds F$$(A,f) = F$$(B,g);

theorem 
  for F,G being BinOp of Y st F is idempotent & F is commutative & F is
  associative & G is_distributive_wrt F for B being Element of Fin X st B <> {}
for f being Function of X,Y for a being Element of Y holds G.(a,F$$(B,f)) = F$$
  (B,G[;](a,f));

theorem 
  for F,G being BinOp of Y st F is idempotent & F is commutative & F is
  associative & G is_distributive_wrt F for B being Element of Fin X st B <> {}
for f being Function of X,Y for a being Element of Y holds G.(F$$(B,f),a) = F$$
  (B,G[:](f,a));

definition
  let X, Y be non empty set;
  let f be Function of X,Y;
  let A be Element of Fin X;
  redefine func f.:A -> Element of Fin Y;
end;

theorem 
  for A, X, Y being non empty set for F being BinOp of A st F is
  idempotent & F is commutative & F is associative for B being Element of Fin X
st B <> {} for f being Function of X,Y holds for g being Function of Y,A holds
  F$$(f.:B,g) = F$$(B,g*f);

theorem 
  F is commutative & F is associative & F is idempotent implies
  for Z being non empty set for G being BinOp of Z st G is commutative & G is
associative & G is idempotent for f being Function of X, Y for g being Function
  of Y,Z st for x,y being Element of Y holds g.(F.(x,y)) = G.(g.x,g.y) for B
  being Element of Fin X st B <> {} holds g.(F$$(B,f)) = G$$(B,g*f);



theorem 
  F is commutative & F is associative & F is having_a_unity
  implies for f holds F$$({}.X,f) = the_unity_wrt F;

theorem 
  F is idempotent & F is commutative & F is associative & F is
having_a_unity implies for x being Element of X holds F $$(B \/ {.x.}, f) = F.(
  F $$(B,f),f.x);

theorem 
  F is idempotent & F is commutative & F is associative & F is
having_a_unity implies for B1,B2 being Element of Fin X holds F $$ (B1 \/ B2,f)
  = F.(F $$ (B1,f),F $$ (B2,f));

theorem 
  F is commutative & F is associative & F is idempotent & F is
  having_a_unity implies for f,g being Function of X,Y for A,B being Element of
  Fin X st f.:A = g.:B holds F$$(A,f) = F$$(B,g);

theorem 
  for A, X, Y being non empty set for F being BinOp of A st F is
  idempotent & F is commutative & F is associative & F is having_a_unity for B
  being Element of Fin X for f being Function of X,Y holds for g being Function
  of Y,A holds F$$(f.:B,g) = F$$(B,g*f);

theorem 
  F is commutative & F is associative & F is idempotent & F is
having_a_unity implies for Z being non empty set for G being BinOp of Z st G is
  commutative & G is associative & G is idempotent & G is having_a_unity for f
  being Function of X, Y for g being Function of Y,Z st g.the_unity_wrt F =
  the_unity_wrt G & for x,y being Element of Y holds g.(F.(x,y)) = G.(g.x,g.y)
  for B being Element of Fin X holds g.(F$$(B,f)) = G$$(B,g*f);

definition
  let A be set;
  func FinUnion A -> BinOp of Fin A means


  for x,y being Element of Fin A holds it.(x,y) = (x \/ y);
end;

reserve A for set,
  x,y,z for Element of Fin A;

theorem 
  FinUnion A is idempotent;

theorem 
  FinUnion A is commutative;

theorem 
  FinUnion A is associative;

theorem 
  {}.A is_a_unity_wrt FinUnion A;

theorem 
  FinUnion A is having_a_unity;

theorem 
  the_unity_wrt FinUnion A is_a_unity_wrt FinUnion A;

theorem 
  the_unity_wrt FinUnion A = {};

reserve X,Y for non empty set,
  A for set,
  f for (Function of X, Fin A),
  i,j,k for (Element of X);

definition
  let X be non empty set, A be set;
  let B be Element of Fin X;
  let f be Function of X, Fin A;
  func FinUnion(B,f) -> Element of Fin A equals

  FinUnion A $$(B,f);
end;

theorem 
  FinUnion({.i.},f) = f.i;

theorem 
  FinUnion({.i,j.},f) = f.i \/ f.j;

theorem 
  FinUnion({.i,j,k.},f) = f.i \/ f.j \/ f.k;

theorem 
  FinUnion({}.X,f) = {};

theorem 
  for B being Element of Fin X holds FinUnion(B \/ {.i.}, f) =
  FinUnion(B,f) \/ f.i;

theorem 
  for B being Element of Fin X holds FinUnion(B,f) = union (f.:B);

theorem 
  for B1,B2 being Element of Fin X holds FinUnion(B1 \/ B2, f) =
  FinUnion(B1,f) \/ FinUnion(B2,f);

theorem 
  for B being Element of Fin X for f being Function of X,Y holds for g
  being Function of Y,Fin A holds FinUnion(f.:B,g) = FinUnion(B,g*f);

theorem 
  for A,X being non empty set, Y being set for G being BinOp of A
st G is commutative & G is associative & G is idempotent for B being Element of
Fin X st B <> {} for f being (Function of X,Fin Y), g being Function of Fin Y,A
  st for x,y being Element of Fin Y holds g.(x \/ y) = G.(g.x,g.y) holds g.(
  FinUnion(B,f)) = G$$(B,g*f);

theorem 
  for Z being non empty set, Y being set for G being BinOp of Z st
G is commutative & G is associative & G is idempotent & G is having_a_unity for
  f being Function of X, Fin Y for g being Function of Fin Y,Z st g.{}.Y =
the_unity_wrt G & for x,y being Element of Fin Y holds g.(x \/ y) = G.(g.x,g.y)
  for B being Element of Fin X holds g.(FinUnion(B,f)) = G$$(B,g*f);

definition
  let A be set;
  func singleton A -> Function of A, Fin A means


  for x being set st x in A holds it.x = {x};
end;

theorem 
  for A being non empty set for f being Function of A, Fin A holds
  f = singleton A iff for x being Element of A holds f.x = {x};

theorem 
  for x being set, y being Element of X holds x in singleton X.y iff x = y;

theorem 
  for x,y,z being Element of X st x in singleton X.z & y in singleton X.
  z holds x = y;

theorem 
  for B being Element of Fin X, x being set holds x in FinUnion(B,
  f) iff ex i being Element of X st i in B & x in f.i;

theorem 
  for B being Element of Fin X holds FinUnion(B, singleton X) = B;

theorem 
  for Y,Z being set for f being Function of X, Fin Y for g being
  Function of Fin Y, Fin Z st g.{}.Y = {}.Z & for x,y being Element of Fin Y
holds g.(x \/ y) = g.x \/ g.y for B being Element of Fin X holds g.(FinUnion(B,
  f)) = FinUnion(B,g*f);














begin

reserve B for non empty set,
  A,X,x for set;

scheme 

  Fraenkel59{ A() -> set, F(set) -> set, P,Q[set] } :
  { F(v) where v is Element of A() : P[v] } c=
   { F(u) where u is Element of A() : Q[u] }
provided
 for v being Element of A() holds P[v] implies Q[v];

scheme 

  Fraenkel599 { A,B() -> set, F(set,set) -> set, P,Q[set,set] } :
  { F(u1,v1) where u1 is Element of A(), v1 is Element of B() : P[u1,v1] } c=
  { F(u2,v2) where u2 is Element of A(), v2 is Element of B() : Q[u2,v2] }
provided
 for u being (Element of A()), v being Element of B() holds P[u,v]
implies Q[u,v];

scheme 

  Fraenkel69{ B() -> set, F(set) -> set, P, Q[set] } :
  { F(v1) where v1 is Element of B() : P[v1] } =
  { F(v2) where v2 is Element of B() : Q[v2] }
provided
 for v being Element of B() holds P[v] iff Q[v];

scheme 

  Fraenkel699 { A,B() -> set, F(set,set) -> set, P,Q[set,set] } :
  { F(u1,v1) where u1 is Element of A(), v1 is Element of B() : P[u1,v1] } =
  { F(u2,v2) where u2 is Element of A(), v2 is Element of B() : Q[u2,v2] }
provided
 for u being Element of A(), v being Element of B() holds P[u,v]
iff Q[u,v];

scheme 

  FraenkelF9{ B() -> set, F,G(set) -> set, P[set] } :
  { F(v1) where v1 is Element of B() : P[v1] } =
  { G(v2) where v2 is Element of B() : P[v2] }
provided
 for v being Element of B() holds F(v) = G(v);

scheme 

  FraenkelF9R{ B() -> set, F,G(set) -> set, P[set] } :
  { F(v1) where v1 is Element of B() : P[v1] } =
  { G(v2) where v2 is Element of B() : P[v2] }
provided
 for v being Element of B() st P[v] holds F(v) = G(v);

scheme 

  FraenkelF99 { A,B() -> set, F(set,set) -> set, G(set,set) -> set,
                P[set,set] } :
  { F(u1,v1) where u1 is Element of A(), v1 is Element of B() : P[u1,v1] } =
  { G(u2,v2) where u2 is Element of A(), v2 is Element of B() : P[u2,v2] }
provided
 for u being Element of A(), v being Element of B() holds F(u,v) = G(u,v);

scheme 

  FraenkelF699 { A,B() -> set, F(set,set) -> set, P,Q[set,set] } :
  { F(u1,v1) where u1 is Element of A(), v1 is Element of B() : P[u1,v1] } =
  { F(v2,u2) where u2 is Element of A(), v2 is Element of B() : Q[u2,v2] }
provided
 for u being Element of A(), v being Element of B() holds P[u,v]
iff Q[u,v] and
 for u being Element of A(), v being Element of B() holds F(u,v) = F(v,u);

theorem 
  for A,B being  set, F,G being Function of A,B for X
  being set st F|X = G|X for x being Element of A st x in X holds F.x = G.x;

theorem 
  for A,B being set holds Funcs(A,B) c= bool [:A,B:];

theorem 
  for X,Y being set st Funcs(X,Y) <> {} & X c= A & Y c= B for f
  being Element of Funcs(X,Y) holds f is PartFunc of A,B;

scheme 

  RelevantArgs
  { A,B,X() -> set, f,g() -> Function of A(),B(), P[set], Q[set] } :
  { f().u9 where u9 is Element of A() : P[u9] & u9 in X() } =
  { g().v9 where v9 is Element of A() : Q[v9] & v9 in X() }
provided
 f()|X() = g()|X() and
 for u being Element of A() st u in X() holds P[u] iff Q[u];

scheme 

  FrSet0{ A() -> non empty set, P[set] }:
  { x where x is Element of A(): P[x] } c= A();

scheme 

  Gen199{A,B() -> set, F(set,set) -> set, P[set,set], Q[set] } :
  for s being Element of A(), t being Element of B() st P[s,t] holds Q[F(s,t)]
provided
 for st1 being set st st1 in { F(s1,t1) where s1 is (Element of A()),
t1 is Element of B(): P[s1,t1] } holds Q[st1];

scheme 

  Gen199A{A,B() -> set, F(set,set) -> set, P[set,set], Q[set] } :
  for st1 being set st st1 in { F(s1,t1) where s1 is Element of A(),
  t1 is Element of B(): P[s1,t1] } holds Q[st1]
provided
 for s being Element of A(), t being Element of B() st P[s,t] holds
    Q[F(s,t)];

scheme 

  Gen299{A,B,C() -> set, F(set,set) -> Element of C(), P[set, set], Q[set] } :
  { st1 where st1 is Element of C() :
    st1 in { F(s1,t1) where s1 is Element of A(), t1 is Element of B() :
       P[s1,t1] } & Q[st1] } =
  { F(s2,t2) where s2 is Element of A(), t2 is Element of B() :
    P[s2,t2] & Q[F(s2,t2)]};

scheme 

  Gen39{A() -> set, F(set) -> set, P[set], Q[set] } : { F(s) where s
is Element of A() : s in { s1 where s1 is Element of A(): Q[s1] } & P[s] } = {
  F(s2) where s2 is Element of A() : Q[s2] & P[s2] };

scheme 

  Gen399{A,B() -> set, F(set,set) -> set, P[set,
set], Q[set] } : { F(s,t) where s is (Element of A()), t is Element of B() : s
in { s1 where s1 is Element of A(): Q[s1] } & P[s,t] } = { F(s2,t2) where s2 is
  (Element of A()), t2 is Element of B() : Q[s2] & P[s2,t2] };

scheme 

  Gen499{A,B() -> set, F(set,set) -> set, P[set,
set], Q[set,set] } : { F(s,t) where s is (Element of A()), t is Element of B()
: P[s,t] } c= { F(s1,t1) where s1 is (Element of A()), t1 is Element of B() : Q
  [s1,t1] }
provided
 for s being (Element of A()), t being Element of B() st P[s,t] ex s9
being Element of A() st Q[s9,t] & F(s,t) = F(s9,t);

scheme 

  FrSet1{ D,A() -> set, P[set], F(set) -> set }:
  { F(y) where y is Element of D() : F(y) in A() & P[y] } c= A();

scheme 

  FrSet2{ D,A() -> set, Q[set], F(set) -> set }:
  { F(y) where y is Element of D() : Q[y] & not F(y) in A() } misses A();

scheme 

  FrEqua1{ A,B() -> set, F(set,set) -> set, x()
-> (Element of B()), P[set,set], Q[set,set] }: { F(s,t) where s is (Element of
A()), t is Element of B(): Q[s,t] } = { F(s9,x()) where s9 is Element of A(): P
  [s9,x()] }
provided
 for s being Element of A() for t being Element of B() holds Q[s,t]
iff t = x() & P[s,t];

scheme 

  FrEqua2{ A,B() -> set, F(set,set) -> set, x()
  -> (Element of B()), P[set,set] }: { F(s,t) where s is (Element of A()), t is
Element of B(): t = x() & P[s,t] } = { F(s9,x()) where s9 is Element of A(): P[
  s9,x()] };



reserve phi for Element of Funcs(A,B);

theorem 
  for X,Y being set st Funcs(X,Y) <> {} & X c= A & Y c= B for f
  being Element of Funcs(X,Y) ex phi being Element of Funcs(A,B) st phi|X = f;

theorem 
  phi|X = phi|(A /\ X);



scheme 

  FraenkelFin { A() -> set, X() -> set, F(set) -> set }:
  { F(w) where w is Element of A(): w in X() } is finite
provided
 X() is finite;

scheme 

  CartFin { A, B() -> non empty set, X, Y() -> set, F(set, set) -> set }:
  { F(u,v) where u is Element of A(), v is Element of B() :
    u in X() & v in Y () } is finite
provided
 X() is finite and
 Y() is finite;

scheme 

  Finiteness { A()->non empty set, B()->(Element of Fin A()), P[(Element of A(
  )), Element of A()] } : for x being Element of A() st x in B() ex y being
Element of A() st y in B() & P[y,x] & for z being Element of A() st z in B() &
  P[z,y] holds P[y,z]
provided
 for x being Element of A() holds P[x,x] and
 for x,y,z being Element of A() st P[x,y] & P[y,z] holds P[x,z];

scheme 

  FinIm{A,B()->non empty set, x()-> (Element of Fin B()), F
  (set)->(Element of A()), P[set,set]}: ex c1 being Element of Fin A() st for t
being Element of A() holds t in c1 iff ex t9 being Element of B() st t9 in x()
  & t = F(t9) & P[t,t9];

registration
  let A, B be finite set;
  cluster Funcs(A,B) -> finite;
end;

theorem 
  for A,B being set st A is finite & B is finite holds Funcs(A,B) is finite;

scheme 

  ImFin { A() -> set, B() -> non empty set, X() -> set, Y() -> set,
F(set) -> set } : { F(phi9) where phi9 is Element of Funcs(A(),B()): phi9.:X()
  c= Y() } is finite
provided
 X() is finite and
 Y() is finite and
 for phi,psi being Element of Funcs(A(),B()) holds phi|X() = psi|X()
implies F(phi) = F(psi);



scheme 

  FunctChoice { A()->non empty set, B()->non empty set, P[(Element of A()),
Element of B()], x()->Element of Fin A() }: ex ff being Function of A(), B() st
  for t being Element of A() st t in x() holds P[t,ff.t]
provided
 for t being Element of A() st t in x() ex ff being Element of B() st
P[t,ff];

scheme 

  FuncsChoice { A()->non empty set, B()->non empty set, P[Element of A(),
Element of B()], x()->Element of Fin A() }: ex ff being Element of Funcs(A(),B(
  )) st for t being Element of A() st t in x() holds P[t,ff.t]
provided
 for t being Element of A() st t in x() ex ff being Element of B() st
P[t,ff];

scheme 

  FraenkelFin9 { A,B() -> non empty set, X() -> set, P[set,set] }: { x where x
  is Element of B(): ex w being Element of A() st P[w,x] & w in X() } is finite
provided
 X() is finite and
 for w being Element of A(), x,y being Element of B() st P[w,x] & P[w
,y] holds x = y;














begin

reserve A,B,C for Ordinal,
  X,X1,Y,Y1,Z,a,b,b1,b2,x,y,z for set,
  R for Relation,
  f,g,h for Function,
  k,m,n for Nat;

notation
  synonym 0 for {};
end;

definition
  let IT be set;
  attr IT is cardinal means


  ex B st IT = B & for A st A,B
  are_equipotent holds B c= A;
end;

registration
  cluster cardinal for set;
end;

definition
  mode Cardinal is cardinal set;
end;

registration
  cluster cardinal -> ordinal for set;
end;

reserve M,N for Cardinal;

theorem 
  for X ex A st X,A are_equipotent;

theorem 
  M = N iff M,N are_equipotent;

theorem 
  M in N iff M c= N & M <> N;

theorem 
  M in N iff not N c= M;

definition
  let X;
  func card X -> Cardinal means


  X,it are_equipotent;
  projectivity;
end;

registration
  cluster empty -> cardinal for set;
end;

registration
  let X be empty set;
  cluster card X -> empty;
end;

registration
  let X be non empty set;
  cluster card X -> non empty;
end;

theorem 
  X,Y are_equipotent iff card X = card Y;

theorem 
  R is well-ordering implies field R,order_type_of R
  are_equipotent;

theorem 
  X c= M implies card X c= M;

theorem 
  card A c= A;

theorem 
  X in M implies card X in M;


theorem 
  card X c= card Y iff ex f st f is one-to-one & dom f = X & rng f c= Y;

theorem 
  X c= Y implies card X c= card Y;

theorem 
  card X c= card Y iff ex f st dom f = Y & X c= rng f;

theorem 
  not X,bool X are_equipotent;


theorem 
  card X in card bool X;

definition
  let X;
  func nextcard X -> Cardinal means


  card X in it & for M st card X in M
  holds it c= M;
end;

theorem 
  {} in nextcard X;

theorem 
  card X = card Y implies nextcard X = nextcard Y;

theorem 
  X,Y are_equipotent implies nextcard X = nextcard Y;

theorem 
  A in nextcard A;

reserve S for T-Sequence;

definition
  let M;
  attr M is limit_cardinal means


  not ex N st M = nextcard N;
end;

definition
  let A;
  func alef A -> set means


  ex S st it = last S & dom S = succ A & S.{}
= card omega & (for B st succ B in succ A holds S.succ B = nextcard union { S.B
}) & for B st B in succ A & B <> {} & B is limit_ordinal holds S.B = card sup(S
  |B);
end;

registration
  let A;
  cluster alef A -> cardinal;
end;

theorem 
  alef succ A = nextcard alef A;

theorem 
  A <> {} & A is limit_ordinal implies for S st dom S = A & for B st B
  in A holds S.B = alef B holds alef A = card sup S;

theorem 
  A in B iff alef A in alef B;

theorem 
  alef A = alef B implies A = B;

theorem 
  A c= B iff alef A c= alef B;

theorem 
  X c= Y & Y c= Z & X,Z are_equipotent implies X,Y are_equipotent & Y,Z
  are_equipotent;

theorem 
  bool Y c= X implies card Y in card X & not Y,X are_equipotent;

theorem 
  X,{} are_equipotent implies X = {};

theorem 
  card {} = {};

theorem 
  X,{x} are_equipotent iff ex x st X = { x };

theorem 
  card X = card { x } iff ex x st X = { x };

theorem 
  card { x } = 1;

theorem 
  X misses X1 & Y misses Y1 & X,Y are_equipotent & X1,Y1
  are_equipotent implies X \/ X1,Y \/ Y1 are_equipotent;

theorem 
  x in X & y in X implies X \ { x },X \ { y } are_equipotent;

theorem 
  X c= dom f & f is one-to-one implies X,f.:X are_equipotent;

theorem 
  X,Y are_equipotent & x in X & y in Y implies X \ { x },Y \ { y }
  are_equipotent;

theorem 
  succ X, succ Y are_equipotent implies X, Y are_equipotent;

theorem 
  n = {} or ex m st n = succ m;

theorem 
  x in omega implies x is cardinal;

registration
  cluster natural -> cardinal for number;
end;

theorem 
  X,Y are_equipotent & X is finite implies Y is finite;

theorem 
  n is finite & card n is finite;

theorem 
  card n = card m implies n = m;

theorem 
  card n c= card m iff n c= m;

theorem 
  card n in card m iff n in m;

theorem 
  X is finite implies ex n st X,n are_equipotent;

theorem 
  nextcard card n = card succ n;

definition
  let n be Nat;
  redefine func succ n -> Element of omega;
end;

definition
  let X be finite set;
  redefine func card X -> Element of omega;
end;

theorem 
  X is finite implies nextcard X is finite;

scheme 

  CardinalInd { Sigma[set] }: for M holds Sigma[M]
provided
 Sigma[{}] and
 for M st Sigma[M] holds Sigma[nextcard M] and
 for M st M <> {} & M is limit_cardinal & for N st N in M holds Sigma
[N] holds Sigma[M];

scheme 

  CardinalCompInd { Sigma[set] }: for M holds Sigma[M]
provided
 for M st for N st N in M holds Sigma[N] holds Sigma[M];

theorem 
  alef 0 = omega;

registration
  cluster omega -> cardinal for number;
end;

theorem 
  card omega = omega;

registration
  cluster omega -> limit_cardinal;
end;

registration
  cluster -> finite for Element of omega;
end;

registration
  cluster finite for Cardinal;
end;

theorem 
  for M being finite Cardinal ex n st M = card n;

registration
  let X be finite set;
  cluster card X -> finite;
end;

registration
  cluster omega -> infinite;
end;

registration
  cluster infinite for set;
end;

registration
  let X be infinite set;
  cluster card X -> infinite;
end;

begin 

theorem 
  1 = { 0 };

theorem 
  2 = { 0,1 };

theorem 
  3 = { 0,1,2 };

theorem 
  4 = { 0,1,2,3 };

theorem 
  5 = { 0,1,2,3,4 };

theorem 
  6 = { 0,1,2,3,4,5 };

theorem 
  7 = { 0,1,2,3,4,5,6 };

theorem 
  8 = { 0,1,2,3,4,5,6,7 };

theorem 
  9 = { 0,1,2,3,4,5,6,7,8 };

theorem 
  10 = { 0,1,2,3,4,5,6,7,8,9 };



theorem 
  for f being Function st dom f is infinite & f is one-to-one holds rng
  f is infinite;



reserve k,n,m for Nat;

definition

  let n;
  func Segm n -> set equals

  n;
end;

reserve l for Element of omega;

definition
  let n;
  redefine func Segm n -> Subset of omega;
end;



theorem 
  A,n are_equipotent implies A = n;

theorem 
  A is finite iff A in omega;

registration
  cluster natural -> finite for set;
end;



registration
  let A be infinite set;
  cluster bool A -> infinite;
  let B be non empty set;
  cluster [:A,B:] ->infinite;
  cluster [:B,A:] ->infinite;
end;

registration
  let X be infinite set;
  cluster infinite for Subset of X;
end;



registration
  cluster finite ordinal -> natural for number;
end;

theorem 
  for f being Function holds card f = card dom f;

registration
  let X be finite set;
  cluster RelIncl X -> finite;
end;



theorem 
  RelIncl X is finite implies X is finite;

theorem 
 card(k -->x) = k;

begin 

definition let N,X be set;
 attr X is N-element means

 card X = N;
end;

registration let N be Cardinal;
 cluster N-element for set;
end;

registration
 cluster 0-element -> empty for set;
 cluster empty -> 0-element for set;
end;

registration let x be set;
 cluster {x} -> 1-element;
end;

registration let N be Cardinal;
 cluster N-element for Function;
end;

registration let N be Cardinal; let f be N-element Function;
 cluster dom f -> N-element;
end;

registration
 cluster 1-element -> trivial non empty for set;
 cluster trivial non empty -> 1-element for set;
end;

registration let X be non empty set;
 cluster 1-element for Subset of X;
end;

definition let X be non empty set;
 mode Singleton of X is 1-element Subset of X;
end;

theorem 
 for X being non empty set, A being Singleton of X
  ex x being Element of X st A = {x};

theorem 
  card X c= card Y iff ex f st X c= f.:Y;

theorem 
  card (f.:X) c= card X;

theorem 
  card X in card Y implies Y \ X <> {};

theorem 
  X,[:X,{x}:] are_equipotent & card X = card [:X,{x}:];



theorem 
  for f being Function st f is one-to-one holds card dom f = card rng f;















begin

reserve X,Y,Z,X1,X2,Y1,Y2,x,y,z,t,x1,x2 for set,
  f,g,h,f1,f2,g1,g2 for Function;

scheme 

  LambdaFS { FS()->set, f(set)->set }: ex f st dom f = FS() & for g st g in FS
  () holds f.g = f(g);

theorem 
  ~{} = {};

canceled 6;

theorem 
  proj1 {} = {} & proj2 {} = {};

theorem 
  Y <> {} or [:X,Y:] <> {} or [:Y,X:] <> {} implies proj1 [:X,Y:]
  = X & proj2 [:Y,X:] = X;

theorem 
  proj1 [:X,Y:] c= X & proj2 [:X,Y:] c= Y;

theorem 
  Z c= [:X,Y:] implies proj1 Z c= X & proj2 Z c= Y;

theorem 
  proj1 {[x,y]} = {x} & proj2 {[x,y]} = {y};

theorem 
  proj1 {[x,y],[z,t]} = {x,z} & proj2 {[x,y],[z,t]} = {y,t};

theorem 
  not (ex x,y st [x,y] in X) implies proj1 X = {} & proj2 X = {};

theorem 
  proj1 X = {} or proj2 X = {} implies not ex x,y st [x,y] in X;

theorem 
  proj1 X = {} iff proj2 X = {};

theorem 
  proj1 dom f = proj2 dom ~f & proj2 dom f = proj1 dom ~f;

theorem 
  for f being Relation holds proj1 f = dom f & proj2 f = rng f;

definition

  let f;
  func curry f -> Function means


  dom it = proj1 dom f & for x st x in
  proj1 dom f ex g st it.x = g & dom g = proj2 (dom f /\ [:{x},proj2 dom f:]) &
  for y st y in dom g holds g.y = f.(x,y);
  func uncurry f -> Function means


  (for t holds t in dom it iff ex x,g
,y st t = [x,y] & x in dom f & g = f.x & y in dom g) & for x,g st x in dom it &
  g = f.x`1 holds it.x = g.x`2;
end;

definition
  let f;
  func curry' f -> Function equals

  curry ~f;
  func uncurry' f -> Function equals

  ~(uncurry f);
end;

theorem 
  [x,y] in dom f implies x in dom curry f & (curry f).x is Function;

theorem 
  [x,y] in dom f & g = (curry f).x implies y in dom g & g.y = f.(x ,y);

theorem 
  [x,y] in dom f implies y in dom curry' f & (curry' f).y is Function;

theorem 
  [x,y] in dom f & g = (curry' f).y implies x in dom g & g.x = f.(x,y);

theorem 
  dom curry' f = proj2 dom f;

theorem 
  [:X,Y:] <> {} & dom f = [:X,Y:] implies dom curry f = X & dom curry' f = Y;

theorem 
  dom f c= [:X,Y:] implies dom curry f c= X & dom curry' f c= Y;

theorem 
  rng f c= Funcs(X,Y) implies dom uncurry f = [:dom f,X:] & dom
  uncurry' f = [:X,dom f:];

theorem 
  not (ex x,y st [x,y] in dom f) implies curry f = {} & curry' f = {};

theorem 
  not (ex x st x in dom f & f.x is Function) implies uncurry f = {} &
  uncurry' f = {};

theorem 
  [:X,Y:] <> {} & dom f = [:X,Y:] & x in X implies ex g st (curry
  f).x = g & dom g = Y & rng g c= rng f & for y st y in Y holds g.y = f.(x,y);

theorem 
  x in dom curry f implies (curry f).x is Function;

theorem 
  x in dom curry f & g = (curry f).x implies dom g = proj2 (dom f
/\ [:{x},proj2 dom f:]) & dom g c= proj2 dom f & rng g c= rng f & for y st y in
  dom g holds g.y = f.(x,y) & [x,y] in dom f;

theorem 
  [:X,Y:] <> {} & dom f = [:X,Y:] & y in Y implies ex g st (curry'
  f).y = g & dom g = X & rng g c= rng f & for x st x in X holds g.x = f.(x,y);

theorem 
  x in dom curry' f implies (curry' f).x is Function;

theorem 
  x in dom curry' f & g = (curry' f).x implies dom g = proj1 (dom f /\
  [:proj1 dom f,{x}:]) & dom g c= proj1 dom f & rng g c= rng f & for y st y in
  dom g holds g.y = f.(y,x) & [y,x] in dom f;

theorem 
  dom f = [:X,Y:] implies rng curry f c= Funcs(Y,rng f) & rng
  curry' f c= Funcs(X,rng f);

theorem 
  rng curry f c= PFuncs(proj2 dom f,rng f) & rng curry' f c= PFuncs(
  proj1 dom f,rng f);

theorem 
  rng f c= PFuncs(X,Y) implies dom uncurry f c= [:dom f,X:] & dom
  uncurry' f c= [:X,dom f:];

theorem 
  x in dom f & g = f.x & y in dom g implies [x,y] in dom uncurry f
  & (uncurry f).(x,y) = g.y & g.y in rng uncurry f;

theorem 
  x in dom f & g = f.x & y in dom g implies [y,x] in dom uncurry' f & (
  uncurry' f).(y,x) = g.y & g.y in rng uncurry' f;

theorem 
  rng f c= PFuncs(X,Y) implies rng uncurry f c= Y & rng uncurry' f c= Y;

theorem 
  rng f c= Funcs(X,Y) implies rng uncurry f c= Y & rng uncurry' f c= Y;

theorem 
  curry {} = {} & curry' {} = {};

theorem 
  uncurry {} = {} & uncurry' {} = {};

theorem 
  dom f1 = [:X,Y:] & dom f2 = [:X,Y:] & curry f1 = curry f2 implies f1 = f2;

theorem 
  dom f1 = [:X,Y:] & dom f2 = [:X,Y:] & curry' f1 = curry' f2 implies f1 = f2;

theorem 
  rng f1 c= Funcs(X,Y) & rng f2 c= Funcs(X,Y) & X <> {} & uncurry
  f1 = uncurry f2 implies f1 = f2;

theorem 
  rng f1 c= Funcs(X,Y) & rng f2 c= Funcs(X,Y) & X <> {} & uncurry' f1 =
  uncurry' f2 implies f1 = f2;

theorem 
  rng f c= Funcs(X,Y) & X <> {} implies curry uncurry f = f &
  curry' uncurry' f = f;

theorem 
  dom f = [:X,Y:] implies uncurry curry f = f & uncurry' curry' f = f;

theorem 
  dom f c= [:X,Y:] implies uncurry curry f = f & uncurry' curry' f = f;

theorem 
  rng f c= PFuncs(X,Y) & not {} in rng f implies curry uncurry f =
  f & curry' uncurry' f = f;

theorem 
  dom f1 c= [:X,Y:] & dom f2 c= [:X,Y:] & curry f1 = curry f2 implies f1 = f2;

theorem 
  dom f1 c= [:X,Y:] & dom f2 c= [:X,Y:] & curry' f1 = curry' f2 implies f1 = f2
;

theorem 
  rng f1 c= PFuncs(X,Y) & rng f2 c= PFuncs(X,Y) & not {} in rng f1 & not
  {} in rng f2 & uncurry f1 = uncurry f2 implies f1 = f2;

theorem 
  rng f1 c= PFuncs(X,Y) & rng f2 c= PFuncs(X,Y) & not {} in rng f1 & not
  {} in rng f2 & uncurry' f1 = uncurry' f2 implies f1 = f2;

theorem 
  X c= Y implies Funcs(Z,X) c= Funcs(Z,Y);

theorem 
  Funcs({},X) = {{}};

theorem 
  X,Funcs({x},X) are_equipotent & card X = card Funcs({x},X);

theorem 
  Funcs(X,{x}) = {X --> x};

theorem 
  X1,Y1 are_equipotent & X2,Y2 are_equipotent implies Funcs(X1,X2)
  ,Funcs(Y1,Y2) are_equipotent & card Funcs(X1,X2) = card Funcs(Y1,Y2);

theorem 
  card X1 = card Y1 & card X2 = card Y2 implies card Funcs(X1,X2) = card
  Funcs(Y1,Y2);

theorem 
  X1 misses X2 implies Funcs(X1 \/ X2,X),[:Funcs(X1,X),Funcs(X2,X):]
  are_equipotent & card Funcs(X1 \/ X2,X) = card [:Funcs(X1,X),Funcs(X2,X):];

theorem 
  Funcs([:X,Y:],Z),Funcs(X,Funcs(Y,Z)) are_equipotent & card Funcs([:X,Y
  :],Z) = card Funcs(X,Funcs(Y,Z));

theorem 
  Funcs(Z,[:X,Y:]),[:Funcs(Z,X),Funcs(Z,Y):] are_equipotent & card Funcs
  (Z,[:X,Y:]) = card [:Funcs(Z,X),Funcs(Z,Y):];

theorem 
  x <> y implies Funcs(X,{x,y}),bool X are_equipotent & card Funcs(X,{x,
  y}) = card bool X;

theorem 
  x <> y implies Funcs({x,y},X),[:X,X:] are_equipotent & card Funcs({x,y
  },X) = card [:X,X:];

begin 


notation
  synonym op0 for 0;
end;

definition
  redefine func op0 -> Element of 1;
end;

definition
  func op1 equals

  0 .--> 0;
  func op2 equals

  (0,0) :-> 0;
end;

definition
  redefine func op1 -> UnOp of 1;
  redefine func op2 -> BinOp of 1;
end;



reserve C,D,E for non empty set;
reserve c for Element of C,
  d for Element of D;

definition
  let D,X,E;
  let F be FUNCTION_DOMAIN of X,E;
  let f be Function of D,F;
  let d be Element of D;
  redefine func f.d -> Element of F;
end;

reserve f for Function of [:C,D:],E;

theorem 
  curry f is Function of C,Funcs(D,E);

theorem 
  curry' f is Function of D,Funcs(C,E);

definition
  let C,D,E,f;
  redefine func curry f -> Function of C,Funcs(D,E);
  redefine func curry' f -> Function of D,Funcs(C,E);
end;

theorem 
  f.(c,d) = ((curry f).c).d;

theorem 
  f.(c,d) = ((curry' f).d).c;



definition
  let A,B,C be non empty set;
  let f be Function of A, Funcs(B,C);
  redefine func uncurry f -> Function of [:A,B:],C;
end;

theorem 
  for A,B,C being non empty set, f being Function of A,Funcs(B,C)
  holds curry uncurry f = f;

theorem 
  for A,B,C being non empty set, f being Function of A, Funcs(B,C)
for a being Element of A, b being Element of B
      holds (uncurry f).(a,b) = f.a.b;















begin

reserve x,y,X,Y for set;
reserve C,D,E for non empty set;
reserve SC for Subset of C;
reserve SD for Subset of D;
reserve SE for Subset of E;
reserve c,c1,c2 for Element of C;
reserve d,d1,d2 for Element of D;
reserve e for Element of E;
reserve f,f1,g for PartFunc of C,D;
reserve t for PartFunc of D,C;
reserve s for PartFunc of D,E;
reserve h for PartFunc of C,E;
reserve F for PartFunc of D,D;

theorem 
  dom f = dom g & (for c st c in dom f holds f/.c = g/.c) implies f = g;

theorem 
  y in rng f iff ex c st c in dom f & y = f/.c;

theorem 
  h = s*f iff (for c holds c in dom h iff c in dom f & f/.c in dom
  s) & for c st c in dom h holds h/.c = s/.(f/.c);

theorem 
  c in dom f & f/.c in dom s implies (s*f)/.c = s/.(f/.c);

theorem 
  rng f c= dom s & c in dom f implies (s*f)/.c = s/.(f/.c);

definition
  let D;
  let SD;
  redefine func id SD -> PartFunc of D,D;
end;

theorem 
  F = id SD iff dom F = SD & for d st d in SD holds F/.d = d;

theorem 
  d in dom F /\ SD implies F/.d = (F*id SD)/.d;

theorem 
  d in dom((id SD)*F) iff d in dom F & F/.d in SD;

theorem 
  (for c1,c2 st c1 in dom f & c2 in dom f & f/.c1 = f/.c2 holds c1 = c2)
  implies f is one-to-one;

theorem 
  f is one-to-one & x in dom f & y in dom f & f/.x = f/.y implies x = y;

definition
  let X,Y;
  let f be one-to-one PartFunc of X,Y;
  redefine func f" -> PartFunc of Y,X;
end;

theorem 
  for f being one-to-one PartFunc of C,D holds for g be PartFunc
of D,C holds g = f" iff dom g = rng f & for d,c holds d in rng f & c = g/.d iff
  c in dom f & d = f/.c;

theorem 
  for f being one-to-one PartFunc of C,D st c in dom f holds c = f"/.(f
  /.c) & c = (f"*f)/.c;

theorem 
  for f being one-to-one PartFunc of C,D st d in rng f holds d = f/.(f"
  /.d) & d = (f*(f"))/.d;

theorem 
  f is one-to-one & dom f = rng t & rng f = dom t & (for c,d st c in dom
  f & d in dom t holds f/.c = d iff t/.d = c) implies t = f";

theorem 
  g = f|X iff dom g = dom f /\ X & for c st c in dom g holds g/.c = f/.c;

theorem 
  c in dom f /\ X implies f|X/.c = f/.c;

theorem 
  c in dom f & c in X implies f|X/.c = f/.c;

theorem 
  c in dom f & c in X implies f/.c in rng (f|X);

definition
  let C,D;
  let X,f;
  redefine func X|`f -> PartFunc of C,D;
end;

theorem 
  g = X|`f iff (for c holds c in dom g iff c in dom f & f/.c in X)
  & for c st c in dom g holds g/.c = f/.c;

theorem 
  c in dom (X|`f) iff c in dom f & f/.c in X;

theorem 
  c in dom (X|`f) implies X|`f/.c = f/.c;

theorem 
  SD = f.: X iff for d holds d in SD iff ex c st c in dom f & c in X & d = f/.c
;

theorem 
  d in (f qua Relation of C,D).:X iff ex c st c in dom f & c in X & d =
  f/.c;

theorem 
  c in dom f implies Im(f,c) = {f/.c};

theorem 
  c1 in dom f & c2 in dom f implies f.:{c1,c2} = {f/.c1,f/.c2};

theorem 
  SC = f"X iff for c holds c in SC iff c in dom f & f/.c in X;

theorem 
  for f ex g being Function of C,D st for c st c in dom f holds g.c = f /.c;

theorem 
  f tolerates g iff for c st c in dom f /\ dom g holds f/.c = g/.c;

scheme 

  PartFuncExD{D,C()->non empty set, P[set,set]}: ex f being PartFunc of D(),C(
) st (for d be Element of D() holds d in dom f iff (ex c be Element of C() st P
  [d,c])) & for d be Element of D() st d in dom f holds P[d,f/.d];

scheme 

  LambdaPFD{D,C()->non empty set, F(set)->Element of C(), P[set]}: ex f being
  PartFunc of D(),C() st (for d be Element of D() holds d in dom f iff P[d]) &
  for d be Element of D() st d in dom f holds f/.d = F(d);

scheme 

  UnPartFuncD{C,D()->non empty set, X()->set, F(set)->Element of D()}: for f,g
being PartFunc of C(),D() st (dom f=X() & for c be Element of C() st c in dom f
holds f/.c = F(c)) & (dom g=X() & for c be Element of C() st c in dom g holds g
  /.c = F(c)) holds f = g;

definition
  let C,D;
  let SC,d;
  redefine func SC --> d -> PartFunc of C,D;
end;

theorem 
  c in SC implies (SC --> d)/.c = d;

theorem 
  (for c st c in dom f holds f/.c = d) implies f = dom f --> d;

theorem 
  c in dom f implies f*(SE --> c) = SE --> f/.c;

theorem 
  (id SC) is total iff SC = C;

theorem 
  (SC --> d) is total implies SC <> {};

theorem 
  (SC --> d) is total iff SC = C;





definition
  let C,D,f;
  redefine attr f is constant means

  ex d st for c st c in dom f holds f.c = d;
end;

theorem 
  f|X is constant iff ex d st for c st c in X /\ dom f holds f/.c = d;

theorem 
  f|X is constant iff for c1,c2 st c1 in X /\ dom f & c2 in X /\ dom f
  holds f/.c1=f/.c2;

theorem 
  X meets dom f implies (f|X is constant iff ex d st rng (f|X) = {d});

theorem 
  f|X is constant & Y c= X implies f|Y is constant;

theorem 
  X misses dom f implies f|X is constant;

theorem 
  f|SC = dom (f|SC) --> d implies f|SC is constant;

theorem 
  f|{x} is constant;

theorem 
  f|X is constant & f|Y is constant & X /\ Y meets dom f implies f|(X \/
  Y) is constant;

theorem 
  f|Y is constant implies f|X|Y is constant;

theorem 
  (SC --> d)|SC is constant;





theorem 
 dom f c= dom g & (for c st c in dom f holds f/.c = g/.c) implies f c= g;

theorem 
  c in dom f & d = f/.c iff [c,d] in f;

theorem 
  [c,e] in (s*f) implies [c,f/.c] in f & [f/.c,e] in s;

theorem 
  f = {[c,d]} implies f/.c = d;

theorem 
  dom f = {c} implies f = {[c,f/.c]};

theorem 
  f1 = f /\ g & c in dom f1 implies f1/.c = f/.c & f1/.c = g/.c;

theorem 
  c in dom f & f1 = f \/ g implies f1/.c = f/.c;

theorem 
  c in dom g & f1 = f \/ g implies f1/.c = g/.c;

theorem 
  c in dom f1 & f1 = f \/ g implies f1/.c = f/.c or f1/.c = g/.c;

theorem 
  c in dom f & c in SC iff [c,f/.c] in (f|SC);

theorem 
  c in dom f & f/.c in SD iff [c,f/.c] in (SD|`f);

theorem 
  c in f"SD iff [c,f/.c] in f & f/.c in SD;

theorem 
  f|X is constant iff ex d st for c st c in X /\ dom f holds f.c = d;

theorem 
  f|X is constant iff for c1,c2 st c1 in X /\ dom f & c2 in X /\ dom f
  holds f.c1=f.c2;

theorem 
  d in f.:X implies ex c st c in dom f & c in X & d = f.c;

theorem 
  f is one-to-one implies (d in rng f & c = (f").d iff c in dom f & d = f.c);

theorem 
  for Y for f,g be Y-valued Function st f c= g
  for x st x in dom f holds f/.x = g/.x;














begin

reserve W,X,Y,Z for set,
  f,g for Function,
  a,x,y,z for set;

definition
  let B be set;
  attr B is subset-closed means


  for X,Y holds X in B & Y c= X implies Y in B;
end;

definition
  let B be set;
  attr B is Tarski means


  B is subset-closed & (for X holds X in B implies bool X in B) &
  for X holds X c= B implies X,B are_equipotent or X in B;
end;

definition
  let A,B be set;
  pred B is_Tarski-Class_of A means


  A in B & B is Tarski;
end;

definition
  let A be set;
  func Tarski-Class A -> set means


  it is_Tarski-Class_of A &
  for D being set st D is_Tarski-Class_of A holds it c= D;
end;

registration
  let A be set;
  cluster Tarski-Class A -> non empty;
end;

theorem 
  W is Tarski iff W is subset-closed & (for X st X in W holds bool X in W) &
  for X st X c= W & card X in card W holds X in W;

theorem 
  X in Tarski-Class X;

theorem 
  Y in Tarski-Class X & Z c= Y implies Z in Tarski-Class X;

theorem 
  Y in Tarski-Class X implies bool Y in Tarski-Class X;

theorem 
  Y c= Tarski-Class X implies
  Y,Tarski-Class X are_equipotent or Y in Tarski-Class X;

theorem 
  Y c= Tarski-Class X & card Y in card Tarski-Class X implies
  Y in Tarski-Class X;

reserve u,v for Element of Tarski-Class(X),
  A,B,C for Ordinal,
  L for T-Sequence;

definition
  let X,A;
  func Tarski-Class(X,A) means


  ex L st it = last L & dom L = succ A & L.{} = { X } &
  (for C st succ C in succ A holds
  L.succ C = { u : ex v st v in L.C & u c= v } \/ { bool v : v in L.C } \/
  bool(L.C) /\ Tarski-Class X) &
  for C st C in succ A & C <> {} & C is limit_ordinal
  holds L.C = (union rng(L|C)) /\ Tarski-Class X;
end;

definition
  let X,A;
  redefine func Tarski-Class(X,A) -> Subset of Tarski-Class X;
end;

theorem 
  Tarski-Class(X,{}) = { X };

theorem 
  Tarski-Class(X,succ A) = { u : ex v st v in Tarski-Class(X,A) & u c= v } \/
  { bool v : v in Tarski-Class(X,A) } \/
  bool Tarski-Class(X,A) /\ Tarski-Class X;

theorem 
  A <> {} & A is limit_ordinal implies
  Tarski-Class(X,A) = { u : ex B st B in A & u in Tarski-Class(X,B) };

theorem 
  Y in Tarski-Class(X,succ A) iff
  Y c= Tarski-Class(X,A) & Y in Tarski-Class X or
  ex Z st Z in Tarski-Class(X,A) & (Y c= Z or Y = bool Z);

theorem 
  Y c= Z & Z in Tarski-Class(X,A) implies Y in Tarski-Class(X,succ A);

theorem 
  Y in Tarski-Class(X,A) implies bool Y in Tarski-Class(X,succ A);

theorem 
  A <> {} & A is limit_ordinal implies
  (x in Tarski-Class(X,A) iff ex B st B in A & x in Tarski-Class(X,B));

theorem 
  A <> {} & A is limit_ordinal & Y in Tarski-Class(X,A) &
  (Z c= Y or Z = bool Y) implies Z in Tarski-Class(X,A);

theorem 
  Tarski-Class(X,A) c= Tarski-Class(X,succ A);

theorem 
  A c= B implies Tarski-Class(X,A) c= Tarski-Class(X,B);

theorem 
  ex A st Tarski-Class(X,A) = Tarski-Class(X,succ A);

theorem 
  Tarski-Class(X,A) = Tarski-Class(X,succ A) implies
  Tarski-Class(X,A) = Tarski-Class X;

theorem 
  ex A st Tarski-Class(X,A) = Tarski-Class X;

theorem 
  ex A st Tarski-Class(X,A) = Tarski-Class X &
  for B st B in A holds Tarski-Class(X,B) <> Tarski-Class X;

theorem 
  Y <> X & Y in Tarski-Class X implies
  ex A st not Y in Tarski-Class(X,A) & Y in Tarski-Class(X,succ A);

theorem 
  X is epsilon-transitive implies
  for A st A <> {} holds Tarski-Class(X,A) is epsilon-transitive;

theorem 
  X is epsilon-transitive implies Tarski-Class X is epsilon-transitive;

theorem 
  Y in Tarski-Class X implies card Y in card Tarski-Class X;

theorem 
  Y in Tarski-Class X implies not Y,Tarski-Class X are_equipotent;

theorem 
  x in Tarski-Class X & y in Tarski-Class X implies
  {x} in Tarski-Class X & {x,y} in Tarski-Class X;

theorem 
  x in Tarski-Class X & y in Tarski-Class X implies [x,y] in Tarski-Class X;

theorem 
  Y c= Tarski-Class X & Z c= Tarski-Class X implies [:Y,Z:] c= Tarski-Class X;

definition
  let A;
  func Rank(A) means


  ex L st it = last L & dom L = succ A & L.{} = {} &
  (for C st succ C in succ A holds L.succ C = bool(L.C)) &
  for C st C in succ A & C <> {} & C is limit_ordinal
  holds L.C = union rng(L|C);
end;

theorem 
  Rank {} = {};

theorem 
  Rank succ A = bool Rank A;

theorem 
  A <> {} & A is limit_ordinal implies
  for x holds x in Rank A iff ex B st B in A & x in Rank B;

theorem 
  X c= Rank A iff X in Rank succ A;

registration
  let A;
  cluster Rank A -> epsilon-transitive;
end;

theorem 
  Rank A c= Rank succ A;

theorem 
  union Rank A c= Rank A;

theorem 
  X in Rank A implies union X in Rank A;

theorem 
  A in B iff Rank A in Rank B;

theorem 
  A c= B iff Rank A c= Rank B;

theorem 
  A c= Rank A;

theorem 
  for A,X st X in Rank A holds
  not X,Rank A are_equipotent & card X in card Rank A;

theorem 
  X c= Rank A iff bool X c= Rank succ A;

theorem 
  X c= Y & Y in Rank A implies X in Rank A;

theorem 
  X in Rank A iff bool X in Rank succ A;

theorem 
  x in Rank A iff {x} in Rank succ A;

theorem 
  x in Rank A & y in Rank A iff {x,y} in Rank succ A;

theorem 
  x in Rank A & y in Rank A iff [x,y] in Rank succ succ A;

theorem 
  X is epsilon-transitive &
  Rank A /\ Tarski-Class X = Rank succ A /\ Tarski-Class X implies
  Tarski-Class X c= Rank A;

theorem 
  X is epsilon-transitive implies ex A st Tarski-Class X c= Rank A;

theorem 
  X is epsilon-transitive implies union X c= X;

theorem 
  X is epsilon-transitive & Y is epsilon-transitive implies
  X \/ Y is epsilon-transitive;

theorem 
  X is epsilon-transitive & Y is epsilon-transitive implies
  X /\ Y is epsilon-transitive;

reserve n for Element of omega;

definition
  let X;
  func the_transitive-closure_of X -> set means


  x in it iff ex f,n st x in f.n & dom f = omega & f.0 = X &
  for k being Nat holds f.(succ k) = union(f.k);
end;

theorem 
  the_transitive-closure_of X is epsilon-transitive;

theorem 
  X c= the_transitive-closure_of X;

theorem 
  X c= Y & Y is epsilon-transitive implies the_transitive-closure_of X c= Y;

theorem 
  (for Z st X c= Z & Z is epsilon-transitive holds Y c= Z) & X c= Y &
  Y is epsilon-transitive implies the_transitive-closure_of X = Y;

theorem 
  X is epsilon-transitive implies the_transitive-closure_of X = X;

theorem 
  the_transitive-closure_of {} = {};

theorem 
  the_transitive-closure_of A = A;

theorem 
  X c= Y implies the_transitive-closure_of X c= the_transitive-closure_of Y;

theorem 
  the_transitive-closure_of the_transitive-closure_of X =
  the_transitive-closure_of X;

theorem 
  the_transitive-closure_of (X \/ Y) =
  the_transitive-closure_of X \/ the_transitive-closure_of Y;

theorem 
  the_transitive-closure_of (X /\ Y) c=
  the_transitive-closure_of X /\ the_transitive-closure_of Y;

theorem 
  ex A st X c= Rank A;

definition
  let X;
  func the_rank_of X -> Ordinal means


  X c= Rank it & for B st X c= Rank B holds it c= B;
end;

theorem 
  the_rank_of bool X = succ the_rank_of X;

theorem 
  the_rank_of Rank A = A;

theorem 
  X c= Rank A iff the_rank_of X c= A;

theorem 
  X in Rank A iff the_rank_of X in A;

theorem 
  X c= Y implies the_rank_of X c= the_rank_of Y;

theorem 
  X in Y implies the_rank_of X in the_rank_of Y;

theorem 
  the_rank_of X c= A iff for Y st Y in X holds the_rank_of Y in A;

theorem 
  A c= the_rank_of X iff for B st B in A ex Y st Y in X & B c= the_rank_of Y;

theorem 
  the_rank_of X = {} iff X = {};

theorem 
  the_rank_of X = succ A implies ex Y st Y in X & the_rank_of Y = A;

theorem 
  the_rank_of A = A;

theorem 
  the_rank_of Tarski-Class X <> {} &
  the_rank_of Tarski-Class X is limit_ordinal;

begin 


reserve e,u for set;

scheme 
 NonUniqFuncEx { X() -> set, P[set,set] }:
  ex f being Function st dom f = X() & for e st e in X() holds P[e,f.e]
provided
 for e st e in X() ex u st P[e,u];



definition
  let F,G be Relation;
  pred F,G are_fiberwise_equipotent means


  for x be set holds card Coim(F,x) = card Coim(G,x);
  reflexivity;
  symmetry;
end;

theorem 
  for F,G be Function st F,G are_fiberwise_equipotent holds rng F = rng G;

theorem 
  for F,G,H be Function
  st F,G are_fiberwise_equipotent & F,H are_fiberwise_equipotent holds
  G,H are_fiberwise_equipotent;

theorem 
  for F,G be Function holds F,G are_fiberwise_equipotent iff
  ex H be Function st dom H = dom F & rng H = dom G & H is one-to-one & F = G*H
;

theorem 
  for F,G be Function holds
  F,G are_fiberwise_equipotent iff for X be set holds card (F"X) = card (G"X);

theorem 
  for D be non empty set, F,G be Function st rng F c= D & rng G c= D &
  for d be Element of D holds card Coim(F,d) = card Coim(G,d)
  holds F,G are_fiberwise_equipotent;

theorem 
  for F,G be Function st dom F = dom G holds
  F,G are_fiberwise_equipotent iff ex P be Permutation of dom F st F = G*P;

theorem 
  for F,G be Function
  st F,G are_fiberwise_equipotent holds card dom F = card dom G;



theorem 
  for f being set, p being Relation
  for x being set st x in rng p holds the_rank_of x in the_rank_of [p,f];



theorem 
  for f, g, h being Function
  st dom f = dom g & rng f c= dom h & rng g c= dom h &
  f, g are_fiberwise_equipotent holds h*f, h*g are_fiberwise_equipotent;















begin

reserve i,j,e,u for set;

theorem 
  for f being Function st f is non-empty holds rng f is
  with_non-empty_elements;

theorem 
  for f being Function holds f is empty-yielding iff f = {} or rng f = {
  {} };

reserve I for set; 

registration
  let I;
  cluster total for I-defined Function;
end;

definition
  let I;
  mode ManySortedSet of I is total I-defined Function;
end;

reserve x,X,Y,Z,V for ManySortedSet of I;

scheme 

  KuratowskiFunction{A()-> set, F(set) -> set}:
 ex f being ManySortedSet of A() st for e st e in A() holds f.e in F(e)
provided
 for e st e in A() holds F(e) <> {};

definition
  let I,X,Y;
  pred X in Y means


  for i st i in I holds X.i in Y.i;
  pred X c= Y means


  for i st i in I holds X.i c= Y.i;
  reflexivity;
end;

definition
  let I be non empty set,X,Y be ManySortedSet of I;
  redefine pred X in Y;
  asymmetry;
end;

scheme 

  PSeparation { I()-> set, A() -> ManySortedSet of I(), P[set,set] } : ex X
being ManySortedSet of I() st for i being set st i in I() for e holds e in X.i
  iff e in A().i & P[i,e];

theorem 
  (for i st i in I holds X.i = Y.i) implies X = Y;

definition
  let I;
  func [[0]]I -> ManySortedSet of I equals

  I --> {};
  let X,Y;
  func X \/ Y -> ManySortedSet of I means


  for i st i in I holds it.i = X.i \/ Y.i;
  commutativity;
  idempotence;
  func X /\ Y -> ManySortedSet of I means


  for i st i in I holds it.i = X.i /\ Y.i;
  commutativity;
  idempotence;
  func X \ Y -> ManySortedSet of I means


  for i st i in I holds it.i = X.i \ Y.i;
  pred X overlaps Y means


  for i st i in I holds X.i meets Y.i;
  symmetry;
  pred X misses Y means


  for i st i in I holds X.i misses Y.i;
  symmetry;
end;

notation
  let I;
  let X,Y;
  antonym X meets Y for X misses Y;
end;

definition
  let I,X,Y;
  func X \+\ Y -> ManySortedSet of I equals

  (X \ Y) \/ (Y \ X);
  commutativity;
end;

theorem 
  for i st i in I holds (X \+\ Y).i = X.i \+\ Y.i;

theorem 
  [[0]]I.i = {};

theorem 
  (for i st i in I holds X.i = {}) implies X = [[0]]I;

theorem 
  x in X or x in Y implies x in X \/ Y;

theorem 
  x in X /\ Y iff x in X & x in Y;

theorem 
  x in X & X c= Y implies x in Y;

theorem 
  x in X & x in Y implies X overlaps Y;

theorem 
  X overlaps Y implies ex x st x in X & x in Y;

theorem 
  x in X \ Y implies x in X;

begin

definition
  let I,X,Y;
  redefine pred X = Y means

  for i st i in I holds X.i = Y.i;
end;

theorem 
  X c= Y & Y c= Z implies X c= Z;

theorem 
  X c= X \/ Y;

theorem 
  X /\ Y c= X;

theorem 
  X c= Z & Y c= Z implies X \/ Y c= Z;

theorem 
  Z c= X & Z c= Y implies Z c= X /\ Y;

theorem 
  X c= Y implies X \/ Z c= Y \/ Z;

theorem 
  X c= Y implies X /\ Z c= Y /\ Z;

theorem 
  X c= Y & Z c= V implies X \/ Z c= Y \/ V;

theorem 
  X c= Y & Z c= V implies X /\ Z c= Y /\ V;

theorem 
  X c= Y implies X \/ Y = Y;

theorem 
  X c= Y implies X /\ Y = X;

theorem 
  X /\ Y c= X \/ Z;

theorem 
  X c= Z implies X \/ Y /\ Z = (X \/ Y) /\ Z;

theorem 
  X = Y \/ Z iff Y c= X & Z c= X & for V st Y c= V & Z c= V holds X c= V;

theorem 
  X = Y /\ Z iff X c= Y & X c= Z & for V st V c= Y & V c= Z holds V c= X;

theorem 
  (X \/ Y) \/ Z = X \/ (Y \/ Z);

theorem 
  (X /\ Y) /\ Z = X /\ (Y /\ Z);

theorem 
  X /\ (X \/ Y) = X;

theorem 
  X \/ (X /\ Y) = X;

theorem 
  X /\ (Y \/ Z) = X /\ Y \/ X /\ Z;

theorem 
  X \/ Y /\ Z = (X \/ Y) /\ (X \/ Z);

theorem 
  (X /\ Y) \/ (X /\ Z) = X implies X c= Y \/ Z;

theorem 
  (X \/ Y) /\ (X \/ Z) = X implies Y /\ Z c= X;

theorem 
  (X /\ Y) \/ (Y /\ Z) \/ (Z /\ X) = (X \/ Y) /\ (Y \/ Z) /\ (Z \/ X);

theorem 
  X \/ Y c= Z implies X c= Z;

theorem 
  X c= Y /\ Z implies X c= Y;

theorem 
  X \/ Y \/ Z = (X \/ Z) \/ (Y \/ Z);

theorem 
  X /\ Y /\ Z = (X /\ Z) /\ (Y /\ Z);

theorem 
  X \/ (X \/ Y) = X \/ Y;

theorem 
  X /\ (X /\ Y) = X /\ Y;

begin 

theorem 
  [[0]]I c= X;

theorem 
  X c= [[0]]I implies X = [[0]]I;

theorem 
  X c= Y & X c= Z & Y /\ Z = [[0]]I implies X = [[0]]I;

theorem 
  X c= Y & Y /\ Z = [[0]]I implies X /\ Z = [[0]]I;

theorem 
  X \/ [[0]]I = X & [[0]]I \/ X = X;

theorem 
  X \/ Y = [[0]]I implies X = [[0]]I;

theorem 
  X /\ [[0]]I = [[0]]I;

theorem 
  X c= (Y \/ Z) & X /\ Z = [[0]]I implies X c= Y;

theorem 
  Y c= X & X /\ Y = [[0]]I implies Y = [[0]]I;

begin 

theorem 
  X \ Y = [[0]]I iff X c= Y;

theorem 
  X c= Y implies X \ Z c= Y \ Z;

theorem 
  X c= Y implies Z \ Y c= Z \ X;

theorem 
  X c= Y & Z c= V implies X \ V c= Y \ Z;

theorem 
  X \ Y c= X;

theorem 
  X c= Y \ X implies X = [[0]]I;

theorem 
  X \ X = [[0]]I;

theorem 
  X \ [[0]]I = X;

theorem 
  [[0]]I \ X = [[0]]I;

theorem 
  X \ (X \/ Y) = [[0]]I;

theorem 
  X /\ (Y \ Z) = (X /\ Y) \ Z;

theorem 
  (X \ Y) /\ Y = [[0]]I;

theorem 
  X \ (Y \ Z) = (X \ Y) \/ X /\ Z;

theorem 
  (X \ Y) \/ X /\ Y = X;

theorem 
  X c= Y implies Y = X \/ (Y \ X);

theorem 
  X \/ (Y \ X) = X \/ Y;

theorem 
  X \ (X \ Y) = X /\ Y;

theorem 
  X \ (Y /\ Z) = (X \ Y) \/ (X \ Z);

theorem 
  X \ X /\ Y = X \ Y;

theorem 
  X /\ Y = [[0]]I iff X \ Y = X;

theorem 
  (X \/ Y) \ Z = (X \ Z) \/ (Y \ Z);

theorem 
  (X \ Y) \ Z = X \ (Y \/ Z);

theorem 
  (X /\ Y) \ Z = (X \ Z) /\ (Y \ Z);

theorem 
  (X \/ Y) \ Y = X \ Y;

theorem 
  X c= Y \/ Z implies X \ Y c= Z & X \ Z c= Y;

theorem 
  (X \/ Y) \ (X /\ Y) = (X \ Y) \/ (Y \ X);

theorem 
  (X \ Y) \ Y = X \ Y;

theorem 
  X \ (Y \/ Z) = (X \ Y) /\ (X \ Z);

theorem 
  X \ Y = Y \ X implies X = Y;

theorem 
  X /\ (Y \ Z) = X /\ Y \ X /\ Z;

theorem 
  X \ Y c= Z implies X c= Y \/ Z;

theorem 
  X \ Y c= X \+\ Y;

theorem 
  X \+\ [[0]]I = X;

theorem 
  X \+\ X = [[0]]I;

theorem 
  X \/ Y = (X \+\ Y) \/ X /\ Y;

theorem 
  X \+\ Y = (X \/ Y) \ X /\ Y;

theorem 
  (X \+\ Y) \ Z = (X \ (Y \/ Z)) \/ (Y \ (X \/ Z));

theorem 
  X \ (Y \+\ Z) = X \ (Y \/ Z) \/ X /\ Y /\ Z;

theorem 
  (X \+\ Y) \+\ Z = X \+\ (Y \+\ Z);

theorem 
  X \ Y c= Z & Y \ X c= Z implies X \+\ Y c= Z;

theorem 
  X \/ Y = X \+\ (Y \ X);

theorem 
  X /\ Y = X \+\ (X \ Y);

theorem 
  X \ Y = X \+\ (X /\ Y);

theorem 
  Y \ X = X \+\ (X \/ Y);

theorem 
  X \/ Y = X \+\ Y \+\ X /\ Y;

theorem 
  X /\ Y = X \+\ Y \+\ (X \/ Y);

begin 

theorem 
  X overlaps Y or X overlaps Z implies X overlaps Y \/ Z;

theorem 
  X overlaps Y & Y c= Z implies X overlaps Z;

theorem 
  X overlaps Y & X c= Z implies Z overlaps Y;

theorem 
  X c= Y & Z c= V & X overlaps Z implies Y overlaps V;

theorem 
  X overlaps Y /\ Z implies X overlaps Y & X overlaps Z;

theorem 
  X overlaps Z & X c= V implies X overlaps Z /\ V;

theorem 
  X overlaps Y \ Z implies X overlaps Y;

theorem 
  Y does not overlap Z implies X /\ Y does not overlap X /\ Z;

theorem 
  X overlaps Y \ Z implies Y overlaps X \ Z;

theorem 
  X meets Y & Y c= Z implies X meets Z;

theorem 
  Y misses X \ Y;

theorem 
  X /\ Y misses X \ Y;

theorem 
  X /\ Y misses X \+\ Y;

theorem 
  X misses Y implies X /\ Y = [[0]]I;

theorem 
  X <> [[0]]I implies X meets X;

theorem 
  X c= Y & X c= Z & Y misses Z implies X = [[0]]I;

theorem 
  Z \/ V = X \/ Y & X misses Z & Y misses V implies X = V & Y = Z;

theorem 
  X misses Y implies X \ Y = X;

theorem 
  X misses Y implies (X \/ Y) \ Y = X;

theorem 
  X \ Y = X implies X misses Y;

theorem 
  X \ Y misses Y \ X;

begin 

definition
  let I,X,Y;
  pred X [= Y means


  for x st x in X holds x in Y;
  reflexivity;
end;

theorem 
  X c= Y implies X [= Y;

theorem 
  X [= Y & Y [= Z implies X [= Z;

begin 

theorem 
  [[0]]{} in [[0]]{};

theorem 
  for X being ManySortedSet of {} holds X = {};

reserve I for non empty set,
  x,X,Y for ManySortedSet of I;

theorem 
  X overlaps Y implies X meets Y;

theorem 
  not ex x st x in [[0]]I;

theorem 
  x in X & x in Y implies X /\ Y <> [[0]]I;

theorem 
  X does not overlap [[0]]I;

theorem 
  X /\ Y = [[0]]I implies X does not overlap Y;

theorem 
  X overlaps X implies X <> [[0]]I;

begin 

reserve I for set,
  x,X,Y,Z for ManySortedSet of I;

definition
  let I be set;
  let X be ManySortedSet of I;
  redefine attr X is empty-yielding means


  for i st i in I holds X.i is
  empty;
  redefine attr X is non-empty means


  for i st i in I holds X.i is non empty;
end;

registration
  let I be set;
  cluster empty-yielding for ManySortedSet of I;
  cluster non-empty for ManySortedSet of I;
end;

registration
  let I be non empty set;
  cluster non-empty -> non empty-yielding for ManySortedSet of I;
  cluster empty-yielding -> non non-empty for ManySortedSet of I;
end;

theorem 
  X is empty-yielding iff X = [[0]]I;

theorem 
  Y is empty-yielding & X c= Y implies X is empty-yielding;

theorem 
  X is non-empty & X c= Y implies Y is non-empty;

theorem 
  X is non-empty & X [= Y implies X c= Y;

theorem 
  X is non-empty & X [= Y implies Y is non-empty;

reserve X for non-empty ManySortedSet of I;

theorem 
  ex x st x in X;

theorem 
  (for x holds x in X iff x in Y) implies X = Y;

theorem 
  (for x holds x in X iff x in Y & x in Z) implies X = Y /\ Z;

begin 

scheme 

  MSSEx { I() -> set, P[set,set] }: ex f being ManySortedSet of I() st for i
  st i in I() holds P[i,f.i]
provided
 for i st i in I() ex j st P[i,j];

scheme 

  MSSLambda { I() -> set, F(set) -> set }: ex f being ManySortedSet of I() st
  for i st i in I() holds f.i = F(i);

registration
  let I be set;
  cluster Function-yielding for ManySortedSet of I;
end;

definition
  let I be set;
  mode ManySortedFunction of I is Function-yielding ManySortedSet of I;
end;

theorem 
  not ex M being non-empty ManySortedSet of I st {} in rng M;

definition
  let I be set;
  let M be ManySortedSet of I;
  mode Component of M is Element of rng M;
end;

theorem 
  for I being non empty set for M being ManySortedSet of I, A being
  Component of M ex i st i in I & A = M.i;

theorem 
  for M being ManySortedSet of I, i st i in I holds M.i is Component of M;

definition
  let I;
  let B be ManySortedSet of I;
  mode Element of B -> ManySortedSet of I means

    for i st i in I holds it.i is
    Element of B.i;
end;

begin 

definition
  let I;
  let A be ManySortedSet of I, B be ManySortedSet of I;
  mode ManySortedFunction of A,B -> ManySortedSet of I means

 for i st i in I holds it.i is Function of A.i, B.i;
end;

registration
  let I;
  let A be ManySortedSet of I, B be ManySortedSet of I;
  cluster ->Function-yielding for ManySortedFunction of A,B;
end;

registration
  let I be set;
  let J be non empty set;
  let O be Function of I,J;
  let F be ManySortedSet of J;
  cluster F*O -> total for I-defined Function;
end;

reserve D for non empty set,
  n for Nat;

scheme 

  LambdaDMS {D()->non empty set, F(set)->set}: ex X be ManySortedSet of D() st
  for d be Element of D() holds X.d = F(d);

registration
  let J be non empty set, B be non-empty ManySortedSet of J, j be Element of J;
  cluster B.j -> non empty;
end;

reserve X,Y for ManySortedSet of I;

definition
  let I, X,Y;
  func [|X,Y|] -> ManySortedSet of I means

  for i st i in I holds it.i = [:X.i,Y.i:];
end;

definition
  let I, X, Y;
  func (Funcs) (X,Y) -> ManySortedSet of I means

  for i be set st i in I holds it.i = Funcs(X.i,Y.i);
end;

definition
  let I be set, M be ManySortedSet of I;
  mode ManySortedSubset of M -> ManySortedSet of I means


  it c= M;
end;

registration
  let I be set, M be non-empty ManySortedSet of I;
  cluster non-empty for ManySortedSubset of M;
end;

definition
  let F,G be Function-yielding Function;
  func G**F -> Function means


  dom it = (dom F) /\ (dom G) &
  for i be set st i in dom it holds it.i = (G.i)*(F.i);
end;

registration
  let F,G be Function-yielding Function;
  cluster G**F -> Function-yielding;
end;

definition
  let I be set, A be ManySortedSet of I, F be ManySortedFunction of I;
  func F.:.:A -> ManySortedSet of I means

  for i be set st i in I holds it.i = (F.i).:(A.i);
end;

registration
  let I;
  cluster [[0]]I -> empty-yielding;
end;

scheme 

  MSSExD { I() -> non empty set, P[set,set] }: ex f being ManySortedSet of I()
  st for i being Element of I() holds P[i,f.i]
provided
 for i being Element of I() ex j being set st P[i,j];

registration
  let A be non empty set;
  cluster non-empty -> non empty-yielding for ManySortedSet of A;
end;

registration
  let X be non empty set;
  cluster -> non empty for ManySortedSet of X;
end;

theorem 
  for F, G, H be Function-yielding Function holds
  (H ** G) ** F = H ** (G ** F);

registration
 let I be set, f be non-empty ManySortedSet of I;
 cluster total for I-defined f-compatible Function;
end;

theorem 
 for I being set, f being non-empty ManySortedSet of I
 for p being f-compatible I-defined Function
  ex s being f-compatible ManySortedSet of I st p c= s;

theorem 
  for I,A be set
  for s,ss being ManySortedSet of I
  holds (ss +* s | A) | A = s | A;

registration
 let X be non empty set, Y be set;
 cluster X-valued for ManySortedSet of Y;
end;

theorem 
  for I,Y being non empty set, M be Y-valued ManySortedSet of I,
     x be Element of I
  holds M.x = M/.x;

theorem 
 for f being Function, M being ManySortedSet of I
   holds (f+*M)|I = M;

theorem 
 for I being set, Y being non empty set
 for p being Y-valued I-defined Function
  ex s being Y-valued ManySortedSet of I st p c= s;

theorem 
 X c= Y & Y c= X implies X = Y;

definition let I be non empty set, A,B be ManySortedSet of I;
 redefine pred A = B means

  for i being Element of I holds A.i = B.i;
end;














begin

reserve A,B,C for Ordinal,
  K,L,M,N for Cardinal,
  x,y,y1,y2,z,u,X,Y,Z,Z1,Z2 for set,
  n for Nat,
  f,f1,g,h for Function,
  Q,R for Relation;

definition
  let IT be Function;
  attr IT is Cardinal-yielding means

   for x st x in dom IT holds IT.x is Cardinal;
end;

registration
  cluster empty -> Cardinal-yielding for Function;
end;

registration
  cluster Cardinal-yielding for Function;
end;

definition
  mode Cardinal-Function is Cardinal-yielding Function;
end;

reserve ff for Cardinal-Function;

registration
  let ff,X;
  cluster ff|X -> Cardinal-yielding;
end;

registration
  let X,K;
  cluster X --> K -> Cardinal-yielding;
end;

registration
  let X,K;
  cluster X .--> K -> Cardinal-yielding;
end;

scheme 
 CFLambda { A()->set, F(set)->Cardinal } :
  ex ff st dom ff = A() & for x st x in A() holds ff.x = F(x);

definition
  let f;
  func Card f -> Cardinal-Function means


   dom it = dom f & for x st x in dom f holds it.x = card(f.x);
  func disjoin f -> Function means


   dom it = dom f & for x st x in dom f holds it.x = [:f.x,{x}:];
  func Union f -> set equals

  union rng f;
  func product f -> set means


   x in it iff ex g st x = g & dom g = dom f &
  for y st y in dom f holds g.y in f.y;
end;

theorem 
  Card ff = ff;

theorem 
  Card (X --> Y) = X --> card Y;

theorem 
  disjoin {} = {};

theorem 
  disjoin (x .--> X) = x .--> [:X,{x}:];

theorem 
  x in dom f & y in dom f & x <> y implies (disjoin f).x misses (disjoin f).y;

theorem 
  Union (X --> Y) c= Y;

theorem 
  X <> {} implies Union (X --> Y) = Y;

theorem 
  Union (x .--> Y) = Y;

theorem 
  g in product f iff dom g = dom f & for x st x in dom f holds g.x in f.x;

theorem 
  product {} = {{}};

theorem 
  Funcs(X,Y) = product (X --> Y);

definition
  let x,X;
  func pi(X,x) -> set means


  y in it iff ex f st f in X & y = f.x;
end;

theorem 
  x in dom f & product f <> {} implies pi(product f,x) = f.x;

theorem 
  pi({},x) = {};

theorem 
  pi({g},x) = {g.x};

theorem 
  pi({f,g},x) = {f.x,g.x};

theorem 
  pi(X \/ Y,x) = pi(X,x) \/ pi(Y,x);

theorem 
  pi(X /\ Y,x) c= pi(X,x) /\ pi(Y,x);

theorem 
  pi(X,x) \ pi(Y,x) c= pi(X \ Y,x);

theorem 
  pi(X,x) \+\ pi(Y,x) c= pi(X \+\ Y,x);

theorem 
  card pi(X,x) c= card X;

theorem 
  x in Union disjoin f implies ex y,z st x = [y,z];

theorem 
  x in Union disjoin f iff x`2 in dom f & x`1 in f.(x`2) & x = [x`1,x`2];

theorem 
  f c= g implies disjoin f c= disjoin g;

theorem 
  f c= g implies Union f c= Union g;

theorem 
  Union disjoin (Y --> X) = [:X,Y:];

theorem 
  product f = {} iff {} in rng f;

theorem 
  dom f = dom g & (for x st x in dom f holds f.x c= g.x) implies
  product f c= product g;

reserve F,G for Cardinal-Function;

theorem 
  for x st x in dom F holds card (F.x) = F.x;

theorem 
  for x st x in dom F holds card ((disjoin F).x) = F.x;

definition
  let F;
  func Sum F -> Cardinal equals

  card Union disjoin F;
  func Product F -> Cardinal equals

  card product F;
end;

theorem 
  dom F = dom G & (for x st x in dom F holds F.x c= G.x) implies Sum F c= Sum
  G;

theorem 
  {} in rng F iff Product F = 0;

theorem 
  dom F = dom G & (for x st x in dom F holds F.x c= G.x) implies
  Product F c= Product G;

theorem 
  F c= G implies Sum F c= Sum G;

theorem 
  F c= G & not 0 in rng G implies Product F c= Product G;

theorem 
  Sum({} --> K) = 0;

theorem 
  Product ({} --> K) = 1;

theorem 
  Sum(x .--> K) = K;

theorem 
  Product(x .--> K) = K;

theorem 
  card Union f c= Sum Card f;

theorem 
  card Union F c= Sum F;


theorem 
  dom F = dom G & (for x st x in dom F holds F.x in G.x) implies
  Sum F in Product G;

scheme 
 FuncSeparation { X()->set, F(set)->set, P[set,set] }:
  ex f st dom f = X() &
  for x st x in X() for y holds y in f.x iff y in F(x) & P[x,y];

theorem 
  X is finite implies card X in card omega;

theorem 
  card A in card B implies A in B;

theorem 
  card A in M implies A in M;

theorem 
  X is c=-linear implies
  ex Y st Y c= X & union Y = union X & for Z st Z c= Y & Z <> {}
  ex Z1 st Z1 in Z & for Z2 st Z2 in Z holds Z1 c= Z2;

theorem 
  (for Z st Z in X holds card Z in M) & X is c=-linear implies
  card union X c= M;

begin 



registration
  let f be Function;
  cluster product f -> functional;
end;

registration
  let A be set;
  let B be with_non-empty_elements set;
  cluster -> non-empty for Function of A,B;
end;



registration
  let f be non-empty Function;
  cluster product f -> non empty;
end;



theorem 
  for a,b,c,d being set st a <> b holds
  product (a,b) --> ({c},{d}) = { (a,b) --> (c,d) };



theorem 
  x in product f implies x is Function;

begin 

reserve A,B for set;

definition
  let f be Function;
  func sproduct f -> set means


  x in it iff ex g st x = g & dom g c= dom f &
  for x st x in dom g holds g.x in f.x;
end;

registration
  let f be Function;
  cluster sproduct f -> functional non empty;
end;

theorem 
  g in sproduct f implies dom g c= dom f &
  for x st x in dom g holds g.x in f.x;

theorem 
  {} in sproduct f;

registration let f;
 cluster empty for Element of sproduct f;
end;

theorem 
  product f c= sproduct f;

theorem 
  x in sproduct f implies x is PartFunc of dom f, union rng f;

theorem 
  g in product f & h in sproduct f implies g +* h in product f;

theorem 
  product f <> {} implies
  (g in sproduct f iff ex h st h in product f & g c= h);

theorem 
  sproduct f c= PFuncs(dom f,union rng f);

theorem 
  f c= g implies sproduct f c= sproduct g;

theorem 
  sproduct {} = {{}};

theorem 
  PFuncs(A,B) = sproduct (A --> B);

theorem 
  for A, B being non empty set for f being Function of A,B
  holds sproduct f = sproduct(f|{x where x is Element of A: f.x <> {} });

theorem 
  x in dom f & y in f.x implies x .--> y in sproduct f;

theorem 
  sproduct f = {{}} iff for x st x in dom f holds f.x = {};

theorem 
  A c= sproduct f &
  (for h1,h2 being Function st h1 in A & h2 in A holds h1 tolerates h2)
  implies union A in sproduct f;

theorem 
  g tolerates h & g in sproduct f & h in sproduct f
  implies g \/ h in sproduct f;

theorem 
  x c= h & h in sproduct f implies x in sproduct f;

theorem 
  g in sproduct f implies g|A in sproduct f;

theorem 
  g in sproduct f implies g|A in sproduct f|A;

theorem 
  h in sproduct(f+*g) implies
  ex f9,g9 being Function st f9 in sproduct f & g9 in sproduct g & h = f9+*g9;

theorem 
  for f9,g9 being Function st dom g misses dom f9 \ dom g9 &
  f9 in sproduct f & g9 in sproduct g holds f9+*g9 in sproduct(f+*g);

theorem 
  for f9,g9 being Function st dom f9 misses dom g \ dom g9 &
  f9 in sproduct f & g9 in sproduct g holds f9+*g9 in sproduct(f+*g);

theorem 
  g in sproduct f & h in sproduct f implies g +* h in sproduct f;

theorem 
  for x1,x2,y1,y2 being set holds
  x1 in dom f & y1 in f.x1 & x2 in dom f & y2 in f.x2
  implies (x1,x2)-->(y1,y2) in sproduct f;

begin  

definition
  let IT be set;
  attr IT is with_common_domain means


  for f,g be Function st f in IT & g in IT holds dom f = dom g;
end;

registration
  cluster with_common_domain functional non empty for set;
end;

registration
  let f;
  cluster {f} -> with_common_domain;
end;

definition
  let X be functional set;
  func DOM X -> set equals

 meet { dom f where f is Element of X: not contradiction };
end;

theorem 
  for X be with_common_domain functional set st X = {{}} holds DOM X = {};

registration let X be empty set;
 cluster DOM X -> empty;
end;

begin  

definition
  let S be functional set;
  func product" S -> Function means

    dom it = DOM S &
  for i being set st i in dom it holds it.i = pi(S,i);
end;

canceled;

theorem 
  for S being non empty functional set,
  i being set st i in dom product" S holds
  (product" S).i = {f.i where f is Element of S: not contradiction};

definition
  let S be set;
  attr S is product-like means


  ex f being Function st S = product f;
end;

registration
  let f be Function;
  cluster product f -> product-like;
end;

registration
  cluster product-like -> functional with_common_domain for set;
end;

registration
  cluster product-like non empty for set;
end;

canceled 2;

theorem 
  for S being functional with_common_domain set holds S c= product product" S;

theorem 
  for S being non empty product-like set holds S = product product" S;



theorem 
  for f being Function
  for s, t being Element of product f, A be set holds
  s +* t|A is Element of product f;

theorem 
  for f being non-empty Function
  for p being Element of sproduct f
  ex s being Element of product f st p c= s;

theorem 
  g in product f implies g|A in sproduct f;



definition
  let f be non-empty Function;
  let g be Element of product f;
  let X;
  redefine func g|X -> Element of sproduct f;
end;

theorem 
  for f being non-empty Function
  for s,ss being Element of product f, A being set
  holds (ss +* s | A) | A = s | A;



theorem 
  for M,x, g being Function st x in product M holds x * g in product (M * g);



theorem 
  X is finite iff card X in omega;

reserve A,B for Ordinal;

theorem 
  A is infinite iff omega c= A;

theorem 
  N is finite & not M is finite implies N in M & N c= M;

theorem 
  not X is finite iff ex Y st Y c= X & card Y = omega;

theorem 
  card X = card Y iff nextcard X = nextcard Y;

theorem 
  nextcard N = nextcard M implies M = N;

theorem 
  N in M iff nextcard N c= M;

theorem 
  N in nextcard M iff N c= M;

theorem 
  M is finite & (N c= M or N in M) implies N is finite;

reserve n,k for Nat;

definition
  let X;
  attr X is countable means


  card X c= omega;
  attr X is denumerable means

  card X = omega;
end;

registration
  cluster denumerable -> countable infinite for set;
  cluster countable infinite -> denumerable for set;
end;

registration
  cluster finite -> countable for set;
end;

registration
  cluster omega -> denumerable;
end;

registration
  cluster denumerable for set;
end;

theorem 
  X is countable iff ex f st dom f = omega & X c= rng f;

registration
  let X be countable set;
  cluster -> countable for Subset of X;
end;

theorem 
  X is countable implies X /\ Y is countable;

theorem 
  X is countable implies X \ Y is countable;

theorem 
  for A being non empty countable set
  ex f being Function of omega, A st rng f = A;



theorem 
  for f,g being non-empty Function, x being Element of product f,
  y being Element of product g holds x+*y in product (f+*g);

theorem 
  for f,g being non-empty Function
  for x being Element of product (f+*g) holds x|dom g in product g;

theorem 
  for f,g being non-empty Function st f tolerates g
  for x being Element of product (f+*g) holds x|dom f in product f;



theorem 
  for S being with_common_domain functional set, f be Function
     st f in S  holds dom f = dom product" S;

theorem 
  for S being functional set, f be Function, i be set
     st f in S & i in dom product" S holds f.i in (product" S).i;

theorem 
  for S being with_common_domain functional set, f be Function, i be set
     st f in S & i in dom f holds f.i in (product" S).i;



registration let X be with_common_domain set;
 cluster -> with_common_domain for Subset of X;
end;



definition
  let f be Function, x be set;
  func proj(f,x) -> Function means


  dom it = product f & for y being
  Function st y in dom it holds it.y = y.x;
end;

registration
  let f be Function, x be set;
  cluster proj(f,x) -> (product f)-defined;
end;

registration
  let f be Function, x be set;
  cluster proj(f,x) -> total;
end;

registration
  let f be non-empty Function;
  cluster -> f-compatible for Element of product f;
end;

registration
  let I be set; let f be I-defined non-empty Function;
  cluster -> I-defined for Element of product f;
end;

registration
  let f be Function;
  cluster -> f-compatible for Element of sproduct f;
end;

registration
  let I be set; let f be I-defined Function;
  cluster -> I-defined for Element of sproduct f;
end;

registration
  let I be set; let f be total I-defined non-empty Function;
  cluster -> total for Element of product f;
end;

theorem 
 for I being set, f being non-empty I-defined Function
 for p being f-compatible I-defined Function
  holds p in sproduct f;

theorem 
 for I being set, f being non-empty I-defined Function
 for p being f-compatible I-defined Function
  ex s being Element of product f st p c= s;



registration
  let X be infinite set, a be set;
  cluster X --> a -> infinite;
end;

registration
  cluster infinite for Function;
end;

registration
  let R be infinite Relation;
  cluster field R -> infinite;
end;

registration
  let X be infinite set;
  cluster RelIncl X -> infinite;
end;

theorem 
for R,S being Relation st R,S are_isomorphic & R is finite
 holds S is finite;

theorem 
 product" {{}} = {};

theorem 
 for I being set, f being non-empty ManySortedSet of I
 for s being f-compatible ManySortedSet of I
  holds s in product f;

registration
 let I be set, f be non-empty ManySortedSet of I;
 cluster -> total for Element of product f;
end;

definition
 let I be set, f be non-empty ManySortedSet of I;
 let M be f-compatible ManySortedSet of I;
 func down M -> Element of product f equals

M;
end;

theorem 
 for X being functional with_common_domain set
   for f being Function st f in X holds dom f = DOM X;

theorem 
 for X being non empty functional set
  st for f being Function st f in X holds x in dom f
  holds x in DOM X;
















begin

reserve x,y,y1,y2,z,a,b,X,Y,Z,V1,V2 for set,
  f,g,h,h9,f1,f2 for Function,
  i for Nat,
  P for Permutation of X,
  D,D1,D2,D3 for non empty set,
  d1 for Element of D1,
  d2 for Element of D2,
  d3 for Element of D3;

theorem 
  product f c= Funcs(dom f, Union f);

begin

theorem 
  x in dom ~f implies ex y,z st x = [y,z];

theorem 
  ~([:X,Y:] --> z) = [:Y,X:] --> z;

theorem 
  curry f = curry' ~f & uncurry f = ~uncurry' f;

theorem 
  [:X,Y:] <> {} implies curry ([:X,Y:] --> z) = X --> (Y --> z) & curry'
  ([:X,Y:] --> z) = Y --> (X --> z);

theorem 
  uncurry (X --> (Y --> z)) = [:X,Y:] --> z & uncurry' (X --> (Y --> z))
  = [:Y,X:] --> z;

theorem 
  x in dom f & g = f.x implies rng g c= rng uncurry f & rng g c= rng uncurry' f
;

theorem 
  dom uncurry (X --> f) = [:X,dom f:] & rng uncurry (X --> f) c=
rng f & dom uncurry' (X --> f) = [:dom f,X:] & rng uncurry' (X --> f) c= rng f;

theorem 
  X <> {} implies rng uncurry (X --> f) = rng f & rng uncurry' (X --> f)
  = rng f;

theorem 
  [:X,Y:] <> {} & f in Funcs([:X,Y:],Z) implies curry f in Funcs(X
  ,Funcs(Y,Z)) & curry' f in Funcs(Y,Funcs(X,Z));

theorem 
  f in Funcs(X,Funcs(Y,Z)) implies uncurry f in Funcs([:X,Y:],Z) &
  uncurry' f in Funcs([:Y,X:],Z);

theorem 
  (curry f in Funcs(X,Funcs(Y,Z)) or curry' f in Funcs(Y,Funcs(X,Z))) &
  dom f c= [:V1,V2:] implies f in Funcs([:X,Y:],Z);

theorem 
  (uncurry f in Funcs([:X,Y:],Z) or uncurry' f in Funcs([:Y,X:],Z)) &
  rng f c= PFuncs(V1,V2) & dom f = X implies f in Funcs(X,Funcs(Y,Z));

theorem 
  f in PFuncs([:X,Y:],Z) implies curry f in PFuncs(X,PFuncs(Y,Z)) &
  curry' f in PFuncs(Y,PFuncs(X,Z));

theorem 
  f in PFuncs(X,PFuncs(Y,Z)) implies uncurry f in PFuncs([:X,Y:],Z
  ) & uncurry' f in PFuncs([:Y,X:],Z);

theorem 
  (curry f in PFuncs(X,PFuncs(Y,Z)) or curry' f in PFuncs(Y,PFuncs(X,Z))
  ) & dom f c= [:V1,V2:] implies f in PFuncs([:X,Y:],Z);

theorem 
  (uncurry f in PFuncs([:X,Y:],Z) or uncurry' f in PFuncs([:Y,X:],Z)) &
  rng f c= PFuncs(V1,V2) & dom f c= X implies f in PFuncs(X,PFuncs(Y,Z));

begin

definition
  let X be set;
  func SubFuncs X means


  x in it iff x in X & x is Function;
end;

theorem 
  SubFuncs X c= X;

theorem 
  x in f"SubFuncs rng f iff x in dom f & f.x is Function;

theorem 
  SubFuncs {} = {} & SubFuncs {f} = {f} & SubFuncs {f,g} = {f,g} &
  SubFuncs {f,g,h} = {f,g,h};

theorem 
  Y c= SubFuncs X implies SubFuncs Y = Y;

definition
  let f be Function;
  func doms f -> Function means


  dom it = f"SubFuncs rng f & for x st x
  in f"SubFuncs rng f holds it.x = proj1 (f.x);
  func rngs f -> Function means


  dom it = f"SubFuncs rng f & for x st x
  in f"SubFuncs rng f holds it.x = proj2 (f.x);
  func meet f equals

  meet rng f;
end;

theorem 
  x in dom f & g = f.x implies x in dom doms f & (doms f).x = dom
  g & x in dom rngs f & (rngs f).x = rng g;

theorem 
  doms {} = {} & rngs {} = {};

theorem 
  doms (X --> f) = X --> dom f & rngs (X --> f) = X --> rng f;

theorem 
  f <> {} implies (x in meet f iff for y st y in dom f holds x in f.y);

theorem 
  Union ({} --> Y) = {} & meet ({} --> Y) = {};

theorem 
  X <> {} implies Union (X --> Y) = Y & meet (X --> Y) = Y;

definition
  let f be Function, x, y be set;
  func f..(x,y) -> set equals

  (uncurry f).(x,y);
end;

theorem 
  x in X & y in dom f implies (X --> f)..(x,y) = f.y;

begin

definition
  let f be Function;
  func <:f:> -> Function equals

  curry ((uncurry' f)|([:meet doms f, dom f:]
  qua set));
end;

theorem 
  dom <:f:> = meet doms f & rng <:f:> c= product rngs f;

theorem 
  x in dom <:f:> implies <:f:>.x is Function;

theorem 
  x in dom <:f:> & g = <:f:>.x implies dom g = f"SubFuncs rng f &
  for y st y in dom g holds [y,x] in dom uncurry f & g.y = (uncurry f).(y,x);

theorem 
  x in dom <:f:> implies for g st g in rng f holds x in dom g;

theorem 
  g in rng f & (for g st g in rng f holds x in dom g) implies x in dom <:f :>;

theorem 
  x in dom f & g = f.x & y in dom <:f:> & h = <:f:>.y implies g.y = h.x;

theorem 
  x in dom f & f.x is Function & y in dom <:f:> implies f..(x,y) = <:f:>
  ..( y, x );

definition
  let f be Function;
  func Frege f -> Function means


  dom it = product doms f & for g st g
  in product doms f ex h st it.g = h & dom h = f"SubFuncs rng f & for x st x in
  dom h holds h.x = (uncurry f).(x,g.x);
end;

theorem 
  g in product doms f & x in dom g implies (Frege f)..(g,x) = f..(x,g.x);

theorem 
  x in dom f & g = f.x & h in product doms f & h9 = (Frege f).h
  implies h.x in dom g & h9.x = g.(h.x) & h9 in product rngs f;

theorem 
  rng Frege f = product rngs f;

theorem 
  not {} in rng f implies (Frege f is one-to-one iff for g st g in
  rng f holds g is one-to-one);

begin

theorem 
  <:{}:> = {} & Frege{} = {} .--> {};

theorem 
  X <> {} implies dom <:X --> f:> = dom f & for x st x in dom f holds <:
  X --> f:>.x = X --> f.x;

theorem 
  dom Frege(X-->f) = Funcs(X,dom f) & rng Frege(X-->f) = Funcs(X,rng f)
  & for g st g in Funcs(X,dom f) holds (Frege(X-->f)).g = f*g;

theorem 
  dom f = X & dom g = X & (for x st x in X holds f.x,g.x
  are_equipotent) implies product f,product g are_equipotent;

theorem 
  dom f = dom h & dom g = rng h & h is one-to-one & (for x st x in
  dom h holds f.x, g.(h.x) are_equipotent) implies product f,product g
  are_equipotent;

theorem 
  dom f = X implies product f,product (f*P) are_equipotent;

begin

definition
  let f,X;
  func Funcs(f,X) -> Function means


  dom it = dom f & for x st x in dom f holds it.x = Funcs(f.x,X);
end;

theorem 
  not {} in rng f implies Funcs(f,{}) = dom f --> {};

theorem 
  Funcs({},X) = {};

theorem 
  Funcs(X --> Y, Z) = X --> Funcs(Y,Z);

theorem 
  Funcs(Union disjoin f,X),product Funcs(f,X) are_equipotent;

definition
  let X,f;
  func Funcs(X,f) -> Function means


  dom it = dom f & for x st x in dom f holds it.x = Funcs(X,f.x);
end;

theorem 
  Funcs({},f) = dom f --> {{}};

theorem 
  Funcs(X,{}) = {};

theorem 
  Funcs(X, Y --> Z) = Y --> Funcs(X,Z);

theorem 
  product Funcs(X,f),Funcs(X, product f) are_equipotent;

begin 


definition
  let f be Function;

  func commute f -> Function-yielding Function equals

  curry' uncurry f;
end;

theorem 
  for f be Function, x be set st x in dom (commute f) holds (commute f).
  x is Function;

theorem 
  for A,B,C be set, f be Function st A <> {} & B <> {} & f in
  Funcs(A,Funcs(B,C)) holds commute f in Funcs(B,Funcs(A,C));

theorem 
  for A,B,C be set, f be Function st A <> {} & B <> {} & f in Funcs(A,
  Funcs(B,C)) for g,h be Function, x,y be set st x in A & y in B & f.x = g & (
  commute f).y = h holds h.x = g.y & dom h = A & dom g = B & rng h c= C & rng g
  c= C;

theorem 
  for A,B,C be set, f be Function st A <> {} & B <> {} & f in Funcs(A,
  Funcs(B,C)) holds commute commute f = f;

theorem 
  commute {} = {};



theorem 
  for f be Function-yielding Function holds dom doms f = dom f;

theorem 
  for f be Function-yielding Function holds dom rngs f = dom f;















begin 

reserve A,B,C for Ordinal;

definition
  func one equals

  1;
end;

begin 

definition
  let a,b be Ordinal;
  pred a,b are_relative_prime means


  for c,d1,d2 being Ordinal st a = c *^ d1 & b = c *^ d2 holds c = 1;
  symmetry;
end;

theorem 
  not {},{} are_relative_prime;

theorem 
  1,A are_relative_prime;

theorem 
  {},A are_relative_prime implies A = 1;

reserve a,b,c,d for natural Ordinal;

theorem 
  a <> {} or b <> {} implies ex c,d1,d2 being natural Ordinal st d1,d2
  are_relative_prime & a = c *^ d1 & b = c *^ d2;

reserve l,m,n for natural Ordinal;

registration
  let m,n;
  cluster m div^ n -> natural;
  cluster m mod^ n -> natural;
end;

definition
  let k,n be Ordinal;
  pred k divides n means


  ex a being Ordinal st n = k*^a;
  reflexivity;
end;

theorem 
  a divides b iff ex c st b = a*^c;

theorem 
  for m,n st {} in m holds n mod^ m in m;

theorem 
  for n,m holds m divides n iff n = m *^ (n div^ m);

theorem 
  for n,m st n divides m & m divides n holds n = m;

theorem 
  n divides {} & 1 divides n;

theorem 
  for n,m st {} in m & n divides m holds n c= m;

theorem 
  for n,m,l st n divides m & n divides m +^ l holds n divides l;

definition
  let k,n be natural Ordinal;
  func k lcm n -> Element of omega means


  k divides it & n divides it &
  for m st k divides m & n divides m holds it divides m;
  commutativity;
end;

theorem 
  m lcm n divides m*^n;

theorem 
  n <> {} implies (m*^n) div^ (m lcm n) divides m;

definition
  let k,n be natural Ordinal;
  func k hcf n -> Element of omega means


  it divides k & it divides n &
  for m st m divides k & m divides n holds m divides it;
  commutativity;
end;

theorem 
  a hcf {} = a & a lcm {} = {};

theorem 
  a hcf b = {} implies a = {};

theorem 
  a hcf a = a & a lcm a = a;

theorem 
  (a*^c) hcf (b*^c) = (a hcf b)*^c;

theorem 
  b <> {} implies a hcf b <> {} & b div^ (a hcf b) <> {};

theorem 
  a <> {} or b <> {} implies a div^ (a hcf b), b div^ (a hcf b)
  are_relative_prime;

theorem 
  a,b are_relative_prime iff a hcf b = 1;

definition
  let a,b be natural Ordinal;
  func RED(a,b) -> Element of omega equals

  a div^ (a hcf b);
end;

theorem 
  RED(a,b)*^(a hcf b) = a;

theorem 
  a <> {} or b <> {} implies RED(a,b), RED(b,a) are_relative_prime;

theorem 
  a,b are_relative_prime implies RED(a,b) = a;

theorem 
  RED(a,1) = a & RED(1,a) = 1;

theorem 
  b <> {} implies RED(b,a) <> {};

theorem 
  RED({},a) = {} & (a <> {} implies RED(a,{}) = 1);

theorem 
  a <> {} implies RED(a,a) = 1;

theorem 
  c <> {} implies RED(a*^c, b*^c) = RED(a, b);

begin 

reserve i,j,k for Element of omega;

definition
  func RAT+ equals

  ({[i,j]: i,j are_relative_prime & j <> {}} \ {[k,1]: not
  contradiction}) \/ omega;
end;

reserve x,y,z for Element of RAT+;

registration
  cluster RAT+ -> non empty;
end;

registration
  cluster non empty ordinal for Element of RAT+;
end;

theorem 
  x in omega or ex i,j st x = [i,j] & i,j are_relative_prime & j <> {} & j <> 1
;

theorem 
  not ex i,j being set st [i,j] is Ordinal;

theorem 
  A in RAT+ implies A in omega;

registration
  cluster -> natural for ordinal Element of RAT+;
end;

theorem 
  not ex i,j being set st [i,j] in omega;

theorem 
  [i,j] in RAT+ iff i,j are_relative_prime & j <> {} & j <> 1;

definition
  let x be Element of RAT+;
  func numerator x -> Element of omega means


  it = x if x in omega otherwise ex a st x = [it,a];
  func denominator x -> Element of omega means


  it = 1 if x in omega otherwise ex a st x = [a,it];
end;

theorem 
  numerator x, denominator x are_relative_prime;

theorem 
  denominator x <> {};

theorem 
  not x in omega implies x = [numerator x, denominator x] & denominator x <> 1;

theorem 
  x <> {} iff numerator x <> {};

theorem 
  x in omega iff denominator x = 1;

definition
  let i,j be natural Ordinal;
  func i/j -> Element of RAT+ equals


  {} if j = {}, RED(i,j) if RED(j,i
  ) = 1 otherwise [RED(i,j), RED(j,i)];
end;

notation
  let i,j be natural Ordinal;
  synonym quotient(i,j) for i/j;
end;

theorem 
  (numerator x)/(denominator x) = x;

theorem 
  {}/b = {} & a/1 = a;

theorem 
  a <> {} implies a/a = 1;

theorem 
  b <> {} implies numerator (a/b) = RED(a,b) & denominator (a/b) = RED(b,a);

theorem 
  i,j are_relative_prime & j <> {} implies numerator (i/j) = i &
  denominator (i/j) = j;

theorem 
  c <> {} implies (a*^c)/(b*^c) = a/b;

reserve i,j,k for natural Ordinal;

theorem 
  j <> {} & l <> {} implies (i/j = k/l iff i*^l = j*^k);

definition
  let x,y be Element of RAT+;
  func x+y -> Element of RAT+ equals

  ((numerator x)*^(denominator y)+^(
  numerator y)*^(denominator x)) / ((denominator x)*^(denominator y));
  commutativity;
  func x*'y -> Element of RAT+ equals

  ((numerator x)*^(numerator y)) / ((
  denominator x)*^(denominator y));
  commutativity;
end;

theorem 
  j <> {} & l <> {} implies (i/j)+(k/l) = (i*^l+^j*^k)/(j*^l);

theorem 
  k <> {} implies (i/k)+(j/k) = (i+^j)/k;

registration
  cluster empty for Element of RAT+;
end;

definition
  redefine func {} -> Element of RAT+;
  redefine func one -> non empty ordinal Element of RAT+;
end;

theorem 
  x*'{} = {};

theorem 
  (i/j)*'(k/l) = (i*^k)/(j*^l);

theorem 
  x+{} = x;

theorem 
  (x+y)+z = x+(y+z);

theorem 
  (x*'y)*'z = x*'(y*'z);

theorem 
  x*'one = x;

theorem 
  x <> {} implies ex y st x*'y = 1;

theorem 
  x <> {} implies ex z st y = x*'z;

theorem 
  x <> {} & x*'y = x*'z implies y = z;

theorem 
  x*'(y+z) = x*'y+x*'z;

theorem 
  for i,j being ordinal Element of RAT+ holds i+j = i+^j;

theorem 
  for i,j being ordinal Element of RAT+ holds i*'j = i*^j;

theorem 
  ex y st x = y+y;

definition
  let x,y be Element of RAT+;
  pred x <=' y means


  ex z being Element of RAT+ st y = x+z;
  connectedness;
end;

notation
  let x,y be Element of RAT+;
  antonym y < x for x <=' y;
end;

reserve r,s,t for Element of RAT+;

theorem 
  not ex y being set st [{},y] in RAT+;

theorem 
  s + t = r + t implies s = r;

theorem 
  r+s = {} implies r = {};

theorem 
  {} <=' s;

theorem 
  s <=' {} implies s = {};

theorem 
  r <=' s & s <=' r implies r = s;

theorem 
  r <=' s & s <=' t implies r <=' t;

theorem 
  r < s iff r <=' s & r <> s;

theorem 
  r < s & s <=' t or r <=' s & s < t implies r < t;

theorem 
  r < s & s < t implies r < t;

theorem 
  x in omega & x+y in omega implies y in omega;

theorem 
  for i being ordinal Element of RAT+ st i < x & x < i+one holds not x in omega
;

theorem 
  t <> {} implies ex r st r < t & not r in omega;

theorem 
  {s: s < t} in RAT+ iff t = {};

theorem 
  for A being Subset of RAT+ st (ex t st t in A & t <> {}) & for r,s st
r in A & s <=' r holds s in A ex r1,r2,r3 being Element of RAT+ st r1 in A & r2
  in A & r3 in A & r1 <> r2 & r2 <> r3 & r3 <> r1;

theorem 
  s + t <=' r + t iff s <=' r;

theorem 
  s <=' s + t;

theorem 
  r*'s = {} implies r = {} or s = {};

theorem 
  r <=' s *' t implies ex t0 being Element of RAT+ st r = s *' t0 & t0 <=' t;

theorem 
  t <> {} & s *' t <=' r *' t implies s <=' r;

theorem 
  for r1,r2,s1,s2 being Element of RAT+ st r1+r2 = s1+s2 holds r1 <=' s1
  or r2 <=' s2;

theorem 
  s <=' r implies s *' t <=' r *' t;

theorem 
  for r1,r2,s1,s2 being Element of RAT+ st r1*'r2 = s1*'s2 holds r1 <='
  s1 or r2 <=' s2;

theorem 
  r = {} iff r + s = s;

theorem 
  for s1,t1,s2,t2 being Element of RAT+ st s1 + t1 = s2 + t2 & s1 <=' s2
  holds t2 <=' t1;

theorem 
  r <=' s & s <=' r + t implies ex t0 being Element of RAT+ st s =
  r + t0 & t0 <=' t;

theorem 
  r <=' s + t implies ex s0,t0 being Element of RAT+ st r = s0 + t0 & s0
  <=' s & t0 <=' t;

theorem 
  r < s & r < t implies ex t0 being Element of RAT+ st t0 <=' s & t0 <='
  t & r < t0;

theorem 
  r <=' s & s <=' t & s <> t implies r <> t;

theorem 
  s < r + t & t <> {} implies ex r0,t0 being Element of RAT+ st s = r0 +
  t0 & r0 <=' r & t0 <=' t & t0 <> t;

theorem 
  for A being non empty Subset of RAT+ st A in RAT+ ex s st s in A & for
  r st r in A holds r <=' s;

theorem 
  ex t st r + t = s or s + t = r;

theorem 
  r < s implies ex t st r < t & t < s;

theorem 
  ex s st r < s;

theorem 
  t <> {} implies ex s st s in omega & r <=' s *' t;

scheme 

  DisNat { n0,n1,n2() -> Element of RAT+, P[set] }: ex s st s in omega & P[s]
  & not P[s + n1()]
provided
 n1() = 1 and
 n0() = {} and
 n2() in omega and
 P[n0()] and
 not P[n2()];














begin

reserve r,s,t,x9,y9,z9,p,q for Element of RAT+;

definition
  func DEDEKIND_CUTS -> Subset-Family of RAT+ equals

  { A where A is Subset of
RAT+: r in A implies (for s st s <=' r holds s in A) & ex s st s in A & r < s }
  \ { RAT+};
end;

registration
  cluster DEDEKIND_CUTS -> non empty;
end;

definition
  func REAL+ equals

  RAT+ \/ DEDEKIND_CUTS \ {{ s: s < t}: t <> {}};
end;

reserve x,y,z for Element of REAL+;

theorem 
  RAT+ c= REAL+;

theorem 
  omega c= REAL+;

registration
  cluster REAL+ -> non empty;
end;

definition
  let x;
  func DEDEKIND_CUT x -> Element of DEDEKIND_CUTS means


  ex r st x = r & it = { s : s < r } if x in RAT+ otherwise it = x;
end;

theorem 
  not ex y being set st [{},y] in REAL+;

definition
  let x be Element of DEDEKIND_CUTS;
  func GLUED x -> Element of REAL+ means


  ex r st it = r & for s holds s
  in x iff s < r if ex r st for s holds s in x iff s < r otherwise it = x;
end;

definition
  let x,y be Element of REAL+;
  pred x <=' y means


  ex x9,y9 st x = x9 & y = y9 & x9 <=' y9 if x in
  RAT+ & y in RAT+, x in y if x in RAT+ & not y in RAT+, not y in x if not x in
  RAT+ & y in RAT+ otherwise x c= y;
  connectedness;
end;

notation
  let x,y be Element of REAL+;
  antonym y < x for x <=' y;
end;

definition
  let A,B be Element of DEDEKIND_CUTS;
  func A + B -> Element of DEDEKIND_CUTS equals


  { r + s : r in A & s in
  B};
  commutativity;
end;

definition
  let A,B be Element of DEDEKIND_CUTS;
  func A *' B -> Element of DEDEKIND_CUTS equals

  { r *' s : r in A & s in B};
  commutativity;
end;

definition
  let x,y be Element of REAL+;
  func x + y -> Element of REAL+ equals


  x if y = {}, y if x = {}
  otherwise GLUED(DEDEKIND_CUT x + DEDEKIND_CUT y);
  commutativity;
  func x *' y -> Element of REAL+ equals

  GLUED(DEDEKIND_CUT x *' DEDEKIND_CUT
  y);
  commutativity;
end;

theorem 
  x = {} implies x *' y = {};

theorem 
  x + y = {} implies x = {};

theorem 
  x + (y + z) = (x + y) + z;

theorem 
  { A where A is Subset of RAT+: r in A implies (for s st s <=' r holds
  s in A) & ex s st s in A & r < s} is c=-linear;

theorem 
  for X,Y being Subset of REAL+ st (ex x st x in Y) & for x,y st x in X
& y in Y holds x <=' y ex z st for x,y st x in X & y in Y holds x <=' z & z <='
  y;

theorem 
  x <=' y implies ex z st x + z = y;

theorem 
  ex z st x + z = y or y + z = x;

theorem 
  x + y = x + z implies y = z;

theorem 
  x *' (y *' z) = x *' y *' z;

theorem 
  x *' (y + z) = (x *' y) + (x *' z);

theorem 
  x <> {} implies ex y st x *' y = one;

theorem 
  x = one implies x *' y = y;

theorem 
  x in omega & y in omega implies y + x in omega;

theorem 
  for A being Subset of REAL+ st {} in A & for x,y st x in A & y = one
  holds x + y in A holds omega c= A;

theorem 
  for x st x in omega holds for y holds y in x iff y in omega & y <> x &
  y <=' x;

theorem 
  x = y + z implies z <=' x;

theorem 
  {} in REAL+ & one in REAL+;

theorem 
  x in RAT+ & y in RAT+ implies ex x9,y9 st x = x9 & y = y9 & x *' y = x9 *' y9
;














begin

reserve x,y,z for Element of REAL+;

theorem 
  x + y = y implies x = {};

theorem 
  x *' y = {} implies x = {} or y = {};

theorem 
  x <=' y & y <=' z implies x <=' z;

theorem 
  x <=' y & y <=' x implies x = y;

theorem 
  x <=' y & y = {} implies x = {};

theorem 
  x = {} implies x <=' y;

theorem 
  x <=' y iff x + z <=' y + z;

theorem 
  x <=' y implies x *' z <=' y *' z;

definition
  let x,y be Element of REAL+;
  func x -' y -> Element of REAL+ means


  it + y = x if y <=' x otherwise it = {};
end;

theorem 
  x <=' y or x -' y <> {};

theorem 
  x <=' y & y -' x = {} implies x = y;

theorem 
  x -' y <=' x;

theorem 
  y <=' x & y <=' z implies x + (z -' y) = x -' y + z;

theorem 
  z <=' y implies x + (y -' z) = x + y -' z;

theorem 
  z <=' x & y <=' z implies x -' z + y = x -' (z -' y);

theorem 
  y <=' x & y <=' z implies z -' y + x = x -' y + z;

theorem 
  x <=' y implies z -' y <=' z -' x;

theorem 
  x <=' y implies x -' z <=' y -' z;

definition
  let x,y be Element of REAL+;
  func x - y equals


  x -' y if y <=' x otherwise [{},y -' x];
end;

theorem 
  x - x = {};

theorem 
  x = {} & y <> {} implies x - y = [{},y];

theorem 
  z <=' y implies x + (y -' z) = x + y - z;

theorem 
  not z <=' y implies x - (z -' y) = x + y - z;

theorem 
  y <=' x & not y <=' z implies x - (y -' z) = x -' y + z;

theorem 
  not y <=' x & not y <=' z implies x - (y -' z) = z - (y -' x);

theorem 
  y <=' x implies x - (y + z) = x -' y - z;

theorem 
  x <=' y & z <=' y implies y -' z - x = y -' x - z;

theorem 
  z <=' y implies x *' (y -' z) = (x *' y) - (x *' z);

theorem 
  not z <=' y & x <> {} implies [{},x *' (z -' y)] = (x *' y) - (x *' z);

theorem 
  y -' z <> {} & z <=' y & x <> {} implies (x *' z) - (x *' y) = [{},x
  *' (y -' z)];














begin

notation
  synonym NAT for omega;
  synonym 0 for {};
end;

definition
  func REAL equals

  REAL+ \/ [:{0},REAL+:] \ {[0,0]};
end;

registration
  cluster REAL -> non empty;
end;

definition
  func COMPLEX equals

  Funcs({0,1},REAL) \ { x where x is Element of Funcs({0,1
  },REAL): x.1 = 0} \/ REAL;
  func RAT equals

  RAT+ \/ [:{0},RAT+:] \ {[0,0]};
  func INT equals

  NAT \/ [:{0},NAT:] \ {[0,0]};
  redefine func NAT -> Subset of REAL;
end;

registration
  cluster COMPLEX -> non empty;
  cluster RAT -> non empty;
  cluster INT -> non empty;
end;

reserve i,j,k for Element of NAT;
reserve a,b for Element of REAL;

definition
  redefine func 0 -> Element of NAT;
end;

theorem 
  REAL c< COMPLEX;

reserve r,s,t for Element of RAT+;
reserve i,j,k for Element of omega;

theorem 
  RAT c< REAL;

theorem 
  RAT c< COMPLEX;

theorem 
  INT c< RAT;

theorem 
  INT c< REAL;

theorem 
  INT c< COMPLEX;

theorem 
  NAT c< INT;

theorem 
  NAT c< RAT;

theorem 
  NAT c< REAL;

theorem 
  NAT c< COMPLEX;

begin 

theorem 
  REAL c= COMPLEX;

theorem 
  RAT c= REAL;

theorem 
  RAT c= COMPLEX;

theorem 
  INT c= RAT;

theorem 
  INT c= REAL;

theorem 
  INT c= COMPLEX;

theorem 
  NAT c= INT;

theorem 
  NAT c= RAT;

theorem 
  NAT c= REAL;

theorem 
  NAT c= COMPLEX;

theorem 
  REAL <> COMPLEX;

theorem 
  RAT <> REAL;

theorem 
  RAT <> COMPLEX;

theorem 
  INT <> RAT;

theorem 
  INT <> REAL;

theorem 
  INT <> COMPLEX;

theorem 
  NAT <> INT;

theorem 
  NAT <> RAT;

theorem 
  NAT <> REAL;

theorem 
  NAT <> COMPLEX;

definition
  func ExtREAL equals

  REAL \/ { REAL, [0,REAL] };
end;

registration
  cluster ExtREAL -> non empty;
end;

theorem 
  REAL c= ExtREAL;

theorem 
  REAL <> ExtREAL;

theorem 
  REAL c< ExtREAL;

registration
  cluster INT -> infinite;
  cluster RAT -> infinite;
  cluster REAL -> infinite;
  cluster COMPLEX -> infinite;
end;














begin

theorem 
  REAL+ c= REAL;

theorem 
  for x being Element of REAL+ st x <> {} holds [{},x] in REAL;

theorem 
  for y being set st [{},y] in REAL holds y <> {};

theorem 
  for x,y being Element of REAL+ holds x - y in REAL;

theorem 
  REAL+ misses [:{{}},REAL+:];

begin  

theorem 
  for x,y being Element of REAL+ st x - y = {} holds x = y;

theorem 
  for x,y,z being Element of REAL+ st x <> {} & x *' y = x *' z holds y = z;

begin 

definition
  let x,y be Element of REAL;

  func +(x,y) -> Element of REAL means


  ex x9,y9 being Element of REAL+
  st x = x9 & y = y9 & it = x9 + y9 if x in REAL+ & y in REAL+, ex x9,y9 being
Element of REAL+ st x = x9 & y = [0,y9] & it = x9 - y9 if x in REAL+ & y in [:{
0},REAL+:], ex x9,y9 being Element of REAL+ st x = [0,x9] & y = y9 & it = y9 -
x9 if y in REAL+ & x in [:{0},REAL+:] otherwise ex x9,y9 being Element of REAL+
  st x = [0,x9] & y = [0,y9] & it = [0,x9+y9];
  commutativity;
  func *(x,y) -> Element of REAL means


  ex x9,y9 being Element of REAL+
  st x = x9 & y = y9 & it = x9 *' y9 if x in REAL+ & y in REAL+, ex x9,y9 being
  Element of REAL+ st x = x9 & y = [0,y9] & it = [0,x9 *' y9] if x in REAL+ & y
in [:{0},REAL+:] & x <> 0, ex x9,y9 being Element of REAL+ st x = [0,x9] & y =
  y9 & it = [0,y9 *' x9] if y in REAL+ & x in [:{0},REAL+:] & y <> 0, ex x9,y9
being Element of REAL+ st x = [0,x9] & y = [0,y9] & it = y9 *' x9 if x in [:{0}
  ,REAL+:] & y in [:{0},REAL+:] otherwise it = 0;
  commutativity;
end;

reserve x,y for Element of REAL;

definition
  let x be Element of REAL;
  func opp x -> Element of REAL means


  +(x,it) = 0;
  involutiveness;
  func inv x -> Element of REAL means


  *(x,it) = 1 if x <> 0 otherwise it = 0;
  involutiveness;
end;

begin

reserve i,j,k for Element of NAT;
reserve a,b for Element of REAL;

theorem 
  not (0,1)-->(a,b) in REAL;

definition
  let x,y be Element of REAL;

  func [*x,y*] -> Element of COMPLEX equals


  x if y = 0 otherwise (0,1)
  --> (x,y);
end;

theorem 
  for c being Element of COMPLEX ex r,s being Element of REAL st c = [*r ,s*];

theorem 
  for x1,x2,y1,y2 being Element of REAL st [*x1,x2*] = [*y1,y2*] holds
  x1 = y1 & x2 = y2;

theorem 
  for x,o being Element of REAL st o = 0 holds +(x,o) = x;

theorem 
  for x,o being Element of REAL st o = 0 holds *(x,o) = 0;

theorem 
  for x,y,z being Element of REAL holds *(x,*(y,z)) = *(*(x,y),z);

theorem 
  for x,y,z being Element of REAL holds *(x,+(y,z)) = +(*(x,y),*(x ,z));

theorem 
  for x,y being Element of REAL holds *(opp x,y) = opp *(x,y);

theorem 
  for x being Element of REAL holds *(x,x) in REAL+;

theorem 
  for x,y st +(*(x,x),*(y,y)) = 0 holds x = 0;

theorem 
  for x,y,z being Element of REAL st x <> 0 & *(x,y) = 1 & *(x,z)
  = 1 holds y = z;

theorem 
  for x,y st y = 1 holds *(x,y) = x;

theorem 
  for x,y st y <> 0 holds *(*(x,y),inv y) = x;

theorem 
  for x,y st *(x,y) = 0 holds x = 0 or y = 0;

theorem 
  for x,y holds inv *(x,y) = *(inv x, inv y);

theorem 
  for x,y,z being Element of REAL holds +(x,+(y,z)) = +(+(x,y),z);

theorem 
  [*x,y*] in REAL implies y = 0;

theorem 
  for x,y being Element of REAL holds opp +(x,y) = +(opp x, opp y);














begin

definition
  func <i> equals

  (0,1) --> (0,1);
  let c be number;
  attr c is complex means


  c in COMPLEX;
end;

registration
  cluster <i> -> complex;
end;

registration
  cluster complex for number;
end;

registration
  sethood of complex number;
end;

notation
  let x be complex number;
  synonym x is zero for x is empty;
end;

definition
  let x be complex number;
  redefine attr x is zero means

  x = 0;
end;

definition
  let x,y be complex number;
  func x+y means


  ex x1,x2,y1,y2 being Element of REAL st
  x = [*x1,x2*] & y = [*y1,y2*] & it = [*+(x1,y1),+(x2,y2)*];
  commutativity;
  func x*y means


  ex x1,x2,y1,y2 being Element of REAL st x = [*x1,x2*] & y = [*y1,y2*] &
  it = [* +(*(x1,y1),opp*(x2,y2)), +(*(x1,y2),*(x2,y1)) *];
  commutativity;
end;

registration
  let z,z9 be complex number;
  cluster z+z9 -> complex;
  cluster z*z9 -> complex;
end;

definition
  let z be complex number;
  func -z -> complex number means


  z + it = 0;
  involutiveness;
  func z" -> complex number means


  z*it = 1 if z <> 0 otherwise it = 0;
  involutiveness;
end;

definition
  let x,y be complex number;
  func x-y equals

  x+(-y);
  func x/y equals

  x * y";
end;

registration
  let x,y be complex number;
  cluster x-y -> complex;
  cluster x/y -> complex;
end;

registration
  cluster non zero for complex number;
end;

registration
  let x be non zero complex number;
  cluster -x -> non zero;
  cluster x" -> non zero;
  let y be non zero complex number;
  cluster x*y -> non zero;
end;

registration
  let x,y be non zero complex number;
  cluster x/y -> non zero;
end;

registration
  cluster -> complex for Element of REAL;
end;

registration
  cluster natural -> complex for number;
end;

registration
  cluster -> complex for Element of COMPLEX;
end;














begin









reserve x for complex number;

theorem 
  x + 0 = x;

theorem 
  x * 0 = 0;

theorem 
  1 * x = x;

theorem 
  x - 0 = x;

theorem 
  0 / x = 0;

theorem 
  x / 1 = x;














begin

reserve x for set;

definition
  let x;
  attr x is ext-real means


  x in ExtREAL;
end;

registration
  cluster ext-real for number;
  cluster -> ext-real for Element of ExtREAL;
end;

registration
  sethood of ext-real number;
end;

definition
  func +infty equals

  REAL;
  func -infty equals

  [0,REAL];
end;

definition
  redefine func ExtREAL equals

  REAL \/ {+infty,-infty};
end;

registration
  cluster +infty -> ext-real;
  cluster -infty -> ext-real;
end;

definition
  let x,y be ext-real number;
  pred x <= y means


  ex x9,y9 being Element of REAL+ st x = x9 & y = y9
& x9 <=' y9 if x in REAL+ & y in REAL+, ex x9,y9 being Element of REAL+ st x =
  [0,x9] & y = [0,y9] & y9 <=' x9 if x in [:{0},REAL+:] & y in [:{0},REAL+:]
  otherwise y in REAL+ & x in [:{0},REAL+:] or x = -infty or y = +infty;
  reflexivity;
  connectedness;
end;

reserve a,b,c,d for ext-real number;

notation
  let a,b;
  synonym b >= a for a <= b;
  antonym b < a for a <= b;
  antonym a > b for a <= b;
end;

theorem 
  a <= b & b <= a implies a = b;

theorem 
  a <= b & b <= c implies a <= c;

theorem 
  a <= +infty;

theorem 
  +infty <= a implies a = +infty;

theorem 
  a >= -infty;

theorem 
  -infty >= a implies a = -infty;

theorem 
  -infty < +infty;

theorem 
  not +infty in REAL;

theorem 
  a in REAL implies +infty > a;

theorem 
  a in REAL & b >= a implies b in REAL or b = +infty;

theorem 
  not -infty in REAL;

theorem 
  a in REAL implies -infty < a;

theorem 
  a in REAL & b <= a implies b in REAL or b = -infty;

theorem 
  a in REAL or a = +infty or a = -infty;

begin 

registration
  cluster natural -> ext-real for number;
end;

notation
  let a be number;
  synonym a is zero for a is empty;
end;

definition
  let a be ext-real number;
  attr a is positive means

  a > 0;
  attr a is negative means

  a < 0;
  redefine attr a is zero means

  a = 0;
end;

registration
  cluster positive -> non negative non zero for ext-real number;
  cluster non negative non zero -> positive for ext-real number;
  cluster negative -> non positive non zero for ext-real number;
  cluster non positive non zero -> negative for ext-real number;
  cluster zero -> non negative non positive for ext-real number;
  cluster non negative non positive -> zero for ext-real number;
end;

registration
  cluster +infty -> positive;
  cluster -infty -> negative;
end;

registration
  cluster positive for ext-real number;
  cluster negative for ext-real number;
  cluster zero for ext-real number;
end;

begin 

definition
  let a,b;
  func min(a,b) equals


  a if a <= b otherwise b;
  commutativity;
  idempotence;
  func max(a,b) equals


  a if b <= a otherwise b;
  commutativity;
  idempotence;
end;

theorem 
  min(a,b) = a or min(a,b) = b;

theorem 
  max(a,b) = a or max(a,b) = b;

registration
  let a,b;
  cluster min(a,b) -> ext-real;
  cluster max(a,b) -> ext-real;
end;

theorem 
  min(a,b) <= a;

theorem 
  a <= b & c <= d implies min(a,c) <= min(b,d);

theorem 
  a < b & c < d implies min(a,c) < min(b,d);

theorem 
  a <= b & a <= c implies a <= min(b,c);

theorem 
  a < b & a < c implies a < min(b,c);

theorem 
  a <= min(b,c) implies a <= b;

theorem 
  a < min(b,c) implies a < b;

theorem 
  c <= a & c <= b & (for d st d <= a & d <= b holds d <= c) implies c =
  min(a,b);

theorem 
  a <= max(a,b);

theorem 
  a <= b & c <= d implies max(a,c) <= max(b,d);

theorem 
  a < b & c < d implies max(a,c) < max(b,d);

theorem 
  b <= a & c <= a implies max(b,c) <= a;

theorem 
  b < a & c < a implies max(b,c) < a;

theorem 
  max(b,c) <= a implies b <= a;

theorem 
  max(b,c) < a implies b < a;

theorem 
  a <= c & b <= c & (for d st a <= d & b <= d holds c <= d) implies c =
  max(a,b);

theorem 
  min(min(a,b),c) = min(a,min(b,c));

theorem 
  max(max(a,b),c) = max(a,max(b,c));

theorem 
  min(max(a,b),b) = b;

theorem 
  max(min(a,b),b) = b;

theorem 
  a <= c implies max(a,min(b,c)) = min(max(a,b),c);

theorem 
  min(a,max(b,c)) = max(min(a,b),min(a,c));

theorem 
  max(a,min(b,c)) = min(max(a,b),max(a,c));

theorem 
  max(max(min(a,b),min(b,c)),min(c,a)) = min(min(max(a,b),max(b,c)),max( c,a));

theorem 
  max(a,+infty) = +infty;

theorem 
  min(a,+infty) = a;

theorem 
  max(a,-infty) = a;

theorem 
  min(a,-infty) = -infty;

begin 

theorem 
  a in REAL & c in REAL & a <= b & b <= c implies b in REAL;

theorem 
  a in REAL & a <= b & b < c implies b in REAL;

theorem 
  c in REAL & a < b & b <= c implies b in REAL;

theorem 
  a < b & b < c implies b in REAL;



definition
  let x,y be ext-real number, a,b be set;
  func IFGT(x,y,a,b) equals


  a if x > y otherwise b;
end;

registration
  let x,y be ext-real number, a,b be Nat;
  cluster IFGT(x,y,a,b) -> natural;
end;



theorem 
  max(a,b) <= a implies max(a,b) = a;

theorem 
  a <= min(a,b) implies min(a,b) = a;














begin

definition
  let r be number;
  attr r is real means


  r in REAL;
end;

registration
  cluster -> real for Element of REAL;
end;

registration
  cluster -infty -> non real;
  cluster +infty -> non real;
end;

registration
  cluster natural -> real for number;
  cluster real -> complex for number;
end;

registration
  cluster real for number;
  cluster real -> ext-real for number;
end;

registration
  let x be real number;
  cluster -x -> real;
  cluster x" -> real;
  let y be real number;
  cluster x + y -> real;
  cluster x * y -> real;
end;

registration
  let x,y be real number;
  cluster x-y -> real;
  cluster x/y -> real;
end;

begin

reserve r,s,t for real number;

registration
  cluster positive for real number;
  cluster negative for real number;
  cluster zero for real number;
end;

registration
  let r,s be non negative real number;
  cluster r + s -> non negative;
end;

registration
  let r,s be non positive real number;
  cluster r + s -> non positive;
end;

registration
  let r be positive real number;
  let s be non negative real number;
  cluster r + s -> positive;
  cluster s + r -> positive;
end;

registration
  let r be negative real number;
  let s be non positive real number;
  cluster r + s -> negative;
  cluster s + r -> negative;
end;

registration
  let r be non positive real number;
  cluster -r -> non negative;
end;

registration
  let r be non negative real number;
  cluster -r -> non positive;
end;

registration
  let r be non negative real number, s be non positive real number;
  cluster r - s -> non negative;
  cluster s - r -> non positive;
end;

registration
  let r be positive real number;
  let s be non positive real number;
  cluster r - s -> positive;
  cluster s - r -> negative;
end;

registration
  let r be negative real number;
  let s be non negative real number;
  cluster r - s -> negative;
  cluster s - r -> positive;
end;

registration
  let r be non positive real number, s be non negative real number;
  cluster r*s -> non positive;
  cluster s*r -> non positive;
end;

registration
  let r,s be non positive real number;
  cluster r*s -> non negative;
end;

registration
  let r,s be non negative real number;
  cluster r*s -> non negative;
end;

registration
  let r be positive real number;
  cluster r" -> positive;
end;

registration
  let r be non positive real number;
  cluster r" -> non positive;
end;

registration
  let r be negative real number;
  cluster r" -> negative;
end;

registration
  let r be non negative real number;
  cluster r" -> non negative;
end;

registration
  let r be non negative real number, s be non positive real number;
  cluster r/s -> non positive;
  cluster s/r -> non positive;
end;

registration
  let r,s be non negative real number;
  cluster r/s -> non negative;
end;

registration
  let r,s be non positive real number;
  cluster r/s -> non negative;
end;

begin 

registration
  let r,s;
  cluster min(r,s) -> real;
  cluster max(r,s) -> real;
end;

definition
  let r,s be real number;
  func r -' s equals


  r - s if r -s >= 0 otherwise 0;
end;

registration
  let r,s be real number;
  cluster r -' s -> real;
end;

registration
  let r,s be real number;
  cluster r -' s -> non negative for real number;
end;














begin









reserve x, y, z for real number;

theorem 
  x <= y & x is positive implies y is positive;

theorem 
  x <= y & y is negative implies x is negative;

theorem 
  x <= y & x is non negative implies y is non negative;

theorem 
  x <= y & y is non positive implies x is non positive;

theorem 
  x <= y & y is non zero & x is non negative implies y is positive;

theorem 
  x <= y & x is non zero & y is non positive implies x is negative;

theorem 
  not x <= y & x is non positive implies y is negative;

theorem 
  not x <= y & y is non negative implies x is positive;
 
















begin

reserve a, b, c, d, e for complex number;



theorem 
  a + (b + c) = (a + b) + c;

theorem 
  a + c = b + c implies a = b;

theorem 
  a = a + b implies b = 0;



theorem 
  a * (b * c) = (a * b) * c;

theorem 
  c <> 0 & a * c = b * c implies a = b;

theorem 
  a*b=0 implies a=0 or b=0;

theorem 
  b <> 0 & a * b = b implies a = 1;



theorem 
  a * (b + c) = a * b + a * c;

theorem 
  (a + b + c) * d = a * d + b * d + c * d;

theorem 
  (a + b) * (c + d) = a * c + a * d + b * c + b * d;

theorem 
  2 * a = a + a;

theorem 
  3 * a = a + a + a;

theorem 
  4 * a = a + a + a + a;



theorem 
  a - a = 0;

theorem 
  a - b = 0 implies a = b;

theorem 
  b - a = b implies a = 0;



theorem 
  a = a - (b - b);

theorem 
  a - (a - b) = b;

theorem 
  a - c = b - c implies a = b;

theorem 
  c - a = c - b implies a = b;

theorem 
  a - b - c = a - c - b;

theorem 
  a - c = (a - b) - (c - b);

theorem 
  (c - a) - (c - b) = b - a;

theorem 
  a - b = c - d implies a - c = b - d;



theorem 
  a = a + (b - b);

theorem 
  a = a + b - b;

theorem 
  a = a - b + b;

theorem 
  a + c = a + b + (c - b);



theorem 
  a + b - c = a - c + b;

theorem 
  a - b + c = c - b + a;

theorem 
  a + c = a + b - (b - c);

theorem 
  a - c = a + b - (c + b);

theorem 
  a + b = c + d implies a - c = d - b;

theorem 
  a - c = d - b implies a + b = c + d;

theorem 
  a + b = c - d implies a + d = c - b;



theorem 
  a - (b + c) = a - b - c;

theorem 
  a - (b - c) = a - b + c;

theorem 
  a - (b - c) = a + (c - b);

theorem 
  a - c = (a - b) + (b - c);

theorem 
  a * (b - c) = a * b - a * c;

theorem 
  (a - b) * (c - d) = (b - a) * (d - c);

theorem 
  (a - b - c) * d = a * d - b * d - c * d;



theorem 
  (a + b - c) * d = a * d + b * d - c * d;

theorem 
  (a - b + c) * d = a * d - b * d + c * d;

theorem 
  (a + b) * (c - d) = a * c - a * d + b * c - b * d;

theorem 
  (a - b) * (c + d) = a * c + a * d - b * c - b * d;

theorem 
  (a - b) * (e - d) = a * e - a * d - b * e + b * d;



theorem 
  a / b / c = a / c / b;



theorem 
  a / 0 = 0;

theorem 
  a <> 0 & b <> 0 implies a / b <> 0;



theorem 
  b <> 0 implies a = a / (b / b);

theorem 
  a <> 0 implies a / (a / b) = b;

theorem 
  c <> 0 & a / c = b / c implies a = b;

theorem 
  a / b <> 0 implies b = a / (a / b);

theorem 
  c <> 0 implies a / b = (a / c) / (b / c);



theorem 
  1 / (1 / a) = a;

theorem 
  1 / (a / b) = b / a;

theorem 
  a / b = 1 implies a = b;

theorem 
  1 / a = 1 / b implies a = b;



theorem 
  a <> 0 implies a / a = 1;

theorem 
  b <> 0 & b / a = b implies a = 1;



theorem 
  a / c + b / c = (a + b) / c;

theorem 
  (a + b + e) / d = a / d + b / d + e / d;



theorem 
  (a + a) / 2 = a;

theorem 
  a/2 + a/2 = a;

theorem 
  a = (a + b) / 2 implies a = b;



theorem 
  (a + a + a)/3 = a;

theorem 
  a/3 + a/3 + a/3 = a;



theorem 
  (a + a + a + a) / 4 = a;

theorem 
  a/4 + a/4 + a/4 + a/4 = a;

theorem 
  a / 4 + a / 4 = a / 2;

theorem 
  (a + a) / 4 = a / 2;



theorem 
  a * b = 1 implies a = 1 / b;

theorem 
  a * (b / c) = (a * b) / c;

theorem 
  a / b * e = e / b * a;



theorem 
  (a / b) * (c / d) = (a * c) / (b * d);

theorem 
  a / (b / c) = (a * c) / b;

theorem 
  a / (b * c) = a / b / c;

theorem 
  a / (b / c) = a * (c / b);

theorem 
  a / (b / c) = c / b * a;

theorem 
  a / (b / e) = e * (a / b);

theorem 
  a / (b / c) = a / b * c;

theorem 
  (a * b) / (c * d) = (a / c * b) / d;



theorem 
  (a / b) / (c / d) = (a * d) / (b * c);

theorem 
  (a / c) * (b / d) = (a / d) * (b / c);

theorem 
  a / (b * c * (d / e)) = (e / c) * (a / (b * d));



theorem 
  b <> 0 implies a / b * b = a;

theorem 
  b <> 0 implies a = a * (b / b);

theorem 
  b <> 0 implies a = a * b / b;

theorem 
  b <> 0 implies a * c = a * b * (c / b);



theorem 
  c <> 0 implies a / b = (a * c) / (b * c);

theorem 
  c <> 0 implies a / b = a / (b * c) * c;

theorem 
  b <> 0 implies a * c = a * b / (b / c);

theorem 
  c <> 0 & d <> 0 & a * c = b * d implies a / d = b / c;

theorem 
  c <> 0 & d<>0 & a/d=b/c implies a*c = b*d;

theorem 
  c <> 0 & d <> 0 & a * c = b / d implies a * d = b / c;



theorem 
  c <> 0 implies a / b = c * (a / c / b);

theorem 
  c <> 0 implies a / b = a / c * (c / b);



theorem 
  a * (1 / b) = a / b;

theorem 
  a / (1 / b) = a * b;

theorem 
  a / b * c = 1 / b * c * a;



theorem 
  (1 / a) * (1 / b) = 1 / (a * b);

theorem 
  1 / c * (a / b) = a / (b * c);



theorem 
  a / b / c = 1 / b * (a / c);

theorem 
  a / b / c = 1 / c * (a / b);



theorem 
  a <> 0 implies a * (1 / a) = 1;

theorem 
  b <> 0 implies a = a * b * (1 / b);

theorem 
  b <> 0 implies a = a * (1 / b * b);

theorem 
  b <> 0 implies a = a * (1 / b) * b;

theorem 
  b <> 0 implies a = a / (b * (1 / b));

theorem 
  a <> 0 & b <> 0 implies 1 / (a * b) <> 0;

theorem 
  a <> 0 & b <> 0 implies (a / b) * (b / a) = 1;



theorem 
  b <> 0 implies a / b + c = (a + b * c) / b;

theorem 
  c <> 0 implies a + b = c * (a / c + b / c);

theorem 
  c <> 0 implies a + b = (a * c + b * c) / c;

theorem 
  b <> 0 & d <> 0 implies a / b + c / d =(a * d + c * b) / (b * d );

theorem 
  a <> 0 implies a + b = a * (1 + b / a);



theorem 
  a / (2 * b) + a / (2 * b) = a / b;



theorem 
  a / (3 * b) + a / (3 * b) + a / (3 * b) = a / b;

theorem 
  a / c - b / c = (a - b) / c;

theorem 
  a - a / 2 = a / 2;

theorem 
  (a - b - c) / d = a / d - b / d - c / d;

theorem 
  b <> 0 & d <> 0 & b <> d & a / b = e / d implies a / b = (a - e) / (b - d );



theorem 
  (a + b - e) / d = a / d + b / d - e / d;

theorem 
  (a - b + e) / d = a / d - b / d + e / d;



theorem 
  b <> 0 implies a / b - e = (a - e * b) / b;

theorem 
  b <> 0 implies c - a / b = (c * b - a) / b;

theorem 
  c <> 0 implies a - b = c * (a / c - b / c);

theorem 
  c <> 0 implies a - b = (a * c - b * c) / c;

theorem 
  b <> 0 & d <> 0 implies a / b - c / d = (a * d - c * b) / (b * d);

theorem 
  a <> 0 implies a - b = a * (1 - b / a);



theorem 
  a <> 0 implies c = (a * c + b - b) / a;



theorem 
  -a = -b implies a = b;

theorem 
  -a = 0 implies a = 0;

theorem 
  a + -b = 0 implies a = b;

theorem 
  a = a + b + -b;

theorem 
  a = a + (b + -b);

theorem 
  a = (- b + a) + b;

theorem 
  - (a + b) = -a + -b;

theorem 
  - (-a + b) = a + -b;

theorem 
  a+b=-(-a+-b);



theorem 
  -(a - b) = b - a;

theorem 
  - a - b = - b - a;

theorem 
  a = - b - (- a - b);



theorem 
  - a - b - c = - a - c - b;

theorem 
  - a - b - c = - b - c - a;

theorem 
  - a - b - c = - c - b - a;

theorem 
  (c - a) - (c - b) = - (a - b);



theorem 
  0 - a = - a;



theorem 
  a + b = a - - b;

theorem 
  a = a - (b + -b);

theorem 
  a - c = b + - c implies a = b;

theorem 
  c - a = c + - b implies a = b;



theorem 
  a + b - c = - c + a + b;

theorem 
  a - b + c = - b + c + a;

theorem 
  a - (- b - c) = a + b + c;



theorem 
  a - b - c = - b - c + a;

theorem 
  a - b - c = - c + a - b;

theorem 
  a - b - c = - c - b + a;



theorem 
  - (a + b) = - b - a;

theorem 
  - (a - b) = - a + b;

theorem 
  -(-a+b)=a-b;

theorem 
  a + b = -(- a - b);

theorem 
  - a + b - c = - c + b - a;



theorem 
  - a + b - c = - c - a + b;

theorem 
  - (a + b + c) = - a - b - c;

theorem 
  - (a + b - c) = - a - b + c;

theorem 
  - (a - b + c) = - a + b - c;

theorem 
  - (a - b - c) = - a + b + c;

theorem 
  - (- a + b + c) = a - b - c;

theorem 
  - (- a + b - c) = a - b + c;

theorem 
  - (- a - b + c) = a + b - c;

theorem 
  - (- a - b - c) = a + b + c;



theorem 
  (- a) * b = -(a * b);

theorem 
  (- a) * b = a * (- b);

theorem 
  (- a) * (- b) = a * b;

theorem 
  - a * (- b) = a * b;

theorem 
  -(-a) * b = a * b;

theorem 
  (-1) * a = -a;

theorem 
  (- a) * (- 1) = a;

theorem 
  b<>0 & a*b=-b implies a=-1;



theorem 
  a * a = 1 implies a = 1 or a = -1;

theorem 
  -a + 2 * a = a;

theorem 
  (a - b) * c = (b - a) * (- c);

theorem 
  (a - b) * c = - (b - a) * c;

theorem 
  a - 2 * a = -a;



theorem 
  -a / b = (-a) / b;

theorem 
  a / (- b) = -a / b;

theorem 
  - a / (- b) = a / b;

theorem 
  -(- a) / b = a / b;

theorem 
  (- a) / (- b) = a / b;

theorem 
  (-a) / b = a / (-b);

theorem 
  -a = a / (-1);

theorem 
  a = (- a) / (-1);

theorem 
  a / b = - 1 implies a = - b & b = - a;

theorem 
  b <> 0 & b / a = - b implies a = -1;

theorem 
  a <> 0 implies (-a) / a = -1;

theorem 
  a <> 0 implies a / (- a) = -1;

theorem 
  a <> 0 & a = 1 / a implies a = 1 or a = -1;

theorem 
  b <> 0 & d <> 0 & b <> -d & a / b = e / d implies a / b = (a + e) / (b + d );



theorem 
  a" = b" implies a = b;

theorem 
  0" = 0;



theorem 
  b <> 0 implies a = a*b*b";

theorem 
  a" * b" = (a * b)";

theorem 
  (a * b")" = a" * b;

theorem 
  (a" * b")" = a * b;

theorem 
  a <> 0 & b <> 0 implies a * b" <> 0;

theorem 
  a <> 0 & b <> 0 implies a" * b" <> 0;

theorem 
  a * b" = 1 implies a = b;

theorem 
  a * b = 1 implies a = b";



theorem 
  a <> 0 & b <> 0 implies a" + b" = (a + b)*(a*b)";



theorem 
  a <> 0 & b <> 0 implies a" - b" = (b - a)*(a*b)";



theorem 
  (a / b)" = b / a;

theorem 
  (a"/b") = b/a;

theorem 
  1 / a = a";

theorem 
  1 / a" = a;

theorem 
  (1 / a)" = a;

theorem 
  1 / a = b" implies a = b;



theorem 
  a/b" = a*b;

theorem 
  a"*(c/b) = c/(a*b);

theorem 
  a"/b = (a*b)";



theorem 
  (- a)" = -a";

theorem 
  a <> 0 & a = a" implies a = 1 or a = -1;

begin 


theorem 
  a+b+c-b=a+c;

theorem 
  a-b+c+b=a+c;

theorem 
  a+b-c-b=a-c;

theorem 
  a-b-c+b=a-c;

theorem 
  a-a-b=-b;

theorem 
  -a+a-b=-b;

theorem 
  a-b-a=-b;

theorem 
  -a-b+a=-b;

begin 


theorem 
  for a,b st b<>0 ex e st a=b/e;



theorem 
  a/(b*c*(d/e))=(e/c)*(a/(b*d));



theorem 
  ((d - c)/b) * a + c = (1 - a/b)*c + (a/b) * d;



theorem 
  a <> 0 implies a * b + c = a * (b + (c/a));














begin

reserve a,b,c,d for real number;
reserve r,s for real number;

theorem 
  ex b st a < b;

theorem 
  ex b st b < a;

theorem 
  ex c st a < c & b < c;

theorem 
  ex c st c < a & c < b;

theorem 
  a < b implies ex c st a < c & c < b;

begin

theorem 
  a <= b iff a + c <= b + c;

theorem 
  a <= b & c <= d implies a+c <= b+d;

theorem 
  a < b & c <= d implies a+c < b+d;

begin

theorem 
  a <= b iff a-c <= b-c;

theorem 
  a <= b iff c-b <= c-a;

theorem 
  a <= b-c implies c <= b-a;

theorem 
  a-b <= c implies a-c <= b;

theorem 
  a <= b & c <= d implies a-d <= b-c;

theorem 
  a < b & c <= d implies a-d < b-c;

theorem 
  a <= b & c < d implies a-d < b-c;

theorem 
  a-b <= c-d implies a-c <= b-d;

theorem 
  a-b <= c-d implies d-b <= c-a;

theorem 
  a-b <= c-d implies d-c <= b-a;

begin

theorem 
  a+b <= c iff a <= c-b;

theorem 
  a <= b+c iff a-b <= c;

theorem 
  a+b<=c+d iff a-c <= d-b;

theorem 
  a+b<=c-d implies a+d<=c-b;

theorem 
  a-b<=c+d implies a-d<=c+b;

begin

theorem 
  a<=b iff -b<=-a;

theorem 
  a<=-b implies b<=-a;

theorem 
  -b<=a implies -a<=b;

begin

theorem 
  0 <= a & 0 <= b & a+b = 0 implies a = 0;

theorem 
  a <= 0 & b <= 0 & a+b = 0 implies a = 0;

begin

theorem 
  0 < a implies b < b+a;

theorem 
  a < 0 implies a+b < b;

theorem 
  0 <= a implies b <= a+b;

theorem 
  a <= 0 implies a+b <= b;

begin

theorem 
  0 <= a & 0 <= b implies 0 <= a+b;

theorem 
  0 <= a & 0 < b implies 0 < a+b;

theorem 
  a <= 0 & c <= b implies c+a <= b;

theorem 
  a <= 0 & c < b implies c+a < b;

theorem 
  a < 0 & c <= b implies c+a < b;

theorem 
  0 <= a & b <= c implies b <= a+c;

theorem 
  0 < a & b <= c implies b < a+c;

theorem 
  0 <= a & b < c implies b < a+c;

begin

theorem 
  (for a being real number st a>0 holds c <= b+a) implies c <= b;

theorem 
  (for a being real number st a<0 holds b+a <= c) implies b <= c;

begin

theorem 
  0 <= a implies b-a <= b;

theorem 
  0 < a implies b-a < b;

theorem 
  a <= 0 implies b <= b-a;

theorem 
  a < 0 implies b < b-a;

theorem 
  a <= b implies a-b <= 0;

theorem 
  a <= b implies 0 <= b-a;

theorem 
  a < b implies a-b < 0;

theorem 
  a < b implies 0 < b-a;

theorem 
  0 <= a & b < c implies b-a < c;

theorem 
  a <= 0 & b <= c implies b <= c-a;

theorem 
  a <= 0 & b < c implies b < c-a;

theorem 
  a < 0 & b <= c implies b < c-a;

theorem 
  a <> b implies 0 < a-b or 0 < b-a;

begin

theorem 
  (for a being real number st a<0 holds c <= b-a) implies b>=c;

theorem 
  (for a being real number st a>0 holds b-a <= c) implies b<=c;

begin

theorem 
  a < 0 iff 0 < -a;

theorem 
  a <= -b implies a+b <= 0;

theorem 
  -a <= b implies 0 <= a+b;

theorem 
  a < -b implies a+b < 0;

theorem 
  -b < a implies 0 < a+b;

begin

theorem 
  0 <= a*a;

theorem 
  a <= b & 0 <= c implies a*c <= b*c;

theorem 
  a <= b & c <= 0 implies b*c <= a*c;

theorem 
  0 <= a & a <= b & 0 <= c & c <= d implies a*c <= b*d;

theorem 
  a <= 0 & b <= a & c <= 0 & d <= c implies a*c <= b*d;

theorem 
  0 < c & a < b implies a*c < b*c;

theorem 
  c < 0 & a < b implies b*c < a*c;

theorem 
  a < 0 & b <= a & c < 0 & d < c implies a*c < b*d;

begin

theorem 
  0 <= a & 0 <= b & 0 <= c & 0 <= d & a*c+b*d = 0 implies a = 0 or c = 0;

begin

theorem 
  0 <= c & b <= a implies b/c <= a/c;

theorem 
  c <= 0 & a <= b implies b/c <= a/c;

theorem 
  0 < c & a < b implies a/c < b/c;

theorem 
  c < 0 & a < b implies b/c < a/c;

theorem 
  0 < c & 0 < a & a < b implies c/b < c/a;

begin

theorem 
  0 < b & a*b <= c implies a <= c/b;

theorem 
  b < 0 & a*b <= c implies c/b <= a;

theorem 
  0 < b & c <= a*b implies c/b <= a;

theorem 
  b < 0 & c <= a*b implies a <= c/b;

theorem 
  0 < b & a*b < c implies a< c/b;

theorem 
  b < 0 & a*b < c implies c/b < a;

theorem 
  0 < b & c < a*b implies c/b < a;

theorem 
  b < 0 & c < a*b implies a < c/b;

begin

theorem 
  0 < a & a <= b implies b" <= a";

theorem 
  b < 0 & a <= b implies b" <= a";

theorem 
  b < 0 & a < b implies b" < a";

theorem 
  0 < a & a < b implies b" < a";

theorem 
  0 < b" & b" <= a" implies a <= b;

theorem 
  a" < 0 & b" <= a" implies a <= b;

theorem 
  0 < b" & b" < a" implies a < b;

theorem 
  a" < 0 & b" < a" implies a < b;

begin

theorem 
  0 <= a & (b-a)*(b+a) <= 0 implies -a <= b & b <= a;

theorem 
  0 <= a & (b-a)*(b+a) < 0 implies -a < b & b < a;

theorem 
  0 <= (b-a)*(b+a) implies b <= -a or a <= b;

theorem 
  0 <= a & 0 <= c & a < b & c < d implies a*c < b*d;

theorem 
  0 <= a & 0 < c & a < b & c <= d implies a*c < b*d;

theorem 
  0 < a & 0 < c & a <= b & c < d implies a*c < b*d;

theorem 
  0 < c & b < 0 & a < b implies c/b < c/a;

theorem 
  c < 0 & 0 < a & a < b implies c/a < c/b;

theorem 
  c < 0 & b < 0 & a < b implies c/a < c/b;

theorem 
  0 < b & 0 < d & a*d <= c*b implies a/b <= c/d;

theorem 
  b < 0 & d < 0 & a*d <= c*b implies a/b <= c/d;

theorem 
  0 < b & d < 0 & a*d <= c*b implies c/d <= a/b;

theorem 
  b < 0 & 0 < d & a*d <= c*b implies c/d <= a/b;

theorem 
  0 < b & 0 < d & a*d < c*b implies a/b < c/d;

theorem 
  b < 0 & d < 0 & a*d < c*b implies a/b < c/d;

theorem 
  0 < b & d < 0 & a*d < c*b implies c/d < a/b;

theorem 
  b < 0 & 0 < d & a*d < c*b implies c/d < a/b;

theorem 
  b < 0 & d < 0 & a*b < c/d implies a*d < c/b;

theorem 
  0 < b & 0 < d & a*b < c/d implies a*d < c/b;

theorem 
  b < 0 & d < 0 & c/d < a*b implies c/b < a*d;

theorem 
  0 < b & 0 < d & c/d < a*b implies c/b < a*d;

theorem 
  b < 0 & 0 < d & a*b < c/d implies c/b < a*d;

theorem 
  0 < b & d < 0 & a*b < c/d implies c/b < a*d;

theorem 
  b < 0 & 0 < d & c/d < a*b implies a*d < c/b;

theorem 
  0 < b & d < 0 & c/d < a*b implies a*d < c/b;

theorem 
  0 < a & 0 <= c & a <= b implies c/b <= c/a;

theorem 
  0 <= c & b < 0 & a <= b implies c/b <= c/a;

theorem 
  c <= 0 & 0 < a & a <= b implies c/a <= c/b;

theorem 
  c <= 0 & b < 0 & a <= b implies c/a <= c/b;

theorem 
  0 < a iff 0 < a";

theorem 
  a < 0 iff a" < 0;

theorem 
  a < 0 & 0 < b implies a" < b";

theorem 
  a" < 0 & 0 < b" implies a < b;

begin

theorem 
  a <= 0 & 0 <= a implies 0 = a*b;

theorem 
  0 <= a & 0 <= b implies 0 <= a*b;

theorem 
  a <= 0 & b <= 0 implies 0 <= a*b;

theorem 
  0 < a & 0 < b implies 0 < a*b;

theorem 
  a < 0 & b < 0 implies 0 < a*b;

theorem 
  0 <= a & b <= 0 implies a*b <= 0;

theorem 
  0 < a & b < 0 implies a*b < 0;

theorem 
  a*b<0 implies a>0 & b<0 or a<0 & b>0;

theorem 
  a*b>0 implies a>0 & b>0 or a<0 & b<0;

theorem 
  a <= 0 & b <= 0 implies 0 <= a/b;

theorem 
  0 <= a & 0 <= b implies 0 <= a/b;

theorem 
  0 <= a & b <= 0 implies a/b <= 0;

theorem 
  a <= 0 & 0 <= b implies a/b <= 0;

theorem 
  0 < a & 0 < b implies 0 < a/b;

theorem 
  a < 0 & b < 0 implies 0 < a/b;

theorem 
  a < 0 & 0 < b implies a/b < 0;

theorem 
  a < 0 & 0 < b implies b/a < 0;

theorem 
  a/b<0 implies b<0 & a>0 or b>0 & a<0;

theorem 
  a/b>0 implies b>0 & a>0 or b<0 & a<0;

begin

theorem 
  a <= b implies a < b+1;

theorem 
  a - 1 < a;

theorem 
  a <= b implies a-1 < b;

theorem 
  -1 < a implies 0 < 1+a;

theorem 
  a<1 implies 1-a>0;

begin

theorem 
  a <= 1 & 0 <= b & b <= 1 & a*b = 1 implies a=1;

theorem 
  0 <= a & 1 <= b implies a <= a*b;

theorem 
  a <= 0 & b <= 1 implies a <= a*b;

theorem 
  0 <= a & b <= 1 implies a*b <= a;

theorem 
  a <= 0 & 1 <= b implies a*b <= a;

theorem 
  0 < a & 1 < b implies a < a*b;

theorem 
  a < 0 & b < 1 implies a < a*b;

theorem 
  0 < a & b < 1 implies a*b < a;

theorem 
  a < 0 & 1 < b implies a*b < a;

theorem 
  1 <= a & 1 <= b implies 1 <= a*b;

theorem 
  0 <= a & a <= 1 & b <= 1 implies a*b <= 1;

theorem 
  1 < a & 1 <= b implies 1 < a*b;

theorem 
  0 <= a & a < 1 & b <= 1 implies a*b < 1;

theorem 
  a <= -1 & b <= -1 implies 1 <= a*b;

theorem 
  a < -1 & b <= -1 implies 1 < a*b;

theorem 
  a <= 0 & -1 <= a & -1 <= b implies a*b <= 1;

theorem 
  a <= 0 & -1 < a & -1 <= b implies a*b < 1;

begin

theorem 
  (for a st 1 < a holds c <= b*a) implies c <= b;

theorem 
  (for a st 0 < a & a < 1 holds b*a <= c) implies b <= c;

theorem 
  (for a st 0 < a & a < 1 holds b <= a*c) implies b <= 0;

theorem 
  0 <= d & d <= 1 & 0 <= a & 0 <= b & d*a+(1-d)*b=0 implies d=0 & b=0 or
  d=1 & a=0 or a=0 & b=0;

theorem 
  0 <= d & a <= b implies a <= (1-d)*a+d*b;

theorem 
  d <= 1 & a <= b implies (1-d)*a+d*b <= b;

theorem 
  0 <= d & d <= 1 & a <= b & a <= c implies a <= (1-d)*b+d*c;

theorem 
  0 <= d & d <= 1 & b <= a & c <= a implies (1-d)*b+d*c <= a;

theorem 
  0 <= d & d <= 1 & a < b & a < c implies a < (1-d)*b+d*c;

theorem 
  0 <= d & d <= 1 & b < a & c < a implies (1-d)*b+d*c < a;

theorem 
  0 < d & d < 1 & a <= b & a < c implies a < (1-d)*b+d*c;

theorem 
  0 < d & d < 1 & b < a & c <= a implies (1-d)*b+d*c < a;

theorem 
  0 <= d & d <= 1 & a <= (1-d)*a+d*b & b < (1-d)*a+d*b implies d = 0;

theorem 
  0 <= d & d <= 1 & (1-d)*a+d*b <= a & (1-d)*a+d*b < b implies d = 0;

begin

theorem 
  0 < a & a <= b implies 1 <= b/a;

theorem 
  a < 0 & b <= a implies 1 <= b/a;

theorem 
  0 <= a & a <= b implies a/b <= 1;

theorem 
  b <= a & a <= 0 implies a/b <= 1;

theorem 
  0 <= a & b <= a implies b/a <= 1;

theorem 
  a <= 0 & a <= b implies b/a <= 1;

theorem 
  0 < a & a < b implies 1 < b/a;

theorem 
  a < 0 & b < a implies 1 < b/a;

theorem 
  0 <= a & a < b implies a/b < 1;

theorem 
  a <= 0 & b < a implies a/b < 1;

theorem 
  0 < a & b < a implies b/a < 1;

theorem 
  a < 0 & a < b implies b/a < 1;

begin

theorem 
  0 <= b & -b <= a implies -1 <= a/b;

theorem 
  0 <= b & -a <= b implies -1 <= a/b;

theorem 
  b <= 0 & a <= -b implies -1 <= a/b;

theorem 
  b <= 0 & b <= -a implies -1 <= a/b;

theorem 
  0 < b & -b < a implies -1 < a/b;

theorem 
  0 < b & -a < b implies -1 < a/b;

theorem 
  b < 0 & a < -b implies -1 < a/b;

theorem 
  b < 0 & b < -a implies -1 < a/b;

theorem 
  0 < b & a <= -b implies a/b <= -1;

theorem 
  0 < b & b <= -a implies a/b <= -1;

theorem 
  b < 0 & -b <= a implies a/b <= -1;

theorem 
  b < 0 & -a <= b implies a/b <= -1;

theorem 
  0 < b & a < -b implies a/b < -1;

theorem 
  0 < b & b < -a implies a/b < -1;

theorem 
  b < 0 & -b < a implies a/b < -1;

theorem 
  b < 0 & -a < b implies a/b < -1;

begin

theorem 
  (for a being real number st 0 < a & a < 1 holds c <= b/a)
  implies c <= b;

theorem 
  (for a being real number st 1 < a holds b/a <= c) implies b <= c;

theorem 
  1 <= a implies a" <= 1;

theorem 
  1 < a implies a" < 1;

theorem 
  a <= -1 implies -1 <= a";

theorem 
  a < -1 implies -1 < a";

begin

theorem 
  0 < a implies 0 < a/2;

theorem 
  0 < a implies a/2 < a;

theorem 
  a <= 1/2 implies 2 * a - 1 <= 0;

theorem 
  a <= 1/2 implies 0 <= 1 - 2 * a;

theorem 
  a >= 1/2 implies 2 * a - 1 >= 0;

theorem 
  a >= 1/2 implies 0 >= 1 - 2 * a;

begin

theorem 
  0 < a implies a/3 < a;

theorem 
  0 < a implies 0 < a/3;

begin

theorem 
  0 < a implies a/4 < a;

theorem 
  0 < a implies 0 < a/4;

theorem 
  for a,b st b<>0 ex c st a=b/c;

begin 



theorem 
  r<s implies r < (r+s)/2 & (r+s)/2 < s;



registration
  cluster -> ext-real for Element of REAL;
end;

reserve p,q,r,s,t for ext-real number;

theorem 
  r < t implies ex s st r < s & s < t;

theorem 
  r < s & (for q st r < q & q < s holds t <= q) implies t <= r;

theorem 
  r < s & (for q st r < q & q < s holds q <= t) implies s <= t;



theorem 
  0 <= a & b <= c implies b-a <= c;

theorem 
  0 < a & b <= c implies b-a < c;

begin

theorem 
  a -' a = 0;

theorem 
  b <= a implies a -' b = a - b;

theorem 
  c <= a & c <= b & a -' c = b -' c implies a = b;

theorem 
  a >= b implies a -' b + b = a;



theorem 
  a <= b & c < a implies b -' a < b -' c;



theorem 
 1 <= a implies a -' 1 < a;














begin

reserve r,s for real number;

reserve x,y,z for real number,
  k for Nat,
  i for Element of NAT;

reserve r,r1,r2 for Element of REAL+;

theorem 
  for X,Y being Subset of REAL st for x,y st x in X & y in Y holds x <=
  y ex z st for x,y st x in X & y in Y holds x <= z & z <= y;

theorem 
  x in NAT & y in NAT implies x + y in NAT;

theorem 
  for A being Subset of REAL st 0 in A & for x st x in A holds x + 1 in
  A holds NAT c= A;

theorem 
  k = { i: i < k };














begin

registration
  cluster -> real for Element of REAL;
end;

definition
  mode Real is Element of REAL;
end;

registration
  cluster positive for Real;
end;

definition
  let x be Real;
  redefine func -x -> Real;
  redefine func x" -> Real;
end;

definition
  let x be real number, y be Real;
  redefine func x+y -> Real;
  redefine func x*y -> Real;
  redefine func x-y -> Real;
  redefine func x/y -> Real;
end;

definition
  let x be Real, y be real number;
  redefine func x+y -> Real;
  redefine func x*y -> Real;
  redefine func x-y -> Real;
  redefine func x/y -> Real;
end;



reserve s,t for Element of RAT+;

theorem 
  REAL+ = { r where r is Real: 0 <= r};















begin

reserve a,b,c,x,y,z for real number;

scheme 

  RealContinuity { P[set], Q[set] } :
  ex z st for x,y st P[x] & Q[y] holds x <= z & z <= y
provided
 for x,y st P[x] & Q[y] holds x <= y;

definition
  let x,y be Element of REAL;
  redefine func min(x,y) -> Element of REAL;
  redefine func max(x,y) -> Element of REAL;
end;

theorem 
  min(x,y) + max(x,y) = x + y;

theorem 
  for x,y being real number st 0 <= x & 0 <= y holds max(x,y) <= x + y;

definition
  let x be complex number;

  func x^2 equals

  x * x;
end;

registration
  let x be complex number;
  cluster x^2 -> complex;
end;

registration
  let x;
  cluster x^2 -> real;
end;

definition
  let x be Element of COMPLEX;
  redefine func x^2 -> Element of COMPLEX;
end;

definition
  let x be Element of REAL;
  redefine func x^2 -> Element of REAL;
end;

theorem 
  for a being complex number holds a^2 = (-a)^2;

theorem 
  for a, b being complex number holds (a + b)^2 = a^2 + 2*a*b + b^2;

theorem 
  for a, b being complex number holds (a - b)^2 = a^2 - 2*a*b + b^2;

theorem 
  for a being complex number holds (a + 1)^2 = a^2 + 2*a + 1;

theorem 
  for a being complex number holds (a - 1)^2 = a^2 - 2*a + 1;

theorem 
  for a, b being complex number holds (a - b)*(a + b) = a^2 - b^2;

theorem 
  for a, b being complex number holds (a*b)^2 = a^2*b^2;

theorem 
  for a, b being complex number st a^2 - b^2 <> 0 holds
    1/(a+b) = (a-b)/(a^2-b^2);

theorem 
  for a, b being complex number st a^2-b^2 <> 0 holds 1/(a-b) = (a+b)/(a^2-b^2)
;

theorem 
  0 <> a implies 0 < a^2;

theorem 
  0 < a & a < 1 implies a^2 < a;

theorem 
  1 < a implies a < a^2;

theorem 
  0 <= x & x <= y implies x^2 <= y^2;

theorem 
  0 <= x & x < y implies x^2 < y^2;

definition
  let a;
  assume
 0 <= a;
  func sqrt a -> real number means


  0 <= it & it^2 = a;
end;

definition
  let a be Element of REAL;
  redefine func sqrt a -> Element of REAL;
end;

theorem 
  sqrt 0 = 0;

theorem 
  sqrt 1 = 1;

theorem 
  1 < sqrt 2;

theorem 
  sqrt 4 = 2;

theorem 
  sqrt 2 < 2;

theorem 
  0 <= a implies sqrt a^2 = a;

theorem 
  a <= 0 implies sqrt a^2 = -a;

theorem 
  0 <= a & sqrt a = 0 implies a = 0;

theorem 
  0 < a implies 0 < sqrt a;

theorem 
  0 <= x & x <= y implies sqrt x <= sqrt y;

theorem 
  0 <= x & x < y implies sqrt x < sqrt y;

theorem 
  0 <= x & 0 <= y & sqrt x = sqrt y implies x = y;

theorem 
  0 <= a & 0 <= b implies sqrt (a*b) = sqrt a * sqrt b;

theorem 
  0 <= a & 0 <= b implies sqrt (a/b) = sqrt a/sqrt b;

theorem 
  for a,b being real number st 0 <= a & 0 <= b holds
    sqrt(a + b) = 0 iff a = 0 & b = 0;

theorem 
  0 < a implies sqrt (1/a) = 1/sqrt a;

theorem 
  0 < a implies sqrt a/a = 1/sqrt a;

theorem 
  0 < a implies a / sqrt a = sqrt a;

theorem 
  0 <= a & 0 <= b implies (sqrt a - sqrt b)*(sqrt a + sqrt b) = a - b;

theorem 
  0 <= a & 0 <= b & a <>b implies 1/(sqrt a+sqrt b) = (sqrt a - sqrt b)/ (a-b);

theorem 
  0 <= b & b < a implies 1/(sqrt a+sqrt b) = (sqrt a - sqrt b)/(a-b);

theorem 
  0 <= a & 0 <= b implies 1/(sqrt a-sqrt b) = (sqrt a + sqrt b)/(a-b);

theorem 
  0 <= b & b < a implies 1/(sqrt a-sqrt b) = (sqrt a + sqrt b)/(a-b);

theorem 
  for x,y being complex number st x^2=y^2 holds x=y or x=-y;

theorem 
  for x being complex number st x^2=1 holds x=1 or x=-1;

theorem 
  0<=x & x<=1 implies x^2<=x;

theorem 
  x^2-1<=0 implies -1<=x & x<=1;

begin 


theorem 
  a <= 0 & x < a implies x^2 > a^2;



theorem 
  -1 >= a implies -a <= a^2;

theorem 
  -1 > a implies -a < a^2;

theorem 
  b^2 <= a^2 & a >= 0 implies -a <= b & b <= a;

theorem 
  b^2 < a^2 & a >= 0 implies -a < b & b < a;

theorem 
  -a <= b & b <= a implies b^2 <= a^2;

theorem 
  -a < b & b < a implies b^2 < a^2;



theorem 
  a^2 <= 1 implies -1 <= a & a <= 1;

theorem 
  a^2 < 1 implies -1 < a & a < 1;



theorem 
  -1 <= a & a <= 1 & -1 <= b & b <= 1 implies a^2*b^2 <= 1;

theorem 
  a >= 0 & b >= 0 implies a*sqrt(b) = sqrt(a^2*b);

theorem 
  -1 <= a & a <= 1 & -1 <= b & b <= 1 implies (-b)*sqrt(1+a^2) <=
  sqrt(1+b^2) & -sqrt(1+b^2) <= b*sqrt(1+a^2);

theorem 
  -1 <= a & a <= 1 & -1 <= b & b <= 1 implies b*sqrt(1+a^2) <= sqrt(1+b^2);

theorem 
  a >= b implies a*sqrt(1+b^2) >= b*sqrt(1+a^2);

theorem 
 a >= 0 implies sqrt(a+b^2) >= b;



theorem 
  0 <= a & 0 <= b implies sqrt(a+b) <= sqrt a + sqrt b;















begin

reserve x for Real,
  p,k,l,m,n,s,h,i,j,k1,t,t1 for Nat,
  X for Subset of REAL;



theorem 
  for X st 0 in X & for x st x in X holds x + 1 in X for n holds n in X;





registration
  let n,k be Nat;
  cluster n + k -> natural;
end;

definition
  let n be Nat, k be Element of NAT;
  redefine func n + k -> Element of NAT;
end;

definition
  let n be Element of NAT, k be Nat;
  redefine func n + k -> Element of NAT;
end;




scheme 

  Ind { P[Nat] } : for k being Element of NAT holds P[k]
provided
 P[0] and
 for k being Element of NAT st P[k] holds P[k + 1];

scheme 

  NatInd { P[Nat] } : for k being Nat holds P[k]
provided
 P[0] and
 for k be Nat st P[k] holds P[k + 1];




registration
  let n,k be Nat;
  cluster n * k -> natural;
end;

definition
  let n be Nat, k be Element of NAT;
  redefine func n * k -> Element of NAT;
end;

definition
  let n be Element of NAT, k be Nat;
  redefine func n * k -> Element of NAT;
end;





theorem 
  0 <= i;

theorem 
  0 <> i implies 0 < i;

theorem 
  i <= j implies i * h <= j * h;

theorem 
  0 < i + 1;

theorem 
  i = 0 or ex k st i = k + 1;

theorem 
  i + j = 0 implies i = 0 & j = 0;

registration
  cluster non zero for Nat;
end;

registration
  let m be Nat, n be non zero Nat;
  cluster m + n -> non zero;
  cluster n + m -> non zero;
end;

scheme 

  DefbyInd { N()->Nat, F(Nat,Nat)->Nat, P[Nat,Nat] } : (for k being Nat ex n
  being Nat st P[k,n]) & for k,n,m being Nat st P[k,n] & P[k,m] holds n = m
provided
 for k,n being Nat holds P[k,n] iff k = 0 & n = N() or ex m,l being
Nat st k = m + 1 & P[m,l] & n = F(k,l);

theorem 
  i <= j + 1 implies i <= j or i = j + 1;

theorem 
  i <= j & j <= i + 1 implies i = j or j = i + 1;

theorem 
  i <= j implies ex k st j = i + k;

theorem 
  i <= i + j;

scheme 

  CompInd { P[Nat] } : for k being Nat holds P[k]
provided
 for k being Nat st for n being Nat st n < k holds P[n] holds P[k];



scheme 

 Min { P[Nat] } : ex k being Nat st P[k] & for n being Nat st P[n] holds k <= n
provided
 ex k being Nat st P[k];



scheme 

  Max { P[Nat], N()->Nat } : ex k being Nat st P[k] & for n being Nat st P[n]
  holds n <= k
provided
 for k being Nat st P[k] holds k <= N() and
 ex k being Nat st P[k];

theorem 
  i <= j implies i <= j + h;

theorem 
  i < j + 1 iff i <= j;

theorem 
  j < 1 implies j = 0;

theorem 
  i * j = 1 implies i = 1;

theorem 
  k <> 0 implies n < n + k;

scheme 

  Regr { P[Nat] } : P[0]
provided
 ex k being Nat st P[k] and
 for k being Nat st k <> 0 & P[k] ex n being Nat st n < k & P[n];



theorem 
  0 < m implies for n ex k,t st n = (m*k)+t & t < m;

theorem 
  n = m*k+t & t < m & n = m*k1+t1 & t1 < m implies k = k1 & t = t1;

registration
  cluster -> ordinal for Nat;
end;

registration
  cluster non empty ordinal for Subset of REAL;
end;

theorem 
  k < k + n iff 1 <= n;

theorem 
  k < n implies n - 1 is Element of NAT;

theorem 
  k <= n implies n - k is Element of NAT;

begin 



theorem 
  m < n+1 implies m < n or m = n;

theorem 
  k < 2 implies k = 0 or k = 1;

registration
  cluster non zero for Element of NAT;
end;

registration
  cluster -> non negative for Element of NAT;
end;

registration
  cluster -> non negative for Nat;
end;



theorem 
  i <> 0 & h = j*i implies j <= h;





scheme 

  Ind1{M() -> Nat, P[Nat]} : for i being Nat st M() <= i holds P[i]
provided
 P[M()] and
 for j being Nat st M() <= j holds P[j] implies P[j+1];



scheme 

  CompInd1 { a() -> Nat, P[Nat] } : for k being Nat st k >= a() holds P[k]
provided
 for k being Nat st k>=a() & (for n being Nat st n>=a() & n<k holds P
[n]) holds P[k];



theorem 
  n <= 1 implies n = 0 or n = 1;

theorem 
  n <= 2 implies n = 0 or n = 1 or n = 2;

theorem 
  n <= 3 implies n = 0 or n = 1 or n = 2 or n = 3;

theorem 
  n <= 4 implies n = 0 or n = 1 or n = 2 or n = 3 or n = 4;

theorem 
  n <= 5 implies n = 0 or n = 1 or n = 2 or n = 3 or n = 4 or n =
  5;

theorem 
  n <= 6 implies n = 0 or n = 1 or n = 2 or n = 3 or n = 4 or n =
  5 or n = 6;

theorem 
  n <= 7 implies n = 0 or n = 1 or n = 2 or n = 3 or n = 4 or n =
  5 or n = 6 or n = 7;

theorem 
  n <= 8 implies n = 0 or n = 1 or n = 2 or n = 3 or n = 4 or n =
  5 or n = 6 or n = 7 or n = 8;

theorem 
  n <= 9 implies n = 0 or n = 1 or n = 2 or n = 3 or n = 4 or n =
  5 or n = 6 or n = 7 or n = 8 or n = 9;

theorem 
  n <= 10 implies n = 0 or n = 1 or n = 2 or n = 3 or n = 4 or n =
  5 or n = 6 or n = 7 or n = 8 or n = 9 or n = 10;

theorem 
  n <= 11 implies n = 0 or n = 1 or n = 2 or n = 3 or n = 4 or n =
  5 or n = 6 or n = 7 or n = 8 or n = 9 or n = 10 or n = 11;

theorem 
  n <= 12 implies n = 0 or n = 1 or n = 2 or n = 3 or n = 4 or n =
  5 or n = 6 or n = 7 or n = 8 or n = 9 or n = 10 or n = 11 or n = 12;

theorem 
  n <= 13 implies n = 0 or n = 1 or n = 2 or n = 3 or n = 4 or n = 5 or
  n = 6 or n = 7 or n = 8 or n = 9 or n = 10 or n = 11 or n = 12 or n = 13;



scheme 

  Indfrom1 { P[Nat] } : for k being non empty Nat holds P[k]
provided
 ( P[1]) and
 for k being non empty Nat st P[k] holds P[k + 1];



definition
  let A be set;
  func min* A -> Element of NAT means

  it in A & for k st k in A holds it <= k
  if A is non empty Subset of NAT otherwise it = 0;
end;



reserve x,X,Y,Z for set;

theorem 
  for n being Nat holds succ n = n + 1;

theorem 
  n <= m iff n c= m;

theorem 
  card n c= card m iff n <= m;

theorem 
  card n in card m iff n < m;

reserve M,N for Cardinal;

theorem 
  nextcard card n = card(n+1);

definition
  let n be Nat;
  redefine func succ n equals

  n+1;
end;

theorem 
  for X,Y being finite set holds X c= Y implies card X <= card Y;

reserve l for Element of NAT;

theorem 
  k in n iff k < n;

theorem 
  n in n+1;

theorem 
  k <= n implies k = k /\ n;



scheme 

  LambdaRecEx{A() -> set,G(set,set) -> set}: ex f being Function st dom f =
  NAT & f.0 = A() & for n being Nat holds f.(n+1) = G(n,f.n);

scheme 

  LambdaRecExD{D() -> non empty set, A() -> Element of D(), G(set,set) ->
Element of D()}: ex f being Function of NAT,D() st f.0 = A() & for n being Nat
  holds f.(n+1) = G(n,f.n);

scheme 

  RecUn{A() -> set, F, G() -> Function, P[set,set,set]}: F() = G()
provided
 dom F() = NAT and
 F().0 = A() and
 for n holds P[n,F().n,F().(n+1)] and
 dom G() = NAT and
 G().0 = A() and
 for n holds P[n,G().n,G().(n+1)] and
 for n for x,y1,y2 being set st P[n,x,y1] & P[n,x,y2] holds y1 = y2;

scheme 

  RecUnD{D() -> non empty set,A() -> Element of D(), P[set,set,set], F, G() ->
  Function of NAT,D()} : F() = G()
provided
 F().0 = A() and
 for n holds P[n,F().n,F().(n+1)] and
 G().0 = A() and
 for n holds P[n,G().n,G().(n+1)] and
 for n being Nat,x,y1,y2 being Element of D() st P[n,x,y1] & P[n,x,y2
] holds y1=y2;

scheme 

  LambdaRecUn{A() -> set, RecFun(set,set) -> set, F, G() -> Function}: F() = G
  ()
provided
 dom F() = NAT and
 F().0 = A() and
 for n holds F().(n+1) = RecFun(n,F().n) and
 dom G() = NAT and
 G().0 = A() and
 for n holds G().(n+1) = RecFun(n,G().n);

scheme 

  LambdaRecUnD{D() -> non empty set,A() -> Element of D(), RecFun(set,set) ->
  Element of D(), F, G() -> Function of NAT,D()}: F() = G()
provided
 F().0 = A() and
 for n holds F().(n+1) = RecFun(n,F().n) and
 G().0 = A() and
 for n holds G().(n+1) = RecFun(n,G().n);



registration
  let x,y be Nat;
  cluster min(x,y) -> natural;
  cluster max(x,y) -> natural;
end;

definition
  let x,y be Element of NAT;
  redefine func min(x,y) -> Element of NAT;
  redefine func max(x,y) -> Element of NAT;
end;



scheme 

  MinIndex { F(Nat)->Nat} : ex k st F(k)=0 & for n st F(n)=0 holds k <= n
provided
 for k holds (F(k+1) < F(k) or F(k) = 0);



definition
  let D be set, f be Function of NAT,D;
  let n be Nat;
  redefine func f.n -> Element of D;
end;



definition
  let X be set;
  mode sequence of X is Function of NAT, X;
end;




definition
  let s be ManySortedSet of NAT, k be Nat;
  func s ^\ k -> ManySortedSet of NAT means


  for n being Nat holds it.n=s.(n+k);
end;

registration
 let X be non empty set, s be X-valued ManySortedSet of NAT, k be Nat;
 cluster s ^\ k -> X-valued;
end;

definition
 let X be non empty set, s be sequence of X, k be Nat;
 redefine func s ^\ k -> sequence of X;
end;

reserve X for non empty set,
  s for sequence of X,
  k,m for Nat;

theorem 
  s^\0 =s;

theorem 
  s ^\k^\m = s^\(k+m);

theorem 
  s^\k^\m = s^\m^\k;

registration let N be sequence of NAT; let X,s;
 cluster s * N -> Function-like NAT-defined X-valued;
end;

registration let N be sequence of NAT; let X,s;
 cluster s * N -> total;
end;






theorem 
  for N being sequence of NAT holds (s * N) ^\k = s * (N ^\k);

theorem 
  s.n in rng s;

theorem 
  (for n holds s.n in Y) implies rng s c= Y;



theorem 
  for n being Nat holds n is non zero implies n = 1 or n > 1;

theorem 
 succ n = {l : l <= n};

scheme 
 MinPred { F(Element of NAT) -> Element of NAT, P[set]} :
  ex k be Element of NAT st P[k] &
    for n be Element of NAT st P[n] holds k <= n
provided
 for k be Element of NAT holds F(k+1) < F(k) or P[k];

registration let k be Ordinal, x be set;
  cluster k --> x -> T-Sequence-like;
end;

theorem 
  for s be ManySortedSet of NAT, k be Nat
   holds rng(s ^\ k) c= rng s;



theorem 
  for n,m st n<=m & m<=n+2 holds m=n or m=n+1 or m=n+2;

theorem 
  for n,m st n<=m & m<=n+3 holds m=n or m=n+1 or m=n+2 or m=n+3;

theorem 
  for n,m st n<=m & m<=n+4 holds m=n or m=n+1 or m=n+2 or m=n+3 or m=n+4;



theorem 
  for X being finite set st 1 < card X holds ex x1,x2 being set st
  x1 in X & x2 in X & x1 <> x2;

theorem 
  n <= 14 implies n = 0 or n = 1 or n = 2 or n = 3 or n = 4 or n = 5 or
  n = 6 or n = 7 or n = 8 or n = 9 or n = 10 or n = 11 or n = 12 or n = 13
   or n = 14;















begin

reserve X,x,y,z for set,
  k,l,n for Element of NAT,
  r for real number;

definition
  redefine func INT means


  x in it iff ex k st x = k or x = - k;
end;

definition
  let i be number;
  attr i is integer means


  i in INT;
end;

registration
  cluster integer for Real;
  cluster integer for number;
  cluster -> integer for Element of INT;
end;

definition
  mode Integer is integer number;
end;

theorem 
  for k being Nat st r = k or r = -k holds r is Integer;

theorem 
  r is Integer implies ex k st r = k or r = - k;



registration
  cluster natural -> integer for number;
end;

registration
  cluster integer -> real for number;
end;

reserve i,i0,i1,i2,i3,i4,i5,i8,i9,j for Integer;

registration
  let i1,i2 be Integer;
  cluster i1 + i2 -> integer;
  cluster i1 * i2 -> integer;
end;

registration
  let i0 be Integer;
  cluster - i0 -> integer;
end;

registration
  let i1,i2 be Integer;
  cluster i1 - i2 -> integer;
end;



theorem 
  0 <= i0 implies i0 in NAT;

theorem 
  r is Integer implies r + 1 is Integer & r - 1 is Integer;

theorem 
  i2 <= i1 implies i1 - i2 in NAT;

theorem 
  i1 + k = i2 implies i1 <= i2;

theorem 
  i0 < i1 implies i0 + 1 <= i1;

theorem 
  i1 < 0 implies i1 <= - 1;

theorem 
  i1 * i2 = 1 iff i1 = 1 & i2 = 1 or i1 = - 1 & i2 = - 1;

theorem 
  i1 * i2 = - 1 iff i1 = - 1 & i2 = 1 or i1 = 1 & i2 = - 1;

scheme 

  SepInt { P[Integer] } : ex X being Subset of INT st for x being Integer
  holds x in X iff P[x];

scheme 

  IntIndUp { F() -> Integer, P[Integer] } : for i0 st F() <= i0 holds P[i0]
provided
 P[F()] and
 for i2 st F() <= i2 holds P[i2] implies P[i2 + 1];

scheme 

  IntIndDown { F() -> Integer, P[Integer] } : for i0 st i0 <= F() holds P[i0]
provided
 P[F()] and
 for i2 st i2 <= F() holds P[i2] implies P[i2 - 1];

scheme 

  IntIndFull { F() -> Integer, P[Integer] } : for i0 holds P[i0]
provided
 P[F()] and
 for i2 holds P[i2] implies P[i2 - 1] & P[i2 + 1];

scheme 

  IntMin { F() -> Integer, P[Integer] } : ex i0 st P[i0] & for i1 st P[i1]
  holds i0 <= i1
provided
 for i1 st P[i1] holds F() <= i1 and
 ex i1 st P[i1];

scheme 

  IntMax { F() -> Integer, P[Integer] } : ex i0 st P[i0] & for i1 st P[i1]
  holds i1 <= i0
provided
 for i1 st P[i1] holds i1 <= F() and
 ex i1 st P[i1];



definition
  let i1,i2 be Integer;
  pred i1 divides i2 means


  ex i3 st i2 = i1 * i3;
  reflexivity;
end;

definition
  let i1,i2,i3 be Integer;
  pred i1,i2 are_congruent_mod i3 means

  i3 divides i1 - i2;
end;

definition
  let i1,i2,i3 be Integer;
  redefine pred i1,i2 are_congruent_mod i3 means


  ex i4 st i3 * i4 = i1 - i2;
end;

theorem 
  i1,i1 are_congruent_mod i2;

theorem 
  i1,0 are_congruent_mod i1 & 0,i1 are_congruent_mod i1;

theorem 
  i1,i2 are_congruent_mod 1;

theorem 
  i1,i2 are_congruent_mod i3 implies i2,i1 are_congruent_mod i3;

theorem 
  i1,i2 are_congruent_mod i5 & i2,i3 are_congruent_mod i5 implies
  i1,i3 are_congruent_mod i5;

theorem 
  i1,i2 are_congruent_mod i5 & i3,i4 are_congruent_mod i5 implies
  (i1 + i3),(i2 + i4) are_congruent_mod i5;

theorem 
  i1,i2 are_congruent_mod i5 & i3,i4 are_congruent_mod i5 implies
  (i1 - i3),(i2 - i4) are_congruent_mod i5;

theorem 
  i1,i2 are_congruent_mod i5 & i3,i4 are_congruent_mod i5 implies
  (i1 * i3),(i2 * i4) are_congruent_mod i5;

theorem 
  (i1 + i2),i3 are_congruent_mod i5 iff i1, (i3 - i2) are_congruent_mod i5;

theorem 
  i4 * i5 = i3 implies (i1,i2 are_congruent_mod i3 implies
  i1,i2 are_congruent_mod i4);

theorem 
  i1,i2 are_congruent_mod i5 iff (i1 + i5),i2 are_congruent_mod i5;

theorem 
  i1,i2 are_congruent_mod i5 iff (i1 - i5),i2 are_congruent_mod i5;

theorem 
  i1 <= r & r - 1 < i1 & i2 <= r & r - 1 < i2 implies i1 = i2;

theorem 
  r <= i1 & i1 < r + 1 & r <= i2 & i2 < r + 1 implies i1 = i2;

reserve r1,p,p1,g,g1,g2 for real number,
  Y for Subset of REAL;

definition
  let r be real number;
  func [\ r /] -> Integer means


  it <= r & r - 1 < it;
  projectivity;
end;

theorem 
  [\ r /] = r iff r is integer;

theorem 
  [\ r /] < r iff r is not integer;

theorem 
  [\ r /] - 1 < r & [\ r /] < r + 1;

theorem 
  [\ r /] + i0 = [\ r + i0 /];

theorem 
  r < [\ r /] + 1;

definition
  let r be real number;
  func [/ r \] -> Integer means


  r <= it & it < r + 1;
  projectivity;
end;

theorem 
  [/ r \] = r iff r is integer;

theorem 
  r < [/ r \] iff r is not integer;

theorem 
  r - 1 < [/ r \] & r < [/ r \] + 1;

theorem 
  [/ r \] + i0 = [/ r + i0 \];

theorem 
  [\ r /] = [/ r \] iff r is integer;

theorem 
  [\ r /] < [/ r \] iff r is not integer;

theorem 
  [\ r /] <= [/ r \];

theorem 
  [\ ([/ r \]) /] = [/ r \];

canceled 2;

theorem 
  [/ ([\ r /]) \] = [\ r /];

theorem 
  [\ r /] = [/ r \] iff not [\ r /] + 1 = [/ r \];

definition
  let r be real number;
  func frac r equals

  r - [\ r /];
end;

registration
  let r be real number;
  cluster frac r -> real;
end;

definition
  let r be real number;
  redefine func frac r -> Real;
end;

theorem 
  r = [\ r /] + frac r;

theorem 
  frac r < 1 & 0 <= frac r;

theorem 
  [\ frac r /] = 0;

theorem 
  frac r = 0 iff r is integer;

theorem 
  0 < frac r iff r is not integer;



definition
  let i1,i2 be Integer;
  func i1 div i2 -> Integer equals

  [\ i1 / i2 /];
end;

definition
  let i1,i2 be Integer;
  func i1 mod i2 -> Integer equals


  i1 - (i1 div i2) * i2 if i2 <> 0
  otherwise 0;
end;

theorem 
  for r being real number st r <> 0 holds [\ r / r /] = 1;

theorem 
  for i being Integer holds i div 0 = 0;

theorem 
  for i being Integer st i <> 0 holds i div i = 1;

theorem 
  for i being Integer holds i mod i = 0;

begin 


theorem 
  for k, i being Integer holds
  k < i implies ex j being Element of NAT st j = i-k & 1 <= j;



theorem 
  for a,b being Integer st a < b holds a <= b - 1;



theorem 
  for r being real number st r>=0 holds [/ r \]>=0 & [\ r /]>=0 &
  [/ r \] is Element of NAT & [\ r /] is Element of NAT;



theorem 
  for i being Integer, r being real number st i <= r holds i <= [\ r /];

theorem 
  for m,n being Nat holds 0 <= m qua Integer div n;



theorem 
  0 < i & 1 < j implies i div j < i;



theorem 
  i2 >= 0 implies i1 mod i2 >= 0;

theorem 
  i2 > 0 implies i1 mod i2 < i2;

theorem 
  i2 <> 0 implies i1 = (i1 div i2) * i2 + (i1 mod i2);



theorem 
  for m,j being Integer holds m*j, 0 are_congruent_mod m;



theorem 
  i >= 0 & j >= 0 implies i div j >= 0;



theorem 
  for n being Nat st n > 0 for a being Integer holds a mod n
  = 0 iff n divides a;



reserve r, s for real number;

theorem 
  r/s is not Integer implies - [\ r/s /] = [\ (-r) / s /] + 1;

theorem 
  r/s is Integer implies - [\ r/s /] = [\ (-r) / s /];



theorem 
  r <= i implies [/ r \] <= i;



scheme 

  FinInd{M, N() -> Element of NAT, P[Nat]} : for i being Element of NAT st M()
  <= i & i <= N() holds P[i]
provided
 P[M()] and
 for j being Element of NAT st M() <= j & j < N() holds P[j] implies P[j+1];

scheme 

  FinInd2{M,N() -> Element of NAT, P[Nat]} : for i being Element of NAT st M()
  <= i & i <= N() holds P[i]
provided
 P[M()] and
 for j being Element of NAT st M() <= j & j < N() holds (for j9 being
Element of NAT st M() <= j9 & j9 <= j holds P[j9]) implies P[j+1];



reserve i for Integer,
  a, b, r, s for real number;

theorem 
  frac(r+i) = frac r;

theorem 
  r <= a & a < [\r/]+1 implies [\a/] = [\r/];

theorem 
  r <= a & a < [\r/]+1 implies frac r <= frac a;

theorem 
  r < a & a < [\r/]+1 implies frac r < frac a;

theorem 
  a >= [\r/]+1 & a <= r+1 implies [\a/] = [\r/]+1;

theorem 
  a >= [\r/]+1 & a < r+1 implies frac a < frac r;

theorem 
  r <= a & a < r+1 & r <= b & b < r+1 & frac a = frac b implies a = b;















begin

reserve x for set,
  a,b for real number,
  k,k1,l,l1 for Element of NAT,
  m,m1,n, n1 for Integer;




reserve i1,j1 for Element of NAT;

definition
  redefine func RAT means


  x in it iff ex m,n st x = m/n;
end;

definition
  let r be number;
  attr r is rational means


  r in RAT;
end;

registration
  cluster rational for Real;
end;

registration
  cluster rational for number;
end;

definition
  mode Rational is rational number;
end;

theorem 
  x in RAT implies ex m,n st n<>0 & x = m/n;

theorem 
  x is Rational implies ex m,n st n<>0 & x = m/n;

registration
  cluster rational -> real for number;
end;

theorem 
  m/n is rational;

registration
  cluster integer -> rational for number;
end;

reserve p,q for Rational;




registration
  let p,q;
  cluster p*q -> rational;
  cluster p+q -> rational;
  cluster p-q -> rational;
  cluster p/q -> rational;
end;

registration
  let p;
  cluster -p -> rational;
  cluster p" -> rational;
end;

canceled 3;




theorem 
  a<b implies ex p st a<p & p<b;

theorem 
  ex m,k st k<>0 & p=m/k;







theorem 
  ex m,k st k<>0 & p=m/k & for n,l st l<>0 & p=n/l holds k<=l;

definition
  let p;
  func denominator(p) -> Element of NAT means


  it<>0 & (ex m st p=m/it) & for n,k st k<>0 & p=n/k holds it<=k;
end;

definition
  let p;
  func numerator(p) -> Integer equals

  denominator(p)*p;
end;



theorem 
  0<denominator(p);

theorem 
  1<=denominator(p);

theorem 
  0<denominator(p)";

theorem 
  1>=denominator(p)";

theorem 
  numerator(p)=0 iff p=0;

theorem 
  p=numerator(p)/denominator(p) & p=numerator(p)*denominator(p)" &
  p=denominator(p)"*numerator(p);

theorem 
  p<>0 implies denominator(p)=numerator(p)/p;

theorem 
  p is Integer implies denominator(p)=1 & numerator(p)=p;

theorem 
  (numerator(p)=p or denominator(p)=1) implies p is Integer;

theorem 
  numerator(p)=p iff denominator(p)=1;

theorem 
  (numerator(p)=p or denominator(p)=1) & 0<=p implies p is Element of NAT;

theorem 
  1<denominator(p) iff p is not integer;

theorem 
  1>denominator(p)" iff p is not integer;

theorem 
  numerator(p)=denominator(p) iff p=1;

theorem 
  numerator(p)=-denominator(p) iff p=-1;

theorem 
  -numerator(p)=denominator(p) iff p=-1;




theorem 
  m<>0 implies p=(numerator(p)*m)/(denominator(p)*m);

theorem 
  k<>0 & p=m/k implies ex l st m=numerator(p)*l & k=denominator(p) *l;

theorem 
  p=m/n & n<>0 implies ex m1 st m=numerator(p)*m1 & n=denominator(p)*m1;



theorem 
  not ex l st 1<l & ex m,k st numerator(p)=m*l & denominator(p)=k* l;

theorem 
  (p=m/k & k<>0 & not ex l st 1<l & ex m1,k1 st m=m1*l & k=k1*l)
  implies k=denominator(p) & m=numerator(p);

theorem 
  p<-1 iff numerator(p)<-denominator(p);

theorem 
  p<=-1 iff numerator(p)<=-denominator(p);

theorem 
  p<-1 iff denominator(p)<-numerator(p);

theorem 
  p<=-1 iff denominator(p)<=-numerator(p);

theorem 
  p<1 iff numerator(p)<denominator(p);

theorem 
  p<=1 iff numerator(p)<=denominator(p);

theorem 
  p<0 iff numerator(p)<0;

theorem 
  p<=0 iff numerator(p)<=0;

theorem 
  a<p iff a*denominator(p)<numerator(p);

theorem 
  a<=p iff a*denominator(p)<=numerator(p);

theorem 
  denominator p=denominator q & numerator p=numerator q implies p = q;

theorem 
  p<q iff numerator(p)*denominator(q)<numerator(q)*denominator(p);

theorem 
  denominator(-p)=denominator(p) & numerator(-p)=-numerator(p);

theorem 
  0<p & q=1/p iff numerator(q)=denominator(p) & denominator(q)= numerator(p);

theorem 
  p<0 & q=1/p iff numerator(q)=-denominator(p) & denominator(q)=- numerator(p);














begin

reserve x, X, F for set;

definition
  let X be set;
  attr X is complex-membered means


  x in X implies x is complex;
  attr X is ext-real-membered means


  x in X implies x is ext-real;
  attr X is real-membered means


  x in X implies x is real;
  attr X is rational-membered means


  x in X implies x is rational;
  attr X is integer-membered means


  x in X implies x is integer;
  attr X is natural-membered means


  x in X implies x is natural;
end;

registration
  cluster natural-membered -> integer-membered for set;
  cluster integer-membered -> rational-membered for set;
  cluster rational-membered -> real-membered for set;
  cluster real-membered -> ext-real-membered for set;
  cluster real-membered -> complex-membered for set;
end;

registration
  cluster non empty natural-membered for set;
end;

registration
  cluster -> complex-membered for Subset of COMPLEX;
  cluster -> ext-real-membered for Subset of ExtREAL;
  cluster -> real-membered for Subset of REAL;
  cluster -> rational-membered for Subset of RAT;
  cluster -> integer-membered for Subset of INT;
  cluster -> natural-membered for Subset of NAT;
end;

registration
  cluster COMPLEX -> complex-membered;
  cluster ExtREAL -> ext-real-membered;
  cluster REAL -> real-membered;
  cluster RAT -> rational-membered;
  cluster INT -> integer-membered;
  cluster NAT -> natural-membered;
end;

theorem 
  X is complex-membered implies X c= COMPLEX;

theorem 
  X is ext-real-membered implies X c= ExtREAL;

theorem 
  X is real-membered implies X c= REAL;

theorem 
  X is rational-membered implies X c= RAT;

theorem 
  X is integer-membered implies X c= INT;

theorem 
  X is natural-membered implies X c= NAT;

registration
  let X be complex-membered set;
  cluster -> complex for Element of X;
end;

registration
  let X be ext-real-membered set;
  cluster -> ext-real for Element of X;
end;

registration
  let X be real-membered set;
  cluster -> real for Element of X;
end;

registration
  let X be rational-membered set;
  cluster -> rational for Element of X;
end;

registration
  let X be integer-membered set;
  cluster -> integer for Element of X;
end;

registration
  let X be natural-membered set;
  cluster -> natural for Element of X;
end;

reserve c, c1, c2, c3 for complex number,
  e, e1, e2, e3 for ext-real number,
  r , r1, r2, r3 for real number,
  w, w1, w2, w3 for rational number,
  i, i1, i2, i3 for integer number,
  n, n1, n2, n3 for Nat;

theorem 
  for X being non empty complex-membered set ex c st c in X;

theorem 
  for X being non empty ext-real-membered set ex e st e in X;

theorem 
  for X being non empty real-membered set ex r st r in X;

theorem 
  for X being non empty rational-membered set ex w st w in X;

theorem 
  for X being non empty integer-membered set ex i st i in X;

theorem 
  for X being non empty natural-membered set ex n st n in X;

theorem 
  for X being complex-membered set st for c holds c in X holds X = COMPLEX;

theorem 
  for X being ext-real-membered set st for e holds e in X holds X = ExtREAL;

theorem 
  for X being real-membered set st for r holds r in X holds X = REAL;

theorem 
  for X being rational-membered set st for w holds w in X holds X = RAT;

theorem 
  for X being integer-membered set st for i holds i in X holds X = INT;

theorem 
  for X being natural-membered set st for n holds n in X holds X = NAT;

theorem 
  for Y being complex-membered set st X c= Y holds X is complex-membered;

theorem 
  for Y being ext-real-membered set st X c= Y holds X is ext-real-membered;

theorem 
  for Y being real-membered set st X c= Y holds X is real-membered;

theorem 
  for Y being rational-membered set st X c= Y holds X is rational-membered;

theorem 
  for Y being integer-membered set st X c= Y holds X is integer-membered;

theorem 
  for Y being natural-membered set st X c= Y holds X is natural-membered;

registration
  cluster empty -> natural-membered for set;
end;

registration
  let c;
  cluster {c} -> complex-membered;
end;

registration
  let e;
  cluster {e} -> ext-real-membered;
end;

registration
  let r;
  cluster {r} -> real-membered;
end;

registration
  let w;
  cluster {w} -> rational-membered;
end;

registration
  let i;
  cluster {i} -> integer-membered;
end;

registration
  let n;
  cluster {n} -> natural-membered;
end;

registration
  let c1,c2;
  cluster {c1,c2} -> complex-membered;
end;

registration
  let e1,e2;
  cluster {e1,e2} -> ext-real-membered;
end;

registration
  let r1,r2;
  cluster {r1,r2} -> real-membered;
end;

registration
  let w1,w2;
  cluster {w1,w2} -> rational-membered;
end;

registration
  let i1,i2;
  cluster {i1,i2} -> integer-membered;
end;

registration
  let n1,n2;
  cluster {n1,n2} -> natural-membered;
end;

registration
  let c1,c2,c3;
  cluster {c1,c2,c3} -> complex-membered;
end;

registration
  let e1,e2,e3;
  cluster {e1,e2,e3} -> ext-real-membered;
end;

registration
  let r1,r2,r3;
  cluster {r1,r2,r3} -> real-membered;
end;

registration
  let w1,w2,w3;
  cluster {w1,w2,w3} -> rational-membered;
end;

registration
  let i1,i2,i3;
  cluster {i1,i2,i3} -> integer-membered;
end;

registration
  let n1,n2,n3;
  cluster {n1,n2,n3} -> natural-membered;
end;

registration
  let X be complex-membered set;
  cluster -> complex-membered for Subset of X;
end;

registration
  let X be ext-real-membered set;
  cluster -> ext-real-membered for Subset of X;
end;

registration
  let X be real-membered set;
  cluster -> real-membered for Subset of X;
end;

registration
  let X be rational-membered set;
  cluster -> rational-membered for Subset of X;
end;

registration
  let X be integer-membered set;
  cluster -> integer-membered for Subset of X;
end;

registration
  let X be natural-membered set;
  cluster -> natural-membered for Subset of X;
end;

registration
  let X,Y be complex-membered set;
  cluster X \/ Y -> complex-membered;
end;

registration
  let X,Y be ext-real-membered set;
  cluster X \/ Y -> ext-real-membered;
end;

registration
  let X,Y be real-membered set;
  cluster X \/ Y -> real-membered;
end;

registration
  let X,Y be rational-membered set;
  cluster X \/ Y -> rational-membered;
end;

registration
  let X,Y be integer-membered set;
  cluster X \/ Y -> integer-membered;
end;

registration
  let X,Y be natural-membered set;
  cluster X \/ Y -> natural-membered;
end;

registration
  let X be complex-membered set, Y be set;
  cluster X /\ Y -> complex-membered;
  cluster Y /\ X -> complex-membered;
end;

registration
  let X be ext-real-membered set, Y be set;
  cluster X /\ Y -> ext-real-membered;
  cluster Y /\ X -> ext-real-membered;
end;

registration
  let X be real-membered set, Y be set;
  cluster X /\ Y -> real-membered;
  cluster Y /\ X -> real-membered;
end;

registration
  let X be rational-membered set, Y be set;
  cluster X /\ Y -> rational-membered;
  cluster Y /\ X -> rational-membered;
end;

registration
  let X be integer-membered set, Y be set;
  cluster X /\ Y -> integer-membered;
  cluster Y /\ X -> integer-membered;
end;

registration
  let X be natural-membered set, Y be set;
  cluster X /\ Y -> natural-membered;
  cluster Y /\ X -> natural-membered;
end;

registration
  let X be complex-membered set, Y be set;
  cluster X \ Y -> complex-membered;
end;

registration
  let X be ext-real-membered set, Y be set;
  cluster X \ Y -> ext-real-membered;
end;

registration
  let X be real-membered set, Y be set;
  cluster X \ Y -> real-membered;
end;

registration
  let X be rational-membered set, Y be set;
  cluster X \ Y -> rational-membered;
end;

registration
  let X be integer-membered set, Y be set;
  cluster X \ Y -> integer-membered;
end;

registration
  let X be natural-membered set, Y be set;
  cluster X \ Y -> natural-membered;
end;

registration
  let X,Y be complex-membered set;
  cluster X \+\ Y -> complex-membered;
end;

registration
  let X,Y be ext-real-membered set;
  cluster X \+\ Y -> ext-real-membered;
end;

registration
  let X,Y be real-membered set;
  cluster X \+\ Y -> real-membered;
end;

registration
  let X,Y be rational-membered set;
  cluster X \+\ Y -> rational-membered;
end;

registration
  let X,Y be integer-membered set;
  cluster X \+\ Y -> integer-membered;
end;

registration
  let X,Y be natural-membered set;
  cluster X \+\ Y -> natural-membered;
end;

definition
  let X be complex-membered set, Y be set;
  redefine pred X c= Y means


  c in X implies c in Y;
end;

definition
  let X be ext-real-membered set, Y be set;
  redefine pred X c= Y means


  e in X implies e in Y;
end;

definition
  let X be real-membered set, Y be set;
  redefine pred X c= Y means


  r in X implies r in Y;
end;

definition
  let X be rational-membered set, Y be set;
  redefine pred X c= Y means


  w in X implies w in Y;
end;

definition
  let X be integer-membered set, Y be set;
  redefine pred X c= Y means


  i in X implies i in Y;
end;

definition
  let X be natural-membered set, Y be set;
  redefine pred X c= Y means


  n in X implies n in Y;
end;

definition
  let X,Y be complex-membered set;
  redefine pred X = Y means

  c in X iff c in Y;
end;

definition
  let X,Y be ext-real-membered set;
  redefine pred X = Y means

  e in X iff e in Y;
end;

definition
  let X,Y be real-membered set;
  redefine pred X = Y means

  r in X iff r in Y;
end;

definition
  let X,Y be rational-membered set;
  redefine pred X = Y means

  w in X iff w in Y;
end;

definition
  let X,Y be integer-membered set;
  redefine pred X = Y means

  i in X iff i in Y;
end;

definition
  let X,Y be natural-membered set;
  redefine pred X = Y means

  n in X iff n in Y;
end;

definition
  let X,Y be complex-membered set;
  redefine pred X meets Y means

  ex c st c in X & c in Y;
end;

definition
  let X,Y be ext-real-membered set;
  redefine pred X meets Y means

  ex e st e in X & e in Y;
end;

definition
  let X,Y be real-membered set;
  redefine pred X meets Y means

  ex r st r in X & r in Y;
end;

definition
  let X,Y be rational-membered set;
  redefine pred X meets Y means

  ex w st w in X & w in Y;
end;

definition
  let X,Y be integer-membered set;
  redefine pred X meets Y means

  ex i st i in X & i in Y;
end;

definition
  let X,Y be natural-membered set;
  redefine pred X meets Y means

  ex n st n in X & n in Y;
end;

theorem 
  (for X st X in F holds X is complex-membered) implies union F is
  complex-membered;

theorem 
  (for X st X in F holds X is ext-real-membered) implies union F is
  ext-real-membered;

theorem 
  (for X st X in F holds X is real-membered) implies union F is real-membered;

theorem 
  (for X st X in F holds X is rational-membered) implies union F is
  rational-membered;

theorem 
  (for X st X in F holds X is integer-membered) implies union F is
  integer-membered;

theorem 
  (for X st X in F holds X is natural-membered) implies union F is
  natural-membered;

theorem 
  for X st X in F & X is complex-membered holds meet F is
  complex-membered;

theorem 
  for X st X in F & X is ext-real-membered holds meet F is
  ext-real-membered;

theorem 
  for X st X in F & X is real-membered holds meet F is real-membered;

theorem 
  for X st X in F & X is rational-membered holds meet F is
  rational-membered;

theorem 
  for X st X in F & X is integer-membered holds meet F is
  integer-membered;

theorem 
  for X st X in F & X is natural-membered holds meet F is
  natural-membered;

scheme 

  CMSeparation {P[set]}: ex X being complex-membered set st for c holds c in X
  iff P[c];

scheme 

  EMSeparation {P[set]}: ex X being ext-real-membered set st for e holds e in
  X iff P[e];

scheme 

  RMSeparation {P[set]}: ex X being real-membered set st for r holds r in X
  iff P[r];

scheme 

  WMSeparation {P[set]}: ex X being rational-membered set st for w holds w in
  X iff P[w];

scheme 

  IMSeparation {P[set]}: ex X being integer-membered set st for i holds i in X
  iff P[i];

scheme 

  NMSeparation {P[set]}: ex X being natural-membered set st for n holds n in X
  iff P[n];

registration
  cluster non empty natural-membered for set;
end;



registration
  cluster -> natural-membered for Element of NAT;
end;



reserve a,b,d for real number;

theorem 
  for X,Y being real-membered set st X<>{} & Y<>{} & for a,b st a in X &
b in Y holds a<=b holds ex d st (for a st a in X holds a<=d) & for b st b in Y
  holds d<=b;



definition
  let X be set;
  attr X is add-closed means

  for x, y being complex number st x in X & y in X holds x+y in X;
end;

registration
  cluster empty -> add-closed for set;
  cluster COMPLEX -> add-closed;
  cluster REAL -> add-closed;
  cluster RAT -> add-closed;
  cluster INT -> add-closed;
  cluster NAT -> add-closed;
  cluster non empty add-closed natural-membered for set;
end;














begin

definition
  let f be Relation;
  attr f is complex-valued means


  rng f c= COMPLEX;
  attr f is ext-real-valued means


  rng f c= ExtREAL;
  attr f is real-valued means


  rng f c= REAL;
  canceled 2;
  attr f is natural-valued means


  rng f c= NAT;
end;

registration
  cluster natural-valued -> INT-valued for Relation;
  cluster INT-valued -> RAT-valued for Relation;
  cluster INT-valued -> real-valued for Relation;
  cluster RAT-valued -> real-valued for Relation;
  cluster real-valued -> ext-real-valued for Relation;
  cluster real-valued -> complex-valued for Relation;
  cluster natural-valued -> RAT-valued for Relation;
  cluster natural-valued -> real-valued for Relation;
end;

registration
  cluster empty -> natural-valued for Relation;
end;

registration
  cluster natural-valued for Function;
end;

registration
  let R be complex-valued Relation;
  cluster rng R -> complex-membered;
end;

registration
  let R be ext-real-valued Relation;
  cluster rng R -> ext-real-membered;
end;

registration
  let R be real-valued Relation;
  cluster rng R -> real-membered;
end;

registration
  let R be RAT-valued Relation;
  cluster rng R -> rational-membered;
end;

registration
  let R be INT-valued Relation;
  cluster rng R -> integer-membered;
end;

registration
  let R be natural-valued Relation;
  cluster rng R -> natural-membered;
end;

reserve x,y,X for set,
  f for Function,
  R,S for Relation;

theorem 
  for S being complex-valued Relation st R c= S holds R is complex-valued;

theorem 
  for S being ext-real-valued Relation st R c= S holds R is ext-real-valued;

theorem 
  for S being real-valued Relation st R c= S holds R is real-valued;

theorem 
  for S being RAT-valued Relation st R c= S holds R is RAT-valued;

theorem 
  for S being INT-valued Relation st R c= S holds R is INT-valued;

theorem 
  for S being natural-valued Relation st R c= S holds R is natural-valued;

registration
  let R be complex-valued Relation;
  cluster -> complex-valued for Subset of R;
end;

registration
  let R be ext-real-valued Relation;
  cluster -> ext-real-valued for Subset of R;
end;

registration
  let R be real-valued Relation;
  cluster -> real-valued for Subset of R;
end;

registration
  let R be RAT-valued Relation;
  cluster -> RAT-valued for Subset of R;
end;

registration
  let R be INT-valued Relation;
  cluster -> INT-valued for Subset of R;
end;

registration
  let R be natural-valued Relation;
  cluster -> natural-valued for Subset of R;
end;

registration
  let R,S be complex-valued Relation;
  cluster R \/ S -> complex-valued;
end;

registration
  let R,S be ext-real-valued Relation;
  cluster R \/ S -> ext-real-valued;
end;

registration
  let R,S be real-valued Relation;
  cluster R \/ S -> real-valued;
end;

registration
  let R,S be RAT-valued Relation;
  cluster R \/ S -> RAT-valued;
end;

registration
  let R,S be INT-valued Relation;
  cluster R \/ S -> INT-valued;
end;

registration
  let R,S be natural-valued Relation;
  cluster R \/ S -> natural-valued;
end;

registration
  let R be complex-valued Relation;
  let S;
  cluster R /\ S -> complex-valued;
  cluster R \ S -> complex-valued;
end;

registration
  let R be ext-real-valued Relation;
  let S;
  cluster R /\ S -> ext-real-valued;
  cluster R \ S -> ext-real-valued;
end;

registration
  let R be real-valued Relation;
  let S;
  cluster R /\ S -> real-valued;
  cluster R \ S -> real-valued;
end;

registration
  let R be RAT-valued Relation;
  let S;
  cluster R /\ S -> RAT-valued;
  cluster R \ S -> RAT-valued;
end;

registration
  let R be INT-valued Relation;
  let S;
  cluster R /\ S -> INT-valued;
  cluster R \ S -> INT-valued;
end;

registration
  let R be natural-valued Relation;
  let S;
  cluster R /\ S -> natural-valued;
  cluster R \ S -> natural-valued;
end;

registration
  let R,S be complex-valued Relation;
  cluster R \+\ S -> complex-valued;
end;

registration
  let R,S be ext-real-valued Relation;
  cluster R \+\ S -> ext-real-valued;
end;

registration
  let R,S be real-valued Relation;
  cluster R \+\ S -> real-valued;
end;

registration
  let R,S be RAT-valued Relation;
  cluster R \+\ S -> RAT-valued;
end;

registration
  let R,S be INT-valued Relation;
  cluster R \+\ S -> INT-valued;
end;

registration
  let R,S be natural-valued Relation;
  cluster R \+\ S -> natural-valued;
end;

registration
  let R be complex-valued Relation;
  let X;
  cluster R.:X -> complex-membered;
end;

registration
  let R be ext-real-valued Relation;
  let X;
  cluster R.:X -> ext-real-membered;
end;

registration
  let R be real-valued Relation;
  let X;
  cluster R.:X -> real-membered;
end;

registration
  let R be RAT-valued Relation;
  let X;
  cluster R.:X -> rational-membered;
end;

registration
  let R be INT-valued Relation;
  let X;
  cluster R.:X -> integer-membered;
end;

registration
  let R be natural-valued Relation;
  let X;
  cluster R.:X -> natural-membered;
end;

registration
  let R be complex-valued Relation;
  let x;
  cluster Im(R,x) -> complex-membered;
end;

registration
  let R be ext-real-valued Relation;
  let x;
  cluster Im(R,x) -> ext-real-membered;
end;

registration
  let R be real-valued Relation;
  let x;
  cluster Im(R,x) -> real-membered;
end;

registration
  let R be RAT-valued Relation;
  let x;
  cluster Im(R,x) -> rational-membered;
end;

registration
  let R be INT-valued Relation;
  let x;
  cluster Im(R,x) -> integer-membered;
end;

registration
  let R be natural-valued Relation;
  let x;
  cluster Im(R,x) -> natural-membered;
end;

registration
  let R be complex-valued Relation;
  let X;
  cluster R|X -> complex-valued;
end;

registration
  let R be ext-real-valued Relation;
  let X;
  cluster R|X -> ext-real-valued;
end;

registration
  let R be real-valued Relation;
  let X;
  cluster R|X -> real-valued;
end;

registration
  let R be RAT-valued Relation;
  let X;
  cluster R|X -> RAT-valued;
end;

registration
  let R be INT-valued Relation;
  let X;
  cluster R|X -> INT-valued;
end;

registration
  let R be natural-valued Relation;
  let X;
  cluster R|X -> natural-valued;
end;

registration
  let X be complex-membered set;
  cluster id X -> complex-valued;
end;

registration
  let X be ext-real-membered set;
  cluster id X -> ext-real-valued;
end;

registration
  let X be real-membered set;
  cluster id X -> real-valued;
end;

registration
  let X be rational-membered set;
  cluster id X -> RAT-valued;
end;

registration
  let X be integer-membered set;
  cluster id X -> INT-valued;
end;

registration
  let X be natural-membered set;
  cluster id X -> natural-valued;
end;

registration
  let R;
  let S be complex-valued Relation;
  cluster R*S -> complex-valued;
end;

registration
  let R;
  let S be ext-real-valued Relation;
  cluster R*S -> ext-real-valued;
end;

registration
  let R;
  let S be real-valued Relation;
  cluster R*S -> real-valued;
end;

registration
  let R;
  let S be RAT-valued Relation;
  cluster R*S -> RAT-valued;
end;

registration
  let R;
  let S be INT-valued Relation;
  cluster R*S -> INT-valued;
end;

registration
  let R;
  let S be natural-valued Relation;
  cluster R*S -> natural-valued;
end;

definition
  let f be Function;
  redefine attr f is complex-valued means


  for x st x in dom f holds f.x is complex;
  redefine attr f is ext-real-valued means


  for x st x in dom f holds f.x is ext-real;
  redefine attr f is real-valued means


  for x st x in dom f holds f.x is real;
  canceled 2;
  redefine attr f is natural-valued means


  for x st x in dom f holds f.x is natural;
end;

theorem 
  f is complex-valued iff for x holds f.x is complex;

theorem 
  f is ext-real-valued iff for x holds f.x is ext-real;

theorem 
  f is real-valued iff for x holds f.x is real;

theorem 
  f is RAT-valued iff for x holds f.x is rational;

theorem 
  f is INT-valued iff for x holds f.x is integer;

theorem 
  f is natural-valued iff for x holds f.x is natural;

registration
  let f be complex-valued Function;
  let x;
  cluster f.x -> complex;
end;

registration
  let f be ext-real-valued Function;
  let x;
  cluster f.x -> ext-real;
end;

registration
  let f be real-valued Function;
  let x;
  cluster f.x -> real;
end;

registration
  let f be RAT-valued Function;
  let x;
  cluster f.x -> rational;
end;

registration
  let f be INT-valued Function;
  let x;
  cluster f.x -> integer;
end;

registration
  let f be natural-valued Function;
  let x;
  cluster f.x -> natural;
end;

registration
  let X;
  let x be complex number;
  cluster X --> x -> complex-valued;
end;

registration
  let X;
  let x be ext-real number;
  cluster X --> x -> ext-real-valued;
end;

registration
  let X;
  let x be real number;
  cluster X --> x -> real-valued;
end;

registration
  let X;
  let x be rational number;
  cluster X --> x -> RAT-valued;
end;

registration
  let X;
  let x be integer number;
  cluster X --> x -> INT-valued;
end;

registration
  let X;
  let x be Nat;
  cluster X --> x -> natural-valued;
end;

registration
  let f,g be complex-valued Function;
  cluster f +* g -> complex-valued;
end;

registration
  let f,g be ext-real-valued Function;
  cluster f +* g -> ext-real-valued;
end;

registration
  let f,g be real-valued Function;
  cluster f +* g -> real-valued;
end;

registration
  let f,g be RAT-valued Function;
  cluster f +* g -> RAT-valued;
end;

registration
  let f,g be INT-valued Function;
  cluster f +* g -> INT-valued;
end;

registration
  let f,g be natural-valued Function;
  cluster f +* g -> natural-valued;
end;

registration
  let x;
  let y be complex number;
  cluster x .--> y -> complex-valued;
end;

registration
  let x;
  let y be ext-real number;
  cluster x .--> y -> ext-real-valued;
end;

registration
  let x;
  let y be real number;
  cluster x .--> y -> real-valued;
end;

registration
  let x;
  let y be rational number;
  cluster x .--> y -> RAT-valued;
end;

registration
  let x;
  let y be integer number;
  cluster x .--> y -> INT-valued;
end;

registration
  let x;
  let y be Nat;
  cluster x .--> y -> natural-valued;
end;

registration
  let X;
  let Y be complex-membered set;
  cluster -> complex-valued for Relation of X,Y;
end;

registration
  let X;
  let Y be ext-real-membered set;
  cluster -> ext-real-valued for Relation of X,Y;
end;

registration
  let X;
  let Y be real-membered set;
  cluster -> real-valued for Relation of X,Y;
end;

registration
  let X;
  let Y be rational-membered set;
  cluster -> RAT-valued for Relation of X,Y;
end;

registration
  let X;
  let Y be integer-membered set;
  cluster -> INT-valued for Relation of X,Y;
end;

registration
  let X;
  let Y be natural-membered set;
  cluster -> natural-valued for Relation of X,Y;
end;

registration
  let X;
  let Y be complex-membered set;
  cluster [:X,Y:] -> complex-valued;
end;

registration
  let X;
  let Y be ext-real-membered set;
  cluster [:X,Y:] -> ext-real-valued;
end;

registration
  let X;
  let Y be real-membered set;
  cluster [:X,Y:] -> real-valued;
end;

registration
  let X;
  let Y be rational-membered set;
  cluster [:X,Y:] -> RAT-valued;
end;

registration
  let X;
  let Y be integer-membered set;
  cluster [:X,Y:] -> INT-valued;
end;

registration
  let X;
  let Y be natural-membered set;
  cluster [:X,Y:] -> natural-valued;
end;

notation
  let f be ext-real-valued Relation;
  synonym f is non-zero for f is non-empty;
end;

registration
  cluster non empty constant natural-valued INT-valued RAT-valued for Function;
end;

theorem 
  for f being non empty constant complex-valued Function ex r being
  complex number st for x st x in dom f holds f.x = r;

theorem 
  for f being non empty constant ext-real-valued Function ex r being
  ext-real number st for x st x in dom f holds f.x = r;

theorem 
  for f being non empty constant real-valued Function ex r being real
  number st for x st x in dom f holds f.x = r;

theorem 
  for f being non empty constant RAT-valued Function ex r being
  rational number st for x st x in dom f holds f.x = r;

theorem 
  for f being non empty constant INT-valued Function ex r being
  integer number st for x st x in dom f holds f.x = r;

theorem 
  for f being non empty constant natural-valued Function ex r being
  Nat st for x st x in dom f holds f.x = r;

begin 

reserve e1,e2 for ext-real number;

definition
  let f be ext-real-valued Function;
  attr f is increasing means


  for e1,e2 st e1 in dom f & e2 in dom f & e1 < e2 holds f.e1 < f.e2;
  attr f is decreasing means


  for e1,e2 st e1 in dom f & e2 in dom f & e1 < e2 holds f.e1 > f.e2;
  attr f is non-decreasing means


  for e1,e2 st e1 in dom f & e2 in dom f & e1 <= e2 holds f.e1 <= f.e2;
  attr f is non-increasing means


  for e1,e2 st e1 in dom f & e2 in dom f & e1 <= e2 holds f.e1 >= f.e2;
end;



registration
  cluster trivial -> increasing decreasing for ext-real-valued Function;
end;

registration
  cluster increasing -> non-decreasing for ext-real-valued Function;
  cluster decreasing -> non-increasing for ext-real-valued Function;
end;

registration
  let f,g be increasing ext-real-valued Function;
  cluster g*f -> increasing;
end;

registration
  let f,g be non-decreasing ext-real-valued Function;
  cluster g*f -> non-decreasing;
end;

registration
  let f,g be decreasing ext-real-valued Function;
  cluster g*f -> increasing;
end;

registration
  let f,g be non-increasing ext-real-valued Function;
  cluster g*f -> non-decreasing;
end;

registration
  let f be decreasing ext-real-valued Function;
  let g be increasing ext-real-valued Function;
  cluster g*f -> decreasing;
  cluster f*g -> decreasing;
end;

registration
  let f be non-increasing ext-real-valued Function;
  let g be non-decreasing ext-real-valued Function;
  cluster g*f -> non-increasing;
  cluster f*g -> non-increasing;
end;

registration
  let X be ext-real-membered set;
  cluster id X -> increasing for Function of X,X;
end;

registration
  cluster increasing for sequence of NAT;
end;

definition
  let s be ManySortedSet of NAT;
  mode subsequence of s -> ManySortedSet of NAT means


  ex N being increasing sequence of NAT st it = s * N;
end;

registration
 let X be non empty set, s be X-valued ManySortedSet of NAT;
 cluster -> X-valued for subsequence of s;
end;

definition
  let X be non empty set, s be sequence of X;
  redefine mode subsequence of s -> sequence of X;
end;

definition
  let X be non empty set, s be sequence of X, k be Nat;
  redefine func s ^\ k -> subsequence of s;
end;

reserve s,s1,s2,s3 for sequence of X;

reserve XX for non empty set,
        ss,ss1,ss2,ss3 for sequence of XX;

theorem 
  ss is subsequence of ss;

theorem 
  ss1 is subsequence of ss2 & ss2 is subsequence of ss3 implies
  ss1 is subsequence of ss3;



registration
  let X;
  cluster constant for sequence of X;
end;

theorem 
  for ss1 being subsequence of ss holds rng ss1 c= rng ss;

registration
  let X be non empty set;
  let s be constant sequence of X;
  cluster -> constant for subsequence of s;
end;



definition
  let X be non empty set, N be increasing sequence of NAT, s be sequence of X;
  redefine func s*N -> subsequence of s;
end;



reserve X,Y for non empty set,
  Z for set;
reserve s,s1 for sequence of X,
  h,h1 for PartFunc of X,Y,
  h2 for PartFunc of Y ,Z,
  x for Element of X,
  N for increasing sequence of NAT;

theorem 
  rng s c= dom h & s1 is subsequence of s implies h/*s1 is subsequence of h/*s;



registration
  let X be with_non-empty_element set;
  cluster non-empty for sequence of X;
end;

registration
  let X be with_non-empty_element set, s be non-empty sequence of X;
  cluster -> non-empty for subsequence of s;
end;

reserve i,j for Nat;

definition
  let X be non empty set, s be sequence of X;
  redefine attr s is constant means

  ex x being Element of X st for n being Nat holds s.n=x;
end;

theorem 
  for X being set for s being constant sequence of X holds s.i = s.j;

theorem 
  (for i,j holds s.i = s.j) implies s is constant;

theorem 
  (for i holds s.i = s.(i+1)) implies s is constant;

theorem 
  s is constant & s1 is subsequence of s implies s = s1;

reserve n for Nat;

theorem 
  rng s c= dom h implies (h/*s)^\n=h/*(s^\n);

theorem 
  s.n in rng s;

theorem 
  h is total implies h/*(s^\n) = (h/*s)^\n;

theorem 
  rng s c= dom h implies h.:(rng s) = rng (h/*s);

theorem 
  rng s c= dom (h2*h1) implies h2/*(h1/*s) = (h2*h1)/*s;

definition
  let f be ext-real-valued Function;
  attr f is zeroed means

  f.{} = 0;
end;



registration
  cluster COMPLEX-valued -> complex-valued for Relation;
  cluster ExtREAL-valued -> ext-real-valued for Relation;
  cluster REAL-valued -> real-valued for Relation;
  cluster NAT-valued -> natural-valued for Relation;
end;

definition
  let s be ManySortedSet of NAT;
  redefine attr s is constant means

  ex x being set st for n being Nat holds s.n=x;
end;

theorem 
 for x being non empty set, M be ManySortedSet of NAT,
     s be subsequence of M
   holds rng s c= rng M;

registration
  let X be set;
  cluster natural-valued for ManySortedSet of X;
end;














begin

reserve a,b,c,d for real number;



theorem 
  a^2 + b^2 = 0 implies a = 0;



definition
  let z be complex number;

  func Re z means


  it = z if z in REAL
  otherwise ex f being Function of 2,REAL st z = f & it = f.0;
  func Im z means


  it = 0 if z in REAL otherwise ex f being Function of
  2,REAL st z = f & it = f.1;
end;

registration
  let z be complex number;
  cluster Re z -> real;
  cluster Im z -> real;
end;

definition
  let z be complex number;
  redefine func Re z -> Real;
  redefine func Im z -> Real;
end;

theorem 
  for f being Function of 2,REAL
  ex a,b being Element of REAL st f = (0,1)-->(a,b);

reserve z,z1,z2 for complex number;

theorem 
  Re z1 = Re z2 & Im z1 = Im z2 implies z1 = z2;

definition
  let z1,z2 be complex number;

  redefine pred z1 = z2 means

  Re z1 = Re z2 & Im z1 = Im z2;
end;

notation
  synonym 0c for 0;
end;

definition
  redefine func 0c -> Element of COMPLEX;
end;

definition

  func 1r -> Element of COMPLEX equals

  1;
  redefine func <i> -> Element of COMPLEX;
end;

theorem 
  Re 0 = 0 & Im 0 = 0;

theorem 
  z = 0 iff (Re z)^2 + (Im z)^2 = 0;

theorem 
  Re(1r) = 1 & Im(1r) = 0;

theorem 
  Re(<i>) = 0 & Im(<i>) = 1;

definition

  let z1,z2 be Element of COMPLEX;
  redefine func z1 + z2 -> Element of COMPLEX equals

  Re z1 + Re z2 + (Im z1 + Im z2)*<i>;
end;

theorem 
  Re(z1 + z2) = Re z1 + Re z2 & Im(z1 + z2) = Im z1 + Im z2;

definition
  let z1,z2 be Element of COMPLEX;
  redefine func z1 * z2 -> Element of COMPLEX equals

  Re z1 * Re z2 - Im z1 *
  Im z2+(Re z1 * Im z2 + Re z2 * Im z1)*<i>;
end;

theorem 
  Re(z1 * z2) = Re z1 * Re z2 - Im z1 * Im z2 &
  Im(z1 * z2) = Re z1 * Im z2 + Re z2 * Im z1;

theorem 
  Re (a*<i>) = 0;

theorem 
  Im (a*<i>) = a;

theorem 
  Re(a+b*<i>) = a & Im(a+b*<i>) = b;

theorem 
  Re z+(Im z)*<i> = z;

theorem 
  Im z1 = 0 & Im z2 = 0 implies Re(z1*z2) = Re z1 * Re z2 & Im(z1*z2) = 0;

theorem 
  Re z1 = 0 & Re z2 = 0 implies Re(z1*z2) = - Im z1 * Im z2 & Im(z1*z2) = 0;

theorem 
  Re(z*z) = (Re z)^2 - (Im z)^2 & Im(z*z) = 2*(Re z *Im z);

definition
  let z be Element of COMPLEX;
  redefine func -z -> Element of COMPLEX equals


  -Re z+(-Im z)*<i>;
end;

theorem 
  Re(-z) = -(Re z) & Im(-z) = -(Im z);

theorem 
  <i>*<i> = -1r;

definition
  let z1,z2 be Element of COMPLEX;
  redefine func z1 - z2 -> Element of COMPLEX equals


  Re z1 - Re z2 + (Im z1 - Im z2)*<i>;
end;

theorem 
  Re(z1 - z2) = Re z1 - Re z2 & Im(z1 - z2) = Im z1 - Im z2;

definition
  let z be Element of COMPLEX;
  redefine func z" -> Element of COMPLEX equals


  Re z / ((Re z)^2+(Im z
  )^2)+((- Im z) / ((Re z)^2+(Im z)^2))*<i>;
end;

theorem 
  Re(z") = Re z / ((Re z)^2+(Im z)^2) & Im(z") = (- Im z) / ((Re z)^2+(Im z)^2)
;

theorem 
  <i>" = -<i>;

theorem 
  Re z <> 0 & Im z = 0 implies Re(z") = (Re z)" & Im(z") = 0;

theorem 
  Re z = 0 & Im z <> 0 implies Re(z") = 0 & Im(z") = -(Im z)";

definition
  let z1,z2 be complex number;
  redefine func z1 / z2 -> Element of COMPLEX equals


  (Re z1 * Re z2 + Im z1 * Im z2) / ((Re z2)^2 + (Im z2)^2) +
  ((Re z2 * Im z1 - Re z1 * Im z2) / ((Re z2)^2 + (Im z2)^2))*<i>;
end;

theorem 
  Re(z1 / z2) = (Re z1 * Re z2 + Im z1 * Im z2) / ((Re z2)^2 + (Im z2)^2) &
  Im(z1 / z2) = (Re z2 * Im z1 - Re z1 * Im z2) / ((Re z2)^2 + (Im z2)^2);

theorem 
  Im z1 = 0 & Im z2 = 0 & Re z2 <> 0 implies Re(z1/z2) = (Re z1)/(Re z2)
  & Im(z1/z2) = 0;

theorem 
  Re z1 = 0 & Re z2 = 0 & Im z2 <> 0 implies Re(z1/z2) = (Im z1)/(Im z2)
  & Im(z1/z2) = 0;

definition
  let z be complex number;
  func z*' -> complex number equals

  Re z-(Im z)*<i>;
  involutiveness;
end;

definition
  let z be complex number;
  redefine func z*' -> Element of COMPLEX;
end;

theorem 
  Re (z*') = Re z & Im (z*') = -Im z;

theorem 
  0*' = 0;

theorem 
  z*' = 0 implies z = 0;

theorem 
  1r*' = 1r;

theorem 
  <i>*' = -<i>;

theorem 
  (z1 + z2)*' = z1*' + z2*';

theorem 
  (-z)*' = -(z*');

theorem 
  (z1 - z2)*' = z1*' - z2*';

theorem 
  (z1*z2)*' = z1*'*z2*';

theorem 
  z"*' = z*'";

theorem 
  (z1/z2)*' = (z1*')/(z2*');

theorem 
  Im z = 0 implies z*' = z;

theorem 
  Re z = 0 implies z*' = -z;

theorem 
  Re(z*z*') = (Re z)^2 + (Im z)^2 & Im(z*z*') = 0;

theorem 
  Re(z + z*') = 2*Re z & Im(z + z*') = 0;

theorem 
  Re(z - z*') = 0 & Im(z - z*') = 2*Im z;

definition
  let z be complex number;
  func |.z.| -> real number equals

  sqrt ((Re z)^2 + (Im z)^2);
  projectivity;
end;

definition
  let z;
  redefine func |.z.| -> Real;
end;

theorem 
  a >= 0 implies |.a.| = a;

registration
  cluster |.0.| -> zero;
end;

theorem 
  |.0.| = 0;

registration
  let z be non zero complex number;
  cluster |.z.| -> non zero;
end;

theorem 
  |.z.| = 0 implies z = 0;

registration
  let z;
  cluster |.z.| -> non negative;
end;

theorem 
  0 <= |.z.|;

theorem 
  z <> 0 iff 0 < |.z.|;

theorem 
  |.1r.| = 1;

theorem 
  |.<i>.| = 1;

theorem 
  Im z = 0 implies |.z.| = |.Re z.|;

theorem 
  Re z = 0 implies |.z.| = |.Im z.|;

theorem 
  |.-z.| = |.z.|;

theorem 
  |.z*'.| = |.z.|;

theorem 
  Re z <= |.z.|;

theorem 
  Im z <= |.z.|;

theorem 
  |.z1 + z2.| <= |.z1.| + |.z2.|;

theorem 
  |.z1 - z2.| <= |.z1.| + |.z2.|;

theorem 
  |.z1.| - |.z2.| <= |.z1 + z2.|;

theorem 
  |.z1.| - |.z2.| <= |.z1 - z2.|;

theorem 
  |.z1 - z2.| = |.z2 - z1.|;

theorem 
  |.z1 - z2.| = 0 iff z1 = z2;

theorem 
  z1 <> z2 iff 0 < |.z1 - z2.|;

theorem 
  |.z1 - z2.| <= |.z1 - z.| + |.z - z2.|;

theorem 
  |.|.z1.| - |.z2.|.| <= |.z1 - z2.|;

theorem 
  |.z1*z2.| = |.z1.|*|.z2.|;

theorem 
  |.z".| = |.z.|";

theorem 
  |.z1.| / |.z2.| = |.z1/z2.|;

theorem 
  |.z*z.| = (Re z)^2 + (Im z)^2;

theorem 
  |.z*z.| = |.z*z*'.|;



theorem 
  a <= 0 implies |.a.| = -a;

theorem 
  |.a.| = a or |.a.| = -a;

theorem 
  sqrt a^2 = |.a.|;

theorem 
  min(a,b) = (a + b - |.a - b.|) / 2;

theorem 
  max(a,b) = (a + b + |.a - b.|) / 2;

theorem 
  |.a.|^2 = a^2;

theorem 
  -|.a.| <= a & a <= |.a.|;

notation
  let z be complex number;
  synonym abs z for |.z.|;
end;

definition
  let z be complex number;
  redefine func abs z -> Real;
end;

theorem 
  a+b*<i> = c+d*<i> implies a = c & b = d;



theorem 
  sqrt(a^2+b^2) <= abs(a)+abs(b);

theorem 
  abs(a) <= sqrt(a^2+b^2);

theorem 
  |. 1/z1 .| = 1 / |.z1.|;














begin 

reserve x, y, z, s, t for real number;

definition
  let x be real number;
  redefine func |.x.| equals


  x if 0 <= x otherwise -x;
end;

theorem 
  abs x = x or abs x = -x;

theorem 
  x = 0 iff abs x = 0;

theorem 
  abs x = -x & x <> 0 implies x < 0;

theorem 
  -abs x <= x & x <= abs x;

theorem 
  -y <= x & x <= y iff abs x <= y;

theorem 
  x <> 0 implies abs(x) * abs(1/x) = 1;

theorem 
  abs(1/x) = 1/abs(x);

theorem 
  0 <= x*y implies sqrt (x*y) = sqrt abs(x)*sqrt abs(y);

theorem 
  abs x <= z & abs y <= t implies abs(x+y) <= z + t;

theorem 
  0 < x/y implies sqrt (x/y) = sqrt abs(x) / sqrt abs(y);

theorem 
  0 <= x * y implies abs (x+y) = abs(x) + abs(y);

theorem 
  abs(x+y) = abs(x) + abs(y) implies 0 <= x * y;

theorem 
  abs(x + y)/(1 + abs(x+y)) <= abs(x)/(1 + abs(x)) + abs(y)/(1 + abs(y));



definition
  let x;
  func sgn x -> real number equals


  1 if 0 < x, -1 if x < 0 otherwise 0;
  projectivity;
end;

registration
  let x;
  cluster sgn x -> integer;
end;

definition
  let x be Real;
  redefine func sgn x -> Real;
end;

theorem 
  sgn x = 1 implies 0 < x;

theorem 
  sgn x = -1 implies x < 0;

theorem 
  sgn x = 0 implies x = 0;

theorem 
  x = abs(x) * sgn x;

theorem 
  sgn (x * y) = sgn x * sgn y;

canceled;

theorem 
  sgn (x + y) <= sgn x + sgn y + 1;

theorem 
  x <> 0 implies sgn x * sgn (1/x) = 1;

theorem 
  1/(sgn x) = sgn (1/x);

theorem 
  sgn x + sgn y - 1 <= sgn ( x + y );

theorem 
  sgn x = sgn (1/x);

theorem 
  sgn (x/y) = (sgn x)/(sgn y);



reserve r, s for real number;

theorem 
  0 <= r + abs(r);

theorem 
  0 <= -r + abs(r);

theorem 
  abs(r) = abs(s) implies r = s or r = -s;

theorem 
  for m being Nat holds
  m = abs m;



theorem 
  r<=0 implies abs(r)=-r;















begin

definition
  let a be integer number;
  redefine func abs a -> Element of NAT;
end;

reserve a,b,c for Integer;

theorem 
  a divides b & a divides b + c implies a divides c;

theorem 
  a divides b implies a divides b * c;

theorem 
  0 divides a iff a = 0;

reserve i,j,k,l for Nat;

definition
  let a,b be Integer;

  func a lcm b -> Nat means


  a divides it & b divides it & for m being
  Integer st a divides m & b divides m holds it divides m;
  commutativity;
end;

theorem 
  a = 0 or b = 0 iff a lcm b = 0;

definition
  let a,b be Integer;
  func a gcd b -> Nat means


  it divides a & it divides b &
  for m being Integer st m divides a & m divides b holds m divides it;
  commutativity;
end;

theorem 
  a = 0 & b = 0 iff a gcd b = 0;

reserve n for Nat;
reserve a,b,c,d,a1,b1,a2,b2,k,l for Integer;

theorem 
  -n is Element of NAT iff n = 0;

registration
  let n be non zero Nat;
  cluster -n -> non natural;
end;

theorem 
  not -1 is Element of NAT;

theorem 
  a divides -a & -a divides a;

theorem 
  a divides b & b divides c implies a divides c;

theorem 
  (a divides b iff a divides -b) & (a divides b iff -a divides b) &
  (a divides b iff -a divides -b) & (a divides -b iff -a divides b);

theorem 
  a divides b & b divides a implies a = b or a = -b;

theorem 
  a divides 0 & 1 divides a & -1 divides a;

theorem 
  a divides 1 or a divides -1 implies a = 1 or a = -1;

theorem 
  a = 1 or a = -1 implies a divides 1 & a divides -1;

theorem 
  a,b are_congruent_mod c iff c divides (a-b);

theorem 
  a divides b iff (abs a) divides (abs b);

theorem 
  a lcm b is Element of NAT;

theorem 
  a divides a lcm b;

theorem 
  for c st a divides c & b divides c holds a lcm b divides c;

theorem 
  a gcd b is Element of NAT;

theorem 
  a gcd b divides a;

theorem 
  for c st c divides a & c divides b holds c divides (a gcd b);



definition
  let a,b;
  pred a,b are_relative_prime means


  a gcd b = 1;
  symmetry;
end;

theorem 
  a<>0 or b<>0 implies ex a1,b1 st a = (a gcd b)*a1 & b = (a gcd b)*b1 &
  a1,b1 are_relative_prime;

theorem 
  a,b are_relative_prime implies (c*a gcd c*b) = abs(c) & c*a gcd
  b*c = abs(c) & a*c gcd c*b = abs(c) & a*c gcd b*c = abs(c);

theorem 
  c divides a*b & a,c are_relative_prime implies c divides b;

theorem 
  a,c are_relative_prime & b,c are_relative_prime implies
  a*b,c are_relative_prime;





reserve p,p1,q,l for Nat;

definition
  let p be Nat;
  attr p is prime means


  p > 1 & for n being Nat st n divides p holds n = 1 or n = p;
end;

theorem 
  0 < b & a divides b implies a <= b;

theorem 
  2 is prime;

theorem 
  not 4 is prime;

registration
  cluster prime for Nat;
  cluster non zero non prime for Nat;
end;

theorem 
  p is prime & q is prime implies p,q are_relative_prime or p = q;

theorem 
  l>=2 implies ex p being Element of NAT st p is prime & p divides l;

begin 


theorem 
  for i,j being Integer st i >= 0 & j >= 0 holds
  abs(i) mod abs(j) = i mod j & abs(i) div abs(j) = i div j;



theorem 
  a lcm b = abs(a) lcm abs(b);

theorem 
  a gcd b = abs(a) gcd abs(b);















begin

reserve p,k,l,m,n,s,h,i,j,t for Nat;

definition
  let k,l be Nat;
  redefine func k div l -> Nat means


  ( ex t being Nat st k = l * it + t & t < l ) or it = 0 & l = 0;
end;

definition
  let k,l be Nat;
  redefine func k mod l -> Nat means


  ( ex t being Nat st k = l * t + it & it < l ) or it = 0 & l = 0;
end;

definition
  let k,l be Nat;
  redefine func k div l -> Element of NAT;
  redefine func k mod l -> Element of NAT;
end;

theorem 
  0 < i implies j mod i < i;

theorem 
  0 < i implies j = i * (j div i) + (j mod i);



definition
  let k,l be Nat;
  redefine pred k divides l means


  ex t being Nat st l = k * t;
  reflexivity;
end;

theorem 
  j divides i iff i = j * (i div j);

theorem 
  i divides j & j divides h implies i divides h;

theorem 
  i divides j & j divides i implies i = j;

theorem 
  i divides 0 & 1 divides i;

theorem 
  0 < j & i divides j implies i <= j;

theorem 
  i divides j & i divides h implies i divides j+h;

theorem 
  i divides j implies i divides j * h;

theorem 
  i divides j & i divides j + h implies i divides h;

theorem 
  i divides j & i divides h implies i divides j mod h;



definition
  let k,n be Nat;
  redefine func k lcm n means


  k divides it & n divides it &
  for m being Nat st k divides m & n divides m holds it divides m;
end;

definition
  let k,n be Nat;
  redefine func k lcm n -> Element of NAT;
end;

definition
  let k,n be Nat;
  redefine func k gcd n means


  it divides k & it divides n &
  for m being Nat st m divides k & m divides n holds m divides it;
end;

definition
  let k,n be Nat;
  redefine func k gcd n -> Element of NAT;
end;



scheme 
 Euklides { Q(Nat)->Nat, a,b()->Nat } :
  ex n being Element of NAT st Q(n) = a() gcd b() & Q(n + 1) = 0
provided
 0 < b() & b() < a() and
 Q(0) = a() & Q(1) = b() and
 for n being Element of NAT holds Q(n + 2) = Q(n) mod Q(n + 1);

theorem 
  n mod 2 = 0 or n mod 2 = 1;

theorem 
  (k * n) mod k = 0;

theorem 
  k > 1 implies 1 mod k = 1;

theorem 
  k mod n = 0 & l = k - m * n implies l mod n = 0;

theorem 
  n <> 0 & k mod n = 0 & l < n implies k + l mod n = l;

theorem 
  k mod n = 0 implies k + l mod n = l mod n;

theorem 
  k <> 0 implies (k * n) div k = n;

theorem 
  k mod n = 0 implies (k + l) div n = (k div n) + (l div n);

begin 


theorem 
  k <> 0 implies m * k div k = m;



theorem 
  m mod n = (n*k + m) mod n;

theorem 
  (p+s) mod n = ((p mod n)+s) mod n;

theorem 
  (p+s) mod n = (p + ( s mod n)) mod n;

theorem 
  k < n implies k mod n = k;

theorem 
  n mod n = 0;

theorem 
  0 = 0 mod n;



theorem 
  i < j implies i div j = 0;



theorem 
  m > 0 implies n gcd m = m gcd (n mod m);



scheme 
 INDI{ k,n() -> Element of NAT, P[set] }: P[n()]
provided
 P[0] and
 k() > 0 and
 for i,j st P[k()*i] & j <> 0 & j <= k() holds P[k()*i+j];



theorem 
  i*j = (i lcm j)*(i gcd j);



theorem 
  for i,j being Integer st i>=0 & j>0 holds i gcd j= j gcd (i mod j);



theorem 
  i lcm i = i;

theorem 
  i gcd i = i;



theorem 
  for i, j being Nat st i < j & i <> 0 holds i/j is not integer;



definition
  let i,j be Nat;
  redefine func i -' j -> Element of NAT;
end;

theorem 
  for i,j being Nat holds i + j -' j = i;

reserve a,b for Nat;

theorem 
  a -' b <= a;

reserve n,i,j,k for Nat;

theorem 
  n-'i=0 implies n<=i;

theorem 
  i<=j implies j+k-'i=j+k-i;

theorem 
  i<=j implies j+k-'i=j-'i+k;

reserve i,j,k,i1,i2,n for Nat;

theorem 
  i-'i1>=1 or i-i1>=1 implies i-'i1=i-i1;

theorem 
  n-'0=n;

theorem 
  i1<=i2 implies n-'i2<=n-'i1;

theorem 
  i1<=i2 implies i1-'n<=i2-'n;

theorem 
  i-'i1>=1 or i-i1>=1 implies i-'i1+i1=i;

theorem 
  i1<=i2 implies i1-'1<=i2;

theorem 
  i-'2=i-'1-'1;

theorem 
  i1+1<=i2 implies i1-'1<i2 & i1-'2<i2 & i1<=i2;

theorem 
  i1+2<=i2 or i1+1+1<=i2 implies i1+1<i2 & i1+1-'1<i2 & i1+1-'2<i2 & i1+1<=i2 &
  i1-'1+1<i2 & i1-'1+1-'1<i2 & i1<i2 & i1-'1<i2 & i1-'2<i2 & i1<=i2;

theorem 
  i1<=i2 or i1<=i2-'1 implies
  i1<i2+1 & i1<=i2+1 & i1<i2+1+1 & i1<=i2+1+1 & i1<i2+2 & i1<=i2+2;

theorem 
  i1<i2 or i1+1<=i2 implies i1<=i2-'1;

theorem 
  i>=i1 implies i>=i1-'i2;

theorem 
  1<=i & 1<=i1-'i implies i1-'i<i1;

theorem 
  i-'k <= j implies i <= j + k;

theorem 
  i <= j + k implies i-'k <= j;

theorem 
  i <= j -' k & k <= j implies i + k <= j;

theorem 
  j + k <= i implies k <= i -' j;

theorem 
  k <= i & i < j implies i -' k < j -' k;

theorem 
  i < j & k < j implies i -' k < j -' k;



theorem 
  i <= j implies j-'(j-'i) = i;



theorem 
  for n,k being Nat st n < k holds k -' (n+1) + 1 = k -' n;

theorem 
  for A being finite set holds A is trivial iff card A < 2;



theorem 
  for n,a,k being Integer holds (n <> 0 implies (a + n * k) div n =
  (a div n) + k) & (a + n * k) mod n = a mod n;

theorem 
  for n being Nat st n > 0 for a being Integer holds a
  mod n >= 0 & a mod n < n;

theorem 
  for n,a being Integer holds (0 <= a & a < n implies a mod n = a)
  & (0 > a & a >= -n implies a mod n = n + a);

theorem 
  for n,a,b being Integer holds (n <> 0 & a mod n = b mod n
implies a,b are_congruent_mod n) & (a,b are_congruent_mod n implies a mod n = b
  mod n);

theorem 
  for n being Nat for a being Integer holds (a mod n)
  mod n = a mod n;

theorem 
  for n,a,b being Integer holds (a + b) mod n = ((a mod n) + (b mod n)) mod n;

theorem 
  for n,a,b being Integer holds (a * b) mod n = ((a mod n) * (b mod n)) mod n;

theorem 
  for a,b being Integer ex s,t being Integer st a gcd b = s * a + t * b;



theorem 
  n mod k = k - 1 implies (n+1) mod k = 0;

theorem 
  n mod k < k - 1 implies (n+1) mod k = (n mod k) + 1;















begin

scheme 

  FuncDefUniq{C, D()->non empty set, F(Element of C())->set}: for f1,f2 being
Function of C(),D() st (for x being Element of C() holds f1.x = F(x)) & (for x
  being Element of C() holds f2.x = F(x)) holds f1 = f2;

scheme 

  BinOpDefuniq{A()->non empty set, O(Element of A(),Element of A())->set}: for
o1,o2 being BinOp of A() st (for a,b being Element of A() holds o1.(a,b) = O(a,
  b)) & (for a,b being Element of A() holds o2.(a,b) = O(a,b)) holds o1 = o2;

scheme 

  CFuncDefUniq{F(complex number)->set}: for f1,f2 being
Function of COMPLEX,COMPLEX st
   (for x being complex number holds f1.x = F(x)) & (for x
  being complex number holds f2.x = F(x)) holds f1 = f2;

scheme 

  RFuncDefUniq{F(real number)->set}: for f1,f2 being
Function of REAL,REAL st
   (for x being real number holds f1.x = F(x)) & (for x
  being real number holds f2.x = F(x)) holds f1 = f2;

registration
  cluster -> rational for Element of RAT;
end;

scheme 

  WFuncDefUniq{F(rational number)->set}: for f1,f2 being
Function of RAT,RAT st
   (for x being rational number holds f1.x = F(x)) & (for x
  being rational number holds f2.x = F(x)) holds f1 = f2;

scheme 

  IFuncDefUniq{F(integer number)->set}: for f1,f2 being
Function of INT,INT st
   (for x being integer number holds f1.x = F(x)) & (for x
  being integer number holds f2.x = F(x)) holds f1 = f2;

scheme 

  NFuncDefUniq{F(Nat)->set}: for f1,f2 being
Function of NAT,NAT st
   (for x being Nat holds f1.x = F(x)) & (for x
  being Nat holds f2.x = F(x)) holds f1 = f2;

scheme 

  CBinOpDefuniq{O(complex number,complex number)->set}:
  for o1,o2 being BinOp of COMPLEX st
  (for a,b being complex number holds o1.(a,b) = O(a,b)) &
  (for a,b being complex number holds o2.(a,b) = O(a,b)) holds o1 = o2;

scheme 

  RBinOpDefuniq{O(real number,real number)->set}:
  for o1,o2 being BinOp of REAL st
  (for a,b being real number holds o1.(a,b) = O(a,b)) &
  (for a,b being real number holds o2.(a,b) = O(a,b)) holds o1 = o2;

scheme 

  WBinOpDefuniq{O(rational number,rational number)->set}:
  for o1,o2 being BinOp of RAT st
  (for a,b being rational number holds o1.(a,b) = O(a,b)) &
  (for a,b being rational number holds o2.(a,b) = O(a,b)) holds o1 = o2;

scheme 

  IBinOpDefuniq{O(integer number,integer number)->set}:
  for o1,o2 being BinOp of INT st
  (for a,b being integer number holds o1.(a,b) = O(a,b)) &
  (for a,b being integer number holds o2.(a,b) = O(a,b)) holds o1 = o2;

scheme 

  NBinOpDefuniq{O(Nat,Nat)->set}:
  for o1,o2 being BinOp of NAT st
  (for a,b being Nat holds o1.(a,b) = O(a,b)) &
  (for a,b being Nat holds o2.(a,b) = O(a,b)) holds o1 = o2;

scheme 

  CLambda2D{F(complex number,complex number) -> complex number}:
 ex f being Function of [:COMPLEX,COMPLEX:],COMPLEX st
  for x,y being complex number holds f.(x,y)=F(x,y);

scheme 

  RLambda2D{F(real number,real number) -> real number}:
 ex f being Function of [:REAL,REAL:],REAL st
  for x,y being real number holds f.(x,y)=F(x,y);

scheme 

  WLambda2D{F(rational number,rational number) -> rational number}:
 ex f being Function of [:RAT,RAT:],RAT st
  for x,y being rational number holds f.(x,y)=F(x,y);

scheme 

  ILambda2D{F(integer number,integer number) -> integer number}:
 ex f being Function of [:INT,INT:],INT st
  for x,y being integer number holds f.(x,y)=F(x,y);

scheme 

  NLambda2D{F(Nat,Nat) -> Nat}:
 ex f being Function of [:NAT,NAT:],NAT st
  for x,y being Nat holds f.(x,y)=F(x,y);

scheme 

  CLambdaD{F(complex number) -> complex number }: ex f
being Function of COMPLEX,COMPLEX st
 for x being complex number holds f.x = F(x);

scheme 

  RLambdaD{F(real number) -> real number }: ex f
being Function of REAL,REAL st
 for x being real number holds f.x = F(x);

scheme 

  WLambdaD{F(rational number) -> rational number }: ex f
being Function of RAT,RAT st
 for x being rational number holds f.x = F(x);

scheme 

  ILambdaD{F(integer number) -> integer number }: ex f
being Function of INT,INT st
 for x being integer number holds f.x = F(x);

scheme 

  NLambdaD{F(Nat) -> Nat }: ex f
being Function of NAT,NAT st
 for x being Nat holds f.x = F(x);

reserve c,c1,c2 for complex number;

definition
  let c1;
  redefine func -c1 -> Element of COMPLEX;
  redefine func c1" -> Element of COMPLEX;
  let c2;
  redefine func c1+c2 -> Element of COMPLEX;
  redefine func c1-c2 -> Element of COMPLEX;
  redefine func c1*c2 -> Element of COMPLEX;
  redefine func c1/c2 -> Element of COMPLEX;
end;

reserve r,r1,r2 for real number;

definition
  let r1;
  redefine func -r1 -> Element of REAL;
  redefine func r1" -> Element of REAL;
  let r2;
  redefine func r1+r2 -> Element of REAL;
  redefine func r1-r2 -> Element of REAL;
  redefine func r1*r2 -> Element of REAL;
  redefine func r1/r2 -> Element of REAL;
end;

reserve w,w1,w2 for rational number;

definition
  let w1;
  redefine func -w1 -> Element of RAT;
  redefine func w1" -> Element of RAT;
  let w2;
  redefine func w1+w2 -> Element of RAT;
  redefine func w1-w2 -> Element of RAT;
  redefine func w1*w2 -> Element of RAT;
  redefine func w1/w2 -> Element of RAT;
end;

reserve i,i1,i2 for integer number;

definition
  let i1;
  redefine func -i1 -> Element of INT;
  let i2;
  redefine func i1+i2 -> Element of INT;
  redefine func i1-i2 -> Element of INT;
  redefine func i1*i2 -> Element of INT;
end;

reserve n1,n2 for Nat;

definition
  let n1,n2;
  redefine func n1+n2 -> Element of NAT;
  redefine func n1*n2 -> Element of NAT;
end;

definition
  func compcomplex -> UnOp of COMPLEX means

  for c holds it.c = -c;
  func invcomplex -> UnOp of COMPLEX means

  for c holds it.c = c";
  func addcomplex -> BinOp of COMPLEX means


  for c1,c2 holds it.(c1,c2) = c1 + c2;
  func diffcomplex -> BinOp of COMPLEX means

  for c1,c2 holds it.(c1,c2) = c1 - c2;
  func multcomplex -> BinOp of COMPLEX means


  for c1,c2 holds it.(c1,c2) = c1 * c2;
  func divcomplex -> BinOp of COMPLEX means

  for c1,c2 holds it.(c1,c2) = c1 / c2;
end;

definition
  func compreal -> UnOp of REAL means

  for r holds it.r = -r;
  func invreal -> UnOp of REAL means

  for r holds it.r = r";
  func addreal -> BinOp of REAL means


  for r1,r2 holds it.(r1,r2) = r1 + r2;
  func diffreal -> BinOp of REAL means

  for r1,r2 holds it.(r1,r2) = r1 - r2;
  func multreal -> BinOp of REAL means


  for r1,r2 holds it.(r1,r2) = r1 * r2;
  func divreal -> BinOp of REAL means

  for r1,r2 holds it.(r1,r2) = r1 / r2;
end;

definition
  func comprat -> UnOp of RAT means

  for w holds it.w = -w;
  func invrat -> UnOp of RAT means

  for w holds it.w = w";
  func addrat -> BinOp of RAT means


  for w1,w2 holds it.(w1,w2) = w1 + w2;
  func diffrat -> BinOp of RAT means

  for w1,w2 holds it.(w1,w2) = w1 - w2;
  func multrat -> BinOp of RAT means


  for w1,w2 holds it.(w1,w2) = w1 * w2;
  func divrat -> BinOp of RAT means

  for w1,w2 holds it.(w1,w2) = w1 / w2;
end;

definition
  func compint -> UnOp of INT means

  for i holds it.i = -i;
  func addint -> BinOp of INT means


  for i1,i2 holds it.(i1,i2) = i1 + i2;
  func diffint -> BinOp of INT means

  for i1,i2 holds it.(i1,i2) = i1 - i2;
  func multint -> BinOp of INT means


  for i1,i2 holds it.(i1,i2) = i1 * i2;
end;

definition
  func addnat -> BinOp of NAT means


  for n1,n2 holds it.(n1,n2) = n1 + n2;
  func multnat -> BinOp of NAT means


  for n1,n2 holds it.(n1,n2) = n1 * n2;
end;

registration
  cluster addcomplex -> commutative associative;
  cluster multcomplex -> commutative associative;
  cluster addreal -> commutative associative;
  cluster multreal -> commutative associative;
  cluster addrat -> commutative associative;
  cluster multrat -> commutative associative;
  cluster addint -> commutative associative;
  cluster multint -> commutative associative;
  cluster addnat -> commutative associative;
  cluster multnat -> commutative associative;
end;

registration
  cluster addcomplex -> having_a_unity;
  cluster addreal -> having_a_unity;
  cluster addrat -> having_a_unity;
  cluster addint -> having_a_unity;
  cluster addnat -> having_a_unity;
  cluster multcomplex -> having_a_unity;
  cluster multreal -> having_a_unity;
  cluster multrat -> having_a_unity;
  cluster multint -> having_a_unity;
  cluster multnat -> having_a_unity;
end;

theorem 
  the_unity_wrt addcomplex = 0;

theorem 
  the_unity_wrt addreal = 0;

theorem 
  the_unity_wrt addrat = 0;

theorem 
  the_unity_wrt addint = 0;

theorem 
  the_unity_wrt addnat = 0;

theorem 
  the_unity_wrt multcomplex = 1;

theorem 
  the_unity_wrt multreal = 1;

theorem 
  the_unity_wrt multrat = 1;

theorem 
  the_unity_wrt multint = 1;

theorem 
  the_unity_wrt multnat = 1;















begin

reserve x for set,
  p,q,r,s,t,u for ext-real number,
  a for Element of ExtREAL;

scheme 
 Conti { P,Q[set] }:
  ex s st (for r st P[r] holds r <= s) & for r st Q[r] holds s <= r
provided
 for r,s st P[r] & Q[s] holds r <= s;

begin 

definition
  let r,s;
  func [.r,s.] equals

  { a : r <= a & a <= s };
  func [.r,s.[ equals

  { a : r <= a & a < s };
  func ].r,s.] equals

  { a : r < a & a <= s };
  func ].r,s.[ equals

  { a : r < a & a < s };
end;

theorem 
  t in [.r,s.] iff r <= t & t <= s;

theorem 
  t in ].r,s.] iff r < t & t <= s;

theorem 
  t in [.r,s.[ iff r <= t & t < s;

theorem 
  t in ].r,s.[ iff r < t & t < s;

registration
  let r,s; 
  cluster [.r,s.] -> ext-real-membered;
  cluster [.r,s.[ -> ext-real-membered;
  cluster ].r,s.] -> ext-real-membered;
  cluster ].r,s.[ -> ext-real-membered;
end;

theorem 
  x in [.p,q.] implies x in ].p,q.[ or x = p or x = q;

theorem 
  x in [.p,q.] implies x in ].p,q.] or x = p;

theorem 
  x in [.p,q.] implies x in [.p,q.[ or x = q;

theorem 
  x in [.p,q.[ implies x in ].p,q.[ or x = p;

theorem 
  x in ].p,q.] implies x in ].p,q.[ or x = q;

theorem 
  x in [.p,q.[ implies x in ].p,q.] & x <> q or x = p;

theorem 
  x in ].p,q.] implies x in [.p,q.[ & x <> p or x = q;

theorem 
  x in ].p,q.] implies x in [.p,q.] & x <> p;

theorem 
  x in [.p,q.[ implies x in [.p,q.] & x <> q;

theorem 
  x in ].p,q.[ implies x in [.p,q.[ & x <> p;

theorem 
  x in ].p,q.[ implies x in ].p,q.] & x <> q;

theorem 
  x in ].p,q.[ implies x in [.p,q.] & x <> p & x <> q;

theorem 
  [.r,r.] = {r};

theorem 
  [.r,r.[ = {};

theorem 
  ].r,r.] = {};

theorem 
  ].r,r.[ = {};

registration
  let r;
  cluster [.r,r.] -> non empty;
  cluster [.r,r.[ -> empty;
  cluster ].r,r.] -> empty;
  cluster ].r,r.[ -> empty;
end;

theorem 
  ].p,q.[ c= ].p,q.];

theorem 
  ].p,q.[ c= [.p,q.[;

theorem 
  ].p,q.] c= [.p,q.];

theorem 
  [.p,q.[ c= [.p,q.];

theorem 
  ].p,q.[ c= [.p,q.];

theorem 
  p <= q implies ].q,p.] = {};

theorem 
  p <= q implies [.q,p.[ = {};

theorem 
  p <= q implies ].q,p.[ = {};

theorem 
  p < q implies [.q,p.] = {};

theorem 
  r <= s implies [.r,s.] is non empty;

theorem 
  p < q implies [.p,q.[ is non empty;

theorem 
  p < q implies ].p,q.] is non empty;

theorem 
  p < q implies ].p,q.[ is non empty;

theorem 
  p <= r & s <= q implies [.r,s.] c= [.p,q.];

theorem 
  p <= r & s <= q implies [.r,s.[ c= [.p,q.];

theorem 
  p <= r & s <= q implies ].r,s.] c= [.p,q.];

theorem 
  p <= r & s <= q implies ].r,s.[ c= [.p,q.];

theorem 
  p <= r & s <= q implies [.r,s.[ c= [.p,q.[;

theorem 
  p < r & s <= q implies [.r,s.] c= ].p,q.];

theorem 
  p < r & s <= q implies [.r,s.[ c= ].p,q.];

theorem 
  p <= r & s <= q implies ].r,s.[ c= ].p,q.];

theorem 
  p <= r & s <= q implies ].r,s.] c= ].p,q.];

theorem 
  p <= r & s < q implies [.r,s.] c= [.p,q.[;

theorem 
  p <= r & s < q implies ].r,s.] c= [.p,q.[;

theorem 
  p <= r & s <= q implies ].r,s.[ c= [.p,q.[;

theorem 
  p <= r & s <= q implies ].r,s.[ c= ].p,q.[;

theorem 
  p < r & s < q implies [.r,s.] c= ].p,q.[;

theorem 
  p < r & s <= q implies [.r,s.[ c= ].p,q.[;

theorem 
  p <= r & s < q implies ].r,s.] c= ].p,q.[;

theorem 
  r <= s & [.r,s.] c= [.p,q.] implies p <= r & s <= q;

theorem 
  r < s & ].r,s.[ c= [.p,q.] implies p <= r & s <= q;

theorem 
  r < s & [.r,s.[ c= [.p,q.] implies p <= r & s <= q;

theorem 
  r < s & ].r,s.] c= [.p,q.] implies p <= r & s <= q;

theorem 
  r <= s & [.r,s.] c= [.p,q.[ implies p <= r & s < q;

theorem 
  r < s & [.r,s.[ c= [.p,q.[ implies p <= r & s <= q;

theorem 
  r < s & ].r,s.[ c= [.p,q.[ implies p <= r & s <= q;

theorem 
  r < s & ].r,s.] c= [.p,q.[ implies p <= r & s < q;

theorem 
  r <= s & [.r,s.] c= ].p,q.] implies p < r & s <= q;

theorem 
  r < s & ].r,s.[ c= ].p,q.] implies p <= r & s <= q;

theorem 
  r < s & [.r,s.[ c= ].p,q.] implies p < r & s <= q;

theorem 
  r < s & ].r,s.] c= ].p,q.] implies p <= r & s <= q;

theorem 
  r <= s & [.r,s.] c= ].p,q.[ implies p < r & s < q;

theorem 
  r < s & ].r,s.[ c= ].p,q.[ implies p <= r & s <= q;

theorem 
  r < s & [.r,s.[ c= ].p,q.[ implies p < r & s <= q;

theorem 
  r < s & ].r,s.] c= ].p,q.[ implies p <= r & s < q;

theorem 
  p <= q & [.p,q.] = [.r,s.] implies p = r & q = s;

theorem 
  p < q & ].p,q.[ = ].r,s.[ implies p = r & q = s;

theorem 
  p < q & ].p,q.] = ].r,s.] implies p = r & q = s;

theorem 
  p < q & [.p,q.[ = [.r,s.[ implies p = r & q = s;

theorem 
  r <= s implies [.r,s.] <> ].p,q.];

theorem 
  r <= s implies [.r,s.] <> [.p,q.[;

theorem 
  r <= s implies [.r,s.] <> ].p,q.[;

theorem 
  r < s implies [.r,s.[ <> [.p,q.];

theorem 
  r < s implies [.r,s.[ <> ].p,q.];

theorem 
  r < s implies [.r,s.[ <> ].p,q.[;

theorem 
  r < s implies ].r,s.] <> [.p,q.];

theorem 
  r < s implies ].r,s.] <> [.p,q.[;

theorem 
  r < s implies ].r,s.] <> ].p,q.[;

theorem 
  r < s implies ].r,s.[ <> [.p,q.];

theorem 
  r < s implies ].r,s.[ <> ].p,q.];

theorem 
  r < s implies ].r,s.[ <> [.p,q.[;

theorem 
  r <= s & [.r,s.] c< [.p,q.] implies p < r or s < q;

theorem 
  r < s & ].r,s.[ c= [.p,q.] implies [.r,s.] c= [.p,q.];

theorem 
  r < s implies [.s,p.[ c= ].r,p.[;

theorem 
  s <= r implies [.r,s.] c= {r} & [.r,s.] c= {s};

theorem 
  ].r,s.[ misses {r,s};

theorem 
  [.r,s.[ misses {s};

theorem 
  ].r,s.] misses {r};

theorem 
  s <= p implies [.r,s.] misses ].p,q.[;

theorem 
  s <= p implies [.r,s.] misses ].p,q.];

theorem 
  s <= p implies ].r,s.] misses ].p,q.[;

theorem 
  s <= p implies ].r,s.] misses ].p,q.];

theorem 
  s <= p implies ].r,s.[ misses [.p,q.];

theorem 
  s <= p implies ].r,s.[ misses [.p,q.[;

theorem 
  s <= p implies [.r,s.[ misses [.p,q.];

theorem 
  s <= p implies [.r,s.[ misses [.p,q.[;

theorem 
  r < p & r < s implies not ].r,s.[ c= [.p,q.];

theorem 
  r < p & r < s implies not [.r,s.[ c= [.p,q.];

theorem 
  r < p & r < s implies not ].r,s.] c= [.p,q.];

theorem 
  r < p & r <= s implies not [.r,s.] c= [.p,q.];

theorem 
  r < p & r < s implies not ].r,s.[ c= [.p,q.[;

theorem 
  r < p & r < s implies not ].r,s.] c= [.p,q.[;

theorem 
  r < p & r < s implies not [.r,s.[ c= [.p,q.[;

theorem 
  r < p & r <= s implies not [.r,s.] c= [.p,q.[;

theorem 
  r < p & r < s implies not ].r,s.[ c= ].p,q.];

theorem 
  r <= p & r < s implies not [.r,s.[ c= ].p,q.];

theorem 
  r < p & r < s implies not ].r,s.] c= ].p,q.];

theorem 
  r <= p & r <= s implies not [.r,s.] c= ].p,q.];

theorem 
  r <= p & r <= s implies not [.r,s.] c= ].p,q.[;

theorem 
  r <= p & r < s implies not [.r,s.[ c= ].p,q.[;

theorem 
  r < p & r < s implies not ].r,s.] c= ].p,q.[;

theorem 
  r < p & r < s implies not ].r,s.[ c= ].p,q.[;

theorem 
  q < s & r < s implies not ].r,s.[ c= [.p,q.];

theorem 
  q < s & r < s implies not [.r,s.[ c= [.p,q.];

theorem 
  q < s & r < s implies not ].r,s.] c= [.p,q.];

theorem 
  q < s & r <= s implies not [.r,s.] c= [.p,q.];

theorem 
  q < s & r < s implies not ].r,s.[ c= [.p,q.[;

theorem 
  q <= s & r < s implies not ].r,s.] c= [.p,q.[;

theorem 
  q < s & r < s implies not [.r,s.[ c= [.p,q.[;

theorem 
  q < s & r < s implies not ].r,s.[ c= ].p,q.];

theorem 
  q < s & r <= s implies not [.r,s.] c= ].p,q.];

theorem 
  q < s & r < s implies not [.r,s.[ c= ].p,q.];

theorem 
  q < s & r < s implies not ].r,s.] c= ].p,q.];

theorem 
  q <= s & r <= s implies not [.r,s.] c= ].p,q.[;

theorem 
  q < s & r < s implies not [.r,s.[ c= ].p,q.[;

theorem 
  q <= s & r < s implies not ].r,s.] c= ].p,q.[;

theorem 
  q < s & r < s implies not ].r,s.[ c= ].p,q.[;

begin 

theorem 
  r <= s implies [.r,s.] = ].r,s.[ \/ {r,s};

theorem 
  r <= s implies [.r,s.] = [.r,s.[ \/ {s};

theorem 
  r <= s implies [.r,s.] = {r} \/ ].r,s.];

theorem 
  r < s implies [.r,s.[ = {r} \/ ].r,s.[;

theorem 
  r < s implies ].r,s.] = ].r,s.[ \/ {s};

theorem 
  r <= s implies [.r,s.] \ {r,s} = ].r,s.[;

theorem 
  r <= s implies [.r,s.] \ {r} = ].r,s.];

theorem 
  r <= s implies [.r,s.] \ {s} = [.r,s.[;

theorem 
  r < s implies [.r,s.[ \ {r} = ].r,s.[;

theorem 
  r < s implies ].r,s.] \ {s} = ].r,s.[;

theorem 
  r < s & s < t implies ].r,s.] /\ [.s,t.[ = {s};

theorem 
  [.r,s.[ /\ [.p,q.[ = [.max(r,p),min(s,q).[;

theorem 
  [.r,s.] /\ [.p,q.] = [.max(r,p),min(s,q).];

theorem 
  ].r,s.] /\ ].p,q.] = ].max(r,p),min(s,q).];

theorem 
  ].r,s.[ /\ ].p,q.[ = ].max(r,p),min(s,q).[;

theorem 
  r <= p & s <= q implies [.r,s.] /\ [.p,q.] = [.p,s.];

theorem 
  r <= p & s <= q implies [.r,s.[ /\ [.p,q.] = [.p,s.[;

theorem 
  r >= p & s > q implies [.r,s.[ /\ [.p,q.] = [.r,q.];

theorem 
  r < p & s <= q implies ].r,s.] /\ [.p,q.] = [.p,s.];

theorem 
  r >= p & s >= q implies ].r,s.] /\ [.p,q.] = ].r,q.];

theorem 
  r < p & s <= q implies ].r,s.[ /\ [.p,q.] = [.p,s.[;

theorem 
  r >= p & s > q implies ].r,s.[ /\ [.p,q.] = ].r,q.];

theorem 
  r <= p & s <= q implies [.r,s.[ /\ [.p,q.[ = [.p,s.[;

theorem 
  r >= p & s >= q implies [.r,s.[ /\ [.p,q.[ = [.r,q.[;

theorem 
  r < p & s < q implies ].r,s.] /\ [.p,q.[ = [.p,s.];

theorem 
  r >= p & s >= q implies ].r,s.] /\ [.p,q.[ = ].r,q.[;

theorem 
  r < p & s <= q implies ].r,s.[ /\ [.p,q.[ = [.p,s.[;

theorem 
  r >= p & s >= q implies ].r,s.[ /\ [.p,q.[ = ].r,q.[;

theorem 
  r <= p & s <= q implies ].r,s.] /\ ].p,q.] = ].p,s.];

theorem 
  r >= p & s >= q implies ].r,s.] /\ ].p,q.] = ].r,q.];

theorem 
  r <= p & s <= q implies ].r,s.[ /\ ].p,q.] = ].p,s.[;

theorem 
  r >= p & s > q implies ].r,s.[ /\ ].p,q.] = ].r,q.];

theorem 
  r <= p & s <= q implies ].r,s.[ /\ ].p,q.[ = ].p,s.[;

theorem 
  [.r,s.[ \/ [.p,q.[ c= [.min(r,p),max(s,q).[;

theorem 
  [.r,s.[ meets [.p,q.[ implies [.r,s.[ \/ [.p,q.[ = [.min(r,p),max(s,q).[;

theorem 
  ].r,s.] \/ ].p,q.] c= ].min(r,p),max(s,q).];

theorem 
  ].r,s.] meets ].p,q.] implies ].r,s.] \/ ].p,q.] = ].min(r,p),max(s,q).];

theorem 
  r <= s & s <= t implies [.r,s.] \/ [.s,t.] = [.r,t.];

theorem 
  r <= s & s <= t implies [.r,s.[ \/ [.s,t.] = [.r,t.];

theorem 
  r <= s & s <= t implies [.r,s.] \/ ].s,t.] = [.r,t.];

theorem 
  r <= s & s <= t implies [.r,s.[ \/ [.s,t.[ = [.r,t.[;

theorem 
  r <= s & s < t implies [.r,s.] \/ ].s,t.[ = [.r,t.[;

theorem 
  r <= s & s <= t implies ].r,s.] \/ ].s,t.] = ].r,t.];

theorem 
  r <= s & s < t implies ].r,s.] \/ ].s,t.[ = ].r,t.[;

theorem 
  r < s & s < t implies ].r,s.] \/ [.s,t.[ = ].r,t.[;

theorem 
  r < s & s < t implies ].r,s.[ \/ [.s,t.[ = ].r,t.[;

theorem 
  p <= s & r <= q & s <= r implies [.p,r.] \/ [.s,q.] = [.p,q.];

theorem 
  p <= s & r <= q & s < r implies [.p,r.[ \/ ].s,q.] = [.p,q.];

theorem 
  p <= s & s <= r & r < q implies [.p,r.] \/ [.s,q.[ = [.p,q.[;

theorem 
  p < s & r <= q & s <= r implies ].p,r.] \/ [.s,q.] = ].p,q.];

theorem 
  p < s & r < q & s <= r implies ].p,r.] \/ [.s,q.[ = ].p,q.[;

theorem 
  p<=r & p<=s & r<=q & s<=q implies [.p,r.[ \/ [.r,s.] \/ ].s,q.] = [.p,q.];

theorem 
  p<r & p<s & r<q & s<q implies ].p,r.] \/ ].r,s.[ \/ [.s,q.[ = ].p,q.[;

theorem 
  p <= r & r <= s & s <= q implies [.p,r.] \/ ].r,s.[ \/ [.s,q.] = [.p,q.];

theorem 
  r <= s implies [.r,t.] \ [.r,s.] = ].s,t.];

theorem 
  r <= s implies [.r,t.[ \ [.r,s.] = ].s,t.[;

theorem 
  r < s implies [.r,t.] \ [.r,s.[ = [.s,t.];

theorem 
  r < s implies [.r,t.[ \ [.r,s.[ = [.s,t.[;

theorem 
  r <= s implies [.r,t.] \ [.r,s.] = ].s,t.];

theorem 
  r < s implies ].r,t.[ \ ].r,s.] = ].s,t.[;

theorem 
  r < s implies ].r,t.] \ ].r,s.[ = [.s,t.];

theorem 
  r < s implies ].r,t.[ \ ].r,s.[ = [.s,t.[;

theorem 
  s <= t implies [.r,t.] \ [.s,t.] = [.r,s.[;

theorem 
  s <= t implies ].r,t.] \ [.s,t.] = ].r,s.[;

theorem 
  s < t implies [.r,t.] \ ].s,t.] = [.r,s.];

theorem 
  s < t implies ].r,t.] \ ].s,t.] = ].r,s.];

theorem 
  s < t implies [.r,t.[ \ [.s,t.[ = [.r,s.[;

theorem 
  s < t implies ].r,t.[ \ [.s,t.[ = ].r,s.[;

theorem 
  s < t implies [.r,t.[ \ ].s,t.[ = [.r,s.];

theorem 
  s < t implies ].r,t.[ \ ].s,t.[ = ].r,s.];

theorem 
  [.p,q.[ meets [.r,s.[ implies [.p,q.[ \ [.r,s.[ = [.p,r.[ \/ [.s,q.[;

theorem 
  ].p,q.] meets ].r,s.] implies ].p,q.] \ ].r,s.] = ].p,r.] \/ ].s,q.];

theorem 
  p <= r & s <= q implies [.p,q.] \ ([.p,r.] \/ [.s,q.]) = ].r,s.[;

theorem 
  r <= s & s <= t implies [.r,t.] \ {s} = [.r,s.[ \/ ].s,t.];

theorem 
  r <= s & s < t implies [.r,t.[ \ {s} = [.r,s.[ \/ ].s,t.[;

theorem 
  r < s & s <= t implies ].r,t.] \ {s} = ].r,s.[ \/ ].s,t.];

theorem 
  r < s & s < t implies ].r,t.[ \ {s} = ].r,s.[ \/ ].s,t.[;

theorem 
  not s in ].r,s .[ \/ ].s,t.[;

theorem 
  not s in [.r,s .[ \/ ].s,t.[;

theorem 
  not s in ].r,s .[ \/ ].s,t.];

theorem 
  not s in [.r,s .[ \/ ].s,t.];

begin 

theorem 
  [.-infty,+infty.] = ExtREAL;

theorem 
  ].p,-infty.[ = {};

theorem 
  [.p,-infty.[ = {};

theorem 
  ].p,-infty.] = {};

theorem 
  p <> -infty implies [.p,-infty.] = {};

theorem 
  ].+infty,p.[ = {};

theorem 
  [.+infty,p.[ = {};

theorem 
  ].+infty,p.] = {};

theorem 
  p <> +infty implies [.+infty,p.] = {};

theorem 
  p > q implies p in ].q, +infty.];

theorem 
  q <= p implies p in [.q, +infty.];

theorem 
  p <= q implies p in [.-infty,q.];

theorem 
  p < q implies p in [.-infty, q.[;

begin 

theorem 
  p <= q implies [.p,q.] = [.p,q.] \/ [.q,p.];

theorem 
  r <= s & s <= t implies not r in ].s,t.[ \/ ].t,p.[;



theorem 
  REAL = ].-infty,+infty.[;

theorem 
  ].p,q.[ c= REAL;

theorem 
  p in REAL implies [.p,q.[ c= REAL;

theorem 
  q in REAL implies ].p,q.] c= REAL;

theorem 
  p in REAL & q in REAL implies [.p,q.] c= REAL;

registration
  let p,q;
  cluster ].p,q.[ -> real-membered;
end;

registration
  let p be real number, q;
  cluster [.p,q.[ -> real-membered;
end;

registration
  let q be real number, p;
  cluster ].p,q.] -> real-membered;
end;

registration
  let p,q be real number;
  cluster [.p,q.] -> real-membered;
end;



theorem 
  ].-infty,s.[ = {g where g is Real : g<s};

theorem 
  ].s,+infty.[ = {g where g is Real : s<g};

theorem 
  for s being real number holds ].-infty,s.] = {g where g is Real : g<=s};

theorem 
  for s being real number holds [.s,+infty.[ = {g where g is Real : s<=g};

theorem 
  for x being real number holds x in ].-infty,u.[ iff x < u;

theorem 
  for x being real number holds x in ].-infty,u.] iff x <= u;

theorem 
  for x being real number holds x in ].u,+infty.[ iff u < x;

theorem 
  for x being real number holds x in [.u,+infty.[ iff u <= x;

theorem 
  p <= r implies [.r,s.] c= [.p,+infty.];

theorem 
  p <= r implies [.r,s.[ c= [.p,+infty.];

theorem 
  p <= r implies ].r,s.] c= [.p,+infty.];

theorem 
  p <= r implies ].r,s.[ c= [.p,+infty.];

theorem 
  p <= r implies [.r,s.[ c= [.p,+infty.[;

theorem 
  p < r implies [.r,s.] c= ].p,+infty.];

theorem 
  p < r implies [.r,s.[ c= ].p,+infty.];

theorem 
  p <= r implies ].r,s.[ c= ].p,+infty.];

theorem 
  p <= r implies ].r,s.] c= ].p,+infty.];

theorem 
  p <= r implies ].r,s.[ c= [.p,+infty.[;

theorem 
  p <= r implies ].r,s.[ c= ].p,+infty.[;

theorem 
  p < r implies [.r,s.[ c= ].p,+infty.[;

theorem 
  for s being real number st p < r holds [.r,s.] c= ].p,+infty.[;

theorem 
  for s being real number st p <= r holds ].r,s.] c= ].p,+infty.[;

theorem 
  for s being real number st p <= r holds [.r,s.] c= [.p,+infty.[;

theorem 
  for s being real number st p <= r holds ].r,s.] c= [.p,+infty.[;

theorem 
  s <= q implies [.r,s.] c= [.-infty,q.];

theorem 
  s <= q implies [.r,s.[ c= [.-infty,q.];

theorem 
  s <= q implies ].r,s.] c= [.-infty,q.];

theorem 
  s <= q implies ].r,s.[ c= [.-infty,q.];

theorem 
  s <= q implies [.r,s.[ c= [.-infty,q.[;

theorem 
  s <= q implies ].r,s.[ c= ].-infty,q.];

theorem 
  s <= q implies ].r,s.] c= ].-infty,q.];

theorem 
  s < q implies [.r,s.] c= [.-infty,q.[;

theorem 
  s < q implies ].r,s.] c= [.-infty,q.[;

theorem 
  s <= q implies ].r,s.[ c= [.-infty,q.[;

theorem 
  s <= q implies ].r,s.[ c= ].-infty,q.[;

theorem 
  s < q implies ].r,s.] c= ].-infty,q.[;

theorem 
  for r being real number st s <= q holds [.r,s.] c= ].-infty,q.];

theorem 
  for r being real number st s <= q holds [.r,s.[ c= ].-infty,q.];

theorem 
  for r being real number st s < q holds [.r,s.] c= ].-infty,q.[;

theorem 
  for r being real number st s <= q holds [.r,s.[ c= ].-infty,q.[;

theorem 
  for a,b being ext-real number holds ].-infty,b.[ /\ ].a,+infty.[ = ].a,b.[;

theorem 
  for b being real number holds ].-infty,b.] /\ ].p,+infty.[ = ].p,b.];

theorem 
  for a being real number holds ].-infty,p.[ /\ [.a,+infty.[ = [.a,p.[;

theorem 
  for a,b being real number holds ].-infty,a.] /\ [.b,+infty.[ = [.b,a.];

theorem 
  s <= p implies [.r,s.[ misses ].p,q.[;

theorem 
  s <= p implies [.r,s.[ misses ].p,q.];

theorem 
  s <= p implies ].r,s.[ misses ].p,q.[;

theorem 
  s <= p implies ].r,s.[ misses ].p,q.];

theorem 
  s < p implies [.r,s.] misses [.p,q.[;

theorem 
  s < p implies [.r,s.] misses [.p,q.];

theorem 
  s < p implies ].r,s.] misses [.p,q.[;

theorem 
  s < p implies ].r,s.] misses [.p,q.];

theorem 
  [.-infty,t.] \ [.-infty,s.] = ].s,t.];

theorem 
  [.-infty,t.[ \ [.-infty,s.] = ].s,t.[;

theorem 
  [.-infty,t.] \ [.-infty,s.] = ].s,t.];

theorem 
  [.r,+infty.] \ [.s,+infty.] = [.r,s.[;

theorem 
  ].r,+infty.] \ [.s,+infty.] = ].r,s.[;

theorem 
  for s being real number holds [.-infty,t.] \ [.-infty,s.[ = [.s,t.];

theorem 
  for s being real number holds [.-infty,t.[ \ [.-infty,s.[ = [.s,t.[;

theorem 
  for s being real number holds ].-infty,t.[ \ ].-infty,s.] = ].s,t.[;

theorem 
  for s being real number holds ].-infty,t.] \ ].-infty,s.[ = [.s,t.];

theorem 
  for s being real number holds ].-infty,t.[ \ ].-infty,s.[ = [.s,t.[;

theorem 
  for s being real number holds [.r,+infty.] \ ].s,+infty.] = [.r,s.];

theorem 
  for s being real number holds ].r,+infty.] \ ].s,+infty.] = ].r,s.];

theorem 
  for s being real number holds [.r,+infty.[ \ [.s,+infty.[ = [.r,s.[;

theorem 
  for s being real number holds ].r,+infty.[ \ [.s,+infty.[ = ].r,s.[;

theorem 
  for s being real number holds [.r,+infty.[ \ ].s,+infty.[ = [.r,s.];

theorem 
  for s being real number holds ].r,+infty.[ \ ].s,+infty.[ = ].r,s.];

theorem 
  r < s & p < q implies ].r,q.[ \ ].p,s.[ = ].r,p.] \/ [.s,q.[;

theorem 
  r <= s & p < q implies [.r,q.[ \ ].p,s.[ = [.r,p.] \/ [.s,q.[;

theorem 
  r < s & p <= q implies ].r,q.] \ ].p,s.[ = ].r,p.] \/ [.s,q.];

theorem 
  r <= s & p <= q implies [.r,q.] \ ].p,s.[ = [.r,p.] \/ [.s,q.];

theorem 
  r < s & p <= q implies ].r,q.[ \ [.p,s.[ = ].r,p.[ \/ [.s,q.[;

theorem 
  r <= s & p <= q implies [.r,q.[ \ [.p,s.[ = [.r,p.[ \/ [.s,q.[;

theorem 
  r < s & p <= q implies ].r,q.] \ [.p,s.[ = ].r,p.[ \/ [.s,q.];

theorem 
  r <= s & p <= q implies [.r,q.] \ [.p,s.[ = [.r,p.[ \/ [.s,q.];

theorem 
  r < s & p < q implies ].r,q.[ \ ].p,s.] = ].r,p.] \/ ].s,q.[;

theorem 
  r <= s & p < q implies [.r,q.[ \ ].p,s.] = [.r,p.] \/ ].s,q.[;

theorem 
  r < s & p <= q implies ].r,q.] \ ].p,s.] = ].r,p.] \/ ].s,q.];

theorem 
  r <= s & p <= q implies [.r,q.] \ ].p,s.] = [.r,p.] \/ ].s,q.];

theorem 
  r <= s & p <= q implies ].r,q.[ \ [.p,s.] = ].r,p.[ \/ ].s,q.[;

theorem 
  r <= s & p <= q implies [.r,q.[ \ [.p,s.] = [.r,p.[ \/ ].s,q.[;

theorem 
  r < s & p <= q implies ].r,q.] \ [.p,s.] = ].r,p.[ \/ ].s,q.];

theorem 
  r <= s & p <= q implies [.r,q.] \ [.p,s.] = [.r,p.[ \/ ].s,q.];

theorem 
  r <= p & p <= q implies ].r,q.[ \ {p} = ].r,p.[ \/ ].p,q.[;

theorem 
  r <= p & p <= q implies [.r,q.[ \ {p} = [.r,p.[ \/ ].p,q.[;

theorem 
  r < p & p <= q implies ].r,q.] \ {p} = ].r,p.[ \/ ].p,q.];

theorem 
  r <= p & p <= q implies [.r,q.] \ {p} = [.r,p.[ \/ ].p,q.];

theorem 
  r < q & p <= q implies ].r,q.] \ ].p,q.[ = ].r,p.] \/ {q};

theorem 
  r <= q & p <= q implies [.r,q.] \ ].p,q.[ = [.r,p.] \/ {q};

theorem 
  r < q & p <= q implies ].r,q.] \ [.p,q.[ = ].r,p.[ \/ {q};

theorem 
  r <= q & p <= q implies [.r,q.] \ [.p,q.[ = [.r,p.[ \/ {q};

theorem 
  p <= s & p < q implies [.p,q.[ \ ].p,s.[ = {p} \/ [.s,q.[;

theorem 
  p <= s & p <= q implies [.p,q.] \ ].p,s.[ = {p} \/ [.s,q.];

theorem 
  p <= s & p < q implies [.p,q.[ \ ].p,s.] = {p} \/ ].s,q.[;

theorem 
  p <= s & p <= q implies [.p,q.] \ ].p,s.] = {p} \/ ].s,q.];

theorem 
  p < q implies [.-infty,q.[ \ ].p,s.[ = [.-infty,p.] \/ [.s,q.[;

theorem 
  p <= q implies [.-infty,q.] \ ].p,s.[ = [.-infty,p.] \/ [.s,q.];

theorem 
  p <= q implies [.-infty,q.[ \ [.p,s.[ = [.-infty,p.[ \/ [.s,q.[;

theorem 
  p <= q implies [.-infty,q.] \ [.p,s.[ = [.-infty,p.[ \/ [.s,q.];

theorem 
  p < q implies [.-infty,q.[ \ ].p,s.] = [.-infty,p.] \/ ].s,q.[;

theorem 
  p <= q implies [.-infty,q.] \ ].p,s.] = [.-infty,p.] \/ ].s,q.];

theorem 
  p <= q implies [.-infty,q.[ \ [.p,s.] = [.-infty,p.[ \/ ].s,q.[;

theorem 
  p <= q implies [.-infty,q.] \ [.p,s.] = [.-infty,p.[ \/ ].s,q.];

theorem 
  for s being real number holds p < q
  implies ].-infty,q.[ \ ].p,s.[ = ].-infty,p.] \/ [.s,q.[;

theorem 
  for s being real number holds p <= q
  implies ].-infty,q.] \ ].p,s.[ = ].-infty,p.] \/ [.s,q.];

theorem 
  for s being real number holds p <= q
  implies ].-infty,q.[ \ [.p,s.[ = ].-infty,p.[ \/ [.s,q.[;

theorem 
  for s being real number holds p <= q
  implies ].-infty,q.] \ [.p,s.[ = ].-infty,p.[ \/ [.s,q.];

theorem 
  for s being real number holds p < q
  implies ].-infty,q.[ \ ].p,s.] = ].-infty,p.] \/ ].s,q.[;

theorem 
  for s being real number holds p <= q
  implies ].-infty,q.] \ ].p,s.] = ].-infty,p.] \/ ].s,q.];

theorem 
  p <= q implies ].-infty,q.[ \ [.p,s.] = ].-infty,p.[ \/ ].s,q.[;

theorem 
  for s being real number holds p <= q
  implies ].-infty,q.] \ [.p,s.] = ].-infty,p.[ \/ ].s,q.];

theorem 
  p <= q implies [.-infty,q.[ \ {p} = [.-infty,p.[ \/ ].p,q.[;

theorem 
  p <= q implies [.-infty,q.] \ {p} = [.-infty,p.[ \/ ].p,q.];

theorem 
  p <= q implies [.-infty,q.] \ ].p,q.[ = [.-infty,p.] \/ {q};

theorem 
  p <= q implies [.-infty,q.] \ [.p,q.[ = [.-infty,p.[ \/ {q};

theorem 
  [.-infty,q.] \ ].-infty,s.[ = {-infty} \/ [.s,q.];

theorem 
  [.-infty,q.] \ ].-infty,s.] = {-infty} \/ ].s,q.];

theorem 
  for q being real number holds
  [.-infty,q.[ \ ].-infty,s.[ = {-infty} \/ [.s,q.[;

theorem 
  for q being real number holds
  [.-infty,q.[ \ ].-infty,s.] = {-infty} \/ ].s,q.[;

theorem 
  p <= q implies ].-infty,q.[ \ {p} = ].-infty,p.[ \/ ].p,q.[;

theorem 
  for p being real number holds p <= q
  implies ].-infty,q.] \ {p} = ].-infty,p.[ \/ ].p,q.];

theorem 
  for q being real number holds p <= q
  implies ].-infty,q.] \ ].p,q.[ = ].-infty,p.] \/ {q};

theorem 
  for q being real number holds p <= q
  implies ].-infty,q.] \ [.p,q.[ = ].-infty,p.[ \/ {q};

theorem 
  r < s implies ].r,+infty.] \ ].p,s.[ = ].r,p.] \/ [.s,+infty.];

theorem 
  r <= s implies [.r,+infty.] \ ].p,s.[ = [.r,p.] \/ [.s,+infty.];

theorem 
  r < s implies ].r,+infty.[ \ [.p,s.[ = ].r,p.[ \/ [.s,+infty.[;

theorem 
  r <= s implies [.r,+infty.[ \ [.p,s.[ = [.r,p.[ \/ [.s,+infty.[;

theorem 
  r < s implies ].r,+infty.] \ [.p,s.[ = ].r,p.[ \/ [.s,+infty.];

theorem 
  r <= s implies [.r,+infty.] \ [.p,s.[ = [.r,p.[ \/ [.s,+infty.];

theorem 
  r < s implies ].r,+infty.] \ ].p,s.] = ].r,p.] \/ ].s,+infty.];

theorem 
  r <= s implies [.r,+infty.] \ ].p,s.] = [.r,p.] \/ ].s,+infty.];

theorem 
  r <= s implies ].r,+infty.[ \ [.p,s.] = ].r,p.[ \/ ].s,+infty.[;

theorem 
  r <= s implies [.r,+infty.[ \ [.p,s.] = [.r,p.[ \/ ].s,+infty.[;

theorem 
  r < s implies ].r,+infty.] \ [.p,s.] = ].r,p.[ \/ ].s,+infty.];

theorem 
  r <= s implies [.r,+infty.] \ [.p,s.] = [.r,p.[ \/ ].s,+infty.];

theorem 
  r <= p implies ].r,+infty.[ \ {p} = ].r,p.[ \/ ].p,+infty.[;

theorem 
  r <= p implies [.r,+infty.[ \ {p} = [.r,p.[ \/ ].p,+infty.[;

theorem 
  r < p implies ].r,+infty.] \ {p} = ].r,p.[ \/ ].p,+infty.];

theorem 
  r <= p implies [.r,+infty.] \ {p} = [.r,p.[ \/ ].p,+infty.];

theorem 
  [.r,+infty.] \ ].p,+infty.[ = [.r,p.] \/ {+infty};

theorem 
  [.r,+infty.] \ [.p,+infty.[ = [.r,p.[ \/ {+infty};

theorem 
  for r being real number
  holds ].r,+infty.] \ ].p,+infty.[ = ].r,p.] \/ {+infty};

theorem 
  for r being real number
  holds ].r,+infty.] \ [.p,+infty.[ = ].r,p.[ \/ {+infty};

theorem 
  p <= s implies [.p,+infty.] \ ].p,s.[ = {p} \/ [.s,+infty.];

theorem 
  p <= s implies [.p,+infty.] \ ].p,s.] = {p} \/ ].s,+infty.];

theorem 
  [.-infty,+infty.] \ ].p,s.[ = [.-infty,p.] \/ [.s,+infty.];

theorem 
  [.-infty,+infty.[ \ [.p,s.[ = [.-infty,p.[ \/ [.s,+infty.[;

theorem 
  [.-infty,+infty.] \ [.p,s.[ = [.-infty,p.[ \/ [.s,+infty.];

theorem 
  [.-infty,+infty.] \ ].p,s.] = [.-infty,p.] \/ ].s,+infty.];

theorem 
  [.-infty,+infty.[ \ [.p,s.] = [.-infty,p.[ \/ ].s,+infty.[;

theorem 
  [.-infty,+infty.] \ [.p,s.] = [.-infty,p.[ \/ ].s,+infty.];

theorem 
  for s being real number holds
  ].-infty,+infty.] \ ].p,s.[ = ].-infty,p.] \/ [.s,+infty.];

theorem 
  for s being real number holds REAL \ [.p,s.[ = ].-infty,p.[ \/ [.s,+infty.[;

theorem 
  for s being real number holds
  ].-infty,+infty.] \ [.p,s.[ = ].-infty,p.[ \/ [.s,+infty.];

theorem 
  for s being real number holds
  ].-infty,+infty.] \ ].p,s.] = ].-infty,p.] \/ ].s,+infty.];

theorem 
  REAL \ [.p,s.] = ].-infty,p.[ \/ ].s,+infty.[;

theorem 
  for s being real number holds
  ].-infty,+infty.] \ [.p,s.] = ].-infty,p.[ \/ ].s,+infty.];

theorem 
  [.-infty,+infty.[ \ {p} = [.-infty,p.[ \/ ].p,+infty.[;

theorem 
  [.-infty,+infty.] \ {p} = [.-infty,p.[ \/ ].p,+infty.];

theorem 
  REAL \ {p} = ].-infty,p.[ \/ ].p,+infty.[;

theorem 
  for p being real number holds
  ].-infty,+infty.] \ {p} = ].-infty,p.[ \/ ].p,+infty.];

theorem 
  for p being real number holds
  r < s implies ].r,+infty.[ \ ].p,s.[ = ].r,p.] \/ [.s,+infty.[;

theorem 
  for p being real number holds
  r <= s implies [.r,+infty.[ \ ].p,s.[ = [.r,p.] \/ [.s,+infty.[;

theorem 
  for p being real number holds
  r < s implies ].r,+infty.[ \ ].p,s.] = ].r,p.] \/ ].s,+infty.[;

theorem 
  for p being real number holds
  r <= s implies [.r,+infty.[ \ ].p,s.] = [.r,p.] \/ ].s,+infty.[;

theorem 
  for p being real number holds
  p <= s implies [.p,+infty.[ \ ].p,s.] = {p} \/ ].s,+infty.[;

theorem 
  for p being real number holds
  [.-infty,+infty.[ \ ].p,s.[ = [.-infty,p.] \/ [.s,+infty.[;

theorem 
  for p being real number holds
  [.-infty,+infty.[ \ ].p,s.] = [.-infty,p.] \/ ].s,+infty.[;

theorem 
  for s,p being real number holds REAL \ ].p,s.[ = ].-infty,p.] \/ [.s,+infty.[
;

theorem 
  for s,p being real number holds REAL \ ].p,s.] = ].-infty,p.] \/ ].s,+infty.[
;

theorem 
  for p being real number holds
  p <= s implies [.p,+infty.[ \ ].p,s.[ = {p} \/ [.s,+infty.[;

theorem 
  r < s implies [.r,s.] \ [.r,s.[ = {s};

theorem 
  r < s implies ].r,s.] \ ].r,s.[ = {s};

theorem 
  r < t implies [.r,t.] \ ].r,t.] = {r};

theorem 
  r < t implies [.r,t.[ \ ].r,t.[ = {r};

theorem 
  for s being real number holds [.-infty,s.] \ [.-infty,s.[ = {s};

theorem 
  for s being real number holds ].-infty,s.] \ ].-infty,s.[ = {s};

theorem 
  for s being real number holds [.-infty,s.] \ ].-infty,s.] = {-infty};

theorem 
  for s being real number holds [.-infty,s.[ \ ].-infty,s.[ = {-infty};

theorem 
  for s being real number holds [.s,+infty.] \ [.s,+infty.[ = {+infty};

theorem 
  for s being real number holds ].s,+infty.] \ ].s,+infty.[ = {+infty};

theorem 
  for s being real number holds [.s,+infty.] \ ].s,+infty.] = {s};

theorem 
  for s being real number holds [.s,+infty.[ \ ].s,+infty.[ = {s};



theorem 
  r <= s & s < t implies [.r,s.] \/ [.s,t.[ = [.r,t.[;

theorem 
  r < s & s <= t implies ].r,s.] \/ [.s,t.] = ].r,t.];

theorem 
  r < s & s < t implies ].r,s.] \/ [.s,t.[ = ].r,t.[;



theorem 
  r <= s & s < t implies [.r,s.] /\ [.s,t.[ = {s};

theorem 
  r < s & s <= t implies ].r,s.] /\ [.s,t.] = {s};

theorem 
  r <= s & s <= t implies [.r,s.] /\ [.s,t.] = {s};



theorem 
  [.-infty,s.] = ].-infty,s.[ \/ {-infty,s};

theorem 
  [.-infty,s.] = [.-infty,s.[ \/ {s};

theorem 
  [.-infty,s.] = {-infty} \/ ].-infty,s.];

theorem 
  for s being real number holds [.-infty,s.[ = {-infty} \/ ].-infty,s.[;

theorem 
  for s being real number holds ].-infty,s.] = ].-infty,s.[ \/ {s};

theorem 
  [.r,+infty.] = ].r,+infty.[ \/ {r,+infty};

theorem 
  [.r,+infty.] = [.r,+infty.[ \/ {+infty};

theorem 
  [.r,+infty.] = {r} \/ ].r,+infty.];

theorem 
  for r being real number holds [.r,+infty.[ = {r} \/ ].r,+infty.[;

theorem 
  for r being real number holds ].r,+infty.] = ].r,+infty.[ \/ {+infty};















begin

reserve A,B for Ordinal,
  K,M,N for Cardinal,
  x,x1,x2,y,y1,y2,z,u,X,Y,Z,X1,X2, Y1,Y2 for set,
  f,g for Function;

theorem 
  x in X & X,Y are_equipotent implies Y <> {} & ex x st x in Y;

theorem 
  bool X,bool card X are_equipotent & card bool X = card bool card X;

theorem 
  Z in Funcs(X,Y) implies Z,X are_equipotent & card Z = card X;

definition
  let M,N;
  func M +` N -> Cardinal equals

  card( M +^ N);
  commutativity;
  func M *` N -> Cardinal equals

  card [:M,N:];
  commutativity;
  func exp(M,N) -> Cardinal equals

  card Funcs(N,M);
end;

theorem 
  [:X,Y:],[:Y,X:] are_equipotent & card [:X,Y:] = card [:Y,X:];

theorem 
  [:[:X,Y:],Z:],[:X,[:Y,Z:]:] are_equipotent & card [:[:X,Y:],Z:]
  = card [:X,[:Y,Z:]:];

theorem 
  X,[:X,{x}:] are_equipotent & card X = card [:X,{x}:];

theorem 
  [:X,Y:],[:card X,Y:] are_equipotent & [:X,Y:],[:X,card Y:]
are_equipotent & [:X,Y:],[:card X,card Y:] are_equipotent & card [:X,Y:] = card
[:card X,Y:] & card [:X,Y:] = card [:X,card Y:] & card [:X,Y:] = card [:card X,
  card Y:];

theorem 
  X1,Y1 are_equipotent & X2,Y2 are_equipotent implies [:X1,X2:],[:
  Y1,Y2:] are_equipotent & card [:X1,X2:] = card [:Y1,Y2:];

theorem 
  x1 <> x2 implies A+^B,[:A,{x1}:] \/ [:B,{x2}:] are_equipotent & card(A
  +^B) = card([:A,{x1}:] \/ [:B,{x2}:]);

theorem 
  x1 <> x2 implies K+`M,[:K,{x1}:] \/ [:M,{x2}:] are_equipotent &
  K+`M = card([:K,{x1}:] \/ [:M,{x2}:]);

theorem 
  A*^B,[:A,B:] are_equipotent & card(A*^B) = card [:A,B:];

theorem 
  X1,Y1 are_equipotent & X2,Y2 are_equipotent & x1 <> x2 & y1 <>
y2 implies [:X1,{x1}:] \/ [:X2,{x2}:],[:Y1,{y1}:] \/ [:Y2,{y2}:] are_equipotent
  & card ([:X1,{x1}:] \/ [:X2,{x2}:]) = card ([:Y1,{y1}:] \/ [:Y2,{y2}:]);

theorem 
  card(A+^B) = card A +` card B;

theorem 
  card(A*^B) = card A *` card B;

theorem 
  [:X,{0}:] \/ [:Y,{1}:],[:Y,{0}:] \/ [:X,{1}:] are_equipotent & card([:
  X,{0}:] \/ [:Y,{1}:]) = card([:Y,{0}:] \/ [:X,{1}:]);

theorem 
  [:X1,X2:] \/ [:Y1,Y2:],[:X2,X1:] \/ [:Y2,Y1:] are_equipotent &
  card ([:X1,X2:] \/ [:Y1,Y2:]) = card ([:X2,X1:] \/ [:Y2,Y1:]);

theorem 
  x <> y implies card X +` card Y = card([:X,{x}:] \/ [:Y,{y}:]);

theorem 
  M+`0 = M;

theorem 
  (K+`M)+`N = K+`(M+`N);

theorem 
  K*`0 = 0;

theorem 
  K*`1 = K;

theorem 
  (K*`M)*`N = K*`(M*`N);

theorem 
  2*`K = K+`K;

theorem 
  K*`(M+`N) = K*`M +` K*`N;

theorem 
  exp(K,0) = 1;

theorem 
  K <> 0 implies exp(0,K) = 0;

theorem 
  exp(K,1) = K & exp(1,K) = 1;

theorem 
  exp(K,M+`N) = exp(K,M)*`exp(K,N);

theorem 
  exp(K*`M,N) = exp(K,N)*`exp(M,N);

theorem 
  exp(K,M*`N) = exp(exp(K,M),N);


theorem 
  exp(2,card X) = card bool X;

theorem 
  exp(K,2) = K*`K;

theorem 
  exp(K+`M,2) = K*`K +` 2*`K*`M +` M*`M;

theorem 
  card(X \/ Y) c= card X +` card Y;

theorem 
  X misses Y implies card (X \/ Y) = card X +` card Y;

reserve m,n for Element of NAT;

theorem 
  n+m = n +^ m;

theorem 
  n*m = n *^ m;

theorem 
  card(n+m) = card n +` card m;

theorem 
  card(n*m) = card n *` card m;

theorem 
  for X,Y being finite set st X misses Y holds card (X \/ Y) = card X + card Y;

theorem 
  for X being finite set st not x in X holds card (X \/ {x}) = card X + 1;

theorem 
  for X being set holds card X = 1 iff ex x st X = {x};

theorem 
  for X,Y being finite set holds card(X \/ Y) <= card X + card Y;

theorem 
  for X,Y being finite set st Y c= X holds card (X \ Y) = card X - card Y;

theorem 
  for X,Y being finite set holds card (X \/ Y) = card X + card Y - card
  (X /\ Y);

theorem 
  for X,Y being finite set holds card [:X,Y:] = card X * card Y;

theorem 
  for f being finite Function holds card rng f <= card dom f;

theorem 
  for X,Y being finite set st X c< Y holds card X < card Y & card X in card Y;

theorem 
  (card X c= card Y or card X in card Y) & Y is finite implies X is finite;

reserve x1,x2,x3,x4,x5,x6,x7,x8 for set;

theorem 
  card {x1,x2} <= 2;

theorem 
  card {x1,x2,x3} <= 3;

theorem 
  card {x1,x2,x3,x4} <= 4;

theorem 
  card {x1,x2,x3,x4,x5} <= 5;

theorem 
  card {x1,x2,x3,x4,x5,x6} <= 6;

theorem 
  card {x1,x2,x3,x4,x5,x6,x7} <= 7;

theorem 
  card {x1,x2,x3,x4,x5,x6,x7,x8} <= 8;

theorem 
  x1 <> x2 implies card {x1,x2} = 2;

theorem 
  x1 <> x2 & x1 <> x3 & x2 <> x3 implies card {x1,x2,x3} = 3;

theorem 
  x1 <> x2 & x1 <> x3 & x1 <> x4 & x2 <> x3 & x2 <> x4 & x3 <> x4
  implies card {x1,x2,x3,x4} = 4;

begin 


theorem 
  for X being set st card X = 2 ex x,y st x <> y & X = {x,y};



theorem 
  for f being Function holds card rng f c= card dom f;

theorem 
  Z <> {} & Z is finite & (for X,Y st X in Z & Y in Z holds X c= Y or Y
  c= X) implies union Z in Z;

theorem 
  x1,x2,x3,x4,x5 are_mutually_different implies card {x1,x2,x3,x4,x5} = 5;



theorem 
  for M1, M2 being set st card M1 = 0 & card M2 = 0 holds M1 = M2;



registration
  let x,y;
  cluster [x,y] -> non natural;
end;

begin 

reserve A,B,C for Ordinal,
  K,L,M,N for Cardinal,
  x,y,y1,y2,z,u,X,Y,Z,Z1,Z2 for set,
  n for Nat,
  f,f1,g,h for Function,
  Q,R for Relation;

theorem 
  Sum(M --> N) = M*`N;

theorem 
  Product(N --> M) = exp(M,N);

scheme 
 FinRegularity { X()->finite set, P[set,set] }:
  ex x st x in X() & for y st y in X() & y <> x holds not P[y,x]
provided
 X() <> {} and
 for x,y st P[x,y] & P[y,x] holds x = y and
 for x,y,z st P[x,y] & P[y,z] holds P[x,z];

scheme 
 MaxFinSetElem { X()->finite set, P[set,set] }:
  ex x st x in X() & for y st y in X() holds P[x,y]
provided
 X() <> {} and
 for x,y holds P[x,y] or P[y,x] and
 for x,y,z st P[x,y] & P[y,z] holds P[x,z];

theorem 
  Rank n is finite;

theorem 
  0 in M iff 1 c= M;

theorem 
  1 in M iff 2 c= M;

reserve n,k for Nat;

theorem 
  A is limit_ordinal iff for B,n st B in A holds B+^ n in A;

theorem 
  A+^succ n = succ A +^ n & A +^ (n+1) = succ A +^ n;

theorem 
  ex n st A*^succ 1 = A +^ n;

theorem 
  A is limit_ordinal implies A *^ succ 1 = A;

theorem 
  omega c= A implies 1+^A = A;

registration
  cluster infinite -> limit_ordinal for Cardinal;
end;

theorem 
  not M is finite implies M+`M = M;

theorem 
  not M is finite & (N c= M or N in M) implies M+`N = M & N+`M = M;

theorem 
  not X is finite & (X,Y are_equipotent or Y,X are_equipotent) implies
  X \/ Y,X are_equipotent & card (X \/ Y) = card X;

theorem 
  not X is finite & Y is finite implies
  X \/ Y,X are_equipotent & card (X \/ Y) = card X;

theorem 
  not X is finite & (card Y in card X or card Y c= card X) implies
  X \/ Y,X are_equipotent & card (X \/ Y) = card X;

theorem 
  for M,N being finite Cardinal holds M+`N is finite;

theorem 
  not M is finite implies not M+`N is finite & not N+`M is finite;

theorem 
  for M,N being finite Cardinal holds M*`N is finite;

theorem 
  K in L & M in N or K c= L & M in N or K in L & M c= N or K c= L & M c= N
  implies K+`M c= L+`N & M+`K c= L+`N;

theorem 
  M in N or M c= N implies K+`M c= K+`N & K+`M c= N+`K &
  M+`K c= K+`N & M+`K c= N+`K;

theorem 
  X is countable & Y is countable implies X \/ Y is countable;

theorem 
  (card dom f c= M & for x st x in dom f holds card (f.x) c= N) implies
  card Union f c= M*`N;

theorem 
  (card X c= M & for Y st Y in X holds card Y c= N) implies card union X c=
  M*`N;

theorem 
  for f st dom f is finite &
  for x st x in dom f holds f.x is finite holds Union f is finite;

theorem 
  (omega)*`(card n) c= omega & (card n)*`(omega) c= omega;

theorem 
  K in L & M in N or K c= L & M in N or K in L & M c= N or K c= L & M c= N
  implies K*`M c= L*`N & M*`K c= L*`N;

theorem 
  M in N or M c= N implies
  K*`M c= K*`N & K*`M c= N*`K & M*`K c= K*`N & M*`K c= N*`K;

theorem 
  K in L & M in N or K c= L & M in N or K in L & M c= N or K c= L & M c= N
  implies K = 0 or exp(K,M) c= exp(L,N);

theorem 
  M in N or M c= N implies K = 0 or
  exp(K,M) c= exp(K,N) & exp(M,K) c= exp(N,K);

theorem 
  M c= M+`N & N c= M+`N;

theorem 
  N <> 0 implies M c= M*`N & M c= N*`M;

theorem 
  K in L & M in N implies K+`M in L+`N & M+`K in L+`N;

theorem 
  K+`M in K+`N implies M in N;

theorem 
  card X +` card Y = card X & card Y in card X implies card (X \ Y) = card X;

theorem 
  K*`M in K*`N implies M in N;

theorem 
  X is countable & Y is countable implies X \+\ Y is countable;

registration
  let A be finite set, B be set, f be Function of A, Fin B;
  cluster Union f -> finite;
end;

registration let f be finite finite-yielding Function;
 cluster product f -> finite;
end;



theorem 
  for F be Function st dom F is infinite & rng F is finite ex x st
  x in rng F & F"{x} is infinite;















begin

scheme 

  FinInter{m, n() -> Integer, F(set)->set, P[set]}: {F(i) where i is Element
  of INT: m()<=i & i<=n() & P[i]} is finite;

reserve x,y,z,r,s for ext-real number;

definition
  let X be ext-real-membered set;
  mode UpperBound of X -> ext-real number means


    x in X implies x <= it;
  mode LowerBound of X -> ext-real number means


    x in X implies it <= x;
end;

definition
  let X be ext-real-membered set;
  func sup X -> ext-real number means


  it is UpperBound of X & for x being UpperBound of X holds it <= x;
  func inf X -> ext-real number means


  it is LowerBound of X & for x being LowerBound of X holds x <= it;
end;

definition
  let X be ext-real-membered set;
  attr X is left_end means


  inf X in X;
  attr X is right_end means


  sup X in X;
end;

theorem 
  y is UpperBound of {x} iff x <= y;

theorem 
  y is LowerBound of {x} iff y <= x;

registration
  cluster -> ext-real-membered for Element of Fin ExtREAL;
end;

reserve A,B for ext-real-membered set;

theorem 
  x in A implies inf A <= x;

theorem 
  x in A implies x <= sup A;

theorem 
  B c= A implies for x being LowerBound of A holds x is LowerBound of B;

theorem 
  B c= A implies for x being UpperBound of A holds x is UpperBound of B;

theorem 
  for x being LowerBound of A, y being LowerBound of B holds min(x,
  y) is LowerBound of A\/ B;

theorem 
  for x being UpperBound of A, y being UpperBound of B holds max(x,
  y) is UpperBound of A\/ B;

theorem 
  inf(A \/ B) = min(inf A,inf B);

theorem 
  sup(A \/ B) = max(sup A,sup B);

registration
  cluster finite -> left_end right_end for non empty ext-real-membered set;
end;

registration
  cluster -> left_end for non empty natural-membered set;
end;

registration
  cluster right_end for non empty natural-membered set;
end;

notation
  let X be left_end ext-real-membered set;
  synonym min X for inf X;
end;

notation
  let X be right_end ext-real-membered set;
  synonym max X for sup X;
end;

definition
  let X be left_end ext-real-membered set;
  redefine func min X means


  it in X & for x st x in X holds it <= x;
end;

definition
  let X be right_end ext-real-membered set;
  redefine func max X means


  it in X & for x st x in X holds x <= it;
end;

theorem 
  max{x} = x;

theorem 
  max(x,y) = max{x,y};

theorem 
  min{x} = x;

theorem 
  min{x,y} = min(x,y);

definition
  let X be ext-real-membered set;
  attr X is bounded_below means


  ex r being real number st r is LowerBound of X;
  attr X is bounded_above means


  ex r being real number st r is UpperBound of X;
end;

registration
  cluster non empty finite natural-membered for set;
end;

definition
  let X be ext-real-membered set;
  attr X is real-bounded means


  X is bounded_below bounded_above;
end;

registration
  cluster real-bounded -> bounded_above bounded_below
          for ext-real-membered set;
  cluster bounded_above bounded_below -> real-bounded
          for ext-real-membered set;
end;

registration
  cluster finite -> real-bounded for real-membered set;
end;

registration
  cluster real-bounded for non empty natural-membered set;
end;

theorem 
  for X being non empty real-membered set st X is bounded_below
  holds inf X in REAL;

theorem 
  for X being non empty real-membered set st X is bounded_above
  holds sup X in REAL;

registration
  let X be bounded_above non empty real-membered set;
  cluster sup X -> real;
end;

registration
  let X be bounded_below non empty real-membered set;
  cluster inf X -> real;
end;

registration
  cluster bounded_above -> right_end for non empty integer-membered set;
end;

registration
  cluster bounded_below -> left_end for non empty integer-membered set;
end;

registration
  cluster -> bounded_below for natural-membered set;
end;

registration
  let X be left_end real-membered set;
  cluster min X -> real;
end;

registration
  let X be left_end rational-membered set;
  cluster min X -> rational;
end;

registration
  let X be left_end integer-membered set;
  cluster min X -> integer;
end;

registration
  let X be left_end natural-membered set;
  cluster min X -> natural;
end;

registration
  let X be right_end real-membered set;
  cluster max X -> real;
end;

registration
  let X be right_end rational-membered set;
  cluster max X -> rational;
end;

registration
  let X be right_end integer-membered set;
  cluster max X -> integer;
end;

registration
  let X be right_end natural-membered set;
  cluster max X -> natural;
end;

registration
  cluster left_end -> bounded_below for real-membered set;
  cluster right_end -> bounded_above for real-membered set;
end;

theorem 
  x is LowerBound of [.x,y.];

theorem 
  x is LowerBound of ].x,y.];

theorem 
  x is LowerBound of [.x,y.[;

theorem 
  x is LowerBound of ].x,y.[;

theorem 
  y is UpperBound of [.x,y.];

theorem 
  y is UpperBound of ].x,y.];

theorem 
  y is UpperBound of [.x,y.[;

theorem 
  y is UpperBound of ].x,y.[;

theorem 
  x <= y implies inf [.x,y.] = x;

theorem 
  x < y implies inf [.x,y.[ = x;

theorem 
  x < y implies inf ].x,y.] = x;

theorem 
  x < y implies inf ].x,y.[ = x;

theorem 
  x <= y implies sup [.x,y.] = y;

theorem 
  x < y implies sup ].x,y.] = y;

theorem 
  x < y implies sup [.x,y.[ = y;

theorem 
  x < y implies sup ].x,y.[ = y;

theorem 
  x <= y implies [.x,y.] is left_end right_end;

theorem 
  x < y implies [.x,y.[ is left_end;

theorem 
  x < y implies ].x,y.] is right_end;

theorem 
  x is LowerBound of {};

theorem 
  x is UpperBound of {};

theorem 
  inf {} = +infty;

theorem 
  sup {} = -infty;

theorem 
  for X being ext-real-membered set holds X is non empty iff inf X <= sup X;

registration
  cluster real-bounded -> finite for integer-membered set;
end;

registration
  cluster -> finite for bounded_above natural-membered set;
end;

theorem 
  for X being ext-real-membered set holds +infty is UpperBound of X;

theorem 
  for X being ext-real-membered set holds -infty is LowerBound of X;

theorem 
  for X,Y being ext-real-membered set st X c= Y & Y is
  bounded_above holds X is bounded_above;

theorem 
  for X,Y being ext-real-membered set st X c= Y & Y is
  bounded_below holds X is bounded_below;

theorem 
  for X,Y being ext-real-membered set st X c= Y & Y is real-bounded holds
  X is real-bounded;

theorem 
  REAL is non bounded_below non bounded_above;

registration
  cluster REAL -> non bounded_below non bounded_above;
end;

theorem 
  {+infty} is bounded_below;

theorem 
  {-infty} is bounded_above;

theorem 
  for X being bounded_above non empty ext-real-membered set st X
  <> {-infty} holds ex x being Element of REAL st x in X;

theorem 
  for X being bounded_below non empty ext-real-membered set st X
  <> {+infty} holds ex x being Element of REAL st x in X;

theorem 
  for X being ext-real-membered set st -infty is UpperBound of X
  holds X c= {-infty};

theorem 
  for X being ext-real-membered set st +infty is LowerBound of X
  holds X c= {+infty};

theorem 
  for X being non empty ext-real-membered set st ex y being UpperBound
  of X st y <> +infty holds X is bounded_above;

theorem 
  for X being non empty ext-real-membered set st ex y being LowerBound
  of X st y <> -infty holds X is bounded_below;

theorem 
  for X being non empty ext-real-membered set, x being UpperBound of X
  st x in X holds x = sup X;

theorem 
  for X being non empty ext-real-membered set, x being LowerBound of X
  st x in X holds x = inf X;

theorem 
  for X being non empty ext-real-membered set st X is
  bounded_above & X <> {-infty} holds sup X in REAL;

theorem 
  for X being non empty ext-real-membered set st X is
  bounded_below & X <> {+infty} holds inf X in REAL;

theorem 
  for X,Y being ext-real-membered set st X c= Y holds sup X <= sup Y;

theorem 
  for X,Y being ext-real-membered set st X c= Y holds inf Y <= inf X;

theorem 
  for X being ext-real-membered set, x being ext-real number st (ex y
  being ext-real number st y in X & x <= y) holds x <= sup X;

theorem 
  for X being ext-real-membered set, x being ext-real number st (ex y
  being ext-real number st y in X & y <= x) holds inf X <= x;

theorem 
  for X,Y being ext-real-membered set st for x being ext-real number st
  x in X ex y being ext-real number st y in Y & x <= y holds sup X <= sup Y;

theorem 
  for X,Y being ext-real-membered set st for y being ext-real number st
  y in Y ex x being ext-real number st x in X & x <= y holds inf X <= inf Y;

theorem 
  for X,Y being ext-real-membered set, x being UpperBound of X, y
  being UpperBound of Y holds min(x,y) is UpperBound of X /\ Y;

theorem 
  for X,Y being ext-real-membered set, x being LowerBound of X, y
  being LowerBound of Y holds max(x,y) is LowerBound of X /\ Y;

theorem 
  for X,Y being ext-real-membered set holds sup(X /\ Y) <= min(sup X,sup Y);

theorem 
  for X,Y being ext-real-membered set holds max(inf X,inf Y) <= inf(X /\ Y);

registration
  cluster real-bounded -> real-membered for ext-real-membered set;
end;

theorem 
  A c= [.inf A, sup A.];

theorem 
  sup A = inf A implies A = {inf A};

theorem 
  x <= y & x is UpperBound of A implies y is UpperBound of A;

theorem 
  y <= x & x is LowerBound of A implies y is LowerBound of A;

theorem 
  A is bounded_above iff sup A <> +infty;

theorem 
  A is bounded_below iff inf A <> -infty;

begin 

definition
  let A be ext-real-membered set;
  attr A is interval means


  for r,s being ext-real number st r in A & s in A holds [.r,s.] c= A;
end;

registration
  cluster ExtREAL -> interval;
  cluster empty -> interval for ext-real-membered set;
  let r,s;
  cluster [.r,s.] -> interval;
  cluster ].r,s.] -> interval;
  cluster [.r,s.[ -> interval;
  cluster ].r,s.[ -> interval;
end;

registration
  cluster REAL -> interval;
end;

registration
  cluster interval for non empty ext-real-membered set;
end;

registration
  let A,B be interval ext-real-membered set;
  cluster A /\ B -> interval;
end;

reserve A,B for ext-real-membered set;

registration
  let r,s;
  cluster ].r,s.] -> non left_end;
  cluster [.r,s.[ -> non right_end;
  cluster ].r,s.[ -> non left_end non right_end;
end;

registration
  cluster left_end right_end interval for ext-real-membered set;
  cluster non left_end right_end interval for ext-real-membered set;
  cluster left_end non right_end interval for ext-real-membered set;
  cluster non left_end non right_end interval non empty for ext-real-membered
    set;
end;

theorem 
  for A being left_end right_end interval ext-real-membered set holds
  A = [.min A, max A.];

theorem 
  for A being non left_end right_end interval ext-real-membered set
  holds A = ].inf A, max A.];

theorem 
  for A being left_end non right_end interval ext-real-membered set
  holds A = [.min A, sup A.[;

theorem 
  for A being non left_end non right_end non empty interval
  ext-real-membered set holds A =].inf A,sup A.[;

theorem 
  for A being non left_end non right_end interval ext-real-membered
  set ex r,s st r <= s & A =].r,s.[;

theorem 
  A is interval implies for x,y,r st x in A & y in A & x <= r & r
  <= y holds r in A;

theorem 
  A is interval implies for x,r st x in A & x <= r & r < sup A holds r in A;

theorem 
  A is interval implies for x,r st x in A & inf A < r & r <= x holds r in A;

theorem 
  A is interval implies for r st inf A < r & r < sup A holds r in A;

theorem 
  (for x,y,r st x in A & y in A & x < r & r < y holds r in A)
  implies A is interval;

theorem 
  (for x,r st x in A & x < r & r < sup A holds r in A) implies A is interval;

theorem 
  (for y,r st y in A & inf A < r & r < y holds r in A) implies A is interval;

theorem 
  (for r st inf A < r & r < sup A holds r in A) implies A is interval;

theorem 
  (for x,y,r st x in A & y in A & x <= r & r <= y holds r in A)
  implies A is interval;

theorem 
  A is interval & B is interval & A meets B implies A \/ B is interval;

theorem 
  A is interval & B is left_end interval & sup A = inf B implies A \/
  B is interval;

theorem 
  A is right_end interval & B is interval & sup A = inf B implies A \/
  B is interval;

registration
 cluster left_end -> non empty for ext-real-membered set;
 cluster right_end -> non empty for ext-real-membered set;
end;



theorem 
  for A being non empty Subset of ExtREAL st
   for r being Element of ExtREAL st r in A
  holds r <= -infty holds A = {-infty};

theorem 
  for A being non empty Subset of ExtREAL st
   for r being Element of ExtREAL st r in A
  holds +infty <= r holds A = {+infty};

theorem 
  for A being non empty Subset of ExtREAL, r being ext-real number
  st r < sup A ex s being Element of ExtREAL st s in A & r < s;

theorem 
  for A being non empty Subset of ExtREAL, r being Element of ExtREAL
    st inf A < r
   ex s being Element of ExtREAL st s in A & s < r;

theorem 
  for A,B being non empty Subset of ExtREAL st for r,s being Element of ExtREAL
  st r in A & s in B holds r <= s holds sup A <= inf B;















begin

reserve x,y,z,w for ext-real number,
  r for real number;

definition
  let x,y;
  redefine pred x <= y means


  ex p,q being Element of REAL st p = x & q = y & p <= q
  if x in REAL & y in REAL otherwise x = -infty or y = +infty;
end;

registration
  cluster non real positive for ext-real number;
  cluster non real negative for ext-real number;
end;

theorem 
  for x being non real positive ext-real number holds x = +infty;

theorem 
  for x being non real negative ext-real number holds x = -infty;

registration
  cluster non real non negative -> positive for ext-real number;
  cluster non real non positive -> negative for ext-real number;
end;

theorem 
  x < z implies ex y being real number st x < y & y < z;

begin 

definition
  let x,y;
  func x + y -> ext-real number means


  ex a,b being complex number st x = a & y = b & it = a + b
  if x is real & y is real,
  it = +infty if x = +infty & y <> -infty or y = +infty & x <> -infty,
  it = -infty if x = -infty & y <> +infty or y = -infty & x <> +infty
  otherwise it = 0;
  commutativity;
end;

definition
  let x;
  func -x -> ext-real number means


  ex a being complex number st x = a & it = -a if x is real,
  it = -infty if x = +infty otherwise it = +infty;
  involutiveness;
end;

definition
  let x,y;
  func x - y -> ext-real number equals

  x + -y;
end;

registration
  let x,y be real number, a,b be complex number;
  identify x+y with a+b when x = a, y = b;
end;

registration
  let x be real number, a be complex number;
  identify -x with -a when x = a;
end;



registration
  let r be real number;
  cluster -r -> real;
end;



registration
  let r,s be real number;
  cluster r+s -> real;
  cluster r-s -> real;
end;

registration
  let x be real number, y be non real ext-real number;
  cluster x+y -> non real for number;
end;

registration
  let x,y be non real positive ext-real number;
  cluster x+y -> non real;
end;

registration
  let x,y be non real negative ext-real number;
  cluster x+y -> non real;
end;

registration
  let x be non real negative ext-real number, y be non real positive
  ext-real number;
  cluster x+y -> zero;
end;

registration
  let x,y be real number, a,b be complex number;
  identify x-y with a-b when x = a, y = b;
end;

theorem 
  x + 0 = x;

theorem 
  --infty = +infty;

theorem 
  -+infty = -infty;

theorem 
  x + -x = 0;

theorem 
  x+y = 0 implies x = -y;

theorem 
  -(x+y) = -x + -y;

reserve f,g for ext-real number;

theorem 
  -f = -g implies f = g;

theorem 
  r+f = r+g implies f = g;

theorem 
  r-f = r-g implies f = g;

theorem 
  x <> +infty implies +infty - x = +infty & x - +infty = -infty;

theorem 
  x <> -infty implies -infty - x = -infty & x - -infty = +infty;

theorem 
  x - 0 = x;

theorem 
  x + y = +infty implies x = +infty or y = +infty;

theorem 
  x + y = -infty implies (x = -infty or y = -infty);

theorem 
  x - y = +infty implies (x = +infty or y = -infty);

theorem 
  x - y = -infty implies (x = -infty or y = +infty);

theorem 
  not ( x = +infty & y = -infty or x = -infty & y = +infty ) & x +
  y in REAL implies x in REAL & y in REAL;

theorem 
  not ( x = +infty & y = +infty or x = -infty & y = -infty ) & x -
  y in REAL implies x in REAL & y in REAL;

theorem 
  x is real implies y - x + x = y & y + x - x = y;

theorem 
  (x = +infty iff -x = -infty) & (x = -infty iff -x = +infty);

theorem 
  z is real implies x = x + z - z;

theorem 
  -(x + y) = -y - x;

theorem 
  -(x - y) = -x + y & -(x - y) = y - x;

theorem 
  -(-x + y) = x - y & -(-x + y) = x + -y;

theorem 
  0 <= y & y < +infty implies z = z + y - y;

theorem 
  not (x = +infty & y = -infty) & not (x = -infty & y = +infty) &
  not ( y = +infty & z = -infty or y = -infty & z = +infty ) &
  not ( x = +infty & z = -infty or x = -infty & z = +infty ) implies
  x + y + z = x + (y + z);

theorem 
  not (x = +infty & y = -infty) & not (x = -infty & y = +infty) &
not (y = +infty & z = +infty) & not (y = -infty & z = -infty) & not (x = +infty
  & z = +infty) & not (x = -infty & z = -infty) implies x + y - z = x + (y - z)
;

theorem 
  not (x = +infty & y = +infty) & not (x = -infty & y = -infty) & not (y
= +infty & z = -infty) & not (y = -infty & z = +infty) & not (x = +infty & z =
  +infty) & not (x = -infty & z = -infty) implies x - y - z = x - (y + z);

theorem 
  not (x = +infty & y = +infty) & not (x = -infty & y = -infty) &
not (y = +infty & z = +infty) & not (y = -infty & z = -infty) & not (x = +infty
  & z = -infty) & not (x = -infty & z = +infty) implies x - y + z = x - (y - z)
;

theorem 
  z is real implies (z + x) - (z + y) = x - y;

theorem 
  y is real implies (z - y) + (y - x) = z - x;

begin

registration
  let x,y be non negative ext-real number;
  cluster x + y -> non negative;
end;

registration
  let x,y be non positive ext-real number;
  cluster x + y -> non positive;
end;

registration
  let x be positive ext-real number;
  let y be non negative ext-real number;
  cluster x + y -> positive;
  cluster y + x -> positive;
end;

registration
  let x be negative ext-real number;
  let y be non positive ext-real number;
  cluster x + y -> negative;
  cluster y + x -> negative;
end;

registration
  let x be non positive ext-real number;
  cluster -x -> non negative;
end;

registration
  let x be non negative ext-real number;
  cluster -x -> non positive;
end;

registration
  let x be positive ext-real number;
  cluster -x -> negative;
end;

registration
  let x be negative ext-real number;
  cluster -x -> positive;
end;

registration
  let x be non negative ext-real number, y be non positive ext-real number;
  cluster x - y -> non negative;
  cluster y - x -> non positive;
end;

registration
  let x be positive ext-real number;
  let y be non positive ext-real number;
  cluster x - y -> positive;
  cluster y - x -> negative;
end;

registration
  let x be negative ext-real number;
  let y be non negative ext-real number;
  cluster x - y -> negative;
  cluster y - x -> positive;
end;

theorem 
  x <= y implies x + z <= y + z;

theorem 
  x <= y & z <= w implies x + z <= y + w;

theorem 
  x <= y & z <= w implies x - w <= y - z;

theorem 
  x <= y iff - y <= - x;

theorem 
  0 <= z implies x <= x + z;

theorem 
  x <= y implies y-x >= 0;

theorem 
  (z = -infty & y = +infty implies x <= 0) & (z = +infty & y = -infty
  implies x <= 0) implies (x - y <= z implies x <= z + y);

theorem 
  (x = +infty & y = +infty implies 0 <= z) & (x = -infty & y = -infty
  implies 0 <= z) implies (x <= z + y implies x - y <= z);

theorem 
  z in REAL & x < y implies x + z < y + z & x - z < y - z;

theorem 
  0<= x & 0<= y & 0<= z implies (x + y) + z = x + (y + z);

theorem 
  x is real implies (y + x <= z iff y <= z - x);

theorem 
  0 < x & x < y implies 0 < y - x;

theorem 
  0 <= x & 0 <= z & z + x < y implies z < y - x;

theorem 
  0 <= x & 0 <= z & z + x < y implies z <= y;

theorem 
  0 <= x & x < z implies ex y being real number st 0 < y & x + y < z;

theorem 
  0 < x implies ex y being real number st 0 < y & y + y < x;

theorem 
  x < y & x < +infty & -infty < y implies 0 < y- x;

theorem 
  not ( x = +infty & y = -infty or x = -infty & y = +infty ) & x + y < z
  implies x <> +infty & y <> +infty & z <> -infty & x < z - y;

theorem 
  not ( z = +infty & y = +infty or z = -infty & y = -infty ) & x < z - y
  implies x <> +infty & y <> +infty & z <> -infty & x + y < z;

theorem 
  not ( x = +infty & y = +infty or x = -infty & y = -infty ) & x - y < z
  implies x <> +infty & y <> -infty & z <> -infty & x < z + y;

theorem 
  not ( z = +infty & y = -infty or z = -infty & y = +infty ) & x < z + y
  implies x <> +infty & y <> -infty & z <> -infty & x - y < z;

theorem 
  not ( x = +infty & y = -infty or x = -infty & y = +infty or y = +infty
& z = +infty or y = -infty & z = -infty ) & x + y <= z implies y <> +infty & x
  <= z - y;

theorem 
  not (x = +infty & y = -infty) & not (x = -infty & y = +infty) & not (y
  = +infty & z = +infty) & x <= z - y implies y <> +infty & x + y <= z;

theorem 
  not ( x = +infty & y = +infty or x = -infty & y = -infty or y = +infty
  & z = -infty or y = -infty & z = +infty ) & x - y <= z implies y <> -infty;

theorem 
  not (x = -infty & y = -infty) & not (y = -infty & z = +infty) & x <= z
  + y implies y <> -infty;

theorem 
  (x <= -y implies y <= -x) & (-x <= y implies -y <= x);

theorem 
  (for e be real number st 0 < e holds x < y + e) implies x <= y;

reserve t for ext-real number;

theorem 
  t <> -infty & t <> +infty & x < y implies x + t < y + t;

theorem 
  t <> -infty & t <> +infty & x < y implies x - t < y - t;

theorem 
  x < y & w < z implies x + w < y + z;

theorem 
  0 <= x & z + x <= y implies z <= y;

begin 

definition
  let x,y be ext-real number;
  func x * y -> ext-real number means


  ex a,b being complex number st x = a & y = b & it = a * b
    if x is real & y is real,
  it = +infty if (x is not real or y is not real) &
    (x is positive & y is positive or x is negative & y is negative),
  it = -infty if (x is not real or y is not real) &
    (x is positive & y is negative or x is negative & y is positive)
  otherwise it = 0;
  commutativity;
end;

registration
  let x,y be real number, a,b be complex number;
  identify x*y with a*b when x = a, y = b;
end;

definition
  let x be ext-real number;
  func x" -> ext-real number means


  ex a being complex number st x = a & it = a" if x is real otherwise it = 0;
end;

registration
  let x be real number, a be complex number;
  identify x" with a" when x = a;
end;

definition
  let x,y be ext-real number;
  func x / y -> ext-real number equals

  x * y";
end;

registration
  let x,y be real number, a,b be complex number;
  identify x/y with a/b when x = a, y = b;
end;

registration
  let x be positive ext-real number, y be negative ext-real number;
  cluster x*y -> negative;
end;

registration
  let x,y be negative ext-real number;
  cluster x*y -> positive;
end;

registration
  let x,y be positive ext-real number;
  cluster x*y -> positive;
end;

registration
  let x be non positive ext-real number, y be non negative ext-real number;
  cluster x*y -> non positive;
end;

registration
  let x,y be non positive ext-real number;
  cluster x*y -> non negative;
end;

registration
  let x,y be non negative ext-real number;
  cluster x*y -> non negative;
end;

registration
  let x be non positive ext-real number;
  cluster x" -> non positive;
end;

registration
  let x be non negative ext-real number;
  cluster x" -> non negative;
end;

registration
  let x be non negative ext-real number, y be non positive ext-real number;
  cluster x/y -> non positive;
  cluster y/x -> non positive;
end;

registration
  let x,y be non negative ext-real number;
  cluster x/y -> non negative;
end;

registration
  let x,y be non positive ext-real number;
  cluster x/y -> non negative;
end;

registration
  let x,y be non zero ext-real number;
  cluster x*y -> non zero;
end;

registration
  let x be zero ext-real number, y be ext-real number;
  cluster x*y -> zero for ext-real number;
end;

theorem 
  x*(y*z) = (x*y)*z;



registration
  let r be real number;
  cluster r" -> real;
end;



registration
  let r,s be real number;
  cluster r*s -> real;
  cluster r/s -> real;
end;

registration
  cluster -infty" -> zero;
  cluster +infty" -> zero;
end;

theorem 
  (f*g)" = f"*g";

theorem 
  r <> 0 & r*f = r*g implies f = g;

theorem 
  x <> +infty & x <> -infty & x * y = +infty implies y = +infty or y = -infty;

theorem 
  x <> +infty & x <> -infty & x * y = -infty implies y = +infty or y = -infty;

theorem 
  x <= y & 0 <= z implies x*z <= y*z;

theorem 
  x < y & 0 < z & z <> +infty implies x*z < y*z;

theorem 
  x*y in REAL implies x in REAL & y in REAL or x*y = 0;

theorem 
  +infty" = 0;

theorem 
  -infty" = 0;

theorem 
  x/+infty = 0;

theorem 
  x/-infty = 0;

theorem 
  x <> -infty & x <> +infty & x <> 0 implies x / x = 1;

theorem 
  x <= y & 0 < z implies x/z <= y/z;

theorem 
  x < y & 0 < z & z <> +infty implies x/z < y/z;

theorem 
  1*x = x;

theorem 
  y" = 0 implies y = +infty or y = -infty or y = 0;

theorem 
  0 < y & y <> +infty implies +infty / y = +infty;

theorem 
  y < 0 & -infty <> y implies -infty / y = +infty;

theorem 
  y < 0 & -infty <> y implies +infty / y = -infty;

theorem 
  0 < y & y <> +infty implies -infty / y = -infty;

theorem 
  x <> +infty & x <> -infty & x <> 0 implies x*(1/x) = 1 & (1/x)*x = 1;

theorem 
  -infty <> y & y <> +infty & y <> 0 implies x * y / y = x & x * (y / y) = x;

theorem 
  +infty * y <> 1 & -infty * y <> 1;

theorem 
  x * y <> +infty & x * y <> -infty implies x in REAL or y in REAL;

begin 

theorem 
  (-1)*x = -x;

theorem 
  - x*y = (-x)*y;

theorem 
  y = -z implies x*(y+z) = x*y +x*z;

theorem 
  2*x = x+x;

theorem 
  x is real implies x*(y+z) = x*y +x*z;

theorem 
  y>=0 & z>=0 implies x*(y+z) = x*y +x*z;

theorem 
  y<=0 & z<=0 implies x*(y+z) = x*y +x*z;

theorem 
  x*(0+z) = x*0 +x*z;

theorem 
  (-f)" = -f";

theorem 
  x is real implies x * (y - z) = x * y - x * z;

theorem 
  x <= y & z <= 0 implies y*z <= x*z;

theorem 
  x < y & z < 0 & z <> -infty implies y*z < x*z;

theorem 
  x <= y & z < 0 implies y/z <= x/z;

theorem 
  x < y & z < 0 & z <> -infty implies y/z < x/z;

theorem 
  x/2 + x/2 = x;














begin

reserve w, w1, w2 for Element of ExtREAL;
reserve c, c1, c2 for Element of COMPLEX;
reserve A, B, C, D for complex-membered set;
reserve F, G, H, I for ext-real-membered set;
reserve a, b, s, t, z for complex number;
reserve f, g, h, i, j for ext-real number;
reserve r for real number;
reserve e for set;

definition
  let w;
  redefine func -w -> Element of ExtREAL;
  redefine func w" -> Element of ExtREAL;
  let w1;
  redefine func w*w1 -> Element of ExtREAL;
end;

registration
  let a, b, c, d be complex number;
  cluster {a,b,c,d} -> complex-membered;
end;

registration
  let a, b, c, d be ext-real number;
  cluster {a,b,c,d} -> ext-real-membered;
end;

definition
  let F be ext-real-membered set;
  func --F -> ext-real-membered set equals

  {-w: w in F};
  involutiveness;
end;

theorem 
  f in F iff -f in --F;

theorem 
  -f in F iff f in --F;

registration
  let F be empty set;
  cluster --F -> empty;
end;

registration
  let F be ext-real-membered non empty set;
  cluster --F -> non empty;
end;

theorem 
  F c= G iff --F c= --G;

theorem 
  --F = --G implies F = G;

theorem 
  -- (F \/ G) = (--F) \/ (--G);

theorem 
  -- (F /\ G) = (--F) /\ (--G);

theorem 
  -- (F \ G) = (--F) \ (--G);

theorem 
  -- (F \+\ G) = (--F) \+\ (--G);

theorem 
  --{f} = {-f};

theorem 
  --{f,g} = {-f,-g};

definition
  let A be complex-membered set;
  func --A -> complex-membered set equals

  {-c: c in A};
  involutiveness;
end;

theorem 
  a in A iff -a in --A;

theorem 
  -a in A iff a in --A;

registration
  let A be empty set;
  cluster --A -> empty;
end;

registration
  let A be complex-membered non empty set;
  cluster --A -> non empty;
end;

registration
  let A be real-membered set;
  cluster --A -> real-membered;
end;

registration
  let A be rational-membered set;
  cluster --A -> rational-membered;
end;

registration
  let A be integer-membered set;
  cluster --A -> integer-membered;
end;

registration
  let A be real-membered set, F be ext-real-membered set;
  identify --A with --F when A = F;
end;

theorem 
  A c= B iff --A c= --B;

theorem 
  --A = --B implies A = B;

theorem 
  -- (A \/ B) = (--A) \/ (--B);

theorem 
  -- (A /\ B) = (--A) /\ (--B);

theorem 
  -- (A \ B) = (--A) \ (--B);

theorem 
  -- (A \+\ B) = (--A) \+\ (--B);

theorem 
  --{a} = {-a};

theorem 
  --{a,b} = {-a,-b};

definition
  let F be ext-real-membered set;
  func F"" -> ext-real-membered set equals

  {w": w in F};
end;

theorem 
  f in F implies f" in F"";

registration
  let F be empty set;
  cluster F"" -> empty;
end;

registration
  let F be ext-real-membered non empty set;
  cluster F"" -> non empty;
end;

theorem 
  F c= G implies F"" c= G"";

theorem 
  (F \/ G)"" = (F"") \/ (G"");

theorem 
  (F /\ G)"" c= (F"") /\ (G"");

theorem 
  --(F"") = (--F)"";

theorem 
  {f}"" = {f"};

theorem 
  {f,g}"" = {f",g"};

definition
  let A be complex-membered set;
  func A"" -> complex-membered set equals

  {c": c in A};
  involutiveness;
end;

theorem 
  a in A iff a" in A"";

theorem 
  a" in A iff a in A"";

registration
  let A be empty set;
  cluster A"" -> empty;
end;

registration
  let A be complex-membered non empty set;
  cluster A"" -> non empty;
end;

registration
  let A be real-membered set;
  cluster A"" -> real-membered;
end;

registration
  let A be rational-membered set;
  cluster A"" -> rational-membered;
end;

registration
  let A be real-membered set, F be ext-real-membered set;
  identify A"" with F"" when A = F;
end;

theorem 
  A c= B iff A"" c= B"";

theorem 
  A"" = B"" implies A = B;

theorem 
  (A \/ B)"" = (A"") \/ (B"");

theorem 
  (A /\ B)"" = (A"") /\ (B"");

theorem 
  (A \ B)"" = (A"") \ (B"");

theorem 
  (A \+\ B)"" = (A"") \+\ (B"");

theorem 
  --(A"") = (--A)"";

theorem 
  {a}"" = {a"};

theorem 
  {a,b}"" = {a",b"};

definition
  let F, G be ext-real-membered set;
  func F++G equals

  {w1+w2: w1 in F & w2 in G};
  commutativity;
end;

theorem 
  f in F & g in G implies f+g in F++G;

registration
  let F be empty set;
  let G be ext-real-membered set;
  cluster F++G -> empty;
  cluster G++F -> empty;
end;

registration
  let F, G be ext-real-membered non empty set;
  cluster F++G -> non empty;
end;

registration
  let F, G be ext-real-membered set;
  cluster F++G -> ext-real-membered;
end;

theorem 
  F c= G & H c= I implies F++H c= G++I;

theorem 
  F ++ (G \/ H) = (F++G) \/ (F++H);

theorem 
  F ++ (G /\ H) c= (F++G) /\ (F++H);

theorem 
  {f}++{g} = {f+g};

theorem 
  {f}++{g,h} = {f+g,f+h};

theorem 
  {f,g}++{h,i} = {f+h,f+i,g+h,g+i};

definition
  let A, B be complex-membered set;
  func A++B equals

  {c1+c2: c1 in A & c2 in B};
  commutativity;
end;

theorem 
  a in A & b in B implies a+b in A++B;

registration
  let A be empty set;
  let B be complex-membered set;
  cluster A++B -> empty;
  cluster B++A -> empty;
end;

registration
  let A, B be complex-membered non empty set;
  cluster A++B -> non empty;
end;

registration
  let A, B be complex-membered set;
  cluster A++B -> complex-membered;
end;

registration
  let A, B be real-membered set;
  cluster A++B -> real-membered;
end;

registration
  let A, B be rational-membered set;
  cluster A++B -> rational-membered;
end;

registration
  let A, B be integer-membered set;
  cluster A++B -> integer-membered;
end;

registration
  let A, B be natural-membered set;
  cluster A++B -> natural-membered;
end;

registration
  let A, B be real-membered set, F, G be ext-real-membered set;
  identify A++B with F++G when A = F, B = G;
end;

theorem 
  A c= B & C c= D implies A++C c= B++D;

theorem 
  A ++ (B \/ C) = (A++B) \/ (A++C);

theorem 
  A ++ (B /\ C) c= (A++B) /\ (A++C);

theorem 
  (A++B)++C = A++(B++C);

theorem 
  {a}++{b} = {a+b};

theorem 
  {a}++{s,t} = {a+s,a+t};

theorem 
  {a,b}++{s,t} = {a+s,a+t,b+s,b+t};

definition
  let F, G be ext-real-membered set;
  func F--G equals

  F ++ --G;
end;

theorem 
  F--G = {w1-w2: w1 in F & w2 in G};

theorem 
  f in F & g in G implies f-g in F--G;

registration
  let F be empty set;
  let G be ext-real-membered set;
  cluster F--G -> empty;
  cluster G--F -> empty;
end;

registration
  let F, G be ext-real-membered non empty set;
  cluster F--G -> non empty;
end;

registration
  let F, G be ext-real-membered set;
  cluster F--G -> ext-real-membered;
end;

theorem 
  F c= G & H c= I implies F--H c= G--I;

theorem 
  F -- (G \/ H) = (F--G) \/ (F--H);

theorem 
  F -- (G /\ H) c= (F--G) /\ (F--H);

theorem 
  --(F++G) = (--F) -- G;

theorem 
  --(F--G) = (--F) ++ G;

theorem 
  {f}--{g} = {f-g};

theorem 
  {f}--{h,i} = {f-h,f-i};

theorem 
  {f,g}--{h} = {f-h,g-h};

theorem 
  {f,g}--{h,i} = {f-h,f-i,g-h,g-i};

definition
  let A, B be complex-membered set;
  func A--B equals

  A ++ --B;
end;

theorem 
  A--B = {c1-c2: c1 in A & c2 in B};

theorem 
  a in A & b in B implies a-b in A--B;

registration
  let A be empty set;
  let B be complex-membered set;
  cluster A--B -> empty;
  cluster B--A -> empty;
end;

registration
  let A, B be complex-membered non empty set;
  cluster A--B -> non empty;
end;

registration
  let A, B be complex-membered set;
  cluster A--B -> complex-membered;
end;

registration
  let A, B be real-membered set;
  cluster A--B -> real-membered;
end;

registration
  let A, B be rational-membered set;
  cluster A--B -> rational-membered;
end;

registration
  let A, B be integer-membered set;
  cluster A--B -> integer-membered;
end;

registration
  let A, B be real-membered set, F, G be ext-real-membered set;
  identify A--B with F--G when A = F, B = G;
end;

theorem 
  A c= B & C c= D implies A--C c= B--D;

theorem 
  A -- (B \/ C) = (A--B) \/ (A--C);

theorem 
  A -- (B /\ C) c= (A--B) /\ (A--C);

theorem 
  --(A++B) = (--A) -- B;

theorem 
  --(A--B) = (--A) ++ B;

theorem 
  A++(B--C) = A++B--C;

theorem 
  A--(B++C) = A--B--C;

theorem 
  A--(B--C) = A--B++C;

theorem 
  {a}--{b} = {a-b};

theorem 
  {a}--{s,t} = {a-s,a-t};

theorem 
  {a,b}--{s} = {a-s,b-s};

theorem 
  {a,b}--{s,t} = {a-s,a-t,b-s,b-t};

definition
  let F, G be ext-real-membered set;
  func F**G equals

  {w1*w2: w1 in F & w2 in G};
  commutativity;
end;

registration
  let F be empty set;
  let G be ext-real-membered set;
  cluster F**G -> empty;
  cluster G**F -> empty;
end;

registration
  let F, G be ext-real-membered set;
  cluster F**G -> ext-real-membered;
end;

theorem 
  f in F & g in G implies f*g in F**G;

registration
  let F, G be ext-real-membered non empty set;
  cluster F**G -> non empty;
end;

theorem 
  (F**G)**H = F**(G**H);

theorem 
  F c= G & H c= I implies F**H c= G**I;

theorem 
  F ** (G \/ H) = (F**G) \/ (F**H);

theorem 
  F ** (G /\ H) c= (F**G) /\ (F**H);

theorem 
  F**--G = --(F**G);

theorem 
  (F**G)"" = (F"") ** (G"");

theorem 
  {f}**{g} = {f*g};

theorem 
  {f}**{h,i} = {f*h,f*i};

theorem 
  {f,g}**{h,i} = {f*h,f*i,g*h,g*i};

definition
  let A, B be complex-membered set;
  func A**B equals

  {c1*c2: c1 in A & c2 in B};
  commutativity;
end;

theorem 
  a in A & b in B implies a*b in A**B;

registration
  let A be empty set;
  let B be complex-membered set;
  cluster A**B -> empty;
  cluster B**A -> empty;
end;

registration
  let A, B be complex-membered non empty set;
  cluster A**B -> non empty;
end;

registration
  let A, B be complex-membered set;
  cluster A**B -> complex-membered;
end;

registration
  let A, B be real-membered set;
  cluster A**B -> real-membered;
end;

registration
  let A, B be rational-membered set;
  cluster A**B -> rational-membered;
end;

registration
  let A, B be integer-membered set;
  cluster A**B -> integer-membered;
end;

registration
  let A, B be natural-membered set;
  cluster A**B -> natural-membered;
end;

registration
  let A, B be real-membered set, F, G be ext-real-membered set;
  identify A**B with F**G when A = F, B = G;
end;

theorem 
  (A**B)**C = A**(B**C);

theorem 
  A c= B & C c= D implies A**C c= B**D;

theorem 
  A ** (B \/ C) = (A**B) \/ (A**C);

theorem 
  A ** (B /\ C) c= (A**B) /\ (A**C);

theorem 
  A**--B = --(A**B);

theorem 
  A**(B++C) c= A**B ++ A**C;

theorem 
  A**(B--C) c= A**B -- A**C;

theorem 
  (A**B)"" = (A"") ** (B"");

theorem 
  {a}**{b} = {a*b};

theorem 
  {a}**{s,t} = {a*s,a*t};

theorem 
  {a,b}**{s,t} = {a*s,a*t,b*s,b*t};

definition
  let F, G be ext-real-membered set;
  func F///G equals

  F**(G"");
end;

theorem 
  F///G = {w1/w2: w1 in F & w2 in G};

theorem 
  f in F & g in G implies f/g in F///G;

registration
  let F be empty set;
  let G be ext-real-membered set;
  cluster F///G -> empty;
  cluster G///F -> empty;
end;

registration
  let F, G be ext-real-membered non empty set;
  cluster F///G -> non empty;
end;

registration
  let F, G be ext-real-membered set;
  cluster F///G -> ext-real-membered;
end;

theorem 
  F c= G & H c= I implies F///H c= G///I;

theorem 
  (F \/ G) /// H = (F///H) \/ (G///H);

theorem 
  (F /\ G) /// H c= (F///H) /\ (G///H);

theorem 
  F /// (G \/ H) = (F///G) \/ (F///H);

theorem 
  F /// (G /\ H) c= (F///G) /\ (F///H);

theorem 
  (F**G)///H = F**(G///H);

theorem 
  (F///G)**H = (F**H)///G;

theorem 
  (F///G)///H = F///(G**H);

theorem 
  {f}///{g} = {f/g};

theorem 
  {f}///{h,i} = {f/h,f/i};

theorem 
  {f,g}///{h} = {f/h,g/h};

theorem 
  {f,g}///{h,i} = {f/h,f/i,g/h,g/i};

definition
  let A, B be complex-membered set;
  func A///B equals

  A**(B"");
end;

theorem 
  A///B = {c1/c2: c1 in A & c2 in B};

theorem 
  a in A & b in B implies a/b in A///B;

registration
  let A be empty set;
  let B be complex-membered set;
  cluster A///B -> empty;
  cluster B///A -> empty;
end;

registration
  let A, B be complex-membered non empty set;
  cluster A///B -> non empty;
end;

registration
  let A, B be complex-membered set;
  cluster A///B -> complex-membered;
end;

registration
  let A, B be real-membered set;
  cluster A///B -> real-membered;
end;

registration
  let A, B be rational-membered set;
  cluster A///B -> rational-membered;
end;

registration
  let A, B be real-membered set, F, G be ext-real-membered set;
  identify A///B with F///G when A = F, B = G;
end;

theorem 
  A c= B & C c= D implies A///C c= B///D;

theorem 
  A /// (B \/ C) = (A///B) \/ (A///C);

theorem 
  A /// (B /\ C) c= (A///B) /\ (A///C);

theorem 
  A///--B = --(A///B);

theorem 
  (--A)///B = --(A///B);

theorem 
  (A++B)///C c= A///C ++ B///C;

theorem 
  (A--B)///C c= A///C -- B///C;

theorem 
  (A**B)///C = A**(B///C);

theorem 
  (A///B)**C = (A**C)///B;

theorem 
  (A///B)///C = A///(B**C);

theorem 
  A///(B///C) = (A**C)///B;

theorem 
  {a}///{b} = {a/b};

theorem 
  {a}///{s,t} = {a/s,a/t};

theorem 
  {a,b}///{s} = {a/s,b/s};

theorem 
  {a,b}///{s,t} = {a/s,a/t,b/s,b/t};

definition
  let F be ext-real-membered set;
  let f be ext-real number;
  func f++F equals

  {f}++F;
end;

theorem 
  g in G implies f+g in f++G;

theorem 
  f++F = {f+w: w in F};

theorem 
  e in f++F implies ex w st e = f+w & w in F;

registration
  let F be empty set;
  let f be ext-real number;
  cluster f++F -> empty;
end;

registration
  let F be ext-real-membered non empty set;
  let f be ext-real number;
  cluster f++F -> non empty;
end;

registration
  let F be ext-real-membered set;
  let f be ext-real number;
  cluster f++F -> ext-real-membered;
end;

theorem 
  r++F c= r++G implies F c= G;

theorem 
  r++F = r++G implies F = G;

theorem 
  r ++ (F /\ G) = (r++F) /\ (r++G);

theorem 
  (f++F) \ (f++G) c= f ++ (F \ G);

theorem 
  r ++ (F \ G) = (r++F) \ (r++G);

theorem 
  r ++ (F \+\ G) = (r++F) \+\ (r++G);

definition
  let A be complex-membered set;
  let a be complex number;
  func a++A equals

  {a}++A;
end;

theorem 
  b in A implies a+b in a++A;

theorem 
  a++A = {a+c: c in A};

theorem 
  e in a++A implies ex c st e = a+c & c in A;

registration
  let A be empty set;
  let a be complex number;
  cluster a++A -> empty;
end;

registration
  let A be complex-membered non empty set;
  let a be complex number;
  cluster a++A -> non empty;
end;

registration
  let A be complex-membered set;
  let a be complex number;
  cluster a++A -> complex-membered;
end;

registration
  let A be real-membered set;
  let a be real number;
  cluster a++A -> real-membered;
end;

registration
  let A be rational-membered set;
  let a be rational number;
  cluster a++A -> rational-membered;
end;

registration
  let A be integer-membered set;
  let a be integer number;
  cluster a++A -> integer-membered;
end;

registration
  let A be natural-membered set;
  let a be Nat;
  cluster a++A -> natural-membered;
end;

registration
  let A be real-membered set, F be ext-real-membered set;
  let a be real number, f be ext-real number;
  identify a++A with f++F when a = f, A = F;
end;

theorem 
  A c= B iff a++A c= a++B;

theorem 
  a++A = a++B implies A = B;

theorem 
  0++A = A;

theorem 
  (a+b)++A = a++(b++A);

theorem 
  a++(A++B) = (a++A)++B;

theorem 
  a ++ (A /\ B) = (a++A) /\ (a++B);

theorem 
  a ++ (A \ B) = (a++A) \ (a++B);

theorem 
  a ++ (A \+\ B) = (a++A) \+\ (a++B);

definition
  let F be ext-real-membered set;
  let f be ext-real number;
  func f--F equals

  {f}--F;
end;

theorem 
  g in G implies f-g in f--G;

theorem 
  f--F = {f-w: w in F};

theorem 
  e in f--F implies ex w st e = f-w & w in F;

registration
  let F be empty set;
  let f be ext-real number;
  cluster f--F -> empty;
end;

registration
  let F be ext-real-membered non empty set;
  let f be ext-real number;
  cluster f--F -> non empty;
end;

registration
  let F be ext-real-membered set;
  let f be ext-real number;
  cluster f--F -> ext-real-membered;
end;

theorem 
  r--F c= r--G implies F c= G;

theorem 
  r--F = r--G implies F = G;

theorem 
  r -- (F/\G) = (r--F) /\ (r--G);

theorem 
  r -- (F\G) = (r--F) \ (r--G);

theorem 
  r -- (F\+\G) = (r--F) \+\ (r--G);

definition
  let A be complex-membered set;
  let a be complex number;
  func a--A equals

  {a}--A;
end;

theorem 
  b in A implies a-b in a--A;

theorem 
  a--A = {a-c: c in A};

theorem 
  e in a--A implies ex c st e = a-c & c in A;

registration
  let A be empty set;
  let a be complex number;
  cluster a--A -> empty;
end;

registration
  let A be complex-membered non empty set;
  let a be complex number;
  cluster a--A -> non empty;
end;

registration
  let A be complex-membered set;
  let a be complex number;
  cluster a--A -> complex-membered;
end;

registration
  let A be real-membered set;
  let a be real number;
  cluster a--A -> real-membered;
end;

registration
  let A be rational-membered set;
  let a be rational number;
  cluster a--A -> rational-membered;
end;

registration
  let A be integer-membered set;
  let a be integer number;
  cluster a--A -> integer-membered;
end;

registration
  let A be real-membered set, F be ext-real-membered set;
  let a be real number, f be ext-real number;
  identify a--A with f--F when a = f, A = F;
end;

theorem 
  A c= B iff a--A c= a--B;

theorem 
  a--A = a--B implies A = B;

theorem 
  a -- (A/\B) = (a--A) /\ (a--B);

theorem 
  a -- (A\B) = (a--A) \ (a--B);

theorem 
  a -- (A\+\B) = (a--A) \+\ (a--B);

definition
  let F be ext-real-membered set;
  let f be ext-real number;
  func F--f equals

  F--{f};
end;

theorem 
  g in G implies g-f in G--f;

theorem 
  F--f = {w-f: w in F};

theorem 
  e in F--f implies ex w st e = w-f & w in F;

registration
  let F be empty set;
  let f be ext-real number;
  cluster F--f -> empty;
end;

registration
  let F be ext-real-membered non empty set;
  let f be ext-real number;
  cluster F--f -> non empty;
end;

registration
  let F be ext-real-membered set;
  let f be ext-real number;
  cluster F--f -> ext-real-membered;
end;

theorem 
  F -- f = -- (f -- F);

theorem 
  f -- F = -- (F -- f);

theorem 
  (F/\G) -- r = (F--r) /\ (G--r);

theorem 
  (F\G) -- r = (F--r) \ (G--r);

theorem 
  (F\+\G) -- r = (F--r) \+\ (G--r);

definition
  let A be complex-membered set;
  let a be complex number;
  func A--a equals

  A--{a};
end;

theorem 
  b in A implies b-a in A--a;

theorem 
  A--a = {c-a: c in A};

theorem 
  e in A--a implies ex c st e = c-a & c in A;

registration
  let A be empty set;
  let a be complex number;
  cluster A--a -> empty;
end;

registration
  let A be complex-membered non empty set;
  let a be complex number;
  cluster A--a -> non empty;
end;

registration
  let A be complex-membered set;
  let a be complex number;
  cluster A--a -> complex-membered;
end;

registration
  let A be real-membered set;
  let a be real number;
  cluster A--a -> real-membered;
end;

registration
  let A be rational-membered set;
  let a be rational number;
  cluster A--a -> rational-membered;
end;

registration
  let A be integer-membered set;
  let a be integer number;
  cluster A--a -> integer-membered;
end;

registration
  let A be real-membered set, F be ext-real-membered set;
  let a be real number, f be ext-real number;
  identify A--a with F--f when a = f, A = F;
end;

theorem 
  A c= B iff A--a c= B--a;

theorem 
  A--a = B--a implies A = B;

theorem 
  A -- a = -- (a -- A);

theorem 
  a -- A = -- (A -- a);

theorem 
  (A/\B) -- a = (A--a) /\ (B--a);

theorem 
  (A\B) -- a = (A--a) \ (B--a);

theorem 
  (A\+\B) -- a = (A--a) \+\ (B--a);

definition
  let F be ext-real-membered set;
  let f be ext-real number;
  func f**F equals

  {f}**F;
end;

theorem 
  g in G implies f*g in f**G;

theorem 
  f**F = {f*w: w in F};

theorem 
  e in f**F implies ex w st e = f*w & w in F;

registration
  let F be empty set;
  let f be ext-real number;
  cluster f**F -> empty;
end;

registration
  let F be ext-real-membered non empty set;
  let f be ext-real number;
  cluster f**F -> non empty;
end;

registration
  let F be ext-real-membered set;
  let f be ext-real number;
  cluster f**F -> ext-real-membered;
end;

theorem 
  r <> 0 implies r ** (F/\G) = (r**F) /\ (r**G);

theorem 
  (f**F) \ (f**G) c= f ** (F \ G);

theorem 
  r <> 0 implies r ** (F\G) = (r**F) \ (r**G);

theorem 
  r <> 0 implies r ** (F\+\G) = (r**F) \+\ (r**G);

definition
  let A be complex-membered set;
  let a be complex number;
  func a**A equals

  {a}**A;
end;

theorem 
  b in A implies a*b in a**A;

theorem 
  a**A = {a*c: c in A};

theorem 
  e in a**A implies ex c st e = a*c & c in A;

registration
  let A be empty set;
  let a be complex number;
  cluster a**A -> empty;
end;

registration
  let A be complex-membered non empty set;
  let a be complex number;
  cluster a**A -> non empty;
end;

registration
  let A be complex-membered set;
  let a be complex number;
  cluster a**A -> complex-membered;
end;

registration
  let A be real-membered set;
  let a be real number;
  cluster a**A -> real-membered;
end;

registration
  let A be rational-membered set;
  let a be rational number;
  cluster a**A -> rational-membered;
end;

registration
  let A be integer-membered set;
  let a be integer number;
  cluster a**A -> integer-membered;
end;

registration
  let A be natural-membered set;
  let a be Nat;
  cluster a**A -> natural-membered;
end;

registration
  let A be real-membered set, F be ext-real-membered set;
  let a be real number, f be ext-real number;
  identify a**A with f**F when a = f, A = F;
end;

theorem 
  a <> 0 & a**A c= a**B implies A c= B;

theorem 
  a <> 0 & a**A = a**B implies A = B;

theorem 
  a <> 0 implies a ** (A/\B) = (a**A) /\ (a**B);

theorem 
  a <> 0 implies a ** (A\B) = (a**A) \ (a**B);

theorem 
  a <> 0 implies a ** (A\+\B) = (a**A) \+\ (a**B);

theorem 
  0**A c= {0};

theorem 
  A <> {} implies 0**A = {0};

theorem 
  1**A = A;

theorem 
  (a*b)**A = a**(b**A);

theorem 
  a**(A**B) = (a**A)**B;

theorem 
  (a+b)**A c= a**A ++ b**A;

theorem 
  (a-b)**A c= a**A -- b**A;

theorem 
  a**(B++C) = a**B++a**C;

theorem 
  a**(B--C) = a**B--a**C;

definition
  let F be ext-real-membered set;
  let f be ext-real number;
  func f///F equals

  {f}///F;
end;

theorem 
  g in G implies f/g in f///G;

theorem 
  f///F = {f/w: w in F};

theorem 
  e in f///F implies ex w st e = f/w & w in F;

registration
  let F be empty set;
  let f be ext-real number;
  cluster f///F -> empty;
end;

registration
  let F be ext-real-membered non empty set;
  let f be ext-real number;
  cluster f///F -> non empty;
end;

registration
  let F be ext-real-membered set;
  let f be ext-real number;
  cluster f///F -> ext-real-membered;
end;

definition
  let A be complex-membered set;
  let a be complex number;
  func a///A equals

  {a}///A;
end;

theorem 
  b in A implies a/b in a///A;

theorem 
  a///A = {a/c: c in A};

theorem 
  e in a///A implies ex c st e = a/c & c in A;

registration
  let A be empty set;
  let a be complex number;
  cluster a///A -> empty;
end;

registration
  let A be complex-membered non empty set;
  let a be complex number;
  cluster a///A -> non empty;
end;

registration
  let A be complex-membered set;
  let a be complex number;
  cluster a///A -> complex-membered;
end;

registration
  let A be real-membered set;
  let a be real number;
  cluster a///A -> real-membered;
end;

registration
  let A be rational-membered set;
  let a be rational number;
  cluster a///A -> rational-membered;
end;

registration
  let A be real-membered set, F be ext-real-membered set;
  let a be real number, f be ext-real number;
  identify a///A with f///F when a = f, A = F;
end;

theorem 
  a <> 0 & a///A c= a///B implies A c= B;

theorem 
  a <> 0 & a///A = a///B implies A = B;

theorem 
  a <> 0 implies a /// (A/\B) = (a///A) /\ (a///B);

theorem 
  a <> 0 implies a /// (A\B) = (a///A) \ (a///B);

theorem 
  a <> 0 implies a /// (A\+\B) = (a///A) \+\ (a///B);

theorem 
  (a+b)///A c= a///A ++ b///A;

theorem 
  (a-b)///A c= a///A -- b///A;

definition
  let F be ext-real-membered set;
  let f be ext-real number;
  func F///f equals

  F///{f};
end;

theorem 
  g in G implies g/f in G///f;

theorem 
  F///f = {w/f: w in F};

theorem 
  e in F///f implies ex w st e = w/f & w in F;

registration
  let F be empty set;
  let f be ext-real number;
  cluster F///f -> empty;
end;

registration
  let F be ext-real-membered non empty set;
  let f be ext-real number;
  cluster F///f -> non empty;
end;

registration
  let F be ext-real-membered set;
  let f be ext-real number;
  cluster F///f -> ext-real-membered;
end;

definition
  let A be complex-membered set;
  let a be complex number;
  func A///a equals

  A///{a};
end;

theorem 
  b in A implies b/a in A///a;

theorem 
  A///a = {c/a: c in A};

theorem 
  e in A///a implies ex c st e = c/a & c in A;

registration
  let A be empty set;
  let a be complex number;
  cluster A///a -> empty;
end;

registration
  let A be complex-membered non empty set;
  let a be complex number;
  cluster A///a -> non empty;
end;

registration
  let A be complex-membered set;
  let a be complex number;
  cluster A///a -> complex-membered;
end;

registration
  let A be real-membered set;
  let a be real number;
  cluster A///a -> real-membered;
end;

registration
  let A be rational-membered set;
  let a be rational number;
  cluster A///a -> rational-membered;
end;

registration
  let A be real-membered set, F be ext-real-membered set;
  let a be real number, f be ext-real number;
  identify A///a with F///f when a = f, A = F;
end;

theorem 
  a <> 0 & A///a c= B///a implies A c= B;

theorem 
  a <> 0 & A///a = B///a implies A = B;

theorem 
  a <> 0 implies (A/\B) /// a = (A///a) /\ (B///a);

theorem 
  a <> 0 implies (A\B) /// a = (A///a) \ (B///a);

theorem 
  a <> 0 implies (A\+\B) /// a = (A///a) \+\ (B///a);

theorem 
  (A++B)///a = A///a ++ B///a;

theorem 
  (A--B)///a = A///a -- B///a;














begin

definition
  mode R_eal is Element of ExtREAL;
end;

definition
  redefine func +infty -> R_eal;
  redefine func -infty -> R_eal;
end;





definition

  let X be ext-real-membered set;
  func SetMajorant(X) -> ext-real-membered set means


  for x being ext-real number holds x in it iff x is UpperBound of X;
end;

registration
  let X be ext-real-membered set;
  cluster SetMajorant(X) -> non empty;
end;

theorem 
  for X,Y being ext-real-membered set st X c= Y holds for x being
  ext-real number holds x in SetMajorant Y implies x in SetMajorant(X);

definition
  let X be ext-real-membered set;
  func SetMinorant(X) -> ext-real-membered set means


  for x being ext-real number holds x in it iff x is LowerBound of X;
end;

registration
  let X be ext-real-membered set;
  cluster SetMinorant(X) -> non empty;
end;

theorem 
  for X,Y being ext-real-membered set st X c= Y holds for x being
  ext-real number holds x in SetMinorant(Y) implies x in SetMinorant(X);





theorem 
  for X being non empty ext-real-membered set holds sup X = inf
  SetMajorant(X) & inf X = sup SetMinorant(X);

registration
  let X be non empty set;
  cluster non empty with_non-empty_elements for Subset-Family of X;
end;

definition
  let X be non empty set;
  mode bool_DOMAIN of X is non empty with_non-empty_elements Subset-Family of
    X;
end;

definition
  let F be bool_DOMAIN of ExtREAL;

  func SUP(F) -> ext-real-membered set means


  for a being ext-real
number holds a in it iff ex A being non empty ext-real-membered set st A in F &
  a = sup A;
end;

registration
  let F be bool_DOMAIN of ExtREAL;
  cluster SUP(F) -> non empty;
end;

theorem 
  for F being bool_DOMAIN of ExtREAL, S being non empty
  ext-real-membered number st S = union F holds sup S is UpperBound of SUP(F);

theorem 
  for F being bool_DOMAIN of ExtREAL, S being ext-real-membered
  set st S = union F holds sup SUP(F) is UpperBound of S;

theorem 
  for F being bool_DOMAIN of ExtREAL, S being non empty
  ext-real-membered set st S = union F holds sup S = sup SUP(F);

definition
  let F be bool_DOMAIN of ExtREAL;
  func INF F -> ext-real-membered set means


  for a being ext-real
number holds a in it iff ex A being non empty ext-real-membered set st A in F &
  a = inf A;
end;

registration
  let F be bool_DOMAIN of ExtREAL;
  cluster INF(F) -> non empty;
end;

theorem 
  for F being bool_DOMAIN of ExtREAL, S being non empty
  ext-real-membered set st S = union F holds inf S is LowerBound of INF(F);

theorem 
  for F being bool_DOMAIN of ExtREAL, S being ext-real-membered
  set st S = union F holds inf INF(F) is LowerBound of S;

theorem 
  for F being bool_DOMAIN of ExtREAL, S being non empty
  ext-real-membered set st S = union F holds inf S = inf INF(F);














begin

reserve x, a, b, c for real number;

definition
  let a,b,c be complex number;
  func delta(a,b,c) equals

  b^2 - 4 * a * c;
end;

registration
  let a,b,c be complex number;
  cluster delta(a,b,c) -> complex;
end;

registration
  let a,b,c;
  cluster delta(a,b,c) -> real;
end;

definition
  let a,b,c be Real;
  redefine func delta(a,b,c) -> Real;
end;

theorem 
  for a, b, c, x being complex number holds a <> 0 implies a * x^2
  + b * x + c = a * (x + b/(2 * a))^2 - delta(a,b,c)/(4 * a);

theorem 
  a > 0 & delta(a,b,c) <= 0 implies a * x^2 + b * x + c >= 0;

theorem 
  a > 0 & delta(a,b,c) < 0 implies a * x^2 + b * x + c > 0;

theorem 
  a < 0 & delta(a,b,c) <= 0 implies a * x^2 + b * x + c <= 0;

theorem 
  a < 0 & delta(a,b,c) < 0 implies a * x^2 + b * x + c < 0;

theorem 
  a > 0 & a * x^2 + b * x + c >= 0 implies (2 * a * x + b)^2 -
  delta(a,b,c) >= 0;

theorem 
  a > 0 & a * x^2 + b * x + c > 0 implies (2 * a * x + b)^2 - delta (a,b,c) > 0
;

theorem 
  a < 0 & a * x^2 + b * x + c <= 0 implies (2 * a * x + b)^2 -
  delta(a,b,c) >= 0;

theorem 
  a < 0 & a * x^2 + b * x + c < 0 implies (2 * a * x + b)^2 - delta (a,b,c) > 0
;

theorem 
  ( for x holds a * x^2 + b * x + c >= 0 ) & a > 0 implies delta(a,b,c) <= 0;

theorem 
  ( for x holds a * x^2 + b * x + c <= 0 ) & a < 0 implies delta(a,b,c) <= 0;

theorem 
  ( for x holds a * x^2 + b * x + c > 0 ) & a > 0 implies delta(a,b,c) < 0;

theorem 
  ( for x holds a * x^2 + b * x + c < 0 ) & a < 0 implies delta(a,b,c) < 0;

theorem 
  for a, b, c, x being complex number holds a <> 0 & a * x^2 + b *
  x + c = 0 implies (2 * a * x + b)^2 - delta(a,b,c) = 0;

theorem 
  a <> 0 & delta(a,b,c) >= 0 & a * x^2 + b * x + c = 0 implies x = (- b
  - sqrt delta(a,b,c))/(2 * a) or x = (- b + sqrt delta(a,b,c))/(2 * a);

theorem 
  a <> 0 & delta(a,b,c) >= 0 implies a * x^2 + b * x + c = a * (x
- (- b - sqrt delta(a,b,c))/(2 * a)) * (x - (- b + sqrt delta(a,b,c))/(2 * a));

theorem 
  a < 0 & delta(a,b,c) > 0 implies (- b + sqrt delta(a,b,c))/(2 *
  a) < (- b - sqrt delta(a,b,c))/(2 * a);

theorem 
  a < 0 & delta(a,b,c) > 0 implies ( a * x^2 + b * x + c > 0 iff (- b +
  sqrt delta(a,b,c))/(2 * a) < x & x < (- b - sqrt delta(a,b,c))/(2 * a) );

theorem 
  a < 0 & delta(a,b,c) > 0 implies ( a * x^2 + b * x + c < 0 iff x < (-
  b + sqrt delta(a,b,c))/(2 * a) or x > (- b - sqrt delta(a,b,c))/(2 * a) );

theorem 
  for a, b, c, x being complex number holds a <> 0 & delta(a,b,c) = 0 &
  a * x^2 + b * x + c = 0 implies x = - b/(2 * a);

theorem 
  a > 0 & (2 * a * x + b)^2 - delta(a,b,c) > 0 implies a * x^2 + b * x + c > 0;

theorem 
  a > 0 & delta(a,b,c) = 0 implies ( a * x^2 + b * x + c > 0 iff x <> -
  b/(2 * a) );

theorem 
  a < 0 & (2 * a * x + b)^2 - delta(a,b,c) > 0 implies a * x^2 + b * x + c < 0;

theorem 
  a < 0 & delta(a,b,c) = 0 implies ( a * x^2 + b * x + c < 0 iff x <> -
  b/(2 * a) );

theorem 
  a > 0 & delta(a,b,c) > 0 implies (- b + sqrt delta(a,b,c))/(2 *
  a) > (- b - sqrt delta(a,b,c))/(2 * a);

theorem 
  a > 0 & delta(a,b,c) > 0 implies ( a * x^2 + b * x + c < 0 iff (- b -
  sqrt delta(a,b,c))/(2 * a) < x & x < (- b + sqrt delta(a,b,c))/(2 * a) );

theorem 
  a > 0 & delta(a,b,c) > 0 implies ( a * x^2 + b * x + c > 0 iff x < (-
  b - sqrt delta(a,b,c))/(2 * a) or x > (- b + sqrt delta(a,b,c))/(2 * a) );














begin

theorem 
  for X,x being set holds for F being Function of [:X,X:],X holds x
  in [:X,X:] implies F.x in X;

definition

  let X be set;
  let F be BinOp of X;
  mode Preserv of F -> Subset of X means


    for x being set holds x in [: it,it:] implies F.x in it;
end;

definition
  let R be Relation;
  let A be set;
  func R||A equals

  R | [:A,A:];
end;

registration
  let R be Relation;
  let A be set;
  cluster R||A -> Relation-like;
end;

registration
  let R be Function;
  let A be set;
  cluster R||A -> Function-like;
end;

theorem 
  for X being set, F being BinOp of X, A being Preserv of F holds F
  ||A is BinOp of A;

definition
  let X be set;
  let F be BinOp of X;
  let A be Preserv of F;
  redefine func F||A -> BinOp of A;
end;

theorem 
  for X being set holds X is non trivial iff for x being
  set holds X\{x} is non empty set;

theorem 
  ex A being non empty set st for z being Element of A holds A \ {z} is
  non empty set;

definition

  let X be non trivial set;
  let F be BinOp of X;
  let x be Element of X;
  pred F is_Bin_Op_Preserv x means

  X\{x} is Preserv of F & F||X\{x} is BinOp of X\{x};
end;

theorem 
  for X being set holds for A being Subset of X holds ex F being
  BinOp of X st for x being set holds x in [:A,A:] implies F.x in A;

definition
  let X be set;
  let A be Subset of X;
  mode Presv of X,A -> BinOp of X means


    for x being set holds x in [:A, A:] implies it.x in A;
end;

theorem 
  for X being set, A being Subset of X, F being Presv of X,A holds
  F||A is BinOp of A;

definition
  let X be set;
  let A be Subset of X;
  let F be Presv of X,A;
  func F|||A -> BinOp of A equals

  F||A;
end;

definition
  let A be set;
  let x be Element of A;
  mode DnT of x,A -> BinOp of A means


    for y being set holds y in [:A\{x },A\{x}:] implies it.y in A\{x};
end;

theorem 
  for A being non trivial set holds for x being Element of A holds
  for F being DnT of x,A holds F||(A\{x}) is BinOp of A\{x};

definition
  let A be non trivial set;
  let x be Element of A;
  let F be DnT of x,A;
  func F!(A,x) -> BinOp of A\{x} equals

  F||(A\{x});
end;

theorem 
  for F being non trivial set holds for A being Singleton of F
  holds F\A is non empty set;

registration
  let F be non trivial set;
  let A be Singleton of F;
  cluster F\A -> non empty;
end;















begin

reserve m for Cardinal,
  A,B,C for Ordinal,
  x,y,z,X,Y,Z,W for set,
  f for Function;

registration
  cluster Tarski -> subset-closed for set;
end;

registration
  let X be set;
  cluster Tarski-Class X -> Tarski;
end;

theorem 
  W is subset-closed & X in W implies not X,W are_equipotent & card X in card W
;

theorem 
  W is Tarski & x in W & y in W implies {x} in W & {x,y} in W;

theorem 
  W is Tarski & x in W & y in W implies [x,y] in W;

theorem 
  W is Tarski & X in W implies Tarski-Class X c= W;

theorem 
  W is Tarski & A in W implies succ A in W & A c= W;

theorem 
  A in Tarski-Class W implies succ A in Tarski-Class W & A c=
  Tarski-Class W;

theorem 
  W is subset-closed & X is epsilon-transitive & X in W implies X c= W;

theorem 
  X is epsilon-transitive & X in Tarski-Class W implies X c=
  Tarski-Class W;

theorem 
  W is Tarski implies On W = card W;

theorem 
  On Tarski-Class W = card Tarski-Class W;

theorem 
  W is Tarski & X in W implies card X in W;

theorem 
  X in Tarski-Class W implies card X in Tarski-Class W;

theorem 
  W is Tarski & x in card W implies x in W;

theorem 
  x in card Tarski-Class W implies x in Tarski-Class W;

theorem 
  W is Tarski & m in card W implies m in W;

theorem 
  m in card Tarski-Class W implies m in Tarski-Class W;

theorem 
  W is Tarski & m in W implies m c= W;

theorem 
  m in Tarski-Class W implies m c= Tarski-Class W;

theorem 
  W is Tarski implies card W is limit_ordinal;

theorem 
  W is Tarski & W <> {} implies card W <> 0 & card W <> {} & card W is
  limit_ordinal;

theorem 
  card Tarski-Class W <> 0 & card Tarski-Class W <> {} & card
  Tarski-Class W is limit_ordinal;

reserve f,g for Function,
  L for T-Sequence,
  F for Cardinal-Function;

theorem 
  W is Tarski & (X in W & W is epsilon-transitive or X in W & X c=
  W or card X in card W & X c= W) implies Funcs(X,W) c= W;

theorem 
  X in Tarski-Class W & W is epsilon-transitive or X in Tarski-Class W &
  X c= Tarski-Class W or card X in card Tarski-Class W & X c= Tarski-Class W
  implies Funcs(X,Tarski-Class W) c= Tarski-Class W;

theorem 
  dom L is limit_ordinal & (for A st A in dom L holds L.A = Rank A
  ) implies Rank dom L = Union L;

theorem 
  W is Tarski & A in On W implies card Rank A in card W & Rank A in W;

theorem 
  A in On Tarski-Class W implies card Rank A in card Tarski-Class W &
  Rank A in Tarski-Class W;

theorem 
  W is Tarski implies Rank card W c= W;

theorem 
  Rank card Tarski-Class W c= Tarski-Class W;

theorem 
  W is Tarski & W is epsilon-transitive & X in W implies the_rank_of X in W;

theorem 
  W is Tarski & W is epsilon-transitive implies W c= Rank card W;

theorem 
  W is Tarski & W is epsilon-transitive implies Rank card W = W;

theorem 
  W is Tarski & A in On W implies card Rank A c= card W;

theorem 
  A in On Tarski-Class W implies card Rank A c= card Tarski-Class W;

theorem 
  W is Tarski implies card W = card Rank card W;

theorem 
  card Tarski-Class W = card Rank card Tarski-Class W;

theorem 
  W is Tarski & X c= Rank card W implies X,Rank card W
  are_equipotent or X in Rank card W;

theorem 
  X c= Rank card Tarski-Class W implies X,Rank card Tarski-Class W
  are_equipotent or X in Rank card Tarski-Class W;

theorem 
  W is Tarski implies Rank card W is Tarski;

theorem 
  Rank card Tarski-Class W is Tarski;

theorem 
  X is epsilon-transitive & A in the_rank_of X implies ex Y st Y
  in X & the_rank_of Y = A;

theorem 
  X is epsilon-transitive implies card the_rank_of X c= card X;

theorem 
  W is Tarski & X is epsilon-transitive & X in W implies X in Rank card W;

theorem 
  X is epsilon-transitive & X in Tarski-Class W implies X in Rank card
  Tarski-Class W;

theorem 
  W is epsilon-transitive implies Rank card Tarski-Class W is_Tarski-Class_of W
;

theorem 
  W is epsilon-transitive implies Rank card Tarski-Class W = Tarski-Class W;

definition
  let IT be set;
  attr IT is universal means


  IT is epsilon-transitive & IT is Tarski;
end;

registration
  cluster universal -> epsilon-transitive Tarski for set;
  cluster epsilon-transitive Tarski -> universal for set;
end;

registration
  cluster universal non empty for set;
end;

definition
  mode Universe is universal non empty set;
end;

reserve U1,U2,U for Universe;

theorem 
  On U is Ordinal;

theorem 
  X is epsilon-transitive implies Tarski-Class X is universal;

theorem 
  Tarski-Class U is Universe;

registration
  let U;
  cluster On U -> ordinal;
  cluster Tarski-Class U -> universal;
end;

theorem 
  Tarski-Class A is universal;

registration
  let A;
  cluster Tarski-Class A -> universal;
end;

theorem 
  U = Rank On U;

theorem 
  On U <> {} & On U is limit_ordinal;

theorem 
  U1 in U2 or U1 = U2 or U2 in U1;

theorem 
  U1 c= U2 or U2 in U1;

theorem 
  U1,U2 are_c=-comparable;

theorem 
  U1 \/ U2 is Universe & U1 /\ U2 is Universe;

theorem 
  {} in U;

theorem 
  x in U implies {x} in U;

theorem 
  x in U & y in U implies {x,y} in U & [x,y] in U;

theorem 
  X in U implies bool X in U & union X in U & meet X in U;

theorem 
  X in U & Y in U implies X \/ Y in U & X /\ Y in U & X \ Y in U & X \+\ Y in U
;

theorem 
  X in U & Y in U implies [:X,Y:] in U & Funcs(X,Y) in U;

reserve u,v for Element of U;

registration
  let U1;
  cluster non empty for Element of U1;
end;

definition
  let U,u;
  redefine func {u} -> Element of U;
  redefine func bool u -> Element of U;
  redefine func union u -> Element of U;
  redefine func meet u -> Element of U;
  let v;
  redefine func {u,v} -> Element of U;
  redefine func [u,v] -> Element of U;
  redefine func u \/ v -> Element of U;
  redefine func u /\ v -> Element of U;
  redefine func u \ v -> Element of U;
  redefine func u \+\ v -> Element of U;
  redefine func [:u,v:] -> Element of U;
  redefine func Funcs(u,v) -> Element of U;
end;

definition
  func FinSETS -> Universe equals

  Tarski-Class {};
end;

theorem 
  card Rank omega = card omega;

theorem 
  Rank omega is Tarski;

theorem 
  FinSETS = Rank omega;

definition
  func SETS -> Universe equals

  Tarski-Class FinSETS;
end;

registration
  let X be set;
  cluster the_transitive-closure_of X -> epsilon-transitive;
end;

registration
  let X be epsilon-transitive set;
  cluster Tarski-Class X -> epsilon-transitive;
end;

definition
  let X be set;
  func Universe_closure X -> Universe means


  X c= it & for Y being Universe st X c= Y holds it c= Y;
end;

definition
  mode FinSet is Element of FinSETS;
  mode Set is Element of SETS;
  let A;
  func UNIVERSE A means


  ex L st it = last L & dom L = succ A & L.{} =
FinSETS & (for C st succ C in succ A holds L.succ C = Tarski-Class(L.C)) & for
  C st C in succ A & C <> {} & C is limit_ordinal holds L.C = Universe_closure
  Union(L|C);
end;

registration
  let A;
  cluster UNIVERSE A -> universal non empty;
end;

theorem 
  UNIVERSE {} = FinSETS;

theorem 
  UNIVERSE succ A = Tarski-Class UNIVERSE A;

theorem 
  UNIVERSE 1 = SETS;

theorem 
  A <> {} & A is limit_ordinal & dom L = A & (for B st B in A holds L.B
  = UNIVERSE B) implies UNIVERSE A = Universe_closure Union L;

theorem 
  FinSETS c= U & Tarski-Class {} c= U & UNIVERSE {} c= U;

theorem 
  A in B iff UNIVERSE A in UNIVERSE B;

theorem 
  UNIVERSE A = UNIVERSE B implies A = B;

theorem 
  A c= B iff UNIVERSE A c= UNIVERSE B;

reserve u,v for Element of Tarski-Class(X);

theorem 
  Tarski-Class(X,{}) in Tarski-Class(X,1) &
  Tarski-Class(X,{}) <> Tarski-Class(X,1);















begin

reserve phi,fi,psi for Ordinal-Sequence,
  A,A1,B,C,D for Ordinal,
  f,g for Function,
  X for set,
  x,y,z for set;

registration
  let L be Ordinal-Sequence;
  cluster last L -> ordinal;
end;

theorem 
  dom fi = succ A implies last fi is_limes_of fi & lim fi = last fi;

definition
  let fi,psi be T-Sequence;
  func fi^psi -> T-Sequence means


  dom it = (dom fi)+^(dom psi) & (for
A st A in dom fi holds it.A = fi.A) & for A st A in dom psi holds it.((dom fi)
  +^A) = psi.A;
end;

theorem 
 rng(fi^psi) c= rng fi \/ rng psi;

registration
  let fi,psi;
  cluster fi^psi -> Ordinal-yielding;
end;

theorem 
  A is_limes_of psi implies A is_limes_of fi^psi;

theorem 
  A is_limes_of fi implies B+^A is_limes_of B+^fi;

theorem 
  A is_limes_of fi implies A*^B is_limes_of fi*^B;

theorem 
  dom fi = dom psi & B is_limes_of fi & C is_limes_of psi & ((for A
st A in dom fi holds fi.A c= psi.A) or for A st A in dom fi holds fi.A in psi.A
  ) implies B c= C;

reserve f1,f2 for Ordinal-Sequence;

theorem 
  dom f1 = dom fi & dom fi = dom f2 & A is_limes_of f1 & A is_limes_of
  f2 & (for A st A in dom fi holds f1.A c= fi.A & fi.A c= f2.A) implies A
  is_limes_of fi;

theorem 
  dom fi <> {} & dom fi is limit_ordinal & fi is increasing implies
  sup fi is_limes_of fi & lim fi = sup fi;

theorem 
  fi is increasing & A c= B & B in dom fi implies fi.A c= fi.B;

theorem 
  fi is increasing & A in dom fi implies A c= fi.A;

theorem 
  phi is increasing implies phi"A is Ordinal;

theorem 
  f1 is increasing implies f2*f1 is Ordinal-Sequence;

theorem 
  f1 is increasing & f2 is increasing implies ex phi st phi = f1*
  f2 & phi is increasing;

theorem 
  f1 is increasing & A is_limes_of f2 & sup rng f1 = dom f2 & fi =
  f2*f1 implies A is_limes_of fi;

theorem 
  phi is increasing implies phi|A is increasing;

theorem 
  phi is increasing & dom phi is limit_ordinal implies sup phi is limit_ordinal
;

theorem 
  fi is increasing & fi is continuous & psi is continuous & phi = psi*fi
  implies phi is continuous;

theorem 
  (for A st A in dom fi holds fi.A = C+^A) implies fi is increasing;

theorem 
  C <> {} & (for A st A in dom fi holds fi.A = A*^C) implies fi is increasing;

theorem 
  A <> {} implies exp({},A) = {};

theorem 
  A <> {} & A is limit_ordinal implies for fi st dom fi = A & for
  B st B in A holds fi.B = exp(C,B) holds exp(C,A) is_limes_of fi;

theorem 
  C <> {} implies exp(C,A) <> {};

theorem 
  1 in C implies exp(C,A) in exp(C,succ A);

theorem 
  1 in C & A in B implies exp(C,A) in exp(C,B);

theorem 
  1 in C & (for A st A in dom fi holds fi.A = exp(C,A)) implies fi
  is increasing;

theorem 
  1 in C & A <> {} & A is limit_ordinal implies for fi st dom fi = A &
  for B st B in A holds fi.B = exp(C,B) holds exp(C,A) = sup fi;

theorem 
  C <> {} & A c= B implies exp(C,A) c= exp(C,B);

theorem 
  A c= B implies exp(A,C) c= exp(B,C);

theorem 
  1 in C & A <> {} implies 1 in exp(C,A);

theorem 
  exp(C,A+^B) = exp(C,B)*^exp(C,A);

theorem 
  exp(exp(C,A),B) = exp(C,B*^A);

theorem 
  1 in C implies A c= exp(C,A);


scheme 

  CriticalNumber { phi(Ordinal) -> Ordinal } : ex A st phi(A) = A
provided
 for A,B st A in B holds phi(A) in phi(B) and
 for A st A <> {} & A is limit_ordinal for phi st dom phi = A & for B
st B in A holds phi.B = phi(B) holds phi(A) is_limes_of phi;

reserve W for Universe;

registration
  let W;
  cluster ordinal for Element of W;
end;

definition
  let W;
  mode Ordinal of W is ordinal Element of W;
  mode Ordinal-Sequence of W is Function of On W, On W;
end;

registration
  let W;
  cluster non empty for Ordinal of W;
end;

registration
  let W;
  cluster On W -> non empty;
end;

registration
  let W;
  cluster -> T-Sequence-like Ordinal-yielding for Ordinal-Sequence of W;
end;

reserve A1,B1 for Ordinal of W,
  phi for Ordinal-Sequence of W;

scheme 

  UOSLambda { W() -> Universe, F(set) -> Ordinal of W() } : ex phi being
Ordinal-Sequence of W() st for a being Ordinal of W() holds phi.a = F(a);

definition
  let W;

  func 0-element_of W -> Ordinal of W equals

  {};
  func 1-element_of W -> non empty Ordinal of W equals

  1;
  let phi,A1;
  redefine func phi.A1 -> Ordinal of W;
end;

definition
  let W;
  let p2,p1 be Ordinal-Sequence of W;
  redefine func p1*p2 -> Ordinal-Sequence of W;
end;

theorem 
  0-element_of W = {} & 1-element_of W = 1;

definition
  let W,A1;
  redefine func succ A1 -> non empty Ordinal of W;
  let B1;
  redefine func A1 +^ B1 -> Ordinal of W;
end;

definition
  let W,A1,B1;
  redefine func A1 *^ B1 -> Ordinal of W;
end;

theorem 
  A1 in dom phi;

theorem 
  dom fi in W & rng fi c= W implies sup fi in W;

reserve L for T-Sequence;

theorem 
  phi is increasing & phi is continuous & omega in W implies ex A st A
  in dom phi & phi.A = A;

begin 


reserve e,u for set;

theorem 
  A is_cofinal_with B & B is_cofinal_with C implies A is_cofinal_with C;

theorem 
  A is_cofinal_with B implies (A is limit_ordinal iff B is limit_ordinal );



registration let D;
  let f,g be T-Sequence of D;
  cluster f^g -> D-valued;
end;














begin

reserve k,l,m,n,k1,a,b,c,i for Nat,
  x,y,z,y1,y2,X,Y for set,
  f,g for Function;



definition
  let n be Nat;
  func Seg n -> set equals

  { k where k is Element of NAT: 1 <= k & k <= n };
end;

definition
  let n be Nat;
  redefine func Seg n -> Subset of NAT;
end;

theorem 
  a in Seg b iff 1 <= a & a <= b;

registration let n be zero Nat;
  cluster Seg n -> empty;
end;

theorem 
  Seg 1 = { 1 } & Seg 2 = { 1,2 };

theorem 
  a = 0 or a in Seg a;

registration let n be non zero Nat;
  cluster Seg n -> non empty;
end;

theorem 
  a+1 in Seg(a+1);

theorem 
  a <= b iff Seg a c= Seg b;

theorem 
  Seg a = Seg b implies a = b;

theorem 
  c <= a implies Seg c = Seg a /\ Seg c;

theorem 
  Seg c = Seg c /\ Seg a implies c <= a;

theorem 
  Seg a \/ { a+1 } = Seg (a+1);

theorem 
  for k being Nat holds Seg k = Seg(k + 1) \ {k + 1};



definition
  let IT be Relation;
  attr IT is FinSequence-like means


  ex n st dom IT = Seg n;
end;

registration
  cluster empty -> FinSequence-like for Relation;
end;

definition
  mode FinSequence is FinSequence-like Function;
end;

reserve p,q,r,s,t for FinSequence;

registration
  let n be Nat;
  cluster Seg n -> finite;
end;

registration
  cluster FinSequence-like -> finite for Function;
end;

registration let n;
 cluster Seg n -> n-element;
end;

notation
  let p;
  synonym len p for card p;
end;

definition
  let p;
  redefine func len p -> Element of NAT means


  Seg it = dom p;
end;

definition
  let p;
  redefine func dom p -> Subset of NAT;
end;

theorem 
  (ex k st dom f c= Seg k) implies ex p st f c= p;

scheme 
 SeqEx{A()->Nat,P[set,set]}:
  ex p st dom p = Seg A() & for k st k in Seg A() holds P[k,p.k]
provided
 for k st k in Seg A() ex x st P[k,x];

scheme 
 SeqLambda{A()->Nat,F(set) -> set}:
  ex p being FinSequence st len p = A() & for k st k in dom p holds p.k=F(k);

theorem 
  z in p implies ex k st k in dom p & z=[k,p.k];

theorem 
  dom p = dom q & (for k st k in dom p holds p.k = q.k) implies p=q;

theorem 
  len p = len q & (for k st 1 <= k & k <= len p holds p.k = q.k) implies p=q;

theorem 
  p|(Seg a) is FinSequence;

theorem 
  rng p c= dom f implies f*p is FinSequence;

theorem 
  a <= len p & q = p|(Seg a) implies len q = a & dom q = Seg a;





definition
  let D be set;
  mode FinSequence of D -> FinSequence means


    rng it c= D;
end;

registration
  let D be set;
  cluster -> D-valued for FinSequence of D;
end;

registration
  cluster empty -> FinSequence-like for Relation;
end;

registration
  let D be set;
  cluster FinSequence-like for PartFunc of NAT,D;
end;

definition
  let D be set;
  redefine mode FinSequence of D -> FinSequence-like PartFunc of NAT,D;
end;

reserve D for set;

theorem 
  for p being FinSequence of D holds p|(Seg a) is FinSequence of D;

theorem 
  for D being non empty set ex p being FinSequence of D st len p = a;

theorem 
  p <> {} iff len p >= 1;

definition
  let x;
  func <*x*> -> set equals

  { [1,x] };
end;

definition
  let D be set;
  func <*>D -> FinSequence of D equals

  {};
end;

registration
  let D be set;
  cluster <*>D -> empty;
end;

registration
  let D be set;
  cluster empty for FinSequence of D;
end;

definition
  let p,q;
  func p^q -> FinSequence means


  dom it = Seg (len p + len q) & (for k st k in dom p holds it.k=p.k) &
  for k st k in dom q holds it.(len p + k) = q.k;
end;

theorem 
  p = (p ^ q) | (dom p);

theorem 
  len(p^q) = len p + len q;

theorem 
  for k being Nat st
  len p + 1 <= k & k <= len p + len q holds (p^q).k=q.(k-len p);

theorem 
  for k being Nat st len p < k & k <= len(p^q) holds (p^q).k = q.(k - len p);

theorem 
  for k being Nat st k in dom (p^q) holds
  (k in dom p or ex n st n in dom q & k=len p + n );

theorem 
  dom p c= dom(p^q);

theorem 
  x in dom q implies ex k st k=x & len p + k in dom(p^q);

theorem 
  k in dom q implies len p + k in dom(p^q);

theorem 
  rng p c= rng(p^q);

theorem 
  rng q c= rng(p^q);

theorem 
  rng(p^q) = rng p \/ rng q;

theorem 
  p^q^r = p^(q^r);

theorem 
  p^r = q^r or r^p = r^q implies p = q;

theorem 
  p^{} = p & {}^p = p;

theorem 
  p^q = {} implies p={} & q={};

definition
  let D be set;
  let p,q be FinSequence of D;
  redefine func p^q -> FinSequence of D;
end;

definition
  let x;
  redefine func <*x*> -> Function means


  dom it = Seg 1 & it.1 = x;
end;

registration
  let x;
  cluster <*x*> -> Function-like Relation-like;
end;

registration
  let x;
  cluster <*x*> -> FinSequence-like;
end;

theorem 
  p^q is FinSequence of D implies p is FinSequence of D & q is FinSequence of D
;

definition
  let x,y;
  func <*x,y*> -> set equals

  <*x*>^<*y*>;
  let z;
  func <*x,y,z*> -> set equals

  <*x*>^<*y*>^<*z*>;
end;

registration
  let x,y;
  cluster <*x,y*> -> Function-like Relation-like;
  let z;
  cluster <*x,y,z*> -> Function-like Relation-like;
end;

registration
  let x,y;
  cluster <*x,y*> -> FinSequence-like;
  let z;
  cluster <*x,y,z*> -> FinSequence-like;
end;

theorem 
  <*x*> = { [1,x] };

theorem 
  p=<*x*> iff dom p = Seg 1 & rng p = {x};

theorem 
  p=<*x*> iff len p = 1 & rng p = {x};

theorem 
  p = <*x*> iff len p = 1 & p.1 = x;

theorem 
  (<*x*>^p).1 = x;

theorem 
  (p^<*x*>).(len p + 1)=x;

theorem 
  <*x,y,z*>=<*x*>^<*y,z*> & <*x,y,z*>=<*x,y*>^<*z*>;

theorem 
  p = <*x,y*> iff len p = 2 & p.1=x & p.2=y;

theorem 
  p = <*x,y,z*> iff len p = 3 & p.1 = x & p.2 = y & p.3 = z;

theorem 
  p <> {} implies ex q,x st p=q^<*x*>;

definition
  let D be non empty set;
  let x be Element of D;
  redefine func <*x*> -> FinSequence of D;
end;



scheme 
 IndSeq{P[FinSequence]}: for p holds P[p]
provided
 P[{}] and
 for p,x st P[p] holds P[p^<*x*>];

theorem 
  for p,q,r,s being FinSequence st p^q = r^s & len p <= len r
  ex t being FinSequence st p^t = r;

registration
 cluster  -> NAT-defined for FinSequence;
end;

definition
  let D be set;
  func D* -> set means


  x in it iff x is FinSequence of D;
end;

registration
  let D be set;
  cluster D* -> non empty;
end;

theorem 
  rng p = rng q & p is one-to-one & q is one-to-one implies len p = len q;

theorem 
  {} in D*;

scheme 
 SepSeq{D()->non empty set, P[FinSequence]}:
  ex X st for x holds x in X iff ex p st p in D()* & P[p] & x=p;





definition
  let IT be Function;
  attr IT is FinSubsequence-like means


  ex k st dom IT c= Seg k;
end;

registration
  cluster FinSubsequence-like for Function;
end;

definition
  mode FinSubsequence is FinSubsequence-like Function;
end;

registration
 cluster FinSequence-like -> FinSubsequence-like for Function;
 let p be FinSubsequence, X be set;
 cluster p|X -> FinSubsequence-like;
 cluster X|`p -> FinSubsequence-like;
end;

registration
 cluster  -> NAT-defined for FinSubsequence;
end;

reserve p9 for FinSubsequence;

definition
  let X;
  given k being Nat such that
 X c= Seg k;
  func Sgm X -> FinSequence of NAT means


  rng it = X & for l,m,k1,k2 being Nat st 1 <= l & l < m & m <= len it &
  k1=it.l & k2=it.m holds k1 < k2;
end;

theorem 
  rng Sgm dom p9 = dom p9;

definition
  let p9;
  func Seq p9 -> Function equals

  p9* Sgm(dom p9);
end;

registration
  let p9;
  cluster Seq p9 -> FinSequence-like;
end;

theorem 
  for X st ex k st X c= Seg k holds Sgm X = {} iff X = {};

begin 

theorem 
  D is finite iff ex p st D = rng p;

begin 

theorem 
  Seg n,Seg m are_equipotent implies n = m;

theorem 
  Seg n,n are_equipotent;

theorem 
  card Seg n = card n;

theorem 
  X is finite implies ex n st X,Seg n are_equipotent;

theorem 
  for n being Nat holds card Seg n = n;

begin 


registration
  let x be set;
  cluster <*x*> -> non empty;
end;



registration
  cluster non empty for FinSequence;
end;



registration
  let f1 be FinSequence, f2 be non empty FinSequence;
  cluster f1^f2 -> non empty;
  cluster f2^f1 -> non empty;
end;

registration
  let x,y be set;
  cluster <*x,y*> -> non empty;
  let z be set;
  cluster <*x,y,z*> -> non empty;
end;



scheme 
 SeqDEx{D()->non empty set,A()->Nat,P[set,set]}:
  ex p being FinSequence of D() st dom p = Seg A() &
  for k st k in Seg A() holds P[k,p.k]
provided
 for k st k in Seg A() ex x being Element of D() st P[k,x];



reserve D for set,
  p for FinSequence of D,
  m for Nat;

definition
  let m;
  let p be FinSequence;
  func p|m -> FinSequence equals

  p|Seg m;
end;

definition
  let D,m,p;
  redefine func p|m -> FinSequence of D;
end;

registration
  let f be FinSequence;
  cluster f|0 -> empty;
end;

theorem 
  len q <= i implies q|i = q;

theorem 
  i <= len q implies len(q|i) = i;



theorem 
  i in Seg n implies i+m in Seg (n+m);

theorem 
  i>0 & i+m in Seg (n+m) implies i in Seg n & i in Seg (n+m);



definition
  let R be Relation;
  func R[*] -> Relation means

  for x,y being set holds [x,y] in it iff x in field R & y in field R &
  ex p being FinSequence st len p >= 1 & p.1 = x & p.(len p) = y &
  for i being Nat st i >= 1 & i < len p holds [p.i,p.(i+1)] in R;
end;

theorem 
  for D1,D2 being set st D1 c= D2 holds D1* c= D2*;



registration
  let D be set;
  cluster D* -> functional;
end;



theorem 
  for p,q being FinSequence st p c= q holds len p <= len q;

theorem 
  for p,q being FinSequence, i being Nat st
  1 <= i & i <= len p holds (p ^ q).i = p.i;

theorem 
  for p,q being FinSequence, i being Nat st
  1 <= i & i <= len q holds (p ^ q).(len p + i) = q.i;



scheme 
 FinSegRng{m, n() -> Nat, F(set)->set, P[set]}:
  {F(i) where i is Element of NAT: m()<=i & i<=n() & P[i]} is finite;

theorem 
  for x1, x2, x3, x4 being set, p being FinSequence
  st p = <*x1*>^<*x2*>^<*x3*>^<*x4*>
  holds len p = 4 & p.1 = x1 & p.2 = x2 & p.3 = x3 & p.4 = x4;

theorem 
  for x1, x2, x3, x4, x5 being set, p being FinSequence
  st p = <*x1*>^<*x2*>^<*x3*>^<*x4*>^<*x5*>
  holds len p = 5 & p.1 = x1 & p.2 = x2 & p.3 = x3 & p.4 = x4 & p.5 = x5;

theorem 
  for x1, x2, x3, x4, x5, x6 being set, p being FinSequence
  st p = <*x1*>^<*x2*>^<*x3*>^<*x4*>^<*x5*>^<*x6*>
  holds len p = 6 & p.1 = x1 & p.2 = x2 & p.3 = x3 & p.4 = x4 & p.5 = x5 &
  p.6 = x6;

theorem 
  for x1, x2, x3, x4, x5, x6, x7 being set, p being FinSequence
  st p = <*x1*>^<*x2*>^<*x3*>^<*x4*>^<*x5*>^<*x6*>^<*x7*>
  holds len p = 7 & p.1 = x1 & p.2 = x2 & p.3 = x3 & p.4 = x4 & p.5 = x5 &
  p.6 = x6 & p.7 = x7;

theorem 
  for x1,x2,x3,x4, x5, x6, x7, x8 being set, p being FinSequence
  st p = <*x1*>^<*x2*>^<*x3*>^<*x4*>^<*x5*>^<*x6*>^<*x7*>^<*x8*>
  holds len p = 8 & p.1 = x1 & p.2 = x2 & p.3 = x3 & p.4 = x4 & p.5 = x5 &
  p.6 = x6 & p.7 = x7 & p.8 = x8;

theorem 
  for x1,x2,x3,x4,x5,x6,x7, x8, x9 being set, p being FinSequence
  st p = <*x1*>^<*x2*>^<*x3*>^<*x4*>^<*x5*>^<*x6*>^<*x7*>^<*x8*>^<*x9*>
  holds len p = 9 & p.1 = x1 & p.2 = x2 & p.3 = x3 & p.4 = x4 & p.5 = x5 &
  p.6 = x6 & p.7 = x7 & p.8 = x8 & p.9 = x9;



theorem 
  for p being FinSequence holds p | Seg 0 = {};

theorem 
  for f,g being FinSequence holds f | Seg 0 = g | Seg 0;

theorem 
  for D being non empty set, x being Element of D holds
  <* x *> is FinSequence of D;

theorem 
  for D being set, p,q being FinSequence of D holds p ^ q is FinSequence of D;



reserve a, b, c, d, e, f for set;

theorem 
  <*a*> = <*b*> implies a = b;

theorem 
  <*a,b*> = <*c,d*> implies a = c & b = d;

theorem 
  <*a,b,c*> = <*d,e,f*> implies a = d & b = e & c = f;



registration
  cluster non empty non-empty for FinSequence;
end;

theorem 
  for p,q being FinSequence st q = p|Seg n holds len q <= len p;

theorem 
  for p,r being FinSequence st r = p|Seg n ex q being FinSequence st p = r^q;



registration
  let D be non empty set;
  cluster non empty for FinSequence of D;
end;



definition
  let p,q be FinSequence;
  redefine pred p = q means

  len p = len q & for k st 1 <= k & k <= len p holds p.k = q.k;
end;



theorem 
  for M1, M2 being set st card M1 = 0 & card M2 = 0 holds M1 = M2;



registration
  let n be non zero Nat;
  cluster Seg n -> non empty;
end;



theorem 
  for p being FinSequence, n,m being Nat st m <= n holds p|n|m = p|m;



reserve m for Element of NAT;

theorem 
  Seg n = (n+1) \ {0};



registration
  let n be Nat;
  cluster n-element for FinSequence;
end;



registration
  let x be set;
  cluster <*x*> -> 1-element;
  let y be set;
  cluster <*x,y*> -> 2-element;
  let z be set;
  cluster <*x,y,z*> -> 3-element;
end;



definition let X be set;
 attr X is FinSequence-membered means

 x in X implies x is FinSequence;
end;

registration
 cluster empty -> FinSequence-membered for set;
end;

registration
 cluster non empty FinSequence-membered for set;
end;

registration let X be set;
 cluster X* -> FinSequence-membered;
end;

theorem 
 for f being Function st f in D* & x in dom f holds f.x in D;

registration
 cluster FinSequence-membered -> functional for set;
end;

theorem 
 for X being FinSequence-membered set ex Y being non empty set st X c= Y*;

registration
  let X be FinSequence-membered set;
  cluster -> FinSequence-like for Element of X;
end;

registration let X be FinSequence-membered set;
 cluster -> FinSequence-membered for Subset of X;
end;



theorem 
  for p,q being FinSequence st q = p|Seg n holds len q <= n;

theorem 
  for p,q being FinSequence st p = p^q or p = q^p holds q = {};

theorem 
  for p,q being FinSequence st p^q = <*x*> holds
  p = <*x*> & q = {} or p = {} & q = <*x*>;



theorem 
 for f being n-element FinSequence holds dom f = Seg n;

registration let n,m;
 let f be n-element FinSequence, g be m-element FinSequence;
 cluster f^g -> (n+m)-element;
end;



registration
  cluster increasing -> one-to-one for real-valued FinSequence;
end;



theorem 
 for x, y being set st x in dom <*y*> holds x = 1;



registration let X;
 cluster X-valued for FinSequence;
end;



registration
  let D be FinSequence-membered set;
  let f be D-valued Function;
  let x be set;
  cluster f.x -> FinSequence-like;
end;














begin

reserve n,m,k for Element of NAT,
  D for non empty set,
  Z,x,y,z,y1,y2 for set,
  p,q for FinSequence;

definition
  let p be natural-valued Function;
  let n be set;
  redefine func p.n -> Element of NAT;
end;



scheme 

  RecEx{A() -> set,P[set,set,set]}: ex f being Function st dom f = NAT & f.0 =
  A() & for n being Element of NAT holds P[n,f.n,f.(n+1)]
provided
 for n being Element of NAT for x being set ex y being set st P[n,x,y ];

scheme 

  RecExD{D()->non empty set,A() -> Element of D(), P[set,set,set]}: ex f being
Function of NAT,D() st f.0 = A() & for n being Element of NAT holds P[n,f.n,f.(
  n+1)]
provided
 for n being Element of NAT for x being Element of D() ex y being
Element of D() st P[n,x,y];

scheme 

  FinRecEx{A() -> set,N() -> Nat,P[set,set,set]}: ex p being FinSequence st
len p = N() & (p.1 = A() or N() = 0) & for n st 1 <= n & n < N() holds P[n,p.n,
  p.(n+1)]
provided
 for n being Element of NAT st 1 <= n & n < N() for x being set ex y
being set st P[n,x,y];

scheme 

  FinRecExD{D() -> non empty set,A() -> Element of D(), N() -> Nat, P[set,set,
set]}: ex p being FinSequence of D() st len p = N() & (p.1 = A() or N() = 0) &
  for n st 1 <= n & n < N() holds P[n,p.n,p.(n+1)]
provided
 for n being Element of NAT st 1 <= n & n < N() for x being Element
of D() ex y being Element of D() st P[n,x,y];

scheme 

  SeqBinOpEx{S() -> FinSequence,P[set,set,set]}: ex x st ex p being
FinSequence st x = p.(len p) & len p = len S() & p.1 = S().1 & for k st 1 <= k
  & k < len S() holds P[S().(k+1),p.k,p.(k+1)]
provided
 for k,x st 1 <= k & k < len S() ex y st P[S().(k+1),x,y];

scheme 

  LambdaSeqBinOpEx{S() -> FinSequence,F(set,set) -> set}: ex x st ex p being
FinSequence st x = p.(len p) & len p = len S() & p.1 = S().1 & for k st 1 <= k
  & k < len S() holds p.(k+1) = F(S().(k+1),p.k);



scheme 

  FinRecUn{A() -> set,N() -> Nat, F, G() -> FinSequence, P[set,set,set]}: F()
  = G()
provided
 for n st 1 <= n & n < N() for x,y1,y2 being set st P[n,x,y1] & P[n,x
,y2] holds y1 = y2 and
 len F() = N() & (F().1 = A() or N() = 0) & for n st 1 <= n & n < N()
holds P[n,F().n,F().(n+1)] and
 len G() = N() & (G().1 = A() or N() = 0) & for n st 1 <= n & n < N()
holds P[n,G().n,G().(n+1)];

scheme 

  FinRecUnD{D() -> non empty set, A() -> Element of D(), N() -> Nat, F, G() ->
  FinSequence of D(), P[set,set,set]}: F() = G()
provided
 for n st 1 <= n & n < N() for x,y1,y2 being Element of D() st P[n,x,
y1] & P[n,x,y2] holds y1 = y2 and
 len F() = N() & (F().1 = A() or N() = 0) & for n st 1 <= n & n < N()
holds P[n,F().n,F().(n+1)] and
 len G() = N() & (G().1 = A() or N() = 0) & for n st 1 <= n & n < N()
holds P[n,G().n,G().(n+1)];

scheme 

  SeqBinOpUn{S() -> FinSequence,P[set,set,set],x, y() -> set}: x() = y()
provided
 for k,x,y1,y2,z st 1 <= k & k < len S() & z = S().(k+1) & P[z,x,y1]
& P[z,x,y2] holds y1 = y2 and
 ex p being FinSequence st x() = p.(len p) & len p = len S() & p.1 =
S().1 & for k st 1 <= k & k < len S() holds P[S().(k+1),p.k,p.(k+1)] and
 ex p being FinSequence st y() = p.(len p) & len p = len S() & p.1 =
S().1 & for k st 1 <= k & k < len S() holds P[S().(k+1),p.k,p.(k+1)];

scheme 

  LambdaSeqBinOpUn{S() -> FinSequence, F(set,set) -> set, x, y() -> set}: x()
  = y()
provided
 ex p being FinSequence st x() = p.(len p) & len p = len S() & p.1 =
S().1 & for k st 1 <= k & k < len S() holds p.(k+1) = F(S().(k+1),p.k) and
 ex p being FinSequence st y() = p.(len p) & len p = len S() & p.1 =
S().1 & for k st 1 <= k & k < len S() holds p.(k+1) = F(S().(k+1),p.k);



scheme 

  DefRec{A() -> set,n() -> Nat,P[set,set,set]}: (ex y being set st ex f being
Function st y = f.n() & dom f = NAT & f.0 = A() & for n holds P[n,f.n,f.(n+1)])
& for y1,y2 being set st (ex f being Function st y1 = f.n() & dom f = NAT & f.0
  = A() & for n holds P[n,f.n,f.(n+1)]) & (ex f being Function st y2 = f.n() &
  dom f = NAT & f.0 = A() & for n holds P[n,f.n,f.(n+1)]) holds y1 = y2
provided
 for n,x ex y st P[n,x,y] and
 for n,x,y1,y2 st P[n,x,y1] & P[n,x,y2] holds y1 = y2;

scheme 

  LambdaDefRec{A() -> set,n() -> Nat,RecFun(set,set) -> set}: (ex y being set
st ex f being Function st y = f.n() & dom f = NAT & f.0 = A() & for n holds f.(
n+1) = RecFun(n,f.n)) & for y1,y2 being set st (ex f being Function st y1 = f.n
  () & dom f = NAT & f.0 = A() & for n holds f.(n+1) = RecFun(n,f.n)) & (ex f
being Function st y2 = f.n() & dom f = NAT & f.0 = A() & for n holds f.(n+1) =
  RecFun(n,f.n)) holds y1 = y2;

scheme 

  DefRecD{D() -> non empty set,A() -> (Element of D()), n() -> Nat,P[set,set,
set]}: (ex y being Element of D() st ex f being Function of NAT,D() st y = f.n(
) & f.0 = A() & for n holds P[n,f.n,f.(n+1)]) & for y1,y2 being Element of D()
st (ex f being Function of NAT,D() st y1 = f.n() & f.0 = A() & for n holds P[n,
f.n,f.(n+1)]) & (ex f being Function of NAT,D() st y2 = f.n() & f.0 = A() & for
  n holds P[n,f.n,f.(n+1)]) holds y1 = y2
provided
 for n being Element of NAT,x being Element of D() ex y being Element
of D() st P[n,x,y] and
 for n being Element of NAT, x,y1,y2 being Element of D() st P[n,x,y1
] & P[n,x,y2] holds y1 = y2;

scheme 

  LambdaDefRecD{D() -> non empty set, A() -> Element of D(), n() -> Nat,
  RecFun(set,set) -> Element of D()}: (ex y being Element of D() st ex f being
Function of NAT,D() st y = f.n() & f.0 = A() & for n being Nat holds f.(n+1) =
RecFun(n,f.n)) & for y1,y2 being Element of D() st (ex f being Function of NAT,
D() st y1 = f.n() & f.0 = A() & for n being Nat holds f.(n+1) = RecFun(n,f.n))
  & (ex f being Function of NAT,D() st y2 = f.n() & f.0 = A() & for n being Nat
  holds f.(n+1) = RecFun(n,f.n)) holds y1 = y2;

scheme 

  SeqBinOpDef{S() -> FinSequence,P[set,set,set]}: (ex x st ex p being
FinSequence st x = p.(len p) & len p = len S() & p.1 = S().1 & for k st 1 <= k
  & k < len S() holds P[S().(k+1),p.k,p.(k+1)]) & for x,y st (ex p being
FinSequence st x = p.(len p) & len p = len S() & p.1 = S().1 & for k st 1 <= k
& k < len S() holds P[S().(k+1),p.k,p.(k+1)]) & (ex p being FinSequence st y =
p.(len p) & len p = len S() & p.1 = S().1 & for k st 1 <= k & k < len S() holds
  P[S().(k+1),p.k,p.(k+1)]) holds x = y
provided
 for k,y st 1 <= k & k < len S() ex z st P[S().(k+1),y,z] and
 for k,x,y1,y2,z st 1 <= k & k < len S() & z = S().(k+1) & P[z,x,y1]
& P[z,x,y2] holds y1 = y2;

scheme 

  LambdaSeqBinOpDef{S() -> FinSequence,F(set,set) -> set}: (ex x st ex p being
FinSequence st x = p.(len p) & len p = len S() & p.1 = S().1 & for k st 1 <= k
  & k < len S() holds p.(k+1) = F(S().(k+1),p.k)) & for x,y st (ex p being
FinSequence st x = p.(len p) & len p = len S() & p.1 = S().1 & for k st 1 <= k
& k < len S() holds p.(k+1) = F(S().(k+1),p.k)) & (ex p being FinSequence st y
  = p.(len p) & len p = len S() & p.1 = S().1 & for k st 1 <= k & k < len S()
  holds p.(k+1) = F(S().(k+1),p.k)) holds x = y;



scheme 

  SeqExD{D() -> non empty set, N() -> Element of NAT, P[set,set]}: ex p being
FinSequence of D() st dom p = Seg N() & for k being Element of NAT st k in Seg
  N() holds P[k,p/.k]
provided
 for k being Element of NAT st k in Seg N() ex x being Element of D()
st P[k,x];

scheme 

  FinRecExD2{D() -> non empty set,A() -> (Element of D()), N() -> Element of
NAT, P[set,set,set]}: ex p being FinSequence of D() st len p = N() & (p/.1 = A(
) or N() = 0) & for n being Element of NAT st 1 <= n & n <= N()-1 holds P[n,p/.
  n,p/.(n+1)]
provided
 for n being Element of NAT st 1 <= n & n <= N()-1 holds for x being
Element of D() ex y being Element of D() st P[n,x,y];














begin

registration
  cluster complex-valued for FinSequence;
end;


registration
  let r be rational number;
  cluster |. r .| -> rational;
end;

definition
  let f1,f2 be complex-valued Function;
  func f1 + f2 -> Function means


  dom it = dom f1 /\ dom f2 &
  for c being set st c in dom it holds it.c = f1.c + f2.c;
  commutativity;
end;

registration
  let f1,f2 be complex-valued Function;
  cluster f1+f2 -> complex-valued;
end;

registration
  let f1,f2 be real-valued Function;
  cluster f1+f2 -> real-valued;
end;

registration
  let f1,f2 be RAT-valued Function;
  cluster f1+f2 -> RAT-valued;
end;

registration
  let f1,f2 be INT-valued Function;
  cluster f1+f2 -> INT-valued;
end;

registration
  let f1,f2 be natural-valued Function;
  cluster f1+f2 -> natural-valued;
end;

definition
  let C be set;
  let D1,D2 be complex-membered set;
  let f1 be PartFunc of C,D1;
  let f2 be PartFunc of C,D2;
  redefine func f1+f2 -> PartFunc of C,COMPLEX;
end;

definition
  let C be set;
  let D1,D2 be real-membered set;
  let f1 be PartFunc of C,D1;
  let f2 be PartFunc of C,D2;
  redefine func f1+f2 -> PartFunc of C,REAL;
end;

definition
  let C be set;
  let D1,D2 be rational-membered set;
  let f1 be PartFunc of C,D1;
  let f2 be PartFunc of C,D2;
  redefine func f1+f2 -> PartFunc of C,RAT;
end;

definition
  let C be set;
  let D1,D2 be integer-membered set;
  let f1 be PartFunc of C,D1;
  let f2 be PartFunc of C,D2;
  redefine func f1+f2 -> PartFunc of C,INT;
end;

definition
  let C be set;
  let D1,D2 be natural-membered set;
  let f1 be PartFunc of C,D1;
  let f2 be PartFunc of C,D2;
  redefine func f1+f2 -> PartFunc of C,NAT;
end;

registration
  let C be set;
  let D1,D2 be complex-membered non empty set;
  let f1 be Function of C,D1;
  let f2 be Function of C,D2;
  cluster f1+f2 -> total for PartFunc of C,COMPLEX;
end;

registration
  let C be set;
  let D1,D2 be real-membered non empty set;
  let f1 be Function of C,D1;
  let f2 be Function of C,D2;
  cluster f1+f2 -> total for PartFunc of C,REAL;
end;

registration
  let C be set;
  let D1,D2 be rational-membered non empty set;
  let f1 be Function of C,D1;
  let f2 be Function of C,D2;
  cluster f1+f2 -> total for PartFunc of C,RAT;
end;

registration
  let C be set;
  let D1,D2 be integer-membered non empty set;
  let f1 be Function of C,D1;
  let f2 be Function of C,D2;
  cluster f1+f2 -> total for PartFunc of C,INT;
end;

registration
  let C be set;
  let D1,D2 be natural-membered non empty set;
  let f1 be Function of C,D1;
  let f2 be Function of C,D2;
  cluster f1+f2 -> total for PartFunc of C,NAT;
end;

theorem 
  for C being set, D1,D2 being complex-membered non empty set for f1
  being Function of C,D1, f2 being Function of C,D2 for c being Element of C
  holds (f1+f2).c = f1.c + f2.c;

registration
  let f1, f2 be complex-valued FinSequence;
  cluster f1+f2 -> FinSequence-like;
end;

begin 

definition
  let f be complex-valued Function, r be complex number;
  func r + f -> Function means


  dom it = dom f &
  for c being set st c in dom it holds it.c = r + f.c;
end;

notation
  let f be complex-valued Function, r be complex number;
  synonym f + r for r + f;
end;

registration
  let f be complex-valued Function, r be complex number;
  cluster r+f -> complex-valued;
end;

registration
  let f be real-valued Function, r be real number;
  cluster r+f -> real-valued;
end;

registration
  let f be RAT-valued Function, r be rational number;
  cluster r+f -> RAT-valued;
end;

registration
  let f be INT-valued Function, r be integer number;
  cluster r+f -> INT-valued;
end;

registration
  let f be natural-valued Function, r be Nat;
  cluster r+f -> natural-valued;
end;

definition
  let C be set;
  let D be complex-membered set;
  let f be PartFunc of C,D;
  let r be complex number;
  redefine func r+f -> PartFunc of C,COMPLEX;
end;

definition
  let C be set;
  let D be real-membered set;
  let f be PartFunc of C,D;
  let r be real number;
  redefine func r+f -> PartFunc of C,REAL;
end;

definition
  let C be set;
  let D be rational-membered set;
  let f be PartFunc of C,D;
  let r be rational number;
  redefine func r+f -> PartFunc of C,RAT;
end;

definition
  let C be set;
  let D be integer-membered set;
  let f be PartFunc of C,D;
  let r be integer number;
  redefine func r+f -> PartFunc of C,INT;
end;

definition
  let C be set;
  let D be natural-membered set;
  let f be PartFunc of C,D;
  let r be Nat;
  redefine func r+f -> PartFunc of C,NAT;
end;

registration
  let C be set;
  let D be complex-membered non empty set;
  let f be Function of C,D;
  let r be complex number;
  cluster r+f -> total for PartFunc of C,COMPLEX;
end;

registration
  let C be set;
  let D be real-membered non empty set;
  let f be Function of C,D;
  let r be real number;
  cluster r+f -> total for PartFunc of C,REAL;
end;

registration
  let C be set;
  let D be rational-membered non empty set;
  let f be Function of C,D;
  let r be rational number;
  cluster r+f -> total for PartFunc of C,RAT;
end;

registration
  let C be set;
  let D be integer-membered non empty set;
  let f be Function of C,D;
  let r be integer number;
  cluster r+f -> total for PartFunc of C,INT;
end;

registration
  let C be set;
  let D be natural-membered non empty set;
  let f be Function of C,D;
  let r be Nat;
  cluster r+f -> total for PartFunc of C,NAT;
end;

theorem 
  for C being non empty set, D being complex-membered non empty set
  for f being Function of C,D, r being complex number
  for c being Element of C holds
  (r+f).c = r + f.c;

registration
  let f be complex-valued FinSequence, r be complex number;
  cluster r+f -> FinSequence-like;
end;

begin 

definition
  let f be complex-valued Function, r be complex number;
  func f - r -> Function equals

  -r + f;
end;

theorem 
  for f being complex-valued Function, r being complex number holds dom
  (f-r) = dom f & for c being set st c in dom f holds (f-r).c = f.c - r;

registration
  let f be complex-valued Function, r be complex number;
  cluster f-r -> complex-valued;
end;

registration
  let f be real-valued Function, r be real number;
  cluster f-r -> real-valued;
end;

registration
  let f be RAT-valued Function, r be rational number;
  cluster f-r -> RAT-valued;
end;

registration
  let f be INT-valued Function, r be integer number;
  cluster f-r -> INT-valued;
end;

definition
  let C be set;
  let D be complex-membered set;
  let f be PartFunc of C,D;
  let r be complex number;
  redefine func f-r -> PartFunc of C,COMPLEX;
end;

definition
  let C be set;
  let D be real-membered set;
  let f be PartFunc of C,D;
  let r be real number;
  redefine func f-r -> PartFunc of C,REAL;
end;

definition
  let C be set;
  let D be rational-membered set;
  let f be PartFunc of C,D;
  let r be rational number;
  redefine func f-r -> PartFunc of C,RAT;
end;

definition
  let C be set;
  let D be integer-membered set;
  let f be PartFunc of C,D;
  let r be integer number;
  redefine func f-r -> PartFunc of C,INT;
end;

registration
  let C be set;
  let D be complex-membered non empty set;
  let f be Function of C,D;
  let r be complex number;
  cluster f-r -> total for PartFunc of C,COMPLEX;
end;

registration
  let C be set;
  let D be real-membered non empty set;
  let f be Function of C,D;
  let r be real number;
  cluster f-r -> total for PartFunc of C,REAL;
end;

registration
  let C be set;
  let D be rational-membered non empty set;
  let f be Function of C,D;
  let r be rational number;
  cluster f-r -> total for PartFunc of C,RAT;
end;

registration
  let C be set;
  let D be integer-membered non empty set;
  let f be Function of C,D;
  let r be integer number;
  cluster f-r -> total for PartFunc of C,INT;
end;

theorem 
  for C being non empty set, D being complex-membered non empty set for
f being Function of C,D, r being complex number for c being Element of C holds
  (f-r).c = f.c - r;

registration
  let f be complex-valued FinSequence, r be complex number;
  cluster f-r -> FinSequence-like;
end;

begin 

definition
  let f1,f2 be complex-valued Function;
  func f1 (#) f2 -> Function means


  dom it = dom f1 /\ dom f2 & for c
  being set st c in dom it holds it.c = f1.c * f2.c;
  commutativity;
end;

theorem 
  for f1,f2 being complex-valued Function for c being set holds (f1(#)f2
  ).c = f1.c * f2.c;

registration
  let f1,f2 be complex-valued Function;
  cluster f1(#)f2 -> complex-valued;
end;

registration
  let f1,f2 be real-valued Function;
  cluster f1(#)f2 -> real-valued;
end;

registration
  let f1,f2 be RAT-valued Function;
  cluster f1(#)f2 -> RAT-valued;
end;

registration
  let f1,f2 be INT-valued Function;
  cluster f1(#)f2 -> INT-valued;
end;

registration
  let f1,f2 be natural-valued Function;
  cluster f1(#)f2 -> natural-valued;
end;

definition
  let C be set;
  let D1,D2 be complex-membered set;
  let f1 be PartFunc of C,D1;
  let f2 be PartFunc of C,D2;
  redefine func f1(#)f2 -> PartFunc of C,COMPLEX;
end;

definition
  let C be set;
  let D1,D2 be real-membered set;
  let f1 be PartFunc of C,D1;
  let f2 be PartFunc of C,D2;
  redefine func f1(#)f2 -> PartFunc of C,REAL;
end;

definition
  let C be set;
  let D1,D2 be rational-membered set;
  let f1 be PartFunc of C,D1;
  let f2 be PartFunc of C,D2;
  redefine func f1(#)f2 -> PartFunc of C,RAT;
end;

definition
  let C be set;
  let D1,D2 be integer-membered set;
  let f1 be PartFunc of C,D1;
  let f2 be PartFunc of C,D2;
  redefine func f1(#)f2 -> PartFunc of C,INT;
end;

definition
  let C be set;
  let D1,D2 be natural-membered set;
  let f1 be PartFunc of C,D1;
  let f2 be PartFunc of C,D2;
  redefine func f1(#)f2 -> PartFunc of C,NAT;
end;

registration
  let C be set;
  let D1,D2 be complex-membered non empty set;
  let f1 be Function of C,D1;
  let f2 be Function of C,D2;
  cluster f1(#)f2 -> total for PartFunc of C,COMPLEX;
end;

registration
  let C be set;
  let D1,D2 be real-membered non empty set;
  let f1 be Function of C,D1;
  let f2 be Function of C,D2;
  cluster f1(#)f2 -> total for PartFunc of C,REAL;
end;

registration
  let C be set;
  let D1,D2 be rational-membered non empty set;
  let f1 be Function of C,D1;
  let f2 be Function of C,D2;
  cluster f1(#)f2 -> total for PartFunc of C,RAT;
end;

registration
  let C be set;
  let D1,D2 be integer-membered non empty set;
  let f1 be Function of C,D1;
  let f2 be Function of C,D2;
  cluster f1(#)f2 -> total for PartFunc of C,INT;
end;

registration
  let C be set;
  let D1,D2 be natural-membered non empty set;
  let f1 be Function of C,D1;
  let f2 be Function of C,D2;
  cluster f1(#)f2 -> total for PartFunc of C,NAT;
end;

registration
  let f1, f2 be complex-valued FinSequence;
  cluster f1(#)f2 -> FinSequence-like;
end;

begin 

definition
  let f be complex-valued Function, r be complex number;
  func r (#) f -> Function means


  dom it = dom f & for c being set st c
  in dom it holds it.c = r * f.c;
end;

notation
  let f be complex-valued Function, r be complex number;
  synonym f (#) r for r (#) f;
end;

theorem 
  for f being complex-valued Function, r being complex number for c
  being set holds (r(#)f).c = r * f.c;

registration
  let f be complex-valued Function, r be complex number;
  cluster r(#)f -> complex-valued;
end;

registration
  let f be real-valued Function, r be real number;
  cluster r(#)f -> real-valued;
end;

registration
  let f be RAT-valued Function, r be rational number;
  cluster r(#)f -> RAT-valued;
end;

registration
  let f be INT-valued Function, r be integer number;
  cluster r(#)f -> INT-valued;
end;

registration
  let f be natural-valued Function, r be Nat;
  cluster r(#)f -> natural-valued;
end;

definition
  let C be set;
  let D be complex-membered set;
  let f be PartFunc of C,D;
  let r be complex number;
  redefine func r(#)f -> PartFunc of C,COMPLEX;
end;

definition
  let C be set;
  let D be real-membered set;
  let f be PartFunc of C,D;
  let r be real number;
  redefine func r(#)f -> PartFunc of C,REAL;
end;

definition
  let C be set;
  let D be rational-membered set;
  let f be PartFunc of C,D;
  let r be rational number;
  redefine func r(#)f -> PartFunc of C,RAT;
end;

definition
  let C be set;
  let D be integer-membered set;
  let f be PartFunc of C,D;
  let r be integer number;
  redefine func r(#)f -> PartFunc of C,INT;
end;

definition
  let C be set;
  let D be natural-membered set;
  let f be PartFunc of C,D;
  let r be Nat;
  redefine func r(#)f -> PartFunc of C,NAT;
end;

registration
  let C be set;
  let D be complex-membered non empty set;
  let f be Function of C,D;
  let r be complex number;
  cluster r(#)f -> total for PartFunc of C,COMPLEX;
end;

registration
  let C be set;
  let D be real-membered non empty set;
  let f be Function of C,D;
  let r be real number;
  cluster r(#)f -> total for PartFunc of C,REAL;
end;

registration
  let C be set;
  let D be rational-membered non empty set;
  let f be Function of C,D;
  let r be rational number;
  cluster r(#)f -> total for PartFunc of C,RAT;
end;

registration
  let C be set;
  let D be integer-membered non empty set;
  let f be Function of C,D;
  let r be integer number;
  cluster r(#)f -> total for PartFunc of C,INT;
end;

registration
  let C be set;
  let D be natural-membered non empty set;
  let f be Function of C,D;
  let r be Nat;
  cluster r(#)f -> total for PartFunc of C,NAT;
end;

theorem 
  for C being non empty set, D being complex-membered non empty set for
  f being Function of C,D, r being complex number for g being Function of C,
  COMPLEX st for c being Element of C holds g.c = r * f.c holds g = r(#)f;

registration
  let f be complex-valued FinSequence, r be complex number;
  cluster r(#)f -> FinSequence-like;
end;

begin 

definition
  let f be complex-valued Function;
  func -f -> complex-valued Function equals

  (-1) (#) f;
  involutiveness;
end;

theorem 
  for f being complex-valued Function holds dom -f = dom f & for c
  being set holds (-f).c = -(f.c);

theorem 
  for f being complex-valued Function, g being Function st dom f = dom g
  & for c being set st c in dom f holds g.c = -(f.c) holds g = -f;

registration
  let f be complex-valued Function;
  cluster -f -> complex-valued;
end;

registration
  let f be real-valued Function;
  cluster -f -> real-valued;
end;

registration
  let f be RAT-valued Function;
  cluster -f -> RAT-valued;
end;

registration
  let f be INT-valued Function;
  cluster -f -> INT-valued;
end;

definition
  let C be set;
  let D be complex-membered set;
  let f be PartFunc of C,D;
  redefine func -f -> PartFunc of C,COMPLEX;
end;

definition
  let C be set;
  let D be real-membered set;
  let f be PartFunc of C,D;
  redefine func -f -> PartFunc of C,REAL;
end;

definition
  let C be set;
  let D be rational-membered set;
  let f be PartFunc of C,D;
  redefine func -f -> PartFunc of C,RAT;
end;

definition
  let C be set;
  let D be integer-membered set;
  let f be PartFunc of C,D;
  redefine func -f -> PartFunc of C,INT;
end;

registration
  let C be set;
  let D be complex-membered non empty set;
  let f be Function of C,D;
  cluster -f -> total for PartFunc of C,COMPLEX;
end;

registration
  let C be set;
  let D be real-membered non empty set;
  let f be Function of C,D;
  cluster -f -> total for PartFunc of C,REAL;
end;

registration
  let C be set;
  let D be rational-membered non empty set;
  let f be Function of C,D;
  cluster -f -> total for PartFunc of C,RAT;
end;

registration
  let C be set;
  let D be integer-membered non empty set;
  let f be Function of C,D;
  cluster -f -> total for PartFunc of C,INT;
end;

registration
  let f be complex-valued FinSequence;
  cluster -f -> FinSequence-like;
end;

begin 

definition
  let f be complex-valued Function;
  func f" -> complex-valued Function means


  dom it = dom f & for c being
  set st c in dom it holds it.c = (f.c)";
  involutiveness;
end;


theorem 
  for f being complex-valued Function holds for c being set holds
  f".c = (f.c)";

registration
  let f be real-valued Function;
  cluster f" -> real-valued;
end;

registration
  let f be RAT-valued Function;
  cluster f" -> RAT-valued;
end;

definition
  let C be set;
  let D be complex-membered set;
  let f be PartFunc of C,D;
  redefine func f" -> PartFunc of C,COMPLEX;
end;

definition
  let C be set;
  let D be real-membered set;
  let f be PartFunc of C,D;
  redefine func f" -> PartFunc of C,REAL;
end;

definition
  let C be set;
  let D be rational-membered set;
  let f be PartFunc of C,D;
  redefine func f" -> PartFunc of C,RAT;
end;

registration
  let C be set;
  let D be complex-membered non empty set;
  let f be Function of C,D;
  cluster f" -> total for PartFunc of C,COMPLEX;
end;

registration
  let C be set;
  let D be real-membered non empty set;
  let f be Function of C,D;
  cluster f" -> total for PartFunc of C,REAL;
end;

registration
  let C be set;
  let D be rational-membered non empty set;
  let f be Function of C,D;
  cluster f" -> total for PartFunc of C,RAT;
end;

registration
  let f be complex-valued FinSequence;
  cluster f" -> FinSequence-like;
end;

begin 

definition
  let f be complex-valued Function;
  func f^2 -> Function equals

  f (#) f;
end;

theorem 
  for f being complex-valued Function holds dom (f^2) = dom f &
  for c being set holds f^2.c = (f.c)^2;

registration
  let f be complex-valued Function;
  cluster f^2 -> complex-valued;
end;

registration
  let f be real-valued Function;
  cluster f^2 -> real-valued;
end;

registration
  let f be RAT-valued Function;
  cluster f^2 -> RAT-valued;
end;

registration
  let f be INT-valued Function;
  cluster f^2 -> INT-valued;
end;

registration
  let f be natural-valued Function;
  cluster f^2 -> natural-valued;
end;

definition
  let C be set;
  let D be complex-membered set;
  let f be PartFunc of C,D;
  redefine func f^2 -> PartFunc of C,COMPLEX;
end;

definition
  let C be set;
  let D be real-membered set;
  let f be PartFunc of C,D;
  redefine func f^2 -> PartFunc of C,REAL;
end;

definition
  let C be set;
  let D be rational-membered set;
  let f be PartFunc of C,D;
  redefine func f^2 -> PartFunc of C,RAT;
end;

definition
  let C be set;
  let D be integer-membered set;
  let f be PartFunc of C,D;
  redefine func f^2 -> PartFunc of C,INT;
end;

definition
  let C be set;
  let D be natural-membered set;
  let f be PartFunc of C,D;
  redefine func f^2 -> PartFunc of C,NAT;
end;

registration
  let C be set;
  let D be complex-membered non empty set;
  let f be Function of C,D;
  cluster f^2 -> total for PartFunc of C,COMPLEX;
end;

registration
  let C be set;
  let D be real-membered non empty set;
  let f be Function of C,D;
  cluster f^2 -> total for PartFunc of C,REAL;
end;

registration
  let C be set;
  let D be rational-membered non empty set;
  let f be Function of C,D;
  cluster f^2 -> total for PartFunc of C,RAT;
end;

registration
  let C be set;
  let D be integer-membered non empty set;
  let f be Function of C,D;
  cluster f^2 -> total for PartFunc of C,INT;
end;

registration
  let C be set;
  let D be natural-membered non empty set;
  let f be Function of C,D;
  cluster f^2 -> total for PartFunc of C,NAT;
end;

registration
  let f be complex-valued FinSequence;
  cluster f^2 -> FinSequence-like;
end;

begin 

definition
  let f1,f2 be complex-valued Function;
  func f1 - f2 -> Function equals

  f1 + - f2;
end;

registration
  let f1,f2 be complex-valued Function;
  cluster f1-f2 -> complex-valued;
end;

registration
  let f1,f2 be real-valued Function;
  cluster f1-f2 -> real-valued;
end;

registration
  let f1,f2 be RAT-valued Function;
  cluster f1-f2 -> RAT-valued;
end;

registration
  let f1,f2 be INT-valued Function;
  cluster f1-f2 -> INT-valued;
end;

theorem 
  for f1,f2 being complex-valued Function holds dom (f1-f2) = dom
  f1 /\ dom f2;

theorem 
  for f1,f2 being complex-valued Function for c being set st c in dom (
  f1-f2) holds (f1-f2).c = f1.c - f2.c;

theorem 
  for f1,f2 being complex-valued Function, f being Function st dom f =
  dom (f1-f2) & for c being set st c in dom f holds f.c = f1.c - f2.c holds f =
  f1-f2;

definition
  let C be set;
  let D1,D2 be complex-membered set;
  let f1 be PartFunc of C,D1;
  let f2 be PartFunc of C,D2;
  redefine func f1-f2 -> PartFunc of C,COMPLEX;
end;

definition
  let C be set;
  let D1,D2 be real-membered set;
  let f1 be PartFunc of C,D1;
  let f2 be PartFunc of C,D2;
  redefine func f1-f2 -> PartFunc of C,REAL;
end;

definition
  let C be set;
  let D1,D2 be rational-membered set;
  let f1 be PartFunc of C,D1;
  let f2 be PartFunc of C,D2;
  redefine func f1-f2 -> PartFunc of C,RAT;
end;

definition
  let C be set;
  let D1,D2 be integer-membered set;
  let f1 be PartFunc of C,D1;
  let f2 be PartFunc of C,D2;
  redefine func f1-f2 -> PartFunc of C,INT;
end;

registration
  let C be set;
  let D1,D2 be complex-membered non empty set;
  let f1 be Function of C,D1;
  let f2 be Function of C,D2;
  cluster f1-f2 -> total for PartFunc of C,COMPLEX;
end;

registration
  let C be set;
  let D1,D2 be real-membered non empty set;
  let f1 be Function of C,D1;
  let f2 be Function of C,D2;
  cluster f1-f2 -> total for PartFunc of C,REAL;
end;

registration
  let C be set;
  let D1,D2 be rational-membered non empty set;
  let f1 be Function of C,D1;
  let f2 be Function of C,D2;
  cluster f1-f2 -> total for PartFunc of C,RAT;
end;

registration
  let C be set;
  let D1,D2 be integer-membered non empty set;
  let f1 be Function of C,D1;
  let f2 be Function of C,D2;
  cluster f1-f2 -> total for PartFunc of C,INT;
end;

theorem 
  for C being set, D1,D2 being complex-membered non empty set for f1
  being Function of C,D1, f2 being Function of C,D2 for c being Element of C
  holds (f1-f2).c = f1.c - f2.c;

registration
  let f1, f2 be complex-valued FinSequence;
  cluster f1-f2 -> FinSequence-like;
end;

begin 

definition
  let f1,f2 be complex-valued Function;
  func f1 /" f2 -> Function equals

  f1 (#) (f2");
end;

theorem 
  for f1,f2 being complex-valued Function holds dom (f1/"f2) = dom
  f1 /\ dom f2;

theorem 
  for f1,f2 being complex-valued Function for c being set holds (f1/"f2)
  .c = f1.c / f2.c;

registration
  let f1,f2 be complex-valued Function;
  cluster f1/"f2 -> complex-valued;
end;

registration
  let f1,f2 be real-valued Function;
  cluster f1/"f2 -> real-valued;
end;

registration
  let f1,f2 be RAT-valued Function;
  cluster f1/"f2 -> RAT-valued;
end;

definition
  let C be set;
  let D1,D2 be complex-membered set;
  let f1 be PartFunc of C,D1;
  let f2 be PartFunc of C,D2;
  redefine func f1/"f2 -> PartFunc of C,COMPLEX;
end;

definition
  let C be set;
  let D1,D2 be real-membered set;
  let f1 be PartFunc of C,D1;
  let f2 be PartFunc of C,D2;
  redefine func f1/"f2 -> PartFunc of C,REAL;
end;

definition
  let C be set;
  let D1,D2 be rational-membered set;
  let f1 be PartFunc of C,D1;
  let f2 be PartFunc of C,D2;
  redefine func f1/"f2 -> PartFunc of C,RAT;
end;

registration
  let C be set;
  let D1,D2 be complex-membered non empty set;
  let f1 be Function of C,D1;
  let f2 be Function of C,D2;
  cluster f1/"f2 -> total for PartFunc of C,COMPLEX;
end;

registration
  let C be set;
  let D1,D2 be real-membered non empty set;
  let f1 be Function of C,D1;
  let f2 be Function of C,D2;
  cluster f1/"f2 -> total for PartFunc of C,REAL;
end;

registration
  let C be set;
  let D1,D2 be rational-membered non empty set;
  let f1 be Function of C,D1;
  let f2 be Function of C,D2;
  cluster f1/"f2 -> total for PartFunc of C,RAT;
end;

registration
  let f1, f2 be complex-valued FinSequence;
  cluster f1/"f2 -> FinSequence-like;
end;

begin 

definition
  let f be complex-valued Function;
  func |. f .| -> real-valued Function means


  dom it = dom f & for c
  being set st c in dom it holds it.c = |. f.c .|;
  projectivity;
end;

notation
  let f be complex-valued Function;
  synonym abs f for |. f .|;
end;

theorem 
  for f being complex-valued Function holds for c being set holds |.f.|.
  c = |.f.c.|;

registration
  let f be RAT-valued Function;
  cluster |.f.| -> RAT-valued;
end;

registration
  let f be INT-valued Function;
  cluster |.f.| -> natural-valued;
end;

definition
  let C be set;
  let D be complex-membered set;
  let f be PartFunc of C,D;
  redefine func |.f.| -> PartFunc of C,REAL;
end;

definition
  let C be set;
  let D be complex-membered set;
  let f be PartFunc of C,D;
  redefine func abs(f) -> PartFunc of C,REAL;
end;

definition
  let C be set;
  let D be rational-membered set;
  let f be PartFunc of C,D;
  redefine func |.f.| -> PartFunc of C,RAT;
end;

definition
  let C be set;
  let D be rational-membered set;
  let f be PartFunc of C,D;
  redefine func abs(f) -> PartFunc of C,RAT;
end;

definition
  let C be set;
  let D be integer-membered set;
  let f be PartFunc of C,D;
  redefine func |.f.| -> PartFunc of C,NAT;
end;

definition
  let C be set;
  let D be integer-membered set;
  let f be PartFunc of C,D;
  redefine func abs(f) -> PartFunc of C,NAT;
end;

registration
  let C be set;
  let D be complex-membered non empty set;
  let f be Function of C,D;
  cluster |.f.| -> total for PartFunc of C,REAL;
end;

registration
  let C be set;
  let D be rational-membered non empty set;
  let f be Function of C,D;
  cluster |.f.| -> total for PartFunc of C,RAT;
end;

registration
  let C be set;
  let D be integer-membered non empty set;
  let f be Function of C,D;
  cluster |.f.| -> total for PartFunc of C,NAT;
end;

registration
  let f be complex-valued FinSequence;
  cluster |.f.| -> FinSequence-like;
end;

theorem 
  for f, g being FinSequence, h being Function st dom h = dom f /\ dom g
  holds h is FinSequence;

begin 



reserve m,j,p,q,n,l for Element of NAT;

definition
  let p be Function, k be Nat;
  func Shift(p,k) -> Function means


  dom it = { m+k:m in dom p } & for
  m st m in dom p holds it.(m+k) = p.m;
end;

registration
  let p be Function, k be Nat;
  cluster Shift(p,k) -> NAT-defined;
end;

theorem 
  for P,Q being Function, k being Nat st P c= Q holds Shift(P
  ,k) c= Shift(Q,k);

theorem 
  for n,m being Nat
  for I being Function holds Shift(Shift(I,m),n) = Shift(I,m+n);

theorem 
  for s,f be Function for n being Nat holds Shift(f*s,n) = f*Shift(s,n);

theorem 
  for I,J being Function, n being Nat
   holds Shift(I +* J, n) = Shift(I,n) +* Shift(J,n);



theorem 
  for p being Function,k,il being Nat st il in dom p
  holds il+k in dom Shift(p,k);



theorem 
  for p being Function, k being Nat holds rng Shift(p,k) c= rng p;

theorem 
  for p being Function st dom p c= NAT for k being Nat holds
  rng Shift(p,k) = rng p;

registration
  let p be finite Function, k be Nat;
  cluster Shift(p,k) -> finite;
end;

reserve e1,e2 for ext-real number;

definition
  let X be non empty ext-real-membered set, s be sequence of X;
  redefine attr s is increasing means

  for n being Nat holds s.n < s.(n+1);
  redefine attr s is decreasing means

  for n being Nat holds s.n > s.(n+1);
  redefine attr s is non-decreasing means

  for n being Nat holds s.n <= s.(n+1);
  redefine attr s is non-increasing means

  for n being Nat holds s.n >= s.(n+1);
end;



scheme 

  SubSeqChoice { X() -> non empty set, S() -> sequence of X(), P[set]} :
   ex S1 being subsequence of S() st for n being Element of NAT holds P[S1.n]
provided
 for n being Element of NAT ex m being Element of NAT st n <= m & P[S
().m];



theorem 
  for k being Nat
  for F being NAT-defined Function
  holds dom F,dom Shift(F,k) are_equipotent;

registration
 let F be NAT-defined Function;
 reduce Shift(F,0) to F;
end;

theorem 
  for F being NAT-defined Function holds Shift(F,0) = F;

registration
  let X be non empty set;
  let F be X-valued Function, k be Nat;
  cluster Shift(F,k) -> X-valued;
end;

registration  
 cluster non empty NAT-defined for Function;
end;

registration
  let F be empty Function, k be Nat;
  cluster Shift(F,k) -> empty;
end;

registration
  let F be non empty NAT-defined Function, k be Nat;
  cluster Shift(F,k) -> non empty;
end;

theorem 
  for F being Function, k being Nat st k > 0
  holds not 0 in dom Shift(F,k);

registration
 cluster NAT-defined finite non empty for Function;
end;

registration
  let F be NAT-defined Relation;
  cluster dom F -> natural-membered;
end;

definition
  let F be non empty NAT-defined finite Function;
  func LastLoc F -> Element of NAT equals

   max dom F;
end;

definition
  let F be non empty NAT-defined finite Function;
  func CutLastLoc F -> Function equals

  F \ ( LastLoc F .--> F.LastLoc F );
end;

registration
 let F be non empty NAT-defined finite Function;
 cluster CutLastLoc F -> NAT-defined finite;
end;

theorem 
  for F being non empty NAT-defined finite Function holds
  LastLoc F in dom F;

theorem 
  for F, G being non empty NAT-defined finite Function st F c= G holds
  LastLoc F <= LastLoc G;

theorem 
  for F being non empty NAT-defined finite Function, l being
  Element of NAT st l in dom F holds l <= LastLoc F;

definition
  let F be non empty NAT-defined Function;
  func FirstLoc F -> Element of NAT equals

   min dom F;
end;

theorem 
  for F being non empty NAT-defined finite Function holds
  FirstLoc F in dom F;

theorem 
  for F, G being non empty NAT-defined finite Function st F c= G holds
  FirstLoc G <= FirstLoc F;

theorem 
  for l1 being Element of NAT
  for F being non empty NAT-defined finite Function st l1 in dom
  F holds FirstLoc F <= l1;

theorem 
  for F being non empty NAT-defined finite Function
  holds dom CutLastLoc F = (dom F) \ {LastLoc F};

theorem 
  for F being non empty NAT-defined finite Function
  holds dom F = dom CutLastLoc F \/ {LastLoc F};

registration
 cluster 1-element NAT-defined finite for Function;
end;

registration
  let F be 1-element NAT-defined finite Function;
  cluster CutLastLoc F -> empty;
end;

theorem 
  for F being non empty NAT-defined finite Function
  holds card CutLastLoc F = card F - 1;

begin 

registration let X be set, f be X-defined complex-valued Function;
 cluster -f -> X-defined;
 cluster f" -> X-defined;
 cluster f^2 -> X-defined;
 cluster |.f.| -> X-defined;
end;

registration let X be set;
 cluster total for X-defined natural-valued Function;
end;

registration let X be set,
   f be total X-defined complex-valued Function;
 cluster -f -> total;
 cluster f" -> total;
 cluster f^2 -> total;
 cluster |.f.| -> total;
end;

registration
 let X be set, f be X-defined complex-valued Function,
     r be complex number;
 cluster r+f -> X-defined;
 cluster f-r -> X-defined;
 cluster r(#)f -> X-defined;
end;

registration let X be set,
   f be total X-defined complex-valued Function,
     r be complex number;
 cluster r+f -> total;
 cluster f-r -> total;
 cluster r(#)f -> total;
end;

registration
 let X be set, f1 be complex-valued Function;
 let f2 be X-defined complex-valued Function;
 cluster f1 + f2 -> X-defined;
 cluster f1 - f2 -> X-defined;
 cluster f1(#)f2 -> X-defined;
 cluster f1/"f2 -> X-defined;
end;

registration let X be set;
 let f1,f2 be total X-defined complex-valued Function;
 cluster f1 + f2 -> total;
 cluster f1 - f2 -> total;
 cluster f1(#)f2 -> total;
 cluster f1/"f2 -> total;
end;

registration let X be non empty set;
 let F be X-valued non empty NAT-defined finite Function;
 cluster CutLastLoc F -> X-valued;
end;

theorem 
 for f being Function
 for i,n being Nat st i in dom Shift(f,n)
  ex j being Nat st j in dom f & i = j + n;














begin

reserve i,j,k,l for Nat;
reserve A,a,b,x,x1,x2,x3 for set;
reserve D,D9,E for non empty set;
reserve d,d1,d2,d3 for Element of D;
reserve d9,d19,d29,d39 for Element of D9;
reserve p,q,r for FinSequence;



theorem 
  min(i,j) is Element of NAT & max(i,j) is Element of NAT;

theorem 
  l = min(i,j) implies Seg i /\ Seg j = Seg l;

theorem 
  i <= j implies max(0,i-j) = 0;

theorem 
  j <= i implies max(0,i-j) = i-j;

theorem 
  max(0,i-j) is Element of NAT;

theorem 
  min(0,i) = 0 & min(i,0) = 0 & max(0,i) = i & max(i,0) = i;



theorem 
  i in Seg (l+1) implies i in Seg l or i = l+1;

theorem 
  i in Seg l implies i in Seg(l+j);



theorem 
  len p = len q & (for j st j in dom p holds p.j = q.j) implies p = q;

theorem 
  b in rng p implies ex i st i in dom p & p.i = b;

theorem 
  for D being set for p being FinSequence of D st i in dom p holds p.i in D;

theorem 
  for D being set holds (for i st i in dom p holds p.i in D)
  implies p is FinSequence of D;

theorem 
  <*d1,d2*> is FinSequence of D;

theorem 
  <*d1,d2,d3*> is FinSequence of D;

theorem 
  i in dom p implies i in dom(p^q);

theorem 
  len(p^<*a*>) = len p + 1;

theorem 
  p^<*a*> = q^<*b*> implies p = q & a = b;

theorem 
  len p = i + 1 implies ex q,a st p = q^<*a*>;

theorem 
  for p being FinSequence of A st len p <> 0 ex q being
  FinSequence of A, d being Element of A st p = q^<*d*>;

theorem 
  q = p|(Seg i) & len p <= i implies p = q;

theorem 
  q = p|(Seg i) implies len q = min(i,len p);

theorem 
  len r = i+j implies ex p,q st len p = i & len q = j & r = p^q;

theorem 
  for r being FinSequence of D st len r = i+j ex p,q being
  FinSequence of D st len p = i & len q = j & r = p^q;

scheme 

  SeqLambdaD{i()->Nat,D()->non empty set,F(set)->Element of D()}: ex z being
FinSequence of D() st len z = i() & for j being Nat st j in dom z holds z.j = F
  (j);

scheme 

  IndSeqD{D()->set, P[set]}: for p being FinSequence of D() holds P[p]
provided
 P[<*> D()] and
 for p being FinSequence of D() for x being Element of D() st P[p]
holds P[p^<*x*>];

theorem 
  for D being set, D1 being Subset of D for p being FinSequence of D1
  holds p is FinSequence of D;

theorem 
  for f being Function of Seg i, D holds f is FinSequence of D;

theorem 
  for p being FinSequence of D holds p is Function of dom p, D;

theorem 
  for f being Function of NAT,D holds f|(Seg i) is FinSequence of D;

theorem 
  for f being Function of NAT,D st q = f|(Seg i) holds len q = i;

theorem 
  for f being Function st rng p c= dom f & q = f*p holds len q = len p;

theorem 
  D = Seg i implies for p being FinSequence for q being
  FinSequence of D st i <= len p holds p*q is FinSequence;

theorem 
  D = Seg i implies for p being FinSequence of D9 for q being
  FinSequence of D st i <= len p holds p*q is FinSequence of D9;

theorem 
  for A,D being set for p being FinSequence of A for f being
  Function of A,D holds f*p is FinSequence of D;

theorem 
  for p being FinSequence of A
  for f being Function of A,D9 st q = f*p holds len q = len p;

theorem 
  for x being set, f being Function st x in dom f holds f*<*x*> = <*f.x*>;

theorem 
  for p being FinSequence of D
  for f being Function of D,D9 st p = <*x1*> holds f*p = <*f.x1*>;

theorem 
  for p being FinSequence of D for f being Function of D,D9 st p =
  <*x1,x2*> holds f*p = <*f.x1,f.x2*>;

theorem 
  for p being FinSequence of D for f being Function of D,D9 st p =
  <*x1,x2,x3*> holds f*p = <*f.x1,f.x2,f.x3*>;

theorem 
  for f being Function of Seg i,Seg j st (j = 0 implies i = 0) & j
  <= len p holds p*f is FinSequence;

theorem 
  for f being Function of Seg i,Seg i st i <= len p holds p*f is
  FinSequence;

theorem 
  for f being Function of dom p,dom p holds p*f is FinSequence;

theorem 
  for f being Function of Seg i,Seg i st rng f = Seg i & i <= len
  p & q = p*f holds len q = i;

theorem 
  for f being Function of dom p,dom p st rng f = dom p & q = p*f
  holds len q = len p;

theorem 
  for f being Permutation of Seg i st i <= len p & q = p*f holds len q = i;

theorem 
  for f being Permutation of dom p st q = p*f holds len q = len p;

theorem 
  for p being FinSequence of D for f being Function of Seg i,Seg j
  st (j = 0 implies i = 0) & j <= len p holds p*f is FinSequence of D;

theorem 
  for p being FinSequence of D for f being Function of Seg i,Seg i st i
  <= len p holds p*f is FinSequence of D;

theorem 
  for p being FinSequence of D for f being Function of dom p,dom p
  holds p*f is FinSequence of D;

theorem 
  id Seg k is FinSequence of NAT;

definition
  let i be Nat;
  func idseq i -> FinSequence equals

  id Seg i;
end;

registration
  let k;
  cluster idseq k -> k-element;
end;

registration
  cluster idseq 0 -> empty;
end;

theorem 
  for k being Element of Seg i holds (idseq i).k = k;

theorem 
  idseq 1 = <*1*>;

theorem 
  idseq (i+1) = (idseq i) ^ <*i+1*>;

theorem 
  idseq 2 = <*1,2*>;

theorem 
  idseq 3 = <*1,2,3*>;

theorem 
  len p <= k implies p*(idseq k) = p;

theorem 
  idseq k is Permutation of Seg k;

theorem 
  (Seg k) --> a is FinSequence;

registration
  let k, a;
  cluster (Seg k) --> a -> FinSequence-like;
end;

definition
  let i be Nat, a be set;
  func i |-> a -> FinSequence equals

  Seg i --> a;
end;

registration
  let k be Nat, a be set;
  cluster k |-> a -> k-element;
end;

theorem 
  for d being set, w being set st w in Seg k holds (k |-> d).w = d;

theorem 
  0 |-> a = {};

theorem 
  1 |-> a = <*a*>;

theorem 
  (i+1) |-> a = (i |-> a) ^ <*a*>;

theorem 
  2 |-> a = <*a,a*>;

theorem 
  3 |-> a = <*a,a,a*>;

theorem 
  k |-> d is FinSequence of D;

theorem 
  for F being Function st [:rng p,rng q:] c= dom F holds F.:(p,q)
  is FinSequence;

theorem 
  for F being Function st [:rng p,rng q:] c= dom F & r = F.:(p,q)
  holds len r = min(len p,len q);

theorem 
  for F being Function st [:{a},rng p:] c= dom F holds F[;](a,p) is FinSequence
;

theorem 
  for F being Function st [:{a},rng p:] c= dom F & r = F[;](a,p)
  holds len r = len p;

theorem 
  for F being Function st [:rng p,{a}:] c= dom F holds F[:](p,a) is FinSequence
;

theorem 
  for F being Function st [:rng p,{a}:] c= dom F & r = F[:](p,a)
  holds len r = len p;

theorem 
  for F being Function of [:D,D9:],E for p being FinSequence of D
  for q being FinSequence of D9 holds F.:(p,q) is FinSequence of E;

theorem 
  for F being Function of [:D,D9:],E for p being FinSequence of D
  for q being FinSequence of D9 st r = F.:(p,q) holds len r = min(len p,len q);

theorem 
  for F being Function of [:D,D9:],E for p being FinSequence of D
for q being FinSequence of D9 st len p = len q & r = F.:(p,q) holds len r = len
  p & len r = len q;

theorem 
  for F being Function of [:D,D9:],E for p being FinSequence of D for p9
  being FinSequence of D9 holds F.:(<*>D,p9) = <*>E & F.:(p,<*>D9) = <*>E;

theorem 
  for F being Function of [:D,D9:],E for p being FinSequence of D for q
  being FinSequence of D9 st p = <*d1*> & q = <*d19*> holds F.:(p,q) = <*F.(d1,
  d19)*>;

theorem 
  for F being Function of [:D,D9:],E for p being FinSequence of D for q
being FinSequence of D9 st p = <*d1,d2*> & q = <*d19,d29*> holds F.:(p,q) = <*F
  .(d1,d19),F.(d2,d29)*>;

theorem 
  for F being Function of [:D,D9:],E for p being FinSequence of D for q
being FinSequence of D9 st p = <*d1,d2,d3*> & q = <*d19,d29,d39*> holds F.:(p,q
  ) = <*F.(d1,d19),F.(d2,d29),F.(d3,d39)*>;

theorem 
  for F being Function of [:D,D9:],E for p being FinSequence of D9
  holds F[;](d,p) is FinSequence of E;

theorem 
  for F being Function of [:D,D9:],E for p being FinSequence of D9
  st r = F[;](d,p) holds len r = len p;

theorem 
  for F being Function of [:D,D9:],E holds F[;](d,<*>D9) = <*>E;

theorem 
  for F being Function of [:D,D9:],E for p being FinSequence of D9 st p
  = <*d19*> holds F[;](d,p) = <*F.(d,d19)*>;

theorem 
  for F being Function of [:D,D9:],E for p being FinSequence of D9 st p
  = <*d19,d29*> holds F[;](d,p) = <*F.(d,d19),F.(d,d29)*>;

theorem 
  for F being Function of [:D,D9:],E for p being FinSequence of D9 st p
  = <*d19,d29,d39*> holds F[;](d,p) = <*F.(d,d19),F.(d,d29),F.(d,d39)*>;

theorem 
  for F being Function of [:D,D9:],E for p being FinSequence of D
  holds F[:](p,d9) is FinSequence of E;

theorem 
  for F being Function of [:D,D9:],E for p being FinSequence of D
  st r = F[:](p,d9) holds len r = len p;

theorem 
  for F being Function of [:D,D9:],E holds F[:](<*>D,d9) = <*>E;

theorem 
  for F being Function of [:D,D9:],E for p being FinSequence of D st p =
  <*d1*> holds F[:](p,d9) = <*F.(d1,d9)*>;

theorem 
  for F being Function of [:D,D9:],E for p being FinSequence of D st p =
  <*d1,d2*> holds F[:](p,d9) = <*F.(d1,d9),F.(d2,d9)*>;

theorem 
  for F being Function of [:D,D9:],E for p being FinSequence of D st p =
  <*d1,d2,d3*> holds F[:](p,d9) = <*F.(d1,d9),F.(d2,d9),F.(d3,d9)*>;



definition
  let D be set;
  mode FinSequenceSet of D -> set means


  a in it implies a is FinSequence of D;
end;

definition
  let D be set, S be FinSequenceSet of D;
  redefine mode Element of S -> FinSequence of D;
end;

registration
  let D be set;
  cluster non empty for FinSequenceSet of D;
end;

theorem 
  for D being set holds D* is FinSequenceSet of D;

definition
  let D be set;
  redefine func D* -> FinSequenceSet of D;
end;

theorem 
  for D being set, D9 being FinSequenceSet of D holds D9 c= D*;

theorem 
  for D9 being Subset of D, S being FinSequenceSet of D9
  holds S is FinSequenceSet of D;

reserve s for Element of D*;

registration
  let i be Nat, D;
  cluster i-element for FinSequence of D;
end;

definition
  let i be Nat, D be non empty set;
  mode Tuple of i,D is i-element FinSequence of D;
end;

definition
  let i be Nat;
  let D be set;
  func i-tuples_on D -> FinSequenceSet of D equals

  { s where s is Element of D*: len s = i };
end;

registration
  let i be Nat, D;
  cluster i-tuples_on D -> non empty;
end;

registration
  let D;
  let i be Nat;
  cluster -> i-element for Element of i-tuples_on D;
end;

theorem 
  for D be set, z being FinSequence of D holds z is Element of (
  len z)-tuples_on D;

theorem 
 for D being set holds i-tuples_on D = Funcs(Seg i,D);

theorem 
  for D being set holds 0-tuples_on D = { <*>D };

theorem 
  for z being Tuple of 0,D for t being Tuple of i, D
   holds z^t = t & t^z = t;

theorem 
  1-tuples_on D = { <*d*>: not contradiction };

theorem 
  for z being Tuple of 1,D ex d st z = <*d*>;

theorem 
  <*d*> in 1-tuples_on D;

theorem 
  2-tuples_on D = { <*d1,d2*>: not contradiction };

theorem 
  for z being Tuple of 2,D ex d1,d2 st z = <*d1,d2*>;

theorem 
  <*d1,d2*> in 2-tuples_on D;

theorem 
  3-tuples_on D = { <*d1,d2,d3*>: not contradiction };

theorem 
  for z being Tuple of 3,D ex d1,d2,d3 st z = <*d1,d2,d3*>;

theorem 
  <*d1,d2,d3*> in 3-tuples_on D;

theorem 
  (i+j)-tuples_on D = {z^t where z is Tuple of i,D,
  t is Tuple of j,D: not contradiction};

theorem 
  for s being Tuple of i+j,D
   ex z being Element of i-tuples_on D, t being Element of j-tuples_on D
    st s = z^t;

theorem 
  for z being Tuple of i,D for t being Tuple of j,D holds z^t is Tuple of i+j,D
;

theorem 
  D* = union {i-tuples_on D where i is Element of NAT: not contradiction};

theorem 
  for D9 being non empty Subset of D
  for z being Tuple of i,D9 holds z is Element of i-tuples_on D;

theorem 
  i-tuples_on D = j-tuples_on A implies i = j;

theorem 
  idseq i is Element of i-tuples_on NAT;

theorem 
  i |-> d is Element of i-tuples_on D;

theorem 
  for z being Tuple of i,D for f being Function of D,D9
  holds f*z is Element of i-tuples_on D9;

theorem 
  for z being Tuple of i,D for f being Function of
  Seg i,Seg i st rng f = Seg i holds z*f is Element of i-tuples_on D;

theorem 
  for z being Tuple of i,D for f being Permutation of Seg i
  holds z*f is Tuple of i,D;

theorem 
  for z being Tuple of i,D for d holds (z^<*d*>).(i+1) = d;

theorem 
  for z being Tuple of i+1,D ex t being Element of i-tuples_on D, d
   st z = t^<*d*>;

theorem 
  for z being Tuple of i,D holds z*(idseq i) = z;

theorem 
  for z1,z2 being Tuple of i,D st for j st j in Seg i holds
  z1.j = z2.j holds z1 = z2;

theorem 
  for F being Function of [:D,D9:],E for z1 being Tuple of i,D
   for z2 being Tuple of i,D9 holds F.:(z1,z2) is Element of i
  -tuples_on E;

theorem 
  for F being Function of [:D,D9:],E for z being Tuple of i,D9
   holds F[;](d,z) is Element of i-tuples_on E;

theorem 
  for F being Function of [:D,D9:],E for z being Tuple of i,D
    holds F[:](z,d9) is Element of i-tuples_on E;

theorem 
  (i+j)|->x = (i|->x)^(j|->x);



theorem 
  for i, D for x being Tuple of i,D holds dom x = Seg i;

theorem 
  for f being Function, x, y being set st x in dom f & y in dom f holds
  f*<*x,y*> = <*f.x,f.y*>;

theorem 
  for f being Function, x, y, z being set st x in dom f & y in dom f & z
  in dom f holds f*<*x,y,z*> = <*f.x,f.y,f.z*>;

theorem 
  rng <*x1,x2*> = {x1,x2};

theorem 
  rng <*x1,x2,x3*> = {x1,x2,x3};

begin 


theorem 
  for p1,p2,q being FinSequence st p1 c= q & p2 c= q & len p1 = len p2
  holds p1 = p2;



reserve m,n for Nat,
  s,w for FinSequence of NAT;

theorem 
  for D being non empty set,
      s being FinSequence of D st s <> {}
   ex w being FinSequence of D, n being Element of D st s = <*n*>^w;



registration
  let D be set;
  cluster -> functional for FinSequenceSet of D;
end;



definition
  let D,n,d;
  redefine func n |-> d -> Element of n-tuples_on D;
end;



theorem 
 for z being set holds z is Tuple of i,D iff z in i-tuples_on D;



theorem 
  for A being set, i being (Element of NAT), p being FinSequence
  holds p in i-tuples_on A iff len p = i & rng p c= A;

theorem 
  for A being set, i being (Element of NAT), p being FinSequence of
  A holds p in i-tuples_on A iff len p = i;

theorem 
  for A being set, i being Element of NAT holds i-tuples_on A c= A*;

theorem 
  for A,x being set holds x in 1-tuples_on A iff ex a being set st
  a in A & x = <*a*>;

theorem 
  for A,a being set st <*a*> in 1-tuples_on A holds a in A;

theorem 
  for A,x being set holds x in 2-tuples_on A iff
  ex a,b being set st a in A & b in A & x = <*a,b*>;

theorem 
  for A,a,b being set st <*a,b*> in 2-tuples_on A holds a in A & b in A;

theorem 
  for A,x being set holds x in 3-tuples_on A iff
  ex a,b,c being set st a in A & b in A & c in A & x = <*a,b,c*>;

theorem 
  for A,a,b,c being set st <*a,b,c*> in 3-tuples_on A holds
  a in A & b in A & c in A;

theorem 
  x in i-tuples_on A implies x is i-element FinSequence;



theorem 
  for A being non empty set, n holds n-tuples_on A c= A*;



theorem 
  n |-> x = m |-> x implies n = m;



reserve i,j,e,u for set,
        n for Element of NAT;

definition
  let I be set;
  let M be ManySortedSet of I;
  func M# -> ManySortedSet of I* means


  for i being Element of I* holds it.i = product(M*i);
end;

registration
  let I be set;
  let M be non-empty ManySortedSet of I;
  cluster M# -> non-empty;
end;

definition
  let a be set;
  func *-->a -> Function of NAT,{a}* means


  for n being Element of NAT holds it.n = n |-> a;
end;

theorem 
  for a,b being set holds (a .--> b)*(n|->a) = n |-> b;

theorem 
  for a being set for M being ManySortedSet of {a} st M = a .--> D holds
  (M#* *-->a).n = Funcs(Seg n, D);

theorem 
 for F being total NAT-defined Function, p be NAT-defined Function,
     n be Element of NAT st Shift(p,n) c= F
 for i being Element of NAT st i in dom p holds F.(n+i) = p.i;

registration
  let i be Nat;
  cluster i |-> 0 -> empty-yielding;
end;



registration
  let D be set;
  cluster -> FinSequence-membered for FinSequenceSet of D;
end;














begin

reserve f for Function;
reserve n,k,n1 for Element of NAT;
reserve r,p for real number;
reserve x,y,z for set;

definition
  mode Real_Sequence is 
     sequence of REAL;
end;

reserve seq,seq1,seq2,seq3,seq9,seq19 for Real_Sequence;

theorem 
  f is Real_Sequence iff (dom f=NAT & for x st x in NAT holds f.x is real);

theorem 
  f is Real_Sequence iff (dom f=NAT & for n holds f.n is real);

definition
  let f be real-valued Function, x be set;
  redefine func f.x -> Real;
end;

registration
  cluster non-zero for PartFunc of NAT,REAL;
end;

theorem 
  for f being non-zero PartFunc of NAT,REAL holds rng f c= REAL \ {0};

theorem 
  seq is non-zero iff for x st x in NAT holds seq.x<>0;

theorem 
  seq is non-zero iff for n holds seq.n<>0;

theorem 
  for r ex seq st rng seq={r};

scheme 

  ExRealSeq{F(set)->real number}: ex seq st for n holds seq.n=F(n);





scheme 

  PartFuncExD9{D,C()->non empty set, P[set,set]}: ex f being PartFunc of D(),C
() st (for d be Element of D() holds d in dom f iff (ex c be Element of C() st
  P[d,c])) & for d be Element of D() st d in dom f holds P[d,f.d];

scheme 

  LambdaPFD9{D,C()->non empty set, F(set)->Element of C(), P[set]}: ex f being
  PartFunc of D(),C() st (for d be Element of D() holds d in dom f iff P[d]) &
  for d be Element of D() st d in dom f holds f.d = F(d);

scheme 

  UnPartFuncD9{C,D,X() -> set, F(set)->set}: for f,g being PartFunc of C(),D()
st (dom f=X() & for c be Element of C() st c in dom f holds f.c = F(c)) & (dom
  g=X() & for c be Element of C() st c in dom g holds g.c = F(c)) holds f = g;

theorem 
  seq = seq1 + seq2 iff for n holds seq.n =seq1.n + seq2.n;

theorem 
  seq = seq1 (#) seq2 iff for n holds seq.n =seq1.n * seq2.n;

theorem 
  seq1 = r(#)seq2 iff for n holds seq1.n=r*seq2.n;

theorem 
  seq1 = -seq2 iff for n holds seq1.n= -seq2.n;

theorem 
  seq1 - seq2 = seq1 +- seq2;

theorem 
  seq1 = abs seq iff for n holds seq1.n= abs(seq.n);

theorem 
  (seq1 + seq2) + seq3 = seq1 + (seq2 + seq3);

theorem 
  (seq1 (#) seq2) (#) seq3 = seq1 (#) (seq2 (#) seq3);

theorem 
  (seq1 + seq2) (#) seq3 = seq1 (#) seq3 + seq2 (#) seq3;

theorem 
  seq3 (#) (seq1 + seq2) = seq3 (#) seq1 + seq3 (#) seq2;

theorem 
  -seq = (-1) (#) seq;

theorem 
  r(#)(seq1(#)seq2)=r(#)seq1(#)seq2;

theorem 
  r (#) (seq1 (#) seq2) = seq1 (#) (r (#) seq2);

theorem 
  (seq1 - seq2) (#) seq3 = seq1 (#) seq3 - seq2 (#) seq3;

theorem 
  seq3(#)seq1-seq3(#)seq2=seq3(#)(seq1-seq2);

theorem 
  r(#)(seq1+seq2)=r(#)seq1+r(#)seq2;

theorem 
  (r*p)(#)seq=r(#)(p(#)seq);

theorem 
  r(#)(seq1-seq2)=r(#)seq1-r(#)seq2;

theorem 
  r(#)(seq1/"seq)=(r(#)seq1)/"seq;

theorem 
  seq1-(seq2+seq3)=seq1-seq2-seq3;

theorem 
  1(#)seq=seq;

canceled;

theorem 
  seq1 - (-seq2) = seq1 + seq2;

theorem 
  seq1-(seq2-seq3)=seq1-seq2+seq3;

theorem 
  seq1+(seq2-seq3)=seq1+seq2-seq3;

theorem 
  (-seq1)(#)seq2=-(seq1(#)seq2) & seq1(#)(-seq2)=-(seq1(#)seq2);

theorem 
  seq is non-zero implies seq" is non-zero;

canceled;

theorem 
  seq is non-zero & seq1 is non-zero iff seq(#)seq1 is non-zero;

theorem 
  seq"(#)seq1"=(seq(#)seq1)";

theorem 
  seq is non-zero implies (seq1/"seq)(#)seq=seq1;

theorem 
  (seq9/"seq)(#)(seq19/"seq1)=(seq9(#)seq19)/"(seq(#)seq1);

theorem 
  seq is non-zero & seq1 is non-zero implies seq/"seq1 is non-zero;

theorem 
  (seq/"seq1)"=seq1/"seq;

theorem 
  seq2(#)(seq1/"seq)=(seq2(#)seq1)/"seq;

theorem 
  seq2/"(seq/"seq1)=(seq2(#)seq1)/"seq;

theorem 
  seq1 is non-zero implies seq2/"seq=(seq2(#)seq1)/"(seq(#)seq1);

theorem 
  r<>0 & seq is non-zero implies r(#)seq is non-zero;

theorem 
  seq is non-zero implies -seq is non-zero;

theorem 
  (r(#)seq)"=r"(#)seq";

theorem 
  (-seq)" = (-1)(#)seq";

theorem 
  -seq1/"seq=(-seq1)/"seq & seq1/"(-seq)=-seq1/"seq;

theorem 
  seq1/"seq + seq19/"seq = (seq1 + seq19) /" seq & seq1/"seq - seq19/"
  seq = (seq1 - seq19) /" seq;

theorem 
  seq is non-zero & seq9 is non-zero implies seq1/"seq + seq19/"seq9=(
seq1(#)seq9+seq19(#)seq)/"(seq(#)seq9) & seq1/"seq - seq19/"seq9=(seq1(#)seq9-
  seq19(#)seq)/"(seq(#)seq9);

theorem 
  (seq19/"seq)/"(seq9/"seq1)=(seq19(#)seq1)/"(seq(#)seq9);

theorem 
  abs(seq(#)seq9)=abs(seq)(#)abs(seq9);

theorem 
  seq is non-zero implies abs(seq) is non-zero;

theorem 
  abs(seq)"=abs(seq");

theorem 
  abs(seq9/"seq)=abs(seq9)/"abs(seq);

theorem 
  abs(r(#)seq)=abs(r)(#)abs(seq);














begin

reserve f for Function;
reserve n,k,n1 for Element of NAT;
reserve r,p for Element of COMPLEX;
reserve x,y for set;

definition
  mode Complex_Sequence is sequence of COMPLEX;
end;

reserve seq,seq1,seq2,seq3,seq9,seq19 for Complex_Sequence;

theorem 
  f is Complex_Sequence iff (dom f=NAT & for x st x in NAT holds f.
  x is Element of COMPLEX);

theorem 
  f is Complex_Sequence iff (dom f=NAT & for n holds f.n is Element of COMPLEX)
;

scheme 

  ExComplexSeq{F(set) -> complex number}: ex seq st for n holds seq.n=F(n);

notation
  let f be complex-valued Relation;
  synonym f is non-zero for f is non-empty;
end;

registration
  cluster non-zero for Complex_Sequence;
end;

theorem 
  seq is non-zero iff for x st x in NAT holds seq.x<>0c;

theorem 
  seq is non-zero iff for n holds seq.n<>0c;

theorem 
  for IT being non-zero Complex_Sequence holds rng IT c= COMPLEX \ {0c};

theorem 
  for r ex seq st rng seq={r};

theorem 
  (seq1+seq2)+seq3=seq1+(seq2+seq3);

theorem 
  (seq1(#)seq2)(#)seq3=seq1(#)(seq2(#)seq3);

theorem 
  (seq1+seq2)(#)seq3=seq1(#)seq3+seq2(#)seq3;

theorem 
  seq3(#)(seq1+seq2)=seq3(#)seq1+seq3(#)seq2;

theorem 
  -seq=(-1r)(#)seq;

theorem 
  r(#)(seq1(#)seq2)=r(#)seq1(#)seq2;

theorem 
  r(#)(seq1(#)seq2)=seq1(#)(r(#)seq2);

theorem 
  (seq1-seq2)(#)seq3=seq1(#)seq3-seq2(#)seq3;

theorem 
  seq3(#)seq1-seq3(#)seq2=seq3(#)(seq1-seq2);

theorem 
  r(#)(seq1+seq2)=r(#)seq1+r(#)seq2;

theorem 
  (r*p)(#)seq=r(#)(p(#)seq);

theorem 
  r(#)(seq1-seq2)=r(#)seq1-r(#)seq2;

theorem 
  r(#)(seq1/"seq)=(r(#)seq1)/"seq;

theorem 
  seq1-(seq2+seq3)=seq1-seq2-seq3;

theorem 
  1r(#)seq=seq;

theorem 
  --seq = seq;

theorem 
  seq1 - (-seq2) = seq1 + seq2;

theorem 
  seq1 - (seq2 - seq3) = seq1 - seq2 + seq3;

theorem 
  seq1 + (seq2 - seq3) = seq1 + seq2 - seq3;

theorem 
  (-seq1)(#)seq2=-(seq1(#)seq2) & seq1(#)(-seq2)=-(seq1(#)seq2);

theorem 
  seq is non-zero implies seq" is non-zero;

canceled;

theorem 
  seq is non-zero & seq1 is non-zero iff seq(#)seq1 is non-zero;

theorem 
  seq"(#)seq1"=(seq(#)seq1)";

theorem 
  seq is non-zero implies (seq1/"seq)(#)seq=seq1;

theorem 
  (seq9/"seq)(#)(seq19/"seq1)=(seq9(#)seq19)/"(seq(#)seq1);

theorem 
  seq is non-zero & seq1 is non-zero implies seq/"seq1 is non-zero;

theorem 
  (seq/"seq1)"=seq1/"seq;

theorem 
  seq2 (#) (seq1 /" seq) = (seq2 (#) seq1) /" seq;

theorem 
  seq2/"(seq/"seq1)=(seq2(#)seq1)/"seq;

theorem 
  seq1 is non-zero implies seq2/"seq=(seq2(#)seq1)/"(seq(#)seq1);

theorem 
  r<>0c & seq is non-zero implies r(#)seq is non-zero;

theorem 
  seq is non-zero implies -seq is non-zero;

theorem 
  (r(#)seq)"=r"(#)seq";

theorem 
  seq is non-zero implies (-seq)"=(-1r)(#)seq";

theorem 
  seq is non-zero implies -seq1/"seq=(-seq1)/"seq & seq1/"(-seq)=-seq1/" seq;

theorem 
  seq1/"seq + seq19/"seq = (seq1+seq19) /" seq & seq1/"seq - seq19/"seq
  = (seq1-seq19) /" seq;

theorem 
  seq is non-zero & seq9 is non-zero implies seq1/"seq + seq19/"seq9=(
seq1(#)seq9+seq19(#)seq)/"(seq(#)seq9) & seq1/"seq - seq19/"seq9=(seq1(#)seq9-
  seq19(#)seq)/"(seq(#)seq9);

theorem 
  (seq19/"seq)/"(seq9/"seq1)=(seq19(#)seq1)/"(seq(#)seq9);

theorem 
  |.seq(#)seq9.|=|.seq.|(#)|.seq9.|;

theorem 
  seq is non-zero implies |.seq.| is non-zero;

theorem 
  |. seq .| " = |. seq" .|;

theorem 
  |.seq9/"seq.|=|.seq9.|/"|.seq.|;

theorem 
  |.r(#)seq.|=|.r.|(#)|.seq.|;














begin

definition
  func FALSE equals

  0;
  func TRUE equals

  1;
end;

definition
  let p be set;
  attr p is boolean means


  p = FALSE or p = TRUE;
end;

registration
  cluster FALSE -> boolean;
  cluster TRUE -> boolean;
  cluster boolean for number;
  cluster boolean -> natural for number;
end;

reserve p,q,r,s for boolean number;

definition
  let p;
  func 'not' p -> boolean number equals

  1 - p;
  involutiveness;
  let q;
  func p '&' q equals

  p*q;
  commutativity;
  idempotence;
end;

registration
  let p,q;
  cluster p '&' q -> boolean;
end;

definition
  let p,q;
  func p 'or' q equals

  'not' ('not' p '&' 'not' q);
  commutativity;
  idempotence;
end;

definition
  let p,q;
  func p => q equals

  'not' p 'or' q;
end;

registration
  let p,q;
  cluster p 'or' q -> boolean;
  cluster p => q -> boolean;
end;

definition
  let p,q;
  func p <=> q equals

  (p => q) '&' (q => p);
  commutativity;
end;

registration
  let p,q;
  cluster p <=> q -> boolean;
end;

definition
  let p,q;
  func p 'nand' q equals

  'not'(p '&' q);
  commutativity;
  func p 'nor' q equals

  'not'(p 'or' q);
  commutativity;
  func p 'xor' q equals

  'not'(p <=> q);
  commutativity;
  func p '\' q equals

  p '&' 'not' q;
end;

registration
  let p,q;
  cluster p 'nand' q -> boolean;
  cluster p 'nor' q -> boolean;
  cluster p 'xor' q -> boolean;
  cluster p '\' q -> boolean;
end;

begin

theorem 
  p '&' p = p;

theorem 
  p '&' (p '&' q) = p '&' q;

theorem 
  p 'or' p = p;

theorem 
  p 'or' (p 'or' q) = p 'or' q;

theorem 
  p 'or' p '&' q = p;

theorem 
  p '&' (p 'or' q) = p;

theorem 
  p '&' (p 'or' q) = p 'or' (p '&' q);

theorem 
  p '&' (q 'or' r) = p '&' q 'or' p '&' r;

theorem 
  p 'or' q '&' r = (p 'or' q) '&' (p 'or' r);

theorem 
  p '&' q 'or' q '&' r 'or' r '&' p = (p 'or' q) '&' (q 'or' r) '&' (r 'or' p);

theorem 
  p '&' ('not' p 'or' q) = p '&' q;

theorem 
  p 'or' 'not' p '&' q = p 'or' q;

theorem 
  p => (p => q) = p => q;

theorem 
  p '&' (p => q) = p '&' q;

theorem 
  p => (p '&' q) = p => q;

theorem 
  p '&' 'not' (p => q) = p '&' 'not' q;

theorem 
  'not' p 'or' (p => q) = p => q;

theorem 
  'not' p '&' (p => q) = 'not' p 'or' 'not' p '&' q;

theorem 
  p <=> q <=> r = p <=> (q <=> r);

theorem 
  p '&' (p <=> q) = p '&' q;

theorem 
  'not' p '&' (p <=> q) ='not' p '&' 'not' q;

theorem 
  p '&' (q <=> r) = p '&' ('not' q 'or' r) '&' ('not' r 'or' q);

theorem 
  p 'or' (q <=> r) = (p 'or' 'not' q 'or' r) '&' (p 'or' 'not' r 'or' q);

theorem 
  'not' p '&' (p <=> q) =('not' p '&' 'not' q) '&' ('not' p 'or' q);

theorem 
  'not' p '&' (q <=> r) = 'not' p '&' ('not' q 'or' r) '&' ('not' r 'or' q);

theorem 
  p => (p <=> q) = p => q;

theorem 
  p => (p <=> q) = p => (p => q);

theorem 
  p 'or' (p <=> q) = q => p;

theorem 
  'not' p 'or' (p <=> q) = p => q;

theorem 
  p => (q <=> r) = ('not' p 'or' 'not' q 'or' r) '&' ('not' p 'or' q
  'or' 'not' r);

theorem 
  p 'nor' p = 'not' p;

theorem 
  p 'nor' (p '&' q) = 'not' p;

theorem 
  p 'nor' (p 'or' q) = 'not' p '&' 'not' q;

theorem 
  p 'nor' (p 'nor' q) = 'not' p '&' q;

theorem 
  p 'nor' (p '&' q) = 'not' p;

theorem 
  p 'nor' (p 'or' q) = p 'nor' q;

theorem 
  'not' p '&' (p 'nor' q) = p 'nor' q;

theorem 
  p 'or' (q 'nor' r) = (p 'or' 'not' q) '&' (p 'or' 'not' r);

theorem 
  p 'nor' (q 'nor' r) = 'not' p '&' q 'or' 'not' p '&' r;

theorem 
  p 'nor' (q '&' r) = 'not' (p 'or' q) 'or' 'not' (p 'or' r);

theorem 
  p '&' (q 'nor' r) = p '&' 'not' q '&' 'not' r;

theorem 
  p => (p 'nor' q) = 'not' p;

theorem 
  p => (q 'nor' r) = (p => 'not' q) '&' (p => 'not' r);

theorem 
  p 'or' (p 'nor' q) = q => p;

theorem 
  p 'or' (q 'nor' r) = (q => p) '&' (r => p);

theorem 
  p => (q 'nor' r) = ('not' p 'or' 'not' q) '&' ('not' p 'or' 'not' r);

theorem 
  p 'nor' (p <=> q) = 'not' p '&' q;

theorem 
  'not' p '&' (p <=> q) = p 'nor' q;

theorem 
  p 'nor' (q <=> r) = 'not' ((p 'or' 'not' q 'or' r) '&' (p 'or' 'not' r
  'or' q));

theorem 
  p <=> q = p '&' q 'or' (p 'nor' q);

theorem 
  p 'nand' p = 'not' p;

theorem 
  p '&' (p 'nand' q) = p '&' 'not' q;

theorem 
  p 'nand' (p '&' q) = 'not' (p '&' q);

theorem 
  p 'nand' (q 'nand' r) = ('not' p 'or' q) '&' ('not' p 'or' r);

theorem 
  p 'nand' (q 'or' r) = 'not' (p '&' q) '&' 'not' (p '&' r);

theorem 
  p => (p 'nand' q) = p 'nand' q;

theorem 
  p 'nand' (p 'nand' q) = p => q;

theorem 
  p 'nand' (q 'nand' r) = (p => q) '&' (p => r);

theorem 
  p 'nand' (p => q) = 'not' (p '&' q);

theorem 
  p 'nand' (q => r) = (p => q) '&' (p => 'not' r);

theorem 
  'not' p 'or' (p 'nand' q) = p 'nand' q;

theorem 
  p 'nand' (q => r) = ('not' p 'or' q) '&' ('not' p 'or' 'not' r);

theorem 
  'not' p '&' (p 'nand' q) = 'not' p 'or' 'not' p '&' 'not' q;

theorem 
  p '&' (q 'nand' r) = p '&' 'not' q 'or' p '&' 'not' r;

theorem 
  p 'nand' (p <=> q) = 'not' (p '&' q);



theorem 
  p 'nand' (q <=> r) = 'not' (p '&' ('not' q 'or' r) '&' ('not' r 'or' q ));

theorem 
  p 'nand' (q 'nor' r) = 'not' p 'or' q 'or' r;

theorem 
  p '\' q '\' q = p '\' q;

theorem 
  p '&' (p '\' q) = p '\' q;

theorem 
  p 'nor' (p <=> q) = q '\' p;

theorem 
  p 'nor' (p 'nor' q) = q '\' p;

theorem 
  p 'xor' (p 'xor' q) = q;

theorem 
  (p 'xor' q) 'xor' r = p 'xor' (q 'xor' r);

theorem 
  'not' (p 'xor' q) = 'not' p 'xor' q;

theorem 
  p '&' (q 'xor' r) = (p '&' q) 'xor' (p '&' r);

theorem 
  p '&' (p 'xor' q) = p '&' 'not' q;

theorem 
  p 'xor' (p '&' q) = p '&' 'not' q;

theorem 
  'not' p '&' (p 'xor' q) ='not' p '&' q;

theorem 
  p 'or' (p 'xor' q) = p 'or' q;

theorem 
  p 'or' ('not' p 'xor' q) =p 'or' 'not' q;



theorem 
  p 'xor' ('not' p '&' q) = p 'or' q;

theorem 
  p 'xor' (p 'or' q) = 'not' p '&' q;

theorem 
  p 'xor' (q '&' r) = (p 'or' (q '&' r)) '&' ('not' p 'or' 'not' (q '&' r));

theorem 
  'not' p 'xor' (p => q) = p '&' q;

theorem 
  p => (p 'xor' q) = 'not' p 'or' 'not' q;

theorem 
  p 'xor' (p => q) = 'not' p 'or' 'not' q;

theorem 
  'not' p 'xor' (q => p) = (p '&' (p 'or' 'not' q)) 'or' ('not' p '&' q);

theorem 
  p 'xor' (p <=> q) = 'not' q;

theorem 
  'not' p 'xor' (p <=> q) = q;

theorem 
  p 'nor' (p 'xor' q) = 'not' p '&' 'not' q;

theorem 
  p 'nor' (p 'xor' q) = p 'nor' q;

theorem 
  p 'xor' (p 'nor' q) = q => p;

theorem 
  p 'nand' (p 'xor' q) = p => q;

theorem 
  p 'xor' (p 'nand' q) = p => q;

theorem 
  p 'xor' (p => q) = p 'nand' q;

theorem 
  p 'nand' (q 'xor' r) = (p '&' q) <=> (p '&' r);

theorem 
  p 'xor' (p '&' q) = p '\' q;

theorem 
  p '&' (p 'xor' q) = p '\' q;

theorem 
  'not' p '&' (p 'xor' q) = q '\' p;

theorem 
  p 'xor' (p 'or' q) = q '\' p;

begin

theorem 
  p '&' q = TRUE implies p = TRUE & q = TRUE;

theorem 
  'not'(p '&' 'not' p) = TRUE;

theorem 
  p => p = TRUE;

theorem 
  p => (q => p) = TRUE;

theorem 
  p => ((p => q) => q) = TRUE;

theorem 
  (p => q) => ((q => r) => (p => r)) = TRUE;

theorem 
  (p => q) => ((r => p) => (r => q)) = TRUE;

theorem 
  (p => (p => q)) => (p => q) = TRUE;

theorem 
  (p => (q => r)) => ((p => q) => (p => r)) = TRUE;

theorem 
  (p => (q => r)) => (q => (p => r)) = TRUE;

theorem 
  ((p => q) => r) => (q => r) = TRUE;

theorem 
  (TRUE => p) => p = TRUE;

theorem 
  p => q = TRUE implies (q => r) => (p => r) = TRUE;

theorem 
  p => (p => q) = TRUE implies p => q = TRUE;

theorem 
  p => (q => r) = TRUE implies (p => q) => (p =>r) = TRUE;

theorem 
  p => q = TRUE & q => p = TRUE implies p = q;

theorem 
  p => q = TRUE & q => r = TRUE implies p => r = TRUE;

theorem 
  ('not' p => p) => p = TRUE;

theorem 
  'not' p = TRUE implies p => q = TRUE;

theorem 
  p => q = TRUE & p => 'not' q = TRUE implies 'not' p = TRUE;

theorem 
  (p => q) => ('not' (q '&' r) => 'not' (p '&' r)) = TRUE;

theorem 
  p 'or' (p => q) = TRUE;

theorem 
  p => (p 'or' q) = TRUE;

theorem 
  'not' q 'or' (q => p => p) = TRUE;

theorem 
  p <=> p = TRUE;

theorem 
  p <=> q <=> r <=> p <=> (q <=> r) = TRUE;

theorem 
  p <=> q = TRUE & q <=> r = TRUE implies p <=> r = TRUE;

theorem 
  p <=> q = TRUE & r <=> s = TRUE implies (p <=> r) <=> (q <=> s) = TRUE;

theorem 
  'not' (p <=> 'not' p) = TRUE;

theorem 
  p <=> q = TRUE & r <=> s = TRUE implies (p '&' r) <=> (q '&' s) = TRUE;

theorem 
  p <=> q = TRUE & r <=> s = TRUE implies (p 'or' r) <=> (q 'or' s) = TRUE;

theorem 
  p <=> q = TRUE iff p => q = TRUE & q => p = TRUE;

theorem 
  p <=> q = TRUE & r <=> s = TRUE implies (p => r) <=> (q => s) = TRUE;

theorem 
  'not' (p 'nor' 'not' p) = TRUE;

theorem 
  p 'nand' 'not' p = TRUE;

theorem 
  p 'or' (p 'nand' q) = TRUE;

theorem 
  p 'nand' (p 'nor' q) = TRUE;

theorem 
  p '&' 'not' p = FALSE;

theorem 
  p '&' p = FALSE implies p = FALSE;

theorem 
  p '&' q = FALSE implies p = FALSE or q = FALSE;

theorem 
  'not' (p => p) = FALSE;

theorem 
  p <=> 'not' p = FALSE;

theorem 
  'not'(p <=> p) = FALSE;

theorem 
  p '&' (p 'nor' q) = FALSE;

theorem 
  p 'nor' (p => q) = FALSE;

theorem 
  p 'nor' (p 'nand' q) = FALSE;

theorem 
  p 'xor' p = FALSE;














begin

reserve X,Y,Z,x,y,z for set;
reserve i,j for Element of NAT;
reserve A,B,C for Subset of X;
reserve R,R1,R2 for Relation of X;
reserve AX for Subset of [:X,X:];
reserve SFXX for Subset-Family of [:X,X:];



definition
  let X;
  func nabla X -> Relation of X equals

  [:X,X:];
end;

registration
  let X;
  cluster nabla X -> total reflexive;
end;

definition
  let X;
  let R1,R2;
  redefine func R1 /\ R2 -> Relation of X;
  redefine func R1 \/ R2 -> Relation of X;
end;

theorem 
  nabla X \/ R1 = nabla X;

theorem 
  id X is_reflexive_in X & id X is_symmetric_in X & id X is_transitive_in X;

definition
  let X;
  mode Tolerance of X is total reflexive symmetric Relation of X;
  mode Equivalence_Relation of X is total symmetric transitive Relation of X;
end;

theorem 
  id X is Equivalence_Relation of X;

theorem 
  nabla X is Equivalence_Relation of X;

registration
  let X;
  cluster nabla X -> total symmetric transitive;
end;

reserve EqR,EqR1,EqR2,EqR3 for Equivalence_Relation of X;

theorem 
  for R being total reflexive Relation of X holds x in X implies [ x,x] in R;

theorem 
  for R being total symmetric Relation of X holds [x,y] in R implies [y,x] in R
;

theorem 
  for R being total transitive Relation of X holds [x,y] in R & [y
  ,z] in R implies [x,z] in R;

theorem 
  for R being total reflexive Relation of X holds (ex x being set st x
  in X) implies R <> {};

theorem 
  R is Equivalence_Relation of X iff R is reflexive symmetric
  transitive & field R = X;

definition
  let X;
  let EqR1,EqR2;
  redefine func EqR1 /\ EqR2 -> Equivalence_Relation of X;
end;

theorem 
  id X /\ EqR = id X;

theorem 
  for SFXX st (SFXX <> {} & for Y st Y in SFXX holds Y is
  Equivalence_Relation of X) holds meet SFXX is Equivalence_Relation of X;

theorem 
  for R holds ex EqR st R c= EqR & for EqR2 st R c= EqR2 holds EqR c= EqR2;

definition
  let X;
  let EqR1,EqR2;

  func EqR1 "\/" EqR2 -> Equivalence_Relation of X means


  EqR1 \/ EqR2 c= it & for EqR st EqR1 \/ EqR2 c= EqR holds it c= EqR;
  commutativity;
  idempotence;
end;

theorem 
  (EqR1 "\/" EqR2) "\/" EqR3 = EqR1 "\/" (EqR2 "\/" EqR3);

theorem 
  EqR "\/" EqR = EqR;

theorem 
  EqR1 "\/" EqR2 = EqR2 "\/" EqR1;

theorem 
  EqR1 /\ (EqR1 "\/" EqR2) = EqR1;

theorem 
  EqR1 "\/" (EqR1 /\ EqR2) = EqR1;

scheme 

  ExEqRel {X() -> set,P[set,set]}: ex EqR being Equivalence_Relation of X() st
  for x,y holds [x,y] in EqR iff x in X() & y in X() & P[x,y]
provided
 for x st x in X() holds P[x,x] and
 for x,y st P[x,y] holds P[y,x] and
 for x,y,z st P[x,y] & P[y,z] holds P[x,z];



notation
  let R be Relation, x be set;
  synonym Class(R,x) for Im(R,x);
end;

definition
  let X, Y be set, R be Relation of X, Y, x be set;

  redefine func Class(R,x) -> Subset of Y;
end;

theorem 
  for R being Relation holds y in Class (R,x) iff [x,y] in R;

theorem 
  for R being total symmetric Relation of X holds y in Class (R,x)
  iff [y,x] in R;

theorem 
  for R being Tolerance of X holds for x st x in X holds x in Class (R,x);

theorem 
  for R being Tolerance of X holds for x st x in X holds ex y st x in
  Class(R,y);

theorem 
  for R being transitive Tolerance of X holds y in Class(R,x) & z in
  Class(R,x) implies [y,z] in R;

theorem 
  for x st x in X holds y in Class(EqR,x) iff Class(EqR,x) = Class (EqR,y);

theorem 
  for x,y st y in X holds Class(EqR,x) = Class(EqR,y) or Class(EqR
  ,x) misses Class(EqR,y);

theorem 
  for x st x in X holds Class(id X,x) = {x};

theorem 
  for x st x in X holds Class(nabla X,x) = X;

theorem 
  (ex x st Class(EqR,x) = X) implies EqR = nabla X;

theorem 
  x in X implies ([x,y] in EqR1 "\/" EqR2 iff ex f being FinSequence st
1 <= len f & x = f.1 & y = f.(len f) & for i st 1 <= i & i < len f holds [f.i,f
  .(i+1)] in EqR1 \/ EqR2);

theorem 
  for E being Equivalence_Relation of X st E = EqR1 \/ EqR2 holds
for x st x in X holds Class(E,x) = Class(EqR1,x) or Class(E,x) = Class(EqR2,x);

theorem 
  EqR1 \/ EqR2 = nabla X implies EqR1 = nabla X or EqR2 = nabla X;

definition
  let X;
  let EqR;
  func Class EqR -> Subset-Family of X means


  A in it iff ex x st x in X & A = Class(EqR,x);
end;

theorem 
  X = {} implies Class EqR = {};

definition
  let X;
  mode a_partition of X -> Subset-Family of X means


    union it = X & for
    A st A in it holds A<>{} & for B st B in it holds A = B or A misses B;
end;

theorem 
  for P being a_partition of {} holds P = {};

theorem 
  Class EqR is a_partition of X;

theorem 
  for P being a_partition of X holds ex EqR st P = Class EqR;

theorem 
  for x st x in X holds [x,y] in EqR iff Class(EqR,x) = Class(EqR,y);

theorem 
  x in Class EqR implies ex y being Element of X st x = Class(EqR,y);

begin 


registration
  let X be non empty set;
  cluster -> non empty for a_partition of X;
end;



registration
  let X be set;
  cluster -> with_non-empty_elements for a_partition of X;
end;

definition
  let X be set, R be Equivalence_Relation of X;
  redefine func Class R -> a_partition of X;
end;



registration
  let I be non empty set, R be Equivalence_Relation of I;
  cluster Class R -> non empty;
end;

registration
  let I be non empty set, R be Equivalence_Relation of I;
  cluster Class R -> with_non-empty_elements;
end;

notation
  let I be non empty set, R be Equivalence_Relation of I;
  let x be Element of I;
  synonym EqClass(R,x) for Class(R,x);
end;

definition
  let I be non empty set, R be Equivalence_Relation of I;
  let x be Element of I;
  redefine func EqClass(R,x) -> Element of Class R;
end;

definition
  let X be set;
  func SmallestPartition X -> a_partition of X equals

  Class id X;
end;

theorem 
  for X being non empty set holds SmallestPartition X = {{x} where x is
  Element of X: not contradiction};




reserve X for non empty set,
  x for Element of X;

definition
  let X be non empty set,x be Element of X,S1 be a_partition of X;
  func EqClass(x,S1) -> Subset of X means


  x in it & it in S1;
end;

theorem 
  for S1,S2 being a_partition of X st (for x being Element of X
  holds EqClass(x,S1) = EqClass(x,S2)) holds S1=S2;

theorem 
  for X being non empty set holds {X} is a_partition of X;

definition
  let X be set;
  mode Family-Class of X is Subset-Family of bool X;
end;

definition

  let X be set;
  let F be Family-Class of X;
  attr F is partition-membered means


  for S being set st S in F holds S is a_partition of X;
end;

registration
  let X be set;
  cluster partition-membered for Family-Class of X;
end;

definition
  let X be set;
  mode Part-Family of X is partition-membered Family-Class of X;
end;

reserve F for Part-Family of X;

registration
  let X be non empty set;
  cluster non empty for a_partition of X;
end;

theorem 
  for X being set, p being a_partition of X holds {p} is Part-Family of X;

registration
  let X be set;
  cluster non empty for Part-Family of X;
end;

theorem 
  for S1 being a_partition of X, x,y being Element of X holds
  EqClass(x,S1) meets EqClass(y,S1) implies EqClass(x,S1) = EqClass(y,S1);

theorem 
  for A being set,X being non empty set,S being a_partition of X holds A
  in S implies ex x being Element of X st A = EqClass(x,S);

definition
  let X be non empty set,F be non empty Part-Family of X;
  func Intersection F -> non empty a_partition of X means

  for x being Element
of X holds EqClass(x,it) = meet{EqClass(x,S) where S is a_partition of X : S in
  F};
end;

theorem 
  for X being non empty set, S being a_partition of X, A being
  Subset of S holds (union S) \ (union A) = union (S \ A);

theorem 
  for X being non empty set,A being Subset of X, S being a_partition of
  X holds A in S implies union(S \ {A}) = X \ A;



theorem 
  {} is a_partition of {};

begin 

reserve e,u,v,X,Y,X1 for set;

theorem 
  for F being Function st X c= F"X1 holds F.:X c= X1;

theorem 
  e c= [:X,Y:] implies (.:pr1(X,Y)).e = pr1(X,Y).:e;

theorem 
  e c= [:X,Y:] implies (.:pr2(X,Y)).e = pr2(X,Y).:e;

theorem 
  for X1 being Subset of X, Y1 being Subset of Y st [:X1,Y1:] <>
  {} holds pr1(X,Y).:[:X1,Y1:] = X1 & pr2(X,Y).:[:X1,Y1:] = Y1;

theorem 
  for X1 being Subset of X, Y1 being Subset of Y st [:X1,Y1:] <>
  {} holds .:pr1(X,Y). [:X1,Y1:] = X1 & .:pr2(X,Y). [:X1,Y1:] = Y1;

theorem 
  for A being Subset of [:X,Y:], H being Subset-Family of [:X,Y:]
st for e st e in H holds e c= A & ex X1 being Subset of X, Y1 being Subset of Y
  st e =[:X1,Y1:] holds [:union(.:pr1(X,Y).:H), meet(.:pr2(X,Y).:H):] c= A;

theorem 
  for A being Subset of [:X,Y:], H being Subset-Family of [:X,Y:] st for
e st e in H holds e c= A & ex X1 being Subset of X, Y1 being Subset of Y st e =
  [:X1,Y1:] holds [:meet(.:pr1(X,Y).:H), union(.:pr2(X,Y).:H):] c= A;

theorem 
  for X being set, Y being non empty set, f being Function of X,Y
  for H being Subset-Family of X holds union(.:f.:H) = f.: union H;

reserve X,Y,Z for non empty set;

theorem 
  for X being set, a being Subset-Family of X holds union union a
  = union { union A where A is Subset of X: A in a };

theorem 
  for X being set for D being Subset-Family of X st union D = X
for A being Subset of D, B being Subset of X st B = union A holds B` c= union A
  `;

theorem 
  for F being Function of X,Y, G being Function of X,Z st for x,x9
being Element of X st F.x=F.x9 holds G.x=G.x9 ex H being Function of Y,Z st H*F
  =G;

theorem 
  for X,Y,Z for y being Element of Y, F being (Function of X,Y), G
  being Function of Y,Z holds F"{y} c= (G*F)"{G.y};

theorem 
  for F being Function of X,Y, x being Element of X, z being
  Element of Z holds [:F,id Z:].(x,z) = [F.x,z];

theorem 
  for F being Function of X,Y, A being Subset of X, B being Subset
  of Z holds [:F,id Z:].:[:A,B:] = [:F.:A,B:];

theorem 
  for F being Function of X,Y, y being Element of Y, z being
  Element of Z holds [:F,id Z:]"{[y,z]} = [:F"{y},{z}:];

theorem 
  for D being Subset-Family of X, A being Subset of D holds union
  A is Subset of X;

theorem 
  for X being set, D being a_partition of X, A,B being Subset of D
  holds union(A /\ B) = union A /\ union B;

theorem 
  for D being a_partition of X, A being Subset of D, B being
  Subset of X st B = union A holds B` = union A`;

theorem 
  for E being Equivalence_Relation of X holds Class(E) is non empty;

registration
  let X be non empty set;
  cluster non empty for a_partition of X;
end;

definition
  let X;
  let D be non empty a_partition of X;
  func proj D -> Function of X, D means


  for p being Element of X holds p in it.p;
end;

theorem 
  for D being non empty a_partition of X, p being Element of X, A
  being Element of D st p in A holds A = (proj D).p;

theorem 
  for D being non empty a_partition of X, p being Element of D
  holds p = proj D " {p};

theorem 
  for D being non empty a_partition of X, A being Subset of D
  holds (proj D)"A = union A;

theorem 
  for D being non empty a_partition of X, W being Element of D ex
  W9 being Element of X st proj(D).W9=W;

theorem 
  for D being non empty a_partition of X, W being Subset of X st
for B being Subset of X st B in D & B meets W holds B c= W holds W = proj D " (
  proj D .: W);

theorem 
  for X being set, P being a_partition of X, x, a, b being set st
    x in a & a in P & x in b & b in P holds a = b;















begin 

reserve n,n1,n2,m for Element of NAT;
reserve r,g1,g2,g,g9 for Element of COMPLEX;
reserve R,R2 for Real;
reserve s,s9,s1 for Complex_Sequence;

theorem 
  g<>0c & r<>0c implies |.g"-r".|=|.g-r.|/(|.g.|*|.r.|);

theorem 
  for n ex r being Real st 0<r & for m st m<=n holds |.s.m.|<r;

begin 

definition
  let f be complex-valued Function;
  func f*' -> complex-valued Function means


  dom it = dom f &
  for c being set st c in dom it holds it.c = (f.c)*';
 involutiveness;
end;

definition
  let C be non empty set;
  let f be Function of C,COMPLEX;
  redefine func f*' -> Function of C,COMPLEX means


  dom it = C & for n being Element of C holds it.n=(f.n)*';
end;

registration
 let C be non empty set;
 let s be complex-valued ManySortedSet of C;
 cluster s*' -> C-defined;
end;

registration
  let C be non empty set;
  let seq be complex-valued ManySortedSet of C;
  cluster seq*' -> total for C-defined Function;
end;

theorem 
  s is non-zero implies s*' is non-zero;

theorem 
  (r(#)s)*' = (r*')(#)(s*');

theorem 
  (s (#) s9)*' = (s*') (#) (s9*');

theorem 
  (s*')" = (s")*';

theorem 
  (s9/"s)*' = (s9*') /" (s*');

begin 

definition
  let f be complex-valued Function;
  attr f is bounded means


  ex r being real number st
   for y being set st y in dom f holds abs(f.y) <r;
end;

definition
  let s;
  redefine attr s is bounded means


  ex r being Real st for n holds |.s.n .|<r;
end;

registration
  cluster bounded for Complex_Sequence;
end;

theorem 
  s is bounded iff ex r being Real st (0<r & for n holds |.s.n.|<r);

begin




definition
  let s be complex-valued ManySortedSet of NAT;
  attr s is convergent means


  ex g st for p be Real st 0<p ex n st for m st n<=m holds |.s.m-g.|<p;
end;

definition
  let s;
  assume
 s is convergent;
  func lim s -> Element of COMPLEX means


  for p be Real st 0<p ex n st for m st n<=m holds |.s.m-it.|<p;
end;

theorem 
  (ex g st for n being Element of NAT holds s.n = g) implies s is convergent;

theorem 
  for g st for n being Element of NAT holds s.n = g holds lim s = g;

registration
  cluster convergent for Complex_Sequence;
end;

registration
  let s be convergent Complex_Sequence;
  cluster s*' -> convergent for Complex_Sequence;
end;

canceled;

theorem 
  s is convergent implies lim(s*') = (lim s)*';

begin 

registration
  let s1,s2 be convergent Complex_Sequence;
  cluster s1 + s2 -> convergent for Complex_Sequence;
end;

canceled;

theorem 
 for s,s9 being convergent Complex_Sequence
  holds lim (s + s9)=(lim s)+ (lim s9);

canceled;

theorem 
 for s,s9 being convergent Complex_Sequence
  holds lim (s + s9)*' = (lim s)*' + (lim s9)*';

registration
  let s be convergent Complex_Sequence, c be complex number;
  cluster c(#)s -> convergent for Complex_Sequence;
end;

canceled;

theorem 
  for s being convergent Complex_Sequence, r being complex number
   holds lim(r(#)s)=r*(lim s);

canceled;

theorem 
  for s being convergent Complex_Sequence
  holds lim (r(#)s)*' = (r*')*(lim s)*';

registration
  let s be convergent Complex_Sequence;
  cluster -s -> convergent for Complex_Sequence;
end;

canceled;

theorem 
  for s being convergent Complex_Sequence
  holds lim(-s)=-(lim s);

canceled;

theorem 
 for s being convergent Complex_Sequence
  holds lim (-s)*' = -(lim s)*';

registration
  let s1,s2 be convergent Complex_Sequence;
  cluster s1 - s2 -> convergent for Complex_Sequence;
end;

canceled;

theorem 
  for s,s9 being convergent Complex_Sequence
  holds lim(s - s9)=(lim s)-( lim s9);

canceled;

theorem 
  for s,s9 being convergent Complex_Sequence
  holds lim (s - s9)*' = (lim s)*' - (lim s9)*';

registration
  cluster convergent -> bounded for Complex_Sequence;
end;

registration
  cluster non bounded -> non convergent for Complex_Sequence;
end;

registration
  let s1,s2 be convergent Complex_Sequence;
  cluster s1 (#) s2 -> convergent for Complex_Sequence;
end;

canceled;

theorem 
 for s,s9 being convergent Complex_Sequence
  holds lim(s(#)s9)=(lim s)*(lim s9);

canceled;

theorem 
  for s,s9 being convergent Complex_Sequence
  holds lim (s(#)s9)*' = (lim s)*' * (lim s9)*';

theorem 
  for s being convergent Complex_Sequence st lim s <> 0c
   ex n st for m st n <=m holds |.(lim s).|/2<|.s.m.|;

theorem 
  for s being convergent Complex_Sequence st lim s <> 0c & s is non-zero
   holds s" is convergent;

theorem 
  s is convergent & (lim s)<>0c & s is non-zero implies lim s"=( lim s)";

canceled;

theorem 
  s is convergent & (lim s)<>0c & s is non-zero implies lim (s")*' = ((
  lim s)*')";

theorem 
  s9 is convergent & s is convergent & (lim s)<>0c & s is non-zero
  implies s9/"s is convergent;

theorem 
  s9 is convergent & s is convergent & (lim s)<>0c & s is non-zero
  implies lim(s9/"s)=(lim s9)/(lim s);

canceled;

theorem 
  s9 is convergent & s is convergent & (lim s)<>0c & s is non-zero
  implies lim (s9/"s)*' = ((lim s9)*')/((lim s)*');

theorem 
  s is convergent & s1 is bounded & (lim s)=0c implies s(#)s1 is convergent;

theorem 
  s is convergent & s1 is bounded & (lim s)=0c implies lim(s(#)s1) =0c;

canceled;

theorem 
  s is convergent & s1 is bounded & (lim s)=0c implies lim (s(#)s1)*' = 0c;














begin

reserve n,n1,n2,m for Element of NAT,
  r,r1,r2,p,g1,g2,g for real number,
  seq,seq9,seq1 for Real_Sequence,
  y for set;

theorem 
  -g<r & r<g iff abs(r)<g;

theorem 
  g<>0 & r<>0 implies abs(g"-r")=abs(g-r)/(abs(g)*abs(r));

definition
  let f be real-valued Function;
  attr f is bounded_above means


  ex r st for y st y in dom f holds f.y<r;
  attr f is bounded_below means


  ex r st for y st y in dom f holds r<f.y;
end;

definition
  let seq;
  redefine attr seq is bounded_above means


  ex r st for n holds seq.n<r;
  redefine attr seq is bounded_below means


  ex r st for n holds r<seq.n;
end;

registration
  cluster bounded -> bounded_above bounded_below for real-valued Function;
  cluster bounded_above bounded_below -> bounded for real-valued Function;
end;

theorem 
  seq is bounded iff ex r st (0<r & for n holds abs(seq.n)<r);

theorem 
  for n ex r st (0<r & for m st m<=n holds abs(seq.m)<r);






definition
 canceled;
  let seq;
  redefine attr seq is convergent means


  ex g st for p st 0<p ex n st for m st n<=m holds abs (seq.m-g) < p;
end;

definition
  let seq;
  assume
 seq is convergent;
  func lim seq -> real number means


  for p st 0<p ex n st for m st n<=m holds abs(seq.m-it)<p;
end;

definition
  let f be real-valued Function;
  redefine attr f is bounded means

  f is bounded_above bounded_below;
end;

definition
  let seq;
  redefine func lim seq -> Real;
end;

registration
  cluster constant -> convergent for Real_Sequence;
end;

registration
  cluster constant for Real_Sequence;
end;

theorem 
  seq is convergent & seq9 is convergent implies seq + seq9 is convergent;

registration
  let seq1,seq2 be convergent Real_Sequence;
  cluster seq1 + seq2 -> convergent for Real_Sequence;
end;

theorem 
  seq is convergent & seq9 is convergent implies
  lim (seq + seq9)=(lim seq)+(lim seq9);

theorem 
  seq is convergent implies r(#)seq is convergent;

registration
  let r be real number;
  let seq be convergent Real_Sequence;
  cluster r(#)seq -> convergent for Real_Sequence;
end;

theorem 
  seq is convergent implies lim(r(#)seq)=r*(lim seq);

theorem 
  seq is convergent implies -seq is convergent;

registration
  let seq be convergent Real_Sequence;
  cluster -seq -> convergent for Real_Sequence;
end;

theorem 
  seq is convergent implies lim(-seq) = -(lim seq);

theorem 
  seq is convergent & seq9 is convergent implies seq - seq9 is convergent;

registration
  let seq1,seq2 be convergent Real_Sequence;
  cluster seq1 - seq2 -> convergent for Real_Sequence;
end;

theorem 
  seq is convergent & seq9 is convergent implies
  lim(seq - seq9)=(lim seq)-(lim seq9);

theorem 
  seq is convergent implies seq is bounded;

registration
  cluster convergent -> bounded for Real_Sequence;
end;

theorem 
  seq is convergent & seq9 is convergent implies seq (#) seq9 is convergent;

registration
  let seq1,seq2 be convergent Real_Sequence;
  cluster seq1 (#) seq2 -> convergent for Real_Sequence;
end;

theorem 
  seq is convergent & seq9 is convergent implies
  lim(seq(#)seq9)=(lim seq)*(lim seq9);

theorem 
  seq is convergent implies (lim seq<>0 implies
  ex n st for m st n<=m holds abs(lim seq)/2<abs(seq.m));

theorem 
  seq is convergent & (for n holds 0<=seq.n) implies 0<=lim seq;

theorem 
  seq is convergent & seq9 is convergent &
  (for n holds seq.n<=(seq9.n)) implies (lim seq)<=(lim seq9);

theorem 
  seq is convergent & seq9 is convergent &
  (for n holds seq.n<=(seq1.n) & seq1.n<=seq9.n) & (lim seq)=(lim seq9)
  implies seq1 is convergent;

theorem 
  seq is convergent & seq9 is convergent &
  (for n holds seq.n<=(seq1.n) & seq1.n<=seq9.n) &
  lim seq = lim seq9 implies lim seq1 = lim seq;

theorem 
  seq is convergent & lim seq <> 0 & seq is non-zero implies seq" is convergent
;

theorem 
  seq is convergent & lim seq <> 0 & seq is non-zero
  implies lim seq"=(lim seq)";

theorem 
  seq9 is convergent & seq is convergent & lim seq <> 0
  & seq is non-zero implies seq9/"seq is convergent;

theorem 
  seq9 is convergent & seq is convergent & lim seq <> 0
  & seq is non-zero implies lim(seq9/"seq)=(lim seq9)/(lim seq);

theorem 
  seq is convergent & seq1 is bounded & lim seq=0 implies
  seq(#)seq1 is convergent;

theorem 
  seq is convergent & seq1 is bounded & lim seq=0 implies lim(seq(#)seq1)=0;



reserve g for Element of COMPLEX;

registration
  let s be convergent Complex_Sequence;
  cluster |.s.| -> convergent for Real_Sequence;
end;

reserve s,s1,s9 for Complex_Sequence;

theorem 
  s is convergent implies lim |.s.| = |.lim s.|;

theorem 
 for s,s9 being convergent Complex_Sequence
  holds lim |.(s + s9).| = |.(lim s)+(lim s9).|;

theorem 
  for s being convergent Complex_Sequence
   holds lim |.(r(#)s).| = |.r.|*|.(lim s).|;

theorem 
  for s being convergent Complex_Sequence
  holds lim |.-s.| = |.lim s.|;

theorem 
    for s,s9 being convergent Complex_Sequence
  holds lim |.s - s9.| = |.(lim s) - (lim s9).|;

theorem 
  for s,s9 being convergent Complex_Sequence
  holds lim |.s(#)s9.| = |.lim s.|*|.lim s9.|;

theorem 
  s is convergent & (lim s)<>0c & s is non-zero implies lim |.s".| = (|.
  lim s.|)";

theorem 
  s9 is convergent & s is convergent & (lim s)<>0c & s is non-zero
  implies lim |.(s9/"s).|=|.(lim s9).|/|.(lim s).|;

theorem 
  s is convergent & s1 is bounded & (lim s)=0c implies lim |.s(#)s1.| = 0;















begin

reserve x,y for set;
reserve C,C9,D,D9,E for non empty set;
reserve c for Element of C;
reserve c9 for Element of C9;
reserve d,d1,d2,d3,d4,e for Element of D;
reserve d9 for Element of D9;



theorem 
  for f being Function holds <:{},f:> = {} & <:f,{}:> = {};

theorem 
  for f being Function holds [:{},f:] = {} & [:f,{}:] = {};

theorem 
  for F,f being Function holds F.:({},f) = {} & F.:(f,{}) = {};

theorem 
  for F being Function holds F[:]({},x) = {};

theorem 
  for F being Function holds F[;](x,{}) = {};

theorem 
  for X being set, x1,x2 being set holds <:X-->x1,X-->x2:> = X -->[ x1,x2];

theorem 
  for F being Function,X being set, x1,x2 being set st [x1,x2] in
  dom F holds F.:(X-->x1,X-->x2) = X --> F.(x1,x2);

reserve i,j for Nat;
reserve F for Function of [:D,D9:],E;
reserve p,q for FinSequence of D,
  p9,q9 for FinSequence of D9;

definition
  let D,D9,E,F,p,p9;
  redefine func F.:(p,p9) -> FinSequence of E;
end;

definition
  let D,D9,E,F,p,d9;
  redefine func F[:](p,d9) -> FinSequence of E;
end;

definition
  let D,D9,E,F,d,p9;
  redefine func F[;](d,p9) -> FinSequence of E;
end;

reserve f,f9 for Function of C,D,
  h for Function of D,E;

definition
  let D,E be set, p be FinSequence of D, h be Function of D,E;
  redefine func h*p -> FinSequence of E;
end;

theorem 
  h*(p^<*d*>) = (h*p)^<*h.d*>;

theorem 
  h*(p^q) = (h*p)^(h*q);

reserve T,T1,T2,T3 for Tuple of i,D;
reserve T9 for Tuple of i, D9;
reserve S for Tuple of j, D;
reserve S9 for Tuple of j, D9;

theorem 
  F.:(T^<*d*>,T9^<*d9*>) = (F.:(T,T9))^<*F.(d,d9)*>;

theorem 
  F.:(T^S,T9^S9) = (F.:(T,T9))^(F.:(S,S9));

theorem 
  F[;](d,p9^<*d9*>) = (F[;](d,p9))^<*F.(d,d9)*>;

theorem 
  F[;](d,p9^q9) = (F[;](d,p9))^(F[;](d,q9));

theorem 
  F[:](p^<*d*>,d9) = (F[:](p,d9))^<*F.(d,d9)*>;

theorem 
  F[:](p^q,d9) = (F[:](p,d9))^(F[:](q,d9));

theorem 
  for h being Function of D,E holds h*(i|->d) = i|->(h.d);

theorem 
  F.:(i|->d,i|->d9) = i |-> (F.(d,d9));

theorem 
  F[;](d,i|->d9) = i |-> (F.(d,d9));

theorem 
  F[:](i|->d,d9) = i |-> (F.(d,d9));

theorem 
  F.:(i|->d,T9) = F[;](d,T9);

theorem 
  F.:(T,i|->d) = F[:](T,d);

theorem 
  F[;](d,T9) = F[;](d,id D9)*T9;

theorem 
  F[:](T,d) = F[:](id D,d)*T;



reserve F,G for BinOp of D;
reserve u for UnOp of D;
reserve H for BinOp of E;

theorem 
  F is associative implies F[;](d,id D)*(F.:(f,f9)) = F.:(F[;](d, id D)*f,f9);

theorem 
  F is associative implies F[:](id D,d)*(F.:(f,f9)) = F.:(f,F[:]( id D,d)*f9);

theorem 
  F is associative implies F[;](d,id D)*(F.:(T1,T2)) = F.:(F[;](d,id D)*
  T1,T2 );

theorem 
  F is associative implies F[:](id D,d)*(F.:(T1,T2)) = F.:(T1,F[:](id D,
  d)*T2 );

theorem 
  F is associative implies F.:(F.:(T1,T2),T3) = F.:(T1,F.:(T2,T3));

theorem 
  F is associative implies F[:](F[;](d1,T),d2) = F[;](d1,F[:](T,d2));

theorem 
  F is associative implies F.:(F[:](T1,d),T2) = F.:(T1,F[;](d,T2));

theorem 
  F is associative implies F[;](F.(d1,d2),T) = F[;](d1,F[;](d2,T));

theorem 
  F is associative implies F[:](T,F.(d1,d2)) = F[:](F[:](T,d1),d2);

theorem 
  F is commutative implies F.:(T1,T2) = F.:(T2,T1);

theorem 
  F is commutative implies F[;](d,T) = F[:](T,d);

theorem 
  F is_distributive_wrt G implies F[;](G.(d1,d2),f) = G.:(F[;](d1,
  f),F[;] (d2,f));

theorem 
  F is_distributive_wrt G implies F[:](f,G.(d1,d2)) = G.:(F[:](f,
  d1),F[:] (f,d2));

theorem 
  (for d1,d2 holds h.(F.(d1,d2)) = H.(h.d1,h.d2)) implies h*(F.:(f
  ,f9)) = H.:(h*f,h*f9);

theorem 
  (for d1,d2 holds h.(F.(d1,d2)) = H.(h.d1,h.d2)) implies h*(F[;](
  d,f)) = H[;](h.d,h*f);

theorem 
  (for d1,d2 holds h.(F.(d1,d2)) = H.(h.d1,h.d2)) implies h*(F[:](
  f,d)) = H[:](h*f,h.d);

theorem 
  u is_distributive_wrt F implies u*(F.:(f,f9)) = F.:(u*f,u*f9);

theorem 
  u is_distributive_wrt F implies u*(F[;](d,f)) = F[;](u.d,u*f);

theorem 
  u is_distributive_wrt F implies u*(F[:](f,d)) = F[:](u*f,u.d);

theorem 
  F is having_a_unity implies F.:(C-->the_unity_wrt F,f) = f & F.:
  (f,C-->the_unity_wrt F) = f;

theorem 
  F is having_a_unity implies F[;](the_unity_wrt F,f) = f;

theorem 
  F is having_a_unity implies F[:](f,the_unity_wrt F) = f;

theorem 
  F is_distributive_wrt G implies F[;](G.(d1,d2),T) = G.:(F[;](d1,T),F
  [;] (d2,T));

theorem 
  F is_distributive_wrt G implies F[:](T,G.(d1,d2)) = G.:(F[:](T,d1),F
  [:] (T,d2));

theorem 
  (for d1,d2 holds h.(F.(d1,d2)) = H.(h.d1,h.d2)) implies h*(F.:(
  T1,T2)) = H.:(h*T1,h*T2);

theorem 
  (for d1,d2 holds h.(F.(d1,d2)) = H.(h.d1,h.d2)) implies h*(F[;](
  d,T)) = H[;](h.d,h*T);

theorem 
  (for d1,d2 holds h.(F.(d1,d2)) = H.(h.d1,h.d2)) implies h*(F[:](
  T,d)) = H[:](h*T,h.d);

theorem 
  u is_distributive_wrt F implies u*(F.:(T1,T2)) = F.:(u*T1,u*T2);

theorem 
  u is_distributive_wrt F implies u*(F[;](d,T)) = F[;](u.d,u*T);

theorem 
  u is_distributive_wrt F implies u*(F[:](T,d)) = F[:](u*T,u.d);

theorem 
  G is_distributive_wrt F & u = G[;](d,id D) implies u is_distributive_wrt F;

theorem 
  G is_distributive_wrt F & u = G[:](id D,d) implies u is_distributive_wrt F;

theorem 
  F is having_a_unity implies F.:(i|->the_unity_wrt F,T) = T & F.:(T,i
  |->the_unity_wrt F) = T;

theorem 
  F is having_a_unity implies F[;](the_unity_wrt F,T) = T;

theorem 
  F is having_a_unity implies F[:](T,the_unity_wrt F) = T;

definition
  let D,u,F;
  pred u is_an_inverseOp_wrt F means


  for d holds F.(d,u.d) = the_unity_wrt F & F.(u.d,d) = the_unity_wrt F;
end;

definition
  let D,F;
  attr F is having_an_inverseOp means


  ex u st u is_an_inverseOp_wrt F;
end;

definition
  let D,F;
  assume that
 F is having_a_unity and
 F is associative and
 F is having_an_inverseOp;
  func the_inverseOp_wrt F -> UnOp of D means


  it is_an_inverseOp_wrt F;
end;

theorem 
  F is having_a_unity & F is associative & F is
having_an_inverseOp implies F.((the_inverseOp_wrt F).d,d) = the_unity_wrt F & F
  .(d,(the_inverseOp_wrt F).d) = the_unity_wrt F;

theorem 
  F is having_a_unity & F is associative & F is
  having_an_inverseOp & F.(d1,d2) = the_unity_wrt F implies d1 = (
  the_inverseOp_wrt F).d2 & (the_inverseOp_wrt F).d1 = d2;

theorem 
  F is having_a_unity & F is associative & F is
  having_an_inverseOp implies (the_inverseOp_wrt F).(the_unity_wrt F) =
  the_unity_wrt F;

theorem 
  F is having_a_unity & F is associative & F is
having_an_inverseOp implies (the_inverseOp_wrt F).((the_inverseOp_wrt F).d) = d
;

theorem 
  F is having_a_unity & F is associative & F is commutative & F is
  having_an_inverseOp implies (the_inverseOp_wrt F) is_distributive_wrt F;

theorem 
  F is having_a_unity & F is associative & F is
having_an_inverseOp & (F.(d,d1) = F.(d,d2) or F.(d1,d) = F.(d2,d)) implies d1 =
  d2;

theorem 
  F is having_a_unity & F is associative & F is
  having_an_inverseOp & (F.(d1,d2) = d2 or F.(d2,d1) = d2) implies d1 =
  the_unity_wrt F;

theorem 
  F is associative & F is having_a_unity & F is
having_an_inverseOp & G is_distributive_wrt F & e = the_unity_wrt F implies for
  d holds G.(e,d) = e & G.(d,e) = e;

theorem 
  F is having_a_unity & F is associative & F is
having_an_inverseOp & u = the_inverseOp_wrt F & G is_distributive_wrt F implies
  u.(G.(d1,d2)) = G.(u.d1,d2) & u.(G.(d1,d2)) = G.(d1,u.d2);

theorem 
  F is having_a_unity & F is associative & F is having_an_inverseOp & u
= the_inverseOp_wrt F & G is_distributive_wrt F & G is having_a_unity implies G
  [;](u.(the_unity_wrt G),id D) = u;

theorem 
  F is associative & F is having_a_unity & F is having_an_inverseOp & G
  is_distributive_wrt F implies G[;](d,id D).the_unity_wrt F = the_unity_wrt F;

theorem 
  F is associative & F is having_a_unity & F is having_an_inverseOp & G
  is_distributive_wrt F implies G[:](id D,d).the_unity_wrt F = the_unity_wrt F;

theorem 
  F is having_a_unity & F is associative & F is
having_an_inverseOp implies F.:(f,(the_inverseOp_wrt F)*f) = C-->the_unity_wrt
  F & F.:((the_inverseOp_wrt F)*f,f) = C-->the_unity_wrt F;

theorem 
  F is associative & F is having_an_inverseOp & F is
having_a_unity & F.:(f,f9) = C-->the_unity_wrt F implies f = (the_inverseOp_wrt
  F)*f9 & (the_inverseOp_wrt F)*f = f9;

theorem 
  F is having_a_unity & F is associative & F is having_an_inverseOp
  implies F.:(T,(the_inverseOp_wrt F)*T) = i|->the_unity_wrt F & F.:((
  the_inverseOp_wrt F)*T,T) = i|->the_unity_wrt F;

theorem 
  F is associative & F is having_an_inverseOp & F is having_a_unity & F
  .:(T1,T2) = i|->the_unity_wrt F implies T1 = (the_inverseOp_wrt F)*T2 & (
  the_inverseOp_wrt F)*T1 = T2;

theorem 
  F is associative & F is having_a_unity & e = the_unity_wrt F & F
  is having_an_inverseOp & G is_distributive_wrt F implies G[;](e,f) = C-->e;

theorem 
  F is associative & F is having_a_unity & e = the_unity_wrt F & F is
  having_an_inverseOp & G is_distributive_wrt F implies G[;](e,T) = i|->e;

definition
  let F,f,g be Function;
  func F*(f,g) -> Function equals

  F*[:f,g:];
end;

theorem 
  for F,f,g being Function st [x,y] in dom(F*(f,g)) holds (F*(f,g)
  ).(x,y) = F.(f.x,g.y);

theorem 
  for F,f,g being Function st [x,y] in dom(F*(f,g)) holds (F*(f,g)).(x,y
  ) = F.(f.x,g.y);

theorem 
  for F being Function of [:D,D9:],E, f being Function of C,D, g
  being Function of C9,D9 holds F*(f,g) is Function of [:C,C9:],E;

theorem 
  for u,u9 being Function of D,D holds F*(u,u9) is BinOp of D;

definition
  let D,F;
  let f,f9 be Function of D,D;
  redefine func F*(f,f9) -> BinOp of D;
end;

theorem 
  for F being Function of [:D,D9:],E, f being Function of C,D, g
  being Function of C9,D9 holds (F*(f,g)).(c,c9) = F.(f.c,g.c9);

theorem 
  for u being Function of D,D holds (F*(id D,u)).(d1,d2) = F.(d1,u
  .d2) & (F*(u,id D)).(d1,d2) = F.(u.d1,d2);

theorem 
  (F*(id D,u)).:(f,f9) = F.:(f,u*f9);

theorem 
  (F*(id D,u)).:(T1,T2) = F.:(T1,u*T2);

theorem 
  F is associative & F is having_a_unity & F is commutative & F is
having_an_inverseOp & u = the_inverseOp_wrt F implies u.(F*(id D,u).(d1,d2)) =
  F*(u,id D).(d1,d2) & F*(id D,u).(d1,d2) = u.(F*(u,id D).(d1,d2));

theorem 
  F is associative & F is having_a_unity & F is having_an_inverseOp
  implies (F*(id D,the_inverseOp_wrt F)).(d,d) = the_unity_wrt F;

theorem 
  F is associative & F is having_a_unity & F is having_an_inverseOp
  implies (F*(id D,the_inverseOp_wrt F)).(d,the_unity_wrt F) = d;

theorem 
  F is having_a_unity implies (F*(id D,u)).(the_unity_wrt F,d) = u.d;

theorem 
  F is commutative & F is associative & F is having_a_unity & F is
having_an_inverseOp & G = F*(id D,the_inverseOp_wrt F) implies for d1,d2,d3,d4
  holds F.(G.(d1,d2),G.(d3,d4))= G.(F.(d1,d3),F.(d2,d4));














begin

reserve p,q,r for FinSequence;
reserve u,v,x,y,y1,y2,z,A,D,X,Y for set;
reserve i,j,k,l,m,n for Nat;

theorem 
  Seg 3 = {1,2,3};

theorem 
  Seg 4 = {1,2,3,4};

theorem 
  Seg 5 = {1,2,3,4,5};

theorem 
  Seg 6 = {1,2,3,4,5,6};

theorem 
  Seg 7 = {1,2,3,4,5,6,7};

theorem 
  Seg 8 = {1,2,3,4,5,6,7,8};

theorem 
  Seg k = {} iff not k in Seg k;

theorem 
  not k + 1 in Seg k;

theorem 
  k <> 0 implies k in Seg(k + n);

theorem 
  k + n in Seg k implies n = 0;

theorem 
  k < n implies k + 1 in Seg n;

theorem 
  k in Seg n & m < k implies k - m in Seg n;

theorem 
  k - n in Seg k iff n < k;

theorem 
  Seg k misses {k + 1};

theorem 
  Seg(k + 1) \ Seg k = {k + 1};




theorem 
  Seg k <> Seg(k + 1);

theorem 
  Seg k = Seg(k + n) implies n = 0;

theorem 
  Seg k c= Seg(k + n);

theorem 
  Seg k, Seg n are_c=-comparable;

theorem 
  Seg k = {y} implies k = 1 & y = 1;

theorem 
  Seg k = {x,y} & x <> y implies k = 2 & {x,y} = {1,2};

theorem 
  x in dom p implies x in dom(p ^ q);

theorem 
  x in dom p implies x is Element of NAT;

theorem 
  x in dom p implies x <> 0;

theorem 
  n in dom p iff 1 <= n & n <= len p;

theorem 
  n in dom p iff n - 1 is Element of NAT & len p - n is Element of NAT;

canceled 2;

theorem 
  len p = len q iff dom p = dom q;

theorem 
  len p <= len q iff dom p c= dom q;

theorem 
  x in rng p implies 1 in dom p;

theorem 
  rng p <> {} implies 1 in dom p;

theorem 
  {} <> <* x,y *>;

theorem 
  {} <> <* x,y,z *>;

theorem 
  <* x *> <> <* y,z *>;

theorem 
  <* u *> <> <* x,y,z *>;

theorem 
  <* u,v *> <> <* x,y,z *>;

theorem 
  len r = len p + len q & (for k being Element of NAT st k in dom
p holds r.k = p.k) & (for k being Element of NAT st k in dom q holds r.(len p +
  k) = q.k) implies r = p ^ q;

theorem 
  for A being finite set st A c= Seg k holds len(Sgm A) = card A;

theorem 
  for A being finite set st A c= Seg k holds dom(Sgm A) = Seg(card A);

theorem 
  X c= Seg i & k < l & 1 <= n & m <= len(Sgm X) & Sgm(X).m = k &
  Sgm(X).n = l implies m < n;

theorem 
  X c= Seg i & Y c= Seg j implies ((for m,n being Element of NAT
  st m in X & n in Y holds m < n) iff Sgm(X \/ Y) = Sgm(X) ^ Sgm(Y));

theorem 
  Sgm {} = {};



theorem 
  0 <> n implies Sgm{n} = <* n *>;

theorem 
  0 < n & n < m implies Sgm{n,m} = <* n,m *>;

theorem 
  len(Sgm(Seg k)) = k;

theorem 
  Sgm(Seg(k + n)) | Seg k = Sgm(Seg k);

theorem 
  Sgm(Seg k) = idseq k;

theorem 
  p | Seg n = p iff len p <= n;

theorem 
  idseq(n + k) | Seg n = idseq n;

theorem 
  idseq n | Seg m = idseq m iff m <= n;

theorem 
  idseq n | Seg m = idseq n iff n <= m;

theorem 
  len p = k + l & q = p | Seg k implies len q = k;

theorem 
  len p = k + l & q = p | Seg k implies dom q = Seg k;

theorem 
  len p = k + 1 & q = p | Seg k implies p = q ^ <* p.(k + 1) *>;

theorem 
  p | X is FinSequence iff ex k being Element of NAT st X /\ dom p = Seg k;

theorem 
  card((p ^ q) " A) = card(p " A) + card(q " A);

theorem 
  p " A c= (p ^ q) " A;

definition
  let p,A;
  func p - A -> FinSequence equals

  p * Sgm ((dom p) \ p " A);
end;

theorem 
  len(p - A) = len p - card(p " A);

theorem 
  len(p - A) <= len p;

theorem 
  len(p - A) = len p implies A misses rng p;

theorem 
  n = len p - card(p " A) implies dom(p - A) = Seg n;

theorem 
  dom(p - A) c= dom p;

theorem 
  dom(p - A) = dom p implies A misses rng p;

theorem 
  rng(p - A) = rng p \ A;

theorem 
  rng(p - A) c= rng p;

theorem 
  rng(p - A) = rng p implies A misses rng p;

theorem 
  p - A = {} iff rng p c= A;

theorem 
  p - A = p iff A misses rng p;

theorem 
  p - {x} = p iff not x in rng p;

theorem 
  p - {} = p;

theorem 
  p - rng p = {};

theorem 
  (p ^ q) - A = (p - A) ^ (q - A);

theorem 
  {} - A = {};

theorem 
  <* x *> - A = <* x *> iff not x in A;

theorem 
  <* x *> - A = {} iff x in A;

theorem 
  <* x,y *> - A = {} iff x in A & y in A;

theorem 
  x in A & not y in A implies <* x,y *> - A = <* y *>;

theorem 
  <* x,y *> - A = <* y *> & x <> y implies x in A & not y in A;

theorem 
  not x in A & y in A implies <* x,y *> - A = <* x *>;

theorem 
  <* x,y *> - A = <* x *> & x <> y implies not x in A & y in A;

theorem 
  <* x,y *> - A = <* x,y *> iff not x in A & not y in A;

theorem 
  len p = k + 1 & q = p | Seg k implies (p.(k + 1) in A iff p - A = q - A);

theorem 
  len p = k + 1 & q = p | Seg k implies (not p.(k + 1) in A iff p
  - A = (q - A) ^ <* p.(k + 1) *>);

theorem 
  n in dom p implies for B being finite set st B = {k where k is Element
of NAT : k in dom p & k <= n & p.k in A} holds p.n in A or (p - A).(n - card B)
  = p.n;

theorem 
  p is FinSequence of D implies p - A is FinSequence of D;

theorem 
  p is one-to-one implies p - A is one-to-one;

theorem 
  p is one-to-one implies len(p - A) = len p - card(A /\ rng p);

theorem 
  for A being finite set st p is one-to-one & A c= rng p holds len
  (p - A) = len p - card A;

theorem 
  p is one-to-one & x in rng p implies len(p - {x}) = len p - 1;

theorem 
  rng p misses rng q & p is one-to-one & q is one-to-one iff p ^ q
  is one-to-one;

theorem 
  A c= Seg k implies Sgm A is one-to-one;

theorem 
  <* x *> is one-to-one;

theorem 
  x <> y iff <* x,y *> is one-to-one;

theorem 
  x <> y & y <> z & z <> x iff <* x,y,z *> is one-to-one;

theorem 
  p is one-to-one & rng p = {x} implies len p = 1;

theorem 
  p is one-to-one & rng p = {x} implies p = <* x *>;

theorem 
  p is one-to-one & rng p = {x,y} & x <> y implies len p = 2;

theorem 
  p is one-to-one & rng p = {x,y} & x <> y implies p = <* x,y *> or p =
  <* y,x *>;

theorem 
  p is one-to-one & rng p = {x,y,z} & <* x,y,z *> is one-to-one
  implies len p = 3;

theorem 
  p is one-to-one & rng p = {x,y,z} & x <> y & y <> z & x <> z implies
  len p = 3;

begin 


theorem 
  for D being non empty set, df being FinSequence of D holds df is non
empty implies ex d being Element of D, df1 being FinSequence of D st d = df.1 &
  df = <*d*>^df1;

theorem 
  for df being FinSequence, d being set holds i in dom df implies (<*d*>
  ^df).(i+1) = df.i;



definition
  let i;
  let p be FinSequence;
  func Del(p,i) -> FinSequence equals

  p * Sgm ((dom p) \ {i});
end;

theorem 
  for p being FinSequence holds
  (i in dom p implies ex m being Nat st len p = m + 1 & len Del(p,i) = m) &
  (not i in dom p implies Del(p,i) = p);

theorem 
  for D being non empty set for p being FinSequence of D holds
  Del(p,i) is FinSequence of D;



theorem 
  for p be FinSequence holds rng Del(p,i) c= rng p;



theorem 
  n = m + 1 & i in Seg n implies len Sgm(Seg n \ {i}) = m;

reserve J for Element of NAT;

theorem 
  for i,k,m,n being Nat st n=m+1 & k in Seg n & i in Seg m holds
  (1<=i & i<k implies Sgm(Seg n \ {k}).i = i) &
  (k<=i & i<=m implies Sgm(Seg n \ {k}).i = i+1);

theorem 
  for f being FinSequence st len f = m+1 & n in dom f holds len Del(f,n) = m;

theorem 
  for f being FinSequence st k < n holds Del(f,n).k = f.k;

theorem 
  for f being FinSequence st len f = m+1 & n in dom f & n<=k & k<=m
  holds Del(f,n).k = f.(k+1);



theorem 
  for f being FinSequence st k<=n holds (f|n).k=f.k;



theorem 
  for p,q being FinSequence st p c= q holds q|len p = p;



theorem 
  for A being set, F being FinSequence holds Sgm(F"A)^Sgm(F"(rng
  F \ A)) is Permutation of dom F;

theorem 
  for F being FinSequence, A be Subset of rng F
  ex p being Permutation of dom F st (F-A`)^(F-A) = F*p;



theorem 
  for f being FinSubsequence holds f is FinSequence implies Seq f = f;



theorem 
  for t be FinSequence of INT holds t is FinSequence of REAL;



theorem 
  len p < len q iff dom p c< dom q;



theorem 
  for A being set, i being Nat holds i <> 0 & A = {} iff i-tuples_on A = {};



registration
  let i be Nat, D be set;
  cluster i-tuples_on D -> with_common_domain;
end;

registration
  let i be Nat, D be set;
  cluster i-tuples_on D -> product-like;
end;

begin 

reserve
  n for Element of NAT;

theorem 
  for D1,D2 be non empty set, p be FinSequence of D1, f be Function
  of D1,D2 holds dom(f*p) = dom p & len (f*p) = len p & for n being Nat st n in
  dom (f*p) holds (f*p).n = f.(p.n);

definition
  let D be non empty set, R be Relation of D;
  func ExtendRel(R) -> Relation of D* means


  for x,y be FinSequence of D
holds [x,y] in it iff len x = len y & for n st n in dom x holds [x.n,y.n] in R;
end;

theorem 
  for D be non empty set holds ExtendRel(id D) = id (D*);

definition
  let D be non empty set, R be Equivalence_Relation of D;
  let y be FinSequence of Class(R), x be FinSequence of D;
  pred x is_representatives_FS y means

  len x = len y & for n st n in dom x holds Class(R,x.n) = y.n;
end;

theorem 
  for D be non empty set, R be Equivalence_Relation of D, y be
  FinSequence of Class(R) ex x be FinSequence of D st x is_representatives_FS y
;



reserve x,y,y1,y2,z,a,b,X,Y,Z,V1,V2 for set,
  f,g,h,h9,f1,f2 for Function,
  i for Nat,
  P for Permutation of X,
  D,D1,D2,D3 for non empty set,
  d1 for Element of D1,
  d2 for Element of D2,
  d3 for Element of D3;

theorem 
  x in product <*X*> iff ex y st y in X & x = <*y*>;

theorem 
  z in product <*X,Y*> iff ex x,y st x in X & y in Y & z = <*x,y*>;

theorem 
  a in product <*X,Y,Z*> iff ex x,y,z st x in X & y in Y & z in Z &
  a = <*x,y,z*>;

theorem 
  product <*D*> = 1-tuples_on D;

theorem 
  product <*D1,D2*> = { <*d1,d2*>: not contradiction };

theorem 
  product <*D,D*> = 2-tuples_on D;

theorem 
  product <*D1,D2,D3*> = { <*d1,d2,d3*>: not contradiction };

theorem 
  product <*D,D,D*> = 3-tuples_on D;

theorem 
 for D being set holds product (i |-> D) = i-tuples_on D;

theorem 
  doms <*f*> = <*dom f*> & rngs <*f*> = <*rng f*>;

theorem 
  doms <*f,g*> = <*dom f, dom g*> & rngs <*f,g*> = <*rng f, rng g *>;

theorem 
  doms <*f,g,h*> = <*dom f, dom g, dom h*> & rngs <*f,g,h*> = <*rng f,
  rng g, rng h*>;

theorem 
  Union <*X*> = X & meet <*X*> = X;

theorem 
  Union <*X,Y*> = X \/ Y & meet <*X,Y*> = X /\ Y;

theorem 
  Union <*X,Y,Z*> = X \/ Y \/ Z & meet <*X,Y,Z*> = X /\ Y /\ Z;

theorem 
  x in dom f implies <*f*>..(1,x) = f.x & <*f,g*>..(1,x) = f.x & <*f,g,h
  *>..(1,x) = f.x;

theorem 
  x in dom g implies <*f,g*>..(2,x) = g.x & <*f,g,h*>..(2,x) = g.x;

theorem 
  x in dom h implies <*f,g,h*>..(3,x) = h.x;

theorem 
  dom <:<*h*>:> = dom h & for x st x in dom h holds <:<*h*>:>.x = <*h.x *>;

theorem 
  dom <:<*f1,f2*>:> = dom f1 /\ dom f2 & for x st x in dom f1 /\
  dom f2 holds <:<*f1,f2*>:>.x = <*f1.x,f2.x*>;

theorem 
  dom Frege<*h*> = product <*dom h*> & rng Frege<*h*> = product <*rng h
  *> & for x st x in dom h holds (Frege<*h*>).<*x*> = <*h.x*>;

theorem 
  dom Frege<*f1,f2*> = product <*dom f1, dom f2*> & rng Frege<*f1,
f2*> = product <*rng f1, rng f2*> & for x,y st x in dom f1 & y in dom f2 holds
  (Frege<*f1,f2*>).<*x,y*> = <*f1.x, f2.y*>;

theorem 
  x in dom f1 & x in dom f2 implies for y1,y2 holds <:f1,f2:>.x = [y1,y2
  ] iff <:<*f1,f2*>:>.x = <*y1,y2*>;

theorem 
  x in dom f1 & y in dom f2 implies for y1,y2 holds [:f1,f2:].(x,y) = [
  y1,y2] iff (Frege<*f1,f2*>).<*x,y*> = <*y1,y2*>;

theorem 
  Funcs(<*X*>,Y) = <*Funcs(X,Y)*>;

theorem 
  Funcs(<*X,Y*>,Z) = <*Funcs(X,Z), Funcs(Y,Z)*>;

theorem 
  Funcs(X,<*Y*>) = <*Funcs(X,Y)*>;

theorem 
  Funcs(X,<*Y,Z*>) = <*Funcs(X,Y), Funcs(X,Z)*>;



theorem 
  for f being FinSequence st rng f={x,y} & len f=2 holds f.1=x & f.
  2=y or f.1=y & f.2=x;



theorem 
  for X being set, k being Element of NAT st X c= Seg k holds for m
  ,n being Element of NAT st m in dom (Sgm X) & n = (Sgm X).m holds m <= n;

registration
  let i be Nat; let D be finite set;
  cluster i-tuples_on D -> finite;
end;














begin

reserve x,z for set;
reserve k for Element of NAT;
reserve D for non empty set;

definition
  let B be non empty set, A be set, b be Element of B;
  redefine func A --> b -> Function of A,B;
end;

definition
  let IT be FinSequence-membered set;
  redefine attr IT is with_common_domain means


   for a,b being FinSequence st a in IT & b in IT holds len a = len b;
end;

registration
  cluster FinSequence-membered with_common_domain for set;
end;

definition
  mode relation is FinSequence-membered with_common_domain set;
end;

reserve X for set;
reserve p,r for relation;
reserve a,a1,a2,b for FinSequence;

theorem 
  X c= p implies X is relation;

theorem 
  {a} is relation;

scheme 

  relexist{A() -> set, P[FinSequence]}: ex r st for a holds a in r iff a in A(
  ) & P[a]
provided
 for a,b st P[a] & P[b] holds len a = len b;

definition
  let p,r;
  redefine pred p = r means

  for a holds a in p iff a in r;
end;

registration
  cluster empty -> with_common_domain for set;
end;

theorem 
  for p st for a holds not a in p holds p = {};

definition
  let p;
  assume
 p <> {};

  func the_arity_of p -> Element of NAT means

  for a st a in p holds it = len a;
end;

definition
  let k;
  mode relation_length of k -> relation means

    for a st a in it holds len a = k;
end;

definition
  let X be set;
  mode relation of X -> relation means

    for a st a in it holds rng a c= X;
end;

theorem 
  {} is relation of X;

theorem 
  {} is relation_length of k;

definition
  let X, k;
  mode relation of X,k -> relation means

    it is relation of X & it is relation_length of k;
end;

definition
  let D;
  func relations_on D -> set means


  for X holds X in it iff X c= D* &
  for a,b being FinSequence of D st a in X & b in X holds len a = len b;
end;

registration
  let D;
  cluster relations_on D -> non empty;
end;

definition
  let D be non empty set;
  mode relation of D is Element of relations_on D;
end;

reserve a,b for FinSequence of D;
reserve p,r for Element of relations_on D;

theorem 
  X c= r implies X is Element of relations_on D;

theorem 
  {a} is Element of relations_on D;

theorem 
  for x,y being Element of D holds {<*x,y*>} is Element of relations_on D;

definition
  let D,p,r;
  redefine pred p = r means


  for a holds a in p iff a in r;
end;

scheme 

  relDexist{D() -> non empty set, P[FinSequence of D()]}: ex r being Element
  of relations_on D() st for a being FinSequence of D() holds a in r iff P[a]
provided
 for a,b being FinSequence of D() st P[a] & P[b] holds len a = len b;

definition
  let D;
  func empty_rel(D) -> Element of relations_on D means


  not a in it;
end;

theorem 
  empty_rel(D) = {};

definition
  let D,p;
  assume
 p <> empty_rel(D);
  func the_arity_of p -> Element of NAT means

  a in p implies it = len a;
end;

scheme 

  relDexist2{D() -> non empty set, k() -> Element of NAT, P[FinSequence of D()
]}: ex r being Element of relations_on D() st for a being FinSequence of D() st
  len a = k() holds a in r iff P[a];

definition
  func BOOLEAN -> set equals

  {0,1};
end;

registration
  cluster BOOLEAN -> non empty;
end;

definition
  redefine func FALSE -> Element of BOOLEAN;
  redefine func TRUE -> Element of BOOLEAN;
end;

definition
  let x be set;
  redefine attr x is boolean means


  x in BOOLEAN;
end;

registration
  cluster -> boolean for Element of BOOLEAN;
end;

reserve u,v,w for boolean set;

definition
  let v be boolean set;
  redefine func 'not' v equals

  TRUE if v = FALSE otherwise FALSE;
  let w be boolean set;
  redefine func v '&' w equals

  TRUE if v = TRUE & w =TRUE otherwise FALSE;
end;

definition
  let v be Element of BOOLEAN;
  redefine func 'not' v -> Element of BOOLEAN;
  let w be Element of BOOLEAN;
  redefine func v '&' w -> Element of BOOLEAN;
end;

canceled;

theorem 
  (v = FALSE iff 'not' v = TRUE) & (v = TRUE iff 'not' v = FALSE);

theorem 
  (v '&' w = TRUE iff v = TRUE & w = TRUE) & (v '&' w = FALSE iff v =
  FALSE or w = FALSE);

theorem 
  FALSE '&' v = FALSE;

theorem 
  TRUE '&' v = v;

theorem 
  v '&' v = FALSE implies v = FALSE;

theorem 
  v '&' (w '&' u) = (v '&' w) '&' u;

definition
  let X;
  func ALL(X) equals


  TRUE if not FALSE in X otherwise FALSE;
end;

registration
  let X;
  cluster ALL X -> boolean;
end;

definition
  let X;
  redefine func ALL X -> Element of BOOLEAN;
end;

theorem 
  (not FALSE in X iff ALL(X) = TRUE) & (FALSE in X iff ALL(X) = FALSE);

begin 


definition
  let f be Relation;
  attr f is boolean-valued means


  rng f c= BOOLEAN;
end;

registration
  cluster boolean-valued for Function;
end;

registration
  let f be boolean-valued Function, x be set;
  cluster f.x -> boolean;
end;

definition
  let p be boolean-valued Function;
  func 'not' p -> boolean-valued Function means


  dom it = dom p & for x being set st x in dom p holds it.x = 'not'(p.x);
  involutiveness;
  let q be boolean-valued Function;
  func p '&' q -> boolean-valued Function means


  dom it = dom p /\ dom
  q & for x being set st x in dom it holds it.x = (p.x) '&' (q.x);
  commutativity;
  idempotence;
end;

registration
  let A be set;
  cluster -> boolean-valued for Function of A,BOOLEAN;
end;

definition
  let A be non empty set;
  let p be Function of A,BOOLEAN;
  redefine func 'not' p -> Function of A,BOOLEAN means

  for x being Element of A holds it.x = 'not'(p.x);
  let q be Function of A,BOOLEAN;
  redefine func p '&' q -> Function of A,BOOLEAN means

  for x being Element of A holds it.x = (p.x) '&' (q.x);
end;

begin 

reserve A,z for set,
  x,y for FinSequence of A,
  h for PartFunc of A*,A,
  n,m for Nat;

definition
  let IT be Relation;
  attr IT is homogeneous means

 dom IT is with_common_domain;
end;

definition
  let A;
  let IT be PartFunc of A*,A;
  attr IT is quasi_total means

 for x,y st len x = len y & x in dom IT holds y in dom IT;
end;

registration
  let f be Relation;
  let X be with_common_domain set;
  cluster f|X -> homogeneous;
end;

registration
  let A be non empty set, f be PartFunc of A*,A;
  cluster dom f -> FinSequence-membered;
end;

registration
  let A be non empty set;
  cluster homogeneous quasi_total non empty for PartFunc of A*,A;
end;

registration
  cluster homogeneous non empty for Function;
end;

registration let R be homogeneous Relation;
 cluster dom R -> with_common_domain;
end;

theorem 
  for A being non empty set, a being Element of A holds <*>A .-->a
  is homogeneous quasi_total non empty PartFunc of A*,A;

theorem 
  for A being non empty set, a being Element of A holds <*>A .-->a
  is Element of PFuncs(A*,A);

definition
  let A;
  mode PFuncFinSequence of A is FinSequence of PFuncs(A*,A);
end;

definition
  let A;
  let IT be PFuncFinSequence of A;
  attr IT is homogeneous means


  for n,h st n in dom IT & h = IT.n holds h is homogeneous;
end;

definition
  let A;
  let IT be PFuncFinSequence of A;
  attr IT is quasi_total means


  for n,h st n in dom IT & h = IT.n holds h is quasi_total;
end;

definition
  let A be non empty set;
  let x be Element of PFuncs(A*,A);
  redefine func <*x*> -> PFuncFinSequence of A;
end;

registration
  let A be non empty set;
  cluster homogeneous quasi_total non-empty for PFuncFinSequence of A;
end;

registration
  let A be non empty set;
  let f be homogeneous PFuncFinSequence of A;
  let i be set;
  cluster f.i -> homogeneous;
end;

reserve A for non empty set,
  h for PartFunc of A*,A,

  a for Element of A;

theorem 
  for x be Element of PFuncs(A*,A) st x = <*>A .--> a holds <*x*>
  is homogeneous quasi_total non-empty;

definition
  let f be homogeneous Relation;
  func arity(f) -> Nat means

  for x being FinSequence st x in dom f holds it =
  len x if ex x being FinSequence st x in dom f otherwise it = 0;
end;

definition
  let f be homogeneous Function;
  redefine func arity(f) -> Element of NAT;
end;

begin 

theorem 
  for n be Nat, D be non empty set, D1 be non empty Subset of D
  holds n-tuples_on D /\ n-tuples_on D1 = n-tuples_on D1;

theorem 
  for D being non empty set for h being homogeneous quasi_total non
  empty PartFunc of D*,D holds dom h = (arity(h))-tuples_on D;

definition
  let D be non empty set;
  mode PFuncsDomHQN of D -> non empty set means


    for x be Element of it
    holds x is homogeneous quasi_total non empty PartFunc of D*,D;
end;

definition
  let D be non empty set, P be PFuncsDomHQN of D;
  redefine mode Element of P -> homogeneous quasi_total non empty PartFunc of
    D*,D;
end;














begin

reserve X,Y,Z,x,y,z for set;

registration
  cluster empty -> reflexive irreflexive symmetric antisymmetric asymmetric
    connected strongly_connected transitive for Relation;
end;



notation
  let X;
  synonym Total X for nabla X;
end;

definition
  let R be Relation, Y be set;
  redefine func R |_2 Y -> Relation of Y,Y;
end;

theorem 
  rng Total X = X;

theorem 
  for x,y st x in X & y in X holds [x,y] in Total X;

theorem 
  for x,y st x in field Total X & y in field Total X holds [x,y] in Total X;

theorem 
  Total X is strongly_connected;

theorem 
  Total X is connected;



reserve T,R for Tolerance of X;

theorem 
  for T being Tolerance of X holds rng T = X;

theorem 
  for T being total reflexive Relation of X holds x in X iff [x,x] in T;

theorem 
  for T being Tolerance of X holds T is_reflexive_in X;

theorem 
  for T being Tolerance of X holds T is_symmetric_in X;

theorem 
  for R be Relation of X,Y st R is symmetric holds R |_2 Z is symmetric;

definition
  let X,T;
  let Y be Subset of X;
  redefine func T |_2 Y -> Tolerance of Y;
end;

theorem 
  Y c= X implies T|_2 Y is Tolerance of Y;



definition
  let X;
  let T be Tolerance of X;

  mode TolSet of T -> set means


    for x,y st x in it & y in it holds [x,y ] in T;
end;

theorem 
  {} is TolSet of T;

definition
  let X;
  let T be Tolerance of X;
  let IT be TolSet of T;
  attr IT is TolClass-like means


  for x st not x in IT & x in X ex y st y in IT & not [x,y] in T;
end;

registration
  let X;
  let T be Tolerance of X;
  cluster TolClass-like for TolSet of T;
end;

definition
  let X;
  let T be Tolerance of X;
  mode TolClass of T is TolClass-like TolSet of T;
end;

theorem 
  for T being Tolerance of X st {} is TolClass of T holds T={};

theorem 
  {} is Tolerance of {};

theorem 
  for x,y st [x,y] in T holds {x,y} is TolSet of T;

theorem 
  for x st x in X holds {x} is TolSet of T;

theorem 
  for Y,Z st Y is TolSet of T holds Y /\ Z is TolSet of T;

theorem 
  Y is TolSet of T implies Y c= X;

theorem 
  for Y being TolSet of T ex Z being TolClass of T st Y c= Z;

theorem 
  for x,y st [x,y] in T ex Z being TolClass of T st x in Z & y in Z;

theorem 
  for x st x in X ex Z being TolClass of T st x in Z;

theorem 
  T c= Total X;

theorem 
  id X c= T;

scheme 

  ToleranceEx{A() -> set,P[set,set]}: ex T being Tolerance of A() st for x,y
  st x in A() & y in A() holds [x,y] in T iff P[x,y]
provided
 for x st x in A() holds P[x,x] and
 for x,y st x in A() & y in A() & P[x,y] holds P[y,x];

theorem 
  for Y ex T being Tolerance of union Y st for Z st Z in Y holds Z is
  TolSet of T;

theorem 
  for Y being set for T,R being Tolerance of union Y st (for x,y holds [
x,y] in T iff ex Z st Z in Y & x in Z & y in Z) & (for x,y holds [x,y] in R iff
  ex Z st Z in Y & x in Z & y in Z) holds T = R;

theorem 
  for T,R being Tolerance of X st for Z holds Z is TolClass of T
  iff Z is TolClass of R holds T = R;



notation
  let X, Y;
  let T be Relation of X, Y;
  let x;
  synonym neighbourhood (x, T) for Class (T,x);
end;

theorem 
  for y being set holds y in neighbourhood(x,T) iff [x,y] in T;

theorem 
  for Y st for Z being set holds Z in Y iff x in Z & Z is TolClass of T
  holds neighbourhood(x,T) = union Y;

theorem 
  for Y st for Z holds Z in Y iff x in Z & Z is TolSet of T holds
  neighbourhood(x,T) = union Y;



definition
  let X;
  let T be Tolerance of X;

  func TolSets T -> set means


  for Y holds Y in it iff Y is TolSet of T;
  func TolClasses T -> set means


  for Y holds Y in it iff Y is TolClass of T;
end;

theorem 
  TolClasses R c= TolClasses T implies R c= T;

theorem 
  for T,R being Tolerance of X st TolClasses T = TolClasses R holds T = R;

theorem 
  union TolClasses T = X;

theorem 
  union TolSets T = X;

theorem 
  (for x st x in X holds neighbourhood(x,T) is TolSet of T) implies T is
  transitive;

theorem 
  T is transitive implies for x st x in X holds neighbourhood(x,T) is
  TolClass of T;

theorem 
  for x for Y being TolClass of T st x in Y holds Y c= neighbourhood(x,T );

theorem 
  TolSets R c= TolSets T iff R c= T;

theorem 
  TolClasses T c= TolSets T;

theorem 
  (for x st x in X holds neighbourhood(x,R) c= neighbourhood(x,T))
  implies R c= T;

theorem 
  T c= T*T;














begin

reserve
  X,x,y,z for set,
  k,n,m for Element of NAT,
  f for Function,
  p,q,r for FinSequence of NAT;






notation
  let p,q be FinSequence;
  synonym p is_a_prefix_of q for p c= q;
end;

definition
  let p,q be FinSequence;
  redefine pred p is_a_prefix_of q means


  ex n st p = q|Seg n;
end;

theorem 
  for p,q being FinSequence holds p is_a_prefix_of q iff
  ex r being FinSequence st q = p^r;

theorem 
  for p,q being FinSequence st p is_a_prefix_of q & len p = len q holds p = q;

theorem 
  <*x*> is_a_prefix_of <*y*> iff x = y;

notation
  let p,q be FinSequence;
  synonym p is_a_proper_prefix_of q for p c< q;
end;

theorem 
  for p,q being finite set st p,q are_c=-comparable & card p = card q holds
  p = q;

reserve p1,p2,p3 for FinSequence;

theorem 
  <*x*>,<*y*> are_c=-comparable implies x = y;

theorem 
  for p,q being finite set st p c< q holds card p < card q;

theorem 
  p1^<*x*> is_a_prefix_of p2 implies p1 is_a_proper_prefix_of p2;

theorem 
  p1 is_a_prefix_of p2 implies p1 is_a_proper_prefix_of p2^<*x*>;

theorem 
  p1 is_a_proper_prefix_of p2^<*x*> implies p1 is_a_prefix_of p2;

theorem 
  {} is_a_proper_prefix_of p2 or {} <> p2 implies
  p1 is_a_proper_prefix_of p1^p2;





definition
  let p be FinSequence;

  func ProperPrefixes p -> set means


  x in it iff ex q being FinSequence st x = q & q is_a_proper_prefix_of p;
end;

theorem 
  for p being FinSequence st x in ProperPrefixes p holds x is FinSequence;

theorem 
  for p,q being FinSequence holds
  p in ProperPrefixes q iff p is_a_proper_prefix_of q;

theorem 
  for p,q being FinSequence st p in ProperPrefixes q holds len p < len q;

theorem 
  for p,q,r being FinSequence st q^r in ProperPrefixes p holds
  q in ProperPrefixes p;

theorem 
  ProperPrefixes {} = {};

theorem 
  ProperPrefixes <*x*> = { {} };

theorem 
  for p,q being FinSequence st p is_a_prefix_of q holds
  ProperPrefixes p c= ProperPrefixes q;

theorem 
  for p,q,r being FinSequence st
  q in ProperPrefixes p & r in ProperPrefixes p holds q,r are_c=-comparable;





definition
  let X;
  attr X is Tree-like means


  X c= NAT* & (for p st p in X holds ProperPrefixes p c= X) &
  for p,k,n st p^<*k*> in X & n <= k holds p^<*n*> in X;
end;

registration
  cluster { {} } -> Tree-like;
end;

registration
  cluster non empty Tree-like for set;
end;

definition
  mode Tree is Tree-like non empty set;
end;

reserve T,T1 for Tree;

theorem 
  x in T implies x is FinSequence of NAT;

definition
  let T;
  redefine mode Element of T -> FinSequence of NAT;
end;

theorem 
  for p,q being FinSequence st p in T & q is_a_prefix_of p holds q in T;

theorem 
  for r being FinSequence st q^r in T holds q in T;

theorem 
  {} in T & <*> NAT in T;

theorem 
  { {} } is Tree;

registration
  let T,T1;
  cluster T \/ T1 -> Tree-like;

  cluster T /\ T1 -> Tree-like non empty;
end;

theorem 
  T \/ T1 is Tree;

theorem 
  T /\ T1 is Tree;





registration
  cluster finite for Tree;
end;

reserve fT,fT1 for finite Tree;

theorem 
  fT \/ fT1 is finite Tree;

theorem 
  fT /\ T is finite Tree;





definition
  let n;

  func elementary_tree n -> Tree equals

  { <*k*> : k < n } \/ { {} };
end;

registration
  let n;
  cluster elementary_tree n -> finite;
end;

theorem 
  k < n implies <*k*> in elementary_tree n;

theorem 
  elementary_tree 0 = { {} };

theorem 
  p in elementary_tree n implies p = {} or ex k st k < n & p = <*k*>;





definition
  let T;
  func Leaves T -> Subset of T means


  p in it iff p in T & not ex q st q in T & p is_a_proper_prefix_of q;
  let p such that
 p in T;
  func T|p -> Tree means


  q in it iff p^q in T;
end;

theorem 
  T|(<*> NAT) = T;

registration
  let T be finite Tree;
  let p be Element of T;
  cluster T|p -> finite;
end;

definition
  let T;
  assume
 Leaves T <> {};
  mode Leaf of T -> Element of T means

  it in Leaves T;
end;

definition
  let T;
  mode Subtree of T -> Tree means

    ex p being Element of T st it = T|p;
end;

reserve t for Element of T;

definition
  let T,p,T1;
  assume
 p in T;
  func T with-replacement (p,T1) -> Tree means


  q in it iff q in T & not p is_a_proper_prefix_of q or
  ex r st r in T1 & q = p^r;
end;

theorem 
  p in T implies T with-replacement (p,T1) =
  { t1 where t1 is Element of T : not p is_a_proper_prefix_of t1 } \/
  { p^s where s is Element of T1 : s = s };

theorem 
  p in T implies T1 = T with-replacement (p,T1)|p;

registration
  let T be finite Tree, t be Element of T;
  let T1 be finite Tree;
  cluster T with-replacement (t,T1) -> finite;
end;

reserve w for FinSequence;

theorem 
  for p being FinSequence holds ProperPrefixes p,dom p are_equipotent;

registration
  let p be FinSequence;
  cluster ProperPrefixes p -> finite;
end;

theorem 
  for p being FinSequence holds card ProperPrefixes p = len p;





definition
  let IT be set;
  attr IT is AntiChain_of_Prefixes-like means


  (for x st x in IT holds x is FinSequence) &
  for p1,p2 st p1 in IT & p2 in IT & p1 <> p2 holds
  not p1,p2 are_c=-comparable;
end;

registration
  cluster AntiChain_of_Prefixes-like for set;
end;

definition
  mode AntiChain_of_Prefixes is AntiChain_of_Prefixes-like set;
end;

theorem 
  { w } is AntiChain_of_Prefixes-like;

theorem 
  not p1,p2 are_c=-comparable implies { p1,p2 } is AntiChain_of_Prefixes-like;

definition
  let T;
  mode AntiChain_of_Prefixes of T -> AntiChain_of_Prefixes means


  it c= T;
end;

reserve t1,t2 for Element of T;

theorem 
  {} is AntiChain_of_Prefixes of T & { {} } is AntiChain_of_Prefixes of T;

theorem 
  { t } is AntiChain_of_Prefixes of T;

theorem 
  not t1,t2 are_c=-comparable implies { t1,t2 } is AntiChain_of_Prefixes of T;

registration
  let T be finite Tree;
  cluster -> finite for AntiChain_of_Prefixes of T;
end;

definition
  let T be finite Tree;
  func height T -> Element of NAT means


  (ex p st p in T & len p = it) & for p st p in T holds len p <= it;
  func width T -> Element of NAT means


  ex X being AntiChain_of_Prefixes of T st it = card X &
  for Y being AntiChain_of_Prefixes of T holds card Y <= card X;
end;

theorem 
  1 <= width fT;

theorem 
  height elementary_tree 0 = 0;

theorem 
  height fT = 0 implies fT = elementary_tree 0;

theorem 
  height elementary_tree(n+1) = 1;

theorem 
  width elementary_tree 0 = 1;

theorem 
  width elementary_tree(n+1) = n+1;

theorem 
  for t being Element of fT holds height(fT|t) <= height fT;

theorem 
  for t being Element of fT st t <> {} holds height(fT|t) < height fT;

scheme 
 TreeInd { P[Tree] }: for fT holds P[fT]
provided
 for fT st for n st <*n*> in fT holds P[fT|<*n*>] holds P[fT];

begin 


reserve s,t for FinSequence;

theorem 
  w^t is_a_proper_prefix_of w^s implies t is_a_proper_prefix_of s;

theorem 
  n <> m implies not <*n*> is_a_prefix_of <*m*>^s;

theorem 
  elementary_tree 1 = {{},<*0*>};

theorem 
  not <*n*> is_a_proper_prefix_of <*m*>;

theorem 
  elementary_tree 2 = {{},<*0*>,<*1*>};



theorem 
  for T being Tree, t being Element of T holds
  t in Leaves T iff not t^<*0*> in T;

theorem 
  for T being Tree, t being Element of T holds
  t in Leaves T iff not ex n being Element of NAT st t^<*n*> in T;

definition
  func TrivialInfiniteTree equals

  { k |-> 0 where k is Element of NAT: not contradiction };
end;

registration
  cluster TrivialInfiniteTree -> non empty Tree-like;
end;

theorem 
  NAT,TrivialInfiniteTree are_equipotent;

registration
  cluster TrivialInfiniteTree -> infinite;
end;














begin

reserve f for Function;
reserve p,q for FinSequence;
reserve A,B,C,x,x1,x2,y,z for set;
reserve k,l,m,n for Nat;
reserve a for Nat;

definition
  let f,x;
  pred f is_one-to-one_at x means


  f"Im(f,x) = {x};
end;

theorem 
  f is_one-to-one_at x implies x in dom f;

theorem 
  f is_one-to-one_at x iff x in dom f & f " {f.x} = {x};

theorem 
  f is_one-to-one_at x iff x in dom f & for z st z in dom f & x <>
  z holds f.x <> f.z;

theorem 
  (for x st x in dom f holds f is_one-to-one_at x) iff f is one-to-one;

definition
  let R be Relation, y be set;
  pred R just_once_values y means


  card Coim(R,y) = 1;
end;

theorem 
  f just_once_values y implies y in rng f;

theorem 
  f just_once_values y iff ex x st {x} = f " {y};

theorem 
  f just_once_values y iff ex x st x in dom f & y = f.x & for z st
  z in dom f & z <> x holds f.z <> y;

theorem 
  f is one-to-one iff for y st y in rng f holds f just_once_values y;

theorem 
  f is_one-to-one_at x iff x in dom f & f just_once_values f.x;

definition
  let f,y;
  assume
 f just_once_values y;
  func f <- y -> set means


  it in dom f & f.it = y;
end;

theorem 
  f just_once_values y implies Im(f, f<-y) = {y};

theorem 
  f just_once_values y implies f " {y} = {f <- y};

theorem 
  f is one-to-one & y in rng f implies (f").y = f <- y;

theorem 
  f is_one-to-one_at x implies f <- (f.x) = x;

theorem 
  f just_once_values y implies f is_one-to-one_at f <- y;

reserve D for non empty set;
reserve d,d1,d2,d3 for Element of D;

definition
  let D;
  let d1,d2;
  redefine func <* d1,d2 *> -> FinSequence of D;
end;

definition
  let D;
  let d1,d2,d3;
  redefine func <* d1,d2,d3 *> -> FinSequence of D;
end;

theorem 
  for i being Nat for D being set, P being FinSequence of D st 1 <= i &
  i <= len P holds P/.i = P.i;

theorem 
  <* d *>/.1 = d;

theorem 
  <* d1,d2 *>/.1 = d1 & <* d1,d2 *>/.2 = d2;

theorem 
  <* d1,d2,d3 *>/.1 = d1 & <* d1,d2,d3 *>/.2 = d2 & <* d1,d2,d3 *>/.3 = d3;

definition
  let p,x;
  func x..p -> Element of NAT equals

  Sgm(p " {x}).1;
end;

theorem 
  x in rng p implies p.(x..p) = x;

theorem 
  x in rng p implies x..p in dom p;

theorem 
  x in rng p implies 1 <= x..p & x..p <= len p;

theorem 
  x in rng p implies x..p - 1 is Element of NAT & len p - x..p is
  Element of NAT;

theorem 
  x in rng p implies x..p in p " {x};

theorem 
  for k st k in dom p & k < x..p holds p.k <> x;

theorem 
  p just_once_values x implies p <- x = x..p;

theorem 
  p just_once_values x implies for k st k in dom p & k <> x..p holds p.k <> x;

theorem 
  x in rng p & (for k st k in dom p & k <> x..p holds p.k <> x)
  implies p just_once_values x;

theorem 
  p just_once_values x iff x in rng p & {x..p} = p " {x};

theorem 
  p is one-to-one & x in rng p implies {x..p} = p " {x};

theorem 
  p just_once_values x iff len(p - {x}) = len p - 1;

reserve L,M for Element of NAT;

theorem 
  p just_once_values x implies for k st k in dom(p - {x}) holds (k
< x..p implies (p - {x}).k = p.k) & (x..p <= k implies (p - {x}).k = p.(k + 1))
;

theorem 
  p is one-to-one & x in rng p implies for k st k in dom(p - {x}) holds
  ((p - {x}).k = p.k iff k < x..p) & ((p - {x}).k = p.(k + 1) iff x..p <= k);

definition
  let p;
  let x;
  assume
 x in rng p;
  func p -| x -> FinSequence means


  ex n st n = x..p - 1 & it = p | Seg n;
end;

theorem 
  x in rng p & n = x..p - 1 implies p | Seg n = p -| x;

theorem 
  x in rng p implies len(p -| x) = x..p - 1;

theorem 
  x in rng p & n = x..p - 1 implies dom(p -| x) = Seg n;

theorem 
  x in rng p & k in dom(p -| x) implies p.k = (p -| x).k;

theorem 
  x in rng p implies not x in rng(p -| x);

theorem 
  x in rng p implies rng(p -| x) misses {x};

theorem 
  x in rng p implies rng(p -| x) c= rng p;

theorem 
  x in rng p implies (x..p = 1 iff p -| x = {});

theorem 
  x in rng p & p is FinSequence of D implies p -| x is FinSequence of D;

definition
  let p;
  let x;
  assume
 x in rng p;
  func p |-- x -> FinSequence means


  len it = len p - x..p & for k st k in dom it holds it.k = p.(k + x..p);
end;

theorem 
  x in rng p & n = len p - x..p implies dom(p |-- x) = Seg n;

theorem 
  x in rng p & n in dom(p |-- x) implies n + x..p in dom p;

theorem 
  x in rng p implies rng(p |-- x) c= rng p;

theorem 
  p just_once_values x iff x in rng p & not x in rng(p |-- x);

theorem 
  x in rng p & p is one-to-one implies not x in rng(p |-- x);

theorem 
  p just_once_values x iff x in rng p & rng(p |-- x) misses {x};

theorem 
  x in rng p & p is one-to-one implies rng(p |-- x) misses {x};

theorem 
  x in rng p implies (x..p = len p iff p |-- x = {});

theorem 
  x in rng p & p is FinSequence of D implies p |-- x is FinSequence of D;

theorem 
  x in rng p implies p = (p -| x) ^ <* x *> ^ (p |-- x);

theorem 
  x in rng p & p is one-to-one implies p -| x is one-to-one;

theorem 
  x in rng p & p is one-to-one implies p |-- x is one-to-one;

theorem 
  p just_once_values x iff x in rng p & p - {x} = (p -| x) ^ (p |-- x);

theorem 
  x in rng p & p is one-to-one implies p - {x} = (p -| x) ^ (p |-- x);

theorem 
  x in rng p & p - {x} is one-to-one & p - {x} = (p -| x) ^ (p |--
  x) implies p is one-to-one;

theorem 
  x in rng p & p is one-to-one implies rng(p -| x) misses rng(p |-- x);

theorem 
  A is finite implies ex p st rng p = A & p is one-to-one;

theorem 
  rng p c= dom p & p is one-to-one implies rng p = dom p;

theorem 
  rng p = dom p implies p is one-to-one;

theorem 
  rng p = rng q & len p = len q & q is one-to-one implies p is one-to-one;

theorem 
  p is one-to-one iff card(rng p) = len p;





reserve f for Function of A,B;

theorem 
  for A,B being finite set, f being Function of A,B holds card A = card
  B & f is one-to-one implies rng f = B;

theorem 
  for A,B being finite set, f being Function of A,B st card A = card B &
  rng f = B holds f is one-to-one;



theorem 
  card B in card A & B <> {} implies ex x,y st x in A & y in A & x <> y
  & f.x = f.y;

theorem 
  card A in card B implies ex x st x in B & for y st y in A holds f.y <> x;

begin 


theorem 
  for D being non empty set, f being FinSequence of D, p being Element
  of D holds (f^<*p*>)/.(len f + 1) = p;



theorem 
  for E being non empty set, p,q being FinSequence of E st k in dom p
  holds (p ^ q)/.k = p/.k;

theorem 
  for E being non empty set, p,q being FinSequence of E st k in dom q
  holds (p ^ q)/.(len p + k) = q/.k;



theorem 
  for m being Nat for D being set, p being FinSequence of D st a in dom(
  p|m) holds (p|m qua FinSequence of D)/.a = p/.a;



theorem 
  for D being set, f being FinSequence of D, n,m st n in dom f & m in
  Seg n holds m in dom f & (f|n)/.m = f/.m;



theorem 
  for X being finite set st n <= card X holds ex A being finite Subset
  of X st card A = n;

reserve f for Function;

theorem 
  f is one-to-one & x in rng f implies card Coim (f,x) = 1;



definition
  let x1,x2,x3,x4 be set;
  func <*x1,x2,x3,x4*> -> set equals

  <*x1,x2,x3*>^<*x4*>;
  let x5 be set;
  func <*x1,x2,x3,x4,x5*> -> set equals

  <*x1,x2,x3*>^<*x4,x5*>;
end;

registration
  let x1,x2,x3,x4 be set;
  cluster <*x1,x2,x3,x4*> -> non empty Function-like Relation-like;
  let x5 be set;
  cluster <*x1,x2,x3,x4,x5*> -> non empty Function-like Relation-like;
end;

registration
  let x1,x2,x3,x4 be set;
  cluster <*x1,x2,x3,x4*> -> FinSequence-like;
  let x5 be set;
  cluster <*x1,x2,x3,x4,x5*> -> FinSequence-like;
end;

definition
  let D be non empty set,x1,x2,x3,x4 be Element of D;
  redefine func <* x1,x2,x3,x4*> -> FinSequence of D;
end;

definition
  let D be non empty set,x1,x2,x3,x4,x5 be Element of D;
  redefine func <*x1,x2,x3,x4,x5*> -> FinSequence of D;
end;

reserve x1,x2,x3,x4,x5 for set;

theorem 
  <*x1,x2,x3,x4*>=<*x1,x2,x3*>^<*x4*> & <*x1,x2,x3,x4*>=<*x1,x2*>^
<*x3,x4*> & <*x1,x2,x3,x4*>=<*x1*>^<*x2,x3,x4*> & <*x1,x2,x3,x4*>=<*x1*>^<*x2*>
  ^<*x3*>^<*x4*>;

theorem 
  <*x1,x2,x3,x4,x5*>=<*x1,x2,x3*>^<*x4,x5*> & <*x1,x2,x3,x4,x5*>=
<*x1,x2,x3,x4*>^<*x5*> & <*x1,x2,x3,x4,x5*>=<*x1*>^<*x2*>^<*x3*>^<*x4*>^<*x5*>
& <*x1,x2,x3,x4,x5*>=<*x1,x2*>^<*x3,x4,x5*> & <*x1,x2,x3,x4,x5*>=<*x1*>^<*x2,x3
  ,x4,x5*>;

reserve p for FinSequence;

theorem 
  p = <*x1,x2,x3,x4*> iff len p = 4 & p.1 = x1 & p.2 = x2 & p.3=x3 & p.4= x4;

canceled;

theorem 
  p = <*x1,x2,x3,x4,x5*> iff len p = 5 & p.1 = x1 & p.2 = x2 & p.3
  =x3 & p.4= x4 & p.5= x5;

reserve ND for non empty set;
reserve y1,y2,y3,y4,y5 for Element of ND;

canceled;

theorem 
  <*y1,y2,y3,y4*>/.1 = y1 & <*y1,y2,y3,y4*>/.2 = y2 & <*y1,y2,y3,y4*>/.3
  = y3 & <*y1,y2,y3,y4*>/.4=y4;

theorem 
  <*y1,y2,y3,y4,y5*>/.1 = y1 & <*y1,y2,y3,y4,y5*>/.2 = y2 & <*y1,y2,y3,
  y4,y5*>/.3 = y3 & <*y1,y2,y3,y4,y5*>/.4=y4 & <*y1,y2,y3,y4,y5*>/.5=y5;



scheme 

  Sch1{D()->non empty set, N()->Nat, P[set,set]}: ex f being FinSequence of D(
  ) st len f = N() & for n st n in Seg N() holds P[n,f/.n]
provided
 for n st n in Seg N() ex d being Element of D() st P[n,d];



theorem 
  for D being non empty set, p,q being FinSequence of D st p c= q
  holds ex p9 being FinSequence of D st p ^ p9 = q;

theorem 
  for D being non empty set, p,q being FinSequence of D, i being Element
  of NAT st p c= q & 1 <= i & i <= len p holds q.i = p.i;



scheme 

  PiLambdaD{D()-> non empty set, l()->Nat, F(set)-> Element of D()}: ex g
being FinSequence of D() st len g=l() & for n being Nat st n in dom g holds g/.
  n=F(n);



registration
  let x1,x2,x3,x4 be set;
  cluster <*x1,x2,x3,x4*> -> 4-element;
  let x5 be set;
  cluster <*x1,x2,x3,x4,x5*> -> 5-element;
end;

begin 

theorem 
  for m, n being Nat holds m < n implies ex p being Element of NAT
  st n = m+p & 1 <= p;

theorem 
  for S being set, D1, D2 being non empty set, f1 being Function of
  S, D1, f2 being Function of D1, D2 holds f1 is bijective & f2 is bijective
  implies f2*f1 is bijective;



theorem 
  for Y being set, E1, E2 being Equivalence_Relation of Y holds
  Class E1 = Class E2 implies E1 = E2;

registration
  let Z be finite set;
  cluster -> finite for a_partition of Z;
end;

registration
  let X be non empty finite set;
  cluster non empty finite for a_partition of X;
end;

reserve X, A for non empty finite set,
  PX for a_partition of X,
  PA1, PA2 for a_partition of A;

theorem 
  for X being non empty set, PX being a_partition of X for Pi
  being set st Pi in PX ex x being Element of X st x in Pi;

theorem 
  card PX <= card X;

theorem 
  PA1 is_finer_than PA2 implies card PA2 <= card PA1;

theorem 
  PA1 is_finer_than PA2 implies for p2 being Element of PA2 ex p1
  being Element of PA1 st p1 c=p2;

theorem 
  PA1 is_finer_than PA2 & card PA1 = card PA2 implies PA1 = PA2;

registration
  let D be set, M be FinSequence of D*;
  let k;
  cluster M/.k  -> Function-like Relation-like;
  
end;

registration
  let D be set, M be FinSequence of D*;
  let k;
  cluster M/.k -> FinSequence-like D-valued for Function;
end;















begin

reserve x,y,y1,y2 for set,
  D for non empty set,
  d,d1,d2,d3 for Element of D,
  F ,G,H,H1,H2 for FinSequence of D,
  f,f1,f2 for Function of NAT,D,
  g for BinOp of D,
  k,n,i,l for Element of NAT,
  P for Permutation of dom F;

definition
  let D,F,g;
  assume
 g is having_a_unity or len F >= 1;
  func g "**" F -> Element of D means


  it = the_unity_wrt g if g is
having_a_unity & len F = 0 otherwise ex f st f.1 = F.1 & (for n st 0 <> n & n <
  len F holds f.(n + 1) = g.(f.n,F.(n + 1))) & it = f.(len F);
end;

theorem 
  len F >= 1 implies ex f st f.1 = F.1 & (for n st 0 <> n & n < len F
  holds f.(n + 1) = g.(f.n,F.(n + 1))) & g "**" F = f.(len F);

theorem 
  len F >= 1 & (ex f st f.1 = F.1 & (for n st 0 <> n & n < len F holds f
  .(n + 1) = g.(f.n,F.(n + 1))) & d = f.(len F)) implies d = g "**" F;

definition
  let A be non empty set, F be Function of NAT,A, p be FinSequence of A;
  redefine func F +* p -> Function of NAT,A;
end;

notation
  let f be FinSequence;
  synonym findom f for dom f;
end;

definition
  let f be FinSequence;
  redefine func findom f -> Element of Fin NAT;
end;

theorem 
  (g is having_a_unity or len F >= 1) & g is associative & g is
  commutative implies g "**" F = g $$(findom F,(NAT-->the_unity_wrt g)+*F);

theorem 
  g is having_a_unity or len F >= 1 implies g "**" (F ^ <* d *>) =
  g.(g "**" F,d);

theorem 
  g is associative & (g is having_a_unity or len F >= 1 & len G >=
  1) implies g "**" (F ^ G) = g.(g "**" F,g "**" G);

theorem 
  g is associative & (g is having_a_unity or len F >= 1) implies g
  "**" (<* d *> ^ F) = g.(d,g "**" F);

theorem 
  g is commutative associative & (g is having_a_unity or len F >= 1
  ) & G = F * P implies g "**" F = g "**" G;

theorem 
  (g is having_a_unity or len F >= 1) & g is associative commutative & F
  is one-to-one & G is one-to-one & rng F = rng G implies g "**" F = g "**" G;

theorem 
  g is associative commutative & (g is having_a_unity or len F >= 1) &
  len F = len G & len F = len H & (for k st k in dom F holds F.k = g.(G.k,H.k))
  implies g "**" F = g.(g "**" G,g "**" H);

theorem 
  g is having_a_unity implies g "**" <*>D = the_unity_wrt g;

theorem 
  g "**" <* d *> = d;

theorem 
  g "**" <* d1,d2 *> = g.(d1,d2);

theorem 
  g is commutative implies g "**" <* d1,d2 *> = g "**" <* d2,d1 *>;

theorem 
  g "**" <* d1,d2,d3 *> = g.(g.(d1,d2),d3);

theorem 
  g is commutative implies g "**" <* d1,d2,d3 *> = g "**" <* d2,d1,d3 *>;

theorem 
  g "**" (1 |-> d) = d;

theorem 
  g "**" (2 |-> d) = g.(d,d);

theorem 
  g is associative & (g is having_a_unity or k <> 0 & l <> 0)
  implies g "**" ((k + l) |-> d) = g.(g "**" (k |-> d),g "**" (l |-> d));

theorem 
  g is associative & (g is having_a_unity or k <> 0 & l <> 0) implies g
  "**" (k * l |-> d) = g "**" (l |-> (g "**" (k |-> d)));

theorem 
  len F = 1 implies g "**" F = F.1;

theorem 
  len F = 2 implies g "**" F = g.(F.1,F.2);














begin

reserve x,y for set;
reserve C,C9,D,E for non empty set;
reserve c,c9,c1,c2,c3 for Element of C;
reserve B,B9,B1,B2 for Element of Fin C;
reserve A for Element of Fin C9;
reserve d,d1,d2,d3,d4,e for Element of D;
reserve F,G for BinOp of D;
reserve u for UnOp of D;
reserve f,f9 for Function of C,D;
reserve g for Function of C9,D;
reserve H for BinOp of E;
reserve h for Function of D,E;
reserve i,j for Nat;
reserve s for Function;
reserve p,q for FinSequence of D;
reserve T1,T2 for Element of i-tuples_on D;

theorem 
  F is commutative associative & c1 <> c2 implies F $$ ({.c1,c2.},f
  ) = F.(f.c1, f.c2);

theorem 
  F is commutative associative & (B <> {} or F is having_a_unity) &
  not c in B implies F $$(B \/ {.c.}, f) = F.(F $$(B,f),f.c);

theorem 
  F is commutative associative & c1 <> c2 & c1 <> c3 & c2 <> c3 implies
  F $$ ({.c1,c2,c3.},f) = F.(F.(f.c1, f.c2),f.c3);

theorem 
  F is commutative associative & (B1 <> {} & B2 <> {} or F is
having_a_unity) & B1 misses B2 implies F $$(B1 \/ B2, f) = F.(F $$(B1,f),F $$(
  B2,f));

theorem 
  F is commutative associative & (A <> {} or F is having_a_unity) &
(ex s st dom s = A & rng s = B & s is one-to-one & g|A = f*s) implies F $$(A,g)
  = F $$(B,f);

theorem 
  H is commutative associative & (B <> {} or H is having_a_unity) & f is
  one-to-one implies H $$(f.:B,h) = H $$(B,h*f);

theorem 
  F is commutative associative & (B <> {} or F is having_a_unity) & f|B
  = f9|B implies F $$(B,f) = F $$(B,f9);

theorem 
  F is commutative associative & F is having_a_unity & e = the_unity_wrt
  F & f.:B = {e} implies F$$(B,f) = e;

theorem 
  F is commutative associative & F is having_a_unity & e =
the_unity_wrt F & G.(e,e) = e & (for d1,d2,d3,d4 holds F.(G.(d1,d2),G.(d3,d4))=
  G.(F.(d1,d3),F.(d2,d4))) implies G.(F$$(B,f),F$$(B,f9)) = F $$(B,G.:(f,f9));

theorem 
  F is commutative associative & F is having_a_unity implies F.(F$$(B,f)
  ,F$$(B,f9)) = F $$(B,F.:(f,f9));

theorem 
  F is commutative associative & F is having_a_unity & F is
having_an_inverseOp & G = F*(id D,the_inverseOp_wrt F) implies G.(F$$(B,f),F$$(
  B,f9)) = F $$(B,G.:(f,f9));

theorem 
  F is commutative associative & F is having_a_unity & e =
the_unity_wrt F & G is_distributive_wrt F & G.(d,e) = e implies G.(d,F$$(B,f))
  = F $$(B,G[;](d,f));

theorem 
  F is commutative associative & F is having_a_unity & e =
the_unity_wrt F & G is_distributive_wrt F & G.(e,d) = e implies G.(F$$(B,f),d)
  = F $$(B,G[:](f,d));

theorem 
  F is commutative associative & F is having_a_unity & F is
having_an_inverseOp & G is_distributive_wrt F implies G.(d,F$$(B,f)) = F $$(B,G
  [;](d,f));

theorem 
  F is commutative associative & F is having_a_unity & F is
having_an_inverseOp & G is_distributive_wrt F implies G.(F$$(B,f),d) = F $$(B,G
  [:](f,d));

theorem 
  F is commutative associative & F is having_a_unity & H is
  commutative associative & H is having_a_unity & h.the_unity_wrt F =
the_unity_wrt H & (for d1,d2 holds h.(F.(d1,d2)) = H.(h.d1,h.d2)) implies h.(F
  $$(B,f)) = H $$(B,h*f);

theorem 
  F is commutative associative & F is having_a_unity & u.the_unity_wrt F
= the_unity_wrt F & u is_distributive_wrt F implies u.(F$$(B,f)) = F $$(B,u*f);

theorem 
  F is commutative associative & F is having_a_unity & F is
having_an_inverseOp & G is_distributive_wrt F implies G[;](d,id D).(F$$(B,f)) =
  F $$(B,G[;](d,id D)*f);

theorem 
  F is commutative associative & F is having_a_unity & F is
  having_an_inverseOp implies (the_inverseOp_wrt F).(F$$(B,f)) = F $$(B,(
  the_inverseOp_wrt F)*f);

definition
  let D,p,d;
  func [#](p,d) -> Function of NAT,D equals

  (NAT --> d) +* p;
end;

theorem 
  (i in dom p implies [#](p,d).i = p.i) & (not i in dom p implies
  [#](p,d).i = d);

theorem 
  [#](p,d)|(dom p) = p;

theorem 
  [#](p^q,d)|(dom p) = p;

theorem 
  rng [#](p,d) = rng p \/ {d};

theorem 
  h*[#](p,d) = [#](h*p,h.d);

notation
  let i be Nat;
  synonym finSeg i for Seg i;
end;

definition
  let i be Nat;
  redefine func finSeg i -> Element of Fin NAT;
end;

notation
  let D,p,F;
  synonym F $$ p for F "**" p;
end;

definition
  let D,p,F;
  assume
 ( F is having_a_unity or len p >= 1)& F is associative commutative;
  redefine func F $$ p equals


  F $$(findom p,[#](p,the_unity_wrt F));
end;

theorem 
  F is having_a_unity implies F"**"(i|->the_unity_wrt F) = the_unity_wrt F;

theorem 
  F is associative & (i>=1 & j>=1 or F is having_a_unity) implies
  F"**"((i+j)|->d) = F.(F"**"(i|->d),F"**"(j|->d));

theorem 
  F is commutative associative & (i>=1 & j>=1 or F is having_a_unity)
  implies F"**"((i*j)|->d) = F"**"(j|->(F"**"(i|->d)));

theorem 
  F is having_a_unity & H is having_a_unity & h.the_unity_wrt F =
the_unity_wrt H & (for d1,d2 holds h.(F.(d1,d2)) = H.(h.d1,h.d2)) implies h.(F
  "**"p) = H "**"(h*p);

theorem 
  F is having_a_unity & u.the_unity_wrt F = the_unity_wrt F & u
  is_distributive_wrt F implies u.(F"**"p) = F "**"(u*p);

theorem 
  F is associative & F is having_a_unity & F is having_an_inverseOp & G
  is_distributive_wrt F implies G[;](d,id D).(F"**"p) = F "**"(G[;](d,id D)*p);

theorem 
  F is commutative associative & F is having_a_unity & F is
  having_an_inverseOp implies (the_inverseOp_wrt F).(F"**"p) = F "**"((
  the_inverseOp_wrt F)*p);

theorem 
  F is commutative associative & F is having_a_unity & e =
the_unity_wrt F & G.(e,e) = e & (for d1,d2,d3,d4 holds F.(G.(d1,d2),G.(d3,d4))=
G.(F.(d1,d3),F.(d2,d4))) & len p = len q implies G.(F"**"p,F"**"q) = F "**"(G.:
  (p,q));

theorem 
  F is commutative associative & F is having_a_unity & e =
the_unity_wrt F & G.(e,e) = e & (for d1,d2,d3,d4 holds F.(G.(d1,d2),G.(d3,d4))=
  G.(F.(d1,d3),F.(d2,d4))) implies G.(F"**"T1,F"**"T2) = F "**"(G.:(T1,T2));

theorem 
  F is commutative associative & F is having_a_unity & len p = len
  q implies F.(F"**"p,F"**"q) = F "**"(F.:(p,q));

theorem 
  F is commutative associative & F is having_a_unity implies
  F.(F"**"T1,F"**"T2) = F "**"(F.:(T1,T2));

theorem 
  F is commutative associative & F is having_a_unity implies
  F"**"(i|->(F.(d1,d2))) = F.(F"**"(i|->d1),F"**"(i|->d2));

theorem 
  F is commutative associative & F is having_a_unity & F is
having_an_inverseOp & G = F*(id D,the_inverseOp_wrt F) implies G.(F"**"T1,F"**"
  T2) = F "**"(G.:(T1,T2));

theorem 
  F is commutative associative & F is having_a_unity & e =
the_unity_wrt F & G is_distributive_wrt F & G.(d,e) = e implies G.(d,F"**"p) =
  F "**"(G[;](d,p));

theorem 
  F is commutative associative & F is having_a_unity & e =
the_unity_wrt F & G is_distributive_wrt F & G.(e,d) = e implies G.(F"**"p,d) =
  F "**"(G[:](p,d));

theorem 
  F is commutative associative & F is having_a_unity & F is
  having_an_inverseOp & G is_distributive_wrt F implies G.(d,F"**"p) = F "**"(G
  [;](d,p));

theorem 
  F is commutative associative & F is having_a_unity & F is
  having_an_inverseOp & G is_distributive_wrt F implies G.(F"**"p,d) = F "**"(G
  [:](p,d));














begin

reserve x,X,Y for set;
reserve C for non empty set;
reserve c for Element of C;
reserve f,f1,f2,f3,g,g1 for complex-valued Function;
reserve r,p for complex number;





definition
  let f1,f2 be complex-valued Function;

  func f1/f2 -> Function means


  dom it = dom f1 /\ (dom f2 \ f2"{0}) &
  for c being set st c in dom it holds it.c = f1.c * (f2.c)";
end;

registration
  let f1, f2 be complex-valued Function;
  cluster f1/f2 -> complex-valued;
end;

registration
  let f1, f2 be real-valued Function;
  cluster f1/f2 -> real-valued;
end;

definition
  let C be set, D be complex-membered set;
  let f1, f2 be PartFunc of C,D;
  redefine func f1/f2 -> PartFunc of C,COMPLEX;
end;

definition
  let C be set, D be real-membered set;
  let f1, f2 be PartFunc of C,D;
  redefine func f1/f2 -> PartFunc of C,REAL;
end;

definition
  let f be complex-valued Function;

  func f^ -> Function means


  dom it = dom f \ f"{0} & for c being set st c in dom it holds it.c = (f.c)";
end;

registration
  let f be complex-valued Function;
  cluster f^ -> complex-valued;
end;

registration
  let f be real-valued Function;
  cluster f^ -> real-valued;
end;

definition
  let C be set, D be complex-membered set, f be PartFunc of C,D;
  redefine func f^ -> PartFunc of C,COMPLEX;
end;

definition
  let C be set, D be real-membered set, f be PartFunc of C,D;
  redefine func f^ -> PartFunc of C,REAL;
end;

theorem 
  dom (g^) c= dom g & dom g /\ (dom g \ g"{0}) = dom g \ g"{0};

theorem 
  dom (f1(#)f2) \ (f1(#)f2)"{0} = (dom f1 \ f1"{0}) /\ (dom f2 \ f2"{0});

theorem 
  c in dom (f^) implies f.c <> 0;

theorem 
  (f^)"{0} = {};

theorem 
  (abs(f))"{0} = f"{0} & (-f)"{0} = f"{0};

theorem 
  dom (f^^) = dom (f|(dom (f^)));

theorem 
  r<>0 implies (r(#)f)"{0} = f"{0};





theorem 
  (f1 + f2) + f3 = f1 + (f2 + f3);

theorem 
  (f1 (#) f2) (#) f3 = f1 (#) (f2 (#) f3);

theorem 
  (f1 + f2) (#) f3=f1 (#) f3 + f2 (#) f3;

theorem 
  f3 (#) (f1 + f2)=f3(#)f1 + f3(#)f2;

theorem 
  r(#)(f1(#)f2)=r(#)f1(#)f2;

theorem 
  r(#)(f1(#)f2)=f1(#)(r(#)f2);

theorem 
  (f1 - f2)(#)f3=f1(#)f3 - f2(#)f3;

theorem 
  f3(#)f1 - f3(#)f2 = f3(#)(f1 - f2);

theorem 
  r(#)(f1 + f2) = r(#)f1 + r(#)f2;

theorem 
  (r*p)(#)f = r(#)(p(#)f);

theorem 
  r(#)(f1 - f2) = r(#)f1 - r(#)f2;

theorem 
  f1-f2 = (-1)(#)(f2-f1);

theorem 
  f1 - (f2 + f3) = f1 - f2 - f3;

theorem 
  1(#)f = f;

theorem 
  f1 - (f2 - f3) = f1 - f2 + f3;

theorem 
  f1 + (f2 - f3) = f1 + f2 - f3;

theorem 
  abs(f1(#)f2) = abs(f1)(#)abs(f2);

theorem 
  abs(r(#)f) = abs(r)(#)abs(f);

theorem 
  f^^ = f|(dom (f^));

theorem 
  (f1(#)f2)^ = (f1^)(#)(f2^);

theorem 
  r<>0 implies (r(#)f)^ = r" (#) (f^);

theorem 
  (-f)^ = (-1)(#)(f^);

theorem 
  (abs(f))^ = abs(f^);

theorem 
  f/g = f(#) (g^);

theorem 
  r(#)(g/f) = (r(#)g)/f;

theorem 
  (f/g)(#)g = (f|dom(g^));

theorem 
  (f/g)(#)(f1/g1) = (f(#)f1)/(g(#)g1);

theorem 
  (f1/f2)^ = (f2|dom(f2^))/f1;

theorem 
  g (#) (f1/f2) = (g (#) f1)/f2;

theorem 
  g/(f1/f2) = (g(#)(f2|dom(f2^)))/f1;

theorem 
  -f/g = (-f)/g & f/(-g) = -f/g;

theorem 
  f1/f + f2/f = (f1 + f2)/f & f1/f - f2/f = (f1 - f2)/f;

theorem 
  f1/f + g1/g = (f1(#)g + g1(#)f)/(f(#)g);

theorem 
  (f/g)/(f1/g1) = (f(#)(g1|dom(g1^)))/(g(#)f1);

theorem 
  f1/f - g1/g = (f1(#)g - g1(#)f)/(f(#)g);

theorem 
  abs(f1/f2) = abs(f1)/abs(f2);

theorem 
  (f1+f2)|X = f1|X + f2|X & (f1+f2)|X = f1|X + f2 & (f1+f2)|X = f1 + f2|X;

theorem 
  (f1(#)f2)|X = f1|X (#) f2|X & (f1(#)f2)|X = f1|X (#) f2 & (f1(#)
  f2)|X = f1 (#) f2|X;

theorem 
  (-f)|X = -(f|X) & (f^)|X = (f|X)^ & (abs(f))|X = abs((f|X));

theorem 
  (f1-f2)|X = f1|X - f2|X & (f1-f2)|X = f1|X - f2 & (f1-f2)|X = f1 - f2| X;

theorem 
  (f1/f2)|X = f1|X / f2|X & (f1/f2)|X = f1|X / f2 &(f1/f2)|X = f1 / f2|X;

theorem 
  (r(#)f)|X = r(#)(f|X);





reserve r,r1,r2,p for real number;
reserve f,f1,f2 for PartFunc of C,REAL;

theorem 
  (f1 is total & f2 is total iff f1+f2 is total) & (f1 is total &
  f2 is total iff f1-f2 is total) & (f1 is total & f2 is total iff f1(#)f2 is
  total);

theorem 
  f is total iff r(#)f is total;

theorem 
  f is total iff -f is total;

theorem 
  f is total iff abs(f) is total;

theorem 
  f^ is total iff f"{0} = {} & f is total;

theorem 
  f1 is total & f2"{0} = {} & f2 is total iff f1/f2 is total;

theorem 
  f1 is total & f2 is total implies (f1+f2).c = f1.c + f2.c & (f1-f2).c
  = f1.c - f2.c & (f1(#)f2).c = f1.c * f2.c;

theorem 
  f is total implies (r(#)f).c = r * (f.c);

theorem 
  f is total implies (-f).c = - f.c & (abs(f)).c = abs( f.c );

theorem 
  f^ is total implies (f^).c = (f.c)";

theorem 
  f1 is total & f2^ is total implies (f1/f2).c = f1.c *(f2.c)";





definition
  let X,C be set;
  redefine func chi(X,C) -> PartFunc of C,REAL;
end;

registration
  let X,C be set;
  cluster chi(X,C) -> total for PartFunc of C,REAL;
end;

theorem 
  f= chi(X,C) iff ( dom f = C & for c holds (c in X implies f.c =
  1) & (not c in X implies f.c = 0));

theorem 
  chi(X,C) is total;

theorem 
  c in X iff chi(X,C).c = 1;

theorem 
  not c in X iff chi(X,C).c = 0;

theorem 
  c in C \ X iff chi(X,C).c = 0;

theorem 
  chi(C,C).c = 1;

theorem 
  chi(X,C).c <> 1 iff chi(X,C).c = 0;

theorem 
  X misses Y implies chi(X,C) + chi(Y,C) = chi(X \/ Y,C);

theorem 
  chi(X,C) (#) chi(Y,C) = chi(X /\ Y,C);





reserve f for real-valued Function;

theorem 
  f|Y is bounded_above iff ex r st for c being set st c in Y /\
  dom f holds f.c <= r;

theorem 
  f|Y is bounded_below iff ex r st for c being set st c in Y /\
  dom f holds r <= f.c;

theorem 
  f is bounded iff ex r st for c being set st c in dom f holds abs (f.c)<=r;

theorem 
  f|Y is bounded iff ex r st for c being set st c in Y /\ dom f holds
  abs(f.c)<=r;

theorem 
  (Y c= X & f|X is bounded_above implies f|Y is bounded_above) & (Y c= X
& f|X is bounded_below implies f|Y is bounded_below) & (Y c= X & f|X is bounded
  implies f|Y is bounded);

theorem 
  f|X is bounded_above & f|Y is bounded_below implies f|(X /\ Y) is bounded;

registration
  cluster constant -> bounded for real-valued Function;
end;

theorem 
  X misses dom f implies f|X is bounded;

theorem 
  (0(#)f)|Y is bounded;

registration
  let f be bounded_above real-valued Function, X be set;
  cluster f|X -> bounded_above for real-valued Function;
end;

registration
  let f be bounded_below real-valued Function, X be set;
  cluster f|X -> bounded_below for real-valued Function;
end;

registration
  let f be bounded_above real-valued Function;
  let r be non negative real number;
  cluster r(#)f -> bounded_above for real-valued Function;
end;

registration
  let f be bounded_below real-valued Function;
  let r be non negative real number;
  cluster r(#)f -> bounded_below for real-valued Function;
end;

registration
  let f be bounded_above real-valued Function;
  let r be non positive real number;
  cluster r(#)f -> bounded_below for real-valued Function;
end;

registration
  let f be bounded_below real-valued Function;
  let r be non positive real number;
  cluster r(#)f -> bounded_above for real-valued Function;
end;

theorem 
  (f|Y is bounded_above & 0<=r implies (r(#)f)|Y is bounded_above)
  & (f|Y is bounded_above & r<=0 implies (r(#)f)|Y is bounded_below);

theorem 
  (f|Y is bounded_below & 0<=r implies (r(#)f)|Y is bounded_below)
  & (f|Y is bounded_below & r<=0 implies (r(#)f)|Y is bounded_above);

theorem 
  f|Y is bounded implies (r(#)f)|Y is bounded;

registration
  let f;
  cluster abs f -> bounded_below;
end;

theorem 
  (abs f)|X is bounded_below;

registration
  let f be bounded real-valued Function;
  cluster abs f -> bounded for real-valued Function;
end;

registration
  let f be bounded_above real-valued Function;
  cluster -f -> bounded_below for real-valued Function;
end;

theorem 
  f|Y is bounded implies (abs f)|Y is bounded & (-f)|Y is bounded;

reserve f1,f2 for real-valued Function;

registration
  let f1,f2 be bounded_above real-valued Function;
  cluster f1+f2 -> bounded_above for real-valued Function;
end;

registration
  let f1,f2 be bounded_below real-valued Function;
  cluster f1+f2 -> bounded_below for real-valued Function;
end;

theorem 
  (f1|X is bounded_above & f2|Y is bounded_above implies (f1+f2)|
  (X /\ Y) is bounded_above) & (f1|X is bounded_below & f2|Y is bounded_below
implies (f1+f2)|(X /\ Y) is bounded_below) & (f1|X is bounded & f2|Y is bounded
  implies (f1+f2)|(X /\ Y) is bounded);

registration
  let f1,f2 be bounded real-valued Function;
  cluster f1(#)f2 -> bounded for real-valued Function;
end;

theorem 
  f1|X is bounded & f2|Y is bounded implies (f1(#)f2)|(X /\ Y) is
  bounded & (f1-f2)|(X /\ Y) is bounded;

theorem 
  f|X is bounded_above & f|Y is bounded_above implies f|(X \/ Y)
  is bounded_above;

theorem 
  f|X is bounded_below & f|Y is bounded_below implies f|(X \/ Y)
  is bounded_below;

theorem 
  f|X is bounded & f|Y is bounded implies f|(X \/ Y) is bounded;

reserve f,f1,f2 for PartFunc of C,REAL;

registration
  let C;
  let f1,f2 be constant PartFunc of C,REAL;
  cluster f1+f2 -> constant;
  cluster f1-f2 -> constant;
  cluster f1(#)f2 -> constant;
end;

theorem 
  f1|X is constant & f2|Y is constant implies (f1+f2)|(X /\ Y) is
  constant & (f1-f2)|(X /\ Y) is constant & (f1(#)f2)|(X /\ Y) is constant;

registration
  let C;
  let f be constant PartFunc of C,REAL;
  cluster -f -> constant;
  cluster abs f -> constant;
  let p;
  cluster p(#)f -> constant;
end;

theorem 
  f|Y is constant implies (p(#)f)|Y is constant;

theorem 
  f|Y is constant implies (-f)|Y is constant;

theorem 
  f|Y is constant implies (abs f)|Y is constant;

theorem 
  f|Y is constant implies (for r holds (r(#)f)|Y is bounded) & (-f)|Y is
  bounded & (abs f)|Y is bounded;

theorem 
  (f1|X is bounded_above & f2|Y is constant implies (f1+f2)|(X /\ Y) is
  bounded_above) & (f1|X is bounded_below & f2|Y is constant implies (f1+f2)|(X
/\ Y) is bounded_below) & (f1|X is bounded & f2|Y is constant implies (f1+f2)|(
  X /\ Y) is bounded);

theorem 
  (f1|X is bounded_above & f2|Y is constant implies (f1-f2)|(X /\ Y) is
  bounded_above) & (f1|X is bounded_below & f2|Y is constant implies (f1-f2)|(X
/\ Y) is bounded_below) & (f1|X is bounded & f2|Y is constant implies (f1-f2)|(
X /\ Y) is bounded & (f2-f1)|(X /\ Y) is bounded& (f1(#)f2)|(X /\ Y) is bounded
  );














begin 

registration
  let n be Nat;
  cluster n-element natural-valued for FinSequence;
end;

registration
  cluster real-valued for FinSequence;
end;

definition
  let F be real-valued Relation;
  redefine func rng F -> Subset of REAL;
end;

registration
  let D be non empty set;
  let F be Function of REAL,D;
  let F1 be real-valued FinSequence;
  cluster F*F1 -> FinSequence-like;
end;

registration
  let r be real number;
  cluster <*r*> -> real-valued;
end;

registration
  let r1, r2 be real number;
  cluster <*r1, r2*> -> real-valued;
end;

registration
  let r1, r2, r3 be real number;
  cluster <*r1, r2, r3*> -> real-valued;
end;

registration
  let r1, r2, r3, r4 be real number;
  cluster <*r1, r2, r3, r4*> -> real-valued;
end;

registration
  let j be Nat, r be real number;
  cluster j |-> r -> real-valued;
end;

registration
  let f, g be real-valued FinSequence;
  cluster f ^ g -> real-valued;
end;

reserve s for set,
  i,j,k for Nat,
  x,x1,x2,x3 for Element of REAL,
  r,r1,r2,r3,r4 for real number,
  F,F1,F2,F3 for real-valued FinSequence,
  R,R1,R2 for Element of i-tuples_on REAL;

theorem 
  0 is_a_unity_wrt addreal;

definition
  redefine func diffreal equals

  addreal*(id REAL,compreal);
end;

definition
  func sqrreal -> UnOp of REAL means


  for r holds it.r = r^2;
end;

theorem 
  1 is_a_unity_wrt multreal;

theorem 
  multreal is_distributive_wrt addreal;

theorem 
  sqrreal is_distributive_wrt multreal;

definition
  let x be real number;
  func x multreal -> UnOp of REAL equals

  multreal[;](x,id REAL);
end;

theorem 
  (r multreal).r1 = r*r1;

theorem 
  r multreal is_distributive_wrt addreal;

theorem 
  compreal is_an_inverseOp_wrt addreal;

theorem 
  addreal is having_an_inverseOp;

theorem 
  the_inverseOp_wrt addreal = compreal;

theorem 
  compreal is_distributive_wrt addreal;

definition
  let F1,F2;
  redefine func F1 + F2 -> FinSequence of REAL equals

  addreal.:(F1,F2);
  commutativity;
end;

definition
  let i,R1,R2;
  redefine func R1 + R2 -> Element of i-tuples_on REAL;
end;

theorem 
  (R1+R2).s = R1.s + R2.s;

theorem 
  <*>REAL + F = <*>REAL;

theorem 
  <*r1*> + <*r2*> = <*r1+r2*>;

theorem 
  (i|->r1) + (i|->r2) = i|->(r1+r2);

theorem 
  F1 + (F2 + F3) = F1 + F2 + F3;

theorem 
  R + (i|->(0 qua Real)) = R;

theorem 
  (-F).s = -F.s;

definition
  let F;
  redefine func -F -> FinSequence of REAL equals

  compreal*F;
end;

definition
  let i,R;
  redefine func -R -> Element of i-tuples_on REAL;
end;

theorem 
  (-F).s = -(F.s);

theorem 
  -(<*>REAL) = <*>REAL;

theorem 
  -<*r*> = <*-r*>;

theorem 
  -(i|->r) = i|->-r;

theorem 
  R + -R = i|->0;

theorem 
  R1 + R2 = i|->0 implies R1 = -R2;

theorem 
  for R1, R2 being complex-valued Function st -R1 = -R2 holds R1 = R2;

theorem 
  R1 + R = R2 + R implies R1 = R2;

theorem 
  -(F1 + F2) = -F1 + -F2;

definition
  let F1,F2;
  redefine func F1 - F2 -> FinSequence of REAL equals

  diffreal.:(F1,F2);
end;

definition
  let i,R1,R2;
  redefine func R1 - R2 -> Element of i-tuples_on REAL;
end;

theorem 
  (R1-R2).s = R1.s - R2.s;

theorem 
  <*>REAL - F = <*>REAL & F - <*>REAL = <*>REAL;

theorem 
  <*r1*> - <*r2*> = <*r1-r2*>;

theorem 
  (i|->r1) - (i|->r2) = i|->(r1-r2);

theorem 
  F1 - F2 = F1 + - F2;

theorem 
  R - (i|->(0 qua Real)) = R;

theorem 
  (i|->(0 qua Real)) - R = -R;

theorem 
  F1 - -F2 = F1 + F2;

theorem 
  -(F1 - F2) = F2 - F1;

theorem 
  -(F1 - F2) = -F1 + F2;

theorem 
  R - R = i|->0;

theorem 
  R1 - R2 = i|->0 implies R1 = R2;

theorem 
  F1 - F2 - F3 = F1 - (F2 + F3);

theorem 
  F1 + (F2 - F3) = F1 + F2 - F3;

theorem 
  F1 - (F2 - F3) = F1 - F2 + F3;

theorem 
  R1 = R1 + R - R;

theorem 
  R1 = R1 - R + R;

notation
  let F,r;
  synonym r*F for r(#)F;
end;

theorem 
  (r*F).s = r*(F.s);

definition
  let F,r;
  redefine func r*F -> FinSequence of REAL equals

  (r multreal)*F;
end;

definition
  let i,R,r;
  redefine func r*R -> Element of i-tuples_on REAL;
end;

theorem 
  (r*F).s = r*(F.s);

theorem 
  r*(<*>REAL) = <*>REAL;

theorem 
  r*<*r1*> = <*r*r1*>;

theorem 
  r1*(i|->r2) = i|->(r1*r2);

theorem 
  (r1*r2)*F = r1*(r2*F);

theorem 
  (r1 + r2)*F = r1*F + r2*F;

theorem 
  r*(F1+F2) = r*F1 + r*F2;

theorem 
  1*F = F;

theorem 
  0*R = i|->0;

theorem 
  (-1)*F = -F;

notation
  let F;
  synonym sqr F for F^2;
end;

definition
  let F;
  redefine func sqr F -> FinSequence of REAL equals

  sqrreal*F;
end;

definition
  let i,R;
  redefine func sqr R -> Element of i-tuples_on REAL;
end;

theorem 
  sqr <*r*> = <*r^2*>;

theorem 
  sqr(i |-> r) = i |-> r^2;

theorem 
  sqr -F = sqr F;

theorem 
  sqr (r*F) = r^2 * sqr F;

notation
  let F1,F2;
  synonym mlt(F1,F2) for F1(#)F2;
end;

definition
  let F1,F2;
  redefine func mlt(F1,F2) -> FinSequence of REAL equals

  multreal.:(F1,F2);
  commutativity;
end;

theorem 
  mlt(F1,F2).s = F1.s * F2.s;

definition
  let i,R1,R2;
  redefine func mlt(R1,R2) -> Element of i-tuples_on REAL;
end;

theorem 
  mlt(F1,F2).s = F1.s * F2.s;

theorem 
  mlt(<*>REAL,F) = <*>REAL;

theorem 
  mlt(<*r1*>,<*r2*>) = <*r1*r2*>;

theorem 
  mlt(i|->r,R) = r*R;

theorem 
  mlt(i|->r1,i|->r2) = i|->(r1*r2);

theorem 
  r*mlt(F1,F2) = mlt(r*F1,F2);

theorem 
  r*R = mlt(i|->r,R);

theorem 
  sqr(F) = mlt(F,F);

theorem 
  sqr(F1 + F2) = sqr F1 + 2*mlt(F1,F2) + sqr F2;

theorem 
  sqr(F1 - F2) = sqr F1 - 2*mlt(F1,F2) + sqr F2;

theorem 
  sqr mlt(F1,F2) = mlt(sqr F1,sqr F2);



notation
  let F be Relation;
  synonym F is complex-yielding for F is complex-valued;
end;

registration
  cluster -> complex-valued for FinSequence of COMPLEX;
  cluster real-valued complex-valued for FinSequence;
end;

definition
  let F be complex-valued FinSequence;

  func Sum F -> complex number means


  ex f being FinSequence of COMPLEX st f = F & it = addcomplex $$ f;
end;

registration
  let F be real-valued FinSequence;
  cluster Sum F -> real;
end;

theorem 
  for F being FinSequence of REAL holds Sum F = addreal $$ F;

definition
  let F be FinSequence of COMPLEX;
  redefine func Sum F -> Element of COMPLEX equals

  addcomplex $$ F;
end;

definition
  let F be FinSequence of REAL;
  redefine func Sum F -> Element of REAL equals

  addreal $$ F;
end;

theorem 
  Sum(<*> REAL) = 0;

theorem 
  Sum <*r*> = r;

theorem 
  Sum(F^<*r*>) = Sum F + r;

theorem 
  Sum(F1^F2) = Sum F1 + Sum F2;

theorem 
  Sum(<*r*>^F) = r + Sum F;

theorem 
  Sum<*r1,r2*> = r1 + r2;

theorem 
  Sum<*r1,r2,r3*> = r1 + r2 + r3;

theorem 
  for R being Element of 0-tuples_on REAL holds Sum R = 0;

theorem 
  Sum(i |-> r) = i*r;

theorem 
  Sum(i |-> (0 qua Real)) = 0;

theorem 
  (for j st j in Seg i holds R1.j <= R2.j) implies Sum R1 <= Sum R2;

theorem 
  (for j st j in Seg i holds R1.j <= R2.j) & (ex j st j in Seg i
  & R1.j < R2.j) implies Sum R1 < Sum R2;

theorem 
  (for i st i in dom F holds 0 <= F.i) implies 0 <= Sum F;

theorem 
  (for i st i in dom F holds 0 <= F.i) & (ex i st i in dom F & 0
  < F.i) implies 0 < Sum F;

theorem 
  0 <= Sum sqr F;

theorem 
  Sum(r*F) = r*(Sum F);

theorem 
  Sum -F = -(Sum F);

theorem 
  Sum(R1 + R2) = Sum R1 + Sum R2;

theorem 
  Sum(R1 - R2) = Sum R1 - Sum R2;

theorem 
  Sum sqr R = 0 implies R = i |-> 0;

theorem 
  (Sum mlt(R1,R2))^2 <= (Sum sqr R1)*(Sum sqr R2);



definition
  let F be complex-valued FinSequence;
  func Product F -> complex number means


  ex f being FinSequence of COMPLEX st f = F & it = multcomplex $$ f;
end;

registration
  let F be real-valued FinSequence;
  cluster Product F -> real;
end;

theorem 
  for F being FinSequence of REAL holds Product F = multreal $$ F;

definition
  let F be FinSequence of COMPLEX;
  redefine func Product F -> Element of COMPLEX equals

  multcomplex $$ F;
end;

definition
  let F be FinSequence of REAL;
  redefine func Product F -> Element of REAL equals

  multreal $$ F;
end;

theorem 
  Product <*>REAL = 1;

registration
  let r be complex number;
  cluster <*r*> -> complex-valued;
end;

registration
  let r1, r2 be complex number;
  cluster <*r1, r2*> -> complex-valued;
end;

registration
  let r1, r2, r3 be complex number;
  cluster <*r1, r2, r3*> -> complex-valued;
end;

theorem 
  for r being complex number holds Product <*r*> = r;

registration
  let f, g be complex-valued FinSequence;
  cluster f ^ g -> complex-valued;
end;

theorem 
  for F being complex-valued FinSequence, r being complex
  number holds Product (F^<*r*>) = Product F * r;

theorem 
  for F1, F2 being complex-valued FinSequence holds
  Product (F1^F2) = Product F1 * Product F2;

theorem 
  Product (<*r*>^F) = r * Product F;

theorem 
  for r1, r2 being complex number holds Product <*r1,r2*> = r1 * r2;

theorem 
  for r1, r2, r3 being complex number holds Product <*r1,r2,r3*> = r1 * r2 * r3
;

theorem 
  for R being Element of 0-tuples_on REAL holds Product R = 1;

theorem 
  Product (i|->1) = 1;

theorem 
  for F being complex-valued FinSequence holds
  (ex k st k in dom F & F.k = 0) iff Product F = 0;

theorem 
  Product ((i+j) |->r ) = (Product (i|->r))*(Product (j|->r));

theorem 
  Product ((i*j) |->r) = Product (j |-> (Product (i|->r)));

theorem 
  Product (i|->(r1*r2)) = (Product (i|->r1))*(Product (i|->r2));

theorem 
  Product mlt(R1,R2) = Product R1 * Product R2;

theorem 
  Product (r*R) = Product (i|->r) * Product R;

theorem 
  Product sqr R = (Product R)^2;

begin 


reserve z,z1,z2 for Element of COMPLEX;

theorem 
  for F being FinSequence of COMPLEX holds Product F = multcomplex $$ F;

theorem 
  Product ((i+j) |->z) = (Product (i|->z))*(Product (j|->z));

theorem 
  Product ((i*j) |->z) = Product (j |-> (Product (i|->z)));

theorem 
  Product (i|->(z1*z2)) = (Product (i|->z1))*(Product (i|->z2));

begin 

reserve  n for Nat,
  x, y, a for real number,
  p, p1, p2, p3, q, q1, q2 for Element of n-tuples_on REAL;

theorem 
  for x being real-valued FinSequence holds len (-x)=len x;

theorem 
  for x1,x2 being real-valued FinSequence st len x1=len x2 holds
  len (x1+x2)=len x1;

theorem 
  for x1,x2 being real-valued FinSequence st len x1=len x2 holds
  len (x1-x2)=len x1;

theorem 
  for a being real number, x being real-valued FinSequence
   holds len (a*x)=len x;

theorem 
  for x,y,z being real-valued FinSequence st len x=len y & len y=len z
  holds mlt(x+y,z) = mlt(x,z)+mlt(y,z);

begin 

definition
  let x1,x2 be real-valued FinSequence;
  func |( x1,x2 )| -> real number equals

  Sum mlt(x1,x2);
  commutativity;
end;

definition
  let x1,x2 be real-valued FinSequence;
  redefine func |( x1,x2 )| -> Element of REAL;
  commutativity;
end;

theorem 
  for x being real-valued FinSequence holds |(x,x)| >= 0;

theorem 
  for x,y,z being real-valued FinSequence st len x=len y & len y=len z
  holds |((x+y),z)| = |(x,z)| + |(y,z)|;

theorem 
  for x,y being real-valued FinSequence,a being real number st len x=
  len y holds |(a*x,y)| = a*|(x,y)|;

theorem 
  for x1,x2 being real-valued FinSequence st len x1=len x2 holds
  |(-x1, x2)| = -|(x1, x2)|;

theorem 
  for x1,x2 being real-valued FinSequence st len x1=len x2 holds
  |(-x1, -x2)| = |(x1, x2)|;

theorem 
  for x1,x2,x3 being real-valued FinSequence st len x1=len x2 & len x2
  =len x3 holds |(x1-x2, x3)| = |(x1, x3)| - |(x2, x3)|;

theorem 
  for x,y being real number,x1,x2,x3 being real-valued FinSequence st len x1
  =len x2 & len x2=len x3 holds |((x*x1+y*x2), x3)| = x*|(x1,x3)| + y*|(x2,x3)|
;

theorem 
  for x1,x2,y1,y2 being real-valued FinSequence st len x1=len x2 & len
x2=len y1 & len y1=len y2 holds |(x1+x2, y1+y2)| = |(x1, y1)| + |(x1, y2)| + |(
  x2, y1)| + |(x2, y2)|;

theorem 
  for x1,x2,y1,y2 being real-valued FinSequence st len x1=len x2 & len
x2=len y1 & len y1=len y2 holds |(x1-x2, y1-y2)| = |(x1, y1)| - |(x1, y2)| - |(
  x2, y1)| + |(x2, y2)|;

theorem 
  for x,y being real-valued FinSequence st len x=len y holds |(x+y, x+
  y)| = |(x, x)| + 2*|(x, y)| + |(y, y)|;

theorem 
  for x,y being real-valued FinSequence st len x=len y holds |(x-y, x-
  y)| = |(x, x)| - 2*|(x, y)| + |(y, y)|;

theorem 
  |(p1 + p2, p3)| = |(p1, p3)| + |(p2, p3)|;

theorem 
  for x being real number holds |(x*p1, p2)| = x*|(p1, p2)|;

theorem 
  |(-p1, p2)| = -|(p1, p2)|;

theorem 
  |(-p1, -p2)| = |(p1, p2)|;

theorem 
  |(p1-p2, p3)| = |(p1, p3)| - |(p2, p3)|;

theorem 
  |((x*p1+y*p2), p3)| = x*|(p1,p3)| + y*|(p2,p3)|;

theorem 
  |(p1+p2, q1+q2)| = |(p1, q1)| + |(p1, q2)| + |(p2, q1)| + |(p2, q2)|;

theorem 
  |(p1-p2, q1-q2)| = |(p1, q1)| - |(p1, q2)| - |(p2, q1)| + |(p2, q2)|;

theorem 
  |(p+q, p+q)| = |(p, p)| + 2*|(p, q)| + |(q, q)|;

theorem 
  |(p-q, p-q)| = |(p, p)| - 2*|(p, q)| + |(q, q)|;

theorem 
  |(p,q)| <= |(p,p)| + |(q,q)|;

definition
  let p, q be real-valued FinSequence;
  pred p,q are_orthogonal means


  |(p,q)| = 0;
  symmetry;
end;

theorem 
  p, q are_orthogonal implies a*p,q are_orthogonal;



theorem 
  Sum<*r1,r2,r3,r4*> = r1 + r2 + r3 + r4;



reserve f,g for FinSequence of REAL;

theorem 
  len f = len sqr f & dom f = dom sqr f;

theorem 
  sqr (f^g) = sqr f ^ sqr g;

theorem 
  for F being real-valued FinSequence holds F is FinSequence of REAL;














begin

reserve i,j,k,n,m,l,s,t,r for Nat;
reserve a,b for real number;
reserve F,G,H for FinSequence of REAL;

theorem 
  n>=1 implies Seg n = {1} \/ {k where k is Element of NAT: 1<k & k <n} \/ {n};

theorem 
  len (a*F) = len F;

theorem 
  dom G = dom (a*G);



registration
  let x be complex number, n be Nat;
  cluster n |-> x -> complex-yielding;
end;

definition
  let x be complex number, n be Nat;
  func x |^ n equals

  Product (n |-> x);
end;

registration
  let x be real number, n be Nat;
  cluster x |^ n -> real;
end;

definition
  let x be Real, n be Nat;
  redefine func x |^ n -> Real;
end;

reserve z for complex number;

registration
  let z be complex number, n be Nat;
  cluster z|^n -> complex;
end;

theorem 
  z|^0 = 1;

theorem 
  z|^1 = z;

theorem 
  z|^(s+1) = z|^s * z;

registration
  let x, n be Nat;
  cluster x|^n -> natural;
end;

reserve x,y for complex number;

theorem 
  (x*y) |^ s = x|^s * y|^s;

theorem 
  x|^(s+t) = x|^s * x|^t;

theorem 
  (x|^s) |^ t = x|^(s*t);

theorem 
  1|^s = 1;

theorem 
  s >= 1 implies 0|^s = 0;



registration
  let n be Nat;
  cluster idseq n -> natural-valued;
end;

definition
  let n be Nat;
  func n! -> Element of REAL equals

  Product idseq n;
end;

registration
  let n be Nat;
  cluster n! -> real;
end;

theorem 
  0! = 1;

theorem 
  1! = 1;

theorem 
  2! = 2;

theorem 
  (s+1)! = (s!) * (s+1);

theorem 
  s! is Element of NAT;

registration
  let n;
  cluster n! -> natural;
end;

theorem 
  s! > 0;

registration
  let n;
  cluster n! -> positive;
end;

theorem 
  (s!) * (t!) <> 0;



definition
  let k,n be Nat;
  func n choose k means


  for l be Nat st l = n-k holds it = (n!)/((k!) * (l!)) if n >= k
  otherwise it = 0;
end;

registration
  let k,n be Nat;
  cluster n choose k -> real;
end;

definition
  let k,n be Nat;
  redefine func n choose k -> Real;
end;

theorem 
  s choose 0 = 1;

theorem 
  s >= t & r = s-t implies s choose t = s choose r;

theorem 
  s choose s = 1;

theorem 
  (t+1) choose (s+1) = (t choose (s+1)) + (t choose s);

theorem 
  s >= 1 implies s choose 1 = s;

theorem 
  s>=1 & t = s-1 implies s choose t = s;

theorem 
  s choose r is Element of NAT;

theorem 
  for m,F st m <> 0 & len F = m & (for i,l st i in dom F & l = n+i-1
  holds F.i = l choose n) holds Sum F = (n+m) choose (n+1);

registration
  let k,n be Nat;
  cluster n choose k -> natural;
end;

definition
  let k,n be Nat;
  redefine func n choose k -> Element of NAT;
end;

definition
  let a,b be real number;
  let n be Nat;
  func (a,b) In_Power n -> FinSequence of REAL means


  len it = n+1 & for i,l,m being Nat st i in dom it & m = i - 1 & l = n-m holds
    it.i = (n choose m) * a|^l * b|^m;
end;

theorem 
  (a,b) In_Power 0 = <*1*>;

theorem 
  ((a,b) In_Power s).1 = a|^s;

theorem 
  ((a,b) In_Power s).(s+1) = b|^s;

theorem 
  (a+b) |^ s = Sum((a,b) In_Power s);

definition
  let n be Nat;
  func Newton_Coeff n -> FinSequence of REAL means


  len it = n+1 & for i,k be Nat st i in dom it & k = i-1 holds
  it.i = n choose k;
end;

theorem 
  Newton_Coeff s = (1,1) In_Power s;

theorem 
  2|^s = Sum(Newton_Coeff s);

begin 


theorem 
  l >= 1 implies k*l >= k;

theorem 
  l >= 1 & n >= k*l implies n >= k;

definition
  let n;
  redefine func n! -> Element of NAT;
end;

theorem 
  l <> 0 implies l divides l!;

theorem 
  n <> 0 implies (n+1)/n > 1;

theorem 
  k/(k+1) < 1;

theorem 
  l! >= l;

theorem 
  m<>1 & m divides n implies not m divides (n+1);

theorem 
  j<>0 implies j divides (j+k)!;

theorem 
  j<=l & j<>0 implies j divides l!;

theorem 
  j<>1 & j<>0 & j divides (l!+1) implies j>l;



theorem 
  m lcm (n lcm k) = (m lcm n) lcm k;

theorem 
  m divides n iff m lcm n = n;

theorem 
  n divides m & k divides m iff n lcm k divides m;

theorem 
  m lcm 1 = m;

theorem 
  m lcm n divides m*n;

theorem 
  m gcd (n gcd k) = (m gcd n) gcd k;

theorem 
  n divides m implies n gcd m = n;

theorem 
  m divides n & m divides k iff m divides n gcd k;

theorem 
  m gcd 1 = 1;

theorem 
  m gcd 0 = m;

theorem 
  (m gcd n) lcm n = n;

theorem 
  m gcd (m lcm n) = m;

theorem 
  m gcd (m lcm n) = (n gcd m) lcm m;

theorem 
  m divides n implies m gcd k divides n gcd k;

theorem 
  m divides n implies k gcd m divides k gcd n;

theorem 
  n > 0 implies n gcd m > 0;

theorem 
  m > 0 & n > 0 implies m lcm n > 0;

theorem 
  (n gcd m) lcm (n gcd k) divides n gcd (m lcm k);

theorem 
  m divides l implies m lcm (n gcd l) divides (m lcm n) gcd l;

theorem 
  n gcd m divides n lcm m;



reserve p,q for Nat;
reserve i0,i,i1,i2,i4 for Integer;

theorem 
  0 < m implies n mod m = n - m * (n div m);

theorem 
  i2 >= 0 implies i1 mod i2 >= 0;

theorem 
  i2 > 0 implies i1 mod i2 < i2;

theorem 
  i2 <> 0 implies i1 = (i1 div i2) * i2 + (i1 mod i2);


theorem 
  m>0 or n>0 implies ex i,i1 st i*m + i1*n = m gcd n;



definition
  func SetPrimes -> Subset of NAT means


  for n being Nat holds n in it iff n is prime;
end;

registration
  cluster prime for Element of NAT;
  cluster prime for Nat;
end;

definition
  mode Prime is prime Nat;
end;

reserve x for set;

definition
  let p be Nat;
  func SetPrimenumber p -> Subset of NAT means


  for q being Nat holds q in it iff q < p & q is prime;
end;

theorem 
  SetPrimenumber p c= SetPrimes;

theorem 
  p <= q implies SetPrimenumber p c= SetPrimenumber q;

theorem 
  SetPrimenumber p c= Seg p;

theorem 
  SetPrimenumber p is finite;

registration
  let n be Nat;
  cluster SetPrimenumber n -> finite;
end;

reserve p for Prime;

theorem 
  ex p st p is prime & p>l;

registration
  cluster SetPrimes -> non empty;
end;

registration
  cluster SetPrimenumber 2 -> empty;
end;

theorem 
  SetPrimenumber m c= Seg m;

theorem 
  k>=m implies not k in SetPrimenumber m;

theorem 
  SetPrimenumber n \/ {n} is finite;

theorem 
  for f being Prime, g being Nat st f < g holds SetPrimenumber f
  \/ {f} c= SetPrimenumber g;

theorem 
  k>=m implies not k in SetPrimenumber m;

definition
  let n be Nat;
  func primenumber n -> prime Element of NAT means


  n = card SetPrimenumber it;
end;

theorem 
  SetPrimenumber n = {k where k is Element of NAT: k<n & k is prime};


theorem 
  SetPrimes is infinite;

registration
  cluster SetPrimes -> non empty infinite;
end;

reserve i for Nat;



theorem 
  i is prime implies for m,n being Nat holds i divides m * n implies
  i divides m or i divides n;

theorem 
  for x being complex number holds x |^ 2 = x * x & x^2 = x |^ 2;



theorem 
  m qua Integer div n = m div n & m qua Integer mod n = m mod n;



reserve x for real number;

theorem 
  x > 0 implies x|^k > 0;



theorem 
  n > 0 implies 0 |^ n = 0;



definition
  let m,n be Element of NAT;
  redefine func m|^n -> Element of NAT;
end;

theorem 
  2|^n >= n + 1;

theorem 
  2|^n > n;



reserve k for Element of NAT;

scheme 

  Euklides9 { F(Nat) -> Element of NAT, G(Nat) -> Element of NAT,
    a() -> Element of NAT, b() -> Element of NAT } :
    ex k st F(k) = a() gcd b() & G(k) = 0
provided
 0 < b() and
 b() < a() and
 F(0) = a() and
 G(0) = b() and
 for k st G(k) > 0 holds F(k+1) = G(k) & G(k+1) = F(k) mod G(k);



reserve k,n,n1,n2,m1,m2 for Nat;

theorem 
  r <> 0 or n = 0 iff r|^n <> 0;

theorem 
  (2|^n1)*(2*m1+1) = (2|^n2)*(2*m2+1) implies n1 = n2 & m1 = m2;

theorem 
  k <= n implies m |^ k divides m |^ n;















begin

reserve X,Y,Z,x,y,y1,y2 for set,
  D for non empty set,
  k,n,n1,n2,m2,m1 for Nat,

  L,K,M,N for Cardinal,
  f,g for Function;

theorem 
  X is finite implies X is countable;

theorem 
  omega is countable;

reserve r for Real;

theorem 
  r <> 0 or n = 0 iff r|^n <> 0;

theorem 
  (2|^n1)*(2*m1+1) = (2|^n2)*(2*m2+1) implies n1 = n2 & m1 = m2;

theorem 
  [:NAT,NAT:],NAT are_equipotent & card NAT = card [:NAT,NAT:];

theorem 
  (omega)*`(omega) = omega;

theorem 
  X is countable & Y is countable implies [:X,Y:] is countable;

theorem 
  1-tuples_on D,D are_equipotent & card (1-tuples_on D) = card D;

reserve p,q for FinSequence,
  k,m,n,n1,n2,n3 for Element of NAT;

theorem 
  [:n-tuples_on D, m-tuples_on D:],(n+m)-tuples_on D
are_equipotent & card [:n-tuples_on D, m-tuples_on D:] = card ((n+m)-tuples_on
  D);

theorem 
  D is countable implies n-tuples_on D is countable;

theorem 
  for f st dom f is countable & for x st x in dom f holds f.x is
  countable holds Union f is countable;

theorem 
  (X is countable & for Y st Y in X holds Y is countable) implies union
  X is countable;

theorem 
  D is countable implies D* is countable;

theorem 
  omega c= card (D*);

scheme 

  FraenCoun1 { f(set)->set, P[set] } : { f(n) : P[n] } is countable;

scheme 

  FraenCoun2 { f(set,set)->set, P[set,set] } : { f(n1,n2) : P[n1,n2] } is
  countable;

scheme 

  FraenCoun3 { f(set,set,set)->set, P[set,set,set] } : { f(n1,n2,n3) : P[n1,n2
  ,n3] } is countable;

reserve f,f1,f2 for Function,
  X1,X2 for set;


theorem 
  not M is finite implies M*`M = M;

theorem 
  not M is finite & 0 in N & (N c= M or N in M) implies M*`N = M & N*`M = M;

theorem 
  not M is finite & (N c= M or N in M) implies M*`N c= M & N*`M c= M;

theorem 
  not X is finite implies [:X,X:],X are_equipotent & card [:X,X:] = card X;

theorem 
  not X is finite & Y is finite & Y <> {} implies [:X,Y:],X
  are_equipotent & card [:X,Y:] = card X;

theorem 
  K in L & M in N implies K*`M in L*`N & M*`K in L*`N;

theorem 
  not X is finite implies card X = (omega)*`card X;

theorem 
  X <> {} & X is finite & not Y is finite implies card Y *` card X = card Y;

theorem 
  not D is finite & n <> 0 implies n-tuples_on D,D are_equipotent
  & card (n-tuples_on D) = card D;

theorem 
  not D is finite implies card D = card (D*);














begin 

reserve k,n,m for Element of NAT,
  A,B,C for Ordinal,
  X for set,
  x,y,z for set;

begin 

reserve f,g,h,fx for Function,
  K,M,N for Cardinal,
  phi,psi for
  Ordinal-Sequence;

theorem 
  nextcard card X = nextcard X;

theorem 
  y in Union f iff ex x st x in dom f & y in f.x;

theorem 
  alef A is infinite;

theorem 
  M is infinite implies ex A st M = alef A;

registration
  let phi;
  cluster Union phi -> ordinal;
end;

theorem 
  X c= A implies ex phi st phi = canonical_isomorphism_of(RelIncl
  order_type_of RelIncl X, RelIncl X) & phi is increasing & dom phi =
  order_type_of RelIncl X & rng phi = X;

theorem 
  X c= A implies sup X is_cofinal_with order_type_of RelIncl X;

theorem 
  X c= A implies card X = card order_type_of RelIncl X;

theorem 
  ex B st B c= card A & A is_cofinal_with B;

theorem 
  ex M st M c= card A & A is_cofinal_with M & for B st A
  is_cofinal_with B holds M c= B;

theorem 
  rng phi = rng psi & phi is increasing & psi is increasing implies phi
  = psi;

theorem 
  phi is increasing implies phi is one-to-one;

theorem 
  (phi^psi)|(dom phi) = phi;

theorem 
  X <> {} implies card { Y where Y is Subset of X: card Y in M } c= M*`
  exp(card X,M);

theorem 
  M in exp(2,M);

registration
  cluster infinite for Cardinal;
end;

registration
  cluster infinite -> non empty for set;
end;

definition
  mode Aleph is infinite Cardinal;
  let M;

  func cf M -> Cardinal means


  M is_cofinal_with it & for N st M
  is_cofinal_with N holds it c= N;
  let N;
  func N-powerfunc_of M -> Cardinal-Function means


  (for x holds x in
  dom it iff x in M & x is Cardinal) & for K st K in M holds it.K = exp(K,N);
end;

registration
  let A;
  cluster alef A -> infinite;
end;

begin 

reserve a,b for Aleph;

theorem 
  ex A st a = alef A;

theorem 
  a <> 0 & a <> 1 & a <> 2 & a <> card n & card n in a & omega c= a;

theorem 
  a c= M or a in M implies M is Aleph;

theorem 
  a c= M or a in M implies a +` M = M & M +` a = M & a *` M = M &
  M *` a = M;

theorem 
  a +` a = a & a *` a = a;

theorem 
  M c= exp(M,a);

theorem 
  union a = a;

registration
  let a,M;
  cluster a +` M -> infinite;
end;

registration
  let M,a;
  cluster M +` a -> infinite;
end;

registration
  let a,b;
  cluster a *` b -> infinite;
  cluster exp(a,b) -> infinite;
end;

begin 

definition
  let IT be Aleph;
  attr IT is regular means

  cf IT = IT;
end;

notation
  let IT be Aleph;
  antonym IT is irregular for IT is regular;
end;

registration
  let a;
  cluster nextcard a -> infinite;
end;

theorem 
  cf omega = omega;

theorem 
  cf nextcard a = nextcard a;

theorem 
  omega c= cf a;

theorem 
  cf 0 = 0 & cf card (n+1) = 1;

theorem 
  X c= M & card X in cf M implies sup X in M & union X in M;

theorem 
  dom phi = M & rng phi c= N & M in cf N implies sup phi in N &
  Union phi in N;

registration
  let a;
  cluster cf a -> infinite;
end;

theorem 
  cf a in a implies a is limit_cardinal;

theorem 
  cf a in a implies ex xi being Ordinal-Sequence st dom xi = cf a
& rng xi c= a & xi is increasing & a = sup xi & xi is Cardinal-Function & not 0
  in rng xi;

theorem 
  omega is regular & nextcard a is regular;

begin 

reserve a,b for Aleph;

theorem 
  a c= b implies exp(a,b) = exp(2,b);

theorem 
  exp(nextcard a,b) = exp(a,b) *` nextcard a;

theorem 
  Sum (b-powerfunc_of a) c= exp(a,b);

theorem 
  a is limit_cardinal & b in cf a implies exp(a,b) = Sum (b-powerfunc_of
  a);

theorem 
  cf a c= b & b in a implies exp(a,b) = exp(Sum (b-powerfunc_of a), cf a
  );

reserve O for Ordinal,
        F for Subset of omega;

theorem 
  for X being finite set st X c= O holds order_type_of RelIncl X =
  card X;

theorem 
  {x} c= O implies order_type_of RelIncl {x} = 1;

theorem 
  {x} c= O implies canonical_isomorphism_of (RelIncl order_type_of
  RelIncl {x}, RelIncl {x}) = 0 .--> x;

registration
  let O be Ordinal, X be Subset of O, n be set;
  cluster canonical_isomorphism_of (RelIncl order_type_of RelIncl X,RelIncl X)
    .n -> ordinal;
end;

registration
  let X be natural-membered set, n be set;
  cluster canonical_isomorphism_of
   (RelIncl order_type_of RelIncl X,RelIncl X).n -> natural;
end;

theorem 
  card F c= order_type_of RelIncl F;















begin

reserve x,y,z,a,b,c,X,X1,X2,Y,Z for set,
  W,W1,W2 for Tree,
  w,w9 for Element of W,
  f for Function,
  D,D9 for non empty set,
  i,k,k1,k2,l,m,n for Element of NAT,
  v,v1,v2 for FinSequence,
  p,q,r,r1,r2 for FinSequence of NAT;

theorem 
  for v1,v2,v st v1 is_a_prefix_of v & v2 is_a_prefix_of v
  holds v1,v2 are_c=-comparable;

theorem 
  for v1,v2,v st v1 is_a_proper_prefix_of v & v2 is_a_prefix_of v holds
  v1,v2 are_c=-comparable;

theorem 
  len v1 = k+1 implies ex v2,x st v1 = v2^<*x*> & len v2 = k;

theorem 
  ProperPrefixes (v^<*x*>) = ProperPrefixes v \/ {v};

scheme 
 TreeStructInd { T()->Tree, P[set] }:
  for t being Element of T() holds P[t]
provided
 P[{}] and
 for t being Element of T(), n st P[t] & t^<*n*> in T() holds P[t^<*n*>];

theorem 
  (for p holds p in W1 iff p in W2) implies W1 = W2;

definition
  let W1,W2;
  redefine pred W1 = W2 means

  for p holds p in W1 iff p in W2;
end;

theorem 
  p in W implies W = W with-replacement (p,W|p);

theorem 
  p in W & q in W & not p is_a_prefix_of q implies
  q in W with-replacement (p,W1);

theorem 
  p in W & q in W & not p,q are_c=-comparable implies
  (W with-replacement (p,W1)) with-replacement (q,W2) =
  (W with-replacement (q,W2)) with-replacement (p,W1);

definition
  let IT be Tree;
  attr IT is finite-order means

  ex n st for t being Element of IT holds not t^<*n*> in IT;
end;

registration
  cluster finite-order for Tree;
end;

definition
  let W;
  mode Chain of W -> Subset of W means


     for p,q st p in it & q in it holds p,q are_c=-comparable;
  mode Level of W -> Subset of W means


    ex n being Nat st it = { w: len w = n};
  let w;
  func succ w -> Subset of W equals

  { w^<*n*>: w^<*n*> in W };
end;

theorem 
  for L being Level of W holds L is AntiChain_of_Prefixes of W;

theorem 
  succ w is AntiChain_of_Prefixes of W;

theorem 
  for A being AntiChain_of_Prefixes of W, C being Chain of W
  ex w st A /\ C c= {w};

definition
  let W;
  let n be Nat;
  func W-level n -> Level of W equals

  { w: len w = n };
end;

theorem 
  w^<*n*> in succ w iff w^<*n*> in W;

theorem 
  w = {} implies W-level 1 = succ w;

theorem 
  W = union { W-level n: not contradiction };

theorem 
  for W being finite Tree holds W = union { W-level n: n <= height W };

theorem 
  for L being Level of W ex n st L = W-level n;

scheme 
 FraenkelCard { A() ->non empty set, X() -> set, F(set) -> set }:
  card { F(w) where w is Element of A(): w in X() } c= card X();

scheme 
 FraenkelFinCard { A() ->non empty set,
  X,Y() -> finite set, F(set) -> set }: card Y() <= card X()
provided
 Y() = { F(w) where w is Element of A(): w in X() };

theorem 
  W is finite-order implies ex n st for w holds
  ex B being finite set st B = succ w & card B <= n;

theorem 
  W is finite-order implies succ w is finite;

registration
  let W be finite-order Tree;
  let w be Element of W;
  cluster succ w -> finite;
end;

theorem 
  {} is Chain of W;

theorem 
  {{}} is Chain of W;

registration
  let W;
  cluster non empty for Chain of W;
end;

definition
  let W;
  let IT be Chain of W;
  attr IT is Branch-like means


   (for p st p in IT holds ProperPrefixes p c= IT) &
  not ex p st p in W & for q st q in IT holds q is_a_proper_prefix_of p;
end;

registration
  let W;
  cluster Branch-like for Chain of W;
end;

definition
  let W;
  mode Branch of W is Branch-like Chain of W;
end;

registration
  let W;
  cluster Branch-like -> non empty for Chain of W;
end;

reserve C for Chain of W,
  B for Branch of W;

theorem 
  v1 in C & v2 in C implies v1 in ProperPrefixes v2 or v2 is_a_prefix_of v1;

theorem 
  v1 in C & v2 in C & v is_a_prefix_of v2 implies
  v1 in ProperPrefixes v or v is_a_prefix_of v1;

registration
  let W;
  cluster finite for Chain of W;
end;

theorem 
  for C being finite Chain of W st card C > n ex p st p in C & len p >= n;

theorem 
  for C holds { w: ex p st p in C & w is_a_prefix_of p } is Chain of W;

theorem 
  p is_a_prefix_of q & q in B implies p in B;

theorem 
  {} in B;

theorem 
  p in C & q in C & len p <= len q implies p is_a_prefix_of q;

theorem 
  ex B st C c= B;

scheme 
 FuncExOfMinNat { P[set,Nat], X()->set }:
  ex f st dom f = X() & for x st x in X() ex n st f.x = n & P[x,n] &
  for m st P[x,m] holds n <= m
provided
 for x st x in X() ex n st P[x,n];

scheme 
 InfiniteChain { X()->set, a()->set, Q[set], P[set,set] }:
  ex f st dom f = NAT & rng f c= X() & f.0 = a() &
  for k holds P[f.k,f.(k+1)] & Q[f.k]
provided
 a() in X() & Q[a()] and
 for x st x in X() & Q[x] ex y st y in X() & P[x,y] & Q[y];

theorem 
  for T being Tree st (for n ex C being finite Chain of T st card C = n) &
  for t being Element of T holds succ t is finite
  ex B being Chain of T st not B is finite;


theorem 
  for T being finite-order Tree st
  for n ex C being finite Chain of T st card C = n
  ex B being Chain of T st not B is finite;

definition
  let IT be Relation;
  attr IT is DecoratedTree-like means


  dom IT is Tree;
end;

registration
  cluster DecoratedTree-like for Function;
end;

definition
  mode DecoratedTree is DecoratedTree-like Function;
end;

reserve T,T1,T2 for DecoratedTree;

registration
  let T;
  cluster dom T -> non empty Tree-like;
end;

registration
  let D;
  cluster DecoratedTree-like D-valued for Function;
end;

definition
  let D;
  mode DecoratedTree of D is D-valued DecoratedTree;
end;

definition
  let D be non empty set, T be DecoratedTree of D, t be Element of dom T;
  redefine func T.t -> Element of D;
end;

theorem 
  dom T1 = dom T2 & (for p st p in dom T1 holds T1.p = T2.p) implies T1 = T2;

scheme 
 DTreeEx { T() -> Tree, P[set,set] }:
  ex T st dom T = T() & for p st p in T() holds P[p,T.p]
provided
 for p st p in T() ex x st P[p,x];

scheme 
 DTreeLambda { T() -> Tree, f(set) -> set }:
  ex T st dom T = T() & for p st p in T() holds T.p = f(p);

definition

  let T;
  func Leaves T -> set equals

  T.:Leaves dom T;
  let p;
  func T|p -> DecoratedTree means


   dom it = (dom T)|p & for q st q in (dom T)|p holds it.q = T.(p^q);
end;

theorem 
  p in dom T implies rng (T|p) c= rng T;

definition
  let D;
  let T be DecoratedTree of D;
  redefine func Leaves T -> Subset of D;
end;

registration
  let D;
  let T be DecoratedTree of D;
  let p be Element of dom T;
  cluster T|p -> D-valued;
end;

definition
  let T,p,T1;
  assume
 p in dom T;
  func T with-replacement (p,T1) -> DecoratedTree means

  dom it = dom T with-replacement (p,dom T1) &
  for q st q in dom T with-replacement (p,dom T1) holds
  not p is_a_prefix_of q & it.q = T.q or
  ex r st r in dom T1 & q = p^r & it.q = T1.r;
end;

registration
  let W,x;
  cluster W --> x -> DecoratedTree-like;
end;

theorem 
  (for x st x in D holds x is Tree) implies union D is Tree;

theorem 
  (for x st x in X holds x is Function) & X is c=-linear implies
  union X is Relation-like Function-like;

theorem 
  (for x st x in D holds x is DecoratedTree) & D is c=-linear
  implies union D is DecoratedTree;

theorem 
  (for x st x in D9 holds x is DecoratedTree of D) & D9 is c=-linear implies
  union D9 is DecoratedTree of D;

scheme 
 DTreeStructEx
  { D() -> non empty set, d() -> Element of D(), F(set) -> set,
  S() -> Function of [:D(),NAT:],D()}:
  ex T being DecoratedTree of D() st T.{} = d() &
  for t being Element of dom T holds succ t = { t^<*k*>: k in F(T.t)} &
  for n st n in F(T.t) holds T.(t^<*n*>) = S().(T.t,n)
provided
 for d being Element of D(), k1,k2 st k1 <= k2 & k2 in F(d) holds k1 in F(d);

scheme 
 DTreeStructFinEx
  { D() -> non empty set, d() -> Element of D(), F(set) -> Element of NAT,
  S() -> Function of [:D(),NAT:],D()}:
  ex T being DecoratedTree of D() st T.{} = d() &
  for t being Element of dom T holds succ t = { t^<*k*>: k < F(T.t)} &
  for n st n < F(T.t) holds T.(t^<*n*>) = S().(T.t,n);

begin 


registration
  let Tr be finite Tree, v be Element of Tr;
  cluster succ v -> finite;
end;

definition
  let Tr be finite Tree, v be Element of Tr;
  func branchdeg v equals

  card succ v;
end;

registration
  cluster finite for DecoratedTree;
end;

registration
  let D be non empty set;
  cluster finite for DecoratedTree of D;
end;

registration
  let a,b be non empty set;
  cluster non empty for Relation of a,b;
end;



reserve x1,x2 for set,
  w for FinSequence of NAT;

theorem 
  for Z1,Z2 being Tree,p being FinSequence of NAT st p in Z1 holds
  for v being Element of Z1 with-replacement (p,Z2),w being Element of Z2
  st v = p^w holds succ v,succ w are_equipotent;

scheme 
 DTreeStructEx
  { D() -> non empty set, d() -> Element of D(), Q[set,set],
  S() -> Function of [:D(),NAT:],D()}:
  ex T being DecoratedTree of D() st T.{} = d() &
  for t being Element of dom T holds succ t = { t^<*k*>: Q[k,T.t]} &
  for n st Q[n,T.t] holds T.(t^<*n*>) = S().(T.t,n)
provided
 for d being Element of D(), k1,k2 st k1 <= k2 & Q[k2,d] holds Q[k1,d];



theorem 
  for T1, T2 being Tree st
     for n being Element of NAT holds T1-level n = T2-level n
   holds T1 = T2;

theorem 
  for n being Element of NAT holds TrivialInfiniteTree-level n = { n |-> 0 };

theorem 
  for X,Y being set for B being c=-linear Subset of PFuncs(X,Y)
  holds union B in PFuncs(X,Y);














begin 

reserve x, X, X1, X2 for set;

definition
  let Y be functional set;
  func DOMS(Y) equals

  union {dom f where f is Element of Y: not contradiction};
end;

definition
  let X;
  attr X is complex-functions-membered means


  x in X implies x is complex-valued Function;
end;

definition
  let X;
  attr X is ext-real-functions-membered means


  x in X implies x is ext-real-valued Function;
end;

definition
  let X;
  attr X is real-functions-membered means


  x in X implies x is real-valued Function;
end;

definition
  let X;
  attr X is rational-functions-membered means


  x in X implies x is RAT-valued Function;
end;

definition
  let X;
  attr X is integer-functions-membered means


  x in X implies x is INT-valued Function;
end;

definition
  let X;
  attr X is natural-functions-membered means


  x in X implies x is natural-valued Function;
end;

registration
  cluster natural-functions-membered -> integer-functions-membered for set;
  cluster integer-functions-membered -> rational-functions-membered for set;
  cluster rational-functions-membered -> real-functions-membered for set;
  cluster real-functions-membered -> complex-functions-membered for set;
  cluster real-functions-membered -> ext-real-functions-membered for set;
end;

registration
  cluster empty -> natural-functions-membered for set;
end;

registration
  let f be complex-valued Function;
  cluster {f} -> complex-functions-membered;
end;

registration
  cluster complex-functions-membered -> functional for set;
  cluster ext-real-functions-membered -> functional for set;
end;

registration
  cluster natural-functions-membered non empty for set;
end;

registration
  let X be complex-functions-membered set;
  cluster -> complex-functions-membered for Subset of X;
end;

registration
  let X be ext-real-functions-membered set;
  cluster -> ext-real-functions-membered for Subset of X;
end;

registration
  let X be real-functions-membered set;
  cluster -> real-functions-membered for Subset of X;
end;

registration
  let X be rational-functions-membered set;
  cluster -> rational-functions-membered for Subset of X;
end;

registration
  let X be integer-functions-membered set;
  cluster -> integer-functions-membered for Subset of X;
end;

registration
  let X be natural-functions-membered set;
  cluster -> natural-functions-membered for Subset of X;
end;

definition
  let D be set;
  func C_PFuncs(D) -> set means


  for f being set holds f in it iff f is PartFunc of D,COMPLEX;
end;

definition
  let D be set;
  func C_Funcs(D) -> set means


  for f being set holds f in it iff f is Function of D,COMPLEX;
end;

definition
  let D be set;
  func E_PFuncs(D) -> set means


  for f being set holds f in it iff f is PartFunc of D,ExtREAL;
end;

definition
  let D be set;
  func E_Funcs(D) -> set means


  for f being set holds f in it iff f is Function of D,ExtREAL;
end;

definition
  let D be set;
  func R_PFuncs(D) -> set means


  for f being set holds f in it iff f is PartFunc of D,REAL;
end;

definition
  let D be set;
  func R_Funcs(D) -> set means


  for f being set holds f in it iff f is Function of D,REAL;
end;

definition
  let D be set;
  func Q_PFuncs(D) -> set means


  for f being set holds f in it iff f is PartFunc of D,RAT;
end;

definition
  let D be set;
  func Q_Funcs(D) -> set means


  for f being set holds f in it iff f is Function of D,RAT;
end;

definition
  let D be set;
  func I_PFuncs(D) -> set means


  for f being set holds f in it iff f is PartFunc of D,INT;
end;

definition
  let D be set;
  func I_Funcs(D) -> set means


  for f being set holds f in it iff f is Function of D,INT;
end;

definition
  let D be set;
  func N_PFuncs(D) -> set means


  for f being set holds f in it iff f is PartFunc of D,NAT;
end;

definition
  let D be set;
  func N_Funcs(D) -> set means


  for f being set holds f in it iff f is Function of D,NAT;
end;

theorem 
  C_Funcs(X) is Subset of C_PFuncs(X);

theorem 
  E_Funcs(X) is Subset of E_PFuncs(X);

theorem 
  R_Funcs(X) is Subset of R_PFuncs(X);

theorem 
  Q_Funcs(X) is Subset of Q_PFuncs(X);

theorem 
  I_Funcs(X) is Subset of I_PFuncs(X);

theorem 
  N_Funcs(X) is Subset of N_PFuncs(X);

registration
  let X;
  cluster C_PFuncs(X) -> complex-functions-membered;
  cluster C_Funcs(X) -> complex-functions-membered;
  cluster E_PFuncs(X) -> ext-real-functions-membered;
  cluster E_Funcs(X) -> ext-real-functions-membered;
  cluster R_PFuncs(X) -> real-functions-membered;
  cluster R_Funcs(X) -> real-functions-membered;
  cluster Q_PFuncs(X) -> rational-functions-membered;
  cluster Q_Funcs(X) -> rational-functions-membered;
  cluster I_PFuncs(X) -> integer-functions-membered;
  cluster I_Funcs(X) -> integer-functions-membered;
  cluster N_PFuncs(X) -> natural-functions-membered;
  cluster N_Funcs(X) -> natural-functions-membered;
end;

registration
  let X be complex-functions-membered set;
  cluster -> complex-valued for Element of X;
end;

registration
  let X be ext-real-functions-membered set;
  cluster -> ext-real-valued for Element of X;
end;

registration
  let X be real-functions-membered set;
  cluster -> real-valued for Element of X;
end;

registration
  let X be rational-functions-membered set;
  cluster -> RAT-valued for Element of X;
end;

registration
  let X be integer-functions-membered set;
  cluster -> INT-valued for Element of X;
end;

registration
  let X be natural-functions-membered set;
  cluster -> natural-valued for Element of X;
end;

registration
  let X, x be set;
  let Y be complex-functions-membered set;
  let f be PartFunc of X,Y;
  cluster f.x -> Function-like Relation-like;
end;

registration
  let X, x be set;
  let Y be ext-real-functions-membered set;
  let f be PartFunc of X,Y;
  cluster f.x -> Function-like Relation-like;
end;

registration
  let X, x;
  let Y be complex-functions-membered set;
  let f be PartFunc of X,Y;
  cluster f.x -> complex-valued;
end;

registration
  let X, x;
  let Y be ext-real-functions-membered set;
  let f be PartFunc of X,Y;
  cluster f.x -> ext-real-valued;
end;

registration
  let X, x;
  let Y be real-functions-membered set;
  let f be PartFunc of X,Y;
  cluster f.x -> real-valued;
end;

registration
  let X, x;
  let Y be rational-functions-membered set;
  let f be PartFunc of X,Y;
  cluster f.x -> RAT-valued;
end;

registration
  let X, x;
  let Y be integer-functions-membered set;
  let f be PartFunc of X,Y;
  cluster f.x -> INT-valued;
end;

registration
  let X, x;
  let Y be natural-functions-membered set;
  let f be PartFunc of X,Y;
  cluster f.x -> natural-valued;
end;

registration
  let X;
  let Y be complex-membered set;
  cluster PFuncs(X,Y) -> complex-functions-membered;
end;

registration
  let X;
  let Y be ext-real-membered set;
  cluster PFuncs(X,Y) -> ext-real-functions-membered;
end;

registration
  let X;
  let Y be real-membered set;
  cluster PFuncs(X,Y) -> real-functions-membered;
end;

registration
  let X;
  let Y be rational-membered set;
  cluster PFuncs(X,Y) -> rational-functions-membered;
end;

registration
  let X;
  let Y be integer-membered set;
  cluster PFuncs(X,Y) -> integer-functions-membered;
end;

registration
  let X;
  let Y be natural-membered set;
  cluster PFuncs(X,Y) -> natural-functions-membered;
end;

registration
  let X;
  let Y be complex-membered set;
  cluster Funcs(X,Y) -> complex-functions-membered;
end;

registration
  let X;
  let Y be ext-real-membered set;
  cluster Funcs(X,Y) -> ext-real-functions-membered;
end;

registration
  let X;
  let Y be real-membered set;
  cluster Funcs(X,Y) -> real-functions-membered;
end;

registration
  let X;
  let Y be rational-membered set;
  cluster Funcs(X,Y) -> rational-functions-membered;
end;

registration
  let X;
  let Y be integer-membered set;
  cluster Funcs(X,Y) -> integer-functions-membered;
end;

registration
  let X;
  let Y be natural-membered set;
  cluster Funcs(X,Y) -> natural-functions-membered;
end;

definition
  let R be Relation;
  attr R is complex-functions-valued means


  rng R is complex-functions-membered;
  attr R is ext-real-functions-valued means


  rng R is ext-real-functions-membered;
  attr R is real-functions-valued means


  rng R is real-functions-membered;
  attr R is rational-functions-valued means


  rng R is rational-functions-membered;
  attr R is integer-functions-valued means


  rng R is integer-functions-membered;
  attr R is natural-functions-valued means


  rng R is natural-functions-membered;
end;

registration
 let Y be complex-functions-membered set;
 cluster -> complex-functions-valued for Y-valued Function;
end;

definition
  let f be Function;
  redefine attr f is complex-functions-valued means

  for x being set st x in dom f holds f.x is complex-valued Function;
  redefine attr f is ext-real-functions-valued means

  for x being set st x in dom f holds f.x is ext-real-valued Function;
  redefine attr f is real-functions-valued means

  for x being set st x in dom f holds f.x is real-valued Function;
  redefine attr f is rational-functions-valued means

  for x being set st x in dom f holds f.x is RAT-valued Function;
  redefine attr f is integer-functions-valued means

  for x being set st x in dom f holds f.x is INT-valued Function;
  redefine attr f is natural-functions-valued means

  for x being set st x in dom f holds f.x is natural-valued Function;
end;

registration
  cluster natural-functions-valued -> integer-functions-valued for Relation;
  cluster integer-functions-valued -> rational-functions-valued for Relation;
  cluster rational-functions-valued -> real-functions-valued for Relation;
  cluster real-functions-valued -> ext-real-functions-valued for Relation;
  cluster real-functions-valued -> complex-functions-valued for Relation;
end;

registration
  cluster empty -> natural-functions-valued for Relation;
end;

registration
  cluster natural-functions-valued for Function;
end;

registration
  let R be complex-functions-valued Relation;
  cluster rng R -> complex-functions-membered;
end;

registration
  let R be ext-real-functions-valued Relation;
  cluster rng R -> ext-real-functions-membered;
end;

registration
  let R be real-functions-valued Relation;
  cluster rng R -> real-functions-membered;
end;

registration
  let R be rational-functions-valued Relation;
  cluster rng R -> rational-functions-membered;
end;

registration
  let R be integer-functions-valued Relation;
  cluster rng R -> integer-functions-membered;
end;

registration
  let R be natural-functions-valued Relation;
  cluster rng R -> natural-functions-membered;
end;

registration
  let X;
  let Y be complex-functions-membered set;
  cluster -> complex-functions-valued for PartFunc of X,Y;
end;

registration
  let X;
  let Y be ext-real-functions-membered set;
  cluster -> ext-real-functions-valued for PartFunc of X,Y;
end;

registration
  let X;
  let Y be real-functions-membered set;
  cluster -> real-functions-valued for PartFunc of X,Y;
end;

registration
  let X;
  let Y be rational-functions-membered set;
  cluster -> rational-functions-valued for PartFunc of X,Y;
end;

registration
  let X;
  let Y be integer-functions-membered set;
  cluster -> integer-functions-valued for PartFunc of X,Y;
end;

registration
  let X;
  let Y be natural-functions-membered set;
  cluster -> natural-functions-valued for PartFunc of X,Y;
end;

registration
  let f be complex-functions-valued Function;
  let x;
  cluster f.x -> Function-like Relation-like;
end;

registration
  let f be ext-real-functions-valued Function;
  let x;
  cluster f.x -> Function-like Relation-like;
end;

registration
  let f be complex-functions-valued Function;
  let x;
  cluster f.x -> complex-valued;
end;

registration
  let f be ext-real-functions-valued Function;
  let x;
  cluster f.x -> ext-real-valued;
end;

registration
  let f be real-functions-valued Function;
  let x;
  cluster f.x -> real-valued;
end;

registration
  let f be rational-functions-valued Function;
  let x;
  cluster f.x -> RAT-valued;
end;

registration
  let f be integer-functions-valued Function;
  let x;
  cluster f.x -> INT-valued;
end;

registration
  let f be natural-functions-valued Function;
  let x;
  cluster f.x -> natural-valued;
end;

begin 

reserve Y, Y1, Y2 for complex-functions-membered set,
  c, c1, c2 for complex number,
  f for PartFunc of X,Y,
  f1 for PartFunc of X1,Y1,
  f2 for PartFunc of X2, Y2,
  g, h, k for complex-valued Function;

theorem 
  g <> {} & g + c1 = g + c2 implies c1 = c2;

theorem 
  g <> {} & g - c1 = g - c2 implies c1 = c2;

theorem 
  g <> {} & g is non-empty & g (#) c1 = g (#) c2 implies c1 = c2;

theorem 
  - (g + c) = -g - c;

theorem 
  - (g - c) = -g + c;

theorem 
  (g + c1) + c2 = g + (c1 + c2);

theorem 
  (g + c1) - c2 = g + (c1 - c2);

theorem 
  (g - c1) + c2 = g - (c1 - c2);

theorem 
  (g - c1) - c2 = g - (c1 + c2);

theorem 
  g (#) c1 (#) c2 = g (#) (c1 * c2);

theorem 
  - (g + h) = (-g) - h;

theorem 
  g - h = - (h - g);

theorem 
  g (#) h /" k = g (#) (h /" k);

theorem 
  g /" h (#) k = g (#) k /" h;

theorem 
  g /" h /" k = g /" (h (#) k);

theorem 
  c(#)-g = (-c)(#)g;

theorem 
  c(#)-g = -(c(#)g);

theorem 
  (-c)(#)g = -(c(#)g);

theorem 
  - (g (#) h) = (-g) (#) h;

theorem 
  - (g /" h) = (-g) /" h;

theorem 
  - (g /" h) = g /" -h;

definition
  let f be complex-valued Function, c be complex number;
  func f (/) c -> Function equals

  (1/c) (#) f;
end;

registration
  let f be complex-valued Function, c be complex number;
  cluster f (/) c -> complex-valued;
end;

registration
  let f be real-valued Function, r be real number;
  cluster f (/) r -> real-valued;
end;

registration
  let f be RAT-valued Function, r be rational number;
  cluster f (/) r -> RAT-valued;
end;

registration
  let f be complex-valued FinSequence, c be complex number;
  cluster f (/) c -> FinSequence-like;
end;

theorem 
  dom(g(/)c) = dom g;

theorem 
  (g(/)c).x = g.x / c;

theorem 
  (-g) (/) c = -(g(/)c);

theorem 
  g (/) -c = -(g(/)c);

theorem 
  g (/) -c = (-g) (/) c;

theorem 
  g <> {} & g is non-empty & g (/) c1 = g (/) c2 implies c1 = c2;

theorem 
  g (#) c1 (/) c2 = g (#) (c1 / c2);

theorem 
  g (/) c1 (#) c2 = g (#) c2 (/) c1;

theorem 
  g (/) c1 (/) c2 = g (/) (c1*c2);

theorem 
  (g+h) (/) c = g(/)c + h(/)c;

theorem 
  (g-h) (/) c = g(/)c - h(/)c;

theorem 
  (g(#)h) (/) c = g (#) (h(/)c);

theorem 
  (g/"h) (/) c = g /" (h(#)c);

definition



  let f be complex-functions-valued Function;
  func <->f -> Function means


  dom it = dom f & for x being set st x in dom it holds it.x = -f.x;
end;

definition
  let X;
  let Y be complex-functions-membered set;
  let f be PartFunc of X,Y;
  redefine func <->f -> PartFunc of X, C_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be real-functions-membered set;
  let f be PartFunc of X,Y;
  redefine func <->f -> PartFunc of X, R_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be rational-functions-membered set;
  let f be PartFunc of X,Y;
  redefine func <->f -> PartFunc of X, Q_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be integer-functions-membered set;
  let f be PartFunc of X,Y;
  redefine func <->f -> PartFunc of X, I_PFuncs(DOMS(Y));
end;

registration
  let Y be complex-functions-membered set;
  let f be FinSequence of Y;
  cluster <->f -> FinSequence-like;
end;

theorem 
  <-><->f = f;

theorem 
  <->f1 = <->f2 implies f1 = f2;

definition
  let X be complex-functions-membered set;
  let Y be set;
  let f be PartFunc of X,Y;
  func f(-) -> Function means

  dom it = dom f & for x being complex-valued
  Function st x in dom it holds it.x = f.-x;
end;

definition


  let f be complex-functions-valued Function;
  func </>f -> Function means


  dom it = dom f & for x being set st x in dom it holds it.x = (f.x)";
end;

definition
  let X;
  let Y be complex-functions-membered set;
  let f be PartFunc of X,Y;
  redefine func </>f -> PartFunc of X, C_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be real-functions-membered set;
  let f be PartFunc of X,Y;
  redefine func </>f -> PartFunc of X, R_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be rational-functions-membered set;
  let f be PartFunc of X,Y;
  redefine func </>f -> PartFunc of X, Q_PFuncs(DOMS(Y));
end;

registration
  let Y be complex-functions-membered set;
  let f be FinSequence of Y;
  cluster </>f -> FinSequence-like;
end;

theorem 
  </></>f = f;

definition


  let f be complex-functions-valued Function;
  func abs(f) -> Function means


  dom it = dom f & for x being set st x in dom it holds it.x = abs(f.x);
end;

definition
  let X;
  let Y be complex-functions-membered set;
  let f be PartFunc of X,Y;
  redefine func abs(f) -> PartFunc of X, C_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be real-functions-membered set;
  let f be PartFunc of X,Y;
  redefine func abs(f) -> PartFunc of X, R_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be rational-functions-membered set;
  let f be PartFunc of X,Y;
  redefine func abs(f) -> PartFunc of X, Q_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be integer-functions-membered set;
  let f be PartFunc of X,Y;
  redefine func abs(f) -> PartFunc of X, N_PFuncs(DOMS(Y));
end;

registration
  let Y be complex-functions-membered set;
  let f be FinSequence of Y;
  cluster abs(f) -> FinSequence-like;
end;

theorem 
  abs abs f = abs f;

definition

  let Y be complex-functions-membered set;
  let f be Y-valued Function;
  let c be complex number;
  func f[+]c -> Function means


  dom it = dom f & for x being set st x in dom it holds it.x = c + f.x;
end;

definition
  let X;
  let Y be complex-functions-membered set;
  let f be PartFunc of X,Y;
  let c be complex number;
  redefine func f[+]c -> PartFunc of X, C_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be real-functions-membered set;
  let f be PartFunc of X,Y;
  let c be real number;
  redefine func f[+]c -> PartFunc of X, R_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be rational-functions-membered set;
  let f be PartFunc of X,Y;
  let c be rational number;
  redefine func f[+]c -> PartFunc of X, Q_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be integer-functions-membered set;
  let f be PartFunc of X,Y;
  let c be integer number;
  redefine func f[+]c -> PartFunc of X, I_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be natural-functions-membered set;
  let f be PartFunc of X,Y;
  let c be Nat;
  redefine func f[+]c -> PartFunc of X, N_PFuncs(DOMS(Y));
end;

theorem 
  f [+] c1 [+] c2 = f [+] (c1+c2);

theorem 
  f <> {} & f is non-empty & f [+] c1 = f [+] c2 implies c1 = c2;

definition

  let Y be complex-functions-membered set;
  let f be Y-valued Function;
  let c be complex number;
  func f[-]c -> Function equals

  f [+] -c;
end;

theorem 
  dom(f[-]c) = dom f;

theorem 
  x in dom(f[-]c) implies (f[-]c).x = f.x - c;

definition
  let X;
  let Y be complex-functions-membered set;
  let f be PartFunc of X,Y;
  let c be complex number;
  redefine func f[-]c -> PartFunc of X, C_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be real-functions-membered set;
  let f be PartFunc of X,Y;
  let c be real number;
  redefine func f[-]c -> PartFunc of X, R_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be rational-functions-membered set;
  let f be PartFunc of X,Y;
  let c be rational number;
  redefine func f[-]c -> PartFunc of X, Q_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be integer-functions-membered set;
  let f be PartFunc of X,Y;
  let c be integer number;
  redefine func f[-]c -> PartFunc of X, I_PFuncs(DOMS(Y));
end;

theorem 
  f <> {} & f is non-empty & f [-] c1 = f [-] c2 implies c1 = c2;

theorem 
  f [+] c1 [-] c2 = f [+] (c1-c2);

theorem 
  f [-] c1 [+] c2 = f [-] (c1-c2);

theorem 
  f [-] c1 [-] c2 = f [-] (c1+c2);

definition

  let Y be complex-functions-membered set;
  let f be Y-valued Function;
  let c be complex number;
  func f[#]c -> Function means


  dom it = dom f & for x being set st x in dom it holds it.x = c (#) (f.x);
end;

definition
  let X;
  let Y be complex-functions-membered set;
  let f be PartFunc of X,Y;
  let c be complex number;
  redefine func f[#]c -> PartFunc of X, C_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be real-functions-membered set;
  let f be PartFunc of X,Y;
  let c be real number;
  redefine func f[#]c -> PartFunc of X, R_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be rational-functions-membered set;
  let f be PartFunc of X,Y;
  let c be rational number;
  redefine func f[#]c -> PartFunc of X, Q_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be integer-functions-membered set;
  let f be PartFunc of X,Y;
  let c be integer number;
  redefine func f[#]c -> PartFunc of X, I_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be natural-functions-membered set;
  let f be PartFunc of X,Y;
  let c be Nat;
  redefine func f[#]c -> PartFunc of X, N_PFuncs(DOMS(Y));
end;

theorem 
  f [#] c1 [#] c2 = f [#] (c1*c2);

theorem 
  f <> {} & f is non-empty & (for x st x in dom f holds f.x is non-empty
  ) & f [#] c1 = f [#] c2 implies c1 = c2;

definition

  let Y be complex-functions-membered set;
  let f be Y-valued Function;
  let c be complex number;
  func f[/]c -> Function equals

  f [#] (c");
end;

theorem 
  dom(f[/]c) = dom f;

theorem 
  x in dom(f[/]c) implies (f[/]c).x = c" (#) f.x;

definition
  let X;
  let Y be complex-functions-membered set;
  let f be PartFunc of X,Y;
  let c be complex number;
  redefine func f[/]c -> PartFunc of X, C_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be real-functions-membered set;
  let f be PartFunc of X,Y;
  let c be real number;
  redefine func f[/]c -> PartFunc of X, R_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be rational-functions-membered set;
  let f be PartFunc of X,Y;
  let c be rational number;
  redefine func f[/]c -> PartFunc of X, Q_PFuncs(DOMS(Y));
end;

theorem 
  f [/] c1 [/] c2 = f [/] (c1*c2);

theorem 
  f <> {} & f is non-empty & (for x st x in dom f holds f.x is non-empty
  ) & f [/] c1 = f [/] c2 implies c1 = c2;

definition

  let Y be complex-functions-membered set;
  let f be Y-valued Function;
  let g be complex-valued Function;
  func f<+>g -> Function means


  dom it = dom f /\ dom g & for x being
  set st x in dom it holds it.x = f.x + g.x;
end;

definition
  let X;
  let Y be complex-functions-membered set;
  let f be PartFunc of X,Y;
  let g be complex-valued Function;
  redefine func f<+>g -> PartFunc of X /\ dom g, C_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be real-functions-membered set;
  let f be PartFunc of X,Y;
  let g be real-valued Function;
  redefine func f<+>g -> PartFunc of X /\ dom g, R_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be rational-functions-membered set;
  let f be PartFunc of X,Y;
  let g be RAT-valued Function;
  redefine func f<+>g -> PartFunc of X /\ dom g, Q_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be integer-functions-membered set;
  let f be PartFunc of X,Y;
  let g be INT-valued Function;
  redefine func f<+>g -> PartFunc of X /\ dom g, I_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be natural-functions-membered set;
  let f be PartFunc of X,Y;
  let g be natural-valued Function;
  redefine func f<+>g -> PartFunc of X /\ dom g, N_PFuncs(DOMS(Y));
end;

theorem 
  f <+> g <+> h = f <+> (g+h);

theorem 
  <->(f<+>g) = (<->f) <+> -g;

definition

  let Y be complex-functions-membered set;
  let f be Y-valued Function;
  let g be complex-valued Function;
  func f<->g -> Function equals

  f <+> -g;
end;

theorem 
  dom(f<->g) = dom f /\ dom g;

theorem 
  x in dom(f<->g) implies (f<->g).x = f.x - g.x;

definition
  let X;
  let Y be complex-functions-membered set;
  let f be PartFunc of X,Y;
  let g be complex-valued Function;
  redefine func f<->g -> PartFunc of X /\ dom g, C_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be real-functions-membered set;
  let f be PartFunc of X,Y;
  let g be real-valued Function;
  redefine func f<->g -> PartFunc of X /\ dom g, R_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be rational-functions-membered set;
  let f be PartFunc of X,Y;
  let g be RAT-valued Function;
  redefine func f<->g -> PartFunc of X /\ dom g, Q_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be integer-functions-membered set;
  let f be PartFunc of X,Y;
  let g be INT-valued Function;
  redefine func f<->g -> PartFunc of X /\ dom g, I_PFuncs(DOMS(Y));
end;

theorem 
  f <-> -g = f <+> g;

theorem 
  <->(f<->g) = (<->f) <+> g;

theorem 
  f <+> g <-> h = f <+> (g-h);

theorem 
  f <-> g <+> h = f <-> (g-h);

theorem 
  f <-> g <-> h = f <-> (g+h);

definition

  let Y be complex-functions-membered set;
  let f be Y-valued Function;
  let g be complex-valued Function;
  func f<#>g -> Function means


  dom it = dom f /\ dom g & for x being
  set st x in dom it holds it.x = f.x (#) g.x;
end;

definition
  let X;
  let Y be complex-functions-membered set;
  let f be PartFunc of X,Y;
  let g be complex-valued Function;
  redefine func f<#>g -> PartFunc of X /\ dom g, C_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be real-functions-membered set;
  let f be PartFunc of X,Y;
  let g be real-valued Function;
  redefine func f<#>g -> PartFunc of X /\ dom g, R_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be rational-functions-membered set;
  let f be PartFunc of X,Y;
  let g be RAT-valued Function;
  redefine func f<#>g -> PartFunc of X /\ dom g, Q_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be integer-functions-membered set;
  let f be PartFunc of X,Y;
  let g be INT-valued Function;
  redefine func f<#>g -> PartFunc of X /\ dom g, I_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be natural-functions-membered set;
  let f be PartFunc of X,Y;
  let g be natural-valued Function;
  redefine func f<#>g -> PartFunc of X /\ dom g, N_PFuncs(DOMS(Y));
end;

theorem 
  f <#> -g = (<->f) <#> g;

theorem 
  f <#> -g = <-> (f <#> g);

theorem 
  f <#> g <#> h = f <#> (g(#)h);

definition

  let Y be complex-functions-membered set;
  let f be Y-valued Function;
  let g be complex-valued Function;
  func f</>g -> Function equals

  f <#> (g");
end;

theorem 
  dom(f</>g) = dom f /\ dom g;

theorem 
  x in dom(f</>g) implies (f</>g).x = f.x (/) g.x;

definition
  let X;
  let Y be complex-functions-membered set;
  let f be PartFunc of X,Y;
  let g be complex-valued Function;
  redefine func f</>g -> PartFunc of X /\ dom g, C_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be real-functions-membered set;
  let f be PartFunc of X,Y;
  let g be real-valued Function;
  redefine func f</>g -> PartFunc of X /\ dom g, R_PFuncs(DOMS(Y));
end;

definition
  let X;
  let Y be rational-functions-membered set;
  let f be PartFunc of X,Y;
  let g be RAT-valued Function;
  redefine func f</>g -> PartFunc of X /\ dom g, Q_PFuncs(DOMS(Y));
end;

theorem 
  f <#> g </> h = f <#> (g/"h);

definition

  let Y1, Y2 be complex-functions-membered set;
  let f be Y1-valued Function;
  let g be Y2-valued Function;
  func f<++>g -> Function means


  dom it = dom f /\ dom g & for x being
  set st x in dom it holds it.x = f.x + g.x;
end;

definition
  let X1, X2 be set;
  let Y1, Y2 be complex-functions-membered set;
  let f be PartFunc of X1,Y1;
  let g be PartFunc of X2,Y2;
  redefine func f<++>g -> PartFunc of X1 /\ X2, C_PFuncs(DOMS(Y1)/\DOMS(Y2));
end;

definition
  let X1, X2 be set;
  let Y1, Y2 be real-functions-membered set;
  let f be PartFunc of X1,Y1;
  let g be PartFunc of X2,Y2;
  redefine func f<++>g -> PartFunc of X1 /\ X2, R_PFuncs(DOMS(Y1)/\DOMS(Y2));
end;

definition
  let X1, X2 be set;
  let Y1, Y2 be rational-functions-membered set;
  let f be PartFunc of X1,Y1;
  let g be PartFunc of X2,Y2;
  redefine func f<++>g -> PartFunc of X1 /\ X2, Q_PFuncs(DOMS(Y1)/\DOMS(Y2));
end;

definition
  let X1, X2 be set;
  let Y1, Y2 be integer-functions-membered set;
  let f be PartFunc of X1,Y1;
  let g be PartFunc of X2,Y2;
  redefine func f<++>g -> PartFunc of X1 /\ X2, I_PFuncs(DOMS(Y1)/\DOMS(Y2));
end;

definition
  let X1, X2 be set;
  let Y1, Y2 be natural-functions-membered set;
  let f be PartFunc of X1,Y1;
  let g be PartFunc of X2,Y2;
  redefine func f<++>g -> PartFunc of X1 /\ X2, N_PFuncs(DOMS(Y1)/\DOMS(Y2));
end;

theorem 
  f1 <++> f2 = f2 <++> f1;

theorem 
  f <++> f1 <++> f2 = f <++> (f1 <++> f2);

theorem 
  <-> (f1 <++> f2) = (<->f1) <++> (<->f2);

definition

  let Y1, Y2 be complex-functions-membered set;
  let f be Y1-valued Function;
  let g be Y2-valued Function;
  func f<-->g -> Function means


  dom it = dom f /\ dom g & for x being
  set st x in dom it holds it.x = f.x - g.x;
end;

definition
  let X1, X2 be set;
  let Y1, Y2 be complex-functions-membered set;
  let f be PartFunc of X1,Y1;
  let g be PartFunc of X2,Y2;
  redefine func f<-->g -> PartFunc of X1 /\ X2, C_PFuncs(DOMS(Y1)/\DOMS(Y2));
end;

definition
  let X1, X2 be set;
  let Y1, Y2 be real-functions-membered set;
  let f be PartFunc of X1,Y1;
  let g be PartFunc of X2,Y2;
  redefine func f<-->g -> PartFunc of X1 /\ X2, R_PFuncs(DOMS(Y1)/\DOMS(Y2));
end;

definition
  let X1, X2 be set;
  let Y1, Y2 be rational-functions-membered set;
  let f be PartFunc of X1,Y1;
  let g be PartFunc of X2,Y2;
  redefine func f<-->g -> PartFunc of X1 /\ X2, Q_PFuncs(DOMS(Y1)/\DOMS(Y2));
end;

definition
  let X1, X2 be set;
  let Y1, Y2 be integer-functions-membered set;
  let f be PartFunc of X1,Y1;
  let g be PartFunc of X2,Y2;
  redefine func f<-->g -> PartFunc of X1 /\ X2, I_PFuncs(DOMS(Y1)/\DOMS(Y2));
end;

theorem 
  f1 <--> f2 = <-> (f2 <--> f1);

theorem 
  <-> (f1 <--> f2) = (<->f1) <++> f2;

theorem 
  f <++> f1 <--> f2 = f <++> (f1<-->f2);

theorem 
  f <--> f1 <++> f2 = f <--> (f1 <--> f2);

theorem 
  f <--> f1 <--> f2 = f <--> (f1 <++> f2);

theorem 
  f <--> f1 <--> f2 = f <--> f2 <--> f1;

definition

  let Y1, Y2 be complex-functions-membered set;
  let f be Y1-valued Function;
  let g be Y2-valued Function;
  func f<##>g -> Function means


  dom it = dom f /\ dom g & for x being
  set st x in dom it holds it.x = f.x (#) g.x;
end;

definition
  let X1, X2 be set;
  let Y1, Y2 be complex-functions-membered set;
  let f be PartFunc of X1,Y1;
  let g be PartFunc of X2,Y2;
  redefine func f<##>g -> PartFunc of X1 /\ X2, C_PFuncs(DOMS(Y1)/\DOMS(Y2));
end;

definition
  let X1, X2 be set;
  let Y1, Y2 be real-functions-membered set;
  let f be PartFunc of X1,Y1;
  let g be PartFunc of X2,Y2;
  redefine func f<##>g -> PartFunc of X1 /\ X2, R_PFuncs(DOMS(Y1)/\DOMS(Y2));
end;

definition
  let X1, X2 be set;
  let Y1, Y2 be rational-functions-membered set;
  let f be PartFunc of X1,Y1;
  let g be PartFunc of X2,Y2;
  redefine func f<##>g -> PartFunc of X1 /\ X2, Q_PFuncs(DOMS(Y1)/\DOMS(Y2));
end;

definition
  let X1, X2 be set;
  let Y1, Y2 be integer-functions-membered set;
  let f be PartFunc of X1,Y1;
  let g be PartFunc of X2,Y2;
  redefine func f<##>g -> PartFunc of X1 /\ X2, I_PFuncs(DOMS(Y1)/\DOMS(Y2));
end;

definition
  let X1, X2 be set;
  let Y1, Y2 be natural-functions-membered set;
  let f be PartFunc of X1,Y1;
  let g be PartFunc of X2,Y2;
  redefine func f<##>g -> PartFunc of X1 /\ X2, N_PFuncs(DOMS(Y1)/\DOMS(Y2));
end;

theorem 
  f1 <##> f2 = f2 <##> f1;

theorem 
  (f <##> f1) <##> f2 = f <##> (f1 <##> f2);

theorem 
  (<->f1) <##> f2 = <-> (f1<##>f2);

theorem 
  f1 <##> <->f2 = <-> (f1<##>f2);

theorem 
  f <##> (f1<++>f2) = (f<##>f1) <++> (f<##>f2);

theorem 
  (f1<++>f2) <##> f = (f1<##>f) <++> (f2<##>f);

theorem 
  f <##> (f1<-->f2) = (f<##>f1) <--> (f<##>f2);

theorem 
  (f1<-->f2) <##> f = (f1<##>f) <--> (f2<##>f);

definition

  let Y1, Y2 be complex-functions-membered set;
  let f be Y1-valued Function;
  let g be Y2-valued Function;
  func f<//>g -> Function means


  dom it = dom f /\ dom g & for x being
  set st x in dom it holds it.x = f.x /" g.x;
end;

definition
  let X1, X2 be set;
  let Y1, Y2 be complex-functions-membered set;
  let f be PartFunc of X1,Y1;
  let g be PartFunc of X2,Y2;
  redefine func f<//>g -> PartFunc of X1 /\ X2, C_PFuncs(DOMS(Y1)/\DOMS(Y2));
end;

definition
  let X1, X2 be set;
  let Y1, Y2 be real-functions-membered set;
  let f be PartFunc of X1,Y1;
  let g be PartFunc of X2,Y2;
  redefine func f<//>g -> PartFunc of X1 /\ X2, R_PFuncs(DOMS(Y1)/\DOMS(Y2));
end;

definition
  let X1, X2 be set;
  let Y1, Y2 be rational-functions-membered set;
  let f be PartFunc of X1,Y1;
  let g be PartFunc of X2,Y2;
  redefine func f<//>g -> PartFunc of X1 /\ X2, Q_PFuncs(DOMS(Y1)/\DOMS(Y2));
end;

theorem 
  (<->f1) <//> f2 = <-> (f1<//>f2);

theorem 
  f1 <//> <->f2 = <-> (f1<//>f2);

theorem 
  f <##> f1 <//> f2 = f <##> (f1<//>f2);

theorem 
  f <//> f1 <##> f2 = f <##> f2 <//> f1;

theorem 
  f <//> f1 <//> f2 = f <//> (f1 <##> f2);

theorem 
  (f1<++>f2) <//> f = (f1<//>f) <++> (f2<//>f);

theorem 
  (f1<-->f2) <//> f = (f1<//>f) <--> (f2<//>f);














begin

reserve n,m,k for Element of NAT;
reserve r,r1 for real number;
reserve f,seq,seq1 for Real_Sequence;
reserve x,y for set;





reserve e1,e2 for ext-real number;

definition

  let f be NAT-defined REAL-valued Function;
  redefine attr f is increasing means


  for m,n st m in dom f & n in dom f & m < n holds f.m < f.n;
  redefine attr f is decreasing means


  for m,n st m in dom f & n in dom f & m < n holds f.m > f.n;
  redefine attr f is non-decreasing means


  for m,n st m in dom f & n in dom f & m <= n holds f.m <= f.n;
  redefine attr f is non-increasing means


  for m,n st m in dom f & n in dom f & m <= n holds f.m >= f.n;
end;

definition

  let seq;
  attr seq is monotone means


  seq is non-decreasing or seq is non-increasing;
end;

theorem 
  seq is increasing iff for n,m st n<m holds seq.n<seq.m;

theorem 
  seq is increasing iff for n,k holds seq.n<seq.(n+1+k);

theorem 
  seq is decreasing iff for n,k holds seq.(n+1+k)<seq.n;

theorem 
  seq is decreasing iff for n,m st n<m holds seq.m<seq.n;

theorem 
  seq is non-decreasing iff for n,k holds seq.n<=seq.(n+k);

theorem 
  seq is non-decreasing iff for n,m st n<=m holds seq.n<=seq.m;

theorem 
  seq is non-increasing iff for n,k holds seq.(n+k)<=seq.n;

theorem 
  seq is non-increasing iff for n,m st n<=m holds seq.m<=seq.n;





theorem 
  seq is increasing implies for n st 0<n holds seq.0<seq.n;

theorem 
  seq is decreasing implies for n st 0<n holds seq.n<seq.0;

theorem 
  seq is non-decreasing implies for n holds seq.0<=seq.n;

theorem 
  seq is non-increasing implies for n holds seq.n<=seq.0;

registration
  cluster constant -> non-decreasing non-increasing for PartFunc of NAT, REAL;
  cluster non-decreasing non-increasing -> constant for PartFunc of NAT, REAL;
end;

registration
  cluster increasing natural-valued for Real_Sequence;
end;

registration
  cluster increasing for sequence of NAT;
end;

reserve Nseq for increasing sequence of NAT;

theorem 
  seq is sequence of NAT iff for n holds seq.n is Element of NAT;

registration
  let Nseq,k;
  cluster Nseq ^\ k -> increasing natural-valued for ext-real-valued Function;
end;

definition
  let f be Real_Sequence;
  redefine attr f is increasing means

  for n being Element of NAT holds f.n < f.(n+1);
  redefine attr f is decreasing means

  for n being Element of NAT holds f.n > f.(n+1);
  redefine attr f is non-decreasing means

  for n being Element of NAT holds f.n <= f.(n+1);
  redefine attr f is non-increasing means

  for n being Element of NAT holds f.n >= f.(n+1);
end;

theorem 
  for n holds n<=Nseq.n;

registration
  let s be Real_Sequence, k be Nat;
  cluster s^\k ->real-valued;
end;

theorem 
  (seq+seq1) ^\k=(seq ^\k) + (seq1 ^\k);

theorem 
  (-seq) ^\k=-(seq ^\k);

theorem 
  (seq-seq1) ^\k=(seq ^\k)-(seq1 ^\k);

theorem 
  (seq") ^\k=(seq ^\k)";

theorem 
  (seq(#)seq1) ^\k=(seq ^\k)(#)(seq1 ^\k);

theorem 
  (seq/"seq1) ^\k=(seq ^\k)/"(seq1 ^\k);

theorem 
  (r(#)seq) ^\k=r(#)(seq ^\k);






theorem 
  seq is increasing & seq1 is subsequence of seq implies seq1 is increasing;

theorem 
  seq is decreasing & seq1 is subsequence of seq implies seq1 is decreasing;

theorem 
  seq is non-decreasing & seq1 is subsequence of seq implies seq1
  is non-decreasing;

theorem 
  seq is non-increasing & seq1 is subsequence of seq implies seq1
  is non-increasing;

theorem 
  seq is monotone & seq1 is subsequence of seq implies seq1 is monotone;

theorem 
  seq is bounded_above & seq1 is subsequence of seq implies seq1
  is bounded_above;

theorem 
  seq is bounded_below & seq1 is subsequence of seq implies seq1
  is bounded_below;

theorem 
  seq is bounded & seq1 is subsequence of seq implies seq1 is bounded;





theorem 
  (seq is increasing & 0<r implies r(#)seq is increasing) & (0=r implies
r(#)seq is constant) & (seq is increasing & r<0 implies r(#)seq is decreasing);

theorem 
  (seq is decreasing & 0<r implies r(#)seq is decreasing) & (seq is
  decreasing & r<0 implies r(#)seq is increasing);

theorem 
  (seq is non-decreasing & 0<=r implies r(#)seq is non-decreasing) & (
  seq is non-decreasing & r<=0 implies r(#)seq is non-increasing);

theorem 
  (seq is non-increasing & 0<=r implies r(#)seq is non-increasing) & (
  seq is non-increasing & r<=0 implies r(#)seq is non-decreasing);

theorem 
  (seq is increasing & seq1 is increasing implies seq+seq1 is
  increasing) & (seq is decreasing & seq1 is decreasing implies seq+seq1 is
decreasing) & (seq is non-decreasing & seq1 is non-decreasing implies seq+seq1
  is non-decreasing) & (seq is non-increasing & seq1 is non-increasing implies
  seq+seq1 is non-increasing);

theorem 
  (seq is increasing & seq1 is constant implies seq+seq1 is increasing)
& (seq is decreasing & seq1 is constant implies seq+seq1 is decreasing) & (seq
is non-decreasing & seq1 is constant implies seq+seq1 is non-decreasing) & (seq
  is non-increasing & seq1 is constant implies seq+seq1 is non-increasing);





theorem 
  (seq is bounded_above & 0<r implies r(#)seq is bounded_above) &
(0=r implies r(#)seq is bounded) & (seq is bounded_above & r<0 implies r(#)seq
  is bounded_below);

theorem 
  (seq is bounded implies for r holds r(#)seq is bounded) & (seq is
  bounded implies -seq is bounded) & (seq is bounded iff abs seq is bounded);





theorem 
  seq is bounded_above & seq1 is non-increasing implies seq+seq1 is
  bounded_above;

theorem 
  seq is bounded_below & seq1 is non-decreasing implies seq+seq1 is
  bounded_below;

theorem 
  incl NAT is increasing natural-valued;

registration
  cluster -> natural-valued for FinSequence of NAT;
end;

begin 

reserve v for FinSequence of REAL,
  r,s for Real,
  n,m,i,j,k for Element of NAT;

theorem 
  abs(r-s)=1 iff r>s & r=s+1 or r<s & s=r+1;

theorem 
  abs(i-j)+abs(n-m)=1 iff abs(i-j)=1 & n=m or abs(n-m)=1 & i=j;

theorem 
  n>1 iff ex m st n=m+1 & m>0;

theorem 
  for f being FinSequence,n,m,k st len f = m+1 & n in dom f & k in
  Seg m holds Del(f,n).k = f.k or Del(f,n).k = f.(k+1);

definition
  let f be FinSequence;
  redefine attr f is constant means

  for n,m st n in dom f & m in dom f holds f.n=f.m;
end;

registration
  cluster -> real-valued for FinSequence of REAL;
end;

registration
  cluster non empty increasing for FinSequence of REAL;
end;

registration
  cluster constant for FinSequence of REAL;
end;

theorem 
  v<>{} & rng v c= Seg n & v.(len v) = n & (for k st 1<=k & k<=len
v - 1 holds for r,s st r = v.k & s = v.(k+1) holds abs(r-s) = 1 or r=s) & i in
  Seg n & i+1 in Seg n & m in dom v & v.m = i & (for k st k in dom v & v.k = i
  holds k<=m) implies m+1 in dom v & v.(m+1)=i+1;

theorem 
  v<>{} & rng v c= Seg n & v.1 = 1 & v.(len v) = n & (for k st 1<=k & k
  <=len v - 1 holds for r,s st r = v.k & s = v.(k+1) holds abs(r-s) = 1 or r=s)
  implies (for i st i in Seg n ex k st k in dom v & v.k = i) & for m,k,i,r st m
  in dom v & v.m = i & (for j st j in dom v & v.j = i holds j<=m) & m<k & k in
  dom v & r = v.k
   holds i<r;














begin

reserve x,y for set,
  n,m for Element of NAT,
  r,s for Real;

registration
  let f be FinSequence, x be set;
  cluster Coim(f,x) -> finite;
end;

theorem 
  for f,g,h be FinSequence holds f,g are_fiberwise_equipotent iff
  f^h, g^h are_fiberwise_equipotent;

theorem 
  for f,g be FinSequence holds f^g, g^f are_fiberwise_equipotent;

theorem 
  for f,g be FinSequence st f,g are_fiberwise_equipotent holds len
  f = len g & dom f = dom g;

theorem 
  for f,g be FinSequence holds f,g are_fiberwise_equipotent iff ex
  P be Permutation of dom g st f = g*P;

theorem 
  for F be Function, X be finite set ex f be FinSequence st F|X, f
  are_fiberwise_equipotent;

definition
  let n be Nat, f be FinSequence;
  func f /^ n -> FinSequence means


  len it = len f - n & for m be Nat st
  m in dom it holds it.m = f.(m+n) if n<=len f otherwise it = {};
end;

definition
  let D be set, n be Nat, f be FinSequence of D;
  redefine func f /^ n -> FinSequence of D;
end;

theorem 
  for D be non empty set, f be FinSequence of D, n,m be Nat holds
  n in dom f & m in Seg n implies (f|n).m = f.m & m in dom f;

theorem 
  for D be non empty set, f be FinSequence of D, n be Nat, x be
  set st len f = n+1 & x = f.(n+1) holds f = (f|n) ^ <*x*>;

theorem 
  for D be non empty set, f be FinSequence of D, n be Nat holds
  (f|n)^(f/^n) = f;

theorem 
  for R1,R2 be FinSequence of REAL st R1,R2 are_fiberwise_equipotent
  holds Sum R1 = Sum R2;

definition
  let R be FinSequence of REAL;
  func MIM(R) -> FinSequence of REAL means


  len it = len R & it.(len it) = R.(len R) &
  for n be Nat st 1 <= n & n <= len it - 1 holds it.n = (R.n) - (R.(n+1));
end;

theorem 
  for R be FinSequence of REAL, r be Real, n be Element of NAT st
  len R = n+2 & R.(n+1) = r holds MIM(R|(n+1)) = MIM(R)|n ^ <* r *>;

theorem 
  for R be FinSequence of REAL, r,s be Real, n be Element of NAT
  st len R = n+2 & R.(n+1) = r & R.(n+2) = s holds
  MIM(R) = MIM(R)|n ^ <* r-s,s *>;

theorem 
  MIM( <*>REAL ) = <*>REAL;

theorem 
  for r be Real holds MIM(<*r*>) = <*r*>;

theorem 
  for r,s be Real holds MIM(<*r,s*>) = <*r-s,s*>;

theorem 
  for R be FinSequence of REAL, n be Element of NAT holds MIM(R) /^ n =
  MIM(R/^n);

theorem 
  for R be FinSequence of REAL st len R <> 0 holds Sum MIM(R) = R. 1;

theorem 
  for R be FinSequence of REAL, n be Element of NAT st n<len R holds Sum
  MIM(R/^n) = R.(n+1);

definition
  let IT be FinSequence of REAL;
  redefine attr IT is non-increasing means


  for n be Element of NAT st n in dom IT & n+1 in dom IT holds
  IT.n >= IT.(n+1);
end;

registration
  cluster non-increasing for FinSequence of REAL;
end;

theorem 
  for R be FinSequence of REAL st len R = 0 or len R = 1 holds
  R is non-increasing;

theorem 
  for R be FinSequence of REAL holds R is non-increasing iff for n
  ,m be Element of NAT st n in dom R & m in dom R & n<m holds R.n>=R.m;

theorem 
  for R be non-increasing FinSequence of REAL, n be Element of NAT
  holds R|n is non-increasing FinSequence of REAL;

theorem 
  for R be non-increasing FinSequence of REAL, n be Element of NAT holds
  R /^ n is non-increasing;

theorem 
  for R be FinSequence of REAL ex R1 be non-increasing FinSequence of
  REAL st R,R1 are_fiberwise_equipotent;

theorem 
  for R1,R2 be non-increasing FinSequence of REAL st R1,R2
  are_fiberwise_equipotent holds R1 = R2;

theorem 
  for R be FinSequence of REAL, r,s be Real st r <> 0 holds R"{s/r} = (r
  *R)"{ s };

theorem 
  for R be FinSequence of REAL holds (0*R)"{0} = dom R;

begin 


reserve f, g for Function;

theorem 
  for f, g st rng f = rng g & f is one-to-one & g is one-to-one holds
  f,g are_fiberwise_equipotent;



theorem 
  for D being set, f being FinSequence of D holds f /^ len f = {};



theorem 
  for f,g be Function,m,n be set st f.m=g.n & f.n=g.m & m in dom f & n
in dom f & dom f = dom g & (for k be set st k<>m & k<>n & k in dom f holds f.k=
  g.k) holds f,g are_fiberwise_equipotent;



theorem 
  for D being non empty set, f being FinSequence of D, k being Nat holds
  len (f/^k)=len f-'k;



theorem 
  for f,g be FinSequence,x be set st x in dom g & f,g
  are_fiberwise_equipotent holds ex y be set st y in dom g & f.x=g.y;

theorem 
  for f,g,h be FinSequence holds f,g are_fiberwise_equipotent iff
  h^f, h^g are_fiberwise_equipotent;

theorem 
  for f,g be FinSequence,m,n,j be Element of NAT st f,g
are_fiberwise_equipotent & m<=n & n <= len f & (for i be Element of NAT st 1<=i
& i<=m holds f.i=g.i) & (for i be Element of NAT st n<i & i<=len f holds f.i=g.
  i) & m<j & j<=n holds ex k be Element of NAT st m<k & k<=n & f.j=g.k;

theorem 
  for t being FinSequence of INT holds ex u being FinSequence of REAL
  st t,u are_fiberwise_equipotent & u is FinSequence of INT
  & u is non-increasing;















begin

reserve n,k,k1,m,m1,n1,n2,l for Element of NAT;
reserve r,r1,r2,p,p1,g,g1,g2,s,s1,s2,t for real number;
reserve seq,seq1,seq2 for Real_Sequence;
reserve Nseq for increasing sequence of NAT;
reserve x for set;
reserve X,Y for Subset of REAL;

theorem 
  for X,Y st for r,p st r in X & p in Y holds r<p ex g st for r,p
  st r in X & p in Y holds r<=g & g<=p;

theorem 
  0<p & (ex r st r in X) & (for r st r in X holds r+p in X) implies
  for g ex r st r in X & g<r;

theorem 
  for r ex n st r<n;

theorem 
  X is real-bounded iff ex s st 0<s & for r st r in X holds abs(r)<s;

definition

  let r;
  redefine func {r} -> Subset of REAL;
end;

theorem 
  for X being real-membered set holds X is non empty bounded_above
implies ex g st (for r st r in X holds r<=g) & for s st 0<s ex r st r in X & g-
  s<r;

theorem 
  for X being real-membered set holds (for r st r in X holds r<=g1
) & (for s st 0<s ex r st (r in X & g1-s<r)) & (for r st r in X holds r<=g2) &
  (for s st 0<s ex r st (r in X & g2-s<r)) implies g1=g2;

theorem 
  for X being real-membered set holds X is non empty bounded_below
implies ex g st (for r st r in X holds g<=r) & for s st 0<s ex r st r in X & r<
  g+s;

theorem 
  for X being real-membered set holds (for r st r in X holds g1<=r
) & (for s st 0<s ex r st (r in X & r<g1+s)) & (for r st r in X holds g2<=r) &
  (for s st 0<s ex r st (r in X & r<g2+s)) implies g1=g2;

definition

  let X be real-membered set;
  assume
 X is non empty bounded_above;
  func upper_bound X -> real number means


  (for r st r in X holds r<=it) & for s st 0<s ex r st r in X & it-s<r;
end;

definition
  let X be real-membered set;
  assume
 X is non empty bounded_below;
  func lower_bound X -> real number means


  (for r st r in X holds it<=r) & for s st 0<s ex r st r in X & r<it+s;
end;

registration
  let X be non empty bounded_below real-membered set;
  identify lower_bound X with inf X;
end;

registration
  let X be non empty bounded_above real-membered set;
  identify upper_bound X with sup X;
end;

definition
  let X;
  redefine func upper_bound X -> Real;
  redefine func lower_bound X -> Real;
end;

theorem 
  lower_bound {r} = r & upper_bound {r} = r;

theorem 
  lower_bound {r} = upper_bound {r};

theorem 
  X is real-bounded non empty implies lower_bound X <= upper_bound X;

theorem 
  X is real-bounded non empty implies ((ex r,p st r in X & p in X & p<>r) iff
  lower_bound X < upper_bound X);





theorem 
  seq is convergent implies abs seq is convergent;

registration
  let seq be convergent Real_Sequence;
  cluster abs seq -> convergent for Real_Sequence;
end;

theorem 
  seq is convergent implies lim abs seq = abs lim seq;

theorem 
  abs seq is convergent & lim abs seq=0 implies seq is convergent & lim seq=0;

theorem 
  seq1 is subsequence of seq & seq is convergent implies seq1 is convergent;

theorem 
  seq1 is subsequence of seq & seq is convergent implies lim seq1= lim seq;

theorem 
  seq is convergent & (ex k st for n st k<=n holds seq1.n=seq.n)
  implies seq1 is convergent;

theorem 
  seq is convergent & (ex k st for n st k<=n holds seq1.n=seq.n) implies
  lim seq=lim seq1;

registration
  cluster constant -> convergent for Real_Sequence;
end;

registration
  cluster constant for Real_Sequence;
end;

registration
  let seq be convergent Real_Sequence;
  let k;
  cluster seq ^\ k -> convergent for Real_Sequence;
end;

theorem 
  seq is convergent implies lim (seq^\k)=lim seq;

theorem 
  seq^\k is convergent implies seq is convergent;

theorem 
  seq^\k is convergent implies lim seq = lim (seq^\k);

theorem 
  seq is convergent & lim seq<>0 implies ex k st (seq ^\k) is non-zero;

theorem 
  seq is convergent & lim seq<>0 implies ex seq1 st seq1 is subsequence
  of seq & seq1 is non-zero;

theorem 
 seq is constant & (r in rng seq or ex n st seq.n=r ) implies lim seq=r;

theorem 
  seq is constant implies for n holds lim seq=seq.n;

theorem 
  seq is convergent & lim seq<>0 implies for seq1 st seq1 is subsequence
  of seq & seq1 is non-zero holds lim (seq1")=(lim seq)";

theorem 
  0<=r & (for n holds seq.n=1/(n+r)) implies seq is convergent;

theorem 
  0<=r & (for n holds seq.n=1/(n+r)) implies lim seq=0;

theorem 
  (for n holds seq.n=1/(n+1)) implies seq is convergent & lim seq=0;

theorem 
  0<=r & (for n holds seq.n=g/(n+r)) implies seq is convergent & lim seq =0;

theorem 
  0<=r & (for n holds seq.n=1/(n*n+r)) implies seq is convergent;

theorem 
  0<=r & (for n holds seq.n=1/(n*n+r)) implies lim seq=0;

theorem 
  (for n holds seq.n=1/(n*n+1)) implies seq is convergent & lim seq=0;

theorem 
  0<=r & (for n holds seq.n=g/(n*n+r)) implies seq is convergent & lim seq=0;

registration
  cluster non-decreasing bounded_above -> convergent for Real_Sequence;
end;

registration
  cluster non-increasing bounded_below -> convergent for Real_Sequence;
end;

registration
  cluster monotone bounded -> convergent for Real_Sequence;
end;

theorem 
  seq is monotone & seq is bounded implies seq is convergent;

theorem 
  seq is bounded_above & seq is non-decreasing implies for n holds seq.n
  <=lim seq;

theorem 
  seq is bounded_below & seq is non-increasing implies for n holds lim
  seq <= seq.n;

theorem 
  for seq ex Nseq st seq*Nseq is monotone;


theorem 
  seq is bounded implies ex seq1 st seq1 is subsequence of seq &
  seq1 is convergent;


theorem 
  seq is convergent iff for s st 0<s ex n st for m st n<=m holds abs(seq
  .m -seq.n)<s;

theorem 
  seq is constant & seq1 is convergent implies lim (seq+seq1) =(seq.0) +
lim seq1 & lim (seq-seq1) =(seq.0) - lim seq1 & lim (seq1-seq) =(lim seq1) -seq
  .0 & lim (seq(#)seq1) =(seq.0) * (lim seq1);

begin 


theorem 
  for X being non empty real-membered set for t st for s st s in X
  holds s >= t holds lower_bound X >= t;

theorem 
  for X being non empty real-membered set st (for s st s in X holds s >=
r) & for t st for s st s in X holds s >= t holds r >= t holds r = lower_bound X
;

theorem 
  for X being non empty real-membered set, r for t st for s st s
  in X holds s <= t holds upper_bound X <= t;

theorem 
  for X being non empty real-membered set, r st (for s st s in X holds s
  <= r) & for t st for s st s in X holds s <= t holds r <= t holds r =
  upper_bound X;

theorem 
  for X being non empty real-membered set, Y being real-membered set st
  X c= Y & Y is bounded_below holds lower_bound Y <= lower_bound X;

theorem 
  for X being non empty real-membered set, Y being real-membered set st
  X c= Y & Y is bounded_above holds upper_bound X <= upper_bound Y;



definition
  let A be non empty natural-membered set;
  redefine func min A -> Element of NAT;
end;

begin 

reserve k,n for Element of NAT,
  r,r9,r1,r2 for Real,
  c,c9,c1,c2,c3 for Element of COMPLEX;

theorem 
  0c is_a_unity_wrt addcomplex;

theorem 
  compcomplex is_an_inverseOp_wrt addcomplex;

theorem 
  addcomplex is having_an_inverseOp;

theorem 
  the_inverseOp_wrt addcomplex = compcomplex;

definition
  redefine func diffcomplex equals

  addcomplex*(id COMPLEX,compcomplex);
end;

theorem 
  1r is_a_unity_wrt multcomplex;

theorem 
  multcomplex is_distributive_wrt addcomplex;

definition let c be complex number;
  func c multcomplex -> UnOp of COMPLEX equals

  multcomplex[;](c,id COMPLEX);
end;

theorem 
  (c multcomplex).c9 = c*c9;

theorem 
  c multcomplex is_distributive_wrt addcomplex;

definition
  func abscomplex -> Function of COMPLEX,REAL means

  for c holds it.c = |.c.|;
end;

reserve z,z1,z2 for FinSequence of COMPLEX;

definition let z1,z2;
  redefine func z1 + z2 -> FinSequence of COMPLEX equals

  addcomplex.:(z1,z2);
  redefine func z1 - z2 -> FinSequence of COMPLEX equals

  diffcomplex.:(z1,z2);
end;

definition let z;
  redefine func -z -> FinSequence of COMPLEX equals

  compcomplex*z;
end;

notation let z;
  let c be complex number;
  synonym c*z for c(#)z;
end;

definition let z;
  let c be complex number;
  redefine func c*z -> FinSequence of COMPLEX equals

  (c multcomplex)*z;
end;

definition let z;
  redefine func abs z -> FinSequence of REAL equals

  abscomplex*z;
end;

definition let n;
  func COMPLEX n -> FinSequenceSet of COMPLEX equals

  n-tuples_on COMPLEX;
end;

registration let n;
  cluster COMPLEX n -> non empty;
end;

reserve x,z,z1,z2,z3 for Element of COMPLEX n,
  A,B for Subset of COMPLEX n;

theorem 
  k in Seg n implies z.k in COMPLEX;

definition let n,z1,z2;
  redefine func z1 + z2 -> Element of COMPLEX n;
end;

theorem 
  k in Seg n & c1 = z1.k & c2 = z2.k implies (z1 + z2).k = c1 + c2;

definition let n;
  func 0c n -> FinSequence of COMPLEX equals

  n |-> 0c;
end;

definition let n;
  redefine func 0c n -> Element of COMPLEX n;
end;

theorem 
  z + 0c n = z & z = 0c n + z;

definition let n,z;
  redefine func -z -> Element of COMPLEX n;
end;

theorem 
  k in Seg n & c = z.k implies (-z).k = -c;

theorem 
  z + -z = 0c n & -z + z = 0c n;

theorem 
  z1 + z2 = 0c n implies z1 = -z2 & z2 = -z1
;

canceled;

theorem 
  -z1 = -z2 implies z1 = z2;

theorem 
  z1 + z = z2 + z or z1 + z = z + z2 implies z1 = z2;

theorem 
  -(z1 + z2) = -z1 + -z2;

definition let n,z1,z2;
  redefine func z1 - z2 -> Element of COMPLEX n;
end;

theorem 
  k in Seg n implies (z1 - z2).k = z1.k - z2.k;

theorem 
  z - 0c n = z;

theorem 
  0c n - z = -z;

theorem 
  z1 - -z2 = z1 + z2;

theorem 
  -(z1 - z2) = z2 - z1;

theorem 
  -(z1 - z2) = -z1 + z2;

theorem 
  z - z = 0c n;

theorem 
  z1 - z2 = 0c n implies z1 = z2;

theorem 
  z1 - z2 - z3 = z1 - (z2 + z3);

theorem 
  z1 + (z2 - z3) = z1 + z2 - z3;

theorem 
  z1 - (z2 - z3) = z1 - z2 + z3;

theorem 
  z1 - z2 + z3 = z1 + z3 - z2;

theorem 
  z1 = z1 + z - z;

theorem 
  z1 + (z2 - z1) = z2;

theorem 
  z1 = z1 - z + z;

definition let n,z,c;
  redefine func c*z -> Element of COMPLEX n;
end;

theorem 
  k in Seg n & c9 = z.k implies (c*z).k = c*c9;

theorem 
  c1*(c2*z) = (c1*c2)*z;

theorem 
  (c1 + c2)*z = c1*z + c2*z;

theorem 
  c*(z1+z2) = c*z1 + c*z2;

theorem 
  1r*z = z;

theorem 
  0c*z = 0c n;

theorem 
  (-1r)*z = -z;

definition let n,z;
  redefine func abs z -> Element of n-tuples_on REAL;
end;

theorem 
  k in Seg n & c = z.k implies (abs z).k = |.c.|;

theorem 
  abs 0c n = n |-> 0;

theorem 
  abs -z = abs z;

theorem 
  abs(c*z) = |.c.|*(abs z);

definition
  let z be FinSequence of COMPLEX;
  func |.z.| -> Real equals

  sqrt Sum sqr abs z;
end;

theorem 
  |.0c n.| = 0;

theorem 
  |.z.| = 0 implies z = 0c n;

theorem 
  0 <= |.z.|;

theorem 
  |.-z.| = |.z.|;

theorem 
  |.c*z.| = |.c.|*|.z.|;

theorem 
  |.z1 + z2.| <= |.z1.| + |.z2.|;

theorem 
  |.z1 - z2.| <= |.z1.| + |.z2.|;

theorem 
  |.z1.| - |.z2.| <= |.z1 + z2.|;

theorem 
  |.z1.| - |.z2.| <= |.z1 - z2.|;

theorem 
  |.z1 - z2.| = 0 iff z1 = z2;

theorem 
  z1 <> z2 implies 0 < |.z1 - z2.|;

theorem 
  |.z1 - z2.| = |.z2 - z1.|;

theorem 
  |.z1 - z2.| <= |.z1 - z.| + |.z - z2.|;

definition
  let n;
  let A be Subset of COMPLEX n;
  attr A is open means


  for x st x in A ex r st 0 < r & for z st |.z.| < r holds x + z in A;
end;

definition let n;
  let A be Subset of COMPLEX n;
  attr A is closed means

  for x st for r st r > 0 ex z st |.z.| < r & x + z in A holds x in A;
end;

theorem 
  for A being Subset of COMPLEX n st A = {} holds A is open;

theorem 
  for A being Subset of COMPLEX n st A = COMPLEX n holds A is open;

theorem 
  for AA being Subset-Family of COMPLEX n st for A being Subset of
  COMPLEX n st A in AA holds A is open for A being Subset of COMPLEX n st A =
  union AA holds A is open;

theorem 
  for A,B being Subset of COMPLEX n st A is open & B is open for C
  being Subset of COMPLEX n st C = A /\ B holds C is open;

definition
  let n,x,r;
  func Ball(x,r) -> Subset of COMPLEX n equals

  { z : |.z - x.| < r };
end;

theorem 
  z in Ball(x,r) iff |.x - z.| < r;

theorem 
  0 < r implies x in Ball(x,r);

theorem 
  Ball(z1,r1) is open;

definition let n,x,A;
  func dist(x,A) -> Real means


  for X being Subset of REAL st X = {|.x
  - z.| : z in A} holds it = lower_bound X;
end;

definition let n,A,r;
  func Ball(A,r) -> Subset of COMPLEX n equals

  { z : dist(z,A) < r };
end;

theorem 
  for X being Subset of REAL, r st X <> {} & for r9 st r9 in X
  holds r <= r9 holds lower_bound X >= r;

theorem 
  A <> {} implies dist(x,A) >= 0;

theorem 
  A <> {} implies dist(x + z,A) <= dist(x,A) + |.z.|;

theorem 
  x in A implies dist(x,A) = 0;

theorem 
  not x in A & A <> {} & A is closed implies dist(x,A) > 0;

theorem 
  A <> {} implies |.z1 - x.| + dist(x,A) >= dist(z1,A);

theorem 
  z in Ball(A,r) iff dist(z,A) < r;

theorem 
  0 < r & x in A implies x in Ball(A,r);

theorem 
  0 < r implies A c= Ball(A,r);

theorem 
  A <> {} implies Ball(A,r1) is open;

definition
  let n,A,B;
  func dist(A,B) -> Real means


  for X being Subset of REAL st X = {|.x
  - z.| : x in A & z in B} holds it = lower_bound X;
end;

theorem 
  for X,Y being Subset of REAL holds X <> {} & Y <> {} implies X ++ Y <> {};

theorem 
  for X,Y being Subset of REAL holds X is bounded_below &
    Y is bounded_below implies X++Y is bounded_below;

theorem 
  for X,Y being Subset of REAL st
  X <> {} & X is bounded_below & Y <> {} & Y is bounded_below holds
  lower_bound (X ++ Y) = lower_bound X + lower_bound Y;

theorem 
  for X,Y being Subset of REAL st Y is bounded_below & X <> {} &
  for r st r in X ex r1 st r1 in Y & r1 <= r holds
    lower_bound X >= lower_bound Y;

theorem 
  A <> {} & B <> {} implies dist(A,B) >= 0;

theorem 
  dist(A,B) = dist(B,A);

theorem 
  A <> {} & B <> {} implies dist(x,A) + dist(x,B) >= dist(A,B);

theorem 
  A meets B implies dist(A,B) = 0;

definition
  let n;
  func ComplexOpenSets(n) -> Subset-Family of COMPLEX n equals

  {A where A is
  Subset of COMPLEX n: A is open};
end;

theorem 
  for A being Subset of COMPLEX n holds A in ComplexOpenSets n iff A is open;

theorem 
  for A being Subset of COMPLEX n holds A is closed iff A` is open;

begin 

reserve
  v,v1,v2 for FinSequence of REAL,
  n,m,k for Element of NAT,
  x for set;

theorem 
  for R being finite Subset of REAL holds R <> {} implies R is
bounded_above & upper_bound(R) in R & R is bounded_below & lower_bound(R) in R;

theorem 
  for n being Nat for f being FinSequence holds 1 <= n & n+1 <= len
  f iff n in dom f & n+1 in dom f;

theorem 
  for n being Nat for f being FinSequence holds 1 <= n & n+2 <= len f
  iff n in dom f & n+1 in dom f & n+2 in dom f;

theorem 
  for D being non empty set, f1,f2 being FinSequence of D, n st 1
  <= n & n <= len f2 holds (f1^f2)/.(n + len f1) = f2/.n;

theorem 
  v is increasing implies for n,m st n in dom v & m in dom v & n<=m
  holds v.n <= v.m;

theorem 
  v is increasing implies for n,m st n in dom v & m in dom v & n<>
  m holds v.n<>v.m;

theorem 
  v is increasing & v1 = v|Seg n implies v1 is increasing;

theorem 
  for v holds ex v1 st rng v1 = rng v & len v1 = card rng v & v1 is
  increasing;

theorem 
  for v1,v2 st len v1 = len v2 & rng v1 = rng v2 & v1 is increasing & v2
  is increasing holds v1 = v2;

definition
  let v;
  func Incr(v) ->increasing FinSequence of REAL means


  rng it = rng v & len it = card rng v;
end;

registration
  let v be non empty FinSequence of REAL;
  cluster Incr v -> non empty;
end;



registration
  cluster non empty bounded_above bounded_below for Subset of REAL;
end;

theorem 
  for A,B being non empty bounded_below Subset of REAL holds lower_bound(A
  \/ B) = min(lower_bound A,lower_bound B);

theorem 
  for A,B being non empty bounded_above Subset of REAL holds upper_bound(A
  \/ B) = max(upper_bound A,upper_bound B);



theorem 
  for R being non empty Subset of REAL,r0 being real number st for
  r being real number st r in R holds r <= r0 holds upper_bound R <= r0;















begin

reserve n,n1,m,k for Element of NAT;
reserve x,y for set;
reserve s,g,g1,g2,r,p,q,t for real number;
reserve s1,s2,s3 for Real_Sequence;
reserve Nseq for increasing sequence of NAT;
reserve X for Subset of REAL;

definition
  let g,s be real number;
  redefine func [. g,s .] -> Subset of REAL equals

  {r where r is Real: g<=r &
  r<=s };
end;

definition
  let g,s be ext-real number;
  redefine func ]. g,s .[ -> Subset of REAL equals

  {r where r is Real : g<r &
  r<s };
end;

theorem 
  r in ].p-g,p+g.[ iff abs(r-p)<g;

theorem 
  r in [.p,g.] iff abs(p+g-2*r)<=g-p;

theorem 
  r in ].p,g.[ iff abs(p+g-2*r)<g-p;

definition
  let X;
  attr X is compact means


  for s1 st rng s1 c= X ex s2 st s2 is
  subsequence of s1 & s2 is convergent & lim s2 in X;
end;

definition
  let X;
  attr X is closed means


  for s1 st rng s1 c= X & s1 is convergent holds lim s1 in X;
end;

definition
  let X;
  attr X is open means


  X` is closed;
end;

theorem 
  for s1 st rng s1 c= [.s,g.] holds s1 is bounded;

theorem 
  [.s,g.] is closed;

theorem 
  [.s,g.] is compact;

theorem 
  ].p,q.[ is open;

registration
  let p, q be real number;
  cluster ].p,q.[ -> open for Subset of REAL;
  cluster [.p,q.] -> closed for Subset of REAL;
end;

theorem 
  X is compact implies X is closed;

registration
  cluster compact -> closed for Subset of REAL;
end;

theorem 
  (for p st p in X ex r,n st 0<r & (for m st n<m holds r<abs(s1.m
- p))) implies for s2 st s2 is subsequence of s1 holds not (s2 is convergent &
  lim s2 in X);

theorem 
  X is compact implies X is real-bounded;

theorem 
  X is real-bounded closed implies X is compact;

theorem 
  for X st X<>{} & X is closed & X is bounded_above holds upper_bound X in X;

theorem 
  for X st X<>{} & X is closed & X is bounded_below holds lower_bound X in X;

theorem 
  for X st X<>{} & X is compact holds upper_bound X in X & lower_bound X in X;

theorem 
  X is compact & (for g1,g2 st g1 in X & g2 in X holds [.g1,g2.] c= X)
  implies ex p,g st X = [.p,g.];

registration
  cluster open for Subset of REAL;
end;

definition
  let r be real number;

  mode Neighbourhood of r -> Subset of REAL means


    ex g st 0<g & it = ]. r-g,r+g.[;
end;

registration
  let r be real number;
  cluster -> open for Neighbourhood of r;
end;

theorem 
  for N being Neighbourhood of r holds r in N;

theorem 
  for r for N1,N2 being Neighbourhood of r ex N being Neighbourhood of r
  st N c= N1 & N c= N2;

theorem 
  for X being open Subset of REAL, r st r in X ex N being
  Neighbourhood of r st N c= X;

theorem 
  for X being open Subset of REAL, r st r in X ex g st 0<g & ].r-g,r+g.[ c= X;

theorem 
  (for r st r in X holds ex N be Neighbourhood of r st N c= X) implies X
  is open;

theorem 
  X is open bounded_above implies not upper_bound X in X;

theorem 
  X is open bounded_below implies not lower_bound X in X;

theorem 
  X is open real-bounded & (for g1,g2 st g1 in X & g2 in X holds [.g1,g2.] c=
  X) implies ex p,g st X = ].p,g.[;



definition
  let g be real number,s be ext-real number;
  redefine func [. g,s .[ -> Subset of REAL equals

  { r where r is Real : g<=r
  & r<s };
end;

definition
  let g be ext-real number,s be real number;
  redefine func ]. g,s .] -> Subset of REAL equals

  { r where r is Real : g<r &
  r<=s };
end;














begin

reserve x,X,Y for set;
reserve g,r,r1,r2,p,p1,p2 for Element of REAL;
reserve R for Subset of REAL;
reserve seq,seq1,seq2,seq3 for Real_Sequence;
reserve Ns for increasing sequence of NAT;
reserve n for Element of NAT;
reserve W for non empty set;
reserve h,h1,h2 for PartFunc of W,REAL;





theorem 
  seq1=seq2-seq3 iff for n holds seq1.n=seq2.n-seq3.n;

theorem 
  (seq1 + seq2)*Ns = (seq1*Ns) + (seq2*Ns) & (seq1 - seq2)*Ns = (
  seq1*Ns) - (seq2*Ns) & (seq1 (#) seq2)*Ns = (seq1*Ns) (#) (seq2*Ns);

theorem 
  (p(#)seq)*Ns = p(#)(seq*Ns);

theorem 
  (-seq)*Ns = -(seq*Ns) & (abs(seq))*Ns = abs((seq*Ns));

theorem 
  (seq*Ns)" = (seq")*Ns;

theorem 
  (seq1/"seq)*Ns = (seq1*Ns)/"(seq*Ns);

theorem 
  seq is convergent & (for n holds seq.n<=0) implies lim seq <= 0;

theorem 
  for h1,h2 being PartFunc of W,REAL, seq being sequence of W holds
  rng seq c= dom h1 /\ dom h2 implies (h1+h2)/*seq=h1/*seq+h2/*seq
  & (h1-h2)/*seq=h1/*seq-h2/*seq & (h1(#)h2)/*seq=(h1/*seq)(#)(h2/*seq);

theorem 
  for h being PartFunc of W,REAL, seq being sequence of W holds
  for r being real number holds rng seq c= dom h implies
  (r(#)h)/*seq = r(#) (h/*seq);

theorem 
  for h being PartFunc of W,REAL, seq being sequence of W holds
  rng seq c= dom h implies abs(h/*seq) = (abs(h))/*seq & -(h/*seq) = (-h )/*seq
;

theorem 
  for h being PartFunc of W,REAL, seq being sequence of W holds
  rng seq c= dom (h^) implies h/*seq is non-zero;

theorem 
  for h being PartFunc of W,REAL, seq being sequence of W holds
  rng seq c= dom (h^) implies (h^)/*seq =(h/*seq)";

theorem 
  for h1,h2 being PartFunc of W,REAL, seq being sequence of W holds
  h1 is total & h2 is total implies
  (h1+h2)/*seq = h1/*seq + h2/*seq & (h1-h2)/*seq = h1/*seq - h2/*seq &
  (h1(#)h2)/*seq = (h1/*seq) (#) (h2/*seq);

theorem 
  for h being PartFunc of W,REAL, seq being sequence of W holds
  h is total implies (r(#)h)/*seq = r(#)(h/*seq);

theorem 
  for h being PartFunc of W,REAL, seq being sequence of W holds
  rng seq c= dom (h|X) implies abs((h|X)/*seq) = ((abs(h))|X)/*seq;

theorem 
  for h being PartFunc of W,REAL, seq being sequence of W holds
  rng seq c= dom (h|X) & h"{0}={} implies ((h^)|X)/*seq = ((h|X)/*seq)";





registration
  let Z be set;
  let f be one-to-one Function;
  cluster f|Z -> one-to-one;
end;

theorem 
  for h being one-to-one Function holds (h|X)" = (h")|(h.:X);

theorem 
  for h being PartFunc of W,REAL holds
  rng h is real-bounded & upper_bound (rng h) = lower_bound (rng h)
  implies h is constant;

theorem 
  for h being PartFunc of W,REAL holds
  h.:Y is real-bounded & upper_bound(h.:Y) = lower_bound(h.:Y) implies
  h|Y is constant;

reserve e1,e2 for ext-real number;
reserve h,h1,h2 for PartFunc of REAL,REAL;

definition
  let h;
  redefine attr h is increasing means


  for r1,r2 st r1 in dom h & r2 in dom h & r1<r2 holds h.r1 < h.r2;
  redefine attr h is decreasing means


  for r1,r2 st r1 in dom h & r2 in dom h & r1<r2 holds h.r2 < h.r1;
  redefine attr h is non-decreasing means


  for r1,r2 st r1 in dom h & r2 in dom h & r1<r2 holds h.r1 <= h.r2;
  redefine attr h is non-increasing means


  for r1,r2 st r1 in dom h & r2 in dom h & r1<r2 holds h.r2 <= h.r1;
end;

theorem 
  h|Y is increasing iff for r1,r2 st r1 in Y /\ dom h & r2 in Y /\
  dom h & r1<r2 holds h.r1 < h.r2;

theorem 
  h|Y is decreasing iff for r1,r2 st r1 in Y /\ dom h & r2 in Y /\
  dom h & r1<r2 holds h.r2 < h.r1;

theorem 
  h|Y is non-decreasing iff for r1,r2 st r1 in Y /\ dom h & r2 in
  Y /\ dom h & r1<r2 holds h.r1 <= h.r2;

theorem 
  h|Y is non-increasing iff for r1,r2 st r1 in Y /\ dom h & r2 in
  Y /\ dom h & r1<r2 holds h.r2 <= h.r1;

definition
  let h;
  attr h is monotone means


  h is non-decreasing or h is non-increasing;
end;

registration
  cluster non-decreasing -> monotone for PartFunc of REAL,REAL;
  cluster non-increasing -> monotone for PartFunc of REAL,REAL;
  cluster non monotone -> non non-decreasing non non-increasing for PartFunc of
    REAL,REAL;
end;

theorem 
  h|Y is non-decreasing iff for r1,r2 st r1 in Y /\ dom h & r2 in
  Y /\ dom h & r1<=r2 holds h.r1 <= h.r2;

theorem 
  h|Y is non-increasing iff for r1,r2 st r1 in Y /\ dom h & r2 in
  Y /\ dom h & r1<=r2 holds h.r2 <= h.r1;

registration
  cluster non-decreasing non-increasing -> constant for PartFunc of REAL,REAL;
end;

registration
  cluster constant -> non-increasing non-decreasing for PartFunc of REAL,REAL;
end;

registration
  cluster trivial for PartFunc of REAL,REAL;
end;

registration
  let h be increasing PartFunc of REAL,REAL, X be set;
  cluster h|X -> increasing for PartFunc of REAL,REAL;
end;

registration
  let h be decreasing PartFunc of REAL,REAL, X be set;
  cluster h|X -> decreasing for PartFunc of REAL,REAL;
end;

registration
  let h be non-decreasing PartFunc of REAL,REAL, X be set;
  cluster h|X -> non-decreasing for PartFunc of REAL,REAL;
end;

theorem 
  Y misses dom h implies h|Y is increasing & h|Y is decreasing & h|Y is
  non-decreasing & h|Y is non-increasing & h|Y is monotone;

theorem 
  h|Y is non-decreasing & h|X is non-increasing implies h|(Y /\ X) is constant;

theorem 
  X c= Y & h|Y is increasing implies h|X is increasing;

theorem 
  X c= Y & h|Y is decreasing implies h|X is decreasing;

theorem 
  X c= Y & h|Y is non-decreasing implies h|X is non-decreasing;

theorem 
  X c= Y & h|Y is non-increasing implies h|X is non-increasing;

theorem 
  (h|Y is increasing & 0<r implies (r(#)h)|Y is increasing) & (r =
  0 implies (r(#)h)|Y is constant) & (h|Y is increasing & r<0 implies (r(#)h)|Y
  is decreasing);

theorem 
  (h|Y is decreasing & 0<r implies (r(#)h)|Y is decreasing) & (h|Y is
  decreasing & r<0 implies (r(#)h)|Y is increasing);

theorem 
  (h|Y is non-decreasing & 0<=r implies (r(#)h)|Y is
  non-decreasing) & (h|Y is non-decreasing & r<=0 implies (r(#)h)|Y is
  non-increasing);

theorem 
  (h|Y is non-increasing & 0<=r implies (r(#)h)|Y is non-increasing) & (
  h|Y is non-increasing & r<=0 implies (r(#)h)|Y is non-decreasing);

theorem 
  r in X /\ Y /\ dom (h1+h2) implies r in X /\ dom h1 & r in Y /\ dom h2;

theorem 
  (h1|X is increasing & h2|Y is increasing implies (h1+h2)|(X /\ Y) is
increasing) & (h1|X is decreasing & h2|Y is decreasing implies (h1+h2)|(X /\ Y)
is decreasing) & (h1|X is non-decreasing & h2|Y is non-decreasing implies (h1+
  h2)|(X /\ Y) is non-decreasing) & (h1|X is non-increasing & h2|Y is
  non-increasing implies (h1+h2)|(X /\ Y) is non-increasing);

theorem 
  (h1|X is increasing & h2|Y is constant implies (h1+h2)|(X /\ Y) is
  increasing) & (h1|X is decreasing & h2|Y is constant implies (h1+h2)|(X /\ Y)
  is decreasing);

theorem 
  h1|X is increasing & h2|Y is non-decreasing implies (h1+h2)|(X /\ Y)
  is increasing;

theorem 
  h1|X is non-increasing & h2|Y is constant implies (h1+h2)|(X /\ Y) is
  non-increasing;

theorem 
  h1|X is decreasing & h2|Y is non-increasing implies (h1+h2)|(X /\ Y)
  is decreasing;

theorem 
  h1|X is non-decreasing & h2|Y is constant implies (h1+h2)|(X /\ Y) is
  non-decreasing;

theorem 
  h|{x} is non-increasing;

theorem 
  h|{x} is decreasing;

theorem 
  h|{x} is non-decreasing;

theorem 
  h|{x} is non-increasing;

theorem 
  (id R)|R is increasing;

theorem 
  h|X is increasing implies (-h)|X is decreasing;

theorem 
  h|X is non-decreasing implies (-h)|X is non-increasing;

theorem 
  (h|[.p,g.] is increasing or h|[.p,g.] is decreasing) implies h|[.p,g.]
  is one-to-one;

theorem 
  for h being one-to-one PartFunc of REAL, REAL st h|[.p,g.] is
  increasing holds (h|[.p,g.])"|(h.:[.p,g.]) is increasing;

theorem 
  for h being one-to-one PartFunc of REAL, REAL st h|[.p,g.] is
  decreasing holds (h|[.p,g.])"|(h.:[.p,g.]) is decreasing;














begin

reserve x,y,X,Y for set;
reserve C for non empty set;
reserve c for Element of C;
reserve f,f1,f2,f3,g,g1 for PartFunc of C,COMPLEX;
reserve r1,r2,p1 for real number;
reserve r,q,cr1,cr2 for Element of COMPLEX;





definition
  mode Complex is complex number;
end;

definition
  let C,f1,f2;
  func f1/f2 -> PartFunc of C,COMPLEX means


  dom it = dom f1 /\ (dom f2
  \ f2"{0}) & for c st c in dom it holds it/.c = f1/.c * (f2/.c)";
end;

definition
  let C,f;
  func f^ -> PartFunc of C,COMPLEX means


  dom it = dom f \ f"{0} & for c st c in dom it holds it/.c = (f/.c)";
end;

theorem 
  dom (f1+f2) = dom f1 /\ dom f2 & for c st c in dom(f1+f2) holds (
  f1+f2)/.c = (f1/.c) + (f2/.c);

theorem 
  dom (f1-f2) = dom f1 /\ dom f2 & for c st c in dom(f1-f2) holds (
  f1-f2)/.c = (f1/.c) - (f2/.c);

theorem 
  dom(f1(#)f2)=dom f1 /\ dom f2 & for c st c in dom(f1(#)f2) holds
  (f1(#)f2)/.c =(f1/.c) * (f2/.c);

theorem 
  dom (r(#)f) = dom f & for c st c in dom (r(#)f) holds (r(#)f)/.c = r * (f/.c)
;

theorem 
  dom (-f) = dom f & for c st c in dom (-f) holds (-f)/.c = -f/.c;

theorem 
  dom (g^) c= dom g & dom g /\ (dom g \ g"{0}) = dom g \ g"{0};

theorem 
  dom (f1(#)f2) \ (f1(#)f2)"{0} = (dom f1 \ (f1)"{0}) /\ (dom f2 \ (f2)"{0});

theorem 
  c in dom (f^) implies (f/.c) <> 0;

theorem 
  (f^)"{0} = {};

theorem 
  |.f.|"{0} = f"{0} & (-f)"{0} = f"{0};

theorem 
  dom (f^^) = dom (f|(dom (f^)));

theorem 
  r<>0 implies (r(#)f)"{0} = f"{0};

begin





theorem 
  (f1 + f2) + f3 = f1 + (f2 + f3);

theorem 
  (f1 (#) f2) (#) f3 = f1 (#) (f2 (#) f3);

theorem 
  (f1 + f2) (#) f3=f1 (#) f3 + f2 (#) f3;

theorem 
  f3 (#) (f1 + f2)=f3(#)f1 + f3(#)f2;

theorem 
  r(#)(f1(#)f2)=r(#)f1(#)f2;

theorem 
  r(#)(f1(#)f2)=f1(#)(r(#)f2);

theorem 
  (f1 - f2)(#)f3=f1(#)f3 - f2(#)f3;

theorem 
  f3(#)f1 - f3(#)f2 = f3(#)(f1 - f2);

theorem 
  r(#)(f1 + f2) = r(#)f1 + r(#)f2;

theorem 
  (r*q)(#)f = r(#)(q(#)f);

theorem 
  r(#)(f1 - f2) = r(#)f1 - r(#)f2;

theorem 
  f1-f2 = (-1r)(#)(f2-f1);

theorem 
  f1 - (f2 + f3) = f1 - f2 - f3;

theorem 
  1r(#)f = f;

theorem 
  f1 - (f2 - f3) = f1 - f2 + f3;

theorem 
  f1 + (f2 - f3) =f1 + f2 - f3;

theorem 
  |.f1(#)f2.| = |.f1.|(#)|.f2.|;

theorem 
  |.r(#)f.| = |.r.|(#)|.f.|;

theorem 
  -f = (-1r)(#)f;

canceled;

theorem 
  f1 - (-f2) = f1 + f2;

theorem 
  f^^ = f|(dom (f^));

theorem 
  (f1(#)f2)^ = (f1^)(#)(f2^);

theorem 
  r<>0 implies (r(#)f)^ = r" (#) (f^);

theorem 
  (-f)^ = (-1r)(#)(f^);

theorem 
  |.f.|^ = |. f^ .|;

theorem 
  f/g = f(#) (g^);

theorem 
  r(#)(g/f) = (r(#)g)/f;

theorem 
  (f/g)(#)g = (f|dom(g^));

theorem 
  (f/g)(#)(f1/g1) = (f(#)f1)/(g(#)g1);

theorem 
  (f1/f2)^ = (f2|dom(f2^))/f1;

theorem 
  g (#) (f1/f2) = (g (#) f1)/f2;

theorem 
  g/(f1/f2) = (g(#)(f2|dom(f2^)))/f1;

theorem 
  -f/g = (-f)/g & f/(-g) = -f/g;

theorem 
  f1/f + f2/f = (f1 + f2)/f & f1/f - f2/f = (f1 - f2)/f;

theorem 
  f1/f + g1/g = (f1(#)g + g1(#)f)/(f(#)g);

theorem 
  (f/g)/(f1/g1) = (f(#)(g1|dom(g1^)))/(g(#)f1);

theorem 
  f1/f - g1/g = (f1(#)g - g1(#)f)/(f(#)g);

theorem 
  |.f1/f2.| = |.f1.|/|.f2.|;

theorem 
  (f1+f2)|X = f1|X + f2|X & (f1+f2)|X = f1|X + f2 & (f1+f2)|X = f1 + f2|X;

theorem 
  (f1(#)f2)|X = f1|X (#) f2|X & (f1(#)f2)|X = f1|X (#) f2 & (f1(#)
  f2)|X = f1 (#) f2|X;

theorem 
  (-f)|X = -(f|X) & (f^)|X = (f|X)^ & (|.f.|)|X = |.(f|X).|;

theorem 
  (f1-f2)|X = f1|X - f2|X & (f1-f2)|X = f1|X - f2 &(f1-f2)|X = f1 - f2|X;

theorem 
  (f1/f2)|X = f1|X / f2|X & (f1/f2)|X = f1|X / f2 &(f1/f2)|X = f1 / f2|X;

theorem 
  (r(#)f)|X = r(#)(f|X);

begin





theorem 
  (f1 is total & f2 is total iff f1+f2 is total) & (f1 is total &
  f2 is total iff f1-f2 is total) & (f1 is total & f2 is total iff f1(#)f2 is
  total);

theorem 
  f is total iff r(#)f is total;

theorem 
  f is total iff -f is total;

theorem 
  f is total iff |.f.| is total;

theorem 
  f^ is total iff f"{0} = {} & f is total;

theorem 
  f1 is total & f2"{0} = {} & f2 is total iff f1/f2 is total;

theorem 
  f1 is total & f2 is total implies (f1+f2)/.c = ((f1/.c)) + ((f2/.c)) &
  (f1-f2)/.c = ((f1/.c)) - ((f2/.c)) & (f1(#) f2)/.c = ((f1/.c)) * ((f2/.c));

theorem 
  f is total implies (r(#)f)/.c = r * ((f/.c));

theorem 
  f is total implies (-f)/.c = - (f/.c) & (|.f.|).c = |. (f/.c) .|;

theorem 
  f^ is total implies (f^)/.c = ((f/.c))";

theorem 
  f1 is total & f2^ is total implies (f1/f2)/.c = ((f1/.c)) *(((f2/.c))) ";

begin

theorem 
  f|Y is bounded iff ex p be real number st for c st c in Y /\ dom
  f holds |.(f/.c).|<= p;

theorem 
  Y c= X & f|X is bounded implies f|Y is bounded;

theorem 
  X misses dom f implies f|X is bounded;

theorem 
  f|Y is bounded implies (r(#)f)|Y is bounded;

theorem 
  |.f.||X is bounded_below;

theorem 
  f|Y is bounded implies |.f.||Y is bounded & (-f)|Y is bounded;

theorem 
  f1|X is bounded & f2|Y is bounded implies (f1+f2)|(X /\ Y) is bounded;

theorem 
  f1|X is bounded & f2|Y is bounded implies (f1(#)f2)|(X /\ Y) is
  bounded & (f1-f2)|(X /\ Y) is bounded;

theorem 
  f|X is bounded & f|Y is bounded implies f|(X \/ Y) is bounded;

theorem 
  f1|X is constant & f2|Y is constant implies (f1+f2)|(X /\ Y) is
  constant & (f1-f2)|(X /\ Y) is constant & (f1(#)f2)|(X /\ Y) is constant;

theorem 
  f|Y is constant implies (q(#)f)|Y is constant;

theorem 
  f|Y is constant implies |.f.||Y is constant & (-f)|Y is constant;

theorem 
  f|Y is constant implies f|Y is bounded;

theorem 
  f|Y is constant implies (for r holds (r(#)f)|Y is bounded) & (-f)|Y is
  bounded & |.f.||Y is bounded;

theorem 
  f1|X is bounded & f2|Y is constant implies (f1+f2)|(X /\ Y) is bounded;

theorem 
  f1|X is bounded & f2|Y is constant implies (f1-f2)|(X /\ Y) is bounded
  & (f2-f1)|(X /\ Y) is bounded & (f1(#)f2)|(X /\ Y) is bounded;

theorem 
  |.f.| is bounded iff f is bounded;














begin

reserve n,m,k for Element of NAT;
reserve x, X,X1,Z,Z1 for set;
reserve s,g,r,p,x0,x1,x2 for real number;
reserve s1,s2,q1 for Real_Sequence;
reserve Y for Subset of REAL;
reserve f,f1,f2 for PartFunc of REAL,REAL;

definition
  let f,x0;
  pred f is_continuous_in x0 means


  for s1 st rng s1 c= dom f & s1 is
  convergent & lim s1 = x0 holds f/*s1 is convergent & f.x0 = lim (f/*s1);
end;

theorem 
  x0 in X & f is_continuous_in x0 implies f|X is_continuous_in x0;

theorem 
  f is_continuous_in x0 iff for s1 st rng s1 c= dom f & s1 is convergent
& lim s1=x0 & (for n holds s1.n<>x0) holds f/*s1 is convergent & f.x0=lim(f/*s1
  );

theorem 
  f is_continuous_in x0 iff for r st 0<r ex s st 0<s & for x1 st x1
  in dom f & abs(x1-x0)<s holds abs(f.x1-f.x0)<r;

theorem 
  for f,x0 holds f is_continuous_in x0 iff for N1 being
Neighbourhood of f.x0 ex N being Neighbourhood of x0 st for x1 st x1 in dom f &
  x1 in N holds f.x1 in N1;

theorem 
  for f,x0 holds f is_continuous_in x0 iff for N1 being
  Neighbourhood of f.x0 ex N being Neighbourhood of x0 st f.:N c= N1;

theorem 
  (ex N be Neighbourhood of x0 st dom f /\ N = {x0}) implies f
  is_continuous_in x0;

theorem 
  x0 in dom f1 /\ dom f2 & f1 is_continuous_in x0 & f2
is_continuous_in x0 implies f1+f2 is_continuous_in x0 & f1-f2 is_continuous_in
  x0 & f1(#)f2 is_continuous_in x0;

theorem 
  x0 in dom f & f is_continuous_in x0 implies r(#)f is_continuous_in x0;

theorem 
  x0 in dom f & f is_continuous_in x0 implies abs(f) is_continuous_in x0
  & -f is_continuous_in x0;

theorem 
  f is_continuous_in x0 & f.x0<>0 implies f^ is_continuous_in x0;

theorem 
  x0 in dom f2 & f1 is_continuous_in x0 & f1.x0<>0 & f2 is_continuous_in
  x0 implies f2/f1 is_continuous_in x0;

theorem 
  x0 in dom (f2*f1) & f1 is_continuous_in x0 & f2 is_continuous_in
  f1.x0 implies f2*f1 is_continuous_in x0;

definition
  let f;
  attr f is continuous means


  for x0 st x0 in dom f holds f is_continuous_in x0;
end;

theorem 
  for X,f st X c= dom f holds f|X is continuous iff for s1 st rng
s1 c= X & s1 is convergent & lim s1 in X holds f/*s1 is convergent & f.(lim s1)
  = lim (f/*s1);

theorem 
  X c= dom f implies (f|X is continuous iff for x0,r st x0 in X &
0<r ex s st 0<s & for x1 st x1 in X & abs(x1-x0) < s holds abs(f.x1 - f.x0) < r
  );

registration
  cluster constant -> continuous for PartFunc of REAL,REAL;
end;

registration
  cluster continuous for PartFunc of REAL,REAL;
end;

registration
  let f be continuous PartFunc of REAL,REAL, X be set;
  cluster f|X -> continuous for PartFunc of REAL,REAL;
end;

theorem 
  f|X is continuous iff f|X|X is continuous;

theorem 
  f|X is continuous & X1 c= X implies f|X1 is continuous;

registration
  cluster empty -> continuous for PartFunc of REAL,REAL;
end;

registration
  let f;
  let X be trivial set;
  cluster f|X -> continuous for PartFunc of REAL,REAL;
end;

theorem 
  f|{x0} is continuous;

registration
  let f1,f2 be continuous PartFunc of REAL,REAL;
  cluster f1+f2 -> continuous for PartFunc of REAL,REAL;
  cluster f1-f2 -> continuous for PartFunc of REAL,REAL;
  cluster f1(#)f2 -> continuous for PartFunc of REAL,REAL;
end;

theorem 
  for X,f1,f2 st X c= dom f1 /\ dom f2 & f1|X is continuous & f2|X
is continuous holds (f1+f2)|X is continuous & (f1-f2)|X is continuous & (f1(#)
  f2)|X is continuous;

theorem 
  for X,X1,f1,f2 st X c= dom f1 & X1 c= dom f2 & f1|X is continuous & f2
|X1 is continuous holds (f1+f2)|(X /\ X1) is continuous & (f1-f2)|(X /\ X1) is
  continuous & (f1(#)f2)|(X /\ X1) is continuous;

registration
  let f be continuous PartFunc of REAL,REAL;
  let r;
  cluster r(#)f -> continuous for PartFunc of REAL,REAL;
end;

theorem 
  for r,X,f st X c= dom f & f|X is continuous holds (r(#)f)|X is continuous;

theorem 
  X c= dom f & f|X is continuous implies (abs f)|X is continuous & (-f)|
  X is continuous;

theorem 
  f|X is continuous & f"{0} = {} implies f^|X is continuous;

theorem 
  f|X is continuous & (f|X)"{0} = {} implies f^|X is continuous;

theorem 
  X c= dom f1 /\ dom f2 & f1|X is continuous & f1"{0} = {} & f2|X is
  continuous implies (f2/f1)|X is continuous;

registration
  let f1,f2 be continuous PartFunc of REAL,REAL;
  cluster f2*f1 -> continuous for PartFunc of REAL,REAL;
end;

theorem 
  f1|X is continuous & f2|(f1.:X) is continuous implies (f2*f1)|X is continuous
;

theorem 
  f1|X is continuous & f2|X1 is continuous implies (f2*f1)|(X /\ (f1"X1)
  ) is continuous;

theorem 
  f is total & (for x1,x2 holds f.(x1+x2) = f.x1 + f.x2) & (ex x0 st f
  is_continuous_in x0) implies f|REAL is continuous;

theorem 
  for f st dom f is compact & f|dom f is continuous holds rng f is compact;

theorem 
  Y c= dom f & Y is compact & f|Y is continuous implies (f.:Y) is compact;

theorem 
  for f st dom f<>{} & (dom f) is compact & f|dom f is continuous
  ex x1,x2 st x1 in dom f & x2 in dom f & f.x1 = upper_bound (rng f) & f.x2 =
  lower_bound (rng f);


theorem 
  for f,Y st Y<>{} & Y c= dom f & Y is compact & f|Y is continuous ex x1
,x2 st x1 in Y & x2 in Y & f.x1 = upper_bound (f.:Y) & f.x2 = lower_bound (f.:Y
  );

definition
  let f;
  attr f is Lipschitzian means


  ex r st 0<r & for x1,x2 st x1 in dom f &
  x2 in dom f holds abs(f.x1-f.x2)<=r*abs(x1-x2);
end;

theorem 
  f|X is Lipschitzian iff ex r st 0<r & for x1,x2 st x1 in dom(f|X
  ) & x2 in dom(f|X) holds abs(f.x1-f.x2)<=r*abs(x1-x2);

registration
  cluster empty -> Lipschitzian for PartFunc of REAL,REAL;
end;

registration
  cluster empty for PartFunc of REAL,REAL;
end;

registration
  let f be Lipschitzian PartFunc of REAL,REAL, X be set;
  cluster f|X -> Lipschitzian for PartFunc of REAL,REAL;
end;

theorem 
  f|X is Lipschitzian & X1 c= X implies f|X1 is Lipschitzian;

registration
  let f1,f2 be Lipschitzian PartFunc of REAL,REAL;
  cluster f1+f2 -> Lipschitzian for PartFunc of REAL,REAL;
  cluster f1-f2 -> Lipschitzian for PartFunc of REAL,REAL;
end;

theorem 
  f1|X is Lipschitzian & f2|X1 is Lipschitzian implies (f1+f2)|(X /\ X1)
  is Lipschitzian;

theorem 
  f1|X is Lipschitzian & f2|X1 is Lipschitzian implies (f1-f2)|(X /\ X1)
  is Lipschitzian;

registration
  let f1,f2 be bounded Lipschitzian PartFunc of REAL,REAL;
  cluster f1 (#) f2 -> Lipschitzian for PartFunc of REAL,REAL;
end;

theorem 
  f1|X is Lipschitzian & f2|X1 is Lipschitzian & f1|Z is bounded & f2|Z1
  is bounded implies (f1(#)f2)|(X /\ Z /\ X1 /\ Z1) is Lipschitzian;

registration
  let f be Lipschitzian PartFunc of REAL, REAL;
  let p;
  cluster p(#)f -> Lipschitzian for PartFunc of REAL, REAL;
end;

theorem 
  f|X is Lipschitzian & X c= dom f implies (p(#)f)|X is Lipschitzian;

registration
  let f be Lipschitzian PartFunc of REAL, REAL;
  cluster abs f -> Lipschitzian for PartFunc of REAL, REAL;
end;

theorem 
  f|X is Lipschitzian implies -f|X is Lipschitzian & (abs f)|X is Lipschitzian;

registration
  cluster constant -> Lipschitzian for PartFunc of REAL, REAL;
end;

registration
  let Y;
  cluster id Y -> Lipschitzian for PartFunc of REAL,REAL;
end;

registration

  cluster Lipschitzian -> continuous for PartFunc of REAL, REAL;
end;

theorem 
  for f st (ex r st rng f = {r}) holds f is continuous;

theorem 
  for f st (for x0 st x0 in dom f holds f.x0 = x0) holds f is continuous;

theorem 
  (for x0 st x0 in X holds f.x0 = r*x0+p) implies f|X is continuous;

theorem 
  (for x0 st x0 in dom f holds f.x0 = x0^2) implies f|dom f is continuous;

theorem 
  X c= dom f & (for x0 st x0 in X holds f.x0 = x0^2) implies f|X is continuous;

theorem 
  (for x0 st x0 in dom f holds f.x0 = abs(x0)) implies f is continuous;

theorem 
  (for x0 st x0 in X holds f.x0 = abs(x0)) implies f|X is continuous;

theorem 
  f|X is monotone & (ex p,g st p<=g & f.:X=[.p,g.]) implies f|X is continuous;

theorem 
  for f being one-to-one PartFunc of REAL,REAL st p<=g & [.p,g.] c= dom
f & (f|[.p,g.] is increasing or f|[.p,g.] is decreasing) holds (f|[.p,g.])"|(f
  .:[.p,g.]) is continuous;



definition
  let a,b be real number;
  func AffineMap(a,b) -> Function of REAL, REAL means


  for x being real number holds it.x = a*x + b;
end;

registration
  let a,b be real number;
  cluster AffineMap(a,b) -> continuous;
end;

registration
  cluster continuous for Function of REAL, REAL;
end;

theorem 
  for a,b being real number holds AffineMap(a,b).0 = b;

theorem 
  for a,b being real number holds AffineMap(a,b).1 = a+b;

theorem 
  for a,b being real number st a<> 0 holds AffineMap(a,b) is one-to-one;

theorem 
  for a,b,x,y being real number st a > 0 & x < y holds AffineMap(a,b).x
  < AffineMap(a,b).y;

theorem 
  for a,b,x,y being real number st a < 0 & x < y holds AffineMap(a,b).x
  > AffineMap(a,b).y;

theorem 
  for a,b,x,y being real number st a >= 0 & x <= y holds AffineMap
  (a,b).x <= AffineMap(a,b).y;

theorem 
  for a,b,x,y being real number st a <= 0 & x <= y holds AffineMap(a,b).
  x >= AffineMap(a,b).y;

theorem 
  for a,b being real number st a <> 0 holds rng AffineMap(a,b) = REAL;

theorem 
  for a,b being real number st a <> 0 holds (AffineMap(a,b) qua
  Function)" = AffineMap(a",-b/a);

theorem 
  for a,b being real number st a > 0 holds AffineMap(a,b).:[.0,1.] = [.b,a+b.];















begin

reserve n,m for Element of NAT;
reserve x, X,X1,Z,Z1 for set;
reserve s,g,r,t,p,x0,x1,x2 for Real;
reserve s1,s2,q1 for Real_Sequence;
reserve Y for Subset of REAL;
reserve f,f1,f2 for PartFunc of REAL,REAL;

definition
  let f;
  attr f is uniformly_continuous means


  for r st 0<r ex s st 0<s & for
x1,x2 st x1 in dom f & x2 in dom f & abs(x1 - x2) < s holds abs(f.x1 - f.x2) <
  r;
end;

theorem 
  f|X is uniformly_continuous iff for r st 0<r ex s st 0<s & for x1
,x2 st x1 in dom(f|X) & x2 in dom(f|X) & abs(x1 - x2) < s holds abs(f.x1 - f.x2
  ) < r;

theorem 
  f|X is uniformly_continuous & X1 c= X implies f|X1 is uniformly_continuous;

theorem 
  X c= dom f1 & X1 c= dom f2 & f1|X is uniformly_continuous & f2|X1 is
  uniformly_continuous implies (f1+f2)|(X/\X1) is uniformly_continuous;

theorem 
  X c= dom f1 & X1 c= dom f2 & f1|X is uniformly_continuous & f2|X1 is
  uniformly_continuous implies (f1-f2)|(X/\X1) is uniformly_continuous;

theorem 
  X c= dom f & f|X is uniformly_continuous implies (p(#)f)|X is
  uniformly_continuous;

theorem 
  X c= dom f & f|X is uniformly_continuous implies (-f)|X is
  uniformly_continuous;

theorem 
  f|X is uniformly_continuous implies (abs f)|X is uniformly_continuous;

theorem 
  X c= dom f1 & X1 c= dom f2 & f1|X is uniformly_continuous & f2|X1 is
uniformly_continuous & f1|Z is bounded & f2|Z1 is bounded implies (f1(#)f2)|(X
  /\Z/\X1/\Z1) is uniformly_continuous;

theorem 
  X c= dom f & f|X is uniformly_continuous implies f|X is continuous;

theorem 
  f|X is Lipschitzian implies f|X is uniformly_continuous;

theorem 
  for f,Y st Y c= dom f & Y is compact & f|Y is continuous holds f
  |Y is uniformly_continuous;

theorem 
  Y c= dom f & Y is compact & f|Y is uniformly_continuous implies f.:Y
  is compact;

theorem 
  for f,Y st Y <> {} & Y c= dom f & Y is compact & f|Y is
uniformly_continuous ex x1,x2 st x1 in Y & x2 in Y & f.x1 = upper_bound (f.:Y)
  & f.x2 = lower_bound (f.:Y);

theorem 
  X c= dom f & f|X is constant implies f|X is uniformly_continuous;

theorem 
  p<= g & [.p,g.] c= dom f & f|[.p,g.] is continuous implies for r
  st r in [.f.p,f.g.] \/ [.f.g,f.p.] ex s st s in [.p,g.] & r = f.s;

theorem 
  p<=g & [.p,g.] c= dom f & f|[.p,g.] is continuous implies for r
st r in [.(lower_bound (f.:[.p,g.])),(upper_bound (f.:[.p,g.])).] ex s st s in
  [.p,g.] & r = f.s;

theorem 
  f is one-to-one & [.p,g.] c= dom f & p<=g & f|[.p,g.] is
  continuous implies f|[.p,g.] is increasing or f|[.p,g.] is decreasing;

theorem 
  f is one-to-one & p<=g & [.p,g.] c= dom f & f|[.p,g.] is continuous
  implies lower_bound (f.:[.p,g.])=f.p & upper_bound (f.:[.p,g.])=f.g or
  lower_bound (f.:[.p,g.])=f.g & upper_bound (f.:[.p,g.])=f.p;


theorem 
  p<=g & [.p,g.] c= dom f & f|[.p,g.] is continuous implies f.:[.p
  ,g.]=[.lower_bound (f.:[.p,g.]),upper_bound (f.:[.p,g.]).];

theorem 
  for f be one-to-one PartFunc of REAL,REAL st p<=g & [.p,g.] c= dom f &
f|[.p,g.] is continuous holds f"|[.lower_bound (f.:[.p,g.]),upper_bound (f.:[.p
  ,g.]).] is continuous;














begin

reserve y,X for set;
reserve x,x0,x1,x2,g,g1,g2,r,r1,s,p,p1 for Real;
reserve n,m,k for Element of NAT;
reserve Y for Subset of REAL;
reserve Z for open Subset of REAL;
reserve s1,s3 for Real_Sequence;
reserve f,f1,f2 for PartFunc of REAL,REAL;

theorem 
  (for r holds r in Y iff r in REAL) iff Y = REAL;

definition let x be real number;
  let IT be Real_Sequence;
  attr IT is x-convergent means

    IT is convergent & lim IT = x;
end;

registration
  cluster 0-convergent non-zero for Real_Sequence;
end;

registration let f be 0-convergent Real_Sequence;
  cluster lim f -> empty;
end;

registration
  cluster 0-convergent -> convergent for Real_Sequence;
end;

reserve h for non-zero 0-convergent Real_Sequence;
reserve c for constant Real_Sequence;

definition
  let IT be PartFunc of REAL,REAL;
  attr IT is RestFunc-like means

  IT is total & for h holds (h")(#)(IT/*h) is convergent &
  lim ((h")(#)(IT/*h)) = 0;
end;

registration
  cluster RestFunc-like for PartFunc of REAL,REAL;
end;

definition
  mode RestFunc is RestFunc-like PartFunc of REAL,REAL;
end;

definition
  let IT be PartFunc of REAL,REAL;
  attr IT is linear means

  IT is total & ex r st for p holds IT.p = r*p;
end;

registration
  cluster linear for PartFunc of REAL,REAL;
end;

definition
  mode LinearFunc is linear PartFunc of REAL,REAL;
end;

reserve R,R1,R2 for RestFunc;
reserve L,L1,L2 for LinearFunc;

theorem 
  L1+L2 is LinearFunc & L1-L2 is LinearFunc;

theorem 
  r(#)L is LinearFunc;

theorem 
  R1+R2 is RestFunc & R1-R2 is RestFunc & R1(#)R2 is RestFunc;

theorem 
  r(#)R is RestFunc;

theorem 
  L1(#)L2 is RestFunc-like;

theorem 
  R(#)L is RestFunc & L(#)R is RestFunc;

definition
  let f;
  let x0 be real number;
  pred f is_differentiable_in x0 means


  ex N being Neighbourhood of x0
st N c= dom f & ex L,R st for x st x in N holds f.x - f.x0 = L.(x-x0) + R.(x-x0
  );
end;

definition
  let f;
  let x0 be real number;
  assume
 f is_differentiable_in x0;
  func diff(f,x0) -> Real means


  ex N being Neighbourhood of x0 st N c= dom f &
  ex L,R st it=L.1 & for x st x in N holds f.x-f.x0 = L.(x-x0) + R.(x-x0);
end;

definition
  let f,X;
  pred f is_differentiable_on X means


  X c= dom f & for x st x in X holds f|X is_differentiable_in x;
end;

theorem 
  f is_differentiable_on X implies X is Subset of REAL;

theorem 
  f is_differentiable_on Z iff Z c= dom f & for x st x in Z holds
  f is_differentiable_in x;

theorem 
  f is_differentiable_on Y implies Y is open;

definition
  let f,X;
  assume
 f is_differentiable_on X;
  func f`|X -> PartFunc of REAL,REAL means


  dom it = X & for x st x in X holds it.x = diff(f,x);
end;

theorem 
  (Z c= dom f & ex r st rng f = {r}) implies f is_differentiable_on Z &
  for x st x in Z holds (f`|Z).x = 0;

registration
  let h,n;
  cluster h^\n -> non-zero 0-convergent for Real_Sequence;
end;

theorem 
  for x0 being real number for N being Neighbourhood of x0 st f
is_differentiable_in x0 & N c= dom f holds for h,c st rng c = {x0} & rng (h+c)
c= N holds h"(#)(f/*(h+c) - f/*c) is convergent & diff(f,x0) = lim (h"(#)(f/*(h
  +c) - f/*c));

theorem 
  f1 is_differentiable_in x0 & f2 is_differentiable_in x0 implies
  f1+f2 is_differentiable_in x0 & diff(f1+f2,x0)=diff(f1,x0)+diff(f2,x0);

theorem 
  f1 is_differentiable_in x0 & f2 is_differentiable_in x0 implies
  f1-f2 is_differentiable_in x0 & diff(f1-f2,x0)=diff(f1,x0)-diff(f2,x0);

theorem 
  f is_differentiable_in x0 implies r(#)f is_differentiable_in x0
  & diff((r(#)f),x0) = r*diff(f,x0);

theorem 
  f1 is_differentiable_in x0 & f2 is_differentiable_in x0 implies
f1(#)f2 is_differentiable_in x0 & diff(f1(#)f2,x0)=(f2.x0)*diff(f1,x0)+(f1.x0)*
  diff(f2,x0);

theorem 
  Z c= dom f & f|Z = id Z implies f is_differentiable_on Z & for x
  st x in Z holds (f`|Z).x = 1;

theorem 
  Z c= dom (f1+f2) & f1 is_differentiable_on Z & f2 is_differentiable_on
Z implies f1+f2 is_differentiable_on Z & for x st x in Z holds ((f1+f2)`|Z).x =
  diff(f1,x) + diff(f2,x);

theorem 
  Z c= dom (f1-f2) & f1 is_differentiable_on Z & f2 is_differentiable_on
Z implies f1-f2 is_differentiable_on Z & for x st x in Z holds ((f1-f2)`|Z).x =
  diff(f1,x) - diff(f2,x);

theorem 
  Z c= dom (r(#)f) & f is_differentiable_on Z implies r(#)f
  is_differentiable_on Z & for x st x in Z holds ((r(#) f)`|Z).x =r*diff(f,x);

theorem 
  Z c= dom (f1(#)f2) & f1 is_differentiable_on Z & f2
is_differentiable_on Z implies f1(#)f2 is_differentiable_on Z & for x st x in Z
  holds ((f1(#)f2)`|Z).x = (f2.x)*diff(f1,x) + (f1.x)*diff(f2,x);

theorem 
  Z c= dom f & f|Z is constant implies f is_differentiable_on Z & for x
  st x in Z holds (f`|Z).x = 0;

theorem 
  Z c= dom f & (for x st x in Z holds f.x = r*x + p) implies f
  is_differentiable_on Z & for x st x in Z holds (f`|Z).x = r;

theorem 
  for x0 being real number holds f is_differentiable_in x0 implies
  f is_continuous_in x0;

theorem 
  f is_differentiable_on X implies f|X is continuous;

theorem 
  f is_differentiable_on X & Z c= X implies f is_differentiable_on Z;

theorem 

ex R st R.0=0 & R is_continuous_in 0;

definition
  let f be PartFunc of REAL, REAL;
  attr f is differentiable means

  f is_differentiable_on dom f;
end;

registration
  cluster differentiable for Function of REAL, REAL;
end;

theorem 
  for f being differentiable PartFunc of REAL, REAL st Z c= dom f holds
  f is_differentiable_on Z;














begin

reserve y for set;
reserve g,r,s,p,t,x,x0,x1,x2 for Real;
reserve n,n1 for Element of NAT;
reserve s1,s2,s3 for Real_Sequence;
reserve f,f1,f2 for PartFunc of REAL,REAL;

theorem 
  for p,g st p<g for f st [.p,g.] c= dom f & f|[.p,g.] is
continuous & f.p=f.g & f is_differentiable_on ].p,g.[ ex x0 st x0 in ].p,g.[ &
  diff(f,x0)=0;


theorem 
  for x,t st 0<t for f st [.x,x+t.] c= dom f & f|[.x,x+t.] is continuous
& f.x=f.(x+t) & f is_differentiable_on ].x,x+t.[ ex s st 0<s & s<1 & diff(f,x+s
  *t)=0;


theorem 
  for p,g st p<g for f st [.p,g.] c= dom f & f|[.p,g.] is
continuous & f is_differentiable_on ].p,g.[ ex x0 st x0 in ].p,g.[ & diff(f,x0)
  =(f.g-f.p)/(g-p);


theorem 
  for x,t st 0<t for f st [.x,x+t.] c= dom f & f|[.x,x+t.] is continuous
& f is_differentiable_on ].x,x+t.[ ex s st 0<s & s<1 & f.(x+t) = f.x + t*diff(f
  ,x+s*t);

theorem 
  for p,g st p<g for f1,f2 st [.p,g.] c= dom f1 & [.p,g.] c= dom f2
  & f1|[.p,g.] is continuous & f1 is_differentiable_on ].p,g.[ & f2|[.p,g.] is
continuous & f2 is_differentiable_on ].p,g.[ ex x0 st x0 in ].p,g.[ & (f1.g-f1.
  p)*diff(f2,x0)=(f2.g-f2.p)*diff(f1,x0);


theorem 
  for x,t st 0<t for f1,f2 st [.x,x+t.] c= dom f1 & [.x,x+t.] c= dom f2
& f1|[.x,x+t.] is continuous & f1 is_differentiable_on ].x,x+t.[ & f2|[.x,x+t.]
is continuous & f2 is_differentiable_on ].x,x+t.[ & (for x1 st x1 in ].x,x+t.[
  holds diff(f2,x1)<>0) ex s st 0<s & s<1 & (f1.(x+t)-f1.x)/(f2.(x+t)-f2.x) =
  diff(f1,x+s*t)/diff(f2,x+s*t);

theorem 
  for p,g for f st ].p,g.[ c= dom f & f is_differentiable_on ].p,g
  .[ & (for x st x in ].p,g.[ holds diff(f,x) = 0) holds f|].p,g.[ is constant;

theorem 
  for p,g for f1,f2 st f1 is_differentiable_on ].p,g.[ & f2
is_differentiable_on ].p,g.[ & (for x st x in ].p,g.[ holds diff(f1,x) = diff(
f2,x)) holds (f1-f2)|].p,g.[ is constant & ex r st for x st x in ].p,g.[ holds
  f1.x = f2.x+r;

theorem 
  for p,g for f st ].p,g.[ c= dom f & f is_differentiable_on ].p,g.[ & (
  for x st x in ].p,g.[ holds 0<diff(f,x)) holds f|].p,g.[ is increasing;

theorem 
  for p,g for f st ].p,g.[ c= dom f & f is_differentiable_on ].p,g.[ & (
  for x st x in ].p,g.[ holds diff(f,x)<0) holds f|].p,g.[ is decreasing;

theorem 
  for p,g for f st ].p,g.[ c= dom f & f is_differentiable_on ].p,g.[ & (
  for x st x in ].p,g.[ holds 0<=diff(f,x)) holds f|].p,g.[ is non-decreasing;

theorem 
  for p,g for f st ].p,g.[ c= dom f & f is_differentiable_on ].p,g.[ & (
  for x st x in ].p,g.[ holds diff(f,x)<=0) holds f|].p,g.[ is non-increasing;














begin

registration
  let i be Integer;
  cluster abs i -> natural;
end;

reserve x for set;
reserve a, b, c for real number;
reserve m, n, m1, m2 for Element of NAT;
reserve k, l for Integer;
reserve p, q for Rational;
reserve s1, s2 for Real_Sequence;

theorem 
  s1 is convergent & (for n holds s1.n>=a) implies lim s1 >= a;

theorem 
  s1 is convergent & (for n holds s1.n<=a) implies lim s1 <= a;

definition
  let a be real number;
  func a GeoSeq -> Real_Sequence means


  for m holds it.m = a|^m;
end;

theorem 
  s1 = a GeoSeq iff s1.0 = 1 & for m holds s1.(m+1) = s1.m * a;

theorem 
  for a st a <> 0 holds for m holds a GeoSeq.m <> 0;

theorem 
  for n being Nat holds 0 <> a implies 0 <> a |^ n;

theorem 
  for n being Nat holds 0 < a implies 0 < a |^ n;

theorem 
  for n being Nat holds (1/a) |^ n = 1 / a |^ n;

theorem 
  for n being Nat holds (b/a) |^ n = b |^ n / a |^ n;

theorem 
  for n being Nat st 0 < a & a <= b holds a |^ n <= b |^ n;

theorem 
  for n being Nat st 0 <= a & a < b & 1 <= n holds a |^ n < b |^ n;

theorem 
  for n being Nat holds a>=1 implies a |^ n >= 1;

theorem 
  for n being Nat st 1 <= a & 1 <= n holds a <= a |^ n;

theorem 
  for n being Nat st 1 < a & 2 <= n holds a < a |^ n;

theorem 
  for n being Nat st 0 < a & a <= 1 & 1 <= n holds a |^ n <= a;

theorem 
  for n being Nat st 0 < a & a < 1 & 2 <= n holds a |^ n < a;

theorem 
  for n being Nat holds -1 < a implies (1 + a) |^ n >= 1 + n * a;

theorem 
  for n being Nat st 0 < a & a < 1 holds (1 + a) |^ n
  <= 1 + 3 |^ n * a;

theorem 
  s1 is convergent & (for n holds s2.n = (s1.n) |^ m) implies s2
  is convergent & lim s2 = (lim s1) |^ m;

definition
  let n be Nat;
  let a be real number;
  assume
 1 <= n;

  func n -Root a -> real number means


  it |^ n = a & it > 0 if a>0, it = 0 if a=0;
end;

definition
  let n;
  let a be Real;
  redefine func n -Root a -> Real;
end;

theorem 
  for n being Nat st a>=0 & n>=1 holds (n -Root a) |^ n = a & n
  -Root (a |^ n) = a;

theorem 
  n>=1 implies n -Root 1 = 1;

theorem 
  a>=0 implies 1 -Root a = a;

theorem 
  a>=0 & b>=0 & n>=1 implies n -Root (a*b) = n -Root a * n -Root b;

theorem 
  a>0 & n>=1 implies n -Root (1/a) = 1/(n -Root a);

theorem 
  a>=0 & b>0 & n>=1 implies n -Root (a/b) = n -Root a / n -Root b;

theorem 
  a>=0 & n>=1 & m>=1 implies n -Root (m -Root a) = (n*m) -Root a;

theorem 
  a>=0 & n>=1 & m>=1 implies n -Root a * m -Root a = (n*m) -Root ( a |^ (n+m));

theorem 
  0<=a & a<=b & n>=1 implies n -Root a <= n -Root b;

theorem 
  a>=0 & a<b & n>=1 implies n -Root a < n -Root b;

theorem 
  a>=1 & n>=1 implies n -Root a >= 1 & a >= n -Root a;

theorem 
  0<=a & a<1 & n>=1 implies a <= n -Root a & n -Root a < 1;

theorem 
  a>0 & n>=1 implies n -Root a - 1 <= (a-1)/n;

theorem 
  a>=0 implies 2-Root a = sqrt a;

theorem 
  for s being Real_Sequence st a > 0 & (for n st n>=1 holds s.n = n
  -Root a) holds s is convergent & lim s = 1;

definition
  let a be real number;
  let k;
  func a #Z k equals


  a |^ abs k if k >= 0, (a |^ abs k)" if k < 0;
end;

registration
  let a be real number;
  let k;
  cluster a #Z k -> real;
end;

definition
  let a be Real;
  let k;
  redefine func a #Z k -> Real;
end;

theorem 
  a #Z 0 = 1;

theorem 
  a #Z 1 = a;

theorem 
  for n being Nat holds a #Z n = a |^ n;

theorem 
  1 #Z k = 1;

theorem 
  a<>0 implies a #Z k <> 0;

theorem 
  a>0 implies a #Z k > 0;

theorem 
  (a*b) #Z k = a #Z k * b #Z k;

theorem 
  a #Z (-k) = 1/a #Z k;

theorem 
  (1/a) #Z k = 1/a #Z k;

theorem 
  for m,n being Nat holds a<>0 implies a #Z (m-n) = a |^ m / a |^ n;

theorem 
  a<>0 implies a #Z (k+l) = a #Z k * a #Z l;

theorem 
  a #Z k #Z l = a #Z (k*l);

theorem 
  a>0 & n>=1 implies (n -Root a) #Z k = n -Root (a #Z k);

definition
  let a be real number;
  let p;
  func a #Q p equals

  (denominator p) -Root (a #Z numerator p);
end;

registration
  let a be real number;
  let p;
  cluster a #Q p -> real;
end;

definition
  let a be Real;
  let p;
  redefine func a #Q p -> Real;
end;

theorem 
  p = 0 implies a #Q p = 1;

theorem 
  a > 0 & p = 1 implies a #Q p = a;

theorem 
  for n be Nat st 0 <= a holds a #Q n = a |^ n;

theorem 
  for n be Nat holds n>=1 & p = n" implies a #Q p = n -Root a;

theorem 
  1 #Q p = 1;

theorem 
  a>0 implies a #Q p > 0;

theorem 
  a>0 implies a #Q p * a #Q q = a #Q (p+q);

theorem 
  a>0 implies 1 / a #Q p = a #Q (-p);

theorem 
  a>0 implies a #Q p / a #Q q = a #Q (p-q);

theorem 
  a>0 & b>0 implies (a*b) #Q p = a #Q p * b #Q p;

theorem 
  a>0 implies (1/a) #Q p = 1/a #Q p;

theorem 
  a>0 & b>0 implies (a/b) #Q p = a #Q p / b #Q p;

theorem 
  a > 0 implies a #Q p #Q q = a #Q (p*q);

theorem 
  a>=1 & p >= 0 implies a #Q p >= 1;

theorem 
  a>=1 & p<=0 implies a #Q p <= 1;

theorem 
  a>1 & p>0 implies a #Q p > 1;

theorem 
  a>=1 & p>=q implies a #Q p >= a #Q q;

theorem 
  a>1 & p>q implies a #Q p > a #Q q;

theorem 
  a>0 & a<1 & p>0 implies a #Q p < 1;

theorem 
  a>0 & a<=1 & p<=0 implies a #Q p >= 1;

registration
  cluster RAT-valued for Real_Sequence;
end;

definition
  canceled;
  mode Rational_Sequence is RAT-valued Real_Sequence;
end;

theorem 
  for a be real number ex s being Rational_Sequence st
  s is convergent & lim s = a & for n holds s.n<=a;

theorem 
  ex s being Rational_Sequence st s is convergent & lim s = a &
  for n holds s.n>=a;

definition
  let a be real number;
  let s be Rational_Sequence;
  func a #Q s -> Real_Sequence means


  for n holds it.n = a #Q (s.n);
end;

theorem 
  for s being Rational_Sequence st s is convergent & a>0 holds a
  #Q s is convergent;

theorem 
  for s1,s2 being Rational_Sequence, a st s1 is convergent & s2 is
  convergent & lim s1 = lim s2 & a>0 holds a #Q s1 is convergent & a #Q s2 is
  convergent & lim a #Q s1 = lim a #Q s2;

definition
  let a,b be real number;
  assume
 a > 0;
  func a #R b -> real number means


  ex s being Rational_Sequence st s is
  convergent & lim s = b & a #Q s is convergent & lim a #Q s = it;
end;

definition
  let a,b be Real;
  redefine func a #R b -> Real;
end;

theorem 
  a > 0 implies a #R 0 = 1;

theorem 
  a > 0 implies a #R 1 = a;

theorem 
  1 #R a = 1;

theorem 
  a>0 implies a #R p = a #Q p;

theorem 
  a > 0 implies a #R (b+c) = a #R b * a #R c;

theorem 
  a > 0 implies a #R (-c) = 1 / a #R c;

theorem 
  a > 0 implies a #R (b-c) = a #R b / a #R c;

theorem 
  a > 0 & b > 0 implies (a * b) #R c = a #R c * b #R c;

theorem 
  a>0 implies (1/a) #R c = 1 / a #R c;

theorem 
  a > 0 & b > 0 implies (a/b) #R c = a #R c / b #R c;

theorem 
  a > 0 implies a #R b > 0;

theorem 
  a>=1 & c>=b implies a #R c >= a #R b;

theorem 
  a>1 & c>b implies a #R c > a #R b;

theorem 
  a>0 & a<=1 & c>=b implies a #R c <= a #R b;

theorem 
  a >= 1 & b >= 0 implies a #R b >= 1;

theorem 
  a > 1 & b > 0 implies a #R b > 1;

theorem 
  a >= 1 & b <= 0 implies a #R b <= 1;

theorem 
  a > 1 & b < 0 implies a #R b < 1;

theorem 
  s1 is convergent & s2 is convergent & lim s1 > 0 & (for n holds
  s1.n>0 & s2.n = (s1.n) #Q p) implies lim s2 = (lim s1) #Q p;

theorem 
  a>0 & s1 is convergent & s2 is convergent & (for n holds s2.n =
  a #R (s1.n)) implies lim s2 = a #R (lim s1);

theorem 
  a > 0 implies a #R b #R c = a #R (b * c);

begin 


reserve r, u for real number,
  k for Nat;

theorem 
  r>0 & u > 0 implies ex k be Element of NAT st u/(2 |^ k) <= r;

theorem 
  k>=n & r >= 1 implies r |^ k >= r |^ n;



theorem 
  for n,m,l be Element of NAT st n divides m & n divides l holds n divides m-l;

theorem 
  m divides n iff m divides (n qua Integer);

theorem 
  m gcd n= m gcd abs(n-m);

theorem 
  for a,b be Integer st a>=0 & b>=0 holds a gcd b = a gcd (b-a);



theorem 
  a>=0 implies a #Z l >= 0;

theorem 
  a > 0 implies a #Q l = a #Z l;



theorem 
 l <> 0 implies 0 #Z l = 0;














begin

reserve i,j,k,n for Nat;

theorem 
  for i, n being Nat holds i <= n implies n - i + 1 is Element of NAT;

theorem 
  for i,n being Nat holds i in Seg n implies n - i + 1 in Seg n;

theorem 
  for f being Function, x,y being set st f"{y} = {x} holds x in dom
  f & y in rng f & f.x = y;

theorem 
  for f being Function holds f is one-to-one iff for x being set st x in
  dom f holds f"{f.x} = {x};

theorem 
  for f being Function, y1,y2 being set st f is one-to-one & y1 in rng f
  & f"{y1} = f"{y2} holds y1 = y2;

registration
  let x be set;
  cluster <*x*> -> trivial;
  let y be set;
  cluster <*x,y*> -> non trivial;
end;

registration
  cluster one-to-one non empty for FinSequence;
end;

theorem 
  for f being non empty FinSequence holds 1 in dom f & len f in dom f;

theorem 
  for f being non empty FinSequence ex i being Nat st i+1 = len f;

theorem 
  for x being set, f being FinSequence holds len(<*x*>^f) = 1 + len f;

theorem 
  for f being FinSequence, p,q being set st p in rng f & q in rng f & p
  ..f = q..f holds p = q;

theorem 
  for f,g being FinSequence st n+1 in dom f & g = f|Seg n holds f|
  Seg(n+1) = g^<*f.(n+1)*>;

theorem 
  for f being one-to-one FinSequence st i in dom f holds (f.i)..f = i;

reserve D for non empty set,
  p for Element of D,
  f,g for FinSequence of D;

registration
  let D be non empty set;
  cluster one-to-one non empty for FinSequence of D;
end;



theorem 
  dom f = dom g & (for i st i in dom f holds f/.i = g/.i) implies f = g;



theorem 
  len f = len g & (for k st 1 <= k & k <= len f holds f/.k = g/.k)
  implies f = g;

theorem 
  len f = 1 implies f = <*f/.1*>;

theorem 
  for D being non empty set, p being Element of D, f being
  FinSequence of D holds (<*p*>^f)/.1 = p;

theorem 
  for f being FinSequence, i being Nat holds len(f|i) <= len f;

theorem 
  for f being FinSequence, i being Nat holds len(f|i) <= i;

theorem 
  for f being FinSequence, i being Nat holds dom(f|i) c= dom f;

theorem 
  for f being FinSequence, i being Nat holds rng(f|i) c= rng f;

theorem 
  for D being set, f being FinSequence of D st f is non empty
  holds f|1 = <*f/.1*>;

theorem 
  i+1 = len f implies f = (f|i)^<*f/.len f*>;

registration
  let i,D;
  let f be one-to-one FinSequence of D;
  cluster f|i -> one-to-one;
end;

theorem 
  for D being set, f, g being FinSequence of D st i <= len f holds
  (f^g)|i = f|i;

theorem 
  for D being set, f, g being FinSequence of D holds (f^g)|(len f) = f;

theorem 
  for D being set, f being FinSequence of D st p in rng f holds (f-|p)^
  <*p*> = f|(p..f);

theorem 
  len(f/^i) <= len f;

reserve D for set,
  f for FinSequence of D;

theorem 
  i in dom(f/^n) implies n+i in dom f;

theorem 
  i in dom(f/^n) implies (f/^n)/.i = f/.(n+i);

theorem 
  f/^0 = f;

reserve D for non empty set,
  p for Element of D,
  f,g for FinSequence of D;

theorem 
  f is non empty implies f = <*f/.1*>^(f/^1);

theorem 
  i+1 = len f implies f/^i = <*f/.len f*>;

theorem 
  j+1 = i & i in dom f implies <*f/.i*>^(f/^i) = f/^j;

theorem 
  for D being set, f being FinSequence of D holds len f <= i
  implies f/^i is empty;

theorem 
  rng(f/^n) c= rng f;

registration
  let i,D;
  let f be one-to-one FinSequence of D;
  cluster f/^i -> one-to-one;
end;

theorem 
  f is one-to-one implies rng(f|n) misses rng(f/^n);

theorem 
  p in rng f implies f |-- p = f/^(p..f);

theorem 
  (f^g)/^(len f + i) = g/^i;

theorem 
  (f^g)/^(len f) = g;

theorem 
  p in rng f implies f/.(p..f) = p;

theorem 
  i in dom f implies f/.i..f <= i;

theorem 
  p in rng(f|i) implies p..(f|i) = p..f;

theorem 
  i in dom f & f is one-to-one implies f/.i..f = i;

definition
  let D, f;
  let p be set;
  func f-:p -> FinSequence of D equals

  f|(p..f);
end;

theorem 
  p in rng f implies len(f-:p) = p..f;

theorem 
  p in rng f & i in Seg(p..f) implies (f-:p)/.i = f/.i;

theorem 
  p in rng f implies (f-:p)/.1 = f/.1;

theorem 
  p in rng f implies (f-:p)/.(p..f) = p;

theorem 
  for x being set holds x in rng f & p in rng f & x..f<=p..f implies x
  in rng(f-:p);

theorem 
  p in rng f implies f-:p is non empty;

theorem 
  rng(f-:p) c= rng f;

registration
  let D,p;
  let f be one-to-one FinSequence of D;
  cluster f-:p -> one-to-one;
end;

definition
  let D, f, p;
  func f:-p -> FinSequence of D equals

  <*p*>^(f/^p..f);
end;

theorem 
  p in rng f implies ex i being Element of NAT st i+1 = p..f & f:- p = f/^i;

theorem 
  p in rng f implies len (f:-p) = len f - p..f + 1;

theorem 
  p in rng f & j+1 in dom(f:-p) implies j+p..f in dom f;

registration
  let D,p,f;
  cluster f:-p -> non empty;
end;

theorem 
  p in rng f & j+1 in dom(f:-p) implies (f:-p)/.(j+1) = f/.(j+p..f );

theorem 
  (f:-p)/.1 = p;

theorem 
  p in rng f implies (f:-p)/.(len(f:-p)) = f/.len f;

theorem 
  p in rng f implies rng(f:-p) c= rng f;

theorem 
  p in rng f & f is one-to-one implies f:-p is one-to-one;

reserve i for Nat;

definition
  let f be FinSequence;
  func Rev f -> FinSequence means


  len it = len f & for i st i in dom it holds it.i = f.(len f - i + 1);
 involutiveness;
end;

theorem 
  for f being FinSequence holds dom f = dom Rev f & rng f = rng Rev f;

theorem 
  for f being FinSequence st i in dom f holds (Rev f).i = f.(len f - i + 1);

theorem 
  for f being FinSequence, i,j being Nat st i in dom f & i+j = len
  f + 1 holds j in dom Rev f;

registration
  let f be empty FinSequence;
  cluster Rev f -> empty;
end;

theorem 
  for x being set holds Rev <*x*> = <*x*>;

theorem 
  for x1,x2 being set holds Rev <*x1,x2*> = <*x2,x1*>;

theorem 
  for f being FinSequence holds f.1 = (Rev f).(len f) & f.(len f) = (Rev f).1;

registration
  let f be one-to-one FinSequence;
  cluster Rev f -> one-to-one;
end;

theorem 
  for f being FinSequence, x being set holds Rev(f^<*x*>) = <*x*>^ (Rev f);

theorem 
  for f,g being FinSequence holds Rev(f^g) = (Rev g)^(Rev f);

definition
  let D be set, f be FinSequence of D;
  redefine func Rev f -> FinSequence of D;
end;

theorem 
  f is non empty implies f/.1 = (Rev f)/.len f & f/.len f = (Rev f)/.1;

theorem 
  i in dom f & i+j = len f + 1 implies f/.i = (Rev f)/.j;

definition
  let D,f,p;
  let n be Nat;
  func Ins(f,n,p) -> FinSequence of D equals

  (f|n)^<*p*>^(f/^n);
end;

theorem 
  Ins(f,0,p) = <*p*>^f;

theorem 
  len f <= n implies Ins(f,n,p) = f^<*p*>;

theorem 
  len(Ins(f,n,p)) = len f + 1;

theorem 
  rng Ins(f,n,p) = {p} \/ rng f;

registration
  let D,f,n,p;
  cluster Ins(f,n,p) -> non empty;
end;

theorem 
  p in rng Ins(f,n,p);

theorem 
  i in dom(f|n) implies (Ins(f,n,p))/.i = f/.i;

theorem 
  n <= len f implies (Ins(f,n,p))/.(n+1) = p;

theorem 
  n+1 <= i & i <= len f implies (Ins(f,n,p))/.(i+1) = f/.i;

theorem 
  1 <= n & f is non empty implies (Ins(f,n,p))/.1 = f/.1;

theorem 
  f is one-to-one & not p in rng f implies Ins(f,n,p) is one-to-one;

begin 


theorem 
  for i1,i2 be Nat st i1<=i2 holds (f|i1)|i2=f|i1 & (f|i2)|i1=f|i1;

theorem 
  for i be Nat holds (<*>D)|i=<*>D;

theorem 
  Rev <*>D = <*>D;



registration
  cluster non trivial for FinSequence;
end;



theorem 
  for f being FinSequence of D,l1,l2 being Nat holds (f/^l1)|(l2-'l1)=(f
  |l2)/^l1;



reserve D for set,
  f for FinSequence of D;

theorem 
  len f >= 2 implies f|2 = <*f/.1,f/.2*>;

theorem 
  k+1 <= len f implies f|(k+1) = f|k^<*f/.(k+1)*>;



theorem 
  for D being set, p be FinSequence of D for i be Nat st i < len p
  holds p|(i+1) = p|i ^ <*p.(i+1)*>;



theorem 
  for D be non empty set for p be FinSequence of D for n be Nat st 1 <=
  n & n <= len p holds p = (p|(n-'1))^<*p.n*>^(p/^n);














begin 

definition
  let p,q be FinSequence;
  func p$^q -> FinSequence means


  it = p^q if p = {} or q = {} otherwise
  ex i being Element of NAT, r being FinSequence st len p = i+1 & r = p|Seg i &
  it = r^q;
end;

reserve p,q,r for FinSequence,
  x,y for set;

theorem 
  {}$^p = p & p$^{} = p;

theorem 
  q <> {} implies (p^<*x*>)$^q = p^q;

theorem 
  (p^<*x*>)$^(<*y*>^q) = p^<*y*>^q;

theorem 
  q <> {} implies <*x*>$^q = q;

theorem 
  p <> {} implies ex x,q st p = <*x*>^q & len p = len q+1;

scheme 

  PathCatenation {P[set,set], p,q() -> FinSequence}: for i being Element of
NAT st i in dom (p()$^q()) & i+1 in dom (p()$^q()) for x,y being set st x = (p(
  )$^q()).i & y = (p()$^q()).(i+1) holds P[x,y]
provided
 for i being Element of NAT st i in dom p() & i+1 in dom p() holds P[
p().i, p().(i+1)] and
 for i being Element of NAT st i in dom q() & i+1 in dom q() holds P[
q().i, q().(i+1)] and
 len p() > 0 & len q() > 0 & p().len p() = q().1;

definition
  let R be Relation;
  mode RedSequence of R -> FinSequence means


    len it > 0 & for i being
    Element of NAT st i in dom it & i+1 in dom it holds [it.i, it.(i+1)] in R;
end;

registration
  let R be Relation;
  cluster -> non empty for RedSequence of R;
end;

theorem 
  for R being Relation, a being set holds <*a*> is RedSequence of R;

theorem 
  for R being Relation, a,b being set st [a,b] in R holds <*a,b*>
  is RedSequence of R;

theorem 
  for R being Relation, p,q being RedSequence of R st p.len p = q.1
  holds p$^q is RedSequence of R;

theorem 
  for R being Relation, p being RedSequence of R holds Rev p is
  RedSequence of R~;

theorem 
  for R,Q being Relation st R c= Q for p being RedSequence of R
  holds p is RedSequence of Q;

begin 

definition
  let R be Relation;
  let a,b be set;
  pred R reduces a,b means


  ex p being RedSequence of R st p.1 = a & p. len p = b;
end;

definition
  let R be Relation;
  let a,b be set;
  pred a,b are_convertible_wrt R means


  R \/ R~ reduces a,b;
end;

theorem 
  for R being Relation, a,b being set holds R reduces a,b iff ex p
being FinSequence st len p > 0 & p.1 = a & p.len p = b & for i being Element of
  NAT st i in dom p & i+1 in dom p holds [p.i, p.(i+1)] in R;

theorem 
  for R being Relation, a being set holds R reduces a,a;

theorem 
  for a,b being set st {} reduces a,b holds a = b;

theorem 
  for R being Relation, a,b being set st R reduces a,b & not a in
  field R holds a = b;

theorem 
  for R being Relation, a,b being set st [a,b] in R holds R reduces a,b;

theorem 
  for R being Relation, a,b,c being set st R reduces a,b & R
  reduces b,c holds R reduces a,c;

theorem 
  for R being Relation, p being RedSequence of R, i,j being
  Element of NAT st i in dom p & j in dom p & i <= j holds R reduces p.i,p.j;

theorem 
  for R being Relation, a,b being set st R reduces a,b & a <> b
  holds a in field R & b in field R;

theorem 
  for R being Relation, a,b being set st R reduces a,b holds a in field
  R iff b in field R;

theorem 
  for R being Relation, a,b being set holds R reduces a,b iff a =
  b or [a,b] in R[*];

theorem 
  for R being Relation, a,b being set holds R reduces a,b iff R[*] reduces a,b;

theorem 
  for R,Q being Relation st R c= Q for a,b being set st R reduces
  a,b holds Q reduces a,b;

theorem 
  for R being Relation, X being set, a,b being set holds R reduces a,b
  iff R \/ id X reduces a,b;

theorem 
  for R being Relation, a,b being set st R reduces a,b holds R~ reduces b,a;

theorem 
  for R being Relation, a,b being set st R reduces a,b holds a,b
  are_convertible_wrt R & b,a are_convertible_wrt R;

theorem 
  for R being Relation, a being set holds a,a are_convertible_wrt R;

theorem 
  for a,b being set st a,b are_convertible_wrt {} holds a = b;

theorem 
  for R being Relation, a,b being set st a,b are_convertible_wrt R & not
  a in field R holds a = b;

theorem 
  for R being Relation, a,b being set st [a,b] in R holds a,b
  are_convertible_wrt R;

theorem 
  for R being Relation, a,b,c being set st a,b are_convertible_wrt
  R & b,c are_convertible_wrt R holds a,c are_convertible_wrt R;

theorem 
  for R being Relation, a,b being set st a,b are_convertible_wrt R holds
  b,a are_convertible_wrt R;

theorem 
  for R being Relation, a,b being set st a,b are_convertible_wrt R
  & a <> b holds a in field R & b in field R;

definition
  let R be Relation;
  let a be set;
  pred a is_a_normal_form_wrt R means

  not ex b being set st [a,b] in R;
end;

theorem 
  for R being Relation, a,b being set st a is_a_normal_form_wrt R
  & R reduces a,b holds a = b;

theorem 
  for R being Relation, a being set st not a in field R holds a
  is_a_normal_form_wrt R;

definition
  let R be Relation;
  let a,b be set;
  pred b is_a_normal_form_of a,R means


  b is_a_normal_form_wrt R & R reduces a,b;
  pred a,b are_convergent_wrt R means


  ex c being set st R reduces a,c & R reduces b,c;
  pred a,b are_divergent_wrt R means


  ex c being set st R reduces c,a & R reduces c,b;
  pred a,b are_convergent<=1_wrt R means


  ex c being set st ([a,c] in R or a = c) & ([b,c] in R or b = c);
  pred a,b are_divergent<=1_wrt R means


  ex c being set st ([c,a] in R or a = c) & ([c,b] in R or b = c);
end;

theorem 
  for R being Relation, a being set st not a in field R holds a
  is_a_normal_form_of a,R;

theorem 
  for R being Relation, a,b being set st R reduces a,b holds a,b
are_convergent_wrt R & a,b are_divergent_wrt R & b,a are_convergent_wrt R & b,a
  are_divergent_wrt R;

theorem 
  for R being Relation, a,b being set st a,b are_convergent_wrt R
  or a,b are_divergent_wrt R holds a,b are_convertible_wrt R;

theorem 
  for R being Relation, a being set holds a,a are_convergent_wrt R
  & a,a are_divergent_wrt R;

theorem 
  for a,b being set st a,b are_convergent_wrt {} or a,b
  are_divergent_wrt {} holds a = b;

theorem 
  for R being Relation, a,b being set st a,b are_convergent_wrt R holds
  b,a are_convergent_wrt R;

theorem 
  for R being Relation, a,b being set st a,b are_divergent_wrt R holds b
  ,a are_divergent_wrt R;

theorem 
  for R being Relation, a,b,c being set st R reduces a,b & b,c
  are_convergent_wrt R or a,b are_convergent_wrt R & R reduces c,b holds a,c
  are_convergent_wrt R;

theorem 
  for R being Relation, a,b,c being set st R reduces b,a & b,c
  are_divergent_wrt R or a,b are_divergent_wrt R & R reduces b,c holds a,c
  are_divergent_wrt R;

theorem 
  for R being Relation, a,b being set st a,b are_convergent<=1_wrt
  R holds a,b are_convergent_wrt R;

theorem 
  for R being Relation, a,b being set st a,b are_divergent<=1_wrt
  R holds a,b are_divergent_wrt R;

definition
  let R be Relation;
  let a be set;
  pred a has_a_normal_form_wrt R means


  ex b being set st b is_a_normal_form_of a,R;
end;

theorem 
  for R being Relation, a being set st not a in field R holds a
  has_a_normal_form_wrt R;

definition
  let R be Relation, a be set;
  assume that
 a has_a_normal_form_wrt R and
 for b,c being set st b is_a_normal_form_of a,R & c
  is_a_normal_form_of a,R holds b = c;
  func nf(a,R) means


  it is_a_normal_form_of a,R;
end;

begin 

definition
  let R be Relation;
  attr R is co-well_founded means


  R~ is well_founded;
  attr R is weakly-normalizing means


  for a being set st a in field R holds a has_a_normal_form_wrt R;
  attr R is strongly-normalizing means

  for f being ManySortedSet of NAT ex i
  being Element of NAT st not [f.i,f.(i+1)] in R;
end;

definition
  let R be Relation;
  redefine attr R is co-well_founded means


  for Y being set st Y c=
field R & Y <> {} ex a being set st a in Y & for b being set st b in Y & a <> b
  holds not [a,b] in R;
end;

scheme 

  coNoetherianInduction{R() -> Relation, P[set]}: for a being set st a in
  field R() holds P[a]
provided
 R() is co-well_founded and
 for a being set st for b being set st [a,b] in R() & a <> b holds P[
b] holds P[a];

registration
  cluster strongly-normalizing -> irreflexive co-well_founded for Relation;
  cluster co-well_founded irreflexive -> strongly-normalizing for Relation;
end;

registration
  cluster empty -> weakly-normalizing strongly-normalizing for Relation;
end;

theorem 
  for Q being co-well_founded Relation, R being Relation st R c= Q holds
  R is co-well_founded;

registration
  cluster strongly-normalizing -> weakly-normalizing for Relation;
end;

begin 

definition
  let R,Q be Relation;
  pred R commutes-weakly_with Q means

  for a,b,c being set st [a,b] in R & [a,c
  ] in Q ex d being set st Q reduces b,d & R reduces c,d;
  symmetry;
  pred R commutes_with Q means


  for a,b,c being set st R reduces a,b &
  Q reduces a,c ex d being set st Q reduces b,d & R reduces c,d;
  symmetry;
end;

theorem 
  for R,Q being Relation st R commutes_with Q holds R commutes-weakly_with Q;

definition
  let R be Relation;
  attr R is with_UN_property means


  for a,b being set st a
  is_a_normal_form_wrt R & b is_a_normal_form_wrt R & a,b are_convertible_wrt R
  holds a = b;
  attr R is with_NF_property means

  for a,b being set st a is_a_normal_form_wrt
  R & a,b are_convertible_wrt R holds R reduces b,a;
  attr R is subcommutative means


  for a,b,c being set st [a,b] in R &
  [a,c] in R holds b,c are_convergent<=1_wrt R;
  attr R is confluent means


  for a,b being set st a,b are_divergent_wrt R holds a,b are_convergent_wrt R;
  attr R is with_Church-Rosser_property means


  for a,b being set st a,
  b are_convertible_wrt R holds a,b are_convergent_wrt R;
  attr R is locally-confluent means


  for a,b,c being set st [a,b] in R
  & [a,c] in R holds b,c are_convergent_wrt R;
end;

theorem 
  for R being Relation st R is subcommutative for a,b,c being set
  st R reduces a,b & [a,c] in R holds b,c are_convergent_wrt R;

theorem 
  for R being Relation holds R is confluent iff R commutes_with R;

theorem 
  for R being Relation holds R is confluent iff for a,b,c being
  set st R reduces a,b & [a,c] in R holds b,c are_convergent_wrt R;

theorem 
  for R being Relation holds R is locally-confluent iff R
  commutes-weakly_with R;

registration
  cluster with_Church-Rosser_property -> confluent for Relation;
  cluster confluent -> locally-confluent with_Church-Rosser_property for
Relation;
  cluster subcommutative -> confluent for Relation;
  cluster with_Church-Rosser_property -> with_NF_property for Relation;
  cluster with_NF_property -> with_UN_property for Relation;
  cluster with_UN_property weakly-normalizing -> with_Church-Rosser_property
    for Relation;
end;

registration
  cluster empty -> subcommutative for Relation;
end;

theorem 
  for R being with_UN_property Relation for a,b,c being set st b
  is_a_normal_form_of a,R & c is_a_normal_form_of a,R holds b = c;

theorem 
  for R being with_UN_property weakly-normalizing Relation for a
  being set holds nf(a,R) is_a_normal_form_of a,R;

theorem 
  for R being with_UN_property weakly-normalizing Relation for a,b
  being set st a,b are_convertible_wrt R holds nf(a,R) = nf(b,R);

registration
  cluster strongly-normalizing locally-confluent -> confluent for Relation;
end;

definition
  let R be Relation;
  attr R is complete means

  R is confluent strongly-normalizing;
end;

registration
  cluster complete -> confluent strongly-normalizing for Relation;
  cluster confluent strongly-normalizing -> complete for Relation;
end;

registration
  cluster complete for non empty Relation;
end;

theorem 
  for R,Q being with_Church-Rosser_property Relation st R commutes_with
  Q holds R \/ Q is with_Church-Rosser_property;

theorem 
  for R being Relation holds R is confluent iff R[*] is locally-confluent;

theorem 
  for R being Relation holds R is confluent iff R[*] is subcommutative;

begin 

definition
  let R,Q be Relation;
  pred R,Q are_equivalent means

  for a,b being set holds a,b
  are_convertible_wrt R iff a,b are_convertible_wrt Q;
  symmetry;
end;

definition
  let R be Relation;
  let a,b be set;
  pred a,b are_critical_wrt R means


  a,b are_divergent<=1_wrt R & not a,b are_convergent_wrt R;
end;

theorem 
  for R being Relation, a,b being set st a,b are_critical_wrt R
  holds a,b are_convertible_wrt R;

theorem 
  for R being Relation st not ex a,b being set st a,b are_critical_wrt R
  holds R is locally-confluent;

theorem 
  for R,Q being Relation st for a,b being set st [a,b] in Q holds a,b
  are_critical_wrt R holds R, R \/ Q are_equivalent;

theorem 
  for R being Relation ex Q being complete Relation st field Q c=
  field R & for a,b being set holds a,b are_convertible_wrt R iff a,b
  are_convergent_wrt Q;

definition
  let R be Relation;
  mode Completion of R -> complete Relation means


    for a,b being set
    holds a,b are_convertible_wrt R iff a,b are_convergent_wrt it;
end;

theorem 
  for R being Relation, C being Completion of R holds R,C are_equivalent;

theorem 
  for R being Relation, Q being complete Relation st R,Q are_equivalent
  holds Q is Completion of R;

theorem 
  for R being Relation, C being Completion of R, a,b being set holds a,b
  are_convertible_wrt R iff nf(a,C) = nf(b,C);














begin 

reserve a,x,y,A,B for set,
  l,m,n for Element of NAT;

theorem 
  for f being Function, X being set st rng f c= X holds (id X)*f = f;

theorem 
  for X being set, Y being non empty set, f being Function of X,Y st f
is one-to-one for B being Subset of X, C being Subset of Y st C c= f.:B holds f
  "C c= B;

theorem 
  for X,Y be non empty set, f being Function of X,Y st f is
one-to-one for x being Element of X, A being Subset of X st f.x in f.:A holds x
  in A;

theorem 
  for X,Y be non empty set, f being Function of X,Y st f is
  one-to-one for x being Element of X, A being Subset of X, B being Subset of Y
  st f.x in f.:A \ B holds x in A \ f"B;

theorem 
  for X,Y be non empty set, f being Function of X,Y st f is one-to-one
for y being Element of Y, A being Subset of X, B being Subset of Y st y in f.:A
  \ B holds f".y in A \ f"B;

theorem 
  for f being Function, a being set st a in dom f holds f|{a} = a
  .--> f.a;

registration
  let x,y be set;
  cluster x .--> y -> non empty;
end;

registration
  let x,y,a,b be set;
  cluster (x,y) --> (a,b) -> non empty;
end;

theorem 
  for I being set, M being ManySortedSet of I for i being set st i
  in I holds i.--> (M.i) = M|{i};

theorem 
  for I,J being set, M being ManySortedSet of [:I,J:] for i,j being set
  st i in I & j in J holds (i,j):-> (M.(i,j)) = M|([:{i},{j}:] qua set);

theorem 
  for f,g,h being Function st rng h c= dom f holds f*(g +* h) = (f
  *g) +* (f*h);

theorem 
  for f,g,h being Function holds (g +* h)*f = (g*f) +* (h*f);

theorem 
  for f,g,h being Function st rng f misses dom g holds (h +* g)*f = h*f;

theorem 
  for A,B be set, y be set st A meets rng(id B +* (A --> y)) holds
  y in A;

theorem 
  for x,y be set, A be set st x <> y holds not x in rng(id A +* (x .-->
  y));

theorem 
  for X being set, a being set, f being Function st dom f = X \/ {a}
  holds f = f|X +* (a .--> f.a);

theorem 
  for f being Function, X,y,z being set holds (f+*(X-->y))+*(X-->z) = f
  +*(X-->z);

theorem 
  INT <> INT*;

theorem 
  {}* = {{}};

theorem 
  <*x*> in A* iff x in A;

theorem 
  A* c= B* implies A c= B;

theorem 
  for A being Subset of NAT st for n,m st n in A & m < n holds m in A
  holds A is Cardinal;

theorem 
  for A being finite set, X being non empty Subset-Family of A ex C
  being Element of X st for B being Element of X holds B c= C implies B = C;

theorem 
  for p,q being FinSequence st len p = len q+1 for i being Element
  of NAT holds i in dom q iff i in dom p & i+1 in dom p;

registration
  cluster Function-yielding non empty non-empty for FinSequence;
end;

registration
  cluster empty -> Function-yielding for Function;
  let f be Function;
  cluster <*f*> -> Function-yielding;
  let g be Function;
  cluster <*f,g*> -> Function-yielding;
  let h be Function;
  cluster <*f,g,h*> -> Function-yielding;
end;

registration
  let n be Element of NAT, f be Function;
  cluster n |-> f -> Function-yielding;
end;

registration
  let p,q be Function-yielding FinSequence;
  cluster p^q -> Function-yielding;
end;

theorem 
  for p,q being FinSequence st p^q is Function-yielding holds p is
  Function-yielding & q is Function-yielding;

begin 

scheme 

  Kappa2D{ X,Y,Z()->non empty set,F(Element of X(),Element of Y())->set}: ex f
  being Function of [:X(),Y():], Z() st for x being Element of X(), y being
  Element of Y() holds f.(x,y)=F(x,y)
provided
 for x being Element of X(), y being Element of Y() holds F(x,y) in Z
();

scheme 

  FinMono{ A() -> set, D() -> non empty set, F,G(set) -> set }: { F(d) where d
  is Element of D() : G(d) in A() } is finite
provided
 A() is finite and
 for d1,d2 being Element of D() st G(d1) = G(d2) holds d1 = d2;

scheme 

  CardMono{ A() -> set, D() -> non empty set, G(set) -> set }: A(),{ d where d
  is Element of D() : G(d) in A() } are_equipotent
provided
 for x being set st x in A() ex d being Element of D() st x = G(d) and
 for d1,d2 being Element of D() st G(d1) = G(d2) holds d1 = d2;

scheme 

  CardMono9{ A() -> set, D() -> non empty set, G(set) -> set }: A(),{ G(d)
  where d is Element of D() : d in A() } are_equipotent
provided
 A() c= D() and
 for d1,d2 being Element of D() st G(d1) = G(d2) holds d1 = d2;

scheme 

  FuncSeqInd {P[set]}: for p being Function-yielding FinSequence holds P[p]
provided
 P[ {} ] and
 for p being Function-yielding FinSequence st P[p] for f being
Function holds P[p^<*f*>];

begin 

definition
  let x, y be set;
  assume
 x in y;
  func In (x, y) -> Element of y equals


  x;
end;

theorem 
  x in A /\ B implies In (x,A) = In (x,B);

definition
  let f,g be Function;
  let A be set;
  pred f,g equal_outside A means


  f|(dom f \ A) = g|(dom g \ A);
end;

theorem 
  for f be Function, A be set holds f,f equal_outside A;

theorem 
  for f,g be Function, A be set st f,g equal_outside A holds g,f
  equal_outside A;

theorem 
  for f,g,h be Function, A be set st f,g equal_outside A & g,h
  equal_outside A holds f,h equal_outside A;

theorem 
  for f,g be Function, A be set st f,g equal_outside A holds dom f
  \ A = dom g \ A;

theorem 
  for f,g being Function, A be set st dom g c= A holds f, f +* g
  equal_outside A;

definition
  let f be Function, i, x be set;
  func f+*(i,x) -> Function equals


  f+*(i.-->x) if i in dom f otherwise
  f;
end;

theorem 
  for f be Function, d,i be set holds dom(f+*(i,d)) = dom f;

theorem 
  for f be Function, d,i be set st i in dom f holds (f+*(i,d)).i = d;

theorem 
  for f be Function, d,i,j be set st i <> j holds (f+*(i,d)).j = f.j;

theorem 
  for f be Function, d,e,i,j be set st i <> j holds f+*(i,d)+*(j,e) = f
  +*(j,e)+*(i,d);

theorem 
  for f be Function, d,e,i be set holds f+*(i,d)+*(i,e) = f+*(i,e);

theorem 
  for f be Function, i be set holds f+*(i,f.i) = f;

registration
  let f be FinSequence, i,x be set;
  cluster f+*(i,x) -> FinSequence-like;
end;

definition
  let D be set, f be FinSequence of D, i be Element of NAT, d be Element of D;
  redefine func f+*(i,d) -> FinSequence of D;
end;

theorem 
  for D be non empty set, f be FinSequence of D, d be Element of D, i be
  Element of NAT st i in dom f holds (f+*(i,d))/.i = d;

theorem 
  for D be non empty set, f be FinSequence of D, d be Element of D, i,j
  be Element of NAT st i <> j & j in dom f holds (f+*(i,d))/.j = f/.j;

theorem 
  for D be non empty set, f be FinSequence of D, d,e be Element of D, i
  be Element of NAT holds f+*(i,f/.i) = f;

begin 

definition
  let X be set;
  let p be Function-yielding FinSequence;
  func compose(p,X) -> Function means


  ex f being ManySortedFunction of
  NAT st it = f.len p & f.0 = id X & for i being Element of NAT st i+1 in dom p
  for g,h being Function st g = f.i & h = p.(i+1) holds f.(i+1) = h*g;
end;

definition
  let p be Function-yielding FinSequence;
  let x be set;
  func apply(p,x) -> FinSequence means


  len it = len p+1 & it.1 = x &
for i being Element of NAT, f being Function st i in dom p & f = p.i holds it.(
  i+1) = f.(it.i);
end;

reserve X,Y,x for set,
  p,q for Function-yielding FinSequence,
  f,g,h for Function;

theorem 
  compose({},X) = id X;

theorem 
  apply({},x) = <*x*>;

theorem 
  compose(p^<*f*>,X) = f*compose(p,X);

theorem 
  apply(p^<*f*>,x) = apply(p,x)^<*f.(apply(p,x).(len p+1))*>;

theorem 
  compose(<*f*>^p,X) = compose(p,f.:X)*(f|X);

theorem 
  apply(<*f*>^p,x) = <*x*>^apply(p,f.x);

theorem 
  compose(<*f*>,X) = f*id X;

theorem 
  dom f c= X implies compose(<*f*>,X) = f;

theorem 
  apply(<*f*>,x) = <*x,f.x*>;

theorem 
  rng compose(p,X) c= Y implies compose(p^q,X) = compose(q,Y)*compose(p,
  X );

theorem 
  apply(p^q,x).(len (p^q)+1) = apply(q,apply(p,x).(len p+1)).(len
  q+1);

theorem 
  apply(p^q,x) = apply(p,x)$^apply(q,apply(p,x).(len p+1));

theorem 
  compose(<*f,g*>,X) = g*f*id X;

theorem 
  dom f c= X or dom(g*f) c= X implies compose(<*f,g*>,X) = g*f;

theorem 
  apply(<*f,g*>,x) = <*x,f.x,g.(f.x)*>;

theorem 
  compose(<*f,g,h*>,X) = h*g*f*id X;

theorem 
  dom f c= X or dom(g*f) c= X or dom(h*g*f) c= X implies compose(<*f,g,h
  *>,X) = h*g*f;

theorem 
  apply(<*f,g,h*>,x) = <*x*>^<*f.x,g.(f.x),h.(g.(f.x))*>;

definition
  let F be FinSequence;
  func firstdom F means


  it is empty if F is empty otherwise it = proj1
  (F.1);
  func lastrng F means


  it is empty if F is empty otherwise it = proj2
  (F.len F);
end;

theorem 
  firstdom {} = {} & lastrng {} = {};

theorem 
  for p being FinSequence holds firstdom (<*f*>^p) = dom f &
  lastrng (p^<*f*>) = rng f;

theorem 
  for p being Function-yielding FinSequence st p <> {} holds rng
  compose(p,X) c= lastrng p;

definition
  let IT be FinSequence;
  attr IT is FuncSeq-like means


  ex p being FinSequence st len p = len
IT+1 & for i being Element of NAT st i in dom IT holds IT.i in Funcs(p.i, p.(i+
  1));
end;

theorem 
  for p,q being FinSequence st p^q is FuncSeq-like holds p is
  FuncSeq-like & q is FuncSeq-like;

registration
  cluster FuncSeq-like -> Function-yielding for FinSequence;
end;

registration
  cluster empty -> FuncSeq-like for FinSequence;
end;

registration
  let f be Function;
  cluster <*f*> -> FuncSeq-like;
end;

registration
  cluster FuncSeq-like non empty non-empty for FinSequence;
end;

definition
  mode FuncSequence is FuncSeq-like FinSequence;
end;

theorem 
  for p being FuncSequence st p <> {} holds dom compose(p,X) = (
  firstdom p) /\ X;

theorem 
  for p being FuncSequence holds dom compose(p,firstdom p) =
  firstdom p;

theorem 
  for p being FuncSequence, f being Function st rng f c= firstdom p
  holds <*f*>^p is FuncSequence;

theorem 
  for p being FuncSequence, f being Function st lastrng p c= dom f holds
  p^<*f*> is FuncSequence;

theorem 
  for p being FuncSequence st x in firstdom p & x in X holds apply(p,x).
  (len p+1) = compose(p,X).x;

definition
  let X,Y be set such that
 Y is empty implies X is empty;
  mode FuncSequence of X,Y -> FuncSequence means


    firstdom it = X &
    lastrng it c= Y;
end;

definition
  let Y be non empty set, X be set;
  let F be FuncSequence of X,Y;
  redefine func compose(F,X) -> Function of X,Y;
end;

definition
  let q be non-empty non empty FinSequence;
  mode FuncSequence of q -> FinSequence means


    len it+1 = len q & for i
    being Element of NAT st i in dom it holds it.i in Funcs(q.i,q.(i+1));
end;

registration
  let q be non-empty non empty FinSequence;
  cluster -> FuncSeq-like non-empty for FuncSequence of q;
end;

theorem 
  for q being non-empty non empty FinSequence, p being
  FuncSequence of q st p <> {} holds firstdom p = q.1 & lastrng p c= q.len q;

theorem 
  for q being non-empty non empty FinSequence, p being FuncSequence of q
  holds dom compose(p,q.1) = q.1 & rng compose(p,q.1) c= q.len q;



registration
  let X be set;
  let f be Function of NAT, bool [:X,X:];
  let n be Nat;
  cluster f.n -> Relation-like;
end;

definition
  let f be Relation;
  let n be Nat;
  func iter (f,n) -> Relation means


  ex p being Function of NAT, bool [:field f,field f:] st
  it = p.n & p.0 = id(field f) &
  for k being Nat holds p.(k+1) = f*(p.k);
end;

registration
  let f be Function;
  let n be Nat;
  cluster iter (f,n) -> Function-like;
end;

reserve m,n,k for Element of NAT, R for Relation;

theorem 
  iter (R,0) = id(field R);

theorem 
  for n be Nat holds iter(R,n+1) = R*iter(R,n);

theorem 
  iter(R,1) = R;

theorem 
  for n being Nat holds iter(R,n+1) = iter(R,n)*R;

theorem 
  dom iter(R,n) c= field R & rng iter(R,n) c= field R;

theorem 
  n <> 0 implies dom iter(R,n) c= dom R & rng iter(R,n) c= rng R;

theorem 
  for n being Nat st rng R c= dom R holds dom iter(R,n) = dom R &
  rng iter(R,n) c= dom R;

theorem 
  id(field R)*iter(R,n) = iter(R,n);

theorem 
  iter(R,n)*id(field R) = iter(R,n);

theorem 
  iter(R,m)*iter(R,n) = iter(R,n+m);

theorem 
  n <> 0 implies iter(iter(R,m),n) = iter(R,m*n);

theorem 
  rng R c= dom R implies iter(iter(R,m),n) = iter(R,m*n);

theorem 
  iter({},n) = {};

theorem 
  iter(id(X),n) = id(X);

theorem 
  rng R misses dom R implies iter(R,2) = {};

theorem 
  for n being Nat for f being Function of X,X holds iter(f,n) is
  Function of X,X;

theorem 
  for f being Function of X,X holds iter(f,0) = id X;

theorem 
  for f being Function of X,X holds iter(iter(f,m),n) = iter(f,m*n);

theorem 
  for f being PartFunc of X,X holds iter(f,n) is PartFunc of X,X;

theorem 
  n <> 0 & a in X & f = X --> a implies iter(f,n) = f;

theorem 
  for f being Function, n being Element of NAT holds iter(f,n) = compose
  (n|->f,field f);

begin 



theorem 
  for f,g being Function, x,y being set st g c= f & not x in dom g holds
  g c= f+*(x,y);

theorem 
  for f,g being Function, A being set st f|A = g|A & f,g equal_outside A
  holds f = g;

theorem 
  for f being Function, a,b,A being set st a in A holds f,f+*(a,b)
  equal_outside A;

theorem 
  for f being Function, a,b,A being set holds a in A or (f+*(a,b))
  |A = f|A;

theorem 
  for f,g being Function, a,b,A being set st f|A = g|A holds (f+*(a,b))|
  A = (g+*(a,b))|A;



theorem 
  for f being Function, a, b being set holds (f +* (a .--> b)).a =
  b;



theorem 
  for a, b being set holds <*a*> +* (1,b) = <*b*>;



theorem 
  for f be Function, x be set st x in dom f holds f +* (x .--> f.x) = f;



reserve i for Nat;
reserve j for Element of NAT;

theorem 
  for w being FinSequence,r being set,i holds len (w+*(i,r))=len w;

theorem 
  for D being non empty set, w being FinSequence of D, r being Element
  of D st i in dom w holds w+*(i,r)=(w|(i-'1))^<*r*>^(w/^i);



reserve F for Function,
  e,x,y,z for set;

definition
  let F;
  let x,y;
  func Swap(F,x,y) equals


  F+*(x,F.y)+*(y,F.x) if x in dom F & y in dom
  F otherwise F;
end;

registration
  let F;
  let x,y;
  cluster Swap(F,x,y) -> Relation-like Function-like;
end;

theorem 
  dom Swap(F,x,y) = dom F;

theorem 
  rng(F+*(x,y)) c= rng F \/ {y};

theorem 
  rng F c= rng(F+*(x,y)) \/ {F.x};

theorem 
  x in dom F implies y in rng(F+*(x,y));

theorem 
  rng Swap(F,x,y) = rng F;



scheme 

  { A() -> set, D() -> non empty set, G(set) -> set }: A(),{ G(d) where d is
  Element of D() : d in A() } are_equipotent
provided
 A() c= D() and
 for d1,d2 being Element of D() st d1 in A() & d2 in A() & G(d1) = G(
d2) holds d1 = d2;



theorem 
  for f,g,h being Function, A being set holds f, g equal_outside A
  implies f +* h, g +* h equal_outside A;

theorem 
  for f,g,h being Function, A being set holds f, g equal_outside A
  implies h +* f, h +* g equal_outside A;

theorem 
  for f,g,h being Function holds f +* h = g +* h iff f,g equal_outside
  dom h;



theorem 
  for x, y, a being set, f being Function st f.x = f.y holds f.a
  = (f*((id dom f)+*(x,y))).a;

theorem 
  for x, y being set, f being Function st x in dom f implies y in dom f
  & f.x = f.y holds f = f*((id dom f)+*(x,y));



theorem 
  for f be Function, x be set st x in dom f holds f +* (x .--> f.x) = f;



theorem 
  for X being set, p being Permutation of X, x, y being Element
  of X holds p+*(x, p.y)+*(y, p.x) is Permutation of X;

theorem 
  for f being Function, x, y being set st x in dom f & y in dom f ex p
  being Permutation of dom f st f+*(x, f.y)+*(y, f.x) = f*p;



theorem 
  for f be Function,d,r be set st d in dom f holds dom f=dom (f+*(d.-->r
  ));



theorem 
  for f,g be FinSequence of INT,m,n be Element of NAT st 1<=n & n <= len
f & 1<=m & m <= len f & g=f+*(m,f/.n) +*(n,f/.m) holds f.m=g.n & f.n=g.m & (for
  k be set st k<>m & k<>n & k in dom f holds f.k=g.k) & f,g
  are_fiberwise_equipotent;



theorem 
  for f being Function, a, A, b, B, c, C being set st a <> b & a <> c
  holds ( f +* (a .--> A) +* (b .--> B) +* (c .--> C) ).a = A;



theorem 
  for A, B, a, b being set, f being Function of A,B st b in B
  holds f +* (a,b) is Function of A,B;



theorem 
  rng f c= A implies f+~(x,y) = (id A+*(x,y))*f;

theorem 
  (f+*g)+~(x,y) = f+~(x,y)+*(g+~(x,y));

definition
  let a,b be set;
  func a followed_by b equals

  (NAT --> b) +* (0,a);
end;

registration
  let a,b be set;
  cluster a followed_by b -> Function-like Relation-like;
end;

reserve a,b,c for set,
  n for Nat;

theorem 
  dom(a followed_by b) = NAT;

definition
  let X be non empty set;
  let a,b be Element of X;
  redefine func a followed_by b -> sequence of X;
end;

theorem 
  (a followed_by b).0 = a;

theorem 
  for n st n > 0 holds (a followed_by b).n = b;



definition
  let a,b,c be set;
  func (a,b) followed_by c equals

  (NAT --> c) +* ((0,1) --> (a,b));
end;

registration
  let a,b,c be set;
  cluster (a,b) followed_by c -> Function-like Relation-like;
end;

theorem 
  dom (a,b) followed_by c = NAT;

theorem 
  ((a,b) followed_by c).0 = a;

theorem 
  ((a,b) followed_by c).1 = b;

theorem 
  for n st n > 1 holds ((a,b) followed_by c).n = c;

theorem 
  (a,b) followed_by c = (a followed_by c) +* (1,b);

definition
  let X be non empty set;
  let a,b,c be Element of X;
  redefine func (a,b) followed_by c -> sequence of X;
end;

theorem 
  rng(a followed_by b) = {a,b};

theorem 
  rng (a,b) followed_by c = {a,b,c};



definition
  let A, B be set, f be Function of A, B, x be set, y be Element of B;
  redefine func f+*(x,y) -> Function of A, B;
end;



theorem 
  for A, B being non empty set, f being Function of A, B, x being
  Element of A, y being set holds f+*(x,y).x = y;

theorem 
  for A, B being non empty set, f,g being Function of A, B, x being
Element of A st for y being Element of A st f.y <> g.y holds y = x holds f = g
  +*(x,f.x);

theorem 
 for g being A-defined Function holds f,f+*g equal_outside A;

theorem 
 for f,g being A-defined Function holds f,g equal_outside A;

theorem 
 for f,g being A-defined Function, h being Function
  holds h+*f, h+*g equal_outside A;

reserve n for Element of NAT;

theorem 
  for I being NAT-defined Function holds card Shift(I,m) = card I;

theorem 
 dom f = dom g & dom f c= A \/ B & f|B = g|B
  implies f,g equal_outside A;

theorem 
 dom f = dom g & B c= dom f & A misses B & f,g equal_outside A
  implies f|B = g|B;

reserve A,B,I for set, X,Y for ManySortedSet of I;

theorem 
 I c= A \/ B & X|B = Y|B implies X,Y equal_outside A;

theorem 
 B c= I & A misses B & X,Y equal_outside A implies X|B = Y|B;

registration let V be non empty set;
 let f be V-valued Function, x be set, y be Element of V;
 cluster f+*(x,y) -> V-valued;
end;

theorem 
 f c= g & not x in dom f implies f c= g+*(x,y);

theorem 
 for I being non empty set, X being ManySortedSet of I,
     l1,l2 being Element of I, i1,i2 being set
 holds X +*((l1,l2) --> (i1, i2)) = X +* (l1,i1) +* (l2,i2);















begin

reserve x,y,z for set;
reserve n,m,k for Element of NAT;
reserve r for Real;

theorem 
  for n ex m st n = 2*m or n = 2*m+1;

theorem 
  for n ex m st n = 3*m or n = 3*m+1 or n = 3*m+2;

theorem 
  for n ex m st n = 4*m or n = 4*m+1 or n = 4*m+2 or n = 4*m+3;

theorem 
  for n ex m st n = 5*m or n = 5*m+1 or n = 5*m+2 or n = 5*m+3 or n = 5*m+4;

scheme 

  ExRealSubseq{s()->Real_Sequence,P[set]}: ex q being Real_Sequence st q is
subsequence of s() & (for n holds P[q.n]) & for n st (for r st r = s().n holds
  P[r]) ex m st s().n = q.m
provided
 for n ex m st n <= m & P[s().m];

scheme 

  ExRealSeq2{F,G(set)->Real}: ex s being Real_Sequence st for n holds s.(2*n)
  = F(n) & s.(2*n+1) = G(n);

scheme 

  ExRealSeq3{F,G,H(set)->Real}: ex s being Real_Sequence st for n holds s.(3*n
  ) = F(n) & s.(3*n+1) = G(n) & s.(3*n+2) = H(n);

scheme 

  ExRealSeq4{F,G,H,I(set)->Real}: ex s being Real_Sequence st for n holds s.(4
  *n) = F(n) & s.(4*n+1) = G(n) & s.(4*n+2) = H(n) & s.(4*n+3) = I(n);

scheme 

  ExRealSeq5{F,G,H,I,J(set)->Real}: ex s being Real_Sequence st for n holds s.
(5*n) = F(n) & s.(5*n+1) = G(n) & s.(5*n+2) = H(n) & s.(5*n+3) = I(n) & s.(5*n+
  4) = J(n);

scheme 

  PartFuncExD2{C, D()->non empty set, P,Q[set], F,G(set)->Element of D()}: ex
f being PartFunc of C(),D() st (for c be Element of C() holds c in dom f iff P[
c] or Q[c]) & for c be Element of C() st c in dom f holds (P[c] implies f.c = F
  (c)) & (Q[c] implies f.c = G(c))
provided
 for c be Element of C() st P[c] holds not Q[c];

scheme 

  PartFuncExD29{C, D()->non empty set,P,Q[set], F,G(set)->Element of D()}: ex
f being PartFunc of C(),D() st (for c be Element of C() holds c in dom f iff P[
c] or Q[c]) & for c be Element of C() st c in dom f holds (P[c] implies f.c = F
  (c)) & (Q[c] implies f.c = G(c))
provided
 for c be Element of C() st P[c] & Q[c] holds F(c)=G(c);

scheme 

  PartFuncExD299{C, D()->non empty set,P[set], F,G(set)->Element of D()}: ex f
being PartFunc of C(),D() st f is total & for c be Element of C() st c in dom f
  holds (P[c] implies f.c = F(c)) & (not P[c] implies f.c = G(c));

scheme 

  PartFuncExD3{C, D()->non empty set,P,Q,R[set], F,G,H(set)->Element of D()}:
ex f being PartFunc of C(),D() st (for c be Element of C() holds c in dom f iff
  P[c] or Q[c] or R[c]) & for c be Element of C() st c in dom f holds (P[c]
  implies f.c = F(c)) & (Q[c] implies f.c = G(c)) & (R[c] implies f.c = H(c))
provided
 for c be Element of C() holds (P[c] implies not Q[c]) & (P[c]
implies not R[c]) & (Q[c] implies not R[c]);

scheme 

  PartFuncExD39{C, D()->non empty set,P,Q,R[set], F,G,H(set)->Element of D()}:
ex f being PartFunc of C(),D() st (for c be Element of C() holds c in dom f iff
  P[c] or Q[c] or R[c]) & for c be Element of C() st c in dom f holds (P[c]
  implies f.c = F(c)) & (Q[c] implies f.c = G(c)) & (R[c] implies f.c = H(c))
provided
 for c be Element of C() holds (P[c] & Q[c] implies F(c)=G(c)) & (P[c
] & R[c] implies F(c)=H(c)) & (Q[c] & R[c] implies G(c)=H(c));

scheme 

  PartFuncExD4{C, D()->non empty set,P,Q,R,S[set], F,G,H,I(set)->Element of D(
)}: ex f being PartFunc of C(),D() st (for c be Element of C() holds c in dom f
iff P[c] or Q[c] or R[c] or S[c]) & for c be Element of C() st c in dom f holds
(P[c] implies f.c = F(c)) & (Q[c] implies f.c = G(c)) & (R[c] implies f.c = H(c
  )) & (S[c] implies f.c = I(c))
provided
 for c be Element of C() holds (P[c] implies not Q[c]) & (P[c]
implies not R[c]) & (P[c] implies not S[c]) & (Q[c] implies not R[c]) & (Q[c]
implies not S[c]) & (R[c] implies not S[c]);

scheme 

  PartFuncExS2{X, Y()->set,P,Q[set],F,G(set)->set}: ex f being PartFunc of X()
,Y() st (for x holds x in dom f iff x in X() & (P[x] or Q[x])) & for x st x in
  dom f holds (P[x] implies f.x=F(x)) & (Q[x] implies f.x=G(x))
provided
 for x st x in X() holds P[x] implies not Q[x] and
 for x st x in X() & P[x] holds F(x) in Y() and
 for x st x in X() & Q[x] holds G(x) in Y();

scheme 

  PartFuncExS3{X, Y()->set,P,Q,R[set], F,G,H(set)->set}: ex f being PartFunc
of X(),Y() st (for x holds x in dom f iff x in X() & (P[x] or Q[x] or R[x])) &
for x st x in dom f holds (P[x] implies f.x=F(x)) & (Q[x] implies f.x=G(x)) & (
  R[x] implies f.x=H(x))
provided
 for x st x in X() holds (P[x] implies not Q[x]) & (P[x] implies not
R[x]) & (Q[x] implies not R[x]) and
 for x st x in X() & P[x] holds F(x) in Y() and
 for x st x in X() & Q[x] holds G(x) in Y() and
 for x st x in X() & R[x] holds H(x) in Y();

scheme 

  PartFuncExS4{X, Y()->set,P,Q,R,S[set], F,G,H,I(set)->set}: ex f being
PartFunc of X(),Y() st (for x holds x in dom f iff x in X() & (P[x] or Q[x] or
  R[x] or S[x])) & for x st x in dom f holds (P[x] implies f.x=F(x)) & (Q[x]
  implies f.x=G(x)) & (R[x] implies f.x=H(x)) & (S[x] implies f.x=I(x))
provided
 for x st x in X() holds (P[x] implies not Q[x]) & (P[x] implies not
R[x]) & (P[x] implies not S[x]) & (Q[x] implies not R[x]) & (Q[x] implies not S
[x]) & (R[x] implies not S[x]) and
 for x st x in X() & P[x] holds F(x) in Y() and
 for x st x in X() & Q[x] holds G(x) in Y() and
 for x st x in X() & R[x] holds H(x) in Y() and
 for x st x in X() & S[x] holds I(x) in Y();

scheme 

  PartFuncExCD2{C, D, E()->non empty set, P,Q[set,set], F,G(set,set)->Element
of E()}: ex f being PartFunc of [:C(),D():],E() st (for c be Element of C() ,d
be Element of D() holds [c,d] in dom f iff P[c,d] or Q[c,d]) & for c be Element
of C() ,d be Element of D() st [c,d] in dom f holds (P[c,d] implies f.[c,d]=F(c
  ,d)) & (Q[c,d] implies f.[c,d]=G(c,d))
provided
 for c be Element of C() ,d be Element of D() st P[c,d] holds not Q[c ,d];

scheme 

  PartFuncExCD3{C, D, E()->non empty set, P,Q,R[set,set], F,G,H(set,set)->
Element of E()}: ex f being PartFunc of [:C(),D():],E() st (for c be Element of
C() ,d be Element of D() holds [c,d] in dom f iff P[c,d] or Q[c,d] or R[c,d]) &
  for c be Element of C() ,r be Element of D() st [c,r] in dom f holds (P[c,r]
implies f.[c,r]=F(c,r)) & (Q[c,r] implies f.[c,r]=G(c,r)) & (R[c,r] implies f.[
  c,r]=H(c,r))
provided
 for c be Element of C() ,s be Element of D() holds (P[c,s] implies
not Q[c,s]) & (P[c,s] implies not R[c,s]) & (Q[c,s] implies not R[c,s]);

scheme 

  PartFuncExCS2{X, Y, Z()->set,P,Q[set,set], F,G(set,set)->set}: ex f being
  PartFunc of [:X(),Y():],Z() st (for x,y holds [x,y] in dom f iff x in X() & y
in Y() & (P[x,y] or Q[x,y])) & for x,y st [x,y] in dom f holds (P[x,y] implies
  f.[x,y]=F(x,y)) & (Q[x,y] implies f.[x,y]=G(x,y))
provided
 for x,y st x in X() & y in Y() holds P[x,y] implies not Q[x,y] and
 for x,y st x in X() & y in Y() & P[x,y] holds F(x,y) in Z() and
 for x,y st x in X() & y in Y() & Q[x,y] holds G(x,y) in Z();

scheme 

  PartFuncExCS3{X, Y, Z()->set, P,Q,R[set,set], F,G,H(set,set)->set}: ex f
being PartFunc of [:X(),Y():],Z() st (for x,y holds [x,y] in dom f iff x in X()
& y in Y() & (P[x,y] or Q[x,y] or R[x,y])) & for x,y st [x,y] in dom f holds (P
  [x,y] implies f.[x,y]=F(x,y)) & (Q[x,y] implies f.[x,y]=G(x,y)) & (R[x,y]
  implies f.[x,y]=H(x,y))
provided
 for x,y st x in X() & y in Y() holds (P[x,y] implies not Q[x,y]) & (
P[x,y] implies not R[x,y]) & (Q[x,y] implies not R[x,y]) and
 for x,y st x in X() & y in Y() holds P[x,y] implies F(x,y) in Z() and
 for x,y st x in X() & y in Y() holds Q[x,y] implies G(x,y) in Z() and
 for x,y st x in X() & y in Y() holds R[x,y] implies H(x,y) in Z();

scheme 

  ExFuncD3{C, D()->non empty set,P,Q,R[set], F,G,H(set)->Element of D()}: ex f
being Function of C(),D() st for c be Element of C() holds (P[c] implies f.c =
  F(c)) & (Q[c] implies f.c = G(c)) & (R[c] implies f.c = H(c))
provided
 for c be Element of C() holds (P[c] implies not Q[c]) & (P[c]
implies not R[c]) & (Q[c] implies not R[c]) and
 for c be Element of C() holds P[c] or Q[c] or R[c];

scheme 

  ExFuncD4{C, D()->non empty set, P,Q,R,S[set], F,G,H,I(set)->Element of D()}:
ex f being Function of C(),D() st for c be Element of C() holds (P[c] implies f
  .c = F(c)) & (Q[c] implies f.c = G(c)) & (R[c] implies f.c = H(c)) & (S[c]
  implies f.c = I(c))
provided
 for c be Element of C() holds (P[c] implies not Q[c]) & (P[c]
implies not R[c]) & (P[c] implies not S[c]) & (Q[c] implies not R[c]) & (Q[c]
implies not S[c]) & (R[c] implies not S[c]) and
 for c be Element of C() holds P[c] or Q[c] or R[c] or S[c];

scheme 

  FuncExCD2{C, D, E()->non empty set,P[set,set], F,G(set,set)->Element of E()}
  : ex f being Function of [:C(),D():],E() st for c be Element of C() ,d be
Element of D() st [c,d] in dom f holds (P[c,d] implies f.[c,d]=F(c,d)) & (not P
  [c,d] implies f.[c,d]=G(c,d));

scheme 

  FuncExCD3{C, D, E()->non empty set, P,Q,R[set,set], F,G,H(set,set)->Element
of E()}: ex f being Function of [:C(),D():],E() st (for c be Element of C() ,d
be Element of D() holds [c,d] in dom f iff P[c,d] or Q[c,d] or R[c,d]) & for c
be Element of C() ,d be Element of D() st [c,d] in dom f holds (P[c,d] implies
f.[c,d]=F(c,d)) & (Q[c,d] implies f.[c,d]=G(c,d)) & (R[c,d] implies f.[c,d]=H(c
  ,d))
provided
 for c be Element of C() ,d be Element of D() holds (P[c,d] implies
not Q[c,d]) & (P[c,d] implies not R[c,d]) & (Q[c,d] implies not R[c,d]) and
 for c be Element of C() ,d be Element of D() holds P[c,d] or Q[c,d]
or R[c,d];














begin

reserve x, y, z, E, E1, E2, E3 for set,
  sE for Subset-Family of E,
  f for Function of E, E,
  k, l, m, n for Element of NAT;

definition
  let i be Integer;
  attr i is even means


  2 divides i;
end;

notation
  let i be Integer;
  antonym i is odd for i is even;
end;

definition
  let n be Element of NAT;
  redefine attr n is even means

  ex k st n = 2*k;
end;

registration
  cluster even for Element of NAT;
  cluster odd for Element of NAT;
  cluster even for Integer;
  cluster odd for Integer;
end;

theorem 
  for i being Integer holds i is odd iff ex j being Integer st i = 2*j+1;

registration
  let i be Integer;
  cluster 2*i -> even;
end;

registration
  let i be even Integer;
  cluster i+1 -> odd;
end;

registration
  let i be odd Integer;
  cluster i+1 -> even;
end;

registration
  let i be even Integer;
  cluster i-1 -> odd;
end;

registration
  let i be odd Integer;
  cluster i-1 -> even;
end;

registration
  let i be even Integer, j be Integer;
  cluster i*j -> even;
  cluster j*i -> even;
end;

registration
  let i, j be odd Integer;
  cluster i*j -> odd;
end;

registration
  let i, j be even Integer;
  cluster i+j -> even;
end;

registration
  let i be even Integer, j be odd Integer;
  cluster i+j -> odd;
  cluster j+i -> odd;
end;

registration
  let i, j be odd Integer;
  cluster i+j -> even;
end;

registration
  let i be even Integer, j be odd Integer;
  cluster i-j -> odd;
  cluster j-i -> odd;
end;

registration
  let i, j be odd Integer;
  cluster i-j -> even;
end;

registration
  let m be even Integer;
  cluster m + 2 -> even;
end;

registration
  let m be odd Integer;
  cluster m + 2 -> odd;
end;

definition
  let E, f, n;
  redefine func iter(f, n) -> Function of E, E;
end;

theorem 
  for S being non empty Subset of NAT st 0 in S holds min S = 0;

theorem 
  for E being non empty set, f being Function of E, E, x being
  Element of E holds iter(f,0).x = x;



definition
  let x be set, f be Function;
  pred x is_a_fixpoint_of f means


  x in dom f & x = f.x;
end;

definition
  let A be non empty set, a be Element of A, f be Function of A, A;
  redefine pred a is_a_fixpoint_of f means


  a = f.a;
end;

definition
  let f be Function;
  attr f is with_fixpoint means


  ex x st x is_a_fixpoint_of f;
end;

notation
  let f be Function;
  antonym f is without_fixpoints for f is with_fixpoint;
end;

definition
  let X be set, x be Element of X;
  attr x is covering means


  union x = union union X;
end;

theorem 
  sE is covering iff union sE = E;

registration
  let E;
  cluster non empty finite covering for Subset-Family of E;
end;

theorem 
  for E being set, f being Function of E, E, sE being non empty covering
  Subset-Family of E st for X being Element of sE holds X misses f.:X holds
  f is without_fixpoints;

definition
  let E, f;
  func =_f -> Equivalence_Relation of E means


  for x, y st x in E & y in
  E holds [x,y] in it iff ex k, l st iter(f,k).x = iter(f,l).y;
end;

theorem 
  for E being non empty set, f being Function of E, E, c being
  Element of Class =_f, e being Element of c holds f.e in c;

theorem 
  for E being non empty set, f being Function of E, E, c being
  Element of Class =_f, e being Element of c, n holds iter(f, n).e in c;

registration
  cluster empty-membered -> trivial for set;
end;

registration
  let A be set, B be with_non-empty_element set;
  cluster non-empty for Function of A, B;
end;

registration
  let A be non empty set, B be with_non-empty_element set, f be non-empty
  Function of A, B, a be Element of A;
  cluster f.a -> non empty;
end;

registration
  let X be non empty set;
  cluster bool X -> with_non-empty_element;
end;

theorem 
  for E being non empty set, f being Function of E, E st f
  is without_fixpoints ex E1, E2, E3 st E1 \/ E2 \/ E3 = E &
  f.:E1 misses E1 & f.:E2 misses E2 & f.:E3 misses E3;

begin 


theorem 
  for n being Nat holds
  n is odd iff ex k being Element of NAT st n = 2*k+1;



theorem 
  for A being non empty set, f being Function of A,A, x being Element of
  A holds iter(f,n+1).x = f.(iter(f,n).x);

theorem 
  for i being Integer holds i is even iff ex j being Integer st i = 2*j;



registration
  cluster odd for Nat;
  cluster even for Nat;
end;

theorem 
  for n being odd Nat holds 1 <= n;

registration
 cluster odd -> non zero for Integer;
end;














begin

reserve x for set;
reserve a, b, c, d, e for real number;
reserve m, n, m1, m2 for Element of NAT;
reserve k, l for Integer;
reserve p for Rational;

theorem 
  n is even implies (-a) |^ n = a |^ n;

theorem 
  n is odd implies (-a) |^ n = - a |^ n;

theorem 
  a>=0 or n is even implies a |^ n >= 0;

definition
  let n be Nat;
  let a be real number;
  func n-root a -> real number equals


  n -Root a if a>=0 & n>=1,
  -n -Root (-a) if a<0 & n is odd;
end;

definition
  let n be Nat;
  let a be Real;
  redefine func n-root a -> Real;
end;

theorem 
  for n being Nat st n>=1 & a>=0 or n is odd holds
  (n-root a) |^ n = a & n-root (a |^ n) = a;

theorem 
  for n being Nat st n>=1 holds n-root 0 = 0;

theorem 
  n>=1 implies n-root 1 = 1;

theorem 
  a>=0 & n>=1 implies n-root a >= 0;

theorem 
  n is odd implies n-root (-1) = -1;

theorem 
  1-root a = a;

theorem 
  n is odd implies n-root a = - n-root (-a);

theorem 
  n>=1 & a>=0 & b>=0 or n is odd implies n-root (a*b) = n-root a * n-root b;

theorem 
  a>0 & n>=1 or a<>0 & n is odd implies n-root (1/a) = 1/(n-root a);

theorem 
  a>=0 & b>0 & n>=1 or b<>0 & n is odd implies
  n-root (a/b) = n-root a / n-root b;

theorem 
  a>=0 & n>=1 & m>=1 or n is odd & m is odd implies
  n-root (m-root a) = (n*m)-root a;

theorem 
  a>=0 & n>=1 & m>=1 or n is odd & m is odd implies
  n-root a * m-root a = (n*m)-root (a |^ (n+m));

theorem 
  a<=b & (0<=a & n>=1 or n is odd) implies n-root a <= n-root b;

theorem 
  a<b & (a>=0 & n>=1 or n is odd) implies n-root a < n-root b;

theorem 
  a>=1 & n>=1 implies n-root a >= 1 & a >= n-root a;

theorem 
  a<=-1 & n is odd implies n-root a <= -1 & a <= n-root a;

theorem 
  a>=0 & a<1 & n>=1 implies a <= n-root a & n-root a < 1;

theorem 
  a>-1 & a<=0 & n is odd implies a >= n-root a & n-root a > -1;

theorem 
  a>0 & n>=1 implies n-root a - 1 <= (a-1)/n;

theorem 
  for s being Real_Sequence, a st a > 0 & (for n st n>=1 holds s.n = n-root a)
  holds s is convergent & lim s = 1;

definition
  let a,b be real number;
  func a to_power b -> real number means


  it = a #R b if a > 0, it = 0 if a = 0 & b > 0,
  ex k st k = b & it = a #Z k if b is Integer;
end;

definition
  let a,b be Real;
  redefine func a to_power b -> Real;
end;

theorem 
  a to_power 0 = 1;

theorem 
  a to_power 1 = a;

theorem 
  1 to_power a = 1;

theorem 
  a > 0 implies a to_power (b+c) = a to_power b * a to_power c;

theorem 
  a > 0 implies a to_power (-c) = 1 / a to_power c;

theorem 
  a > 0 implies a to_power (b-c) = a to_power b / a to_power c;

theorem 
  a>0 & b>0 implies (a*b) to_power c = a to_power c*b to_power c;

theorem 
  a>0 & b>0 implies (a/b) to_power c = a to_power c/b to_power c;

theorem 
  a>0 implies (1/a) to_power b = a to_power (-b);

theorem 
  a > 0 implies a to_power b to_power c = a to_power (b * c);

theorem 
  a > 0 implies a to_power b > 0;

theorem 
  a > 1 & b > 0 implies a to_power b > 1;

theorem 
  a > 1 & b < 0 implies a to_power b < 1;

theorem 
  a > 0 & a < b & c > 0 implies a to_power c < b to_power c;

theorem 
  a > 0 & a < b & c < 0 implies a to_power c > b to_power c;

theorem 
  a < b & c > 1 implies c to_power a < c to_power b;

theorem 
  a < b & c > 0 & c < 1 implies c to_power a > c to_power b;

registration
  let a be real number, n be Nat;
  identify a to_power n with a |^ n;
end;

theorem 
  for n be Nat holds a to_power n = a |^ n;

theorem 
 k <> 0 implies 0 to_power k = 0;

theorem 
  a to_power k = a #Z k;

theorem 
  a>0 implies a to_power p = a #Q p;

theorem 
  a>=0 & n>=1 implies a to_power (1/n) = n-root a;

theorem 
  a to_power 2 = a^2;

theorem 
  k is even implies (-a) to_power k = a to_power k;

theorem 
  k is odd implies (-a) to_power k = -(a to_power k);

theorem 
  -1 < a implies (1 + a) to_power n >= 1 + n * a;

theorem 
  a>0 & a<>1 & c <>d implies a to_power c <> a to_power d;

definition
  let a,b be real number;
  assume that
 a>0 and
 a<>1 and
 b>0;
  func log(a,b) -> real number means


  a to_power it = b;
end;

definition
  let a,b be Real;
  redefine func log(a,b) -> Real;
end;

theorem 
  a>0 & a<>1 implies log(a,1) = 0;

theorem 
  a>0 & a<>1 implies log(a,a) = 1;

theorem 
  a>0 & a<>1 & b>0 & c>0 implies log(a,b) + log(a,c) = log(a,b*c);

theorem 
  a>0 & a<>1 & b>0 & c>0 implies log(a,b) - log(a,c) = log(a,b/c);

theorem 
  a>0 & a<>1 & b>0 implies log(a,b to_power c) = c * log(a,b);

theorem 
  a>0 & a<>1 & b>0 & b<>1 & c>0 implies log(a,c) = log(a,b)*log(b,c);

theorem 
  a>1 & b>0 & c>b implies log(a,c) > log(a,b);

theorem 
  a>0 & a<1 & b>0 & c>b implies log(a,c) < log(a,b);

theorem 
  for s being Real_Sequence st for n holds s.n = (1 + 1/(n+1)) to_power (n+1 )
  holds s is convergent;

definition
  func number_e -> real number means

  for s being Real_Sequence st for n holds s.n = (1 + 1/(n+1)) to_power (n+1)
  holds it = lim s;
end;

definition
  redefine func number_e -> Real;
end;

theorem 
  2 to_power 2 = 4;

theorem 
  2 to_power 3 = 8;

theorem 
  2 to_power 4 = 16;

theorem 
  2 to_power 5 = 32;

theorem 
  2 to_power 6 = 64;















begin 

reserve a, a9, a1, a2, a3, b, b9, c, c9, d, d9, h, p, q, x, x1, x2, x3, u, v,
  y, z for real number;

definition
  let a, b, x be complex number;
  func Polynom (a,b,x) equals

  a*x+b;
end;

registration
  let a, b, x be complex number;
  cluster Polynom(a,b,x) -> complex;
end;

registration
  let a, b, x be real number;
  cluster Polynom(a,b,x) -> real;
end;

definition
  let a, b, x be Real;
  redefine func Polynom(a,b,x) -> Real;
end;

theorem 
  for a, b, x being complex number holds a <> 0 & Polynom(a,b,x) = 0
  implies x = -(b/a);

theorem 
  for x being complex number holds Polynom(0,0,x) = 0;

theorem 
  for b being complex number holds b <> 0 implies not ex x being complex
  number st Polynom(0,b,x) = 0;

definition
  let a,b,c,x be complex number;
  func Polynom(a,b,c,x) equals

  a*x^2+b*x+c;
end;

registration
  let a,b,c,x be real number;
  cluster Polynom(a,b,c,x) -> real;
end;

registration
  let a,b,c,x be complex number;
  cluster Polynom(a,b,c,x) -> complex;
end;

definition
  let a,b,c,x be Real;
  redefine func Polynom(a,b,c,x) -> Real;
end;

theorem 
  for a, b, c, a9, b9, c9 being complex number holds (for x being
  real number holds Polynom(a,b,c,x) = Polynom(a9,b9,c9,x)) implies a = a9& b =
  b9& c = c9;

theorem 
  a <> 0 & delta(a,b,c) >= 0 implies for x holds Polynom(a,b,c,x) =
0 implies x = (-b+sqrt delta(a,b,c))/(2*a) or x = (-b-sqrt delta(a,b,c))/(2*a);

theorem 
  for a, b, c, x being complex number holds a <> 0 & delta(a,b,c) = 0 &
  Polynom(a,b,c,x) = 0 implies x = -(b/(2*a));

theorem 
  delta(a,b,c) < 0 implies not ex x st Polynom(a,b,c,x) = 0;

theorem 
  for b, c being complex number holds b <> 0 & (for x being real number
  holds Polynom(0,b,c,x) = 0) implies x = -(c/b);

theorem 
  for x being complex number holds Polynom(0,0,0,x) = 0;

theorem 
  for c being complex number holds c <> 0 implies not ex x being complex
  number st Polynom(0,0,c,x) = 0;

definition
  let a,x,x1,x2 be complex number;
  func Quard(a,x1,x2,x) equals

  a*((x-x1)*(x-x2));
end;

registration
  let a,x,x1,x2 be real number;
  cluster Quard(a,x1,x2,x) -> real;
end;

definition
  let a,x,x1,x2 be Real;
  redefine func Quard(a,x1,x2,x) -> Real;
end;

theorem 
  for a, b, c being complex number holds a <> 0 & (for x being real
number holds Polynom(a,b,c,x) = Quard(a,x1,x2,x)) implies b/a = -(x1+x2) & c/a
  = x1*x2;

begin 

definition
  let a,b,c,d,x be complex number;
  func Polynom(a,b,c,d,x) equals

  a*(x |^ 3)+ b*x^2 +c*x +d;
end;

registration
  let a,b,c,d,x be complex number;
  cluster Polynom(a,b,c,d,x) -> complex;
end;

registration
  let a,b,c,d,x be real number;
  cluster Polynom(a,b,c,d,x) -> real;
end;

definition
  let a,b,c,d,x be Real;
  redefine func Polynom(a,b,c,d,x) -> Real;
end;

theorem 
  (for x holds Polynom(a,b,c,d,x) = Polynom(a9,b9,c9,d9,x))
  implies a = a9 & b = b9 & c = c9 & d = d9;

definition
  let a,x,x1,x2,x3 be real number;
  func Tri(a,x1,x2,x3,x) equals

  a*((x-x1)*(x-x2)*(x-x3));
end;

registration
  let a,x,x1,x2,x3 be real number;
  cluster Tri(a,x1,x2,x3,x) -> real;
end;

definition
  let a,x,x1,x2,x3 be Real;
  redefine func Tri(a,x1,x2,x3,x) -> Real;
end;

theorem 
  a <> 0 & (for x holds Polynom(a,b,c,d,x) = Tri(a,x1,x2,x3,x)) implies
  b/a = -(x1+x2+x3) & c/a = x1*x2 +x2*x3 +x1*x3 & d/a = -x1*x2*x3;

theorem 
  (y+h) |^ 3 = y |^ 3+((3*h)*y^2+(3*h^2)*y)+h |^ 3;

theorem 
  a <> 0 & Polynom(a,b,c,d,x) = 0 implies for a1,a2,a3,h,y st y =
(x+b/(3*a)) & h = -b/(3*a) & a1 = b/a & a2 = c/a & a3 = d/a holds y |^ 3 + ((3*
  h+a1)*y^2+(3*h^2+2*(a1*h)+a2)*y) + ((h |^ 3+a1*h^2)+(a2*h+a3)) = 0;

theorem 
  a <> 0 & Polynom(a,b,c,d,x) = 0 implies for a1,a2,a3,h,y st y = (x+b/(
3*a)) & h = -b/(3*a) & a1 = b/a & a2 = c/a & a3 = d/a holds y |^ 3 + 0*y^2 + ((
  3*a*c-b^2)/(3*a^2))*y + (2*((b/(3*a)) |^ 3)+(3*a*d-b*c)/(3*a^2)) = 0;

theorem 
  (y |^ 3)+0*y^2+((3*a*c-b^2)/(3*a^2))*y + (2*((b/(3*a)) |^ 3)+(3*a*d-b*
  c)/(3*a^2)) = 0 implies for p,q st p = (3*a*c-b^2)/(3*a^2) & q = 2*((b/(3*a))
  |^ 3)+(3*a*d-b*c)/(3*a^2) holds Polynom(1,0,p,q,y) = 0;

theorem 
  Polynom(1,0,p,q,y) = 0 implies for u,v st y = u+v & 3*v*u+p = 0
  holds u |^ 3 + v |^ 3 = -q & (u |^ 3)*(v |^ 3) = (-p/3) |^ 3;

theorem 
  Polynom(1,0,p,q,y) = 0 implies for u,v st y = u+v & 3*v*u+p = 0
holds y = 3-root(-q/2+sqrt(q^2/4+(p/3) |^ 3)) + 3-root(-q/2-sqrt(q^2/4+(p/3) |^
  3)) or y = 3-root(-q/2+sqrt(q^2/4+(p/3) |^ 3)) + 3-root(-q/2+sqrt(q^2/4+(p/3)
|^ 3)) or y = 3-root(-q/2-sqrt(q^2/4+(p/3) |^ 3)) + 3-root(-q/2-sqrt(q^2/4+(p/3
  ) |^ 3));

theorem 
  b <> 0 & delta(b,c,d) > 0 & Polynom(0,b,c,d,x) = 0 implies x = (-c+
  sqrt delta(b,c,d))/(2*b) or x = (-c-sqrt delta(b,c,d))/(2*b);

theorem 
  a <> 0 & p = c/a & q = d/a & Polynom(a,0,c,d,x) = 0 implies for u,v st
x = u+v & 3*v*u+p = 0 holds x = 3-root(-d/(2*a)+sqrt((d^2/(4*a^2))+(c/(3*a)) |^
3)) +3-root(-d/(2*a)-sqrt((d^2/(4*a^2))+(c/(3*a)) |^ 3)) or x = 3-root(-d/(2*a)
+sqrt((d^2/(4*a^2))+(c/(3*a)) |^ 3)) +3-root(-d/(2*a)+sqrt((d^2/(4*a^2))+(c/(3*
a)) |^ 3)) or x = 3-root(-d/(2*a)-sqrt((d^2/(4*a^2))+(c/(3*a)) |^ 3)) +3-root(-
  d/(2*a)-sqrt((d^2/(4*a^2))+(c/(3*a)) |^ 3));

theorem 
  a <> 0 & delta(a,b,c) >= 0 & Polynom(a,b,c,0,x) = 0 implies x = 0 or x
  = (-b+sqrt delta(a,b,c))/(2*a) or x = (-b-sqrt delta(a,b,c))/(2*a);

theorem 
  a <> 0 & c/a < 0 & Polynom(a,0,c,0,x) = 0 implies x = 0 or x = sqrt -c
  /a or x = -sqrt(-c/a);














begin

reserve n,m,k for Element of NAT;
reserve a,p,r for real number;
reserve s,s1,s2,s3 for Real_Sequence;

theorem 
  0<a & a<1 & (for n holds s.n=a to_power (n+1)) implies
  s is convergent & lim s = 0;

theorem 
  for n being Nat holds abs(a) to_power n = abs(a to_power n);

theorem 
  abs(a)<1 & (for n holds s.n=a to_power (n+1)) implies s is
  convergent & lim s = 0;

definition
  let X be non empty add-closed complex-membered set;
  let s1, s2 be sequence of X;
  redefine func s1+s2 -> sequence of X;
end;

definition
  let s be complex-valued ManySortedSet of NAT;
  func Partial_Sums(s) -> complex-valued ManySortedSet of NAT means


  it.0 = s.0 & for n holds it.(n+1) = it.n + s.(n+1);
end;

registration
  let s be real-valued ManySortedSet of NAT;
 cluster Partial_Sums s -> real-valued;
end;

definition
  let s be Real_Sequence;
  redefine func Partial_Sums s -> Real_Sequence;
end;

definition
  let s;
  attr s is summable means


  Partial_Sums(s) is convergent;
  func Sum(s) -> Real equals

  lim Partial_Sums(s);
end;

theorem 
  s is summable implies s is convergent & lim s = 0;

theorem 
  for X being non empty add-closed complex-membered set
  for s1,s2 being sequence of X holds
  Partial_Sums(s1) + Partial_Sums(s2) = Partial_Sums(s1+s2);

theorem 
  Partial_Sums(s1) - Partial_Sums(s2) = Partial_Sums(s1-s2);

theorem 
  s1 is summable & s2 is summable implies s1+s2 is summable &
  Sum(s1+s2) = Sum(s1) + Sum(s2);

theorem 
  s1 is summable & s2 is summable implies s1-s2 is summable & Sum(s1-s2)
  = Sum(s1) - Sum(s2);

theorem 
  Partial_Sums(r(#)s) = r(#)Partial_Sums(s);

theorem 
  s is summable implies r(#)s is summable & Sum(r(#)s) =r*Sum(s);

theorem 
  for s,s1 st for n holds s1.n=s.0 holds Partial_Sums(s^\1) = (
  Partial_Sums(s)^\1) - s1;

theorem 
  s is summable implies for n holds s^\n is summable;

theorem 
  (ex n st s^\n is summable) implies s is summable;

theorem 
  (for n holds s1.n<=s2.n) implies for n holds Partial_Sums(s1).n
  <=Partial_Sums(s2).n;

theorem 
  s is summable implies
   for n holds Sum(s) = Partial_Sums(s).n + Sum(s^\(n+1));

theorem 
  (for n holds 0<=s.n) implies Partial_Sums(s) is non-decreasing;

theorem 
  (for n holds 0<=s.n) implies (Partial_Sums(s) is bounded_above
  iff s is summable);

theorem 
  s is summable & (for n holds 0<=s.n) implies 0<=Sum(s);

theorem 
  (for n holds 0<=s2.n) & s1 is summable & (ex m st for n st m<=n
  holds s2.n<=s1.n) implies s2 is summable;

theorem 
  (for n holds 0<=s1.n & s1.n<=s2.n) & s2 is summable implies s1 is
  summable & Sum(s1)<=Sum(s2);

theorem 
  s is summable iff for r st 0<r ex n st for m st n<=m holds abs(
  Partial_Sums(s).m - Partial_Sums(s).n)<r;


theorem 
  a <> 1 implies Partial_Sums(a GeoSeq).n = (1 - a to_power (n+1)) /(1-a);

theorem 
  a <> 1 & (for n holds s.(n+1) = a * s.n) implies for n holds
  Partial_Sums(s).n = s.0 * (1 - a to_power (n+1))/(1-a);

theorem 
  abs(a)<1 implies a GeoSeq is summable & Sum(a GeoSeq) = 1/(1-a);

theorem 
  abs(a) < 1 & (for n holds s.(n+1) = a * s.n) implies s is summable &
  Sum(s) = s.0/(1-a);

theorem 
  (for n holds s.n>0 & s1.n=s.(n+1)/s.n) & s1 is convergent & lim
  s1 < 1 implies s is summable;

theorem 
  (for n holds s.n>0) & (ex m st for n st n>=m holds s.(n+1)/s.n >= 1)
  implies s is not summable;

theorem 
  (for n holds s.n>=0 & s1.n = n-root (s.n)) & s1 is convergent &
  lim s1 < 1 implies s is summable;

theorem 
  (for n holds s.n>=0 & s1.n = n-root (s.n)) & (ex m st for n st m
  <=n holds s1.n>=1) implies s is not summable;

theorem 
  (for n holds s.n>=0 & s1.n = n-root (s.n)) & s1 is convergent & lim s1
  > 1 implies s is not summable;

registration
  let k, n be Nat;
  cluster k to_power n -> natural;
end;

definition
  let k, n be Nat;
  redefine func k to_power n -> Element of NAT;
end;

theorem 
  s is non-increasing & (for n holds s.n>=0 & s1.n = 2 to_power n
  * s.(2 to_power n)) implies (s is summable iff s1 is summable);

theorem 
  p>1 & (for n st n>=1 holds s.n = 1/n to_power p) implies s is summable;


theorem 
  p<=1 & (for n st n>=1 holds s.n=1/n to_power p) implies s is not summable;

definition
  let s;
  attr s is absolutely_summable means

 abs s is summable;
end;

theorem 
  for n,m st n<=m holds abs(Partial_Sums(s).m - Partial_Sums(s).n)
  <= abs(Partial_Sums(abs(s)).m - Partial_Sums(abs(s)).n);

registration
 cluster absolutely_summable -> summable for Real_Sequence;
end;

theorem 
  s is absolutely_summable implies s is summable;

theorem 
  (for n holds 0<=s.n) & s is summable implies s is absolutely_summable;

theorem 
  (for n holds s.n<>0 & s1.n=abs(s).(n+1)/abs(s).n) & s1 is convergent &
  lim s1 < 1 implies s is absolutely_summable;

theorem 
  r>0 & (ex m st for n st n>=m holds abs(s.n)>=r) implies s is not
  convergent or lim s <> 0;

theorem 
  (for n holds s.n<>0) & (ex m st for n st n>=m holds abs(s).(n+1)/abs(s
  ).n >= 1) implies s is not summable;

theorem 
  (for n holds s1.n = n-root (abs(s).n)) & s1 is convergent & lim s1 < 1
  implies s is absolutely_summable;

theorem 
  (for n holds s1.n = n-root(abs(s).n)) & (ex m st for n st m<=n holds
  s1.n >= 1 ) implies s is not summable;

theorem 
  (for n holds s1.n = n-root (abs(s).n)) & s1 is convergent & lim s1 > 1
  implies s is not summable;

begin 


definition
  let s;
  let n be Nat;
  func Sum(s, n) -> Real equals

  Partial_Sums(s).n;
end;

definition
  let s;
  let n,m be Nat;
  func Sum(s, n, m) -> Real equals

  Sum(s, n) - Sum(s, m);
end;














begin  

reserve rseq, rseq1, rseq2 for Real_Sequence;
reserve seq, seq1, seq2 for Complex_Sequence;
reserve k, n, n1, n2, m for Element of NAT;
reserve p, r for Real;

theorem 
  n+1 <> 0c & (n+1)*<i> <> 0c;

theorem 
  (for n holds rseq.n = 0) implies for m holds (Partial_Sums abs( rseq)).m = 0;

theorem 
  (for n holds rseq.n = 0) implies rseq is absolutely_summable;

registration
  cluster summable -> convergent for Real_Sequence;
end;

registration
  cluster absolutely_summable -> summable for Real_Sequence;
end;

registration
  cluster absolutely_summable for Real_Sequence;
end;

theorem 
  rseq is convergent implies for p st 0<p ex n st for m,l be Element of
  NAT st n <= m & n <= l holds abs(rseq.m-rseq.l)<p;

theorem 
  (for n holds rseq.n <= p) implies for n, l be Element of NAT holds
  Partial_Sums(rseq).(n+l)-Partial_Sums(rseq).n <= p * l;

theorem 
  (for n holds rseq.n <= p) implies for n holds Partial_Sums(rseq).n <=
  p * (n+1);

theorem 
  (for n st n <= m holds rseq1.n <= p * rseq2.n) implies Partial_Sums(
  rseq1).m <= p * Partial_Sums(rseq2).m;

theorem 
  (for n st n <= m holds rseq1.n <= p * rseq2.n) implies for n holds for
  l be Element of NAT st n+l <= m holds Partial_Sums(rseq1).(n+l)-Partial_Sums(
  rseq1).n <= p * (Partial_Sums(rseq2).(n+l)-Partial_Sums(rseq2).n);

theorem 
  (for n holds 0 <= rseq.n) implies (for n, m st n <= m holds abs(
Partial_Sums(rseq).m-Partial_Sums(rseq).n) =Partial_Sums(rseq).m-Partial_Sums(
  rseq).n) & for n holds abs(Partial_Sums(rseq).n)=Partial_Sums(rseq).n;

theorem 
  seq1 is convergent & seq2 is convergent & lim(seq1-seq2)=0c implies
  lim seq1 = lim seq2;

begin 

reserve z for Element of COMPLEX;
reserve Nseq,Nseq1 for increasing sequence of NAT;

definition
  let z be complex number;
  func z GeoSeq -> Complex_Sequence means


  it.0 = 1r & for n holds it.(n+1) = it.n * z;
end;

notation
  let z be complex number, n be natural number;
  synonym z #N n for z|^n;
end;

definition
  let z be complex number, n be natural number;
  redefine func z #N n -> Element of COMPLEX equals

  z GeoSeq.n;
end;

theorem 
  z #N 0 = 1r;

definition
  let f be complex-valued Function;
  func Re f -> Function means


  dom it = dom f & for x be set st x in dom it holds it.x = Re(f.x);
  func Im f -> Function means


  dom it = dom f & for x be set st x in dom it holds it.x = Im(f.x);
end;

registration
  let f be complex-valued Function;
  cluster Re f -> real-valued;
  cluster Im f -> real-valued;
end;

definition
  let X be set, f be PartFunc of X,COMPLEX;
  redefine func Re f -> PartFunc of X,REAL;
  redefine func Im f -> PartFunc of X,REAL;
end;

definition
  let c be Complex_Sequence;
  redefine func Re c -> Real_Sequence means


  for n holds it.n = Re(c.n);
  redefine func Im c -> Real_Sequence means


  for n holds it.n = Im(c.n);
end;

theorem 
  |.z.| <= abs Re z + abs Im z;

theorem 
  abs Re z <= |.z.| & abs Im z <= |.z.|;

theorem 
  Re seq1=Re seq2 & Im seq1=Im seq2 implies seq1=seq2;

theorem 
  Re seq1 + Re seq2 = Re (seq1+seq2) & Im seq1 + Im seq2 = Im (
  seq1+seq2 qua Complex_Sequence);

theorem 
  -(Re seq) = Re (-seq) & -(Im seq) = Im -seq;

theorem 
  r*Re(z)=Re(r*z) & r*Im(z)=Im(r*z);

theorem 
  Re seq1-Re seq2=Re (seq1-seq2) & Im seq1-Im seq2=Im(seq1-seq2);

theorem 
  r(#)Re seq = Re (r (#) seq) & r(#)Im seq = Im (r (#) seq);

theorem 
  Re (z (#) seq) = Re z (#) Re seq - Im z (#) Im seq & Im (z (#) seq) =
  Re z (#) Im seq + Im z (#) Re seq;

theorem 
  Re (seq1 (#) seq2) = Re seq1(#)Re seq2-Im seq1(#)Im seq2 & Im (seq1
  (#) seq2) = Re seq1(#)Im seq2+Im seq1(#)Re seq2;

definition
  let Nseq be increasing sequence of NAT, seq be Complex_Sequence;
  redefine func seq * Nseq -> Complex_Sequence;
end;

theorem 
  Re (seq*Nseq)=(Re seq)*Nseq & Im (seq*Nseq)=(Im seq)*Nseq;

theorem 
  (Re seq)^\k =Re (seq^\k) & (Im seq)^\k =Im (seq^\k);

definition
  let s be Complex_Sequence;
  redefine func Partial_Sums s -> Complex_Sequence;
end;

definition
  let seq be Complex_Sequence;
  func Sum seq -> Element of COMPLEX equals

  lim Partial_Sums seq;
end;

theorem 
  (for n holds seq.n = 0c) implies for m holds (Partial_Sums seq). m = 0c;

theorem 
  (for n holds seq.n = 0c) implies for m holds (Partial_Sums |.seq .|).m = 0;

theorem 
  Partial_Sums Re seq = Re (Partial_Sums seq) & Partial_Sums Im
  seq = Im (Partial_Sums seq);

theorem 
  Partial_Sums(seq1)+Partial_Sums(seq2) = Partial_Sums(seq1+seq2);

theorem 
  Partial_Sums(seq1)-Partial_Sums(seq2) = Partial_Sums(seq1-seq2);

theorem 
  for z being complex number holds Partial_Sums(z (#) seq) = z (#)
  Partial_Sums(seq);

theorem 
  |.Partial_Sums(seq).k.| <= (Partial_Sums |.seq.|).k;

theorem 
  |.Partial_Sums(seq).m- Partial_Sums(seq).n.| <= abs(
  Partial_Sums(|.seq.|).m- Partial_Sums(|.seq.|).n );

theorem 
  Partial_Sums(Re seq)^\k =Re (Partial_Sums(seq)^\k) &
  Partial_Sums(Im seq)^\k =Im (Partial_Sums(seq)^\k);

theorem 
  (for n holds seq1.n=seq.0) implies Partial_Sums(seq^\1) = (
  Partial_Sums(seq)^\1) - seq1;

theorem 
  Partial_Sums |.seq.| is non-decreasing;

registration
  let seq be Complex_Sequence;
  cluster Partial_Sums |.seq.| -> non-decreasing for Real_Sequence;
end;

theorem 
  (for n st n <= m holds seq1.n = seq2.n) implies Partial_Sums(seq1).m =
  Partial_Sums(seq2).m;

theorem 
  1r <> z implies for n holds Partial_Sums(z GeoSeq).n = (1r - z
  #N (n+1))/(1r-z);

theorem 
  z <> 1r & (for n holds seq.(n+1) = z * seq.n) implies for n
  holds Partial_Sums(seq).n = seq.0 * ((1r - z #N (n+1))/(1r-z));

begin  

theorem 
  for a, b being Real_Sequence, c being Complex_Sequence st (for n
holds Re (c.n) = a.n & Im (c.n) = b.n) holds a is convergent & b is convergent
  iff c is convergent;

theorem 
  for a, b being convergent Real_Sequence, c being
  Complex_Sequence st (for n holds Re (c.n) = a.n & Im (c.n) = b.n) holds c is
  convergent & lim(c)= lim(a) + lim(b)*<i>;

theorem 
  for a, b being Real_Sequence, c being convergent
  Complex_Sequence st (for n holds Re (c.n) = a.n & Im (c.n) = b.n) holds a is
  convergent & b is convergent & lim a=Re lim c & lim b=Im lim c;

theorem 
  for c being convergent Complex_Sequence holds Re c is convergent
  & Im c is convergent & lim Re c = Re lim c & lim Im c = Im lim c;

registration
  let c be convergent Complex_Sequence;
  cluster Re c -> convergent for Real_Sequence;
  cluster Im c -> convergent for Real_Sequence;
end;

theorem 
  for c being Complex_Sequence st Re c is convergent & Im c is
convergent holds c is convergent & Re(lim(c))=lim(Re c) & Im (lim(c))=lim(Im c)
;

theorem 
  (0 < |.z.| & |.z.| < 1 & seq.0 = z & for n holds seq.(n+1) = seq
  .n * z) implies seq is convergent & lim(seq)=0c;

theorem 
  |.z.| < 1 & (for n holds seq.n=z #N (n+1)) implies seq is
  convergent & lim(seq)=0c;

theorem 
  r>0 & (ex m st for n st n>=m holds |.seq.n.| >= r) implies not |.seq.|
  is convergent or lim |.seq.| <> 0;

theorem 
  seq is convergent iff for p st 0<p ex n st for m st n <= m holds
  |.seq.m-seq.n.|<p;

theorem 
  seq is convergent implies for p st 0<p ex n st for m,l be Element of
  NAT st n <= m & n <= l holds |.seq.m-seq.l.|<p;

theorem 
  (for n holds |. seq.n .| <= rseq.n) & rseq is convergent & lim(rseq)=0
  implies seq is convergent & lim(seq)=0c;

begin 

theorem 
  seq is subsequence of seq1 implies Re seq is subsequence of Re seq1 &
  Im seq is subsequence of Im seq1;

theorem 
  seq is bounded implies ex seq1 st seq1 is subsequence of seq & seq1 is
  convergent;

definition

  let seq be Complex_Sequence;
  attr seq is summable means


  Partial_Sums seq is convergent;
end;

registration
  cluster summable for Complex_Sequence;
end;

registration
  let seq be summable Complex_Sequence;
  cluster Partial_Sums seq -> convergent for Complex_Sequence;
end;

definition
  let seq be Complex_Sequence;
  attr seq is absolutely_summable means


  |.seq.| is summable;
end;

theorem 
  (for n holds seq.n = 0c) implies seq is absolutely_summable;

registration
  cluster absolutely_summable for Complex_Sequence;
end;

registration
  let seq be absolutely_summable Complex_Sequence;
  cluster |.seq.| -> summable for Real_Sequence;
end;

theorem 
  seq is summable implies seq is convergent & lim seq = 0c;

registration
  cluster summable -> convergent for Complex_Sequence;
end;

theorem 
  seq is summable implies Re seq is summable & Im seq is summable
  & Sum(seq)= Sum(Re seq)+Sum(Im seq)*<i>;

registration
  let seq be summable Complex_Sequence;
  cluster Re seq -> summable for Real_Sequence;
  cluster Im seq -> summable for Real_Sequence;
end;

theorem 
  seq1 is summable & seq2 is summable implies seq1+seq2 is
  summable & Sum(seq1+seq2)= Sum(seq1)+Sum(seq2);

theorem 
  seq1 is summable & seq2 is summable implies seq1-seq2 is
  summable & Sum(seq1-seq2)= Sum(seq1)-Sum(seq2);

registration
  let seq1, seq2 be summable Complex_Sequence;
  cluster seq1 + seq2 -> summable for Complex_Sequence;
  cluster seq1 - seq2 -> summable for Complex_Sequence;
end;

theorem 
  seq is summable implies for z being complex number holds z (#)
  seq is summable & Sum(z (#) seq)= z * Sum(seq);

registration
  let z be Element of COMPLEX, seq be summable Complex_Sequence;
  cluster z (#) seq -> summable for Complex_Sequence;
end;

theorem 
  Re seq is summable & Im seq is summable implies seq is summable
  & Sum(seq)=Sum(Re seq)+Sum(Im seq)*<i>;

theorem 
  seq is summable implies for n holds seq^\n is summable;

registration
  let seq be summable Complex_Sequence, n be Element of NAT;
  cluster seq^\n -> summable for Complex_Sequence;
end;

theorem 
  (ex n st seq^\n is summable) implies seq is summable;

theorem 
  seq is summable implies for n holds Sum(seq) = Partial_Sums(seq).n +
  Sum(seq^\(n+1));

theorem 
  Partial_Sums |.seq.| is bounded_above iff seq is absolutely_summable;

registration
  let seq be absolutely_summable Complex_Sequence;
  cluster Partial_Sums |.seq.| -> bounded_above for Real_Sequence;
end;

theorem 
  seq is summable iff for p st 0<p holds ex n st for m st n <= m
  holds |.Partial_Sums(seq).m-Partial_Sums(seq).n.|<p;

theorem 
  seq is absolutely_summable implies seq is summable;

registration
  cluster absolutely_summable -> summable for Complex_Sequence;
end;

registration
  cluster absolutely_summable for Complex_Sequence;
end;

theorem 
  |.z.| < 1 implies z GeoSeq is summable & Sum(z GeoSeq) = 1r/(1r- z);

theorem 
  |.z.| < 1 & (for n holds seq.(n+1) = z * seq.n) implies seq is
  summable & Sum(seq) = seq.0/(1r-z);

theorem 
  rseq1 is summable & (ex m st for n st m<=n holds |.seq2.n.| <= rseq1.n
  ) implies seq2 is absolutely_summable;

theorem 
  (for n holds 0 <= |.seq1.|.n & |.seq1.|.n <= |.seq2.|.n) & seq2 is
  absolutely_summable implies seq1 is absolutely_summable & Sum |.seq1.| <= Sum
  |.seq2.|;

theorem 
  (for n holds |.seq.|.n>0) & (ex m st for n st n>=m holds |.seq.|.(n+1)
  /|.seq.|.n >= 1) implies not seq is absolutely_summable;

theorem 
  (for n holds rseq1.n = n-root (|.seq.|.n)) & rseq1 is convergent & lim
  rseq1 < 1 implies seq is absolutely_summable;

theorem 
  (for n holds rseq1.n = n-root (|.seq.|.n)) & (ex m st for n st m<=n
  holds rseq1.n>= 1) implies |.seq.| is not summable;

theorem 
  (for n holds rseq1.n = n-root (|.seq.|.n)) & rseq1 is convergent & lim
  rseq1 > 1 implies seq is not absolutely_summable;

theorem 
  |.seq .| is non-increasing & (for n holds rseq1.n = 2 to_power n * |.
seq.|.(2 to_power n)) implies (seq is absolutely_summable iff rseq1 is summable
  );

theorem 
  p>1 & (for n st n>=1 holds |.seq.|.n = 1/n to_power p) implies seq is
  absolutely_summable;

theorem 
  p<=1 & (for n st n>=1 holds |.seq.|.n=1/n to_power p) implies not seq
  is absolutely_summable;

theorem 
  (for n holds seq.n<>0c & rseq1.n=|.seq.|.(n+1)/|.seq.|.n) & rseq1 is
  convergent & lim rseq1 < 1 implies seq is absolutely_summable;

theorem 
  (for n holds seq.n<>0c) & (ex m st for n st n>=m holds |.seq.|.(n+1)/
  |.seq.|.n >= 1) implies seq is not absolutely_summable;














begin

reserve n,n1,m,m1,k for Element of NAT;
reserve x,X,X1 for set;
reserve g,g1,g2,t,x0,x1,x2 for Element of COMPLEX;
reserve s1,s2,q1,seq,seq1,seq2,seq3 for Complex_Sequence;
reserve Y for Subset of COMPLEX;
reserve f,f1,f2,h,h1,h2 for PartFunc of COMPLEX,COMPLEX;
reserve p,r,s for Real;
reserve Ns,Nseq for increasing sequence of NAT;





definition

  let f,x0;
  pred f is_continuous_in x0 means


  x0 in dom f & for s1 st rng s1 c=
dom f & s1 is convergent & lim s1 = x0 holds f/*s1 is convergent & f/.x0 = lim
  (f/*s1);
end;

theorem 
  seq1=seq2-seq3 iff for n holds seq1.n=seq2.n-seq3.n;

theorem 
  (seq1 + seq2)*Ns = (seq1*Ns) + (seq2*Ns) & (seq1 - seq2)*Ns = (
  seq1*Ns) - (seq2*Ns) & (seq1 (#) seq2)*Ns = (seq1*Ns) (#) (seq2*Ns);

theorem 
  (g(#)seq)*Ns = g(#)(seq*Ns);

theorem 
  (-seq)*Ns = -(seq*Ns) & (|.seq.|)*Ns = |.(seq*Ns).|;

theorem 
  (seq*Ns)" = (seq")*Ns;

theorem 
  (seq1/"seq)*Ns = (seq1*Ns)/"(seq*Ns);

theorem 
  rng seq c= dom h1 /\ dom h2 implies (h1+h2)/*seq=h1/*seq+h2/*seq
  & (h1-h2)/*seq=h1/*seq-h2/*seq & (h1(#)h2)/*seq=(h1/*seq)(#)(h2/*seq);

theorem 
  rng seq c= dom h implies (g(#)h)/*seq = g(#)(h/*seq);

theorem 
  rng seq c= dom h implies -(h/*seq) = (-h)/*seq;

theorem 
  rng seq c= dom (h^) implies h/*seq is non-zero;

theorem 
  rng seq c= dom (h^) implies (h^)/*seq =(h/*seq)";

theorem 
  rng seq c= dom h implies Re ( (h/*seq)*Ns ) = Re (h/*(seq*Ns));

theorem 
  rng seq c= dom h implies Im ( (h/*seq)*Ns ) = Im (h/*(seq*Ns));

theorem 
  h1 is total & h2 is total implies (h1+h2)/*seq = h1/*seq + h2/*seq & (
  h1-h2)/*seq = h1/*seq - h2/*seq & (h1(#)h2)/*seq = (h1/*seq) (#) (h2/*seq);

theorem 
  h is total implies (g(#)h)/*seq = g(#)(h/*seq);

theorem 
  rng seq c= dom (h|X) & h"{0}={} implies ((h^)|X)/*seq = ((h|X)/*seq)";

theorem 
  seq1 is subsequence of seq & seq is convergent implies seq1 is convergent;

theorem 
  seq1 is subsequence of seq & seq is convergent implies lim seq1= lim seq;

theorem 
  seq is convergent & (ex k st for n st k<=n holds seq1.n=seq.n)
  implies seq1 is convergent;

theorem 
  seq is convergent & (ex k st for n st k<=n holds seq1.n=seq.n) implies
  lim seq=lim seq1;

theorem 
  seq is convergent implies (seq ^\k) is convergent & lim (seq ^\k)=lim
  seq;

theorem 
  seq is convergent & (ex k st seq=seq1 ^\k) implies seq1 is convergent;

theorem 
  seq is convergent & (ex k st seq=seq1 ^\k) implies lim seq1 =lim seq;

theorem 
  seq is convergent & lim seq<>0 implies ex k st (seq ^\k) is non-zero;

theorem 
  seq is convergent & lim seq<>0 implies ex seq1 st seq1 is subsequence
  of seq & seq1 is non-zero;

theorem 
  seq is constant implies seq is convergent;

theorem 
  (seq is constant & g in rng seq or seq is constant & ex n st seq
  .n=g ) implies lim seq=g;

theorem 
  seq is constant implies for n holds lim seq=seq.n;

theorem 
  seq is convergent & lim seq<>0 implies for seq1 st seq1 is subsequence
  of seq & seq1 is non-zero holds lim (seq1")=(lim seq)";

theorem 
  seq is constant & seq1 is convergent implies lim (seq+seq1) =(seq.0) +
lim seq1 & lim (seq-seq1) =(seq.0) - lim seq1 & lim (seq1-seq) =(lim seq1) -seq
  .0 & lim (seq(#)seq1) =(seq.0) * (lim seq1);

scheme 

  CompSeqChoice { P[set,set] }: ex s1 st for n holds P[n,s1.n]
provided
 for n ex g st P[n,g];

begin

theorem 
  f is_continuous_in x0 iff x0 in dom f & for s1 st rng s1 c= dom f & s1
is convergent & lim s1=x0 & (for n holds s1.n<>x0) holds f/*s1 is convergent &
  f/.x0=lim(f/*s1);

theorem 
  f is_continuous_in x0 iff x0 in dom f & for r st 0<r ex s st 0<s
  & for x1 st x1 in dom f & |.x1-x0.|<s holds |.f/.x1-f/.x0.|<r;

theorem 
  f1 is_continuous_in x0 & f2 is_continuous_in x0 implies f1+f2
  is_continuous_in x0 & f1-f2 is_continuous_in x0 & f1(#)f2 is_continuous_in x0
;

theorem 
  f is_continuous_in x0 implies g(#)f is_continuous_in x0;

theorem 
  f is_continuous_in x0 implies -f is_continuous_in x0;

theorem 
  f is_continuous_in x0 & f/.x0<>0 implies f^ is_continuous_in x0;

theorem 
  f1 is_continuous_in x0 & f1/.x0<>0 & f2 is_continuous_in x0 implies f2
  /f1 is_continuous_in x0;

definition

  let f,X;
  pred f is_continuous_on X means


  X c= dom f & for x0 st x0 in X holds f|X is_continuous_in x0;
end;

theorem 
  for X,f holds f is_continuous_on X iff X c= dom f & for s1 st
  rng s1 c= X & s1 is convergent & lim s1 in X holds f/*s1 is convergent & f/.(
  lim s1) = lim (f/*s1);

theorem 
  f is_continuous_on X iff X c= dom f & for x0,r st x0 in X & 0<r
  ex s st 0<s & for x1 st x1 in X & |.x1-x0.| < s holds |.f/.x1 - f/.x0.| < r;

theorem 
  f is_continuous_on X iff f|X is_continuous_on X;

theorem 
  f is_continuous_on X & X1 c= X implies f is_continuous_on X1;

theorem 
  x0 in dom f implies f is_continuous_on {x0};

theorem 
  for X,f1,f2 st f1 is_continuous_on X & f2 is_continuous_on X
  holds f1+f2 is_continuous_on X & f1-f2 is_continuous_on X & f1(#) f2
  is_continuous_on X;

theorem 
  for X,X1,f1,f2 st f1 is_continuous_on X & f2 is_continuous_on X1 holds
  f1+f2 is_continuous_on X /\ X1 & f1-f2 is_continuous_on X /\ X1 & f1(#)f2
  is_continuous_on X /\ X1;

theorem 
  for g,X,f st f is_continuous_on X holds g(#)f is_continuous_on X;

theorem 
  f is_continuous_on X implies -f is_continuous_on X;

theorem 
  f is_continuous_on X & f"{0} = {} implies f^ is_continuous_on X;

theorem 
  f is_continuous_on X & (f|X)"{0} = {} implies f^ is_continuous_on X;

theorem 
  f1 is_continuous_on X & f1"{0} = {} & f2 is_continuous_on X implies f2
  /f1 is_continuous_on X;

theorem 
  f is total & (for x1,x2 holds f/.(x1+x2) = f/.x1 + f/.x2) & (ex x0 st
  f is_continuous_in x0) implies f is_continuous_on COMPLEX;

definition
  let X;
  attr X is compact means


  for s1 st (rng s1) c= X ex s2 st s2 is
  subsequence of s1 & s2 is convergent & (lim s2) in X;
end;

theorem 
  for f st dom f is compact & f is_continuous_on (dom f) holds (
  rng f) is compact;

theorem 
  Y c= dom f & Y is compact & f is_continuous_on Y implies (f.:Y) is compact;














begin

reserve k, k1, n, n1, m for Element of NAT;
reserve X, y for set;
reserve p for Real;
reserve r for real number;
reserve a, a1, a2, b, b1, b2, x, x0, z, z0 for Element of COMPLEX;
reserve s1, s3, seq, seq1 for Complex_Sequence;
reserve Y for Subset of COMPLEX;
reserve f, f1, f2 for PartFunc of COMPLEX,COMPLEX;
reserve Nseq for increasing sequence of NAT;

definition
  let x be real number;
  let IT be Complex_Sequence;
  attr IT is x-convergent means

  IT is convergent & lim IT = x;
end;

theorem 
  for rs be Real_Sequence, cs be Complex_Sequence st rs = cs & rs is
  convergent holds cs is convergent;

definition
  let r be real number;
  func InvShift(r) -> Complex_Sequence means


  for n holds it.n = 1/(n+r);
end;

theorem 
  0 < r implies InvShift(r) is convergent;

registration
  let r be positive real number;
  cluster InvShift(r) -> convergent;
end;

theorem 
  0 < r implies lim InvShift(r) = 0;

registration
  let r be positive real number;
  cluster InvShift(r) -> non-zero 0-convergent;
end;

registration
  cluster 0-convergent non-zero for Complex_Sequence;
end;

registration
  cluster 0-convergent non-zero -> convergent for Complex_Sequence;
end;

registration
  cluster constant for Complex_Sequence;
end;

theorem 
  seq is constant iff for n,m holds seq.n = seq.m;

theorem 
  for n holds (seq*Nseq).n = seq.(Nseq.n);

reserve h for 0-convergent non-zero Complex_Sequence;
reserve c for constant Complex_Sequence;

definition
  let IT be PartFunc of COMPLEX,COMPLEX;
  attr IT is RestFunc-like means


  for h holds (h")(#)(IT/*h) is convergent & lim ((h")(#)(IT/*h)) = 0;
end;

registration
  cluster total RestFunc-like for PartFunc of COMPLEX,COMPLEX;
end;

definition
  mode C_RestFunc is total RestFunc-like PartFunc of COMPLEX,COMPLEX;
end;

definition
  let IT be PartFunc of COMPLEX,COMPLEX;
  attr IT is linear means


  ex a st for z holds IT/.z = a*z;
end;

registration
  cluster total linear for PartFunc of COMPLEX,COMPLEX;
end;

definition
  mode C_LinearFunc is total linear PartFunc of COMPLEX,COMPLEX;
end;

reserve R, R1, R2 for C_RestFunc;
reserve L, L1, L2 for C_LinearFunc;

registration
  let L1,L2;
  cluster L1+L2 -> total linear for PartFunc of COMPLEX,COMPLEX;
  cluster L1-L2 -> total linear for PartFunc of COMPLEX,COMPLEX;
end;

registration
  let a,L;
  cluster a(#)L -> total linear for PartFunc of COMPLEX,COMPLEX;
end;

registration
  let R1,R2;
  cluster R1+R2 -> total RestFunc-like for PartFunc of COMPLEX,COMPLEX;
  cluster R1-R2 -> total RestFunc-like for PartFunc of COMPLEX,COMPLEX;
  cluster R1(#)R2 -> total RestFunc-like for PartFunc of COMPLEX,COMPLEX;
end;

registration
  let a,R;
  cluster a(#)R -> total RestFunc-like for PartFunc of COMPLEX,COMPLEX;
end;

registration
  let L1,L2;
  cluster L1(#)L2 -> total RestFunc-like for PartFunc of COMPLEX,COMPLEX;
end;

registration
  let R,L;
  cluster R(#)L -> total RestFunc-like for PartFunc of COMPLEX,COMPLEX;
  cluster L(#)R -> total RestFunc-like for PartFunc of COMPLEX,COMPLEX;
end;

definition
  let z0 be Complex;
  mode Neighbourhood of z0 -> Subset of COMPLEX means


  ex g be Real st 0 < g & {y where y is Complex : |.y-z0.| < g} c= it;
end;

theorem 
  for g be real number st 0 < g holds
  {y where y is Complex : |.y-z0.| < g} is Neighbourhood of z0;

theorem 
  for N being Neighbourhood of z0 holds z0 in N;

definition
  let f;
  let z0 be Complex;
  pred f is_differentiable_in z0 means


  ex N being Neighbourhood of z0 st N c= dom f &
  ex L,R st for z st z in N holds f/.z-f/.z0 = L/.(z-z0)+R/.(z-z0);
end;

definition
  let f;
  let z0 be Complex;
  assume
 f is_differentiable_in z0;
  func diff(f,z0) -> Element of COMPLEX means


  ex N being Neighbourhood of z0 st N c= dom f &
  ex L,R st it = L/.1r & for z st z in N holds f/.z-f/.z0 =
  L/.(z-z0)+R/.(z-z0);
end;

definition
  let f;
  attr f is differentiable means


  for x st x in dom f holds f is_differentiable_in x;
end;

definition
  let f,X;
  pred f is_differentiable_on X means


  X c= dom f & f|X is differentiable;
end;

theorem 
  f is_differentiable_on X implies X is Subset of COMPLEX;

definition 
  let X be Subset of COMPLEX;
  attr X is closed means


  for s1 be Complex_Sequence st rng s1 c= X &
  s1 is convergent holds lim s1 in X;
end;

definition
  let X be Subset of COMPLEX;
  attr X is open means


  X` is closed;
end;

theorem 
  for X being Subset of COMPLEX st X is open for z0 be Complex st
  z0 in X ex N being Neighbourhood of z0 st N c= X;

theorem 
  for X being Subset of COMPLEX st X is open for z0 be Complex st z0 in
  X holds ex g be Real st {y where y is Complex : |.y-z0.| < g} c= X;

theorem 
  for X being Subset of COMPLEX holds ((for z0 be Complex st z0 in
  X holds ex N be Neighbourhood of z0 st N c= X) implies X is open);

theorem 
  for X be Subset of COMPLEX holds X is open iff for x be Complex st x
  in X ex N be Neighbourhood of x st N c= X;

theorem 
  for X be Subset of COMPLEX, z0 be Element of COMPLEX, r be
  Element of REAL st X = {y where y is Complex : |.y-z0.| < r} holds X is open;

theorem 
  for X be Subset of COMPLEX, z0 be Element of COMPLEX, r be Element of
  REAL st X = {y where y is Complex : |.y-z0.| <= r} holds X is closed;

registration
  cluster open for Subset of COMPLEX;
end;

reserve Z for open Subset of COMPLEX;

theorem 
  f is_differentiable_on Z iff Z c= dom f & for x st x in Z holds
  f is_differentiable_in x;

theorem 
  f is_differentiable_on Y implies Y is open;

definition
  let f, X;
  assume
 f is_differentiable_on X;
  func f`|X -> PartFunc of COMPLEX,COMPLEX means


  dom it = X & for x st x in X holds it/.x = diff(f,x);
end;

theorem 
  for f,Z st Z c= dom f & ex a1 st rng f = {a1} holds f
  is_differentiable_on Z & for x st x in Z holds (f`|Z)/.x = 0c;

registration
  let seq be non-zero Complex_Sequence, k be Nat;
  cluster seq ^\k -> non-zero;
end;

registration
  let h,n;
  cluster h^\n -> 0-convergent for Complex_Sequence;
end;

theorem 
  (seq+seq1)^\k = (seq^\k)+(seq1^\k);

theorem 
  (seq-seq1)^\k = (seq^\k)-(seq1^\k);

theorem 
  (seq")^\k = (seq^\k)";

theorem 
  (seq(#)seq1)^\k = (seq^\k)(#)(seq1^\k);

theorem 
  for x0 be Complex for N being Neighbourhood of x0 st f
is_differentiable_in x0 & N c= dom f holds for h,c st rng c = {x0} & rng (h+c)
c= N holds h"(#)(f/*(h+c)-f/*c) is convergent & diff(f,x0) = lim (h"(#)(f/*(h+c
  )-f/*c));

theorem 
  for f1,f2,x0 st f1 is_differentiable_in x0 & f2
is_differentiable_in x0 holds f1+f2 is_differentiable_in x0 & diff(f1+f2,x0) =
  diff(f1,x0)+diff(f2,x0);

theorem 
  for f1,f2,x0 st f1 is_differentiable_in x0 & f2
is_differentiable_in x0 holds f1-f2 is_differentiable_in x0 & diff(f1-f2,x0) =
  diff(f1,x0)-diff(f2,x0);

theorem 
  for a,f,x0 st f is_differentiable_in x0 holds a(#)f
  is_differentiable_in x0 & diff((a(#)f),x0) = a*diff(f,x0);

theorem 
  for f1,f2,x0 st f1 is_differentiable_in x0 & f2
is_differentiable_in x0 holds f1(#)f2 is_differentiable_in x0 & diff(f1(#)f2,x0
  ) = (f2/.x0)*diff(f1,x0)+(f1/.x0)*diff(f2,x0);

theorem 
  for f,Z st Z c= dom f & f|Z = id Z holds f is_differentiable_on Z &
  for x st x in Z holds (f`|Z)/.x = 1r;

theorem 
  for f1,f2,Z st Z c= dom (f1+f2) & f1 is_differentiable_on Z & f2
  is_differentiable_on Z holds f1+f2 is_differentiable_on Z & for x st x in Z
  holds ((f1+f2)`|Z)/.x = diff(f1,x)+diff(f2,x);

theorem 
  for f1,f2,Z st Z c= dom (f1-f2) & f1 is_differentiable_on Z & f2
  is_differentiable_on Z holds f1-f2 is_differentiable_on Z & for x st x in Z
  holds ((f1-f2)`|Z)/.x = diff(f1,x)-diff(f2,x);

theorem 
  for a,f,Z st Z c= dom (a(#)f) & f is_differentiable_on Z holds a(#)f
  is_differentiable_on Z & for x st x in Z holds ((a(#)f)`|Z)/.x = a*diff(f,x);

theorem 
  for f1,f2,Z st Z c= dom (f1(#)f2) & f1 is_differentiable_on Z & f2
  is_differentiable_on Z holds f1(#)f2 is_differentiable_on Z & for x st x in Z
  holds ((f1(#)f2)`|Z)/.x = (f2/.x)*diff(f1,x)+(f1/.x)*diff(f2,x);

theorem 
  Z c= dom f & f|Z is constant implies f is_differentiable_on Z & for x
  st x in Z holds (f`|Z)/.x = 0c;

theorem 
  Z c= dom f & (for x st x in Z holds f/.x = a*x+b) implies f
  is_differentiable_on Z & for x st x in Z holds (f`|Z)/.x = a;

theorem 
  for x0 be Element of COMPLEX holds f is_differentiable_in x0 implies f
  is_continuous_in x0;

theorem 
  f is_differentiable_on X implies f is_continuous_on X;

theorem 
  f is_differentiable_on X & Z c= X implies f is_differentiable_on Z;

canceled;

theorem 
  f is_differentiable_in x0 implies ex R st R/.0c = 0c & R is_continuous_in 0c;














begin

reserve E for non empty set;
reserve a for Element of E;
reserve A, B for Subset of E;
reserve Y for set;
reserve p for FinSequence;

theorem 
  for e being non empty Subset of E holds e is Singleton of E iff for Y
  holds (Y c= e iff Y = {} or Y = e);

registration
  let E;
  cluster -> finite for Singleton of E;
end;

reserve e, e1, e2 for Singleton of E;

theorem 
  e = A \/ B & A <> B implies A = {} & B = e or A = e & B = {};

theorem 
  e = A \/ B implies A = e & B = e or A = e & B = {} or A = {} & B = e;

theorem 
  {a} is Singleton of E;

theorem 
  e1 c= e2 implies e1 = e2;

theorem 
  ex a st a in E & e = {a};

theorem 
  ex e st e is Singleton of E;

theorem 
  ex p st p is FinSequence of E & rng p = e & len p = 1;

definition
  let E be set;
  mode Event of E is Subset of E;
end;

theorem 
  for E being non empty set, e being Singleton of E, A being Event of E
  holds e misses A or e /\ A = e;

theorem 
  for E being non empty set, A being Event of E st A <> {} ex e being
  Singleton of E st e c= A;

theorem 
  for E being non empty set, e being Singleton of E, A being Event of E st e
  c= A \/ A` holds e c= A or e c= A`;

theorem 
  e1 = e2 or e1 misses e2;

theorem 
  A /\ B misses A /\ B`;

definition
  let E be finite set;
  let A be Event of E;
  func prob(A) -> Real equals

  card A / card E;
end;

theorem 
  for E being finite non empty set, e being Singleton of E holds prob(e) = 1
  / card E;

theorem 
  for E being finite non empty set holds prob([#] E) = 1;

theorem 
  for E being finite non empty set, A,B being Event of E st A
  misses B holds prob(A /\ B) = 0;

theorem 
  for E being finite non empty set, A being Event of E holds prob(A) <= 1;

theorem 
  for E being finite non empty set, A being Event of E holds 0 <= prob(A);

theorem 
  for E being finite non empty set, A,B being Event of E st A c= B
  holds prob(A) <= prob(B);

theorem 
  for E being finite non empty set, A,B being Event of E holds
  prob(A \/ B) = prob(A) + prob(B) - prob(A /\ B);

theorem 
  for E being finite non empty set, A,B being Event of E st A
  misses B holds prob(A \/ B) = prob(A) + prob(B);

theorem 
  for E being finite non empty set, A being Event of E holds prob(
  A) = 1 - prob(A`) & prob(A`) = 1 - prob(A);

theorem 
  for E being finite non empty set, A,B being Event of E holds
  prob(A \ B) = prob(A) - prob(A /\ B);

theorem 
  for E being finite non empty set, A,B being Event of E st B c= A
  holds prob(A \ B) = prob(A) - prob(B);

theorem 
  for E being finite non empty set, A,B being Event of E holds prob(A \/
  B) <= prob(A) + prob(B);

theorem 
  for E being finite non empty set, A,B being Event of E holds
  prob(A) = prob(A /\ B) + prob(A /\ B`);

theorem 
  for E being finite non empty set, A,B being Event of E holds prob(A) =
  prob(A \/ B) - prob(B \ A);

theorem 
  for E being finite non empty set, A,B being Event of E holds prob(A) +
  prob(A` /\ B) = prob(B) + prob(B` /\ A);

theorem 
  for E being finite non empty set, A,B,C being Event of E holds
  prob(A \/ B \/ C) = ( prob(A) + prob(B) + prob(C) ) - ( prob(A /\ B) + prob(A
  /\ C) + prob(B /\ C) ) + prob(A /\ B /\ C);

theorem 
  for E being finite non empty set, A,B,C being Event of E st A misses B
& A misses C & B misses C holds prob(A \/ B \/ C) = prob(A) + prob(B) + prob(C)
;

theorem 
  for E being finite non empty set, A,B being Event of E holds prob(A) -
  prob(B) <= prob(A \ B);

definition
  let E be finite set;
  let B,A be Event of E;
  func prob(A, B) -> Real equals

  prob(A /\ B) / prob(B);
end;

theorem 
  for E being finite non empty set, A being Event of E holds
  prob(A, [#]E ) = prob(A);

theorem 
  for E being finite non empty set holds prob([#] E, [#] E) = 1;

theorem 
  for E being finite non empty set, A,B being Event of E st 0 < prob(B)
  holds prob(A, B) <= 1;

theorem 
  for E being finite non empty set, A,B being Event of E st 0 < prob(B)
  holds 0 <= prob(A, B);

theorem 
  for E being finite non empty set, A,B being Event of E st 0 <
  prob(B) holds prob(A, B) = 1 - prob(B \ A) / prob(B);

theorem 
  for E being finite non empty set, A,B being Event of E st 0 < prob(B)
  & A c= B holds prob(A, B) = prob(A) / prob(B);

theorem 
  for E being finite non empty set, A,B being Event of E st A
  misses B holds prob(A, B) = 0;

theorem 
  for E being finite non empty set, A,B being Event of E st 0 <
  prob(A) & 0 < prob(B) holds prob(A) * prob(B, A) = prob(B) * prob(A, B);

theorem 
  for E being finite non empty set, A,B being Event of E st 0 <
  prob B holds prob(A, B) = 1 - prob(A`, B) & prob(A`, B) = 1 - prob(A, B);

theorem 
  for E being finite non empty set, A,B being Event of E st 0 <
  prob(B) & B c= A holds prob(A, B) = 1;

theorem 
  for E being finite non empty set, B being Event of E st 0 < prob(B)
  holds prob([#] E, B) = 1;

theorem 
  for E being finite non empty set, A being Event of E holds prob(A`, A) = 0;

theorem 
  for E being finite non empty set, A being Event of E holds prob(A, A`) = 0;

theorem 
  for E being finite non empty set, A,B being Event of E st 0 <
  prob(B) & A misses B holds prob(A`, B) = 1;

theorem 
  for E being finite non empty set, A,B being Event of E st 0 <
prob(A) & prob(B) < 1 & A misses B holds prob(A, B`) = prob(A) / (1 - prob(B));

theorem 
  for E being finite non empty set, A,B being Event of E st 0 < prob(A)
  & prob(B) < 1 & A misses B holds prob(A`, B`) = 1 - prob(A) / (1 - prob(B));

theorem 
  for E being finite non empty set, A,B,C being Event of E st 0 < prob(B
  /\ C) & 0 < prob(C) holds prob(A /\ B /\ C) = prob(A, B /\ C) * prob(B, C) *
  prob(C);

theorem 
  for E being finite non empty set, A,B being Event of E st 0 <
prob(B) & prob(B) < 1 holds prob(A) = prob(A, B) * prob(B) + prob(A, B`) * prob
  (B`);

theorem 
  for E being finite non empty set, A,B1,B2 being Event of E st 0
< prob(B1) & 0 < prob(B2) & B1 \/ B2 = E & B1 misses B2 holds prob(A) = prob(A,
  B1) * prob(B1) + prob(A, B2) * prob(B2);

theorem 
  for E being finite non empty set, A,B1,B2,B3 being Event of E st
0 < prob(B1) & 0 < prob(B2) & 0 < prob(B3) & B1 \/ B2 \/ B3 = E & B1 misses B2
& B1 misses B3 & B2 misses B3 holds prob(A) = ( prob(A, B1) * prob(B1) + prob(A
  , B2) * prob(B2) ) + prob(A, B3) * prob(B3);

theorem 
  for E being finite non empty set, A,B1,B2 being Event of E st 0 < prob
(B1) & 0 < prob(B2) & B1 \/ B2 = E & B1 misses B2 holds prob(B1, A) = ( prob(A,
  B1) * prob(B1) ) / ( prob(A, B1) * prob(B1) + prob(A, B2) * prob(B2) );

theorem 
  for E being finite non empty set, A,B1,B2,B3 being Event of E st 0 <
prob(B1) & 0 < prob(B2) & 0 < prob(B3) & B1 \/ B2 \/ B3 = E & B1 misses B2 & B1
  misses B3 & B2 misses B3 holds prob(B1, A) = ( prob(A, B1) * prob(B1) ) / ( (
  prob(A, B1) * prob(B1) + prob(A, B2) * prob(B2) ) + prob(A, B3) * prob(B3) );

definition
  let E be finite set;
  let A, B be Event of E;
  pred A, B are_independent means


  prob(A /\ B) = prob(A) * prob(B);
  symmetry;
end;

theorem 
  for E being finite non empty set, A,B being Event of E st 0 < prob(B)
  & A, B are_independent holds prob(A, B) = prob(A);

theorem 
  for E being finite non empty set, A,B being Event of E st prob(B) = 0
  holds A, B are_independent;

theorem 
  for E being finite non empty set, A,B being Event of E st A, B
  are_independent holds A`, B are_independent;

theorem 
  for E being finite non empty set, A,B being Event of E st A misses B &
  A, B are_independent holds prob(A) = 0 or prob(B) = 0;














begin 

notation
  synonym 0. for 0;
end;

definition
  redefine func 0. -> R_eal;
  let x be R_eal;
  redefine func - x -> R_eal;
  let y be R_eal;
  redefine func x + y -> R_eal;
  redefine func x - y -> R_eal;
end;

theorem 
  for x,y being R_eal, a,b being Real st x = a & y = b holds
  x + y = a + b;

theorem 
  for x being R_eal, a being Real st x = a holds - x = - a;

theorem 
  for x,y being R_eal, a,b being Real st x = a & y = b holds x - y = a - b;





notation
  let X,Y be Subset of ExtREAL;
  synonym X + Y for X ++ Y;
end;

definition
  let X,Y be Subset of ExtREAL;
  redefine func X + Y -> Subset of ExtREAL;
end;

notation
  let X be Subset of ExtREAL;
  synonym -X for --X;
end;

definition
  let X be Subset of ExtREAL;
  redefine func - X -> Subset of ExtREAL;
end;

canceled;

theorem 
  for X being non empty Subset of ExtREAL, z being R_eal holds
  z in X iff - z in - X;

theorem 
  for X,Y being non empty Subset of ExtREAL holds X c= Y iff - X c= - Y;

theorem 
  for z being R_eal holds z in REAL iff - z in REAL;

definition
  let X be ext-real-membered set;
  redefine func inf X -> R_eal;
  redefine func sup X -> R_eal;
end;

theorem 
  for X,Y being non empty Subset of ExtREAL holds sup (X + Y) <= sup X + sup Y;

theorem 
  for X,Y being non empty Subset of ExtREAL holds inf X + inf Y <= inf (X + Y);

theorem 
  for X,Y being non empty Subset of ExtREAL holds X is bounded_above & Y
  is bounded_above implies sup (X + Y) <= sup X + sup Y;

theorem 
  for X,Y being non empty Subset of ExtREAL st X is bounded_below & Y is
  bounded_below holds inf X + inf Y <= inf (X + Y);

theorem 
  for X being non empty Subset of ExtREAL, a being R_eal holds
  a is UpperBound of X iff - a is LowerBound of - X;

theorem 
  for X being non empty Subset of ExtREAL holds for a being R_eal
  holds a is LowerBound of X iff - a is UpperBound of - X;

theorem 
  for X being non empty Subset of ExtREAL holds inf(- X) = - sup X;

theorem 
  for X be non empty Subset of ExtREAL holds sup(- X) = - inf X;

definition
  let X be non empty set;
  let Y be non empty Subset of ExtREAL;
  let F be Function of X,Y;
  redefine func rng F -> non empty Subset of ExtREAL;
end;





definition
  let D be ext-real-membered set;
  let X be set;
  let Y be Subset of D;
  let F be PartFunc of X,Y;
  func sup F -> Element of ExtREAL equals

  sup rng F;
  func inf F -> Element of ExtREAL equals

  inf rng F;
end;

definition
  let F be ext-real-valued Function;
  let x be set;
  redefine func F.x -> R_eal;
end;

definition
  let X be non empty set;
  let Y,Z be non empty Subset of ExtREAL;
  let F be Function of X,Y;
  let G be Function of X,Z;
  func F + G -> Function of X,Y + Z means


  for x being Element of X holds it.x = F.x + G.x;
end;

theorem 
  for X being non empty set, Y,Z being non empty Subset of ExtREAL,
     F being Function of X,Y, G being Function of X,Z holds
  rng(F + G) c= rng F + rng G;

theorem 
  for X being non empty set, Y,Z being non empty Subset of ExtREAL
for F being Function of X,Y for G being Function of X,Z holds sup(F + G) <= sup
  F + sup G;

theorem 
  for X being non empty set holds for Y,Z being non empty Subset
of ExtREAL for F being Function of X,Y for G being Function of X,Z holds inf F
  + inf G <= inf(F + G);

definition
  let X be non empty set;
  let Y be non empty Subset of ExtREAL;
  let F be Function of X,Y;
  func - F -> Function of X,- Y means


  for x being Element of X holds it.x = - F.x;
end;

theorem 
  for X being non empty set, Y being non empty Subset of ExtREAL,
  F being Function of X,Y holds rng(- F) = - rng F;

theorem 
  for X being non empty set, Y being non empty Subset of ExtREAL
  for F being Function of X,Y holds inf(- F) = - sup F & sup(- F) = - inf F;





definition
  let X be set;
  let Y be Subset of ExtREAL;
  let F be Function of X,Y;
  attr F is bounded_above means


  sup F < +infty;
  attr F is bounded_below means


  -infty < inf F;
end;

definition
  let X be set, Y be Subset of ExtREAL, F be Function of X,Y;
  attr F is bounded means


  F is bounded_above bounded_below;
end;

registration
  let X be set;
  let Y be Subset of ExtREAL;
  cluster bounded -> bounded_above bounded_below for Function of X, Y;
  cluster bounded_above bounded_below -> bounded for Function of X, Y;
end;

theorem 
  for X being non empty set, Y being non empty Subset of ExtREAL, F
  being Function of X,Y holds F is bounded iff sup F <+infty & -infty <inf F;

theorem 
  for X being non empty set, Y being non empty Subset of ExtREAL,
  F being Function of X,Y holds F is bounded_above iff - F is bounded_below;

theorem 
  for X being non empty set, Y being non empty Subset of ExtREAL,
  F being Function of X,Y holds F is bounded_below iff - F is bounded_above;

theorem 
  for X being non empty set, Y being non empty Subset of ExtREAL, F
  being Function of X,Y holds F is bounded iff - F is bounded;

theorem 
  for X being non empty set, Y being non empty Subset of ExtREAL, F
being Function of X,Y, x being Element of X holds -infty <= F.x & F.x <= +infty
;

theorem 
  for X being non empty set, Y being non empty Subset of ExtREAL, F
being Function of X,Y, x being Element of X st Y c= REAL holds -infty <F.x & F.
  x <+infty;

theorem 
  for X being non empty set, Y being non empty Subset of ExtREAL,
F being Function of X,Y, x being Element of X holds inf F <= F.x & F.x <= sup F
;

theorem 
  for X being non empty set, Y being non empty Subset of ExtREAL,
  F being Function of X,Y holds Y c= REAL implies (F is bounded_above iff sup F
  in REAL);

theorem 
  for X being non empty set, Y being non empty Subset of ExtREAL,
  F being Function of X,Y st Y c= REAL holds (F is bounded_below iff inf F in
  REAL);

theorem 
  for X being non empty set, Y being non empty Subset of ExtREAL, F
being Function of X,Y st Y c= REAL holds (F is bounded iff inf F in REAL & sup
  F in REAL);

theorem 
  for X being non empty set, Y,Z being non empty Subset of ExtREAL
  holds for F1 being Function of X,Y, F2 being Function of X,Z st F1 is
  bounded_above & F2 is bounded_above holds F1 + F2 is bounded_above;

theorem 
  for X being non empty set, Y,Z being non empty Subset of ExtREAL
  holds for F1 being Function of X,Y, F2 being Function of X,Z st F1 is
  bounded_below & F2 is bounded_below holds F1 + F2 is bounded_below;

theorem 
  for X being non empty set, Y,Z being non empty Subset of ExtREAL holds
for F1 being Function of X,Y, F2 being Function of X,Z st F1 is bounded & F2 is
  bounded holds F1 + F2 is bounded;

theorem 
  incl NAT is Function of NAT,ExtREAL &
  incl NAT is one-to-one & NAT = rng incl NAT &
  rng incl NAT is non empty Subset of ExtREAL;





definition
  let D be non empty set, IT be Subset of D;
  redefine attr IT is countable means


  IT is empty or ex F being Function of NAT,D st IT = rng F;
end;

registration
  cluster countable for non empty Subset of ExtREAL;
end;

definition
  mode Denum_Set_of_R_EAL is countable non empty Subset of ExtREAL;
end;

definition
  let IT be set;
  attr IT is nonnegative means


  for x being R_eal holds x in IT implies 0. <= x;
end;

registration
  cluster nonnegative for Denum_Set_of_R_EAL;
end;

definition
  mode Pos_Denum_Set_of_R_EAL is nonnegative Denum_Set_of_R_EAL;
end;

definition
  let D be Denum_Set_of_R_EAL;
  mode Num of D -> Function of NAT,ExtREAL means


    D = rng it;
end;

definition
  let D be Denum_Set_of_R_EAL;
  let N be Num of D;
  func Ser(D,N) -> Function of NAT,ExtREAL means


  it.0 = N.0 &
  for n being Element of NAT for y being R_eal st y = it.n holds
  it.(n + 1) = y + N.(n + 1);
end;

theorem 
  for D being Pos_Denum_Set_of_R_EAL, N being Num of D, n being
  Element of NAT holds 0. <= N.n;

theorem 
  for D being Pos_Denum_Set_of_R_EAL, N being Num of D, n being
  Element of NAT holds Ser(D,N).n <= Ser(D,N).(n + 1) & 0. <= Ser(D,N).n;

theorem 
  for D being Pos_Denum_Set_of_R_EAL, N being Num of D, n,m being
  Element of NAT holds Ser(D,N).n <= Ser(D,N).(n + m);

definition
  let D be Denum_Set_of_R_EAL;
  mode Set_of_Series of D -> non empty Subset of ExtREAL means

    ex N being Num of D st it = rng Ser(D,N);
end;

definition
  let D be Pos_Denum_Set_of_R_EAL;
  let N be Num of D;
  func SUM(D,N) -> R_eal equals

  sup(rng Ser(D,N));
end;

definition
  let D be Pos_Denum_Set_of_R_EAL;
  let N be Num of D;
  pred D is_sumable N means

  SUM(D,N) in REAL;
end;

theorem 
  for F being Function of NAT,ExtREAL holds rng F is Denum_Set_of_R_EAL;

definition
  let F be Function of NAT,ExtREAL;
  redefine func rng F -> Denum_Set_of_R_EAL;
end;

definition
  let F be Function of NAT,ExtREAL;
  func Ser(F) -> Function of NAT,ExtREAL means


  for N being Num of rng F st N = F holds it = Ser(rng F,N);
end;

definition
  let R be Relation;
  attr R is nonnegative means


  rng R is nonnegative;
end;

definition
  let F be Function of NAT,ExtREAL;
  func SUM(F) -> R_eal equals

  sup rng Ser(F);
end;

theorem 
  for X being set, F being PartFunc of X,ExtREAL holds F is
  nonnegative iff for n being Element of X holds 0. <= F.n;

theorem 
  for F being Function of NAT,ExtREAL, n being Element of NAT st F
  is nonnegative holds (Ser F).n <= (Ser F).(n + 1) & 0. <= (Ser F).n;

theorem 
  for F being Function of NAT,ExtREAL st F is nonnegative holds
  for n,m being Element of NAT holds Ser(F).n <= Ser(F).(n + m);

theorem 
  for F1,F2 being Function of NAT,ExtREAL st (for n being Element
of NAT holds F1.n <= F2.n) holds for n being Element of NAT holds Ser(F1).n <=
  Ser(F2).n;

theorem 
  for F1,F2 being Function of NAT,ExtREAL st (for n being Element
  of NAT holds F1.n <= F2.n) holds SUM(F1) <= SUM(F2);

theorem 
  for F being Function of NAT,ExtREAL holds Ser(F).0 = F.0 & for n
being Element of NAT, y being R_eal st y = Ser(F).n holds Ser(F).(n + 1) = y +
  F.(n + 1);

theorem 
  for F being Function of NAT,ExtREAL st F is nonnegative holds (
  ex n being Element of NAT st F.n = +infty) implies SUM(F) = +infty;

definition
  let F be Function of NAT,ExtREAL;
  attr F is summable means


  SUM(F) in REAL;
end;

theorem 
  for F being Function of NAT,ExtREAL st F is nonnegative holds (ex n
  being Element of NAT st F.n = +infty) implies F is not summable;

theorem 
  for F1,F2 being Function of NAT,ExtREAL st F1 is nonnegative & (for n
  being Element of NAT holds F1.n <= F2.n) holds (F2 is summable implies F1 is
  summable);

theorem 
  for F being Function of NAT,ExtREAL st F is nonnegative holds
for n being Nat st (for r being Element of NAT st n <= r holds F.r = 0.) holds
  SUM(F) = Ser(F).n;

theorem 
  for F being Function of NAT,ExtREAL st (for n being Element of
NAT holds F.n in REAL) holds for n being Element of NAT holds Ser(F).n in REAL;

theorem 
  for F being Function of NAT,ExtREAL st F is nonnegative & (ex n being
Element of NAT st (for k being Element of NAT st n <= k holds F.k = 0.) & (for
  k being Element of NAT st k <= n holds F.k <> +infty)) holds F is summable;



theorem 
  for X being set, F being PartFunc of X,ExtREAL holds F is nonnegative
  iff for n being set holds 0. <= F.n;

theorem 
  for X being set, F being PartFunc of X,ExtREAL st for n being set st n
  in dom F holds 0. <= F.n holds F is nonnegative;














begin

reserve T, T1 for Tree,
  P for AntiChain_of_Prefixes of T,
  p1 for FinSequence,
  p, q, r, s, p9 for FinSequence of NAT,
  x, Z for set,
  t for Element of T,
  k, n for Element of NAT;

theorem 
  for p,q,r,s being FinSequence st p^q = s^r holds p,s are_c=-comparable;

definition
  let T,T1;
  let P such that
 P<>{};
  func tree(T,P,T1) -> Tree means


  q in it iff (q in T & for p st p in P holds not p is_a_proper_prefix_of q)
  or ex p,r st p in P & r in T1 & q = p^r;
end;

theorem 
  P <> {} implies tree(T,P,T1) = {t1 where t1 is Element of T :
  for p st p in P holds not p is_a_proper_prefix_of t1}
  \/ { p^s where p is Element of T, s is Element of T1 : p in P };

theorem 
  {t1 where t1 is Element of T :
  for p st p in P holds not p is_a_prefix_of t1} c=
  {t1 where t1 is Element of T :
  for p st p in P holds not p is_a_proper_prefix_of t1};

theorem 
  P c= {t1 where t1 is Element of T :
  for p st p in P holds not p is_a_proper_prefix_of t1};

theorem 
  {t1 where t1 is Element of T :
  for p st p in P holds not p is_a_proper_prefix_of t1} \
  {t1 where t1 is Element of T :
  for p st p in P holds not p is_a_prefix_of t1} = P;

theorem 
  for T, T1, P holds
  P c= { p^s where p is Element of T, s is Element of T1 : p in P };

theorem 
  P <> {} implies tree(T,P,T1) = {t1 where t1 is Element of T :
  for p st p in P holds not p is_a_prefix_of t1}
  \/ { p^s where p is Element of T, s is Element of T1 : p in P };

theorem 
  p in P implies T1 = tree(T,P,T1)|p;

registration
  let T;
  cluster non empty for AntiChain_of_Prefixes of T;
end;

definition
  let T;
  let t be Element of T;
  redefine func {t} -> AntiChain_of_Prefixes of T;
end;

theorem 
  tree(T,{t},T1) = T with-replacement (t,T1);

reserve T,T1 for DecoratedTree,
  P for AntiChain_of_Prefixes of dom T,
  t for Element of dom T,
  p1, p2, r1, r2 for FinSequence of NAT;

definition
  let T,P,T1;
  assume
 P<>{};
  func tree(T,P,T1) -> DecoratedTree means


  dom it = tree(dom T, P, dom T1) & for q st q in tree(dom T, P, dom T1) holds
  (for p st p in P holds not p is_a_prefix_of q & it.q = T.q)
  or ex p,r st p in P & r in dom T1 & q = p^r & it.q = T1.r;
end;

theorem 
  P<>{} implies for q st q in dom tree(T,P,T1) holds
  (for p st p in P holds not p is_a_prefix_of q & tree(T,P,T1).q = T.q)
  or ex p,r st p in P & r in dom T1 & q = p^r & tree(T,P,T1).q = T1.r;

theorem 
  p in dom T implies for q st q in dom (T with-replacement (p,T1)) holds
  not p is_a_prefix_of q & T with-replacement (p,T1).q = T.q
  or ex r st r in dom T1 & q = p^r & T with-replacement (p,T1).q = T1.r;

theorem 
  P<>{} implies for q st q in dom tree(T,P,T1) &
  q in {t1 where t1 is Element of dom T :
  for p st p in P holds not p is_a_prefix_of t1} holds tree(T,P,T1).q = T.q;

theorem 
  p in dom T implies for q st q in dom (T with-replacement (p,T1)) &
  q in {t1 where t1 is Element of dom T : not p is_a_prefix_of t1}
  holds T with-replacement (p,T1).q = T.q;

theorem 
  for q st q in dom tree(T,P,T1) &
  q in {p^s where p is Element of dom T, s is Element of dom T1 : p in P}
  holds ex p9 being Element of dom T, r being Element of dom T1 st
  q = p9^r & p9 in P & tree(T,P,T1).q = T1.r;

theorem 
  p in dom T implies for q st q in dom (T with-replacement (p,T1)) &
  q in {p^s where s is Element of dom T1 : s = s}
  holds ex r being Element of dom T1 st
  q = p^r & T with-replacement (p,T1).q = T1.r;

theorem 
  tree(T,{t},T1) = T with-replacement (t,T1);

reserve D for non empty set,
  T,T1 for DecoratedTree of D,
  P for AntiChain_of_Prefixes of dom T;

definition
  let D,T,P,T1;
  assume
 P<>{};
  func tree(T,P,T1) -> DecoratedTree of D equals

  tree(T,P,T1);
end;














begin 



definition
  let n be Nat;
  func Fib (n) -> Element of NAT means


  ex fib being Function of NAT, [:NAT, NAT:] st it = (fib.n)`1 & fib.0 = [0,1]
  & for n being Nat holds fib.(n+1) = [ (fib.n)`2, (fib.n)`1 + (fib.n)`2 ];
end;

theorem 
  Fib(0) = 0 & Fib(1) = 1 &
  for n being Nat holds Fib((n+1)+1) = Fib(n) + Fib(n+1);



theorem 
  for i being Integer holds i div 1 = i;

theorem 
  for i, j being Integer st j > 0 & i div j = 0 holds i < j;

theorem 
  for i, j being Integer st 0<=i & i<j holds i div j = 0;

theorem 
  for i, j, k being Integer st k > 0 holds (i div j) div k = i div (j*k);

theorem 
  for i being Integer holds i mod 2 = 0 or i mod 2 = 1;

theorem 
  for i being Integer st i is Element of NAT holds i div 2 is Element of NAT;

theorem 
  for a, b, c being real number st a <= b & c > 1 holds
  c to_power a <= c to_power b;

theorem 
  for r, s being real number st r>=s holds [\r/] >= [\s/];

theorem 
  for a, b, c being real number st a > 1 & b > 0 & c >= b holds
  log (a, c) >= log (a, b);

theorem 
  for n being Nat st n > 0 holds
  [\ log (2, 2*n) /] +1 <> [\ log (2, 2*n + 1) /];

theorem 
  for n being Nat st n > 0 holds
  [\ log (2, 2*n) /] +1 >= [\ log (2, 2*n + 1) /];

theorem 
  for n being Nat st n > 0 holds [\ log(2, 2*n) /] = [\ log(2, 2*n + 1) /];

theorem 
  for n being Nat st n > 0 holds [\ log(2, n) /] + 1 = [\ log(2, 2*n + 1 ) /];



definition
  let f be Function of NAT, NAT*, n be Element of NAT;
  redefine func f.n -> FinSequence of NAT;
end;

definition
  let n be Nat;
  func Fusc n -> Element of NAT means


  it = 0 if n = 0 otherwise ex l
being Element of NAT, fusc being Function of NAT, NAT* st l+1 = n & it = (fusc.
  l)/.n & fusc.0 = <*1*> & for n being Nat holds (for k being Nat st n+2 = 2*k
holds fusc.(n+1) = (fusc.n qua Element of NAT*)^ <*(fusc.n qua Element of NAT*)
/.k*>) & for k being Nat st n+2 = 2*k+1 holds fusc.(n+1) = (fusc.n qua Element
of NAT*)^<*((fusc.n qua Element of NAT*)/.k)+ ((fusc.n qua Element of NAT*)/.(k
  +1))*>;
end;

theorem 
  Fusc 0 = 0 & Fusc 1 = 1 &
  for n being Nat holds Fusc (2*n) = Fusc n &
  Fusc (2*n+1) = Fusc n + Fusc (n+1);



theorem 
  for n being Nat st n <> 0 holds n < 2*n;

theorem 
  for n being Nat holds n < 2*n+1;

theorem 
  for A, B being Nat holds B = A * Fusc 0 + B * Fusc 1;

theorem 
  for n, A, B, N being Nat st Fusc N = A * Fusc (2*n+1) + B * Fusc (2*n+1+1)
  holds Fusc N = A * Fusc n + (B+A) * Fusc (n+1);

theorem 
  for n, A, B, N being Nat st Fusc N = A * Fusc (2*n) + B * Fusc (2*n+1)
  holds Fusc N = (A+B) * Fusc n + B * Fusc (n+1);














begin 

reserve x,y,z,X,Y for set,
  i,k,n for Element of NAT,
  p,q,r,s for FinSequence,
  w for FinSequence of NAT,
  f for Function;

begin 

definition
  func Trees -> set means


  x in it iff x is Tree;
end;

registration
  cluster Trees -> non empty;
end;

definition
  func FinTrees -> Subset of Trees means


  x in it iff x is finite Tree;
end;

registration
  cluster FinTrees -> non empty;
end;

definition
  let IT be set;
  attr IT is constituted-Trees means


  for x st x in IT holds x is Tree;
  attr IT is constituted-FinTrees means


   for x st x in IT holds x is finite Tree;
  attr IT is constituted-DTrees means


   for x st x in IT holds x is DecoratedTree;
end;

theorem 
  X is constituted-Trees iff X c= Trees;

theorem 
  X is constituted-FinTrees iff X c= FinTrees;

theorem 
  X is constituted-Trees & Y is constituted-Trees iff X \/
  Y is constituted-Trees;

theorem 
  X is constituted-Trees & Y is constituted-Trees implies
  X \+\ Y is constituted-Trees;

theorem 
  X is constituted-Trees implies X /\ Y is constituted-Trees &
  Y /\ X is constituted-Trees & X \ Y is constituted-Trees;

theorem 
  X is constituted-FinTrees & Y is constituted-FinTrees iff
  X \/ Y is constituted-FinTrees;

theorem 
  X is constituted-FinTrees & Y is constituted-FinTrees implies
  X \+\ Y is constituted-FinTrees;

theorem 
  X is constituted-FinTrees implies X /\ Y is constituted-FinTrees &
  Y /\ X is constituted-FinTrees & X \ Y is constituted-FinTrees;

theorem 
  X is constituted-DTrees & Y is constituted-DTrees iff
  X \/ Y is constituted-DTrees;

theorem 
  X is constituted-DTrees & Y is constituted-DTrees implies
  X \+\ Y is constituted-DTrees;

theorem 
  X is constituted-DTrees implies X /\ Y is constituted-DTrees &
  Y /\ X is constituted-DTrees & X \ Y is constituted-DTrees;

registration
  cluster empty ->
    constituted-Trees constituted-FinTrees constituted-DTrees for set;
end;

theorem 
  {x} is constituted-Trees iff x is Tree;

theorem 
  {x} is constituted-FinTrees iff x is finite Tree;

theorem 
  {x} is constituted-DTrees iff x is DecoratedTree;

theorem 
  {x,y} is constituted-Trees iff x is Tree & y is Tree;

theorem 
  {x,y} is constituted-FinTrees iff x is finite Tree & y is finite Tree;

theorem 
  {x,y} is constituted-DTrees iff x is DecoratedTree & y is DecoratedTree;

theorem 
  X is constituted-Trees & Y c= X implies Y is constituted-Trees;

theorem 
  X is constituted-FinTrees & Y c= X implies Y is constituted-FinTrees;

theorem 
  X is constituted-DTrees & Y c= X implies Y is constituted-DTrees;

registration
  cluster finite constituted-Trees constituted-FinTrees non empty for set;
  cluster finite constituted-DTrees non empty for set;
end;

registration
  cluster constituted-FinTrees -> constituted-Trees for set;
end;

registration
  let X be constituted-Trees set;
  cluster -> constituted-Trees for Subset of X;
end;

registration
  let X be constituted-FinTrees set;
  cluster -> constituted-FinTrees for Subset of X;
end;

registration
  let X be constituted-DTrees set;
  cluster -> constituted-DTrees for Subset of X;
end;

registration
  let D be constituted-Trees non empty set;
  cluster -> non empty Tree-like for Element of D;
end;

registration
  let D be constituted-FinTrees non empty set;
  cluster -> finite for Element of D;
end;

registration
  cluster constituted-DTrees -> functional for set;
end;

registration
  let D be constituted-DTrees non empty set;
  cluster -> DecoratedTree-like for Element of D;
end;

registration
  cluster Trees -> constituted-Trees;
end;

registration
  cluster FinTrees -> constituted-FinTrees;
end;

registration
  cluster constituted-FinTrees non empty for Subset of Trees;
end;

definition
  let D be non empty set;
  mode DTree-set of D -> non empty set means

   for x st x in it holds x is DecoratedTree of D;
end;

registration
  let D be non empty set;
  cluster -> constituted-DTrees for DTree-set of D;
end;

registration
  let D be non empty set;
  cluster finite non empty for DTree-set of D;
end;

registration
  let D be non empty set, E be non empty DTree-set of D;
  cluster -> D-valued for Element of E;
end;

definition
  let T be Tree, D be non empty set;
  redefine func Funcs(T,D) -> non empty DTree-set of D;
end;

registration
  let T be Tree, D be non empty set;
  cluster -> DecoratedTree-like for Function of T,D;
end;

definition
  let D be non empty set;
  func Trees(D) -> DTree-set of D means

   for T being DecoratedTree of D holds T in it;
end;

registration
  let D be non empty set;
  cluster Trees(D) -> non empty;
end;

definition
  let D be non empty set;
  func FinTrees(D) -> DTree-set of D means


  for T being DecoratedTree of D holds dom T is finite iff T in it;
end;

theorem 
  for D being non empty set holds FinTrees D c= Trees D;

begin 

definition
  let IT be Function;
  attr IT is Tree-yielding means


  rng IT is constituted-Trees;
  attr IT is FinTree-yielding means


  rng IT is constituted-FinTrees;
  attr IT is DTree-yielding means


  rng IT is constituted-DTrees;
end;

registration
  cluster empty -> Tree-yielding FinTree-yielding DTree-yielding for Function;
end;

theorem 
  f is Tree-yielding iff for x st x in dom f holds f.x is Tree;

theorem 
  f is FinTree-yielding iff for x st x in dom f holds f.x is finite Tree;

theorem 
  f is DTree-yielding iff for x st x in dom f holds f.x is DecoratedTree;

theorem 
  p is Tree-yielding & q is Tree-yielding iff p^q is Tree-yielding;

theorem 
  p is FinTree-yielding & q is FinTree-yielding iff p^q is FinTree-yielding;

theorem 
  p is DTree-yielding & q is DTree-yielding iff p^q is DTree-yielding;

theorem 
  <*x*> is Tree-yielding iff x is Tree;

theorem 
  <*x*> is FinTree-yielding iff x is finite Tree;

theorem 
  <*x*> is DTree-yielding iff x is DecoratedTree;

theorem 
  <*x,y*> is Tree-yielding iff x is Tree & y is Tree;

theorem 
  <*x,y*> is FinTree-yielding iff x is finite Tree & y is finite Tree;

theorem 
  <*x,y*> is DTree-yielding iff x is DecoratedTree & y is DecoratedTree;

theorem 
  i <> 0 implies (i |-> x is Tree-yielding iff x is Tree);

theorem 
  i <> 0 implies (i |-> x is FinTree-yielding iff x is finite Tree);

theorem 
  i <> 0 implies (i |-> x is DTree-yielding iff x is DecoratedTree);

registration
  cluster Tree-yielding FinTree-yielding non empty for FinSequence;
  cluster DTree-yielding non empty for FinSequence;
end;

registration
  cluster Tree-yielding FinTree-yielding non empty for Function;
  cluster DTree-yielding non empty for Function;
end;

registration
  cluster FinTree-yielding -> Tree-yielding for Function;
end;

registration
  let D be constituted-Trees non empty set;
  cluster -> Tree-yielding for FinSequence of D;
end;

registration
  let p,q be Tree-yielding FinSequence;
  cluster p^q -> Tree-yielding;
end;

registration
  let D be constituted-FinTrees non empty set;
  cluster -> FinTree-yielding for FinSequence of D;
end;

registration
  let p,q be FinTree-yielding FinSequence;
  cluster p^q -> FinTree-yielding;
end;

registration
  let D be constituted-DTrees non empty set;
  cluster -> DTree-yielding for FinSequence of D;
end;

registration
  let p,q be DTree-yielding FinSequence;
  cluster p^q -> DTree-yielding;
end;

registration
  let T be Tree;
  cluster <*T*> -> Tree-yielding non empty;
  let S be Tree;
  cluster <*T,S*> -> Tree-yielding non empty;
end;

registration
  let n be Element of NAT, T be Tree;
  cluster n |-> T -> Tree-yielding;
end;

registration
  let T be finite Tree;
  cluster <*T*> -> FinTree-yielding;
  let S be finite Tree;
  cluster <*T,S*> -> FinTree-yielding;
end;

registration
  let n be Element of NAT, T be finite Tree;
  cluster n |-> T -> FinTree-yielding;
end;

registration
  let T be DecoratedTree;
  cluster <*T*> -> DTree-yielding non empty;
  let S be DecoratedTree;
  cluster <*T,S*> -> DTree-yielding non empty;
end;

registration
  let n be Element of NAT, T be DecoratedTree;
  cluster n |-> T -> DTree-yielding;
end;

theorem 
  for f being DTree-yielding Function holds dom doms f = dom f &
  doms f is Tree-yielding;

registration
  let p be DTree-yielding FinSequence;
  cluster doms p -> Tree-yielding FinSequence-like;
end;

theorem 
  for p being DTree-yielding FinSequence holds len doms p = len p;

begin 

definition
  let D,E be non empty set;
  mode DecoratedTree of D,E is DecoratedTree of [:D,E:];
  mode DTree-set of D,E is DTree-set of [:D,E:];
end;

registration
  let T1,T2 be DecoratedTree;
  cluster <:T1,T2:> -> DecoratedTree-like;
end;

registration
  let D1,D2 be non empty set;
  let T1 be DecoratedTree of D1;
  let T2 be DecoratedTree of D2;
  cluster <:T1,T2:> -> [:D1,D2:]-valued;
end;

registration
  let D,E be non empty set;
  let T be DecoratedTree of D;
  let f be Function of D,E;
  cluster f*T -> DecoratedTree-like;
end;

definition
  let D1,D2 be non empty set;
  redefine func pr1(D1,D2) -> Function of [:D1,D2:], D1;
  redefine func pr2(D1,D2) -> Function of [:D1,D2:], D2;
end;

definition
  let D1,D2 be non empty set, T be DecoratedTree of D1,D2;
  func T`1 -> DecoratedTree of D1 equals

  pr1(D1,D2)*T;
  func T`2 -> DecoratedTree of D2 equals

  pr2(D1,D2)*T;
end;

theorem 
  for D1,D2 being non empty set, T being DecoratedTree of D1,D2,
  t being Element of dom T holds (T.t)`1 = T`1.t & T`2.t = (T.t)`2;

theorem 
  for D1,D2 being non empty set, T being DecoratedTree of D1,D2 holds
  <:T`1,T`2:> = T;

registration
  let T be finite Tree;
  cluster Leaves T -> finite non empty;
end;

definition
  let T be Tree, S be non empty Subset of T;
  redefine mode Element of S -> Element of T;
end;

definition
  let T be finite Tree;
  redefine mode Leaf of T -> Element of Leaves T;
end;

definition
  let T be finite Tree;
  mode T-Substitution of T -> Tree means


     for t being Element of it holds t in T or
    ex l being Leaf of T st l is_a_proper_prefix_of t;
end;

definition
  let T be finite Tree, t be Leaf of T, S be Tree;
  redefine func T with-replacement (t,S) -> T-Substitution of T;
end;

registration
  let T be finite Tree;
  cluster finite for T-Substitution of T;
end;

definition
  let n;
  mode T-Substitution of n is T-Substitution of elementary_tree n;
end;

theorem 
  for T being Tree holds T is T-Substitution of 0;

theorem 
  for T1, T2 being Tree st T1-level 1 c= T2-level 1 &
  for n st <*n*> in T1 holds T1|<*n*> = T2|<*n*> holds T1 c= T2;

begin 

theorem 
  for T,T9 being Tree, p being FinSequence of NAT st
  p in Leaves T holds T c= T with-replacement (p,T9);

theorem 
  for T,T9 being DecoratedTree, p being Element of dom T holds
  (T with-replacement (p,T9)).p = T9.{};

theorem 
  for T,T9 being DecoratedTree, p,q being Element of dom T st
  not p is_a_prefix_of q holds (T with-replacement (p,T9)).q = T.q;

theorem 
  for T,T9 being DecoratedTree, p being Element of dom T,
  q being Element of dom T9 holds (T with-replacement (p,T9)).(p^q) = T9.q;

registration
  let T1,T2 be Tree;
  cluster T1 \/ T2 -> non empty Tree-like;
end;

theorem 
  for T1,T2 being Tree, p being Element of T1 \/ T2 holds
  (p in T1 & p in T2 implies (T1 \/ T2)|p = (T1|p) \/ (T2|p)) &
  (not p in T1 implies (T1 \/ T2)|p = T2|p) &
  (not p in T2 implies (T1 \/ T2)|p = T1|p);

definition
  let p such that
 p is Tree-yielding;
  func tree p -> Tree means


  x in it iff x = {} or ex n,q st n < len p & q in p.(n+1) & x = <*n*>^q;
end;

definition
  let T be Tree;
  func ^T -> Tree equals

  tree<*T*>;
end;

definition
  let T1,T2 be Tree;
  func tree(T1,T2) -> Tree equals

  tree(<*T1,T2*>);
end;

theorem 
  p is Tree-yielding implies (<*n*>^q in tree(p) iff n < len p & q in p.(n+ 1
  ) );

theorem 
  p is Tree-yielding implies tree(p)-level 1 = {<*n*>: n < len p} &
  for n st n < len p holds (tree(p))|<*n*> = p.(n+1);

theorem 
  for p,q being Tree-yielding FinSequence st tree(p) = tree(q) holds p = q;

theorem 
  for p1,p2 being Tree-yielding FinSequence, T being Tree holds
  p in T iff <*len p1*>^p in tree(p1^<*T*>^p2);

theorem 
  tree({}) = elementary_tree 0;

theorem 
  p is Tree-yielding implies elementary_tree len p c= tree(p);

theorem 
  elementary_tree i = tree(i|->elementary_tree 0);

theorem 
  for T being Tree, p being Tree-yielding FinSequence holds
  tree(p^<*T*>) = (tree(p) \/ elementary_tree (len p + 1))
  with-replacement (<*len p*>, T);

theorem 
  for p being Tree-yielding FinSequence holds
  tree(p^<*elementary_tree 0*>) = tree(p) \/ elementary_tree (len p + 1);

theorem 
  for p, q being Tree-yielding FinSequence for T1,T2 be Tree holds
  tree(p^<*T1*>^q) = tree(p^<*T2*>^q) with-replacement(<*len p*>,T1);

theorem 
  for T being Tree holds ^T = elementary_tree 1 with-replacement(<*0*>, T);

theorem 
  for T1,T2 being Tree holds
  tree(T1,T2) = (elementary_tree 2 with-replacement(<*0*>,T1))
  with-replacement (<*1*>, T2);

registration
  let p be FinTree-yielding FinSequence;
  cluster tree(p) -> finite;
end;

registration
  let T be finite Tree;
  cluster ^T -> finite;
end;

registration
  let T1,T2 be finite Tree;
  cluster tree(T1,T2) -> finite;
end;

theorem 
  for T being Tree, x being set holds x in ^T iff x = {} or
  ex p st p in T & x = <*0*>^p;

theorem 
  for T being Tree, p being FinSequence holds p in T iff <*0*>^p in ^T;

theorem 
  for T being Tree holds elementary_tree 1 c= ^T;

theorem 
  for T1,T2 being Tree st T1 c= T2 holds ^T1 c= ^T2;

theorem 
  for T1,T2 being Tree st ^T1 = ^T2 holds T1 = T2;

theorem 
  for T being Tree holds (^T)|<*0*> = T;

theorem 
  for T1,T2 being Tree holds ^T1 with-replacement (<*0*>,T2) = ^T2;

theorem 
  ^elementary_tree 0 = elementary_tree 1;

theorem 
  for T1,T2 being Tree, x being set holds x in tree(T1,T2) iff x = {} or
  ex p st p in T1 & x = <*0*>^p or p in T2 & x = <*1*>^p;

theorem 
  for T1,T2 being Tree, p being FinSequence holds
  p in T1 iff <*0*>^p in tree(T1,T2);

theorem 
  for T1,T2 being Tree, p being FinSequence holds
  p in T2 iff <*1*>^p in tree(T1,T2);

theorem 
  for T1,T2 being Tree holds elementary_tree 2 c= tree(T1,T2);

theorem 
  for T1,T2, W1,W2 being Tree st T1 c= W1 & T2 c= W2 holds
  tree(T1,T2) c= tree(W1,W2);

theorem 
  for T1,T2, W1,W2 being Tree st tree(T1,T2) = tree(W1,W2) holds
  T1 = W1 & T2 = W2;

theorem 
  for T1,T2 being Tree holds tree(T1,T2)|<*0*> = T1 & tree(T1,T2)|<*1*> = T2;

theorem 
  for T,T1,T2 being Tree holds
  tree(T1,T2) with-replacement (<*0*>, T) = tree(T,T2) &
  tree(T1,T2) with-replacement (<*1*>, T) = tree(T1,T);

theorem 
  tree(elementary_tree 0, elementary_tree 0) = elementary_tree 2;

reserve w for FinTree-yielding FinSequence;

theorem 
  for w st for t being finite Tree st t in rng w holds height t <= n holds
  height tree(w) <= n+1;

theorem 
  for t being finite Tree st t in rng w holds height tree(w) > height t;

theorem 
  for t being finite Tree st t in rng w &
  for t9 being finite Tree st t9 in rng w holds height t9 <= height t holds
  height tree(w) = (height t) + 1;

theorem 
  for T being finite Tree holds height ^T = (height T) + 1;

theorem 
  for T1,T2 being finite Tree holds
  height tree(T1,T2) = max(height T1, height T2)+1;

begin 


registration
  let D be non empty set, t be Element of FinTrees D;
  cluster dom t -> finite;
end;

definition
  let p be FinSequence such that
 p is DTree-yielding;
  func roots p -> FinSequence means

  dom it = dom p & for i being Element of NAT st i in dom p
  ex T being DecoratedTree st T = p.i & it.i = T.{};
end;















begin



reserve Y,Z for non empty set;
reserve PA,PB for a_partition of Y;
reserve A,B for Subset of Y;
reserve i,j,k for Element of NAT;
reserve x,y,z,x1,x2,y1,z0,X,V,a,b,d,t,SFX,SFY for set;

theorem 
  X in PA & V in PA & X c= V implies X=V;

notation
  let SFX,SFY;
  synonym SFX '<' SFY for SFX is_finer_than SFY;
  synonym SFY '>' SFX for SFX is_finer_than SFY;
end;

theorem 
  union (SFX \ {{}}) = union SFX;

theorem 
  for PA,PB being a_partition of Y st PA '>' PB & PB '>' PA holds PB c= PA;

theorem 
  for PA,PB being a_partition of Y st PA '>' PB & PB '>' PA holds PA = PB;

theorem 
  for PA,PB being a_partition of Y st PA '>' PB holds PA is_coarser_than PB;

definition
  let Y;
  let PA be a_partition of Y,b be set;
  pred b is_a_dependent_set_of PA means


  ex B being set st B c= PA & B<>{} & b = union B;
end;

definition
  let Y;
  let PA,PB be a_partition of Y,b be set;
  pred b is_min_depend PA,PB means


  b is_a_dependent_set_of PA &
  b is_a_dependent_set_of PB & for d being set st d c= b
  & d is_a_dependent_set_of PA & d is_a_dependent_set_of PB holds d=b;
end;

theorem 
  for PA,PB being a_partition of Y
  st PA '>' PB holds for b being set st b in PA holds
  b is_a_dependent_set_of PB;

theorem 
  for PA being a_partition of Y holds Y is_a_dependent_set_of PA;

theorem 
  for F being Subset-Family of Y st (Intersect(F)<>{} &
  for X st X in F holds X is_a_dependent_set_of PA)
  holds Intersect(F) is_a_dependent_set_of PA;

theorem 
  for X0,X1 being Subset of Y st X0 is_a_dependent_set_of PA &
  X1 is_a_dependent_set_of PA & X0 meets X1
  holds X0 /\ X1 is_a_dependent_set_of PA;

theorem 
  for X being Subset of Y holds X is_a_dependent_set_of PA & X<>Y
  implies X` is_a_dependent_set_of PA;

theorem 
  for y being Element of Y
  ex X being Subset of Y st y in X & X is_min_depend PA,PB;

theorem 
  for P being a_partition of Y for y being Element of Y
  ex A being Subset of Y st y in A & A in P;

definition
  let Y be set;
  func PARTITIONS(Y) means


  for x being set holds x in it iff x is a_partition of Y;
end;

registration
  let Y be set;
  cluster PARTITIONS(Y) -> non empty;
end;

begin



definition
  let Y;
  let PA,PB be a_partition of Y;
  func PA '/\' PB -> a_partition of Y equals

  INTERSECTION(PA,PB) \ {{}};
  commutativity;
end;

theorem 
  for PA being a_partition of Y holds PA '/\' PA = PA;

theorem 
  for PA,PB,PC being a_partition of Y holds
  (PA '/\' PB) '/\' PC = PA '/\' (PB '/\' PC);

theorem 
  for PA,PB being a_partition of Y holds PA '>' PA '/\' PB;

definition
  let Y;
  let PA,PB be a_partition of Y;
  func PA '\/' PB -> a_partition of Y means


  for d holds d in it iff d is_min_depend PA,PB;
  commutativity;
end;

theorem 
  for PA,PB being a_partition of Y holds PA '<' PA '\/' PB;

theorem 
  for PA being a_partition of Y holds PA '\/' PA = PA;

theorem 
  for PA,PC being a_partition of Y st
  PA '<' PC & x in PC & z0 in PA & t in x & t in z0 holds z0 c= x;

theorem 
  for PA,PB being a_partition of Y st
  x in (PA '\/' PB) & z0 in PA & t in x & t in z0 holds z0 c= x;

begin



definition
  let Y;
  let PA be a_partition of Y;
  func ERl PA -> Equivalence_Relation of Y means


  for x1,x2 being set holds
  [x1,x2] in it iff ex A st A in PA & x1 in A & x2 in A;
end;

definition
  let Y;
  func Rel(Y) -> Function means

  dom it = PARTITIONS(Y) &
  for x st x in PARTITIONS(Y) ex PA st PA = x & it.x = ERl PA;
end;

theorem 
  for PA,PB being a_partition of Y holds PA '<' PB iff ERl(PA) c= ERl(PB);

theorem 
  for PA,PB being a_partition of Y,p0,x,y being set,
  f being FinSequence of Y st p0 c= Y &
  x in p0 & f.1=x & f.len f=y & 1 <= len f & (for i st 1<=i & i<len f
  ex p2,p3,u being set st p2 in PA & p3 in PB &
  f.i in p2 & u in p2 & u in p3 & f.(i+1) in p3) &
  p0 is_a_dependent_set_of PA & p0 is_a_dependent_set_of PB holds y in p0;

theorem 
  for R1,R2 being Equivalence_Relation of Y,f being FinSequence of Y,
  x,y being set st x in Y &
  f.1=x & f.len f=y & 1 <= len f &
  (for i st 1<=i & i<len f
  ex u being set st u in Y & [f.i,u] in (R1 \/ R2) & [u,f.(i+1)] in (R1 \/
  R2)) holds [x,y] in (R1 "\/" R2);

theorem 
  for PA,PB being a_partition of Y holds ERl(PA '\/' PB) = ERl(PA) "\/" ERl(PB)
;

theorem 
  for PA,PB being a_partition of Y holds ERl(PA '/\' PB) = ERl(PA) /\ ERl(PB);

theorem 
  for PA,PB being a_partition of Y st ERl(PA) = ERl(PB) holds PA = PB;

theorem 
  for PA,PB,PC being a_partition of Y holds
  (PA '\/' PB) '\/' PC = PA '\/' (PB '\/' PC);

theorem 
  for PA,PB being a_partition of Y holds PA '/\' (PA '\/' PB) = PA;

theorem 
  for PA,PB being a_partition of Y holds PA '\/' (PA '/\' PB) = PA;

theorem 
  for PA,PB,PC being a_partition of Y st
  PA '<' PC & PB '<' PC holds PA '\/' PB '<' PC;

theorem 
  for PA,PB,PC being a_partition of Y st
  PA '>' PC & PB '>' PC holds PA '/\' PB '>' PC;

notation
  let Y;
  synonym %I(Y) for SmallestPartition Y;
end;

definition
  let Y;

  func %O(Y) -> a_partition of Y equals

  {Y};
end;

theorem 
  %I(Y)={B:ex x being set st B={x} & x in Y};

theorem 
  for PA being a_partition of Y holds %O(Y) '>' PA & PA '>' %I(Y);

theorem 
  ERl(%O(Y)) = nabla Y;

theorem 
  ERl(%I(Y)) = id Y;

theorem 
  %I(Y) '<' %O(Y);

theorem 
  for PA being a_partition of Y holds
  %O(Y) '\/' PA = %O(Y) & %O(Y) '/\' PA = PA;

theorem 
  for PA being a_partition of Y holds
  %I(Y) '\/' PA = PA & %I(Y) '/\' PA = %I(Y);














begin 

definition
  let T be DecoratedTree;
  mode Node of T is Element of dom T;
end;

reserve x, y, z for set,
  i, j, n for Element of NAT,
  p, q, r for FinSequence,
  v for FinSequence of NAT;

definition
  let T1, T2 be DecoratedTree;
  redefine pred T1 = T2 means

  dom T1 = dom T2 & for p being Node of T1 holds T1.p = T2.p;
end;

theorem 
  for i,j being Element of NAT
  st elementary_tree i c= elementary_tree j holds i <= j;

theorem 
  for i,j being Element of NAT
  st elementary_tree i = elementary_tree j holds i = j;

definition
  let x;
  func root-tree x -> DecoratedTree equals

  (elementary_tree 0) --> x;
end;

definition
  let D be non empty set, d be Element of D;
  redefine func root-tree d -> Element of FinTrees D;
end;

theorem 
  dom root-tree x = elementary_tree 0 & (root-tree x).{} = x;

theorem 
  root-tree x = root-tree y implies x = y;

theorem 
  for T being DecoratedTree st dom T = elementary_tree 0 holds
  T = root-tree (T.{});

theorem 
  root-tree x = {[{},x]};

definition
  let x;
  let p be FinSequence;
  func x-flat_tree(p) -> DecoratedTree means


   dom it = elementary_tree len p & it.{} = x &
  for n st n < len p holds it.<*n*> = p.(n+1);
end;

theorem 
  x-flat_tree p = y-flat_tree q implies x = y & p = q;

theorem 
  j < i implies (elementary_tree i)|<*j*> = elementary_tree 0;

theorem 
  i < len p implies (x-flat_tree p)|<*i*> = root-tree (p.(i+1));

definition
  let x, p such that
 p is DTree-yielding;
  func x-tree(p) -> DecoratedTree means


  ( ex q being DTree-yielding FinSequence st p = q & dom it = tree(doms q)) &
  it.{} = x & for n st n < len p holds it|<*n*> = p.(n+1);
end;

definition
  let x;
  let T be DecoratedTree;
  func x-tree T -> DecoratedTree equals

  x-tree <*T*>;
end;

definition
  let x;
  let T1, T2 be DecoratedTree;
  func x-tree (T1,T2) -> DecoratedTree equals

  x-tree <*T1,T2*>;
end;

theorem 
  for p being DTree-yielding FinSequence holds dom (x-tree(p)) = tree(doms p);

theorem 
  for p being DTree-yielding FinSequence holds
  y in dom (x-tree(p)) iff y = {} or
  ex i being Element of NAT, T being DecoratedTree, q being Node of T st
  i < len p & T = p.(i+1) & y = <*i*>^q;

theorem 
  for p being DTree-yielding FinSequence for i being Element of NAT,
  T being DecoratedTree, q being Node of T st i < len p &
  T = p.(i+1) holds (x-tree p).(<*i*>^q) = T.q;

theorem 
  for T being DecoratedTree holds dom (x-tree T) = ^dom T;

theorem 
  for T1, T2 being DecoratedTree holds
  dom (x-tree (T1,T2)) = tree(dom T1, dom T2);

theorem 
  for p,q being DTree-yielding FinSequence st x-tree p = y-tree q holds
  x = y & p = q;

theorem 
  root-tree x = y-flat_tree p implies x = y & p = {};

theorem 
  root-tree x = y-tree p & p is DTree-yielding implies x = y & p = {};

theorem 
  x-flat_tree p = y-tree q & q is DTree-yielding implies x = y &
  len p = len q & for i st i in dom p holds q.i = root-tree (p.i);

theorem 
  for p being DTree-yielding FinSequence, n being Element of NAT,
  q being FinSequence st <*n*>^q in dom (x-tree(p)) holds
  (x-tree(p)).(<*n*>^q) = p..(n+1,q);

theorem 
  x-flat_tree({}) = root-tree x & x-tree({}) = root-tree x;

theorem 
  x-flat_tree(<*y*>) =
  ((elementary_tree 1) --> x) with-replacement (<*0*>, root-tree y);

theorem 
  for T being DecoratedTree holds
  x-tree(<*T*>) = ((elementary_tree 1) --> x) with-replacement (<*0*>, T);

registration
  let D be non empty set, d be Element of D, p be FinSequence of D;
  cluster d-flat_tree(p) -> D-valued;
end;

registration
  let D be non empty set, F be non empty DTree-set of D;
  let d be Element of D, p be FinSequence of F;
  cluster d-tree(p) -> D-valued;
end;

registration
  let D be non empty set, d be Element of D, T be DecoratedTree of D;
  cluster d-tree T -> D-valued;
end;

registration
  let D be non empty set, d be Element of D, T1, T2 be DecoratedTree of D;
  cluster d-tree(T1, T2) -> D-valued;
end;

definition
  let D be non empty set;
  let p be FinSequence of FinTrees D;
  redefine func doms p -> FinSequence of FinTrees;
end;

definition
  let D be non empty set;
  let d be Element of D, p be FinSequence of FinTrees D;
  redefine func d-tree p -> Element of FinTrees D;
end;

definition
  let D be non empty set, x be Subset of D;
  redefine mode FinSequence of x -> FinSequence of D;
end;

registration
  let D be non empty constituted-DTrees set;
  let X be Subset of D;
  cluster -> DTree-yielding for FinSequence of X;
end;

begin 

scheme 
 ExpandTree{T1() -> Tree, T2() -> Tree, P[set]}: ex T being Tree st
  for p holds p in T iff p in T1() or
  ex q being Element of T1(), r being Element of T2() st P[q] & p = q^r;

definition
  let T,T9 be DecoratedTree;
  let x be set;
  func (T,x) <- T9 -> DecoratedTree means


   (for p holds p in dom it iff p in dom T or
  ex q being Node of T, r being Node of T9 st
  q in Leaves dom T & T.q = x & p = q^r) & (for p being Node of T st
  not p in Leaves dom T or T.p <> x holds it.p = T.p) &
  for p being Node of T, q being Node of T9 st
  p in Leaves dom T & T.p = x holds it.(p^q) = T9.q;
end;

registration
  let D be non empty set;
  let T,T9 be DecoratedTree of D;
  let x be set;
  cluster (T,x) <- T9 -> D-valued;
end;

reserve T,T9 for DecoratedTree,
  x,y for set;

theorem 
  not x in rng T or not x in Leaves T implies (T,x) <- T9 = T;

begin 

reserve D1, D2 for non empty set,
  T for DecoratedTree of D1,D2,
  d1 for Element of D1,
  d2 for Element of D2,
  F for non empty DTree-set of D1,D2,
  F1 for non empty (DTree-set of D1),
  F2 for non empty DTree-set of D2;

theorem 
  for D1, D2, T holds dom T`1 = dom T & dom T`2 = dom T;

theorem 
  (root-tree [d1,d2])`1 = root-tree d1 & (root-tree [d1,d2])`2 = root-tree d2;

theorem 
  <:root-tree x, root-tree y:> = root-tree [x,y];

theorem 
  for D1,D2, d1,d2, F,F1
  for p being FinSequence of F, p1 being FinSequence of F1 st dom p1 = dom p &
  for i st i in dom p for T st T = p.i holds p1.i = T`1
  holds ([d1,d2]-tree p)`1 = d1-tree p1;

theorem 
  for D1,D2, d1,d2, F,F2
  for p being FinSequence of F, p2 being FinSequence of F2 st dom p2 = dom p &
  for i st i in dom p for T st T = p.i holds p2.i = T`2
  holds ([d1,d2]-tree p)`2 = d2-tree p2;

theorem 
  for D1,D2, d1,d2, F for p being FinSequence of F
  ex p1 being FinSequence of Trees D1 st dom p1 = dom p &
  (for i st i in dom p ex T being Element of F st T = p.i & p1.i = T`1) &
  ([d1,d2]-tree p)`1 = d1-tree p1;

theorem 
  for D1,D2, d1,d2, F for p being FinSequence of F
  ex p2 being FinSequence of Trees D2 st dom p2 = dom p &
  (for i st i in dom p ex T being Element of F st T = p.i & p2.i = T`2) &
  ([d1,d2]-tree p)`2 = d2-tree p2;

theorem 
  for D1,D2, d1,d2 for p being FinSequence of FinTrees [:D1,D2:]
  ex p1 being FinSequence of FinTrees D1 st dom p1 = dom p &
  (for i st i in dom p ex T being Element of FinTrees [:D1,D2:] st
  T = p.i & p1.i = T`1) & ([d1,d2]-tree p)`1 = d1-tree p1;

theorem 
  for D1,D2, d1,d2 for p being FinSequence of FinTrees [:D1,D2:]
  ex p2 being FinSequence of FinTrees D2 st dom p2 = dom p &
  (for i st i in dom p ex T being Element of FinTrees [:D1,D2:] st
  T = p.i & p2.i = T`2) & ([d1,d2]-tree p)`2 = d2-tree p2;














begin

theorem 
  for x being set for X being infinite set holds card {x} in card X;

scheme 

  ElemProp{D()-> non empty set,x()->set,P[set]}: P[x()]
provided
 x() in {y where y is Element of D(): P[y]};



reserve N for Cardinal;
reserve M for Aleph;
reserve X for non empty set;
reserve Y,Z,Z1,Z2,Y1,Y2,Y3,Y4 for Subset of X;
reserve S for Subset-Family of X;
reserve x for set;



theorem 
  { X } is non empty Subset-Family of X & not {} in { X } & for Y1,
Y2 holds (Y1 in { X } & Y2 in { X } implies Y1 /\ Y2 in { X }) & ( Y1 in { X }
  & Y1 c= Y2 implies Y2 in { X });

definition
  let X;
  mode Filter of X -> non empty Subset-Family of X means


    (not {} in it)
& for Y1,Y2 holds (Y1 in it & Y2 in it implies Y1 /\ Y2 in it) & ( Y1 in it &
    Y1 c= Y2 implies Y2 in it);
end;

theorem 
  for F being set holds F is Filter of X iff (F is non empty
  Subset-Family of X & not {} in F & for Y1,Y2 holds (Y1 in F & Y2 in F implies
  Y1 /\ Y2 in F) & ( Y1 in F & Y1 c= Y2 implies Y2 in F));

theorem 
  { X } is Filter of X;

reserve F,Uf for Filter of X;

theorem 
  X in F;

theorem 
  Y in F implies not (X \ Y) in F;

theorem 
  for I being non empty Subset-Family of X st (for Y holds Y in I
iff Y` in F) holds (not X in I) & for Y1,Y2 holds (Y1 in I & Y2 in I implies Y1
  \/ Y2 in I) & ( Y1 in I & Y2 c= Y1 implies Y2 in I);

notation
  let X,S;
  synonym dual S for COMPLEMENT S;
end;

reserve S for non empty Subset-Family of X;

registration
  let X,S;
  cluster COMPLEMENT S -> non empty;
end;

theorem 
  dual S = {Y:Y` in S};

theorem 
  dual S = {Y`:Y in S};

definition
  let X;
  mode Ideal of X -> non empty Subset-Family of X means


    (not X in it) &
for Y1,Y2 holds (Y1 in it & Y2 in it implies Y1 \/ Y2 in it) & ( Y1 in it & Y2
    c= Y1 implies Y2 in it);
end;

definition
  let X,F;
  redefine func dual F -> Ideal of X;
end;

reserve I for Ideal of X;

theorem 
  (for Y holds not (Y in F & Y in dual F)) & for Y holds not (Y in
  I & Y in dual I);

theorem 
  {} in I;

definition
  let X,N,S;
  pred S is_multiplicative_with N means


  for S1 being non empty set st S1 c= S & card S1 in N holds meet S1 in S;
end;

definition
  let X,N,S;
  pred S is_additive_with N means


  for S1 being non empty set st S1 c= S & card S1 in N holds union S1 in S;
end;

notation
  let X,N,F;
  synonym F is_complete_with N for F is_multiplicative_with N;
end;

notation
  let X,N,I;
  synonym I is_complete_with N for I is_additive_with N;
end;

theorem 
  S is_multiplicative_with N implies dual S is_additive_with N;

definition
  let X,F;
  attr F is uniform means


  for Y holds Y in F implies card Y = card X;
  attr F is principal means


  ex Y st Y in F & for Z holds Z in F implies Y c= Z;
  attr F is being_ultrafilter means


  for Y holds Y in F or (X \ Y) in F;
end;

definition
  let X,F,Z;
  func Extend_Filter(F,Z) -> non empty Subset-Family of X equals

  {Y: ex Y2 st
  (Y2 in {Y1 /\ Z : Y1 in F} & Y2 c= Y)};
end;

theorem 
  for Z1 holds ( Z1 in Extend_Filter(F,Z) iff ex Z2 st Z2 in F & Z2 /\ Z c= Z1)
;

theorem 
  (for Y1 st Y1 in F holds Y1 meets Z) implies Z in Extend_Filter(
  F,Z) & Extend_Filter(F,Z) is Filter of X & F c= Extend_Filter(F,Z);

reserve S,S1 for Subset-Family of X;

definition
  let X;
  func Filters(X) -> non empty Subset-Family of bool X equals

  {S where S is
  Subset-Family of X : S is Filter of X};
end;

theorem 
  for S being set holds S in Filters(X) iff S is Filter of X;

reserve FS for non empty Subset of Filters(X);

theorem 
  FS is c=-linear implies union FS is Filter of X;

theorem 
  for F ex Uf st F c= Uf & Uf is being_ultrafilter;

reserve X for infinite set;
reserve Y,Y1,Y2,Z for Subset of X;
reserve F,Uf for Filter of X;

definition
  let X;
  func Frechet_Filter(X) -> Filter of X equals

  { Y : card (X \ Y) in card X};
end;

definition
  let X;
  func Frechet_Ideal(X) -> Ideal of X equals

  dual Frechet_Filter(X);
end;

theorem 
  Y in Frechet_Filter(X) iff card (X \ Y) in card X;

theorem 
  Y in Frechet_Ideal(X) iff card Y in card X;

theorem 
  Frechet_Filter(X) c= F implies F is uniform;

theorem 
  Uf is uniform being_ultrafilter implies Frechet_Filter(X) c= Uf;

registration
  let X;
  cluster non principal being_ultrafilter for Filter of X;
end;

registration
  let X;
  cluster uniform being_ultrafilter -> non principal for Filter of X;
end;

theorem 
  for F being being_ultrafilter Filter of X for Y holds Y in F iff
  not Y in dual F;

reserve x for Element of X;

theorem 
  F is non principal being_ultrafilter & F is_complete_with card X
  implies F is uniform;

begin 

theorem 
  nextcard N c= exp(2,N);

definition
  pred GCH means


  for N being Aleph holds nextcard N = exp(2,N);
end;

definition
  let IT be Aleph;
  attr IT is inaccessible means


  IT is regular limit_cardinal;
end;

registration
  cluster inaccessible -> regular limit_cardinal for Aleph;
end;

theorem 
  omega is inaccessible;

definition
  let IT be Aleph;
  attr IT is strong_limit means


  for N st N in IT holds exp(2,N) in IT;
end;

theorem 
  omega is strong_limit;

theorem 
  M is strong_limit implies M is limit_cardinal;

registration
  cluster strong_limit -> limit_cardinal for Aleph;
end;

theorem 
  GCH implies (M is limit_cardinal implies M is strong_limit);

definition
  let IT be Aleph;
  attr IT is strongly_inaccessible means


  IT is regular strong_limit;
end;

registration
  cluster strongly_inaccessible -> regular strong_limit for Aleph;
end;

theorem 
  omega is strongly_inaccessible;

theorem 
  M is strongly_inaccessible implies M is inaccessible;

registration
  cluster strongly_inaccessible -> inaccessible for Aleph;
end;

theorem 
  GCH implies ( M is inaccessible implies M is strongly_inaccessible);

definition
  let M;
  attr M is measurable means


  ex Uf being Filter of M st Uf
  is_complete_with M & Uf is non principal being_ultrafilter;
end;

theorem 
  for A being limit_ordinal Ordinal for X being set st X c= A
  holds sup X = A implies union X = A;

theorem 
  M is measurable implies M is regular;

registration
  let M;
  cluster nextcard M -> non limit_cardinal;
end;

registration
  cluster non limit_cardinal infinite for Cardinal;
end;

registration
  cluster non limit_cardinal -> regular for Aleph;
end;

definition
  let M be non limit_cardinal Cardinal;
  func predecessor M -> Cardinal means


  M = nextcard it;
end;

registration
  let M be non limit_cardinal Aleph;
  cluster predecessor M -> infinite;
end;

definition 
  let X be set;
  let N,N1 be Cardinal;
  mode Inf_Matrix of N,N1,X is Function of [:N,N1:],X;
end;

reserve X for set;
reserve M for non limit_cardinal Aleph;
reserve F for Filter of M;
reserve N1,N2,N3 for Element of predecessor M;
reserve K1,K2 for Element of M;
reserve T for Inf_Matrix of predecessor M, M, bool M;

definition 
  let M,T;
  pred T is_Ulam_Matrix_of M means


  (for N1,K1,K2 holds K1<>K2 implies
T.(N1,K1) /\ T.(N1,K2) is empty ) & (for K1,N1,N2 holds N1<>N2 implies T.(N1,K1
) /\ T.(N2,K1) is empty ) & (for N1 holds card (M \ union {T.(N1,K1): K1 in M})
c= predecessor M ) & for K1 holds card (M \ union {T.(N1,K1): N1 in predecessor
  M}) c= predecessor M;
end;



theorem 
  ex T st T is_Ulam_Matrix_of M;

theorem 
  for M for I being Ideal of M st I is_complete_with M &
  Frechet_Ideal(M) c= I ex S being Subset-Family of M st card S = M & ( for X1
being set st X1 in S holds not X1 in I ) & for X1,X2 being set st X1 in S & X2
  in S & X1 <> X2 holds X1 misses X2;

theorem 
  for X for N being Cardinal st N c= card X ex Y being set st Y c=
  X & card Y = N;

theorem 
  for M holds not ex F st F is uniform being_ultrafilter & F is_complete_with M
;

reserve M for Aleph;

theorem 
  M is measurable implies M is limit_cardinal;

theorem 
  M is measurable implies M is inaccessible;

theorem 
  M is measurable implies M is strong_limit;

theorem 
  M is measurable implies M is strongly_inaccessible;














begin

theorem 
  for i,n being Nat, D being non empty set, d being Element of D, z
  being Tuple of n,D st i in Seg n holds (z^<*d*>)/.i=z/.i;

theorem 
  for n being Nat, D being non empty set, d being Element of D, z
  being Tuple of n,D holds (z^<*d*>)/.(n+1)=d;

definition
  let x, y be Element of BOOLEAN;
  redefine func x 'or' y -> Element of BOOLEAN;
  redefine func x 'xor' y -> Element of BOOLEAN;
end;

reserve x,y,z for boolean set;

theorem 
  x 'or' FALSE = x;

theorem 
  'not' (x '&' y) = 'not' x 'or' 'not' y;

theorem 
  'not' (x 'or' y) = 'not' x '&' 'not' y;

theorem 
  x '&' y = 'not' ('not' x 'or' 'not' y);

theorem 
  TRUE 'xor' x = 'not' x;

theorem 
  FALSE 'xor' x = x;

theorem 
  x '&' x = x;

theorem 
  x 'or' TRUE = TRUE;

theorem 
  (x 'or' y) 'or' z = x 'or' (y 'or' z);

theorem 
  x 'or' x = x;

theorem 
  TRUE 'xor' FALSE = TRUE;

reserve i,j,k for Nat;
reserve n for non zero Nat;
reserve x,y,z1,z2 for Tuple of n, BOOLEAN;

definition

  let n be Nat, x be Tuple of n, BOOLEAN;
  func 'not' x -> Tuple of n, BOOLEAN means

  for i st i in Seg n holds it/.i = 'not' (x/.i);
end;

definition
  let n be non empty Nat, x, y be Tuple of n, BOOLEAN;
  func carry(x, y) -> Tuple of n, BOOLEAN means


  it/.1 = FALSE & for i
being Nat st 1 <= i & i < n holds it/.(i+1) = (x/.i) '&' (y/.i) 'or' (x/.i) '&'
  (it/.i) 'or' (y/.i) '&' (it/.i);
end;

definition
  let n be Nat, x be Tuple of n, BOOLEAN;
  func Binary(x) -> Tuple of n, NAT means


  for i st i in Seg n holds it /.i = IFEQ(x/.i,FALSE,0,2 to_power(i-'1));
end;

definition
  let n be Nat, x be Tuple of n, BOOLEAN;
  func Absval (x) -> Element of NAT equals

  addnat $$ Binary (x);
end;

definition
  let n, x, y;
  func x + y -> Tuple of n, BOOLEAN means


  for i st i in Seg n holds it /.i = (x/.i) 'xor' (y/.i) 'xor' (carry(x,y)/.i);
end;

definition
  let n,z1,z2;
  func add_ovfl(z1,z2) -> Element of BOOLEAN equals

  (z1/.n) '&' (z2/.n) 'or' (
  z1/.n) '&' (carry(z1,z2)/.n) 'or' (z2/.n) '&' (carry(z1,z2)/.n);
end;

definition
  let n,z1,z2;
  pred z1,z2 are_summable means


  add_ovfl(z1,z2) = FALSE;
end;

theorem 
  for z1 being Tuple of 1,BOOLEAN holds z1= <*FALSE*> or z1=<*TRUE *>;

theorem 
  for z1 being Tuple of 1,BOOLEAN holds z1=<*FALSE*> implies Absval(z1) = 0;

theorem 
  for z1 being Tuple of 1,BOOLEAN st z1=<*TRUE*> holds Absval(z1)= 1;

definition
  let n1,n2 be Nat;
  let D be non empty set;
  let z1 be Tuple of n1,D;
  let z2 be Tuple of n2,D;
  redefine func z1 ^ z2 -> Tuple of n1+n2,D;
end;

definition
  let D be non empty set;
  let d be Element of D;
  redefine func <* d *> -> Tuple of 1,D;
end;

theorem 
  for z1,z2 being Tuple of n,BOOLEAN holds for d1,d2 being Element
of BOOLEAN holds for i being Nat holds i in Seg n implies carry(z1^<*d1*>,z2^<*
  d2*>)/.i = carry(z1,z2)/.i;

theorem 
  for z1,z2 being Tuple of n,BOOLEAN, d1,d2 being Element of
  BOOLEAN holds add_ovfl(z1,z2) = carry(z1^<*d1*>,z2^<*d2*>)/.(n+1);

theorem 
  for z1,z2 being Tuple of n,BOOLEAN, d1,d2 being Element of
BOOLEAN holds z1^<*d1*> + z2^<*d2*> = (z1+z2)^<*d1 'xor' d2 'xor' add_ovfl(z1,
  z2)*>;

theorem 
  for z being Tuple of n,BOOLEAN, d being Element of BOOLEAN holds
  Absval(z^<*d*>) = Absval(z)+IFEQ(d,FALSE,0,2 to_power n);

theorem 
  for n for z1,z2 being Tuple of n,BOOLEAN holds Absval(z1+z2) +
  IFEQ(add_ovfl(z1,z2),FALSE,0,2 to_power (n)) = Absval(z1) + Absval(z2);

theorem 
  for z1,z2 being Tuple of n,BOOLEAN st z1,z2 are_summable holds Absval(
  z1+z2) = Absval(z1) + Absval(z2);














begin

scheme 

  FraenkelFinIm{ A() -> finite non empty set, F(set) -> set, P[set] }: { F(x)
  where x is Element of A() : P[x] } is finite;

theorem 
  for f being Function, x, y being set st dom f = {x} & rng f = {y}
  holds f = { [x,y] };

begin





theorem 
  for I being set, MSS being ManySortedSet of I holds MSS#.<*>I = {{}};

reserve i,j,x,y for set,
  f,g for Function;

scheme 

  MSSLambda2Part { I() -> set, P [set], F, G (set) -> set }: ex f being
  ManySortedSet of I() st for i being Element of I() st i in I() holds (P[i]
  implies f.i = F(i)) & (not P[i] implies f.i = G(i));

registration
  let I be set;
  cluster non-empty finite-yielding for ManySortedSet of I;
end;

registration
  let I be set, M be ManySortedSet of I, A be Subset of I;
  cluster M | A -> total for A-defined Function;
end;

registration
  let I be set, M be ManySortedSet of I, A be Subset of I;
  cluster M | A -> total;
end;

registration
  let M be non-empty Function, A be set;
  cluster M | A -> non-empty;
end;

theorem 
  for I being non empty set, B being non-empty ManySortedSet of I
  holds union rng B is non empty;

theorem 
  for I being set holds uncurry (I --> {}) = {};

theorem 
  for I being non empty set, A being set, B being non-empty
ManySortedSet of I, F being ManySortedFunction of (I --> A qua total I-defined
  Function), B holds dom commute F = A;

scheme 

  LambdaRecCorrD {D() -> non empty set, A() -> Element of D(), F(Nat, Element
  of D()) -> Element of D() } : (ex f being Function of NAT, D() st f.0 = A() &
for i being Nat holds f.(i+1) = F(i, f.i)) & for f1, f2 being Function of NAT,
D() st (f1.0 = A() & for i being Nat holds f1.(i+1) = F(i, f1.i)) & (f2.0 = A()
  & for i being Nat holds f2.(i+1) = F(i,f2.i)) holds f1 = f2;

scheme 

  LambdaMSFD{J() -> non empty set, I() -> Subset of J(), A, B() ->
ManySortedSet of I(), F(set) -> set } : ex f being ManySortedFunction of A(), B
  () st for i being Element of J() st i in I() holds f.i = F(i)
provided
 for i being Element of J() st i in I() holds F(i) is Function of A()
.i, B().i;

theorem 
  for I being set, f being non-empty ManySortedSet of I, g being
Function , s being Element of product f st dom g c= dom f & for x being set st
  x in dom g holds g.x in f.x holds s+*g is Element of product f;

theorem 
  for A, B being non empty set, C being non-empty ManySortedSet of A,
  InpFs being ManySortedFunction of A --> B, C, b being Element of B ex c being
  ManySortedSet of A st c = (commute InpFs).b & c in C;

theorem 
  for n being Element of NAT, a being set holds product ( n |-> {a} ) =
  { n |-> a };

begin





reserve T,T1 for finite Tree,
  t,p for Element of T,
  t1 for Element of T1;

registration
  let D be non empty set;
  cluster -> finite for Element of FinTrees D;
end;

registration
  let T be finite DecoratedTree;
  let t be Element of dom T;
  cluster T|t -> finite;
end;

theorem 
  T|p,{ t : p is_a_prefix_of t } are_equipotent;

registration
  let T be finite DecoratedTree-like Function;
  let t be Element of dom T;
  let T1 be finite DecoratedTree;
  cluster T with-replacement (t,T1) -> finite;
end;

theorem 
  T with-replacement (p,T1) = { t : not p is_a_prefix_of t } \/ {
  p^t1 : not contradiction };

theorem 
  for f being FinSequence of NAT st f in T with-replacement (p,T1)
  & p is_a_prefix_of f ex t1 st f = p^t1;

theorem 
  for p being Tree-yielding FinSequence, k being Element of NAT st
  k+1 in dom p holds (tree p)|<*k*> = p.(k+1);

theorem 
  for q being DTree-yielding FinSequence, k being Element of NAT st k+1
  in dom q holds <*k*> in tree doms q;

theorem 
  for p,q being Tree-yielding FinSequence, k being Element of NAT
st len p = len q & k+1 in dom p & for i being Element of NAT st i in dom p & i
<> k+1 holds p.i = q.i for t being Tree st q.(k+1) = t holds tree(q) = tree(p)
  with-replacement (<*k*>, t);

theorem 
  for e1,e2 being finite DecoratedTree, x being set, k being Element of
NAT, p being DTree-yielding FinSequence st <*k*> in dom e1 & e1 = x-tree p ex q
being DTree-yielding FinSequence st e1 with-replacement (<*k*>,e2) = x-tree q &
len q = len p & q.(k+1) = e2 & for i being Element of NAT st i in dom p & i <>
  k+1 holds q.i = p.i;

theorem 
  for T being finite Tree, p being Element of T st p <> {} holds card (T
  |p) < card T;

theorem 
  for T, T1 being finite Tree, p being Element of T holds card(T
  with-replacement (p,T1)) + card (T|p) = card T + card T1;

theorem 
  for T, T1 being finite DecoratedTree, p being Element of dom T holds
  card(T with-replacement (p,T1)) + card (T|p) = card T + card T1;

registration
  let x be set;
  cluster root-tree x -> finite;
end;

theorem 
  for x being set holds card root-tree x = 1;

begin 


theorem 
  for F being non empty finite set holds card F - 1 = card F -' 1;



theorem 
  for f, g being Function holds dom f,dom g are_equipotent iff f,g
  are_equipotent;

theorem 
  for f, g being finite Function st dom f misses dom g holds card (f +*
  g) = card f + card g;



theorem 
  for n being Nat holds
  {k where k is Element of NAT: k > n} is infinite;















begin 

reserve x,y,z for set;

registration
  let x,y,z;
  cluster <*x,y,z*> -> non trivial;
end;

registration
  let f be non empty FinSequence;
  cluster Rev f -> non empty;
end;

begin

reserve f,f1,f2,f3 for FinSequence,
  p,p1,p2,p3 for set,
  i,k for Nat;

theorem 
  for X being set, i st X c= Seg i & 1 in X holds (Sgm X).1 = 1;

theorem 
  for f being FinSequence holds k in dom f & (for i st 1 <= i & i <
  k holds f.i <> f.k) implies (f.k)..f = k;

theorem 
  <*p1,p2*>| Seg 1 = <*p1*>;

theorem 
  <*p1,p2,p3*>| Seg 1 = <*p1*>;

theorem 
  <*p1,p2,p3*>| Seg 2 = <*p1,p2*>;

theorem 
  p in rng f1 implies p..(f1^f2) = p..f1;

theorem 
  p in rng f2 \ rng f1 implies p..(f1^f2) = len f1 + p..f2;

theorem 
  p in rng f1 implies (f1^f2)|--p = (f1|--p)^f2;

theorem 
  p in rng f2 \ rng f1 implies (f1^f2)|--p = f2|--p;

theorem 
  f1 c= f1^f2;

theorem 
  for A being set st A c= dom f1 holds (f1^f2)|A = f1 | A;

theorem 
  p in rng f1 implies (f1^f2)-|p = f1-|p;

registration
  let f1;
  let i be Nat;
  cluster f1|Seg i -> FinSequence-like;
end;

theorem 
  f1 c= f2 implies f3^f1 c= f3^f2;

theorem 
  (f1^f2)|Seg(len f1 + i) = f1^(f2|Seg i);

theorem 
  p in rng f2 \ rng f1 implies (f1^f2)-|p = f1^(f2-|p);

theorem 
  f1^f2 just_once_values p implies p in rng f1 \+\ rng f2;

theorem 
  f1^f2 just_once_values p & p in rng f1 implies f1 just_once_values p;

theorem 
  p..<*p*> = 1;

theorem 
  p1..<*p1,p2*> = 1;

theorem 
  p1 <> p2 implies p2..<*p1,p2*> = 2;

theorem 
  p1..<*p1,p2,p3*> = 1;

theorem 
  p1 <> p2 implies p2..<*p1,p2,p3*> = 2;

theorem 
  p1 <> p3 & p2 <> p3 implies p3..<*p1,p2,p3*> = 3;

theorem 
  for f being FinSequence holds Rev(<*p*>^f) = Rev f ^ <*p*>;

theorem 
  for f being FinSequence holds Rev Rev f = f;

theorem 
  x <> y implies <*x,y*> -| y = <*x*>;

theorem 
  x <> y implies <*x,y,z*> -| y = <*x*>;

theorem 
  x <> z & y <> z implies <*x,y,z*> -| z = <*x,y*>;

theorem 
  <*x,y*>|--x = <*y*>;

theorem 
  x <> y implies <*x,y,z*>|--y = <*z*>;

theorem 
  <*x,y,z*>|--x = <*y,z*>;

theorem 
  <*z*>|--z = {} & <*z*>-|z = {};

theorem 
  x <> y implies <*x,y*> |-- y = {};

theorem 
  x <> z & y <> z implies <*x,y,z*> |-- z = {};

theorem 
  x in rng f & y in rng(f-|x) implies f-|x-|y = f-|y;

theorem 
  not x in rng f1 implies x..(f1^<*x*>^f2) = len f1 + 1;

theorem 
  f just_once_values x implies x..f + x..Rev f = len f + 1;

theorem 
  f just_once_values x implies Rev(f-|x) = Rev f |--x;

theorem 
  f just_once_values x implies Rev f just_once_values x;

begin

reserve D for non empty set,
  p,p1,p2,p3 for Element of D,
  f,f1,f2 for FinSequence of D;

theorem 
  p in rng f implies f-:p = (f -| p)^<*p*>;

theorem 
  p in rng f implies f:-p = <*p*>^(f |-- p);

theorem 
  f <> {} implies f/.1 in rng f;

theorem 
  f <> {} implies f/.1..f = 1;

theorem 
  f <> {} & f/.1 = p implies f-:p = <*p*> & f:-p = f;

theorem 
  (<*p1*>^f)/^1 = f;

theorem 
  <*p1,p2*>/^1 = <*p2*>;

theorem 
  <*p1,p2,p3*>/^1 = <*p2,p3*>;

theorem 
  k in dom f & (for i st 1 <= i & i < k holds f/.i <> f/.k) implies f/.k..f = k
;

theorem 
  p1 <> p2 implies <*p1,p2*>-:p2 = <*p1,p2*>;

theorem 
  p1 <> p2 implies <*p1,p2,p3*>-:p2 = <*p1,p2*>;

theorem 
  p1 <> p3 & p2 <> p3 implies <*p1,p2,p3*>-:p3 = <*p1,p2,p3*>;

theorem 
  <*p*>:-p = <*p*> & <*p*>-:p = <*p*>;

theorem 
  p1 <> p2 implies <*p1,p2*>:-p2 = <*p2*>;

theorem 
  p1 <> p2 implies <*p1,p2,p3*>:-p2 = <*p2,p3*>;

theorem 
  p1 <> p3 & p2 <> p3 implies <*p1,p2,p3*>:-p3 = <*p3*>;

theorem 
  p in rng f & p..f > k implies p..f = k + p..(f/^k);

theorem 
  p in rng f & p..f > k implies p in rng(f/^k);

theorem 
  k < i & i in dom f implies f/.i in rng(f/^k);

theorem 
  p in rng f & p..f > k implies (f/^k)-:p = (f-:p)/^k;

theorem 
  p in rng f & p..f <> 1 implies (f/^1)-:p = (f-:p)/^1;

theorem 
  p in rng(f:-p);

theorem 
  x in rng f & p in rng f & x..f >= p..f implies x in rng(f:-p);

theorem 
  p in rng f & k <= len f & k >= p..f implies f/.k in rng(f:-p);

theorem 
  p in rng f1 implies (f1^f2):-p = (f1:-p)^f2;

theorem 
  p in rng f2 \ rng f1 implies (f1^f2):-p = f2:-p;

theorem 
  p in rng f1 implies (f1^f2)-:p = f1-:p;

theorem 
  p in rng f2 \ rng f1 implies (f1^f2)-:p = f1^(f2-:p);

theorem 
  f:-p:-p = f:-p;

theorem 
  p1 in rng f & p2 in rng f \ rng(f-:p1) implies f|--p2 = f|--p1 |--p2;

theorem 
  p in rng f implies rng f = rng(f-:p) \/ rng(f:-p);

theorem 
  p1 in rng f & p2 in rng f \ rng(f-:p1) implies f:-p1:-p2 = f:-p2;

theorem 
  p in rng f implies p..(f-:p) = p..f;

theorem 
  f|i|i = f|i;

theorem 
  p in rng f implies f-:p-:p = f-:p;

theorem 
  p1 in rng f & p2 in rng(f-:p1) implies f-:p1-:p2 = f-:p2;

theorem 
  p in rng f implies (f-:p)^((f:-p)/^1) = f;

theorem 
  f1 <> {} implies (f1^f2)/^1 = (f1/^1)^f2;

theorem 
  p2 in rng f & p2..f <> 1 implies p2 in rng(f/^1);

theorem 
  p..(f:-p) = 1;

theorem 
  <*>D/^k = <*>D;

theorem 
  f/^(i+k) = f/^i/^k;

theorem 
  p in rng f & p..f > k implies (f/^k):-p = f:-p;

theorem 
  p in rng f & p..f <> 1 implies (f/^1):-p = f:-p;

theorem 
  i + k = len f implies Rev(f/^k) = Rev f|i;

theorem 
  i + k = len f implies Rev(f|k) = Rev f/^i;

theorem 
  f just_once_values p implies Rev(f|--p) = Rev f -|p;

theorem 
  f just_once_values p implies Rev(f:-p) = Rev f -:p;

theorem 
  f just_once_values p implies Rev(f-:p) = Rev f :-p;

begin 

definition
  let D be non empty set;
  let IT be FinSequence of D;
  attr IT is circular means


  IT/.1 = IT/.len IT;
end;

definition
  let D,f,p;
  func Rotate(f,p) -> FinSequence of D equals


  (f:-p)^((f-:p)/^1) if p
  in rng f otherwise f;
end;

registration
  let D;
  let f be non empty FinSequence of D, p be Element of D;
  cluster Rotate(f,p) -> non empty;
end;

registration
  let D;
  cluster circular 1-element for FinSequence of D;
  cluster circular non trivial for FinSequence of D;
end;

theorem 
  Rotate(f,f/.1) = f;

registration
  let D,p;
  let f be circular non empty FinSequence of D;
  cluster Rotate(f,p) -> circular;
end;

theorem 
  f is circular & p in rng f implies rng Rotate(f,p) = rng f;

theorem 
  p in rng f implies p in rng Rotate(f,p);

theorem 
  p in rng f implies (Rotate(f,p))/.1 = p;

theorem 
  Rotate(Rotate(f,p),p) = Rotate(f,p);

theorem 
  Rotate(<*p*>,p) = <*p*>;

theorem 
  Rotate(<*p1,p2*>,p1) = <*p1,p2*>;

theorem 
  Rotate(<*p1,p2*>,p2) = <*p2,p2*>;

theorem 
  Rotate(<*p1,p2,p3*>,p1) = <*p1,p2,p3*>;

theorem 
  p1 <> p2 implies Rotate(<*p1,p2,p3*>,p2) = <*p2,p3,p2*>;

theorem 
  p2 <> p3 implies Rotate(<*p1,p2,p3*>,p3) = <*p3,p2,p3*>;

theorem 
  for f being circular non trivial FinSequence of D holds rng(f/^1) = rng f;

theorem 
  rng(f/^1) c= rng Rotate(f,p);

theorem 
  p2 in rng f \ rng(f-:p1) implies Rotate(Rotate(f,p1),p2) = Rotate(f,p2);

theorem 
  p2..f <> 1 & p2 in rng f \ rng(f:-p1) implies Rotate(Rotate(f,
  p1),p2) = Rotate(f,p2);

theorem 
  p2 in rng(f/^1) & f just_once_values p2 implies Rotate(Rotate(f
  ,p1),p2) = Rotate(f,p2);

theorem 
  f is circular & f just_once_values p2 implies Rotate(Rotate(f,p1),p2)
  = Rotate(f,p2);

theorem 
  f is circular & f just_once_values p implies Rev Rotate(f,p) = Rotate(
  Rev f,p);

begin 


theorem 
  for f being trivial FinSequence of D holds f is empty or ex x being
  Element of D st f = <*x*>;

begin 

reserve D for non empty set;

theorem 
  for i be Nat for p,q being FinSequence st len p<i & (i<=len p +
  len q or i<=len (p^q)) holds (p^q).i=q.(i-len p);

theorem 
  for x being set,f being FinSequence of D st 1<=len f holds (f^<*
x*>).1=f.1 & (f^<*x*>).1=f/.1 & (<*x*>^f).(len f +1)=f.len f & (<*x*>^f).(len f
  +1)=f/.len f;

theorem 
  for f being FinSequence st len f=1 holds Rev f=f;

theorem 
  for f being FinSequence of D,k being Nat holds len (f/^k)=len f-'k;

theorem 
  for f being FinSequence of D,l1,l2 being Nat holds (f/^l1)|(l2-'l1)=(f
  |l2)/^l1;

definition
  let f be FinSequence,k1,k2 be Nat;
  func mid(f,k1,k2) -> FinSequence equals


  (f/^(k1-'1))|(k2-'k1+1)
  if k1<=k2 otherwise Rev ((f/^(k2-'1))|(k1-'k2+1));
end;

definition
  let D;
  let f be FinSequence of D,k1,k2 be Nat;
  redefine func mid(f,k1,k2) -> FinSequence of D;
end;

theorem 
  for f being FinSequence of D,k1,k2 being Element of NAT st 1<=k1
  & k1<=len f & 1<=k2 & k2<=len f holds Rev mid(f,k1,k2)=mid(Rev f,len f-'k2+1,
  len f-'k1+1);

theorem 
  for n,m being Element of NAT,f being FinSequence of D st 1<= m &
  m+n<=len f holds (f/^n).m=f.(m+n);

theorem 
  for i being Element of NAT,f being FinSequence of D st 1<=i & i
  <=len f holds (Rev f).i=f.(len f -i+1);

theorem 
  for f being FinSequence of D,k being Nat st 1<=k holds mid(f,1,k)=f|k;

theorem 
  for f being FinSequence of D,k being Element of NAT st k<=len f
  holds mid(f,k,len f)=f/^(k-'1);

theorem 
  for f being FinSequence of D,k1,k2 being Element of NAT st 1<=k1
& k1<=len f & 1<=k2 & k2<=len f holds mid(f,k1,k2).1=f.k1 & (k1<=k2 implies len
mid(f,k1,k2) = k2 -' k1 +1 & for i being Element of NAT st 1<=i & i<=len mid(f,
k1,k2) holds mid(f,k1,k2).i=f.(i+k1-'1)) & (k1>k2 implies len mid(f,k1,k2) = k1
-' k2 +1 & for i being Element of NAT st 1<=i & i<=len mid(f,k1,k2) holds mid(f
  ,k1,k2).i=f.(k1-'i+1));

theorem 
  for f being FinSequence of D,k1,k2 being Element of NAT holds
  rng mid(f,k1,k2) c= rng f;

theorem 
  for f being FinSequence of D st 1<=len f holds mid(f,1,len f)=f;

theorem 
  for f being FinSequence of D st 1<=len f holds mid(f,len f,1)=Rev f;

theorem 
  for f being FinSequence of D, k1,k2,i being Element of NAT st 1
  <=k1 & k1<=k2 & k2<=len f & 1<=i & (i<=k2-'k1+1 or i<=k2-k1+1 or i<=k2+1-k1)
holds mid(f,k1,k2).i=f.(i+k1-'1) & mid(f,k1,k2).i=f.(i-'1+k1) & mid(f,k1,k2).i=
  f.(i+k1-1) & mid(f,k1,k2).i=f.(i-1+k1);

theorem 
  for f being FinSequence of D,k,i being Nat st 1<=i & i<=k & k<=
  len f holds mid(f,1,k).i=f.i;

theorem 
  for f being FinSequence of D, k1,k2 being Element of NAT st 1<=k1 & k1
  <=k2 & k2<=len f holds len mid(f,k1,k2)<=len f;

theorem 
  for D for f being FinSequence of D, k being Element of NAT, p
  being Element of D holds (<*p*>^f)|(k+1) = <*p*>^(f|k);

theorem 
  for D for f being FinSequence of D, k1,k2 being Element of NAT
  st k1 < k2 & k1 in dom f holds mid(f,k1,k2) = <*f.k1*>^ mid(f,k1+1,k2);















begin 

reserve x, y, I for set,
  A, B, X, Y for ManySortedSet of I;

definition
  let I, A;
  func bool A -> ManySortedSet of I means


  for i be set st i in I holds it.i = bool (A.i);
end;

registration
  let I, A;
  cluster bool A -> non-empty;
end;

theorem 
  X = bool Y iff for A holds A in X iff A c= Y;

theorem 
  bool [[0]]I = I --> {{}};

theorem 
  bool (I --> x) = I --> bool x;

theorem 
  bool (I --> {x}) = I --> { {} , {x} };

theorem 
  [[0]]I c= A;

theorem 
  A c= B implies bool A c= bool B;

theorem 
  bool A \/ bool B c= bool (A \/ B);

theorem 
  bool A \/ bool B = bool (A \/ B) implies for i be set st i in I holds
  A.i,B.i are_c=-comparable;

theorem 
  bool (A /\ B) = bool A /\ bool B;

theorem 
  bool (A \ B) c= (I --> {{}}) \/ (bool A \ bool B);

theorem 
  X c= A \ B iff X c= A & X misses B;

theorem 
  bool (A \ B) \/ bool (B \ A) c= bool (A \+\ B);

theorem 
  X c= A \+\ B iff X c= A \/ B & X misses A /\ B;

theorem 
  X c= A or Y c= A implies X /\ Y c= A;

theorem 
  X c= A implies X \ Y c= A;

theorem 
  X c= A & Y c= A implies X \+\ Y c= A;

theorem 
  [|X, Y|] c= bool bool (X \/ Y);

theorem 
  X c= A iff X in bool A;

theorem 
  (Funcs)(A,B) c= bool [|A, B|];

begin 

definition
  let I, A;
  func union A -> ManySortedSet of I means


  for i be set st i in I holds it.i = union (A.i);
end;

registration
  let I;
  cluster union [[0]]I -> empty-yielding;
end;

theorem 
  A in union X iff ex Y st A in Y & Y in X;

theorem 
  union [[0]]I = [[0]]I;

theorem 
  union (I --> x) = I --> union x;

theorem 
  union (I --> {x}) = I --> x;

theorem 
  union (I --> { {x},{y} }) = I --> {x,y};

theorem 
  X in A implies X c= union A;

theorem 
  A c= B implies union A c= union B;

theorem 
  union (A \/ B) = union A \/ union B;

theorem 
  union (A /\ B) c= union A /\ union B;

theorem 
  union bool A = A;

theorem 
  A c= bool union A;

theorem 
  union Y c= A & X in Y implies X c= A;

theorem 
  for Z be ManySortedSet of I for A be non-empty ManySortedSet of I
holds (for X be ManySortedSet of I st X in A holds X c= Z) implies union A c= Z
;

theorem 
  for B be ManySortedSet of I for A be non-empty ManySortedSet of I
holds (for X be ManySortedSet of I st X in A holds X /\ B = [[0]]
I) implies union
  (A) /\ B = [[0]]I;

theorem 
  for A, B be ManySortedSet of I st A \/ B is non-empty holds (for X, Y
be ManySortedSet of I st X <> Y & X in A \/ B & Y in A \/ B holds X /\ Y =
[[0]]I
  ) implies union(A /\ B) = union A /\ union B;

theorem 
  for A, X be ManySortedSet of I for B be non-empty ManySortedSet of I
holds (X c= union (A \/ B) & for Y be ManySortedSet of I st Y in B holds Y /\ X
  = [[0]]I) implies X c= union A;

theorem 
  for A be finite-yielding non-empty ManySortedSet of I st (for X, Y be
ManySortedSet of I st X in A & Y in A holds X c= Y or Y c= X) holds union A in
  A;














begin 

reserve x,y,z for real number,
  a,b,c,d,e,f,g,h for Nat,
  k,l,m,n,m1,n1,m2,n2 for Integer,
  q for Rational;

theorem 
  x|^2=x*x & (-x)|^2=x|^2;

theorem 
  for a being Nat holds (-x)|^(2*a)=x|^(2*a) & (-x)|^(2*a+1)=-(x|^( 2*a+1));

theorem 
  x>=0 & y>=0 & d>0 & x|^d=y|^d implies x=y;

registration
  let k, a;
  cluster k |^ a -> integer;
end;

theorem 
  k divides m & k divides n implies k divides m+n;

theorem 
  k divides m & k divides n implies k divides m*m1+n*n1;

theorem 
  m gcd n = 1 & k gcd n = 1 implies m*k gcd n = 1;

theorem 
  a gcd b=1 & c gcd b=1 implies a*c gcd b=1;

theorem 
  0 gcd m = abs m & 1 gcd m = 1;

theorem 
  1,k are_relative_prime;

theorem 
  k,l are_relative_prime implies k|^a,l are_relative_prime;

theorem 
  k,l are_relative_prime implies k|^a,l|^b are_relative_prime;

theorem 
  k gcd l = 1 implies k gcd l|^b = 1 & k|^a gcd l|^b = 1;

theorem 
  abs m divides k iff m divides k;

theorem 
  a divides b implies (a|^c) divides (b|^c);

theorem 
  a divides 1 implies a=1;

theorem 
  d divides a & a gcd b = 1 implies d gcd b = 1;

theorem 
  k<>0 implies (k divides l iff l/k is Integer);

theorem 
  a<=b-c implies a<=b & c <=b;

reserve fs,fs1,fs2,fs3 for FinSequence;

definition
  let D be non empty set;
  let D1 be non empty Subset of D;
  let f1,f2 be FinSequence of D1;
  redefine func f1^f2 -> FinSequence of D1;
end;

reserve D for non empty set,
  v,v1,v2,v3 for set,
  fp for FinSequence of NAT,
  fr,fr1,fr2 for FinSequence of INT,
  ft for FinSequence of REAL;

registration
  let fr;
  cluster Product fr -> integer;
end;

definition
  let fp;
  redefine func Sum(fp) -> Element of NAT;
end;

definition
  let fp;
  redefine func Product fp -> Element of NAT;
end;

definition
  let a be Nat,fs;
  redefine func Del (fs,a) means


  it=fs if not a in dom fs otherwise len
it + 1 = len fs & for b holds (b<a implies it.b=fs.b) & (b>=a implies it.b=fs.(
  b+1));
end;

definition
  let D;
  let a be Nat;
  let fs be FinSequence of D;
  redefine func Del(fs,a) -> FinSequence of D;
end;

definition
  let D;
  let D1 be non empty Subset of D;
  let a be Nat;
  let fs be FinSequence of D1;
  redefine func Del(fs,a) -> FinSequence of D1;
end;

theorem 
  Del(<*v1*>,1) = {} & Del(<*v1,v2*>,1) = <*v2*> & Del(<*v1,v2*>,2) = <*
v1 *> & Del(<*v1,v2,v3*>,1) = <*v2,v3*> & Del(<*v1,v2,v3*>,2) = <*v1,v3*> & Del
  (<*v1,v2,v3*>,3) = <*v1,v2*>;

theorem 
  a in dom ft implies Sum Del(ft,a)+(ft.a)=Sum(ft);

theorem 
  a in dom fp implies Product(fp)/fp.a is Element of NAT;



theorem 
  numerator(q),denominator(q) are_relative_prime;

theorem 
  q=k/a & a<>0 & k,a are_relative_prime implies k=numerator(q) & a=
  denominator(q);

theorem 
  (ex q st a=q|^b) implies ex k st a=k|^b;

theorem 
  (ex q st a=q|^d) implies ex b st a=b|^d;

theorem 
  e>0 & (a|^e) divides (b|^e) implies a divides b;

theorem 
  ex m,n st a gcd b = a*m+b*n;

theorem 
  ex m1,n1 st m gcd n = m*m1+n*n1;

theorem 
  m divides n*k & m gcd n=1 implies m divides k;

theorem 
  for a,b,c being Nat holds a gcd b=1 & a divides b*c implies a divides
  c;

theorem 
  a<>0 & b<>0 implies ex c,d st a gcd b=a*c-b*d;

theorem 
  f>0 & g>0 & (f gcd g)=1 & a|^f=b|^g implies ex e st a=e|^g & b=e|^f;

reserve x,y,t for Integer;

theorem 
  (ex x,y st m*x+n*y=k) iff (m gcd n) divides k;

theorem 
  m<>0 & n<>0 & m*m1+n*n1=k implies for x,y st m*x+n*y=k ex t st x=m1+t*
  (n/(m gcd n)) & y=n1-t*(m/(m gcd n));

theorem 
  a gcd b=1 & a*b=c|^d implies ex e,f st a=e|^d & b=f|^d;




theorem 
  for d holds (for a st a in dom fp holds fp.a gcd d=1) implies
  Product(fp) gcd d = 1;

theorem 
  len fp>=2 & (for b,c st b in dom fp & c in dom fp & b<>c holds (fp.b
gcd fp.c)=1) implies for fr st len fr=len fp holds ex fr1 st (len fr1=len fp &
  for b st b in dom fp holds (fp.b)*(fr1.b)+(fr.b)=(fp.1)*(fr1.1)+(fr.1));
:$N Thue Theorem
theorem 
  a<>0 & a gcd k=1 implies ex b,e st 0<>b & 0<>e & b<=sqrt a & e<=sqrt a
  & (a divides (k*b+e) or a divides (k*b-e));

theorem 
  dom Del(fs,a) c= dom fs;

theorem 
  Del (<*v*>^fs, 1) = fs & Del (fs^<*v*>, len fs + 1) = fs;

begin 


reserve n for Nat;

theorem 
  n > 0 & k mod n <> 0 implies - (k div n) = (-k) div n + 1;

theorem 
  n > 0 & k mod n = 0 implies - (k div n) = (-k) div n;














begin 

registration
  cluster finite NAT-defined for Function;
end;

definition
  mode GraphStruct is finite NAT-defined Function;
end;

definition

  func VertexSelector -> Element of NAT equals

  1;
  func EdgeSelector -> Element of NAT equals

  2;
  func SourceSelector -> Element of NAT equals

  3;
  func TargetSelector -> Element of NAT equals

  4;
end;

definition
  func _GraphSelectors -> non empty Subset of NAT equals

  {VertexSelector,
  EdgeSelector, SourceSelector, TargetSelector};
end;

definition
  let G be GraphStruct;
  func the_Vertices_of G equals

  G.VertexSelector;
  func the_Edges_of G equals

  G.EdgeSelector;
  func the_Source_of G equals

  G.SourceSelector;
  func the_Target_of G equals

  G.TargetSelector;
end;

definition
  let G be GraphStruct;
  attr G is [Graph-like] means


  VertexSelector in dom G & EdgeSelector
in dom G & SourceSelector in dom G & TargetSelector in dom G & the_Vertices_of
  G is non empty set & the_Source_of G is Function of the_Edges_of G,
  the_Vertices_of G & the_Target_of G is Function of the_Edges_of G,
  the_Vertices_of G;
end;

registration
  cluster [Graph-like] for GraphStruct;
end;

definition
  mode _Graph is [Graph-like] GraphStruct;
end;

registration
  let G be _Graph;
  cluster the_Vertices_of G -> non empty;
end;

definition
  let G be _Graph;
  redefine func the_Source_of G -> Function of the_Edges_of G,the_Vertices_of
  G;
  redefine func the_Target_of G -> Function of the_Edges_of G,the_Vertices_of
  G;
end;

definition
  let V be non empty set,E be set, S,T be Function of E,V;
  func createGraph(V,E,S,T) -> _Graph equals

  <* V, E, S, T *>;
end;

definition
  let G be GraphStruct, n be Nat, x be set;
  func G.set(n,x) -> GraphStruct equals

  G +* (n .--> x);
end;

registration
  let G be _Graph;
  cluster G|(_GraphSelectors) -> [Graph-like];
end;

definition
  let G be _Graph, x,y,e be set;
  pred e Joins x,y,G means


  e in the_Edges_of G & ( (the_Source_of G).e
= x & (the_Target_of G).e = y or (the_Source_of G).e = y & (the_Target_of G).e
  = x );
end;

definition
  let G be _Graph, x, y, e be set;
  pred e DJoins x,y,G means


  e in the_Edges_of G & (the_Source_of G).e = x & (the_Target_of G).e = y;
end;

definition
  let G be _Graph, X,Y,e be set;
  pred e SJoins X,Y,G means


  e in the_Edges_of G & ( (the_Source_of G).
e in X & (the_Target_of G).e in Y or (the_Source_of G).e in Y & (the_Target_of
  G).e in X );
  pred e DSJoins X,Y,G means


  e in the_Edges_of G & (the_Source_of G).e in X & (the_Target_of G).e in Y;
end;

definition
  let G be _Graph;
  attr G is finite means


  the_Vertices_of G is finite & the_Edges_of G is finite;
  attr G is loopless means


  not ex e being set st e in the_Edges_of G &
  (the_Source_of G).e = (the_Target_of G).e;
  attr G is trivial means


  card the_Vertices_of G = 1;
  attr G is non-multi means


  for e1,e2,v1,v2 being set holds e1 Joins
  v1,v2,G & e2 Joins v1,v2,G implies e1 = e2;
  attr G is non-Dmulti means


  for e1,e2,v1,v2 being set holds e1 DJoins
  v1,v2,G & e2 DJoins v1,v2,G implies e1 = e2;
end;

definition
  let G be _Graph;
  attr G is simple means


  G is loopless & G is non-multi;
  attr G is Dsimple means


  G is loopless & G is non-Dmulti;
end;

registration
  cluster non-multi -> non-Dmulti for _Graph;
  cluster simple -> loopless non-multi for _Graph;
  cluster loopless non-multi -> simple for _Graph;
  cluster loopless non-Dmulti -> Dsimple for _Graph;
  cluster Dsimple -> loopless non-Dmulti for _Graph;
  cluster trivial loopless -> finite for _Graph;
  cluster trivial non-Dmulti -> finite for _Graph;
end;

registration
  cluster trivial simple for _Graph;
  cluster finite non trivial simple for _Graph;
end;

registration
  let G be finite _Graph;
  cluster the_Vertices_of G -> finite;
  cluster the_Edges_of G -> finite;
end;

registration
  let G be trivial _Graph;
  cluster the_Vertices_of G -> finite;
end;

registration
  let V be non empty finite set, E be finite set, S,T be Function of E,V;
  cluster createGraph(V,E,S,T) -> finite;
end;

registration
  let V be non empty set, E be empty set,S,T be Function of E,V;
  cluster createGraph(V,E,S,T) -> simple;
end;

registration
  let v be set, E be set, S,T be Function of E,{v};
  cluster createGraph({v},E,S,T) -> trivial;
end;

definition
  let G be _Graph;
  func G.order() -> Cardinal equals

  card the_Vertices_of G;
end;

definition
  let G be finite _Graph;
  redefine func G.order() -> non empty Element of NAT;
end;

definition
  let G be _Graph;
  func G.size() -> Cardinal equals

  card the_Edges_of G;
end;

definition
  let G be finite _Graph;
  redefine func G.size() -> Element of NAT;
end;

definition
  let G be _Graph, X be set;
  func G.edgesInto(X) -> Subset of the_Edges_of G means


  for e being
  set holds e in it iff e in the_Edges_of G & (the_Target_of G).e in X;
  func G.edgesOutOf(X) -> Subset of the_Edges_of G means


  for e being
  set holds e in it iff e in the_Edges_of G & (the_Source_of G).e in X;
end;

definition
  let G be _Graph, X be set;
  func G.edgesInOut(X) -> Subset of the_Edges_of G equals

  G.edgesInto(X) \/ G
  .edgesOutOf(X);
  func G.edgesBetween(X) -> Subset of the_Edges_of G equals

  G.edgesInto(X) /\
  G.edgesOutOf(X);
end;

definition
  let G be _Graph, X,Y be set;
  func G.edgesBetween(X,Y) -> Subset of the_Edges_of G means


  for e being set holds e in it iff e SJoins X,Y,G;
  func G.edgesDBetween(X,Y) -> Subset of the_Edges_of G means


  for e being set holds e in it iff e DSJoins X,Y,G;
end;

scheme 

  FinGraphOrderInd{P[finite _Graph]}: for G being finite _Graph holds P[G]
provided
 for G being finite _Graph st G.order() = 1 holds P[G] and
 for k being non empty Nat st (for Gk being finite _Graph st Gk
.order() = k holds P[Gk]) holds for Gk1 being finite _Graph st Gk1.order() = k+
1 holds P[Gk1];

scheme 

  FinGraphSizeInd{P[finite _Graph]}: for G being finite _Graph holds P[G]
provided
 for G being finite _Graph st G.size() = 0 holds P[G] and
 for k being Element of NAT st (for Gk being finite _Graph st Gk
.size() = k holds P[Gk]) holds for Gk1 being finite _Graph st Gk1.size() = k+1
holds P[Gk1];

definition
  let G be _Graph;
  mode Subgraph of G -> _Graph means


    the_Vertices_of it c=
the_Vertices_of G & the_Edges_of it c= the_Edges_of G & for e being set st e in
    the_Edges_of it holds (the_Source_of it).e = (the_Source_of G).e & (
    the_Target_of it).e = (the_Target_of G).e;
end;

definition
  let G1 be _Graph, G2 be Subgraph of G1;
  redefine func the_Vertices_of G2 -> non empty Subset of the_Vertices_of G1;
  redefine func the_Edges_of G2 -> Subset of the_Edges_of G1;
end;

registration
  let G be _Graph;
  cluster trivial simple for Subgraph of G;
end;

registration
  let G be finite _Graph;
  cluster -> finite for Subgraph of G;
end;

registration
  let G be loopless _Graph;
  cluster -> loopless for Subgraph of G;
end;

registration
  let G be trivial _Graph;
  cluster -> trivial for Subgraph of G;
end;

registration
  let G be non-multi _Graph;
  cluster -> non-multi for Subgraph of G;
end;

definition
  let G1 be _Graph, G2 be Subgraph of G1;
  attr G2 is spanning means


  the_Vertices_of G2 = the_Vertices_of G1;
end;

registration
  let G be _Graph;
  cluster spanning for Subgraph of G;
end;

definition
  let G1, G2 be _Graph;
  pred G1 == G2 means


  the_Vertices_of G1 = the_Vertices_of G2 &
  the_Edges_of G1 = the_Edges_of G2 & the_Source_of G1 = the_Source_of G2 &
  the_Target_of G1 = the_Target_of G2;
  reflexivity;
  symmetry;
end;

notation
  let G1,G2 be _Graph;
  antonym G1 != G2 for G1 == G2;
end;

definition
  let G1,G2 be _Graph;
  pred G1 c= G2 means


  G1 is Subgraph of G2;
  reflexivity;
end;

definition
  let G1,G2 be _Graph;
  pred G1 c< G2 means


  G1 c= G2 & G1 != G2;
  irreflexivity;
end;

definition
  let G be _Graph, V, E be set;
  mode inducedSubgraph of G,V,E -> Subgraph of G means


    the_Vertices_of
it = V & the_Edges_of it = E if V is non empty Subset of the_Vertices_of G & E
    c= G.edgesBetween(V) otherwise it == G;
end;

definition
  let G be _Graph, V be set;
  mode inducedSubgraph of G,V is inducedSubgraph of G,V,G.edgesBetween(V);
end;

registration
  let G be _Graph, V be finite non empty Subset of the_Vertices_of G, E be
  finite Subset of G.edgesBetween(V);
  cluster -> finite for inducedSubgraph of G,V,E;
end;

registration
  let G be _Graph, v be Element of the_Vertices_of G, E be Subset of G
  .edgesBetween({v});
  cluster -> trivial for inducedSubgraph of G,{v},E;
end;

registration
  let G be _Graph, v be Element of the_Vertices_of G;
  cluster -> finite trivial for inducedSubgraph of G,{v},{};
end;

registration
  let G be _Graph, V be non empty Subset of the_Vertices_of G;
  cluster -> simple for inducedSubgraph of G,V,{};
end;

registration
  let G be _Graph, E be Subset of the_Edges_of G;
  cluster -> spanning for inducedSubgraph of G,the_Vertices_of G, E;
end;

registration
  let G be _Graph;
  cluster -> spanning for inducedSubgraph of G,the_Vertices_of G,{};
end;

definition
  let G be _Graph, v be set;
  mode removeVertex of G,v is inducedSubgraph of G, the_Vertices_of G \ {v};
end;

definition
  let G be _Graph, V be set;
  mode removeVertices of G,V is inducedSubgraph of G, the_Vertices_of G \ V;
end;

definition
  let G be _Graph, e be set;
  mode removeEdge of G,e is inducedSubgraph of G, the_Vertices_of G,
    the_Edges_of G \ {e};
end;

definition
  let G be _Graph, E be set;
  mode removeEdges of G,E is inducedSubgraph of G, the_Vertices_of G,
    the_Edges_of G \ E;
end;

registration
  let G be _Graph, e be set;
  cluster -> spanning for removeEdge of G,e;
end;

registration
  let G be _Graph, E be set;
  cluster -> spanning for removeEdges of G,E;
end;

definition
  let G be _Graph;
  mode Vertex of G is Element of the_Vertices_of G;
end;

definition
  let G be _Graph, v be Vertex of G;
  func v.edgesIn() -> Subset of the_Edges_of G equals

  G.edgesInto( {v} );
  func v.edgesOut() -> Subset of the_Edges_of G equals

  G.edgesOutOf( {v} );
  func v.edgesInOut() -> Subset of the_Edges_of G equals

  G.edgesInOut( {v} );
end;

definition
  let G be _Graph, v be Vertex of G, e be set;
  func v.adj(e) -> Vertex of G equals


  (the_Source_of G).e if e in
  the_Edges_of G & (the_Target_of G).e = v, (the_Target_of G).e if e in
  the_Edges_of G & (the_Source_of G).e = v & not (the_Target_of G).e = v
  otherwise v;
end;

definition
  let G be _Graph, v be Vertex of G;
  func v.inDegree() -> Cardinal equals

  card v.edgesIn();
  func v.outDegree() -> Cardinal equals

  card v.edgesOut();
end;

definition
  let G be finite _Graph, v be Vertex of G;
  redefine func v.inDegree() -> Element of NAT;
  redefine func v.outDegree() -> Element of NAT;
end;

definition
  let G be _Graph, v be Vertex of G;
  func v.degree() -> Cardinal equals

  v.inDegree() +` v.outDegree();
end;

definition
  let G be finite _Graph, v be Vertex of G;
  redefine func v.degree() -> Element of NAT equals

  v.inDegree() + v
  .outDegree();
end;

definition
  let G be _Graph, v be Vertex of G;
  func v.inNeighbors() -> Subset of the_Vertices_of G equals

  (the_Source_of G)
  .:v.edgesIn();
  func v.outNeighbors() -> Subset of the_Vertices_of G equals

  (the_Target_of G
  ).:v.edgesOut();
end;

definition
  let G be _Graph, v be Vertex of G;
  func v.allNeighbors() -> Subset of the_Vertices_of G equals

  v.inNeighbors()
  \/ v.outNeighbors();
end;

definition
  let G be _Graph, v being Vertex of G;
  attr v is isolated means


  v.edgesInOut() = {};
end;

definition
  let G be finite _Graph, v be Vertex of G;
  redefine attr v is isolated means

  v.degree() = 0;
end;

definition
  let G be _Graph, v be Vertex of G;
  attr v is endvertex means


  ex e being set st v.edgesInOut() = {e} & not e Joins v,v,G;
end;

definition
  let G be finite _Graph, v be Vertex of G;
  redefine attr v is endvertex means

  v.degree() = 1;
end;

definition
  let F be ManySortedSet of NAT;
  attr F is Graph-yielding means


  for n being Nat holds F.n is _Graph;
  attr F is halting means


  ex n being Nat st F.n = F.(n+1);
end;

definition
  let F be ManySortedSet of NAT;
  func F.Lifespan() -> Element of NAT means

  F.it = F.(it+1) & for n being Nat
  st F.n = F.(n+1) holds it <= n if F is halting otherwise it = 0;
end;

definition
  let F be ManySortedSet of NAT;
  func F.Result() -> set equals

  F.(F.Lifespan());
end;

registration
  cluster Graph-yielding for ManySortedSet of NAT;
end;

definition
  mode GraphSeq is Graph-yielding ManySortedSet of NAT;
end;

registration
  let GSq be GraphSeq, x be Nat;
  cluster GSq.x -> Function-like Relation-like;
end;

registration
  let GSq be GraphSeq, x be Nat;
  cluster GSq.x -> NAT -defined finite;
end;

registration
  let GSq be GraphSeq, x be Nat;
  cluster GSq.x -> [Graph-like];
end;

definition
  let GSq be GraphSeq;

  attr GSq is finite means


  for x being Nat holds GSq.x is finite;
  attr GSq is loopless means


  for x being Nat holds GSq.x is loopless;
  attr GSq is trivial means


  for x being Nat holds GSq.x is trivial;
  attr GSq is non-trivial means


  for x being Nat holds GSq.x is non trivial;
  attr GSq is non-multi means


  for x being Nat holds GSq.x is non-multi;
  attr GSq is non-Dmulti means


  for x being Nat holds GSq.x is non-Dmulti;
  attr GSq is simple means


  for x being Nat holds GSq.x is simple;
  attr GSq is Dsimple means


  for x being Nat holds GSq.x is Dsimple;
end;

definition
  let GSq be GraphSeq;
  redefine attr GSq is halting means

  ex n being Nat st GSq.n = GSq.(n+1);
end;

registration
  cluster halting finite loopless trivial non-multi non-Dmulti simple Dsimple
    for GraphSeq;
  cluster halting finite loopless non-trivial non-multi non-Dmulti simple
    Dsimple for GraphSeq;
end;

registration
  let GSq be finite GraphSeq, x be Nat;
  cluster GSq.x -> finite;
end;

registration
  let GSq be loopless GraphSeq, x be Nat;
  cluster GSq.x -> loopless for _Graph;
end;

registration
  let GSq be trivial GraphSeq, x be Nat;
  cluster GSq.x -> trivial for _Graph;
end;

registration
  let GSq be non-trivial GraphSeq, x be Nat;
  cluster GSq.x -> non trivial for _Graph;
end;

registration
  let GSq be non-multi GraphSeq, x be Nat;
  cluster GSq.x -> non-multi for _Graph;
end;

registration
  let GSq be non-Dmulti GraphSeq, x be Nat;
  cluster GSq.x -> non-Dmulti for _Graph;
end;

registration
  let GSq be simple GraphSeq, x be Nat;
  cluster GSq.x -> simple for _Graph;
end;

registration
  let GSq be Dsimple GraphSeq, x be Nat;
  cluster GSq.x -> Dsimple for _Graph;
end;

registration
  cluster non-multi -> non-Dmulti for GraphSeq;
end;

registration
  cluster simple -> loopless non-multi for GraphSeq;
end;

registration
  cluster loopless non-multi -> simple for GraphSeq;
end;

registration
  cluster loopless non-Dmulti -> Dsimple for GraphSeq;
end;

registration
  cluster Dsimple -> loopless non-Dmulti for GraphSeq;
end;

registration
  cluster trivial loopless -> finite for GraphSeq;
end;

registration
  cluster trivial non-Dmulti -> finite for GraphSeq;
end;

begin 

reserve GS for GraphStruct;
reserve G,G1,G2,G3 for _Graph;
reserve e,x,x1,x2,y,y1,y2,E,V,X,Y for set;
reserve n,n1,n2 for Nat;
reserve v,v1,v2 for Vertex of G;

theorem 
  VertexSelector = 1 & EdgeSelector = 2 & SourceSelector = 3 &
  TargetSelector = 4;

theorem 
  _GraphSelectors c= dom G;

theorem 
  the_Vertices_of GS = GS.VertexSelector & the_Edges_of GS = GS.
  EdgeSelector & the_Source_of GS = GS.SourceSelector & the_Target_of GS = GS.
  TargetSelector;

theorem 
  dom (the_Source_of G) = the_Edges_of G & dom (the_Target_of G) =
  the_Edges_of G & rng (the_Source_of G) c= the_Vertices_of G & rng (
  the_Target_of G) c= the_Vertices_of G;

theorem 
  GS is [Graph-like] iff _GraphSelectors c= dom GS & the_Vertices_of GS
is non empty & the_Source_of GS is Function of the_Edges_of GS,the_Vertices_of
GS & the_Target_of GS is Function of the_Edges_of GS,the_Vertices_of GS;

theorem 
  for V being non empty set, E being set, S,T being Function of E,V
holds the_Vertices_of createGraph(V,E,S,T) = V & the_Edges_of createGraph(V,E,S
,T) = E & the_Source_of createGraph(V,E,S,T) = S & the_Target_of createGraph(V,
  E,S,T) = T;

theorem 
  dom GS.set(n,x) = dom GS \/ {n};

theorem 
  GS.set(n,x).n = x;

theorem 
  n1 <> n2 implies GS.n2 = GS.set(n1,x).n2;

theorem 
  not n in _GraphSelectors implies the_Vertices_of G = the_Vertices_of G
  .set(n,x) & the_Edges_of G = the_Edges_of G.set(n,x) & the_Source_of G =
the_Source_of G.set(n,x) & the_Target_of G = the_Target_of G.set(n,x) & G.set(n
  ,x) is _Graph;

theorem 
  the_Vertices_of GS.set(VertexSelector,x) = x & the_Edges_of GS.set(
  EdgeSelector,x) = x & the_Source_of GS.set(SourceSelector,x) = x &
  the_Target_of GS.set(TargetSelector,x) = x;

theorem 
  n1 <> n2 implies n1 in dom GS.set(n1,x).set(n2,y) & n2 in dom GS.set(
n1,x).set(n2,y) & GS.set(n1,x).set(n2,y).n1 = x & GS.set(n1,x).set(n2,y).n2 = y
;

theorem 
  e Joins x,y,G implies x in the_Vertices_of G & y in the_Vertices_of G;

theorem 
  e Joins x,y,G implies e Joins y,x,G;

theorem 
  e Joins x1,y1,G & e Joins x2,y2,G implies x1 = x2 & y1 = y2 or x1 = y2
  & y1 = x2;

theorem 
  e Joins x,y,G iff (e DJoins x,y,G or e DJoins y,x,G);

theorem 
  e Joins x,y,G & ( x in X & y in Y or x in Y & y in X ) implies e SJoins X,Y,G
;

theorem 
  G is loopless iff for v being set holds not ex e being set st e Joins v,v,G;

theorem 
  for G being finite loopless _Graph, v being Vertex of G holds v
  .degree() = card v.edgesInOut();

theorem 
  for G being non trivial _Graph, v being Vertex of G holds (
  the_Vertices_of G) \ {v} is non empty;

theorem 
  for G being non trivial _Graph holds ex v1, v2 being Vertex of G st v1 <> v2;

theorem 
  for G being trivial _Graph holds ex v being Vertex of G st
  the_Vertices_of G = {v};

theorem 
  for G being trivial loopless _Graph holds the_Edges_of G = {};

theorem 
  the_Edges_of G = {} implies G is simple;

theorem 
  for G being finite _Graph holds G.order() >= 1;

theorem 
  for G being finite _Graph holds G.order() = 1 iff G is trivial;

theorem 
  for G being finite _Graph holds G.order() = 1 iff ex v being Vertex of
  G st the_Vertices_of G = {v};

theorem 
  e in the_Edges_of G & ((the_Source_of G).e in X or (
  the_Target_of G).e in X) iff e in G.edgesInOut(X);

theorem 
  G.edgesInto(X) c= G.edgesInOut(X) & G.edgesOutOf(X) c= G.edgesInOut(X);

theorem 
  the_Edges_of G = G.edgesInOut(the_Vertices_of G);

theorem 
  e in the_Edges_of G & (the_Source_of G).e in X & (the_Target_of G).e
  in X iff e in G.edgesBetween(X);

theorem 
  x in X & y in X & e Joins x,y,G implies e in G.edgesBetween(X);

theorem 
  G.edgesBetween(X) c= G.edgesInOut(X);

theorem 
  the_Edges_of G = G.edgesBetween(the_Vertices_of G);

theorem 
  (the_Edges_of G) \ (G.edgesInOut(X)) = G.edgesBetween( (
  the_Vertices_of G) \ X);

theorem 
  X c= Y implies G.edgesBetween(X) c= G.edgesBetween(Y);

theorem 
  for G being _Graph, X1,X2,Y1,Y2 being set st X1 c= X2 & Y1 c= Y2 holds
  G.edgesBetween(X1,Y1) c= G.edgesBetween(X2,Y2);

theorem 
  for G being _Graph, X1,X2,Y1,Y2 being set st X1 c= X2 & Y1 c= Y2 holds
  G.edgesDBetween(X1,Y1) c= G.edgesDBetween(X2,Y2);

theorem 
  for G being _Graph, v being Vertex of G holds v.edgesIn() = G
  .edgesDBetween(the_Vertices_of G, {v}) & v.edgesOut() = G.edgesDBetween({v},
  the_Vertices_of G);

theorem 
  G is Subgraph of G;

theorem 
  G1 is Subgraph of G2 & G2 is Subgraph of G1 iff the_Vertices_of
G1 = the_Vertices_of G2 & the_Edges_of G1 = the_Edges_of G2 & the_Source_of G1
  = the_Source_of G2 & the_Target_of G1 = the_Target_of G2;

theorem 
  for G1 being _Graph, G2 being Subgraph of G1, x being set holds (x in
  the_Vertices_of G2 implies x in the_Vertices_of G1) & (x in the_Edges_of G2
  implies x in the_Edges_of G1);

theorem 
  for G1 being _Graph, G2 being Subgraph of G1, G3 being Subgraph
  of G2 holds G3 is Subgraph of G1;

theorem 
  for G being _Graph, G1, G2 being Subgraph of G st
  the_Vertices_of G1 c= the_Vertices_of G2 & the_Edges_of G1 c= the_Edges_of G2
  holds G1 is Subgraph of G2;

theorem 
  for G1 being _Graph, G2 being Subgraph of G1 holds the_Source_of
  G2 = (the_Source_of G1) | the_Edges_of G2 & the_Target_of G2 = (the_Target_of
  G1) | the_Edges_of G2;

theorem 
  for G being _Graph, V1,V2,E1,E2 being set, G1 being inducedSubgraph of
G,V1,E1, G2 being inducedSubgraph of G,V2,E2 st V2 c= V1 & E2 c= E1 & V2 is non
  empty Subset of the_Vertices_of G & E2 c= G.edgesBetween(V2) holds G2 is
  Subgraph of G1;

theorem 
  for G1 being non trivial _Graph, v being Vertex of G1, G2 being
  removeVertex of G1,v holds the_Vertices_of G2 = the_Vertices_of G1 \ {v} &
  the_Edges_of G2 = G1.edgesBetween(the_Vertices_of G1 \ {v});

theorem 
  for G1 being finite non trivial _Graph, v being Vertex of G1, G2 being
  removeVertex of G1,v holds G2.order() + 1 = G1.order() & G2.size() + card v
  .edgesInOut() = G1.size();

theorem 
  for G1 being _Graph, V being set, G2 being removeVertices of G1,
V st V c< the_Vertices_of G1 holds the_Vertices_of G2 = the_Vertices_of G1 \ V
  & the_Edges_of G2 = G1.edgesBetween(the_Vertices_of G1 \ V);

theorem 
  for G1 being finite _Graph, V being Subset of the_Vertices_of G1, G2
being removeVertices of G1,V st V <> the_Vertices_of G1 holds G2.order() + card
  V = G1.order() & G2.size() + card G1.edgesInOut(V) = G1.size();

theorem 
  for G1 being _Graph, e being set, G2 being removeEdge of G1,e
holds the_Vertices_of G2 = the_Vertices_of G1 & the_Edges_of G2 = the_Edges_of
  G1 \ {e};

theorem 
  for G1 being finite _Graph, e being set, G2 being removeEdge of G1,e
  holds G1.order() = G2.order() & (e in the_Edges_of G1 implies G2.size() + 1 =
  G1.size());

theorem 
  for G1 being _Graph, E being set, G2 being removeEdges of G1,E
holds the_Vertices_of G2 = the_Vertices_of G1 & the_Edges_of G2 = the_Edges_of
  G1 \ E;

theorem 
  for G1 being finite _Graph, E being set, G2 being removeEdges of G1,E
  holds G1.order() = G2.order();

theorem 
  for G1 being finite _Graph, E being Subset of the_Edges_of G1, G2
  being removeEdges of G1,E holds G2.size() + card E = G1.size();

theorem 
  e in v.edgesIn() iff e in the_Edges_of G & (the_Target_of G).e = v;

theorem 
  e in v.edgesIn() iff ex x being set st e DJoins x,v,G;

theorem 
  e in v.edgesOut() iff e in the_Edges_of G & (the_Source_of G).e = v;

theorem 
  e in v.edgesOut() iff ex x being set st e DJoins v,x,G;

theorem 
  v.edgesInOut() = v.edgesIn() \/ v.edgesOut();

theorem 
  e in v.edgesInOut() iff e in the_Edges_of G & ((the_Source_of G)
  .e = v or (the_Target_of G).e = v);

theorem 
  e Joins v1,x,G implies e in v1.edgesInOut();

theorem 
  e Joins v1,v2,G implies e in v1.edgesIn() & e in v2.edgesOut()
  or e in v2.edgesIn() & e in v1.edgesOut();

theorem 
  e in v1.edgesInOut() iff ex v2 being Vertex of G st e Joins v1,v2,G;

theorem 
  e in v.edgesInOut() & e Joins x,y,G implies v = x or v = y;

theorem 
  e Joins v1,v2,G implies v1.adj(e) = v2 & v2.adj(e) = v1;

theorem 
  e in v.edgesInOut() iff e Joins v,v.adj(e),G;

theorem 
  for G being finite _Graph, e being set, v1,v2 being Vertex of G holds
  e Joins v1,v2,G implies 1 <= v1.degree() & 1 <= v2.degree();

theorem 
  x in v.inNeighbors() iff ex e being set st e DJoins x,v,G;

theorem 
  x in v.outNeighbors() iff ex e being set st e DJoins v,x,G;

theorem 
  x in v.allNeighbors() iff ex e being set st e Joins v,x,G;

theorem 
  for G1 being _Graph, G2 being Subgraph of G1, x,y,e being set
  holds (e Joins x,y,G2 implies e Joins x,y,G1) & (e DJoins x,y,G2 implies e
DJoins x,y,G1) & (e SJoins x,y,G2 implies e SJoins x,y,G1) & (e DSJoins x,y,G2
  implies e DSJoins x,y,G1);

theorem 
  for G1 being _Graph, G2 being Subgraph of G1, x,y,e being set st e in
the_Edges_of G2 holds (e Joins x,y,G1 implies e Joins x,y,G2) & (e DJoins x,y,
  G1 implies e DJoins x,y,G2) & (e SJoins x,y,G1 implies e SJoins x,y,G2) & (e
  DSJoins x,y,G1 implies e DSJoins x,y,G2);

theorem 
  for G1 being _Graph, G2 being spanning Subgraph of G1, G3 being
  spanning Subgraph of G2 holds G3 is spanning Subgraph of G1;

theorem 
  for G1 being finite _Graph, G2 being Subgraph of G1 holds G2.order()
  <= G1.order() & G2.size() <= G1.size();

theorem 
  for G1 being _Graph, G2 being Subgraph of G1, X being set holds G2
  .edgesInto(X) c= G1.edgesInto(X) & G2.edgesOutOf(X) c= G1.edgesOutOf(X) & G2
  .edgesInOut(X) c= G1.edgesInOut(X) & G2.edgesBetween(X) c= G1.edgesBetween(X)
;

theorem 
  for G1 being _Graph, G2 being Subgraph of G1, X,Y being set holds G2
  .edgesBetween(X,Y) c= G1.edgesBetween(X,Y) & G2.edgesDBetween(X,Y) c= G1
  .edgesDBetween(X,Y);

theorem 
  for G1 being _Graph, G2 being Subgraph of G1, v1 being Vertex of
  G1, v2 being Vertex of G2 st v1 = v2 holds v2.edgesIn() c= v1.edgesIn() & v2
  .edgesOut() c= v1.edgesOut() & v2.edgesInOut() c= v1.edgesInOut();

theorem 
  for G1 being _Graph, G2 being Subgraph of G1, v1 being Vertex of
  G1, v2 being Vertex of G2 st v1 = v2 holds v2.edgesIn() = v1.edgesIn() /\ (
  the_Edges_of G2) & v2.edgesOut() = v1.edgesOut() /\ (the_Edges_of G2) & v2
  .edgesInOut() = v1.edgesInOut() /\ (the_Edges_of G2);

theorem 
  for G1 being _Graph, G2 being Subgraph of G1, v1 being Vertex of G1,
  v2 being Vertex of G2, e being set st v1 = v2 & e in the_Edges_of G2 holds v1
  .adj(e) = v2.adj(e);

theorem 
  for G1 being finite _Graph, G2 being Subgraph of G1, v1 being Vertex
of G1, v2 being Vertex of G2 st v1 = v2 holds v2.inDegree() <= v1.inDegree() &
  v2.outDegree() <= v1.outDegree() & v2.degree() <= v1.degree();

theorem 
  for G1 being _Graph, G2 being Subgraph of G1, v1 being Vertex of G1,
  v2 being Vertex of G2 st v1 = v2 holds v2.inNeighbors() c= v1.inNeighbors() &
v2.outNeighbors() c= v1.outNeighbors() & v2.allNeighbors() c= v1.allNeighbors()
;

theorem 
  for G1 being _Graph, G2 being Subgraph of G1, v1 being Vertex of G1,
  v2 being Vertex of G2 st v1 = v2 & v1 is isolated holds v2 is isolated;

theorem 
  for G1 being _Graph, G2 being Subgraph of G1, v1 being Vertex of G1,
v2 being Vertex of G2 st v1 = v2 & v1 is endvertex holds v2 is endvertex or v2
  is isolated;

theorem 
  G1 == G2 & G2 == G3 implies G1 == G3;

theorem 
  for G being _Graph, G1,G2 being Subgraph of G st the_Vertices_of
  G1 = the_Vertices_of G2 & the_Edges_of G1 = the_Edges_of G2 holds G1 == G2;

theorem 
  G1 == G2 iff G1 is Subgraph of G2 & G2 is Subgraph of G1;

theorem 
  G1 == G2 implies (e Joins x,y,G1 implies e Joins x,y,G2) & (e
DJoins x,y,G1 implies e DJoins x,y,G2) & (e SJoins X,Y,G1 implies e SJoins X,Y,
  G2) & (e DSJoins X,Y,G1 implies e DSJoins X,Y,G2);

theorem 
  G1 == G2 implies (G1 is finite implies G2 is finite) & (G1 is loopless
  implies G2 is loopless) & (G1 is trivial implies G2 is trivial) & (G1 is
non-multi implies G2 is non-multi) & (G1 is non-Dmulti implies G2 is non-Dmulti
) & (G1 is simple implies G2 is simple) & (G1 is Dsimple implies G2 is Dsimple)
;

theorem 
  G1 == G2 implies G1.order() = G2.order() & G1.size() = G2.size()
& G1.edgesInto(X) = G2.edgesInto(X) & G1.edgesOutOf(X) = G2.edgesOutOf(X) & G1
  .edgesInOut(X) = G2.edgesInOut(X) & G1.edgesBetween(X) = G2.edgesBetween(X) &
  G1.edgesDBetween(X,Y) = G2.edgesDBetween(X,Y);

theorem 
  G1 == G2 & G3 is Subgraph of G1 implies G3 is Subgraph of G2;

theorem 
  G1 == G2 & G1 is Subgraph of G3 implies G2 is Subgraph of G3;

theorem 
  for G1,G2 being inducedSubgraph of G,V,E holds G1 == G2;

theorem 
  for G1 being _Graph, G2 being inducedSubgraph of G1,the_Vertices_of G1
  holds G1 == G2;

theorem 
  for G1,G2 being _Graph, V,E being set, G3 being inducedSubgraph of G1,
  V,E st G1 == G2 holds G3 is inducedSubgraph of G2,V,E;

theorem 
  for v1 being Vertex of G1, v2 being Vertex of G2 st v1 = v2 & G1
  == G2 holds v1.edgesIn() = v2.edgesIn() & v1.edgesOut() = v2.edgesOut() & v1
  .edgesInOut() = v2.edgesInOut() & v1.adj(e) = v2.adj(e) & v1.inDegree() = v2
.inDegree() & v1.outDegree() = v2.outDegree() & v1.degree() = v2.degree() & v1
.inNeighbors() = v2.inNeighbors() & v1.outNeighbors() = v2.outNeighbors() & v1
  .allNeighbors() = v2.allNeighbors();

theorem 
  for v1 being Vertex of G1, v2 being Vertex of G2 st v1 = v2 & G1 == G2
holds (v1 is isolated implies v2 is isolated) & (v1 is endvertex implies v2 is
  endvertex);

theorem 
  for G being _Graph, G1,G2 being Subgraph of G st G1 c< G2 holds
(the_Vertices_of G1 c< the_Vertices_of G2 or the_Edges_of G1 c< the_Edges_of G2
  );

theorem 
  for G being _Graph, G1,G2 being Subgraph of G st G1 c< G2 holds (ex v
  being set st v in the_Vertices_of G2 & not v in the_Vertices_of G1) or ex e
  being set st e in the_Edges_of G2 & not e in the_Edges_of G1;














begin 

reserve i, I for set,
  f for Function,
  x, x1, x2, y, A, B, X, Y, Z for ManySortedSet of I;

theorem 
  for X be set for M be ManySortedSet of I st i in I
  holds dom (M +* (i .--> X)) = I;

theorem 
  f = {} implies f is ManySortedSet of {};

theorem 
  I is non empty implies not ex X st X is empty-yielding & X is non-empty;

begin 

definition
  let I, A;
  func {A} -> ManySortedSet of I means


  for i st i in I holds it.i = {A.i};
end;

registration
  let I, A;
  cluster {A} -> non-empty finite-yielding;
end;

definition
  let I, A, B;
  func {A,B} -> ManySortedSet of I means


  for i st i in I holds it.i = {A.i,B.i};
  commutativity;
end;

registration
  let I, A, B;
  cluster {A,B} -> non-empty finite-yielding;
end;

theorem 
  X = { y } iff for x holds x in X iff x = y;

theorem 
  (for x holds x in X iff x = x1 or x = x2) implies X = { x1,x2 };

theorem 
  X = { x1,x2 } implies for x holds x = x1 or x = x2 implies x in X;

theorem 
  x in { A } implies x = A;

theorem 
  x in { x };

theorem 
  x = A or x = B implies x in { A,B };

theorem 
  {A} \/ {B} = {A,B};

theorem 
  { x,x } = { x };

theorem 
  {A} c= {B} implies A = B;

theorem 
  {x} = {y} implies x = y;

theorem 
  {x} = {A,B} implies x = A & x = B;

theorem 
  {x} = {A,B} implies A = B;

theorem 
  {x} c= {x,y} & {y} c= {x,y};

theorem 
  {x} \/ {y} = {x} or {x} \/ {y} = {y} implies x = y;

theorem 
  {x} \/ {x,y} = {x,y};

theorem 
  I is non empty & {x} /\ {y} = [[0]]I implies x <> y;

theorem 
  {x} /\ {y} = {x} or {x} /\ {y} = {y} implies x = y;

theorem 
  {x} /\ {x,y} = {x} & {y} /\ {x,y} = {y};

theorem 
  I is non empty & {x} \ {y} = {x} implies x <> y;

theorem 
  {x} \ {y} = [[0]]I implies x = y;

theorem 
  {x} \ {x,y} = [[0]]I & {y} \ {x,y} = [[0]]I;

theorem 
  {x} c= {y} implies {x} = {y};

theorem 
  {x,y} c= {A} implies x = A & y = A;

theorem 
  {x,y} c= {A} implies {x,y} = {A};

theorem 
  bool { x } = { [[0]]I, {x} };

theorem 
  { A } c= bool A;

theorem 
  union { x } = x;

theorem 
  union { {x},{y} } = {x,y};

theorem 
  union { A,B } = A \/ B;

theorem 
  {x} c= X iff x in X;

theorem 
  {x1,x2} c= X iff x1 in X & x2 in X;

theorem 
  A = [[0]]I or A = {x1} or A = {x2} or A = {x1,x2} implies A c= {x1,x2};

begin 

theorem 
  x in A or x = B implies x in A \/ {B};

theorem 
  A \/ {x} c= B iff x in B & A c= B;

theorem 
  {x} \/ X = X implies x in X;

theorem 
  x in X implies {x} \/ X = X;

theorem 
  {x,y} \/ A = A iff x in A & y in A;

theorem 
  I is non empty implies {x} \/ X <> [[0]]I;

theorem 
  I is non empty implies {x,y} \/ X <> [[0]]I;

begin 

theorem 
  X /\ {x} = {x} implies x in X;

theorem 
  x in X implies X /\ {x} = {x};

theorem 
  x in X & y in X iff {x,y} /\ X = {x,y};

theorem 
  I is non empty & {x} /\ X = [[0]]I implies not x in X;

theorem 
  I is non empty & {x,y} /\ X = [[0]]I implies not x in X & not y in X;

begin 

theorem 
  y in X \ {x} implies y in X;

theorem 
  I is non empty & y in X \ {x} implies y <> x;

theorem 
  I is non empty & X \ {x} = X implies not x in X;

theorem 
  I is non empty & {x} \ X = {x} implies not x in X;

theorem 
  {x} \ X = [[0]]I iff x in X;

theorem 
  I is non empty & {x,y} \ X = {x} implies not x in X;

theorem 
  I is non empty & {x,y} \ X = {x,y} implies not x in X & not y in X;

theorem 
  {x,y} \ X = [[0]]I iff x in X & y in X;

theorem 
  X = [[0]]I or X = {x} or X = {y} or X = {x,y} implies X \ {x,y} = [[0]]I;

begin 

theorem 
  X = [[0]]I or Y = [[0]]I implies [|X,Y|] = [[0]]I;

theorem 
  X is non-empty & Y is non-empty & [|X,Y|] = [|Y,X|] implies X = Y;

theorem 
  [|X,X|] = [|Y,Y|] implies X = Y;

theorem 
  Z is non-empty & ([|X,Z|] c= [|Y,Z|] or [|Z,X|] c= [|Z,Y|]) implies X c= Y;

theorem 
  X c= Y implies [|X,Z|] c= [|Y,Z|] & [|Z,X|] c= [|Z,Y|];

theorem 
  x1 c= A & x2 c= B implies [|x1,x2|] c= [|A,B|];

theorem 
  [|X \/ Y, Z|] = [|X, Z|] \/ [|Y, Z|] & [|Z, X \/ Y|] = [|Z, X|] \/ [|Z, Y|];

theorem 
  [|x1 \/ x2, A \/ B|] = [|x1,A|] \/ [|x1,B|] \/ [|x2,A|] \/ [|x2,B|];

theorem 
  [|X /\ Y, Z|] = [|X, Z|] /\ [|Y, Z|] & [|Z, X /\ Y|] = [|Z, X|] /\ [|Z, Y|];

theorem 
  [|x1 /\ x2, A /\ B|] = [|x1,A|] /\ [|x2, B|];

theorem 
  A c= X & B c= Y implies [|A,Y|] /\ [|X,B|] = [|A,B|];

theorem 
  [|X \ Y, Z|] = [|X, Z|] \ [|Y, Z|] & [|Z, X \ Y|] = [|Z, X|] \ [|Z, Y|];

theorem 
  [|x1,x2|] \ [|A,B|] = [|x1\A,x2|] \/ [|x1,x2\B|];

theorem 
  x1 /\ x2 = [[0]]I or A /\ B = [[0]]I implies [|x1,A|] /\ [|x2,B|] = [[0]]I;

theorem 
  X is non-empty implies [|{x},X|] is non-empty & [|X,{x}|] is non-empty;

theorem 
  [|{x,y},X|] = [|{x},X|] \/ [|{y},X|] & [|X,{x,y}|] = [|X,{x}|] \/ [|X,{y}|];

theorem 
  x1 is non-empty & A is non-empty & [|x1,A|] = [|x2,B|]
  implies x1 = x2 & A = B;

theorem 
  X c= [|X,Y|] or X c= [|Y,X|] implies X = [[0]]I;

theorem 
  A in [|x,y|] & A in [|X,Y|] implies A in [|x /\ X, y /\ Y|];

theorem 
  [|x,X|] c= [|y,Y|] & [|x,X|] is non-empty implies x c= y & X c= Y;

theorem 
  A c= X implies [|A,A|] c= [|X,X|];

theorem 
  X /\ Y = [[0]]I implies [|X,Y|] /\ [|Y,X|] = [[0]]I;

theorem 
  A is non-empty & ([|A,B|] c= [|X,Y|] or [|B,A|] c= [|Y,X|]) implies B c= Y;

theorem 
  x c= [|A,B|] & y c= [|X,Y|] implies x \/ y c= [|A \/ X,B \/ Y|];

begin 


definition
  let I, A, B;
  pred A is_transformable_to B means

  for i be set st i in I holds B.i = {} implies A.i = {};
  reflexivity;
end;














begin 

reserve D for non empty set;
reserve f1,f2 for FinSequence of D;
reserve i,n,n1,n2,n3,n4,n5,n6 for Element of NAT;

theorem 
  for n being Nat holds n <= len f1 implies (f1^f2)/^n = (f1/^n)^f2;

theorem 
  (f1^f2)|(len f1 + i) = f1^(f2|i);



definition
  mode Gene-Set is non-empty non empty FinSequence;
end;

notation
  let S be Gene-Set;
  synonym GA-Space S for Union S;
end;

registration
  let f be non-empty non empty Function;
  cluster Union f -> non empty;
end;

definition
  let S be Gene-Set;
  mode Individual of S -> FinSequence of GA-Space S means


    len it = len S & for i st i in dom it holds it.i in S.i;
end;

begin 

definition
  let S be Gene-Set, p1,p2 be FinSequence of GA-Space S, n;
  func crossover(p1,p2,n) -> FinSequence of GA-Space S equals

  (p1|n)^(p2/^n);
end;

definition
  let S be Gene-Set, p1,p2 be FinSequence of GA-Space S, n1,n2;
  func crossover(p1,p2,n1,n2) -> FinSequence of GA-Space S equals

  crossover(
  crossover(p1,p2,n1),crossover(p2,p1,n1),n2);
end;

definition
  let S be Gene-Set, p1,p2 be FinSequence of GA-Space S, n1,n2,n3;
  func crossover(p1,p2,n1,n2,n3) -> FinSequence of GA-Space S equals

  crossover
  (crossover(p1,p2,n1,n2),crossover(p2,p1,n1,n2),n3);
end;

definition
  let S be Gene-Set, p1,p2 be FinSequence of GA-Space S, n1,n2,n3,n4;
  func crossover(p1,p2,n1,n2,n3,n4) -> FinSequence of GA-Space S equals

  crossover(crossover(p1,p2,n1,n2,n3),crossover(p2,p1,n1,n2,n3),n4);
end;

definition
  let S be Gene-Set, p1,p2 be FinSequence of GA-Space S, n1,n2,n3,n4,n5;
  func crossover(p1,p2,n1,n2,n3,n4,n5) -> FinSequence of GA-Space S equals

  crossover(crossover(p1,p2,n1,n2,n3,n4),crossover(p2,p1,n1,n2,n3,n4),n5);
end;

definition
  let S be Gene-Set, p1,p2 be FinSequence of GA-Space S, n1,n2,n3,n4,n5,n6;
  func crossover(p1,p2,n1,n2,n3,n4,n5,n6) -> FinSequence of GA-Space S equals

crossover(crossover(p1,p2,n1,n2,n3,n4,n5), crossover(p2,p1,n1,n2,n3,n4,n5),n6);
end;

begin 

reserve S for Gene-Set;
reserve p1,p2 for Individual of S;

theorem 
  crossover(p1,p2,n) is Individual of S;

definition
  let S be Gene-Set, p1,p2 be Individual of S, n;
  redefine func crossover(p1,p2,n) -> Individual of S;
end;

theorem 
  crossover(p1,p2,0) = p2;

theorem 
  n >= len p1 implies crossover(p1,p2,n) = p1;

begin 

theorem 
  crossover(p1,p2,n1,n2) is Individual of S;

definition
  let S be Gene-Set, p1,p2 be Individual of S, n1,n2;
  redefine func crossover(p1,p2,n1,n2) -> Individual of S;
end;

theorem 
  crossover(p1,p2,0,n) = crossover(p2,p1,n);

theorem 
  crossover(p1,p2,n,0) = crossover(p2,p1,n);

theorem 
  n1 >= len p1 implies crossover(p1,p2,n1,n2)=crossover(p1,p2,n2);

theorem 
  n2 >= len p1 implies crossover(p1,p2,n1,n2)=crossover(p1,p2,n1);

theorem 
  n1 >= len p1 & n2 >= len p1 implies crossover(p1,p2,n1,n2)=p1;

theorem 
  crossover(p1,p2,n1,n1) = p1;

theorem 
  crossover(p1,p2,n1,n2) = crossover(p1,p2,n2,n1);

begin 

theorem 
  crossover(p1,p2,n1,n2,n3) is Individual of S;

definition
  let S be Gene-Set, p1,p2 be Individual of S, n1,n2,n3;
  redefine func crossover(p1,p2,n1,n2,n3) -> Individual of S;
end;

theorem 
  crossover(p1,p2,0,n2,n3) = crossover(p2,p1,n2,n3) & crossover(p1
,p2,n1,0,n3) = crossover(p2,p1,n1,n3) & crossover(p1,p2,n1,n2,0) = crossover(p2
  ,p1,n1,n2);

theorem 
  crossover(p1,p2,0,0,n3) = crossover(p1,p2,n3) & crossover(p1,p2,n1,0,0
  ) = crossover(p1,p2,n1) & crossover(p1,p2,0,n2,0) = crossover(p1,p2,n2);

theorem 
  crossover(p1,p2,0,0,0) = p2;

theorem 
  n1 >= len p1 implies crossover(p1,p2,n1,n2,n3) = crossover(p1,p2 ,n2,n3);

theorem 
  n2 >= len p1 implies crossover(p1,p2,n1,n2,n3) = crossover(p1,p2 ,n1,n3);

theorem 
  n3 >= len p1 implies crossover(p1,p2,n1,n2,n3) = crossover(p1,p2 ,n1,n2);

theorem 
  n1 >= len p1 & n2 >= len p1 implies crossover(p1,p2,n1,n2,n3) =
  crossover(p1,p2,n3);

theorem 
  n1 >= len p1 & n3 >= len p1 implies crossover(p1,p2,n1,n2,n3) =
  crossover(p1,p2,n2);

theorem 
  n2 >= len p1 & n3 >= len p1 implies crossover(p1,p2,n1,n2,n3) =
  crossover(p1,p2,n1);

theorem 
  n1 >= len p1 & n2 >= len p1 & n3 >= len p1 implies crossover(p1,p2,n1,
  n2,n3) = p1;

theorem 
  crossover(p1,p2,n1,n2,n3) = crossover(p1,p2,n2,n1,n3) &
  crossover(p1,p2,n1,n2,n3) = crossover(p1,p2,n1,n3,n2);

theorem 
  crossover(p1,p2,n1,n2,n3) = crossover(p1,p2,n3,n1,n2);

theorem 
  crossover(p1,p2,n1,n1,n3)=crossover(p1,p2,n3) & crossover(p1,p2,
  n1,n2,n1)=crossover(p1,p2,n2) & crossover(p1,p2,n1,n2,n2)=crossover(p1,p2,n1)
;

begin 

theorem 
  crossover(p1,p2,n1,n2,n3,n4) is Individual of S;

definition
  let S be Gene-Set, p1,p2 be Individual of S, n1,n2,n3,n4;
  redefine func crossover(p1,p2,n1,n2,n3,n4) -> Individual of S;
end;

theorem 
  crossover(p1,p2,0,n2,n3,n4) = crossover(p2,p1,n2,n3,n4) &
crossover(p1,p2,n1,0,n3,n4) = crossover(p2,p1,n1,n3,n4) & crossover(p1,p2,n1,n2
,0,n4) = crossover(p2,p1,n1,n2,n4) & crossover(p1,p2,n1,n2,n3,0) = crossover(p2
  ,p1,n1,n2,n3);

theorem 
  crossover(p1,p2,0,0,n3,n4) = crossover(p1,p2,n3,n4) & crossover(
  p1,p2,0,n2,0,n4) = crossover(p1,p2,n2,n4) & crossover(p1,p2,0,n2,n3,0) =
crossover(p1,p2,n2,n3) & crossover(p1,p2,n1,0,n3,0) = crossover(p1,p2,n1,n3) &
crossover(p1,p2,n1,0,0,n4) = crossover(p1,p2,n1,n4) & crossover(p1,p2,n1,n2,0,0
  ) = crossover(p1,p2,n1,n2);

theorem 
  crossover(p1,p2,n1,0,0,0) = crossover(p2,p1,n1) & crossover(p1,
p2,0,n2,0,0) = crossover(p2,p1,n2) & crossover(p1,p2,0,0,n3,0) = crossover(p2,
  p1,n3) & crossover(p1,p2,0,0,0,n4) = crossover(p2,p1,n4);

theorem 
  crossover(p1,p2,0,0,0,0) = p1;

theorem 
  (n1 >= len p1 implies crossover(p1,p2,n1,n2,n3,n4) = crossover(
  p1,p2,n2,n3,n4)) & (n2 >= len p1 implies crossover(p1,p2,n1,n2,n3,n4) =
crossover(p1,p2,n1,n3,n4)) & (n3 >= len p1 implies crossover(p1,p2,n1,n2,n3,n4)
= crossover(p1,p2,n1,n2,n4)) & (n4 >= len p1 implies crossover(p1,p2,n1,n2,n3,
  n4) = crossover(p1,p2,n1,n2,n3));

theorem 
  (n1 >= len p1 & n2 >= len p1 implies crossover(p1,p2,n1,n2,n3,n4
) = crossover(p1,p2,n3,n4)) & (n1 >= len p1 & n3 >= len p1 implies crossover(p1
  ,p2,n1,n2,n3,n4) = crossover(p1,p2,n2,n4)) & (n1 >= len p1 & n4 >= len p1
implies crossover(p1,p2,n1,n2,n3,n4) = crossover(p1,p2,n2,n3)) & (n2 >= len p1
& n3 >= len p1 implies crossover(p1,p2,n1,n2,n3,n4) = crossover(p1,p2,n1,n4)) &
(n2 >= len p1 & n4 >= len p1 implies crossover(p1,p2,n1,n2,n3,n4) = crossover(
p1,p2,n1,n3)) & (n3 >= len p1 & n4 >= len p1 implies crossover(p1,p2,n1,n2,n3,
  n4) = crossover(p1,p2,n1,n2));

theorem 
  (n1 >= len p1 & n2 >= len p1 & n3 >= len p1 implies crossover(p1
,p2,n1,n2,n3,n4) = crossover(p1,p2,n4)) & (n1 >= len p1 & n2 >= len p1 & n4 >=
len p1 implies crossover(p1,p2,n1,n2,n3,n4) = crossover(p1,p2,n3)) & (n1 >= len
  p1 & n3 >= len p1 & n4 >= len p1 implies crossover(p1,p2,n1,n2,n3,n4) =
  crossover(p1,p2,n2)) & (n2 >= len p1 & n3 >= len p1 & n4 >= len p1 implies
  crossover(p1,p2,n1,n2,n3,n4) = crossover(p1,p2,n1));

theorem 
  n1 >= len p1 & n2 >= len p1 & n3 >= len p1 & n4 >= len p1
  implies crossover(p1,p2,n1,n2,n3,n4) = p1;

theorem 
  crossover(p1,p2,n1,n2,n3,n4) = crossover(p1,p2,n1,n2,n4,n3) &
crossover(p1,p2,n1,n2,n3,n4) = crossover(p1,p2,n1,n3,n2,n4) & crossover(p1,p2,
  n1,n2,n3,n4) = crossover(p1,p2,n1,n3,n4,n2) & crossover(p1,p2,n1,n2,n3,n4) =
crossover(p1,p2,n1,n4,n3,n2) & crossover(p1,p2,n1,n2,n3,n4) = crossover(p1,p2,
  n2,n1,n3,n4) & crossover(p1,p2,n1,n2,n3,n4) = crossover(p1,p2,n2,n1,n4,n3) &
crossover(p1,p2,n1,n2,n3,n4) = crossover(p1,p2,n2,n3,n1,n4) & crossover(p1,p2,
  n1,n2,n3,n4) = crossover(p1,p2,n2,n3,n4,n1) & crossover(p1,p2,n1,n2,n3,n4) =
crossover(p1,p2,n2,n4,n1,n3) & crossover(p1,p2,n1,n2,n3,n4) = crossover(p1,p2,
  n2,n4,n3,n1) & crossover(p1,p2,n1,n2,n3,n4) = crossover(p1,p2,n3,n2,n1,n4) &
crossover(p1,p2,n1,n2,n3,n4) = crossover(p1,p2,n3,n2,n4,n1) & crossover(p1,p2,
  n1,n2,n3,n4) = crossover(p1,p2,n3,n4,n1,n2) & crossover(p1,p2,n1,n2,n3,n4) =
crossover(p1,p2,n3,n4,n2,n1) & crossover(p1,p2,n1,n2,n3,n4) = crossover(p1,p2,
  n4,n2,n3,n1) & crossover(p1,p2,n1,n2,n3,n4) = crossover(p1,p2,n4,n3,n2,n1);

theorem 
  crossover(p1,p2,n1,n1,n3,n4) = crossover(p1,p2,n3,n4) &
crossover(p1,p2,n1,n2,n1,n4) = crossover(p1,p2,n2,n4) & crossover(p1,p2,n1,n2,
n3,n1) = crossover(p1,p2,n2,n3) & crossover(p1,p2,n1,n2,n2,n4) = crossover(p1,
p2,n1,n4) & crossover(p1,p2,n1,n2,n3,n2) = crossover(p1,p2,n1,n3) & crossover(
  p1,p2,n1,n2,n3,n3) = crossover(p1,p2,n1,n2);

theorem 
  crossover(p1,p2,n1,n1,n3,n3) = p1 & crossover(p1,p2,n1,n2,n1,n2) = p1
  & crossover(p1,p2,n1,n2,n2,n1) = p1;

begin 

theorem 
  crossover(p1,p2,n1,n2,n3,n4,n5) is Individual of S;

definition
  let S be Gene-Set, p1,p2 be Individual of S, n1,n2,n3,n4,n5;
  redefine func crossover(p1,p2,n1,n2,n3,n4,n5) -> Individual of S;
end;

theorem 
  crossover(p1,p2,0,n2,n3,n4,n5)=crossover(p2,p1,n2,n3,n4,n5) &
crossover(p1,p2,n1,0,n3,n4,n5) = crossover(p2,p1,n1,n3,n4,n5) & crossover(p1,p2
,n1,n2,0,n4,n5) = crossover(p2,p1,n1,n2,n4,n5) & crossover(p1,p2,n1,n2,n3,0,n5)
= crossover(p2,p1,n1,n2,n3,n5) & crossover(p1,p2,n1,n2,n3,n4,0) = crossover(p2,
  p1,n1,n2,n3,n4);

theorem 
  crossover(p1,p2,0,0,n3,n4,n5)=crossover(p1,p2,n3,n4,n5) & crossover(p1
  ,p2,0,n2,0,n4,n5)=crossover(p1,p2,n2,n4,n5) & crossover(p1,p2,0,n2,n3,0,n5)=
crossover(p1,p2,n2,n3,n5) & crossover(p1,p2,0,n2,n3,n4,0)=crossover(p1,p2,n2,n3
,n4) & crossover(p1,p2,n1,0,0,n4,n5)=crossover(p1,p2,n1,n4,n5) & crossover(p1,
  p2,n1,0,n3,0,n5)=crossover(p1,p2,n1,n3,n5) & crossover(p1,p2,n1,0,n3,n4,0)=
crossover(p1,p2,n1,n3,n4) & crossover(p1,p2,n1,n2,0,0,n5)=crossover(p1,p2,n1,n2
,n5) & crossover(p1,p2,n1,n2,0,n4,0)=crossover(p1,p2,n1,n2,n4) & crossover(p1,
  p2,n1,n2,n3,0,0)=crossover(p1,p2,n1,n2,n3);

theorem 
  crossover(p1,p2,0,0,0,n4,n5)=crossover(p2,p1,n4,n5) & crossover(p1,p2,
0,0,n3,0,n5)=crossover(p2,p1,n3,n5) & crossover(p1,p2,0,0,n3,n4,0)=crossover(p2
,p1,n3,n4) & crossover(p1,p2,0,n2,0,0,n5)=crossover(p2,p1,n2,n5) & crossover(p1
  ,p2,0,n2,0,n4,0)=crossover(p2,p1,n2,n4) & crossover(p1,p2,0,n2,n3,0,0)=
crossover(p2,p1,n2,n3) & crossover(p1,p2,n1,0,0,0,n5)=crossover(p2,p1,n1,n5) &
crossover(p1,p2,n1,0,0,n4,0)=crossover(p2,p1,n1,n4) & crossover(p1,p2,n1,0,n3,0
,0)=crossover(p2,p1,n1,n3) & crossover(p1,p2,n1,n2,0,0,0)=crossover(p2,p1,n1,n2
  );

theorem 
  crossover(p1,p2,0,0,0,0,n5)=crossover(p1,p2,n5) & crossover(p1,p2,0,0,
0,n4,0)=crossover(p1,p2,n4) & crossover(p1,p2,0,0,n3,0,0)=crossover(p1,p2,n3) &
crossover(p1,p2,0,n2,0,0,0)=crossover(p1,p2,n2) & crossover(p1,p2,n1,0,0,0,0)=
  crossover(p1,p2,n1);

theorem 
  crossover(p1,p2,0,0,0,0,0)=p2;

theorem 
  (n1>=len p1 implies crossover(p1,p2,n1,n2,n3,n4,n5)=crossover(p1
  ,p2,n2,n3,n4,n5)) & (n2>=len p1 implies crossover(p1,p2,n1,n2,n3,n4,n5)=
crossover(p1,p2,n1,n3,n4,n5)) & (n3>=len p1 implies crossover(p1,p2,n1,n2,n3,n4
,n5)=crossover(p1,p2,n1,n2,n4,n5)) & (n4>=len p1 implies crossover(p1,p2,n1,n2,
n3,n4,n5)=crossover(p1,p2,n1,n2,n3,n5)) & (n5>=len p1 implies crossover(p1,p2,
  n1,n2,n3,n4,n5)=crossover(p1,p2,n1,n2,n3,n4));

theorem 
  (n1>=len p1 & n2>=len p1 implies crossover(p1,p2,n1,n2,n3,n4,n5)=
crossover(p1,p2,n3,n4,n5)) & (n1>=len p1 & n3>=len p1 implies crossover(p1,p2,
  n1,n2,n3,n4,n5)=crossover(p1,p2,n2,n4,n5)) & (n1>=len p1 & n4>=len p1 implies
crossover(p1,p2,n1,n2,n3,n4,n5)=crossover(p1,p2,n2,n3,n5)) & (n1>=len p1 & n5>=
len p1 implies crossover(p1,p2,n1,n2,n3,n4,n5)=crossover(p1,p2,n2,n3,n4)) & (n2
>=len p1 & n3>=len p1 implies crossover(p1,p2,n1,n2,n3,n4,n5)=crossover(p1,p2,
n1,n4,n5)) & (n2>=len p1 & n4>=len p1 implies crossover(p1,p2,n1,n2,n3,n4,n5)=
crossover(p1,p2,n1,n3,n5)) & (n2>=len p1 & n5>=len p1 implies crossover(p1,p2,
  n1,n2,n3,n4,n5)=crossover(p1,p2,n1,n3,n4)) & (n3>=len p1 & n4>=len p1 implies
crossover(p1,p2,n1,n2,n3,n4,n5)=crossover(p1,p2,n1,n2,n5)) & (n3>=len p1 & n5>=
len p1 implies crossover(p1,p2,n1,n2,n3,n4,n5)=crossover(p1,p2,n1,n2,n4)) & (n4
>=len p1 & n5>=len p1 implies crossover(p1,p2,n1,n2,n3,n4,n5)=crossover(p1,p2,
  n1,n2,n3));

theorem 
  (n1>=len p1 & n2>=len p1 & n3>=len p1 implies crossover(p1,p2,n1,n2,n3
,n4,n5)=crossover(p1,p2,n4,n5)) & (n1>=len p1 & n2>=len p1 & n4>=len p1 implies
crossover(p1,p2,n1,n2,n3,n4,n5)=crossover(p1,p2,n3,n5)) & (n1>=len p1 & n2>=len
p1 & n5>=len p1 implies crossover(p1,p2,n1,n2,n3,n4,n5)=crossover(p1,p2,n3,n4))
& (n1>=len p1 & n3>=len p1 & n4>=len p1 implies crossover(p1,p2,n1,n2,n3,n4,n5)
  =crossover(p1,p2,n2,n5)) & (n1>=len p1 & n3>=len p1 & n5>=len p1 implies
crossover(p1,p2,n1,n2,n3,n4,n5)=crossover(p1,p2,n2,n4)) & (n1>=len p1 & n4>=len
p1 & n5>=len p1 implies crossover(p1,p2,n1,n2,n3,n4,n5)=crossover(p1,p2,n2,n3))
& (n2>=len p1 & n3>=len p1 & n4>=len p1 implies crossover(p1,p2,n1,n2,n3,n4,n5)
  =crossover(p1,p2,n1,n5)) & (n2>=len p1 & n3>=len p1 & n5>=len p1 implies
crossover(p1,p2,n1,n2,n3,n4,n5)=crossover(p1,p2,n1,n4)) & (n2>=len p1 & n4>=len
p1 & n5>=len p1 implies crossover(p1,p2,n1,n2,n3,n4,n5)=crossover(p1,p2,n1,n3))
& (n3>=len p1 & n4>=len p1 & n5>=len p1 implies crossover(p1,p2,n1,n2,n3,n4,n5)
  =crossover(p1,p2,n1,n2));

theorem 
  (n1>=len p1 & n2>=len p1 & n3>=len p1 & n4>=len p1 implies crossover(
p1,p2,n1,n2,n3,n4,n5)=crossover(p1,p2,n5)) & (n1>=len p1 & n2>=len p1 & n3>=len
p1 & n5>=len p1 implies crossover(p1,p2,n1,n2,n3,n4,n5)=crossover(p1,p2,n4)) &
(n1>=len p1 & n2>=len p1 & n4>=len p1 & n5>=len p1 implies crossover(p1,p2,n1,
n2,n3,n4,n5)=crossover(p1,p2,n3)) & (n1>=len p1 & n3>=len p1 & n4>=len p1 & n5
  >=len p1 implies crossover(p1,p2,n1,n2,n3,n4,n5)=crossover(p1,p2,n2)) & (n2>=
len p1 & n3>=len p1 & n4>=len p1 & n5>=len p1 implies crossover(p1,p2,n1,n2,n3,
  n4,n5)=crossover(p1,p2,n1));

theorem 
  n1>=len p1 & n2>=len p1 & n3>=len p1 & n4>=len p1 & n5>=len p1 implies
  crossover(p1,p2,n1,n2,n3,n4,n5)=p1;

theorem 
  crossover(p1,p2,n1,n2,n3,n4,n5)=crossover(p1,p2,n2,n1,n3,n4,n5)
& crossover(p1,p2,n1,n2,n3,n4,n5)=crossover(p1,p2,n3,n2,n1,n4,n5) & crossover(
p1,p2,n1,n2,n3,n4,n5)=crossover(p1,p2,n4,n2,n3,n1,n5) & crossover(p1,p2,n1,n2,
  n3,n4,n5)=crossover(p1,p2,n5,n2,n3,n4,n1);

theorem 
  crossover(p1,p2,n1,n1,n3,n4,n5)=crossover(p1,p2,n3,n4,n5) &
crossover(p1,p2,n1,n2,n1,n4,n5)=crossover(p1,p2,n2,n4,n5) & crossover(p1,p2,n1,
  n2,n3,n1,n5)=crossover(p1,p2,n2,n3,n5) & crossover(p1,p2,n1,n2,n3,n4,n1)=
  crossover(p1,p2,n2,n3,n4);

begin 

theorem 
  crossover(p1,p2,n1,n2,n3,n4,n5,n6) is Individual of S;

definition
  let S be Gene-Set,p1,p2 be Individual of S,n1,n2,n3,n4,n5,n6;
  redefine func crossover(p1,p2,n1,n2,n3,n4,n5,n6) -> Individual of S;
end;

theorem 
  crossover(p1,p2,0,n2,n3,n4,n5,n6)=crossover(p2,p1,n2,n3,n4,n5,n6) &
crossover(p1,p2,n1,0,n3,n4,n5,n6)=crossover(p2,p1,n1,n3,n4,n5,n6) & crossover(
p1,p2,n1,n2,0,n4,n5,n6)=crossover(p2,p1,n1,n2,n4,n5,n6) & crossover(p1,p2,n1,n2
,n3,0,n5,n6)=crossover(p2,p1,n1,n2,n3,n5,n6) & crossover(p1,p2,n1,n2,n3,n4,0,n6
)=crossover(p2,p1,n1,n2,n3,n4,n6) & crossover(p1,p2,n1,n2,n3,n4,n5,0)=crossover
  (p2,p1,n1,n2,n3,n4,n5);

theorem 
  (n1 >= len p1 implies crossover(p1,p2,n1,n2,n3,n4,n5,n6)=crossover(p1,
p2,n2,n3,n4,n5,n6)) & (n2 >= len p1 implies crossover(p1,p2,n1,n2,n3,n4,n5,n6)=
crossover(p1,p2,n1,n3,n4,n5,n6)) & (n3 >= len p1 implies crossover(p1,p2,n1,n2,
n3,n4,n5,n6)=crossover(p1,p2,n1,n2,n4,n5,n6)) & (n4 >= len p1 implies crossover
  (p1,p2,n1,n2,n3,n4,n5,n6)=crossover(p1,p2,n1,n2,n3,n5,n6)) & (n5 >= len p1
implies crossover(p1,p2,n1,n2,n3,n4,n5,n6)=crossover(p1,p2,n1,n2,n3,n4,n6)) & (
n6 >= len p1 implies crossover(p1,p2,n1,n2,n3,n4,n5,n6)=crossover(p1,p2,n1,n2,
  n3,n4,n5));

theorem 
  crossover(p1,p2,n1,n2,n3,n4,n5,n6)=crossover(p1,p2,n2,n1,n3,n4,
n5,n6) & crossover(p1,p2,n1,n2,n3,n4,n5,n6)=crossover(p1,p2,n3,n2,n1,n4,n5,n6)
  & crossover(p1,p2,n1,n2,n3,n4,n5,n6)=crossover(p1,p2,n4,n2,n3,n1,n5,n6) &
  crossover(p1,p2,n1,n2,n3,n4,n5,n6)=crossover(p1,p2,n5,n2,n3,n4,n1,n6) &
  crossover(p1,p2,n1,n2,n3,n4,n5,n6)=crossover(p1,p2,n6,n2,n3,n4,n5,n1);

theorem 
  crossover(p1,p2,n1,n1,n3,n4,n5,n6)=crossover(p1,p2,n3,n4,n5,n6) &
crossover(p1,p2,n1,n2,n1,n4,n5,n6)=crossover(p1,p2,n2,n4,n5,n6) & crossover(p1,
p2,n1,n2,n3,n1,n5,n6)=crossover(p1,p2,n2,n3,n5,n6) & crossover(p1,p2,n1,n2,n3,
  n4,n1,n6)=crossover(p1,p2,n2,n3,n4,n6) & crossover(p1,p2,n1,n2,n3,n4,n5,n1)=
  crossover(p1,p2,n2,n3,n4,n5);














begin

reserve i,n for Nat;
reserve m for non empty Nat;
reserve p,q for Tuple of n, BOOLEAN;
reserve d,d1,d2 for Element of BOOLEAN;

definition
  let n be Nat;
  func Bin1 (n) -> Tuple of n, BOOLEAN means


  for i st i in Seg n holds it/.i = IFEQ(i,1,TRUE,FALSE);
end;

definition
  let n be non empty Nat, x be Tuple of n, BOOLEAN;
  func Neg2 (x) -> Tuple of n,BOOLEAN equals

  'not' x + Bin1 (n);
end;

definition
  let n be Nat, x be Tuple of n, BOOLEAN;
  func Intval (x) -> Integer equals


  Absval (x) if x/.n = FALSE
  otherwise Absval (x) - 2 to_power n;
end;

definition
  let n be non empty Nat, z1,z2 be Tuple of n, BOOLEAN;
  func Int_add_ovfl(z1,z2) -> Element of BOOLEAN equals

  'not' (z1/.n) '&' 'not' (z2/.n) '&' (carry(z1,z2)/.n);
end;

definition
  let n be non empty Nat, z1,z2 be Tuple of n, BOOLEAN;
  func Int_add_udfl(z1,z2) -> Element of BOOLEAN equals

  (z1/.n) '&' (z2/.n) '&' 'not' (carry(z1,z2)/.n);
end;

theorem 
  for z1 being Tuple of 2, BOOLEAN holds
  z1=<*FALSE*>^<*FALSE*> implies Intval(z1) = 0;

theorem 
  for z1 being Tuple of 2, BOOLEAN holds
  z1=<*TRUE*>^<*FALSE*> implies Intval(z1) = 1;

theorem 
  for z1 being Tuple of 2, BOOLEAN holds
  z1=<*FALSE*>^<*TRUE*> implies Intval(z1) = -2;

theorem 
  for z1 being Tuple of 2, BOOLEAN holds
  z1=<*TRUE*>^<*TRUE*> implies Intval(z1) = -1;

theorem 
  for i st i in Seg n & i = 1 holds (Bin1(n))/.i = TRUE;

theorem 
  for i st i in Seg n & i <> 1 holds (Bin1(n))/.i = FALSE;

theorem 
  Bin1 (m+1) = Bin1 (m)^<*FALSE*>;

theorem 
  for m holds Intval (Bin1(m)^<*FALSE*>) = 1;

theorem 
  for z being Tuple of m, BOOLEAN for d being Element of BOOLEAN holds
  'not' (z^<* d *>) = 'not' z^<* 'not' d *>;

theorem 
  for z being Tuple of m, BOOLEAN for d being Element of BOOLEAN holds
  Intval(z^<*d*>) =
  Absval(z)-(IFEQ(d,FALSE,0,2 to_power(m)) qua Nat);

theorem 
  for z1,z2 being Tuple of m, BOOLEAN for d1,d2 being Element of BOOLEAN holds
  Intval(z1^<*d1*>+z2^<*d2*>)
  + IFEQ(Int_add_ovfl(z1^<*d1*>,z2^<*d2*>),FALSE,0,2 to_power(m+1))
  - IFEQ(Int_add_udfl(z1^<*d1*>,z2^<*d2*>),FALSE,0,2 to_power(m+1))
  = Intval(z1^<*d1*>) + Intval(z2^<*d2*>);

theorem 
  for z1,z2 being Tuple of m, BOOLEAN for d1,d2 being Element of BOOLEAN holds
  Intval(z1^<*d1*>+z2^<*d2*>) = Intval(z1^<*d1*>) + Intval(z2^<*d2*>)
  - IFEQ(Int_add_ovfl(z1^<*d1*>,z2^<*d2*>),FALSE,0,2 to_power(m+1))
  + IFEQ(Int_add_udfl(z1^<*d1*>,z2^<*d2*>),FALSE,0,2 to_power(m+1));

theorem 
  for m for x being Tuple of m, BOOLEAN holds
  Absval('not' x) = - Absval(x) + 2 to_power m - 1;

theorem 
  for z being Tuple of m, BOOLEAN for d being Element of BOOLEAN holds
  Neg2(z^<*d*>) = Neg2(z)^<*'not' d 'xor' add_ovfl('not' z,Bin1(m))*>;

theorem 
  for z being Tuple of m, BOOLEAN for d being Element of BOOLEAN holds
  Intval(Neg2(z^<*d*>))
  + IFEQ(Int_add_ovfl('not' (z^<*d*>),Bin1(m+1)),FALSE,0,2 to_power(m+1))
  = - Intval(z^<*d*>);

theorem 
  for m for z being Tuple of m, BOOLEAN for d being Element of BOOLEAN holds
  Neg2(Neg2(z^<*d*>)) = z^<*d*>;

definition
  let n be non empty Nat, x, y be Tuple of n, BOOLEAN;
  func x - y -> Tuple of n, BOOLEAN means


  for i st i in Seg n holds
  it/.i = (x/.i) 'xor' ((Neg2(y))/.i) 'xor' ((carry(x,Neg2(y)))/.i);
end;

theorem 
  for x,y being Tuple of m, BOOLEAN holds x - y = x + Neg2(y);

theorem 
  for z1,z2 being Tuple of m, BOOLEAN for d1,d2 being Element of BOOLEAN holds
  z1^<*d1*> - z2^<*d2*>
  = (z1 + Neg2(z2))^<*d1 'xor' 'not' d2 'xor' add_ovfl('not'
  z2,Bin1(m)) 'xor' add_ovfl(z1,Neg2(z2))*>;

theorem 
  for z1,z2 being Tuple of m, BOOLEAN for d1,d2 being Element of BOOLEAN holds
  Intval(z1^<*d1*>-z2^<*d2*>)
  + IFEQ(Int_add_ovfl(z1^<*d1*>,Neg2(z2^<*d2*>)),FALSE,0,2 to_power(m+1))
  - IFEQ(Int_add_udfl(z1^<*d1*>,Neg2(z2^<*d2*>)),FALSE,0,2 to_power(m+1))
  + IFEQ(Int_add_ovfl('not' (z2^<*d2*>),Bin1(m+1)),FALSE,0,2 to_power(m+1))
  = Intval(z1^<*d1*>) - Intval(z2^<*d2*>);














begin 

definition
  let D be non empty set;
  let F be non empty DTree-set of D;
  let Tset be non empty Subset of F;
  redefine mode Element of Tset -> Element of F;
end;

registration
  cluster finite -> finite-order for Tree;
end;

theorem 
  for t being DecoratedTree holds t|<*>NAT = t;

theorem 
  for t being Tree, p,q being FinSequence of NAT st p^q in t holds
  t|(p^q) = (t|p)|q;

theorem 
  for t being DecoratedTree, p,q being FinSequence of NAT st p^q in
  dom t holds t|(p^q) = (t|p)|q;

notation
  let IT be DecoratedTree;
  synonym IT is root for IT is trivial;
end;

definition
  let IT be DecoratedTree;
  redefine attr IT is root means


  dom IT = elementary_tree 0;
end;

theorem 
  for t being DecoratedTree holds t is root iff {} in Leaves dom t;

theorem 
  for t being Tree, p being Element of t holds t|p =
  elementary_tree 0 iff p in Leaves t;

theorem 
  for t being DecoratedTree, p being Node of t holds t|p is root iff p
  in Leaves dom t;

registration
  cluster root for DecoratedTree;
  cluster finite non root for DecoratedTree;
end;

registration
  let x be set;
  cluster root-tree x -> finite root;
end;

definition
  let IT be Tree;
  attr IT is finite-branching means


  for x being Element of IT holds succ x is finite;
end;

registration
  cluster finite-order -> finite-branching for Tree;
end;

definition
  let IT be DecoratedTree;
  attr IT is finite-order means


  dom IT is finite-order;
  attr IT is finite-branching means


  dom IT is finite-branching;
end;

registration
  cluster finite -> finite-order for DecoratedTree;
  cluster finite-order -> finite-branching for DecoratedTree;
end;

registration
  let t be finite-order DecoratedTree;
  cluster dom t -> finite-order;
end;

registration
  let t be finite-branching DecoratedTree;
  cluster dom t -> finite-branching;
end;

registration
  let t be finite-branching Tree;
  let p be Element of t;
  cluster succ p -> finite;
end;

scheme 

  FinOrdSet{f(set) -> set, X() -> finite set}: for n being Element of NAT
  holds f(n) in X() iff n < card X()
provided
 for x being set st x in X() ex n being Element of NAT st x = f(n) and
 for i,j being Element of NAT st i < j & f(j) in X() holds f(i) in X( ) and
 for i,j being Element of NAT st f(i) = f(j) holds i = j;

theorem 
  for t being finite-branching Tree, p being Element of t for n
  being Element of NAT holds p^<*n*> in succ p iff n < card succ p;

definition
  let t be finite-branching Tree;
  let p be Element of t;
  func p succ -> one-to-one FinSequence of t means


  len it = card succ
p & rng it = succ p & for i being Element of NAT st i < len it holds it.(i+1) =
  p^<*i*>;
end;

definition
  let t be finite-branching DecoratedTree;
  let p be FinSequence such that
 p in dom t;
  func succ(t,p) -> FinSequence means


  ex q being Element of dom t st q = p & it = t*(q succ);
end;

theorem 
  for t being finite-branching DecoratedTree ex x being set, p
  being DTree-yielding FinSequence st t = x-tree p;

registration
  let t be finite DecoratedTree;
  let p be Node of t;
  cluster t|p -> finite;
end;

theorem 
  for t being finite Tree, p being Element of t st t = t|p holds p = {};

registration
  let D be non empty set;
  let S be non empty Subset of FinTrees D;
  cluster -> finite for Element of S;
end;

begin 

definition
  let t be DecoratedTree;
  func Subtrees t -> set equals

  {t|p where p is Node of t: not contradiction};
end;

registration
  let t be DecoratedTree;
  cluster Subtrees t -> constituted-DTrees non empty;
end;

definition
  let D be non empty set;
  let t be DecoratedTree of D;
  redefine func Subtrees t -> non empty Subset of Trees D;
end;

definition
  let D be non empty set;
  let t be finite DecoratedTree of D;
  redefine func Subtrees t -> non empty Subset of FinTrees D;
end;

registration
  let t be finite DecoratedTree;
  cluster -> finite for Element of Subtrees t;
end;

reserve x for set,
  t,t1,t2 for DecoratedTree;

theorem 
  x in Subtrees t iff ex n being Node of t st x = t|n;

theorem 
  t in Subtrees t;

theorem 
  t1 is finite & Subtrees t1 = Subtrees t2 implies t1 = t2;

theorem 
  for n being Node of t holds Subtrees (t|n) c= Subtrees t;

definition
  let t be DecoratedTree;
  func FixedSubtrees t -> Subset of [:dom t, Subtrees t:] equals

  {[p,t|p]
  where p is Node of t: not contradiction};
end;

registration
  let t be DecoratedTree;
  cluster FixedSubtrees t -> non empty;
end;

theorem 
  x in FixedSubtrees t iff ex n being Node of t st x = [n,t|n];

theorem 
  [{},t] in FixedSubtrees t;

theorem 
  FixedSubtrees t1 = FixedSubtrees t2 implies t1 = t2;

definition
  let t be DecoratedTree;
  let C be set;
  func C-Subtrees t -> Subset of Subtrees t equals

  {t|p where p is Node of t:
  not p in Leaves dom t or t.p in C};
end;

reserve C for set;

theorem 
  x in C-Subtrees t iff ex n being Node of t st x = t|n & (not n
  in Leaves dom t or t.n in C);

theorem 
  C-Subtrees t is empty iff t is root & not t.{} in C;

definition
  let t be finite DecoratedTree;
  let C be set;
  func C-ImmediateSubtrees t -> Function of C-Subtrees t, (Subtrees t)* means

  for d being DecoratedTree st d in C-Subtrees t for p being FinSequence of
  Subtrees t st p = it.d holds d = (d.{})-tree p;
end;

begin 

definition
  let X be constituted-DTrees non empty set;
  func Subtrees X -> set equals

  {t|p where t is Element of X, p is Node of t:
  not contradiction};
end;

registration
  let X be constituted-DTrees non empty set;
  cluster Subtrees X -> constituted-DTrees non empty;
end;

definition
  let D be non empty set;
  let X be non empty Subset of Trees D;
  redefine func Subtrees X -> non empty Subset of Trees D;
end;

definition
  let D be non empty set;
  let X be non empty Subset of FinTrees D;
  redefine func Subtrees X -> non empty Subset of FinTrees D;
end;

reserve X,Y for non empty constituted-DTrees set;

theorem 
  x in Subtrees X iff ex t being Element of X, n being Node of t st x = t|n;

theorem 
  t in X implies t in Subtrees X;

theorem 
  X c= Y implies Subtrees X c= Subtrees Y;

registration
  let t be DecoratedTree;
  cluster {t} -> constituted-DTrees;
end;

theorem 
  Subtrees {t} = Subtrees t;

theorem 
  Subtrees X = union {Subtrees t where t is Element of X: not contradiction };

definition
  let X be constituted-DTrees non empty set;
  let C be set;
  func C-Subtrees X -> Subset of Subtrees X equals

  {t|p where t is Element of
  X, p is Node of t: not p in Leaves dom t or t.p in C};
end;

theorem 
  x in C-Subtrees X iff ex t being Element of X, n being Node of t
  st x = t|n & (not n in Leaves dom t or t.n in C);

theorem 
  C-Subtrees X is empty iff for t being Element of X holds t is root &
  not t.{} in C;

theorem 
  C-Subtrees {t} = C-Subtrees t;

theorem 
  C-Subtrees X = union {C-Subtrees t where t is Element of X: not
  contradiction};

definition
  let X be non empty constituted-DTrees set such that
 for t being Element of X holds t is finite;
  let C be set;
  func C-ImmediateSubtrees X -> Function of C-Subtrees X, (Subtrees X)* means

  for d being DecoratedTree st d in C-Subtrees X for p being FinSequence of
  Subtrees X st p = it.d holds d = (d.{})-tree p;
end;

registration
  let t be Tree;
  cluster empty for Element of t;
end;

theorem 
  for t being finite DecoratedTree, p being Element of dom t holds len
  succ(t,p) = len (p succ) & dom succ(t,p) = dom (p succ);

theorem 
  for p being FinTree-yielding FinSequence, n being empty Element
  of tree p holds card succ n = len p;

theorem 
  for t being finite DecoratedTree, x being set, p being DTree-yielding
FinSequence st t = x-tree p for n being empty Element of dom t holds succ(t,n)
  = roots p;

registration
  let T be finite-branching DecoratedTree, t being Node of T;
  cluster T|t -> finite-branching;
end;

theorem 
  for t being finite-branching DecoratedTree, p being Node of t,
  q being Node of t|p holds succ(t,p^q) = succ(t|p,q);

begin 

theorem 
  for n being Element of NAT, r being FinSequence ex q being
  FinSequence st q = r|Seg n & q is_a_prefix_of r;

theorem 
  for D being non empty set, r being FinSequence of D, r1,r2 being
FinSequence, k being Element of NAT st k+1 <= len r & r1 = r|Seg (k+1) & r2 = r
  |Seg k holds ex x being Element of D st r1 = r2^<*x*>;

theorem 
  for D being non empty set, r being FinSequence of D, r1 being
FinSequence st 1 <= len r & r1 = r|Seg 1 holds ex x being Element of D st r1 =
  <*x*>;

reserve T for DecoratedTree,
  p for FinSequence of NAT;

theorem 
  T.p = (T|p).{};

reserve T for finite-branching DecoratedTree,
  t for Element of dom T,
  x for FinSequence,
  n, m for Element of NAT;

theorem 
  succ(T,t) = T*(t succ);

theorem 
  dom (T*(t succ)) = dom (t succ);

theorem 
  dom succ(T,t) = dom (t succ);

theorem 
  t^<*n*> in dom T iff n+1 in dom (t succ);

theorem 
  for T, x, n st x^<*n*> in dom T holds T.(x^<*n*>) = succ(T,x).(n +1);

reserve x, x9 for Element of dom T,
  y9 for set;

theorem 
  x9 in succ x implies T.x9 in rng succ(T,x);

theorem 
  y9 in rng succ(T,x) implies ex x9 st y9 = T.x9 & x9 in succ x;

reserve n,k1,k2,l,k,m for Element of NAT,
  x,y for set;

scheme 

  ExDecTrees { D() -> non empty set, d() -> Element of D(), G(set) ->
FinSequence of D() }: ex T being finite-branching DecoratedTree of D() st T.{}
  = d() & for t being Element of dom T, w being Element of D() st w = T.t holds
  succ(T,t) = G(w);

theorem 
  for T being Tree, t being Element of T holds ProperPrefixes t is
  finite Chain of T;

theorem 
  for T being Tree holds T-level 0 = {{}};

theorem 
  for T being Tree holds T-level (n+1) = union { succ w where w is
  Element of T : len w = n };

theorem 
  for T being finite-branching Tree, n being Element of NAT holds
  T-level n is finite;

theorem 
  for T being finite-branching Tree holds T is finite iff ex n
  being Element of NAT st T-level n = {};

theorem 
  for T being finite-branching Tree st not T is finite ex C being
  Chain of T st not C is finite;

theorem 
  for T being finite-branching Tree st not T is finite ex B being
  Branch of T st not B is finite;

theorem 
  for T being Tree, C being Chain of T, t being Element of T st t
  in C & not C is finite ex t9 being Element of T st t9 in C & t
  is_a_proper_prefix_of t9;

theorem 
  for T being Tree, B being Branch of T, t being Element of T st t
  in B & not B is finite ex t9 being Element of T st t9 in B & t9 in succ t;

theorem 
  for f being Function of NAT,NAT st (for n holds f.(n+1) qua
Element of NAT <= f.n qua Element of NAT) ex m st for n st m <= n holds f.n = f
  .m;

scheme 

  FinDecTree { D() -> non empty set,
  T() -> finite-branching (DecoratedTree of D()),
   F(Element of D()) -> Element of NAT }:
   T() is finite
provided
 for t,t9 being Element of dom T(), d being Element of D() st t9 in
succ t & d = T().t9 holds F(d) < F(T().t);














begin 

registration
  let I be set;
  let F be ManySortedFunction of I;
  cluster doms F -> I-defined;
  cluster rngs F -> I-defined;
end;

registration
  let I be set;
  let F be ManySortedFunction of I;
  cluster doms F -> total for I-defined Function;
  cluster rngs F -> total for I-defined Function;
end;

reserve I, G, H, i, x for set,
  A, B, M for ManySortedSet of I,
  sf, sg, sh for Subset-Family of I,
  v, w for Subset of I,
  F for ManySortedFunction of I;

scheme 

  MSFExFunc { I() -> set, A, B() -> ManySortedSet of I(), P[set,set,set] } :
  ex F be ManySortedFunction of A(), B() st for i be set st i in I() holds ex f
be Function of A().i, B().i st f = F.i & for x be set st x in A().i holds P[f.x
  ,x,i]
provided
 for i be set st i in I() holds for x be set st x in A().i ex y be
set st y in B().i & P[y,x,i];

theorem 
  sf <> {} implies Intersect sf c= union sf;

theorem 
  G in sf implies Intersect sf c= G;

theorem 
  {} in sf implies Intersect sf = {};

theorem 
  for Z be Subset of I holds (for Z1 be set st Z1 in sf holds Z c= Z1)
  implies Z c= Intersect sf;

theorem 
  sf <> {} & (for Z1 be set st Z1 in sf holds G c= Z1) implies G c=
  Intersect sf;

theorem 
  G in sf & G c= H implies Intersect sf c= H;

theorem 
  G in sf & G misses H implies Intersect sf misses H;

theorem 
  sh = sf \/ sg implies Intersect sh = Intersect sf /\ Intersect sg;

theorem 
  sf = {v} implies Intersect sf = v;

theorem 
  sf = { v,w } implies Intersect sf = v /\ w;

theorem 
  A in B implies A is Element of B;

theorem 
  for B be non-empty ManySortedSet of I holds A is Element of B implies A in B;

theorem 
  for f be Function st i in I & f = F.i holds (rngs F).i = rng f;

theorem 
  for f be Function st i in I & f = F.i holds (doms F).i = dom f;

theorem 
  for F, G be ManySortedFunction of I holds G ** F is ManySortedFunction of I;

theorem 
  for A be non-empty ManySortedSet of I for F be ManySortedFunction of A
  , [[0]]I holds F = [[0]]I;

theorem 
  A is_transformable_to B & F is ManySortedFunction of A, B implies
  doms F = A & rngs F c= B;

begin 

registration
  let I;
  cluster empty-yielding -> finite-yielding for ManySortedSet of I;
end;

registration
  let I;
  cluster [[0]]I -> empty-yielding finite-yielding;
end;

registration
  let I, A;
  cluster empty-yielding finite-yielding for ManySortedSubset of A;
end;

theorem 
  A c= B & B is finite-yielding implies A is finite-yielding;

registration
  let I;
  let A be finite-yielding ManySortedSet of I;
  cluster -> finite-yielding for ManySortedSubset of A;
end;

registration
  let I;
  let A, B be finite-yielding ManySortedSet of I;
  cluster A \/ B -> finite-yielding;
end;

registration
  let I, A;
  let B be finite-yielding ManySortedSet of I;
  cluster A /\ B -> finite-yielding;
end;

registration
  let I, B;
  let A be finite-yielding ManySortedSet of I;
  cluster A /\ B -> finite-yielding;
end;

registration
  let I, B;
  let A be finite-yielding ManySortedSet of I;
  cluster A \ B -> finite-yielding;
end;

registration
  let I, F;
  let A be finite-yielding ManySortedSet of I;
  cluster F.:.:A -> finite-yielding;
end;

registration
  let I;
  let A, B be finite-yielding ManySortedSet of I;
  cluster [|A,B|] -> finite-yielding;
end;

theorem 
  B is non-empty & [|A,B|] is finite-yielding implies A is finite-yielding;

theorem 
  A is non-empty & [|A,B|] is finite-yielding implies B is finite-yielding;

theorem 
  A is finite-yielding iff bool A is finite-yielding;

registration
  let I;
  let M be finite-yielding ManySortedSet of I;
  cluster bool M -> finite-yielding;
end;

theorem 
  for A be non-empty ManySortedSet of I holds A is finite-yielding & (
for M be ManySortedSet of I st M in A holds M is finite-yielding) implies union
  A is finite-yielding;

theorem 
  union A is finite-yielding implies A is finite-yielding & for M st M
  in A holds M is finite-yielding;

theorem 
  doms F is finite-yielding implies rngs F is finite-yielding;

theorem 
  (A c= rngs F & for i be set for f be Function st i in I & f = F.i
  holds f"(A.i) is finite) implies A is finite-yielding;

registration
  let I;
  let A, B be finite-yielding ManySortedSet of I;
  cluster (Funcs)(A,B) -> finite-yielding;
end;

registration
  let I;
  let A, B be finite-yielding ManySortedSet of I;
  cluster A \+\ B -> finite-yielding;
end;

reserve X, Y, Z for ManySortedSet of I;

theorem 
  X is finite-yielding & X c= [|Y,Z|] implies ex A, B st A is
  finite-yielding & A c= Y & B is finite-yielding & B c= Z & X c= [|A,B|];

theorem 
  X is finite-yielding & X c= [|Y,Z|] implies ex A st A is
  finite-yielding & A c= Y & X c= [|A,Z|];

theorem 
  for M be non-empty finite-yielding ManySortedSet of I st for A, B be
  ManySortedSet of I st A in M & B in M holds A c= B or B c= A ex m be
ManySortedSet of I st m in M & for K be ManySortedSet of I st K in M holds m c=
  K;

theorem 
  for M be non-empty finite-yielding ManySortedSet of I st for A, B be
  ManySortedSet of I st A in M & B in M holds A c= B or B c= A ex m be
ManySortedSet of I st m in M & for K be ManySortedSet of I st K in M holds K c=
  m;

theorem 
  Z is finite-yielding & Z c= rngs F implies ex Y st Y c= doms F & Y is
  finite-yielding & F.:.:Y = Z;

begin 

definition
  let I, M;
  mode MSSubsetFamily of M is ManySortedSubset of bool M;
end;

registration
  let I, M;
  cluster non-empty for MSSubsetFamily of M;
end;

definition
  let I, M;
  redefine func bool M -> MSSubsetFamily of M;
end;

registration
  let I, M;
  cluster empty-yielding finite-yielding for MSSubsetFamily of M;
end;

theorem 
  [[0]]I is empty-yielding finite-yielding MSSubsetFamily of M;

registration
  let I;
  let M be finite-yielding ManySortedSet of I;
  cluster non-empty finite-yielding for MSSubsetFamily of M;
end;

reserve SF, SG, SH for MSSubsetFamily of M,
  SFe for non-empty MSSubsetFamily of M,
  V, W for ManySortedSubset of M;

definition
  let I be non empty set, M be ManySortedSet of I, SF be MSSubsetFamily of M,
  i be Element of I;
  redefine func SF.i -> Subset-Family of (M.i);
end;

theorem 
  i in I implies SF.i is Subset-Family of (M.i);

theorem 
  A in SF implies A is ManySortedSubset of M;

theorem 
  SF \/ SG is MSSubsetFamily of M;

theorem 
  SF /\ SG is MSSubsetFamily of M;

theorem 
  SF \ A is MSSubsetFamily of M;

theorem 
  SF \+\ SG is MSSubsetFamily of M;

theorem 
  A c= M implies {A} is MSSubsetFamily of M;

theorem 
  A c= M & B c= M implies {A,B} is MSSubsetFamily of M;

theorem 
  union SF c= M;

begin 

definition
  let I, M, SF;

  func meet SF -> ManySortedSet of I means


  for i be set st i in I holds
  ex Q be Subset-Family of (M.i) st Q = SF.i & it.i = Intersect Q;
end;

definition
  let I, M, SF;
  redefine func meet SF -> ManySortedSubset of M;
end;

theorem 
  SF = [[0]]I implies meet SF = M;

theorem 
  meet SFe c= union SFe;

theorem 
  A in SF implies meet SF c= A;

theorem 
  [[0]]I in SF implies meet SF = [[0]]I;

theorem 
  for Z, M be ManySortedSet of I for SF be non-empty MSSubsetFamily of M
st (for Z1 be ManySortedSet of I st Z1 in SF holds Z c= Z1) holds Z c= meet SF;

theorem 
  SF c= SG implies meet SG c= meet SF;

theorem 
  A in SF & A c= B implies meet SF c= B;

theorem 
  A in SF & A /\ B = [[0]]I implies meet SF /\ B = [[0]]I;

theorem 
  SH = SF \/ SG implies meet SH = meet SF /\ meet SG;

theorem 
  SF = {V} implies meet SF = V;

theorem 
  SF = { V,W } implies meet SF = V /\ W;

theorem 
  A in meet SF implies for B st B in SF holds A in B;

theorem 
  for A, M be ManySortedSet of I for SF be non-empty MSSubsetFamily of M
  st (A in M & for B be ManySortedSet of I st B in SF holds A in B) holds A in
  meet SF;

definition
  let I, M;
  let IT be MSSubsetFamily of M;
  attr IT is additive means

  for A, B st A in IT & B in IT holds A \/ B in IT;
  attr IT is absolutely-additive means


  for F be MSSubsetFamily of M st F c= IT holds union F in IT;
  attr IT is multiplicative means

  for A, B st A in IT & B in IT holds A /\ B in IT;
  attr IT is absolutely-multiplicative means


  for F be MSSubsetFamily of M st F c= IT holds meet F in IT;
  attr IT is properly-upper-bound means


  M in IT;
  attr IT is properly-lower-bound means


  [[0]]I in IT;
end;

registration
  let I, M;
  cluster non-empty additive absolutely-additive multiplicative
    absolutely-multiplicative properly-upper-bound properly-lower-bound
    for MSSubsetFamily of M;
end;

definition
  let I, M;
  redefine func bool M -> additive absolutely-additive multiplicative
  absolutely-multiplicative properly-upper-bound properly-lower-bound
  MSSubsetFamily of M;
end;

registration
  let I, M;
  cluster absolutely-additive -> additive for MSSubsetFamily of M;
end;

registration
  let I, M;
  cluster absolutely-multiplicative -> multiplicative for MSSubsetFamily of M;
end;

registration
  let I, M;
  cluster absolutely-multiplicative -> properly-upper-bound for
MSSubsetFamily of
    M;
end;

registration
  let I, M;
  cluster properly-upper-bound -> non-empty for MSSubsetFamily of M;
end;

registration
  let I, M;
  cluster absolutely-additive -> properly-lower-bound for MSSubsetFamily of M;
end;

registration
  let I, M;
  cluster properly-lower-bound -> non-empty for MSSubsetFamily of M;
end;














begin 





reserve x,y,X,Y,A,B,C,M for set;
reserve P,Q,R,R1,R2 for Relation;

notation
  let X be set;
  synonym {_{X}_} for SmallestPartition X;
end;

theorem 
  y in {_{X}_} iff ex x st y = {x} & x in X;

theorem 
  X = {} iff {_{X}_} = {};

theorem 
  {_{X\/Y}_} = {_{X}_} \/ {_{Y}_};

theorem 
  {_{X/\Y}_} = {_{X}_} /\ {_{Y}_};

theorem 
  {_{X\Y}_} = {_{X}_} \ {_{Y}_};

theorem 
  X c= Y iff {_{X}_} c= {_{Y}_};

theorem 
  for B1, B2 being Subset-Family of M holds
  Intersect(B1) /\ Intersect(B2) c= Intersect(B1 /\ B2);

theorem 
  (P /\ Q)*R c= (P*R) /\ (Q*R);

begin

theorem 
  y in Im(R,x) iff [x,y] in R;

theorem 
  Im(R1 \/ R2,x) = Im(R1,x) \/ Im(R2,x);

theorem 
  Im(R1 /\ R2,x) = Im(R1,x) /\ Im(R2,x);

theorem 
  Im(R1 \ R2,x) = Im(R1,x) \ Im(R2,x);

theorem 
  (R1 /\ R2).:{_{X}_} c= R1.:{_{X}_} /\ R2.:{_{X}_};

definition
  let X,Y be set;
  let R be Relation of X,Y;
  let x be set;
  redefine func Im(R,x) -> Subset of Y;
  redefine func Coim(R,x) -> Subset of X;
end;

theorem 
  for A being set, F being Subset-Family of A, R be Relation holds
  R.: union F = union {R.:X where X is Subset of A: X in F};



theorem 
  for A being non empty set, X being Subset of A holds
  X = union {{x} where x is Element of A: x in X};

theorem 
  for A being non empty set, X being Subset of A holds
  {{x} where x is Element of A: x in X} is Subset-Family of A;

theorem 
  for A being non empty set, B being set,
  X being Subset of A, R being Relation of A,B
  holds R.:X = union {Class(R,x) where x is Element of A: x in X};

theorem 
  for A being non empty set, B being set, X being Subset of A,
  R being Relation of A,B holds
  {R.:x where x is Element of A: x in X} is Subset-Family of B;

definition

  let A be set, R be Relation;
  func .:(R,A) -> Function means


  dom it = bool A & for X being set st X c= A holds it.X = R.:X;
end;

notation
  let B,A be set;
  let R be Subset of [:A,B:];
  synonym .:R for .:(R,A);
end;

theorem 
  for A,B being set, R being Subset of [:A,B:] st
  X in dom(.:R) holds (.:R).X = R.:X;

theorem 
  for A,B being set, R being Subset of [:A,B:] holds rng(.:R) c= bool rng R;

theorem 
  for A,B being set, R being Subset of [:A,B:]
  holds .:R is Function of bool A, bool rng R;

definition
  let B,A be set;
  let R be Subset of [:A,B:];
  redefine func .:R -> Function of bool A, bool B;
end;

theorem 
  for A,B being set, R being Subset of [:A,B:] holds
  union((.:R).:A) c= R.:(union A);

begin 


reserve X,X1,X2 for Subset of A;
reserve Y for Subset of B;
reserve R,R1,R2 for Subset of [:A,B:];

reserve FR for Subset-Family of [:A,B:];

definition
  let A,B be set, X be Subset of A, R be Subset of [:A,B:];
  func R.:^X equals

  Intersect(.:R.:{_{X}_});
end;

definition
  let A,B be set;
  let X be Subset of A;
  let R be Subset of [:A,B:];
  redefine func R.:^X -> Subset of B;
end;

theorem 
  .:R.:{_{X}_} = {} iff X = {};

theorem 
  y in R.:^X implies for x being set st x in X holds y in Im(R,x);

theorem 
  for B being non empty set, A being set, X being Subset of A,
  y being Element of B, R being Subset of [:A,B:] holds
  y in R.:^X iff for x being set st x in X holds y in Im(R,x);

theorem 
  (.:R).:{_{X1}_} = {} implies R.:^(X1\/X2) = R.:^X2;





theorem 
  R.:^(X1\/X2) = (R.:^X1) /\ (R.:^X2);

theorem 
  for A being non empty set, B being set, F being Subset-Family of A,
  R being Relation of A,B
  holds {R.:^X where X is Subset of A: X in F} is Subset-Family of B;

theorem 
  X = {} implies R.:^X = B;

theorem 
  for A being set,B being non empty set, R being Relation of A,B,
  F being Subset-Family of A, G being Subset-Family of B st
  G = {R.:^Y where Y is Subset of A: Y in F} holds R.:^(union F) = Intersect G;

theorem 
  X1 c= X2 implies R.:^X2 c= R.:^X1;

theorem 
  R.:^X1 \/ R.:^X2 c= R.:^(X1/\X2);

theorem 
  (R1 /\ R2).:^X = (R1.:^X) /\ (R2.:^X);

theorem 
  (union FR).:X = union {R.:X where R is Subset of [:A,B:]: R in FR};



theorem 
  for FR being Subset-Family of [:A,B:], A,B being set,
  X being Subset of A holds
  {R.:^X where R is Subset of [:A,B:]: R in FR} is Subset-Family of B;



theorem 
  R = {} & X <> {} implies R.:^X = {};

theorem 
  R = [:A,B:] implies R.:^X = B;

theorem 
  for G being Subset-Family of B st
  G = {R.:^X where R is Subset of [:A,B:]: R in FR} holds
  (Intersect FR).:^X = Intersect G;

theorem 
  R1 c= R2 implies R1.:^X c= R2.:^X;

theorem 
  (R1.:^X) \/ (R2.:^X) c= (R1 \/ R2).:^X;

theorem 
  y in Im(R`,x) iff not [x,y] in R & x in A & y in B;

theorem 
  X <> {} implies R.:^X c= R.:X;

theorem 
  for X, Y being set holds
  X meets R~.:Y iff ex x,y being set st x in X & y in Y & x in Im(R~,y);

theorem 
  for X, Y being set holds
  (ex x,y being set st x in X & y in Y & x in Im(R~,y)) iff Y meets R.:X;

theorem 
  X misses R~.:Y iff Y misses R.:X;

theorem 
  for X being set holds R.:X = R.:(X /\ proj1 R);

theorem 
  for Y being set holds (R~).:Y = (R~).:(Y /\ proj2 R);

theorem 
  (R.:^X)` = R`.:X;

reserve R for Relation of A,B;
reserve S for Relation of B,C;

definition
  let A,B,C be set;
  let R be Subset of [:A,B:], S be Subset of [:B,C:];
  redefine func R*S -> Relation of A,C;
end;

theorem 
  (R.:X)` = (R`).:^X;



theorem 
  proj1 R = (R~).:B & proj2 R = R.:A;

theorem 
  proj1 (R*S) = (R~).:(proj1 S) & proj1 (R*S) c= proj1 R;

theorem 
  proj2 (R*S) = S.:(proj2 R) & proj2 (R*S) c= proj2 S;

theorem 
  X c= proj1 R iff X c= (R*(R~)).:X;

theorem 
  Y c= proj2 R iff Y c= ((R~)*R).:Y;

theorem 
  proj1 R = (R~).:B & (R~).:(R.:A) = (R~).:(proj2 R);

theorem 
  (R~).:B = (R*(R~)).:A;

theorem 
  R.:A = (R~*R).:B;

theorem 
  S.:^(R.:X) = (R*S`)`.:^X;

theorem 
  (R`)~ = (R~)`;

theorem 
  X c= (R~).:^Y iff Y c= R.:^X;

theorem 
  R.:(X`) c= Y` iff R~.:Y c= X;

theorem 
  X c= (R~).:^(R.:^X) & Y c= R.:^((R~).:^Y);

theorem 
  R.:^X = R.:^( R~.:^(R.:^X) ) & R~.:^Y = (R~).:^(R.:^((R~).:^Y));

theorem 
  (id A)*R = R*(id B);
 

























begin

reserve a,b,c,d,e,z,A,B,C,D,E for set;



definition
  let x be triple set;
  redefine func x`1_3 means


  for y1,y2,y3 being set holds x = [y1,y2,y3] implies
  it = y1;
  redefine func x`2_3 means


  for y1,y2,y3 being set holds x = [y1,y2,y3] implies
  it = y2;
  redefine func x`3_3 means


  for y1,y2,y3 being set holds x = [y1,y2,y3] implies
  it = y3;
end;

theorem 
  (ex a,b,c st z = [a,b,c]) implies z = [ z`1_3, z`2_3, z`3_3 ];

theorem 
  z in [:A,B,C:] implies z`1_3 in A & z`2_3 in B & z`3_3 in C;

theorem 
  z in [:A,B,C:] implies z = [ z`1_3, z`2_3, z`3_3 ];

definition
  let x be quadruple set;
  redefine func x`1_4 means


  for y1,y2,y3,y4 being set holds x = [y1,y2,y3,y4]
  implies it = y1;
  redefine func x`2_4 means


  for y1,y2,y3,y4 being set holds x = [y1,y2,y3,y4]
  implies it = y2;
  redefine func x`3_4 means


  for y1,y2,y3,y4 being set holds x = [y1,y2,y3,y4]
  implies it = y3;
  redefine func x`4_4 means


  for y1,y2,y3,y4 being set holds x = [y1,y2,y3,y4]
  implies it = y4;
end;

theorem 
  (ex a,b,c,d st z = [a,b,c,d]) implies z = [ z`1_4, z`2_4, z`3_4,
  z`4_4 ];

theorem 
  z in [:A,B,C,D:] implies z`1_4 in A & z`2_4 in B & z`3_4 in C & z`4_4 in D;

theorem 
  z in [:A,B,C,D:] implies z = [ z`1_4, z`2_4, z`3_4, z`4_4 ];

definition
 canceled 5;
end;

canceled 3;



scheme 

  ExFunc3Cond { C() -> set, P,Q,R[set], F,G,H(set) -> set }: ex f being
Function st dom f = C() & for c being set st c in C() holds (P[c] implies f.c =
  F(c)) & (Q[c] implies f.c = G(c)) & (R[c] implies f.c = H(c))
provided
 for c being set st c in C() holds (P[c] implies not Q[c]) & (P[c]
implies not R[c]) & (Q[c] implies not R[c]) and
 for c being set st c in C() holds P[c] or Q[c] or R[c];

scheme 

  ExFunc4Cond { C() -> set, P,Q,R,S[set], F,G,H,I(set) -> set }: ex f being
Function st dom f = C() & for c being set st c in C() holds (P[c] implies f.c =
F(c)) & (Q[c] implies f.c = G(c)) & (R[c] implies f.c = H(c)) & (S[c] implies f
  .c = I(c))
provided
 for c being set st c in C() holds (P[c] implies not Q[c]) & (P[c]
implies not R[c]) & (P[c] implies not S[c]) & (Q[c] implies not R[c]) & (Q[c]
implies not S[c]) & (R[c] implies not S[c]) and
 for c being set st c in C() holds P[c] or Q[c] or R[c] or S[c];



scheme 

  DoubleChoiceRec { A, B() -> non empty set, A0() -> Element of A(), B0() ->
  Element of B(), P[set,set,set,set,set] }: ex f being Function of NAT, A(), g
being Function of NAT, B() st f.0 = A0() & g.0 = B0() & for n being Element of
  NAT holds P[n,f.n,g.n,f.(n+1),g.(n+1)]
provided
 for n being Element of NAT, x being Element of A(), y being Element
of B() ex x1 being Element of A(), y1 being Element of B() st P[n,x,y,x1,y1];



scheme 

  LambdaRec2Ex { A,B() -> set, F(set,set,set) -> set }: ex f being Function st
dom f = NAT & f.0 = A() & f.1 = B() & for n being Element of NAT holds f.(n+2)
  = F(n,f.n,f.(n+1));

scheme 

  LambdaRec2ExD { X() -> non empty set, A,B() -> Element of X(), F(set,set,set
) -> Element of X() }: ex f being Function of NAT,X() st f.0 = A() & f.1 = B()
  & for n being Element of NAT holds f.(n+2) = F(n,f.n,f.(n+1));

scheme 

  LambdaRec2Un { A,B() -> set, F,G() -> Function, F(set,set,set) -> set }: F()
  = G()
provided
 dom F() = NAT and
 F().0 = A() & F().1 = B() and
 for n being Element of NAT holds F().(n+2) = F(n,F().n,F().(n+1)) and
 dom G() = NAT and
 G().0 = A() & G().1 = B() and
 for n being Element of NAT holds G().(n+2) = F(n,G().n,G().(n+1));

scheme 

  LambdaRec2UnD { X() -> non empty set, A,B() -> Element of X(), F,G() ->
  Function of NAT,X(), F(set,set,set) -> Element of X() }: F() = G()
provided
 F().0 = A() & F().1 = B() and
 for n being Element of NAT holds F().(n+2) = F(n,F().n,F().(n+1)) and
 G().0 = A() & G().1 = B() and
 for n being Element of NAT holds G().(n+2) = F(n,G().n,G().(n+1));



scheme 

  LambdaRec3Ex { A,B,C() -> set, F(set,set,set,set) -> set }: ex f being
  Function st dom f = NAT & f.0 = A() & f.1 = B() & f.2 = C() & for n being
  Element of NAT holds f.(n+3) = F(n,f.n,f.(n+1),f.(n+2));

scheme 

  LambdaRec3ExD { X() -> non empty set, A,B,C() -> Element of X(), F(set,set,
set,set) -> Element of X() }: ex f being Function of NAT,X() st f.0 = A() & f.1
= B() & f.2 = C() & for n being Element of NAT holds f.(n+3) = F(n,f.n,f.(n+1),
  f.(n+2));

scheme 

  LambdaRec3Un { A,B,C() -> set, F,G() -> Function, F(set,set,set,set) -> set
  }: F() = G()
provided
 dom F() = NAT and
 F().0 = A() & F().1 = B() & F().2 = C() and
 for n being Element of NAT holds F().(n+3) = F(n,F().n,F().(n+1),F()
.(n+2)) and
 dom G() = NAT and
 G().0 = A() & G().1 = B() & G().2 = C() and
 for n being Element of NAT holds G().(n+3) = F(n,G().n,G().(n+1),G()
.(n+2));

scheme 

  LambdaRec3UnD { X() -> non empty set, A,B,C() -> Element of X(), F,G() ->
  Function of NAT,X(), F(set,set,set,set) -> Element of X() }: F() = G()
provided
 F().0 = A() & F().1 = B() & F().2 = C() and
 for n being Element of NAT holds F().(n+3) = F(n,F().n,F().(n+1),F()
.(n+2)) and
 G().0 = A() & G().1 = B() & G().2 = C() and
 for n being Element of NAT holds G().(n+3) = F(n,G().n,G().(n+1),G()
.(n+2));



scheme 

  LambdaRec4Un { A,B,C,D() -> set, F,G() -> Function, F(set,set,set,set,set)
  -> set }: F() = G()
provided
 dom F() = NAT and
 F().0 = A() & F().1 = B() & F().2 = C() & F().3 = D() and
 for n being Element of NAT holds F().(n+4) = F(n,F().n,F().(n+1),F()
.(n+2),F().(n+3)) and
 dom G() = NAT and
 G().0 = A() & G().1 = B() & G().2 = C() & G().3 = D() and
 for n being Element of NAT holds G().(n+4) = F(n,G().n,G().(n+1),G()
.(n+2),G().(n+3));

scheme 

  LambdaRec4UnD { X() -> non empty set, A,B,C,D() -> Element of X(), F,G() ->
  Function of NAT,X(), F(set,set,set,set,set) -> Element of X() }: F() = G()
provided
 F().0 = A() & F().1 = B() & F().2 = C() & F().3 = D() and
 for n being Element of NAT holds F().(n+4) = F(n,F().n,F().(n+1),F()
.(n+2),F().(n+3)) and
 G().0 = A() & G().1 = B() & G().2 = C() & G().3 = D() and
 for n being Element of NAT holds G().(n+4) = F(n,G().n,G().(n+1),G()
.(n+2),G().(n+3));

begin 



theorem 
 for x,y,X,Y,Z being set
  st x`1_3 = y`1_3 & x`2_3 = y`2_3 & x`3_3 = y`3_3 &
  y in [:X,Y,Z:] & x in [:X,Y,Z:]
     holds x = y;















begin

reserve Omega for set;
reserve X, Y, Z, p,x,y,z for set;
reserve D, E for Subset of Omega;
reserve f for Function;
reserve m,n for Element of NAT;
reserve r,r1 for real number;
reserve seq for Real_Sequence;

theorem 
  for r,seq st (ex n st for m st n <= m holds seq.m = r) holds seq
  is convergent & lim seq = r;




definition
  let X be set;
  let IT be Subset-Family of X;
  attr IT is compl-closed means


  for A being Subset of X st A in IT holds A` in IT;
end;

registration
  let X be set;
  cluster bool X -> cap-closed;
end;

registration
  let X be set;
  cluster bool X -> compl-closed for Subset-Family of X;
end;

registration
  let X be set;
  cluster non empty compl-closed cap-closed for Subset-Family of X;
end;

definition
  let X be set;
  mode Field_Subset of X is non empty compl-closed cap-closed
       Subset-Family of X;
end;

reserve F for Field_Subset of X;

theorem 
  for A,B being Subset of X holds {A,B} is Subset-Family of X;

theorem 
  for A, B being set st A in F & B in F holds A \/ B in F;

theorem 
  {} in F;

theorem 
  X in F;

theorem 
  for A,B being Subset of X holds A in F & B in F implies A \ B in F;

theorem 
  for A, B being set holds (A in F & B in F implies (A \ B) \/ B in F);

registration
  let X be set;
  cluster { {}, X } -> cap-closed;
end;

theorem 
  { {}, X } is Field_Subset of X;

theorem 
  bool X is Field_Subset of X;

theorem 
  { {} , X } c= F & F c= bool X;

definition
  let X be set;
  mode SetSequence of X is sequence of bool X;
end;

reserve ASeq,BSeq for SetSequence of Omega;
reserve A1 for SetSequence of X;

theorem 
  union rng A1 is Subset of X;

definition
  let X be set, A1 be SetSequence of X;
  redefine func Union A1 -> Subset of X;
end;

theorem 
  x in Union A1 iff ex n st x in A1.n;

definition
  let X be set, A1 be SetSequence of X;

  func Complement A1 -> SetSequence of X means


  for n holds it.n = (A1.n )`;
  involutiveness;
end;

definition
  let X be set, A1 be SetSequence of X;
  func Intersection A1 -> Subset of X equals

  (Union Complement A1)`;
end;

theorem 
  x in Intersection A1 iff for n holds x in A1.n;

theorem 
  for A, B being Subset of X holds Intersection(A followed_by B) = A /\ B;

definition
  let f be Function;
  attr f is non-ascending means


  for n,m st n <= m holds f.m c= f.n;
  attr f is non-descending means

  for n,m st n <= m holds f.n c= f.m;
end;

definition
  let X be set, F be Subset-Family of X;
  attr F is sigma-multiplicative means


  for A1 being SetSequence of X st rng A1 c= F holds Intersection A1 in F;
end;

registration
  let X be set;
  cluster bool X -> sigma-multiplicative for Subset-Family of X;
end;

registration
  let X be set;
  cluster compl-closed sigma-multiplicative non empty for Subset-Family of X;
end;

definition
  let X be set;
  mode SigmaField of X is compl-closed sigma-multiplicative non empty
    Subset-Family of X;
end;

theorem 
  for S being non empty set holds S is SigmaField of X iff S c= bool X &
  (for A1 being SetSequence of X st rng A1 c= S holds Intersection A1 in S) &
  for A being Subset of X st A in S holds A` in S;

theorem 
  Y is SigmaField of X implies Y is Field_Subset of X;

registration
  let X be set;
  cluster -> cap-closed compl-closed for SigmaField of X;
end;

reserve Sigma for SigmaField of Omega;
reserve Si for SigmaField of X;






registration
  let X be set, F be non empty Subset-Family of X;
  cluster F-valued for SetSequence of X;
end;

definition
  let X be set, F be non empty Subset-Family of X;
  mode SetSequence of F is F-valued SetSequence of X;
end;

theorem 
  for ASeq being SetSequence of Si holds Union ASeq in Si;

notation
  let X be set, F be SigmaField of X;
  synonym Event of F for Element of F;
end;

definition
  let X be set, F be SigmaField of X;
  redefine mode Event of F -> Subset of X;
end;

theorem 
  x in Si implies x is Event of Si;

theorem 
  for A,B being Event of Si holds A /\ B is Event of Si;

theorem 
  for A being Event of Si holds A` is Event of Si;

theorem 
  for A,B being Event of Si holds A \/ B is Event of Si;

theorem 
  {} is Event of Si;

theorem 
  X is Event of Si;

theorem 
  for A,B being Event of Si holds A \ B is Event of Si;

registration
  let X,Si;
  cluster empty for Event of Si;
end;

definition

  let X,Si;

  func [#] Si -> Event of Si equals

  X;
end;

definition
  let X,Si;
  let A,B be Event of Si;
  redefine func A /\ B -> Event of Si;
  redefine func A \/ B -> Event of Si;
  redefine func A \ B -> Event of Si;
end;

theorem 
  A1 is SetSequence of Si iff for n holds A1.n is Event of Si;

theorem 
  ASeq is SetSequence of Sigma implies Union ASeq is Event of Sigma;



reserve A, B for Event of Sigma,
  ASeq for SetSequence of Sigma;

theorem 
  ex f st (dom f = Sigma & for D st D in Sigma holds (p in D
  implies f.D = 1) & (not p in D implies f.D = 0));

reserve P for Function of Sigma,REAL;

theorem 
  ex P st for D st D in Sigma holds (p in D implies P.D = 1) & (
  not p in D implies P.D = 0);

theorem 
  P * ASeq is Real_Sequence;

definition
  let Omega,Sigma,ASeq,P;
  redefine func P * ASeq -> Real_Sequence;
end;

reserve Omega for non empty set;
reserve Sigma for SigmaField of Omega;
reserve A, B for Event of Sigma,
  ASeq for SetSequence of Sigma;
reserve P for Function of Sigma,REAL;
reserve D, E for Subset of Omega;
reserve BSeq for SetSequence of Omega;

definition
  let Omega,Sigma;

  mode Probability of Sigma -> Function of Sigma,REAL means


  (for A holds 0 <= it.A) & it.Omega = 1 &
  (for A,B st A misses B holds it.(A \/ B) = it.A + it.B) &
  for ASeq st ASeq is non-ascending holds it * ASeq is convergent &
    lim (it * ASeq) = it.Intersection ASeq;
end;

reserve P for Probability of Sigma;

registration
  let Omega,Sigma;
  cluster -> zeroed for Probability of Sigma;
end;

theorem 
  P.([#] Sigma) = 1;

theorem 
  P.(([#] Sigma) \ A) + P.A = 1;

theorem 
  P.(([#] Sigma) \ A) = 1 - P.A;

theorem 
  A c= B implies P.(B \ A) = P.B - P.A;

theorem 
  A c= B implies P.A <= P.B;

theorem 
  P.A <= 1;

theorem 
  P.(A \/ B) = P.A + P.(B \ A);

theorem 
  P.(A \/ B) = P.A + P.(B \ (A /\ B));

theorem 
  P.(A \/ B) = P.A + P.B - P.(A /\ B);

theorem 
  P.(A \/ B) <= P.A + P.B;




reserve D for Subset of REAL;
reserve S for Subset-Family of Omega;

theorem 
  bool X is SigmaField of X;

definition
  let Omega;
  let X be Subset-Family of Omega;
  func sigma(X) -> SigmaField of Omega means

  X c= it & for Z st X c= Z & Z is SigmaField of Omega holds it c= Z;
end;

definition
  let r be ext-real number;
  func halfline r -> Subset of REAL equals

  ].-infty,r.[;
end;

definition
  func Family_of_halflines -> Subset-Family of REAL equals

  { halfline(r) where r is Element of REAL: not contradiction };
end;

definition
  func Borel_Sets -> SigmaField of REAL equals

  sigma(Family_of_halflines);
end;

theorem 
  for A, B being Subset of X holds Complement (A followed_by B) = A`
  followed_by B`;

definition
  let X, Y be set;
  let A be Subset-Family of X;
  let F be Function of Y, bool A;
  let x be set;
  redefine func F.x -> Subset-Family of X;
end;















begin

reserve Omega for set;
reserve m,n,k for Element of NAT;
reserve x,y for set;
reserve r,r1,r2,r3 for Real;
reserve seq,seq1 for Real_Sequence;
reserve Sigma for SigmaField of Omega;
reserve ASeq,BSeq for SetSequence of Sigma;
reserve A, B, C, A1, A2, A3 for Event of Sigma;

theorem 
  for r,r1,r2,r3 st r <> 0 & r1 <> 0 holds (r3/r1 = r2/r iff r3 * r = r2 * r1);

theorem 
  (seq is convergent & for n holds seq1.n = r - seq.n) implies seq1
  is convergent & lim seq1 = r - lim seq;

definition
  let Omega,Sigma,ASeq,n;
  redefine func ASeq.n -> Event of Sigma;
end;

definition
  let Omega,Sigma,ASeq;
  func @Intersection ASeq -> Event of Sigma equals

   
  Intersection ASeq;
end;

theorem 
  ex BSeq st for n holds BSeq.n = ASeq.n /\ B;

theorem 
  (ASeq is non-ascending & for n holds BSeq.n = ASeq.n /\ B)
  implies BSeq is non-ascending;

theorem 
  (for n holds BSeq.n = ASeq.n /\ B) implies (Intersection ASeq)
  /\ B = Intersection BSeq;

registration
  let Omega,Sigma,ASeq;
  cluster Complement ASeq -> Sigma-valued;
end;

theorem 
  for X being set, S being SetSequence of X holds S is non-ascending iff
  for n holds S.(n+1) c= S.n;

theorem 
  for X being set, S being SetSequence of X holds S is non-descending
  iff for n holds S.n c= S.(n+1);

theorem 
  for ASeq being SetSequence of Omega holds (ASeq is non-ascending
  iff Complement ASeq is non-descending);

definition

  let F be Function;
  attr F is disjoint_valued means


  x <> y implies F.x misses F.y;
end;

definition
  let Omega,Sigma,ASeq;
  redefine attr ASeq is disjoint_valued means

  for m,n st m <> n holds ASeq.m misses ASeq.n;
end;





reserve Omega for non empty set;
reserve Sigma for SigmaField of Omega;
reserve A, B, C, A1, A2, A3 for Event of Sigma;
reserve ASeq,BSeq for SetSequence of Sigma;
reserve P,P1,P2 for Probability of Sigma;

theorem 
  (for A holds P.A = P1.A) implies P = P1;

theorem 
 
  for P being Function of Sigma,REAL holds P is Probability of Sigma iff
(for A holds 0 <= P.A) & P.Omega = 1 & (for A,B st A misses B holds P.(A \/ B)
= P.A + P.B) & for ASeq st ASeq is non-descending holds P * ASeq is convergent
  & lim (P * ASeq) = P.Union ASeq;

theorem 
  P.(A \/ B \/ C) = P.A + P.B + P.C - (P.(A /\ B) + P.(B /\ C) + P.(A /\
  C)) + P.(A /\ B /\ C);

theorem 
  P.(A \ (A /\ B)) = P.A - P.(A /\ B);

theorem 
  P.(A /\ B) <= P.B & P.(A /\ B) <= P.A;

theorem 
  C = B` implies P.A = P.(A /\ B) + P.(A /\ C);

theorem 
  P.A + P.B - 1 <= P.(A /\ B);

theorem 
  P.A = 1 - P.([#] Sigma \ A);

theorem 
  P.A < 1 iff 0 < P.([#] Sigma \ A);

theorem 
  P.([#] Sigma \ A) < 1 iff 0 < P.A;





definition
  let Omega, Sigma, P, A, B;
  pred A,B are_independent_respect_to P means


  P.(A /\ B) = P.A * P.B;
  let C;
  pred A,B,C are_independent_respect_to P means


  P.(A /\ B /\ C) = P.A *
P.B * P.C & P.(A /\ B) = P.A * P.B & P.(A /\ C) = P.A * P.C & P.(B /\ C) = P.B
  * P.C;
end;

theorem 
  A,B are_independent_respect_to P implies B,A are_independent_respect_to P;

theorem 
  A,B,C are_independent_respect_to P iff P.(A /\ B /\ C) = P.A * P
.B * P.C & A,B are_independent_respect_to P & B,C are_independent_respect_to P
  & A,C are_independent_respect_to P;

theorem 
  A,B,C are_independent_respect_to P implies B,A,C are_independent_respect_to P
;

theorem 
  A,B,C are_independent_respect_to P implies A,C,B are_independent_respect_to P
;

theorem 
  for E being Event of Sigma st E = {} holds A, E are_independent_respect_to P;

theorem 
  A, [#] Sigma are_independent_respect_to P;

theorem 
  for A,B,P st A,B are_independent_respect_to P holds A,([#] Sigma
  \ B) are_independent_respect_to P;

theorem 
  A,B are_independent_respect_to P implies ([#] Sigma \ A),([#]
  Sigma \ B) are_independent_respect_to P;

theorem 
  for A,B,C,P st A,B are_independent_respect_to P & A,C
  are_independent_respect_to P & B misses C holds A,B \/ C
  are_independent_respect_to P;

theorem 
  for P,A,B st A,B are_independent_respect_to P & P.A < 1 & P.B < 1
  holds P.(A \/ B) < 1;





definition
  let Omega,Sigma,P,B;
  assume
 0 < P.B;
  func P.|.B -> Probability of Sigma means


  for A holds it.A = P.(A /\ B )/P.B;
end;

theorem 
  for P,B,A st 0 < P.B holds P.(A /\ B) = P.|.B.A * P.B;

theorem 
  for P,A,B,C st 0 < P.(A /\ B) holds P.(A /\ B /\ C) = P.A * P.|.A.B *
  P.|.(A /\ B).C;

theorem 
  for P,A,B,C st C = B` & 0 < P.B & 0 < P.C holds P.A = P.|.B.A *
  P.B + P.|.C.A * P.C;

theorem 
  for P,A,A1,A2,A3 st A1 misses A2 & A3 = (A1 \/ A2)` & 0 < P.A1 &
0 < P.A2 & 0 < P.A3 holds P.A = (P.|.A1.A * P.A1) + (P.|.A2.A * P.A2) + (P.|.A3
  .A * P.A3);

theorem 
  for P,A,B st 0 < P.B holds (P.|.B.A = P.A iff A,B
  are_independent_respect_to P);

theorem 
  for P,A,B st 0 < P.B & P.B < 1 & P.|.B.A = P.|.([#] Sigma \ B).A holds
  A,B are_independent_respect_to P;

theorem 
  for P,A,B st 0 < P.B holds (P.A + P.B - 1)/ P.B <= P.|.B.A;

theorem 
  for A,B,P st 0 < P.A & 0 < P.B holds P.|.B.A = P.|.A.B * P.A / P .B;

theorem 


  for B,A1,A2,P st 0 < P.B & A2 = A1` & 0 < P.A1 & 0 < P.A2 holds P.|.B.
A1 = (P.|.A1.B * P.A1) / (P.|.A1.B * P.A1 + P.|.A2.B * P.A2) & P.|.B.A2 = (P.|.
  A2.B * P.A2) / (P.|.A1.B * P.A1 + P.|.A2.B * P.A2);

theorem 


  for B,A1,A2,A3,P st 0<P.B & 0<P.A1 & 0<P.A2 & 0<P.A3 & A1 misses A2 &
A3=(A1 \/ A2)` holds P.|.B.A1 = (P.|.A1.B * P.A1)/((P.|.A1.B * P.A1 + P.|.A2.B
* P.A2) + P.|. A3.B * P.A3) & P.|.B.A2 = (P.|.A2.B * P.A2)/((P.|.A1.B * P.A1 +
P.|.A2.B * P.A2) + P.|. A3.B * P.A3) & P.|.B.A3 = (P.|.A3.B * P.A3)/((P.|.A1.B
  * P.A1 + P.|.A2.B * P.A2) + P.|. A3.B * P.A3);

theorem 
  for A,B,P st 0 < P.B holds 1 - P.([#] Sigma \ A)/P.B <= P.|.B.A;















begin

reserve r,r1,g for real number,
  n,m,k for Element of NAT,
  seq,seq1, seq2 for Real_Sequence,
  f,f1,f2 for PartFunc of REAL,REAL,
  x for set;

notation
  let r be real number;
  synonym left_open_halfline r for halfline r;
end;

definition
  let r be real number;
  func left_closed_halfline r -> Subset of REAL equals

  ].-infty,r.];
  func right_closed_halfline r -> Subset of REAL equals

  [.r,+infty.[;
  func right_open_halfline r -> Subset of REAL equals

  ].r,+infty.[;
end;

theorem 
  (seq is non-decreasing implies seq is bounded_below) & (seq is
  non-increasing implies seq is bounded_above);

theorem 
  seq is non-zero & seq is convergent & lim seq=0 & seq is
  non-decreasing implies for n holds seq.n<0;

theorem 
  seq is non-zero & seq is convergent & lim seq=0 & seq is
  non-increasing implies for n holds 0<seq.n;

theorem 
  seq is convergent & 0<lim seq implies ex n st for m st n<=m holds 0<seq.m;

theorem 
  seq is convergent & 0<lim seq implies ex n st for m st n<=m
  holds (lim seq)/2<seq.m;

reserve r,r1,r2,g,g1,g2 for Real;

definition
  let seq;
  attr seq is divergent_to+infty means


  for r ex n st for m st n<=m holds r<seq.m;
  attr seq is divergent_to-infty means


  for r ex n st for m st n<=m holds seq.m<r;
end;

theorem 
  seq is divergent_to+infty or seq is divergent_to-infty implies ex n st
  for m st n<=m holds seq^\m is non-zero;

theorem 
  (seq^\k is divergent_to+infty implies seq is divergent_to+infty)
  & (seq^\k is divergent_to-infty implies seq is divergent_to-infty);

theorem 
  seq1 is divergent_to+infty & seq2 is divergent_to+infty implies
  seq1+seq2 is divergent_to+infty;

theorem 
  seq1 is divergent_to+infty & seq2 is bounded_below implies seq1+
  seq2 is divergent_to+infty;

theorem 
  seq1 is divergent_to+infty & seq2 is divergent_to+infty implies
  seq1(#)seq2 is divergent_to+infty;

theorem 
  seq1 is divergent_to-infty & seq2 is divergent_to-infty implies
  seq1+seq2 is divergent_to-infty;

theorem 
  seq1 is divergent_to-infty & seq2 is bounded_above implies seq1+
  seq2 is divergent_to-infty;

theorem 
  (seq is divergent_to+infty & r>0 implies r(#)seq is
  divergent_to+infty) & (seq is divergent_to+infty & r<0 implies r(#)seq is
  divergent_to-infty) & ( r=0 implies rng (r(#)seq)={0} & r(#) seq is constant)
;

theorem 
  (seq is divergent_to-infty & r>0 implies r(#)seq is
  divergent_to-infty) & (seq is divergent_to-infty & r<0 implies r(#)seq is
  divergent_to+infty) & ( r=0 implies rng (r(#)seq)={0} & r(#) seq is constant)
;

theorem 
  (seq is divergent_to+infty implies -seq is divergent_to-infty) & (seq
  is divergent_to-infty implies -seq is divergent_to+infty);

theorem 
  seq is bounded_below & seq1 is divergent_to-infty implies seq-seq1 is
  divergent_to+infty;

theorem 
  seq is bounded_above & seq1 is divergent_to+infty implies seq-seq1 is
  divergent_to-infty;

theorem 
  seq is divergent_to+infty & seq1 is convergent implies seq+seq1 is
  divergent_to+infty;

theorem 
  seq is divergent_to-infty & seq1 is convergent implies seq+seq1 is
  divergent_to-infty;

theorem 
  (for n holds seq.n=n) implies seq is divergent_to+infty;

theorem 
  (for n holds seq.n=-n) implies seq is divergent_to-infty;

theorem 
  seq1 is divergent_to+infty & (ex r st r>0 & for n holds seq2.n>=
  r) implies seq1(#)seq2 is divergent_to+infty;

theorem 
  seq1 is divergent_to-infty & (ex r st 0<r & for n holds seq2.n>=r)
  implies seq1(#)seq2 is divergent_to-infty;

theorem 
  seq1 is divergent_to-infty & seq2 is divergent_to-infty implies
  seq1(#)seq2 is divergent_to+infty;

theorem 
  (seq is divergent_to+infty or seq is divergent_to-infty) implies
  abs(seq) is divergent_to+infty;

theorem 
  seq is divergent_to+infty & seq1 is subsequence of seq implies
  seq1 is divergent_to+infty;

theorem 
  seq is divergent_to-infty & seq1 is subsequence of seq implies
  seq1 is divergent_to-infty;

theorem 
  seq1 is divergent_to+infty & seq2 is convergent & 0<lim seq2 implies
  seq1(#)seq2 is divergent_to+infty;

theorem 
  seq is non-decreasing & not seq is bounded_above implies seq is
  divergent_to+infty;

theorem 
  seq is non-increasing & not seq is bounded_below implies seq is
  divergent_to-infty;

theorem 
  seq is increasing & not seq is bounded_above implies seq is
  divergent_to+infty;

theorem 
  seq is decreasing & not seq is bounded_below implies seq is
  divergent_to-infty;

theorem 
  seq is monotone implies seq is convergent or seq is divergent_to+infty
  or seq is divergent_to-infty;

theorem 
  (seq is divergent_to+infty or seq is divergent_to-infty) implies
  seq" is convergent & lim(seq")=0;

theorem 
  seq is convergent & lim seq=0 & (ex k st for n st k<=n holds 0<
  seq.n) implies seq" is divergent_to+infty;

theorem 
  seq is convergent & lim seq=0 & (ex k st for n st k<=n holds seq
  .n<0) implies seq" is divergent_to-infty;

theorem 
  seq is non-zero & seq is convergent & lim seq=0 & seq is
  non-decreasing implies seq" is divergent_to-infty;

theorem 
  seq is non-zero & seq is convergent & lim seq=0 & seq is
  non-increasing implies seq" is divergent_to+infty;

theorem 
  seq is non-zero & seq is convergent & lim seq=0 & seq is increasing
  implies seq" is divergent_to-infty;

theorem 
  seq is non-zero & seq is convergent & lim seq=0 & seq is decreasing
  implies seq" is divergent_to+infty;

theorem 
  seq1 is bounded & (seq2 is divergent_to+infty or seq2 is
  divergent_to-infty) implies seq1/"seq2 is convergent & lim(seq1/"seq2)=0;

theorem 
  seq is divergent_to+infty & (for n holds seq.n<=seq1.n) implies
  seq1 is divergent_to+infty;

theorem 
  seq is divergent_to-infty & (for n holds seq1.n<=seq.n) implies
  seq1 is divergent_to-infty;

definition
  let f;
  attr f is convergent_in+infty means


  (for r ex g st r<g & g in dom f)
& ex g st for seq st seq is divergent_to+infty & rng seq c= dom f holds f/*seq
  is convergent & lim(f/*seq)=g;
  attr f is divergent_in+infty_to+infty means


  (for r ex g st r<g & g in
  dom f) & for seq st seq is divergent_to+infty & rng seq c= dom f holds f/*seq
  is divergent_to+infty;
  attr f is divergent_in+infty_to-infty means


  (for r ex g st r<g & g in
  dom f) & for seq st seq is divergent_to+infty & rng seq c= dom f holds f/*seq
  is divergent_to-infty;
  attr f is convergent_in-infty means


  (for r ex g st g<r & g in dom f)
& ex g st for seq st seq is divergent_to-infty & rng seq c= dom f holds f/*seq
  is convergent & lim(f/*seq)=g;
  attr f is divergent_in-infty_to+infty means


  (for r ex g st g<r & g
  in dom f) & for seq st seq is divergent_to-infty & rng seq c= dom f holds f/*
  seq is divergent_to+infty;
  attr f is divergent_in-infty_to-infty means


  (for r ex g st g<r & g
  in dom f) & for seq st seq is divergent_to-infty & rng seq c= dom f holds f/*
  seq is divergent_to-infty;
end;

theorem 
  f is convergent_in+infty iff (for r ex g st r<g & g in dom f) & ex g
  st for g1 st 0<g1 ex r st for r1 st r<r1 & r1 in dom f holds abs(f.r1-g)<g1;

theorem 
  f is convergent_in-infty iff (for r ex g st g<r & g in dom f) & ex g
  st for g1 st 0<g1 ex r st for r1 st r1<r & r1 in dom f holds abs(f.r1-g)<g1;

theorem 
  f is divergent_in+infty_to+infty iff (for r ex g st r<g & g in dom f)
  & for g ex r st for r1 st r<r1 & r1 in dom f holds g<f.r1;

theorem 
  f is divergent_in+infty_to-infty iff (for r ex g st r<g & g in dom f)
  & for g ex r st for r1 st r<r1 & r1 in dom f holds f.r1<g;

theorem 
  f is divergent_in-infty_to+infty iff (for r ex g st g<r & g in dom f)
  & for g ex r st for r1 st r1<r & r1 in dom f holds g<f.r1;

theorem 
  f is divergent_in-infty_to-infty iff (for r ex g st g<r & g in dom f)
  & for g ex r st for r1 st r1<r & r1 in dom f holds f.r1<g;

theorem 
  f1 is divergent_in+infty_to+infty & f2 is divergent_in+infty_to+infty
  & (for r ex g st r<g & g in dom f1 /\ dom f2) implies f1+f2 is
  divergent_in+infty_to+infty & f1(#)f2 is divergent_in+infty_to+infty;

theorem 
  f1 is divergent_in+infty_to-infty & f2 is divergent_in+infty_to-infty
  & (for r ex g st r<g & g in dom f1 /\ dom f2) implies f1+f2 is
  divergent_in+infty_to-infty & f1(#)f2 is divergent_in+infty_to+infty;

theorem 
  f1 is divergent_in-infty_to+infty & f2 is divergent_in-infty_to+infty
  & (for r ex g st g<r & g in dom f1 /\ dom f2) implies f1+f2 is
  divergent_in-infty_to+infty & f1(#)f2 is divergent_in-infty_to+infty;

theorem 
  f1 is divergent_in-infty_to-infty & f2 is divergent_in-infty_to-infty
  & (for r ex g st g<r & g in dom f1 /\ dom f2) implies f1+f2 is
  divergent_in-infty_to-infty & f1(#)f2 is divergent_in-infty_to+infty;

theorem 
  f1 is divergent_in+infty_to+infty & (for r ex g st r<g & g in dom(f1+
  f2)) & (ex r st f2|right_open_halfline r is bounded_below) implies f1+f2 is
  divergent_in+infty_to+infty;

theorem 
  f1 is divergent_in+infty_to+infty & (for r ex g st r<g & g in dom(f1
  (#)f2 ) ) & (ex r,r1 st 0<r & for g st g in dom f2 /\ right_open_halfline(r1)
  holds r<=f2.g) implies f1(#)f2 is divergent_in+infty_to+infty;

theorem 
  f1 is divergent_in-infty_to+infty & (for r ex g st g<r & g in dom(f1+
  f2)) & (ex r st f2|left_open_halfline r is bounded_below) implies f1+f2 is
  divergent_in-infty_to+infty;

theorem 
  f1 is divergent_in-infty_to+infty & (for r ex g st g<r & g in dom(f1
  (#)f2 ) ) & (ex r,r1 st 0<r & for g st g in dom f2 /\ left_open_halfline(r1)
  holds r<=f2.g) implies f1(#)f2 is divergent_in-infty_to+infty;

theorem 
  (f is divergent_in+infty_to+infty & r>0 implies r(#)f is
divergent_in+infty_to+infty) & (f is divergent_in+infty_to+infty & r<0 implies
r(#)f is divergent_in+infty_to-infty) & (f is divergent_in+infty_to-infty & r>0
  implies r(#)f is divergent_in+infty_to-infty) & (f is
divergent_in+infty_to-infty & r<0 implies r(#)f is divergent_in+infty_to+infty)
;

theorem 
  (f is divergent_in-infty_to+infty & r>0 implies r(#)f is
divergent_in-infty_to+infty) & (f is divergent_in-infty_to+infty & r<0 implies
r(#)f is divergent_in-infty_to-infty) & (f is divergent_in-infty_to-infty & r>0
  implies r(#)f is divergent_in-infty_to-infty) & (f is
divergent_in-infty_to-infty & r<0 implies r(#)f is divergent_in-infty_to+infty)
;

theorem 
  (f is divergent_in+infty_to+infty or f is divergent_in+infty_to-infty)
  implies abs(f) is divergent_in+infty_to+infty;

theorem 
  (f is divergent_in-infty_to+infty or f is divergent_in-infty_to-infty)
  implies abs(f) is divergent_in-infty_to+infty;

theorem 
  (ex r st f|right_open_halfline r is non-decreasing & not f|
  right_open_halfline r is bounded_above) & (for r ex g st r<g & g in dom f)
  implies f is divergent_in+infty_to+infty;

theorem 
  (ex r st f|right_open_halfline r is increasing & not f|
  right_open_halfline r is bounded_above) & (for r ex g st r<g & g in dom f)
  implies f is divergent_in+infty_to+infty;

theorem 
  (ex r st f|right_open_halfline r is non-increasing & not f|
  right_open_halfline r is bounded_below) & (for r ex g st r<g & g in dom f)
  implies f is divergent_in+infty_to-infty;

theorem 
  (ex r st f|right_open_halfline r is decreasing & not f|
  right_open_halfline r is bounded_below) & (for r ex g st r<g & g in dom f)
  implies f is divergent_in+infty_to-infty;

theorem 
  (ex r st f|left_open_halfline r is non-increasing & not f|
  left_open_halfline r is bounded_above) & (for r ex g st g<r & g in dom f)
  implies f is divergent_in-infty_to+infty;

theorem 
  (ex r st f|left_open_halfline r is decreasing & not f|
  left_open_halfline r is bounded_above) & (for r ex g st g<r & g in dom f)
  implies f is divergent_in-infty_to+infty;

theorem 
  (ex r st f|left_open_halfline r is non-decreasing & not f|
  left_open_halfline r is bounded_below) & (for r ex g st g<r & g in dom f)
  implies f is divergent_in-infty_to-infty;

theorem 
  (ex r st f|left_open_halfline r is increasing & not f|
  left_open_halfline r is bounded_below) & (for r ex g st g<r & g in dom f)
  implies f is divergent_in-infty_to-infty;

theorem 
  f1 is divergent_in+infty_to+infty & (for r ex g st r<g & g in
  dom f) & (ex r st dom f /\ right_open_halfline(r) c= dom f1 /\
right_open_halfline(r) & for g st g in dom f /\ right_open_halfline(r) holds f1
  .g<=f.g) implies f is divergent_in+infty_to+infty;

theorem 
  f1 is divergent_in+infty_to-infty & (for r ex g st r<g & g in
  dom f) & (ex r st dom f/\right_open_halfline(r) c= dom f1 /\
right_open_halfline(r) & for g st g in dom f /\ right_open_halfline(r) holds f.
  g<=f1.g) implies f is divergent_in+infty_to-infty;

theorem 
  f1 is divergent_in-infty_to+infty & (for r ex g st g<r & g in
dom f) & (ex r st dom f/\left_open_halfline(r) c= dom f1 /\ left_open_halfline(
r) & for g st g in dom f /\ left_open_halfline(r) holds f1.g<=f.g) implies f is
  divergent_in-infty_to+infty;

theorem 
  f1 is divergent_in-infty_to-infty & (for r ex g st g<r & g in
dom f) & (ex r st dom f/\left_open_halfline(r) c= dom f1 /\ left_open_halfline(
r) & for g st g in dom f /\ left_open_halfline(r) holds f.g<=f1.g) implies f is
  divergent_in-infty_to-infty;

theorem 
  f1 is divergent_in+infty_to+infty & (ex r st right_open_halfline(r) c=
dom f /\ dom f1 & for g st g in right_open_halfline(r) holds f1.g<=f.g) implies
  f is divergent_in+infty_to+infty;

theorem 
  f1 is divergent_in+infty_to-infty & (ex r st right_open_halfline(r) c=
dom f /\ dom f1 & for g st g in right_open_halfline(r) holds f.g<=f1.g) implies
  f is divergent_in+infty_to-infty;

theorem 
  f1 is divergent_in-infty_to+infty & (ex r st left_open_halfline(r) c=
dom f /\ dom f1 & for g st g in left_open_halfline(r) holds f1.g<=f.g) implies
  f is divergent_in-infty_to+infty;

theorem 
  f1 is divergent_in-infty_to-infty & (ex r st left_open_halfline(r) c=
dom f /\ dom f1 & for g st g in left_open_halfline(r) holds f.g<=f1.g) implies
  f is divergent_in-infty_to-infty;

definition
  let f;
  assume
 f is convergent_in+infty;
  func lim_in+infty f ->Real means


  for seq st seq is
divergent_to+infty & rng seq c= dom f holds f/*seq is convergent & lim(f/*seq)=
  it;
end;

definition
  let f;
  assume
 f is convergent_in-infty;
  func lim_in-infty f ->Real means


  for seq st seq is
divergent_to-infty & rng seq c= dom f holds f/*seq is convergent & lim(f/*seq)=
  it;
end;

theorem 
  f is convergent_in-infty implies (lim_in-infty f=g iff for g1 st 0<g1
  ex r st for r1 st r1<r & r1 in dom f holds abs(f.r1-g)<g1);

theorem 
  f is convergent_in+infty implies (lim_in+infty f=g iff for g1 st 0<g1
  ex r st for r1 st r<r1 & r1 in dom f holds abs(f.r1-g)<g1);

theorem 
  f is convergent_in+infty implies r(#)f is convergent_in+infty &
  lim_in+infty(r(#)f)=r*(lim_in+infty f);

theorem 
  f is convergent_in+infty implies -f is convergent_in+infty &
  lim_in+infty(-f)=-(lim_in+infty f);

theorem 
  f1 is convergent_in+infty & f2 is convergent_in+infty & (for r
  ex g st r<g & g in dom(f1+f2)) implies f1+f2 is convergent_in+infty &
  lim_in+infty(f1+f2) = lim_in+infty f1 + lim_in+infty f2;

theorem 
  f1 is convergent_in+infty & f2 is convergent_in+infty & (for r ex g st
r<g & g in dom(f1-f2)) implies f1-f2 is convergent_in+infty & lim_in+infty(f1-
  f2)=(lim_in+infty f1)-(lim_in+infty f2);

theorem 
  f is convergent_in+infty & f"{0}={} & (lim_in+infty f)<>0 implies f^
  is convergent_in+infty & lim_in+infty(f^)=(lim_in+infty f)";

theorem 
  f is convergent_in+infty implies abs(f) is convergent_in+infty &
  lim_in+infty abs(f)=abs(lim_in+infty f);

theorem 
  f is convergent_in+infty & lim_in+infty f<>0 & (for r ex g st r
<g & g in dom f & f.g<>0) implies f^ is convergent_in+infty & lim_in+infty(f^)=
  (lim_in+infty f)";

theorem 
  f1 is convergent_in+infty & f2 is convergent_in+infty & (for r
  ex g st r<g & g in dom(f1(#)f2)) implies f1(#) f2 is convergent_in+infty &
  lim_in+infty(f1(#)f2)=(lim_in+infty f1)*(lim_in+infty f2);

theorem 
  f1 is convergent_in+infty & f2 is convergent_in+infty & lim_in+infty
  f2<> 0 & (for r ex g st r<g & g in dom(f1/f2)) implies f1/f2 is
  convergent_in+infty & lim_in+infty(f1/f2)=(lim_in+infty f1)/(lim_in+infty f2)
;

theorem 
  f is convergent_in-infty implies r(#)f is convergent_in-infty &
  lim_in-infty(r(#)f)=r*(lim_in-infty f);

theorem 
  f is convergent_in-infty implies -f is convergent_in-infty &
  lim_in-infty(-f)=-(lim_in-infty f);

theorem 
  f1 is convergent_in-infty & f2 is convergent_in-infty & (for r
  ex g st g<r & g in dom(f1+f2)) implies f1+f2 is convergent_in-infty &
  lim_in-infty(f1+f2) = lim_in-infty f1 + lim_in-infty f2;

theorem 
  f1 is convergent_in-infty & f2 is convergent_in-infty & (for r ex g st
g<r & g in dom(f1-f2)) implies f1-f2 is convergent_in-infty & lim_in-infty(f1-
  f2)=(lim_in-infty f1)-(lim_in-infty f2);

theorem 
  f is convergent_in-infty & f"{0}={} & (lim_in-infty f)<>0 implies f^
  is convergent_in-infty & lim_in-infty(f^)=(lim_in-infty f)";

theorem 
  f is convergent_in-infty implies abs(f) is convergent_in-infty &
  lim_in-infty abs(f)=abs(lim_in-infty f);

theorem 
  f is convergent_in-infty & lim_in-infty f<>0 & (for r ex g st g
<r & g in dom f & f.g<>0) implies f^ is convergent_in-infty & lim_in-infty(f^)=
  (lim_in-infty f)";

theorem 
  f1 is convergent_in-infty & f2 is convergent_in-infty & (for r
  ex g st g<r & g in dom(f1(#)f2)) implies f1(#) f2 is convergent_in-infty &
  lim_in-infty(f1(#)f2)=(lim_in-infty f1)*(lim_in-infty f2);

theorem 
  f1 is convergent_in-infty & f2 is convergent_in-infty & lim_in-infty
  f2<> 0 & (for r ex g st g<r & g in dom(f1/f2)) implies f1/f2 is
  convergent_in-infty & lim_in-infty(f1/f2)=(lim_in-infty f1)/(lim_in-infty f2)
;

theorem 
  f1 is convergent_in+infty & lim_in+infty f1=0 & (for r ex g st r<g & g
in dom(f1(#)f2)) & (ex r st f2|right_open_halfline r is bounded) implies f1(#)
  f2 is convergent_in+infty & lim_in+infty(f1(#)f2)=0;

theorem 
  f1 is convergent_in-infty & lim_in-infty f1=0 & (for r ex g st g<r & g
in dom(f1(#)f2)) & (ex r st f2|left_open_halfline r is bounded) implies f1(#)f2
  is convergent_in-infty & lim_in-infty(f1(#)f2)=0;

theorem 
  f1 is convergent_in+infty & f2 is convergent_in+infty &
lim_in+infty f1=lim_in+infty f2 & (for r ex g st r<g & g in dom f) & (ex r st (
  (dom f1 /\ right_open_halfline(r) c= dom f2 /\ right_open_halfline(r) & dom f
  /\ right_open_halfline(r) c= dom f1 /\ right_open_halfline(r)) or (dom f2 /\
  right_open_halfline(r) c= dom f1 /\ right_open_halfline(r) & dom f /\
  right_open_halfline(r) c= dom f2 /\ right_open_halfline(r))) & for g st g in
  dom f /\ right_open_halfline(r) holds f1.g<=f.g & f.g<=f2.g) implies f is
  convergent_in+infty & lim_in+infty f=lim_in+infty f1;

theorem 
  f1 is convergent_in+infty & f2 is convergent_in+infty & lim_in+infty
f1=lim_in+infty f2 & (ex r st right_open_halfline(r) c= dom f1 /\ dom f2 /\ dom
f & for g st g in right_open_halfline(r) holds f1.g<=f.g & f.g<=f2.g) implies f
  is convergent_in+infty & lim_in+infty f=lim_in+infty f1;

theorem 
  f1 is convergent_in-infty & f2 is convergent_in-infty &
lim_in-infty f1=lim_in-infty f2 & (for r ex g st g<r & g in dom f) & (ex r st (
(dom f1 /\ left_open_halfline(r) c= dom f2 /\ left_open_halfline(r) & dom f /\
  left_open_halfline(r) c= dom f1 /\ left_open_halfline(r)) or (dom f2 /\
  left_open_halfline(r) c= dom f1 /\ left_open_halfline(r) & dom f /\
left_open_halfline(r) c= dom f2 /\ left_open_halfline(r))) & for g st g in dom
  f /\ left_open_halfline(r) holds f1.g<=f.g & f.g<=f2.g) implies f is
  convergent_in-infty & lim_in-infty f=lim_in-infty f1;

theorem 
  f1 is convergent_in-infty & f2 is convergent_in-infty & lim_in-infty
f1=lim_in-infty f2 & (ex r st left_open_halfline(r) c= dom f1 /\ dom f2 /\ dom
f & for g st g in left_open_halfline(r) holds f1.g<=f.g & f.g<=f2.g) implies f
  is convergent_in-infty & lim_in-infty f=lim_in-infty f1;

theorem 
  f1 is convergent_in+infty & f2 is convergent_in+infty & (ex r st ((dom
  f1 /\ right_open_halfline(r) c= dom f2 /\ right_open_halfline(r) & for g st g
  in dom f1 /\ right_open_halfline(r) holds f1.g<=f2.g) or (dom f2 /\
right_open_halfline(r) c= dom f1 /\ right_open_halfline(r) & for g st g in dom
  f2 /\ right_open_halfline(r) holds f1.g<=f2.g))) implies lim_in+infty f1<=
  lim_in+infty f2;

theorem 
  f1 is convergent_in-infty & f2 is convergent_in-infty & (ex r st ((dom
f1 /\ left_open_halfline(r) c= dom f2 /\ left_open_halfline(r) & for g st g in
  dom f1 /\ left_open_halfline(r) holds f1.g<=f2.g) or (dom f2 /\
left_open_halfline(r) c= dom f1 /\ left_open_halfline(r) & for g st g in dom f2
  /\ left_open_halfline(r) holds f1.g<=f2.g))) implies lim_in-infty f1<=
  lim_in-infty f2;

theorem 
  (f is divergent_in+infty_to+infty or f is divergent_in+infty_to-infty)
& (for r ex g st r<g & g in dom f & f.g<>0) implies f^ is convergent_in+infty &
  lim_in+infty(f^)=0;

theorem 
  (f is divergent_in-infty_to+infty or f is divergent_in-infty_to-infty)
& (for r ex g st g<r & g in dom f & f.g<>0) implies f^ is convergent_in-infty &
  lim_in-infty(f^)=0;

theorem 
  f is convergent_in+infty & lim_in+infty f=0 & (for r ex g st r<g & g
  in dom f & f.g<>0) & (ex r st for g st g in dom f /\ right_open_halfline(r)
  holds 0<=f.g) implies f^ is divergent_in+infty_to+infty;

theorem 
  f is convergent_in+infty & lim_in+infty f=0 & (for r ex g st r<g & g
  in dom f & f.g<>0) & (ex r st for g st g in dom f /\ right_open_halfline(r)
  holds f.g<=0) implies f^ is divergent_in+infty_to-infty;

theorem 
  f is convergent_in-infty & lim_in-infty f=0 & (for r ex g st g<r & g
  in dom f & f.g<>0) & (ex r st for g st g in dom f /\ left_open_halfline(r)
  holds 0<=f.g) implies f^ is divergent_in-infty_to+infty;

theorem 
  f is convergent_in-infty & lim_in-infty f=0 & (for r ex g st g<r & g
  in dom f & f.g<>0) & (ex r st for g st g in dom f /\ left_open_halfline(r)
  holds f.g<=0) implies f^ is divergent_in-infty_to-infty;

theorem 
  f is convergent_in+infty & lim_in+infty f=0 & (ex r st for g st g in
  dom f /\ right_open_halfline(r) holds 0<f.g) implies f^ is
  divergent_in+infty_to+infty;

theorem 
  f is convergent_in+infty & lim_in+infty f=0 & (ex r st for g st g in
  dom f /\ right_open_halfline(r) holds f.g<0) implies f^ is
  divergent_in+infty_to-infty;

theorem 
  f is convergent_in-infty & lim_in-infty f=0 & (ex r st for g st g in
  dom f /\ left_open_halfline(r) holds 0<f.g) implies f^ is
  divergent_in-infty_to+infty;

theorem 
  f is convergent_in-infty & lim_in-infty f=0 & (ex r st for g st g in
  dom f /\ left_open_halfline(r) holds f.g<0) implies f^ is
  divergent_in-infty_to-infty;














begin

reserve r,r1,r2,g,g1,g2,x0 for Real;
reserve n,k for Element of NAT;
reserve seq for Real_Sequence;
reserve f,f1,f2 for PartFunc of REAL,REAL;

theorem 
  seq is convergent & r<lim seq implies ex n st for k st n<=k holds r<seq.k;

theorem 
  seq is convergent & lim seq<r implies ex n st for k st n<=k holds seq.k<r;

theorem 
  0<r2 & ].r1-r2,r1.[ c= dom f implies for r st r<r1 ex g st r<g &
  g<r1 & g in dom f;

theorem 
  0<r2 & ].r1,r1+r2.[ c= dom f implies for r st r1<r ex g st g<r &
  r1<g & g in dom f;

theorem 
  (for n holds x0-1/(n+1)<seq.n & seq.n<x0 & seq.n in dom f)
implies seq is convergent & lim seq=x0 & rng seq c= dom f & rng seq c= dom f /\
  left_open_halfline(x0);

theorem 
  (for n holds x0<seq.n & seq.n<x0+1/(n+1) & seq.n in dom f)
implies seq is convergent & lim seq=x0 & rng seq c= dom f & rng seq c= dom f /\
  right_open_halfline(x0);

definition
  let f,x0;
  pred f is_left_convergent_in x0 means


  (for r st r<x0 ex g st r<g & g<
x0 & g in dom f) & ex g st for seq st seq is convergent & lim seq=x0 & rng seq
c= dom f /\ left_open_halfline(x0) holds f/*seq is convergent & lim(f/*seq)=g;
  pred f is_left_divergent_to+infty_in x0 means


  (for r st r<x0 ex g st
r<g & g<x0 & g in dom f) & for seq st seq is convergent & lim seq=x0 & rng seq
  c= dom f /\ left_open_halfline(x0) holds f/*seq is divergent_to+infty;
  pred f is_left_divergent_to-infty_in x0 means


  (for r st r<x0 ex g st
r<g & g<x0 & g in dom f) & for seq st seq is convergent & lim seq=x0 & rng seq
  c= dom f /\ left_open_halfline(x0) holds f/*seq is divergent_to-infty;
  pred f is_right_convergent_in x0 means


  (for r st x0<r ex g st g<r &
  x0<g & g in dom f) & ex g st for seq st seq is convergent & lim seq=x0 & rng
seq c= dom f /\ right_open_halfline(x0) holds f/*seq is convergent & lim(f/*seq
  )=g;
  pred f is_right_divergent_to+infty_in x0 means


  (for r st x0<r ex g st
g<r & x0<g & g in dom f) & for seq st seq is convergent & lim seq=x0 & rng seq
  c= dom f /\ right_open_halfline(x0) holds f/*seq is divergent_to+infty;
  pred f is_right_divergent_to-infty_in x0 means


  (for r st x0<r ex g st
g<r & x0<g & g in dom f) & for seq st seq is convergent & lim seq=x0 & rng seq
  c= dom f /\ right_open_halfline(x0) holds f/*seq is divergent_to-infty;
end;

theorem 
  f is_left_convergent_in x0 iff (for r st r<x0 ex g st r<g & g<x0 & g
  in dom f) & ex g st for g1 st 0<g1 ex r st r<x0 & for r1 st r<r1 & r1<x0 & r1
  in dom f holds abs(f.r1-g)<g1;

theorem 
  f is_left_divergent_to+infty_in x0 iff (for r st r<x0 ex g st r<g & g<
  x0 & g in dom f) & for g1 ex r st r<x0 & for r1 st r<r1 & r1<x0 & r1 in dom f
  holds g1<f.r1;

theorem 
  f is_left_divergent_to-infty_in x0 iff (for r st r<x0 ex g st r<g & g<
  x0 & g in dom f) & for g1 ex r st r<x0 & for r1 st r<r1 & r1<x0 & r1 in dom f
  holds f.r1<g1;

theorem 
  f is_right_convergent_in x0 iff (for r st x0<r ex g st g<r & x0<g & g
  in dom f) & ex g st for g1 st 0<g1 ex r st x0<r & for r1 st r1<r & x0<r1 & r1
  in dom f holds abs(f.r1-g)<g1;

theorem 
  f is_right_divergent_to+infty_in x0 iff (for r st x0<r ex g st g<r &
x0<g & g in dom f) & for g1 ex r st x0<r & for r1 st r1<r & x0<r1 & r1 in dom f
  holds g1<f.r1;

theorem 
  f is_right_divergent_to-infty_in x0 iff (for r st x0<r ex g st g<r &
x0<g & g in dom f) & for g1 ex r st x0<r & for r1 st r1<r & x0<r1 & r1 in dom f
  holds f.r1<g1;

theorem 
  f1 is_left_divergent_to+infty_in x0 & f2 is_left_divergent_to+infty_in
  x0 & (for r st r<x0 ex g st r<g & g<x0 & g in dom f1 /\ dom f2) implies f1+f2
  is_left_divergent_to+infty_in x0 & f1(#) f2 is_left_divergent_to+infty_in x0;

theorem 
  f1 is_left_divergent_to-infty_in x0 & f2 is_left_divergent_to-infty_in
  x0 & (for r st r<x0 ex g st r<g & g<x0 & g in dom f1 /\ dom f2) implies f1+f2
  is_left_divergent_to-infty_in x0 & f1(#)f2 is_left_divergent_to+infty_in x0;

theorem 
  f1 is_right_divergent_to+infty_in x0 & f2
  is_right_divergent_to+infty_in x0 & (for r st x0<r ex g st g<r & x0<g & g in
  dom f1 /\ dom f2) implies f1+f2 is_right_divergent_to+infty_in x0 & f1(#)f2
  is_right_divergent_to+infty_in x0;

theorem 
  f1 is_right_divergent_to-infty_in x0 & f2
  is_right_divergent_to-infty_in x0 & (for r st x0<r ex g st g<r & x0<g & g in
  dom f1 /\ dom f2) implies f1+f2 is_right_divergent_to-infty_in x0 & f1(#)f2
  is_right_divergent_to+infty_in x0;

theorem 
  f1 is_left_divergent_to+infty_in x0 & (for r st r<x0 ex g st r<g & g<
x0 & g in dom(f1+f2)) & (ex r st 0<r & f2|].x0-r,x0.[ is bounded_below) implies
  f1+f2 is_left_divergent_to+infty_in x0;

theorem 
  f1 is_left_divergent_to+infty_in x0 & (for r st r<x0 ex g st r<g & g<
x0 & g in dom(f1(#)f2)) & (ex r,r1 st 0<r & 0<r1 & for g st g in dom f2 /\ ].x0
  -r,x0.[ holds r1<= f2.g) implies f1(#)f2 is_left_divergent_to+infty_in x0;

theorem 
  f1 is_right_divergent_to+infty_in x0 & (for r st x0<r ex g st g<r & x0
<g & g in dom(f1+f2)) & (ex r st 0<r & f2|].x0,x0+r.[ is bounded_below) implies
  f1+f2 is_right_divergent_to+infty_in x0;

theorem 
  f1 is_right_divergent_to+infty_in x0 & (for r st x0<r ex g st g<r & x0
<g & g in dom(f1(#)f2)) & (ex r,r1 st 0<r & 0<r1 & for g st g in dom f2 /\ ].x0
  ,x0+r.[ holds r1<= f2.g) implies f1(#)f2 is_right_divergent_to+infty_in x0;

theorem 
  (f is_left_divergent_to+infty_in x0 & r>0 implies r(#)f
is_left_divergent_to+infty_in x0 ) & (f is_left_divergent_to+infty_in x0 & r<0
  implies r(#)f is_left_divergent_to-infty_in x0 ) & (f
  is_left_divergent_to-infty_in x0 & r>0 implies r(#)f
is_left_divergent_to-infty_in x0 ) & (f is_left_divergent_to-infty_in x0 & r<0
  implies r(#)f is_left_divergent_to+infty_in x0 );

theorem 
  (f is_right_divergent_to+infty_in x0 & r>0 implies r(#)f
is_right_divergent_to+infty_in x0 ) & (f is_right_divergent_to+infty_in x0 & r<
  0 implies r(#)f is_right_divergent_to-infty_in x0 ) & (f
  is_right_divergent_to-infty_in x0 & r>0 implies r(#)f
is_right_divergent_to-infty_in x0 ) & (f is_right_divergent_to-infty_in x0 & r<
  0 implies r(#)f is_right_divergent_to+infty_in x0);

theorem 
  (f is_left_divergent_to+infty_in x0 or f is_left_divergent_to-infty_in
  x0) implies abs(f) is_left_divergent_to+infty_in x0;

theorem 
  (f is_right_divergent_to+infty_in x0 or f
  is_right_divergent_to-infty_in x0 ) implies abs(f)
  is_right_divergent_to+infty_in x0;

theorem 
  (ex r st f|].x0-r,x0.[ is non-decreasing& not f|].x0-r,x0.[ is
  bounded_above) & (for r st r<x0 ex g st r<g & g<x0 & g in dom f) implies f
  is_left_divergent_to+infty_in x0;

theorem 
  (ex r st 0<r & f|].x0-r,x0.[ is increasing & not f|].x0-r,x0.[ is
  bounded_above) & (for r st r<x0 ex g st r<g & g<x0 & g in dom f) implies f
  is_left_divergent_to+infty_in x0;

theorem 
  (ex r st f|].x0-r,x0.[ is non-increasing & not f|].x0-r,x0.[ is
  bounded_below) & (for r st r<x0 ex g st r<g & g<x0 & g in dom f) implies f
  is_left_divergent_to-infty_in x0;

theorem 
  (ex r st 0<r & f|].x0-r,x0.[ is decreasing & not f|].x0-r,x0.[ is
  bounded_below) & (for r st r<x0 ex g st r<g & g<x0 & g in dom f) implies f
  is_left_divergent_to-infty_in x0;

theorem 
  (ex r st f|].x0,x0+r.[ is non-increasing & not f|].x0,x0+r.[ is
  bounded_above) & (for r st x0<r ex g st g<r & x0<g & g in dom f) implies f
  is_right_divergent_to+infty_in x0;

theorem 
  (ex r st 0<r & f|].x0,x0+r.[ is decreasing & not f|].x0,x0+r.[ is
  bounded_above) & (for r st x0<r ex g st g<r & x0<g & g in dom f) implies f
  is_right_divergent_to+infty_in x0;

theorem 
  (ex r st f|].x0,x0+r.[ is non-decreasing & not f|].x0,x0+r.[ is
  bounded_below) & (for r st x0<r ex g st g<r & x0<g & g in dom f) implies f
  is_right_divergent_to-infty_in x0;

theorem 
  (ex r st 0<r & f|].x0,x0+r.[ is increasing & not f|].x0,x0+r.[ is
  bounded_below) & (for r st x0<r ex g st g<r & x0<g & g in dom f) implies f
  is_right_divergent_to-infty_in x0;

theorem 
  f1 is_left_divergent_to+infty_in x0 & (for r st r<x0 ex g st r<g
& g<x0 & g in dom f) & (ex r st 0<r & dom f /\ ].x0-r,x0.[ c= dom f1 /\ ].x0-r,
  x0.[ & for g st g in dom f /\ ].x0-r,x0.[ holds f1.g<=f.g) implies f
  is_left_divergent_to+infty_in x0;

theorem 
  f1 is_left_divergent_to-infty_in x0 & (for r st r<x0 ex g st r<g
& g<x0 & g in dom f) & (ex r st 0<r & dom f /\ ].x0-r,x0.[ c= dom f1 /\ ].x0-r,
  x0.[ & for g st g in dom f /\ ].x0-r,x0.[ holds f.g<=f1.g) implies f
  is_left_divergent_to-infty_in x0;

theorem 
  f1 is_right_divergent_to+infty_in x0 & (for r st x0<r ex g st g<
r & x0<g & g in dom f) & (ex r st 0<r & dom f /\ ].x0,x0+r.[ c= dom f1 /\ ].x0,
  x0+r.[ & for g st g in dom f /\ ].x0,x0+r.[ holds f1.g<=f.g) implies f
  is_right_divergent_to+infty_in x0;

theorem 
  f1 is_right_divergent_to-infty_in x0 & (for r st x0<r ex g st g<
r & x0<g & g in dom f) & (ex r st 0<r & dom f /\ ].x0,x0+r.[ c= dom f1 /\ ].x0,
  x0+r.[ & for g st g in dom f /\ ].x0,x0+r.[ holds f.g<=f1.g) implies f
  is_right_divergent_to-infty_in x0;

theorem 
  f1 is_left_divergent_to+infty_in x0 & (ex r st 0<r & ].x0-r,x0.[ c=
  dom f /\ dom f1 & for g st g in ].x0-r,x0.[ holds f1.g<= f.g) implies f
  is_left_divergent_to+infty_in x0;

theorem 
  f1 is_left_divergent_to-infty_in x0 & (ex r st 0<r & ].x0-r,x0.[ c=
  dom f /\ dom f1 & for g st g in ].x0-r,x0.[ holds f.g<= f1.g) implies f
  is_left_divergent_to-infty_in x0;

theorem 
  f1 is_right_divergent_to+infty_in x0 & (ex r st 0<r & ].x0,x0+r.[ c=
  dom f /\ dom f1 & for g st g in ].x0,x0+r.[ holds f1.g<= f.g) implies f
  is_right_divergent_to+infty_in x0;

theorem 
  f1 is_right_divergent_to-infty_in x0 & (ex r st 0<r & ].x0,x0+r.[ c=
  dom f /\ dom f1 & for g st g in ].x0,x0+r.[ holds f.g<= f1.g) implies f
  is_right_divergent_to-infty_in x0;

definition
  let f,x0;
  assume
 f is_left_convergent_in x0;
  func lim_left(f,x0)->Real means


  for seq st seq is convergent & lim
seq=x0 & rng seq c= dom f /\ left_open_halfline(x0) holds f/*seq is convergent
  & lim(f/*seq)=it;
end;

definition
  let f,x0;
  assume
 f is_right_convergent_in x0;
  func lim_right(f,x0)->Real means


  for seq st seq is convergent & lim
seq=x0 & rng seq c= dom f /\ right_open_halfline(x0) holds f/*seq is convergent
  & lim(f/*seq)=it;
end;

theorem 
  f is_left_convergent_in x0 implies (lim_left(f,x0)=g iff for g1 st 0<
  g1 ex r st r<x0 & for r1 st r<r1 & r1<x0 & r1 in dom f holds abs(f.r1-g)<g1);

theorem 
  f is_right_convergent_in x0 implies (lim_right(f,x0)=g iff for g1 st 0
  <g1 ex r st x0<r & for r1 st r1<r & x0<r1 & r1 in dom f holds abs(f.r1-g)<g1)
;

theorem 
  f is_left_convergent_in x0 implies r(#)f is_left_convergent_in
  x0 & lim_left(r(#)f,x0)=r*(lim_left(f,x0));

theorem 
  f is_left_convergent_in x0 implies -f is_left_convergent_in x0 &
  lim_left(-f,x0)=-(lim_left(f,x0));

theorem 
  f1 is_left_convergent_in x0 & f2 is_left_convergent_in x0 & (for
  r st r<x0 ex g st r<g & g<x0 & g in dom(f1+f2)) implies f1+f2
  is_left_convergent_in x0 & lim_left(f1+f2,x0)=lim_left(f1,x0)+lim_left(f2,x0)
;

theorem 
  f1 is_left_convergent_in x0 & f2 is_left_convergent_in x0 & (for r st
r<x0 ex g st r<g & g<x0 & g in dom(f1-f2)) implies f1-f2 is_left_convergent_in
  x0 & lim_left(f1-f2,x0)=(lim_left(f1,x0))-(lim_left(f2,x0));

theorem 
  f is_left_convergent_in x0 & f"{0}={} & lim_left(f,x0)<>0 implies f^
  is_left_convergent_in x0 & lim_left(f^,x0)=(lim_left(f,x0))";

theorem 
  f is_left_convergent_in x0 implies abs(f) is_left_convergent_in x0 &
  lim_left(abs(f),x0)=abs(lim_left(f,x0));

theorem 
  f is_left_convergent_in x0 & lim_left(f,x0)<>0 & (for r st r<x0
ex g st r<g & g<x0 & g in dom f & f.g<>0) implies f^ is_left_convergent_in x0 &
  lim_left(f^,x0)=(lim_left(f,x0))";

theorem 
  f1 is_left_convergent_in x0 & f2 is_left_convergent_in x0 & (for
  r st r<x0 ex g st r<g & g<x0 & g in dom(f1(#)f2)) implies f1(#)f2
is_left_convergent_in x0 & lim_left(f1(#)f2,x0)=(lim_left(f1,x0))*(lim_left(f2,
  x0));

theorem 
  f1 is_left_convergent_in x0 & f2 is_left_convergent_in x0 & lim_left(
f2,x0 ) <> 0 & (for r st r<x0 ex g st r<g & g<x0 & g in dom(f1/f2)) implies f1/
f2 is_left_convergent_in x0 & lim_left(f1/f2,x0)=(lim_left(f1,x0))/(lim_left(f2
  ,x0));

theorem 
  f is_right_convergent_in x0 implies r(#)f is_right_convergent_in
  x0 & lim_right(r(#)f,x0)=r*(lim_right(f,x0));

theorem 
  f is_right_convergent_in x0 implies -f is_right_convergent_in x0
  & lim_right(-f,x0)=-(lim_right(f,x0));

theorem 
  f1 is_right_convergent_in x0 & f2 is_right_convergent_in x0 & (
  for r st x0<r ex g st g<r & x0<g & g in dom(f1+f2)) implies f1+f2
is_right_convergent_in x0 & lim_right(f1+f2,x0)=(lim_right(f1,x0))+(lim_right(
  f2,x0));

theorem 
  f1 is_right_convergent_in x0 & f2 is_right_convergent_in x0 & (for r
  st x0<r ex g st g<r & x0<g & g in dom(f1-f2)) implies f1-f2
is_right_convergent_in x0 & lim_right(f1-f2,x0)=(lim_right(f1,x0))-(lim_right(
  f2,x0));

theorem 
  f is_right_convergent_in x0 & f"{0}={} & lim_right(f,x0)<>0 implies f^
  is_right_convergent_in x0 & lim_right(f^,x0)=(lim_right(f,x0))";

theorem 
  f is_right_convergent_in x0 implies abs(f) is_right_convergent_in x0 &
  lim_right(abs(f),x0)=abs(lim_right(f,x0));

theorem 
  f is_right_convergent_in x0 & lim_right(f,x0)<>0 & (for r st x0<
  r ex g st g<r & x0<g & g in dom f & f.g<>0) implies f^ is_right_convergent_in
  x0 & lim_right(f^,x0)=(lim_right(f,x0))";

theorem 
  f1 is_right_convergent_in x0 & f2 is_right_convergent_in x0 & (
  for r st x0<r ex g st g<r & x0<g & g in dom(f1(#)f2)) implies f1(#)f2
is_right_convergent_in x0 & lim_right(f1(#)f2,x0)=(lim_right(f1,x0))*(lim_right
  (f2,x0));

theorem 
  f1 is_right_convergent_in x0 & f2 is_right_convergent_in x0 &
  lim_right(f2,x0)<>0 & (for r st x0<r ex g st g<r & x0<g & g in dom(f1/f2))
implies f1/f2 is_right_convergent_in x0 & lim_right(f1/f2,x0)=(lim_right(f1,x0)
  )/(lim_right(f2,x0));

theorem 
  f1 is_left_convergent_in x0 & lim_left(f1,x0)=0 & (for r st r<x0 ex g
st r<g & g<x0 & g in dom(f1(#)f2)) & (ex r st 0<r & f2|].x0-r,x0.[ is bounded)
  implies f1(#)f2 is_left_convergent_in x0 & lim_left(f1(#)f2,x0)=0;

theorem 
  f1 is_right_convergent_in x0 & lim_right(f1,x0)=0 & (for r st x0<r ex
g st g<r & x0<g & g in dom(f1(#)f2)) & (ex r st 0<r & f2|].x0,x0+r.[ is bounded
  ) implies f1(#)f2 is_right_convergent_in x0 & lim_right(f1(#)f2,x0)=0;

theorem 
  f1 is_left_convergent_in x0 & f2 is_left_convergent_in x0 &
lim_left(f1,x0)=lim_left(f2,x0) & (for r st r<x0 ex g st r<g & g<x0 & g in dom
f) & (ex r st 0<r & (for g st g in dom f /\ ].x0-r,x0.[ holds f1.g<=f.g & f.g<=
f2.g) & ((dom f1 /\ ].x0-r,x0.[ c= dom f2 /\ ].x0-r,x0.[ & dom f /\ ].x0-r,x0.[
c= dom f1 /\ ].x0-r,x0.[) or (dom f2 /\ ].x0-r,x0.[ c= dom f1 /\ ].x0-r,x0.[ &
  dom f /\ ].x0-r,x0.[ c= dom f2 /\ ].x0-r,x0.[))) implies f
  is_left_convergent_in x0 & lim_left(f,x0)=lim_left(f1,x0);

theorem 
  f1 is_left_convergent_in x0 & f2 is_left_convergent_in x0 & lim_left(
f1,x0)=lim_left(f2,x0) & (ex r st 0<r & ].x0-r,x0.[ c= dom f1 /\ dom f2 /\ dom
  f & for g st g in ].x0-r,x0.[ holds f1.g<=f.g & f.g<=f2.g) implies f
  is_left_convergent_in x0 & lim_left(f,x0)=lim_left(f1,x0);

theorem 
  f1 is_right_convergent_in x0 & f2 is_right_convergent_in x0 &
  lim_right(f1,x0)=lim_right(f2,x0) & (for r st x0<r ex g st g<r & x0<g & g in
dom f) & (ex r st 0<r & (for g st g in dom f /\ ].x0,x0+r.[ holds f1.g<=f.g & f
.g<=f2.g) & ((dom f1 /\ ].x0,x0+r.[ c= dom f2 /\ ].x0,x0+r.[ & dom f /\ ].x0,x0
+r.[ c= dom f1 /\ ].x0,x0+r.[) or (dom f2 /\ ].x0,x0+r.[ c= dom f1 /\ ].x0,x0+r
  .[ & dom f /\ ].x0,x0+r.[ c= dom f2 /\ ].x0,x0+r.[))) implies f
  is_right_convergent_in x0 & lim_right(f,x0)=lim_right(f1,x0);

theorem 
  f1 is_right_convergent_in x0 & f2 is_right_convergent_in x0 &
lim_right(f1,x0)=lim_right(f2,x0) & (ex r st 0<r & ].x0,x0+r.[ c= dom f1 /\ dom
f2 /\ dom f & for g st g in ].x0,x0+r.[ holds f1.g<=f.g & f.g<=f2.g) implies f
  is_right_convergent_in x0 & lim_right(f,x0)=lim_right(f1,x0);

theorem 
  f1 is_left_convergent_in x0 & f2 is_left_convergent_in x0 & (ex r st 0
<r & ((dom f1 /\ ].x0-r,x0.[ c= dom f2 /\ ].x0-r,x0.[ & for g st g in dom f1 /\
].x0-r,x0.[ holds f1.g<=f2.g) or (dom f2 /\ ].x0-r,x0.[ c= dom f1 /\ ].x0-r,x0
.[ & for g st g in dom f2 /\ ].x0-r,x0.[ holds f1.g<=f2.g))) implies lim_left(
  f1,x0)<=lim_left(f2,x0);

theorem 
  f1 is_right_convergent_in x0 & f2 is_right_convergent_in x0 & (ex r st
  0<r & ((dom f1 /\ ].x0,x0+r.[ c= dom f2 /\ ].x0,x0+r.[ & for g st g in dom f1
/\ ].x0,x0+r.[ holds f1.g<=f2.g) or (dom f2 /\ ].x0,x0+r.[ c= dom f1 /\ ].x0,x0
  +r.[ & for g st g in dom f2 /\ ].x0,x0+r.[ holds f1.g<=f2.g))) implies
  lim_right(f1,x0)<=lim_right(f2,x0);

theorem 
  (f is_left_divergent_to+infty_in x0 or f is_left_divergent_to-infty_in
  x0) & (for r st r<x0 ex g st r<g & g<x0 & g in dom f & f.g<>0) implies f^
  is_left_convergent_in x0 & lim_left(f^,x0)=0;

theorem 
  (f is_right_divergent_to+infty_in x0 or f
is_right_divergent_to-infty_in x0 ) & (for r st x0<r ex g st g<r & x0<g & g in
  dom f & f.g<>0) implies f^ is_right_convergent_in x0 & lim_right(f^,x0)=0;

theorem 
  f is_left_convergent_in x0 & lim_left(f,x0)=0 & (ex r st 0<r & for g
  st g in dom f /\ ].x0-r,x0.[ holds 0<f.g) implies f^
  is_left_divergent_to+infty_in x0;

theorem 
  f is_left_convergent_in x0 & lim_left(f,x0)=0 & (ex r st 0<r & for g
  st g in dom f /\ ].x0-r,x0.[ holds f.g<0) implies f^
  is_left_divergent_to-infty_in x0;

theorem 
  f is_right_convergent_in x0 & lim_right(f,x0)=0 & (ex r st 0<r & for g
  st g in dom f /\ ].x0,x0+r.[ holds 0<f.g) implies f^
  is_right_divergent_to+infty_in x0;

theorem 
  f is_right_convergent_in x0 & lim_right(f,x0)=0 & (ex r st 0<r & for g
  st g in dom f /\ ].x0,x0+r.[ holds f.g<0) implies f^
  is_right_divergent_to-infty_in x0;

theorem 
  f is_left_convergent_in x0 & lim_left(f,x0)=0 & (for r st r<x0 ex g st
r<g & g<x0 & g in dom f & f.g<>0) & (ex r st 0<r & for g st g in dom f /\ ].x0-
  r,x0.[ holds 0<=f.g) implies f^ is_left_divergent_to+infty_in x0;

theorem 
  f is_left_convergent_in x0 & lim_left(f,x0)=0 & (for r st r<x0 ex g st
r<g & g<x0 & g in dom f & f.g<>0) & (ex r st 0<r & for g st g in dom f /\ ].x0-
  r,x0.[ holds f.g<=0) implies f^ is_left_divergent_to-infty_in x0;

theorem 
  f is_right_convergent_in x0 & lim_right(f,x0)=0 & (for r st x0<r ex g
st g<r & x0<g & g in dom f & f.g<>0) & (ex r st 0<r & for g st g in dom f /\ ].
  x0,x0+r.[ holds 0<=f.g) implies f^ is_right_divergent_to+infty_in x0;

theorem 
  f is_right_convergent_in x0 & lim_right(f,x0)=0 & (for r st x0<r ex g
st g<r & x0<g & g in dom f & f.g<>0) & (ex r st 0<r & for g st g in dom f /\ ].
  x0,x0+r.[ holds f.g<=0) implies f^ is_right_divergent_to-infty_in x0;














begin

reserve D for non empty set,
  D1,D2,x,y for set,
  n,k for Element of NAT,
  p,x1 ,r for Real,
  f for Function;

definition
  let D1,D2;
  mode Functional_Sequence of D1,D2 is sequence of PFuncs(D1,D2);
end;

reserve F for Functional_Sequence of D1,D2;

definition
  let D1,D2,F;
  let n be Nat;
  redefine func F.n -> PartFunc of D1,D2;
end;

reserve G,H,H1,H2,J for Functional_Sequence of D,REAL;

theorem 
  f is Functional_Sequence of D1,D2 iff (dom f = NAT & for n holds f.n
  is PartFunc of D1,D2);

scheme 

  ExFuncSeq{D1() -> set, D2() -> set, F(set)->PartFunc of D1(),D2()}: ex G
  being Functional_Sequence of D1(), D2() st for n being Nat holds G.n = F(n);

definition
  let D,H;

  let r be real number;
  func r(#)H ->Functional_Sequence of D,REAL means


  for n being Nat holds it.n = r(#)(H.n);
end;

definition
  let D,H;
  func H" -> Functional_Sequence of D,REAL means


  for n being Nat holds it.n=(H.n)^;
  func - H -> Functional_Sequence of D,REAL means


  for n being Nat holds it.n = -H.n;
 involutiveness;
  func abs(H)->Functional_Sequence of D,REAL means


  for n being Nat holds it.n=abs(H.n);
 projectivity;
end;

definition
  let D,G,H;
  func G + H -> Functional_Sequence of D,REAL means


  for n being Nat holds it.n = G.n + H.n;
end;

definition
  let D,G,H;
  func G - H -> Functional_Sequence of D,REAL equals

  G + -H;
end;

definition
  let D,G,H;
  func G (#) H -> Functional_Sequence of D,REAL means


  for n being Nat holds it.n =G.n (#) H.n;
end;

definition
  let D,H,G;
  func G / H ->Functional_Sequence of D,REAL equals

  G (#) (H");
end;

theorem 
  H1 = G/H iff for n holds H1.n = G.n / H.n;

theorem 
  H1 = G - H iff for n holds H1.n = G.n - H.n;

theorem 
  G + H = H + G & (G + H) + J = G + (H + J);

theorem 
  G (#) H = H (#) G & (G (#) H) (#) J = G (#) (H (#) J);

theorem 
  (G + H) (#) J = G(#)J + H(#)J & J (#) (G + H) = J(#)G + J(#)H;

theorem 
  -H = (-1)(#)H;

theorem 
  (G - H) (#) J = G(#)J - H(#)J & J(#)G - J(#)H = J (#) (G - H);

theorem 
  r(#)(G + H) = r(#)G + r(#)H & r(#)(G - H) = r(#)G - r(#)H;

theorem 
  (r*p)(#)H = r(#)(p(#)H);

theorem 
  1 (#) H = H;

canceled;

theorem 
  G" (#) H" = (G(#)H)";

theorem 
  r<>0 implies (r(#)H)" = r" (#) H";

theorem 
  abs(H)"=abs(H");

theorem 
  abs(G(#)H) = abs(G) (#) abs(H);

theorem 
  abs(G/H) = abs(G) / abs(H);

theorem 
  abs(r(#)H) = abs(r) (#) abs(H);

reserve x for Element of D,
  X,Y for set,
  S1,S2 for Real_Sequence,
  f for PartFunc of D,REAL;

definition
  let D1,D2,F,X;
  pred X common_on_dom F means


  X <> {} & for n holds X c= dom (F.n);
end;

definition
  let D,H,x;
  func H#x ->Real_Sequence means


  for n holds it.n = (H.n).x;
end;

definition
  let D,H,X;
  pred H is_point_conv_on X means


  X common_on_dom H & ex f st X = dom
f & for x st x in X holds for p st p>0 ex k st for n st n>=k holds abs((H.n).x
  - f.x) < p;
end;

theorem 
  H is_point_conv_on X iff X common_on_dom H & ex f st X = dom f &
  for x st x in X holds (H#x) is convergent & lim(H#x) = f.x;

theorem 
  H is_point_conv_on X iff X common_on_dom H & for x st x in X
  holds (H#x) is convergent;

definition
  let D,H,X;
  pred H is_unif_conv_on X means


  X common_on_dom H & ex f st X = dom f
  & for p st p>0 ex k st for n,x st n>=k & x in X holds abs((H.n).x - f.x) < p;
end;

definition
  let D,H,X;
  assume
 H is_point_conv_on X;
  func lim(H,X) -> PartFunc of D,REAL means


  dom it = X & for x st x in dom it holds it.x = lim(H#x);
end;

theorem 
  H is_point_conv_on X implies (f = lim(H,X) iff dom f = X & for x
st x in X holds for p st p>0 ex k st for n st n>=k holds abs((H.n).x - f.x) < p
  );

theorem 
  H is_unif_conv_on X implies H is_point_conv_on X;

theorem 
  Y c= X & Y<>{} & X common_on_dom H implies Y common_on_dom H;

theorem 
  Y c= X & Y<>{} & H is_point_conv_on X implies H is_point_conv_on Y &
  lim(H,X)|Y = lim(H,Y);

theorem 
  Y c= X & Y<>{} & H is_unif_conv_on X implies H is_unif_conv_on Y;

theorem 
  X common_on_dom H implies for x st x in X holds {x} common_on_dom H;

theorem 
  H is_point_conv_on X implies for x st x in X holds {x} common_on_dom H;

theorem 
  {x} common_on_dom H1 & {x} common_on_dom H2 implies H1#x + H2#x
  = (H1+H2)#x & H1#x - H2#x = (H1-H2)#x & (H1#x) (#) (H2#x) = (H1(#)H2)#x;

theorem 
  (abs(H))#x = abs(H#x) & (-H)#x = -(H#x);

theorem 
  {x} common_on_dom H implies (r(#)H)#x = r(#)(H#x);

theorem 
  X common_on_dom H1 & X common_on_dom H2 implies for x st x in X
holds H1#x + H2#x = (H1+H2)#x & H1#x - H2#x = (H1-H2)#x & (H1#x) (#) (H2#x) = (
  H1(#)H2)#x;

theorem 
  abs(H)#x = abs(H#x) & (-H)#x = -(H#x);

theorem 
  X common_on_dom H implies for x st x in X holds (r(#)H)#x = r(#) (H#x);

theorem 
  H1 is_point_conv_on X & H2 is_point_conv_on X implies for x st x
in X holds H1#x + H2#x = (H1+H2)#x & H1#x - H2#x = (H1-H2)#x & (H1#x) (#) (H2#x
  ) = (H1(#)H2)#x;

theorem 
  abs(H)#x = abs(H#x) & (-H)#x = -(H#x);

theorem 
  H is_point_conv_on X implies for x st x in X holds (r(#)H)#x = r(#)(H# x);

theorem 
  X common_on_dom H1 & X common_on_dom H2 implies X common_on_dom
  H1+H2 & X common_on_dom H1-H2 & X common_on_dom H1(#)H2;

theorem 
  X common_on_dom H implies X common_on_dom abs(H) & X common_on_dom (-H);

theorem 
  X common_on_dom H implies X common_on_dom r(#)H;

theorem 
  H1 is_point_conv_on X & H2 is_point_conv_on X implies H1+H2
  is_point_conv_on X & lim(H1+H2,X) = lim(H1,X) + lim(H2,X) & H1-H2
  is_point_conv_on X & lim(H1-H2,X) = lim(H1,X) - lim(H2,X) & H1(#)H2
  is_point_conv_on X & lim(H1(#)H2,X) = lim(H1,X) (#) lim(H2,X);

theorem 
  H is_point_conv_on X implies abs(H) is_point_conv_on X & lim (abs(H),X
  ) = abs( lim (H,X) ) & -H is_point_conv_on X & lim (-H,X) = - lim(H,X);

theorem 
  H is_point_conv_on X implies r(#)H is_point_conv_on X & lim (r(#)H,X)
  = r(#)(lim(H,X));

theorem 
  H is_unif_conv_on X iff X common_on_dom H & H is_point_conv_on X
& for r st 0<r ex k st for n,x st n>=k & x in X holds abs((H.n).x-(lim(H,X)).x)
  <r;

reserve H for Functional_Sequence of REAL,REAL;

theorem 
  H is_unif_conv_on X & (for n holds (H.n)|X is continuous) implies lim(
  H,X)|X is continuous;














begin

reserve r,r1,r2,g,g1,g2,x0 for Real;
reserve n,k,m for Element of NAT;
reserve seq for Real_Sequence;
reserve f,f1,f2 for PartFunc of REAL,REAL;

theorem 
  (rng seq c= dom f /\ left_open_halfline(x0) or rng seq c= dom f
  /\ right_open_halfline(x0)) implies rng seq c= dom f \ {x0};

theorem 
  (for n holds 0<abs(x0-seq.n) & abs(x0-seq.n)<1/(n+1) & seq.n in
  dom f) implies seq is convergent & lim seq=x0 & rng seq c=dom f & rng seq c=
  dom f \ {x0};

theorem 
  seq is convergent & lim seq=x0 & rng seq c= dom f \ {x0} implies
  for r st 0<r ex n st for k st n<=k holds 0<abs(x0-seq.k) & abs(x0-seq.k)<r &
  seq.k in dom f;

theorem 
  0<r implies ].x0-r,x0+r.[ \ {x0} = ].x0-r,x0.[ \/ ].x0,x0+r.[;

theorem 
  0<r2 & ].x0-r2,x0.[ \/ ].x0,x0+r2.[ c= dom f implies for r1,r2 st
  r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom f & g2<r2 & x0<g2 & g2 in
  dom f;

theorem 
  (for n holds x0-1/(n+1)<seq.n & seq.n<x0 & seq.n in dom f)
  implies seq is convergent & lim seq=x0 & rng seq c= dom f \ {x0};

theorem 
  seq is convergent & lim seq=x0 & 0<g implies ex k st for n st k<=
  n holds x0-g<seq.n & seq.n<x0+g;

theorem 
  (for r1,r2 st r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom
  f & g2<r2 & x0<g2 & g2 in dom f) iff (for r st r<x0 ex g st r<g & g<x0 & g in
  dom f) & for r st x0<r ex g st g<r & x0<g & g in dom f;

definition
  let f,x0;
  pred f is_convergent_in x0 means


  (for r1,r2 st r1<x0 & x0<r2 ex g1,g2
st r1<g1 & g1<x0 & g1 in dom f & g2<r2 & x0<g2 & g2 in dom f) & ex g st for seq
  st seq is convergent & lim seq=x0 & rng seq c= dom f \ {x0} holds f/*seq is
  convergent & lim(f/*seq)=g;
  pred f is_divergent_to+infty_in x0 means


  (for r1,r2 st r1<x0 & x0<r2
  ex g1,g2 st r1<g1 & g1<x0 & g1 in dom f & g2<r2 & x0<g2 & g2 in dom f) & for
seq st seq is convergent & lim seq=x0 & rng seq c= dom f \ {x0} holds f/*seq is
  divergent_to+infty;
  pred f is_divergent_to-infty_in x0 means


  (for r1,r2 st r1<x0 & x0<r2
  ex g1,g2 st r1<g1 & g1<x0 & g1 in dom f & g2<r2 & x0<g2 & g2 in dom f) & for
seq st seq is convergent & lim seq=x0 & rng seq c= dom f \ {x0} holds f/*seq is
  divergent_to-infty;
end;

theorem 
  f is_convergent_in x0 iff (for r1,r2 st r1<x0 & x0<r2 ex g1,g2 st r1<
g1 & g1<x0 & g1 in dom f & g2<r2 & x0<g2 & g2 in dom f) & ex g st for g1 st 0<
  g1 ex g2 st 0<g2 & for r1 st 0<abs(x0-r1) & abs(x0-r1)<g2 & r1 in dom f holds
  abs(f.r1-g)<g1;

theorem 
  f is_divergent_to+infty_in x0 iff (for r1,r2 st r1<x0 & x0<r2 ex g1,g2
st r1<g1 & g1<x0 & g1 in dom f & g2<r2 & x0<g2 & g2 in dom f) & for g1 ex g2 st
  0<g2 & for r1 st 0<abs(x0-r1) & abs(x0-r1)<g2 & r1 in dom f holds g1<f.r1;

theorem 
  f is_divergent_to-infty_in x0 iff (for r1,r2 st r1<x0 & x0<r2 ex g1,g2
st r1<g1 & g1<x0 & g1 in dom f & g2<r2 & x0<g2 & g2 in dom f) & for g1 ex g2 st
  0<g2 & for r1 st 0<abs(x0-r1) & abs(x0-r1)<g2 & r1 in dom f holds f.r1<g1;

theorem 
  f is_divergent_to+infty_in x0 iff f
  is_left_divergent_to+infty_in x0 & f is_right_divergent_to+infty_in x0;

theorem 
  f is_divergent_to-infty_in x0 iff f
  is_left_divergent_to-infty_in x0 & f is_right_divergent_to-infty_in x0;

theorem 
  f1 is_divergent_to+infty_in x0 & f2 is_divergent_to+infty_in x0 & (for
r1,r2 st r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom f1 /\ dom f2 & g2<
r2 & x0<g2 & g2 in dom f1 /\ dom f2) implies f1+f2 is_divergent_to+infty_in x0
  & f1(#)f2 is_divergent_to+infty_in x0;

theorem 
  f1 is_divergent_to-infty_in x0 & f2 is_divergent_to-infty_in x0 & (for
r1,r2 st r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom f1 /\ dom f2 & g2<
r2 & x0<g2 & g2 in dom f1 /\ dom f2) implies f1+f2 is_divergent_to-infty_in x0
  & f1(#) f2 is_divergent_to+infty_in x0;

theorem 
  f1 is_divergent_to+infty_in x0 & (for r1,r2 st r1<x0 & x0<r2 ex g1,g2
st r1<g1 & g1<x0 & g1 in dom(f1+f2) & g2<r2 & x0<g2 & g2 in dom(f1+f2)) & (ex r
  st 0<r & f2|(].x0-r,x0.[ \/ ].x0,x0+r.[) is bounded_below ) implies f1+f2
  is_divergent_to+infty_in x0;

theorem 
  f1 is_divergent_to+infty_in x0 & (for r1,r2 st r1<x0 & x0<r2 ex g1,g2
st r1<g1 & g1<x0 & g1 in dom(f1(#)f2) & g2<r2 & x0<g2 & g2 in dom(f1(#)f2)) & (
  ex r,r1 st 0<r & 0<r1 & for g st g in dom f2 /\ (].x0-r,x0.[ \/ ].x0,x0+r.[)
  holds r1<=f2.g) implies f1(#)f2 is_divergent_to+infty_in x0;

theorem 
  (f is_divergent_to+infty_in x0 & r>0 implies r(#) f
is_divergent_to+infty_in x0)& (f is_divergent_to+infty_in x0 & r<0 implies r(#)
f is_divergent_to-infty_in x0)& (f is_divergent_to-infty_in x0 & r>0 implies r
  (#) f is_divergent_to-infty_in x0)& (f is_divergent_to-infty_in x0 & r<0
  implies r(#)f is_divergent_to+infty_in x0);

theorem 
  (f is_divergent_to+infty_in x0 or f is_divergent_to-infty_in x0)
  implies abs(f) is_divergent_to+infty_in x0;

theorem 
  (ex r st f|].x0-r,x0.[ is non-decreasing & f|].x0,x0+r.[ is
  non-increasing & not f|].x0-r,x0.[ is bounded_above & not f|].x0,x0+r.[ is
bounded_above) & (for r1,r2 st r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in
  dom f & g2<r2 & x0<g2 & g2 in dom f) implies f is_divergent_to+infty_in x0;

theorem 
  (ex r st 0<r & f|].x0-r,x0.[ is increasing & f|].x0,x0+r.[ is
  decreasing & not f|].x0-r,x0.[ is bounded_above & not f|].x0,x0+r.[ is
bounded_above) & (for r1,r2 st r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in
  dom f & g2<r2 & x0<g2 & g2 in dom f) implies f is_divergent_to+infty_in x0;

theorem 
  (ex r st f|].x0-r,x0.[ is non-increasing & f|].x0,x0+r.[ is
  non-decreasing & not f|].x0-r,x0.[ is bounded_below & not f|].x0,x0+r.[ is
bounded_below) & (for r1,r2 st r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in
  dom f & g2<r2 & x0<g2 & g2 in dom f) implies f is_divergent_to-infty_in x0;

theorem 
  (ex r st 0<r & f|].x0-r,x0.[ is decreasing & f|].x0,x0+r.[ is
  increasing & not f|].x0-r,x0.[ is bounded_below & not f|].x0,x0+r.[ is
bounded_below) & (for r1,r2 st r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in
  dom f & g2<r2 & x0<g2 & g2 in dom f) implies f is_divergent_to-infty_in x0;

theorem 
  f1 is_divergent_to+infty_in x0 & (for r1,r2 st r1<x0 & x0<r2 ex
g1,g2 st r1<g1 & g1<x0 & g1 in dom f & g2<r2 & x0<g2 & g2 in dom f) & (ex r st
0<r & dom f /\ (].x0-r,x0.[ \/ ].x0,x0+r.[) c= dom f1 /\ (].x0-r,x0.[ \/ ].x0,
x0+r.[) & for g st g in dom f /\ (].x0-r,x0.[ \/ ].x0,x0+r.[) holds f1.g<=f.g)
  implies f is_divergent_to+infty_in x0;

theorem 
  f1 is_divergent_to-infty_in x0 & (for r1,r2 st r1<x0 & x0<r2 ex
g1,g2 st r1<g1 & g1<x0 & g1 in dom f & g2<r2 & x0<g2 & g2 in dom f) & (ex r st
0<r & dom f /\ (].x0-r,x0.[ \/ ].x0,x0+r.[) c= dom f1 /\ (].x0-r,x0.[ \/ ].x0,
x0+r.[) & for g st g in dom f /\ (].x0-r,x0.[ \/ ].x0,x0+r.[) holds f.g<=f1.g)
  implies f is_divergent_to-infty_in x0;

theorem 
  f1 is_divergent_to+infty_in x0 & (ex r st 0<r & ].x0-r,x0.[ \/ ].x0,x0
+r.[ c= dom f /\ dom f1 & for g st g in ].x0-r,x0.[ \/ ].x0,x0+r.[ holds f1.g<=
  f.g) implies f is_divergent_to+infty_in x0;

theorem 
  f1 is_divergent_to-infty_in x0 & (ex r st 0<r & ].x0-r,x0.[ \/ ].x0,x0
+r.[ c= dom f /\ dom f1 & for g st g in ].x0-r,x0.[ \/ ].x0,x0+r.[ holds f.g<=
  f1.g) implies f is_divergent_to-infty_in x0;

definition
  let f,x0;
  assume
 f is_convergent_in x0;
  func lim(f,x0)->Real means


  for seq st seq is convergent & lim seq=x0
  & rng seq c= dom f \ {x0} holds f/*seq is convergent & lim(f/*seq)=it;
end;

theorem 
  f is_convergent_in x0 implies (lim(f,x0)=g iff for g1 st 0<g1 ex g2 st
0<g2 & for r1 st 0<abs(x0-r1) & abs(x0-r1)<g2 & r1 in dom f holds abs(f.r1-g)<
  g1);

theorem 
  f is_convergent_in x0 implies f is_left_convergent_in x0 & f
is_right_convergent_in x0 & lim_left(f,x0)=lim_right(f,x0) & lim(f,x0)=lim_left
  (f,x0) & lim(f,x0)=lim_right(f,x0);

theorem 
  f is_left_convergent_in x0 & f is_right_convergent_in x0 & lim_left(f,
x0)=lim_right(f,x0) implies f is_convergent_in x0 & lim(f,x0)=lim_left(f,x0) &
  lim(f,x0)=lim_right(f,x0);

theorem 
  f is_convergent_in x0 implies r(#)f is_convergent_in x0 & lim(r
  (#)f,x0)=r*(lim(f,x0));

theorem 
  f is_convergent_in x0 implies -f is_convergent_in x0 & lim(-f,x0
  )=-(lim(f,x0));

theorem 
  f1 is_convergent_in x0 & f2 is_convergent_in x0 & (for r1,r2 st
r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom(f1+f2) & g2<r2 & x0<g2 & g2
in dom(f1+f2)) implies f1+f2 is_convergent_in x0 & lim(f1+f2,x0)=lim(f1,x0)+lim
  (f2,x0);

theorem 
  f1 is_convergent_in x0 & f2 is_convergent_in x0 & (for r1,r2 st r1<x0
  & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom(f1-f2) & g2<r2 & x0<g2 & g2 in
dom(f1-f2)) implies f1-f2 is_convergent_in x0 & lim(f1-f2,x0)=(lim(f1,x0))-(lim
  (f2,x0));

theorem 
  f is_convergent_in x0 & f"{0}={} & lim(f,x0)<>0 implies f^
  is_convergent_in x0 & lim(f^,x0)=(lim(f,x0))";

theorem 
  f is_convergent_in x0 implies abs(f) is_convergent_in x0 & lim(abs(f),
  x0)=abs(lim(f,x0));

theorem 
  f is_convergent_in x0 & lim(f,x0)<>0 & (for r1,r2 st r1<x0 & x0<
r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom f & g2<r2 & x0<g2 & g2 in dom f & f.g1
  <>0 & f.g2<>0) implies f^ is_convergent_in x0 & lim(f^,x0)=(lim(f,x0))";

theorem 
  f1 is_convergent_in x0 & f2 is_convergent_in x0 & (for r1,r2 st
r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom(f1(#)f2) & g2<r2 & x0<g2 &
g2 in dom(f1(#) f2)) implies f1(#)f2 is_convergent_in x0 & lim(f1(#)f2,x0)=(lim
  (f1,x0))*(lim(f2,x0));

theorem 
  f1 is_convergent_in x0 & f2 is_convergent_in x0 & lim(f2,x0)<>0 & (for
  r1,r2 st r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom(f1/f2) & g2<r2 &
  x0<g2 & g2 in dom(f1/f2)) implies f1/f2 is_convergent_in x0 & lim(f1/f2,x0)=(
  lim(f1,x0))/(lim(f2,x0));

theorem 
  f1 is_convergent_in x0 & lim(f1,x0)=0 & (for r1,r2 st r1<x0 & x0<r2 ex
g1,g2 st r1<g1 & g1<x0 & g1 in dom(f1(#)f2) & g2<r2 & x0<g2 & g2 in dom(f1(#)f2
)) & (ex r st 0<r & f2|(].x0-r,x0.[ \/ ].x0,x0+r.[) is bounded ) implies f1(#)
  f2 is_convergent_in x0 & lim(f1(#)f2,x0)=0;

theorem 
  f1 is_convergent_in x0 & f2 is_convergent_in x0 & lim(f1,x0)=lim
(f2,x0) & (for r1,r2 st r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom f &
g2<r2 & x0<g2 & g2 in dom f) & (ex r st 0<r & (for g st g in dom f /\ (].x0-r,
x0.[ \/ ].x0,x0+r.[) holds f1.g<=f.g & f.g<=f2.g) & ((dom f1 /\ (].x0-r,x0.[ \/
].x0,x0+r.[) c= dom f2 /\ (].x0-r,x0.[ \/ ].x0,x0+r.[) & dom f /\ (].x0-r,x0.[
\/ ].x0,x0+r.[) c= dom f1 /\ (].x0-r,x0.[ \/ ].x0,x0+r.[)) or (dom f2 /\ (].x0-
r,x0.[ \/ ].x0,x0+r.[) c= dom f1 /\ (].x0-r,x0.[ \/ ].x0,x0+r.[) & dom f /\ (].
x0-r,x0.[ \/ ].x0,x0+r.[) c= dom f2 /\ (].x0-r,x0.[ \/ ].x0,x0+r.[)))) implies
  f is_convergent_in x0 & lim(f,x0)=lim(f1,x0);

theorem 
  f1 is_convergent_in x0 & f2 is_convergent_in x0 & lim(f1,x0)=lim(f2,x0
  ) & (ex r st 0<r & ].x0-r,x0.[ \/ ].x0,x0+r.[ c= dom f1 /\ dom f2 /\ dom f &
for g st g in ].x0-r,x0.[ \/ ].x0,x0+r.[ holds f1.g<=f.g & f.g<=f2.g) implies f
  is_convergent_in x0 & lim(f,x0)=lim(f1,x0);

theorem 
  f1 is_convergent_in x0 & f2 is_convergent_in x0 & (ex r st 0<r & ((dom
f1 /\ (].x0-r,x0.[ \/ ].x0,x0+r.[) c= dom f2 /\ (].x0-r,x0.[ \/ ].x0,x0+r.[) &
for g st g in dom f1 /\ (].x0-r,x0.[ \/ ].x0,x0+r.[) holds f1.g<=f2.g) or (dom
f2 /\ (].x0-r,x0.[ \/ ].x0,x0+r.[) c= dom f1 /\ (].x0-r,x0.[ \/ ].x0,x0+r.[) &
  for g st g in dom f2 /\ (].x0-r,x0.[ \/ ].x0,x0+r.[) holds f1.g<= f2.g)))
  implies lim(f1,x0)<=lim(f2,x0);

theorem 
  (f is_divergent_to+infty_in x0 or f is_divergent_to-infty_in x0) & (
for r1,r2 st r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom f & g2<r2 & x0
<g2 & g2 in dom f & f.g1<>0 & f.g2<>0) implies f^ is_convergent_in x0 & lim(f^,
  x0)=0;

theorem 
  f is_convergent_in x0 & lim(f,x0)=0 & (for r1,r2 st r1<x0 & x0<r2 ex
g1,g2 st r1<g1 & g1<x0 & g1 in dom f & g2<r2 & x0<g2 & g2 in dom f & f.g1<>0 &
  f.g2<>0) & (ex r st 0<r & for g st g in dom f /\ (].x0-r,x0.[ \/ ].x0,x0+r.[)
  holds 0<=f.g) implies f^ is_divergent_to+infty_in x0;

theorem 
  f is_convergent_in x0 & lim(f,x0)=0 & (for r1,r2 st r1<x0 & x0<r2 ex
g1,g2 st r1<g1 & g1<x0 & g1 in dom f & g2<r2 & x0<g2 & g2 in dom f & f.g1<>0 &
  f.g2<>0) & (ex r st 0<r & for g st g in dom f /\ (].x0-r,x0.[ \/ ].x0,x0+r.[)
  holds f.g<=0) implies f^ is_divergent_to-infty_in x0;

theorem 
  f is_convergent_in x0 & lim(f,x0)=0 & (ex r st 0<r & for g st g in dom
  f /\ (].x0-r,x0.[ \/ ].x0,x0+r.[) holds 0<f.g) implies f^
  is_divergent_to+infty_in x0;

theorem 
  f is_convergent_in x0 & lim(f,x0)=0 & (ex r st 0<r & for g st g in dom
  f /\ (].x0-r,x0.[ \/ ].x0,x0+r.[) holds f.g<0) implies f^
  is_divergent_to-infty_in x0;














begin

reserve x,X for set;
reserve x0,r1,r2,g,g1,g2,p,s for Real;
reserve r for real number;
reserve n,m for Element of NAT;
reserve a,b,d for Real_Sequence;
reserve f for PartFunc of REAL,REAL;

registration
  cluster [#] REAL -> closed;
  cluster empty -> closed for Subset of REAL;
end;

registration
  cluster [#] REAL -> open;
  cluster empty -> open for Subset of REAL;
end;

registration
  let r;
  cluster right_closed_halfline(r) -> closed;
  cluster left_closed_halfline(r) -> closed;
  cluster right_open_halfline(r) -> open;
  cluster halfline(r) -> open;
end;

theorem 
  g in ].x0 - r,x0 + r.[ implies abs(g-x0) < r;

theorem 
  g in ].x0 - r,x0 + r.[ implies g - x0 in ].-r,r.[;

theorem 
  g = x0 + r1 & abs(r1) < r implies 0 < r & g in ].x0 - r,x0 + r.[;

theorem 
  g - x0 in ].-r,r.[ implies 0 < r & g in ].x0 - r,x0 + r.[;

theorem 
  for x0 be real number holds (for n holds a.n = x0 - p/(n+1))
  implies a is convergent & lim a = x0;

theorem 
  for x0 be real number holds (for n holds a.n = x0 + p/(n+1))
  implies a is convergent & lim a = x0;

theorem 
  f is_continuous_in x0 & f.x0 <> r & (ex N be Neighbourhood of x0 st N
  c= dom f) implies ex N be Neighbourhood of x0 st N c= dom f & for g st g in N
  holds f.g <> r;

theorem 
  f|X is increasing or f|X is decreasing implies f|X is one-to-one;

theorem 
  for f be one-to-one PartFunc of REAL,REAL st f|X is increasing
  holds (f|X)"|(f.:X) is increasing;

theorem 
  for f be one-to-one PartFunc of REAL,REAL st f|X is decreasing
  holds (f|X)"|(f.:X) is decreasing;

theorem 
  X c= dom f & f|X is monotone & (ex p st f.:X =
  left_open_halfline(p)) implies f|X is continuous;

theorem 
  X c= dom f & f|X is monotone & (ex p st f.:X =
  right_open_halfline(p)) implies f|X is continuous;

theorem 
  X c= dom f & f|X is monotone & (ex p st f.:X =
  left_closed_halfline(p)) implies f|X is continuous;

theorem 
  X c= dom f & f|X is monotone & (ex p st f.:X =
  right_closed_halfline(p)) implies f|X is continuous;

theorem 
  X c= dom f & f|X is monotone & (ex p,g st f.:X = ].p,g.[)
  implies f|X is continuous;

theorem 
  X c= dom f & f|X is monotone & f.:X = REAL implies f|X is continuous;

theorem 
  for f be one-to-one PartFunc of REAL,REAL st (f|].p,g.[ is increasing
or f|].p,g.[ is decreasing) & ].p,g.[ c= dom f holds (f|].p,g.[)"|(f.:].p,g.[)
  is continuous;

theorem 
  for f be one-to-one PartFunc of REAL,REAL st (f|left_open_halfline p
is increasing or f|left_open_halfline p is decreasing) & left_open_halfline(p)
  c= dom f holds (f|left_open_halfline(p))"|(f.:left_open_halfline(p)) is
  continuous;

theorem 
  for f be one-to-one PartFunc of REAL,REAL st (f|right_open_halfline p
is increasing or f|right_open_halfline p is decreasing) & right_open_halfline(p
  ) c= dom f holds (f|right_open_halfline(p))"|(f.:right_open_halfline(p)) is
  continuous;

theorem 
  for f be one-to-one PartFunc of REAL,REAL st (f|left_closed_halfline p
is increasing or f|left_closed_halfline p is decreasing) & left_closed_halfline
(p) c= dom f holds (f|left_closed_halfline(p))"|(f.:left_closed_halfline(p)) is
  continuous;

theorem 
  for f be one-to-one PartFunc of REAL,REAL st (f|right_closed_halfline
  p is increasing or f|right_closed_halfline p is decreasing) &
  right_closed_halfline(p) c= dom f holds (f|right_closed_halfline(p))"|(f.:
  right_closed_halfline(p)) is continuous;

theorem 
  for f be one-to-one PartFunc of REAL,REAL st (f|[#]REAL is increasing
  or f|[#]REAL is decreasing) & f is total holds f"|rng f is continuous;

theorem 
  ].p,g.[ c= dom f & f|].p,g.[ is continuous & (f|].p,g.[ is increasing
  or f|].p,g.[ is decreasing) implies rng (f|].p,g.[) is open;

theorem 
  left_open_halfline(p) c= dom f & f|left_open_halfline p is continuous
& (f|left_open_halfline p is increasing or f|left_open_halfline p is decreasing
  ) implies rng (f|left_open_halfline(p)) is open;

theorem 
  right_open_halfline(p) c= dom f & f|right_open_halfline p is
continuous & (f|right_open_halfline p is increasing or f|right_open_halfline p
  is decreasing) implies rng (f|right_open_halfline(p)) is open;

theorem 
  [#](REAL) c= dom f & f|[#]REAL is continuous & (f|[#]REAL is
  increasing or f|[#]REAL is decreasing) implies rng f is open;














begin

reserve r,r1,r2,g,g1,g2,x0 for Real;
reserve f1,f2 for PartFunc of REAL,REAL;

theorem 
  for s be Real_Sequence,X be set st rng s c= dom(f2*f1) /\ X holds
rng s c= dom(f2*f1) & rng s c= X & rng s c= dom f1 & rng s c= dom f1 /\ X & rng
  (f1/*s) c= dom f2;

theorem 
  for s be Real_Sequence,X be set st rng s c= dom(f2*f1) \ X holds
rng s c= dom(f2*f1) & rng s c= dom f1 & rng s c= dom f1 \ X & rng(f1/*s) c= dom
  f2;

theorem 
  f1 is divergent_in+infty_to+infty & f2 is divergent_in+infty_to+infty
  & (for r ex g st r<g & g in dom(f2*f1)) implies f2*f1 is
  divergent_in+infty_to+infty;

theorem 
  f1 is divergent_in+infty_to+infty & f2 is divergent_in+infty_to-infty
  & (for r ex g st r<g & g in dom(f2*f1)) implies f2*f1 is
  divergent_in+infty_to-infty;

theorem 
  f1 is divergent_in+infty_to-infty & f2 is divergent_in-infty_to+infty
  & (for r ex g st r<g & g in dom(f2*f1)) implies f2*f1 is
  divergent_in+infty_to+infty;

theorem 
  f1 is divergent_in+infty_to-infty & f2 is divergent_in-infty_to-infty
  & (for r ex g st r<g & g in dom(f2*f1)) implies f2*f1 is
  divergent_in+infty_to-infty;

theorem 
  f1 is divergent_in-infty_to+infty & f2 is divergent_in+infty_to+infty
  & (for r ex g st g<r & g in dom(f2*f1)) implies f2*f1 is
  divergent_in-infty_to+infty;

theorem 
  f1 is divergent_in-infty_to+infty & f2 is divergent_in+infty_to-infty
  & (for r ex g st g<r & g in dom(f2*f1)) implies f2*f1 is
  divergent_in-infty_to-infty;

theorem 
  f1 is divergent_in-infty_to-infty & f2 is divergent_in-infty_to+infty
  & (for r ex g st g<r & g in dom(f2*f1)) implies f2*f1 is
  divergent_in-infty_to+infty;

theorem 
  f1 is divergent_in-infty_to-infty & f2 is divergent_in-infty_to-infty
  & (for r ex g st g<r & g in dom(f2*f1)) implies f2*f1 is
  divergent_in-infty_to-infty;

theorem 
  f1 is_left_divergent_to+infty_in x0 & f2 is
divergent_in+infty_to+infty & (for r st r<x0 ex g st r<g & g<x0 & g in dom(f2*
  f1)) implies f2*f1 is_left_divergent_to+infty_in x0;

theorem 
  f1 is_left_divergent_to+infty_in x0 & f2 is
divergent_in+infty_to-infty & (for r st r<x0 ex g st r<g & g<x0 & g in dom(f2*
  f1)) implies f2*f1 is_left_divergent_to-infty_in x0;

theorem 
  f1 is_left_divergent_to-infty_in x0 & f2 is
divergent_in-infty_to+infty & (for r st r<x0 ex g st r<g & g<x0 & g in dom(f2*
  f1)) implies f2*f1 is_left_divergent_to+infty_in x0;

theorem 
  f1 is_left_divergent_to-infty_in x0 & f2 is
divergent_in-infty_to-infty & (for r st r<x0 ex g st r<g & g<x0 & g in dom(f2*
  f1)) implies f2*f1 is_left_divergent_to-infty_in x0;

theorem 
  f1 is_right_divergent_to+infty_in x0 & f2 is
divergent_in+infty_to+infty & (for r st x0<r ex g st g<r & x0<g & g in dom(f2*
  f1)) implies f2*f1 is_right_divergent_to+infty_in x0;

theorem 
  f1 is_right_divergent_to+infty_in x0 & f2 is
divergent_in+infty_to-infty & (for r st x0<r ex g st g<r & x0<g & g in dom(f2*
  f1)) implies f2*f1 is_right_divergent_to-infty_in x0;

theorem 
  f1 is_right_divergent_to-infty_in x0 & f2 is
divergent_in-infty_to+infty & (for r st x0<r ex g st g<r & x0<g & g in dom(f2*
  f1)) implies f2*f1 is_right_divergent_to+infty_in x0;

theorem 
  f1 is_right_divergent_to-infty_in x0 & f2 is
divergent_in-infty_to-infty & (for r st x0<r ex g st g<r & x0<g & g in dom(f2*
  f1)) implies f2*f1 is_right_divergent_to-infty_in x0;

theorem 
  f1 is_left_convergent_in x0 & f2 is_left_divergent_to+infty_in
lim_left(f1,x0) & (for r st r<x0 ex g st r<g & g<x0 & g in dom(f2*f1)) & (ex g
  st 0<g & for r st r in dom f1 /\ ].x0-g,x0.[ holds f1.r<lim_left(f1,x0))
  implies f2*f1 is_left_divergent_to+infty_in x0;

theorem 
  f1 is_left_convergent_in x0 & f2 is_left_divergent_to-infty_in
lim_left(f1,x0) & (for r st r<x0 ex g st r<g & g<x0 & g in dom(f2*f1)) & (ex g
  st 0<g & for r st r in dom f1 /\ ].x0-g,x0.[ holds f1.r<lim_left(f1,x0))
  implies f2*f1 is_left_divergent_to-infty_in x0;

theorem 
  f1 is_left_convergent_in x0 & f2 is_right_divergent_to+infty_in
lim_left(f1,x0) & (for r st r<x0 ex g st r<g & g<x0 & g in dom(f2*f1)) & (ex g
  st 0<g & for r st r in dom f1 /\ ].x0-g,x0.[ holds lim_left(f1,x0)<f1.r)
  implies f2*f1 is_left_divergent_to+infty_in x0;

theorem 
  f1 is_left_convergent_in x0 & f2 is_right_divergent_to-infty_in
lim_left(f1,x0) & (for r st r<x0 ex g st r<g & g<x0 & g in dom(f2*f1)) & (ex g
  st 0<g & for r st r in dom f1 /\ ].x0-g,x0.[ holds lim_left(f1,x0)<f1.r)
  implies f2*f1 is_left_divergent_to-infty_in x0;

theorem 
  f1 is_right_convergent_in x0 & f2 is_right_divergent_to+infty_in
lim_right(f1,x0) & (for r st x0<r ex g st g<r & x0<g & g in dom(f2*f1)) & (ex g
  st 0<g & for r st r in dom f1 /\ ].x0,x0+g.[ holds lim_right(f1,x0)<f1.r)
  implies f2*f1 is_right_divergent_to+infty_in x0;

theorem 
  f1 is_right_convergent_in x0 & f2 is_right_divergent_to-infty_in
lim_right(f1,x0) & (for r st x0<r ex g st g<r & x0<g & g in dom(f2*f1)) & (ex g
  st 0<g & for r st r in dom f1 /\ ].x0,x0+g.[ holds lim_right(f1,x0)<f1.r)
  implies f2*f1 is_right_divergent_to-infty_in x0;

theorem 
  f1 is_right_convergent_in x0 & f2 is_left_divergent_to+infty_in
lim_right(f1,x0) & (for r st x0<r ex g st g<r & x0<g & g in dom(f2*f1)) & (ex g
  st 0<g & for r st r in dom f1 /\ ].x0,x0+g.[ holds f1.r<lim_right(f1,x0))
  implies f2*f1 is_right_divergent_to+infty_in x0;

theorem 
  f1 is_right_convergent_in x0 & f2 is_left_divergent_to-infty_in
lim_right(f1,x0) & (for r st x0<r ex g st g<r & x0<g & g in dom(f2*f1)) & (ex g
  st 0<g & for r st r in dom f1 /\ ].x0,x0+g.[ holds f1.r<lim_right(f1,x0))
  implies f2*f1 is_right_divergent_to-infty_in x0;

theorem 
  f1 is convergent_in+infty & f2 is_left_divergent_to+infty_in
  lim_in+infty f1 & (for r ex g st r<g & g in dom(f2*f1)) & (ex r st for g st g
  in dom f1 /\ right_open_halfline(r) holds f1.g<lim_in+infty f1) implies f2*f1
  is divergent_in+infty_to+infty;

theorem 
  f1 is convergent_in+infty & f2 is_left_divergent_to-infty_in
  lim_in+infty f1 & (for r ex g st r<g & g in dom(f2*f1)) & (ex r st for g st g
  in dom f1 /\ right_open_halfline(r) holds f1.g<lim_in+infty f1) implies f2*f1
  is divergent_in+infty_to-infty;

theorem 
  f1 is convergent_in+infty & f2 is_right_divergent_to+infty_in
  lim_in+infty f1 & (for r ex g st r<g & g in dom(f2*f1)) & (ex r st for g st g
  in dom f1 /\ right_open_halfline(r) holds lim_in+infty f1<f1.g) implies f2*f1
  is divergent_in+infty_to+infty;

theorem 
  f1 is convergent_in+infty & f2 is_right_divergent_to-infty_in
  lim_in+infty f1 & (for r ex g st r<g & g in dom(f2*f1)) & (ex r st for g st g
  in dom f1 /\ right_open_halfline(r) holds lim_in+infty f1<f1.g) implies f2*f1
  is divergent_in+infty_to-infty;

theorem 
  f1 is convergent_in-infty & f2 is_left_divergent_to+infty_in
  lim_in-infty f1 & (for r ex g st g<r & g in dom(f2*f1)) & (ex r st for g st g
in dom f1 /\ left_open_halfline(r) holds f1.g<lim_in-infty f1) implies f2*f1 is
  divergent_in-infty_to+infty;

theorem 
  f1 is convergent_in-infty & f2 is_left_divergent_to-infty_in
  lim_in-infty f1 & (for r ex g st g<r & g in dom(f2*f1)) & (ex r st for g st g
in dom f1 /\ left_open_halfline(r) holds f1.g<lim_in-infty f1) implies f2*f1 is
  divergent_in-infty_to-infty;

theorem 
  f1 is convergent_in-infty & f2 is_right_divergent_to+infty_in
  lim_in-infty f1 & (for r ex g st g<r & g in dom(f2*f1)) & (ex r st for g st g
in dom f1 /\ left_open_halfline(r) holds lim_in-infty f1<f1.g) implies f2*f1 is
  divergent_in-infty_to+infty;

theorem 
  f1 is convergent_in-infty & f2 is_right_divergent_to-infty_in
  lim_in-infty f1 & (for r ex g st g<r & g in dom(f2*f1)) & (ex r st for g st g
in dom f1 /\ left_open_halfline(r) holds lim_in-infty f1<f1.g) implies f2*f1 is
  divergent_in-infty_to-infty;

theorem 
  f1 is_divergent_to+infty_in x0 & f2 is divergent_in+infty_to+infty & (
for r1,r2 st r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom(f2*f1) & g2<r2
  & x0<g2 & g2 in dom(f2*f1)) implies f2*f1 is_divergent_to+infty_in x0;

theorem 
  f1 is_divergent_to+infty_in x0 & f2 is divergent_in+infty_to-infty & (
for r1,r2 st r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom(f2*f1) & g2<r2
  & x0<g2 & g2 in dom(f2*f1)) implies f2*f1 is_divergent_to-infty_in x0;

theorem 
  f1 is_divergent_to-infty_in x0 & f2 is divergent_in-infty_to+infty & (
for r1,r2 st r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom(f2*f1) & g2<r2
  & x0<g2 & g2 in dom(f2*f1)) implies f2*f1 is_divergent_to+infty_in x0;

theorem 
  f1 is_divergent_to-infty_in x0 & f2 is divergent_in-infty_to-infty & (
for r1,r2 st r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom(f2*f1) & g2<r2
  & x0<g2 & g2 in dom(f2*f1)) implies f2*f1 is_divergent_to-infty_in x0;

theorem 
  f1 is_convergent_in x0 & f2 is_divergent_to+infty_in lim(f1,x0) & (for
  r1,r2 st r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom(f2*f1) & g2<r2 &
x0<g2 & g2 in dom(f2*f1)) & (ex g st 0<g & for r st r in dom f1 /\ (].x0-g,x0.[
\/ ].x0,x0+g.[) holds f1.r<>lim(f1,x0)) implies f2*f1 is_divergent_to+infty_in
  x0;

theorem 
  f1 is_convergent_in x0 & f2 is_divergent_to-infty_in lim(f1,x0) & (for
  r1,r2 st r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom(f2*f1) & g2<r2 &
x0<g2 & g2 in dom(f2*f1)) & (ex g st 0<g & for r st r in dom f1 /\ (].x0-g,x0.[
\/ ].x0,x0+g.[) holds f1.r<>lim(f1,x0)) implies f2*f1 is_divergent_to-infty_in
  x0;

theorem 
  f1 is_convergent_in x0 & f2 is_right_divergent_to+infty_in lim(f1,x0)
& (for r1,r2 st r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom(f2*f1) & g2
<r2 & x0<g2 & g2 in dom(f2*f1)) & (ex g st 0<g & for r st r in dom f1 /\ (].x0-
  g,x0.[ \/ ].x0,x0+g.[) holds f1.r>lim(f1,x0)) implies f2*f1
  is_divergent_to+infty_in x0;

theorem 
  f1 is_convergent_in x0 & f2 is_right_divergent_to-infty_in lim(f1,x0)
& (for r1,r2 st r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom(f2*f1) & g2
<r2 & x0<g2 & g2 in dom(f2*f1)) & (ex g st 0<g & for r st r in dom f1 /\ (].x0-
  g,x0.[ \/ ].x0,x0+g.[) holds f1.r>lim(f1,x0)) implies f2*f1
  is_divergent_to-infty_in x0;

theorem 
  f1 is_right_convergent_in x0 & f2 is_divergent_to+infty_in lim_right(
f1,x0 ) & (for r st x0<r ex g st g<r & x0<g & g in dom(f2*f1)) & (ex g st 0<g &
for r st r in dom f1 /\ ].x0,x0+g.[ holds f1.r<>lim_right(f1,x0)) implies f2*f1
  is_right_divergent_to+infty_in x0;

theorem 
  f1 is_right_convergent_in x0 & f2 is_divergent_to-infty_in lim_right(
f1,x0 ) & (for r st x0<r ex g st g<r & x0<g & g in dom(f2*f1)) & (ex g st 0<g &
for r st r in dom f1 /\ ].x0,x0+g.[ holds f1.r<>lim_right(f1,x0)) implies f2*f1
  is_right_divergent_to-infty_in x0;

theorem 
  f1 is convergent_in+infty & f2 is_divergent_to+infty_in lim_in+infty
  f1 & (for r ex g st r<g & g in dom(f2*f1)) & (ex r st for g st g in dom f1 /\
  right_open_halfline(r) holds f1.g<>lim_in+infty f1) implies f2*f1 is
  divergent_in+infty_to+infty;

theorem 
  f1 is convergent_in+infty & f2 is_divergent_to-infty_in lim_in+infty
  f1 & (for r ex g st r<g & g in dom(f2*f1)) & (ex r st for g st g in dom f1 /\
  right_open_halfline(r) holds f1.g<>lim_in+infty f1) implies f2*f1 is
  divergent_in+infty_to-infty;

theorem 
  f1 is convergent_in-infty & f2 is_divergent_to+infty_in lim_in-infty
  f1 & (for r ex g st g<r & g in dom(f2*f1)) & (ex r st for g st g in dom f1 /\
  left_open_halfline(r) holds f1.g<>lim_in-infty f1) implies f2*f1 is
  divergent_in-infty_to+infty;

theorem 
  f1 is convergent_in-infty & f2 is_divergent_to-infty_in lim_in-infty
  f1 & (for r ex g st g<r & g in dom(f2*f1)) & (ex r st for g st g in dom f1 /\
  left_open_halfline(r) holds f1.g<>lim_in-infty f1) implies f2*f1 is
  divergent_in-infty_to-infty;

theorem 
  f1 is_convergent_in x0 & f2 is_left_divergent_to+infty_in lim(f1,x0) &
(for r1,r2 st r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom(f2*f1) & g2<
r2 & x0<g2 & g2 in dom(f2*f1)) & (ex g st 0<g & for r st r in dom f1 /\ (].x0-g
  ,x0.[ \/ ].x0,x0+g.[) holds f1.r<lim(f1,x0)) implies f2*f1
  is_divergent_to+infty_in x0;

theorem 
  f1 is_convergent_in x0 & f2 is_left_divergent_to-infty_in lim(f1,x0) &
(for r1,r2 st r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom(f2*f1) & g2<
r2 & x0<g2 & g2 in dom(f2*f1)) & (ex g st 0<g & for r st r in dom f1 /\ (].x0-g
  ,x0.[ \/ ].x0,x0+g.[) holds f1.r<lim(f1,x0)) implies f2*f1
  is_divergent_to-infty_in x0;

theorem 
  f1 is_left_convergent_in x0 & f2 is_divergent_to+infty_in lim_left(f1,
x0) & (for r st r<x0 ex g st r<g & g<x0 & g in dom(f2*f1)) & (ex g st 0<g & for
  r st r in dom f1 /\ ].x0-g,x0.[ holds f1.r<>lim_left(f1,x0)) implies f2*f1
  is_left_divergent_to+infty_in x0;

theorem 
  f1 is_left_convergent_in x0 & f2 is_divergent_to-infty_in lim_left(f1,
x0) & (for r st r<x0 ex g st r<g & g<x0 & g in dom(f2*f1)) & (ex g st 0<g & for
  r st r in dom f1 /\ ].x0-g,x0.[ holds f1.r<>lim_left(f1,x0)) implies f2*f1
  is_left_divergent_to-infty_in x0;

theorem 
  f1 is divergent_in+infty_to+infty & f2 is convergent_in+infty & (for r
  ex g st r<g & g in dom(f2*f1)) implies f2*f1 is convergent_in+infty &
  lim_in+infty(f2*f1)=lim_in+infty f2;

theorem 
  f1 is divergent_in+infty_to-infty & f2 is convergent_in-infty & (for r
  ex g st r<g & g in dom(f2*f1)) implies f2*f1 is convergent_in+infty &
  lim_in+infty(f2*f1)=lim_in-infty f2;

theorem 
  f1 is divergent_in-infty_to+infty & f2 is convergent_in+infty & (for r
  ex g st g<r & g in dom(f2*f1)) implies f2*f1 is convergent_in-infty &
  lim_in-infty(f2*f1)=lim_in+infty f2;

theorem 
  f1 is divergent_in-infty_to-infty & f2 is convergent_in-infty & (for r
  ex g st g<r & g in dom(f2*f1)) implies f2*f1 is convergent_in-infty &
  lim_in-infty(f2*f1)=lim_in-infty f2;

theorem 
  f1 is_left_divergent_to+infty_in x0 & f2 is convergent_in+infty & (for
  r st r<x0 ex g st r<g & g<x0 & g in dom(f2*f1)) implies f2*f1
  is_left_convergent_in x0 & lim_left(f2*f1,x0)=lim_in+infty f2;

theorem 
  f1 is_left_divergent_to-infty_in x0 & f2 is convergent_in-infty & (for
  r st r<x0 ex g st r<g & g<x0 & g in dom(f2*f1)) implies f2*f1
  is_left_convergent_in x0 & lim_left(f2*f1,x0)=lim_in-infty f2;

theorem 
  f1 is_right_divergent_to+infty_in x0 & f2 is convergent_in+infty & (
  for r st x0<r ex g st g<r & x0<g & g in dom(f2*f1)) implies f2*f1
  is_right_convergent_in x0 & lim_right(f2*f1,x0)=lim_in+infty f2;

theorem 
  f1 is_right_divergent_to-infty_in x0 & f2 is convergent_in-infty & (
  for r st x0<r ex g st g<r & x0<g & g in dom(f2*f1)) implies f2*f1
  is_right_convergent_in x0 & lim_right(f2*f1,x0)=lim_in-infty f2;

theorem 
  f1 is_left_convergent_in x0 & f2 is_left_convergent_in lim_left(f1,x0)
  & (for r st r<x0 ex g st r<g & g<x0 & g in dom(f2*f1)) & (ex g st 0<g & for r
  st r in dom f1 /\ ].x0-g,x0.[ holds f1.r<lim_left(f1,x0)) implies f2*f1
  is_left_convergent_in x0 & lim_left(f2*f1,x0)=lim_left(f2,lim_left(f1,x0));

theorem 
  f1 is_right_convergent_in x0 & f2 is_right_convergent_in lim_right(f1,
x0) & (for r st x0<r ex g st g<r & x0<g & g in dom(f2*f1)) & (ex g st 0<g & for
  r st r in dom f1 /\ ].x0,x0+g.[ holds lim_right(f1,x0)<f1.r) implies f2*f1
is_right_convergent_in x0 & lim_right(f2*f1,x0)=lim_right(f2,lim_right(f1,x0));

theorem 
  f1 is_left_convergent_in x0 & f2 is_right_convergent_in lim_left(f1,x0
) & (for r st r<x0 ex g st r<g & g<x0 & g in dom(f2*f1)) & (ex g st 0<g & for r
  st r in dom f1 /\ ].x0-g,x0.[ holds lim_left(f1,x0)<f1.r) implies f2*f1
  is_left_convergent_in x0 & lim_left(f2*f1,x0)=lim_right(f2,lim_left(f1,x0));

theorem 
  f1 is_right_convergent_in x0 & f2 is_left_convergent_in lim_right(f1,
x0) & (for r st x0<r ex g st g<r & x0<g & g in dom(f2*f1)) & (ex g st 0<g & for
  r st r in dom f1 /\ ].x0,x0+g.[ holds f1.r<lim_right(f1,x0)) implies f2*f1
  is_right_convergent_in x0 & lim_right(f2*f1,x0)=lim_left(f2,lim_right(f1,x0))
;

theorem 
  f1 is convergent_in+infty & f2 is_left_convergent_in lim_in+infty f1 &
  (for r ex g st r<g & g in dom(f2*f1)) & (ex r st for g st g in dom f1 /\
  right_open_halfline(r) holds f1.g<lim_in+infty f1) implies f2*f1 is
  convergent_in+infty & lim_in+infty(f2*f1)=lim_left(f2,lim_in+infty f1);

theorem 
  f1 is convergent_in+infty & f2 is_right_convergent_in lim_in+infty f1
  & (for r ex g st r<g & g in dom(f2*f1)) & (ex r st for g st g in dom f1 /\
  right_open_halfline(r) holds lim_in+infty f1<f1.g) implies f2*f1 is
  convergent_in+infty & lim_in+infty(f2*f1)=lim_right(f2,lim_in+infty f1);

theorem 
  f1 is convergent_in-infty & f2 is_left_convergent_in lim_in-infty f1 &
  (for r ex g st g<r & g in dom(f2*f1)) & (ex r st for g st g in dom f1 /\
  left_open_halfline(r) holds f1.g<lim_in-infty f1) implies f2*f1 is
  convergent_in-infty & lim_in-infty(f2*f1)=lim_left(f2,lim_in-infty f1);

theorem 
  f1 is convergent_in-infty & f2 is_right_convergent_in lim_in-infty f1
  & (for r ex g st g<r & g in dom(f2*f1)) & (ex r st for g st g in dom f1 /\
  left_open_halfline(r) holds lim_in-infty f1<f1.g) implies f2*f1 is
  convergent_in-infty & lim_in-infty(f2*f1)=lim_right(f2,lim_in-infty f1);

theorem 
  f1 is_divergent_to+infty_in x0 & f2 is convergent_in+infty & (for r1,
r2 st r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom(f2*f1) & g2<r2 & x0<
  g2 & g2 in dom(f2*f1)) implies f2*f1 is_convergent_in x0 & lim(f2*f1,x0)=
  lim_in+infty f2;

theorem 
  f1 is_divergent_to-infty_in x0 & f2 is convergent_in-infty & (for r1,
r2 st r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom(f2*f1) & g2<r2 & x0<
  g2 & g2 in dom(f2*f1)) implies f2*f1 is_convergent_in x0 & lim(f2*f1,x0)=
  lim_in-infty f2;

theorem 
  f1 is convergent_in+infty & f2 is_convergent_in lim_in+infty f1 & (for
  r ex g st r<g & g in dom(f2*f1)) & (ex r st for g st g in dom f1 /\
  right_open_halfline(r) holds f1.g<>lim_in+infty f1) implies f2*f1 is
  convergent_in+infty & lim_in+infty(f2*f1)=lim(f2,lim_in+infty f1);

theorem 
  f1 is convergent_in-infty & f2 is_convergent_in lim_in-infty f1 & (for
  r ex g st g<r & g in dom(f2*f1)) & (ex r st for g st g in dom f1 /\
  left_open_halfline(r) holds f1.g<>lim_in-infty f1) implies f2*f1 is
  convergent_in-infty & lim_in-infty(f2*f1)=lim(f2,lim_in-infty f1);

theorem 
  f1 is_convergent_in x0 & f2 is_left_convergent_in lim(f1,x0) & (for r1
,r2 st r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom(f2*f1) & g2<r2 & x0<
g2 & g2 in dom(f2*f1)) & (ex g st 0<g & for r st r in dom f1 /\ (].x0-g,x0.[ \/
].x0,x0+g.[) holds f1.r<lim(f1,x0)) implies f2*f1 is_convergent_in x0 & lim(f2*
  f1,x0)=lim_left(f2,lim(f1,x0));

theorem 
  f1 is_left_convergent_in x0 & f2 is_convergent_in lim_left(f1,x0) & (
for r st r<x0 ex g st r<g & g<x0 & g in dom(f2*f1)) & (ex g st 0<g & for r st r
  in dom f1 /\ ].x0-g,x0.[ holds f1.r<>lim_left(f1,x0)) implies f2*f1
  is_left_convergent_in x0 & lim_left(f2*f1,x0)=lim(f2,lim_left(f1,x0));

theorem 
  f1 is_convergent_in x0 & f2 is_right_convergent_in lim(f1,x0) & (for
  r1,r2 st r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom(f2*f1) & g2<r2 &
x0<g2 & g2 in dom(f2*f1)) & (ex g st 0<g & for r st r in dom f1 /\ (].x0-g,x0.[
\/ ].x0,x0+g.[) holds lim(f1,x0)<f1.r) implies f2*f1 is_convergent_in x0 & lim(
  f2*f1,x0)=lim_right(f2,lim(f1,x0));

theorem 
  f1 is_right_convergent_in x0 & f2 is_convergent_in lim_right(f1,x0) &
(for r st x0<r ex g st g<r & x0<g & g in dom(f2*f1)) & (ex g st 0<g & for r st
  r in dom f1 /\ ].x0,x0+g.[ holds f1.r<>lim_right(f1,x0)) implies f2*f1
  is_right_convergent_in x0 & lim_right(f2*f1,x0)=lim(f2,lim_right(f1,x0));

theorem 
  f1 is_convergent_in x0 & f2 is_convergent_in lim(f1,x0) & (for r1,r2
st r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom(f2*f1) & g2<r2 & x0<g2 &
g2 in dom(f2*f1)) & (ex g st 0<g & for r st r in dom f1 /\ (].x0-g,x0.[ \/ ].x0
,x0+g.[) holds f1.r<>lim(f1,x0)) implies f2*f1 is_convergent_in x0 & lim(f2*f1,
  x0)=lim(f2,lim(f1,x0));














begin

reserve f,g for PartFunc of REAL,REAL,
  r,r1,r2,g1,g2,g3,g4,g5,g6,x,x0,t,c for Real,
  a,b,s for Real_Sequence,
  n,k for Element of NAT;

theorem 
  f is_continuous_in x0 & (for r1,r2 st r1<x0 & x0<r2 ex g1,g2 st r1<g1
& g1<x0 & g1 in dom f & g2<r2 & x0<g2 & g2 in dom f) implies f is_convergent_in
  x0;

theorem 
  f is_right_convergent_in x0 & lim_right(f,x0) = t iff (for r st
x0<r ex t st t<r & x0<t & t in dom f) & for a st a is convergent & lim a = x0 &
rng a c= dom f /\ right_open_halfline(x0) holds f/*a is convergent & lim(f/*a)
  = t;

theorem 
  f is_left_convergent_in x0 & lim_left(f,x0) = t iff (for r st r<
  x0 ex t st r<t & t<x0 & t in dom f) & for a st a is convergent & lim a = x0 &
rng a c= dom f /\ left_open_halfline(x0) holds f/*a is convergent & lim(f/*a) =
  t;

theorem 
  (ex N being Neighbourhood of x0 st N\{x0} c=dom f) implies for r1
,r2 st r1<x0 & x0<r2 ex g1,g2 st r1<g1 & g1<x0 & g1 in dom f & g2<r2 & x0<g2 &
  g2 in dom f;

theorem 
  (ex N being Neighbourhood of x0 st N c= dom f & N c= dom g & f
  is_differentiable_on N & g is_differentiable_on N & N \ {x0} c= dom (f/g) & N
  c= dom ((f`|N)/(g`|N)) & f.x0 = 0 & g.x0 = 0 & (f`|N)/(g`|N)
  is_divergent_to+infty_in x0) implies f/g is_divergent_to+infty_in x0;

theorem 
  (ex N being Neighbourhood of x0 st N c= dom f & N c= dom g & f
  is_differentiable_on N & g is_differentiable_on N & N \ {x0} c= dom (f/g) & N
  c= dom ((f`|N)/(g`|N)) & f.x0 = 0 & g.x0 = 0 & (f`|N)/(g`|N)
  is_divergent_to-infty_in x0) implies f/g is_divergent_to-infty_in x0;

theorem 
  x0 in dom f /\ dom g & (ex r st r>0 & [.x0,x0+r.] c= dom f & [.x0,x0+r
.] c= dom g & f is_differentiable_on ].x0,x0+r.[ & g is_differentiable_on ].x0,
x0+r.[ & ].x0,x0+r.[ c= dom (f/g) & [.x0,x0+r.] c= dom ((f`|(].x0,x0+r.[))/(g`|
  (].x0,x0+r.[))) & f.x0 = 0 & g.x0 = 0 & f is_continuous_in x0 & g
  is_continuous_in x0 & (f`|(].x0,x0+r.[))/(g`|(].x0,x0+r.[))
is_right_convergent_in x0) implies f/g is_right_convergent_in x0 & ex r st r>0
  & lim_right(f/g,x0) = lim_right(((f`|(].x0,x0+r.[))/(g`|(].x0,x0+r.[))),x0);

theorem 
  x0 in dom f /\ dom g & (ex r st r>0 & [.x0-r,x0.] c= dom f & [.x0-r,x0
.] c= dom g & f is_differentiable_on ].x0-r,x0.[ & g is_differentiable_on ].x0-
r,x0.[ & ].x0-r,x0.[ c= dom (f/g) & [.x0-r,x0.] c= dom ((f`|(].x0-r,x0.[))/(g`|
  (].x0-r,x0.[))) & f.x0 = 0 & g.x0 = 0 & f is_continuous_in x0 & g
  is_continuous_in x0 & (f`|(].x0-r,x0.[))/(g`|(].x0-r,x0.[))
is_left_convergent_in x0) implies f/g is_left_convergent_in x0 & ex r st r>0 &
  lim_left(f/g,x0) = lim_left(((f`|(].x0-r,x0.[))/(g`|(].x0-r,x0.[))),x0);

theorem 
  (ex N being Neighbourhood of x0 st N c= dom f & N c= dom g & f
  is_differentiable_on N & g is_differentiable_on N & N \ {x0} c= dom (f/g) & N
  c= dom ((f`|N)/(g`|N)) & f.x0 = 0 & g.x0 = 0 & (f`|N)/(g`|N) is_convergent_in
x0) implies f/g is_convergent_in x0 & ex N being Neighbourhood of x0 st lim(f/g
  ,x0) = lim(((f`|N)/(g`|N)),x0);


theorem 
  (ex N being Neighbourhood of x0 st N c= dom f & N c= dom g & f
  is_differentiable_on N & g is_differentiable_on N & N \ {x0} c= dom (f/g) & N
  c= dom ((f`|N)/(g`|N)) & f.x0 = 0 & g.x0 = 0 & (f`|N)/(g`|N) is_continuous_in
  x0) implies f/g is_convergent_in x0 & lim(f/g,x0) = diff(f,x0)/diff(g,x0);














begin

reserve x for set;
reserve x0,r,r1,r2,g,g1,g2,p for Real;
reserve n,m,k,l for Element of NAT;
reserve a,b,d for Real_Sequence;
reserve h,h1,h2 for non-zero 0-convergent Real_Sequence;
reserve c,c1 for constant Real_Sequence;
reserve A for open Subset of REAL;
reserve f,f1,f2 for PartFunc of REAL,REAL;
reserve L for LinearFunc;
reserve R for RestFunc;

registration
  let h;
  cluster -h -> non-zero convergent;
end;

theorem 
  a is convergent & b is convergent & lim a = lim b & (for n holds
  d.(2*n) = a.n & d.(2*n + 1) = b.n) implies d is convergent & lim d = lim a;

theorem 
  (for n holds a.n = 2*n) implies a is increasing sequence of NAT;

theorem 
  (for n holds a.n = 2*n + 1) implies a is increasing sequence of NAT;

theorem 
  rng c = {x0} implies c is convergent & lim c = x0 & h + c is
  convergent & lim(h + c) = x0;

theorem 
  rng a = {r} & rng b = {r} implies a = b;

theorem 
  a is subsequence of h implies a is 0-convergent non-zero Real_Sequence;

theorem 
  (for h,c st rng c = {g} & rng (h + c) c= dom f & {g} c= dom f
holds h"(#)(f/*(h+c) - f/*c) is convergent) implies for h1,h2,c st rng c = {g}
  & rng (h1 + c) c= dom f & rng (h2 + c) c= dom f & {g} c= dom f holds lim (h1"
  (#)(f/*(h1+c) - f/*c)) = lim(h2"(#)(f/*(h2+c) - f/*c));

theorem 
  (ex N be Neighbourhood of r st N c= dom f) implies ex h,c st rng
  c = {r} & rng (h+c) c= dom f & {r} c= dom f;

theorem 
  rng a c= dom (f2*f1) implies rng a c= dom f1 & rng (f1/*a) c= dom f2;

scheme 

  ExIncSeqofNat{ s()->Real_Sequence,P[set] }: ex q being increasing sequence
of NAT st (for n holds P[(s()*q).n]) & for n st (for r st r = s().n holds P[r])
  ex m st n = q.m
provided
 for n ex m st n <= m & P[s().m];

theorem 
  f.x0 <> r & f is_differentiable_in x0 implies ex N be Neighbourhood of
  x0 st N c= dom f & for g st g in N holds f.g <> r;

theorem 
  f is_differentiable_in x0 iff (ex N be Neighbourhood of x0 st N
c= dom f) & for h,c st rng c = {x0} & rng (h + c) c= dom f holds h"(#)(f/*(h+c)
  - f/*c) is convergent;

theorem 
  f is_differentiable_in x0 & diff(f,x0) = g iff
  (ex N be Neighbourhood of x0 st N c= dom f) &
  for h,c st rng c = {x0} & rng (h + c) c= dom f holds
  h"(#)(f/*(h+c) - f/*c) is convergent &
  lim (h"(#)(f/*(h+c) - f/*c)) = g;

theorem 
  f1 is_differentiable_in x0 & f2 is_differentiable_in f1.x0
implies f2*f1 is_differentiable_in x0 & diff(f2*f1,x0) = diff(f2,f1.x0)*diff(f1
  ,x0);

theorem 
  f2.x0 <> 0 & f1 is_differentiable_in x0 & f2
is_differentiable_in x0 implies f1/f2 is_differentiable_in x0 & diff(f1/f2,x0)
  = (diff(f1,x0) * f2.x0 - diff(f2,x0) * f1.x0)/(f2.x0)^2;

theorem 
  f.x0 <> 0 & f is_differentiable_in x0 implies f^
  is_differentiable_in x0 & diff(f^,x0) = - diff(f,x0)/(f.x0)^2;

theorem 
  f is_differentiable_on A implies f|A is_differentiable_on A & f`|A = (
  f|A) `| A;

theorem 
  f1 is_differentiable_on A & f2 is_differentiable_on A implies f1 + f2
  is_differentiable_on A & (f1 + f2)`|A = f1`|A + f2`|A;

theorem 
  f1 is_differentiable_on A & f2 is_differentiable_on A implies f1 - f2
  is_differentiable_on A & (f1 - f2)`|A = f1`|A - f2`|A;

theorem 
  f is_differentiable_on A implies r(#)f is_differentiable_on A & (r(#)f
  )`|A = r(#)(f`|A);

theorem 
  f1 is_differentiable_on A & f2 is_differentiable_on A implies f1 (#)
  f2 is_differentiable_on A & (f1(#)f2)`|A = (f1`|A)(#)f2 + f1(#)(f2`|A);

theorem 
  f1 is_differentiable_on A & f2 is_differentiable_on A & (for x0 st x0
in A holds f2.x0 <> 0) implies f1/f2 is_differentiable_on A & (f1/f2)`|A = (f1
  `|A (#) f2 - f2`|A (#) f1)/(f2 (#) f2);

theorem 
  f is_differentiable_on A & (for x0 st x0 in A holds f.x0 <> 0) implies
  f^ is_differentiable_on A & (f^)`|A = - (f`|A)/ (f (#) f);

theorem 
  f1 is_differentiable_on A & (f1.:A) is open Subset of REAL & f2
is_differentiable_on (f1.:A) implies f2*f1 is_differentiable_on A & (f2*f1)`|A
  = ((f2`|(f1.:A))*f1) (#) (f1`|A);

theorem 
  A c= dom f & (for r,p st r in A & p in A holds abs(f.r - f.p) <=
(r - p)^2) implies f is_differentiable_on A & for x0 st x0 in A holds diff(f,x0
  ) = 0;

theorem 
  (for r1,r2 st r1 in ].p,g.[ & r2 in ].p,g.[ holds abs(f.r1 - f.
r2) <= (r1 - r2)^2) & ].p,g.[ c= dom f implies f is_differentiable_on ].p,g.[ &
  f|].p,g.[ is constant;

theorem 
  left_open_halfline(r) c= dom f & (for r1,r2 st r1 in
left_open_halfline(r) & r2 in left_open_halfline(r) holds abs(f.r1 - f.r2) <= (
  r1 - r2)^2) implies f is_differentiable_on left_open_halfline(r) & f|
  left_open_halfline r is constant;

theorem 
  right_open_halfline(r) c= dom f & (for r1,r2 st r1 in
right_open_halfline(r) & r2 in right_open_halfline(r) holds abs(f.r1 - f.r2) <=
  (r1 - r2)^2) implies f is_differentiable_on right_open_halfline(r) & f|
  right_open_halfline r is constant;

theorem 
  f is total & (for r1,r2 holds abs(f.r1 - f.r2) <= (r1 - r2)^2) implies
  f is_differentiable_on [#](REAL) & f|[#]REAL is constant;

theorem 
  left_open_halfline(r) c= dom f & f is_differentiable_on
left_open_halfline(r) & (for x0 st x0 in left_open_halfline(r) holds 0 < diff(f
,x0)) implies f|left_open_halfline r is increasing & f|left_open_halfline(r) is
  one-to-one;

theorem 
  left_open_halfline(r) c= dom f & f is_differentiable_on
left_open_halfline(r) & (for x0 st x0 in left_open_halfline(r) holds diff(f,x0)
< 0) implies f|left_open_halfline r is decreasing & f|left_open_halfline(r) is
  one-to-one;

theorem 
  left_open_halfline(r) c= dom f & f is_differentiable_on
left_open_halfline(r) & (for x0 st x0 in left_open_halfline(r) holds 0 <= diff(
  f,x0)) implies f|left_open_halfline r is non-decreasing;

theorem 
  left_open_halfline(r) c= dom f & f is_differentiable_on
left_open_halfline(r) & (for x0 st x0 in left_open_halfline(r) holds diff(f,x0)
  <= 0) implies f|left_open_halfline r is non-increasing;

theorem 
  right_open_halfline(r) c= dom f & f is_differentiable_on
right_open_halfline(r) & (for x0 st x0 in right_open_halfline(r) holds 0 < diff
(f,x0)) implies f|right_open_halfline r is increasing & f|right_open_halfline(r
  ) is one-to-one;

theorem 
  right_open_halfline(r) c= dom f & f is_differentiable_on
right_open_halfline(r) & (for x0 st x0 in right_open_halfline(r) holds diff(f,
x0) < 0) implies f|right_open_halfline r is decreasing & f|right_open_halfline(
  r) is one-to-one;

theorem 
  right_open_halfline(r) c= dom f & f is_differentiable_on
  right_open_halfline(r) & (for x0 st x0 in right_open_halfline(r) holds 0 <=
  diff(f,x0)) implies f|right_open_halfline r is non-decreasing;

theorem 
  right_open_halfline(r) c= dom f & f is_differentiable_on
right_open_halfline(r) & (for x0 st x0 in right_open_halfline(r) holds diff(f,
  x0) <= 0) implies f|right_open_halfline r is non-increasing;

theorem 
  [#](REAL) c= dom f & f is_differentiable_on [#](REAL) & (for x0
  holds 0 < diff(f,x0)) implies f|[#]REAL is increasing & f is one-to-one;

theorem 
  [#](REAL) c= dom f & f is_differentiable_on [#](REAL) & (for x0
  holds diff(f,x0) < 0) implies f|[#]REAL is decreasing & f is one-to-one;

theorem 
  [#](REAL) c= dom f & f is_differentiable_on [#](REAL) & (for x0 holds
  0 <= diff(f,x0)) implies f|[#]REAL is non-decreasing;

theorem 
  [#](REAL) c= dom f & f is_differentiable_on [#](REAL) & (for x0 holds
  diff(f,x0) <= 0) implies f|[#]REAL is non-increasing;

theorem 
  ].p,g.[ c= dom f & f is_differentiable_on ].p,g.[ & ((for x0 st
x0 in ].p,g.[ holds 0 < diff(f,x0)) or for x0 st x0 in ].p,g.[ holds diff(f,x0)
  < 0) implies rng (f|].p,g.[) is open;

theorem 
  left_open_halfline(p) c= dom f & f is_differentiable_on
left_open_halfline(p) & ((for x0 st x0 in left_open_halfline(p) holds 0 < diff(
  f,x0)) or for x0 st x0 in left_open_halfline(p) holds diff(f,x0) < 0) implies
  rng (f|left_open_halfline(p)) is open;

theorem 
  right_open_halfline(p) c= dom f& f is_differentiable_on
  right_open_halfline(p) & ((for x0 st x0 in right_open_halfline(p) holds 0 <
  diff(f,x0)) or for x0 st x0 in right_open_halfline(p) holds diff(f,x0) < 0)
  implies rng (f|right_open_halfline(p)) is open;

theorem 
  [#](REAL) c= dom f & f is_differentiable_on [#](REAL) & ((for x0
  holds 0 < diff(f,x0)) or for x0 holds diff(f,x0) < 0) implies rng f is open;

theorem 
  for f be one-to-one PartFunc of REAL,REAL st [#]REAL c= dom f & f
  is_differentiable_on [#](REAL ) & ((for x0 holds 0 < diff(f,x0)) or for x0
holds diff(f,x0) < 0) holds f is one-to-one & f" is_differentiable_on dom (f")
  & for x0 st x0 in dom (f") holds diff(f",x0) = 1/diff(f,(f").x0);

theorem 
  for f be one-to-one PartFunc of REAL,REAL st left_open_halfline(p) c=
  dom f & f is_differentiable_on left_open_halfline(p) & ((for x0 st x0 in
  left_open_halfline(p) holds 0 < diff(f,x0)) or for x0 st x0 in
  left_open_halfline(p) holds diff(f,x0) < 0) holds f|left_open_halfline(p) is
  one-to-one & (f|left_open_halfline(p))" is_differentiable_on dom ((f|
  left_open_halfline(p))") & for x0 st x0 in dom ((f|left_open_halfline(p))")
holds diff((f|left_open_halfline(p))",x0) = 1/diff(f,((f|left_open_halfline(p))
  ").x0);

theorem 
  for f be one-to-one PartFunc of REAL,REAL st right_open_halfline(p) c=
  dom f & f is_differentiable_on right_open_halfline(p) & ((for x0 st x0 in
  right_open_halfline(p) holds 0 < diff(f,x0)) or for x0 st x0 in
right_open_halfline(p) holds diff(f,x0) < 0) holds f|right_open_halfline(p) is
  one-to-one & (f|right_open_halfline(p))" is_differentiable_on dom ((f|
  right_open_halfline(p))") & for x0 st x0 in dom ((f|right_open_halfline(p))")
holds diff((f|right_open_halfline(p))",x0) = 1/diff(f,((f|right_open_halfline(p
  ))").x0);

theorem 
  for f be one-to-one PartFunc of REAL,REAL st ].p,g.[ c= dom f & f
is_differentiable_on ].p,g.[ & ((for x0 st x0 in ].p,g.[ holds 0 < diff(f,x0))
or for x0 st x0 in ].p,g.[ holds diff(f,x0) < 0) holds f|].p,g.[ is one-to-one
& (f|].p,g.[)" is_differentiable_on dom ((f|].p,g.[)") & for x0 st x0 in dom ((
  f|].p,g.[)") holds diff((f|].p,g.[)",x0) = 1/diff(f,((f|].p,g.[)").x0);

theorem 
  f is_differentiable_in x0 implies for h,c st rng c = {x0} & rng (h + c
  ) c= dom f & rng (-h + c) c= dom f holds (2(#)h)"(#)(f/*(c+h) - f/*(c-h)) is
  convergent & lim((2(#)h)"(#)(f/*(c+h) - f/*(c-h))) = diff(f,x0);














begin

reserve h,h1,h2 for 0-convergent non-zero Real_Sequence,
  c,c1 for constant Real_Sequence,
  f,f1,f2 for PartFunc of REAL,REAL,
  x0,r,r0,r1,r2,g,g1,g2 for Real,
  n0,k,n,m for Element of NAT,
  a,b,d for Real_Sequence,
  x for set;

theorem 
  (ex r st r>0 & [.x0-r,x0.] c= dom f) implies ex h,c st rng c ={x0
  } & rng (h+c) c= dom f & for n holds h.n < 0;

theorem 
  (ex r st r>0 & [.x0,x0+r.] c= dom f) implies ex h,c st rng c ={x0
  } & rng (h+c) c= dom f & for n holds h.n > 0;

theorem 
  (for h,c st rng c ={x0} & rng (h+c) c= dom f & (for n holds h.n <
0) holds h"(#)(f/*(h+c) - f/*c) is convergent) & {x0} c= dom f implies for h1,
h2,c st rng c ={x0} & rng (h1+c) c= dom f & (for n holds h1.n < 0) & rng (h2+c)
c= dom f & (for n holds h2.n < 0) holds lim (h1"(#)(f/*(h1+c) - f/*c)) = lim (
  h2"(#)(f/*(h2+c) - f/*c));

theorem 
  (for h,c st rng c ={x0} & rng (h+c) c= dom f & (for n holds h.n>0
) holds h"(#)(f/*(h+c) - f/*c) is convergent) & {x0} c= dom f implies for h1,h2
,c st rng c ={x0} & rng (h1 + c)c= dom f & rng (h2 + c) c= dom f & (for n holds
h1.n >0) & (for n holds h2.n >0) holds lim (h1"(#)(f/*(h1+c) - f/*c)) = lim (h2
  "(#)(f/*(h2+c) - f/*c));

definition
  let f,x0;
  pred f is_Lcontinuous_in x0 means


  x0 in dom f & for a st rng a c=
  left_open_halfline(x0) /\ dom f & a is convergent & lim a = x0 holds f/*a is
  convergent & f.x0 = lim(f/*a);
  pred f is_Rcontinuous_in x0 means


  x0 in dom f & for a st rng a c=
  right_open_halfline(x0) /\ dom f & a is convergent & lim a = x0 holds f/*a is
  convergent & f.x0 = lim(f/*a);
  pred f is_right_differentiable_in x0 means


  (ex r st r>0 & [.x0, x0+r
.] c= dom f) & for h,c st rng c ={x0} & rng (h+c) c= dom f & (for n holds h.n >
  0) holds h"(#)(f/*(h+c) - f/*c) is convergent;
  pred f is_left_differentiable_in x0 means


  (ex r st r>0 & [.x0-r,x0.]
  c= dom f) & for h,c st rng c ={x0} & rng (h+c) c= dom f & (for n holds h.n<0)
  holds h"(#)(f/*(h+c) - f/*c) is convergent;
end;

theorem 
  f is_left_differentiable_in x0 implies f is_Lcontinuous_in x0;

theorem 
  f is_Lcontinuous_in x0 & f.x0<>g2 & (ex r st r>0 & [.x0-r,x0.] c=
dom f) implies ex r1 st r1 > 0 & [.x0-r1,x0.] c= dom f & for g st g in [.x0-r1,
  x0.] holds f.g <> g2;

theorem 
  f is_right_differentiable_in x0 implies f is_Rcontinuous_in x0;

theorem 
  f is_Rcontinuous_in x0 & f.x0 <> g2 & (ex r st r>0 & [.x0, x0+r.]
c= dom f) implies ex r1 st r1>0 & [.x0, x0+r1.] c= dom f & for g st g in [.x0,
  x0+r1.] holds f.g <> g2;

definition
  let x0,f;
  assume
 f is_left_differentiable_in x0;
  func Ldiff (f,x0) -> Real means


  for h,c st rng c = {x0} & rng (h + c
  ) c= dom f & (for n holds h.n <0) holds it =lim (h"(#)(f/*(h+c) - f/*c));
end;

definition
  let x0,f;
  assume
 f is_right_differentiable_in x0;
  func Rdiff(f,x0) -> Real means


  for h,c st rng c = {x0} & rng (h+c) c=
  dom f & (for n holds h.n > 0) holds it=lim (h"(#)(f/*(h+c) - f/*c));
end;

theorem 
  f is_left_differentiable_in x0 & Ldiff(f,x0) = g iff (ex r st 0 <
  r & [.x0 -r,x0.] c= dom f) & for h,c st rng c = {x0} & rng (h+c) c= dom f & (
for n holds h.n < 0) holds h"(#)(f/*(h+c) - f/*c) is convergent & lim(h"(#)(f/*
  (h+c) - f/*c)) = g;

theorem 
  f1 is_left_differentiable_in x0 & f2 is_left_differentiable_in x0
implies f1 + f2 is_left_differentiable_in x0 & Ldiff(f1+f2,x0) = Ldiff(f1,x0) +
  Ldiff(f2,x0);

theorem 
  f1 is_left_differentiable_in x0 & f2 is_left_differentiable_in x0
implies f1 - f2 is_left_differentiable_in x0 & Ldiff(f1-f2,x0) = Ldiff(f1,x0) -
  Ldiff(f2,x0);

theorem 
  f1 is_left_differentiable_in x0 & f2 is_left_differentiable_in x0
implies f1(#)f2 is_left_differentiable_in x0 & Ldiff(f1(#)f2,x0) = Ldiff(f1,x0)
  *f2.x0 + Ldiff(f2,x0)*f1.x0;

theorem 
  f1 is_left_differentiable_in x0 & f2 is_left_differentiable_in x0 & f2
.x0 <> 0 implies f1/f2 is_left_differentiable_in x0 & Ldiff(f1/f2,x0) = (Ldiff(
  f1,x0)*f2.x0 - Ldiff(f2,x0)*f1.x0)/(f2.x0)^2;

theorem 
  f is_left_differentiable_in x0 & f.x0 <> 0 implies f^
  is_left_differentiable_in x0 & Ldiff(f^,x0) = - Ldiff(f,x0)/(f.x0)^2;

theorem 
  f is_right_differentiable_in x0 & Rdiff(f,x0) = g1 iff (ex r st
r>0 & [.x0,x0+r.] c= dom f) & for h,c st rng c = {x0} & rng (h+c) c= dom f & (
for n holds h.n > 0) holds h"(#)(f/*(h+c) - f/*c) is convergent & lim (h"(#)(f
  /*(h+c) - f/*c)) = g1;

theorem 
  f1 is_right_differentiable_in x0 & f2 is_right_differentiable_in x0
  implies f1+f2 is_right_differentiable_in x0 & Rdiff(f1+f2,x0) = Rdiff(f1,x0)+
  Rdiff(f2,x0);

theorem 
  f1 is_right_differentiable_in x0 & f2 is_right_differentiable_in x0
implies f1 - f2 is_right_differentiable_in x0 & Rdiff(f1-f2,x0) = Rdiff(f1,x0)
  - Rdiff(f2,x0);

theorem 
  f1 is_right_differentiable_in x0 & f2 is_right_differentiable_in x0
implies f1(#)f2 is_right_differentiable_in x0 & Rdiff(f1(#)f2,x0) = Rdiff(f1,x0
  )*f2.x0 + Rdiff(f2,x0)*f1.x0;

theorem 
  f1 is_right_differentiable_in x0 & f2 is_right_differentiable_in x0 &
  f2.x0 <> 0 implies f1/f2 is_right_differentiable_in x0 & Rdiff(f1/f2,x0) = (
  Rdiff(f1,x0)*f2.x0 - Rdiff(f2,x0)*f1.x0)/(f2.x0)^2;

theorem 
  f is_right_differentiable_in x0 & f.x0 <> 0 implies f^
  is_right_differentiable_in x0 & Rdiff(f^,x0) = - Rdiff(f,x0)/(f.x0)^2;

theorem 
  f is_right_differentiable_in x0 & f is_left_differentiable_in x0 &
Rdiff(f,x0) = Ldiff(f,x0) implies f is_differentiable_in x0 & diff(f,x0)=Rdiff(
  f,x0) & diff(f,x0)=Ldiff(f,x0);

theorem 
  f is_differentiable_in x0 implies f is_right_differentiable_in x0 & f
is_left_differentiable_in x0 & diff(f,x0) = Rdiff(f,x0) & diff(f,x0) = Ldiff(f,
  x0);














begin 

reserve X for set;

theorem 
  for X,Y being set holds union {X,Y,{}} = union {X,Y};

theorem 
  for A,B being Subset of X holds {A,B} is Subset-Family of X;

theorem 
  for A,B,C being Subset of X holds {A,B,C} is Subset-Family of X;

scheme 

  DomsetFamEx {A() -> set,P[set]}: ex F being non empty Subset-Family of A()
  st for B being set holds B in F iff B c= A() & P[B]
provided
 ex B being set st B c= A() & P[B];

notation
  let X be set;
  let S be non empty Subset-Family of X;
  synonym X\S for COMPLEMENT S;
end;

registration
  let X be set;
  let S be non empty Subset-Family of X;
  cluster X\S -> non empty;
end;

theorem 
  for S being non empty Subset-Family of X holds meet S = X \
  union (X \ S) & union S = X \ meet (X \ S);





definition
  let X be set;
  let IT be Subset-Family of X;

  redefine attr IT is compl-closed means


  for A being set holds A in IT implies X\A in IT;
end;

registration
  let X be set;
  cluster cup-closed compl-closed -> cap-closed for Subset-Family of X;
  cluster cap-closed compl-closed -> cup-closed for Subset-Family of X;
end;

theorem 
  for S being Field_Subset of X holds S = X \ S;

registration let X;
 cluster compl-closed cap-closed -> diff-closed for Subset-Family of X;
end;

theorem 
  for S being Field_Subset of X holds for A,B being set st A in S
  & B in S holds A \ B in S;

theorem 
  for S being Field_Subset of X holds {} in S & X in S;

definition
  let X be non empty set, F be Function of X,ExtREAL;
  redefine attr F is nonnegative means


  for A being Element of X holds 0. <= F.A;
end;

definition
  let X be set, S be Field_Subset of X;
  let F be Function of S,ExtREAL;
  attr F is additive means


  for A,B being Element of S st A misses B holds F.(A \/ B) = F.A + F.B;
end;

registration
  let X be set, S be Field_Subset of X;
  cluster nonnegative additive zeroed for Function of S,ExtREAL;
end;

definition
  let X be set, S be Field_Subset of X;
  mode Measure of S is nonnegative additive zeroed Function of S,ExtREAL;
end;

theorem 
  for S being Field_Subset of X, M being Measure of S, A,B being
  Element of S holds A c= B implies M.A <= M.B;

theorem 
  for S being Field_Subset of X, M being Measure of S, A,B being
  Element of S holds A c= B & M.A < +infty implies M.(B \ A) = M.B - M.A;

registration
  let X be set;
  cluster non empty compl-closed cap-closed for Subset-Family of X;
end;

definition
  let X be set, S be non empty cup-closed Subset-Family of X, A,B be Element
  of S;
  redefine func A \/ B -> Element of S;
end;

definition
  let X be set, S be Field_Subset of X, A,B be Element of S;
  redefine func A /\ B -> Element of S;
  redefine func A \ B -> Element of S;
end;

theorem 
  for S being Field_Subset of X, M being Measure of S, A,B being
  Element of S holds M.(A \/ B) <= M.A + M.B;

theorem 
  for S being Field_Subset of X, M being Measure of S holds {} in S & X
in S & for A,B being set st A in S & B in S holds X \ A in S & A \/ B in S & A
  /\ B in S;

definition

  let X be set, S be Field_Subset of X, M be Measure of S;
  mode measure_zero of M -> Element of S means


    M.it = 0.;
end;

theorem 
  for S being Field_Subset of X, M being Measure of S, A being Element
  of S, B being measure_zero of M st A c= B holds A is measure_zero of M;

theorem 
  for S being Field_Subset of X, M being Measure of S, A,B being
measure_zero of M holds A \/ B is measure_zero of M & A /\ B is measure_zero of
  M & A \ B is measure_zero of M;

theorem 
  for S being Field_Subset of X, M being Measure of S, A being Element
of S, B being measure_zero of M holds M.(A \/ B) = M.A & M.(A /\ B) = 0.& M.(A
  \ B) = M.A;





theorem 
  for A being Subset of X ex F being Function of NAT,bool X st rng F = {A};

theorem 
  for A being set ex F being Function of NAT,{A} st
  for n being Element of NAT holds F.n = A;

registration
  let X be set;
  cluster non empty countable for Subset-Family of X;
end;

definition
  let X be set;
  mode N_Sub_set_fam of X is non empty countable Subset-Family of X;
end;

theorem 
  for A,B,C being Subset of X ex F being Function of NAT,bool X st
  rng F = {A,B,C} & F.0 = A & F.1 = B & for n being Element of NAT st 1 < n
  holds F.n = C;

theorem 
  for A,B being Subset of X holds {A,B,{}} is N_Sub_set_fam of X;

theorem 
  for A,B being Subset of X ex F being Function of NAT,bool X st
  rng F = {A,B} & F.0 = A & for n being Element of NAT st 0 < n holds F.n = B;

theorem 
  for A,B being Subset of X holds {A,B} is N_Sub_set_fam of X;

theorem 
  for S being N_Sub_set_fam of X holds X \ S is N_Sub_set_fam of X;

definition
  let X be set;
  let IT be Subset-Family of X;

  attr IT is sigma-additive means


  for M being N_Sub_set_fam of X st M c= IT holds union M in IT;
end;

registration
  let X be set;
  cluster non empty compl-closed sigma-additive for Subset-Family of X;
end;

registration
  let X;
  cluster compl-closed sigma-multiplicative -> sigma-additive for
Subset-Family of
    X;
  cluster compl-closed sigma-additive -> sigma-multiplicative for
Subset-Family of
    X;
end;

registration
  let X be set;
  cluster -> non empty for SigmaField of X;
end;

theorem 
  for S being non empty Subset-Family of X holds (for A being set
  holds A in S implies X\A in S) & (for M being N_Sub_set_fam of X st M c= S
  holds meet M in S) iff S is SigmaField of X;

registration
  let X be set;
  let S be SigmaField of X;
  cluster disjoint_valued for Function of NAT, S;
end;

definition
  let X be set;
  let S be SigmaField of X;
  mode Sep_Sequence of S is disjoint_valued Function of NAT, S;
end;

definition
  let X be set;
  let S be SigmaField of X;
  let F be Function of NAT,S;
  redefine func rng F -> non empty Subset-Family of X;
end;

theorem 
  for S being SigmaField of X, F being Function of NAT,S holds rng
  F is N_Sub_set_fam of X;

theorem 
  for S being SigmaField of X, F being Function of NAT,S holds
  union rng F is Element of S;

theorem 
  for Y,S being non empty set, F being Function of Y,S, M being
  Function of S,ExtREAL st M is nonnegative holds M*F is nonnegative;

theorem 
  for S being SigmaField of X, a,b being R_eal holds ex M being
Function of S,ExtREAL st for A being Element of S holds (A = {} implies M.A = a
  ) & (A <> {} implies M.A = b);

theorem 
  for S being SigmaField of X ex M being Function of S,ExtREAL st for A
  being Element of S holds (A = {} implies M.A = 0.) & (A <> {} implies M.A =
  +infty);

theorem 
  for S being SigmaField of X ex M being Function of S,ExtREAL st
  for A being Element of S holds M.A = 0.;

definition
  let X be set;
  let S be SigmaField of X;
  let F be Function of S,ExtREAL;

  attr F is sigma-additive means


  for s being Sep_Sequence of S holds SUM(F*s) = F.(union rng s);
end;

registration
  let X be set;
  let S be SigmaField of X;
  cluster nonnegative sigma-additive zeroed for Function of S,ExtREAL;
end;

definition
  let X be set;
  let S be SigmaField of X;
  mode sigma_Measure of S is nonnegative sigma-additive zeroed Function of S,
    ExtREAL;
end;

registration
  let X be set;
  cluster sigma-additive compl-closed -> cup-closed for
non empty Subset-Family
    of X;
end;

theorem 
  for S being SigmaField of X, M being sigma_Measure of S holds M
  is Measure of S;

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, A,B being
  Element of S st A misses B holds M.(A \/ B) = M.A + M.B;

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, A,B
  being Element of S st A c= B holds M.A <= M.B;

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, A,B being
  Element of S st A c= B & M.A < +infty holds M.(B \ A) = M.B - M.A;

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, A,B
  being Element of S holds M.(A \/ B) <= M.A + M.B;

theorem 
  for S being SigmaField of X, M being sigma_Measure of S holds {} in S
& X in S & for A,B being set st A in S & B in S holds X \ A in S & A \/ B in S
  & A /\ B in S;

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, T being
N_Sub_set_fam of X st (for A being set st A in T holds A in S) holds union T in
  S & meet T in S;

definition

  let X be set, S be SigmaField of X, M be sigma_Measure of S;
  mode measure_zero of M -> Element of S means


    M.it = 0.;
end;

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, A being
Element of S, B being measure_zero of M st A c= B holds A is measure_zero of M;

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, A,B being
measure_zero of M holds A \/ B is measure_zero of M & A /\ B is measure_zero of
  M & A \ B is measure_zero of M;

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, A being
  Element of S, B being measure_zero of M holds M.(A \/ B) = M.A & M.(A /\ B) =
  0.& M.(A \ B) = M.A;














begin





reserve X for set;

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, F being
  Function of NAT,S holds M*F is nonnegative;

definition
  let X be set;
  let S be SigmaField of X;
  mode N_Measure_fam of S -> N_Sub_set_fam of X means


    it c= S;
end;

theorem 
  for S being SigmaField of X, T being N_Measure_fam of S holds
  meet T in S & union T in S;

definition
  let X be set, S be SigmaField of X, T be N_Measure_fam of S;
  redefine func meet T -> Element of S;
  redefine func union T -> Element of S;
end;

theorem 
  for S being SigmaField of X, N being Function of NAT,S holds ex F
being Function of NAT,S st F.0 = N.0 & for n being Element of NAT holds F.(n+1)
  = N.(n+1) \ N.n;

theorem 
  for S being SigmaField of X, N being Function of NAT,S holds ex F
being Function of NAT,S st F.0 = N.0 & for n being Element of NAT holds F.(n+1)
  = N.(n+1) \/ F.n;

theorem 
  for S being non empty Subset-Family of X, N,F being Function of
NAT,S holds F.0 = N.0 & (for n being Element of NAT holds F.(n+1) = N.(n+1) \/
F.n) implies for r being set for n being Element of NAT holds (r in F.n iff ex
  k being Element of NAT st k <= n & r in N.k);

theorem 
  for S being non empty Subset-Family of X, N,F being Function of
NAT,S holds (F.0 = N.0 & (for n being Element of NAT holds F.(n+1) = N.(n+1) \/
  F.n) implies for n,m being Element of NAT st n < m holds F.n c= F.m);

theorem 
  for S being non empty Subset-Family of X, N, G, F being Function
of NAT,S holds G.0 = N.0 & (for n being Element of NAT holds G.(n+1) = N.(n+1)
\/ G.n) & F.0 = N.0 & (for n being Element of NAT holds F.(n+1) = N.(n+1) \ G.n
  ) implies for n,m being Element of NAT st n <= m holds F.n c= G.m;

theorem 
  for S being SigmaField of X holds for N, G being Function of NAT,
S holds ex F being Function of NAT,S st F.0 = N.0 & for n being Element of NAT
  holds F.(n+1) = N.(n+1) \ G.n;

theorem 
  for S being SigmaField of X holds for N being Function of NAT,S holds
ex F being Function of NAT,S st F.0 = {} & for n being Element of NAT holds F.(
  n+1) = N.0 \ N.n;

theorem 
  for S being SigmaField of X holds for N, G, F being Function of
NAT,S holds G.0 = N.0 & (for n being Element of NAT holds G.(n+1) = N.(n+1) \/
  G.n) & F.0 = N.0 & (for n being Element of NAT holds F.(n+1) = N.(n+1) \ G.n)
  implies for n,m being Element of NAT st n < m holds F.n misses F.m;

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, T being
N_Measure_fam of S, F being Function of NAT,S st T = rng F holds M.(union T) <=
  SUM(M*F);

theorem 
  for S being SigmaField of X, T being N_Measure_fam of S holds ex
  F being Function of NAT,S st T = rng F;

theorem 
  for N, F being Function st (F.0 = {} & for n being Element of
  NAT holds F.(n+1) = N.0 \ N.n & N.(n+1) c= N.n ) holds for n being Element of
  NAT holds F.n c= F.(n+1);

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, T being
N_Measure_fam of S st (for A being set st A in T holds A is measure_zero of M)
  holds union T is measure_zero of M;

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, T being
N_Measure_fam of S st (ex A being set st A in T & A is measure_zero of M) holds
  meet T is measure_zero of M;

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, T being
N_Measure_fam of S st (for A being set st A in T holds A is measure_zero of M)
  holds meet T is measure_zero of M;

definition
  let X be set;
  let S be SigmaField of X;
  let IT be N_Measure_fam of S;
  attr IT is non-decreasing means


  ex F being Function of NAT,S st IT =
  rng F & for n being Element of NAT holds F.n c= F.(n+1);
end;

registration
  let X be set;
  let S be SigmaField of X;
  cluster non-decreasing for N_Measure_fam of S;
end;

definition
  let X be set;
  let S be SigmaField of X;
  let IT be N_Measure_fam of S;
  attr IT is non-increasing means

  ex F being Function of NAT,S st IT = rng F &
  for n being Element of NAT holds F.(n+1) c= F.n;
end;

registration
  let X be set;
  let S be SigmaField of X;
  cluster non-increasing for N_Measure_fam of S;
end;

theorem 
  for S being SigmaField of X, N,F being Function of NAT,S holds (F.0 =
  {} & for n being Element of NAT holds F.(n+1) = N.0 \ N.n & N.(n+1) c= N.n )
  implies rng F is non-decreasing N_Measure_fam of S;

theorem 
  for N being Function st (for n being Element of NAT holds N.n c=
  N.(n+1)) holds for m,n being Element of NAT st n <= m holds N.n c= N.m;

theorem 
  for N,F being Function st (F.0 = N.0 & for n being Element of
NAT holds F.(n+1) = N.(n+1) \ N.n & N.n c= N.(n+1)) holds for n,m being Element
  of NAT st n < m holds F.n misses F.m;

theorem 
  for S being SigmaField of X, N,F being Function of NAT,S holds (
F.0 = N.0 & for n being Element of NAT holds F.(n+1) = N.(n+1) \ N.n & N.n c= N
  .(n+1) ) implies union rng F = union rng N;

theorem 
  for S being SigmaField of X, N,F being Function of NAT,S holds (
F.0 = N.0 & for n being Element of NAT holds F.(n+1) = N.(n+1) \ N.n & N.n c= N
  .(n+1) ) implies F is Sep_Sequence of S;

theorem 
  for S being SigmaField of X, N,F being Function of NAT,S holds (F.0 =
N.0 & for n being Element of NAT holds F.(n+1) = N.(n+1) \ N.n & N.n c= N.(n+1)
) implies (N.0 = F.0 & for n being Element of NAT holds N.(n+1) = F.(n+1) \/ N.
  n);

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, F being
Function of NAT,S st (for n being Element of NAT holds F.n c= F.(n+1)) holds M.
  (union rng F) = sup(rng (M*F));














begin





reserve X for set;

theorem 
  for F1,F2 being Function of NAT,ExtREAL st (for n being Element
  of NAT holds Ser(F1).n <= Ser(F2).n) holds SUM(F1) <= SUM(F2);

theorem 
  for F1,F2 being Function of NAT,ExtREAL st (for n being Element of NAT
  holds Ser(F1).n = Ser(F2).n) holds SUM(F1) = SUM(F2);





notation
  let X be set;
  let S be SigmaField of X;
  synonym N_Sub_fam of S for N_Measure_fam of S;
end;

definition
  let X be set;
  let S be SigmaField of X;
  let F be Function of NAT,S;
  redefine func rng F -> N_Measure_fam of S;
end;

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, F being
  Function of NAT,S, A being Element of S st meet rng F c= A & (for n being
  Element of NAT holds A c= F.n) holds M.A = M.(meet rng F);

theorem 
  for S being SigmaField of X, G,F being Function of NAT,S st (G.0
= {} & for n being Element of NAT holds G.(n+1) = F.0 \ F.n & F.(n+1) c= F.n )
  holds union rng G = F.0 \ meet rng F;

theorem 
  for S being SigmaField of X, G,F being Function of NAT,S st (G.0
= {} & for n being Element of NAT holds G.(n+1) = F.0 \ F.n & F.(n+1) c= F.n )
  holds meet rng F = F.0 \ union rng G;

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, G,F
being Function of NAT,S st (M.(F.0) <+infty & G.0 = {} & for n being Element of
NAT holds G.(n+1) = F.0 \ F.n & F.(n+1) c= F.n ) holds M.(meet rng F) = M.(F.0)
  - M.(union rng G);

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, G,F
being Function of NAT,S st (M.(F.0) <+infty & G.0 = {} & for n being Element of
NAT holds G.(n+1) = F.0 \ F.n & F.(n+1) c= F.n ) holds M.(union rng G) = M.(F.0
  ) - M.(meet rng F);

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, G,F being
  Function of NAT,S st (M.(F.0) <+infty & G.0 = {} & for n being Element of NAT
  holds G.(n+1) = F.0 \ F.n & F.(n+1) c= F.n ) holds M.(meet rng F) = M.(F.0) -
  sup(rng (M*G));

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, G,F
being Function of NAT,S st (M.(F.0) <+infty & G.0 = {} & for n being Element of
  NAT holds G.(n+1) = F.0 \ F.n & F.(n+1) c= F.n ) holds M.(F.0) is Real & inf(
  rng (M*F)) is Real & sup(rng (M*G)) is Real;

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, G,F
being Function of NAT,S st (M.(F.0) <+infty & G.0 = {} & for n being Element of
NAT holds G.(n+1) = F.0 \ F.n & F.(n+1) c= F.n ) holds sup rng (M*G) = M.(F.0)
  - inf rng (M*F);

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, G,F
being Function of NAT,S st (M.(F.0) <+infty & G.0 = {} & for n being Element of
NAT holds G.(n+1) = F.0 \ F.n & F.(n+1) c= F.n ) holds inf(rng (M*F)) = M.(F.0)
  - sup(rng (M*G));

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, F being
Function of NAT,S st (for n being Element of NAT holds F.(n+1) c= F.n) & M.(F.0
  ) <+infty holds M.(meet rng F) = inf(rng (M*F));

theorem 
  for S being SigmaField of X, M being Measure of S, F being
  Sep_Sequence of S holds SUM(M*F) <= M.(union rng F);

theorem 
  for S being SigmaField of X, M being Measure of S st (for F being
  Sep_Sequence of S holds M.(union rng F) <= SUM(M*F)) holds M is sigma_Measure
  of S;





definition
  let X be set;
  let S be SigmaField of X;
  let M be sigma_Measure of S;

  pred M is_complete S means


  for A being Subset of X, B being set st B
  in S & A c= B & M.B = 0. holds A in S;
end;

definition
  let X be set;
  let S be SigmaField of X;
  let M be sigma_Measure of S;
  mode thin of M -> Subset of X means


    ex B being set st B in S & it c= B & M.B = 0.;
end;

definition
  let X be set;
  let S be SigmaField of X;
  let M be sigma_Measure of S;
  func COM(S,M) -> non empty Subset-Family of X means


  for A being set
holds (A in it iff ex B being set st B in S & ex C being thin of M st A = B \/
  C );
end;

definition
  let X be set;
  let S be SigmaField of X;
  let M be sigma_Measure of S;
  let A be Element of COM(S,M);
  func MeasPart(A) -> non empty Subset-Family of X means


  for B being set holds (B in it iff B in S & B c= A & A \ B is thin of M );
end;

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, F being
  Function of NAT,COM(S,M) holds ex G being Function of NAT,S st for n being
  Element of NAT holds G.n in MeasPart(F.n);

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, F being
Function of NAT,COM(S,M), G being Function of NAT,S ex H being Function of NAT,
  bool X st for n being Element of NAT holds H.n = F.n \ G.n;

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, F being
  Function of NAT,bool X st (for n being Element of NAT holds F.n is thin of M)
holds ex G being Function of NAT,S st for n being Element of NAT holds F.n c= G
  .n & M.(G.n) = 0.;

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, D being
  non empty Subset-Family of X st (for A being set holds (A in D iff ex B being
set st B in S & ex C being thin of M st A = B \/ C)) holds D is SigmaField of X
;

registration
  let X be set;
  let S be SigmaField of X;
  let M be sigma_Measure of S;
  cluster COM(S,M) -> sigma-additive compl-closed non empty;
end;

theorem 
  for S being SigmaField of X, M being sigma_Measure of S, B1,B2
being set st B1 in S & B2 in S holds for C1,C2 being thin of M holds B1 \/ C1 =
  B2 \/ C2 implies M.B1 = M.B2;

definition
  let X be set;
  let S be SigmaField of X;
  let M be sigma_Measure of S;
  func COM(M) -> sigma_Measure of COM(S,M) means


  for B being set st B in S for C being thin of M holds it.(B \/ C) = M.B;
end;

theorem 
  for S being SigmaField of X, M being sigma_Measure of S holds COM(M)
  is_complete COM(S,M);














begin 

reserve
  A,B,X for set,
  S for SigmaField of X;

theorem 
  for S being non empty Subset-Family of X, F, G being Function of
NAT,S, A being Element of S st for n being Element of NAT holds G.n = A /\ F.n
  holds union rng G = A /\ union rng F;

theorem 
  for S being non empty Subset-Family of X for F, G being Function
of NAT,S st (G.0 = F.0 & for n being Element of NAT holds G.(n+1) = F.(n+1) \/
G.n) holds for H being Function of NAT,S st (H.0 = F.0 & for n being Element of
  NAT holds H.(n+1) = F.(n+1) \ G.n) holds union rng F = union rng H;

theorem 
  bool X is SigmaField of X;

definition
  let X be set;

  mode C_Measure of X -> Function of bool X,ExtREAL means


    it is
nonnegative zeroed & for A,B being Subset of X st A c= B holds it.A <= it.B &
    for F being Function of NAT,bool X holds it.(union rng F) <= SUM(it*F);
end;

reserve C for C_Measure of X;

definition
  let X be set;
  let C be C_Measure of X;
  func sigma_Field(C) -> non empty Subset-Family of X means


  for A being
Subset of X holds (A in it iff for W,Z being Subset of X holds (W c= A & Z c= X
  \ A implies C.W + C.Z <= C.(W \/ Z)));
end;

theorem 
  for W,Z being Subset of X holds C.(W \/ Z) <= C.W + C.Z;

theorem 
  for A being Subset of X holds (A in sigma_Field(C) iff for W,Z
  being Subset of X holds (W c= A & Z c= X \ A implies C.W + C.Z = C.(W \/ Z)))
;

theorem 
  for W,Z being Subset of X holds W in sigma_Field(C) & Z misses W
  implies C.(W \/ Z) = C.W + C.Z;

theorem 
  A in sigma_Field(C) implies X \ A in sigma_Field(C);

theorem 
  A in sigma_Field(C) & B in sigma_Field(C) implies A \/ B in sigma_Field(C);

theorem 
  A in sigma_Field(C) & B in sigma_Field(C) implies A /\ B in sigma_Field(C);

theorem 
  A in sigma_Field(C) & B in sigma_Field(C) implies A \ B in sigma_Field(C);

theorem 
  for N being Function of NAT,S holds for A being Element of S
holds ex F being Function of NAT,S st for n being Element of NAT holds F.n = A
  /\ N.n;

theorem 
  sigma_Field(C) is SigmaField of X;

registration
  let X be set;
  let C be C_Measure of X;
  cluster sigma_Field(C) -> sigma-additive compl-closed non empty;
end;

definition
  let X be set;
  let S be SigmaField of X;
  let A be N_Sub_fam of S;
  redefine func union A -> Element of S;
end;

definition
  let X be set;
  let C be C_Measure of X;
  func sigma_Meas(C) -> Function of sigma_Field(C),ExtREAL means


  for A being Subset of X st A in sigma_Field(C) holds it.A = C.A;
end;

theorem 
  sigma_Meas(C) is Measure of sigma_Field(C);


theorem 
  sigma_Meas(C) is sigma_Measure of sigma_Field(C);

registration
  let X be set;
  let C be C_Measure of X;
  cluster sigma_Meas(C) -> nonnegative sigma-additive zeroed;
end;

theorem 
  for A being Subset of X holds C.A = 0. implies A in sigma_Field(C);

theorem 
  sigma_Meas(C) is_complete sigma_Field(C);














begin 

reserve n,m for Element of NAT,
  r,s for Real,
  x,y for set;

definition
  let r be real number;
  func max+ (r) -> Real equals

  max(r,0);
  func max- (r) -> Real equals

  max(-r,0);
end;

theorem 
  for r be real number holds r = max+(r) - max-(r);

theorem 
  for r be real number holds abs(r) = max+(r) + max-(r);

theorem 
  for r be real number holds 2*max+(r) = r + abs(r);

theorem 
  for r,s be real number st 0<=r holds max+(r*s) = r*(max+ s);

theorem 
  for r,s be real number holds max+(r+s) <= max+(r) + max+(s);

begin





theorem 
  for D be non empty set, F be PartFunc of D,REAL, r,s be real
  number st r <> 0 holds F"{s/r} = (r(#)F)"{s};

theorem 
  for D be non empty set, F be PartFunc of D,REAL holds (0(#)F)"{0} = dom F;

theorem 
  for D be non empty set, F be PartFunc of D,REAL, r be Real st 0<
  r holds abs(F)"{r} = F"{-r,r};

theorem 
  for D be non empty set, F be PartFunc of D,REAL holds abs(F)"{0} = F"{0};

theorem 
  for D be non empty set, F be PartFunc of D,REAL, r be Real st r<
  0 holds abs(F)"{r} = {};

theorem 
  for D,C be non empty set, F be PartFunc of D,REAL, G be PartFunc
of C,REAL, r be Real st r <> 0 holds F,G are_fiberwise_equipotent iff r(#)F, r
  (#)G are_fiberwise_equipotent;

theorem 
  for D,C be non empty set, F be PartFunc of D,REAL, G be PartFunc of C,
  REAL holds F,G are_fiberwise_equipotent iff -F, -G are_fiberwise_equipotent;

theorem 
  for D,C be non empty set, F be PartFunc of D,REAL, G be PartFunc of C,
  REAL st F,G are_fiberwise_equipotent holds abs(F), abs(G)
  are_fiberwise_equipotent;

definition
  let X,Y be set;
  mode PartFunc-set of X,Y means


    for x being Element of it holds x is PartFunc of X,Y;
end;

registration
  let X,Y be set;
  cluster non empty for PartFunc-set of X,Y;
end;

definition
  let X,Y be set;
  mode PFUNC_DOMAIN of X,Y is non empty PartFunc-set of X,Y;
end;

definition
  let X,Y be set;
  redefine func PFuncs(X,Y) -> PartFunc-set of X,Y;
  let P be non empty PartFunc-set of X,Y;
  redefine mode Element of P -> PartFunc of X,Y;
end;

definition
  let D,C be non empty set, X be Subset of D, c be Element of C;
  redefine func X --> c -> Element of PFuncs(D,C);
end;



registration
  let D be non empty set, E be real-membered set;
  cluster -> real-valued for Element of PFuncs(D,E);
end;

definition
  let D be non empty set, E be real-membered set, F1,F2 be Element of PFuncs(D
  ,E);
  redefine func F1+F2 -> Element of PFuncs(D,REAL);
  redefine func F1-F2 -> Element of PFuncs(D,REAL);
  redefine func F1(#)F2 -> Element of PFuncs(D,REAL);
  redefine func F1/F2 -> Element of PFuncs(D,REAL);
end;

definition
  let D be non empty set, E be real-membered set, F be Element of PFuncs(D,E);
  redefine func abs(F) -> Element of PFuncs(D,REAL);
  redefine func - F -> Element of PFuncs(D,REAL);
  redefine func F^ -> Element of PFuncs(D,REAL);
end;

definition
  let D be non empty set, E be real-membered set, F be Element of PFuncs(D,E),
  r be real number;
  redefine func r(#)F -> Element of PFuncs(D,REAL);
end;

definition
  let D be non empty set;
  func addpfunc(D) -> BinOp of PFuncs(D,REAL) means


  for F1,F2 be Element of PFuncs(D,REAL) holds it.(F1,F2) = F1 + F2;
end;

theorem 
  for D be non empty set holds addpfunc(D) is commutative;

theorem 
  for D be non empty set holds addpfunc(D) is associative;

theorem 
  for D be non empty set holds [#](D) --> (0 qua Real)
  is_a_unity_wrt addpfunc(D);

theorem 
  for D be non empty set holds the_unity_wrt addpfunc(D) = [#](D)
  --> (0 qua Real);

theorem 
  for D be non empty set holds addpfunc(D) is having_a_unity;

definition
  let D be non empty set, f be FinSequence of PFuncs(D,REAL);
  func Sum(f) -> Element of PFuncs(D,REAL) equals

  (addpfunc(D)) $$ f;
end;

theorem 
  for D be non empty set holds Sum(<*> PFuncs(D,REAL) ) = [#](D)
  -->(0 qua Real);

theorem 
  for D be non empty set, f be FinSequence of PFuncs(D,REAL), G be
  Element of PFuncs(D,REAL) holds Sum(f^<*G*>) = Sum f + G;

theorem 
  for D be non empty set, f1,f2 be FinSequence of PFuncs(D,REAL)
  holds Sum(f1^f2) = Sum f1 + Sum f2;

theorem 
  for D be non empty set, f be FinSequence of PFuncs(D,REAL), G be
  Element of PFuncs(D,REAL) holds Sum(<*G*>^f) = G + Sum f;

theorem 
  for D be non empty set, G1,G2 be Element of PFuncs(D,REAL) holds
  Sum<*G1,G2*> = G1 + G2;

theorem 
  for D be non empty set, G1,G2,G3 be Element of PFuncs(D,REAL) holds
  Sum<*G1,G2,G3*> = G1 + G2 + G3;

theorem 
  for D be non empty set, f,g be FinSequence of PFuncs(D,REAL) st f,g
  are_fiberwise_equipotent holds Sum f = Sum g;

definition
  let D be non empty set, f be FinSequence;
  func CHI(f,D) -> FinSequence of PFuncs(D,REAL) means


  len it = len f & for n st n in dom it holds it.n = chi(f.n,D);
end;

definition
  let D be non empty set, f be FinSequence of PFuncs(D,REAL), R be FinSequence
  of REAL;
  func R (#) f -> FinSequence of PFuncs(D,REAL) means


  len it = min(len R,len f) &
  for n st n in dom it for F be PartFunc of D,REAL, r st r = R.n &
  F = f.n holds it.n = r(#)F;
end;

definition
  let D be non empty set, f be FinSequence of PFuncs(D,REAL),
      d be Element of D;
  func f#d -> FinSequence of REAL means


  len it = len f & for n be Element of NAT st n in dom it holds it.n = f.n.d;
end;

definition
  let D,C be non empty set, f be FinSequence of PFuncs(D,C), d be Element of D;
  pred d is_common_for_dom f means


  for n be Element of NAT st n in dom f holds d in dom (f.n);
end;

theorem 
  for D,C be non empty set, f be FinSequence of PFuncs(D,C), d be
  Element of D, n be Element of NAT st d is_common_for_dom f & n <> 0 holds
  d is_common_for_dom f|n;

theorem 
  for D,C be non empty set, f be FinSequence of PFuncs(D,C), d be
  Element of D, n be Element of NAT st d is_common_for_dom f holds d
  is_common_for_dom f /^ n;

theorem 
  for D be non empty set, d be Element of D, f be FinSequence of
  PFuncs(D,REAL) st len f <> 0 holds d is_common_for_dom f iff d in dom Sum(f);

theorem 
  for D be non empty set, f be FinSequence of PFuncs(D,REAL), d be
  Element of D, n be Element of NAT holds (f|n)#d = (f#d)|n;

theorem 
  for D be non empty set, f be FinSequence, d be Element of D
  holds d is_common_for_dom CHI(f,D);

theorem 
  for D be non empty set, d be Element of D, f be FinSequence of
  PFuncs(D,REAL), R be FinSequence of REAL st d is_common_for_dom f holds d
  is_common_for_dom R(#)f;

theorem 
  for D be non empty set, f be FinSequence, R be FinSequence of REAL, d
  be Element of D holds d is_common_for_dom R(#)CHI(f,D);

theorem 
  for D be non empty set, d be Element of D, f be FinSequence of PFuncs(
  D, REAL ) st d is_common_for_dom f holds (Sum(f)).d = Sum (f#d);

definition
  let D be non empty set, F be PartFunc of D,REAL;
  func max+(F) -> PartFunc of D,REAL means


  dom it = dom F & for d be Element of D st d in dom it holds it.d = max+(F.d);
  func max-(F) -> PartFunc of D,REAL means


  dom it = dom F & for d be Element of D st d in dom it holds it.d = max-(F.d);
end;

theorem 
  for D be non empty set, F be PartFunc of D,REAL holds F = max+(F) -
  max-(F) & abs(F) = max+(F) + max-(F) & 2 (#) max+(F) = F + abs(F);

theorem 
  for D be non empty set, F be PartFunc of D,REAL, r be Real st 0<
  r holds F"{r} = max+(F)"{r};

theorem 
  for D be non empty set, F be PartFunc of D,REAL holds F"(
  left_closed_halfline(0)) = max+(F)"{0};

theorem 
  for D be non empty set, F be PartFunc of D,REAL, d be Element of
  D holds 0<=(max+ F).d;

theorem 
  for D be non empty set, F be PartFunc of D,REAL, r be Real st 0<
  r holds F"{-r} = max-(F)"{r};

theorem 
  for D be non empty set, F be PartFunc of D,REAL holds F"(
  right_closed_halfline(0)) = max-(F)"{0};

theorem 
  for D be non empty set, F be PartFunc of D,REAL, d be Element of
  D holds 0<=(max- F).d;

theorem 
  for D,C be non empty set, F be PartFunc of D,REAL, G be PartFunc of C,
  REAL st F,G are_fiberwise_equipotent holds max+(F), max+(G)
  are_fiberwise_equipotent;

theorem 
  for D,C be non empty set, F be PartFunc of D,REAL, G be PartFunc of C,
  REAL st F,G are_fiberwise_equipotent holds max-(F), max-(G)
  are_fiberwise_equipotent;

registration
  let D be non empty set, F be finite PartFunc of D,REAL;
  cluster max+(F) -> finite;
  cluster max-(F) -> finite;
end;

theorem 
  for D,C be non empty set, F be finite PartFunc of D,REAL, G be finite
PartFunc of C,REAL st max+ F, max+ G are_fiberwise_equipotent & max- F, max- G
  are_fiberwise_equipotent holds F, G are_fiberwise_equipotent;

theorem 
  for D be non empty set, F be PartFunc of D,REAL, X be set holds
  (max+ F)|X = max+ (F|X);

theorem 
  for D be non empty set, F be PartFunc of D,REAL, X be set holds (max-
  F)|X = max- (F|X);

theorem 
  for D be non empty set, F be PartFunc of D,REAL st (for d be
  Element of D st d in dom F holds F.d>=0) holds max+ F = F;

theorem 
  for D be non empty set, F be PartFunc of D,REAL st (for d be Element
  of D st d in dom F holds F.d<=0) holds max- F = -F;

theorem 
  for D be non empty set, F be PartFunc of D,REAL holds F - 0 = F;

theorem 
  for D be non empty set, F be PartFunc of D,REAL, r be Real, X be set
  holds (F|X) - r = (F-r)| X;

theorem 
  for D be non empty set, F be PartFunc of D,REAL, r,s be Real
  holds F"{s+r} = (F-r)"{s};

theorem 
  for D,C be non empty set, F be PartFunc of D,REAL, G be PartFunc of C,
  REAL , r be Real holds F, G are_fiberwise_equipotent iff F-r,G-r
  are_fiberwise_equipotent;

definition

  let F be PartFunc of REAL,REAL, X be set;
  pred F is_convex_on X means


  X c= dom F & for p be Real st 0<=p & p<=
1 holds for r,s be Real st r in X & s in X & p*r + (1-p)*s in X holds F.(p*r +
  (1-p)*s) <= p*F.r + (1-p)*F.s;
end;

theorem 
  for a,b be Real, F be PartFunc of REAL,REAL holds F is_convex_on
  [.a,b.] iff [.a,b.] c= dom F & for p be Real st 0<=p & p<=1 holds for r,s be
Real st r in [.a,b.] & s in [.a,b.] holds F.(p*r + (1-p)*s) <= p*F.r + (1-p)*F.
  s;

theorem 
  for a,b be Real, F be PartFunc of REAL,REAL holds F is_convex_on [.a,b
.] iff [.a,b.] c= dom F & for x1,x2,x3 be Real st x1 in [.a,b.] & x2 in [.a,b.]
& x3 in [.a,b.] & x1<x2 & x2<x3 holds (F.x1-F.x2)/(x1-x2)<=(F.x2-F.x3)/(x2-x3);

theorem 
  for F be PartFunc of REAL,REAL, X,Y be set st F is_convex_on X & Y c=
  X holds F is_convex_on Y;

theorem 
  for F be PartFunc of REAL,REAL, X be set, r be Real holds F
  is_convex_on X iff F-r is_convex_on X;

theorem 
  for F be PartFunc of REAL,REAL, X be set, r be Real st 0<r holds F
  is_convex_on X iff r(#)F is_convex_on X;

theorem 
  for F be PartFunc of REAL,REAL, X be set st X c= dom F holds 0(#) F
  is_convex_on X;

theorem 
  for F,G be PartFunc of REAL,REAL, X be set st F is_convex_on X & G
  is_convex_on X holds F+G is_convex_on X;

theorem 
  for F be PartFunc of REAL,REAL, X be set, r be Real st F
  is_convex_on X holds max+(F-r) is_convex_on X;

theorem 
  for F be PartFunc of REAL,REAL, X be set st F is_convex_on X holds
  max+ F is_convex_on X;

theorem 
  id [#](REAL) is_convex_on REAL;

theorem 
  for r be Real holds max+(id [#](REAL) - r) is_convex_on REAL;

definition
  let D be non empty set, F be PartFunc of D,REAL, X be set;
  assume
 dom(F|X) is finite;
  func FinS(F,X) -> non-increasing FinSequence of REAL means


  F|X, it are_fiberwise_equipotent;
end;

theorem 
  for D be non empty set, F be PartFunc of D,REAL, X be set st dom
  (F|X) is finite holds FinS(F,dom(F|X)) = FinS(F,X);

theorem 
  for D be non empty set, F be PartFunc of D,REAL, X be set st dom
  (F|X) is finite holds FinS(F|X,X) = FinS(F,X);

theorem 
  for D be non empty set, d be Element of D, X be set,
      F be PartFunc of D,REAL st
    X is finite & d in dom(F|X) holds
    FinS(F,X\{d})^<*F.d*>, F|X are_fiberwise_equipotent;

theorem 
  for D be non empty set, d be Element of D, X be set,
      F be PartFunc of D,REAL st
      dom(F|X) is finite & d in dom(F|X) holds
    FinS(F,X\{d})^<*F.d*>, F|X are_fiberwise_equipotent;

theorem 
  for D be non empty set, F be PartFunc of D,REAL, X be set,
      Y being finite set st Y = dom(F|X) holds len FinS(F,X) = card Y;

theorem 
  for D be non empty set, F be PartFunc of D,REAL holds FinS(F,{}) = <*>REAL;

theorem 
  for D be non empty set, F be PartFunc of D,REAL, d be Element of
  D st d in dom F holds FinS(F,{d}) = <* F.d *>;

theorem 
  for D be non empty set, F be PartFunc of D,REAL, X be set, d be
Element of D st dom(F|X) is finite & d in dom(F|X) & FinS(F,X).(len FinS(F,X))
  = F.d holds FinS(F,X) = FinS(F,X\{d}) ^ <*F.d*>;

theorem 
  for D be non empty set, F be PartFunc of D,REAL, X,Y be set st dom(F|X
) is finite & Y c= X & (for d1,d2 be Element of D st d1 in dom(F|Y) & d2 in dom
  (F|(X\Y)) holds F.d1>=F.d2) holds FinS(F,X) = FinS(F,Y) ^ FinS(F,X \ Y);

theorem 
  for D be non empty set, F be PartFunc of D,REAL, r be Real, X be
set, d be Element of D st dom(F|X) is finite & d in dom(F|X) holds FinS(F-r,X).
  (len FinS(F-r,X)) = (F-r).d iff FinS(F,X).(len FinS(F,X)) = F.d;

theorem 
  for D be non empty set, F be PartFunc of D,REAL, r be Real, X be
set, Z being finite set st Z = dom(F|X) holds FinS(F-r, X) = FinS(F,X) - (card
  Z |->r);

theorem 
  for D be non empty set, F be PartFunc of D,REAL, X be set st dom(F|X)
  is finite & (for d be Element of D st d in dom(F|X) holds F.d>=0) holds FinS(
  max+ F, X) = FinS(F, X);

theorem 
  for D be non empty set, F be PartFunc of D,REAL, X be set, r be Real,
Z be finite set st Z = dom(F|X) & rng(F|X) = {r} holds FinS(F, X) = card(Z) |->
  r;

theorem 
  for D be non empty set, F be PartFunc of D,REAL, X,Y be set st
dom(F|(X \/ Y)) is finite & X misses Y holds FinS(F,X \/ Y), FinS(F,X) ^ FinS(F
  ,Y) are_fiberwise_equipotent;

definition
  let D be non empty set, F be PartFunc of D,REAL, X be set;
  func Sum(F,X) -> Real equals

  Sum FinS(F,X);
end;

theorem 
  for D be non empty set, F be PartFunc of D,REAL, X be set, r be
  Real st dom(F|X) is finite holds Sum(r(#)F,X) = r * Sum(F,X);

theorem 
  for D be non empty set, F,G be PartFunc of D,REAL, X be set, Y
being finite set st Y = dom(F|X) & dom(F|X) = dom(G|X) holds Sum(F+G,X) = Sum(F
  ,X) + Sum(G,X);

theorem 
  for D be non empty set, F,G be PartFunc of D,REAL, X be set st dom(F|X
  ) is finite & dom(F|X) = dom(G|X) holds Sum(F-G,X) = Sum(F,X) - Sum (G,X);

theorem 
  for D be non empty set, F be PartFunc of D,REAL, X be set, r be Real,
  Y being finite set st Y = dom(F|X) holds Sum(F-r,X) = Sum(F,X) - r*card(Y);

theorem 
  for D be non empty set, F be PartFunc of D,REAL holds Sum(F,{}) = 0;

theorem 
  for D be non empty set, F be PartFunc of D,REAL, d be Element of D st
  d in dom F holds Sum(F,{d}) = F.d;

theorem 
  for D be non empty set, F be PartFunc of D,REAL, X,Y be set st dom(F|(
  X \/ Y)) is finite & X misses Y holds Sum(F, X \/ Y) = Sum(F,X) + Sum (F,Y);

theorem 
  for D be non empty set, F be PartFunc of D,REAL, X,Y be set st dom(F|(
X \/ Y)) is finite & dom(F|X) misses dom(F|Y) holds Sum(F, X \/ Y) = Sum(F,X) +
  Sum(F,Y);














begin  

reserve a,b for R_eal;



scheme 

  RSetEq {P[set]} : for X1,X2 being Subset of REAL st (for x being R_eal holds
  x in X1 iff P[x]) & (for x being R_eal holds x in X2 iff P[x]) holds X1 = X2;

definition
  let a,b be R_eal;
  redefine func ].a,b.[ -> Subset of REAL means

  for x being R_eal holds x in it iff a < x & x < b;
end;

definition
  let IT be Subset of REAL;
  attr IT is open_interval means


  ex a,b being R_eal st IT = ].a,b.[;
  attr IT is closed_interval means


  ex a,b being real number st IT = [.a,b.];
end;

registration
  cluster non empty open_interval for Subset of REAL;
  cluster non empty closed_interval for Subset of REAL;
end;

definition
  let IT be Subset of REAL;
  attr IT is right_open_interval means


  ex a being real number, b being R_eal st IT = [.a,b.[;
end;

notation
  let IT be Subset of REAL;
  synonym IT is left_closed_interval for IT is right_open_interval;
end;

definition
  let IT be Subset of REAL;
  attr IT is left_open_interval means


  ex a being R_eal,b being real number st IT = ].a,b.];
end;

notation
  let IT be Subset of REAL;
  synonym IT is right_closed_interval for IT is left_open_interval;
end;

registration
  cluster non empty right_open_interval for Subset of REAL;
  cluster non empty left_open_interval for Subset of REAL;
end;

definition
  mode Interval is interval Subset of REAL;
end;

reserve A,B for Interval;

registration
  cluster open_interval -> interval for Subset of REAL;
  cluster closed_interval -> interval for Subset of REAL;
  cluster right_open_interval -> interval for Subset of REAL;
  cluster left_open_interval -> interval for Subset of REAL;
end;

theorem 
  for I being interval Subset of REAL holds
  I is open_interval or I is closed_interval or
  I is right_open_interval or I is left_open_interval;

theorem 
  for a,b being R_eal st a < b ex x being R_eal st a < x & x < b & x in REAL;

theorem 
  for a,b,c being R_eal st a < b & a < c ex x being R_eal st a < x & x <
  b & x < c & x in REAL;

theorem 
  for a,b,c being R_eal st a < c & b < c ex x being R_eal st a < x & b <
  x & x < c & x in REAL;

definition

  let A be ext-real-membered set;
  func diameter A -> R_eal equals


  sup A - inf A if A <> {} otherwise
  0.;
end;

theorem 
  for a,b being R_eal holds (a < b implies diameter ].a,b.[ = b - a) & (
  b <= a implies diameter ].a,b.[ = 0.);

theorem 
  for a,b being R_eal holds (a <= b implies diameter [.a,b.] = b - a) &
  (b < a implies diameter [.a,b.] = 0.);

theorem 
  for a,b being R_eal holds (a < b implies diameter [.a,b.[ = b - a) & (
  b <= a implies diameter [.a,b.[ = 0.);

theorem 
  for a,b being R_eal holds (a < b implies diameter ].a,b.] = b - a) & (
  b <= a implies diameter ].a,b.] = 0.);

theorem 
  for a,b being R_eal holds a = -infty & b = +infty & (A = ].a,b.[ or A
  = [.a,b.] or A = [.a,b.[ or A = ].a,b.]) implies diameter(A) = +infty;

registration
  cluster empty -> open_interval for Subset of REAL;
end;

theorem 
  diameter {} = 0.;

theorem 
  A c= B & B =[.a,b.] & b <= a implies diameter(A) = 0. & diameter(B) = 0.;

theorem 
  A c= B implies diameter A <= diameter B;

theorem 
  0. <= diameter A;

theorem 
 for X being Subset of REAL holds X is non empty closed_interval
  iff ex a,b being Real st a <= b & X = [.a,b.];















begin

reserve n,m,k for Element of NAT,
  x,y for set,
  r for Real;

definition
  let D be non empty set, E be real-membered set, F be PartFunc of D,E, r be
  Real;
  redefine func r(#)F ->Element of PFuncs(D,REAL);
end;

definition
  let IT be FinSequence;
  attr IT is terms've_same_card_as_number means


  for n be Nat st 1<=n &
  n<=len IT for B being finite set st B = IT.n holds card B = n;
  attr IT is ascending means


  for n be Nat st 1<=n & n<=len IT - 1 holds IT.n c= IT.(n+1);
end;

definition
  let X be set;
  let IT be FinSequence of X;
  attr IT is lenght_equal_card_of_set means


  ex B being finite set st B = union X & len IT = card B;
end;

registration
  let D be non empty finite set;
  cluster terms've_same_card_as_number ascending lenght_equal_card_of_set
    for FinSequence of bool(D);
end;

definition
  let D be non empty finite set;
  mode RearrangmentGen of D is terms've_same_card_as_number ascending
    lenght_equal_card_of_set FinSequence of bool(D);
end;

reserve C,D for non empty finite set,
  a for FinSequence of bool D;

theorem 
  for a be FinSequence of bool D holds a is
  lenght_equal_card_of_set iff len a = card D;

theorem 
  for a be FinSequence holds a is ascending iff for n,m st n<=m & n
  in dom a & m in dom a holds a.n c= a.m;

theorem 
  for a be terms've_same_card_as_number lenght_equal_card_of_set
  FinSequence of bool D holds a.(len a) = D;

theorem 
  for a be lenght_equal_card_of_set FinSequence of bool D holds len a <> 0;

theorem 
  for a be ascending terms've_same_card_as_number FinSequence of
  bool D holds for n,m holds n in dom a & m in dom a & n<>m implies a.n <> a.m;

theorem 
  for a be ascending terms've_same_card_as_number FinSequence of bool D
  holds for n holds 1 <= n & n <= len a - 1 implies a.n <> a.(n+1);

theorem 
  for a be terms've_same_card_as_number FinSequence of bool D st n
  in dom a holds a.n <> {};

theorem 
  for a be terms've_same_card_as_number FinSequence of bool D st 1
  <=n & n<=len a - 1 holds a.(n+1) \ a.n <> {};

theorem 
  for a be terms've_same_card_as_number lenght_equal_card_of_set
  FinSequence of bool D ex d be Element of D st a.1 = {d};

theorem 
  for a be terms've_same_card_as_number ascending FinSequence of
bool D st 1<=n & n<=len a - 1 ex d be Element of D st a.(n+1) \ a.n = {d} & a.(
  n+1) = a.n \/ {d} & a.(n+1) \ {d} = a.n;

definition
  let D be non empty finite set, A be RearrangmentGen of D;
  func Co_Gen A -> RearrangmentGen of D means


  for m be Nat st 1 <= m & m <= len it - 1 holds it.m = D \ A.(len A -m);
 involutiveness;
end;

canceled;

theorem 
  for F be PartFunc of D,REAL, A be RearrangmentGen of C st F is
  total & card C = card D holds len MIM FinS(F,D) = len CHI(A,C);

definition
  let D,C be non empty finite set, A be RearrangmentGen of C, F be PartFunc of
  D,REAL;
  func Rland (F,A) -> PartFunc of C,REAL equals

  Sum (MIM(FinS(F,D)) (#) CHI(A,
  C));
  func Rlor(F,A) -> PartFunc of C,REAL equals

  Sum (MIM(FinS(F,D)) (#) CHI(
  Co_Gen A,C));
end;

theorem 
  for F be PartFunc of D,REAL, A be RearrangmentGen of C st F is
  total & card C = card D holds dom Rland(F,A) = C;

theorem 
  for c be Element of C, F be PartFunc of D,REAL, A be
RearrangmentGen of C st F is total & card C = card D holds (c in A.1 implies (
MIM(FinS(F,D)) (#) CHI(A,C))#c = MIM(FinS(F,D))) & for n st 1<=n & n<len A & c
in A.(n+1) \ A.n holds (MIM(FinS(F,D)) (#) CHI(A,C))#c = (n |-> (0 qua Real)) ^
  (MIM(FinS(F,D)/^n));

theorem 
  for c be Element of C, F be PartFunc of D,REAL, A be
RearrangmentGen of C st F is total & card C = card D holds (c in A.1 implies (
  Rland(F,A)).c = FinS(F,D).1) & for n st 1<=n & n<len A & c in A.(n+1) \ A.n
  holds Rland(F,A).c = FinS(F,D).(n+1);

theorem 
  for F be PartFunc of D,REAL, A be RearrangmentGen of C st F is
  total & card C = card D holds rng Rland(F,A) = rng FinS(F,D);

theorem 
  for F be PartFunc of D,REAL, A be RearrangmentGen of C st F is
  total & card C = card D holds Rland(F,A), FinS(F,D) are_fiberwise_equipotent;

theorem 
  for F be PartFunc of D,REAL, A be RearrangmentGen of C st F is
  total & card C = card D holds FinS(Rland(F,A),C) = FinS(F,D);

theorem 
  for F be PartFunc of D,REAL, A be RearrangmentGen of C st F is
  total & card C = card D holds Sum (Rland(F,A),C) = Sum (F,D);

theorem 
  for F be PartFunc of D,REAL, A be RearrangmentGen of C st F is total &
card C = card D holds FinS(Rland(F,A) - r,C) = FinS(F-r,D) & Sum (Rland(F,A)-r,
  C) = Sum (F-r,D);

theorem 
  for F be PartFunc of D,REAL, A be RearrangmentGen of C st F is
  total & card C = card D holds dom Rlor(F,A) = C;

theorem 
  for c be Element of C, F be PartFunc of D,REAL, A be
  RearrangmentGen of C st F is total & card C = card D holds (c in (Co_Gen A).1
implies (Rlor(F,A)).c = FinS(F,D).1) & for n st 1<=n & n<len (Co_Gen A) & c in
  (Co_Gen A).(n+1) \ (Co_Gen A).n holds Rlor(F,A).c = FinS(F,D).(n+1);

theorem 
  for F be PartFunc of D,REAL, A be RearrangmentGen of C st F is
  total & card C = card D holds rng Rlor(F,A) = rng FinS(F,D);

theorem 
  for F be PartFunc of D,REAL, A be RearrangmentGen of C st F is
  total & card C = card D holds Rlor(F,A), FinS(F,D) are_fiberwise_equipotent;

theorem 
  for F be PartFunc of D,REAL, A be RearrangmentGen of C st F is
  total & card C = card D holds FinS(Rlor(F,A),C) = FinS(F,D);

theorem 
  for F be PartFunc of D,REAL, A be RearrangmentGen of C st F is
  total & card C = card D holds Sum (Rlor(F,A),C) = Sum (F,D);

theorem 
  for F be PartFunc of D,REAL, A be RearrangmentGen of C st F is total &
card C = card D holds FinS((Rlor(F,A)) - r,C) = FinS(F-r,D) & Sum (Rlor(F,A)-r,
  C) = Sum (F-r,D);

theorem 
  for F be PartFunc of D,REAL, A be RearrangmentGen of C st F is total &
  card C = card D holds Rlor(F,A), Rland(F,A) are_fiberwise_equipotent & FinS(
  Rlor(F,A),C) = FinS(Rland(F,A),C) & Sum (Rlor(F,A),C) = Sum (Rland(F,A),C);

theorem 
  for F be PartFunc of D,REAL, A be RearrangmentGen of C st F is total &
  card C = card D holds max+(Rland(F,A) - r), max+(F - r)
are_fiberwise_equipotent & FinS(max+(Rland(F,A) - r), C) = FinS(max+(F - r), D)
  & Sum (max+(Rland(F,A) - r), C) = Sum (max+(F - r), D);

theorem 
  for F be PartFunc of D,REAL, A be RearrangmentGen of C st F is total &
  card C = card D holds max-(Rland(F,A) - r), max-(F - r)
are_fiberwise_equipotent & FinS(max-(Rland(F,A) - r), C) = FinS(max-(F - r), D)
  & Sum (max-(Rland(F,A) - r), C) = Sum (max-(F - r), D);

theorem 
  for F be PartFunc of D,REAL, A be RearrangmentGen of C st F is
  total & card D = card C holds len FinS(Rland(F,A),C) = card C & 1<=len FinS(
  Rland(F,A),C);

theorem 
  for F be PartFunc of D,REAL, A be RearrangmentGen of C st F is total &
card D = card C & n in dom A holds FinS(Rland(F,A),C) | n = FinS(Rland(F,A),A.n
  );

theorem 
  for F be PartFunc of D,REAL, A be RearrangmentGen of C st F is total &
  card D = card C holds Rland(F-r,A) = Rland(F,A) - r;

theorem 
  for F be PartFunc of D,REAL, A be RearrangmentGen of C st F is total &
card C = card D holds max+(Rlor(F,A) - r), max+(F - r) are_fiberwise_equipotent
& FinS(max+(Rlor(F,A) - r), C) = FinS(max+(F - r), D) & Sum (max+(Rlor(F,A) - r
  ), C) = Sum (max+(F - r), D);

theorem 
  for F be PartFunc of D,REAL, A be RearrangmentGen of C st F is total &
card C = card D holds max-(Rlor(F,A) - r), max-(F - r) are_fiberwise_equipotent
& FinS(max-(Rlor(F,A) - r), C) = FinS(max-(F - r), D) & Sum (max-(Rlor(F,A) - r
  ), C) = Sum (max-(F - r), D);

theorem 
  for F be PartFunc of D,REAL, A be RearrangmentGen of C st F is
total & card D = card C holds len FinS(Rlor(F,A),C) = card C & 1<=len FinS(Rlor
  (F,A),C);

theorem 
  for F be PartFunc of D,REAL, A be RearrangmentGen of C st F is total &
  card D = card C & n in dom A holds FinS(Rlor(F,A),C) | n = FinS(Rlor(F,A),(
  Co_Gen A).n);

theorem 
  for F be PartFunc of D,REAL, A be RearrangmentGen of C st F is total &
  card D = card C holds Rlor(F-r,A) = Rlor(F,A) - r;

theorem 
  for F be PartFunc of D,REAL, A be RearrangmentGen of C st F is total &
card D = card C holds Rland(F,A) , F are_fiberwise_equipotent & Rlor (F,A) , F
  are_fiberwise_equipotent & rng Rland(F,A) = rng F & rng Rlor(F,A) = rng F;














begin 

theorem 
  ex F being Function of NAT,[:NAT,NAT:]
  st F is one-to-one & dom F = NAT & rng F = [:NAT,NAT:];

theorem 
  for F being Function of NAT,ExtREAL st F is nonnegative holds 0. <= SUM(F);

theorem 
  for F being Function of NAT,ExtREAL, x being R_eal st
  (ex n being Element of NAT st x <= F.n) & F is nonnegative holds x <= SUM(F);

definition
  let x be ext-real number;
  func R_EAL x -> R_eal equals

  x;
end;

theorem 
  for eps being R_eal st 0. < eps ex F being Function of NAT,ExtREAL st
  (for n being Element of NAT holds 0. < F.n) & SUM(F) < eps;

theorem 
  for eps being R_eal, X being non empty Subset of ExtREAL st
  0. < eps & inf X is Real holds
  ex x being ext-real number st x in X & x < inf X + eps;

theorem 
  for eps being R_eal, X being non empty Subset of ExtREAL st
  0. < eps & sup X is Real holds ex x being ext-real number st
  x in X & sup X - eps < x;

theorem 
  for F being Function of NAT, ExtREAL st F is nonnegative & SUM(F) < +infty
    holds for n being Element of NAT holds F.n in REAL;



registration
  cluster non empty interval for Subset of REAL;
end;

theorem 
  for A being non empty Interval, a being R_eal st ex b being R_eal st a
  <= b & A = ].a,b.[ holds a = inf A;

theorem 
  for A being non empty Interval, a being R_eal st ex b being R_eal st a
  <= b & A = ].a,b.] holds a = inf A;

theorem 
  for A being non empty Interval, a being R_eal st ex b being R_eal st a
  <= b & A = [.a,b.] holds a = inf A;

theorem 
  for A being non empty Interval, a being R_eal st
   ex b being R_eal st a <= b & A = [.a,b.[ holds a = inf A;

theorem 
  for A being non empty Interval, b being R_eal st ex a being R_eal st a
  <= b & A = ].a,b.[ holds b = sup A;

theorem 
  for A being non empty Interval, b being R_eal st ex a being
  R_eal st a <= b & A = ].a,b.] holds b = sup A;

theorem 
  for A being non empty Interval, b being R_eal st
  ex a being R_eal st a <= b & A = [.a,b.] holds b = sup A;

theorem 
  for A being non empty Interval, b being R_eal st
    ex a being R_eal st a <= b & A = [.a,b.[ holds b = sup A;

theorem 
  for A being non empty Interval st A is open_interval
     holds A = ].inf A,sup A.[;

theorem 
  for A being non empty Interval st A is closed_interval holds
    A = [.inf A,sup A.];

theorem 
  for A being non empty Interval st A is right_open_interval holds
  A = [.inf A,sup A.[;

theorem 
  for A being non empty Interval st A is left_open_interval holds
   A = ].inf A,sup A.];

theorem 
  for A,B being non empty Interval, a,b being real number st
    a in A & b in B & sup A <= inf B holds a <= b;

theorem 
  for A,B be real-membered set holds for y being Real holds y in B ++ A iff
    ex x,z being Real st x in B & z in A & y = x + z;

theorem 
  for A,B being non empty Interval holds sup A = inf B &
  (sup A in A or inf B in B) implies A \/ B is Interval;

definition

  let A be real-membered set;
  let x be real number;
  redefine func x ++ A -> Subset of REAL;
end;

theorem 
  for A being Subset of REAL, x being real number holds -x ++ (x ++ A) = A;

theorem 
  for x being real number, A being Subset of REAL st A = REAL holds x ++ A = A;

theorem 
  for x being real number holds x ++ {} = {};

theorem 
  for A being Interval, x being real number holds
    A is open_interval iff x ++ A is open_interval;

theorem 
  for A being Interval, x being real number holds
    A is closed_interval iff x ++ A is closed_interval;

theorem 
  for A being Interval, x being real number holds
    A is right_open_interval iff x ++ A is right_open_interval;

theorem 
  for A being Interval, x being real number holds
    A is left_open_interval iff x ++ A is left_open_interval;

theorem 
  for A being Interval, x being real number holds x ++ A is Interval;

theorem 
  for A being real-membered set, x being real number,
      y being R_eal st x = y holds sup(x ++ A) = y + sup A;

theorem 
  for A being real-membered set, x being real number,
      y being R_eal st x = y holds inf(x ++ A) = y + inf A;

theorem 
  for A being Interval, x being real number holds
    diameter(A) = diameter(x ++ A);

begin 

notation
  let X be set;
  synonym X is without_zero for X is with_non-empty_elements;
  antonym X is with_zero for X is with_non-empty_elements;
end;

definition
  let X be set;
  redefine attr X is without_zero means


  not 0 in X;
end;

registration
  cluster REAL -> with_zero;
  cluster NAT -> with_zero;
end;

registration
  cluster non empty without_zero for set;
  cluster non empty with_zero for set;
end;

registration
  cluster non empty without_zero for Subset of REAL;
  cluster non empty with_zero for Subset of REAL;
end;

theorem 
  for F being set st
    F is non empty with_non-empty_elements c=-linear holds F is centered;

registration
  let F be set;
  cluster non empty with_non-empty_elements c=-linear -> centered
    for Subset-Family of F;
end;

registration 
  let X, Y be non empty set, f be Function of X, Y;
  cluster f.:X -> non empty;
end;

definition 
  let X, Y be set, f be Function of X, Y;
  func "f -> Function of bool Y, bool X means

  for y being Subset of Y holds it.y = f"y;
end;

theorem 
  for X, Y, x being set, S being Subset-Family of Y, f being
  Function of X, Y st x in meet (("f).:S) holds f.x in meet S;

reserve r, s, t for real number;

theorem 
  abs r + abs s = 0 implies r = 0;

theorem 
  r < s & s < t implies abs s < abs r + abs t;

reserve seq for Real_Sequence,
  X, Y for Subset of REAL;

theorem 
  seq is convergent & seq is non-zero & lim seq = 0 implies seq" is non bounded
;

theorem 
  rng seq is real-bounded iff seq is bounded;

notation
  let X be real-membered set;
  synonym X is with_max for X is right_end;
  synonym X is with_min for X is left_end;
end;

definition
  let X be real-membered set;
  redefine attr X is with_max means

  X is bounded_above & upper_bound X in X;
  redefine attr X is with_min means

  X is bounded_below & lower_bound X in X;
end;

registration
  cluster non empty closed real-bounded for Subset of REAL;
end;

definition
  let R be Subset-Family of REAL;
  attr R is open means

  for X being Subset of REAL st X in R holds X is open;
  attr R is closed means


  for X being Subset of REAL st X in R holds X is closed;
end;

reserve   r3, r1, q3, p3 for Real;

definition let X be Subset of REAL;
  redefine func --X -> Subset of REAL;
end;

theorem 
  r in X iff -r in --X;

theorem 
  X is bounded_above iff --X is bounded_below;

theorem 
  X is bounded_below iff --X is bounded_above;

theorem 
  for X being non empty Subset of REAL st X is bounded_below holds
  lower_bound X = - upper_bound --X;

theorem 
  for X being non empty Subset of REAL st X is bounded_above holds
  upper_bound X = - lower_bound --X;

theorem 
  X is closed iff --X is closed;

theorem 
  r in X iff q3+r in q3++X;

theorem 
  X = 0++X;

theorem 
  q3++(p3++X) = (q3+p3)++X;

theorem 
  X is bounded_above iff q3++X is bounded_above;

theorem 
  X is bounded_below iff q3++X is bounded_below;

theorem 
  for X being non empty Subset of REAL st X is bounded_below
   holds lower_bound (q3++X) = q3+lower_bound X;

theorem 
  for X being non empty Subset of REAL st X is bounded_above
  holds upper_bound (q3++X) = q3+upper_bound X;

theorem 
  X is closed iff q3++X is closed;

definition
  let X be Subset of REAL;
  func Inv X -> Subset of REAL equals

  { 1/r3 : r3 in X};
  involutiveness;
end;

theorem 
  for X being Subset of REAL holds r in X iff 1/r in Inv X;

registration
  let X be non empty Subset of REAL;
  cluster Inv X -> non empty;
end;

registration
  let X be without_zero Subset of REAL;
  cluster Inv X -> without_zero;
end;

theorem 
  for X being without_zero Subset of REAL st X is closed real-bounded
  holds Inv X is closed;

theorem 
  for Z being Subset-Family of REAL st Z is closed holds meet Z is closed;

definition
  let X be Subset of REAL;
  func Cl X -> Subset of REAL equals

  meet { A where A is Subset of REAL : X c= A & A is closed };
  projectivity;
end;

registration
  let X be Subset of REAL;
  cluster Cl X -> closed;
end;

theorem 
  for Y being closed Subset of REAL st X c= Y holds Cl X c= Y;

theorem 
  X c= Cl X;

theorem 
  X is closed iff X = Cl X;

theorem 
  Cl ({}REAL) = {};

theorem 
  Cl ([#]REAL) = REAL;

theorem 
  X c= Y implies Cl X c= Cl Y;

theorem 
  r3 in Cl X iff for O being open Subset of REAL st r3 in O holds
  O /\ X is non empty;

theorem 
  r3 in Cl X implies ex seq st rng seq c= X & seq is convergent & lim seq = r3;

begin 

definition
  let X be set, f be Function of X, REAL;
  redefine attr f is bounded_below means

  f.:X is bounded_below;
  redefine attr f is bounded_above means

  f.:X is bounded_above;
end;

definition
  let X be set, f be Function of X, REAL;
  attr f is with_max means

  f.:X is with_max;
  attr f is with_min means

  f.:X is with_min;
end;

theorem 
  for X, A being set, f being Function of X, REAL holds (-f).:A = --(f.:A);

theorem 
  for X being non empty set, f being Function of X, REAL holds
  f is with_min iff -f is with_max;

theorem 
  for X being non empty set, f being Function of X, REAL holds
  f is with_max iff -f is with_min;

theorem 
  for X being set, A being Subset of REAL, f being Function of X, REAL
    holds (-f)"A = f"(--A);

theorem 
  for X, A being set, f being Function of X, REAL, s being Real holds
    (s+f).:A = s++(f.:A);

theorem 
  for X being set, A being Subset of REAL,
      f being Function of X,REAL, q3 holds (q3+f)"A = f"(-q3++A);

notation
  let f be real-valued Function;
  synonym Inv f for f";
end;

definition
  let C be set;
  let D be real-membered set;
  let f be PartFunc of C,D;
  redefine func Inv f -> PartFunc of C,REAL;
end;

theorem 
  for X being set, A being without_zero Subset of REAL,
      f being Function of X, REAL holds (Inv f)"A = f"(Inv A);

theorem 
  for A being Subset of REAL, x being Real st x in --A holds
    ex a being Real st a in A & x = -a;














begin  

definition
  let x,y be R_eal;
  redefine func x * y -> R_eal;
end;

theorem 
  for x,y being R_eal holds for a,b being Real holds x = a & y = b
  implies x * y = a * b;

definition
  let x,y be R_eal;
  redefine func x / y -> R_eal;
end;

theorem 
  for x,y being R_eal holds for a,b being Real st x = a & y = b
  holds x / y = a / b;

definition
  let x be R_eal;
  func |. x .| -> R_eal equals


  x if 0 <= x otherwise -x;
  projectivity;
end;

theorem 
  for x being R_eal st 0 <= x holds |. x .| = x;

theorem 
  for x being R_eal st x < 0 holds |. x .| = -x;

registration let x be R_eal;
 cluster |.x.| -> non negative;
end;

theorem 
  for a,b being Real holds a*b = R_EAL a * R_EAL b;

theorem 
  for a,b being Real holds a/b = R_EAL a / R_EAL b;

begin 
  

definition
  let F be FinSequence of ExtREAL;
  func Sum(F) -> R_eal means


  ex f being Function of NAT, ExtREAL st it
= f.(len F) & f.0 = 0. & for i being Element of NAT st i < len F holds f.(i+1)=
  f.i+F.(i+1);
end;

theorem 
  Sum(<*> ExtREAL) = 0.;

theorem 
  for a being R_eal holds Sum<*a*> = a;

theorem 
  for a,b being R_eal holds Sum<*a,b*> = a+b;

theorem 
  for F,G being FinSequence of ExtREAL st not -infty in rng F & not
  -infty in rng G holds Sum(F^G) = Sum(F)+Sum(G);

theorem 
  for F,G being FinSequence of ExtREAL, s being Permutation of dom
  F st G = F*s & not -infty in rng F holds Sum(F) = Sum(G);
















begin 

theorem 
  for F being Function of NAT,ExtREAL st for n being Element of NAT
  holds F.n = 0. holds SUM(F) = 0.;

theorem 
  for F being Function of NAT,ExtREAL st F is nonnegative holds for
  n being Element of NAT holds F.n <= Ser(F).n;

theorem 
  for F,G,H being Function of NAT,ExtREAL st G is nonnegative & H
  is nonnegative holds (for n being Element of NAT holds F.n = G.n + H.n )
  implies for n being Element of NAT holds (Ser F).n = (Ser G).n + (Ser H).n;

theorem 
  for F,G,H being Function of NAT,ExtREAL st for n being Element of
NAT holds F.n = G.n + H.n holds G is nonnegative & H is nonnegative implies SUM
  (F) <= SUM(G) + SUM(H);

theorem 
  for F,G being Function of NAT,ExtREAL holds ( for n being Element
of NAT holds F.n <= G.n) implies for n being Element of NAT holds (Ser(F)).n <=
  SUM(G);

theorem 
  for F being Function of NAT,ExtREAL holds F is nonnegative
  implies for n being Element of NAT holds (Ser(F)).n <= SUM(F);

definition
  let S be non empty set;
  let H be Function of S,ExtREAL;
  func On H -> Function of NAT,ExtREAL means


  for n being Element of NAT
  holds (n in S implies it.n = H.n) & (not n in S implies it.n = 0.);
end;

theorem 
  for X being non empty set for G being Function of X,ExtREAL st G
  is nonnegative holds On G is nonnegative;

theorem 
  for F being Function of NAT,ExtREAL st F is nonnegative holds for
  n,k being Element of NAT st n <= k holds Ser(F).n <= Ser(F).k;

theorem 
  for k being Element of NAT holds for F being Function of NAT,
ExtREAL holds ((for n being Element of NAT st n <> k holds F.n = 0.) implies (
for n being Element of NAT st n < k holds Ser(F).n = 0.) & for n being Element
  of NAT st k <= n holds Ser(F).n = F.k );

theorem 
  for G being Function of NAT,ExtREAL st G is nonnegative holds
for S being non empty Subset of NAT holds for H being Function of S,NAT st H is
  one-to-one holds SUM(On(G*H)) <= SUM(G);

theorem 
  for F,G being Function of NAT,ExtREAL st G is nonnegative holds
for S being non empty Subset of NAT holds for H being Function of S,NAT st H is
one-to-one holds (for k being Element of NAT holds ((k in S implies F.k = (G*H)
  .k) & ((not k in S) implies F.k = 0.))) implies SUM(F) <= SUM(G);

definition
  let A be Subset of REAL;
  mode Interval_Covering of A -> Function of NAT, bool REAL means


    A c= union(rng it) & for n being Element of NAT holds it.n is Interval;
end;

definition
  let A be Subset of REAL;
  let F be Interval_Covering of A;
  let n be Element of NAT;
  redefine func F.n ->Interval;
end;

definition
  let F be Function of NAT,bool REAL;
  mode Interval_Covering of F -> Function of NAT,Funcs(NAT,bool REAL) means


     for n being Element of NAT holds it.n is Interval_Covering of F.n;
end;

definition
  let A be Subset of REAL;
  let F be Interval_Covering of A;
  func F vol -> Function of NAT,ExtREAL means


  for n being Element of NAT holds it.n = diameter(F.n);
end;

theorem 
  for A being Subset of REAL holds for F being Interval_Covering
  of A holds (F vol) is nonnegative;

definition
  let F be Function of NAT, bool REAL;
  let H be Interval_Covering of F;
  let n be Element of NAT;
  redefine func H.n -> Interval_Covering of F.n;
end;

definition
  let F be Function of NAT, bool REAL;
  let G be Interval_Covering of F;
  func G vol -> Function of NAT,Funcs(NAT,ExtREAL) means

  for n being Element of NAT holds it.n = (G.n) vol;
end;

definition
  let A be Subset of REAL;
  let F be Interval_Covering of A;
  func vol F -> R_eal equals

  SUM(F vol);
end;

definition
  let F be Function of NAT,(bool REAL);
  let G be Interval_Covering of F;
  func vol(G) -> Function of NAT,ExtREAL means


  for n being Element of NAT holds it.n = vol(G.n);
end;

theorem 
  for F being Function of NAT,(bool REAL) holds for G being
Interval_Covering of F holds for n being Element of NAT holds 0. <= (vol(G)).n;

definition
  let A be Subset of REAL;
  func Svc(A) -> Subset of ExtREAL means


  for x being R_eal holds x in
  it iff ex F being Interval_Covering of A st x = vol(F);
end;

registration
  let A be Subset of REAL;
  cluster Svc(A) -> non empty;
end;

definition
  let A be Subset of REAL;
  func COMPLEX(A) -> Element of ExtREAL equals

  inf(Svc(A));
end;

definition
  func OS_Meas -> Function of bool REAL,ExtREAL means


  for A being Subset of REAL holds it.A = inf(Svc(A));
end;

definition

  let F be Function of NAT,bool REAL;
  let G be Interval_Covering of F;
  let H be Function of NAT,[:NAT,NAT:] such that
 rng H = [:NAT,NAT:];
  func On(G,H) -> Interval_Covering of union rng F means


  for n being Element of NAT holds it.n = (G.(pr1(H).n)).(pr2(H).n);
end;

theorem 
  for H being Function of NAT,[:NAT,NAT:] st H is one-to-one & rng
  H = [:NAT,NAT:] holds for k being Element of NAT holds ex m being Element of
  NAT st for F being Function of NAT,bool REAL holds for G being
  Interval_Covering of F holds Ser((On(G,H)) vol).k <= Ser(vol(G)).m;

theorem 
  for F being Function of NAT,bool REAL holds for G being
  Interval_Covering of F holds inf Svc(union rng F) <= SUM(vol(G));

theorem 
  OS_Meas is C_Measure of REAL;

definition
  redefine func OS_Meas -> C_Measure of REAL;
end;

definition
  func Lmi_sigmaFIELD -> SigmaField of REAL equals

  sigma_Field(OS_Meas);
end;

definition
  func L_mi -> sigma_Measure of Lmi_sigmaFIELD equals

  sigma_Meas(OS_Meas);
end;















begin 

reserve a,b,r,s,x0,x for Real;
reserve f,g for PartFunc of REAL,REAL;
reserve X,Y for set;

theorem 
  for a, b being real number holds max(a,b) >= min(a,b);

theorem 
  for n being Element of NAT, R1,R2 being Element of n-tuples_on
  REAL, r1,r2 being Real holds mlt(R1^<*r1*>,R2^<*r2*>)=mlt(R1,R2)^<*r1*r2*>;

theorem 
  for n being Element of NAT, R being Element of n-tuples_on REAL
  st Sum R=0 & (for i being Element of NAT st i in dom R holds 0 <= R.i) holds
  for i being Element of NAT st i in dom R holds R.i = 0;

theorem 
  for n being Element of NAT, R being Element of n-tuples_on REAL
st (for i being Element of NAT st i in dom R holds 0 = R.i) holds R = n |-> (0
  qua Real);

theorem 
  for n being Element of NAT, R being Element of n-tuples_on REAL
  holds mlt(n |-> (0 qua Real),R) = n |-> (0 qua Real);

begin 

definition
  let f, X;
  pred f is_strictly_convex_on X means


  X c= dom f & for p being Real st
0<p & p<1 holds for r,s being Real st r in X & s in X & p*r + (1-p)*s in X & r
  <> s holds f.(p*r + (1-p)*s) < p*f.r + (1-p)*f.s;
end;

theorem 
  f is_strictly_convex_on X implies f is_convex_on X;

theorem 
  for a,b be Real, f be PartFunc of REAL,REAL holds f
is_strictly_convex_on [.a,b.] iff [.a,b.] c= dom f & for p be Real st 0<p & p<1
holds for r,s be Real st r in [.a,b.] & s in [.a,b.] & r <> s holds f.(p*r+(1-p
  )*s) < p*f.r + (1-p)*f.s;

theorem 
  for X being set, f being PartFunc of REAL,REAL holds f is_convex_on X
  iff X c= dom f & for a,b,c being Real st a in X & b in X & c in X & a<b & b<c
  holds f.b <=((c-b)/(c-a))*f.a + ((b-a)/(c-a))*f.c;

theorem 
  for X being set, f being PartFunc of REAL,REAL holds f
is_strictly_convex_on X iff X c= dom f & for a,b,c being Real st a in X & b in
  X & c in X & a<b & b<c holds f.b < ((c-b)/(c-a))*f.a + ((b-a)/(c-a))*f.c;

theorem 
  f is_strictly_convex_on X & Y c= X implies f is_strictly_convex_on Y;

theorem 
  f is_strictly_convex_on X iff f-r is_strictly_convex_on X;

theorem 
  0<r implies (f is_strictly_convex_on X iff r(#)f is_strictly_convex_on X);

theorem 
  f is_strictly_convex_on X & g is_strictly_convex_on X implies f+
  g is_strictly_convex_on X;

theorem 
  f is_strictly_convex_on X & g is_convex_on X implies f+g
  is_strictly_convex_on X;

theorem 
  f is_strictly_convex_on X & g is_strictly_convex_on X & ( a>0 & b>=0
  or a>=0 & b>0 ) implies a(#)f+b(#)g is_strictly_convex_on X;

theorem 
  f is_convex_on X iff X c= dom f & for a,b,r st a in X & b in X &
r in X & a < r & r < b holds (f.r-f.a)/(r-a) <= (f.b-f.a)/(b-a) & (f.b-f.a)/(b-
  a) <= (f.b-f.r)/(b-r);

theorem 
  f is_strictly_convex_on X iff X c= dom f & for a,b,r st a in X & b in
X & r in X & a < r & r < b holds (f.r-f.a)/(r-a) < (f.b-f.a)/(b-a) & (f.b-f.a)/
  (b-a) < (f.b-f.r)/(b-r);



theorem 
  for f being PartFunc of REAL,REAL st f is total holds (for n being
  Element of NAT, P,E,F being Element of n-tuples_on REAL st Sum P=1 & (for i
being Element of NAT st i in dom P holds P.i >=0 & F.i=f.(E.i)) holds f.Sum(mlt
  (P,E))<=Sum(mlt(P,F))) iff f is_convex_on REAL;

theorem 
  for f being PartFunc of REAL,REAL, I being Interval, a being Real st (
ex x1,x2 being Real st x1 in I & x2 in I & x1 < a & a < x2) & f is_convex_on I
  holds f is_continuous_in a;

begin 

definition
  let f, X;
  pred f is_quasiconvex_on X means


  X c= dom f & for p being Real st 0<p
& p<1 holds for r,s being Real st r in X & s in X & p*r + (1-p)*s in X holds f.
  (p*r + (1-p)*s) <= max(f.r,f.s);
end;

definition
  let f, X;
  pred f is_strictly_quasiconvex_on X means


  X c= dom f & for p being
  Real st 0<p & p<1 holds for r,s being Real st r in X & s in X & p*r + (1-p)*s
  in X & f.r <> f.s holds f.(p*r + (1-p)*s) < max(f.r,f.s);
end;

definition
  let f, X;
  pred f is_strongly_quasiconvex_on X means


  X c= dom f & for p being
  Real st 0<p & p<1 holds for r,s being Real st r in X & s in X & p*r + (1-p)*s
  in X & r <> s holds f.(p*r + (1-p)*s) < max(f.r,f.s);
end;

definition
  let f;
  let x0 be real number;
  pred f is_upper_semicontinuous_in x0 means


  x0 in dom f & for r st 0<r
  ex s st 0<s & for x st x in dom f & abs(x-x0)<s holds f.x0-f.x<r;
end;

definition
  let f,X;
  pred f is_upper_semicontinuous_on X means


  X c= dom f & for x0 st x0 in X holds f|X is_upper_semicontinuous_in x0;
end;

definition
  let f;
  let x0 be real number;
  pred f is_lower_semicontinuous_in x0 means


  x0 in dom f & for r st 0<r
  ex s st 0<s & for x st x in dom f & abs(x-x0)<s holds f.x-f.x0<r;
end;

definition
  let f,X;
  pred f is_lower_semicontinuous_on X means


  X c= dom f & for x0 st x0 in X holds f|X is_lower_semicontinuous_in x0;
end;

theorem 
  for x0 be real number, f st x0 in dom f holds f
  is_upper_semicontinuous_in x0 & f is_lower_semicontinuous_in x0 iff f
  is_continuous_in x0;

theorem 
  for X, f st X c= dom f holds f is_upper_semicontinuous_on X & f
  is_lower_semicontinuous_on X iff f|X is continuous;

theorem 
  for X, f st f is_strictly_convex_on X holds f is_strongly_quasiconvex_on X;

theorem 
  for X, f st f is_strongly_quasiconvex_on X holds f is_quasiconvex_on X;

theorem 
  for X, f st f is_convex_on X holds f is_strictly_quasiconvex_on X;

theorem 
  for X, f st f is_strongly_quasiconvex_on X holds f
  is_strictly_quasiconvex_on X;

theorem 
  for X, f st f is_strictly_quasiconvex_on X & f is one-to-one holds f
  is_strongly_quasiconvex_on X;














begin  

reserve k for Element of NAT;
reserve r for Real;
reserve i for Integer;
reserve q for Rational;

definition
  func INT- -> Subset of REAL means


  r in it iff ex k st r = - k;
end;

registration
  cluster INT- -> non empty;
end;

theorem 
  NAT,INT- are_equipotent;

theorem 
  INT=INT- \/ NAT;

theorem 
  NAT,INT are_equipotent;

definition
  let n be Nat;
  func RAT_with_denominator n -> Subset of RAT means


  q in it iff ex i st q = i/n;
end;

registration
  let n be Nat;
  cluster RAT_with_denominator(n+1) -> non empty;
end;

theorem 
  for n being Nat holds INT,RAT_with_denominator (n+1) are_equipotent;

theorem 
  NAT,RAT are_equipotent;

begin  

definition
  let C be non empty set;

  let f1,f2 be C-defined ExtREAL-valued Function;
  func f1+f2 -> PartFunc of C,ExtREAL means


  dom it = (dom f1 /\ dom f2)\((f1"{-infty} /\ f2"{+infty}) \/ (f1"{+infty} /\
  f2"{-infty}))
  & for c being Element of C st c in dom it holds it.c = f1.c + f2.c;
  commutativity;
  func f1-f2 -> PartFunc of C,ExtREAL means

  dom it = (dom f1 /\ dom f2)\((f1"{+infty} /\ f2"{+infty}) \/ (f1"{-infty} /\
  f2"{-infty}))
  & for c being Element of C st c in dom it holds it.c = f1.c - f2.c;
  func f1(#)f2 -> PartFunc of C,ExtREAL means


  dom it = dom f1 /\ dom f2
  & for c being Element of C st c in dom it holds it.c = f1.c * f2.c;
  commutativity;
end;

definition
  let C be non empty set, 
      f be C-defined ExtREAL-valued Function,
      r be Real;
  func r(#)f -> PartFunc of C,ExtREAL means


  dom it = dom f
  & for c being Element of C st c in dom it holds it.c = (R_EAL r) * f.c;
end;

theorem 
  for C being non empty set, f being PartFunc of C,ExtREAL, r being Real
  st r <> 0 holds
  for c being Element of C st c in dom(r(#)f) holds f.c = (r(#)f).c / R_EAL r;

definition
  let C be non empty set;

  let f be C-defined ExtREAL-valued Function;
  func -f -> PartFunc of C,ExtREAL means

  dom it = dom f & for c being Element of C st c in dom it holds it.c = -(f.c);
end;

definition
  func 1. -> R_eal equals

  1;
end;

definition
  let C be non empty set;

  let f be C-defined ExtREAL-valued Function;
  let r be Real;
  func r/f -> PartFunc of C,ExtREAL means


  dom it = dom f \ f"{0.} &
  for c being Element of C st c in dom it holds it.c = (R_EAL r)/(f.c);
end;

theorem 
  for C being non empty set, f being PartFunc of C,ExtREAL holds
  dom (1/f) = dom f \ f"{0.} &
  for c being Element of C st c in dom (1/f) holds (1/f).c = 1./(f.c);

definition
  let C be non empty set;

  let f be C-defined ExtREAL-valued Function;
  func |.f.| -> PartFunc of C,ExtREAL means

  dom it = dom f &
  for c being Element of C st c in dom it holds it.c = |. f.c .|;
end;

begin  

theorem 
  for r being Real holds ex n being Element of NAT st r <= n;

theorem 
  for r being Real holds ex n being Element of NAT st -n <= r;

theorem 
  for r,s being real number st r < s holds
  ex n being Element of NAT st 1/(n+1) < s-r;

theorem 
  for r,s being real number st for n being Element of NAT
  holds r-1/(n+1) <= s holds r <= s;

theorem 
  for a being R_eal st (for r being Real holds R_EAL r < a) holds a = +infty;

theorem 
  for a being R_eal st (for r being Real holds a < R_EAL r) holds a = -infty;

reserve X for set;
reserve f for PartFunc of X,ExtREAL;
reserve S for SigmaField of X;
reserve F for Function of NAT,S;
reserve A for set;
reserve a for R_eal;
reserve r,s for Real;
reserve n,m for Element of NAT;

notation
  let f be ext-real-valued Function, a be ext-real number;
  synonym eq_dom(f,a) for Coim(f,a);
end;

definition

  let f be ext-real-valued Function, a be ext-real number;
  func less_dom(f,a) -> set means


  for x being set holds x in it iff x in dom f & f.x < a;
  func less_eq_dom(f,a) -> set means


  for x being set holds x in it iff x in dom f & f.x <= a;
  func great_dom(f,a) -> set means


  for x being set holds x in it iff x in dom f & a < f.x;
  func great_eq_dom(f,a) -> set means


  for x being set holds x in it iff x in dom f & a <= f.x;
  redefine func eq_dom(f,a) means


  for x being set holds x in it iff x in dom f & f.x = a;
end;

definition
  let X be set, f be PartFunc of X,ExtREAL, a be ext-real number;
  redefine func less_dom(f,a) -> Subset of X;
  redefine func less_eq_dom(f,a) -> Subset of X;
  redefine func great_dom(f,a) -> Subset of X;
  redefine func great_eq_dom(f,a) -> Subset of X;
  redefine func eq_dom(f,a) -> Subset of X;
end;

theorem 
  A c= dom f implies A /\ great_eq_dom(f,a) = A\(A /\ less_dom(f,a));

theorem 
  A c= dom f implies A /\ great_dom(f,a) = A\(A /\ less_eq_dom(f,a));

theorem 
  A c= dom f implies A /\ less_eq_dom(f,a) = A\(A /\ great_dom(f,a));

theorem 
  A c= dom f implies A /\ less_dom(f,a) = A\(A /\ great_eq_dom(f,a));

theorem 
  A /\ eq_dom(f,a) = A /\ great_eq_dom(f,a) /\ less_eq_dom(f,a);

theorem 
  for X, S, F, f, A, r st for n holds F.n = A /\ great_dom(f,R_EAL(r-1/(n+1)))
  holds A /\ great_eq_dom(f,R_EAL r) = meet rng F;

theorem 
for r being real number st for n holds F.n = A /\ less_dom(f,R_EAL(r+1/(n+1)))
  holds A /\ less_eq_dom(f,R_EAL r) = meet rng F;

theorem 
  for r being real number st for n
  holds F.n = A /\ less_eq_dom(f,R_EAL(r-1/(n+1)))
  holds A /\ less_dom(f,R_EAL r) = union rng F;

theorem 
  for X, S, F, f, A, r st for n holds F.n = A /\
  great_eq_dom(f,R_EAL(r+1/(n+1)))
  holds A /\ great_dom(f,R_EAL r) = union rng F;

theorem 
  for X, S, F, f, A st for n holds F.n = A /\ great_dom(f,R_EAL n)
  holds A /\ eq_dom(f,+infty) = meet rng F;

theorem 
  for X, S, F, f, A st for n holds F.n = A /\ less_dom(f,R_EAL n)
  holds A /\ less_dom(f,+infty) = union rng F;

theorem 
  for X, S, F, f, A st for n holds F.n = A /\ less_dom(f,R_EAL (-n))
  holds A /\ eq_dom(f,-infty) = meet rng F;

theorem 
  for X, S, F, f, A st for n holds F.n = A /\ great_dom(f,R_EAL (-n))
  holds A /\ great_dom(f,-infty) = union rng F;

begin 

definition
  let X be non empty set;
  let S be SigmaField of X;
  let f be PartFunc of X,ExtREAL;
  let A be Element of S;
  pred f is_measurable_on A means


  for r being real number holds A /\ less_dom(f,R_EAL r) in S;
end;

reserve X for non empty set;
reserve x for Element of X;
reserve f,g for PartFunc of X,ExtREAL;
reserve S for SigmaField of X;
reserve A,B for Element of S;

theorem 
  for X,S,f,A st A c= dom f holds f is_measurable_on A iff
  for r being real number holds A /\ great_eq_dom(f,R_EAL r) in S;

theorem 
  for X,S,f,A holds f is_measurable_on A iff
  for r being real number holds A /\ less_eq_dom(f,R_EAL r) in S;

theorem 
  for X,S,f,A st A c= dom f holds f is_measurable_on A iff
  for r being real number holds A /\ great_dom(f,R_EAL r) in S;

theorem 
  for X,S,f,A,B st B c= A & f is_measurable_on A holds f is_measurable_on B;

theorem 
  for X,S,f,A,B st f is_measurable_on A & f is_measurable_on B holds
  f is_measurable_on (A \/ B);

theorem 
  for X,S,f,A,r,s st f is_measurable_on A & A c= dom f holds
  (A /\ great_dom(f,R_EAL r) /\ less_dom(f,R_EAL s)) in S;

theorem 
  for X,S,f,A st f is_measurable_on A & A c= dom f holds
  A /\ eq_dom(f,+infty) in S;

theorem 
  for X,S,f,A st f is_measurable_on A holds A /\ eq_dom(f,-infty) in S;

theorem 
  for X,S,f,A st f is_measurable_on A & A c= dom f holds
  A /\ great_dom(f,-infty) /\ less_dom(f,+infty) in S;

theorem 
  for X,S,f,g,A,r st f is_measurable_on A & g is_measurable_on A & A c= dom g
  holds A /\ less_dom(f,R_EAL r) /\ great_dom(g,R_EAL r) in S;

theorem 
  for X,S,f,A,r st f is_measurable_on A & A c= dom f
  holds r(#)f is_measurable_on A;















begin 

reserve x,y,w,z for R_eal,
  a for Real;

begin 

theorem 
  x = a implies |.x.| = abs(a);

theorem 
  |.x.| = x or |.x.| = -x;

theorem 
  0 <= |.x.|;

theorem 
  x <> 0 implies 0 < |.x.|;

theorem 
  x = 0 iff |.x.| = 0;

theorem 
  |.x.| = -x & x <> 0 implies x < 0;

theorem 
  x <= 0 implies |.x.| = -x;

theorem 
  |.x * y.| = |.x.| * |.y.|;

theorem 
  -|.x.| <= x & x <= |.x.|;

theorem 
  |.x.| < y implies -y < x & x < y;

theorem 
  -y < x & x < y implies 0 < y & |.x.| < y;

theorem 
  -y <= x & x <= y iff |.x.| <= y;

theorem 
  |.x + y.| <= |.x.| + |.y.|;

theorem 
  -infty < x & x < +infty & x <> 0 implies |.x.|*|. 1./x .| = 1.;

theorem 
  x = +infty or x = -infty implies |.x.|*|. 1./x .| = 0;

theorem 
  x <> 0 implies |. 1./x .| = 1./|.x.|;

theorem 
  not((x=-infty or x=+infty) & (y=-infty or y=+infty)) & y<>0 implies |.
  x/y.| = |.x.|/|.y.|;

theorem 
  |.x.| = |.-x.|;

theorem 
  |.+infty.| = +infty & |.-infty.| = +infty;

theorem 
  x is Real or y is Real implies |.x.|-|.y.| <= |.x-y.|;

theorem 
   |.x-y.| <= |.x.| + |.y.|;

canceled;

theorem 
  |.x.| <= z & |.y.| <= w implies |.x+y.| <= z + w;

theorem 
  x is Real or y is Real implies |.|.x.|-|.y.|.| <= |.x-y.|;

theorem 
  0 <= x * y implies |.x+y.| = |.x.|+|.y.|;

begin

theorem 
  x <> +infty & y <> +infty & not ( x = +infty & y = +infty or x =
  -infty & y = -infty ) implies min(x,y) = (x + y - |.x - y.|) / R_EAL 2;

theorem 
  x <> -infty & y <> -infty & not ( x = +infty & y = +infty or x =
  -infty & y = -infty ) implies max(x,y) = (x + y + |.x - y.|) / R_EAL 2;

definition
  let x,y be R_eal;
  redefine func max(x,y) -> R_eal;
  redefine func min(x,y) -> R_eal;
end;

theorem 
  min(x,y) + max(x,y)= x + y;

begin 


theorem 
  |.x.| = +infty implies x = +infty or x = -infty;

theorem 
  |.x.| < +infty iff x in REAL;














begin

reserve q,th,r for Real,
  a,b,p for real number,
  w,z for Element of COMPLEX,
  k,l,m,n,n1,n2 for Element of NAT,
  seq,seq1,seq2,cq1 for Complex_Sequence,
  rseq,rseq1,rseq2 for Real_Sequence,
  rr for set,
  hy1 for 0-convergent non-zero Real_Sequence;



definition
  let m,k be Element of NAT;
  func CHK(m,k) -> Element of COMPLEX equals


  1 if m <= k otherwise 0;
end;

registration
  let m,k be Element of NAT;
  cluster CHK(m,k) -> real;
end;

scheme 
 ExComplexCASE{F(Nat,Nat)->complex number}:
  for k holds ex seq st for n holds (n <= k implies seq.n=F(k,n)) &
  (n > k implies seq.n=0);

scheme 
 ExRealCASE{F(Nat,Nat)->real number}: for k holds
  ex rseq st for n holds (n <= k implies rseq.n=F(k,n)) &
  (n > k implies rseq.n=0);

definition
  func Prod_real_n -> Real_Sequence means


  it.0 = 1 & for n holds it.(n+1) = it.n * (n+1);
end;

definition
  let n be Nat;
  redefine func n! equals

  Prod_real_n.n;
end;

definition
  let z be complex number;
  func z ExpSeq -> Complex_Sequence means


  for n holds it.n = z #N n / (n!);
end;

definition
  let a be real number;
  func a rExpSeq -> Real_Sequence means


  for n holds it.n = a |^ n /(n!);
end;

theorem 
  0! = 1 & n! <> 0 & (n+1)! = n! * (n+1);

theorem 
  (0 < k implies ((k-'1)! ) * k = k!) &
  (k <= m implies ((m-'k)!) * (m+1-k) = (m+1-'k)!);

definition
  let n be Element of NAT;
  func Coef(n) -> Complex_Sequence means


  for k be Element of NAT holds
  (k <= n implies it.k = n! /( (k! ) * ((n-'k)! ))) &
  (k > n implies it.k = 0);
end;

definition
  let n be Element of NAT;
  func Coef_e(n) -> Complex_Sequence means


  for k be Element of NAT holds
  (k <= n implies it.k = 1r/((k! ) * ((n-'k)! ))) & (k > n implies it.k=0);
end;

definition
  let seq;
  func Shift seq -> Complex_Sequence means


  it.0=0 & for k be Element of NAT holds it.(k+1) = seq.k;
end;

definition
  let n;
  let z,w be Element of COMPLEX;
  func Expan(n,z,w) -> Complex_Sequence means


  for k be Element of NAT holds ( k <= n implies
  it.k=((Coef(n)).k) * (z |^ k) * (w |^ (n-'k)) ) & (n < k implies it.k=0);
end;

definition
  let n;
  let z,w be Element of COMPLEX;
  func Expan_e(n,z,w) -> Complex_Sequence means


  for k be Element of NAT holds ( k <= n implies
  it.k=((Coef_e(n)).k) * (z |^ k) * (w |^ (n-'k)) ) & (n < k implies it.k=0);
end;

definition
  let n;
  let z,w be Element of COMPLEX;
  func Alfa(n,z,w) -> Complex_Sequence means


  for k be Element of NAT holds ( k <= n implies
  it.k= (z ExpSeq).k * Partial_Sums(w ExpSeq).(n-'k) ) &
  ( n < k implies it.k=0);
end;

definition
  let a,b be real number;
  let n be Element of NAT;
  func Conj(n,a,b) -> Real_Sequence means

  for k be Element of NAT holds
  ( k <= n implies it.k= (a rExpSeq).k * (Partial_Sums(b rExpSeq).n
  -Partial_Sums(b rExpSeq).(n-'k))) & (n < k implies it.k=0);
end;

definition
  let z, w be Element of COMPLEX;
  let n be Element of NAT;
  func Conj(n,z,w) -> Complex_Sequence means


  for k be Element of NAT holds ( k <= n implies
  it.k= (z ExpSeq).k * (Partial_Sums(w ExpSeq).n
  -Partial_Sums(w ExpSeq).(n-'k))) & (n < k implies it.k=0);
end;

theorem 
  for z being complex number holds
  z ExpSeq.(n+1) = z ExpSeq.n * z /(n+1+0*<i>) & z ExpSeq.0=1 &
  |.(z ExpSeq).n .| = (|.z.| rExpSeq ).n;

theorem 
  0 < k implies (Shift(seq)).k=seq.(k-'1);

theorem 
  Partial_Sums(seq).k=Partial_Sums(Shift(seq)).k+seq.k;

theorem 
  (z+w) |^ n = Partial_Sums(Expan(n,z,w)).n;

theorem 
  Expan_e(n,z,w)=(1r/(n! )) (#) Expan(n,z,w);

theorem 
  ((z+w) |^ n) / (n!) = Partial_Sums(Expan_e(n,z,w)).n;

theorem 
  ((0c qua complex number) ExpSeq is absolutely_summable)
  & Sum((0c qua complex number) ExpSeq)=1r;

registration
  let z be complex number;
  cluster z ExpSeq -> absolutely_summable;
end;

theorem 
  (z ExpSeq).0 = 1 & Expan(0,z,w).0 = 1;

theorem 
  l <= k implies (Alfa(k+1,z,w)).l = (Alfa(k,z,w)).l + Expan_e(k+1,z,w).l;

theorem 
  Partial_Sums((Alfa(k+1,z,w))).k = (Partial_Sums(( Alfa(k,z,w)))).k
  + (Partial_Sums(( Expan_e(k+1,z,w) ))).k;

theorem 
  (z ExpSeq).k=(Expan_e(k,z,w)).k;

theorem 
  Partial_Sums((z+w) ExpSeq).n = Partial_Sums(Alfa(n,z,w)).n;

theorem 
  Partial_Sums(z ExpSeq).k * Partial_Sums(w ExpSeq).k
  -Partial_Sums((z+w) ExpSeq).k = Partial_Sums(Conj(k,z,w)).k;

theorem 
  |. Partial_Sums((z ExpSeq)).k .| <= Partial_Sums(|.z.| rExpSeq).k &
  Partial_Sums((|.z.| rExpSeq)).k <= Sum(|.z.| rExpSeq) &
  |. Partial_Sums(( z ExpSeq)).k .| <= Sum(|.z.| rExpSeq);

theorem 
  1 <= Sum(|.z.| rExpSeq);

theorem 
  0 <= (|. z .| rExpSeq).n;

theorem 
  abs((Partial_Sums(|.z .| rExpSeq)).n) = Partial_Sums(|.z .| rExpSeq).n &
  (n <= m implies
  abs((Partial_Sums(|.z .| rExpSeq).m-Partial_Sums(|.z .| rExpSeq).n))
  = Partial_Sums(|.z .| rExpSeq).m-Partial_Sums(|.z .| rExpSeq).n);

theorem 
  abs(Partial_Sums(|.Conj(k,z,w).|).n)=Partial_Sums(|.Conj(k,z,w).|).n;

theorem 
  for p being real number st p>0 ex n st for k st n <= k
  holds abs(Partial_Sums(|.Conj(k,z,w).|).k) < p;

theorem 
  (for k holds seq.k=Partial_Sums((Conj(k,z,w))).k) implies
  seq is convergent & lim seq = 0;

begin 

definition
  func exp -> Function of COMPLEX, COMPLEX means


  for z being complex number holds it.z=Sum(z ExpSeq);
end;

definition
  let z be complex number;
  func exp z -> complex number equals

  exp.z;
end;

definition
  let z be complex number;
  redefine func exp z -> Element of COMPLEX;
end;

theorem 
  for z1, z2 being complex number holds exp(z1+z2)=exp(z1) *exp(z2);

begin 

definition
  func sin -> Function of REAL, REAL means


  for d being Element of REAL holds it.d = Im(Sum(d*<i> ExpSeq));
end;

definition
  let th be real number;
  func sin th equals

  sin.th;
end;

registration
  let th be real number;
  cluster sin th -> real;
end;

definition
  let th be Real;
  redefine func sin th -> Real;
end;

reserve d for Real;

definition
  func cos -> Function of REAL, REAL means


  for d holds it.d = Re(Sum(d*<i> ExpSeq));
end;

definition
  let th be real number;
  func cos th equals

  cos.th;
end;

registration
  let th be real number;
  cluster cos th -> real;
end;

definition
  let th be Real;
  redefine func cos th -> Real;
end;

theorem 
  dom(sin)=REAL & dom(cos)=REAL;

theorem 
  exp(th*<i>)=cos(th)+(sin th)*<i>;

theorem 
  (exp((th*<i>)))*'=exp(-(th*<i>));

theorem 
  |.exp((th*<i>)).| = 1 &
  for th being real number holds abs(sin th) <= 1 & abs(cos th) <= 1;

reserve th,th1,th2 for real number;

theorem 
  (cos.th)^2+(sin.th)^2=1 & (cos.th)*(cos.th)+(sin.th)*(sin.th)=1;

theorem 
  (cos(th))^2+(sin(th))^2=1 &
  (cos(th))*(cos(th))+(sin(th))*(sin(th))=1;

theorem 
  cos.0=1 & sin.0=0 & cos.(-th)=cos.th & sin.(-th)=-sin.th;

theorem 
  cos(0)=1 & sin(0)=0 & cos(-th)=cos(th) & sin(-th)=-sin(th);

definition
  let th be real number;
  func th P_sin -> Real_Sequence means


  for n holds it.n = (-1)|^ n * (th)|^ (2*n+1)/((2*n+1)!);
  func th P_cos -> Real_Sequence means


  for n holds it.n = (-1)|^ n * (th)|^ (2*n)/((2*n)!);
end;

theorem 
  for z being complex number,
  k holds z|^ (2*k) = (z|^ k)|^ 2& z|^ (2*k)= (z|^ 2)|^ k;

theorem 
  for th being Real holds (th*<i>) |^ (2*k)=(-1)|^ k* (th |^ (2*k))
  & (th*<i>) |^ (2*k+1)=(-1)|^ k* (th |^ (2*k+1))*<i>;

theorem 
  n! = n!;

theorem 
  for th being Real holds
  Partial_Sums(th P_sin).n = Partial_Sums(Im ((th*<i>) ExpSeq)).(2*n+1) &
  Partial_Sums(th P_cos).n = Partial_Sums(Re ((th*<i>) ExpSeq)).(2*n);

theorem 
  for th being Real holds
  Partial_Sums(th P_sin) is convergent & Sum(th P_sin)=Im(Sum
  ((th*<i>) ExpSeq))
  &Partial_Sums(th P_cos) is convergent & Sum(th P_cos)=Re(Sum
  ((th*<i>) ExpSeq));

theorem 
  cos.th=Sum(th P_cos) & sin.th=Sum(th P_sin);

theorem 
  for p,th,rseq st rseq is convergent &
  lim(rseq)=th & (for n holds rseq.n >= p) holds th >= p;

theorem 
  n <= k implies n! <= k!;

theorem 
  0<=th & th <=1 & n<=k implies th |^ k <= th |^ n;

theorem 
  for th being Real holds th |^ n /(n!)=(th|^ n) /(n!);

theorem 
  for p being real number holds Im(Sum(p ExpSeq))=0;

theorem 
  cos.1>0 & sin.1>0 & cos.1<sin.1;

theorem 
  for th being Real holds th rExpSeq=Re(th ExpSeq);

theorem 
  for th being Real holds th rExpSeq is summable &
  Sum(th rExpSeq)=Re(Sum(th ExpSeq));

theorem 
  for p,q being real number holds
  Sum((p+q) rExpSeq) = (Sum(p rExpSeq))*(Sum(q rExpSeq));

definition
  func exp_R -> Function of REAL, REAL means


  for d being real number holds it.d = Sum(d rExpSeq);
end;

definition
  let th be real number;
  func exp_R th equals

  exp_R.th;
end;

registration
  let th be real number;
  cluster exp_R th -> real;
end;

definition
  let th be Real;
  redefine func exp_R th -> Real;
end;

theorem 
  dom(exp_R)=REAL;

theorem 
  for th being Real holds exp_R.th = Re(Sum(th ExpSeq));

theorem 
  for th being Real holds exp th=exp_R th;

theorem 
  for p,q being real number holds exp_R(p+q) = exp_R(p) * exp_R(q);

theorem 
  exp_R(0) =1;

theorem 
  th > 0 implies exp_R.th >=1;

theorem 
  th < 0 implies 0<exp_R.th & exp_R.th <=1;

theorem 
  exp_R.th>0;

theorem 
  exp_R(th)>0;

begin 

definition
  let z be complex number;
  func z P_dt -> Complex_Sequence means


  for n holds it.n = (z|^(n+1))/((n+2)!);
  func z P_t -> Complex_Sequence means

  for n holds it.n = (z#N(n))/((n+2)!);
end;

theorem 
  for z being complex number holds z P_dt is absolutely_summable;

theorem 
  for z being complex number holds z*(Sum(z P_dt))=(Sum(z ExpSeq))-1r-z;

theorem 
  for p st p>0 holds ex q st q>0 &
  for z being complex number st |.z.|<q holds |.(Sum(z P_dt)).|<p;

theorem 
  for z,z1 being complex number holds (Sum((z1+z) ExpSeq))-(Sum(z1 ExpSeq))
  =(Sum(z1 ExpSeq))*z+z*(Sum(z P_dt))*(Sum(z1 ExpSeq));

theorem 
  for p,q being Real holds cos.(p+q)-cos.p=
  -q*sin.p -q*Im((Sum(q*<i> P_dt))* (cos.p+(sin.p)*<i>));

theorem 
  for p,q being Real holds sin.(p+q)-sin.p=
  q*cos.p+q*Re((Sum((q*<i>) P_dt))* (cos.p+sin.p*<i>));

theorem 
  for p,q being Real holds exp_R.(p+q)-exp_R.p=
  q * (exp_R.p)+q*exp_R.p*Re((Sum(q P_dt)));

theorem 
  cos is_differentiable_in p & diff(cos,p)=-sin.p;

theorem 
  sin is_differentiable_in p & diff(sin,p)=cos.p;

theorem 
  exp_R is_differentiable_in p & diff(exp_R,p)=exp_R.p;

theorem 
  exp_R is_differentiable_on REAL & diff(exp_R,th)=exp_R.th;

theorem 
  cos is_differentiable_on REAL & diff(cos,th)=-sin.th;

theorem 
  sin is_differentiable_on REAL & diff(sin,th)=cos.th;

theorem 
  th in [.0,1 .] implies 0<cos.th & cos.th>=1/2;

definition
  func tan -> PartFunc of REAL, REAL equals

  sin/cos;
  func cot -> PartFunc of REAL, REAL equals

  cos/sin;
end;

theorem 
  [.0,1 .] c= dom tan & ].0,1 .[ c= dom tan;

theorem 
  tan|[.0,1 .] is continuous;

theorem 
  th1 in ].0,1 .[ & th2 in ].0,1 .[ & tan.th1=tan.th2 implies th1=th2;

begin 

definition
  func PI -> real number means


  tan.(it/4) = 1 & it in ]. 0, 4 .[;
end;

definition
  redefine func PI -> Real;
end;

theorem 
  sin.(PI/4) = cos.(PI/4);

begin 

theorem 
  sin.(th1+th2)=(sin.(th1)) *(cos.(th2))+(cos.(th1)) * (sin.(th2)) &
  cos.(th1+th2)=(cos.(th1)) *(cos.(th2))-(sin.(th1)) * (sin.(th2));

theorem 
  sin(th1+th2)=(sin(th1)) *(cos(th2))+(cos(th1)) * (sin(th2)) &
  cos(th1+th2)=(cos(th1)) *(cos(th2))-(sin(th1)) * (sin(th2));

theorem 
  cos.(PI/2) = 0 & sin.(PI/2) = 1 & cos.(PI) = -1 & sin.(PI) = 0 &
  cos.(PI+PI/2) = 0 & sin.(PI+PI/2) = -1 & cos.(2 * PI) = 1 & sin.(2 * PI) =0;

theorem 
  cos(PI/2) = 0 & sin(PI/2) = 1 & cos(PI) = -1 & sin(PI) = 0 &
  cos(PI+PI/2) = 0 & sin(PI+PI/2) = -1 &
  cos(2 * PI) = 1 & sin(2 * PI) =0;

theorem 
  sin.(th+2 * PI) = sin.th & cos.(th+2 * PI) = cos.th &
  sin.(PI/2-th) = cos.th & cos.(PI/2-th) = sin.th & sin.(PI/2+th) = cos.th &
  cos.(PI/2+th) = -sin.th & sin.(PI+th) = -sin.th & cos.(PI+th) = -cos.th;

theorem 
  sin(th+2 * PI) = sin(th) & cos(th+2 * PI) = cos(th) &
  sin(PI/2-th) = cos(th) & cos(PI/2-th) = sin(th) & sin(PI/2+th) = cos(th) &
  cos(PI/2+th) = -sin(th) & sin(PI+th) = -sin(th) &
  cos(PI+th) = -cos(th);

theorem 
  th in ].0,PI/2.[ implies cos.th > 0;

theorem 
  th in ].0,PI/2.[ implies cos(th) > 0;

begin 


theorem 
  sin(a-b) = sin(a)*cos(b)-cos(a)*sin(b);

theorem 
  cos(a-b) = cos(a)*cos(b)+sin(a)*sin(b);

registration
  cluster sin -> continuous;
  cluster cos -> continuous;
  cluster exp_R -> continuous;
end;














begin  

reserve X for non empty set;
reserve e for set;
reserve x for Element of X;
reserve f,g for PartFunc of X,ExtREAL;
reserve S for SigmaField of X;
reserve F for Function of RAT,S;
reserve p,q for Rational;
reserve r for Real;
reserve n,m for Nat;
reserve A,B for Element of S;

definition
  let X, f;
  redefine attr f is real-valued means


  for x st x in dom f holds |. f.x .| < +infty;
end;

theorem 
  f = 1(#)f;

theorem 
  f is real-valued or g is real-valued implies
  dom (f+g) = dom f /\ dom g & dom (f-g) = dom f /\ dom g;

theorem 
  for f,g,F,r,A st f is real-valued & g is real-valued &
  (for p holds F.p = (A /\ less_dom(f,R_EAL p)) /\ (A /\
  less_dom(g,R_EAL (r-p)))) holds A /\ less_dom(f+g,R_EAL r) = union (rng F);

begin  

theorem 
  ex F being Function of NAT,RAT st F is one-to-one & dom F = NAT & rng F = RAT
;

theorem 
  for X,Y,Z be non empty set, F be Function of X,Z st X,Y are_equipotent holds
  ex G be Function of Y,Z st rng F = rng G;

theorem 
  for S,f,g,A st f is_measurable_on A & g is_measurable_on A holds
  ex F being Function of RAT,S st for p being Rational holds
  F.p = (A /\ less_dom(f,R_EAL p)) /\ (A /\ less_dom(g,R_EAL (r-p)));

theorem 
  for f,g,A st f is real-valued & g is real-valued & f is_measurable_on A &
  g is_measurable_on A holds f+g is_measurable_on A;

theorem 
  for C being non empty set, f1,f2 being PartFunc of C,ExtREAL holds
  f1 - f2 = f1 + (-f2);

theorem 
  for C being non empty set, f being PartFunc of C,ExtREAL holds -f = (-1)(#)f;

theorem 
  for C being non empty set, f being PartFunc of C,ExtREAL, r be Real
  st f is real-valued holds r(#)f is real-valued;

theorem 
  for f,g,A st f is real-valued & g is real-valued & f is_measurable_on A &
  g is_measurable_on A & A c= dom g holds f-g is_measurable_on A;

begin  
       

definition
  let C be non empty set, f be PartFunc of C,ExtREAL;
  func max+(f) -> PartFunc of C,ExtREAL means


  dom it = dom f &
  for x be Element of C st x in dom it holds it.x = max(f.x,0.);
  func max-(f) -> PartFunc of C,ExtREAL means


  dom it = dom f &
  for x be Element of C st x in dom it holds it.x = max(-(f.x),0.);
end;

theorem 
  for C being non empty set, f being PartFunc of C,ExtREAL,
  x being Element of C holds 0. <= (max+(f)).x;

theorem 
  for C being non empty set, f being PartFunc of C,ExtREAL,
  x being Element of C holds 0. <= (max-(f)).x;

theorem 
  for C being non empty set, f being PartFunc of C,ExtREAL holds
  max-(f) = max+(-f);

theorem 
for C being non empty set, f being PartFunc of C,ExtREAL, x being Element of C
  st 0. < max+(f).x holds max-(f).x = 0.;

theorem 
  for C being non empty set, f being PartFunc of C,ExtREAL,
  x being Element of C st 0. < max-(f).x holds max+(f).x = 0.;

theorem 
  for C being non empty set, f being PartFunc of C,ExtREAL holds
  dom f = dom (max+(f)-max-(f)) & dom f = dom (max+(f)+max-(f));

theorem 
for C being non empty set, f being PartFunc of C,ExtREAL, x being Element of C
  holds
  (max+(f).x = f.x or max+(f).x = 0.) & (max-(f).x = -(f.x) or max-(f).x = 0.);

theorem 
for C being non empty set, f being PartFunc of C,ExtREAL, x being Element of C
  st max+(f).x = f.x holds max-(f).x = 0.;

theorem 
for C being non empty set, f being PartFunc of C,ExtREAL, x being Element of C
  st x in dom f & max+(f).x = 0. holds max-(f).x = -(f.x);

theorem 
  for C being non empty set, f being PartFunc of C,ExtREAL,
  x being Element of C st max-(f).x = -(f.x) holds max+(f).x = 0.;

theorem 
  for C being non empty set, f being PartFunc of C,ExtREAL,
  x being Element of C st x in dom f & max-(f).x = 0. holds max+(f).x = f.x;

theorem 
  for C being non empty set, f being PartFunc of C,ExtREAL holds
  f = max+(f) - max-(f);

theorem 
  for C being non empty set, f being PartFunc of C,ExtREAL holds
  |.f.| = max+(f) + max-(f);

begin  

theorem 
  f is_measurable_on A implies max+(f) is_measurable_on A;

theorem 
  f is_measurable_on A & A c= dom f implies max-(f) is_measurable_on A;

theorem 
  for f,A st f is_measurable_on A & A c= dom f holds |.f.| is_measurable_on A;

begin

definition
  let A,X be set;
  redefine func chi(A,X) -> PartFunc of X,ExtREAL;
end;

theorem 
  chi(A,X) is real-valued;

theorem 
  chi(A,X) is_measurable_on B;

begin  

registration
  let X be set;
  let S be SigmaField of X;
  cluster disjoint_valued for FinSequence of S;
end;

definition
  let X be set;
  let S be SigmaField of X;
  mode Finite_Sep_Sequence of S is disjoint_valued FinSequence of S;
end;

theorem 
  for F being Function st F is Finite_Sep_Sequence of S holds
  ex G being Sep_Sequence of S st union rng F = union rng G &
  (for n st n in dom F holds F.n = G.n) &
  for m st not m in dom F holds G.m = {};

theorem 
  for F being Function st F is Finite_Sep_Sequence of S holds union rng F in S;

definition
  let X be non empty set;
  let S be SigmaField of X;
  let f be PartFunc of X,ExtREAL;

  pred f is_simple_func_in S means


  f is real-valued &
  ex F being Finite_Sep_Sequence of S st (dom f = union rng F &
  for n being Nat,x,y being Element of X st
  n in dom F & x in F.n & y in F.n holds f.x = f.y);
end;

theorem 
  f is real-valued implies rng f is Subset of REAL;

theorem 
  for F being Relation st F is Finite_Sep_Sequence of S holds
  F|(Seg n) is Finite_Sep_Sequence of S;

theorem 
  f is_simple_func_in S implies f is_measurable_on A;














begin 

reserve p,q,r,th for real number;
reserve n for Element of NAT;

theorem 
  p>=0 & r>=0 implies p+r>=2*sqrt(p*r);

theorem 
  sin|].0,PI/2.[ is increasing;

theorem 
  sin|].PI/2,PI.[ is decreasing;

theorem 
  cos|].0,PI/2.[ is decreasing;

theorem 
  cos|].PI/2,PI.[ is decreasing;

theorem 
  sin|].PI,3/2*PI.[ is decreasing;

theorem 
  sin|].3/2*PI,2*PI.[ is increasing;

theorem 
  cos|].PI,3/2*PI.[ is increasing;

theorem 
  cos|].3/2*PI,2*PI.[ is increasing;

theorem 
  for n being Nat holds sin.th = sin.(2*PI*n + th);

theorem 
  for n being Nat holds cos.th = cos.(2*PI*n + th);

begin 

definition
  func sinh -> Function of REAL, REAL means


  for d being real number holds it.d=(exp_R.d - exp_R.(-d))/2;
end;

definition
  let d be number;
  func sinh(d) equals

  sinh.d;
end;

registration
  let d be number;
  cluster sinh(d) -> real;
end;

definition
  let d be number;
  redefine func sinh(d) -> Real;
end;

definition
  func cosh -> Function of REAL, REAL means


  for d being real number holds it.d=(exp_R.d + exp_R.(-d))/2;
end;

definition
  let d be number;
  func cosh(d) equals

  cosh.d;
end;

registration
  let d be number;
  cluster cosh(d) -> real;
end;

definition
  let d be number;
  redefine func cosh(d) -> Real;
end;

definition
  func tanh -> Function of REAL, REAL means


  for d being real number
  holds it.d=(exp_R.d - exp_R.(-d))/(exp_R.d + exp_R.(-d));
end;

definition
  let d be number;
  func tanh(d) equals

  tanh.d;
end;

registration
  let d be number;
  cluster tanh(d) -> real;
end;

definition
  let d be number;
  redefine func tanh(d) -> Real;
end;

theorem 
  exp_R.(p+q) = exp_R.(p) * exp_R.(q);

theorem 
  exp_R.0 = 1;

theorem 
  (cosh.p)^2-(sinh.p)^2=1 & (cosh.p)*(cosh.p)-(sinh.p)*(sinh.p)=1;

theorem 
  cosh.p <> 0 & cosh.p > 0 & cosh.0 = 1;

theorem 
  sinh.0 = 0;

theorem 
  tanh.p = (sinh.p)/(cosh.p);

theorem 
  (sinh.p)^2 = 1/2*(cosh.(2*p) - 1) & (cosh.p)^2 = 1/2*(cosh.(2*p) + 1);

theorem 
  cosh.(-p) = cosh.p & sinh.(-p) = -sinh.p & tanh.(-p) = -tanh.p;

theorem 
  cosh.(p+r)=(cosh.p)*(cosh.r) + (sinh.p)*(sinh.r) & cosh.(p-r)=(cosh.p)
  *(cosh.r) - (sinh.p)*(sinh.r);

theorem 
  sinh.(p+r)=(sinh.p)*(cosh.r) + (cosh.p)*(sinh.r) & sinh.(p-r)=(sinh.p)
  *(cosh.r) - (cosh.p)*(sinh.r);

theorem 
  tanh.(p+r) = (tanh.p + tanh.r)/(1+ (tanh.p)*(tanh.r)) & tanh.(p-r) = (
  tanh.p - tanh.r)/(1- (tanh.p)*(tanh.r));

theorem 
  sinh.(2*p) = 2*(sinh.p)*(cosh.p) & cosh.(2*p) = 2*(cosh.p)^2 - 1 &
  tanh.(2*p) = (2*tanh.p)/(1+(tanh.p)^2);

theorem 
  (sinh.p)^2 - (sinh.q)^2 = (sinh.(p+q))*(sinh.(p-q)) & (sinh.(p+q
))*(sinh.(p-q)) = (cosh.p)^2 - (cosh.q)^2 & (sinh.p)^2 - (sinh.q)^2 = (cosh.p)
  ^2 - (cosh.q)^2;

theorem 
  (sinh.p)^2 + (cosh.q)^2 = (cosh.(p+q))*(cosh.(p-q)) & (cosh.(p+q
))*(cosh.(p-q)) = (cosh.p)^2 + (sinh.q)^2 & (sinh.p)^2 + (cosh.q)^2 = (cosh.p)
  ^2 + (sinh.q)^2;

theorem 
  sinh.p + sinh.r = 2*(sinh.(p/2+r/2))*(cosh.(p/2-r/2)) & sinh.p - sinh.
  r = 2*(sinh.(p/2-r/2))*(cosh.(p/2+r/2));

theorem 
  cosh.p + cosh.r = 2*(cosh.(p/2+r/2))*(cosh.(p/2-r/2)) & cosh.p - cosh.
  r = 2*(sinh.(p/2-r/2))*(sinh.(p/2+r/2));

theorem 
  tanh.p + tanh.r = (sinh.(p+r))/((cosh.p)*(cosh.r)) & tanh.p - tanh.r =
  (sinh.(p-r))/((cosh.p)*(cosh.r));

theorem 
  (cosh.p + sinh.p) |^ n = cosh.(n*p) + sinh.(n*p);

theorem 
  dom sinh=REAL & dom cosh=REAL & dom tanh=REAL;

theorem 
  sinh is_differentiable_in p & diff(sinh,p)=cosh.p;

theorem 
  cosh is_differentiable_in p & diff(cosh,p)=sinh.p;

theorem 
  tanh is_differentiable_in p & diff(tanh,p)=1/(cosh.p)^2;

theorem 
  sinh is_differentiable_on REAL & diff(sinh,p)=cosh.p;

theorem 
  cosh is_differentiable_on REAL & diff(cosh,p)=sinh.p;

theorem 
  tanh is_differentiable_on REAL & diff(tanh,p)=1/(cosh.p)^2;

theorem 
  cosh.p >= 1;

theorem 
  sinh is_continuous_in p;

theorem 
  cosh is_continuous_in p;

theorem 
  tanh is_continuous_in p;

theorem 
  sinh|REAL is continuous;

theorem 
  cosh|REAL is continuous;

theorem 
  tanh|REAL is continuous;

theorem 
  tanh.p<1 & tanh.p>-1;














begin  

reserve x,y for Element of REAL;
reserve z,z1,z2 for Element of COMPLEX;
reserve n for Element of NAT;

definition
  func sin_C -> Function of COMPLEX, COMPLEX means


  it.z = (exp(<i>*z)-( exp(-<i> * z)))/(2 * <i>);
end;

definition
  func cos_C -> Function of COMPLEX,COMPLEX means


  it.z = (exp(<i>*z) + exp(-<i>*z))/2;
end;

definition
  func sinh_C -> Function of COMPLEX,COMPLEX means


  it.z = (exp(z) - exp (-z))/2;
end;

definition
  func cosh_C -> Function of COMPLEX,COMPLEX means


  it.z = (exp(z) + exp (-z))/2;
end;

begin  

theorem 
  for z being Element of COMPLEX holds (sin_C/.z)*(sin_C/.z) + (cos_C/.z
  )*(cos_C/.z) = 1;

theorem 
  for z being complex number holds -sin_C/.z = sin_C/.(-z);

theorem 
  for z being complex number holds cos_C/.z = cos_C/.(-z);

theorem 
  for z1,z2 being complex number holds sin_C/.(z1+z2) = (sin_C/.z1)
  *(cos_C/.z2) + (cos_C/.z1)*(sin_C/.z2);

theorem 
  sin_C/.(z1-z2) = (sin_C/.z1)*(cos_C/.z2) - (cos_C/.z1)*(sin_C/.z2);

theorem 
  for z1,z2 being complex number holds cos_C/.(z1+z2) = (cos_C/.z1)
  *(cos_C/.z2) - (sin_C/.z1)*(sin_C/.z2);

theorem 
  cos_C/.(z1-z2) = (cos_C/.z1)*(cos_C/.z2) + (sin_C/.z1)*(sin_C/.z2);

theorem 
  (cosh_C/.z)*(cosh_C/.z) - (sinh_C/.z)*(sinh_C/.z) = 1;

theorem 
  -sinh_C/.z = sinh_C/.(-z);

theorem 
  cosh_C/.z = cosh_C/.(-z);

theorem 
  sinh_C/.(z1+z2) = (sinh_C/.z1)*(cosh_C/.z2) + (cosh_C/.z1)*( sinh_C/.z2);

theorem 
  sinh_C/.(z1-z2) = (sinh_C/.z1)*(cosh_C/.z2) - (cosh_C/.z1)*( sinh_C/.z2);

theorem 
  cosh_C/.(z1-z2) = (cosh_C/.z1)*(cosh_C/.z2) - (sinh_C/.z1)*( sinh_C/.z2);

theorem 
  cosh_C/.(z1+z2) = (cosh_C/.z1)*(cosh_C/.z2) + (sinh_C/.z1)*( sinh_C/.z2);

theorem 
  for z being complex number holds sin_C/.(<i>*z) = <i>*sinh_C/.z;

theorem 
  for z being complex number holds cos_C/.(<i>*z) = cosh_C/.z;

theorem 
  for z being complex number holds sinh_C/.(<i>*z) = <i>*sin_C/.z;

theorem 
  for z being complex number holds cosh_C/.(<i>*z) = cos_C/.z;

theorem 
  for x,y being Element of REAL holds exp(x+y*<i>) = (exp_R.x)*(
  cos.y)+(exp_R.x)*(sin.y)*<i>;

theorem 
  exp(0c) = 1;

theorem 
  sin_C/.0c = 0;

theorem 
  sinh_C/.0c = 0;

theorem 
  cos_C/.0c = 1;

theorem 
  cosh_C/.0c = 1;

theorem 
  exp(z) = cosh_C/.z + sinh_C/.z;

theorem 
  exp(-z) = cosh_C/.z - sinh_C/.z;

theorem 
  exp(z+2*PI*<i>) = exp(z);

theorem 
  exp(2*PI*n*<i>) = 1;

theorem 
  exp((-2*PI*n)*<i>) = 1;

theorem 
  exp((2*n+1)*PI*<i>) = -1;

theorem 
  exp((-(2*n+1)*PI)*<i>) = -1;

theorem 
  exp((2*n + 1/2)*PI*<i>) = <i>;

theorem 
  exp((-(2*n + 1/2)*PI)*<i>) = -1*<i>;

theorem 
  sin_C/.(z + 2*n*PI) = sin_C/.z;

theorem 
  cos_C/.(z + 2*n*PI) = cos_C/.z;

theorem 
  for z being complex number holds exp(<i>*z) = cos_C/.z + <i>* sin_C/.z;

theorem 
  for z being complex number holds exp(-<i>*z) = cos_C/.z - <i>* sin_C/.z;

theorem 
  for x being Element of REAL holds sin_C/.x = sin.x;

theorem 
  for x being Element of REAL holds cos_C/.x = cos.x;

theorem 
  for x being Element of REAL holds sinh_C/.x = sinh.x;

theorem 
  for x being Element of REAL holds cosh_C/.x = cosh.x;

theorem 
  sin_C/.(x+y*<i>) = sin.x*cosh.y+cos.x*sinh.y*<i>;

theorem 
  sin_C/.(x+(-y)*<i>) = sin.x*cosh.y+(-cos.x*sinh.y)*<i>;

theorem 
  cos_C/.(x+y*<i>) = cos.x*cosh.y+(-sin.x*sinh.y)*<i>;

theorem 
  cos_C/.(x+(-y)*<i>) = cos.x*cosh.y+sin.x*sinh.y*<i>;

theorem 
  sinh_C/.(x+y*<i>) = sinh.x*cos.y+cosh.x*sin.y*<i>;

theorem 
  sinh_C/.(x+(-y)*<i>) = sinh.x*cos.y+(-cosh.x*sin.y)*<i>;

theorem 
  cosh_C/.(x+y*<i>) = cosh.x*cos.y+sinh.x*sin.y*<i>;

theorem 
  cosh_C/.(x+(-y)*<i>) = cosh.x*cos.y+(-sinh.x*sin.y)*<i>;


theorem 
  for n being Element of NAT, z being Element of COMPLEX holds (
  cos_C/.z + <i>*sin_C/.z) #N n = cos_C/.(n*z) + <i>*sin_C/.(n*z);

theorem 
  for n being Element of NAT, z being Element of COMPLEX holds (
  cos_C/.z - <i>*sin_C/.z) #N n = cos_C/.(n*z) - <i>*sin_C/.(n*z);

theorem 
  for n being Element of NAT, z being Element of COMPLEX holds exp(<i>*n
  *z) = (cos_C/.z + <i>*sin_C/.z) #N n;

theorem 
  for n being Element of NAT, z being Element of COMPLEX holds exp(-<i>*
  n*z) = (cos_C/.z - <i>*sin_C/.z) #N n;

theorem 
  for x,y being Element of REAL holds (1+(-1)*<i>)/2*sinh_C/.(x+y*<i>) +
  (1+<i>)/2*sinh_C/.(x+(-y)*<i>) = sinh.x*cos.y + cosh.x*sin.y;

theorem 
  for x,y being Element of REAL holds (1+(-1)*<i>)/2*cosh_C/.(x+y*<i>) +
  (1+<i>)/2*cosh_C/.(x+(-y)*<i>) = sinh.x*sin.y + cosh.x*cos.y;

theorem 
  sinh_C/.z*sinh_C/.z = (cosh_C/.(2*z) - 1)/2;

theorem 
  cosh_C/.z*cosh_C/.z = (cosh_C/.(2*z) + 1)/2;

theorem 
  sinh_C/.(2*z) = 2*(sinh_C/.z)*(cosh_C/.z) & cosh_C/.(2*z) = 2*(
  cosh_C/.z)*(cosh_C/.z) - 1;

theorem 
  (sinh_C/.z1)*(sinh_C/.z1) - (sinh_C/.z2)*(sinh_C/.z2) =(sinh_C/.
(z1+z2))*(sinh_C/.(z1-z2)) & (cosh_C/.z1)*(cosh_C/.z1) - (cosh_C/.z2)*(cosh_C/.
z2) =(sinh_C/.(z1+z2))*(sinh_C/.(z1-z2)) & (sinh_C/.z1)*(sinh_C/.z1) - (sinh_C
  /.z2)*(sinh_C/.z2) =(cosh_C/.z1)*(cosh_C/.z1) - (cosh_C/.z2)*(cosh_C/.z2);

theorem 
  (cosh_C/.(z1+z2))*(cosh_C/.(z1-z2)) =(sinh_C/.z1)*(sinh_C/.z1) +
(cosh_C/.z2)*(cosh_C/.z2) & (cosh_C/.(z1+z2))*(cosh_C/.(z1-z2)) =(cosh_C/.z1)*(
cosh_C/.z1) + (sinh_C/.z2)*(sinh_C/.z2) & (sinh_C/.z1)*(sinh_C/.z1) + (cosh_C/.
  z2)*(cosh_C/.z2) =(cosh_C/.z1)*(cosh_C/.z1) + (sinh_C/.z2)*(sinh_C/.z2);

theorem 
  sinh_C/.(2*z1) + sinh_C/.(2*z2) = 2*sinh_C/.(z1+z2)*cosh_C/.(z1-z2) &
  sinh_C/.(2*z1) - sinh_C/.(2*z2) = 2*sinh_C/.(z1-z2)*cosh_C/.(z1+z2);

theorem 
  cosh_C/.(2*z1) + cosh_C/.(2*z2) = 2*cosh_C/.(z1+z2)*cosh_C/.(z1-z2) &
  cosh_C/.(2*z1) - cosh_C/.(2*z2) = 2*sinh_C/.(z1+z2)*sinh_C/.(z1-z2);














begin

reserve th, th1, th2, th3 for real number;

definition
  let th;
  func tan(th) -> Real equals

  sin(th)/cos(th);
end;

definition
  let th;
  func cot(th) -> Real equals

  cos(th)/sin(th);
end;

definition
  let th;
  func cosec(th) -> Real equals

  1/sin(th);
end;

definition
  let th;
  func sec(th) -> Real equals

  1/cos(th);
end;

theorem 
  tan(-th) = -tan(th);

theorem 
  cosec(-th) = -1/sin(th);

theorem 
  cot(-th) = -cot(th);

theorem 
  sin(th)*sin(th) = 1-cos(th)*cos(th);

theorem 
  cos(th)*cos(th) = 1-sin(th)*sin(th);

theorem 
  cos(th)<>0 implies sin(th) = cos(th)*tan(th);

theorem 
  cos(th1)<>0 & cos(th2)<>0 implies tan(th1+th2)=(tan(th1)+tan(th2))/(1-
  tan(th1)*tan(th2));

theorem 
  cos(th1)<>0 & cos(th2)<>0 implies tan(th1-th2)=(tan(th1)-tan(th2))/(1+
  tan(th1)*tan(th2));

theorem 
  sin(th1)<>0 & sin(th2)<>0 implies cot(th1+th2) = (cot(th1)*cot(th2)-1)
  /(cot(th2)+cot(th1));

theorem 
  sin(th1)<>0 & sin(th2)<>0 implies cot(th1-th2)=(cot(th1)*cot(th2)+1)/(
  cot(th2)-cot(th1));

theorem 
  cos(th1)<>0 & cos(th2)<>0 & cos(th3)<>0 implies sin(th1+th2+th3)
= cos(th1)*cos(th2)*cos(th3) *(tan(th1)+tan(th2)+tan(th3)-tan(th1)*tan(th2)*tan
  (th3));

theorem 
  cos(th1)<>0 & cos(th2)<>0 & cos(th3)<>0 implies cos(th1+th2+th3)
= cos(th1)*cos(th2)*cos(th3) *(1-tan(th2)*tan(th3)-tan(th3)*tan(th1)-tan(th1)*
  tan(th2));

theorem 
  cos(th1)<>0 & cos(th2)<>0 & cos(th3)<>0 implies tan(th1+th2+th3) = (
  tan(th1)+tan(th2)+tan(th3)-tan(th1)*tan(th2)*tan(th3)) /(1-tan(th2)*tan(th3)-
  tan(th3)*tan(th1)-tan(th1)*tan(th2));

theorem 
  sin(th1) <> 0 & sin(th2) <> 0 & sin(th3) <> 0 implies cot(th1+th2+th3)
= (cot(th1)*cot(th2)*cot(th3)-cot(th1)-cot(th2)-cot(th3)) /(cot(th2)*cot(th3)+
  cot(th3)*cot(th1)+cot(th1)*cot(th2)-1);

theorem 
  sin(th1)+sin(th2)= 2*(cos((th1-th2)/2)*sin((th1+th2)/2));

theorem 
  sin(th1)-sin(th2)= 2*(cos((th1+th2)/2)*sin((th1-th2)/2));

theorem 
  cos(th1)+cos(th2)= 2*(cos((th1+th2)/2)*cos((th1-th2)/2));

theorem 
  cos(th1)-cos(th2)= -2*(sin((th1+th2)/2)*sin((th1-th2)/2));

theorem 
  cos(th1)<>0 & cos(th2)<>0 implies tan(th1)+tan(th2)= sin(th1+th2)/(cos
  (th1)*cos(th2));

theorem 
  cos(th1)<>0 & cos(th2)<>0 implies tan(th1)-tan(th2)= sin(th1-th2)/(cos
  (th1)*cos(th2));

theorem 
  cos(th1)<>0 & sin(th2)<>0 implies tan(th1)+cot(th2)= cos(th1-th2)/(cos
  (th1)*sin(th2));

theorem 
  cos(th1)<>0 & sin(th2)<>0 implies tan(th1)-cot(th2)= -cos(th1+th2)/(
  cos(th1)*sin(th2));

theorem 
  sin(th1)<>0 & sin(th2)<>0 implies cot(th1)+cot(th2) = sin(th1+th2)/(
  sin(th1)*sin(th2));

theorem 
  sin(th1)<>0 & sin(th2)<>0 implies cot(th1)-cot(th2)= -sin(th1-th2)/(
  sin(th1)*sin(th2));

theorem 
  sin(th1+th2)+sin(th1-th2) = 2*(sin(th1)*cos(th2));

theorem 
  sin(th1+th2)-sin(th1-th2) = 2*(cos(th1)*sin(th2));

theorem 
  cos(th1+th2)+cos(th1-th2) = 2*(cos(th1)*cos(th2));

theorem 
  cos(th1+th2)-cos(th1-th2) = -2*(sin(th1)*sin(th2));

theorem 
  sin(th1)*sin(th2) = -(1/2)*(cos(th1+th2)-cos(th1-th2));

theorem 
  sin(th1)*cos(th2)= (1/2)*(sin(th1+th2)+sin(th1-th2));

theorem 
  cos(th1)*sin(th2)= (1/2)*(sin(th1+th2)-sin(th1-th2));

theorem 
  cos(th1)*cos(th2)= (1/2)*(cos(th1+th2)+cos(th1-th2));

theorem 
  sin(th1)*sin(th2)*sin(th3) = (1/4) *(sin(th1+th2-th3)+sin(th2+th3-th1)
  +sin(th3+th1-th2)-sin(th1+th2+th3));

theorem 
  sin(th1)*sin(th2)*cos(th3) = (1/4) *(-cos(th1+th2-th3)+cos(th2+th3-th1
  )+cos(th3+th1-th2)-cos(th1+th2+th3));

theorem 
  sin(th1)*cos(th2)*cos(th3) = (1/4) *(sin(th1+th2-th3)-sin(th2+th3-th1)
  +sin(th3+th1-th2)+sin(th1+th2+th3));

theorem 
  cos(th1)*cos(th2)*cos(th3) = (1/4) *(cos(th1+th2-th3)+cos(th2+th3-th1)
  +cos(th3+th1-th2)+cos(th1+th2+th3));

theorem 
  sin(th1+th2)*sin(th1-th2) = sin(th1)*sin(th1)-sin(th2)*sin(th2);

theorem 
  sin(th1+th2)*sin(th1-th2)= cos(th2)*cos(th2)-cos(th1)*cos(th1);

theorem 
  sin(th1+th2)*cos(th1-th2) = sin(th1)*cos(th1)+sin(th2)*cos(th2);

theorem 
  cos(th1+th2)*sin(th1-th2) = sin(th1)*cos(th1)-sin(th2)*cos(th2);

theorem 
  cos(th1+th2)*cos(th1-th2)= cos(th1)*cos(th1)-sin(th2)*sin(th2);

theorem 
  cos(th1+th2)*cos(th1-th2) = cos(th2)*cos(th2)-sin(th1)*sin(th1);

theorem 
  cos(th1)<>0 & cos(th2)<>0 implies sin(th1+th2)/sin(th1-th2)= (tan(th1)
  +tan(th2))/(tan(th1)-tan(th2));

theorem 
  cos(th1) <> 0 & cos(th2) <> 0 implies cos(th1+th2)/cos(th1-th2) = (1-
  tan(th1)*tan(th2))/(1+tan(th1)*tan(th2));

theorem 
  (sin(th1)+sin(th2))/(sin(th1)-sin(th2)) = tan((th1+th2)/2)*cot((th1- th2)/2 )
;

theorem 
  cos((th1-th2)/2)<>0 implies (sin(th1)+sin(th2))/(cos(th1)+cos(th2)) =
  tan((th1+th2)/2);

theorem 
  cos((th1+th2)/2)<>0 implies (sin(th1)-sin(th2))/(cos(th1)+cos(th2)) =
  tan((th1-th2)/2);

theorem 
  sin((th1+th2)/2)<>0 implies (sin(th1)+sin(th2))/(cos(th2)-cos(th1)) =
  cot((th1-th2)/2);

theorem 
  sin((th1-th2)/2)<>0 implies (sin(th1)-sin(th2))/(cos(th2)-cos(th1)) =
  cot((th1+th2)/2);

theorem 
  (cos(th1)+cos(th2))/(cos(th1)-cos(th2)) = cot((th1+th2)/2)*cot((th2- th1)/2);














begin

reserve x,x1,x2,x3 for real number;

theorem 
  cos(x)<>0 implies cosec(x)=sec(x)/tan(x);

theorem 
  sin(x)<>0 implies cos(x) = sin(x)*cot(x);

theorem 
  sin(x1)<>0 & sin(x2)<>0 & sin(x3)<>0 implies sin(x1+x2+x3)=sin(x1)*sin
  (x2)*sin(x3)*(cot(x2)*cot(x3)+ cot(x1)*cot(x3)+cot(x1)*cot(x2)-1);

theorem 
  sin(x1)<>0 & sin(x2)<>0 & sin(x3)<>0 implies cos(x1+x2+x3)=-sin(x1)*
  sin(x2)*sin(x3)*(cot(x1)+cot(x2)+cot(x3)- cot(x1)*cot(x2)*cot(x3));

theorem 
  sin(2*x) = 2*sin(x)*cos(x);

theorem 
  cos(x)<>0 implies sin(2*x)=(2*tan(x))/(1+(tan(x))^2);

theorem 
  cos(2*x)=(cos(x))^2-(sin(x))^2 & cos(2*x)=2*(cos(x))^2-1 & cos(2*
  x)=1-2*(sin(x))^2;

theorem 
  cos(x)<>0 implies cos(2*x)=(1-(tan(x))^2)/(1+(tan(x))^2);

theorem 
  cos(x)<>0 implies tan(2*x)=(2*tan(x))/(1-(tan(x))^2);

theorem 
  sin(x)<>0 implies cot(2*x)=((cot(x))^2-1)/(2*cot(x));

theorem 
  cos(x)<>0 implies (sec x)^2 = 1 + (tan x)^2;

theorem 
  cot(x) = 1/tan(x);

theorem 
  cos(x)<>0 & sin(x)<>0 implies sec(2*x) = (sec(x))^2/(1-(tan(x))
  ^2) & sec(2*x)=(cot(x)+tan(x))/(cot(x)-tan(x));

theorem 
  sin(x)<>0 implies (cosec(x))^2 = 1 +(cot(x))^2;

theorem 
  cos(x)<>0 & sin(x)<>0 implies cosec(2*x)=sec(x)*cosec(x)/2 & cosec(2*x
  )=(tan(x)+cot(x))/2;

theorem 
  sin(3*x)=-4*(sin(x))|^3+3*sin(x);

theorem 
  cos(3*x)=4*(cos(x))|^3-3*cos(x);

theorem 
  cos(x)<>0 implies tan(3*x)=(3*tan(x)-(tan(x))|^3)/(1-3*(tan(x))^2);

theorem 
  sin(x)<>0 implies cot(3*x)=((cot(x))|^3-3*cot(x))/(3*(cot(x))^2-1);

theorem 
  (sin(x))^2=(1-cos(2*x))/2;

theorem 
  (cos(x))^2=(1+cos(2*x))/2;

theorem 
  (sin(x))|^3=(3*sin(x)-sin(3*x))/4;

theorem 
  (cos(x))|^3=(3*cos(x)+cos(3*x))/4;

theorem 
  (sin(x))|^4=(3-4*cos(2*x)+cos(4*x))/8;

theorem 
  (cos(x))|^4 = (3+4*cos(2*x)+cos(4*x))/8;



theorem 
  sin(x/2)=sqrt((1-cos(x))/2) or sin(x/2)=-sqrt((1-cos(x))/2);

theorem 
  cos(x/2)=sqrt((1+cos(x))/2) or cos(x/2)=-sqrt((1+cos(x))/2);

theorem 
  sin(x/2)<>0 implies tan(x/2)=(1-cos(x))/sin(x);

theorem 
  cos(x/2)<>0 implies tan(x/2)=sin(x)/(1+cos(x));

theorem 
  tan(x/2)=sqrt((1-cos(x))/(1+cos(x))) or tan(x/2)=-sqrt((1-cos(x))/(1+
  cos(x)));

theorem 
  cos(x/2)<>0 implies cot(x/2)=(1+cos(x))/sin(x);

theorem 
  sin(x/2)<>0 implies cot(x/2)=sin(x)/(1-cos(x));

theorem 
  cot(x/2) = sqrt((1+cos(x))/(1-cos(x))) or cot(x/2) =-sqrt((1+cos(x))/(
  1-cos(x)));

theorem 
  sin(x/2)<>0 & cos(x/2)<>0 & 1-(tan(x/2))^2<>0 implies sec(x/2)= sqrt((
  2*sec(x))/(sec(x)+1)) or sec(x/2)=-sqrt((2*sec(x))/(sec(x)+1));

theorem 
  sin(x/2)<>0 & cos(x/2)<>0 & 1-(tan(x/2))^2<>0 implies cosec(x/2)= sqrt
  ((2*sec(x))/(sec(x)-1)) or cosec(x/2)=-sqrt((2*sec(x))/(sec(x)-1));

definition
  let x;
  func coth(x) -> Real equals

  cosh(x)/sinh(x);
  func sech(x) -> Real equals

  1/cosh(x);
  func cosech(x) -> Real equals

  1/sinh(x);
end;

theorem 
  coth(x)=(exp_R(x)+exp_R(-x))/(exp_R(x)-exp_R(-x)) & sech(x)=2/(
  exp_R(x)+exp_R(-x)) & cosech(x)=2/(exp_R(x)-exp_R(-x));

theorem 
  exp_R(x)-exp_R(-x)<>0 implies tanh(x)*coth(x)=1;

theorem 
  (sech(x))^2+(tanh(x))^2=1;

theorem 
  sinh x <> 0 implies (coth x)^2-(cosech x)^2=1;

theorem 
  sinh(x1)<>0 & sinh(x2)<>0 implies coth(x1+x2)=(1+coth(x1)*coth(
  x2))/(coth(x1)+coth(x2));

theorem 
  sinh(x1)<>0 & sinh(x2)<>0 implies coth(x1-x2)=(1-coth(x1)*coth(x2))/(
  coth(x1)-coth(x2));

theorem 
  sinh(x1)<>0 & sinh(x2)<>0 implies coth(x1)+coth(x2)=sinh(x1+x2)/(sinh(
  x1)*sinh(x2)) & coth(x1)-coth(x2)=-(sinh(x1-x2))/(sinh(x1)*sinh(x2));

theorem 
  sinh(3*x)=3*sinh(x)+4*(sinh(x))|^3;

theorem 
  cosh(3*x)=4*(cosh(x))|^3-3*cosh(x);

theorem 
  sinh(x)<>0 implies coth(2*x)=(1+(coth(x))^2)/(2*coth(x));

theorem 
  x >= 0 implies sinh x >= 0;

theorem 
  x<=0 implies sinh x<=0;

theorem 
  cosh(x/2)=sqrt((cosh(x)+1)/2);

theorem 
  sinh(x/2)<>0 implies tanh(x/2)=(cosh(x)-1)/(sinh(x));

theorem 
  cosh(x/2)<>0 implies tanh(x/2)=(sinh(x))/(cosh(x)+1);

theorem 
  sinh(x/2)<>0 implies coth(x/2)=(sinh(x))/(cosh(x)-1);

theorem 
  cosh(x/2)<>0 implies coth(x/2)=(cosh(x)+1)/(sinh(x));














begin 

reserve c, c1, d for Real,
  k, n, m, N, n1, N1, N2, N3, N4, N5, M for Element of NAT,
  x for set;

scheme 

  FinSegRng1{m, n() -> Nat, X() -> non empty set, F(set) -> Element of X()} :
  {F(i) where i is Element of NAT: m() <= i & i <= n()} is finite non empty
  Subset of X()
provided
 m() <= n();

scheme 

  FinImInit1{N() -> Nat, X() -> non empty set, F(set) -> Element of X()} : {F(
n) where n is Element of NAT: n <= N()} is finite non empty Subset of X();

scheme 

  FinImInit2{N() -> Nat, X() -> non empty set, F(set) -> Element of X()} : {F(
  n) where n is Element of NAT: n < N()} is finite non empty Subset of X()
provided
 N() > 0;

definition
  let c be real number;

  attr c is logbase means


  c > 0 & c <> 1;
end;

registration
  cluster positive for Real;
  cluster negative for Real;
  cluster logbase for Real;
  cluster non negative for Real;
  cluster non positive for Real;
  cluster non logbase for Real;
end;

definition
  let f be Real_Sequence;
  attr f is eventually-nonnegative means


  ex N st for n st n >= N holds f.n >= 0;
  attr f is positive means


  for n holds f.n > 0;
  attr f is eventually-positive means


  ex N st for n st n >= N holds f.n > 0;
  attr f is eventually-nonzero means


  ex N st for n st n >= N holds f.n <> 0;
  attr f is eventually-nondecreasing means


  ex N st for n st n >= N holds f.n <= f.(n+1);
end;

registration
  cluster eventually-nonnegative eventually-nonzero positive
    eventually-positive eventually-nondecreasing for Real_Sequence;
end;

registration
  cluster positive -> eventually-positive for Real_Sequence;
  cluster eventually-positive -> eventually-nonnegative eventually-nonzero
    for Real_Sequence;
  cluster eventually-nonnegative eventually-nonzero -> eventually-positive
    for Real_Sequence;
end;

definition
  let f,g be eventually-nonnegative Real_Sequence;
  redefine func f+g -> eventually-nonnegative Real_Sequence;
end;

definition
  let f be eventually-nonnegative Real_Sequence, c be positive Real;
  redefine func c(#)f -> eventually-nonnegative Real_Sequence;
end;

definition
  let f be eventually-nonnegative Real_Sequence, c be non negative Real;
  redefine func c+f -> eventually-nonnegative Real_Sequence;
end;

definition
  let f be eventually-nonnegative Real_Sequence, c be positive Real;
  redefine func c+f -> eventually-positive Real_Sequence;
end;

definition
  let f,g be Real_Sequence;
  func max(f, g) -> Real_Sequence means


  for n holds it.n = max( f.n, g .n );
  commutativity;
end;

registration
  let f be Real_Sequence, g be eventually-nonnegative Real_Sequence;
  cluster max(f, g) -> eventually-nonnegative;
end;

registration
  let f be Real_Sequence, g be eventually-positive Real_Sequence;
  cluster max(f, g) -> eventually-positive;
end;

definition
  let f,g be Real_Sequence;
  pred g majorizes f means


  ex N st for n st n >= N holds f.n <= g.n;
end;

theorem 
  for f being Real_Sequence, N being Element of NAT st for n st n
>= N holds f.n <= f.(n+1) holds for n,m being Element of NAT st N <= n & n <= m
  holds f.n <= f.m;

theorem 
  for f,g being eventually-positive Real_Sequence st f/"g is
convergent & lim(f/"g) <> 0 holds g/"f is convergent & lim(g/"f) = (lim(f/"g))"
;

theorem 
  for f being eventually-nonnegative Real_Sequence st f is
  convergent holds 0 <= lim f;

theorem 
  for f,g being Real_Sequence st f is convergent & g is convergent
  & g majorizes f holds lim(f) <= lim(g);

theorem 
  for f being Real_Sequence, g being eventually-nonzero
Real_Sequence st f/"g is divergent_to+infty holds g/"f is convergent & lim(g/"f
  )=0;

begin 

definition
  let f be eventually-nonnegative Real_Sequence;
  func Big_Oh(f) -> FUNCTION_DOMAIN of NAT, REAL equals

  { t where t is Element
of Funcs(NAT, REAL) : ex c,N st c > 0 & for n st n >= N holds t.n <= c*f.n & t.
  n >= 0 };
end;

theorem 
  for x being set, f being eventually-nonnegative Real_Sequence st
  x in Big_Oh(f) holds x is eventually-nonnegative Real_Sequence;

theorem 
  for f being positive Real_Sequence, t being eventually-nonnegative
Real_Sequence holds t in Big_Oh(f) iff ex c st c > 0 & for n holds t.n <= c*f.n
;

theorem 
  for f being eventually-positive Real_Sequence, t being
eventually-nonnegative Real_Sequence, N being Element of NAT st t in Big_Oh(f)
& for n st n >= N holds f.n > 0 holds ex c st c > 0 & for n st n >= N holds t.n
  <= c*f.n;

theorem 
  for f,g being eventually-nonnegative Real_Sequence holds Big_Oh( f + g
  ) = Big_Oh( max( f, g ) );

theorem 
  for f being eventually-nonnegative Real_Sequence holds f in Big_Oh(f);

theorem 
  for f,g being eventually-nonnegative Real_Sequence st f in
  Big_Oh(g) holds Big_Oh(f) c= Big_Oh(g);

theorem 
  for f,g,h being eventually-nonnegative Real_Sequence holds f in
  Big_Oh(g) & g in Big_Oh(h) implies f in Big_Oh(h);

theorem 
  for f being eventually-nonnegative Real_Sequence, c being positive
  Real holds Big_Oh(f) = Big_Oh(c(#)f);

theorem 



  for c being non negative Real, x,f being eventually-nonnegative
  Real_Sequence holds x in Big_Oh(f) implies x in Big_Oh(c+f);

theorem 
  for f,g being eventually-positive Real_Sequence st f/"g is
  convergent & lim( f/"g ) > 0 holds Big_Oh(f) = Big_Oh(g);

theorem 
  for f,g being eventually-positive Real_Sequence st f/"g is
  convergent & lim( f/"g )=0 holds f in Big_Oh(g) & not g in Big_Oh(f);

theorem 
  for f,g being eventually-positive Real_Sequence st f/"g is
  divergent_to+infty holds not f in Big_Oh(g) & g in Big_Oh(f);

begin 

definition
  let f be eventually-nonnegative Real_Sequence;
  func Big_Omega(f) -> FUNCTION_DOMAIN of NAT, REAL equals

  { t where t is
Element of Funcs(NAT, REAL) : ex d,N st d > 0 & for n st n >= N holds t.n >= d*
  f.n & t.n >= 0 };
end;

theorem 
  for x being set, f being eventually-nonnegative Real_Sequence st x in
  Big_Omega(f) holds x is eventually-nonnegative Real_Sequence;

theorem 
  for f,g being eventually-nonnegative Real_Sequence holds f in
  Big_Omega(g) iff g in Big_Oh(f);

theorem 
  for f being eventually-nonnegative Real_Sequence holds f in Big_Omega(f);

theorem 
  for f,g,h being eventually-nonnegative Real_Sequence holds f in
  Big_Omega(g) & g in Big_Omega(h) implies f in Big_Omega(h);

theorem 
  for f,g being eventually-positive Real_Sequence st f/"g is convergent
  & lim( f/"g ) > 0 holds Big_Omega(f) = Big_Omega(g);

theorem 
  for f,g being eventually-positive Real_Sequence st f/"g is
  convergent & lim( f/"g ) = 0 holds g in Big_Omega(f) & not f in Big_Omega(g);

theorem 
  for f,g being eventually-positive Real_Sequence st f/"g is
  divergent_to+infty holds not g in Big_Omega(f) & f in Big_Omega(g);

theorem 
  for f,t being positive Real_Sequence holds t in Big_Omega(f) iff ex d
  st d > 0 & for n holds d*f.n <= t.n;

theorem 
  for f,g being eventually-nonnegative Real_Sequence holds Big_Omega(f+g
  ) = Big_Omega(max(f,g));

definition
  let f be eventually-nonnegative Real_Sequence;
  func Big_Theta(f) -> FUNCTION_DOMAIN of NAT, REAL equals

  Big_Oh(f) /\
  Big_Omega(f);
end;

theorem 
  for f being eventually-nonnegative Real_Sequence holds Big_Theta
(f) = { t where t is Element of Funcs(NAT, REAL) : ex c,d,N st c > 0 & d > 0 &
  for n st n >= N holds d*f.n <= t.n & t.n <= c*f.n };

theorem 
  for f being eventually-nonnegative Real_Sequence holds f in Big_Theta( f);

theorem 
  for f,g being eventually-nonnegative Real_Sequence st f in Big_Theta(g
  ) holds g in Big_Theta(f);

theorem 
  for f,g,h being eventually-nonnegative Real_Sequence st f in Big_Theta
  (g) & g in Big_Theta(h) holds f in Big_Theta(h);

theorem 
  for f,t being positive Real_Sequence holds t in Big_Theta(f) iff ex c,
  d st c > 0 & d > 0 & for n holds d*f.n <= t.n & t.n <= c*f.n;

theorem 
  for f,g being eventually-nonnegative Real_Sequence holds Big_Theta(f+g
  ) = Big_Theta(max(f,g));

theorem 
  for f,g being eventually-positive Real_Sequence st f/"g is convergent
  & lim( f/"g ) > 0 holds f in Big_Theta(g);

theorem 
  for f,g being eventually-positive Real_Sequence st f/"g is convergent
  & lim( f/"g ) = 0 holds f in Big_Oh(g) & not f in Big_Theta(g);

theorem 
  for f,g being eventually-positive Real_Sequence st f/"g is
  divergent_to+infty holds f in Big_Omega(g) & not f in Big_Theta(g);

begin 

definition
  let f be eventually-nonnegative Real_Sequence, X be set;
  func Big_Oh(f,X) -> FUNCTION_DOMAIN of NAT, REAL equals

  { t where t is
Element of Funcs(NAT, REAL) : ex c,N st c > 0 & for n st n >= N & n in X holds
  t.n <= c*f.n & t.n >= 0 };
end;

definition
  let f be eventually-nonnegative Real_Sequence, X be set;
  func Big_Omega(f,X) -> FUNCTION_DOMAIN of NAT, REAL equals

  { t where t is
Element of Funcs(NAT, REAL) : ex d,N st d > 0 & for n st n >= N & n in X holds
  t.n >= d*f.n & t.n >= 0 };
end;

definition
  let f be eventually-nonnegative Real_Sequence, X be set;
  func Big_Theta(f,X) -> FUNCTION_DOMAIN of NAT, REAL equals

  { t where t is
  Element of Funcs(NAT, REAL) : ex c,d,N st c > 0 & d > 0 & for n st n >= N & n
  in X holds d*f.n <= t.n & t.n <= c*f.n };
end;

theorem 
  for f being eventually-nonnegative Real_Sequence, X being set
  holds Big_Theta(f,X) = Big_Oh(f,X) /\ Big_Omega(f,X);

definition 
  let f be Real_Sequence, b be Element of NAT;
  func f taken_every b -> Real_Sequence means


  for n holds it.n = f.(b* n);
end;

definition
  let f be eventually-nonnegative Real_Sequence, b be Element of NAT;
  pred f is_smooth_wrt b means


  f is eventually-nondecreasing & f taken_every b in Big_Oh(f);
end;

definition
  let f be eventually-nonnegative Real_Sequence;
  attr f is smooth means


  for b being Element of NAT st b >= 2 holds f is_smooth_wrt b;
end;

theorem 
  for f being eventually-nonnegative Real_Sequence st ex b being Element
  of NAT st b >= 2 & f is_smooth_wrt b holds f is smooth;

theorem 
  for f being eventually-nonnegative Real_Sequence, t being
eventually-nonnegative eventually-nondecreasing Real_Sequence, b being Element
  of NAT st f is smooth & b >= 2 & t in Big_Oh(f, { b|^n where n is Element of
  NAT : not contradiction } ) holds t in Big_Oh(f);

theorem 
  for f being eventually-nonnegative Real_Sequence, t being
eventually-nonnegative eventually-nondecreasing Real_Sequence, b being Element
of NAT st f is smooth & b >= 2 & t in Big_Omega(f, { b|^n where n is Element of
  NAT : not contradiction } ) holds t in Big_Omega(f);

theorem 
  for f being eventually-nonnegative Real_Sequence, t being
eventually-nonnegative eventually-nondecreasing Real_Sequence, b being Element
of NAT st f is smooth & b >= 2 & t in Big_Theta(f, { b|^n where n is Element of
  NAT : not contradiction } ) holds t in Big_Theta(f);



begin 

definition
  let X be non empty set, F,G be FUNCTION_DOMAIN of X,REAL;
  func F + G -> FUNCTION_DOMAIN of X,REAL equals

  { t where t is Element of
Funcs(X,REAL) : ex f,g being Element of Funcs(X,REAL) st f in F & g in G & for
  n being Element of X holds t.n = f.n + g.n };
end;

definition 
  let X be non empty set, F,G be FUNCTION_DOMAIN of X,REAL;
  func max(F, G) -> FUNCTION_DOMAIN of X,REAL equals

  { t where t is Element of
Funcs(X,REAL) : ex f,g being Element of Funcs(X,REAL) st f in F & g in G & for
  n being Element of X holds t.n = max(f.n, g.n) };
end;

theorem 
  for f,g being eventually-nonnegative Real_Sequence holds Big_Oh(f) +
  Big_Oh(g) = Big_Oh(f+g);

theorem 
  for f,g being eventually-nonnegative Real_Sequence holds max(Big_Oh(f)
  , Big_Oh(g)) = Big_Oh(max(f,g));

definition 
  let F,G be FUNCTION_DOMAIN of NAT,REAL;
  func F to_power G -> FUNCTION_DOMAIN of NAT,REAL equals

  { t where t is
  Element of Funcs(NAT,REAL) : ex f,g being Element of Funcs(NAT,REAL), N being
Element of NAT st f in F & g in G & for n being Element of NAT st n >= N holds
  t.n = (f.n) to_power (g.n) };
end;














begin

reserve x for real number;

scheme 

  Regrwithout0 { P[Nat] } : P[1]
provided
 ex k be non empty Nat st P[k] and
 for k be non empty Nat st k <> 1 & P[k] ex n be non empty Nat st n <
k & P[n];

theorem 
  for z be complex number holds Re z >= -|.z.|;

theorem 
  for z be complex number holds Im z >= -|.z.|;

theorem 
  for z be complex number holds |.z.|^2 = (Re z)^2 + (Im z)^2;

theorem 
  for n be Nat st x >= 0 & n <> 0 holds (n-root x) |^ n = x;

registration
  cluster PI -> non negative;
end;

begin

theorem 
  0 < PI/2 & PI/2 < PI & 0 < PI & -PI/2 < PI/2 & PI < 2*PI & PI/2 < 3/2*
PI & -PI/2 < 0 & 0 < 2*PI & PI < 3/2*PI & 3/2*PI < 2*PI & 0 < 3/2*PI;

theorem 
  for a,b,c,x be real number st x in ].a,c.[ holds x in ].a,b.[ or
  x = b or x in ].b,c.[;

theorem 
  x in ].0,PI.[ implies sin.x > 0;

theorem 
  x in [.0,PI.] implies sin.x >= 0;

theorem 
  x in ].PI,2*PI.[ implies sin.x < 0;

theorem 
  x in [.PI,2*PI.] implies sin.x <= 0;

theorem 
  x in ].-PI/2,PI/2.[ implies cos.x > 0;

theorem 
  x in [.-PI/2,PI/2.] implies cos.x >= 0;

theorem 
  x in ].PI/2,3/2*PI.[ implies cos.x < 0;

theorem 
  x in [.PI/2,3/2*PI.] implies cos.x <= 0;

theorem 
  x in ].3/2*PI,2*PI.[ implies cos.x > 0;

theorem 
  x in [.3/2*PI,2*PI.] implies cos.x >= 0;

theorem 
  0 <= x & x < 2*PI & sin x = 0 implies x = 0 or x = PI;

theorem 
  0 <= x & x < 2*PI & cos x = 0 implies x = PI/2 or x = 3/2*PI;

theorem 
  sin|].-PI/2,PI/2.[ is increasing;

theorem 
  sin|].PI/2,3/2*PI.[ is decreasing;

theorem 
  cos|].0,PI.[ is decreasing;

theorem 
  cos|].PI,2*PI.[ is increasing;

theorem 
  sin|[.-PI/2,PI/2.] is increasing;

theorem 
  sin|[.PI/2,3/2*PI.] is decreasing;

theorem 
  cos|[.0,PI.] is decreasing;

theorem 
  cos|[.PI,2*PI.] is increasing;

theorem 
  sin.x in [.-1,1 .] & cos.x in [.-1,1 .];

theorem 
  rng sin = [.-1,1 .];

theorem 
  rng cos = [.-1,1 .];

theorem 
  rng (sin|[.-PI/2,PI/2.]) = [.-1,1 .];

theorem 
  rng (sin|[.PI/2,3/2*PI.]) = [.-1,1 .];

theorem 
  rng (cos|[.0,PI.]) = [.-1,1 .];

theorem 
  rng (cos|[.PI,2*PI.]) = [.-1,1 .];

begin  

definition
  let z be complex number;
  func Arg z -> Real means


  z = |.z.|*cos it + |.z.|*sin it * <i> & 0 <=
  it & it < 2*PI if z <> 0 otherwise it = 0;
end;

theorem 
  for z be complex number holds 0 <= Arg z & Arg z < 2*PI;

theorem 
  for x be Real st x >= 0 holds Arg x = 0;

theorem 
  for x be Real st x < 0 holds Arg x = PI;

theorem 
  for x be Real st x > 0 holds Arg (x*<i>) = PI/2;

theorem 
  for x be Real st x < 0 holds Arg (x*<i>) = 3/2*PI;

theorem 
  Arg 1 = 0;

theorem 
  Arg <i> = PI/2;

theorem 
  for z be complex number holds Arg z in ].0,PI/2.[ iff Re z > 0 & Im z > 0;

theorem 
  for z be complex number holds Arg z in ].PI/2,PI.[ iff Re z < 0 & Im z > 0;

theorem 
  for z be complex number holds Arg z in ].PI,3/2*PI.[ iff Re z < 0 & Im z < 0;

theorem 
  for z be complex number holds Arg z in ].3/2*PI,2*PI.[ iff Re z
  > 0 & Im z < 0;

theorem 
  for z be complex number st Im z > 0 holds sin Arg z > 0;

theorem 
  for z be complex number st Im z < 0 holds sin Arg z < 0;

theorem 
  for z be complex number st Im z >= 0 holds sin Arg z >= 0;

theorem 
  for z be complex number st Im z <= 0 holds sin Arg z <= 0;

theorem 
  for z be complex number st Re z > 0 holds cos Arg z > 0;

theorem 
  for z be complex number st Re z < 0 holds cos Arg z < 0;

theorem 
  for z be complex number st Re z >= 0 holds cos Arg z >= 0;

theorem 
  for z be complex number st Re z <= 0 & z <> 0 holds cos Arg z <= 0;

theorem 
  for x be real number, n be Nat holds (cos x+(sin x)*<i>)|^n =
  cos (n*x)+sin (n*x)*<i>;

theorem 
  for z be Element of COMPLEX for n be Nat st z <> 0 or n <> 0 holds z|^
  n = (|.z.| |^ n)*cos (n*Arg z)+(|.z.| |^ n)*sin (n*Arg z)*<i>;

theorem 
  for x be Real, n,k be Nat st n <> 0 holds (cos((x+2*PI*k)/n)+sin
  ((x+2*PI*k)/n)*<i>)|^n = (cos x+(sin x)*<i>);

theorem 
  for z be complex number for n,k be Nat st n <> 0 holds z = ((n
-root |.z.|)*cos((Arg z+2*PI*k)/n)+ (n-root |.z.|)*sin((Arg z+2*PI*k)/n)*<i>)|^
  n;

definition
  let x be complex number;
  let n be non empty Nat;
  mode CRoot of n,x -> complex number means


    it|^n = x;
end;

theorem 
  for x be Element of COMPLEX for n be non empty Nat for k be Nat holds
(n-root |. x .|)*cos((Arg x+2*PI*k)/n)+ (n-root |. x .|)*sin((Arg x+2*PI*k)/n)*
  <i> is CRoot of n,x;

theorem 
  for x be Element of COMPLEX for v be CRoot of 1,x holds v = x;

theorem 
  for n be non empty Nat for v be CRoot of n,0 holds v = 0;

theorem 
  for n be non empty Nat for x be Element of COMPLEX for v be CRoot of n
  ,x st v = 0 holds x = 0;

theorem 
  for a being real number st 0 <= a & a < 2*PI & cos(a) = 1 holds a = 0;

theorem 
  for z being complex number holds z = |.z.|*cos Arg z + |.z.|*sin Arg z * <i>;














begin

theorem 
  for a, b being real number st b > 0 ex r being real number st r =
  b*-[\ a/b /]+a & 0 <= r & r < b;

theorem 
  for a, b, c being real number st a > 0 & b >= 0 & c >= 0 & b < a
  & c < a for i being Integer st b = c + a*i holds b = c;

theorem 
  for a, b being real number holds sin(a-b) = sin(a)*cos(b)-cos(a)*
  sin(b) & cos(a-b) = cos(a)*cos(b)+sin(a)*sin(b);

theorem 
  for a being real number holds sin.(a-PI) = -sin.a & cos.(a-PI) = -cos. a;

theorem 
  for a being real number holds sin(a-PI) = -sin a & cos(a-PI) = - cos a;

theorem 
  for a, b being real number st a in ].0,PI/2.[ & b in ].0,PI/2.[
  holds a < b iff sin a < sin b;

theorem 
  for a, b being real number st a in ].PI/2,PI.[ & b in ].PI/2,PI.[
  holds a < b iff sin a > sin b;

theorem 
  for a being real number, i being Integer holds sin a = sin (2*PI* i+a);

theorem 
  for a being real number, i being Integer holds cos a = cos (2*PI *i+a);

theorem 
  for a being real number st sin a = 0 holds cos a <> 0;

theorem 
  for a, b being real number st 0 <= a & a < 2*PI & 0 <= b & b < 2
  *PI & sin a = sin b & cos a = cos b holds a = b;

begin 


theorem 
  for z being complex number holds z = |.z.|*cos Arg z + |.z.|*sin Arg z *<i>;

theorem 
  for z being complex number st z <> 0 holds (Arg z < PI implies
  Arg -z = Arg z +PI) & (Arg z >= PI implies Arg -z = Arg z -PI);

theorem 
  for r being Real st r >= 0 holds Arg r = 0;

theorem 
  for z being complex number holds Arg z = 0 iff z = |.z.|;

theorem 
  for z being complex number st z <> 0 holds Arg(z) < PI iff Arg - z >= PI;

theorem 
  for x, y being complex number st x <> y or x - y <> 0 holds Arg(
  x-y) < PI iff Arg(y-x) >= PI;

theorem 
  for z being complex number holds Arg z in ].0,PI.[ iff Im z > 0;

theorem 
  for z being complex number st Arg z <> 0 holds Arg z < PI iff sin Arg z> 0;

theorem 
  for x, y being complex number st Arg x < PI & Arg y < PI holds Arg(x+y ) < PI
;

theorem 
  for z being complex number holds Arg z = 0 iff Re z >= 0 & Im z = 0;

theorem 
  for z being complex number holds Arg z = PI iff Re z < 0 & Im z= 0;

theorem 
  for z being complex number holds Im z = 0 iff Arg z = 0 or Arg z = PI;

theorem 
  for z being complex number st Arg z <= PI holds Im z >= 0;

theorem 
  for z being Element of COMPLEX st z <> 0 holds cos Arg -z = -cos
  Arg z & sin Arg -z = - sin Arg z;

theorem 
  for a being complex number st a <> 0 holds cos Arg a = Re a / |.
  a.| & sin Arg a = Im a / |.a.|;

theorem 
  for a being complex number, r being Real st r > 0 holds Arg(a*r) = Arg a;

theorem 
  for a being complex number, r being Real st r < 0 holds Arg(a*r) = Arg -a;

begin 

definition
  let x, y be complex number;

  func x .|. y -> Element of COMPLEX equals

  x*(y*');
end;

reserve a, b, c, d, x, y, z for Element of COMPLEX;

theorem 
  x.|.y = (Re x)*(Re y)+(Im x)*(Im y) + (-(Re x)*(Im y)+(Im x)*(Re y))*<i>;

theorem 
  z.|.z = (Re z)*(Re z)+(Im z)*(Im z) & z.|.z = (Re z)^2+(Im z)^2;

theorem 
  z.|.z = |.z.|^2 & |.z.|^2 = Re (z.|.z);

theorem 
  |. x.|.y .| = |.x.|*|.y.|;

theorem 
  x.|.x = 0 implies x = 0;

theorem 
  y.|.x = (x.|.y)*';

theorem 
  (x+y).|.z = x.|.z + y.|.z;

theorem 
  x.|.(y+z) = x.|.y + x.|.z;

theorem 
  (a*x).|.y = a * x.|.y;

theorem 
  x.|.(a*y) = (a*') * x.|.y;

theorem 
  (a*x).|.y = x.|.((a*')*y);

theorem 
  (a*x+b*y).|.z = a * x.|.z + b * y.|.z;

theorem 
  x.|.(a*y + b*z) = (a*') * x.|.y + (b*') * x.|.z;

theorem 
  (-x).|.y = x.|.(-y);

theorem 
  (-x).|.y = - x.|.y;

theorem 
  - x.|.y = x.|.(-y);

theorem 
  (-x).|.(-y) = x.|.y;

theorem 
  (x - y).|.z = x.|.z - y.|.z;

theorem 
  x.|.(y - z) = x.|.y - x.|.z;

theorem 
  (x + y).|.(x + y) = x.|.x + x.|.y + y.|.x + y.|.y;

theorem 
  (x-y).|.(x-y) = x.|.x - x.|.y - y.|.x + y.|.y;

theorem 
  Re (x.|.y) = 0 iff Im (x.|.y) = |.x.|*|.y.| or Im (x.|.y) = -|.x .|*|.y.|;

begin 

definition
  let a be complex number, r be Real;
  func Rotate(a, r) -> Element of COMPLEX equals

  |.a.|*cos (r+Arg a) + |.a.|*
  sin (r+Arg a) *<i>;
end;

reserve r for Real;

theorem 
  Rotate(a, 0) = a;

theorem 
  for a being complex number holds Rotate(a, r) = 0 iff a = 0;

theorem 
  for a being complex number holds |.Rotate(a,r).| = |.a.|;

theorem 
  for a being complex number st a <> 0 ex i being Integer st Arg(
  Rotate(a,r)) = 2*PI*i+(r+Arg(a));

theorem 
  Rotate(a,-Arg a) = |.a.|;

theorem 
  Re Rotate(a,r) = (Re a)*(cos r)-(Im a)*(sin r) & Im Rotate(a,r)
  = (Re a)*(sin r)+(Im a)*(cos r);

theorem 
  Rotate(a+b,r) = Rotate(a,r)+Rotate(b,r);

theorem 
  Rotate(-a,r) = -Rotate(a,r);

theorem 
  Rotate(a-b,r) = Rotate(a,r)-Rotate(b,r);

theorem 
  Rotate(a, PI) = -a;

begin 

definition
  let a, b be complex number;
  func angle(a,b) -> Real equals


  Arg(Rotate(b, -Arg a)) if Arg a = 0 or
  b <> 0 otherwise 2*PI - Arg a;
end;

theorem 
  for a being complex number holds r >= 0 implies angle(r,a) = Arg a;

theorem 
  for a,b being complex number holds Arg a = Arg b & a <> 0 & b <>
  0 implies Arg Rotate(a,r) = Arg Rotate(b,r);

theorem 
  r > 0 implies angle(a,b) = angle(a*r,b*r);

theorem 
  a <> 0 & b <> 0 & Arg a = Arg b implies Arg -a = Arg -b;

theorem 
  a <> 0 & b <> 0 implies angle(a,b) = angle(Rotate(a,r),Rotate(b, r));

theorem 
  r < 0 & a <> 0 & b <> 0 implies angle(a,b) = angle(a*r,b*r);

theorem 
  a <> 0 & b <> 0 implies angle(a,b) = angle(-a,-b);

theorem 
  b <> 0 & angle(a,b) = 0 implies angle(a,-b) = PI;

theorem 
  a <> 0 & b <> 0 implies cos angle(a,b) = Re (a.|.b)/(|.a.|*|.b.|
  ) & sin angle(a,b) = - Im (a.|.b)/(|.a.|*|.b.|);

definition
  let x, y, z be complex number;
  func angle(x,y,z) -> real number equals


  Arg(z-y)-Arg(x-y) if Arg(z-y)
  -Arg(x-y) >= 0 otherwise 2*PI+(Arg(z-y)-Arg(x-y));
end;

theorem 
  0 <= angle(x,y,z) & angle(x,y,z) < 2*PI;

theorem 
  angle(x,y,z)=angle(x-y,0,z-y);

theorem 
  angle(a,b,c) = angle(a+d,b+d,c+d);

theorem 
  angle(a,b) = angle(a,0,b);

theorem 
  angle(x,y,z) = 0 implies Arg(x-y) = Arg(z-y) & angle(z,y,x)=0;

theorem 
  a <> 0 & b <> 0 implies (Re (a.|.b) = 0 iff angle(a,0,b) = PI/2
  or angle(a,0,b) = 3/2*PI);

theorem 
  a <> 0 & b <> 0 implies (Im(a.|.b) = |.a.|*|.b.| or Im(a.|.b) = -|.a.|
  *|.b .| iff angle(a,0,b) = PI/2 or angle(a,0,b) = 3/2*PI);

theorem 
  x <> y & z <> y & (angle(x,y,z) = PI/2 or angle(x,y,z) = 3/2*PI)
  implies |.x-y.|^2+|.z-y.|^2 = |.x-z.|^2;

theorem 
  a <> b & b <> c implies angle(a,b,c) = angle(Rotate(a,r), Rotate
  (b,r), Rotate(c,r));

theorem 
  angle(a,b,a) = 0;

theorem 
  angle(a,b,c) <> 0 iff angle(a,b,c)+angle(c,b,a) = 2*PI;

theorem 
  angle(a,b,c) <> 0 implies angle(c,b,a) <> 0;

theorem 
  angle(a,b,c) = PI implies angle(c,b,a) = PI;

theorem 
  a <> b & a <> c & b <> c implies angle(a,b,c) <> 0 or angle(b,c,
  a) <> 0 or angle(c,a,b) <> 0;

theorem 
  a <> b & b <> c & 0 < angle(a,b,c) & angle(a,b,c) < PI implies
angle(a,b,c)+angle(b,c,a)+angle(c,a,b) = PI & 0 < angle(b,c,a) & 0 < angle(c,a,
  b);

theorem 
  a <> b & b <> c & angle(a,b,c) > PI implies angle(a,b,c)+angle(b
  ,c,a)+angle(c,a,b) = 5*PI & angle(b,c,a) > PI & angle(c,a,b) > PI;

theorem 
  a <> b & b <> c & angle(a,b,c) = PI implies angle(b,c,a) = 0 &
  angle(c,a,b) = 0;

theorem 
  a <> b & a <> c & b <> c & angle(a,b,c) = 0 implies angle(b,c,a
  ) = 0 & angle(c,a,b) = PI or angle(b,c,a) = PI & angle(c,a,b) = 0;

theorem 
  angle(a,b,c)+angle(b,c,a)+angle(c,a,b) = PI or angle(a,b,c)+angle(b,c,
  a)+angle(c,a,b) = 5*PI iff a <> b & a <> c & b <> c;














begin

definition
  let a,b,c,d,e,x be complex number;
  func Polynom(a,b,c,d,e,x) equals

  a*(x |^ 4)+b*(x |^ 3)+c*(x^2)+d*x+e;
end;

registration
  let a,b,c,d,e,x be complex number;
  cluster Polynom(a,b,c,d,e,x) -> complex;
end;

registration
  let a,b,c,d,e,x be real number;
  cluster Polynom(a,b,c,d,e,x) -> real;
end;

theorem 
  for a,c,e,x being real number st a <> 0 & e <> 0 & c^2 - (4*a*e) > 0
holds Polynom(a,0,c,0,e,x) = 0 implies x <> 0 & (x = sqrt((-c + sqrt delta(a,c,
e))/(2*a)) or x = sqrt((-c - sqrt delta(a,c,e))/(2*a)) or x = - sqrt((-c + sqrt
  delta(a,c,e))/(2*a)) or x = - sqrt((-c - sqrt delta(a,c,e))/(2*a)));

theorem 
  for a,b,c,x,y being real number st a <> 0 & y = x + 1/x holds
  Polynom(a,b,c,b,a,x) = 0 implies x <> 0 & a*y^2 + b*y + c - 2*a = 0;

theorem 
  for a,b,c,x,y being real number st a <> 0 & b^2-4*a*c + 8*a^2 > 0 & y
= x + 1/x holds Polynom(a,b,c,b,a,x) = 0 implies for y1,y2 being real number st
  y1 = (-b+sqrt(b^2-4*a*c+8*a^2))/(2*a) & y2 = (-b-sqrt(b^2-4*a*c+8*a^2))/(2*a)
holds x <> 0 & (x = (y1 + sqrt delta(1,(-y1),1))/2 or x = (y2 + sqrt delta(1,(-
y2),1))/2 or x = (y1 - sqrt delta(1,(-y1),1))/2 or x = (y2 - sqrt delta(1,(-y2)
  ,1))/2);

theorem 
  for x being real number holds x|^ 3 = x^2*x & (x|^ 3)*x = x|^ 4 &
  x^2*x^2 = x|^ 4;

theorem 
  for x,y being real number st x+y <> 0 holds (x+y)|^ 4 = (x|^ 3 +
  ((3*y)*x^2+(3*y^2)*x) +y|^ 3)*x + (x|^ 3 + ((3*y)*x^2+(3*y^2)*x) +y|^ 3)*y;

theorem 
  for x,y being real number st x+y <> 0 holds (x+y)|^ 4 = x|^ 4+((4*y)*(
  x|^ 3)+6*y^2*x^2+4*(y|^ 3)*x)+y|^ 4;

theorem 
  for a1,a2,a3,a4,a5,b1,b2,b3,b4,b5 being real number holds (for x
being real number holds Polynom(a1,a2,a3,a4,a5,x) = Polynom(b1,b2,b3,b4,b5,x))
  implies a5=b5 & a1-a2+a3-a4 = b1-b2+b3-b4 & a1+a2+a3+a4 = b1+b2+b3+b4;

theorem 
  for a1,a2,a3,a4,a5,b1,b2,b3,b4,b5 being real number holds (for x
  being real number holds Polynom(a1,a2,a3,a4,a5,x)=Polynom(b1,b2,b3,b4,b5,x))
  implies a1-b1=b3-a3 & a2-b2=b4-a4;

theorem 
  for a1,a2,a3,a4,a5,b1,b2,b3,b4,b5 being real number st (for x
being real number holds Polynom(a1,a2,a3,a4,a5,x) = Polynom(b1,b2,b3,b4,b5,x))
  holds a1 = b1 & a2 = b2 & a3 = b3 & a4 = b4 & a5 = b5;

definition
  let a1,x1,x2,x3,x4,x be real number;
  func Four0(a1,x1,x2,x3,x4,x) equals

  a1*((x-x1)*(x-x2)*(x-x3)*(x-x4));
end;

registration
  let a1,x1,x2,x3,x4,x be real number;
  cluster Four0(a1,x1,x2,x3,x4,x) -> real;
end;

theorem 
  for a1,a2,a3,a4,a5,x,x1,x2,x3,x4 being real number st a1 <> 0
holds (for x being real number holds Polynom(a1,a2,a3,a4,a5,x) = Four0(a1,x1,x2
,x3,x4,x)) implies (a1*(x|^ 4)+a2*(x|^ 3)+a3*x^2+a4*x+a5)/a1 = x^2*x^2-(x1+x2+
  x3)*(x^2*x)+(x1*x3+x2*x3+x1*x2)*x^2 - (x1*x2*x3)*x-((x-x1)*(x-x2)*(x-x3))*x4;

theorem 
  for a1,a2,a3,a4,a5,x,x1,x2,x3,x4 being real number st a1 <> 0
holds (for x being real number holds Polynom(a1,a2,a3,a4,a5,x) = Four0(a1,x1,x2
,x3,x4,x)) implies (a1*(x|^ 4)+a2*(x|^ 3)+a3*x^2+a4*x+a5)/a1 = x|^ 4-(x1+x2+x3+
x4)*x|^ 3 +((x1*x2+x1*x3+x1*x4)+(x2*x3+x2*x4)+x3*x4)*x^2 -(x1*x2*x3+x1*x2*x4+x1
  *x3*x4+x2*x3*x4)*x+(x1*x2*x3*x4);

theorem 
  for a1,a2,a3,a4,a5,x1,x2,x3,x4 being real number st a1 <> 0 & (for x
  being real number holds Polynom(a1,a2,a3,a4,a5,x) = Four0(a1,x1,x2,x3,x4,x))
holds a2/a1 = -(x1+x2+x3+x4) & a3/a1 = (x1*x2+x1*x3+x1*x4)+(x2*x3+x2*x4)+x3*x4
  & a4/a1 = -(x1*x2*x3+x1*x2*x4+x1*x3*x4+x2*x3*x4) & a5/a1 = x1*x2*x3*x4;

theorem 
  for a,k,y being real number st a <> 0 holds (for x being real number
  holds x|^ 4+a|^ 4 = k*a*x*(x^2+a^2)) implies y|^ 4 -k*(y|^ 3)-k*y+1 = 0;















begin

reserve a,b,c,d,a9,b9,c9,d9,y,x1,u,v for Real,
  s,t,h,z,z1,z2,z3,s1,s2,s3 for Element of COMPLEX;

definition
  let z be Element of COMPLEX;
  redefine func z^2 -> Element of COMPLEX equals

  (Re z)^2-(Im z)^2 + 2*(Re z*Im z)*<i>;
end;

definition
  let a,b,c,z;
  redefine func Polynom (a,b,c,z) -> Element of COMPLEX;
end;

theorem 
  a <> 0 & delta(a,b,c) >=0 & Polynom(a,b,c,z) = 0 implies z= (-b+
  sqrt delta(a,b,c))/(2*a) or z= (-b-sqrt delta(a,b,c))/(2*a) or z= -b/(2*a);

theorem 
  a <> 0 & delta(a,b,c) < 0 & Polynom(a,b,c,z) = 0 implies z= -b/(2
*a)+(sqrt (-delta(a,b,c))/(2*a))*<i> or z= -b/(2*a)+(-sqrt (-delta(a,b,c))/(2*a
  ))*<i>;

theorem 
  b <> 0 & (for z holds Polynom(0,b,c,z) = 0) implies z = -c/b;

theorem 
  for a,b,c being Real,z,z1,z2 being complex number st a <> 0 & for z
being complex number holds Polynom(a,b,c,z) = Quard(a,z1,z2,z) holds b/a =-(z1+
  z2) & c/a = z1*z2;

definition
  let z be complex number;
  func z^3 -> Element of COMPLEX equals

  z^2*z;
end;

definition
  let a,b,c,d,z be complex number;
  redefine func Polynom(a,b,c,d,z) equals

  a*z^3 + b*z^2 + c*z + d;
end;

theorem 
  Re z^3 = (Re z)|^3 - 3*Re z*(Im z)^2 & Im z^3 = -(Im z)|^ 3+3*( Re z)^2*Im z;

theorem 
  (for z being complex number holds Polynom(a,b,c,d,z) = Polynom(a9,b9,
  c9,d9,z ) ) implies a = a9 & b = b9 & c = c9 & d = d9;

theorem 
  b<>0 & delta(b,c,d)>=0 & Polynom(0,b,c,d,z)=0 implies z = (-c+sqrt
  delta(b,c,d))/(2*b) or z = (-c-sqrt delta(b,c,d))/(2*b) or z = -c/(2*b);

theorem 
  b<>0 & delta(b,c,d)<0 & Polynom(0,b,c,d,z)=0 implies z = -c/(2*b)+(
sqrt (-delta(b,c,d))/(2*b))*<i> or z = -c/(2*b)+(-sqrt (-delta(b,c,d))/(2*b))*
  <i>;

theorem 
  a<>0 & 4*a*c <= 0 & Polynom(a,0,c,0,z)=0 implies z = (sqrt -4*a*c)/(2*
  a) or z = (-sqrt -4*a*c)/(2*a) or z = 0;

theorem 
  a<>0 & delta(a,b,c)>=0 & Polynom(a,b,c,0,z)=0 implies z = (-b+sqrt
delta(a,b,c))/(2*a) or z = (-b-sqrt delta(a,b,c))/(2*a) or z = -b/(2*a) or z =
  0;

theorem 
  a<>0 & delta(a,b,c)<0 & Polynom(a,b,c,0,z)=0 implies z= -b/(2*a)+(sqrt
(-delta(a,b,c))/(2*a))*<i> or z= -b/(2*a)+(-sqrt (-delta(a,b,c))/(2*a))*<i> or
  z = 0;

theorem 
  y^2 = a implies y = sqrt a or y = -sqrt a;

theorem 
  a<>0 & Im z = 0 & Polynom(a,0,c,d,z)=0 implies for u,v st Re z = u+v &
3*v*u+c/a=0 holds z = 3-root(-d/(2*a)+sqrt(d^2/(4*a^2)+(c/(3*a)) |^ 3)) +3-root
(-d/(2*a)-sqrt(d^2/(4*a^2)+(c/(3*a)) |^ 3)) or z = 3-root(-d/(2*a)+sqrt(d^2/(4*
a^2)+(c/(3*a)) |^ 3)) +3-root(-d/(2*a)+sqrt(d^2/(4*a^2)+(c/(3*a)) |^ 3)) or z =
3-root(-d/(2*a)-sqrt(d^2/(4*a^2)+(c/(3*a)) |^ 3)) +3-root(-d/(2*a)-sqrt(d^2/(4*
  a^2)+(c/(3*a)) |^ 3));

theorem 
  a<>0 & Im z <> 0 & Polynom(a,0,c,d,z)=0 implies for u,v st Re z = u+v
& 3*v*u+c/(4*a)=0 holds z=3-root(d/(16*a)+sqrt((d/(16*a))^2+(c/(12*a)) |^ 3)) +
  3-root(d/(16*a)-sqrt((d/(16*a))^2+(c/(12*a)) |^ 3))+ sqrt(3*(3-root(d/(16*a)+
sqrt((d/(16*a))^2+(c/(12*a)) |^ 3)) + 3-root(d/(16*a)-sqrt((d/(16*a))^2+(c/(12*
a)) |^ 3)))^2+c/a)*<i> or z=3-root(d/(16*a)+sqrt((d/(16*a))^2+(c/(12*a)) |^ 3))
+3-root(d/(16*a)-sqrt((d/(16*a))^2+(c/(12*a)) |^ 3)) -sqrt(3*(3-root(d/(16*a)+
sqrt((d/(16*a))^2+(c/(12*a)) |^ 3)) +3-root(d/(16*a)-sqrt((d/(16*a))^2+(c/(12*a
)) |^ 3)))^2+c/a)*<i> or z=2*(3-root(d/(16*a)+sqrt((d/(16*a))^2+(c/(12*a)) |^ 3
)))+ sqrt(3*(2*(3-root(d/(16*a)+sqrt((d/(16*a))^2 +(c/(12*a)) |^ 3))))^2+c/a)*
<i> or z=2*(3-root(d/(16*a)+sqrt((d/(16*a))^2+(c/(12*a)) |^ 3))) -sqrt(3*(2*(3
-root(d/(16*a)+sqrt((d/(16*a))^2 +(c/(12*a)) |^ 3))))^2+c/a)*<i> or z=2*(3-root
(d/(16*a)-sqrt((d/(16*a))^2+(c/(12*a)) |^ 3)))+ sqrt(3*(2*(3-root(d/(16*a)-sqrt
((d/(16*a))^2 +(c/(12*a)) |^ 3))))^2+c/a)*<i> or z=2*(3-root(d/(16*a)-sqrt((d/(
16*a))^2+(c/(12*a)) |^ 3))) -sqrt(3*(2*(3-root(d/(16*a)-sqrt((d/(16*a))^2 +(c/(
  12*a)) |^ 3))))^2+c/a)*<i>;

theorem 
  a<>0 & Polynom(a,b,c,d,z)=0 & Im z=0 implies for u,v,x1 st x1=Re z + b
/(3*a) & Re z=u+v-b/(3*a) & 3*u*v+(3*a*c-b^2)/(3*a^2)=0 holds z =3-root(-(b/(3*
a)) |^ 3-(3*a*d-b*c)/(6*a^2) +sqrt((2*((b/(3*a)) |^ 3)+(3*a*d-b*c)/(3*a^2))^2/4
  +((3*a*c-b^2)/(9*a^2)) |^ 3)) + 3-root(-(b/(3*a)) |^ 3-(3*a*d-b*c)/(6*a^2) -
sqrt((2*((b/(3*a)) |^ 3)+(3*a*d-b*c)/(3*a^2))^2/4 +((3*a*c-b^2)/(9*a^2)) |^ 3))
-b/(3*a)+0*<i> or z =3-root(-(b/(3*a)) |^ 3-(3*a*d-b*c)/(6*a^2) +sqrt((2*((b/(3
*a)) |^ 3)+(3*a*d-b*c)/(3*a^2))^2/4 +((3*a*c-b^2)/(9*a^2)) |^ 3)) + 3-root(-(b/
(3*a)) |^ 3-(3*a*d-b*c)/(6*a^2) +sqrt((2*((b/(3*a)) |^ 3)+(3*a*d-b*c)/(3*a^2))
^2/4 +((3*a*c-b^2)/(9*a^2)) |^ 3))-b/(3*a)+0*<i> or z =3-root(-(b/(3*a)) |^ 3-(
3*a*d-b*c)/(6*a^2) -sqrt((2*((b/(3*a)) |^ 3)+(3*a*d-b*c)/(3*a^2))^2/4 +((3*a*c-
b^2)/(9*a^2)) |^ 3)) + 3-root(-(b/(3*a)) |^ 3-(3*a*d-b*c)/(6*a^2) -sqrt((2*((b/
(3*a)) |^ 3)+(3*a*d-b*c)/(3*a^2))^2/4 +((3*a*c-b^2)/(9*a^2)) |^ 3))-b/(3*a)+0*
  <i>;

theorem 
  z1 <> 0 & Polynom(z1,z2,z) = 0 implies z = -(z2/z1);

begin

theorem 
  (for z holds Polynom(z1,z2,z3,z) = Polynom(s1,s2,s3,z)) implies z1 =
  s1 & z2 = s2 & z3 = s3;

theorem 
  (-a+sqrt (a^2+b^2))/2 >=0 & (a+sqrt (a^2+b^2))/2>=0;

theorem 
  z^2 = s & Im s >= 0 implies z=sqrt (( Re s+sqrt ((Re s)^2+(Im s)
  ^2))/2)+ (sqrt ((-Re s+sqrt ((Re s)^2+(Im s)^2))/2))*<i> or z=-sqrt (( Re s+
sqrt ((Re s)^2+(Im s)^2))/2)+ (-sqrt ((-Re s+sqrt ((Re s)^2+(Im s)^2))/2))*<i>;

theorem 
  z^2 = s & Im s = 0 & Re s > 0 implies z=sqrt(Re s) or z=-sqrt(Re s);

theorem 
  z^2 = s & Im s = 0 & Re s < 0 implies z= sqrt (-Re s)*<i> or z= -sqrt
  (-Re s)*<i>;

theorem 
  z^2 = s & Im s <0 implies z= sqrt (( Re s+sqrt ((Re s)^2+(Im s)^2))/2)
+ (-sqrt ((-Re s+sqrt ((Re s)^2+(Im s)^2))/2))*<i> or z=-sqrt (( Re s+sqrt ((Re
  s)^2+(Im s)^2))/2)+ (sqrt ((-Re s+sqrt ((Re s)^2+(Im s)^2))/2))*<i>;

theorem 
  z^2 = s implies z=sqrt (( Re s+sqrt ((Re s)^2+(Im s)^2))/2)+ (
sqrt ((-Re s+sqrt ((Re s)^2+(Im s)^2))/2))*<i> or z=-sqrt (( Re s+sqrt ((Re s)
^2+(Im s)^2))/2)+ (-sqrt ((-Re s+sqrt ((Re s)^2+(Im s)^2))/2))*<i> or z= sqrt (
( Re s+sqrt ((Re s)^2+(Im s)^2))/2)+ (-sqrt ((-Re s+sqrt ((Re s)^2+(Im s)^2))/2
))*<i> or z=-sqrt (( Re s+sqrt ((Re s)^2+(Im s)^2))/2)+ (sqrt ((-Re s+sqrt ((Re
  s)^2+(Im s)^2))/2))*<i>;

theorem 
  z1<>0 & Polynom(z1,z2,0,z)=0 implies z=-(z2/z1) or z=0;

theorem 
  z1<>0 & Polynom(z1,0,z3,z)=0 implies for s st s=-(z3/z1) holds z
= sqrt (( Re s+sqrt ((Re s)^2+(Im s)^2))/2)+ (sqrt ((-Re s+sqrt ((Re s)^2+(Im s
)^2))/2))*<i> or z=-sqrt (( Re s+sqrt ((Re s)^2+(Im s)^2))/2)+ (-sqrt ((-Re s+
sqrt ((Re s)^2+(Im s)^2))/2))*<i> or z= sqrt (( Re s+sqrt ((Re s)^2+(Im s)^2))/
2)+ (-sqrt ((-Re s+sqrt ((Re s)^2+(Im s)^2))/2))*<i> or z=-sqrt (( Re s+sqrt ((
  Re s)^2+(Im s)^2))/2)+ (sqrt ((-Re s+sqrt ((Re s)^2+(Im s)^2))/2))*<i>;

theorem 
  z1<>0 & Polynom(z1,z2,z3,z)=0 implies for h,t st h=(z2/(2*z1))^2
-z3/z1 & t=z2/(2*z1) holds z= sqrt (( Re h+sqrt ((Re h)^2+(Im h)^2))/2)+ (sqrt
((-Re h+sqrt ((Re h)^2+(Im h)^2))/2))*<i>-t or z=-sqrt (( Re h+sqrt ((Re h)^2+(
Im h)^2))/2)+ (-sqrt ((-Re h+sqrt ((Re h)^2+(Im h)^2))/2))*<i>-t or z= sqrt ((
Re h+sqrt ((Re h)^2+(Im h)^2))/2)+ (-sqrt ((-Re h+sqrt ((Re h)^2+(Im h)^2))/2))
*<i>-t or z=-sqrt (( Re h+sqrt ((Re h)^2+(Im h)^2))/2)+ (sqrt ((-Re h+sqrt ((Re
  h)^2+(Im h)^2))/2))*<i>-t;

theorem 
  z|^ 3=z*z*z & z|^ 3=z^2*z & z|^ 3 = z^3;

theorem 
  z1<>0 & Polynom(z1,z2,0,0,z)=0 implies z=-z2/z1 or z=0;

theorem 
  z1<>0 & Polynom(z1,0,z3,0,z)=0 implies for s st s=-(z3/z1) holds z=0
or z=sqrt (( Re s+sqrt ((Re s)^2+(Im s)^2))/2)+ (sqrt ((-Re s+sqrt ((Re s)^2+(
Im s)^2))/2))*<i> or z=-sqrt (( Re s+sqrt ((Re s)^2+(Im s)^2))/2)+ (-sqrt ((-Re
s+sqrt ((Re s)^2+(Im s)^2))/2))*<i> or z= sqrt (( Re s+sqrt ((Re s)^2+(Im s)^2)
)/2)+ (-sqrt ((-Re s+sqrt ((Re s)^2+(Im s)^2))/2))*<i> or z=-sqrt (( Re s+sqrt
  ((Re s)^2+(Im s)^2))/2)+ (sqrt ((-Re s+sqrt ((Re s)^2+(Im s)^2))/2))*<i>;

theorem 
  z1<>0 & Polynom(z1,z2,z3,0,z)=0 implies for s,h,t st h=(z2/(2*z1))^2-
z3/z1 & t=z2/(2*z1) holds z=0 or z= sqrt (( Re h+sqrt ((Re h)^2+(Im h)^2))/2)+
(sqrt ((-Re h+sqrt ((Re h)^2+(Im h)^2))/2))*<i>-t or z=-sqrt (( Re h+sqrt ((Re
  h)^2+(Im h)^2))/2)+ (-sqrt ((-Re h+sqrt ((Re h)^2+(Im h)^2))/2))*<i>-t or z=
sqrt (( Re h+sqrt ((Re h)^2+(Im h)^2))/2)+ (-sqrt ((-Re h+sqrt ((Re h)^2+(Im h)
^2))/2))*<i>-t or z=-sqrt (( Re h+sqrt ((Re h)^2+(Im h)^2))/2)+ (sqrt ((-Re h+
  sqrt ((Re h)^2+(Im h)^2))/2))*<i>-t;

theorem 
  for x being real number, n be Element of NAT holds (cos x + sin
  x*<i>) |^ n = cos (n*x) + sin (n*x)*<i>;

theorem 
  for z being Element of COMPLEX for n being Element of NAT
  holds z|^ n = (|.z.| to_power n)*cos (n*Arg z) + (|.z.| to_power n)*sin (
  n*Arg z)*<i>;

theorem 
  for n,k be Element of NAT,x be Real st n <> 0 holds (cos((x+2*PI
  *k)/n) + sin((x+2*PI*k)/n)*<i>)|^ n = cos x + (sin x)*<i>;

theorem 
  for z be complex number for n,k be Element of NAT st n <> 0
holds z = ((n-root |.z.|)*cos((Arg z+2*PI*k)/n) + (n-root |.z.|)*sin((Arg z+2*
  PI*k)/n)*<i>)|^ n;

theorem 
  for z be Element of COMPLEX, n be non empty Element of NAT, k be
Element of NAT holds (n-root |.z.|)*cos((Arg z+2*PI*k)/n)+ (n-root |.z.|)*sin((
  Arg z+2*PI*k)/n)*<i> is CRoot of n,z;

theorem 
  for z be complex number, v be CRoot of 1,z holds v = z;

theorem 
  for n be non empty Nat, v be CRoot of n,0 holds v = 0;

theorem 
  for n be non empty Element of NAT, z be complex number for v be CRoot
  of n,z st v = 0 holds z = 0;

theorem 
  for n be non empty Element of NAT, k be Element of NAT holds cos(2*PI*
  k/n) + sin(2*PI*k/n)*<i> is CRoot of n,1;

theorem 
  for z,s being Element of COMPLEX, n being Element of NAT st s<>0 & z<>
  0 & n>=1 & s|^ n=z|^ n holds |.s.| = |.z.|;















begin

reserve x,y,a,b,c,p,q for Real;
reserve m,n for Element of NAT;

theorem 
  b/a<0 & c/a>0 & delta(a,b,c) >=0 implies (-b+sqrt delta(a,b,c))/(
  2*a)>0 & (-b-sqrt delta(a,b,c))/(2*a)>0;

theorem 
  b/a>0 & c/a>0 & delta(a,b,c) >=0 implies (-b+sqrt delta(a,b,c))/(2*a)<
  0 & (-b-sqrt delta(a,b,c))/(2*a)<0;

theorem 
  c/a<0 implies (-b+sqrt delta(a,b,c))/(2*a)>0 & (-b-sqrt delta(a,b,c))/
  (2*a)<0 or (-b+sqrt delta(a,b,c))/(2*a)<0 & (-b-sqrt delta(a,b,c))/(2*a)>0;

theorem 
  a>0 & n is even & n >= 1 & x |^ n = a implies x = n-root a or x = -n-root a;

theorem 
  a <> 0 & Polynom(a,b,0,x) = 0 implies x=0 or x = -(b/a);

theorem 
  a <> 0 & Polynom(a,0,0,x) = 0 implies x=0;

theorem 
  a <> 0 & n is odd & delta(a,b,c) >= 0 & Polynom(a,b,c,x|^ n)
  = 0 implies x = n-root((-b+sqrt delta(a,b,c))/(2*a)) or x = n-root((-b-sqrt
  delta(a,b,c))/(2*a));

theorem 
  a <> 0 & b/a<0 & c/a>0 & n is even & n >= 1 & delta(a,b,c) >= 0 &
Polynom(a,b,c,x|^ n) = 0 implies x = n-root((-b+sqrt delta(a,b,c))/(2*a)) or x
= -n-root((-b+sqrt delta(a,b,c))/(2*a)) or x = n-root((-b-sqrt delta(a,b,c))/(2
  *a)) or x = -n-root((-b-sqrt delta(a,b,c))/(2*a));

theorem 
  a <> 0 & n is odd & Polynom(a,b,0,x|^ n) = 0 implies x=0 or x = n-root -(b/a)
;

theorem 
  a <> 0 & b/a<0 & n is even & n >= 1 & Polynom(a,b,0,x|^ n) = 0
  implies x=0 or x = n-root -(b/a) or x = -n-root -(b/a);

theorem 
  a|^3+b|^3 = (a+b)*(a^2-a*b+b^2) & a|^5+b|^5 = (a+b)*(a|^4-a|^3*b
  +a|^2*b|^2-a*b|^3+b|^4);

theorem 
  a<>0 & b^2-2*a*b-3*a^2>=0 & Polynom(a,b,b,a,x)=0 implies x=-1 or x= (a
  -b+sqrt(b^2-2*a*b-3*a^2))/(2*a) or x= (a-b-sqrt(b^2-2*a*b-3*a^2))/(2*a);

definition
  let a,b,c,d,e,f,x be complex number;
  func Polynom(a,b,c,d,e,f,x) equals

  a*(x|^5)+b*(x|^4)+c*(x|^3)+d*(x^2)+e*x+f;
end;

registration
  let a,b,c,d,e,f,x be complex number;
  cluster Polynom(a,b,c,d,e,f,x) -> complex;
end;

registration
  let a,b,c,d,e,f,x be real number;
  cluster Polynom(a,b,c,d,e,f,x) -> real;
end;

theorem 
  a<>0 & b^2+2*a*b+5*a^2-4*a*c>0 & Polynom(a,b,c,c,b,a,x)=0 implies for
  y1,y2 being Real st y1 = (a-b+sqrt(b^2+2*a*b+5*a^2-4*a*c))/(2*a) & y2 = (a-b-
sqrt(b^2+2*a*b+5*a^2-4*a*c))/(2*a) holds x=-1 or x = (y1 + sqrt delta(1,(-y1),1
))/2 or x = (y2 + sqrt delta(1,(-y2),1))/2 or x = (y1 - sqrt delta(1,(-y1),1))/
  2 or x = (y2 - sqrt delta(1,(-y2),1))/2;

theorem 
  x+y=p & x*y=q & p^2-4*q>=0 implies x=(p+sqrt(p^2-4*q))/2 & y=(p-
  sqrt(p^2-4*q))/2 or x=(p-sqrt(p^2-4*q))/2 & y=(p+sqrt(p^2-4*q))/2;

theorem 
  (x|^ n)+(y|^ n)=p & (x|^ n)*(y|^ n)=q & p^2-4*q>=0 & n is odd
  implies x=n-root((p+sqrt(p^2-4*q))/2) & y=n-root((p-sqrt(p^2-4*q))/2) or x=n
  -root((p-sqrt(p^2-4*q))/2) & y=n-root((p+sqrt(p^2-4*q))/2);

theorem 
  (x|^ n)+(y|^ n)=p & (x|^ n)*(y|^ n)=q & p^2-4*q>=0 & p>0 & q>0 &
  n is even & n >= 1
  implies x=n-root((p+sqrt(p^2-4*q))/2)&y=n-root((p-sqrt(p^2-4*q
  ))/2) or x=-n-root((p+sqrt(p^2-4*q))/2)&y=n-root((p-sqrt(p^2-4*q))/2) or x=n
-root((p+sqrt(p^2-4*q))/2)&y=-n-root((p-sqrt(p^2-4*q))/2) or x=-n-root((p+sqrt(
p^2-4*q))/2)&y=-n-root((p-sqrt(p^2-4*q))/2) or x=n-root((p-sqrt(p^2-4*q))/2)&y=
n-root((p+sqrt(p^2-4*q))/2) or x=-n-root((p-sqrt(p^2-4*q))/2)&y=n-root((p+sqrt(
p^2-4*q))/2) or x=n-root((p-sqrt(p^2-4*q))/2)&y=-n-root((p+sqrt(p^2-4*q))/2) or
  x=-n-root((p-sqrt(p^2-4*q))/2)&y=-n-root((p+sqrt(p^2-4*q))/2);

theorem 
  x|^ n+y|^ n=a & x|^ n-y|^ n=b & n is even & n >= 1 & a+b>0 & a-b>0
implies x=n-root((a+b)/2) & y=n-root((a-b)/2) or x=n-root((a+b)/2) & y=-n-root(
(a-b)/2) or x=-n-root((a+b)/2)& y=n-root((a-b)/2) or x=-n-root((a+b)/2) & y=-n
  -root((a-b)/2);

theorem 
  a*x|^ n+b*y|^ n=p & x*y=0 & n is odd & a*b<>0 implies x=0 & y
  =n-root(p/b) or x=n-root(p/a) & y=0;

theorem 
  a*x|^ n+b*y|^ n=p & x*y=0 & n is even & n >= 1 & p/b>0 &p/a>0 &a*b
<>0 implies x=0 & y=n-root(p/b) or x=0 & y=-n-root(p/b) or x=n-root(p/a) & y=0
  or x=-n-root(p/a) & y=0;

theorem 
  a*x|^ n=p & x*y=q & n is odd & p*a<>0 implies x=n-root(p/a) & y=q*n-root(a/p)
;

theorem 
  a*x|^ n=p & x*y=q & n is even & n >= 1 & p/a>0 &a<>0 implies x=n
  -root(p/a) & y=q*n-root(a/p) or x=-n-root(p/a) & y=-q*n-root(a/p);

theorem 
  for a,x being Real st a>0 & a<>1 & a to_power x = 1 holds x=0;

theorem 
  for a,x being Real st a>0 & a<>1 & a to_power x = a holds x=1;

theorem 
  for a,b,x being Real st a>0 & a<>1 & x>0 & log(a,x) = 0 holds x = 1;

theorem 
  for a,b,x being Real st a>0 & a<>1 & x>0 & log(a,x) = 1 holds x = a;














begin 

reserve a,b for complex number;

theorem 
  a*a = a|^2;

theorem 
  a*a*a = a|^3;

theorem 
  a*a*a*a = a|^4;

theorem 
  (a - b)|^2 = a|^2 -2*a*b +b|^2;



theorem 
  (a - b)|^3 = a|^3 -3*a|^2*b +3*b|^2*a -b|^3;

theorem 
  (a - b)|^4 = a|^4 -4*a|^3*b +6*a|^2*b|^2 -4*b|^3*a +b|^4;

notation
  let n be Nat;
  let r be real number;
  synonym n -real-root r for n -root r;
end;



definition
  let n be non zero Nat;
  let z be complex number;
  func n -root z -> complex number equals

  (n -real-root |.z.|)*(cos((Arg z)/n)
  + sin((Arg z)/n)*<i>);
end;

reserve z for complex number;
reserve n0 for non zero Nat;

theorem 
  (n0-root z)|^n0 = z;

theorem 
  for r being real number st r >= 0 holds n0-root r = n0-real-root r;

theorem 
  for r being real number st r > 0 holds n0-root(z/r) = n0-root z/ n0-root r;

theorem 
  z|^2 = a iff z = 2-root a or z = -2-root a;

begin 

reserve a0,a1,a2,s1,s2 for complex number;

theorem 
  a1 = -(s1+s2) & a0 = s1*s2 implies (z|^2 + a1*z + a0 = 0 iff z =
  s1 or z = s2);

theorem 
  a2<>0 implies (a2*z|^2+a1*z+a0 = 0 iff z = -a1/(2*a2)+2-root(
  delta(a0,a1,a2))/(2*a2) or z = -a1/(2*a2)-2-root(delta(a0,a1,a2))/(2*a2));

begin 

reserve a3,x,q,r,s,s3 for complex number;

theorem 
  z = x - a2/3 & q = (3*a1 - a2|^2)/9 & r = (9*a2*a1 - 2*a2|^3 -
  27*a0)/54 implies (z|^3+a2*z|^2+a1*z+a0 = 0 iff x|^3+3*q*x-2*r = 0);

theorem 
  a2 = -(s1+s2+s3) & a1 = s1*s2+s1*s3+s2*s3 & a0 = -s1*s2*s3
  implies (z|^3 + a2*z|^2 + a1*z + a0 = 0 iff z = s1 or z = s2 or z = s3);





theorem 
  q = (3*a1 - a2|^2)/9 & q <> 0 & r = (9*a2*a1 - 2*a2|^3 - 27*a0)/54 & s
= 2-root(q|^3+r|^2) & s1 = 3-root(r+s) & s2 = -q/s1 implies ( z|^3+a2*z|^2+a1*z
+a0 = 0 iff z = s1+s2-a2/3 or z = -(s1+s2)/2-a2/3+(s1-s2)*(2-root 3)*<i>/2 or z
  = -(s1+s2)/2-a2/3-(s1-s2)*(2-root 3)*<i>/2);



theorem 
  q = (3*a1 - a2|^2)/9 & q = 0 & r = (9*a2*a1 - 2*a2|^3 - 27*a0)/54 & s1
= 3-root(2*r) implies ( z|^3+a2*z|^2+a1*z+a0 = 0 iff z = s1-a2/3 or z = -s1/2-
  a2/3+s1*(2-root 3)*<i>/2 or z = -s1/2-a2/3-s1*(2-root 3)*<i>/2);

definition
  let a0,a1,a2 be complex number;
  func 1_root_of_cubic(a0,a1,a2) -> complex number means


  ex r,s1 st r =
(9*a2*a1 - 2*a2|^3 - 27*a0)/54 & s1 = 3-root(2*r) & it = s1-a2/3 if 3*a1 - a2|^
2 = 0 otherwise ex q,r,s,s1,s2 st q = (3*a1 - a2|^2)/9 & r = (9*a2*a1 - 2*a2|^3
- 27*a0)/54 & s = 2-root(q|^3+r|^2) & s1 = 3-root(r+s) & s2 = -q/s1 & it = s1+
  s2-a2/3;
  func 2_root_of_cubic(a0,a1,a2) -> complex number means


  ex r,s1 st r =
(9*a2*a1 - 2*a2|^3 - 27*a0)/54 & s1 = 3-root(2*r) & it = -s1/2-a2/3+s1*(2-root
3)*<i>/2 if 3*a1 - a2|^2 = 0 otherwise ex q,r,s,s1,s2 st q = (3*a1 - a2|^2)/9 &
r = (9*a2*a1 - 2*a2|^3 - 27*a0)/54 & s = 2-root(q|^3+r|^2) & s1 = 3-root(r+s) &
  s2 = -q/s1 & it = -(s1+s2)/2-a2/3+(s1-s2)*(2-root 3)*<i>/2;
  func 3_root_of_cubic(a0,a1,a2) -> complex number means


  ex r,s1 st r =
(9*a2*a1 - 2*a2|^3 - 27*a0)/54 & s1 = 3-root(2*r) & it = -s1/2-a2/3-s1*(2-root
3)*<i>/2 if 3*a1 - a2|^2 = 0 otherwise ex q,r,s,s1,s2 st q = (3*a1 - a2|^2)/9 &
r = (9*a2*a1 - 2*a2|^3 - 27*a0)/54 & s = 2-root(q|^3+r|^2) & s1 = 3-root(r+s) &
  s2 = -q/s1 & it = -(s1+s2)/2-a2/3-(s1-s2)*(2-root 3)*<i>/2;
end;

theorem 
  1_root_of_cubic(a0,a1,a2)+2_root_of_cubic(a0,a1,a2)+
  3_root_of_cubic(a0,a1,a2) = -a2;

theorem 
  1_root_of_cubic(a0,a1,a2) * 2_root_of_cubic(a0,a1,a2) +
1_root_of_cubic(a0,a1,a2) * 3_root_of_cubic(a0,a1,a2) + 2_root_of_cubic(a0,a1,
  a2) * 3_root_of_cubic(a0,a1,a2) = a1;

theorem 
  1_root_of_cubic(a0,a1,a2) * 2_root_of_cubic(a0,a1,a2) *
  3_root_of_cubic(a0,a1,a2) = -a0;

theorem 
  a3 <> 0 implies (a3*z|^3 + a2*z|^2 + a1*z + a0 = 0 iff z =
1_root_of_cubic(a0/a3,a1/a3,a2/a3) or z = 2_root_of_cubic(a0/a3,a1/a3,a2/a3) or
  z = 3_root_of_cubic(a0/a3,a1/a3,a2/a3));

begin 

reserve a4,p,s4 for complex number;

theorem 
  z = x - a3/4 & p = (8*a2-3*a3|^2)/32 & q = (8*a1 -4*a2*a3 + a3|^
3)/64 & r = (256*a0 -64*a3*a1 +16*a3|^2*a2 -3*a3|^4)/1024 implies (z|^4+a3*z|^3
  +a2*z|^2+a1*z+a0 = 0 iff x|^4+4*p*x|^2+8*q*x+4*r = 0);

theorem 
  a3 = -(s1+s2+s3+s4) & a2 = s1*s2+s1*s3+s1*s4+s2*s3+s2*s4+s3*s4 &
a1 = -(s1*s2*s3+s1*s2*s4+s1*s3*s4+s2*s3*s4) & a0=s1*s2*s3*s4 implies (z|^4 + a3
  *z|^3 + a2*z|^2 + a1*z + a0 = 0 iff z = s1 or z = s2 or z = s3 or z = s4);




theorem 
  q <> 0 & s1 = 2-root(1_root_of_cubic(-q|^2,p|^2-r,2*p)) & s2 = 2
-root(2_root_of_cubic(-q|^2,p|^2-r,2*p)) & s3 = -q/(s1*s2) implies (z|^4+4*p*z
|^2+8*q*z+4*r = 0 iff z = s1+s2+s3 or z = s1-s2-s3 or z = -s1+s2-s3 or z = -s1-
  s2+s3);



theorem 
  p = (8*a2-3*a3|^2)/32 & q = (8*a1 -4*a2*a3 + a3|^3)/64 & q <> 0 & r =
(256*a0 -64*a3*a1 +16*a3|^2*a2 -3*a3|^4)/1024 & s1 = 2-root(1_root_of_cubic(-q
|^2,p|^2-r,2*p)) & s2 = 2-root(2_root_of_cubic(-q|^2,p|^2-r,2*p)) & s3 = -q/(s1
*s2) implies ( z|^4+a3*z|^3+a2*z|^2+a1*z+a0 = 0 iff z = s1+s2+s3-a3/4 or z = s1
  -s2-s3-a3/4 or z = -s1+s2-s3-a3/4 or z = -s1-s2+s3-a3/4);



theorem 
  p = (8*a2-3*a3|^2)/32 & q = (8*a1 -4*a2*a3 + a3|^3)/64 & q = 0 & r = (
256*a0 -64*a3*a1 +16*a3|^2*a2 -3*a3|^4)/1024 & s1 = 2-root(p|^2-r) implies ( z
|^4+a3*z|^3+a2*z|^2+a1*z+a0 = 0 iff z = 2-root(-2*(p-s1))-a3/4 or z = -2-root(-
  2*(p-s1))-a3/4 or z = 2-root(-2*(p+s1))-a3/4 or z = -2-root(-2*(p+s1))-a3/4);

definition
  let a0,a1,a2,a3 be complex number;
  func 1_root_of_quartic(a0,a1,a2,a3) -> complex number means


  ex p,r,s1
st p = (8*a2-3*a3|^2)/32 & r = (256*a0 -64*a3*a1 +16*a3|^2*a2 -3*a3|^4)/1024 &
s1 = 2-root(p|^2-r) & it = 2-root(-2*(p-s1))-a3/4 if 8*a1 -4*a2*a3 + a3|^3 = 0
otherwise ex p,q,r,s1,s2,s3 st p = (8*a2-3*a3|^2)/32 & q = (8*a1 -4*a2*a3 + a3
  |^3)/64 & r = (256*a0 -64*a3*a1 +16*a3|^2*a2 -3*a3|^4)/1024 & s1 = 2-root(
1_root_of_cubic(-q|^2,p|^2-r,2*p)) & s2 = 2-root(2_root_of_cubic(-q|^2,p|^2-r,2
  *p)) & s3 = -q/(s1*s2) & it = s1+s2+s3-a3/4;
  func 2_root_of_quartic(a0,a1,a2,a3) -> complex number means


  ex p,r,s1
st p = (8*a2-3*a3|^2)/32 & r = (256*a0 -64*a3*a1 +16*a3|^2*a2 -3*a3|^4)/1024 &
s1 = 2-root(p|^2-r) & it = -2-root(-2*(p-s1))-a3/4 if 8*a1 -4*a2*a3 + a3|^3 = 0
otherwise ex p,q,r,s1,s2,s3 st p = (8*a2-3*a3|^2)/32 & q = (8*a1 -4*a2*a3 + a3
  |^3)/64 & r = (256*a0 -64*a3*a1 +16*a3|^2*a2 -3*a3|^4)/1024 & s1 = 2-root(
1_root_of_cubic(-q|^2,p|^2-r,2*p)) & s2 = 2-root(2_root_of_cubic(-q|^2,p|^2-r,2
  *p)) & s3 = -q/(s1*s2) & it = -s1-s2+s3-a3/4;
  func 3_root_of_quartic(a0,a1,a2,a3) -> complex number means


  ex p,r,s1
st p = (8*a2-3*a3|^2)/32 & r = (256*a0 -64*a3*a1 +16*a3|^2*a2 -3*a3|^4)/1024 &
s1 = 2-root(p|^2-r) & it = 2-root(-2*(p+s1))-a3/4 if 8*a1 -4*a2*a3 + a3|^3 = 0
otherwise ex p,q,r,s1,s2,s3 st p = (8*a2-3*a3|^2)/32 & q = (8*a1 -4*a2*a3 + a3
  |^3)/64 & r = (256*a0 -64*a3*a1 +16*a3|^2*a2 -3*a3|^4)/1024 & s1 = 2-root(
1_root_of_cubic(-q|^2,p|^2-r,2*p)) & s2 = 2-root(2_root_of_cubic(-q|^2,p|^2-r,2
  *p)) & s3 = -q/(s1*s2) & it = -s1+s2-s3-a3/4;
  func 4_root_of_quartic(a0,a1,a2,a3) -> complex number means


  ex p,r,s1
st p = (8*a2-3*a3|^2)/32 & r = (256*a0 -64*a3*a1 +16*a3|^2*a2 -3*a3|^4)/1024 &
s1 = 2-root(p|^2-r) & it = -2-root(-2*(p+s1))-a3/4 if 8*a1 -4*a2*a3 + a3|^3 = 0
otherwise ex p,q,r,s1,s2,s3 st p = (8*a2-3*a3|^2)/32 & q = (8*a1 -4*a2*a3 + a3
  |^3)/64 & r = (256*a0 -64*a3*a1 +16*a3|^2*a2 -3*a3|^4)/1024 & s1 = 2-root(
1_root_of_cubic(-q|^2,p|^2-r,2*p)) & s2 = 2-root(2_root_of_cubic(-q|^2,p|^2-r,2
  *p)) & s3 = -q/(s1*s2) & it = s1-s2-s3-a3/4;
end;

theorem 
  1_root_of_quartic(a0,a1,a2,a3)+2_root_of_quartic(a0,a1,a2,a3)+
  3_root_of_quartic(a0,a1,a2,a3)+4_root_of_quartic(a0,a1,a2,a3) = -a3;

theorem 
  (1_root_of_quartic(a0,a1,a2,a3)*2_root_of_quartic(a0,a1,a2,a3)+
  1_root_of_quartic(a0,a1,a2,a3)*3_root_of_quartic(a0,a1,a2,a3)+
  1_root_of_quartic(a0,a1,a2,a3)*4_root_of_quartic(a0,a1,a2,a3))+
  2_root_of_quartic(a0,a1,a2,a3)*3_root_of_quartic(a0,a1,a2,a3)+
  2_root_of_quartic(a0,a1,a2,a3)*4_root_of_quartic(a0,a1,a2,a3)+
  3_root_of_quartic(a0,a1,a2,a3)*4_root_of_quartic(a0,a1,a2,a3) = a2;

theorem 
  (1_root_of_quartic(a0,a1,a2,a3)*2_root_of_quartic(a0,a1,a2,a3)*
  3_root_of_quartic(a0,a1,a2,a3)+ 1_root_of_quartic(a0,a1,a2,a3)*
  2_root_of_quartic(a0,a1,a2,a3)* 4_root_of_quartic(a0,a1,a2,a3))+
  1_root_of_quartic(a0,a1,a2,a3)*3_root_of_quartic(a0,a1,a2,a3)*
  4_root_of_quartic(a0,a1,a2,a3)+ 2_root_of_quartic(a0,a1,a2,a3)*
  3_root_of_quartic(a0,a1,a2,a3)* 4_root_of_quartic(a0,a1,a2,a3) = -a1;

theorem 
  1_root_of_quartic(a0,a1,a2,a3)*2_root_of_quartic(a0,a1,a2,a3)*
  3_root_of_quartic(a0,a1,a2,a3)*4_root_of_quartic(a0,a1,a2,a3) = a0;


theorem 
  a4 <> 0 implies (a4*z|^4 + a3*z|^3 + a2*z|^2 + a1*z + a0 = 0 iff z =
1_root_of_quartic(a0/a4,a1/a4,a2/a4,a3/a4) or z = 2_root_of_quartic(a0/a4,a1/a4
  ,a2/a4,a3/a4) or z = 3_root_of_quartic(a0/a4,a1/a4,a2/a4,a3/a4) or z =
  4_root_of_quartic(a0/a4,a1/a4,a2/a4,a3/a4));














begin 

reserve r, s for real number,
  i for integer number;

theorem 
  0 <= r & r < s implies [\ r/s /] = 0;

theorem 
  for f being Function, X, Y being set st f|X is one-to-one & Y c=
  X holds f|Y is one-to-one;

begin 

theorem 
  -1 <= sin r;

theorem 
  sin r <= 1;

theorem 
  -1 <= cos r;

theorem 
  cos r <= 1;

registration
  cluster PI -> positive;
end;

theorem 
  sin(-PI/2) = -1 & sin.-PI/2 = -1;

theorem 
  sin.r = sin.(r+2*PI*i);

theorem 
  cos(-PI/2) = 0 & cos.-PI/2 = 0;

theorem 
  cos.r = cos.(r+2*PI*i);

theorem 
  2*PI*i < r & r < PI+2*PI*i implies sin r > 0;

theorem 
  PI+2*PI*i < r & r < 2*PI+2*PI*i implies sin r < 0;

theorem 
  -PI/2+2*PI*i < r & r < PI/2+2*PI*i implies cos r > 0;

theorem 
  PI/2+2*PI*i < r & r < 3/2*PI+2*PI*i implies cos r < 0;

theorem 
  3/2*PI+2*PI*i < r & r < 2*PI+2*PI*i implies cos r > 0;

theorem 
  2*PI*i <= r & r <= PI+2*PI*i implies sin r >= 0;

theorem 
  PI+2*PI*i <= r & r <= 2*PI+2*PI*i implies sin r <= 0;

theorem 
  -PI/2+2*PI*i <= r & r <= PI/2+2*PI*i implies cos r >= 0;

theorem 
  PI/2+2*PI*i <= r & r <= 3/2*PI+2*PI*i implies cos r <= 0;

theorem 
  3/2*PI+2*PI*i <= r & r <= 2*PI+2*PI*i implies cos r >= 0;

theorem 
  2*PI*i <= r & r < 2*PI+2*PI*i & sin r = 0 implies r = 2*PI*i or r = PI+2*PI*i
;

theorem 
  2*PI*i <= r & r < 2*PI+2*PI*i & cos r = 0 implies r = PI/2+2*PI*
  i or r = 3/2*PI+2*PI*i;

theorem 
  sin r = -1 implies r = 3/2*PI + 2*PI*[\r/(2*PI)/];

theorem 
  sin r = 1 implies r = PI/2 + 2*PI*[\r/(2*PI)/];

theorem 
  cos r = -1 implies r = PI + 2*PI*[\r/(2*PI)/];

theorem 
  cos r = 1 implies r = 2*PI*[\r/(2*PI)/];

theorem 
  0 <= r & r <= 2*PI & sin r = -1 implies r = 3/2*PI;

theorem 
  0 <= r & r <= 2*PI & sin r = 1 implies r = PI/2;



theorem 
  0 <= r & r <= 2*PI & cos r = -1 implies r = PI;

theorem 
  0 <= r & r < PI/2 implies sin r < 1;

theorem 
  0 <= r & r < 3/2*PI implies sin r > -1;

theorem 
  3/2*PI < r & r <= 2*PI implies sin r > -1;

theorem 
  PI/2 < r & r <= 2*PI implies sin r < 1;

theorem 
  0 < r & r < 2*PI implies cos r < 1;

theorem 
  0 <= r & r < PI implies cos r > -1;

theorem 
  PI < r & r <= 2*PI implies cos r > -1;

theorem 
  2*PI*i <= r & r < PI/2+2*PI*i implies sin r < 1;

theorem 
  2*PI*i <= r & r < 3/2*PI+2*PI*i implies sin r > -1;

theorem 
  3/2*PI+2*PI*i < r & r <= 2*PI+2*PI*i implies sin r > -1;

theorem 
  PI/2+2*PI*i < r & r <= 2*PI+2*PI*i implies sin r < 1;

theorem 
  2*PI*i < r & r < 2*PI+2*PI*i implies cos r < 1;

theorem 
  2*PI*i <= r & r < PI+2*PI*i implies cos r > -1;

theorem 
  PI+2*PI*i < r & r <= 2*PI+2*PI*i implies cos r > -1;

theorem 
  cos(2*PI*r) = 1 implies r in INT;

theorem 
  sin.:[.-PI/2,PI/2.] = [.-1,1.];

theorem 
  sin.:].-PI/2,PI/2.[ = ].-1,1.[;

theorem 
  sin.:[.PI/2,3/2*PI.] = [.-1,1.];

theorem 
  sin.:].PI/2,3/2*PI.[ = ].-1,1.[;

theorem 
  cos.:[.0,PI.] = [.-1,1.];

theorem 
  cos.:].0,PI.[ = ].-1,1.[;

theorem 
  cos.:[.PI,2*PI.] = [.-1,1.];

theorem 
  cos.:].PI,2*PI.[ = ].-1,1.[;

theorem 
  sin|[.-PI/2+2*PI*i,PI/2+2*PI*i.] is increasing;

theorem 
  sin|[.PI/2+2*PI*i,3/2*PI+2*PI*i.] is decreasing;

theorem 
  cos|[.2*PI*i,PI+2*PI*i.] is decreasing;

theorem 
  cos|[.PI+2*PI*i,2*PI+2*PI*i.] is increasing;

theorem 
  sin | [.-PI/2+2*PI*i,PI/2+2*PI*i.] is one-to-one;

theorem 
  sin | [.PI/2+2*PI*i,3/2*PI+2*PI*i.] is one-to-one;

registration
  cluster sin | [.-PI/2,PI/2.] -> one-to-one;
  cluster sin | [.PI/2,3/2*PI.] -> one-to-one;
end;

registration
  cluster sin | [.-PI/2,0 .] -> one-to-one;
  cluster sin | [.0,PI/2.] -> one-to-one;
  cluster sin | [.PI/2,PI.] -> one-to-one;
  cluster sin | [.PI,3/2*PI.] -> one-to-one;
  cluster sin | [.3/2*PI,2*PI.] -> one-to-one;
end;

registration
  cluster sin | ].-PI/2,PI/2.[ -> one-to-one;
  cluster sin | ].PI/2,3/2*PI.[ -> one-to-one;
  cluster sin | ].-PI/2,0 .[ -> one-to-one;
  cluster sin | ].0,PI/2.[ -> one-to-one;
  cluster sin | ].PI/2,PI.[ -> one-to-one;
  cluster sin | ].PI,3/2*PI.[ -> one-to-one;
  cluster sin | ].3/2*PI,2*PI.[ -> one-to-one;
end;

theorem 
  cos | [.2*PI*i,PI+2*PI*i.] is one-to-one;

theorem 
  cos | [.PI+2*PI*i,2*PI+2*PI*i.] is one-to-one;

registration
  cluster cos | [.0,PI.] -> one-to-one;
  cluster cos | [.PI,2*PI.] -> one-to-one;
end;

registration
  cluster cos | [.0,PI/2.] -> one-to-one;
  cluster cos | [.PI/2,PI.] -> one-to-one;
  cluster cos | [.PI,3/2*PI.] -> one-to-one;
  cluster cos | [.3/2*PI,2*PI.] -> one-to-one;
end;

registration
  cluster cos | ].0,PI.[ -> one-to-one;
  cluster cos | ].PI,2*PI.[ -> one-to-one;
  cluster cos | ].0,PI/2.[ -> one-to-one;
  cluster cos | ].PI/2,PI.[ -> one-to-one;
  cluster cos | ].PI,3/2*PI.[ -> one-to-one;
  cluster cos | ].3/2*PI,2*PI.[ -> one-to-one;
end;

theorem 
  2*PI*i <= r & r < 2*PI+2*PI*i & 2*PI*i <= s & s < 2*PI+2*PI*i & sin r
  = sin s & cos r = cos s implies r = s;

begin 

definition
  func arcsin -> PartFunc of REAL, REAL equals

  (sin | [.-PI/2,PI/2.])";
end;

definition
  let r be set;
  func arcsin r equals

  arcsin.r;
end;

definition
  let r be set;
  redefine func arcsin r -> Real;
end;

theorem 
  rng arcsin = [.-PI/2,PI/2.];

registration
  cluster arcsin -> one-to-one;
end;

theorem 
  dom arcsin = [.-1,1.];

theorem 
  (sin | [.-PI/2,PI/2.]) qua Function * arcsin = id [.-1,1.];

theorem 
  arcsin * (sin | [.-PI/2,PI/2.]) = id [.-1,1.];

theorem 
  (sin | [.-PI/2,PI/2.]) * arcsin = id [.-PI/2,PI/2.];

theorem 
  arcsin qua Function * (sin | [.-PI/2,PI/2.]) = id [.-PI/2,PI/2.];

theorem 
  -1 <= r & r <= 1 implies sin arcsin r = r;

theorem 
  -PI/2 <= r & r <= PI/2 implies arcsin sin r = r;

theorem 
  arcsin (-1) = -PI/2;

theorem 
  arcsin 0 = 0;

theorem 
  arcsin 1 = PI/2;

theorem 
  -1 <= r & r <= 1 & arcsin r = -PI/2 implies r = -1;

theorem 
  -1 <= r & r <= 1 & arcsin r = 0 implies r = 0;

theorem 
  -1 <= r & r <= 1 & arcsin r = PI/2 implies r = 1;

theorem 
  -1 <= r & r <= 1 implies -PI/2 <= arcsin r & arcsin r <= PI/2;

theorem 
  -1 < r & r < 1 implies -PI/2 < arcsin r & arcsin r < PI/2;

theorem 
  -1 <= r & r <= 1 implies arcsin r = -arcsin(-r);

theorem 
  0 <= s & r^2 + s^2 = 1 implies cos arcsin r = s;

theorem 
  s <= 0 & r^2 + s^2 = 1 implies cos arcsin r = -s;

theorem 
  -1 <= r & r <= 1 implies cos arcsin r = sqrt(1-r^2);

theorem 
  arcsin|[.-1,1.] is increasing;

theorem 
  arcsin is_differentiable_on ].-1,1.[ & (-1 < r & r < 1 implies diff(
  arcsin,r) = 1 / sqrt(1-r^2));

theorem 
  arcsin|[.-1,1.] is continuous;

begin 

definition
  func arccos -> PartFunc of REAL, REAL equals

  (cos | [.0,PI.])";
end;

definition
  let r be set;
  func arccos r equals

  arccos.r;
end;

definition
  let r be set;
  redefine func arccos r -> Real;
end;

theorem 
  rng arccos = [.0,PI.];

registration
  cluster arccos -> one-to-one;
end;

theorem 
  dom arccos = [.-1,1.];

theorem 
  (cos | [.0,PI.]) qua Function * arccos = id [.-1,1.];

theorem 
  arccos * (cos | [.0,PI.]) = id [.-1,1.];

theorem 
  (cos | [.0,PI.]) * arccos = id [.0,PI.];

theorem 
  arccos qua Function * (cos | [.0,PI.]) = id [.0,PI.];

theorem 
  -1 <= r & r <= 1 implies cos arccos r = r;

theorem 
  0 <= r & r <= PI implies arccos cos r = r;

theorem 
  arccos (-1) = PI;

theorem 
  arccos 0 = PI/2;

theorem 
  arccos 1 = 0;

theorem 
  -1 <= r & r <= 1 & arccos r = 0 implies r = 1;

theorem 
  -1 <= r & r <= 1 & arccos r = PI/2 implies r = 0;

theorem 
  -1 <= r & r <= 1 & arccos r = PI implies r = -1;

theorem 
  -1 <= r & r <= 1 implies 0 <= arccos r & arccos r <= PI;

theorem 
  -1 < r & r < 1 implies 0 < arccos r & arccos r < PI;

theorem 
  -1 <= r & r <= 1 implies arccos r = PI - arccos(-r);

theorem 
  0 <= s & r^2 + s^2 = 1 implies sin arccos r = s;

theorem 
  s <= 0 & r^2 + s^2 = 1 implies sin arccos r = -s;

theorem 
  -1 <= r & r <= 1 implies sin arccos r = sqrt(1-r^2);

theorem 
  arccos|[.-1,1.] is decreasing;

theorem 
  arccos is_differentiable_on ].-1,1.[ & (-1 < r & r < 1 implies diff(
  arccos,r) = -1 / sqrt(1-r^2));

theorem 
  arccos|[.-1,1.] is continuous;



theorem 
  -1 <= r & r <= 1 implies arcsin r + arccos r = PI/2;

theorem 
  -1 <= r & r <= 1 implies arccos(-r) - arcsin r = PI/2;

theorem 
  -1 <= r & r <= 1 implies arccos r - arcsin(-r) = PI/2;














begin 

reserve a,b,c,k,l,m,n for Nat,
  i,j,x,y for Integer;

theorem 
  n,n are_relative_prime iff n = 1;

theorem 
  for k,n be Nat holds k <> 0 & k < n & n is prime implies k,n
  are_relative_prime;

theorem 
  n is prime & k in {kk where kk is Element of NAT: n,kk
are_relative_prime & kk >= 1 & kk <= n} iff n is prime & k in n & not k in {0};

theorem 
  for A being finite set, x being set st x in A holds card(A \ {x})
  = card A - card{x};

theorem 
  a gcd b = 1 implies for c holds a*c gcd b*c = c;

theorem 
  a <> 0 & c <> 0 & a*c gcd b*c = c implies a,b are_relative_prime;

theorem 
  a gcd b = 1 implies (a + b) gcd b = 1;

theorem 
  for a, b, c be Nat holds (a + b*c) gcd b = a gcd b;

theorem 
  m,n are_relative_prime implies ex k st (ex i0,j0 being Integer
st k = i0*m + j0*n & k > 0) & for l st (ex i,j being Integer st l = i*m + j*n &
  l > 0) holds k <= l;

theorem 
  m,n are_relative_prime implies for k holds ex i,j st i*m + j*n = k;

theorem 
  for A be set, B being non empty set,
      f being Function of A, B st f is bijective holds card A = card B;

theorem 
  for i,k,n being Integer holds (i + k*n) mod n = i mod n;

theorem 
  c divides a*b & a,c are_relative_prime implies c divides b;

theorem 
  a <> 0 & c <> 0 & a,c are_relative_prime & b,c
  are_relative_prime implies a*b,c are_relative_prime;

theorem 
  x <> 0 & i > 0 implies i*x gcd i*y = i*(x gcd y);

theorem 
  for x st a <> 0 holds (a + x*b) gcd b = a gcd b;

begin 

definition
  let n be Nat;
  func Euler n -> Element of NAT equals

  card {k where k is Element of NAT : n,
  k are_relative_prime & k >= 1 & k <= n};
end;

theorem 
  Euler 1 = 1;

theorem 
  Euler 2 = 1;

theorem 
  n > 1 implies Euler n <= n - 1;

theorem 
  n is prime implies Euler n = n - 1;

theorem 
  m > 1 & n > 1 & m,n are_relative_prime implies
  Euler (m*n) = Euler m * Euler n;














begin 

reserve a,b,m,x,n,l,xi,xj for Nat,
  t,z for Integer,
  f,F for FinSequence of NAT;



theorem 
  a,(b qua Integer) are_relative_prime iff a,b are_relative_prime;

theorem 
  m*t >= 1 implies t >= 1;

theorem 
  a <> 0 & b <> 0 & m <> 0 & a,m are_relative_prime & b,m
  are_relative_prime implies m,a*b mod m are_relative_prime;

theorem 
  m > 1 & m,n are_relative_prime & n = a*b mod m implies m,b are_relative_prime
;

theorem 
  (m mod n) mod n = m mod n;

theorem 
  (l+m) mod n = ((l mod n)+(m mod n)) mod n;

theorem 
  (l*m) mod n = (l*(m mod n)) mod n;

theorem 
  (l*m) mod n = ((l mod n)*m) mod n;

theorem 
  (l*m) mod n = ((l mod n)*(m mod n)) mod n;

begin 

definition
  let f,a;
  redefine func a*f -> FinSequence of NAT;
end;

theorem 
  for R1,R2 be FinSequence of NAT st R1,R2
  are_fiberwise_equipotent holds Product R1 = Product R2;

begin 


definition
  let f be FinSequence of NAT,m be Nat;
  func f mod m -> FinSequence of NAT means


  len(it) = len(f) & for i being Nat st i in dom f holds it.i = (f.i) mod m;
end;

theorem 
  for f be FinSequence of NAT st m <> 0 holds (Product(f mod m)) mod m =
  (Product f) mod m;

theorem 
  a <> 0 & m > 1 & a*n mod m = n mod m & m,n are_relative_prime
  implies a mod m = 1;

theorem 
  (F mod m) mod m = F mod m;

theorem 
  (a*(F mod m)) mod m = (a*F) mod m;

theorem 
  for F,G being FinSequence of NAT holds (F ^ G) mod m = (F mod m) ^ (G mod m);

theorem 
  for F,G being FinSequence of NAT holds (a*(F ^ G)) mod m = ((a*F) mod
  m) ^ ((a*G) mod m);



theorem 
  a <> 0 & m <> 0 & a,m are_relative_prime implies for b holds a |^ b,m
  are_relative_prime;

begin 


theorem 
  a <> 0 & m > 1 & a,m are_relative_prime implies (a |^ Euler m) mod m = 1;




theorem 
  a <> 0 & m is prime & a,m are_relative_prime implies (a |^ m) mod m = a mod m
;














begin 

reserve c, c1, c2, d, d1, d2, e for Real,
   k, n, m, N, n1, N0, N1, N2, N3, M for Element of NAT,
  x for set;

theorem 
  for t,t1 being Real_Sequence st t.0 = 0 & (for n st n > 0 holds t.n =
12*(n to_power 3)*log(2,n) - 5*n^2 + (log(2,n))^2 +36) & (for n st n > 0 holds
t1.n = (n to_power 3)*log(2,n)) ex s,s1 being eventually-positive Real_Sequence
  st s = t & s1 = t1 & s in Big_Oh(s1);

theorem 
  for a,b being logbase Real, f,g being Real_Sequence st a > 1 & b > 1 &
  (for n st n > 0 holds f.n = log(a,n)) & (for n st n > 0 holds g.n = log(b,n))
  holds ex s,s1 being eventually-positive Real_Sequence st s = f & s1 = g &
  Big_Oh(s) = Big_Oh(s1);

definition
  let a,b,c be Real;
  func seq_a^(a,b,c) -> Real_Sequence means


  it.n = a to_power (b*n+c);
end;

registration
  let a be positive Real, b,c be Real;
  cluster seq_a^(a,b,c) -> eventually-positive;
end;

theorem 
  for a,b being positive Real st a < b holds not seq_a^(b,1,0) in Big_Oh
  (seq_a^(a,1,0));



definition
  func seq_logn -> Real_Sequence means


  it.0 = 0 & for n st n > 0 holds it.n = log(2,n);
end;

definition
  let a be Real;
  func seq_n^(a) -> Real_Sequence means


  it.0 = 0 & for n st n > 0 holds it.n = n to_power a;
end;

registration
  cluster seq_logn -> eventually-positive;
end;

registration
  let a be Real;
  cluster seq_n^(a) -> eventually-positive;
end;

theorem 
  for f,g being eventually-nonnegative Real_Sequence holds Big_Oh(f
  ) c= Big_Oh(g) & not Big_Oh(f) = Big_Oh(g) iff f in Big_Oh(g) & not f in
  Big_Omega(g);

theorem 
  Big_Oh(seq_logn) c= Big_Oh(seq_n^(1/2)) & not Big_Oh(seq_logn) =
  Big_Oh(seq_n^(1/2));



theorem 
  seq_n^(1/2) in Big_Omega(seq_logn) & not seq_logn in Big_Omega(seq_n^( 1/2));

theorem 
  for f being Real_Sequence, k being Element of NAT st (for n holds f.n
  = Sum(seq_n^(k), n)) holds f in Big_Theta(seq_n^(k+1));



theorem 
  for f being Real_Sequence st (for n st n > 0 holds f.n = (n to_power
log(2,n))) holds ex s being eventually-positive Real_Sequence st s = f & not s
  is smooth;



definition
  let b be Real;
  func seq_const(b) -> Real_Sequence equals

  NAT --> b;
end;

registration
  cluster seq_const(1) -> eventually-nonnegative;
end;

theorem 
  for f being eventually-nonnegative Real_Sequence holds ex F being
  FUNCTION_DOMAIN of NAT,REAL st F = { seq_n^(1) } & (f in F to_power Big_Oh(
seq_const(1)) iff ex N,c,k st c>0 & for n st n >= N holds 1 <= f.n & f.n <= c*(
  seq_n^(k)).n);

begin 

theorem 
  for f being Real_Sequence st (for n holds f.n = 3*(10 to_power 6) - 18
  *(10 to_power 3)*n + 27*n^2) holds f in Big_Oh(seq_n^(2));





begin 

theorem 
  seq_n^(2) in Big_Oh(seq_n^(3));

theorem 
  not seq_n^(2) in Big_Omega(seq_n^(3));

theorem 
  ex s being eventually-positive Real_Sequence st s = seq_a^(2,1,1) &
  seq_a^(2,1,0) in Big_Theta(s);

definition
  let a be Element of NAT;
  func seq_n!(a) -> Real_Sequence means


  it.n = (n+a)!;
end;

registration
  let a be Element of NAT;
  cluster seq_n!(a) -> eventually-positive;
end;

theorem 
  not seq_n!(0) in Big_Theta(seq_n!(1));

begin

theorem 
  for f being Real_Sequence st f in Big_Oh(seq_n^(1)) holds f(#)f in
  Big_Oh(seq_n^(2));

begin 

theorem 
  ex s being eventually-positive Real_Sequence st s = seq_a^(2,1,0) & 2
  (#)seq_n^(1) in Big_Oh( seq_n^(1) ) & not seq_a^(2,2,0) in Big_Oh(s);

begin 

theorem 
  log(2,3) < 159/100 implies seq_n^(log(2,3)) in Big_Oh(seq_n^(159/100))
& not seq_n^(log(2,3)) in Big_Omega(seq_n^(159/100)) & not seq_n^(log(2,3)) in
  Big_Theta(seq_n^(159/100));




begin 

theorem 
  for f,g being Real_Sequence st (for n holds f.n = n mod 2) & (for n
holds g.n = n+1 mod 2) holds ex s,s1 being eventually-nonnegative Real_Sequence
  st s = f & s1 = g & not s in Big_Oh(s1) & not s1 in Big_Oh(s);











begin 

theorem 
  for f,g being eventually-nonnegative Real_Sequence holds Big_Oh(f) =
  Big_Oh(g) iff f in Big_Theta(g);

theorem 
  for f,g being eventually-nonnegative Real_Sequence holds f in
  Big_Theta(g) iff Big_Theta(f) = Big_Theta(g);



begin

theorem 
  for e being Real, f being Real_Sequence st 0 < e & (for n st n > 0
holds f.n = n*log(2,n)) holds ex s being eventually-positive Real_Sequence st s
  = f & Big_Oh(s) c= Big_Oh(seq_n^(1+e)) & not Big_Oh(s) = Big_Oh(seq_n^(1+e));

theorem 
  for e being Real, g being Real_Sequence st e < 1 & (for n st n > 1
  holds g.n = (n to_power 2)/log(2,n)) holds ex s being eventually-positive
Real_Sequence st s = g & Big_Oh(seq_n^(1+e)) c= Big_Oh(s) & not Big_Oh(seq_n^(1
  +e)) = Big_Oh(s);

theorem 
  for f being Real_Sequence st (for n st n > 1 holds f.n = (n to_power 2
  )/log(2,n)) holds ex s being eventually-positive Real_Sequence st s = f &
  Big_Oh(s) c= Big_Oh(seq_n^(8)) & not Big_Oh(s) = Big_Oh(seq_n^(8));

theorem 
  for g being Real_Sequence st (for n holds g.n = (n^2 - n + 1) to_power
4) holds ex s being eventually-positive Real_Sequence st s = g & Big_Oh(seq_n^(
  8)) = Big_Oh(s);

theorem 
  for e being Real st 0 < e & e < 1 holds ex s being eventually-positive
  Real_Sequence st s = seq_a^(1+e,1,0) & Big_Oh(seq_n^(8)) c= Big_Oh(s) & not
  Big_Oh(seq_n^(8)) = Big_Oh(s);

begin

theorem 
  for f,g being Real_Sequence st (for n st n > 0 holds f.n = (n to_power
  log(2,n))) & (for n st n > 0 holds g.n = (n to_power sqrt n)) holds ex s,s1
being eventually-positive Real_Sequence st s = f & s1 = g & Big_Oh(s) c= Big_Oh
  (s1) & not Big_Oh(s) = Big_Oh(s1);

theorem 
  for f being Real_Sequence st (for n st n > 0 holds f.n = (n to_power
sqrt n)) holds ex s,s1 being eventually-positive Real_Sequence st s = f & s1 =
  seq_a^(2,1,0) & Big_Oh(s) c= Big_Oh(s1) & not Big_Oh(s) = Big_Oh(s1);

theorem 
  ex s, s1 being eventually-positive Real_Sequence st s = seq_a^(2,1,0)
  & s1 = seq_a^(2,1,1) & Big_Oh(s) = Big_Oh(s1);

theorem 
  ex s, s1 being eventually-positive Real_Sequence st s = seq_a^(2,1,0)
  & s1 = seq_a^(2,2,0) & Big_Oh(s) c= Big_Oh(s1) & not Big_Oh(s) = Big_Oh(s1);

theorem 
  ex s being eventually-positive Real_Sequence st s = seq_a^(2,2,0) &
  Big_Oh(s) c= Big_Oh(seq_n!(0)) & not Big_Oh(s) = Big_Oh(seq_n!(0));

theorem 
  Big_Oh(seq_n!(0)) c= Big_Oh(seq_n!(1)) & not Big_Oh(seq_n!(0)) =
  Big_Oh(seq_n!(1));

theorem 
  for g being Real_Sequence st (for n st n > 0 holds g.n = (n to_power n
)) holds ex s being eventually-positive Real_Sequence st s = g & Big_Oh(seq_n!(
  1)) c= Big_Oh(s) & not Big_Oh(seq_n!(1)) = Big_Oh(s);

begin

theorem 
  for n st n >= 1 holds for f being Real_Sequence, k being Element of
NAT st (for n holds f.n = Sum(seq_n^(k), n)) holds f.n >= (n to_power (k+1)) /
  (k+1);

begin

theorem 
  for f,g being Real_Sequence st (for n st n > 0 holds g.n = n*log(2,n))
  & (for n holds f.n = log(2,n!)) holds ex s being eventually-nonnegative
  Real_Sequence st s = g & f in Big_Theta(s);



begin 






theorem 
  for f being eventually-nondecreasing eventually-nonnegative
Real_Sequence , t being Real_Sequence st (for n holds (n mod 2 = 0 implies t.n
  = 1) & (n mod 2 = 1 implies t.n = n)) holds not t in Big_Theta(f);



begin



begin 

definition

  func POWEROF2SET -> non empty Subset of NAT equals

  { 2 to_power n where n is
  Element of NAT : not contradiction };
end;

theorem 
  for f being Real_Sequence st (for n holds (n in POWEROF2SET implies f.
  n = n) & (not n in POWEROF2SET implies f.n = 2 to_power n)) holds f in
  Big_Theta(seq_n^(1), POWEROF2SET) & not f in Big_Theta(seq_n^(1)) & seq_n^(1)
  is smooth & not f is eventually-nondecreasing;

theorem 
  for f,g being Real_Sequence st (for n st n > 0 holds f.n = (n to_power
(2 to_power [\log(2,n)/] ))) & (for n st n > 0 holds g.n = (n to_power n)) ex s
  being eventually-positive Real_Sequence st s = g & f in Big_Theta(s,
  POWEROF2SET) & not f in Big_Theta(s) & f is eventually-nondecreasing & s is
  eventually-nondecreasing & not s is_smooth_wrt 2;

theorem 
  for g being Real_Sequence st (for n holds (n in POWEROF2SET implies g.
  n = n) & (not n in POWEROF2SET implies g.n = n to_power 2)) holds ex s being
  eventually-positive Real_Sequence st s = g & seq_n^(1) in Big_Theta(s,
  POWEROF2SET) & not seq_n^(1) in Big_Theta(s) & s taken_every 2 in Big_Oh(s) &
  seq_n^(1) is eventually-nondecreasing & not s is eventually-nondecreasing;

begin

definition
  let x be Element of NAT;
  func Step1(x) -> Element of NAT means


  ex n st n! <= x & x < (n+1)! & it = n! if x <> 0 otherwise it = 0;
end;

theorem 
  for f being Real_Sequence st (for n holds f.n = Step1(n)) holds ex s
  being eventually-positive Real_Sequence st s = f & f is
eventually-nondecreasing & (for n holds f.n <= (seq_n^(1)).n) & not s is smooth
;




begin





theorem 
  for F being eventually-nonnegative Real_Sequence st F = seq_n^(1) -
  seq_const(1) holds Big_Theta(F) + Big_Theta(seq_n^(1)) = Big_Theta(seq_n^(1))
;

begin 

theorem 
  ex F being FUNCTION_DOMAIN of NAT,REAL st F = { seq_n^(1) } & (for n
  holds (seq_n^(-1)).n <= (seq_n^(1)).n) & not seq_n^(-1) in F to_power Big_Oh(
  seq_const(1));

begin 




theorem 
  for c being non negative Real, x,f being eventually-nonnegative
  Real_Sequence st ex e,N st e > 0 & for n st n >= N holds f.n >= e holds x in
  Big_Oh(c+f) implies x in Big_Oh(f);

begin 

theorem 
  2 to_power 12 = 4096;

theorem 
  for n st n >= 3 holds n^2 > 2*n + 1;

theorem 
  for n st n >= 10 holds 2 to_power (n-1) > (2*n)^2;

theorem 
  for n st n >= 9 holds (n+1) to_power 6 < 2*(n to_power 6);

theorem 
  for n st n >= 30 holds 2 to_power n > n to_power 6;

theorem 
  for x being Real st x > 9 holds 2 to_power x > (2*x)^2;

theorem 
  ex N st for n st n >= N holds sqrt n - log(2, n) > 1;

theorem 
  for a,b,c being Real st a > 0 & c > 0 & c <> 1 holds a to_power b = c
  to_power (b*log(c,a));

theorem 
  5! = 120;

theorem 
  5 to_power 5 = 3125;

theorem 
  4 to_power 4 = 256;

theorem 
  for n holds (n^2 - n + 1) > 0;

theorem 
  for n st n >= 2 holds n! > 1;

theorem 
  for n1, n st n <= n1 holds n! <= n1!;

theorem 
  for k st k >= 1 holds ex n st (n! <= k & k < (n+1)! & for m st m! <= k
  & k < (m+1)! holds m = n);

theorem 
  for n st n >= 2 holds [/n/2\] < n;

theorem 
  for n st n >= 3 holds n! > n;

theorem 
  seq_n^(1) - seq_const(1) is eventually-positive;

theorem 
  for n st n >= 2 holds 2 to_power n > n+1;

theorem 
  for a being logbase Real, f being Real_Sequence st a > 1 & f.0 = 0 & (
  for n st n > 0 holds f.n = log(a,n)) holds f is eventually-positive;

theorem 
  for f,g being eventually-nonnegative Real_Sequence holds f in Big_Oh(g
  ) & g in Big_Oh(f) iff Big_Oh(f) = Big_Oh(g);

theorem 
  for a, b, c being Real st 0 < a & a <= b & c >= 0 holds a to_power c
  <= b to_power c;

theorem 
  for n st n >= 4 holds 2*n + 3 < 2 to_power n;

theorem 
  for n st n >= 6 holds (n+1)^2 < 2 to_power n;

theorem 
  for c being Real st c > 6 holds c^2 < 2 to_power c;

theorem 
  for e being positive Real, f being Real_Sequence st f.0 = 0 & (for n
st n > 0 holds f.n = log(2,n to_power e)) holds (f /" seq_n^(e)) is convergent
  & lim (f /" seq_n^(e)) = 0;

theorem 
  for e being Real st e > 0 holds (seq_logn/"seq_n^(e)) is convergent &
  lim(seq_logn/"seq_n^(e)) = 0;

theorem 
  for f being Real_Sequence holds for N holds (for n st n <= N holds f.n
  >= 0) implies Sum(f,N) >= 0;

theorem 
  for f,g being Real_Sequence holds for N holds (for n st n <= N holds f
  .n <= g.n) implies Sum(f,N) <= Sum (g,N);

theorem 
  for f being Real_Sequence, b being Real st f.0 = 0 & (for n st n > 0
  holds f.n = b) holds for N being Element of NAT holds Sum(f,N) = b*N;

theorem 
  for f being Real_Sequence, N,M being Element of NAT holds Sum(f,N,M) +
  f.(N+1) = Sum(f,N+1,M);

theorem 
  for f,g being Real_Sequence, M being Element of NAT holds for N st N
  >= M+1 holds (for n st M+1 <= n & n <= N holds f.n <= g.n) implies Sum(f,N,M)
  <= Sum (g,N,M);

theorem 
  for n holds [/n/2\] <= n;

theorem 
  for f being Real_Sequence, b being Real, N being Element of NAT st f.0
= 0 & (for n st n > 0 holds f.n = b) holds for M being Element of NAT holds Sum
  (f, N, M) = b*(N-M);

theorem 
  for f,g being Real_Sequence, N being Element of NAT, c being Real st f
  is convergent & lim f = c & for n st n >= N holds f.n = g.n holds g is
  convergent & lim g = c;

theorem 
  for n st n >= 1 holds (n^2 -n + 1) <= n^2;

theorem 
  for n st n >= 1 holds n^2 <= 2*(n^2 -n + 1);

theorem 
  for e being Real st 0 < e & e < 1 holds ex N st for n st n >= N holds
  n*log(2,1+e) - 8*log(2,n) > 8*log(2,n);

theorem 
  for n st n >= 10 holds 2 to_power (2*n) / (n!) < 1/(2 to_power (n-9));

theorem 
  for n st n >= 3 holds 2*(n-2) >= n-1;

theorem 
  for c being real number st c >= 0 holds c to_power (1/2) = sqrt c;

theorem 
  ex N st for n st n >= N holds n - sqrt n*log(2,n) > n/2;




theorem 
  for s being Real_Sequence st for n holds s.n = (1 + 1/(n+1)) to_power
  (n+1) holds s is non-decreasing;



theorem 
  for n st n >= 1 holds ((n+1)/n) to_power n <= ((n+2)/(n+1)) to_power (
  n+1);

theorem 
  for k,n st k <= n holds n choose k >= ((n+1) choose k) / (n+1);

theorem 
  for f being Real_Sequence st (for n holds f.n = log(2,n!)) holds for n
  holds f.n = Sum(seq_logn, n);

theorem 
  for n st n >= 4 holds n*log(2,n) >= 2*n;

theorem 
  for n st n >= 2 holds n^2 > n+1;

theorem 
  for n st n >= 1 holds (2 to_power (n+1)) - (2 to_power n) > 1;

theorem 
  for n st n >= 2 holds not ((2 to_power n) - 1) in POWEROF2SET;

theorem 
  for n,k st k >= 1 & n! <= k & k < (n+1)! holds Step1(k) = n!;

theorem 
  for a,b,c being Real holds a>1 & b>=a & c>=1 implies log(a,c) >= log(b
  ,c);














begin

reserve a,b,c for positive real number,
  m,x,y,z for real number,
  n for Element of NAT,
  s,s1,s2,s3,s4,s5 for Real_Sequence;

registration
  let x;
  cluster abs x -> non negative;
end;

theorem 
  y>x & x>=0 & m>=0 implies x/y <= (x+m)/(y+m);

theorem 
  (a+b)/2>=sqrt(a*b);

theorem 
  b/a+a/b>=2;

theorem 
  ((x+y)/2)^2>=x*y;

theorem 
  (x^2+y^2)/2>=((x+y)/2)^2;

theorem 
  x^2+y^2>=2*x*y;

theorem 
  (x^2+y^2)/2>=x*y;

theorem 
  x^2+y^2>=2*abs(x)*abs(y);

theorem 
  (x+y)^2>=4*x*y;

theorem 
  x^2+y^2+z^2>=x*y+y*z+x*z;

theorem 
  (x+y+z)^2>=3*(x*y+y*z+x*z);

theorem 
  a|^3+b|^3+c|^3>=3*a*b*c;

theorem 
  (a|^3+b|^3+c|^3)/3>=a*b*c;

theorem 
  (a/b)|^3+(b/c)|^3+(c/a)|^3>=b/a+c/b+a/c;

theorem 
  (a+b+c)>=3*(3-root(a*b*c));

theorem 
  (a+b+c)/3>=3-root(a*b*c);

theorem 
  x+y+z=1 implies x*y+y*z+x*z<=1/3;

theorem 
  x+y=1 implies x*y<=1/4;

theorem 
  x+y=1 implies x^2+y^2>=1/2;

theorem 
  a+b=1 implies (1+1/a)*(1+1/b)>=9;

theorem 
  x+y=1 implies x|^3+y|^3>=1/4;

theorem 
  a+b=1 implies a|^3+b|^3<1;

theorem 
  a+b=1 implies (a+1/a)*(b+1/b)>=25/4;

theorem 
  for x, a being real number st abs(x)<=a holds x^2<=a^2;

theorem 
  abs(x)>=a implies x^2>=a^2;

theorem 
  abs(abs(x)-abs(y))<=abs(x)+abs(y);

theorem 
  a*b*c = 1 implies (1/a)+(1/b)+(1/c)>=sqrt(a)+sqrt(b)+sqrt(c);

theorem 
  x>0 & y>0 & z<0 & x+y+z=0 implies (x|^2+y|^2+z|^2)|^3>=6*(x|^3+y|^3+z |^3)^2;

theorem 
  a>=1 implies (a to_power b)+(a to_power c)>=2*(a to_power sqrt(b*c));

theorem 
  a>=b & b>=c implies (a to_power a)*(b to_power b)*(c to_power c)>=(a*b
  *c) to_power ((a+b+c)/3);

theorem 
  for a,b being non negative real number holds (a+b)|^(n+2)>=a|^
  (n+2)+(n+2)*(a|^(n+1))*b;

theorem 
  (a|^n+b|^n)/2 >= ((a+b)/2)|^n;

theorem 
  (for n holds s.n>0) implies for n holds (Partial_Sums s).n>0;

theorem 
  (for n holds s.n>=0) implies for n holds (Partial_Sums s).n>=0;

theorem 
  (for n holds s.n<0) implies (Partial_Sums s).n<0;

theorem 
  s=s1(#)s1 implies for n holds (Partial_Sums s).n>=0;

theorem 
  (for n holds s.n>0 & s.n>s.(n-1)) implies (n+1)*s.(n+1) > ( Partial_Sums s).n
;

theorem 
  (for n holds s.n>0 & s.n>=s.(n-1)) implies (n+1)*s.(n+1) >= (
  Partial_Sums s).n;

theorem 
  (s=s1(#)s2 & for n holds s1.n>=0 & s2.n>=0) implies for n holds (
  Partial_Sums s).n<= (Partial_Sums(s1).n)*(Partial_Sums(s2).n);

theorem 
  (s=s1(#)s2 & for n holds s1.n<0 & s2.n<0) implies (Partial_Sums s).n<=
  (Partial_Sums(s1).n)*(Partial_Sums(s2).n);

theorem 
  for n holds abs((Partial_Sums s).n)<=(Partial_Sums (abs s)).n;

theorem 
  (Partial_Sums s).n<=(Partial_Sums abs s).n;

definition
  let s;
  func Partial_Product(s) -> Real_Sequence means


  it.0=s.0 & for n holds it.(n+1) = it.n * s.(n+1);
end;

theorem 
  (for n holds s.n>0) implies (Partial_Product s).n>0;

theorem 
  (for n holds s.n>=0) implies (Partial_Product s).n>=0;

theorem 
  (for n holds s.n>0 & s.n<1) implies for n holds (Partial_Product s).n>
  0 & (Partial_Product s).n<1;

theorem 
  (for n holds s.n>=1) implies for n holds (Partial_Product s).n>=1;

theorem 
  (for n holds s1.n>=0 & s2.n>=0) implies for n holds (Partial_Product
  s1).n+(Partial_Product s2).n<= (Partial_Product(s1+s2)).n;

theorem 
  (for n holds s.n=(2*n+1)/(2*n+2)) implies (Partial_Product s).n<=1/
  sqrt(3*n+4);

theorem 
  (for n holds s1.n=1+s.n & s.n>-1 & s.n<0) implies for n holds 1+
  Partial_Sums(s).n<=(Partial_Product s1).n;

theorem 
  (for n holds s1.n=1+s.n & s.n>=0) implies for n holds 1+Partial_Sums(s
  ).n<=(Partial_Product s1).n;

theorem 
  s3=s1(#)s2 & s4=s1(#)s1 & s5=s2(#)s2 implies for n holds ((
  Partial_Sums s3).n)^2<=(Partial_Sums s4).n*(Partial_Sums s5).n;

theorem 
  (s4=s1(#)s1 & s5=s2(#)s2 & for n holds s1.n>=0 & s2.n>=0 & s3.n=(s1.n+
s2.n)^2) implies for n holds sqrt((Partial_Sums s3).n) <= sqrt((Partial_Sums s4
  ).n) + sqrt((Partial_Sums s5).n);

theorem 
  (for n holds s.n>0 & s.n>=s.(n-1)) implies (Partial_Sums s).n>=(n+1)*(
  (n+1)-root((Partial_Product s).n));














begin

reserve n for Element of NAT,
  a,b,c,d for real number,
  s for Real_Sequence;

theorem 
  (a+b+c)|^2=a|^2+b|^2+c|^2+2*a*b+2*a*c+2*b*c;

theorem 
  (a+b)|^3 = a|^3+3*a|^2*b+3*b|^2*a+b|^3;

theorem 
  (a-b+c)|^2=a|^2+b|^2+c|^2-2*a*b+2*a*c-2*b*c;

theorem 
  (a-b-c)|^2=a|^2+b|^2+c|^2-2*a*b-2*a*c+2*b*c;

theorem 
  (a-b)|^3 = a|^3-3*a|^2*b+3*b|^2*a-b|^3;

theorem 
  (a+b)|^4 = a|^4+4*a|^3*b+6*a|^2*b|^2+4*b|^3*a+b|^4;

theorem 
  (a+b+c+d)|^2 = a|^2+b|^2+c|^2+d|^2+(2*a*b+2*a*c+2*a*d) +(2*b*c+2*b*d)+ 2*c*d;

theorem 
  (a+b+c)|^3=a|^3+b|^3+c|^3+(3*a|^2*b+3*a|^2*c)+ (3*b|^2*a+3*b|^2*c)+(3*
  c|^2*a+3*c|^2*b)+6*a*b*c;

theorem 
  a<>0 implies ((1/a)|^(n+1)+a|^(n+1))|^2 = (1/a)|^(2*n+2)+a|^(2*n+2)+2;



theorem 
  (a <> 1 & for n holds s.n = a|^n) implies Partial_Sums(s).n = (1 - a|^
  (n+1))/(1-a);

theorem 
  (a <> 1 & a <> 0 & for n holds s.n = (1/a)|^n) implies for n holds
  Partial_Sums(s).n = ((1/a)|^n-a)/(1-a);



theorem 
  (for n holds s.n = 10|^n+2*n+1) implies Partial_Sums(s).n = 10|^(n+1)/
  9-1/9+(n+1)|^2;

theorem 
  (for n holds s.n = 2*n-1+(1/2)|^n) implies Partial_Sums(s).n =n|^2+1-(
  1/2)|^n;

theorem 
  (for n holds s.n = n*(1/2)|^n) implies Partial_Sums(s).n =2-(2+n)*(1/2 )|^n;

theorem 
  (for n holds s.n = ((1/2)|^n+2|^n)|^2) implies for n holds
  Partial_Sums(s).n=-(1/4)|^n/3+4|^(n+1)/3+2*n+3;

theorem 
  (for n holds s.n = ((1/3)|^n+3|^n)|^2) implies for n holds
  Partial_Sums(s).n = -(1/9)|^n/8+9|^(n+1)/8+2*n+3;

theorem 
  (for n holds s.n = n*2|^n) implies for n holds Partial_Sums(s).n = n*2
  |^(n+1)-2|^(n+1)+2;

theorem 
  (for n holds s.n = (2*n+1)*3|^n) implies for n holds Partial_Sums(s).n
  = n*3|^(n+1)+1;

theorem 
  (a <> 1 & for n holds s.n = n*a|^n) implies for n holds Partial_Sums(s
  ).n = a*(1-a|^n)/(1-a)|^2 - n*a|^(n+1)/(1-a);

theorem 
  (for n holds s.n = 1/((2 -Root (n+1))+(2 -Root n))) implies
  Partial_Sums(s).n = 2 -Root (n+1);

theorem 
  (for n holds s.n = 2|^n + (1/2)|^n) implies for n holds Partial_Sums(s
  ).n = 2|^(n+1)-(1/2)|^n+1;

theorem 
  (for n holds s.n = n!*n+n/((n+1)!)) implies for n st n>=1 holds
  Partial_Sums(s).n = (n+1)!-1/((n+1)!);

theorem 
  (a <> 1 & for n st n>=1 holds s.n = (a/(a-1))|^n & s.0=0) implies for
  n st n>=1 holds Partial_Sums(s).n = a*((a/(a-1))|^n-1);

theorem 
  (for n st n>=1 holds s.n = 2|^n*((3*n-1)/4) & s.0=0) implies for n st
  n>=1 holds Partial_Sums(s).n = 2|^n*((3*n-4)/2)+2;



theorem 
  (for n holds s.n = (n+1)/(n+2)) implies (Partial_Product s).n = 1/(n+2 );

theorem 
  (for n holds s.n = 1/(n+1)) implies (Partial_Product s).n = 1/((n+1)!);

theorem 
  (for n st n>=1 holds s.n = n & s.0 = 1) implies for n st n>=1 holds (
  Partial_Product s).n = n!;

theorem 
  (for n st n>=1 holds s.n = a/n & s.0 = 1) implies for n st n>=1 holds
  (Partial_Product s).n = a|^n/(n!);

theorem 
  (for n st n>=1 holds s.n = a & s.0 = 1) implies for n st n>=1 holds (
  Partial_Product s).n = a|^n;

theorem 
  (for n st n>=2 holds s.n = 1-1/(n|^2) & s.0 = 1 & s.1 = 1) implies for
  n st n>=2 holds (Partial_Product s).n = (n+1)/(2*n);















begin

reserve a,b,c,d for positive real number,
  m,u,w,x,y,z for real number,
  n,k for Element of NAT,
  s,s1 for Real_Sequence;

theorem 
  (a+b)*(1/a+1/b)>=4;

theorem 
  a|^4+b|^4>=a|^3*b+a*b|^3;

theorem 
  a<b implies 1<(b+c)/(a+c);

theorem 
  a<b implies a/b<sqrt(a/b);

theorem 
  a<b implies sqrt(a/b)<(b+sqrt((a^2+b^2)/2))/(a+sqrt((a^2+b^2)/2));

theorem 
  a<b implies a/b<(b+sqrt((a^2+b^2)/2))/(a+sqrt((a^2+b^2)/2));

theorem 
  2/((1/a)+(1/b))<=sqrt(a*b);

theorem 
  (a+b)/2<=sqrt((a^2+b^2)/2);

theorem 
  x+y<=sqrt(2*(x^2+y^2));

theorem 
  2/((1/a)+(1/b))<=(a+b)/2;

theorem 
  sqrt(a*b)<=sqrt((a^2+b^2)/2);

theorem 
  2/((1/a)+(1/b))<=sqrt((a^2+b^2)/2);

theorem 
  abs x<1 & abs y<1 implies abs((x+y)/(1+x*y))<=1;

theorem 
  abs(x+y)/(1+abs(x+y))<=abs(x)/(1+abs x)+abs(y)/(1+abs y);

theorem 
  a/(a+b+d)+b/(a+b+c)+c/(b+c+d)+d/(a+c+d)>1;

theorem 
  a/(a+b+d)+b/(a+b+c)+c/(b+c+d)+d/(a+c+d)<2;

theorem 
  a+b>c & b+c>a & a+c>b implies 1/(a+b-c)+1/(b+c-a)+1/(c+a-b)>=9/(a+b+c);

theorem 
  sqrt((a+b)*(c+d))>=sqrt(a*c)+sqrt(b*d);

theorem 
  (a*b+c*d)*(a*c+b*d)>=4*a*b*c*d;

theorem 
  a/b+b/c+c/a>=3;

theorem 
  a*b+b*c+c*a=1 implies a+b+c>=sqrt 3;

theorem 
  (b+c-a)/a+(c+a-b)/b+(a+b-c)/c>=3;

theorem 
  (a+1/a)*(b+1/b)>=(sqrt(a*b)+1/sqrt(a*b))^2;

theorem 
  (b*c)/a+(a*c)/b+(a*b)/c>=a+b+c;

theorem 
  x>y & y>z implies x^2*y+y^2*z+z^2*x>x*y^2+y*z^2+z*x^2;

theorem 
  a>b & b>c implies b/(a-b)>c/(a-c);

theorem 
  b>a & c>d implies c/(c+a)>d/(d+b);

theorem 
  m*x+z*y<=sqrt(m^2+z^2)*sqrt(x^2+y^2);

theorem 
  (m*x+u*y+w*z)^2<=(m^2+u^2+w^2)*(x^2+y^2+z^2);

theorem 
  (9*a*b*c)/(a^2+b^2+c^2)<=a+b+c;

theorem 
  a+b+c<=sqrt((a^2+a*b+b^2)/3)+sqrt((b^2+b*c+c^2)/3)+sqrt((c^2+c*a+a^2)/ 3);

theorem 
  sqrt((a^2+a*b+b^2)/3)+sqrt((b^2+b*c+c^2)/3)+sqrt((c^2+c*a+a^2)/3) <=
  sqrt((a^2+b^2)/2)+sqrt((b^2+c^2)/2)+sqrt((c^2+a^2)/2);

theorem 
  sqrt((a^2+b^2)/2)+sqrt((b^2+c^2)/2)+sqrt((c^2+a^2)/2) <=sqrt(3*(a^2+b
  ^2+c^2));

theorem 
  sqrt(3*(a^2+b^2+c^2))<=(b*c)/a+(c*a)/b+(a*b)/c;

theorem 
  a+b=1 implies (1/a^2-1)*(1/b^2-1)>=9;

theorem 
  a+b=1 implies a*b+1/(a*b)>=17/4;

theorem 
  a+b+c = 1 implies 1/a+1/b+1/c>=9;

theorem 
  a+b+c = 1 implies (1/a-1)*(1/b-1)*(1/c-1)>=8;

theorem 
  a+b+c = 1 implies (1+1/a)*(1+1/b)*(1+1/c)>=64;

theorem 
  x+y+z=1 implies x^2+y^2+z^2>=1/3;

theorem 
  x+y+z=1 implies x*y+y*z+z*x<=1/3;

theorem 
  a>b & b>c implies (a to_power (2*a))*(b to_power (2*b))*(c to_power (2
  *c)) > (a to_power (b+c))*(b to_power (a+c))*(c to_power (a+b));

theorem 
  n>=1 implies a|^(n+1)+b|^(n+1)>=a|^n*b+a*b|^n;

theorem 
  a^2+b^2=c^2 & n>=3 implies a|^(n+2)+b|^(n+2)<c|^(n+2);

theorem 
  n>=1 implies (1+1/(n+1))|^n<(1+1/n)|^(n+1);

theorem 
  n>=1 & k>=1 implies (a|^k+b|^k)*(a|^n+b|^n)<=2*(a|^(k+n)+b|^(k+n));

theorem 
  (for n holds s.n=1/sqrt(n+1)) implies for n holds (Partial_Sums s).n<2
  *sqrt(n+1);

theorem 
  (for n holds s.n=1/((n+1)^2)) implies for n holds (Partial_Sums
  s).n<=2-1/(n+1);

theorem 
  (for n holds s.n=1/((n+1)^2)) implies (Partial_Sums s).n<2;

theorem 
  (for n holds s.n<1) implies for n holds Partial_Sums(s).n<n+1;

theorem 
  (for n holds s.n>0 & s.n<1) implies for n holds Partial_Product(s).n>=
  Partial_Sums(s).n-n;

theorem 
  (for n holds s.n>0 & s1.n=1/s.n) implies for n holds Partial_Sums(s1).n>0;

theorem 
  (for n holds s.n>0 & s1.n=1/s.n) implies for n holds Partial_Sums(s).n
  *Partial_Sums(s1).n>=(n+1)^2;

theorem 
  (for n st n>=1 holds s.n=sqrt(n) & s.0=0) implies for n st n>=1 holds
  Partial_Sums(s).n<1/6*(4*n+3)*sqrt(n);

theorem 
  (for n st n>=1 holds s.n=sqrt(n) & s.0=0) implies for n st n>=1 holds
  Partial_Sums(s).n>(2/3)*n*sqrt(n);

theorem 
  (for n st n>=1 holds s.n=1+1/(2*n+1) & s.0=1) implies for n st n>=1
  holds Partial_Product(s).n>(1/2)*sqrt(2*n+3);

theorem 
  (for n st n>=1 holds s.n=sqrt(n*(n+1)) & s.0=0) implies for n st n>=1
  holds Partial_Sums(s).n>(n*(n+1))/2;














begin

reserve a,b,c,d,x,y,X,w,z,x1,x2,x3,x4 for set;
reserve A for non empty set;

definition
  func QUATERNION equals

  Funcs(4,REAL) \ { x where x is Element of Funcs(4,REAL):
  x.2 = 0 & x.3 = 0} \/ COMPLEX;
end;

definition
  let x be number;
  attr x is quaternion means


  x in QUATERNION;
end;

registration
  cluster QUATERNION -> non empty;
end;

definition
  let x,y,w,z,a,b,c,d;
  func (x,y,w,z) --> (a,b,c,d) -> set equals

  ((x,y) --> (a,b)) +* ((w,z) --> (c,d));
end;

registration
  let x,y,w,z,a,b,c,d;
  cluster (x,y,w,z) --> (a,b,c,d) -> Function-like Relation-like;
end;

theorem 
  dom (x,y,w,z) --> (a,b,c,d) = {x,y,w,z};

theorem 
  rng ((x,y,w,z) --> (a,b,c,d)) c= {a,b,c,d};

theorem 
  x,y,w,z are_mutually_different implies
  ((x,y,w,z) --> (a,b,c,d)).x=a & ((x,y,w,z) --> (a,b,c,d)).y=b &
  ((x,y,w,z) --> (a,b,c,d)).w=c & ((x,y,w,z) --> (a,b,c,d)).z=d;

theorem 
  x,y,w,z are_mutually_different implies
  rng ((x,y,w,z) --> (a,b,c,d)) = {a,b,c,d};

theorem 
  {x1,x2,x3,x4} c= X iff x1 in X & x2 in X & x3 in X & x4 in X;

definition
  let A,x,y,w,z;
  let a,b,c,d be Element of A;
  redefine func (x,y,w,z) --> (a,b,c,d) -> Function of {x,y,w,z},A;
end;

definition
  func <j> equals

  (0,1,2,3) --> (0,0,1,0);
  func <k> equals

  (0,1,2,3) --> (0,0,0,1);
end;

registration
  cluster <i> -> quaternion;
  cluster <j> -> quaternion;
  cluster <k> -> quaternion;
end;

registration
  cluster quaternion for number;
end;

registration
  cluster -> quaternion for Element of QUATERNION;
end;

definition
  let x,y,w,z be real number;
  func [*x,y,w,z*] -> Element of QUATERNION means


  ex x9, y9 being Element of REAL st
  x9 = x & y9 = y & it = [*x9,y9*] if w=0 & z=0
  otherwise it = (0,1,2,3) --> (x,y,w,z);
end;

theorem 
  for a,b,c,d,e,i,j,k being set,
  g being Function st a<>b & c <>d & dom g = {a,b,c,d} &
  g.a = e & g.b = i & g.c = j & g.d=k holds g = (a,b,c,d) --> (e,i,j,k);

theorem 
  for g being quaternion number
  ex r,s,t,u being Element of REAL st g = [*r,s,t,u*];

theorem 
  a,c,x,w are_mutually_different
  implies (a,c,x,w) --> (b,d,y,z) = { [a,b], [c,d],[x,y],[w,z] };

reserve i,j,k for Element of NAT;
reserve a,b,c,d for Element of REAL;
reserve y,r,s,x,t,w for Element of RAT+;

theorem 
  for A being Subset of RAT+ st (ex t st t in A & t <> {}) &
  for r,s st r in A & s <=' r holds s in A
  ex r1,r2,r3,r4,r5 being Element of RAT+ st
  r1 in A & r2 in A & r3 in A & r4 in A & r5 in A &
  r1 <> r2 & r1 <> r3 & r1<>r4 & r1 <> r5 & r2<> r3 & r2<> r4 &
  r2<> r5& r3 <> r4 & r3 <> r5 & r4 <> r5;

theorem 
  not (0,1,2,3) --> (a,b,c,d) in COMPLEX;

theorem 
  for a,b,c,d,x,y,z,w,x9,y9,z9,w9 being set st a,b,c,d are_mutually_different &
  (a,b,c,d) --> (x,y,z,w) = (a,b,c,d) --> (x9,y9,z9,w9)
  holds x = x9 & y = y9 & z=z9 & w=w9;

theorem 
  for x1,x2,x3,x4,y1,y2,y3,y4 being Element of REAL st [*x1,x2,x3,x4*]
  = [*y1,y2,y3,y4*] holds x1 = y1 & x2 = y2 & x3=y3 & x4=y4;

definition
  let x,y be quaternion number;
  func x + y means


  ex x1,x2,x3,x4,y1,y2,y3,y4 being Element of REAL st
  x = [*x1,x2,x3,x4*] & y = [*y1,y2,y3,y4*] &
  it = [*x1+y1,x2+y2,x3+y3,x4+y4*];
  commutativity;
end;

definition
  let z be quaternion number;
  func - z -> quaternion number means


  z + it = 0;
  involutiveness;
end;

definition
  let x,y be quaternion number;
  func x-y equals

  x + - y;
end;

definition
  let x,y be quaternion number;
  func x*y means


  ex x1,x2,x3,x4,y1,y2,y3,y4 being Element of REAL st
  x = [*x1,x2,x3,x4*] & y = [*y1,y2,y3,y4*] & it = [* x1*y1-x2*y2-x3*y3-x4*y4,
  x1*y2+x2*y1+x3*y4-x4*y3, x1*y3+y1*x3+y2*x4-y4*x2,
  x1*y4+x4*y1+x2*y3-x3*y2 *];
end;

registration
  let z,z9 be quaternion number;
  cluster z + z9 -> quaternion;
  cluster z*z9 -> quaternion;
end;

definition
  redefine func <j> -> Element of QUATERNION equals

  [*0,0,1,0*];
  redefine func <k> -> Element of QUATERNION equals

  [*0,0,0,1*];
end;

theorem 
  <i> * <i> = -1;

theorem 
  <j> * <j> = -1;

theorem 
  <k> * <k> = -1;

theorem 
  <i> * <j> = <k>;

theorem 
  <j> * <k> = <i>;

theorem 
  <k> * <i> = <j>;

theorem 
  <i> * <j> = - <j> * <i>;

theorem 
  <j> * <k> = - <k> * <j>;

theorem 
  <k> * <i> = - <i> * <k>;

definition
  let z be quaternion number;
  func Rea z means


  ex z9 being complex number st z=z9 & it = Re z9 if z in COMPLEX otherwise
  ex f being Function of 4,REAL st z = f & it = f.0;
  func Im1 z means


  ex z9 being complex number st z=z9 & it = Im z9 if z in COMPLEX otherwise
  ex f being Function of 4,REAL st z = f & it = f.1;
  func Im2 z means


  it = 0 if z in COMPLEX otherwise
  ex f being Function of 4,REAL st z = f & it = f.2;
  func Im3 z means


  it = 0 if z in COMPLEX otherwise
  ex f being Function of 4,REAL st z = f & it = f.3;
end;

registration
  let z be quaternion number;
  cluster Rea z -> real;
  cluster Im1 z -> real;
  cluster Im2 z -> real;
  cluster Im3 z -> real;
end;

definition
  let z be quaternion number;
  redefine func Rea z -> Real;
  redefine func Im1 z -> Real;
  redefine func Im2 z -> Real;
  redefine func Im3 z -> Real;
end;

theorem 
  for f being Function of 4,REAL ex a,b,c,d st f = (0,1,2,3)-->(a,b,c,d);

theorem 
  Rea [*a,b,c,d*] = a & Im1 [*a,b,c,d*] = b &
  Im2 [*a,b,c,d*] = c & Im3 [*a,b,c,d*] = d;

reserve z,z1,z2,z3,z4 for quaternion number;

theorem 
  z = [*Rea z, Im1 z, Im2 z, Im3 z*];

theorem 
  Rea z1 = Rea z2 & Im1 z1 = Im1 z2 & Im2 z1 = Im2 z2 &
  Im3 z1 = Im3 z2 implies z1 = z2;

definition
  func 0q -> quaternion number equals

  0;
  func 1q -> quaternion number equals

  1;
end;

theorem 
  Rea z = 0 & Im1 z = 0 & Im2 z = 0 & Im3 z = 0 implies z = 0q;

theorem 
  z = 0 implies (Rea z)^2 + (Im1 z)^2 +(Im2 z)^2 + (Im3 z)^2 = 0;

theorem 
  (Rea z)^2 + (Im1 z)^2 +(Im2 z)^2 + (Im3 z)^2 = 0 implies z = 0q;

theorem 
  Rea (1q) = 1 & Im1(1q) = 0 & Im2 (1q) = 0 & Im3 (1q) = 0;

theorem 
  Rea <i> = 0 & Im1 <i> = 1 & Im2 <i> = 0 & Im3 <i> = 0;

theorem 
  Rea <j> = 0 & Im1 <j> = 0 & Im2 <j> = 1 & Im3 <j> = 0 &
  Rea <k> = 0 & Im1 <k> = 0 & Im2 <k> = 0 & Im3 <k> = 1;

theorem 
  Rea (z1 + z2 + z3 + z4) = Rea z1 + Rea z2 + Rea z3 + Rea z4 &
  Im1 (z1 + z2 + z3 + z4) = Im1 z1 + Im1 z2 + Im1 z3 + Im1 z4 &
  Im2 (z1 + z2 + z3 + z4) = Im2 z1 + Im2 z2 + Im2 z3 + Im2 z4 &
  Im3 (z1 + z2 + z3 + z4) = Im3 z1 + Im3 z2 + Im3 z3 + Im3 z4;

 reserve x for Real;

theorem 
  z1 = x implies Rea (z1*<i>) = 0 &
  Im1 (z1*<i>) = x & Im2 (z1*<i>) = 0 & Im3 (z1*<i>) = 0;

theorem 
  z1 = x implies Rea (z1*<j>) = 0 &
  Im1 (z1*<j>) = 0 & Im2 (z1*<j>) = x & Im3 (z1*<j>) = 0;

theorem 
  z1 = x implies Rea (z1*<k>) = 0 &
  Im1 (z1*<k>) = 0 & Im2 (z1*<k>) = 0 & Im3 (z1*<k>) = x;

definition
  let x be Real, y be quaternion number;
  func x + y means


  ex y1,y2,y3,y4 being Element of REAL st y = [*y1,y2,y3,y4*] &
  it = [*x+y1,y2,y3,y4*];
end;

definition
  let x be Real, y be quaternion number;
  func x - y equals

  x + -y;
end;

definition
  let x be Real, y be quaternion number;
  func x * y means


  ex y1,y2,y3,y4 being Element of REAL st y = [*y1,y2,y3,y4*] &
  it = [*x*y1,x*y2,x*y3,x*y4*];
end;

registration
  let x be Real,z9 be quaternion number;
  cluster x+z9 -> quaternion;
  cluster x*z9 -> quaternion;
  cluster x-z9 -> quaternion;
end;

definition
  let z1,z2 be quaternion number;
  redefine func z1 + z2 -> Element of QUATERNION;
end;

theorem 
  Rea (z1 + z2) = Rea z1 + Rea z2 & Im1(z1 + z2) = Im1 z1 + Im1 z2 &
  Im2 (z1 + z2) = Im2 z1 + Im2 z2 & Im3(z1 + z2) = Im3 z1 + Im3 z2;

definition
  let z1,z2 be quaternion number;
  redefine func z1 * z2 -> Element of QUATERNION;
end;

theorem 
  z = Rea z+(Im1 z)*<i> + (Im2 z)*<j> + (Im3 z)*<k>;

theorem 
  Im1 z1 = 0 & Im1 z2 = 0 & Im2 z1 = 0 & Im2 z2 = 0 &
  Im3 z1 = 0 & Im3 z2 = 0 implies Rea(z1*z2) = Rea z1 * Rea z2 &
  Im1(z1*z2) = Im2 z1 * Im3 z2 - Im3 z1 * Im2 z2 &
  Im2(z1*z2) = Im3 z1 * Im1 z2 - Im1 z1 * Im3 z2 &
  Im3(z1*z2) = Im1 z1 * Im2 z2 - Im2 z1 * Im1 z2;

theorem 
  Rea z1 = 0 & Rea z2 = 0 implies
  Rea(z1*z2) = - Im1 z1 * Im1 z2 - Im2 z1 * Im2 z2 - Im3 z1 * Im3 z2 &
  Im1(z1*z2) = Im2 z1 * Im3 z2 - Im3 z1 * Im2 z2 &
  Im2(z1*z2) = Im3 z1 * Im1 z2 - Im1 z1 * Im3 z2 &
  Im3(z1*z2) = Im1 z1 * Im2 z2 - Im2 z1 * Im1 z2;

theorem 
  Rea(z*z) = (Rea z)^2 - (Im1 z)^2 - (Im2 z)^2 - (Im3 z)^2 &
  Im1(z*z) = 2*(Rea z * Im1 z) & Im2(z*z) = 2*( Rea z * Im2 z) &
  Im3(z*z) = 2*(Rea z * Im3 z);

definition
  let z be quaternion number;
  redefine func -z -> Element of QUATERNION;
end;

theorem 
  Rea(-z) = -(Rea z) & Im1(-z) = -(Im1 z) & Im2(-z) = -(Im2 z) &
  Im3(-z) = -(Im3 z);

definition
  let z1,z2 be quaternion number;
  redefine func z1 - z2 -> Element of QUATERNION;
end;

theorem 
  Rea(z1 - z2) = Rea z1 - Rea z2 & Im1(z1 - z2) = Im1 z1 - Im1 z2 &
  Im2(z1 - z2) = Im2 z1 - Im2 z2 & Im3(z1 - z2) = Im3 z1 - Im3 z2;

definition
  let z be quaternion number;
  func z*' -> quaternion number equals

  Rea z + (-Im1 z)*<i> + (-Im2 z)*<j> + (-Im3 z)*<k>;
end;

definition
  let z be quaternion number;
  redefine func z*' -> Element of QUATERNION;
end;

theorem 
  z*' = [*Rea z, -Im1 z, -Im2 z, -Im3 z*];

theorem 
  Rea (z*') = Rea z & Im1 (z*') = -Im1 z &
  Im2 (z*') = -Im2 z & Im3 (z*') = -Im3 z;

theorem 
  z = 0 implies z*' = 0;

theorem 
  z*' = 0 implies z = 0;

theorem 
  1q*' = 1q;

theorem 
  Rea (<i>*') = 0 & Im1 (<i>*') = -1 & Im2 (<i>*') = 0 & Im3 (<i>*') = 0;

theorem 
  Rea (<j>*') = 0 & Im1 (<j>*') = 0 & Im2 (<j>*') = -1 & Im3 (<j>*') = 0;

theorem 
  Rea (<k>*') = 0 & Im1 (<k>*') = 0 & Im2 (<k>*') = 0 & Im3 (<k>*') = -1;

theorem 
  <i>*' = -<i>;

theorem 
  <j>*' = -<j>;

theorem 
  <k>*' = -<k>;

theorem 
  (z1 + z2)*' = z1*' + z2*';

theorem 
  (-z)*' = -(z*');

theorem 
  (z1 - z2)*' = z1*' - z2*';

theorem 
  (z1*z2)*' = z1*' * z2*' implies (Im2 z1 * Im3 z2) = (Im3 z1)*(Im2 z2);

theorem 
  Im1 z = 0 & Im2 z = 0 & Im3 z = 0 implies z*' = z;

theorem 
  Rea z = 0 implies z*' = -z;

theorem 
  Rea(z*z*') = (Rea z)^2+(Im1 z)^2+(Im2 z)^2+(Im3 z)^2 &
  Im1(z*z*') = 0 & Im2(z*z*') = 0 & Im3(z*z*') = 0;

theorem 
  Rea(z + z*') = 2*Rea z & Im1(z + z*') = 0 &
  Im2(z + z*') = 0 & Im3(z + z*') = 0;

theorem 
  -z = [*-Rea z, -Im1 z, -Im2 z, -Im3 z*];

theorem 
  z1 - z2 =
    [*Rea z1 - Rea z2, Im1 z1 - Im1 z2, Im2 z1 - Im2 z2, Im3 z1 - Im3 z2*];

theorem 
  Rea(z - z*') = 0 & Im1(z - z*') = 2*Im1 z &
  Im2(z - z*') = 2*Im2 z & Im3(z - z*') = 2*Im3 z;

definition let z;
  func |.z.| -> real number equals

  sqrt ((Rea z)^2 + (Im1 z)^2 + (Im2 z)^2 + (Im3 z)^2);
end;

theorem 
  |.0q.| = 0;

theorem 
  |.z.| = 0 implies z = 0;

theorem 
  0 <= |.z.|;

theorem 
  |.1q.| = 1;

theorem 
  |.<i>.| = 1;

theorem 
  |.<j>.| = 1;

theorem 
  |.<k>.| = 1;

theorem 
  |.-z.| = |.z.|;

theorem 
  |.z*'.| = |.z.|;

theorem 
  for a,b,c,d being real number holds a^2 + b^2 + c^2 + d^2 >= 0;

theorem 
  Rea z <= |.z.|;

theorem 
  Im1 z <= |.z.|;

theorem 
  Im2 z <= |.z.|;

theorem 
  Im3 z <= |.z.|;

theorem 
  |.z1 + z2.| <= |.z1.| + |.z2.|;

theorem 
  |.z1 - z2.| <= |.z1.| + |.z2.|;

theorem 
  |.z1.| - |.z2.| <= |.z1 + z2.|;

theorem 
  |.z1.| - |.z2.| <= |.z1 - z2.|;

theorem 
  |.z1 - z2.| = |.z2 - z1.|;

theorem 
  |.z1 - z2.| = 0 iff z1 = z2;

theorem 
  |.z1 - z2.| <= |.z1 - z.| + |.z - z2.|;

theorem 
  |.|.z1.| - |.z2.|.| <= |.z1 - z2.|;

theorem 
  |.z1*z2.| = |.z1.|*|.z2.|;

theorem 
  |.z*z.| = (Rea z)^2 + (Im1 z)^2 + (Im2 z)^2 + (Im3 z)^2;

theorem 
  |.z*z.| = |.z*z*'.|;

theorem 
  z is real implies Rea z = z & Im1 z = 0 & Im2 z = 0 & Im3 z = 0;

theorem 
  for x,y being Element of REAL holds [*x,y,0,0*] = [*x,y*];

theorem 
  z1+z2 = Rea z1 + Rea z2 + (Im1 z1 + Im1 z2)*<i> +
    (Im2 z1 + Im2 z2)*<j> + (Im3 z1 + Im3 z2)*<k>;

theorem 
  z1*z2 =
  (Rea z1 * Rea z2 - Im1 z1 * Im1 z2 - Im2 z1 * Im2 z2 - Im3 z1 * Im3 z2) +
  (Rea z1 * Im1 z2 + Im1 z1 * Rea z2 + Im2 z1 * Im3 z2 - Im3 z1 * Im2 z2)*<i> +
  (Rea z1 * Im2 z2 + Im2 z1 * Rea z2 + Im3 z1 * Im1 z2 - Im1 z1 * Im3 z2)*<j> +
  (Rea z1 * Im3 z2 + Im3 z1 * Rea z2 + Im1 z1 * Im2 z2 - Im2 z1 * Im1 z2)*<k>;

theorem 
  -z = -Rea z + (-Im1 z)*<i> + (-Im2 z)*<j> + (-Im3 z)*<k>;

theorem 
  z1 - z2 = Rea z1 - Rea z2 + (Im1 z1 - Im1 z2)*<i> +
    (Im2 z1 - Im2 z2)*<j> + (Im3 z1 - Im3 z2)*<k>;

theorem 
  for a, b, c, d being real number st a^2 + b^2 + c^2 + d^2 = 0 holds
    a = 0 & b = 0 & c = 0 & d = 0;

theorem 
Rea (z1 * z2) =
Rea z1 * Rea z2 - Im1 z1 * Im1 z2 - Im2 z1 * Im2 z2 - Im3 z1 * Im3 z2 &
Im1 (z1 * z2) =
Rea z1 * Im1 z2 + Im1 z1 * Rea z2 + Im2 z1 * Im3 z2 - Im3 z1 * Im2 z2 &
Im2 (z1 * z2) =
Rea z1 * Im2 z2 + Im2 z1 * Rea z2 + Im3 z1 * Im1 z2 - Im1 z1 * Im3 z2 &
Im3 (z1 * z2) =
Rea z1 * Im3 z2 + Im3 z1 * Rea z2 + Im1 z1 * Im2 z2 - Im2 z1 * Im1 z2;














begin

reserve k,n for Nat,
  x,y,z,y1,y2,X,Y for set,
  f,g for Function;



theorem 
  k = k /\ n implies k <= n;

theorem 
  n \/ { n } = n+1;

theorem 
  Seg n c= n+1;

theorem 
  n+1 = {0} \/ Seg n;



theorem 
  for r being Function holds r is finite T-Sequence-like iff
  ex n st dom r = n;

definition
  mode XFinSequence is finite T-Sequence;
end;

reserve p,q,r,s,t for XFinSequence;

registration let p;
  cluster dom p -> natural;
end;

notation let p;
  synonym len p for card p;
end;

registration let p;
  identify len p with dom p;
end;

definition let p;
  redefine func len p -> Element of NAT;
end;

definition let p;

  redefine func dom p -> Subset of NAT;
end;

theorem 
  (ex k st dom f c= k) implies ex p st f c= p;

scheme 
 XSeqEx{A()->Nat,P[set,set]}:
  ex p st dom p = A() & for k st k in A() holds P[k,p.k]
provided
 for k st k in A() ex x st P[k,x];

scheme 

  XSeqLambda{A()->Nat,F(set) -> set}: ex p being XFinSequence st len p = A() &
  for k st k in A() holds p.k=F(k);

theorem 
  z in p implies ex k st k in dom p & z=[k,p.k];

theorem 
  dom p = dom q & (for k st k in dom p holds p.k = q.k) implies p = q;

theorem 
  ( len p = len q & for k st k < len p holds p.k=q.k ) implies p=q;

registration let p,n;
  cluster p|n -> finite;
end;

theorem 
  rng p c= dom f implies f*p is XFinSequence;

theorem 
  k < len p implies dom(p|k) = k;



registration let D be set;
  cluster finite for T-Sequence of D;
end;

definition let D be set;
  mode XFinSequence of D is finite T-Sequence of D;
end;

theorem 
  for D being set, f being XFinSequence of D holds f is PartFunc of NAT,D;

registration
  cluster empty -> T-Sequence-like for Function;
end;

reserve D for set;

theorem 
  for k being Nat,a being set holds k --> a is XFinSequence;

theorem 
  for D being non empty set ex p being XFinSequence of D st len p = k;





theorem 
  len p = 0 iff p = {};

theorem 
  for D be set holds {} is XFinSequence of D;

registration let D be set;
  cluster empty for XFinSequence of D;
end;

registration
  let D be non empty set;
  cluster non empty for XFinSequence of D;
end;

definition let x;
  func <%x%> -> set equals

  0 .--> x;
end;

registration let x;
  cluster <%x%> -> non empty;
end;

definition let D be set;
  func <%>D -> XFinSequence of D equals

  {};
end;

registration
  let D be set;
  cluster <%>D -> empty;
end;

definition let p,q;
  redefine func p^q means

 dom it = len p + len q & (for k st k in dom p
  holds it.k=p.k) & for k st k in dom q holds it.(len p + k) = q.k;
end;

registration
  let p,q;
  cluster p^q -> finite;
end;

theorem 
  len(p^q) = len p + len q;

theorem 
  len p <= k & k < len p + len q implies (p^q).k=q.(k-len p);

theorem 
  len p <= k & k < len(p^q) implies (p^q).k = q.(k - len p);

theorem 
  k in dom (p^q) implies (k in dom p or ex n st n in dom q & k=len
  p + n );

theorem 
  for p,q being T-Sequence holds dom p c= dom(p^q);

theorem 
  x in dom q implies ex k st k=x & len p + k in dom(p^q);

theorem 
  k in dom q implies len p + k in dom(p^q);

theorem 
  rng p c= rng(p^q);

theorem 
  rng q c= rng(p^q);

theorem 
  rng(p^q) = rng p \/ rng q;

theorem 
  p^q^r = p^(q^r);

theorem 
  p^r = q^r or r^p = r^q implies p = q;

registration let p;
 reduce p^{} to p;
 reduce {}^p to p;
end;

canceled;

theorem 
  p^q = {} implies p={} & q={};

registration
  let D be set;
  let p,q be XFinSequence of D;
  cluster p^q -> D-valued;
end;

definition
  let x;
  redefine func <%x%> -> Function means


  dom it = 1 & it.0 = x;
end;

registration
  let x;
  cluster <%x%> -> Function-like Relation-like;
end;

registration
  let x;
  cluster <%x%> -> finite T-Sequence-like;
end;

theorem 
  p^q is XFinSequence of D implies p is XFinSequence of D & q is
  XFinSequence of D;

definition
  let x,y;
  func <%x,y%> -> set equals

  <%x%>^<%y%>;
  let z;
  func <%x,y,z%> -> set equals

  <%x%>^<%y%>^<%z%>;
end;

registration
  let x,y;
  cluster <%x,y%> -> Function-like Relation-like;
  let z;
  cluster <%x,y,z%> -> Function-like Relation-like;
end;

registration
  let x,y;
  cluster <%x,y%> -> finite T-Sequence-like;
  let z;
  cluster <%x,y,z%> -> finite T-Sequence-like;
end;

theorem 
  <%x%> = { [0,x] };

theorem 
  p=<%x%> iff dom p = 1 & rng p = {x};

theorem 
  p = <%x%> iff len p = 1 & p.0 = x;

theorem 
  (<%x%>^p).0 = x;

theorem 
  (p^<%x%>).(len p)=x;

theorem 
  <%x,y,z%>=<%x%>^<%y,z%> & <%x,y,z%>=<%x,y%>^<%z%>;

theorem 
  p = <%x,y%> iff len p = 2 & p.0=x & p.1=y;

theorem 
  p = <%x,y,z%> iff len p = 3 & p.0 = x & p.1 = y & p.2 = z;

registration
  let x;
  cluster <%x%> -> 1-element;
  let y;
  cluster <%x,y%> -> 2-element;
  let z;
  cluster <%x,y,z%> -> 3-element;
end;

registration let n be Nat;
 cluster n-element -> n-defined for XFinSequence;
end;

registration let n be Nat, x be set;
 cluster n --> x -> finite T-Sequence-like;
end;

registration let n be Nat;
 cluster n-element for XFinSequence;
end;

registration let n be Nat;
 cluster -> total for n-element n-defined XFinSequence;
end;

theorem 
  p <> {} implies ex q,x st p=q^<%x%>;

registration
  let D be non empty set;
  let d1 be Element of D;
  cluster <%d1%> -> D -valued;
  let d2 be Element of D;
  cluster <%d1,d2%> -> D -valued;
  let d3 be Element of D;
  cluster <%d1,d2,d3%> -> D -valued;
end;



scheme 

  IndXSeq{P[XFinSequence]}: for p holds P[p]
provided
 P[{}] and
 for p,x st P[p] holds P[p^<%x%>];

theorem 
  for p,q,r,s being XFinSequence st p^q = r^s & len p <= len r ex t
  being XFinSequence st p^t = r;

definition
  let D be set;
  func D^omega -> set means


  x in it iff x is XFinSequence of D;
end;

registration
  let D be set;
  cluster D^omega -> non empty;
end;

theorem 
  x in D^omega iff x is XFinSequence of D;

theorem 
  {} in D^omega;

scheme 

  SepXSeq{D()->non empty set, P[XFinSequence]}: ex X st for x holds x in X iff
  ex p st p in D()^omega & P[p] & x=p;

notation
  let p be XFinSequence;
  let i,x be set;
  synonym Replace(p,i,x) for p+*(i,x);
end;

registration
  let p be XFinSequence;
  let i,x be set;
  cluster p+*(i,x) -> finite T-Sequence-like;
end;

theorem 
  for p being XFinSequence, i being Element of NAT, x being set holds
  len Replace(p,i,x) = len p & (i < len p implies Replace(p,i,x).i = x) & for j
  being Element of NAT st j <> i holds Replace(p,i,x).j = p.j;

registration
  let D be non empty set;
  let p be XFinSequence of D;
  let i be Element of NAT, a be Element of D;
  cluster Replace(p,i,a) -> D -valued;
end;



registration
  cluster -> real-valued for XFinSequence of REAL;
end;

registration
  cluster -> natural-valued for XFinSequence of NAT;
end;



theorem 
  for x1, x2, x3, x4 being set st
   p = <%x1%>^<%x2%>^<%x3%>^<%x4%>
  holds len p = 4 & p.0 = x1 & p.1 = x2 & p.2 = x3 & p.3 = x4;

theorem 
  for x1, x2, x3, x4, x5 being set st
     p = <%x1%>^<%x2%>^<%x3%>^<%x4%>^<%x5%>
  holds len p = 5 & p.0 = x1 & p.1 = x2 & p.2 = x3 & p.3 = x4 & p.4 = x5;

theorem 
  for x1, x2, x3, x4, x5, x6 being set st
     p = <%x1%>^<%x2%>^<%x3%>^<%x4%>^<%x5%>^<%x6%>
  holds len p = 6 & p.0 = x1 & p.1 = x2 & p.2 = x3 & p.3 = x4 & p.4 = x5 &
  p.5 = x6;

theorem 
  for x1, x2, x3, x4, x5, x6, x7 being set st
     p = <%x1%>^<%x2%>^<%x3%>^<%x4%>^<%x5%>^<%x6%>^<%x7%>
  holds len p = 7 & p.0 = x1 & p.1 = x2 & p.2 = x3 & p.3 = x4 & p.4 = x5 &
  p.5 = x6 & p.6 = x7;

theorem 
  for x1,x2,x3,x4, x5, x6, x7, x8 being set st
    p = <%x1%>^<%x2%>^<%x3%>^<%x4%>^<%x5%>^<%x6%>^<%x7%>^<%x8%>
  holds len p = 8 & p.0 = x1 & p.1 = x2 & p.2 = x3 & p.3 = x4 & p.4 = x5 &
  p.5 = x6 & p.6 = x7 & p.7 = x8;

theorem 
  for x1,x2,x3,x4,x5,x6,x7, x8, x9 being set st
     p = <%x1%>^<%x2%>^<%x3%>^<%x4%>^<%x5%>^<%x6%>^<%x7%>^<%x8%>^<%x9%>
  holds len p = 9 & p.0 = x1 & p.1 = x2 & p.2 = x3 & p.3 = x4 & p.4 = x5 &
  p.5 = x6 & p.6 = x7 & p.7 = x8 & p.8 = x9;



theorem 
   n <len p implies (p^q).n=p.n;

theorem 
  len p <= n implies (p|n) = p;

theorem 
  n <=len p & k in n
  implies (p|n).k = p.k & k in dom p;

theorem 
  n <= len p implies len(p|n) = n;

theorem 
  len(p|n) <= n;

theorem 
  len p = n+1 implies p = (p|n) ^ <% p.n %>;

theorem 
  (p^q)|dom p = p;

theorem 
  n <= dom p implies (p^q)|n = p|n;

theorem 
  n = dom p + k implies (p^q)|n = p^(q|k);

theorem 
  ex q st p = (p|n)^q;

theorem 
 len p = n + k implies ex q1, q2 being
   XFinSequence st len q1 = n & len q2 = k & p = q1 ^ q2;

theorem 
   <%x%>^p = <%y%>^q implies x = y & p = q;

definition
  let D be set,q be FinSequence of D;
  func FS2XFS q -> XFinSequence of D means

  len it=len q & for i being Nat st i < len q holds q.(i+1)=it.i;
end;

reserve i for Nat;

definition
  let D be set,q be XFinSequence of D;
  func XFS2FS q -> FinSequence of D means

  len it=len q & for i be Nat st 1<=i & i<= len q holds q.(i-'1)=it.i;
end;

theorem 
  for D being set, n being Nat, r being set st r in D holds
  (n-->r) is XFinSequence of D;

definition
  let D be non empty set;
  let q be FinSequence of D, n be Nat;
  assume that
 n>len q and
 NAT c= D;
  func FS2XFS*(q,n) -> non empty XFinSequence of D means

  len q = it.0 &
  len it=n & (for i be Nat st 1<=i & i<= len q holds it.i=q.i)&
  for j being Nat st len q
  <j & j<n holds it.j=0;
end;

reserve m for Nat,
        D for non empty set;

definition
  let D be non empty set;
  let p be XFinSequence of D;
  assume that
 p.0 is Nat and
 p.0 in len p;
  func XFS2FS*(p) -> FinSequence of D means

  for m be Nat st m = p.0 holds
  len it =m & for i st 1<=i & i<= m holds it.i=p.i;
end;

theorem 
  for p being XFinSequence of D st p.0=0 & 0<len p holds
  XFS2FS*(p)={};



definition
  let F be Function;
  attr F is initial means


  for m,n being Nat st n in dom F & m < n holds m in dom F;
end;

registration
  cluster empty -> initial for Function;
end;

registration
  cluster -> initial for XFinSequence;
end;



registration
 cluster -> NAT-defined for XFinSequence;
end;

theorem 
 for F being non empty initial NAT-defined Function holds 0 in dom F;

registration
 cluster initial finite NAT-defined -> T-Sequence-like for Function;
end;

theorem 
 for F being finite initial NAT-defined Function
 for n being Nat holds
  n in dom F iff n < card F;



theorem 
  for F being initial NAT-defined Function,
  G being NAT-defined Function st dom F = dom G holds G is initial;

theorem 
  for F being initial NAT-defined finite Function
  holds dom F = { k where k is Element of NAT: k < card F };

theorem 
  for F being initial non empty NAT-defined finite Function, G being non
  empty NAT-defined finite Function holds F c= G & LastLoc F = LastLoc G
  implies F = G;

theorem 
  for F being initial non empty NAT-defined finite Function holds
  LastLoc F = card F -' 1;

theorem 
  for F being initial non empty NAT-defined finite Function holds
  FirstLoc F = 0;

registration
  let F be initial non empty NAT-defined finite Function;
  cluster CutLastLoc F -> initial;
end;

reserve l for Element of NAT;

theorem 
 for I being finite initial NAT-defined Function, J being Function
 holds dom I misses dom Shift(J,card I);



theorem 
  not m in dom p implies not succ m in dom p;



registration let D be set;
 cluster D^omega -> functional;
end;

registration let D be set;
  cluster -> finite T-Sequence-like for Element of D^omega;
end;

definition let D be set;
 let f be XFinSequence of D;
 func Down f -> Element of D^omega equals

 f;
end;

definition let D be set;
 let f be XFinSequence of D, g be Element of D^omega;
 redefine func f^g -> Element of D^omega;
end;

definition let D be set;
 let f, g be Element of D^omega;
 redefine func f^g -> Element of D^omega;
end;



theorem 
 p c= p^q;

theorem 
  len(p^<%x%>) = len p + 1;

theorem 
 <%x,y%> = (0,1) --> (x,y);

reserve M for Element of NAT;

theorem 
 p^q = p +* Shift(q, card p);

theorem 
 p +* (p ^ q) = p ^ q & (p ^ q) +* p = p ^ q;

reserve m,n for Element of NAT;

theorem 
 for I being finite initial NAT-defined Function, J being Function
 holds dom Shift(I,n) misses dom Shift(J,n+card I);

theorem 
 Shift(p,n) c= Shift(p^q,n);

theorem 
 Shift(q,n+card p) c= Shift(p^q,n);

theorem 
 Shift(p^q,n) c= X implies Shift(p,n) c= X;

theorem 
 Shift(p^q,n) c= X implies Shift(q,n+card p) c= X;

registration let F be initial non empty NAT-defined finite Function;
 cluster CutLastLoc F -> initial;
end;

definition let x1,x2,x3,x4 be set;
 func <%x1,x2,x3,x4%> -> set equals

  <%x1%>^<%x2%>^<%x3%>^<%x4%>;
end;

registration let x1,x2,x3,x4 be set;
 cluster <%x1,x2,x3,x4%> -> Function-like Relation-like;
end;

registration let x1,x2,x3,x4 be set;
 cluster <%x1,x2,x3,x4%> -> finite T-Sequence-like;
end;

reserve x1,x2,x3,x4 for set;

theorem 
 len<%x1,x2,x3,x4%> = 4;

theorem 
 <%x1,x2,x3,x4%>.0 = x1 &
 <%x1,x2,x3,x4%>.1 = x2 &
 <%x1,x2,x3,x4%>.2 = x3 &
 <%x1,x2,x3,x4%>.3 = x4;














begin 

reserve i, j, k, l, m, n, t for Nat;

scheme 

  NonUniqPiFinRecExD{D() -> non empty set, A() -> Element of D(), N() -> Nat,
P[set,set,set]}: ex p be FinSequence of D() st len p = N() & (p/.1 = A() or N()
  = 0) & for n be Nat st 1 <= n & n < N() holds P[n,p/.n,p/.(n+1)]
provided
 for n be Nat st 1 <= n & n < N() for x be Element of D() ex y be
Element of D() st P[n,x,y];

theorem 
  for x,y be real number st x >= 0 & y > 0 holds x / ( [\ x / y /] + 1 ) < y;

begin 

theorem 
  0 div n = 0;

theorem 
  for n be non empty Nat holds n div n = 1;

theorem 
  n div 1 = n;

theorem 
  i <= j & k <= j & i = j -' k + l implies k = j -' i + l;

theorem 
  i in Seg n implies n -' i + 1 in Seg n;

theorem 
  j < i implies i -' (j + 1) + 1 = i -' j;

theorem 
  i >= j implies j -' i = 0;

theorem 
  for i,j be non empty Nat holds i -' j < i;

theorem 
  k <= n implies 2 to_power n = (2 to_power k) * (2 to_power (n-'k ));

theorem 
  k <= n implies 2 to_power k divides 2 to_power n;

theorem 
  k > 0 & n div k = 0 implies n < k;

theorem 
  k > 0 & k <= n implies n div k >= 1;

theorem 
  k <> 0 implies (n+k) div k = (n div k) + 1;

theorem 
  k divides n & 1 <= n & 1 <= i & i <= k implies (n -' i) div k = (n div k) - 1
;

theorem 
  k <= n implies (2 to_power n) div (2 to_power k) = 2 to_power (n -' k);

theorem 
  n > 0 implies 2 to_power n mod 2 = 0;

theorem 
  n > 0 implies (n mod 2 = 0 iff (n -' 1) mod 2 = 1);

theorem 
  for n be non empty Nat st n <> 1 holds n > 1;

theorem 
  n <= k & k < n + n implies k div n = 1;

theorem 
  n is even iff n mod 2 = 0;

theorem 
  n is odd iff n mod 2 = 1;

theorem 
  1 <= t & k <= n & 2*t divides k implies (n div t is even iff (n-'k)
  div t is even);

theorem 
  n <= m implies n div k <= m div k;

theorem 
  k <= 2 * n implies (k+1) div 2 <= n;

theorem 
  n is even implies n div 2 = (n + 1) div 2;

theorem 
  (n div k) div i = n div (k*i);

definition
  let n be Nat;
  redefine attr n is trivial means


  n = 0 or n = 1;
end;

registration
  cluster non trivial for Nat;
end;

theorem 
  k is non trivial iff k is non empty & k <> 1;

theorem 
  for k be non trivial Nat holds k >= 2;

scheme 

  Indfrom2 { P[set] } : for k be non trivial Nat holds P[k]
provided
 P[2] and
 for k be non trivial Nat st P[k] holds P[k + 1];

begin 


theorem 
  i-'j-'k = i-'(j+k);















begin 

reserve d,i,j,k,m,n,p,q,x,k1,k2 for Nat,
  a,c,i1,i2,i3,i5 for Integer;

theorem 
  for i being Nat holds i,i+1 are_relative_prime;

theorem 
  for p being Nat holds p is prime implies m,p are_relative_prime
  or m gcd p = p;

theorem 
  for k,m,n being Nat holds k divides n*m & n,k are_relative_prime
  implies k divides m;

theorem 
  n divides m & k divides m & n,k are_relative_prime implies (n*k) divides m;

registration
  let i be Integer;
  cluster i^2 -> natural;
end;

theorem 
  c > 1 implies 1 mod c = 1;

theorem 
  for i,n be Nat st i <> 0 holds i divides n iff n mod i = 0;

theorem 
  for m,n being Nat holds m <> 0 & m divides n mod m implies m divides n;

theorem 
  for m,n,k being Nat holds 0 < n & m mod n = k implies n divides (m - k );

theorem 
  i*p <> 0 & k mod i*p < p implies k mod i*p = k mod p;

theorem 
  (a*p + 1) mod p = 1 mod p;

theorem 
  1 < m & (n*k) mod m = k mod m & k,m are_relative_prime implies n mod m = 1;

theorem 
  (p |^ k) mod m = ((p mod m) |^ k) mod m;

theorem 
  i <> 0 implies i^2 mod (i+1) = 1;

theorem 
  k^2 < j & i mod j = k implies i^2 mod j = k^2;

theorem 
  p is prime & i mod p = -1 implies i^2 mod p = 1;

theorem 
  n is even implies n + 1 is odd;

theorem 
  for p being Nat holds p > 2 & p is prime implies p is odd;

theorem 
  n > 0 implies 2 to_power(n) is even;

theorem 
  i is odd & j is odd implies i*j is odd;

theorem 
  i is odd implies i |^ k is odd;

theorem 
  k > 0 & i is even implies i |^ k is even;

theorem 
  2 divides n iff n is even;

theorem 
  m*n is even implies m is even or n is even;

theorem 
  n |^ 2 = n^2;

theorem 
  m > 1 & n > 0 implies m |^ n > 1;

theorem 
  n <> 0 & p <> 0 implies n |^ p = n*(n |^ (p -'1));

theorem 
  for n,m st m mod 2 = 0 holds (n |^ (m div 2))^2 = n |^ m;

theorem 
  n <> 0 & 1 <= k implies (n |^ k) div n = n |^ (k -'1);

theorem 
  2 |^ (n + 1) = (2 |^ n)+(2 |^ n);

theorem 
  k > 1 & k |^ n = k |^ m implies n = m;

theorem 
  m <= n iff 2 |^ m divides 2 |^ n;

theorem 
  p is prime & i divides p |^ n implies i = 1 or ex k being
  Element of NAT st i = p*k;

theorem 
  for n st p is prime & n < p |^ (k+1) holds n divides p |^ (k+1)
  iff n divides p |^ k;

theorem 
  for k holds p is prime & d divides (p |^ k) implies ex t being
  Element of NAT st d = p |^ t & t <= k;

theorem 
  p > 1 & i mod p = 1 implies (i |^ n) mod p = 1;

theorem 
  for m,n being Nat holds m > 0 implies (n |^ m) mod n = 0;

theorem 
  for p being Nat holds p is prime & n,p are_relative_prime
  implies (n |^ (p -'1)) mod p = 1;

theorem 
  p is prime & d > 1 & d divides (p |^ k) & not d divides ((p |^ k
  ) div p) implies d = p |^ k;

definition
  let i be Integer;
  redefine func i^2 -> Element of NAT;
end;

theorem 
  for n st n > 1 holds m mod n = 1 iff m,1 are_congruent_mod n;

theorem 
  i1,i2 are_congruent_mod i5 & i1,i3 are_congruent_mod i5 implies
  i2,i3 are_congruent_mod i5;

theorem 
  3 is prime;

theorem 
  n <> 0 implies Euler n <> 0;

theorem 
  n <> 0 implies -n < n;

theorem 
  n <> 0 implies n div n = 1;

begin 

definition
  let k,m,n;
  func Crypto(m,n,k) -> Element of NAT equals

  (m |^ k) mod n;
end;

theorem 
  p is prime & q is prime & p <> q & n = p*q & k1,Euler(n)
  are_relative_prime & (k1*k2) mod Euler(n) = 1 implies for m be Element of NAT
  st m < n holds Crypto(Crypto(m,n,k1),n,k2) = m;

begin 

definition
  let i,p;
  assume that
 p > 1 and
 i,p are_relative_prime;
  func order(i,p) -> Element of NAT means


  it > 0 & (i |^ it) mod p = 1
  & for k st k > 0 & (i |^ k) mod p = 1 holds 0 < it & it <= k;
end;

theorem 
  p > 1 implies order(1,p) = 1;

theorem 
  p > 1 & (i |^ n) mod p = 1 & i,p are_relative_prime implies
  order(i,p) divides n;

theorem 
  p > 1 & i,p are_relative_prime & order(i,p) divides n implies (i
  |^ n) mod p = 1;

theorem 
  p is prime & i,p are_relative_prime implies order(i,p) divides ( p -'1);

begin 

definition
  let n be Nat;
  func Fermat(n) -> Element of NAT equals

  2 |^ (2 |^ n) + 1;
end;

theorem 
  Fermat(0) = 3;

theorem 
  Fermat(1) = 5;

theorem 
  Fermat(2) = 17;

theorem 
  Fermat(3) = 257;

theorem 
  Fermat(4) = 256*256+1;

theorem 
  Fermat(n) > 2;

theorem 
  p is prime & p > 2 & p divides Fermat(n) implies ex k being
  Element of NAT st p = k*(2 |^ (n + 1)) + 1;

theorem 
  n <> 0 implies 3,Fermat(n) are_relative_prime;

begin 


theorem 
  (3 |^ ((Fermat(n)-'1) div 2)),(-1) are_congruent_mod Fermat(n)
  implies Fermat(n) is prime;

theorem 
  5 is prime;

theorem 
  17 is prime;

theorem 
  257 is prime;

theorem 
  256*256+1 is prime;



theorem 
  for i,j being Nat holds j > 0 & i mod j = 0 implies i
  div j = i / j;

theorem 
  for i,n being Nat holds n > 0 implies i |^ n div i = i |^ n / i;

reserve r for real number;

theorem 
  for n being Nat holds 0 < n & 1 < r implies 1 < r|^n;

theorem 
  for m,n being Nat holds r > 1 & m > n implies r|^m > r|^n;














begin 

reserve k, m, n, p, K, N for Element of NAT;
reserve i for Integer;
reserve x, y, eps for real number;
reserve seq, seq1, seq2 for Real_Sequence;
reserve sq for FinSequence of REAL;

notation
  let x;
  antonym x is irrational for x is rational;
end;

notation
  let x, y;
  synonym x ^ y for x to_power y;
end;


theorem 
  p is prime implies sqrt p is irrational;

theorem 
  ex x, y st x is irrational & y is irrational & x ^ y is rational;

begin 

scheme 

  LambdaRealSeq{F(set)->real number}: (ex seq st for n holds seq.n=F(n)) & for
seq1, seq2 st (for n holds seq1.n=F(n)) & (for n holds seq2.n=F(n)) holds seq1=
  seq2;

definition
  let k be Nat;
  func aseq(k) -> Real_Sequence means


  for n holds it.n=(n-k)/n;
  func bseq(k) -> Real_Sequence means


  for n holds it.n=(n choose k)*(n ^ (-k));
end;

definition
  let n be Nat;
  func cseq(n) -> Real_Sequence means


  for k holds it.k=(n choose k)*(n ^ (-k));
end;

theorem 
  cseq(n).k=bseq(k).n;

definition
  func dseq -> Real_Sequence means


  for n holds it.n=(1+(1/n)) ^ n;
end;

definition
  func eseq -> Real_Sequence means


  for k holds it.k=1/(k!);
end;



theorem 
  n>0 implies (n ^ (-(k+1)))=(n ^ (-k))/n;

theorem 
  (n choose (k+1))=((n-k)/(k+1))*(n choose k);

theorem 
  n>0 implies bseq(k+1).n=(1/(k+1))*(bseq(k).n)*(aseq(k).n);

theorem 
  n>0 implies aseq(k).n=1-(k/n);

theorem 
  aseq(k) is convergent & lim(aseq(k))=1;

theorem 
  for seq st for n being Nat holds seq.n=x holds seq is convergent & lim(seq)=x
;

theorem 
  for n holds bseq(0).n=1;

theorem 
  (1/(k+1))*(1/(k!))=1/((k+1)!);

theorem 
  bseq(k) is convergent & lim(bseq(k))=1/(k!) & lim(bseq(k))=eseq. k;



theorem 
  k<n implies 0<aseq(k).n & aseq(k).n<=1;

theorem 
  n>0 implies 0<=bseq(k).n & bseq(k).n<=1/(k!) & bseq(k).n<=eseq.k
  & 0<=cseq(n).k & cseq(n).k<=1/(k!) & cseq(n).k<=eseq.k;



theorem 
  for seq st seq^\1 is summable holds seq is summable & Sum(seq)=(
  seq.0)+Sum(seq^\1);

theorem 
  for D being non empty set, sq being FinSequence of D st 1<=k & k
  <len sq holds (sq/^1).k=sq.(k+1);

theorem 
  for sq st len(sq)>0 holds Sum(sq)=(sq.1)+Sum(sq/^1);

theorem 
  for n holds for seq, sq st len(sq)=n & (for k st k<n holds seq.k
=sq.(k+1)) & (for k st k>=n holds seq.k=0) holds seq is summable & Sum(seq)=Sum
  (sq);

theorem 
  k<=n implies ((x,y) In_Power n).(k+1)=(n choose k)*(x ^ (n-k))*( y ^ k);

theorem 
  n>0 & k<=n implies cseq(n).k=((1,1/n) In_Power n).(k+1);

theorem 
  n>0 implies cseq(n) is summable & Sum(cseq(n))=(1+(1/n)) ^ n &
  Sum(cseq(n))=dseq.n;



theorem 
  dseq is convergent & lim(dseq)=number_e;



theorem 
  eseq is summable & Sum(eseq)=exp_R(1);



theorem 
  for K holds for dseqK being Real_Sequence st for n holds dseqK.n
  =Partial_Sums(cseq(n)).K holds dseqK is convergent & lim(dseqK)=Partial_Sums(
  eseq).K;

theorem 
  seq is convergent & lim(seq)=x implies for eps st eps>0 holds ex
  N st for n st n>=N holds seq.n>x-eps;

theorem 
  (for eps st eps>0 holds ex N st for n st n>=N holds seq.n>x-eps)
& (ex N st for n st n>=N holds seq.n<=x) implies seq is convergent & lim(seq)=x
;

theorem 
  seq is summable implies for eps st eps>0 holds ex K st
  Partial_Sums(seq).K>Sum(seq)-eps;

theorem 
  n>=1 implies dseq.n<=Sum(eseq);

theorem 
  seq is summable & (for k holds seq.k>=0) implies Sum(seq)>=
  Partial_Sums(seq).K;

theorem 
  dseq is convergent & lim(dseq)=Sum(eseq);



definition
  redefine func number_e equals

  Sum eseq;
end;

definition
  redefine func number_e equals

  exp_R(1);
end;

begin 

theorem 
  x is rational implies ex n st n>=2 & n!*x is integer;

theorem 
  n!*eseq.k = (n!)/(k!);

theorem 
  (n!)/(k!)>0;

theorem 
  seq is summable & (for n holds seq.n>0) implies Sum(seq)>0;

theorem 
  n!*Sum(eseq^\(n+1))>0;

theorem 
  k<=n implies (n!)/(k!) is integer;

theorem 
  n!*Partial_Sums(eseq).n is integer;

theorem 
  x=1/(n+1) implies (n!)/((n+k+1)!)<=x ^ (k+1);

theorem 
  n>0 & x=1/(n+1) implies n!*Sum(eseq^\(n+1))<=x/(1-x);

theorem 
  for n be real number st n>=2 & x=1/(n+1) holds x/(1-x)<1;


theorem 
  number_e is irrational;














begin 

reserve n for Nat,
  i for Integer,
  p, x, x0, y for real number,
  q for Rational,
  f for PartFunc of REAL,REAL;

definition
  let q be Integer;
  func #Z q -> Function of REAL, REAL means


  for x be real number holds it.x = x #Z q;
end;

theorem 
  for m,n be Nat holds x #Z (n+m) = (x #Z n) * (x #Z m);

theorem 
  #Z n is_differentiable_in x & diff(( #Zn),x) = n * x #Z (n-1);

theorem 
  f is_differentiable_in x0 implies ( #Z n) *f is_differentiable_in x0 &
  diff( ( #Z n) *f,x0) = n * (f.x0) #Z (n-1) *diff(f,x0);

theorem 
  exp_R(-x) = 1/exp_R(x);

theorem 
  (exp_R(x)) #R (1/i) = exp_R(x/i);

theorem 
  for m,n be Integer holds (exp_R(x)) #R (m/n) = exp_R(m/n*x);

theorem 
  (exp_R(x)) #Q q = exp_R(q*x);

theorem 
  (exp_R(x)) #R p = exp_R(p*x);

theorem 
  (exp_R(1)) #R x =exp_R(x) & (exp_R(1)) to_power x = exp_R(x) &
  number_e to_power x = exp_R(x) & number_e #R x = exp_R(x);

theorem 
  (exp_R.1) #R x =exp_R.x & (exp_R.1) to_power x = exp_R.x & number_e
  to_power x = exp_R.x & number_e #R x =exp_R.x;

theorem 
  number_e > 2;

theorem 
  log(number_e,exp_R(x)) = x;

theorem 
  log(number_e,exp_R.x) = x;

theorem 
  y > 0 implies exp_R(log(number_e,y)) = y;

theorem 
  y > 0 implies exp_R.(log(number_e,y)) = y;

theorem 
  exp_R is one-to-one & exp_R is_differentiable_on REAL & exp_R
is_differentiable_on [#](REAL) & (for x be Real holds diff(exp_R,x)=exp_R.x) &
(for x be Real holds 0 < diff(exp_R,x)) & dom(exp_R)=[#]REAL & dom(exp_R)=[#](
  REAL) & rng(exp_R)=right_open_halfline(0);

registration
  cluster exp_R -> one-to-one;
end;

theorem 
  exp_R" is_differentiable_on dom (exp_R") & for x be real number
  st x in dom (exp_R") holds diff(((exp_R)"),x) = 1/x;

registration
  cluster right_open_halfline(0) -> non empty;
end;

definition
  let a be real number;
  func log_ a -> PartFunc of REAL,REAL means


  dom it =
right_open_halfline(0) & for d be Element of right_open_halfline(0) holds it.d
  = log(a,d);
end;

definition
  func ln -> PartFunc of REAL, REAL equals

  log_number_e;
end;

theorem 
  ln=(exp_R)" & ln is one-to-one & dom ln = right_open_halfline(0)
  & rng ln = REAL & ln is_differentiable_on right_open_halfline(0) & (for x be
  Real st x > 0 holds ln is_differentiable_in x) & (for x be Element of
  right_open_halfline(0) holds diff(ln,x)=1/x) & for x be Element of
  right_open_halfline(0) holds 0 < diff(ln,x);

theorem 
  f is_differentiable_in x0 implies exp_R*f is_differentiable_in x0 &
  diff(exp_R*f,x0) = exp_R.(f.x0)*diff(f,x0);

theorem 
  f is_differentiable_in x0 & f.x0 > 0 implies ln *f
  is_differentiable_in x0 & diff( ln *f,x0) = diff(f,x0)/(f.x0);

definition
  let p be real number;
  func #R p -> PartFunc of REAL,REAL means


  dom it = right_open_halfline
  (0) & for d be Element of right_open_halfline(0) holds it.d= d #R p;
end;

theorem 
  x > 0 implies ( #R p) is_differentiable_in x & diff(( #R p),x)=p
  *(x #R (p-1));

theorem 
  f is_differentiable_in x0 & f.x0 > 0 implies ( #R p) *f
is_differentiable_in x0 & diff( ( #R p) *f,x0) = p*( (f.x0) #R (p-1)) * diff(f,
  x0);

begin 

definition
  let f be PartFunc of REAL,REAL;
  let Z be Subset of REAL;
  func diff(f,Z) -> Functional_Sequence of REAL,REAL means


  it.0 = f|Z & for i be Nat holds it.(i+1) = (it.i) `| Z;
end;

definition
  let f be PartFunc of REAL,REAL;
  let n be Nat;
  let Z be Subset of REAL;
  pred f is_differentiable_on n, Z means


  for i be Element of NAT st i <= n-1 holds diff(f,Z).i is_differentiable_on Z;
end;

theorem 
  for f be PartFunc of REAL,REAL, Z be Subset of REAL, n be
Nat st f is_differentiable_on n,Z for m be Nat st m <= n
  holds f is_differentiable_on m, Z;

definition
  let f be PartFunc of REAL,REAL;
  let Z be Subset of REAL;
  let a,b be real number;
  func Taylor(f,Z,a,b) -> Real_Sequence means


  for n be Nat holds it.n = (diff(f,Z).n).a * (b-a) |^ n / (n!);
end;

theorem 
  for f be PartFunc of REAL,REAL, Z be Subset of REAL, n be
Element of NAT st f is_differentiable_on n, Z for a,b be Real st a < b & ].a,b
  .[ c= Z holds diff(f,Z).n | ].a,b.[ = diff(f,].a,b.[).n;

theorem 
  for n be Element of NAT, f be PartFunc of REAL,REAL, Z be Subset
  of REAL st Z c= dom f & f is_differentiable_on n,Z for a,b be Real st a < b &
[.a,b.] c=Z & (diff(f,Z).n)|[.a,b.] is continuous & f is_differentiable_on (n+1
), ].a,b.[ holds for l be Real, g be PartFunc of REAL,REAL st dom(g)=[#]REAL &
( for x be Real holds g.x=f.b-Partial_Sums(Taylor(f,Z,x,b)).n -l*(b-x) |^ (n+1)
/ ((n+1)!)) & f.b-Partial_Sums(Taylor(f,Z,a,b)).n -l*(b-a) |^ (n+1) / ((n+1)!)
  = 0 holds g is_differentiable_on ].a,b.[ & g.a=0 & g.b=0 & g|[.a,b.] is
continuous & for x be Real st x in ].a,b.[ holds diff(g,x) = -(diff(f,].a,b.[).
  (n+1)).x * (b-x) |^ n /(n!) +l* (b-x) |^ n /(n!);

theorem 
  for n be Element of NAT, f be PartFunc of REAL,REAL, Z be Subset
of REAL, b,l be Real holds ex g be Function of REAL,REAL st for x be Real holds
  g.x=f.b-Partial_Sums(Taylor(f,Z,x,b)).n -l*(b-x) |^ (n+1) /((n+1)!);

theorem 
  for n be Element of NAT, f be PartFunc of REAL,REAL, Z be Subset
  of REAL st Z c= dom f & f is_differentiable_on n,Z for a,b be Real st a < b &
[.a,b.] c=Z & (diff(f,Z).n)|[.a,b.] is continuous & f is_differentiable_on (n+1
), ].a,b.[ holds ex c be Real st c in ].a, b.[ & f.b = Partial_Sums(Taylor(f,Z,
  a,b)).n + (diff(f,].a,b.[).(n+1)).c * (b-a) |^ (n+1) / ((n+1)!);

theorem 
  for n be Element of NAT, f be PartFunc of REAL,REAL, Z be Subset
  of REAL st Z c= dom f & f is_differentiable_on n,Z for a,b be Real st a < b &
[.a,b.] c=Z & (diff(f,Z).n)|[.a,b.] is continuous & f is_differentiable_on (n+1
), ].a,b.[ holds for l be Real, g be PartFunc of REAL,REAL st dom(g)=[#]REAL &
( for x be Real holds g.x = f.a-Partial_Sums(Taylor(f,Z,x,a)).n -l*(a-x) |^ (n+
1) /((n+1)!) ) & f.a-Partial_Sums(Taylor(f,Z,b,a)).n-l*(a-b) |^ (n+1)/((n+1)!)
  =0 holds g is_differentiable_on ].a,b.[ & g.b=0 & g.a=0 & g|[.a,b.] is
continuous & for x be Real st x in ].a,b.[ holds diff(g,x) = -(diff(f,].a,b.[).
  (n+1)).x * (a-x) |^ n /(n!) +l* (a-x) |^ n /((n)!);

theorem 
  for n be Element of NAT, f be PartFunc of REAL,REAL, Z be Subset
  of REAL st Z c= dom f & f is_differentiable_on n,Z for a,b be Real st a < b &
[.a,b.] c=Z & (diff(f,Z).n)|[.a,b.] is continuous & f is_differentiable_on (n+1
), ].a,b.[ holds ex c be Real st c in ].a, b.[ & f.a = Partial_Sums(Taylor(f,Z,
  b,a)).n + (diff(f,].a,b.[).(n+1)).c * (a-b) |^ (n+1) /((n+1)!);

theorem 
  for f be PartFunc of REAL,REAL, Z be Subset of REAL, Z1 be open
Subset of REAL st Z1 c= Z for n be Element of NAT st f is_differentiable_on n,Z
  holds diff(f,Z).n | Z1 = diff(f,Z1).n;

theorem 
  for f be PartFunc of REAL,REAL, Z be Subset of REAL, Z1 be open
Subset of REAL st Z1 c= Z for n be Nat st f is_differentiable_on n+1
  ,Z holds f is_differentiable_on n+1, Z1;

theorem 
  for f be PartFunc of REAL,REAL, Z be Subset of REAL, x be Real
  st x in Z for n be Element of NAT holds f.x = Partial_Sums(Taylor(f,Z,x,x)).n
;


theorem 
  for n be Element of NAT, f be PartFunc of REAL,REAL, x0,r be Real st
].x0-r,x0+r.[ c= dom f & 0 < r & f is_differentiable_on n+1, ].x0-r,x0+r.[ for
  x be Real st x in ].x0-r, x0+r.[ holds ex s be Real st 0 < s & s < 1 & f.x=
Partial_Sums(Taylor(f, ].x0-r,x0+r.[,x0,x)).n + (diff(f,].x0-r,x0+r.[).(n+1)).(
  x0+s*(x-x0)) * (x-x0) |^ (n+1) / ((n+1)!);














begin 

reserve a, b, p, q for Real;

registration
  let x be real number;
  cluster right_closed_halfline(x) -> non empty;
end;

theorem 
  for p, q be Real st 0 < p & 0 < q for a be Real st 0 <= a holds (a
  to_power p) * (a to_power q) = a to_power (p+q);

theorem 
  for p, q be Real st 0 < p & 0 < q for a be Real st 0 <=a holds (a
  to_power p) to_power q = a to_power (p*q);

theorem 
  for p be Real st 0 < p for a,b be Real st 0 <= a & a <= b holds a
  to_power p <= b to_power p;

theorem 
  1 < p & 1/p + 1/q = 1 & 0 < a & 0 < b implies a * b <= a #R p / p
  + b #R q / q & (a * b = a #R p / p + b #R q / q iff a #R p= b #R q);

theorem 
  1 < p & 1/p + 1/q = 1 & 0 <= a & 0 <= b implies a * b <= a
to_power p / p + b to_power q / q & (a * b = a to_power p / p + b to_power q /
  q iff a to_power p = b to_power q);

begin  

theorem 
  for p, q be Real st 1 < p & 1/p + 1/q = 1 for a,b,ap,bq,ab be
Real_Sequence st ( for n be Element of NAT holds ap.n=abs(a.n) to_power p & bq.
n=abs(b.n) to_power q & ab.n=abs(a.n* b.n)) holds for n be Element of NAT holds
Partial_Sums(ab).n <= ( (Partial_Sums(ap).n) to_power (1/p) ) * ( (Partial_Sums
  (bq).n) to_power (1/q) );

theorem 
  for p be Real st 1 < p for a,b,ap,bp,ab be Real_Sequence st ( for
n be Element of NAT holds ap.n=abs(a.n) to_power p & bp.n=abs(b.n) to_power p &
  ab.n=abs(a.n+b.n) to_power p ) holds for n be Element of NAT holds (
Partial_Sums(ab).n) to_power (1/p) <= ( Partial_Sums(ap).n) to_power (1/p) + (
  Partial_Sums(bp).n) to_power (1/p);

theorem 
  for a,b be Real_Sequence st (for n be Element of NAT holds a.n <=
b.n ) & b is convergent & a is non-decreasing holds a is convergent & lim a <=
  lim b;

theorem 
  for a,b,c be Real_Sequence st (for n be Element of NAT holds a.n
<= b.n+c.n ) & b is convergent & c is convergent & a is non-decreasing holds a
  is convergent & lim a <= lim b + lim c;

theorem 
  for p be Real st 0 < p for a,ap be Real_Sequence st a is
  convergent & (for n be Element of NAT holds 0 <=a.n ) & (for n be Element of
  NAT holds ap.n=(a.n) to_power p) holds ap is convergent & lim ap = (lim a)
  to_power p;

theorem 
  for p be Real st 0 < p for a,ap be Real_Sequence st a is summable & (
for n be Element of NAT holds 0 <=a.n ) & (for n be Element of NAT holds ap.n=(
  Partial_Sums(a).n) to_power p) holds ap is convergent & lim ap = Sum(a)
to_power p & ap is non-decreasing & for n be Element of NAT holds ap.n <= Sum(a
  ) to_power p;

theorem 
  for p, q be Real st 1 < p & 1/p + 1/q = 1 for a,b,ap,bq,ab be
Real_Sequence st ( for n be Element of NAT holds ap.n=abs(a.n) to_power p & bq.
n=abs(b.n) to_power q & ab.n=abs(a.n* b.n) ) & ap is summable & bq is summable
  holds ab is summable & Sum ab <= ( Sum(ap) to_power (1/p) ) * ( Sum(bq)
  to_power (1/q) );

theorem 
  for p be Real st 1 < p for a,b,ap,bp,ab be Real_Sequence st ( for n be
Element of NAT holds ap.n=abs(a.n) to_power p & bp.n=abs(b.n) to_power p & ab.n
  =abs(a.n+b.n) to_power p ) & ap is summable & bp is summable holds ab is
summable & Sum(ab) to_power (1/p) <= Sum(ap) to_power (1/p) + Sum(bp) to_power
  (1/p);














begin

reserve y for set;
reserve x,a,b,c for Real;
reserve n for Element of NAT;
reserve Z for open Subset of REAL;
reserve f,f1,f2 for PartFunc of REAL,REAL;



theorem 
  Z c= dom (ln*f) & (for x st x in Z holds f.x = a+x & f.x > 0)
implies ln*f is_differentiable_on Z & for x st x in Z holds ((ln*f)`|Z).x = 1/(
  a+x);



theorem 
  Z c= dom (ln*f) & (for x st x in Z holds f.x = x-a & f.x >0)
implies ln*f is_differentiable_on Z & for x st x in Z holds ((ln*f)`|Z).x = 1/(
  x-a);



theorem 
  Z c= dom (-(ln*f)) & (for x st x in Z holds f.x =a-x & f.x >0) implies
- (ln*f) is_differentiable_on Z & for x st x in Z holds ((-(ln*f))`|Z).x = 1/(a
  -x);



theorem 
  Z c= dom (id Z - a(#)f) & f = ln*f1 & (for x st x in Z holds f1.x=a+x
& f1.x>0) implies (id Z - a(#)f) is_differentiable_on Z & for x st x in Z holds
  ((id Z - a(#)f)`|Z).x = x/(a+x);



theorem 
  Z c= dom ((2*a)(#)f - id Z) & f = ln*f1 & (for x st x in Z holds f1.x=
a+x & f1.x>0) implies ((2*a)(#)f - id Z) is_differentiable_on Z & for x st x in
  Z holds (((2*a)(#)f - id Z)`|Z).x = (a-x)/(a+x);



theorem 
  Z c= dom (id Z - (2*a)(#)f) & f = ln*f1 & (for x st x in Z holds f1.x=
x+a & f1.x>0) implies (id Z - (2*a)(#)f) is_differentiable_on Z & for x st x in
  Z holds ((id Z -(2*a)(#)f)`|Z).x = (x-a)/(x+a);



theorem 
  Z c= dom (id Z + (2*a)(#)f) & f = ln*f1 & (for x st x in Z holds f1.x=
x-a & f1.x>0) implies (id Z + (2*a)(#)f) is_differentiable_on Z & for x st x in
  Z holds ((id Z +(2*a)(#)f)`|Z).x = (x+a)/(x-a);



theorem 
  Z c= dom (id Z + (a-b)(#)f) & f = ln*f1 & (for x st x in Z holds f1.x=
x+b & f1.x>0) implies (id Z + (a-b)(#)f) is_differentiable_on Z & for x st x in
  Z holds ((id Z +(a-b)(#)f)`|Z).x = (x+a)/(x+b);



theorem 
  Z c= dom (id Z + (a+b)(#)f) & f = ln*f1 & (for x st x in Z holds f1.x=
x-b & f1.x>0) implies (id Z + (a+b)(#)f) is_differentiable_on Z & for x st x in
  Z holds ((id Z +(a+b)(#)f)`|Z).x = (x+a)/(x-b);



theorem 
  Z c= dom (id Z - (a+b)(#)f) & f = ln*f1 & (for x st x in Z holds f1.x=
x+b & f1.x>0) implies (id Z - (a+b)(#)f) is_differentiable_on Z & for x st x in
  Z holds ((id Z -(a+b)(#)f)`|Z).x = (x-a)/(x+b);



theorem 
  Z c= dom (id Z + (b-a)(#)f) & f = ln*f1 & (for x st x in Z holds f1.x=
x-b & f1.x>0) implies (id Z + (b-a)(#)f) is_differentiable_on Z & for x st x in
  Z holds ((id Z +(b-a)(#)f)`|Z).x = (x-a)/(x-b);



theorem 
  Z c= dom (f1+c(#)f2) & (for x st x in Z holds f1.x=a+b*x) & f2=
#Z 2 implies f1+c(#)f2 is_differentiable_on Z & for x st x in Z holds ((f1+c(#)
  f2)`|Z).x = b+2*c*x;



theorem 
  Z c= dom (ln*(f1+c(#)f2)) & f2=#Z 2 & (for x st x in Z holds f1.
  x=a+b*x & (f1+c(#)f2).x >0) implies (ln*(f1+c(#)f2)) is_differentiable_on Z &
  for x st x in Z holds ((ln*(f1+c(#)f2))`|Z).x = (b+2*c*x)/(a+b*x+c*x |^2);



theorem 
  Z c= dom f & (for x st x in Z holds f.x = a+x & f.x<>0) implies
  f^ is_differentiable_on Z & for x st x in Z holds ( (f^)`|Z).x= -1/(a+x)^2;



theorem 
  Z c= dom ((-1)(#)(f^)) & (for x st x in Z holds f.x=a+x & f.x <>0)
implies (-1)(#)(f^) is_differentiable_on Z & for x st x in Z holds (((-1)(#)(f^
  ))`|Z).x = 1/(a+x)^2;



theorem 
  Z c= dom f & (for x st x in Z holds f.x = a-x & f.x<>0) implies f^
  is_differentiable_on Z & for x st x in Z holds ( (f^)`|Z).x= 1/(a-x)^2;



theorem 
  Z c= dom (f1+f2) & (for x st x in Z holds f1.x=a^2) & f2=#Z 2
implies f1+f2 is_differentiable_on Z & for x st x in Z holds ((f1+f2)`|Z).x = 2
  *x;



theorem 
  Z c= dom (ln*(f1+f2)) & f2=#Z 2 & (for x st x in Z holds f1.x=a^2 & (
  f1+f2).x >0) implies (ln*(f1+f2)) is_differentiable_on Z & for x st x in Z
  holds ((ln*(f1+f2))`|Z).x = (2*x)/(a^2+x|^2);



theorem 
  Z c= dom -(ln*(f1-f2)) & f2=#Z 2 & (for x st x in Z holds f1.x=a^2 & (
  f1-f2).x >0) implies -(ln*(f1-f2)) is_differentiable_on Z & for x st x in Z
  holds ((-(ln*(f1-f2)))`|Z).x = 2*x/(a^2-x |^2);



theorem 
  Z c= dom (f1+f2) & (for x st x in Z holds f1.x=a) & f2=#Z 3
implies f1+f2 is_differentiable_on Z & for x st x in Z holds ((f1+f2)`|Z).x = 3
  *x |^2;



theorem 
  Z c= dom (ln*(f1+f2)) & f2=#Z 3 & (for x st x in Z holds f1.x=a & (f1+
f2).x >0) implies (ln*(f1+f2)) is_differentiable_on Z & for x st x in Z holds (
  (ln*(f1+f2))`|Z).x = (3*x |^2)/(a+x |^3);



theorem 
  Z c= dom (ln*(f1/f2)) & (for x st x in Z holds f1.x=a+x & f1.x >0 & f2
  .x=a-x & f2.x >0) implies ln*(f1/f2) is_differentiable_on Z & for x st x in Z
  holds ((ln*(f1/f2))`|Z).x = (2*a)/(a^2-x^2);



theorem 
  Z c= dom (ln*(f1/f2)) & (for x st x in Z holds f1.x=x-a & f1.x >0 & f2
  .x=x+a & f2.x >0) implies ln*(f1/f2) is_differentiable_on Z & for x st x in Z
  holds ((ln*(f1/f2))`|Z).x = (2*a)/(x^2-a^2);



theorem 
  Z c= dom (ln*(f1/f2)) & (for x st x in Z holds f1.x=x-a & f1.x >
0 & f2.x=x-b & f2.x >0) implies ln*(f1/f2) is_differentiable_on Z & for x st x
  in Z holds ((ln*(f1/f2))`|Z).x = (a-b)/((x-a)*(x-b));



theorem 
  Z c= dom ((1/(a-b))(#)f) & f=ln*(f1/f2) & (for x st x in Z holds f1.x=
  x-a & f1.x >0 & f2.x=x-b & f2.x >0 & a-b<>0) implies (1/(a-b))(#)f
is_differentiable_on Z & for x st x in Z holds (((1/(a-b))(#)f)`|Z).x =1/((x-a)
  *(x-b));



theorem 
  Z c= dom (ln*(f1/f2)) & f2=#Z 2 & (for x st x in Z holds f1.x=x-a & f1
.x >0 & f2.x >0 & x <>0) implies ln*(f1/f2) is_differentiable_on Z & for x st x
  in Z holds ((ln*(f1/f2))`|Z).x = (2*a-x)/(x*(x-a));




theorem 
  Z c= dom (( #R (3/2))*f) & (for x st x in Z holds f.x=a+x & f.x>
0) implies ( #R (3/2))*f is_differentiable_on Z & for x st x in Z holds ((( #R
  (3/2))*f)`|Z).x =(3/2)* (a+x) #R (1/2);



theorem 
  Z c= dom ((2/3)(#)(( #R (3/2))*f)) & (for x st x in Z holds f.x=a+x &
f.x>0) implies (2/3)(#)(( #R (3/2))*f) is_differentiable_on Z & for x st x in Z
  holds (((2/3)(#)(( #R (3/2))*f))`|Z).x =(a+x) #R (1/2);



theorem 
  Z c= dom ((-2/3)(#)(( #R (3/2))*f)) & (for x st x in Z holds f.x=a-x &
  f.x> 0 ) implies (-2/3)(#)(( #R (3/2))*f) is_differentiable_on Z & for x st x
  in Z holds (((-2/3)(#)(( #R (3/2))*f))`|Z).x =(a-x) #R (1/2);



theorem 
  Z c= dom ((2(#)(( #R (1/2))*f))) & (for x st x in Z holds f.x=a+x & f.
x>0) implies 2(#)(( #R (1/2))*f) is_differentiable_on Z & for x st x in Z holds
  ((2(#)(( #R (1/2))*f))`|Z).x =(a+x) #R (-1/2);



theorem 
  Z c= dom (((-2)(#)(( #R (1/2))*f))) & (for x st x in Z holds f.x=a-x &
f.x>0) implies (-2)(#)(( #R (1/2))*f) is_differentiable_on Z & for x st x in Z
  holds (((-2)(#)(( #R (1/2))*f))`|Z).x =(a-x) #R (-1/2);



theorem 
  Z c= dom ((2/(3*b))(#)(( #R (3/2))*f)) & (for x st x in Z holds f.x=a+
b*x & b<>0 & f.x>0) implies (2/(3*b))(#)(( #R (3/2))*f) is_differentiable_on Z
& for x st x in Z holds (((2/(3*b))(#)(( #R (3/2))*f))`|Z).x =(a+b*x) #R (1/2);



theorem 
  Z c= dom ((-2/(3*b))(#)(( #R (3/2))*f)) & (for x st x in Z holds f.x=a
-b*x & b<>0 & f.x>0) implies (-2/(3*b))(#)(( #R (3/2))*f) is_differentiable_on
Z & for x st x in Z holds (((-2/(3*b))(#)(( #R (3/2))*f))`|Z).x =(a-b*x) #R (1/
  2);



theorem 
  Z c= dom (( #R (1/2))*f) & f=f1+f2 & f2=#Z 2 & (for x st x in Z holds
f1.x=a^2 & f.x>0) implies ( #R (1/2))*f is_differentiable_on Z & for x st x in
  Z holds ((( #R (1/2))*f)`|Z).x =x * (a^2+x |^2) #R (-1/2);



theorem 
  Z c= dom -(( #R (1/2))*f) & f=f1-f2 & f2=#Z 2 & (for x st x in Z holds
f1.x=a^2 & f.x >0) implies -(( #R (1/2))*f) is_differentiable_on Z & for x st x
  in Z holds ((-(( #R (1/2))*f))`|Z).x = x* (a^2-x |^2) #R (-1/2);



theorem 
  Z c= dom ((2(#)(( #R (1/2))*f))) & f=f1+f2 & f2=#Z 2 & (for x st x in
  Z holds f1.x=x & f.x>0) implies 2(#)(( #R (1/2))*f) is_differentiable_on Z &
for x st x in Z holds ((2(#)(( #R (1/2))*f))`|Z).x =(2*x+1)*(x |^2+x) #R (-1/2)
;




theorem 
  Z c= dom (sin*f) & (for x st x in Z holds f.x=a*x+b) implies sin*f
is_differentiable_on Z & for x st x in Z holds ((sin*f)`|Z).x = a* cos.(a*x+b);



theorem 
  Z c= dom (cos*f) & (for x st x in Z holds f.x=a*x+b) implies cos*f
is_differentiable_on Z & for x st x in Z holds ((cos*f)`|Z).x = -a* sin.(a*x+b)
;



theorem 
  (for x st x in Z holds cos.x<>0) implies cos^ is_differentiable_on Z &
  for x st x in Z holds ( (cos^)`|Z).x= sin.x/(cos.x)^2;



theorem 
  (for x st x in Z holds sin.x<>0) implies sin^ is_differentiable_on Z &
  for x st x in Z holds ( (sin^)`|Z).x= -cos.x/(sin.x)^2;



theorem 
  Z c= dom (sin(#)cos) implies sin(#)cos is_differentiable_on Z & for x
  st x in Z holds ((sin(#)cos)`|Z).x = cos(2*x);



theorem 
  Z c= dom (ln*cos) & (for x st x in Z holds cos.x >0) implies ln*cos
  is_differentiable_on Z & for x st x in Z holds ((ln*cos)`|Z).x =- tan(x);



theorem 
  Z c= dom (ln*sin) & (for x st x in Z holds sin.x >0) implies ln*sin
  is_differentiable_on Z & for x st x in Z holds ((ln*sin)`|Z).x = cot(x);



theorem 
  Z c= dom ((-id Z)(#)cos) implies (-id Z)(#)cos
is_differentiable_on Z & for x st x in Z holds (((-id Z)(#)cos)`|Z).x =-cos.x+x
  *sin.x;



theorem 
  Z c= dom ((id Z)(#)sin) implies (id Z)(#)sin
is_differentiable_on Z & for x st x in Z holds (((id Z)(#)sin)`|Z).x =sin.x+x*
  cos.x;



theorem 
  Z c= dom ((-id Z)(#)cos+sin) implies (-id Z)(#)cos+sin
  is_differentiable_on Z & for x st x in Z holds (((-id Z)(#)cos+sin)`|Z).x =x*
  sin.x;



theorem 
  Z c= dom ((id Z)(#)sin+cos) implies (id Z)(#)sin+cos
is_differentiable_on Z & for x st x in Z holds (((id Z)(#)sin+cos)`|Z).x =x*cos
  .x;



theorem 
  Z c= dom ((2(#)(( #R (1/2))*sin))) & (for x st x in Z holds sin.x>0)
implies 2(#)(( #R (1/2))*sin) is_differentiable_on Z & for x st x in Z holds ((
  2(#)(( #R (1/2))*sin))`|Z).x =cos.x*(sin.x) #R (-1/2);

theorem 
  Z c= dom ((1/2)(#)(( #Z 2)*sin)) implies (1/2)(#)(( #Z 2)*sin)
is_differentiable_on Z & for x st x in Z holds (((1/2)(#)(( #Z 2)*sin))`|Z).x =
  sin.x*cos.x;



theorem 
  Z c= dom (sin+(1/2)(#)(( #Z 2)*sin)) & (for x st x in Z holds sin.x>0
& sin.x<1) implies sin+(1/2)(#)(( #Z 2)*sin) is_differentiable_on Z & for x st
  x in Z holds ((sin+(1/2)(#)(( #Z 2)*sin))`|Z).x =(cos.x)|^3/(1-sin.x);



theorem 
  Z c= dom ((1/2)(#)(( #Z 2)*sin)-cos) & (for x st x in Z holds sin.x>0
  & cos.x<1) implies ((1/2)(#)(( #Z 2)*sin)-cos) is_differentiable_on Z & for x
  st x in Z holds ( ((1/2)(#)(( #Z 2)*sin)-cos) `|Z).x =(sin.x)|^3/(1-cos.x);



theorem 
  Z c= dom (sin-(1/2)(#)(( #Z 2)*sin)) & (for x st x in Z holds sin.x>0
& sin.x>-1) implies sin-(1/2)(#)(( #Z 2)*sin) is_differentiable_on Z & for x st
  x in Z holds ((sin-(1/2)(#)(( #Z 2)*sin))`|Z).x =(cos.x)|^3/(1+sin.x);



theorem 
  Z c= dom (-cos-(1/2)(#)(( #Z 2)*sin)) & (for x st x in Z holds sin.x>0
  & cos.x>-1) implies -cos-(1/2)(#)(( #Z 2)*sin) is_differentiable_on Z & for x
  st x in Z holds ((-cos-(1/2)(#)(( #Z 2)*sin))`|Z).x =(sin.x)|^3/(1+cos.x);



theorem 
  Z c= dom ((1/n)(#)(( #Z n)*sin)) & n>0 implies (1/n)(#)(( #Z n)*sin)
is_differentiable_on Z & for x st x in Z holds (((1/n)(#)(( #Z n)*sin))`|Z).x =
  (sin.x) #Z (n-1) *cos.x;




theorem 
  Z c= dom (exp_R(#)f) & (for x st x in Z holds f.x=x-1) implies exp_R
  (#)f is_differentiable_on Z & for x st x in Z holds ((exp_R(#)f)`|Z).x = x*(
  exp_R.x);



theorem 
  Z c= dom (ln*(exp_R/(exp_R+f))) & (for x st x in Z holds f.x=1)
implies ln*(exp_R/(exp_R+f)) is_differentiable_on Z & for x st x in Z holds ((
  ln*(exp_R/(exp_R+f)))`|Z).x = 1/(exp_R.x+1);



theorem 
  Z c= dom (ln*((exp_R-f)/exp_R)) & (for x st x in Z holds f.x=1 & (
exp_R-f).x>0) implies ln*((exp_R-f)/exp_R) is_differentiable_on Z & for x st x
  in Z holds ((ln*((exp_R-f)/exp_R))`|Z).x = 1/(exp_R.x-1);














begin

reserve y for set,
  x,a,b for Real,
  n for Element of NAT,
  Z for open Subset of REAL,
  f,f1,f2,g for PartFunc of REAL,REAL;



theorem 
  Z c= dom (f1/f2) & (for x st x in Z holds f1.x=a+x & f2.x=a-x & f2.x<>
0) implies (f1/f2) is_differentiable_on Z & for x st x in Z holds ((f1/f2)`|Z).
  x = (2*a)/(a-x)^2;



theorem 
  Z c= dom (f1/f2) & (for x st x in Z holds f1.x=x-a & f2.x=x+a & f2.x<>
0) implies (f1/f2) is_differentiable_on Z & for x st x in Z holds ((f1/f2)`|Z).
  x = (2*a)/(x+a)^2;



theorem 
  Z c= dom (f1/f2) & (for x st x in Z holds f1.x=x-a & f2.x=x-b & f2.x<>
0) implies (f1/f2) is_differentiable_on Z & for x st x in Z holds ((f1/f2)`|Z).
  x = (a-b)/(x-b)^2;



theorem 
  not 0 in Z implies (id Z)^ is_differentiable_on Z & for x st x in
  Z holds (((id Z)^)`|Z).x= -1/x^2;

theorem 
  not 0 in Z implies sin*((id Z)^) is_differentiable_on Z & for x
  st x in Z holds ((sin*((id Z)^))`|Z).x = -(1/x^2)*cos.(1/x);



theorem 
  not 0 in Z & Z c= dom (cos*((id Z)^)) implies cos*((id Z)^)
is_differentiable_on Z & for x st x in Z holds ((cos*((id Z)^))`|Z).x = 1/x^2*
  sin.(1/x);



theorem 
  Z c= dom ((id Z)(#)(sin*((id Z)^))) & not 0 in Z implies (id Z)(#)(sin
*((id Z)^)) is_differentiable_on Z & for x st x in Z holds (((id Z)(#)(sin*((id
  Z)^)))`|Z).x = sin.(1/x)-(1/x)*cos.(1/x);



theorem 
  Z c= dom ((id Z)(#)(cos*((id Z)^))) & not 0 in Z implies (id Z)(#)(cos
*((id Z)^)) is_differentiable_on Z & for x st x in Z holds (((id Z)(#)(cos*((id
  Z)^)))`|Z).x = cos.(1/x)+(1/x)*sin.(1/x);



theorem 
  Z c= dom ((sin*((id Z)^))(#)(cos*((id Z)^))) & not 0 in Z implies (sin
*((id Z)^))(#)(cos*((id Z)^)) is_differentiable_on Z & for x st x in Z holds ((
(sin*((id Z)^))(#)(cos*((id Z)^)))`|Z).x = (1/x^2)*((sin.(1/x))^2-(cos.(1/x))^2
  );



theorem 
  Z c= dom ((sin*f)(#)(( #Z n)*sin)) & n>=1 & (for x st x in Z holds f.x
=n*x) implies (sin*f)(#)(( #Z n)*sin) is_differentiable_on Z & for x st x in Z
  holds (((sin*f)(#)(( #Z n)*sin))`|Z).x =n*(sin.x) #Z (n-1)*sin.((n+1)*x);



theorem 
  Z c= dom ((cos*f)(#)(( #Z n)*sin)) & n>=1 & (for x st x in Z holds f.x
=n*x) implies (cos*f)(#)(( #Z n)*sin) is_differentiable_on Z & for x st x in Z
  holds (((cos*f)(#)(( #Z n)*sin))`|Z).x =n*(sin.x) #Z (n-1) * cos.((n+1)*x);



theorem 
  Z c= dom ((cos*f)(#)(( #Z n)*cos)) & n>=1 & (for x st x in Z holds f.x
=n*x) implies (cos*f)(#)(( #Z n)*cos) is_differentiable_on Z & for x st x in Z
  holds (((cos*f)(#)(( #Z n)*cos))`|Z).x =-n*(cos.x) #Z (n-1) *sin.((n+1)*x);



theorem 
  Z c= dom ((sin*f)(#)(( #Z n)*cos)) & n>=1 & (for x st x in Z holds f.x
=n*x) implies (sin*f)(#)(( #Z n)*cos) is_differentiable_on Z & for x st x in Z
  holds (((sin*f)(#)(( #Z n)*cos))`|Z).x =n*(cos.x) #Z (n-1) *cos.((n+1)*x);



theorem 
  not 0 in Z & Z c= dom (((id Z)^)(#)sin) implies ((id Z)^)(#)sin
is_differentiable_on Z & for x st x in Z holds ((((id Z)^)(#)sin)`|Z).x =(1/x)*
  cos.x-(1/x^2)*sin.x;



theorem 
  not 0 in Z & Z c= dom (((id Z)^)(#)cos) implies ((id Z)^)(#)cos
is_differentiable_on Z & for x st x in Z holds ((((id Z)^)(#)cos)`|Z).x =-(1/x)
  *sin.x-(1/x^2)*cos.x;



theorem 
  Z c= dom (sin+( #R (1/2))) implies sin+( #R (1/2))
is_differentiable_on Z & for x st x in Z holds ((sin+( #R (1/2)))`|Z).x =cos.x+
  (1/2)* x #R (-1/2);



theorem 
  not 0 in Z & Z c= dom (g(#)(sin*((id Z)^))) & g=#Z 2 implies g(#)(sin*
((id Z)^)) is_differentiable_on Z & for x st x in Z holds ((g(#)(sin*((id Z)^))
  )`|Z).x = 2*x*sin.(1/x)-cos.(1/x);



theorem 
  not 0 in Z & Z c= dom (g(#)(cos*((id Z)^))) & g=#Z 2 implies g(#)(cos*
((id Z)^)) is_differentiable_on Z & for x st x in Z holds ((g(#)(cos*((id Z)^))
  )`|Z).x = 2*x*cos.(1/x)+sin.(1/x);

theorem 
  Z c= dom ln implies ln is_differentiable_on Z & for x st x in Z
  holds (ln`|Z).x = 1/x;



theorem 
  Z c= dom ((id Z)(#)ln) implies (id Z)(#)ln is_differentiable_on Z &
  for x st x in Z holds (((id Z)(#)ln)`|Z).x = 1+ln.x;



theorem 
  Z c= dom (g(#)ln) & g=#Z 2 & (for x st x in Z holds x>0) implies g(#)
ln is_differentiable_on Z & for x st x in Z holds ((g(#)ln)`|Z).x = x+2*x*ln.x;



theorem 
  Z c= dom ((f1+f2)/(f1-f2)) & (for x st x in Z holds f1.x=a) & f2
  =#Z 2 & (for x st x in Z holds (f1-f2).x>0) implies (f1+f2)/(f1-f2)
is_differentiable_on Z & for x st x in Z holds (((f1+f2)/(f1-f2))`|Z).x = (4*a*
  x)/(a-x|^2)|^2;



theorem 
  Z c= dom (ln*((f1+f2)/(f1-f2))) & (for x st x in Z holds f1.x=a) & f2=
#Z 2 & (for x st x in Z holds (f1-f2).x>0) & (for x st x in Z holds (f1+f2).x>0
) implies ln*((f1+f2)/(f1-f2)) is_differentiable_on Z & for x st x in Z holds (
  (ln*((f1+f2)/(f1-f2)))`|Z).x = (4*a*x)/(a|^2-x|^4);



theorem 
  Z c= dom (((id Z)^)(#)ln) & (for x st x in Z holds x >0) implies ((id
Z)^)(#)ln is_differentiable_on Z & for x st x in Z holds ((((id Z)^)(#)ln)`|Z).
  x = (1/x^2)*(1-ln.x);



theorem 
  Z c= dom (ln^) & (for x st x in Z holds ln.x<>0) implies (ln^)
  is_differentiable_on Z & for x st x in Z holds ((ln^)`|Z).x =-1/(x*(ln.x)^2);














begin

reserve y for set,
  x,a for Real,
  n for Element of NAT,
  Z for open Subset of REAL,
  f,f1,f2 for PartFunc of REAL,REAL;



theorem 
  a>0 implies exp_R.(x*log(number_e,a))=a #R x;



theorem 
  a>0 implies exp_R.(-x*log(number_e,a))=a #R (-x);



theorem 
  Z c= dom (f1-f2) & (for x st x in Z holds f1.x=a^2) & f2=#Z 2
implies f1-f2 is_differentiable_on Z & for x st x in Z holds ((f1-f2)`|Z).x = -
  2*x;



theorem 
  Z c= dom ((f1+f2)/(f1-f2)) & f2=#Z 2 & (for x st x in Z holds f1.
x=a^2 & (f1-f2).x<>0) implies (f1+f2)/(f1-f2) is_differentiable_on Z & for x st
  x in Z holds (((f1+f2)/(f1-f2))`|Z).x = 4*a^2*x/(a^2-x|^2)^2;



theorem 
  Z c= dom f & f=ln*((f1+f2)/(f1-f2)) & f2=#Z 2 & (for x st x in Z
  holds f1.x=a^2 & (f1-f2).x>0 & a<>0) implies f is_differentiable_on Z & for x
  st x in Z holds (f`|Z).x =4*a^2*x/(a|^4-x|^4);



theorem 
  Z c= dom ((1/(4*a^2))(#)f) & f=ln*((f1+f2)/(f1-f2)) & f2=#Z 2 & (for x
  st x in Z holds f1.x=a^2 & (f1-f2).x>0 & a<>0) implies (1/(4*a^2))(#)f
is_differentiable_on Z & for x st x in Z holds (((1/(4*a^2))(#)f)`|Z).x =x/(a|^
  4-x|^4);



theorem 
  Z c= dom (f1/(f2+f1)) & f1=#Z 2 & (for x st x in Z holds f2.x=1 &
x<>0) implies f1/(f2+f1) is_differentiable_on Z & for x st x in Z holds ((f1/(
  f2+f1))`|Z).x =2*x/(1+x^2)^2;



theorem 
  Z c= dom ((1/2)(#)f) & f=ln*(f1/(f2+f1)) & f1=#Z 2 & (for x st x in Z
holds f2.x=1 & x<>0) implies (1/2)(#)f is_differentiable_on Z & for x st x in Z
  holds (((1/2)(#)f)`|Z).x =1/(x*(1+x^2));



theorem 
  Z c= dom (ln*( #Z n)) & (for x st x in Z holds x>0) implies ln*( #Z n)
  is_differentiable_on Z & for x st x in Z holds ((ln*( #Z n))`|Z).x =n/x;



theorem 
  Z c= dom (f2^+ln*(f1/f2)) & (for x st x in Z holds f2.x = x & f2.x>0 &
f1.x=x-1 & f1.x >0 ) implies f2^+ln*(f1/f2) is_differentiable_on Z & for x st x
  in Z holds ( (f2^+ln*(f1/f2))`|Z).x= 1/(x^2*(x-1));



theorem 
  Z c= dom (exp_R*f) & (for x st x in Z holds f.x=x*log(number_e,a
)) & a>0 implies exp_R*f is_differentiable_on Z & for x st x in Z holds ((exp_R
  *f)`|Z).x =a #R x*log(number_e,a);



theorem 
  Z c= dom ((1/log(number_e,a))(#)((exp_R*f1)(#)f2)) & (for x st x in Z
holds f1.x=x*log(number_e,a) & f2.x=x-1/log(number_e,a)) & a>0 & a<>1 implies (
1/log(number_e,a))(#)((exp_R*f1)(#)f2) is_differentiable_on Z & for x st x in Z
  holds (((1/log(number_e,a))(#)((exp_R*f1)(#)f2))`|Z).x =x * a #R x;



theorem 
  Z c= dom ((1/(1+log(number_e,a)))(#)((exp_R*f)(#)exp_R)) & (for x st x
  in Z holds f.x=x*log(number_e,a)) & a>0 & a<>1/number_e implies (1/(1+log(
  number_e,a)))(#)((exp_R*f)(#)exp_R) is_differentiable_on Z & for x st x in Z
  holds (((1/(1+log(number_e,a)))(#)((exp_R*f)(#)exp_R))`|Z).x =a #R x*exp_R.x;



theorem 
  Z c= dom (exp_R*f) & (for x st x in Z holds f.x=-x) implies
  exp_R*f is_differentiable_on Z & for x st x in Z holds ((exp_R*f)`|Z).x = -
  exp_R(-x);



theorem 
  Z c= dom (f1(#)(exp_R*f2)) & (for x st x in Z holds f1.x=-x-1 & f2.x=-
x) implies f1(#)(exp_R*f2) is_differentiable_on Z & for x st x in Z holds ((f1
  (#)(exp_R*f2))`|Z).x = x/exp_R(x);



theorem 
  Z c= dom -(exp_R*f) & (for x st x in Z holds f.x=-x*log(number_e
,a)) & a>0 implies -(exp_R*f) is_differentiable_on Z & for x st x in Z holds ((
  -(exp_R*f))`|Z).x =a #R (-x)*log(number_e,a);



theorem 
  Z c= dom ((1/log(number_e,a))(#)((-(exp_R*f1))(#)f2)) & (for x st x in
  Z holds f1.x=-x*log(number_e,a) & f2.x=x+1/log(number_e,a)) & a>0 & a<>1
implies (1/log(number_e,a))(#)((-(exp_R*f1))(#)f2) is_differentiable_on Z & for
x st x in Z holds (((1/log(number_e,a))(#)((-(exp_R*f1))(#)f2))`|Z).x =x /a #R
  x;



theorem 
  Z c= dom ((1/(log(number_e,a)-1))(#)((exp_R*f)/exp_R)) & (for x st x
in Z holds f.x=x*log(number_e,a)) & a>0 & a<>number_e implies (1/(log(number_e,
a)-1))(#)((exp_R*f)/exp_R) is_differentiable_on Z & for x st x in Z holds (((1/
  (log(number_e,a)-1))(#)((exp_R*f)/exp_R))`|Z).x =a #R x/exp_R.x;



theorem 
  Z c= dom ((1/(1-log(number_e,a)))(#)(exp_R/(exp_R*f))) & (for x st x
  in Z holds f.x=x*log(number_e,a)) & a>0 & a<>number_e implies (1/(1-log(
  number_e,a)))(#)(exp_R/(exp_R*f)) is_differentiable_on Z & for x st x in Z
  holds (((1/(1-log(number_e,a)))(#)(exp_R/(exp_R*f)))`|Z).x =exp_R.x/a #R x;



theorem 
  Z c= dom (ln*(exp_R+f)) & (for x st x in Z holds f.x=1 ) implies ln*(
exp_R+f) is_differentiable_on Z & for x st x in Z holds ((ln*(exp_R+f))`|Z).x =
  exp_R.x/(exp_R.x+1);



theorem 
  Z c= dom (ln*(exp_R-f)) & (for x st x in Z holds f.x=1 & (exp_R-f).x>0
  ) implies ln*(exp_R-f) is_differentiable_on Z & for x st x in Z holds ((ln*(
  exp_R-f))`|Z).x = exp_R.x/(exp_R.x-1);



theorem 
  Z c= dom -(ln*(f-exp_R)) & (for x st x in Z holds f.x=1 & (f-exp_R).x>
0) implies -(ln*(f-exp_R)) is_differentiable_on Z & for x st x in Z holds ( (-
  ln*(f-exp_R)) `|Z).x = exp_R.x/(1-exp_R.x);



theorem 
  Z c= dom ((( #Z 2)*exp_R)+f) & (for x st x in Z holds f.x=1)
  implies (( #Z 2)*exp_R)+f is_differentiable_on Z & for x st x in Z holds ((((
  #Z 2)*exp_R)+f)`|Z).x =2*exp_R(2*x);



theorem 
  Z c= dom ((1/2)(#)(ln*f)) & f=(( #Z 2)*exp_R)+f1 & (for x st x in Z
  holds f1.x=1) implies (1/2)(#)(ln*f) is_differentiable_on Z & for x st x in Z
  holds (((1/2)(#)(ln*f))`|Z).x =exp_R(x)/(exp_R(x)+exp_R(-x));



theorem 
  Z c= dom ((( #Z 2)*exp_R)-f) & (for x st x in Z holds f.x=1)
  implies (( #Z 2)*exp_R)-f is_differentiable_on Z & for x st x in Z holds ((((
  #Z 2)*exp_R)-f)`|Z).x =2*exp_R(2*x);



theorem 
  Z c= dom ((1/2)(#)(ln*f)) & f=(( #Z 2)*exp_R)-f1 & (for x st x in Z
holds f1.x=1 & f.x>0) implies (1/2)(#)(ln*f) is_differentiable_on Z & for x st
  x in Z holds (((1/2)(#)(ln*f))`|Z).x =exp_R(x)/(exp_R(x)-exp_R(-x));



theorem 
  Z c= dom (( #Z 2)*(exp_R-f)) & (for x st x in Z holds f.x=1)
implies ( #Z 2)*(exp_R-f) is_differentiable_on Z & for x st x in Z holds ((( #Z
  2)*(exp_R-f))`|Z).x =2*exp_R.x*(exp_R.x-1);



theorem 
  Z c= dom f & f=ln*((( #Z 2)*(exp_R-f1))/exp_R) & (for x st x in Z
holds f1.x=1 & (exp_R-f1).x>0) implies f is_differentiable_on Z & for x st x in
  Z holds (f`|Z).x =(exp_R.x+1)/(exp_R.x-1);



theorem 
  Z c= dom (( #Z 2)*(exp_R+f)) & (for x st x in Z holds f.x=1)
implies ( #Z 2)*(exp_R+f) is_differentiable_on Z & for x st x in Z holds ((( #Z
  2)*(exp_R+f))`|Z).x =2*exp_R.x*(exp_R.x+1);



theorem 
  Z c= dom f & f=ln*((( #Z 2)*(exp_R+f1))/exp_R) & (for x st x in Z
holds f1.x=1) implies f is_differentiable_on Z & for x st x in Z holds (f`|Z).x
  =(exp_R.x-1)/(exp_R.x+1);



theorem 
  Z c= dom (( #Z 2)*(f-exp_R)) & (for x st x in Z holds f.x=1)
implies ( #Z 2)*(f-exp_R) is_differentiable_on Z & for x st x in Z holds ((( #Z
  2)*(f-exp_R))`|Z).x =-2*exp_R.x*(1-exp_R.x);



theorem 
  Z c= dom f & f=ln*(exp_R/(( #Z 2)*(f1-exp_R))) & (for x st x in Z
holds f1.x=1 & (f1-exp_R).x>0) implies f is_differentiable_on Z & for x st x in
  Z holds (f`|Z).x =(1+exp_R.x)/(1-exp_R.x);



theorem 
  Z c= dom f & f=ln*(exp_R/(( #Z 2)*(f1+exp_R))) & (for x st x in Z
holds f1.x=1) implies f is_differentiable_on Z & for x st x in Z holds (f`|Z).x
  =(1-exp_R.x)/(1+exp_R.x);



theorem 
  Z c= dom (ln*f) & f=exp_R+(exp_R*f1) & (for x st x in Z holds f1.x=-x)
  implies ln*f is_differentiable_on Z & for x st x in Z holds ((ln*f)`|Z).x =(
  exp_R(x)-exp_R(-x))/(exp_R(x)+exp_R(-x));



theorem 
  Z c= dom (ln*f) & f=exp_R-(exp_R*f1) & (for x st x in Z holds f1.x=-x
& f.x>0) implies ln*f is_differentiable_on Z & for x st x in Z holds ((ln*f)`|Z
  ).x=(exp_R(x)+exp_R(-x))/ (exp_R(x)-exp_R(-x));



theorem 
  Z c= dom ((2/3)(#)(( #R (3/2))*(f+exp_R))) & (for x st x in Z holds f.
x=1) implies (2/3)(#)(( #R (3/2))*(f+exp_R)) is_differentiable_on Z & for x st
x in Z holds (((2/3)(#)(( #R (3/2))*(f+exp_R)))`|Z).x =exp_R.x*(1+exp_R.x) #R (
  1/2);



theorem 
  Z c= dom ((2/(3*log(number_e,a)))(#)(( #R (3/2))*(f+(exp_R*f1)))) & (
for x st x in Z holds f.x=1 & f1.x=x*log(number_e,a)) & a>0 & a<>1 implies (2/(
3*log(number_e,a)))(#)(( #R (3/2))*(f+(exp_R*f1))) is_differentiable_on Z & for
x st x in Z holds (((2/(3*log(number_e,a)))(#)(( #R (3/2))*(f+(exp_R*f1))))`|Z)
  .x =a #R x * (1+a #R x) #R (1/2);



theorem 
  Z c= dom ((-1/2)(#)(cos*f)) & (for x st x in Z holds f.x=2*x) implies
(-1/2)(#)(cos*f) is_differentiable_on Z & for x st x in Z holds (((-1/2)(#)(cos
  *f))`|Z).x =sin(2*x);

theorem 
  Z c= dom (2(#)(( #R (1/2))*(f-cos))) & (for x st x in Z holds f.x=1 &
  sin.x>0 & cos.x<1 & cos.x>-1) implies 2(#)(( #R (1/2))*(f-cos))
is_differentiable_on Z & for x st x in Z holds ((2(#)(( #R (1/2))*(f-cos)))`|Z)
  .x =(1+cos.x) #R (1/2);

theorem 
  Z c= dom ((-2)(#)(( #R (1/2))*(f+cos))) & (for x st x in Z holds f.x=1
  & sin.x>0 & cos.x<1 & cos.x>-1) implies (-2)(#)(( #R (1/2))*(f+cos))
is_differentiable_on Z & for x st x in Z holds (((-2)(#)(( #R (1/2))*(f+cos)))
  `|Z).x =(1-cos.x) #R (1/2);

theorem 
  Z c= dom ((1/2)(#)(ln*f)) & f=f1+2(#)sin & (for x st x in Z holds f1.x
  =1 & f.x >0) implies (1/2)(#)(ln*f) is_differentiable_on Z & for x st x in Z
  holds (((1/2)(#)(ln*f))`|Z).x =cos.x/(1+2*sin.x);

theorem 
  Z c= dom ((-1/2)(#)(ln*f)) & f=f1+2(#)cos & (for x st x in Z holds f1.
x=1 & f.x >0) implies (-1/2)(#)(ln*f) is_differentiable_on Z & for x st x in Z
  holds (((-1/2)(#)(ln*f))`|Z).x =sin.x/(1+2*cos.x);



theorem 
  Z c= dom ((1/(4*a))(#)(sin*f)) & (for x st x in Z holds f.x=2*a*
x) & a<>0 implies (1/(4*a))(#)(sin*f) is_differentiable_on Z & for x st x in Z
  holds (((1/(4*a))(#)(sin*f))`|Z).x =1/2 * cos(2*a*x);



theorem 
  Z c= dom (f1-((1/(4*a))(#)(sin*f))) & (for x st x in Z holds f1.x=x/2
  & f.x=2*a*x) & a<>0 implies f1-((1/(4*a))(#)(sin*f)) is_differentiable_on Z &
  for x st x in Z holds ((f1-((1/(4*a))(#)(sin*f)))`|Z).x =(sin(a*x))^2;



theorem 
  Z c= dom (f1+((1/(4*a))(#)(sin*f))) & (for x st x in Z holds f1.x=x/2
  & f.x=2*a*x) & a<>0 implies f1+((1/(4*a))(#)(sin*f)) is_differentiable_on Z &
  for x st x in Z holds ((f1+((1/(4*a))(#)(sin*f)))`|Z).x =(cos(a*x))^2;



theorem 
  Z c= dom ((1/n)(#)(( #Z n)*cos)) & n>0 implies (1/n)(#)(( #Z n)*
cos) is_differentiable_on Z & for x st x in Z holds (((1/n)(#)(( #Z n)*cos))`|Z
  ).x =-(cos.x) #Z (n-1)*sin.x;



theorem 
  Z c= dom (((1/3)(#)(( #Z 3)*cos))-cos) implies (1/3)(#)(( #Z 3)*cos)-
  cos is_differentiable_on Z & for x st x in Z holds ((((1/3)(#)(( #Z 3)*cos))-
  cos)`|Z).x =(sin.x)|^3;



theorem 
  Z c= dom (sin-((1/3)(#)(( #Z 3)*sin))) implies sin-((1/3)(#)(( #Z 3)*
  sin)) is_differentiable_on Z & for x st x in Z holds ((sin-((1/3)(#)(( #Z 3)*
  sin)))`|Z).x =(cos.x)|^3;



theorem 
  Z c= dom (sin*ln) implies sin*ln is_differentiable_on Z & for x st x
  in Z holds ((sin*ln)`|Z).x =cos.(log(number_e,x))/x;



theorem 
  Z c= dom (-(cos*ln)) implies -(cos*ln) is_differentiable_on Z & for x
  st x in Z holds ((-(cos*ln))`|Z).x =sin.(log(number_e,x))/x;














begin

reserve y for set,
  x,r,a,b for Real,
  n for Element of NAT,
  Z for open Subset of REAL,
  f,f1,f2,f3 for PartFunc of REAL,REAL;

theorem 
  x #Z 2=x^2;

theorem 
  x>0 implies x #R (1/2)=sqrt x;

theorem 
  x>0 implies x #R (-1/2)=1/sqrt x;



theorem 
  Z c=]. -1,1 .[ & Z c= dom (r(#)arcsin) implies r(#)arcsin
is_differentiable_on Z & for x st x in Z holds ((r(#)arcsin)`|Z).x = r / sqrt(1
  -x^2);



theorem 
  Z c=]. -1,1 .[ & Z c= dom (r(#)arccos) implies r(#)arccos
is_differentiable_on Z & for x st x in Z holds ((r(#)arccos)`|Z).x =- r / sqrt(
  1-x^2);

theorem 
  f is_differentiable_in x & f.x > -1 & f.x < 1 implies (arcsin)*f
  is_differentiable_in x & diff((arcsin)*f,x) = diff(f,x)/sqrt(1-(f.x)^2);

theorem 
  f is_differentiable_in x & f.x > -1 & f.x < 1 implies (arccos)*f
  is_differentiable_in x & diff((arccos)*f,x) = -diff(f,x)/sqrt(1-(f.x)^2);



theorem 
  Z c= dom (ln*(arcsin)) & Z c= ]. -1,1 .[ & (for x st x in Z holds
arcsin.x>0) implies ln*(arcsin) is_differentiable_on Z & for x st x in Z holds
  ((ln*(arcsin))`|Z).x=1 / (sqrt(1-x^2)*arcsin.x);



theorem 
  Z c= dom (ln*arccos) & Z c= ]. -1,1 .[ & (for x st x in Z holds arccos
.x>0) implies ln*(arccos) is_differentiable_on Z & for x st x in Z holds ((ln*(
  arccos))`|Z).x=-1 / (sqrt(1-x^2)*arccos.x);



theorem 
  Z c= dom (( #Z n)*(arcsin)) & Z c=]. -1,1 .[ implies ( #Z n)*(
arcsin) is_differentiable_on Z & for x st x in Z holds ((( #Z n)*arcsin)`|Z).x
  =n*(arcsin.x) #Z (n-1) / sqrt(1-x^2);



theorem 
  Z c= dom (( #Z n)*(arccos)) & Z c=]. -1,1 .[ implies ( #Z n)*(
arccos) is_differentiable_on Z & for x st x in Z holds ((( #Z n)*(arccos))`|Z).
  x =-n*(arccos.x) #Z (n-1) / sqrt(1-x^2);



theorem 
  Z c= dom ((1/2)(#)(( #Z 2)*(arcsin))) & Z c=]. -1,1 .[ implies (1/2)
(#)(( #Z 2)*(arcsin)) is_differentiable_on Z & for x st x in Z holds (((1/2)(#)
  (( #Z 2)*(arcsin)))`|Z).x =arcsin.x / sqrt(1-x^2);



theorem 
  Z c= dom ((1/2)(#)(( #Z 2)*(arccos))) & Z c=]. -1,1 .[ implies (1/2)
(#)(( #Z 2)*(arccos)) is_differentiable_on Z & for x st x in Z holds (((1/2)(#)
  (( #Z 2)*(arccos)))`|Z).x =-arccos.x / sqrt(1-x^2);



theorem 
  Z c= dom ((arcsin)*f) & (for x st x in Z holds f.x=a*x+b & f.x >
-1 & f.x < 1) implies (arcsin)*f is_differentiable_on Z & for x st x in Z holds
  (((arcsin)*f)`|Z).x=a / sqrt(1-(a*x+b)^2);



theorem 
  Z c= dom ((arccos)*f) & (for x st x in Z holds f.x=a*x+b & f.x >
-1 & f.x < 1) implies (arccos)*f is_differentiable_on Z & for x st x in Z holds
  (((arccos)*f)`|Z).x=-a / sqrt(1-(a*x+b)^2);



theorem 
  Z c= dom ((id Z)(#)(arcsin)) & Z c= ]. -1,1 .[ implies (id Z)(#)
(arcsin) is_differentiable_on Z & for x st x in Z holds (((id Z)(#)(arcsin))`|Z
  ).x =arcsin.x+x/sqrt(1-x^2);



theorem 
  Z c= dom ((id Z)(#)(arccos)) & Z c= ]. -1,1 .[ implies (id Z)(#)
(arccos) is_differentiable_on Z & for x st x in Z holds (((id Z)(#)(arccos))`|Z
  ).x =arccos.x-x/sqrt(1-x^2);



theorem 
  Z c= dom (f(#)(arcsin)) & Z c= ]. -1,1 .[ & (for x st x in Z holds f.x
=a*x+b) implies f(#)(arcsin) is_differentiable_on Z & for x st x in Z holds ((f
  (#)(arcsin))`|Z).x =a*arcsin.x+(a*x+b)/sqrt(1-x^2);



theorem 
  Z c= dom (f(#)(arccos)) & Z c= ]. -1,1 .[ & (for x st x in Z holds f.x
=a*x+b) implies f(#)(arccos) is_differentiable_on Z & for x st x in Z holds ((f
  (#)(arccos))`|Z).x =a*arccos.x-(a*x+b)/sqrt(1-x^2);



theorem 
  Z c= dom ((1/2)(#)((arcsin)*f)) & (for x st x in Z holds f.x=2*x & f.x
> -1 & f.x < 1) implies (1/2)(#)((arcsin)*f) is_differentiable_on Z & for x st
  x in Z holds (((1/2)(#)((arcsin)*f))`|Z).x=1/sqrt(1-(2*x)^2);



theorem 
  Z c= dom ((1/2)(#)((arccos)*f)) & (for x st x in Z holds f.x=2*x & f.x
> -1 & f.x < 1) implies (1/2)(#)((arccos)*f) is_differentiable_on Z & for x st
  x in Z holds (((1/2)(#)((arccos)*f))`|Z).x=-1/sqrt(1-(2*x)^2);



theorem 
  Z c= dom (( #R (1/2))*f) & f=f1-f2 & f2=#Z 2 & (for x st x in Z
  holds f1.x=1 & f.x >0) implies (( #R (1/2))*f) is_differentiable_on Z & for x
  st x in Z holds ((( #R (1/2))*f)`|Z).x =-x*(1-x #Z 2) #R (-1/2);



theorem 
  Z c= dom ((id Z)(#)(arcsin)+( #R (1/2))*f) & Z c= ]. -1,1 .[ & f=f1-f2
  & f2=#Z 2 & (for x st x in Z holds f1.x=1 & f.x >0 & x<>0) implies (id Z)(#)(
  arcsin)+( #R (1/2))*f is_differentiable_on Z & for x st x in Z holds (((id Z)
  (#)(arcsin)+( #R (1/2))*f)`|Z).x =arcsin.x;



theorem 
  Z c= dom ((id Z)(#)(arccos)-( #R (1/2))*f) & Z c= ]. -1,1 .[ & f=f1-f2
  & f2=#Z 2 & (for x st x in Z holds f1.x=1 & f.x >0 & x<>0) implies (id Z)(#)(
  arccos)-( #R (1/2))*f is_differentiable_on Z & for x st x in Z holds (((id Z)
  (#)(arccos)-( #R (1/2))*f)`|Z).x =arccos.x;



theorem 
  Z c= dom ((id Z)(#)((arcsin)*f)) & (for x st x in Z holds f.x=x/
a & f.x > -1 & f.x < 1) implies (id Z)(#)((arcsin)*f) is_differentiable_on Z &
for x st x in Z holds (((id Z)(#)((arcsin)*f))`|Z).x =arcsin.(x/a)+x/(a*sqrt(1-
  (x/a)^2));



theorem 
  Z c= dom ((id Z)(#)((arccos)*f)) & (for x st x in Z holds f.x=x/
a & f.x > -1 & f.x < 1) implies (id Z)(#)((arccos)*f) is_differentiable_on Z &
for x st x in Z holds (((id Z)(#)((arccos)*f))`|Z).x =arccos.(x/a)-x/(a*sqrt(1-
  (x/a)^2));



theorem 
  Z c= dom (( #R (1/2))*f) & f=f1-f2 & f2=#Z 2 & (for x st x in Z
  holds f1.x=a^2 & f.x >0) implies ( #R (1/2))*f is_differentiable_on Z & for x
  st x in Z holds ((( #R (1/2))*f)`|Z).x = -x*(a^2-x #Z 2) #R (-1/2);



theorem 
  Z c= dom ((id Z)(#)((arcsin)*f3)+( #R (1/2))*f) & f=f1-f2 & f2=#Z 2 &
(for x st x in Z holds f1.x=a^2 & f.x >0 & f3.x=x/a & f3.x > -1 & f3.x < 1 & x
<>0 & a>0) implies (id Z)(#)((arcsin)*f3)+( #R (1/2))*f is_differentiable_on Z
& for x st x in Z holds (((id Z)(#)((arcsin)*f3)+( #R (1/2))*f)`|Z).x = arcsin.
  (x/a);



theorem 
  Z c= dom ((id Z)(#)((arccos)*f3)-( #R (1/2))*f) & f=f1-f2 & f2=#Z 2 &
(for x st x in Z holds f1.x=a^2 & f.x >0 & f3.x=x/a & f3.x > -1 & f3.x < 1 & x
<>0 & a>0) implies (id Z)(#)((arccos)*f3)-( #R (1/2))*f is_differentiable_on Z
& for x st x in Z holds (((id Z)(#)((arccos)*f3)-( #R (1/2))*f)`|Z).x = arccos.
  (x/a);



theorem 
  Z c= dom ((-1/n)(#)(( #Z n)*(sin^))) & n>0 & (for x st x in Z holds
sin.x<>0) implies (-1/n)(#)(( #Z n)*(sin^)) is_differentiable_on Z & for x st x
  in Z holds (((-1/n)(#)(( #Z n)*(sin^)))`|Z).x=cos.x/((sin.x) #Z (n+1));



theorem 
  Z c= dom ((1/n)(#)(( #Z n)*(cos^))) & n>0 & (for x st x in Z holds cos
.x<>0) implies (1/n)(#)(( #Z n)*(cos^)) is_differentiable_on Z & for x st x in
  Z holds (((1/n)(#)(( #Z n)*(cos^)))`|Z).x=sin.x/((cos.x) #Z (n+1));



theorem 
  Z c= dom (sin*ln) & (for x st x in Z holds x>0) implies sin*ln
  is_differentiable_on Z & for x st x in Z holds ((sin*ln)`|Z).x =cos.(ln.x)/x;



theorem 
  Z c= dom (cos*ln) & (for x st x in Z holds x>0) implies cos*ln
  is_differentiable_on Z & for x st x in Z holds ((cos*ln)`|Z).x =-sin.(ln.x)/x
;



theorem 
  Z c= dom (sin*exp_R) implies sin*exp_R is_differentiable_on Z & for x
  st x in Z holds ((sin*exp_R)`|Z).x = exp_R.x * cos.(exp_R.x);



theorem 
  Z c= dom (cos*exp_R) implies cos*exp_R is_differentiable_on Z & for x
  st x in Z holds ((cos*exp_R)`|Z).x = -exp_R.x * sin.(exp_R.x);



theorem 
  Z c= dom (exp_R*cos) implies exp_R*cos is_differentiable_on Z & for x
  st x in Z holds ((exp_R*cos)`|Z).x = -exp_R.(cos.x) * sin.x;



theorem 
  Z c= dom (exp_R*sin) implies exp_R*sin is_differentiable_on Z & for x
  st x in Z holds ((exp_R*sin)`|Z).x = exp_R.(sin.x) * cos.x;



theorem 
  Z c= dom (sin+cos) implies sin+cos is_differentiable_on Z & for
  x st x in Z holds ((sin+cos)`|Z).x =cos.x-sin.x;



theorem 
  Z c= dom (sin-cos) implies sin-cos is_differentiable_on Z & for
  x st x in Z holds ((sin-cos)`|Z).x =cos.x+sin.x;



theorem 
  Z c= dom (exp_R(#)(sin-cos)) implies exp_R(#)(sin-cos)
is_differentiable_on Z & for x st x in Z holds ((exp_R(#)(sin-cos))`|Z).x =2 *
  exp_R.x * sin.x;



theorem 
  Z c= dom (exp_R(#)(sin+cos)) implies exp_R(#)(sin+cos)
is_differentiable_on Z & for x st x in Z holds ((exp_R(#)(sin+cos))`|Z).x =2 *
  exp_R.x * cos.x;



theorem 
  Z c= dom ((sin+cos)/exp_R) implies (sin+cos)/exp_R
is_differentiable_on Z & for x st x in Z holds (((sin+cos)/exp_R)`|Z).x =-2*sin
  .x/exp_R.x;



theorem 
  Z c= dom ((sin-cos)/exp_R) implies (sin-cos)/exp_R
is_differentiable_on Z & for x st x in Z holds (((sin-cos)/exp_R)`|Z).x =2*cos.
  x/exp_R.x;



theorem 
  Z c= dom (exp_R(#)sin) implies exp_R(#)sin is_differentiable_on Z &
  for x st x in Z holds ((exp_R(#)sin)`|Z).x = exp_R.x*(sin.x+cos.x);



theorem 
  Z c= dom (exp_R(#)cos) implies exp_R(#)cos is_differentiable_on Z &
  for x st x in Z holds ((exp_R(#)cos)`|Z).x = exp_R.x*(cos.x-sin.x);



theorem 
  cos.x<>0 implies sin/cos is_differentiable_in x & diff(sin/cos,
  x)=1/(cos.x)^2;



theorem 
  sin.x<>0 implies cos/sin is_differentiable_in x & diff(cos/sin,
  x)=-1/(sin.x)^2;



theorem 
  Z c= dom (( #Z 2)*(sin/cos)) & (for x st x in Z holds cos.x<>0)
implies ( #Z 2)*(sin/cos) is_differentiable_on Z & for x st x in Z holds ((( #Z
  2)*(sin/cos))`|Z).x =2*sin.x/((cos.x) #Z 3);



theorem 
  Z c= dom (( #Z 2)*(cos/sin)) & (for x st x in Z holds sin.x<>0)
implies ( #Z 2)*(cos/sin) is_differentiable_on Z & for x st x in Z holds ((( #Z
  2)*(cos/sin))`|Z).x =-2*cos.x/((sin.x) #Z 3);



theorem 
  Z c= dom ((sin/cos)*f) & (for x st x in Z holds f.x=x/2 & cos.(f.x)<>0
) implies (sin/cos)*f is_differentiable_on Z & for x st x in Z holds (((sin/cos
  )*f)`|Z).x = 1/(1+cos.x);



theorem 
  Z c= dom ((cos/sin)*f) & (for x st x in Z holds f.x=x/2 & sin.(f.x)<>0
) implies (cos/sin)*f is_differentiable_on Z & for x st x in Z holds (((cos/sin
  )*f)`|Z).x = -1/(1-cos.x);














begin

reserve x,a,b,c for Real,
  n for Nat,
  Z for open Subset of REAL,
  f, f1,f2 for PartFunc of REAL,REAL;

theorem 
  x in dom tan implies cos.x<>0;

theorem 
  x in dom cot implies sin.x<>0;



theorem 
  Z c= dom (f1/f2) implies for x st x in Z holds ((f1/f2).x) #Z n =
  (f1.x) #Z n/(f2.x) #Z n;



theorem 
  Z c= dom (f1/f2) & (for x st x in Z holds f1.x=x+a & f2.x=x-b) implies
(f1/f2) is_differentiable_on Z & for x st x in Z holds ((f1/f2)`|Z).x = (-a-b)/
  (x-b)^2;



theorem 
  not 0 in Z & Z c= dom (ln*((id Z)^)) implies (ln*((id Z)^))
  is_differentiable_on Z & for x st x in Z holds ((ln*((id Z)^))`|Z).x = -1/x;



theorem 
  Z c= dom (tan*f) & (for x st x in Z holds f.x = a*x+b) implies
tan*f is_differentiable_on Z & for x st x in Z holds ((tan*f)`|Z).x = a/(cos.(a
  *x+b))^2;



theorem 
  Z c= dom (cot*f) & (for x st x in Z holds f.x = a*x+b) implies
cot*f is_differentiable_on Z & for x st x in Z holds ((cot*f)`|Z).x = -a/(sin.(
  a*x+b))^2;



theorem 
  not 0 in Z & Z c= dom (tan*((id Z)^)) implies (tan*((id Z)^))
is_differentiable_on Z & for x st x in Z holds ((tan*((id Z)^))`|Z).x = -1/(x^2
  *(cos.(1/x))^2);



theorem 
  not 0 in Z & Z c= dom (cot*((id Z)^)) implies (cot*((id Z)^))
is_differentiable_on Z & for x st x in Z holds ((cot*((id Z)^))`|Z).x = 1/(x^2*
  (sin.(1/x))^2);



theorem 
  Z c= dom (tan*(f1+c(#)f2)) & f2=#Z 2 & (for x st x in Z holds f1.x = a
+b*x) implies tan*(f1+c(#)f2) is_differentiable_on Z & for x st x in Z holds ((
  tan*(f1+c(#)f2))`|Z).x = (b+2*c*x)/(cos.(a+b*x+c*x^2))^2;



theorem 
  Z c= dom (cot*(f1+c(#)f2)) & f2=#Z 2 & (for x st x in Z holds f1.x = a
+b*x) implies cot*(f1+c(#)f2) is_differentiable_on Z & for x st x in Z holds ((
  cot*(f1+c(#)f2))`|Z).x = -(b+2*c*x)/(sin.(a+b*x+c*x^2))^2;



theorem 
  Z c= dom (tan*exp_R) implies tan*exp_R is_differentiable_on Z & for x
  st x in Z holds ((tan*exp_R)`|Z).x = exp_R.x/(cos.(exp_R.x))^2;



theorem 
  Z c= dom (cot*exp_R) implies cot*exp_R is_differentiable_on Z & for x
  st x in Z holds ((cot*exp_R)`|Z).x = -exp_R.x/(sin.(exp_R.x))^2;



theorem 
  Z c= dom (tan*ln) implies tan*ln is_differentiable_on Z & for x st x
  in Z holds ((tan*ln)`|Z).x = 1/(x*(cos.(ln.x))^2);



theorem 
  Z c= dom (cot*ln) implies cot*ln is_differentiable_on Z & for x st x
  in Z holds ((cot*ln)`|Z).x = -1/(x*(sin.(ln.x))^2);



theorem 
  Z c= dom (exp_R*tan) implies exp_R*tan is_differentiable_on Z & for x
  st x in Z holds ((exp_R*tan)`|Z).x = exp_R.(tan.x)/(cos.x)^2;



theorem 
  Z c= dom (exp_R*cot) implies exp_R*cot is_differentiable_on Z & for x
  st x in Z holds ((exp_R*cot)`|Z).x = -exp_R.(cot.x)/(sin.x)^2;



theorem 
  Z c= dom (ln*tan) implies ln*tan is_differentiable_on Z & for x st x
  in Z holds ((ln*tan)`|Z).x = 1/(cos.x*sin.x);



theorem 
  Z c= dom (ln*cot) implies ln*cot is_differentiable_on Z & for x st x
  in Z holds ((ln*cot)`|Z).x = -1/(sin.x*cos.x);



theorem 
  Z c= dom (( #Z n)*tan) & 1<=n implies ( #Z n)*tan is_differentiable_on
Z & for x st x in Z holds ((( #Z n)*tan)`|Z).x =n*(sin.x) #Z (n-1)/(cos.x) #Z (
  n+1);



theorem 
  Z c= dom (( #Z n)*cot) & 1<=n implies ( #Z n)*cot is_differentiable_on
Z & for x st x in Z holds ((( #Z n)*cot)`|Z).x =-n*(cos.x) #Z (n-1)/(sin.x) #Z
  (n+1);



theorem 
  (Z c= dom (tan+cos^) & for x st x in Z holds (1+sin.x)<>0 & (1-sin.x)
<>0) implies tan+cos^ is_differentiable_on Z & for x st x in Z holds ((tan+cos^
  )`|Z).x = 1/(1-sin.x);



theorem 
  (Z c= dom (tan-cos^) & for x st x in Z holds (1-sin.x)<>0 & (1+sin.x)
<>0) implies tan-cos^ is_differentiable_on Z & for x st x in Z holds ((tan-cos^
  )`|Z).x = 1/(1+sin.x);



theorem 
  Z c= dom (tan-id Z) implies tan-id Z is_differentiable_on Z & for x st
  x in Z holds ((tan-id Z)`|Z).x=(sin.x)^2/(cos.x)^2;



theorem 
  Z c= dom (-cot-id Z) implies -cot-id Z is_differentiable_on Z & for x
  st x in Z holds ((-cot-id Z)`|Z).x=(cos.x)^2/(sin.x)^2;



theorem 
  (Z c= dom ((1/a)(#)(tan*f)-id Z) & for x st x in Z holds f.x=a*x & a<>
0) implies (1/a)(#)(tan*f)-id Z is_differentiable_on Z & for x st x in Z holds
  (((1/a)(#)(tan*f)-id Z)`|Z).x=(sin.(a*x))^2/(cos.(a*x))^2;



theorem 
  (Z c= dom ((-1/a)(#)(cot*f)-id Z) & for x st x in Z holds f.x=a*x & a
  <>0) implies (-1/a)(#)(cot*f)-id Z is_differentiable_on Z & for x st x in Z
  holds (((-1/a)(#)(cot*f)-id Z)`|Z).x=(cos.(a*x))^2/(sin.(a*x))^2;



theorem 
  (Z c= dom (f(#)tan) & for x st x in Z holds f.x=a*x+b) implies (f(#)
tan) is_differentiable_on Z & for x st x in Z holds ((f(#)tan)`|Z).x = a*sin.x/
  cos.x+(a*x+b)/(cos.x)^2;



theorem 
  (Z c= dom (f(#)cot) & for x st x in Z holds f.x=a*x+b) implies (f(#)
cot) is_differentiable_on Z & for x st x in Z holds ((f(#)cot)`|Z).x = a*cos.x/
  sin.x-(a*x+b)/(sin.x)^2;



theorem 
  Z c= dom (exp_R(#)tan) implies (exp_R(#)tan) is_differentiable_on Z &
for x st x in Z holds ((exp_R(#)tan)`|Z).x = exp_R.x*sin.x/cos.x+exp_R.x/(cos.x
  )^2;



theorem 
  Z c= dom (exp_R(#)cot) implies (exp_R(#)cot) is_differentiable_on Z &
for x st x in Z holds ((exp_R(#)cot)`|Z).x = exp_R.x*cos.x/sin.x-exp_R.x/(sin.x
  )^2;



theorem 
  Z c= dom (ln(#)tan) implies (ln(#)tan) is_differentiable_on Z & for x
  st x in Z holds ((ln(#)tan)`|Z).x = sin.x/cos.x/x+ln.x/(cos.x)^2;



theorem 
  Z c= dom (ln(#)cot) implies ln(#)cot is_differentiable_on Z & for x st
  x in Z holds ((ln(#)cot)`|Z).x = cos.x/sin.x/x-ln.x/(sin.x)^2;



theorem 
  not 0 in Z & Z c= dom ((id Z)^(#)tan) implies ((id Z)^(#)tan)
is_differentiable_on Z & for x st x in Z holds (((id Z)^(#)tan)`|Z).x = -sin.x/
  cos.x/x^2+1/x/(cos.x)^2;



theorem 
  not 0 in Z & Z c= dom ((id Z)^(#)cot) implies ((id Z)^(#)cot)
is_differentiable_on Z & for x st x in Z holds (((id Z)^(#)cot)`|Z).x = -cos.x/
  sin.x/x^2-1/x/(sin.x)^2;














begin

reserve x,y,t for real number;

theorem 
  x>0 implies 1/x=x to_power (-1);

theorem 
  x>1 implies ((sqrt(x^2-1))/x)^2<1;

theorem 
  (x/sqrt(x^2+1))^2<1;

theorem 
  sqrt(x^2+1)>0;

theorem 
  sqrt(x^2+1)+x>0;

theorem 
  y>=0 & x>=1 implies (x+1)/y>=0;

theorem 
  y>=0 & x>=1 implies (x-1)/y>=0;

theorem 
  x>=1 implies sqrt((x+1)/2)>=1;

theorem 
  y>=0 & x>=1 implies (x^2-1)/y>=0;

theorem 
  x>=1 implies sqrt((x+1)/2)+sqrt((x-1)/2)>0;

theorem 
  x^2<1 implies x+1>0 & 1-x>0;

theorem 
  x<>1 implies (1-x)^2>0;

theorem 
  x^2<1 implies (x^2+1)/(1-x^2)>=0;

theorem 
  x^2<1 implies ((2*x)/(1+x^2))^2<1;

theorem 
  0<x & x<1 implies (1+x)/(1-x)>0;

theorem 
  0<x & x<1 implies x^2<1;

theorem 
  0<x & x<1 implies 1/(sqrt(1-x^2))>1;

theorem 
  0<x & x<1 implies (2*x)/(1-x^2)>0;

theorem 
  0<x & x<1 implies 0<(1-x^2)^2;

theorem 
  0<x & x<1 implies ((1+x^2)/(1-x^2))>1;

theorem 
  1<x^2 implies (1/x)^2<1;

theorem 
  0<x & x<=1 implies 1-x^2>=0;

theorem 
  1<=x implies 0<x+sqrt(x^2-1);

theorem 
  1<=x & 1<=y implies 0<=x*sqrt(y^2-1)+y*sqrt(x^2-1);

theorem 
  1<=y implies 0<y-sqrt(y^2-1);

theorem 
  1<=x & 1<=y & abs(y)<=abs(x) implies 0<=y*sqrt(x^2-1)-x*sqrt(y^2 -1);

theorem 
  x^2<1 & y^2<1 implies x*y<>-1;

theorem 
  x^2<1 & y^2<1 implies x*y<>1;

theorem 
  x<>0 implies exp_R(x)<>1;

theorem 
  0<>x implies (exp_R x)^2-1<>0;

theorem 
  (t^2-1)/(t^2+1)<1;

theorem 
  -1<t & t<1 implies 0<(t+1)/(1-t);

begin 

definition
  let x be real number;
  func sinh"(x) -> real number equals

  log(number_e,(x+sqrt(x^2+1)));
end;

definition
  let x be real number;
  func cosh1"(x) -> real number equals

  log(number_e,x+sqrt(x^2-1));
end;

definition
  let x be real number;
  func cosh2"(x) -> real number equals

  -(log(number_e,x+sqrt(x^2-1)));
end;

definition
  let x be real number;
  func tanh"(x) -> real number equals

  (1/2)*log(number_e,(1+x)/(1-x));
end;

definition
  let x be real number;
  func coth"(x) -> real number equals

  (1/2)*log(number_e,(x+1)/(x-1));
end;

definition
  let x be real number;
  func sech1"(x) -> real number equals

  log(number_e,(1+sqrt(1-x^2))/x);
end;

definition
  let x be real number;
  func sech2"(x) -> real number equals

  -(log(number_e,(1+sqrt(1-x^2))/x));
end;

definition
  let x be real number;
  func csch"(x) -> real number equals


  log(number_e,(1+sqrt(1+x^2))/x)
  if 0<x, log(number_e,(1-sqrt(1+x^2))/x) if x<0;
end;

theorem 
  0<=x implies sinh"(x)=cosh1"(sqrt(x^2+1));

theorem 
  x<0 implies sinh"(x)=cosh2"(sqrt(x^2+1));

theorem 
  sinh"(x)=tanh"(x/sqrt(x^2+1));

theorem 
  x>=1 implies cosh1"(x)=sinh"(sqrt(x^2-1));

theorem 
  x>1 implies cosh1"(x)=tanh"((sqrt(x^2-1))/x);

theorem 
  x>=1 implies cosh1"(x)=2*cosh1"(sqrt((x+1)/2));

theorem 
  x>=1 implies cosh2"(x)=2*cosh2"(sqrt((x+1)/2));

theorem 
  x>=1 implies cosh1"(x)=2*sinh"(sqrt((x-1)/2));

theorem 
  x^2<1 implies tanh"(x)=sinh"(x/sqrt(1-x^2));

theorem 
  0<x & x<1 implies tanh"(x)=cosh1"(1/(sqrt(1-x^2)));

theorem 
  x^2<1 implies tanh"(x)=(1/2)*sinh"((2*x)/(1-x^2));

theorem 
  x>0 & x<1 implies tanh"(x)=(1/2)*cosh1"((1+x^2)/(1-x^2));

theorem 
  x^2<1 implies tanh"(x)=(1/2)*tanh"((2*x)/(1+x^2));

theorem 
  x^2>1 implies coth"(x)=tanh"(1/x);

theorem 
  x>0 & x<=1 implies sech1"(x)=cosh1"(1/x);

theorem 
  x>0 & x<=1 implies sech2"(x)=cosh2"(1/x);

theorem 
  x>0 implies csch"(x)=sinh"(1/x);

theorem 
  (x*y+sqrt(x^2+1)*sqrt(y^2+1))>=0 implies sinh"(x)+sinh"(y)=sinh"(x*
  sqrt(1+y^2)+y*sqrt(1+x^2));

theorem 
  sinh"(x)-sinh"(y)=sinh"(x*sqrt(1+y^2)-y*sqrt(1+x^2));

theorem 
  1<=x & 1<=y implies cosh1"(x)+cosh1"(y)=cosh1"(x*y+sqrt((x^2-1)*(y^2-1 )));

theorem 
  1<=x & 1<=y implies cosh2"(x)+cosh2"(y)=cosh2"(x*y+sqrt((x^2-1)*(y^2-1 )));

theorem 
  1<=x & 1<=y & abs(y)<=abs(x) implies cosh1"(x)-cosh1"(y)=cosh1"(x*y-
  sqrt((x^2-1)*(y^2-1)));

theorem 
  1<=x & 1<=y & abs(y)<=abs(x) implies cosh2"(x)-cosh2"(y)=cosh2"(x*y-
  sqrt((x^2-1)*(y^2-1)));

theorem 
  x^2<1 & y^2<1 implies tanh"(x)+tanh"(y)=tanh"((x+y)/(1+x*y));

theorem 
  x^2<1 & y^2<1 implies tanh"(x)-tanh"(y)=tanh"((x-y)/(1-x*y));

theorem 
  0<x implies log(number_e,x)=2*tanh"((x-1)/(x+1));

theorem 
  0<x implies log(number_e,x)=tanh"((x^2-1)/(x^2+1));

theorem 
  1<x implies log(number_e,x)=cosh1"((x^2+1)/(2*x));

theorem 
  0<x & x<1 & 1<=(x^2+1)/(2*x) implies log(number_e,x)=cosh2"((x^2+1)/(2 *x));

theorem 
  0<x implies log(number_e,x)=sinh"((x^2-1)/(2*x));

theorem 
  y=(1/2)*(exp_R(x)-exp_R(-x)) implies x=log(number_e,(y+sqrt(y^2+1)));

theorem 
  y=(1/2)*(exp_R(x)+exp_R(-x)) & 1<=y implies x=log(number_e,(y+sqrt(y^2
  -1))) or x=-log(number_e,(y+sqrt(y^2-1)));

theorem 
  y=(exp_R(x)-exp_R(-x))/(exp_R(x)+exp_R(-x)) implies x=(1/2)*log(
  number_e,(1+y)/(1-y));

theorem 
  y=(exp_R(x)+exp_R(-x))/(exp_R(x)-exp_R(-x)) & x<>0 implies x=(1/2)*log
  (number_e,(y+1)/(y-1));

theorem 
  y=1/((exp_R(x)+exp_R(-x))/2) implies x=log(number_e,(1+sqrt(1-y^2))/y)
  or x=-log(number_e,(1+sqrt(1-y^2))/y);

theorem 
  y=1/((exp_R(x)-exp_R(-x))/2) & x<>0 implies x=log(number_e,(1+sqrt(1+y
  ^2))/y) or x=log(number_e,(1-sqrt(1+y^2))/y);

theorem 
  cosh.(2*x)=1+2*(sinh.x)^2;

theorem 
  (cosh.x)^2=1+(sinh.x)^2;

theorem 
  (sinh.x)^2=(cosh.x)^2-1;

theorem 
  sinh(5*x)=5*sinh(x)+20*(sinh(x))|^3+16*(sinh(x))|^5;

theorem 
  cosh(5*x)=5*cosh(x)-20*(cosh(x))|^3+16*(cosh(x))|^5;














begin 

reserve x, y, z, w for real number;
reserve n for Element of NAT;

theorem 
  tanh x = sinh(x)/cosh(x) & tanh 0 = 0;

theorem 
  sinh x = 1/cosech x & cosh x = 1/sech x & tanh x = 1/coth x;

theorem 
  sech x <= 1 & 0 < sech x & sech 0 = 1;

theorem 
  x >= 0 implies tanh x >= 0;

theorem 
  cosh x = 1/sqrt (1-(tanh x)^2) & sinh x = tanh(x)/sqrt (1-(tanh x)^2);

theorem 
  (cosh(x)+sinh(x)) |^ n = cosh(n*x)+sinh(n*x) & (cosh(x)-sinh(x)) |^ n
  = cosh(n*x)-sinh(n*x);

theorem 
  exp_R(x) = cosh(x)+sinh(x) & exp_R(-x) = cosh(x)-sinh(x) & exp_R(
x) = (cosh(x/2)+sinh(x/2))/(cosh(x/2)-sinh(x/2)) & exp_R(-x) = (cosh(x/2)-sinh(
x/2))/(cosh(x/2)+sinh(x/2)) & exp_R(x) = (1+tanh(x/2))/(1-tanh(x/2)) & exp_R(-x
  ) = (1-tanh(x/2))/(1+tanh(x/2));

theorem 
  x <> 0 implies exp_R(x) = (coth(x/2)+1)/(coth(x/2)-1) & exp_R(-x) = (
  coth(x/2)-1)/(coth(x/2)+1);

theorem 
  (cosh(x)+sinh x)/(cosh(x)-sinh(x)) = (1+tanh(x))/(1-tanh x);

theorem 
  y <> 0 implies coth(y)+tanh(z) = cosh(y+z)/(sinh(y)*cosh(z)) & coth(y)
  -tanh(z) = cosh(y-z)/(sinh(y)*cosh(z));

theorem 
  sinh(y)*sinh(z) = 1/2*(cosh(y+z)-cosh(y-z)) & sinh(y)*cosh(z) =
1/2*(sinh(y+z)+sinh(y-z)) & cosh(y)*sinh(z) = 1/2*(sinh(y+z)-sinh(y-z)) & cosh(
  y)*cosh(z) = 1/2*(cosh(y+z)+cosh(y-z));

theorem 
  (sinh y)^2-(cosh z)^2 = sinh(y+z)*sinh(y-z)-1;

theorem 
  (sinh(y)-sinh z)^2-(cosh(y)-cosh z)^2 = 4*(sinh((y-z)/2))^2 & (cosh(y)
  +cosh z)^2-(sinh(y)+sinh z)^2 = 4*(cosh((y-z)/2))^2;

theorem 
  (sinh(y)+sinh(z))/(sinh(y)-sinh(z)) = tanh((y+z)/2)*coth((y-z)/2);

theorem 
  (cosh(y)+cosh(z))/(cosh(y)-cosh(z)) = coth((y+z)/2)*coth((y-z)/2);

theorem 
  y-z <> 0 implies (sinh(y)+sinh(z))/(cosh(y)+cosh(z)) = (cosh(y)-cosh(z
  ))/(sinh(y)-sinh(z));

theorem 
  y+z <> 0 implies (sinh(y)-sinh(z))/(cosh(y)+cosh(z)) = (cosh(y)-cosh(z
  ))/(sinh(y)+sinh(z));

theorem 
  (sinh(y)+sinh(z))/(cosh(y)+cosh(z)) = tanh(y/2+z/2) & (sinh(y)-sinh(z)
  )/(cosh(y)+cosh(z)) = tanh(y/2-z/2);

theorem 
  (tanh(y)+tanh(z))/(tanh(y)-tanh(z)) = sinh(y+z)/sinh(y-z);

theorem 
  (sinh(y-z)+sinh(y)+sinh(y+z))/(cosh(y-z)+cosh(y)+cosh(y+z)) = tanh(y);

theorem 
  sinh(y+z+w) = (tanh(y)+tanh(z)+tanh(w)+tanh(y)*tanh(z)*tanh w) *
cosh(y)*cosh(z)*cosh(w) & cosh(y+z+w) = (1+tanh(y)*tanh(z)+tanh(z)*tanh(w)+tanh
(w)*tanh y) * cosh(y)*cosh(z)*cosh(w) & tanh(y+z+w) = (tanh(y)+tanh(z)+tanh(w)+
  tanh(y)*tanh(z)*tanh w) / (1+tanh(z)*tanh(w)+tanh(w)*tanh(y)+tanh(y)*tanh z);

theorem 
  cosh(2*y)+cosh(2*z)+cosh(2*w)+cosh(2*(y+z+w)) = 4*cosh(z+w)*cosh(w+y)*
  cosh(y+z);

theorem 
  sinh(y)*sinh(z)*sinh(z-y) + sinh(z)*sinh(w)*sinh(w-z) + sinh(w)*sinh(y
  )*sinh(y-w) + (sinh(z-y)*sinh(w-z)*sinh(y-w)) = 0;

theorem 
  x >= 0 implies sinh(x/2) = sqrt ((cosh(x)-1)/2);

theorem 
  x < 0 implies sinh(x/2) = - sqrt ((cosh(x)-1)/2);

theorem 
  sinh(2*x) = 2*sinh(x)*cosh(x) & cosh(2*x) = 2*(cosh x)^2-1 &
  tanh(2*x) = (2*tanh x)/(1+(tanh x)^2);

theorem 
  sinh(2*x) = 2*tanh(x)/(1-(tanh x)^2) & sinh(3*x) = sinh(x)*(4*(
cosh x)^2-1) & sinh(3*x) = 3*sinh(x)-2*sinh(x)*(1-cosh(2*x)) & cosh(2*x) = 1+2*
(sinh x)^2 & cosh(2*x) = (cosh x)^2+(sinh x)^2 & cosh(2*x) = (1+(tanh x)^2)/(1-
  (tanh x)^2) & cosh(3*x) = cosh(x)*(4*(sinh x)^2+1) & tanh(3*x) = (3*tanh x+(
  tanh x)|^3)/(1+3*(tanh x)^2);

theorem 
  (sinh(5*x)+2*sinh(3*x)+sinh x)/(sinh(7*x)+2*sinh(5*x)+sinh(3*x)) =
  sinh(3*x)/sinh(5*x);

theorem 
  x >= 0 implies tanh(x/2) = sqrt((cosh(x)-1)/(cosh(x)+1));

theorem 
  x < 0 implies tanh(x/2) = -sqrt((cosh(x)-1)/(cosh(x)+1));

theorem 
  (sinh x)|^3 = (sinh(3*x)-3*sinh x)/4 & (sinh x)|^4 = (cosh(4*x)-4*cosh
(2*x)+3)/8 & (sinh x)|^5 = (sinh(5*x)-5*sinh(3*x)+10*sinh(x))/16 & (sinh x)|^6
= (cosh(6*x)-6*cosh(4*x)+15*cosh(2*x)-10)/32 & (sinh x)|^7 = (sinh(7*x)-7*sinh(
5*x)+21*sinh(3*x)-35*sinh(x))/64 & (sinh x)|^8 = (cosh(8*x)-8*cosh(6*x)+28*cosh
  (4*x)-56*cosh(2*x)+35)/128;

theorem 
  (cosh x)|^3 = (cosh(3*x)+3*cosh x)/4 & (cosh x)|^4 = (cosh(4*x)+4*cosh
(2*x)+3)/8 & (cosh x)|^5 = (cosh(5*x)+5*cosh(3*x)+10*cosh x)/16 & (cosh x)|^6 =
(cosh(6*x)+6*cosh(4*x)+15*cosh(2*x)+10)/32 & (cosh x)|^7 = (cosh(7*x)+7*cosh(5*
x)+21*cosh(3*x)+35*cosh x)/64 & (cosh x)|^8 = (cosh(8*x)+8*cosh(6*x)+28*cosh(4*
  x)+56*cosh(2*x)+35)/128;

theorem 
  cosh(2*y)+cos(2*z) = 2+2*((sinh y)^2-(sin z)^2) & cosh(2*y)-cos(2*z) =
  2*((sinh y)^2+(sin z)^2);














begin 

definition
  let k,l be boolean set;
  redefine pred k <= l means


  k => l = TRUE;
end;

begin 

reserve Y for non empty set;
reserve B for Subset of Y;

scheme 

  BVFUniq1 {Y() -> non empty set, F(set) -> set}:
  for f1,f2 being Function of Y(),BOOLEAN
  st (for x being Element of Y() holds f1.x = F(x)) & (for x
  being Element of Y() holds f2.x = F(x)) holds f1 = f2;

definition
  let Y;
  let a be Function of Y,BOOLEAN;
  redefine func 'not' a -> Function of Y,BOOLEAN;
  let b be Function of Y,BOOLEAN;
  redefine func a '&' b -> Function of Y,BOOLEAN;
end;

definition
  let p,q be boolean-valued Function;
  func p 'or' q -> boolean-valued Function means


  dom it = dom p /\ dom q &
  for x being set st x in dom it holds it.x = (p.x) 'or' (q.x);
  commutativity;
  idempotence;
  func p 'xor' q -> Function means


  dom it = dom p /\ dom q &
  for x being set st x in dom it holds it.x = (p.x) 'xor' (q.x);
  commutativity;
end;

registration
  let p,q be boolean-valued Function;
  cluster p 'xor' q -> boolean-valued;
end;

definition
  let A be non empty set;
  let p,q be Function of A,BOOLEAN;
  redefine func p 'or' q -> Function of A,BOOLEAN means


  for x being Element of A holds it.x = (p.x) 'or' (q.x);
  redefine func p 'xor' q -> Function of A,BOOLEAN means

  for x being Element of A holds it.x = (p.x) 'xor' (q.x);
end;

definition
  let p,q be boolean-valued Function;
  func p 'imp' q -> Function means


  dom it = dom p /\ dom q &
  for x being set st x in dom it holds it.x = (p.x) => (q.x);
  func p 'eqv' q -> Function means


  dom it = dom p /\ dom q &
  for x being set st x in dom it holds it.x = (p.x) <=> (q.x);
  commutativity;
end;

registration
  let p,q be boolean-valued Function;
  cluster p 'imp' q -> boolean-valued;
  cluster p 'eqv' q -> boolean-valued;
end;

definition
  let A be non empty set;
  let p,q be Function of A,BOOLEAN;
  redefine func p 'imp' q -> Function of A,BOOLEAN means


  for x being Element of A holds it.x = 'not' p.x 'or' q.x;
  redefine func p 'eqv' q -> Function of A,BOOLEAN means


  for x being Element of A holds it.x = 'not' (p.x 'xor' q.x);
end;

definition
  let Y;
  func O_el(Y) ->Function of Y,BOOLEAN means


  for x being Element of Y holds it.x= FALSE;
end;

definition
  let Y;
  func I_el(Y) ->Function of Y,BOOLEAN means


  for x being Element of Y holds it.x= TRUE;
end;

canceled;

theorem 
  'not' I_el(Y)=O_el(Y) & 'not' O_el(Y)=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds a '&' a=a;

theorem 
  for a,b,c being Function of Y,BOOLEAN
   holds a '&' b '&' c = a '&' (b '&' c);

theorem 
  for a being Function of Y,BOOLEAN holds a '&' O_el(Y)=O_el( Y);

theorem 
  for a being Function of Y,BOOLEAN holds a '&' I_el(Y)=a;

theorem 
  for a being Function of Y,BOOLEAN holds a 'or' a=a;

theorem 
  for a,b,c being Function of Y,BOOLEAN
   holds a 'or' b 'or' c = a 'or' (b 'or' c);

theorem 
  for a being Function of Y,BOOLEAN holds a 'or' O_el(Y)=a;

theorem 
  for a being Function of Y,BOOLEAN holds a 'or' I_el(Y)= I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN
   holds (a '&' b) 'or' c = (a 'or' c) '&' (b 'or' c);

theorem 
  for a,b,c being Function of Y,BOOLEAN
  holds (a 'or' b) '&' c = (a '&' c) 'or' (b '&' c);

theorem 
  for a,b being Function of Y,BOOLEAN
   holds 'not' (a 'or' b)=('not' a) '&' ('not' b);

theorem 
  for a,b being Function of Y,BOOLEAN
  holds 'not' (a '&' b)=('not' a) 'or' ('not' b);

definition
  let Y;
  let a,b be Function of Y,BOOLEAN;
  pred a '<' b means


  for x being Element of Y st a.x= TRUE holds b.x= TRUE;
  reflexivity;
end;

theorem 
  for a,b,c being Function of Y,BOOLEAN holds ( a '<' b & b '<' a
  implies a=b)& ( a '<' b & b '<' c implies a '<' c);

theorem 
  for a,b being Function of Y,BOOLEAN holds (a 'imp' b)=I_el
  (Y) iff a '<' b;

theorem 
  for a,b being Function of Y,BOOLEAN holds (a 'eqv' b)=I_el(Y) iff a = b;

theorem 
  for a being Function of Y,BOOLEAN holds O_el(Y) '<' a & a '<' I_el(Y);

begin 

definition
  let Y;
  let a be Function of Y,BOOLEAN;
  func B_INF(a) ->Function of Y,BOOLEAN equals


  I_el(Y) if for x being Element of Y holds a.x=TRUE
  otherwise O_el(Y);
  func B_SUP(a) ->Function of Y,BOOLEAN equals


  O_el(Y) if for x being Element of Y holds a.x=FALSE
  otherwise I_el(Y);
end;

theorem 
  for a being Function of Y,BOOLEAN holds 'not' B_INF(a) =
  B_SUP('not' a) & 'not' B_SUP(a)=B_INF('not' a);

theorem 
  B_INF(O_el(Y)) = O_el(Y) & B_INF(I_el(Y))=I_el(Y) & B_SUP(O_el(Y)) =
  O_el(Y) & B_SUP(I_el(Y))=I_el(Y);

registration
  let Y;
  cluster O_el(Y) -> constant;
end;

registration
  let Y;
  cluster I_el(Y) -> constant;
end;

registration
  let Y be non empty set;
  cluster constant for Function of Y,BOOLEAN;
end;

theorem 
  for a being constant Function of Y,BOOLEAN holds a=O_el(Y) or a=I_el(Y);

theorem 
  for d being constant Function of Y,BOOLEAN holds B_INF(d)
  = d & B_SUP(d) = d;

theorem 
  for a,b being Function of Y,BOOLEAN holds B_INF(a '&' b) = B_INF
  (a) '&' B_INF(b) & B_SUP(a 'or' b) = B_SUP(a) 'or' B_SUP(b);

theorem 
  for a being Function of Y,BOOLEAN, d being constant Function of Y,BOOLEAN
 holds B_INF(d 'imp' a) = d 'imp' B_INF(a) & B_INF(a 'imp' d) =
  B_SUP(a) 'imp' d;

theorem 
  for a being Function of Y,BOOLEAN, d being constant Function of Y,BOOLEAN
  holds B_INF(d 'or' a) = d 'or' B_INF(a) & B_SUP(d '&' a) = d
  '&' B_SUP(a) & B_SUP(a '&' d) = B_SUP(a) '&' d;

theorem 
  for a being Function of Y,BOOLEAN,x being Element of Y holds (
  B_INF a).x <= a.x;

theorem 
  for a being Function of Y,BOOLEAN,x being Element of Y holds a.x
  <= (B_SUP a).x;

begin 

definition
  let Y;
  let a be Function of Y,BOOLEAN,PA be a_partition of Y;
  pred a is_dependent_of PA means


  for F being set st F in PA for x1,x2
  being set st x1 in F & x2 in F holds a.x1=a.x2;
end;

theorem 
  for a being Function of Y,BOOLEAN holds a is_dependent_of %I(Y);

theorem 
  for a being constant Function of Y,BOOLEAN holds a
  is_dependent_of %O(Y);

definition
  let Y;
  let PA be a_partition of Y;
  redefine mode Element of PA -> Subset of Y;
end;

definition
  let Y;
  let x be Element of Y;
  let PA be a_partition of Y;
  redefine func EqClass(x,PA) -> Element of PA;
end;

definition
  let Y;
  let a be Function of Y,BOOLEAN,PA be a_partition of Y;
  func B_INF(a,PA) -> Function of Y,BOOLEAN means


  for y being
Element of Y holds ( (for x being Element of Y st x in EqClass(y,PA) holds a.x=
TRUE) implies it.y = TRUE ) & (not (for x being Element of Y st x in EqClass(y,
  PA) holds a.x=TRUE) implies it.y = FALSE);
end;

definition
  let Y;
  let a be Function of Y,BOOLEAN,PA be a_partition of Y;
  func B_SUP(a,PA) -> Function of Y,BOOLEAN means


  for y being
Element of Y holds ( (ex x being Element of Y st x in EqClass(y,PA) & a.x=TRUE)
implies it.y = TRUE ) & (not (ex x being Element of Y st x in EqClass(y,PA) & a
  .x=TRUE) implies it.y = FALSE);
end;

theorem 
  for a being Function of Y,BOOLEAN,PA being a_partition of Y
  holds B_INF(a,PA) is_dependent_of PA;

theorem 
  for a being Function of Y,BOOLEAN,PA being a_partition of Y
  holds B_SUP(a,PA) is_dependent_of PA;

theorem 
  for a being Function of Y,BOOLEAN,PA being a_partition of Y
  holds B_INF(a,PA) '<' a;

theorem 
  for a being Function of Y,BOOLEAN,PA being a_partition of Y
  holds a '<' B_SUP(a,PA);

theorem 
  for a being Function of Y,BOOLEAN,PA being a_partition of Y
  holds 'not' B_INF(a,PA) = B_SUP('not' a,PA);

theorem 
  for a being Function of Y,BOOLEAN holds B_INF(a,%O(Y))=B_INF(a);

theorem 
  for a being Function of Y,BOOLEAN holds B_SUP(a,%O(Y))=B_SUP(a);

theorem 
  for a being Function of Y,BOOLEAN holds B_INF(a,%I(Y))=a;

theorem 
  for a being Function of Y,BOOLEAN holds B_SUP(a,%I(Y))=a;

theorem 
  for a,b being Function of Y,BOOLEAN,PA being a_partition of Y
  holds B_INF(a '&' b,PA)=B_INF(a,PA) '&' B_INF(b,PA);

theorem 
  for a,b being Function of Y,BOOLEAN,PA being a_partition of Y
  holds B_SUP(a 'or' b,PA)=B_SUP(a,PA) 'or' B_SUP(b,PA);

definition
  let Y;
  let f be Function of Y,BOOLEAN;
  func GPart(f) -> a_partition of Y equals

  {{x where x is Element of Y:f.x =
  TRUE }, {x9 where x9 is Element of Y:f.x9 = FALSE}} \ {{}};
end;

theorem 
  for a being Function of Y,BOOLEAN holds a is_dependent_of GPart( a);

theorem 
  for a being Function of Y,BOOLEAN,PA being a_partition of Y st a
  is_dependent_of PA holds PA is_finer_than GPart(a);

begin 

definition
  let x, y be Element of BOOLEAN;
  redefine func x 'nand' y -> Element of BOOLEAN;
end;

definition
  let x, y be Element of BOOLEAN;
  redefine func x 'nor' y -> Element of BOOLEAN;
end;

definition
  let x, y be boolean set;
  redefine func x <=> y equals

  'not' (x 'xor' y);
end;

definition
  let x, y be Element of BOOLEAN;
  redefine func x <=> y -> Element of BOOLEAN;
end;

reserve x,y,z for boolean set;

theorem 
  TRUE 'nand' x = 'not' x;

theorem 
  FALSE 'nand' x = TRUE;

theorem 
  x 'nand' x = 'not' x & 'not' (x 'nand' x) = x;

theorem 
  'not' (x 'nand' y) = x '&' y;

theorem 
  x 'nand' 'not' x = TRUE & 'not' (x 'nand' 'not' x) = FALSE;

theorem 
  x 'nand' (y '&' z) = 'not' (x '&' y '&' z);

theorem 
  x 'nand' (y '&' z) = (x '&' y) 'nand' z;

theorem 
  TRUE 'nor' x = FALSE;

theorem 
  FALSE 'nor' x = 'not' x;

theorem 
  x 'nor' x = 'not' x & 'not' (x 'nor' x) = x;

theorem 
  'not' (x 'nor' y) = x 'or' y;

theorem 
  x 'nor' 'not' x = FALSE & 'not' (x 'nor' 'not' x) = TRUE;

theorem 
  x 'nor' (y 'or' z) = 'not' (x 'or' y 'or' z);

theorem 
  TRUE <=> x = x;

theorem 
  FALSE <=> x = 'not' x;

theorem 
  x <=> x = TRUE & 'not' (x <=> x) = FALSE;

theorem 
  'not' (x <=> y) = x 'xor' y;

theorem 
  x <=> 'not' x = FALSE & 'not' (x <=> 'not' x) = TRUE;

theorem 
  x <= (y => z) iff x '&' y <= z;

theorem 
  x <=> y = (x => y) '&' (y => x);

theorem 
  x => y = 'not' y => 'not' x;

theorem 
  x <=> y = 'not' x <=> 'not' y;

theorem 
  x=TRUE & (x => y)=TRUE implies y=TRUE;

theorem 
  y=TRUE implies (x => y)=TRUE;

theorem 
  ('not' x)=TRUE implies (x => y)=TRUE;

theorem 
  z => (y => x)=TRUE implies y => (z => x)=TRUE;

theorem 
  z => (y => x)=TRUE & y=TRUE implies z => x=TRUE;

theorem 
  z => (y => x)=TRUE & y=TRUE & z = TRUE implies x=TRUE;















begin 

reserve Y for non empty set,
  G for Subset of PARTITIONS(Y);

definition
  let X be set;
  redefine func PARTITIONS X -> Part-Family of X;
end;

definition
  let X be set;
  let F be non empty Part-Family of X;
  redefine mode Element of F -> a_partition of X;
end;

theorem 
  for y being Element of Y ex X being Subset of Y st y in X & ex h
  being Function, F being Subset-Family of Y st dom h=G & rng h = F & (for d
  being set st d in G holds h.d in d) & X=Intersect F & X<>{};

definition
  let Y;
  let G be Subset of PARTITIONS(Y);
  func '/\' G -> a_partition of Y means


  for x being set holds x in it
iff ex h being Function, F being Subset-Family of Y st dom h=G & rng h = F & (
  for d being set st d in G holds h.d in d) & x=Intersect F & x<>{};
end;

definition
  let Y;
  let G be Subset of PARTITIONS(Y),b be set;
  pred b is_upper_min_depend_of G means


  (for d being a_partition of Y
st d in G holds b is_a_dependent_set_of d) & for e being set st e c= b & (for d
  being a_partition of Y st d in G holds e is_a_dependent_set_of d) holds e=b;
end;

theorem 
  for y being Element of Y st G<>{} holds ex X being Subset of Y st
  y in X & X is_upper_min_depend_of G;

definition
  let Y;
  let G be Subset of PARTITIONS(Y);
  func '\/' G -> a_partition of Y means


  for x being set holds x in it
  iff x is_upper_min_depend_of G if G<>{} otherwise it = %I(Y);
end;

theorem 
  for G being Subset of PARTITIONS(Y),PA being a_partition of Y st PA in
  G holds PA '>' ('/\' G);

theorem 
  for G being Subset of PARTITIONS(Y),PA being a_partition of Y st PA in
  G holds PA '<' ('\/' G);

begin 

definition
  let Y;
  let G be Subset of PARTITIONS(Y);
  attr G is generating means

  ('/\' G) = %I(Y);
end;

definition
  let Y;
  let G be Subset of PARTITIONS(Y);
  attr G is independent means

  for h being Function, F being Subset-Family of Y
  st dom h=G & rng h=F & (for d being set st d in G holds h.d in d) holds (
  Intersect F)<>{};
end;

definition
  let Y;
  let G be Subset of PARTITIONS(Y);
  pred G is_a_coordinate means

  G is independent generating;
end;

definition
  let Y;
  let PA be a_partition of Y;
  redefine func {PA} -> Subset of PARTITIONS(Y);
end;

definition
  let Y;
  let PA be a_partition of Y;
  let G be Subset of PARTITIONS(Y);
  func CompF(PA,G) -> a_partition of Y equals

  '/\' (G \ {PA});
end;

definition
  let Y;
  let a be Function of Y,BOOLEAN;
  let G be Subset of PARTITIONS(Y),PA be a_partition of Y;
  pred a is_independent_of PA,G means


  a is_dependent_of CompF(PA,G);
end;

definition
  let Y;
  let a be Function of Y,BOOLEAN, G be Subset of PARTITIONS(Y), PA be
  a_partition of Y;
  func All(a,PA,G) -> Function of Y,BOOLEAN equals

  B_INF(a,CompF(PA,G));
end;

definition
  let Y;
  let a be Function of Y,BOOLEAN, G be Subset of PARTITIONS(Y), PA be
  a_partition of Y;
  func Ex(a,PA,G) -> Function of Y,BOOLEAN equals

  B_SUP(a,CompF(PA,G));
end;

theorem 
  for a being Function of Y,BOOLEAN, PA being a_partition of Y
  holds All(a,PA,G) is_dependent_of CompF(PA,G);

theorem 
  for a being Function of Y,BOOLEAN, PA being a_partition of Y
  holds Ex(a,PA,G) is_dependent_of CompF(PA,G);

theorem 
  for a being Function of Y,BOOLEAN, PA being a_partition of Y
  holds All(I_el(Y),PA,G) = I_el(Y);

theorem 
  for a being Function of Y,BOOLEAN, PA being a_partition of Y
  holds Ex(I_el(Y),PA,G) = I_el(Y);

theorem 
  for a being Function of Y,BOOLEAN, PA being a_partition of Y
  holds All(O_el(Y),PA,G) = O_el(Y);

theorem 
  for a being Function of Y,BOOLEAN, PA being a_partition of Y
  holds Ex(O_el(Y),PA,G) = O_el(Y);

theorem 
  for a being Function of Y,BOOLEAN, PA being a_partition of Y
  holds All(a,PA,G) '<' a;

theorem 
  for a being Function of Y,BOOLEAN, PA being a_partition of Y
  holds a '<' Ex(a,PA,G);

theorem 
  for a,b being Function of Y,BOOLEAN, PA being a_partition of Y
  holds All(a,PA,G) 'or' All(b,PA,G) '<' All(a 'or' b,PA,G);

theorem 
  for a,b being Function of Y,BOOLEAN, PA being a_partition of Y
  holds All(a 'imp' b,PA,G) '<' All(a,PA,G) 'imp' All(b,PA,G);

theorem 
  for a,b being Function of Y,BOOLEAN,G being Subset of PARTITIONS
(Y) , PA being a_partition of Y holds Ex(a '&' b,PA,G) '<' Ex(a,PA,G) '&' Ex(b,
  PA,G);

theorem 
  for a,b being Function of Y,BOOLEAN, PA being a_partition of Y
  holds Ex(a,PA,G) 'xor' Ex(b,PA,G) '<' Ex(a 'xor' b,PA,G);

theorem 
  for a,b being Function of Y,BOOLEAN, PA being a_partition of Y
  holds Ex(a,PA,G) 'imp' Ex(b,PA,G) '<' Ex(a 'imp' b,PA,G);

reserve a, u for Function of Y,BOOLEAN;

theorem 
  for PA being a_partition of Y holds 'not' All(a,PA,G) = Ex('not' a,PA, G);

theorem 
  for PA being a_partition of Y holds 'not' Ex(a,PA,G) = All('not' a,PA, G);

theorem 
  for PA being a_partition of Y st u is_independent_of PA,G holds All(u
  'imp' a,PA,G) = u 'imp' All(a,PA,G);

theorem 
  for PA being a_partition of Y st u is_independent_of PA,G holds All(a
  'imp' u,PA,G) = Ex(a,PA,G) 'imp' u;

theorem 
  for PA being a_partition of Y st u is_independent_of PA,G holds
  All(u 'or' a,PA,G) = u 'or' All(a,PA,G);

theorem 
  for PA being a_partition of Y st u is_independent_of PA,G holds All(a
  'or' u,PA,G) = All(a,PA,G) 'or' u;

theorem 
  for PA being a_partition of Y st u is_independent_of PA,G holds All(a
  'or' u,PA,G) '<' Ex(a,PA,G) 'or' u;

theorem 
  for PA being a_partition of Y st u is_independent_of PA,G holds
  All(u '&' a,PA,G) = u '&' All(a,PA,G);

theorem 
  for PA being a_partition of Y st u is_independent_of PA,G holds All(a
  '&' u,PA,G) = All(a,PA,G) '&' u;

theorem 
  for PA being a_partition of Y holds All(a '&' u,PA,G) '<' Ex(a,PA,G) '&' u;

theorem 
  for PA being a_partition of Y st u is_independent_of PA,G holds
  All(u 'xor' a,PA,G) '<' u 'xor' All(a,PA,G);

theorem 
  for PA being a_partition of Y st u is_independent_of PA,G holds All(a
  'xor' u,PA,G) '<' All(a,PA,G) 'xor' u;

theorem 
  for PA being a_partition of Y st u is_independent_of PA,G holds
  All(u 'eqv' a,PA,G) '<' u 'eqv' All(a,PA,G);

theorem 
  for PA being a_partition of Y st u is_independent_of PA,G holds All(a
  'eqv' u,PA,G) '<' All(a,PA,G) 'eqv' u;

theorem 
  for PA being a_partition of Y st u is_independent_of PA,G holds
  Ex(u 'or' a,PA,G) = u 'or' Ex(a,PA,G);

theorem 
  for PA being a_partition of Y st u is_independent_of PA,G holds Ex(a
  'or' u,PA,G) = Ex(a,PA,G) 'or' u;

theorem 
  for PA being a_partition of Y st u is_independent_of PA,G holds
  Ex(u '&' a,PA,G) = u '&' Ex(a,PA,G);

theorem 
  for PA being a_partition of Y st u is_independent_of PA,G holds Ex(a
  '&' u,PA,G) = Ex(a,PA,G) '&' u;

theorem 
  for PA being a_partition of Y holds u 'imp' Ex(a,PA,G) '<' Ex(u 'imp' a,PA,G)
;

theorem 
  for PA being a_partition of Y holds Ex(a,PA,G) 'imp' u '<' Ex(a 'imp' u,PA,G)
;

theorem 
  for PA being a_partition of Y st u is_independent_of PA,G holds
  u 'xor' Ex(a,PA,G) '<' Ex(u 'xor' a,PA,G);

theorem 
  for PA being a_partition of Y st u is_independent_of PA,G holds Ex(a,
  PA,G) 'xor' u '<' Ex(a 'xor' u,PA,G);














begin

reserve Z for open Subset of REAL;

theorem 
  for x be Real, n be Element of NAT holds abs(x |^ n) = abs(x) |^ n;

definition
  let f be PartFunc of REAL,REAL, Z be Subset of REAL, a be real number;
  func Maclaurin(f,Z,a) -> Real_Sequence equals

  Taylor(f,Z,0,a);
end;

theorem 
  for n be Element of NAT, f be PartFunc of REAL,REAL, r be Real st
  0 < r & ].-r,r.[ c= dom f & f is_differentiable_on n+1,].-r,r.[ for x be Real
  st x in ].-r, r.[ holds ex s be Real st 0 < s & s < 1 & f.x = Partial_Sums(
Maclaurin(f,].-r,r.[,x)).n + (diff(f,].-r,r.[).(n+1)).(s*x) * x |^ (n+1) / ((n+
  1)!);

theorem 
  for n be Element of NAT, f be PartFunc of REAL,REAL, x0, r be Real st
0 < r & ].x0-r,x0+r.[ c= dom f & f is_differentiable_on n+1, ].x0-r,x0+r.[ for
x be Real st x in ].x0-r, x0+r.[ holds ex s be Real st 0 < s & s < 1 & abs(f.x-
Partial_Sums(Taylor(f, ].x0-r,x0+r.[,x0,x)).n) = abs( (diff(f,].x0-r,x0+r.[).(n
  +1)).(x0+s*(x-x0)) * (x-x0) |^ (n+1) / ((n+1)!) );

theorem 
  for n be Element of NAT, f be PartFunc of REAL,REAL, r be Real st
0 < r & ].-r,r.[ c= dom f & f is_differentiable_on n+1, ].-r,r.[ for x be Real
  st x in ].-r, r.[ holds ex s be Real st 0 < s & s < 1 & abs(f.x-Partial_Sums(
Maclaurin(f,].-r,r.[,x)).n) = abs( (diff(f,].-r,r.[).(n+1)).(s*x) * x |^ (n+1)
  / ((n+1)!) );

theorem 
  exp_R `| Z = exp_R | Z & dom(exp_R | Z) = Z;

theorem 
  for n be Element of NAT holds diff(exp_R,Z).n=exp_R | Z;

theorem 
  for n be Element of NAT, x be Real st x in Z holds (diff(exp_R,Z)
  .n).x = exp_R.x;

theorem 
  for n be Element of NAT, r,x be Real st 0 < r holds Maclaurin(exp_R,
  ].-r,r.[,x).n = x |^ n / (n!);

theorem 
  for n be Element of NAT, r,x,s be Real st x in ].-r,r.[ & 0 < s & s <
1 holds abs((diff(exp_R,].-r,r.[).(n+1)).(s*x) * x |^ (n+1) / ((n+1)!) ) <= abs
  (exp_R.(s*x)) * abs(x) |^ (n+1) / ((n+1)!);

theorem 
  for n be Element of NAT holds exp_R is_differentiable_on n, Z;

theorem 
  for r be Real st 0 < r ex M,L be Real st 0 <= M & 0 <= L & for n
be Element of NAT holds for x,s be Real st x in ].-r,r.[ & 0 < s & s < 1 holds
  abs((diff(exp_R,].-r,r.[).n).(s*x) * x |^ n /(n!)) <= M * L |^ n / (n!);

theorem 
  for M,L be Real st M >= 0 & L >= 0 for e be Real st e > 0 holds
ex n be Element of NAT st for m be Element of NAT st n <= m holds (M*L |^ m / (
  m!)) < e;

theorem 
  for r, e be Real st 0 < r & 0 < e holds ex n be Element of NAT
st for m be Element of NAT st n <= m holds for x,s be Real st x in ].-r,r.[ & 0
  < s & s < 1 holds abs((diff(exp_R,].-r,r.[).m).(s*x) * x |^ m / (m!))< e;

theorem 
  for r, e be Real st 0 < r & 0 < e holds ex n be Element of NAT st for
  m be Element of NAT st n <= m holds for x being real number st x in ].-r,r.[
  holds abs(exp_R.x-Partial_Sums(Maclaurin(exp_R,].-r,r.[,x)).m) < e;

theorem 
  for x be Real holds x rExpSeq is absolutely_summable;

theorem 
  for r, x be Real st 0 < r holds Maclaurin(exp_R,].-r,r.[,x) = (x
  rExpSeq) & Maclaurin(exp_R,].-r,r.[,x) is absolutely_summable & exp_R.x=Sum(
  Maclaurin(exp_R,].-r,r.[,x));

theorem 
  sin `| Z = cos | Z & cos `| Z = (-sin) | Z & dom(sin | Z) = Z &
  dom(cos | Z) = Z;

theorem 
  for f be PartFunc of REAL,REAL, Z be Subset of REAL st f
  is_differentiable_on Z holds (-f) `| Z = -f `| Z;

theorem 
  for n be Element of NAT holds diff(sin,Z).(2*n) = (-1) |^ n (#)
sin | Z & diff(sin,Z).(2*n+1) = (-1) |^ n (#) cos | Z & diff(cos,Z).(2*n) = (-1
  ) |^ n (#)cos | Z & diff(cos,Z).(2*n+1) = (-1) |^ (n+1) (#)sin | Z;

theorem 
  for n be Element of NAT, r,x be Real st r > 0 holds Maclaurin(
sin, ].-r,r.[,x).(2*n) = 0 & Maclaurin(sin, ].-r,r.[,x).(2*n+1) = (-1) |^ n * x
|^ (2*n+1) / ((2*n+1)!) & Maclaurin(cos, ].-r,r.[,x).(2*n) = (-1) |^ n * x |^ (
  2*n) / ((2*n)!) & Maclaurin(cos, ].-r,r.[,x).(2*n+1) = 0;

theorem 
  for n be Element of NAT holds sin is_differentiable_on n, Z &
  cos is_differentiable_on n, Z;

theorem 
  for r be Real st r > 0 ex r1,r2 be Real st r1 >= 0 & r2 >= 0 &
for n be Element of NAT holds for x,s be Real st x in ].-r,r.[ & 0 < s & s < 1
holds abs((diff(sin,].-r,r.[).n).(s*x) * x |^ n / (n!)) <= r1 * r2 |^ n / (n!)
  & abs((diff(cos,].-r,r.[).n).(s*x) * x |^ n / (n!)) <= r1 * r2 |^ n / (n!);

theorem 
  for r, e be Real st 0 < r & 0 < e holds ex n be Element of NAT
st for m be Element of NAT st n <= m holds for x,s be Real st x in ].-r,r.[ & 0
< s & s < 1 holds abs((diff(sin,].-r,r.[).m).(s*x) * x |^ m / (m!)) < e & abs((
  diff(cos,].-r,r.[).m).(s*x) * x |^ m / (m!)) < e;

theorem 
  for r, e be Real st 0 < r & 0 < e holds ex n be Element of NAT st for
  m be Element of NAT st n <= m holds for x being real number st x in ].-r,r.[
  holds abs(sin.x-Partial_Sums(Maclaurin(sin,].-r,r.[,x)).m) < e & abs(cos.x-
  Partial_Sums(Maclaurin(cos,].-r,r.[,x)).m) < e;

theorem 
  for r, x be Real, m be Element of NAT st 0 < r holds
  Partial_Sums(Maclaurin(sin,].-r,r.[,x)).(2*m+1) = Partial_Sums(x P_sin).m &
  Partial_Sums(Maclaurin(cos,].-r,r.[,x)).(2*m+1) = Partial_Sums(x P_cos).m;

theorem 
  for r, x be Real, m being Element of NAT st 0 < r & m > 0 holds
  Partial_Sums(Maclaurin(sin,].-r,r.[,x)).(2*m) = Partial_Sums(x P_sin).(m-1) &
  Partial_Sums(Maclaurin(cos,].-r,r.[,x)).(2*m) = Partial_Sums(x P_cos).m;

theorem 
  for r, x be Real, m be Element of NAT st 0 < r holds
  Partial_Sums(Maclaurin(cos,].-r,r.[,x)).(2*m) = Partial_Sums(x P_cos).m;

theorem 
  for r, x be Real st r > 0 holds Partial_Sums(Maclaurin(sin,].-r,r.[,x)
  ) is convergent & sin.x = Sum(Maclaurin(sin,].-r,r.[,x)) & Partial_Sums(
Maclaurin(cos,].-r,r.[,x)) is convergent & cos.x = Sum(Maclaurin(cos,].-r,r.[,x
  ));














begin 

theorem 
  for n being Nat st n > 1 holds n -' 1 <= 2 * n -' 3;

theorem 
  for n being Nat st n >= 1 holds n -' 1 <= 2 * n -' 2;

theorem 
  for n being Nat st n > 1 holds n < 2 * n -' 1;

theorem 
  for n being Nat st n > 1 holds n -' 2 + 1 = n -' 1;

theorem 
  for n being Nat st n > 1 holds (4 * n * n - 2*n) / (n + 1) > 1;

theorem 
  for n being Nat st n > 1 holds (2 * n -' 2)! * n * (n
  + 1) < (2 * n)!;

theorem 
  for n being Nat holds 2 * (2 - (3 / (n + 1))) < 4;

begin 

definition
  let n be Nat;
  func Catalan (n) -> Real equals

  ((2*n -' 2) choose (n -' 1)) / n;
end;

theorem 
  for n being Nat st n > 1 holds Catalan (n) = (2 * n -'
  2)! / ((n -' 1)! * (n!));

theorem 
  for n being Nat st n > 1 holds Catalan n = 4 * ((2*n
  -' 3) choose (n -' 1)) - ((2*n -' 1) choose (n -' 1));

theorem 
  Catalan 0 = 0;

theorem 
  Catalan 1 = 1;

theorem 
  Catalan 2 = 1;

theorem 
  for n being Nat holds Catalan (n) is Integer;

theorem 
  for k being Nat holds Catalan (k + 1) = (2*k)! / (k! * ((k+1)!));

theorem 
  for n being Nat st n > 1 holds Catalan (n) < Catalan (n + 1);

theorem 
  for n being Nat holds Catalan (n) <= Catalan (n + 1);

theorem 
  for n being Nat holds Catalan (n) >= 0;

theorem 
  for n being Nat holds Catalan (n) is Element of NAT;

theorem 
  for n being Nat st n > 0 holds Catalan (n+1) = 2 * (2
  - (3 / (n + 1))) * Catalan (n);

registration
  let n be Nat;
  cluster Catalan n -> natural;
end;

theorem 
  for n being Nat st n > 0 holds Catalan n > 0;

registration
  let n be non empty Nat;
  cluster Catalan n -> non empty;
end;

theorem 
  for n being Nat st n > 0 holds Catalan (n+1) < 4 * Catalan (n);














begin 

reserve a,b,c,k,k9,m,n,n9,p,p9 for Element of NAT;
reserve i,i9 for Integer;

definition
  let m,n be Nat;
  redefine pred m,n are_relative_prime means


  for k be Nat st k divides m & k divides n holds k = 1;
end;

definition
  let m,n be Nat;
  redefine pred m,n are_relative_prime means


  for p being prime Nat holds not (p divides m & p divides n);
end;

begin 

definition
  let n be number;
  attr n is square means


  ex m being Nat st n = m^2;
end;

registration
  cluster square -> natural for number;
end;

registration
  let n be Nat;
  cluster n^2 -> square;
end;

registration
  cluster even square for Element of NAT;
end;

registration
  cluster odd square for Element of NAT;
end;

registration
  cluster even square for Integer;
end;

registration
  cluster odd square for Integer;
end;

registration
  let m,n be square number;
  cluster m*n -> square;
end;

theorem 
  m*n is square & m,n are_relative_prime implies m is square & n is square;

registration
  let i be Integer;
  cluster i^2 -> integer;
end;

registration
  let i be even Integer;
  cluster i^2 -> even;
end;

registration
  let i be odd Integer;
  cluster i^2 -> odd;
end;

theorem 
  i is even iff i^2 is even;

theorem 
  i is even implies i^2 mod 4 = 0;

theorem 
  i is odd implies i^2 mod 4 = 1;

registration
  let m,n be odd square Integer;
  cluster m + n -> non square;
end;

theorem 
  m^2 = n^2 implies m = n;

theorem 
  m divides n iff m^2 divides n^2;

begin 

theorem 
  m divides n or k = 0 iff k*m divides k*n;

theorem 
  (k*m) gcd (k*n) = k*(m gcd n);

begin 

theorem 
  for X being set st for m ex n st n >= m & n in X holds X is infinite;

begin 

theorem 
  a,b are_relative_prime implies a is odd or b is odd;

theorem 
  a^2 + b^2 = c^2 & a,b are_relative_prime & a is odd implies ex m
  ,n st m <= n & a = n^2 - m^2 & b = 2*m*n & c = n^2 + m^2;

theorem 
  a = n^2 - m^2 & b = 2*m*n & c = n^2 + m^2 implies a^2 + b^2 = c^2;

definition
  mode Pythagorean_triple -> Subset of NAT means


    ex a,b,c st a^2 + b^2 = c^2 & it = { a,b,c };
end;

reserve X for Pythagorean_triple;

registration
  cluster -> finite for Pythagorean_triple;
end;

definition

  redefine mode Pythagorean_triple means


    ex k,m,n st m <= n & it = { k* (n^2 - m^2), k*(2*m*n), k*(n^2 + m^2) };
end;

definition
  let X;
  attr X is degenerate means


  0 in X;
end;

theorem 
  n > 2 implies ex X st X is non degenerate & n in X;

definition
  let X;
  attr X is simplified means


  for k st for n st n in X holds k divides n holds k = 1;
end;

definition
  let X;
  redefine attr X is simplified means


  ex m,n st m in X & n in X & m,n are_relative_prime;
end;

theorem 
  n > 0 implies ex X st X is non degenerate & X is simplified & 4* n in X;

registration
  cluster non degenerate simplified for Pythagorean_triple;
end;

theorem 
  { 3,4,5 } is non degenerate simplified Pythagorean_triple;

theorem 
  { X: X is non degenerate & X is simplified } is infinite;














begin

reserve n for Element of NAT,
  a,b for real number,
  s for Real_Sequence;

theorem 
  abs ((-1)|^n) = 1;

theorem 
  for n being real number holds (n+1)|^3=n|^3+3*n|^2+3*n+1 & (n+1)|^4=n
|^4+4*n|^3+6*n|^2+4*n+1 & (n+1)|^5=n|^5+5*n|^4+10*n|^3+10*n|^2+5*n+1
;

theorem 
  (for n holds s.n = n) implies for n holds Partial_Sums(s).n = n*(n+1)/ 2;

theorem 
  (for n holds s.n = 2*n) implies for n holds Partial_Sums(s).n = n*(n+1 );

theorem 
  (for n holds s.n = 2*n+1) implies for n holds Partial_Sums(s).n = (n+1 )|^2;

theorem 
  (for n holds s.n = n*(n+1)) implies for n holds Partial_Sums(s).n = n*
  (n+1)*(n+2)/3;

theorem 
  (for n holds s.n = n*(n+1)*(n+2)) implies for n holds Partial_Sums(s).
  n = n*(n+1)*(n+2)*(n+3)/4;

theorem 
  (for n holds s.n = n*(n+1)*(n+2)*(n+3)) implies for n holds
  Partial_Sums(s).n = n*(n+1)*(n+2)*(n+3)*(n+4)/5;

theorem 
  (for n holds s.n = 1/(n*(n+1))) implies for n holds Partial_Sums(s).n
  = 1-1/(n+1);

theorem 
  (for n holds s.n = 1/(n*(n+1)*(n+2))) implies for n holds Partial_Sums
  (s).n = 1/4-1/(2*(n+1)*(n+2));

theorem 
  (for n holds s.n = 1/(n*(n+1)*(n+2)*(n+3))) implies for n holds
  Partial_Sums(s).n = 1/18-1/(3*(n+1)*(n+2)*(n+3));

theorem 
  (for n holds s.n = n |^ 2) implies for n holds Partial_Sums(s).n = n*(
  n+1)*(2*n+1)/6;

theorem 
  (for n holds s.n = (-1)|^(n+1)*n|^2) implies for n holds Partial_Sums(
  s).n = (-1)|^(n+1)*n*(n+1)/2;

theorem 
  (for n st n>=1 holds s.n = (2*n-1)|^2 & s.0 = 0) implies for n st n>=1
  holds Partial_Sums(s).n = n*(4*n|^2-1)/3;

theorem 
  (for n holds s.n = n |^ 3) implies for n holds Partial_Sums(s).n = n|^
  2*(n+1)|^2/4;

theorem 
  (for n st n>=1 holds s.n = (2*n-1) |^ 3 & s.0 = 0) implies for n st n
  >=1 holds Partial_Sums(s).n = n|^2*(2*n|^2-1);

theorem 
  (for n holds s.n = n |^ 4) implies for n holds Partial_Sums(s).n = n*(
  n+1)*(2*n+1)*(3*n|^2+3*n-1)/30;

theorem 
  (for n holds s.n = (-1)|^(n+1)*n|^4) implies for n holds Partial_Sums(
  s).n = (-1)|^(n+1)*n*(n+1)*(n|^2+n-1)/2;

theorem 
  (for n holds s.n = n|^5) implies for n holds Partial_Sums(s).n = n|^2*
  (n+1)|^2*(2*n|^2+2*n-1)/12;

theorem 
  (for n holds s.n = n|^6) implies for n holds Partial_Sums(s).n = n*(n+
  1)*(2*n+1)*(3*n|^4+6*n|^3-3*n+1)/42;

theorem 
  (for n holds s.n = n|^7) implies for n holds Partial_Sums(s).n = n|^2*
  (n+1)|^2*(3*n|^4+6*n|^3-n|^2-4*n+2)/24;

theorem 
  (for n holds s.n = n*(n+1)|^2) implies for n holds Partial_Sums(s).n =
  n*(n+1)*(n+2)*(3*n+5)/12;

theorem 
  (for n holds s.n = n*(n+1)|^2*(n+2)) implies for n holds Partial_Sums(
  s).n = n*(n+1)*(n+2)*(n+3)*(2*n+3)/10;

theorem 
  (for n holds s.n = n*(n+1)*2|^n) implies for n holds Partial_Sums(s).n
  = 2|^(n+1)*(n|^2-n+2)-4;

theorem 
  (for n st n>=1 holds s.n = 1/((n-1)*(n+1)) & s.0=0) implies for n st n
  >=2 holds Partial_Sums(s).n = 3/4-1/(2*n)-1/(2*(n+1));

theorem 
  (for n st n>=1 holds s.n = 1/((2*n-1)*(2*n+1)) & s.0=0) implies for n
  st n>=1 holds Partial_Sums(s).n = n/(2*n+1);

theorem 
  (for n st n>=1 holds s.n = 1/((3*n-2)*(3*n+1)) & s.0=0) implies for n
  st n>=1 holds Partial_Sums(s).n = n/(3*n+1);

theorem 
  (for n st n>=1 holds s.n = 1/((2*n-1)*(2*n+1)*(2*n+3)) & s.0=0)
  implies for n st n>=1 holds Partial_Sums(s).n =1/12-1/(4*(2*n+1)*(2*n+3));

theorem 
  (for n st n>=1 holds s.n = 1/((3*n-2)*(3*n+1)*(3*n+4)) & s.0=0)
  implies for n st n>=1 holds Partial_Sums(s).n =1/24-1/(6*(3*n+1)*(3*n+4));

theorem 
  (for n holds s.n = (2*n-1)/(n*(n+1)*(n+2))) implies for n st n>=1
  holds Partial_Sums(s).n = 3/4-2/(n+2)+1/(2*(n+1)*(n+2));

theorem 
  (for n holds s.n = (n+2)/(n*(n+1)*(n+3))) implies for n st n>=1 holds
  Partial_Sums(s).n = 29/36-1/(n+3)-3/(2*(n+2)*(n+3))-4/(3*(n+1)*(n+2)*(n+3));

theorem 
  (for n holds s.n = ((n+1)*2|^n)/((n+2)*(n+3))) implies for n holds
  Partial_Sums(s).n = 2|^(n+1)/(n+3)-1/2;

theorem 
  (for n holds s.n = (n|^2*4|^n)/((n+1)*(n+2))) implies for n st n>=1
  holds Partial_Sums(s).n =2/3+((n-1)*4|^(n+1))/(3*(n+2));

theorem 
  (for n holds s.n = (n+2)/(n*(n+1)*2|^n)) implies for n st n>=1 holds
  Partial_Sums(s).n =1-1/((n+1)*2|^n);

theorem 
  (for n holds s.n = (2*n+3)/(n*(n+1)*3|^n)) implies for n st n>=1 holds
  Partial_Sums(s).n = 1-1/((n+1)*3|^n);

theorem 
  (for n holds s.n =((-1)|^n*2|^(n+1)) /((2|^(n+1)+(-1)|^(n+1))*(2|^(n+2
)+(-1)|^(n+2)))) implies for n holds Partial_Sums(s).n = 1/3+((-1)|^(n+2))/(3*(
  2|^(n+2)+(-1)|^(n+2)));

theorem 
  (for n holds s.n = n!*n) implies for n st n>=1 holds Partial_Sums(s).n
  = (n+1)!-1;

theorem 
  (for n holds s.n = n/((n+1)!)) implies for n st n>=1 holds
  Partial_Sums(s).n = 1-1/((n+1)!);

theorem 
  (for n st n>=1 holds s.n = (n|^2+n-1)/((n+2)!) & s.0=0) implies for n
  st n>=1 holds Partial_Sums(s).n = 1/2-(n+1)/((n+2)!);

theorem 
  (for n holds s.n = (n*2|^n)/((n+2)!)) implies for n st n>=1 holds
  Partial_Sums(s).n = 1-2|^(n+1)/((n+2)!);



theorem 
  (for n holds s.n = a*n+b) implies for n holds Partial_Sums(s).n = a*(n
  +1)*n/2+n*b+b;


theorem 
  (for n holds s.n = a*n+b) implies for n holds Partial_Sums(s).n = (n+1
  )*(s.0 + s.n)/2;














begin





reserve k,m, n, p for Element of NAT;



theorem 
  for m, n being Element of NAT holds m gcd n = m gcd (n + m);

theorem 
  for k, m, n being Element of NAT st k gcd m = 1 holds k gcd m * n = k gcd n;

theorem 
  for s being real number st s > 0 ex n being Element of NAT st n >
  0 & 0 < 1/n & 1/n <= s;

scheme 

  FibInd {P[set] } : for k being Nat holds P[k]
provided
 P[0] and
 P[1] and
 for k being Nat st P[k] & P[k+1] holds P[k+2];

scheme 

  BinInd { P[Nat,Nat] } : for m, n being Element of NAT holds P[m, n]
provided
 for m, n being Element of NAT st P[m,n] holds P[n,m] and
 for k being Element of NAT st (for m, n being Element of NAT st (m <
k & n < k) holds P[m,n]) holds for m being Element of NAT st m <= k holds P[k,m
];

theorem 
  for m, n being Nat holds Fib(m + (n + 1)) = (Fib(n) * Fib (m)) +
  (Fib(n + 1) * Fib (m + 1));

theorem 
  for m, n being Element of NAT holds Fib(m) gcd Fib(n) = Fib(m gcd n);

begin





reserve x, a, b, c for real number;

theorem 
  for x, a, b, c being real number st a <> 0 & delta(a,b,c) >= 0
holds a * x^2 + b * x + c = 0 iff (x = (- b - sqrt delta(a,b,c))/(2 * a) or x =
  (- b + sqrt delta(a,b,c))/(2 * a));




definition
  func tau -> real number equals

  (1 + sqrt 5)/2;
end;



definition
  func tau_bar -> real number equals

  (1 - sqrt 5)/2;
end;

theorem 
  for n being Nat holds Fib(n) = ((tau to_power n) - (tau_bar
  to_power n))/(sqrt 5);

theorem 
  for n being Element of NAT holds abs(Fib(n) - (tau to_power n)/(sqrt 5 )) < 1
;

reserve F, f, g, h for Real_Sequence;

theorem 
  for f, g, h being Real_Sequence st g is non-zero holds (f /" g)
  (#) (g /" h) = (f /" h);

theorem 
  for f, g being Real_Sequence for n being Element of NAT holds (f
  /" g) . n = (f .n) / (g.n) & (f /" g) . n = (f.n) * (g.n)";

theorem 
  for F being Real_Sequence st (for n being Element of NAT holds F.n =
  Fib(n+1)/Fib(n)) holds F is convergent & lim F = tau;














begin 

reserve Y for non empty set,
  a for Function of Y,BOOLEAN,
  G for Subset of PARTITIONS(Y),
  P,Q for a_partition of Y;

definition
  let Y be non empty set, G be non empty Subset of PARTITIONS Y;
  redefine mode Element of G -> a_partition of Y;
end;

theorem 
  '/\' {} PARTITIONS Y = %O Y;

theorem 
  for R,S being Equivalence_Relation of Y holds R \/ S c= R*S;

theorem 
  for R being Relation of Y holds R c= nabla Y;

theorem 
  for R being Equivalence_Relation of Y holds (nabla Y)*R = nabla Y
  & R*nabla Y = nabla Y;

theorem 
  for P being a_partition of Y, x,y being Element of Y holds [x,y]
  in ERl P iff x in EqClass(y,P);

theorem 
  for P,Q,R being a_partition of Y st ERl(R) = ERl(P)*ERl(Q) for x,y
being Element of Y holds x in EqClass(y,R) iff ex z being Element of Y st x in
  EqClass(z,P) & z in EqClass(y,Q);

theorem 
  for R,S being Relation, Y being set st R is_reflexive_in Y &
  S is_reflexive_in Y holds R*S is_reflexive_in Y;

theorem 
  for R being Relation, Y being set st R is_reflexive_in Y holds Y c= field R;

theorem 
  for Y being set, R being Relation of Y st R is_reflexive_in Y holds
    Y = field R;

theorem 
  for R,S being Equivalence_Relation of Y st R*S = S*R holds
  R*S is Equivalence_Relation of Y;

begin 

theorem 
  for a,b being Function of Y,BOOLEAN st a '<' b holds
  'not' b '<' 'not' a;

theorem 
  for a,b being Function of Y,BOOLEAN, G being Subset of PARTITIONS(Y),
      P being a_partition of Y st a '<' b holds All(a,P,G) '<' All(b,P,G);

theorem 
  for a,b being Function of Y,BOOLEAN,
      G being Subset of PARTITIONS(Y), P being a_partition of Y st
    a '<' b holds Ex(a,P,G) '<' Ex(b,P,G);

begin

theorem 
  G is independent implies for P,Q being Subset of PARTITIONS Y st
  P c= G & Q c= G holds ERl('/\'P)*ERl('/\'Q) = ERl('/\'Q)*ERl('/\'P);

theorem 
  G is independent implies All(All(a,P,G),Q,G) = All(All(a,Q,G),P,G);

theorem 
  G is independent implies Ex(Ex(a,P,G),Q,G) = Ex(Ex(a,Q,G),P,G);

theorem 
  for a being Function of Y,BOOLEAN, G being Subset of PARTITIONS(
Y), P,Q being a_partition of Y st G is independent holds Ex(All(a,P,G),Q,G) '<'
  All(Ex(a,Q,G),P,G);

begin 

reserve x,y,z for set,
  S, X for non empty set,
  R for Relation of X;

notation
  let A,B be set;
  synonym [#](A,B) for [:A,B:];
end;

definition
  let A,B be set;
  func {}(A,B) -> Relation of A,B equals

  {};
  redefine func [#](A,B) -> Relation of A,B;
end;

registration let A,B be set;
 cluster {}(A,B) -> empty;
end;

theorem 
  field id X = X;

theorem 
  op1 = {[{},{}]};

theorem 
  for A,B being set holds field {}(A,B) = {};

theorem 
  R is_reflexive_in X implies R is reflexive & field R = X;

theorem 
  R is_symmetric_in X implies R is symmetric;

theorem 
  R is symmetric implies R is_symmetric_in S;

theorem 
  R is antisymmetric implies R is_antisymmetric_in S;

theorem 
  R is_antisymmetric_in X implies R is antisymmetric;

theorem 
  R is transitive implies R is_transitive_in S;

theorem 
  R is_transitive_in X implies R is transitive;

theorem 
  R is asymmetric implies R is_asymmetric_in S;

theorem 
  R is_asymmetric_in X implies R is asymmetric;

theorem 
  R is irreflexive & field R c= S implies R is_irreflexive_in S;

theorem 
  R is_irreflexive_in X implies R is irreflexive;



registration
  cluster empty -> irreflexive asymmetric transitive for Relation;
end;



definition
  let f be Function;
  attr f is involutive means


  for x being set st x in dom f holds f.(f.x) = x;
end;

definition
  let X;
  let f be UnOp of X;
  redefine attr f is involutive means

  for x being Element of X holds f.(f.x) = x;
end;

registration
  cluster op1 -> involutive for Function;
end;

registration let X be set;
  cluster id X -> involutive;
end;














begin 

reserve Y for non empty set,
  G for Subset of PARTITIONS(Y),
  a,b,c,u for Function of Y,BOOLEAN,
  PA for a_partition of Y;

theorem 
  (a 'imp' b) '<' (All(a,PA,G) 'imp' Ex(b,PA,G));

theorem 
  (All(a,PA,G) '&' All(b,PA,G)) '<' (a '&' b);

theorem 
  (a '&' b) '<' (Ex(a,PA,G) '&' Ex(b,PA,G));

theorem 
  'not' (All(a,PA,G) '&' All(b,PA,G)) = Ex('not' a,PA,G) 'or' Ex('not' b
  , PA, G );

theorem 
  'not' (Ex(a,PA,G) '&' Ex(b,PA,G)) = All('not' a,PA,G) 'or' All('not' b ,PA,G)
;

theorem 
  (All(a,PA,G) 'or' All(b,PA,G)) '<' (a 'or' b);

theorem 
  (a 'or' b) '<' (Ex(a,PA,G) 'or' Ex(b,PA,G));

theorem 
  (a 'xor' b) '<' ('not' (Ex('not' a,PA,G) 'xor' Ex(b,PA,G)) 'or' 'not'
  (Ex(a,PA,G) 'xor' Ex( 'not' b,PA,G)));

theorem 
  All(a 'or' b,PA,G) '<' All(a,PA,G) 'or' Ex(b,PA,G);

theorem 
  All(a 'or' b,PA,G) '<' Ex(a,PA,G) 'or' All(b,PA,G);

theorem 
  All(a 'or' b,PA,G) '<' Ex(a,PA,G) 'or' Ex(b,PA,G);

theorem 
  Ex(a,PA,G) '&' All(b,PA,G) '<' Ex(a '&' b,PA,G);

theorem 
  All(a,PA,G) '&' Ex(b,PA,G) '<' Ex(a '&' b,PA,G);

theorem 
  All(a 'imp' b,PA,G) '<' All(a,PA,G) 'imp' Ex(b,PA,G);

theorem 
  All(a 'imp' b,PA,G) '<' Ex(a,PA,G) 'imp' Ex(b,PA,G);

theorem 
  Ex(a,PA,G) 'imp' All(b,PA,G) '<' All(a 'imp' b,PA,G);

theorem 
  (a 'imp' b) '<' (a 'imp' Ex(b,PA,G));

theorem 
  (a 'imp' b) '<' (All(a,PA,G) 'imp' b);

theorem 
  Ex(a 'imp' b,PA,G) '<' All(a,PA,G) 'imp' Ex(b,PA,G);

theorem 
  All(a,PA,G) '<' Ex(b,PA,G) 'imp' Ex(a '&' b,PA,G);

theorem 
  u is_independent_of PA,G implies Ex(u 'imp' a,PA,G) '<' (u 'imp' Ex(a, PA,G))
;

theorem 
  u is_independent_of PA,G implies Ex(a 'imp' u,PA,G) '<' (All(a,PA,G) 'imp' u)
;

theorem 
  All(a,PA,G) 'imp' Ex(b,PA,G) = Ex(a 'imp' b,PA,G);

theorem 
  All(a,PA,G) 'imp' All(b,PA,G) '<' All(a,PA,G) 'imp' Ex(b,PA,G);

theorem 
  Ex(a,PA,G) 'imp' Ex(b,PA,G) '<' All(a,PA,G) 'imp' Ex(b,PA,G);

theorem 
  All(a 'imp' b,PA,G) = All('not' a 'or' b,PA,G);

theorem 
  All(a 'imp' b,PA,G) = 'not' (Ex(a '&' 'not' b,PA,G));

theorem 
  Ex(a,PA,G) '<' 'not' (All(a 'imp' b,PA,G) '&' All(a 'imp' 'not' b,PA,G ));

theorem 
  Ex(a,PA,G) '<' 'not' ('not' Ex(a '&' b,PA,G) '&' 'not' Ex(a '&' 'not'
  b,PA,G));

theorem 
  Ex(a,PA,G) '&' All(a 'imp' b,PA,G) '<' Ex(a '&' b,PA,G);

theorem 
  Ex(a,PA,G) '&' 'not' Ex(a '&' b,PA,G) '<' 'not' All(a 'imp' b,PA,G);

theorem 
  All(a 'imp' c,PA,G) '&' All(c 'imp' b,PA,G) '<' All(a 'imp' b,PA,G);

theorem 
  All(c 'imp' b,PA,G) '&' Ex(a '&' c,PA,G) '<' Ex(a '&' b,PA,G);

theorem 
  All(b 'imp' 'not' c,PA,G) '&' All(a 'imp' c,PA,G) '<' All(a 'imp'
  'not' b,PA,G);

theorem 
  All(b 'imp' c,PA,G) '&' All(a 'imp' 'not' c,PA,G) '<' All(a 'imp'
  'not' b,PA,G);

theorem 
  All(b 'imp' 'not' c,PA,G) '&' Ex(a '&' c,PA,G) '<' Ex(a '&' 'not' b,PA ,G );

theorem 
  All(b 'imp' c,PA,G) '&' Ex(a '&' 'not' c,PA,G) '<' Ex(a '&' 'not' b,PA ,G );

theorem 
  Ex(c,PA,G) '&' All(c 'imp' b,PA,G) '&' All(c 'imp' a,PA,G) '<' Ex(a
  '&' b,PA,G);

theorem 
  All(b 'imp' c,PA,G) '&' All(c 'imp' 'not' a,PA,G) '<' All(a 'imp'
  'not' b,PA,G);

theorem 
  Ex(b,PA,G) '&' All(b 'imp' c,PA,G) '&' All(c 'imp' a,PA,G) '<' Ex(a
  '&' b,PA,G);

theorem 
  Ex(c,PA,G) '&' All(b 'imp' 'not' c,PA,G) '&' All(c 'imp' a,PA,G) '<'
  Ex(a '&' 'not' b,PA,G);














begin



reserve Y for non empty set;

theorem 
 for a,b,c being Function of Y,BOOLEAN holds a '<' (b 'imp' c)
  implies a '&' b '<' c;

theorem 
  for a,b,c being Function of Y,BOOLEAN holds a '&' b '<' c
  implies a '<' (b 'imp' c);

theorem 
  for a,b being Function of Y,BOOLEAN holds a 'or' (a '&' b) = a;

theorem 
  for a,b being Function of Y,BOOLEAN holds a '&' (a 'or' b) = a;

theorem 
  for a being Function of Y,BOOLEAN holds a '&' 'not' a = O_el(Y);

theorem 
  for a being Function of Y,BOOLEAN holds a 'or' 'not' a = I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN
   holds a 'eqv' b = (a 'imp' b) '&' (b 'imp' a);

theorem 
  for a,b being Function of Y,BOOLEAN holds a 'imp' b = 'not' a 'or' b;

theorem 
  for a,b being Function of Y,BOOLEAN
    holds a 'xor' b = ('not' a '&' b) 'or' (a '&' 'not' b);

theorem 
  for a,b being Function of Y,BOOLEAN holds (a 'eqv' b)=I_el
  (Y) iff (a 'imp' b)=I_el(Y) & (b 'imp' a)=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds a 'eqv' b=I_el(Y)
  implies 'not' a 'eqv' 'not' b=I_el(Y);

theorem 
  for a,b,c,d being Function of Y,BOOLEAN holds (a 'eqv' b)=I_el(Y
  ) & (c 'eqv' d)=I_el(Y) implies ((a '&' c) 'eqv' (b '&' d))=I_el(Y);

theorem 
  for a,b,c,d being Function of Y,BOOLEAN holds (a 'eqv' b)=I_el(Y
  ) & (c 'eqv' d)=I_el(Y) implies ((a 'imp' c) 'eqv' (b 'imp' d))=I_el(Y);

theorem 
  for a,b,c,d being Function of Y,BOOLEAN holds (a 'eqv' b)=I_el(Y
  ) & (c 'eqv' d)=I_el(Y) implies ((a 'or' c) 'eqv' (b 'or' d))=I_el(Y);

theorem 
  for a,b,c,d being Function of Y,BOOLEAN holds (a 'eqv' b)=I_el(Y
  ) & (c 'eqv' d)=I_el(Y) implies ((a 'eqv' c) 'eqv' (b 'eqv' d))=I_el(Y);

begin



theorem 
  for a,b being Function of Y,BOOLEAN, G being Subset of
  PARTITIONS(Y), PA being a_partition of Y
   holds All(a 'eqv' b,PA,G) = All(a 'imp' b,PA,G) '&' All(b 'imp' a,PA,G);

theorem 
  for a being Function of Y,BOOLEAN, G being Subset of PARTITIONS(
  Y), PA,PB being a_partition of Y holds All(a,PA,G) '<' Ex(a,PB,G);

theorem 
  for a,u being Function of Y,BOOLEAN, G being Subset of
PARTITIONS(Y), PA being a_partition of Y st a 'imp' u = I_el(Y) holds All(a,PA,
  G) 'imp' u = I_el(Y);

theorem 
  for u being Function of Y,BOOLEAN, G being Subset of PARTITIONS(
Y), PA being a_partition of Y st u is_independent_of PA,G holds Ex(u,PA,G) '<'
  u;

theorem 
  for u being Function of Y,BOOLEAN, G being Subset of PARTITIONS(
Y), PA being a_partition of Y st u is_independent_of PA,G holds u '<' All(u,PA,
  G);

theorem 
  for u being Function of Y,BOOLEAN, G being Subset of PARTITIONS(
Y), PA,PB being a_partition of Y st u is_independent_of PB,G holds All(u,PA,G)
  '<' All(u,PB,G);

theorem 
  for u being Function of Y,BOOLEAN, G being Subset of PARTITIONS(
  Y), PA,PB being a_partition of Y st u is_independent_of PA,G holds Ex(u,PA,G)
  '<' Ex(u,PB,G);

theorem 
  for a,b being Function of Y,BOOLEAN, G being Subset of
PARTITIONS(Y), PA being a_partition of Y holds All(a 'eqv' b,PA,G) '<' All(a,PA
  ,G) 'eqv' All(b,PA,G);

theorem 
  for a,b being Function of Y,BOOLEAN, G being Subset of
PARTITIONS(Y), PA being a_partition of Y holds All(a '&' b,PA,G) '<' a '&' All(
  b,PA,G);

theorem 
  for a,u being Function of Y,BOOLEAN, G being Subset of
  PARTITIONS(Y), PA being a_partition of Y holds All(a,PA,G) 'imp' u '<' Ex(a
  'imp' u,PA,G);

theorem 
  for a,b being Function of Y,BOOLEAN, G being Subset of
PARTITIONS(Y), PA being a_partition of Y holds (a 'eqv' b)=I_el(Y) implies (All
  (a,PA,G) 'eqv' All(b,PA,G))=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN, G being Subset of
PARTITIONS(Y), PA being a_partition of Y holds (a 'eqv' b)=I_el(Y) implies (Ex(
  a,PA,G) 'eqv' Ex(b,PA,G))=I_el(Y);














begin



reserve Y for non empty set;

theorem 
  for a,b being Function of Y,BOOLEAN holds a=I_el(Y) & b=I_el(Y)
  iff (a '&' b)=I_el(Y);

theorem 
  for b being Function of Y,BOOLEAN st (I_el(Y) 'imp' b)=I_el
  (Y) holds b=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN st a=I_el(Y) holds (a 'or' b
  )=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN st b=I_el(Y) holds (a 'imp'
  b)=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN st ('not' a)=I_el(Y) holds (
  a 'imp' b)=I_el(Y);

theorem 
  for a being Function of Y,BOOLEAN holds 'not' (a '&' 'not' a)= I_el(Y);

theorem 
  for a being Function of Y,BOOLEAN holds a 'imp' a = I_el Y;

theorem 
  for a,b being Function of Y,BOOLEAN holds (a 'imp' b)=I_el(Y)
  iff ('not' b 'imp' 'not' a)=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN st (a 'imp' b)=I_el(Y) & (
  b 'imp' c)=I_el(Y) holds (a 'imp' c)=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN st (a 'imp' b)=I_el(Y) & (a
  'imp' 'not' b)=I_el(Y) holds 'not' a=I_el(Y);

theorem 
  for a being Function of Y,BOOLEAN holds ('not' a 'imp' a) 'imp'
  a = I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' b) 'imp' (
  'not' (b '&' c) 'imp' 'not' (a '&' c)) =I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' b) 'imp' ((
  b 'imp' c) 'imp' (a 'imp' c))=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN st (a 'imp' b)=I_el(
  Y) holds (b 'imp' c) 'imp' (a 'imp' c)=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds b 'imp' (a 'imp' b) =I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds ((a 'imp' b) 'imp' c
  ) 'imp' (b 'imp' c)=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds b 'imp' ((b 'imp' a)
  'imp' a)=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (c 'imp' (b 'imp' a)
  ) 'imp' (b 'imp' (c 'imp' a))=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (b 'imp' c) 'imp' ((
  a 'imp' b) 'imp' (a 'imp' c))=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (b 'imp' (b 'imp' c)
  ) 'imp' (b 'imp' c)=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' (b
  'imp' c)) 'imp' ((a 'imp' b) 'imp' (a 'imp' c))=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds a=I_el(Y) implies (a
  'imp' b) 'imp' b=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds c 'imp' (b 'imp' a)=
  I_el(Y) implies b 'imp' (c 'imp' a)=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds c 'imp' (b 'imp' a)=
  I_el(Y) & b=I_el(Y) implies c 'imp' a=I_el(Y);

theorem 
  for a being Function of Y,BOOLEAN holds I_el Y 'imp' (I_el
  Y 'imp' a)=I_el Y implies a=I_el Y;

theorem 
  for b,c being Function of Y,BOOLEAN holds b 'imp' (b 'imp' c)=
  I_el(Y) implies b 'imp' c = I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' (b 'imp' c)
  ) = I_el(Y) implies (a 'imp' b) 'imp' (a 'imp' c) = I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' (b 'imp' c)
  ) = I_el(Y) & a 'imp' b = I_el(Y) implies a 'imp' c = I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' (b 'imp' c)
  ) = I_el(Y) & a 'imp' b = I_el(Y) & a = I_el(Y) implies c = I_el(Y);

theorem 
  for a,b,c,d being Function of Y,BOOLEAN holds a 'imp' (b 'imp' c
) = I_el(Y) & a 'imp' (c 'imp' d) = I_el(Y) implies a 'imp' (b 'imp' d) = I_el(
  Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds ('not' a 'imp' 'not' b
  ) 'imp' (b 'imp' a) = I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds (a 'imp' b) 'imp' (
  'not' b 'imp' 'not' a)=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds (a 'imp' 'not' b)
  'imp' (b 'imp' 'not' a)=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds ('not' a 'imp' b)
  'imp' ('not' b 'imp' a)=I_el(Y);

theorem 
  for a being Function of Y,BOOLEAN holds (a 'imp' 'not' a) 'imp'
  'not' a=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds 'not' a 'imp' (a 'imp'
  b)=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds 'not' (a '&' b '&' c
  )=('not' a) 'or' ('not' b) 'or' ('not' c);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds 'not' (a 'or' b 'or'
  c)=('not' a) '&' ('not' b) '&' ('not' c);

theorem 
  for a,b,c,d being Function of Y,BOOLEAN holds a 'or' (b '&' c
  '&' d) = (a 'or' b) '&' (a 'or' c) '&' (a 'or' d);

theorem 
  for a,b,c,d being Function of Y,BOOLEAN holds a '&' (b 'or' c
  'or' d) = (a '&' b) 'or' (a '&' c) 'or' (a '&' d);














begin



reserve Y for non empty set;

theorem 
  for a,b being Function of Y,BOOLEAN holds a 'imp' (b 'imp' (a
  '&' b))=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds (a 'imp' b) 'imp' ((b
  'imp' a) 'imp' (a 'eqv' b))=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds (a 'or' b) 'eqv' (b
  'or' a)=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds ((a '&' b) 'imp' c)
  'imp' (a 'imp' (b 'imp' c))=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' (b 'imp' c)
  ) 'imp' ((a '&' b) 'imp' c)=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (c 'imp' a) 'imp' ((
  c 'imp' b) 'imp' (c 'imp' (a '&' b)))=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds ((a 'or' b) 'imp' c)
  'imp' ((a 'imp' c) 'or' (b 'imp' c))=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' c) 'imp' ((
  b 'imp' c) 'imp' ((a 'or' b) 'imp' c))=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds ((a 'imp' c) '&' (b
  'imp' c)) 'imp' ((a 'or' b) 'imp' c)=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds (a 'imp' (b '&' 'not'
  b)) 'imp' 'not' a=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds ((a 'or' b) '&' (a
  'or' c)) 'imp' (a 'or' (b '&' c))=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a '&' (b 'or' c))
  'imp' ((a '&' b) 'or' (a '&' c))=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds ((a 'or' c) '&' (b
  'or' c)) 'imp' ((a '&' b) 'or' c)=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds ((a 'or' b) '&' c)
  'imp' ((a '&' c) 'or' (b '&' c))=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds (a '&' b)=I_el(Y)
  implies (a 'or' b)=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' b)=I_el(Y)
  implies (a 'or' c) 'imp' (b 'or' c)=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' b)=I_el(Y)
  implies (a '&' c) 'imp' (b '&' c)=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (c 'imp' a)=I_el(Y)
  & (c 'imp' b)=I_el(Y) implies c 'imp' (a '&' b)=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' c)=I_el(Y)
  & (b 'imp' c)=I_el(Y) implies (a 'or' b) 'imp' c = I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds (a 'or' b)=I_el(Y) &
  'not' a=I_el(Y) implies b=I_el(Y);

theorem 
  for a,b,c,d being Function of Y,BOOLEAN holds (a 'imp' b)=I_el(Y
  ) & (c 'imp' d)=I_el(Y) implies (a '&' c) 'imp' (b '&' d)=I_el(Y);

theorem 
  for a,b,c,d being Function of Y,BOOLEAN holds (a 'imp' b)=I_el(Y
  ) & (c 'imp' d)=I_el(Y) implies (a 'or' c) 'imp' (b 'or' d) =I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds (a '&' 'not' b) 'imp'
  'not' a=I_el(Y) implies (a 'imp' b)=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds a 'imp' 'not' b=I_el(Y
  ) implies b 'imp' 'not' a=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds 'not' a 'imp' b=I_el(Y
  ) implies 'not' b 'imp' a=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds a 'imp' (a 'or' b)= I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds (a 'or' b) 'imp' (
  'not' a 'imp' b)=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds 'not'( a 'or' b)
  'imp' ('not' a '&' 'not' b)=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds ('not' a '&' 'not' b)
  'imp' 'not'( a 'or' b)=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds 'not'( a 'or' b) 'imp'
  'not' a=I_el(Y);

theorem 
  for a being Function of Y,BOOLEAN holds (a 'or' a) 'imp' a=I_el( Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds (a '&' 'not' a) 'imp'
  b=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds (a 'imp' b) 'imp' (
  'not' a 'or' b)=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds (a '&' b) 'imp' 'not'(
  a 'imp' 'not' b)=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds 'not'( a 'imp' 'not' b
  ) 'imp' (a '&' b)=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds 'not'( a '&' b)
  'imp' ('not' a 'or' 'not' b)=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds ('not' a 'or' 'not' b)
  'imp' 'not'( a '&' b)=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds (a '&' b) 'imp' a=I_el (Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds (a '&' b) 'imp' (a
  'or' b)=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds (a '&' b) 'imp' b=I_el (Y);

theorem 
  for a being Function of Y,BOOLEAN holds a 'imp' a '&' a=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds (a 'eqv' b)
  'imp' (a 'imp' b)=I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds (a 'eqv' b) 'imp' (b
  'imp' a)=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds ((a 'or' b) 'or' c)
  'imp' (a 'or' (b 'or' c))=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds ((a '&' b) '&' c)
  'imp' (a '&' (b '&' c))=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'or' (b 'or' c))
  'imp' ((a 'or' b) 'or' c)=I_el(Y);














begin



reserve Y for non empty set;

theorem 
  for a,b being Function of Y,BOOLEAN holds (a 'imp' b) '&' ('not'
  a 'imp' b) = b;

theorem 
  for a,b being Function of Y,BOOLEAN holds (a 'imp' b) '&' (a
  'imp' 'not' b) = 'not' a;

theorem 
  for a,b,c being Function of Y,BOOLEAN holds a 'imp' (b 'or' c) =
  (a 'imp' b) 'or' (a 'imp' c);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds a 'imp' (b '&' c) =
  (a 'imp' b) '&' (a 'imp' c);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'or' b) 'imp' c =
  (a 'imp' c) '&' (b 'imp' c);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a '&' b) 'imp' c =
  (a 'imp' c) 'or' (b 'imp' c);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a '&' b) 'imp'
  c = a 'imp' (b 'imp' c);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a '&' b) 'imp' c =
  a 'imp' ('not' b 'or' c);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds a 'imp' (b 'or' c) =
  (a '&' 'not' b) 'imp' c;

theorem 
  for a,b being Function of Y,BOOLEAN holds a '&' (a 'imp' b) = a '&' b;

theorem 
  for a,b being Function of Y,BOOLEAN holds (a 'imp' b) '&' 'not'
  b = 'not' a '&' 'not' b;

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' b) '&' (b
  'imp' c) = (a 'imp' b) '&' (b 'imp' c) '&' (a 'imp' c);

theorem 
  for a being Function of Y,BOOLEAN holds I_el(Y) 'imp' a = a;

theorem 
  for a being Function of Y,BOOLEAN holds a 'imp' O_el(Y) = 'not' a;

theorem 
  for a being Function of Y,BOOLEAN holds O_el(Y) 'imp' a = I_el(Y );

theorem 
  for a being Function of Y,BOOLEAN holds a 'imp' I_el(Y) = I_el(Y );

theorem 
  for a being Function of Y,BOOLEAN holds a 'imp' 'not' a = 'not' a;

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' b) '<' (c
  'imp' a) 'imp' (c 'imp' b);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'eqv' b) '<' (a
  'eqv' c) 'eqv' (b 'eqv' c);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'eqv' b) '<' (a
  'imp' c) 'eqv' (b 'imp' c);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'eqv' b) '<' (c
  'imp' a) 'eqv' (c 'imp' b);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'eqv' b) '<' (a
  '&' c) 'eqv' (b '&' c);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'eqv' b) '<' (a
  'or' c) 'eqv' (b 'or' c);

theorem 
  for a,b being Function of Y,BOOLEAN holds a '<' (a 'eqv' b)
  'eqv' (b 'eqv' a) 'eqv' a;

theorem 
  for a,b being Function of Y,BOOLEAN holds a '<' (a 'imp' b) 'eqv' b;

theorem 
  for a,b being Function of Y,BOOLEAN holds a '<' (b 'imp' a) 'eqv' a;

theorem 
  for a,b being Function of Y,BOOLEAN holds a '<' (a '&' b) 'eqv'
  (b '&' a) 'eqv' a;














begin



reserve Y for non empty set;

theorem 
  for a,b,c,d being Function of Y,BOOLEAN holds a 'imp' (b '&' c
  '&' d) = (a 'imp' b) '&' (a 'imp' c) '&' (a 'imp' d);

theorem 
  for a,b,c,d being Function of Y,BOOLEAN holds a 'imp' (b 'or' c
  'or' d) = (a 'imp' b) 'or' (a 'imp' c) 'or' (a 'imp' d);

theorem 
  for a,b,c,d being Function of Y,BOOLEAN holds (a '&' b '&' c)
  'imp' d = (a 'imp' d) 'or' (b 'imp' d) 'or' (c 'imp' d);

theorem 
  for a,b,c,d being Function of Y,BOOLEAN holds (a 'or' b 'or' c)
  'imp' d = (a 'imp' d) '&' (b 'imp' d) '&' (c 'imp' d);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' b) '&' (b
  'imp' c) '&' (c 'imp' a) = (a 'imp' b) '&' (b 'imp' c) '&' (c 'imp' a) '&' (b
  'imp' a) '&' (a 'imp' c);

theorem 
  for a,b being Function of Y,BOOLEAN holds a = (a '&' b) 'or' (a
  '&' 'not' b);

theorem 
  for a,b being Function of Y,BOOLEAN holds a = (a 'or' b) '&' (a
  'or' 'not' b);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds a = (a '&' b '&' c)
  'or' (a '&' b '&' 'not' c) 'or' (a '&' 'not' b '&' c) 'or' (a '&' 'not' b '&'
  'not' c);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds a = (a 'or' b 'or' c
  ) '&' (a 'or' b 'or' 'not' c) '&' (a 'or' 'not' b 'or' c) '&' (a 'or' 'not' b
  'or' 'not' c);

theorem 
  for a,b being Function of Y,BOOLEAN holds a '&' b = a '&' ('not'
  a 'or' b);

theorem 
  for a,b being Function of Y,BOOLEAN holds a 'or' b = a 'or' (
  'not' a '&' b);

theorem 
  for a,b being Function of Y,BOOLEAN holds a 'xor' b = 'not'( a 'eqv' b);

theorem 
  for a,b being Function of Y,BOOLEAN holds a 'xor' b = (a 'or' b)
  '&' ('not' a 'or' 'not' b);

theorem 
  for a being Function of Y,BOOLEAN holds a 'xor' I_el(Y) = 'not' a;

theorem 
  for a being Function of Y,BOOLEAN holds a 'xor' O_el(Y) = a;

theorem 
  for a,b being Function of Y,BOOLEAN holds a 'xor' b = 'not' a
  'xor' 'not' b;

theorem 
  for a,b being Function of Y,BOOLEAN holds 'not'( a 'xor' b) = a
  'xor' 'not' b;

theorem 
  for a,b being Function of Y,BOOLEAN holds a 'eqv' b = (a
  'or' 'not' b) '&' ('not' a 'or' b);

theorem 
  for a,b being Function of Y,BOOLEAN holds a 'eqv' b = (a '&' b)
  'or' ('not' a '&' 'not' b);

theorem 
  for a being Function of Y,BOOLEAN holds a 'eqv' I_el(Y) = a;

theorem 
  for a being Function of Y,BOOLEAN holds a 'eqv' O_el(Y) = 'not' a;

theorem 
  for a,b being Function of Y,BOOLEAN holds 'not'( a 'eqv' b) = (a
  'eqv' 'not' b);

theorem 
  for a,b being Function of Y,BOOLEAN holds 'not' a '<' (a 'imp' b
  ) 'eqv' 'not' a;

theorem 
  for a,b being Function of Y,BOOLEAN holds 'not' a '<' (b 'imp' a
  ) 'eqv' 'not' b;

theorem 
  for a,b being Function of Y,BOOLEAN holds a '<' (a 'or' b) 'eqv'
  (b 'or' a) 'eqv' a;

theorem 
  for a being Function of Y,BOOLEAN holds a 'imp' ('not' a 'eqv'
  'not' a) = I_el(Y);

theorem 
  for a,b being Function of Y,BOOLEAN holds ((a 'imp' b) 'imp' a)
  'imp' a = I_el(Y);

theorem 
  for a,b,c,d being Function of Y,BOOLEAN holds ((a 'imp' c) '&' (
  b 'imp' d)) '&' ('not' c 'or' 'not' d) 'imp' ('not' a 'or' 'not' b)=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' b) 'imp' ((
  a 'imp' (b 'imp' c)) 'imp' (a 'imp' c)) = I_el(Y);














begin 

reserve Y for non empty set,
  a,b,c,d,e,f,g for Function of Y,BOOLEAN;

theorem 
  (a 'or' b) '&' (b 'imp' c) '<' a 'or' c;

theorem 
  a '&' (a 'imp' b) '<' b;

theorem 
  (a 'imp' b) '&' 'not' b '<' 'not' a;

theorem 
  (a 'or' b) '&' 'not' a '<' b;

theorem 
  (a 'imp' b) '&' ('not' a 'imp' b) '<' b;

theorem 
  (a 'imp' b) '&' (a 'imp' 'not' b) '<' 'not' a;

theorem 
  a 'imp' (b '&' c) '<' a 'imp' b;

theorem 
  (a 'or' b) 'imp' c '<' a 'imp' c;

theorem 
  a 'imp' b '<' (a '&' c) 'imp' b;

theorem 
  a 'imp' b '<' (a '&' c) 'imp' (b '&' c);

theorem 
  a 'imp' b '<' a 'imp' (b 'or' c);

theorem 
  a 'imp' b '<' (a 'or' c) 'imp' (b 'or' c);

theorem 
  a '&' b 'or' c '<' a 'or' c;

theorem 
  (a '&' b) 'or' (c '&' d) '<' a 'or' c;

theorem 
  (a 'or' b) '&' (b 'imp' c) '<' a 'or' c;

theorem 
  (a 'imp' b) '&' ('not' a 'imp' c) '<' b 'or' c;

theorem 
  (a 'imp' c) '&' (b 'imp' 'not' c) '<' 'not' a 'or' 'not' b;

theorem 
  (a 'or' b) '&' ('not' a 'or' c) '<' b 'or' c;

theorem 
  (a 'imp' b) '&' (c 'imp' d) '<' (a '&' c) 'imp' (b '&' d);

theorem 
  (a 'imp' b) '&' (a 'imp' c) '<' a 'imp' (b '&' c);

theorem 
  ((a 'imp' c) '&' (b 'imp' c)) '<' (a 'or' b) 'imp' c;

theorem 
  (a 'imp' b) '&' (c 'imp' d) '<' (a 'or' c) 'imp' (b 'or' d);

theorem 
  (a 'imp' b) '&' (a 'imp' c) '<' a 'imp' (b 'or' c);

theorem 
  for a1,b1,c1,a2,b2,c2 being Function of Y,BOOLEAN holds (
  b1 'imp' b2) '&' (c1 'imp' c2) '&' (a1 'or' b1 'or' c1) '&' 'not'( a2 '&' b2)
  '&' 'not'( a2 '&' c2) '<' (a2 'imp' a1);

theorem 
  for a1,b1,c1,a2,b2,c2 being Function of Y,BOOLEAN holds (a1
  'imp' a2) '&' (b1 'imp' b2) '&' (c1 'imp' c2) '&' (a1 'or' b1 'or' c1) '&'
'not'( a2 '&' b2) '&' 'not'( a2 '&' c2) '&' 'not'( b2 '&' c2) '<' (a2 'imp' a1)
  '&' (b2 'imp' b1) '&' (c2 'imp' c1);

theorem 
  for a1,b1,a2,b2 being Function of Y,BOOLEAN holds ((a1
'imp' a2) '&' (b1 'imp' b2) '&' 'not'(a2 '&' b2)) 'imp' 'not' (a1 '&' b1)=I_el(
  Y);

theorem 
  for a1,b1,c1,a2,b2,c2 being Function of Y,BOOLEAN holds (a1
'imp' a2) '&' (b1 'imp' b2) '&' (c1 'imp' c2) '&' 'not'( a2 '&' b2) '&' 'not'(
  a2 '&' c2) '&' 'not'( b2 '&' c2) '<' 'not'( a1 '&' b1) '&' 'not'( a1 '&' c1)
  '&' 'not'( b1 '&' c1);

theorem 
  a '&' b '<' a;

theorem 
  a '&' b '&' c '<' a & a '&' b '&' c '<' b;

theorem 
  a '&' b '&' c '&' d '<' a & a '&' b '&' c '&' d '<' b;

theorem 
  a '&' b '&' c '&' d '&' e '<' a & a '&' b '&' c '&' d '&' e '<' b;

theorem 
  a '&' b '&' c '&' d '&' e '&' f '<' a & a '&' b '&' c '&' d '&' e '&'
  f '<' b;

theorem 
  a '&' b '&' c '&' d '&' e '&' f '&' g '<' a & a '&' b '&' c '&' d '&'
  e '&' f '&' g '<' b;

theorem 
  a '<' b & c '<' d implies a '&' c '<' b '&' d;

theorem 
  a '&' b '<' c implies a '&' 'not' c '<' 'not' b;

theorem 
  (a 'imp' c) '&' (b 'imp' c) '&' (a 'or' b) '<' c;

theorem 
  ((a 'imp' c) 'or' (b 'imp' c)) '&' (a '&' b) '<' c;

theorem 
  a '<' b & c '<' d implies a 'or' c '<' b 'or' d;

theorem 
  a '<' a 'or' b;

theorem 
  a '&' b '<' a 'or' b;














begin



reserve Y for non empty set;

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a '&' b) 'or' (b
  '&' c) 'or' (c '&' a)= (a 'or' b) '&' (b 'or' c) '&' (c 'or' a);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a '&' 'not' b) 'or'
(b '&' 'not' c) 'or' (c '&' 'not' a)= (b '&' 'not' a) 'or' (c '&' 'not' b) 'or'
  (a '&' 'not' c);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'or' 'not' b) '&'
  (b 'or' 'not' c) '&' (c 'or' 'not' a)= (b 'or' 'not' a) '&' (c 'or' 'not' b)
  '&' (a 'or' 'not' c);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (c 'imp' a)=I_el(Y)
  & (c 'imp' b)=I_el(Y) implies c 'imp' (a 'or' b)=I_el(Y);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' c)=I_el(Y)
  & (b 'imp' c)=I_el(Y) implies (a '&' b) 'imp' c = I_el(Y);

theorem 
  for a1,a2,b1,b2,c1,c2 being Function of Y,BOOLEAN holds (a1
'imp' a2) '&' (b1 'imp' b2) '&' (c1 'imp' c2) '&' (a1 'or' b1 'or' c1) '<' (a2
  'or' b2 'or' c2);

theorem 
  for a1,a2,b1,b2 being Function of Y,BOOLEAN holds (a1 'imp' b1)
'&' (a2 'imp' b2) '&' (a1 'or' a2) '&' 'not'( b1 '&' b2)= (b1 'imp' a1) '&' (b2
  'imp' a2) '&' (b1 'or' b2) '&' 'not'( a1 '&' a2);

theorem 
  for a,b,c,d being Function of Y,BOOLEAN holds (a 'or' b) '&' (c
  'or' d) = (a '&' c) 'or' (a '&' d) 'or' (b '&' c) 'or' (b '&' d);

theorem 
  for a1,a2,b1,b2,b3 being Function of Y,BOOLEAN holds (a1 '&' a2)
'or' (b1 '&' b2 '&' b3)= (a1 'or' b1) '&' (a1 'or' b2) '&' (a1 'or' b3) '&' (a2
  'or' b1) '&' (a2 'or' b2) '&' (a2 'or' b3);

theorem 
  for a,b,c,d being Function of Y,BOOLEAN holds (a 'imp' b) '&' (b
'imp' c) '&' (c 'imp' d)= (a 'imp' (b '&' c '&' d)) '&' (b 'imp' (c '&' d)) '&'
  (c 'imp' d);

theorem 
  for a,b,c,d being Function of Y,BOOLEAN holds (a 'imp' c) '&' (b
  'imp' d) '&' (a 'or' b) '<' (c 'or' d);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds ((a '&' b) 'imp'
  'not' c) '&' a '&' c '<' 'not' b;

theorem 
  for a1,a2,a3,b1,b2,b3 being Function of Y,BOOLEAN holds (a1 '&'
  a2 '&' a3) 'imp' (b1 'or' b2 'or' b3)= ('not' b1 '&' 'not' b2 '&' a3) 'imp' (
  'not' a1 'or' 'not' a2 'or' b3);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' b) '&' (b
'imp' c) '&' (c 'imp' a) = (a '&' b '&' c) 'or' ('not' a '&' 'not' b '&' 'not'
  c);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' b) '&' (b
  'imp' c) '&' (c 'imp' a) '&' (a 'or' b 'or' c)= (a '&' b '&' c);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'or' b) '&' (b
'or' c) '&' (c 'or' a) '&' 'not'( a '&' b '&' c)= ('not' a '&' b '&' c) 'or' (a
  '&' 'not' b '&' c) 'or' (a '&' b '&' 'not' c);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' b) '&' (b
  'imp' c) '<' (a 'imp' (b '&' c));

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' b) '&' (b
  'imp' c) '<' ((a 'or' b) 'imp' c);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' b)
  '&' (b 'imp' c) '<' (a 'imp' (b 'or' c));

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' b)
  '&' (b 'imp' c) '<' (a 'imp' (b 'or' 'not' c));

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' b)
  '&' (b 'imp' c) '<' (b 'imp' (c 'or' a));

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' b)
  '&' (b 'imp' c) '<' (b 'imp' (c 'or' 'not' a));

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' b) '&' (b
  'imp' c) '<' (a 'imp' b) '&' (b 'imp' (c 'or' a));

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' b) '&' (b
  'imp' c) '<' (a 'imp' (b 'or' 'not' c)) '&' (b 'imp' c);

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' b) '&' (b
  'imp' c) '<' (a 'imp' (b 'or' c)) '&' (b 'imp' (c 'or' a));

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' b) '&' (b
  'imp' c) '<' (a 'imp' (b 'or' 'not' c)) '&' (b 'imp' (c 'or' a));

theorem 
  for a,b,c being Function of Y,BOOLEAN holds (a 'imp' b) '&' (b
  'imp' c) '<' (a 'imp' (b 'or' 'not' c)) '&' (b 'imp' (c 'or' 'not' a));














begin 

reserve Y for non empty set,
  a, b for Function of Y,BOOLEAN,
  G for Subset of PARTITIONS(Y),
  A, B for a_partition of Y;

theorem 
  for z being Element of Y, PA,PB being a_partition of Y st PA '<'
  PB holds EqClass(z,PA) c= EqClass(z,PB);

theorem 
  for z being Element of Y, PA,PB being a_partition of Y holds EqClass(z
  ,PA) c= EqClass(z,PA '\/' PB);

theorem 
  for z being Element of Y, PA,PB being a_partition of Y holds EqClass(z
  ,PA '/\' PB) c= EqClass(z,PA);

theorem 
  for z being Element of Y, PA being a_partition of Y holds EqClass(z,PA
  ) c= EqClass(z,%O(Y)) & EqClass(z,%I(Y)) c= EqClass(z,PA);

theorem 
  for G being Subset of PARTITIONS(Y), A,B being a_partition of Y st G
  is independent & G={A,B} & A<>B holds for a,b being set st a in A & b in B
  holds a meets b;

theorem 
  for G being Subset of PARTITIONS(Y), A,B being a_partition of Y st G
  is independent & G={A,B} & A <> B holds '/\' G = A '/\' B;

theorem 
  for G being Subset of PARTITIONS(Y), A,B being a_partition of Y st G={
  A,B} & A<>B holds CompF(A,G) = B;

begin

theorem 
  a '<' b implies All(a,A,G) '<' Ex(b,A,G);

theorem 
  G is independent implies All(All(a,A,G),B,G) '<' Ex(All(a,B,G),A,G);

theorem 
  All(All(a,A,G),B,G) '<' Ex(Ex(a,B,G),A,G);

theorem 
  G is independent implies All(All(a,A,G),B,G) '<' All(Ex(a,B,G),A,G);

theorem 
  All(Ex(a,A,G),B,G) '<' Ex(Ex(a,B,G),A,G);

theorem 
  'not' Ex(All(a,A,G),B,G) '<' Ex(Ex('not' a,B,G),A,G);

theorem 
  G is independent implies Ex('not' All(a,A,G),B,G) '<' Ex(Ex(
  'not' a,B,G),A,G);

theorem 
  G is independent implies 'not' All(All(a,A,G),B,G) = Ex('not' All(a,B,G),A,G)
;

theorem 
  G is independent implies All('not' All(a,A,G),B,G) '<' Ex(Ex('not' a,B
  ,G),A,G);

theorem 
  G is independent implies 'not' All(All(a,A,G),B,G) = Ex(Ex('not' a,B,G ),A,G)
;

theorem 
  G is independent implies 'not' All(All(a,A,G),B,G) '<' Ex(Ex('not' a,A
  ,G),B,G);



theorem 
  'not' All(Ex(a,A,G),B,G) = Ex(All('not' a,A,G),B,G);

theorem 
  'not' Ex(All(a,A,G),B,G) = All(Ex('not' a,A,G),B,G);

theorem 
  'not' All(All(a,A,G),B,G) = Ex(Ex('not' a,A,G),B,G);

theorem 
  G is independent implies Ex(All(a,A,G),B,G) '<' Ex(Ex(a,B,G),A,G);

theorem 
  All(All(a,A,G),B,G) '<' All(Ex(a,A,G),B,G);

theorem 
  All(All(a,A,G),B,G) '<' Ex(Ex(a,A,G),B,G);

theorem 
  Ex(All(a,A,G),B,G) '<' Ex(Ex(a,A,G),B,G);



theorem 
  G is independent implies All('not' All(a,A,G),B,G) '<' 'not' All(
  All(a,B,G),A,G);

theorem 
  All(All('not' a,A,G),B,G) '<' 'not' All(All(a,B,G),A,G);

theorem 
  All('not' Ex(a,A,G),B,G) '<' 'not' All(All(a,B,G),A,G);

theorem 
  G is independent implies All(Ex('not' a,A,G),B,G) '<' 'not' All(
  All(a,B,G),A,G);

theorem 
  G is independent implies Ex(All('not' a,A,G),B,G) '<' 'not' All(All(a,
  B,G),A,G);

theorem 
  G is independent implies Ex('not' Ex(a,A,G),B,G) '<' 'not' All(
  All(a,B,G),A,G);

theorem 
  G is independent implies 'not' All(Ex(a,A,G),B,G) '<' 'not' Ex(All(a,B
  ,G),A,G);

theorem 
  G is independent implies 'not' Ex(Ex(a,A,G),B,G) '<' 'not' Ex(
  All(a,B,G),A,G);

theorem 
  'not' Ex(Ex(a,A,G),B,G) '<' 'not' All(Ex(a,B,G),A,G);

theorem 
  G is independent implies 'not' Ex(All(a,A,G),B,G) '<' 'not' All(All(a,
  B,G),A,G);

theorem 
  G is independent implies 'not' All(Ex(a,A,G),B,G) '<' 'not' All(All(a,
  B,G),A,G);

theorem 
  'not' Ex(Ex(a,A,G),B,G) '<' 'not' All(All(a,B,G),A,G);

theorem 
  G is independent implies 'not' Ex(All(a,A,G),B,G) '<' Ex('not'
  All(a,B,G),A,G);

theorem 
  G is independent implies 'not' All(Ex(a,A,G),B,G) '<' Ex('not'
  All(a,B,G),A,G);

theorem 
  'not' Ex(Ex(a,A,G),B,G) '<' Ex('not' All(a,B,G),A,G);

theorem 
  G is independent implies 'not' All(Ex(a,A,G),B,G) '<' All('not'
  All(a,B,G),A,G);

theorem 
  G is independent implies 'not' Ex(Ex(a,A,G),B,G) '<' All('not'
  All(a,B,G),A,G);

theorem 
  'not' Ex(Ex(a,A,G),B,G) '<' Ex('not' Ex(a,B,G),A,G);

theorem 
  G is independent implies 'not' Ex(Ex(a,A,G),B,G) = All('not' Ex( a,B,G),A,G);

theorem 
  G is independent implies 'not' All(Ex(a,A,G),B,G) '<' Ex(Ex(
  'not' a,B,G),A,G);

theorem 
  'not' Ex(Ex(a,A,G),B,G) '<' Ex(Ex('not' a,B,G),A,G);

theorem 
  G is independent implies 'not' All(Ex(a,A,G),B,G) '<' All(Ex(
  'not' a,B,G),A,G);

theorem 
  G is independent implies 'not' Ex(Ex(a,A,G),B,G) '<' All(Ex(
  'not' a,B,G),A,G);

theorem 
  'not' Ex(Ex(a,A,G),B,G) '<' Ex(All('not' a,B,G),A,G);

theorem 
  G is independent implies 'not' Ex(Ex(a,A,G),B,G) = All(All('not' a,B,G),A,G);

theorem 
  G is independent implies Ex('not' Ex(a,A,G),B,G) '<' 'not' Ex(All(a,B,
  G),A,G);

theorem 
  All('not' Ex(a,A,G),B,G) '<' 'not' Ex(All(a,B,G),A,G);

theorem 
  All('not' Ex(a,A,G),B,G) '<' 'not' All(Ex(a,B,G),A,G);

theorem 
  G is independent implies All('not' Ex(a,A,G),B,G) = 'not' Ex(Ex(a,B,G) ,A,G);

theorem 
  G is independent implies Ex('not' All(a,A,G),B,G) = Ex('not' All(a,B,G ),A,G)
;

theorem 
  G is independent implies All('not' All(a,A,G),B,G) '<' Ex('not' All(a,
  B,G),A,G);

theorem 
  G is independent implies Ex('not' Ex(a,A,G),B,G) '<' Ex('not' All(a,B,
  G),A,G);

theorem 
  All('not' Ex(a,A,G),B,G) '<' Ex('not' All(a,B,G),A,G);

theorem 
  G is independent implies Ex('not' Ex(a,A,G),B,G) '<' All('not' All(a,B
  ,G),A,G);

theorem 
  G is independent implies All('not' Ex(a,A,G),B,G) '<' All('not' All(a,
  B,G),A,G);

theorem 
  All('not' Ex(a,A,G),B,G) '<' Ex('not' Ex(a,B,G),A,G);

theorem 
  G is independent implies All('not' Ex(a,A,G),B,G) = All('not' Ex(a,B,G ),A,G)
;

theorem 
  G is independent implies Ex('not' Ex(a,A,G),B,G) '<' Ex(Ex('not' a,B,G ),A,G)
;

theorem 
  All('not' Ex(a,A,G),B,G) '<' Ex(Ex('not' a,B,G),A,G);

theorem 
  G is independent implies Ex('not' Ex(a,A,G),B,G) '<' All(Ex('not' a,B,
  G),A,G);

theorem 
  G is independent implies All('not' Ex(a,A,G),B,G) '<' All(Ex('not' a,B
  ,G),A,G);

theorem 
  All('not' Ex(a,A,G),B,G) '<' Ex(All('not' a,B,G),A,G);

theorem 
  G is independent implies All('not' Ex(a,A,G),B,G) = All(All('not' a,B,
  G),A,G);

theorem 
  G is independent implies Ex(All('not' a,A,G),B,G) '<' 'not' Ex(All(a,B
  ,G),A,G);

theorem 
  G is independent implies All(All('not' a,A,G),B,G) '<' 'not' Ex(All(a,
  B,G),A,G);

theorem 
  All(All('not' a,A,G),B,G) '<' 'not' All(Ex(a,B,G),A,G);

theorem 
  G is independent implies All(All('not' a,A,G),B,G) '<' 'not' Ex(Ex(a,B
  ,G),A,G);

theorem 
  G is independent implies Ex(Ex('not' a,A,G),B,G) '<' Ex('not' All(a,B,
  G),A,G);

theorem 
  G is independent implies All(Ex('not' a,A,G),B,G) '<' Ex('not' All(a,B
  ,G),A,G);

theorem 
  G is independent implies Ex(All('not' a,A,G),B,G) '<' Ex('not' All(a,B
  ,G),A,G);

theorem 
  All(All('not' a,A,G),B,G) '<' Ex('not' All(a,B,G),A,G);

theorem 
  G is independent implies Ex(All('not' a,A,G),B,G) '<' All('not' All(a,
  B,G),A,G);

theorem 
  G is independent implies All(All('not' a,A,G),B,G) '<' All('not' All(a
  ,B,G),A,G);

theorem 
  All(All('not' a,A,G),B,G) '<' Ex('not' Ex(a,B,G),A,G);

theorem 
  G is independent implies All(All('not' a,A,G),B,G) = All('not' Ex(a,B,
  G),A,G);

theorem 
  All(Ex('not' a,A,G),B,G) '<' Ex(Ex('not' a,B,G),A,G);

theorem 
  G is independent implies
    Ex(All('not' a,A,G),B,G) '<' Ex(Ex('not' a,B,G),A,G);














begin 

reserve Y for non empty set,
  G for Subset of PARTITIONS(Y),
  A,B,C,D,E,F for a_partition of Y;

theorem 
  for z being Element of Y, PA,PB being a_partition of Y holds
  EqClass(z,PA '/\' PB) = EqClass(z,PA) /\ EqClass(z,PB);

theorem 
  G={A,B} & A<>B implies '/\' G = A '/\' B;

theorem 
  G={B,C,D} & B<>C & C<>D & D<>B implies '/\' G = B '/\' C '/\' D;

theorem 
  G={A,B,C} & A<>B & C<>A implies CompF(A,G) = B '/\' C;

theorem 
  G={A,B,C} & A<>B & B<>C implies CompF(B,G) = C '/\' A;

theorem 
  G={A,B,C} & B<>C & C<>A implies CompF(C,G) = A '/\' B;

theorem 
  G={A,B,C,D} & A<>B & A<>C & A<>D implies CompF(A,G) = B '/\' C '/\' D;

theorem 
  G={A,B,C,D} & A<>B & B<>C & B<>D implies CompF(B,G) = A '/\' C '/\' D;

theorem 
  G={A,B,C,D} & A<>C & B<>C & C<>D implies CompF(C,G) = A '/\' B '/\' D;

theorem 
  G={A,B,C,D} & A<>D & B<>D & C<>D implies CompF(D,G) = A '/\' C '/\' B;

theorem 
  for B,C,D,b,c,d being set holds dom((B .--> b) +* (C .--> c) +* (D
  .--> d)) = {B,C,D};

theorem 
  for f being Function, C,D,c,d being set st C<>D holds (f +* (C .--> c)
  +* (D .--> d)).C = c;

theorem 
  for B,C,D,b,c,d being set st B<>C & D<>B holds ((B .--> b) +* (C .-->
  c) +* (D .--> d)).B = b;

theorem 
  for B,C,D,b,c,d being set, h being Function st h = (B .--> b) +* (C
  .--> c) +* (D .--> d) holds rng h = {h.B,h.C,h.D};



theorem 
  for h being Function, A9,B9,C9,D9 being set st A<>B & A<>C & A<>
  D & B<>C & B<>D & C<>D & h = (B .--> B9) +* (C .--> C9) +* (D .--> D9) +* (A
  .--> A9) holds h.B = B9 & h.C = C9 & h.D = D9;

theorem 
  for A,B,C,D being set,h being Function, A9,B9,C9,D9 being set st
h = (B .--> B9) +* (C .--> C9) +* (D .--> D9) +* (A .--> A9) holds dom h = {A,B
  ,C,D};

theorem 
  for h being Function,A9,B9,C9,D9 being set st G={A,B,C,D} & h =
(B .--> B9) +* (C .--> C9) +* (D .--> D9) +* (A .--> A9) holds rng h = {h.A,h.B
  ,h.C,h.D};

theorem 
  for z,u being Element of Y, h being Function st G is independent & G={
  A,B,C,D} & A<>B & A<>C & A<>D & B<>C & B<>D & C<>D holds EqClass(u,B '/\' C
  '/\' D) meets EqClass(z,A);

theorem 
  for z,u being Element of Y st G is independent & G={A,B,C,D} & A<>B &
  A<>C & A<>D & B<>C & B<>D & C<>D & EqClass(z,C '/\' D)=EqClass(u,C '/\' D)
  holds EqClass(u,CompF(A,G)) meets EqClass(z,CompF(B,G));

theorem 
  for z,u being Element of Y st G is independent & G={A,B,C} & A<>B & B
  <>C & C<>A & EqClass(z,C)=EqClass(u,C) holds EqClass(u,CompF(A,G)) meets
  EqClass(z,CompF(B,G));

theorem 
  G={A,B,C,D,E} & A<>B & A<>C & A<>D & A<>E implies CompF(A,G) = B
  '/\' C '/\' D '/\' E;

theorem 
  G={A,B,C,D,E} & A<>B & B<>C & B<>D & B<>E implies CompF(B,G) = A
  '/\' C '/\' D '/\' E;

theorem 
  G={A,B,C,D,E} & A<>C & B<>C & C<>D & C<>E implies CompF(C,G) = A
  '/\' B '/\' D '/\' E;

theorem 
  G={A,B,C,D,E} & A<>D & B<>D & C<>D & D<>E implies CompF(D,G) = A
  '/\' B '/\' C '/\' E;

theorem 
  G={A,B,C,D,E} & A<>E & B<>E & C<>E & D<>E implies CompF(E,G) = A '/\'
  B '/\' C '/\' D;

theorem 
  for A,B,C,D,E being set, h being Function, A9,B9,C9,D9,E9 being
set st A<>B & A<>C & A<>D & A<>E & B<>C & B<>D & B<>E & C<>D & C<>E & D<>E & h
= (B .--> B9) +* (C .--> C9) +* (D .--> D9) +* (E .--> E9) +* (A .--> A9) holds
  h.A = A9 & h.B = B9 & h.C = C9 & h.D = D9 & h.E = E9;

theorem 
  for A,B,C,D,E being set, h being Function, A9,B9,C9,D9,E9 being
set st h = (B .--> B9) +* (C .--> C9) +* (D .--> D9) +* (E .--> E9) +* (A .-->
  A9) holds dom h = {A,B,C,D,E};

theorem 
  for A,B,C,D,E being set, h being Function, A9,B9,C9,D9,E9 being
set st h = (B .--> B9) +* (C .--> C9) +* (D .--> D9) +* (E .--> E9) +* (A .-->
  A9) holds rng h = {h.A,h.B,h.C,h.D,h.E};

theorem 
  for G being Subset of PARTITIONS(Y), A,B,C,D,E being a_partition of Y,
z,u being Element of Y, h being Function st G is independent & G={A,B,C,D,E} &
  A<>B & A<>C & A<>D & A<>E & B<>C & B<>D & B<>E & C<>D & C<>E & D<>E holds
  EqClass(u,B '/\' C '/\' D '/\' E) meets EqClass(z,A);

theorem 
  for G being Subset of PARTITIONS(Y), A,B,C,D,E being a_partition of Y,
z,u being Element of Y st G is independent & G={A,B,C,D,E} & A<>B & A<>C & A<>D
& A<>E & B<>C & B<>D & B<>E & C<>D & C<>E & D<>E & EqClass(z,C '/\' D '/\' E)=
EqClass(u,C '/\' D '/\' E) holds EqClass(u,CompF(A,G)) meets EqClass(z,CompF(B,
  G));



theorem 
  G={A,B,C,D,E,F} & A<>B & A<>C & A<>D & A<>E & A<>F & B<>C & B<>D
& B<>E & B<>F & C<>D & C<>E & C<>F & D<>E & D<>F & E<>F implies CompF(A,G) = B
  '/\' C '/\' D '/\' E '/\' F;

theorem 
  G={A,B,C,D,E,F} & A<>B & A<>C & A<>D & A<>E & A<>F & B<>C & B<>D
& B<>E & B<>F & C<>D & C<>E & C<>F & D<>E & D<>F & E<>F implies CompF(B,G) = A
  '/\' C '/\' D '/\' E '/\' F;

theorem 
  G={A,B,C,D,E,F} & A<>B & A<>C & A<>D & A<>E & A<>F & B<>C & B<>D
& B<>E & B<>F & C<>D & C<>E & C<>F & D<>E & D<>F & E<>F implies CompF(C,G) = A
  '/\' B '/\' D '/\' E '/\' F;

theorem 
  G={A,B,C,D,E,F} & A<>B & A<>C & A<>D & A<>E & A<>F & B<>C & B<>D
& B<>E & B<>F & C<>D & C<>E & C<>F & D<>E & D<>F & E<>F implies CompF(D,G) = A
  '/\' B '/\' C '/\' E '/\' F;

theorem 
  G={A,B,C,D,E,F} & A<>B & A<>C & A<>D & A<>E & A<>F & B<>C & B<>D
& B<>E & B<>F & C<>D & C<>E & C<>F & D<>E & D<>F & E<>F implies CompF(E,G) = A
  '/\' B '/\' C '/\' D '/\' F;

theorem 
  G={A,B,C,D,E,F} & A<>B & A<>C & A<>D & A<>E & A<>F & B<>C & B<>D & B<>
E & B<>F & C<>D & C<>E & C<>F & D<>E & D<>F & E<>F implies CompF(F,G) = A '/\'
  B '/\' C '/\' D '/\' E;

theorem 
  for A,B,C,D,E,F being set, h being Function, A9,B9,C9,D9,E9,F9
being set st A<>B & A<>C & A<>D & A<>E & A<>F & B<>C & B<>D & B<>E & B<>F & C<>
  D & C<>E & C<>F & D<>E & D<>F & E<>F & h = (B .--> B9) +* (C .--> C9) +* (D
.--> D9) +* (E .--> E9) +* (F .--> F9) +* (A .--> A9) holds h.A = A9 & h.B = B9
  & h.C = C9 & h.D = D9 & h.E = E9 & h.F = F9;

theorem 
  for A,B,C,D,E,F being set, h being Function, A9,B9,C9,D9,E9,F9
being set st h = (B .--> B9) +* (C .--> C9) +* (D .--> D9) +* (E .--> E9) +* (F
  .--> F9) +* (A .--> A9) holds dom h = {A,B,C,D,E,F};

theorem 
  for A,B,C,D,E,F being set, h being Function, A9,B9,C9,D9,E9,F9
being set st h = (B .--> B9) +* (C .--> C9) +* (D .--> D9) +* (E .--> E9) +* (F
  .--> F9) +* (A .--> A9) holds rng h = {h.A,h.B,h.C,h.D,h.E,h.F};

theorem 
  for G being Subset of PARTITIONS(Y), A,B,C,D,E,F being a_partition of
Y, z,u being Element of Y, h being Function st G is independent & G={A,B,C,D,E,
F} & A<>B & A<>C & A<>D & A<>E & A<>F & B<>C & B<>D & B<>E & B<>F & C<>D & C<>E
  & C<>F & D<>E & D<>F & E<>F holds EqClass(u,B '/\' C '/\' D '/\' E '/\' F)
  meets EqClass(z,A);

theorem 
  for G being Subset of PARTITIONS(Y), A,B,C,D,E,F being a_partition of
Y, z,u being Element of Y, h being Function st G is independent & G={A,B,C,D,E,
F} & A<>B & A<>C & A<>D & A<>E & A<>F & B<>C & B<>D & B<>E & B<>F & C<>D & C<>E
  & C<>F & D<>E & D<>F & E<>F & EqClass(z,C '/\' D '/\' E '/\' F)=EqClass(u,C
  '/\' D '/\' E '/\' F) holds EqClass(u,CompF(A,G)) meets EqClass(z,CompF(B,G))
;

begin 

reserve Y for non empty set,
  G for Subset of PARTITIONS(Y),
  A, B, C, D, E, F, J, M for a_partition of Y,
  x,x1,x2,x3,x4,x5,x6,x7,x8,x9 for set;

theorem 
  G={A,B,C,D,E,F,J} & A<>B & A<>C & A<>D & A<>E & A<>F & A<>J & B
<>C & B<>D & B<>E & B<>F & B<>J & C<>D & C<>E & C<>F & C<>J & D<>E & D<>F & D<>
J & E<>F & E<>J & F<>J implies CompF(A,G) = B '/\' C '/\' D '/\' E '/\' F '/\'
  J;

theorem 
  G={A,B,C,D,E,F,J} & A<>B & A<>C & A<>D & A<>E & A<>F & A<>J & B
<>C & B<>D & B<>E & B<>F & B<>J & C<>D & C<>E & C<>F & C<>J & D<>E & D<>F & D<>
J & E<>F & E<>J & F<>J implies CompF(B,G) = A '/\' C '/\' D '/\' E '/\' F '/\'
  J;

theorem 
  G={A,B,C,D,E,F,J} & A<>B & A<>C & A<>D & A<>E & A<>F & A<>J & B
<>C & B<>D & B<>E & B<>F & B<>J & C<>D & C<>E & C<>F & C<>J & D<>E & D<>F & D<>
J & E<>F & E<>J & F<>J implies CompF(C,G) = A '/\' B '/\' D '/\' E '/\' F '/\'
  J;

theorem 
  G={A,B,C,D,E,F,J} & A<>B & A<>C & A<>D & A<>E & A<>F & A<>J & B
<>C & B<>D & B<>E & B<>F & B<>J & C<>D & C<>E & C<>F & C<>J & D<>E & D<>F & D<>
J & E<>F & E<>J & F<>J implies CompF(D,G) = A '/\' B '/\' C '/\' E '/\' F '/\'
  J;

theorem 
  G={A,B,C,D,E,F,J} & A<>B & A<>C & A<>D & A<>E & A<>F & A<>J & B
<>C & B<>D & B<>E & B<>F & B<>J & C<>D & C<>E & C<>F & C<>J & D<>E & D<>F & D<>
J & E<>F & E<>J & F<>J implies CompF(E,G) = A '/\' B '/\' C '/\' D '/\' F '/\'
  J;

theorem 
  G={A,B,C,D,E,F,J} & A<>B & A<>C & A<>D & A<>E & A<>F & A<>J & B
<>C & B<>D & B<>E & B<>F & B<>J & C<>D & C<>E & C<>F & C<>J & D<>E & D<>F & D<>
J & E<>F & E<>J & F<>J implies CompF(F,G) = A '/\' B '/\' C '/\' D '/\' E '/\'
  J;

theorem 
  G={A,B,C,D,E,F,J} & A<>B & A<>C & A<>D & A<>E & A<>F & A<>J & B<>C & B
<>D & B<>E & B<>F & B<>J & C<>D & C<>E & C<>F & C<>J & D<>E & D<>F & D<>J & E<>
  F & E<>J & F<>J implies CompF(J,G) = A '/\' B '/\' C '/\' D '/\' E '/\' F;

theorem 
  for A,B,C,D,E,F,J being set, h being Function, A9,B9,C9,D9,E9,F9
,J9 being set st A<>B & A<>C & A<>D & A<>E & A<>F & A<>J & B<>C & B<>D & B<>E &
B<>F & B<>J & C<>D & C<>E & C<>F & C<>J & D<>E & D<>F & D<>J & E<>F & E<>J & F
  <>J & h = (B .--> B9) +* (C .--> C9) +* (D .--> D9) +* (E .--> E9) +* (F .-->
F9) +* (J .--> J9) +* (A .--> A9) holds h.A = A9 & h.B = B9 & h.C = C9 & h.D =
  D9 & h.E = E9 & h.F = F9 & h.J = J9;

theorem 
  for A,B,C,D,E,F,J being set, h being Function, A9,B9,C9,D9,E9,F9
  ,J9 being set st h = (B .--> B9) +* (C .--> C9) +* (D .--> D9) +* (E .--> E9)
  +* (F .--> F9) +* (J .--> J9) +* (A .--> A9) holds dom h = {A,B,C,D,E,F,J};

theorem 
  for A,B,C,D,E,F,J being set, h being Function, A9,B9,C9,D9,E9,F9
  ,J9 being set st h = (B .--> B9) +* (C .--> C9) +* (D .--> D9) +* (E .--> E9)
+* (F .--> F9) +* (J .--> J9) +* (A .--> A9) holds rng h = {h.A,h.B,h.C,h.D,h.E
  ,h.F,h.J};

theorem 
  for G being Subset of PARTITIONS(Y), A,B,C,D,E,F,J being a_partition
of Y, z,u being Element of Y st G is independent & G={A,B,C,D,E,F,J} & A<>B & A
<>C & A<>D & A<>E & A<>F & A<>J & B<>C & B<>D & B<>E & B<>F & B<>J & C<>D & C<>
  E & C<>F & C<>J & D<>E & D<>F & D<>J & E<>F & E<>J & F<>J holds EqClass(u,B
  '/\' C '/\' D '/\' E '/\' F '/\' J) meets EqClass(z,A);

theorem 
  for G being Subset of PARTITIONS(Y), A,B,C,D,E,F,J being a_partition
of Y, z,u being Element of Y st G is independent & G={A,B,C,D,E,F,J} & A<>B & A
<>C & A<>D & A<>E & A<>F & A<>J & B<>C & B<>D & B<>E & B<>F & B<>J & C<>D & C<>
E & C<>F & C<>J & D<>E & D<>F & D<>J & E<>F & E<>J & F<>J & EqClass(z,C '/\' D
'/\' E '/\' F '/\' J)= EqClass(u,C '/\' D '/\' E '/\' F '/\' J) holds EqClass(u
  ,CompF(A,G)) meets EqClass(z,CompF(B,G));

theorem 
  G={A,B,C,D,E,F,J,M} & A<>B & A<>C & A<>D & A<>E & A<>F & A<>J &
A<>M & B<>C & B<>D & B<>E & B<>F & B<>J & B<>M & C<>D & C<>E & C<>F & C<>J & C
  <>M & D<>E & D<>F & D<>J & D<>M & E<>F & E<>J & E<>M & F<>J & F<>M & J<>M
  implies CompF(A,G) = B '/\' C '/\' D '/\' E '/\' F '/\' J '/\' M;

theorem 
  G={A,B,C,D,E,F,J,M} & A<>B & A<>C & A<>D & A<>E & A<>F & A<>J &
A<>M & B<>C & B<>D & B<>E & B<>F & B<>J & B<>M & C<>D & C<>E & C<>F & C<>J & C
  <>M & D<>E & D<>F & D<>J & D<>M & E<>F & E<>J & E<>M & F<>J & F<>M & J<>M
  implies CompF(B,G) = A '/\' C '/\' D '/\' E '/\' F '/\' J '/\' M;

theorem 
  G={A,B,C,D,E,F,J,M} & A<>B & A<>C & A<>D & A<>E & A<>F & A<>J &
A<>M & B<>C & B<>D & B<>E & B<>F & B<>J & B<>M & C<>D & C<>E & C<>F & C<>J & C
  <>M & D<>E & D<>F & D<>J & D<>M & E<>F & E<>J & E<>M & F<>J & F<>M & J<>M
  implies CompF(C,G) = A '/\' B '/\' D '/\' E '/\' F '/\' J '/\' M;

theorem 
  G={A,B,C,D,E,F,J,M} & A<>B & A<>C & A<>D & A<>E & A<>F & A<>J &
A<>M & B<>C & B<>D & B<>E & B<>F & B<>J & B<>M & C<>D & C<>E & C<>F & C<>J & C
  <>M & D<>E & D<>F & D<>J & D<>M & E<>F & E<>J & E<>M & F<>J & F<>M & J<>M
  implies CompF(D,G) = A '/\' B '/\' C '/\' E '/\' F '/\' J '/\' M;

theorem 
  G={A,B,C,D,E,F,J,M} & A<>B & A<>C & A<>D & A<>E & A<>F & A<>J &
A<>M & B<>C & B<>D & B<>E & B<>F & B<>J & B<>M & C<>D & C<>E & C<>F & C<>J & C
  <>M & D<>E & D<>F & D<>J & D<>M & E<>F & E<>J & E<>M & F<>J & F<>M & J<>M
  implies CompF(E,G) = A '/\' B '/\' C '/\' D '/\' F '/\' J '/\' M;

theorem 
  G={A,B,C,D,E,F,J,M} & A<>B & A<>C & A<>D & A<>E & A<>F & A<>J &
A<>M & B<>C & B<>D & B<>E & B<>F & B<>J & B<>M & C<>D & C<>E & C<>F & C<>J & C
  <>M & D<>E & D<>F & D<>J & D<>M & E<>F & E<>J & E<>M & F<>J & F<>M & J<>M
  implies CompF(F,G) = A '/\' B '/\' C '/\' D '/\' E '/\' J '/\' M;

theorem 
  G={A,B,C,D,E,F,J,M} & A<>B & A<>C & A<>D & A<>E & A<>F & A<>J &
A<>M & B<>C & B<>D & B<>E & B<>F & B<>J & B<>M & C<>D & C<>E & C<>F & C<>J & C
  <>M & D<>E & D<>F & D<>J & D<>M & E<>F & E<>J & E<>M & F<>J & F<>M & J<>M
  implies CompF(J,G) = A '/\' B '/\' C '/\' D '/\' E '/\' F '/\' M;

theorem 
  G={A,B,C,D,E,F,J,M} & A<>B & A<>C & A<>D & A<>E & A<>F & A<>J & A<>M &
B<>C & B<>D & B<>E & B<>F & B<>J & B<>M & C<>D & C<>E & C<>F & C<>J & C<>M & D
  <>E & D<>F & D<>J & D<>M & E<>F & E<>J & E<>M & F<>J & F<>M & J<>M implies
  CompF(M,G) = A '/\' B '/\' C '/\' D '/\' E '/\' F '/\' J;

theorem 
  for A,B,C,D,E,F,J,M being set, h being Function, A9,B9,C9,D9,E9,
F9,J9,M9 being set st A<>B & A<>C & A<>D & A<>E & A<>F & A<>J & B<>C & B<>D & B
<>E & B<>F & B<>J & B<>M & C<>D & C<>E & C<>F & C<>J & C<>M & D<>E & D<>F & D<>
J & D<>M & E<>F & E<>J & E<>M & F<>J & F<>M & J<>M & h = (B .--> B9) +* (C .-->
C9) +* (D .--> D9) +* (E .--> E9) +* (F .--> F9) +* (J .--> J9) +* (M .--> M9)
+* (A .--> A9) holds h.B = B9 & h.C = C9 & h.D = D9 & h.E = E9 & h.F = F9 & h.J
  = J9;

theorem 
  for A,B,C,D,E,F,J,M being set, h being Function, A9,B9,C9,D9,E9,
F9,J9,M9 being set st h = (B .--> B9) +* (C .--> C9) +* (D .--> D9) +* (E .-->
E9) +* (F .--> F9) +* (J .--> J9) +* (M .--> M9) +* (A .--> A9) holds dom h = {
  A,B,C,D,E,F,J,M};

theorem 
  for A,B,C,D,E,F,J,M being set, h being Function, A9,B9,C9,D9,E9,
F9,J9,M9 being set st h = (B .--> B9) +* (C .--> C9) +* (D .--> D9) +* (E .-->
E9) +* (F .--> F9) +* (J .--> J9) +* (M .--> M9) +* (A .--> A9) holds rng h = {
  h.A,h.B,h.C,h.D,h.E,h.F,h.J,h.M};

theorem 
  for G being Subset of PARTITIONS(Y), A,B,C,D,E,F,J,M being a_partition
of Y, z,u being Element of Y st G is independent & G={A,B,C,D,E,F,J,M} & A<>B &
A<>C & A<>D & A<>E & A<>F & A<>J & A<>M & B<>C & B<>D & B<>E & B<>F & B<>J & B
<>M & C<>D & C<>E & C<>F & C<>J & C<>M & D<>E & D<>F & D<>J & D<>M & E<>F & E<>
  J & E<>M & F<>J & F<>M & J<>M holds EqClass(u,B '/\' C '/\' D '/\' E '/\' F
  '/\' J '/\' M) /\ EqClass(z,A) <> {};

theorem 
  for G being Subset of PARTITIONS(Y), A,B,C,D,E,F,J,M being a_partition
of Y, z,u being Element of Y st G is independent & G={A,B,C,D,E,F,J,M} & A<>B &
A<>C & A<>D & A<>E & A<>F & A<>J & A<>M & B<>C & B<>D & B<>E & B<>F & B<>J & B
<>M & C<>D & C<>E & C<>F & C<>J & C<>M & D<>E & D<>F & D<>J & D<>M & E<>F & E<>
J & E<>M & F<>J & F<>M & J<>M & EqClass(z,C '/\' D '/\' E '/\' F '/\' J '/\' M)
  = EqClass(u,C '/\' D '/\' E '/\' F '/\' J '/\' M) holds EqClass(u,CompF(A,G))
  meets EqClass(z,CompF(B,G));

theorem 
  for G being Subset of PARTITIONS(Y), A,B,C,D,E,F,J,M,N being
a_partition of Y st G={A,B,C,D,E,F,J,M,N} & A<>B & A<>C & A<>D & A<>E & A<>F &
A<>J & A<>M & A<>N & B<>C & B<>D & B<>E & B<>F & B<>J & B<>M & B<>N & C<>D & C
<>E & C<>F & C<>J & C<>M & C<>N & D<>E & D<>F & D<>J & D<>M & D<>N & E<>F & E<>
J & E<>M & E<>N & F<>J & F<>M & F<>N & J<>M & J<>N & M<>N holds CompF(A,G) = B
  '/\' C '/\' D '/\' E '/\' F '/\' J '/\' M '/\' N;

theorem 
  for G being Subset of PARTITIONS(Y), A,B,C,D,E,F,J,M,N being
a_partition of Y st G={A,B,C,D,E,F,J,M,N} & A<>B & A<>C & A<>D & A<>E & A<>F &
A<>J & A<>M & A<>N & B<>C & B<>D & B<>E & B<>F & B<>J & B<>M & B<>N & C<>D & C
<>E & C<>F & C<>J & C<>M & C<>N & D<>E & D<>F & D<>J & D<>M & D<>N & E<>F & E<>
J & E<>M & E<>N & F<>J & F<>M & F<>N & J<>M & J<>N & M<>N holds CompF(B,G) = A
  '/\' C '/\' D '/\' E '/\' F '/\' J '/\' M '/\' N;

theorem 
  for G being Subset of PARTITIONS(Y), A,B,C,D,E,F,J,M,N being
a_partition of Y st G={A,B,C,D,E,F,J,M,N} & A<>B & A<>C & A<>D & A<>E & A<>F &
A<>J & A<>M & A<>N & B<>C & B<>D & B<>E & B<>F & B<>J & B<>M & B<>N & C<>D & C
<>E & C<>F & C<>J & C<>M & C<>N & D<>E & D<>F & D<>J & D<>M & D<>N & E<>F & E<>
J & E<>M & E<>N & F<>J & F<>M & F<>N & J<>M & J<>N & M<>N holds CompF(C,G) = A
  '/\' B '/\' D '/\' E '/\' F '/\' J '/\' M '/\' N;

theorem 
  for G being Subset of PARTITIONS(Y), A,B,C,D,E,F,J,M,N being
a_partition of Y st G={A,B,C,D,E,F,J,M,N} & A<>B & A<>C & A<>D & A<>E & A<>F &
A<>J & A<>M & A<>N & B<>C & B<>D & B<>E & B<>F & B<>J & B<>M & B<>N & C<>D & C
<>E & C<>F & C<>J & C<>M & C<>N & D<>E & D<>F & D<>J & D<>M & D<>N & E<>F & E<>
J & E<>M & E<>N & F<>J & F<>M & F<>N & J<>M & J<>N & M<>N holds CompF(D,G) = A
  '/\' B '/\' C '/\' E '/\' F '/\' J '/\' M '/\' N;

theorem 
  for G being Subset of PARTITIONS(Y), A,B,C,D,E,F,J,M,N being
a_partition of Y st G={A,B,C,D,E,F,J,M,N} & A<>B & A<>C & A<>D & A<>E & A<>F &
A<>J & A<>M & A<>N & B<>C & B<>D & B<>E & B<>F & B<>J & B<>M & B<>N & C<>D & C
<>E & C<>F & C<>J & C<>M & C<>N & D<>E & D<>F & D<>J & D<>M & D<>N & E<>F & E<>
J & E<>M & E<>N & F<>J & F<>M & F<>N & J<>M & J<>N & M<>N holds CompF(E,G) = A
  '/\' B '/\' C '/\' D '/\' F '/\' J '/\' M '/\' N;

theorem 
  for G being Subset of PARTITIONS(Y), A,B,C,D,E,F,J,M,N being
a_partition of Y st G={A,B,C,D,E,F,J,M,N} & A<>B & A<>C & A<>D & A<>E & A<>F &
A<>J & A<>M & A<>N & B<>C & B<>D & B<>E & B<>F & B<>J & B<>M & B<>N & C<>D & C
<>E & C<>F & C<>J & C<>M & C<>N & D<>E & D<>F & D<>J & D<>M & D<>N & E<>F & E<>
J & E<>M & E<>N & F<>J & F<>M & F<>N & J<>M & J<>N & M<>N holds CompF(F,G) = A
  '/\' B '/\' C '/\' D '/\' E '/\' J '/\' M '/\' N;

theorem 
  for G being Subset of PARTITIONS(Y), A,B,C,D,E,F,J,M,N being
a_partition of Y st G={A,B,C,D,E,F,J,M,N} & A<>B & A<>C & A<>D & A<>E & A<>F &
A<>J & A<>M & A<>N & B<>C & B<>D & B<>E & B<>F & B<>J & B<>M & B<>N & C<>D & C
<>E & C<>F & C<>J & C<>M & C<>N & D<>E & D<>F & D<>J & D<>M & D<>N & E<>F & E<>
J & E<>M & E<>N & F<>J & F<>M & F<>N & J<>M & J<>N & M<>N holds CompF(J,G) = A
  '/\' B '/\' C '/\' D '/\' E '/\' F '/\' M '/\' N;

theorem 
  for G being Subset of PARTITIONS(Y), A,B,C,D,E,F,J,M,N being
a_partition of Y st G={A,B,C,D,E,F,J,M,N} & A<>B & A<>C & A<>D & A<>E & A<>F &
A<>J & A<>M & A<>N & B<>C & B<>D & B<>E & B<>F & B<>J & B<>M & B<>N & C<>D & C
<>E & C<>F & C<>J & C<>M & C<>N & D<>E & D<>F & D<>J & D<>M & D<>N & E<>F & E<>
J & E<>M & E<>N & F<>J & F<>M & F<>N & J<>M & J<>N & M<>N holds CompF(M,G) = A
  '/\' B '/\' C '/\' D '/\' E '/\' F '/\' J '/\' N;

theorem 
  for G being Subset of PARTITIONS(Y), A,B,C,D,E,F,J,M,N being
a_partition of Y st G={A,B,C,D,E,F,J,M,N} & A<>B & A<>C & A<>D & A<>E & A<>F &
A<>J & A<>M & A<>N & B<>C & B<>D & B<>E & B<>F & B<>J & B<>M & B<>N & C<>D & C
<>E & C<>F & C<>J & C<>M & C<>N & D<>E & D<>F & D<>J & D<>M & D<>N & E<>F & E<>
J & E<>M & E<>N & F<>J & F<>M & F<>N & J<>M & J<>N & M<>N holds CompF(N,G) = A
  '/\' B '/\' C '/\' D '/\' E '/\' F '/\' J '/\' M;

theorem 
  for A,B,C,D,E,F,J,M,N being set, h being Function, A9,B9,C9,D9,
E9,F9,J9,M9,N9 being set st A<>B & A<>C & A<>D & A<>E & A<>F & A<>J & A<>M & A
<>N & B<>C & B<>D & B<>E & B<>F & B<>J & B<>M & B<>N & C<>D & C<>E & C<>F & C<>
J & C<>M & C<>N & D<>E & D<>F & D<>J & D<>M & D<>N & E<>F & E<>J & E<>M & E<>N
& F<>J & F<>M & F<>N & J<>M & J<>N & M<>N & h = (B .--> B9) +* (C .--> C9) +* (
  D .--> D9) +* (E .--> E9) +* (F .--> F9) +* (J .--> J9) +* (M .--> M9) +* (N
.--> N9) +* (A .--> A9) holds h.A = A9 & h.B = B9 & h.C = C9 & h.D = D9 & h.E =
  E9 & h.F = F9 & h.J = J9 & h.M = M9 & h.N = N9;

theorem 
  for A,B,C,D,E,F,J,M,N being set, h being Function, A9,B9,C9,D9,
E9,F9,J9,M9,N9 being set st h = (B .--> B9) +* (C .--> C9) +* (D .--> D9) +* (E
.--> E9) +* (F .--> F9) +* (J .--> J9) +* (M .--> M9) +* (N .--> N9) +* (A .-->
  A9) holds dom h = {A,B,C,D,E,F,J,M,N};

theorem 
  for A,B,C,D,E,F,J,M,N being set, h being Function, A9,B9,C9,D9,
E9,F9,J9,M9,N9 being set st h = (B .--> B9) +* (C .--> C9) +* (D .--> D9) +* (E
.--> E9) +* (F .--> F9) +* (J .--> J9) +* (M .--> M9) +* (N .--> N9) +* (A .-->
  A9) holds rng h = {h.A,h.B,h.C,h.D,h.E,h.F,h.J,h.M,h.N};

theorem 
  for G being Subset of PARTITIONS(Y), A,B,C,D,E,F,J,M,N being
a_partition of Y, z,u being Element of Y st G is independent & G={A,B,C,D,E,F,J
,M,N} & A<>B & A<>C & A<>D & A<>E & A<>F & A<>J & A<>M & A<>N & B<>C & B<>D & B
<>E & B<>F & B<>J & B<>M & B<>N & C<>D & C<>E & C<>F & C<>J & C<>M & C<>N & D<>
E & D<>F & D<>J & D<>M & D<>N & E<>F & E<>J & E<>M & E<>N & F<>J & F<>M & F<>N
& J<>M & J<>N & M<>N holds EqClass(u,B '/\' C '/\' D '/\' E '/\' F '/\' J '/\'
  M '/\' N) /\ EqClass(z,A) <> {};

theorem 
  for G being Subset of PARTITIONS(Y), A,B,C,D,E,F,J,M,N being
a_partition of Y, z,u being Element of Y st G is independent & G={A,B,C,D,E,F,J
,M,N} & A<>B & A<>C & A<>D & A<>E & A<>F & A<>J & A<>M & A<>N & B<>C & B<>D & B
<>E & B<>F & B<>J & B<>M & B<>N & C<>D & C<>E & C<>F & C<>J & C<>M & C<>N & D<>
E & D<>F & D<>J & D<>M & D<>N & E<>F & E<>J & E<>M & E<>N & F<>J & F<>M & F<>N
& J<>M & J<>N & M<>N & EqClass(z,C '/\' D '/\' E '/\' F '/\' J '/\' M '/\' N)=
EqClass(u,C '/\' D '/\' E '/\' F '/\' J '/\' M '/\' N) holds EqClass(u,CompF(A,
  G)) meets EqClass(z,CompF(B,G));














begin

reserve Y for non empty set,
  a,b,c,d for Function of Y,BOOLEAN;

theorem 
  'not' (a 'imp' b) = a '&' 'not' b;

theorem 
  ('not' b 'imp' 'not' a) 'imp' (a 'imp' b)=I_el(Y);

theorem 
  a 'imp' b = 'not' b 'imp' 'not' a;

theorem 
  a 'eqv' b = 'not' a 'eqv' 'not' b;

theorem 
  a 'imp' b = a 'imp' (a '&' b);

theorem 
  a 'eqv' b = (a 'or' b) 'imp' (a '&' b);

theorem 
  a 'eqv' 'not' a = O_el(Y);

theorem 
  a 'imp' (b 'imp' c) = b 'imp' (a 'imp' c);

theorem 
  a 'imp' (b 'imp' c) = (a 'imp' b) 'imp' (a 'imp' c);

theorem 
  a 'eqv' b = a 'xor' 'not' b;

theorem 
  a '&' (b 'xor' c) = a '&' b 'xor' a '&' c;

theorem 
  a 'eqv' b = 'not' (a 'xor' b);

theorem 
  a 'xor' a = O_el(Y);

theorem 
  a 'xor' 'not' a = I_el(Y);

theorem 
  (a 'imp' b) 'imp' (b 'imp' a) = b 'imp' a;

theorem 
  (a 'or' b) '&' ('not' a 'or' 'not' b) = ('not' a '&' b) 'or' (a '&' 'not' b);

theorem 
  (a '&' b) 'or' ('not' a '&' 'not' b) = ('not' a 'or' b) '&' (a 'or' 'not' b);

theorem 
  a 'xor' (b 'xor' c) = (a 'xor' b) 'xor' c;

theorem 
  a 'eqv' (b 'eqv' c) = (a 'eqv' b) 'eqv' c;

theorem 
  'not' 'not' a 'imp' a = I_el(Y);

theorem 
  ((a 'imp' b) '&' a) 'imp' b = I_el(Y);

theorem 
  a 'imp' ('not' a 'imp' a) = I_el(Y);

theorem 
  ('not' a 'imp' a) 'eqv' a = I_el(Y);

theorem 
  a 'or' (a 'imp' b) = I_el(Y);

theorem 
  (a 'imp' b) 'or' (c 'imp' a) = I_el(Y);

theorem 
  (a 'imp' b) 'or' ('not' a 'imp' b) = I_el(Y);

theorem 
  (a 'imp' b) 'or' (a 'imp' 'not' b) = I_el(Y);

theorem 
  'not' a 'imp' ('not' b 'eqv' (b 'imp' a)) = I_el(Y);

theorem 
  (a 'imp' b) 'imp' (((a 'imp' c) 'imp' b) 'imp' b) = I_el(Y);

theorem 
  a 'imp' b = a 'eqv' (a '&' b);

theorem 
  a 'imp' b=I_el(Y) & b 'imp' a=I_el(Y) iff a=b;

theorem 
  a = 'not' a 'imp' a;

theorem 
  a 'imp' ((a 'imp' b) 'imp' a) = I_el(Y);

theorem 
  a = (a 'imp' b) 'imp' a;

theorem 
  a = (b 'imp' a) '&' ('not' b 'imp' a);

theorem 
  a '&' b = 'not' (a 'imp' 'not' b);

theorem 
  a 'or' b = 'not' a 'imp' b;

theorem 
  a 'or' b = (a 'imp' b) 'imp' b;

theorem 
  (a 'imp' b) 'imp' (a 'imp' a) = I_el(Y);

theorem 
  (a 'imp' (b 'imp' c)) 'imp' ((d 'imp' b) 'imp' (a 'imp' (d 'imp' c)))
  = I_el ( Y );

theorem 
  (((a 'imp' b) '&' a) '&' c) 'imp' b = I_el(Y);

theorem 
  (b 'imp' c) 'imp' ((a '&' b) 'imp' c) = I_el(Y);

theorem 
  ((a '&' b) 'imp' c) 'imp' ((a '&' b) 'imp' (c '&' b)) = I_el(Y);

theorem 
  (a 'imp' b) 'imp' ((a '&' c) 'imp' (b '&' c)) = I_el(Y);

theorem 
  (a 'imp' b) '&' (a '&' c) 'imp' (b '&' c) = I_el(Y);

theorem 
  a '&' (a 'imp' b) '&' (b 'imp' c) '<' c;

theorem 
  (a 'or' b) '&' (a 'imp' c) '&' (b 'imp' c) '<' ('not' a 'imp' (b 'or' c));














begin

reserve Y for non empty set,
  a,b,c for Function of Y,BOOLEAN;

definition
  let p,q be boolean-valued Function;
  func p 'nand' q -> Function means


  dom it = dom p /\ dom q & for x
  being set st x in dom it holds it.x = (p.x) 'nand' (q.x);
  commutativity;
  func p 'nor' q -> Function means


  dom it = dom p /\ dom q & for x
  being set st x in dom it holds it.x = (p.x) 'nor' (q.x);
  commutativity;
end;

registration
  let p,q be boolean-valued Function;
  cluster p 'nand' q -> boolean-valued;
  cluster p 'nor' q -> boolean-valued;
end;

definition
  let A be non empty set;
  let p,q be Function of A,BOOLEAN;
  redefine func p 'nand' q -> Function of A,BOOLEAN means


  for x being Element of A holds it.x = (p.x) 'nand' (q.x);
  redefine func p 'nor' q -> Function of A,BOOLEAN means


  for x being Element of A holds it.x = (p.x) 'nor' (q.x);
end;

definition
  let Y;
  let a,b be Function of Y,BOOLEAN;
  redefine func a 'nand' b ->Function of Y,BOOLEAN;
  redefine func a 'nor' b ->Function of Y,BOOLEAN;
end;

theorem 
  a 'nand' b = 'not' (a '&' b);

theorem 
  a 'nor' b = 'not' (a 'or' b);

theorem 
  I_el(Y) 'nand' a = 'not' a;

theorem 
  O_el(Y) 'nand' a = I_el(Y);

theorem 
  O_el(Y) 'nand' O_el(Y) = I_el(Y) & O_el(Y) 'nand' I_el(Y) = I_el(Y) &
  I_el(Y) 'nand' I_el(Y) = O_el(Y);

theorem 
  a 'nand' a = 'not' a & 'not' (a 'nand' a) = a;

theorem 
  'not' (a 'nand' b) = a '&' b;

theorem 
  a 'nand' 'not' a = I_el(Y) & 'not' (a 'nand' 'not' a) = O_el(Y);

theorem 
  a 'nand' (b '&' c) = 'not' (a '&' b '&' c);

theorem 
  a 'nand' (b '&' c) = (a '&' b) 'nand' c;

theorem 
  a 'nand' (b 'or' c) = 'not' (a '&' b) '&' 'not' (a '&' c);

theorem 
  a 'nand' (b 'xor' c) = (a '&' b) 'eqv' (a '&' c);

theorem 
  a 'nand' (b 'nand' c) = 'not' a 'or' (b '&' c) & a 'nand' (b 'nand' c)
  = a 'imp' (b '&' c);

theorem 
  a 'nand' (b 'nor' c) = 'not' a 'or' b 'or' c & a 'nand' (b 'nor' c) =
  a 'imp' (b 'or' c);

theorem 
  a 'nand' (b 'eqv' c) = a 'imp' (b 'xor' c);

theorem 
  a 'nand' (a '&' b) = a 'nand' b;

theorem 
  a 'nand' (a 'or' b) = 'not' a '&' 'not' (a '&' b);

theorem 
  a 'nand' (a 'eqv' b) = a 'imp' (a 'xor' b);

theorem 
  a 'nand' (a 'nand' b) = 'not' a 'or' b & a 'nand' (a 'nand' b) = a 'imp' b;

theorem 
  a 'nand' (a 'nor' b) = I_el(Y);

theorem 
  a 'nand' (a 'eqv' b) = 'not' a 'or' 'not' b;

theorem 
  a '&' b = (a 'nand' b) 'nand' (a 'nand' b);

theorem 
  (a 'nand' b) 'nand' (a 'nand' c) = a '&' (b 'or' c);

theorem 
  a 'nand' (b 'imp' c) = ('not' a 'or' b) '&' 'not' (a '&' c);

theorem 
  a 'nand' (a 'imp' b) = 'not' (a '&' b);

theorem 
  I_el(Y) 'nor' a = O_el(Y);

theorem 
  O_el(Y) 'nor' a = 'not' a;

theorem 
  O_el(Y) 'nor' O_el(Y) = I_el(Y) & O_el(Y) 'nor' I_el(Y) = O_el(Y) &
  I_el(Y) 'nor' I_el(Y) = O_el(Y);

theorem 
  a 'nor' a = 'not' a & 'not' (a 'nor' a) = a;

theorem 
  'not' (a 'nor' b) = a 'or' b;

theorem 
  a 'nor' 'not' a = O_el(Y) & 'not' (a 'nor' 'not' a) = I_el(Y);

theorem 
  'not' a '&' (a 'xor' b) = 'not' a '&' b;

theorem 
  a 'nor' (b '&' c) = 'not' (a 'or' b) 'or' 'not' (a 'or' c);

theorem 
  a 'nor' (b 'or' c) = 'not' (a 'or' b 'or' c);

theorem 
  a 'nor' (b 'eqv' c) = ('not' a) '&' (b 'xor' c);

theorem 
  a 'nor' (b 'imp' c) = 'not' a '&' b '&' 'not' c;

theorem 
  a 'nor' (b 'nand' c) = 'not' a '&' b '&' c;

theorem 
  a 'nor' (b 'nor' c) = 'not' a '&' (b 'or' c);

theorem 
  a 'nor' (a '&' b) = 'not' (a '&' (a 'or' b));

theorem 
  a 'nor' (a 'or' b) = 'not' (a 'or' b);

theorem 
  a 'nor' (a 'eqv' b) = 'not' a '&' b;

theorem 
  a 'nor' (a 'imp' b) = O_el(Y);

theorem 
  a 'nor' (a 'nand' b) = O_el(Y);

theorem 
  a 'nor' (a 'nor' b) = 'not' a '&' b;

theorem 
  O_el(Y) 'eqv' O_el(Y) = I_el(Y);

theorem 
  O_el(Y) 'eqv' I_el(Y) = O_el(Y);

theorem 
  I_el(Y) 'eqv' I_el(Y) = I_el(Y);

theorem 
  a 'eqv' a = I_el(Y) & 'not' (a 'eqv' a) = O_el(Y);

theorem 
  a 'eqv' (a 'or' b) = a 'or' 'not' b;

theorem 
  a '&' (b 'nand' c) = (a '&' 'not' b) 'or' (a '&' 'not' c);

theorem 
  a 'or' (b 'nand' c) = a 'or' 'not' b 'or' 'not' c;

theorem 
  a 'xor' (b 'nand' c) = ('not' a '&' 'not' (b '&' c)) 'or' (a '&' b '&' c);

theorem 
  a 'eqv' (b 'nand' c) = (a '&' 'not' (b '&' c)) 'or' ('not' a '&' b '&' c);

theorem 
  a 'imp' (b 'nand' c) = 'not' (a '&' b '&' c);

theorem 
  a 'nor' (b 'nand' c) = 'not' (a 'or' 'not' b 'or' 'not' c);

theorem 
  a '&' (a 'nand' b) = a '&' 'not' b;

theorem 
  a 'or' (a 'nand' b) = I_el(Y);

theorem 
  a 'xor' (a 'nand' b) = 'not' a 'or' b;

theorem 
  a 'eqv' (a 'nand' b) = a '&' 'not' b;

theorem 
  a 'imp' (a 'nand' b) = 'not' (a '&' b);

theorem 
  a 'nor' (a 'nand' b) = O_el(Y);

theorem 
  a '&' (b 'nor' c) = a '&' 'not' b '&' 'not' c;

theorem 
  a 'or' (b 'nor' c) = (a 'or' 'not' b) '&' (a 'or' 'not' c);

theorem 
  a 'xor' (b 'nor' c) = (a 'or' 'not' (b 'or' c)) '&' ('not' a 'or' b 'or' c);

theorem 
  a 'eqv' (b 'nor' c) = (a 'or' b 'or' c) '&' ('not' a 'or' 'not' (b 'or' c));

theorem 
  a 'imp' (b 'nor' c) = 'not' (a '&' (b 'or' c));

theorem 
  a 'nand' (b 'nor' c) = 'not' a 'or' b 'or' c;

theorem 
  a '&' (a 'nor' b) = O_el(Y);

theorem 
  a 'or' (a 'nor' b) = a 'or' 'not' b;

theorem 
  a 'xor' (a 'nor' b) = a 'or' 'not' b;

theorem 
  a 'eqv' (a 'nor' b) = 'not' a '&' b;

theorem 
  a 'imp' (a 'nor' b) = 'not' (a 'or' a '&' b);

theorem 
  a 'nand' (a 'nor' b) = I_el(Y);














begin 

reserve D for non empty set,
  f for FinSequence of D,
  p, p1, p2, p3, q for Element of D,
  i, j, k, l, n for Nat;

theorem 
  1 <= i & j <= len f & i < j implies f = (f|(i-'1))^<*f.i*>^((f/^i)|(j
  -'i-'1))^<*f.j*>^(f/^j);

theorem 
  for f,g,h being FinSequence holds len g = len h & len g < i & i <= len
  (g^f) implies (g^f).i = (h^f).i;

theorem 
  for f,g being FinSequence st 1 <= i & i <= len f holds
    f.i = (g^f).(len g + i);

theorem 
  i in dom(f/^n) implies (f/^n).i = f.(n+i);

begin 

notation
  let D be non empty set;
  let f be FinSequence of D;
  let i be Nat;
  let p be Element of D;
  synonym Replace(f, i, p) for f +* (i, p);
end;

definition
  let D be non empty set;
  let f be FinSequence of D;
  let i be Nat;
  let p be Element of D;
  redefine func Replace(f, i, p) -> FinSequence of D equals


  (f|(i-'1))^<*p*>^(f/^i) if 1 <= i & i <= len f otherwise f;
end;

theorem 
  len Replace(f, i, p) = len f;

theorem 
  rng Replace(f, i, p) c= rng f \/ {p};

theorem 
  1 <= i & i <= len f implies p in rng Replace(f, i, p);

theorem 
  1 <= i & i <= len f implies Replace(f, i, p)/.i = p;

theorem 
  1 <= i & i <= len f implies for k st 0 < k & k <= len f - i holds
  Replace(f, i, p).(i + k) = (f/^i).k;

theorem 
  1 <= k & k <= len f & k <> i implies Replace(f, i, p)/.k = f/.k;

theorem 
  1 <= i & i < j & j <= len f implies Replace(Replace(f, j, q), i, p) =
    (f|(i-'1))^<*p*>^(f/^i)|(j-'i-'1)^<*q*>^(f/^j);

theorem 
  Replace(<*p*>, 1, q) = <*q*>;

theorem 
  Replace(<*p1, p2*>, 1, q) = <*q, p2*>;

theorem 
  Replace(<*p1, p2*>, 2, q) = <*p1, q*>;

theorem 
  Replace(<*p1, p2, p3*>, 1, q) = <*q, p2, p3*>;

theorem 
  Replace(<*p1, p2, p3*>, 2, q) = <*p1, q, p3*>;

theorem 
  Replace(<*p1, p2, p3*>, 3, q) = <*p1, p2, q*>;

begin 

registration
  let f be FinSequence;
  let i, j be Nat;
  cluster Swap(f, i, j) -> FinSequence-like;
end;

definition
  let D be non empty set;
  let f be FinSequence of D;
  let i, j be Nat;
  redefine func Swap(f, i, j) -> FinSequence of D equals


  Replace(
  Replace(f, i, f/.j), j, f/.i) if 1 <= i & i <= len f & 1 <= j & j <= len f
  otherwise f;
end;

theorem 
  len Swap(f, i, j) = len f;

theorem 
  Swap(f, i, i) = f;

theorem 
  Swap(Swap(f,i,j),j,i) = f;

theorem 
  Swap(f, i, j) = Swap(f, j, i);

theorem 
  rng Swap(f,i,j) = rng f;

theorem 
  Swap(<*p1, p2*>, 1, 2) = <*p2, p1*>;

theorem 
  Swap(<*p1, p2, p3*>, 1, 2) = <*p2, p1, p3*>;

theorem 
  Swap(<*p1, p2, p3*>, 1, 3) = <*p3, p2, p1*>;

theorem 
  Swap(<*p1, p2, p3*>, 2, 3) = <*p1, p3, p2*>;

theorem 
  1 <= i & i < j & j <= len f implies Swap(f, i, j) = (f|(i-'1))^
  <*f/.j*>^(f/^i)|(j-'i-'1)^<*f/.i*>^(f/^j);

theorem 
  1 < i & i <= len f implies Swap(f, 1, i) = <*f/.i*>^((f/^1)|(i-'2))^<*
  f/.1*>^(f/^i);

theorem 
  1 <= i & i < len f implies Swap(f, i, len f) = (f|(i-'1))^<*f/.len f*>
  ^((f/^i)|(len f-'i-'1))^<*f/.i*>;

theorem 
  i <> k & j <> k & 1 <= k & k <= len f implies Swap(f, i, j)/.k = f/.k;

theorem 
  1 <= i & i <= len f & 1 <= j & j <= len f implies Swap(f, i, j)
  /.i = f/.j & Swap(f, i, j)/.j = f/.i;

begin 

theorem 
  1 <= i & i <= len f & 1 <= j & j <= len f implies Replace(Swap(f
  , i, j), i, p) = Swap(Replace(f, j, p), i, j);

theorem 
  i <> k & j <> k & 1 <= i & i <= len f & 1 <= j & j <= len f
  implies Swap(Replace(f, k, p), i, j) = Replace(Swap(f, i, j), k, p);

theorem 
  i <> k & j <> k & 1 <= i & i <= len f & 1 <= j & j <= len f & 1 <= k &
  k <= len f implies Swap(Swap(f, i, j), j, k) = Swap(Swap(f, i, k), i, j);

theorem 
  i <> k & j <> k & l <> i & l <> j & 1 <= i & i <= len f & 1 <= j & j
<= len f & 1 <= k & k <= len f & 1 <= l & l <= len f implies Swap(Swap(f, i, j)
  , k, l) = Swap(Swap(f, k, l), i, j);














begin






























































































theorem 
  for n,m,k being Element of NAT holds (n+k)-'(m+k)=n-'m;

theorem 
  for n,k being Element of NAT st k>0 & n mod (2*k)>=k holds n mod
  (2*k)-k= n mod k & (n mod k) +k = n mod (2*k);

theorem 
  for n,k being Element of NAT st k>0 & n mod (2*k)>=k holds n div
  k= (n div (2*k))*2+1;

theorem 
  for n,k being Element of NAT st k>0 & n mod (2*k)<k holds n mod (
  2*k)= n mod k;

theorem 
  for n,k being Element of NAT st k>0 & n mod (2*k)<k holds n div k
  = (n div (2*k))*2;

theorem 
  for m,n being Element of NAT st m>0 ex i being Element of NAT st
  (for k2 being Element of NAT st k2<i holds m*(2|^k2)<=n) & m*(2|^i)>n;

theorem 
  for i being Integer,f being FinSequence st 1<=i & i<=len f holds i in dom f;
































definition
  let n,m be Integer;
  assume that
 n>=0 and
 m>0;
  func idiv1_prg(n,m) -> Integer means


  ex sm,sn,pn being FinSequence of INT
   st len sm=n+1 & len sn=n+1 & len pn=n+1 & (n<m implies it=0)& (not n<m
implies sm.1=m & ex i being Integer st 1<=i & i<=n & (for k being Integer st 1
<=k & k<i holds sm.(k+1)=sm.(k)*2 & not(sm.(k+1)>n)) & sm.(i+1)=sm.(i)*2 & sm.(
i+1)>n & pn.(i+1)=0 & sn.(i+1)=n & (for j being Integer st 1<=j & j<=i holds (
sn.(i+1- (j- 1))>=sm.(i+1- j) implies sn.(i+1- j)=sn.(i+1- (j- 1))-sm.(i+1- j)
  & pn.(i+1- j)=pn.(i+1- (j- 1))*2+1 )& (not sn.(i+1- (j- 1))>=sm.(i+1- j)
implies sn.(i+1- j)=sn.(i+1- (j- 1)) & pn.(i+1- j)=pn.(i+1- (j- 1))*2 ) )& it=
  pn.1 );
end;






theorem 
  for n,m being Integer st n>=0 holds for sm,sn,pn being FinSequence of
INT,i being Integer st len sm=n+1 & len sn=n+1 & len pn=n+1 & (not n<m implies
sm.1=m & 1<=i & i<=n & (for k being Integer st 1<=k & k<i holds sm.(k+1)=sm.(k)
*2 & not(sm.(k+1)>n)) & sm.(i+1)=sm.(i)*2 & sm.(i+1)>n & pn.(i+1)=0 & sn.(i+1)=
  n & (for j being Integer st 1<=j & j<=i holds (sn.(i+1- (j- 1))>=sm.(i+1- j)
implies sn.(i+1- j)=sn.(i+1- (j- 1))-sm.(i+1- j) & pn.(i+1- j)=pn.(i+1- (j- 1))
*2+1 )& (not sn.(i+1- (j- 1))>=sm.(i+1- j) implies sn.(i+1- j)=sn.(i+1- (j- 1))
& pn.(i+1- j)=pn.(i+1- (j- 1))*2 ) )& idiv1_prg(n,m)=pn.1 ) holds len sm=n+1 &
len sn=n+1 & len pn=n+1 & (n<m implies idiv1_prg(n,m)=0)& (not n<m implies 1 in
dom sm & sm.1=m & 1<=i & i<=n & (for k being Integer st 1<=k & k<i holds k+1 in
dom sm & k in dom sm & sm.(k+1)=sm.(k)*2 & not(sm.(k+1)>n)) & i+1 in dom sm & i
  in dom sm & sm.(i+1)=sm.(i)*2 & sm.(i+1)>n & i+1 in dom pn & pn.(i+1)=0 & i+1
in dom sn & sn.(i+1)=n & (for j being Integer st 1<=j & j<=i holds i+1-(j-1) in
dom sn & i+1-j in dom sm & (sn.(i+1- (j- 1))>=sm.(i+1- j) implies i+1-j in dom
sn & i+1-j in dom sm & sn.(i+1- j)=sn.(i+1- (j- 1))-sm.(i+1- j) & i+1-j in dom
pn & i+1-(j-1) in dom pn & pn.(i+1- j)=pn.(i+1- (j- 1))*2+1 )& (not sn.(i+1- (j
- 1))>=sm.(i+1- j) implies i+1-j in dom sn & i+1-(j-1) in dom sn & sn.(i+1- j)=
sn.(i+1- (j- 1)) & i+1-j in dom pn & i+1-(j-1) in dom pn & pn.(i+1- j)=pn.(i+1-
  (j- 1))*2 ) ) & 1 in dom pn & idiv1_prg(n,m) =pn.1 );

theorem 
  for n,m being Element of NAT st m>0 holds idiv1_prg(n qua Integer
  ,m qua Integer)=n div m;

theorem 
  for n,m being Integer st n>=0 & m>0 holds idiv1_prg(n,m)=n div m;

theorem 
  for n,m being Integer,n2,m2 being Element of NAT holds (m=0 & n2
=n & m2=m implies n div m=0 & n2 div m2=0)& (n>=0 & m>0 & n2=n & m2=m implies n
  div m =n2 div m2)& (n>=0 & m<0 & n2=n & m2= -m implies (m2*(n2 div m2)=n2
  implies n div m =-(n2 div m2)) &(m2*(n2 div m2)<>n2 implies n div m =-(n2 div
m2)-1))& (n<0 & m>0 & n2= -n & m2=m implies (m2*(n2 div m2)=n2 implies n div m
=-(n2 div m2)) &(m2*(n2 div m2)<>n2 implies n div m =-(n2 div m2)-1))& (n<0 & m
  <0 & n2= -n & m2= -m implies n div m =n2 div m2);




















definition
  let n,m be Integer;
  func idiv_prg(n,m) -> Integer means


  ex i being Integer st (m=0
implies it=0)& (not m=0 implies (n>=0 & m>0 implies it= idiv1_prg(n,m))& (not (
  n>=0 & m>0) implies (n>=0 & m<0 implies i=idiv1_prg(n,-m) & ((-m)*i=n implies
it=-i )& ((-m)*i <> n implies it= -i-1 ) )& (not (n>=0 & m<0) implies (n<0 & m>
0 implies i=idiv1_prg(-n,m) & (m*i= -n implies it=-i )& (m*i <> -n implies it=-
  i-1 ) )& (not (n<0 & m>0) implies it=idiv1_prg(-n,-m) ) ) ) );
end;

theorem 
  for n,m being Integer holds idiv_prg(n,m)=n div m;














begin

definition
  func sec -> PartFunc of REAL,REAL equals

  cos^;
  func cosec -> PartFunc of REAL,REAL equals

  sin^;
end;

reserve x,a,b,c for Real,
  n for Nat,
  Z for open Subset of REAL,
  f, f1,f2 for PartFunc of REAL,REAL;

theorem 
  cos.x<>0 implies sec is_differentiable_in x & diff(sec, x) = sin. x/(cos.x)^2
;

theorem 
  sin.x<>0 implies cosec is_differentiable_in x & diff(cosec, x) =
  -cos.x/(sin.x)^2;

theorem 
  (1/x) #Z n = 1/(x) #Z n;



theorem 
  Z c= dom sec implies sec is_differentiable_on Z & for x st x in Z
  holds ( (sec)`|Z).x = sin.x/(cos.x)^2;



theorem 
  Z c= dom cosec implies cosec is_differentiable_on Z & for x st x in Z
  holds ( (cosec)`|Z).x = -cos.x/(sin.x)^2;



theorem 
  Z c= dom (sec*f) & (for x st x in Z holds f.x = a*x+b) implies
sec*f is_differentiable_on Z & for x st x in Z holds ((sec*f)`|Z).x = a*sin.(a*
  x+b)/(cos.(a*x+b))^2;



theorem 
  Z c= dom (cosec*f) & (for x st x in Z holds f.x = a*x+b) implies
  cosec*f is_differentiable_on Z & for x st x in Z holds ((cosec*f)`|Z).x = -a*
  cos.(a*x+b)/(sin.(a*x+b))^2;



theorem 
  not 0 in Z & Z c= dom (sec*((id Z)^)) implies (sec*((id Z)^))
is_differentiable_on Z & for x st x in Z holds ((sec*((id Z)^))`|Z).x = -sin.(1
  /x)/(x^2*(cos.(1/x))^2);



theorem 
  not 0 in Z & Z c= dom (cosec*((id Z)^)) implies (cosec*((id Z)^))
is_differentiable_on Z & for x st x in Z holds ((cosec*((id Z)^))`|Z).x = cos.(
  1/x)/(x^2*(sin.(1/x))^2);



theorem 
  Z c= dom (sec*(f1+c(#)f2)) & f2=#Z 2 & (for x st x in Z holds f1.x = a
+b*x) implies sec*(f1+c(#)f2) is_differentiable_on Z & for x st x in Z holds ((
  sec*(f1+c(#)f2))`|Z).x = (b+2*c*x)*sin.(a+b*x+c*x^2)/(cos.(a+b*x+c*x^2))^2;



theorem 
  Z c= dom (cosec*(f1+c(#)f2)) & f2=#Z 2 & (for x st x in Z holds f1.x =
a+b*x) implies cosec*(f1+c(#)f2) is_differentiable_on Z & for x st x in Z holds
((cosec*(f1+c(#)f2))`|Z).x = -(b+2*c*x)*cos.(a+b*x+c*x^2)/(sin.(a+b*x+c*x^2))^2
;



theorem 
  Z c= dom (sec*exp_R) implies sec*exp_R is_differentiable_on Z & for x
  st x in Z holds ((sec*exp_R)`|Z).x = exp_R.x*sin.(exp_R.x)/(cos.(exp_R.x))^2;



theorem 
  Z c= dom (cosec*exp_R) implies cosec*exp_R is_differentiable_on Z &
for x st x in Z holds ((cosec*exp_R)`|Z).x = -exp_R.x*cos.(exp_R.x)/(sin.(exp_R
  .x))^2;



theorem 
  Z c= dom (sec*ln) implies sec*ln is_differentiable_on Z & for x st x
  in Z holds ((sec*ln)`|Z).x = sin.(ln.x)/(x*(cos.(ln.x))^2);



theorem 
  Z c= dom (cosec*ln) implies cosec*ln is_differentiable_on Z & for x st
  x in Z holds ((cosec*ln)`|Z).x = -cos.(ln.x)/(x*(sin.(ln.x))^2);



theorem 
  Z c= dom (exp_R*sec) implies exp_R*sec is_differentiable_on Z & for x
  st x in Z holds ((exp_R*sec)`|Z).x = exp_R.(sec.x)*sin.x/(cos.x)^2;



theorem 
  Z c= dom (exp_R*cosec) implies exp_R*cosec is_differentiable_on Z &
  for x st x in Z holds ((exp_R*cosec)`|Z).x = -exp_R.(cosec.x)*cos.x/(sin.x)^2
;



theorem 
  Z c= dom (ln*sec) implies ln*sec is_differentiable_on Z & for x st x
  in Z holds ((ln*sec)`|Z).x = sin.x/cos.x;



theorem 
  Z c= dom (ln*cosec) implies ln*cosec is_differentiable_on Z & for x st
  x in Z holds ((ln*cosec)`|Z).x = -cos.x/sin.x;



theorem 
  Z c= dom (( #Z n)*sec) & 1<=n implies ( #Z n)*sec is_differentiable_on
  Z & for x st x in Z holds ((( #Z n)*sec)`|Z).x = n*sin.x/(cos.x) #Z (n+1);



theorem 
  Z c= dom (( #Z n)*cosec) & 1<=n implies ( #Z n)*cosec
is_differentiable_on Z & for x st x in Z holds ((( #Z n)*cosec)`|Z).x = -n*cos.
  x/(sin.x) #Z (n+1);



theorem 
  Z c= dom (sec-id Z) implies sec-id Z is_differentiable_on Z & for x st
  x in Z holds ((sec-id Z)`|Z).x=(sin.x-(cos.x)^2)/(cos.x)^2;



theorem 
  Z c= dom (-cosec-id Z) implies -cosec-id Z is_differentiable_on Z &
  for x st x in Z holds ((-cosec-id Z)`|Z).x = (cos.x-(sin.x)^2)/(sin.x)^2;



theorem 
  Z c= dom (exp_R(#)sec) implies (exp_R(#)sec) is_differentiable_on Z &
for x st x in Z holds ((exp_R(#)sec)`|Z).x = exp_R.x/cos.x+exp_R.x*sin.x/(cos.x
  )^2;



theorem 
  Z c= dom (exp_R(#)cosec) implies (exp_R(#)cosec) is_differentiable_on
Z & for x st x in Z holds ((exp_R(#)cosec)`|Z).x = exp_R.x/sin.x-exp_R.x*cos.x/
  (sin.x)^2;



theorem 
  (Z c= dom ((1/a)(#)(sec*f)-id Z) & for x st x in Z holds f.x=a*x & a<>
0) implies (1/a)(#)(sec*f)-id Z is_differentiable_on Z & for x st x in Z holds
  (((1/a)(#)(sec*f)-id Z)`|Z).x= (sin.(a*x)-(cos.(a*x))^2)/(cos.(a*x))^2;



theorem 
  (Z c= dom ((-1/a)(#)(cosec*f)-id Z) & for x st x in Z holds f.x=a*x &
a<>0) implies (-1/a)(#)(cosec*f)-id Z is_differentiable_on Z & for x st x in Z
holds (((-1/a)(#)(cosec*f)-id Z)`|Z).x= (cos.(a*x)-(sin.(a*x))^2)/(sin.(a*x))^2
;



theorem 
  (Z c= dom (f(#)sec) & for x st x in Z holds f.x=a*x+b) implies (f(#)
sec) is_differentiable_on Z & for x st x in Z holds ((f(#)sec)`|Z).x = a/cos.x+
  (a*x+b)*sin.x/(cos.x)^2;



theorem 
  (Z c= dom (f(#)cosec) & for x st x in Z holds f.x=a*x+b) implies (f(#)
  cosec) is_differentiable_on Z & for x st x in Z holds ((f(#)cosec)`|Z).x = a/
  sin.x-(a*x+b)*cos.x/(sin.x)^2;



theorem 
  Z c= dom (ln(#)sec) implies (ln(#)sec) is_differentiable_on Z & for x
  st x in Z holds ((ln(#)sec)`|Z).x = 1/cos.x/x+ln.x*sin.x/(cos.x)^2;



theorem 
  Z c= dom (ln(#)cosec) implies (ln(#)cosec) is_differentiable_on Z &
  for x st x in Z holds ((ln(#)cosec)`|Z).x = 1/sin.x/x-ln.x*cos.x/(sin.x)^2;



theorem 
  not 0 in Z & Z c= dom ((id Z)^(#)sec) implies ((id Z)^(#)sec)
is_differentiable_on Z & for x st x in Z holds (((id Z)^(#)sec)`|Z).x = -1/cos.
  x/x^2+sin.x/x/(cos.x)^2;



theorem 
  not 0 in Z & Z c= dom ((id Z)^(#)cosec) implies ((id Z)^(#)cosec)
  is_differentiable_on Z & for x st x in Z holds (((id Z)^(#)cosec)`|Z).x = -1/
  sin.x/x^2-cos.x/x/(sin.x)^2;



theorem 
  Z c= dom (sec*sin) implies sec*sin is_differentiable_on Z & for x st x
  in Z holds ((sec*sin)`|Z).x = cos.x*sin.(sin.x)/(cos.(sin.x))^2;



theorem 
  Z c= dom (sec*cos) implies sec*cos is_differentiable_on Z & for x st x
  in Z holds ((sec*cos)`|Z).x = -sin.x*sin.(cos.x)/(cos.(cos.x))^2;



theorem 
  Z c= dom (cosec*sin) implies cosec*sin is_differentiable_on Z & for x
  st x in Z holds ((cosec*sin)`|Z).x = -cos.x*cos.(sin.x)/(sin.(sin.x))^2;



theorem 
  Z c= dom (cosec*cos) implies cosec*cos is_differentiable_on Z & for x
  st x in Z holds ((cosec*cos)`|Z).x = sin.x*cos.(cos.x)/(sin.(cos.x))^2;



theorem 
  Z c= dom (sec*tan) implies sec*tan is_differentiable_on Z & for x st x
  in Z holds ((sec*tan)`|Z).x = sin.(tan.x)/(cos.x)^2/(cos.(tan.x))^2;



theorem 
  Z c= dom (sec*cot) implies sec*cot is_differentiable_on Z & for x st x
  in Z holds ((sec*cot)`|Z).x = -sin.(cot.x)/(sin.x)^2/(cos.(cot.x))^2;



theorem 
  Z c= dom (cosec*tan) implies cosec*tan is_differentiable_on Z & for x
  st x in Z holds ((cosec*tan)`|Z).x = -cos.(tan.x)/(cos.x)^2/(sin.(tan.x))^2;



theorem 
  Z c= dom (cosec*cot) implies cosec*cot is_differentiable_on Z & for x
  st x in Z holds ((cosec*cot)`|Z).x = cos.(cot.x)/(sin.x)^2/(sin.(cot.x))^2;



theorem 
  Z c= dom (tan(#)sec) implies (tan(#)sec) is_differentiable_on Z & for
x st x in Z holds ((tan(#)sec)`|Z).x = 1/(cos.x)^2/cos.x+tan.x*sin.x/(cos.x)^2;



theorem 
  Z c= dom (cot(#)sec) implies (cot(#)sec) is_differentiable_on Z & for
x st x in Z holds ((cot(#)sec)`|Z).x = -1/(sin.x)^2/cos.x+cot.x*sin.x/(cos.x)^2
;



theorem 
  Z c= dom (tan(#)cosec) implies (tan(#)cosec) is_differentiable_on Z &
for x st x in Z holds ((tan(#)cosec)`|Z).x = 1/(cos.x)^2/sin.x-tan.x*cos.x/(sin
  .x)^2;



theorem 
  Z c= dom (cot(#)cosec) implies (cot(#)cosec) is_differentiable_on Z &
  for x st x in Z holds ((cot(#)cosec)`|Z).x = -1/(sin.x)^2/sin.x-cot.x*cos.x/(
  sin.x)^2;














begin 

definition
  let A,B9 be non empty set;
  let B be non empty Subset of B9;
  let f be Function of A,B;
  let x be Element of A;
  redefine func f.x -> Element of B;
end;

theorem 
  for A being finite set st card A >= 2 holds for a being Element of A holds
  ex b being Element of A st b <> a;

theorem 
  for A being finite set st card A >= 3 holds for a,b being Element of A holds
  ex c being Element of A st c <> a & c <> b;

begin 

reserve A for non empty set;
reserve a,b,c,x,y,z for Element of A;

definition
  let A;
  func LinPreorders A means


  for R being set holds R in it iff
  R is Relation of A & (for a,b holds [a,b] in R or [b,a] in R) &
  for a,b,c st [a,b] in R & [b,c] in R holds [a,c] in R;
end;

registration
  let A;
  cluster LinPreorders A -> non empty;
end;

definition
  let A;
  func LinOrders A -> Subset of LinPreorders A means


  for R being Element of LinPreorders A holds R in it iff
  for a,b st [a,b] in R & [b,a] in R holds a = b;
end;

registration
  let A be set;
  cluster connected for Order of A;
end;

definition
  let A;
  redefine func LinOrders A means


  for R being set holds R in it iff R is connected Order of A;
end;

registration
  let A;
  cluster LinOrders A -> non empty;
end;

registration let A;
 cluster -> Relation-like for Element of LinPreorders A;
 cluster -> Relation-like for Element of LinOrders A;
end;

reserve o,o9 for Element of LinPreorders A;
reserve o99 for Element of LinOrders A;

definition
  let o be Relation, a,b be set;
  pred a <=_o, b means


  [a,b] in o;
end;

notation
  let o be Relation, a,b be set;
  synonym b >=_o, a for a <=_o, b;
  antonym b <_o, a for a <=_o, b;
  antonym a >_o, b for a <=_o, b;
end;

theorem 
  a <=_o, a;

theorem 
  a <=_o, b or b <=_o, a;

theorem 
  (a <=_o, b or a <_o, b) & (b <=_ o, c or b <_o, c) implies a <=_o, c;

theorem 
  a <=_o99, b & b <=_o99, a implies a = b;

theorem 
  a <> b & b <> c & a <> c implies ex o st a <_o, b & b <_o, c;

theorem 
  ex o st for a st a <> b holds b <_o, a;

theorem 
  ex o st for a st a <> b holds a <_o, b;

theorem 
  a <> b & a <> c implies ex o st a <_o, b & a <_o, c &
  (b <_o, c iff b <_o9, c) & (c <_o, b iff c <_o9, b);

theorem 
  a <> b & a <> c implies ex o st b <_o, a & c <_o, a &
  (b <_o, c iff b <_o9, c) & (c <_o, b iff c <_o9, b);

theorem 
  for o,o9 being Element of LinOrders A holds
  (a <_o, b iff a <_o9, b) & (b <_o, a iff b <_o9, a) iff
  (a <_o, b iff a <_o9, b);

theorem 
  for o being Element of LinOrders A, o9 being Element of LinPreorders A holds
  (for a,b st a <_o, b holds a <_o9, b) iff
  for a,b holds a <_o, b iff a <_o9, b;

begin 


reserve A,N for finite non empty set;
reserve a,b,c,d,a9,c9 for Element of A;
reserve i,n,nb,nc for Element of N;
reserve o,oI,oII for Element of LinPreorders A;
reserve p,p9,pI,pII,pI9,pII9 for Element of Funcs(N,LinPreorders A);
reserve f for Function of Funcs(N,LinPreorders A),LinPreorders A;
reserve k,k0 for Nat;

theorem 
  (for p,a,b st for i holds a <_p.i, b holds a <_f.p, b) & (for p,p9,a,b st
  for i holds (a <_p.i, b iff a <_p9.i, b) & (b <_p.i, a iff b <_p9.i, a)
  holds a <_f.p, b iff a <_f.p9, b) & card A >= 3 implies
  ex n st for p,a,b st a <_p.n, b holds a <_f.p, b;



reserve o,o1 for Element of LinOrders A;
reserve o9 for Element of LinPreorders A;
reserve p,p9 for Element of Funcs(N,LinOrders A);
reserve q,q9 for Element of Funcs(N,LinPreorders A);
reserve f for Function of Funcs(N,LinOrders A),LinPreorders A;

theorem 
  (for p,a,b st for i holds a <_p.i, b holds a <_f.p, b) & (for p,p9,a,b st
  for i holds a <_p.i, b iff a <_p9.i, b holds a <_f.p, b iff a <_f.p9, b) &
  card A >= 3 implies ex n st for p,a,b holds a <_p.n, b iff a <_f.p, b;














begin 

reserve a, b, k, n, m for Nat,
  i for Integer,
  r for real number,
  p for rational number,
  c for complex number,
  x for set,
  f for Function;

registration
  let n;
  cluster n div 0 -> zero;
  cluster n mod 0 -> zero;
  cluster 0 div n -> zero;
  cluster 0 mod n -> zero;
end;

registration
  let c;
  cluster c-c -> zero;
  cluster c/0 -> zero;
end;

registration
  cluster [\ 0 /] -> zero;
end;

theorem 
  0 < r & r < 1 implies 1 < 1/r;

theorem 
  i <= r & r < i+1 implies [\ r /] = i;

theorem 
  [\ m/n /] = m div n;

theorem 
  m mod n = 0 implies m / n = m div n;

theorem 
  m / n = m div n implies m mod n = 0;

theorem 
  frac(m/n) = (m mod n) / n;

theorem 
  p >= 0 implies ex m,n being Nat st n <> 0 & p = m/n;

registration
  cluster INT-valued for Real_Sequence;
end;

definition
  mode Integer_Sequence is INT-valued Real_Sequence;
end;

theorem 
  f is Integer_Sequence iff dom f=NAT & for x st x in NAT holds f.x is integer;

theorem 
  f is Function of NAT,INT iff f is Integer_Sequence;

theorem 
  f is sequence of NAT iff dom f=NAT & for x st x in NAT holds f.x is natural;

theorem 
  f is Function of NAT,NAT iff f is sequence of NAT;

begin 

definition

  let m, n be Nat;
  func modSeq(m,n) -> sequence of NAT means


  it.0 = m mod n & it.1 = n
  mod (m mod n) & for k being Nat holds it.(k+2) = it.k mod it.(k+1);
end;

definition
  let m, n be Nat;
  func divSeq(m,n) -> sequence of NAT means


  it.0 = m div n & it.1 = n
div (m mod n) & for k being Nat holds it.(k+2) = modSeq(m,n).k div modSeq(m,n).
  (k+1);
end;

theorem 
  divSeq(m,n).1 = n div modSeq(m,n).0;

theorem 
  modSeq(m,n).1 = n mod modSeq(m,n).0;

theorem 
  a <= b & modSeq(m,n).a = 0 implies modSeq(m,n).b = 0;

theorem 
  a < b implies modSeq(m,n).a > modSeq(m,n).b or modSeq(m,n).a = 0;

theorem 
  divSeq(m,n).(a+1) = 0 implies modSeq(m,n).a = 0;

theorem 
  a <> 0 & a <= b & divSeq(m,n).a = 0 implies divSeq(m,n).b = 0;

theorem 
  a < b & modSeq(m,n).a = 0 implies divSeq(m,n).b = 0;

theorem 
  n <> 0 implies m = divSeq(m,n).0 * n + modSeq(m,n).0;

theorem 
  n <> 0 implies m / n = divSeq(m,n).0 + 1 / (n / modSeq(m,n).0);

theorem 
  divSeq(m,0) = NAT --> 0;

theorem 
  modSeq(m,0) = NAT --> 0;

theorem 
  divSeq(0,n) = NAT --> 0;

theorem 
  modSeq(0,n) = NAT --> 0;

theorem 
  ex k being Nat st divSeq(m,n).k = 0 & modSeq(m,n).k = 0;

begin

definition
  let r be real number;
  func remainders_for_scf r -> Real_Sequence means


  it.0 = r & for n being Nat holds it.(n+1) = 1 / frac(it.n);
end;

notation
  let r be real number;
  synonym rfs r for remainders_for_scf r;
end;

definition
  let r be real number;
  func SimpleContinuedFraction r -> Integer_Sequence means


  for n being Nat holds it.n = [\ rfs(r).n /];
end;

notation
  let r be real number;
  synonym scf r for SimpleContinuedFraction r;
end;

theorem 
  rfs(r).(n+1) = 1 / (rfs(r).n-scf(r).n);

theorem 
  rfs(r).n = 0 & n <= m implies rfs(r).m = 0;

theorem 
  rfs(r).n = 0 & n <= m implies scf(r).m = 0;

theorem 
  rfs(i).(n+1) = 0;

theorem 
  scf(i).0 = i & scf(i).(n+1) = 0;

theorem 
  i > 1 implies rfs(1/i).1 = i & rfs(1/i).(n+2) = 0;

theorem 
  i > 1 implies scf(1/i).0 = 0 & scf(1/i).1 = i & scf(1/i).(n+2) = 0;

theorem 
  (for n holds scf(r).n = 0) implies rfs(r).n = 0;

theorem 
  (for n holds scf(r).n = 0) implies r = 0;

theorem 
  frac(r) = r - scf(r).0;

theorem 
  rfs(r).(n+1) = rfs(1/frac(r)).n;

theorem 
  scf(r).(n+1) = scf(1/frac(r)).n;

theorem 
  n >= 1 implies scf(r).n >= 0;

theorem 
  n >= 1 implies scf(r).n in NAT;

theorem 
  n >= 1 & scf(r).n <> 0 implies scf(r).n >= 1;

theorem 
  scf(m/n).k = divSeq(m,n).k & rfs(m/n).1 = n / modSeq(m,n).0 &
  rfs(m/n).(k+2) = (modSeq(m,n).k) / (modSeq(m,n).(k+1));

theorem 
  r is rational iff ex n st for m st m >= n holds scf(r).m = 0;

theorem 
  (for n holds scf(r).n <> 0) implies r is irrational;

begin 

reserve l, n1, n2 for Nat;
reserve s1, s2 for Real_Sequence;

definition
  let r be real number;
  func convergent_numerators(r) -> Real_Sequence means


  it.0 = scf(r).0
& it.1 = scf(r).1 * scf(r).0 + 1 & for n being Nat holds it.(n+2) = scf(r).(n+2
  ) * it.(n+1) + it.n;
end;

definition
  let r be real number;
  func convergent_denominators(r) -> Real_Sequence means


  it.0 = 1 & it.
1 = scf(r).1 & for n being Nat holds it.(n+2) = scf(r).(n+2) * it.(n+1) + it.n;
end;

notation
  let r be real number;
  synonym c_n(r) for convergent_numerators(r);
  synonym c_d(r) for convergent_denominators(r);
end;

theorem 
  scf(r).0 > 0 implies for n holds c_n(r).n in NAT;

theorem 
  scf(r).0 > 0 implies for n holds c_n(r).n > 0;

theorem 
  scf(r).0 > 0 implies for n holds c_n(r).(n+2) > scf(r).(n+2) * c_n(r). (n+1);

theorem 
  scf(r).0 > 0 implies for n st n1=c_n(r).(n+1) & n2=c_n(r).n holds n1
  gcd n2 = 1;

theorem 
  scf(r).0 > 0 & (for n holds scf(r).n <> 0) implies for n holds c_n(r).
  n >= tau |^ n;

theorem 
  scf(r).0 > 0 & (for n holds scf(r).n <= b) implies for n holds c_n(r).
  n <= ((b+sqrt (b^2+4))/2)|^(n+1);

theorem 
  c_d(r).n in NAT;

theorem 
  c_d(r).n >= 0;

theorem 
  scf(r).1 > 0 implies for n holds c_d(r).n > 0;

theorem 
  c_d(r).(n+2) >= scf(r).(n+2) * c_d(r).(n+1);

theorem 
  scf(r).1 > 0 implies for n holds c_d(r).(n+2) > scf(r).(n+2) * c_d(r). (n+1);

theorem 
  (for n holds scf(r).n>0) implies for n st n>=1 holds 1 / (c_d(r).n*c_d
  (r).(n+1)) < 1 / (scf(r).(n+1)*(c_d(r).n)^2);

theorem 
  (for n holds scf(r).n <= b) implies for n holds c_d(r).(n+1) <= ((b+
  sqrt (b^2+4))/2)|^(n+1);

theorem 
  n1=c_d(r).(n+1) & n2=c_d(r).n implies n1 gcd n2 = 1;

theorem 
  (for n holds scf(r).n > 0) implies for n holds c_d(r).(n+1)/c_d(
  r).n >= 1/scf(r).(n+2);

theorem 
  (for n holds scf(r).n > 0) implies for n holds c_d(r).(n+2) <= 2*scf(r
  ).(n+2) * c_d(r).(n+1);

theorem 
  (for n holds scf(r).n<>0) implies for n holds 1/(scf(r).(n+1)*(c_d(r).
  n)^2) <= 1/(c_d(r).n)^2;

theorem 
  (for n holds scf(r).n<>0) implies for n holds c_d(r).(n+1) >= tau |^ n;

theorem 
  a > 0 & (for n holds scf(r).n >= a) implies for n holds c_d(r).(n+1)
  >= ((a+sqrt (a^2+4))/2)|^n;

theorem 
  c_n(r).(n+2) / c_d(r).(n+2) = (scf(r).(n+2) * c_n(r).(n+1) + c_n(r).n)
  / (scf(r).(n+2) * c_d(r).(n+1) + c_d(r).n);

theorem 
  c_n(r).(n+1)*c_d(r).n - c_n(r).n*c_d(r).(n+1) = (-1)|^n;

theorem 
  (for n holds c_d(r).n<>0) implies c_n(r).(n+1)/c_d(r).(n+1) -
  c_n(r).n/c_d(r).n = (-1)|^n / (c_d(r).(n+1)*c_d(r).n);

theorem 
  c_n(r).(n+2)*c_d(r).n - c_n(r).n*c_d(r).(n+2) = (-1)|^n * scf(r) .(n+2);

theorem 
  (for n holds c_d(r).n<>0) implies c_n(r).(n+2)/c_d(r).(n+2) - c_n(r).n
  /c_d(r).n = (-1)|^n * scf(r).(n+2) / (c_d(r).(n+2) * c_d(r).n);

theorem 
  (for n holds scf(r).n<>0) implies for n st n >= 1 holds c_n(r).n / c_d
  (r).n = (c_n(r).(n+1)-c_n(r).(n-1)) / (c_d(r).(n+1)-c_d(r).(n-1));

theorem 
  (for n holds c_d(r).n<>0) implies for n holds abs (c_n(r).(n+1)/c_d(r)
  .(n+1) - c_n(r).n/c_d(r).n) = 1 / abs (c_d(r).(n+1)*c_d(r).n);

theorem 
  scf(r).1 > 0 implies for n holds c_n(r).(2*n+1) / c_d(r).(2*n+1) > c_n
  (r).(2*n) / c_d(r).(2*n);

definition
  let r be real number;

  func convergents_of_continued_fractions(r) -> Real_Sequence equals

  c_n(r) /"
  c_d(r);
end;

notation
  let r be real number;
  synonym cocf(r) for convergents_of_continued_fractions(r);
end;

theorem 
  cocf(r).0 = scf(r).0;

theorem 
  scf(r).1 <> 0 implies cocf(r).1 = scf(r).0 + 1 / scf(r).1;

theorem 
  (for n holds scf(r).n>0) implies cocf(r).2 = scf(r).0 + 1 / (scf
  (r).1 + 1/scf(r).2);

theorem 
  (for n holds scf(r).n>0) implies cocf(r).3 = scf(r).0 + 1/(scf(r
  ).1 + 1/(scf(r).2 + 1/scf(r).3));

theorem 
  (for n holds scf(r).n>0) implies for n st n>=1 holds c_n(r).(2*n+1) /
  c_d(r).(2*n+1) < c_n(r).(2*n-1) / c_d(r).(2*n-1);

theorem 
  (for n holds scf(r).n>0) implies for n st n>=1 holds c_n(r).(2*n) /
  c_d(r).(2*n) > c_n(r).(2*n-2) / c_d(r).(2*n-2);

theorem 
  (for n holds scf(r).n>0) implies for n st n>=1 holds c_n(r).(2*n) /
  c_d(r).(2*n) < c_n(r).(2*n-1) / c_d(r).(2*n-1);

definition
  let r be real number;
  func backContinued_fraction r -> Real_Sequence means


  it.0 = scf(r).0 & for n being Nat holds it.(n+1) = 1/it.n + scf(r).(n+1);
end;

notation
  let r be real number;
  synonym bcf r for backContinued_fraction r;
end;

theorem 
  scf(r).0 > 0 implies for n holds bcf(r).(n+1)=c_n(r).(n+1)/c_n(r).n;














begin

reserve x for Real,

  Z for open Subset of REAL;



theorem 
  Z c= dom (tan*cot) implies tan*cot is_differentiable_on Z & for x st x
  in Z holds((tan*cot)`|Z).x = 1/(cos.(cot.x))^2 *(-1/(sin.x)^2);



theorem 
  Z c= dom (tan*tan) implies tan*tan is_differentiable_on Z & for x st x
  in Z holds((tan*tan)`|Z).x = 1/(cos.(tan.x))^2 *(1/(cos.x)^2);



theorem 
  Z c= dom (cot*cot) implies cot*cot is_differentiable_on Z & for x st x
  in Z holds((cot*cot)`|Z).x = (1/(sin.(cot.x))^2) *(1/(sin.x)^2);



theorem 
  Z c= dom (cot*tan) implies cot*tan is_differentiable_on Z & for x st x
  in Z holds((cot*tan)`|Z).x = (-1/(sin.(tan.x))^2)*(1/(cos.x)^2);



theorem 
  Z c= dom(tan-cot) implies (tan - cot) is_differentiable_on Z &
  for x st x in Z holds((tan - cot)`|Z).x = 1/(cos.x)^2+1/(sin.x)^2;



theorem 
  Z c= dom(tan+cot) implies (tan + cot) is_differentiable_on Z &
  for x st x in Z holds((tan + cot)`|Z).x = 1/(cos.x)^2-1/(sin.x)^2;



theorem 
  sin*sin is_differentiable_on Z & for x st x in Z holds((sin*sin)`|Z).x
  = cos.(sin.x)*cos.x;



theorem 
  sin*cos is_differentiable_on Z & for x st x in Z holds((sin*cos)`|Z).x
  = -cos.(cos.x)*sin.x;



theorem 
  cos*sin is_differentiable_on Z & for x st x in Z holds((cos*sin)`|Z).x
  = -sin.(sin.x)*cos.x;



theorem 
  cos*cos is_differentiable_on Z & for x st x in Z holds((cos*cos)`|Z).x
  = sin.(cos.x)*sin.x;



theorem 
  Z c= dom (cos (#) cot) implies (cos (#) cot) is_differentiable_on Z &
  for x st x in Z holds((cos (#) cot)`|Z).x = -cos.x-cos.x/(sin.x)^2;



theorem 
  Z c= dom (sin (#) tan) implies (sin (#)tan) is_differentiable_on Z &
  for x st x in Z holds((sin (#) tan)`|Z).x = sin.x + sin.x/(cos.x)^2;



theorem 
  Z c= dom (sin (#) cot) implies (sin (#) cot) is_differentiable_on Z &
  for x st x in Z holds((sin (#) cot)`|Z).x = cos.x*cot.x - 1/sin.x;



theorem 
  Z c= dom (cos (#) tan) implies (cos (#) tan) is_differentiable_on Z &
  for x st x in Z holds((cos (#) tan)`|Z).x = -(sin.x)^2/cos.x+1/cos.x;



theorem 
  Z c= dom (sin (#) cos) implies (sin (#) cos) is_differentiable_on Z &
  for x st x in Z holds((sin (#) cos)`|Z).x =(cos.x)^2-(sin.x)^2;



theorem 
  Z c= dom (ln(#)sin) implies ln(#)sin is_differentiable_on Z & for x st
  x in Z holds ((ln(#)sin)`|Z).x = sin.x/x+ln.x*cos.x;



theorem 
  Z c= dom (ln(#)cos) implies ln(#)cos is_differentiable_on Z & for x st
  x in Z holds ((ln(#)cos)`|Z).x = cos.x/x - ln.x*sin.x;



theorem 
  Z c= dom (ln(#)exp_R) implies ln(#)exp_R is_differentiable_on Z & for
  x st x in Z holds ((ln(#)exp_R)`|Z).x = exp_R.x/x + ln.x*exp_R.x;



theorem 
  Z c= dom (ln*ln) & (for x st x in Z holds x>0) implies ln*ln
  is_differentiable_on Z & for x st x in Z holds ((ln*ln)`|Z).x = 1/(ln.x*x);



theorem 
  Z c= dom (exp_R*exp_R) implies exp_R*exp_R is_differentiable_on Z &
  for x st x in Z holds ((exp_R*exp_R)`|Z).x = exp_R.(exp_R.x)*exp_R.x;



theorem 
  Z c= dom (sin*tan) implies sin*tan is_differentiable_on Z & for x st x
  in Z holds ((sin*tan)`|Z).x = cos(tan.x)/(cos.x)^2;



theorem 
  Z c= dom (sin*cot) implies sin*cot is_differentiable_on Z & for x st x
  in Z holds ((sin*cot)`|Z).x =-cos(cot.x)/(sin.x)^2;



theorem 
  Z c= dom (cos*tan) implies cos*tan is_differentiable_on Z & for x st x
  in Z holds ((cos*tan)`|Z).x =-sin(tan.x)/(cos.x)^2;



theorem 
  Z c= dom (cos*cot) implies cos*cot is_differentiable_on Z & for x st x
  in Z holds ((cos*cot)`|Z).x =sin(cot.x)/(sin.x)^2;



theorem 
  Z c= dom (sin(#)(tan+cot)) implies sin(#)(tan+cot)
is_differentiable_on Z & for x st x in Z holds ((sin(#)(tan+cot))`|Z).x =cos.x*
  (tan.x+cot.x)+sin.x*(1/(cos.x)^2-1/(sin.x)^2);



theorem 
  Z c= dom (cos(#)(tan+cot)) implies cos(#)(tan+cot)
is_differentiable_on Z & for x st x in Z holds ((cos(#)(tan+cot))`|Z).x =-sin.x
  *(tan.x+cot.x)+cos.x*(1/(cos.x)^2-1/(sin.x)^2);



theorem 
  Z c= dom (sin(#)(tan-cot)) implies sin(#)(tan-cot)
is_differentiable_on Z & for x st x in Z holds ((sin(#)(tan-cot))`|Z).x =cos.x*
  (tan.x-cot.x)+sin.x*(1/(cos.x)^2+1/(sin.x)^2);



theorem 
  Z c= dom (cos(#)(tan-cot)) implies cos(#)(tan-cot)
is_differentiable_on Z & for x st x in Z holds ((cos(#)(tan-cot))`|Z).x =-sin.x
  *(tan.x-cot.x)+cos.x*(1/(cos.x)^2+1/(sin.x)^2);



theorem 
  Z c= dom (exp_R(#)(tan+cot)) implies exp_R(#)(tan+cot)
  is_differentiable_on Z & for x st x in Z holds ((exp_R(#)(tan+cot))`|Z).x =
  exp_R.x*(tan.x+cot.x)+exp_R.x*(1/(cos.x)^2-1/(sin.x)^2);



theorem 
  Z c= dom (exp_R(#)(tan-cot)) implies exp_R(#)(tan-cot)
  is_differentiable_on Z & for x st x in Z holds ((exp_R(#)(tan-cot))`|Z).x =
  exp_R.x*(tan.x-cot.x)+exp_R.x*(1/(cos.x)^2+1/(sin.x)^2);



theorem 
  Z c= dom (sin(#)(sin+cos)) implies sin(#)(sin+cos)
is_differentiable_on Z & for x st x in Z holds ((sin(#)(sin+cos))`|Z).x =(cos.x
  )^2+2*sin.x*cos.x-(sin.x)^2;



theorem 
  Z c= dom (sin(#)(sin-cos)) implies sin(#)(sin-cos)
is_differentiable_on Z & for x st x in Z holds ((sin(#)(sin-cos))`|Z).x =(sin.x
  )^2+2*sin.x*cos.x-(cos.x)^2;



theorem 
  Z c= dom (cos(#)(sin-cos)) implies cos(#)(sin-cos)
is_differentiable_on Z & for x st x in Z holds ((cos(#)(sin-cos))`|Z).x =(cos.x
  )^2+2*sin.x*cos.x-(sin.x)^2;



theorem 
  Z c= dom (cos(#)(sin+cos)) implies cos(#)(sin+cos)
is_differentiable_on Z & for x st x in Z holds ((cos(#)(sin+cos))`|Z).x =(cos.x
  )^2-2*sin.x*cos.x-(sin.x)^2;



theorem 
  Z c= dom (sin*(tan+cot)) implies sin*(tan+cot) is_differentiable_on Z
& for x st x in Z holds (sin*(tan+cot)`|Z).x = cos.(tan.x+cot.x)*(1/(cos.x)^2-1
  /(sin.x)^2);



theorem 
  Z c= dom (sin*(tan-cot)) implies sin*(tan-cot) is_differentiable_on Z
& for x st x in Z holds (sin*(tan-cot)`|Z).x = cos.(tan.x-cot.x)*(1/(cos.x)^2+1
  /(sin.x)^2);



theorem 
  Z c= dom (cos*(tan-cot)) implies cos*(tan-cot) is_differentiable_on Z
& for x st x in Z holds (cos*(tan-cot)`|Z).x = -sin.(tan.x-cot.x)*(1/(cos.x)^2+
  1/(sin.x)^2);



theorem 
  Z c= dom (cos*(tan+cot)) implies cos*(tan+cot) is_differentiable_on Z
& for x st x in Z holds (cos*(tan+cot)`|Z).x = -sin.(tan.x+cot.x)*(1/(cos.x)^2-
  1/(sin.x)^2);



theorem 
  Z c= dom (exp_R*(tan+cot)) implies exp_R*(tan+cot)
is_differentiable_on Z & for x st x in Z holds (exp_R*(tan+cot)`|Z).x = exp_R.(
  tan.x+cot.x)*(1/(cos.x)^2-1/(sin.x)^2);



theorem 
  Z c= dom (exp_R*(tan-cot)) implies exp_R*(tan-cot)
is_differentiable_on Z & for x st x in Z holds (exp_R*(tan-cot)`|Z).x = exp_R.(
  tan.x-cot.x)*(1/(cos.x)^2+1/(sin.x)^2);



theorem 
  Z c= dom ((tan-cot)/exp_R) implies (tan-cot)/exp_R
is_differentiable_on Z & for x st x in Z holds (((tan-cot)/exp_R)`|Z).x = (1/(
  cos.x)^2+1/(sin.x)^2-tan.x+cot.x)/exp_R.x;



theorem 
  Z c= dom ((tan+cot)/exp_R) implies (tan+cot)/exp_R
is_differentiable_on Z & for x st x in Z holds (((tan+cot)/exp_R)`|Z).x = (1/(
  cos.x)^2-1/(sin.x)^2-tan.x-cot.x)/exp_R.x;



theorem 
  Z c= dom (sin*sec) implies sin*sec is_differentiable_on Z & for x st x
  in Z holds ((sin*sec)`|Z).x = cos.(sec.x)* sin.x/(cos.x)^2;



theorem 
  Z c= dom (cos*sec) implies cos*sec is_differentiable_on Z & for x st x
  in Z holds ((cos*sec)`|Z).x = -sin.(sec.x)* sin.x/(cos.x)^2;



theorem 
  Z c= dom (sin*cosec) implies sin*cosec is_differentiable_on Z & for x
  st x in Z holds ((sin*cosec)`|Z).x = -cos.(cosec.x)*cos.x/(sin.x)^2;



theorem 
  Z c= dom (cos*cosec) implies cos*cosec is_differentiable_on Z & for x
  st x in Z holds ((cos*cosec)`|Z).x = sin.(cosec.x)*cos.x/(sin.x)^2;














begin

reserve x,r,a,x0,p for Real;
reserve n,i,m for Element of NAT;
reserve Z for open Subset of REAL;
reserve f,f1,f2 for PartFunc of REAL,REAL;
reserve k for Nat;

theorem 
  for f being Function of REAL, REAL holds dom (f | Z) = Z;

theorem 
  (-f1)(#)(-f2)=f1(#)f2;

theorem 
  n>=1 implies dom(( #Z n)^) = REAL\{0} & ( #Z n)"{0}={0};

theorem 
  (r*p)(#)(( #Z n)^)=r(#)(p(#)(( #Z n)^));

theorem 
  for n,m be Element of REAL holds n(#)f1+m(#)f1=(n+m)(#)f1;

theorem 
  f|Z is_differentiable_on Z implies f is_differentiable_on Z;

theorem 
  n>=1 & f1 is_differentiable_on n,Z implies f1 is_differentiable_on Z;

theorem 
  #Z n is_differentiable_on REAL;



theorem 
  x in Z implies (diff(sin,Z).2).x = -sin.x;

theorem 
  x in Z implies (diff(sin,Z).3).x = (-cos).x;

theorem 
  x in Z implies (diff(sin,Z).n).x = sin.(x + n*PI/2);



theorem 
  x in Z implies (diff(cos,Z).2).x = -cos.x;

theorem 
  x in Z implies (diff(cos,Z).3).x = sin.x;

theorem 
  x in Z implies (diff(cos,Z).n).x = cos.(x + n*PI/2);

theorem 
  f1 is_differentiable_on n,Z & f2 is_differentiable_on n,Z
  implies diff(f1+f2,Z).n = diff(f1,Z).n + diff(f2,Z).n;

theorem 
  f1 is_differentiable_on n,Z & f2 is_differentiable_on n,Z
  implies diff(f1-f2,Z).n = diff(f1,Z).n - diff(f2,Z).n;

theorem 
  f1 is_differentiable_on n,Z & f2 is_differentiable_on n,Z & i<=n
  implies diff(f1+f2,Z).i = diff(f1,Z).i + diff(f2,Z).i;

theorem 
  f1 is_differentiable_on n,Z & f2 is_differentiable_on n,Z & i<=n
  implies diff(f1-f2,Z).i = diff(f1,Z).i - diff(f2,Z).i;

theorem 
  f1 is_differentiable_on n,Z & f2 is_differentiable_on n,Z implies f1+
  f2 is_differentiable_on n,Z;

theorem 
  f1 is_differentiable_on n,Z & f2 is_differentiable_on n,Z implies f1-
  f2 is_differentiable_on n,Z;

theorem 
  f is_differentiable_on n,Z implies diff(r(#)f,Z).n = r(#)diff(f, Z).n;

theorem 
  f is_differentiable_on n,Z implies r(#)f is_differentiable_on n, Z;

theorem 
  f is_differentiable_on Z implies diff(f,Z).1 = f`|Z;

theorem 
  n>=1 & f1 is_differentiable_on n,Z implies diff(f1,Z).1=f1`|Z;

theorem 
  x in Z implies (diff(r(#)sin,Z).n).x = r*sin.(x + n*PI/2);

theorem 
  x in Z implies (diff(r(#)cos,Z).n).x = r*cos.(x + n*PI/2);

theorem 
  x in Z implies (diff(r(#)exp_R,Z).n).x = r*exp_R.x;

theorem 
  #Z n `| Z = (n(#) #Z (n-1)) | Z;

theorem 
  x <> 0 implies ( #Z n)^ is_differentiable_in x & diff(( #Z n)^,x
  ) = -(n * x #Z (n-1))/(x #Z n)^2;

theorem 
  n>=1 implies diff( #Z n,Z).2 = (n*(n-1)(#) #Z (n-2))|Z;

theorem 
  n>=2 implies diff( #Z n,Z).3 = (n*(n-1)*(n-2)(#) #Z (n-3))|Z;

theorem 
  n>m implies diff( #Z n,Z).m = ((n choose m)*(m!)(#) #Z (n-m)) |Z;

theorem 
  f is_differentiable_on n,Z implies diff(-f,Z).n = -diff(f,Z).n & -f
  is_differentiable_on n,Z;

theorem 
  x0 in Z implies Taylor(sin,Z,x0,x).n = sin.(x0+n*PI/2)*(x-x0)|^ n / (n
  !) & Taylor(cos,Z,x0,x).n = cos.(x0+n*PI/2)*(x-x0)|^ n / (n!);

theorem 
  r>0 implies Maclaurin(sin,].-r,r.[,x).n = sin.(n*PI/2)*x|^ n / (n!) &
  Maclaurin(cos,].-r,r.[,x).n = cos.(n*PI/2)*x|^ n / (n!);

theorem 
  n>m & x in Z implies (diff( #Z n,Z).m).x = (n choose m)*(m!)*x #Z (n-m);

theorem 
  x in Z implies (diff( #Z m,Z).m).x = m!;

theorem 
  #Z n is_differentiable_on n,Z;

theorem 
  x in Z & n>m implies (diff(a(#) #Z n,Z).m).x = a*(n choose m)*(m!)*x #Z (n-m)
;

theorem 
  x in Z implies (diff(a(#) #Z n,Z).n).x = a*(n!);

theorem 
  x0 in Z & n>m implies Taylor( #Z n,Z,x0,x).m = (n choose m)*x0
  #Z (n-m) *(x-x0)|^ m & Taylor( #Z n,Z,x0,x).n = (x-x0)|^ n;

theorem 
  for n,m be Element of NAT,r,x be Real st n>m & r>0 holds Maclaurin( #Z
  n,].-r,r.[,x).m = 0 & Maclaurin( #Z n,].-r,r.[,x).n = x|^ n;

theorem 
  not 0 in Z implies ( #Z n)^ is_differentiable_on Z;

theorem 
  not 0 in Z & x0 in Z implies ((( #Z n)^)`|Z).x0 =- n/( #Z (n+1)).x0;

theorem 
  x <> 0 implies (id REAL)^ is_differentiable_in x & diff((id REAL
  )^,x) = -1/x^2;

theorem 
  not 0 in Z implies ((id REAL)^)`|Z = ((-1)(#)(( #Z 2)^))|Z;

theorem 
  x <> 0 implies ( #Z 2)^ is_differentiable_in x & diff(( #Z 2)^,x
  ) = -(2 * x)/(x #Z 2)^2;

theorem 
  not 0 in Z implies (( #Z 2)^)`|Z = ((-2)(#)(( #Z 3)^))|Z;

theorem 
  not 0 in Z & n>=1 implies (( #Z n)^)`|Z = ((-n)(#)(( #Z (n+1))^) )|Z;

theorem 
  f1 is_differentiable_on 2,Z & f2 is_differentiable_on 2,Z
implies diff(f1(#)f2,Z).2 = (diff(f1,Z).2)(#)f2 + 2(#)((f1`|Z)(#)(f2`|Z)) + f1
  (#)(diff(f2,Z).2);

theorem 
  Z c= dom ln & Z c= dom((id REAL)^) implies ln`| Z = ((id REAL)^)| Z;

theorem 
  n>=1 & x0 in Z & not 0 in Z implies (diff((( #Z n)^),Z).2).x0 = n*(n+1
  )*((( #Z (n+2))^).x0);

theorem 
  diff(sin^2,Z).2 = 2(#)((cos^2)|Z) +(-2)(#)((sin^2)|Z);

theorem 
  diff(cos^2,Z).2 = 2(#)((sin^2)|Z) +(-2)(#)((cos^2)|Z);

theorem 
  diff(sin(#)cos,Z).2 = 4(#)((-sin)(#)cos)|Z;

theorem 
  Z c= dom tan implies tan is_differentiable_on Z & tan`|Z = ((cos ^)^2)|Z;

theorem 
  Z c= dom tan implies cos^ is_differentiable_on Z & (cos^)`|Z = (
  (cos^)(#)tan)|Z;

theorem 
  Z c= dom tan implies diff(tan,Z).2=2(#)((tan(#)(cos^)(#)(cos^))|Z);

theorem 
  Z c= dom cot implies cot is_differentiable_on Z & cot`|Z = ((-1)
  (#)((sin^)^2))|Z;

theorem 
  Z c= dom cot implies sin^ is_differentiable_on Z & (sin^)`|Z = (
  -(sin^)(#)cot)|Z;

theorem 
  Z c= dom cot implies diff(cot,Z).2=2(#)(cot(#)(sin^)(#)(sin^))|Z;

theorem 
  diff(exp_R(#)sin,Z).2 = 2(#)((exp_R(#)cos)|Z);

theorem 
  diff(exp_R(#)cos,Z).2 = 2(#)((exp_R(#)-sin)|Z);

theorem 
  f1 is_differentiable_on 3,Z & f2 is_differentiable_on 3,Z
implies diff(f1(#)f2,Z).3 =(diff(f1,Z).3)(#)f2 + (3(#)(diff(f1,Z).2(#)(f2`|Z))
  +3(#)((f1`|Z)(#)diff(f2,Z).2))+ f1(#)(diff(f2,Z).3);

theorem 
  diff(sin^2,Z).3=(-8)(#)((cos(#)sin)|Z);

theorem 
  f is_differentiable_on 2,Z implies diff(f^2,Z).2=2(#)(f(#)(diff(f,Z).2
  ))+2(#)((f`|Z)^2);

theorem 
  f is_differentiable_on 2,Z & (for x0 st x0 in Z holds f.x0 <> 0)
  implies diff(f^,Z).2=((2(#)(f`|Z)(#)(f`|Z)-diff(f,Z).2(#)f) /(f(#)(f(#)f)));

theorem 
  diff(exp_R(#)sin,Z).3=(2(#)(exp_R(#)((-sin)+cos)))|Z;














begin 

definition
  let D be set;
  let p, q be Element of D*;
  redefine func p^q -> Element of D*;
end;

registration
  let D be set;
  cluster empty for Element of D*;
end;

definition
  let D be set;
  redefine func <*> D -> empty Element of D*;
end;

definition
  let D be non empty set;
  let d be Element of D;
  redefine func <*d*> -> Element of D*;
  let e be Element of D;
  redefine func <*d,e*> -> Element of D*;
end;

begin 

registration
  let X be set;
  cluster -> FinSequence-like for Element of X*;
end;

definition
  let D be set, F be FinSequence of D*;
  func FlattenSeq F -> Element of D* means


  ex g being BinOp of D* st
  (for p, q being Element of D* holds g.(p,q) = p^q) & it = g "**" F;
end;

theorem 
  for D being set, d be Element of D* holds FlattenSeq <*d*> = d;



theorem 
  for D being set holds FlattenSeq <*>(D*) = <*>D;

theorem 
  for D being set, F,G be FinSequence of D* holds
  FlattenSeq (F ^ G) = FlattenSeq F ^ FlattenSeq G;

theorem 
  for D being set, p,q be Element of D* holds FlattenSeq <* p,q *> = p ^ q;

theorem 
  for D being set, p,q,r be Element of D* holds
  FlattenSeq <* p,q,r *> = p ^ q ^ r;



theorem 
  for D being set, F,G be FinSequence of D* holds
  F c= G implies FlattenSeq F c= FlattenSeq G;

begin 

reserve A,x,y,z for set,
  k for Element of NAT;

scheme 

  Regr1 { n() -> Nat, P[set] }: for k st k <= n() holds P[k]
provided
 P[n()] and
 for k st k < n() & P[k+1] holds P[k];

registration
  let n be Nat;
  cluster Seg (n+1) -> non empty;
end;

theorem 
  {}|_2 A = {};

registration
  let X be set;
  cluster non empty for Subset of Fin X;
end;

registration
  let X be non empty set;
  cluster non empty with_non-empty_elements for Subset of Fin X;
end;

registration
  let X be non empty set, F be non empty with_non-empty_elements Subset of Fin
  X;
  cluster non empty for Element of F;
end;

registration
  let X be non empty set;
  cluster with_non-empty_element for Subset of Fin X;
end;

definition
  let X be non empty set, R be Order of X, A be Subset of X;
  redefine func R|_2 A -> Order of A;
end;

scheme 

  SubFinite{D()->set, A()->Subset of D(), P[set]}: P[A()]
provided
 A() is finite and
 P[{}(D())] and
 for x being Element of D(), B being Subset of D() st x in A() & B c=
A() & P[B] holds P[B \/ {x}];

registration
  let X be non empty set, F be with_non-empty_element Subset of Fin X;
  cluster finite non empty for Element of F;
end;

theorem 
  for A,B being finite set st A c= B & card A = card B holds A = B;

definition
  let X be set, A be finite Subset of X, R be Order of X;
  assume
 R linearly_orders A;
  func SgmX (R,A) -> FinSequence of X means


  rng it = A & for n,m be Nat
st n in dom it & m in dom it & n < m holds it/.n <> it/.m & [it/.n,it/.m] in R;
end;

theorem 
  for X be set, A be finite Subset of X, R be Order of X, f be
FinSequence of X st rng f = A & for n,m be Nat st n in dom f & m in dom f & n <
  m holds f/.n <> f/.m & [f/.n, f/.m] in R holds f = SgmX(R,A);

registration
  let X be set, F be non empty Subset of Fin X;
  cluster -> finite for Element of F;
end;

definition
  let X be set, F be non empty Subset of Fin X;
  redefine mode Element of F -> Subset of X;
end;

theorem 
  for X being set, A being finite Subset of X, R being Order of X
  st R linearly_orders A holds SgmX(R,A) is one-to-one;

theorem 
  for X being set, A being finite Subset of X, R being Order of X
  st R linearly_orders A holds len(SgmX(R, A)) = card A;

begin 

reserve n for Nat,
  x for set;

theorem 
  for M be FinSequence st len M = n+1 holds len Del(M,n+1) = n;

theorem 
  for M being FinSequence st len M = n + 1 holds M = Del(M,len M) ^
  <*M.(len M)*>;

definition
  let IT be Function;
  attr IT is FinSequence-yielding means


  for x st x in dom IT holds IT.x is FinSequence;
end;

registration
  cluster FinSequence-yielding for Function;
end;

definition
  let F,G be FinSequence-yielding Function;
  func F^^G -> FinSequence-yielding Function means


  dom it = dom F /\
dom G & for i being set st i in dom it for f,g being FinSequence st f = F.i & g
  = G.i holds it.i = f^g;
end;

begin 

reserve V, C for set;

theorem 
  for V, C being non empty set ex f be Element of PFuncs (V, C) st f <> {};

theorem 
  for f being Element of PFuncs (V, C), g being set st g c= f holds
  g in PFuncs (V, C);

theorem 
  PFuncs(V,C) c= bool [:V,C:];

theorem 
  V is finite & C is finite implies PFuncs (V, C) is finite;

registration
  cluster functional finite non empty for set;
end;

begin 

registration
  let D be set;
  cluster -> FinSequence-yielding for FinSequence of D*;
end;

registration
  cluster FinSequence-yielding -> Function-yielding for Function;
end;

begin 

theorem 
  for X being set, R being Relation st field R c= X holds R is Relation of X;

registration
  let X be set, f be ManySortedSet of X, x, y be set;
  cluster f+*(x,y) -> X-defined;
end;

registration
  let X be set, f be ManySortedSet of X, x, y be set;
  cluster f+*(x,y) -> total for X-defined Function;
end;

theorem 
  for f being one-to-one Function holds card f = card rng f;

definition
  let A be set;
  let X be set, D be non empty FinSequenceSet of A,
      p be PartFunc of X,D, i be set;
  redefine func p/.i -> Element of D;
end;

registration
  let X be set;
  cluster being_linear-order well-ordering for Order of X;
end;

theorem 
  for X being non empty set, A being non empty finite Subset of X,
R being Order of X, x being Element of X st x in A & R linearly_orders A & for
  y being Element of X st y in A holds [x,y] in R holds (SgmX (R,A))/.1 = x;

theorem 
  for X being non empty set, A being non empty finite Subset of X,
R being Order of X, x being Element of X st x in A & R linearly_orders A & for
y being Element of X st y in A holds [y,x] in R holds SgmX (R,A)/.len SgmX (R,A
  ) = x;

registration
  let X be non empty set, A be non empty finite Subset of X, R be
  being_linear-order Order of X;
  cluster SgmX(R, A) -> non empty one-to-one;
end;

registration
  cluster empty -> FinSequence-yielding for Function;
end;

registration
  let F, G be FinSequence-yielding FinSequence;
  cluster F^^G -> FinSequence-like;
end;

registration
  let i be Element of NAT, f be FinSequence;
  cluster i |-> f -> FinSequence-yielding;
end;

registration
  let F be FinSequence-yielding FinSequence, x be set;
  cluster F.x -> FinSequence-like;
end;

registration
  let F be FinSequence;
  cluster Card F -> FinSequence-like;
end;

registration
  cluster Cardinal-yielding for FinSequence;
end;

theorem 
  for f being Function holds f is Cardinal-yielding iff for y
  being set st y in rng f holds y is Cardinal;

registration
  let F, G be Cardinal-yielding FinSequence;
  cluster F^G -> Cardinal-yielding;
end;

registration
  cluster -> Cardinal-yielding for FinSequence of NAT;
end;

registration
  cluster Cardinal-yielding for FinSequence of NAT;
end;

definition
  let D be set;
  let F be FinSequence of D*;
  redefine func Card F -> Cardinal-yielding FinSequence of NAT;
end;

registration
  let F be FinSequence of NAT, i be Element of NAT;
  cluster F|i -> Cardinal-yielding;
end;

theorem 
  for F being Function, X being set holds Card (F|X) = (Card F)|X;

registration
  let F be empty Function;
  cluster Card F -> empty;
end;

theorem 
  for p being set holds Card <*p*> = <*card p*>;

theorem 
  for F, G be FinSequence holds Card (F^G) = Card F ^ Card G;

registration
  let X be set;
  cluster <*>X -> FinSequence-yielding;
end;

registration
  let f be FinSequence;
  cluster <*f*> -> FinSequence-yielding;
end;

theorem 
  for f being Function holds f is FinSequence-yielding iff for y
  being set st y in rng f holds y is FinSequence;

registration
  let F, G be FinSequence-yielding FinSequence;
  cluster F^G -> FinSequence-yielding;
end;

registration
  let D be set, F be empty FinSequence of D*;
  cluster FlattenSeq F -> empty;
end;

theorem 
  for D being set, F being FinSequence of D* holds len FlattenSeq
  F = Sum Card F;

theorem 
  for D, E being set, F being FinSequence of D*, G being
FinSequence of E* st Card F = Card G holds len FlattenSeq F = len FlattenSeq G;

theorem 
  for D being set, F being FinSequence of D*, k being set st k in
dom FlattenSeq F ex i, j being Element of NAT st i in dom F & j in dom (F.i) &
  k = (Sum Card (F|(i-'1))) + j & (F.i).j = (FlattenSeq F).k;

theorem 
  for D being set, F being FinSequence of D*, i, j being Element
  of NAT st i in dom F & j in dom (F.i) holds (Sum Card (F|(i-'1))) + j in dom
  FlattenSeq F & (F.i).j = (FlattenSeq F).((Sum Card (F|(i-'1))) + j);

theorem 
  for X, Y being non empty set, f being FinSequence of X*, v being
  Function of X, Y holds (dom f --> v)**f is FinSequence of Y*;

theorem 
  for X, Y being non empty set, f being FinSequence of X*, v being
  Function of X, Y ex F being FinSequence of Y* st F = (dom f --> v)**f & v*
  FlattenSeq f = FlattenSeq F;

begin 

registration
  let f be natural-valued Function, x be set, n be Nat;
  cluster f+*(x,n) -> natural-valued;
end;

registration
  let f be real-valued Function, x be set, n be real number;
  cluster f+*(x,n) -> real-valued;
end;

definition
  let X be set, b1, b2 be complex-valued ManySortedSet of X;
  redefine func b1+b2 -> ManySortedSet of X means


  for x being set holds it.x = b1.x+b2.x;
end;

definition
  let X be set, b1, b2 be natural-valued ManySortedSet of X;
  func b1 -' b2 -> ManySortedSet of X means


  for x being set holds it.x = b1.x -' b2.x;
end;

theorem 
  for X being set, b, b1, b2 being real-valued ManySortedSet of X st for
  x being set st x in X holds b.x = b1.x+b2.x holds b = b1+b2;

theorem 
  for X being set, b, b1, b2 being natural-valued ManySortedSet of
  X st for x being set st x in X holds b.x = b1.x-'b2.x holds b = b1-'b2;

registration
  let X be set, b1, b2 be natural-valued ManySortedSet of X;
  cluster b1+b2 -> natural-valued;
  cluster b1-'b2 -> natural-valued;
end;

theorem 
  for X being set, b1, b2, b3 being real-valued ManySortedSet of X
  holds (b1+b2)+b3 = b1+(b2+b3);

theorem 
  for X being set, b, c, d being natural-valued ManySortedSet of X holds
  b-'c-'d = b-'(c+d);

begin 

definition
  let f be Function;
  func support f means


  for x being set holds x in it iff f.x <> 0;
end;

theorem 
  for f being Function holds support f c= dom f;

definition
  let f be Function;
  attr f is finite-support means


  support f is finite;
end;

registration
  cluster finite -> finite-support for Function;
end;

registration
  cluster natural-valued finite-support non empty for Function;
end;

registration
  let f be finite-support Function;
  cluster support f -> finite;
end;

registration
  let X be set;
  cluster finite-support for Function of X, NAT;
end;

registration
  let f be finite-support Function, x, y be set;
  cluster f+*(x,y) -> finite-support;
end;

registration
  let X be set;
  cluster natural-valued finite-support for ManySortedSet of X;
end;

theorem 
  for X being set, b1, b2 being natural-valued ManySortedSet of X
  holds support (b1+b2) = support b1 \/ support b2;

theorem 
  for X being set, b1, b2 being natural-valued ManySortedSet of X
  holds support (b1-'b2) c= support b1;

begin 

definition
  let X be set;
  mode bag of X is natural-valued finite-support ManySortedSet of X;
end;

registration
  let X be finite set;
  cluster -> finite-support for ManySortedSet of X;
end;

registration
  let X be set, b1, b2 be bag of X;
  cluster b1+b2 -> finite-support;
  cluster b1-'b2 -> finite-support;
end;

theorem 
  for X being set holds X--> 0 is bag of X;

definition
  let n be Ordinal, p, q be bag of n;
  pred p < q means


  ex k being Ordinal st p.k < q.k & for l being
  Ordinal st l in k holds p.l = q.l;
  asymmetry;
end;

theorem 
  for n being Ordinal, p, q, r being bag of n st p < q & q < r holds p < r;

definition
  let n be Ordinal, p, q be bag of n;
  pred p <=' q means


  p < q or p = q;
  reflexivity;
end;

theorem 
  for n being Ordinal, p, q, r being bag of n st p <=' q & q <=' r
  holds p <=' r;

theorem 
  for n being Ordinal, p, q, r being bag of n st p < q & q <=' r holds p < r;

theorem 
  for n being Ordinal, p, q, r being bag of n st p <=' q & q < r holds p < r;

theorem 
  for n being Ordinal, p, q being bag of n holds p <=' q or q <=' p;

definition
  let X be set, d, b be bag of X;
  pred d divides b means


  for k being set holds d.k <= b.k;
  reflexivity;
end;

theorem 
  for n being set, d, b being bag of n st for k being set st k in
  n holds d.k <= b.k holds d divides b;

theorem 
  for n being Ordinal, b1, b2 being bag of n st b1 divides b2
  holds b2 -' b1 + b1 = b2;

theorem 
  for X being set, b1, b2 being bag of X holds b2 + b1 -' b1 = b2;

theorem 
  for n being Ordinal, d, b being bag of n st d divides b holds d <=' b;

theorem 
  for n being set, b,b1,b2 being bag of n st b = b1 + b2 holds b1 divides b;

definition
  let X be set;
  func Bags X means


  for x being set holds x in it iff x is bag of X;
end;

definition
  let X be set;
  redefine func Bags X -> Subset of Bags X;
end;

theorem 
  Bags {} = {{}};

registration
  let X be set;
  cluster Bags X -> non empty;
end;

registration
  let X be set;
  cluster -> functional for Subset of Bags X;
end;

registration
  let X be set, B be Subset of Bags X;
  cluster -> X-defined for Element of B;
end;

registration
  let X be set, B be non empty Subset of Bags X;
  cluster -> total natural-valued finite-support for Element of B;
end;

definition
  let X be set;
  func EmptyBag X -> Element of Bags X equals

  X --> 0;
end;

theorem 
  for X, x being set holds (EmptyBag X).x = 0;

theorem 
  for X be set, b being bag of X holds b+EmptyBag X = b;

theorem 
  for X be set, b being bag of X holds b-'EmptyBag X = b;

theorem 
  for X be set, b being bag of X holds (EmptyBag X) -' b = EmptyBag X;

theorem 
  for X being set, b being bag of X holds b-'b = EmptyBag X;

theorem 
  for n being set, b1, b2 be bag of n st b1 divides b2 & b2 -' b1
  = EmptyBag n holds b2 = b1;

theorem 
  for n being set, b being bag of n st b divides EmptyBag n holds
  EmptyBag n = b;

theorem 
  for n being set, b being bag of n holds EmptyBag n divides b;

theorem 
  for n being Ordinal, b being bag of n holds EmptyBag n <=' b;

definition
  let n be Ordinal;
  func BagOrder n -> Order of Bags n means


  for p, q being bag of n holds [p, q] in it iff p <=' q;
end;

registration
  let n be Ordinal;
  cluster BagOrder n -> being_linear-order;
end;

definition
  let X be set, f be Function of X, NAT;
  func NatMinor f -> Subset of Funcs(X, NAT) means


  for g being
  natural-valued ManySortedSet of X holds g in it iff for x being set st x in X
  holds g.x <= f.x;
end;

theorem 
  for X being set, f being Function of X, NAT holds f in NatMinor f;

registration
  let X be set, f be Function of X, NAT;
  cluster NatMinor f -> non empty functional;
end;

registration
  let X be set, f be Function of X, NAT;
  cluster -> natural-valued for Element of NatMinor f;
end;

theorem 
  for X being set, f being finite-support Function of X, NAT holds
  NatMinor f c= Bags X;

definition
  let X be set, f be finite-support Function of X, NAT;
  redefine func support f -> Element of Fin X;
end;

theorem 
  for X being non empty set, f being finite-support Function of X,
  NAT holds card NatMinor f = multnat $$ (support f, addnat[:](f,1));

registration
  let X be set, f be finite-support Function of X, NAT;
  cluster NatMinor f -> finite;
end;

definition
  let n be Ordinal, b be bag of n;
  func divisors b -> FinSequence of Bags n means


  ex S being non empty
  finite Subset of Bags n st it = SgmX(BagOrder n, S) & for p being bag of n
  holds p in S iff p divides b;
end;

registration
  let n be Ordinal, b be bag of n;
  cluster divisors b -> non empty one-to-one;
end;

theorem 
  for n being Ordinal,i being Element of NAT, b being bag of n st
  i in dom divisors b holds ((divisors b)/.i) qua Element of Bags n divides b;

theorem 
  for n being Ordinal, b being bag of n holds (divisors b)/.1 =
  EmptyBag n & (divisors b)/.len divisors b = b;

theorem 
  for n being Ordinal, i being Nat, b, b1, b2 being bag of n st i
> 1 & i < len divisors b holds (divisors b)/.i <> EmptyBag n & (divisors b)/.i
  <> b;

theorem 
  for n being Ordinal holds divisors EmptyBag n = <* EmptyBag n *>;

definition
  let n be Ordinal, b be bag of n;
  func decomp b -> FinSequence of 2-tuples_on Bags n means


  dom it = dom divisors b &
   for i being Element of NAT, p being bag of n st i in dom it &
    p = (divisors b)/.i holds it/.i = <*p, b-'p*>;
end;

theorem 
  for n being Ordinal, i being Element of NAT, b being bag of n st
i in dom decomp b ex b1, b2 being bag of n st (decomp b)/.i = <*b1, b2*> & b =
  b1+b2;

theorem 
  for n being Ordinal, b, b1, b2 being bag of n st b = b1+b2 ex i
  being Element of NAT st i in dom decomp b & (decomp b)/.i = <*b1, b2*>;

theorem 
  for n being Ordinal, i being Element of NAT, b,b1,b2 being bag
of n st i in dom decomp b & (decomp b)/.i = <*b1, b2*> holds b1 = (divisors b)
  /.i;

registration
  let n be Ordinal, b be bag of n;
  cluster decomp b -> non empty one-to-one FinSequence-yielding;
end;

registration
  let n be Ordinal, b be Element of Bags n;
  cluster decomp b -> non empty one-to-one FinSequence-yielding;
end;

theorem 
  for n being Ordinal, b being bag of n holds (decomp b)/.1 = <*
  EmptyBag n, b*> & (decomp b)/.len decomp b = <*b, EmptyBag n*>;

theorem 
  for n being Ordinal, i being Nat, b, b1, b2 being bag of n st i
> 1 & i < len decomp b & (decomp b)/.i = <*b1, b2*> holds b1 <> EmptyBag n & b2
  <> EmptyBag n;

theorem 
  for n being Ordinal holds decomp EmptyBag n = <* <*EmptyBag n,
  EmptyBag n*> *>;

theorem 
  for n being Ordinal, b being bag of n, f, g being FinSequence of
  (3-tuples_on Bags n)* st dom f = dom decomp b & dom g = dom decomp b &
  (for k being Nat st k in dom f
   holds f.k = ((decomp ((((decomp b)/.k
    qua Element of 2-tuples_on Bags n)/.1) qua Element
  of Bags n))) ^^ ((len (decomp
   ((((decomp b)/.k qua Element of 2-tuples_on Bags n)/.1)
    qua Element of Bags n)))
|-> <*(((decomp b)/.k qua Element of 2-tuples_on Bags n)/.2)*>)) &
 (for k being Nat st k in dom g holds g.k = ((
len (decomp ((((decomp b)/.k qua Element of 2-tuples_on Bags n)/.2)
qua Element of Bags n)))
 |-> <*((decomp b)/.k qua Element of 2-tuples_on Bags n)/.1*>)
   ^^ (decomp ((((decomp b)/.k qua Element of 2-tuples_on Bags n)/.2)
   qua Element of Bags n))) ex p being
  Permutation of dom FlattenSeq f st FlattenSeq g = (FlattenSeq f)*p;

theorem 
  for X being set, b1, b2 being real-valued ManySortedSet of X holds
  support (b1+b2) c= support b1 \/ support b2;

registration
  let D be non empty set;
  let n be Element of NAT;
  cluster -> FinSequence-yielding for FinSequence of n-tuples_on D;
end;

registration let k be Element of NAT;
  let D be non empty set, M be FinSequence of k-tuples_on D;
  let x be set;
  cluster M/.x  -> Function-like Relation-like;
end;

registration let k be Element of NAT;
  let D be non empty set, M be FinSequence of k-tuples_on D;
  let x be set;
  cluster M/.x  -> D-valued FinSequence-like;
end;















begin

reserve k,i for Nat;
reserve D for non empty set;

definition let D;

  let p be XFinSequence of D, q be FinSequence of D;
  pred p is_an_xrep_of q means

  NAT c= D & (p.0)=len q & len q < len p &
  for i st 1<=i & i<=len q holds p.i=q.i;
end;

theorem 
  for p being XFinSequence of D st NAT c= D &
  (p.0) is Nat & (p.0) in len p holds p is_an_xrep_of (XFS2FS*(p));

definition
  let x,y,a,b,c be set;
  func IFLGT(x,y,a,b,c) -> set equals

  a if x in y, b if x = y otherwise
  c;
end;

theorem 
  for q being FinSequence of D, n being Nat st NAT c= D & n>len q
  holds ex p being XFinSequence of D st len p=n & p is_an_xrep_of q;













definition
  let a,b be XFinSequence of REAL;
  assume that
 b.0 is Nat and
 b.0 < len a;
  func inner_prd_prg(a,b) -> Real means


  ex s being XFinSequence of REAL
  , n being Integer st len s=len a & s.0=0 & n= b.0 & (n<>0 implies for i being
  Nat st i<n holds s.(i+1)=s.i + (a.(i+1))*(b.(i+1)) ) & it=s.n;
end;

theorem 
  for a being FinSequence of REAL, s being XFinSequence of REAL st
  s.0=0 & (for i st i<len a holds s.(i+1)=s.i+a.(i+1)) holds Sum a =s.(len a);

theorem 
  for a being FinSequence of REAL holds ex s being XFinSequence of REAL
st len s=len a +1 & s.0=0 & (for i st i<len a holds s.(i+1)=s.i+a.(i+1)) & Sum
  a =s.(len a);

theorem 
  for a,b being FinSequence of REAL, n being Nat st len a=len b & n>len
  a holds |(a,b)| = inner_prd_prg(FS2XFS*(a,n),FS2XFS*(b,n));




























definition
  let b,c be XFinSequence of REAL,a be Real,m be Integer;
  pred m scalar_prd_prg c,a,b means


  len c =m & len b =m & ex n being
Integer st c.0=b.0 & n=b.0 & (n<>0 implies for i being Nat st 1<=i & i<=n holds
  c.i=a*(b.i));
end;

theorem 
  for b being non empty XFinSequence of REAL, a being Real,m being Nat
  st b.0 is Nat & len b=m & b.0 < m holds (ex c being XFinSequence of REAL st m
  scalar_prd_prg c,a,b)& for c being non empty XFinSequence of REAL st m
  scalar_prd_prg c,a,b holds (XFS2FS*(c))=a*(XFS2FS*(b));














definition
  let b,c be XFinSequence of REAL,m be Integer;
  pred m vector_minus_prg c,b means


  len c =m & len b =m & ex n being
  Integer st c.0=b.0 & n= b.0 & (n<>0 implies for i being Nat st 1<=i & i<=n
  holds c.i= -(b.i));
end;

theorem 
  for b being non empty XFinSequence of REAL,m being Nat st b.0 is Nat &
len b=m & b.0 < m holds (ex c being XFinSequence of REAL st m vector_minus_prg
  c,b)& for c being non empty XFinSequence of REAL st m vector_minus_prg c,b
  holds (XFS2FS*(c))= -(XFS2FS*(b));

















definition
  let a,b,c be XFinSequence of REAL,m be Integer;
  pred m vector_add_prg c,a,b means


  len c =m & len a=m & len b =m & ex
n being Integer st c.0=b.0 & n=b.0 & (n<>0 implies for i being Nat st 1<=i & i
  <=n holds c.i=(a.i)+(b.i) );
end;

theorem 
  for a,b being non empty XFinSequence of REAL, m being Nat st b.0 is
  Nat & len a=m & len b=m & a.0=b.0 & b.0 < m holds (ex c being XFinSequence of
REAL st m vector_add_prg c,a,b)& for c being non empty XFinSequence of REAL st
  m vector_add_prg c,a,b holds (XFS2FS*(c))=(XFS2FS*(a))+(XFS2FS*(b));

















definition
  let a,b,c be XFinSequence of REAL,m be Integer;
  pred m vector_sub_prg c,a,b means

  len c =m & len a=m & len b =m & ex n being Integer st c.0=b.0 & n=b.0 &
  (n<>0 implies for i being Nat st 1<=i & i <=n holds c.i=(a.i)-(b.i) );
end;

theorem 
  for a,b being non empty XFinSequence of REAL, m being Nat st b.0 is
  Nat & len a=m & len b=m & a.0=b.0 & b.0 < m holds (ex c being XFinSequence of
REAL st m vector_sub_prg c,a,b) & for c being non empty XFinSequence of REAL st
  m vector_sub_prg c,a,b holds XFS2FS*(c)=XFS2FS*(a)-XFS2FS*(b);














begin 

reserve x, r, s, h for Real,

  n for Element of NAT,
  rr, y for set,
  Z for open Subset of REAL,

  f, f1, f2 for PartFunc of REAL,REAL;

theorem 
  ].-PI/2,PI/2.[ c= dom tan;

theorem 
  ].0,PI.[ c= dom cot;

theorem 
  tan is_differentiable_on ].-PI/2,PI/2.[ & for x st x in ].-PI/2,PI/2.[
  holds diff(tan,x) = 1/(cos.x)^2;

theorem 
  cot is_differentiable_on ].0,PI.[ & for x st x in ].0,PI.[ holds diff(
  cot,x) = -1/(sin.x)^2;

theorem 
  tan|].-PI/2,PI/2.[ is continuous;

theorem 
  cot|].0,PI.[ is continuous;

theorem 
  tan|].-PI/2,PI/2.[ is increasing;

theorem 
  cot|].0,PI.[ is decreasing;

theorem 
  tan | ].-PI/2,PI/2.[ is one-to-one;

theorem 
  cot | ].0,PI.[ is one-to-one;

registration
  cluster tan | ].-PI/2,PI/2.[ -> one-to-one;
  cluster cot | ].0,PI.[ -> one-to-one;
end;

definition
  func arctan -> PartFunc of REAL,REAL equals

  (tan | ].-PI/2,PI/2.[)";
  func arccot -> PartFunc of REAL, REAL equals

  (cot | ].0,PI.[)";
end;

definition
  let r be Real;
  func arctan r equals

  arctan.r;
  func arccot r equals

  arccot.r;
end;

definition
  let r be Real;
  redefine func arctan r -> Real;
  redefine func arccot r -> Real;
end;

theorem 
  rng arctan = ].-PI/2,PI/2.[;

theorem 
  rng arccot = ].0,PI.[;

registration
  cluster arctan -> one-to-one;
  cluster arccot -> one-to-one;
end;

theorem 
  for x be real number st x in ].-PI/2,PI/2.[ holds tan.x = tan x;

theorem 
  for x be real number st x in ].0,PI.[ holds cot.x = cot x;

theorem 
  for x be Real st cos.x <> 0 holds tan.x = tan x;

theorem 
  for x be Real st sin.x <> 0 holds cot.x = cot x;

theorem 
  tan.(-PI/4) = -1 & tan(-PI/4) = -1;

theorem 
  cot.(PI/4) = 1 & cot(PI/4) = 1 & cot.(3/4*PI) = -1 & cot(3/4*PI) = -1;

theorem 
  for x be set st x in [.-PI/4,PI/4.] holds tan.x in [.-1,1.];

theorem 
  for x be set st x in [.PI/4,3/4*PI.] holds cot.x in [.-1,1.];

theorem 
  rng (tan | [.-PI/4,PI/4.]) = [.-1,1.];

theorem 
  rng (cot | [.PI/4,3/4*PI.]) = [.-1,1.];

theorem 
  [.-1,1.] c= dom arctan;

theorem 
  [.-1,1.] c= dom arccot;

registration
  cluster tan | [.-PI/4,PI/4.] -> one-to-one;
  cluster cot | [.PI/4,3/4*PI.] -> one-to-one;
end;

theorem 
  arctan | [.-1,1.] = (tan | [.-PI/4,PI/4.])";

theorem 
  arccot | [.-1,1.] = (cot | [.PI/4,3/4*PI.])";

theorem 
  (tan | [.-PI/4,PI/4.]) qua Function * (arctan | [.-1,1.]) = id [.-1,1
  .];

theorem 
  (cot | [.PI/4,3/4*PI.]) qua Function * (arccot | [.-1,1.]) = id [.-1,1
  .];

theorem 
  (tan | [.-PI/4,PI/4.]) * (arctan | [.-1,1.]) = id [.-1,1.];

theorem 
  (cot | [.PI/4,3/4*PI.]) * (arccot | [.-1,1.]) = id [.-1,1.];

theorem 
  (arctan qua Function) * (tan | ].-PI/2,PI/2.[) = id ].-PI/2,PI/2
  .[;

theorem 
  arccot * (cot | ].0,PI.[) = id ].0,PI.[;

theorem 
  arctan qua Function * (tan | ].-PI/2,PI/2.[) = id ].-PI/2,PI/2.[;

theorem 
  arccot qua Function * (cot | ].0,PI.[) = id ].0,PI.[;

theorem 
  -PI/2 < r & r < PI/2 implies arctan tan.r = r & arctan tan r = r;

theorem 
  0 < r & r < PI implies arccot cot.r = r & arccot cot r = r;

theorem 
  arctan (-1) = -PI/4 & arctan.(-1) = -PI/4;

theorem 
  arccot (-1) = 3/4*PI & arccot.(-1) = 3/4*PI;

theorem 
  arctan 1 = PI/4 & arctan.1 = PI/4;

theorem 
  arccot 1 = PI/4 & arccot.1 = PI/4;

theorem 
  tan.0 = 0 & tan 0 =0;

theorem 
  cot.(PI/2) = 0 & cot (PI/2) = 0;

theorem 
  arctan 0 = 0 & arctan.0 = 0;

theorem 
  arccot 0 = PI/2 & arccot.0 = PI/2;

theorem 
  arctan|(tan.:].-PI/2,PI/2.[) is increasing;

theorem 
  arccot|(cot.:].0,PI.[) is decreasing;

theorem 
  arctan|[.-1,1.] is increasing;

theorem 
  arccot|[.-1,1.] is decreasing;

theorem 
  for x be set st x in [.-1,1.] holds arctan.x in [.-PI/4,PI/4.];

theorem 
  for x be set st x in [.-1,1.] holds arccot.x in [.PI/4,3/4*PI.];

theorem 
  -1 <= r & r <= 1 implies tan arctan r = r;

theorem 
  -1 <= r & r <= 1 implies cot arccot r = r;

theorem 
  arctan|[.-1,1.] is continuous;

theorem 
  arccot|[.-1,1.] is continuous;

theorem 
  rng(arctan | [.-1,1.]) = [.-PI/4,PI/4.];

theorem 
  rng(arccot | [.-1,1.]) = [.PI/4,3/4*PI.];

theorem 
  -1 <= r & r <= 1 & arctan r = -PI/4 implies r = -1;

theorem 
  -1 <= r & r <= 1 & arccot r = 3/4*PI implies r = -1;

theorem 
  -1 <= r & r <= 1 & arctan r = 0 implies r = 0;

theorem 
  -1 <= r & r <= 1 & arccot r = PI/2 implies r = 0;

theorem 
  -1 <= r & r <= 1 & arctan r = PI/4 implies r = 1;

theorem 
  -1 <= r & r <= 1 & arccot r = PI/4 implies r = 1;

theorem 
  -1 <= r & r <= 1 implies -PI/4 <= arctan r & arctan r <= PI/4;

theorem 
  -1 <= r & r <= 1 implies PI/4 <= arccot r & arccot r <= 3/4*PI;

theorem 
  -1 < r & r < 1 implies -PI/4 < arctan r & arctan r < PI/4;

theorem 
  -1 < r & r < 1 implies PI/4 < arccot r & arccot r < 3/4*PI;

theorem 
  -1 <= r & r <= 1 implies arctan r = -arctan(-r);

theorem 
  -1 <= r & r <= 1 implies arccot r = PI - arccot(-r);

theorem 
  -1 <= r & r <= 1 implies cot arctan r = 1/r;

theorem 
  -1 <= r & r <= 1 implies tan arccot r = 1/r;

theorem 
  arctan is_differentiable_on tan.:].-PI/2,PI/2.[;

theorem 
  arccot is_differentiable_on cot.:].0,PI.[;

theorem 
  arctan is_differentiable_on ].-1,1.[;

theorem 
  arccot is_differentiable_on ].-1,1.[;

theorem 
  -1 <= r & r <= 1 implies diff(arctan,r) = 1/(1+r^2);

theorem 
  -1 <= r & r <= 1 implies diff(arccot,r) = -1/(1+r^2);

theorem 
  arctan|(tan.:].-PI/2,PI/2.[) is continuous;

theorem 
  arccot|(cot.:].0,PI.[) is continuous;

theorem 
  dom arctan is open;

theorem 
  dom arccot is open;

begin 


theorem 
  Z c= ].-1,1.[ implies arctan is_differentiable_on Z & for x st x
  in Z holds ((arctan)`|Z).x = 1/(1+x^2);



theorem 
  Z c= ].-1,1.[ implies arccot is_differentiable_on Z & for x st x
  in Z holds ((arccot)`|Z).x = -1/(1+x^2);



theorem 
  Z c= ].-1,1.[ implies r(#)arctan is_differentiable_on Z & for x st x
  in Z holds ((r(#)arctan)`|Z).x = r/(1+x^2);



theorem 
  Z c= ].-1,1.[ implies r(#)arccot is_differentiable_on Z & for x st x
  in Z holds ((r(#)arccot)`|Z).x = -r/(1+x^2);

theorem 
  f is_differentiable_in x & f.x > -1 & f.x < 1 implies (arctan)*f
  is_differentiable_in x & diff((arctan)*f,x) = diff(f,x)/(1+(f.x)^2);

theorem 
  f is_differentiable_in x & f.x > -1 & f.x < 1 implies (arccot)*f
  is_differentiable_in x & diff((arccot)*f,x) = -diff(f,x)/(1+(f.x)^2);



theorem 
  Z c= dom ((arctan)*f) & (for x st x in Z holds f.x=r*x+s & f.x >
-1 & f.x < 1) implies (arctan)*f is_differentiable_on Z & for x st x in Z holds
  (((arctan)*f)`|Z).x = r/(1+(r*x+s)^2);



theorem 
  Z c= dom ((arccot)*f) & (for x st x in Z holds f.x=r*x+s & f.x >
-1 & f.x < 1) implies (arccot)*f is_differentiable_on Z & for x st x in Z holds
  (((arccot)*f)`|Z).x = -r/(1+(r*x+s)^2);



theorem 
  Z c= dom (ln*(arctan)) & Z c= ].-1,1.[ & (for x st x in Z holds arctan
.x>0) implies ln*(arctan) is_differentiable_on Z & for x st x in Z holds ((ln*(
  arctan))`|Z).x = 1/((1+x^2)*arctan.x);



theorem 
  Z c= dom (ln*(arccot)) & Z c= ].-1,1.[ & (for x st x in Z holds arccot
.x>0) implies ln*(arccot) is_differentiable_on Z & for x st x in Z holds ((ln*(
  arccot))`|Z).x = -1/((1+x^2)*arccot.x);



theorem 
  Z c= dom (( #Z n)*(arctan)) & Z c=].-1,1.[ implies ( #Z n)*(
arctan) is_differentiable_on Z & for x st x in Z holds ((( #Z n)*arctan)`|Z).x
  = n*(arctan.x) #Z (n-1) / (1+x^2);



theorem 
  Z c= dom (( #Z n)*(arccot)) & Z c=].-1,1.[ implies ( #Z n)*(
arccot) is_differentiable_on Z & for x st x in Z holds ((( #Z n)*arccot)`|Z).x
  = -n*(arccot.x) #Z (n-1) / (1+x^2);



theorem 
  Z c= dom ((1/2)(#)(( #Z 2)*(arctan))) & Z c=].-1,1.[ implies (1/2)(#)(
  ( #Z 2)*(arctan)) is_differentiable_on Z & for x st x in Z holds (((1/2)(#)((
  #Z 2)*(arctan)))`|Z).x = arctan.x / (1+x^2);



theorem 
  Z c= dom ((1/2)(#)(( #Z 2)*(arccot))) & Z c=].-1,1.[ implies (1/2)(#)(
  ( #Z 2)*(arccot)) is_differentiable_on Z & for x st x in Z holds (((1/2)(#)((
  #Z 2)*(arccot)))`|Z).x = -arccot.x / (1+x^2);



theorem 
  Z c= ].-1,1.[ implies (id Z)(#)(arctan) is_differentiable_on Z &
  for x st x in Z holds (((id Z)(#)(arctan))`|Z).x = arctan.x + x/(1+x^2);



theorem 
  Z c= ].-1,1.[ implies (id Z)(#)(arccot) is_differentiable_on Z &
  for x st x in Z holds (((id Z)(#)(arccot))`|Z).x = arccot.x - x/(1+x^2);



theorem 
  Z c= dom (f(#)(arctan)) & Z c= ].-1,1.[ & (for x st x in Z holds f.x=r
  *x+s) implies f(#)(arctan) is_differentiable_on Z & for x st x in Z holds ((f
  (#)(arctan))`|Z).x = r*arctan.x + (r*x+s)/(1+x^2);



theorem 
  Z c= dom (f(#)(arccot)) & Z c= ].-1,1.[ & (for x st x in Z holds f.x=r
  *x+s) implies f(#)(arccot) is_differentiable_on Z & for x st x in Z holds ((f
  (#)(arccot))`|Z).x = r*arccot.x - (r*x+s)/(1+x^2);



theorem 
  Z c= dom ((1/2)(#)((arctan)*f)) & (for x st x in Z holds f.x=2*x & f.x
> -1 & f.x < 1) implies (1/2)(#)((arctan)*f) is_differentiable_on Z & for x st
  x in Z holds (((1/2)(#)((arctan)*f))`|Z).x = 1/(1+(2*x)^2);



theorem 
  Z c= dom ((1/2)(#)((arccot)*f)) & (for x st x in Z holds f.x=2*x & f.x
> -1 & f.x < 1) implies (1/2)(#)((arccot)*f) is_differentiable_on Z & for x st
  x in Z holds (((1/2)(#)((arccot)*f))`|Z).x = -1/(1+(2*x)^2);



theorem 
  Z c= dom (f1+f2) & (for x st x in Z holds f1.x=1) & f2=#Z 2
implies f1+f2 is_differentiable_on Z & for x st x in Z holds ((f1+f2)`|Z).x = 2
  *x;



theorem 
  Z c= dom ((1/2)(#)(ln*(f1+f2))) & f2=#Z 2 & (for x st x in Z
holds f1.x=1 ) implies ((1/2)(#)(ln*(f1+f2))) is_differentiable_on Z & for x st
  x in Z holds (((1/2)(#)(ln*(f1+f2)))`|Z).x = x/(1+x^2);



theorem 
  Z c= dom ((id Z)(#)(arctan)-(1/2)(#)(ln*(f1+f2))) & Z c= ].-1,1.[ & f2
=#Z 2 & (for x st x in Z holds f1.x=1 ) implies (id Z)(#)(arctan)-(1/2)(#)(ln*(
f1+f2)) is_differentiable_on Z & for x st x in Z holds (((id Z)(#)(arctan)-(1/2
  )(#)(ln*(f1+f2)))`|Z).x = arctan.x;



theorem 
  Z c= dom ((id Z)(#)(arccot)+(1/2)(#)(ln*(f1+f2))) & Z c= ].-1,1.[ & f2
=#Z 2 & (for x st x in Z holds f1.x=1 ) implies (id Z)(#)(arccot)+(1/2)(#)(ln*(
f1+f2)) is_differentiable_on Z & for x st x in Z holds (((id Z)(#)(arccot)+(1/2
  )(#)(ln*(f1+f2)))`|Z).x = arccot.x;



theorem 
  Z c= dom ((id Z)(#)((arctan)*f)) & (for x st x in Z holds f.x=x
/r & f.x > -1 & f.x < 1) implies (id Z)(#)((arctan)*f) is_differentiable_on Z &
for x st x in Z holds (((id Z)(#)((arctan)*f))`|Z).x = arctan.(x/r)+x/(r*(1+(x/
  r)^2));



theorem 
  Z c= dom ((id Z)(#)((arccot)*f)) & (for x st x in Z holds f.x=x
/r & f.x > -1 & f.x < 1) implies (id Z)(#)((arccot)*f) is_differentiable_on Z &
for x st x in Z holds (((id Z)(#)((arccot)*f))`|Z).x = arccot.(x/r)-x/(r*(1+(x/
  r)^2));



theorem 
  Z c= dom (f1+f2) & (for x st x in Z holds f1.x=1) & f2=( #Z 2)*
f & (for x st x in Z holds f.x=x/r) implies f1+f2 is_differentiable_on Z & for
  x st x in Z holds ((f1+f2)`|Z).x = (2*x)/(r^2);



theorem 
  Z c= dom ((r/2)(#)(ln*(f1+f2))) & (for x st x in Z holds f1.x=1
) & r <> 0 & f2=( #Z 2)*f & (for x st x in Z holds f.x=x/r) implies ((r/2)(#)(
ln*(f1+f2))) is_differentiable_on Z & for x st x in Z holds (((r/2)(#)(ln*(f1+
  f2)))`|Z).x = x/(r*(1+(x/r)^2));



theorem 
  Z c= dom ((id Z)(#)((arctan)*f)-(r/2)(#)(ln*(f1+f2))) & r <> 0 & (for
x st x in Z holds f.x=x/r & f.x > -1 & f.x < 1) & (for x st x in Z holds f1.x=1
) & f2=( #Z 2)*f & (for x st x in Z holds f.x=x/r) implies (id Z)(#)((arctan)*f
)-(r/2)(#)(ln*(f1+f2)) is_differentiable_on Z & for x st x in Z holds (((id Z)
  (#)((arctan)*f)-(r/2)(#)(ln*(f1+f2)))`|Z).x = arctan.(x/r);



theorem 
  Z c= dom ((id Z)(#)((arccot)*f)+(r/2)(#)(ln*(f1+f2))) & r <> 0 & (for
x st x in Z holds f.x=x/r & f.x > -1 & f.x < 1) & (for x st x in Z holds f1.x=1
) & f2=( #Z 2)*f & (for x st x in Z holds f.x=x/r) implies (id Z)(#)((arccot)*f
)+(r/2)(#)(ln*(f1+f2)) is_differentiable_on Z & for x st x in Z holds (((id Z)
  (#)((arccot)*f)+(r/2)(#)(ln*(f1+f2)))`|Z).x = arccot.(x/r);



theorem 
  not 0 in Z & Z c= dom (arctan*((id Z)^)) & (for x st x in Z holds ((id
Z)^).x > -1 & ((id Z)^).x < 1) implies (arctan*((id Z)^)) is_differentiable_on
  Z & for x st x in Z holds ((arctan*((id Z)^))`|Z).x = -1/(1+x^2);



theorem 
  not 0 in Z & Z c= dom (arccot*((id Z)^)) & (for x st x in Z holds ((id
Z)^).x > -1 & ((id Z)^).x < 1) implies (arccot*((id Z)^)) is_differentiable_on
  Z & for x st x in Z holds ((arccot*((id Z)^))`|Z).x = 1/(1+x^2);



theorem 
  Z c= dom (arctan*f) & f=f1+h(#)f2 & (for x st x in Z holds f.x > -1 &
f.x < 1) & (for x st x in Z holds f1.x = r+s*x) & f2=#Z 2 implies arctan*(f1+h
(#)f2) is_differentiable_on Z & for x st x in Z holds ((arctan*(f1+h(#)f2))`|Z)
  .x = (s+2*h*x)/(1+(r+s*x+h*x^2)^2);



theorem 
  Z c= dom (arccot*f) & f=f1+h(#)f2 & (for x st x in Z holds f.x > -1 &
f.x < 1) & (for x st x in Z holds f1.x = r+s*x) & f2=#Z 2 implies arccot*(f1+h
(#)f2) is_differentiable_on Z & for x st x in Z holds ((arccot*(f1+h(#)f2))`|Z)
  .x = -(s+2*h*x)/(1+(r+s*x+h*x^2)^2);



theorem 
  Z c= dom (arctan*exp_R) & (for x st x in Z holds exp_R.x < 1) implies
arctan*exp_R is_differentiable_on Z & for x st x in Z holds ((arctan*exp_R)`|Z)
  .x = exp_R.x/(1+(exp_R.x)^2);



theorem 
  Z c= dom (arccot*exp_R) & (for x st x in Z holds exp_R.x < 1) implies
arccot*exp_R is_differentiable_on Z & for x st x in Z holds ((arccot*exp_R)`|Z)
  .x = -exp_R.x/(1+(exp_R.x)^2);



theorem 
  Z c= dom (arctan*ln) & (for x st x in Z holds ln.x > -1 & ln.x < 1)
implies arctan*ln is_differentiable_on Z & for x st x in Z holds ((arctan*ln)`|
  Z).x = 1/(x*(1+(ln.x)^2));



theorem 
  Z c= dom (arccot*ln) & (for x st x in Z holds ln.x > -1 & ln.x < 1)
implies arccot*ln is_differentiable_on Z & for x st x in Z holds ((arccot*ln)`|
  Z).x = -1/(x*(1+(ln.x)^2));



theorem 
  Z c= dom (exp_R*arctan) & Z c= ].-1,1.[ implies exp_R*arctan
is_differentiable_on Z & for x st x in Z holds ((exp_R*arctan)`|Z).x = exp_R.(
  arctan.x)/(1+x^2);



theorem 
  Z c= dom (exp_R*arccot) & Z c= ].-1,1.[ implies exp_R*arccot
is_differentiable_on Z & for x st x in Z holds ((exp_R*arccot)`|Z).x = -exp_R.(
  arccot.x)/(1+x^2);



theorem 
  Z c= dom (arctan-id Z) & Z c= ].-1,1.[ implies arctan-id Z
is_differentiable_on Z & for x st x in Z holds ((arctan-id Z)`|Z).x = -x^2/(1+x
  ^2);



theorem 
  Z c= dom (-arccot-id Z) & Z c= ].-1,1.[ implies -arccot-id Z
is_differentiable_on Z & for x st x in Z holds ((-arccot-id Z)`|Z).x = -x^2/(1+
  x^2);



theorem 
  Z c= ].-1,1.[ implies (exp_R(#)arctan) is_differentiable_on Z & for x
  st x in Z holds ((exp_R(#)arctan)`|Z).x = exp_R.x*arctan.x+exp_R.x/(1+x^2);



theorem 
  Z c= ].-1,1.[ implies (exp_R(#)arccot) is_differentiable_on Z & for x
  st x in Z holds ((exp_R(#)arccot)`|Z).x = exp_R.x*arccot.x-exp_R.x/(1+x^2);



theorem 
  Z c= dom ((1/r)(#)(arctan*f)-id Z) & (for x st x in Z holds f.x=r*x &
r<>0 & f.x > -1 & f.x < 1) implies (1/r)(#)(arctan*f)-id Z is_differentiable_on
Z & for x st x in Z holds (((1/r)(#)(arctan*f)-id Z)`|Z).x = -(r*x)^2/(1+(r*x)
  ^2);



theorem 
  Z c= dom ((-1/r)(#)(arccot*f)-id Z) & (for x st x in Z holds f.x=r*x &
  r<>0 & f.x > -1 & f.x < 1) implies (-1/r)(#)(arccot*f)-id Z
is_differentiable_on Z & for x st x in Z holds (((-1/r)(#)(arccot*f)-id Z)`|Z).
  x = -(r*x)^2/(1+(r*x)^2);



theorem 
  Z c= dom (ln(#)arctan) & Z c= ].-1,1.[ implies (ln(#)arctan)
is_differentiable_on Z & for x st x in Z holds ((ln(#)arctan)`|Z).x = arctan.x/
  x+ln.x/(1+x^2);



theorem 
  Z c= dom (ln(#)arccot) & Z c= ].-1,1.[ implies (ln(#)arccot)
is_differentiable_on Z & for x st x in Z holds ((ln(#)arccot)`|Z).x = arccot.x/
  x-ln.x/(1+x^2);



theorem 
  not 0 in Z & Z c= dom ((id Z)^(#)arctan) & Z c= ].-1,1.[ implies ((id
Z)^(#)arctan) is_differentiable_on Z & for x st x in Z holds (((id Z)^(#)arctan
  )`|Z).x = -arctan.x/(x^2)+1/(x*(1+x^2));



theorem 
  not 0 in Z & Z c= dom ((id Z)^(#)arccot) & Z c= ].-1,1.[ implies ((id
Z)^(#)arccot) is_differentiable_on Z & for x st x in Z holds (((id Z)^(#)arccot
  )`|Z).x = -arccot.x/(x^2)-1/(x*(1+x^2));














begin 

reserve x, r for Real,
      th for real number,

  rr for set,

  rseq for Real_Sequence;

theorem 
  [.0,PI/2.[ c= dom sec;

theorem 
  ].PI/2,PI.] c= dom sec;

theorem 
  [.-PI/2,0.[ c= dom cosec;

theorem 
  ].0,PI/2.] c= dom cosec;

theorem 
  sec is_differentiable_on ].0,PI/2.[ & for x st x in ].0,PI/2.[
  holds diff(sec,x) = sin.x/(cos.x)^2;

theorem 
  sec is_differentiable_on ].PI/2,PI.[ & for x st x in ].PI/2,PI.[
  holds diff(sec,x) = sin.x/(cos.x)^2;

theorem 
  cosec is_differentiable_on ].-PI/2,0.[ & for x st x in ].-PI/2,0
  .[ holds diff(cosec,x) = -cos.x/(sin.x)^2;

theorem 
  cosec is_differentiable_on ].0,PI/2.[ & for x st x in ].0,PI/2.[
  holds diff(cosec,x) = -cos.x/(sin.x)^2;

theorem 
  sec|].0,PI/2.[ is continuous;

theorem 
  sec|].PI/2,PI.[ is continuous;

theorem 
  cosec|].-PI/2,0.[ is continuous;

theorem 
  cosec|].0,PI/2.[ is continuous;

theorem 
  sec|].0,PI/2.[ is increasing;

theorem 
  sec|].PI/2,PI.[ is increasing;

theorem 
  cosec|].-PI/2,0.[ is decreasing;

theorem 
  cosec|].0,PI/2.[ is decreasing;

theorem 
  sec|[.0,PI/2.[ is increasing;

theorem 
  sec|].PI/2,PI.] is increasing;

theorem 
  cosec|[.-PI/2,0.[ is decreasing;

theorem 
  cosec|].0,PI/2.] is decreasing;

theorem 
  sec | [.0,PI/2.[ is one-to-one;

theorem 
  sec | ].PI/2,PI.] is one-to-one;

theorem 
  cosec | [.-PI/2,0.[ is one-to-one;

theorem 
  cosec | ].0,PI/2.] is one-to-one;

registration
  cluster sec | [.0,PI/2.[ -> one-to-one;
  cluster sec | ].PI/2,PI.] -> one-to-one;
  cluster cosec | [.-PI/2,0.[ -> one-to-one;
  cluster cosec | ].0,PI/2.] -> one-to-one;
end;

definition
  func arcsec1 -> PartFunc of REAL, REAL equals

  (sec | [.0,PI/2.[)";
  func arcsec2 -> PartFunc of REAL, REAL equals

  (sec | ].PI/2, PI.])";
  func arccosec1 -> PartFunc of REAL, REAL equals

  (cosec | [.-PI/2,0.[)";
  func arccosec2 -> PartFunc of REAL, REAL equals

  (cosec | ].0,PI/2.])";
end;

definition
  let r be Real;
  func arcsec1 r equals

  arcsec1.r;
  func arcsec2 r equals

  arcsec2.r;
  func arccosec1 r equals

  arccosec1.r;
  func arccosec2 r equals

  arccosec2.r;
end;

definition
  let r be Real;
  redefine func arcsec1 r -> Real;
  redefine func arcsec2 r -> Real;
  redefine func arccosec1 r -> Real;
  redefine func arccosec2 r -> Real;
end;

theorem 
  rng arcsec1 = [.0,PI/2.[;

theorem 
  rng arcsec2 = ].PI/2,PI.];

theorem 
  rng arccosec1 = [.-PI/2,0.[;

theorem 
  rng arccosec2 = ].0,PI/2.];

registration
  cluster arcsec1 -> one-to-one;
  cluster arcsec2 -> one-to-one;
  cluster arccosec1 -> one-to-one;
  cluster arccosec2 -> one-to-one;
end;

theorem 
  sin.(PI/4) = 1/sqrt 2 & cos.(PI/4) = 1/sqrt 2;

theorem 
  sin.(-PI/4) = -1/sqrt 2 & cos.(-PI/4) = 1/sqrt 2 & sin.(3/4*PI)
  = 1/sqrt 2 & cos.(3/4*PI) = -1/sqrt 2;

theorem 
  sec.0 = 1 & sec.(PI/4) = sqrt 2 & sec.(3/4*PI) = -sqrt 2 & sec. PI = -1;

theorem 
  cosec.(-PI/2) = -1 & cosec.(-PI/4) = -sqrt 2 & cosec.(PI/4) =
  sqrt 2 & cosec.(PI/2) = 1;

theorem 
  for x be set st x in [.0,PI/4.] holds sec.x in [.1,sqrt 2.];

theorem 
  for x be set st x in [.3/4*PI,PI.] holds sec.x in [.-sqrt 2,-1.];

theorem 
  for x be set st x in [.-PI/2,-PI/4.] holds cosec.x in [.-sqrt 2, -1.];

theorem 
  for x be set st x in [.PI/4,PI/2.] holds cosec.x in [.1,sqrt 2.];

theorem 
  sec|[.0,PI/2.[ is continuous;

theorem 
  sec|].PI/2,PI.] is continuous;

theorem 
  cosec|[.-PI/2,0.[ is continuous;

theorem 
  cosec|].0,PI/2.] is continuous;

theorem 
  rng(sec | [.0,PI/4.]) = [.1,sqrt 2.];

theorem 
  rng(sec | [.3/4*PI,PI.]) = [.-sqrt 2,-1.];

theorem 
  rng(cosec | [.-PI/2,-PI/4.]) = [.-sqrt 2,-1.];

theorem 
  rng(cosec | [.PI/4,PI/2.]) = [.1,sqrt 2.];

theorem 
  [.1,sqrt 2.] c= dom arcsec1;

theorem 
  [.-sqrt 2,-1.] c= dom arcsec2;

theorem 
  [.-sqrt 2,-1.] c= dom arccosec1;

theorem 
  [.1,sqrt 2.] c= dom arccosec2;

registration
  cluster sec | [.0,PI/4.] -> one-to-one;
  cluster sec | [.3/4*PI,PI.] -> one-to-one;
  cluster cosec | [.-PI/2,-PI/4.] -> one-to-one;
  cluster cosec | [.PI/4,PI/2.] -> one-to-one;
end;

theorem 
  arcsec1 | [.1,sqrt 2.] = (sec | [.0,PI/4.])";

theorem 
  arcsec2 | [.-sqrt 2,-1.] = (sec | [.3/4*PI,PI.])";

theorem 
  arccosec1 | [.-sqrt 2,-1.] = (cosec | [.-PI/2,-PI/4.])";

theorem 
  arccosec2 | [.1,sqrt 2.] = (cosec | [.PI/4,PI/2.])";

theorem 
  (sec | [.0,PI/4.]) qua Function * (arcsec1 | [.1,sqrt 2.]) = id [.1,
  sqrt 2.];

theorem 
  (sec | [.3/4*PI,PI.]) qua Function * (arcsec2 | [.-sqrt 2,-1.]) = id
  [.-sqrt 2,-1.];

theorem 
  (cosec | [.-PI/2,-PI/4.]) qua Function * (arccosec1 | [.-sqrt 2,-1.])
  = id [.-sqrt 2,-1.];

theorem 
  (cosec | [.PI/4,PI/2.]) qua Function * (arccosec2 | [.1,sqrt 2.]) = id
  [.1,sqrt 2.];

theorem 
  (sec | [.0,PI/4.]) * (arcsec1 | [.1,sqrt 2.]) = id [.1,sqrt 2.];

theorem 
  (sec | [.3/4*PI,PI.]) * (arcsec2 | [.-sqrt 2,-1.]) = id [.-sqrt 2,-1.];

theorem 
  (cosec | [.-PI/2,-PI/4.]) * (arccosec1 | [.-sqrt 2,-1.]) = id [.-sqrt
  2,-1.];

theorem 
  (cosec | [.PI/4,PI/2.]) * (arccosec2 | [.1,sqrt 2.]) = id [.1,sqrt 2.];

theorem 
  arcsec1 qua Function * (sec | [.0,PI/2.[) = id [.0,PI/2.[;

theorem 
  arcsec2 qua Function * (sec | ].PI/2,PI.]) = id ].PI/2,PI.];

theorem 
  arccosec1 qua Function * (cosec | [.-PI/2,0.[) = id [.-PI/2,0.[;

theorem 
  arccosec2 qua Function * (cosec | ].0,PI/2.]) = id ].0,PI/2.];

theorem 
  arcsec1 * (sec | [.0,PI/2.[) = id [.0,PI/2.[;

theorem 
  arcsec2 * (sec | ].PI/2,PI.]) = id ].PI/2,PI.];

theorem 
  arccosec1 * (cosec | [.-PI/2,0.[) = id [.-PI/2,0.[;

theorem 
  arccosec2 * (cosec | ].0,PI/2.]) = id ].0,PI/2.];

theorem 
  0 <= r & r < PI/2 implies arcsec1 sec.r = r;

theorem 
  PI/2 < r & r <= PI implies arcsec2 sec.r = r;

theorem 
  -PI/2 <= r & r < 0 implies arccosec1 cosec.r = r;

theorem 
  0 < r & r <= PI/2 implies arccosec2 cosec.r = r;

theorem 
  arcsec1.1 = 0 & arcsec1.(sqrt 2) = PI/4;

theorem 
  arcsec2.(-sqrt 2) = 3/4*PI & arcsec2.(-1) = PI;

theorem 
  arccosec1.(-1) = -PI/2 & arccosec1.(-sqrt 2) = -PI/4;

theorem 
  arccosec2.(sqrt 2) = PI/4 & arccosec2.1 = PI/2;

theorem 
  arcsec1|(sec.:[.0,PI/2.[) is increasing;

theorem 
  arcsec2|(sec.:].PI/2,PI.]) is increasing;

theorem 
  arccosec1|(cosec.:[.-PI/2,0.[) is decreasing;

theorem 
  arccosec2|(cosec.:].0,PI/2.]) is decreasing;

theorem 
  arcsec1|[.1,sqrt 2.] is increasing;

theorem 
  arcsec2|[.-sqrt 2,-1.] is increasing;

theorem 
  arccosec1|[.-sqrt 2,-1.] is decreasing;

theorem 
  arccosec2|[.1,sqrt 2.] is decreasing;

theorem 
  for x be set st x in [.1,sqrt 2.] holds arcsec1.x in [.0,PI/4.];

theorem 
  for x be set st x in [.-sqrt 2,-1.] holds arcsec2.x in [.3/4*PI, PI.];

theorem 
  for x be set st x in [.-sqrt 2,-1.] holds arccosec1.x in [.-PI/2 ,-PI/4.];

theorem 
  for x be set st x in [.1,sqrt 2.] holds arccosec2.x in [.PI/4,PI /2.];

theorem 
  1 <= r & r <= sqrt 2 implies sec.(arcsec1 r) = r;

theorem 
  -sqrt 2 <= r & r <= -1 implies sec.(arcsec2 r ) = r;

theorem 
  -sqrt 2 <= r & r <= -1 implies cosec.(arccosec1 r) = r;

theorem 
  1 <= r & r <= sqrt 2 implies cosec.(arccosec2 r) = r;

theorem 
  arcsec1|[.1,sqrt 2.] is continuous;

theorem 
  arcsec2|[.-sqrt 2,-1.] is continuous;

theorem 
  arccosec1|[.-sqrt 2,-1.] is continuous;

theorem 
  arccosec2|[.1,sqrt 2.] is continuous;

theorem 
  rng(arcsec1 | [.1,sqrt 2.]) = [.0,PI/4.];

theorem 
  rng(arcsec2 | [.-sqrt 2,-1.]) = [.3/4*PI,PI.];

theorem 
  rng(arccosec1 | [.-sqrt 2,-1.]) = [.-PI/2,-PI/4.];

theorem 
  rng(arccosec2 | [.1,sqrt 2.]) = [.PI/4,PI/2.];

theorem 
  (1 <= r & r <= sqrt 2 & arcsec1 r = 0 implies r = 1) & (1 <= r & r <=
  sqrt 2 & arcsec1 r = PI/4 implies r = sqrt 2);

theorem 
  (-sqrt 2 <= r & r <= -1 & arcsec2 r = 3/4*PI implies r = -sqrt 2) & (-
  sqrt 2 <= r & r <= -1 & arcsec2 r = PI implies r = -1);

theorem 
  (-sqrt 2 <= r & r <= -1 & arccosec1 r = -PI/2 implies r = -1) & (-sqrt
  2 <= r & r <= -1 & arccosec1 r = -PI/4 implies r = -sqrt 2);

theorem 
  (1 <= r & r <= sqrt 2 & arccosec2 r = PI/4 implies r = sqrt 2) & (1 <=
  r & r <= sqrt 2 & arccosec2 r = PI/2 implies r = 1);

theorem 
  1 <= r & r <= sqrt 2 implies 0 <= arcsec1 r & arcsec1 r <= PI/4;

theorem 
  -sqrt 2 <= r & r <= -1 implies 3/4*PI <= arcsec2 r & arcsec2 r <= PI;

theorem 
  -sqrt 2 <= r & r <= -1 implies -PI/2 <= arccosec1 r & arccosec1 r <= -PI/4;

theorem 
  1 <= r & r <= sqrt 2 implies PI/4 <= arccosec2 r & arccosec2 r <= PI/2;

theorem 
  1 < r & r < sqrt 2 implies 0 < arcsec1 r & arcsec1 r < PI/4;

theorem 
  -sqrt 2 < r & r < -1 implies 3/4*PI < arcsec2 r & arcsec2 r < PI;

theorem 
  -sqrt 2 < r & r < -1 implies -PI/2 < arccosec1 r & arccosec1 r < -PI/4;

theorem 
  1 < r & r < sqrt 2 implies PI/4 < arccosec2 r & arccosec2 r < PI/2;

theorem 
  1 <= r & r <= sqrt 2 implies sin.(arcsec1 r) = sqrt(r^2-1)/r &
  cos.(arcsec1 r) = 1/r;

theorem 
  -sqrt 2 <= r & r <= -1 implies sin.(arcsec2 r) = -sqrt(r^2-1)/r
  & cos.(arcsec2 r) = 1/r;

theorem 
  -sqrt 2 <= r & r <= -1 implies sin.(arccosec1 r) = 1/r & cos.(
  arccosec1 r) = -sqrt(r^2-1)/r;

theorem 
  1 <= r & r <= sqrt 2 implies sin.(arccosec2 r) = 1/r & cos.(
  arccosec2 r) = sqrt(r^2-1)/r;

theorem 
  1 < r & r < sqrt 2 implies cosec.(arcsec1 r) = r/sqrt(r^2-1);

theorem 
  -sqrt 2 < r & r < -1 implies cosec.(arcsec2 r) = -r/sqrt(r^2-1);

theorem 
  -sqrt 2 < r & r < -1 implies sec.(arccosec1 r) = -r/sqrt(r^2-1);

theorem 
  1 < r & r < sqrt 2 implies sec.(arccosec2 r) = r/sqrt(r^2-1);

theorem 
  arcsec1 is_differentiable_on sec.:].0,PI/2.[;

theorem 
  arcsec2 is_differentiable_on sec.:].PI/2,PI.[;

theorem 
  arccosec1 is_differentiable_on cosec.:].-PI/2,0.[;

theorem 
  arccosec2 is_differentiable_on cosec.:].0,PI/2.[;

theorem 
  sec.:].0,PI/2.[ is open;

theorem 
  sec.:].PI/2,PI.[ is open;

theorem 
  cosec.:].-PI/2,0.[ is open;

theorem 
  cosec.:].0,PI/2.[ is open;

theorem 
  arcsec1|(sec.:].0,PI/2.[) is continuous;

theorem 
  arcsec2|(sec.:].PI/2,PI.[) is continuous;

theorem 
  arccosec1|(cosec.:].-PI/2,0.[) is continuous;

theorem 
  arccosec2|(cosec.:].0,PI/2.[) is continuous;














begin  

theorem 
  for n,m be Nat, a be Function of [:Seg n,Seg m:],REAL for p,q
be FinSequence of REAL st ( dom p=Seg n & for i be Nat st i in dom p holds ex r
  be FinSequence of REAL st (dom r = Seg m & p.i = Sum r & for j be Nat st j in
dom r holds r.j=a.[i,j])) & ( dom q=Seg m & for j be Nat st j in dom q holds ex
s be FinSequence of REAL st (dom s = Seg n & q.j = Sum s & for i be Nat st i in
  dom s holds s.i=a.[i,j])) holds Sum p = Sum q;

theorem 
  for F be FinSequence of ExtREAL, f be FinSequence of REAL st F=f
  holds Sum(F)=Sum(f);

theorem 
  for X be non empty set, S be SigmaField of X, f be PartFunc of X,
  ExtREAL st f is_simple_func_in S holds ex F be Finite_Sep_Sequence of S, a be
FinSequence of ExtREAL st dom f = union rng F & dom F= dom a & (for n be Nat st
n in dom F for x be set st x in F.n holds f.x = a.n) & for x be set st x in dom
  f holds ex ax be FinSequence of ExtREAL st dom ax = dom a & for n be Nat st n
  in dom ax holds ax.n=a.n*(chi(F.n,X)).x;

theorem 
  for X be set, F be FinSequence of X holds F is disjoint_valued
  iff for i,j be Nat st i in dom F & j in dom F & i <> j holds F.i misses F.j;

theorem 
  for X be non empty set, A be set, S be SigmaField of X, F be
Finite_Sep_Sequence of S, G be FinSequence of S st dom G = dom F & for i be Nat
  st i in dom G holds G.i = A /\ F.i holds G is Finite_Sep_Sequence of S;

theorem 
  for X be non empty set, A be set, F,G be FinSequence of X st dom
G = dom F & (for i be Nat st i in dom G holds G.i = A /\ F.i) holds union rng G
  = A /\ union rng F;

theorem 
  for X be set, F be FinSequence of X, i be Nat st i in dom F holds
  F.i c= union rng F & F.i /\ union rng F = F.i;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, F be Finite_Sep_Sequence of S holds dom F = dom (M*F);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, F be Finite_Sep_Sequence of S holds M.(union rng F) = Sum(M*F);

theorem 
  for F,G be FinSequence of ExtREAL, a be R_eal st (a is real or (
for i be Nat st i in dom F holds F.i < 0.) or for i be Nat st i in dom F holds
  0. < F.i ) & dom F = dom G & for i be Nat st i in dom G holds G.i=a*F.i holds
  Sum(G)=a*Sum(F);

theorem 
  for F be FinSequence of REAL holds F is FinSequence of ExtREAL;

definition
  let X be non empty set;
  let S be SigmaField of X;
  let f be PartFunc of X,ExtREAL;
  let F be Finite_Sep_Sequence of S;
  let a be FinSequence of ExtREAL;
  pred F,a are_Re-presentation_of f means


  dom f = union rng F & dom F=
  dom a & for n be Nat st n in dom F for x be set st x in F.n holds f.x=a.n;
end;

theorem 
  for X be non empty set, S be SigmaField of X, f be PartFunc of X,
  ExtREAL st f is_simple_func_in S holds ex F be Finite_Sep_Sequence of S, a be
  FinSequence of ExtREAL st F,a are_Re-presentation_of f;

theorem 
  for X be non empty set, S be SigmaField of X, F be
Finite_Sep_Sequence of S holds ex G be Finite_Sep_Sequence of S st union rng F
= union rng G & for n be Nat st n in dom G holds (G.n <> {} & ex m be Nat st m
  in dom F & F.m = G.n);

theorem 
  for X be non empty set, S be SigmaField of X, f be PartFunc of X
,ExtREAL st f is_simple_func_in S & for x be set st x in dom f holds 0. <= f.x
  holds ex F be Finite_Sep_Sequence of S, a be FinSequence of ExtREAL st F,a
  are_Re-presentation_of f & a.1=0. & for n be Nat st 2 <= n & n in dom a holds
  0. < a.n & a.n < +infty;

theorem 
  for X be non empty set, S be SigmaField of X, f be PartFunc of X,
  ExtREAL, F be Finite_Sep_Sequence of S, a be FinSequence of ExtREAL, x be
  Element of X st F,a are_Re-presentation_of f & x in dom f holds ex ax be
FinSequence of ExtREAL st dom ax= dom a & (for n be Nat st n in dom ax holds ax
  .n=a.n*(chi(F.n,X)).x) & f.x=Sum(ax);

theorem 
  for p be FinSequence of ExtREAL, q be FinSequence of REAL st p=q holds
  Sum(p) = Sum(q);

theorem 
  for p be FinSequence of ExtREAL st not -infty in rng p & +infty in rng p
  holds Sum(p) = +infty;

definition
  let X be non empty set;
  let S be SigmaField of X;
  let M be sigma_Measure of S;
  let f be PartFunc of X,ExtREAL;
  assume
 f is_simple_func_in S & for x be set st x in dom f holds 0. <= f.x;
  func integral(X,S,M,f) -> Element of ExtREAL means

  ex F be Finite_Sep_Sequence of S, a, x be FinSequence of ExtREAL st F,a
are_Re-presentation_of f & a.1 =0. & (for n be Nat st 2 <= n & n in dom a holds
0. < a.n & a.n < +infty ) & dom x = dom F & (for n be Nat st n in dom x holds x
  .n=a.n*(M*F).n) & it=Sum(x);
end;

begin 

theorem 
  for a be FinSequence of ExtREAL, p,N be Element of ExtREAL st N = len a &
  (for n be Nat st n in dom a holds a.n = p) holds Sum(a) = N * p;














begin  

theorem 
  for F,G,H be FinSequence of ExtREAL st (for i be Nat st i in dom
F holds 0. <= F.i) & (for i be Nat st i in dom G holds 0. <= G.i) & dom F = dom
  G & H = F + G holds Sum(H)=Sum(F)+Sum(G);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S holds for n be Nat, f be PartFunc of X,ExtREAL, F be Finite_Sep_Sequence
of S, a,x be FinSequence of ExtREAL st f is_simple_func_in S & dom f <> {} & (
  for x be set st x in dom f holds 0. <= f.x) & F,a are_Re-presentation_of f &
dom x = dom F & (for i be Nat st i in dom x holds x.i=a.i*(M*F).i) & len F = n
  holds integral(X,S,M,f)=Sum(x);

theorem 
  for X be non empty set, S be SigmaField of X, f be PartFunc of X,
  ExtREAL, M be sigma_Measure of S, F be Finite_Sep_Sequence of S, a,x be
  FinSequence of ExtREAL st f is_simple_func_in S & dom f <> {} & (for x be set
st x in dom f holds 0. <= f.x) & F,a are_Re-presentation_of f & dom x = dom F &
(for n be Nat st n in dom x holds x.n=a.n*(M*F).n) holds integral(X,S,M,f)=Sum(
  x);

theorem 
  for X be non empty set, S be SigmaField of X, f be PartFunc of X,
ExtREAL, M be sigma_Measure of S st f is_simple_func_in S & dom f <> {} & (for
x be set st x in dom f holds 0. <= f.x) holds ex F be Finite_Sep_Sequence of S,
a,x be FinSequence of ExtREAL st F,a are_Re-presentation_of f & dom x = dom F &
  (for n be Nat st n in dom x holds x.n=a.n*(M*F).n) & integral(X,S,M,f)=Sum(x)
;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure of S,
f,g be PartFunc of X,ExtREAL st f is_simple_func_in S & dom f <> {} & (for x be
set st x in dom f holds 0. <= f.x) & g is_simple_func_in S & dom g = dom f & (
for x be set st x in dom g holds 0. <= g.x) holds f+g is_simple_func_in S & dom
(f+g) <> {} & (for x be set st x in dom (f+g) holds 0. <= (f+g).x) & integral(X
  ,S,M,f+g)=integral(X,S,M,f)+integral(X,S,M,g);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure of S,
f,g be PartFunc of X,ExtREAL, c be R_eal st f is_simple_func_in S & dom f <> {}
& (for x be set st x in dom f holds 0. <= f.x) & 0. <= c & c < +infty & dom g =
dom f & (for x be set st x in dom g holds g.x=c*f.x) holds integral(X,S,M,g)=c*
  integral(X,S,M,f);














begin 

definition let F be complex-valued Relation;
  redefine func rng F -> Subset of COMPLEX;
end;

registration
  let D be non empty set;
  let F be Function of COMPLEX,D;
  let F1 be complex-valued FinSequence;
  cluster F*F1 -> FinSequence-like;
end;

reserve s for set,
  i,j for Nat,
  x,x1,x2 for Element of COMPLEX,
  c,c1,c2,c3 for complex number,
  F,F1,F2 for complex-valued FinSequence,
  R,R1,R2 for i-element FinSequence of COMPLEX;

definition
  func sqrcomplex -> UnOp of COMPLEX means

  for c holds it.c = c^2;
end;

theorem 
  sqrcomplex is_distributive_wrt multcomplex;

theorem 
  c multcomplex is_distributive_wrt addcomplex;

begin

definition let F1,F2;
  redefine func F1 + F2 -> FinSequence of COMPLEX equals

  addcomplex.:(F1,F2);
  commutativity;
end;

definition let i,R1,R2;
  redefine func R1 + R2 -> Element of i-tuples_on COMPLEX;
end;

theorem 
  (R1+R2).s = R1.s + R2.s;

theorem 
  <*>COMPLEX + F = <*>COMPLEX;

theorem 
  <*c1*> + <*c2*> = <*c1+c2*>;

theorem 
  (i|->c1) + (i|->c2) = i|->(c1+c2);

definition let F;
  redefine func -F -> FinSequence of COMPLEX equals

  compcomplex*F;
end;

definition let i,R;
  redefine func -R -> Element of i-tuples_on COMPLEX;
end;

theorem 
  -<*c*> = <*-c*>;

theorem 
  -(i|->c) = i|->-c;

theorem 
  R1 + R = R2 + R implies R1 = R2;

theorem 
  -(F1 + F2) = -F1 + -F2;

definition let F1,F2;
  redefine func F1 - F2 -> FinSequence of COMPLEX equals

  diffcomplex.:(F1,F2);
end;

definition let i,R1,R2;
  redefine func R1 - R2 -> Element of i-tuples_on COMPLEX;
end;

theorem 
  (R1-R2).s = R1.s - R2.s;

theorem 
  <*>COMPLEX - F = <*>COMPLEX & F - <*>COMPLEX = <*>COMPLEX;

theorem 
  <*c1*> - <*c2*> = <*c1-c2*>;

theorem 
  (i|->c1) - (i|->c2) = i|->(c1-c2);

theorem 
  R - (i|-> 0c) = R;

theorem 
  -(F1 - F2) = F2 - F1;

theorem 
  -(F1 - F2) = -F1 + F2;

theorem 
  R1 - R2 = i|->0c implies R1 = R2;

theorem 
  R1 = R1 + R - R;

theorem 
  R1 = R1 - R + R;

notation let F,c;
  synonym c*F for c(#)F;
end;

definition let F,c;
  redefine func c*F -> FinSequence of COMPLEX equals

  (c multcomplex)*F;
end;

definition let i,R,c;
  redefine func c*R -> Element of i-tuples_on COMPLEX;
end;

theorem 
  c*<*c1*> = <*c*c1*>;

theorem 
  c1*(i|->c2) = i|->(c1*c2);

theorem 
  (c1 + c2)*F = c1*F + c2*F;

theorem 
  0c*R = i|->0c;

notation let F1,F2;
  synonym mlt(F1,F2) for F1(#)F2;
end;

definition let F1,F2;
  redefine func mlt(F1,F2) -> FinSequence of COMPLEX equals

  multcomplex.:(F1,F2);
  commutativity;
end;

definition let i,R1,R2;
  redefine func mlt(R1,R2) -> Element of i-tuples_on COMPLEX;
end;

theorem 
  mlt(<*>COMPLEX,F) = <*>COMPLEX;

theorem 
  mlt(<*c1*>,<*c2*>) = <*c1*c2*>;

theorem 
  mlt(i|->c,R) = c*R;

theorem 
  mlt(i|->c1,i|->c2) = i|->(c1*c2);

begin 

theorem 
  Sum(<*> COMPLEX) = 0c;

theorem 
  Sum <*c*> = c;

theorem 
  Sum(F^<*c*>) = Sum F + c;

theorem 
  Sum(F1^F2) = Sum F1 + Sum F2;

theorem 
  Sum(<*c*>^F) = c + Sum F;

theorem 
  Sum<*c1,c2*> = c1 + c2;

theorem 
  Sum<*c1,c2,c3*> = c1 + c2 + c3;

theorem 
  Sum(i |-> c) = i*c;

theorem 
  Sum(i |-> 0c) = 0c;

theorem 
  Sum(c*F) = c*(Sum F);

theorem 
  Sum -F = -(Sum F);

theorem 
  Sum(R1 + R2) = Sum R1 + Sum R2;

theorem 
  Sum(R1 - R2) = Sum R1 - Sum R2;

begin

theorem 
  Product <*>COMPLEX = 1;

theorem 
  Product (<*c*>^F) = c * Product F;

theorem 
  for R being Element of 0-tuples_on COMPLEX holds Product R = 1;

theorem 
  Product ((i+j) |->c) = (Product (i|->c))*(Product (j|->c));

theorem 
  Product ((i*j) |->c) = Product (j |-> (Product (i|->c)));

theorem 
  Product (i|->(c1*c2)) = (Product (i|->c1))*(Product (i|->c2));

theorem 
  Product mlt(R1,R2) = Product R1 * Product R2;

theorem 
  Product (c*R) = Product (i|->c) * Product R;

begin 

theorem 
  for x being complex-valued FinSequence holds len (-x)=len x;

theorem 
  for x1,x2 being complex-valued FinSequence st len x1=len x2 holds
  len (x1+x2)=len x1;

theorem 
  for x1,x2 being complex-valued FinSequence st len x1=len x2 holds
  len (x1-x2)=len x1;

theorem 
  for a being real number, x being complex-valued FinSequence
  holds len (a*x)=len x;

theorem 
  for x,y,z being complex-valued FinSequence st len x=len y & len y=len z
  holds mlt(x+y,z) = mlt(x,z)+mlt(y,z);















begin

definition
  let D be set,f,g be FinSequence of D;
  redefine func f^g -> FinSequence of D;
end;

theorem 
  for D being non empty set, f,g being FinSequence of D st len f>=1 holds
  mid(f^g,1,len f)=f;

theorem 
  for D being set,f being FinSequence of D,i being Element of NAT
  st i>=len f holds f/^i=<*>D;

theorem 
  for D being non empty set,k1,k2 being Element of NAT holds
  mid(<*>D,k1,k2)=<*>D;

definition
  let f be FinSequence, k1,k2 be Nat;
  func smid(f,k1,k2) -> FinSequence equals

  (f/^(k1-'1))|(k2+1-'k1);
end;

definition
  let D be set,f be FinSequence of D,k1,k2 be Nat;
  redefine func smid(f,k1,k2) -> FinSequence of D;
end;

theorem 
  for f being FinSequence,k1,k2 being Element of NAT st k1<=k2 holds
  smid(f,k1,k2) = mid(f,k1,k2);

theorem 
  for D being non empty set,
  f being FinSequence of D,k2 being Element of NAT holds smid(f,1,k2)=f|k2;

theorem 
  for D being non empty set,
  f being FinSequence of D,k2 being Element of NAT st len f<=k2 holds
  smid(f,1,k2)=f;

theorem 
  for D being set,
  f being FinSequence of D,k1,k2 being Element of NAT st k1>k2 holds
  smid(f,k1,k2)={};

theorem 
  for D being set, f being FinSequence of D,k2 being Element of NAT holds
  smid(f,0,k2)=smid(f,1,k2+1);

theorem 
  for D being non empty set, f,g being FinSequence of D holds
  smid(f^g,len f+1,len f+len g)=g;



definition
  let D be non empty set,f,g be FinSequence of D;
  func ovlpart(f,g) -> FinSequence of D means


  len it <=len g & it=smid(g,1,len it) & it=smid(f,len f-'len it+1,len f)
  & for j being Nat st j<=len g & smid(g,1,j)=smid(f,len f-'j+1,len f)
  holds j<=len it;
end;

theorem 
  for D being non empty set,f,g being FinSequence of D
  holds len ovlpart(f,g)<=len f;



definition
  let D be non empty set,f,g be FinSequence of D;
  func ovlcon(f,g) -> FinSequence of D equals

  f^(g/^(len ovlpart(f,g)));
end;

theorem 
  for D being non empty set,f,g being FinSequence of D
  holds ovlcon(f,g)=(f|(len f-'len ovlpart(f,g)))^g;



definition
  let D be non empty set,f,g be FinSequence of D;
  func ovlldiff(f,g) -> FinSequence of D equals

  (f|(len f-'len ovlpart(f,g)));
end;



definition
  let D be non empty set,f,g be FinSequence of D;
  func ovlrdiff(f,g) -> FinSequence of D equals

  (g/^(len ovlpart(f,g)));
end;

theorem 
  for D being non empty set,f,g being FinSequence of D holds ovlcon(f,g)
  =ovlldiff(f,g)^ovlpart(f,g)^ovlrdiff(f,g) & ovlcon(f,g)
  =ovlldiff(f,g)^(ovlpart(f,g)^ovlrdiff(f,g));

theorem 
  for D being non empty set,f being FinSequence of D
  holds ovlcon(f,f)=f & ovlpart(f,f)=f & ovlldiff(f,f)={} & ovlrdiff(f,f)={};

theorem 
  for D being non empty set,f,g being FinSequence of D
  holds ovlpart(f^g,g)=g & ovlpart(f,f^g)=f;

theorem 
  for D being non empty set,f,g being FinSequence of D
  holds len ovlcon(f,g)=len f+len g -len ovlpart(f,g) &
  len ovlcon(f,g)=len f+len g -'len ovlpart(f,g) &
  len ovlcon(f,g)=len f+(len g -'len ovlpart(f,g));

theorem 
  for D being non empty set,f,g being FinSequence of D holds
  len ovlpart(f,g)<=len f & len ovlpart(f,g)<=len g;

definition
  let D be non empty set,CR be FinSequence of D;
  pred CR separates_uniquely means


  for f being FinSequence of D,i,j being Element of NAT
  st 1<=i & i<j & j+len CR-'1<=len f &
  smid(f,i,i+len CR-'1)=smid(f,j,j+len CR-'1) & smid(f,i,i+len CR-'1)=CR
  holds j-'i>=len CR;
end;

theorem 
  for D being non empty set,CR being FinSequence of D holds
  CR separates_uniquely iff len ovlpart(CR/^1,CR) =0;

definition
  let D be non empty set,f,g be FinSequence of D,n be Element of NAT;
  pred g is_substring_of f,n means


  len g>0 implies
  ex i being Element of NAT st n<=i & i<=len f & mid(f,i,(i-'1)+len g)=g;
end;

theorem 
  for D being non empty set,f,g being FinSequence of D,
  n,m being Element of NAT
  st m>=n & g is_substring_of f,m holds g is_substring_of f,n;

theorem 
  for D being non empty set,f being FinSequence of D
  st 1<= len f holds f is_substring_of f,1;

theorem 
  for D being non empty set,f,g being FinSequence of D
  st g is_substring_of f,0 holds g is_substring_of f,1;

notation
  let D be non empty set,g,f be FinSequence of D;
  synonym g is_preposition_of f for g c= f;
end;

definition
  let D be non empty set,g,f be FinSequence of D;
  redefine pred g c= f means


  len g>0 implies 1<=len f & mid(f,1,len g)=g;
end;

theorem 
  for D being non empty set,f,g
  being FinSequence of D st len g>0 & g is_preposition_of f holds g.1=f.1;

definition
  let D be non empty set,f,g be FinSequence of D;
  pred g is_postposition_of f means


  Rev g is_preposition_of Rev f;
end;

theorem 
  for D being non empty set,f,g being FinSequence of D
  st len g=0 holds g is_postposition_of f;

theorem 
  for D being non empty set,f,g being FinSequence of D
  st g is_postposition_of f holds len g <=len f;

theorem 
  for D being non empty set,f,g being FinSequence of D
  st g is_postposition_of f holds
  len g>0 implies len g<=len f & mid(f,(len f+1) -' len g,len f)=g;

theorem 
  for D being non empty set,f,g being FinSequence of D
  st (len g>0 implies len g<=len f & mid(f,(len f+1) -' len g,len f)=g)
  holds g is_postposition_of f;

theorem 
  for D being non empty set,f,g being FinSequence of D
  st 1<=len f & g is_preposition_of f holds g is_substring_of f,1;

theorem 
  for D being non empty set,f,g being FinSequence of D, n being Element of NAT
st not g is_substring_of f,n holds for i being Element of NAT st n <= i & 0 < i
  holds mid(f,i,(i-'1)+len g) <> g;

definition
  let D be non empty set,f,g be FinSequence of D,n be Element of NAT;
  func instr(n,f,g) -> Element of NAT means


  (it <> 0 implies n <= it & g is_preposition_of f/^(it-'1) &
  for j being Element of NAT st j >= n & j > 0
  & g is_preposition_of f/^(j-'1) holds j >= it)
  & (it=0 implies not g is_substring_of f,n );
end;

definition
  let D be non empty set,f,CR be FinSequence of D;
  func addcr(f,CR) -> FinSequence of D equals

  ovlcon(f,CR);
end;

definition
  let D be non empty set, r,CR be FinSequence of D;
  pred r is_terminated_by CR means


  len CR >0 implies len r>=len CR & instr(1,r,CR) = len r + 1 -'len CR;
end;

theorem 
  for D being non empty set,f being FinSequence of D holds f is_terminated_by f
;














begin 

reserve a,a1,b,b1,x,y for Real,
  F,G,H for FinSequence of REAL,
  i,j,k,n,m for Element of NAT,
  I for Subset of REAL,
  X for non empty set,
  x1,R,s for set;

reserve A for non empty closed_interval Subset of REAL;

registration
  cluster closed_interval -> compact for Subset of REAL;
end;

canceled 2;

theorem 
  A is bounded_below bounded_above;

registration
  cluster non empty closed_interval -> real-bounded for Subset of REAL;
end;

reserve A, B for non empty closed_interval Subset of REAL;

theorem 
  A = [. lower_bound A, upper_bound A .];

theorem 
  for a1,a2,b1,b2 being real number holds A=[.a1,b1.] & A=[.a2,b2.]
  implies a1=a2 & b1=b2;

begin 

definition
 canceled;
  let A be non empty compact Subset of REAL;
  mode Division of A -> non empty increasing FinSequence of REAL means


    rng it c= A & it.(len it) = upper_bound A;
end;

definition
  let A be non empty compact Subset of REAL;
  func divs A means


  x1 in it iff x1 is Division of A;
end;

registration
  let A be non empty compact Subset of REAL;
  cluster divs A -> non empty;
end;

registration
  let A be non empty compact Subset of REAL;
  cluster -> Function-like Relation-like for Element of divs A;
end;

registration
  let A be non empty compact Subset of REAL;
  cluster -> real-valued FinSequence-like for Element of divs A;
end;

reserve r for Real;
reserve D, D1, D2 for Division of A;
reserve f, g for Function of A,REAL;

theorem 
  i in dom D implies D.i in A;

theorem 
  i in dom D & i<>1 implies i-1 in dom D & D.(i-1) in A & i-1 in NAT;

definition
  let A be non empty closed_interval Subset of REAL;
  let D be Division of A;
  let i be Nat;
  assume
 i in dom D;
  func divset(D,i) -> non empty closed_interval Subset of REAL means


  lower_bound it = lower_bound A & upper_bound it = D.i if i=1
  otherwise lower_bound it = D.(i-1) & upper_bound it = D.i;
end;

theorem 
  i in dom D implies divset(D,i) c= A;

definition
  let A be Subset of REAL;
  func vol(A) -> Real equals

  upper_bound A - lower_bound A;
end;

theorem 
  for A be real-bounded non empty Subset of REAL holds 0 <= vol(A);

begin 

definition
  let A be non empty closed_interval Subset of REAL;
  let f be PartFunc of A,REAL;
  let D be Division of A;
  func upper_volume(f,D) -> FinSequence of REAL means


  len it = len D &
  for i be Nat st i in dom D holds it.i=(upper_bound rng (f|divset(D,i)))*vol
  divset(D,i);
  func lower_volume(f,D) -> FinSequence of REAL means


  len it = len D &
  for i be Nat st i in dom D holds it.i=(lower_bound rng (f|divset(D,i)))*vol
  divset(D,i);
end;

definition
  let A be non empty closed_interval Subset of REAL;
  let f be PartFunc of A,REAL;
  let D be Division of A;
  func upper_sum(f,D) -> Real equals

  Sum(upper_volume(f,D));
  func lower_sum(f,D) -> Real equals

  Sum(lower_volume(f,D));
end;

definition
  let A be non empty closed_interval Subset of REAL;
  let f be PartFunc of A,REAL;
  func upper_sum_set(f) -> Function of divs A,REAL means


  for D be Division of A holds it.D=upper_sum(f,D);
  func lower_sum_set(f) -> Function of divs A,REAL means


  for D be Division of A holds it.D=lower_sum(f,D);
end;

definition
  let A be non empty closed_interval Subset of REAL;
  let f be PartFunc of A,REAL;
  attr f is upper_integrable means


  rng upper_sum_set(f) is bounded_below;
  attr f is lower_integrable means


  rng lower_sum_set(f) is bounded_above;
end;

definition
  let A be non empty closed_interval Subset of REAL;
  let f be PartFunc of A,REAL;
  func upper_integral(f) -> Real equals

  lower_bound rng upper_sum_set(f);
end;

definition
  let A be non empty closed_interval Subset of REAL;
  let f be PartFunc of A,REAL;
  func lower_integral(f) -> Real equals

  upper_bound rng lower_sum_set(f);
end;

definition
  let A be non empty closed_interval Subset of REAL;
  let f be PartFunc of A,REAL;
  attr f is integrable means


  f is upper_integrable lower_integrable &
  upper_integral(f) = lower_integral(f);
end;

definition
  let A be non empty closed_interval Subset of REAL;
  let f be PartFunc of A,REAL;
  func integral(f) -> Real equals

  upper_integral(f);
end;

begin 

theorem 
  for f,g be PartFunc of X,REAL holds rng(f+g) c= rng f ++ rng g;

theorem 
  for f be PartFunc of X,REAL holds f|X is bounded_below implies
  rng f is bounded_below;

theorem 
  for f be PartFunc of X,REAL st rng f is bounded_below holds
    f|X is bounded_below;

theorem 
  for f be PartFunc of X,REAL st f|X is bounded_above holds
    rng f is bounded_above;

theorem 
  for f be PartFunc of X,REAL st rng f is bounded_above holds
    f|X is bounded_above;

theorem 
  for f be PartFunc of X,REAL holds f|X is bounded implies
    rng f is real-bounded;

begin 

theorem 
  for A be non empty set holds chi(A,A)|A is constant;

theorem 
  for A be non empty Subset of X holds rng chi(A,A) = {1};

theorem 
  for A be non empty Subset of X, B be set holds B meets dom chi(A
  ,A) implies rng (chi(A,A)|B) = {1};

theorem 
  i in dom D implies vol(divset(D,i))=lower_volume(chi(A,A),D).i;

theorem 
  i in dom D implies vol(divset(D,i))=upper_volume(chi(A,A),D).i;

theorem 
  len F = len G & len F = len H & (for k st k in dom F holds H.k = F/.k
  + G/.k) implies Sum(H) = Sum(F) + Sum(G);

theorem 
  len F = len G & len F = len H & (for k st k in dom F holds H.k =
  F/.k - G/.k) implies Sum(H) = Sum(F) - Sum(G);

theorem 
  Sum(lower_volume(chi(A,A),D))=vol(A);

theorem 
  Sum(upper_volume(chi(A,A),D))=vol(A);

begin 

registration
  let A be non empty closed_interval Subset of REAL;
  let f be PartFunc of A,REAL;
  let D be Division of A;
  cluster upper_volume(f,D) -> non empty;
  cluster lower_volume(f,D) -> non empty;
end;

theorem 
  f|A is bounded_below implies (lower_bound rng f)*vol(A) <=
  lower_sum(f,D);

theorem 
  f|A is bounded_above & i in dom D implies (upper_bound rng f)*vol(
  divset(D,i)) >= (upper_bound rng (f|divset(D,i)))*vol(divset(D,i));

theorem 
  f|A is bounded_above implies upper_sum(f,D) <= (upper_bound rng
  f)*vol(A);

theorem 
  f|A is bounded implies lower_sum(f,D) <= upper_sum(f,D);

definition
  let D1, D2 be FinSequence;

  pred D1 <= D2 means

  len D1 <= len D2 & rng D1 c= rng D2;
  reflexivity;
end;

notation
  let D1, D2 be FinSequence;
  synonym D2 >= D1 for D1 <= D2;
end;

theorem 
  len D1 = 1 implies D1 <= D2;

theorem 
  f|A is bounded_above & len D1 = 1 implies
    upper_sum(f,D1) >= upper_sum(f,D2);

theorem 
  f|A is bounded_below & len D1 = 1 implies
    lower_sum(f,D1) <= lower_sum(f,D2);

theorem 
  i in dom D implies ex A1,A2 be non empty closed_interval Subset of REAL
  st A1=[.lower_bound A,D.i .] & A2=[. D.i,upper_bound A.] & A=A1 \/ A2;

theorem 
  i in dom D1 & D1 <= D2 implies ex j st j in dom D2 & D1.i=D2.j;

definition
  let A, D1, D2;
  let i be Nat;
  assume
 D1 <= D2;
  func indx(D2,D1,i) -> Element of NAT means


  it in dom D2 & D1.i=D2.it
  if i in dom D1 otherwise it = 0;
end;

theorem 
  for p be increasing FinSequence of REAL, n be Element of NAT
  holds n <= len p implies p/^n is increasing FinSequence of REAL;

theorem 
  for p be increasing FinSequence of REAL, i,j be Element of NAT
holds j in dom p & i <= j implies mid(p,i,j) is increasing FinSequence of REAL;

theorem 
  i in dom D & j in dom D & i<=j implies
  ex B be non empty closed_interval Subset of REAL st
  lower_bound B = mid(D,i,j).1 & upper_bound B = mid(D,i,j).(len mid(D,i,j)) &
  mid(D,i,j) is Division of B;

theorem 
  i in dom D & j in dom D & i<=j & D.i>=lower_bound B & D.j=
  upper_bound B implies mid(D,i,j) is Division of B;

definition
  let p be FinSequence of REAL;
  func PartSums(p) -> FinSequence of REAL means


  len it = len p & for i be Nat st i in dom p holds it.i=Sum(p|i);
end;

theorem 
  D1 <= D2 & f|A is bounded_above implies for i be non empty
  Element of NAT holds (i in dom D1 implies Sum(upper_volume(f,D1)|i) >= Sum(
  upper_volume(f,D2)|indx(D2,D1,i)));

theorem 
  D1 <= D2 & f|A is bounded_below implies for i be non empty
  Element of NAT holds (i in dom D1 implies
  Sum(lower_volume(f,D1)|i) <= Sum(lower_volume(f,D2)|indx(D2,D1,i)));

theorem 
  D1 <= D2 & i in dom D1 & f|A is bounded_above implies (PartSums(
  upper_volume(f,D1))).i >= (PartSums(upper_volume(f,D2))).indx(D2,D1,i);

theorem 
  D1 <= D2 & i in dom D1 & f|A is bounded_below implies (PartSums(
  lower_volume(f,D1))).i <= (PartSums(lower_volume(f,D2))).indx(D2,D1,i);

theorem 
  (PartSums(upper_volume(f,D))).(len D) = upper_sum(f,D);

theorem 
  (PartSums(lower_volume(f,D))).(len D) = lower_sum(f,D);

theorem 
  D1 <= D2 implies indx(D2,D1,len D1) = len D2;

theorem 
  D1 <= D2 & f|A is bounded_above implies upper_sum(f,D2) <=
  upper_sum(f,D1);

theorem 
  D1 <= D2 & f|A is bounded_below implies lower_sum(f,D2) >=
  lower_sum(f,D1);

theorem 
  ex D be Division of A st D1 <= D & D2 <= D;

theorem 
  f|A is bounded implies lower_sum(f,D1) <= upper_sum(f,D2);

begin 

theorem 
  f|A is bounded implies upper_integral(f) >= lower_integral(f);

theorem 
  for X,Y be Subset of REAL holds (--X)++(--Y)=--(X++Y);

theorem 
  for X,Y being Subset of REAL st X is bounded_above & Y is
  bounded_above holds X++Y is bounded_above;

theorem 
  for X,Y be non empty Subset of REAL st
  X is bounded_above & Y is bounded_above holds
  upper_bound(X++Y) = upper_bound X + upper_bound Y;

theorem 
  i in dom D & f|A is bounded_above & g|A is bounded_above implies
  upper_volume(f+g,D).i <= upper_volume(f,D).i + upper_volume(g,D).i;

theorem 
  i in dom D & f|A is bounded_below & g|A is bounded_below implies
  lower_volume(f,D).i + lower_volume(g,D).i <= lower_volume(f+g,D).i;

theorem 
  f|A is bounded_above & g|A is bounded_above implies upper_sum(f+
  g,D) <= upper_sum(f,D) + upper_sum(g,D);

theorem 
  f|A is bounded_below & g|A is bounded_below implies lower_sum(f,
  D) + lower_sum(g,D) <= lower_sum(f+g,D);

theorem 
  f|A is bounded & g|A is bounded & f is integrable & g is integrable
  implies f+g is integrable & integral(f+g)=integral(f)+integral(g);

theorem 
  for f being FinSequence holds
  i in dom f & j in dom f & i<=j implies len mid(f,i,j) = j-i+1;














begin 

reserve a,b,r,x,y for Real,
  i,j,k,n for Element of NAT,
  x1 for set,
  p for FinSequence of REAL;

theorem 
  for A be non empty closed_interval Subset of REAL, x being real number holds
  x in A iff lower_bound A <= x & x <= upper_bound A;

definition
  let IT be FinSequence of REAL;
  attr IT is non-decreasing means


  for n be Element of NAT st n in dom
  IT & n+1 in dom IT holds IT.n <= IT.(n+1);
end;

registration
  cluster non-decreasing for FinSequence of REAL;
end;

theorem 
  for p be non-decreasing FinSequence of REAL, i,j st i in dom p & j in
  dom p & i <= j holds p.i <= p.j;

theorem 
  for p ex q be non-decreasing FinSequence of REAL st p,q
  are_fiberwise_equipotent;

theorem 
  for D be non empty set, f be FinSequence of D, k1,k2,k3 be Element of
NAT st 1<=k1 & k3<=len f & k1<=k2 & k2<k3 holds mid(f,k1,k2)^mid(f,k2+1,k3)=mid
  (f,k1,k3);

begin 

definition
  let A be real-membered set;
  let x be real number;
  redefine func x ** A -> Subset of REAL;
end;

theorem 
  for X,Y be non empty set, f be PartFunc of X,REAL st
    f|X is bounded_above & Y c= X holds f|Y|Y is bounded_above;

theorem 
  for X,Y be non empty set, f be PartFunc of X,REAL st
    f|X is bounded_below & Y c= X holds f|Y|Y is bounded_below;

theorem 
  for X being real-membered set, a being real number holds
    X is empty iff a ** X is empty;

theorem 
  for X be Subset of REAL holds r**X = {r*x : x in X};

theorem 
  for X be non empty Subset of REAL st X is bounded_above & 0<=r holds
    r**X is bounded_above;

theorem 
  for X be non empty Subset of REAL st X is bounded_above & r<=0 holds
    r**X is bounded_below;

theorem 
  for X be non empty Subset of REAL st X is bounded_below & 0<=r holds
    r**X is bounded_below;

theorem 
  for X be non empty Subset of REAL st X is bounded_below & r<=0 holds
    r**X is bounded_above;

theorem 
  for X be non empty Subset of REAL st X is bounded_above & 0<=r
  holds upper_bound(r**X) = r*(upper_bound X);

theorem 
  for X be non empty Subset of REAL st X is bounded_above & r<=0
  holds lower_bound(r**X) = r*(upper_bound X);

theorem 
  for X be non empty Subset of REAL st X is bounded_below & 0<=r
  holds lower_bound(r**X) = r*(lower_bound X);

theorem 
  for X be non empty Subset of REAL st X is bounded_below & r<=0
  holds upper_bound(r**X) = r*(lower_bound X);

begin 

theorem 
  for X be non empty set, f be Function of X,REAL holds rng(r(#)f)
  = r**rng f;

theorem 
  for X,Z be non empty set, f be PartFunc of X,REAL holds rng(r(#)
  (f|Z)) = r**rng(f|Z);

reserve A, B for non empty closed_interval Subset of REAL;
reserve f, g for Function of A,REAL;
reserve D, D1, D2 for Division of A;

theorem 
  f|A is bounded & r >= 0 implies (upper_sum_set(r(#)f)).D >= r*(
  lower_bound rng f)*vol(A);

theorem 
  f|A is bounded & r <= 0 implies (upper_sum_set(r(#)f)).D >= r*(
  upper_bound rng f)*vol(A);

theorem 
  f|A is bounded & r >= 0 implies (lower_sum_set(r(#)f)).D <= r*(
  upper_bound rng f)*vol(A);

theorem 
  f|A is bounded & r <= 0 implies (lower_sum_set(r(#)f)).D <= r*(
  lower_bound rng f)*vol(A);

theorem 
  i in dom D & f|A is bounded_above & r >= 0 implies upper_volume(
  r(#)f,D).i = r*upper_volume(f,D).i;

theorem 
  i in dom D & f|A is bounded_above & r <= 0 implies lower_volume(
  r(#)f,D).i = r*upper_volume(f,D).i;

theorem 
  i in dom D & f|A is bounded_below & r >= 0 implies lower_volume(
  r(#)f,D).i = r*lower_volume(f,D).i;

theorem 
  i in dom D & f|A is bounded_below & r <= 0 implies upper_volume(
  r(#)f,D).i = r*lower_volume(f,D).i;

theorem 
  f|A is bounded_above & r >= 0 implies upper_sum(r(#)f,D) = r*
  upper_sum(f,D);

theorem 
  f|A is bounded_above & r <= 0 implies lower_sum(r(#)f,D) = r*
  upper_sum(f,D);

theorem 
  f|A is bounded_below & r >= 0 implies lower_sum(r(#)f,D) = r*
  lower_sum(f,D);

theorem 
  f|A is bounded_below & r <= 0 implies upper_sum(r(#)f,D) = r*
  lower_sum(f,D);

theorem 
  f|A is bounded & f is integrable implies r(#)f is integrable &
  integral(r(#)f) = r*integral(f);

begin 

theorem 
  f|A is bounded & (for x st x in A holds f.x >= 0) implies
  integral(f) >= 0;

theorem 
  f|A is bounded & f is integrable & g|A is bounded & g is
integrable implies f-g is integrable & integral(f-g) = integral(f)-integral(g);

theorem 
  f|A is bounded & f is integrable & g|A is bounded & g is integrable &
  (for x st x in A holds f.x >= g.x) implies integral(f) >= integral(g);

begin 

theorem 
  f|A is bounded implies rng upper_sum_set(f) is bounded_below;

theorem 
  f|A is bounded implies rng lower_sum_set(f) is bounded_above;

definition
  let A be non empty closed_interval Subset of REAL;
  mode DivSequence of A is Function of NAT,divs A;
end;

definition
  let A;
  let T be DivSequence of A;
  let i;
  redefine func T.i -> Division of A;

end;

definition
  let A be non empty closed_interval Subset of REAL, f be PartFunc of A,REAL,
      T be DivSequence of A;
  func upper_sum(f,T) -> Real_Sequence means

  for i holds it.i = upper_sum(f,T.i);
  func lower_sum(f,T) -> Real_Sequence means

  for i holds it.i = lower_sum(f,T.
  i);
end;

theorem 
  D1 <= D2 implies for j st j in dom D2 holds ex i st i in dom D1
  & divset(D2,j) c= divset(D1,i);

theorem 
  A c= B implies vol(A) <= vol(B);

theorem 
  for A being Subset of REAL,
      a,x being Real st x in a ** A holds
   ex b being Real st b in A & x = a * b;

begin 


theorem 
  for A being non empty ext-real-membered set holds 0 ** A = {0};














begin

reserve n,m for Element of NAT;

definition
  let f be FinSequence of REAL;
  func max_p f -> Element of NAT means


  (len f=0 implies it=0) & (len f>
  0 implies it in dom f & (for i being Element of NAT,r1,r2 being Real st i in
dom f & r1=f.i & r2=f.it holds r1<=r2) & for j being Element of NAT st j in dom
  f & f.j=f.it holds it<=j );
end;

definition
  let f be FinSequence of REAL;
  func min_p f -> Element of NAT means


  (len f=0 implies it=0) & (len f>
  0 implies it in dom f & (for i being Element of NAT,r1,r2 being Real st i in
dom f & r1=f.i & r2=f.it holds r1>=r2) & for j being Element of NAT st j in dom
  f & f.j=f.it holds it<=j );
end;

definition
  let f be FinSequence of REAL;
  func max f -> Real equals

  f.(max_p f);
  func min f -> Real equals

  f.(min_p f);
end;

theorem 
  for f being FinSequence of REAL,i being Element of NAT st 1<=i &
  i<=len f holds f.i<=f.(max_p f) & f.i<=max f;

theorem 
  for f being FinSequence of REAL,i being Element of NAT st 1<=i &
  i<=len f holds f.i>=f.(min_p f) & f.i>=min f;

theorem 
  for f being FinSequence of REAL,r being Real st f=<*r*> holds max_p f=
  1 & max f=r;

theorem 
  for f being FinSequence of REAL,r being Real st f=<*r*> holds min_p f=
  1 & min f=r;

theorem 
  for f being FinSequence of REAL,r1,r2 being Real st f=<*r1,r2*> holds
  max f=max(r1,r2) & max_p f=IFEQ(r1,max(r1,r2),1,2);

theorem 
  for f being FinSequence of REAL,r1,r2 being Real st f=<*r1,r2*> holds
  min f=min(r1,r2) & min_p f=IFEQ(r1,min(r1,r2),1,2);

theorem 
  for f1,f2 being FinSequence of REAL st len f1=len f2 & len f1>0 holds
  max (f1+f2)<=(max f1) +(max f2);

theorem 
  for f1,f2 being FinSequence of REAL st len f1=len f2 & len f1>0 holds
  min (f1+f2)>=(min f1) +(min f2);

theorem 
  for f being FinSequence of REAL, a being Real st len f>0 & a>0 holds
  max (a*f)=a*(max f) & max_p (a*f)=max_p f;

theorem 
  for f being FinSequence of REAL, a being Real st len f>0 & a>0 holds
  min (a*f)=a*(min f) & min_p (a*f)=min_p f;

theorem 
  for f being FinSequence of REAL st len f>0 holds max (-f)=-(min f) &
  max_p (-f)=min_p f;

theorem 
  for f being FinSequence of REAL st len f>0 holds min (-f)=-(max f) &
  min_p (-f)=max_p f;

theorem 
  for f being FinSequence of REAL,n being Element of NAT st n<len f
  holds max (f/^n)<= max f & min (f/^n)>= min f;

theorem 
  for f,g being FinSequence of REAL st f,g
  are_fiberwise_equipotent holds max f=max g;

theorem 
  for f,g being FinSequence of REAL st f,g
  are_fiberwise_equipotent holds min f=min g;

definition
  let f be FinSequence of REAL;
  func sort_d f -> non-increasing FinSequence of REAL means

  

  f,it are_fiberwise_equipotent;
 projectivity;
end;

theorem 
  for R be FinSequence of REAL st len R = 0 or len R = 1 holds R
  is non-decreasing;

theorem 
  for R be FinSequence of REAL holds R is non-decreasing iff for n
  ,m be Element of NAT st n in dom R & m in dom R & n<m holds R.n<=R.m;

theorem 
  for R be non-decreasing FinSequence of REAL, n be Element of NAT
  holds R|n is non-decreasing FinSequence of REAL;

theorem 
  for R1,R2 be non-decreasing FinSequence of REAL st R1,R2
  are_fiberwise_equipotent holds R1 = R2;

definition
  let f be FinSequence of REAL;
  func sort_a f -> non-decreasing FinSequence of REAL means

  

  f,it are_fiberwise_equipotent;
 projectivity;
end;

theorem 
  for f being non-increasing FinSequence of REAL holds sort_d f=f;

theorem 
  for f being non-decreasing FinSequence of REAL holds sort_a f=f;

canceled 2;

theorem 
  for f being FinSequence of REAL st f is non-increasing holds -f
  is non-decreasing;

theorem 
  for f being FinSequence of REAL st f is non-decreasing holds -f
  is non-increasing;

theorem 
  for f,g being FinSequence of REAL,P being Permutation of dom g
  st f = g*P & len g>=1 holds -f=(-g)*P;

theorem 
  for f,g being FinSequence of REAL st f,g
  are_fiberwise_equipotent holds -f,-g are_fiberwise_equipotent;

theorem 
  for f being FinSequence of REAL holds sort_d (-f) = - (sort_a f);

theorem 
  for f being FinSequence of REAL holds sort_a (-f) = - (sort_d f);

theorem 
  for f being FinSequence of REAL holds dom (sort_d f)=dom f & len
  (sort_d f)=len f;

theorem 
  for f being FinSequence of REAL holds dom (sort_a f)=dom f & len
  (sort_a f)=len f;

theorem 
  for f being FinSequence of REAL st len f >=1 holds max_p(sort_d f)=1 &
  min_p(sort_a f)=1 & (sort_d f).1=max f & (sort_a f).1=min f;














begin 

reserve a,b,e,r,x,y for Real,
  i,j,k,n,m for Element of NAT,
  x1 for set,
  p,q for FinSequence of REAL,
  A for non empty closed_interval Subset of REAL,
  D,D1,D2 for Division of A,
  f,g for Function of A,REAL,
  T for DivSequence of A;

definition
  let A be non empty closed_interval Subset of REAL, D be Division of A;
  func delta(D) -> Real equals

  max rng upper_volume(chi(A,A),D);
end;

definition
  let A be non empty closed_interval Subset of REAL, T be DivSequence of A;
  func delta(T) -> Real_Sequence means

  for i holds it.i = delta(T.i);
end;

theorem 
  D1 <= D2 implies delta(D1) >= delta(D2);

theorem 
  vol(A) <> 0 implies ex i st i in dom D & vol(divset(D,i)) > 0;

theorem 
  x in A implies ex j st j in dom D & x in divset(D,j);

theorem 
  ex D st D1 <= D & D2 <= D & rng D = rng D1 \/ rng D2;

theorem 
  delta(D1) < min rng upper_volume(chi(A,A),D) implies for x,y,i st
i in dom D1 & x in rng D /\ divset(D1,i) & y in rng D /\ divset(D1,i) holds x=y
;

theorem 
  for p,q st rng p = rng q & p is increasing & q is increasing
  holds p = q;

theorem 
  D <= D1 & i in dom D & j in dom D & i <= j implies indx(D1,D,i)
  <= indx(D1,D,j) & indx(D1,D,i) in dom D1;

theorem 
  D <= D1 & i in dom D & j in dom D & i < j implies indx(D1,D,i) <
  indx(D1,D,j);

theorem 
  delta(D) >= 0;

theorem 
  x in divset(D1,len D1) & len D1 >= 2 & D1<=D2 & rng D2 = rng D1
\/ {x} & g|A is bounded implies Sum lower_volume(g,D2) - Sum lower_volume(g,D1)
  <= (upper_bound rng g-lower_bound rng g)*delta(D1);

theorem 
  x in divset(D1,len D1) & len D1 >= 2 & D1<=D2 & rng D2 = rng D1
\/ {x} & g|A is bounded implies Sum upper_volume(g,D1) - Sum upper_volume(g,D2)
  <= (upper_bound rng g-lower_bound rng g)*delta(D1);

theorem 
  i in dom D & j in dom D & i<=j & r < mid(D,i,j).1 implies
  ex B be non empty closed_interval Subset of REAL st r = lower_bound B &
  upper_bound B=mid(D,i,j).(len mid(D,i,j)) &  mid(D,i,j) is Division of B;

theorem 
  x in divset(D1,len D1) & vol(A)<>0 & D1<=D2 & rng D2 = rng D1 \/
  {x} & f|A is bounded & x > lower_bound A implies Sum lower_volume(f,D2)-Sum
  lower_volume(f,D1)<=(upper_bound rng f-lower_bound rng f)*delta(D1);

theorem 
  x in divset(D1,len D1) & vol(A)<>0 & D1<=D2 & rng D2 = rng D1 \/
  {x} & f|A is bounded & x > lower_bound A implies Sum upper_volume(f,D1)-Sum
  upper_volume(f,D2)<=(upper_bound rng f-lower_bound rng f)*delta(D1);

theorem 
  i in dom D1 & j in dom D1 & i<=j & D1 <= D2 & r < mid(D2,indx(D2
,D1,i),indx(D2,D1,j)).1 implies
 ex B be non empty closed_interval Subset of REAL, MD1,MD2
be Division of B st r=lower_bound B & upper_bound B=MD2.(len MD2) & upper_bound
B=MD1.(len MD1) & MD1 <= MD2 & MD1=mid(D1,i,j) & MD2=mid(D2,indx(D2,D1,i),indx(
  D2,D1,j));

theorem 
  x in rng D implies D.1 <= x & x <= D.(len D);

theorem 
  for p be FinSequence of REAL, i,j,k st p is increasing & i in
dom p & j in dom p & k in dom p & p.i <= p.k & p.k <= p.j holds p.k in rng mid(
  p,i,j);

theorem 
  f|A is bounded & i in dom D implies lower_bound rng(f|divset(D,i
  )) <= upper_bound rng f;

theorem 
  f|A is bounded & i in dom D implies upper_bound rng(f|divset(D,i
  )) >= lower_bound rng f;

begin 


theorem 
  f|A is bounded & delta(T) is 0-convergent non-zero & vol(A)<>0 implies
  lower_sum(f,T) is convergent & lim lower_sum(f,T) = lower_integral(f);

theorem 
  f|A is bounded & delta(T) is 0-convergent non-zero & vol(A)<>0 implies
  upper_sum(f,T) is convergent & lim upper_sum(f,T) = upper_integral(f);














begin 

reserve i,j,k,n,n1,n2,m for Element of NAT;
reserve a,r,x,y for Real;
reserve A for non empty closed_interval Subset of REAL;
reserve C for non empty set;
reserve X for set;

theorem 
  for D being Division of A st vol(A)=0 holds len D=1;

theorem 
  chi(A,A) is integrable & integral(chi(A,A))=vol(A);

theorem 
  for f being PartFunc of A,REAL, r holds f is total & rng f = {r}
  iff f=r(#)chi(A,A);

theorem 
  for f being Function of A,REAL, r st rng f = {r} holds f is
  integrable & integral(f)=r*vol(A);

theorem 
  for r holds ex f being Function of A,REAL st rng f = {r} & f|A is
  bounded;

theorem 
  for f being PartFunc of A,REAL, D being Element of divs A st vol(
  A)=0 holds f is integrable & integral(f)=0;

theorem 
  for f being Function of A,REAL st f|A is bounded & f is integrable
holds ex a st lower_bound rng f <= a & a <= upper_bound rng f & integral(f)=a*
  vol(A);

begin 

theorem 
  for f being Function of A,REAL, T being DivSequence of A st
  f|A is bounded & delta(T) is convergent & lim delta(T)=0 holds
  lower_sum(f,T) is convergent & lim lower_sum(f,T) = lower_integral(f);

theorem 
  for f being Function of A,REAL, T being DivSequence of A st f|A
  is bounded & delta(T) is convergent & lim delta(T)=0 holds upper_sum(f,T) is
  convergent & lim upper_sum(f,T) = upper_integral(f);

theorem 
  for f being Function of A,REAL st f|A is bounded holds f is
  upper_integrable & f is lower_integrable;

definition
  let A be non empty closed_interval Subset of REAL, IT be Division of A, n;
  pred IT divide_into_equal n means


  len IT = n & for i st i in dom IT
  holds IT.i=lower_bound A + vol(A)/(len IT)*i;
end;

theorem 
  ex T being DivSequence of A st delta(T) is convergent & lim
  delta(T)=0;

theorem 
  for f being Function of A,REAL st f|A is bounded holds f is
  integrable iff for T being DivSequence of A st delta(T) is convergent & lim
  delta(T)=0 holds lim upper_sum(f,T)-lim lower_sum(f,T)=0;

theorem 
  for f being Function of C,REAL holds max+(f) is total & max-(f)
  is total;

theorem 
  for f being PartFunc of C,REAL st f|X is bounded_above holds (
  max+f)|X is bounded_above;

theorem 
  for f being PartFunc of C,REAL holds (max+f)|X is bounded_below;

theorem 
  for f being PartFunc of C,REAL st f|X is bounded_below holds (
  max-f)|X is bounded_above;

theorem 
  for f being PartFunc of C,REAL holds (max-f)|X is bounded_below;

theorem 
  for f being PartFunc of A,REAL st f|A is bounded_above holds rng
  (f|X) is bounded_above;

theorem 
  for f being PartFunc of A,REAL st f|A is bounded_below holds rng
  (f|X) is bounded_below;

theorem 
  for f being Function of A,REAL st f|A is bounded & f is
  integrable holds max+(f) is integrable;

theorem 
  for f being PartFunc of C,REAL holds max-(f)=max+(-f);

theorem 
  for f being Function of A,REAL st f|A is bounded & f is
  integrable holds max-(f) is integrable;

theorem 
  for f being Function of A,REAL st f|A is bounded & f is integrable
  holds abs(f) is integrable & abs(integral(f))<=integral(abs(f));

theorem 
  for f being Function of A,REAL st (for x,y st x in A & y in A
  holds abs(f.x-f.y)<=a) holds upper_bound rng f - lower_bound rng f <= a;

theorem 
  for f,g being Function of A,REAL st f|A is bounded & a>=0 & (for
  x,y st x in A & y in A holds abs(g.x-g.y)<=a*abs(f.x-f.y)) holds upper_bound
  rng g - lower_bound rng g <= a*(upper_bound rng f - lower_bound rng f);

theorem 
  for f,g,h being Function of A,REAL st f|A is bounded & g|A is
bounded & a>=0 & (for x,y st x in A & y in A holds abs(h.x-h.y)<=a*(abs(f.x-f.y
)+abs(g.x-g.y))) holds upper_bound rng h - lower_bound rng h <= a*((upper_bound
  rng f - lower_bound rng f)+(upper_bound rng g - lower_bound rng g));

theorem 
  for f,g being Function of A,REAL st f|A is bounded & f is
integrable & g|A is bounded & a>0 & (for x,y st x in A & y in A holds abs(g.x-g
  .y)<=a*abs(f.x-f.y)) holds g is integrable;

theorem 
  for f,g,h being Function of A,REAL st f|A is bounded & f is
integrable & g|A is bounded & g is integrable & h|A is bounded & a > 0 & (for x
,y st x in A & y in A holds abs(h.x-h.y)<=a*(abs(f.x-f.y)+abs(g.x-g.y))) holds
  h is integrable;

theorem 
  for f,g being Function of A,REAL st f|A is bounded & f is integrable &
  g|A is bounded & g is integrable holds f(#)g is integrable;

theorem 
  for f being Function of A,REAL st f|A is bounded & f is integrable &
  not 0 in rng f & f^|A is bounded holds f^ is integrable;















begin 

reserve i,k,n,m for Element of NAT;
reserve a,b,r,r1,r2,s,x,x1,x2 for Real;
reserve A for non empty closed_interval Subset of REAL;
reserve X for set;

theorem 
  for F,F1,F2 being FinSequence of REAL, r1,r2 st (F1=<*r1*>^F or
  F1=F^<*r1*>) & (F2=<*r2*>^F or F2=F^<*r2*>) holds Sum(F1-F2)=r1-r2;

theorem 
  for F1,F2 being FinSequence of REAL st len F1 = len F2 holds len
  (F1+F2)=len F1 & len (F1-F2)=len F1 & Sum(F1+F2)=Sum F1+Sum F2 & Sum(F1-F2)=
  Sum F1-Sum F2;

theorem 
  for F1,F2 being FinSequence of REAL st len F1 = len F2 & (for i
  st i in dom F1 holds F1.i <= F2.i) holds Sum F1 <= Sum F2;

begin 

notation
  let f be PartFunc of REAL,REAL;
  let C be non empty Subset of REAL;
  synonym f||C for f|C;
end;

definition
  let f be PartFunc of REAL,REAL;
  let C be non empty Subset of REAL;
  redefine func f||C -> PartFunc of C,REAL;
end;

theorem 
  for f,g being PartFunc of REAL,REAL, C being non empty Subset of
  REAL holds (f||C)(#)(g||C) = (f(#)g)||C;

theorem 
  for f,g being PartFunc of REAL,REAL, C being non empty Subset of
  REAL holds (f+g)||C = f||C + g||C;

definition

  let A be non empty closed_interval Subset of REAL;
  let f be PartFunc of REAL,REAL;
  pred f is_integrable_on A means


  f||A is integrable;
end;

definition
  let A be non empty closed_interval Subset of REAL;
  let f be PartFunc of REAL,REAL;
  func integral(f,A) -> Real equals

  integral(f||A);
end;

theorem 
  for f being PartFunc of REAL,REAL st A c= dom f holds f||A is
  total;

theorem 
  for f being PartFunc of REAL,REAL st f|A is bounded_above holds f
  ||A|A is bounded_above;

theorem 
  for f being PartFunc of REAL,REAL st f|A is bounded_below holds f
  ||A|A is bounded_below;

theorem 
  for f being PartFunc of REAL,REAL st f|A is bounded holds f||A|A
  is bounded;

begin 

theorem 
  for f being PartFunc of REAL,REAL st A c= dom f & f|A is
  continuous holds f|A is bounded;

theorem 
  for f being PartFunc of REAL,REAL st A c= dom f & f|A is
  continuous holds f is_integrable_on A;

theorem 
  for f being PartFunc of REAL,REAL, D being Division of A st A c=
X & f is_differentiable_on X & (f`|X)|A is bounded holds lower_sum((f`|X)||A,D)
  <= f.(upper_bound A)-f.(lower_bound A) & f.(upper_bound A)-f.(lower_bound A)
  <=upper_sum((f`|X)||A,D);


theorem 
  for f being PartFunc of REAL,REAL st A c= X & f
  is_differentiable_on X & f`|X is_integrable_on A & (f`|X)|A is bounded holds
  integral(f`|X,A) = f.(upper_bound A)-f.(lower_bound A);

theorem 
  for f being PartFunc of REAL,REAL st f|A is non-decreasing & A
  c= dom f holds rng (f|A) is real-bounded;

theorem 
  for f being PartFunc of REAL,REAL st f|A is non-decreasing & A
  c= dom f holds lower_bound rng (f|A) = f.(lower_bound A) &
  upper_bound rng (f|A) = f.(upper_bound A);

theorem 
  for f being PartFunc of REAL,REAL st f|A is monotone & A c= dom f
  holds f is_integrable_on A;

theorem 
  for f being PartFunc of REAL,REAL,
  A,B being non empty closed_interval Subset of
  REAL st A c= dom f & f|A is continuous & B c= A holds f is_integrable_on B;

theorem 
  for f being PartFunc of REAL,REAL,
  A,B,C being non empty closed_interval Subset
of REAL, X st A c= X & f is_differentiable_on X & (f`|X)|A is continuous
 &lower_bound A
= lower_bound B & upper_bound B = lower_bound C & upper_bound C = upper_bound A
 holds B c= A & C c= A & integral(f`|X,A
  )=integral(f`|X,B)+integral(f`|X,C);

definition
  let a,b be real number;
  assume
 a<=b;
  func [' a,b '] -> non empty closed_interval Subset of REAL equals


  [.a,b.];
end;

definition
  let a,b be real number;
  let f be PartFunc of REAL,REAL;
  func integral(f,a,b) -> Real equals


  integral(f,[' a,b ']) if a<=b
  otherwise -integral(f,[' b,a ']);
end;

theorem 
  for f being PartFunc of REAL,REAL,
  A being non empty closed_interval Subset of
  REAL, a,b st A=[.a,b.] holds integral(f,A)=integral(f,a,b);

theorem 
  for f being PartFunc of REAL,REAL,
   A being non empty closed_interval Subset of
  REAL, a,b st A=[.b,a.] holds -integral(f,A)=integral(f,a,b);

theorem 
  for f,g being PartFunc of REAL,REAL, X being open Subset of REAL st f
  is_differentiable_on X & g is_differentiable_on X & A c= X & f`|X
  is_integrable_on A & (f`|X)|A is bounded & g`|X is_integrable_on A & (g`|X)|A
is bounded holds integral((f`|X)(#)g,A) =
f.(upper_bound A)*g.(upper_bound A)-f.(lower_bound A)*g.(lower_bound A
  )-integral(f(#)(g`|X),A);














begin

 reserve a,b,x,r for Real;
 reserve y for set;
 reserve n for Element of NAT;
 reserve A for non empty closed_interval Subset of REAL;
 reserve f,g,f1,f2,g1,g2 for PartFunc of REAL,REAL;
 reserve Z for open Subset of REAL;

theorem 
 Z c= dom ((f1+f2)^) & (for x st x in Z holds f1.x=1) & f2=#Z 2
 implies (f1+f2)^ is_differentiable_on Z & for x st x in Z holds
 (((f1+f2)^)`|Z).x = -2*x/(1+x |^2)^2;



theorem 
 A c= Z & f = ((g1+g2)^)/f2 & f2 = arccot & Z c= ]. -1,1 .[ & g2=#Z 2
 & (for x st x in Z holds g1.x=1 & f2.x>0) & Z = dom f implies
 integral(f,A)=(-ln*arccot).(upper_bound A)-(-ln*arccot).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds exp_R.x < 1 & f1.x=1)
 & Z c= dom (arctan*exp_R)
 & Z = dom f & f=exp_R/(f1+(exp_R)^2)
 implies integral(f,A)=(arctan*exp_R).(upper_bound A)
                      -(arctan*exp_R).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds exp_R.x < 1 & f1.x=1)
& Z c= dom (arccot*exp_R) & Z = dom f & f=(-exp_R)/(f1+(exp_R)^2)
 implies integral(f,A)=(arccot*exp_R).(upper_bound A)
                      -(arccot*exp_R).(lower_bound A);



theorem 
 A c= Z & Z = dom f & f=exp_R(#)(sin/cos)+exp_R/cos^2 implies
 integral(f,A)=(exp_R(#)tan).(upper_bound A)-(exp_R(#)tan).(lower_bound A);



theorem 
 A c= Z & Z = dom f & f=exp_R(#)(cos/sin)-exp_R/sin^2 implies
 integral(f,A)=(exp_R(#)cot).(upper_bound A)-(exp_R(#)cot).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds f1.x=1) & Z c= ]. -1,1 .[ & Z = dom f
 & f=exp_R(#)arctan+exp_R/(f1+#Z 2) implies
 integral(f,A
 )=(exp_R(#)arctan).(upper_bound A)-(exp_R(#)arctan).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds f1.x=1) & Z c= ]. -1,1 .[ & Z = dom f
 & f=exp_R(#)arccot-exp_R/(f1+#Z 2) implies
 integral(f,A)
 =(exp_R(#)arccot).(upper_bound A)-(exp_R(#)arccot).(lower_bound A);



theorem 
 A c= Z & Z = dom f & f=(exp_R*sin)(#)cos implies
 integral(f,A)=(exp_R*sin).(upper_bound A)-(exp_R*sin).(lower_bound A);



theorem 
  A c= Z & Z = dom f & f=(exp_R*cos)(#)sin implies
  integral(f,A)=(-exp_R*cos).(upper_bound A)-(-exp_R*cos).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds x>0)
 & Z = dom f & f=(cos*ln)(#)((id Z)^) implies
 integral(f,A)=(sin*ln).(upper_bound A)-(sin*ln).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds x>0)
 & Z = dom f & f=(sin*ln)(#)((id Z)^) implies
 integral(f,A)=(-cos*ln).(upper_bound A)-(-cos*ln).(lower_bound A);



theorem 
 A c= Z & Z = dom f & f=exp_R(#)(cos*exp_R) implies
 integral(f,A)=(sin*exp_R).(upper_bound A)-(sin*exp_R).(lower_bound A);



theorem 
 A c= Z & Z = dom f & f=exp_R(#)(sin*exp_R) implies
 integral(f,A)=(-cos*exp_R).(upper_bound A)-(-cos*exp_R).(lower_bound A);



theorem 
A c= Z & Z c= dom (ln*(f1+f2))
& r <> 0 & (for x st x in Z holds g.x=x/r & g.x > -1 & g.x < 1 & f1.x=1)
& f2=( #Z 2)*g & Z = dom f & f=arctan*g
implies
integral(f,A)=((id Z)(#)(arctan*g)-(r/2)(#)(ln*(f1+f2))).(upper_bound A)
             -((id Z)(#)(arctan*g)-(r/2)(#)(ln*(f1+f2))).(lower_bound A);



theorem 
A c= Z & Z c= dom (ln*(f1+f2))
& r <> 0 & (for x st x in Z holds g.x=x/r & g.x > -1 & g.x < 1 & f1.x=1)
& f2=( #Z 2)*g & Z = dom f & f=arccot*g implies
integral(f,A)=((id Z)(#)((arccot)*g)+(r/2)(#)(ln*(f1+f2))).(upper_bound A)
             -((id Z)(#)((arccot)*g)+(r/2)(#)(ln*(f1+f2))).(lower_bound A);



theorem 
 A c= Z & f=arctan*f1+(id Z)/(r(#)(g+f1^2))
 & (for x st x in Z holds g.x=1 & f1.x=x/r & f1.x > -1 & f1.x < 1)
 & Z = dom f & f|A is continuous
 implies integral(f,A)=((id Z)(#)(arctan*f1)).(upper_bound A)
                      -((id Z)(#)(arctan*f1)).(lower_bound A);



theorem 
 A c= Z & f=arccot*f1-(id Z)/(r(#)(g+f1^2))
 & (for x st x in Z holds g.x=1 & f1.x=x/r & f1.x > -1 & f1.x < 1)
 & Z = dom f & f|A is continuous
 implies integral(f,A)=((id Z)(#)((arccot)*f1)).(upper_bound A)
                      -((id Z)(#)((arccot)*f1)).(lower_bound A);



theorem 
 A c= Z & Z c= ]. -1,1 .[  & (for x st x in Z holds f1.x=1)
 & Z = dom f & Z c= dom (( #Z n)*arcsin) & 1<n &
 f=n(#)(( #Z (n-1))*arcsin)/(( #R (1/2))*(f1-#Z 2))
 implies integral(f,A) = (( #Z n)*arcsin).(upper_bound A)
                        -(( #Z n)*arcsin).(lower_bound A);



theorem 
 A c= Z & Z c= ]. -1,1 .[  & (for x st x in Z holds f1.x=1)
 & Z c= dom (( #Z n)*(arccos)) & Z = dom f & 1<n &
 f=n(#)(( #Z (n-1))*arccos)/(( #R (1/2))*(f1-#Z 2))
 implies integral(f,A) = (-( #Z n)*(arccos)).(upper_bound A)
                       - (-( #Z n)*(arccos)).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds f1.x=1)
 & Z c= ]. -1,1 .[ & Z = dom f & f=arcsin+(id Z)/(( #R (1/2))*(f1-#Z 2))
 implies
 integral(f,A)
 =((id Z)(#)(arcsin)).(upper_bound A)-((id Z)(#)(arcsin)).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds f1.x=1)
 & Z c= ]. -1,1 .[ & Z = dom f & f=arccos-(id Z)/(( #R (1/2))*(f1-#Z 2))
 implies
 integral(f,A)
 =((id Z)(#)(arccos)).(upper_bound A)-((id Z)(#)(arccos)).(lower_bound A);



theorem 
A c= Z & Z c= ]. -1,1 .[ &
(for x st x in Z holds f1.x=a*x+b & f2.x=1) & Z = dom f
& f=a(#)arcsin+f1/(( #R (1/2))*(f2-#Z 2)) implies
integral(f,A)=(f1(#)(arcsin)).(upper_bound A)-(f1(#)(arcsin)).(lower_bound A);



theorem 
A c= Z & Z c= ]. -1,1 .[ &
(for x st x in Z holds f1.x=a*x+b & f2.x=1) & Z = dom f &
f=a(#)arccos-f1/(( #R (1/2))*(f2-#Z 2)) implies
integral(f,A)=(f1(#)(arccos)).(upper_bound A)-(f1(#)(arccos)).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds g.x=1 & f1.x=x/a & f1.x>-1 & f1.x<1)
 & Z = dom f & f|A is continuous
 & f=arcsin*f1+(id Z)/(a(#)(( #R (1/2))*(g-f1^2))) implies
 integral(f,A)=((id Z)(#)((arcsin)*f1)).(upper_bound A)
              -((id Z)(#)((arcsin)*f1)).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds g.x=1 & f1.x=x/a & f1.x>-1 & f1.x<1)
 & Z = dom f & f|A is continuous
 & f=arccos*f1-(id Z)/(a(#)(( #R (1/2))*(g-f1^2))) implies
 integral(f,A)=((id Z)(#)(arccos*f1)).(upper_bound A)
              -((id Z)(#)(arccos*f1)).(lower_bound A);



theorem 
 A c= Z & f=(n(#)(( #Z (n-1))*sin))/(( #Z (n+1))*cos) &
 1<=n & Z c= dom (( #Z n)*tan) & Z = dom f
 implies
 integral(f,A)=(( #Z n)*tan).(upper_bound A)-(( #Z n)*tan).(lower_bound A);



theorem 
 A c= Z & f=(n(#)(( #Z (n-1))*cos))/(( #Z (n+1))*sin)
 & 1<=n & Z c= dom (( #Z n)*cot) & Z = dom f
 implies
 integral(f,A)=(-( #Z n)*cot).(upper_bound A)-(-( #Z n)*cot).(lower_bound A);



theorem 
 A c= Z & Z c= dom (tan*f1) & f=(sin*f1)^2/(cos*f1)^2
 & (for x st x in Z holds f1.x=a*x & a<>0) & Z = dom f
 implies
 integral(f,A)=((1/a)(#)(tan*f1)-id Z).(upper_bound A)
              -((1/a)(#)(tan*f1)-id Z).(lower_bound A);



theorem 
 A c= Z & Z c= dom (cot*f1) & f=(cos*f1)^2/(sin*f1)^2 &
 (for x st x in Z holds f1.x=a*x & a<>0) & Z = dom f
 implies
 integral(f,A)=((-1/a)(#)(cot*f1)-id Z).(upper_bound A)
              -((-1/a)(#)(cot*f1)-id Z).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds f1.x=a*x+b) & Z = dom f &
 f=a(#)(sin/cos)+f1/cos^2 implies
 integral(f,A)=(f1(#)tan).(upper_bound A)-(f1(#)tan).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds f1.x=a*x+b) & Z = dom f &
 f=a(#)(cos/sin)-f1/sin^2 implies
 integral(f,A)=(f1(#)cot).(upper_bound A)-(f1(#)cot).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds f.x=(sin.x)^2/(cos.x)^2)
 & Z c= dom (tan-id Z) & Z = dom f & f|A is continuous implies
 integral(f,A)=(tan-id Z).(upper_bound A)-(tan-id Z).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds f.x=(cos.x)^2/(sin.x)^2)
 & Z c= dom (-cot-id Z) & Z = dom f & f|A is continuous implies
 integral(f,A)=(-cot-id Z).(upper_bound A)-(-cot-id Z).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds f.x=1/(x*(1+(ln.x)^2))
 & ln.x > -1 & ln.x < 1) & Z c= dom (arctan*ln) & Z = dom f
 & f|A is continuous implies integral(f,A)=(arctan*ln).(upper_bound A)
                                          -(arctan*ln).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds f.x=-1/(x*(1+(ln.x)^2))
 & ln.x > -1 & ln.x < 1) & Z c= dom (arccot*ln) & Z = dom f
 & f|A is continuous implies integral(f,A)=(arccot*ln).(upper_bound A)
                                          -(arccot*ln).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds f.x=a / sqrt(1-(a*x+b)^2)
 & f1.x=a*x+b & f1.x>-1 & f1.x<1) & Z c= dom ((arcsin)*f1)
 & Z = dom f & f|A is continuous implies
 integral(f,A)=((arcsin)*f1).(upper_bound A)-((arcsin)*f1).(lower_bound A);

theorem 
 A c= Z & (for x st x in Z holds f.x=a / sqrt(1-(a*x+b)^2)
 & f1.x=a*x+b & f1.x>-1 & f1.x<1) & Z c= dom ((arccos)*f1)
 & Z = dom f & f|A is continuous implies
 integral(f,A)=(-(arccos)*f1).(upper_bound A)-(-(arccos)*f1).(lower_bound A);



theorem 
A c= Z & f1=g-f2 & f2=#Z 2 & (for x st x in Z holds f.x=x*(1-x #Z 2) #R (-1/2)
& g.x=1 & f1.x >0) & Z c= dom (( #R (1/2))*f1)
& Z = dom f & f|A is continuous implies
integral(f,A)=(-( #R (1/2))*f1).(upper_bound A)
             -(-( #R (1/2))*f1).(lower_bound A);



theorem 
 A c= Z & g=f1-f2 & f2=#Z 2 & (for x st x in Z holds
 f.x=x*((a^2-x #Z 2) #R (-1/2)) & f1.x=a^2 & g.x >0)
 & Z c= dom (( #R (1/2))*g) & Z = dom f & f|A is continuous implies
 integral(f,A)
 =(-( #R (1/2))*g).(upper_bound A)-(-( #R (1/2))*g).(lower_bound A);



theorem 
 A c= Z & n>0 & (for x st x in Z holds f.x=cos.x/((sin.x) #Z (n+1))
 & sin.x<>0) & Z c= dom (( #Z n)*(sin^)) & Z =dom f
 & f|A is continuous implies
 integral(f,A)=((-1/n)(#)(( #Z n)*(sin^))).(upper_bound A)
              -((-1/n)(#)(( #Z n)*(sin^))).(lower_bound A);



theorem 
 A c= Z & n>0 & (for x st x in Z holds f.x=sin.x/((cos.x) #Z (n+1))
 & cos.x<>0) & Z c= dom (( #Z n)*(cos^)) & Z =dom f
 & f|A is continuous implies
 integral(f,A)=((1/n)(#)(( #Z n)*(cos^))).(upper_bound A)
              -((1/n)(#)(( #Z n)*(cos^))).(lower_bound A);



theorem 
 A c= Z & f = ((g1+g2)^)/f2 & f2 = arccot & Z c= ]. -1,1 .[ & g2=#Z 2
 & (for x st x in Z holds f.x=1/((1+x^2)*arccot.x) & g1.x=1 & f2.x>0) &
 Z = dom f implies
 integral(f,A)=(-ln*arccot).(upper_bound A)-(-ln*arccot).(lower_bound A);



theorem 
 A c= Z & Z c= ]. -1,1 .[ & (for x st x in Z holds
 arcsin.x>0 & f1.x=1) & Z c= dom (ln*(arcsin)) & Z = dom f
 & f=((( #R (1/2))*(f1-#Z 2))(#)arcsin)^ implies
 integral(f,A)=(ln*(arcsin)).(upper_bound A)-(ln*(arcsin)).(lower_bound A);



theorem 
 A c= Z & Z c= ]. -1,1 .[  & (for x st x in Z holds f1.x=1
 & arccos.x>0) & Z c= dom (ln*arccos) & Z = dom f &
 f=((( #R (1/2))*(f1-#Z 2))(#)arccos)^ implies
 integral(f,A)=(-ln*arccos).(upper_bound A)-(-ln*arccos).(lower_bound A);














begin 

reserve f,f1,f2,g for PartFunc of REAL,REAL;
reserve A for non empty closed_interval Subset of REAL;
reserve p,r,x,x0 for Real;
reserve n for Element of NAT;
reserve Z for open Subset of REAL;

theorem 
  sin(x + 2 * n * PI) = sin x;

theorem 
  sin(x + (2*n+1)*PI) = -sin x;

theorem 
  cos(x + 2 * n* PI) = cos x;

theorem 
  cos(x + (2*n+1)*PI) = -cos x;

theorem 
  sin(x/2) >= 0 implies sin(x/2)=sqrt((1-cos(x))/2);

theorem 
  sin(x/2) < 0 implies sin(x/2)=-sqrt((1-cos(x))/2);

theorem 
  sin(PI/4) = sqrt(2)/2;

theorem 
  sin(-PI/4) = -sqrt(2)/2;

theorem 
  [.-sqrt 2/2,sqrt 2/2.] c= ].-1,1.[;

theorem 
  arcsin (sqrt 2/2) = PI/4;

theorem 
  arcsin (-sqrt 2/2) = -PI/4;

theorem 
  cos(x/2) >=0 implies cos(x/2)=sqrt((1+cos x)/2);

theorem 
  cos (PI/4) = sqrt 2/2;

theorem 
  cos(3*PI/4) = -sqrt 2 /2;

theorem 
  arccos (sqrt 2 /2) = PI/4;

theorem 
  arccos (-sqrt 2 /2) = 3*PI/4;

theorem 
  sinh.1 = (number_e^2 - 1)/(2*number_e);

theorem 
  cosh.0 = 1;

theorem 
  cosh.1 = (number_e^2 + 1)/(2*number_e);

theorem 
  for L1 being LinearFunc holds -L1 is LinearFunc;

theorem 
  for R1 being RestFunc holds -R1 is RestFunc;

theorem 
  for f1,x0 st f1 is_differentiable_in x0 holds -f1
  is_differentiable_in x0 & diff(-f1,x0)=-diff(f1,x0);

theorem 
  for f1,Z st Z c= dom (-f1) & f1 is_differentiable_on Z holds -f1
  is_differentiable_on Z & for x st x in Z holds ((-f1)`|Z).x = -diff(f1,x);

theorem 
  -sin is_differentiable_on REAL;

theorem 
  -cos is_differentiable_in x & diff(-cos,x) = sin.x;

theorem 
  -cos is_differentiable_on REAL & for x st x in REAL holds diff(- cos,x)=sin.x
;

theorem 
  sin`|REAL = cos;

theorem 
  cos`|REAL = -sin;

theorem 
  (-cos)`|REAL = sin;

theorem 
  sinh`|REAL = cosh;

theorem 
  cosh`|REAL = sinh;

theorem 
  exp_R`|REAL = exp_R;

theorem 
  Z c= dom tan implies tan is_differentiable_on Z & for x st x in Z holds
  ((tan)`|Z).x = 1/(cos.x)^2;

theorem 
  Z c= dom cot implies cot is_differentiable_on Z &
  for x st x in Z holds (cot`|Z).x = - 1/(sin.x)^2;

theorem 
  for r being Real holds rng (REAL --> r) c= REAL;

definition
  let r be Real;
  func Cst(r) -> Function of REAL,REAL equals

  REAL --> r;
end;

theorem 
  for a,b being Real, A being non empty closed_interval Subset of REAL holds
  chi(A,A)=(Cst(1))|A;

theorem 
  for a,b being Real, A being non empty closed_interval Subset of REAL st A=
  [.a,b.] holds upper_bound A=b & lower_bound A=a;

begin 

theorem 
  for a,b being Real st a<=b holds integral(Cst(1),a,b)=b-a;

theorem 
  integral(cos,A) = sin.(upper_bound A)-sin.(lower_bound A);

theorem 
  A = [.0,PI/2.] implies integral(cos,A) = 1;

theorem 
  A = [.0,PI.] implies integral(cos,A) = 0;

theorem 
  A = [.0,PI*3/2.] implies integral(cos,A) = -1;

theorem 
  A= [.0,PI*2.] implies integral(cos,A) = 0;

theorem 
  A = [.2*n*PI,(2*n+1)*PI.] implies integral(cos,A) = 0;

theorem 
  A = [.x+2*n*PI,x+(2*n+1)*PI.] implies integral(cos,A) = -2*sin(x);

theorem 
  integral(-sin,A) = cos.(upper_bound A)-cos.(lower_bound A);

theorem 
  A = [.0,PI/2.] implies integral(-sin,A) = -1;

theorem 
  A = [.0,PI.] implies integral(-sin,A) = -2;

theorem 
  A = [.0,PI*3/2.] implies integral(-sin,A) = -1;

theorem 
  A = [.0,PI*2.] implies integral(-sin,A) = 0;

theorem 
  A = [.2*n*PI,(2*n+1)*PI.] implies integral(-sin,A) = -2;

theorem 
  A = [.x+2*n*PI,x+(2*n+1)*PI.] implies integral(-sin,A) = -2*cos(x);

theorem 
  integral(exp_R,A) = exp_R.(upper_bound A)-exp_R.(lower_bound A);

theorem 
  A = [.0,1.] implies integral(exp_R,A) = number_e -1;

theorem 
  integral(sinh,A) = cosh.(upper_bound A)-cosh.(lower_bound A);

theorem 
  A= [.0,1.] implies integral(sinh,A) = (number_e - 1)^2/(2*number_e);

theorem 
  integral(cosh,A) = sinh.(upper_bound A)-sinh.(lower_bound A);

theorem 
  A= [.0,1.] implies integral(cosh,A) = (number_e^2 - 1)/(2*number_e);

theorem 
  A c= Z & dom tan = Z & dom tan = dom f2 & (for x st x in Z holds f2.x
= 1/(cos.x)^2 & cos.x <> 0) & f2|A is continuous implies integral(f2,A) = tan.(
  upper_bound A)-tan.(lower_bound A);

theorem 
  A c= Z & dom cot = Z & dom cot = dom f2 & (for x st x in Z holds f2.x
= -1/(sin.x)^2 & sin.x <> 0) & f2|A is continuous implies integral(f2,A) = cot.
  (upper_bound A)-cot.(lower_bound A);

theorem 
  dom tanh = dom f2 & (for x st x in REAL holds f2.x = 1/(cosh.x)^2) &
  f2|A is continuous implies integral(f2,A) = tanh.(upper_bound A)-tanh.(
  lower_bound A);

theorem 
  A c=].-1,1.[ & dom ((arcsin)`|].-1,1.[) = dom f2 & (for x holds
x in ].-1,1.[ & f2.x = 1/sqrt(1-x^2)) & f2|A is continuous implies integral(f2,
  A) = arcsin.(upper_bound A)-arcsin.(lower_bound A);

theorem 
  A c=].-1,1.[ & dom (arccos`|].-1,1.[) = dom f2 & (for x holds x
in ].-1,1.[ & f2.x = -1/sqrt(1-x^2)) & f2|A is continuous implies integral(f2,A
  ) = arccos.(upper_bound A)-arccos.(lower_bound A);

theorem 
  A = [.-sqrt 2/2,sqrt 2/2.] & dom ((arcsin)`|].-1,1.[) = dom f2 & (for
  x holds x in ].-1,1.[ & f2.x = 1/sqrt(1-x^2)) & f2|A is continuous implies
  integral(f2,A) = PI/2;

theorem 
  A = [.-sqrt 2/2,sqrt 2/2.] & dom ((arccos)`|].-1,1.[) = dom f2 & (for
  x holds x in ].-1,1.[ & f2.x = -1/sqrt(1-x^2)) & f2|A is continuous implies
  integral(f2,A) = -PI/2;

theorem 
  f is_differentiable_on Z & g is_differentiable_on Z & A c= Z & f
`|Z is_integrable_on A & (f`|Z)|A is bounded & g`|Z is_integrable_on A & (g`|Z)
  |A is bounded implies integral(f`|Z+g`|Z,A) = f.(upper_bound A) - f.(
  lower_bound A) + g.(upper_bound A) - g.(lower_bound A);

theorem 
  f is_differentiable_on Z & g is_differentiable_on Z & A c= Z & f
`|Z is_integrable_on A & (f`|Z)|A is bounded & g`|Z is_integrable_on A & (g`|Z)
  |A is bounded implies integral(f`|Z-g`|Z,A) = f.(upper_bound A) - f.(
  lower_bound A) - (g.(upper_bound A) - g.(lower_bound A));

theorem 
  f is_differentiable_on Z & A c= Z & f`|Z is_integrable_on A & (f
`|Z)|A is bounded implies integral((r(#)(f`|Z)),A) = r*f.(upper_bound A) - r*f.
  (lower_bound A);

theorem 
  integral(sin+cos,A) = (-cos).(upper_bound A) - (-cos).(
  lower_bound A) + sin.(upper_bound A) - sin.(lower_bound A);

theorem 
  A = [.0,PI/2.] implies integral(sin+cos,A) = 2;

theorem 
  A = [.0,PI.] implies integral(sin+cos,A) = 2;

theorem 
  A = [.0,PI*3/2.] implies integral(sin+cos,A) = 0;

theorem 
  A = [.0,PI*2.] implies integral(sin+cos,A) = 0;

theorem 
  A = [.2*n*PI,(2*n+1)*PI.] implies integral(sin+cos,A) = 2;

theorem 
  A = [.x+2*n*PI,x+(2*n+1)*PI.] implies integral(sin+cos,A) = 2*cos x - 2*sin x
;

theorem 
  integral(sinh+cosh,A) = cosh.(upper_bound A) - cosh.(lower_bound
  A) + sinh.(upper_bound A) - sinh.(lower_bound A);

theorem 
  A = [.0,1.] implies integral(sinh+cosh,A) = number_e -1;

theorem 
  integral(sin-cos,A) = (-cos).(upper_bound A) - (-cos).(
  lower_bound A) - (sin.(upper_bound A) - sin.(lower_bound A));

theorem 
  A = [.0,PI/2.] implies integral(sin-cos,A) = 0;

theorem 
  A = [.0,PI.] implies integral(sin-cos,A) = 2;

theorem 
  A = [.0,PI*3/2.] implies integral(sin-cos,A) = 2;

theorem 
  A = [.0,PI*2.] implies integral(sin-cos,A) = 0;

theorem 
  A = [.2*n*PI,(2*n+1)*PI.] implies integral(sin-cos,A) = 2;

theorem 
  A = [.x+2*n*PI,x+(2*n+1)*PI.] implies integral(sin-cos,A) = 2*cos x + 2*sin x
;

theorem 
  integral(r(#)sin,A) = r*(-cos).(upper_bound A) - r*(-cos).(lower_bound A);

theorem 
  integral(r(#)cos,A) = r*sin.(upper_bound A) - r*sin.(lower_bound A);

theorem 
  integral(r(#)sinh,A) = r*cosh.(upper_bound A) - r*cosh.(lower_bound A);

theorem 
  integral(r(#)cosh,A) = r*sinh.(upper_bound A) - r*sinh.(lower_bound A);

theorem 
  integral(r(#)exp_R,A) = r*exp_R.(upper_bound A) - r*exp_R.(lower_bound A);

theorem 
  integral(sin(#)cos,A) = 1/2*(cos.(lower_bound A)*cos.(
  lower_bound A)- cos.(upper_bound A)*cos.(upper_bound A));

theorem 
  A = [.0,PI/2.] implies integral(sin(#)cos,A) = 1/2;

theorem 
  A = [.0,PI.] implies integral(sin(#)cos,A) = 0;

theorem 
  A = [.0,PI*(3/2).] implies integral(sin(#)cos,A) = 1/2;

theorem 
  A = [.0,PI*2.] implies integral(sin(#)cos,A) = 0;

theorem 
  A = [.2*n*PI,(2*n+1)*PI.] implies integral(sin(#)cos,A) = 0;

theorem 
  A = [.x+2*n*PI,x+(2*n+1)*PI.] implies integral(sin(#)cos,A) = 0;

theorem 
  integral(sin(#)sin,A)=cos.(lower_bound A)*sin.(lower_bound A)- cos.(
  upper_bound A)*sin.(upper_bound A)+integral((cos)(#)(cos),A);

theorem 
  integral(sinh(#)sinh,A)=cosh.(upper_bound A)*sinh.(upper_bound A)-
  cosh.(lower_bound A)*sinh.(lower_bound A)-integral((cosh)(#)(cosh),A);

theorem 
  integral(sinh(#)cosh,A) =1/2*((cosh.(upper_bound A))*cosh.(upper_bound
  A)- (cosh).(lower_bound A)*cosh.(lower_bound A));

theorem 
  integral(exp_R(#)exp_R,A) =1/2*((exp_R.(upper_bound A))^2 -((exp_R).(
  lower_bound A))^2);

theorem 
  integral(exp_R(#)(sin+cos),A) = (exp_R(#)sin).(upper_bound A)-(exp_R
  (#)sin).(lower_bound A);

theorem 
  integral(exp_R(#)(cos-sin),A) = (exp_R(#)cos).(upper_bound A)-(exp_R
  (#)cos).(lower_bound A);














begin





registration
  cluster cardinal infinite -> limit_ordinal for Ordinal;
end;

registration
  cluster non empty limit_ordinal -> infinite for Ordinal;
end;

registration
  cluster non limit_cardinal -> non countable for Aleph;
end;

registration
  cluster regular non countable for Aleph;
end;



reserve A,B for limit_ordinal infinite Ordinal;
reserve B1,B2,B3,B5,B6,D, C for Ordinal;
reserve X for set;

definition
  let A,X;
  pred X is_unbounded_in A means


  X c= A & sup X = A;
  pred X is_closed_in A means


  X c= A & for B st B in A holds sup (X /\ B)=B implies B in X;
end;

definition
  let A,X;
  pred X is_club_in A means


  X is_closed_in A & X is_unbounded_in A;
end;

reserve X for Subset of A;

definition
  let A,X;
  attr X is unbounded means


  sup X = A;
  attr X is closed means


  for B st B in A holds sup (X /\ B)=B implies B in X;
end;

notation
  let A,X;
  antonym X is bounded for X is unbounded;
end;

theorem 
  X is_club_in A iff X is closed unbounded;



theorem 
  X c= sup X;

theorem 
  (X is non empty & for B1 st B1 in X ex B2 st B2 in X & B1 in B2 )
  implies sup X is limit_ordinal infinite Ordinal;

theorem 
  X is bounded iff ex B1 st B1 in A & X c= B1;

theorem 
  not sup (X /\ B) = B implies ex B1 st B1 in B & (X /\ B) c= B1;

theorem 
  X is unbounded iff for B1 st B1 in A ex C st C in X & B1 c= C;

theorem 
  X is unbounded implies X is non empty;

theorem 
  X is unbounded & B1 in A implies ex B3 being Element of A st B3
  in { B2 where B2 is Element of A: B2 in X & B1 in B2};

definition
  let A,X,B1;
  assume
 X is unbounded;
  assume
 B1 in A;
  func LBound(B1,X) -> Element of X equals


  inf { B2 where B2 is Element
  of A: B2 in X & B1 in B2};
end;

theorem 
  X is unbounded & B1 in A implies LBound(B1,X) in X & B1 in LBound(B1,X);

theorem 
  [#] A is closed unbounded;

theorem 
  B1 in A & X is closed unbounded implies X \ B1 is closed unbounded;

theorem 
  B1 in A implies A \ B1 is closed unbounded;

definition
  let A,X;
  attr X is stationary means


  for Y being Subset of A holds Y is closed
  unbounded implies X /\ Y is non empty;
end;

theorem 
  for X,Y being Subset of A holds (X is stationary & X c= Y
  implies Y is stationary);

definition
  let A;
  let X be set;
  pred X is_stationary_in A means


  X c= A & for Y being Subset of A
  holds Y is closed unbounded implies X /\ Y is non empty;
end;

theorem 
  for X,Y being set holds (X is_stationary_in A & X c= Y & Y c= A
  implies Y is_stationary_in A);



definition
  let X be set;
  let S be Subset-Family of X;
  redefine mode Element of S -> Subset of X;
end;

theorem 
  X is stationary implies X is unbounded;

definition
  let A,X;
  func limpoints X -> Subset of A equals

  {B1 where B1 is Element of A: B1 is
  infinite limit_ordinal & sup (X /\ B1) = B1};
end;

theorem 
  X /\ B3 c= B1 implies B3 /\ limpoints X c= succ B1;

theorem 
  X c= B1 implies limpoints X c= succ B1;

theorem 
  limpoints X is closed;



theorem 
  X is unbounded & limpoints X is bounded implies ex B1 st B1 in A
  & {succ B2 where B2 is Element of A : B2 in X & B1 in succ B2} is_club_in A;

reserve M for non countable Aleph;
reserve X for Subset of M;

registration
  let M;
  cluster cardinal infinite for Element of M;
end;

reserve N,N1 for cardinal infinite Element of M;

theorem 
  for M being Aleph for X being Subset of M holds X is unbounded
  implies cf M c= card X;

theorem 
  for S being Subset-Family of M st for X being Element of S holds
  X is closed holds meet S is closed;

theorem 
  omega in cf M implies for f being Function of NAT,X holds sup rng f in M;

theorem 
  omega in cf M implies for S being non empty Subset-Family of M st (
  card S in cf M & for X being Element of S holds X is closed unbounded ) holds
  meet S is closed unbounded;

theorem 
  omega in cf M & X is unbounded implies for B1 st B1 in M ex B st
  B in M & B1 in B & B in limpoints X;

theorem 
  omega in cf M & X is unbounded implies limpoints X is unbounded;

definition
  let M;
  attr M is Mahlo means


  { N : N is regular } is_stationary_in M;
  attr M is strongly_Mahlo means


  { N : N is strongly_inaccessible} is_stationary_in M;
end;

theorem 
  M is strongly_Mahlo implies M is Mahlo;

theorem 
  M is Mahlo implies M is regular;

theorem 
  M is Mahlo implies M is limit_cardinal;

theorem 
  M is Mahlo implies M is inaccessible;

theorem 
  M is strongly_Mahlo implies M is strong_limit;

theorem 
  M is strongly_Mahlo implies M is strongly_inaccessible;





begin

reserve A for Ordinal;
reserve x,y,X,Y for set;



theorem 
  (for x st x in X ex y st y in X & x c= y & y is Cardinal)
  implies union X is Cardinal;

theorem 
  for M being Aleph holds (card X in cf M & for Y st Y in X holds
  card Y in M) implies card union X in M;

theorem 
  M is strongly_inaccessible & A in M implies card Rank A in M;

theorem 
  M is strongly_inaccessible implies card Rank M = M;

theorem 
  M is strongly_inaccessible implies Rank M is Tarski;

theorem 
  for A being non empty Ordinal holds Rank A is non empty;

registration
  let A be non empty Ordinal;
  cluster Rank A -> non empty;
end;

theorem 
  M is strongly_inaccessible implies Rank M is Universe;















begin

reserve x,y,y1,y2 for set;
reserve C for non empty set;
reserve c for Element of C;



registration
  let x,y;
  cluster chi(x,y) -> [.0,1.]-valued;
end;

registration
  let C;
  cluster [.0,1.]-valued for Function of C,REAL;
end;

definition
  let C;
  mode Membership_Func of C is [.0,1.]-valued Function of C,REAL;
end;

theorem 
  chi(C,C) is Membership_Func of C;

reserve f,h,g,h1 for Membership_Func of C;

registration
  let X be non empty set;
  cluster -> real-valued for Membership_Func of X;
end;

definition

  let f,g be real-valued Function;
  pred f is_less_than g means


  dom f c= dom g & for x being set st x in dom f holds f.x <= g.x;
  reflexivity;
end;

notation
  let X be non empty set;
  let f,g be Membership_Func of X;
  synonym f c= g for f is_less_than g;
end;

definition
  let X be non empty set;
  let f,g be Membership_Func of X;
  redefine pred f is_less_than g means


  for x being Element of X holds f .x <= g.x;
end;

theorem 
  f = g iff f c= g & g c= f;

theorem 
  f c= f;

theorem 
  f c= g & g c= h implies g c= h;

begin



definition
  let C be non empty set;
  let h,g be Membership_Func of C;
  func min(h,g) -> Membership_Func of C means


  for c being Element of C holds it.c = min(h.c,g.c);
  idempotence;
  commutativity;
end;

definition
  let C be non empty set;
  let h,g be Membership_Func of C;
  func max(h,g) -> Membership_Func of C means


  for c being Element of C holds it.c = max(h.c,g.c);
  idempotence;
  commutativity;
end;

definition
  let C be non empty set;
  let h be Membership_Func of C;
  func 1_minus h -> Membership_Func of C means


  for c being Element of C holds it.c = 1-h.c;
  involutiveness;
end;

theorem 
  min(h.c,g.c) = min(h,g).c & max(h.c,g.c) = max(h,g).c;

theorem 
  max(h,h) = h & min(h,h) = h & max(h,h) = min(h,h) & min(f,g) = min(g,f
  ) & max(f,g) = max(g,f);

theorem 
  max(max(f,g),h) = max(f,max(g,h)) & min(min(f,g),h) = min(f,min(g ,h));

theorem 
  max(f,min(f,g)) = f & min(f,max(f,g)) = f;

theorem 
  min(f,max(g,h)) = max(min(f,g),min(f,h)) & max(f,min(g,h)) = min
  (max(f,g),max(f,h));

canceled;

theorem 
  1_minus(max(f,g)) = min(1_minus(f),1_minus(g)) & 1_minus(min(f,g
  )) = max(1_minus(f),1_minus(g));

begin



theorem 
  chi({},C) is Membership_Func of C;

definition
  let C be non empty set;
  func EMF(C) -> Membership_Func of C equals

  chi({},C);
end;

definition
  let C be non empty set;
  func UMF(C) -> Membership_Func of C equals

  chi(C,C);
end;

theorem 
  for a,b be Element of REAL, f be PartFunc of C,REAL st rng f c=
[.a,b.] & a <= b holds for x being Element of C st x in dom f holds a <= f.x &
  f.x <= b;

theorem 
  EMF(C) c= f;

theorem 
  f c= UMF(C);

theorem 
  for x be Element of C,h be Membership_Func of C holds (EMF(C)).x
  <= h.x & h.x <= (UMF(C)).x;

theorem 
  min(f,g) c= f & f c= max(f,g);

theorem 
  max(f,UMF(C)) = UMF(C) & min(f,UMF(C)) = f & max(f,EMF(C)) = f &
  min(f,EMF(C)) = EMF(C);

theorem 
  f c= h & g c= h implies max(f,g) c= h;

theorem 
  f c= g implies max(f,h) c= max(g,h);

theorem 
  f c= g & h c= h1 implies max(f,h) c= max(g,h1);

theorem 
  f c= g implies max(f,g) = g;

theorem 
  min(f,g) c= max(f,g);

theorem 
  h c= f & h c= g implies h c= min(f,g);

theorem 
  f c= g implies min(f,h) c= min(g,h);

theorem 
  f c= g & h c= h1 implies min(f,h) c= min(g,h1);

theorem 
  f c= g implies min(f,g) = f;

theorem 
  f c= g & f c= h & min(g,h) = EMF(C) implies f = EMF(C);

theorem 
  max(min(f,g),min(f,h)) = f implies f c= max(g,h);

theorem 
  f c= g & min(g,h) = EMF(C) implies min(f,h) = EMF(C);

theorem 
  f c= EMF(C) implies f = EMF(C);

theorem 
  max(f,g) = EMF(C) iff f = EMF(C) & g = EMF(C);

theorem 
  f = max(g,h) iff g c= f & h c= f & for h1 st g c= h1 & h c= h1 holds f c= h1;

theorem 
  f = min(g,h) iff f c= g & f c= h & for h1 st h1 c= g & h1 c= h holds h1 c= f;

theorem 
  f c= max(g,h) & min(f,h) = EMF(C) implies f c= g;

theorem 
  f c= g iff 1_minus g c= 1_minus f;

theorem 
  f c= 1_minus g implies g c= 1_minus f;

theorem 
  1_minus max(f,g) c= 1_minus f;

theorem 
  1_minus f c= 1_minus min(f,g);

theorem 
  1_minus(EMF(C)) = UMF(C) & 1_minus(UMF(C)) = EMF(C);



definition
  let C be non empty set;
  let h,g be Membership_Func of C;
  func h \+\ g -> Membership_Func of C equals

  max(min(h,1_minus(g)),min(
  1_minus(h),g));
  commutativity;
end;

theorem 
  f \+\ EMF(C) = f;

theorem 
  f \+\ UMF(C) = 1_minus f;

theorem 
  min(min(max(f,g),max(g,h)),max(h,f)) = max(max(min(f,g),min(g,h)),min( h,f));

theorem 
  max(min(f,g),min(1_minus f, 1_minus g)) c= 1_minus (f \+\ g);

theorem 
  max(f \+\ g, min(f,g)) c= max(f,g);

theorem 
  f \+\ f = min(f, 1_minus f);

definition
  let C be non empty set;
  let h,g be Membership_Func of C;
  func ab_difMF(h,g) -> Membership_Func of C means

  for c being Element of C holds it.c = abs(h.c - g.c);
end;














begin

theorem 
  for F being Function, i being set st i in dom F holds meet F c= F.i;

theorem 
  for A, B, C, D being set st A meets B & C meets D
   holds [: A, C :] meets [: B, D :];

registration
  let X be set;
  cluster -> non empty for SetSequence of X;
end;

registration
  let T be non empty set;
  cluster non-empty for SetSequence of T;
end;

definition
  let X be set, F be SetSequence of X;
  redefine func Union F -> Subset of X;
  redefine func meet F -> Subset of X;
end;

begin 

definition
  let X be set, F be SetSequence of X;
  func lim_inf F -> Subset of X means


  ex f being SetSequence of X st it
  = Union f & for n being Element of NAT holds f.n = meet (F ^\ n);
  func lim_sup F -> Subset of X means


  ex f being SetSequence of X st it
  = meet f & for n being Element of NAT holds f.n = Union (F ^\ n);
end;

theorem 
  for X being set, F being SetSequence of X, x being set
   holds x in meet F iff for z being Element of NAT holds x in F.z;

theorem 
  for X being set, F being SetSequence of X, x being set holds x in
  lim_inf F iff ex n being Element of NAT st for k being Element of NAT holds x
  in F.(n+k);

theorem 
  for X being set, F being SetSequence of X, x being set holds x in
lim_sup F iff for n being Element of NAT ex k being Element of NAT st x in F.(n
  +k);

theorem 
  for X being set, F being SetSequence of X holds lim_inf F c= lim_sup F;

theorem 
  for X being set, F being SetSequence of X holds meet F c= lim_inf F;

theorem 
  for X being set, F being SetSequence of X holds lim_sup F c= Union F;

theorem 
  for X being set, F being SetSequence of X
   holds lim_inf F = (lim_sup Complement F)`;

theorem 
  for X being set, A, B, C being SetSequence of X
   st for n being Element of NAT holds C.n = A.n /\ B.n
 holds lim_inf C = lim_inf A /\ lim_inf B;

theorem 
  for X being set, A, B, C being SetSequence of X
    st for n being Element of NAT holds C.n = A.n \/ B.n
   holds lim_sup C = lim_sup A \/ lim_sup B;

theorem 
  for X being set, A, B, C being SetSequence of X
   st for n being Element of NAT holds C.n = A.n \/ B.n
   holds lim_inf A \/ lim_inf B c= lim_inf C;

theorem 
  for X being set, A, B, C being SetSequence of X st (for n being
Element of NAT holds C.n = A.n /\ B.n) holds lim_sup C c= lim_sup A /\ lim_sup
  B;

theorem 
  for X being set, A being SetSequence of X, B being Subset of X
  st (for n being Nat holds A.n = B) holds lim_sup A = B;

theorem 
  for X being set, A being SetSequence of X, B being Subset of X
  st (for n being Nat holds A.n = B) holds lim_inf A = B;

theorem 
  for X being set, A, B being SetSequence of X, C being Subset of X st (
  for n being Element of NAT holds B.n = C \+\ A.n) holds C \+\ lim_inf A c=
  lim_sup B;

theorem 
  for X being set, A, B being SetSequence of X, C being Subset of X st (
  for n being Element of NAT holds B.n = C \+\ A.n) holds C \+\ lim_sup A c=
  lim_sup B;

begin 

theorem 
  for f being Function st (for i being Element of NAT holds f.(i+1
  ) c= f.i) for i, j being Element of NAT st i <= j holds f.j c= f.i;

definition
  let T be set, S be SetSequence of T;
  redefine attr S is non-ascending means


  for i being Element of NAT holds S.(i+1) c= S.i;
  redefine attr S is non-descending means


  for i being Element of NAT holds S.i c= S.(i+1);
end;

theorem 
  for T being set, F being SetSequence of T, x being set st F is
non-ascending & ex k being Element of NAT st for n being Element of NAT st n >
  k holds x in F.n holds x in meet F;

theorem 
  for T being set, F being SetSequence of T st F is non-ascending holds
  lim_inf F = meet F;

theorem 
  for T being set, F being SetSequence of T st F is non-descending holds
  lim_sup F = Union F;

begin 

definition
  let T be set, S be SetSequence of T;
  attr S is convergent means


  lim_sup S = lim_inf S;
end;

theorem 
  for T being set, S being SetSequence of T st S is constant holds
  the_value_of S is Subset of T;

registration
  let T be set;
  cluster constant -> convergent non-descending non-ascending for
SetSequence of T;
end;

registration
  let T be set;
  cluster constant non empty for SetSequence of T;
end;

notation
  let T be set, S be convergent SetSequence of T;
  synonym Lim_K S for lim_sup S;
end;

theorem 
  for X being set, F being convergent SetSequence of X, x being set
holds x in Lim_K F iff ex n being Element of NAT st for k being Element of NAT
  holds x in F.(n+k);















begin

registration
  let r be real number;
  cluster r/r -> non negative;
end;

registration
  let r be real number;
  cluster r*r -> non negative;
  cluster r*(r") -> non negative;
end;

registration
  let r be non negative real number;
  cluster sqrt r -> non negative;
end;

registration
  let r be positive real number;
  cluster sqrt r -> positive;
end;

theorem 
  for f being Function, A being set st f is one-to-one & A c= dom (f")
  holds f.:(f".:A) = A;

registration
  let f be non-empty Function;
  cluster f"{0} -> empty;
end;

definition
  let R be Relation;
  attr R is positive-yielding means


  for r being real number st r in rng R holds 0 < r;
  attr R is negative-yielding means


  for r being real number st r in rng R holds 0 > r;
  attr R is nonpositive-yielding means


  for r being real number st r in rng R holds 0 >= r;
  attr R is nonnegative-yielding means


  for r being real number st r in rng R holds 0 <= r;
end;

registration
  let X be set, r be positive real number;
  cluster X --> r -> positive-yielding;
end;

registration
  let X be set, r be negative real number;
  cluster X --> r -> negative-yielding;
end;

registration
  let X be set, r be non positive real number;
  cluster X --> r -> nonpositive-yielding;
end;

registration
  let X be set, r be non negative real number;
  cluster X --> r -> nonnegative-yielding;
end;

registration
  let X be non empty set;
  cluster X --> 0 -> non non-empty;
end;

registration
  cluster positive-yielding -> nonnegative-yielding non-empty for Relation;
  cluster negative-yielding -> nonpositive-yielding non-empty for Relation;
end;

registration
  let X be set;
  cluster negative-yielding for Function of X,REAL;
  cluster positive-yielding for Function of X,REAL;
end;

registration
  cluster non-empty real-valued for Function;
end;

theorem 
  for f being non-empty real-valued Function holds dom(f^) = dom f;

theorem 
  for X being non empty set, f being PartFunc of X,REAL, g being
  non-empty PartFunc of X,REAL holds dom(f/g) = dom f /\ dom g;

registration
  let X be set;
  let f, g be nonpositive-yielding PartFunc of X,REAL;
  cluster f+g -> nonpositive-yielding;
end;

registration
  let X be set;
  let f, g be nonnegative-yielding PartFunc of X,REAL;
  cluster f+g -> nonnegative-yielding;
end;

registration
  let X be set;
  let f be positive-yielding PartFunc of X,REAL;
  let g be nonnegative-yielding PartFunc of X,REAL;
  cluster f+g -> positive-yielding;
end;

registration
  let X be set;
  let f be nonnegative-yielding PartFunc of X,REAL;
  let g be positive-yielding PartFunc of X,REAL;
  cluster f+g -> positive-yielding;
end;

registration
  let X be set;
  let f be nonpositive-yielding PartFunc of X,REAL;
  let g be negative-yielding PartFunc of X,REAL;
  cluster f+g -> negative-yielding;
end;

registration
  let X be set;
  let f be negative-yielding PartFunc of X,REAL;
  let g be nonpositive-yielding PartFunc of X,REAL;
  cluster f+g -> negative-yielding;
end;

registration
  let X be set;
  let f be nonnegative-yielding PartFunc of X,REAL;
  let g be nonpositive-yielding PartFunc of X,REAL;
  cluster f-g -> nonnegative-yielding;
end;

registration
  let X be set;
  let f be nonpositive-yielding PartFunc of X,REAL;
  let g be nonnegative-yielding PartFunc of X,REAL;
  cluster f-g -> nonpositive-yielding;
end;

registration
  let X be set;
  let f be positive-yielding PartFunc of X,REAL;
  let g be nonpositive-yielding PartFunc of X,REAL;
  cluster f-g -> positive-yielding;
end;

registration
  let X be set;
  let f be nonpositive-yielding PartFunc of X,REAL;
  let g be positive-yielding PartFunc of X,REAL;
  cluster f-g -> negative-yielding;
end;

registration
  let X be set;
  let f be negative-yielding PartFunc of X,REAL;
  let g be nonnegative-yielding PartFunc of X,REAL;
  cluster f-g -> negative-yielding;
end;

registration
  let X be set;
  let f be nonnegative-yielding PartFunc of X,REAL;
  let g be negative-yielding PartFunc of X,REAL;
  cluster f-g -> positive-yielding;
end;

registration
  let X be set;
  let f, g be nonpositive-yielding PartFunc of X,REAL;
  cluster f(#)g -> nonnegative-yielding;
end;

registration
  let X be set;
  let f, g be nonnegative-yielding PartFunc of X,REAL;
  cluster f(#)g -> nonnegative-yielding;
end;

registration
  let X be set;
  let f be nonpositive-yielding PartFunc of X,REAL;
  let g be nonnegative-yielding PartFunc of X,REAL;
  cluster f(#)g -> nonpositive-yielding;
end;

registration
  let X be set;
  let f be nonnegative-yielding PartFunc of X,REAL;
  let g be nonpositive-yielding PartFunc of X,REAL;
  cluster f(#)g -> nonpositive-yielding;
end;

registration
  let X be set;
  let f be positive-yielding PartFunc of X,REAL;
  let g be negative-yielding PartFunc of X,REAL;
  cluster f(#)g -> negative-yielding;
end;

registration
  let X be set;
  let f be negative-yielding PartFunc of X,REAL;
  let g be positive-yielding PartFunc of X,REAL;
  cluster f(#)g -> negative-yielding;
end;

registration
  let X be set;
  let f, g be positive-yielding PartFunc of X,REAL;
  cluster f(#)g -> positive-yielding;
end;

registration
  let X be set;
  let f, g be negative-yielding PartFunc of X,REAL;
  cluster f(#)g -> positive-yielding;
end;

registration
  let X be set;
  let f, g be non-empty PartFunc of X,REAL;
  cluster f(#)g -> non-empty;
end;

registration
  let X be set;
  let f be PartFunc of X,REAL;
  cluster f(#)f -> nonnegative-yielding;
end;

registration
  let X be set;
  let r be non positive real number;
  let f be nonpositive-yielding PartFunc of X,REAL;
  cluster r(#)f -> nonnegative-yielding;
end;

registration
  let X be set;
  let r be non negative real number;
  let f be nonnegative-yielding PartFunc of X,REAL;
  cluster r(#)f -> nonnegative-yielding;
end;

registration
  let X be set;
  let r be non positive real number;
  let f be nonnegative-yielding PartFunc of X,REAL;
  cluster r(#)f -> nonpositive-yielding;
end;

registration
  let X be set;
  let r be non negative real number;
  let f be nonpositive-yielding PartFunc of X,REAL;
  cluster r(#)f -> nonpositive-yielding;
end;

registration
  let X be set;
  let r be positive real number;
  let f be negative-yielding PartFunc of X,REAL;
  cluster r(#)f -> negative-yielding;
end;

registration
  let X be set;
  let r be negative real number;
  let f be positive-yielding PartFunc of X,REAL;
  cluster r(#)f -> negative-yielding;
end;

registration
  let X be set;
  let r be positive real number;
  let f be positive-yielding PartFunc of X,REAL;
  cluster r(#)f -> positive-yielding;
end;

registration
  let X be set;
  let r be negative real number;
  let f be negative-yielding PartFunc of X,REAL;
  cluster r(#)f -> positive-yielding;
end;

registration
  let X be set;
  let r be non zero real number;
  let f be non-empty PartFunc of X,REAL;
  cluster r(#)f -> non-empty;
end;

registration
  let X be non empty set;
  let f, g be nonpositive-yielding PartFunc of X,REAL;
  cluster f/g -> nonnegative-yielding;
end;

registration
  let X be non empty set;
  let f, g be nonnegative-yielding PartFunc of X,REAL;
  cluster f/g -> nonnegative-yielding;
end;

registration
  let X be non empty set;
  let f be nonpositive-yielding PartFunc of X,REAL;
  let g be nonnegative-yielding PartFunc of X,REAL;
  cluster f/g -> nonpositive-yielding;
end;

registration
  let X be non empty set;
  let f be nonnegative-yielding PartFunc of X,REAL;
  let g be nonpositive-yielding PartFunc of X,REAL;
  cluster f/g -> nonpositive-yielding;
end;

registration
  let X be non empty set;
  let f be positive-yielding PartFunc of X,REAL;
  let g be negative-yielding PartFunc of X,REAL;
  cluster f/g -> negative-yielding;
end;

registration
  let X be non empty set;
  let f be negative-yielding PartFunc of X,REAL;
  let g be positive-yielding PartFunc of X,REAL;
  cluster f/g -> negative-yielding;
end;

registration
  let X be non empty set;
  let f, g be positive-yielding PartFunc of X,REAL;
  cluster f/g -> positive-yielding;
end;

registration
  let X be non empty set;
  let f, g be negative-yielding PartFunc of X,REAL;
  cluster f/g -> positive-yielding;
end;

registration
  let X be non empty set;
  let f be PartFunc of X,REAL;
  cluster f/f -> nonnegative-yielding;
end;

registration
  let X be non empty set;
  let f, g be non-empty PartFunc of X,REAL;
  cluster f/g -> non-empty;
end;

registration
  let X be set;
  let f be nonpositive-yielding Function of X,REAL;
  cluster Inv f -> nonpositive-yielding;
end;

registration
  let X be set;
  let f be nonnegative-yielding Function of X,REAL;
  cluster Inv f -> nonnegative-yielding;
end;

registration
  let X be set;
  let f be positive-yielding Function of X,REAL;
  cluster Inv f -> positive-yielding;
end;

registration
  let X be set;
  let f be negative-yielding Function of X,REAL;
  cluster Inv f -> negative-yielding;
end;

registration
  let X be set;
  let f be non-empty Function of X,REAL;
  cluster Inv f -> non-empty;
end;

registration
  let X be set;
  let f be non-empty Function of X,REAL;
  cluster -f -> non-empty;
end;

registration
  let X be set;
  let f be nonpositive-yielding Function of X,REAL;
  cluster -f -> nonnegative-yielding;
end;

registration
  let X be set;
  let f be nonnegative-yielding Function of X,REAL;
  cluster -f -> nonpositive-yielding;
end;

registration
  let X be set;
  let f be positive-yielding Function of X,REAL;
  cluster -f -> negative-yielding;
end;

registration
  let X be set;
  let f be negative-yielding Function of X,REAL;
  cluster -f -> positive-yielding;
end;

registration
  let X be set;
  let f be Function of X,REAL;
  cluster abs f -> nonnegative-yielding;
end;

registration
  let X be set;
  let f be non-empty Function of X,REAL;
  cluster abs f -> positive-yielding;
end;

registration
  let X be non empty set;
  let f be nonpositive-yielding Function of X,REAL;
  cluster f^ -> nonpositive-yielding;
end;

registration
  let X be non empty set;
  let f be nonnegative-yielding Function of X,REAL;
  cluster f^ -> nonnegative-yielding;
end;

registration
  let X be non empty set;
  let f be positive-yielding Function of X,REAL;
  cluster f^ -> positive-yielding;
end;

registration
  let X be non empty set;
  let f be negative-yielding Function of X,REAL;
  cluster f^ -> negative-yielding;
end;

registration
  let X be non empty set;
  let f be non-empty Function of X,REAL;
  cluster f^ -> non-empty;
end;

definition
  let f be real-valued Function;
  func sqrt f -> Function means


  dom it = dom f & for x being set st x in dom it holds it.x = sqrt(f.x);
end;

registration
  let f be real-valued Function;
  cluster sqrt f -> real-valued;
end;

definition
  let C be set, D be real-membered set, f be PartFunc of C,D;
  redefine func sqrt f -> PartFunc of C,REAL;
end;

registration
  let X be set;
  let f be nonnegative-yielding Function of X,REAL;
  cluster sqrt f -> nonnegative-yielding;
end;

registration
  let X be set;
  let f be positive-yielding Function of X,REAL;
  cluster sqrt f -> positive-yielding;
end;

definition
  let X be set, f be Function of X, REAL;
  redefine func sqrt f -> Function of X,REAL;
end;

definition
  let X be set, f be non-empty Function of X, REAL;
  redefine func f^ -> Function of X,REAL;
end;

definition
  let X be non empty set, f be Function of X, REAL, g be non-empty Function of
  X, REAL;
  redefine func f/g -> Function of X,REAL;
end;















begin 

reserve x,y,y1,y2 for set;
reserve C for non empty set;
reserve c for Element of C;
reserve f,h,g,h1 for Membership_Func of C;

theorem 
  for x be Element of C,h be Membership_Func of C holds 0 <= h.x & h.x <= 1;

theorem 
  f c= h implies max(f,min(g,h)) = min(max(f,g),h);

definition
  let C be non empty set;
  let f,g be Membership_Func of C;
  func f\g -> Membership_Func of C equals

  min(f,1_minus g);
end;

theorem 
  1_minus (f\g) = max(1_minus f,g);

theorem 
  f c= g implies f\h c= g\h;

theorem 
  f c= g implies h\g c= h\f;

theorem 
  f c= g & h c= h1 implies f\h1 c= g\h;

theorem 
  f\EMF(C) = f;

theorem 
  f\g c= f\min(f,g);

theorem 
  max(min(f,g),f\g) c= f;

theorem 
  max(f,g\f) c= max(f,g);

theorem 
  f\(g\h) = max(f\g,min(f,h));

theorem 
  min(f,g) c= f\(f\g);

theorem 
  f\g c= max(f,g)\g;

theorem 
  f\max(g,h) = min(f\g,f\h);

theorem 
  f\min(g,h) = max(f\g,f\h);

theorem 
  (f\g)\h = f\max(g,h);

theorem 
  f \+\ g c= max(f,g)\min(f,g);

theorem 
  f\g c= h & g\f c= h implies f \+\ g c= h;

theorem 
  min(f,g\h) c= min(f,g)\min(f,h);

theorem 
  f \+\ g c= max(f,g)\min(f,g);

theorem 
  max(min(f,g),1_minus max(f,g)) c= 1_minus (f \+\ g);

theorem 
  (f \+\ g)\h = max(f\max(g,h),g\max(f,h));

theorem 
  max(f\ max(g,h),min(min(f,g),h)) c= f\(g \+\ h);

theorem 
  f c= g implies max(f,g\f) c= g;

theorem 
  max(f \+\ g,min(f,g)) c= max(f,g);

theorem 
  f\g = EMF(C) implies f c= g;

theorem 
  min(f,g) = EMF(C) implies f\g = f;

begin 

definition
  let C be non empty set;
  let h,g be Membership_Func of C;
  func h*g -> Membership_Func of C means


  for c being Element of C holds it.c = (h.c)*(g.c);
  commutativity;
end;

definition
  let C be non empty set;
  let h,g be Membership_Func of C;
  func h ++ g -> Membership_Func of C means


  for c being Element of C holds it.c = h.c + g.c -(h.c)*(g.c);
  commutativity;
end;

theorem 
  f*f c= f & f c= f ++ f;

theorem 
  (f*g)*h = f*(g*h);

theorem 
  (f ++ g) ++ h = f ++ (g ++ h);

theorem 
  f*(f ++ g) c= f & f c= f ++ (f*g);

theorem 
  f*(g ++ h) c= (f*g) ++ (f*h);

theorem 
  (f ++ g)*(f ++ h) c= f ++ (g*h);

theorem 
  1_minus (f*g) = (1_minus f) ++ (1_minus g);

theorem 
  1_minus(f ++ g) = (1_minus f)*(1_minus g);

theorem 
  f ++ g = 1_minus((1_minus f)*(1_minus g));

theorem 
  f*(EMF(C)) = EMF(C) & f*(UMF(C)) = f;

theorem 
  f ++ EMF(C) = f & f ++ UMF(C) = UMF(C);

theorem 
  f*g c= min(f,g);

theorem 
  max(f,g) c= f ++ g;

theorem 
  for a,b,c be Real st 0 <= c holds c*max(a,b) = max(c*a,c*b) & c*min(a,
  b) = min(c*a,c*b);

theorem 
  for a,b,c be Real holds c + max(a,b) = max(c+a,c+b) & c + min(a,b) =
  min(c+a,c+b);

theorem 
  f*max(g,h) = max(f*g,f*h);

theorem 
  f*min(g,h) = min(f*g,f*h);

theorem 
  f ++ max(g,h) = max((f ++ g),(f ++ h));

theorem 
  f ++ min(g,h) = min((f ++ g),(f ++ h));

theorem 
  max(f,g)*max(f,h) c= max(f,(g*h));

theorem 
  min(f,g)*min(f,h) c= min(f,(g*h));

theorem 
  for c be Element of C,f,g be Membership_Func of C holds (f ++ g)
  .c = 1 - ((1 - f.c)*(1 - g.c));

theorem 
  max(f,g ++ h) c= max(f,g) ++ max(f,h);

theorem 
  min(f,g ++ h) c= min(f,g) ++ min(f,h);

begin 

reserve C1,C2 for non empty set;

registration
  let C be non empty set;
  cluster -> quasi_total for Membership_Func of C;
end;

definition
  let C1,C2 be non empty set;
  mode RMembership_Func of C1,C2 is Membership_Func of [:C1,C2:];
end;

reserve f,g for RMembership_Func of C1,C2;

definition
  let C1,C2 be non empty set;
  func Zmf(C1,C2) -> RMembership_Func of C1,C2 equals

  chi({},[:C1,C2:]);
  func Umf(C1,C2) -> RMembership_Func of C1,C2 equals

  chi([:C1,C2:],[:C1,C2:]);
end;

theorem 
  for x be Element of [:C1,C2:],h be RMembership_Func of C1,C2 holds (
  Zmf(C1,C2)).x <= h.x & h.x <= (Umf(C1,C2)).x;

theorem 
  max(f,Umf(C1,C2)) = Umf(C1,C2) & min(f,Umf(C1,C2)) = f & max(f,Zmf(C1,
  C2)) = f & min(f,Zmf(C1,C2)) = Zmf(C1,C2);

theorem 
  1_minus(Zmf(C1,C2)) = Umf(C1,C2) & 1_minus(Umf(C1,C2)) = Zmf(C1,C2);

theorem 
  f\g = Zmf(C1,C2) implies f c= g;

theorem 
  min(f,g) = Zmf(C1,C2) implies f\g = f;














begin 

reserve c,c1,c2,x,y,z,z1,z2 for set;
reserve C1,C2,C3 for non empty set;

registration
  let C1 be non empty set;
  let F be Membership_Func of C1;
  cluster rng F -> non empty;
end;

theorem 
  for F be Membership_Func of C1 holds rng F is real-bounded & (for x st
x in dom F holds F.x <= upper_bound rng F) & for x st x in dom F
holds F.x >= lower_bound rng F;

theorem 
  for F,G be Membership_Func of C1 holds (for x st x in C1 holds F.x <=
  G.x) implies upper_bound rng F <= upper_bound rng G;

theorem 
  for f be RMembership_Func of C1,C2, c be set holds 0 <= f.c & f.c <= 1;

definition
  let C1,C2;
  let f be RMembership_Func of C1,C2;
  let x,y;
  redefine func f.(x,y) -> Element of REAL;
end;

theorem 
  for f be RMembership_Func of C1,C2, x,y holds 0 <= f.(x,y) & f.(x,y)
  <= 1;

begin



notation
  let C1,C2 be non empty set;
  let h be RMembership_Func of C2,C1;
  synonym converse h for ~h;
end;

definition
  let C1,C2 be non empty set;
  let h be RMembership_Func of C2,C1;
  redefine func converse h -> RMembership_Func of C1,C2 means


  for x,y st [x,y] in [:C1,C2:] holds it.(x,y) = h.(y,x);
end;

theorem 
  for f be RMembership_Func of C1,C2 holds converse converse f = f;

theorem 
  for f be RMembership_Func of C1,C2 holds 1_minus(converse f) =
  converse(1_minus f);

theorem 
  for f,g be RMembership_Func of C1,C2 holds converse max(f,g) =
  max(converse f,converse g);

theorem 
  for f,g be RMembership_Func of C1,C2 holds converse min(f,g) =
  min(converse f,converse g);

theorem 
  for f,g be RMembership_Func of C1,C2, x,y st x in C1 & y in C2
  holds f. [x,y] <= g. [x,y]
   implies (converse f). [y,x] <= (converse g). [y,x];

theorem 
  for f,g be RMembership_Func of C1,C2 holds f c= g implies converse f
  c= converse g;

theorem 
  for f,g be RMembership_Func of C1,C2 holds converse(f\g) = (converse f
  )\(converse g);

theorem 
  for f,g be RMembership_Func of C1,C2 holds converse (f \+\ g) = (
  converse f) \+\ (converse g);

begin



definition
  let C1,C2,C3 be non empty set;
  let h be RMembership_Func of C1,C2;
  let g be RMembership_Func of C2,C3;
  let x,z be set;
  assume that
 x in C1 and
 z in C3;
  func min(h,g,x,z) -> Membership_Func of C2 means


  for y being Element of C2 holds it.y = min(h. [x,y],g. [y,z]);
end;

definition
  let C1,C2,C3 be non empty set;
  let h be RMembership_Func of C1,C2;
  let g be RMembership_Func of C2,C3;
  func h(#)g -> RMembership_Func of C1,C3 means


  for x,z st [x,z] in [:
  C1,C3:] holds it.(x,z) = upper_bound(rng(min(h,g,x,z)));
end;

theorem 
  for f be RMembership_Func of C1,C2, g,h be RMembership_Func of C2,C3
  holds f(#)(max(g,h)) = max(f(#)g,f(#)h);

theorem 
  for f,g be RMembership_Func of C1,C2, h be RMembership_Func of C2,C3
  holds (max(f,g))(#)h = max(f(#)h,g(#)h);

theorem 
  for f be RMembership_Func of C1,C2, g,h be RMembership_Func of C2,C3
  holds f(#)(min(g,h)) c= min(f(#)g,f(#)h);

theorem 
  for f,g be RMembership_Func of C1,C2, h be RMembership_Func of C2,C3
  holds min(f,g)(#)h c= min(f(#)h,g(#)h);

theorem 
  for f be RMembership_Func of C1,C2, g be RMembership_Func of C2,C3
  holds converse(f(#)g) = (converse g)(#)(converse f);

theorem 
  for f,g be RMembership_Func of C1,C2, h,k be RMembership_Func of
C2,C3, x,z be set st x in C1 & z in C3 & (for y be set st y in C2 holds f. [x,y
  ]<=g. [x,y] & h. [y,z]<=k. [y,z]) holds (f(#)h). [x,z] <= (g(#)k). [x,z];

theorem 
  for f,g be RMembership_Func of C1,C2, h,k be RMembership_Func of C2,C3
  st f c= g & h c= k holds f(#)h c= g(#)k;

begin




definition
  let C1,C2 be non empty set;
  func Imf(C1,C2) -> RMembership_Func of C1,C2 means


  for x,y st [x,y]
  in [:C1,C2:] holds (x=y implies it.(x,y) = 1) & (x<>y implies it.(x,y) = 0);
end;

theorem 
  for c be Element of [:C1,C2:] holds (Zmf(C1,C2)).c = 0 & (Umf(C1,C2)).
  c = 1;

theorem 
  for x,y st [x,y] in [:C1,C2:] holds (Zmf(C1,C2)). [x,y] = 0 & (Umf(C1,
  C2)). [x,y] = 1;

theorem 
  for f be RMembership_Func of C2,C3 holds Zmf(C1,C2)(#)f = Zmf(C1 ,C3);

theorem 
  for f be RMembership_Func of C1,C2 holds f(#)Zmf(C2,C3) = Zmf(C1 ,C3);

theorem 
  for f be RMembership_Func of C1,C1 holds f(#)Zmf(C1,C1) = Zmf(C1,C1) (#)f;

begin 


theorem 
  for X,Y being non empty set for x being Element of X, y being Element
of Y holds (x = y implies Imf(X,Y).(x,y) = 1) & (x <> y implies Imf(X,Y).(x,y)
  = 0);

theorem 
  for X,Y being non empty set for x being Element of X, y being Element
  of Y for f being RMembership_Func of X,Y holds (converse f).(y,x) = f.(x,y);














begin

reserve n,m,k,k1,k2,i,j for Element of NAT;
reserve x,y,z,X,Y,Z for set;
reserve A for Subset of X;
reserve B,A1,A2,A3 for SetSequence of X;
reserve Si for SigmaField of X;
reserve S,S1,S2,S3 for SetSequence of Si;

theorem 
  for f be Function of NAT,Y holds f.(n + m) in {f.k : n <= k};

theorem 
  for f being Function of NAT,Y holds {f.k1: n <= k1} = {f.k2 : n+1
  <=k2} \/ {f.n};

theorem 
  for f be Function of NAT,Y holds (for k1 holds x in f.(n+k1)) iff
  for Z st Z in {f.k2 : n <= k2} holds x in Z;

theorem 
  for Y being non empty set for f being Function of NAT,Y holds x
  in rng f iff ex n st x = f.n;

theorem 
  for Y be non empty set for f being Function of NAT,Y holds rng f
  = {f.k : 0 <= k};

theorem 
  for Y being non empty set for f being Function of NAT,Y holds rng
  (f ^\ k) = {f.n: k <= n};

theorem 
  x in meet rng B iff for n holds x in B.n;

theorem 
  Intersection B = meet rng B;

theorem 
  Intersection B c= Union B;

theorem 
  (for n holds B.n = A) implies Union B = A;

theorem 
  (for n holds B.n = A) implies Intersection B = A;

theorem 
  B is constant implies Union B = Intersection B;

theorem 
  B is constant & the_value_of B = A implies for n holds union {B.
k: n <= k} = A;

theorem 
  B is constant & the_value_of B = A implies for n holds meet {B.k
  : n <= k} = A;

theorem 
  for X, B for f being Function st dom f = NAT & for n holds f.n =
  meet {B.k: n <= k} holds f is SetSequence of X;

theorem 
  for X being set, B being SetSequence of X for f being Function
  st dom f = NAT & for n holds f.n = union {B.k: n <= k} holds f is Function of
  NAT,bool X;

definition
  let X,B;
  attr B is monotone means


  B is non-descending or B is non-ascending;
end;

definition
  let B be Function;
  func inferior_setsequence B -> Function means


  dom it = NAT & for n holds it.n = meet {B.k : n <= k};
end;

definition
  let X be set, B be SetSequence of X;
  redefine func inferior_setsequence B -> SetSequence of X;
end;

definition
  let B be Function;
  func superior_setsequence B -> Function means


  dom it = NAT & for n holds it.n = union {B.k : n <= k};
end;

definition
  let X be set, B be SetSequence of X;
  redefine func superior_setsequence B -> SetSequence of X;
end;

theorem 
  (inferior_setsequence B).0 = Intersection B;

theorem 
  (superior_setsequence B).0 = Union B;

theorem 
  x in (inferior_setsequence B).n iff for k holds x in B.(n+k);

theorem 
  x in (superior_setsequence B).n iff ex k st x in B.(n + k);

theorem 
  (inferior_setsequence B).n = (inferior_setsequence B).(n+1) /\ B .n;

theorem 
  (superior_setsequence B).n = (superior_setsequence B).(n+1) \/ B .n;

theorem 
  inferior_setsequence B is non-descending;

theorem 
  superior_setsequence B is non-ascending;

theorem 
  inferior_setsequence B is monotone & superior_setsequence B is monotone;

registration
  let X be set, A be SetSequence of X;
  cluster inferior_setsequence A -> non-descending for SetSequence of X;
end;

registration
  let X be set, A be SetSequence of X;
  cluster superior_setsequence A -> non-ascending for SetSequence of X;
end;

theorem 
  Intersection B c= (inferior_setsequence B).n;

theorem 
  (superior_setsequence B).n c= Union B;

theorem 
  for B,n holds {B.k: n <= k} is Subset-Family of X;

theorem 
  Union B = (Intersection Complement B)`;

theorem 
  (inferior_setsequence B).n = ((superior_setsequence Complement B ).n)`;

theorem 
  (superior_setsequence B).n = ((inferior_setsequence Complement B).n)`;

theorem 
  Complement (inferior_setsequence B) = (superior_setsequence Complement B);

theorem 
  Complement superior_setsequence B = inferior_setsequence Complement B;

theorem 
  (for n holds A3.n = A1.n \/ A2.n) implies for n holds (
  inferior_setsequence A1).n \/ (inferior_setsequence(A2)).n c= (
  inferior_setsequence(A3)).n;

theorem 
  (for n holds A3.n = A1.n /\ A2.n) implies for n holds (
  inferior_setsequence A3).n = (inferior_setsequence A1).n /\ (
  inferior_setsequence A2).n;

theorem 
  (for n holds A3.n = A1.n \/ A2.n) implies for n holds (
  superior_setsequence(A3)).n = (superior_setsequence(A1)).n \/ (
  superior_setsequence(A2)).n;

theorem 
  (for n holds A3.n = A1.n /\ A2.n) implies for n holds (
  superior_setsequence A3).n c= (superior_setsequence A1).n /\ (
  superior_setsequence A2).n;

theorem 
  B is constant & the_value_of B = A implies for n holds (
  inferior_setsequence B).n = A;

theorem 
  B is constant & the_value_of B = A implies for n holds (
  superior_setsequence B).n = A;

theorem 
  B is non-descending implies B.n c= (superior_setsequence(B)).(n+ 1);

theorem 
  B is non-descending implies (superior_setsequence B).n = (
  superior_setsequence B).(n+1);

theorem 
  B is non-descending implies (superior_setsequence B).n = Union B;

theorem 
  B is non-descending implies Intersection superior_setsequence B = Union B;

theorem 
  B is non-descending implies B.n c= (inferior_setsequence B).(n+1 );

theorem 
  B is non-descending implies (inferior_setsequence B).n = B.n;

theorem 
  B is non-descending implies inferior_setsequence B = B;

theorem 
  B is non-ascending implies (superior_setsequence B).(n+1) c= B.n;

theorem 
  B is non-ascending implies (superior_setsequence(B)).n = B.n;

theorem 
  B is non-ascending implies superior_setsequence(B) = B;

theorem 
  B is non-ascending implies (inferior_setsequence(B)).(n+1) c= B. n;

theorem 
  B is non-ascending implies (inferior_setsequence(B)).n = (
  inferior_setsequence(B)).(n+1);

theorem 
  B is non-ascending implies (inferior_setsequence(B)).n = Intersection B;

theorem 
  B is non-ascending implies Union inferior_setsequence(B) = Intersection B;

definition
  let X be set, B be SetSequence of X;
  redefine func lim_inf B equals

  Union inferior_setsequence B;
end;

definition
  let X be set, B be SetSequence of X;
  redefine func lim_sup B equals

  Intersection superior_setsequence B;
end;

notation
  let X be set, B be SetSequence of X;
  synonym lim B for lim_sup B;
end;

theorem 
  Intersection B c= lim_inf B;

theorem 
  lim_inf B = lim inferior_setsequence(B);

theorem 
  lim_sup B = lim superior_setsequence(B);

theorem 
  lim_sup B = (lim_inf Complement B)`;

theorem 
  B is constant & the_value_of B = A implies B is convergent & lim
  B = A & lim_inf B = A & lim_sup B = A;

theorem 
  B is non-descending implies lim_sup B = Union B;

theorem 
  B is non-descending implies lim_inf B = Union B;

theorem 
  B is non-ascending implies lim_sup B = Intersection B;

theorem 
  B is non-ascending implies lim_inf B = Intersection B;

theorem 
  B is non-descending implies B is convergent & lim B = Union B;

theorem 
  B is non-ascending implies B is convergent & lim B = Intersection B;

theorem 
  B is monotone implies B is convergent;

definition

  let X be set, Si be SigmaField of X, S be SetSequence of Si;
  redefine func inferior_setsequence S -> SetSequence of Si;
end;

definition
  let X be set, Si be SigmaField of X, S be SetSequence of Si;
  redefine func superior_setsequence S -> SetSequence of Si;
end;

theorem 
  x in lim_sup S iff for n holds ex k st x in S.(n+k);

theorem 
  x in lim_inf S iff ex n st for k holds x in S.(n+k);

theorem 
  Intersection S c= lim_inf S;

theorem 
  lim_sup S c= Union S;

theorem 
  lim_inf S c= lim_sup S;

theorem 
  lim_inf S = (lim_sup Complement S)`;

theorem 
  lim_sup S = (lim_inf Complement S)`;

theorem 
  (for n holds S3.n = S1.n \/ S2.n) implies lim_inf S1 \/ lim_inf S2 c=
  lim_inf S3;

theorem 
  (for n holds S3.n = S1.n /\ S2.n) implies lim_inf S3 = lim_inf S1 /\
  lim_inf S2;

theorem 
  (for n holds S3.n = S1.n \/ S2.n) implies lim_sup S3 = lim_sup S1 \/
  lim_sup S2;

theorem 
  (for n holds S3.n = S1.n /\ S2.n) implies lim_sup S3 c= lim_sup S1 /\
  lim_sup S2;

theorem 
  S is constant & the_value_of S = A implies S is convergent & lim S = A
  & lim_inf S = A & lim_sup S = A;

theorem 
  S is non-descending implies lim_sup S = Union S;

theorem 
  S is non-descending implies lim_inf S = Union S;

theorem 
  S is non-descending implies S is convergent & lim S = Union S;

theorem 
  S is non-ascending implies lim_sup S = Intersection S;

theorem 
  S is non-ascending implies lim_inf S = Intersection S;

theorem 
  S is non-ascending implies S is convergent & lim S = Intersection S;

theorem 
  S is monotone implies S is convergent;














begin

reserve n,m,k,i for Element of NAT,
  h,r,r1,r2,x0,x1,x2,x for Real,
  S for Functional_Sequence of REAL,REAL,
  y for set;

definition
  let f be PartFunc of REAL,REAL;
  let h be real number;
  func Shift(f,h) -> PartFunc of REAL,REAL means


  dom it = -h ++ dom f & for x st x in (-h ++ dom f) holds it.x = f.(x+h);
end;

definition
  let f be Function of REAL,REAL;
  let h be real number;
  redefine func Shift(f,h) -> Function of REAL,REAL means


  for x holds it.x = f.(x+h);
end;

definition
  let f be PartFunc of REAL,REAL, h be real number;
  func fD(f,h) -> PartFunc of REAL,REAL equals

  Shift(f,h) - f;
end;

registration
  let f be Function of REAL,REAL, h be real number;
  cluster fD(f,h) -> quasi_total;
end;

definition
  let f be PartFunc of REAL,REAL, h be real number;
  func bD(f,h) -> PartFunc of REAL,REAL equals

  f - Shift(f,-h);
end;

registration
  let f be Function of REAL,REAL, h be real number;
  cluster bD(f,h) -> quasi_total;
end;

definition
  let f be PartFunc of REAL,REAL, h be real number;
  func cD(f,h) -> PartFunc of REAL,REAL equals

  Shift(f,h/2) - Shift(f,-h/2);
end;

registration
  let f be Function of REAL,REAL, h be real number;
  cluster cD(f,h) -> quasi_total;
end;

definition
  let f be PartFunc of REAL,REAL;
  let h be real number;
  func forward_difference(f,h) -> Functional_Sequence of REAL,REAL means


  it.0=f & for n being Nat holds it.(n+1)=fD(it.n,h);
end;

notation
  let f be PartFunc of REAL,REAL;
  let h be real number;
  synonym fdif(f,h) for forward_difference(f,h);
end;

reserve f,f1,f2 for Function of REAL,REAL;

theorem 
  for f being PartFunc of REAL, REAL st x in dom f & x+h in dom f holds
    fD(f,h).x = f.(x+h) - f.x;

theorem 
  for n be Nat holds fdif(f,h).n is Function of REAL,REAL;

theorem 
  fD(f,h).x = f.(x+h) - f.x;

theorem 
  bD(f,h).x = f.x - f.(x-h);

theorem 
  cD(f,h).x = f.(x+h/2) - f.(x-h/2);

theorem 
  f is constant implies for x holds fdif(f,h).(n+1).x=0;

theorem 
  fdif(r(#)f,h).(n+1).x = r* fdif(f,h).(n+1).x;

theorem 
  fdif(f1+f2,h).(n+1).x = fdif(f1,h).(n+1).x + fdif(f2,h).(n+1).x;

theorem 
  fdif(f1-f2,h).(n+1).x = fdif(f1,h).(n+1).x - fdif(f2,h).(n+1).x;

theorem 
  fdif(r1(#)f1+r2(#)f2,h).(n+1).x = r1* fdif(f1,h).(n+1).x + r2* fdif(f2
  ,h).(n+1).x;

theorem 
  (fdif(f,h).1).x = Shift(f,h).x - f.x;

definition
  let f be PartFunc of REAL,REAL;
  let h be real number;
  func backward_difference(f,h) -> Functional_Sequence of REAL,REAL means

   it.0=f & for n being Nat holds it.(n+1)=bD(it.n,h);
end;

notation
  let f be PartFunc of REAL,REAL;
  let h be real number;
  synonym bdif(f,h) for backward_difference(f,h);
end;

theorem 
  for n be Nat holds bdif(f,h).n is Function of REAL,REAL;

theorem 
  f is constant implies for x holds bdif(f,h).(n+1).x=0;

theorem 
  bdif(r(#)f,h).(n+1).x = r* bdif(f,h).(n+1).x;

theorem 
  bdif(f1+f2,h).(n+1).x = bdif(f1,h).(n+1).x + bdif(f2,h).(n+1).x;

theorem 
  bdif(f1-f2,h).(n+1).x = bdif(f1,h).(n+1).x - bdif(f2,h).(n+1).x;

theorem 
  bdif(r1(#)f1+r2(#)f2,h).(n+1).x = r1* bdif(f1,h).(n+1).x + r2* bdif(f2
  ,h).(n+1).x;

theorem 
  (bdif(f,h).1).x = f.x - Shift(f,-h).x;

definition
  let f be PartFunc of REAL,REAL;
  let h be real number;
  func central_difference(f,h) -> Functional_Sequence of REAL,REAL means


  it.0=f & for n be Nat holds it.(n+1)=cD(it.n,h);
end;

notation
  let f be PartFunc of REAL,REAL;
  let h be real number;
  synonym cdif(f,h) for central_difference(f,h);
end;

theorem 
  for n being Nat holds cdif(f,h).n is Function of REAL,REAL;

theorem 
  f is constant implies for x holds cdif(f,h).(n+1).x=0;

theorem 
  cdif(r(#)f,h).(n+1).x = r* cdif(f,h).(n+1).x;

theorem 
  cdif(f1+f2,h).(n+1).x = cdif(f1,h).(n+1).x + cdif(f2,h).(n+1).x;

theorem 
  cdif(f1-f2,h).(n+1).x = cdif(f1,h).(n+1).x - cdif(f2,h).(n+1).x;

theorem 
  cdif(r1(#)f1+r2(#)f2,h).(n+1).x = r1* cdif(f1,h).(n+1).x + r2* cdif(f2
  ,h).(n+1).x;

theorem 
  (cdif(f,h).1).x = Shift(f,h/2).x - Shift(f,-h/2).x;

theorem 
  (fdif(f,h).n).x = (bdif(f,h).n).(x+n*h);

theorem 
  (fdif(f,h).(2*n)).x = (cdif(f,h).(2*n)).(x+n*h);

theorem 
  (fdif(f,h).(2*n+1)).x = (cdif(f,h).(2*n+1)).(x+n*h+h/2);

definition 
  let f be real-valued Function;
  let x0,x1 be real number;
  func [!f,x0,x1!] -> Real equals

  (f.x0-f.x1)/(x0-x1);
end;

definition 
  let f be real-valued Function;
  let x0,x1,x2 be real number;
  func [!f,x0,x1,x2!] -> Real equals

  ([!f,x0,x1!] - [!f,x1,x2!])/(x0-x2);
end;

definition 
  let f be real-valued Function;
  let x0,x1,x2,x3 be real number;
  func [!f,x0,x1,x2,x3!] -> Real equals

  ([!f,x0,x1,x2!] - [!f,x1,x2,x3!])/(x0-x3);
end;

theorem 
  [!f,x0,x1!] = [!f,x1,x0!];

theorem 
  f is constant implies [!f,x0,x1!] = 0;

theorem 
  [!(r(#)f),x0,x1!] = r*[!f,x0,x1!];

theorem 
  [!(f1+f2),x0,x1!] = [!f1,x0,x1!] + [!f2,x0,x1!];

theorem 
  [!(r1(#)f1+r2(#)f2),x0,x1!] = r1*[!f1,x0,x1!] + r2*[!f2,x0,x1!];

theorem 
  x0,x1,x2 are_mutually_different implies [!f,x0,x1,x2!] = [!f,x1,
  x2,x0!] & [!f,x0,x1,x2!] = [!f,x2,x1,x0!];

theorem 
  x0,x1,x2 are_mutually_different implies
  [!f,x0,x1,x2!] = [!f,x2,x0,x1!] & [!f,x0,x1,x2!] = [!f,x1,x0,x2!];

theorem 
  (fdif(fdif(f,h).m,h).n).x = fdif(f,h).(m+n).x;

definition
  let S;
  attr S is Sequence-yielding means


  for n holds S.n is Real_Sequence;
end;

registration
  cluster Sequence-yielding for Functional_Sequence of REAL,REAL;
end;

definition
  mode Seq_Sequence is Sequence-yielding Functional_Sequence of REAL,REAL;
end;

definition
  let S be Seq_Sequence;
  let n;
  redefine func S.n -> Real_Sequence;
end;

reserve S for Seq_Sequence;

theorem 
  (for n for i st i<=n holds (S.n).i=(n choose i) * fdif(f1,h).i.x *
fdif(f2,h).(n-'i).(x+i*h)) implies fdif(f1(#)f2,h).1.x = Sum(S.1, 1) & fdif(f1
  (#)f2,h).2.x = Sum(S.2, 2);

theorem 
  for f being PartFunc of REAL, REAL st x in dom f & x-h in dom f holds
  bD(f,h).x = f.x - f.(x-h);

theorem 
  for f being PartFunc of REAL, REAL st x+h/2 in dom f & x-h/2 in dom f holds
  cD(f,h).x = f.(x+h/2) - f.(x-h/2);















begin

reserve n,m,k,k1,k2 for Element of NAT;
reserve r,r1,r2,s,t,p for real number;
reserve seq,seq1,seq2 for Real_Sequence;
reserve x,y for set;

theorem 
  s - r < t & s + r > t iff abs(t-s) < r;

definition
  let seq be Real_Sequence;
  func upper_bound seq -> Real equals

  upper_bound rng seq;
end;

definition
  let seq be Real_Sequence;
  func lower_bound seq -> Real equals

  lower_bound rng seq;
end;

theorem 
  seq1+seq2-seq2=seq1;

theorem 
  r in rng seq iff -r in rng(-seq);

theorem 
  rng (-seq) = -- rng seq;

theorem 
  seq is bounded_above iff rng seq is bounded_above;

theorem 
  seq is bounded_below iff rng seq is bounded_below;

theorem 
  seq is bounded_above implies ( r = upper_bound seq iff (for n holds seq.n
  <= r) & for s st 0<s holds ex k st r-s < seq.k );

theorem 
  seq is bounded_below implies (r = lower_bound seq iff (for n holds r <=
  seq.n) & for s st 0<s holds ex k st seq.k < r+s );

theorem 
  (for n holds seq.n <= r) iff seq is bounded_above & upper_bound seq <= r;

theorem 
  (for n holds r <= seq.n) iff seq is bounded_below & r <= lower_bound seq;

theorem 
  seq is bounded_above iff -seq is bounded_below;

theorem 
  seq is bounded_below iff -seq is bounded_above;

theorem 
  seq is bounded_above implies upper_bound seq = -lower_bound (-seq);

theorem 
  seq is bounded_below implies lower_bound seq = -upper_bound (-seq);

theorem 
  seq1 is bounded_below & seq2 is bounded_below implies lower_bound (seq1
  + seq2) >= lower_bound seq1 + lower_bound seq2;

theorem 
  seq1 is bounded_above & seq2 is bounded_above implies upper_bound (seq1
  + seq2) <= upper_bound seq1 + upper_bound seq2;

notation
  let f be Real_Sequence;
  synonym f is nonnegative for f is nonnegative-yielding;
end;

definition
  let f be Real_Sequence;
  redefine attr f is nonnegative means


  for n holds f.n >= 0;
end;

theorem 
  seq is nonnegative implies seq ^\k is nonnegative;

theorem 
  seq is bounded_below nonnegative implies lower_bound seq >= 0;

theorem 
  seq is bounded_above nonnegative implies upper_bound seq >= 0;

theorem 
  seq1 is bounded_below nonnegative & seq2 is bounded_below
  nonnegative implies (seq1(#)seq2) is bounded_below &
  lower_bound (seq1 (#) seq2) >= (
  lower_bound seq1) * (lower_bound seq2);

theorem 
  seq1 is bounded_above nonnegative & seq2 is bounded_above
  nonnegative implies (seq1(#)seq2) is bounded_above &
  upper_bound (seq1 (#) seq2) <= (
  upper_bound seq1) * (upper_bound seq2);

theorem 
  seq is non-decreasing bounded_above implies seq is bounded;

theorem 
  seq is non-increasing bounded_below implies seq is bounded;

theorem 
  seq is non-decreasing bounded_above implies lim seq = upper_bound seq;

theorem 
  seq is non-increasing bounded_below implies lim seq = lower_bound seq;

theorem 
  seq is bounded_above implies seq ^\k is bounded_above;

theorem 
  seq is bounded_below implies seq ^\k is bounded_below;

theorem 
  seq is bounded implies seq ^\k is bounded;

theorem 
  for seq, n holds {seq.k: n <= k} is Subset of REAL;

theorem 
  rng (seq ^\ k) = {seq.n: k <= n};

theorem 
  seq is bounded_above implies for n for R being Subset of REAL st
  R = {seq.k : n <= k} holds R is bounded_above;

theorem 
  seq is bounded_below implies for n for R being Subset of REAL st
  R = {seq.k : n <= k} holds R is bounded_below;

theorem 
  seq is bounded implies for n for R being Subset of REAL st R = {
  seq.k : n <= k} holds R is real-bounded;

theorem 
  seq is non-decreasing implies for n for R being Subset of REAL
  st R = {seq.k : n <= k} holds lower_bound R = seq.n;

theorem 
  seq is non-increasing implies for n for R being Subset of REAL
  st R = {seq.k : n <= k} holds upper_bound R = seq.n;

definition
  let seq be Real_Sequence;
  func inferior_realsequence seq -> Real_Sequence means


  for n for Y
  being Subset of REAL st Y = {seq.k : n <= k} holds it.n = lower_bound Y;
end;

definition
  let seq be Real_Sequence;
  func superior_realsequence seq -> Real_Sequence means


  for n for Y
  being Subset of REAL st Y = {seq.k : n <= k} holds it.n = upper_bound Y;
end;

theorem 
  (inferior_realsequence seq).n = lower_bound (seq ^\n);

theorem 
  (superior_realsequence seq).n = upper_bound (seq ^\n);

theorem 
  seq is bounded_below implies (inferior_realsequence seq).0 = lower_bound seq;

theorem 
  seq is bounded_above implies (superior_realsequence seq).0 = upper_bound seq;

theorem 
  seq is bounded_below implies (r = (inferior_realsequence seq).n
  iff (for k holds r <= seq.(n+k)) & for s st 0<s ex k st seq.(n+k)<r+s);

theorem 
  seq is bounded_above implies (r = (superior_realsequence seq).n
  iff (for k holds seq.(n+k) <= r) & for s st 0<s ex k st r-s<seq.(n+k));

theorem 
  seq is bounded_below implies ((for k holds r <= seq.(n+k)) iff r
  <= (inferior_realsequence seq).n);

theorem 
  seq is bounded_below implies ((for m st n <= m holds r <= seq.m)
  iff r <= (inferior_realsequence seq).n);

theorem 
  seq is bounded_above implies ((for k holds seq.(n+k) <= r) iff (
  superior_realsequence seq).n <= r);

theorem 
  seq is bounded_above implies ((for m st n<=m holds seq.m <= r)
  iff (superior_realsequence seq).n <= r);

theorem 
  seq is bounded_below implies (inferior_realsequence seq).n = min
  ((inferior_realsequence seq).(n+1),seq.n);

theorem 
  seq is bounded_above implies (superior_realsequence seq).n = max
  ((superior_realsequence seq).(n+1),seq.n);

theorem 
  seq is bounded_below implies (inferior_realsequence seq).n <= (
  inferior_realsequence seq).(n+1);

theorem 
  seq is bounded_above implies (superior_realsequence seq).(n+1)
  <= (superior_realsequence seq).n;

theorem 
  seq is bounded_below implies inferior_realsequence seq is non-decreasing;

theorem 
  seq is bounded_above implies superior_realsequence seq is non-increasing;

theorem 
  seq is bounded implies (inferior_realsequence seq).n <= (
  superior_realsequence seq).n;

theorem 
  seq is bounded implies (inferior_realsequence seq).n <= lower_bound (
  superior_realsequence seq);

theorem 
  seq is bounded implies upper_bound(inferior_realsequence seq) <= (
  superior_realsequence seq).n;

theorem 
  seq is bounded implies upper_bound(inferior_realsequence seq) <= lower_bound(
  superior_realsequence seq);

theorem 
  seq is bounded implies superior_realsequence seq is bounded &
  inferior_realsequence seq is bounded;

theorem 
  seq is bounded implies inferior_realsequence seq is convergent &
  lim inferior_realsequence seq = upper_bound inferior_realsequence seq;

theorem 
  seq is bounded implies superior_realsequence seq is convergent &
  lim superior_realsequence seq = lower_bound superior_realsequence seq;

theorem 
  seq is bounded_below implies (inferior_realsequence seq).n = - (
  superior_realsequence(-seq)).n;

theorem 
  seq is bounded_above implies (superior_realsequence seq).n = - (
  inferior_realsequence(-seq)).n;

theorem 
  seq is bounded_below implies (inferior_realsequence seq) = - (
  superior_realsequence(-seq));

theorem 
  seq is bounded_above implies (superior_realsequence seq) = - (
  inferior_realsequence(-seq));

theorem 
  seq is non-decreasing implies seq.n <= (inferior_realsequence seq).(n+ 1);

theorem 
  seq is non-decreasing implies inferior_realsequence seq = seq;

theorem 
  seq is non-decreasing bounded_above implies seq.n <= (
  superior_realsequence seq).(n+1);

theorem 
  seq is non-decreasing bounded_above implies (
  superior_realsequence seq).n = (superior_realsequence seq).(n+1);

theorem 
  seq is non-decreasing bounded_above implies (
  superior_realsequence seq).n = upper_bound seq & (superior_realsequence seq)
   is
  constant;

theorem 
  seq is non-decreasing bounded_above implies
  lower_bound (superior_realsequence
  seq) = upper_bound seq;

theorem 
  seq is non-increasing implies (superior_realsequence seq).(n+1) <= seq .n;

theorem 
  seq is non-increasing implies superior_realsequence seq = seq;

theorem 
  seq is non-increasing bounded_below implies (
  inferior_realsequence seq).(n+1) <= seq.n;

theorem 
  seq is non-increasing bounded_below implies (
  inferior_realsequence seq).n = (inferior_realsequence seq).(n+1);

theorem 
  seq is non-increasing & seq is bounded_below implies (
  inferior_realsequence seq).n = lower_bound seq &
  (inferior_realsequence seq) is
  constant;

theorem 
  seq is non-increasing bounded_below implies upper_bound inferior_realsequence
  seq = lower_bound seq;

theorem 
  seq1 is bounded & seq2 is bounded & (for n holds seq1.n <= seq2.
  n) implies (for n holds (superior_realsequence seq1).n <= (
superior_realsequence seq2).n) & for n holds (inferior_realsequence seq1).n <=
  (inferior_realsequence seq2).n;

theorem 
  seq1 is bounded_below & seq2 is bounded_below implies (
  inferior_realsequence(seq1+seq2)).n >= (inferior_realsequence seq1).n + (
  inferior_realsequence seq2).n;

theorem 
  seq1 is bounded_above & seq2 is bounded_above implies (
  superior_realsequence(seq1+seq2)).n <= (superior_realsequence seq1).n + (
  superior_realsequence seq2).n;

theorem 
  seq1 is bounded_below nonnegative & seq2 is bounded_below nonnegative
implies (inferior_realsequence(seq1(#)seq2)).n >= (inferior_realsequence seq1).
  n * (inferior_realsequence seq2).n;

theorem 
  seq1 is bounded_below nonnegative & seq2 is bounded_below
  nonnegative implies (inferior_realsequence(seq1(#)seq2)).n >= (
  inferior_realsequence seq1).n * (inferior_realsequence seq2).n;

theorem 
  seq1 is bounded_above nonnegative & seq2 is bounded_above
  nonnegative implies (superior_realsequence(seq1(#)seq2)).n <= (
  superior_realsequence seq1).n * (superior_realsequence seq2).n;

definition
  let seq be Real_Sequence;
  func lim_sup seq -> Element of REAL equals

  lower_bound superior_realsequence seq;
end;

definition
  let seq be Real_Sequence;
  func lim_inf seq -> Element of REAL equals

  upper_bound inferior_realsequence seq;
end;

theorem 
  seq is bounded implies (lim_inf seq <= r iff for s st 0<s holds
  for n ex k st seq.(n+k)<r+s );

theorem 
  seq is bounded implies (r <= lim_inf seq iff for s st 0<s holds
  ex n st for k holds r-s<seq.(n+k) );

theorem 
  seq is bounded implies (r = lim_inf seq iff for s st 0<s holds (for n
  ex k st seq.(n+k)<r+s) & ex n st for k holds r-s<seq.(n+k) );

theorem 
  seq is bounded implies (r <= lim_sup seq iff for s st 0<s holds
  for n ex k st seq.(n+k)>r-s );

theorem 
  seq is bounded implies (lim_sup seq <= r iff for s st 0<s holds
  ex n st for k holds seq.(n+k)<r+s );

theorem 
  seq is bounded implies (r = lim_sup seq iff for s st 0<s holds (for n
  holds ex k st seq.(n+k)>r-s) & ex n st for k holds seq.(n+k)<r+s );

theorem 
  seq is bounded implies lim_inf seq <= lim_sup seq;

theorem 
  seq is bounded & lim_sup seq = lim_inf seq iff seq is convergent;

theorem 
  seq is convergent implies lim seq = lim_sup seq & lim seq = lim_inf seq;

theorem 
  seq is bounded implies lim_sup -seq = - lim_inf seq & lim_inf -
  seq = - lim_sup seq;

theorem 
  seq1 is bounded & seq2 is bounded & (for n holds seq1.n <= seq2.n)
  implies lim_sup seq1 <= lim_sup seq2 & lim_inf seq1 <= lim_inf seq2;

theorem 
  seq1 is bounded & seq2 is bounded implies lim_inf seq1 + lim_inf seq2
  <= lim_inf (seq1+seq2) & lim_inf (seq1+seq2) <= lim_inf seq1 + lim_sup seq2 &
  lim_inf (seq1+seq2) <= lim_sup seq1 + lim_inf seq2 & lim_inf seq1 + lim_sup
seq2 <= lim_sup (seq1+seq2) & lim_sup seq1 + lim_inf seq2 <= lim_sup (seq1+seq2
) & lim_sup (seq1+seq2) <= lim_sup seq1 + lim_sup seq2 & (seq1 is convergent or
seq2 is convergent implies lim_inf (seq1+seq2) = lim_inf seq1 + lim_inf seq2 &
  lim_sup (seq1+seq2) = lim_sup seq1 + lim_sup seq2 );

theorem 
  seq1 is bounded nonnegative & seq2 is bounded nonnegative implies (
  lim_inf seq1) * (lim_inf seq2) <= lim_inf(seq1(#)seq2) & lim_sup(seq1(#)seq2)
  <= (lim_sup seq1) * (lim_sup seq2);














begin

reserve n,m,k for Element of NAT,
  x,X for set,
  A for Subset of X,
  A1,A2 for SetSequence of X;

theorem 
  (inferior_setsequence(A1)).n = Intersection (A1 ^\n);

theorem 
  (superior_setsequence(A1)).n = Union (A1 ^\n);

definition
  let X;
  let A1,A2 be SetSequence of X;
  func A1 (/\) A2 -> SetSequence of X means


  for n holds it.n = A1.n /\ A2.n;
  commutativity;
  func A1 (\/) A2 -> SetSequence of X means


  for n holds it.n = A1.n \/ A2.n;
  commutativity;
  func A1 (\) A2 -> SetSequence of X means


  for n holds it.n = A1.n \ A2 .n;
  func A1 (\+\) A2 -> SetSequence of X means


  for n holds it.n = A1.n \+\ A2.n;
  commutativity;
end;

theorem 
  A1 (\+\) A2 = (A1 (\) A2) (\/) (A2 (\) A1);

theorem 
  (A1 (/\) A2) ^\k = (A1 ^\k) (/\) (A2 ^\k);

theorem 
  (A1 (\/) A2) ^\k = (A1 ^\k) (\/) (A2 ^\k);

theorem 
  (A1 (\) A2) ^\k = (A1 ^\k) (\) (A2 ^\k);

theorem 
  (A1 (\+\) A2) ^\k = (A1 ^\k) (\+\) (A2 ^\k);

theorem 
  Union (A1 (/\) A2) c= Union A1 /\ Union A2;

theorem 
  Union (A1 (\/) A2) = Union A1 \/ Union A2;

theorem 
  Union A1 \ Union A2 c= Union (A1 (\) A2);

theorem 
  Union A1 \+\ Union A2 c= Union (A1 (\+\) A2);

theorem 
  Intersection (A1 (/\) A2) = Intersection A1 /\ Intersection A2;

theorem 
  Intersection A1 \/ Intersection A2 c= Intersection (A1 (\/) A2);

theorem 
  Intersection (A1 (\) A2) c= Intersection A1 \ Intersection A2;

definition
  let X;
  let A1 be SetSequence of X, A be Subset of X;
  func A (/\) A1 -> SetSequence of X means


  for n holds it.n = A /\ A1.n;
  func A (\/) A1 -> SetSequence of X means


  for n holds it.n = A \/ A1.n;
  func A (\) A1 -> SetSequence of X means


  for n holds it.n = A \ A1.n;
  func A1 (\) A -> SetSequence of X means


  for n holds it.n = A1.n \ A;
  func A (\+\) A1 -> SetSequence of X means


  for n holds it.n = A \+\ A1 .n;
end;

theorem 
  A (\+\) A1 = (A (\) A1) (\/) (A1 (\) A);

theorem 
  (A (/\) A1) ^\k = A (/\) (A1 ^\k);

theorem 
  (A (\/) A1) ^\k = A (\/) (A1 ^\k);

theorem 
  (A (\) A1) ^\k = A (\) (A1 ^\k);

theorem 
  (A1 (\) A) ^\k = (A1 ^\k) (\) A;

theorem 
  (A (\+\) A1) ^\k = A (\+\) (A1 ^\k);

theorem 
  A1 is non-ascending implies A (/\) A1 is non-ascending;

theorem 
  A1 is non-descending implies A (/\) A1 is non-descending;

theorem 
  A1 is monotone implies A (/\) A1 is monotone;

theorem 
  A1 is non-ascending implies A (\/) A1 is non-ascending;

theorem 
  A1 is non-descending implies A (\/) A1 is non-descending;

theorem 
  A1 is monotone implies A (\/) A1 is monotone;

theorem 
  A1 is non-ascending implies A (\) A1 is non-descending;

theorem 
  A1 is non-descending implies A (\) A1 is non-ascending;

theorem 
  A1 is monotone implies A (\) A1 is monotone;

theorem 
  A1 is non-ascending implies A1 (\) A is non-ascending;

theorem 
  A1 is non-descending implies A1 (\) A is non-descending;

theorem 
  A1 is monotone implies A1 (\) A is monotone;

theorem 
  Intersection (A (/\) A1) = A /\ Intersection A1;

theorem 
  Intersection (A (\/) A1) = A \/ Intersection A1;

theorem 
  Intersection (A (\) A1) c= A \ Intersection A1;

theorem 
  Intersection (A1 (\) A) = Intersection A1 \ A;

theorem 
  Intersection (A (\+\) A1) c= A \+\ Intersection A1;

theorem 
  Union (A (/\) A1) = A /\ Union A1;

theorem 
  Union (A (\/) A1) = A \/ Union A1;

theorem 
  A \ Union A1 c= Union (A (\) A1);

theorem 
  Union (A1 (\) A) = Union A1 \ A;

theorem 
  A \+\ Union A1 c= Union (A (\+\) A1);

theorem 
  (inferior_setsequence(A1 (/\) A2)).n = (inferior_setsequence A1).n /\
  (inferior_setsequence A2).n;

theorem 
  (inferior_setsequence A1).n \/ (inferior_setsequence A2).n c= (
  inferior_setsequence(A1 (\/) A2)).n;

theorem 
  (inferior_setsequence(A1 (\) A2)).n c= (inferior_setsequence A1).n \ (
  inferior_setsequence A2).n;

theorem 
  (superior_setsequence(A1 (/\) A2)).n c= (superior_setsequence A1).n /\
  (superior_setsequence A2).n;

theorem 
  (superior_setsequence(A1 (\/) A2)).n = (superior_setsequence A1).n \/
  (superior_setsequence A2).n;

theorem 
  (superior_setsequence A1).n \ (superior_setsequence A2).n c= (
  superior_setsequence(A1 (\) A2)).n;

theorem 
  (superior_setsequence A1).n \+\ (superior_setsequence A2).n c= (
  superior_setsequence(A1 (\+\) A2)).n;

theorem 
  (inferior_setsequence(A (/\) A1)).n = A /\ (inferior_setsequence A1).n;

theorem 
  (inferior_setsequence(A (\/) A1)).n = A \/ (inferior_setsequence A1).n;

theorem 
  (inferior_setsequence(A (\) A1)).n c= A \ (inferior_setsequence A1).n;

theorem 
  (inferior_setsequence(A1 (\) A)).n = (inferior_setsequence A1).n \ A;

theorem 
  (inferior_setsequence(A (\+\) A1)).n c= A \+\ (inferior_setsequence A1 ).n;

theorem 
  (superior_setsequence(A (/\) A1)).n = A /\ (superior_setsequence A1).n;

theorem 
  (superior_setsequence(A (\/) A1)).n = A \/ (superior_setsequence A1).n;

theorem 
  A \ (superior_setsequence A1).n c= (superior_setsequence(A (\) A1)).n;

theorem 
  (superior_setsequence(A1 (\) A)).n = (superior_setsequence A1).n \ A;

theorem 
  A \+\ (superior_setsequence A1).n c= (superior_setsequence(A (\+\) A1) ).n;

theorem 
  lim_inf (A1 (/\) A2) = lim_inf A1 /\ lim_inf A2;

theorem 
  lim_inf A1 \/ lim_inf A2 c= lim_inf (A1 (\/) A2);

theorem 
  lim_inf (A1 (\) A2) c= lim_inf A1 \ lim_inf A2;

theorem 
  A1 is convergent or A2 is convergent implies lim_inf (A1 (\/) A2
  ) = lim_inf A1 \/ lim_inf A2;

theorem 
  A2 is convergent implies lim_inf (A1 (\) A2) = lim_inf A1 \ lim_inf A2;

theorem 
  A1 is convergent or A2 is convergent implies lim_inf (A1 (\+\)
  A2) c= lim_inf A1 \+\ lim_inf A2;

theorem 
  A1 is convergent & A2 is convergent implies lim_inf (A1 (\+\) A2
  ) = lim_inf A1 \+\ lim_inf A2;

theorem 
  lim_sup (A1 (/\) A2) c= lim_sup A1 /\ lim_sup A2;

theorem 
  lim_sup (A1 (\/) A2) = lim_sup A1 \/ lim_sup A2;

theorem 
  lim_sup A1 \ lim_sup A2 c= lim_sup (A1 (\) A2);

theorem 
  lim_sup A1 \+\ lim_sup A2 c= lim_sup (A1 (\+\) A2);

theorem 
  A1 is convergent or A2 is convergent implies lim_sup (A1 (/\) A2
  ) = lim_sup A1 /\ lim_sup A2;

theorem 
  A2 is convergent implies lim_sup (A1 (\) A2) = lim_sup A1 \ lim_sup A2;

theorem 
  A1 is convergent & A2 is convergent implies lim_sup (A1 (\+\) A2
  ) = lim_sup A1 \+\ lim_sup A2;

theorem 
  lim_inf (A (/\) A1) = A /\ lim_inf A1;

theorem 
  lim_inf (A (\/) A1) = A \/ lim_inf A1;

theorem 
  lim_inf (A (\) A1) c= A \ lim_inf A1;

theorem 
  lim_inf (A1 (\) A) = lim_inf A1 \ A;

theorem 
  lim_inf (A (\+\) A1) c= A \+\ lim_inf A1;

theorem 
  A1 is convergent implies lim_inf (A (\) A1) = A \ lim_inf A1;

theorem 
  A1 is convergent implies lim_inf (A (\+\) A1) = A \+\ lim_inf A1;

theorem 
  lim_sup (A (/\) A1) = A /\ lim_sup A1;

theorem 
  lim_sup (A (\/) A1) = A \/ lim_sup A1;

theorem 
  A \ lim_sup A1 c= lim_sup (A (\) A1);

theorem 
  lim_sup (A1 (\) A) = lim_sup A1 \ A;

theorem 
  A \+\ lim_sup A1 c= lim_sup (A (\+\) A1);

theorem 
  A1 is convergent implies lim_sup (A (\) A1) = A \ lim_sup A1;

theorem 
  A1 is convergent implies lim_sup (A (\+\) A1) = A \+\ lim_sup A1;

theorem 
  A1 is convergent & A2 is convergent implies (A1 (/\) A2) is convergent
  & lim (A1 (/\) A2) = lim A1 /\ lim A2;

theorem 
  A1 is convergent & A2 is convergent implies (A1 (\/) A2) is convergent
  & lim (A1 (\/) A2) = lim A1 \/ lim A2;

theorem 
  A1 is convergent & A2 is convergent implies (A1 (\) A2) is convergent
  & lim (A1 (\) A2) = lim A1 \ lim A2;

theorem 
  A1 is convergent & A2 is convergent implies (A1 (\+\) A2) is
  convergent & lim (A1 (\+\) A2) = lim A1 \+\ lim A2;

theorem 
  A1 is convergent implies (A (/\) A1) is convergent & lim (A (/\) A1) =
  A /\ lim A1;

theorem 
  A1 is convergent implies (A (\/) A1) is convergent & lim (A (\/) A1) =
  A \/ lim A1;

theorem 
  A1 is convergent implies (A (\) A1) is convergent & lim (A (\) A1) = A
  \ lim A1;

theorem 
  A1 is convergent implies (A1 (\) A) is convergent & lim (A1 (\) A) =
  lim A1 \ A;

theorem 
  A1 is convergent implies (A (\+\) A1) is convergent & lim (A (\+\) A1)
  = A \+\ lim A1;














begin

reserve n,m,k,i for Nat,
  g,s,t,p for real number,
  x,y,z,X,Y,Z for set,
  A1 for SetSequence of X,
  F1 for FinSequence of bool X,
  RFin for FinSequence of REAL,
  Si for SigmaField of X,
  XSeq,YSeq for SetSequence of Si,
  Omega for non empty set,
  Sigma for SigmaField of Omega,
  ASeq,BSeq for SetSequence of Sigma,
  P for Probability of Sigma;

theorem 
  for f being FinSequence holds not 0 in dom f;

theorem 
  for f being FinSequence holds n in dom f iff n<>0 & n <= len f;

theorem 
  for f being Real_Sequence st (ex k st for n st k<=n holds f.n=g)
  holds f is convergent & lim f = g;

theorem 
  (P * ASeq).n >= 0;

theorem 
  ASeq.n c= BSeq.n implies (P * ASeq).n <= (P * BSeq).n;

theorem 
  ASeq is non-descending implies P * ASeq is non-decreasing;

theorem 
  ASeq is non-ascending implies P * ASeq is non-increasing;

definition
  let X be set, A1 be SetSequence of X;
  func Partial_Intersection A1 -> SetSequence of X means


  it.0 = A1.0 & for n being Nat holds it.(n+1) = it.n /\ A1.(n+1);
end;

definition
  let X be set, A1 be SetSequence of X;
  func Partial_Union A1 -> SetSequence of X means


  it.0 = A1.0 & for n being Nat holds it.(n+1) = it.n \/ A1.(n+1);
end;

theorem 
  (Partial_Intersection A1).n c= A1.n;

theorem 
  A1.n c= (Partial_Union A1).n;

theorem 
  Partial_Intersection A1 is non-ascending;

theorem 
  Partial_Union A1 is non-descending;

theorem 
  x in (Partial_Intersection A1).n iff for k st k <= n holds x in A1.k;

theorem 
  x in (Partial_Union A1).n iff ex k st k <= n & x in A1.k;

theorem 
  Intersection Partial_Intersection A1 = Intersection A1;

theorem 
  Union Partial_Union A1 = Union A1;

definition
  let X be set, A1 be SetSequence of X;
  func Partial_Diff_Union A1 -> SetSequence of X means


  it.0 = A1.0 &
  for n being Nat holds it.(n+1) = A1.(n+1) \ (Partial_Union A1).n;
end;

theorem 
  x in (Partial_Diff_Union A1).n iff x in A1.n & for k st k < n
  holds not x in A1.k;

theorem 
  (Partial_Diff_Union A1).n c= A1.n;

theorem 
  (Partial_Diff_Union A1).n c= (Partial_Union A1).n;

theorem 
  Partial_Union (Partial_Diff_Union A1) = Partial_Union A1;

theorem 
  Union Partial_Diff_Union A1 = Union A1;

definition
  let X,A1;
  redefine attr A1 is disjoint_valued means


  for m,n st m <> n holds A1. m misses A1.n;
end;

registration let X,A1;
 cluster Partial_Diff_Union A1 -> disjoint_valued;
end;

registration
 let X be set, Si be SigmaField of X, XSeq be SetSequence of Si;
 cluster Partial_Intersection XSeq -> Si-valued;
end;

registration
  let X be set, Si be SigmaField of X, XSeq be SetSequence of Si;
  cluster Partial_Union XSeq -> Si-valued;
end;

registration
  let X be set, Si be SigmaField of X, XSeq be SetSequence of Si;
  cluster Partial_Diff_Union XSeq -> Si-valued;
end;

theorem 
  YSeq = Partial_Intersection XSeq implies YSeq.0 = XSeq.0 & for n
  holds YSeq.(n+1) = YSeq.n /\ XSeq.(n+1);

theorem 
  YSeq = Partial_Union XSeq implies YSeq.0 = XSeq.0 & for n holds YSeq.
  (n+1) = YSeq.n \/ XSeq.(n+1);

theorem 
  (Partial_Intersection XSeq).n c= XSeq.n;

theorem 
  XSeq.n c= (Partial_Union XSeq).n;

theorem 
  x in (Partial_Intersection XSeq).n iff for k st k <= n holds x in
  XSeq.k;

theorem 
  x in (Partial_Union XSeq).n iff ex k st k <= n & x in XSeq.k;

theorem 
  Partial_Intersection XSeq is non-ascending;

theorem 
  Partial_Union XSeq is non-descending;

theorem 
  Intersection Partial_Intersection XSeq = Intersection XSeq;

theorem 
  Union Partial_Union XSeq = Union XSeq;

theorem 
  YSeq = Partial_Diff_Union XSeq implies YSeq.0 = XSeq.0 & for n holds
  YSeq.(n+1) = XSeq.(n+1) \ (Partial_Union XSeq).n;

theorem 
  x in (Partial_Diff_Union XSeq).n iff x in XSeq.n & for k st k < n
  holds not x in XSeq.k;

theorem 
  (Partial_Diff_Union XSeq).n c= XSeq.n;

theorem 
  (Partial_Diff_Union XSeq).n c= (Partial_Union XSeq).n;

theorem 
  Partial_Union (Partial_Diff_Union XSeq) = Partial_Union XSeq;

theorem 
  Union Partial_Diff_Union XSeq = Union XSeq;

theorem 
  (P * Partial_Union ASeq) is non-decreasing;

theorem 
  (P * Partial_Intersection ASeq) is non-increasing;

theorem 
  Partial_Sums(P * ASeq) is non-decreasing;

theorem 
  (P * Partial_Union ASeq).0 = Partial_Sums(P * ASeq).0;

theorem 
  P * Partial_Union ASeq is convergent & lim (P * Partial_Union
ASeq) = upper_bound (P * Partial_Union ASeq) & lim (P * Partial_Union ASeq)
 = P.Union
  ASeq;

theorem 
  ASeq is disjoint_valued implies for n,m st n < m holds (
  Partial_Union ASeq).n misses ASeq.m;

theorem 
  ASeq is disjoint_valued implies (P * Partial_Union ASeq).n =
  Partial_Sums(P * ASeq).n;

theorem 
  ASeq is disjoint_valued implies (P * Partial_Union ASeq) =
  Partial_Sums(P * ASeq);

theorem 
  ASeq is disjoint_valued implies Partial_Sums(P * ASeq) is
  convergent & lim Partial_Sums(P * ASeq) = upper_bound Partial_Sums(P * ASeq)
   & lim
  Partial_Sums(P * ASeq) = P.Union ASeq;

theorem 
  ASeq is disjoint_valued implies P.(Union ASeq) = Sum(P * ASeq);

definition
  let X,F1,n;
  redefine func F1.n -> Subset of X;
end;

theorem 
  ex F1 being FinSequence of bool X st for k st k in dom F1 holds F1.k = X;

theorem 
  for F1 being FinSequence of bool X holds union rng F1 is Subset of X;

definition
  let X be set, F1 be FinSequence of bool X;
  redefine func Union F1 -> Subset of X;
end;

theorem 
  x in Union F1 iff ex k st k in dom F1 & x in F1.k;

definition

  let X, F1;
  func Complement F1 -> FinSequence of bool X means


  len it = len F1 & for n st n in dom it holds it.n = (F1.n)`;
end;

definition
  let X, F1;
  func Intersection F1 -> Subset of X equals


  (Union Complement F1)` if
  F1 <> {} otherwise {};
end;

theorem 
  dom Complement F1 = dom F1;

theorem 
  F1 <> {} implies (x in Intersection F1 iff for k st k in dom F1
  holds x in F1.k );

theorem 
  F1 <> {} implies (x in meet rng F1 iff for n st n in dom F1 holds x in F1.n);

theorem 
  Intersection F1 = meet rng F1;

theorem 
  for F1 being FinSequence of bool X holds ex A1 being SetSequence
  of X st (for k st k in dom F1 holds A1.k = F1.k) & for k st not k in dom F1
  holds A1.k = {};

theorem 
  for F1 being FinSequence of bool X for A1 being SetSequence of X
  st (for k st k in dom F1 holds A1.k = F1.k) & (for k st not k in dom F1 holds
  A1.k = {}) holds A1.0={} & Union A1 = Union F1;

definition 
  let X be set, Si be SigmaField of X;
  redefine mode FinSequence of Si -> FinSequence of bool X;
end;

definition
  let X be set, Si be SigmaField of X, FSi be FinSequence of Si,n;
  redefine func FSi.n -> Event of Si;
end;

theorem 
  for FSi being FinSequence of Si holds ex ASeq being SetSequence
  of Si st (for k st k in dom FSi holds ASeq.k = FSi.k) & for k st not k in dom
  FSi holds ASeq.k = {};

theorem 
  for FSi being FinSequence of Si holds Union FSi in Si;

 registration
  let X be set, S be SigmaField of X, F being FinSequence of S;
  cluster Complement F -> S-valued;
end;

theorem 
  for FSi being FinSequence of Si holds Intersection FSi in Si;

reserve FSeq for FinSequence of Sigma;

theorem 
  dom(P * FSeq) = dom FSeq;

theorem 
  P * FSeq is FinSequence of REAL;

definition
  let Omega,Sigma,FSeq,P;
  redefine func P * FSeq -> FinSequence of REAL;
end;

theorem 
  len (P * FSeq) = len FSeq;

theorem 
  len RFin = 0 implies Sum RFin = 0;

theorem 
  len RFin >= 1 implies ex f being Real_Sequence st f.1 = RFin.1 &
(for n st 0 <> n & n < len RFin holds f.(n+1) = f.n+RFin.(n+1)) & Sum(RFin) = f
  .(len RFin);

theorem 
  for FSeq being FinSequence of Sigma, ASeq being SetSequence of
  Sigma st (for k st k in dom FSeq holds ASeq.k = FSeq.k) & (for k st not k in
dom FSeq holds ASeq.k = {}) holds Partial_Sums(P * ASeq) is convergent & Sum(P
* ASeq) = Partial_Sums(P * ASeq).(len FSeq) & P.(Union ASeq) <= Sum(P * ASeq) &
  Sum(P * FSeq) = Sum(P * ASeq);

theorem 
  P.(Union FSeq) <= Sum(P * FSeq) & (FSeq is disjoint_valued implies P.(
  Union FSeq) = Sum(P * FSeq));

definition
 canceled 2;
  let X;
  let IT be Subset-Family of X;
  attr IT is non-decreasing-closed means


  for A1 being SetSequence of X
  st A1 is non-descending & rng A1 c= IT holds Union A1 in IT;
  attr IT is non-increasing-closed means


  for A1 being SetSequence of X
  st A1 is non-ascending & rng A1 c= IT holds Intersection A1 in IT;
end;

theorem 
  for IT be Subset-Family of X holds IT is non-decreasing-closed
iff for A1 being SetSequence of X st A1 is non-descending & rng A1 c= IT holds
  lim A1 in IT;

theorem 
  for IT be Subset-Family of X holds IT is non-increasing-closed
  iff for A1 being SetSequence of X st A1 is non-ascending & rng A1 c= IT holds
  lim A1 in IT;

theorem 
  bool X is non-decreasing-closed & bool X is non-increasing-closed;

registration
  let X;
  cluster non-decreasing-closed non-increasing-closed for Subset-Family of X;
end;

definition
  let X;
  mode MonotoneClass of X is non-decreasing-closed non-increasing-closed
    Subset-Family of X;
end;

theorem 
  Z is MonotoneClass of X iff Z c= bool X & for A1 being
  SetSequence of X st A1 is monotone & rng A1 c= Z holds lim A1 in Z;

theorem 
  for F being Field_Subset of X holds F is SigmaField of X iff F
  is MonotoneClass of X;

theorem 
  bool Omega is MonotoneClass of Omega;

definition

  let Omega;
  let X be Subset-Family of Omega;
  func monotoneclass(X) -> MonotoneClass of Omega means


  X c= it & for Z st X c= Z & Z is MonotoneClass of Omega holds it c= Z;
end;

theorem 
  for Z being Field_Subset of Omega holds monotoneclass(Z) is
  Field_Subset of Omega;

theorem 
  for Z being Field_Subset of Omega holds sigma Z = monotoneclass Z;














begin

reserve Omega, F for non empty set,
  f for SetSequence of Omega,
  X,A,B for Subset of Omega,
  D for non empty Subset-Family of Omega,
  n,m for Element of NAT,
  h,x,y,z,u,v,Y,I for set;



theorem 
  for f being SetSequence of Omega for x holds x in rng f iff ex n st f.n=x;

theorem 
  for n holds n is finite;

registration
  let n;
  cluster Segm(n) -> finite;
end;

definition
  let Omega be non empty set;
  let a,b,c be Subset of Omega;
  redefine func (a,b) followed_by c -> SetSequence of Omega;
end;

theorem 
  for a,b being set holds Union (a,b) followed_by {} = a \/ b;

definition

  let Omega be non empty set;
  let f be SetSequence of Omega;
  let X be Subset of Omega;
  func seqIntersection(X,f) -> SetSequence of Omega means


  for n holds it.n = X /\ f.n;
end;

begin



definition
  let Omega;
  let f;
  redefine attr f is disjoint_valued means


  n<m implies f.n misses f.m;
end;

theorem 
  for Y being non empty set holds for x holds x c= meet Y iff for y
  being Element of Y holds x c= y;

notation
  let x be set;
  synonym x is intersection_stable for x is cap-closed;
end;

definition
  let Omega be non empty set;
  let f be SetSequence of Omega;
  let n be Nat;

  func disjointify(f,n) -> Subset of Omega equals

  f.n \ union rng (f|n);
end;

definition
  let Omega be non empty set;
  let g be SetSequence of Omega;
  func disjointify(g) -> SetSequence of Omega means


  for n being Nat holds it.n=disjointify(g,n);
end;

theorem 
  for n being Nat holds (disjointify(f)).n=f.n \ union rng(f|n);

theorem 
  for f being SetSequence of Omega holds disjointify(f) is disjoint_valued;

theorem 
  for f being SetSequence of Omega holds union rng disjointify(f) = union rng f
;

theorem 
  for x,y being Subset of Omega st x misses y holds (x,y)
  followed_by {} Omega is disjoint_valued;

theorem 
  for f being SetSequence of Omega holds f is disjoint_valued
  implies for X being Subset of Omega holds seqIntersection(X,f) is
  disjoint_valued;

theorem 
  for f being SetSequence of Omega for X being Subset of Omega
  holds X/\ Union f= Union seqIntersection(X,f);

begin



definition
  let Omega;
  mode Dynkin_System of Omega -> Subset-Family of Omega means


    (for f
holds rng f c= it & f is disjoint_valued implies Union f in it) & (for X holds
    X in it implies X` in it) & {} in it;
end;

registration
  let Omega;
  cluster -> non empty for Dynkin_System of Omega;
end;

theorem 
  bool Omega is Dynkin_System of Omega;

theorem 
  (for Y st Y in F holds Y is Dynkin_System of Omega) implies meet
  F is Dynkin_System of Omega;

theorem 
  D is Dynkin_System of Omega & D is intersection_stable implies (
  A in D & B in D implies A\B in D);

theorem 
  D is Dynkin_System of Omega & D is intersection_stable implies (
  A in D & B in D implies A \/ B in D);

theorem 
  D is Dynkin_System of Omega & D is intersection_stable implies
  for x being finite set holds x c= D implies union x in D;

theorem 
  D is Dynkin_System of Omega & D is intersection_stable implies
for f being SetSequence of Omega holds rng f c= D implies rng disjointify(f) c=
  D;

theorem 
  D is Dynkin_System of Omega & D is intersection_stable implies
  for f being SetSequence of Omega holds rng f c= D implies union rng f in D;

theorem 
  for D being Dynkin_System of Omega for x,y being Element of D
  holds x misses y implies x \/ y in D;

theorem 
  for D being Dynkin_System of Omega for x,y being Element of D
  holds x c= y implies y\x in D;

begin



theorem 
  D is Dynkin_System of Omega & D is intersection_stable implies D
  is SigmaField of Omega;

definition
  let Omega be non empty set;
  let E be Subset-Family of Omega;
  func generated_Dynkin_System(E) -> Dynkin_System of Omega means


  E c= it & for D being Dynkin_System of Omega holds (E c= D implies it c= D);
end;

definition
  let Omega be non empty set;
  let G be set;
  let X be Subset of Omega;
  func DynSys(X,G) -> Subset-Family of Omega means


  for A being Subset of Omega holds A in it iff A /\ X in G;
end;

definition
  let Omega be non empty set;
  let G be Dynkin_System of Omega;
  let X be Element of G;
  redefine func DynSys(X,G) -> Dynkin_System of Omega;
end;

theorem 
  for E being Subset-Family of Omega for X,Y being Subset of Omega
  holds X in E & Y in generated_Dynkin_System(E) & E is intersection_stable
  implies X/\ Y in generated_Dynkin_System(E);

theorem 
  for E being Subset-Family of Omega for X,Y being Subset of Omega
holds X in generated_Dynkin_System(E) & Y in generated_Dynkin_System(E) & E is
  intersection_stable implies X/\ Y in generated_Dynkin_System(E);

theorem 
  for E being Subset-Family of Omega st E is intersection_stable
  holds generated_Dynkin_System(E) is intersection_stable;


theorem 
  for E being Subset-Family of Omega st E is intersection_stable for D
  being Dynkin_System of Omega st E c= D holds sigma(E) c= D;















begin

reserve n,m,k for Element of NAT,
  x,X for set,
  A1 for SetSequence of X,
  Si for SigmaField of X,
  XSeq for SetSequence of Si;
reserve Omega for non empty set,
  Sigma for SigmaField of Omega,
  ASeq for SetSequence of Sigma,
  P for Probability of Sigma;

definition
  let X,Si,XSeq,n;
  redefine func XSeq.n -> Element of Si;
end;

theorem 
  rng XSeq c= Si;

theorem 
  for f being Function holds f is SetSequence of Si iff f is Function of NAT,Si
;

scheme 

  LambdaSigmaSSeq { X() -> set, Si() -> SigmaField of X(), F(set) -> Element
  of Si() } : ex f being SetSequence of Si() st for n holds f.n = F(n);

registration
  let X;
  cluster disjoint_valued for SetSequence of X;
end;

registration
  let X,Si;
  cluster disjoint_valued for SetSequence of Si;
end;

theorem 
  for A, B being Subset of X st A misses B holds (A,B) followed_by
  {} is disjoint_valued;

theorem 
  for S being non empty set holds S is SigmaField of X iff S c=
  bool X & (for A1 being SetSequence of X st rng A1 c= S holds Union A1 in S) &
  for A being Subset of X st A in S holds A` in S;

theorem 
  for A,B being Event of Sigma holds P.(A \ B) = P.(A \/ B) - P.B;

theorem 
  for A,B being Event of Sigma st A c= B & P.B = 0 holds P.A = 0;

theorem 
  (for n holds P.(ASeq.n) = 0) iff P.(Union ASeq) = 0;

theorem 
  (for A being set st A in rng ASeq holds P.A = 0) iff P.(union rng ASeq) = 0;

theorem 
  for seq being Function of NAT,REAL, Eseq being Function of NAT,
  ExtREAL st seq = Eseq holds Partial_Sums seq = Ser Eseq;

theorem 
  for seq being Function of NAT,REAL, Eseq being Function of NAT,
  ExtREAL st seq = Eseq & seq is bounded_above
  holds upper_bound seq = sup rng Eseq;

theorem 
  for seq being Function of NAT,REAL, Eseq being Function of NAT,
  ExtREAL st seq = Eseq & seq is bounded_below
   holds lower_bound seq = inf rng Eseq;

theorem 
  for seq being Function of NAT,REAL, Eseq being Function of NAT,
  ExtREAL st seq = Eseq & seq is nonnegative summable holds Sum seq = SUM Eseq;

theorem 
  P is sigma_Measure of Sigma;

definition
  let Omega,Sigma,P;
  func P2M(P) -> sigma_Measure of Sigma equals

  P;
end;

theorem 
  for X being non empty set, S being SigmaField of X, M being
  sigma_Measure of S st M.X = R_EAL(1) holds M is Probability of S;

definition
  let X be non empty set, S be SigmaField of X, M be sigma_Measure of S;
  assume
 M.X = R_EAL(1);
  func M2P(M) -> Probability of S equals

  M;
end;

theorem 
  A1 is non-descending implies Partial_Union A1 = A1;

theorem 
  A1 is non-descending implies (Partial_Diff_Union A1).0 = A1.0 &
  for n holds (Partial_Diff_Union A1).(n+1) = A1.(n+1) \ A1.n;

theorem 
  A1 is non-descending implies for n holds A1.(n+1) = (
  Partial_Diff_Union A1).(n+1) \/ A1.n;

theorem 
  A1 is non-descending implies for n holds (Partial_Diff_Union A1)
  .(n+1) misses A1.n;

theorem 
  XSeq is non-descending implies Partial_Union XSeq = XSeq;

theorem 
  XSeq is non-descending implies (Partial_Diff_Union XSeq).0 = XSeq.0 &
  for n holds (Partial_Diff_Union XSeq).(n+1) = XSeq.(n+1) \ XSeq.n;

theorem 
  XSeq is non-descending implies for n holds (Partial_Diff_Union XSeq).
  (n+1) misses XSeq.n;

definition
  let Omega,Sigma,P;
  pred P is_complete Sigma means


  for A being Subset of Omega for B
  being set st B in Sigma holds (A c= B & P.B=0 implies A in Sigma);
end;

theorem 
  P is_complete Sigma iff P2M(P) is_complete Sigma;

definition
  let Omega,Sigma,P;
  mode thin of P -> Subset of Omega means


    ex A being set st A in Sigma & it c= A & P.A = 0;
end;

theorem 
  for Y being Subset of Omega holds Y is thin of P iff Y is thin of P2M(P);

theorem 
  {} is thin of P;

theorem 
  for B1,B2 being set st B1 in Sigma & B2 in Sigma holds for C1,C2
  being thin of P holds B1 \/ C1 = B2 \/ C2 implies P.B1 = P.B2;

definition
  let Omega,Sigma,P;
  func COM(Sigma,P) -> non empty Subset-Family of Omega means


  for A
being set holds A in it iff ex B being set st B in Sigma & ex C being thin of P
  st A = B \/ C;
end;

theorem 
  for C being thin of P holds C in COM(Sigma,P);

theorem 
  COM(Sigma,P) = COM(Sigma,P2M P);

definition
  let Omega,Sigma,P;
  let A be Element of COM(Sigma,P);
  func P_COM2M_COM(A) -> Element of COM(Sigma,P2M(P)) equals

  A;
end;

theorem 
  Sigma c= COM(Sigma,P);

definition
  let Omega,Sigma,P;
  let A be Element of COM(Sigma,P);
  func ProbPart(A) -> non empty Subset-Family of Omega means


  for B
  being set holds (B in it iff B in Sigma & B c= A & A \ B is thin of P );
end;

theorem 
  for A being Element of COM(Sigma,P) holds ProbPart(A) = MeasPart(
  P_COM2M_COM(A));

theorem 
  for A being Element of COM(Sigma,P) holds for A1,A2 being set st A1 in
  ProbPart(A) & A2 in ProbPart(A) holds P.A1 = P.A2;

theorem 
  for F being Function of NAT,COM(Sigma,P) holds ex BSeq being
  SetSequence of Sigma st for n holds BSeq.n in ProbPart(F.n);

theorem 
  for F being Function of NAT,COM(Sigma,P), BSeq being SetSequence
of Sigma holds ex CSeq being SetSequence of Omega st for n holds CSeq.n = F.n \
  BSeq.n;

theorem 
  for BSeq being SetSequence of Omega st (for n holds BSeq.n is
  thin of P) holds ex CSeq being SetSequence of Sigma st for n holds BSeq.n c=
  CSeq.n & P.(CSeq.n) = 0;

theorem 
  for D being non empty Subset-Family of Omega holds (for A being
set holds (A in D iff ex B being set st B in Sigma & ex C being thin of P st A
  = B \/ C)) implies D is SigmaField of Omega;

registration
  let Omega,Sigma,P;
  cluster COM(Sigma,P) -> compl-closed sigma-multiplicative;
end;

definition
  let Omega,Sigma,P;
  redefine mode thin of P -> Event of COM(Sigma,P);
end;

theorem 
  for A being set holds (A in COM(Sigma,P) iff ex A1,A2 being set
  st A1 in Sigma & A2 in Sigma & A1 c= A & A c= A2 & P.(A2 \ A1) = 0);

theorem 
  for C being non empty Subset-Family of Omega holds (for A being set
holds (A in C iff ex A1,A2 being set st A1 in Sigma & A2 in Sigma & A1 c= A & A
  c= A2 & P.(A2 \ A1) = 0)) implies C = COM(Sigma,P);

definition
  let Omega,Sigma,P;
  func COM(P) -> Probability of COM(Sigma,P) means


  for B being set st B in Sigma for C being thin of P holds it.(B \/ C) = P.B;
end;

theorem 
  COM(P) = COM(P2M P);

theorem 
  COM(P) is_complete COM(Sigma,P);

theorem 
  for A being Event of Sigma holds P.A = (COM P).A;

theorem 
  for C being thin of P holds (COM P).C = 0;

theorem 
  for A being Element of COM(Sigma,P), B being set st B in ProbPart(A)
  holds P.B = (COM P).A;














begin

reserve Omega, I for non empty set;
reserve Sigma for SigmaField of Omega;
reserve P for Probability of Sigma;
reserve D, E, F for Subset-Family of Omega;
reserve  B, sB for non empty Subset of Sigma;
reserve b for Element of B;
reserve a for Element of Sigma;
reserve p, q, u, v for Event of Sigma;
reserve n, m for Element of NAT;
reserve S, S9, X, x, y, z, i, j for set;

theorem 
  for f being Function, X being set st X c= dom f holds X <> {}
  implies rng (f|X) <> {};

theorem 
  for r being Real st r*r=r holds r=0 or r=1;

theorem 
  for X being Subset-Family of Omega st X={} holds sigma(X) = {{}, Omega};

definition
  let Omega be non empty set, Sigma be SigmaField of Omega, B be Subset of
  Sigma, P be Probability of Sigma;
  func Indep(B,P) -> Subset of Sigma means


  for a being Element of Sigma
  holds a in it iff for b being Element of B holds P.(a /\ b) = P.a * P.b;
end;

theorem 
  for f being SetSequence of Sigma holds (for n,b holds P.(f.n /\ b
  ) = P.(f.n) * P.b) & f is disjoint_valued implies P.(b /\ Union f) = P.b * P.
  Union f;

theorem 
  Indep(B,P) is Dynkin_System of Omega;

theorem 
  for A being Subset-Family of Omega st A is intersection_stable &
  A c= Indep(B,P) holds sigma(A) c= Indep(B,P);

theorem 
  for A, B being non empty Subset of Sigma holds A c= Indep(B,P)
  iff for p,q st p in A & q in B holds p,q are_independent_respect_to P;

theorem 
  for A,B being non empty Subset of Sigma st A c= Indep(B,P) holds
  B c= Indep(A,P);

theorem 
  for A being Subset-Family of Omega st A is non empty Subset of
Sigma & A is intersection_stable for B being non empty Subset of Sigma st B is
intersection_stable holds A c= Indep(B,P) implies for D,sB st D=B & sigma(D)=sB
  holds sigma(A) c= Indep(sB,P);

theorem 
  for E,F st E is non empty Subset of Sigma & E is
intersection_stable & F is non empty Subset of Sigma & F is intersection_stable
  holds (for p,q st p in E & q in F holds p,q are_independent_respect_to P)
  implies for u,v st u in sigma(E) & v in sigma(F) holds u,v
  are_independent_respect_to P;

definition
  let I be set, Omega be non empty set, Sigma be SigmaField of Omega;
  mode ManySortedSigmaField of I,Sigma -> Function of I, bool Sigma means


     for i st i in I holds it.i is SigmaField of Omega;
end;

definition
  let Omega be non empty set, Sigma be SigmaField of Omega, P be Probability
  of Sigma, I be set, A be Function of I, Sigma;
  pred A is_independent_wrt P means


  for e being one-to-one FinSequence
  of I st e <> {} holds Product (P*A*e) = P.(meet rng (A*e));
end;

definition
  let Omega be non empty set, Sigma be SigmaField of Omega, I be set, J be
  Subset of I, F be ManySortedSigmaField of I,Sigma;
  mode SigmaSection of J,F -> Function of J, Sigma means


    for i st i in J holds it.i in F.i;
end;

definition
  let Omega be non empty set, Sigma be SigmaField of Omega, P be Probability
  of Sigma, I be set, F be ManySortedSigmaField of I,Sigma;
  pred F is_independent_wrt P means


  for E being finite Subset of I, A
  being SigmaSection of E,F holds A is_independent_wrt P;
end;

definition
  let I be set, Omega be non empty set, Sigma be SigmaField of Omega, F be
  ManySortedSigmaField of I,Sigma, J be Subset of I;
  redefine func F|J -> Function of J, bool Sigma;
end;

definition
  let I be set, J be Subset of I, Omega be non empty set, Sigma be SigmaField
  of Omega, F be Function of J, bool Sigma;
  redefine func Union F -> Subset-Family of Omega;
end;

definition
  let I be set, Omega be non empty set, Sigma be SigmaField of Omega, F be
  ManySortedSigmaField of I,Sigma, J be Subset of I;
  func sigUn(F,J) -> SigmaField of Omega equals

  sigma Union (F|J);
end;

definition
  let I be set, Omega be non empty set, Sigma be SigmaField of Omega, F be
  ManySortedSigmaField of I, Sigma;
  func futSigmaFields(F,I) -> Subset-Family of bool Omega means


  for S
being Subset-Family of Omega holds S in it iff ex E being finite Subset of I st
  S=sigUn(F,I\E);
end;

registration
  let I be set, Omega be non empty set, Sigma be SigmaField of Omega, F be
  ManySortedSigmaField of I, Sigma;
  cluster futSigmaFields(F,I) -> non empty;
end;

definition
  let I be set, Omega be non empty set, Sigma be SigmaField of Omega, F be
  ManySortedSigmaField of I, Sigma;
  func tailSigmaField(F,I) -> Subset-Family of Omega equals

  meet
  futSigmaFields(F,I);
end;

registration
  let I be set, Omega be non empty set, Sigma be SigmaField of Omega, F be
  ManySortedSigmaField of I, Sigma;
  cluster tailSigmaField(F,I) -> non empty;
end;

definition
  let Omega be non empty set, Sigma be SigmaField of Omega, I be non empty set
  , J be non empty Subset of I, F be ManySortedSigmaField of I,Sigma;
  func MeetSections(J,F) -> Subset-Family of Omega means


  for x being
  Subset of Omega holds x in it iff ex E being non empty finite Subset of I, f
  being SigmaSection of E,F st E c= J & x = meet rng f;
end;

theorem 
  for F being ManySortedSigmaField of I, Sigma, J being non empty
  Subset of I holds sigma MeetSections(J,F) = sigUn(F,J);

theorem 
  for F being ManySortedSigmaField of I, Sigma, J,K being non
  empty Subset of I st F is_independent_wrt P & J misses K holds for a,c being
  Subset of Omega st a in MeetSections(J,F) & c in MeetSections(K,F) holds P.(a
  /\ c) = P.a * P.c;

theorem 
  for F being ManySortedSigmaField of I,Sigma, J being non empty
  Subset of I holds MeetSections(J,F) is non empty Subset of Sigma;

registration
  let I,Omega,Sigma;
  let F be ManySortedSigmaField of I,Sigma, J be non empty Subset of I;
  cluster MeetSections(J,F) -> intersection_stable;
end;

theorem 
  for F being ManySortedSigmaField of I,Sigma, J,K being non empty
Subset of I st F is_independent_wrt P & J misses K holds for u,v st u in sigUn(
  F,J) & v in sigUn(F,K) holds P.(u /\ v) = P.u * P.v;

definition
  let I be set, Omega be non empty set, Sigma be SigmaField of Omega, F be
  ManySortedSigmaField of I, Sigma;
  func finSigmaFields(F,I) -> Subset-Family of Omega means


  for S being
Subset of Omega holds S in it iff ex E being finite Subset of I st S in sigUn(F
  ,E);
end;

theorem 
  for F being ManySortedSigmaField of I, Sigma holds
  tailSigmaField(F,I) is SigmaField of Omega;


theorem 
  for F being ManySortedSigmaField of I,Sigma st F is_independent_wrt P
  & a in tailSigmaField(F,I) holds P.a=0 or P.a=1;














begin 

theorem 
  for x,y be R_eal holds |.x-y.| = |.y-x.|;

theorem 
  for x,y be R_eal holds y-x <= |.x-y.|;

theorem 
  for x,y be R_eal, e be real number st |.x-y.| < e & not ( x =
  +infty & y = +infty or x = -infty & y = -infty ) holds x <> +infty & x <>
  -infty & y <> +infty & y <>-infty;

theorem 
  for n be Nat, p be R_eal st 0 <= p & p < n holds ex k be Nat st 1
  <= k & k <= 2|^n*n & (k-1)/(2|^n) <= p & p < k/(2|^n);

theorem 
  for n,k be Nat, p be R_eal st k <= 2|^n*n & n <= p holds k/(2|^n) <= p;

theorem 
  for x,y,k being ext-real number st 0 <= k holds k*max(x,y) = max
  (k*x,k*y) & k*min(x,y) = min(k*x,k*y);

theorem 
  for x,y,k being R_eal st k <= 0 holds k*min(x,y) = max(k*x,k*y) & k*
  max(x,y) = min(k*x,k*y);

begin 

definition
  let IT be set;
  attr IT is nonpositive means


  for x being R_eal holds x in IT implies x <= 0;
end;

definition
  let R be Relation;
  attr R is nonpositive means


  rng R is nonpositive;
end;

theorem 
  for X being set, F being PartFunc of X,ExtREAL holds F is
  nonpositive iff for n being set holds F.n <= 0.;

theorem 
  for X being set, F being PartFunc of X,ExtREAL st for n being
  set st n in dom F holds F.n <= 0. holds F is nonpositive;

definition
  let R be Relation;
  attr R is without-infty means


  not -infty in rng R;
  attr R is without+infty means


  not +infty in rng R;
end;

definition
  let X be non empty set, f be PartFunc of X,ExtREAL;
  redefine attr f is without-infty means


  for x being set holds -infty < f.x;
  redefine attr f is without+infty means


  for x being set holds f.x < +infty;
end;

theorem 
  for X be non empty set, f be PartFunc of X,ExtREAL holds (for x
  be set st x in dom f holds -infty < f.x) iff f is without-infty;

theorem 
  for X be non empty set, f be PartFunc of X,ExtREAL holds (for x
  be set st x in dom f holds f.x < +infty) iff f is without+infty;

theorem 
  for X be non empty set, f be PartFunc of X,ExtREAL st f is
  nonnegative holds f is without-infty;

theorem 
  for X be non empty set, f be PartFunc of X,ExtREAL st f is
  nonpositive holds f is without+infty;

registration
  let X be non empty set;
  cluster nonnegative -> without-infty for PartFunc of X,ExtREAL;
  cluster nonpositive -> without+infty for PartFunc of X,ExtREAL;
end;

theorem 
  for X be non empty set, S be SigmaField of X, f be PartFunc of X
,ExtREAL st f is_simple_func_in S holds f is without+infty & f is without-infty
;

theorem 
  for X be non empty set, Y be set, f be PartFunc of X,ExtREAL st
  f is nonnegative holds f|Y is nonnegative;

theorem 
  for X be non empty set, f,g be PartFunc of X,ExtREAL st f is
  without-infty & g is without-infty holds dom(f+g)=dom f /\ dom g;

theorem 
  for X be non empty set, f,g be PartFunc of X,ExtREAL st f is
  without-infty & g is without+infty holds dom(f-g)=dom f /\ dom g;

theorem 
  for X be non empty set, S be SigmaField of X, f,g be PartFunc of
  X,ExtREAL, F be Function of RAT,S, r be Real, A be Element of S st f is
  without-infty & g is without-infty & (for p be Rational holds F.p = A /\
less_dom(f,R_EAL p) /\ (A /\ less_dom(g,R_EAL (r-p)))) holds A /\ less_dom(f+g,
  R_EAL r) = union rng F;

definition
  let X be non empty set;
  let f be PartFunc of X,REAL;
  func R_EAL f -> PartFunc of X,ExtREAL equals

  f;
end;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
of S, f,g be PartFunc of X,ExtREAL st f is nonnegative & g is nonnegative holds
  f+g is nonnegative;

theorem 
  for X be non empty set, f be PartFunc of X,ExtREAL,c be Real st
f is nonnegative holds (0 <= c implies c(#)f is nonnegative) & (c <= 0 implies
  c(#)f is nonpositive);

theorem 
  for X be non empty set, f,g be PartFunc of X,ExtREAL st (for x
  be set st x in dom f /\ dom g holds g.x <= f.x & -infty < g.x & f.x < +infty)
  holds f-g is nonnegative;

theorem 
  for X be non empty set, f,g be PartFunc of X,ExtREAL st f is
  nonnegative & g is nonnegative holds dom(f+g)=dom f /\ dom g & f+g is
  nonnegative;

theorem 
  for X be non empty set, f,g,h be PartFunc of X,ExtREAL st f is
  nonnegative & g is nonnegative & h is nonnegative holds dom(f+g+h) = dom f /\
dom g /\ dom h & f+g+h is nonnegative & for x be set st x in dom f /\ dom g /\
  dom h holds (f+g+h).x=f.x+g.x+h.x;

theorem 
  for X be non empty set, f,g being PartFunc of X,ExtREAL st f is
without-infty & g is without-infty holds dom(max+(f+g) + max- f) = dom f /\ dom
g & dom(max-(f+g) + max+ f) = dom f /\ dom g & dom(max+(f+g) + max- f + max- g)
= dom f /\ dom g & dom(max-(f+g) + max+ f + max+ g) = dom f /\ dom g & max+(f+g
  ) + max-f is nonnegative & max-(f+g) + max+f is nonnegative;

theorem 
  for X being non empty set, f,g being PartFunc of X,ExtREAL st f
is without-infty & f is without+infty & g is without-infty & g is without+infty
  holds max+(f+g) + max- f + max- g = max-(f+g) + max+ f + max+ g;

theorem 
  for C being non empty set, f being PartFunc of C,ExtREAL, c be
  Real st 0 <= c holds max+(c(#)f) = c(#)max+f & max-(c(#)f) = c(#)max-f;

theorem 
  for C being non empty set, f being PartFunc of C,ExtREAL, c be
  Real st 0 <= c holds max+((-c)(#)f) = c(#)max-f & max-((-c)(#)f) = c(#)max+f;

theorem 
  for X be non empty set, f be PartFunc of X,ExtREAL, A be set
  holds max+(f|A)=max+f|A & max-(f|A)=max-f|A;

theorem 
  for X be non empty set, f,g be PartFunc of X,ExtREAL, B be set
  st B c= dom(f+g) holds dom((f+g)|B) =B & dom(f|B+g|B)=B & (f+g)|B = f|B+g|B;

theorem 
  for X be non empty set, f be PartFunc of X,ExtREAL, a be R_eal
  holds eq_dom(f,a) = f"{a};

begin 

theorem 
  for X be non empty set, S be SigmaField of X, f,g be PartFunc of
  X,ExtREAL, A be Element of S st f is without-infty & g is without-infty & f
  is_measurable_on A & g is_measurable_on A holds f+g is_measurable_on A;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure of S,
f be PartFunc of X,ExtREAL st f is_simple_func_in S & dom f = {} holds ex F be
  Finite_Sep_Sequence of S, a,x be FinSequence of ExtREAL st F,a
are_Re-presentation_of f & a.1 = 0 & (for n be Nat st 2 <= n & n in dom a holds
0 < a.n & a.n < +infty) & dom x = dom F & (for n be Nat st n in dom x holds x.n
  = a.n*(M*F).n) & Sum x = 0;

theorem 
  for X be non empty set, S be SigmaField of X, f be PartFunc of X
  ,ExtREAL, A be Element of S, r,s be Real st f is_measurable_on A & A c= dom f
  holds A /\ great_eq_dom(f,R_EAL r) /\ less_dom(f,R_EAL s) in S;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, f be PartFunc of X,ExtREAL, A be Element of S st f is_simple_func_in S
  holds f|A is_simple_func_in S;

theorem 
  for X be non empty set, S be SigmaField of X, A be Element of S,
  F be Finite_Sep_Sequence of S, G be FinSequence st dom F = dom G & (for n be
  Nat st n in dom F holds G.n = F.n /\ A) holds G is Finite_Sep_Sequence of S;

theorem 
  for X be non empty set, S be SigmaField of X, f be PartFunc of X
,ExtREAL, A be Element of S, F,G be Finite_Sep_Sequence of S, a be FinSequence
of ExtREAL st dom F = dom G & (for n be Nat st n in dom F holds G.n = F.n /\ A)
  & F,a are_Re-presentation_of f holds G,a are_Re-presentation_of f|A;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, f be PartFunc of X,ExtREAL st f is_simple_func_in S holds dom f is
  Element of S;

theorem 
  for X be non empty set, S be SigmaField of X, f,g be PartFunc of
  X,ExtREAL st f is_simple_func_in S & g is_simple_func_in S holds f+g
  is_simple_func_in S;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
of S, f be PartFunc of X,ExtREAL,c be Real st f is_simple_func_in S holds c(#)f
  is_simple_func_in S;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, f,g be PartFunc of X,ExtREAL st f is_simple_func_in S & g
is_simple_func_in S & (for x be set st x in dom(f-g) holds g.x <= f.x) holds f-
  g is nonnegative;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
of S, A be Element of S, c be R_eal st c <> +infty & c <> -infty holds ex f be
PartFunc of X,ExtREAL st f is_simple_func_in S & dom f = A & for x be set st x
  in A holds f.x=c;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
of S, f be PartFunc of X,ExtREAL, B,BF be Element of S st f is_measurable_on B
  & BF = dom f /\ B holds f|B is_measurable_on BF;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, A be Element of S, f,g being PartFunc of X,ExtREAL st A c= dom f & f
  is_measurable_on A & g is_measurable_on A & f is without-infty & g is
  without-infty holds max+(f+g) + max-f is_measurable_on A;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
of S, A be Element of S, f,g being PartFunc of X,ExtREAL st A c= dom f /\ dom g
  & f is_measurable_on A & g is_measurable_on A & f is without-infty & g is
  without-infty holds max-(f+g) + max+f is_measurable_on A;

theorem 
  for X be non empty set, S being SigmaField of X, M being
  sigma_Measure of S, A being set st A in S holds 0 <= M.A;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, f,g be PartFunc of X,ExtREAL st (ex E1 be Element of S st E1=dom f & f
is_measurable_on E1) & (ex E2 be Element of S st E2=dom g & g is_measurable_on
  E2) & f"{+infty} in S & f"{-infty} in S & g"{+infty} in S & g"{-infty} in S
  holds dom(f+g) in S;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, f,g be PartFunc of X,ExtREAL st (ex E1 be Element of S st E1=dom f & f
is_measurable_on E1) & (ex E2 be Element of S st E2=dom g & g is_measurable_on
  E2) holds ex E be Element of S st E=dom(f+g) & (f+g) is_measurable_on E;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, f be PartFunc of X,ExtREAL, A,B be Element of S st dom f = A holds f
  is_measurable_on B iff f is_measurable_on (A/\B);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
of S, f be PartFunc of X,ExtREAL st ( ex A be Element of S st dom f = A ) for c
be Real, B be Element of S st f is_measurable_on B holds c(#)f is_measurable_on
  B;

begin 

definition
  mode ExtREAL_sequence is Function of NAT, ExtREAL;
end;

definition
  let seq be ExtREAL_sequence;
  attr seq is convergent_to_finite_number means


  ex g be real number st
for p be real number st 0<p ex n be Nat st for m be Nat st n<=m holds |.seq.m-
  R_EAL(g).| < p;
end;

definition
  let seq be ExtREAL_sequence;
  attr seq is convergent_to_+infty means


  for g be real number st 0 < g
  ex n be Nat st for m be Nat st n<=m holds g <= seq.m;
end;

definition
  let seq be ExtREAL_sequence;
  attr seq is convergent_to_-infty means


  for g be real number st g < 0
  ex n be Nat st for m be Nat st n<=m holds seq.m <= g;
end;

theorem 
  for seq be ExtREAL_sequence st seq is convergent_to_+infty holds
  not seq is convergent_to_-infty & not seq is convergent_to_finite_number;

theorem 
  for seq be ExtREAL_sequence st seq is convergent_to_-infty holds
  not seq is convergent_to_+infty & not seq is convergent_to_finite_number;

definition
  let seq be ExtREAL_sequence;
  attr seq is convergent means


  seq is convergent_to_finite_number or
  seq is convergent_to_+infty or seq is convergent_to_-infty;
end;

definition
  let seq be ExtREAL_sequence;
  assume
 seq is convergent;
  func lim seq -> R_eal means


  ( ex g be real number st it = g & (for p
be real number st 0<p ex n be Nat st for m be Nat st n<=m holds |.seq.m-it.| <
  p) & seq is convergent_to_finite_number ) or it=+infty & seq is
  convergent_to_+infty or it=-infty & seq is convergent_to_-infty;
end;

theorem 
  for seq be ExtREAL_sequence, r be real number st (for n be Nat
  holds seq.n = r) holds seq is convergent_to_finite_number & lim seq = r;

theorem 
  for F be FinSequence of ExtREAL st (for n be Nat st n in dom F
  holds 0 <= F.n) holds 0 <= Sum F;

theorem 
  for L be ExtREAL_sequence st (for n,m be Nat st n <=m holds L.n
  <= L.m) holds L is convergent & lim L = sup rng L;

theorem 
  for L,G be ExtREAL_sequence st (for n be Nat holds L.n <= G.n)
  holds sup rng L <= sup rng G;

theorem 
  for L be ExtREAL_sequence holds for n be Nat holds L.n <= sup rng L;

theorem 
  for L be ExtREAL_sequence, K be R_eal st (for n be Nat holds L.n
  <= K) holds sup rng L <= K;

theorem 
  for L be ExtREAL_sequence, K be R_eal st K <> +infty & (for n be Nat
  holds L.n <= K) holds sup rng L < +infty;

theorem 
  for L be ExtREAL_sequence st L is without-infty holds sup rng L
  <> +infty iff ex K be real number st 0 <K & for n be Nat holds L.n <= K;

theorem 
  for L be ExtREAL_sequence,c be ext-real number st (for n be Nat
  holds L.n=c) holds L is convergent & lim L = c & lim L = sup rng L;

theorem 
  for J,K,L be ExtREAL_sequence st (for n,m be Nat st n <=m holds
J.n <= J.m) & (for n,m be Nat st n <=m holds K.n <= K.m) & J is without-infty &
K is without-infty & (for n be Nat holds J.n+K.n =L.n ) holds L is convergent &
  lim L= sup rng L & lim L = lim J + lim K & sup rng L = sup rng K + sup rng J;

theorem 
  for L,K be ExtREAL_sequence,c be Real st 0 <= c & L is
  without-infty & (for n be Nat holds K.n = R_EAL c * L.n ) holds sup rng K =
  R_EAL c * sup rng L & K is without-infty;

theorem 
  for L,K be ExtREAL_sequence, c be Real st 0 <=c & (for n,m be
  Nat st n <=m holds L.n <= L.m) & (for n be Nat holds K.n = R_EAL c * L.n) & L
  is without-infty holds (for n,m be Nat st n <=m holds K.n <= K.m) & K is
  without-infty & K is convergent & lim K = sup rng K & lim K = R_EAL c * lim L
;

begin 

definition
  let X be non empty set, H be Functional_Sequence of X,ExtREAL, x be Element
  of X;
  func H#x -> ExtREAL_sequence means


  for n be Nat holds it.n = (H.n).x;
end;

definition
  let D1,D2 be set, F be Function of NAT,PFuncs(D1,D2), n be Nat;
  redefine func F.n -> PartFunc of D1,D2;
end;

theorem 
  for X be non empty set, S be SigmaField of X, f be PartFunc of X
  ,ExtREAL st (ex A be Element of S st A = dom f & f is_measurable_on A) & f is
  nonnegative holds ex F be Functional_Sequence of X,ExtREAL st (for n be Nat
holds F.n is_simple_func_in S & dom(F.n) = dom f) & (for n be Nat holds F.n is
nonnegative) & (for n,m be Nat st n <=m holds for x be Element of X st x in dom
f holds (F.n).x <= (F.m).x ) & for x be Element of X st x in dom f holds (F#x)
  is convergent & lim(F#x) = f.x;

begin 

definition
  let X be non empty set;
  let S be SigmaField of X;
  let M be sigma_Measure of S;
  let f be PartFunc of X,ExtREAL;
  func integral'(M,f) -> Element of ExtREAL equals


  integral(X,S,M,f)
  if dom f <> {} otherwise 0.;
end;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, f,g be PartFunc of X,ExtREAL st f is_simple_func_in S & g
is_simple_func_in S & f is nonnegative & g is nonnegative holds dom(f+g) = dom
f /\ dom g & integral'(M,f+g) = integral'(M,f|dom(f+g)) + integral'(M,g|dom(f+g
  ));

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, f be PartFunc of X,ExtREAL,c be Real st f is_simple_func_in S & f is
  nonnegative & 0 <= c holds integral'(M,c(#)f) = R_EAL(c)*integral'(M,f);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
of S, f be PartFunc of X,ExtREAL, A,B be Element of S st f is_simple_func_in S
& f is nonnegative & A misses B holds integral'(M,f|(A\/B)) = integral'(M,f|A)
  + integral'(M,f|B);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, f be PartFunc of X,ExtREAL st f is_simple_func_in S & f is nonnegative
  holds 0 <= integral'(M,f);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
of S, f,g be PartFunc of X,ExtREAL st f is_simple_func_in S & f is nonnegative
  & g is_simple_func_in S & g is nonnegative & (for x be set st x in dom(f-g)
  holds g.x <= f.x) holds dom (f-g) = dom f /\ dom g & integral'(M,f|dom(f-g))=
  integral'(M,f-g)+integral'(M,g|dom(f-g));

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, f,g be PartFunc of X,ExtREAL st f is_simple_func_in S & g
is_simple_func_in S & f is nonnegative & g is nonnegative & (for x be set st x
  in dom(f-g) holds g.x <= f.x) holds integral'(M,g|dom(f-g)) <= integral'(M,f|
  dom(f-g));

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
of S, f be PartFunc of X,ExtREAL, c be R_eal st 0 <= c & f is_simple_func_in S
& (for x be set st x in dom f holds f.x=c) holds integral'(M,f) = c*(M.(dom f))
;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, f be PartFunc of X,ExtREAL st f is_simple_func_in S & f is nonnegative
  holds integral'(M,f|eq_dom(f,R_EAL 0)) = 0;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
of S, B be Element of S, f be PartFunc of X,ExtREAL st f is_simple_func_in S &
  M.B=0 & f is nonnegative holds integral'(M,f|B) = 0;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, g be PartFunc of X,ExtREAL, F be Functional_Sequence of X,ExtREAL, L be
ExtREAL_sequence st g is_simple_func_in S & (for x be set st x in dom g holds 0
< g.x) & (for n be Nat holds F.n is_simple_func_in S) & (for n be Nat holds dom
(F.n) = dom g) & (for n be Nat holds F.n is nonnegative) & (for n,m be Nat st n
<=m holds for x be Element of X st x in dom g holds (F.n).x <= (F.m).x ) & (for
x be Element of X st x in dom g holds (F#x) is convergent & g.x <= lim(F#x) ) &
(for n be Nat holds L.n = integral'(M,F.n)) holds L is convergent & integral'(M
  ,g) <= lim(L);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, g be PartFunc of X,ExtREAL, F be Functional_Sequence of X,ExtREAL st g
  is_simple_func_in S & g is nonnegative & (for n be Nat holds F.n
  is_simple_func_in S) & (for n be Nat holds dom(F.n) = dom g) & (for n be Nat
holds F.n is nonnegative) & (for n,m be Nat st n <=m holds for x be Element of
X st x in dom g holds (F.n).x <= (F.m).x ) & (for x be Element of X st x in dom
g holds (F#x) is convergent & g.x <= lim(F#x) ) holds ex G be ExtREAL_sequence
st (for n be Nat holds G.n = integral'(M,F.n)) & G is convergent & sup(rng G)=
  lim (G) & integral'(M,g) <= lim(G);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, A be Element of S, F,G be Functional_Sequence of X,ExtREAL, K,L be
ExtREAL_sequence st (for n be Nat holds F.n is_simple_func_in S & dom(F.n)=A )
& (for n be Nat holds F.n is nonnegative) & (for n,m be Nat st n <=m holds for
x be Element of X st x in A holds (F.n).x <= (F.m).x ) & (for n be Nat holds G.
n is_simple_func_in S & dom(G.n)=A) & (for n be Nat holds G.n is nonnegative) &
(for n,m be Nat st n <=m holds for x be Element of X st x in A holds (G.n).x <=
  (G.m).x ) & (for x be Element of X st x in A holds F#x is convergent & G#x is
convergent & lim(F#x) = lim(G#x)) & (for n be Nat holds K.n=integral'(M,F.n) &
  L.n=integral'(M,G.n)) holds K is convergent & L is convergent & lim K = lim L
;

definition
  let X be non empty set;
  let S be SigmaField of X;
  let M be sigma_Measure of S;
  let f be PartFunc of X,ExtREAL;
  assume that
 ex A be Element of S st A = dom f & f is_measurable_on A and
 f is nonnegative;
  func integral+(M,f) -> Element of ExtREAL means


  ex F be
Functional_Sequence of X,ExtREAL, K be ExtREAL_sequence st (for n be Nat holds
  F.n is_simple_func_in S & dom(F.n) = dom f) & (for n be Nat holds F.n is
nonnegative) & (for n,m be Nat st n <=m holds for x be Element of X st x in dom
  f holds (F.n).x <= (F.m).x ) & (for x be Element of X st x in dom f holds F#x
is convergent & lim(F#x) = f.x) & (for n be Nat holds K.n=integral'(M,F.n)) & K
  is convergent & it=lim K;
end;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, f be PartFunc of X,ExtREAL st f is_simple_func_in S & f is nonnegative
  holds integral+(M,f) =integral'(M,f);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, f,g be PartFunc of X,ExtREAL st ( ex A be Element of S st A = dom f & f
is_measurable_on A ) & ( ex B be Element of S st B = dom g & g is_measurable_on
B ) & f is nonnegative & g is nonnegative holds ex C be Element of S st C = dom
  (f+g) & integral+(M,f+g) = integral+(M,f|C) + integral+(M,g|C);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, f be PartFunc of X,ExtREAL st (ex A be Element of S st A = dom f & f
  is_measurable_on A) & f is nonnegative holds 0 <= integral+(M,f);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
of S, f be PartFunc of X,ExtREAL, A be Element of S st (ex E be Element of S st
E = dom f & f is_measurable_on E ) & f is nonnegative holds 0<= integral+(M,f|A
  );

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
of S, f be PartFunc of X,ExtREAL, A,B be Element of S st (ex E be Element of S
  st E = dom f & f is_measurable_on E) & f is nonnegative & A misses B holds
  integral+(M,f|(A\/B)) = integral+(M,f|A)+integral+(M,f|B);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
of S, f be PartFunc of X,ExtREAL, A be Element of S st (ex E be Element of S st
E = dom f & f is_measurable_on E ) & f is nonnegative & M.A = 0 holds integral+
  (M,f|A) = 0;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
of S, f be PartFunc of X,ExtREAL, A,B be Element of S st (ex E be Element of S
  st E = dom f & f is_measurable_on E ) & f is nonnegative & A c= B holds
  integral+(M,f|A) <= integral+(M,f|B);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
of S, f be PartFunc of X,ExtREAL, E,A be Element of S st f is nonnegative & E =
dom f & f is_measurable_on E & M.A =0 holds integral+(M,f|(E\A)) = integral+(M,
  f);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, f,g be PartFunc of X,ExtREAL st (ex E be Element of S st E = dom f & E=
dom g & f is_measurable_on E & g is_measurable_on E) & f is nonnegative & g is
  nonnegative & (for x be Element of X st x in dom g holds g.x <= f.x) holds
  integral+(M,g) <= integral+(M,f);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, f be PartFunc of X,ExtREAL, c be Real st 0 <= c & (ex A be Element of S
st A = dom f & f is_measurable_on A) & f is nonnegative holds integral+(M,c(#)f
  ) = R_EAL c * integral+(M,f);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, f be PartFunc of X,ExtREAL st (ex A be Element of S st A = dom f & f
is_measurable_on A) & (for x be Element of X st x in dom f holds 0= f.x) holds
  integral+(M,f) = 0;

begin 

definition
  let X be non empty set;
  let S be SigmaField of X;
  let M be sigma_Measure of S;
  let f be PartFunc of X,ExtREAL;


  func Integral(M,f) -> Element of ExtREAL equals

  integral+(M,max+f)-integral+
  (M,max-f);
end;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, f be PartFunc of X,ExtREAL st (ex A be Element of S st A = dom f & f
  is_measurable_on A) & f is nonnegative holds Integral(M,f) =integral+(M,f);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure of S,
  f be PartFunc of X,ExtREAL st f is_simple_func_in S & f is nonnegative holds
  Integral(M,f) = integral+(M,f) & Integral(M,f) = integral'(M,f);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure of S,
  f be PartFunc of X,ExtREAL st (ex A be Element of S st A = dom f & f
  is_measurable_on A) & f is nonnegative holds 0 <= Integral(M,f);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure of S,
f be PartFunc of X,ExtREAL, A,B be Element of S st (ex E be Element of S st E =
dom f & f is_measurable_on E ) & f is nonnegative & A misses B holds Integral(M
  ,f|(A\/B)) = Integral(M,f|A)+Integral(M,f|B);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure of S,
  f be PartFunc of X,ExtREAL, A be Element of S st (ex E be Element of S st E =
  dom f & f is_measurable_on E ) & f is nonnegative holds 0<= Integral(M,f|A);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure of S,
f be PartFunc of X,ExtREAL, A,B be Element of S st (ex E be Element of S st E =
dom f & f is_measurable_on E ) & f is nonnegative & A c= B holds Integral(M,f|A
  ) <= Integral(M,f|B);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure of S,
  f be PartFunc of X,ExtREAL, A be Element of S st (ex E be Element of S st E =
  dom f & f is_measurable_on E) & M.A = 0 holds Integral(M,f|A)=0;

theorem 
  for X be non empty set, S be SigmaField of X, M be
sigma_Measure of S, f be PartFunc of X,ExtREAL, E,A be Element of S st E = dom
  f & f is_measurable_on E & M.A =0 holds Integral(M,f|(E\A)) = Integral(M,f);

definition
  let X be non empty set;
  let S be SigmaField of X;
  let M be sigma_Measure of S;
  let f be PartFunc of X,ExtREAL;
  pred f is_integrable_on M means


  (ex A be Element of S st A = dom f &
  f is_measurable_on A ) & integral+(M,max+ f) < +infty & integral+(M,max- f) <
  +infty;
end;

theorem 
  for X be non empty set, S be SigmaField of X, M be
sigma_Measure of S, f be PartFunc of X,ExtREAL st f is_integrable_on M holds 0
  <= integral+(M,max+f) & 0 <= integral+(M,max-f) & -infty < Integral(M,f) &
  Integral(M,f) < +infty;

theorem 
  for X be non empty set, S be SigmaField of X, M be
  sigma_Measure of S, f be PartFunc of X,ExtREAL, A be Element of S st f
  is_integrable_on M holds integral+(M,max+(f|A)) <= integral+(M,max+ f) &
  integral+(M,max-(f|A)) <= integral+(M,max- f) & f|A is_integrable_on M;

theorem 
  for X be non empty set, S be SigmaField of X, M be
  sigma_Measure of S, f be PartFunc of X,ExtREAL, A,B be Element of S st f
is_integrable_on M & A misses B holds Integral(M,f|(A\/B)) = Integral(M,f|A) +
  Integral(M,f|B);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure of S,
f be PartFunc of X,ExtREAL, A,B be Element of S st f is_integrable_on M & B = (
  dom f)\A holds f|A is_integrable_on M & Integral(M,f) = Integral(M,f|A)+
  Integral(M,f|B);

theorem 
  for X be non empty set, S be SigmaField of X, M be
sigma_Measure of S, f be PartFunc of X,ExtREAL st (ex A be Element of S st A =
  dom f & f is_measurable_on A ) holds f is_integrable_on M iff |.f.|
  is_integrable_on M;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure of S,
f be PartFunc of X,ExtREAL st f is_integrable_on M holds |. Integral(M,f) .| <=
  Integral(M,|.f.|);

theorem 
  for X be non empty set, S be SigmaField of X, M be
sigma_Measure of S, f,g be PartFunc of X,ExtREAL st ( ex A be Element of S st A
= dom f & f is_measurable_on A ) & dom f = dom g & g is_integrable_on M & ( for
  x be Element of X st x in dom f holds |.f.x .| <= g.x ) holds f
  is_integrable_on M & Integral(M,|.f.|) <= Integral(M,g);

theorem 
  for X be non empty set, S be SigmaField of X, M be
sigma_Measure of S, f be PartFunc of X,ExtREAL, r be Real st dom f in S & 0 <=
r & dom f <> {} & (for x be set st x in dom f holds f.x = r) holds integral(X,S
  ,M,f) = r * M.(dom f);

theorem 
  for X be non empty set, S be SigmaField of X, M be
sigma_Measure of S, f be PartFunc of X,ExtREAL, r be Real st dom f in S & 0 <=
r & (for x be set st x in dom f holds f.x = r) holds integral'(M,f) = R_EAL(r)
  * M.(dom f);

theorem 
  for X be non empty set, S be SigmaField of X, M be
sigma_Measure of S, f be PartFunc of X,ExtREAL st f is_integrable_on M holds f"
  {+infty} in S & f"{-infty} in S & M.(f"{+infty})=0 & M.(f"{-infty})=0 & f"{
  +infty} \/ f"{-infty} in S & M.(f"{+infty} \/ f"{-infty})=0;

theorem 
  for X be non empty set, S be SigmaField of X, M be
  sigma_Measure of S, f,g be PartFunc of X,ExtREAL st f is_integrable_on M & g
  is_integrable_on M & f is nonnegative & g is nonnegative holds f+g
  is_integrable_on M;

theorem 
  for X be non empty set, S be SigmaField of X, M be
  sigma_Measure of S, f,g be PartFunc of X,ExtREAL st f is_integrable_on M & g
  is_integrable_on M holds dom (f+g) in S;

theorem 
  for X be non empty set, S be SigmaField of X, M be
  sigma_Measure of S, f,g be PartFunc of X,ExtREAL st f is_integrable_on M & g
  is_integrable_on M holds f+g is_integrable_on M;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure of S,
  f,g be PartFunc of X,ExtREAL st f is_integrable_on M & g is_integrable_on M
holds ex E be Element of S st E = dom f /\ dom g & Integral(M,f+g)=Integral(M,f
  |E)+Integral(M,g|E);

theorem 
  for X be non empty set, S be SigmaField of X, M be
sigma_Measure of S, f be PartFunc of X,ExtREAL, c be Real st f is_integrable_on
M holds c(#)f is_integrable_on M & Integral(M,c(#)f) = R_EAL c * Integral(M,f);

definition
  let X be non empty set;
  let S be SigmaField of X;
  let M be sigma_Measure of S;
  let f be PartFunc of X,ExtREAL;
  let B be Element of S;
  func Integral_on(M,B,f) -> Element of ExtREAL equals

  Integral(M,f|B);
end;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure of S,
  f,g be PartFunc of X,ExtREAL, B be Element of S st f is_integrable_on M & g
is_integrable_on M & B c= dom(f+g) holds f+g is_integrable_on M & Integral_on(M
  ,B,f+g) = Integral_on(M,B,f) + Integral_on(M,B,g);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure of S,
f be PartFunc of X,ExtREAL, c be Real, B be Element of S st f is_integrable_on
M holds f|B is_integrable_on M & Integral_on(M,B,c(#)f) = R_EAL c * Integral_on
  (M,B,f);














begin

reserve h,r,r1,r2,x0,x1,x2,x3,x4,x5,x,a,b,c,k for Real,
  f,f1,f2 for Function of REAL,REAL;

theorem 
  [!f,x,x+h!] = (fdif(f,h).1.x)/h;

theorem 
  h<>0 implies [!f,x,x+h,x+2*h!] = (fdif(f,h).2.x)/(2*h^2);

theorem 
  [!f,x-h,x!] = (bdif(f,h).1.x)/h;

theorem 
  h<>0 implies [!f,x-2*h,x-h,x!] = (bdif(f,h).2.x)/(2*h^2);

theorem 
  [!(r(#)f),x0,x1,x2!] = r*[!f,x0,x1,x2!];

theorem 
  [!(f1+f2),x0,x1,x2!] = [!f1,x0,x1,x2!]+[!f2,x0,x1,x2!];

theorem 
  [!(r1(#)f1+r2(#)f2),x0,x1,x2!] = r1*[!f1,x0,x1,x2!]+r2*[!f2,x0,x1,x2!];

theorem 
  [!(r(#)f),x0,x1,x2,x3!] = r*[!f,x0,x1,x2,x3!];

theorem 
  [!(f1+f2),x0,x1,x2,x3!]=[!f1,x0,x1,x2,x3!]+[!f2,x0,x1,x2,x3!];

theorem 
  [!(r1(#)f1+r2(#)f2),x0,x1,x2,x3!] = r1*[!f1,x0,x1,x2,x3!]+r2*[!f2,x0,
  x1,x2,x3!];

definition 
  let f be real-valued Function;
  let x0,x1,x2,x3,x4 be real number;
  func [!f,x0,x1,x2,x3,x4!] -> Real equals

  ([!f,x0,x1,x2,x3!] - [!f,x1,x2,x3,
  x4!])/(x0-x4);
end;

theorem 
  [!(r(#)f),x0,x1,x2,x3,x4!] = r*[!f,x0,x1,x2,x3,x4!];

theorem 
  [!(f1+f2),x0,x1,x2,x3,x4!] = [!f1,x0,x1,x2,x3,x4!]+[!f2,x0,x1,x2 ,x3,x4!];

theorem 
  [!(r1(#)f1+r2(#)f2),x0,x1,x2,x3,x4!] = r1*[!f1,x0,x1,x2,x3,x4!]+r2*[!
  f2,x0,x1,x2,x3,x4!];

definition 
  let f be real-valued Function;
  let x0,x1,x2,x3,x4,x5 be real number;
  func [!f,x0,x1,x2,x3,x4,x5!] -> Real equals

  ([!f,x0,x1,x2,x3,x4!] - [!f,x1,
  x2,x3,x4,x5!])/(x0-x5);
end;

theorem 
  [!(r(#)f),x0,x1,x2,x3,x4,x5!] = r*[!f,x0,x1,x2,x3,x4,x5!];

theorem 
  [!(f1+f2),x0,x1,x2,x3,x4,x5!] =[!f1,x0,x1,x2,x3,x4,x5!]+[!f2,x0,
  x1,x2,x3,x4,x5!];

theorem 
  [!(r1(#)f1+r2(#)f2),x0,x1,x2,x3,x4,x5!] = r1*[!f1,x0,x1,x2,x3,x4,x5!]+
  r2*[!f2,x0,x1,x2,x3,x4,x5!];

theorem 
  x0,x1,x2 are_mutually_different implies [!f,x0,x1,x2!] = f.x0/((x0-x1)
  *(x0-x2))+f.x1/((x1-x0)*(x1-x2))+f.x2/((x2-x0)*(x2-x1));

theorem 
  x0,x1,x2,x3 are_mutually_different implies [!f,x0,x1,x2,x3!] = [!f,x1,
  x2,x3,x0!] & [!f,x0,x1,x2,x3!] = [!f,x3,x2,x1,x0!];

theorem 
  x0,x1,x2,x3 are_mutually_different implies [!f,x0,x1,x2,x3!] = [!f,x1,
  x0,x2,x3!] & [!f,x0,x1,x2,x3!] = [!f,x1,x2,x0,x3!];

theorem 
  f is constant implies [!f,x0,x1,x2!] = 0;



theorem 
  x0<>x1 implies [!AffineMap(a,b),x0,x1!] = a;

theorem 
  x0,x1,x2 are_mutually_different implies [!AffineMap(a,b),x0,x1, x2!]=0;

theorem 
  x0,x1,x2,x3 are_mutually_different implies [!AffineMap(a,b),x0,x1,x2, x3!]=0;

theorem 
  for x holds fD(AffineMap(a,b),h).x = a*h;

theorem 
  for x holds bD(AffineMap(a,b),h).x = a*h;

theorem 
  for x holds cD(AffineMap(a,b),h).x = a*h;



theorem 
  (for x holds f.x = a*x^2+b*x+c) & x0<>x1 implies [!f,x0,x1!]=a*( x0+x1)+b;

theorem 
  (for x holds f.x = a*x^2+b*x+c) & x0,x1,x2
  are_mutually_different implies [!f,x0,x1,x2!]=a;

theorem 
  (for x holds f.x = a*x^2+b*x+c) & x0,x1,x2,x3
  are_mutually_different implies [!f,x0,x1,x2,x3!]=0;

theorem 
  (for x holds f.x = a*x^2+b*x+c) & x0,x1,x2,x3,x4
  are_mutually_different implies [!f,x0,x1,x2,x3,x4!] = 0;

theorem 
  (for x holds f.x = a*x^2+b*x+c) implies for x holds fD(f,h).x = 2*a*h*
  x+a*h^2+b*h;

theorem 
  (for x holds f.x = a*x^2+b*x+c) implies for x holds bD(f,h).x = 2*a*h*
  x-a*h^2+b*h;

theorem 
  (for x holds f.x = a*x^2+b*x+c) implies for x holds cD(f,h).x = 2*a*h* x+b*h;



theorem 
  (for x holds f.x = k/x) & x0<>x1 & x0<>0 & x1<>0 implies [!f,x0,
  x1!] = - k/(x0*x1);

theorem 
  (for x holds f.x = k/x) & x0<>0 & x1<>0 & x2<>0 & x0,x1,x2
  are_mutually_different implies [!f,x0,x1,x2!] = k/(x0*x1*x2);

theorem 
  (for x holds f.x = k/x) & x0<>0 & x1<>0 & x2<>0 & x3<>0 & x0,x1,
  x2,x3 are_mutually_different implies [!f,x0,x1,x2,x3!]=-k/(x0*x1*x2*x3);

theorem 
  (for x holds f.x = k/x) & x0<>0 & x1<>0 & x2<>0 & x3<>0 & x4<>0 & x0,
x1,x2,x3,x4 are_mutually_different implies [!f,x0,x1,x2,x3,x4!] = k/(x0*x1*x2*
  x3*x4);

theorem 
  (for x holds f.x = k/x & x<>0 & x+h<>0) implies for x holds fD(f,h).x
  = (-k*h)/((x+h)*x);

theorem 
  (for x holds f.x = k/x & x<>0 & x-h<>0) implies for x holds bD(f,h).x
  = (-k*h)/((x-h)*x);

theorem 
  (for x holds f.x = k/x & x+h/2<>0 & x-h/2<>0) implies for x holds cD(f
  ,h).x = (-k*h)/((x-h/2)*(x+h/2));



theorem 
  [!sin,x0,x1!] = 2*cos((x0+x1)/2)*sin((x0-x1)/2)/(x0-x1);

theorem 
  for x holds fD(sin,h).x = 2*(cos((2*x+h)/2)*sin(h/2));

theorem 
  for x holds bD(sin,h).x = 2*(cos((2*x-h)/2)*sin(h/2));

theorem 
  for x holds cD(sin,h).x = 2*(cos(x)*sin(h/2));



theorem 
  [!cos,x0,x1!] = -2*sin((x0+x1)/2)*sin((x0-x1)/2)/(x0-x1);

theorem 
  for x holds fD(cos,h).x = -2*(sin((2*x+h)/2)*sin(h/2));

theorem 
  for x holds bD(cos,h).x = -2*(sin((2*x-h)/2)*sin(h/2));

theorem 
  for x holds cD(cos,h).x = -2*(sin(x)*sin(h/2));



theorem 
  [!sin(#)sin,x0,x1!] = (1/2)*(cos(2*x1)-cos(2*x0))/(x0-x1);

theorem 
  for x holds fD(sin(#)sin,h).x = (1/2)*(cos(2*x)-cos(2*(x+h)));

theorem 
  for x holds bD(sin(#)sin,h).x = (1/2)*(cos(2*(x-h))-cos(2*x));

theorem 
  for x holds cD(sin(#)sin,h).x = (1/2)*(cos(2*x-h)-cos(2*x+h));



theorem 
  [!sin(#)cos,x0,x1!] = (1/2)*(sin(2*x0)-sin(2*x1))/(x0-x1);

theorem 
  for x holds fD(sin(#)cos,h).x = (1/2)*(sin(2*(x+h))-sin(2*x));

theorem 
  for x holds bD(sin(#)cos,h).x = (1/2)*(sin(2*x)-sin(2*(x-h)));

theorem 
  for x holds cD(sin(#)cos,h).x = (1/2)*(sin(2*x+h)-sin(2*x-h));



theorem 
  [!cos(#)cos,x0,x1!] = (1/2)*(cos(2*x0)-cos(2*x1))/(x0-x1);

theorem 
  for x holds fD(cos(#)cos,h).x = (1/2)*(cos(2*(x+h))-cos(2*x));

theorem 
  for x holds bD(cos(#)cos,h).x = (1/2)*(cos(2*x)-cos(2*(x-h)));

theorem 
  for x holds cD(cos(#)cos,h).x = (1/2)*(cos(2*x+h)-cos(2*x-h));



theorem 
  [!sin(#)sin(#)cos,x0,x1!] = -(1/2)*(sin(3*(x1+x0)/2)*sin(3*(x1-x0)/2)
  +sin((x0+x1)/2)*sin((x0-x1)/2))/(x0-x1);

theorem 
  for x holds fD(sin(#)sin(#)cos,h).x =(1/2)*(sin((6*x+3*h)/2)*sin(3*h/2
  )-sin((2*x+h)/2)*sin(h/2));

theorem 
  for x holds bD(sin(#)sin(#)cos,h).x = (1/2)*(sin((6*x-3*h)/2)*sin(3*h/
  2))-(1/2)*(sin((2*x-h)/2)*sin(h/2));

theorem 
  for x holds cD(sin(#)sin(#)cos,h).x = -(1/2)*(sin(x)*sin(h/2))+(1/2)*(
  sin(3*x)*sin(3*h/2));



theorem 
  [!sin(#)cos(#)cos,x0,x1!] = (1/2)*(cos((x0+x1)/2)*sin((x0-x1)/2) +cos(
  3*(x0+x1)/2)*sin(3*(x0-x1)/2))/(x0-x1);

theorem 
  for x holds fD(sin(#)cos(#)cos,h).x = (1/2)*(cos((2*x+h)/2)*sin(h/2)+
  cos((6*x+3*h)/2)*sin(3*h/2));

theorem 
  for x holds bD(sin(#)cos(#)cos,h).x = (1/2)*(cos((2*x-h)/2)*sin(h/2)+
  cos((6*x-3*h)/2)*sin(3*h/2));

theorem 
  for x holds cD(sin(#)cos(#)cos,h).x = (1/2)*(cos(x)*sin(h/2)+cos(3*x)*
  sin(3*h/2));



theorem 
  x0 in dom tan & x1 in dom tan implies [!tan,x0,x1!]=sin(x0-x1)/(cos(x0
  )*cos(x1)*(x0-x1));



theorem 
  x0 in dom cot & x1 in dom cot implies [!cot,x0,x1!] = - sin(x0-x1)/(
  sin(x0)*sin(x1)*(x0-x1));



theorem 
  x0 in dom cosec & x1 in dom cosec implies [!cosec,x0,x1!] = 2*cos((x1+
  x0)/2)*sin((x1-x0)/2) /(sin(x1)*sin(x0)*(x0-x1));



theorem 
  x0 in dom sec & x1 in dom sec implies [!sec,x0,x1!] = -2*sin((x1+x0)/2
  ) *sin((x1-x0)/2)/(cos(x1)*cos(x0)*(x0-x1));














begin

registration
  let f be complex-valued FinSequence, n be Nat;
  cluster f|n -> complex-valued;
end;

registration
  let f be INT-valued FinSequence, n be Nat;
  cluster f|n -> INT-valued;
end;

registration
  let f be INT-valued FinSequence, n be Nat;
  cluster f/^n -> INT-valued;
end;

registration
  let i be Integer;
  cluster <*i*> -> INT-valued;
end;

registration
  let f,g be INT-valued FinSequence;
  cluster f ^ g -> INT-valued;
end;

theorem 
  for f1,f2 being complex-valued FinSequence holds len(f1 + f2) =
  min(len f1, len f2);

theorem 
  for f1, f2 being complex-valued FinSequence holds len(f1 - f2) =
  min(len f1, len f2);

theorem 
  for f1,f2 being complex-valued FinSequence holds len(f1 (#) f2) =
  min(len f1, len f2);

theorem 
  for m1,m2 being complex-valued FinSequence st len m1 = len m2 for
  k being Nat st k <= len m1 holds (m1(#)m2)|k = (m1|k) (#) (m2|k);

registration
  let F be INT-valued FinSequence;
  cluster Sum F -> integer;
  cluster Product F -> integer;
end;

theorem 
  for f being complex-valued FinSequence, i being Nat st
  i+1 <= len f holds f|i ^ <*f.(i+1)*> = f|(i+1);

theorem 
  for f being complex-valued FinSequence st ex i being Nat
  st i in dom f & f.i = 0 holds Product(f) = 0;

theorem 
  for n,a,b being Integer holds (a - b) mod n = ((a mod n) - (b mod n)) mod n;

theorem 
  for i,j,k being Integer st i divides j holds k*i divides k*j;

theorem 
  for m being INT-valued FinSequence, i being Nat st
  i in dom m & m.i <> 0 holds Product(m) / m.i is Integer;

theorem 
  for m being INT-valued FinSequence, i being Nat
  st i in dom m ex z being Integer st z * m.i = Product(m);

theorem 
  for m being INT-valued FinSequence, i,j being Nat st i
  in dom m & j in dom m & j <> i & m.j <> 0 holds Product(m) / (m.i * m.j) is
  Integer;

theorem 
  for m being INT-valued FinSequence, i,j being Nat st i
  in dom m & j in dom m & j <> i & m.j <> 0 ex z being Integer st z * m.i =
  Product(m) / m.j;

begin  

theorem 
  for i being Integer holds abs(i) divides i & i divides abs(i);

theorem 
  for i,j being Integer holds i gcd j = i gcd abs(j);

theorem 
  for i,j being Integer st i,j are_relative_prime holds i lcm j = abs(i * j);

theorem 
  for i,j,k being Integer holds (i*j) gcd (i*k) = abs(i) * (j gcd k);

theorem 
  for i,j being Integer holds (i * j) gcd i = abs(i);

theorem 
  for i,j,k being Integer holds i gcd (j gcd k) = (i gcd j) gcd k;

theorem 
  for i,j,k being Integer st i,j are_relative_prime holds i gcd (j
  * k) = i gcd k;

theorem 
  for i,j being Integer st i,j are_relative_prime holds i * j divides i lcm j;

theorem 
  for x,y,i,j being Integer st i,j are_relative_prime holds x,y
are_congruent_mod i & x,y are_congruent_mod j implies x,y are_congruent_mod i*j
;

theorem 
  for i,j being Integer st i,j are_relative_prime holds ex s being
  Integer st s*i,1 are_congruent_mod j;

begin  

notation
  let f be INT-valued FinSequence;
  antonym f is multiplicative-trivial for f is non-empty;
end;

definition
  let f be INT-valued FinSequence;
  redefine attr f is multiplicative-trivial means


  ex i being Nat st i in dom f & f.i = 0;
end;

registration
  cluster multiplicative-trivial for INT-valued FinSequence;
  cluster non multiplicative-trivial for INT-valued FinSequence;
  cluster non empty positive-yielding for INT-valued FinSequence;
end;

theorem 
  for m being multiplicative-trivial INT-valued FinSequence holds
  Product(m) = 0;

definition
  let f be INT-valued FinSequence;
  attr f is Chinese_Remainder means


  for i,j being Nat st i
  in dom f & j in dom f & i <> j holds f.i, f.j are_relative_prime;
end;

registration
  cluster non empty positive-yielding Chinese_Remainder for INT-valued
    FinSequence;
end;

definition
  mode CR_Sequence is non empty positive-yielding Chinese_Remainder
    INT-valued FinSequence;
end;

registration
  cluster -> non multiplicative-trivial for CR_Sequence;
end;

registration
  cluster multiplicative-trivial -> non empty for INT-valued FinSequence;
end;

theorem 
  for f being CR_Sequence, m being Nat st 0 < m & m <=
  len f holds f|m is CR_Sequence;

registration
  let m be CR_Sequence;
  cluster Product(m) -> positive natural;
end;

theorem 
  for m being CR_Sequence, i being Nat st i in dom m
for mm being Integer st mm = Product(m) / m.i holds mm, m.i are_relative_prime;

begin  

definition
  let u be Integer, m be INT-valued FinSequence;
  func mod(u,m) -> FinSequence means


  len it = len m & for i being
  Nat st i in dom it holds it.i = u mod m.i;
end;

registration
  let u be Integer, m be INT-valued FinSequence;
  cluster mod(u,m) -> INT-valued;
end;

definition
  let m be CR_Sequence;
  mode CR_coefficients of m -> FinSequence means


    len it = len m & for i
being Nat st i in dom it holds ex s being Integer, mm being Integer
    st mm = Product(m) / m.i & s * mm, 1 are_congruent_mod m.i & it.i = s * (
    Product(m) / m.i);
end;

registration
  let m be CR_Sequence;
  cluster -> INT-valued for CR_coefficients of m;
end;

theorem 
  for m being CR_Sequence, c being CR_coefficients of m, i being
  Nat st i in dom c holds c.i,1 are_congruent_mod m.i;

theorem 
  for m being CR_Sequence, c being CR_coefficients of m, i,j being
  Nat st i in dom c & j in dom c & i <> j holds c.i,0
  are_congruent_mod m.j;

theorem 
  for m being CR_Sequence, c1,c2 being CR_coefficients of m, i being
  Nat st i in dom c1 holds c1.i,c2.i are_congruent_mod m.i;

theorem 
  for u being INT-valued FinSequence, m being CR_Sequence st
len m = len u for c being CR_coefficients of m, i being Nat st i in
  dom m holds Sum(u(#)c),u.i are_congruent_mod m.i;

theorem 
  for u being INT-valued FinSequence, m being CR_Sequence st
len m = len u for c1,c2 being CR_coefficients of m holds Sum(u(#)c1),Sum(u(#)c2
  ) are_congruent_mod Product(m);

definition
  let u be INT-valued FinSequence, m be CR_Sequence such that
 len m = len u;
  func to_int(u,m) -> Integer means


  for c being CR_coefficients of m holds it = Sum(u(#)c) mod Product(m);
end;

theorem 
  for u being INT-valued FinSequence, m being CR_Sequence st
  len m = len u holds 0 <= to_int(u,m) & to_int(u,m) < Product(m);

theorem 
  for u being Integer, m being CR_Sequence, i being Nat
  st i in dom m holds u, mod(u,m).i are_congruent_mod m.i;

theorem 
  for u,v being Integer, m being CR_Sequence, i being Nat
  st i in dom m holds (mod(u,m) + mod(v,m)).i, u + v are_congruent_mod m.i;

theorem 
  for u,v being Integer, m being CR_Sequence, i being Nat
  st i in dom m holds (mod(u,m) (#) mod(v,m)).i, u * v are_congruent_mod m.i;

theorem 
  for u,v being Integer, m being CR_Sequence, i being Nat
  st i in dom m holds to_int(mod(u,m) + mod(v,m),m), u + v
  are_congruent_mod m.i;

theorem 
  for u,v being Integer, m being CR_Sequence, i being Nat
  st i in dom m holds to_int(mod(u,m) - mod(v,m),m), u - v
  are_congruent_mod m.i;

theorem 
  for u,v being Integer, m being CR_Sequence, i being Nat
  st i in dom m holds to_int(mod(u,m) (#) mod(v,m),m), u * v
  are_congruent_mod m.i;

theorem 
  for u,v being Integer, m being CR_Sequence st 0 <= u + v & u + v <
  Product(m) holds to_int(mod(u,m) + mod(v,m), m) = u + v;

theorem 
  for u,v being Integer, m being CR_Sequence st 0 <= u - v & u - v <
  Product(m) holds to_int(mod(u,m) - mod(v,m), m) = u - v;

theorem 
  for u,v being Integer, m being CR_Sequence st 0 <= u * v & u * v <
  Product(m) holds to_int(mod(u,m) (#) mod(v,m), m) = u * v;

begin  

theorem 
  for u being INT-valued FinSequence, m being CR_Sequence st len u =
  len m ex z being Integer st 0 <= z & z < Product(m) & for i being Nat
  st i in dom u holds z,u.i are_congruent_mod m.i;

theorem 
  for u being INT-valued FinSequence, m being CR_Sequence for z1,z2
  being Integer st 0 <= z1 & z1 < Product(m) & (for i being Nat st i
in dom m holds z1,u.i are_congruent_mod m.i) & 0 <= z2 & z2 < Product(m) & (for
i being Nat st i in dom m holds z2,u.i are_congruent_mod m.i) holds
  z1 = z2;














begin

reserve Omega for non empty set,
        Sigma for SigmaField of Omega,
        Prob for Probability of Sigma,
        A for SetSequence of Sigma,
        n,n1,n2 for Element of NAT;

definition
  let D be set;
  let x,y be ext-real number, a,b be Element of D;
  redefine func IFGT(x,y,a,b) -> Element of D;
end;

theorem 
for k being Element of NAT,x being Element of REAL st k is odd & x>0 & x<=1
  holds ((-x) rExpSeq).(k+1) + ((-x) rExpSeq).(k+2) >= 0;

theorem 
for x being Element of REAL holds 1+x <= exp_R.x;

definition let s be Real_Sequence;
  func JSum(s) -> Real_Sequence means

  for d being Nat holds it.d = Sum( (-s.d) rExpSeq);
end;

theorem 
  Partial_Product(JSum(Prob*A)).n = exp_R.(-Partial_Sums(Prob*A).n);

theorem 
  Partial_Product(Prob*(Complement A)).n <=
  Partial_Product(JSum(Prob*A)).n;

definition
  let n1,n2 be Element of NAT;
  func Special_Function(n1,n2) -> sequence of NAT means

  for n being Element of NAT holds it.n = IFGT(n,n1,n+n2,n);
end;

definition let k be Element of NAT;
  func Special_Function2(k) -> sequence of NAT means

  for n being Element of NAT holds it.n = n+k;
end;

definition let k be Element of NAT;
  func Special_Function3(k) -> sequence of NAT means

  for n being Element of NAT holds it.n = IFGT(n,k,0,1);
end;

definition
  let n1,n2 be Element of NAT;
  func Special_Function4(n1,n2) -> sequence of NAT means

  for n being Element of NAT holds it.n = IFGT(n,n1+1,n+n2,n);
end;

registration
  let n1,n2 be Element of NAT;
  cluster Special_Function(n1,n2) -> one-to-one;
  cluster Special_Function4(n1,n2) -> one-to-one;
end;

registration
  let n be Element of NAT;
  cluster Special_Function2(n) -> one-to-one;
end;

registration
  let Omega be non empty set;
  let Sigma be SigmaField of Omega;
  let s be Element of NAT;
  let A be SetSequence of Sigma;
  cluster A^\s -> Sigma-valued;
end;

theorem 
( for A,B being SetSequence of Sigma
    st n>n1 & B=A*Special_Function(n1,n2) holds
    (Partial_Product (Prob*B)).n =
    (Partial_Product (Prob*A)).n1 *
     (Partial_Product (Prob*(A^\(n1+n2+1)))).(n-n1-1) ) &
( for A,B,C being SetSequence of Sigma,
    e being sequence of NAT
    st n>n1 & C = A*e & B=C*Special_Function(n1,n2) holds
    (Partial_Intersection B).n =
    (Partial_Intersection C).n1 /\
     (Partial_Intersection (C^\(n1+n2+1))).(n-n1-1) );

definition
  let Omega be non empty set, Sigma be SigmaField of Omega,
      Prob be Probability of Sigma, A be SetSequence of Sigma;
  pred A is_all_independent_wrt Prob means

   for B being SetSequence of Sigma st
    (ex e being sequence of NAT st
     (e is one-to-one &
      (for n being Element of NAT holds A.(e.n) = B.n) )) holds
     (for n being Element of NAT holds (Partial_Product(Prob*B)).n=
      Prob.((Partial_Intersection B).n) );
end;

theorem 
  n>n1 & A is_all_independent_wrt Prob implies
    Prob.( (Partial_Intersection Complement A).n1 /\
           (Partial_Intersection (A^\(n1+n2+1))).(n-n1-1)) =
    (Partial_Product (Prob*Complement A)).n1 *
    (Partial_Product (Prob*(A^\(n1+n2+1)))).(n-n1-1);

theorem 
  (Partial_Intersection Complement A).n = ((Partial_Union A).n)`;

theorem 
  Prob.( (Partial_Intersection Complement A).n ) =
  1-Prob.( (Partial_Union A).n );

definition
  let X be set, A be SetSequence of X;
  func Union_Shift_Seq A -> SetSequence of X means

  for n being Element of NAT holds it.n = Union (A^\n);
end;

registration
  let Omega be non empty set,
  Sigma be SigmaField of Omega,
  A be SetSequence of Sigma;
  cluster Union_Shift_Seq A -> Sigma-valued;
end;

definition
  let Omega be non empty set, Sigma be SigmaField of Omega,
      A be SetSequence of Sigma;
  func @lim_sup A -> Event of Sigma equals

  @Intersection Union_Shift_Seq A;
end;

definition
  let X be set, A be SetSequence of X;
  func Intersect_Shift_Seq A -> SetSequence of X means

  for n being Element of NAT holds it.n = Intersection (A^\n);
end;

registration
  let Omega be non empty set,
  Sigma be SigmaField of Omega,
  A be SetSequence of Sigma;
  cluster Intersect_Shift_Seq A -> Sigma-valued;
  end;

definition
  let Omega be non empty set, Sigma be SigmaField of Omega,
      A be SetSequence of Sigma;
  func @lim_inf A -> Event of Sigma equals

  Union Intersect_Shift_Seq A;
end;

theorem 
  (Intersect_Shift_Seq Complement A).n =
  ((Union_Shift_Seq A).n)`;

theorem 
  A is_all_independent_wrt Prob implies
     Prob.((Partial_Intersection Complement A).n) =
      Partial_Product(Prob*Complement A).n;

theorem 
  for X being set, A being SetSequence of X holds
  superior_setsequence A = Union_Shift_Seq A &
  inferior_setsequence A = Intersect_Shift_Seq A;

theorem 
  superior_setsequence A = Union_Shift_Seq A &
  inferior_setsequence A = Intersect_Shift_Seq A;

definition
  let Omega be non empty set;
  let Sigma be SigmaField of Omega;
  let Prob be Probability of Sigma;
  let A be SetSequence of Sigma;
  func Sum_Shift_Seq(Prob,A) -> Real_Sequence means

  for n being Element of NAT holds it.n = Sum( Prob*(A^\n) );
end;

theorem 
  Partial_Sums(Prob*A) is convergent
implies (Prob.@lim_sup A = 0 & lim(Sum_Shift_Seq(Prob,A))=0 &
       Sum_Shift_Seq(Prob,A) is convergent);

theorem 
( for X being set, A being SetSequence of X holds
       for n being Element of NAT, x being set holds
      ( (ex k being Element of NAT st x in (A^\n).k)
         iff (ex k being Element of NAT st k>=n & x in A.k) ) ) &
( for X being set, A being SetSequence of X holds
      for x being set holds x in Intersection Union_Shift_Seq A iff
      for m being Element of NAT holds
       ex n being Element of NAT st n>=m & x in A.n ) &
( for A being SetSequence of Sigma holds
              for x being set holds
           x in @Intersection Union_Shift_Seq A iff
           for m being Element of NAT holds
            ex n being Element of NAT st n>=m & x in A.n ) &
( for X being set, A being SetSequence of X holds
        for x being set holds
        ( (x in Union Intersect_Shift_Seq A ) iff
         (ex n being Element of NAT st
           for k being Element of NAT st k>=n holds x in A.k ) ) ) &
( for A being SetSequence of Sigma holds
             for x being set holds
         ( (x in Union Intersect_Shift_Seq A ) iff
         (ex n being Element of NAT st
           for k being Element of NAT st k>=n holds x in A.k ) ) ) &
( for A being SetSequence of Sigma holds
              for x being Element of Omega holds
       ( (x in Union Intersect_Shift_Seq (Complement A) ) iff
        (ex n being Element of NAT st
          for k being Element of NAT st k>=n holds not x in A.k ) ) );

theorem 
  lim_sup A = @lim_sup A &
  lim_inf A = @lim_inf A &
  @lim_inf Complement A = (@lim_sup A)` &
  Prob.(@lim_inf Complement A) + Prob.(@lim_sup A) = 1 &
  Prob.(lim_inf Complement A) + Prob.(lim_sup A) = 1;

theorem 
(Partial_Sums(Prob*A) is convergent
 implies Prob.lim_sup A = 0 &
         Prob.lim_inf Complement A = 1 ) &
(A is_all_independent_wrt Prob &
 Partial_Sums(Prob*A) is divergent_to+infty
  implies Prob.lim_inf Complement A = 0 &
          Prob.lim_sup A = 1);

theorem 
 (not Partial_Sums(Prob*A) is convergent &
   A is_all_independent_wrt Prob) implies
  (Prob.lim_inf Complement A = 0 & Prob.lim_sup A = 1);

theorem 
A is_all_independent_wrt Prob implies
  (Prob.lim_inf Complement A = 0 or
   Prob.lim_inf Complement A = 1) &
   (Prob.lim_sup A = 0 or Prob.lim_sup A = 1);

theorem 
(Partial_Sums(Prob*(A^\(n1+1)))).n <=
Partial_Sums(Prob*A).(n1+1+n) - Partial_Sums(Prob*A).n1;

theorem 
Prob.( (Intersect_Shift_Seq Complement A).n ) =
  1-Prob.( (Union_Shift_Seq A).n );

theorem 
( Complement A is_all_independent_wrt Prob implies
    Prob.((Partial_Intersection A).n) =
     Partial_Product(Prob*A).n ) &
( A is_all_independent_wrt Prob implies
    1-Prob.( (Partial_Union A).n ) =
     Partial_Product(Prob* Complement A).n);














begin 

reserve X for non empty set,
  Y for set,
  S for SigmaField of X,
  F for Function of NAT,S,
  f,g for PartFunc of X,REAL,
  A,B for Element of S,
  r,s for Real,
  a for real number,
  n for Nat;

theorem 
  |. R_EAL f .| = R_EAL abs f;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
of S, f be PartFunc of X,ExtREAL, r be Real st dom f in S & (for x be set st x
  in dom f holds f.x = r) holds f is_simple_func_in S;

theorem 
  for x be set holds x in less_dom(f,a) iff x in dom f & ex y being Real
  st y=f.x & y < a;

theorem 
  for x be set holds x in less_eq_dom(f,a) iff x in dom f & ex y being
  Real st y=f.x & y <= a;

theorem 
  for x be set holds x in great_dom(f,r) iff x in dom f & ex y being
  Real st y=f.x & r < y;

theorem 
  for x be set holds x in great_eq_dom(f,r) iff x in dom f & ex y being
  Real st y=f.x & r <= y;

theorem 
  for x be set holds x in eq_dom(f,r) iff x in dom f & ex y being Real
  st y=f.x & r= y;

theorem 
  (for n holds F.n = Y /\ great_dom(f,r-1/(n+1))) implies Y /\
  great_eq_dom(f,r) = meet rng F;

theorem 
  (for n holds F.n = Y /\ less_dom(f,(r+1/(n+1)))) implies Y /\
  less_eq_dom(f,r) = meet rng F;

theorem 
  (for n holds F.n = Y /\ less_eq_dom(f,r-1/(n+1))) implies Y /\
  less_dom(f,r) = union rng F;

theorem 
  (for n holds F.n = Y /\ great_eq_dom(f,r+1/(n+1))) implies Y /\
  great_dom(f,r) = union rng F;

definition

  let X be non empty set;
  let S be SigmaField of X;
  let f be PartFunc of X,REAL;
  let A be Element of S;
  pred f is_measurable_on A means


  R_EAL f is_measurable_on A;
end;

theorem 
  f is_measurable_on A iff for r being real number holds A /\
  less_dom(f,r) in S;

theorem 
  A c= dom f implies ( f is_measurable_on A iff for r being real
  number holds A /\ great_eq_dom(f,r) in S );

theorem 
  f is_measurable_on A iff for r being real number holds A /\
  less_eq_dom(f,r) in S;

theorem 
  A c= dom f implies ( f is_measurable_on A iff for r being real number
  holds A /\ great_dom(f,r) in S );

theorem 
  B c= A & f is_measurable_on A implies f is_measurable_on B;

theorem 
  f is_measurable_on A & f is_measurable_on B implies f is_measurable_on
  (A \/ B);

theorem 
  f is_measurable_on A & A c= dom f implies A /\ great_dom(f,r) /\
  less_dom(f,s) in S;

theorem 
  f is_measurable_on A & g is_measurable_on A & A c= dom g implies A /\
  less_dom(f,r) /\ great_dom(g,r) in S;

theorem 
  R_EAL(r(#)f)=r(#)R_EAL f;

theorem 
  f is_measurable_on A & A c= dom f implies r(#)f is_measurable_on A;

begin 

reserve X for non empty set,
  S for SigmaField of X,
  f,g for PartFunc of X,REAL ,
  A for Element of S,
  r for Real,
  p for Rational;

theorem 
  R_EAL f is real-valued;

theorem 
  R_EAL(f+g)=R_EAL f + R_EAL g & R_EAL(f-g)=R_EAL f - R_EAL g &
  dom(R_EAL(f+g))= dom(R_EAL f) /\ dom(R_EAL g) & dom(R_EAL(f-g))= dom(R_EAL f)
  /\ dom(R_EAL g) & dom(R_EAL(f+g))= dom f /\ dom g & dom(R_EAL(f-g))= dom f /\
  dom g;

theorem 
  for F be Function of RAT,S st (for p holds F.p = (A/\less_dom(f,p)) /\
  (A/\less_dom(g,r-p))) holds A /\ less_dom(f+g,r) = union rng F;

theorem 
  f is_measurable_on A & g is_measurable_on A implies ex F being
Function of RAT,S st for p being Rational holds F.p = (A /\ less_dom(f,p)) /\ (
  A /\ less_dom(g,r-p));

theorem 
  f is_measurable_on A & g is_measurable_on A implies f+g is_measurable_on A;

theorem 
  R_EAL f - R_EAL g = R_EAL f + R_EAL -g;

theorem 
  -R_EAL f = R_EAL((-1)(#)f) & -R_EAL f = R_EAL -f;

theorem 
  f is_measurable_on A & g is_measurable_on A & A c= dom g implies f-g
  is_measurable_on A;

begin 

reserve X for non empty set,
  f for PartFunc of X,REAL,
  r for Real;

theorem 
  max+(R_EAL f) = max+f & max-(R_EAL f) = max-f;

theorem 
  for x being Element of X holds 0 <= (max+f).x;

theorem 
  for x being Element of X holds 0 <= (max-f).x;

theorem 
  max-f = max+(-f);

theorem 
  for x being set st x in dom f & 0 < max+f.x holds max-f.x = 0;

theorem 
  for x being set st x in dom f & 0 < max-f.x holds max+f.x = 0;

theorem 
  dom f = dom (max+f - max-f) & dom f = dom (max+f + max-f);

theorem 
  for x being set st x in dom f holds (max+f.x = f.x or max+f.x = 0) & (
  max-f.x = -(f.x) or max-f.x = 0);

theorem 
  for x being set st x in dom f & max+f.x = f.x holds max-f.x = 0;

theorem 
  for x being set st x in dom f & max+f.x = 0 holds max-f.x = -(f.x);

theorem 
  for x being set st x in dom f & max-f.x = -(f.x) holds max+f.x = 0;

theorem 
  for x being set st x in dom f & max-f.x = 0 holds max+f.x = f.x;

theorem 
  f = max+f - max-f;

theorem 
  |.r.| = |. R_EAL r .|;

theorem 
  R_EAL(abs f) =|.R_EAL f.|;

theorem 
  abs f = max+f + max-f;

begin 

reserve X for non empty set,
  S for SigmaField of X,
  f for PartFunc of X,REAL,
  A for Element of S;

theorem 
  f is_measurable_on A implies max+f is_measurable_on A;

theorem 
  f is_measurable_on A & A c= dom f implies max-f is_measurable_on A;

theorem 
  f is_measurable_on A & A c= dom f implies abs f is_measurable_on A;

begin 

reserve X for non empty set,
  Y for set,
  S for SigmaField of X,
  f,g,h for PartFunc of X,REAL,
  A for Element of S,
  r for Real;

definition
  let X,S,f;
  pred f is_simple_func_in S means


  ex F being Finite_Sep_Sequence of S
st (dom f = union rng F & for n being Nat,x,y being Element of X st n in dom F
  & x in F.n & y in F.n holds f.x = f.y);
end;

theorem 
  f is_simple_func_in S iff R_EAL f is_simple_func_in S;

theorem 
  f is_simple_func_in S implies f is_measurable_on A;

theorem 
  for X being set, f being PartFunc of X,REAL holds f is
  nonnegative iff for x being set holds 0 <= f.x;

theorem 
  for X being set, f being PartFunc of X,REAL st for x being set
  st x in dom f holds 0 <= f.x holds f is nonnegative;

theorem 
  for X being set, f being PartFunc of X,REAL holds f is nonpositive iff
  for x being set holds f.x <= 0;

theorem 
  (for x being set st x in dom f holds f.x <= 0) implies f is nonpositive;

theorem 
  f is nonnegative implies f|Y is nonnegative;

theorem 
  f is nonnegative & g is nonnegative implies f+g is nonnegative;

theorem 
  f is nonnegative implies (0 <= r implies r(#)f is nonnegative) & (r <=
  0 implies r(#)f is nonpositive);

theorem 
  (for x be set st x in dom f /\ dom g holds g.x <= f.x) implies f
  -g is nonnegative;

theorem 
  f is nonnegative & g is nonnegative & h is nonnegative implies f+g+h
  is nonnegative;

theorem 
  for x be set st x in dom(f+g+h) holds (f+g+h).x=f.x+g.x+h.x;

theorem 
  max+f is nonnegative & max-f is nonnegative;

theorem 
  dom(max+(f+g) + max-f) = dom f /\ dom g & dom(max-(f+g) + max+f)
= dom f /\ dom g & dom(max+(f+g) + max-f + max-g) = dom f /\ dom g & dom(max-(f
+g) + max+f + max+g) = dom f /\ dom g & max+(f+g) + max-f is nonnegative & max-
  (f+g) + max+f is nonnegative;

theorem 
  max+(f+g) + max-f + max-g = max-(f+g) + max+f + max+g;

theorem 
  0 <= r implies max+(r(#)f) = r(#)max+f & max-(r(#)f) = r(#)max-f;

theorem 
  0 <= r implies max+((-r)(#)f) = r(#)max-f & max-((-r)(#)f) = r(#)max+f;

theorem 
  max+(f|Y)=max+f|Y & max-(f|Y)=max-f|Y;

theorem 
  Y c= dom(f+g) implies dom((f+g)|Y) =Y & dom(f|Y+g|Y)=Y & (f+g)|Y = f|Y +g|Y;

theorem 
  eq_dom(f,r) = f"{r};

begin 

reserve X for non empty set,
  S for SigmaField of X,
  f,g for PartFunc of X,REAL ,
  A,B for Element of S,
  r,s for Real;

theorem 
  f is_measurable_on A & A c= dom f implies A /\ great_eq_dom(f,r) /\
  less_dom(f,s) in S;

theorem 
  f is_simple_func_in S implies f|A is_simple_func_in S;

theorem 
  f is_simple_func_in S implies dom f is Element of S;

theorem 
  f is_simple_func_in S & g is_simple_func_in S implies f+g is_simple_func_in S
;

theorem 
  f is_simple_func_in S implies r(#)f is_simple_func_in S;

theorem 
  (for x be set st x in dom(f-g) holds g.x <= f.x) implies f-g is nonnegative;

theorem 
  ex f be PartFunc of X,REAL st f is_simple_func_in S & dom f = A & for
  x be set st x in A holds f.x=r;

theorem 
  f is_measurable_on B & A = dom f /\ B implies f|B is_measurable_on A;

theorem 
  A c= dom f & f is_measurable_on A & g is_measurable_on A implies max+(
  f+g) + max-f is_measurable_on A;

theorem 
  A c= dom f /\ dom g & f is_measurable_on A & g is_measurable_on A
  implies max-(f+g) + max+f is_measurable_on A;

theorem 
  dom f in S & dom g in S implies dom(f+g) in S;

theorem 
  dom f = A implies (f is_measurable_on B iff f is_measurable_on ( A/\B));

theorem 
  ( ex A be Element of S st dom f = A ) implies for c be Real, B be
  Element of S st f is_measurable_on B holds c(#)f is_measurable_on B;

begin 

reserve X for non empty set,
  S for SigmaField of X,
  M for sigma_Measure of S,
  f,g for PartFunc of X,REAL,
  r for Real,
  E,A,B for Element of S;

definition
  let X be non empty set;
  let S be SigmaField of X;
  let M be sigma_Measure of S;
  let f be PartFunc of X,REAL;
  func Integral(M,f) -> Element of ExtREAL equals

  Integral(M,R_EAL f);
end;

theorem 
  (ex A be Element of S st A = dom f & f is_measurable_on A) & f
  is nonnegative implies Integral(M,f) = integral+(M,R_EAL f);

theorem 
  f is_simple_func_in S & f is nonnegative implies Integral(M,f) =
  integral+(M,R_EAL f) & Integral(M,f) = integral'(M,R_EAL f);

theorem 
  (ex A be Element of S st A = dom f & f is_measurable_on A) & f is
  nonnegative implies 0 <= Integral(M,f);

theorem 
  (ex E be Element of S st E = dom f & f is_measurable_on E) & f is
  nonnegative & A misses B implies Integral(M,f|(A\/B)) = Integral(M,f|A)+
  Integral(M,f|B);

theorem 
  (ex E be Element of S st E = dom f & f is_measurable_on E) & f is
  nonnegative implies 0<= Integral(M,f|A);

theorem 
  (ex E be Element of S st E = dom f & f is_measurable_on E ) & f is
  nonnegative & A c= B implies Integral(M,f|A) <= Integral(M,f|B);

theorem 
  (ex E be Element of S st E = dom f & f is_measurable_on E) & M.A = 0
  implies Integral(M,f|A)=0;

theorem 
  E = dom f & f is_measurable_on E & M.A =0 implies Integral(M,f|(E\A))
  = Integral(M,f);

definition
  let X be non empty set;
  let S be SigmaField of X;
  let M be sigma_Measure of S;
  let f be PartFunc of X,REAL;
  pred f is_integrable_on M means


  R_EAL f is_integrable_on M;
end;

theorem 
  f is_integrable_on M implies -infty < Integral(M,f) & Integral(M,f) < +infty;

theorem 
  f is_integrable_on M implies f|A is_integrable_on M;

theorem 
  f is_integrable_on M & A misses B implies Integral(M,f|(A\/B)) =
  Integral(M,f|A) + Integral(M,f|B);

theorem 
  f is_integrable_on M & B = (dom f)\A implies f|A is_integrable_on M &
  Integral(M,f) = Integral(M,f|A)+Integral(M,f|B);

theorem 
  (ex A be Element of S st A = dom f & f is_measurable_on A ) implies (f
  is_integrable_on M iff abs f is_integrable_on M);

theorem 
  f is_integrable_on M implies |. Integral(M,f) .| <= Integral(M,abs f);

theorem 
  ( ex A be Element of S st A = dom f & f is_measurable_on A ) & dom f =
dom g & g is_integrable_on M & ( for x be Element of X st x in dom f holds abs(
f.x) <= g.x ) implies f is_integrable_on M & Integral(M,abs f) <= Integral(M,g)
;

theorem 
  dom f in S & 0 <= r & (for x be set st x in dom f holds f.x = r)
  implies Integral(M,f) = R_EAL(r) * M.(dom f);

theorem 
  f is_integrable_on M & g is_integrable_on M & f is nonnegative & g is
  nonnegative implies f+g is_integrable_on M;

theorem 
  f is_integrable_on M & g is_integrable_on M implies dom (f+g) in S;

theorem 
  f is_integrable_on M & g is_integrable_on M implies f+g is_integrable_on M;

theorem 
  f is_integrable_on M & g is_integrable_on M implies ex E be Element of
  S st E = dom f /\ dom g & Integral(M,f+g)=Integral(M,f|E)+Integral(M,g|E);

theorem 
  f is_integrable_on M implies r(#)f is_integrable_on M & Integral(M,r
  (#)f) = R_EAL r * Integral(M,f);

definition
  let X be non empty set;
  let S be SigmaField of X;
  let M be sigma_Measure of S;
  let f be PartFunc of X,REAL;
  let B be Element of S;
  func Integral_on(M,B,f) -> Element of ExtREAL equals

  Integral(M,f|B);
end;

theorem 
  f is_integrable_on M & g is_integrable_on M & B c= dom(f+g) implies f+
g is_integrable_on M & Integral_on(M,B,f+g) = Integral_on(M,B,f) + Integral_on(
  M,B,g);

theorem 
  f is_integrable_on M implies f|B is_integrable_on M & Integral_on(M,B,
  r(#)f) = R_EAL r * Integral_on(M,B,f);














begin

reserve n,m for Element of NAT;
reserve h,k,r,r1,r2,x,x0,x1,x2,x3 for Real;
reserve f,f1,f2 for Function of REAL,REAL;

theorem 
  cD(f,h).x = fD(f,h/2).x - fD(f,-h/2).x;

theorem 
  fD(f,-h/2).x = -bD(f,h/2).x;

theorem 
  cD(f,h).x = bD(f,h/2).x - bD(f,-h/2).x;

theorem 
  fdif(r(#)f1+f2,h).(n+1).x = r* fdif(f1,h).(n+1).x + fdif(f2,h).(n+1).x;

theorem 
  fdif(f1+r(#)f2,h).(n+1).x = fdif(f1,h).(n+1).x + r* fdif(f2,h).(n+1).x;

theorem 
  fdif(r1(#)f1-r2(#)f2,h).(n+1).x =
  r1* fdif(f1,h).(n+1).x - r2* fdif(f2,h).(n+1).x;

theorem 
  fdif(f,h).1 = fD(f,h);

theorem 
  bdif(r(#)f1+f2,h).(n+1).x = r* bdif(f1,h).(n+1).x + bdif(f2,h).(n+1).x;

theorem 
  bdif(f1+r(#)f2,h).(n+1).x = bdif(f1,h).(n+1).x + r* bdif(f2,h).(n+1).x;

theorem 
  bdif(r1(#)f1-r2(#)f2,h).(n+1).x =
  r1* bdif(f1,h).(n+1).x - r2* bdif(f2,h).(n+1).x;

theorem 
  bdif(f,h).1 = bD(f,h);

theorem 
  (bdif(bdif(f,h).m,h).n).x = bdif(f,h).(m+n).x;

theorem 
  cdif(r(#)f1+f2,h).(n+1).x = r* cdif(f1,h).(n+1).x + cdif(f2,h).(n+1).x;

theorem 
  cdif(f1+r(#)f2,h).(n+1).x = cdif(f1,h).(n+1).x + r* cdif(f2,h).(n+1).x;

theorem 
  cdif(r1(#)f1-r2(#)f2,h).(n+1).x =
  r1* cdif(f1,h).(n+1).x - r2* cdif(f2,h).(n+1).x;

theorem 
  cdif(f,h).1 = cD(f,h);

theorem 
  (cdif(cdif(f,h).m,h).n).x = cdif(f,h).(m+n).x;

theorem 
  (fdif(f,h).n).x = (cdif(f,h).n).(x+(n/2)*h)
  implies (bdif(f,h).n).x = (cdif(f,h).n).(x-(n/2)*h);

theorem 
  (fdif(f,h).n).x = (cdif(f,h).n).(x+((n-1)/2)*h+h/2) implies
  (bdif(f,h).n).x = (cdif(f,h).n).(x-((n-1)/2)*h-h/2);

theorem 
  [!f,x,x+h!] = (fD(f,h).x)/h;

theorem 
  [!f,x-h,x!] = (bD(f,h).x)/h;

theorem 
  [!f,x-h/2,x+h/2!] = (cD(f,h).x)/h;

theorem 
  [!f,x-h/2,x+h/2!] = (cdif(f,h).1.x)/h;

theorem 
  h<>0 implies [!f,x-h,x,x+h!] = (cdif(f,h).2.x)/(2*h*h);

theorem 
  [!(f1-f2),x0,x1!] = [!f1,x0,x1!] - [!f2,x0,x1!];

theorem 
  [!(r(#)f1+f2),x0,x1!] = r* [!f1,x0,x1!] + [!f2,x0,x1!];

theorem 
  [!(r(#)f1-f2),x0,x1!] = r* [!f1,x0,x1!] - [!f2,x0,x1!];

theorem 
  [!(f1+r(#)f2),x0,x1!] = [!f1,x0,x1!] + r* [!f2,x0,x1!];

theorem 
  [!(f1-r(#)f2),x0,x1!] = [!f1,x0,x1!] - r* [!f2,x0,x1!];

theorem 
  [!(r1(#)f1-r2(#)f2),x0,x1!] = r1* [!f1,x0,x1!] - r2* [!f2,x0,x1!];

theorem 
 (bdif(f1(#)f2,h).1).x = f1.x* (bdif(f2,h).1).x + f2.(x-h)* (bdif(f1,h).1).x;

theorem 
  x0,x1,x2 are_mutually_different implies [!f,x0,x1,x2!] = [!f,x0,x2,x1!];

reserve S for Seq_Sequence;

theorem 
  (for n, i be Nat st i<=n holds
  (S.n).i=(n choose i) * bdif(f1,h).i.x * bdif(f2,h).(n-'i).(x-i*h)) implies
  bdif(f1(#)f2,h).1.x = Sum(S.1, 1) & bdif(f1(#)f2,h).2.x = Sum(S.2, 2);

theorem 
  (cdif(f1(#)f2,h).1).x
     = f1.(x+h/2)* (cdif(f2,h).1).x + f2.(x-h/2)* (cdif(f1,h).1).x;

theorem 
  (for n,i be Nat st i<=n holds
  (S.n).i=(n choose i) * (cdif(f1,h).i).(x+(n-'i)*(h/2))
          * (cdif(f2,h).(n-'i)).(x-i*(h/2))) implies
  cdif(f1(#)f2,h).1.x = Sum(S.1, 1) & cdif(f1(#)f2,h).2.x = Sum(S.2, 2);



theorem 
  (for x holds f.x = sqrt x) & x0<>x1 & x0>0 & x1>0 implies
  [!f,x0,x1!] = 1/(sqrt x0 + sqrt x1);

theorem 
  (for x holds f.x = sqrt x) & x0,x1,x2 are_mutually_different
  & x0>0 & x1>0 & x2>0 implies [!f,x0,x1,x2!]
  = -1/((sqrt x0+sqrt x1)*(sqrt x0+sqrt x2)*(sqrt x1+sqrt x2));

theorem 
  (for x holds f.x = sqrt x) & x0,x1,x2,x3 are_mutually_different
  & x0>0 & x1>0 & x2>0 & x3>0 implies
  [!f,x0,x1,x2,x3!] = (sqrt x0+sqrt x1+sqrt x2+sqrt x3)/((sqrt x0+sqrt x1)
  *(sqrt x0+sqrt x2)*(sqrt x0+sqrt x3)*(sqrt x1+sqrt x2)*(sqrt x1+sqrt x3)
  *(sqrt x2+sqrt x3));

theorem 
  (for x holds f.x = sqrt x) & x>0 & x+h>0 implies
  fD(f,h).x = sqrt (x+h) - sqrt x;

theorem 
  (for x holds f.x = sqrt x) & x>0 & x-h>0 implies
  bD(f,h).x = sqrt x - sqrt (x-h);

theorem 
  (for x holds f.x = sqrt x) & x+h/2>0 & x-h/2>0 implies
  cD(f,h).x = sqrt (x+h/2) - sqrt (x-h/2);



theorem 
  (for x holds f.x = x^2) & x0<>x1 implies [!f,x0,x1!] = x0+x1;

theorem 
  (for x holds f.x = x^2) & x0,x1,x2 are_mutually_different implies
  [!f,x0,x1,x2!] = 1;

theorem 
  (for x holds f.x = x^2) & x0,x1,x2,x3 are_mutually_different implies
  [!f,x0,x1,x2,x3!] = 0;

theorem 
  (for x holds f.x = x^2) implies fD(f,h).x = 2*x*h + h^2;

theorem 
  (for x holds f.x = x^2) implies bD(f,h).x = h*(2*x-h);

theorem 
  (for x holds f.x = x^2) implies cD(f,h).x = 2*h*x;



theorem 
  (for x holds f.x = k/(x^2)) & x0<>x1 & x0<>0 & x1<>0
  implies [!f,x0,x1!] = -(k/(x0*x1))*(1/x0+1/x1);

theorem 
  (for x holds f.x = k/(x^2)) & x0<>0 & x1<>0 & x2<>0
  & x0,x1,x2 are_mutually_different implies
  [!f,x0,x1,x2!] = (k/(x0*x1*x2))*(1/x0+1/x1+1/x2);

theorem 
  (for x holds f.x = k/(x^2)) & x<>0 & x+h<>0
  implies fD(f,h).x = (-k)*h*(2*x+h)/((x^2+h*x)^2);

theorem 
  (for x holds f.x = k/(x^2)) & x<>0 & x-h<>0
  implies bD(f,h).x = (-k)*h*(2*x-h)/((x^2-x*h)^2);

theorem 
  (for x holds f.x = k/(x^2)) & x+h/2<>0 & x-h/2<>0
  implies cD(f,h).x = (-2*h*k*x)/((x^2-(h/2)^2)^2);



theorem 
  [!sin(#)sin(#)sin,x0,x1!] = (1/2)*(3*cos((x0+x1)/2)*sin((x0-x1)/2)
       -cos(3*(x0+x1)/2)*sin(3*(x0-x1)/2))/(x0-x1);

theorem 
  fD(sin(#)sin(#)sin,h).x
  =(1/2)*(3*cos((2*x+h)/2)*sin(h/2)-cos(3*(2*x+h)/2)*sin(3*h/2));

theorem 
  bD(sin(#)sin(#)sin,h).x
  = (1/2)*(3*cos((2*x-h)/2)*sin(h/2)-cos(3*(2*x-h)/2)*sin(3*h/2));

theorem 
  cD(sin(#)sin(#)sin,h).x = (1/2)*(3*cos(x)*sin(h/2)-cos(3*x)*sin(3*h/2));



theorem 
  [!cos(#)cos(#)cos,x0,x1!] = -(1/2)*(3*sin((x0+x1)/2)*sin((x0-x1)/2)
       +sin((3*x0+3*x1)/2)*sin((3*x0-3*x1)/2))/(x0-x1);

theorem 
  fD(cos(#)cos(#)cos,h).x= -(1/2)*(3*sin((2*x+h)/2)*sin(h/2)
  +sin((3*(2*x+h))/2)*sin(3*h/2));

theorem 
  bD(cos(#)cos(#)cos,h).x
  = -(1/2)*(3*sin((2*x-h)/2)*sin(h/2)+sin((3*(2*x-h))/2)*sin(3*h/2));

theorem 
  cD(cos(#)cos(#)cos,h).x = -(1/2)*(3*sin(x)*sin(h/2)+sin(3*x)*sin(3*h/2));



theorem 
  (for x holds f.x = 1/sin(x)) & sin(x0)<>0 & sin(x1)<>0 implies [!f,x0,x1!]
  = -2*(sin(x1)-sin(x0))/(cos(x0+x1)-cos(x0-x1))/(x0-x1);

theorem 
  (for x holds f.x = 1/sin(x)) & sin(x)<>0 & sin(x+h)<>0
  implies fD(f,h).x = -2*(sin(x)-sin(x+h))/(cos(2*x+h)-cos(h));

theorem 
  (for x holds f.x = 1/sin(x)) & sin(x)<>0 & sin(x-h)<>0
  implies bD(f,h).x = (-2)*(sin(x-h)-sin(x))/(cos(2*x-h)-cos(h));

theorem 
  (for x holds f.x = 1/sin(x)) & sin(x+h/2)<>0 & sin(x-h/2)<>0
  implies cD(f,h).x = -2*(sin(x-h/2)-sin(x+h/2))/(cos(2*x)-cos(h));



theorem 
  (for x holds f.x = 1/cos(x)) & x0<>x1 & cos(x0)<>0 & cos(x1)<>0
  implies [!f,x0,x1!] = 2*(cos(x1)-cos(x0))/(cos(x0+x1)+cos(x0-x1))/(x0-x1);

theorem 
  (for x holds f.x = 1/cos(x)) & cos(x)<>0 & cos(x+h)<>0
  implies fD(f,h).x = 2*(cos(x)-cos(x+h))/(cos(2*x+h)+cos(h));

theorem 
  (for x holds f.x = 1/cos(x)) & cos(x)<>0 & cos(x-h)<>0
  implies bD(f,h).x = 2*(cos(x-h)-cos(x))/(cos(2*x-h)+cos(h));

theorem 
  (for x holds f.x = 1/cos(x)) & cos(x+h/2)<>0 & cos(x-h/2)<>0
  implies cD(f,h).x = 2*(cos(x-h/2)-cos(x+h/2))/(cos(2*x)+cos(h));



theorem 
  (for x holds f.x=1/(sin(x))^2) & x0<>x1 & sin(x0)<>0 & sin(x1)<>0
  implies [!f,x0,x1!] = 16*cos((x1+x0)/2)*sin((x1-x0)/2)
  *cos((x1-x0)/2)*sin((x1+x0)/2)/(((cos(x0+x1)-cos(x0-x1))^2)*(x0-x1));

theorem 
  (for x holds f.x=1/(sin(x))^2) & sin(x)<>0 & sin(x+h)<>0
  implies fD(f,h).x = 16*cos((2*x+h)/2)*sin((-h)/2)*cos((-h)/2)*sin((2*x+h)/2)
  /((cos(2*x+h)-cos(h))^2);

theorem 
  (for x holds f.x=1/(sin(x))^2) & sin(x)<>0 & sin(x-h)<>0
  implies bD(f,h).x = 16*cos((2*x-h)/2)*sin((-h)/2)*cos((-h)/2)*sin((2*x-h)/2)
       /((cos(2*x-h)-cos(h))^2);

theorem 
  (for x holds f.x=1/(sin(x))^2) & sin(x+h/2)<>0 & sin(x-h/2)<>0 implies
  cD(f,h).x = 16*cos(x)*sin((-h)/2)*cos((-h)/2)*sin(x)/((cos(2*x)-cos(h))^2);



theorem 
  (for x holds f.x=1/(cos(x))^2) & x0<>x1 & cos(x0)<>0 & cos(x1)<>0
  implies [!f,x0,x1!] = (-16)*sin((x1+x0)/2)*sin((x1-x0)/2)*cos((x1+x0)/2)
  *cos((x1-x0)/2)/((cos(x0+x1)+cos(x0-x1))^2)/(x0-x1);

theorem 
  (for x holds f.x=1/(cos(x))^2) & cos(x)<>0 & cos(x+h)<>0
  implies fD(f,h).x = (-16)*sin((2*x+h)/2)*sin((-h)/2)*cos((2*x+h)/2)
  *cos((-h)/2)/((cos(2*x+h)+cos(h))^2);

theorem 
  (for x holds f.x=1/(cos(x))^2) & cos(x)<>0 & cos(x-h)<>0
  implies bD(f,h).x = (-16)*sin((2*x-h)/2)*sin((-h)/2)*cos((2*x-h)/2)
  *cos((-h)/2)/((cos(2*x-h)+cos(h))^2);

theorem 
  (for x holds f.x=1/(cos(x))^2) & cos(x+h/2)<>0 & cos(x-h/2)<>0
  implies cD(f,h).x = (-16)*sin(x)*sin((-h)/2)*cos(x)*cos((-h)/2)
  /((cos(2*x)+cos(h))^2);



theorem 
  x0 in dom tan & x1 in dom tan implies
  [!tan(#)sin,x0,x1!] = (1/cos(x0)-cos(x0)-1/cos(x1)+cos(x1))/(x0-x1);

theorem 
  (for x holds f.x = (tan(#)sin).x) & x in dom tan & x+h in dom tan
  implies fD(f,h).x = 1/cos(x+h)-cos(x+h)-1/cos(x)+cos(x);

theorem 
  (for x holds f.x = (tan(#)sin).x) & x in dom tan & x-h in dom tan
  implies bD(f,h).x = 1/cos(x)-cos(x)-1/cos(x-h)+cos(x-h);

theorem 
  (for x holds f.x = (tan(#)sin).x) & x+h/2 in dom tan & x-h/2 in dom tan
  implies cD(f,h).x = 1/cos(x+h/2)-cos(x+h/2)-1/cos(x-h/2)+cos(x-h/2);



theorem 
  (for x holds f.x = (tan(#)cos).x) & x0 in dom tan & x1 in dom tan
  implies [!f,x0,x1!] = (sin(x0)-sin(x1))/(x0-x1);

theorem 
  (for x holds f.x = (tan(#)cos).x) & x in dom tan & x+h in dom tan
  implies fD(f,h).x = sin(x+h)-sin(x);

theorem 
  (for x holds f.x = (tan(#)cos).x) & x in dom tan & x-h in dom tan
  implies bD(f,h).x = sin(x)-sin(x-h);

theorem 
  (for x holds f.x = (tan(#)cos).x) & x+h/2 in dom tan & x-h/2 in dom tan
  implies cD(f,h).x = sin(x+h/2)-sin(x-h/2);



theorem 
  (for x holds f.x = (cot(#)cos).x) & x0 in dom cot & x1 in dom cot
  implies [!f,x0,x1!] = (1/sin(x0)-sin(x0)-1/sin(x1)+sin(x1))/(x0-x1);

theorem 
  (for x holds f.x = (cot(#)cos).x) & x in dom cot & x+h in dom cot
  implies fD(f,h).x = 1/sin(x+h)-sin(x+h)-1/sin(x)+sin(x);

theorem 
  (for x holds f.x = (cot(#)cos).x) & x in dom cot & x-h in dom cot
  implies bD(f,h).x = 1/sin(x)-sin(x)-1/sin(x-h)+sin(x-h);

theorem 
  (for x holds f.x = (cot(#)cos).x) & x+h/2 in dom cot & x-h/2 in dom cot
  implies cD(f,h).x = 1/sin(x+h/2)-sin(x+h/2)-1/sin(x-h/2)+sin(x-h/2);



theorem 
  (for x holds f.x = (cot(#)sin).x) & x0 in dom cot & x1 in dom cot
  implies [!f,x0,x1!] = (cos(x0)-cos(x1))/(x0-x1);

theorem 
  (for x holds f.x = (cot(#)sin).x) & x in dom cot & x+h in dom cot
  implies fD(f,h).x = cos(x+h)-cos(x);

theorem 
  (for x holds f.x = (cot(#)sin).x) & x in dom cot & x-h in dom cot
  implies bD(f,h).x = cos(x)-cos(x-h);

theorem 
  (for x holds f.x = (cot(#)sin).x) & x+h/2 in dom cot & x-h/2 in dom cot
  implies cD(f,h).x = cos(x+h/2)-cos(x-h/2);



theorem 
  (for x holds f.x=(tan(#)tan).x) & x0 in dom tan & x1 in dom tan
  implies [!f,x0,x1!] = ((cos(x1))^2-(cos(x0))^2)/((cos(x0)*cos(x1))^2*(x0-x1))
;

theorem 
  (for x holds f.x=(tan(#)tan).x) & x in dom tan & x+h in dom tan
  implies fD(f,h).x = -(1/2)*(cos(2*(x+h))-cos(2*x))/((cos(x+h)*cos(x))^2);

theorem 
  (for x holds f.x=(tan(#)tan).x) & x in dom tan & x-h in dom tan
  implies bD(f,h).x = -(1/2)*(cos(2*x)-cos(2*(h-x)))/((cos(x)*cos(x-h))^2);

theorem 
  (for x holds f.x=(tan(#)tan).x) & x+h/2 in dom tan & x-h/2 in dom tan implies
  cD(f,h).x = -(1/2)*(cos(h+2*x)-cos(h-2*x))/((cos(x+h/2)*cos(x-h/2))^2);














begin  

reserve X for non empty set,
  S for SigmaField of X,
  M for sigma_Measure of S,
  f,g for PartFunc of X,ExtREAL,
  E for Element of S;

theorem 
  (for x be Element of X st x in dom f holds f.x <= g.x) implies g-
  f is nonnegative;

theorem 
  for Y be set, f be PartFunc of X,ExtREAL, r be Real holds (r(#)f)
  |Y = r(#)(f|Y);

theorem 
  f is_integrable_on M & g is_integrable_on M & g-f is nonnegative
  implies ex E be Element of S st E = dom f /\ dom g & Integral(M,f|E) <=
  Integral(M,g|E);

begin  

registration
  let X;
  cluster nonnegative for PartFunc of X,ExtREAL;
end;

registration
  let X,f;
  cluster |.f.| -> nonnegative for PartFunc of X,ExtREAL;
end;

theorem 
  f is_integrable_on M implies ex F be Function of NAT,S st ( for n be
Element of NAT holds F.n = dom f /\ great_eq_dom(|.f.|, R_EAL(1/(n+1))) ) & dom
f \ eq_dom(f, 0.) = union rng F & for n be Element of NAT holds F.n in S & M.(F
  .n) <+infty;

begin  

notation
  let F be Relation;
  synonym F is extreal-yielding for F is ext-real-valued;
end;

registration
  cluster extreal-yielding for FinSequence;
end;

definition

  func multextreal -> BinOp of ExtREAL means


  for x,y be Element of ExtREAL holds it.(x,y) = x*y;
end;

registration
  cluster multextreal -> commutative associative;
end;

theorem 
  the_unity_wrt multextreal = 1;

registration
  cluster multextreal -> having_a_unity;
end;

definition
  let F be extreal-yielding FinSequence;
  func Product F -> Element of ExtREAL means


  ex f being FinSequence of ExtREAL st f = F & it = multextreal $$ f;
end;

registration
  let x be Element of ExtREAL, n be Nat;
  cluster n |-> x -> extreal-yielding;
end;

definition
  let x be Element of ExtREAL;
  let k be Nat;
  func x |^ k equals

  Product (k |-> x);
end;

definition
  let x be Element of ExtREAL, k be Nat;
  redefine func x |^ k -> R_eal;
end;

registration
  cluster <*>ExtREAL -> extreal-yielding;
end;

registration
  let r be Element of ExtREAL;
  cluster <*r*> -> extreal-yielding;
end;

theorem 
  Product (<*>ExtREAL) = 1;

theorem 
  for r be Element of ExtREAL holds Product (<*r*>) = r;

registration
  let f,g be extreal-yielding FinSequence;
  cluster f^g -> extreal-yielding;
end;

theorem 
  for F being extreal-yielding FinSequence, r be Element of ExtREAL
  holds Product (F^<*r*>) = Product F * r;

theorem 
  for x be Element of ExtREAL holds x|^1 = x;

theorem 
  for x be Element of ExtREAL, k be Nat holds x|^(k+1) = x|^k*x;

definition
  let k be Nat, X,f;
  func f|^k -> PartFunc of X,ExtREAL means


  dom it = dom f & for x be Element of X st x in dom it holds it.x = (f.x)|^k;
end;

theorem 
  for x be Element of ExtREAL, y be real number, k be Nat
  st x=y holds x|^k = y|^k;

theorem 
  for x be Element of ExtREAL, k be Nat st 0 <=x holds 0 <= x|^k;

theorem 
  for k be Nat st 1<=k holds +infty|^k =+infty;

theorem 
  for k be Nat, X,S,f,E st E c= dom f & f
  is_measurable_on E holds (|.f.|) |^ k is_measurable_on E;

theorem 
  dom f /\ dom g = E & f is real-valued & g is real-valued & f
  is_measurable_on E & g is_measurable_on E implies f(#)g is_measurable_on E;

theorem 
  rng f is real-bounded implies f is real-valued;


theorem 
  for M be sigma_Measure of S, f,g be PartFunc of X, ExtREAL, E be
Element of S, F be non empty Subset of ExtREAL st dom f /\ dom g = E & rng f =
  F & g is real-valued & f is_measurable_on E & rng f is real-bounded & g
is_integrable_on M holds (f(#)g)|E is_integrable_on M & ex c be Element of REAL
st c >= inf F & c <= sup F & Integral(M, (f(#)|.g.|)|E) = R_EAL c * Integral(M,
  (|.g.|)|E);

begin  

reserve E1,E2 for Element of S;
reserve x,A for set;
reserve a,b for real number;

theorem 
  (|.f.|)|A = |.(f|A).|;

theorem 
  dom(|.f.|+|.g.|) = dom f /\ dom g & dom |.f+g.| c= dom |.f.|;

theorem 
  (|.f.|)|(dom |.f+g.|) + (|.g.|)|(dom |.f+g.|) = (|.f.|+|.g.|)|( dom |.f+g.|);

theorem 
  x in dom |.f+g.| implies (|.f+g.|).x <= (|.f.|+|.g.|).x;

theorem 
  f is_integrable_on M & g is_integrable_on M implies ex E be Element of
S st E = dom(f+g) & Integral(M,(|.f+g.|)|E) <= Integral(M,(|.f.|)|E) + Integral
  (M,(|.g.|)|E);

theorem 
  max+(chi(A,X)) = chi(A,X);

theorem 
  M.E < +infty implies chi(E,X) is_integrable_on M & Integral(M,
  chi(E,X)) = M.E & Integral(M,(chi(E,X))|E) = M.E;

theorem 
  M.(E1/\E2) < +infty implies Integral(M,(chi(E1,X))|E2) = M.(E1/\ E2);

theorem 
  f is_integrable_on M & E c= dom f & M.E < +infty & (for x be Element
of X st x in E holds a <= f.x & f.x <= b) implies (R_EAL a)*M.E <= Integral(M,f
  |E) & Integral(M,f|E) <= (R_EAL b)*M.E;














begin 

theorem 
  for a,b be real number holds R_EAL a + R_EAL b = a+b & -R_EAL a =
  -a & R_EAL a - R_EAL b = a-b & R_EAL a * R_EAL b = a*b;

begin 

reserve X for non empty set,
  Y for set,
  S for SigmaField of X,
  M for sigma_Measure of S,
  f,g for PartFunc of X,COMPLEX,
  r for Real,
  c for complex number,
  E,A,B for Element of S;

definition

  let X be non empty set;
  let S be SigmaField of X;
  let f be PartFunc of X,COMPLEX;
  let E be Element of S;
  pred f is_measurable_on E means


  Re f is_measurable_on E & Im f is_measurable_on E;
end;

theorem 
  r(#)(Re f) = Re(r(#)f) & r(#)(Im f) = Im(r(#)f);

theorem 
  Re(c(#)f) = (Re c)(#)(Re f) - (Im c)(#)(Im f) & Im(c(#)f) = (Im c
  )(#)(Re f) + (Re c)(#)(Im f);

theorem 
  -(Im f) = Re(<i>(#)f) & Re f = Im(<i>(#)f);

theorem 
  Re(f+g) = Re f + Re g & Im(f+g) = Im f + Im g;

theorem 
  Re(f-g) = Re f - Re g & Im(f-g) = Im f - Im g;

theorem 
  (Re f)|A = Re(f|A) & (Im f)|A = Im(f|A);

theorem 
  f = Re f + <i>(#)(Im f);

theorem 
  B c= A & f is_measurable_on A implies f is_measurable_on B;

theorem 
  f is_measurable_on A & f is_measurable_on B implies f is_measurable_on
  (A \/ B);

theorem 
  f is_measurable_on A & g is_measurable_on A implies f+g is_measurable_on A;

theorem 
  f is_measurable_on A & g is_measurable_on A & A c= dom g implies f-g
  is_measurable_on A;

theorem 
  Y c= dom(f+g) implies dom(f|Y+g|Y)=Y & (f+g)|Y = f|Y+g|Y;

theorem 
  f is_measurable_on B & A = dom f /\ B implies f|B is_measurable_on A;

theorem 
  dom f in S & dom g in S implies dom(f+g) in S;

theorem 
  dom f = A implies (f is_measurable_on B iff f is_measurable_on A/\B);

theorem 
  f is_measurable_on A & A c= dom f implies c(#)f is_measurable_on A;

theorem 
  ( ex A be Element of S st dom f = A ) implies for c be complex number,
  B be Element of S st f is_measurable_on B holds c(#)f is_measurable_on B;

begin 

definition
  let X be non empty set;
  let S be SigmaField of X;
  let M be sigma_Measure of S;
  let f be PartFunc of X,COMPLEX;
  pred f is_integrable_on M means


  Re f is_integrable_on M & Im f is_integrable_on M;
end;

definition
  let X be non empty set;
  let S be SigmaField of X;
  let M be sigma_Measure of S;
  let f be PartFunc of X,COMPLEX;
  assume
 f is_integrable_on M;
  func Integral(M,f) -> complex number means


  ex R,I be Real st R =
  Integral(M,Re f) & I = Integral(M,Im f) & it = R+ I*<i>;
end;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
of S, f be PartFunc of X,ExtREAL, A be Element of S st (ex E be Element of S st
  E = dom f & f is_measurable_on E) & M.A = 0 holds f|A is_integrable_on M;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
of S, f be PartFunc of X,REAL, E,A be Element of S st (ex E be Element of S st
  E = dom f & f is_measurable_on E) & M.A = 0 holds f|A is_integrable_on M;

theorem 
  (ex E be Element of S st E = dom f & f is_measurable_on E) & M.A = 0
  implies f|A is_integrable_on M & Integral(M,f|A) = 0;

theorem 
  E = dom f & f is_integrable_on M & M.A =0 implies Integral(M,f|(E\A))
  = Integral(M,f);

theorem 
  f is_integrable_on M implies f|A is_integrable_on M;

theorem 
  f is_integrable_on M & A misses B implies Integral(M,f|(A\/B)) =
  Integral(M,f|A) + Integral(M,f|B);

theorem 
  f is_integrable_on M & B = (dom f)\A implies f|A is_integrable_on M &
  Integral(M,f) = Integral(M,f|A)+Integral(M,f|B);

definition
  let k be real number, X be non empty set, f be PartFunc of X,REAL;
  func f to_power k -> PartFunc of X,REAL means


  dom it = dom f & for x
  be Element of X st x in dom it holds it.x = (f.x) to_power k;
end;

registration
  let X;
  cluster nonnegative for PartFunc of X,REAL;
end;

registration
  let k be non negative real number, X;
  let f be nonnegative PartFunc of X,REAL;
  cluster f to_power k -> nonnegative;
end;

theorem 
  for k be real number, X,S,E for f be PartFunc of X,REAL st f is
  nonnegative & 0 <= k holds (f to_power k) is nonnegative;

theorem 
  for x be set,X,S,E for f be PartFunc of X,REAL st f is
  nonnegative holds (f.x) to_power (1/2) = sqrt(f.x);

theorem 
  for f be PartFunc of X,REAL, a be Real st A c= dom f holds A /\
  less_dom(f,a) = A\(A /\ great_eq_dom(f,a));

theorem 
  for k be real number, X,S,E for f be PartFunc of X,REAL st f is
  nonnegative & 0 <= k & E c= dom f & f is_measurable_on E holds (f to_power k)
  is_measurable_on E;

theorem 
  f is_measurable_on A & A c= dom f implies |.f.| is_measurable_on A;

theorem 
  (ex A be Element of S st A = dom f & f is_measurable_on A )
  implies (f is_integrable_on M iff |.f.| is_integrable_on M);

theorem 
  f is_integrable_on M & g is_integrable_on M implies dom (f+g) in S;

theorem 
  f is_integrable_on M & g is_integrable_on M implies f+g is_integrable_on M;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
of S, f,g be PartFunc of X,REAL st f is_integrable_on M & g is_integrable_on M
  holds f-g is_integrable_on M;

theorem 
  f is_integrable_on M & g is_integrable_on M implies f-g is_integrable_on M;

theorem 
  f is_integrable_on M & g is_integrable_on M implies ex E be
Element of S st E = dom f /\ dom g & Integral(M,f+g)=Integral(M,f|E)+Integral(M
  ,g|E);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure of S,
f,g be PartFunc of X,REAL st f is_integrable_on M & g is_integrable_on M holds
  ex E be Element of S st E = dom f /\ dom g & Integral(M,f-g)=Integral(M,f|E)+
  Integral(M,(-g)|E);

theorem 
  f is_integrable_on M implies r(#)f is_integrable_on M & Integral
  (M,r(#)f) = r * Integral(M,f);

theorem 
  f is_integrable_on M implies <i>(#)f is_integrable_on M &
  Integral(M,<i>(#)f) = <i> * Integral(M,f);

theorem 
  f is_integrable_on M implies c(#)f is_integrable_on M & Integral
  (M,c(#)f) = c * Integral(M,f);

theorem 
  for f be PartFunc of X,REAL,Y,r holds (r(#)f)|Y = r(#)(f|Y);

theorem 
  for f,g be PartFunc of X,REAL st ( ex A be Element of S st A =
  dom f /\ dom g & f is_measurable_on A & g is_measurable_on A ) & f
  is_integrable_on M & g is_integrable_on M & g-f is nonnegative holds ex E be
  Element of S st E = dom f /\ dom g & Integral(M,f|E) <= Integral(M,g|E);

theorem 
  ( ex A be Element of S st A = dom f & f is_measurable_on A ) & f
  is_integrable_on M implies |. Integral(M,f).| <= Integral(M,|.f.|);

definition
  let X be non empty set;
  let S be SigmaField of X;
  let M be sigma_Measure of S;
  let f be PartFunc of X,COMPLEX;
  let B be Element of S;
  func Integral_on(M,B,f) -> complex number equals

  Integral(M,f|B);
end;

theorem 
  f is_integrable_on M & g is_integrable_on M & B c= dom(f+g) implies f+
g is_integrable_on M & Integral_on(M,B,f+g) = Integral_on(M,B,f) + Integral_on(
  M,B,g);

theorem 
  f is_integrable_on M implies Integral_on(M,B,c(#)f) = c * Integral_on( M,B,f)
;

begin 

reserve f for PartFunc of X,REAL,
  a for Real;

theorem 
  for f be PartFunc of X,REAL, a be Real st A c= dom f holds A /\
  great_eq_dom(f,a) = A\(A /\ less_dom(f,a));

theorem 
  for f be PartFunc of X,REAL, a be Real st A c= dom f holds A /\
  great_dom(f,a) = A\(A /\ less_eq_dom(f,a));

theorem 
  for f be PartFunc of X,REAL, a be Real st A c= dom f holds A /\
  less_eq_dom(f,a) = A\(A /\ great_dom(f,a));

theorem 
  A /\ eq_dom(f,a) = A /\ great_eq_dom(f,a) /\ less_eq_dom(f,a);














begin

 reserve n,m,i,p for Element of NAT,
         h,k,r,r1,r2,x,x0,x1,x2,x3 for Real;
 reserve f,f1,f2,g for Function of REAL,REAL;

theorem 
  x0>0 & x1>0 implies
  log(number_e,x0) - log(number_e,x1) = log(number_e,x0/x1);

theorem 
  x0>0 & x1>0 implies
  log(number_e,x0) + log(number_e,x1) = log(number_e,x0*x1);

theorem 
  x>0 implies log(number_e,x) = ln.x;

theorem 
  x0>0 & x1>0 implies ln.x0 - ln.x1 = ln.(x0/x1);



theorem 
  (for x holds f.x = k/(x^2)) & x0<>0 & x1<>0 & x2<>0 & x3<>0
  & x0,x1,x2,x3 are_mutually_different implies
  [!f,x0,x1,x2,x3!] = k*((1/(x1*x2*x0))*(1/x0+1/x2+1/x1)
  -(1/(x2*x1*x3))*(1/x3+1/x1+1/x2))/(x0-x3);



theorem 
  x0 in dom cot & x1 in dom cot
  implies [!cot(#)cot,x0,x1!] = -((cos(x1))^2-(cos(x0))^2)
  /(((sin(x0)*sin(x1))^2)*(x0-x1));

theorem 
  x in dom cot & x+h in dom cot implies
  fD(cot(#)cot,h).x = (1/2)*(cos(2*(x+h))-cos(2*x))/((sin(x+h)*sin(x))^2);

theorem 
  x in dom cot & x-h in dom cot implies
  bD(cot(#)cot,h).x = (1/2)*(cos(2*x)-cos(2*(h-x)))/((sin(x)*sin(x-h))^2);

theorem 
  x+h/2 in dom cot & x-h/2 in dom cot implies
  cD(cot(#)cot,h).x = (1/2)*(cos(h+2*x)-cos(h-2*x))/((sin(x+h/2)*sin(x-h/2))^2)
;



theorem 
  x0 in dom cosec & x1 in dom cosec implies
  [!cosec(#)cosec,x0,x1!] = 4*(sin(x1+x0)*sin(x1-x0))
  /((cos(x0+x1)-cos(x0-x1))^2*(x0-x1));

theorem 
  x in dom cosec & x+h in dom cosec implies
  fD(cosec(#)cosec,h).x = -4*sin(2*x+h)*sin(h)/(cos(2*x+h)-cos(h))^2;

theorem 
  x in dom cosec & x-h in dom cosec implies
  bD(cosec(#)cosec,h).x = -4*sin(2*x-h)*sin(h)/(cos(2*x-h)-cos(h))^2;

theorem 
  x+h/2 in dom cosec & x-h/2 in dom cosec implies
  cD(cosec(#)cosec,h).x = -4*sin(2*x)*sin(h)/(cos(2*x)-cos(h))^2;



theorem 
  x0 in dom sec & x1 in dom sec implies
  [!sec(#)sec,x0,x1!] = 4*(sin(x0+x1)*sin(x0-x1))
  /((cos(x0+x1)+cos(x0-x1))^2*(x0-x1));

theorem 
  x in dom sec & x+h in dom sec implies
  fD(sec(#)sec,h).x = 4*sin(2*x+h)*sin(h)/(cos(2*x+h)+cos(h))^2;

theorem 
  x in dom sec & x-h in dom sec implies
  bD(sec(#)sec,h).x = 4*sin(2*x-h)*sin(h)/(cos(2*x-h)+cos(h))^2;

theorem 
  x+h/2 in dom sec & x-h/2 in dom sec implies
  cD(sec(#)sec,h).x = 4*sin(2*x)*sin(h)/(cos(2*x)+cos(h))^2;



theorem 
  x0 in (dom cosec)/\(dom sec) & x1 in (dom cosec)/\(dom sec) implies
  [!cosec(#)sec,x0,x1!] = 4*(cos(x1+x0)*sin(x1-x0))/(sin(2*x0)*sin(2*x1))
  /(x0-x1);

theorem 
  x+h in (dom cosec)/\(dom sec) & x in (dom cosec)/\(dom sec) implies
  fD(cosec(#)sec,h).x = -4*((cos(2*x+h)*sin(h))/(sin(2*(x+h))*sin(2*x)));

theorem 
  x-h in (dom cosec)/\(dom sec) & x in (dom cosec)/\(dom sec) implies
  bD(cosec(#)sec,h).x = -4*((cos(2*x-h)*sin(h))/(sin(2*x)*sin(2*(x-h))));

theorem 
  x+h/2 in (dom cosec)/\(dom sec) & x-h/2 in (dom cosec)/\(dom sec) implies
  cD(cosec(#)sec,h).x = -4*((cos(2*x)*sin(h))/(sin(2*x+h)*sin(2*x-h)));



theorem 
  x0 in dom tan & x1 in dom tan implies
  [!tan(#)tan(#)cos,x0,x1!] = [!tan(#)sin,x0,x1!];

theorem 
  x in dom tan & x+h in dom tan implies
  fD(tan(#)tan(#)cos,h).x = (tan(#)sin).(x+h)-(tan(#)sin).x;

theorem 
  x in dom tan & x-h in dom tan implies
  bD(tan(#)tan(#)cos,h).x = (tan(#)sin).x-(tan(#)sin).(x-h);

theorem 
  x+h/2 in dom tan & x-h/2 in dom tan implies
  cD(tan(#)tan(#)cos,h).x = (tan(#)sin).(x+h/2)-(tan(#)sin).(x-h/2);



theorem 
  x0 in dom cot & x1 in dom cot implies
  [!cot(#)cot(#)sin,x0,x1!] = [!cot(#)cos,x0,x1!];

theorem 
  x in dom cot & x+h in dom cot implies
  fD(cot(#)cot(#)sin,h).x = (cot(#)cos).(x+h)-(cot(#)cos).x;

theorem 
  x in dom cot & x-h in dom cot implies
  bD(cot(#)cot(#)sin,h).x = (cot(#)cos).x-(cot(#)cos).(x-h);

theorem 
  x+h/2 in dom cot & x-h/2 in dom cot implies
  cD(cot(#)cot(#)sin,h).x = (cot(#)cos).(x+h/2)-(cot(#)cos).(x-h/2);



theorem 
  x0>0 & x1>0 implies [!ln,x0,x1!] = (ln.(x0/x1))/(x0-x1);

theorem 
  x>0 & x+h>0 implies fD(ln,h).x = ln.(1+h/x);

theorem 
  x>0 & x-h>0 implies bD(ln,h).x = ln.(1+h/(x-h));

theorem 
  x+h/2>0 & x-h/2>0 implies cD(ln,h).x = ln.(1+h/(x-h/2));

theorem 
  for h,k being real number holds
  exp_R(h-k) = exp_R(h) / exp_R(k);



theorem 
  fD(f,h).x = Shift(f,h).x - f.x;

theorem 
  (for x holds f.x = fD(g,h).x) implies
  [!f,x0,x1!] = [!g,x0+h,x1+h!]-[!g,x0,x1!];

theorem 
  fD(fD(f,h),h).x = fD(f,2*h).x-2*fD(f,h).x;

theorem 
  bD(fD(f,h),h).x = fD(f,h).x-bD(f,h).x;

theorem 
  cD(fD(f,h),h).x = fD(f,h).(x+h/2)-cD(f,h).x;

theorem 
  fdif(f,h).1.x = fdif(f,h).0.(x+h)-fdif(f,h).0.x;

theorem 
  fdif(f,h).(n+1).x = fdif(f,h).n.(x+h)-fdif(f,h).n.x;



theorem 
  bD(f,h).x = f.x - Shift(f,-h).x;

theorem 
  (for x holds f.x = bD(g,h).x) implies
  [!f,x0,x1!] = [!g,x0,x1!]-[!g,x0-h,x1-h!];

theorem 
  fD(bD(f,h),h).x = fD(f,h).x-bD(f,h).x;

theorem 
  bD(bD(f,h),h).x = 2*bD(f,h).x-bD(f,2*h).x;

theorem 
  cD(bD(f,h),h).x = cD(f,h).x-bD(f,h).(x-h/2);

theorem 
  bdif(f,h).1.x = bdif(f,h).0.x-bdif(f,h).0.(x-h);

theorem 
  bdif(f,h).(n+1).x = bdif(f,h).n.x-bdif(f,h).n.(x-h);



theorem 
  cD(f,h).x = Shift(f,h/2).x - Shift(f,-h/2).x;

theorem 
  (for x holds f.x = cD(g,h).x) implies
  [!f,x0,x1!] = [!g,x0+h/2,x1+h/2!]-[!g,x0-h/2,x1-h/2!];

theorem 
  fD(cD(f,h),h).x = fD(f,h).(x+h/2)-cD(f,h).x;

theorem 
  bD(cD(f,h),h).x = cD(f,h).x-bD(f,h).(x-h/2);

theorem 
  cD(cD(f,h),h).x = fD(f,h).x-bD(f,h).x;

theorem 
  cdif(f,h).1.x = cdif(f,h).0.(x+h/2)-cdif(f,h).0.(x-h/2);

theorem 
  cdif(f,h).(n+1).x = cdif(f,h).n.(x+h/2)-cdif(f,h).n.(x-h/2);



theorem 
  x0 in dom tan & x1 in dom tan implies
  [!tan(#)tan(#)sin,x0,x1!] = ((sin(x0))|^3*(cos(x1))^2
  -(sin(x1))|^3*(cos(x0))^2)/((cos(x0))^2*(cos(x1))^2*(x0-x1));

theorem 
  x in dom tan & x+h in dom tan implies
  fD(tan(#)tan(#)sin,h).x = sin.(x+h)|^3*(cos.(x+h))"|^2 - sin.x|^3*(cos.x)"|^2
;

theorem 
  x in dom tan & x-h in dom tan implies
  bD(tan(#)tan(#)sin,h).x = sin.x|^3*(cos.x)"|^2 - sin.(x-h)|^3*(cos.(x-h))"|^2
;

theorem 
  x+h/2 in dom tan & x-h/2 in dom tan implies
  cD(tan(#)tan(#)sin,h).x = sin.(x+h/2)|^3*(cos.(x+h/2))"|^2
  -sin.(x-h/2)|^3*(cos.(x-h/2))"|^2;



theorem 
  x0 in dom cot & x1 in dom cot implies
  [!cot(#)cot(#)cos,x0,x1!] = ((cos(x0))|^3*(sin(x1))^2-(cos(x1))|^3
  *(sin(x0))^2)/((sin(x0))^2*(sin(x1))^2*(x0-x1));

theorem 
  x in dom cot & x+h in dom cot implies
  fD(cot(#)cot(#)cos,h).x = cos.(x+h)|^3*(sin.(x+h))"|^2 - cos.x|^3*(sin.x)"|^2
;

theorem 
  x in dom cot & x-h in dom cot implies
  bD(cot(#)cot(#)cos,h).x = cos.x|^3*(sin.x)"|^2 - cos.(x-h)|^3*(sin.(x-h))"|^2
;

theorem 
  x+h/2 in dom cot & x-h/2 in dom cot implies
  cD(cot(#)cot(#)cos,h).x = cos.(x+h/2)|^3*(sin.(x+h/2))"|^2
  - cos.(x-h/2)|^3*(sin.(x-h/2))"|^2;















begin 


reserve n,m,k for Element of NAT;
reserve X for non empty Subset of ExtREAL;
reserve Y for non empty Subset of REAL;

theorem 
  X = Y & Y is bounded_above implies X is bounded_above & sup X = upper_bound Y
;

theorem 
  X = Y & X is bounded_above implies Y is bounded_above & sup X = upper_bound Y
;

theorem 
  X = Y & Y is bounded_below implies X is bounded_below & inf X = lower_bound Y
;

theorem 
  X = Y & X is bounded_below implies Y is bounded_below & inf X = lower_bound Y
;

definition
  let seq be ExtREAL_sequence;
  func sup seq -> Element of ExtREAL equals

  sup rng seq;
  func inf seq -> Element of ExtREAL equals

  inf rng seq;
end;

definition
  let seq be ExtREAL_sequence;
  attr seq is bounded_below means


  rng seq is bounded_below;
  attr seq is bounded_above means


  rng seq is bounded_above;
end;

definition
  let seq be ExtREAL_sequence;
  attr seq is bounded means


  seq is bounded_above & seq is bounded_below;
end;

reserve seq for ExtREAL_sequence;

theorem 
  for seq,n holds {seq.k where k is Element of NAT: n <= k} is non
  empty Subset of ExtREAL;

definition
  let seq be ExtREAL_sequence;
  func inferior_realsequence seq -> ExtREAL_sequence means


  for n be
Element of NAT ex Y being non empty Subset of ExtREAL st Y = {seq.k where k is
  Element of NAT : n <= k} & it.n = inf Y;
end;

definition
  let seq be ExtREAL_sequence;
  func superior_realsequence seq -> ExtREAL_sequence means


  for n be
Element of NAT ex Y being non empty Subset of ExtREAL st Y = {seq.k where k is
  Element of NAT: n <= k} & it.n = sup Y;
end;

theorem 
  seq is real-valued implies seq is Real_Sequence;

reserve e1,e2 for ext-real number;

theorem 
  (seq is increasing iff for n,m be Element of NAT st m<n holds seq
.m<seq.n) & (seq is decreasing iff for n,m be Element of NAT st m<n holds seq.n
  <seq.m) & (seq is non-decreasing iff for n,m be Element of NAT st m<=n holds
  seq.m<=seq.n) & (seq is non-increasing iff for n,m be Element of NAT st m<=n
  holds seq.n<=seq.m);

theorem 
  (inferior_realsequence seq).n <= seq.n & seq.n <= (
  superior_realsequence seq).n;

registration
  let seq;
  cluster superior_realsequence seq -> non-increasing;
  cluster inferior_realsequence seq -> non-decreasing;
end;

definition

  let seq be ExtREAL_sequence;
  func lim_sup seq -> Element of ExtREAL equals

  inf superior_realsequence seq;
  func lim_inf seq -> Element of ExtREAL equals

  sup inferior_realsequence seq;
end;

reserve rseq for Real_Sequence;

theorem 
  seq = rseq & rseq is bounded implies superior_realsequence seq =
  superior_realsequence rseq & lim_sup seq = lim_sup rseq;

theorem 
  seq = rseq & rseq is bounded implies inferior_realsequence seq =
  inferior_realsequence rseq & lim_inf seq=lim_inf rseq;

theorem 
  seq is bounded implies seq is Real_Sequence;

theorem 
  seq = rseq implies (seq is bounded_above iff rseq is bounded_above);

theorem 
  seq = rseq implies (seq is bounded_below iff rseq is bounded_below);

theorem 
  seq=rseq & rseq is convergent implies seq is
  convergent_to_finite_number & seq is convergent & lim seq = lim rseq;

theorem 
  seq=rseq & seq is convergent_to_finite_number implies rseq is
  convergent & lim seq = lim rseq;

theorem 
  seq^\k is convergent_to_finite_number implies seq is
  convergent_to_finite_number & seq is convergent & lim seq = lim(seq^\k);

theorem 
  seq^\k is convergent implies seq is convergent & lim seq = lim( seq^\k);

theorem 
  lim_sup seq = lim_inf seq & lim_inf seq in REAL implies ex k st
  seq^\k is bounded;

theorem 
  seq is convergent_to_finite_number implies ex k st seq^\k is bounded;

theorem 
  seq is convergent_to_finite_number implies seq^\k is
  convergent_to_finite_number & seq^\k is convergent & lim seq = lim(seq^\k);

theorem 
  seq is convergent implies seq^\k is convergent & lim seq = lim(seq^\k);

theorem 
  (seq is bounded_above implies seq^\k is bounded_above) & (seq is
  bounded_below implies seq^\k is bounded_below);

theorem 
  inf seq <= seq.n & seq.n <= sup seq;

theorem 
  inf seq <= sup seq;

theorem 
  seq is non-increasing implies seq^\k is non-increasing & inf seq
  = inf(seq^\k);

theorem 
  seq is non-decreasing implies seq^\k is non-decreasing & sup seq
  = sup(seq^\k);

theorem 
  (superior_realsequence seq).n = sup(seq^\n) & (inferior_realsequence
  seq).n = inf(seq^\n);

theorem 
  for seq be ExtREAL_sequence,j be Element of NAT holds
superior_realsequence (seq^\j) = (superior_realsequence seq)^\j & lim_sup (seq
  ^\j) = lim_sup seq;

theorem 
  for seq be ExtREAL_sequence,j be Element of NAT holds
inferior_realsequence (seq^\j) = (inferior_realsequence seq)^\j & lim_inf (seq
  ^\j) = lim_inf seq;

theorem 
  for seq be ExtREAL_sequence, k be Element of NAT st seq is
non-increasing & -infty < seq.k & seq.k < +infty holds seq^\k is bounded_above
  & sup(seq^\k) = seq.k;

theorem 
  for seq be ExtREAL_sequence, k be Element of NAT st seq is
non-decreasing & -infty < seq.k & seq.k < +infty holds seq^\k is bounded_below
  & inf (seq^\k) = seq.k;

theorem 
  for seq be ExtREAL_sequence st (for n be Element of NAT holds
  +infty <= seq.n) holds seq is convergent_to_+infty;

theorem 
  for seq be ExtREAL_sequence st (for n be Element of NAT holds
  seq.n <= -infty) holds seq is convergent_to_-infty;

theorem 
  for seq be ExtREAL_sequence st seq is non-increasing & -infty =
  inf seq holds seq is convergent_to_-infty & lim seq = -infty;

theorem 
  for seq be ExtREAL_sequence st seq is non-decreasing & +infty =
  sup seq holds seq is convergent_to_+infty & lim seq = +infty;

theorem 
  for seq be ExtREAL_sequence st seq is non-increasing holds seq
  is convergent & lim seq = inf seq;

theorem 
  for seq be ExtREAL_sequence st seq is non-decreasing holds seq
  is convergent & lim seq = sup seq;

theorem 
  for seq1,seq2 be ExtREAL_sequence st seq1 is convergent & seq2
is convergent & (for n be Element of NAT holds seq1.n <=seq2.n) holds lim seq1
  <= lim seq2;

theorem 
  for seq be ExtREAL_sequence holds lim_inf seq <= lim_sup seq;

theorem 
  for seq be ExtREAL_sequence holds seq is convergent iff lim_inf
  seq = lim_sup seq;

theorem 
  for seq be ExtREAL_sequence st seq is convergent holds lim seq =
  lim_inf seq & lim seq = lim_sup seq;














begin

reserve n,k for Nat,
  X for non empty set,
  S for SigmaField of X;

theorem 
  for M be sigma_Measure of S, F be Function of NAT,S, n holds {x
  where x is Element of X : for k st n <= k holds x in F.k } is Element of S;

theorem 
  for F be SetSequence of X, n be Element of NAT holds (
superior_setsequence F).n = union rng(F^\n) & (inferior_setsequence F).n = meet
  rng(F^\n);

theorem 
  for M be sigma_Measure of S, F be SetSequence of S ex G be
Function of NAT,S st G = inferior_setsequence F & M.(lim_inf F) = sup rng(M*G);

theorem 
  for M be sigma_Measure of S, F be SetSequence of S st M.(Union F)
  < +infty holds ex G be Function of NAT,S st G= superior_setsequence F & M.(
  lim_sup F) = inf rng(M*G);

theorem 
  for M be sigma_Measure of S, F be SetSequence of S st F is convergent
holds ex G be Function of NAT,S st G= inferior_setsequence F & M.(lim F) = sup
  rng (M*G);

theorem 
  for M be sigma_Measure of S, F be SetSequence of S st F is convergent
  & M.(Union F) < +infty holds ex G be Function of NAT,S st G =
  superior_setsequence F & M.(lim F) = inf rng(M*G);

definition
  let X,Y be set, F be Functional_Sequence of X,Y;
  attr F is with_the_same_dom means


  rng F is with_common_domain;
end;

definition
  let X,Y be set, F be Functional_Sequence of X,Y;
  redefine attr F is with_the_same_dom means


  for n,m be Nat holds dom(F.n) = dom(F.m);
end;

registration
  let X,Y be set;
  cluster with_the_same_dom for Functional_Sequence of X,Y;
end;

definition
  let X be non empty set, f be Functional_Sequence of X,ExtREAL;
  func inf f -> PartFunc of X,ExtREAL means


  dom it = dom(f.0) & for x
  be Element of X st x in dom it holds it.x = inf(f#x);
end;

definition
  let X be non empty set, f be Functional_Sequence of X,ExtREAL;
  func sup f -> PartFunc of X,ExtREAL means


  dom it = dom(f.0) & for x
  be Element of X st x in dom it holds it.x = sup(f#x);
end;

definition
  let X be non empty set, f be Functional_Sequence of X,ExtREAL;
  func inferior_realsequence f -> with_the_same_dom Functional_Sequence of X,
  ExtREAL means


  for n be Nat holds dom(it.n) = dom(f.0) & for x
be Element of X st x in dom(it.n) holds (it.n).x=(inferior_realsequence(f#x)).n
  ;
end;

definition
  let X be non empty set, f be Functional_Sequence of X,ExtREAL;
  func superior_realsequence f -> with_the_same_dom Functional_Sequence of X,
  ExtREAL means


  for n be Nat holds dom(it.n) = dom(f.0) & for x
be Element of X st x in dom(it.n) holds (it.n).x = (superior_realsequence(f#x))
  .n;
end;

theorem 
  for f be Functional_Sequence of X,ExtREAL holds for x be Element
  of X st x in dom (f.0) holds (inferior_realsequence f)#x =
  inferior_realsequence(f#x);

registration
  let X,Y be set;
  let f be with_the_same_dom Functional_Sequence of X,Y;
  let n be Element of NAT;
  cluster f^\n -> with_the_same_dom for Functional_Sequence of X,Y;
end;

theorem 
  for f be with_the_same_dom Functional_Sequence of X,ExtREAL, n be
  Element of NAT holds (inferior_realsequence f).n = inf(f^\n);

theorem 
  for f be with_the_same_dom Functional_Sequence of X,ExtREAL, n be
  Element of NAT holds (superior_realsequence f).n = sup(f^\n);

theorem 
  for f be Functional_Sequence of X,ExtREAL, x be Element of X st
  x in dom(f.0) holds (superior_realsequence f)#x = superior_realsequence(f#x);

definition

  let X be non empty set, f be Functional_Sequence of X,ExtREAL;
  func lim_inf f -> PartFunc of X,ExtREAL means


  dom it = dom (f.0) &
  for x be Element of X st x in dom it holds it.x = lim_inf(f#x);
end;

definition
  let X be non empty set, f be Functional_Sequence of X,ExtREAL;
  func lim_sup f -> PartFunc of X,ExtREAL means


  dom it = dom (f.0) &
  for x be Element of X st x in dom it holds it.x = lim_sup(f#x);
end;

theorem 
  for f be Functional_Sequence of X,ExtREAL holds (for x be
  Element of X st x in dom lim_inf f holds (lim_inf f).x=sup
inferior_realsequence(f#x) & (lim_inf f).x=sup ((inferior_realsequence f)#x) &
  (lim_inf f).x=sup (inferior_realsequence f).x ) & lim_inf f = sup
  inferior_realsequence f;

theorem 
  for f be Functional_Sequence of X,ExtREAL holds (for x be
  Element of X st x in dom lim_sup f holds (lim_sup f).x=inf
superior_realsequence(f#x) & (lim_sup f).x=inf ((superior_realsequence f)#x) &
  (lim_sup f).x=inf (superior_realsequence f).x ) & lim_sup f = inf
  superior_realsequence f;

theorem 
  for f be Functional_Sequence of X,ExtREAL, x be Element of X st x in
  dom (f.0) holds f#x is convergent iff (lim_sup f).x = (lim_inf f).x;

definition
  let X be non empty set, f be Functional_Sequence of X,ExtREAL;
  func lim f -> PartFunc of X,ExtREAL means


  dom it = dom (f.0) & for x
  be Element of X st x in dom it holds it.x=lim(f#x);
end;

theorem 
  for f be Functional_Sequence of X,ExtREAL, x be Element of X st
x in dom lim f & f#x is convergent holds (lim f).x= (lim_sup f).x & (lim f).x =
  (lim_inf f).x;

theorem 
  for f be with_the_same_dom Functional_Sequence of X,ExtREAL, F
  be SetSequence of S, r be real number st (for n be Nat holds F.n =
dom(f.0) /\ great_dom(f.n,R_EAL r))
 holds union rng F = dom(f.0) /\ great_dom(sup f,R_EAL r);

theorem 
  for f be with_the_same_dom Functional_Sequence of X,ExtREAL, F
  be SetSequence of S, r be real number st (for n be Nat holds F.n =
  dom(f.0) /\ great_eq_dom(f.n,R_EAL r)) holds meet rng F = dom(f.0) /\
  great_eq_dom(inf f,R_EAL r);

theorem 
  for f be with_the_same_dom Functional_Sequence of X,ExtREAL, F
  be SetSequence of S, r be real number st (for n be Nat holds F.n =
  dom(f.0) /\ great_dom(f.n,R_EAL r)) holds for n be Nat holds (
superior_setsequence F).n = dom(f.0) /\ great_dom((superior_realsequence f).n,
  R_EAL r);

theorem 
  for f be with_the_same_dom Functional_Sequence of X,ExtREAL, F
  be SetSequence of S, r be real number st (for n be Nat holds F.n =
  dom(f.0) /\ great_eq_dom(f.n,R_EAL r)) holds for n be Nat holds (
inferior_setsequence F).n = dom(f.0) /\ great_eq_dom((inferior_realsequence f).
  n,R_EAL r);

theorem 
  for f be with_the_same_dom Functional_Sequence of X,ExtREAL, E
  be Element of S st dom (f.0) = E & (for n be Nat holds f.n
  is_measurable_on E) holds for n holds (superior_realsequence f).n
  is_measurable_on E;

theorem 
  for f be with_the_same_dom Functional_Sequence of X,ExtREAL, E
  be Element of S st dom (f.0) = E & (for n be Nat holds f.n
is_measurable_on E) holds for n be Nat holds (inferior_realsequence
  f).n is_measurable_on E;

theorem 
  for f be Functional_Sequence of X,ExtREAL, F be SetSequence of S
  , r be real number st (for n be Nat holds F.n = dom(f.0) /\
  great_eq_dom((superior_realsequence f).n,R_EAL r)) holds meet F = dom(f.0) /\
  great_eq_dom(lim_sup f,R_EAL r);

theorem 
  for f be Functional_Sequence of X,ExtREAL, F be SetSequence of S
, r be real number st (for n be Nat holds F.n= dom(f.0) /\ great_dom
  ((inferior_realsequence f).n,R_EAL r)) holds union rng F = dom(f.0) /\
  great_dom(lim_inf f,R_EAL r);

theorem 
  for f be with_the_same_dom Functional_Sequence of X,ExtREAL, E
  be Element of S st dom (f.0) = E & (for n be Nat holds f.n
  is_measurable_on E) holds lim_sup f is_measurable_on E;

theorem 
  for f be with_the_same_dom Functional_Sequence of X,ExtREAL, E be
  Element of S st dom(f.0) = E & (for n be Nat holds f.n
  is_measurable_on E) holds lim_inf f is_measurable_on E;

theorem 
  for f be with_the_same_dom Functional_Sequence of X,ExtREAL, E
  be Element of S st dom(f.0) = E & (for n be Nat holds f.n
is_measurable_on E) & (for x be Element of X st x in E holds f#x is convergent)
  holds lim f is_measurable_on E;

theorem 
  for f be with_the_same_dom Functional_Sequence of X,ExtREAL, g
be PartFunc of X,ExtREAL, E be Element of S st dom(f.0) = E & (for n be Nat
  holds f.n is_measurable_on E) & dom g = E & for x be Element of X st x
  in E holds f#x is convergent & g.x = lim(f#x) holds g is_measurable_on E;

theorem 
  for f be Functional_Sequence of X,ExtREAL, g be PartFunc of X,
  ExtREAL st for x be Element of X st x in dom g holds f#x is
  convergent_to_finite_number & g.x = lim (f#x) holds g is real-valued;

begin 

theorem 
  for M be sigma_Measure of S, f be with_the_same_dom
Functional_Sequence of X,ExtREAL, g be PartFunc of X,ExtREAL, E be Element of S
  st M.E < +infty & dom(f.0) = E & (for n be Nat holds f.n
is_measurable_on E & f.n is real-valued) & dom g = E & for x be Element of X st
x in E holds f#x is convergent_to_finite_number & g.x = lim(f#x) holds for r,e
be real number st 0 < r & 0 < e ex H be Element of S, N be Nat st H
  c= E & M.H < r & for k be Nat st N < k holds for x be Element of X
  st x in E\H holds |. (f.k).x - g.x .| < e;

theorem 
  for X,Y be non empty set, E be set, F,G be Function of X,Y st for x be
  Element of X holds G.x = E \ F.x holds union rng G = E \ meet rng F;


theorem 
  for M be sigma_Measure of S, f be with_the_same_dom
Functional_Sequence of X,ExtREAL, g be PartFunc of X,ExtREAL, E be Element of S
st (dom (f.0) = E & for n be Nat holds f.n is_measurable_on E) & M.E
< +infty & (for n be Nat holds ex L be Element of S st L c= E & M.(E
\L) = 0 & for x be Element of X st x in L holds |. (f.n).x .| < +infty) & ex G
  be Element of S st G c= E & M.(E\G) = 0 & (for x be Element of X st x in E
holds f#x is convergent_to_finite_number) & dom g = E & (for x be Element of X
  st x in G holds g.x = lim (f#x)) holds for e be real number st 0 < e ex F be
  Element of S st F c= E & M.(E\F) <= e & for p be real number st 0 < p ex N be
Nat st for n be Nat st N < n holds for x be Element of X
  st x in F holds |. (f.n).x - g.x .| < p;














begin 

reserve X for non empty set,
  S for SigmaField of X,
  M for sigma_Measure of S,
  E for Element of S,
  F,G for Functional_Sequence of X,ExtREAL,
  I for ExtREAL_sequence,
  f,g for PartFunc of X,ExtREAL,
  seq, seq1, seq2 for ExtREAL_sequence,
  p for ext-real number,
  n,m for Nat,
  x for Element of X,
  z,D for set;

theorem 
  f is without+infty & g is without+infty implies dom(f+g)=dom f /\ dom g;

theorem 
  f is without+infty & g is without-infty implies dom(f-g)=dom f /\ dom g;

theorem 
  f is without-infty & g is without-infty implies f+g is without-infty;

theorem 
  f is without+infty & g is without+infty implies f+g is without+infty;

theorem 
  f is without-infty & g is without+infty implies f-g is without-infty;

theorem 
  f is without+infty & g is without-infty implies f-g is without+infty;

theorem 
  ( seq is convergent_to_finite_number implies ex g be real number
st lim seq = g & for p be real number st 0<p ex n be Nat st for m be Nat st n<=
m holds |. seq.m - lim seq .| < p ) & ( seq is convergent_to_+infty implies lim
  seq = +infty ) & ( seq is convergent_to_-infty implies lim seq = -infty );

theorem 
  seq is nonnegative implies not seq is convergent_to_-infty;

theorem 
  seq is convergent & (for k be Nat holds seq.k <= p) implies lim seq <= p;

theorem 
  seq is convergent & (for k be Nat holds p <= seq.k) implies p <= lim seq;

theorem 
  seq1 is convergent & seq2 is convergent & seq1 is nonnegative &
seq2 is nonnegative & (for k be Nat holds seq.k = seq1.k + seq2.k) implies seq
  is nonnegative & seq is convergent & lim seq = lim seq1 + lim seq2;

theorem 
  (for n be Nat holds G.n = (F.n)|D) & x in D implies (F#x is
  convergent_to_+infty implies G#x is convergent_to_+infty) & (F#x is
  convergent_to_-infty implies G#x is convergent_to_-infty) & (F#x is
convergent_to_finite_number implies G#x is convergent_to_finite_number) & (F#x
  is convergent implies G#x is convergent);

theorem 
  E = dom f & f is_measurable_on E & f is nonnegative & M.(E /\
  eq_dom(f,+infty)) <> 0 implies Integral(M,f) = +infty;

theorem 
  Integral(M,chi(E,X)) = M.E & Integral(M,(chi(E,X))|E) = M.E;

theorem 
  E c= dom f & E c= dom g & f is_measurable_on E & g
is_measurable_on E & f is nonnegative & (for x be Element of X st x in E holds
  f.x <= g.x) implies Integral(M,f|E) <= Integral(M,g|E);

begin 

definition
  let f be ext-real-valued Function, x be set;
  redefine func f.x -> Element of ExtREAL;
end;

definition
  let s be ext-real-valued Function;
  func Partial_Sums s -> ExtREAL_sequence means


  it.0=s.0 & for n be Nat holds it.(n+1) = it.n + s.(n+1);
end;

definition
  let s be ext-real-valued Function;
  attr s is summable means


  Partial_Sums s is convergent;
end;

definition
  let s be ext-real-valued Function;
  func Sum s -> R_eal equals

  lim Partial_Sums s;
end;

theorem 
  seq is nonnegative implies Partial_Sums seq is nonnegative &
  Partial_Sums seq is non-decreasing;

theorem 
  (for n be Nat holds 0 < seq.n) implies for m be Nat holds 0 < (
  Partial_Sums seq).m;

theorem 
  F is with_the_same_dom & (for n be Nat holds G.n = (F.n)|D)
  implies G is with_the_same_dom;

theorem 
  D c= dom(F.0) & (for n be Nat holds G.n = (F.n)|D) & (for x be
  Element of X st x in D holds F#x is convergent) implies (lim F)|D = lim G;

theorem 
  F is with_the_same_dom & E c= dom(F.0) & (for m be Nat holds F.m
  is_measurable_on E & G.m= (F.m)|E) implies G.n is_measurable_on E;

theorem 
  E c= dom(F.0) & G is with_the_same_dom & (for x be Element of X
  st x in E holds F#x is summable) & (for n be Nat holds G.n= (F.n)|E) implies
  for x be Element of X st x in E holds G#x is summable;

begin 

definition
  let X be non empty set, F be Functional_Sequence of X,ExtREAL;
  func Partial_Sums F -> Functional_Sequence of X,ExtREAL means


  it.0 = F.0 & for n be Nat holds it.(n+1) = it.n + F.(n+1);
end;

definition
  let X be set, F be Functional_Sequence of X,ExtREAL;
  attr F is additive means


  for n,m be Nat st n <> m holds for x be set
  st x in dom(F.n) /\ dom(F.m) holds (F.n).x <> +infty or (F.m).x <> -infty;
end;

theorem 
  z in dom((Partial_Sums F).n) & m <= n implies z in dom((
  Partial_Sums F).m) & z in dom(F.m);

theorem 
  z in dom((Partial_Sums F).n) & ((Partial_Sums F).n).z = +infty
  implies ex m be Nat st m <= n & (F.m).z = +infty;

theorem 
  F is additive & z in dom((Partial_Sums F).n) & ((Partial_Sums F).n).z
  = +infty & m <= n implies (F.m).z <> -infty;

theorem 
  z in dom((Partial_Sums F).n) & ((Partial_Sums F).n).z = -infty
  implies ex m be Nat st m <= n & (F.m).z = -infty;

theorem 
  F is additive & z in dom((Partial_Sums F).n) & ((Partial_Sums F).n).z
  = -infty & m <= n implies (F.m).z <> +infty;

theorem 
  F is additive implies ((Partial_Sums F).n)"{-infty} /\ (F.(n+1))
  "{+infty} = {} & ((Partial_Sums F).n)"{+infty} /\ (F.(n+1))"{-infty} = {};

theorem 
  F is additive implies dom((Partial_Sums F).n) = meet{dom(F.k)
  where k is Element of NAT : k <= n};

theorem 
  F is additive & F is with_the_same_dom implies dom((Partial_Sums
  F).n) = dom(F.0);

theorem 
  (for n be Nat holds F.n is nonnegative) implies F is additive;

theorem 
  F is additive & (for n holds G.n = (F.n)|D) implies G is additive;

theorem 
  F is additive & F is with_the_same_dom & D c= dom(F.0) & x in D
  implies (Partial_Sums(F#x)).n = ((Partial_Sums F)#x).n;

theorem 
  F is additive & F is with_the_same_dom & D c= dom(F.0) & x in D
implies ( Partial_Sums(F#x) is convergent_to_finite_number iff (Partial_Sums F)
  #x is convergent_to_finite_number ) & ( Partial_Sums(F#x) is
  convergent_to_+infty iff (Partial_Sums F)#x is convergent_to_+infty ) & (
  Partial_Sums(F#x) is convergent_to_-infty iff (Partial_Sums F)#x is
convergent_to_-infty ) & ( Partial_Sums(F#x) is convergent iff (Partial_Sums F)
  #x is convergent );

theorem 
  F is additive & F is with_the_same_dom & dom f c= dom(F.0) & x
in dom f & F#x is summable & f.x = Sum(F#x) implies f.x = lim((Partial_Sums F)#
  x);

theorem 
  (for m be Nat holds F.m is_simple_func_in S) implies F is
  additive & (Partial_Sums F).n is_simple_func_in S;

theorem 
  (for m be Nat holds F.m is nonnegative) implies (Partial_Sums F)
  .n is nonnegative;

theorem 
  F is with_the_same_dom & x in dom(F.0) & (for k be Nat holds F.k
is nonnegative) & n <= m implies ((Partial_Sums F).n).x <= ((Partial_Sums F).m)
  .x;

theorem 
  F is with_the_same_dom & x in dom(F.0) & (for m be Nat holds F.m
is nonnegative) implies (Partial_Sums F)#x is non-decreasing & (Partial_Sums F)
  #x is convergent;

theorem 
  (for m be Nat holds F.m is without-infty) implies (Partial_Sums
  F).n is without-infty;

theorem 
  (for m be Nat holds F.m is without+infty) implies (Partial_Sums F).n
  is without+infty;

theorem 
  (for n be Nat holds F.n is_measurable_on E & F.n is
  without-infty) implies (Partial_Sums F).m is_measurable_on E;

theorem 
  F is additive & F is with_the_same_dom & G is additive & G is
with_the_same_dom & x in dom(F.0) /\ dom(G.0) & (for k be Nat, y be Element of
X st y in dom(F.0) /\ dom(G.0) holds (F.k).y <= (G.k).y) implies ((Partial_Sums
  F).n).x <= ((Partial_Sums G).n).x;

theorem 
  for X be non empty set, F be Functional_Sequence of X,ExtREAL st
  F is additive & F is with_the_same_dom holds Partial_Sums F is
  with_the_same_dom;

theorem 
  dom(F.0) = E & F is additive & F is with_the_same_dom & (for n
be Nat holds (Partial_Sums F).n is_measurable_on E) & (for x be Element of X st
  x in E holds F#x is summable) implies lim(Partial_Sums F) is_measurable_on E;

theorem 
  (for n be Nat holds F.n is_integrable_on M) implies for m be Nat holds
  (Partial_Sums F).m is_integrable_on M;

theorem 
  E = dom(F.0) & F is additive & F is with_the_same_dom & (for n
be Nat holds F.n is_measurable_on E & F.n is nonnegative & I.n = Integral(M,F.n
  )) implies Integral(M,(Partial_Sums F).m) = (Partial_Sums I).m;

begin

theorem 
  E c= dom f & f is nonnegative & f is_measurable_on E & F is additive &
(for n holds F.n is_simple_func_in S & F.n is nonnegative & E c= dom(F.n)) & (
  for x st x in E holds F#x is summable & f.x = Sum(F#x)) implies ex I be
  ExtREAL_sequence st (for n holds I.n = Integral(M,(F.n)|E)) & I is summable &
  Integral(M,f|E) = Sum I;

theorem 
  E c= dom f & f is nonnegative & f is_measurable_on E implies ex g be
  Functional_Sequence of X,ExtREAL st g is additive & (for n be Nat holds g.n
is_simple_func_in S & g.n is nonnegative & g.n is_measurable_on E) & (for x be
  Element of X st x in E holds g#x is summable & f.x = Sum(g#x)) & ex I be
  ExtREAL_sequence st (for n be Nat holds I.n = Integral(M,(g.n)|E)) & I is
  summable & Integral(M,f|E) = Sum I;

registration
  let X be non empty set;
  cluster additive with_the_same_dom for Functional_Sequence of X,ExtREAL;
end;

definition
  let C,D,X be non empty set, F be Function of [:C,D:],PFuncs(X,ExtREAL);
  let c be Element of C, d be Element of D;
  redefine func F.(c,d) -> PartFunc of X,ExtREAL;
end;

definition
  let C,D,X be non empty set;
  let F be Function of [:C,D:],X;
  let c be Element of C;
  func ProjMap1(F,c) -> Function of D,X means

  for d be Element of D holds it.d = F.(c,d);
end;

definition
  let C,D,X be non empty set;
  let F be Function of [:C,D:],X;
  let d be Element of D;
  func ProjMap2(F,d) -> Function of C,X means

  for c be Element of C holds it.c = F.(c,d);
end;

definition
  let X,Y be set, F be Function of [:NAT,NAT:],PFuncs(X,Y), n be Nat;
  func ProjMap1(F,n) -> Functional_Sequence of X,Y means


  for m be Nat holds it.m = F.(n,m);
  func ProjMap2(F,n) -> Functional_Sequence of X,Y means


  for m be Nat holds it.m = F.(m,n);
end;

definition
  let X be non empty set, F be Function of NAT,Funcs(NAT,PFuncs(X,ExtREAL)), n
  be Nat;
  redefine func F.n -> Functional_Sequence of X,ExtREAL;
end;

theorem 
  E = dom(F.0) & F is with_the_same_dom & (for n be Nat holds F.n
  is nonnegative & F.n is_measurable_on E ) implies ex FF be Function of NAT,
Funcs(NAT,PFuncs(X,ExtREAL)) st for n be Nat holds (for m be Nat holds (FF.n).m
is_simple_func_in S & dom((FF.n).m) = dom(F.n)) & (for m be Nat holds (FF.n).m
is nonnegative) & (for j,k be Nat st j <= k holds for x be Element of X st x in
  dom(F.n) holds ((FF.n).j).x <= ((FF.n).k).x) & for x be Element of X st x in
  dom(F.n) holds (FF.n)#x is convergent & lim((FF.n)#x) = (F.n).x;

theorem 
  E = dom(F.0) & F is additive & F is with_the_same_dom & (for n
  be Nat holds F.n is_measurable_on E & F.n is nonnegative) implies ex I be
  ExtREAL_sequence st for n be Nat holds I.n = Integral(M,F.n) & Integral(M,(
  Partial_Sums F).n) = (Partial_Sums I).n;

theorem 
  E c= dom(F.0) & F is additive & F is with_the_same_dom & (for n
  be Nat holds F.n is nonnegative & F.n is_measurable_on E) & (for x be Element
of X st x in E holds F#x is summable) implies ex I be ExtREAL_sequence st (for
  n be Nat holds I.n = Integral(M,(F.n)|E)) & I is summable & Integral(M,(lim(
  Partial_Sums F))|E) = Sum I;




theorem 
  E = dom(F.0) & F.0 is nonnegative & F is with_the_same_dom & (for n be
  Nat holds F.n is_measurable_on E) & (for n,m be Nat st n <=m holds for x be
Element of X st x in E holds (F.n).x <= (F.m).x ) & (for x be Element of X st x
in E holds F#x is convergent) implies ex I be ExtREAL_sequence st (for n be Nat
  holds I.n = Integral(M,F.n)) & I is convergent & Integral(M,lim F) = lim I;














begin 

reserve X for non empty set,
  F for with_the_same_dom Functional_Sequence of X, ExtREAL,
  seq,seq1,seq2 for ExtREAL_sequence,
  x for Element of X,
  a,r for R_eal,
  n,m,k for Nat;

theorem 
  (for n be Nat holds seq1.n <= seq2.n) implies inf rng seq1 <= inf rng seq2;

theorem 
  (for n be Nat holds seq1.n <= seq2.n) implies (
  inferior_realsequence seq1).k <= (inferior_realsequence seq2).k & (
  superior_realsequence seq1).k <= (superior_realsequence seq2).k;

theorem 
  (for n be Nat holds seq1.n <= seq2.n) implies lim_inf seq1 <=
  lim_inf seq2 & lim_sup seq1 <= lim_sup seq2;

theorem 
  (for n be Nat holds seq.n >= a) implies inf seq >= a;

theorem 
  (for n be Nat holds seq.n <= a) implies sup seq <= a;

theorem 
  for n be Element of NAT st x in dom inf(F^\n) holds (inf(F^\n)).x
  =inf((F#x)^\n);

reserve S for SigmaField of X,
  M for sigma_Measure of S,
  E for Element of S;


theorem 
  E = dom(F.0) & (for n holds F.n is nonnegative & F.n
  is_measurable_on E) implies ex I be ExtREAL_sequence st (for n holds I.n =
  Integral(M,F.n)) & Integral(M,lim_inf F) <= lim_inf I;

begin 

theorem 
  for Y being non empty Subset of ExtREAL, r be R_eal st r in REAL
  holds sup({r} + Y) = sup {r} + sup Y;

theorem 
  for Y being non empty Subset of ExtREAL, r be R_eal st r in REAL
  holds inf({r} + Y) = inf {r} + inf Y;

theorem 
  r in REAL & (for n be Nat holds seq1.n = r + seq2.n) implies
  lim_inf seq1 = r + lim_inf seq2 & lim_sup seq1 = r + lim_sup seq2;

reserve F1,F2 for Functional_Sequence of X,ExtREAL,
  f,g,P for PartFunc of X, ExtREAL;

theorem 
  dom(F1.0) = dom(F2.0) & F1 is with_the_same_dom & f"{+infty} =
{} & f"{-infty} = {} & (for n be Nat holds F1.n = f + F2.n) implies lim_inf F1
  = f + lim_inf F2 & lim_sup F1 = f + lim_sup F2;

theorem 
  f is_integrable_on M & g is_integrable_on M implies f-g is_integrable_on M;

theorem 
  f is_integrable_on M & g is_integrable_on M implies ex E be
Element of S st E = dom f /\ dom g & Integral(M,f-g)=Integral(M,f|E)+Integral(M
  ,(-g)|E);

theorem 
  (for n be Nat holds seq1.n = -seq2.n) implies lim_inf seq2 = -
  lim_sup seq1 & lim_sup seq2 = -lim_inf seq1;

theorem 
  dom(F1.0) = dom(F2.0) & F1 is with_the_same_dom & (for n be Nat
  holds F1.n = - F2.n) implies lim_inf F1 = -lim_sup F2 & lim_sup F1 = -lim_inf
  F2;

theorem 
  E = dom(F.0) & E = dom P & (for n be Nat holds F.n
  is_measurable_on E) & P is_integrable_on M & (for x be Element of X, n be Nat
  st x in E holds (|. F.n .|).x <= P.x) implies (for n be Nat holds |. F.n .|
  is_integrable_on M) & |. lim_inf F .| is_integrable_on M & |. lim_sup F .|
  is_integrable_on M;



theorem 
  E = dom(F.0) & E = dom P & (for n be Nat holds F.n
  is_measurable_on E) & P is_integrable_on M & P is nonnegative & (for x be
  Element of X, n be Nat st x in E holds (|. F.n .|).x <= P.x) implies ex I be
  ExtREAL_sequence st (for n be Nat holds I.n = Integral(M,F.n)) & lim_inf I >=
  Integral(M,lim_inf F) & lim_sup I <= Integral(M,lim_sup F) & ( (for x be
Element of X st x in E holds F#x is convergent) implies I is convergent & lim I
  = Integral(M,lim F) );

theorem 
  E = dom(F.0) & (for n holds F.n is nonnegative & F.n is_measurable_on
E) & (for x,n,m st x in E & n <= m holds (F.n).x >= (F.m).x) & Integral(M,(F.0)
  |E) < +infty implies ex I be ExtREAL_sequence st (for n be Nat holds I.n =
  Integral(M,F.n)) & I is convergent & lim I = Integral(M,lim F);

definition
  let X be set, F be Functional_Sequence of X,ExtREAL;
  attr F is uniformly_bounded means


  ex K be real number st for n be Nat
  , x be set st x in dom(F.0) holds |. (F.n).x .| <= K;
end;


theorem 
  M.E < +infty & E = dom(F.0) & (for n be Nat holds F.n is_measurable_on
  E) & F is uniformly_bounded & (for x be Element of X st x in E holds F#x is
  convergent) implies (for n be Nat holds F.n is_integrable_on M) & lim F
  is_integrable_on M & ex I be ExtREAL_sequence st (for n be Nat holds I.n =
  Integral(M,F.n)) & I is convergent & lim I = Integral(M,lim F);

definition
  let X be set, F be Functional_Sequence of X,ExtREAL, f be PartFunc of X,
  ExtREAL;
  pred F is_uniformly_convergent_to f means


  F is with_the_same_dom &
  dom(F.0) = dom f & for e be real number st e>0 ex N be Nat st for n be Nat, x
  be set st n >= N & x in dom(F.0) holds |. (F.n).x - f.x .| < e;
end;

theorem 
  F1 is_uniformly_convergent_to f implies for x be Element of X st
  x in dom(F1.0) holds F1#x is convergent & lim(F1#x) = f.x;

theorem 
  M.E < +infty & E = dom(F.0) & (for n be Nat holds F.n is_integrable_on
  M) & F is_uniformly_convergent_to f implies f is_integrable_on M & ex I be
  ExtREAL_sequence st (for n be Nat holds I.n = Integral(M,F.n)) & I is
  convergent & lim I = Integral(M,f);














begin

reserve k,m,n for Element of NAT,
  a,X,Y for set,
  D,D1,D2 for non empty set;
reserve p,q for FinSequence of NAT;






definition
  func VAR -> Subset of NAT equals

  { k : 5 <= k };
end;

registration
  cluster VAR -> non empty;
end;

definition
  mode Variable is Element of VAR;
end;

definition
  let n;
  func x.n -> Variable equals

  5 + n;
end;

reserve x,y,z,t for Variable;



definition
  let x;
  redefine func <*x*> -> FinSequence of NAT;
end;

definition
  let x,y;
  func x '=' y -> FinSequence of NAT equals

  <*0*>^<*x*>^<*y*>;
  func x 'in' y -> FinSequence of NAT equals

  <*1*>^<*x*>^<*y*>;
end;

theorem 
  x '=' y = z '=' t implies x = z & y = t;

theorem 
  x 'in' y = z 'in' t implies x = z & y = t;

definition
  let p;
  func 'not' p -> FinSequence of NAT equals

  <*2*>^p;
  let q;
  func p '&' q -> FinSequence of NAT equals

  <*3*>^p^q;
end;

definition
  let x,p;
  func All(x,p)-> FinSequence of NAT equals

  <*4*>^<*x*>^p;
end;

theorem 
  All(x,p) = All(y,q) implies x = y & p = q;



definition
  func WFF -> non empty set means


  (for a st a in it holds a is
FinSequence of NAT ) & (for x,y holds x '=' y in it & x 'in' y in it ) & (for p
st p in it holds 'not' p in it ) & (for p,q st p in it & q in it holds p '&' q
in it ) & (for x,p st p in it holds All(x,p) in it ) & for D st (for a st a in
D holds a is FinSequence of NAT ) & (for x,y holds x '=' y in D & x 'in' y in D
) & (for p st p in D holds 'not' p in D ) & (for p,q st p in D & q in D holds p
  '&' q in D ) & (for x,p st p in D holds All(x,p) in D ) holds it c= D;
end;

definition
  let IT be FinSequence of NAT;
  attr IT is ZF-formula-like means


  IT is Element of WFF;
end;

registration
  cluster ZF-formula-like for FinSequence of NAT;
end;

definition
  mode ZF-formula is ZF-formula-like FinSequence of NAT;
end;

theorem 
  a is ZF-formula iff a in WFF;

reserve F,F1,G,G1,H,H1 for ZF-formula;

registration
  let x,y;
  cluster x '=' y -> ZF-formula-like;
  cluster x 'in' y -> ZF-formula-like;
end;

registration
  let H;
  cluster 'not' H -> ZF-formula-like;
  let G;
  cluster H '&' G -> ZF-formula-like;
end;

registration
  let x,H;
  cluster All(x,H) -> ZF-formula-like;
end;





definition
  let H;
  attr H is being_equality means


  ex x,y st H = x '=' y;
  attr H is being_membership means


  ex x,y st H = x 'in' y;
  attr H is negative means


  ex H1 st H = 'not' H1;
  attr H is conjunctive means


  ex F,G st H = F '&' G;
  attr H is universal means


  ex x,H1 st H = All(x,H1);
end;

theorem 
  (H is being_equality iff ex x,y st H = x '=' y) & (H is
being_membership iff ex x,y st H = x 'in' y) & (H is negative iff ex H1 st H =
'not' H1) & (H is conjunctive iff ex F,G st H = F '&' G) & (H is universal iff
  ex x,H1 st H = All(x,H1) );

definition
  let H;
  attr H is atomic means


  H is being_equality or H is being_membership;
end;

definition
  let F,G;
  func F 'or' G -> ZF-formula equals

  'not'('not' F '&' 'not' G);
  func F => G -> ZF-formula equals

  'not' (F '&' 'not' G);
end;

definition
  let F,G;
  func F <=> G -> ZF-formula equals

  (F => G) '&' (G => F);
end;

definition
  let x,H;
  func Ex(x,H) -> ZF-formula equals

  'not' All(x,'not' H);
end;

definition
  let H;
  attr H is disjunctive means


  ex F,G st H = F 'or' G;
  attr H is conditional means


  ex F,G st H = F => G;
  attr H is biconditional means


  ex F,G st H = F <=> G;
  attr H is existential means


  ex x,H1 st H = Ex(x,H1);
end;

theorem 
  (H is disjunctive iff ex F,G st H = F 'or' G) & (H is conditional iff
ex F,G st H = F => G) & (H is biconditional iff ex F,G st H = F <=> G) & (H is
  existential iff ex x,H1 st H = Ex(x,H1) );

definition
  let x,y,H;
  func All(x,y,H) -> ZF-formula equals

  All(x,All(y,H));
  func Ex(x,y,H) -> ZF-formula equals

  Ex(x,Ex(y,H));
end;

theorem 
  All(x,y,H) = All(x,All(y,H)) & Ex(x,y,H) = Ex(x,Ex(y,H));

definition
  let x,y,z,H;
  func All(x,y,z,H) -> ZF-formula equals

  All(x,All(y,z,H));
  func Ex(x,y,z,H) -> ZF-formula equals

  Ex(x,Ex(y,z,H));
end;

theorem 
  All(x,y,z,H) = All(x,All(y,z,H)) & Ex(x,y,z,H) = Ex(x,Ex(y,z,H));

theorem 
  H is being_equality or H is being_membership or H is negative or
  H is conjunctive or H is universal;

theorem 
  H is atomic or H is negative or H is conjunctive or H is universal;

theorem 
  H is atomic implies len H = 3;

theorem 
  H is atomic or ex H1 st len H1 + 1 <= len H;

theorem 
  3 <= len H;

theorem 
  len H = 3 implies H is atomic;

theorem 
  for x,y holds (x '=' y).1 = 0 & (x 'in' y ).1 = 1;

theorem 
  for F,G holds (F '&' G).1 = 3;

theorem 
  for x,H holds All(x,H).1 = 4;

theorem 
  H is being_equality implies H.1 = 0;

theorem 
  H is being_membership implies H.1 = 1;

theorem 
  H is negative implies H.1 = 2;

theorem 
  H is conjunctive implies H.1 = 3;

theorem 
  H is universal implies H.1 = 4;

theorem 
  H is being_equality & H.1 = 0 or H is being_membership & H.1 = 1
or H is negative & H.1 = 2 or H is conjunctive & H.1 = 3 or H is universal & H.
  1 = 4;

theorem 
  H.1 = 0 implies H is being_equality;

theorem 
  H.1 = 1 implies H is being_membership;

theorem 
  H.1 = 2 implies H is negative;

theorem 
  H.1 = 3 implies H is conjunctive;

theorem 
  H.1 = 4 implies H is universal;

reserve sq,sq9 for FinSequence;

theorem 
  H = F^sq implies H = F;

theorem 
  H '&' G = H1 '&' G1 implies H = H1 & G = G1;

theorem 
  F 'or' G = F1 'or' G1 implies F = F1 & G = G1;

theorem 
  F => G = F1 => G1 implies F = F1 & G = G1;

theorem 
  F <=> G = F1 <=> G1 implies F = F1 & G = G1;

theorem 
  Ex(x,H) = Ex(y,G) implies x = y & H = G;





definition
  let H;
  assume
 H is atomic;
  func Var1 H -> Variable equals


  H.2;
  func Var2 H -> Variable equals


  H.3;
end;

theorem 
  H is atomic implies Var1 H = H.2 & Var2 H = H.3;

theorem 
  H is being_equality implies H = (Var1 H) '=' Var2 H;

theorem 
  H is being_membership implies H = (Var1 H) 'in' Var2 H;

definition
  let H;
  assume
 H is negative;
  func the_argument_of H -> ZF-formula means


  'not' it = H;
end;

definition
  let H;
  assume
 H is conjunctive or H is disjunctive;
  func the_left_argument_of H -> ZF-formula means


  ex H1 st it '&' H1 = H if H is conjunctive otherwise ex H1 st it 'or' H1 = H;
  func the_right_argument_of H -> ZF-formula means


  ex H1 st H1 '&' it = H if H is conjunctive otherwise ex H1 st H1 'or' it = H;
end;

theorem 
  H is conjunctive implies (F = the_left_argument_of H iff ex G st F '&'
G = H) & (F = the_right_argument_of H iff ex G st G '&' F = H);

theorem 
  H is disjunctive implies (F = the_left_argument_of H iff ex G st
  F 'or' G = H) & (F = the_right_argument_of H iff ex G st G 'or' F = H);

theorem 
  H is conjunctive implies H = (the_left_argument_of H) '&'
  the_right_argument_of H;

theorem 
  H is disjunctive implies H = (the_left_argument_of H) 'or'
  the_right_argument_of H;

definition
  let H;
  assume
 H is universal or H is existential;
  func bound_in H -> Variable means


  ex H1 st All(it,H1) = H if H is universal otherwise ex H1 st Ex(it,H1) = H;
  func the_scope_of H -> ZF-formula means


  ex x st All(x,it) = H if H is universal otherwise ex x st Ex(x,it) = H;
end;

theorem 
  H is universal implies (x = bound_in H iff ex H1 st All(x,H1) = H) & (
  H1 = the_scope_of H iff ex x st All(x,H1) = H);

theorem 
  H is existential implies (x = bound_in H iff ex H1 st Ex(x,H1) =
  H) & (H1 = the_scope_of H iff ex x st Ex(x,H1) = H);

theorem 
  H is universal implies H = All(bound_in H,the_scope_of H);

theorem 
  H is existential implies H = Ex(bound_in H,the_scope_of H);

definition
  let H;
  assume
 H is conditional;
  func the_antecedent_of H -> ZF-formula means


  ex H1 st H = it => H1;
  func the_consequent_of H -> ZF-formula means


  ex H1 st H = H1 => it;
end;

theorem 
  H is conditional implies (F = the_antecedent_of H iff ex G st H = F =>
  G) & (F = the_consequent_of H iff ex G st H = G => F);

theorem 
  H is conditional implies H = (the_antecedent_of H) => the_consequent_of H;

definition
  let H;
  assume
 H is biconditional;
  func the_left_side_of H -> ZF-formula means


  ex H1 st H = it <=> H1;
  func the_right_side_of H -> ZF-formula means


  ex H1 st H = H1 <=> it;
end;

theorem 
  H is biconditional implies (F = the_left_side_of H iff ex G st H = F
  <=> G) & (F = the_right_side_of H iff ex G st H = G <=> F);

theorem 
  H is biconditional implies H = (the_left_side_of H) <=> the_right_side_of H;





definition
  let H,F;
  pred H is_immediate_constituent_of F means


  F = 'not' H or ( ex H1 st
  F = H '&' H1 or F = H1 '&' H ) or ex x st F = All(x,H);
end;

theorem 
  not H is_immediate_constituent_of x '=' y;

theorem 
  not H is_immediate_constituent_of x 'in' y;

theorem 
  F is_immediate_constituent_of 'not' H iff F = H;

theorem 
  F is_immediate_constituent_of G '&' H iff F = G or F = H;

theorem 
  F is_immediate_constituent_of All(x,H) iff F = H;

theorem 
  H is atomic implies not F is_immediate_constituent_of H;

theorem 
  H is negative implies (F is_immediate_constituent_of H iff F =
  the_argument_of H);

theorem 
  H is conjunctive implies (F is_immediate_constituent_of H iff F
  = the_left_argument_of H or F = the_right_argument_of H);

theorem 
  H is universal implies (F is_immediate_constituent_of H iff F =
  the_scope_of H);





reserve L,L9 for FinSequence;

definition
  let H,F;
  pred H is_subformula_of F means


  ex n,L st 1 <= n & len L = n & L.1 =
  H & L.n = F & for k st 1 <= k & k < n ex H1,F1 st L.k = H1 & L.(k + 1) = F1 &
  H1 is_immediate_constituent_of F1;
end;

theorem 
  H is_subformula_of H;

definition
  let H,F;
  pred H is_proper_subformula_of F means


  H is_subformula_of F & H <> F;
end;

theorem 
  H is_immediate_constituent_of F implies len H < len F;

theorem 
  H is_immediate_constituent_of F implies H is_proper_subformula_of F;

theorem 
  H is_proper_subformula_of F implies len H < len F;

theorem 
  H is_proper_subformula_of F implies ex G st G is_immediate_constituent_of F;

reserve j,j1 for Element of NAT;

theorem 
  F is_proper_subformula_of G & G is_proper_subformula_of H
  implies F is_proper_subformula_of H;

theorem 
  F is_subformula_of G & G is_subformula_of H implies F is_subformula_of H;

theorem 
  G is_subformula_of H & H is_subformula_of G implies G = H;

theorem 
  not F is_proper_subformula_of x '=' y;

theorem 
  not F is_proper_subformula_of x 'in' y;

theorem 
  F is_proper_subformula_of 'not' H implies F is_subformula_of H;

theorem 
  F is_proper_subformula_of G '&' H implies F is_subformula_of G
  or F is_subformula_of H;

theorem 
  F is_proper_subformula_of All(x,H) implies F is_subformula_of H;

theorem 
  H is atomic implies not F is_proper_subformula_of H;

theorem 
  H is negative implies the_argument_of H is_proper_subformula_of H;

theorem 
  H is conjunctive implies the_left_argument_of H
  is_proper_subformula_of H & the_right_argument_of H is_proper_subformula_of H
;

theorem 
  H is universal implies the_scope_of H is_proper_subformula_of H;

theorem 
  H is_subformula_of x '=' y iff H = x '=' y;

theorem 
  H is_subformula_of x 'in' y iff H = x 'in' y;





definition
  let H;
  func Subformulae H -> set means


  a in it iff ex F st F = a & F is_subformula_of H;
end;

theorem 
  G in Subformulae H implies G is_subformula_of H;

theorem 
  F is_subformula_of H implies Subformulae F c= Subformulae H;

theorem 
  Subformulae x '=' y = { x '=' y };

theorem 
  Subformulae x 'in' y = { x 'in' y };

theorem 
  Subformulae 'not' H = Subformulae H \/ { 'not' H };

theorem 
  Subformulae (H '&' F) = Subformulae H \/ Subformulae F \/ { H '&' F };

theorem 
  Subformulae All(x,H) = Subformulae H \/ { All(x,H) };

theorem 
  H is atomic iff Subformulae H = { H };

theorem 
  H is negative implies Subformulae H = Subformulae the_argument_of H \/ { H };

theorem 
  H is conjunctive implies Subformulae H = Subformulae
  the_left_argument_of H \/ Subformulae the_right_argument_of H \/ { H };

theorem 
  H is universal implies Subformulae H = Subformulae the_scope_of H \/ { H };

theorem 
  (H is_immediate_constituent_of G or H is_proper_subformula_of G or H
  is_subformula_of G) & G in Subformulae F implies H in Subformulae F;





scheme 

  ZFInd { P[ZF-formula] } : for H holds P[H]
provided
 for H st H is atomic holds P[H] and
 for H st H is negative & P[the_argument_of H] holds P[H] and
 for H st H is conjunctive & P[the_left_argument_of H] & P[
the_right_argument_of H] holds P[H] and
 for H st H is universal & P[the_scope_of H] holds P[H];

scheme 

  ZFCompInd { P[ZF-formula] } : for H holds P[H]
provided
 for H st for F st F is_proper_subformula_of H holds P[F] holds P[H];















begin

reserve F,H,H9 for ZF-formula,
  x,y,z,t for Variable,
  a,b,c,d,A,X for set;

scheme 

  ZFschex { F1(Variable,Variable)->set, F2(Variable,Variable)->set, F3(set)->
  set, F4(set,set)->set, F5(Variable,set)->set, H()->ZF-formula } : ex a,A st (
for x,y holds [x '=' y,F1(x,y)] in A & [x 'in' y,F2(x,y)] in A) & [H(),a] in A
& for H,a st [H,a] in A holds (H is being_equality implies a = F1(Var1 H,Var2 H
  ) ) & (H is being_membership implies a = F2(Var1 H,Var2 H) ) & (H is negative
  implies ex b st a = F3(b) & [the_argument_of H,b] in A) & (H is conjunctive
  implies ex b,c st a = F4(b,c) & [the_left_argument_of H,b] in A & [
  the_right_argument_of H,c] in A) & (H is universal implies ex b st a = F5(
  bound_in H,b) & [the_scope_of H,b] in A);

scheme 

  ZFschuniq { F1(Variable,Variable)->set, F2(Variable,Variable)->set, F3(set)
->set, F4(set,set)->set, F5(Variable,set)->set, H()->ZF-formula, a()->set, b()
  ->set } : a() = b()
provided
 ex A st (for x,y holds [x '=' y,F1(x,y)] in A & [x 'in' y,F2(x,y)]
in A) & [H(),a()] in A & for H,a st [H,a] in A holds (H is being_equality
implies a = F1(Var1 H,Var2 H) ) & (H is being_membership implies a = F2(Var1 H,
Var2 H) ) & (H is negative implies ex b st a = F3(b) & [the_argument_of H,b] in
A) & (H is conjunctive implies ex b,c st a = F4(b,c) & [the_left_argument_of H,
b] in A & [the_right_argument_of H,c] in A) & (H is universal implies ex b st a
= F5(bound_in H,b) & [the_scope_of H,b] in A) and
 ex A st (for x,y holds [x '=' y,F1(x,y)] in A & [x 'in' y,F2(x,y)]
in A) & [H(),b()] in A & for H,a st [H,a] in A holds (H is being_equality
implies a = F1(Var1 H,Var2 H) ) & (H is being_membership implies a = F2(Var1 H,
Var2 H) ) & (H is negative implies ex b st a = F3(b) & [the_argument_of H,b] in
A) & (H is conjunctive implies ex b,c st a = F4(b,c) & [the_left_argument_of H,
b] in A & [the_right_argument_of H,c] in A) & (H is universal implies ex b st a
= F5(bound_in H,b) & [the_scope_of H,b] in A);

scheme 

  ZFschresult { F1(Variable,Variable)->set, F2(Variable,Variable)->set, F3(set
)->set, F4(set,set)->set, F5(Variable,set)->set, H()->ZF-formula, f(ZF-formula)
->set } : ( H() is being_equality implies f(H()) = F1(Var1 H(),Var2 H()) ) & (
  H() is being_membership implies f(H()) = F2(Var1 H(),Var2 H()) ) & ( H() is
  negative implies f(H()) = F3(f(the_argument_of H())) ) & ( H() is conjunctive
  implies for a,b st a = f(the_left_argument_of H()) & b = f(
  the_right_argument_of H()) holds f(H()) = F4(a,b) ) & ( H() is universal
  implies f(H()) = F5(bound_in H(),f(the_scope_of H())) )
provided
 for H9,a holds a = f(H9) iff ex A st (for x,y holds [x '=' y,F1(x,y)
] in A & [x 'in' y,F2(x,y)] in A) & [H9,a] in A & for H,a st [H,a] in A holds (
H is being_equality implies a = F1(Var1 H,Var2 H) ) & (H is being_membership
implies a = F2(Var1 H,Var2 H) ) & (H is negative implies ex b st a = F3(b) & [
the_argument_of H,b] in A) & (H is conjunctive implies ex b,c st a = F4(b,c) &
[the_left_argument_of H,b] in A & [the_right_argument_of H,c] in A) & (H is
universal implies ex b st a = F5(bound_in H,b) & [the_scope_of H,b] in A);

scheme 

  ZFschproperty { F1(Variable,Variable)->set, F2(Variable,Variable)->set, F3(
  set)->set, F4(set,set)->set, F5(Variable,set)->set, f(ZF-formula)->set, H()->
  ZF-formula, P[set] } : P[f(H())]
provided
 for H9,a holds a = f(H9) iff ex A st (for x,y holds [x '=' y,F1(x,y)
] in A & [x 'in' y,F2(x,y)] in A) & [H9,a] in A & for H,a st [H,a] in A holds (
H is being_equality implies a = F1(Var1 H,Var2 H) ) & (H is being_membership
implies a = F2(Var1 H,Var2 H) ) & (H is negative implies ex b st a = F3(b) & [
the_argument_of H,b] in A) & (H is conjunctive implies ex b,c st a = F4(b,c) &
[the_left_argument_of H,b] in A & [the_right_argument_of H,c] in A) & (H is
universal implies ex b st a = F5(bound_in H,b) & [the_scope_of H,b] in A) and
 for x,y holds P[F1(x,y)] & P[F2(x,y)] and
 for a st P[a] holds P[F3(a)] and
 for a,b st P[a] & P[b] holds P[F4(a,b)] and
 for a,x st P[a] holds P[F5(x,a)];

definition
  let H;
  func Free H -> set means


  ex A st (for x,y holds [x '=' y,{ x,y }] in
A & [x 'in' y,{ x,y }] in A) & [H,it] in A & for H9,a st [H9,a] in A holds (H9
  is being_equality implies a = { Var1 H9,Var2 H9 }) & (H9 is being_membership
  implies a = { Var1 H9,Var2 H9 }) & (H9 is negative implies ex b st a = b & [
the_argument_of H9,b] in A) & (H9 is conjunctive implies ex b,c st a = union {
b,c } & [the_left_argument_of H9,b] in A & [the_right_argument_of H9,c] in A) &
  (H9 is universal implies ex b st a = (union { b }) \ { bound_in H9 } & [
  the_scope_of H9,b] in A);
end;

definition
  let H;
  redefine func Free H -> Subset of VAR;
end;

theorem 
  for H holds (H is being_equality implies Free H = { Var1 H,Var2 H }) &
  (H is being_membership implies Free H = { Var1 H,Var2 H }) & (H is negative
  implies Free H = Free the_argument_of H) & (H is conjunctive implies Free H =
Free the_left_argument_of H \/ Free the_right_argument_of H) & (H is universal
  implies Free H = (Free the_scope_of H) \ { bound_in H });



definition
  let D be non empty set;
  func VAL D -> set equals

  Funcs(VAR,D);
end;

registration
  let D be non empty set;
  cluster VAL D -> non empty;
end;

reserve E for non empty set,
  f,g,h for Function of VAR,E,
  v1,v2,v3,v4,v5,u5 for Element of VAL E;



definition
  let H,E;
  func St(H,E) -> set means


  ex A st (for x,y holds [x '=' y,{ v1 : for
f st f = v1 holds f.x = f.y }] in A & [x 'in' y,{ v2 : for f st f = v2 holds f.
  x in f.y }] in A) & [H,it] in A & for H9,a st [H9,a] in A holds (H9 is
  being_equality implies a = { v3 : for f st f = v3 holds f.(Var1 H9) = f.(Var2
  H9) }) & (H9 is being_membership implies a = { v4 : for f st f = v4 holds f.(
  Var1 H9) in f.(Var2 H9) }) & (H9 is negative implies ex b st a = (VAL E) \
union { b } & [the_argument_of H9,b] in A ) & (H9 is conjunctive implies ex b,c
  st a = (union { b }) /\ union { c } & [the_left_argument_of H9,b] in A & [
the_right_argument_of H9,c] in A) & (H9 is universal implies ex b st a = { v5 :
  for X,f st X = b & f = v5 holds f in X & for g st for y st g.y <> f.y holds
  bound_in H9 = y holds g in X } & [the_scope_of H9,b] in A);
end;

definition
  let H,E;
  redefine func St(H,E) -> Subset of VAL E;
end;

theorem 
  for x,y,f holds f.x = f.y iff f in St(x '=' y,E);

theorem 
  for x,y,f holds f.x in f.y iff f in St(x 'in' y,E);

theorem 
  for H,f holds not f in St(H,E) iff f in St('not' H,E);

theorem 
  for H,H9,f holds f in St(H,E) & f in St(H9,E) iff f in St(H '&' H9,E);

theorem 
  for x,H,f holds ( f in St(H,E) & for g st for y st g.y <> f.y
  holds x = y holds g in St(H,E) ) iff f in St(All(x,H),E);

theorem 
  H is being_equality implies for f holds f.(Var1 H) = f.(Var2 H) iff f
  in St(H,E);

theorem 
  H is being_membership implies for f holds f.(Var1 H) in f.(Var2 H) iff
  f in St(H,E);

theorem 
  H is negative implies for f holds not f in St(the_argument_of H,E) iff
  f in St(H,E);

theorem 
  H is conjunctive implies for f holds f in St(the_left_argument_of H,E)
  & f in St(the_right_argument_of H,E) iff f in St(H,E);

theorem 
  H is universal implies for f holds (f in St(the_scope_of H,E) & for g
  st for y st g.y <> f.y holds bound_in H = y holds g in St(the_scope_of H,E) )
  iff f in St(H,E);



definition
  let D be non empty set;
  let f be Function of VAR,D;
  let H;
  pred D,f |= H means


  f in St(H,D);
end;

theorem 
  for E,f,x,y holds E,f |= x '=' y iff f.x = f.y;

theorem 
  for E,f,x,y holds E,f |= x 'in' y iff f.x in f.y;

theorem 
  for E,f,H holds E,f |= H iff not E,f |= 'not' H;

theorem 
  for E,f,H,H9 holds E,f |= H '&' H9 iff E,f |= H & E,f |= H9;

theorem 
  for E,f,H,x holds E,f |= All(x,H) iff for g st for y st g.y <> f
  .y holds x = y holds E,g |= H;

theorem 
  for E,f,H,H9 holds E,f |= H 'or' H9 iff E,f |= H or E,f |= H9;

theorem 
  for E,f,H,H9 holds E,f |= H => H9 iff (E,f |= H implies E,f |= H9);

theorem 
  for E,f,H,H9 holds E,f |= H <=> H9 iff (E,f |= H iff E,f |= H9);

theorem 
  for E,f,H,x holds E,f |= Ex(x,H) iff ex g st (for y st g.y <> f.
  y holds x = y) & E,g |= H;

theorem 
  E,f |= All(x,y,H) iff for g st for z st g.z <> f.z holds x = z or y =
  z holds E,g |= H;

theorem 
  E,f |= Ex(x,y,H) iff ex g st (for z st g.z <> f.z holds x = z or y = z
  ) & E,g |= H;



definition
  let E,H;
  pred E |= H means


  for f holds E,f |= H;
end;

theorem 
  E |= All(x,H) iff E |= H;



definition
  func the_axiom_of_extensionality -> ZF-formula equals

  All(x.0,x.1,All(x.2,x.
  2 'in' x.0 <=> x.2 'in' x.1) => x.0 '=' x.1);
  func the_axiom_of_pairs -> ZF-formula equals

  All(x.0,x.1,Ex(x.2,All(x.3, x.3
  'in' x.2 <=> (x.3 '=' x.0 'or' x.3 '=' x.1) )));
  func the_axiom_of_unions -> ZF-formula equals

  All(x.0,Ex(x.1,All(x.2, x.2
  'in' x.1 <=> Ex(x.3,x.2 'in' x.3 '&' x.3 'in' x.0) )));
  func the_axiom_of_infinity -> ZF-formula equals

  Ex(x.0,x.1,x.1 'in' x.0 '&'
All(x.2,x.2 'in' x.0 => Ex(x.3,x.3 'in' x.0 '&' 'not' x.3 '=' x.2 '&' All(x.4,
  x.4 'in' x.2 => x.4 'in' x.3) )));
  func the_axiom_of_power_sets -> ZF-formula equals

  All(x.0,Ex(x.1,All(x.2, x.
  2 'in' x.1 <=> All(x.3,x.3 'in' x.2 => x.3 'in' x.0) )));
end;

definition
  let H be ZF-formula;
  func the_axiom_of_substitution_for H -> ZF-formula equals

  All(x.3,Ex(x.0,All
(x.4,H <=> x.4 '=' x.0))) => All(x.1,Ex(x.2,All(x.4,x.4 'in' x.2 <=> Ex(x.3,x.3
  'in' x.1 '&' H))));
end;

definition
  let E;
  attr E is being_a_model_of_ZF means

  E is epsilon-transitive & E |=
the_axiom_of_pairs & E |= the_axiom_of_unions & E |= the_axiom_of_infinity & E
|= the_axiom_of_power_sets & for H st { x.0,x.1,x.2 } misses Free H holds E |=
  the_axiom_of_substitution_for H;
end;














begin

reserve X,Y,Z for set,
  x,y,z for set,
  E for non empty set,
  A,B,C for Ordinal ,
  L,L1 for T-Sequence,
  f,f1,f2,h for Function,
  d,d1,d2,d9 for Element of E;

definition
  let E,A;
  func Collapse (E,A) -> set means


  ex L st it = { d : for d1 st d1 in d
ex B st B in dom L & d1 in union { L.B } } & dom L = A & for B st B in A holds
  L.B = { d1 : for d st d in d1 ex C st C in dom(L|B) & d in union { L|B.C } };
end;

theorem 
  Collapse (E,A) = { d : for d1 st d1 in d ex B st B in A & d1 in
  Collapse (E,B) };

theorem 
  (not ex d1 st d1 in d) iff d in Collapse (E,{});

theorem 
  d /\ E c= Collapse (E,A) iff d in Collapse (E,succ A);

theorem 
  A c= B implies Collapse (E,A) c= Collapse (E,B);

theorem 
  ex A st d in Collapse (E,A);

theorem 
  d9 in d & d in Collapse (E,A) implies d9 in Collapse (E,A) & ex B
  st B in A & d9 in Collapse (E,B);

theorem 
  Collapse (E,A) c= E;

theorem 
  ex A st E = Collapse (E,A);

theorem 
  ex f st dom f = E & for d holds f.d = f.:d;



definition
  let f,X,Y;
  pred f is_epsilon-isomorphism_of X,Y means

  dom f = X & rng f = Y & f is
one-to-one & for x,y st x in X & y in X holds (ex Z st Z = y & x in Z) iff ex Z
  st f.y = Z & f.x in Z;
end;

definition
  let X,Y;
  pred X,Y are_epsilon-isomorphic means

  ex f st f is_epsilon-isomorphism_of X, Y;
end;

theorem 
  (dom f = E & for d holds f.d = f.:d) implies rng f is epsilon-transitive;

reserve f,g,h for (Function of VAR,E),
  u,v,w for (Element of E),
  x for Variable,
  a,b,c for set;

theorem 
  E |= the_axiom_of_extensionality implies for u,v st for w holds
  w in u iff w in v holds u = v;


theorem 
  E |= the_axiom_of_extensionality implies ex X st X is
  epsilon-transitive & E,X are_epsilon-isomorphic;














begin

reserve x,y,z for Variable,
  H for ZF-formula,
  E for non empty set,
  a,b,c,X,Y,Z for set,
  u,v,w for Element of E,
  f,g,h,i,j for Function of VAR,E;

theorem 
  E is epsilon-transitive implies E |= the_axiom_of_extensionality;

theorem 
  E is epsilon-transitive implies (E |= the_axiom_of_pairs iff for
  u,v holds { u,v } in E);

theorem 
  E is epsilon-transitive implies (E |= the_axiom_of_pairs iff for X,Y
  st X in E & Y in E holds { X,Y } in E);

theorem 
  E is epsilon-transitive implies (E |= the_axiom_of_unions iff for
  u holds union u in E);

theorem 
  E is epsilon-transitive implies (E |= the_axiom_of_unions iff for X st
  X in E holds union X in E);

theorem 
  E is epsilon-transitive implies (E |= the_axiom_of_infinity iff
  ex u st u <> {} & for v st v in u ex w st v c< w & w in u);

theorem 
  E is epsilon-transitive implies (E |= the_axiom_of_infinity iff ex X
  st X in E & X <> {} & for Y st Y in X ex Z st Y c< Z & Z in X);

theorem 
  E is epsilon-transitive implies (E |= the_axiom_of_power_sets iff
  for u holds E /\ bool u in E);

theorem 
  E is epsilon-transitive implies (E |= the_axiom_of_power_sets iff for
  X st X in E holds E /\ bool X in E);

theorem 
  not x in Free H & E,f |= H implies E,f |= All(x,H);

theorem 
  { x,y } misses Free H & E,f |= H implies E,f |= All(x,y,H);

theorem 
  { x,y,z } misses Free H & E,f |= H implies E,f |= All(x,y,z,H);

definition
  let H,E;
  let val be Function of VAR,E;
  assume that
 not x.0 in Free H and
 E,val |= All(x.3,Ex(x.0,All(x.4,H <=> x.4 '=' x.0)));
  func def_func'(H,val) -> Function of E,E means


  for g st for y st g.y
<> val.y holds x.0 = y or x.3 = y or x.4 = y holds E,g |= H iff it.(g.x.3) = g.
  x.4;
end;

theorem 
  for H,f,g st (for x st f.x <> g.x holds not x in Free H) & E,f
  |= H holds E,g |= H;

definition
  let H,E;
  assume that
 Free H c= { x.3,x.4 } and
 E |= All(x.3,Ex(x.0,All(x.4,H <=> x.4 '=' x.0)));
  func def_func(H,E) -> Function of E,E means


  for g holds E,g |= H iff it.(g.x.3) = g.x.4;
end;

definition
  let F be Function;
  let E;
  pred F is_definable_in E means

  ex H st Free H c= { x.3,x.4 } & E |= All(x.3,
  Ex(x.0,All(x.4,H <=> x.4 '=' x.0))) & F = def_func(H,E);
  pred F is_parametrically_definable_in E means


  ex H,f st { x.0,x.1,x.2
  } misses Free H & E,f |= All(x.3,Ex(x.0,All(x.4,H <=> x.4 '=' x.0))) & F =
  def_func'(H,f);
end;

theorem 
  for F being Function st F is_definable_in E holds F
  is_parametrically_definable_in E;

theorem 
  E is epsilon-transitive implies ((for H st { x.0,x.1,x.2 }
misses Free H holds E |= the_axiom_of_substitution_for H) iff for H,f st { x.0,
  x.1,x.2 } misses Free H & E,f |= All(x.3,Ex(x.0,All(x.4,H <=> x.4 '=' x.0)))
  for u holds def_func'(H,f).:u in E );

theorem 
  E is epsilon-transitive implies ((for H st { x.0,x.1,x.2 } misses Free
  H holds E |= the_axiom_of_substitution_for H) iff for F being Function st F
  is_parametrically_definable_in E for X st X in E holds F.:X in E );

theorem 
  E is being_a_model_of_ZF implies E is epsilon-transitive & (for u,v st
  for w holds w in u iff w in v holds u = v) & (for u,v holds { u,v } in E) & (
for u holds union u in E) & (ex u st u <> {} & for v st v in u ex w st v c< w &
  w in u) & (for u holds E /\ bool u in E) & for H,f st { x.0,x.1,x.2 } misses
  Free H & E,f |= All(x.3,Ex(x.0,All(x.4,H <=> x.4 '=' x.0))) for u holds
  def_func'(H,f).:u in E;

theorem 
  E is epsilon-transitive & (for u,v holds { u,v } in E) & (for u holds
union u in E) & (ex u st u <> {} & for v st v in u ex w st v c< w & w in u) & (
for u holds E /\ bool u in E) & (for H,f st { x.0,x.1,x.2 } misses Free H & E,f
|= All(x.3,Ex(x.0,All(x.4,H <=> x.4 '=' x.0))) for u holds def_func'(H,f).:u in
  E ) implies E is being_a_model_of_ZF;














begin

reserve p,p1,p2,q,r,F,G,G1,G2,H,H1,H2 for ZF-formula,
  x,x1,x2,y,y1,y2,z,z1,z2,s,t for Variable,
  a,X for set;

theorem 
  Var1 (x '=' y) = x & Var2 (x '=' y) = y;

theorem 
  Var1 (x 'in' y) = x & Var2 (x 'in' y) = y;

theorem 
  the_argument_of 'not' p = p;

theorem 
  the_left_argument_of (p '&' q) = p & the_right_argument_of (p '&' q) = q;

theorem 
  the_left_argument_of (p 'or' q) = p & the_right_argument_of (p 'or' q) = q;

theorem 
  the_antecedent_of (p => q) = p & the_consequent_of (p => q) = q;

theorem 
  the_left_side_of (p <=> q) = p & the_right_side_of (p <=> q) = q;

theorem 
  bound_in All(x,p) = x & the_scope_of All(x,p) = p;

theorem 
  bound_in Ex(x,p) = x & the_scope_of Ex(x,p) = p;

theorem 
  p 'or' q = 'not' p => q;

theorem 
  All(x,y,p) is universal & bound_in All(x,y,p) = x & the_scope_of All(x
  ,y,p) = All(y,p);

theorem 
  Ex(x,y,p) is existential & bound_in Ex(x,y,p) = x & the_scope_of Ex(x,
  y,p) = Ex(y,p);

theorem 
  All(x,y,z,p) = All(x,All(y,All(z,p))) & All(x,y,z,p) = All(x,y,All(z,p ));

theorem 
  All(x1,y1,p1) = All(x2,y2,p2) implies x1 = x2 & y1 = y2 & p1 = p2;

theorem 
  All(x1,y1,z1,p1) = All(x2,y2,z2,p2) implies x1 = x2 & y1 = y2 & z1 =
  z2 & p1 = p2;

theorem 
  All(x,y,z,p) = All(t,s,q) implies x = t & y = s & All(z,p) = q;

theorem 
  Ex(x1,y1,p1) = Ex(x2,y2,p2) implies x1 = x2 & y1 = y2 & p1 = p2;

theorem 
  Ex(x,y,z,p) = Ex(x,Ex(y,Ex(z,p))) & Ex(x,y,z,p) = Ex(x,y,Ex(z,p));

theorem 
  Ex(x1,y1,z1,p1) = Ex(x2,y2,z2,p2) implies x1 = x2 & y1 = y2 & z1 = z2
  & p1 = p2;

theorem 
  Ex(x,y,z,p) = Ex(t,s,q) implies x = t & y = s & Ex(z,p) = q;

theorem 
  All(x,y,z,p) is universal & bound_in All(x,y,z,p) = x & the_scope_of
  All(x,y,z,p) = All(y,z,p);

theorem 
  Ex(x,y,z,p) is existential & bound_in Ex(x,y,z,p) = x & the_scope_of
  Ex(x,y,z,p) = Ex(y,z,p);

theorem 
  H is disjunctive implies the_left_argument_of H = the_argument_of
  the_left_argument_of the_argument_of H;

theorem 
  H is disjunctive implies the_right_argument_of H = the_argument_of
  the_right_argument_of the_argument_of H;

theorem 
  H is conditional implies the_antecedent_of H = the_left_argument_of
  the_argument_of H;

theorem 
  H is conditional implies the_consequent_of H = the_argument_of
  the_right_argument_of the_argument_of H;

theorem 
  H is biconditional implies the_left_side_of H = the_antecedent_of
  the_left_argument_of H & the_left_side_of H = the_consequent_of
  the_right_argument_of H;

theorem 
  H is biconditional implies the_right_side_of H = the_consequent_of
  the_left_argument_of H & the_right_side_of H = the_antecedent_of
  the_right_argument_of H;

theorem 
  H is existential implies bound_in H = bound_in the_argument_of H &
  the_scope_of H = the_argument_of the_scope_of the_argument_of H;

theorem 
  the_argument_of F 'or' G = 'not' F '&' 'not' G & the_antecedent_of F
  'or' G = 'not' F & the_consequent_of F 'or' G = G;

theorem 
  the_argument_of F => G = F '&' 'not' G;

theorem 
  the_left_argument_of F <=> G = F => G & the_right_argument_of F <=> G
  = G => F;

theorem 
  the_argument_of Ex(x,H) = All(x,'not' H);

theorem 
  H is disjunctive implies H is conditional & H is negative &
  the_argument_of H is conjunctive & the_left_argument_of the_argument_of H is
  negative & the_right_argument_of the_argument_of H is negative;

theorem 
  H is conditional implies H is negative & the_argument_of H is
  conjunctive & the_right_argument_of the_argument_of H is negative;

theorem 
  H is biconditional implies H is conjunctive & the_left_argument_of H
  is conditional & the_right_argument_of H is conditional;

theorem 
  H is existential implies H is negative & the_argument_of H is
  universal & the_scope_of the_argument_of H is negative;

theorem 
  not (H is being_equality & (H is being_membership or H is negative or
  H is conjunctive or H is universal)) & not (H is being_membership & (H is
  negative or H is conjunctive or H is universal)) & not (H is negative & (H is
  conjunctive or H is universal)) & not (H is conjunctive & H is universal);

theorem 
  F is_subformula_of G implies len F <= len G;

theorem 
  F is_proper_subformula_of G & G is_subformula_of H or F
  is_subformula_of G & G is_proper_subformula_of H or F is_subformula_of G & G
  is_immediate_constituent_of H or F is_immediate_constituent_of G & G
  is_subformula_of H or F is_proper_subformula_of G & G
  is_immediate_constituent_of H or F is_immediate_constituent_of G & G
  is_proper_subformula_of H implies F is_proper_subformula_of H;

theorem 
  not H is_immediate_constituent_of H;

theorem 
  not (G is_proper_subformula_of H & H is_subformula_of G);

theorem 
  not (G is_proper_subformula_of H & H is_proper_subformula_of G);

theorem 
  not (G is_subformula_of H & H is_immediate_constituent_of G);

theorem 
  not (G is_proper_subformula_of H & H is_immediate_constituent_of G);

theorem 
  'not' F is_subformula_of H implies F is_proper_subformula_of H;

theorem 
  F '&' G is_subformula_of H implies F is_proper_subformula_of H & G
  is_proper_subformula_of H;

theorem 
  All(x,H) is_subformula_of F implies H is_proper_subformula_of F;

theorem 
  F '&' 'not' G is_proper_subformula_of F => G & F
  is_proper_subformula_of F => G & 'not' G is_proper_subformula_of F => G & G
  is_proper_subformula_of F => G;

theorem 
  'not' F '&' 'not' G is_proper_subformula_of F 'or' G & 'not' F
is_proper_subformula_of F 'or' G & 'not' G is_proper_subformula_of F 'or' G & F
  is_proper_subformula_of F 'or' G & G is_proper_subformula_of F 'or' G;

theorem 
  All(x,'not' H) is_proper_subformula_of Ex(x,H) & 'not' H
  is_proper_subformula_of Ex(x,H);

theorem 
  G is_subformula_of H iff G in Subformulae H;

theorem 
  G in Subformulae H implies Subformulae G c= Subformulae H;

theorem 
  H in Subformulae H;

theorem 
  Subformulae (F => G) = Subformulae F \/ Subformulae G \/ { 'not'
  G, F '&' 'not' G, F => G };

theorem 
  Subformulae (F 'or' G) = Subformulae F \/ Subformulae G \/ {'not' G,
  'not' F, 'not' F '&' 'not' G, F 'or' G};

theorem 
  Subformulae (F <=> G) = Subformulae F \/ Subformulae G \/ { 'not' G, F
  '&' 'not' G, F => G, 'not' F, G '&' 'not' F, G => F, F <=> G };

theorem 
  Free (x '=' y) = {x,y};

theorem 
  Free (x 'in' y) = {x,y};

theorem 
  Free ('not' p) = Free p;

theorem 
  Free (p '&' q) = Free p \/ Free q;

theorem 
  Free All(x,p) = Free p \ {x};

theorem 
  Free (p 'or' q) = Free p \/ Free q;

theorem 
  Free (p => q) = Free p \/ Free q;

theorem 
  Free (p <=> q) = Free p \/ Free q;

theorem 
  Free Ex(x,p) = Free p \ {x};

theorem 
  Free All(x,y,p) = Free p \ {x,y};

theorem 
  Free All(x,y,z,p) = Free p \ {x,y,z};

theorem 
  Free Ex(x,y,p) = Free p \ {x,y};

theorem 
  Free Ex(x,y,z,p) = Free p \ {x,y,z};

scheme 

  ZFInduction { P[ZF-formula] } : for H holds P[H]
provided
 for x1,x2 holds P[x1 '=' x2] & P[x1 'in' x2] and
 for H st P[H] holds P['not' H] and
 for H1,H2 st P[H1] & P[H2] holds P[H1 '&' H2] and
 for H,x st P[H] holds P[All(x,H)];

reserve M for non empty set,
  m,m9 for Element of M,
  v,v9 for Function of VAR,M;

definition
  let D,D1,D2 be non empty set, f be Function of D,D1;

  assume
 D1 c= D2;
  func D2!f -> Function of D,D2 equals

  f;
end;

notation
  let E be non empty set, f be Function of VAR,E, x be Variable, e be Element
  of E;
  synonym f / (x,e) for f+*(x,e);
end;

definition
  let E be non empty set, f be Function of VAR,E, x be Variable, e be Element
  of E;
  redefine func f/(x,e) -> Function of VAR, E;
end;

theorem 
  M,v |= All(x,H) iff for m holds M,v/(x,m) |= H;

theorem 
  M,v |= All(x,H) iff M,v/(x,m) |= All(x,H);

theorem 
  M,v |= Ex(x,H) iff ex m st M,v/(x,m) |= H;

theorem 
  M,v |= Ex(x,H) iff M,v/(x,m) |= Ex(x,H);

theorem 
  for v,v9 st for x st x in Free H holds v9.x = v.x holds M,v |= H
  implies M,v9 |= H;

registration
  let H;
  cluster Free H -> finite;
end;

reserve i,j for Element of NAT;

theorem 
  x.i = x.j implies i = j;

theorem 
  ex i st x = x.i;

theorem 
  M,v |= x '=' x;

theorem 
  M |= x '=' x;

theorem 
  not M,v |= x 'in' x;

theorem 
  not M |= x 'in' x & M |= 'not' x 'in' x;

theorem 
  M |= x '=' y iff x = y or ex a st {a} = M;

theorem 
  M |= 'not' x 'in' y iff x = y or for X st X in M holds X misses M;

theorem 
  H is being_equality implies (M,v |= H iff v.Var1 H = v.Var2 H);

theorem 
  H is being_membership implies (M,v |= H iff v.Var1 H in v.Var2 H);

theorem 
  H is negative implies (M,v |= H iff not M,v |= the_argument_of H);

theorem 
  H is conjunctive implies (M,v |= H iff M,v |= the_left_argument_of H &
  M,v |= the_right_argument_of H);

theorem 
  H is universal implies (M,v |= H iff for m holds M,v/(bound_in H,m) |=
  the_scope_of H);

theorem 
  H is disjunctive implies (M,v |= H iff M,v |= the_left_argument_of H
  or M,v |= the_right_argument_of H);

theorem 
  H is conditional implies (M,v |= H iff (M,v |= the_antecedent_of H
  implies M,v |= the_consequent_of H));

theorem 
  H is biconditional implies (M,v |= H iff (M,v |= the_left_side_of H
  iff M,v |= the_right_side_of H));

theorem 
  H is existential implies (M,v |= H iff ex m st M,v/(bound_in H,m) |=
  the_scope_of H);

theorem 
  M |= Ex(x,H) iff for v ex m st M,v/(x,m) |= H;

theorem 
  M |= H implies M |= Ex(x,H);

theorem 
  M |= H iff M |= All(x,y,H);

theorem 
  M |= H implies M |= Ex(x,y,H);

theorem 
  M |= H iff M |= All(x,y,z,H);

theorem 
  M |= H implies M |= Ex(x,y,z,H);





theorem 
  M,v |= (p <=> q) => (p => q) & M |= (p <=> q) => (p => q);

theorem 
  M,v |= (p <=> q) => (q => p) & M |= (p <=> q) => (q => p);

theorem 
  M |= (p => q) => ((q => r) => (p => r));

theorem 
  M,v |= p => q & M,v |= q => r implies M,v |= p => r;

theorem 
  M |= p => q & M |= q => r implies M |= p => r;

theorem 
  M,v |= (p => q) '&' (q => r) => (p => r) & M |= (p => q) '&' (q => r)
  => (p => r);

theorem 
  M,v |= p => (q => p) & M |= p => (q => p);

theorem 
  M,v |= (p => (q => r)) => ((p => q) => (p => r)) & M |= (p => (q => r)
  ) => ((p => q) => (p => r));

theorem 
  M,v |= p '&' q => p & M |= p '&' q => p;

theorem 
  M,v |= p '&' q => q & M |= p '&' q => q;

theorem 
  M,v |= p '&' q => q '&' p & M |= p '&' q => q '&' p;

theorem 
  M,v |= p => p '&' p & M |= p => p '&' p;

theorem 
  M,v |= (p => q) => ((p => r) => (p => q '&' r)) & M |= (p => q) => ((p
  => r) => (p => q '&' r));

theorem 
  M,v |= p => p 'or' q & M |= p => p 'or' q;

theorem 
  M,v |= q => p 'or' q & M |= q => p 'or' q;

theorem 
  M,v |= p 'or' q => q 'or' p & M |= p 'or' q => q 'or' p;

theorem 
  M,v |= p => p 'or' p & M |= p => p 'or' p;

theorem 
  M,v |= (p => r) => ((q => r) => (p 'or' q => r)) & M |= (p => r) => ((
  q => r) => (p 'or' q => r));

theorem 
  M,v |= (p => r) '&' (q => r) => (p 'or' q => r) & M |= (p => r) '&' (q
  => r) => (p 'or' q => r);

theorem 
  M,v |= (p => 'not' q) => (q => 'not' p) & M |= (p => 'not' q) => (q =>
  'not' p);

theorem 
  M,v |= 'not' p => (p => q) & M |= 'not' p => (p => q);

theorem 
  M,v |= (p => q) '&' (p => 'not' q) => 'not' p & M |= (p => q) '&' (p
  => 'not' q) => 'not' p;

theorem 
  M |= p => q & M |= p implies M |= q;

theorem 
  M,v |= 'not'(p '&' q) => 'not' p 'or' 'not' q & M |= 'not'(p '&' q) =>
  'not' p 'or' 'not' q;

theorem 
  M,v |= 'not' p 'or' 'not' q => 'not'(p '&' q) & M |= 'not' p 'or'
  'not' q => 'not'(p '&' q);

theorem 
  M,v |= 'not'(p 'or' q) => 'not' p '&' 'not' q & M |= 'not'(p 'or' q)
  => 'not' p '&' 'not' q;

theorem 
  M,v |= 'not' p '&' 'not' q => 'not'(p 'or' q) & M |= 'not' p '&' 'not'
  q => 'not'(p 'or' q);

theorem 
  M |= All(x,H) => H;

theorem 
  M |= H => Ex(x,H);

theorem 
  not x in Free H1 implies M |= All(x,H1 => H2) => (H1 => All(x, H2));

theorem 
  not x in Free H1 & M |= H1 => H2 implies M |= H1 => All(x,H2);

theorem 
  not x in Free H2 implies M |= All(x,H1 => H2) => (Ex(x,H1) => H2);

theorem 
  not x in Free H2 & M |= H1 => H2 implies M |= Ex(x,H1) => H2;

theorem 
  M |= H1 => All(x,H2) implies M |= H1 => H2;

theorem 
  M |= Ex(x,H1) => H2 implies M |= H1 => H2;

theorem 
  WFF c= bool [:NAT,NAT:];





definition
  let H;
  func variables_in H -> set equals

  rng H \ { 0,1,2,3,4 };
end;

theorem 
  x <> 0 & x <> 1 & x <> 2 & x <> 3 & x <> 4;

theorem 
  not x in { 0,1,2,3,4 };

theorem 
  a in variables_in H implies a <> 0 & a <> 1 & a <> 2 & a <> 3 & a <> 4;

theorem 
  variables_in x '=' y = {x,y};

theorem 
  variables_in x 'in' y = {x,y};

theorem 
  variables_in 'not' H = variables_in H;

theorem 
  variables_in H1 '&' H2 = variables_in H1 \/ variables_in H2;

theorem 
  variables_in All(x,H) = variables_in H \/ {x};

theorem 
  variables_in H1 'or' H2 = variables_in H1 \/ variables_in H2;

theorem 
  variables_in H1 => H2 = variables_in H1 \/ variables_in H2;

theorem 
  variables_in H1 <=> H2 = variables_in H1 \/ variables_in H2;

theorem 
  variables_in Ex(x,H) = variables_in H \/ {x};

theorem 
  variables_in All(x,y,H) = variables_in H \/ {x,y};

theorem 
  variables_in Ex(x,y,H) = variables_in H \/ {x,y};

theorem 
  variables_in All(x,y,z,H) = variables_in H \/ {x,y,z};

theorem 
  variables_in Ex(x,y,z,H) = variables_in H \/ {x,y,z};

theorem 
  Free H c= variables_in H;

definition
  let H;
  redefine func variables_in H -> non empty Subset of VAR;
end;

definition
  let H,x,y;
  func H/(x,y) -> Function means


  dom it = dom H & for a st a in dom H
  holds (H.a = x implies it.a = y) & (H.a <> x implies it.a = H.a);
end;

theorem 
  (x1 '=' x2)/(y1,y2) = z1 '=' z2 iff x1 <> y1 & x2 <> y1 & z1 =
x1 & z2 = x2 or x1 = y1 & x2 <> y1 & z1 = y2 & z2 = x2 or x1 <> y1 & x2 = y1 &
  z1 = x1 & z2 = y2 or x1 = y1 & x2 = y1 & z1 = y2 & z2 = y2;

theorem 
  ex z1,z2 st (x1 '=' x2)/(y1,y2) = z1 '=' z2;

theorem 
  (x1 'in' x2)/(y1,y2) = z1 'in' z2 iff x1 <> y1 & x2 <> y1 & z1
= x1 & z2 = x2 or x1 = y1 & x2 <> y1 & z1 = y2 & z2 = x2 or x1 <> y1 & x2 = y1
  & z1 = x1 & z2 = y2 or x1 = y1 & x2 = y1 & z1 = y2 & z2 = y2;

theorem 
  ex z1,z2 st (x1 'in' x2)/(y1,y2) = z1 'in' z2;

theorem 
  'not' F = ('not' H)/(x,y) iff F = H/(x,y);

theorem 
  H/(x,y) in WFF;

definition
  let H,x,y;
  redefine func H/(x,y) -> ZF-formula;
end;

theorem 
  G1 '&' G2 = (H1 '&' H2)/(x,y) iff G1 = H1/(x,y) & G2 = H2/(x,y);

theorem 
  z <> x implies (All(z,G) = All(z,H)/(x,y) iff G = H/(x,y));

theorem 
  All(y,G) = All(x,H)/(x,y) iff G = H/(x,y);

theorem 
  G1 'or' G2 = (H1 'or' H2)/(x,y) iff G1 = H1/(x,y) & G2 = H2/(x, y);

theorem 
  G1 => G2 = (H1 => H2)/(x,y) iff G1 = H1/(x,y) & G2 = H2/(x,y);

theorem 
  G1 <=> G2 = (H1 <=> H2)/(x,y) iff G1 = H1/(x,y) & G2 = H2/(x,y);

theorem 
  z <> x implies (Ex(z,G) = Ex(z,H)/(x,y) iff G = H/(x,y));

theorem 
  Ex(y,G) = Ex(x,H)/(x,y) iff G = H/(x,y);

theorem 
  H is being_equality iff H/(x,y) is being_equality;

theorem 
  H is being_membership iff H/(x,y) is being_membership;

theorem 
  H is negative iff H/(x,y) is negative;

theorem 
  H is conjunctive iff H/(x,y) is conjunctive;

theorem 
  H is universal iff H/(x,y) is universal;

theorem 
  H is negative implies the_argument_of (H/(x,y)) = (the_argument_of H)/
  (x, y );

theorem 
  H is conjunctive implies the_left_argument_of (H/(x,y)) = (
  the_left_argument_of H)/(x,y) & the_right_argument_of (H/(x,y)) = (
  the_right_argument_of H)/(x,y);

theorem 
  H is universal implies the_scope_of (H/(x,y)) = (the_scope_of H)/(x,y)
  & (bound_in H = x implies bound_in (H/(x,y)) = y) & (bound_in H <> x implies
  bound_in (H/(x,y)) = bound_in H);

theorem 
  H is disjunctive iff H/(x,y) is disjunctive;

theorem 
  H is conditional iff H/(x,y) is conditional;

theorem 
  H is biconditional implies H/(x,y) is biconditional;

theorem 
  H is existential iff H/(x,y) is existential;

theorem 
  H is disjunctive implies the_left_argument_of (H/(x,y)) = (
  the_left_argument_of H)/(x,y) & the_right_argument_of (H/(x,y)) = (
  the_right_argument_of H)/(x,y);

theorem 
  H is conditional implies the_antecedent_of (H/(x,y)) = (
the_antecedent_of H)/(x,y) & the_consequent_of (H/(x,y)) = (the_consequent_of H
  )/(x,y);

theorem 
  H is biconditional implies the_left_side_of (H/(x,y)) = (
the_left_side_of H)/(x,y) & the_right_side_of (H/(x,y)) = (the_right_side_of H)
  /(x,y);

theorem 
  H is existential implies the_scope_of (H/(x,y)) = (the_scope_of H)/(x,
y) & (bound_in H = x implies bound_in (H/(x,y)) = y) & (bound_in H <> x implies
  bound_in (H/(x,y)) = bound_in H);

theorem 
  not x in variables_in H implies H/(x,y) = H;

theorem 
  H/(x,x) = H;

theorem 
  x <> y implies not x in variables_in (H/(x,y));

theorem 
  x in variables_in H implies y in variables_in (H/(x,y));

theorem 
  x <> y implies (H/(x,y))/(x,z) = H/(x,y);

theorem 
  variables_in (H/(x,y)) c= (variables_in H \ {x}) \/ {y};














begin

reserve W for Universe,
  H for ZF-formula,
  x,y,z,X for set,
  k for Variable,
  f for Function of VAR,W,
  u,v for Element of W;

theorem 
  W |= the_axiom_of_pairs;

theorem 
  W |= the_axiom_of_unions;

theorem 
  omega in W implies W |= the_axiom_of_infinity;

theorem 
  W |= the_axiom_of_power_sets;

theorem 
  for H st { x.0,x.1,x.2 } misses Free H holds W |=
  the_axiom_of_substitution_for H;

theorem 
  omega in W implies W is being_a_model_of_ZF;

reserve F for Function,
  A,B,C for Ordinal,
  a,b,b1,b2,c for Ordinal of W,
  fi for Ordinal-Sequence,
  phi for Ordinal-Sequence of W,
  H for ZF-formula;

scheme 

  ALFA9Universe { W()->Universe, D() -> non empty set, P[set,set] }: ex F st
dom F = D() & for d being Element of D() ex a being Ordinal of W() st a = F.d &
  P[d,a] & for b being Ordinal of W() st P[d,b] holds a c= b
provided
 for d being Element of D() ex a being Ordinal of W() st P[d,a];

theorem 
  x is Ordinal of W iff x in On W;

reserve psi for Ordinal-Sequence;

scheme 

  OrdSeqOfUnivEx { W()->Universe, P[set,set] }: ex phi being Ordinal-Sequence
  of W() st for a being Ordinal of W() holds P[a,phi.a]
provided
 for a being Ordinal of W() ex b being Ordinal of W() st P[a,b];

scheme 

  UOSExist { W()->Universe, a()->Ordinal of W(), C(Ordinal,Ordinal)->Ordinal
of W(), D(Ordinal,T-Sequence)->Ordinal of W() } : ex phi being Ordinal-Sequence
of W() st phi.0-element_of W() = a() & (for a being Ordinal of W() holds phi.(
succ a) = C(a,phi.a)) & for a being Ordinal of W() st a <> 0-element_of W() & a
  is limit_ordinal holds phi.a = D(a,phi|a);

scheme 

  UniverseInd { W()->Universe, P[Ordinal] }: for a being Ordinal of W() holds
  P[a]
provided
 P[0-element_of W()] and
 for a being Ordinal of W() st P[a] holds P[succ a] and
 for a being Ordinal of W() st a <> 0-element_of W() & a is
limit_ordinal & for b being Ordinal of W() st b in a holds P[b] holds P[a];

definition
  let f be Function, W be Universe, a be Ordinal of W;
  func union(f,a) -> set equals

  Union (W|`(f|Rank a));
end;

theorem 
  for L being T-Sequence,A holds L|Rank A is T-Sequence;

theorem 
  for L being Ordinal-Sequence,A holds L|Rank A is Ordinal-Sequence;

theorem 
  Union psi is Ordinal;

theorem 
  Union (X|`psi) is Ordinal;

theorem 
  On Rank A = A;

theorem 
  psi|Rank A = psi|A;

definition
  let phi be Ordinal-Sequence, W be Universe, a be Ordinal of W;
  redefine func union(phi,a) -> Ordinal of W;
end;

theorem 
  for phi being Ordinal-Sequence of W holds union(phi,a) = Union (
  phi|a) & union(phi|a,a) = Union (phi|a);

definition
  let W be Universe, a,b be Ordinal of W;
  redefine func a \/ b -> Ordinal of W;
end;

registration
  let W;
  cluster non empty for Element of W;
end;

definition
  let W;
  mode Subclass of W is non empty Subset of W;
end;

definition
  let W;
  let IT be T-Sequence of W;

  attr IT is DOMAIN-yielding means


  dom IT = On W;
end;

registration
  let W;
  cluster DOMAIN-yielding non-empty for T-Sequence of W;
end;

definition
  let W;
  mode DOMAIN-Sequence of W is non-empty DOMAIN-yielding T-Sequence of W;
end;

definition
  let W;
  let L be DOMAIN-Sequence of W;
  redefine func Union L -> Subclass of W;
  let a;
  redefine func L.a -> non empty Element of W;
end;

reserve L for DOMAIN-Sequence of W,
  n for Element of NAT,
  f for Function of VAR,L.a;

theorem 
  a in dom L;

theorem 
  L.a c= Union L;

theorem 
  NAT,VAR are_equipotent;

theorem 
  sup X c= succ union On X;

theorem 
  X in W implies sup X in W;

reserve x1 for Variable;


theorem 
  omega in W & (for a,b st a in b holds L.a c= L.b) & (for a st a <> {}
  & a is limit_ordinal holds L.a = Union (L|a)) implies for H ex phi st phi is
increasing & phi is continuous & for a st phi.a = a & {} <> a for f holds Union
  L,(Union L)!f |= H iff L.a,f |= H;

begin 


reserve M for non countable Aleph;

theorem 
  M is strongly_inaccessible implies Rank M is being_a_model_of_ZF;














begin

reserve H,S for ZF-formula,
  x for Variable,
  X,Y for set,
  i for Element of NAT,
  e,u for set;

definition
  let M be non empty set, F be Subset of WFF;
  pred M |= F means


  for H st H in F holds M |= H;
end;

definition
  let M1,M2 be non empty set;
  pred M1 <==> M2 means

  for H st Free H = {} holds M1 |= H iff M2 |= H;
  reflexivity;
  symmetry;
  pred M1 is_elementary_subsystem_of M2 means

  M1 c= M2 & for H for v being
  Function of VAR,M1 holds M1,v |= H iff M2,M2!v |= H;
  reflexivity;
end;

definition
  func ZF-axioms -> set means


  e in it iff e in WFF & (e =
  the_axiom_of_extensionality or e = the_axiom_of_pairs or e =
the_axiom_of_unions or e = the_axiom_of_infinity or e = the_axiom_of_power_sets
or ex H st {x.0,x.1,x.2} misses Free H & e = the_axiom_of_substitution_for H);
end;

definition
  redefine func ZF-axioms -> Subset of WFF;
end;

reserve M,M1,M2 for non empty set,
  f for Function,
  v1 for Function of VAR,M1,
  v2 for Function of VAR,M2,
  F,F1,F2 for Subset of WFF,
  W for Universe,
  a,b,c for Ordinal of W,
  A,B,C for Ordinal,
  L for DOMAIN-Sequence of W,
  va for Function of VAR,L.a,
  phi,xi for Ordinal-Sequence of W;

theorem 
  M |= {} WFF;

theorem 
  F1 c= F2 & M |= F2 implies M |= F1;

theorem 
  M |= F1 & M |= F2 implies M |= F1 \/ F2;

theorem 
  M is being_a_model_of_ZF implies M |= ZF-axioms;

theorem 
  M |= ZF-axioms & M is epsilon-transitive implies M is being_a_model_of_ZF;

theorem 
  ex S st Free S = {} & for M holds M |= S iff M |= H;

theorem 
  M1 <==> M2 iff for H holds M1 |= H iff M2 |= H;

theorem 
  M1 <==> M2 iff for F holds M1 |= F iff M2 |= F;

theorem 
  M1 is_elementary_subsystem_of M2 implies M1 <==> M2;

theorem 
  M1 is being_a_model_of_ZF & M1 <==> M2 & M2 is
  epsilon-transitive implies M2 is being_a_model_of_ZF;

theorem 
  dom f in W & rng f c= W implies rng f in W;

theorem 
  X,Y are_equipotent or card X = card Y implies bool X,bool Y
  are_equipotent & card bool X = card bool Y;

theorem 
  for D being non empty set, Phi being Function of D, Funcs(On W,
On W) st card D in card W ex phi st phi is increasing & phi is continuous & phi
.0-element_of W = 0-element_of W & (for a holds phi.succ a = sup ({phi.a} \/ (
  uncurry Phi).:[:D,{succ a}:])) & for a st a <> 0-element_of W & a is
  limit_ordinal holds phi.a = sup (phi|a);

theorem 
  for phi being Ordinal-Sequence st phi is increasing holds C+^phi
  is increasing;

theorem 
  for xi being Ordinal-Sequence holds (C+^xi)|A = C+^(xi|A);

theorem 
  for phi being Ordinal-Sequence st phi is increasing & phi is
  continuous holds C+^phi is continuous;

reserve psi for Ordinal-Sequence;

theorem 
  e in rng psi implies e is Ordinal;

theorem 
  rng psi c= sup psi;

theorem 
  A is_cofinal_with B & B is_cofinal_with C implies A is_cofinal_with C;

theorem 
  A is_cofinal_with B implies B c= A;

theorem 
  A is_cofinal_with B & B is_cofinal_with A implies A = B;

theorem 
  dom psi <> {} & dom psi is limit_ordinal & psi is increasing & A
  is_limes_of psi implies A is_cofinal_with dom psi;

theorem 
  succ A is_cofinal_with 1;

theorem 
  A is_cofinal_with succ B implies ex C st A = succ C;

theorem 
  A is_cofinal_with B implies (A is limit_ordinal iff B is limit_ordinal
  );

theorem 
  A is_cofinal_with {} implies A = {};

theorem 
  not On W is_cofinal_with a;

theorem 
  omega in W & phi is increasing & phi is continuous implies ex b
  st a in b & phi.b = b;

theorem 
  omega in W & phi is increasing & phi is continuous implies ex a
  st b in a & phi.a = a & a is_cofinal_with omega;

theorem 
  omega in W & (for a,b st a in b holds L.a c= L.b) & (for a st a
  <> {} & a is limit_ordinal holds L.a = Union (L|a)) implies ex phi st phi is
  increasing & phi is continuous & for a st phi.a = a & {} <> a holds L.a
  is_elementary_subsystem_of Union L;

theorem 
  Rank a in W;

theorem 
  a <> {} implies Rank a is non empty Element of W;

theorem 
  omega in W implies ex phi st phi is increasing & phi is
  continuous & for a,M st phi.a = a & {} <> a & M = Rank a holds M
  is_elementary_subsystem_of W;

theorem 
  omega in W implies ex b,M st a in b & M = Rank b & M
  is_elementary_subsystem_of W;

theorem 
  omega in W implies ex a,M st a is_cofinal_with omega & M = Rank
  a & M is_elementary_subsystem_of W;

theorem 
  omega in W & (for a,b st a in b holds L.a c= L.b) & (for a st a <> {}
  & a is limit_ordinal holds L.a = Union (L|a)) implies ex phi st phi is
  increasing & phi is continuous & for a st phi.a = a & {} <> a holds L.a <==>
  Union L;

theorem 
  omega in W implies ex phi st phi is increasing & phi is continuous &
  for a,M st phi.a = a & {} <> a & M = Rank a holds M <==> W;

theorem 
  omega in W implies ex b,M st a in b & M = Rank b & M <==> W;

theorem 
  omega in W implies ex a,M st a is_cofinal_with omega & M = Rank a & M <==> W;

theorem 
  omega in W implies ex a,M st a is_cofinal_with omega & M = Rank a & M
  is being_a_model_of_ZF;

theorem 
  omega in W & X in W implies ex M st X in M & M in W & M is
  being_a_model_of_ZF;














begin 

theorem 
  for D1 being non empty set, D2 being set, k being Element of D1 holds
  [: {k}, D2 :] c= [: D1, D2 :];

theorem 
  for D1 being non empty set, D2 being set, k1, k2, k3 being
  Element of D1 holds [: {k1, k2, k3}, D2 :] c= [: D1, D2 :];

definition
  mode QC-alphabet means

  it is non empty set & ex X being set st NAT c= X & it = [: NAT, X :];
end;

registration
  cluster -> non empty Relation-like for QC-alphabet;
end;

reserve A for QC-alphabet;
reserve k,n,m for Element of NAT;

definition
  let A be QC-alphabet;
  func QC-symbols(A) -> non empty set equals

    rng A;
end;

definition let A be QC-alphabet;
  mode QC-symbol of A is Element of QC-symbols(A);
end;

theorem 
NAT c= QC-symbols(A) & 0 in QC-symbols(A);

registration let A be QC-alphabet;
  cluster QC-symbols(A) -> non empty;
end;

definition let A be QC-alphabet;
  func QC-variables(A) -> set equals

    [: {6}, NAT :] \/ [: {4,5}, QC-symbols(A) :];
end;

registration
  let A be QC-alphabet;
  cluster QC-variables(A) -> non empty;
end;

theorem 
  QC-variables(A) c= [: NAT, QC-symbols(A) :];

definition
  let A be QC-alphabet;
  mode QC-variable of A is Element of QC-variables(A);
  func bound_QC-variables(A) -> Subset of QC-variables(A) equals

  [: {4}, QC-symbols(A) :];
  func fixed_QC-variables(A) -> Subset of QC-variables(A) equals

  [: {5}, QC-symbols(A) :];
  func free_QC-variables(A) -> Subset of QC-variables(A) equals

  [: {6}, NAT :];
  func QC-pred_symbols(A) -> set equals

  { [n, x] where x is QC-symbol of A : 7 <= n };
end;

registration
  let A be QC-alphabet;
  cluster bound_QC-variables(A) -> non empty;
  cluster fixed_QC-variables(A) -> non empty;
  cluster free_QC-variables(A) -> non empty;
  cluster QC-pred_symbols(A) -> non empty;
end;

theorem 
  A = [: NAT, QC-symbols(A) :];

theorem 
  QC-pred_symbols(A) c= [: NAT, QC-symbols(A) :];

definition
  let A be QC-alphabet;
  mode QC-pred_symbol of A is Element of QC-pred_symbols(A);
end;

definition
  let A be QC-alphabet;
  let P be Element of QC-pred_symbols(A);
  func the_arity_of P -> Element of NAT means


  P`1 = 7+it;
end;

reserve P for QC-pred_symbol of A;

definition
  let A,k;
  func k-ary_QC-pred_symbols(A) -> Subset of QC-pred_symbols(A) equals

  { P : the_arity_of P = k };
end;

registration
  let k, A;
  cluster k-ary_QC-pred_symbols(A) -> non empty;
end;

definition
  let A be QC-alphabet;
  mode bound_QC-variable of A is Element of bound_QC-variables(A);
  mode fixed_QC-variable of A is Element of fixed_QC-variables(A);
  mode free_QC-variable of A is Element of free_QC-variables(A);
  let k;
  mode QC-pred_symbol of k, A is Element of k-ary_QC-pred_symbols(A);
end;

registration
  let k be Element of NAT;
  let A be QC-alphabet;
  cluster k-element for FinSequence of QC-variables(A);
end;

definition
  let k be Element of NAT;
  let A be QC-alphabet;
  mode QC-variable_list of k, A is k-element FinSequence of QC-variables(A);
end;

definition
  let A be QC-alphabet;
  let D be set;
  attr D is A-closed means


   D is Subset of [:NAT, QC-symbols(A):]* &  
  (for k being Element of NAT, p being (QC-pred_symbol of k,A),
  ll being QC-variable_list of k,A holds <*p*>^ll in D) &


  <*[0, 0]*> in D &
  (for p being FinSequence of [:NAT,QC-symbols(A):]
    st p in D holds <*[1, 0]*>^p in D) &
  (for p, q being FinSequence of [:NAT, QC-symbols(A):] st p in D &
    q in D holds <*[2, 0]*>^p^q in D) &
  (for x being bound_QC-variable of A,
    p being FinSequence of [:NAT, QC-symbols(A):]
    st p in D holds <*[3, 0]*>^<*x*>^p in D);
end;

definition
  let A be QC-alphabet;
  func QC-WFF(A) -> non empty set means


  it is A-closed & for D being non empty set st D is A-closed holds it c= D;
end;

theorem 
  QC-WFF(A) is A-closed;

registration
  let A be QC-alphabet;
  cluster A-closed non empty for set;
end;

definition
  let A be QC-alphabet;
  mode QC-formula of A is Element of QC-WFF(A);
end;

definition
  let A be QC-alphabet;
  let P be QC-pred_symbol of A;
  let l be FinSequence of QC-variables(A);
  assume
 the_arity_of P = len l;
  func P!l -> Element of QC-WFF(A) equals

  <*P*>^l;
end;

theorem 
  for k being Element of NAT, p being QC-pred_symbol of k, A, ll be
  QC-variable_list of k, A holds p!ll = <*p*>^ll;

definition
  let A be QC-alphabet;
  let p be Element of QC-WFF(A);
  func @p -> FinSequence of [:NAT, QC-symbols(A):] equals

  p;
end;

definition
  let A be QC-alphabet;
  func VERUM(A) -> QC-formula of A equals

  <*[0, 0]*>;
  let p be Element of QC-WFF(A);
  func 'not' p -> QC-formula of A equals

  <*[1, 0]*>^@p;
  let q be Element of QC-WFF(A);
  func p '&' q -> QC-formula of A equals

  <*[2, 0]*>^@p^@q;
end;

definition
  let A be QC-alphabet;
  let x be bound_QC-variable of A, p be Element of QC-WFF(A);
  func All(x, p) -> QC-formula of A equals

  <*[3, 0]*>^<*x*>^@p;
end;

reserve F for Element of QC-WFF(A);

scheme 

  QCInd { A() -> QC-alphabet, Prop[Element of QC-WFF(A())] }:
          for F being Element of QC-WFF(A()) holds Prop[F]
provided
 for k being Element of NAT, P being (QC-pred_symbol of k, A()), ll being
QC-variable_list of k, A() holds Prop[P!ll] and
 Prop[VERUM(A())] and
 for p being Element of QC-WFF(A()) st Prop[p] holds Prop['not' p] and
 for p, q being Element of QC-WFF(A()) st Prop[p] & Prop[q] holds Prop[p
'&' q] and
 for x being bound_QC-variable of A(),
    p being Element of QC-WFF(A()) st Prop[p]
    holds Prop[All(x, p)];

definition
  let A be QC-alphabet;
  let F be Element of QC-WFF(A);
  attr F is atomic means


  ex k being Element of NAT, p being (
  QC-pred_symbol of k, A), ll being QC-variable_list of k, A st F = p!ll;
  attr F is negative means


  ex p being Element of QC-WFF(A) st F = 'not' p;
  attr F is conjunctive means


  ex p, q being Element of QC-WFF(A) st F = p '&' q;
  attr F is universal means


  ex x being bound_QC-variable of A,
     p being Element of QC-WFF(A) st F = All(x, p);
end;

theorem 
  for F being Element of QC-WFF(A) holds F = VERUM(A) or F is atomic or
  F is negative or F is conjunctive or F is universal;

theorem 
  for F being Element of QC-WFF(A) holds 1 <= len @F;

reserve Q for QC-pred_symbol of A;

theorem 
  for k being Element of NAT, P being QC-pred_symbol of k, A holds
  the_arity_of P = k;

reserve F, G for (Element of QC-WFF(A)), s for FinSequence;

theorem 
  ((@F.1)`1 = 0 implies F = VERUM(A)) & ((@F.1)`1 = 1 implies F is
  negative) & ((@F.1)`1 = 2 implies F is conjunctive) & ((@F.1)`1 = 3 implies F
  is universal) & ((ex k being Element of NAT
                     st @F.1 is QC-pred_symbol of k, A)
  implies F is atomic);

theorem 
  @F = @G^s implies @F = @G;

definition
  let A be QC-alphabet;
  let F be Element of QC-WFF(A) such that
 F is atomic;
  func the_pred_symbol_of F -> QC-pred_symbol of A means


  ex k being Element
of NAT, ll being (QC-variable_list of k, A),
        P being QC-pred_symbol of k, A st it = P
  & F = P!ll;
end;

definition
  let A be QC-alphabet;
  let F be Element of QC-WFF(A) such that
 F is atomic;
  func the_arguments_of F -> FinSequence of QC-variables(A) means


  ex k
being Element of NAT, P being (QC-pred_symbol of k, A),
                      ll being QC-variable_list
  of k, A st it = ll & F = P!ll;
end;

definition
  let A be QC-alphabet;
  let F be Element of QC-WFF(A) such that
 F is negative;
  func the_argument_of F -> QC-formula of A means


  F = 'not' it;
end;

definition
  let A be QC-alphabet;
  let F be Element of QC-WFF(A) such that
 F is conjunctive;
  func the_left_argument_of F -> QC-formula of A means


  ex q being Element of QC-WFF(A) st F = it '&' q;
end;

definition
  let A be QC-alphabet;
  let F be Element of QC-WFF(A) such that
 F is conjunctive;
  func the_right_argument_of F -> QC-formula of A means


  ex p being Element of QC-WFF(A) st F = p '&' it;
end;

definition
  let A be QC-alphabet;
  let F be Element of QC-WFF(A) such that
 F is universal;
  func bound_in F -> bound_QC-variable of A means


  ex p being Element of QC-WFF(A) st F = All(it, p);
  func the_scope_of F -> QC-formula of A means


  ex x being bound_QC-variable of A st F = All(x, it);
end;

reserve p for Element of QC-WFF(A);

theorem 
  p is negative implies len @the_argument_of p < len @p;

theorem 
  p is conjunctive implies len @the_left_argument_of p < len @p &
  len @the_right_argument_of p < len @p;

theorem 
  p is universal implies len @the_scope_of p < len @p;

scheme 

  QCInd2 { A() -> QC-alphabet, P[Element of QC-WFF(A())] }:
    for p being Element of QC-WFF(A()) holds P[p]
provided
 for p being Element of QC-WFF(A()) holds (p is atomic implies P[p]) & P[
VERUM(A())] & (p is negative & P[the_argument_of p] implies P[p]) & (p is
conjunctive & P[the_left_argument_of p] & P[the_right_argument_of p] implies P[
p]) & (p is universal & P[the_scope_of p] implies P[p]);

reserve F for Element of QC-WFF(A);

theorem 
  for k being Element of NAT, P being QC-pred_symbol of k, A holds P
  `1 <> 0 & P`1 <> 1 & P`1 <> 2 & P`1 <> 3;

theorem 
  (@VERUM(A).1)`1 = 0 & (F is atomic implies ex k being Element of
NAT st @F.1 is QC-pred_symbol of k, A) & (F is negative implies (@F.1)`1 = 1) &
(F is conjunctive implies (@F.1)`1 = 2) & (F is universal implies (@F.1)`1 = 3)
;

theorem 
  F is atomic implies (@F.1)`1 <> 0 & (@F.1)`1 <> 1 & (@F.1)`1 <>
  2 & (@F.1)`1 <> 3;

reserve p for Element of QC-WFF(A);

theorem 
  not (VERUM(A) is atomic or VERUM(A) is negative or VERUM(A) is
  conjunctive or VERUM(A) is universal)
  & not (ex p st p is atomic & p is negative
  or p is atomic & p is conjunctive or p is atomic & p is universal or p is
  negative & p is conjunctive or p is negative & p is universal or p is
  conjunctive & p is universal);

scheme 

  QCFuncEx { Al() -> QC-alphabet, D() -> non empty set,
             V() -> (Element of D()),
             A(Element of QC-WFF(Al())) -> (Element of D()),
             N(Element of D()) -> (Element of D()),
             C((Element of D()), Element of D()) -> (Element of D()),
             Q((Element of QC-WFF(Al())), Element of D()) -> Element of D()} :
        ex F being Function of QC-WFF(Al()), D() st F.VERUM(Al()) = V()
        & for p being Element of QC-WFF(Al()) holds
          (p is atomic implies F.p = A(p)) & (p is
          negative implies F.p = N(F.the_argument_of p))
        & (p is conjunctive implies F.p =
        C(F.the_left_argument_of p, F.the_right_argument_of p))
        & (p is universal implies F.p = Q(p, F.the_scope_of p));

reserve j,k for Element of NAT;

definition
  let A be QC-alphabet;
  let ll be FinSequence of QC-variables(A);
  func still_not-bound_in ll -> Subset of bound_QC-variables(A) equals

  { ll.k : 1
  <= k & k <= len ll & ll.k in bound_QC-variables(A) };
end;

reserve k for Element of NAT;

definition
  let A be QC-alphabet;
  let p be QC-formula of A;
  func still_not-bound_in p -> Subset of bound_QC-variables(A) means

  ex F being Function of QC-WFF(A), bool bound_QC-variables(A)
    st it = F.p & for p being Element
of QC-WFF(A) holds F.VERUM(A) = {}
   & (p is atomic implies F.p = { (the_arguments_of p
  ).k : 1 <= k & k <= len the_arguments_of p & (the_arguments_of p).k in
bound_QC-variables(A) })
  & (p is negative implies F.p = F.the_argument_of p) & (p
  is conjunctive implies F.p = (F.the_left_argument_of p) \/ (F.
the_right_argument_of p)) & (p is universal implies F.p = (F.the_scope_of p) \
  {bound_in p});
end;

definition
  let A be QC-alphabet;
  let p be QC-formula of A;
  attr p is closed means

  still_not-bound_in p = {};
end;

reserve s,t,u,v for QC-symbol of A;

definition
  let A;
  mode Relation of A -> Relation means

  it well_orders QC-symbols(A) \ NAT;
end;

definition
  let A,s,t;
  pred s <= t means

  ex n,m st n = s & m = t & n <= m if s in NAT & t in NAT,
  [s,t] in the Relation of A if not s in NAT & not t in NAT
  otherwise t in NAT;
end;

definition
  let A,s,t;
  pred s < t means

  s <= t & s <> t;
end;

theorem 
  s <= t & t <= u implies s <= u;

theorem 
  t <= t;

theorem 
  t <= u & u <= t implies u = t;

theorem 
  t <= u or u <= t;

theorem 
  s < t iff not t <= s;

theorem 
  s < t or s = t or t < s;

definition
  let A;
  let Y be non empty Subset of QC-symbols(A);
  func min Y -> QC-symbol of A means

  it in Y & for t st t in Y holds it <= t;
end;

definition
  let A;
  func 0(A) -> QC-symbol of A means

  for t holds it <= t;
end;

definition
  let A,s;
  func Seg s -> non empty Subset of QC-symbols(A) equals

   { t : s < t };
end;

definition
  let A,s;
  func s++ -> QC-symbol of A equals

  min (Seg s);
end;

theorem 
  s < s++;

theorem 
  for Y1,Y2 being non empty Subset of QC-symbols(A) st Y1 c= Y2 holds
    min Y2 <= min Y1;

theorem 
  s <= t & t < v implies s < v;

theorem 
  s < t & t <= v implies s < v;

definition
  let A;
  let s be set;
  func s@A -> QC-symbol of A equals

  s if s is QC-symbol of A
  otherwise 0;
end;

definition
  let A,t,n;
  func t + n -> QC-symbol of A means

  ex f being Function of NAT,QC-symbols(A) st
  it = f.n & f.0 = t & for k holds f.(k+1) = (f.k)++;
end;

theorem 
  t <= t+n;

definition
  let A;
  let Y be set;
  func A-one_in Y -> QC-symbol of A equals

  the Element of Y if Y is non empty Subset of QC-symbols(A)
  otherwise 0(A);
end;














begin

reserve A for QC-alphabet;
reserve sq for FinSequence,
  x,y,z for bound_QC-variable of A,
  p,q,p1,p2,q1 for Element of QC-WFF(A);

theorem 
  the_argument_of 'not' p = p;

theorem 
  p '&' q = p1 '&' q1 implies p = p1 & q = q1;

theorem 
  p is conjunctive implies p = (the_left_argument_of p) '&'
  the_right_argument_of p;

theorem 
  the_left_argument_of (p '&' q) = p & the_right_argument_of (p '&' q) = q;

theorem 
  All(x,p) = All(y,q) implies x = y & p = q;

theorem 
  p is universal implies p = All(bound_in p, the_scope_of p);

theorem 
  bound_in All(x,p) = x & the_scope_of All(x,p) = p;

definition
  let A be QC-alphabet;
  func FALSUM(A) -> QC-formula of A equals

  'not' VERUM(A);
  let p,q be Element of QC-WFF(A);
  func p => q -> QC-formula of A equals

  'not' (p '&' 'not' q);
  func p 'or' q -> QC-formula of A equals

  'not' ('not' p '&' 'not' q);
end;

definition
  let A be QC-alphabet;
  let p,q be Element of QC-WFF(A);
  func p <=> q -> QC-formula of A equals

  (p => q) '&' (q => p);
end;

definition
  let A be QC-alphabet;
  let x be bound_QC-variable of A, p be Element of QC-WFF(A);
  func Ex(x,p) -> QC-formula of A equals

  'not' All(x,'not' p);
end;

theorem 
  FALSUM(A) is negative & the_argument_of FALSUM(A) = VERUM(A);

theorem 
  p 'or' q = 'not' p => q;

theorem 
  p 'or' q = p1 'or' q1 implies p = p1 & q = q1;

theorem 
  p => q = p1 => q1 implies p = p1 & q = q1;

theorem 
  p <=> q = p1 <=> q1 implies p = p1 & q = q1;

theorem 
  Ex(x,p) = Ex(y,q) implies x = y & p = q;

definition
  let A be QC-alphabet;
  let x,y be bound_QC-variable of A, p be Element of QC-WFF(A);
  func All(x,y,p) -> QC-formula of A equals

  All(x,All(y,p));
  func Ex(x,y,p) -> QC-formula of A equals

  Ex(x,Ex(y,p));
end;

theorem 
  All(x,y,p) = All(x,All(y,p)) & Ex(x,y,p) = Ex(x,Ex(y,p));

theorem 
  for x1,x2,y1,y2 being bound_QC-variable of A st All(x1,y1,p1) = All(
  x2,y2,p2) holds x1 = x2 & y1 = y2 & p1 = p2;

theorem 
  All(x,y,p) = All(z,q) implies x = z & All(y,p) = q;

theorem 
  for x1,x2,y1,y2 being bound_QC-variable of A st Ex(x1,y1,p1) = Ex(x2,
  y2,p2) holds x1 = x2 & y1 = y2 & p1 = p2;

theorem 
  Ex(x,y,p) = Ex(z,q) implies x = z & Ex(y,p) = q;

theorem 
  All(x,y,p) is universal & bound_in All(x,y,p) = x & the_scope_of All(x
  ,y,p) = All(y,p);

definition
  let A be QC-alphabet;
  let x,y,z be bound_QC-variable of A, p be Element of QC-WFF(A);
  func All(x,y,z,p) -> QC-formula of A equals

  All(x,All(y,z,p));
  func Ex(x,y,z,p) -> QC-formula of A equals

  Ex(x,Ex(y,z,p));
end;

theorem 
  All(x,y,z,p) = All(x,All(y,z,p)) & Ex(x,y,z,p) = Ex(x,Ex(y,z,p));

theorem 
  for x1,x2,y1,y2,z1,z2 being bound_QC-variable of A st All(x1,y1,z1,p1) =
  All(x2,y2,z2,p2) holds x1 = x2 & y1 = y2 & z1 = z2 & p1 = p2;

reserve s,t for bound_QC-variable of A;

theorem 
  All(x,y,z,p) = All(t,q) implies x = t & All(y,z,p) = q;

theorem 
  All(x,y,z,p) = All(t,s,q) implies x = t & y = s & All(z,p) = q;

theorem 
  for x1,x2,y1,y2,z1,z2 being bound_QC-variable of A st Ex(x1,y1,z1,p1) = Ex(
  x2,y2,z2,p2) holds x1 = x2 & y1 = y2 & z1 = z2 & p1 = p2;

theorem 
  Ex(x,y,z,p) = Ex(t,q) implies x = t & Ex(y,z,p) = q;

theorem 
  Ex(x,y,z,p) = Ex(t,s,q) implies x = t & y = s & Ex(z,p) = q;

theorem 
  All(x,y,z,p) is universal & bound_in All(x,y,z,p) = x & the_scope_of
  All(x,y,z,p) = All(y,z,p);

definition
  let A be QC-alphabet;
  let H be Element of QC-WFF(A);
  attr H is disjunctive means

  ex p,q being Element of QC-WFF(A) st H = p 'or' q;
  attr H is conditional means


  ex p,q being Element of QC-WFF(A) st H = p => q;
  attr H is biconditional means

  ex p,q being Element of QC-WFF(A) st H = p <=> q;
  attr H is existential means


  ex x being bound_QC-variable of A, p being Element of QC-WFF(A)
   st H = Ex(x,p);
end;

theorem 
  Ex(x,y,p) is existential & Ex(x,y,z,p) is existential;

definition
  let A be QC-alphabet;
  let H be Element of QC-WFF(A);
  func the_left_disjunct_of H -> QC-formula of A equals

  the_argument_of
  the_left_argument_of the_argument_of H;
  func the_right_disjunct_of H -> QC-formula of A equals

  the_argument_of
  the_right_argument_of the_argument_of H;
  func the_antecedent_of H -> QC-formula of A equals

  the_left_argument_of
  the_argument_of H;
end;

notation
  let A be QC-alphabet;
  let H be Element of QC-WFF(A);
  synonym the_consequent_of H for the_right_disjunct_of H;
end;

definition
  let A be QC-alphabet;
  let H be Element of QC-WFF(A);
  func the_left_side_of H -> QC-formula of A equals

  the_antecedent_of
  the_left_argument_of H;
  func the_right_side_of H -> QC-formula of A equals

  the_consequent_of
  the_left_argument_of H;
end;

reserve F,G,H,H1 for Element of QC-WFF(A);

theorem 
  the_left_disjunct_of(F 'or' G) = F & the_right_disjunct_of(F
  'or' G) = G & the_argument_of F 'or' G = 'not' F '&' 'not' G;

theorem 
  the_antecedent_of(F => G) = F & the_consequent_of(F => G) = G &
  the_argument_of F => G = F '&' 'not' G;

theorem 
  the_left_side_of(F <=> G) = F & the_right_side_of(F <=> G) = G &
the_left_argument_of(F <=> G) = F => G & the_right_argument_of(F <=> G) = G =>
  F;

theorem 
  the_argument_of Ex(x,H) = All(x,'not' H);

theorem 
  H is disjunctive implies H is conditional & H is negative &
  the_argument_of H is conjunctive & the_left_argument_of the_argument_of H is
  negative & the_right_argument_of the_argument_of H is negative;

theorem 
  H is conditional implies H is negative & the_argument_of H is
  conjunctive & the_right_argument_of the_argument_of H is negative;

theorem 
  H is biconditional implies H is conjunctive & the_left_argument_of H
  is conditional & the_right_argument_of H is conditional;

theorem 
  H is existential implies H is negative & the_argument_of H is
  universal & the_scope_of the_argument_of H is negative;

theorem 
  H is disjunctive implies H = (the_left_disjunct_of H) 'or' (
  the_right_disjunct_of H);

theorem 
  H is conditional implies H = (the_antecedent_of H) => ( the_consequent_of H);

theorem 
  H is biconditional implies H = (the_left_side_of H) <=> (
  the_right_side_of H);

theorem 
  H is existential implies H = Ex(bound_in the_argument_of H,
  the_argument_of the_scope_of the_argument_of H);





definition
  let A be QC-alphabet;
  let G,H be Element of QC-WFF(A);
  pred G is_immediate_constituent_of H means


  H = 'not' G or (ex F
  being Element of QC-WFF(A) st H = G '&' F or H = F '&' G) or ex x being
  bound_QC-variable of A st H = All(x,G);
end;

reserve x,y,z for bound_QC-variable of A,
  k,n,m for Element of NAT,
  P for ( QC-pred_symbol of k, A),
  V for QC-variable_list of k, A;

theorem 
  not H is_immediate_constituent_of VERUM(A);

theorem 
  not H is_immediate_constituent_of P!V;

theorem 
  F is_immediate_constituent_of 'not' H iff F = H;

theorem 
  H is_immediate_constituent_of FALSUM(A) iff H = VERUM(A);

theorem 
  F is_immediate_constituent_of G '&' H iff F = G or F = H;

theorem 
  F is_immediate_constituent_of All(x,H) iff F = H;

theorem 
  H is atomic implies not F is_immediate_constituent_of H;

theorem 
  H is negative implies (F is_immediate_constituent_of H iff F =
  the_argument_of H);

theorem 
  H is conjunctive implies (F is_immediate_constituent_of H iff F
  = the_left_argument_of H or F = the_right_argument_of H);

theorem 
  H is universal implies (F is_immediate_constituent_of H iff F =
  the_scope_of H);





reserve L,L9 for FinSequence;

definition
  let A be QC-alphabet;
  let G,H be Element of QC-WFF(A);
  pred G is_subformula_of H means


  ex n,L st 1 <= n & len L = n & L.1
= G & L.n = H & for k st 1 <= k & k < n ex G1,H1 being Element of QC-WFF(A)
st L.k = G1 & L.(k+1) = H1 & G1 is_immediate_constituent_of H1;
  reflexivity;
end;

definition
  let A be QC-alphabet;
  let H,F be Element of QC-WFF(A);
  pred H is_proper_subformula_of F means


  H is_subformula_of F & H <> F;
  irreflexivity;
end;

theorem 
  H is_immediate_constituent_of F implies len @H < len @F;

theorem 
  H is_immediate_constituent_of F implies H is_subformula_of F;

theorem 
  H is_immediate_constituent_of F implies H is_proper_subformula_of F;

theorem 
  H is_proper_subformula_of F implies len @H < len @F;

theorem 
  H is_proper_subformula_of F implies ex G st G is_immediate_constituent_of F;

theorem 
  F is_proper_subformula_of G & G is_proper_subformula_of H
  implies F is_proper_subformula_of H;

theorem 
  F is_subformula_of G & G is_subformula_of H implies F is_subformula_of H;

theorem 
  G is_subformula_of H & H is_subformula_of G implies G = H;

theorem 
  not (G is_proper_subformula_of H & H is_subformula_of G);

theorem 
  not (G is_proper_subformula_of H & H is_proper_subformula_of G);

theorem 
  not (G is_subformula_of H & H is_immediate_constituent_of G);

theorem 
  not (G is_proper_subformula_of H & H is_immediate_constituent_of G);

theorem 
  F is_proper_subformula_of G & G is_subformula_of H or F
  is_subformula_of G & G is_proper_subformula_of H or F is_subformula_of G & G
  is_immediate_constituent_of H or F is_immediate_constituent_of G & G
  is_subformula_of H or F is_proper_subformula_of G & G
  is_immediate_constituent_of H or F is_immediate_constituent_of G & G
  is_proper_subformula_of H implies F is_proper_subformula_of H;

theorem 
  not F is_proper_subformula_of VERUM(A);

theorem 
  not F is_proper_subformula_of P!V;

theorem 
  F is_subformula_of H iff F is_proper_subformula_of 'not' H;

theorem 
  'not' F is_subformula_of H implies F is_proper_subformula_of H;

theorem 
  F is_proper_subformula_of FALSUM(A) iff F is_subformula_of VERUM(A);

theorem 
  F is_subformula_of G or F is_subformula_of H iff F
  is_proper_subformula_of G '&' H;

theorem 
  F '&' G is_subformula_of H implies F is_proper_subformula_of H & G
  is_proper_subformula_of H;

theorem 
  F is_subformula_of H iff F is_proper_subformula_of All(x,H);

theorem 
  All(x,H) is_subformula_of F implies H is_proper_subformula_of F;

theorem 
  F '&' 'not' G is_proper_subformula_of F => G & F
  is_proper_subformula_of F => G & 'not' G is_proper_subformula_of F => G & G
  is_proper_subformula_of F => G;

theorem 
  'not' F '&' 'not' G is_proper_subformula_of F 'or' G & 'not' F
is_proper_subformula_of F 'or' G & 'not' G is_proper_subformula_of F 'or' G & F
  is_proper_subformula_of F 'or' G & G is_proper_subformula_of F 'or' G;

theorem 
  H is atomic implies not F is_proper_subformula_of H;

theorem 
  H is negative implies the_argument_of H is_proper_subformula_of H;

theorem 
  H is conjunctive implies the_left_argument_of H
  is_proper_subformula_of H & the_right_argument_of H is_proper_subformula_of H
;

theorem 
  H is universal implies the_scope_of H is_proper_subformula_of H;

theorem 
  H is_subformula_of VERUM(A) iff H = VERUM(A);

theorem 
  H is_subformula_of P!V iff H = P!V;

theorem 
  H is_subformula_of FALSUM(A) iff H = FALSUM(A) or H = VERUM(A);





definition
  let A be QC-alphabet;
  let H be Element of QC-WFF(A);
  func Subformulae H -> set means


  for a being set holds a in it iff ex F being Element of QC-WFF(A)
   st F = a & F is_subformula_of H;
end;

theorem 
  G in Subformulae H implies G is_subformula_of H;

theorem 
  F is_subformula_of H implies Subformulae F c= Subformulae H;

theorem 
  G in Subformulae H implies Subformulae G c= Subformulae H;

theorem 
  Subformulae(VERUM(A)) = { VERUM(A) };

theorem 
  Subformulae(P!V) = { P!V };

theorem 
  Subformulae(FALSUM(A)) = { VERUM(A), FALSUM(A) };

theorem 
  Subformulae 'not' H = Subformulae H \/ { 'not' H };

theorem 
  Subformulae (H '&' F) = Subformulae H \/ Subformulae F \/ { H '&' F };

theorem 
  Subformulae All(x,H) = Subformulae H \/ { All(x,H) };

theorem 
  Subformulae (F => G) = Subformulae F \/ Subformulae G \/ {
  'not' G, F '&' 'not' G, F => G };

theorem 
  Subformulae (F 'or' G) = Subformulae F \/ Subformulae G \/ {'not' G,
  'not' F, 'not' F '&' 'not' G, F 'or' G};

theorem 
  Subformulae (F <=> G) = Subformulae F \/ Subformulae G \/ { 'not' G, F
  '&' 'not' G, F => G, 'not' F, G '&' 'not' F, G => F, F <=> G };

theorem 
  H = VERUM(A) or H is atomic iff Subformulae H = { H };

theorem 
  H is negative implies Subformulae H = Subformulae the_argument_of H \/ { H };

theorem 
  H is conjunctive implies Subformulae H = Subformulae
  the_left_argument_of H \/ Subformulae the_right_argument_of H \/ { H };

theorem 
  H is universal implies Subformulae H = Subformulae the_scope_of H \/ { H };

theorem 
  (H is_immediate_constituent_of G or H is_proper_subformula_of G or H
  is_subformula_of G) & G in Subformulae F implies H in Subformulae F;














begin

reserve i,k for Element of NAT;

scheme 

  QCFuncUniq { Al() -> QC-alphabet, D() -> non empty set,
               F1,F2() -> (Function of QC-WFF(Al()), D()),
               V() -> (Element of D()),
               A,N(set) -> (Element of D()),
               C(set,set) -> (Element of D()),
               Q(set,set) -> Element of D()}
       :
   F1() = F2()
provided
 for p being Element of QC-WFF(Al()) for d1,d2 being Element of D() holds
(p = VERUM(Al()) implies F1().p = V()) &
(p is atomic implies F1().p = A(p)) & (p is negative &
d1 = F1().the_argument_of p implies F1().p = N(d1)) &
(p is conjunctive & d1 = F1().the_left_argument_of p &
d2 = F1().the_right_argument_of p implies F1().p = C(
d1, d2)) & (p is universal & d1 = F1().the_scope_of p implies
F1().p = Q(p, d1)) and
 for p being Element of QC-WFF(Al()) for d1,d2 being Element of D() holds
(p = VERUM(Al()) implies F2().p = V()) & (p is atomic implies F2().p = A(p)) &
(p is negative & d1 = F2().the_argument_of p implies F2().p = N(d1)) &
(p is conjunctive & d1 = F2().the_left_argument_of p &
d2 = F2().the_right_argument_of p implies F2().p = C(d1, d2)) &
(p is universal & d1 = F2().the_scope_of p implies F2().p = Q(p, d1));

scheme 

  QCDefD { Al() -> QC-alphabet,
           D() -> non empty set,
           V() -> (Element of D()),
           p() -> (Element of QC-WFF(Al())),
           A(Element of QC-WFF(Al())) -> (Element of D()),
           N(Element of D()) -> (Element of D()),
           C((Element of D()),Element of D()) -> (Element of D()),
           Q((Element of QC-WFF(Al())),
           Element of D()) -> Element of D()}
      :
      (ex d being (Element of D()), F being Function of QC-WFF(Al()),
      D() st d = F.p() & for p being Element of QC-WFF(Al())
      for d1,d2 being Element of D() holds
      (p = VERUM(Al()) implies F.p = V()) & (p is atomic implies F.p = A(p)) &
      (p is negative & d1 = F.the_argument_of p implies F.p = N(d1)) &
      (p is conjunctive & d1 = F.the_left_argument_of p &
       d2 = F.the_right_argument_of p implies F.p = C(d1, d2)) &
      (p is universal & d1 = F.the_scope_of p implies F.p = Q(p, d1)) ) &
      for x1,x2 being Element of D() st (ex F being Function of QC-WFF(Al()),
      D() st x1 = F.p() & for p being Element of QC-WFF(Al())
      for d1,d2 being Element of D() holds
      (p = VERUM(Al()) implies F.p = V()) & (p is atomic implies F.p = A(p)) &
      (p is negative & d1 = F.the_argument_of p implies F.p = N(d1)) &
      (p is conjunctive & d1 = F.the_left_argument_of p &
       d2 = F.the_right_argument_of p implies F.p = C(d1, d2)) &
      (p is universal & d1 = F.the_scope_of p implies F.p = Q(p, d1)) ) &
      (ex F being Function of QC-WFF(Al()), D() st x2 = F.p() &
      for p being Element of QC-WFF(Al()) for d1,d2 being Element of D()
      holds (p = VERUM(Al()) implies F.p = V()) &
      (p is atomic implies F.p = A(p)) &
      (p is negative & d1 = F.the_argument_of p implies F.p = N(d1)) &
      (p is conjunctive & d1 = F.the_left_argument_of p &
      d2 = F.the_right_argument_of p implies F.p = C(d1, d2)) &
      (p is universal & d1 = F.the_scope_of p implies F.p = Q(p, d1)) )
      holds x1 = x2;

scheme 

  QCDResult9VERUM { Al() -> QC-alphabet, D() -> non empty set,
    F(Element of QC-WFF(Al())) -> (Element of D()), V() -> (Element of D()),
    A(Element of QC-WFF(Al())) -> (Element of D()),
    N(Element of D()) -> (Element of D()), C((Element of D()),
    Element of D()) -> (Element of D()), Q((Element of QC-WFF(Al())),
    Element of D()) -> Element of D()} : F(VERUM(Al())) = V()
provided
 for p being QC-formula of Al(), d being Element of D() holds d = F(p)
iff ex F being Function of QC-WFF(Al()), D() st d = F.p &
for p being Element of QC-WFF(Al()) for
d1,d2 being Element of D() holds (p = VERUM(Al())
implies F.p = V()) & (p is atomic
implies F.p = A(p)) & (p is negative & d1 = F.the_argument_of p implies F.p = N
(d1)) & (p is conjunctive & d1 = F.the_left_argument_of p & d2 = F.
the_right_argument_of p implies F.p = C(d1, d2)) & (p is universal & d1 = F.
the_scope_of p implies F.p = Q(p, d1));

scheme 

  QCDResult9atomic { Al() -> QC-alphabet, D() -> non empty set,
    V() -> (Element of D()), F(Element of QC-WFF(Al())) -> (Element of D()),
    p() -> QC-formula of Al(), A(Element of QC-WFF(Al())) -> (Element of D()),
    N(Element of D()) -> (Element of D()), C((Element of D()),
    Element of D()) -> (Element of D()),
    Q((Element of QC-WFF(Al())), Element of D()) -> Element of D()}
  :
F(p()) = A(p())
provided
 for p being QC-formula of Al(), d being Element of D() holds d = F(p)
iff ex F being Function of QC-WFF(Al()), D() st d = F.p &
for p being Element of QC-WFF(Al()) for
d1,d2 being Element of D() holds (p = VERUM(Al()) implies F.p = V()) &
(p is atomic implies F.p = A(p)) & (p is negative &
d1 = F.the_argument_of p implies F.p = N(d1)) &
(p is conjunctive & d1 = F.the_left_argument_of p & d2 = F.
the_right_argument_of p implies F.p = C(d1, d2)) &
(p is universal & d1 = F.the_scope_of p implies F.p = Q(p, d1)) and
 p() is atomic;

scheme 

  QCDResult9negative { Al() -> QC-alphabet, D() -> non empty set,
    V() -> (Element of D()), p() -> QC-formula of Al(),
    A(Element of QC-WFF(Al())) -> (Element of D()),
    N(Element of D()) -> (Element of D()), C((Element of D()),
    Element of D()) -> (Element of D()), Q((Element of QC-WFF(Al())),
    Element of D()) -> (Element of D()), F(Element of QC-WFF(Al()))
      -> (Element of D()) }
  :
F(p()) = N(F(the_argument_of p()))
provided
 for p being QC-formula of Al(), d being Element of D() holds d = F(p)
iff ex F being Function of QC-WFF(Al()), D() st d = F.p
& for p being Element of QC-WFF(Al()) for
d1,d2 being Element of D() holds (p = VERUM(Al()) implies F.p = V())
& (p is atomic implies F.p = A(p)) &
(p is negative & d1 = F.the_argument_of p implies F.p = N (d1)) &
(p is conjunctive & d1 = F.the_left_argument_of p & d2 = F.
the_right_argument_of p implies F.p = C(d1, d2)) &
(p is universal & d1 = F.the_scope_of p implies F.p = Q(p, d1)) and
 p() is negative;

scheme 

  QCDResult9conjunctive { Al() -> QC-alphabet, D() -> non empty set,
    V() -> (Element of D()), A(Element of QC-WFF(Al())) -> (Element of D()),
    N(Element of D()) -> (Element of D()), C((Element of D()),
    Element of D()) -> (Element of D()), Q((Element of QC-WFF(Al())),
    Element of D()) -> (Element of D()),
    F(Element of QC-WFF(Al())) -> (Element of D()),
    p() -> QC-formula of Al() } : for d1,d2 being Element of D() st d1 = F(
    the_left_argument_of p()) & d2 = F(the_right_argument_of p())
    holds F(p()) = C(d1,d2)
provided
 for p being QC-formula of Al(), d being Element of D() holds d = F(p)
iff ex F being Function of QC-WFF(Al()), D() st d = F.p &
for p being Element of QC-WFF(Al()) for
d1,d2 being Element of D() holds (p = VERUM(Al()) implies F.p = V()) &
(p is atomic implies F.p = A(p)) &
(p is negative & d1 = F.the_argument_of p implies F.p = N
(d1)) & (p is conjunctive & d1 = F.the_left_argument_of p & d2 = F.
the_right_argument_of p implies F.p = C(d1, d2)) & (p is universal & d1 = F.
the_scope_of p implies F.p = Q(p, d1)) and
 p() is conjunctive;

scheme 

  QCDResult9universal { Al() -> QC-alphabet, D() -> non empty set,
    V() -> (Element of D()), p() -> QC-formula of Al(),
    A(Element of QC-WFF(Al())) -> (Element of D()),
    N(Element of D()) -> (Element of D()), C((Element of D()),
    Element of D()) -> (Element of D()), Q((Element of QC-WFF(Al())),
    Element of D()) -> (Element of D()),
    F(Element of QC-WFF(Al())) -> (Element of D()) }
  :
  F(p()) = Q(p(),F(the_scope_of p()))
provided
 for p being QC-formula of Al(), d being Element of D() holds d = F(p)
iff ex F being Function of QC-WFF(Al()), D() st d = F.p &
for p being Element of QC-WFF(Al()) for
d1,d2 being Element of D() holds (p = VERUM(Al()) implies F.p = V()) &
(p is atomic implies F.p = A(p)) & (p is negative &
d1 = F.the_argument_of p implies F.p = N(d1)) & (p is conjunctive &
d1 = F.the_left_argument_of p & d2 = F.the_right_argument_of p implies
F.p = C(d1, d2)) & (p is universal &
d1 = F.the_scope_of p implies F.p = Q(p, d1)) and
 p() is universal;

reserve A for QC-alphabet;
reserve x for bound_QC-variable of A;
reserve a for free_QC-variable of A;
reserve p,q for Element of QC-WFF(A);
reserve l for FinSequence of QC-variables(A);
reserve P,Q for QC-pred_symbol of A;
reserve V for non empty Subset of QC-variables(A);
reserve s,t for QC-symbol of A;

theorem 
  P is QC-pred_symbol of the_arity_of P, A;

definition
  let A,l,V;
  func variables_in(l,V) -> Subset of V equals

  { l.k : 1 <= k & k <= len l & l.k in V };
end;

theorem 
  still_not-bound_in l = variables_in(l,bound_QC-variables(A));

theorem 
  still_not-bound_in VERUM(A) = {};

theorem 
  for p being QC-formula of A st p is atomic holds still_not-bound_in p
  = still_not-bound_in the_arguments_of p;

theorem 
  for P being QC-pred_symbol of k,A for l being QC-variable_list of k, A
  holds still_not-bound_in (P!l) = still_not-bound_in l;

theorem 
  for p being QC-formula of A st p is negative holds still_not-bound_in
  p = still_not-bound_in the_argument_of p;

theorem 
  for p being QC-formula of A holds still_not-bound_in 'not' p =
  still_not-bound_in p;

theorem 
  still_not-bound_in FALSUM(A) = {};

theorem 
  for p being QC-formula of A st p is conjunctive holds
  still_not-bound_in p = (still_not-bound_in the_left_argument_of p) \/ (
  still_not-bound_in the_right_argument_of p);

theorem 
  for p,q being QC-formula of A holds still_not-bound_in(p '&' q) = (
  still_not-bound_in p) \/ (still_not-bound_in q);

theorem 
  for p being QC-formula of A st p is universal holds
  still_not-bound_in p = (still_not-bound_in the_scope_of p) \ {bound_in p};

theorem 
  for p being QC-formula of A holds still_not-bound_in All(x,p) = (
  still_not-bound_in p) \ {x};

theorem 
  for p being QC-formula of A st p is disjunctive holds
  still_not-bound_in p = (still_not-bound_in the_left_disjunct_of p) \/ (
  still_not-bound_in the_right_disjunct_of p);

theorem 
  for p,q being QC-formula of A holds still_not-bound_in p 'or' q = (
  still_not-bound_in p) \/ (still_not-bound_in q);

theorem 
  for p being QC-formula of A st p is conditional holds
  still_not-bound_in p = (still_not-bound_in the_antecedent_of p) \/ (
  still_not-bound_in the_consequent_of p);

theorem 
  for p,q being QC-formula of A holds still_not-bound_in p => q = (
  still_not-bound_in p) \/ (still_not-bound_in q);

theorem 
  for p being QC-formula of A st p is biconditional holds
  still_not-bound_in p = (still_not-bound_in the_left_side_of p) \/ (
  still_not-bound_in the_right_side_of p);

theorem 
  for p,q being QC-formula of A holds still_not-bound_in p <=> q = (
  still_not-bound_in p) \/ (still_not-bound_in q);

theorem 
  for p being QC-formula of A holds still_not-bound_in Ex(x,p) = (
  still_not-bound_in p) \ {x};

theorem 
  VERUM(A) is closed & FALSUM(A) is closed;

theorem 
  for p being QC-formula of A holds p is closed iff 'not' p is closed;

theorem 
  for p,q being QC-formula of A holds p is closed & q is closed iff p
  '&' q is closed;

theorem 
  for p being QC-formula of A holds All(x,p) is closed iff
  still_not-bound_in p c= {x};

theorem 
  for p being QC-formula of A st p is closed holds All(x,p) is closed;

theorem 
  for p,q being QC-formula of A holds p is closed & q is closed iff p 'or' q
  is closed;

theorem 
  for p,q being QC-formula of A holds p is closed &
   q is closed iff p => q is closed;

theorem 
  for p,q being QC-formula of A holds p is closed & q is closed iff p <=> q
  is closed;

theorem 
  for p being QC-formula of A holds Ex(x,p) is closed iff
  still_not-bound_in p c= {x};

theorem 
  for p being QC-formula of A st p is closed holds Ex(x,p) is closed;

definition
  let A,s;
  func x.s -> bound_QC-variable of A equals

  [4,s];
end;

theorem 
  ex t st x.t = x;

definition
  let A,k;
  func (A)a.k -> free_QC-variable of A equals

  [6,k];
end;

theorem 
  ex i st (A)a.i = a;

theorem 
  for c being Element of fixed_QC-variables(A) for a being Element of
  free_QC-variables(A) holds c <> a;

theorem 
  for c being Element of fixed_QC-variables(A) for x being Element of
  bound_QC-variables(A) holds c <> x;

theorem 
  for a being Element of free_QC-variables(A) for x being Element of
  bound_QC-variables(A) holds a <> x;

definition
  let A,V,p;
  func Vars(p,V) -> Subset of V means


  ex F being Function of QC-WFF(A),
bool V st it = F.p & for p being Element of QC-WFF(A)
for d1,d2 being Subset of V
holds (p = VERUM(A) implies F.p = {}(V)) &
(p is atomic implies F.p = variables_in
(the_arguments_of p,V)) & (p is negative & d1 = F.the_argument_of p implies F.p
  = d1) & (p is conjunctive & d1 = F.the_left_argument_of p & d2 = F.
  the_right_argument_of p implies F.p = d1 \/ d2) & (p is universal & d1 = F.
  the_scope_of p implies F.p = d1);
end;

theorem 
  Vars(VERUM(A),V) = {};

theorem 
  p is atomic implies Vars(p,V) = variables_in(the_arguments_of p,
V) & Vars(p,V) = { (the_arguments_of p).k : 1 <= k & k <= len (the_arguments_of
  p) & (the_arguments_of p).k in V };

theorem 
  for P being QC-pred_symbol of k, A for l being QC-variable_list of
  k, A holds Vars(P!l,V) = variables_in(l, V) &
  Vars((P!l),V) = { l.i : 1 <= i & i
  <= len l & l.i in V };

theorem 
  p is negative implies Vars(p,V) = Vars(the_argument_of p,V);

theorem 
  Vars('not' p,V) = Vars(p,V);

theorem 
  Vars(FALSUM(A),V) = {};

theorem 
  p is conjunctive implies Vars(p,V) = Vars(the_left_argument_of p,V) \/
  Vars(the_right_argument_of p,V);

theorem 
  Vars(p '&' q,V) = Vars(p,V) \/ Vars(q,V);

theorem 
  p is universal implies Vars(p,V) = Vars(the_scope_of p,V);

theorem 
  Vars(All(x,p),V) = Vars(p,V);

theorem 
  p is disjunctive implies Vars(p,V) = Vars(the_left_disjunct_of p
  ,V) \/ Vars(the_right_disjunct_of p,V);

theorem 
  Vars(p 'or' q, V) = Vars(p,V) \/ Vars(q,V);

theorem 
  p is conditional implies Vars(p,V) = Vars(the_antecedent_of p,V)
  \/ Vars(the_consequent_of p,V);

theorem 
  Vars(p => q,V) = Vars(p,V) \/ Vars(q,V);

theorem 
  p is biconditional implies Vars(p,V) = Vars(the_left_side_of p,V
  ) \/ Vars(the_right_side_of p,V);

theorem 
  Vars(p <=> q,V) = Vars(p,V) \/ Vars(q,V);

theorem 
  p is existential implies Vars(p,V) = Vars(the_argument_of the_scope_of
  the_argument_of p, V);

theorem 
  Vars(Ex(x,p), V) = Vars(p,V);

definition
  let A,p;
  func Free p -> Subset of free_QC-variables(A) equals

  Vars(p,free_QC-variables(A));
end;

theorem 
  Free VERUM(A) = {};

theorem 
  for P being QC-pred_symbol of k, A for l being QC-variable_list of k, A
  holds Free(P!l) = { l.i : 1 <= i & i <= len l & l.i in free_QC-variables(A)};

theorem 
  Free 'not' p = Free p;

theorem 
  Free FALSUM(A) = {};

theorem 
  Free(p '&' q) = Free p \/ Free q;

theorem 
  Free(All(x,p)) = Free(p);

theorem 
  Free(p 'or' q) = Free p \/ Free q;

theorem 
  Free(p => q) = Free p \/ Free q;

theorem 
  Free(p <=> q) = Free p \/ Free q;

theorem 
  Free Ex(x,p) = Free p;

definition
  let A,p;
  func Fixed p -> Subset of fixed_QC-variables(A) equals

  Vars(p,fixed_QC-variables(A));
end;

theorem 
  Fixed VERUM(A) = {};

theorem 
  for P being QC-pred_symbol of k,A for l being QC-variable_list of k,A
holds Fixed(P!l) = { l.i : 1 <= i & i <= len l & l.i in fixed_QC-variables(A)};

theorem 
  Fixed 'not' p = Fixed p;

theorem 
  Fixed FALSUM(A) = {};

theorem 
  Fixed(p '&' q) = Fixed p \/ Fixed q;

theorem 
  Fixed(All(x,p)) = Fixed(p);

theorem 
  Fixed(p 'or' q) = Fixed p \/ Fixed q;

theorem 
  Fixed(p => q) = Fixed p \/ Fixed q;

theorem 
  Fixed(p <=> q) = Fixed p \/ Fixed q;

theorem 
  Fixed Ex(x,p) = Fixed p;














begin

reserve A for QC-alphabet;
reserve i,j,k for Element of NAT;

theorem 
  for x being set holds x in QC-variables(A) iff x in
  fixed_QC-variables(A) or x in free_QC-variables(A) or
  x in bound_QC-variables(A);

definition
  let A;
  mode Substitution of A is PartFunc of free_QC-variables(A),QC-variables(A);
end;

reserve f for Substitution of A;

definition
  let A;
  let l be FinSequence of QC-variables(A);
  let f;
  func Subst(l,f) -> FinSequence of QC-variables(A) means


  len it = len l &
for k st 1 <= k & k <= len l holds (l.k in dom f implies it.k = f.(l.k)) & (not
  l.k in dom f implies it.k = l.k);
end;

registration
  let A,k;
  let l be QC-variable_list of k, A;
  let f;
  cluster Subst(l,f) -> k-element;
end;

theorem 
  for x being bound_QC-variable of A, a being free_QC-variable of A holds
   a .--> x is Substitution of A;

definition
  let A;
  let a be free_QC-variable of A, x be bound_QC-variable of A;
  redefine func a .--> x -> Substitution of A;
end;

theorem 
  for x being bound_QC-variable of A, a being free_QC-variable of A,
  l, ll being FinSequence of QC-variables(A)
  holds
  f = a .--> x & ll = Subst(l,f) & 1 <= k & k <= len l implies (l.
  k = a implies ll.k = x) & (l.k <> a implies ll.k = l.k);

definition
  let A;
  func CQC-WFF(A) -> Subset of QC-WFF(A) equals

  {s where s is QC-formula of A: Fixed s = {} & Free s = {} };
end;

registration
  let A;
  cluster CQC-WFF(A) -> non empty;
end;

theorem 
  for p being Element of QC-WFF(A) holds
  p is Element of CQC-WFF(A) iff Fixed p = {} & Free p = {};

registration
  let A;
  let k;
  cluster bound_QC-variables(A)-valued for QC-variable_list of k, A;
end;

definition
  let A,k;
  mode CQC-variable_list of k, A is bound_QC-variables(A)-valued
       QC-variable_list of k,A;
end;

theorem 
  for l being QC-variable_list of k, A holds l is CQC-variable_list
of k,A iff { l.i : 1 <= i & i <= len l & l.i in free_QC-variables(A) }
           = {} & { l.j
  : 1 <= j & j <= len l & l.j in fixed_QC-variables(A) } = {};


theorem 
  VERUM(A) is Element of CQC-WFF(A);

theorem 
  for P being QC-pred_symbol of k,A for l being QC-variable_list of
  k,A holds P!l is Element of CQC-WFF(A) iff
  { l.i : 1 <= i & i <= len l & l.i in
  free_QC-variables(A) } = {} & { l.j : 1 <= j & j <= len l & l.j in
  fixed_QC-variables(A) } = {};

definition
  let k,A;
  let P be QC-pred_symbol of k,A;
  let l be CQC-variable_list of k,A;
  redefine func P!l -> Element of CQC-WFF(A);
end;

theorem 
  for p being Element of QC-WFF(A) holds
  'not' p is Element of CQC-WFF(A) iff p is Element of CQC-WFF(A);

theorem 
  for p,q being Element of QC-WFF(A) holds
  p '&' q is Element of CQC-WFF(A) iff p is Element of CQC-WFF(A) & q is
  Element of CQC-WFF(A);

definition
  let A;
  redefine func VERUM(A) -> Element of CQC-WFF(A);
  let r be Element of CQC-WFF(A);
  redefine func 'not' r -> Element of CQC-WFF(A);
  let s be Element of CQC-WFF(A);
  redefine func r '&' s -> Element of CQC-WFF(A);
end;

theorem 
  for r,s being Element of CQC-WFF(A) holds
  r => s is Element of CQC-WFF(A);

theorem 
  for r,s being Element of CQC-WFF(A) holds
  r 'or' s is Element of CQC-WFF(A);

theorem 
  for r,s being Element of CQC-WFF(A) holds
  r <=> s is Element of CQC-WFF(A);

definition
  let A;
  let r,s be Element of CQC-WFF(A);
  redefine func r => s -> Element of CQC-WFF(A);
  redefine func r 'or' s -> Element of CQC-WFF(A);
  redefine func r <=> s -> Element of CQC-WFF(A);
end;

theorem 
  for x being bound_QC-variable of A, p being Element of QC-WFF(A) holds
  All(x,p) is Element of CQC-WFF(A) iff p is Element of CQC-WFF(A);

definition
  let A;
  let x be bound_QC-variable of A,r be Element of CQC-WFF(A);
  redefine func All(x,r) -> Element of CQC-WFF(A);
end;

theorem 
  for x being bound_QC-variable of A,r being Element of CQC-WFF(A) holds
  Ex(x,r) is Element of CQC-WFF(A);

definition
  let A;
  let x be bound_QC-variable of A,r be Element of CQC-WFF(A);
  redefine func Ex(x,r) -> Element of CQC-WFF(A);
end;

scheme 

  CQCInd { A() -> QC-alphabet, P[set] }
:
for r being Element of CQC-WFF(A()) holds P[r]
provided
 for r,s being Element of CQC-WFF(A())
for x being bound_QC-variable of A() for k
for l being CQC-variable_list of k, A() for P being
QC-pred_symbol of k,A() holds P[VERUM(A())] & P[P!l] &
 (P[r] implies P['not' r]) & (P[r]
& P[s] implies P[r '&' s]) & (P[r] implies P[All(x, r)]);

scheme 

  CQCFuncEx { Al() -> QC-alphabet, D() -> non empty set,
V() -> (Element of D()), A(set,set,set) -> (Element of D()),
N(set) -> (Element of D()), C(set,set) -> (Element of D()),
Q(set,set) -> Element of D()} : ex F being Function of CQC-WFF(Al()),
D() st F.VERUM(Al()) = V() &
for r,s being Element of CQC-WFF(Al())
for x being bound_QC-variable of Al()
for k
for l being CQC-variable_list of k, Al()
for P being QC-pred_symbol of k,Al() holds F.(P!l) = A(k,P,l) &
F.('not' r) = N(F.r) & F.(r '&' s) = C(F.r,F.s)& F.All(x,r) = Q(x,F.r);

scheme 

  CQCFuncUniq { Al() -> QC-alphabet, D() -> non empty set,
  F1() -> (Function of CQC-WFF(Al()), D()),
  F2()-> (Function of CQC-WFF(Al()), D()),
  V() -> (Element of D()), A(set,set,set) -> (Element of D()),
  N(set) -> (Element of D()), C(set,set) -> (Element of D()),
  Q(set,set) -> Element of D()} : F1() = F2()
provided
 F1().VERUM(Al()) = V() &
  for r,s being Element of CQC-WFF(Al())
  for x being bound_QC-variable of Al()
  for k
for l being CQC-variable_list of k, Al()
for P being QC-pred_symbol of k,Al() holds F1().(P!l) = A(k,P,l) &
F1().('not' r) = N(F1().r) & F1().(r '&' s) = C(F1().r,F1().s) &
F1().All(x,r) = Q(x,F1().r) and
 F2().VERUM(Al()) = V() &
  for r,s being Element of CQC-WFF(Al())
  for x being bound_QC-variable of Al()
  for k
for l being CQC-variable_list of k, Al()
for P being QC-pred_symbol of k,Al() holds F2().(P!l) =
A(k,P,l) & F2().('not' r) =
N(F2().r) & F2().(r '&' s) = C(F2().r,F2().s) & F2().All(x,r) = Q(x,F2().r);

scheme 

  CQCDefcorrectness { Al() -> QC-alphabet, D() -> non empty set,
    p() -> (Element of CQC-WFF(Al())), V() -> (Element of D()),
    A(set,set,set) -> (Element of D()), N(set) -> (Element of D()),
    C(set,set) -> (Element of D()), Q(set,set) -> Element of D()}
:
  (ex d being Element of D() st ex F being Function of CQC-WFF(Al()),
   D() st d = F.p() & F.VERUM(Al()) = V() &
  for r,s being Element of CQC-WFF(Al())
  for x being bound_QC-variable of Al()
  for k
   for l being CQC-variable_list of k, Al() for P being
   QC-pred_symbol of k,Al() holds F.(P!l) = A(k,P,l) & F.('not' r) = N(F.r) &
   F.(r '&' s) = C(F.r,F.s) & F.All(x,r) = Q(x,F.r) ) &
   for d1,d2 being Element of D() st (ex F being Function of CQC-WFF(Al()),
   D() st d1 = F.p() & F.VERUM(Al()) = V() &
  for r,s being Element of CQC-WFF(Al())
  for x being bound_QC-variable of Al()
  for k
   for l being CQC-variable_list of k, Al()
   for P being QC-pred_symbol of k,Al()
   holds F.(P!l) = A(k,P,l) & F.('not' r) = N(F.r) &
   F.(r '&' s) = C(F.r,F.s) & F.All(x,r) = Q(x,F.r) ) &
   (ex F being Function of CQC-WFF(Al()), D() st d2 = F.p() &
   F.VERUM(Al()) = V() &
  for r,s being Element of CQC-WFF(Al())
  for x being bound_QC-variable of Al()
  for k
for l being CQC-variable_list of k, Al()
   for P being QC-pred_symbol of k,Al() holds F.(P!l) = A(k,P,l) &
   F.('not' r) = N(F.r) & F.(r '&' s) = C(F.r,F.s) &
   F.All(x,r) = Q(x,F.r) ) holds d1 = d2;

scheme 

  CQCDefVERUM { Al() -> QC-alphabet, D() -> non empty set,
F(set) -> (Element of D()), V() -> (Element of D()),
A(set,set,set) -> (Element of D()), N(set) -> (Element of D()),
C(set,set) -> (Element of D()), Q(set,set) -> Element of D()} :
F(VERUM(Al())) = V()
provided
 for p being (Element of CQC-WFF(Al())), d being Element of D() holds
d = F (p) iff ex F being Function of CQC-WFF(Al()), D() st
d = F.p & F.VERUM(Al()) = V() &
  for r,s being Element of CQC-WFF(Al())
  for x being bound_QC-variable of Al()
  for k
for l being CQC-variable_list of k, Al()
for P being QC-pred_symbol of k,Al() holds F.(P!l) = A(k,P,l) &
F.('not' r) = N(F.r) & F.(r '&' s) = C(F.r,F.s) & F.All(x,r) = Q(x,F.r);

scheme 

  CQCDefatomic { Al() -> QC-alphabet, D() -> non empty set,
V() -> (Element of D()), F(set) -> (Element of D()),
A(set,set,set) -> (Element of D()), k() -> Element of NAT, P()
  -> (QC-pred_symbol of k(),Al()), l() -> (CQC-variable_list of k(), Al()),
  N(set) -> (Element of D()), C(set,set) -> (Element of D()),
  Q(set,set) -> Element of D()}
  : F(P()!l()) = A(k(),P(),l())
provided
 for p being (Element of CQC-WFF(Al())), d being Element of D() holds d = F
(p) iff ex F being Function of CQC-WFF(Al()), D()
st d = F.p & F.VERUM(Al()) = V() &
  for r,s being Element of CQC-WFF(Al())
  for x being bound_QC-variable of Al()
  for k
for l being CQC-variable_list of k, Al()
for P being QC-pred_symbol of k,Al() holds
F.(P!l) = A(k,P,l) & F.('not' r) = N(F.r) & F.(r '&' s) = C(F.r,F.s) &
F.All(x,r) = Q(x,F.r);

scheme 

  CQCDefnegative { Al() -> QC-alphabet, D() -> non empty set,
F(set) -> (Element of D()), V() -> (Element of D()),
A(set,set,set) -> (Element of D()), N(set) -> (Element of D()),
r() -> (Element of CQC-WFF(Al())), C(set,set) -> (Element of D()),
Q(set,set) -> Element of D()}
:
F('not' r()) = N(F(r()))
provided
 for p being (Element of CQC-WFF(Al())), d being Element of D() holds
d = F (p) iff ex F being Function of CQC-WFF(Al()), D() st
d = F.p & F.VERUM(Al()) = V() &
  for r,s being Element of CQC-WFF(Al())
  for x being bound_QC-variable of Al()
  for k
for l being CQC-variable_list of k, Al()
for P being QC-pred_symbol of k,Al() holds
F.(P!l) = A(k,P,l) & F.('not' r) = N(F.r) & F.(r '&' s) = C(F.r,F.s) &
F.All(x,r) = Q(x,F.r);

scheme 

  QCDefconjunctive { Al() -> QC-alphabet, D() -> non empty set,
F(set) -> (Element of D()), V() -> (Element of D()),
A(set,set,set) -> (Element of D()), N(set) -> (Element of D()),
C(set,set) -> (Element of D()), r() -> (Element of CQC-WFF(Al())),
s() -> (Element of CQC-WFF(Al())), Q(set,set) -> Element of D()}
:
F(r() '&' s()) = C(F(r()), F(s()))
provided
 for p being (Element of CQC-WFF(Al())), d being Element of D() holds d = F
(p) iff ex F being Function of CQC-WFF(Al()), D() st d = F.p &
F.VERUM(Al()) = V() &
  for r,s being Element of CQC-WFF(Al())
  for x being bound_QC-variable of Al()
  for k
for l being CQC-variable_list of k, Al()
for P being QC-pred_symbol of k,Al() holds
F.(P!l) = A(k,P,l) & F.('not' r) = N(F.r) & F.(r '&' s) = C(F.r,F.s) &
F.All(x,r) = Q(x,F.r);

scheme 

  QCDefuniversal { Al() -> QC-alphabet, D() -> non empty set,
F(set) -> (Element of D()), V() -> (Element of D()),
A(set,set,set) -> (Element of D()), N(set) -> (Element of D()),
C(set,set) -> (Element of D()), Q(set,set) -> (Element of D()),
x() -> bound_QC-variable of Al(), r() -> Element of CQC-WFF(Al())}
:
F(All(x(),r())) = Q(x(),F(r()))
provided
 for p being (Element of CQC-WFF(Al())), d being Element of D() holds d = F
(p) iff ex F being Function of CQC-WFF(Al()), D() st
d = F.p & F.VERUM(Al()) = V() &
  for r,s being Element of CQC-WFF(Al())
  for x being bound_QC-variable of Al()
  for k
for l being CQC-variable_list of k, Al()
for P being QC-pred_symbol of k,Al() holds F.(P!l) = A(k,P,l) &
F.('not' r) = N(F.r) & F.(r '&' s) = C(F.r,F.s) & F.All(x,r) = Q(x,F.r);

reserve x,y for bound_QC-variable of A;
reserve a for free_QC-variable of A;
reserve p,q for Element of QC-WFF(A);
reserve l,l1,l2,ll for FinSequence of QC-variables(A);
reserve r,s for Element of CQC-WFF(A);

definition
  let A,p,x;
  func p.x -> Element of QC-WFF(A) means


  ex F being Function of QC-WFF(A),
QC-WFF(A) st it = F.p & for q holds F.VERUM(A) = VERUM(A) &
(q is atomic implies F.q =
(the_pred_symbol_of q)!Subst(the_arguments_of q,(A)a.0.-->x)) &
(q is negative implies F.q = 'not' (F.the_argument_of q) ) &
(q is conjunctive implies F.q = (F.the_left_argument_of q) '&'
(F.the_right_argument_of q)) & (q is universal implies F.q =
IFEQ(bound_in q,x,q,All(bound_in q,F.the_scope_of q)));
end;

theorem 
  VERUM(A).x = VERUM(A);

theorem 
  p is atomic implies p.x = (the_pred_symbol_of p)!Subst(
  the_arguments_of p,(A)a.0.-->x);

theorem 
  for P being QC-pred_symbol of k,A for l being QC-variable_list of
  k,A holds (P!l).x = P!Subst(l,(A)a.0.-->x);

theorem 
  p is negative implies p.x = 'not'((the_argument_of p).x);

theorem 
  ('not' p).x = 'not'(p.x);

theorem 
  p is conjunctive implies p.x = ((the_left_argument_of p).x) '&'
  ((the_right_argument_of p).x);

theorem 
  (p '&' q).x = (p.x) '&' (q.x);

theorem 
  p is universal & bound_in p = x implies p.x = p;

theorem 
  p is universal & bound_in p <> x implies p.x = All(bound_in p,(
  the_scope_of p).x);

theorem 
  (All(x,p)).x = All(x,p);

theorem 
  x<>y implies (All(x,p)).y = All(x,p.y);

theorem 
  Free p = {} implies p.x = p;

theorem 
  r.x = r;

theorem 
  Fixed(p.x) = Fixed p;

begin 


reserve i,j,k for set;

theorem 
  (i,j):->k = [i,j].-->k;

theorem 
  ((i,j):->k).(i,j) = k;



theorem 
  for a,b,c being set holds (a,a) --> (b,c) = a .--> c;



theorem 
  for f being Function, a,b,c being set st a <> c holds (f +* (a .-->b))
  .c = f.c;

theorem 
  for f being Function, a,b,c,d being set st a <> b holds (f +* ((a,b)
  -->(c,d))) .a = c & (f +* ((a,b)-->(c,d))) .b = d;















begin



reserve Al for QC-alphabet;
reserve i,j,n,k,l for Element of NAT;
reserve a for set;

theorem 
  {k: k <= n + 1} = {i: i <= n} \/ {n + 1};

theorem 
  for n holds {k: k <= n} is finite;

reserve X,Y,Z for set;

theorem 
  X is finite & X c= [:Y,Z:] implies
  ex A,B being set st A is finite & A c= Y & B is finite & B c= Z &
  X c= [:A,B:];

theorem 
  X is finite & Z is finite & X c= [:Y,Z:] implies
  ex A being set st A is finite & A c= Y & X c= [:A,Z:];



reserve T,S,X,Y for Subset of CQC-WFF(Al);
reserve p,q,r,t,F,H,G for Element of CQC-WFF(Al);
reserve s for QC-formula of Al;
reserve x,y for bound_QC-variable of Al;

definition
  let Al,T;
  attr T is being_a_theory means


  VERUM(Al) in T & for p,q,r,s,x,y holds
  ('not' p => p) => p in T & p => ('not' p => q) in T &
  (p => q) => ('not'(q '&' r) => 'not'(p '&' r)) in T &
  p '&' q => q '&' p in T & (p in T & p => q in T implies q in T) &
  All(x,p) => p in T &
  (p => q in T & not x in still_not-bound_in p implies p => All(x,q) in T) &
  (s.x in CQC-WFF(Al) & s.y in CQC-WFF(Al) & not x in still_not-bound_in s
&
s.x in T implies s.y in T);
end;

theorem 
  T is being_a_theory & S is being_a_theory implies T /\ S is being_a_theory;



definition
  let Al,X;
  func Cn(X) -> Subset of CQC-WFF(Al) means


  t in it iff for T st T is being_a_theory & X c= T holds t in T;
end;

theorem 
  VERUM(Al) in Cn(X);

theorem 
  ('not' p => p) => p in Cn(X);

theorem 
  p => ('not' p => q) in Cn(X);

theorem 
  (p => q) => ('not'(q '&' r) => 'not'(p '&' r)) in Cn(X);

theorem 
  p '&' q => q '&' p in Cn(X);

theorem 
  p in Cn(X) & p => q in Cn(X) implies q in Cn(X);

theorem 
  All(x,p) => p in Cn(X);

theorem 
  p => q in Cn(X) & not x in still_not-bound_in p implies
  p => All(x,q) in Cn(X);

theorem 
  s.x in CQC-WFF(Al) & s.y in CQC-WFF(Al) & not x in still_not-bound_in s &
  s.x in Cn(X) implies s.y in Cn(X);

theorem 
  Cn(X) is being_a_theory;

theorem 
  T is being_a_theory & X c= T implies Cn(X) c= T;

theorem 
  X c= Cn(X);

theorem 
  X c= Y implies Cn(X) c= Cn(Y);

theorem 
  Cn(Cn(X)) = Cn(X);

theorem 
  T is being_a_theory iff Cn(T) = T;



definition
  func Proof_Step_Kinds -> set equals

  {k: k <= 9};
end;

registration
  cluster Proof_Step_Kinds -> non empty;
end;

theorem 
  0 in Proof_Step_Kinds & 1 in Proof_Step_Kinds & 2 in Proof_Step_Kinds &
  3 in Proof_Step_Kinds & 4 in Proof_Step_Kinds & 5 in Proof_Step_Kinds &
  6 in Proof_Step_Kinds & 7 in Proof_Step_Kinds & 8 in Proof_Step_Kinds &
  9 in Proof_Step_Kinds;

theorem 
  Proof_Step_Kinds is finite;

reserve f,g for FinSequence of [:CQC-WFF(Al),Proof_Step_Kinds:];

theorem 
  for n being Nat holds 1 <= n & n <= len f implies
  (f.n)`2 = 0 or (f.n)`2 = 1 or (f.n)`2 = 2 or (f.n)`2 = 3 or (f.n)`2 = 4
  or (f.n)`2 = 5 or (f.n)`2 = 6 or (f.n)`2 = 7 or (f.n)`2 = 8 or (f.n)`2 = 9;

definition
  let Al;
  let PR be (FinSequence of [:CQC-WFF(Al),Proof_Step_Kinds:]),n be Nat,X;
  pred PR,n is_a_correct_step_wrt X means


  (PR.n)`1 in X if (PR.n)`2 = 0, (PR.n)`1 = VERUM(Al) if (PR.n)`2 = 1,
  ex p st (PR.n)`1 = ('not' p => p) => p if (PR.n)`2 = 2,
  ex p,q st (PR.n)`1 = p => ('not' p => q) if (PR.n)`2 = 3,
  ex p,q,r st (PR.n)`1 = (p => q) => ('not'(q '&' r) => 'not'(p '&' r))
  if (PR.n)`2 = 4, ex p,q st (PR.n)`1 = p '&' q => q '&' p if (PR.n)`2 = 5,
  ex p,x st (PR.n)`1 = All(x,p) => p if (PR.n)`2 = 6,
  ex i,j,p,q st 1 <= i & i < n & 1 <= j & j < i & p = (PR.j)`1 & q = (PR.n)`1 &
  (PR.i)`1 = p => q if (PR.n)`2 = 7,
  ex i,p,q,x st 1 <= i & i < n & (PR.i)`1 = p => q &
  not x in still_not-bound_in p & (PR.n)`1 = p => All(x,q) if (PR.n)`2 = 8,
  ex i,x,y,s st 1 <= i & i < n & s.x in CQC-WFF(Al) & s.y in CQC-WFF(Al) &
  not x in still_not-bound_in s & s.x = (PR.i)`1 & s.y = (PR.n)`1
  if (PR.n)`2 = 9;
end;

definition
  let Al,X,f;
  pred f is_a_proof_wrt X means


  f <> {} & for n st 1 <= n & n <= len f holds f,n is_a_correct_step_wrt X;
end;

theorem 
  f is_a_proof_wrt X implies rng f <> {};

theorem 
  f is_a_proof_wrt X implies 1 <= len f;

theorem 
  f is_a_proof_wrt X implies (f.1)`2 = 0 or (f.1)`2 = 1 or
  (f.1)`2 = 2 or (f.1)`2 = 3 or (f.1)`2 = 4 or (f.1)`2 = 5 or (f.1)`2 = 6;

theorem 
  1 <= n & n <= len f implies
  (f,n is_a_correct_step_wrt X iff f^g,n is_a_correct_step_wrt X);

theorem 
  1 <= n & n <= len g & g,n is_a_correct_step_wrt X implies
  (f^g),(n+len f) is_a_correct_step_wrt X;

theorem 
  f is_a_proof_wrt X & g is_a_proof_wrt X implies f^g is_a_proof_wrt X;

theorem 
  f is_a_proof_wrt X & X c= Y implies f is_a_proof_wrt Y;

theorem 
  f is_a_proof_wrt X & 1 <= l & l <= len f implies (f.l)`1 in Cn(X);

definition
  let Al,f;
  assume
 f <> {};
  func Effect(f) -> Element of CQC-WFF(Al) equals


  (f.(len f))`1;
end;

theorem 
  f is_a_proof_wrt X implies Effect(f) in Cn(X);

theorem 
  X c= {F: ex f st f is_a_proof_wrt X & Effect(f) = F};

theorem 
  for X holds Y = {p: ex f st f is_a_proof_wrt X & Effect(f) = p}
  implies Y is being_a_theory;

theorem 
  for X holds {p: ex f st f is_a_proof_wrt X & Effect(f) = p} = Cn(X);

theorem 
  p in Cn(X) iff ex f st f is_a_proof_wrt X & Effect(f) = p;

theorem 
  p in Cn(X) implies ex Y st Y c= X & Y is finite & p in Cn(Y);



definition
  let Al;
  func TAUT(Al) -> Subset of CQC-WFF(Al) equals

  Cn({}(CQC-WFF(Al)));
end;

theorem 
  T is being_a_theory implies TAUT(Al) c= T;

theorem 
  TAUT(Al) c= Cn(X);

theorem 
  TAUT(Al) is being_a_theory;

theorem 
  VERUM(Al) in TAUT(Al);

theorem 
  ('not' p => p) =>p in TAUT(Al);

theorem 
  p => ('not' p => q) in TAUT(Al);

theorem 
  (p => q) => ('not'(q '&' r) => 'not' (p '&' r)) in TAUT(Al);

theorem 
  p '&' q => q '&' p in TAUT(Al);

theorem 
  p in TAUT(Al) & p => q in TAUT(Al) implies q in TAUT(Al);

theorem 
  All(x,p) => p in TAUT(Al);

theorem 
  p => q in TAUT(Al) & not x in still_not-bound_in p implies
  p => All(x,q) in TAUT(Al);

theorem 
  s.x in CQC-WFF(Al) & s.y in CQC-WFF(Al) & not x in still_not-bound_in s
&
  s.x in TAUT(Al) implies s.y in TAUT(Al);



definition
  let Al,X,s;
  pred X|-s means


  s in Cn(X);
end;

theorem 
  X |- VERUM(Al);

theorem 
  X |- ('not' p => p) => p;

theorem 
  X |- p => ('not' p => q);

theorem 
  X |- (p => q) => ('not'(q '&' r) => 'not'(p '&' r));

theorem 
  X |- p '&' q => q '&' p;

theorem 
  X |- p & X |- p => q implies X |- q;

theorem 
  X |- All(x,p) => p;

theorem 
  X |- p => q & not x in still_not-bound_in p implies X |- p => All(x,q);

theorem 
  s.y in CQC-WFF(Al) & not x in still_not-bound_in s &
X |- s.x implies X |- s.y;

definition
  let Al,s;
  attr s is valid means


  {}(CQC-WFF(Al))|-s;
end;

definition
  let Al,s;
  redefine attr s is valid means

  s in TAUT(Al);
end;

theorem 
  p is valid implies X |- p;

theorem 
  VERUM(Al) is valid;

theorem 
  ('not' p => p) =>p is valid;

theorem 
  p => ('not' p => q) is valid;

theorem 
  (p => q) => ('not'(q '&' r) => 'not'(p '&' r)) is valid;

theorem 
  p '&' q => q '&' p is valid;

theorem 
  p is valid & p => q is valid implies q is valid;

theorem 
  All(x,p) => p is valid;

theorem 
  p => q is valid & not x in still_not-bound_in p
  implies p => All(x,q) is valid;

theorem 
  s.y in CQC-WFF(Al) & not x in still_not-bound_in s &
  s.x is valid implies s.y is valid;














begin

reserve Al for QC-alphabet;
reserve i,j,k for Element of NAT,
  A,D for non empty set;

definition
  let Al;
  let A be set;
  func Valuations_in(Al,A) -> set equals

  Funcs(bound_QC-variables(Al), A);
end;

registration
  let Al,A;
  cluster Valuations_in(Al,A) -> non empty functional;
end;

theorem 
  for x being set st x is Element of Valuations_in(Al,A) holds x is
  Function of bound_QC-variables(Al) ,A;

definition
  let Al,A;
  redefine func Valuations_in(Al,A) ->
       FUNCTION_DOMAIN of bound_QC-variables(Al), A;
end;

reserve f1,f2 for Element of Funcs(Valuations_in(Al,A),BOOLEAN),
  x,x1,y for bound_QC-variable of Al,
  v,v1 for Element of Valuations_in(Al,A);

definition
  let Al, A, x;
  let p be Element of Funcs(Valuations_in(Al,A),BOOLEAN);
  func FOR_ALL(x,p) -> Element of Funcs(Valuations_in(Al,A),BOOLEAN) means


for v holds it.v =
   ALL{p.v9 where v9 is Element of Valuations_in(Al,A) :
       for y st x <> y holds v9.y = v.y};
end;

theorem 
  for p being Element of Funcs(Valuations_in(Al,A),BOOLEAN) holds
FOR_ALL(x,p).v = FALSE iff ex v1 st p.v1 = FALSE & for y st x <> y holds
v1.y =
  v.y;

theorem 
  for p being Element of Funcs(Valuations_in(Al,A),BOOLEAN) holds
FOR_ALL(x,p).v = TRUE iff for v1 st for y st x <> y holds v1.y = v.y holds
p.v1
  = TRUE;

reserve ll for CQC-variable_list of k,Al;

notation
  let Al, A, k, ll, v;
  synonym v*'ll for v*ll;
end;

definition
  let Al;
  let A, k, ll, v;
  redefine func v*'ll -> FinSequence of A means


  len it = k & for i be natural number st
  1 <= i & i <= k holds it.i = v.(ll.i);
end;

definition
  let Al;
  let A, k, ll;
  let r be Element of relations_on A;
  func ll 'in' r -> Element of Funcs(Valuations_in(Al,A),BOOLEAN) means


  for
  v being Element of Valuations_in(Al,A) holds
   (v*'ll in r iff it.v = TRUE) & (not v*'ll in r iff it.v = FALSE);
end;

definition
  let Al, A;
  let F be Function of CQC-WFF(Al),Funcs(Valuations_in(Al,A), BOOLEAN);
  let p be Element of CQC-WFF(Al);
  redefine func F.p -> Element of Funcs(Valuations_in(Al,A), BOOLEAN);
end;

definition
  let Al, D;
  mode interpretation of Al,D -> Function of QC-pred_symbols(Al),
                                             relations_on D
    means

    for P being (Element of QC-pred_symbols(Al)),
    r being Element of relations_on
    D st it.P = r holds r = empty_rel(D) or the_arity_of P = the_arity_of r;
end;

reserve p,q,s,t for Element of CQC-WFF(Al),
  J for interpretation of Al,A,
  P for QC-pred_symbol of k,Al,
  r for Element of relations_on A;

definition
  let Al, A, k, J, P;
  redefine func J.P -> Element of relations_on A;
end;

definition
  let Al, A, J, p;
  func Valid(p,J) -> Element of Funcs(Valuations_in(Al,A), BOOLEAN) means


ex F being Function of CQC-WFF(Al),Funcs(Valuations_in(Al,A), BOOLEAN)
st it = F.p & F.VERUM(Al) = Valuations_in(Al,A) --> TRUE &
for p,q being Element of CQC-WFF(Al), x being bound_QC-variable of Al,
k being Element of NAT, ll being CQC-variable_list of k,Al, P
  being QC-pred_symbol of k,Al holds F.(P!ll) = (ll 'in' (J.P)) & F.('not' p) =
'not'(F.p) & (F.(p '&' q)) = ((F.p) '&' (F.q)) & F.(All(x,p)) =
(FOR_ALL(x,F.p));
end;

theorem 
  Valid(VERUM(Al),J) = Valuations_in(Al,A) --> TRUE;

theorem 
  Valid(VERUM(Al),J).v = TRUE;

theorem 
  Valid(P!ll,J) = ll 'in' (J.P);

theorem 
  p = P!ll & r = J.P implies (v*'ll in r iff Valid(p,J).v = TRUE);

theorem 
  p = P!ll & r = J.P implies (not v*'ll in r iff Valid(p,J).v = FALSE);

theorem 
  Valid('not' p,J) = 'not' Valid(p,J);

theorem 
  Valid('not' p,J).v = 'not'(Valid(p,J).v);

theorem 
  Valid(p '&'q,J) = Valid(p,J) '&' Valid(q,J);

theorem 
  Valid(p '&'q,J).v = (Valid(p,J).v) '&' (Valid(q,J).v);

theorem 
  Valid(All(x,p),J) = FOR_ALL(x,Valid(p,J));

theorem 
  Valid(p '&' 'not' p,J).v = FALSE;

theorem 
  Valid('not'(p '&' 'not' p),J).v = TRUE;

definition
  let Al, A, p, J, v;
  pred J,v |= p means


  Valid(p,J).v = TRUE;
end;

theorem 
  J,v |= P!ll iff (ll 'in' (J.P)).v = TRUE;

theorem 
  J,v |= 'not' p iff not J,v |= p;

theorem 
  J,v |= (p '&' q) iff J,v |= p & J,v |= q;

theorem 
  J,v |= All(x,p) iff FOR_ALL(x,Valid(p,J)).v = TRUE;

theorem 
  J,v |= All(x,p) iff for v1 st for y st x <> y holds v1.y = v.y
  holds Valid(p,J).v1 = TRUE;

theorem 
  Valid('not' 'not' p,J) = Valid(p,J);

theorem 
  Valid(p '&' p,J) = Valid(p,J);

theorem 
  J,v |= p => q iff Valid(p, J).v = FALSE or Valid(q, J).v = TRUE;

theorem 
  J,v |= p => q iff (J,v |= p implies J,v |= q);

theorem 
  for p being Element of Funcs(Valuations_in(Al,A),BOOLEAN) holds
  FOR_ALL(x,p).v = TRUE implies p.v = TRUE;

definition
  let Al, A, J, p;
  pred J |= p means


  for v holds J,v |= p;
end;

reserve u,w,z for Element of BOOLEAN;

reserve w,v2 for Element of Valuations_in(Al,A),
  z for bound_QC-variable of Al;

theorem 
  for A be non empty set, Y, Z be bound_QC-variable of Al,
   V1, V2 be Element of Valuations_in(Al,A)
  ex v being Element of Valuations_in(Al,A) st
   (for x being bound_QC-variable of Al st x <> Y holds v.x = V1.x) &
   v.Y = V2.Z;

theorem 
  not x in still_not-bound_in p implies for v,w st for y st x<>y
  holds w.y = v.y holds Valid(p,J).v = Valid(p,J).w;

theorem 
  J,v |= p & not x in still_not-bound_in p implies for w st for y
  st x<>y holds w.y = v.y holds J,w |= p;

theorem 
  J,v |= All(x,p) iff for w st for y st x<>y holds w.y = v.y holds J,w |= p;

reserve u,w for Element of Valuations_in(Al,A);
reserve s9 for QC-formula of Al;

theorem 
  x <> y & p = s9.x & q = s9.y implies for v st v.x = v.y holds
  Valid(p,J).v = Valid(q,J).v;

theorem 
  x <> y & not x in still_not-bound_in s9 implies not x in
  still_not-bound_in (s9.y);

theorem 
  J,v |= VERUM(Al);

theorem 
  J,v |= p '&' q => q '&' p;

theorem 
  J,v |= ('not' p => p) => p;

theorem 
  J,v |= p => ('not' p => q);

theorem 
  J,v |= (p => q) => ('not'(q '&' t) => 'not'(p '&' t));

theorem 
  J,v |= p & J,v |= (p => q) implies J,v |= q;

theorem 
  J,v |= All(x,p) => p;

theorem 
  J |= VERUM(Al);

theorem 
  J |= p '&' q => q '&' p;

theorem 
  J |= ('not' p => p) => p;

theorem 
  J |= p => ('not' p => q);

theorem 
  J |= (p => q) => ('not'(q '&' t) => 'not'(p '&' t));

theorem 
  J |= p & J |= (p => q) implies J |= q;

theorem 
  J |= All(x,p) => p;

theorem 
  J |= p => q & not x in still_not-bound_in p implies J |= p => All(x,q);

theorem 
  for s being QC-formula of Al st p = s.x & q = s.y & not x in
  still_not-bound_in s & J |= p holds J |= q;














begin

reserve x,y,z,x1,x2,x3,x4,y1,y2,s for Variable,
  M for non empty set,
  a,b for set,
  i,j,k for Element of NAT,
  m,m1,m2,m3,m4 for Element of M,
  H,H1,H2 for ZF-formula,
  v,v9,v1,v2 for Function of VAR,M;

theorem 
  Free (H/(x,y)) c= (Free H \ {x}) \/ {y};

theorem 
  not y in variables_in H implies (x in Free H implies Free (H/(x,y
)) = (Free H \ {x}) \/ {y}) & (not x in Free H implies Free (H/(x,y)) = Free H)
;

registration
  let H;
  cluster variables_in H -> finite;
end;

theorem 
  (ex i st for j st x.j in variables_in H holds j < i) &
  ex x st not x in variables_in H;

theorem 
  not x in variables_in H implies (M,v |= H iff M,v |= All(x,H));

theorem 
  not x in variables_in H implies (M,v |= H iff M,v/(x,m) |= H);

theorem 
  x <> y & y <> z & z <> x implies v/(x,m1)/(y,m2)/(z,m3) = v/(z,m3
  )/(y,m2)/(x,m1) & v/(x,m1)/(y,m2)/(z,m3) = v/(y,m2)/(z,m3)/(x,m1);

theorem 
  x1 <> x2 & x1 <> x3 & x1 <> x4 & x2 <> x3 & x2 <> x4 & x3 <> x4
implies v/(x1,m1)/(x2,m2)/(x3,m3)/(x4,m4) = v/(x2,m2)/(x3,m3)/(x4,m4)/(x1,m1) &
v/(x1,m1)/(x2,m2)/(x3,m3)/(x4,m4) = v/(x3,m3)/(x4,m4)/(x1,m1)/(x2,m2) & v/(x1,
  m1)/(x2,m2)/(x3,m3)/(x4,m4) = v/(x4,m4)/(x2,m2)/(x3,m3)/(x1,m1);

theorem 
  v/(x1,m1)/(x2,m2)/(x1,m) = v/(x2,m2)/(x1,m) & v/(x1,m1)/(x2,m2)/(
x3,m3)/(x1,m) = v/(x2,m2)/(x3,m3)/(x1,m) & v/(x1,m1)/(x2,m2)/(x3,m3)/(x4,m4)/(
  x1,m) = v/(x2,m2)/(x3,m3)/(x4,m4)/(x1,m);

theorem 
  not x in Free H implies (M,v |= H iff M,v/(x,m) |= H);

theorem 
  not x.0 in Free H & M,v |= All(x.3,Ex(x.0,All(x.4,H <=> x.4 '='
x.0))) implies for m1,m2 holds def_func'(H,v).m1 = m2 iff M,v/(x.3,m1)/(x.4,m2)
  |= H;

theorem 
  Free H c= {x.3,x.4} & M |= All(x.3,Ex(x.0,All(x.4,H <=> x.4 '='
  x.0))) implies def_func'(H,v) = def_func(H,M);

theorem 
  not x in variables_in H implies (M,v |= H/(y,x) iff M,v/(y,v.x) |= H);

theorem 
  not x in variables_in H & M,v |= H implies M,v/(x,v.y) |= H/(y,x );

theorem 
  not x.0 in Free H & M,v |= All(x.3,Ex(x.0,All(x.4,H <=> x.4 '='
x.0))) & not x in variables_in H & not y in Free H & x <> x.0 & x <> x.3 & x <>
x.4 implies not x.0 in Free (H/(y,x)) & M,v/(x,v.y) |= All(x.3,Ex(x.0,All(x.4,H
  /(y,x) <=> x.4 '=' x.0))) & def_func'(H,v) = def_func'(H/(y,x),v/(x,v.y));

theorem 
  not x in variables_in H implies (M |= H/(y,x) iff M |= H);

theorem 
  not x.0 in Free H1 & M,v1 |= All(x.3,Ex(x.0,All(x.4,H1 <=> x.4
'=' x.0))) implies ex H2,v2 st (for j st j < i & x.j in variables_in H2 holds j
= 3 or j = 4) & not x.0 in Free H2 & M,v2 |= All(x.3,Ex(x.0,All(x.4,H2 <=> x.4
  '=' x.0))) & def_func'(H1,v1) = def_func'(H2,v2);

theorem 
  not x.0 in Free H1 & M,v1 |= All(x.3,Ex(x.0,All(x.4,H1 <=> x.4 '=' x.0
))) implies ex H2,v2 st Free H1 /\ Free H2 c= {x.3,x.4} & not x.0 in Free H2 &
  M,v2 |= All(x.3,Ex(x.0,All(x.4,H2 <=> x.4 '=' x.0))) & def_func'(H1,v1) =
  def_func'(H2,v2);





reserve F,G for Function;

theorem 
  F is_definable_in M & G is_definable_in M implies F*G is_definable_in M;

theorem 
  not x.0 in Free H implies (M,v |= All(x.3,Ex(x.0,All(x.4,H <=>
x.4 '=' x.0))) iff for m1 ex m2 st for m3 holds M,v/(x.3,m1)/(x.4,m3) |= H iff
  m3 = m2);

theorem 
  F is_definable_in M & G is_definable_in M & Free H c= {x.3} implies
for FG be Function st dom FG = M & for v holds (M,v |= H implies FG.(v.x.3) = F
  .(v.x.3)) & (M,v |= 'not' H implies FG.(v.x.3) = G.(v.x.3)) holds FG
  is_definable_in M;

theorem 
  F is_parametrically_definable_in M & G is_parametrically_definable_in
  M implies G*F is_parametrically_definable_in M;

theorem 
  {x.0,x.1,x.2} misses Free H1 & M,v |= All(x.3,Ex(x.0,All(x.4,H1 <=> x.
4 '=' x.0))) & {x.0,x.1,x.2} misses Free H2 & M,v |= All(x.3,Ex(x.0,All(x.4,H2
  <=> x.4 '=' x.0))) & {x.0,x.1,x.2} misses Free H & not x.4 in Free H implies
for FG be Function st dom FG = M & for m holds (M,v/(x.3,m) |= H implies FG.m =
def_func'(H1,v).m) & (M,v/(x.3,m) |= 'not' H implies FG.m = def_func'(H2,v).m)
  holds FG is_parametrically_definable_in M;

theorem 
  id M is_definable_in M;

theorem 
  id M is_parametrically_definable_in M;














begin

reserve A for QC-alphabet;
reserve p, q, r, s, t for Element of CQC-WFF(A);
reserve X for Subset of CQC-WFF(A);

theorem 
  (p => q) => ((q => r) => (p => r)) in TAUT(A);

theorem 
  p => q in TAUT(A) implies (q => r) => (p => r) in TAUT(A);

theorem 
  p => q in TAUT(A) & q => r in TAUT(A) implies p => r in TAUT(A);

theorem 
  p => p in TAUT(A);

theorem 
  q => (p => q) in TAUT(A);

theorem 
  ((p => q) => r) => (q => r) in TAUT(A);

theorem 
  q => ((q => p) => p) in TAUT(A);

theorem 
  (s => (q => p)) => (q => (s => p)) in TAUT(A);

theorem 
  (q => r) => ((p => q) => (p => r)) in TAUT(A);

theorem 
  (q => (q => r)) => (q => r) in TAUT(A);

theorem 
  (p => (q => r)) => ((p => q) => (p => r)) in TAUT(A);

theorem 
  'not' VERUM(A) => p in TAUT(A);

theorem 
  q in TAUT(A) implies p => q in TAUT(A);

theorem 
  p in TAUT(A) implies (p => q) => q in TAUT(A);

theorem 
  s => (q => p) in TAUT(A) implies q => (s => p) in TAUT(A);

theorem 
  s => (q => p) in TAUT(A) & q in TAUT(A) implies s => p in TAUT(A);

theorem 
  s => (q => p) in TAUT(A) & q in TAUT(A) & s in TAUT(A) implies p in TAUT(A);

theorem 
  q => (q => r) in TAUT(A) implies q => r in TAUT(A);

theorem 
  (p => (q => r)) in TAUT(A) implies (p => q) => (p => r) in TAUT(A);

theorem 
  (p => (q => r)) in TAUT(A) & p => q in TAUT(A) implies p => r in TAUT(A);

theorem 
  (p => (q => r)) in TAUT(A) & p => q in TAUT(A) & p in TAUT(A) implies
  r in TAUT(A);

theorem 
  p => (q => r) in TAUT(A) & p => (r => s ) in TAUT(A) implies
   p => (q => s) in TAUT(A);

theorem 
  p => VERUM(A) in TAUT(A);

theorem 
  ('not' p => 'not' q) => (q => p) in TAUT(A);

theorem 
  'not' 'not' p => p in TAUT(A);

theorem 
  (p => q) => ('not' q => 'not' p) in TAUT(A);

theorem 
  p => 'not' 'not' p in TAUT(A);

theorem 
  ('not' 'not' p => q) => (p => q) in TAUT(A) & (p => q) => ('not'
  'not' p => q) in TAUT(A);

theorem 
  (p => 'not' 'not' q) => (p => q) in TAUT(A) & (p => q) => (p =>
  'not' 'not' q) in TAUT(A);

theorem 
  (p => 'not' q) => (q => 'not' p) in TAUT(A);

theorem 
  ('not' p => q) => ('not' q => p) in TAUT(A);

theorem 
  (p => 'not' p) => 'not' p in TAUT(A);

theorem 
  'not' p => (p => q) in TAUT(A);

theorem 
  p => q in TAUT(A) iff 'not' q => 'not' p in TAUT(A);

theorem 
  'not' p => 'not' q in TAUT(A) implies q => p in TAUT(A);

theorem 
  p in TAUT(A) iff 'not' 'not' p in TAUT(A);

theorem 
  (p => q) in TAUT(A) iff (p => 'not' 'not' q) in TAUT(A);

theorem 
  (p => q) in TAUT(A) iff ('not' 'not' p => q) in TAUT(A);

theorem 
  p => 'not' q in TAUT(A) implies q => 'not' p in TAUT(A);

theorem 
  'not' p => q in TAUT(A) implies 'not' q => p in TAUT(A);



registration
  let A,p,q,r;
  cluster (p => q) => ((q => r) => (p => r)) -> valid;
end;

theorem 
  p => q is valid implies (q => r) => (p => r) is valid;

theorem 
  p => q is valid & q => r is valid implies p => r is valid;

registration
  let A,p;
  cluster p => p -> valid;
end;

registration
  let A,p,q;
  cluster p => (q => p) -> valid;
end;

theorem 
  p is valid implies q => p is valid;

registration
  let A,p,q,s;
  cluster (s => (q => p)) => (q => (s => p)) -> valid;
end;

theorem 
  p => (q => r) is valid implies q => (p => r) is valid;

theorem 
  p => (q => r) is valid & q is valid implies p => r is valid;

theorem 
  p => VERUM(A) is valid & 'not' VERUM(A) => p is valid;

registration
  let A,p,q;
  cluster p => ((p => q) => q) -> valid;
end;

registration
  let A,q,r;
  cluster (q => (q => r)) => (q => r) -> valid;
end;

theorem 
  q => (q => r) is valid implies q => r is valid;

registration
  let A,p,q,r;
  cluster (p => (q => r)) => ((p => q) => (p => r)) -> valid;
end;

theorem 
  p => (q => r) is valid implies (p => q) => (p => r) is valid;

theorem 
  p => (q => r) is valid & p => q is valid implies p => r is valid;

registration
  let A,p,q,r;
  cluster ((p => q) => r) => (q => r) -> valid;
end;

theorem 
  (p => q) => r is valid implies q => r is valid;

registration
  let A,p,q,r;
  cluster (p => q) => ((r => p) => (r => q)) -> valid;
end;

theorem 
  p => q is valid implies (r => p) => (r => q) is valid;

registration
  let A,p,q;
  cluster (p => q) => ('not' q => 'not' p) -> valid;
end;

registration
  let A,p,q;
  cluster ('not' p => 'not' q) => (q => p) ->  valid;
end;

theorem 
  'not' p => 'not' q is valid iff q => p is valid;

registration
  let A,p;
  cluster p => 'not' 'not' p -> valid;
end;

registration
  let A,p;
  cluster 'not' 'not' p => p -> valid;
end;

theorem 
  'not' 'not' p is valid iff p is valid;

registration
  let A,p,q;
  cluster ('not' 'not' p => q) => (p => q) -> valid;
end;

theorem 
  'not' 'not' p => q is valid iff p => q is valid;

registration
  let A,p,q;
  cluster (p => 'not' 'not' q) => (p => q) -> valid;
end;

theorem 
  p => 'not' 'not' q is valid iff p => q is valid;

registration
  let A,p,q;
  cluster (p => 'not' q) => (q => 'not' p) -> valid;
end;

theorem 
  p => 'not' q is valid implies q => 'not' p is valid;

registration
  let A,p,q;
  cluster ('not' p => q) => ('not' q => p) -> valid;
end;

theorem 
  'not' p => q is valid implies 'not' q => p is valid;

theorem 
  X|- p => q implies X|- (q => r) => (p => r);

theorem 
  X|- p => q & X|- q => r implies X|- p => r;

theorem 
  X|- p => p;

theorem 
  X|- p implies X|- q => p;

theorem 
  X |- p implies X |- (p => q) => q;

theorem 
  X |- p => (q => r) implies X |- q => (p => r);

theorem 
  X |- p => (q => r) & X |- q implies X |- p => r;

theorem 
  X |- p => (p => q) implies X |- p => q;

theorem 
  X |- (p => q) => r implies X |- q => r;

theorem 
  X |- p => (q => r) implies X |- (p => q) => (p =>r);

theorem 
  X |- p => (q => r) & X|- p => q implies X |- p => r;

theorem 
  X|- 'not' p => 'not' q iff X|- q => p;

theorem 
  X|- 'not' 'not' p iff X|- p;

theorem 
  X|- p => 'not' 'not' q iff X|- p => q;

theorem 
  X|- 'not' 'not' p => q iff X|- p => q;

theorem 
  X|- p => 'not' q implies X|- q => 'not' p;

theorem 
  X|- 'not' p => q implies X|- 'not' q => p;

theorem 
  X|- p => 'not' q & X |- q implies X|- 'not' p;

theorem 
  X|- 'not' p => q & X |- 'not' q implies X|- p;














begin 

reserve A for QC-alphabet;
reserve p, q, r, s for Element of CQC-WFF(A);

theorem 
  'not' ( p '&' 'not' p ) in TAUT(A);

theorem 
  p 'or' 'not' p in TAUT(A);

theorem 
  p => ( p 'or' q ) in TAUT(A);

theorem 
  q => ( p 'or' q ) in TAUT(A);

theorem 
  ( p 'or' q ) => ( 'not' p => q ) in TAUT(A);

theorem 
  'not' ( p 'or' q ) => ( 'not' p '&' 'not' q ) in TAUT(A);

theorem 
  ( 'not' p '&' 'not' q ) => 'not' ( p 'or' q ) in TAUT(A);

theorem 
  ( p 'or' q ) => ( q 'or' p ) in TAUT(A);

theorem 
  'not' p 'or' p in TAUT(A);

theorem 
  'not' ( p 'or' q ) => 'not' p in TAUT(A);

theorem 
  ( p 'or' p ) => p in TAUT(A);

theorem 
  p => ( p 'or' p ) in TAUT(A);

theorem 
  ( p '&' 'not' p ) => q in TAUT(A);

theorem 
  ( p => q ) => ( 'not' p 'or' q ) in TAUT(A);

theorem 
  ( p '&' q ) => 'not' ( p => 'not' q ) in TAUT(A);

theorem 
  'not' ( p => 'not' q ) => ( p '&' q ) in TAUT(A);

theorem 
  'not' ( p '&' q ) => ( 'not' p 'or' 'not' q ) in TAUT(A);

theorem 
  ( 'not' p 'or' 'not' q ) => 'not' ( p '&' q ) in TAUT(A);

theorem 
  ( p '&' q ) => p in TAUT(A);

theorem 
  ( p '&' q ) => ( p 'or' q ) in TAUT(A);

theorem 
  ( p '&' q ) => q in TAUT(A);

theorem 
  p => p '&' p in TAUT(A);

theorem 
  ( p <=> q ) => ( p => q ) in TAUT(A);

theorem 
  ( p <=> q ) => ( q => p ) in TAUT(A);

theorem 
  (( p 'or' q ) 'or' r ) => ( p 'or' ( q 'or' r )) in TAUT(A);

theorem 
  (( p '&' q ) '&' r ) => ( p '&' ( q '&' r )) in TAUT(A);

theorem 
  ( p 'or' ( q 'or' r )) => (( p 'or' q ) 'or' r ) in TAUT(A);

theorem 
  p => ( q => ( p '&' q )) in TAUT(A);

theorem 
  ( p => q ) => (( q => p ) => ( p <=> q )) in TAUT(A);

theorem 
  ( p 'or' q ) <=> ( q 'or' p ) in TAUT(A);

theorem 
  (( p '&' q ) => r ) => ( p => ( q => r )) in TAUT(A);

theorem 
  ( p => ( q => r )) => (( p '&' q ) => r ) in TAUT(A);

theorem 
  ( r => p ) => (( r => q ) => ( r => ( p '&' q ))) in TAUT(A);

theorem 
  (( p 'or' q ) => r ) => (( p => r ) 'or' ( q => r )) in TAUT(A);

theorem 
  ( p => r ) => (( q => r ) => (( p 'or' q ) => r)) in TAUT(A);

theorem 
  (( p => r ) '&' ( q => r )) => (( p 'or' q ) => r) in TAUT(A);

theorem 
  ( p => ( q '&' 'not' q )) => 'not' p in TAUT(A);

theorem 
  (( p 'or' q ) '&' ( p 'or' r )) => ( p 'or' ( q '&' r )) in TAUT(A);

theorem 
  ( p '&' ( q 'or' r )) => (( p '&' q ) 'or' ( p '&' r )) in TAUT(A);

theorem 
  (( p 'or' r ) '&' ( q 'or' r )) => (( p '&' q ) 'or' r ) in TAUT(A);

theorem 
  (( p 'or' q ) '&' r ) => (( p '&' r ) 'or' ( q '&' r )) in TAUT(A);



theorem 
  p in TAUT(A) implies ( p 'or' q ) in TAUT(A);

theorem 
  q in TAUT(A) implies ( p 'or' q ) in TAUT(A);

theorem 
  ( p '&' q ) in TAUT(A) implies p in TAUT(A);

theorem 
  ( p '&' q ) in TAUT(A) implies q in TAUT(A);

theorem 
  ( p '&' q ) in TAUT(A) implies ( p 'or' q ) in TAUT(A);

theorem 
  p in TAUT(A) & q in TAUT(A) implies p '&' q in TAUT(A);

theorem 
  p => q in TAUT(A) implies ( p 'or' r ) => ( q 'or' r ) in TAUT(A);

theorem 
  p => q in TAUT(A) implies ( r 'or' p ) => ( r 'or' q ) in TAUT(A);

theorem 
  p => q in TAUT(A) implies ( r '&' p ) => ( r '&' q ) in TAUT(A);

theorem 
  p => q in TAUT(A) implies ( p '&' r ) => ( q '&' r ) in TAUT(A);

theorem 
  r => p in TAUT(A) & r => q in TAUT(A) implies r => ( p '&' q ) in TAUT(A);

theorem 
  p => r in TAUT(A) & q => r in TAUT(A) implies ( p 'or' q ) => r in TAUT(A);

theorem 
  ( p 'or' q ) in TAUT(A) & 'not' p in TAUT(A) implies q in TAUT(A);

theorem 
  ( p 'or' q ) in TAUT(A) & 'not' q in TAUT(A) implies p in TAUT(A);

theorem 
  p => q in TAUT(A) & r => s in TAUT(A) implies ( p '&' r ) => ( q '&' s )
in TAUT(A);

theorem 
  p => q in TAUT(A) & r => s in TAUT(A) implies ( p 'or' r ) => ( q 'or' s )
in TAUT(A);

theorem 
  ( p '&' 'not' q ) => 'not' p in TAUT(A) implies p => q in TAUT(A);














begin

reserve V for Universe,
  a,b,x,y,z,x9,y9 for Element of V,
  X for Subclass of V,
  o,p,q,r,s,t,u,a1,a2,a3,A,B,C,D for set,
  K,L,M for Ordinal,
  n for Element of omega,
  fs for finite Subset of omega,
  e,g,h for Function,
  E for non empty set,
  f for Function of VAR,E,
  k,k1 for Element of NAT,
  v1,v2,v3 for Element of VAR,
  H,H9 for ZF-formula;

registration let V;
 cluster Relation-like for Element of V;
end;

definition
 canceled;
  let V,x,y;
  redefine func x(#)y -> Relation-like Element of V;
end;

definition
  func decode -> Function of omega,VAR means


  for p being Element of omega holds it.p = x.card p;
end;

definition
  let v1;
  func x".v1 -> Element of NAT means


  x.it=v1;
end;

definition
  let A be Subset of VAR;
  func code A -> Subset of omega equals

  (decode").:A;
end;

registration
  let A be finite Subset of VAR;
  cluster code A -> finite;
end;

definition
  let H,E;
  func Diagram(H,E) -> set means


  p in it iff ex f st p=(f*decode)|code Free(H) & f in St(H,E);
end;

definition
  let V,X;
  attr X is closed_wrt_A1 means


  for a st a in X holds {{[0-element_of(V
  ),x],[1-element_of(V),y]}: x in y & x in a & y in a} in X;
  attr X is closed_wrt_A2 means


  for a,b st a in X & b in X holds {a,b} in X;
  attr X is closed_wrt_A3 means


  for a st a in X holds union a in X;
  attr X is closed_wrt_A4 means


  for a,b st a in X & b in X holds {{[x,y ]}: x in a & y in b} in X;
  attr X is closed_wrt_A5 means


  for a,b st a in X & b in X holds {x \/ y: x in a & y in b} in X;
  attr X is closed_wrt_A6 means


  for a,b st a in X & b in X holds {x\y: x in a & y in b} in X;
  attr X is closed_wrt_A7 means


  for a,b st a in X & b in X holds {x(#) y: x in a & y in b} in X;
end;

definition
  let V,X;
  attr X is closed_wrt_A1-A7 means


  X is closed_wrt_A1 closed_wrt_A2
  closed_wrt_A3 closed_wrt_A4 closed_wrt_A5 closed_wrt_A6 closed_wrt_A7;
end;

theorem 
  X c= V & (o in X implies o is Element of V) & (o in A & A in X
  implies o is Element of V);

theorem 
  X is closed_wrt_A1-A7 implies (o in X iff {o} in X) & (A in X
  implies union A in X);

theorem 
  X is closed_wrt_A1-A7 implies {} in X;

theorem 
  X is closed_wrt_A1-A7 & A in X & B in X implies A \/ B in X & A\B
  in X & A(#)B in X;

theorem 
  X is closed_wrt_A1-A7 & A in X & B in X implies A/\B in X;

theorem 
  X is closed_wrt_A1-A7 & o in X & p in X implies {o,p} in X & [o,p ] in X;

theorem 
  X is closed_wrt_A1-A7 implies omega c= X;

theorem 
  X is closed_wrt_A1-A7 implies Funcs(fs,omega) c= X;

theorem 
  X is closed_wrt_A1-A7 & a in X implies Funcs(fs,a) in X;

theorem 
  X is closed_wrt_A1-A7 & a in Funcs(fs,omega) & b in X implies {a
  (#)x: x in b} in X;

theorem 
  X is closed_wrt_A1-A7 & n in fs & a in X & b in X & b c= Funcs(
  fs,a) implies {x: x in Funcs(fs\{n},a) & ex u st {[n,u]} \/ x in b} in X;

theorem 
  for n st X is closed_wrt_A1-A7 & a in X & b in X holds {{[n,x]}
  \/ y: x in a & y in b} in X;

theorem 
  (X is closed_wrt_A1-A7 & B is finite & for o st o in B holds o
  in X) implies B in X;

theorem 
  X is closed_wrt_A1-A7 & A c= X & y in Funcs(fs,A) implies y in X;

theorem 
  for n st X is closed_wrt_A1-A7 & a in X & a c= X & y in Funcs(fs
  ,a) holds {{[n,x]} \/ y: x in a} in X;

theorem 
  X is closed_wrt_A1-A7 & not n in fs & a in X & a c= X & y in Funcs(fs,
  a) & b c= Funcs(fs \/ {n},a) & b in X implies {x: x in a & {[n,x]} \/ y in b}
  in X;

theorem 
  X is closed_wrt_A1-A7 & a in X implies {{[0-element_of(V),x], [
  1-element_of(V),x]} : x in a} in X;

theorem 
  X is closed_wrt_A1-A7 & E in X implies for v1,v2 holds Diagram(
  v1 '=' v2,E) in X & Diagram(v1 'in' v2,E) in X;

theorem 
  X is closed_wrt_A1-A7 & E in X implies for H st Diagram(H,E) in
  X holds Diagram('not' H,E) in X;

theorem 
  X is closed_wrt_A1-A7 & E in X implies for H,H9 st Diagram(H,E)
  in X & Diagram(H9,E) in X holds Diagram(H '&' H9,E) in X;

theorem 
  X is closed_wrt_A1-A7 & E in X implies for H,v1 st Diagram(H,E)
  in X holds Diagram(All(v1,H),E) in X;

theorem 
  X is closed_wrt_A1-A7 & E in X implies Diagram(H,E) in X;



theorem 
  X is closed_wrt_A1-A7 implies n in X & 0-element_of(V) in X &
  1-element_of(V) in X;

theorem 
  {[o,p],[p,p]}(#){[p,q]}={[o,q],[p,q]};

theorem 
  p<>r implies {[o,p],[q,r]}(#){[p,s],[r,t]}={[o,s],[q,t]};

theorem 
  code {v1} = { x".v1} & code {v1,v2} = { x".v1, x".v2};

theorem 
  for f being Function holds dom f={o,q} iff f={[o,f.o],[q,f.q]};

theorem 
  dom decode = omega & rng decode = VAR & decode is one-to-one & decode"
  is one-to-one & dom(decode") = VAR & rng(decode") = omega;

theorem 
  for A being finite Subset of VAR holds A,code A are_equipotent;

theorem 
  for A being Element of omega holds A = x".x.card A;

theorem 
  dom((f*decode)|fs)=fs & rng((f*decode)|fs) c= E & (f*decode)|fs in
  Funcs(fs,E) & dom(f*decode)=omega;

theorem 
  decode.(x".v1)=v1 & (decode").v1= x".v1 & (f*decode).(x".v1)=f.v1;

theorem 
  for A being finite Subset of VAR holds p in code A iff ex v1 st v1 in
  A & p= x".v1;

theorem 
  for A,B being finite Subset of VAR holds code(A \/ B)=code A \/ code B
  & code(A\B)=(code A)\(code B);

theorem 
  v1 in Free H implies ((f*decode)|code Free H).( x".v1)=f.v1;

theorem 
  for f,g being Function of VAR,E st (f*decode)|code Free H=(g*decode)|
  code Free H & f in St(H,E) holds g in St(H,E);

theorem 
  p in Funcs(fs,E) implies ex f st p=(f*decode)|fs;
















begin 


definition
  let E be set;
  attr E is with_FALSUM means


  <*0*>in E;
end;

definition
  let E be set;
  attr E is with_int_implication means


  for p, q being FinSequence st p in E & q in E holds <*1*>^p^q in E;
end;

definition
  let E be set;
  attr E is with_int_conjunction means


  for p, q being FinSequence st p in E & q in E holds <*2*>^p^q in E;
end;

definition
  let E be set;
  attr E is with_int_disjunction means


  for p, q being FinSequence st p in E & q in E holds <*3*>^p^q in E;
end;

definition
  let E be set;
  attr E is with_int_propositional_variables means


  for n being Element of NAT holds <* 5+2*n *> in E;
end;

definition
  let E be set;
  attr E is with_modal_operator means


  for p being FinSequence st p in E holds <*6*>^p in E;
end;






definition
  let E be set;
  attr E is MC-closed means


  E c= NAT* & E is with_FALSUM
  with_int_implication with_int_conjunction with_int_disjunction
  with_int_propositional_variables with_modal_operator;
end;

registration
  cluster MC-closed -> with_FALSUM with_int_implication with_int_conjunction
with_int_disjunction with_int_propositional_variables with_modal_operator non
    empty for set;
  cluster with_FALSUM with_int_implication with_int_conjunction
with_int_disjunction with_int_propositional_variables with_modal_operator ->
    MC-closed for Subset of NAT*;
end;

definition
  func MC-wff -> set means


  it is MC-closed & for E being set st E is MC-closed holds it c= E;
end;

registration
  cluster MC-wff -> MC-closed;
end;

registration
  cluster MC-closed non empty for set;
end;

registration
  cluster MC-wff -> functional;
end;

registration
  cluster -> FinSequence-like for Element of MC-wff;
end;

definition
  mode MC-formula is Element of MC-wff;
end;

definition
  func FALSUM -> MC-formula equals

  <*0*>;
  let p, q be Element of MC-wff;
  func p => q -> MC-formula equals

  <*1*>^p^q;
  func p '&' q -> MC-formula equals

  <*2*>^p^q;
  func p 'or' q -> MC-formula equals

  <*3*>^p^q;
end;

definition
  let p be Element of MC-wff;
  func Nes p -> MC-formula equals

  <*6*>^p;
end;

reserve T, X, Y for Subset of MC-wff;
reserve p, q, r, s for Element of MC-wff;

definition
  let T be Subset of MC-wff;
  attr T is IPC_theory means


  for p, q, r being Element of MC-wff holds
p => (q => p) in T & (p => (q => r)) => ((p => q) => (p => r)) in T & (p '&' q)
=> p in T & (p '&' q) => q in T & p => (q => (p '&' q)) in T & p => (p 'or' q)
in T & q => (p 'or' q) in T & (p => r) => ((q => r) => ((p 'or' q) => r)) in T
  & FALSUM => p in T & (p in T & p => q in T implies q in T);
end;

definition
  let X;
  func CnIPC X -> Subset of MC-wff means


  r in it iff for T st T is IPC_theory & X c= T holds r in T;
end;

definition
  func IPC-Taut -> Subset of MC-wff equals

  CnIPC({}(MC-wff));
end;

definition
  let p be Element of MC-wff;
  func neg p -> MC-formula equals

  (p => FALSUM);
end;

definition
  func IVERUM -> MC-formula equals

  (FALSUM => FALSUM);
end;

theorem 
  p => (q => p) in CnIPC (X);

theorem 
  (p => (q => r)) => ((p => q) => (p => r)) in CnIPC (X);

theorem 
  p '&' q => p in CnIPC(X);

theorem 
  p '&' q => q in CnIPC(X);

theorem 
  p => (q => (p '&' q)) in CnIPC (X);

theorem 
  p => (p 'or' q) in CnIPC (X);

theorem 
  q => (p 'or' q) in CnIPC (X);

theorem 
  (p => r) => ((q => r) => ((p 'or' q) => r)) in CnIPC (X);

theorem 
  FALSUM => p in CnIPC (X);

theorem 
  p in CnIPC(X) & p => q in CnIPC(X) implies q in CnIPC(X);

theorem 
  T is IPC_theory & X c= T implies CnIPC(X) c= T;

theorem 
  X c= CnIPC(X);

theorem 
  X c= Y implies CnIPC(X) c= CnIPC(Y);

theorem 
  CnIPC(CnIPC(X)) = CnIPC(X);

registration
  let X be Subset of MC-wff;
  cluster CnIPC(X) -> IPC_theory;
end;

theorem 
  T is IPC_theory iff CnIPC(T) = T;

theorem 
  T is IPC_theory implies IPC-Taut c= T;

registration
  cluster IPC-Taut -> IPC_theory;
end;

begin  

theorem 
  p => p in IPC-Taut;

theorem 
  q in IPC-Taut implies p => q in IPC-Taut;

theorem 
  IVERUM in IPC-Taut;

theorem 
  (p => q) => (p => p) in IPC-Taut;

theorem 
  (q => p) => (p => p) in IPC-Taut;

theorem 
  (q => r) => ((p => q) => (p => r)) in IPC-Taut;

theorem 
  p => (q => r) in IPC-Taut implies q => (p => r) in IPC-Taut;

theorem 
  (p => q) => ((q => r) => (p => r)) in IPC-Taut;

theorem 
  p => q in IPC-Taut implies (q => r) => (p => r) in IPC-Taut;

theorem 
  p => q in IPC-Taut & q => r in IPC-Taut implies p => r in IPC-Taut;

theorem 
  (p => (q => r)) => ((s => q) => (p => (s => r))) in IPC-Taut;

theorem 
  ((p => q) => r) => (q => r) in IPC-Taut;

theorem 
  (p => (q => r)) => (q => (p => r)) in IPC-Taut;

theorem 
  (p => (p => q)) => (p => q) in IPC-Taut;

theorem 
  q => ((q => p) => p) in IPC-Taut;

theorem 
  s => (q => p) in IPC-Taut & q in IPC-Taut implies s => p in IPC-Taut;

begin 

theorem 
  p => (p '&' p) in IPC-Taut;

theorem 
  (p '&' q) in IPC-Taut iff p in IPC-Taut & q in IPC-Taut;

theorem 
  (p '&' q) in IPC-Taut iff (q '&' p) in IPC-Taut;

theorem 
  (( p '&' q ) => r ) => ( p => ( q => r )) in IPC-Taut;

theorem 
  ( p => ( q => r )) => (( p '&' q ) => r ) in IPC-Taut;

theorem 
  ( r => p ) => (( r => q ) => ( r => ( p '&' q ))) in IPC-Taut;

theorem 
  ( (p => q) '&' p ) => q in IPC-Taut;

theorem 
  (( (p => q) '&' p ) '&' s ) => q in IPC-Taut;

theorem 
  (q => s) => (( p '&' q ) => s) in IPC-Taut;

theorem 
  (q => s) => (( q '&' p ) => s) in IPC-Taut;

theorem 
  ( (p '&' s) => q ) => ((p '&' s) => (q '&' s)) in IPC-Taut;

theorem 
  ( p => q ) => ((p '&' s) => (q '&' s)) in IPC-Taut;

theorem 
  (( p => q ) '&' ( p '&' s )) => ( q '&' s ) in IPC-Taut;

theorem 
  ( p '&' q ) => ( q '&' p ) in IPC-Taut;

theorem 
  ( p => q ) '&' ( p '&' s ) => ( s '&' q ) in IPC-Taut;

theorem 
  ( p => q ) => (( p '&' s ) => ( s '&' q )) in IPC-Taut;

theorem 
  ( p => q ) => (( s '&' p ) => ( s '&' q )) in IPC-Taut;

theorem 
  ( p '&' (s '&' q) ) => ( p '&' (q '&' s) ) in IPC-Taut;

theorem 
  ( ( p => q ) '&' (p => s) ) => ( p => (q '&' s) ) in IPC-Taut;

theorem 
  (p '&' q) '&' s => p '&' (q '&' s) in IPC-Taut;

theorem 
  p '&' (q '&' s) => (p '&' q) '&' s in IPC-Taut;

begin 

theorem 
  (p 'or' p) => p in IPC-Taut;

theorem 
  p in IPC-Taut or q in IPC-Taut implies (p 'or' q) in IPC-Taut;

theorem 
  (p 'or' q) => (q 'or' p) in IPC-Taut;

theorem 
  (p 'or' q) in IPC-Taut iff (q 'or' p) in IPC-Taut;

theorem 
  (p => q) => (p => (q 'or' s)) in IPC-Taut;

theorem 
  (p => q) => (p => (s 'or' q)) in IPC-Taut;

theorem 
  ( p => q ) => ((p 'or' s) => (q 'or' s)) in IPC-Taut;

theorem 
  p => q in IPC-Taut implies (p 'or' s) => (q 'or' s) in IPC-Taut;

theorem 
  ( p => q ) => (( s 'or' p ) => ( s 'or' q )) in IPC-Taut;

theorem 
  p => q in IPC-Taut implies ( s 'or' p ) => ( s 'or' q ) in IPC-Taut;

theorem 
  ( p 'or' (q 'or' s) ) => ( q 'or' (p 'or' s) ) in IPC-Taut;

theorem 
  ( p 'or' (q 'or' s) ) => ( (p 'or' q) 'or' s ) in IPC-Taut;

theorem 
  ( (p 'or' q) 'or' s ) => ( p 'or' (q 'or' s) ) in IPC-Taut;

begin 

reserve T, X, Y for Subset of MC-wff;
reserve p, q, r for Element of MC-wff;

definition
  let T be Subset of MC-wff;
  attr T is CPC_theory means


  for p, q, r being Element of MC-wff holds
p => (q => p) in T & (p => (q => r)) => ((p => q) => (p => r)) in T & (p '&' q)
=> p in T & (p '&' q) => q in T & p => (q => (p '&' q)) in T & p => (p 'or' q)
in T & q => (p 'or' q) in T & (p => r) => ((q => r) => ((p 'or' q) => r)) in T
& FALSUM => p in T & p 'or' (p => FALSUM) in T & (p in T & p => q in T implies
  q in T);
end;

theorem 
  T is CPC_theory implies T is IPC_theory;

definition
  let X;
  func CnCPC X -> Subset of MC-wff means


  r in it iff for T st T is CPC_theory & X c= T holds r in T;
end;

definition
  func CPC-Taut -> Subset of MC-wff equals

  CnCPC({}(MC-wff));
end;

theorem 
  CnIPC (X) c= CnCPC (X);

theorem 
  p => (q => p) in CnCPC (X) & (p => (q => r)) => ((p => q) => (p
=> r)) in CnCPC (X) & p '&' q => p in CnCPC (X) & p '&' q => q in CnCPC (X) & p
=> (q => (p '&' q)) in CnCPC (X) & p => (p 'or' q) in CnCPC (X) & q => (p 'or'
  q) in CnCPC (X) & (p => r) => ((q => r) => ((p 'or' q) => r)) in CnCPC (X) &
  FALSUM => p in CnCPC (X) & p 'or' (p => FALSUM) in CnCPC (X);

theorem 
  p in CnCPC(X) & p => q in CnCPC(X) implies q in CnCPC(X);

theorem 
  T is CPC_theory & X c= T implies CnCPC(X) c= T;

theorem 
  X c= CnCPC(X);

theorem 
  X c= Y implies CnCPC(X) c= CnCPC(Y);

theorem 
  CnCPC(CnCPC(X)) = CnCPC(X);

registration
  let X be Subset of MC-wff;
  cluster CnCPC(X) -> CPC_theory;
end;

theorem 
  T is CPC_theory iff CnCPC(T) = T;

theorem 
  T is CPC_theory implies CPC-Taut c= T;

registration
  cluster CPC-Taut -> CPC_theory;
end;

theorem 
  IPC-Taut c= CPC-Taut;

begin 

reserve T, X, Y for Subset of MC-wff;
reserve p, q, r for Element of MC-wff;

definition
  let T be Subset of MC-wff;
  attr T is S4_theory means


  for p, q, r being Element of MC-wff holds
p => (q => p) in T & (p => (q => r)) => ((p => q) => (p => r)) in T & (p '&' q)
=> p in T & (p '&' q) => q in T & p => (q => (p '&' q)) in T & p => (p 'or' q)
in T & q => (p 'or' q) in T & (p => r) => ((q => r) => ((p 'or' q) => r)) in T
& FALSUM => p in T & p 'or' (p => FALSUM) in T & (Nes (p => q)) => ((Nes p) =>
  (Nes q)) in T & (Nes p) => p in T & (Nes p) => Nes (Nes p) in T & (p in T & p
  => q in T implies q in T) & (p in T implies Nes p in T);
end;

theorem 
  T is S4_theory implies T is CPC_theory;

theorem 
  T is S4_theory implies T is IPC_theory;

definition
  let X;
  func CnS4 X -> Subset of MC-wff means


  r in it iff for T st T is S4_theory & X c= T holds r in T;
end;

definition
  func S4-Taut -> Subset of MC-wff equals

  CnS4({}(MC-wff));
end;

theorem 
  CnCPC (X) c= CnS4 (X);

theorem 
  CnIPC (X) c= CnS4 (X);

theorem 
  p => (q => p) in CnS4 (X) & (p => (q => r)) => ((p => q) => (p
=> r)) in CnS4 (X) & p '&' q => p in CnS4 (X) & p '&' q => q in CnS4 (X) & p =>
(q => (p '&' q)) in CnS4 (X) & p => (p 'or' q) in CnS4 (X) & q => (p 'or' q) in
CnS4 (X) & (p => r) => ((q => r) => ((p 'or' q) => r)) in CnS4 (X) & FALSUM =>
  p in CnS4 (X) & p 'or' (p => FALSUM) in CnS4 (X);

theorem 
  p in CnS4 (X) & p => q in CnS4 (X) implies q in CnS4 (X);

theorem 
  (Nes (p => q)) => ((Nes p) => (Nes q)) in CnS4 (X);

theorem 
  (Nes p) => p in CnS4 (X);

theorem 
  (Nes p) => Nes (Nes p) in CnS4 (X);

theorem 
  p in CnS4 (X) implies Nes p in CnS4 (X);

theorem 
  T is S4_theory & X c= T implies CnS4(X) c= T;

theorem 
  X c= CnS4(X);

theorem 
  X c= Y implies CnS4(X) c= CnS4(Y);

theorem 
  CnS4(CnS4(X)) = CnS4(X);

registration
  let X be Subset of MC-wff;
  cluster CnS4(X) -> S4_theory;
end;

theorem 
  T is S4_theory iff CnS4(T) = T;

theorem 
  T is S4_theory implies S4-Taut c= T;

registration
  cluster S4-Taut -> S4_theory;
end;

theorem 
  CPC-Taut c= S4-Taut;

theorem 
  IPC-Taut c= S4-Taut;














begin

reserve A for QC-alphabet;
reserve X,T for Subset of CQC-WFF(A);
reserve F,G,H,p,q,r,t for Element of CQC-WFF(A);
reserve s,h for QC-formula of A;
reserve x,y for bound_QC-variable of A;
reserve f for FinSequence of [:CQC-WFF(A),Proof_Step_Kinds:];
reserve i,j for Element of NAT;

theorem 
  p => (q => r) is valid implies (p '&' q) => r is valid;

theorem 
  p => (q => r) is valid implies (q '&' p) => r is valid;

theorem 
  (p '&' q) => r is valid implies p => (q => r) is valid;

theorem 
  (p '&' q) => r is valid implies q => (p => r) is valid;



theorem 
  y in still_not-bound_in All(x,s) iff y in still_not-bound_in s & y <> x;

theorem 
  y in still_not-bound_in Ex(x,s) iff y in still_not-bound_in s & y <> x;

theorem 
  y in still_not-bound_in s => h iff y in still_not-bound_in s or y
  in still_not-bound_in h;

theorem 
  y in still_not-bound_in s '&' h iff y in still_not-bound_in s or
  y in still_not-bound_in h;

theorem 
  y in still_not-bound_in s 'or' h iff y in still_not-bound_in s
  or y in still_not-bound_in h;

theorem 
  not x in still_not-bound_in All(x,y,s) & not y in still_not-bound_in
  All(x,y,s);

theorem 
  not x in still_not-bound_in Ex(x,y,s) & not y in still_not-bound_in Ex
  (x,y,s);

theorem 
  (s => h).x = (s.x) => (h.x);

theorem 
  (s 'or' h).x = (s.x) 'or' (h.x);

theorem 
  x<>y implies (Ex(x,p)).y = Ex(x,p.y);



theorem 
  p => Ex(x,p) is valid;

theorem 
  p is valid implies Ex(x,p) is valid;

theorem 
  All(x,p) => Ex(x,p) is valid;

theorem 
  All(x,p) => Ex(y,p) is valid;

theorem 
  p => q is valid & not x in still_not-bound_in q implies Ex(x,p) => q is valid
;

theorem 
  not x in still_not-bound_in p implies Ex(x,p) => p is valid;

theorem 
  not x in still_not-bound_in p & Ex(x,p) is valid implies p is valid;

theorem 
  p=h.x & q=h.y & not y in still_not-bound_in h implies p => Ex(y, q) is valid;

theorem 
  p is valid implies All(x,p) is valid;

theorem 
  not x in still_not-bound_in p implies p => All(x,p) is valid;

theorem 
  p=h.x & q=h.y & not x in still_not-bound_in h implies All(x,p) => q is valid;

theorem 
  not y in still_not-bound_in p implies All(x,p) => All(y,p) is valid;

theorem 
  p=h.x & q=h.y & not x in still_not-bound_in h & not y in
  still_not-bound_in p implies All(x,p) => All(y,q) is valid;

theorem 
  not x in still_not-bound_in p implies Ex(x,p) => Ex(y,p) is valid;

theorem 
  p=h.x & q=h.y & not x in still_not-bound_in q & not y in
  still_not-bound_in h implies Ex(x,p) => Ex(y,q) is valid;

theorem 
  All(x,p => q) => (All(x,p) => All(x,q)) is valid;

theorem 
  All(x,p => q) is valid implies All(x,p) => All(x,q) is valid;

theorem 
  All(x,p <=> q) => (All(x,p) <=> All(x,q)) is valid;

theorem 
  All(x,p <=> q) is valid implies All(x,p) <=> All(x,q) is valid;

theorem 
  All(x,p => q) => (Ex(x,p) => Ex(x,q)) is valid;

theorem 
  All(x,p => q) is valid implies Ex(x,p) => Ex(x,q) is valid;

theorem 
  All(x,p '&' q) => (All(x,p) '&' All(x,q)) is valid & (All(x,p)
  '&' All(x,q)) => All(x,p '&' q) is valid;

theorem 
  All(x,p '&' q) <=> (All(x,p) '&' All(x,q)) is valid;

theorem 
  All(x,p '&' q) is valid iff All(x,p) '&' All(x,q) is valid;

theorem 
  (All(x,p) 'or' All(x,q)) => All(x,p 'or' q) is valid;

theorem 
  Ex(x,p 'or' q) => (Ex(x,p) 'or' Ex(x,q)) is valid & (Ex(x,p)
  'or' Ex(x,q)) => Ex(x,p 'or' q) is valid;

theorem 
  Ex(x,p 'or' q) <=> (Ex(x,p) 'or' Ex(x,q)) is valid;

theorem 
  Ex(x,p 'or' q) is valid iff Ex(x,p) 'or' Ex(x,q) is valid;

theorem 
  Ex(x,p '&' q) => (Ex(x,p) '&' Ex(x,q)) is valid;

theorem 
  Ex(x,p '&' q) is valid implies Ex(x,p) '&' Ex(x,q) is valid;

theorem 
  All(x,'not' 'not' p) => All(x,p) is valid & All(x,p) => All(x,
  'not' 'not' p) is valid;

theorem 
  All(x,'not' 'not' p) <=> All(x,p) is valid;

theorem 
  Ex(x,'not' 'not' p) => Ex(x,p) is valid & Ex(x,p) => Ex(x,'not'
  'not' p) is valid;

theorem 
  Ex(x,'not' 'not' p) <=> Ex(x,p) is valid;

theorem 
  'not' Ex(x,'not' p) => All(x,p) is valid & All(x,p) => 'not' Ex(
  x,'not' p) is valid;

theorem 
  'not' Ex(x,'not' p) <=> All(x,p) is valid;

theorem 
  'not' All(x,p) => Ex(x,'not' p) is valid & Ex(x,'not' p) =>
  'not' All(x,p) is valid;

theorem 
  'not' All(x,p) <=> Ex(x,'not' p) is valid;

theorem 
  'not' Ex(x,p) => All(x,'not' p) is valid & All(x,'not' p) => 'not' Ex(
  x, p ) is valid;

theorem 
  All(x,'not' p) <=> 'not' Ex(x,p) is valid;

theorem 
  All(x,All(y,p)) => All(y,All(x,p)) is valid & All(x,y,p) => All(y,x,p)
  is valid;

theorem 
  p=h.x & q=h.y & not y in still_not-bound_in h implies All(x,All(y,q))
  => All(x,p) is valid;

theorem 
  Ex(x,Ex(y,p)) => Ex(y,Ex(x,p)) is valid & Ex(x,y,p) => Ex(y,x,p) is valid;

theorem 
  p=h.x & q=h.y & not y in still_not-bound_in h implies Ex(x,p) => Ex(x,
  y,q) is valid;

theorem 
  Ex(x,All(y,p)) => All(y,Ex(x,p)) is valid;

theorem 
  Ex(x,p <=> p) is valid;

theorem 
  Ex(x,p => q) => (All(x,p) => Ex(x,q)) is valid & (All(x,p) => Ex
  (x,q)) => Ex(x,p => q) is valid;

theorem 
  Ex(x,p => q) <=> (All(x,p) => Ex(x,q)) is valid;

theorem 
  Ex(x,p => q) is valid iff All(x,p) => Ex(x,q) is valid;

theorem 
  All(x,p '&' q) => (p '&' All(x,q)) is valid;

theorem 
  All(x,p '&' q) => (All(x,p) '&' q) is valid;

theorem 
  not x in still_not-bound_in p implies (p '&' All(x,q)) => All(x,
  p '&' q) is valid;

theorem 
  not x in still_not-bound_in p & p '&' All(x,q) is valid implies All(x,
  p '&' q ) is valid;

theorem 
  not x in still_not-bound_in p implies (p 'or' All(x,q)) => All(x
  ,p 'or' q) is valid & All(x,p 'or' q) => (p 'or' All(x,q)) is valid;

theorem 
  not x in still_not-bound_in p implies (p 'or' All(x,q)) <=> All(
  x,p 'or' q) is valid;

theorem 
  not x in still_not-bound_in p implies ( p 'or' All(x,q) is valid iff
  All(x,p 'or' q) is valid);

theorem 
  not x in still_not-bound_in p implies (p '&' Ex(x,q)) => Ex(x,p
  '&' q) is valid & Ex(x,p '&' q) => (p '&' Ex(x,q)) is valid;

theorem 
  not x in still_not-bound_in p implies (p '&' Ex(x,q)) <=> Ex(x,p
  '&' q) is valid;

theorem 
  not x in still_not-bound_in p implies ( p '&' Ex(x,q) is valid iff Ex(
  x,p '&' q ) is valid );

theorem 
  not x in still_not-bound_in p implies All(x,p => q) => (p => All
  (x,q)) is valid & (p => All(x,q)) => All(x,p => q) is valid;

theorem 
  not x in still_not-bound_in p implies (p => All(x,q)) <=> All(x,
  p => q) is valid;

theorem 
  not x in still_not-bound_in p implies ( All(x,p => q) is valid iff p
  => All(x, q ) is valid );

theorem 
  not x in still_not-bound_in q implies Ex(x,p => q) => (All(x,p)
  => q) is valid;

theorem 
  (All(x,p) => q) => Ex(x,p => q) is valid;

theorem 
  not x in still_not-bound_in q implies ( All(x,p) => q is valid iff Ex(
  x,p => q ) is valid );

theorem 
  not x in still_not-bound_in q implies (Ex(x,p) => q) => All(x,p
  => q) is valid & All(x,p => q) => (Ex(x,p) => q) is valid;

theorem 
  not x in still_not-bound_in q implies (Ex(x,p) => q) <=> All(x,p
  => q) is valid;

theorem 
  not x in still_not-bound_in q implies ( Ex(x,p) => q is valid iff All(
  x,p => q) is valid );

theorem 
  not x in still_not-bound_in p implies Ex(x,p => q) => (p => Ex(x
  ,q)) is valid;

theorem 
  (p => Ex(x,q)) => Ex(x,p => q) is valid;

theorem 
  not x in still_not-bound_in p implies (p => Ex(x,q)) <=> Ex(x,p
  => q) is valid;

theorem 
  not x in still_not-bound_in p implies ( p => Ex(x,q) is valid iff Ex(x
  ,p => q ) is valid );

theorem 
  {p} |- p;

theorem 
  Cn({p} \/ {q}) = Cn({p '&' q});

theorem 
  {p,q} |- r iff {p '&' q} |- r;

theorem 
  X|- p implies X|- All(x,p);

theorem 
  not x in still_not-bound_in p implies X|- All(x,p => q) => (p => All(x
  ,q));


theorem 
  F is closed & (X \/ {F})|- G implies X |- F => G;














begin

reserve H for ZF-formula,
  M,E for non empty set,
  e for Element of E,
  m,m0,m3, m4 for Element of M,
  v,v1,v2 for Function of VAR,M,
  f,f1 for Function of VAR,E,
  g for Function,
  u,u1,u2 for set,
  x,y for Variable,
  i,n for Element of NAT,
  X for set;

definition
  let H,M,v;
  func Section(H,v) -> Subset of M equals


  { m : M,v/(x.0,m) |= H } if
  x.0 in Free H otherwise {};
end;

definition
  let M;
  attr M is predicatively_closed means


  for H, E, f st E in M holds Section(H,f) in M;
end;

theorem 
  E is epsilon-transitive implies Section(All(x.2,x.2 'in' x.0 =>
  x.2 'in' x.1),f/(x.1,e)) = E /\ bool e;

reserve W for Universe,
  w for Element of W,
  Y for Subclass of W,
  a,a1,b,c for Ordinal of W,
  L for DOMAIN-Sequence of W;

theorem 
  (for a,b st a in b holds L.a c= L.b) & (for a holds L.a in Union
L & L.a is epsilon-transitive) & Union L is predicatively_closed implies Union
  L |= the_axiom_of_power_sets;

theorem 
  omega in W & (for a,b st a in b holds L.a c= L.b) & (for a st a
<> {} & a is limit_ordinal holds L.a = Union (L|a)) & (for a holds L.a in Union
L & L.a is epsilon-transitive) & Union L is predicatively_closed implies for H
st {x.0,x.1,x.2} misses Free H holds Union L |= the_axiom_of_substitution_for H
;

theorem 
  Section(H,v)= {m : {[{},m]} \/ (v*decode)|((code Free H)\{{}}) in
  Diagram(H,M)};

theorem 
  Y is closed_wrt_A1-A7 & Y is epsilon-transitive implies Y is
  predicatively_closed;

theorem 
  omega in W & (for a,b st a in b holds L.a c= L.b) & (for a st a <> {}
& a is limit_ordinal holds L.a = Union (L|a)) & (for a holds L.a in Union L & L
  .a is epsilon-transitive) & Union L is closed_wrt_A1-A7 implies Union L is
  being_a_model_of_ZF;














begin 

definition
  let D be set;
  attr D is with_VERUM means


  <*0*> in D;
end;

definition
  let D be set;
  attr D is with_implication means


  for p, q being FinSequence st p in D & q in D holds <*1*>^p^q in D;
end;

definition
  let D be set;
  attr D is with_conjunction means


  for p, q being FinSequence st p in D & q in D holds <*2*>^p^q in D;
end;

definition
  let D be set;
  attr D is with_propositional_variables means


  for n being Element of NAT holds <*3+n*> in D;
end;

definition
  let D be set;
  attr D is HP-closed means


  D c= NAT* & D is with_VERUM
  with_implication with_conjunction with_propositional_variables;
end;

registration
  cluster HP-closed -> with_VERUM with_implication with_conjunction
    with_propositional_variables non empty for set;
  cluster with_VERUM with_implication with_conjunction
    with_propositional_variables -> HP-closed for Subset of NAT*;
end;

definition
  func HP-WFF -> set means


  it is HP-closed & for D being set st D is HP-closed holds it c= D;
end;

registration
  cluster HP-WFF -> HP-closed;
end;

registration
  cluster HP-closed non empty for set;
end;

registration
  cluster HP-WFF -> functional;
end;

registration
  cluster -> FinSequence-like for Element of HP-WFF;
end;

definition
  mode HP-formula is Element of HP-WFF;
end;

definition
  func VERUM -> HP-formula equals

  <*0*>;
  let p, q be Element of HP-WFF;
  func p => q -> HP-formula equals

  <*1*>^p^q;
  func p '&' q -> HP-formula equals

  <*2*>^p^q;
end;

reserve T, X, Y for Subset of HP-WFF;
reserve p, q, r, s for Element of HP-WFF;

definition
  let T be Subset of HP-WFF;
  attr T is Hilbert_theory means


  VERUM in T & for p, q, r being
Element of HP-WFF holds p => (q => p) in T & (p => (q => r)) => ((p => q) => (p
=> r)) in T & (p '&' q) => p in T & (p '&' q) => q in T & p => (q => (p '&' q))
  in T & (p in T & p => q in T implies q in T);
end;

definition
  let X;
  func CnPos X -> Subset of HP-WFF means


  r in it iff for T st T is Hilbert_theory & X c= T holds r in T;
end;

definition
  func HP_TAUT -> Subset of HP-WFF equals

  CnPos({}(HP-WFF));
end;

theorem 
  VERUM in CnPos (X);

theorem 
  p => (q => (p '&' q)) in CnPos (X);

theorem 
  (p => (q => r)) => ((p => q) => (p => r)) in CnPos (X);

theorem 
  p => (q => p) in CnPos (X);

theorem 
  p '&' q => p in CnPos(X);

theorem 
  p '&' q => q in CnPos(X);

theorem 
  p in CnPos(X) & p => q in CnPos(X) implies q in CnPos(X);

theorem 
  T is Hilbert_theory & X c= T implies CnPos(X) c= T;

theorem 
  X c= CnPos(X);

theorem 
  X c= Y implies CnPos(X) c= CnPos(Y);

theorem 
  CnPos(CnPos(X)) = CnPos(X);

registration
  let X be Subset of HP-WFF;
  cluster CnPos(X) -> Hilbert_theory;
end;

theorem 
  T is Hilbert_theory iff CnPos(T) = T;

theorem 
  T is Hilbert_theory implies HP_TAUT c= T;

registration
  cluster HP_TAUT -> Hilbert_theory;
end;

begin  

theorem 
  p => p in HP_TAUT;

theorem 
  q in HP_TAUT implies p => q in HP_TAUT;

theorem 
  p => VERUM in HP_TAUT;

theorem 
  (p => q) => (p => p) in HP_TAUT;

theorem 
  (q => p) => (p => p) in HP_TAUT;

theorem 
  (q => r) => ((p => q) => (p => r)) in HP_TAUT;

theorem 
  p => (q => r) in HP_TAUT implies q => (p => r) in HP_TAUT;

theorem 
  (p => q) => ((q => r) => (p => r)) in HP_TAUT;

theorem 
  p => q in HP_TAUT implies (q => r) => (p => r) in HP_TAUT;

theorem 
  p => q in HP_TAUT & q => r in HP_TAUT implies p => r in HP_TAUT;

theorem 
  (p => (q => r)) => ((s => q) => (p => (s => r))) in HP_TAUT;

theorem 
  ((p => q) => r) => (q => r) in HP_TAUT;

theorem 
  (p => (q => r)) => (q => (p => r)) in HP_TAUT;

theorem 
  (p => (p => q)) => (p => q) in HP_TAUT;

theorem 
  q => ((q => p) => p) in HP_TAUT;

theorem 
  s => (q => p) in HP_TAUT & q in HP_TAUT implies s => p in HP_TAUT;

begin 

theorem 
  p => (p '&' p) in HP_TAUT;

theorem 
  (p '&' q) in HP_TAUT iff p in HP_TAUT & q in HP_TAUT;

theorem 
  (p '&' q) in HP_TAUT implies (q '&' p) in HP_TAUT;

theorem 
  (( p '&' q ) => r ) => ( p => ( q => r )) in HP_TAUT;

theorem 
  ( p => ( q => r )) => (( p '&' q ) => r ) in HP_TAUT;

theorem 
  ( r => p ) => (( r => q ) => ( r => ( p '&' q ))) in HP_TAUT;

theorem 
  ( (p => q) '&' p ) => q in HP_TAUT;

theorem 
  (( (p => q) '&' p ) '&' s ) => q in HP_TAUT;

theorem 
  (q => s) => (( p '&' q ) => s) in HP_TAUT;

theorem 
  (q => s) => (( q '&' p ) => s) in HP_TAUT;

theorem 
  ( (p '&' s) => q ) => ((p '&' s) => (q '&' s)) in HP_TAUT;

theorem 
  ( p => q ) => ((p '&' s) => (q '&' s)) in HP_TAUT;

theorem 
  ( p => q ) '&' ( p '&' s ) => ( q '&' s ) in HP_TAUT;

theorem 
  ( p '&' q ) => ( q '&' p ) in HP_TAUT;

theorem 
  ( p => q ) '&' ( p '&' s ) => ( s '&' q ) in HP_TAUT;

theorem 
  ( p => q ) => (( p '&' s ) => ( s '&' q )) in HP_TAUT;

theorem 
  ( p => q ) => (( s '&' p ) => ( s '&' q )) in HP_TAUT;

theorem 
  ( p '&' (s '&' q) ) => ( p '&' (q '&' s) ) in HP_TAUT;

theorem 
  ( ( p => q ) '&' (p => s) ) => ( p => (q '&' s) ) in HP_TAUT;

theorem 
  (p '&' q) '&' s => p '&' (q '&' s) in HP_TAUT;

theorem 
  p '&' (q '&' s) => (p '&' q) '&' s in HP_TAUT;














begin

reserve A for QC-alphabet;

definition
  let A;
  let b be bound_QC-variable of A;
  func x. b -> QC-symbol of A means

    x.it = b;
end;

theorem 
  for x,y being set, f being Function holds Im(f+*(x .--> y),x) = { y};

theorem 
  for K,L being set for x,y being set, f being Function holds (f+*(
  L --> y)).:K c= f.:K \/ {y};

theorem 
  for x,y being set, g being Function, A being set holds (g +* (x
  .--> y)).:(A \ {x}) = g.:(A \ {x});

theorem 
  for x,y being set for g being Function for A being set st not y
in g.:(A \ {x}) holds (g +* (x .--> y)).:(A \ {x}) = (g +* (x .--> y)).:A \ {y}
;

reserve i,j,k,l,m,n for Element of NAT;
reserve a,b,e for set;
reserve t,u,v,w,z for QC-symbol of A;

reserve p,q,r,s for Element of CQC-WFF(A);
reserve x for Element of bound_QC-variables(A);
reserve ll for CQC-variable_list of k,A;
reserve P for QC-pred_symbol of k,A;


theorem 
  p is atomic implies ex k,P,ll st p = P!ll;

theorem 
  p is negative implies ex q st p = 'not' q;

theorem 
  p is conjunctive implies ex q,r st p = q '&' r;

theorem 
  p is universal implies ex x,q st p = All(x,q);

theorem 
  for l being FinSequence holds rng l = { l.i : 1 <= i & i <= len l };

scheme 

  QCFuncExN { Al() -> QC-alphabet, D() -> non empty set,
V() -> Element of D(), A(set) -> Element
of D(), N(set,set) -> Element of D(), C(set,set,set) -> Element of D(), Q(set,
set) -> Element of D()} : ex F being Function of QC-WFF(Al()), D() st
F.VERUM(Al()) = V() &
  for p being Element of QC-WFF(Al()) holds (p is atomic implies F.p = A(p)) &
(p is negative implies F.p = N(F.the_argument_of p,p)) &
(p is conjunctive implies F.p = C(F.the_left_argument_of p,
 F.the_right_argument_of p, p)) & (p is universal implies F.p =
Q(F.the_scope_of p, p));

scheme 

  CQCF2FuncEx { Al() -> QC-alphabet, D, E() -> non empty set,
V() -> Element of Funcs(D(),E()), A(set,set,set) -> Element of Funcs(D(),
E()), N(set,set) -> Element of Funcs(D(),E()),
C(set,set,set,set) -> Element of Funcs(D(),E()),
Q(set,set,set) -> Element of Funcs(D(),E()) }
:
ex F being Function of CQC-WFF(Al()), Funcs(D(),E()) st
F.VERUM(Al()) = V() & (for k for l being CQC-variable_list of k,Al()
for P being QC-pred_symbol of k,Al() holds F.(P!l) = A(k,P,l)) &
for r,s being Element of CQC-WFF(Al())
for x being Element of bound_QC-variables(Al())
holds F.('not' r) = N(F.r,r) & F.(r '&' s) = C(F.r,F.s,r,s) &
F.All(x,r) = Q(x,F.r,r);

scheme 

  CQCF2FUniq { Al() -> QC-alphabet, D, E() -> non empty set, F1,
               F2() -> Function of CQC-WFF(Al()),Funcs(D(),E()),
               V() -> Function of D(),E(), A(set,set,set) -> Function of D(),
               E(), N(set,set) -> Function of D(),E(),
               C(set,set,set,set) -> Function of D(),E(),
               Q(set,set,set) -> Function of D(),E() }
:
F1() = F2()
provided
 F1().VERUM(Al()) = V() and
 for k for ll be CQC-variable_list of k,Al()
    for P be QC-pred_symbol of k,Al()
    holds F1().(P!ll) = A(k,P,ll) and
 for r,s be Element of CQC-WFF(Al())
    for x be Element of bound_QC-variables(Al())
    holds F1().('not' r) = N(F1().r,r) &
     F1().(r '&' s) = C(F1().r,F1().s,r,s) & F1().All(x,r) = Q(x,F1().r,r) and
 F2().VERUM(Al()) = V() and
 for k for ll be CQC-variable_list of k,Al()
    for P be QC-pred_symbol of k,Al()
    holds F2().(P!ll) = A(k,P,ll) and
 for r,s be Element of CQC-WFF(Al())
    for x be Element of bound_QC-variables(Al())
    holds F2().('not' r) = N(F2().r,r) &
     F2().(r '&' s) = C(F2().r,F2().s,r,s) & F2().All(x,r) = Q(x,F2().r,r);

theorem 
  p is_subformula_of 'not' p;

theorem 
  p is_subformula_of p '&' q & q is_subformula_of p '&' q;

theorem 
  p is_subformula_of All(x,p);

theorem 
  for l being CQC-variable_list of k,A, i st 1<=i & i<=len l holds l
  .i in bound_QC-variables(A);

definition
  let A;
  let D be non empty set, f be Function of D, CQC-WFF(A);
  func NEGATIVE f -> Element of Funcs(D, CQC-WFF(A)) means


  for a being
  Element of D for p being Element of CQC-WFF(A) st p=f.a holds it.a = 'not' p;
end;


reserve f,h for Element of Funcs(bound_QC-variables(A),bound_QC-variables(A)),
  K,L for Finite_Subset of bound_QC-variables(A);

definition
  let A;
  let f,g be Function of [:QC-symbols(A),Funcs(bound_QC-variables(A),
                           bound_QC-variables(A)):],
  CQC-WFF(A), n;
  func CON(f,g,n) -> Element of Funcs([:QC-symbols(A),
   Funcs(bound_QC-variables(A), bound_QC-variables(A)):], CQC-WFF(A)) means


  for t,h,p,q st p = f.(t,h) & q = g .(t+n,h) holds it.(t,h) = p '&' q;
end;

definition
  let A;
  let f be Function of
   [:QC-symbols(A),Funcs(bound_QC-variables(A),bound_QC-variables(A)):],
    CQC-WFF(A),x be bound_QC-variable of A;
  func UNIVERSAL(x,f) -> Element of Funcs([:QC-symbols(A),
   Funcs(bound_QC-variables(A), bound_QC-variables(A)):],CQC-WFF(A)) means


  for t,h,p st p = f.(t++,h +* (x .--> x.t)) holds it.(t,h)=All(x.t,p);
end;

definition
  let A;
  let k;
  let l be CQC-variable_list of k,A;
  let f be Element of Funcs(bound_QC-variables(A),bound_QC-variables(A));
  redefine func f*l -> CQC-variable_list of k,A;
end;

definition
  let A;
  let k;
  let P be QC-pred_symbol of k,A, l be CQC-variable_list of k,A;
  func ATOMIC(P,l) -> Element of Funcs([:QC-symbols(A),
   Funcs(bound_QC-variables(A), bound_QC-variables(A)):], CQC-WFF(A)) means


  for t,h holds it.(t,h) = P!(h*l);
end;

definition
  let A;
  let p;
  func QuantNbr(p) -> Element of NAT means


  ex F being Function of
  CQC-WFF(A), NAT st it = F.p & F.VERUM(A) = 0 & for r,s,x,k for l being
CQC-variable_list of k,A for P being QC-pred_symbol of k,A holds F.(P!l) = 0 &
F.('not' r) = F.r & F.(r '&' s) = F.r + F.s & F.All(x,r) = F.r + 1;
end;

definition
  let A;
  let f be Function of CQC-WFF(A), Funcs([:QC-symbols(A),
   Funcs(bound_QC-variables(A), bound_QC-variables(A)):],CQC-WFF(A)),
   x be Element of CQC-WFF(A);
  redefine func f.x -> Element of Funcs([:QC-symbols(A),
   Funcs(bound_QC-variables(A), bound_QC-variables(A)):],CQC-WFF(A));
end;

definition
  let A;
  func SepFunc(A) -> Function of CQC-WFF(A),
   Funcs([:QC-symbols(A),Funcs(bound_QC-variables(A), bound_QC-variables(A)):],
   CQC-WFF(A)) means


  it.VERUM(A) = [:QC-symbols(A),Funcs(
  bound_QC-variables(A),bound_QC-variables(A)):] --> VERUM(A) &
  (for k for l being CQC-variable_list of k,A for P being QC-pred_symbol of k,A
  holds it.(P!l)=ATOMIC(P,l)) & for r,s,x holds it.('not' r) = NEGATIVE(it.r)
  & it.(r '&' s) = CON(it.r,it.s,QuantNbr(r)) & it.All(x,r) =UNIVERSAL(x,it.r);
end;

definition
  let A;
  let p,t,f;
  func SepFunc(p,t,f) -> Element of CQC-WFF(A) equals

  ((SepFunc(A)).p).[t,f];
end;


theorem 
  QuantNbr(VERUM(A)) = 0;

theorem 
  QuantNbr(P!ll) = 0;

theorem 
  QuantNbr('not' p) = QuantNbr(p);

theorem 
  QuantNbr(p '&' q) = QuantNbr(p) + QuantNbr(q);

theorem 
  QuantNbr(All(x,p)) = QuantNbr(p) + 1;

theorem 
  for p being Element of QC-WFF(A) holds still_not-bound_in p is finite;

scheme 

  MaxFinDomElem {D()->non empty set, X()->set, P[set,set] }: ex x being
Element of D() st x in X() & for y being Element of D() st y in X() holds P[x,y
  ]
provided
 X() is finite & X() <> {} & X() c= D() and
 for x,y being Element of D() holds P[x,y] or P[y,x] and
 for x,y,z being Element of D() st P[x,y] & P[y,z] holds P[x,z];

definition
  let X be set;
  redefine func id X -> Element of Funcs(X,X);
end;

definition
  let A;
  let p;
  func NBI p -> Subset of QC-symbols(A) equals

  {t: for u st t<=u holds not x.u in still_not-bound_in p};
end;

registration
  let A;
  let p;
  cluster NBI p -> non empty;
end;

definition
  let A;
  let p;
  func index p -> QC-symbol of A equals

  min NBI p;
end;

theorem 
  index p = 0(A) iff p is closed;

theorem 
  x.t in still_not-bound_in p implies t < index p;

theorem 
  index VERUM(A) = 0(A);

theorem 
  index ('not' p) = index p;

theorem 
  index p <= index(p '&' q) & index q <= index(p '&' q);

definition
  let A;
  let p;
  func SepVar(p) -> Element of CQC-WFF(A) equals

  SepFunc(p, index p, id(bound_QC-variables(A)));
end;

theorem 
  SepVar VERUM(A) = VERUM(A);

scheme 

  CQCInd{ A() -> QC-alphabet, P[set] }: for r being Element of CQC-WFF(A())
  holds P[r]
provided
 P[VERUM(A())] and
 for k for l being CQC-variable_list of k,A() for P being QC-pred_symbol
of k,A() holds P[P!l] and
 for r being Element of CQC-WFF(A()) st P[r] holds P['not' r] and
 for r,s being Element of CQC-WFF(A()) st P[r] & P[s] holds P[r '&' s] and
 for r being Element of CQC-WFF(A()), x being bound_QC-variable of A()
 st P[r] holds P[All(x, r)];

theorem 
  SepVar(P!ll) = P!ll;

theorem 
  p is atomic implies SepVar p = p;

theorem 
  SepVar 'not' p = 'not' SepVar p;

theorem 
  p is negative & q = the_argument_of p implies SepVar p = 'not' SepVar q;

definition
  let A;
  let p;
  let X be Subset of [:CQC-WFF(A),QC-symbols(A),Fin bound_QC-variables(A),
   Funcs(bound_QC-variables(A),bound_QC-variables(A)):];
  pred X is_Sep-closed_on p means


  [p,index p, {}.bound_QC-variables(A),id
(bound_QC-variables(A))] in X & (for q,t,K,f holds ['not' q,t,K,f] in X
 implies [q,t,K,f] in X) & (for q,r,t,K,f holds [q '&' r,t,K,f] in X implies
 [q,t,K,f] in X & [r,t+QuantNbr(q),K,f] in X) & for q,x,t,K,f st
 [All(x,q),t,K,f] in X holds [q,t++,K \/ {x}, f+*(x .--> x.t)] in X;
end;

definition
  let A;
  let p;
  func SepQuadruples p -> Subset of [:CQC-WFF(A),QC-symbols(A),Fin
   bound_QC-variables(A), Funcs(bound_QC-variables(A),bound_QC-variables(A)):]
  means

  it is_Sep-closed_on p & for D being Subset of [:CQC-WFF(A), QC-symbols(A),
   Fin bound_QC-variables(A),Funcs(bound_QC-variables(A),
   bound_QC-variables(A)):] st D is_Sep-closed_on p holds it c= D;
end;

theorem 
  [p,index p,{}.bound_QC-variables(A),id(bound_QC-variables(A))] in
 SepQuadruples(p);

theorem 
  for q,t,K,f st ['not' q,t,K,f] in SepQuadruples p holds [q,t,K,f
  ] in SepQuadruples p;

theorem 
  for q,r,t,K,f st [q '&' r,t,K,f] in SepQuadruples p holds [q,t,K
  ,f] in SepQuadruples p & [r,t+QuantNbr(q),K,f] in SepQuadruples p;

theorem 
  for q,x,t,K,f st [All(x,q),t,K,f] in SepQuadruples p holds [q,t++,K \/ {x},
  f+*(x .--> x.t)] in SepQuadruples p;

theorem 
  [q,t,K,f] in SepQuadruples p implies [q,t,K,f] = [p,index p,{}.
bound_QC-variables(A),id bound_QC-variables(A)] or ['not' q,t,K,f]
in SepQuadruples p or (ex r st [q '&' r, t, K,f] in SepQuadruples p) or
  (ex r,u st t = u+QuantNbr r & [r '&' q,u,K,f] in SepQuadruples p) or
  ex x,u,h st u++ = t & h +*({x} --> x.u) = f & ([All(x,q),u,K,h]
  in SepQuadruples p or [All(x,q),u,K\{x},h] in SepQuadruples p);

scheme 

  Sepregression{A() -> QC-alphabet, p()-> Element of CQC-WFF(A()),
   P[set,set,set,set] }:
   for q being Element of CQC-WFF(A()), t being QC-symbol of A(),
   K being Finite_Subset of bound_QC-variables(A()), f being Element of
   Funcs(bound_QC-variables(A()),bound_QC-variables(A())) st
   [q,t,K,f] in SepQuadruples p() holds P[q,t,K,f]
provided
 P[p(),index p(),{}.bound_QC-variables(A()),id bound_QC-variables(A())] and
 for q being Element of CQC-WFF(A()), t being QC-symbol of A(),
K being Finite_Subset of bound_QC-variables(A()), f being Element of
Funcs(bound_QC-variables(A()),bound_QC-variables(A())) st
['not' q,t,K,f] in SepQuadruples p() & P['not' q,t,K,
f] holds P[q,t,K,f] and
 for q,r being Element of CQC-WFF(A()), t being QC-symbol of A(),
K being Finite_Subset of bound_QC-variables(A()), f being Element of
Funcs(bound_QC-variables(A()),bound_QC-variables(A())) st
[q '&' r, t, K,f] in SepQuadruples p() & P[q '&' r,
t, K,f] holds P[q,t,K,f] & P[r,t+QuantNbr(q),K,f] and
 for q being Element of CQC-WFF(A()), x being bound_QC-variable of A(),
t being QC-symbol of A(), K being Finite_Subset of bound_QC-variables(A()),
f being Element of Funcs(bound_QC-variables(A()),bound_QC-variables(A()))
st [All(x,q),t,K,f] in SepQuadruples p() & P[All(x,q),t,K,f] holds
P[q,t++,K \/ {x},f+*(x .--> x.t)];

theorem 
  for q,t,K,f holds [q,t,K,f] in SepQuadruples p implies q is_subformula_of p;

theorem 
  SepQuadruples VERUM(A) = { [VERUM(A),0(A),{}.bound_QC-variables(A),id
  bound_QC-variables(A)] };

theorem 
  for k for l being CQC-variable_list of k,A for P being QC-pred_symbol of
  k,A holds SepQuadruples(P!l) = { [P!l,index(P!l),{}.bound_QC-variables(A),
  id bound_QC-variables(A)] };

theorem 
  for q,t,K,f st [q,t,K,f] in SepQuadruples p holds
  still_not-bound_in q c= still_not-bound_in p \/ K;

theorem 
  [q,t,K,f] in SepQuadruples p & x.u in f.:K implies u < t;

theorem 
  [q,t,K,f] in SepQuadruples p implies not x.t in f.:K;

theorem 
  [q,t,K,f] in SepQuadruples p & x.u in f.:still_not-bound_in p implies u<t;

theorem 
  [q,t,K,f] in SepQuadruples p & x.u in f.:still_not-bound_in q implies u<t;

theorem 
  [q,t,K,f] in SepQuadruples p implies not x.t in f.:(still_not-bound_in
  q);

theorem 
  still_not-bound_in p = still_not-bound_in SepVar p;

theorem 
  index p = index(SepVar p);

definition
  let A;
  let p,q;
  pred p,q are_similar means


  SepVar(p) = SepVar(q);
  reflexivity;
  symmetry;
end;

theorem 
  p,q are_similar & q,r are_similar implies p,r are_similar;














begin

reserve x,y,x1,x2,z for set,
  n,m,k for Element of NAT,
  t1 for (DecoratedTree of [: NAT,NAT :]),
  w,s,t,u for FinSequence of NAT,
  D for non empty set;

definition
  let Z be Tree;
  func Root Z -> Element of Z equals

  {};
end;

definition
  let D;
  let T be DecoratedTree of D;
  func Root T -> Element of D equals

  T.(Root dom T);
end;

theorem 
  n <> m implies not <*n*>,<*m*>^s are_c=-comparable;

theorem 
  for s st s <> {} ex w being FinSequence of NAT,
  n being Element of NAT st s = <*n*>^w;

theorem 
  n <> m implies not <*n*> is_a_proper_prefix_of <*m*>^s;

theorem 
  n <> m implies not <*n*> is_a_prefix_of <*m*>^s;

theorem 
  not <*n*> is_a_proper_prefix_of <*m*>;

theorem 
  elementary_tree 1 = {{},<*0*>};

theorem 
  elementary_tree 2 = {{},<*0*>,<*1*>};

theorem 
  for Z being Tree,n,m st n <= m & <*m*> in Z holds <*n*> in Z;

theorem 
  w^t is_a_proper_prefix_of w^s implies t is_a_proper_prefix_of s
;

theorem 
  t1 in PFuncs(NAT*,[: NAT,NAT :]);

theorem 
  for Z,Z1,Z2 being Tree,z being Element of Z st Z
  with-replacement (z,Z1) = Z with-replacement (z,Z2) holds Z1 = Z2;

theorem 
  for Z,Z1,Z2 being (DecoratedTree of D),z being Element of dom Z st
  Z with-replacement (z,Z1) = Z with-replacement (z,Z2) holds Z1 = Z2;

theorem 
  for Z1,Z2 being Tree,p being FinSequence of NAT st p in Z1 holds
for v being Element of Z1 with-replacement (p,Z2), w being Element of Z1 st v =
  w & w is_a_proper_prefix_of p holds succ v = succ w;

theorem 
  for Z1,Z2 being Tree,p being FinSequence of NAT st p in Z1 holds
for v being Element of Z1 with-replacement (p,Z2),w being Element of Z1 st v =
  w & not p,w are_c=-comparable holds succ v = succ w;

theorem 
  for Z1,Z2 being Tree,p being FinSequence of NAT st p in Z1 holds for v
  being Element of Z1 with-replacement (p,Z2),w being Element of Z2 st v = p^w
  holds succ v,succ w are_equipotent;

theorem 
  for Z1 being Tree,p being FinSequence of NAT st p in Z1 holds
for v being Element of Z1,w being Element of Z1|p st v = p^w holds succ v,succ
  w are_equipotent;

theorem 
  for Z being finite Tree st branchdeg (Root Z) = 0 holds card Z = 1 & Z = {{}}
;

theorem 
  for Z being finite Tree st branchdeg (Root Z) = 1 holds succ (
  Root Z) = { <*0*> };

theorem 
  for Z being finite Tree st branchdeg (Root Z) = 2 holds succ (
  Root Z) = { <*0*>,<*1*> };

reserve s9,w9,v9 for Element of NAT*;

theorem 
  for Z being Tree,o being Element of Z st o <> Root Z holds Z|o,{
  o^s9: o^s9 in Z } are_equipotent & not Root Z in { o^w9 : o^w9 in Z };

theorem 
  for Z being finite Tree,o being Element of Z st o <> Root Z
  holds card (Z|o) < card Z;

theorem 
  for Z being finite Tree,z being Element of Z st succ (Root Z) =
  {z} holds Z = elementary_tree 1 with-replacement (<*0*>,Z|z);

theorem 
  for Z being finite (DecoratedTree of D),z be Element of dom Z st
  succ (Root dom Z) = {z} holds Z = ((elementary_tree 1) --> Root Z)
  with-replacement (<*0*>,Z|z);

theorem 
  for Z being Tree,x1,x2 be Element of Z st x1 = <*0*> & x2 = <*1
*> & succ (Root Z) = {x1,x2} holds Z = (elementary_tree 2 with-replacement (<*0
  *>,Z|x1)) with-replacement (<*1*>,Z|x2);

theorem 
  for Z being (DecoratedTree of D),x1,x2 being Element of dom Z st
  x1 = <*0*> & x2 = <*1*> & succ (Root dom Z) = {x1,x2} holds Z = (((
elementary_tree 2) --> Root Z) with-replacement (<*0*>, Z|x1)) with-replacement
  (<*1*>,Z|x2);

definition
  func MP-variables -> set equals

  [: {3},NAT :];
end;

registration
  cluster MP-variables -> non empty;
end;

definition
  mode MP-variable is Element of MP-variables;
end;

definition
  func MP-conectives -> set equals

  [: {0,1,2},NAT :];
end;

registration
  cluster MP-conectives -> non empty;
end;

definition
  mode MP-conective is Element of MP-conectives;
end;

theorem 
  MP-conectives misses MP-variables;

reserve p,q for MP-variable;

definition
  let T be finite Tree,v be Element of T;
  redefine func branchdeg v -> Element of NAT;
end;

definition

  func MP-WFF -> DTree-set of [: NAT,NAT :] means


  (for x being DecoratedTree of [: NAT,NAT :] st x in it holds x is finite) &
  for x being finite DecoratedTree of [: NAT,NAT :] holds x in it iff
  for v being Element of dom x holds branchdeg v <= 2 &
  (branchdeg v = 0 implies x .v = [0,0] or ex k st x .v = [3,k]) &
  (branchdeg v = 1 implies x .v = [1,0] or x .v = [1,1]) &
  (branchdeg v = 2 implies x .v = [2,0]);
end;






definition
  mode MP-wff is Element of MP-WFF;
end;

registration
  cluster -> finite for MP-wff;
end;

reserve A,A1,B,B1,C,C1 for MP-wff;

definition
  let A;
  let a be Element of dom A;
  redefine func A|a -> MP-wff;
end;

definition
  let a be Element of MP-conectives;
  func the_arity_of a -> Element of NAT equals

  a`1;
end;

definition
  let D be non empty set, T,T1 be (DecoratedTree of D),
  p be FinSequence of NAT;
  assume
 p in dom T;
  func @(T,p,T1) -> DecoratedTree of D equals


  T with-replacement (p,T1);
end;

theorem 
  ((elementary_tree 1) --> [1,0]) with-replacement (<*0*>,A) is MP-wff;

theorem 
  ((elementary_tree 1)-->[1,1]) with-replacement (<*0*>,A) is MP-wff;

theorem 
  (((elementary_tree 2)-->[2,0]) with-replacement (<*0*>,A))
  with-replacement (<*1*>,B) is MP-wff;

definition
  let A;
  func 'not' A -> MP-wff equals

  ((elementary_tree 1)-->[1,0]) with-replacement
  (<*0*>,A);
  func (#) A -> MP-wff equals

  ((elementary_tree 1)-->[1,1]) with-replacement (
  <*0*>,A);
  let B;
  func A '&' B -> MP-wff equals

  ((((elementary_tree 2)-->[2,0])
  with-replacement (<*0*>,A))) with-replacement (<*1*>,B);
end;

definition
  let A;
  func ? A -> MP-wff equals

  'not' (#) 'not' A;
  let B;
  func A 'or' B -> MP-wff equals

  'not'('not' A '&' 'not' B);
  func A => B -> MP-wff equals

  'not'(A '&' 'not' B);
end;

theorem 
  (elementary_tree 0) --> [3,n] is MP-wff;

theorem 
  (elementary_tree 0) --> [0,0] is MP-wff;

definition
  let p;
  func @p -> MP-wff equals

  (elementary_tree 0) --> p;
end;

theorem 
  @p = @q implies p = q;

theorem 
  'not' A = 'not' B implies A = B;

theorem 
  (#)A = (#)B implies A = B;

theorem 
  (A '&' B) = (A1 '&' B1) implies A = A1 & B = B1;

definition
  func VERUM -> MP-wff equals

  (elementary_tree 0) --> [0,0];
end;

theorem 
  card dom A = 1 implies A = VERUM or ex p st A = @p;

theorem 
  card dom A >= 2 implies (ex B st A = 'not' B or A = (#)B) or ex
  B,C st A = B '&' C;

theorem 
  card dom A < card dom 'not' A;

theorem 
  card dom A < card dom (#)A;

theorem 
  card dom A < card dom(A '&' B) & card dom B < card dom (A '&' B);

definition
  let IT be MP-wff;
  attr IT is atomic means


  ex p st IT = @p;
  attr IT is negative means


  ex A st IT = 'not' A;
  attr IT is necessitive means


  ex A st IT = (#) A;
  attr IT is conjunctive means


  ex A,B st IT = A '&' B;
end;

registration
  cluster atomic for MP-wff;
  cluster negative for MP-wff;
  cluster necessitive for MP-wff;
  cluster conjunctive for MP-wff;
end;

scheme 

  MPInd { Prop[Element of MP-WFF] }: for A being Element of MP-WFF holds Prop[
  A]
provided
 Prop[VERUM] and
 for p being MP-variable holds Prop[@p] and
 for A being Element of MP-WFF st Prop[A] holds Prop['not' A] and
 for A being Element of MP-WFF st Prop[A] holds Prop[(#) A] and
 for A, B being Element of MP-WFF st Prop[A] & Prop[B] holds Prop[A '&' B];

theorem 
  for A being Element of MP-WFF holds A = VERUM or A is atomic MP-wff or
  A is negative MP-wff or A is necessitive MP-wff or A is conjunctive MP-wff;

theorem 
  A = VERUM or (ex p st A = @p) or (ex B st A = 'not' B) or (ex B
  st A = (#) B) or ex B,C st A = B '&' C;

theorem 
  @p <> 'not' A & @p <> (#)A & @p <> A '&' B;

theorem 
  'not' A <> (#)B & 'not' A <> B '&' C;

theorem 
  (#)A <> B '&' C;

theorem 
  VERUM <> @p & VERUM <> 'not' A & VERUM <> (#)A & VERUM <> A '&' B;

scheme 

  MPFuncEx{ D() -> non empty set, d() -> Element of D(), F(Element of
  MP-variables) -> Element of D(), N,H(Element of D()) -> Element of D(), C((
  Element of D()),Element of D()) -> Element of D() }: ex f being Function of
MP-WFF, D() st f.VERUM = d() & (for p being MP-variable holds f.@p = F(p)) & (
  for A being Element of MP-WFF holds f.('not' A) = N(f.A)) & (for A being
  Element of MP-WFF holds f.((#)A) = H(f.A)) & for A,B being Element of MP-WFF
  holds f.(A '&' B) = C(f.A,f.B);














begin

reserve A for QC-alphabet;
reserve p, q, r, s, p1, q1 for Element of CQC-WFF(A),
  X, Y, Z, X1, X2 for Subset of CQC-WFF(A),
  h for QC-formula of A,
  x, y for bound_QC-variable of A,
  n for Element of NAT;

theorem 
  p in X implies X |- p;

theorem 
  X c= Cn(Y) implies Cn(X) c= Cn(Y);

theorem 
  X |- p & {p} |- q implies X |- q;

theorem 
  X |- p & X c= Y implies Y |- p;

definition
  let A;
  let p, q be Element of CQC-WFF(A);
  pred p |- q means


  {p} |- q;
end;

theorem 
  p |- p;

theorem 
  p |- q & q |- r implies p |- r;

definition
  let A;
  let X, Y be Subset of CQC-WFF(A);
  pred X |- Y means


  for p being Element of CQC-WFF(A) st p in Y holds X |- p;
end;

theorem 
  X |- Y iff Y c= Cn(X);

theorem 
  X |- X;

theorem 
  X |- Y & Y |- Z implies X |- Z;

theorem 
  X |- {p} iff X |- p;

theorem 
  {p} |- {q} iff p |- q;

theorem 
  X c= Y implies Y |- X;

theorem 
  X |- TAUT(A);

theorem 
  {}(CQC-WFF(A)) |- TAUT(A);

definition
  let A;
  let X be Subset of CQC-WFF(A);
  pred |- X means


  for p being Element of CQC-WFF(A) st p in X holds p is valid;
end;

theorem 
  |- X iff {}(CQC-WFF(A)) |- X;

theorem 
  |- TAUT(A);

theorem 
  |- X iff X c= TAUT(A);

definition
  let A, X, Y;
  pred X |-| Y means


  for p holds (X |- p iff Y |- p);
  reflexivity;
  symmetry;
end;

theorem 
  X |-| Y iff X |- Y & Y |- X;

theorem 
  X |-| Y & Y |-| Z implies X |-| Z;

theorem 
  X |-| Y iff Cn(X) = Cn(Y);

theorem 
  Cn(X) \/ Cn(Y) c= Cn(X \/ Y);

theorem 
  Cn(X \/ Y) = Cn(Cn(X) \/ Cn(Y));

theorem 
  X |-| Cn(X);

theorem 
  X \/ Y |-| Cn(X) \/ Cn(Y);

theorem 
  X1 |-| X2 implies X1 \/ Y |-| X2 \/ Y;

theorem 
  X1 |-| X2 & X1 \/ Y |- Z implies X2 \/ Y |- Z;

theorem 
  X1 |-| X2 & Y |- X1 implies Y |- X2;

definition
  let A;
  let p, q be Element of CQC-WFF(A);
  pred p |-| q means


  p |- q & q |- p;
  reflexivity;
  symmetry;
end;

theorem 
  p |-| q & q |-| r implies p |-| r;

theorem 
  p |-| q iff {p} |-| {q};

theorem 
  p |-| q & X |- p implies X |- q;

theorem 
  {p,q} |-| {p '&' q};

theorem 
  p '&' q |-| q '&' p;

theorem 
  X |- p '&' q iff X |- p & X |- q;

theorem 
  p |-| q & r |-| s implies p '&' r |-| q '&' s;

theorem 
  X |- All(x,p) iff X |- p;

theorem 
  All(x,p) |-| p;

theorem 
  p |-| q implies All(x,p) |-| All(y,q);

definition
  let A;
  let p, q be Element of CQC-WFF(A);
  pred p is_an_universal_closure_of q means


  p is closed & ex n being
Element of NAT st 1 <= n & ex L being FinSequence st len L = n & L.1 = q & L.n
  = p & for k being Element of NAT st 1 <= k & k < n holds
  ex x being bound_QC-variable of A st
ex r being Element of CQC-WFF(A) st r = L.k &
L.(k+1) = All(x,r);
end;

theorem 
  p is_an_universal_closure_of q implies p |-| q;

theorem 
  p => q is valid implies p |- q;

theorem 
  X |- p => q implies X \/ {p} |- q;

theorem 
  p is closed & p |- q implies p => q is valid;

theorem 
  p1 is_an_universal_closure_of p implies (X \/ {p} |- q iff X |- p1 => q);

theorem 
  p is closed & p |- q implies 'not' q |- 'not' p;

theorem 
  p is closed & X \/ {p} |- q implies X \/ {'not' q} |- 'not' p;

theorem 
  p is closed & 'not' p |- 'not' q implies q |- p;

theorem 
  p is closed & X \/ {'not' p} |- 'not' q implies X \/ {q} |- p;

theorem 
  p is closed & q is closed implies (p |- q iff 'not' q |- 'not' p);

theorem 
  p1 is_an_universal_closure_of p & q1 is_an_universal_closure_of
  q implies (p |- q iff 'not' q1 |- 'not' p1);

theorem 
  p1 is_an_universal_closure_of p & q1 is_an_universal_closure_of q
  implies (p |-| q iff 'not' p1 |-| 'not' q1);

definition
  let A;
  let p, q be Element of CQC-WFF(A);
  pred p <==> q means


  p <=> q is valid;
  reflexivity;
  symmetry;
end;

theorem 
  p <==> q iff p => q is valid & q => p is valid;

theorem 
  p <==> q & q <==> r implies p <==> r;

theorem 
  p <==> q implies p |-| q;

theorem 
  p <==> q iff 'not' p <==> 'not' q;

theorem 
  p <==> q & r <==> s implies p '&' r <==> q '&' s;

theorem 
  p <==> q & r <==> s implies p => r <==> q => s;

theorem 
  p <==> q & r <==> s implies p 'or' r <==> q 'or' s;

theorem 
  p <==> q & r <==> s implies p <=> r <==> q <=> s;

theorem 
  p <==> q implies All(x,p) <==> All(x,q);

theorem 
  p <==> q implies Ex(x,p) <==> Ex(x,q);

theorem 
  for k being Element of NAT, l being QC-variable_list of k,A, a
being free_QC-variable of A, x being bound_QC-variable of A holds
still_not-bound_in l c=
  still_not-bound_in Subst(l,a .--> x);

theorem 
  for k being Element of NAT, l being QC-variable_list of k,A, a
  being free_QC-variable of A,
  x being bound_QC-variable of A holds still_not-bound_in
  Subst(l,a .--> x) c= still_not-bound_in l \/ {x};

theorem 
  for h holds still_not-bound_in h c= still_not-bound_in (h.x);

theorem 
  for h holds still_not-bound_in (h.x) c= still_not-bound_in h \/ {x};

theorem 
  p = h.x & x <> y & not y in still_not-bound_in h implies not y
  in still_not-bound_in p;

theorem 
  p = h.x & q = h.y & not x in still_not-bound_in h & not y in
  still_not-bound_in h implies All(x,p) <==> All(y,q);














begin

reserve A for QC-alphabet;
reserve n,k,m for Element of NAT;
reserve F,G,G9,H,H9 for Element of QC-WFF(A);

theorem 
  F is_subformula_of G implies len @ F <= len @ G;

theorem 
  F is_subformula_of G & len @ F = len @ G implies F = G;

definition
  let A;
  let p be Element of QC-WFF(A);
  func list_of_immediate_constituents(p) -> FinSequence of QC-WFF(A) equals


  <*> QC-WFF(A) if p = VERUM(A) or
  p is atomic, <* the_argument_of p *> if p is
  negative, <* the_left_argument_of p, the_right_argument_of p *> if p is
  conjunctive otherwise <* the_scope_of p *>;
end;

theorem 
  k in dom list_of_immediate_constituents(F) & G = (
  list_of_immediate_constituents(F)).k implies G is_immediate_constituent_of F;

theorem 
  rng list_of_immediate_constituents(F) = { G where G is Element
  of QC-WFF(A) : G is_immediate_constituent_of F };

definition
  let A;
  let p be Element of QC-WFF(A);
  func tree_of_subformulae(p) -> finite DecoratedTree of QC-WFF(A) means


  it.{} = p & for x being Element of dom it holds succ(it,x) =
  list_of_immediate_constituents(it.x);
end;

reserve t, t9, t99 for Element of dom tree_of_subformulae(F);

theorem 
  F in rng tree_of_subformulae(F);

theorem 
  t^<*n*> in dom tree_of_subformulae(F) implies ex G st G = (
  tree_of_subformulae(F)).(t^<*n*>) & G is_immediate_constituent_of (
  tree_of_subformulae(F)).t;

theorem 
  H is_immediate_constituent_of (tree_of_subformulae(F)).t iff ex
n st t^<*n*> in dom tree_of_subformulae(F) & H = (tree_of_subformulae(F)).(t^<*
  n*>);

theorem 
  G in rng tree_of_subformulae(F) & H is_immediate_constituent_of
  G implies H in rng tree_of_subformulae(F);

theorem 
  G in rng tree_of_subformulae(F) & H is_subformula_of G implies H
  in rng tree_of_subformulae(F);

theorem 
  G in rng tree_of_subformulae(F) iff G is_subformula_of F;

theorem 
  rng tree_of_subformulae(F) = Subformulae(F);

theorem 
  t9 in succ t implies (tree_of_subformulae(F)).t9
  is_immediate_constituent_of (tree_of_subformulae(F)).t;

reserve x for set;

theorem 
  t is_a_prefix_of t9 implies (tree_of_subformulae(F)).t9
  is_subformula_of (tree_of_subformulae(F)).t;

theorem 
  t is_a_proper_prefix_of t9 implies len @((tree_of_subformulae(F)
  ).t9) < len @((tree_of_subformulae(F)).t);

theorem 
  t is_a_proper_prefix_of t9 implies (tree_of_subformulae(F)).t9
  <> (tree_of_subformulae(F)).t;

theorem 
  t is_a_proper_prefix_of t9 implies (tree_of_subformulae(F)).t9
  is_proper_subformula_of (tree_of_subformulae(F)).t;

theorem 
  (tree_of_subformulae(F)).t = F iff t = {};

theorem 
  t <> t9 & (tree_of_subformulae(F)).t = (tree_of_subformulae(F)).
  t9 implies not t,t9 are_c=-comparable;

definition
  let A;
  let F, G be Element of QC-WFF(A);
  func F-entry_points_in_subformula_tree_of G -> AntiChain_of_Prefixes of dom
  tree_of_subformulae(F) means


  for t being Element of dom
  tree_of_subformulae(F) holds t in it iff (tree_of_subformulae(F)).t = G;
end;

theorem 
  F-entry_points_in_subformula_tree_of G = { t where t is Element
  of dom tree_of_subformulae(F) : (tree_of_subformulae(F)).t = G };

theorem 
  G is_subformula_of F iff F-entry_points_in_subformula_tree_of G <> {};

theorem 
  t9 = t^<*m*> & (tree_of_subformulae(F)).t is negative implies (
tree_of_subformulae(F)).t9 = the_argument_of (tree_of_subformulae(F)).t & m = 0
;

theorem 
  t9 = t^<*m*> & (tree_of_subformulae(F)).t is conjunctive implies
(tree_of_subformulae(F)).t9 = the_left_argument_of (tree_of_subformulae(F)).t &
  m = 0 or (tree_of_subformulae(F)).t9 = the_right_argument_of (
  tree_of_subformulae(F)).t & m = 1;

theorem 
  t9 = t^<*m*> & (tree_of_subformulae(F)).t is universal implies (
  tree_of_subformulae(F)).t9 = the_scope_of (tree_of_subformulae(F)).t & m = 0;

theorem 
  (tree_of_subformulae(F)).t is negative implies t^<*0*> in dom
tree_of_subformulae(F) & (tree_of_subformulae(F)).(t^<*0*>) = the_argument_of (
  tree_of_subformulae(F)).t;

reserve x,y for set;

theorem 
  (tree_of_subformulae(F)).t is conjunctive implies t^<*0*> in dom
  tree_of_subformulae(F) & (tree_of_subformulae(F)).(t^<*0*>) =
  the_left_argument_of (tree_of_subformulae(F)).t & t^<*1*> in dom
  tree_of_subformulae(F) & (tree_of_subformulae(F)).(t^<*1*>) =
  the_right_argument_of (tree_of_subformulae(F)).t;

theorem 
  (tree_of_subformulae(F)).t is universal implies t^<*0*> in dom
  tree_of_subformulae(F) & (tree_of_subformulae(F)).(t^<*0*>) = the_scope_of (
  tree_of_subformulae(F)).t;

reserve t for Element of dom tree_of_subformulae(F),
  s for Element of dom tree_of_subformulae(G);

theorem 
  t in F-entry_points_in_subformula_tree_of G & s in G
  -entry_points_in_subformula_tree_of H implies t^s in F
  -entry_points_in_subformula_tree_of H;

reserve t for Element of dom tree_of_subformulae(F),
  s for FinSequence;

theorem 
  t in F-entry_points_in_subformula_tree_of G & t^s in F
  -entry_points_in_subformula_tree_of H implies s in G
  -entry_points_in_subformula_tree_of H;

theorem 
  for F,G,H holds { t^s where t is Element of dom
  tree_of_subformulae(F), s is Element of dom tree_of_subformulae(G) : t in F
  -entry_points_in_subformula_tree_of G & s in G
-entry_points_in_subformula_tree_of H } c= F-entry_points_in_subformula_tree_of
  H;

theorem 
  (tree_of_subformulae(F))|t = tree_of_subformulae(( tree_of_subformulae(F)).t)
;

theorem 
  t in F-entry_points_in_subformula_tree_of G iff (
  tree_of_subformulae(F))|t = tree_of_subformulae(G);

theorem 
  F-entry_points_in_subformula_tree_of G = { t where t is Element of dom
tree_of_subformulae(F) : (tree_of_subformulae(F))|t = tree_of_subformulae(G) };

reserve C for Chain of dom tree_of_subformulae(F);

theorem 
  for F,G,H,C st G in { (tree_of_subformulae(F)).t where t is Element of
dom tree_of_subformulae(F) : t in C } & H in { (tree_of_subformulae(F)).t where
t is Element of dom tree_of_subformulae(F) : t in C } holds G is_subformula_of
  H or H is_subformula_of G;

definition
  let A;
  let F be Element of QC-WFF(A);
  mode Subformula of F -> Element of QC-WFF(A) means


    it is_subformula_of F;
end;

definition
  let A;
  let F be Element of QC-WFF(A);
  let G be Subformula of F;
  mode Entry_Point_in_Subformula_Tree of G -> Element of dom
    tree_of_subformulae(F) means


    (tree_of_subformulae(F)).it = G;
end;

reserve G for Subformula of F;
reserve t, t9 for Entry_Point_in_Subformula_Tree of G;

theorem 
  t <> t9 implies not t,t9 are_c=-comparable;

definition
  let A;
  let F be Element of QC-WFF(A);
  let G be Subformula of F;
  func entry_points_in_subformula_tree(G) -> non empty AntiChain_of_Prefixes
  of dom tree_of_subformulae(F) equals

  F-entry_points_in_subformula_tree_of G;
end;

theorem 
  t in entry_points_in_subformula_tree(G);

theorem 
  entry_points_in_subformula_tree(G) = { t where t is
  Entry_Point_in_Subformula_Tree of G : t = t };

reserve G1, G2 for Subformula of F,
  t1 for Entry_Point_in_Subformula_Tree of G1,
  s for Element of dom tree_of_subformulae(G1);

theorem 
  s in G1-entry_points_in_subformula_tree_of G2 implies t1^s is
  Entry_Point_in_Subformula_Tree of G2;

reserve s for FinSequence;

theorem 
  t1^s is Entry_Point_in_Subformula_Tree of G2 implies s in G1
  -entry_points_in_subformula_tree_of G2;

theorem 
  for F,G1,G2 holds { t^s where t is
Entry_Point_in_Subformula_Tree of G1, s is Element of dom tree_of_subformulae(
  G1) : s in G1-entry_points_in_subformula_tree_of G2 } = { t^s where t is
Element of dom tree_of_subformulae(F), s is Element of dom tree_of_subformulae(
  G1) : t in F-entry_points_in_subformula_tree_of G1 & s in G1
  -entry_points_in_subformula_tree_of G2 };

theorem 
  for F,G1,G2 holds { t^s where t is Entry_Point_in_Subformula_Tree of
  G1, s is Element of dom tree_of_subformulae(G1) : s in G1
-entry_points_in_subformula_tree_of G2 } c= entry_points_in_subformula_tree(G2)
;

reserve G1, G2 for Subformula of F,
  t1 for Entry_Point_in_Subformula_Tree of G1,
  t2 for Entry_Point_in_Subformula_Tree of G2;

theorem 
  (ex t1,t2 st t1 is_a_prefix_of t2) implies G2 is_subformula_of G1;

theorem 
  G2 is_subformula_of G1 implies for t1 ex t2 st t1 is_a_prefix_of t2;














begin 

reserve A for QC-alphabet;
reserve a,b,b1,b2,c,d for set,
  i,j,k,n for Element of NAT,
  x,y,x1,x2 for bound_QC-variable of A,
  P for QC-pred_symbol of k,A,
  ll for CQC-variable_list of k,A,
  l1 ,l2 for FinSequence of QC-variables(A),
  p for QC-formula of A,
  s,t for QC-symbol of A;

definition
  let A;
  func vSUB(A) equals

  PFuncs(bound_QC-variables(A),bound_QC-variables(A));
end;

registration
  let A;
  cluster vSUB(A) -> non empty;
end;

definition
  let A;
  mode CQC_Substitution of A is Element of vSUB(A);
end;

registration
  let A;
  cluster vSUB(A) -> functional;
end;

reserve Sub for CQC_Substitution of A;

definition
  let A;
  let Sub;
  func @Sub -> PartFunc of bound_QC-variables(A),bound_QC-variables(A) equals

  Sub;
end;

theorem 
  a in dom Sub implies Sub.a in bound_QC-variables(A);

definition
  let A;
  let l be FinSequence of QC-variables(A);
  let Sub;
  func CQC_Subst(l,Sub) -> FinSequence of QC-variables(A) means


  len it =
len l & for k st 1 <= k & k <= len l holds (l.k in dom Sub implies it.k = Sub.(
  l.k)) & (not l.k in dom Sub implies it.k = l.k);
end;

definition
  let A;
  let l be FinSequence of bound_QC-variables(A);
  func @l -> FinSequence of QC-variables(A) equals

  l;
end;

definition
  let A;
  let l be FinSequence of bound_QC-variables(A);
  let Sub;
  func CQC_Subst(l,Sub) -> FinSequence of bound_QC-variables(A) equals

  CQC_Subst(
  @l,Sub);
end;

definition
  let A;
  let Sub;
  let X be set;
  redefine func Sub|X -> CQC_Substitution of A;
end;

registration
  let A;
  cluster finite for CQC_Substitution of A;
end;

definition
  let A;
  let x, p, Sub;
  func RestrictSub(x,p,Sub) -> finite CQC_Substitution of A equals

  Sub|{y : y in
  still_not-bound_in p & y is Element of dom Sub & y <> x & y <> Sub.y};
end;

definition
  let A;
  let l1;
  func Bound_Vars(l1) -> Subset of bound_QC-variables(A) equals

  { l1.k : 1 <= k &
  k <= len l1 & l1.k in bound_QC-variables(A)};
end;

definition
  let A;
  let p;
  func Bound_Vars(p) -> Subset of bound_QC-variables(A) means


  ex F being
  Function of QC-WFF(A), bool bound_QC-variables(A)
   st it = F.p & for p being Element
of QC-WFF(A) for d1,d2 being Subset of bound_QC-variables(A)
holds (p = VERUM(A) implies
  F.p = {}(bound_QC-variables(A))) & (p is atomic implies F.p = Bound_Vars(
the_arguments_of p)) & (p is negative & d1 = F.the_argument_of p implies F.p =
  d1) & (p is conjunctive & d1 = F.the_left_argument_of p & d2 = F.
  the_right_argument_of p implies F.p = d1 \/ d2) & (p is universal & d1 = F.
  the_scope_of p implies F.p = (d1 \/ {bound_in p}));
end;

theorem 
  Bound_Vars(VERUM(A)) = {};

theorem 
  for p being QC-formula of A st p is atomic holds Bound_Vars(p) = Bound_Vars
  (the_arguments_of p);

theorem 
  for p being QC-formula of A st p is negative holds Bound_Vars(p) =
  Bound_Vars(the_argument_of p);

theorem 
  for p being QC-formula of A st p is conjunctive holds Bound_Vars(p) = (
  Bound_Vars(the_left_argument_of p)) \/ ( Bound_Vars(the_right_argument_of p))
;

theorem 
  for p being QC-formula of A st p is universal holds Bound_Vars(p) =
  Bound_Vars(the_scope_of p) \/ {bound_in p};

registration
  let A;
  let p;
  cluster Bound_Vars(p) -> finite;
end;

definition
  let A;
  let p;
  func Dom_Bound_Vars(p) -> finite Subset of QC-symbols(A) equals

  {s : x.s in Bound_Vars
  (p)};
end;

reserve finSub for finite CQC_Substitution of A;

definition
  let A;
  let finSub;
  func Sub_Var(finSub) -> finite Subset of QC-symbols(A) equals

  {s : x.s in rng finSub};
end;

definition
  let A;
  let p, finSub;
  func NSub(p,finSub) -> non empty Subset of QC-symbols(A) equals

  NAT\(Dom_Bound_Vars(p)\/ Sub_Var(finSub));
end;

definition
  let A;
  let finSub, p;
  func upVar(finSub,p) -> QC-symbol of A equals

  the Element of NSub(p,finSub);
end;

definition
  let A;
  let x, p, finSub;
  assume
 ex Sub st finSub = RestrictSub(x,All(x,p),Sub);
  func ExpandSub(x,p,finSub) -> CQC_Substitution of A equals

  finSub \/ {[x,x.upVar(finSub,p)]}
    if x in rng finSub otherwise finSub \/ {[x,x]};
end;

definition
  let A;
  let p, Sub, b;
  pred p,Sub PQSub b means


  (p is universal implies b = ExpandSub(
  bound_in p,the_scope_of p, RestrictSub(bound_in p,p,Sub))) & (not p is
  universal implies b = {});
end;

definition
  let A;
  func QSub(A) -> Function means

  a in it iff ex p,Sub,b st a = [[p,Sub],b] & p, Sub PQSub b;
end;

begin 


reserve e for Element of vSUB(A);

theorem 
  [:QC-WFF(A),vSUB(A):] is Subset of [:[:NAT, QC-symbols(A):]*,vSUB(A):] &
(for k being Element of NAT, p being (QC-pred_symbol of k,A),
ll being QC-variable_list
  of k,A , e being Element of vSUB(A) holds [<*p*>^ll,e]
in [:QC-WFF(A),vSUB(A):]) & (for e
  being Element of vSUB(A) holds [<*[0, 0]*>,e] in
[:QC-WFF(A),vSUB(A):]) & (for p being
FinSequence of [:NAT,QC-symbols(A):], e being Element of vSUB(A)
st [p,e] in [:QC-WFF(A),vSUB(A):]
holds [<*[1, 0]*>^p,e] in [:QC-WFF(A),vSUB(A):]) &
(for p, q being FinSequence of [:
  NAT, QC-symbols(A):], e being Element of vSUB(A) st
[p,e] in [:QC-WFF(A),vSUB(A):] & [q,e] in [:
  QC-WFF(A),vSUB(A):] holds [<*[2, 0]*>^p^q,e]
in [:QC-WFF(A),vSUB(A):]) & (for x being
bound_QC-variable of A, p being FinSequence of [:NAT, QC-symbols(A):],
e being Element of vSUB(A)
st [p,(QSub(A)).[<*[3, 0]*>^<*x*>^p,e]] in [:QC-WFF(A),vSUB(A):]
holds [<*[3, 0]*>^<*x*>^p,e] in [:QC-WFF(A),vSUB(A):]);

definition
  let A;
  let IT be set;
  attr IT is A-Sub-closed means


  IT is Subset of [:[:NAT, QC-symbols(A):]*,vSUB(A):] &
  (for k being Element of NAT, p being (QC-pred_symbol of k,A), ll being
QC-variable_list of k,A, e being Element of vSUB(A) holds
[<*p*>^ll,e] in IT) & (for
e being Element of vSUB(A) holds [<*[0, 0]*>,e] in IT) &
(for p being FinSequence of [:NAT,QC-symbols(A):],
     e being Element of vSUB(A) st
[p,e] in IT holds [<*[1, 0]*>^p,e]
  in IT) & (for p, q being FinSequence of [:NAT, QC-symbols(A):],
  e being Element of vSUB(A)
  st [p,e] in IT & [q,e] in IT holds [<*[2, 0]*>^p^q,e] in IT) & (for x being
bound_QC-variable of A, p being FinSequence of [:NAT, QC-symbols(A):],
e being Element of vSUB(A) st [p,(QSub(A)).[<*[3, 0]*>^<*x*>^p,e]] in IT holds
[<*[3, 0]*>^<*x*>^p,e] in IT);
end;

registration
  let A;
  cluster A-Sub-closed non empty for set;
end;

definition
  let A;
  func QC-Sub-WFF(A) -> non empty set means


  it is A-Sub-closed & for D
  being non empty set st D is A-Sub-closed holds it c= D;
end;

reserve S,S9,S1,S2,S19,S29,T1,T2 for Element of QC-Sub-WFF(A);

theorem 
  ex p,e st S = [p,e];

registration
  let A;
  cluster QC-Sub-WFF(A) -> A-Sub-closed;
end;

definition
  let A;
  let P be QC-pred_symbol of A;
  let l be FinSequence of QC-variables(A);
  let e;
  assume
 the_arity_of P = len l;
  func Sub_P(P,l,e) -> Element of QC-Sub-WFF(A) equals


  [P!l,e];
end;

theorem 
  for k being Element of NAT, P being QC-pred_symbol of k,A, ll being
  QC-variable_list of k,A holds Sub_P(P,ll,e) = [P!ll,e];

definition
  let A;
  let S;
  attr S is A-Sub_VERUM means


  ex e st S = [VERUM(A),e];
end;

definition
  let A;
  let S;
  redefine func S`1 -> Element of QC-WFF(A);
  redefine func S`2 -> Element of vSUB(A);
end;

theorem 
  S = [S`1,S`2];

definition
  let A;
  let S;
  func Sub_not S -> Element of QC-Sub-WFF(A) equals

  ['not' S`1,S`2];
end;

definition
  let A;
  let S, S9;
  assume
 S`2 = (S9)`2;
  func Sub_&(S,S9) -> Element of QC-Sub-WFF(A) equals


  [(S`1) '&' ((S9)`1)
  ,S`2];
end;

reserve B for Element of [:QC-Sub-WFF(A),bound_QC-variables(A):];

definition
  let A;
  let B;
  redefine func B`1 -> Element of QC-Sub-WFF(A);
  redefine func B`2 -> Element of bound_QC-variables(A);
end;

definition
  let A;
  let B;
  attr B is quantifiable means


  ex e st (B`1)`2 = (QSub(A)).[All((B)`2,(B`1) `1),e];
end;

definition
  let A;
  let B;
  assume
 B is quantifiable;
  mode second_Q_comp of B -> Element of vSUB(A) means


    (B`1)`2 = (QSub(A)).[All (B`2,(B`1)`1),it];
end;

reserve SQ for second_Q_comp of B;

definition
  let A;
  let B, SQ;
  assume
 B is quantifiable;
  func Sub_All(B,SQ) -> Element of QC-Sub-WFF(A) equals


  [All(B`2,(B`1)`1)
  ,SQ];
end;

definition
  let A;
  let S, x;
  redefine func [S,x] -> Element of [:QC-Sub-WFF(A),bound_QC-variables(A):];
end;

scheme 

  SubQCInd { Al() -> QC-alphabet, Pro[Element of QC-Sub-WFF(Al())]}:
for S being Element of QC-Sub-WFF(Al())
  holds Pro[S]
provided
 for k being Element of NAT, P being (QC-pred_symbol of k,Al()), ll being
QC-variable_list of k,Al(), e being Element of vSUB(Al()) holds
Pro[Sub_P(P,ll,e)] and
 for S being Element of QC-Sub-WFF(Al()) st
S is Al()-Sub_VERUM holds Pro[S] and
 for S being Element of QC-Sub-WFF(Al()) st Pro[S] holds Pro[Sub_not S] and
 for S,S9 being Element of QC-Sub-WFF(Al())
st S`2 = (S9)`2 & Pro[S] & Pro[S9] holds Pro[Sub_&(S,S9)] and
 for x being bound_QC-variable of Al(),
S being Element of QC-Sub-WFF(Al()), SQ
being second_Q_comp of [S,x] st [S,x] is quantifiable & Pro[S] holds Pro[
Sub_All([S,x], SQ)];

definition
  let A;
  let S;
  attr S is Sub_atomic means


  ex k being Element of NAT, P being
QC-pred_symbol of k,A, ll being QC-variable_list of k,A,
e being Element of vSUB(A) st
  S = Sub_P(P,ll,e);
end;

theorem 
  S is Sub_atomic implies S`1 is atomic;

registration
  let A;
  let k be Element of NAT;
  let P be (QC-pred_symbol of k,A), ll be QC-variable_list of k,A;
  let e be Element of vSUB(A);
  cluster Sub_P(P,ll,e) -> Sub_atomic;
end;

definition
  let A;
  let S;
  attr S is Sub_negative means


  ex S9 st S = Sub_not S9;
  attr S is Sub_conjunctive means


  ex S1,S2 st S = Sub_&(S1,S2) & S1`2 = S2`2;
end;

definition
  let A;
  let S;
  attr S is Sub_universal means


  ex B,SQ st S = Sub_All(B,SQ) & B is quantifiable;
end;

theorem 
  for S holds S is A-Sub_VERUM or S is Sub_atomic or S is
  Sub_negative or S is Sub_conjunctive or S is Sub_universal;

definition
  let A;
  let S such that
 S is Sub_atomic;
  func Sub_the_arguments_of S -> FinSequence of QC-variables(A) means


  ex k being Element of NAT, P being (QC-pred_symbol of k,A), ll being
QC-variable_list of k,A, e being Element of vSUB(A)
st it = ll & S = Sub_P(P,ll,e);
end;

definition
  let A;
  let S such that
 S is Sub_negative;
  func Sub_the_argument_of S -> Element of QC-Sub-WFF(A) means


  S = Sub_not it;
end;

definition
  let A;
  let S such that
 S is Sub_conjunctive;
  func Sub_the_left_argument_of S -> Element of QC-Sub-WFF(A) means


  ex S9 st S = Sub_&(it,S9) & it`2 = (S9)`2;
end;

definition
  let A;
  let S such that
 S is Sub_conjunctive;
  func Sub_the_right_argument_of S -> Element of QC-Sub-WFF(A) means


  ex S9 st S = Sub_&(S9,it) & (S9)`2 = it`2;
end;

definition
  let A;
  let S such that
 S is Sub_universal;
  func Sub_the_bound_of S -> bound_QC-variable of A means

  ex B,SQ st S = Sub_All(B, SQ) & B`2 = it & B is quantifiable;
end;

definition
  let A;
  let A2 be Element of QC-Sub-WFF(A) such that
 A2 is Sub_universal;
  func Sub_the_scope_of A2 -> Element of QC-Sub-WFF(A) means


  ex B,SQ st A2 = Sub_All(B,SQ) & B`1 = it & B is quantifiable;
end;

registration
  let A;
  let S;
  cluster Sub_not S -> Sub_negative;
end;

theorem 
  S1`2 = S2`2 implies Sub_&(S1,S2) is Sub_conjunctive;

theorem 
  B is quantifiable implies Sub_All(B,SQ) is Sub_universal;

theorem 
  Sub_not(S) = Sub_not(S9) implies S = S9;

theorem 
  Sub_the_argument_of(Sub_not(S)) = S;

theorem 
  S1`2 = S2`2 & (S19)`2 = (S29)`2 & Sub_&(S1,S2) = Sub_&(S19,S29)
  implies S1 = S19 & S2 = S29;

theorem 
  S1`2 = S2`2 implies Sub_the_left_argument_of(Sub_&(S1,S2)) = S1;

theorem 
  S1`2 = S2`2 implies Sub_the_right_argument_of(Sub_&(S1,S2)) = S2;

theorem 
  for B1,B2 being Element of [:QC-Sub-WFF(A),bound_QC-variables(A):], SQ1
being second_Q_comp of B1, SQ2 being second_Q_comp of B2 st B1 is quantifiable
  & B2 is quantifiable & Sub_All(B1,SQ1) = Sub_All(B2,SQ2) holds B1 = B2;

theorem 
  B is quantifiable implies Sub_the_scope_of(Sub_All(B,SQ)) = B`1;

scheme 

  SubQCInd2 {Al() -> QC-alphabet, Pro[Element of QC-Sub-WFF(Al())]}:
for S being Element of QC-Sub-WFF(Al())
  holds Pro[S]
provided
 for S being Element of QC-Sub-WFF(Al()) holds (S is Sub_atomic implies Pro
[S]) & (S is Al()-Sub_VERUM implies Pro[S]) & (S is Sub_negative & Pro[
Sub_the_argument_of S] implies Pro[S]) & (S is Sub_conjunctive & Pro[
Sub_the_left_argument_of S] & Pro[Sub_the_right_argument_of S] implies Pro[S])
& (S is Sub_universal & Pro[Sub_the_scope_of S] implies Pro[S]);

theorem 
  S is Sub_negative implies len @((Sub_the_argument_of(S))`1) < len @(S`1);

theorem 
  S is Sub_conjunctive implies len @((Sub_the_left_argument_of(S))
  `1) < len @(S`1) & len @((Sub_the_right_argument_of(S))`1) < len @(S`1);

theorem 
  S is Sub_universal implies len@((Sub_the_scope_of(S))`1) < len @ (S`1);

theorem 
  (S is A-Sub_VERUM implies ((@S`1).1)`1 = 0) & (S is Sub_atomic
  implies ex k being Element of NAT st (@S`1).1 is QC-pred_symbol of k,A)
& (S is
Sub_negative implies ((@S`1).1)`1 = 1) & (S is Sub_conjunctive implies ((@S`1).
  1)`1 = 2) & (S is Sub_universal implies ((@S`1).1)`1 = 3);

theorem 
  S is Sub_atomic implies ((@S`1).1)`1 <> 0 & ((@S`1).1)`1 <> 1 &
  ((@S`1).1)`1 <> 2 & ((@S`1).1)`1 <> 3;

theorem 
  not (ex S st S is Sub_atomic Sub_negative or S is Sub_atomic
  Sub_conjunctive or S is Sub_atomic Sub_universal or S is Sub_negative
  Sub_conjunctive or S is Sub_negative Sub_universal or S is Sub_conjunctive
Sub_universal or S is A-Sub_VERUM Sub_atomic or S is A-Sub_VERUM
Sub_negative or S
  is A-Sub_VERUM Sub_conjunctive or S is A-Sub_VERUM Sub_universal );

scheme 

  SubFuncEx { Al() -> QC-alphabet, D()-> non empty set,
  V() -> (Element of D()), A(Element of QC-Sub-WFF(Al())) -> (Element of D()),
  N(Element of D()) -> (Element of D()),
  C((Element of D()),(Element of D())) -> (Element of D()),
  R(set,Element of QC-Sub-WFF(Al()), Element of D()) -> Element of D()} :
ex F being Function of QC-Sub-WFF(Al()), D()
st for S being Element of QC-Sub-WFF(Al())
for d1,d2 being Element of D() holds (S is Al()-Sub_VERUM implies F.S = V()) &
(S is Sub_atomic implies F.S = A(S)) & (S is Sub_negative &
d1 = F.Sub_the_argument_of S implies F.S = N(d1)) & (S is Sub_conjunctive &
d1 = F.Sub_the_left_argument_of S & d2 = F.Sub_the_right_argument_of S
implies F.S = C(d1, d2)) & (S is Sub_universal & d1 = F.Sub_the_scope_of S
implies F.S = R(Al(),S,d1));

scheme 

  SubQCFuncUniq { Al() -> QC-alphabet, D() -> non empty set,
      F1() -> (Function of QC-Sub-WFF(Al()), D()),
      F2() -> (Function of QC-Sub-WFF(Al()), D()), V() -> (Element of D()),
      A(set) -> (Element of D()), N(set) -> (Element of D()),
      C(set,set) -> (Element of D()), R(set,set,set) -> Element of D()}
:
F1() = F2()
provided
 for S being Element of QC-Sub-WFF(Al()) for d1,d2 being Element of D()
holds (S is Al()-Sub_VERUM implies F1().S = V()) &
(S is Sub_atomic implies F1().S =
A(S)) & (S is Sub_negative & d1 = F1().Sub_the_argument_of S implies F1().S = N
(d1)) & (S is Sub_conjunctive & d1 = F1().Sub_the_left_argument_of S & d2 = F1(
).Sub_the_right_argument_of S implies F1().S = C(d1, d2)) & (S is Sub_universal
& d1 = F1().Sub_the_scope_of S implies F1().S = R(Al(),S, d1)) and
 for S being Element of QC-Sub-WFF(Al()) for d1,d2 being Element of D()
holds (S is Al()-Sub_VERUM implies F2().S = V()) &
(S is Sub_atomic implies F2().S =
A(S)) & (S is Sub_negative & d1 = F2().Sub_the_argument_of S implies F2().S = N
(d1)) & (S is Sub_conjunctive & d1 = F2().Sub_the_left_argument_of S & d2 = F2(
).Sub_the_right_argument_of S implies F2().S = C(d1, d2)) & (S is Sub_universal
& d1 = F2().Sub_the_scope_of S implies F2().S = R(Al(),S, d1));

definition
  let A;
  let S;
  func @S -> Element of [:QC-WFF(A),vSUB(A):] equals

  S;
end;

reserve Z for Element of [:QC-WFF(A),vSUB(A):];

definition
  let A;
  let Z;
  redefine func Z`1 -> Element of QC-WFF(A);
  redefine func Z`2 -> CQC_Substitution of A;
end;

definition
  let A;
  let Z;
  func S_Bound(Z) -> bound_QC-variable of A equals

  x.upVar(RestrictSub(bound_in Z`1
,Z`1,Z`2),(the_scope_of Z`1)) if bound_in(Z`1) in rng(RestrictSub(bound_in Z`1,
  Z`1,Z`2)) otherwise bound_in(Z`1);
end;

definition
  let A;
  let S, p;
  func Quant(S,p) -> Element of QC-WFF(A) equals

  All(S_Bound(@S),p);
end;

begin 


definition
  let A;
  let S be Element of QC-Sub-WFF(A);
  func CQC_Sub(S) -> Element of QC-WFF(A) means


  ex F being Function of
QC-Sub-WFF(A),QC-WFF(A) st it = F.S & for S9 being Element of
QC-Sub-WFF(A) holds (S9 is
  A-Sub_VERUM implies F.S9 = VERUM(A)) & ( S9 is Sub_atomic implies F.S9 = (
the_pred_symbol_of ((S9)`1))! CQC_Subst(Sub_the_arguments_of S9,(S9)`2)) & (S9
  is Sub_negative implies F.S9 = 'not' (F.(Sub_the_argument_of S9))) & (S9 is
  Sub_conjunctive implies F.S9 = (F.Sub_the_left_argument_of S9) '&' (F.
Sub_the_right_argument_of S9)) & (S9 is Sub_universal implies F.S9 = Quant(S9,F
  .Sub_the_scope_of S9));
end;

theorem 
  S is Sub_negative implies CQC_Sub(S) = 'not' CQC_Sub( Sub_the_argument_of S);

theorem 
  CQC_Sub(Sub_not S) = 'not' CQC_Sub(S);

theorem 
  S is Sub_conjunctive implies CQC_Sub(S) = (CQC_Sub(
  Sub_the_left_argument_of S)) '&' (CQC_Sub(Sub_the_right_argument_of S));

theorem 
  S1`2 = S2`2 implies CQC_Sub(Sub_&(S1,S2)) = (CQC_Sub(S1)) '&' ( CQC_Sub(S2));

theorem 
  S is Sub_universal implies CQC_Sub(S) = Quant(S,CQC_Sub( Sub_the_scope_of S))
;

definition
  let A;
  func CQC-Sub-WFF(A) -> Subset of QC-Sub-WFF(A) equals

  {S : S`1 is Element of
  CQC-WFF(A)};
end;

registration
  let A;
  cluster CQC-Sub-WFF(A) -> non empty;
end;

theorem 
  S is A-Sub_VERUM implies CQC_Sub(S) is Element of CQC-WFF(A);

theorem 
  for h being FinSequence holds h is CQC-variable_list of k,A iff h
  is FinSequence of bound_QC-variables(A) & len h = k;

theorem 
  CQC_Sub(Sub_P(P,ll,e)) is Element of CQC-WFF(A);

theorem 
  CQC_Sub(S) is Element of CQC-WFF(A) implies CQC_Sub(Sub_not S) is
  Element of CQC-WFF(A);

theorem 
  S1`2 = S2`2 & CQC_Sub(S1) is Element of CQC-WFF(A) & CQC_Sub(S2) is
  Element of CQC-WFF(A) implies CQC_Sub(Sub_&(S1,S2)) is Element of CQC-WFF(A);

reserve xSQ for second_Q_comp of [S,x];

theorem 
  CQC_Sub(S) is Element of CQC-WFF(A) & [S,x] is quantifiable implies
  CQC_Sub(Sub_All([S,x],xSQ)) is Element of CQC-WFF(A);

reserve S for Element of CQC-Sub-WFF(A);

scheme 

  SubCQCInd { Al() -> QC-alphabet, Pro[set] } :
for S being Element of CQC-Sub-WFF(Al()) holds Pro[S]
provided
 for S,S9 being Element of CQC-Sub-WFF(Al()),
x being bound_QC-variable of Al(),
SQ being second_Q_comp of [S,x],
k being Element of NAT,
ll being CQC-variable_list of k,Al(),
P being (QC-pred_symbol of k,Al()),
e being Element of vSUB(Al()) holds
Pro[Sub_P(P,ll,e)] &
(S is Al()-Sub_VERUM implies Pro[S]) &
(Pro[S] implies Pro[Sub_not S]) &
(S`2 = (S9)`2 & Pro[S] & Pro[S9] implies Pro[Sub_&(S,S9)]) &
([S,x] is quantifiable
& Pro[S] implies Pro[Sub_All([S,x], SQ)]);

definition
  let A;
  let S;
  redefine func CQC_Sub(S) -> Element of CQC-WFF(A);
end;

theorem 
  rng @Sub c= bound_QC-variables(A);














begin 

reserve Al for QC-alphabet;
reserve a,b,c,d for set,
  i,k,n for Element of NAT,
  p,q for Element of CQC-WFF(Al),
  x,y,y1 for bound_QC-variable of Al,
  A for non empty set,
  J for interpretation of Al,A,
  v,w for Element of Valuations_in(Al,A),
  f,g for Function,
  P,P9 for QC-pred_symbol of k,Al,
  ll,ll9 for CQC-variable_list of k,Al,
  l1 for FinSequence of QC-variables(Al),
  Sub,Sub9,Sub1 for CQC_Substitution of Al,
  S,S9,S1,S2 for Element of CQC-Sub-WFF(Al),
  s for QC-symbol of Al;

theorem 
  for f,g,h,h1,h2 being Function st dom h1 c= dom h & dom h2 c= dom
  h holds f+*g+*h = (f+*h1)+*(g+*h2)+*h;

theorem 
  for vS1 being Function st x in dom vS1 holds (vS1|((dom vS1) \ {x
  })) +* (x .--> vS1.x) = vS1;

definition
  let Al,A;
  mode Val_Sub of A,Al is PartFunc of bound_QC-variables(Al),A;
end;

reserve vS,vS1,vS2 for Val_Sub of A,Al;

notation
  let Al, A, v, vS;
  synonym v.vS for v +* vS;
end;

definition
  let Al, A, v, vS;
  redefine func v.vS -> Element of Valuations_in(Al,A);
end;

definition
  let Al,S;
  redefine func S`1 -> Element of CQC-WFF(Al);
end;

definition
  let Al, S, A, v;
  func Val_S(v,S) -> Val_Sub of A,Al equals

  (@S`2)*v;
end;

theorem 
  S is Al-Sub_VERUM implies CQC_Sub(S) = VERUM(Al);

definition
  let Al, S, A, v, J;
  pred J,v |= S means


  J,v |= S`1;
end;

theorem 
  S is Al-Sub_VERUM implies for v holds (J,v |= CQC_Sub(S) iff J,v.
  Val_S(v,S) |= S);

theorem 
  i in dom ll implies ll.i is bound_QC-variable of Al;

theorem 
  S is Sub_atomic implies CQC_Sub(S) = (the_pred_symbol_of S`1)!
  CQC_Subst(Sub_the_arguments_of S,S`2);

theorem 
  Sub_the_arguments_of Sub_P(P,ll,Sub) = Sub_the_arguments_of Sub_P(P9,
  ll9,Sub9) implies ll = ll9;

definition
  let k, Al, P, ll, Sub;
  redefine func Sub_P(P,ll,Sub) -> Element of CQC-Sub-WFF(Al);
end;

theorem 
  CQC_Sub(Sub_P(P,ll,Sub)) = P!CQC_Subst(ll,Sub);

theorem 
  P!CQC_Subst(ll,Sub) is Element of CQC-WFF(Al);

theorem 
  CQC_Subst(ll,Sub) is CQC-variable_list of k,Al;

registration
  let Al;
  let k, ll, Sub;
  cluster CQC_Subst(ll,Sub) -> bound_QC-variables(Al) -valued k-element;
end;

theorem 
  not x in dom S`2 implies (v.Val_S(v,S)).x = v.x;

theorem 
  x in dom S`2 implies (v.Val_S(v,S)).x = Val_S(v,S).x;

theorem 
  (v.Val_S(v,Sub_P(P,ll,Sub)))*'ll = v*'(CQC_Subst(ll,Sub));

theorem 
  Sub_P(P,ll,Sub)`1 = P!ll;

theorem 
  for v holds (J,v |= CQC_Sub(Sub_P(P,ll,Sub)) iff J,v.Val_S(v,
  Sub_P(P,ll,Sub)) |= Sub_P(P,ll,Sub));

theorem 
  (Sub_not S)`1 = 'not' S`1 & (Sub_not S)`2 = S`2;

definition
  let Al,S;
  redefine func Sub_not S -> Element of CQC-Sub-WFF(Al);
end;

theorem 
  not J,v.Val_S(v,S) |= S iff J,v.Val_S(v,S) |= Sub_not S;

theorem 
  Val_S(v,S) = Val_S(v,Sub_not S);

theorem 
  (for v holds (J,v |= CQC_Sub(S) iff J,v.Val_S(v,S) |= S))
  implies for v holds (J,v |= CQC_Sub(Sub_not S) iff J,v.Val_S(v,Sub_not S) |=
  Sub_not S);

definition
  let Al, S1, S2;
  assume
 S1`2 = S2`2;
  func CQCSub_&(S1,S2) -> Element of CQC-Sub-WFF(Al) equals


  Sub_&(S1,S2);
end;

theorem 
  S1`2 = S2`2 implies CQCSub_&(S1,S2)`1 = (S1`1) '&' (S2`1) &
  CQCSub_&(S1,S2)`2 = S1`2;

theorem 
  S1`2 = S2`2 implies CQCSub_&(S1,S2)`2 = S1`2;

theorem 
  S1`2 = S2`2 implies Val_S(v,S1) = Val_S(v,CQCSub_&(S1,S2)) & Val_S(v,
  S2) = Val_S(v,CQCSub_&(S1,S2));

theorem 
  S1`2 = S2`2 implies CQC_Sub(CQCSub_&(S1,S2)) = (CQC_Sub(S1)) '&'
  (CQC_Sub(S2));

theorem 
  S1`2 = S2`2 implies (J,v.Val_S(v,S1) |= S1 & J,v.Val_S(v,S2) |=
  S2 iff J,v.Val_S(v,CQCSub_&(S1,S2)) |= CQCSub_&(S1,S2));

theorem 
  S1`2 = S2`2 & (for v holds (J,v |= CQC_Sub(S1) iff J,v.Val_S(v,
  S1) |= S1)) & (for v holds (J,v |= CQC_Sub(S2) iff J,v.Val_S(v,S2) |= S2))
implies for v holds (J,v |= CQC_Sub(CQCSub_&(S1,S2)) iff J,v.Val_S(v,CQCSub_&(
  S1,S2)) |= CQCSub_&(S1,S2));

reserve B for Element of [:QC-Sub-WFF(Al),bound_QC-variables(Al):],
  SQ for second_Q_comp of B;

theorem 
  B is quantifiable implies Sub_All(B,SQ)`1 = All(B`2,(B`1)`1) &
  Sub_All(B,SQ)`2 = SQ;

definition
  let Al;
  let B be Element of [:QC-Sub-WFF(Al),bound_QC-variables(Al):];
  attr B is CQC-WFF-like means


  B`1 in CQC-Sub-WFF(Al);
end;

registration
  let Al;
  cluster CQC-WFF-like for Element of [:QC-Sub-WFF(Al),
   bound_QC-variables(Al):];
end;

definition
  let Al, S, x;
  redefine func [S,x] -> CQC-WFF-like Element of [:QC-Sub-WFF(Al),
  bound_QC-variables(Al):];
end;

reserve B for CQC-WFF-like Element of [:QC-Sub-WFF(Al),
  bound_QC-variables(Al):],
  xSQ for second_Q_comp of [S,x],
  SQ for second_Q_comp of B;

definition
  let Al, B;
  redefine func B`1 -> Element of CQC-Sub-WFF(Al);
end;

definition
  let Al, B, SQ;
  assume
 B is quantifiable;
  func CQCSub_All(B,SQ) -> Element of CQC-Sub-WFF(Al) equals


  Sub_All(B,SQ);
end;

theorem 
  B is quantifiable implies CQCSub_All(B,SQ) is Sub_universal;

definition
  let Al;
  let S such that
 S is Sub_universal;
  func CQCSub_the_scope_of S -> Element of CQC-Sub-WFF(Al) equals


  Sub_the_scope_of S;
end;

definition
  let Al, S1, p;
  assume that
 S1 is Sub_universal and
 p = CQC_Sub(CQCSub_the_scope_of S1);
  func CQCQuant(S1,p) -> Element of CQC-WFF(Al) equals


  Quant(S1,p);
end;

theorem 
  S is Sub_universal implies CQC_Sub(S) = CQCQuant(S,CQC_Sub(
  CQCSub_the_scope_of S));

theorem 
  B is quantifiable implies CQCSub_the_scope_of(CQCSub_All(B,SQ)) = B`1;

begin 

theorem 
  [S,x] is quantifiable implies CQCSub_the_scope_of(CQCSub_All([S,
  x],xSQ)) = S & CQCQuant(CQCSub_All([S,x],xSQ),CQC_Sub(CQCSub_the_scope_of
  CQCSub_All([S,x],xSQ))) = CQCQuant(CQCSub_All([S,x],xSQ),CQC_Sub(S));

theorem 
  [S,x] is quantifiable implies CQCQuant(CQCSub_All([S,x],xSQ),
  CQC_Sub(S)) = All(S_Bound(@CQCSub_All([S,x],xSQ)),CQC_Sub(S));

theorem 
  x in dom S`2 implies v.((@S`2).x) = v.Val_S(v,S).x;

theorem 
  x in dom (@S`2) implies (@S`2).x is bound_QC-variable of Al;

theorem 
  [:QC-WFF(Al),vSUB(Al):] c= dom QSub(Al);

reserve B1 for Element of [:QC-Sub-WFF(Al),bound_QC-variables(Al):];
reserve SQ1 for second_Q_comp of B1;

theorem 
  B is quantifiable & B1 is quantifiable & Sub_All(B,SQ) = Sub_All
  (B1,SQ1) implies B`2 = B1`2 & SQ = SQ1;

theorem 
  B is quantifiable & B1 is quantifiable & CQCSub_All(B,SQ) =
  Sub_All(B1,SQ1) implies B`2 = B1`2 & SQ = SQ1;

theorem 
  [S,x] is quantifiable implies Sub_the_bound_of CQCSub_All([S,x],xSQ) = x;

theorem 
  [S,x] is quantifiable & x in rng RestrictSub(x,All(x,S`1),xSQ)
implies not S_Bound(@CQCSub_All([S,x],xSQ)) in rng RestrictSub(x,All(x,S`1),xSQ
  ) & not S_Bound(@CQCSub_All([S,x],xSQ)) in Bound_Vars(S`1);

theorem 
  [S,x] is quantifiable & not x in rng RestrictSub(x,All(x,S`1),
xSQ) implies not S_Bound(@CQCSub_All([S,x],xSQ)) in rng RestrictSub(x,All(x,S`1
  ),xSQ);

theorem 
  [S,x] is quantifiable implies not S_Bound(@CQCSub_All([S,x],xSQ)
  ) in rng RestrictSub(x,All(x,S`1),xSQ);

theorem 
  [S,x] is quantifiable implies S`2 = ExpandSub(x,S`1,RestrictSub(
  x,All(x,S`1),xSQ));

theorem 
  still_not-bound_in VERUM(Al) c= Bound_Vars(VERUM(Al));

theorem 
  still_not-bound_in (P!ll) = Bound_Vars(P!ll);

theorem 
  still_not-bound_in (p) c= Bound_Vars(p) implies
  still_not-bound_in ('not' p) c= Bound_Vars('not' p);

theorem 
  still_not-bound_in p c= Bound_Vars(p) & still_not-bound_in q c=
  Bound_Vars(q) implies still_not-bound_in (p '&' q) c= Bound_Vars(p '&' q);

theorem 
  still_not-bound_in p c= Bound_Vars(p) implies still_not-bound_in
  All(x,p) c= Bound_Vars(All(x,p));

theorem 
  for p holds still_not-bound_in p c= Bound_Vars(p);

notation
  let Al, A, x;
  let a be Element of A;
  synonym x|a for x .--> a;
end;

definition
  let Al, A, x;
  let a be Element of A;
  redefine func x|a -> Val_Sub of A,Al;
end;

reserve a for Element of A;

theorem 
  x <> b implies v.(x|a).b = v.b;

theorem 
  x = y implies v.(x|a).y = a;

theorem 
  J,v |= All(x,p) iff for a holds J,v.(x|a) |= p;

definition
  let Al, S, x, xSQ, A, v;
  func NEx_Val(v,S,x,xSQ) -> Val_Sub of A,Al equals

  (@RestrictSub(x,All(x,S`1),
  xSQ))*v;
end;

definition
  let Al, A;
  let v,w be Val_Sub of A,Al;
  redefine func v+*w -> Val_Sub of A,Al;
end;

theorem 
  [S,x] is quantifiable & x in rng RestrictSub(x,All(x,S`1),xSQ)
implies S_Bound(@CQCSub_All([S,x],xSQ)) = x.upVar(RestrictSub(x,All(x,S`1),xSQ)
  ,S`1);

theorem 
  [S,x] is quantifiable & not x in rng RestrictSub(x,All(x,S`1),
  xSQ) implies S_Bound(@CQCSub_All([S,x],xSQ)) = x;

theorem 
  [S,x] is quantifiable implies for a holds Val_S(v.((S_Bound(@
CQCSub_All([S,x],xSQ)))|a),S) = NEx_Val(v.((S_Bound(@CQCSub_All([S,x],xSQ)))|a)
  ,S,x,xSQ)+*(x|a) & dom RestrictSub(x,All(x,S`1),xSQ) misses {x};

theorem 
  [S,x] is quantifiable implies ((for a holds J,(v.((S_Bound(@
  CQCSub_All([S,x],xSQ)))|a)). Val_S(v.((S_Bound(@CQCSub_All([S,x],xSQ)))|a),S)
|= S) iff for a holds J,(v.((S_Bound(@CQCSub_All([S,x],xSQ)))|a)). (NEx_Val(v.(
  (S_Bound(@CQCSub_All([S,x],xSQ)))|a),S,x,xSQ)+*(x|a)) |= S);

theorem 
  [S,x] is quantifiable implies for a holds NEx_Val(v.((S_Bound(@
  CQCSub_All([S,x],xSQ)))|a),S,x,xSQ) = NEx_Val(v,S,x,xSQ);

theorem 
  [S,x] is quantifiable implies ((for a holds J,(v.((S_Bound(@
CQCSub_All([S,x],xSQ)))|a)). (NEx_Val(v.((S_Bound(@CQCSub_All([S,x],xSQ)))|a),S
,x,xSQ)+*(x|a)) |= S) iff for a holds J,(v.((S_Bound(@CQCSub_All([S,x],xSQ)))|a
  )). (NEx_Val(v,S,x,xSQ)+*(x|a)) |= S );

begin 

theorem 
  rng l1 c= bound_QC-variables(Al) implies still_not-bound_in l1 = rng l1;

theorem 
  dom v = bound_QC-variables(Al) & dom (x|a) = {x};

theorem 
  v*'ll = ll*(v|still_not-bound_in ll);

theorem 
  for v,w holds (v|still_not-bound_in (P!ll) = w|
  still_not-bound_in (P!ll) implies (J,v |= P!ll iff J,w |= P!ll));

theorem 
  (for v,w holds v|still_not-bound_in p = w|still_not-bound_in p
  implies (J,v |= p iff J,w |= p)) implies for v,w holds v|still_not-bound_in
'not' p = w|still_not-bound_in 'not' p implies (J,v |= 'not' p iff J,w |= 'not'
  p);

theorem 
  (for v,w holds v|still_not-bound_in p = w|still_not-bound_in p
  implies (J,v |= p iff J,w |= p)) & (for v,w holds v|still_not-bound_in q = w|
still_not-bound_in q implies (J,v |= q iff J,w |= q)) implies for v,w holds v|
still_not-bound_in p '&' q = w|still_not-bound_in p '&' q implies (J,v |= p '&'
  q iff J,w |= p '&' q);

theorem 
  for X being set st X c= bound_QC-variables(Al) holds dom (v|X) = dom
  (v.(x|a)|X) & dom (v|X) = X;

theorem 
  v|still_not-bound_in p = w|still_not-bound_in p implies v.(x|a)|
  still_not-bound_in p = w.(x|a)|still_not-bound_in p;

theorem 
  still_not-bound_in p c= still_not-bound_in (All(x,p)) \/ {x};

theorem 
  v|(still_not-bound_in p \ {x}) = w|(still_not-bound_in p \ {x})
  implies v.(x|a)|still_not-bound_in p = w.(x|a)|still_not-bound_in p;

theorem 
  (for v,w holds v|still_not-bound_in p = w|still_not-bound_in p
implies (J,v |= p iff J,w |= p)) implies for v,w holds v|still_not-bound_in All
(x,p) = w|still_not-bound_in All(x,p) implies (J,v |= All(x,p) iff J,w |= All(x
  ,p));



theorem 
  for p holds for v,w holds v|still_not-bound_in p = w|
  still_not-bound_in p implies (J,v |= p iff J,w |= p);

theorem 
  [S,x] is quantifiable implies (v.((S_Bound(@CQCSub_All([S,x],xSQ
)))|a)). (NEx_Val(v,S,x,xSQ)+*(x|a))|still_not-bound_in S`1 = (v.(NEx_Val(v,S,x
  ,xSQ)+*(x|a)))|still_not-bound_in S`1;

theorem 
  [S,x] is quantifiable implies ((for a holds J,(v.((S_Bound(@
CQCSub_All([S,x],xSQ)))|a)).(NEx_Val(v,S,x,xSQ)+*(x|a)) |= S) iff for a holds J
  ,v.(NEx_Val(v,S,x,xSQ)+*(x|a)) |= S );

theorem 
  dom NEx_Val(v,S,x,xSQ) = dom RestrictSub(x,All(x,S`1),xSQ);

theorem 
  (for a holds J,v.(NEx_Val(v,S,x,xSQ)+*(x|a)) |= S) iff for a
  holds J,(v.NEx_Val(v,S,x,xSQ)).(x|a) |= S;

theorem 
  (for a holds J,(v.NEx_Val(v,S,x,xSQ)).(x|a) |= S) iff for a
  holds J,(v.NEx_Val(v,S,x,xSQ)).(x|a) |= S`1;

theorem 
  for v,vS,vS1,vS2 st (for y st y in dom vS1 holds not y in
  still_not-bound_in ll) & (for y st y in dom vS2 holds vS2.y = v.y) & dom vS
  misses dom vS2 holds (v.vS)*'ll = (v.(vS+*vS1+*vS2))*'ll;

theorem 
  for v,vS,vS1,vS2 st (for y st y in dom vS1 holds not y in
still_not-bound_in (P!ll)) & (for y st y in dom vS2 holds vS2.y = v.y) & dom vS
  misses dom vS2 holds J,v.vS |= P!ll iff J,v.(vS+*vS1+*vS2) |= P!ll;

theorem 
  (for v,vS,vS1,vS2 st (for y st y in dom vS1 holds not y in
  still_not-bound_in p) & (for y st y in dom vS2 holds vS2.y = v.y) & dom vS
misses dom vS2 holds J,v.vS |= p iff J,v.(vS+*vS1+*vS2) |= p) implies for v,vS,
vS1,vS2 st (for y st y in dom vS1 holds not y in still_not-bound_in 'not' p) &
(for y st y in dom vS2 holds vS2.y = v.y) & dom vS misses dom vS2 holds J,v.vS
  |= 'not' p iff J,v.(vS+*vS1+*vS2) |= 'not' p;

theorem 
  (for v,vS,vS1,vS2 st (for y st y in dom vS1 holds not y in
  still_not-bound_in p) & (for y st y in dom vS2 holds vS2.y = v.y) & dom vS
misses dom vS2 holds J,v.vS |= p iff J,v.(vS+*vS1+*vS2) |= p) & (for v,vS,vS1,
vS2 st (for y st y in dom vS1 holds not y in still_not-bound_in q) & (for y st
y in dom vS2 holds vS2.y = v.y) & dom vS misses dom vS2 holds J,v.vS |= q iff J
  ,v.(vS+*vS1+*vS2) |= q) implies for v,vS,vS1,vS2 st (for y st y in dom vS1
holds not y in still_not-bound_in p '&' q) & (for y st y in dom vS2 holds vS2.y
  = v.y) & dom vS misses dom vS2 holds J,v.vS |= p '&' q iff J,v.(vS+*vS1+*vS2)
  |= p '&' q;

theorem 
  (for y st y in dom vS1 holds not y in still_not-bound_in All(x,p
  )) implies for y st y in (dom vS1) \ {x} holds not y in still_not-bound_in p;

theorem 
  for vS1 being Function holds (for y st y in dom vS1 holds vS1.y
= v.y) & dom vS misses dom vS1 implies for y st y in (dom vS1) \ {x} holds vS1|
  ((dom vS1) \ {x}).y = (v.vS).y;

theorem 
  (for v,vS,vS1,vS2 st (for y st y in dom vS1 holds not y in
  still_not-bound_in p) & (for y st y in dom vS2 holds vS2.y = v.y) & dom vS
misses dom vS2 holds J,v.vS |= p iff J,v.(vS+*vS1+*vS2) |= p) implies for v,vS,
vS1,vS2 st (for y st y in dom vS1 holds not y in still_not-bound_in All(x,p)) &
(for y st y in dom vS2 holds vS2.y = v.y) & dom vS misses dom vS2 holds J,v.vS
  |= All(x,p) iff J,v.(vS+*vS1+*vS2) |= All(x,p);

theorem 
  for p holds for v,vS,vS1,vS2 st (for y st y in dom vS1 holds not
y in still_not-bound_in p) & (for y st y in dom vS2 holds vS2.y = v.y) & dom vS
  misses dom vS2 holds J,v.vS |= p iff J,v.(vS+*vS1+*vS2) |= p;

definition
  let Al, p;
  func RSub1(p) -> set means


  b in it iff ex x st x = b & not x in still_not-bound_in p;
end;

definition
  let Al, p, Sub;
  func RSub2(p,Sub) -> set means


  b in it iff ex x st x = b & x in still_not-bound_in p & x = (@Sub).x;
end;

theorem 
  dom ((@Sub)|RSub1(p)) misses dom ((@Sub)|RSub2(p,Sub));

theorem 
  @RestrictSub(x,All(x,p),Sub) = @Sub \ ((@Sub)|RSub1(All(x,p)) +*
  (@Sub)|RSub2(All(x,p),Sub));

theorem 
  dom @RestrictSub(x,p,Sub) misses dom ((@Sub)|RSub1(p)) \/ dom ((
  @Sub)|RSub2(p,Sub));

theorem 
  [S,x] is quantifiable implies @(CQCSub_All([S,x],xSQ))`2 = @
RestrictSub(x,All(x,S`1),xSQ) +* (@xSQ)|RSub1(All(x,S`1)) +* (@xSQ)|RSub2(All(x
  ,S`1),xSQ);

theorem 
  [S,x] is quantifiable implies ex vS1,vS2 st (for y st y in dom
  vS1 holds not y in still_not-bound_in All(x,S`1)) & (for y st y in dom vS2
  holds vS2.y = v.y) & dom NEx_Val(v,S,x,xSQ) misses dom vS2 & v.Val_S(v,
  CQCSub_All([S,x],xSQ)) = v.(NEx_Val(v,S,x,xSQ) +* vS1 +* vS2);

theorem 
  [S,x] is quantifiable implies for v holds (J,v.NEx_Val(v,S,x,xSQ
) |= All(x,S`1) iff J,v.Val_S(v,CQCSub_All([S,x],xSQ)) |= CQCSub_All([S,x],xSQ)
  );

theorem 
  [S,x] is quantifiable & (for v holds (J,v |= CQC_Sub(S) iff J,v.
  Val_S(v,S) |= S)) implies for v holds (J,v |= CQC_Sub(CQCSub_All([S,x],xSQ))
  iff J,v.Val_S(v,CQCSub_All([S,x],xSQ)) |= CQCSub_All([S,x],xSQ));

scheme 

  SubCQCInd1 { Al() -> QC-alphabet, Pro[set] } :
  for S being Element of CQC-Sub-WFF(Al())  holds Pro[S]
provided
 for S,S9 being Element of CQC-Sub-WFF(Al()),
x being bound_QC-variable of Al(),
SQ being second_Q_comp of [S,x],
k being Element of NAT,
ll being CQC-variable_list of k, Al(),
P being (QC-pred_symbol of k,Al()),
e being Element of vSUB(Al())
holds Pro[Sub_P(P,ll,e)] & (S is Al()-Sub_VERUM implies Pro[S]) &
(Pro[S] implies Pro[Sub_not S]) &
(S`2 = (S9)`2 & Pro[S] & Pro[S9] implies Pro[CQCSub_&(S,S9)]) &
([S,x] is quantifiable & Pro[S] implies Pro[CQCSub_All([S,x], SQ)]);



theorem 
  for S, v holds (J,v |= CQC_Sub(S) iff J,v.Val_S(v,S) |= S);















begin 

reserve Al for QC-alphabet;
reserve a,b,b1 for set,
  i,j,k,n for Element of NAT,
  p,q,r,s for Element of CQC-WFF(Al),
  x,y,y1 for bound_QC-variable of Al,
  P for QC-pred_symbol of k,Al,
  l,ll for CQC-variable_list of k,Al,
  Sub,Sub1 for CQC_Substitution of Al,
  S,S1,S2 for Element of CQC-Sub-WFF(Al),
  P1,P2 for Element of QC-pred_symbols(Al);

theorem 
  for Sub holds ex S st S`1 = VERUM(Al) & S`2 = Sub;

theorem 
  for Sub holds ex S st S`1 = P!ll & S`2 = Sub;

theorem 
  for k,l being Element of NAT st P is (QC-pred_symbol of k,Al) & P is (
  QC-pred_symbol of l,Al) holds k = l;

theorem 
  (for Sub holds ex S st S`1 = p & S`2 = Sub) implies for Sub holds
  ex S st S`1 = 'not' p & S`2 = Sub;

theorem 
  (for Sub holds ex S st S`1 = p & S`2 = Sub) & (for Sub holds ex S
st S`1 = q & S`2 = Sub) implies for Sub holds ex S st S`1 = p '&' q & S`2 = Sub
;

definition
  let Al, p, Sub;
  redefine func [p,Sub] -> Element of [:QC-WFF(Al),vSUB(Al):];
end;

theorem 
  dom RestrictSub(x,All(x,p),Sub) misses {x};

theorem 
  x in rng RestrictSub(x,All(x,p),Sub) implies S_Bound([All(x,p),
  Sub]) = x.upVar(RestrictSub(x,All(x,p),Sub),p);

theorem 
  not x in rng RestrictSub(x,All(x,p),Sub) implies S_Bound([All(x,p ),Sub]) = x
;

theorem 
  ExpandSub(x,p,RestrictSub(x,All(x,p),Sub)) = @RestrictSub(x,All(x
  ,p),Sub) +* (x|S_Bound([All(x,p),Sub]));

theorem 
  S`2 = @RestrictSub(x,All(x,p),Sub) +* (x|S_Bound([All(x,p),Sub])
  ) & S`1 = p implies [S,x] is quantifiable & ex S1 st S1 = [All(x,p),Sub];

theorem 
  (for Sub holds ex S st S`1 = p & S`2 = Sub) implies for Sub
  holds ex S st S`1 = All(x,p) & S`2 = Sub;

theorem 
  for p, Sub holds ex S st S`1 = p & S`2 = Sub;

definition
  let Al,p,Sub;
  redefine func [p,Sub] -> Element of CQC-Sub-WFF(Al);
end;

notation
  let Al,x,y;
  synonym Sbst(x,y) for x .--> y;
end;

definition
  let Al,x,y;
  redefine func Sbst(x,y) -> CQC_Substitution of Al;
end;

begin 

definition
  let Al,p,x,y;
  func p.(x,y) -> Element of CQC-WFF(Al) equals

  CQC_Sub([p,Sbst(x,y)]);
end;

scheme 

  CQCInd1 { Al() -> QC-alphabet, P[set]} :
for p being Element of CQC-WFF(Al()) holds P[p]
provided
 for p being Element of CQC-WFF(Al()) st QuantNbr(p) = 0 holds P[p] and
 for k st for p being Element of CQC-WFF(Al()) st QuantNbr(p) = k
holds P[p] holds for p being Element of CQC-WFF(Al()) st QuantNbr(p) = k+1
holds P[p];

scheme 

  CQCInd2 {Al() -> QC-alphabet, P[set]}:
   for p being Element of CQC-WFF(Al()) holds P[p]
provided
 for p being Element of CQC-WFF(Al()) st QuantNbr(p) <= 0 holds P[p] and
 for k st for p being Element of CQC-WFF(Al()) st QuantNbr(p) <= k
holds P[p] holds for p being Element of CQC-WFF(Al())
st QuantNbr(p) <= k+1 holds P[p];

theorem 
  VERUM(Al).(x,y) = VERUM(Al);

theorem 
  (P!l).(x,y) = P!CQC_Subst(l,Sbst(x,y)) & QuantNbr(P!l) = QuantNbr((P!l
  ).(x,y));

theorem 
  QuantNbr(P!l) = QuantNbr(CQC_Sub([P!l,Sub]));

definition
  let Al;
  let S be Element of QC-Sub-WFF(Al);
  redefine func S`2 -> CQC_Substitution of Al;
end;

theorem 
  ['not' p,Sub] = Sub_not [p,Sub];

theorem 
  'not' p.(x,y) = 'not' (p.(x,y)) & (QuantNbr(p) = QuantNbr(p.(x,y))
  implies QuantNbr('not' p) = QuantNbr('not' p.(x,y)));

theorem 
  (for Sub holds QuantNbr(p) = QuantNbr(CQC_Sub([p,Sub]))) implies
  for Sub holds QuantNbr('not' p) = QuantNbr(CQC_Sub(['not' p,Sub]));

theorem 
  [p '&' q,Sub] = CQCSub_&([p,Sub],[q,Sub]);

theorem 
  (p '&' q).(x,y) = (p.(x,y)) '&' (q.(x,y)) & ( QuantNbr(p) = QuantNbr(p
.(x,y)) & QuantNbr(q) = QuantNbr(q.(x,y)) implies QuantNbr(p '&'q) = QuantNbr((
  p '&' q).(x,y)));

theorem 
  (for Sub holds QuantNbr(p) = QuantNbr(CQC_Sub([p,Sub]))) & (for
  Sub holds QuantNbr(q) = QuantNbr(CQC_Sub([q,Sub]))) implies for Sub holds
  QuantNbr(p '&' q) = QuantNbr(CQC_Sub[p '&' q,Sub]);

definition
  let Al;
  func CFQ(Al) -> Function of CQC-Sub-WFF(Al),vSUB(Al) equals

  (QSub(Al))|CQC-Sub-WFF(Al);
end;

definition
  let Al,p,x,Sub;
  func QScope(p,x,Sub) -> CQC-WFF-like Element of [:QC-Sub-WFF(Al),
  bound_QC-variables(Al):] equals

  [[p,(CFQ(Al)).[All(x,p),Sub]],x];
end;

definition
  let Al,p,x,Sub;
  func Qsc(p,x,Sub) -> second_Q_comp of QScope(p,x,Sub) equals

  Sub;
end;

theorem 
  [All(x,p),Sub] = CQCSub_All(QScope(p,x,Sub),Qsc(p,x,Sub)) &
  QScope(p,x,Sub) is quantifiable;

theorem 
  (for Sub holds QuantNbr(p) = QuantNbr(CQC_Sub([p,Sub]))) implies
  for Sub holds QuantNbr(All(x,p)) = QuantNbr(CQC_Sub([All(x,p),Sub]));

theorem 
  QuantNbr(VERUM(Al)) = QuantNbr(CQC_Sub([VERUM(Al),Sub]));

theorem 
  for p, Sub holds QuantNbr(p) = QuantNbr(CQC_Sub([p,Sub]));

theorem 
  p is atomic implies ex k,P,ll st p = P!ll;

scheme 

  CQCInd3 {Al() -> QC-alphabet, P[set]} :
for p being Element of CQC-WFF(Al()) st QuantNbr(p) = 0 holds P[p]
provided
 for r,s being Element of CQC-WFF(Al())
for x being bound_QC-variable of Al()
for k
for l being CQC-variable_list of k,Al()
for P being QC-pred_symbol of k,Al()
holds P[VERUM(Al())] & P[P!l] &
(P[r] implies P['not' r]) & (P[r] & P[s] implies P[r '&' s]);

begin 

reserve F1,F2,F3 for QC-formula of Al,
  L for FinSequence;

definition
  let Al;
  let G,H be QC-formula of Al;
  assume
 G is_subformula_of H;
  mode PATH of G,H -> FinSequence means


    1 <= len it & it.1 = G & it.(
len it) = H & for k st 1 <= k & k < len it ex G1,H1
being Element of QC-WFF(Al) st it.k = G1 & it.(k+1) = H1 &
G1 is_immediate_constituent_of H1;
end;

theorem 
  for L being PATH of F1,F2 st F1 is_subformula_of F2 & 1 <= i & i <=
  len L holds ex F3 st F3 = L.i & F3 is_subformula_of F2;

theorem 
  for L being PATH of F1,p st F1 is_subformula_of p & 1 <= i & i
  <= len L holds L.i is Element of CQC-WFF(Al);

theorem 
  for L being PATH of q,p st QuantNbr(p) <= n & q is_subformula_of
  p & 1 <= i & i <= len L holds ex r st r = L.i & QuantNbr(r) <= n;

theorem 
  QuantNbr(p) = n & q is_subformula_of p implies QuantNbr(q) <= n;

theorem 
  for n,p st (for q st q is_subformula_of p holds QuantNbr(q) = n) holds n = 0;

theorem 
  for p st (for q st q is_subformula_of p holds for x,r holds q <> All(x
  ,r)) holds QuantNbr(p) = 0;

theorem 
  for p st for q st q is_subformula_of p holds QuantNbr(q) <> 1
  holds QuantNbr(p) = 0;

theorem 
  1 <= QuantNbr(p) implies ex q st q is_subformula_of p & QuantNbr(q)=1;














begin 

reserve Al for QC-alphabet;

reserve a,b,c,d for set,
  i,j,k,m,n for Element of NAT,
  p,q,r for Element of CQC-WFF(Al),
  x,y,y0 for bound_QC-variable of Al,
  X for Subset of CQC-WFF(Al),
  A for non empty set,
  J for interpretation of Al,A,
  v,w for Element of Valuations_in(Al,A),
  Sub for CQC_Substitution of Al,
  f,f1,g,h,h1 for FinSequence of CQC-WFF(Al);

definition
  let D be non empty set, f be FinSequence of D;
  func Ant(f) -> FinSequence of D means


  for i st len f = i+1 holds it = f|(Seg i) if len f > 0 otherwise it = {};
end;

definition
  let Al;
  let f be FinSequence of CQC-WFF(Al);
  func Suc(f) -> Element of CQC-WFF(Al) equals


  f.(len f) if len f > 0
  otherwise VERUM(Al);
end;

definition
  let f be Relation, p be set;
  pred p is_tail_of f means


  p in rng f;
end;

definition
  let Al,f,g;
  pred f is_Subsequence_of g means


  ex N being Subset of NAT st f c= Seq (g|N);
end;

theorem 
  f is_Subsequence_of g implies rng f c= rng g & ex N being Subset
  of NAT st rng f c= rng (g|N);

theorem 
  len f > 0 implies len Ant(f)+1 = len f & len Ant(f) < len f;

theorem 
  len f > 0 implies f = Ant(f)^<*Suc(f)*> & rng f = rng Ant(f) \/ { Suc(f)};

theorem 
  len f > 1 implies len Ant(f) > 0;

theorem 
  Suc(f^<*p*>) = p & Ant(f^<*p*>) = f;

reserve fin,fin1 for FinSequence;

theorem 
  len fin <= len (fin^fin1) & len fin1 <= len (fin^fin1) & (fin <>
  {} implies 1 <= len fin & len fin1 < len (fin1^fin));

theorem 
  Seq ((f^g)|dom f) = (f^g)|dom f;

theorem 
  f is_Subsequence_of f^g;

theorem 
  1 < len (fin^<*b*>^<*c*>);

theorem 
  1 <= len (fin^<*b*>) & len (fin^<*b*>) in dom (fin^<*b*>);

theorem 
  0 < m implies len (Sgm (Seg n \/ {n+m})) = n+1;

theorem 
  0 < m implies dom (Sgm (Seg n \/ {n+m})) = Seg (n+1);

theorem 
  0 < len f implies f is_Subsequence_of Ant(f)^g^<*Suc(f)*>;

theorem 
  1 in dom <*c,d*> & 2 in dom <*c,d*> & (f^<*c,d*>).(len f + 1) =
  c & (f^<*c,d*>).(len f + 2) = d;

begin 

definition
  let Al,f;
  func still_not-bound_in f -> Subset of bound_QC-variables(Al) means


  a in it iff ex i,p st i in dom f & p = f.i & a in still_not-bound_in p;
end;

definition
  let Al;
  func set_of_CQC-WFF-seq(Al) means


  a in it iff a is FinSequence of CQC-WFF(Al);
end;

reserve PR,PR1 for FinSequence of [:set_of_CQC-WFF-seq(Al),Proof_Step_Kinds:];

definition
  let Al,PR;
  let n be Nat;
  pred PR,n is_a_correct_step means


  ex f st Suc(f) is_tail_of Ant(f) &
  (PR.n)`1 = f if (PR.n)`2 = 0, ex f st (PR.n)`1 = f^<*VERUM(Al)*>
  if (PR.n)`2 = 1,
ex i,f,g st 1 <= i & i < n & Ant(f) is_Subsequence_of Ant(g) & Suc(f) = Suc(g)
& (PR.i)`1 = f & (PR.n)`1 = g if (PR.n)`2 = 2, ex i,j,f,g st 1 <= i & i < n & 1
  <= j & j < i & len f > 1 & len g > 1 & Ant(Ant(f)) = Ant(Ant(g)) & 'not' Suc(
Ant(f)) = Suc(Ant(g)) & Suc(f) = Suc(g) & f = (PR.j)`1 & g = (PR.i)`1 & Ant(Ant
(f))^<*Suc(f)*> = (PR.n)`1 if (PR.n)`2 = 3, ex i,j,f,g,p st 1 <= i & i < n & 1
<= j & j < i & len f > 1 & Ant(f) = Ant(g) & Suc(Ant(f)) = 'not' p & 'not' Suc(
f) = Suc(g) & f = (PR.j)`1 & g = (PR.i)`1 & Ant(Ant(f))^<*p*> = (PR.n)`1 if (PR
.n)`2 = 4, ex i,j,f,g st 1 <= i & i < n & 1 <= j & j < i & Ant(f) = Ant(g) & f
= (PR.j)`1 & g = (PR.i)`1 & Ant(f)^<*(Suc(f)) '&' (Suc(g))*> = (PR.n)`1 if (PR.
n)`2 = 5, ex i,f,p,q st 1 <= i & i < n & p '&' q = Suc(f) & f = (PR.i)`1 & Ant(
  f)^<*p*> = (PR.n)`1 if (PR.n)`2 = 6, ex i,f,p,q st 1 <= i & i < n & p '&' q =
Suc(f) & f = (PR.i)`1 & Ant(f)^<*q*>= (PR.n)`1 if (PR.n)`2 = 7, ex i,f,p,x,y st
1 <= i & i < n & Suc(f) = All(x,p) & f = (PR.i)`1 & Ant(f)^<*p.(x,y)*> = (PR.n)
  `1 if (PR.n)`2 = 8, ex i,f,p,x,y st 1 <= i & i < n & Suc(f) = p.(x,y) & not y
in still_not-bound_in (Ant(f)) & not y in still_not-bound_in All(x,p) & f = (PR
  .i)`1 & Ant(f)^<*All(x,p)*> = (PR.n)`1 if (PR.n)`2 = 9;
end;

definition
  let Al,PR;
  attr PR is a_proof means


  PR <> {} & for n being Nat st 1 <= n & n <=
  len PR holds PR,n is_a_correct_step;
end;

definition
  let Al,f;
  pred |- f means


  ex PR st PR is a_proof & f = (PR.(len PR))`1;
end;

definition
  let Al,p,X;
  pred p is_formal_provable_from X means


  ex f st rng Ant(f) c= X & Suc (f) = p & |- f;
end;

definition
  let Al,X,A,J,v;
  pred J,v |= X means


  p in X implies J,v |= p;
end;

definition
  let Al,X,p;
  pred X |= p means

  J,v |= X implies J,v |= p;
end;

definition
  let Al,p;
  pred |= p means

  {}(CQC-WFF(Al)) |= p;
end;

definition
  let Al,f, A, J, v;
  pred J,v |= f means


  J,v |= rng(f);
end;

definition
  let Al, f, p;
  pred f |= p means


  J,v |= f implies J,v |= p;
end;

theorem 
  Suc(f) is_tail_of Ant(f) implies Ant(f) |= Suc(f);

theorem 
  Ant(f) is_Subsequence_of Ant(g) & Suc(f) = Suc(g) & Ant(f) |=
  Suc(f) implies Ant(g) |= Suc(g);

theorem 
  len f > 0 implies (J,v |= Ant(f) & J,v |= Suc(f) iff J,v |= f);

theorem 
  len f > 1 & len g > 1 & Ant(Ant(f)) = Ant(Ant(g)) & 'not' Suc(
  Ant(f)) = Suc(Ant(g)) & Suc(f) = Suc(g) & Ant(f) |= Suc(f) & Ant(g) |= Suc(g)
  implies Ant(Ant(f)) |= Suc(f);

theorem 
  len f > 1 & Ant(f) = Ant(g) & 'not' p = Suc(Ant(f)) & 'not' Suc(
  f) = Suc(g) & Ant(f) |= Suc(f) & Ant(g) |= Suc(g) implies Ant(Ant(f)) |= p;

theorem 
  Ant(f) = Ant(g) & Ant(f) |= Suc(f) & Ant(g) |= Suc(g) implies
  Ant(f) |= (Suc(f)) '&' (Suc(g));

theorem 
  Ant(f) |= p '&' q implies Ant(f) |= p;

theorem 
  Ant(f) |= p '&' q implies Ant(f) |= q;

theorem 
  J,v |= [p,Sub] iff J,v |= p;

reserve a for Element of A;

theorem 
  J,v |= p.(x,y) iff ex a st v.y = a & J,v.(x|a) |= p;

theorem 
  Suc(f) = All(x,p) & Ant(f) |= Suc(f) implies for y holds Ant(f) |= p.(x,y);

theorem 
  for X being set st X c= bound_QC-variables(Al) holds not x in X
  implies v.(x|a)|X = v|X;

theorem 
  for v,w holds v|still_not-bound_in f = w|still_not-bound_in f
  implies (J,v |= f implies J,w |= f);

theorem 
  not y in still_not-bound_in All(x,p) implies v.(y|a).(x|a)|
  still_not-bound_in p = v.(x|a)|still_not-bound_in p;

theorem 
  Suc(f) = p.(x,y) & Ant(f) |= Suc(f) & not y in
still_not-bound_in Ant(f) & not y in still_not-bound_in All(x,p) implies Ant(f)
  |= All(x,p);

theorem 
  Ant(f^<*VERUM(Al)*>) |= Suc(f^<*VERUM(Al)*>);

theorem 
  for n being Nat holds 1 <= n & n <= len PR implies (PR.n)`2 = 0
or (PR.n)`2 = 1 or (PR.n)`2 = 2 or (PR.n)`2 = 3 or (PR.n)`2 = 4 or (PR.n)`2 = 5
  or (PR.n)`2 = 6 or (PR.n)`2 = 7 or (PR.n)`2 = 8 or (PR.n)`2 = 9;



theorem 
  p is_formal_provable_from X implies X |= p;

begin 

theorem 
  Suc(f) is_tail_of Ant(f) implies |- f;

theorem 
  for n being Nat holds 1 <= n & n <= len PR implies (PR,n
  is_a_correct_step iff PR^PR1,n is_a_correct_step);

theorem 
  1 <= n & n <= len PR1 & PR1,n is_a_correct_step implies (PR^PR1)
  ,(n+len PR) is_a_correct_step;

theorem 
  Ant(f) is_Subsequence_of Ant(g) & Suc(f) = Suc(g) & |- f implies |- g;

theorem 
  1 < len f & 1 < len g & Ant(Ant(f)) = Ant(Ant(g)) & 'not' Suc(
Ant(f)) = Suc(Ant(g)) & Suc(f) = Suc(g) & |- f & |- g implies |- Ant(Ant(f))^<*
  Suc(f)*>;

theorem 
  len f > 1 & Ant(f) = Ant(g) & Suc(Ant(f)) = 'not' p & 'not' Suc(
  f) = Suc(g) & |- f & |- g implies |- Ant(Ant(f))^<*p*>;

theorem 
  Ant(f) = Ant(g) & |- f & |- g implies |- Ant(f)^<*(Suc(f)) '&' ( Suc(g))*>;

theorem 
  p '&' q = Suc(f) & |- f implies |- Ant(f)^<*p*>;

theorem 
  p '&' q = Suc(f) & |- f implies |- Ant(f)^<*q*>;

theorem 
  Suc(f) = All(x,p) & |- f implies |- Ant(f)^<*p.(x,y)*>;

theorem 
  Suc(f) = p.(x,y) & not y in still_not-bound_in Ant(f) & not y in
  still_not-bound_in All(x,p) & |- f implies |- Ant(f)^<*All(x,p)*>;

theorem 
  |- f & |- Ant(f)^<*'not' Suc(f)*> implies |- Ant(f)^<*p*>;

theorem 
  1 <= len f & |- f & |- f^<*p*> implies |- Ant(f)^<*p*>;

theorem 
  |- f^<*p*>^<*q*> implies |- f^<*'not' q*>^<*'not' p*>;

theorem 
  |- f^<*'not' p*>^<*'not' q*> implies |- f^<*q*>^<*p*>;

theorem 
  |- f^<*'not' p*>^<*q*> implies |- f^<*'not' q*>^<*p*>;

theorem 
  |- f^<*p*>^<*'not' q*> implies |- f^<*q*>^<*'not' p*>;

theorem 
  |- f^<*p*>^<*r*> & |- f^<*q*>^<*r*> implies |- f^<*p 'or' q*>^<*r*>;

theorem 
  |- f^<*p*> implies |- f^<*p 'or' q*>;

theorem 
  |- f^<*q*> implies |- f^<*p 'or' q*>;

theorem 
  |- f^<*p*>^<*r*> & |- f^<*q*>^<*r*> implies |- f^<*p 'or' q*>^<* r*>;

theorem 
  |- f^<*p*> implies |- f^<*'not' 'not' p*>;

theorem 
  |- f^<*'not' 'not' p*> implies |- f^<*p*>;

theorem 
  |- f^<*p => q*> & |- f^<*p*> implies |- f^<*q*>;

theorem 
  ('not' p).(x,y) = 'not' (p.(x,y));

theorem 
  (ex y st |- f^<*p.(x,y)*>) implies |- f^<*Ex(x,p)*>;

theorem 
  still_not-bound_in (f^g) = still_not-bound_in f \/ still_not-bound_in g;

theorem 
  still_not-bound_in <*p*> = still_not-bound_in p;

theorem 
  |- f^<*p.(x,y)*>^<*q*> & not y in still_not-bound_in (f^<*Ex(x,p)*>^<*
  q*>) implies |- f^<*Ex(x,p)*>^<*q*>;

theorem 
  still_not-bound_in f = union {still_not-bound_in p : ex i st i
  in dom f & p = f.i};

theorem 
  still_not-bound_in f is finite;

theorem 
  card bound_QC-variables(Al) = card QC-symbols(Al) &
  not bound_QC-variables(Al) is finite;

theorem 
  ex x st not x in still_not-bound_in f;

theorem 
  |- f^<*All(x,p)*> implies |- f^<*All(x,'not' 'not' p)*>;

theorem 
  |- f^<*All(x,'not' 'not' p)*> implies |- f^<*All(x,p)*>;

theorem 
  |- f^<*All(x,p)*> iff |- f^<*'not' Ex(x,'not' p)*>;

definition
  let f be FinSequence, p be set;
  redefine pred p is_tail_of f means

  ex i being Element of NAT st i in dom f & f.i = p;
end;














begin 

reserve Al for QC-alphabet;

reserve p,q,p1,p2,q1 for Element of CQC-WFF(Al),
  k,m,n,i for Element of NAT,
  f, f1,f2,g for FinSequence of CQC-WFF(Al),
  a,b,b1,b2,c for natural number;

definition
  let m,n be natural number;
  func seq(m,n) -> set equals

  {k : 1+m <= k & k <= n+m };
end;

definition
  let m,n be natural number;
  redefine func seq(m,n) -> Subset of NAT;
end;

theorem 
  c in seq(a,b) iff 1+a <= c & c <= b+a;

theorem 
  seq(a,0) = {};

theorem 
  b = 0 or b+a in seq(a,b);

theorem 
  b1 <= b2 iff seq(a,b1) c= seq(a,b2);

theorem 
  seq(a,b) \/ {a+b+1} = seq(a,b+1);

theorem 
  seq(m,n),n are_equipotent;

registration
  let m,n;
  cluster seq(m,n) -> finite;
end;

registration
  let Al;
  let f;
  cluster len f -> finite;
end;

theorem 
  seq(m,n) c= Seg (m+n);

theorem 
  Seg n misses seq(n,m);

theorem 
  for f,g be FinSequence holds dom(f^g) = dom f \/ seq(len f,len g);

theorem 
  len Sgm(seq(len g,len f)) = len f;

theorem 
  dom Sgm(seq(len g,len f)) = dom f;

theorem 
  rng Sgm(seq(len g,len f)) = seq(len g,len f);

theorem 
  i in dom Sgm(seq(len g,len f)) implies Sgm(seq(len g,len f)).i = len g+i;

theorem 
  seq(len g,len f) c= dom (g^f);

theorem 
  dom((g^f)|seq(len g,len f)) = seq(len g,len f);

theorem 
  Seq((g^f)|seq(len g,len f)) = Sgm(seq(len g,len f)) * (g^f);

theorem 
  dom Seq((g^f)|seq(len g,len f)) = dom f;

theorem 
  f is_Subsequence_of g^f;

definition
  let D be non empty set, f be FinSequence of D;
  let P be Permutation of dom f;
  func Per(f,P) -> FinSequence of D equals

  P*f;
end;

reserve P for Permutation of dom f;

theorem 
  dom Per(f,P) = dom f;

theorem 
  |- f^<*p*> implies |- g^f^<*p*>;

begin 

definition
  let Al,f;
  func Begin(f) -> Element of CQC-WFF(Al) means


  it = f.1 if 1 <= len f otherwise it = VERUM(Al);
end;

definition
  let Al,f;
  assume
 1 <= len f;
  func Impl(f) -> Element of CQC-WFF(Al) means


  ex F being FinSequence of
CQC-WFF(Al) st it = F.(len f) & len F = len f & (F.1 = Begin(f) or len f = 0)
 & for n st 1 <= n & n < len f holds ex p,q st p = f.(n+1) &
  q = F.n & F.(n+1) = p => q;
end;



theorem 
  |- f^<*p*>^<*p*>;

theorem 
  |- f^<*p '&' q*> implies |- f^<*p*>;

theorem 
  |- f^<*p '&' q*> implies |- f^<*q*>;

theorem 
  |- f^<*p*> & |- f^<*p*>^<*q*> implies |- f^<*q*>;

theorem 
  |- f^<*p*> & |- f^<*'not' p*> implies |- f^<*q*>;

theorem 
  |- f^<*p*>^<*q*> & |- f^<*'not' p*>^<*q*> implies |- f^<*q*>;

theorem 
  |- f^<*p*>^<*q*> implies |- f^<*p => q*>;

theorem 
  1 <= len g & |- f^g implies |- f^<*Impl(Rev g)*>;

theorem 
  |- Per(f,P)^<*Impl(Rev (f^<*p*>))*> implies |- Per(f,P)^<*p*>;

theorem 
  |- f^<*p*> implies |- Per(f,P)^<*p*>;

begin 

notation
  let n;
  let c be set;
  synonym IdFinS(c,n) for n |-> c;
end;

theorem 
  for c being set st 1 <= n holds rng IdFinS(c,n) = rng <*c*>;

definition
  let D be non empty set, n be Element of NAT, p be Element of D;
  redefine func IdFinS(p,n) -> FinSequence of D;
end;

theorem 
  1 <= n & |- f^IdFinS(p,n)^<*q*> implies |- f^<*p*>^<*q*>;














begin 

reserve Al for QC-alphabet;

reserve a,a1,a2,b,c,d for set,
  X,Y,Z for Subset of CQC-WFF(Al),
  i,k,m,n for Element of NAT,
  p,q for Element of CQC-WFF(Al),
  P for QC-pred_symbol of k,Al,
  ll for CQC-variable_list of k,Al,
  f,f1,f2,g for FinSequence of CQC-WFF(Al);
reserve A for non empty finite Subset of NAT;

theorem 
  for f being Function of n,A st ((ex m st succ m = n) & rng f = A
& for n,m st m in dom f & n in dom f & n < m holds f.n in f.m) holds f.(union n
  ) = union rng f;

theorem 
  union A in A & for a st a in A holds (a in union A or a = union A );

reserve C for non empty set;

theorem 
  for f being Function of NAT,C, X being finite set st (for n,m st
m in dom f & n in dom f & n < m holds f.n c= f.m) & X c= union rng f holds ex k
  st X c= f.k;

definition
  let Al;
  let X,p;
  pred X |- p means


  ex f st rng f c= X & |- f^<*p*>;
end;

definition
  let Al;
  let X;
  attr X is Consistent means


  for p holds not (X |- p & X |- 'not' p);
end;

notation
  let Al;
  let X;
  antonym X is Inconsistent for X is Consistent;
end;

definition
  let Al;
  let f be FinSequence of CQC-WFF(Al);
  attr f is Consistent means


  for p holds not (|- f^<*p*> & |- f^<*'not' p*>);
end;

notation
  let Al;
  let f be FinSequence of CQC-WFF(Al);
  antonym f is Inconsistent for f is Consistent;
end;

theorem 
  X is Consistent & rng g c= X implies g is Consistent;

theorem 
  |- f^<*p*> implies |- f^g^<*p*>;



theorem 
  X is Inconsistent iff for p holds X |- p;



theorem 
  X is Inconsistent implies ex Y st Y c= X & Y is finite & Y is Inconsistent;

theorem 
  X \/ {p} |- q implies ex g st rng g c= X & |- g^<*p*>^<*q*>;



theorem 
  X |- p iff X \/ {'not' p} is Inconsistent;



theorem 
  X |- 'not' p iff X \/ {p} is Inconsistent;

begin 


theorem 
  for f being Function of NAT,bool CQC-WFF(Al) st (for n,m st m in dom f & n
  in dom f & n < m holds f.n is Consistent & f.n c= f.m) holds (union rng f) is
  Consistent;

begin 

reserve A for non empty set,
  v for Element of Valuations_in(Al,A),
  J for interpretation of Al,A;

theorem 
  X is Inconsistent implies for J,v holds not J,v |= X;

theorem 
  {VERUM(Al)} is Consistent;

registration
  let Al;
  cluster Consistent for Subset of CQC-WFF(Al);
end;

reserve CX for Consistent Subset of CQC-WFF(Al),
  P9 for Element of QC-pred_symbols(Al);

definition
  let Al;
  func HCar(Al) -> non empty set equals

  bound_QC-variables(Al);
end;

definition
  let Al;
  let P be (Element of QC-pred_symbols(Al)), ll be CQC-variable_list of (
  the_arity_of P), Al;
  redefine func P!ll -> Element of CQC-WFF(Al);
end;



definition
  let Al;
  let CX;
  mode Henkin_interpretation of CX -> interpretation of Al,HCar(Al) means


    for
P being (Element of QC-pred_symbols(Al)), r being Element of relations_on
HCar(Al) st it.P = r holds for a holds a in r iff
ex ll being CQC-variable_list of (the_arity_of P), Al st a = ll &
CX |- P!ll;
end;

definition
  let Al;
  func valH(Al) -> Element of Valuations_in (Al,HCar(Al)) equals

  id bound_QC-variables(Al);
end;

begin 

reserve JH for Henkin_interpretation of CX;

theorem 
  (valH(Al))*'ll = ll;

theorem 
  |- f^<*VERUM(Al)*>;

theorem 
  JH,valH(Al) |= VERUM(Al) iff CX |- VERUM(Al);

theorem 
  JH,valH(Al) |= P!ll iff CX |- P!ll;














begin 

registration
  cluster countable for QC-alphabet;
end;

reserve Al for QC-alphabet;
reserve b,c,d for set,
  X,Y for Subset of CQC-WFF(Al),
  i,j,k,m,n for Element of NAT,
  p,p1,q,r,s,s1 for Element of CQC-WFF(Al),
  x,x1,x2,y,y1 for bound_QC-variable of Al,
  A for non empty set,
  J for interpretation of Al, A,
  v for Element of Valuations_in(Al,A),
  f1,f2 for FinSequence of CQC-WFF(Al),
  CX,CY,CZ for Consistent Subset of CQC-WFF(Al),
  JH for Henkin_interpretation of CX,
  a for Element of A,
  t,u for QC-symbol of Al;

definition
  let Al,X;
  attr X is negation_faithful means


  X |- p or X |- 'not' p;
end;

definition
  let Al,X;
  attr X is with_examples means


  for x,p holds ex y st X |- ('not' Ex(x,p)) 'or' (p.(x,y));
end;

theorem 
  CX is negation_faithful implies (CX |- p iff not CX |- 'not' p);

theorem 
  for f being FinSequence of CQC-WFF(Al) holds
  |- f^<*'not' p 'or' q*> & |- f^<*p*> implies |- f^<*q*>;

theorem 
  X is with_examples implies (X |- Ex(x,p) iff ex y st X |- p.(x,y));

theorem 
  (CX is negation_faithful & CX is with_examples implies
  (JH,valH(Al) |= p iff CX |- p)) implies
  (CX is negation_faithful & CX is with_examples implies
  (JH,valH(Al) |= 'not' p iff CX |- 'not' p));

theorem 
  |- f1^<*p*> & |- f1^<*q*> implies |- f1^<*p '&' q*>;

theorem 
  X |- p & X |- q iff X |- p '&' q;

theorem 
  (CX is negation_faithful & CX is with_examples implies
  (JH,valH(Al) |= p iff CX |- p)) &
  (CX is negation_faithful & CX is with_examples implies
  (JH,valH(Al) |= q iff CX |- q)) implies
  (CX is negation_faithful & CX is with_examples
  implies (JH,valH(Al) |= p '&' q iff CX |- p '&' q));

theorem 
  for p st QuantNbr(p) <= 0 holds
  CX is negation_faithful & CX is with_examples implies
  (JH,valH(Al) |= p iff CX |- p);

theorem 
  J,v |= Ex(x,p) iff ex a st J,v.(x|a) |= p;

theorem 
  JH,valH(Al) |= Ex(x,p) iff ex y st JH,valH(Al) |= p.(x,y);

theorem 
  J,v |= 'not' Ex(x,'not' p) iff J,v |= All(x,p);

theorem 
  X |- 'not' Ex(x,'not' p) iff X |- All(x,p);

theorem 
  QuantNbr(Ex(x,p)) = QuantNbr(p)+1;

theorem 
  QuantNbr(p) = QuantNbr(p.(x,y));

reserve L for PATH of q,p,
  F1,F3 for QC-formula of Al,
  a for set;

theorem 
  for p st QuantNbr(p) = 1 holds (CX is negation_faithful & CX is with_examples
  implies (JH,valH(Al) |= p iff CX |- p));

theorem 
  for n st for p st QuantNbr(p) <= n holds
  (CX is negation_faithful & CX is with_examples
  implies (JH,valH(Al) |= p iff CX |- p)) holds
  for p st QuantNbr(p) <= n+1 holds
  (CX is negation_faithful & CX is with_examples
  implies (JH,valH(Al) |= p iff CX |- p));



theorem 
  for p holds (CX is negation_faithful & CX is with_examples
  implies (JH,valH(Al) |= p iff CX |- p));

begin 


theorem 
  Al is countable implies
  QC-WFF(Al) is countable;

definition
  let Al;
  func ExCl(Al) -> Subset of CQC-WFF(Al) means


  a in it iff ex x,p st a = Ex(x,p);
end;

theorem 
  Al is countable implies
  CQC-WFF(Al) is countable;

theorem 
  Al is countable implies
  ExCl(Al) is non empty & ExCl(Al) is countable;

definition
  let Al;
  let p be Element of QC-WFF(Al) such that
 p is existential;
  func Ex-bound_in p -> bound_QC-variable of Al means


  ex q being Element of QC-WFF(Al) st p = Ex(it,q);
end;

definition
  let Al;
  let p be Element of CQC-WFF(Al) such that
 p is existential;
  func Ex-the_scope_of p -> Element of CQC-WFF(Al) means


  ex x st p = Ex(x,it);
end;

definition
  let Al;
  let F be Function of NAT,CQC-WFF(Al),a be Element of NAT;
  func bound_in(F,a) -> bound_QC-variable of Al means


  p = F.a implies it = Ex-bound_in p;
end;

definition
  let Al;
  let F be Function of NAT,CQC-WFF(Al),a be Element of NAT;
  func the_scope_of(F,a) -> Element of CQC-WFF(Al) means


  p = F.a implies it = Ex-the_scope_of p;
end;

definition
  let Al,X;
  func still_not-bound_in X -> Subset of bound_QC-variables(Al) equals

  union {still_not-bound_in p : p in X};
end;

theorem 
  p in X implies X |- p;

theorem 
  Ex-bound_in Ex(x,p) = x & Ex-the_scope_of Ex(x,p) = p;

theorem 
  X |- VERUM(Al);

theorem 
  X |- 'not' VERUM(Al) iff X is Inconsistent;

reserve C,D for Element of [:CQC-WFF(Al),bool bound_QC-variables(Al):];
reserve K,L for Subset of bound_QC-variables(Al);

theorem 
  for f,g being FinSequence of CQC-WFF(Al) st 0 < len f & |- f^<*p*> holds
  |- Ant(f)^g^<*Suc(f)*>^<*p*>;

theorem 
  still_not-bound_in {p} = still_not-bound_in p;

theorem 
  still_not-bound_in (X \/ Y) = still_not-bound_in X \/ still_not-bound_in Y;

theorem 
  for A being Subset of bound_QC-variables(Al) st A is finite holds
  ex x st not x in A;

theorem 
  X c= Y implies still_not-bound_in X c= still_not-bound_in Y;

theorem 
  for f being FinSequence of CQC-WFF(Al) holds
  still_not-bound_in rng f = still_not-bound_in f;



theorem 
  ( Al is countable &
  still_not-bound_in CX is finite ) implies
  ex CY st CX c= CY & CY is with_examples;

theorem 
  X |- p & X c= Y implies Y |- p;

reserve C,D for Subset of CQC-WFF(Al);



theorem 
  ( Al is countable &
  CX is with_examples ) implies ( ex CY st CX c= CY &
  CY is negation_faithful & CY is with_examples );

reserve JH1 for Henkin_interpretation of CZ,
  J for interpretation of Al, A,
  v for Element of Valuations_in(Al,A);

theorem 
  (Al is countable & still_not-bound_in CX is finite)
   implies ex CZ,JH1 st JH1,valH(Al) |= CX;

begin 


theorem 
  J,v |= X & Y c= X implies J,v |= Y;

theorem 
  still_not-bound_in X is finite implies
  still_not-bound_in (X \/ {p}) is finite;

theorem 
  X |= p implies not J,v |= X \/ {'not' p};


theorem 
  ( Al is countable &
  still_not-bound_in X is finite & X |= p ) implies X |- p;














begin

definition
  struct 1-sorted(# carrier -> set #);
end;

definition
  let S be 1-sorted;
  attr S is empty means


  the carrier of S is empty;
end;

registration
  cluster strict empty for 1-sorted;
end;

registration
  cluster strict non empty for 1-sorted;
end;

registration
  let S be empty 1-sorted;
  cluster the carrier of S -> empty;
end;

registration
  let S be non empty 1-sorted;
  cluster the carrier of S -> non empty;
end;

definition
  let S be 1-sorted;
  mode Element of S is Element of the carrier of S;
  mode Subset of S is Subset of the carrier of S;
  mode Subset-Family of S is Subset-Family of the carrier of S;
end;




definition
  let S be 1-sorted, X be set;
  mode Function of S,X is Function of the carrier of S, X;
  mode Function of X,S is Function of X, the carrier of S;
end;

definition
  let S, T be 1-sorted;
  mode Function of S,T is Function of the carrier of S, the carrier of T;
end;



definition
  let T be 1-sorted;
  func {}T -> Subset of T equals

  {};
  func [#]T -> Subset of T equals

  the carrier of T;
end;

registration
  let T be 1-sorted;
  cluster {}T -> empty;
end;

registration
  let T be empty 1-sorted;
  cluster [#]T -> empty;
end;

registration
  let T be non empty 1-sorted;
  cluster [#]T -> non empty;
end;

registration
  let S be non empty 1-sorted;
  cluster non empty for Subset of S;
end;



definition
  let S be 1-sorted;
  mode FinSequence of S is FinSequence of the carrier of S;
end;



definition
  let S be 1-sorted;
  mode ManySortedSet of S is ManySortedSet of the carrier of S;
end;



definition
  let S be 1-sorted;
  func id S -> Function of S,S equals

  id the carrier of S;
end;



definition
  let S be 1-sorted;
  mode sequence of S is sequence of the carrier of S;
end;



definition
  let S be 1-sorted, X be set;
  mode PartFunc of S,X is PartFunc of the carrier of S, X;
  mode PartFunc of X,S is PartFunc of X, the carrier of S;
end;

definition
  let S,T be 1-sorted;
  mode PartFunc of S,T is PartFunc of the carrier of S,the carrier of T;
end;



definition
  let S be 1-sorted;
  let x be set;
  pred x in S means

  x in the carrier of S;
end;



definition
  struct (1-sorted) ZeroStr
  (# carrier -> set, ZeroF -> Element of the carrier #);
end;

registration
  cluster strict non empty for ZeroStr;
end;

definition
  struct (1-sorted) OneStr(# carrier -> set, OneF -> Element of the carrier #);
end;

definition
  struct (ZeroStr,OneStr) ZeroOneStr(# carrier -> set, ZeroF -> Element of the
    carrier, OneF -> Element of the carrier #);
end;

definition
  let S be ZeroStr;
  func 0.S -> Element of S equals

  the ZeroF of S;
end;

definition
  let S be OneStr;
  func 1.S -> Element of S equals

  the OneF of S;
end;

definition
  let S be ZeroOneStr;
  attr S is degenerated means


  0.S = 1.S;
end;

definition
  let IT be 1-sorted;
  attr IT is trivial means


  the carrier of IT is trivial;
end;

registration
  cluster empty -> trivial for 1-sorted;
  cluster non trivial -> non empty for 1-sorted;
end;

definition
  let S be 1-sorted;
  redefine attr S is trivial means


  for x,y being Element of S holds x = y;
end;

registration
  cluster non degenerated -> non trivial for ZeroOneStr;
end;

registration
  cluster trivial non empty strict for 1-sorted;
  cluster non trivial strict for 1-sorted;
end;

registration
  let S be non trivial 1-sorted;
  cluster the carrier of S -> non trivial;
end;

registration
  let S be trivial 1-sorted;
  cluster the carrier of S -> trivial;
end;

begin 

definition
  let S be 1-sorted;
  attr S is finite means


  the carrier of S is finite;
end;

registration
  cluster strict finite non empty for 1-sorted;
end;

registration
  let S be finite 1-sorted;
  cluster the carrier of S -> finite;
end;

registration
  cluster -> finite for empty 1-sorted;
end;

notation
  let S be 1-sorted;
  antonym S is infinite for S is finite;
end;

registration
  cluster strict infinite for 1-sorted;
end;

registration
  let S be infinite 1-sorted;
  cluster the carrier of S -> infinite;
end;

registration
  cluster -> non empty for infinite 1-sorted;
end;



registration
  cluster trivial -> finite for 1-sorted;
end;

registration
  cluster infinite -> non trivial for 1-sorted;
end;

definition
  let S be ZeroStr, x be Element of S;
  attr x is zero means

  x = 0.S;
end;

registration
  let S be ZeroStr;
  cluster 0.S -> zero;
end;

registration
  cluster strict non degenerated for ZeroOneStr;
end;

registration
  let S be non degenerated ZeroOneStr;
  cluster 1.S -> non zero;
end;

definition
  let S be 1-sorted;
  mode Cover of S is Cover of the carrier of S;
end;



registration
  let S be 1-sorted;
  cluster [#]S -> non proper;
end;

begin 

definition
  struct(1-sorted) 2-sorted(#carrier,carrier' -> set#);
end;

definition
  let S be 2-sorted;
  attr S is void means


  the carrier' of S is empty;
end;

registration
  cluster strict empty void for 2-sorted;
end;

registration
  let S be void 2-sorted;
  cluster the carrier' of S -> empty;
end;

registration
  cluster strict non empty non void for 2-sorted;
end;

registration
  let S be non void 2-sorted;
  cluster the carrier' of S -> non empty;
end;



definition
  let X be 1-sorted, Y be non empty 1-sorted, y be Element of Y;
  func X --> y -> Function of X,Y equals

  (the carrier of X) --> y;
end;

registration
  let S be ZeroStr;
  cluster zero for Element of S;
end;

registration
  cluster strict non trivial for ZeroStr;
end;

registration
  let S be non trivial ZeroStr;
  cluster non zero for Element of S;
end;



definition

  let X be set, S be ZeroStr, R be Relation of X, the carrier of S;
  attr R is non-zero means

  not 0.S in rng R;
end;



definition
  let S be 1-sorted;
  func card S -> Cardinal equals

  card the carrier of S;
end;



definition
  let S be 1-sorted;
  mode UnOp of S is UnOp of the carrier of S;
  mode BinOp of S is BinOp of the carrier of S;
end;



definition
  let S be ZeroStr;
  func NonZero S -> Subset of S equals

  [#]S \ {0.S};
end;

theorem 
  for S being non empty ZeroStr for u being Element of S holds u in
  NonZero S iff u is not zero;

definition
  let V be non empty ZeroStr;
  redefine attr V is trivial means


  for u being Element of V holds u = 0.V;
end;

registration
  let V be non trivial ZeroStr;
  cluster NonZero V -> non empty;
end;

registration
 cluster trivial non empty for ZeroStr;
end;

registration
  let S be trivial non empty ZeroStr;
  cluster NonZero S -> empty;
end;

registration
  let S be non empty 1-sorted;
  cluster non empty trivial for Subset of S;
end;

theorem 
  for F being non degenerated ZeroOneStr holds 1.F in NonZero F;



registration
 let S be finite 1-sorted;
 cluster card S -> natural;
end;

registration
 let S be finite non empty 1-sorted;
 cluster card S -> non zero for Nat;
end;

registration
  let T be non trivial 1-sorted;
  cluster non trivial for Subset of T;
end;



theorem 
 for S being ZeroStr holds not 0.S in NonZero S;

theorem 
 for S being non empty ZeroStr
  holds the carrier of S = {0.S} \/ NonZero S;



definition let C be set, X be 1-sorted;
 attr X is C-element means

 the carrier of X is C-element;
end;

registration let C be Cardinal;
 cluster C-element for 1-sorted;
end;

registration let C be Cardinal, X be C-element 1-sorted;
 cluster the carrier of X -> C-element;
end;

registration
 cluster empty -> 0-element for 1-sorted;
 cluster 0-element -> empty for 1-sorted;
 cluster non empty trivial -> 1-element for 1-sorted;
 cluster 1-element -> non empty trivial for 1-sorted;
end;



definition let S be 2-sorted;
 attr S is feasible means

  the carrier of S is empty implies the carrier' of S is empty;
end;

registration
 cluster non empty -> feasible for 2-sorted;
 cluster void -> feasible for 2-sorted;
 cluster empty feasible -> void for 2-sorted;
 cluster non void feasible -> non empty for 2-sorted;
end;

definition let S be 2-sorted;
 attr S is trivial' means

 the carrier' of S is trivial;
end;

registration
  cluster strict non empty non void trivial trivial' for 2-sorted;
end;

registration let S be trivial' 2-sorted;
 cluster the carrier' of S ->trivial;
end;

registration
 cluster non trivial' for 2-sorted;
end;

registration let S be non trivial' 2-sorted;
 cluster the carrier' of S -> non trivial;
end;

registration
 cluster void -> trivial' for 2-sorted;
  cluster non trivial -> non empty for 1-sorted;
end;














begin 

reserve D for non empty set,
  d,e for Element of D,
  o,o1 for BinOp of D;
reserve T for trivial set,
  s,t for Element of T,
  f,f1 for BinOp of T;
reserve N for non trivial set,
  n,m for Element of N,
  b,b1 for BinOp of N;

definition
  struct (1-sorted) addMagma (# carrier -> set, addF -> BinOp of the carrier
  #);
end;

registration
  let D,o;
  cluster addMagma(#D,o#) -> non empty;
end;

registration
  let T,f;
  cluster addMagma(#T,f#) -> trivial;
end;

registration
  let N,b;
  cluster addMagma(#N,b#) -> non trivial;
end;

definition
  let M be addMagma;
  let x,y be Element of M;
  func x+y -> Element of M equals

  (the addF of M).(x,y);
end;

definition
  func Trivial-addMagma -> addMagma equals

  addMagma(#1, op2 #);
end;

registration
  cluster Trivial-addMagma -> 1-element strict;
end;

registration
  cluster strict 1-element for addMagma;
end;

definition
  let M be addMagma, x be Element of M;
  attr x is left_add-cancelable means

  for y,z being Element of M st x+y = x+z holds y = z;
  attr x is right_add-cancelable means


  for y,z being Element of M st y+ x = z+x holds y = z;
end;

definition
  let M be addMagma, x be Element of M;
  attr x is add-cancelable means


  x is right_add-cancelable left_add-cancelable;
end;

registration
  let M be addMagma;
  cluster right_add-cancelable left_add-cancelable -> add-cancelable for
Element
    of M;
  cluster add-cancelable -> right_add-cancelable left_add-cancelable for
Element
    of M;
end;

definition
  let M be addMagma;
  attr M is left_add-cancelable means


  for x being Element of M holds x is left_add-cancelable;
  attr M is right_add-cancelable means


  for x being Element of M holds x is right_add-cancelable;
end;

definition
  let M be addMagma;
  attr M is add-cancelable means


  M is right_add-cancelable left_add-cancelable;
end;

registration
  cluster right_add-cancelable left_add-cancelable -> add-cancelable for
addMagma;
  cluster add-cancelable -> right_add-cancelable left_add-cancelable for
addMagma;
end;

registration
  cluster Trivial-addMagma -> add-cancelable;
end;

registration
  cluster add-cancelable strict 1-element for addMagma;
end;

registration
  let M be left_add-cancelable addMagma;
  cluster -> left_add-cancelable for Element of M;
end;

registration
  let M be right_add-cancelable addMagma;
  cluster -> right_add-cancelable for Element of M;
end;

definition
  struct (ZeroStr,addMagma) addLoopStr (# carrier -> set, addF -> BinOp of the
    carrier, ZeroF -> Element of the carrier #);
end;

registration
  let D,o,d;
  cluster addLoopStr(#D,o,d#) -> non empty;
end;

registration
  let T,f,t;
  cluster addLoopStr(#T,f,t#) -> trivial;
end;

registration
  let N,b,m;
  cluster addLoopStr(#N,b,m#) -> non trivial;
end;

definition
  func Trivial-addLoopStr -> addLoopStr equals

  addLoopStr(#1, op2, op0 #);
end;

registration
  cluster Trivial-addLoopStr -> 1-element strict;
end;

registration
  cluster strict 1-element for addLoopStr;
end;

definition
  let M be addLoopStr, x be Element of M;
  attr x is left_complementable means


  ex y being Element of M st y+x = 0.M;
  attr x is right_complementable means

  ex y being Element of M st x+y = 0.M;
end;

definition
  let M be addLoopStr, x be Element of M;
  attr x is complementable means


  x is right_complementable left_complementable;
end;

registration
  let M be addLoopStr;
  cluster right_complementable left_complementable -> complementable for
Element
    of M;
  cluster complementable -> right_complementable left_complementable for
Element
    of M;
end;

definition
  let M be addLoopStr, x be Element of M;
  assume
 x is left_complementable right_add-cancelable;
  func -x -> Element of M means

  it + x = 0.M;
end;

definition
  let V be addLoopStr;
  let v,w be Element of V;
  func v - w -> Element of V equals

  v + -w;
end;

registration
  cluster Trivial-addLoopStr -> add-cancelable;
end;

definition
  let M be addLoopStr;
  attr M is left_complementable means


  for x being Element of M holds x is left_complementable;
  attr M is right_complementable means


  for x being Element of M holds x is right_complementable;
end;

definition
  let M be addLoopStr;
  attr M is complementable means


  M is right_complementable left_complementable;
end;

registration
  cluster right_complementable left_complementable -> complementable
    for addLoopStr;
  cluster complementable -> right_complementable left_complementable
    for addLoopStr;
end;

registration
  cluster Trivial-addLoopStr -> complementable;
end;

registration
  cluster complementable add-cancelable strict 1-element for addLoopStr;
end;

registration
  let M be left_complementable addLoopStr;
  cluster -> left_complementable for Element of M;
end;

registration
  let M be right_complementable addLoopStr;
  cluster -> right_complementable for Element of M;
end;

begin 

definition
  struct (1-sorted) multMagma (# carrier -> set, multF -> BinOp of the carrier
  #);
end;

registration
  let D,o;
  cluster multMagma(#D,o#) -> non empty;
end;

registration
  let T,f;
  cluster multMagma(#T,f#) -> trivial;
end;

registration
  let N,b;
  cluster multMagma(#N,b#) -> non trivial;
end;

definition
  let M be multMagma;
  let x,y be Element of M;
  func x*y -> Element of M equals

  (the multF of M).(x,y);
end;

definition
  func Trivial-multMagma -> multMagma equals

  multMagma(#1, op2 #);
end;

registration
  cluster Trivial-multMagma -> 1-element strict;
end;

registration
  cluster strict 1-element for multMagma;
end;

definition
  let M be multMagma, x be Element of M;
  attr x is left_mult-cancelable means

  for y,z being Element of M st x*y = x*z holds y = z;
  attr x is right_mult-cancelable means


  for y,z being Element of M st y*x = z*x holds y = z;
end;

definition
  let M be multMagma, x be Element of M;
  attr x is mult-cancelable means


  x is right_mult-cancelable left_mult-cancelable;
end;

registration
  let M be multMagma;
  cluster right_mult-cancelable left_mult-cancelable -> mult-cancelable
    for Element of M;
  cluster mult-cancelable -> right_mult-cancelable left_mult-cancelable
    for Element of M;
end;

definition
  let M be multMagma;
  attr M is left_mult-cancelable means


  for x being Element of M holds x is left_mult-cancelable;
  attr M is right_mult-cancelable means


  for x being Element of M holds x is right_mult-cancelable;
end;

definition
  let M be multMagma;
  attr M is mult-cancelable means


  M is left_mult-cancelable right_mult-cancelable;
end;

registration
  cluster right_mult-cancelable left_mult-cancelable -> mult-cancelable
    for multMagma;
  cluster mult-cancelable -> right_mult-cancelable left_mult-cancelable
    for multMagma;
end;

registration
  cluster Trivial-multMagma -> mult-cancelable;
end;

registration
  cluster mult-cancelable strict 1-element for multMagma;
end;

registration
  let M be left_mult-cancelable multMagma;
  cluster -> left_mult-cancelable for Element of M;
end;

registration
  let M be right_mult-cancelable multMagma;
  cluster -> right_mult-cancelable for Element of M;
end;

definition
  struct (OneStr,multMagma) multLoopStr (# carrier -> set, multF -> BinOp of
    the carrier, OneF -> Element of the carrier #);
end;

registration
  let D,o,d;
  cluster multLoopStr(#D,o,d#) -> non empty;
end;

registration
  let T,f,t;
  cluster multLoopStr(#T,f,t#) -> trivial;
end;

registration
  let N,b,m;
  cluster multLoopStr(#N,b,m#) -> non trivial;
end;

definition
  func Trivial-multLoopStr -> multLoopStr equals

  multLoopStr(#1, op2, op0 #);
end;

registration
  cluster Trivial-multLoopStr -> 1-element strict;
end;

registration
  cluster strict 1-element for multLoopStr;
end;

registration
  cluster Trivial-multLoopStr -> mult-cancelable;
end;

definition
  let M be multLoopStr, x be Element of M;
  attr x is left_invertible means


  ex y being Element of M st y*x = 1.M;
  attr x is right_invertible means

  ex y being Element of M st x*y = 1.M;
end;

definition
  let M be multLoopStr, x be Element of M;
  attr x is invertible means


  x is right_invertible left_invertible;
end;

registration
  let M be multLoopStr;
  cluster right_invertible left_invertible -> invertible for Element of M;
  cluster invertible -> right_invertible left_invertible for Element of M;
end;

definition
  let M be multLoopStr, x be Element of M;
  assume
 x is left_invertible right_mult-cancelable;
  func /x -> Element of M means

  it * x = 1.M;
end;

definition
  let M be multLoopStr;
  attr M is left_invertible means


  for x being Element of M holds x is left_invertible;
  attr M is right_invertible means


  for x being Element of M holds x is right_invertible;
end;

definition
  let M be multLoopStr;
  attr M is invertible means


  M is right_invertible left_invertible;
end;

registration
  cluster right_invertible left_invertible -> invertible for multLoopStr;
  cluster invertible -> right_invertible left_invertible for multLoopStr;
end;

registration
  cluster Trivial-multLoopStr -> invertible;
end;

registration
  cluster invertible mult-cancelable strict 1-element for multLoopStr;
end;

registration
  let M be left_invertible multLoopStr;
  cluster -> left_invertible for Element of M;
end;

registration
  let M be right_invertible multLoopStr;
  cluster -> right_invertible for Element of M;
end;

begin 

definition
  struct (multLoopStr,ZeroOneStr) multLoopStr_0 (# carrier -> set, multF ->
    BinOp of the carrier, ZeroF, OneF -> Element of the carrier #);
end;

registration
  let D,o,d,e;
  cluster multLoopStr_0(#D,o,d,e#) -> non empty;
end;

registration
  let T,f,s,t;
  cluster multLoopStr_0(#T,f,s,t#) -> trivial;
end;

registration
  let N,b,m,n;
  cluster multLoopStr_0(#N,b,m,n#) -> non trivial;
end;

definition
  func Trivial-multLoopStr_0 -> multLoopStr_0 equals

  multLoopStr_0(#1, op2,
    op0, op0 #);
end;

registration
  cluster Trivial-multLoopStr_0 -> 1-element strict;
end;

registration
  cluster strict 1-element for multLoopStr_0;
end;

definition
  let M be multLoopStr_0, x be Element of M;
  func x" -> Element of M means

  it * x = 1.M if x is left_invertible
  right_mult-cancelable otherwise it = 0.M;
end;

definition
  let M be multLoopStr_0;
  attr M is almost_left_cancelable means

  for x being Element of M st x <> 0.M holds x is left_mult-cancelable;
  attr M is almost_right_cancelable means

  for x being Element of M st x <> 0.M holds x is right_mult-cancelable;
end;

definition
  let M be multLoopStr_0;
  attr M is almost_cancelable means


  M is almost_left_cancelable almost_right_cancelable;
end;

registration
  cluster almost_right_cancelable almost_left_cancelable -> almost_cancelable
    for multLoopStr_0;
  cluster almost_cancelable -> almost_right_cancelable almost_left_cancelable
    for multLoopStr_0;
end;

registration
  cluster Trivial-multLoopStr_0 -> almost_cancelable;
end;

registration
  cluster almost_cancelable strict 1-element for multLoopStr_0;
end;

definition
  let M be multLoopStr_0;
  attr M is almost_left_invertible means

  for x being Element of M st x <> 0.M holds x is left_invertible;
  attr M is almost_right_invertible means

  for x being Element of M st x <> 0.M holds x is right_invertible;
end;

definition
  let M be multLoopStr_0;
  attr M is almost_invertible means


  M is almost_right_invertible almost_left_invertible;
end;

registration
  cluster almost_right_invertible almost_left_invertible -> almost_invertible
    for multLoopStr_0;
  cluster almost_invertible -> almost_right_invertible almost_left_invertible
    for multLoopStr_0;
end;

registration
  cluster Trivial-multLoopStr_0 -> almost_invertible;
end;

registration
  cluster almost_invertible almost_cancelable strict 1-element
    for multLoopStr_0;
end;

begin 

definition
  struct(addLoopStr,multLoopStr_0) doubleLoopStr (# carrier -> set, addF,
    multF -> BinOp of the carrier, OneF, ZeroF -> Element of the carrier #);
end;

registration
  let D,o,o1,d,e;
  cluster doubleLoopStr(#D,o,o1,d,e#) -> non empty;
end;

registration
  let T,f,f1,s,t;
  cluster doubleLoopStr(#T,f,f1,s,t#) -> trivial;
end;

registration
  let N,b,b1,m,n;
  cluster doubleLoopStr(#N,b,b1,m,n#) -> non trivial;
end;

definition
  func Trivial-doubleLoopStr -> doubleLoopStr equals

  doubleLoopStr(#1, op2, op2, op0, op0 #);
end;

registration
  cluster Trivial-doubleLoopStr -> 1-element strict;
end;

registration
  cluster strict 1-element for doubleLoopStr;
end;














begin

definition
  struct IncProjStr (# Points, Lines -> non empty set, Inc -> Relation of the
    Points, the Lines #);
end;

definition
  struct (IncProjStr) IncStruct (# Points, Lines, Planes -> non empty set, Inc
-> Relation of the Points,the Lines, Inc2 -> Relation of the Points,the Planes,
    Inc3 -> Relation of the Lines,the Planes #);
end;

definition
  let S be IncProjStr;
  mode POINT of S is Element of the Points of S;
  mode LINE of S is Element of the Lines of S;
end;

definition
  let S be IncStruct;
  mode PLANE of S is Element of the Planes of S;
end;

reserve S for IncStruct;
reserve A,B,C,D for POINT of S;
reserve L for LINE of S;
reserve P for PLANE of S;
reserve F,G for Subset of the Points of S;



definition
  let S be IncProjStr;
  let A be POINT of S, L be LINE of S;
  pred A on L means


  [A,L] in the Inc of S;
end;

definition
  let S;
  let A be POINT of S, P be PLANE of S;
  pred A on P means


  [A,P] in the Inc2 of S;
end;

definition
  let S;
  let L be LINE of S, P be PLANE of S;
  pred L on P means


  [L,P] in the Inc3 of S;
end;

definition
  let S be IncProjStr;
  let F be Subset of the Points of S, L be LINE of S;
  pred F on L means


  for A being POINT of S st A in F holds A on L;
end;

definition
  let S;
  let F be Subset of the Points of S, P be PLANE of S;
  pred F on P means


  for A st A in F holds A on P;
end;

definition
  let S be IncProjStr;
  let F be Subset of the Points of S;
  attr F is linear means


  ex L being LINE of S st F on L;
end;

definition
  let S be IncStruct;
  let F be Subset of the Points of S;
  attr F is planar means


  ex P be PLANE of S st F on P;
end;



theorem 
  for S being IncProjStr, L being LINE of S, A, B being POINT of S
  holds {A,B} on L iff A on L & B on L;

theorem 
  for S being IncProjStr, L being LINE of S, A, B, C being POINT
  of S holds {A,B,C} on L iff A on L & B on L & C on L;

theorem 
  {A,B} on P iff A on P & B on P;

theorem 
  {A,B,C} on P iff A on P & B on P & C on P;

theorem 
  {A,B,C,D} on P iff A on P & B on P & C on P & D on P;

theorem 
  G c= F & F on L implies G on L;

theorem 
  G c= F & F on P implies G on P;

theorem 
  F on L & A on L iff F \/ {A} on L;

theorem 
  F on P & A on P iff F \/ {A} on P;

theorem 
  F \/ G on L iff F on L & G on L;

theorem 
  F \/ G on P iff F on P & G on P;

theorem 
  G c= F & F is linear implies G is linear;

theorem 
  G c= F & F is planar implies G is planar;



definition
  let S be IncProjStr;
  attr S is with_non-trivial_lines means


  for L being LINE of S ex A,B being POINT of S st A <> B & {A,B} on L;
  attr S is linear means


  for A,B being POINT of S ex L being LINE of S st {A,B} on L;
  attr S is up-2-rank means


  for A,B being POINT of S, K,L being LINE
  of S st A <> B & {A,B} on K & {A,B} on L holds K = L;
end;

definition
  let S be IncStruct;
  attr S is with_non-empty_planes means


  for P being PLANE of S ex A being POINT of S st A on P;
  attr S is planar means


  for A,B,C being POINT of S ex P being PLANE of S st {A,B,C} on P;
  attr S is with_<=1_plane_per_3_pts means


  for A,B,C being POINT of S,
  P,Q being PLANE of S st not {A,B,C} is linear & {A,B,C} on P & {A,B,C} on Q
  holds P = Q;
  attr S is with_lines_inside_planes means


  for L being LINE of S, P
being PLANE of S st ex A,B being POINT of S st A <> B & {A,B} on L & {A,B} on P
  holds L on P;
  attr S is with_planes_intersecting_in_2_pts means


  for A being POINT
of S, P,Q being PLANE of S st A on P & A on Q ex B being POINT of S st A <> B &
  B on P & B on Q;
  attr S is up-3-dimensional means


  ex A,B,C,D being POINT of S st not {A,B,C,D} is planar;
  attr S is inc-compatible means


  for A being POINT of S, L being LINE
  of S, P being PLANE of S st A on L & L on P holds A on P;
end;

definition
  let IT be IncStruct;
  attr IT is IncSpace-like means


  IT is with_non-trivial_lines linear
  up-2-rank with_non-empty_planes planar with_<=1_plane_per_3_pts
  with_lines_inside_planes with_planes_intersecting_in_2_pts up-3-dimensional
  inc-compatible;
end;

reserve a,b,c for Element of {0,1,2,3};

registration
  cluster IncSpace-like -> with_non-trivial_lines linear up-2-rank
with_non-empty_planes planar with_<=1_plane_per_3_pts with_lines_inside_planes
with_planes_intersecting_in_2_pts up-3-dimensional inc-compatible for
IncStruct;
end;

registration
  cluster strict IncSpace-like for IncStruct;
end;

definition
  mode IncSpace is IncSpace-like IncStruct;
end;

reserve S for IncSpace;
reserve A,B,C,D,E for POINT of S;
reserve K,L,L1,L2 for LINE of S;
reserve P,P1,P2,Q for PLANE of S;
reserve F for Subset of the Points of S;



theorem 
  F on L & L on P implies F on P;



theorem 
  {A,A,B} is linear;

theorem 
  {A,A,B,C} is planar;

theorem 
  {A,B,C} is linear implies {A,B,C,D} is planar;

theorem 
  A <> B & {A,B} on L & not C on L implies not {A,B,C} is linear;

theorem 
  not {A,B,C} is linear & {A,B,C} on P & not D on P implies not {A
  ,B,C,D} is planar;

theorem 
  not(ex P st K on P & L on P) implies K <> L;

theorem 
  not(ex P st L on P & L1 on P & L2 on P) & (ex A st A on L & A on L1 &
  A on L2) implies L <> L1;

theorem 
  L1 on P & L2 on P & not L on P & L1 <> L2 implies not(ex Q st L on Q &
  L1 on Q & L2 on Q);



theorem 
  (ex A st A on K & A on L) implies ex P st K on P & L on P;

theorem 
  A <> B implies ex L st for K holds {A,B} on K iff K = L;

theorem 
  not {A,B,C} is linear implies ex P st for Q holds {A,B,C} on Q iff P = Q;

theorem 
  not A on L implies ex P st for Q holds A on Q & L on Q iff P = Q;

theorem 
  K <>L & (ex A st A on K & A on L) implies ex P st for Q holds K
  on Q & L on Q iff P = Q;



definition
  let S;
  let A,B;
  assume
 A <> B;
  func Line(A,B) -> LINE of S means


  {A,B} on it;
end;

definition
  let S;
  let A,B,C;
  assume
 not {A,B,C} is linear;
  func Plane(A,B,C) -> PLANE of S means


  {A,B,C} on it;
end;

definition
  let S;
  let A,L;
  assume
 not A on L;
  func Plane(A,L) -> PLANE of S means


  A on it & L on it;
end;

definition
  let S;
  let K,L;
  assume that
 K <> L and
 ex A st A on K & A on L;
  func Plane(K,L) -> PLANE of S means


  K on it & L on it;
end;



theorem 
  A <> B implies Line(A,B) = Line(B,A);

theorem 
  not {A,B,C} is linear implies Plane(A,B,C) = Plane(A,C,B);

theorem 
  not {A,B,C} is linear implies Plane(A,B,C) = Plane(B,A,C);

theorem 
  not {A,B,C} is linear implies Plane(A,B,C) = Plane(B,C,A);

theorem 
  not {A,B,C} is linear implies Plane(A,B,C) = Plane(C,A,B);

theorem 
  not {A,B,C} is linear implies Plane(A,B,C) = Plane(C,B,A);

theorem 
  K <> L & (ex A st A on K & A on L) implies Plane(K,L) = Plane(L,K);

theorem 
  A <> B & C on Line(A,B) implies {A,B,C} is linear;

theorem 
  A <> B & A <> C & {A,B,C} is linear implies Line(A,B) = Line(A,C);

theorem 
  not {A,B,C} is linear implies Plane(A,B,C) = Plane(C,Line(A,B));

theorem 
  not {A,B,C} is linear & D on Plane(A,B,C) implies {A,B,C,D} is planar;

theorem 
  not C on L & {A,B} on L & A <> B implies Plane(C,L) = Plane(A,B,C);

theorem 
  not {A,B,C} is linear implies Plane(A,B,C) = Plane(Line(A,B),Line(A,C) );



theorem 
  ex A,B,C st {A,B,C} on P & not {A,B,C} is linear;



theorem 
  ex A,B,C,D st A on P & not {A,B,C,D} is planar;

theorem 
  ex B st A <> B & B on L;

theorem 
  A <> B implies ex C st C on P & not {A,B,C} is linear;

theorem 
  not {A,B,C} is linear implies ex D st not {A,B,C,D} is planar;

theorem 
  ex B,C st {B,C} on P & not {A,B,C} is linear;

theorem 
  A <> B implies ex C,D st not {A,B,C,D} is planar;

theorem 
  ex B,C,D st not {A,B,C,D} is planar;

theorem 
  ex L st not A on L & L on P;

theorem 
  A on P implies ex L,L1,L2 st L1 <> L2 & L1 on P & L2 on P & not
  L on P & A on L & A on L1 & A on L2;

theorem 
  ex L,L1,L2 st A on L & A on L1 & A on L2 & not(ex P st L on P & L1 on
  P & L2 on P);

theorem 
  ex P st A on P & not L on P;

theorem 
  ex A st A on P & not A on L;

theorem 
  ex K st not(ex P st L on P & K on P);

theorem 
  ex P,Q st P <> Q & L on P & L on Q;



theorem 
  not L on P & {A,B} on L & {A,B} on P implies A = B;

theorem 
  P <> Q implies not(ex A st A on P & A on Q) or ex L st for B holds B
  on P & B on Q iff B on L;














begin

definition
  struct(1-sorted) TopStruct (# carrier -> set, topology -> Subset-Family of
    the carrier #);
end;

reserve T for TopStruct;





definition
  let IT be TopStruct;
  attr IT is TopSpace-like means


  the carrier of IT in the topology of
IT & (for a being Subset-Family of IT st a c= the topology of IT holds union a
in the topology of IT) & for a,b being Subset of IT st a in the topology of IT
  & b in the topology of IT holds a /\ b in the topology of IT;
end;

registration
  cluster non empty strict TopSpace-like for TopStruct;
end;

definition
  mode TopSpace is TopSpace-like TopStruct;
end;

definition
  let S be 1-sorted;
  mode Point of S is Element of S;
end;

registration
  let T be TopSpace;
  cluster the topology of T -> non empty;
end;

reserve GX for TopSpace;

theorem 
  {} in the topology of GX;

theorem 
  for T being 1-sorted, P being Subset of T holds P \/ P` = [#]T;

theorem 
  for T being 1-sorted, P being Subset of T holds [#]T \ ([#]T \ P ) = P;

theorem 
  for T being 1-sorted, P being Subset of T holds P <> [#]T iff [#]T \ P <> {};

theorem 
  for T being 1-sorted, P,Q being Subset of T st [#]T = P \/ Q & P
  misses Q holds Q = [#]T \ P;

theorem 
  for T being 1-sorted holds [#]T = ({}T)`;

definition
  let T be TopStruct, P be Subset of T;

  attr P is open means


  P in the topology of T;
end;

definition
  let T be TopStruct, P be Subset of T;
  attr P is closed means


  [#]T \ P is open;
end;

definition

  let T be TopStruct;
  mode SubSpace of T -> TopStruct means


    [#]it c= [#]T & for P being
Subset of it holds P in the topology of it iff ex Q being Subset of T st Q in
    the topology of T & P = Q /\ [#]it;
end;

registration
  let T be TopStruct;
  cluster strict for SubSpace of T;
end;

registration
  let T be non empty TopStruct;
  cluster strict non empty for SubSpace of T;
end;

registration
  let T be TopSpace;
  cluster -> TopSpace-like for SubSpace of T;
end;

definition
  let T be TopStruct, P be Subset of T;
  func T|P -> strict SubSpace of T means


  [#]it = P;
end;

registration
  let T be non empty TopStruct, P be non empty Subset of T;
  cluster T|P -> non empty;
end;

registration
  let T be TopSpace;
  cluster TopSpace-like strict for SubSpace of T;
end;

registration
  let T be TopSpace, P be Subset of T;
  cluster T|P -> TopSpace-like;
end;

theorem 
  for S being TopSpace, P1,P2 being Subset of S, P19 being Subset of S|
  P2 st P1=P19 & P1 c= P2 holds S|P1=(S|P2)|P19;

theorem 
  for GX being TopStruct, A being Subset of GX holds the carrier of (GX|A) = A;

theorem 
  for X being TopStruct,Y being non empty TopStruct, f being Function of
  X,Y, P being Subset of X holds f|P is Function of X|P,Y;

definition
  let S, T be TopStruct, f be Function of S,T;

  attr f is continuous means


  for P1 being Subset of T st P1 is closed holds f" P1 is closed;
end;

theorem 
  for T1, T2, S1, S2 being TopStruct st the TopStruct of T1 = the
  TopStruct of T2 & the TopStruct of S1 = the TopStruct of S2 holds S1 is
  SubSpace of T1 implies S2 is SubSpace of T2;

theorem 
  for X9 being SubSpace of T, A being Subset of X9 holds A is Subset of T;

theorem 
  for A being Subset of T st A <> {}T ex x being Point of T st x in A;

registration
  let T be TopSpace;
  cluster [#]T -> closed;
end;

registration
  let T be TopSpace;
  cluster closed for Subset of T;
end;

registration
  let T be non empty TopSpace;
  cluster non empty closed for Subset of T;
end;

theorem 
  for X9 being SubSpace of T, B being Subset of X9 holds B is
  closed iff ex C being Subset of T st C is closed & C /\ [#](X9) = B;

theorem 
  for F being Subset-Family of GX st for A being Subset of GX st A
  in F holds A is closed holds meet F is closed;





definition
  let GX be TopStruct, A be Subset of GX;
  func Cl A -> Subset of GX means


  for p being set st p in the carrier
  of GX holds p in it iff for G being Subset of GX st G is open holds p in G
  implies A meets G;
  projectivity;
end;

theorem 
  for A being Subset of T, p being set st p in the carrier of T
  holds p in Cl A iff for C being Subset of T st C is closed holds (A c= C
  implies p in C);

theorem 
  for A being Subset of GX ex F being Subset-Family of GX st (for
  C being Subset of GX holds C in F iff C is closed & A c= C) & Cl A = meet F;

theorem 
  for X9 being SubSpace of T, A being Subset of T, A1 being Subset of X9
  st A = A1 holds Cl A1 = (Cl A) /\ ([#]X9);

theorem 
  for A being Subset of T holds A c= Cl A;

theorem 
  for A,B being Subset of T st A c= B holds Cl A c= Cl B;

theorem 
  for A,B being Subset of GX holds Cl(A \/ B) = Cl A \/ Cl B;

theorem 
  for A, B being Subset of T holds Cl (A /\ B) c= (Cl A) /\ Cl B;

theorem 
  for A being Subset of T holds (A is closed implies Cl A = A) & (
  T is TopSpace-like & Cl A = A implies A is closed);

theorem 
  for A being Subset of T holds (A is open implies Cl([#](T) \ A) = [#](
T) \ A) & (T is TopSpace-like & Cl([#](T) \ A) = [#](T) \ A implies A is open);

theorem 
  for A being Subset of T, p being Point of T holds p in Cl A iff T is
non empty & for G being Subset of T st G is open holds p in G implies A meets G
;

begin 


theorem 
  for T being non empty TopStruct, A being non empty SubSpace of T for p
  being Point of A holds p is Point of T;

theorem 
  for A,B,C being TopSpace for f being Function of A,C holds f is
  continuous & C is SubSpace of B implies for h being Function of A,B st h = f
  holds h is continuous;

theorem 
  for A being TopSpace, B being non empty TopSpace for f being Function
  of A,B for C being SubSpace of B holds f is continuous implies for h being
  Function of A,C st h = f holds h is continuous;

registration
  let T be TopSpace;
  cluster empty -> closed for Subset of T;
end;



registration
  let X be TopSpace, Y be non empty TopStruct;
  let y be Point of Y;
  cluster X --> y -> continuous;
end;

registration
  let S be TopSpace;
  let T be non empty TopSpace;
  cluster continuous for Function of S, T;
end;

reserve T for TopStruct,
  x,y for Point of T;



definition
  let T;
  attr T is T_0 means

  for x,y st for G being Subset of T st G is open holds x
  in G iff y in G holds x = y;
  attr T is T_1 means


  for p,q being Point of T st p <> q ex G being
  Subset of T st G is open & p in G & q in G`;
  attr T is T_2 means


  for p, q being Point of T st p <> q ex G1,G2
being Subset of T st G1 is open &G2 is open & p in G1 & q in G2 & G1 misses G2;
  attr T is regular means

  for p being Point of T, F being Subset of T st F is
  closed & p in F` ex G1,G2 being Subset of T st G1 is open & G2 is open & p in
  G1 & F c= G2 & G1 misses G2;
  attr T is normal means

  for F1,F2 being Subset of T st F1 is closed & F2 is
  closed & F1 misses F2 ex G1,G2 being Subset of T st G1 is open & G2 is open &
  F1 c= G1 & F2 c= G2 & G1 misses G2;
end;

definition
  let T;
  attr T is T_3 means


  T is T_1 regular;
  attr T is T_4 means


  T is T_1 normal;
end;

registration
  cluster T_3 -> T_1 regular for TopStruct;
  cluster T_1 regular -> T_3 for TopStruct;
  cluster T_4 -> T_1 normal for TopStruct;
  cluster T_1 normal -> T_4 for TopStruct;
end;

registration
  cluster T_1 for non empty TopSpace;
end;

registration
  cluster T_1 -> T_0 for TopStruct;
  cluster T_2 -> T_1 for TopStruct;
end;



registration
  let T be TopSpace;
  cluster the TopStruct of T -> TopSpace-like;
end;

registration
  let T be non empty TopStruct;
  cluster the TopStruct of T -> non empty;
end;

theorem 
  for T being TopStruct st the TopStruct of T is TopSpace-like holds T
  is TopSpace-like;

theorem 
  for T being TopStruct, S being SubSpace of the TopStruct of T holds S
  is SubSpace of T;

registration
  let T be TopSpace;
  cluster open for Subset of T;
end;

theorem 
  for T being TopSpace, X being set holds X is open Subset of T iff X is
  open Subset of the TopStruct of T;

theorem 
  for T being TopSpace, X being set holds X is closed Subset of T
  iff X is closed Subset of the TopStruct of T;

theorem 
  for S,T being TopSpace, f being Function of S,T, g being
  Function of the TopStruct of S, T st f = g holds f is continuous iff g is
  continuous;

theorem 
  for S,T being TopSpace, f being Function of S,T, g being
  Function of S, the TopStruct of T st f = g holds f is continuous iff g is
  continuous;

theorem 
  for S,T being TopSpace, f being Function of S,T, g being Function of
the TopStruct of S, the TopStruct of T st f = g holds f is continuous iff g is
  continuous;



registration
  let T be TopStruct, P be empty Subset of T;
  cluster T | P -> empty;
end;

theorem 
  for S,T being TopStruct holds S is SubSpace of T iff S is
  SubSpace of the TopStruct of T;

theorem 
  for X being Subset of T, Y being Subset of the TopStruct of T st X = Y
  holds the TopStruct of T|X = (the TopStruct of T)|Y;



registration
 cluster strict empty for TopStruct;
end;



registration
  let A be non empty set, t be Subset-Family of A;
  cluster TopStruct(#A,t#) -> non empty;
end;



registration
  cluster empty -> T_0 for TopStruct;
end;

registration
  cluster strict empty for TopSpace;
end;















begin 

reserve X,Y,x,y for set;

definition
  struct(1-sorted) RelStr (# carrier -> set, InternalRel -> Relation of the
    carrier #);
end;

registration
  let X be non empty set;
  let R be Relation of X;
  cluster RelStr(#X,R#) -> non empty;
end;

definition
  let A be RelStr;

  attr A is total means


  the InternalRel of A is total;
  attr A is reflexive means


  the InternalRel of A is_reflexive_in the carrier of A;
  attr A is transitive means


  the InternalRel of A is_transitive_in the carrier of A;
  attr A is antisymmetric means


  the InternalRel of A is_antisymmetric_in the carrier of A;
end;

registration
  cluster reflexive transitive antisymmetric strict total 1-element for RelStr;
end;

registration
  cluster reflexive -> total for RelStr;
end;

definition
  mode Poset is reflexive transitive antisymmetric RelStr;
end;

registration
  let A be total RelStr;
  cluster the InternalRel of A -> total;
end;

registration
  let A be reflexive RelStr;
  cluster the InternalRel of A -> reflexive;
end;

registration
  let A be total antisymmetric RelStr;
  cluster the InternalRel of A -> antisymmetric;
end;

registration
  let A be total transitive RelStr;
  cluster the InternalRel of A -> transitive;
end;

registration
  let X be set;
  let O be total reflexive Relation of X;
  cluster RelStr(#X,O#) -> reflexive;
end;

registration
  let X be set;
  let O be total transitive Relation of X;
  cluster RelStr(#X,O#) -> transitive;
end;

registration
  let X be set;
  let O be total antisymmetric Relation of X;
  cluster RelStr(#X,O#) -> antisymmetric;
end;

reserve A for non empty Poset;
reserve a,a1,a2,a3,b,c for Element of A;
reserve S,T for Subset of A;

definition
  let A be RelStr;
  let a1,a2 be Element of A;

  pred a1 <= a2 means


  [a1,a2] in the InternalRel of A;
end;

notation
  let A be RelStr;
  let a1,a2 be Element of A;
  synonym a2 >= a1 for a1 <= a2;
end;

definition
  let A be RelStr;
  let a1,a2 be Element of A;
  pred a1 < a2 means


  a1 <= a2 & a1 <> a2;
  irreflexivity;
end;

notation
  let A be RelStr;
  let a1,a2 be Element of A;
  synonym a2 > a1 for a1 < a2;
end;

theorem 
  for A being reflexive non empty RelStr, a being Element of A holds a <= a;

definition
  let A be reflexive non empty RelStr;
  let a1,a2 be Element of A;
  redefine pred a1 <= a2;
  reflexivity;
end;

theorem 
  for A being antisymmetric RelStr, a1,a2 being Element of A st a1
  <= a2 & a2 <= a1 holds a1 = a2;

theorem 
  for A being transitive RelStr, a1,a2,a3 being Element of A holds
  a1 <= a2 & a2 <= a3 implies a1 <= a3;

theorem 
  for A being antisymmetric RelStr, a1,a2 being Element of A holds
  not(a1 < a2 & a2 < a1);

theorem 
  for A being transitive antisymmetric RelStr for a1,a2,a3 being
  Element of A holds a1 < a2 & a2 < a3 implies a1 < a3;

theorem 
  for A being antisymmetric RelStr, a1,a2 being Element of A holds
  a1 <= a2 implies not a2 < a1;

theorem 
  for A being transitive antisymmetric RelStr for a1,a2,a3 being
  Element of A holds a1 < a2 & a2 <= a3 or a1 <= a2 & a2 < a3 implies a1 < a3;





definition
  let A be RelStr;
  let IT be Subset of A;
  attr IT is strongly_connected means


  the InternalRel of A is_strongly_connected_in IT;
end;

registration
  let A be RelStr;
  cluster empty -> strongly_connected for Subset of A;
end;

registration
  let A be RelStr;
  cluster strongly_connected for Subset of A;
end;

definition
  let A be RelStr;
  mode Chain of A is strongly_connected Subset of A;
end;

theorem 
  for A being non empty reflexive RelStr for a being Element of A
  holds {a} is Chain of A;

theorem 
  for A being non empty reflexive RelStr, a1,a2 being Element of A
  holds {a1,a2} is Chain of A iff a1 <= a2 or a2 <= a1;

theorem 
  for A being RelStr, C being Chain of A, S being Subset of A holds S c=
  C implies S is Chain of A;

theorem 
  for A being reflexive RelStr, a1,a2 being Element of A holds (ex
  C being Chain of A st a1 in C & a2 in C) iff a1 <= a2 or a2 <= a1;

theorem 
  for A being reflexive antisymmetric RelStr, a1,a2 being Element
of A holds (ex C being Chain of A st a1 in C & a2 in C) iff (a1 < a2 iff not a2
  <= a1);

theorem 
  for A being RelStr, T being Subset of A holds the InternalRel of
  A well_orders T implies T is Chain of A;





definition
  let A;
  let S;
  func UpperCone(S) -> Subset of A equals

  {a1 : for a2 st a2 in S holds a2 <
  a1};
end;

definition
  let A;
  let S;
  func LowerCone(S) -> Subset of A equals

  {a1 : for a2 st a2 in S holds a1 <
  a2};
end;

theorem 
  UpperCone({}(A)) = the carrier of A;

theorem 
  UpperCone([#](A)) = {};

theorem 
  LowerCone({}(A)) = the carrier of A;

theorem 
  LowerCone([#](A)) = {};

theorem 
  a in S implies not a in UpperCone(S);

theorem 
  not a in UpperCone{a};

theorem 
  a in S implies not a in LowerCone(S);

theorem 
  not a in LowerCone{a};

theorem 
  c < a iff a in UpperCone{c};

theorem 
  a < c iff a in LowerCone{c};





definition
  let A;
  let S;
  let a;
  func InitSegm(S,a) -> Subset of A equals

  LowerCone{a} /\ S;
end;

definition
  let A;
  let S;
  mode Initial_Segm of S -> Subset of A means


    ex a st a in S & it = InitSegm(S,a) if S <> {} otherwise it = {};
end;

theorem 
  a in InitSegm(S,b) iff a < b & a in S;

theorem 
  InitSegm({}(A),a) = {};

theorem 
  not a in InitSegm(S,a);

theorem 
  a1 < a2 implies InitSegm(S,a1) c= InitSegm(S,a2);

theorem 
  S c= T implies InitSegm(S,a) c= InitSegm(T,a);

theorem 
  for I being Initial_Segm of S holds I c= S;

theorem 
  S <> {} iff not S is Initial_Segm of S;

theorem 
  S <> {} & S is Initial_Segm of T implies not T is Initial_Segm of S;

theorem 
  a1 < a2 & a1 in S & a2 in T & T is Initial_Segm of S implies a1 in T;

theorem 
  a in S & S is Initial_Segm of T implies InitSegm(S,a) = InitSegm (T,a);

theorem 
  S c= T & the InternalRel of A well_orders T & (for a1,a2 st a2 in S &
  a1 < a2 holds a1 in S) implies S = T or S is Initial_Segm of T;

theorem 
  S c= T & the InternalRel of A well_orders T & (for a1,a2 st a2
in S & a1 in T & a1 < a2 holds a1 in S) implies S = T or S is Initial_Segm of T
;





reserve f for Choice_Function of BOOL(the carrier of A);

definition
  let A;
  let f;
  mode Chain of f -> Chain of A means


    it <> {} & the InternalRel of A
    well_orders it & for a st a in it holds f.UpperCone(InitSegm(it,a)) = a;
end;

reserve fC,fC1,fC2 for Chain of f;

theorem 
  {f.(the carrier of A)} is Chain of f;

theorem 
  f.(the carrier of A) in fC;

theorem 
  a in fC & b = f.(the carrier of A) implies b <= a;

theorem 
  a = f.(the carrier of A) implies InitSegm(fC,a) = {};

theorem 
  fC1 meets fC2;

theorem 
  fC1 <> fC2 implies (fC1 is Initial_Segm of fC2 iff not fC2 is
  Initial_Segm of fC1);

theorem 
  fC1 c< fC2 iff fC1 is Initial_Segm of fC2;

definition
  let A;
  let f;
  func Chains f -> set means


  x in it iff x is Chain of f;
end;

registration
  let A;
  let f;
  cluster Chains f -> non empty;
end;

theorem 
  union(Chains(f)) <> {};

theorem 
  fC <> union(Chains(f)) & S = union(Chains(f)) implies fC is Initial_Segm of S
;

theorem 
  union(Chains(f)) is Chain of f;

begin 

reserve R for Relation,
  A for non empty Poset,
  C for Chain of A,
  S for Subset of A,
  a,a1,a2,b,c1,c2 for Element of A;





theorem 
  field((the InternalRel of A) |_2 S) = S;

theorem 
  (the InternalRel of A) |_2 S is being_linear-order implies S is Chain of A;

theorem 
  (the InternalRel of A) |_2 C is being_linear-order;

theorem 
  the InternalRel of A linearly_orders S implies S is Chain of A;

theorem 
  the InternalRel of A linearly_orders C;

theorem 
  a is_minimal_in the InternalRel of A iff for b holds not b < a;

theorem 
  a is_maximal_in the InternalRel of A iff for b holds not a < b;

theorem 
  a is_superior_of the InternalRel of A iff for b st a <> b holds b < a;

theorem 
  a is_inferior_of the InternalRel of A iff for b st a <> b holds a < b;





theorem 
  (for C ex a st for b st b in C holds b <= a) implies ex a st
  for b holds not a < b;

theorem 
  (for C ex a st for b st b in C holds a <= b) implies ex a st for b
  holds not b < a;



registration
  cluster strict empty for RelStr;
end;















begin

reserve x, y, z, v for set,
  n, m, k for Element of NAT;

definition
  struct(2-sorted) MultiGraphStruct (# carrier, carrier' -> set,
    Source, Target -> Function of the carrier', the carrier #);
end;

definition
  let G be MultiGraphStruct;
  mode Vertex of G is Element of G;
  mode Edge of G is Element of the carrier' of G;
end;

registration
  cluster strict non empty non void for MultiGraphStruct;
end;

definition
  mode Graph is non empty MultiGraphStruct;
end;

reserve G, G1, G2, G3 for Graph;



definition
  let C be MultiGraphStruct, f be Edge of C;
  func dom f -> Vertex of C equals

 (the Source of C).f if C is non void non empty
    otherwise the Vertex of C;
  func cod f -> Vertex of C equals

 (the Target of C).f if C is non void non empty
    otherwise the Vertex of C;
end;

definition
  let C be non void non empty MultiGraphStruct, f be Edge of C;
  redefine func dom f -> Vertex of C equals

(the Source of C).f;
  redefine func cod f -> Vertex of C equals

(the Target of C).f;
end;

definition
  let G1, G2;
  assume that
 (the Source of G1) tolerates (the Source of G2) and
 (the Target of G1) tolerates (the Target of G2);
  func G1 \/ G2 -> strict Graph means


  the carrier of it = (the carrier of G1) \/ (the carrier of G2) &
  the carrier' of it = (the carrier' of G1) \/ (the carrier' of G2) &
  (for v st v in the carrier' of G1 holds
  (the Source of it).v = (the Source of G1).v &
  (the Target of it).v = (the Target of G1).v) &
  for v st v in the carrier' of G2 holds
  (the Source of it).v = (the Source of G2).v &
  (the Target of it).v = (the Target of G2).v;
end;

definition
  let G, G1, G2 be Graph;
  pred G is_sum_of G1, G2 means


  (the Target of G1) tolerates (the Target of G2) &
  (the Source of G1) tolerates (the Source of G2) &
  the MultiGraphStruct of G = G1 \/ G2;
end;

definition
  let IT be Graph;
  attr IT is oriented means


  for x,y st x in the carrier' of IT & y in the carrier' of IT &
  (the Source of IT).x = (the Source of IT).y &
  (the Target of IT).x = (the Target of IT).y holds x = y;
  attr IT is non-multi means


  for x,y st x in the carrier' of IT & y in the carrier' of IT &
  ( (the Source of IT).x = (the Source of IT).y &
  (the Target of IT).x = (the Target of IT).y or
  (the Source of IT).x = (the Target of IT).y &
  (the Source of IT).y = (the Target of IT).x ) holds x = y;
  attr IT is simple means


  not ex x st x in the carrier' of IT &
  (the Source of IT).x = (the Target of IT).x;
  attr IT is connected means


  not ex G1, G2 being Graph st
  the carrier of G1 misses the carrier of G2 & IT is_sum_of G1, G2;
end;

definition
  let IT be MultiGraphStruct;
  attr IT is finite means


  the carrier of IT is finite & the carrier' of IT is finite;
end;

registration
  cluster finite for MultiGraphStruct;
  cluster finite non-multi oriented simple connected for Graph;
end;

registration
  let G be finite MultiGraphStruct;
  cluster the carrier of G -> finite;
  cluster the carrier' of G -> finite;
end;

reserve x, y for Element of (the carrier of G);

definition
  let G;
  let x, y;
  let v;
  pred v joins x, y means

  (the Source of G).v = x & (the Target of G).v = y or
  (the Source of G).v = y & (the Target of G).v = x;
end;

definition
  let G;
  let x,y be Element of (the carrier of G);
  pred x,y are_incident means

  ex v being set st v in the carrier' of G & v joins x, y;
end;

definition
  let G be Graph;
  mode Chain of G -> FinSequence means


    (for n st 1 <= n & n <= len it holds it.n in the carrier' of G) &
    ex p being FinSequence st len p = len it + 1 &
    (for n st 1 <= n & n <= len p holds p.n in the carrier of G) &
    for n st 1 <= n & n <= len it
    ex x9, y9 being Vertex of G st
    x9 = p.n & y9 = p.(n+1) & it.n joins x9, y9;
end;

definition
  let G be Graph;
  redefine mode Chain of G -> FinSequence of the carrier' of G;
end;

definition
  let G be Graph;
  let IT be Chain of G;
  attr IT is oriented means

  for n st 1 <= n & n < len IT holds
  (the Source of G).(IT.(n+1)) = (the Target of G).(IT.n);
end;

registration
  let G be Graph;
  cluster empty for Chain of G;
end;

registration
  let G be Graph;
  cluster empty -> oriented for Chain of G;
end;

definition
  let G be Graph;
  let IT be Chain of G;
  redefine attr IT is one-to-one means

  for n, m st 1 <= n & n < m & m <= len IT holds IT.n <> IT.m;
end;

definition
  let G be Graph;
  mode Path of G is one-to-one Chain of G;
end;

definition
  let G be Graph;
  mode OrientedPath of G is one-to-one oriented Chain of G;
end;

definition
  let G be Graph;
  let IT be Path of G;

  attr IT is cyclic means

  ex p being FinSequence st len p = len IT + 1 &
  (for n st 1 <= n & n <= len p holds p.n in the carrier of G) &
  (for n st 1 <= n & n <= len IT
  ex x9, y9 being Vertex of G st
  x9 = p.n & y9 = p.(n+1) & IT.n joins x9, y9) & p.1 = p.(len p);
end;

registration
  let G be Graph;
  cluster empty -> cyclic for Path of G;
end;

definition
  let G be Graph;
  mode Cycle of G is cyclic Path of G;
end;

definition
  let G be Graph;
  mode OrientedCycle of G is cyclic OrientedPath of G;
end;

definition
  let G be Graph;

  mode Subgraph of G -> Graph means


    the carrier of it c= the carrier of G &
    the carrier' of it c= the carrier' of G &
    for v st v in the carrier' of it holds
    (the Source of it).v = (the Source of G).v &
    (the Target of it).v = (the Target of G).v &
    (the Source of G).v in the carrier of it &
    (the Target of G).v in the carrier of it;
end;

registration
  let G be Graph;
  cluster strict for Subgraph of G;
end;

definition
  let G be finite Graph;
  func VerticesCount G -> Element of NAT means

  ex B being finite set st B = the carrier of G & it = card B;
  func EdgesCount G -> Element of NAT means

  ex B being finite set st B = the carrier' of G & it = card B;
end;

definition
  let G be finite Graph;
  let x be Vertex of G;
  func EdgesIn x -> Element of NAT means

  ex X being finite set st (for z being set holds
  z in X iff z in the carrier' of G & (the Target of G).z = x) & it = card(X);
  func EdgesOut x -> Element of NAT means

  ex X being finite set st (for z being set holds
  z in X iff z in the carrier' of G & (the Source of G).z = x) & it = card(X);
end;

definition
  let G be finite Graph;
  let x be Vertex of G;
  func Degree x -> Element of NAT equals

  EdgesIn(x) + EdgesOut(x);
end;

definition
  let G1, G2 be Graph;
  pred G1 c= G2 means


  G1 is Subgraph of G2;
  reflexivity;
end;

definition
  let G be Graph;
  func bool G -> set means


  for x being set holds x in it iff x is strict Subgraph of G;
end;

scheme 
 GraphSeparation{G() -> Graph, P[set]}: ex X being set st
  for x being set holds x in X iff x is strict Subgraph of G() & P[x];



theorem 
  for G being Graph holds dom(the Source of G) = the carrier' of G &
  dom(the Target of G) = the carrier' of G;

theorem 
  for x being Vertex of G holds x in the carrier of G;

theorem 
  for v being set holds v in the carrier' of G implies
  (the Source of G).v in the carrier of G &
  (the Target of G).v in the carrier of G;



theorem 
  for p being Chain of G holds p|Seg(n) is Chain of G;



theorem 
  G1 c= G implies (the Source of G1) c= (the Source of G) &
  (the Target of G1) c= (the Target of G);

theorem 
  (the Source of G1) tolerates (the Source of G2) &
  (the Target of G1) tolerates (the Target of G2) implies
  (the Source of (G1 \/ G2)) = (the Source of G1) \/ (the Source of G2) &
  (the Target of (G1 \/ G2)) = (the Target of G1) \/ (the Target of G2);

theorem 
  for G being strict Graph holds G = G \/ G;

theorem 
  (the Source of G1) tolerates (the Source of G2) &
  (the Target of G1) tolerates (the Target of G2) implies G1 \/ G2 = G2 \/ G1;

theorem 
  (the Source of G1) tolerates (the Source of G2) &
  (the Target of G1) tolerates (the Target of G2) &
  (the Source of G1) tolerates (the Source of G3) &
  (the Target of G1) tolerates (the Target of G3) &
  (the Source of G2) tolerates (the Source of G3) &
  (the Target of G2) tolerates (the Target of G3) implies
  (G1 \/ G2) \/ G3 = G1 \/ (G2 \/ G3);

theorem 
  G is_sum_of G1, G2 implies G is_sum_of G2, G1;

theorem 
  for G being strict Graph holds G is_sum_of G, G;



theorem 
  (ex G st G1 c= G & G2 c= G) implies G1 \/ G2 = G2 \/ G1;

theorem 
  (ex G st G1 c= G & G2 c= G & G3 c= G) implies (G1 \/ G2) \/ G3 = G1 \/ ( G2
  \/ G3);

theorem 
  {} is Chain of G;

theorem 
  for H1, H2 being strict Subgraph of G st
  the carrier of H1 = the carrier of H2 &
  the carrier' of H1 = the carrier' of H2
  holds H1 = H2;

theorem 
  for G1,G2 being strict Graph holds G1 c= G2 & G2 c= G1 implies G1 = G2;

theorem 
  G1 c= G2 & G2 c= G3 implies G1 c= G3;

theorem 
  G is_sum_of G1, G2 implies G1 c= G & G2 c= G;

theorem 
  (the Source of G1) tolerates (the Source of G2) &
  (the Target of G1) tolerates (the Target of G2) implies
  G1 c= G1 \/ G2 & G2 c= G1 \/ G2;

theorem 
  (ex G st G1 c= G & G2 c= G) implies G1 c= G1 \/ G2 & G2 c= G1 \/ G2;

theorem 
  G1 c= G3 & G2 c= G3 & G is_sum_of G1, G2 implies G c= G3;

theorem 
  G1 c= G & G2 c= G implies (G1 \/ G2) c= G;

theorem 
  for G1,G2 being strict Graph holds
  G1 c= G2 implies G1 \/ G2 = G2 & G2 \/ G1 = G2;

theorem 
  (the Source of G1) tolerates (the Source of G2) &
  (the Target of G1) tolerates (the Target of G2) &
  (G1 \/ G2 = G2 or G2 \/ G1 = G2) implies G1 c= G2;

theorem 
  for G being oriented Graph st G1 c= G holds G1 is oriented;

theorem 
  for G being non-multi Graph st G1 c= G holds G1 is non-multi;

theorem 
  for G being simple Graph st G1 c= G holds G1 is simple;



theorem 
  for G1 being strict Graph holds G1 in bool G iff G1 c= G;

theorem 
  for G being strict Graph holds G in bool G;

theorem 
  for G1 being strict Graph holds G1 c= G2 iff bool G1 c= bool G2;

theorem 
  for G being strict Graph holds { G } c= bool G;

theorem 
  for G1,G2 being strict Graph holds
  (the Source of G1) tolerates (the Source of G2) &
  (the Target of G1) tolerates (the Target of G2) &
  bool (G1 \/ G2) c= (bool G1) \/ (bool G2) implies G1 c= G2 or G2 c= G1;

theorem 
  (the Source of G1) tolerates (the Source of G2) &
  (the Target of G1) tolerates (the Target of G2) implies
  bool G1 \/ bool G2 c= bool (G1 \/ G2);

theorem 
  G1 in bool G & G2 in bool G implies (G1 \/ G2) in bool G;














begin 

definition
  struct(MultiGraphStruct) CatStr (# carrier,carrier' -> set,
     Source,Target -> Function of the carrier', the carrier,
     Comp -> PartFunc of [:the carrier', the carrier' :],the carrier' #);
end;

reserve C for CatStr;

definition
  let C;
  mode Object of C is Element of C;
  mode Morphism of C is Element of the carrier' of C;
end;

reserve f,g for Morphism of C;



registration
  cluster non void non empty for CatStr;
end;

definition
  let C,f,g;
  assume
 [g,f] in dom(the Comp of C);
  func g(*)f -> Morphism of C equals

 ( the Comp of C ).(g,f);
end;

definition
 canceled 2;
  let C be non void non empty CatStr, a,b be Object of C;
  func Hom(a,b) -> Subset of the carrier' of C equals

  {f where f is Morphism of C : dom f = a & cod f = b};
end;

reserve C for non void non empty CatStr,
  f,g for Morphism of C,
  a,b,c,d for Object of C;

theorem 
  f in Hom(a,b) iff dom(f)=a & cod(f)=b;

theorem 
  Hom(dom(f),cod(f)) <> {};

definition
  let C,a,b;
  assume
 Hom(a,b)<>{};
  mode Morphism of a,b -> Morphism of C means

 it in Hom(a,b);
end;

canceled;

theorem 
  for f being Morphism of C holds f is Morphism of dom(f),cod(f);

theorem 
  for f being Morphism of a,b st Hom(a,b) <> {} holds dom(f) = a & cod(f) = b;

theorem 
  for f being Morphism of a,b for h being Morphism of c,d st Hom(a,b) <>
  {} & Hom(c,d) <> {} & f = h holds a = c & b = d;

theorem 
  for f being Morphism of a,b st Hom(a,b) = {f} for g being
  Morphism of a,b holds f = g;

theorem 
  for f being Morphism of a,b st Hom(a,b) <> {} & for g being
  Morphism of a,b holds f = g holds Hom(a,b) = {f};

theorem 
  for f being Morphism of a,b st Hom(a,b),Hom(c,d) are_equipotent & Hom(
  a,b) = {f} holds ex h being Morphism of c,d st Hom(c,d) = {h};



definition
  let C be non empty non void CatStr;
  attr C is Category-like means


  for f,g being Morphism of C
   holds [g,f] in dom(the Comp of C) iff dom g = cod f;

  attr C is transitive means


   for f,g being Morphism of C st dom g = cod f
    holds dom(g(*)f) = dom f & cod(g(*)f) = cod g;

  attr C is associative means


   for f,g,h being Morphism of C
     st dom h = cod g & dom g = cod f
    holds h(*)(g(*)f) = (h(*)g)(*)f;

  attr C is reflexive means


   for b being Element of C holds Hom(b,b) <> {};

  attr C is with_identities means


  for a being Element of C
   ex i being Morphism of a,a st
    for b being Element of C holds
     (Hom(a,b)<>{} implies for g being Morphism of a,b holds g(*)i = g) &
     (Hom(b,a)<>{} implies for f being Morphism of b,a holds i(*)f = f);
end;

definition
  let o,m be set;
  func 1Cat(o,m) -> strict CatStr equals

  CatStr(# {o},{m},m:->o,m:->o,(m,m):->m #);
end;

registration let o,m be set;
 cluster 1Cat(o,m) -> non empty trivial non void trivial';
end;

registration
 cluster non empty trivial -> transitive reflexive
    for non empty non void CatStr;
end;

registration
 cluster non void trivial' -> associative with_identities
    for non empty non void CatStr;
end;

registration let o,m be set;
 cluster 1Cat(o,m) -> Category-like;
end;

registration
  cluster reflexive transitive associative with_identities Category-like
   non void non empty strict for non empty non void CatStr;
end;

definition
  mode Category is reflexive transitive associative with_identities
   Category-like non void non empty CatStr;
end;

registration let C be reflexive non void non empty CatStr,
    a be Object of C;
 cluster Hom(a,a) -> non empty;
end;

definition
  let C be with_identities reflexive non void non empty CatStr,
     a be Object of C;
  func id a -> Morphism of a,a means

  for b being Object of C holds
     (Hom(a,b) <> {} implies
       for f being Morphism of a,b holds f(*)it = f)
   & (Hom(b,a) <> {} implies
     for f being Morphism of b,a holds it(*)f = f);
end;

canceled;

reserve o,m for set;

theorem 
  for a,b being Object of 1Cat(o,m) for f being Morphism of 1Cat(o,m)
   holds f in Hom(a,b);

theorem 
  for a,b being Object of 1Cat(o,m) for f being Morphism of 1Cat(o,m)
  holds f is Morphism of a,b;

theorem 
  for a,b being Object of 1Cat(o,m) holds Hom(a,b) <> {};

theorem 
  for a,b,c,d being Object of 1Cat(o,m) for f being Morphism of a,b for
  g being Morphism of c,d holds f=g;

reserve B,C,D for Category;
reserve a,b,c,d for Object of C;
reserve f,f1,f2,g,g1,g2 for Morphism of C;

theorem 
  dom(g) = cod(f) iff [g,f] in dom(the Comp of C);

theorem 
  dom(g) = cod(f) implies g(*)f = ( the Comp of C ).(g,f);

theorem 
  for f,g being Morphism of C st dom(g) = cod(f) holds dom(g(*)f) =
  dom(f) & cod(g(*)f) = cod(g);

theorem 
  for f,g,h being Morphism of C st dom(h) = cod(g) & dom(g) = cod(
  f) holds h(*)(g(*)f) = (h(*)g)(*)f;

canceled 2;

theorem 
  for f being Morphism of C st cod(f) = b holds (id b)(*)f = f;

theorem 
  for g being Morphism of C st dom(g) = b holds g(*)(id b) = g;

reserve f,f1,f2 for Morphism of a,b;
reserve f9 for Morphism of b,a;
reserve g for Morphism of b,c;
reserve h,h1,h2 for Morphism of c,d;

theorem 
  Hom(a,b)<>{} & Hom(b,c)<>{} implies g(*)f in Hom(a,c);

definition
  let C,a,b,c,f,g;
  assume
 Hom(a,b)<>{} & Hom(b,c)<>{};
  func g*f -> Morphism of a,c equals


  g(*)f;
end;

theorem 
  Hom(a,b)<>{} & Hom(b,c)<>{} implies Hom(a,c)<>{};

theorem 
  Hom(a,b)<>{} & Hom(b,c)<>{} & Hom(c,d)<>{} implies (h*g)*f=h*(g* f);

canceled;

theorem 
 id a in Hom(a,a);

theorem 
  Hom(a,b)<>{} implies (id b)*f=f;

theorem 
  Hom(b,c)<>{} implies g*(id b)=g;

registration let C,a; let f be Morphism of a,a;
 reduce f*id a to f;
 reduce (id a)*f to f;
end;

theorem 
  (id a)*(id a) = id a;



definition
  let C be Category, b,c be Object of C, g be Morphism of b,c;
  attr g is monic means

  Hom(b,c) <> {} &
   for a being Object of C st Hom(a,b) <> {}
  for f1,f2 being Morphism of a,b
   st g*f1=g*f2 holds f1=f2;
end;

definition
  let C be Category, a,b be Object of C, f be Morphism of a,b;
  attr f is epi means

 Hom(a,b) <> {} &
   for c being Object of C st Hom(b,c) <> {}
  for g1,g2 being Morphism of b,c st g1*f=g2*f holds g1=g2;
end;

definition
  let C be Category, a,b be Object of C, f be Morphism of a,b;
  attr f is invertible means

  Hom(a,b) <> {} & Hom(b,a) <> {} &
  ex g being Morphism of b,a st f*g = id b & g*f = id a;
end;

theorem 
  Hom(b,c) <> {} implies (g is monic iff for a for f1,f2 being
  Morphism of a,b st Hom(a,b)<>{} & g*f1=g*f2 holds f1=f2);

theorem 
  g is monic & h is monic implies h*g is monic;

theorem 
  Hom(b,c)<>{} & Hom(c,d)<>{} & h*g is monic implies g is monic;

theorem 
  for h being Morphism of a,b for g being Morphism of b,a st Hom(a,b) <>
  {} & Hom(b,a) <> {} & h*g = id b holds g is monic;

theorem 
  id b is monic;

theorem 
  Hom(a,b) <> {} implies (f is epi iff for c for g1,g2 being
  Morphism of b,c st Hom(b,c)<>{} & g1*f=g2*f holds g1=g2);

theorem 
  f is epi & g is epi implies g*f is epi;

theorem 
  Hom(a,b)<>{} & Hom(b,c)<>{} & g*f is epi implies g is epi;

theorem 
  for h being Morphism of a,b for g being Morphism of b,a st Hom(a,b) <>
  {} & Hom(b,a) <> {} & h*g = id b holds h is epi;

theorem 
  id b is epi;

theorem 
  Hom(a,b) <> {} implies (f is invertible iff Hom(b,a)<>{} & ex g
  being Morphism of b,a st f*g=id b & g*f=id a);

theorem 
  Hom(a,b) <> {} & Hom(b,a) <> {} implies for g1,g2 being Morphism
  of b,a st f*g1=id b & g2*f=id a holds g1=g2;

definition
  let C,a,b,f;
  assume that
 f is invertible;
  func f" -> Morphism of b,a means


  f*it = id b & it*f = id a;
end;

theorem 
  f is invertible implies f is monic & f is epi;

theorem 
  id a is invertible;

theorem 
  f is invertible & g is invertible implies g*f is invertible;

theorem 
  f is invertible implies f" is invertible;

theorem 
  f is invertible & g is invertible
  implies (g*f)" = f"*g";

definition
  let C,a;
  attr a is terminal means


  Hom(b,a)<>{} & ex f being Morphism of b,a
  st for g being Morphism of b,a holds f=g;
  attr a is initial means


  Hom(a,b)<>{} & ex f being Morphism of a,b st
  for g being Morphism of a,b holds f=g;
  let b;
  pred a,b are_isomorphic means

   ex f st f is invertible;
 reflexivity;
 symmetry;
end;

theorem 
  a,b are_isomorphic iff Hom(a,b)<>{} & Hom(b,a)<>{} & ex f,f9 st
  f*f9 = id b & f9*f = id a;

theorem 
  a is initial iff for b ex f being Morphism of a,b st Hom(a,b) = {f};

theorem 
  a is initial implies for h being Morphism of a,a holds id a = h;

theorem 
  a is initial & b is initial implies a,b are_isomorphic;

theorem 
  a is initial & a,b are_isomorphic implies b is initial;

theorem 
  b is terminal iff for a ex f being Morphism of a,b st Hom(a,b) = {f};

theorem 
  a is terminal implies for h being Morphism of a,a holds id a = h;

theorem 
  a is terminal & b is terminal implies a,b are_isomorphic;

theorem 
  b is terminal & a,b are_isomorphic implies a is terminal;

theorem 
  Hom(a,b) <> {} & a is terminal implies f is monic;

registration let C,a;
 reduce dom id a to a;
 reduce cod id a to a;
end;

theorem 
 dom id a = a & cod id a =a;

theorem 
 id a = id b implies a = b;

theorem 
  a,b are_isomorphic & b,c are_isomorphic implies a,c are_isomorphic;



definition
  let C,D;
  mode Functor of C,D -> Function of the carrier' of C,the carrier' of D means


    (for c being Element of C ex d being Element of D st it.id c = id d ) &
    (for f being Element of the carrier' of C
      holds it.(id dom f) = id dom(it.f) &
     it.(id cod f) = id cod(it.f)) &
     for f,g being Element of the carrier' of C
       st [g,f] in dom(the Comp of C)
     holds it.(g(*)f) = (it.g)(*)(it.f);
end;

theorem 
  for T being Function of the carrier' of C,the carrier' of D st
   (for c being Object of C ex d being Object of D st T.(id c) = id d) &
   (for f being Morphism of C
     holds T.(id dom f) = id dom (T.f) &
           T.(id cod f) = id cod (T.f)) &
   (for f,g being Morphism of C st dom g = cod f
     holds T.(g(*)f) = (T.g)(*)(T.f)) holds T is Functor of C,D;

theorem 
  for T being Functor of C,D for c being Object of C ex d being
  Object of D st T.(id c) = id d;

theorem 
  for T being Functor of C,D for f being Morphism of C
  holds T.(id dom f) = id dom (T.f) & T.(id cod f) = id cod (T.f);

theorem 
  for T being Functor of C,D for f,g being Morphism of C st dom g
  = cod f holds dom(T.g) = cod(T.f) & T.(g(*)f) = (T.g)(*)(T.f);

theorem 
  for T being Function of the carrier' of C,the carrier' of D for
F being Function of the carrier of C, the carrier of D st ( for c being Object
of C holds T.(id c) = id(F.c) ) & ( for f being Morphism of C holds F.(dom f) =
dom (T.f) & F.(cod f) = cod (T.f) ) & ( for f,g being Morphism of C st dom g =
  cod f holds T.(g(*)f) = (T.g)(*)(T.f)) holds T is Functor of C,D;



definition
  let C,D;
  let F be Function of the carrier' of C,the carrier' of D;
  assume
 for c being Element of C ex d being Element
 of D st F.id c = id d;
  func Obj(F) -> Function of the carrier of C,the carrier of D means


for c being Element of C for d being Element of D
  st F.id c = id d holds it.c = d;
end;

theorem 
  for T being Function of the carrier' of C,the carrier' of D st
  for c being Object of C ex d being Object of D st T.(id c) = id d for c being
  Object of C for d being Object of D st T.(id c) = id d holds (Obj T).c = d;

theorem 
  for T being Functor of C,D for c being Object of C for d being
  Object of D st T.(id c) = id d holds (Obj T).c = d;

theorem 
  for T being (Functor of C,D),c being Object of C holds T.(id c)
  = id((Obj T).c);

theorem 
  for T being (Functor of C,D), f being Morphism of C holds (Obj
  T).(dom f) = dom (T.f) & (Obj T).(cod f) = cod (T.f);

definition
  let C,D be Category;
  let T be Functor of C,D;
  let c be Object of C;
  func T.c -> Object of D equals

  (Obj T).c;
end;

theorem 
  for T being Functor of C,D for c being Object of C for d being Object
  of D st T.(id c) = id d holds T.c = d;

theorem 
  for T being (Functor of C, D),c being Object of C holds T.(id c) = id(
  T.c);

theorem 
  for T being (Functor of C, D), f being Morphism of C holds T.(dom f) =
  dom (T.f) & T.(cod f) = cod (T.f);

theorem 
  for T being Functor of B,C for S being Functor of C,D holds S*T
  is Functor of B,D;



definition
  let B,C,D;
  let T be Functor of B,C;
  let S be Functor of C,D;
  redefine func S*T -> Functor of B,D;
end;

theorem 
  id the carrier' of C is Functor of C,C;

theorem 
  for T being (Functor of B,C),S being (Functor of C,D),b being
  Object of B holds (Obj (S*T)).b = (Obj S).((Obj T).b);

theorem 
  for T being Functor of B,C for S being Functor of C,D for b being
  Object of B holds (S*T).b = S.(T.b);



definition
  let C;
  func id C -> Functor of C,C equals

  id the carrier' of C;
end;

theorem 
  for c being Object of C holds (Obj id C).c = c;

theorem 
  Obj id C = id the carrier of C;

theorem 
  for c being Object of C holds (id C).c = c;

definition
  let C,D be Category;
  let T be Functor of C,D;
  attr T is isomorphic means

  T is one-to-one & rng T = the carrier' of D & rng Obj T = the carrier of D;
  attr T is full means


  for c,c9 being Object of C st Hom(T.c,T.c9) <>
{} for g being Morphism of T.c,T.c9 holds Hom(c,c9) <> {} & ex f being Morphism
  of c,c9 st g = T.f;
  attr T is faithful means


  for c,c9 being Object of C st Hom(c,c9) <>
  {} for f1,f2 being Morphism of c,c9 holds T.f1 = T.f2 implies f1 = f2;
end;

theorem 
  id C is isomorphic;

theorem 
  for T being Functor of C,D for c,c9 being Object of C for f
  being set st f in Hom(c,c9) holds T.f in Hom(T.c,T.c9);

theorem 
  for T being Functor of C,D for c,c9 being Object of C st Hom(c,
  c9) <> {} for f being Morphism of c,c9 holds T.f in Hom(T.c,T.c9);

theorem 
  for T being Functor of C,D for c,c9 being Object of C st Hom(c,
  c9) <> {} for f being Morphism of c,c9 holds T.f is Morphism of T.c,T.c9;

theorem 
  for T being Functor of C,D for c,c9 being Object of C st Hom(c,
  c9) <> {} holds Hom(T.c,T.c9) <> {};

theorem 
  for T being Functor of B,C for S being Functor of C,D st T is full & S
  is full holds S*T is full;

theorem 
  for T being Functor of B,C for S being Functor of C,D st T is faithful
  & S is faithful holds S*T is faithful;

theorem 
  for T being Functor of C,D for c,c9 being Object of C holds T.:
  Hom(c,c9) c= Hom(T.c,T.c9);

definition
  let C,D be Category;
  let T be Functor of C,D;
  let c,c9 be Object of C;
  func hom(T,c,c9) -> Function of Hom(c,c9) , Hom(T.c,T.c9) equals

  T|Hom(c,c9);
end;

theorem 
  for T being Functor of C,D for c,c9 being Object of C st Hom(c,
  c9) <> {} for f being Morphism of c,c9 holds hom(T,c,c9).f = T.f;

theorem 
  for T being Functor of C,D holds T is full iff for c,c9 being Object
  of C holds rng hom(T,c,c9) = Hom(T.c,T.c9);

theorem 
  for T being Functor of C,D holds T is faithful iff for c,c9 being
  Object of C holds hom(T,c,c9) is one-to-one;















begin



definition
  let A, B be non empty set;
  let r be non empty Relation of A, B;
  redefine mode Element of r -> Element of [:A,B:];
end;



definition
  struct(2-sorted) PT_net_Str (# carrier, carrier' -> set,
       S-T_Arcs -> Relation of the carrier, the carrier',
       T-S_Arcs -> Relation of the carrier', the carrier #);
end;

definition let N be PT_net_Str;
 attr N is with_S-T_arc means

 the S-T_Arcs of N is non empty;
 attr N is with_T-S_arc means

 the T-S_Arcs of N is non empty;
end;

definition
 func TrivialPetriNet -> PT_net_Str equals

  PT_net_Str (# {{}}, {{}}, [#]({{}},{{}}), [#]({{}},{{}}) #);
end;

registration
 cluster TrivialPetriNet ->
  with_S-T_arc with_T-S_arc strict non empty non void;
end;

registration
 cluster non empty non void with_S-T_arc with_T-S_arc strict for PT_net_Str;
end;

registration let N be with_S-T_arc PT_net_Str;
 cluster the S-T_Arcs of N -> non empty;
end;

registration let N be with_T-S_arc PT_net_Str;
 cluster the T-S_Arcs of N -> non empty;
end;

definition
 mode Petri_net
  is non empty non void with_S-T_arc with_T-S_arc PT_net_Str;
end;

reserve PTN for Petri_net;



definition
  let PTN;
  mode place of PTN is Element of the carrier of PTN;
  mode places of PTN is Element of the carrier of PTN;
  mode transition of PTN is Element of the carrier' of PTN;
  mode transitions of PTN is Element of the carrier' of PTN;
  mode S-T_arc of PTN is Element of the S-T_Arcs of PTN;
  mode T-S_arc of PTN is Element of the T-S_Arcs of PTN;
end;



definition
  let PTN;
  let x be S-T_arc of PTN;
  redefine func x`1 -> place of PTN;
  redefine func x`2 -> transition of PTN;
end;



definition
  let PTN;
  let x be T-S_arc of PTN;
  redefine func x`1 -> transition of PTN;
  redefine func x`2 -> place of PTN;
end;



reserve S0 for Subset of the carrier of PTN;

definition
  let PTN, S0;
  func *'S0 -> Subset of the carrier' of PTN equals

  { t where t is
transition of PTN : ex f being T-S_arc of PTN, s being place of PTN st s in S0
  & f = [t,s] };
  func S0*' -> Subset of the carrier' of PTN equals

  { t where t is
transition of PTN : ex f being S-T_arc of PTN, s being place of PTN st s in S0
  & f = [s,t] };
end;

theorem 
  *'S0 = {f`1 where f is T-S_arc of PTN : f`2 in S0};

theorem 
  for x being set holds x in *'S0 iff ex f being T-S_arc of PTN, s
  being place of PTN st s in S0 & f = [x,s];

theorem 
  S0*' = {f`2 where f is S-T_arc of PTN : f`1 in S0};

theorem 
  for x being set holds x in S0*' iff ex f being S-T_arc of PTN, s
  being place of PTN st s in S0 & f = [s,x];



reserve T0 for Subset of the carrier' of PTN;

definition
  let PTN, T0;
  func *'T0 -> Subset of the carrier of PTN equals

  { s where s is place of PTN
: ex f being S-T_arc of PTN, t being transition of PTN st t in T0 & f = [s,t] }
  ;
  func T0*' -> Subset of the carrier of PTN equals

  { s where s is place of PTN
: ex f being T-S_arc of PTN, t being transition of PTN st t in T0 & f = [t,s] }
  ;
end;

theorem 
  *'T0 = {f`1 where f is S-T_arc of PTN : f`2 in T0};

theorem 
  for x being set holds x in *'T0 iff ex f being S-T_arc of PTN, t
  being transition of PTN st t in T0 & f = [x,t];

theorem 
  T0*' = {f`2 where f is T-S_arc of PTN : f`1 in T0};

theorem 
  for x being set holds x in T0*' iff ex f being T-S_arc of PTN, t
  being transition of PTN st t in T0 & f = [t,x];

theorem 
  *'{}the carrier of PTN = {};

theorem 
  ({}the carrier of PTN)*' = {};

theorem 
  *'{}the carrier' of PTN = {};

theorem 
  ({}the carrier' of PTN)*' = {};

begin



definition
  let PTN;
  let IT be Subset of the carrier of PTN;
  attr IT is Deadlock-like means

  *'IT is Subset of IT*';
end;



definition
  let IT be Petri_net;
  attr IT is With_Deadlocks means

  ex S being Subset of the carrier of IT st S is Deadlock-like;
end;

registration
  cluster With_Deadlocks for Petri_net;
end;

begin



definition
  let PTN;
  let IT be Subset of the carrier of PTN;
  attr IT is Trap-like means

  IT*' is Subset of *'IT;
end;



definition
  let IT be Petri_net;
  attr IT is With_Traps means

  ex S being Subset of the carrier of IT st S is Trap-like;
end;

registration
  cluster With_Traps for Petri_net;
end;

definition
  let A, B be non empty set;
  let r be non empty Relation of A, B;
  redefine func r~ -> non empty Relation of B, A;
end;

begin



definition
  let PTN be PT_net_Str;
  func PTN.: -> strict PT_net_Str equals

  PT_net_Str(# the carrier of PTN, the
    carrier' of PTN, (the T-S_Arcs of PTN)~, (the S-T_Arcs of PTN)~ #);
end;

registration let PTN be Petri_net;
 cluster PTN.: -> with_S-T_arc with_T-S_arc non empty non void;
end;

theorem 
  PTN.:.: = the PT_net_Str of PTN;

theorem 
  the carrier of PTN = the carrier of PTN.: & the carrier' of PTN = the
  carrier' of PTN.: & (the S-T_Arcs of PTN)~ = the T-S_Arcs of PTN.: & (the
  T-S_Arcs of PTN)~ = the S-T_Arcs of PTN.:;

definition
  let PTN;
  let S0 be Subset of the carrier of PTN;
  func S0.: -> Subset of the carrier of PTN.: equals

  S0;
end;

definition
  let PTN;
  let s be place of PTN;
  func s.: -> place of PTN.: equals

  s;
end;

definition
  let PTN;
  let S0 be Subset of the carrier of PTN.:;
  func .:S0 -> Subset of the carrier of PTN equals

  S0;
end;

definition
  let PTN;
  let s be place of PTN.:;
  func .:s -> place of PTN equals

  s;
end;

definition
  let PTN;
  let T0 be Subset of the carrier' of PTN;
  func T0.: -> Subset of the carrier' of PTN.: equals

  T0;
end;

definition
  let PTN;
  let t be transition of PTN;
  func t.: -> transition of PTN.: equals

  t;
end;

definition
  let PTN;
  let T0 be Subset of the carrier' of PTN.:;
  func .:T0 -> Subset of the carrier' of PTN equals

  T0;
end;

definition
  let PTN;
  let t be transition of PTN.:;
  func .:t -> transition of PTN equals

  t;
end;

reserve S for Subset of the carrier of PTN;

theorem 
  S.:*' = *'S;

theorem 
  *'(S.:) = S*';

theorem 
  S is Deadlock-like iff S.: is Trap-like;

theorem 
  S is Trap-like iff S.: is Deadlock-like;

theorem 
  for PTN being Petri_net, t being transition of PTN, S0 being Subset
  of the carrier of PTN holds t in S0*' iff *'{t} meets S0;

theorem 
  for PTN being Petri_net, t being transition of PTN, S0 being Subset
  of the carrier of PTN holds t in *'S0 iff {t}*' meets S0;














begin





definition let P be PT_net_Str;
 func Flow P equals

  (the S-T_Arcs of P) \/ the T-S_Arcs of P;
end;

registration let P be PT_net_Str;
 cluster Flow P -> Relation-like;
end;




reserve x,y for set;
reserve N for PT_net_Str;

definition
  let N be PT_net_Str;
  attr N is Petri means


  the carrier of N misses the carrier' of N & (
  Flow N) c= [:the carrier of N, the carrier' of N:] \/ [:the
  carrier' of N, the carrier of N:];
end;









definition
  let N be PT_net_Str;
  func Elements(N) equals

  (the carrier of N) \/ (the carrier' of N);
end;

theorem 
  Elements(N) <> {} implies (x is Element of Elements(N) implies x is
Element of the carrier of N or x is Element of the carrier' of N);

theorem 
  x is Element of the carrier of N & the carrier of N <> {} implies x is
  Element of Elements(N);

theorem 
  x is Element of the carrier' of N & the carrier' of N <> {}
  implies x is Element of Elements(N);

registration
  cluster PT_net_Str (#{}, {}, {}({},{}), {}({},{})#) -> Petri;
end;





registration
  cluster strict Petri for PT_net_Str;
end;

definition
  mode Pnet is Petri PT_net_Str;
end;




theorem 
  for N being Pnet holds not (x in the carrier of N & x in the carrier' of N);





theorem 
  for N being Pnet holds [x,y] in Flow N & x in the
  carrier' of N implies y in the carrier of N;

theorem 
  for N being Pnet holds [x,y] in Flow N & y in the
  carrier' of N implies x in the carrier of N;

theorem 
  for N being Pnet holds [x,y] in Flow N & x in the carrier of N
  implies y in the carrier' of N;

theorem 
  for N being Pnet holds [x,y] in Flow N & y in the carrier of N
  implies x in the carrier' of N;

definition
  let N be Pnet;
  let x,y;

  pred pre N,x,y means


  [y,x] in Flow N & x in the carrier' of N;
  pred post N,x,y means


  [x,y] in Flow N & x in the carrier' of N;
end;

definition
  let N be PT_net_Str;
  let x be Element of Elements(N);
  func Pre(N,x) means


  y in it iff y in Elements(N) & [y,x] in Flow N;
  func Post(N,x) means


  y in it iff y in Elements(N) & [x,y] in Flow N;
end;

theorem 
  for N being Pnet for x being Element of Elements(N) holds Pre(N,
  x) c= Elements(N);

theorem 
  for N being Pnet for x being Element of Elements N holds Pre(N,x) c=
  Elements N;

theorem 
  for N being Pnet for x being Element of Elements(N) holds Post(N
  ,x) c= Elements(N);

theorem 
  for N being Pnet for x being Element of Elements N holds Post(N,x) c=
  Elements N;

theorem 
  for N being Pnet for y being Element of Elements(N) holds y in the
  carrier' of N implies (x in Pre(N,y) iff pre N,y,x);

theorem 
  for N being Pnet for y being Element of Elements(N) holds y in the
  carrier' of N implies (x in Post(N,y) iff post N,y,x);

definition
  let N be Pnet;
  let x be Element of Elements(N);
  assume
 Elements(N) <> {};
  func enter(N,x) means


  (x in the carrier of N implies it = {x}) & (x in
  the carrier' of N implies it = Pre(N,x));
end;

theorem 
  for N being Pnet for x being Element of Elements(N) holds
  Elements(N) <> {} implies enter(N,x) ={x} or enter(N,x) = Pre(N,x);

theorem 
  for N being Pnet for x being Element of Elements(N) holds
  Elements(N) <> {} implies enter(N,x) c= Elements(N);

theorem 
  for N being Pnet for x being Element of Elements N holds Elements N <>
  {} implies enter(N,x) c= Elements N;

definition
  let N be Pnet;
  let x be Element of Elements(N);
  assume
 Elements(N) <> {};
  func exit(N,x) -> set means


  (x in the carrier of N implies it = {x})
  & (x in the carrier' of N implies it = Post(N,x));
end;

theorem 
  for N being Pnet for x being Element of Elements(N) holds
  Elements(N) <> {} implies exit(N,x) ={x} or exit(N,x) = Post(N,x);

theorem 
  for N being Pnet for x being Element of Elements(N) holds
  Elements(N) <> {} implies exit(N,x) c= Elements(N);

theorem 
  for N being Pnet for x being Element of Elements N holds Elements N <>
  {} implies exit(N,x) c= Elements N;

definition
  let N be Pnet;
  let x be Element of Elements(N);
  func field(N,x) equals

  enter(N,x) \/ exit(N,x);
end;

definition
  let N be PT_net_Str;
  let x be Element of the carrier' of N;
  func Prec(N,x) means

  y in it iff y in the carrier of N & [y,x] in Flow N;
  func Postc(N,x) means

  y in it iff y in the carrier of N & [x,y] in Flow N;
end;

definition
  let N be Pnet;
  let X be set;
  func Entr(N,X) means


  x in it iff x c= Elements N & ex y being
  Element of Elements N st y in X & x = enter(N,y);
  func Ext(N,X) means


  x in it iff x c= Elements N & ex y being Element
  of Elements N st y in X & x = exit(N,y);
end;

theorem 
  for N being Pnet for x being Element of Elements(N) for X being
  set holds Elements(N) <> {} & x in X implies enter(N,x) in Entr(N,X);

theorem 
  for N being Pnet for x being Element of Elements(N) for X being
  set holds Elements(N) <> {} & x in X implies exit(N,x) in Ext(N,X);

definition
  let N be Pnet;
  let X be set;
  func Input(N,X) equals

  union Entr(N,X);
  func Output(N,X) equals

  union Ext(N,X);
end;

theorem 
  for N being Pnet for x for X being set holds X c= Elements(N) implies
(x in Input(N,X) iff ex y being Element of Elements(N) st y in X & x in enter(N
  ,y));

theorem 
  for N being Pnet for x for X being set holds X c= Elements(N) implies
(x in Output(N,X) iff ex y being Element of Elements(N) st y in X & x in exit(N
  ,y));

theorem 
  for N being Pnet for X being Subset of Elements(N) for x being Element
of Elements(N) holds Elements(N) <> {} implies (x in Input(N,X) iff (x in X & x
  in the carrier of N or ex y being Element of Elements(N) st y in X & y in the
  carrier' of N & pre N,y,x));

theorem 
  for N being Pnet for X being Subset of Elements(N) for x being Element
of Elements(N) holds Elements(N) <> {} implies (x in Output(N,X) iff (x in X &
x in the carrier of N or ex y being Element of Elements(N) st y in X & y in the
  carrier' of N & post N,y,x));














begin

definition
  struct(1-sorted) /\-SemiLattStr (# carrier -> set, L_meet -> BinOp of the
    carrier #);
end;

definition
  struct (1-sorted) \/-SemiLattStr (# carrier -> set, L_join -> BinOp of the
    carrier #);
end;

definition
  struct (/\-SemiLattStr,\/-SemiLattStr) LattStr (# carrier -> set, L_join,
    L_meet -> BinOp of the carrier #);
end;

registration
  let D be non empty set, u be BinOp of D;
  cluster \/-SemiLattStr (# D, u #) -> non empty;
  cluster /\-SemiLattStr (# D, u #) -> non empty;
end;

registration
  let D be non empty set, u,n be BinOp of D;
  cluster LattStr (# D, u, n #) -> non empty;
end;

registration
  cluster 1-element strict for \/-SemiLattStr;
  cluster 1-element strict for /\-SemiLattStr;
  cluster 1-element strict for LattStr;
end;

definition
  let G be non empty \/-SemiLattStr, p, q be Element of G;
  func p"\/"q -> Element of G equals

  (the L_join of G).(p,q);
end;

definition
  let G be non empty /\-SemiLattStr, p, q be Element of G;
  func p"/\"q -> Element of G equals

  (the L_meet of G).(p,q);
end;

definition
  let G be non empty \/-SemiLattStr, p, q be Element of G;
  pred p [= q means


  p"\/"q = q;
end;

definition
  let IT be non empty \/-SemiLattStr;
  attr IT is join-commutative means


  for a,b being Element of IT holds a "\/"b = b"\/"a;
  attr IT is join-associative means


  for a,b,c being Element of IT holds a"\/"(b"\/"c) = (a"\/"b)"\/"c;
end;

definition
  let IT be non empty /\-SemiLattStr;
  attr IT is meet-commutative means


  for a,b being Element of IT holds a "/\"b = b"/\"a;
  attr IT is meet-associative means


  for a,b,c being Element of IT holds a"/\"(b"/\"c) = (a"/\"b)"/\"c;
end;

definition
  let IT be non empty LattStr;
  attr IT is meet-absorbing means


  for a,b being Element of IT holds (a "/\"b)"\/"b = b;
  attr IT is join-absorbing means


  for a,b being Element of IT holds a "/\"(a"\/"b)=a;
end;

definition
  let IT be non empty LattStr;
  attr IT is Lattice-like means


  IT is join-commutative
  join-associative meet-absorbing meet-commutative meet-associative
  join-absorbing;
end;

registration
  cluster Lattice-like -> join-commutative join-associative meet-absorbing
    meet-commutative meet-associative join-absorbing for non empty LattStr;
  cluster join-commutative join-associative meet-absorbing meet-commutative
    meet-associative join-absorbing -> Lattice-like for non empty LattStr;
end;

registration
  cluster strict join-commutative join-associative for
non empty \/-SemiLattStr;
  cluster strict meet-commutative meet-associative for
non empty /\-SemiLattStr;
  cluster strict Lattice-like for non empty LattStr;
end;

definition
  mode Lattice is Lattice-like non empty LattStr;
end;

definition
  let L be join-commutative non empty \/-SemiLattStr, a, b be Element of L;
  redefine func a"\/"b;
  commutativity;
end;

definition
  let L be meet-commutative non empty /\-SemiLattStr, a, b be Element of L;
  redefine func a"/\"b;
  commutativity;
end;

definition
  let IT be non empty LattStr;
  attr IT is distributive means


  for a,b,c being Element of IT holds a "/\"(b"\/"c) = (a"/\"b)"\/"(a"/\"c);
end;

definition
  let IT be non empty LattStr;
  attr IT is modular means


  for a,b,c being Element of IT st a [= c holds a"\/"(b"/\"c) = (a"\/"b)"/\"c;
end;

definition
  let IT be non empty /\-SemiLattStr;
  attr IT is lower-bounded means


  ex c being Element of IT st for a
  being Element of IT holds c"/\"a = c & a"/\"c = c;
end;

definition
  let IT be non empty \/-SemiLattStr;
  attr IT is upper-bounded means


  ex c being Element of IT st for a
  being Element of IT holds c"\/"a = c & a"\/"c = c;
end;

registration
  cluster strict distributive lower-bounded upper-bounded modular for Lattice;
end;

definition
  mode D_Lattice is distributive Lattice;
  mode M_Lattice is modular Lattice;
  mode 0_Lattice is lower-bounded Lattice;
  mode 1_Lattice is upper-bounded Lattice;
end;

definition
  let IT be non empty LattStr;
  attr IT is bounded means


  IT is lower-bounded upper-bounded;
end;

registration
  cluster lower-bounded upper-bounded -> bounded for non empty LattStr;
  cluster bounded -> lower-bounded upper-bounded for non empty LattStr;
end;

registration
  cluster bounded strict for Lattice;
end;

definition
  mode 01_Lattice is bounded Lattice;
end;

definition
  let L be non empty /\-SemiLattStr;
  assume
 L is lower-bounded;
  func Bottom L -> Element of L means


  for a being Element of L holds it "/\" a = it & a "/\" it = it;
end;

definition
  let L be non empty \/-SemiLattStr;
  assume
 L is upper-bounded;
  func Top L -> Element of L means


  for a being Element of L holds it "\/" a = it & a "\/" it = it;
end;

definition
  let L be non empty LattStr, a, b be Element of L;
  pred a is_a_complement_of b means


  a"\/"b = Top L & b"\/"a = Top L & a"/\"b = Bottom L & b"/\"a = Bottom L;
end;

definition
  let IT be non empty LattStr;
  attr IT is complemented means


  for b being Element of IT ex a being Element of IT st a is_a_complement_of b;
end;

registration
  cluster bounded complemented strict for Lattice;
end;

definition
  mode C_Lattice is complemented 01_Lattice;
end;

definition
  let IT be non empty LattStr;
  attr IT is Boolean means


  IT is bounded complemented distributive;
end;

registration
  cluster Boolean -> bounded complemented distributive for non empty LattStr;
  cluster bounded complemented distributive -> Boolean for non empty LattStr;
end;

registration
  cluster Boolean strict for Lattice;
end;

definition
  mode B_Lattice is Boolean Lattice;
end;

registration
 let L be meet-absorbing join-absorbing meet-commutative non empty LattStr,
  a be Element of L;
 reduce a "\/" a to a;
end;

registration
  let L be meet-absorbing join-absorbing meet-commutative non empty LattStr,
  a be Element of L;
 reduce a "/\" a to a;
end;

canceled 2;

theorem 
  for L being Lattice holds (for a,b,c being Element of L holds a
  "/\"(b"\/"c) = (a"/\"b)"\/"(a"/\"c)) iff for a,b,c being Element of L holds a
  "\/"(b"/\"c) = (a"\/"b)"/\"(a"\/"c);

theorem 
  for L being meet-absorbing join-absorbing non empty LattStr, a
  , b being Element of L holds a [= b iff a"/\"b = a;

theorem 
  for L being meet-absorbing join-absorbing join-associative
meet-commutative non empty LattStr, a, b being Element of L holds a [= a"\/"b;

theorem 
  for L being meet-absorbing meet-commutative non empty LattStr,
  a, b being Element of L holds a"/\"b [= a;

definition
  let L be meet-absorbing join-absorbing meet-commutative non empty LattStr,
  a, b be Element of L;
  redefine pred a [= b;
  reflexivity;
end;

theorem 
  for L being join-associative non empty \/-SemiLattStr, a, b, c being
  Element of L holds a [= b & b [= c implies a [= c;

theorem 
  for L being join-commutative non empty \/-SemiLattStr, a, b
  being Element of L holds a [= b & b [= a implies a=b;

theorem 
  for L being meet-absorbing join-absorbing meet-associative non
empty LattStr, a, b, c being Element of L holds a [= b implies a"/\"c [= b"/\"
  c;

theorem 
  for L being Lattice holds (for a,b,c being Element of L holds (a"/\"b)
  "\/"(b"/\"c)"\/"(c"/\"a) = (a"\/"b)"/\"(b"\/"c)"/\"(c"\/"a)) implies L is
  distributive;

reserve L for D_Lattice;
reserve a, b, c for Element of L;

theorem 
  a"\/"(b"/\"c) = (a"\/"b)"/\"(a"\/"c);

theorem 
  c"/\"a = c"/\"b & c"\/"a = c"\/"b implies a=b;

theorem 
  (a"\/"b)"/\"(b"\/"c)"/\"(c"\/"a) = (a"/\"b)"\/"(b"/\"c)"\/"(c"/\"a);

registration
  cluster distributive -> modular for Lattice;
end;

registration
  let L be 0_Lattice, a be Element of L;
 reduce Bottom L "\/" a to a;
 reduce Bottom L "/\" a to Bottom L;
end;

theorem 
  for L being 0_Lattice, a being Element of L holds Bottom L "\/" a = a;

theorem 
  for L being 0_Lattice, a being Element of L holds Bottom L "/\" a = Bottom L;

theorem 
  for L being 0_Lattice, a being Element of L holds Bottom L [= a;

registration
  let L be 1_Lattice, a be Element of L;
 reduce Top L"/\"a to a;
 reduce Top L"\/"a to Top L;
end;

theorem 
  for L being 1_Lattice, a being Element of L holds Top L"/\"a = a;

theorem 
  for L being 1_Lattice, a being Element of L holds Top L"\/"a = Top L;

theorem 
  for L being 1_Lattice, a being Element of L holds a [= Top L;

definition
  let L be non empty LattStr, x be Element of L;
  assume
 L is complemented D_Lattice;
  func x` -> Element of L means


  it is_a_complement_of x;
end;

reserve L for B_Lattice;
reserve a, b for Element of L;

theorem 
  a`"/\"a = Bottom L;

theorem 
  a`"\/"a = Top L;

registration let L,a;
 reduce a`` to a;
end;

theorem 
  a`` = a;

theorem 
  ( a"/\"b )` = a`"\/" b`;

theorem 
  ( a"\/"b )` = a`"/\" b`;

theorem 
  b"/\"a = Bottom L iff b [= a`;

theorem 
  a [= b implies b` [= a`;

begin 


definition let L be Lattice, S be Subset of L;
 attr S is initial means

  for p,q being Element of L st p [= q & q in S holds p in S;
 attr S is final means

  for p,q being Element of L st p [= q & p in S holds q in S;
 attr S is meet-closed means

  for p,q being Element of L st p in S & q in S holds p "/\" q in S;
 attr S is join-closed means

  for p,q being Element of L st p in S & q in S holds p "\/" q in S;
end;

registration let L be Lattice;
 cluster [#]L -> initial final non empty;
end;

registration let L be Lattice;
 cluster initial final non empty for Subset of L;
 cluster empty -> initial final for Subset of L;
 cluster initial -> meet-closed for Subset of L;
 cluster final -> join-closed for Subset of L;
end;

theorem 
 for L being Lattice, S being initial final non empty Subset of L
   holds S = [#]L;














begin

reserve TS for 1-sorted,
  K, Q for Subset of TS;

theorem 
  K` = Q` implies K = Q;





reserve TS for TopSpace,
  GX for TopStruct,
  x for set,
  P, Q for Subset of TS,
  K , L for Subset of TS,
  R, S for Subset of GX,
  T, W for Subset of GX;

theorem 
  Cl([#] GX) = [#] GX;

registration
  let T be TopSpace, P be Subset of T;
  cluster Cl P -> closed;
end;

theorem 
  R is closed iff R` is open;

registration
  let T be TopSpace, R be closed Subset of T;
  cluster R` -> open;
end;

theorem 
  R is open iff R` is closed;

registration
  let T be TopSpace;
  cluster open for Subset of T;
end;

registration
  let T be TopSpace, R be open Subset of T;
  cluster R` -> closed;
end;

theorem 
  S is closed & T c= S implies Cl T c= S;

theorem 
  Cl K \ Cl L c= Cl(K \ L);

theorem 
  R is closed & S is closed implies Cl(R /\ S) = Cl R /\ Cl S;

registration
  let TS;
  let P,Q be closed Subset of TS;
  cluster P /\ Q -> closed for Subset of TS;
  cluster P \/ Q -> closed for Subset of TS;
end;

theorem 
  P is closed & Q is closed implies P /\ Q is closed;

theorem 
  P is closed & Q is closed implies P \/ Q is closed;

registration
  let TS;
  let P,Q be open Subset of TS;
  cluster P /\ Q -> open for Subset of TS;
  cluster P \/ Q -> open for Subset of TS;
end;

theorem 
  P is open & Q is open implies P \/ Q is open;

theorem 
  P is open & Q is open implies P /\ Q is open;

theorem 
  for GX being non empty TopSpace, R being Subset of GX, p being
Point of GX holds p in Cl R iff for T being Subset of GX st T is open & p in T
  holds R meets T;

theorem 
  Q is open implies Q /\ Cl K c= Cl(Q /\ K);

theorem 
  Q is open implies Cl(Q /\ Cl K) = Cl(Q /\ K);





definition
  let GX be TopStruct, R be Subset of GX;
  func Int R -> Subset of GX equals

  (Cl R`)`;
  projectivity;
end;

theorem 
  Int([#] TS) = [#] TS;

theorem 
  Int T c= T;

theorem 
  Int K /\ Int L = Int(K /\ L);

registration
  let GX;
  cluster Int {}GX -> empty;
end;

theorem 
  Int({} GX) = {} GX;

theorem 
  T c= W implies Int T c= Int W;

theorem 
  Int T \/ Int W c= Int(T \/ W);

theorem 
  Int(K \ L) c= Int K \ Int L;

registration
  let T be TopSpace, K be Subset of T;
  cluster Int K -> open;
end;

registration
  let T be TopSpace;
  cluster empty -> open for Subset of T;
  cluster [#]T -> open;
end;

registration
  let T be TopSpace;
  cluster open closed for Subset of T;
end;

registration
  let T be non empty TopSpace;
  cluster non empty open closed for Subset of T;
end;

theorem 
  x in Int K iff ex Q st Q is open & Q c= K & x in Q;

theorem 
  (R is open implies Int R = R) & (Int P = P implies P is open);

theorem 
  S is open & S c= T implies S c= Int T;

theorem 
  P is open iff for x holds x in P iff ex Q st Q is open & Q c= P & x in Q;

theorem 
  Cl Int T = Cl Int Cl Int T;

theorem 
  R is open implies Cl Int Cl R = Cl R;





definition
  let GX be TopStruct, R be Subset of GX;
  func Fr R -> Subset of GX equals

  Cl R /\ Cl R`;
end;

registration
  let T be TopSpace, A be Subset of T;
  cluster Fr A -> closed;
end;

theorem 
  for GX being non empty TopSpace, R being Subset of GX, p being
Point of GX holds p in Fr R iff for S being Subset of GX st S is open & p in S
  holds R meets S & R` meets S;

theorem 
  Fr T = Fr T`;

theorem 
  Fr T = Cl(T`) /\ T \/ (Cl T \ T);

theorem 
  Cl T = T \/ Fr T;

theorem 
  Fr(K /\ L) c= Fr K \/ Fr L;

theorem 
  Fr(K \/ L) c= Fr K \/ Fr L;

theorem 
  Fr Fr T c= Fr T;

theorem 
  R is closed implies Fr R c= R;

theorem 
  Fr K \/ Fr L = Fr(K \/ L) \/ Fr(K /\ L) \/ (Fr K /\ Fr L);

theorem 
  Fr Int T c= Fr T;

theorem 
  Fr Cl T c= Fr T;

theorem 
  Int T misses Fr T;

theorem 
  Int T = T \ Fr T;

theorem 
  Fr Fr Fr K = Fr Fr K;

theorem 
  P is open iff Fr P = Cl P \ P;

theorem 
  P is closed iff Fr P = P \ Int P;





definition
  let GX be TopStruct, R be Subset of GX;
  attr R is dense means


  Cl R = [#] GX;
end;

registration
  let GX;
  cluster [#]GX -> dense;
  cluster dense for Subset of GX;
end;

theorem 
  R is dense & R c= S implies S is dense;

theorem 
  P is dense iff for Q st Q <> {} & Q is open holds P meets Q;

theorem 
  P is dense implies for Q holds Q is open implies Cl Q = Cl(Q /\ P);

theorem 
  P is dense & Q is dense & Q is open implies P /\ Q is dense;

definition
  let GX be TopStruct, R be Subset of GX;
  attr R is boundary means


  R` is dense;
end;

registration
  let GX;
  cluster empty -> boundary for Subset of GX;
end;

theorem 
  R is boundary iff Int R = {};

registration
  let GX;
  cluster boundary for Subset of GX;
end;

registration
  let GX;
  let R be boundary Subset of GX;
  cluster Int R -> empty;
end;

theorem 
  P is boundary & Q is boundary & Q is closed implies P \/ Q is boundary;

theorem 
  P is boundary iff for Q st Q c= P & Q is open holds Q = {};

theorem 
  P is closed implies (P is boundary iff for Q st Q <> {} & Q is open ex
  G being Subset of TS st G c= Q & G <> {} & G is open & P misses G);

theorem 
  R is boundary iff R c= Fr R;

registration
  let GX be non empty TopSpace;
  cluster [#]GX -> non boundary;
  cluster non boundary non empty for Subset of GX;
end;

definition
  let GX be TopStruct, R be Subset of GX;
  attr R is nowhere_dense means


  Cl R is boundary;
end;

registration
  let TS;
  cluster empty -> nowhere_dense for Subset of TS;
end;

registration
  let TS;
  cluster nowhere_dense for Subset of TS;
end;

theorem 
  P is nowhere_dense & Q is nowhere_dense implies P \/ Q is nowhere_dense;

theorem 
  R is nowhere_dense implies R` is dense;

registration
  let TS;
  let R be nowhere_dense Subset of TS;
  cluster R` -> dense;
end;

theorem 
  R is nowhere_dense implies R is boundary;

registration
  let TS;
  cluster nowhere_dense -> boundary for Subset of TS;
end;

theorem 
  S is boundary & S is closed implies S is nowhere_dense;

registration
  let TS;
  cluster boundary closed -> nowhere_dense for Subset of TS;
end;

theorem 
  R is closed implies (R is nowhere_dense iff R = Fr R);

theorem 
  P is open implies Fr P is nowhere_dense;

registration
  let TS;
  let P be open Subset of TS;
  cluster Fr P -> nowhere_dense;
end;

theorem 
  P is closed implies Fr P is nowhere_dense;

registration
  let TS;
  let P be closed Subset of TS;
  cluster Fr P -> nowhere_dense;
end;

theorem 
  P is open & P is nowhere_dense implies P = {};

registration
  let TS;
  cluster open nowhere_dense -> empty for Subset of TS;
end;





definition
  let GX be TopStruct, R be Subset of GX;
  attr R is condensed means


  Int Cl R c= R & R c= Cl Int R;
  attr R is closed_condensed means


  R = Cl Int R;
  attr R is open_condensed means


  R = Int Cl R;
end;

theorem 
  R is open_condensed iff R` is closed_condensed;

theorem 
  R is closed_condensed implies Fr Int R = Fr R;

theorem 
  R is closed_condensed implies Fr R c= Cl Int R;

theorem 
  R is open_condensed implies Fr R = Fr Cl R & Fr Cl R = Cl R \ R;

theorem 
  R is open & R is closed implies (R is closed_condensed iff R is
  open_condensed);

theorem 
  (R is closed & R is condensed implies R is closed_condensed) &
  (P is closed_condensed implies P is closed & P is condensed);

theorem 
  (R is open & R is condensed implies R is open_condensed) & (P is
  open_condensed implies P is open & P is condensed);

theorem 
  P is closed_condensed & Q is closed_condensed implies P \/ Q is
  closed_condensed;

theorem 
  P is open_condensed & Q is open_condensed implies P /\ Q is open_condensed;

theorem 
  P is condensed implies Int Fr P = {};

theorem 
  R is condensed implies Int R is condensed & Cl R is condensed;














begin

reserve GX for TopSpace;
reserve A, B, C for Subset of GX;
reserve TS for TopStruct;
reserve K, K1, L, L1 for Subset of TS;





definition
  let GX be TopStruct, A,B be Subset of GX;
  pred A,B are_separated means


  Cl A misses B & A misses Cl B;
  symmetry;
end;

theorem 
  K,L are_separated implies K misses L;

theorem 
  K is closed & L is closed & K misses L implies K,L are_separated;

theorem 
  [#]GX = A \/ B & A is open & B is open & A misses B implies A,B are_separated
;

theorem 
  [#]GX = A \/ B & A,B are_separated implies
  A is open closed & B is open closed;

theorem 
  for X9 being SubSpace of GX, P1,Q1 being Subset of GX, P,Q being
Subset of X9 st P=P1 & Q=Q1 holds P,Q are_separated implies P1,Q1 are_separated
;

theorem 
  for X9 being SubSpace of GX, P,Q being Subset of GX, P1,Q1 being
Subset of X9 st P=P1 & Q=Q1 & P \/ Q c= [#](X9) holds P,Q are_separated implies
  P1,Q1 are_separated;

theorem 
  K,L are_separated & K1 c= K & L1 c= L implies K1,L1 are_separated;

theorem 
  A,B are_separated & A,C are_separated implies A,B \/ C are_separated;

theorem 
  K is closed & L is closed or K is open & L is open implies
  K \ L, L \ K are_separated;





definition
  let GX be TopStruct;
  attr GX is connected means


  for A, B being Subset of GX st [#]GX = A \/ B & A,B are_separated holds
  A = {}GX or B = {}GX;
end;

theorem 
  GX is connected iff
  for A, B being Subset of GX st [#]GX = A \/ B & A <> {}GX & B <> {}GX &
  A is closed & B is closed holds A meets B;

theorem 
  GX is connected iff for A,B being Subset of GX st [#]GX = A \/ B &
  A <> {}GX & B <> {}GX & A is open & B is open holds A meets B;

theorem 
  GX is connected iff for A being Subset of GX st A <> {}GX & A <>
  [#]GX holds Cl A meets Cl([#]GX \ A);

theorem 
  GX is connected iff for A being Subset of GX st A is open closed holds
  A = {}GX or A = [#]GX;

theorem 
  for GY being TopSpace for F being Function of GX,GY st F is continuous
  & F.:[#]GX = [#]GY & GX is connected holds GY is connected;





definition
  let GX be TopStruct, A be Subset of GX;
  attr A is connected means


  GX|A is connected;
end;

theorem 
  A is connected iff for P,Q being Subset of GX st A = P \/ Q & P,
  Q are_separated holds P = {}GX or Q = {}GX;

theorem 
  A is connected & A c= B \/ C & B,C are_separated implies A c= B or A c= C;

theorem 
  A is connected & B is connected & not A,B are_separated implies
  A \/ B is connected;

theorem 
  C is connected & C c= A & A c= Cl C implies A is connected;

theorem 
  A is connected implies Cl A is connected;

theorem 
  GX is connected & A is connected & [#]GX \ A = B \/ C & B,C
  are_separated implies A \/ B is connected & A \/ C is connected;

theorem 
  [#]GX \ A = B \/ C & B,C are_separated & A is closed implies A \/ B is
  closed & A \/ C is closed;

theorem 
  C is connected & C meets A & C \ A <> {}GX implies C meets Fr A;

theorem 
  for X9 being SubSpace of GX, A being Subset of GX, B being
  Subset of X9 st A = B holds A is connected iff B is connected;

theorem 
  A is closed & B is closed & A \/ B is connected & A /\ B is connected
  implies A is connected & B is connected;

theorem 
  for F being Subset-Family of GX st (for A being Subset of GX st
A in F holds A is connected) & (ex A being Subset of GX st A <> {}GX & A in F &
  (for B being Subset of GX st B in F & B <> A holds not A,B are_separated))
  holds union F is connected;

theorem 
  for F being Subset-Family of GX st (for A being Subset of GX st
  A in F holds A is connected) & meet F <> {}GX holds union F is connected;

theorem 
  [#]GX is connected iff GX is connected;

registration
  let GX be non empty TopSpace, x be Point of GX;
  cluster {x} -> connected for Subset of GX;
end;

definition
  let GX be TopStruct, x,y be Point of GX;
  pred x, y are_joined means


  ex C being Subset of GX st C is connected & x in C & y in C;
end;

theorem 
  for GX being non empty TopSpace st ex x being Point of GX st for
  y being Point of GX holds x,y are_joined holds GX is connected;

theorem 
  (ex x being Point of GX st for y being Point of GX holds x,y
  are_joined) iff for x,y being Point of GX holds x,y are_joined;

theorem 
  for GX being non empty TopSpace st for x, y being Point of GX holds x,
  y are_joined holds GX is connected;

theorem 
  for GX being non empty TopSpace for x being Point of GX, F being
Subset-Family of GX st for A being Subset of GX holds A in F iff A is connected
  & x in A holds F <> {};





definition
  let GX be TopStruct, A be Subset of GX;
  attr A is a_component means


  A is connected & for B being Subset of GX st B is connected holds
  A c= B implies A = B;
end;

registration
  let GX be TopStruct;
  cluster a_component -> connected for Subset of GX;
end;

registration
  let GX be non empty TopSpace;
  cluster a_component -> non empty for Subset of GX;
end;

theorem 
  for GX being non empty TopSpace, A being Subset of GX st
  A is a_component holds A <> {}GX;

registration
  let GX;
  cluster a_component -> closed for Subset of GX;
end;

theorem 
  A is a_component implies A is closed;

theorem 
  A is a_component & B is a_component implies
  A = B or A,B are_separated;

theorem 
  A is a_component & B is a_component implies A = B or A misses B;

theorem 
  C is connected implies for S being Subset of GX st S is a_component holds
  C misses S or C c= S;

definition
  let GX be TopStruct, A, B be Subset of GX;
  pred B is_a_component_of A means


  ex B1 being Subset of GX|A st B1 = B & B1 is a_component;
end;

theorem 
  GX is connected & A is connected & C is_a_component_of [#]GX \ A
  implies [#]GX \ C is connected;





definition
  let GX be TopStruct, x be Point of GX;
  func Component_of x -> Subset of GX means


  ex F being Subset-Family of GX st
  (for A being Subset of GX holds A in F iff A is connected & x in A) &
  union F = it;
end;

reserve GX for non empty TopSpace;
reserve A, C for Subset of GX;
reserve x for Point of GX;

theorem 
  x in Component_of x;

registration
  let GX,x;
  cluster Component_of x -> non empty connected;
end;

theorem 
  C is connected & Component_of x c= C implies C = Component_of x;

theorem 
  A is a_component iff ex x being Point of GX st A = Component_of x;

theorem 
  A is a_component & x in A implies A = Component_of x;

theorem 
  for p being Point of GX st p in Component_of x holds
  Component_of p = Component_of x;

theorem 
  for F being Subset-Family of GX st
  for A being Subset of GX holds A in F iff A is a_component holds
  F is Cover of GX;

begin 

registration
  let T be TopStruct;
  cluster empty for Subset of T;
end;

registration
  let T be TopStruct;
  cluster empty -> connected for Subset of T;
end;

theorem 
  for T being TopSpace, X being set holds
  X is connected Subset of T iff X is connected Subset of the TopStruct of T;

theorem 
  for T being TopSpace, X being Subset of T, Y being Subset of the
  TopStruct of T st X=Y holds X is a_component iff Y is a_component;



theorem 
  for G being non empty TopSpace, P being Subset of G,A being
Subset of G, Q being Subset of G|A st P=Q & P is connected holds Q is connected
;















begin

reserve x, y for set,
  T for TopStruct,
  GX for TopSpace,
  P, Q, M, N for Subset of T,
  F, G for Subset-Family of T,
  W, Z for Subset-Family of GX,
  A for SubSpace of T;





theorem 
  for T being 1-sorted, F being Subset-Family of T holds F c= bool [#]T;

theorem 
  for T being 1-sorted, F being Subset-Family of T, X being set st
  X c= F holds X is Subset-Family of T;

theorem 
  for T being non empty 1-sorted, F being Subset-Family of T st F is
  Cover of T holds F <> {};

theorem 
  for T being 1-sorted, F, G being Subset-Family of T holds union F \
  union G c= union(F \ G);

theorem 
  for T being set, F being Subset-Family of T holds F <> {} iff
  COMPLEMENT(F) <> {};

theorem 
  for T being set, F being Subset-Family of T holds F <> {}
  implies meet COMPLEMENT(F) = (union F)`;

theorem 
  for T being set, F being Subset-Family of T holds F <> {}
  implies union COMPLEMENT(F) = (meet F)`;

theorem 
  for T being 1-sorted, F being Subset-Family of T holds
  COMPLEMENT(F) is finite iff F is finite;





definition
  let T be TopStruct, F be Subset-Family of T;
  attr F is open means


  for P being Subset of T holds P in F implies P is open;
  attr F is closed means


  for P being Subset of T holds P in F implies P is closed;
end;

theorem 
  F is closed iff COMPLEMENT(F) is open;

theorem 
  F is open iff COMPLEMENT(F) is closed;

theorem 
  F c= G & G is open implies F is open;

theorem 
  F c= G & G is closed implies F is closed;

theorem 
  F is open & G is open implies F \/ G is open;

theorem 
  F is open implies F /\ G is open;

theorem 
  F is open implies F \ G is open;

theorem 
  F is closed & G is closed implies F \/ G is closed;

theorem 
  F is closed implies F /\ G is closed;

theorem 
  F is closed implies F \ G is closed;

theorem 
  W is open implies union W is open;

theorem 
  W is open & W is finite implies meet W is open;

theorem 
  W is closed & W is finite implies union W is closed;

theorem 
  W is closed implies meet W is closed;





theorem 
  for F being Subset-Family of A holds F is Subset-Family of T;

theorem 
  for B being Subset of A holds B is open iff ex C being Subset of
  T st C is open & C /\ [#](A) = B;

theorem 
  Q is open implies for P being Subset of A st P=Q holds P is open;

theorem 
  Q is closed implies for P being Subset of A st P=Q holds P is closed;

theorem 
  F is open implies for G being Subset-Family of A st G=F holds G is open;

theorem 
  F is closed implies for G being Subset-Family of A st G=F holds G is closed;

theorem 
  M /\ N is Subset of T|N;





definition
  let T be TopStruct, P be Subset of T, F be Subset-Family of T;
  func F|P -> Subset-Family of T|P means


  for Q being Subset of T|P
  holds Q in it iff ex R being Subset of T st R in F & R /\ P = Q;
end;

theorem 
  F c= G implies F|M c= G|M;

theorem 
  Q in F implies Q /\ M in F|M;

theorem 
  Q c= union F implies Q /\ M c= union(F|M);

theorem 
  M c= union F implies M = union (F|M);

theorem 
  union(F|M) c= union F;

theorem 
  M c= union (F|M) implies M c= union F;

theorem 
  F is finite implies F|M is finite;

theorem 
  F is open implies F|M is open;

theorem 
  F is closed implies F|M is closed;

theorem 
  for F being Subset-Family of A st F is open ex G being Subset-Family
  of T st G is open & for AA being Subset of T st AA = [#] A holds F = G|AA;

theorem 
  ex f being Function st dom f = F & rng f = F|P & for x st x in F for Q
  st Q = x holds f.x = Q /\ P;

theorem 
  for X,Y being 1-sorted, f being Function of X, Y st [#]Y = {}
  implies [#]X = {} holds f"([#]Y) = [#]X;

theorem 
  for T being 1-sorted, S being non empty 1-sorted, f being Function of
  T, S, H being Subset-Family of S holds ("f).:H is Subset-Family of T;





reserve S for non empty TopStruct,
  f for Function of T, S,
  H for Subset-Family of S;

theorem 
  for X,Y being TopStruct, f being Function of X,Y st [#]Y = {}
  implies [#]X = {} holds f is continuous iff for P being Subset of Y st P is
  open holds f"P is open;

theorem 
  for T being TopSpace, S being TopSpace, f being Function of T, S
holds f is continuous iff for P1 being Subset of S holds Cl(f"P1) c= f"(Cl P1);

theorem 
  for T being TopSpace, S being non empty TopSpace, f being
Function of T, S holds f is continuous iff for P being Subset of T holds f.:(Cl
  P) c= Cl(f.:P);

theorem 
  for T,V being TopStruct,S being non empty TopStruct, f being
  Function of T,S, g being Function of S,V holds f is continuous & g is
  continuous implies g*f is continuous;

theorem 
  f is continuous & H is open implies for F st F=("f).:H holds F is open;

theorem 
  for T, S being TopStruct, f being Function of T, S, H being
  Subset-Family of S st f is continuous & H is closed holds for F being
  Subset-Family of T st F=("f).:H holds F is closed;

definition
  let S, T be set, f be Function of S,T;
  assume
 f is bijective;
  func f/" -> Function of T,S equals


  f";
end;

notation
  let S, T be set, f be Function of S,T;
  synonym f" for f/";
end;

theorem 
  for T being 1-sorted, S being non empty 1-sorted, f being Function of T,S
  st rng f = [#]S & f is one-to-one holds dom(f") = [#]S & rng(f") = [#]T;

theorem 
  for T, S being 1-sorted, f being Function of T,S st rng f = [#]S
  & f is one-to-one holds f" is one-to-one;

theorem 
  for T being 1-sorted, S being non empty 1-sorted, f being
  Function of T,S st rng f = [#]S & f is one-to-one holds (f")" = f;

theorem 
  for T, S being 1-sorted, f being Function of T,S st rng f = [#]S & f
  is one-to-one holds f"*f = id dom f & f*f" = id rng f;

theorem 
  for T being 1-sorted, S, V being non empty 1-sorted, f being
  Function of T,S, g being Function of S,V st rng f = [#]S & f is one-to-one &
  dom g = [#]S & rng g = [#]V & g is one-to-one holds (g*f)" = f"*g";

theorem 
  for T, S being 1-sorted, f being Function of T, S, P being
  Subset of T st rng f = [#]S & f is one-to-one holds f.:P = (f")"P;

theorem 
  for T, S being 1-sorted, f being Function of T,S, P1 being
  Subset of S st rng f = [#]S & f is one-to-one holds f"P1 = (f").:P1;





definition
  let S, T be TopStruct, f be Function of S, T;
  attr f is being_homeomorphism means


  dom f = [#]S & rng f = [#]T & f
  is one-to-one & f is continuous & f" is continuous;
end;

theorem 
  f is being_homeomorphism implies f" is being_homeomorphism;

theorem 
  for T, S, V being non empty TopStruct, f being Function of T,S, g
  being Function of S,V st f is being_homeomorphism & g is being_homeomorphism
  holds g*f is being_homeomorphism;

theorem 
  f is being_homeomorphism iff dom f = [#]T & rng f = [#]S & f is
  one-to-one & for P holds P is closed iff f.:P is closed;

reserve T for non empty TopSpace,
  S for TopSpace,
  P1 for Subset of S,
  f for Function of T, S;

theorem 
  f is being_homeomorphism iff dom f = [#]T & rng f = [#]S & f is
  one-to-one & for P1 holds f"(Cl P1) = Cl(f"P1);

reserve T for TopSpace,
  S for non empty TopSpace,
  P for Subset of T,
  f for Function of T, S;

theorem 
  f is being_homeomorphism iff dom f = [#]T & rng f = [#]S & f is
  one-to-one & for P holds f.:(Cl P) = Cl(f.:P);

theorem 
  for X,Y being non empty TopSpace for f being Function of X,Y, A
  being Subset of X st f is continuous & A is connected holds f.:A is connected
;

theorem 
  for S,T being non empty TopSpace, f being Function of S,T, A being
Subset of T st f is being_homeomorphism & A is connected holds f"A is connected
;

begin 


reserve GX,GY for non empty TopSpace;

theorem 
  for GX being non empty TopSpace st (for x,y being Point of GX ex GY st
(GY is connected & ex f being Function of GY,GX st f is continuous & x in rng(f
  )& y in rng(f))) holds GX is connected;



theorem 
  for X being TopStruct, F being Subset-Family of X holds
  F is open iff F c= the topology of X;

theorem 
  for X being TopStruct, F being Subset-Family of X holds
  F is closed iff F c= COMPLEMENT the topology of X;

registration
  let X be TopStruct;
  cluster the topology of X -> open;
  cluster open for Subset-Family of X;
end;














begin

definition
  struct (addLoopStr) RLSStruct (# carrier -> set,
    ZeroF -> Element of the carrier,
     addF -> BinOp of the carrier,
     Mult -> Function of [:REAL, the carrier :], the carrier #);
end;

registration
  cluster non empty for RLSStruct;
end;

reserve V for non empty RLSStruct;
reserve x,y,y1 for set;

definition
  let V be RLSStruct;
  mode VECTOR of V is Element of V;
end;

theorem 
  for V being non empty 1-sorted, v being Element of V holds v in V;





reserve v for VECTOR of V;
reserve a,b for real number;

definition
  let V;
  let v;
  let a be real number;

  func a * v -> Element of V equals

  (the Mult of V).(a,v);
end;



theorem 
  for V being non empty addMagma, v,w being Element of V holds
  v + w = (the addF of V).(v,w);

registration
  let ZS be non empty set, O be Element of ZS, F be BinOp of ZS, G be Function
  of [:REAL,ZS:],ZS;
  cluster RLSStruct (# ZS,O,F,G #) -> non empty;
end;

definition
  let IT be addMagma;
  attr IT is Abelian means


  for v,w being Element of IT holds v + w = w + v;
  attr IT is add-associative means


  for u,v,w being Element of IT holds (u + v) + w = u + (v + w);
end;

definition
  let IT be addLoopStr;
  attr IT is right_zeroed means

 for v being Element of IT holds v + 0.IT = v;
end;

definition
  let IT be non empty RLSStruct;
  attr IT is vector-distributive means

 for a for v,w being VECTOR of IT holds a * (v + w) = a * v + a * w;
  attr IT is scalar-distributive means

 for a,b for v being VECTOR of IT holds (a + b) * v = a * v + b * v;
  attr IT is scalar-associative means

 for a,b for v being VECTOR of IT holds (a * b) * v = a * (b * v);
  attr IT is scalar-unital means

 for v being VECTOR of IT holds 1 * v = v;
end;

definition
  func Trivial-RLSStruct -> strict RLSStruct equals

  RLSStruct(#1,op0,op2,pr2(REAL,1)#);
end;

registration
  cluster Trivial-RLSStruct -> 1-element;
end;

registration
  cluster strict Abelian add-associative non empty for addMagma;
end;

registration
  cluster strict Abelian add-associative right_zeroed right_complementable
    non empty for addLoopStr;
end;

registration
  cluster strict Abelian add-associative right_zeroed right_complementable
    scalar-distributive vector-distributive scalar-associative scalar-unital
     for non empty RLSStruct;
end;

definition
  mode RealLinearSpace is Abelian add-associative right_zeroed
    right_complementable scalar-distributive vector-distributive
    scalar-associative scalar-unital
     non empty RLSStruct;
end;

definition
  let V be Abelian addMagma, v,w be Element of V;
  redefine func v + w;
  commutativity;
end;



reserve V for RealLinearSpace;
reserve v,w for VECTOR of V;

theorem 
  for V being add-associative right_zeroed right_complementable
  addLoopStr holds V is right_add-cancelable;

theorem 
  for V being add-associative right_zeroed right_complementable
  non empty addLoopStr, v being Element of V holds v + 0.V = v & 0.V + v = v;




definition
  let V be non empty addLoopStr;
  let v be Element of V;
  assume
 V is add-associative right_zeroed right_complementable;
  redefine func - v means


  v + it = 0.V;
end;

definition
  let V be addLoopStr;
  let v,w be Element of V;
  redefine func v - w equals

  v + (- w);
end;



theorem 
  for V being add-associative right_zeroed right_complementable
  non empty addLoopStr, v being Element of V holds v + -v = 0.V & -v + v = 0.V;

theorem 
  for V being add-associative right_zeroed right_complementable
non empty addLoopStr, v,w being Element of V holds v + w = 0.V implies v = - w;

theorem 
  for V being add-associative right_zeroed right_complementable non
empty addLoopStr, v,u being Element of V ex w being Element of V st v + w = u;

theorem 
  for V being add-associative right_zeroed right_complementable
non empty addLoopStr, w,u,v1,v2 being Element of V st w + v1 = w + v2 or v1 +
  w = v2 + w holds v1 = v2;

theorem 
  for V being add-associative right_zeroed right_complementable non
empty addLoopStr, v,w being Element of V holds v + w = v or w + v = v implies
  w = 0.V;

theorem 
  a = 0 or v = 0.V implies a * v = 0.V;

theorem 
  a * v = 0.V implies a = 0 or v = 0.V;

theorem 
  for V being add-associative right_zeroed right_complementable
  non empty addLoopStr holds - 0.V = 0.V;

theorem 
  for V being add-associative right_zeroed right_complementable non
  empty addLoopStr, v being Element of V holds v - 0.V = v;

theorem 
  for V being add-associative right_zeroed right_complementable non
  empty addLoopStr, v being Element of V holds 0.V - v = - v;

theorem 
  for V being add-associative right_zeroed right_complementable non
  empty addLoopStr, v being Element of V holds v - v = 0.V;

theorem 
  - v = (- 1) * v;

theorem 
  for V being add-associative right_zeroed right_complementable
  non empty addLoopStr, v being Element of V holds - (- v) = v;

theorem 
  for V being add-associative right_zeroed right_complementable
  non empty addLoopStr, v,w being Element of V holds - v = - w implies v = w;

theorem 
  v = - v implies v = 0.V;

theorem 
  v + v = 0.V implies v = 0.V;

theorem 
  for V being add-associative right_zeroed right_complementable
  non empty addLoopStr, v,w being Element of V holds v - w = 0.V implies v = w;

theorem 
  for V being add-associative right_zeroed right_complementable non
empty addLoopStr, u,v being Element of V ex w being Element of V st v - w = u;

theorem 
  for V being add-associative right_zeroed right_complementable non
empty addLoopStr, w,v1,v2 being Element of V st w - v1 = w - v2 holds v1 = v2;

theorem 
  a * (- v) = (- a) * v;

theorem 
  a * (- v) = - (a * v);

theorem 
  (- a) * (- v) = a * v;

theorem 
  for V being add-associative right_zeroed right_complementable
non empty addLoopStr, v,u,w being Element of V holds v - (u + w) = (v - w) - u;

theorem 
  for V being add-associative non empty addLoopStr, v,u,w being
  Element of V holds (v + u) - w = v + (u - w);

theorem 
  for V being Abelian add-associative right_zeroed right_complementable
non empty addLoopStr, v,u,w being Element of V holds v - (u - w) = (v -u) + w;

theorem 
  for V being add-associative right_zeroed right_complementable
  non empty addLoopStr, v,w being Element of V holds - (v + w) = (- w) - v;

theorem 
  for V being add-associative right_zeroed right_complementable non
  empty addLoopStr, v,w being Element of V holds - (v + w) = -w + -v;

theorem 
  for V being Abelian add-associative right_zeroed right_complementable
  non empty addLoopStr, v,w being Element of V holds (- v) - w = (- w) - v;

theorem 
  for V being add-associative right_zeroed right_complementable non
  empty addLoopStr, v,w being Element of V holds - (v - w) = w + (- v);

theorem 
  a * (v - w) = a * v - a * w;

theorem 
  (a - b) * v = a * v - b * v;

theorem 
  a <> 0 & a * v = a * w implies v = w;

theorem 
  v <> 0.V & a * v = b * v implies a = b;



reserve V for non empty addLoopStr;
reserve F for FinSequence-like PartFunc of NAT,V;
reserve f,f9,g for Function of NAT,V;
reserve v,u for Element of V;
reserve j,k,n for Element of NAT;

definition
  let V; let F be (the carrier of V)-valued FinSequence;
  func Sum(F) -> Element of V means


  ex f st it = f.(len F) & f.0 = 0.V
  & for j,v st j < len F & v = F.(j + 1) holds f.(j + 1) = f.j + v;
end;

theorem 
  for F,G being FinSequence of V holds
  len F = len G + 1 & G = F | (dom G) & v = F.(len F) implies
  Sum(F) = Sum(G) + v;

reserve V for RealLinearSpace;
reserve v for VECTOR of V;
reserve F,G,H,I for FinSequence of V;

theorem 
  len F = len G & (for k,v st k in dom F & v = G.k holds F.k = a * v)
  implies Sum(F) = a * Sum(G);

theorem 
  for V being Abelian add-associative right_zeroed right_complementable
  non empty addLoopStr, F,G being FinSequence of V st len F =
len G & (for k for v being Element of V st k in dom F & v = G.k holds F.k = - v
  ) holds Sum(F) = - Sum(G);

theorem 
  for V being add-associative right_zeroed non empty addLoopStr,
  F,G being FinSequence of V holds Sum(F ^ G) = Sum(F) + Sum(G);

reserve V for add-associative right_zeroed right_complementable non empty
  addLoopStr;
reserve F for FinSequence of V;
reserve v,v1,v2,u,w for Element of V;
reserve j,k for Element of NAT;

theorem 
  for V being Abelian add-associative right_zeroed non empty addLoopStr
, F,G being FinSequence of V st rng F = rng G & F is one-to-one
  & G is one-to-one holds Sum(F) = Sum(G);

theorem 
  for V being non empty addLoopStr holds Sum(<*>(the carrier of V)) = 0.
  V;

theorem 
  for V being add-associative right_zeroed right_complementable non
  empty addLoopStr, v being Element of V holds Sum<* v *> = v;

theorem 
  for V being add-associative right_zeroed right_complementable
  non empty addLoopStr, v,u being Element of V holds Sum<* v,u *> = v + u;

theorem 
  for V being add-associative right_zeroed right_complementable
non empty addLoopStr, v,u,w being Element of V holds Sum<* v,u,w *> = v + u +
  w;

theorem 
  for V being RealLinearSpace, a being Real holds a * Sum(<*>(the
  carrier of V)) = 0.V;

theorem 
  for V being RealLinearSpace, a being Real, v,u being VECTOR of V holds
  a * Sum<* v,u *> = a * v + a * u;

theorem 
  for V being RealLinearSpace, a being Real, v,u,w being VECTOR of V
  holds a * Sum<* v,u,w *> = a * v + a * u + a * w;

theorem 
  - Sum(<*>(the carrier of V)) = 0.V;

theorem 
  - Sum<* v *> = - v;

theorem 
  for V being Abelian add-associative right_zeroed right_complementable
non empty addLoopStr, v,u being Element of V holds - Sum<* v,u *> = (- v) - u;

theorem 
  for V being Abelian add-associative right_zeroed right_complementable
non empty addLoopStr, v,u,w being Element of V holds - Sum<* v,u,w *> = ((- v
  ) - u) - w;

theorem 
  for V being Abelian add-associative right_zeroed right_complementable
  non empty addLoopStr, v,w being Element of V holds Sum<* v,w *> = Sum<* w,v
  *>;

theorem 
  Sum<* v,w *> = Sum<* v *> + Sum<* w *>;

canceled;

theorem 
  Sum<* 0.V,v *> = v & Sum<* v,0.V *> = v;

theorem 
  Sum<* v,- v *> = 0.V & Sum<* - v,v *> = 0.V;

theorem 
  Sum<* v,- w *> = v - w;

theorem 
  Sum<* - v,- w *> = - (w + v);

theorem 
  for V being RealLinearSpace, v being VECTOR of V holds Sum<* v,v *> = 2 * v;

theorem 
  for V being RealLinearSpace, v being VECTOR of V holds Sum<* - v,- v
  *> = (- 2) * v;

theorem 
  Sum<* u,v,w *> = Sum<* u *> + Sum<* v *> + Sum<* w *>;

theorem 
  Sum<* u,v,w *> = Sum<* u,v *> + w;

theorem 
  for V being Abelian add-associative right_zeroed right_complementable
non empty addLoopStr, v,u,w being Element of V holds Sum<* u,v,w *> = Sum<* v
  ,w *> + u;

theorem 
  for V being Abelian add-associative right_zeroed
right_complementable non empty addLoopStr, v,u,w being Element of V holds Sum
  <* u,v,w *> = Sum<* u,w *> + v;

theorem 
  for V being Abelian add-associative right_zeroed
right_complementable non empty addLoopStr, v,u,w being Element of V holds Sum
  <* u,v,w *> = Sum<* u,w,v *>;

theorem 
  for V being Abelian add-associative right_zeroed
right_complementable non empty addLoopStr, v,u,w being Element of V holds Sum
  <* u,v,w *> = Sum<* v,u,w *>;

theorem 
  for V being Abelian add-associative right_zeroed
right_complementable non empty addLoopStr, v,u,w being Element of V holds Sum
  <* u,v,w *> = Sum<* v,w,u *>;

theorem 
  for V being Abelian add-associative right_zeroed right_complementable
non empty addLoopStr, v,u,w being Element of V holds Sum<* u,v,w *> = Sum<* w
  ,v,u *>;

canceled;

theorem 
  Sum<* 0.V,0.V,v *> = v & Sum<* 0.V,v,0.V *> = v & Sum<* v,0.V,0.V *> = v;

theorem 
  Sum<* 0.V,u,v *> = u + v & Sum<* u,v,0.V *> = u + v & Sum<* u,0.V,v *>
  = u + v;

theorem 
  for V being RealLinearSpace, v being VECTOR of V holds Sum<* v,v,v *> = 3 * v
;

theorem 
  len F = 0 implies Sum(F) = 0.V;

theorem 
  len F = 1 implies Sum(F) = F.1;

theorem 
  len F = 2 & v1 = F.1 & v2 = F.2 implies Sum(F) = v1 + v2;

theorem 
  len F = 3 & v1 = F.1 & v2 = F.2 & v = F.3 implies Sum(F) = v1 + v2 + v;

begin 

definition
  let L be non empty addLoopStr;
  attr L is zeroed means


  for a being Element of L holds a+0.L = a & 0.L+a = a;
end;

registration
  cluster zeroed -> right_zeroed for non empty addLoopStr;
end;

registration
  cluster Abelian right_zeroed -> zeroed for non empty addLoopStr;
  cluster Abelian right_complementable -> left_complementable for non empty
    addLoopStr;
end;



reserve V for RealLinearSpace;
reserve v for VECTOR of V;

theorem 
  (- a) * v = - a * v;

begin 

reserve x,y for set,
  k,n for Element of NAT;

theorem 
  for V being Abelian add-associative right_zeroed right_complementable
  non empty addLoopStr holds - Sum(<*>(the carrier of V)) = 0.V;

theorem 
  for V being Abelian add-associative right_zeroed right_complementable
non empty addLoopStr, v,u being Element of V holds - Sum<* v,u *> = (- v) - u;

theorem 
  for V being Abelian add-associative right_zeroed right_complementable
    non empty addLoopStr, v,u,w being Element of V holds
  - Sum<* v,u,w *> = ((- v) - u) - w;

theorem 
  for V being Abelian add-associative right_zeroed right_complementable
non empty addLoopStr, v being Element of V holds
  Sum<* v,- v *> = 0.V & Sum<*- v,v *> = 0.V;

theorem 
  for V being Abelian add-associative right_zeroed right_complementable
  non empty addLoopStr, v,w being Element of V holds
  Sum<* v,- w *> = v - w & Sum<* - w,v *> = v - w;

theorem 
  for V being Abelian add-associative right_zeroed right_complementable
  non empty addLoopStr, v,w being Element of V holds
  Sum<* - v,- w *> = - (v + w) & Sum<* - w,- v *> = - (v + w);














begin

reserve V,X,Y for RealLinearSpace;
reserve u,u1,u2,v,v1,v2 for VECTOR of V;
reserve a for Real;
reserve V1,V2,V3 for Subset of V;
reserve x for set;





definition
  let V;
  let V1;
  attr V1 is linearly-closed means


  (for v,u st v in V1 & u in V1 holds
  v + u in V1) & for a,v st v in V1 holds a * v in V1;
end;

theorem 
  V1 <> {} & V1 is linearly-closed implies 0.V in V1;

theorem 
  V1 is linearly-closed implies for v st v in V1 holds - v in V1;

theorem 
  V1 is linearly-closed implies for v,u st v in V1 & u in V1 holds v - u in V1;

theorem 
  {0.V} is linearly-closed;

theorem 
  the carrier of V = V1 implies V1 is linearly-closed;

theorem 
  V1 is linearly-closed & V2 is linearly-closed & V3 = {v + u : v in V1
  & u in V2} implies V3 is linearly-closed;

theorem 
  V1 is linearly-closed & V2 is linearly-closed implies V1 /\ V2 is
  linearly-closed;

definition
  let V;
  mode Subspace of V -> RealLinearSpace means


    the carrier of it c= the
carrier of V & 0.it = 0.V & the addF of it = (the addF of V)||the carrier of it
    & the Mult of it = (the Mult of V) | [:REAL, the carrier of it:];
end;

reserve W,W1,W2 for Subspace of V;
reserve w,w1,w2 for VECTOR of W;





theorem 
  x in W1 & W1 is Subspace of W2 implies x in W2;

theorem 
  x in W implies x in V;

theorem 
  w is VECTOR of V;

theorem 
  0.W = 0.V;

theorem 
  0.W1 = 0.W2;

theorem 
  w1 = v & w2 = u implies w1 + w2 = v + u;

theorem 
  w = v implies a * w = a * v;

theorem 
  w = v implies - v = - w;

theorem 
  w1 = v & w2 = u implies w1 - w2 = v - u;

theorem 
  0.V in W;

theorem 
  0.W1 in W2;

theorem 
  0.W in V;

theorem 
  u in W & v in W implies u + v in W;

theorem 
  v in W implies a * v in W;

theorem 
  v in W implies - v in W;

theorem 
  u in W & v in W implies u - v in W;

reserve D for non empty set;
reserve d1 for Element of D;
reserve A for BinOp of D;
reserve M for Function of [:REAL,D:],D;

theorem 
  V1 = D & d1 = 0.V & A = (the addF of V)||V1 & M = (the Mult of V
  ) | [:REAL,V1:] implies RLSStruct (# D,d1,A,M #) is Subspace of V;

theorem 
  V is Subspace of V;

theorem 
  for V,X being strict RealLinearSpace holds V is Subspace of X &
  X is Subspace of V implies V = X;

theorem 
  V is Subspace of X & X is Subspace of Y implies V is Subspace of Y;

theorem 
  the carrier of W1 c= the carrier of W2 implies W1 is Subspace of W2;

theorem 
  (for v st v in W1 holds v in W2) implies W1 is Subspace of W2;

registration
  let V;
  cluster strict for Subspace of V;
end;

theorem 
  for W1,W2 being strict Subspace of V holds the carrier of W1 =
  the carrier of W2 implies W1 = W2;

theorem 
  for W1,W2 being strict Subspace of V holds (for v holds v in W1
  iff v in W2) implies W1 = W2;

theorem 
  for V being strict RealLinearSpace, W being strict Subspace of V holds
  the carrier of W = the carrier of V implies W = V;

theorem 
  for V being strict RealLinearSpace, W being strict Subspace of V holds
  (for v being VECTOR of V holds v in W iff v in V) implies W = V;

theorem 
  the carrier of W = V1 implies V1 is linearly-closed;

theorem 
  V1 <> {} & V1 is linearly-closed implies ex W being strict
  Subspace of V st V1 = the carrier of W;





definition
  let V;
  func (0).V -> strict Subspace of V means


  the carrier of it = {0.V};
end;

definition
  let V;
  func (Omega).V -> strict Subspace of V equals

  the RLSStruct of V;
end;





theorem 
  (0).W = (0).V;

theorem 
  (0).W1 = (0).W2;

theorem 
  (0).W is Subspace of V;

theorem 
  (0).V is Subspace of W;

theorem 
  (0).W1 is Subspace of W2;

theorem 
  for V being strict RealLinearSpace holds V is Subspace of (Omega).V;





definition
  let V;
  let v,W;
  func v + W -> Subset of V equals

  {v + u : u in W};
end;

definition
  let V;
  let W;
  mode Coset of W -> Subset of V means


    ex v st it = v + W;
end;

reserve B,C for Coset of W;





theorem 
  0.V in v + W iff v in W;

theorem 
  v in v + W;

theorem 
  0.V + W = the carrier of W;

theorem 
  v + (0).V = {v};

theorem 
  v + (Omega).V = the carrier of V;

theorem 
  0.V in v + W iff v + W = the carrier of W;

theorem 
  v in W iff v + W = the carrier of W;

theorem 
  v in W implies (a * v) + W = the carrier of W;

theorem 
  a <> 0 & (a * v) + W = the carrier of W implies v in W;

theorem 
  v in W iff - v + W = the carrier of W;

theorem 
  u in W iff v + W = (v + u) + W;

theorem 
  u in W iff v + W = (v - u) + W;

theorem 
  v in u + W iff u + W = v + W;

theorem 
  v + W = (- v) + W iff v in W;

theorem 
  u in v1 + W & u in v2 + W implies v1 + W = v2 + W;

theorem 
  u in v + W & u in (- v) + W implies v in W;

theorem 
  a <> 1 & a * v in v + W implies v in W;

theorem 
  v in W implies a * v in v + W;

theorem 
  - v in v + W iff v in W;

theorem 
  u + v in v + W iff u in W;

theorem 
  v - u in v + W iff u in W;

theorem 
  u in v + W iff ex v1 st v1 in W & u = v + v1;

theorem 
  u in v + W iff ex v1 st v1 in W & u = v - v1;

theorem 
  (ex v st v1 in v + W & v2 in v + W) iff v1 - v2 in W;

theorem 
  v + W = u + W implies ex v1 st v1 in W & v + v1 = u;

theorem 
  v + W = u + W implies ex v1 st v1 in W & v - v1 = u;

theorem 
  for W1,W2 being strict Subspace of V holds v + W1 = v + W2 iff W1 = W2;

theorem 
  for W1,W2 being strict Subspace of V holds v + W1 = u + W2 implies W1 = W2;






theorem 
  C is linearly-closed iff C = the carrier of W;

theorem 
  for W1,W2 being strict Subspace of V, C1 being Coset of W1, C2 being
  Coset of W2 holds C1 = C2 implies W1 = W2;

theorem 
  {v} is Coset of (0).V;

theorem 
  V1 is Coset of (0).V implies ex v st V1 = {v};

theorem 
  the carrier of W is Coset of W;

theorem 
  the carrier of V is Coset of (Omega).V;

theorem 
  V1 is Coset of (Omega).V implies V1 = the carrier of V;

theorem 
  0.V in C iff C = the carrier of W;

theorem 
  u in C iff C = u + W;

theorem 
  u in C & v in C implies ex v1 st v1 in W & u + v1 = v;

theorem 
  u in C & v in C implies ex v1 st v1 in W & u - v1 = v;

theorem 
  (ex C st v1 in C & v2 in C) iff v1 - v2 in W;

theorem 
  u in B & u in C implies B = C;














begin

reserve m,n for Nat;
reserve i,j for Integer;
reserve S for non empty multMagma;
reserve r,r1,r2,s,s1,s2,t,t1,t2 for Element of S;

definition
  let IT be multMagma;

  attr IT is unital means


  ex e being Element of IT st for h being
  Element of IT holds h * e = h & e * h = h;
  attr IT is Group-like means


  ex e being Element of IT st for h being
Element of IT holds h * e = h & e * h = h & ex g being Element of IT st h * g =
  e & g * h = e;
  attr IT is associative means


  for x,y,z being Element of IT holds (x*y )*z = x*(y*z);
end;

registration
  cluster Group-like -> unital for multMagma;
end;

registration
  cluster strict Group-like associative non empty for multMagma;
end;

definition
  mode Group is Group-like associative non empty multMagma;
end;

theorem 
  ((for r,s,t holds (r * s) * t = r * (s * t)) & ex t st for s1 holds s1
* t = s1 & t * s1 = s1 & ex s2 st s1 * s2 = t & s2 * s1 = t) implies S is Group
;

theorem 
  (for r,s,t holds r * s * t = r * (s * t)) & (for r,s holds (ex t st r
  * t = s) & (ex t st t * r = s)) implies S is associative Group-like;

theorem 
  multMagma (# REAL, addreal #) is associative Group-like;

reserve G for Group-like non empty multMagma;
reserve e,h for Element of G;

definition
  let G be multMagma such that
 G is unital;
  func 1_G -> Element of G means


  for h being Element of G holds h * it = h & it * h = h;
end;

theorem 
  (for h holds h * e = h & e * h = h) implies e = 1_G;

reserve G for Group;
reserve f,g,h for Element of G;

definition
  let G,h;
  func h" -> Element of G means


  h * it = 1_G & it * h = 1_G;
  involutiveness;
end;

theorem 
  h * g = 1_G & g * h = 1_G implies g = h";

theorem 
  h * g = h * f or g * h = f * h implies g = f;

theorem 
  h * g = h or g * h = h implies g = 1_G;

theorem 
  (1_G)" = 1_G;

theorem 
  h" = g" implies h = g;

theorem 
  h" = 1_G implies h = 1_G;

canceled;

theorem 
  h * g = 1_G implies h = g" & g = h";

theorem 
  h * f = g iff f = h" * g;

theorem 
  f * h = g iff f = g * h";

theorem 
  ex f st g * f = h;

theorem 
  ex f st f * g = h;

theorem 
  (h * g)" = g" * h";

theorem 
  g * h = h * g iff (g * h)" = g" * h";

theorem 
  g * h = h * g iff g" * h" = h" * g";

theorem 
  g * h = h * g iff g * h" = h" * g;

reserve u for UnOp of G;

definition
  let G;
  func inverse_op(G) -> UnOp of G means


  it.h = h";
end;

registration
  let G be associative non empty multMagma;
  cluster  the multF of G -> associative;
end;

theorem 
  for G being unital non empty multMagma holds 1_G is_a_unity_wrt
  the multF of G;

theorem 
  for G being unital non empty multMagma holds the_unity_wrt the
  multF of G = 1_G;

registration
  let G be unital non empty multMagma;
  cluster the multF of G -> having_a_unity;
end;

theorem 
  inverse_op(G) is_an_inverseOp_wrt the multF of G;

registration
  let G;
  cluster the multF of G -> having_an_inverseOp;
end;

theorem 
  the_inverseOp_wrt the multF of G = inverse_op(G);

definition
  let G be non empty multMagma;
  func power G -> Function of [:the carrier of G,NAT:], the carrier of G means


  for h being Element of G holds it.(h,0) = 1_G & for n being Element of
  NAT holds it.(h,n + 1) = it.(h,n) * h;
end;

definition
  let G,i,h;
  func h |^ i -> Element of G equals


  power(G).(h,abs(i)) if 0 <= i
  otherwise (power(G).(h,abs(i)))";
end;

definition
  let G,n,h;
  redefine func h |^ n equals

  power(G).(h,n);
end;

theorem 
  h |^ 0 = 1_G;

theorem 
  h |^ 1 = h;

theorem 
  h |^ 2 = h * h;

theorem 
  h |^ 3 = h * h * h;

theorem 
  h |^ 2 = 1_G iff h" = h;

theorem 
  i <= 0 implies h |^ i = (h |^ abs(i))";

theorem 
  (1_G) |^ i = 1_G;

theorem 
  h |^ (-1) = h";

theorem 
  h |^ (i + j) = (h |^ i) * (h |^ j);

theorem 
  h |^ (i + 1) = h |^ i * h & h |^ (i + 1) = h * (h |^ i);

theorem 
  h |^ (i * j) = h |^ i |^ j;

theorem 
  h |^ -i = (h |^ i)";

theorem 
  h" |^ i = (h |^ i)";

theorem 
  g * h = h * g implies (g * h) |^ i = g |^ i * (h |^ i);

theorem 
  g * h = h * g implies g |^ i * (h |^ j) = h |^ j * (g |^ i);

theorem 
  g * h = h * g implies g * (h |^ i) = h |^ i * g;

definition
  let G,h;
  attr h is being_of_order_0 means


  h |^ n = 1_G implies n = 0;
end;

registration
  let G;
  cluster 1_G -> non being_of_order_0;
end;

definition
  let G,h;
  func ord h -> Element of NAT means


  it = 0 if h is being_of_order_0
  otherwise
  h |^ it = 1_G & it <> 0 & for m st h |^ m = 1_G & m <> 0 holds it <= m;
end;

theorem 
  h |^ ord h = 1_G;

theorem 
  ord 1_G = 1;

theorem 
  ord h = 1 implies h = 1_G;

theorem 
  h |^ n = 1_G implies ord h divides n;

definition
  let G be finite 1-sorted;

  redefine func card G -> Element of NAT;
end;

theorem 
  for G being non empty finite 1-sorted holds card G >= 1;

definition

  let IT be multMagma;
  attr IT is commutative means


  for x, y being Element of IT holds x*y = y*x;
end;

registration
  cluster strict commutative for Group;
end;

definition
  let FS be commutative non empty multMagma;
  let x,y be Element of FS;
  redefine func x*y;
  commutativity;
end;

theorem 
  multMagma (# REAL, addreal #) is commutative Group;

reserve A for commutative Group;
reserve a,b for Element of A;

theorem 
  (a * b)" = a" * b";

theorem 
  (a * b) |^ i = a |^ i * (b |^ i);

theorem 
  addLoopStr (# the carrier of A, the multF of A, 1_A #) is Abelian
  add-associative right_zeroed right_complementable;

begin 


theorem 
  for L be unital non empty multMagma for x be Element of L holds
  (power L).(x,1) = x;

theorem 
  for L be unital non empty multMagma for x be Element of L holds (power
  L).(x,2) = x*x;

theorem 
  for L be associative commutative unital non empty multMagma for x,y be
Element of L for n be Element of NAT holds (power L).(x*y,n) = (power L).(x,n)
  * (power L).(y,n);



definition
  let G,H be multMagma;
  let IT be Function of G,H;
  attr IT is unity-preserving means

  IT.1_G = 1_H;
end;














begin 

definition

  func G_Real -> strict addLoopStr equals

  addLoopStr (# REAL,addreal,0 #);
end;

registration
  cluster G_Real -> non empty;
end;

registration
  cluster the carrier of G_Real -> real-membered;
end;

registration
  let a,b be Element of G_Real, x,y be real number;
  identify a+b with x+y when a = x, b = y;
end;

registration
  cluster G_Real -> Abelian add-associative right_zeroed right_complementable;
end;

registration
  let a be Element of G_Real, x be real number;
  identify -a with -x when a = x;
end;

theorem 
  for x,y,z being Element of G_Real holds x+y = y+x & (x+y)+z = x+(y+z)
  & x+(0.G_Real) = x & x+(-x) = 0.G_Real;

registration
  cluster strict add-associative right_zeroed right_complementable Abelian for

    non empty addLoopStr;
end;

definition
  mode AddGroup is add-associative right_zeroed right_complementable non
    empty addLoopStr;
end;

definition
  mode AbGroup is Abelian AddGroup;
end;



definition
  let IT be non empty doubleLoopStr;

  attr IT is right-distributive means


  for a, b, c being Element of IT holds a*(b+c) = a*b + a*c;
  attr IT is left-distributive means


  for a, b, c being Element of IT holds (b+c)*a = b*a + c*a;
end;

definition
  let IT be non empty multLoopStr;
  attr IT is right_unital means


  for x being Element of IT holds x * 1. IT = x;
end;

definition

  func F_Real -> strict doubleLoopStr equals

  doubleLoopStr (# REAL,addreal,multreal,1,0 #);
end;

registration
  cluster F_Real -> non empty;
end;

registration
  cluster the carrier of F_Real -> real-membered;
end;

registration
  let a,b be Element of F_Real, x,y be real number;
  identify a+b with x+y when a = x, b = y;
end;

registration
  let a,b be Element of F_Real, x,y be real number;
  identify a*b with x*y when a = x, b = y;
end;

definition
  let IT be non empty multLoopStr;
  attr IT is well-unital means


  for x being Element of IT holds x * 1. IT = x & 1.IT * x = x;
end;

registration
  cluster F_Real -> well-unital;
end;

registration
  cluster well-unital for non empty multLoopStr_0;
end;

definition
  let IT be non empty doubleLoopStr;

  attr IT is distributive means


  for x,y,z being Element of IT holds x* (y+z) = x*y+x*z & (y+z)*x = y*x+z*x;
end;

definition
  let IT be non empty multLoopStr;
  attr IT is left_unital means


  for x being Element of IT holds 1.IT * x = x;
end;

definition
  let IT be non empty multLoopStr_0;
  redefine attr IT is almost_left_invertible means


  for x being Element of IT st x <> 0.IT ex y be Element of IT st y*x = 1.IT;
end;

registration
  cluster F_Real -> unital;
end;

registration
  cluster F_Real -> add-associative right_zeroed right_complementable Abelian
    commutative associative left_unital right_unital distributive
    almost_left_invertible non degenerated;
end;

registration
  let a be Element of F_Real, x be real number;
  identify -a with -x when a = x;
end;

registration
  cluster distributive -> left-distributive right-distributive for non empty
    doubleLoopStr;
  cluster left-distributive right-distributive -> distributive for non empty
    doubleLoopStr;
end;

registration
  cluster well-unital -> left_unital right_unital for non empty multLoopStr;
  cluster left_unital right_unital -> unital for non empty multLoopStr;
end;

registration
  cluster commutative associative for non empty multMagma;
end;

registration
  cluster commutative associative unital for non empty multLoopStr;
end;

registration
  cluster add-associative right_zeroed right_complementable Abelian
    commutative associative left_unital right_unital distributive
    almost_left_invertible non degenerated well-unital strict for non empty
    doubleLoopStr;
end;

definition
  mode Field is add-associative right_zeroed right_complementable Abelian
    commutative associative well-unital distributive almost_left_invertible non
    degenerated non empty doubleLoopStr;
end;

theorem 
  1.F_Real = 1;

theorem 
  for x,y,z being Element of F_Real holds x+y = y+x & (x+y)+z = x+(y+z)
  & x+(0.F_Real) = x & x+(-x) = 0.F_Real & x*y = y*x & (x*y)*z = x*(y*z) & (1.
  F_Real)*x = x & (x <> 0.F_Real implies ex y be Element of F_Real st y*x = 1.
  F_Real) & x*(y+z) = x*y+x*z & (y+z)*x = y*x+z*x;

theorem 
  for FS being non empty doubleLoopStr holds (for x,y,z being Element of
FS holds (x <> 0.FS implies ex y be Element of FS st y*x = 1.FS) & x*(y+z) = x*
y+x*z & (y+z)*x = y*x+z*x ) iff FS is distributive almost_left_invertible non
  empty doubleLoopStr;



registration
  cluster well-unital -> unital for non empty multLoopStr;
end;

theorem 
  for F being associative commutative well-unital distributive
  almost_left_invertible non empty doubleLoopStr, x,y,z being Element of F
  holds (x <> 0.F & x*y = x*z) implies y = z;

definition
  let F be associative commutative well-unital almost_left_invertible non
  empty doubleLoopStr, x be Element of F;

  assume
 x <> 0.F;
  redefine func x" means


  it*x = 1.F;
end;

definition
  let F be associative commutative well-unital distributive
  almost_left_invertible non empty doubleLoopStr, x,y be Element of F;
  func x/y ->Element of F equals

  x*y";
end;

theorem 
  for F being add-associative right_zeroed right_complementable
right-distributive non empty doubleLoopStr, x being Element of F holds x*(0.F
  ) = 0.F;

theorem 
  for F being add-associative right_zeroed right_complementable
left-distributive non empty doubleLoopStr, x being Element of F holds (0.F)*x
  = 0.F;

theorem 
  for F be add-associative right_zeroed right_complementable
right-distributive non empty doubleLoopStr, x,y being Element of F holds x*(-
  y) = -x*y;

theorem 
  for F be add-associative right_zeroed right_complementable
left-distributive non empty doubleLoopStr, x,y being Element of F holds (-x)*
  y = -x*y;

theorem 
  for F be add-associative right_zeroed right_complementable
distributive non empty doubleLoopStr, x,y being Element of F holds (-x)*(-y)
  = x*y;

theorem 
  for F be add-associative right_zeroed right_complementable
right-distributive non empty doubleLoopStr, x,y,z being Element of F holds x*
  (y-z) = x*y - x*z;

theorem 
  for F being add-associative right_zeroed right_complementable
  associative commutative well-unital almost_left_invertible distributive non
  empty doubleLoopStr, x,y being Element of F holds x*y=0.F iff x=0.F or y=0.F;

theorem 
  for K being add-associative right_zeroed right_complementable
left-distributive non empty doubleLoopStr for a,b,c be Element of K holds (a-
  b)*c =a*c -b*c;



definition
  let F be 1-sorted;
  struct(addLoopStr) VectSpStr over F (# carrier -> set, addF -> BinOp of the
carrier, ZeroF -> Element of the carrier, lmult -> Function of [:the carrier of
    F,the carrier:], the carrier #);
end;

registration
  let F be 1-sorted;
  cluster non empty strict for VectSpStr over F;
end;

registration
  let F be 1-sorted;
  let A be non empty set, a be BinOp of A, Z be Element of A, l be Function of
  [:the carrier of F,A:], A;
  cluster VectSpStr(#A,a,Z,l#) -> non empty;
end;

definition
  let F be 1-sorted;
  mode Scalar of F is Element of F;
end;

definition
  let F be 1-sorted;
  let VS be VectSpStr over F;
  mode Scalar of VS is Scalar of F;
  mode Vector of VS is Element of VS;
end;

definition
  let F be non empty 1-sorted, V be non empty VectSpStr over F;
  let x be Element of F;
  let v be Element of V;
  func x*v -> Element of V equals

  (the lmult of V).(x,v);
end;

definition
  let F be non empty addLoopStr;
  func comp F -> UnOp of the carrier of F means

  for x being Element of F holds it.x = -x;
end;

definition
  let F be non empty doubleLoopStr;
  let IT be non empty VectSpStr over F;
  attr IT is vector-distributive means


  for x being Element of F for v,w being Element of IT holds x*(v+w) = x*v+x*w;
  attr IT is scalar-distributive means


  for x,y being Element of F for v being Element of IT holds (x+y)*v = x*v+y*v;
  attr IT is scalar-associative means


  for x,y being Element of F for v being Element of IT holds (x*y)*v = x*(y*v);
  attr IT is scalar-unital means


   for v being Element of IT holds (1.F)*v = v;
end;

registration
  let F be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr;
  cluster scalar-distributive vector-distributive scalar-associative
    scalar-unital add-associative right_zeroed right_complementable
    Abelian strict for non empty VectSpStr over F;
end;

definition
  let F be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr;
  mode VectSp of F is scalar-distributive vector-distributive
  scalar-associative scalar-unital add-associative right_zeroed
    right_complementable Abelian non empty VectSpStr over F;
end;

reserve F for Field,
  x for Element of F,
  V for VectSp of F,
  v for Element of V;

theorem 
  for F being add-associative right_zeroed right_complementable
Abelian associative well-unital distributive non empty doubleLoopStr, x being
  Element of F for V being add-associative right_zeroed right_complementable
scalar-distributive vector-distributive scalar-associative scalar-unital
 non empty VectSpStr over F,
  v being Element of V
 holds (0.F)*v =
  0.V & (-1.F)*v = -v & x*(0.V) = 0.V;

theorem 
  x*v = 0.V iff x = 0.F or v = 0.V;



theorem 
  for V being add-associative right_zeroed right_complementable non
  empty addLoopStr, v,w being Element of V holds v+w=0.V iff -v=w;

theorem 
  for V being add-associative right_zeroed right_complementable non
empty addLoopStr, u,v,w being Element of V holds -(v+w)=-w-v & -(w+-v)=v-w & -
  (v-w)=w+-v & -(-v-w)=w+v & u-(w+v)=u-v-w;

theorem 
  for V being add-associative right_zeroed right_complementable non
empty addLoopStr, v being Element of V holds 0.V-v=-v & v-0.V=v;

theorem 
  for F being add-associative right_zeroed right_complementable
non empty addLoopStr, x,y being Element of F holds (x+(-y)=0.F iff x=y) & (x-y
  =0.F iff x=y);

theorem 
  x<>0.F implies x"*(x*v)=v;

theorem 
  for F be add-associative right_zeroed right_complementable
  Abelian associative well-unital distributive non empty doubleLoopStr, V be
  scalar-distributive vector-distributive scalar-associative scalar-unital
  add-associative right_zeroed right_complementable non empty
VectSpStr over F, x being Element of F, v,w being Element of V holds -x*v=(-x)
  *v & w-x*v=w+(-x)*v;

registration
  cluster commutative left_unital -> right_unital for non empty multLoopStr;
end;

theorem 
  for F be add-associative right_zeroed right_complementable
  Abelian associative well-unital right_unital distributive non empty
  doubleLoopStr, V be scalar-distributive vector-distributive
  scalar-associative scalar-unital add-associative right_zeroed
  right_complementable non empty VectSpStr over F, x being Element of F, v
  being Element of V holds x*(-v)=-x*v;

theorem 
  for F be add-associative right_zeroed right_complementable Abelian
associative well-unital right_unital distributive non empty doubleLoopStr, V
  be scalar-distributive vector-distributive scalar-associative scalar-unital
  add-associative right_zeroed right_complementable non empty
VectSpStr over F, x being Element of F, v,w being Element of V holds x*(v-w)=x
  *v-x*w;

theorem 
  for F being add-associative right_zeroed right_complementable
  commutative associative well-unital non degenerated almost_left_invertible
  distributive non empty doubleLoopStr, x being Element of F holds x <> 0.F
  implies (x")" = x;

theorem 
  for F being Field, x being Element of F holds x <> 0.F implies x" <>
  0.F & -x" <> 0.F;

theorem 
  1.F_Real + 1.F_Real <> 0.F_Real;

definition
  let IT be non empty addLoopStr;
  attr IT is Fanoian means


  for a being Element of IT st a + a = 0.IT holds a = 0.IT;
end;

registration
  cluster Fanoian for non empty addLoopStr;
end;

definition
  let F be add-associative right_zeroed right_complementable commutative
  associative well-unital almost_left_invertible non degenerated distributive
  non empty doubleLoopStr;
  redefine attr F is Fanoian means


  1.F+1.F<>0.F;
end;

registration
  cluster strict Fanoian for Field;
end;

theorem 
  for F being add-associative right_zeroed right_complementable non
  empty addLoopStr, a,b being Element of F holds a - b = 0.F implies a = b;

theorem 
  for F being add-associative right_zeroed right_complementable
  non empty addLoopStr, a being Element of F holds -a = 0.F implies a = 0.F;

theorem 
  for F being add-associative right_zeroed right_complementable non
empty addLoopStr, a, b being Element of F holds a - b = 0.F implies b - a = 0.
  F;

theorem 
  for a, b, c being Element of F holds (a <> 0.F & a*c - b = 0.F implies
  c = b*a") & (a <> 0.F & b - c*a = 0.F implies c = b*a");

theorem 
  for F being add-associative right_zeroed right_complementable non
  empty addLoopStr, a, b being Element of F holds a + b = -(-b + -a);

theorem 
  for F being add-associative right_zeroed right_complementable non
  empty addLoopStr, a, b, c being Element of F holds (b+a)-(c+a) = b-c;

theorem 
  for G being add-associative right_zeroed right_complementable non
  empty addLoopStr, v,w being Element of G holds -(-v+w) = -w+v;

theorem 
  for G being Abelian add-associative non empty addLoopStr, u,v,w
  being Element of G holds u - v - w = u - w - v;

theorem 
  for B being AbGroup holds multMagma (# the carrier of B, the addF of B
  #) is commutative Group;

begin 


theorem 
  for L be add-associative right_zeroed right_complementable
right-distributive unital non empty doubleLoopStr for n be Element of NAT st
  n > 0 holds (power L).(0.L,n) = 0.L;



registration
  cluster well-unital for non empty multLoopStr;
end;

registration
  let S be well-unital non empty multLoopStr;
  identify 1_S with 1.S;
end;

theorem 
  for L being non empty multLoopStr st L is well-unital holds 1.L = 1_L;

definition
  let G,H be non empty addMagma;
  let f be Function of G,H;
  attr f is additive means

    for x,y being Element of G holds f.(x+y) = f.x+f.y;
end;















begin 

reserve L for non empty addLoopStr;
reserve a,b,c,x for Element of L;

theorem 
  (for a holds a + 0.L = a) & (for a ex x st a+x = 0.L) & (for a,b,
  c holds (a+b)+c = a+(b+c)) implies (a+b = 0.L implies b+a = 0.L);

theorem 
  (for a holds a + 0.L = a) & (for a ex x st a+x = 0.L) & (for a,b,c
  holds (a+b)+c = a+(b+c)) implies 0.L+a = a+0.L;

theorem 
  (for a holds a + 0.L = a) & (for a ex x st a+x = 0.L) & (for a,b,c
  holds (a+b)+c = a+(b+c)) implies for a ex x st x+a = 0.L;

definition
  let x be set;

  func Extract x -> Element of {x} equals

  x;
end;

theorem 
  for a,b being Element of Trivial-addLoopStr holds a = b;

theorem 
  for a,b be Element of Trivial-addLoopStr holds a+b = 0.
  Trivial-addLoopStr;

definition
  let IT be non empty addLoopStr;

  attr IT is left_zeroed means


  for a being Element of IT holds 0.IT + a = a;
end;

definition
  let L be non empty addLoopStr;

  attr L is add-left-invertible means


  for a,b be Element of L ex x being Element of L st x + a = b;
  attr L is add-right-invertible means


  for a,b be Element of L ex x being Element of L st a + x = b;
end;

definition
  let IT be non empty addLoopStr;

  attr IT is Loop-like means


  IT is left_add-cancelable
  right_add-cancelable add-left-invertible add-right-invertible;
end;

registration
  cluster Loop-like -> left_add-cancelable right_add-cancelable
    add-left-invertible add-right-invertible for non empty addLoopStr;
  cluster left_add-cancelable right_add-cancelable add-left-invertible
    add-right-invertible -> Loop-like for non empty addLoopStr;
end;

theorem 
  for L being non empty addLoopStr holds L is Loop-like iff (for a,
b be Element of L ex x being Element of L st a+x=b) & (for a,b be Element of L
  ex x being Element of L st x+a=b) & (for a,x,y be Element of L holds a+x=a+y
  implies x=y) & for a,x,y be Element of L holds x+a=y+a implies x=y;

registration
  cluster Trivial-addLoopStr -> add-associative Loop-like right_zeroed
    left_zeroed;
end;

registration
  cluster strict left_zeroed right_zeroed Loop-like for non empty addLoopStr;
end;

definition
  mode Loop is left_zeroed right_zeroed Loop-like non empty addLoopStr;
end;

registration
  cluster strict add-associative for Loop;
end;

registration
  cluster Loop-like -> add-left-invertible for non empty addLoopStr;
  cluster add-associative right_zeroed right_complementable -> left_zeroed
    Loop-like for non empty addLoopStr;
end;

theorem 
  L is AddGroup iff (for a holds a + 0.L = a) & (for a ex x st a+x
  = 0.L) & for a,b,c holds (a+b)+c = a+(b+c);

registration
  cluster Trivial-addLoopStr -> Abelian;
end;

registration
  cluster strict Abelian for AddGroup;
end;

theorem 
  L is Abelian AddGroup iff (for a holds a + 0.L = a) & (for a ex x st a
  +x = 0.L) & (for a,b,c holds (a+b)+c = a+(b+c)) & for a,b holds a+b = b+a;

registration
  cluster Trivial-multLoopStr -> non empty;
end;

theorem 
  for a,b being Element of Trivial-multLoopStr holds a = b;

theorem 
  for a,b be Element of Trivial-multLoopStr holds a*b = 1.
  Trivial-multLoopStr;

definition
  let IT be non empty multLoopStr;

  attr IT is invertible means


  (for a,b be Element of IT ex x being
Element of IT st a*x=b) & for a,b be Element of IT ex x being Element of IT st
  x*a=b;

end;

notation
  let L be non empty multLoopStr;
  synonym L is cancelable for L is mult-cancelable;
end;

registration
  cluster strict well-unital invertible cancelable for non empty multLoopStr;
end;

definition
  mode multLoop is well-unital invertible cancelable non empty multLoopStr;
end;

registration
  cluster Trivial-multLoopStr -> well-unital invertible cancelable;
end;

registration
  cluster strict associative for multLoop;
end;

definition
  mode multGroup is associative multLoop;
end;

reserve L for non empty multLoopStr;
reserve a,b,c,x,y,z for Element of L;

theorem 
  L is multGroup iff (for a holds a * 1.L = a) & (for a ex x st a*
  x = 1.L) & for a,b,c holds (a*b)*c = a*(b*c);

registration
  cluster Trivial-multLoopStr -> associative;
end;

registration
  cluster strict commutative for multGroup;
end;

theorem 
  L is commutative multGroup iff (for a holds a * 1.L = a) & (for a ex x
  st a*x = 1.L) & (for a,b,c holds (a*b)*c = a*(b*c)) & for a,b holds a*b = b*a
;

notation
  let L be invertible cancelable non empty multLoopStr;
  let x be Element of L;
  synonym x" for /x;
end;

registration
  let L be invertible cancelable non empty multLoopStr;
  cluster -> left_invertible for Element of L;
end;

reserve G for multGroup;
reserve a,b,c,x for Element of G;

theorem 
  a"*a=1.G & a*(a") = 1.G;

definition

  let L be invertible cancelable non empty multLoopStr;
  let a, b be Element of L;
  func a/b -> Element of L equals

  a*(b");
end;

definition

  func multEX_0 -> strict multLoopStr_0 equals

  multLoopStr_0 (# REAL, multreal
    , 0, 1 #);
end;

registration
  cluster multEX_0 -> non empty;
end;

registration
  cluster multEX_0 -> well-unital;
end;

theorem 
  for q,p be Real st q<>0 ex y be Real st p=q*y;

theorem 
  for q,p be Real st q<>0 ex y be Real st p=y*q;

definition
  let IT be non empty multLoopStr_0;
  attr IT is almost_invertible means


  (for a,b be Element of IT st a<>
0.IT ex x be Element of IT st a*x=b) & for a,b be Element of IT st a<>0.IT ex x
  be Element of IT st x*a=b;
end;

definition
  let IT be non empty multLoopStr_0;

  attr IT is multLoop_0-like means


  IT is almost_invertible
  almost_cancelable & (for a be Element of IT holds a*0.IT = 0.IT) & for a be
  Element of IT holds 0.IT*a = 0.IT;
end;

theorem 
  for L being non empty multLoopStr_0 holds L is multLoop_0-like
iff (for a,b be Element of L st a<>0.L ex x be Element of L st a*x=b) & (for a,
  b be Element of L st a<>0.L ex x be Element of L st x*a=b) & (for a,x,y be
Element of L st a<>0.L holds a*x=a*y implies x=y) & (for a,x,y be Element of L
st a<>0.L holds x*a=y*a implies x=y) & (for a be Element of L holds a*0.L = 0.L
  ) & for a be Element of L holds 0.L*a = 0.L;

registration
  cluster multLoop_0-like -> almost_invertible almost_cancelable for non empty
    multLoopStr_0;
end;

registration
  cluster strict well-unital multLoop_0-like non degenerated for non empty
    multLoopStr_0;
end;

definition
  mode multLoop_0 is well-unital non degenerated multLoop_0-like non empty
    multLoopStr_0;
end;

registration
  cluster multEX_0 -> well-unital multLoop_0-like;
end;

registration
  cluster strict associative non degenerated for multLoop_0;
end;

definition
  mode multGroup_0 is associative non degenerated multLoop_0;
end;

registration
  cluster multEX_0 -> associative;
end;

registration
  cluster strict commutative for multGroup_0;
end;

definition
  let L be almost_invertible almost_cancelable non empty multLoopStr_0;
  let x be Element of L;
  assume
 x<>0.L;
  redefine func x" means


  it*x = 1.L;
end;

reserve G for associative almost_invertible almost_cancelable well-unital non
  empty multLoopStr_0;
reserve a,x for Element of G;

theorem 
  a<>0.G implies a"*a=1.G & a*(a") = 1.G;

definition
  let L be almost_invertible almost_cancelable non empty multLoopStr_0;
  let a, b be Element of L;
  func a/b -> Element of L equals

  a*(b");
end;



registration
  cluster  -> Abelian add-associative right_zeroed right_complementable
    for 1-element addLoopStr;
  cluster trivial -> well-unital right-distributive for
non empty doubleLoopStr;
end;

registration
  cluster -> Group-like associative commutative for 1-element multMagma;
end;














begin

definition
  func F_Complex -> strict doubleLoopStr means


  the carrier of it =
COMPLEX & the addF of it = addcomplex & the multF of it = multcomplex & 1.it =
  1r & 0.it = 0c;
end;

registration
  cluster F_Complex -> non empty;
end;

registration
  cluster -> complex for Element of F_Complex;
end;

registration
  let a,b be complex number;
  let x,y be Element of F_Complex;
  identify x+y with a+b when x=a, y=b;
  identify x*y with a*b when x=a, y=b;
end;

registration
  cluster F_Complex -> well-unital;
end;

registration
  cluster F_Complex -> add-associative right_zeroed right_complementable
    Abelian commutative associative left_unital right_unital distributive
    almost_left_invertible non degenerated;
end;

theorem 
  for x1,y1 be Element of F_Complex for x2,y2 be complex number st x1 =
  x2 & y1 = y2 holds x1 + y1 = x2 + y2;

theorem 
  for x1 be Element of F_Complex for x2 be complex number st x1 =
  x2 holds - x1 = - x2;

theorem 
  for x1,y1 be Element of F_Complex for x2,y2 be complex number st
  x1 = x2 & y1 = y2 holds x1 - y1 = x2 - y2;

theorem 
  for x1,y1 be Element of F_Complex for x2,y2 be complex number st x1 =
  x2 & y1 = y2 holds x1 * y1 = x2 * y2;

theorem 
  for x1 be Element of F_Complex for x2 be complex number st x1 =
  x2 & x1 <> 0.F_Complex holds x1" = x2";

theorem 
  for x1,y1 be Element of F_Complex for x2,y2 be complex number st
  x1 = x2 & y1 = y2 & y1 <> 0.F_Complex holds x1/y1 = x2/y2;

theorem 
  0.F_Complex = 0c;

theorem 
  1_F_Complex = 1r;

theorem 
  1_F_Complex + 1_F_Complex <> 0.F_Complex;

definition
  let z be Element of F_Complex;
  redefine func z *' -> Element of F_Complex;
end;

reserve z,z1,z2,z3,z4 for Element of F_Complex;

theorem 
  -z = (-1_F_Complex) * z;

theorem 
  z1 - -z2 = z1 + z2;

theorem 
  z1 = z1 + z - z;

theorem 
  z1 = z1 - z + z;

theorem 
  z1 <> 0.F_Complex & z2 <> 0.F_Complex & z1" = z2" implies z1 = z2;

theorem 
  z2 <> 0.F_Complex & (z1 * z2 = 1.F_Complex or z2 * z1 = 1.F_Complex)
  implies z1 = z2";

theorem 
  z2 <> 0.F_Complex & (z1 * z2 = z3 or z2 * z1 = z3) implies z1 = z3 *
  z2" & z1 = z2" * z3;

theorem 
  (1.F_Complex)" = 1.F_Complex;

theorem 
  z1 <> 0.F_Complex & z2 <> 0.F_Complex implies (z1 * z2)" = z1" * z2";

theorem 
  z <> 0.F_Complex implies (-z)" = -(z");

theorem 
  z1 <> 0.F_Complex & z2 <> 0.F_Complex implies z1" + z2" = (z1 + z2) *
  (z1 * z2)";

theorem 
  z1 <> 0.F_Complex & z2 <> 0.F_Complex implies z1" - z2" = (z2 - z1) *
  (z1 * z2)";

theorem 
  z <> 0.F_Complex implies z" = (1.F_Complex) / z;

theorem 
  z / (1.F_Complex) = z;

theorem 
  z <> 0.F_Complex implies z / z = 1.F_Complex;

theorem 
  z <> 0.F_Complex implies (0.F_Complex) / z = 0.F_Complex;

theorem 
  z2 <> 0.F_Complex & z1 / z2 = 0.F_Complex implies z1 = 0. F_Complex;

theorem 
  z2 <> 0.F_Complex & z4 <> 0.F_Complex implies (z1 / z2) * (z3 / z4) =
  (z1 * z3) / (z2 * z4);

theorem 
  z2 <> 0.F_Complex implies z * (z1 / z2) = (z * z1) / z2;

theorem 
  z2 <> 0.F_Complex & z1 / z2 = 1.F_Complex implies z1 = z2;

theorem 
  z <> 0.F_Complex implies z1 = (z1 * z) / z;

theorem 
  z1 <> 0.F_Complex & z2 <> 0.F_Complex implies (z1 / z2)" = z2 / z1;

theorem 
  z1 <> 0.F_Complex & z2 <> 0.F_Complex implies (z1" / z2") = z2 / z1;

theorem 
  z2 <> 0.F_Complex implies z1 / z2" = z1 * z2;

theorem 
  z1 <> 0.F_Complex & z2 <> 0.F_Complex implies z1" / z2 = (z1 * z2)";

theorem 
  z1 <> 0.F_Complex & z2 <> 0.F_Complex implies z1"* (z / z2) = z / (z1 * z2);

theorem 
  z <> 0.F_Complex & z2 <> 0.F_Complex implies (z1 / z2) = (z1 * z) / (
  z2 * z) & (z1 / z2) = (z * z1) / (z * z2);

theorem 
  z2 <> 0.F_Complex & z3 <> 0.F_Complex implies z1 / (z2 * z3) = z1 / z2 / z3;

theorem 
  z2 <> 0.F_Complex & z3 <> 0.F_Complex implies (z1 * z3) / z2 = z1 / (
  z2 / z3);

theorem 
  z2 <> 0.F_Complex & z3 <> 0.F_Complex & z4 <> 0.F_Complex implies (z1
  / z2) / (z3 / z4) = (z1 * z4) / (z2 * z3);

theorem 
  z2 <> 0.F_Complex & z4 <> 0.F_Complex implies z1 / z2 + z3 / z4 = (z1
  * z4 + z3 * z2) / (z2 * z4);

theorem 
  z <> 0.F_Complex implies z1 / z + z2 / z = (z1 + z2) / z;

theorem 
  z2 <> 0.F_Complex implies -(z1 / z2) = (-z1) / z2 & -(z1 / z2) = z1 / (-z2);

theorem 
  z2 <> 0.F_Complex implies z1 / z2 = (-z1) / (-z2);

theorem 
  z2 <> 0.F_Complex & z4 <> 0.F_Complex implies z1 / z2 - z3 / z4 = (z1
  * z4 - z3 * z2) / (z2 * z4);

theorem 
  z <> 0.F_Complex implies z1 / z - z2 / z = (z1 - z2) / z;

theorem 
  z2 <> 0.F_Complex & (z1 * z2 = z3 or z2 * z1 = z3) implies z1 = z3 / z2;

theorem 
  (0.F_Complex)*' = 0.F_Complex;

theorem 
  z*' = 0.F_Complex implies z = 0.F_Complex;

theorem 
  (1.F_Complex)*' = 1.F_Complex;

theorem 
  z*'*' = z;

theorem 
  (z1 + z2)*' = z1*' + z2*';

theorem 
  (-z)*' = -(z*');

theorem 
  (z1 - z2)*' = z1*' - z2*';

theorem 
  (z1 * z2)*' = z1*' * z2*';

theorem 
  z <> 0.F_Complex implies z"*' = z*'";

theorem 
  z2 <> 0.F_Complex implies (z1 / z2)*' = (z1*') / (z2*');

theorem 
  |.0.F_Complex.| = 0;

theorem 
  |.z.| = 0 implies z = 0.F_Complex;

theorem 
  z <> 0.F_Complex iff 0 < |.z.|;

theorem 
  |.1.F_Complex.| = 1;

theorem 
  |.-z.| = |.z.|;

theorem 
  |.z1 + z2.| <= |.z1.| + |.z2.|;

theorem 
  |.z1 - z2.| <= |.z1.| + |.z2.|;

theorem 
  |.z1.| - |.z2.| <= |.z1 + z2.|;

theorem 
  |.z1.| - |.z2.| <= |.z1 - z2.|;

theorem 
  |.z1 - z2.| = |.z2 - z1.|;

theorem 
  |.z1 - z2.| = 0 iff z1 = z2;

theorem 
  z1 <> z2 iff 0 < |.z1 - z2.|;

theorem 
  |.z1 - z2.| <= |.z1 - z.| + |.z - z2.|;

theorem 
  abs(|.z1.| - |.z2.|) <= |.z1 - z2.|;

theorem 
  |.z1*z2.| = |.z1.|*|.z2.|;

theorem 
  z <> 0.F_Complex implies |.z".| = |.z.|";

theorem 
  z2 <> 0.F_Complex implies |.z1.| / |.z2.| = |.z1 / z2.|;

begin 


scheme 

  Regrwithout0 { P[Nat] } : P[1]
provided
 ex k be non empty Element of NAT st P[k] and
 for k be non empty Element of NAT st k <> 1 & P[k] ex n be non empty
Element of NAT st n < k & P[n];

theorem 
  for e being Element of F_Complex, n be non empty Nat holds (
  power F_Complex).(e,n) = e|^n;

definition
  let x be Element of F_Complex;
  let n be non empty Element of NAT;
  redefine mode CRoot of n,x -> Element of F_Complex means


    (power F_Complex).(it,n) = x;
end;

theorem 
  for x be Element of F_Complex for v be CRoot of 1,x holds v = x;

theorem 
  for n be non empty Element of NAT for v be CRoot of n,0.F_Complex
  holds v = 0.F_Complex;

theorem 
  for n be non empty Element of NAT for x be Element of F_Complex for v
  be CRoot of n,x st v = 0.F_Complex holds x = 0.F_Complex;














begin

reserve F for Field,
  a,b,c,d,e,f,g,h for Element of F;





reserve x,y for Element of [:the carrier of F,the carrier of F,the carrier of
  F:];

definition
  let F;
  func c3add(F) -> BinOp of [:the carrier of F,the carrier of F,the carrier of
  F:] means


  it.(x,y) = [x`1_3+y`1_3,x`2_3+y`2_3,x`3_3+y`3_3];
end;

definition
  let F,x,y;
  func x+y -> Element of [:the carrier of F,the carrier of F,the carrier of F
  :] equals

  (c3add(F)).(x,y);
end;

theorem 
  x+y = [x`1_3+y`1_3,x`2_3+y`2_3,x`3_3+y`3_3];

theorem 
  [a,b,c]+[f,g,h]=[a+f,b+g,c+h];

definition
  let F;
  func c3compl(F) -> UnOp of [:the carrier of F,the carrier of F,the carrier
  of F:] means


  it.(x) = [-x`1_3,-x`2_3,-x`3_3];
end;

definition
  let F,x;
  func -x -> Element of [:the carrier of F,the carrier of F,the carrier of F:]
  equals

  (c3compl(F)).(x);
end;

theorem 
  -x = [-x`1_3,-x`2_3,-x`3_3];





reserve S for set;

definition
  let S;
  mode Relation4 of S -> set means


    it c= [:S,S,S,S:];
end;

definition
  struct(1-sorted) ParStr (# carrier -> set, 4_arg_relation -> Relation4 of
    the carrier #);
end;

registration
  cluster non empty for ParStr;
end;

reserve F for Field;
reserve PS for non empty ParStr;

definition
  let PS;
  let a,b,c,d be Element of PS;
  pred a,b '||' c,d means


  [a,b,c,d] in the 4_arg_relation of PS;
end;

definition
  let F;
  func C_3(F) -> set equals

  [:the carrier of F,the carrier of F,the carrier of
  F:];
end;

registration
  let F;
  cluster C_3(F) -> non empty;
end;

definition
  let F;
  func 4C_3(F) -> set equals

  [:C_3(F),C_3(F),C_3(F),C_3(F):];
end;

registration
  let F;
  cluster 4C_3(F) -> non empty;
end;

reserve x for set,
  a,b,c,d,e,f,g,h,i,j,k,l for Element of [:the carrier of F,
  the carrier of F,the carrier of F:];

definition
  let F;
  func PRs(F) -> set means


  x in it iff x in 4C_3(F) & ex a,b,c,d st x =
[a,b,c,d] & (a`1_3-b`1_3)*(c`2_3-d`2_3) - (c`1_3-d`1_3)*(a`2_3-b`2_3) = 0.F &
  (a`1_3-b`1_3)*(c`3_3-d`3_3) - (c`1_3-d`1_3)*(a`3_3-b`3_3) = 0.F &
   (a`2_3-b`2_3)*(c`3_3-d`3_3) - (c`2_3-d`2_3)*(a`3_3-b`3_3) =
  0.F;
end;

theorem 
  PRs(F) c= [:C_3(F),C_3(F),C_3(F),C_3(F):];

definition
  let F;
  func PR(F) -> Relation4 of C_3(F) equals

  PRs(F);
end;

definition
  let F;
  func MPS(F) -> ParStr equals

  ParStr (# C_3(F),PR(F) #);
end;

registration
  let F;
  cluster MPS(F) -> strict non empty;
end;

theorem 
  the carrier of MPS(F) = C_3(F);

theorem 
  the 4_arg_relation of MPS(F) = PR(F);

reserve a,b,c,d,p,q,r,s for Element of MPS(F);

theorem 
  a,b '||' c,d iff [a,b,c,d] in PR(F);

theorem 
  [a,b,c,d] in PR(F) iff ([a,b,c,d] in 4C_3(F) &
   ex e,f,g,h st [a,b,c,d] = [e,f,g,h] &
    (e`1_3-f`1_3)*(g`2_3-h`2_3) - (g`1_3-h`1_3)*(e`2_3-f`2_3) = 0.F &
    (e`1_3-f`1_3)*(g`3_3-h`3_3) - (g`1_3-h`1_3)*(e`3_3-f`3_3) = 0.F &
    (e`2_3-f`2_3)*(g`3_3-h`3_3) - (g`2_3-h`2_3)*(e`3_3-f`3_3) = 0.F);

theorem 
  a,b '||' c,d iff ([a,b,c,d] in 4C_3(F) &
  ex e,f,g,h st [a,b,c,d] = [e,f,g,h] &
  (e`1_3-f`1_3)*(g`2_3-h`2_3) - (g`1_3-h`1_3)*(e`2_3-f`2_3) = 0.F &
  (e`1_3-f`1_3)*(g`3_3-
h`3_3) - (g`1_3-h`1_3)*(e`3_3-f`3_3) = 0.F &
   (e`2_3-f`2_3)*(g`3_3-h`3_3) - (g`2_3-h`2_3)*(e`3_3-f`3_3) =
  0.F);

theorem 
  the carrier of MPS(F) = [:the carrier of F,the carrier of F,the
  carrier of F:];

theorem 
  [a,b,c,d] in 4C_3(F);

theorem 
  a,b '||' c,d iff ex e,f,g,h st [a,b,c,d] = [e,f,g,h] & (e`1_3-f`1_3)
*(g`2_3-h`2_3) - (g`1_3-h`1_3)*(e`2_3-f`2_3) = 0.F &
   (e`1_3-f`1_3)*(g`3_3-h`3_3) - (g`1_3-h`1_3)*(e`3_3-f
  `3_3) = 0.F & (e`2_3-f`2_3)*(g`3_3-h`3_3) - (g`2_3-h`2_3)*(e`3_3-f`3_3) = 0.F
;

theorem 
  a,b '||' b,a;

theorem 
  a,b '||' c,c;

theorem 
  a,b '||' p,q & a,b '||' r,s implies p,q '||' r,s or a=b;

theorem 
  a,b '||' a,c implies b,a '||' b,c;

theorem 
  ex d st a,b '||' c,d & a,c '||' b,d;





definition
  let IT be non empty ParStr;
  attr IT is ParSp-like means


  for a,b,c,d,p,q,r,s being Element of IT
  holds a,b '||' b,a & a,b '||' c,c & (a,b '||' p,q & a,b '||' r,s implies p,q
'||' r,s or a=b) & (a,b '||' a,c implies b,a '||' b,c) & ex x being Element of
  IT st a,b '||' c,x & a,c '||' b,x;
end;

registration
  cluster strict ParSp-like for non empty ParStr;
end;

definition
  mode ParSp is ParSp-like non empty ParStr;
end;

reserve PS for ParSp,
  a,b,c,d,p,q,r,s for Element of PS;

theorem 
  a,b '||' a,b;

theorem 
  a,b '||' c,d implies c,d '||' a,b;

theorem 
  a,a '||' b,c;

theorem 
  a,b '||' c,d implies b,a '||' c,d;

theorem 
  a,b '||' c,d implies a,b '||' d,c;

theorem 
  a,b '||' c,d implies b,a '||' c,d & a,b '||' d,c & b,a '||' d,c
  & c,d '||' a,b & d,c '||' a,b & c,d '||' b,a & d,c '||' b,a;

theorem 
  a,b '||' a,c implies a,c '||' a,b & b,a '||' a,c & a,b '||' c,a
& a,c '||' b,a & b,a '||' c,a & c,a '||' a,b & c,a '||' b,a & b,a '||' b,c & a,
  b '||' b,c & b,a '||' c,b & b,c '||' b,a & a,b '||' c,b & c,b '||' b,a & b,c
'||' a,b & c,b '||' a,b & c,a '||' c,b & a,c '||' c,b & c,a '||' b,c & a,c '||'
  b,c & c,b '||' c,a & b,c '||' c,a & c,b '||' a,c & b,c '||' a,c;

theorem 
  a=b or c = d or a=c & b=d or a=d & b=c implies a,b '||' c,d;

theorem 
  a<>b & p,q '||' a,b & a,b '||' r,s implies p,q '||' r,s;

theorem 
  not a,b '||' a,c implies a<>b & b<>c & c <>a;

theorem 
  not a,b '||' c,d implies a<>b & c <>d;

theorem 
  not a,b '||' a,c implies not a,c '||' a,b & not b,a '||' a,c &
not a,b '||' c,a & not a,c '||' b,a & not b,a '||' c,a & not c,a '||' a,b & not
c,a '||' b,a & not b,a '||' b,c & not a,b '||' b,c & not b,a '||' c,b & not b,c
  '||' b,a & not b,a '||' c,b & not c,b '||' b,a & not b,c '||' a,b & not c,b
  '||' a,b & not c,a '||' c,b & not a,c '||' c,b & not c,a '||' b,c & not a,c
  '||' b,c & not c,b '||' c,a & not b,c '||' c,a & not c,b '||' a,c & not b,c
  '||' a,c;

theorem 
  not a,b '||' c,d & a,b '||' p,q & c,d '||' r,s & p<>q & r<>s
  implies not p,q '||' r,s;

theorem 
  not a,b '||' a,c & a,b '||' p,q & a,c '||' p,r & b,c '||' q,r &
  p<>q implies not p,q '||' p,r;

theorem 
  not a,b '||' a,c & a,c '||' p,r & b,c '||' p,r implies p=r;

theorem 
  not p,q '||' p,r & p,r '||' p,s & q,r '||' q,s implies r=s;

theorem 
  not a,b '||' a,c & a,b '||' p,q & a,c '||' p,r & a,c '||' p,s & b,c
  '||' q,r & b,c '||' q,s implies r=s;

theorem 
  a,b '||' a,c & a,b '||' a,d implies a,b '||' c,d;

theorem 
  (for a,b holds a=b) implies for p,q,r,s holds p,q '||' r,s;

theorem 
  (ex a,b st a<>b & for c holds a,b '||' a,c) implies for p,q,r,s holds
  p,q '||' r,s;

theorem 
  not a,b '||' a,c & p<>q implies not p,q '||' p,a or not p,q '||' p,b
  or not p,q '||' p,c;














begin 

reserve F for Field;

definition
  let F;
  struct (RelStr,VectSpStr over F) SymStr over F (# carrier -> set, addF ->
BinOp of the carrier, ZeroF -> Element of the carrier, lmult -> Function of [:
the carrier of F, the carrier:], the carrier, InternalRel -> Relation of the
    carrier #);
end;

registration
  let F;
  cluster non empty for SymStr over F;
end;

notation
  let F;
  let S be SymStr over F;
  let a,b be Element of S;
  synonym a _|_ b for a <= b;
end;

registration
  let F;
  let X be non empty set, md be BinOp of X, o be Element of X, mF be Function
  of [:the carrier of F, X:], X, mo be Relation of X;
  cluster SymStr (# X,md,o,mF,mo #) -> non empty;
end;

registration
  let F;
  cluster Abelian add-associative right_zeroed right_complementable for
non empty
    SymStr over F;
end;



definition
  let F;
  let IT be Abelian add-associative right_zeroed right_complementable non
  empty SymStr over F;
  attr IT is SymSp-like means


  for a,b,c,x being Element of IT for l
  being Element of F holds (a<>(0.IT) implies ex y being Element of IT st not y
_|_ a ) & (a _|_ b implies l*a _|_ b) & ( b _|_ a & c _|_ a implies b+c _|_ a )
& (not b _|_ a implies ex k being Element of F st x-k*b _|_ a ) & (a _|_ b+c &
  b _|_ c+a implies c _|_ a+b );
end;

registration
  let F;
  cluster SymSp-like vector-distributive scalar-distributive
  scalar-associative scalar-unital strict for
Abelian add-associative right_zeroed
    right_complementable non empty SymStr over F;
end;

definition
  let F;
  mode SymSp of F is SymSp-like vector-distributive scalar-distributive
  scalar-associative scalar-unital Abelian add-associative
    right_zeroed right_complementable non empty SymStr over F;
end;

reserve S for SymSp of F;
reserve a,b,c,d,a9,b9,p,q,r,s,x,y,z for Element of S;
reserve k,l for Element of F;

theorem 
  0.S _|_ a;

theorem 
  a _|_ b implies b _|_ a;

theorem 
  not a _|_ b & c+a _|_ b implies not c _|_ b;

theorem 
  not b _|_ a & c _|_ a implies not b+c _|_ a;

theorem 
  not b _|_ a & not l=0.F implies not l*b _|_ a & not b _|_ l*a;

theorem 
  a _|_ b implies -a _|_ b;

theorem 
  not a _|_ c implies not a+b _|_ c or not (1_F+1_F)*a+b _|_ c;

theorem 
  not a9 _|_ a & a9 _|_ b & not b9 _|_ b & b9 _|_ a implies not a9
  +b9 _|_ a & not a9+b9 _|_ b;

theorem 
  a<>0.S & b<>0.S implies ex p st not p _|_ a & not p _|_ b;

theorem 
  1_F+1_F<>0.F & a<>0.S & b<>0.S & c <>0.S implies ex p st not p
  _|_ a & not p _|_ b & not p _|_ c;

theorem 
  a-b _|_ d & a-c _|_ d implies b-c _|_ d;

theorem 
  not b _|_ a & x-k*b _|_ a & x-l*b _|_ a implies k = l;

theorem 
  1_F+1_F<>0.F implies a _|_ a;



definition
  let F;
  let S,a,b,x;
  assume
 not b _|_ a;

  func ProJ(a,b,x) -> Element of F means


  for l being Element of F st x-l*b _|_ a holds it = l;
end;

theorem 
  not b _|_ a implies x-ProJ(a,b,x)*b _|_ a;

theorem 
  not b _|_ a implies ProJ(a,b,l*x) = l*ProJ(a,b,x);

theorem 
  not b _|_ a implies ProJ(a,b,x+y) = ProJ(a,b,x) + ProJ(a,b,y);

theorem 
  not b _|_ a & l <> 0.F implies ProJ(a,l*b,x) = l"*ProJ(a,b,x);

theorem 
  not b _|_ a & l <> 0.F implies ProJ(l*a,b,x) = ProJ(a,b,x);

theorem 
  not b _|_ a & p _|_ a implies ProJ(a,b+p,c) = ProJ(a,b,c) & ProJ
  (a,b,c+p) = ProJ(a,b,c);

theorem 
  not b _|_ a & p _|_ b & p _|_ c implies ProJ(a+p,b,c) = ProJ(a,b ,c);

theorem 
  not b _|_ a & c-b _|_ a implies ProJ(a,b,c) = 1_F;

theorem 
  not b _|_ a implies ProJ(a,b,b) = 1_F;

theorem 
  not b _|_ a implies ( x _|_ a iff ProJ(a,b,x) = 0.F );

theorem 
  not b _|_ a & not q _|_ a implies ProJ(a,b,p)*ProJ(a,b,q)" = ProJ(a,q,p);

theorem 
  not b _|_ a & not c _|_ a implies ProJ(a,b,c) = ProJ(a,c,b)";

theorem 
  not b _|_ a & b _|_ c+a implies ProJ(a,b,c) = ProJ(c,b,a);

theorem 
  not a _|_ b & not c _|_ b implies ProJ(c,b,a) = (-ProJ(b,a,c)")* ProJ(a,b,c);

theorem 
  1_F+1_F<>0.F & not a _|_ p & not a _|_ q & not b _|_ q implies
  ProJ(a,p,q)*ProJ(b,q,p) = ProJ(p,a,b)*ProJ(q,b,a);

theorem 
  1_F+1_F<>0.F & not p _|_ a & not p _|_ x & not q _|_ a & not q
  _|_ x implies ProJ(a,q,p)*ProJ(p,a,x) = ProJ(x,q,p)*ProJ(q,a,x);

theorem 
  1_F+1_F<>0.F & not p _|_ a & not p _|_ x & not q _|_ a & not q
_|_ x & not b _|_ a implies ProJ(a,b,p)*ProJ(p,a,x)*ProJ(x,p,y) = ProJ(a,b,q)*
  ProJ(q,a,x)*ProJ(x,q,y);

theorem 
  not a _|_ p & not x _|_ p & not y _|_ p implies ProJ(p,a,x)*ProJ
  (x,p,y) = (-ProJ(p,a,y))*ProJ(y,p,x);



definition
  let F,S,x,y,a,b;
  assume
 ( not b _|_ a)& 1_F+1_F<>0.F;
  func PProJ(a,b,x,y) -> Element of F means


  for q st not q _|_ a & not q _|_ x holds
  it = ProJ(a,b,q)* ProJ(q,a,x)*ProJ(x,q,y)
  if ex p st not p _|_ a & not p _|_ x
  otherwise it = 0.F;
end;

theorem 
  1_F+1_F<>0.F & not b _|_ a & x=0.S implies PProJ(a,b,x,y) = 0.F;

theorem 
  1_F+1_F<>0.F & not b _|_ a implies (PProJ(a,b,x,y) = 0.F iff y _|_ x);

theorem 
  1_F+1_F<>0.F & not b _|_ a implies PProJ(a,b,x,y) = -PProJ(a,b,y,x);

theorem 
  1_F+1_F<>0.F & not b _|_ a implies PProJ(a,b,x,l*y) = l*PProJ(a,b,x,y);

theorem 
  1_F+1_F<>0.F & not b _|_ a implies PProJ(a,b,x,y+z) = PProJ(a,b,x,y) +
  PProJ (a,b,x,z);














begin



reserve F for Field;



definition
  let F;
  let IT be Abelian add-associative right_zeroed right_complementable non
  empty SymStr over F;

  attr IT is OrtSp-like means


  for a,b,c,d,x being Element of IT for l
  being Element of F holds (a<>0.IT & b<>0.IT & c <>0.IT & d<>0.IT implies ex p
being Element of IT st not p _|_ a & not p _|_ b & not p _|_ c & not p _|_ d )
& (a _|_ b implies l*a _|_ b) & ( b _|_ a & c _|_ a implies b+c _|_ a ) & (not
b _|_ a implies ex k being Element of F st x-k*b _|_ a ) & ( a _|_ b-c & b _|_
  c-a implies c _|_ a-b );
end;

registration
  let F;
  cluster OrtSp-like vector-distributive scalar-distributive
  scalar-associative scalar-unital strict for
Abelian add-associative right_zeroed
    right_complementable non empty SymStr over F;
end;

definition
  let F;
  mode OrtSp of F is OrtSp-like vector-distributive scalar-distributive
  scalar-associative scalar-unital Abelian add-associative
    right_zeroed right_complementable non empty SymStr over F;
end;

reserve S for OrtSp of F;
reserve a,b,c,d,p,q,r,x,y,z for Element of S;
reserve k,l for Element of F;

theorem 
  0.S _|_ a;

theorem 
  a _|_ b implies b _|_ a;

theorem 
  not a _|_ b & c+a _|_ b implies not c _|_ b;

theorem 
  not b _|_ a & c _|_ a implies not b+c _|_ a;

theorem 
  not b _|_ a & not l=0.F implies not l*b _|_ a & not b _|_ l*a;

theorem 
  a _|_ b implies -a _|_ b;

theorem 
  a-b _|_ d & a-c _|_ d implies b-c _|_ d;

theorem 
  not b _|_ a & x-k*b _|_ a & x-l*b _|_ a implies k = l;

theorem 
  a _|_ a & b _|_ b implies a+b _|_ a-b;

theorem 
  1_F+1_F <> 0.F & (ex a st a<>0.S) implies ex b st not b _|_ b;



definition
  let F,S,a,b,x;
  assume
 not b _|_ a;

  func ProJ(a,b,x) -> Element of F means


  for l being Element of F st x-l*b _|_ a holds it = l;
end;

theorem 
  not b _|_ a implies x-ProJ(a,b,x)*b _|_ a;

theorem 
  not b _|_ a implies ProJ(a,b,l*x) = l*ProJ(a,b,x);

theorem 
  not b _|_ a implies ProJ(a,b,x+y) = ProJ(a,b,x) + ProJ(a,b,y);

theorem 
  not b _|_ a & l <> 0.F implies ProJ(a,l*b,x) = l"*ProJ(a,b,x);

theorem 
  not b _|_ a & l <> 0.F implies ProJ(l*a,b,x) = ProJ(a,b,x);

theorem 
  not b _|_ a & p _|_ a implies ProJ(a,b+p,c) = ProJ(a,b,c) & ProJ(a,b,c
  +p) = ProJ(a,b,c);

theorem 
  not b _|_ a & p _|_ b & p _|_ c implies ProJ(a+p,b,c) = ProJ(a,b,c);

theorem 
  not b _|_ a & c-b _|_ a implies ProJ(a,b,c) = 1_F;

theorem 
  not b _|_ a implies ProJ(a,b,b) = 1_F;

theorem 
  not b _|_ a implies ( x _|_ a iff ProJ(a,b,x) = 0.F );

theorem 
  not b _|_ a & not q _|_ a implies ProJ(a,b,p)*ProJ(a,b,q)" = ProJ(a,q,p);

theorem 
  not b _|_ a & not c _|_ a implies ProJ(a,b,c) = ProJ(a,c,b)";

theorem 
  not b _|_ a & b _|_ c+a implies ProJ(a,b,c) = -ProJ(c,b,a);

theorem 
  not a _|_ b & not c _|_ b implies ProJ(c,b,a) = ProJ(b,a,c)"* ProJ(a,b,c);

theorem 
  not p _|_ a & not p _|_ x & not q _|_ a & not q _|_ x implies
  ProJ(a,q,p)*ProJ(p,a,x) = ProJ(q,a,x)*ProJ(x,q,p);

theorem 
  not p _|_ a & not p _|_ x & not q _|_ a & not q _|_ x & not b
  _|_ a implies ProJ(a,b,p)*ProJ(p,a,x)*ProJ(x,p,y) = ProJ(a,b,q)*ProJ(q,a,x)*
  ProJ(x,q,y);

theorem 
  not a _|_ p & not x _|_ p & not y _|_ p implies ProJ(p,a,x)*ProJ
  (x,p,y) = ProJ(p,a,y)*ProJ(y,p,x);



definition
  let F,S,x,y,a,b;
  assume
 not b _|_ a;
  func PProJ(a,b,x,y) -> Element of F means


  for q st not q _|_ a & not q _|_ x holds
  it = ProJ(a,b,q)*ProJ(q,a,x)*ProJ(x,q,y) if ex p st not p _|_ a & not p _|_ x
  otherwise it = 0.F;
end;

theorem 
  not b _|_ a & x = 0.S implies PProJ(a,b,x,y) = 0.F;

theorem 
  not b _|_ a implies (PProJ(a,b,x,y) = 0.F iff y _|_ x);

theorem 
  not b _|_ a implies PProJ(a,b,x,y) = PProJ(a,b,y,x);

theorem 
  not b _|_ a implies PProJ(a,b,x,l*y) = l*PProJ(a,b,x,y);

theorem 
  not b _|_ a implies PProJ(a,b,x,y+z) = PProJ(a,b,x,y) + PProJ(a,b,x,z);














begin

reserve x, y, z for set,
  T for TopStruct,
  A for SubSpace of T,
  P, Q for Subset of T;

definition

  let T be TopStruct;
  attr T is compact means


  for F being Subset-Family of T st F is Cover
of T & F is open ex G being Subset-Family of T st G c= F & G is Cover of T & G
  is finite;
end;

definition
  let T be non empty TopSpace;

  redefine attr T is regular means

  for p being Point of T, P being Subset of T
  st P <> {} & P is closed & p in P` ex W, V being Subset of T st W is open & V
  is open & p in W & P c= V & W misses V;
  redefine attr T is normal means

  for W, V being Subset of T st W <> {} & V <>
  {} & W is closed & V is closed & W misses V ex P, Q being Subset of T st P is
  open & Q is open & W c= P & V c= Q & P misses Q;
end;

notation
  let T be TopStruct;
  synonym T is Hausdorff for T is T_2;
end;

definition
  let T be TopStruct, P be Subset of T;
  attr P is compact means


  for F being Subset-Family of T st F is Cover
of P & F is open ex G being Subset-Family of T st G c= F & G is Cover of P & G
  is finite;
end;

registration
  let T;
  cluster empty -> compact for Subset of T;
end;

theorem 
  T is compact iff [#]T is compact;

theorem 
  Q c= [#] A implies (Q is compact iff for P being Subset of A st
  P=Q holds P is compact );

theorem 
  ( P = {} implies (P is compact iff T|P is compact) ) & ( T is
  TopSpace-like & P <> {} implies (P is compact iff T|P is compact) );

theorem 
  for T being non empty TopSpace holds T is compact iff for F
  being Subset-Family of T st F is centered & F is closed holds meet F <> {};

theorem 
  for T being non empty TopSpace holds T is compact iff for F being
  Subset-Family of T st F <> {} & F is closed & meet F = {} ex G being
  Subset-Family of T st G <> {} & G c= F & G is finite & meet G = {};

reserve TS for TopSpace;
reserve PS, QS for Subset of TS;

theorem 
  TS is T_2 implies for A being Subset of TS st A <> {} & A is
compact for p being Point of TS st p in A` ex PS,QS st PS is open & QS is open
  & p in PS & A c= QS & PS misses QS;

theorem 
  TS is T_2 & PS is compact implies PS is closed;

theorem 
  T is compact & P is closed implies P is compact;

theorem 
  PS is compact & QS c= PS & QS is closed implies QS is compact;

theorem 
  P is compact & Q is compact implies P \/ Q is compact;

theorem 
  TS is T_2 & PS is compact & QS is compact implies PS /\ QS is compact;

theorem 
  for TS being non empty TopSpace holds TS is T_2 & TS is compact
  implies TS is regular;

theorem 
  for TS being non empty TopSpace holds TS is T_2 & TS is compact
  implies TS is normal;

reserve S for non empty TopStruct;
reserve f for Function of T,S;

theorem 
  T is compact & f is continuous & rng f = [#] S implies S is compact;

theorem 
  f is continuous & rng f = [#] S & P is compact implies f.:P is compact;

reserve SS for non empty TopSpace;
reserve f for Function of TS,SS;

theorem 
  TS is compact & SS is T_2 & rng f = [#] SS & f is continuous
  implies for PS st PS is closed holds f.:PS is closed;

theorem 
  TS is compact & SS is T_2 & dom f = [#]TS & rng f = [#]SS & f is
  one-to-one & f is continuous implies f is being_homeomorphism;

definition
  let D be set;
  func 1TopSp D -> TopStruct equals

  TopStruct (# D, [#] bool D #);
end;

registration
  let D be set;
  cluster 1TopSp D -> strict TopSpace-like;
end;

registration
  let D be non empty set;
  cluster 1TopSp D -> non empty;
end;

registration
  let x be set;
  cluster 1TopSp {x} -> T_2;
end;

registration
  cluster T_2 non empty for TopSpace;
end;

registration
  let T be T_2 non empty TopSpace;
  cluster compact -> closed for Subset of T;
end;

registration
  let A be finite set;
  cluster 1TopSp A -> finite;
end;

registration
  cluster non empty finite strict for TopSpace;
end;

registration
  cluster finite -> compact for TopSpace;
end;

theorem 
  for T being TopSpace st the carrier of T is finite holds T is compact;

registration
  let T be TopSpace;
  cluster finite -> compact for Subset of T;
end;

registration
  let T be non empty TopSpace;
  cluster non empty compact for Subset of T;
end;



registration
  cluster empty -> T_2 for TopStruct;
end;

registration
  let T be T_2 TopStruct;
  cluster -> T_2 for SubSpace of T;
end;



theorem 
  for X being TopStruct for Y being SubSpace of X, A being Subset
  of X, B being Subset of Y st A = B holds A is compact iff B is compact;



reserve T, S for non empty TopSpace,
  p for Point of T;

theorem 
  for T1,T2 being SubSpace of T, f being Function of T1,S, g being
Function of T2,S st ([#] T1) \/ ([#] T2) = [#] T & ([#] T1) /\ ([#] T2) = {p} &
T1 is compact & T2 is compact & T is T_2 & f is continuous & g is continuous &
  f.p = g.p holds f+*g is continuous Function of T,S;

theorem 
  for T being non empty TopSpace, T1, T2 being SubSpace of T, p1,p2
being Point of T for f being Function of T1,S, g being Function of T2,S st ([#]
  T1) \/ ([#] T2) = [#] T & ([#] T1) /\ ([#] T2) = {p1,p2} & T1 is compact & T2
is compact & T is T_2 & f is continuous & g is continuous & f.p1 = g.p1 & f.p2
  = g.p2 holds f+*g is continuous Function of T,S;

begin 

registration
  let S be TopStruct;
  cluster the topology of S -> open;
end;



registration
  let T be TopSpace;
  cluster open non empty for Subset-Family of T;
end;

theorem 
  for T being non empty TopSpace, F being set holds F is open
  Subset-Family of T iff F is open Subset-Family of the TopStruct of T;

theorem 
  for T being non empty TopSpace, X being set holds X is compact Subset
  of T iff X is compact Subset of the TopStruct of T;














begin

reserve V for RealLinearSpace;
reserve W,W1,W2,W3 for Subspace of V;
reserve u,u1,u2,v,v1,v2 for VECTOR of V;
reserve a,a1,a2 for Real;
reserve X,Y,x,y,y1,y2 for set;





definition
  let V;
  let W1,W2;
  func W1 + W2 -> strict Subspace of V means


  the carrier of it = {v + u : v in W1 & u in W2};
end;

definition
  let V;
  let W1,W2;
  func W1 /\ W2 -> strict Subspace of V means


  the carrier of it = (the carrier of W1) /\ (the carrier of W2);
end;





theorem 
  x in W1 + W2 iff ex v1,v2 st v1 in W1 & v2 in W2 & x = v1 + v2;

theorem 
  v in W1 or v in W2 implies v in W1 + W2;

theorem 
  x in W1 /\ W2 iff x in W1 & x in W2;

theorem 
  for W being strict Subspace of V holds W + W = W;

theorem 
  W1 + W2 = W2 + W1;

theorem 
  W1 + (W2 + W3) = (W1 + W2) + W3;

theorem 
  W1 is Subspace of W1 + W2 & W2 is Subspace of W1 + W2;

theorem 
  for W2 being strict Subspace of V holds W1 is Subspace of W2 iff W1 + W2 = W2
;

theorem 
  for W being strict Subspace of V holds (0).V + W = W & W + (0).V = W;

theorem 
  (0).V + (Omega).V = the RLSStruct of V & (Omega). V + (0).V = the
  RLSStruct of V;

theorem 
  (Omega).V + W = the RLSStruct of V & W + (Omega).V = the RLSStruct of V;

theorem 
  for V being strict RealLinearSpace holds (Omega).V + (Omega).V = V;

theorem 
  for W being strict Subspace of V holds W /\ W = W;

theorem 
  W1 /\ W2 = W2 /\ W1;

theorem 
  W1 /\ (W2 /\ W3) = (W1 /\ W2) /\ W3;

theorem 
  W1 /\ W2 is Subspace of W1 & W1 /\ W2 is Subspace of W2;

theorem 
  for W1 being strict Subspace of V holds W1 is Subspace of W2 iff
  W1 /\ W2 = W1;

theorem 
  (0).V /\ W = (0).V & W /\ (0).V = (0).V;

theorem 
  (0).V /\ (Omega).V = (0).V & (Omega).V /\ (0).V = (0).V;

theorem 
  for W being strict Subspace of V holds (Omega).V /\ W = W & W /\
  (Omega).V = W;

theorem 
  for V being strict RealLinearSpace holds (Omega).V /\ (Omega).V = V;

theorem 
  W1 /\ W2 is Subspace of W1 + W2;

theorem 
  for W2 being strict Subspace of V holds (W1 /\ W2) + W2 = W2;

theorem 
  for W1 being strict Subspace of V holds W1 /\ (W1 + W2) = W1;

theorem 
  (W1 /\ W2) + (W2 /\ W3) is Subspace of W2 /\ (W1 + W3);

theorem 
  W1 is Subspace of W2 implies W2 /\ (W1 + W3) = (W1 /\ W2) + (W2 /\ W3);

theorem 
  W2 + (W1 /\ W3) is Subspace of (W1 + W2) /\ (W2 + W3);

theorem 
  W1 is Subspace of W2 implies W2 + (W1 /\ W3) = (W1 + W2) /\ (W2 + W3);

theorem 
  W1 is strict Subspace of W3 implies W1 + (W2 /\ W3) = (W1 + W2) /\ W3;

theorem 
  for W1,W2 being strict Subspace of V holds W1 + W2 = W2 iff W1 /\ W2 = W1;

theorem 
  for W2,W3 being strict Subspace of V holds W1 is Subspace of W2
  implies W1 + W3 is Subspace of W2 + W3;

theorem 
  (ex W st the carrier of W = (the carrier of W1) \/ (the carrier of W2)
  ) iff W1 is Subspace of W2 or W2 is Subspace of W1;





definition
  let V;
  func Subspaces(V) -> set means


  for x holds x in it iff x is strict Subspace of V;
end;

registration
  let V;
  cluster Subspaces(V) -> non empty;
end;

theorem 
  for V being strict RealLinearSpace holds V in Subspaces(V);






definition
  let V;
  let W1,W2;
  pred V is_the_direct_sum_of W1,W2 means


  the RLSStruct of V = W1 + W2 & W1 /\ W2 = (0).V;
end;

definition
  let V be RealLinearSpace;
  let W be Subspace of V;
  mode Linear_Compl of W -> Subspace of V means


    V is_the_direct_sum_of it,W;
end;

registration
  let V be RealLinearSpace;
  let W be Subspace of V;
  cluster strict for Linear_Compl of W;
end;

theorem 
  for V being RealLinearSpace, W1,W2 being Subspace of V holds V
  is_the_direct_sum_of W1,W2 implies W2 is Linear_Compl of W1;

theorem 
  for V being RealLinearSpace, W being Subspace of V, L being
Linear_Compl of W holds V is_the_direct_sum_of L,W & V is_the_direct_sum_of W,L
;






theorem 
  for V being RealLinearSpace, W being Subspace of V, L being
Linear_Compl of W holds W + L = the RLSStruct of V & L + W = the RLSStruct of V
;

theorem 
  for V being RealLinearSpace, W being Subspace of V, L being
  Linear_Compl of W holds W /\ L = (0).V & L /\ W = (0).V;

theorem 
  V is_the_direct_sum_of W1,W2 implies V is_the_direct_sum_of W2,W1;

theorem 
  for V being RealLinearSpace holds V is_the_direct_sum_of (0).V,
  (Omega).V & V is_the_direct_sum_of (Omega).V,(0).V;

theorem 
  for V being RealLinearSpace, W being Subspace of V, L being
  Linear_Compl of W holds W is Linear_Compl of L;

theorem 
  for V being RealLinearSpace holds (0).V is Linear_Compl of (Omega).V &
  (Omega).V is Linear_Compl of (0).V;

reserve C for Coset of W;
reserve C1 for Coset of W1;
reserve C2 for Coset of W2;

theorem 
  C1 meets C2 implies C1 /\ C2 is Coset of W1 /\ W2;

theorem 
  for V being RealLinearSpace, W1,W2 being Subspace of V holds V
  is_the_direct_sum_of W1,W2 iff for C1 being Coset of W1, C2 being Coset of W2
  ex v being VECTOR of V st C1 /\ C2 = {v};





theorem 
  for V being RealLinearSpace, W1,W2 being Subspace of V holds W1 + W2 =
the RLSStruct of V iff for v being VECTOR of V ex v1,v2 being VECTOR of V st v1
  in W1 & v2 in W2 & v = v1 + v2;

theorem 
  V is_the_direct_sum_of W1,W2 & v = v1 + v2 & v = u1 + u2 & v1 in
  W1 & u1 in W1 & v2 in W2 & u2 in W2 implies v1 = u1 & v2 = u2;

theorem 
  V = W1 + W2 & (ex v st for v1,v2,u1,u2 st v = v1 + v2 & v = u1 + u2 &
  v1 in W1 & u1 in W1 & v2 in W2 & u2 in W2 holds v1 = u1 & v2 = u2) implies V
  is_the_direct_sum_of W1,W2;

reserve t1,t2 for Element of [:the carrier of V, the carrier of V:];

definition
  let V;
  let v;
  let W1,W2;
  assume
 V is_the_direct_sum_of W1,W2;
  func v |-- (W1,W2) -> Element of [:the carrier of V, the carrier of V:]
  means


  v = it`1 + it`2 & it`1 in W1 & it`2 in W2;
end;

theorem 
  V is_the_direct_sum_of W1,W2 implies (v |-- (W1,W2))`1 = (v |-- (W2,W1))`2;

theorem 
  V is_the_direct_sum_of W1,W2 implies (v |-- (W1,W2))`2 = (v |-- (W2,W1))`1;

theorem 
  for V being RealLinearSpace, W being Subspace of V, L being
Linear_Compl of W, v being VECTOR of V, t being Element of [:the carrier of V,
the carrier of V:] holds t`1 + t`2 = v & t`1 in W & t`2 in L implies t = v |--
  (W,L);

theorem 
  for V being RealLinearSpace, W being Subspace of V, L being
Linear_Compl of W, v being VECTOR of V holds (v |-- (W,L))`1 + (v |-- (W,L))`2
  = v;

theorem 
  for V being RealLinearSpace, W being Subspace of V, L being
Linear_Compl of W, v being VECTOR of V holds (v |-- (W,L))`1 in W & (v |-- (W,L
  ))`2 in L;

theorem 
  for V being RealLinearSpace, W being Subspace of V, L being
Linear_Compl of W, v being VECTOR of V holds (v |-- (W,L))`1 = (v |-- (L,W))`2;

theorem 
  for V being RealLinearSpace, W being Subspace of V, L being
Linear_Compl of W, v being VECTOR of V holds (v |-- (W,L))`2 = (v |-- (L,W))`1;





reserve A1,A2,B for Element of Subspaces(V);

definition
  let V;
  func SubJoin(V) -> BinOp of Subspaces(V) means


  for A1,A2,W1,W2 st A1 = W1 & A2 = W2 holds it.(A1,A2) = W1 + W2;
end;

definition
  let V;
  func SubMeet(V) -> BinOp of Subspaces(V) means


  for A1,A2,W1,W2 st A1 = W1 & A2 = W2 holds it.(A1,A2) = W1 /\ W2;
end;





theorem 
  LattStr (# Subspaces(V), SubJoin(V), SubMeet(V) #) is Lattice;

registration
  let V;
  cluster LattStr (# Subspaces(V), SubJoin(V), SubMeet(V) #) -> Lattice-like;
end;

theorem 
  for V being RealLinearSpace holds LattStr (# Subspaces(V),
    SubJoin(V), SubMeet(V) #) is lower-bounded;

theorem 
  for V being RealLinearSpace holds LattStr (# Subspaces(V),
    SubJoin(V), SubMeet(V) #) is upper-bounded;

theorem 
  for V being RealLinearSpace holds LattStr (# Subspaces(V),
    SubJoin(V), SubMeet(V) #) is 01_Lattice;

theorem 
  for V being RealLinearSpace holds LattStr (# Subspaces(V),
    SubJoin(V), SubMeet(V) #) is modular;

reserve l for Lattice;
reserve a,b for Element of l;

theorem 
  for V being RealLinearSpace holds LattStr (# Subspaces(V),
    SubJoin(V), SubMeet(V) #) is complemented;

registration
  let V;
  cluster LattStr (# Subspaces(V), SubJoin(V), SubMeet(V) #) -> lower-bounded
    upper-bounded modular complemented;
end;






theorem 
  for V being RealLinearSpace, W1,W2,W3 being strict Subspace of V holds
  W1 is Subspace of W2 implies W1 /\ W3 is Subspace of W2 /\ W3;





theorem 
  for V being add-associative right_zeroed right_complementable non
empty addLoopStr, v,v1,v2 being Element of V holds v = v1 + v2 iff v1 = v - v2;

theorem 
  for V being RealLinearSpace, W being strict Subspace of V holds (for v
  being VECTOR of V holds v in W) implies W = the RLSStruct of V;

theorem 
  ex C st v in C;

theorem 
  (for a holds a "/\" b = b) implies b = Bottom l;

theorem 
  (for a holds a "\/" b = b) implies b = Top l;














begin 

definition
  struct(1-sorted) MidStr (# carrier -> set, MIDPOINT -> BinOp of the carrier
  #);
end;

registration
  cluster non empty for MidStr;
end;

reserve MS for non empty MidStr;
reserve a, b for Element of MS;

definition
  let MS,a,b;
  func a@b -> Element of MS equals

  (the MIDPOINT of MS).(a,b);
end;

definition
  func Example -> MidStr equals

  MidStr (# 1, op2 #);
end;

registration
  cluster Example -> strict non empty;
end;

theorem 
  the carrier of Example = 1;

theorem 
  the MIDPOINT of Example = op2;

theorem 
  for a,b being Element of Example holds a@b = op2.(a,b);

theorem 
  for a,b,c,d being Element of Example holds a@a = a & a@b = b@a &
  (a@b)@(c@d) = (a@c)@(b@d) & ex x being Element of Example st x@a = b;



definition
  let IT be non empty MidStr;
  attr IT is MidSp-like means


  for a,b,c,d being Element of IT holds a@a
= a & a@b = b@a & (a@b)@(c@d) = (a@c)@(b@d) & ex x being Element of IT st x@a =
  b;
end;

registration
  cluster strict MidSp-like for non empty MidStr;
end;

definition
  mode MidSp is MidSp-like non empty MidStr;
end;

definition
  let M be MidSp, a, b be Element of M;
  redefine func a@b;
  commutativity;
end;

reserve M for MidSp;
reserve a,b,c,d,a9,b9,c9,d9,x,y,x9 for Element of M;

theorem 
  (a@b)@c = (a@c)@(b@c);

theorem 
  a@(b@c) = (a@b)@(a@c);

theorem 
  a@b = a implies a = b;

theorem 
  x@a = x9@a implies x = x9;

theorem 
  a@x = a@x9 implies x = x9;




definition
  let M,a,b,c,d;
  pred a,b @@ c,d means


  a@d = b@c;
end;

theorem 
  a,a @@ b,b;

theorem 
  a,b @@ c,d implies c,d @@ a,b;

theorem 
  a,a @@ b,c implies b = c;

theorem 
  a,b @@ c,c implies a = b;

theorem 
  a,b @@ a,b;

theorem 
  ex d st a,b @@ c,d;

theorem 
  a,b @@ c,d & a,b @@ c,d9 implies d = d9;

theorem 
  x,y @@ a,b & x,y @@ c,d implies a,b @@ c,d;

theorem 
  a,b @@ a9,b9 & b,c @@ b9,c9 implies a,c @@ a9,c9;



reserve p,q,r,p9,q9 for Element of [:the carrier of M,the carrier of M:];

definition
  let M,p,q;
  pred p ## q means


  p`1,p`2 @@ q`1,q`2;
  reflexivity;
  symmetry;
end;

theorem 
  a,b @@ c,d implies [a,b] ## [c,d];

theorem 
  [a,b] ## [c,d] implies a,b @@ c,d;

theorem 
  p ## q & p ## r implies q ## r;

theorem 
  p ## r & q ## r implies p ## q;

theorem 
  p ## q & q ## r implies p ## r;

theorem 
  p ## q implies (r ## p iff r ## q);

theorem 
  for p holds { q : q ## p } is non empty Subset of [:the carrier
  of M,the carrier of M:];



definition
  let M,p;
  func p~ -> Subset of [:the carrier of M,the carrier of M:] equals

  { q : q ## p};
end;

registration
  let M,p;
  cluster p~ -> non empty;
end;

theorem 
  for p holds r in p~ iff r ## p;

theorem 
  p ## q implies p~ = q~;

theorem 
  p~ = q~ implies p ## q;

theorem 
  [a,b]~ = [c,d]~ implies a@d = b@c;

theorem 
  p in p~;

definition
  let M;
  mode Vector of M -> non empty Subset of [:the carrier of M,the carrier of M
    :] means


    ex p st it = p~;
end;

reserve u,v,w,u9,w9 for Vector of M;

definition
  let M,p;
  redefine func p~ -> Vector of M;
end;

theorem 
  ex u st for p holds p in u iff p`1 = p`2;

definition
  let M;
  func ID(M) -> Vector of M equals

  { p : p`1 = p`2 };
end;

theorem 
  ID(M) = [b,b]~;

theorem 
  (ex p,q st u = p~ & v = q~ & p`2 = q`1 & w = [p`1,q`2]~)& (ex p,
  q st u = p~ & v = q~ & p`2 = q`1 & w9 = [p`1,q`2]~) implies w = w9;

definition
  let M,u,v;
  func u + v -> Vector of M means


  ex p,q st u = p~ & v = q~ & p`2 = q `1 & it = [p`1,q`2]~;
end;



theorem 
  ex b st u = [a,b]~;

definition
  let M,a,b;
  func vect(a,b) -> Vector of M equals

  [a,b]~;
end;

theorem 
  ex b st u = vect(a,b);

theorem 
  [a,b] ## [c,d] implies vect(a,b) = vect(c,d);

theorem 
  vect(a,b) = vect(c,d) implies a@d = b@c;

theorem 
  ID(M) = vect(b,b);

theorem 
  vect(a,b) = vect(a,c) implies b = c;

theorem 
  vect(a,b) + vect(b,c) = vect(a,c);



theorem 
  [a,a@b] ## [a@b,b];

theorem 
  vect(a,a@b) + vect(a,a@b) = vect(a,b);

theorem 
  (u+v)+w = u+(v+w);

theorem 
  u+ID(M) = u;

theorem 
  ex v st u+v = ID(M);

theorem 
  u+v = v+u;

theorem 
  u + v = u + w implies v = w;

definition
  let M,u;
  func -u -> Vector of M means

  u + it = ID(M);
end;

reserve X for Subset of [:the carrier of M,the carrier of M:];

definition
  let M;
  func setvect(M) -> set equals

  { X : X is Vector of M};
end;

reserve x for set;

theorem 
  x is Vector of M iff x in setvect(M);

registration
  let M;
  cluster setvect(M) -> non empty;
end;

reserve u1,v1,w1,W,W1,W2,T for Element of setvect(M);

definition
  let M,u1,v1;
  func u1 + v1 -> Element of setvect(M) means


  for u,v holds u1 = u & v1 = v implies it = u + v;
end;

theorem 
  u1 + v1 = v1 + u1;

theorem 
  (u1 + v1) + w1 = u1 + (v1 + w1);

definition
  let M;
  func addvect(M) -> BinOp of setvect(M) means


  for u1,v1 holds it.(u1, v1) = u1 + v1;
end;

theorem 
  for W ex T st W + T = ID(M);

theorem 
  for W,W1,W2 st W + W1 = ID(M) & W + W2 = ID(M) holds W1 = W2;

definition
  let M;
  func complvect(M) -> UnOp of setvect(M) means


  for W holds W + it.W = ID(M);
end;

definition
  let M;
  func zerovect(M) -> Element of setvect(M) equals

  ID(M);
end;

definition
  let M;
  func vectgroup(M) -> addLoopStr equals

  addLoopStr (# setvect(M), addvect(M),
    zerovect(M) #);
end;

registration
  let M;
  cluster vectgroup M -> strict non empty;
end;

theorem 
  the carrier of vectgroup(M) = setvect(M);

theorem 
  the addF of vectgroup(M) = addvect(M);

theorem 
  0.vectgroup(M) = zerovect M;

theorem 
  vectgroup(M) is add-associative right_zeroed right_complementable Abelian;














begin

reserve x1,x2,z for set;
reserve A,B for non empty set;

definition
  let A be set, B be non empty set;
  let F be BinOp of Funcs(A,B);
  let f,g be Element of Funcs(A,B);
  redefine func F.(f,g) -> Element of Funcs(A,B);
end;

definition
  let A,B,C,D be non empty set;
  let F be Function of [:C,D:],Funcs(A,B);
  let cd be Element of [:C,D:];
  redefine func F.cd -> Element of Funcs(A,B);
end;

reserve f,g,h for Element of Funcs(A,REAL);

definition
  let X be non empty set, Z be set;
  let F be (BinOp of X), f,g be Function of Z,X;

  redefine func F.:(f,g) -> Element of Funcs(Z,X);
end;

definition
  let X be non empty set, Z be set;
  let F be (BinOp of X),a be Element of X,f be Function of Z,X;
  redefine func F[;](a,f) -> Element of Funcs(Z,X);
end;

definition let A be set;
  func RealFuncAdd(A) -> BinOp of Funcs(A,REAL) means


  for f,g being Element of Funcs(A,REAL) holds it.(f,g) = addreal.:(f,g);
end;

definition let A be set;
  func RealFuncMult(A) -> BinOp of Funcs(A,REAL) means


  for f,g being Element of Funcs(A,REAL) holds it.(f,g) = multreal.:(f,g);
end;

definition let A be set;
  func RealFuncExtMult(A) -> Function of [:REAL,Funcs(A,REAL):],Funcs(A,REAL)
  means


  for a being Real, f being Element of Funcs(A,REAL) holds it.(a,f)
  = multreal[;](a,f);
end;

definition
  let A be set;
  func RealFuncZero A -> Element of Funcs(A,REAL) equals

  A --> 0;
end;

definition
  let A be set;
  func RealFuncUnit A -> Element of Funcs(A,REAL) equals

  A --> 1;
end;

theorem 
  h = (RealFuncAdd A).(f,g) iff for x being Element of A holds h.x = f.x + g.x;

theorem 
  h = (RealFuncMult(A)).(f,g) iff for x being Element of A holds h
  .x = f.x * g.x;

theorem 
  RealFuncZero(A) <> RealFuncUnit(A);

reserve a,b for Real;

theorem 
  h = (RealFuncExtMult A).[a,f] iff for x being Element of A holds
  h.x = a*(f.x);

theorem 
  for A being set, f,g being Element of Funcs(A,REAL) holds (
  RealFuncAdd A).(f,g) = (RealFuncAdd A).(g,f);

theorem 
  for A being set, f,g,h being Element of Funcs(A,REAL) holds (
RealFuncAdd A).(f,(RealFuncAdd A).(g,h)) = (RealFuncAdd A).((RealFuncAdd A).(f,
  g),h);

theorem 
 for A be set, f,g be Element of Funcs(A,REAL) holds
  (RealFuncMult A).(f,g) = (RealFuncMult A).(g,f);

theorem 
 for A be set, f,g,h be Element of Funcs(A,REAL) holds
  (RealFuncMult(A)).(f,(RealFuncMult(A)).(g,h)) = (RealFuncMult(A)
  ).((RealFuncMult(A)).(f,g),h);

theorem 
 for A being set, f being Element of Funcs(A,REAL) holds
  (RealFuncMult(A)).(RealFuncUnit(A),f) = f;

theorem 
  for A being set, f being Element of Funcs(A,REAL) holds (
  RealFuncAdd A).(RealFuncZero(A),f) = f;

theorem 
  for A being set, f be Element of Funcs(A,REAL) holds (
  RealFuncAdd A).(f,(RealFuncExtMult A).[-1,f]) = RealFuncZero(A);

theorem 
  for A being set, f being Element of Funcs(A,REAL) holds (
  RealFuncExtMult A).(1,f) = f;

theorem 
  for A being set, f being Element of Funcs(A,REAL) holds (
RealFuncExtMult A).(a,(RealFuncExtMult A).(b,f)) = (RealFuncExtMult A).(a*b,f);

theorem 
  for A being set, f being Element of Funcs(A,REAL) holds (
  RealFuncAdd A).((RealFuncExtMult A).(a,f),(RealFuncExtMult A).(b,f)) = (
  RealFuncExtMult A).(a+b,f);

theorem 
 for A be set, f,g,h be Element of Funcs(A,REAL) holds
  (RealFuncMult(A)).(f,(RealFuncAdd A).(g,h)) = (RealFuncAdd A).((
  RealFuncMult(A)).(f,g),(RealFuncMult(A)).(f,h));

theorem 
 for A being set, f,g,h be Element of Funcs(A,REAL), a being Real holds
  (RealFuncMult A).((RealFuncExtMult A).(a,f),g)
   = (RealFuncExtMult A).(a,(RealFuncMult A).(f,g));

theorem 
  ex f,g st (for z st z in A holds (z=x1 implies f.z = 1) & (z<>x1
  implies f.z = 0)) & for z st z in A holds (z=x1 implies g.z = 0) & (z<>x1
  implies g.z = 1);

theorem 
  x1 in A & x2 in A & x1<>x2 & (for z st z in A holds (z=x1
  implies f.z = 1) & (z<>x1 implies f.z = 0)) & (for z st z in A holds (z=x1
implies g.z = 0) & (z<>x1 implies g.z = 1)) implies for a,b st (RealFuncAdd A).
((RealFuncExtMult A).[a,f],(RealFuncExtMult A).[b,g]) = RealFuncZero(A) holds a
  =0 & b=0;

theorem 
  x1 in A & x2 in A & x1<>x2 implies ex f,g st for a,b st (RealFuncAdd A
  ). ((RealFuncExtMult A).[a,f],(RealFuncExtMult A).[b,g]) = RealFuncZero(A)
  holds a=0 & b=0;

theorem 
  A = {x1,x2} & x1<>x2 & (for z st z in A holds (z=x1 implies f.z
= 1) & (z<>x1 implies f.z = 0)) & (for z st z in A holds (z=x1 implies g.z = 0)
& (z<>x1 implies g.z = 1)) implies for h holds ex a,b st h = (RealFuncAdd A). (
  (RealFuncExtMult A).[a,f],(RealFuncExtMult A).[b,g]);

theorem 
  A = {x1,x2} & x1<>x2 implies ex f,g st for h holds ex a,b st h = (
  RealFuncAdd A). ((RealFuncExtMult A).[a,f],(RealFuncExtMult A).[b,g]);

theorem 
  A = {x1,x2} & x1<>x2 implies ex f,g st (for a,b st (RealFuncAdd
  A).((RealFuncExtMult A).[a,f], (RealFuncExtMult A).[b,g]) = RealFuncZero(A)
holds a=0 & b=0) & for h holds ex a,b st h = (RealFuncAdd A). ((RealFuncExtMult
  A).[a,f],(RealFuncExtMult A).[b,g]);

definition
  let A be set;
  func RealVectSpace(A) -> strict RealLinearSpace equals

  RLSStruct(#Funcs(A,
    REAL), (RealFuncZero(A)),RealFuncAdd(A),RealFuncExtMult(A)#);
end;

theorem 
  ex V being strict RealLinearSpace st ex u,v being Element of V st (for
a,b st a*u + b*v = 0.V holds a=0 & b=0) & for w being Element of V ex a,b st w
  = a*u + b*v;

definition
  let A;

  func RRing(A) -> strict doubleLoopStr equals

  doubleLoopStr(#Funcs(A,REAL),
    RealFuncAdd A,RealFuncMult A, RealFuncUnit A,RealFuncZero A#);
end;

registration
  let A;
  cluster RRing A -> non empty;
end;

registration
  let A;
  cluster RRing(A) -> unital;
end;

theorem 
  1.RRing(A) = RealFuncUnit(A);

theorem 
  for x,y,z being Element of RRing(A) holds x+y = y+x & (x+y)+z =
x+(y+z) & x+(0.RRing(A)) = x & (ex t being Element of RRing(A) st x+t=(0.RRing(
A))) & x*y = y*x & (x*y)*z = x*(y*z) & x*(1.RRing(A)) = x & (1.RRing(A))*x = x
  & x*(y+z) = x*y + x*z & (y+z)*x = y*x + z*x;

registration
  cluster strict Abelian add-associative right_zeroed right_complementable
    associative commutative right_unital right-distributive for 1-element
    doubleLoopStr;
end;

definition
  mode Ring is Abelian add-associative right_zeroed right_complementable
    associative well-unital distributive non empty doubleLoopStr;
end;

theorem 
  RRing(A) is commutative Ring;

definition
  struct(doubleLoopStr,RLSStruct) AlgebraStr (# carrier -> set, multF,addF ->
(BinOp of the carrier), Mult -> (Function of [:REAL,the carrier:],the carrier),
    OneF,ZeroF -> Element of the carrier #);
end;

registration
  cluster non empty for AlgebraStr;
end;

definition
  let A be set;

  func RAlgebra A -> strict AlgebraStr equals

  AlgebraStr(#Funcs(A,REAL),
    RealFuncMult(A),RealFuncAdd(A), RealFuncExtMult(A),(RealFuncUnit(A)),(
    RealFuncZero(A))#);
end;

registration
  let A;
  cluster RAlgebra(A) -> non empty;
end;

registration
  let A;
  cluster RAlgebra(A) -> unital;
end;

theorem 
  1.RAlgebra(A) = RealFuncUnit(A);

definition
  let IT be non empty AlgebraStr;
  attr IT is vector-associative means

 for x,y being Element of IT for a holds a*(x*y) = (a*x)*y;
end;

registration let A be set;
 cluster RAlgebra A -> non empty;
end;

registration let A be set;
 cluster RAlgebra A -> strict Abelian add-associative right_zeroed
    right_complementable commutative associative right_unital
    right-distributive vector-associative scalar-associative
    vector-distributive scalar-distributive;
end;

registration
  cluster strict Abelian add-associative right_zeroed right_complementable
commutative associative right_unital right-distributive vector-associative
scalar-associative vector-distributive scalar-distributive for non empty
    AlgebraStr;
end;

definition
  mode Algebra is Abelian add-associative right_zeroed right_complementable
    commutative associative right_unital right-distributive
    vector-associative scalar-associative vector-distributive
    scalar-distributive non empty AlgebraStr;
end;














begin 

reserve FS for non empty doubleLoopStr;
reserve F for Field;

registration
  cluster strict Abelian add-associative right_zeroed right_complementable
    unital distributive for non empty doubleLoopStr;
end;

definition
  let IT be non empty multLoopStr_0;

  attr IT is domRing-like means


  for x,y being Element of IT holds x*y = 0.IT implies x = 0.IT or y = 0.IT;
end;

registration
  cluster strict non degenerated commutative almost_left_invertible
    domRing-like for Ring;
end;

definition
  mode comRing is commutative Ring;
end;

definition
  mode domRing is domRing-like non degenerated comRing;
end;

theorem 
  F is domRing;

definition
  mode Skew-Field is non degenerated almost_left_invertible Ring;
end;



registration
  cluster commutative left_unital -> well-unital for non empty multLoopStr;
  cluster commutative right_unital -> well-unital for non empty multLoopStr;
end;



reserve R for Abelian add-associative right_zeroed right_complementable non
  empty addLoopStr,
  x, y, z for Scalar of R;

theorem 
  (x + y = z iff x = z - y) & (x + y = z iff y = z - x);

theorem 
  for R being add-associative right_zeroed right_complementable
  non empty addLoopStr, x being Element of R holds x=0.R iff -x=0.R;

theorem 
  for R being add-associative right_zeroed Abelian right_complementable
non empty addLoopStr for x,y being Element of R ex z being Element of R st x
  = y+z & x = z+y;



reserve SF for Skew-Field,
  x, y, z for Scalar of SF;

theorem 
  for F being add-associative right_zeroed right_complementable
  distributive non degenerated non empty doubleLoopStr for x, y being Element
  of F holds x*y = 1.F implies x<>0.F & y<>0.F;

theorem 
  for SF being non degenerated almost_left_invertible associative
add-associative right_zeroed right_complementable well-unital distributive non
  empty doubleLoopStr, x being Element of SF holds x<>0.SF implies ex y being
  Element of SF st x*y = 1.SF;

theorem 
  for SF being add-associative right_zeroed right_complementable
  distributive non degenerated almost_left_invertible associative well-unital
non empty doubleLoopStr for x,y being Element of SF st y*x = 1.SF holds x*y =
  1.SF;

theorem 
  for SF being non degenerated almost_left_invertible associative
  Abelian add-associative right_zeroed right_complementable well-unital
distributive non empty doubleLoopStr, x,y,z being Element of SF holds x * y =
  x * z & x<>0.SF implies y = z;

definition
  let SF be non degenerated almost_left_invertible associative add-associative
  right_zeroed right_complementable well-unital distributive non empty
  doubleLoopStr, x be Element of SF;
  assume
 x<>0.SF;

  redefine func x" means


  it * x = 1.SF;
end;

definition
  let SF,x,y;
  func x/y -> Scalar of SF equals

  x * y";
end;

theorem 
  x<>0.SF implies x * x" = 1.SF & x" * x = 1.SF;

theorem 
  y*x = 1_SF implies x = y" & y = x";

theorem 
  x<>0.SF & y<>0.SF implies x"*y"=(y*x)";

theorem 
  x*y = 0.SF implies x = 0.SF or y = 0.SF;

theorem 
  x<>0.SF implies x"<>0.SF;

theorem 
  x<>0.SF implies x""=x;

theorem 
  x<>0.SF implies (1_SF)/x=x" & (1_SF)/x"=x;

theorem 
  x<>0.SF implies x*((1_SF)/x)=1_SF & ((1_SF)/x)*x=1_SF;

theorem 
  x<>0.SF implies x/x = 1_SF;

theorem 
  y<>0.SF & z<>0.SF implies x/y=(x*z)/(y*z);

theorem 
  y<>0.SF implies -x/y=(-x)/y & x/(-y)=-x/y;

theorem 
  z<>0.SF implies x/z + y/z = (x+y)/z & x/z - y/z = (x-y)/z;

theorem 
  y<>0.SF & z<>0.SF implies x/(y/z)=(x*z)/y;

theorem 
  y<>0.SF implies x/y*y=x;



definition
  let FS be 1-sorted;
  struct(addLoopStr) RightModStr over FS (# carrier -> set, addF -> BinOp of
    the carrier, ZeroF -> Element of the carrier, rmult -> Function of [: the
    carrier, the carrier of FS:], the carrier #);
end;

registration
  let FS be 1-sorted;
  cluster non empty for RightModStr over FS;
end;

registration
  let FS be 1-sorted;
  let A be non empty set, a be BinOp of A, Z be Element of A, r be Function of
  [:A,the carrier of FS:],A;
  cluster RightModStr(#A,a,Z,r#) -> non empty;
end;

definition
  let FS;
  let RMS be non empty RightModStr over FS;
  mode Scalar of RMS is Element of FS;
  mode Vector of RMS is Element of RMS;
end;

definition
  let FS1,FS2 be 1-sorted;
  struct (VectSpStr over FS1, RightModStr over FS2) BiModStr over FS1,FS2 (#
carrier -> set, addF -> BinOp of the carrier, ZeroF -> Element of the carrier,
lmult -> Function of [:the carrier of FS1, the carrier:], the carrier, rmult ->
    Function of [:the carrier, the carrier of FS2:], the carrier #);
end;

registration
  let FS1,FS2 be 1-sorted;
  cluster non empty for BiModStr over FS1,FS2;
end;

registration
  let FS1,FS2 be 1-sorted;
  let A be non empty set, a be BinOp of A, Z be Element of A, l be Function of
  [:the carrier of FS1,A:],A, r be Function of [:A,the carrier of FS2:],A;
  cluster BiModStr(#A,a,Z,l,r#) -> non empty;
end;



reserve R, R1, R2 for Ring;

definition
  let R be Abelian add-associative right_zeroed right_complementable non
  empty addLoopStr;
  func AbGr R -> strict AbGroup equals

  addLoopStr (#the carrier of R, the addF
    of R, 0.R#);
end;

registration
  let R;
  cluster Abelian add-associative right_zeroed right_complementable strict for

    non empty VectSpStr over R;
end;

definition
  let R;

  func LeftModule R -> Abelian add-associative right_zeroed
  right_complementable strict non empty VectSpStr over R equals

  VectSpStr (#
    the carrier of R, the addF of R, 0.R, the multF of R #);
end;

registration let R;
  cluster Abelian add-associative right_zeroed right_complementable strict for

    non empty RightModStr over R;
end;

definition let R;

  func RightModule R -> Abelian add-associative right_zeroed
  right_complementable strict non empty RightModStr over R equals

  RightModStr
  (# the carrier of R, the addF of R, 0.R, the multF of R #);
end;

definition
  let R be non empty 1-sorted, V be non empty RightModStr over R;
  let x be Element of R;
  let v be Element of V;
  func v*x -> Element of V equals

  (the rmult of V).(v,x);
end;

registration let R1,R2;
  cluster Abelian add-associative right_zeroed right_complementable strict for

    non empty BiModStr over R1,R2;
end;

definition let R1,R2;

  func BiModule(R1,R2) -> Abelian add-associative right_zeroed
  right_complementable strict non empty BiModStr over R1,R2 equals

  BiModStr (#1,op2,op0,pr2(the carrier of R1, 1), pr1(1,the carrier of R2) #);
end;

theorem 
  for x,y being Scalar of R for v,w being Vector of LeftModule R
  holds x*(v+w) = x*v+x*w & (x+y)*v = x*v+y*v & (x*y)*v = x*(y*v) & (1.R)*v = v
;

registration
  let R;
  cluster vector-distributive scalar-distributive scalar-associative
    scalar-unital Abelian add-associative right_zeroed
    right_complementable strict for non empty VectSpStr over R;
end;

definition
  let R;
  mode LeftMod of R is Abelian add-associative right_zeroed
    right_complementable vector-distributive scalar-distributive
    scalar-associative scalar-unital non empty VectSpStr over R;
end;

registration let R;
  cluster LeftModule R -> Abelian add-associative right_zeroed
    right_complementable strict vector-distributive scalar-distributive
    scalar-associative scalar-unital;
end;



theorem 
  for x,y being Scalar of R for v,w being Vector of RightModule R
  holds (v+w)*x = v*x+w*x & v*(x+y) = v*x+v*y & v*(y*x) = (v*y)*x & v*(1_R) = v
;

definition
  let R be non empty doubleLoopStr;
  let IT be non empty RightModStr over R;

  attr IT is RightMod-like means


  for x,y being Scalar of R for v,w
being Vector of IT holds (v+w)*x = v*x+w*x & v*(x+y) = v*x+v*y & v*(y*x) = (v*y
  )*x & v*(1_R) = v;
end;

registration let R;
  cluster Abelian add-associative right_zeroed right_complementable
    RightMod-like strict for non empty RightModStr over R;
end;

definition
  let R;
  mode RightMod of R is Abelian add-associative right_zeroed
    right_complementable RightMod-like non empty RightModStr over R;
end;

registration let R;
  cluster RightModule R -> Abelian add-associative right_zeroed
    right_complementable RightMod-like;
end;

definition let R1,R2;
  let IT be non empty BiModStr over R1,R2;
  attr IT is BiMod-like means


  for x being Scalar of R1 for p being
  Scalar of R2 for v being Vector of IT holds x*(v*p) = (x*v)*p;
end;

registration let R1,R2;
  cluster Abelian add-associative right_zeroed right_complementable
RightMod-like vector-distributive scalar-distributive scalar-associative
scalar-unital BiMod-like strict for non empty BiModStr over R1,R2;
end;

definition let R1,R2;
  mode BiMod of R1,R2 is Abelian add-associative right_zeroed
right_complementable RightMod-like vector-distributive scalar-distributive
scalar-associative scalar-unital BiMod-like non empty BiModStr
    over R1,R2;
end;

theorem 
  for V being non empty BiModStr over R1,R2 holds (for x,y being Scalar
of R1 for p,q being Scalar of R2 for v,w being Vector of V holds x*(v+w) = x*v+
x*w & (x+y)*v = x*v+y*v & (x*y)*v = x*(y*v) & (1_R1)*v = v & (v+w)*p = v*p+w*p
& v*(p+q) = v*p+v*q & v*(q*p) = (v*q)*p & v*(1_R2) = v & x*(v*p) = (x*v)*p) iff
  V is RightMod-like vector-distributive scalar-distributive
  scalar-associative scalar-unital BiMod-like;

theorem 
  BiModule(R1,R2) is BiMod of R1,R2;

registration let R1,R2;
  cluster BiModule(R1,R2) -> Abelian add-associative right_zeroed
    right_complementable RightMod-like vector-distributive scalar-distributive
    scalar-associative scalar-unital BiMod-like;
end;

theorem 
  for L being non empty multLoopStr st L is well-unital holds 1.(L) =
  1_L;

begin 

theorem 
  for K be add-associative right_zeroed right_complementable
right-distributive right_unital non empty doubleLoopStr for a be Element of K
  holds a * (- 1.K) = - a;

theorem 
  for K be add-associative right_zeroed right_complementable
  left-distributive left_unital non empty doubleLoopStr for a be Element of K
  holds (- 1.K) * a = - a;

reserve R for Abelian add-associative right_zeroed right_complementable
  associative well-unital right_unital distributive non empty doubleLoopStr,
  F for non degenerated almost_left_invertible Ring,
  x for Scalar of F,
  V for add-associative right_zeroed right_complementable vector-distributive
  scalar-distributive scalar-associative scalar-unital
   non empty
  VectSpStr over F,
  v for Vector of V;

theorem 
  x*v = 0.V iff x = 0.F or v = 0.V;

theorem 
  x<>0.F implies x"*(x*v)=v;

reserve V for add-associative right_zeroed right_complementable RightMod-like
  non empty RightModStr over R;
reserve x for Scalar of R;
reserve v,w for Vector of V;

theorem 
  v*(0.R) = 0.V & v*(-1_R) = -v & (0.V)*x = 0.V;

theorem 
  -v*x = v*(-x) & w - v*x = w + v*(-x);

theorem 
  (-v)*x = -v*x;

theorem 
  (v - w)*x = v*x - w*x;

reserve F for non degenerated almost_left_invertible Ring;
reserve x for Scalar of F;
reserve V for add-associative right_zeroed right_complementable RightMod-like
  non empty RightModStr over F;
reserve v for Vector of V;

theorem 
  v*x = 0.V iff x = 0.F or v = 0.V;

theorem 
  x<>0.F implies (v*x)*x"=v;














begin

reserve L for Lattice,
  p,p1,q,q1,r,r1 for Element of L;
reserve x,y,z,X,Y,Z,X1,X2 for set;

theorem 
  for L being join-associative join-commutative meet-commutative
  join-absorbing meet-absorbing non empty LattStr, p, q, r being Element of L
  st p [= q holds r "\/" p [= r "\/" q;

theorem 
  p [= r implies p "/\" q [= r;

theorem 
  p [= r implies p [= q"\/"r;

theorem 
  for L being join-absorbing join-commutative join-associative non
empty LattStr, a, b, c, d being Element of L st a [= b & c [= d holds a "\/" c
  [= b "\/" d;

theorem 
  for L being meet-absorbing meet-commutative join-absorbing
meet-associative non empty LattStr, a, b, c, d being Element of L st a [= b &
  c [= d holds a "/\" c [= b "/\" d;

theorem 
  for L being join-absorbing join-commutative join-associative
meet-absorbing meet-commutative non empty LattStr, a, b, c being Element of L
  st a [= c & b [= c holds a "\/" b [= c;

theorem 
  for L being meet-absorbing meet-commutative join-absorbing
meet-associative non empty LattStr, a, b, c being Element of L st a [= b & a
  [= c holds a [= b "/\" c;

definition
  let L;

  mode Filter of L is non empty meet-closed final Subset of L;
end;

theorem 
 for S being non empty Subset of L holds S is Filter of L iff
  for p,q being Element of L holds p in S & q in S iff p "/\" q in S;

theorem 
  for D being non empty Subset of L holds D is Filter of L iff (for
p,q st p in D & q in D holds p "/\" q in D) & for p,q st p in D & p [= q holds
  q in D;

reserve H,F for Filter of L;

theorem 
  p in H implies p"\/"q in H & q"\/"p in H;

theorem 
  L is 1_Lattice implies Top L in H;

theorem 
  L is 1_Lattice implies {Top L} is Filter of L;

theorem 
  {p} is Filter of L implies L is upper-bounded;

theorem 
  the carrier of L is Filter of L;

definition
  let L;
  func <.L.) -> Filter of L equals

  the carrier of L;
end;

definition
  let L,p;
  func <.p.) -> Filter of L equals

  { q : p [= q };
end;

theorem 
  q in <.p.) iff p [= q;

theorem 
  p in <.p.) & p "\/" q in <.p.) & q "\/" p in <.p.);

theorem 
  L is 0_Lattice implies <.L.) = <.Bottom L.);

definition
  let L,F;
  attr F is being_ultrafilter means


  F <> the carrier of L & for H st F c= H & H <> the carrier of L holds F = H;
end;

theorem 
  L is lower-bounded implies for F st F <> the carrier of L ex H
  st F c= H & H is being_ultrafilter;

theorem 
  (ex r st p "/\" r <> p) implies <.p.) <> the carrier of L;

theorem 
  L is 0_Lattice & p <> Bottom L implies ex H st p in H & H is
  being_ultrafilter;

reserve D for non empty Subset of L;

definition
  let L,D;
  func <.D.) -> Filter of L means


  D c= it & for F st D c= F holds it c= F;
end;

theorem 
  <.F.) = F;

reserve D1,D2 for non empty Subset of L;

theorem 
  D1 c= D2 implies <.D1.) c= <.D2.);

theorem 
  p in D implies <.p.) c= <.D.);

theorem 
  D = {p} implies <.D.) = <.p.);

theorem 
  L is 0_Lattice & Bottom L in D implies <.D.) = <.L.) & <.D.) =
  the carrier of L;

theorem 
  L is 0_Lattice & Bottom L in F implies F = <.L.) & F = the carrier of L;

definition
  let L,F;
  attr F is prime means

  p "\/" q in F iff p in F or q in F;
end;

theorem 
  L is B_Lattice implies for p,q holds p "/\" (p` "\/" q) [= q &
  for r st p "/\" r [= q holds r [= p` "\/" q;

definition
  let IT be non empty LattStr;
  attr IT is implicative means


  for p,q being Element of IT ex r being
  Element of IT st p "/\" r [= q & for r1 being Element of IT st p "/\" r1 [= q
  holds r1 [= r;
end;

registration
  cluster strict implicative for Lattice;
end;

definition
  mode I_Lattice is implicative Lattice;
end;

definition
  let L,p,q;
  assume
 L is I_Lattice;
  func p => q -> Element of L means


  p "/\" it [= q & for r st p "/\" r [= q holds r [= it;
end;

reserve I for I_Lattice,
  i,j,k for Element of I;

registration
  cluster -> upper-bounded for I_Lattice;
end;

theorem 
  i => i = Top I;

registration
  cluster -> distributive for I_Lattice;
end;

reserve B for B_Lattice,
  FB,HB for Filter of B;

registration
  cluster -> implicative for B_Lattice;
end;

registration
  cluster implicative -> distributive for Lattice;
end;

reserve I for I_Lattice,
  i,j,k for Element of I,
  DI for non empty Subset of I,
  FI for Filter of I;

theorem 
  i in FI & i => j in FI implies j in FI;

theorem 
  j in FI implies i => j in FI;

definition
  let L,D1,D2;
  func D1 "/\" D2 -> Subset of L equals

  { p"/\"q : p in D1 & q in D2 };
end;

registration
  let L,D1,D2;
  cluster D1 "/\" D2 -> non empty;
end;

theorem 
  p in D1 & q in D2 implies p"/\"q in D1 "/\" D2 & q"/\"p in D1 "/\" D2;

theorem 
  x in D1 "/\" D2 implies ex p,q st x = p"/\"q & p in D1 & q in D2;

theorem 
  D1 "/\" D2 = D2 "/\" D1;

registration
  let L be D_Lattice;
  let F1,F2 be Filter of L;
  cluster F1 "/\" F2 -> final meet-closed;
end;

theorem 
  <.D1 \/ D2.) = <.<.D1.) \/ D2.) & <.D1 \/ D2.) = <.D1 \/ <.D2.) .);

theorem 
  <.F \/ H.) = { r : ex p,q st p"/\"q [= r & p in F & q in H };

theorem 
  F c= F "/\" H & H c= F "/\" H;

theorem 
  <.F \/ H.) = <.F "/\" H.);

reserve F1,F2 for Filter of I;

theorem 
  <.F1 \/ F2.) = F1 "/\" F2;

theorem 
  <.FB \/ HB.) = FB "/\" HB;

theorem 
  j in <.DI \/ {i}.) implies i => j in <.DI.);

theorem 
  i => j in FI & j => k in FI implies i => k in FI;

reserve a,b,c for Element of B;

theorem 
  a => b = a` "\/" b;

theorem 
  a [= b iff a"/\"b` = Bottom B;

theorem 
  FB is being_ultrafilter iff FB <> the carrier of B & for a holds
  a in FB or a` in FB;

theorem 
  FB <> <.B.) & FB is prime iff FB is being_ultrafilter;

theorem 
  FB is being_ultrafilter implies for a holds a in FB iff not a` in FB;

theorem 
  a <> b implies ex FB st FB is being_ultrafilter & (a in FB & not b in
  FB or not a in FB & b in FB);

reserve o1,o2 for BinOp of F;

definition
  let L,F;
  func latt F -> Lattice means


  ex o1,o2 st o1 = (the L_join of L)||F
  & o2 = (the L_meet of L)||F & it = LattStr (#F, o1, o2#);
end;

registration
  let L,F;
  cluster latt F -> strict;
end;

theorem 
  for L being strict Lattice holds latt <.L.) = L;

theorem 
  the carrier of latt F = F & the L_join of latt F = (the L_join
  of L)||F & the L_meet of latt F = (the L_meet of L)||F;

theorem 
  for p9,q9 being Element of latt F st p = p9 & q = q9 holds p"\/"
  q = p9"\/"q9 & p"/\"q = p9"/\"q9;

theorem 
  for p9,q9 being Element of latt F st p = p9 & q = q9 holds p [=
  q iff p9 [= q9;

theorem 
  L is upper-bounded implies latt F is upper-bounded;

theorem 
  L is modular implies latt F is modular;

theorem 
  L is distributive implies latt F is distributive;

theorem 
  L is I_Lattice implies latt F is implicative;

registration
  let L,p;
  cluster latt <.p.) -> lower-bounded;
end;

theorem 
  Bottom latt <.p.) = p;

theorem 
  L is upper-bounded implies Top latt <.p.) = Top L;

theorem 
  L is 1_Lattice implies latt <.p.) is bounded;

theorem 
  L is C_Lattice & L is M_Lattice implies latt <.p.) is C_Lattice;

theorem 
  L is B_Lattice implies latt <.p.) is B_Lattice;

definition
  let L,p,q;
  func p <=> q -> Element of L equals

  (p => q)"/\"(q => p);
end;

theorem 
  p <=> q = q <=> p;

theorem 
  i <=> j in FI & j <=> k in FI implies i <=> k in FI;

definition
  let L,F;
  func equivalence_wrt F -> Relation means


  field it c= the carrier of L & for p,q holds [p,q] in it iff p <=> q in F;
end;

theorem 
  equivalence_wrt F is Relation of the carrier of L;

theorem 
  L is I_Lattice implies equivalence_wrt F is_reflexive_in the carrier of L;

theorem 
  equivalence_wrt F is_symmetric_in the carrier of L;

theorem 
  L is I_Lattice implies equivalence_wrt F is_transitive_in the carrier of L;

theorem 
  L is I_Lattice implies equivalence_wrt F is Equivalence_Relation
  of the carrier of L;

theorem 
  L is I_Lattice implies field equivalence_wrt F = the carrier of L;

definition
  let I,FI;
  redefine func equivalence_wrt FI -> Equivalence_Relation of the carrier of I;
end;

definition
  let B,FB;
  redefine func equivalence_wrt FB -> Equivalence_Relation of the carrier of B;
end;

definition
  let L,F,p,q;
  pred p,q are_equivalence_wrt F means


  p <=> q in F;
end;

theorem 
  p,q are_equivalence_wrt F iff [p,q] in equivalence_wrt F;

theorem 
  i,i are_equivalence_wrt FI & a,a are_equivalence_wrt FB;

theorem 
  p,q are_equivalence_wrt F implies q,p are_equivalence_wrt F;

theorem 
  (i,j are_equivalence_wrt FI & j,k are_equivalence_wrt FI implies i,k
are_equivalence_wrt FI) & (a,b are_equivalence_wrt FB & b,c are_equivalence_wrt
  FB implies a,c are_equivalence_wrt FB);

begin 


theorem 
  for L being meet-absorbing meet-commutative meet-associative
join-absorbing join-commutative non empty LattStr for x,y,z being Element of
L st z [= x & z [= y & for z9 being Element of L st z9 [= x & z9 [= y holds z9
  [= z holds z = x "/\" y;

theorem 
  for L being meet-absorbing meet-commutative join-associative
join-absorbing join-commutative non empty LattStr for x,y,z being Element of
  L st x [= z & y [= z & for z9 being Element of L st x [= z9 & y [= z9 holds z
  [= z9 holds z = x "\/" y;














begin 

reserve A for set,
  C for non empty set,
  B for Subset of A,
  x for Element of A,
  f,g for Function of A,C;

theorem 
  dom (g|B) = B;

theorem 
  f|B = g|B iff for x st x in B holds g.x = f.x;

theorem 
  for B being set holds f +* g|B is Function of A,C;

theorem 
  g|B +* f = f;

theorem 
  for f,g being Function holds g c= f implies f +* g = f;

theorem 
  f +* f|B = f;

theorem 
  (for x st x in B holds g.x = f.x) implies f +* g|B = f;

reserve B for Finite_Subset of A;

theorem 
  g|B +* f = f;

theorem 
  dom (g|B) = B;

theorem 
  (for x st x in B holds g.x = f.x) implies f +* g|B = f;

definition
  let D be non empty set;
  let o,o9 be BinOp of D;
  pred o absorbs o9 means


  for x,y being Element of D holds o.(x,o9.(x,y )) = x;
end;

notation
  let D be non empty set;
  let o,o9 be BinOp of D;
  antonym o doesn't_absorb o9 for o absorbs o9;
end;



reserve L for non empty LattStr,
  a,b,c for Element of L;

theorem 
  the L_join of L is commutative associative & the L_meet of L is
commutative associative & the L_join of L absorbs the L_meet of L & the L_meet
  of L absorbs the L_join of L implies L is Lattice-like;

definition
  let L be LattStr;
  func L.: -> strict LattStr equals

  LattStr(#the carrier of L, the L_meet of L
    , the L_join of L#);
end;

registration
  let L be non empty LattStr;
  cluster L.: -> non empty;
end;

theorem 
  the carrier of L = the carrier of L.: & the L_join of L = the L_meet
  of L.: & the L_meet of L = the L_join of L.:;

theorem 
  for L being strict non empty LattStr holds L .: .: = L;



reserve L for Lattice;
reserve a,b,c,u,v for Element of L;

theorem 
  (for v holds u "\/" v = v) implies u = Bottom L;

theorem 
  (for v holds (the L_join of L).(u,v) = v) implies u = Bottom L;

theorem 
  (for v holds u "/\" v = v) implies u = Top L;

theorem 
  (for v holds (the L_meet of L).(u,v) = v) implies u = Top L;

registration
  let L;
  cluster the L_join of L -> idempotent;
end;

registration
  let L be join-commutative non empty \/-SemiLattStr;
  cluster the L_join of L -> commutative;
end;

theorem 
  the L_join of L is having_a_unity implies Bottom L =
  the_unity_wrt the L_join of L;

registration
  let L be join-associative non empty \/-SemiLattStr;
  cluster the L_join of L -> associative;
end;

registration
  let L;
  cluster the L_meet of L -> idempotent;
end;

registration
  let L be meet-commutative non empty /\-SemiLattStr;
  cluster the L_meet of L -> commutative;
end;

registration
  let L be meet-associative non empty /\-SemiLattStr;
  cluster the L_meet of L -> associative;
end;

theorem 
  the L_meet of L is having_a_unity implies Top L = the_unity_wrt
  the L_meet of L;

theorem 
  the L_join of L is_distributive_wrt the L_join of L;

theorem 
  L is D_Lattice implies the L_join of L is_distributive_wrt the L_meet of L;

theorem 
  the L_join of L is_distributive_wrt the L_meet of L implies L is distributive
;

theorem 
  L is D_Lattice implies the L_meet of L is_distributive_wrt the L_join of L;

theorem 
  the L_meet of L is_distributive_wrt the L_join of L implies L is distributive
;

theorem 
  the L_meet of L is_distributive_wrt the L_meet of L;

theorem 
  the L_join of L absorbs the L_meet of L;

theorem 
  the L_meet of L absorbs the L_join of L;

definition
  let A be non empty set, L be Lattice;
  let B be Finite_Subset of A;
  let f be Function of A, the carrier of L;
  func FinJoin(B, f) -> Element of L equals

  (the L_join of L)$$(B,f);
  func FinMeet(B, f) -> Element of L equals

  (the L_meet of L)$$(B,f);
end;

reserve A for non empty set,
  x for Element of A,
  B for Finite_Subset of A,
  f,g for Function of A, the carrier of L;

theorem 
  x in B implies f.x [= FinJoin(B,f);

theorem 
  (ex x st x in B & u [= f.x) implies u [= FinJoin(B,f);

theorem 
  (for x st x in B holds f.x = u) & B <> {} implies FinJoin(B,f) = u;

theorem 
  FinJoin(B,f) [= u implies for x st x in B holds f.x [= u;

theorem 
  B <> {} & (for x st x in B holds f.x [= u) implies FinJoin(B,f) [= u;

theorem 
  B <> {} & (for x st x in B holds f.x [= g.x) implies FinJoin(B,f) [=
  FinJoin(B,g);

theorem 
  B <> {} & f|B = g|B implies FinJoin(B,f) = FinJoin(B,g);

theorem 
  B <> {} implies v "\/" FinJoin(B,f) = FinJoin(B, (the L_join of L)[;](
  v, f ) );

registration
  let L be Lattice;
  cluster L.: -> Lattice-like;
end;

theorem 
  for L being Lattice, B being Finite_Subset of A for f being Function
  of A, the carrier of L, f9 being Function of A, the carrier of L.: st f = f9
  holds FinJoin(B,f) = FinMeet(B,f9) & FinMeet(B,f) = FinJoin(B,f9);

theorem 
  for a9,b9 being Element of L.: st a = a9 & b = b9 holds a "/\" b
  = a9"\/" b9 & a "\/" b = a9"/\" b9;

theorem 
  a [= b implies for a9,b9 being Element of L.: st a = a9 & b = b9
  holds b9 [= a9;

theorem 
  for a9,b9 being Element of L.: st a9 [= b9 & a = a9 & b = b9 holds b [= a;



theorem 
  x in B implies FinMeet(B,f) [= f.x;

theorem 
  (ex x st x in B & f.x [= u) implies FinMeet(B,f)[= u;

theorem 
  (for x st x in B holds f.x = u) & B <> {} implies FinMeet(B,f) = u;

theorem 
  B <> {} implies v "/\" FinMeet(B,f) = FinMeet(B, (the L_meet of L)[;](
  v, f ) );

theorem 
  u [= FinMeet(B,f) implies for x st x in B holds u [= f.x;

theorem 
  B <> {} & f|B = g|B implies FinMeet(B,f) = FinMeet(B,g);

theorem 
  B <> {} & (for x st x in B holds u [= f.x) implies u [= FinMeet( B,f);

theorem 
  B <> {} & (for x st x in B holds f.x [= g.x) implies FinMeet(B,f) [=
  FinMeet(B,g);

theorem 
  for L being Lattice holds L is lower-bounded iff L.: is upper-bounded;

theorem 
  for L being Lattice holds L is upper-bounded iff L.: is lower-bounded;

theorem 
  L is D_Lattice iff L.: is D_Lattice;





reserve L for 0_Lattice,
  f,g for Function of A, the carrier of L,
  u for Element of L;

theorem 
  Bottom L is_a_unity_wrt the L_join of L;

registration
  let L;
  cluster the L_join of L -> having_a_unity;
end;

theorem 
  Bottom L = the_unity_wrt the L_join of L;

theorem 
  f|B = g|B implies FinJoin(B,f) = FinJoin(B,g);

theorem 
  (for x st x in B holds f.x [= u) implies FinJoin(B,f) [= u;

theorem 
  (for x st x in B holds f.x [= g.x) implies FinJoin(B,f) [= FinJoin(B,g );





reserve L for 1_Lattice,
  f,g for Function of A, the carrier of L,
  u for Element of L;

theorem 
  Top L is_a_unity_wrt the L_meet of L;

registration
  let L;
  cluster the L_meet of L -> having_a_unity;
end;

theorem 
  Top L = the_unity_wrt the L_meet of L;

theorem 
  f|B = g|B implies FinMeet(B,f) = FinMeet(B,g);

theorem 
  (for x st x in B holds u [= f.x) implies u [= FinMeet(B,f);

theorem 
  (for x st x in B holds f.x [= g.x) implies FinMeet(B,f) [= FinMeet(B,g );

theorem 
  for L being 0_Lattice holds Bottom L = Top (L.:);

theorem 
  for L being 1_Lattice holds Top L = Bottom (L.:);





definition
  mode D0_Lattice is distributive lower-bounded Lattice;
end;

reserve L for D0_Lattice,
  f,g for (Function of A, the carrier of L),
  u for Element of L;

theorem 
  the L_meet of L is_distributive_wrt the L_join of L;

theorem 
  (the L_meet of L).(u, FinJoin(B, f)) = FinJoin(B, (the L_meet of L)[;](u,f));

theorem 
  (for x st x in B holds g.x = u "/\" f.x) implies u "/\" FinJoin(B,f) =
  FinJoin(B,g);

theorem 
  u "/\" FinJoin(B,f) = FinJoin(B, (the L_meet of L)[;](u, f));



definition
  let IT be Lattice;

  attr IT is Heyting means


  IT is implicative lower-bounded;
end;

registration
  cluster Heyting for Lattice;
end;

registration
  cluster Heyting -> implicative lower-bounded for Lattice;
  cluster implicative lower-bounded -> Heyting for Lattice;
end;

definition
  mode H_Lattice is Heyting Lattice;
end;

registration
  cluster Heyting strict for Lattice;
end;

theorem 
  for L being 0_Lattice holds L is H_Lattice iff for x,z being Element
  of L ex y being Element of L st x "/\" y [= z & for v being Element of L st x
  "/\" v [= z holds v [= y;

theorem 
  for L being Lattice holds L is finite iff L.: is finite;

registration
  cluster finite -> lower-bounded for Lattice;
  cluster finite -> upper-bounded for Lattice;
end;

registration
  cluster finite -> bounded for Lattice;
end;

registration
  cluster distributive finite -> Heyting for Lattice;
end;














begin 

definition
  struct (1-sorted) ComplStr (# carrier -> set, Compl -> UnOp of the carrier
  #);
end;

definition
  struct(\/-SemiLattStr, ComplStr) ComplLLattStr (# carrier -> set, L_join ->
    BinOp of the carrier, Compl -> UnOp of the carrier #);
end;

definition
  struct(/\-SemiLattStr, ComplStr) ComplULattStr (# carrier -> set, L_meet ->
    BinOp of the carrier, Compl -> UnOp of the carrier #);
end;

definition
  struct (ComplLLattStr, LattStr) OrthoLattStr (# carrier -> set, L_join,
    L_meet -> BinOp of the carrier, Compl -> UnOp of the carrier #);
end;

definition
  func TrivComplLat -> strict ComplLLattStr equals

  ComplLLattStr (# 1, op2, op1 #);
end;

definition
  func TrivOrtLat -> strict OrthoLattStr equals

  OrthoLattStr (# 1, op2, op2, op1 #);
end;

registration
  cluster TrivComplLat -> 1-element;
  cluster TrivOrtLat -> 1-element;
end;

registration
  cluster strict 1-element for OrthoLattStr;
  cluster strict 1-element for ComplLLattStr;
end;

registration
  let L be 1-element ComplLLattStr;
  cluster the ComplStr of L -> 1-element;
end;

registration
  cluster strict 1-element for ComplStr;
end;

definition
  let L be non empty ComplStr;
  let x be Element of L;
  func x` -> Element of L equals

  (the Compl of L).x;
end;

notation
  let L be non empty ComplLLattStr, x,y be Element of L;
  synonym x + y for x "\/" y;
end;

definition
  let L be non empty ComplLLattStr;
  let x,y be Element of L;
  func x *' y -> Element of L equals

  (x` "\/" y`)`;
end;

definition
  let L be non empty ComplLLattStr;
  attr L is Robbins means


  for x, y being Element of L holds ((x + y)` + (x + y`)`)` = x;
  attr L is Huntington means


  for x, y being Element of L holds (x` + y` )` + (x` + y)` = x;
end;

definition
  let G be non empty \/-SemiLattStr;
  attr G is join-idempotent means


  for x being Element of G holds x "\/" x = x;
end;

registration
  cluster TrivComplLat -> join-commutative join-associative Robbins Huntington
    join-idempotent;
  cluster TrivOrtLat -> join-commutative join-associative Huntington Robbins;
end;

registration
  cluster TrivOrtLat -> meet-commutative meet-associative meet-absorbing
    join-absorbing;
end;

registration
  cluster strict join-associative join-commutative Robbins join-idempotent
    Huntington for non empty ComplLLattStr;
end;

registration
  cluster strict Lattice-like Robbins Huntington for non empty OrthoLattStr;
end;

definition
  let L be join-commutative non empty ComplLLattStr, x,y be Element of L;
  redefine func x + y;
  commutativity;
end;

theorem 
  for L being Huntington join-commutative join-associative non
empty ComplLLattStr, a, b being Element of L holds (a *' b) + (a *' b`) = a;

theorem 
  for L being Huntington join-commutative join-associative non
  empty ComplLLattStr, a being Element of L holds a + a` = a` + a``;

theorem 
  for L being join-commutative join-associative Huntington non
  empty ComplLLattStr, x being Element of L holds x`` = x;

theorem 
  for L being join-commutative join-associative Huntington non
  empty ComplLLattStr, a, b being Element of L holds a + a` = b + b`;

theorem 
  for L being join-commutative join-associative join-idempotent
  Huntington non empty ComplLLattStr ex c being Element of L st for a being
  Element of L holds c + a = c & a + a` = c;

theorem 
  for L being join-commutative join-associative join-idempotent
  Huntington non empty ComplLLattStr holds L is upper-bounded;

registration
  cluster join-commutative join-associative join-idempotent Huntington ->
    upper-bounded for non empty ComplLLattStr;
end;

definition
  let L be join-commutative join-associative join-idempotent Huntington non
  empty ComplLLattStr;
  redefine func Top L means


  ex a being Element of L st it = a + a`;
end;

theorem 
  for L being join-commutative join-associative join-idempotent
  Huntington non empty ComplLLattStr ex c being Element of L st for a being
  Element of L holds c *' a = c & (a + a`)` = c;

definition
  let L be join-commutative join-associative non empty ComplLLattStr;
  let x,y be Element of L;
  redefine func x *' y;
  commutativity;
end;

definition
  let L be join-commutative join-associative join-idempotent Huntington non
  empty ComplLLattStr;
  func Bot L -> Element of L means


  for a being Element of L holds it *' a = it;
end;

theorem 
  for L being join-commutative join-associative join-idempotent
Huntington non empty ComplLLattStr, a being Element of L
 holds Bot L = (a + a`)`;

theorem 
  for L being join-commutative join-associative join-idempotent
  Huntington non empty ComplLLattStr
   holds (Top L)` = Bot L & Top L = (Bot L)`;

theorem 
  for L being join-commutative join-associative Huntington non
  empty ComplLLattStr, a, b being Element of L st a` = b` holds a = b;

theorem 
  for L being join-commutative join-associative Huntington non
  empty ComplLLattStr, a, b being Element of L holds a + (b + b`)` = a;

theorem 
  for L being join-commutative join-associative Huntington non
  empty ComplLLattStr, a being Element of L holds a + a = a;

registration
  cluster join-commutative join-associative Huntington -> join-idempotent for
non
    empty ComplLLattStr;
end;

theorem 
  for L being join-commutative join-associative Huntington non
  empty ComplLLattStr, a being Element of L holds a + Bot L = a;

theorem 
  for L being join-commutative join-associative Huntington non empty
  ComplLLattStr, a being Element of L holds a *' Top L = a;

theorem 
  for L being join-commutative join-associative Huntington non
  empty ComplLLattStr, a being Element of L holds a *' a` = Bot L;

theorem 
  for L being join-commutative join-associative Huntington non
empty ComplLLattStr, a, b, c being Element of L
 holds a *' (b *' c) = a *' b *' c;

theorem 
  for L being join-commutative join-associative Huntington non
  empty ComplLLattStr, a, b being Element of L holds a + b = (a` *' b`)`;

theorem 
  for L being join-commutative join-associative Huntington non empty
  ComplLLattStr, a being Element of L holds a *' a = a;

theorem 
  for L being join-commutative join-associative Huntington non empty
  ComplLLattStr, a being Element of L holds a + Top L = Top L;

theorem 
  for L being join-commutative join-associative Huntington non
  empty ComplLLattStr, a, b being Element of L holds a + (a *' b) = a;

theorem 
  for L being join-commutative join-associative Huntington non
  empty ComplLLattStr, a, b being Element of L holds a *' (a + b) = a;

theorem 
  for L being join-commutative join-associative Huntington non
empty ComplLLattStr, a, b being Element of L
   st a` + b = Top L & b` + a = Top L
  holds a = b;

theorem 
  for L being join-commutative join-associative Huntington non
empty ComplLLattStr, a, b being Element of L st a + b = Top L & a *' b = Bot L
  holds a` = b;

theorem 
  for L being join-commutative join-associative Huntington non
  empty ComplLLattStr, a, b, c being Element of L
   holds (a *' b *' c) + (a *' b
*' c`) + (a *' b` *' c) + (a *' b` *' c`) + (a` *' b *' c) + (a` *' b *' c`) +
  (a` *' b` *' c) + (a` *' b` *' c`) = Top L;

theorem 
  for L being join-commutative join-associative Huntington non
  empty ComplLLattStr, a, b, c being Element of L
   holds (a *' c) *' (b *' c`) =
Bot L & (a *' b *' c) *' (a` *' b *' c) = Bot L & (a *' b` *' c) *' (a` *' b *'
  c) = Bot L & (a *' b *' c) *' (a` *' b` *' c) = Bot L & (a *' b *' c`) *' (a`
  *' b` *' c`) = Bot L;

theorem 
  for L being join-commutative join-associative Huntington non
empty ComplLLattStr, a, b, c being Element of L holds (a *' b) + (a *' c) = (a
  *' b *' c) + (a *' b *' c`) + (a *' b` *' c);

theorem 
  for L being join-commutative join-associative Huntington non
empty ComplLLattStr, a, b, c being Element of L
 holds (a *' (b + c))` = (a *' b
` *' c`) + (a` *' b *' c) + (a` *' b *' c`) + (a` *' b` *' c) + (a` *' b` *' c`
  );

theorem 
  for L being join-commutative join-associative Huntington non
empty ComplLLattStr, a, b, c being Element of L
 holds ((a *' b) + (a *' c)) + (a *' (b + c))` = Top L;

theorem 
  for L being join-commutative join-associative Huntington non
empty ComplLLattStr, a, b, c being Element of L holds ((a *' b) + (a *' c)) *'
  (a *' (b + c))` = Bot L;

theorem 
  for L being join-commutative join-associative Huntington non
empty ComplLLattStr, a, b, c being Element of L
 holds a *' (b + c) = (a *' b) + (a *' c);

theorem 
  for L being join-commutative join-associative Huntington non empty
ComplLLattStr, a, b, c being Element of L holds a + (b *' c) = (a + b) *' (a +
  c);

begin 

definition
  let L be non empty OrthoLattStr;
  attr L is well-complemented means


  for a being Element of L holds a` is_a_complement_of a;
end;

registration
  cluster TrivOrtLat -> Boolean well-complemented;
end;

definition
  mode preOrthoLattice is Lattice-like non empty OrthoLattStr;
end;

registration
  cluster strict Boolean well-complemented for preOrthoLattice;
end;

theorem 
  for L being distributive well-complemented preOrthoLattice, x
  being Element of L holds x`` = x;

theorem 
  for L being bounded distributive well-complemented
  preOrthoLattice, x, y being Element of L holds x "/\" y = (x` "\/" y`)`;

begin 


definition
  let L be non empty ComplLLattStr;
  func CLatt L -> strict OrthoLattStr means


  the carrier of it = the
carrier of L & the L_join of it = the L_join of L & the Compl of it = the Compl
  of L & for a, b being Element of L holds (the L_meet of it).(a,b) = a *' b;
end;

registration
  let L be non empty ComplLLattStr;
  cluster CLatt L -> non empty;
end;

registration
  let L be join-commutative non empty ComplLLattStr;
  cluster CLatt L -> join-commutative;
end;

registration
  let L be join-associative non empty ComplLLattStr;
  cluster CLatt L -> join-associative;
end;

registration
  let L be join-commutative join-associative non empty ComplLLattStr;
  cluster CLatt L -> meet-commutative;
end;

theorem 
  for L being non empty ComplLLattStr, a, b being Element of L, a9, b9
being Element of CLatt L st a = a9 & b = b9 holds a *' b = a9 "/\" b9 & a + b =
  a9 "\/" b9 & a` = a9`;

registration
  let L be join-commutative join-associative Huntington non empty
  ComplLLattStr;
  cluster CLatt L -> meet-associative join-absorbing meet-absorbing;
end;

registration
  let L be Huntington non empty ComplLLattStr;
  cluster CLatt L -> Huntington;
end;

registration
  let L be join-commutative join-associative Huntington non empty
  ComplLLattStr;
  cluster CLatt L -> lower-bounded;
end;

theorem 
  for L being join-commutative join-associative Huntington non
  empty ComplLLattStr holds Bot L = Bottom CLatt L;

registration
  let L be join-commutative join-associative Huntington non empty
  ComplLLattStr;
  cluster CLatt L -> complemented distributive bounded;
end;

begin 

notation
  let G be non empty ComplLLattStr, x be Element of G;
  synonym -x for x`;
end;

definition
  let G be join-commutative non empty ComplLLattStr;
  redefine attr G is Huntington means


  for x, y being Element of G holds -(-x + -y) + -(x + -y) = y;
end;

definition
  let G be non empty ComplLLattStr;
  attr G is with_idempotent_element means


  ex x being Element of G st x + x = x;
end;

reserve G for Robbins join-associative join-commutative non empty
  ComplLLattStr;
reserve x, y, z, u, v for Element of G;

definition
  let G be non empty ComplLLattStr, x, y be Element of G;
  func \delta (x, y) -> Element of G equals

  -(-x + y);
end;

definition
  let G be non empty ComplLLattStr, x, y be Element of G;
  func Expand (x, y) -> Element of G equals

  \delta (x + y, \delta(x, y));
end;

definition
  let G be non empty ComplLLattStr, x be Element of G;
  func x _0 -> Element of G equals

  -(-x + x);
  func Double x -> Element of G equals

  x + x;
end;

definition
  let G be non empty ComplLLattStr, x be Element of G;
  func x _1 -> Element of G equals

  x _0 + x;
  func x _2 -> Element of G equals

  x _0 + Double x;
  func x _3 -> Element of G equals

  x _0 + (Double x + x);
  func x _4 -> Element of G equals

  x _0 + (Double x + Double x);
end;

theorem 
  \delta ((x + y), (\delta (x, y))) = y;

theorem 
  Expand (x, y) = y;

theorem 
  \delta (-x + y, z) = -(\delta (x, y) + z);

theorem 
  \delta (x, x) = x _0;

theorem 
  \delta (Double x, x _0) = x;

theorem 
  \delta (x _2, x) = x _0;

theorem 
  x _4 + x _0 = x _3 + x _1;

theorem 
  x _3 + x _0 = x _2 + x _1;

theorem 
  x _3 + x = x _4;

theorem 
  \delta (x _3, x _0) = x;

theorem 
  -x = -y implies \delta (x, z) = \delta (y,z);

theorem 
  \delta (x, -y) = \delta (y, -x);

theorem 
  \delta (x _3, x) = x _0;

theorem 
  \delta (x _1 + x _3, x) = x _0;

theorem 
  \delta (x _1 + x _2, x) = x _0;

theorem 
  \delta (x _1 + x _3, x _0) = x;

definition
  let G, x;
  func \beta x -> Element of G equals

  -(x _1 + x _3) + x + -(x _3);
end;

theorem 
  \delta (\beta x, x) = -x _3;

theorem 
  \delta (\beta x, x) = -(x _1 + x _3);

theorem 
  ex y, z st -(y + z) = -z;

begin 

theorem 
  (for z holds --z = z) implies G is Huntington;

theorem 
  G is with_idempotent_element implies G is Huntington;

registration
  cluster TrivComplLat -> with_idempotent_element;
end;

registration
  cluster with_idempotent_element -> Huntington for Robbins join-associative
    join-commutative non empty ComplLLattStr;
end;

theorem 
  (ex c, d being Element of G st c + d = c) implies G is Huntington;

theorem 
  ex y, z st y + z = z;

registration
  cluster Robbins -> Huntington for
join-associative join-commutative non empty
    ComplLLattStr;
end;

definition
  let L be non empty OrthoLattStr;
  attr L is de_Morgan means


  for x, y being Element of L holds x "/\" y = (x` "\/" y`)`;
end;

registration
  let L be non empty ComplLLattStr;
  cluster CLatt L -> de_Morgan;
end;

theorem 
  for L being well-complemented join-commutative meet-commutative
non empty OrthoLattStr, x being Element of L holds x + x` = Top L & x "/\" x`
  = Bottom L;

theorem 
  for L being bounded distributive well-complemented
  preOrthoLattice holds (Top L)` = Bottom L;

registration
  cluster TrivOrtLat -> de_Morgan;
end;

registration
  cluster strict de_Morgan Boolean Robbins Huntington for preOrthoLattice;
end;

registration
  cluster join-associative join-commutative de_Morgan -> meet-commutative for
non
    empty OrthoLattStr;
end;

theorem 
  for L being Huntington de_Morgan preOrthoLattice holds Bot L = Bottom L;

registration
  cluster Boolean -> Huntington for well-complemented preOrthoLattice;
end;

registration
  cluster Huntington -> Boolean for de_Morgan preOrthoLattice;
end;

registration
  cluster Robbins de_Morgan -> Boolean for preOrthoLattice;
  cluster Boolean -> Robbins for well-complemented preOrthoLattice;
end;














begin

reserve X1,x,y,z for set,
  n,m for Element of NAT,
  X for non empty set;
reserve A,B for Event of Borel_Sets,
  D for Subset of REAL;

definition let X;
  let S be SigmaField of X;
  func Probabilities(S) -> set means


  x in it iff x is Probability of S;
end;

registration let X;
  let S be SigmaField of X;
  cluster Probabilities(S) -> non empty;
end;

definition
  struct QM_Str (# Observables, FStates -> non empty set,
     Quantum_Probability -> Function of [:the Observables, the FStates:],
       Probabilities(Borel_Sets) #);
end;

reserve Q for QM_Str;

definition let Q;
  func Obs Q -> set equals

  the Observables of Q;
  func Sts Q -> set equals

  the FStates of Q;
end;

registration let Q;
  cluster Obs Q -> non empty;
  cluster Sts Q -> non empty;
end;

reserve A1 for Element of Obs Q;
reserve s for Element of Sts Q;
reserve E for Event of Borel_Sets;
reserve ASeq for SetSequence of Borel_Sets;

definition let Q,A1,s;
  func Meas(A1,s) -> Probability of Borel_Sets equals

  (the Quantum_Probability of Q).[A1,s];
end;

definition let IT be QM_Str;
  attr IT is Quantum_Mechanics-like means


  (for A1,A2 being Element of Obs IT st
  for s being Element of Sts IT holds Meas(A1,s)=Meas(A2,s) holds A1=A2) &
  (for s1,s2 being Element of Sts IT st for A being Element of Obs IT holds
  Meas(A,s1)=Meas(A,s2) holds s1=s2) &
  for s1,s2 being Element of Sts IT, t being Real st 0<=t & t<=1
  ex s being Element of Sts IT st for A being Element of Obs IT, E holds
  Meas(A,s).E=t*(Meas(A,s1).E) + ((1-t)*Meas(A,s2).E);
end;

registration
  cluster strict Quantum_Mechanics-like for QM_Str;
end;

definition
  mode Quantum_Mechanics is Quantum_Mechanics-like QM_Str;
end;

reserve Q for Quantum_Mechanics;
reserve s for Element of Sts Q;

definition
  struct(RelStr,ComplStr) OrthoRelStr(# carrier -> set,
  InternalRel -> (Relation of the carrier),
  Compl -> Function of the carrier,the carrier #);
end;

reserve x1 for Element of X1;
reserve Inv for Function of X1,X1;

definition let X1, Inv;
  pred Inv is_an_involution means

  Inv.(Inv.x1) = x1;
end;

definition let W be OrthoRelStr;
  pred W is_a_Quantum_Logic means


  the InternalRel of W partially_orders the carrier of W &
  the Compl of W is_an_involution &
  for x,y being Element of W st
  [x,y] in the InternalRel of W holds
  [(the Compl of W).y,(the Compl of W).x] in the InternalRel of W;
end;

definition let Q;
  func Prop Q -> set equals

  [:Obs Q,Borel_Sets:];
end;

registration let Q;
  cluster Prop Q -> non empty;
end;

reserve p,q,r,p1,q1 for Element of Prop Q;

definition let Q,p;
  redefine func p`1 -> Element of Obs Q;
  redefine func p`2 -> Event of Borel_Sets;
end;

theorem 
  for E st E = p`2` holds Meas(p`1,s).p`2 = 1 - Meas(p`1,s).E;

definition let Q,p;
  func 'not' p -> Element of Prop Q equals

  [p`1,(p`2)`];
  involutiveness;
end;

definition let Q,p,q;
  pred p |- q means


  for s holds Meas(p`1,s).p`2 <= Meas(q`1,s).q`2;
  reflexivity;
end;

definition let Q,p,q;
  pred p <==> q means


  p |- q & q |- p;
  reflexivity;
  symmetry;
end;

theorem 
  p <==> q iff for s holds Meas(p`1,s).p`2 = Meas(q`1,s).q`2;

theorem 
  p |- p;

theorem 
  p |- q & q |- r implies p |- r;

theorem 
  p <==> p;

theorem 
  p <==> q implies q <==> p;

theorem 
  p <==> q & q <==> r implies p <==> r;

canceled;

theorem 
  p |- q implies 'not' q |- 'not' p;

definition let Q;
  func PropRel Q -> Equivalence_Relation of Prop Q means


  [p,q] in it iff p <==> q;
end;

reserve B,C for Subset of Prop Q;

theorem 
  for B,C st B in Class PropRel Q & C in Class PropRel Q for a,b,c
  ,d being Element of Prop Q holds a in B & b in B & c in C & d in C & a |- c
  implies b |- d;

definition let Q;
  func OrdRel Q -> Relation of Class PropRel (Q) means


  [B,C] in it iff B in Class PropRel Q & C in Class PropRel Q &
  for p,q st p in B & q in C holds p |- q;
end;

theorem 
  p |- q iff [Class(PropRel Q,p),Class(PropRel Q,q)] in OrdRel Q;

theorem 
  for B,C st B in Class PropRel Q & C in Class PropRel Q for p1,q1
  holds p1 in B & q1 in B & 'not' p1 in C implies 'not' q1 in C;

theorem 
  for B,C st B in Class PropRel Q & C in Class PropRel Q for p,q holds
  'not' p in C & 'not' q in C & p in B implies q in B;

definition let Q;
  func InvRel Q -> Function of Class PropRel Q,Class PropRel Q means


  it.Class(PropRel Q,p) = Class(PropRel Q,'not' p);
end;

theorem 
  for Q holds OrthoRelStr(#Class PropRel Q,OrdRel Q,InvRel Q#)
  is_a_Quantum_Logic;














begin

reserve F for Field;

theorem 
  MPS(F) is ParSp;

reserve a,b,c,d,p,q,r for Element of MPS(F);
reserve e,f,g,h,i,j,k,l,m,n,o,w for Element of [:the carrier of F,the carrier
  of F,the carrier of F:];
reserve K,L,M,N,R,S for Element of F;

theorem 
  a,b '||' c,d iff ex e,f,g,h st [a,b,c,d] = [e,f,g,h] & ((ex K st
K*(e`1_3-f`1_3) = g`1_3-h`1_3 & K*(e`2_3-f`2_3) = g`2_3-h`2_3 &
  K*(e`3_3-f`3_3) = g`3_3-h`3_3) or e`1_3-f
  `1_3 = 0.F & e`2_3-f`2_3 = 0.F & e`3_3-f`3_3 = 0.F );

theorem 
  not a,b '||' a,c & [a,b,a,c]=[e,f,e,g] implies e<>f & e<>g & f<>g;

theorem 
  not a,b '||' a,c & [a,b,a,c] = [e,f,e,g] & K*(e`1_3-f`1_3)=L*(e`1_3-g`1_3
  ) & K*(e`2_3-f`2_3)=L*(e`2_3-g`2_3) & K*(e`3_3-f`3_3)=L*(e`3_3-g`3_3)
  implies K=0.F & L=0.F;

theorem 
  not a,b '||' a,c & a,b '||' c,d & a,c '||' b,d & [a,b,c,d] = [e,f
  ,g,h] implies h`1_3=f`1_3+g`1_3-e`1_3 & h`2_3=f`2_3+g`2_3-e`2_3 &
 h`3_3=f`3_3+g`3_3-e`3_3;

theorem 
  ex a,b,c st not a,b '||' a,c;

theorem 
  1_F+1_F<>0.F & b,c '||' a,d & a,b '||' c,d & a,c '||' b,d implies
  a,b '||' a,c;

theorem 
  not a,p '||' a,b & not a,p '||' a,c & a,p '||' b,q & a,p '||' c,r
  & a,b '||' p,q & a,c '||' p,r implies b,c '||' q,r;



definition
  let IT be ParSp;
  attr IT is FanodesSp-like means


  (ex a,b,c being Element of IT st not
a,b '||' a,c) & (for a,b,c,d being Element of IT holds b,c '||' a,d & a,b '||'
c,d & a,c '||' b,d implies a,b '||' a,c) & for a,b,c,p,q,r being Element of IT
  holds not a,p '||' a,b & not a,p '||' a,c & a,p '||' b,q & a,p '||' c,r & a,b
  '||' p,q & a,c '||' p,r implies b,c '||' q,r;
end;

registration
  cluster strict FanodesSp-like for ParSp;
end;

definition
  mode FanodesSp is FanodesSp-like ParSp;
end;

reserve FdSp for FanodesSp;
reserve a,b,c,d,p,q,r,s,o,x,y for Element of FdSp;



theorem 
  p<>q implies ex r st not p,q '||' p,r;

definition
  let FdSp,a,b,c;
  pred a,b,c is_collinear means


  a,b '||' a,c;
end;

theorem 
  a,b,c is_collinear implies a,c,b is_collinear & c,b,a
  is_collinear & b,a,c is_collinear & b,c,a is_collinear & c,a,b is_collinear;

theorem 
  not a,b,c is_collinear & a,b '||' p,q & a,c '||' p,r & p<>q & p
  <>r implies not p,q,r is_collinear;

theorem 
  a=b or b=c or c =a implies a,b,c is_collinear;

theorem 
  a<>b & a,b,p is_collinear & a,b,q is_collinear & a,b,r
  is_collinear implies p,q,r is_collinear;

theorem 
  p<>q implies ex r st not p,q,r is_collinear;

theorem 
  a,b,c is_collinear & a,b,d is_collinear implies a,b '||' c,d;

theorem 
  not a,b,c is_collinear & a,b '||' c,d implies not a,b,d is_collinear;

theorem 
  not a,b,c is_collinear & a,b '||' c,d & c <>d implies not a,b,x
  is_collinear or not c,d,x is_collinear;

theorem 
  not o,a,b is_collinear implies not o,a,x is_collinear or not o,b,x
  is_collinear or o=x;

theorem 
  o<>a & o<>b & o,a,b is_collinear & o,a,p is_collinear & o,b,q
  is_collinear implies a,b '||' p,q;

theorem 
  not a,b '||' c,d & a,b,p is_collinear & a,b,q is_collinear & c,d,p
  is_collinear & c,d,q is_collinear implies p=q;

theorem 
  a<>b & a,b,c is_collinear & a,b '||' c,d implies a,c '||' b,d;

theorem 
  a<>b & a,b,c is_collinear & a,b '||' c,d implies c,b '||' c,d;

theorem 
  not o,a,c is_collinear & o,a,b is_collinear & o,c,p is_collinear & o,c
  ,q is_collinear & a,c '||' b,p & a,c '||' b,q implies p=q;

theorem 
  a<>b & a,b,c is_collinear & a,b,d is_collinear implies a,c,d is_collinear;

theorem 
  a,b,c is_collinear & a,c,d is_collinear & a<>c implies b,c,d is_collinear;

definition
  let FdSp,a,b,c,d;
  pred parallelogram a,b,c,d means


  not a,b,c is_collinear & a,b '||' c, d & a,c '||' b,d;
end;

theorem 
  parallelogram a,b,c,d implies a<>b & b<>c & c <>a & a<>d & b<>d & c <>d;

theorem 
  parallelogram a,b,c,d implies not a,b,c is_collinear & not b,a,d
  is_collinear & not c,d,a is_collinear & not d,c,b is_collinear;

theorem 
  parallelogram a,b,c,d implies not a,b,c is_collinear & not b,a,d
  is_collinear & not c,d,a is_collinear & not d,c,b is_collinear & not a,c,b
  is_collinear & not b,a,c is_collinear & not b,c,a is_collinear & not c,a,b
  is_collinear & not c,b,a is_collinear & not b,d,a is_collinear & not a,b,d
  is_collinear & not a,d,b is_collinear & not d,a,b is_collinear & not d,b,a
  is_collinear & not c,a,d is_collinear & not a,c,d is_collinear & not a,d,c
  is_collinear & not d,a,c is_collinear & not d,c,a is_collinear & not d,b,c
  is_collinear & not b,c,d is_collinear & not b,d,c is_collinear & not c,b,d
  is_collinear & not c,d,b is_collinear;

theorem 
  parallelogram a,b,c,d implies not a,b,x is_collinear or not c,d,
  x is_collinear;

theorem 
  parallelogram a,b,c,d implies parallelogram a,c,b,d;

theorem 
  parallelogram a,b,c,d implies parallelogram c,d,a,b;

theorem 
  parallelogram a,b,c,d implies parallelogram b,a,d,c;

theorem 
  parallelogram a,b,c,d implies parallelogram a,c,b,d &
  parallelogram c,d,a,b & parallelogram b,a,d,c & parallelogram c,a,d,b &
  parallelogram d,b,c,a & parallelogram b,d,a,c & parallelogram d,c,b,a;

theorem 
  not a,b,c is_collinear implies ex d st parallelogram a,b,c,d;

theorem 
  parallelogram a,b,c,p & parallelogram a,b,c,q implies p=q;

theorem 
  parallelogram a,b,c,d implies not a,d '||' b,c;

theorem 
  parallelogram a,b,c,d implies not parallelogram a,b,d,c;

theorem 
  a<>b implies ex c st a,b,c is_collinear & c <>a & c <>b;

theorem 
  parallelogram a,p,b,q & parallelogram a,p,c,r implies b,c '||' q ,r;

theorem 
  not b,q,c is_collinear & parallelogram a,p,b,q & parallelogram a
  ,p,c,r implies parallelogram b,q,c,r;

theorem 
  a,b,c is_collinear & b<>c & parallelogram a,p,b,q &
  parallelogram a,p,c,r implies parallelogram b,q,c,r;

theorem 
  parallelogram a,p,b,q & parallelogram a,p,c,r & parallelogram b,
  q,d,s implies c,d '||' r,s;

theorem 
  a<>b implies ex c,d st parallelogram a,b,c,d;

theorem 
  a<>d implies ex b,c st parallelogram a,b,c,d;

definition
  let FdSp,a,b,r,s;
  pred a,b congr r,s means


  a=b & r=s or ex p,q st parallelogram p,q,a,b & parallelogram p,q,r,s;
end;

theorem 
  a,a congr b,c implies b=c;

theorem 
  a,b congr c,c implies a=b;

theorem 
  a,b congr b,a implies a=b;

theorem 
  a,b congr c,d implies a,b '||' c,d;

theorem 
  a,b congr c,d implies a,c '||' b,d;

theorem 
  a,b congr c,d & not a,b,c is_collinear implies parallelogram a,b ,c,d;

theorem 
  parallelogram a,b,c,d implies a,b congr c,d;

theorem 
  a,b congr c,d & a,b,c is_collinear & parallelogram r,s,a,b
  implies parallelogram r,s,c,d;

theorem 
  a,b congr c,x & a,b congr c,y implies x=y;

theorem 
  ex d st a,b congr c,d;

theorem 
  a,b congr a,b;

theorem 
  r,s congr a,b & r,s congr c,d implies a,b congr c,d;

theorem 
  a,b congr c,d implies c,d congr a,b;

theorem 
  a,b congr c,d implies b,a congr d,c;














begin

reserve x,y,y1,y2 for set,
  p for FinSequence,
  i,k,l,n for Element of NAT,
  V for RealLinearSpace,
  u,v,v1,v2,v3,w for VECTOR of V,
  a,b for Real,
  F,G,H1,H2 for FinSequence of V,
  A,B for Subset of V,
  f for Function of the carrier of V, REAL;

definition
  let S be 1-sorted;
  let x;
  assume
 x in S;
  func vector(S,x) -> Element of S equals


  x;
end;

theorem 
  for S being non empty 1-sorted,v being Element of S holds vector(S,v) = v;

theorem 
  for V being Abelian add-associative right_zeroed
  right_complementable non empty addLoopStr, F,G,H being FinSequence of the
carrier of V st len F = len G & len F = len H & for k st k in dom F holds H.k =
  F/.k + G/.k holds Sum(H) = Sum(F) + Sum(G);

theorem 
  len F = len G & (for k st k in dom F holds G.k = a * F/.k) implies Sum
  (G) = a * Sum(F);

theorem 
  for V being Abelian add-associative right_zeroed
  right_complementable non empty addLoopStr, F,G being FinSequence of the
carrier of V st len F = len G & (for k st k in dom F holds G.k = - F/.k) holds
  Sum(G) = - Sum(F);

theorem 
  for V being Abelian add-associative right_zeroed right_complementable
non empty addLoopStr, F,G,H being FinSequence of the carrier of V st len F =
len G & len F = len H & (for k st k in dom F holds H.k = F/.k - G/.k) holds Sum
  (H) = Sum(F) - Sum(G);

theorem 
  for V being Abelian add-associative right_zeroed
  right_complementable non empty addLoopStr, F,G being FinSequence of the
carrier of V for f being Permutation of dom F st len F = len G & (for i st i in
  dom G holds G.i = F.(f.i)) holds Sum(F) = Sum(G);

theorem 
  for V being Abelian add-associative right_zeroed right_complementable
  non empty addLoopStr, F,G being FinSequence of the carrier of V for f being
  Permutation of dom F st G = F * f holds Sum(F) = Sum(G);

definition
  let V be non empty addLoopStr, T be finite Subset of V;
  assume
 V is Abelian add-associative right_zeroed;

  func Sum(T) -> Element of V means


  ex F be FinSequence of the carrier of V st rng F = T & F is one-to-one &
  it = Sum(F);
end;

theorem 
  for V be Abelian add-associative right_zeroed non empty
  addLoopStr holds Sum({}V) = 0.V;

theorem 
  for V be Abelian add-associative right_zeroed right_complementable
  non empty addLoopStr, v be Element of V holds Sum{v} = v;

theorem 
  for V be Abelian add-associative right_zeroed right_complementable
non empty addLoopStr, v1,v2 be Element of V holds v1 <> v2 implies Sum{v1,v2}
  = v1 + v2;

theorem 
  for V be Abelian add-associative right_zeroed right_complementable
non empty addLoopStr, v1,v2,v3 be Element of V holds v1 <> v2 & v2 <> v3 & v1
  <> v3 implies Sum{v1,v2,v3} = v1 + v2 + v3;

theorem 
  for V be Abelian add-associative right_zeroed non empty
  addLoopStr, S,T be finite Subset of V holds T misses S implies Sum(T \/ S) =
  Sum(T) + Sum(S);

theorem 
  for V be Abelian add-associative right_zeroed
  right_complementable non empty addLoopStr, S,T be finite Subset of V holds
  Sum(T \/ S) = Sum(T) + Sum(S) - Sum(T /\ S);

theorem 
  for V be Abelian add-associative right_zeroed right_complementable
  non empty addLoopStr, S,T be finite Subset of V holds Sum(T /\ S) = Sum(T) +
  Sum(S) - Sum(T \/ S);

theorem 
  for V be Abelian add-associative right_zeroed
  right_complementable non empty addLoopStr, S,T be finite Subset of V holds
  Sum(T \ S) = Sum(T \/ S) - Sum(S);

theorem 
  for V be Abelian add-associative right_zeroed
  right_complementable non empty addLoopStr, S,T be finite Subset of V holds
  Sum(T \ S) = Sum(T) - Sum(T /\ S);

theorem 
  for V be Abelian add-associative right_zeroed right_complementable
non empty addLoopStr, S,T be finite Subset of V holds Sum(T \+\ S) = Sum(T \/
  S) - Sum(T /\ S);

theorem 
  for V be Abelian add-associative right_zeroed non empty addLoopStr,
S,T be finite Subset of V holds Sum(T \+\ S) = Sum(T \ S) + Sum(S \ T);

definition
  let V be non empty ZeroStr;
  mode Linear_Combination of V -> Element of Funcs(the carrier of V, REAL)
    means


    ex T being finite Subset of V st for v being Element of V st not v in T
    holds it.v = 0;
end;

reserve K,L,L1,L2,L3 for Linear_Combination of V;

notation
  let V be non empty addLoopStr, L be Element of Funcs(the carrier of V, REAL);
  synonym Carrier L for support L;
end;

definition
  let V be non empty addLoopStr, L be Element of Funcs(the carrier of V, REAL);
  redefine func Carrier(L) -> Subset of V equals

  {v where v is Element of V : L.v <> 0};
end;

registration
  let V be non empty addLoopStr, L be Linear_Combination of V;
  cluster Carrier(L) -> finite;
end;

theorem 
  for V be non empty addLoopStr, L be Linear_Combination of V, v be
  Element of V holds L.v = 0 iff not v in Carrier(L);

definition
  let V be non empty addLoopStr;
  func ZeroLC(V) -> Linear_Combination of V means


  Carrier (it) = {};
end;

theorem 
  for V be non empty addLoopStr, v be Element of V holds ZeroLC(V) .v = 0;

definition
  let V be non empty addLoopStr;
  let A be Subset of V;
  mode Linear_Combination of A -> Linear_Combination of V means


    Carrier (it) c= A;
end;

reserve l,l1,l2 for Linear_Combination of A;

theorem 
  A c= B implies l is Linear_Combination of B;

theorem 
  ZeroLC(V) is Linear_Combination of A;

theorem 
  for l being Linear_Combination of {}the carrier of V holds l = ZeroLC(V);

definition
  let V;
  let F;
  let f;
  func f (#) F -> FinSequence of the carrier of V means


  len it = len F & for i st i in dom it holds it.i = f.(F/.i) * F/.i;
end;

theorem 
  i in dom F & v = F.i implies (f (#) F).i = f.v * v;

theorem 
  f (#) <*>(the carrier of V) = <*>(the carrier of V);

theorem 
  f (#) <* v *> = <* f.v * v *>;

theorem 
  f (#) <* v1,v2 *> = <* f.v1 * v1, f.v2 * v2 *>;

theorem 
  f (#) <* v1,v2,v3 *> = <* f.v1 * v1, f.v2 * v2, f.v3 * v3 *>;

definition
  let V;
  let L;
  func Sum(L) -> Element of V means


  ex F st F is one-to-one & rng F = Carrier(L) & it = Sum(L (#) F);
end;

theorem 
  A <> {} & A is linearly-closed iff for l holds Sum(l) in A;

theorem 
  Sum(ZeroLC(V)) = 0.V;

theorem 
  for l being Linear_Combination of {}(the carrier of V) holds Sum(l) = 0.V;

theorem 
  for l being Linear_Combination of {v} holds Sum(l) = l.v * v;

theorem 
  v1 <> v2 implies for l being Linear_Combination of {v1,v2} holds
  Sum(l) = l.v1 * v1 + l.v2 * v2;

theorem 
  Carrier(L) = {} implies Sum(L) = 0.V;

theorem 
  Carrier(L) = {v} implies Sum(L) = L.v * v;

theorem 
  Carrier(L) = {v1,v2} & v1 <> v2 implies Sum(L) = L.v1 * v1 + L.v2 * v2;

definition
  let V be non empty addLoopStr;
  let L1,L2 be Linear_Combination of V;
  redefine pred L1 = L2 means

  for v being Element of V holds L1.v = L2.v;
end;

definition
  let V be non empty addLoopStr;
  let L1,L2 be Linear_Combination of V;
  redefine func L1 + L2 -> Linear_Combination of V means


  for v being Element of V holds it.v = L1.v + L2.v;
end;

theorem 
  Carrier(L1 + L2) c= Carrier(L1) \/ Carrier(L2);

theorem 
  L1 is Linear_Combination of A & L2 is Linear_Combination of A
  implies L1 + L2 is Linear_Combination of A;

theorem 
  for V be non empty addLoopStr, L1,L2 be Linear_Combination of V holds
  L1 + L2 = L2 + L1;

theorem 
  L1 + (L2 + L3) = L1 + L2 + L3;

theorem 
  L + ZeroLC(V) = L & ZeroLC(V) + L = L;

definition
  let V,a;
  let L;
  func a * L -> Linear_Combination of V means


  for v holds it.v = a * L.v;
end;

theorem 
  a <> 0 implies Carrier(a * L) = Carrier(L);

theorem 
  0 * L = ZeroLC(V);

theorem 
  L is Linear_Combination of A implies a * L is Linear_Combination of A;

theorem 
  (a + b) * L = a * L + b * L;

theorem 
  a * (L1 + L2) = a * L1 + a * L2;

theorem 
  a * (b * L) = (a * b) * L;

theorem 
  1 * L = L;

definition
  let V,L;
  func - L -> Linear_Combination of V equals

  (- 1) * L;
end;

theorem 
  (- L).v = - L.v;

theorem 
  L1 + L2 = ZeroLC(V) implies L2 = - L1;

theorem 
  Carrier(- L) = Carrier(L);

theorem 
  L is Linear_Combination of A implies - L is Linear_Combination of A;

theorem 
  - (- L) = L;

definition
  let V;
  let L1,L2;
  func L1 - L2 -> Linear_Combination of V equals

  L1 + (- L2);
end;

theorem 
  (L1 - L2).v = L1.v - L2.v;

theorem 
  Carrier(L1 - L2) c= Carrier(L1) \/ Carrier(L2);

theorem 
  L1 is Linear_Combination of A & L2 is Linear_Combination of A implies
  L1 - L2 is Linear_Combination of A;

theorem 
  L - L = ZeroLC(V);

definition
  let V;
  func LinComb(V) -> set means


  x in it iff x is Linear_Combination of V;
end;

registration
  let V;
  cluster LinComb(V) -> non empty;
end;

reserve e,e1,e2 for Element of LinComb(V);

definition
  let V;
  let e;
  func @e -> Linear_Combination of V equals

  e;
end;

definition
  let V;
  let L;
  func @L -> Element of LinComb(V) equals

  L;
end;

definition
  let V;
  func LCAdd(V) -> BinOp of LinComb(V) means


  for e1,e2 holds it.(e1,e2 ) = @e1 + @e2;
end;

definition
  let V;
  func LCMult(V) -> Function of [:REAL,LinComb(V):], LinComb(V) means


  for a,e holds it.[a,e] = a * @e;
end;

definition
  let V;
  func LC_RLSpace V -> RLSStruct equals

  RLSStruct (# LinComb(V), @ZeroLC(V),
    LCAdd(V), LCMult(V) #);
end;

registration
  let V;
  cluster LC_RLSpace V -> strict non empty;
end;

registration
  let V;
  cluster LC_RLSpace V -> Abelian add-associative right_zeroed
    right_complementable vector-distributive scalar-distributive
    scalar-associative scalar-unital;
end;

theorem 
  the carrier of LC_RLSpace(V) = LinComb(V);

theorem 
  0.LC_RLSpace(V) = ZeroLC(V);

theorem 
  the addF of LC_RLSpace(V) = LCAdd(V);

theorem 
  the Mult of LC_RLSpace(V) = LCMult(V);

theorem 
  vector(LC_RLSpace(V),L1) + vector(LC_RLSpace(V),L2) = L1 + L2;

theorem 
  a * vector(LC_RLSpace(V),L) = a * L;

theorem 
  - vector(LC_RLSpace(V),L) = - L;

theorem 
  vector(LC_RLSpace(V),L1) - vector(LC_RLSpace(V),L2) = L1 - L2;

definition
  let V;
  let A;
  func LC_RLSpace(A) -> strict Subspace of LC_RLSpace(V) means

  the carrier of it = {l : not contradiction};
end;

reserve x,y for set,
  k,n for Element of NAT;

theorem 
  for R being add-associative right_zeroed right_complementable
  Abelian associative well-unital distributive non empty doubleLoopStr,
      a being
  Element of R for V being Abelian add-associative right_zeroed
  right_complementable vector-distributive scalar-distributive
  scalar-associative scalar-unital non empty VectSpStr over R, F,G being
FinSequence of V st len F = len G & for k for v being Element of
  V st k in dom F & v = G.k holds F.k = a * v holds Sum(F) = a * Sum(G);

theorem 
  for R being add-associative right_zeroed right_complementable Abelian
associative well-unital distributive non empty doubleLoopStr, a being Element
  of R for V being Abelian add-associative right_zeroed right_complementable
vector-distributive scalar-distributive scalar-associative scalar-unital
non empty VectSpStr over R, F,G being FinSequence of V
st len F = len G & for k st k in dom F holds G.k = a * F/.k holds Sum(G) =
  a * Sum(F);

theorem 
  for R being add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr for V being
Abelian add-associative right_zeroed right_complementable non empty VectSpStr
over R, F,G,H being FinSequence of V st len F = len G & len F =
len H & for k st k in dom F holds H.k = F/.k - G/.k holds Sum(H) = Sum(F) - Sum
  (G);

theorem 
  for R being add-associative right_zeroed right_complementable Abelian
associative well-unital distributive non empty doubleLoopStr, a being Element
  of R for V being Abelian add-associative right_zeroed right_complementable
vector-distributive scalar-distributive scalar-associative scalar-unital
non empty VectSpStr over R holds a * Sum(<*>(the carrier of V)) =
  0.V;

theorem 
  for R being add-associative right_zeroed right_complementable Abelian
    associative well-unital distributive non empty doubleLoopStr,
  a being Element of R
  for V being Abelian add-associative right_zeroed right_complementable
    vector-distributive scalar-distributive scalar-associative scalar-unital
 non empty VectSpStr over R, v,u being Element of V holds a * Sum
  <* v,u *> = a * v + a * u;

theorem 
  for R being add-associative right_zeroed right_complementable Abelian
associative well-unital distributive non empty doubleLoopStr, a being Element
  of R for V being Abelian add-associative right_zeroed right_complementable
  vector-distributive scalar-distributive scalar-associative scalar-unital
   non empty VectSpStr over R, v,u,w being Element of V holds a *
  Sum<* v,u,w *> = a * v + a * u + a * w;














begin

reserve V for RealLinearSpace;
reserve p,q,u,v,w,y for VECTOR of V;
reserve a,b,c,d for Real;

definition
  let V;
  let u,v,w,y;
  pred u,v // w,y means


  u=v or w=y or ex a,b st 0<a & 0<b & a*(v-u)=b*( y-w);
end;

theorem 
  (w-v)+(v-u) = w-u;

theorem 
  y+u = v+w implies y-w = v-u;

theorem 
  a*(u-v) = -(a*(v-u));

theorem 
  (a-b)*(u-v) = (b-a)*(v-u);

theorem 
  a<>0 & a*u=v implies u=a"*v;

theorem 
  (a<>0 & a*u=v implies u=a"*v) & (a<>0 & u=a"*v implies a*u=v);

theorem 
  u,v // w,y & u<>v & w<>y implies ex a,b st a*(v-u)=b*(y-w) & 0<a & 0<b;

theorem 
  u,v // u,v;

theorem 
  u,v // w,w & u,u // v,w;

theorem 
  u,v // v,u implies u=v;

theorem 
  p<>q & p,q // u,v & p,q // w,y implies u,v // w,y;

theorem 
  u,v // w,y implies v,u // y,w & w,y // u,v;

theorem 
  u,v // v,w implies u,v // u,w;

theorem 
  u,v // u,w implies u,v // v,w or u,w // w,v;

theorem 
  v-u=y-w implies u,v // w,y;

theorem 
  y=(v+w)-u implies u,v // w,y & u,w // v,y;

theorem 
  (ex p,q st p<>q) implies for u,v,w ex y st u,v // w,y & u,w // v ,y & v<>y;

theorem 
  p<>v & v,p // p,w implies ex y st u,p // p,y & u,v // w,y;

theorem 
  (for a,b st a*u + b*v=0.V holds a=0 & b=0) implies u<>v & u<>0.V & v<>0.V;

theorem 
  (ex u,v st (for a,b st a*u + b*v=0.V holds a=0 & b=0)) implies
  ex u,v,w,y st not u,v // w,y & not u,v // y,w;

theorem 
  (ex p,q st (for w ex a,b st a*p + b*q=w)) implies for u,v,w,y st
not u,v // w,y & not u,v // y,w ex z being VECTOR of V st (u,v // u,z or u,v //
  z,u) & (w,y // w,z or w,y // z,w);

definition
  struct(1-sorted) AffinStruct (#carrier -> set, CONGR -> Relation of [:the
    carrier,the carrier:]#);
end;

registration
  cluster non trivial strict for AffinStruct;
end;

reserve AS for non empty AffinStruct;
reserve a,b,c,d for Element of AS;
reserve x,z for set;

definition
  let AS,a,b,c,d;
  pred a,b // c,d means


  [[a,b],[c,d]] in the CONGR of AS;
end;

definition
  let V;
  func DirPar(V) -> Relation of [:the carrier of V,the carrier of V:] means


   [x,z] in it iff ex u,v,w,y st x=[u,v] & z=[w,y] & u,v // w,y;
end;

theorem 
  [[u,v],[w,y]] in DirPar(V) iff u,v // w,y;

definition
  let V;
  func OASpace(V) -> strict AffinStruct equals

  AffinStruct (#the carrier of V,
    DirPar(V)#);
end;

registration
  let V;
  cluster OASpace V -> non empty;
end;

theorem 
  (ex u,v st for a,b being Real st a*u + b*v = 0.V holds a=0 & b=0
  ) implies (ex a,b being Element of OASpace(V) st a<>b) & (for a,b,c,d,p,q,r,s
being Element of OASpace(V) holds a,b // c,c & (a,b // b,a implies a=b) & (a<>b
& a,b // p,q & a,b // r,s implies p,q // r,s) & (a,b // c,d implies b,a // d,c)
& (a,b // b,c implies a,b // a,c) & (a,b // a,c implies a,b // b,c or a,c // c,
b)) & (ex a,b,c,d being Element of OASpace(V) st not a,b // c,d & not a,b // d,
c) & (for a,b,c being Element of OASpace(V) ex d being Element of OASpace(V) st
a,b // c,d & a,c // b,d & b<>d) & for p,a,b,c being Element of OASpace(V) st p
  <>b & b,p // p,c ex d being Element of OASpace(V) st a,p // p,d & a,b // c,d;

theorem 
  (ex p,q being VECTOR of V st (for w being VECTOR of V ex a,b
being Real st a*p + b*q=w)) implies for a,b,c,d being Element of OASpace(V) st
not a,b // c,d & not a,b // d,c ex t being Element of OASpace(V) st (a,b // a,t
  or a,b // t,a) & (c,d // c,t or c,d // t,c);

definition
  let IT be non empty AffinStruct;
  attr IT is OAffinSpace-like means


  (for a,b,c,d,p,q,r,s being Element
of IT holds a,b // c,c & (a,b // b,a implies a=b) & (a<>b & a,b // p,q & a,b //
r,s implies p,q // r,s) & (a,b // c,d implies b,a // d,c) & (a,b // b,c implies
  a,b // a,c) & (a,b // a,c implies a,b // b,c or a,c // c,b)) & (ex a,b,c,d
  being Element of IT st not a,b // c,d & not a,b // d,c) & (for a,b,c being
Element of IT ex d being Element of IT st a,b // c,d & a,c // b,d & b<>d) & for
p,a,b,c being Element of IT st p<>b & b,p // p,c ex d being Element of IT st a,
  p // p,d & a,b // c,d;
end;

registration
  cluster strict OAffinSpace-like for non trivial AffinStruct;
end;

definition
  mode OAffinSpace is OAffinSpace-like non trivial AffinStruct;
end;

theorem 
  (ex a,b being Element of AS st a<>b) & (for a,b,c,d,p,q,r,s being
Element of AS holds a,b // c,c & (a,b // b,a implies a=b) & (a<>b & a,b // p,q
& a,b // r,s implies p,q // r,s) & (a,b // c,d implies b,a // d,c) & (a,b // b,
c implies a,b // a,c) & (a,b // a,c implies a,b // b,c or a,c // c,b)) & (ex a,
  b,c,d being Element of AS st not a,b // c,d & not a,b // d,c) & (for a,b,c
being Element of AS ex d being Element of AS st a,b // c,d & a,c // b,d & b<>d)
  & (for p,a,b,c being Element of AS st p<>b & b,p // p,c ex d being Element of
  AS st a,p // p,d & a,b // c,d) iff AS is OAffinSpace;

theorem 
  (ex u,v st for a,b being Real st a*u + b*v = 0.V holds a=0 & b=0
  ) implies OASpace(V) is OAffinSpace;

definition
  let IT be OAffinSpace;
  attr IT is 2-dimensional means


  for a,b,c,d being Element of IT st not
a,b // c,d & not a,b // d,c holds ex p being Element of IT st (a,b // a,p or a,
  b // p,a) & (c,d // c,p or c,d // p,c);
end;

registration
  cluster strict 2-dimensional for OAffinSpace;
end;

definition
  mode OAffinPlane is 2-dimensional OAffinSpace;
end;

theorem 
  (ex a,b being Element of AS st a<>b) & (for a,b,c,d,p,q,r,s being
Element of AS holds a,b // c,c & (a,b // b,a implies a=b) & (a<>b & a,b // p,q
& a,b // r,s implies p,q // r,s) & (a,b // c,d implies b,a // d,c) & (a,b // b,
c implies a,b // a,c) & (a,b // a,c implies a,b // b,c or a,c // c,b)) & (ex a,
  b,c,d being Element of AS st not a,b // c,d & not a,b // d,c) & (for a,b,c
being Element of AS ex d being Element of AS st a,b // c,d & a,c // b,d & b<>d)
  & (for p,a,b,c being Element of AS st p<>b & b,p // p,c ex d being Element of
AS st a,p // p,d & a,b // c,d) & (for a,b,c,d being Element of AS st not a,b //
c,d & not a,b // d,c holds ex p being Element of AS st (a,b // a,p or a,b // p,
  a) & (c,d // c,p or c,d // p,c)) iff AS is OAffinPlane;

theorem 
  (ex u,v st (for a,b being Real st a*u + b*v = 0.V holds a=0 & b=0) & (
  for w ex a,b being Real st w = a*u + b*v)) implies OASpace(V) is OAffinPlane;














begin

definition
  struct(1-sorted) MetrStruct
   (# carrier -> set,
     distance -> Function of [:the carrier,the carrier:],REAL #);
end;

registration
  cluster non empty strict for MetrStruct;
end;

definition
  let A,B be set, f be PartFunc of [:A,B:],REAL;
  let a be Element of A;
  let b be Element of B;
  redefine func f.(a,b) -> Real;
end;

definition
  let M be MetrStruct;
  let a, b be Element of M;
  func dist(a,b) -> Real equals

  (the distance of M).(a,b);
end;

notation
  synonym Empty^2-to-zero for op2;
end;

definition
  redefine func Empty^2-to-zero -> Function of [:1,1:], REAL;
end;

registration
  cluster op2 -> natural-valued for Function;
end;

registration
  let f be natural-valued Function;
  let x,y be set;
  cluster f.(x,y) -> natural;
end;

definition

  let A be set;
  let f be PartFunc of [:A,A:], REAL;
  attr f is Reflexive means


  for a being Element of A holds f.(a,a) = 0;
  attr f is discerning means


  for a, b being Element of A st f.(a,b) = 0 holds a = b;
  attr f is symmetric means


  for a, b being Element of A holds f.(a,b) = f.(b,a);
  attr f is triangle means


  for a, b, c being Element of A holds f.(a,c) <= f.(a,b) + f.(b,c);
end;

definition
  let M be MetrStruct;
  attr M is Reflexive means


  the distance of M is Reflexive;
  attr M is discerning means


  the distance of M is discerning;
  attr M is symmetric means


  the distance of M is symmetric;
  attr M is triangle means


  the distance of M is triangle;
end;

registration
  cluster strict Reflexive discerning symmetric triangle non empty for
MetrStruct;
end;

definition
  mode MetrSpace is Reflexive discerning symmetric triangle MetrStruct;
end;

theorem 
  for M being MetrStruct holds ( for a being Element of M holds
  dist(a,a) = 0 ) iff M is Reflexive;

theorem 
  for M being MetrStruct holds
  ( for a, b being Element of M st dist(a,b) = 0 holds a = b ) iff
  M is discerning;

theorem 
  for M being MetrStruct st
   for a, b being Element of M holds dist(a,b) = dist(b,a) holds
  M is symmetric;

theorem 
  for M being MetrStruct holds ( for a, b, c being Element of M
  holds dist(a,c) <= dist(a,b) + dist(b,c) ) iff M is triangle;

definition
  let M be symmetric MetrStruct;
  let a, b be Element of M;
  redefine func dist(a,b);
  commutativity;
end;

theorem 
  for M being symmetric triangle Reflexive MetrStruct,
      a, b being Element of M holds 0 <= dist(a,b);

theorem 
  for M being MetrStruct st (for a, b, c being Element of M holds
  (dist(a,b) = 0 iff a=b) &
  dist(a,b) = dist(b,a) &
  dist(a,c) <= dist(a,b) + dist(b,c)) holds M is MetrSpace;

theorem 
  for M being MetrSpace, x,y being Element of M st x <> y holds 0 < dist(x,y);

definition
  let A be set;
  func discrete_dist A -> Function of [:A,A:], REAL means


  for x,y being Element of A holds it.(x,x) = 0 &
  (x <> y implies it.(x,y) = 1);
end;

definition
  let A be set;
  func DiscreteSpace A -> strict MetrStruct equals

  MetrStruct (#A,discrete_dist A#);
end;

registration
  let A be non empty set;
  cluster DiscreteSpace A -> non empty;
end;

registration
  let A be set;
  cluster DiscreteSpace A -> Reflexive discerning symmetric triangle;
end;

definition
  func real_dist -> Function of [:REAL,REAL:], REAL means


  for x,y being Element of REAL holds it.(x,y) = abs(x-y);
end;

theorem 
  for x,y being Element of REAL holds real_dist.(x,y) = 0 iff x = y;

theorem 
  for x,y being Element of REAL holds real_dist.(x,y) = real_dist.(y,x);

theorem 
  for x,y,z being Element of REAL holds real_dist.(x,y) <=
  real_dist.(x,z) + real_dist.(z,y);

definition
  func RealSpace -> strict MetrStruct equals

  MetrStruct (# REAL, real_dist #);
end;

registration
  cluster RealSpace -> non empty;
end;

registration
  cluster RealSpace -> Reflexive discerning symmetric triangle;
end;

definition
  let M be MetrStruct, p be Element of M, r be real number;
  func Ball(p,r) -> Subset of M means


   it = {q where q is Element of M : dist(p,q) < r} if M is non empty
    otherwise it is empty;
end;

definition
  let M be MetrStruct, p be Element of M, r be real number;
  func cl_Ball(p,r) -> Subset of M means


     it = {q where q is Element of M : dist(p,q) <= r} if M is non empty
      otherwise it is empty;
end;

definition
  let M be MetrStruct, p be Element of M, r be real number;
  func Sphere(p,r) -> Subset of M means


   it = {q where q is Element of M : dist(p,q) = r} if M is non empty
   otherwise it is empty;
end;

reserve r for real number;

theorem 
  for M being MetrStruct, p, x being Element of M holds x in Ball(p,r)
    iff M is non empty & dist(p,x) < r;

theorem 
  for M being MetrStruct, p, x being Element of M holds x in
  cl_Ball(p,r) iff M is non empty & dist(p,x) <= r;

theorem 
  for M being MetrStruct, p, x being Element of M holds x in
  Sphere(p,r) iff M is non empty & dist(p,x) = r;

theorem 
  for M being MetrStruct, p being Element of M holds Ball(p,r) c= cl_Ball(p,r);

theorem 
  for M being MetrStruct, p being Element of M holds Sphere(p,r)
  c= cl_Ball(p,r);

theorem 
  for M being MetrStruct, p being Element of M holds
  Sphere(p,r) \/ Ball(p,r) = cl_Ball(p,r);

theorem 
  for M being non empty MetrStruct, p being Element of M holds Ball(p,r)
  = {q where q is Element of M: dist(p,q) < r};

theorem 
  for M being non empty MetrStruct, p being Element of M holds cl_Ball(p
  ,r) = {q where q is Element of M: dist(p,q) <= r};

theorem 
  for M being non empty MetrStruct, p being Element of M holds Sphere(p,
  r) = {q where q is Element of M: dist(p,q) = r};

begin 

theorem 
  for x being set holds Empty^2-to-zero.(x,x) = 0;

theorem 
  for x,y being Element of 1 st x <> y holds 0 < Empty^2-to-zero.(x,y);

theorem 
  for x,y being Element of 1 holds
    Empty^2-to-zero.(x,y) = Empty^2-to-zero.(y,x);

theorem 
  for x,y,z being Element of 1 holds Empty^2-to-zero.(x,z) <=
  Empty^2-to-zero.(x,y) + Empty^2-to-zero.(y,z);

theorem 
  for x,y,z being Element of 1 holds
  Empty^2-to-zero.(x,z) <= max(Empty^2-to-zero.(x,y),Empty^2-to-zero.(y,z));

definition
  let A be non empty set;
  let f be Function of [:A,A:], REAL;
  attr f is Discerning means


  for a, b being Element of A holds a <> b implies 0 < f.(a,b);
end;

definition
  let M be non empty MetrStruct;
  attr M is Discerning means


  the distance of M is Discerning;
end;

theorem 
  for M being non empty MetrStruct holds
  ( for a, b being Element of M holds a <> b implies 0 < dist(a,b)) iff
  M is Discerning;

registration
  cluster MetrStruct(#1,Empty^2-to-zero#) -> non empty;
end;

registration
  cluster MetrStruct(#1,Empty^2-to-zero#) -> Reflexive symmetric Discerning
    triangle;
end;

definition
  let M be non empty MetrStruct;
  attr M is ultra means

  for a, b, c being Element of M holds dist(a,c) <= max (dist(a,b),dist(b,c));
end;

registration
  cluster strict ultra Reflexive symmetric Discerning triangle
    for non empty MetrStruct;
end;

theorem 
  for M being Reflexive Discerning non empty MetrStruct,
      a,b being Element of M holds 0 <= dist(a,b);

definition
  mode PseudoMetricSpace is Reflexive symmetric triangle
    non empty MetrStruct;
  mode SemiMetricSpace is Reflexive Discerning symmetric
    non empty MetrStruct;
  mode NonSymmetricMetricSpace is Reflexive Discerning triangle
    non empty MetrStruct;
  mode UltraMetricSpace is ultra Reflexive symmetric Discerning
    non empty MetrStruct;
end;

registration
  cluster -> Discerning for non empty MetrSpace;
end;

registration
  cluster -> triangle discerning for UltraMetricSpace;
end;

definition
  func Set_to_zero -> Function of [:2,2:],REAL equals

  [:2,2:] --> 0;
end;

theorem 
  for x,y being Element of 2 holds Set_to_zero.(x,y) = 0;

theorem 
  for x,y being Element of 2 holds Set_to_zero.(x,y) = Set_to_zero.(y,x);

theorem 
  for x,y,z being Element of 2 holds
  Set_to_zero.(x,z) <= Set_to_zero.(x,y) + Set_to_zero.(y,z);

definition
  func ZeroSpace -> MetrStruct equals

  MetrStruct(#2, Set_to_zero#);
end;

registration
  cluster ZeroSpace -> strict non empty;
end;

registration
  cluster ZeroSpace -> Reflexive symmetric triangle;
end;

definition
  let S be MetrStruct, p,q,r be Element of S;
  pred q is_between p,r means

  p <> q & p <> r & q <> r & dist(p,r) = dist(p,q) + dist(q,r);
end;

theorem 
  for S being symmetric triangle Reflexive non empty MetrStruct,
      p, q, r being Element of S holds
    q is_between p,r implies q is_between r,p;

theorem 
  for S being MetrSpace, p,q,r being Element of S st q is_between p,r
  holds (not p is_between q,r) & not r is_between p,q;

theorem 
  for S being MetrSpace, p,q,r,s being Element of S st q is_between p,r
  & r is_between p,s holds q is_between p,s & r is_between q,s;

definition
  let M be non empty MetrStruct, p,r be Element of M;
  func open_dist_Segment(p,r) -> Subset of M equals

  {q where q is Element of M : q is_between p,r};
end;

theorem 
  for M being non empty MetrSpace, p,r,x being Element of M holds
  x in open_dist_Segment(p,r) iff x is_between p,r;

definition
  let M be non empty MetrStruct, p,r be Element of M;
  func close_dist_Segment(p,r) -> Subset of M equals

  {q where q is Element of M : q is_between p,r} \/ {p,r};
end;

theorem 
  for M being non empty MetrStruct, p,r,x being Element of M holds
  x in close_dist_Segment(p,r) iff (x is_between p,r or x = p or x = r);














begin

reserve x,y for set;
reserve X for non empty set;
reserve a,b,c,d for Element of X;

definition
  let X;
  let R be Relation of [:X,X:];
  func lambda(R) -> Relation of [:X,X:] means


  for a,b,c,d being Element
of X holds [[a,b],[c,d]] in it iff ([[a,b],[c,d]] in R or [[a,b],[d,c]] in R);
end;

definition
  let S be non empty AffinStruct;
  func Lambda(S) -> strict AffinStruct equals

  AffinStruct (# the carrier of S,
    lambda(the CONGR of S) #);
end;

registration
  let S be non empty AffinStruct;
  cluster Lambda S -> non empty;
end;

reserve S for OAffinSpace;
reserve a,b,c,d,p,q,r,x,y,z,t,u,w for Element of S;

theorem 
  x,y // x,y;

theorem 
  x,y // z,t implies y,x // t,z & z,t // x,y & t,z // y,x;

theorem 
  z<>t & x,y // z,t & z,t // u,w implies x,y // u,w;

theorem 
  x,x // y,z & y,z // x,x;

theorem 
  x,y // z,t & x,y // t,z implies x=y or z=t;

theorem 
  x,y // x,z iff x,y // y,z or x,z // z,y;

definition
  let S be non empty AffinStruct;
  let a,b,c be Element of S;
  pred Mid a,b,c means


  a,b // b,c;
end;

theorem 
  x,y // x,z iff Mid x,y,z or Mid x,z,y;

theorem 
  Mid a,b,a implies a=b;

theorem 
  Mid a,b,c implies Mid c,b,a;

theorem 
  Mid x,x,y & Mid x,y,y;

theorem 
  Mid a,b,c & Mid a,c,d implies Mid b,c,d;

theorem 
  b<>c & Mid a,b,c & Mid b,c,d implies Mid a,c,d;

theorem 
  ex z st Mid x,y,z & y<>z;

theorem 
  Mid x,y,z & Mid y,x,z implies x=y;

theorem 
  x<>y & Mid x,y,z & Mid x,y,t implies Mid y,z,t or Mid y,t,z;

theorem 
  x<>y & Mid x,y,z & Mid x,y,t implies Mid x,z,t or Mid x,t,z;

theorem 
  Mid x,y,t & Mid x,z,t implies Mid x,y,z or Mid x,z,y;

definition
  let S be non empty AffinStruct;
  let a,b,c,d be Element of S;
  pred a,b '||' c,d means


  a,b // c,d or a,b // d,c;
end;

theorem 
  a,b '||' c,d iff [[a,b],[c,d]] in lambda(the CONGR of S);

theorem 
  x,y '||' y,x & x,y '||' x,y;

theorem 
  x,y '||' z,z & z,z '||' x,y;

theorem 
  x,y '||' x,z implies y,x '||' y,z;

theorem 
  x,y '||' z,t implies x,y '||' t,z & y,x '||' z,t & y,x '||' t,z
  & z,t '||' x,y & z,t '||' y,x & t,z '||' x,y & t,z '||' y,x;

theorem 
  a<>b & ( a,b '||' x,y & a,b '||' z,t or a,b '||' x,y & z,t '||'
a,b or x,y '||' a,b & z,t '||' a,b or x,y '||' a,b & a,b '||' z,t ) implies x,y
  '||' z,t;

theorem 
  ex x,y,z st not x,y '||' x,z;

theorem 
  ex t st x,z '||' y,t & y<>t;

theorem 
  ex t st x,y '||' z,t & x,z '||' y,t;

theorem 
  z,x '||' x,t & x<>z implies ex u st y,x '||' x,u & y,z '||' t,u;

definition
  let S be non empty AffinStruct;
  let a,b,c be Element of S;
  pred LIN a,b,c means


  a,b '||' a,c;
end;

notation
  let S be non empty AffinStruct;
  let a,b,c be Element of S;
  synonym a,b,c is_collinear for LIN a,b,c;
end;

theorem 
  Mid a,b,c implies a,b,c is_collinear;

theorem 
  a,b,c is_collinear implies Mid a,b,c or Mid b,a,c or Mid a,c,b;

theorem 
  x,y,z is_collinear implies x,z,y is_collinear & y,x,z
  is_collinear & y,z,x is_collinear & z,x,y is_collinear & z,y,x is_collinear;

theorem 
  x,x,y is_collinear & x,y,y is_collinear & x,y,x is_collinear;

theorem 
  x<>y & x,y,z is_collinear & x,y,t is_collinear & x,y,u
  is_collinear implies z,t,u is_collinear;

theorem 
  x<>y & x,y,z is_collinear & x,y '||' z,t implies x,y,t is_collinear;

theorem 
  x,y,z is_collinear & x,y,t is_collinear implies x,y '||' z,t;

theorem 
  u<>z & x,y,u is_collinear & x,y,z is_collinear & u,z,w is_collinear
  implies x,y,w is_collinear;

theorem 
  ex x,y,z st not x,y,z is_collinear;

theorem 
  x<>y implies ex z st not x,y,z is_collinear;

reserve AS for non empty AffinStruct;

theorem 
  AS=Lambda(S) implies for a,b,c,d being Element of S, a9,b9,c9,d9
being Element of AS st a=a9 & b=b9 & c =c9 & d=d9 holds a9,b9 // c9,d9 iff a,b
  '||' c,d;

theorem 
  AS = Lambda(S) implies (ex x,y being Element of AS st x<>y) & (
for x,y,z,t,u,w being Element of AS holds x,y // y,x & x,y // z,z & (x<>y & x,y
// z,t & x,y // u,w implies z,t // u,w) & (x,y // x,z implies y,x // y,z)) & (
  ex x,y,z being Element of AS st not x,y // x,z) & (for x,y,z being Element of
AS ex t being Element of AS st x,z // y,t & y<>t) & (for x,y,z being Element of
  AS ex t being Element of AS st x,y // z,t & x,z // y,t) & for x,y,z,t being
Element of AS st z,x // x,t & x<>z ex u being Element of AS st y,x // x,u & y,z
  // t,u;

definition
  let IT be non empty AffinStruct;

  attr IT is AffinSpace-like means


  (for x,y,z,t,u,w being Element of IT
holds x,y // y,x & x,y // z,z & (x<>y & x,y // z,t & x,y // u,w implies z,t //
u,w) & (x,y // x,z implies y,x // y,z)) & (ex x,y,z being Element of IT st not
x,y // x,z) & (for x,y,z being Element of IT ex t being Element of IT st x,z //
y,t & y<>t) & (for x,y,z being Element of IT ex t being Element of IT st x,y //
  z,t & x,z // y,t) & for x,y,z,t being Element of IT st z,x // x,t & x<>z ex u
  being Element of IT st y,x // x,u & y,z // t,u;
end;

registration
  cluster strict AffinSpace-like for non trivial AffinStruct;
end;

definition
  mode AffinSpace is AffinSpace-like non trivial AffinStruct;
end;

theorem 
  for AS being AffinSpace holds (ex x,y being Element of AS st x<>y) & (
for x,y,z,t,u,w being Element of AS holds (x,y // y,x & x,y // z,z) & (x<>y & x
,y // z,t & x,y // u,w implies z,t // u,w) & (x,y // x,z implies y,x // y,z)) &
(ex x,y,z being Element of AS st not x,y // x,z) & (for x,y,z being Element of
AS ex t being Element of AS st x,z // y,t & y<>t) & (for x,y,z being Element of
  AS ex t being Element of AS st x,y // z,t & x,z // y,t) & for x,y,z,t being
Element of AS st z,x // x,t & x<>z ex u being Element of AS st y,x // x,u & y,z
  // t,u;

theorem 
  Lambda(S) is AffinSpace;

theorem 
  (ex x,y being Element of AS st x<>y) & (for x,y,z,t,u,w being Element
of AS holds x,y // y,x & x,y // z,z & (x<>y & x,y // z,t & x,y // u,w implies z
  ,t // u,w) & (x,y // x,z implies y,x // y,z)) & (ex x,y,z being Element of AS
st not x,y // x,z) & (for x,y,z being Element of AS ex t being Element of AS st
x,z // y,t & y<>t) & (for x,y,z being Element of AS ex t being Element of AS st
x,y // z,t & x,z // y,t) & (for x,y,z,t being Element of AS st z,x // x,t & x<>
z ex u being Element of AS st y,x // x,u & y,z // t,u) iff AS is AffinSpace;

reserve S for OAffinPlane;
reserve x,y,z,t,u for Element of S;

theorem 
  not x,y '||' z,t implies ex u st x,y '||' x,u & z,t '||' z,u;

theorem 
  AS = Lambda(S) implies for x,y,z,t being Element of AS st not x,
  y // z,t ex u being Element of AS st x,y // x,u & z,t // z,u;

definition
  let IT be non empty AffinStruct;
  attr IT is 2-dimensional means


  for x,y,z,t being Element of IT st not
  x,y // z,t ex u being Element of IT st x,y // x,u & z,t // z,u;
end;

registration
  cluster strict 2-dimensional for AffinSpace;
end;

definition
  mode AffinPlane is 2-dimensional AffinSpace;
end;

theorem 
  Lambda(S) is AffinPlane;

theorem 
  AS is AffinPlane iff (ex x,y being Element of AS st x<>y) & (for x,y,z
,t,u,w being Element of AS holds x,y // y,x & x,y // z,z & (x<>y & x,y // z,t &
  x,y // u,w implies z,t // u,w) & (x,y // x,z implies y,x // y,z)) & (ex x,y,z
  being Element of AS st not x,y // x,z) & (for x,y,z being Element of AS ex t
being Element of AS st x,z // y,t & y<>t) & (for x,y,z being Element of AS ex t
being Element of AS st x,y // z,t & x,z // y,t) & (for x,y,z,t being Element of
AS st z,x // x,t & x<>z ex u being Element of AS st y,x // x,u & y,z // t,u) &
for x,y,z,t being Element of AS st not x,y // z,t ex u being Element of AS st x
  ,y // x,u & z,t // z,u;














begin

reserve AS for AffinSpace;
reserve a,a9,b,b9,c,d,o,p,q,r,s,x,y,z,t,u,w for Element of AS;

definition
  let AS,a,b,c;
  pred LIN a,b,c means

  a,b // a,c;
end;

theorem 
  for a ex b st a<>b;

theorem 
  x,y // y,x & x,y // x,y;

theorem 
  x,y // z,z & z,z // x,y;

theorem 
  x,y // z,t implies x,y // t,z & y,x // z,t & y,x // t,z &
  z,t // x,y & z,t // y,x & t,z // x,y & t,z // y,x;

theorem 
  a<>b & ( a,b // x,y & a,b // z,t or a,b // x,y & z,t // a,b or x
  ,y // a,b & z,t // a,b or x,y // a,b & a,b // z,t ) implies x,y // z,t;

theorem 
  LIN x,y,z implies LIN x,z,y & LIN y,x,z & LIN y,z,x & LIN z,x,y & LIN z,y,x;

theorem 
  LIN x,x,y & LIN x,y,y & LIN x,y,x;

theorem 
  x<>y & LIN x,y,z & LIN x,y,t & LIN x,y,u implies LIN z,t,u;

theorem 
  x<>y & LIN x,y,z & x,y // z,t implies LIN x,y,t;

theorem 
  LIN x,y,z & LIN x,y,t implies x,y // z,t;

theorem 
  u<>z & LIN x,y,u & LIN x,y,z & LIN u,z,w implies LIN x,y,w;

theorem 
  ex x,y,z st not LIN x,y,z;

theorem 
  x<>y implies ex z st not LIN x,y,z;

theorem 
  not LIN o,a,b & LIN o,b,b9 & a,b // a,b9 implies b=b9;





definition
  let AS,a,b;
  func Line(a,b) -> Subset of AS means


  for x holds x in it iff LIN a,b,x;
end;

reserve A,C,D,K for Subset of AS;

definition
  let AS,a,b;
  redefine func Line(a,b);
  commutativity;
end;

theorem 
  a in Line(a,b) & b in Line(a,b);

theorem 
  c in Line(a,b) & d in Line(a,b) & c <>d implies Line(c,d) c= Line(a,b);

theorem 
  c in Line(a,b) & d in Line(a,b) & a<>b implies Line(a,b) c= Line (c,d);





definition let AS,A;
  attr A is being_line means

  ex a,b st a <> b & A = Line(a,b);
end;

registration let AS;
  cluster being_line for Subset of AS;
end;




theorem 
  A is being_line & C is being_line & a in A & b in A & a in C & b in C
  implies a=b or A=C;

theorem 
  A is being_line implies ex a,b st a in A & b in A & a<>b;

theorem 
  A is being_line implies ex b st a<>b & b in A;

theorem 
  LIN a,b,c iff ex A st A is being_line & a in A & b in A & c in A;





definition
  let AS,a,b,A;
  pred a,b // A means


  ex c,d st c <>d & A=Line(c,d) & a,b // c,d;
end;

definition
  let AS,A,C;
  pred A // C means


  ex a,b st A=Line(a,b) & a<>b & a,b // C;
end;

theorem 
  c in Line(a,b) & a<>b implies (d in Line(a,b) iff a,b // c,d);

theorem 
  A is being_line & a in A implies (b in A iff a,b // A);

theorem 
  a<>b & A=Line(a,b) iff A is being_line & a in A & b in A & a<>b;

theorem 
  A is being_line & a in A & b in A & a<>b & LIN a,b,x implies x in A;

theorem 
  (ex a,b st a,b // A) implies A is being_line;

theorem 
  c in A & d in A & A is being_line & c <>d implies (a,b // A iff a,b // c,d);

theorem 
  a,b // A implies ex c,d st c <>d & c in A & d in A & a,b // c,d;

theorem 
  a<>b implies a,b // Line(a,b);

theorem 
  for A be being_line Subset of AS holds
  (a,b // A iff ex c,d st c <>d & c in A & d in A & a,b // c,d );

theorem 
  for A be being_line Subset of AS st a,b // A & c,d // A holds a,b // c,d;

theorem 
  a,b // A & a,b // p,q & a<>b implies p,q // A;

theorem 
  for A be being_line Subset of AS holds a,a // A;

theorem 
  a,b // A implies b,a // A;

theorem 
  a,b // A & not a in A implies not b in A;

theorem 
  A // C implies A is being_line & C is being_line;

theorem 
  A // C iff ex a,b,c,d st a<>b & c <>d & a,b // c,d & A=Line(a,b)
  & C=Line(c,d);

theorem 
  for A, C be being_line Subset of AS st
    a in A & b in A & c in C & d in C & a<>b & c<>d holds
      (A // C iff a,b // c,d);

theorem 
  a in A & b in A & c in C & d in C & A // C implies a,b // c,d;

theorem 
  a in A & b in A & A // C implies a,b // C;

theorem 
  for A being being_line Subset of AS holds A // A;

definition let AS; let A,B be being_line Subset of AS;
  redefine pred A // B;
  reflexivity;
end;

theorem 
  A // C implies C // A;

definition let AS,A,C;
  redefine pred A // C;
  symmetry;
end;

theorem 
  a,b // A & A // C implies a,b // C;

theorem 
  ( A // C & C // D or A // C & D // C or C // A & C // D or C // A & D
  // C ) implies A // D;

theorem 
  A // C & p in A & p in C implies A=C;

theorem 
  x in K & not a in K & a,b // K implies (a=b or not LIN x,a,b);

theorem 
  a9,b9 // K & LIN p,a,a9 & LIN p,b,b9 & p in K & not a in K & a=b
  implies a9=b9;

theorem 
  for A be being_line Subset of AS st
  a in A & b in A & c in A & a<>b & a,b // c,d holds d in A;

theorem 
  for A be being_line Subset of AS ex C st a in C & A // C;

theorem 
  A // C & A // D & p in C & p in D implies C=D;





theorem 
  A is being_line & a in A & b in A & c in A & d in A implies a,b // c,d;

theorem 
  A is being_line & a in A & b in A implies a,b // A;

theorem 
  a,b // A & a,b // C & a<>b implies A // C;

theorem 
  not LIN o,a,b & LIN o,a,a9 & LIN o,b,b9 & a9=b9 implies a9=o & b9=o;

theorem 
  not LIN o,a,b & LIN o,b,b9 & a,b // a9,b9 & a9=o implies b9=o;

theorem 
  not LIN o,a,b & LIN o,a,a9 & LIN o,b,b9 & LIN o,b,x & a,b // a9,b9 & a
  ,b // a9,x implies b9=x;

theorem 
  for a,b,A holds A is being_line & a in A & b in A & a<>b implies
    A = Line(a,b);





reserve AP for AffinPlane;
reserve a,b,c,d,x,p,q for Element of AP;
reserve A,C for Subset of AP;

theorem 
  A is being_line & C is being_line & not A // C implies
    ex x st x in A & x in C;

theorem 
  A is being_line & not a,b // A implies ex x st x in A & LIN a,b,x;

theorem 
  not a,b // c,d implies ex p st LIN a,b,p & LIN c,d,p;














begin

reserve AP for AffinPlane,
  a,a9,b,b9,c,c9,x,y,o,p,q,r,s for Element of AP,
  A,C,C9,D,K,M,N,P,T for Subset of AP;

definition
  let AP;
  attr AP is satisfying_PPAP means


  for M,N,a,b,c,a9,b9,c9 st M is
  being_line & N is being_line & a in M & b in M & c in M & a9 in N & b9 in N &
  c9 in N & a,b9 // b,a9 & b,c9 // c,b9 holds a,c9 // c,a9;
end;

definition
  let AP be AffinSpace;
  attr AP is Pappian means


  for M,N being Subset of AP, o,a,b,c,a9,b9,c9
being Element of AP st M is being_line & N is being_line & M<>N & o in M & o in
N & o<>a & o<>a9 & o<>b & o<>b9 & o<>c & o<>c9 & a in M & b in M & c in M & a9
  in N & b9 in N & c9 in N & a,b9 // b,a9 & b,c9 // c,b9 holds a,c9 // c,a9;
end;

definition
  let AP;
  attr AP is satisfying_PAP_1 means


  for M,N,o,a,b,c,a9,b9,c9 st M is
being_line & N is being_line & M<>N & o in M & o in N & o<>a & o<>a9 & o<>b & o
<>b9 & o<>c & o<>c9 & a in M & b in M & c in M & b9 in N & c9 in N & a,b9 // b,
  a9 & b,c9 // c,b9 & a,c9 // c,a9 & b<>c holds a9 in N;
end;

definition
  let AP be AffinSpace;
  attr AP is Desarguesian means


  for A,P,C being Subset of AP, o,a,b,c,
a9,b9,c9 being Element of AP st o in A & o in P & o in C & o<>a & o<>b & o<>c &
a in A & a9 in A & b in P & b9 in P & c in C & c9 in C & A is being_line & P is
being_line & C is being_line & A<>P & A<>C & a,b // a9,b9 & a,c // a9,c9 holds
  b,c // b9,c9;
end;

definition
  let AP;
  attr AP is satisfying_DES_1 means


  for A,P,C,o,a,b,c,a9,b9,c9 st o in
A & o in P & o<>a & o<>b & o<>c & a in A & a9 in A & b in P & b9 in P & c in C
& c9 in C & A is being_line & P is being_line & C is being_line & A<>P & A<>C &
a,b // a9,b9 & a,c // a9,c9 & b,c // b9,c9 & not LIN a,b,c & c <>c9 holds o in
  C;
end;

definition
  let AP;
  attr AP is satisfying_DES_2 means

  for A,P,C,o,a,b,c,a9,b9,c9 st o in A & o in P & o in C &
  o<>a & o<>b & o<>c & a in A & a9 in A & b in P & b9 in P & c in C &
  A is being_line & P is being_line & C is being_line & A<>P & A<>C & a,b //
  a9,b9 & a,c // a9,c9 & b,c // b9,c9 holds c9 in C;
end;

definition
  let AP be AffinSpace;
  attr AP is Moufangian means


  for K being Subset of AP, o,a,b,c,a9,b9,c9 being Element of AP st
  K is being_line & o in K & c in K & c9 in K & not a in K &
  o<>c & a<>b & LIN o,a,a9 & LIN o,b,b9 & a,b // a9,b9 & a,c // a9,c9 & a,
  b // K holds b,c // b9,c9;
end;

definition
  let AP;
  attr AP is satisfying_TDES_1 means


  for K,o,a,b,c,a9,b9,c9 st K is being_line &
  o in K & c in K & c9 in K & not a in K & o<>c & a<>b & LIN o,a,a9
  & a,b // a9,b9 & b,c // b9,c9 & a,c // a9,c9 & a,b // K holds LIN o,b,b9;
end;

definition
  let AP;
  attr AP is satisfying_TDES_2 means


  for K,o,a,b,c,a9,b9,c9 st K is being_line &
  o in K & c in K & c9 in K & not a in K & o<>c & a<>b & LIN o,a,a9
  & LIN o,b,b9 & b,c // b9,c9 & a,c // a9,c9 & a,b // K holds a,b // a9,b9;
end;

definition
  let AP;
  attr AP is satisfying_TDES_3 means


  for K,o,a,b,c,a9,b9,c9 st K is
being_line & o in K & c in K & not a in K & o<>c & a<>b & LIN o,a,a9 & LIN o,b,
  b9 & a,b // a9,b9 & a,c // a9,c9 & b,c // b9,c9 & a,b // K holds c9 in K;
end;

definition
  let AP be AffinSpace;
  attr AP is translational means


  for A,P,C being Subset of AP, a,b,c,
  a9,b9,c9 being Element of AP st A // P & A // C & a in A & a9 in A & b in P &
  b9 in P & c in C & c9 in C & A is being_line & P is being_line & C is
  being_line & A<>P & A<>C & a,b // a9,b9 & a,c // a9,c9 holds b,c // b9,c9;
end;

definition
  let AP;
  attr AP is satisfying_des_1 means


  for A,P,C,a,b,c,a9,b9,c9 st A // P
& a in A & a9 in A & b in P & b9 in P & c in C & c9 in C & A is being_line & P
is being_line & C is being_line & A<>P & A<>C & a,b // a9,b9 & a,c // a9,c9 & b
  ,c // b9,c9 & not LIN a,b,c & c <>c9 holds A // C;
end;

definition
  let AP be AffinSpace;
  attr AP is satisfying_pap means


  for M,N being Subset of AP, a,b,c,a9,b9,c9 being Element of AP st
  M is being_line & N is being_line & a in M & b in M & c in M &
  M // N & M<>N & a9 in N & b9 in N & c9 in N & a,b9 // b,a9 & b,c9
  // c,b9 holds a,c9 // c,a9;
end;

definition
  let AP;
  attr AP is satisfying_pap_1 means


  for M,N,a,b,c,a9,b9,c9 st M is being_line & N is being_line &
  a in M & b in M & c in M & M // N & M<>N & a9 in N & b9 in N &
  a,b9 // b,a9 & b,c9 // c,b9 & a,c9 // c,a9 & a9<>b9 holds c9 in N;
end;

theorem 
  AP is Pappian iff AP is satisfying_PAP_1;

theorem 
  AP is Desarguesian iff AP is satisfying_DES_1;

theorem 
  AP is Moufangian implies AP is satisfying_TDES_1;

theorem 
  AP is satisfying_TDES_1 implies AP is satisfying_TDES_2;

theorem 
  AP is satisfying_TDES_2 implies AP is satisfying_TDES_3;

theorem 
  AP is satisfying_TDES_3 implies AP is Moufangian;

theorem 
  AP is translational iff AP is satisfying_des_1;

theorem 
  AP is satisfying_pap iff AP is satisfying_pap_1;

theorem 
  AP is Pappian implies AP is satisfying_pap;

theorem 
  AP is satisfying_PPAP iff AP is Pappian & AP is satisfying_pap;

theorem 
  AP is Pappian implies AP is Desarguesian;

theorem 
  AP is Desarguesian implies AP is Moufangian;

theorem 
  AP is satisfying_TDES_1 implies AP is satisfying_des_1;

theorem 
  AP is Moufangian implies AP is translational;

theorem 
  AP is translational implies AP is satisfying_pap;














begin

reserve AP for AffinPlane;
reserve a,a9,b,b9,c,c9,d,x,y,o,p,q for Element of AP;
reserve A,C,D9,M,N,P for Subset of AP;

definition
  let AP;
  attr AP is satisfying_DES1 means


  for A,P,C,o,a,a9,b,b9,c,c9,p,q st A
is being_line & P is being_line & C is being_line & P<>A & P<>C & A<>C & o in A
& a in A & a9 in A & o in P & b in P & b9 in P & o in C & c in C & c9 in C & o
<>a & o<>b & o<>c & p<>q & not LIN b,a,c & not LIN b9,a9,c9 & a<>a9 & LIN b,a,p
  & LIN b9,a9,p & LIN b,c,q & LIN b9,c9,q & a,c // a9,c9 holds a,c // p,q;
end;

definition
  let AP;
  attr AP is satisfying_DES1_1 means


  for A,P,C,o,a,a9,b,b9,c,c9,p,q st
A is being_line & P is being_line & C is being_line & P<>A & P<>C & A<>C & o in
A & a in A & a9 in A & o in P & b in P & b9 in P & o in C & c in C & c9 in C &
o<>a & o<>b & o<>c & p<>q & c <>q & not LIN b,a,c & not LIN b9,a9,c9 & LIN b,a,
  p & LIN b9,a9,p & LIN b,c,q & LIN b9,c9,q & a,c // p,q holds a,c // a9,c9;
end;

definition
  let AP;
  attr AP is satisfying_DES1_2 means


  for A,P,C,o,a,a9,b,b9,c,c9,p,q st
A is being_line & P is being_line & C is being_line & P<>A & P<>C & A<>C & o in
A & a in A & a9 in A & o in P & b in P & b9 in P & c in C & c9 in C & o<>a & o
<>b & o<>c & p<>q & not LIN b,a,c & not LIN b9,a9,c9 & c <>c9 & LIN b,a,p & LIN
  b9,a9,p & LIN b,c,q & LIN b9,c9,q & a,c // a9,c9 & a,c // p,q holds o in C;
end;

definition
  let AP;
  attr AP is satisfying_DES1_3 means


  for A,P,C,o,a,a9,b,b9,c,c9,p,q st
A is being_line & P is being_line & C is being_line & P<>A & P<>C & A<>C & o in
A & a in A & a9 in A & b in P & b9 in P & o in C & c in C & c9 in C & o<>a & o
<>b & o<>c & p<>q & not LIN b,a,c & not LIN b9,a9,c9 & b<>b9 & a<>a9 & LIN b,a,
  p & LIN b9,a9,p & LIN b,c,q & LIN b9,c9,q & a,c // a9,c9 & a,c // p,q holds o
  in P;
end;

definition
  let AP;
  attr AP is satisfying_DES2 means


  for A,P,C,a,a9,b,b9,c,c9,p,q st A is
being_line & P is being_line & C is being_line & A<>P & A<>C & P<>C & a in A &
a9 in A & b in P & b9 in P & c in C & c9 in C & A // P & A // C & not LIN b,a,c
  & not LIN b9,a9,c9 & p<>q & a<>a9 & LIN b,a,p & LIN b9,a9,p & LIN b,c,q & LIN
  b9,c9,q & a,c // a9,c9 holds a,c // p,q;
end;

definition
  let AP;
  attr AP is satisfying_DES2_1 means


  for A,P,C,a,a9,b,b9,c,c9,p,q st A
is being_line & P is being_line & C is being_line & A<>P & A<>C & P<>C & a in A
& a9 in A & b in P & b9 in P & c in C & c9 in C & A // P & A // C & not LIN b,a
,c & not LIN b9,a9,c9 & p<>q & LIN b,a,p & LIN b9,a9,p & LIN b,c,q & LIN b9,c9,
  q & a,c // p,q holds a,c // a9,c9;
end;

definition
  let AP;
  attr AP is satisfying_DES2_2 means


  for A,P,C,a,a9,b,b9,c,c9,p,q st A
is being_line & P is being_line & C is being_line & A<>P & A<>C & P<>C & a in A
& a9 in A & b in P & b9 in P & c in C & c9 in C & A // C & not LIN b,a,c & not
LIN b9,a9,c9 & p<>q & a<>a9 & LIN b,a,p & LIN b9,a9,p & LIN b,c,q & LIN b9,c9,q
  & a,c // a9,c9 & a,c // p,q holds A // P;
end;

definition
  let AP;
  attr AP is satisfying_DES2_3 means


  for A,P,C,a,a9,b,b9,c,c9,p,q st A
is being_line & P is being_line & C is being_line & A<>P & A<>C & P<>C & a in A
& a9 in A & b in P & b9 in P & c in C & c9 in C & A // P & not LIN b,a,c & not
LIN b9,a9,c9 & p<>q & c <>c9 & LIN b,a,p & LIN b9,a9,p & LIN b,c,q & LIN b9,c9,
  q & a,c // a9,c9 & a,c // p,q holds A // C;
end;

theorem 
  AP is satisfying_DES1 implies AP is satisfying_DES1_1;

theorem 
  AP is satisfying_DES1_1 implies AP is satisfying_DES1;

theorem 
  AP is Desarguesian implies AP is satisfying_DES1;

theorem 
  AP is Desarguesian implies AP is satisfying_DES1_2;

theorem 
  AP is satisfying_DES1_2 implies AP is satisfying_DES1_3;

theorem 
  AP is satisfying_DES1_2 implies AP is Desarguesian;

theorem 
  AP is satisfying_DES2_1 implies AP is satisfying_DES2;

theorem 
  AP is satisfying_DES2_1 iff AP is satisfying_DES2_3;

theorem 
  AP is satisfying_DES2 iff AP is satisfying_DES2_2;

theorem 
  AP is satisfying_DES1_3 implies AP is satisfying_DES2_1;














begin 

reserve X for set;

definition
  let X;
  mode Relation3 of X -> set means


    it c= [:X,X,X:];
end;

theorem 
  X = {} or ex a be set st {a} = X or ex a,b be set st a<>b & a in X & b in X;





definition
  struct(1-sorted) CollStr (# carrier -> set, Collinearity -> Relation3 of the
    carrier #);
end;

registration
  cluster non empty strict for CollStr;
end;

reserve CS for non empty CollStr;
reserve a,b,c for Point of CS;

definition
  let CS, a,b,c;
  pred a,b,c is_collinear means


  [a,b,c] in the Collinearity of CS;
end;

definition
  let IT be non empty CollStr;
  attr IT is reflexive means


  for a,b,c being Point of IT st a=b or a=c
  or b=c holds [a,b,c] in the Collinearity of IT;
end;

definition
  let IT be non empty CollStr;
  attr IT is transitive means


  for a,b,p,q,r being Point of IT st a<>b &
[a,b,p] in the Collinearity of IT & [a,b,q] in the Collinearity of IT & [a,b,r]
  in the Collinearity of IT holds [p,q,r] in the Collinearity of IT;
end;

registration
  cluster strict reflexive transitive for non empty CollStr;
end;

definition
  mode CollSp is reflexive transitive non empty CollStr;
end;

reserve CLSP for CollSp;
reserve a,b,c,d,p,q,r for Point of CLSP;

theorem 
  (a=b or a=c or b=c) implies a,b,c is_collinear;

theorem 
  a<>b & a,b,p is_collinear & a,b,q is_collinear & a,b,r
  is_collinear implies p,q,r is_collinear;

theorem 
  a,b,c is_collinear implies b,a,c is_collinear & a,c,b is_collinear;

theorem 
  a,b,a is_collinear;

theorem 
  a<>b & a,b,c is_collinear & a,b,d is_collinear implies a,c,d is_collinear;

theorem 
  a,b,c is_collinear implies b,a,c is_collinear;

theorem 
  a,b,c is_collinear implies b,c,a is_collinear;

theorem 
  p<>q & a,b,p is_collinear & a,b,q is_collinear & p,q,r
  is_collinear implies a,b,r is_collinear;





definition
  let CLSP,a,b;
  func Line(a,b) -> set equals

  {p: a,b,p is_collinear};
end;

theorem 
  a in Line(a,b) & b in Line(a,b);

theorem 
  a,b,r is_collinear iff r in Line(a,b);





reserve i,j,k for Element of NAT;

definition
  let IT be non empty CollStr;
  attr IT is proper means


  ex a,b,c being Point of IT st not a,b,c is_collinear;
end;

registration
  cluster strict proper for CollSp;
end;

reserve CLSP for proper CollSp;
reserve a,b,c,p,q,r for Point of CLSP;

theorem 
  for p,q holds p<>q implies ex r st not p,q,r is_collinear;

definition
  let CLSP;
  mode LINE of CLSP -> set means


    ex a,b st a<>b & it=Line(a,b);
end;

reserve P,Q for LINE of CLSP;

theorem 
  a=b implies Line(a,b) = the carrier of CLSP;

theorem 
  for P ex a,b st a<>b & a in P & b in P;

theorem 
  a <> b implies ex P st a in P & b in P;

theorem 
  p in P & q in P & r in P implies p,q,r is_collinear;

theorem 
  P c= Q implies P = Q;

theorem 
  p<>q & p in P & q in P implies Line(p,q) c= P;

theorem 
  p<>q & p in P & q in P implies Line(p,q) = P;

theorem 
  p<>q & p in P & q in P & p in Q & q in Q implies P = Q;

theorem 
  P = Q or P misses Q or ex p st P /\ Q = {p};

theorem 
  a<>b implies Line(a,b) <> the carrier of CLSP;















begin

reserve OAS for OAffinSpace;
reserve a,a9,b,b9,c,c9,d,d1,d2,e1,e2,e3,e4,e5,e6,p,p9,q,r,x,y,z for Element of
  OAS;

definition
  let OAS;
  attr OAS is satisfying_Int_Par_Pasch means

  for a,b,c,d,p st not LIN p,b,c &
  Mid b,p,a & LIN p,c,d & b,c '||' d,a holds Mid c,p,d;
end;

definition
  let OAS;
  attr OAS is satisfying_Ext_Par_Pasch means

  for a,b,c,d,p st Mid p,b,c & LIN
  p,a,d & a,b '||' c,d & not LIN p,a,b holds Mid p,a,d;
end;

definition
  let OAS;
  attr OAS is satisfying_Gen_Par_Pasch means

  for a,b,c,a9,b9,c9 st not LIN a,b
,a9 & a,a9 '||' b,b9 & a,a9 '||' c,c9 & Mid a,b,c & LIN a9,b9,c9 holds Mid a9,
  b9,c9;
end;

definition
  let OAS;
  attr OAS is satisfying_Ext_Bet_Pasch means

  for a,b,c,d,x,y st Mid a,b,d &
  Mid b,x,c & not LIN a,b,c holds ex y st Mid a,y,c & Mid y,x,d;
end;

definition
  let OAS;
  attr OAS is satisfying_Int_Bet_Pasch means

  for a,b,c,d,x,y st Mid a,b,d &
  Mid a,x,c & not LIN a,b,c holds ex y st Mid b,y,c & Mid x,y,d;
end;

definition
  let OAS;
  attr OAS is Fanoian means

  for a,b,c,d st a,b // c,d & a,c // b,d & not LIN a
  ,b,c ex x st Mid a,x,d & Mid b,x,c;
end;

theorem 
  b,p // p,c & p<>c & b<>p implies ex d st a,p // p,d & a,b '||' c,
  d & c <>d & p<>d;

theorem 
  p,b // p,c & p<>c & b<>p implies ex d st p,a // p,d & a,b '||' c, d & c <>d;

theorem 
  p,b '||' p,c & p<>b implies ex d st p,a '||' p,d & a,b '||' c,d;

theorem 
  not LIN p,a,b & LIN p,b,c & LIN p,a,d1 & LIN p,a,d2 & a,b '||' c
  ,d1 & a,b '||' c,d2 implies d1=d2;

theorem 
  not LIN a,b,c & a,b '||' c,d1 & a,b '||' c,d2 & a,c '||' b,d1 &
  a,c '||' b,d2 implies d1=d2;

theorem 
  not LIN p,b,c & Mid b,p,a & LIN p,c,d & b,c '||' d,a implies Mid c,p,d;

theorem 
  OAS is satisfying_Int_Par_Pasch;

theorem 
  Mid p,b,c & LIN p,a,d & a,b '||' c,d & not LIN p,a,b implies Mid p,a,d;

theorem 
  OAS is satisfying_Ext_Par_Pasch;

theorem 
  not LIN a,b,a9 & a,a9 '||' b,b9 & a,a9 '||' c,c9 & Mid a,b,c &
  LIN a9,b9,c9 implies Mid a9,b9,c9;

theorem 
  OAS is satisfying_Gen_Par_Pasch;

theorem 
  not LIN p,a,b & a,p // p,a9 & b,p // p,b9 & a,b '||' a9,b9 implies a,b
  // b9,a9;

theorem 
  not LIN p,a,a9 & p,a // p,b & p,a9 // p,b9 & a,a9 '||' b,b9 implies a,
  a9 // b,b9;

theorem 
  not LIN p,a,b & p,a '||' b,c & p,b '||' a,c implies p,a // b,c & p,b // a,c;

theorem 
  Mid p,c,b & c,d // b,a & p,d // p,a & not LIN p,a,b & p<>c implies Mid p,d,a;

theorem 
  Mid p,d,a & c,d // b,a & p,c // p,b & not LIN p,a,b & p<>c implies Mid p,c,b;

theorem 
  not LIN p,a,b & p,b // p,c & b,a // c,d & p<>d implies not Mid a ,p,d;

theorem 
  p,b // p,c & b<>p implies ex x st p,a // p,x & b,a // c,x;

theorem 
  Mid p,c,b implies ex x st Mid p,x,a & b,a // c,x;

theorem 
  p<>b & Mid p,b,c implies ex x st Mid p,a,x & b,a // c,x;

theorem 
  not LIN p,a,b & Mid p,c,b implies ex x st Mid p,x,a & a,b // x,c;

theorem 
  ex x st a,x // b,c & a,b // x,c;

theorem 
  a,b // c,d & not LIN a,b,c implies ex x st Mid a,x,d & Mid b,x,c;

theorem 
  OAS is Fanoian;

theorem 
  a,b '||' c,d & a,c '||' b,d & not LIN a,b,c implies ex x st LIN x,a,d
  & LIN x,b,c;

theorem 
  a,b '||' c,d & not LIN a,b,c & LIN p,a,d & LIN p,b,c implies not LIN p ,a,b;

theorem 
  Mid a,b,d & Mid b,x,c & not LIN a,b,c implies ex y st Mid a,y,c & Mid y,x,d;

theorem 
  OAS is satisfying_Ext_Bet_Pasch;

theorem 
  Mid a,b,d & Mid a,x,c & not LIN a,b,c implies ex y st Mid b,y,c & Mid x,y,d;

theorem 
  OAS is satisfying_Int_Bet_Pasch;

theorem 
  Mid p,a,b & p,a // p9,a9 & not LIN p,a,p9 & LIN p9,a9,b9 & p,p9 // a,
  a9 & p,p9 // b,b9 implies Mid p9,a9,b9;














begin 

reserve x,y for Real;

definition
  func minreal-> BinOp of REAL means


  it.(x,y)=min(x,y);
  func maxreal-> BinOp of REAL means


  it.(x,y)=max(x,y);
end;

definition

  func Real_Lattice -> strict LattStr equals

  LattStr (# REAL, maxreal, minreal #);
end;

registration
  cluster the carrier of Real_Lattice -> real-membered;
end;

registration
  cluster Real_Lattice -> non empty;
end;

reserve a,b,c for Element of Real_Lattice;

registration
  let a,b be Element of Real_Lattice;
  identify a "\/" b with max(a,b);
  identify a "/\" b with min(a,b);
end;

registration
  cluster Real_Lattice -> Lattice-like;
end;

reserve p,q,r for Element of Real_Lattice;

theorem 
  maxreal.(p,q) = maxreal.(q,p);

theorem 
  minreal.(p,q) = minreal.(q,p);

theorem 
  maxreal.(p,(maxreal.(q,r)))=maxreal.((maxreal.(q,r)),p) &
maxreal.(p,(maxreal.(q,r)))=maxreal.((maxreal.(p,q)),r) & maxreal.(p,(maxreal.(
  q,r)))=maxreal.((maxreal.(q,p)),r) & maxreal.(p,(maxreal.(q,r)))=maxreal.((
  maxreal.(r,p)),q) & maxreal.(p,(maxreal.(q,r)))=maxreal.((maxreal.(r,q)),p) &
  maxreal.(p,(maxreal.(q,r)))=maxreal.((maxreal.(p,r)),q);

theorem 
  minreal.(p,(minreal.(q,r)))=minreal.((minreal.(q,r)),p) &
minreal.(p,(minreal.(q,r)))=minreal.((minreal.(p,q)),r) & minreal.(p,(minreal.(
  q,r)))=minreal.((minreal.(q,p)),r) & minreal.(p,(minreal.(q,r)))=minreal.((
  minreal.(r,p)),q) & minreal.(p,(minreal.(q,r)))=minreal.((minreal.(r,q)),p) &
  minreal.(p,(minreal.(q,r)))=minreal.((minreal.(p,r)),q);

theorem 
  maxreal.(minreal.(p,q),q)=q & maxreal.(q,minreal.(p,q))=q &
  maxreal.(q,minreal.(q,p))=q & maxreal.(minreal.(q,p),q)=q;

theorem 
  minreal.(q,maxreal.(q,p))=q & minreal.(maxreal.(p,q),q)=q &
  minreal.(q,maxreal.(p,q))=q & minreal.(maxreal.(q,p),q)=q;

theorem 
  minreal.(q,maxreal.(p,r))=maxreal.(minreal.(q,p),minreal.(q,r));

registration
  cluster Real_Lattice -> distributive;
end;

reserve A,B for non empty set;
reserve f,g,h for Element of Funcs(A,REAL);

definition
  let A;
  func maxfuncreal(A) -> BinOp of Funcs(A,REAL) means


  it.(f,g) = maxreal.:(f,g);
  func minfuncreal(A) -> BinOp of Funcs(A,REAL) means


  it.(f,g) = minreal.:(f,g);
end;

theorem 
  (maxfuncreal(A)).(f,g) = (maxfuncreal(A)).(g,f);

theorem 
  (minfuncreal(A)).(f,g) = (minfuncreal(A)).(g,f);

theorem 
  (maxfuncreal(A)).((maxfuncreal(A)).(f,g),h) =(maxfuncreal(A)).(f
  ,(maxfuncreal(A)).(g,h));

theorem 
  (minfuncreal(A)).((minfuncreal(A)).(f,g),h) =(minfuncreal(A)).(f
  ,(minfuncreal(A)).(g,h));

theorem 
  (maxfuncreal(A)).(f,(minfuncreal(A)).(f,g))=f;

theorem 
  (maxfuncreal(A)).((minfuncreal(A)).(f,g),f)=f;

theorem 
  (maxfuncreal(A)).((minfuncreal(A)).(g,f),f)=f;

theorem 
  (maxfuncreal(A)).(f,(minfuncreal(A)).(g,f))=f;

theorem 
  (minfuncreal(A)).(f,(maxfuncreal(A)).(f,g))=f;

theorem 
  (minfuncreal(A)).(f,(maxfuncreal(A)).(g,f))=f;

theorem 
  (minfuncreal(A)).((maxfuncreal(A)).(g,f),f)=f;

theorem 
  (minfuncreal(A)).((maxfuncreal(A)).(f,g),f)=f;

theorem 
  (minfuncreal(A)).(f,(maxfuncreal(A)).(g,h)) = (maxfuncreal(A)).(
  (minfuncreal(A)).(f,g),(minfuncreal(A)).(f,h));

definition

  let A;
  func RealFunc_Lattice A -> non empty strict LattStr equals

  LattStr (# Funcs(A,REAL), maxfuncreal A, minfuncreal A #);
end;

reserve L for non empty LattStr,
        p,q,r for Element of L;

registration
  let A;
  cluster RealFunc_Lattice A -> join-commutative
  join-associative meet-absorbing meet-commutative meet-associative
  join-absorbing for non empty LattStr;
end;

reserve p,q,r for Element of RealFunc_Lattice(A);

theorem 
  (maxfuncreal(A)).(p,q) = (maxfuncreal(A)).(q,p);

theorem 
  (minfuncreal(A)).(p,q) = (minfuncreal(A)).(q,p);

theorem 
  (maxfuncreal(A)).(p,((maxfuncreal(A)).(q,r))) =(maxfuncreal(A)).(((
  maxfuncreal(A)).(q,r)),p) & (maxfuncreal(A)).(p,((maxfuncreal(A)).(q,r))) =(
  maxfuncreal(A)).(((maxfuncreal(A)).(p,q)),r) & (maxfuncreal(A)).(p,((
  maxfuncreal(A)).(q,r))) =(maxfuncreal(A)).(((maxfuncreal(A)).(q,p)),r) & (
maxfuncreal(A)).(p,((maxfuncreal(A)).(q,r))) =(maxfuncreal(A)).(((maxfuncreal(A
)).(r,p)),q) & (maxfuncreal(A)).(p,((maxfuncreal(A)).(q,r))) =(maxfuncreal(A)).
(((maxfuncreal(A)).(r,q)),p) & (maxfuncreal(A)).(p,((maxfuncreal(A)).(q,r))) =(
  maxfuncreal(A)).(((maxfuncreal(A)).(p,r)),q);

theorem 
  (minfuncreal(A)).(p,((minfuncreal(A)).(q,r))) =(minfuncreal(A)).(((
  minfuncreal(A)).(q,r)),p) & (minfuncreal(A)).(p,((minfuncreal(A)).(q,r))) =(
  minfuncreal(A)).(((minfuncreal(A)).(p,q)),r) & (minfuncreal(A)).(p,((
  minfuncreal(A)).(q,r))) =(minfuncreal(A)).(((minfuncreal(A)).(q,p)),r) & (
minfuncreal(A)).(p,((minfuncreal(A)).(q,r))) =(minfuncreal(A)).(((minfuncreal(A
)).(r,p)),q) & (minfuncreal(A)).(p,((minfuncreal(A)).(q,r))) =(minfuncreal(A)).
(((minfuncreal(A)).(r,q)),p) & (minfuncreal(A)).(p,((minfuncreal(A)).(q,r))) =(
  minfuncreal(A)).(((minfuncreal(A)).(p,r)),q);

theorem 
  (maxfuncreal(A)).((minfuncreal(A)).(p,q),q)=q & (maxfuncreal(A)).(q,(
  minfuncreal(A)).(p,q))=q & (maxfuncreal(A)).(q,(minfuncreal(A)).(q,p))=q & (
  maxfuncreal(A)).((minfuncreal(A)).(q,p),q)=q;

theorem 
  (minfuncreal(A)).(q,(maxfuncreal(A)).(q,p))=q & (minfuncreal(A)).((
maxfuncreal(A)).(p,q),q)=q & (minfuncreal(A)).(q,(maxfuncreal(A)).(p,q))=q & (
  minfuncreal(A)).((maxfuncreal(A)).(q,p),q)=q;

theorem 
  (minfuncreal(A)).(q,(maxfuncreal(A)).(p,r)) =(maxfuncreal(A)).((
  minfuncreal(A)).(q,p),(minfuncreal(A)).(q,r));

theorem 
  RealFunc_Lattice(A) is D_Lattice;














begin

theorem 
  for a being Element of G_Real holds ex b being Element of G_Real st b + b = a
;

theorem 
  for a being Element of G_Real st a + a = 0.G_Real holds a = 0.G_Real;

definition
  let IT be non empty addLoopStr;
  attr IT is Two_Divisible means


  for a being Element of IT holds ex b being Element of IT st b + b = a;
end;

registration
  cluster G_Real -> Fanoian Two_Divisible;
end;

registration
  cluster strict Fanoian Two_Divisible add-associative right_zeroed
    right_complementable Abelian for non empty addLoopStr;
end;

definition
  mode Two_Divisible_Group is Two_Divisible add-associative right_zeroed
    right_complementable Abelian non empty addLoopStr;
end;

definition
  mode Uniquely_Two_Divisible_Group is Fanoian Two_Divisible add-associative
    right_zeroed right_complementable Abelian non empty addLoopStr;
end;

theorem 
  for AG being add-associative right_zeroed right_complementable Abelian
  non empty addLoopStr holds (AG is Uniquely_Two_Divisible_Group iff (for a
  being Element of AG holds (ex b being Element of AG st b + b = a)) & (for a
  being Element of AG st a + a = 0.AG holds a = 0.AG));

reserve ADG for Uniquely_Two_Divisible_Group;
reserve a,b,c,d,a9,b9,c9,p,q for Element of ADG;
reserve x,y for set;

notation
  let ADG be non empty addLoopStr;
  let a,b be Element of ADG;
  synonym a # b for a+b;
end;

definition
  let ADG be non empty addLoopStr;

  func CONGRD(ADG) -> Relation of [:the carrier of ADG,the carrier of ADG:]
  means


  for a,b,c,d being Element of ADG holds [[a,b],[c,d]] in it iff a # d = b # c;
end;

definition
  let ADG be non empty addLoopStr;
  func AV(ADG) -> strict AffinStruct equals

  AffinStruct(#the carrier of ADG,
    CONGRD(ADG)#);
end;

registration
  let ADG be non empty addLoopStr;
  cluster AV ADG -> non empty;
end;

theorem 
  the carrier of AV(ADG) = the carrier of ADG & the CONGR of AV(ADG) =
  CONGRD(ADG);

definition
  let ADG;
  let a,b,c,d;
  pred a,b ==> c,d means


  [[a,b],[c,d]] in the CONGR of AV(ADG);
end;

theorem 
  a,b ==> c,d iff a # d = b # c;

theorem 
  ex a,b being Element of G_Real st a<>b;

theorem 
  ex ADG st ex a,b st a<>b;

theorem 
  a,b ==> c,c implies a=b;

theorem 
  a,b ==> p,q & c,d ==> p,q implies a,b ==> c,d;

theorem 
  ex d st a,b ==> c,d;

theorem 
  a,b ==> a9,b9 & a,c ==> a9,c9 implies b,c ==> b9,c9;

theorem 
  ex b st a,b ==> b,c;

theorem 
  a,b ==> b,c & a,b9 ==> b9,c implies b=b9;

theorem 
  a,b ==> c,d implies a,c ==> b,d;

reserve AS for non empty AffinStruct;

theorem 
  (ex a,b being Element of ADG st a<>b) implies (ex a,b being
Element of AV(ADG) st a<>b) & (for a,b,c being Element of AV(ADG) st a,b // c,c
holds a=b) & (for a,b,c,d,p,q being Element of AV(ADG) st a,b // p,q & c,d // p
  ,q holds a,b // c,d) & (for a,b,c being Element of AV(ADG) ex d being Element
of AV(ADG) st a,b // c,d) & (for a,b,c,a9,b9,c9 being Element of AV(ADG) st a,b
// a9,b9 & a,c // a9,c9 holds b,c // b9,c9) & (for a,c being Element of AV(ADG)
  ex b being Element of AV(ADG) st a,b // b,c) & (for a,b,c,b9 being Element of
AV(ADG) st a,b // b,c & a,b9 // b9,c holds b = b9) & for a,b,c,d being Element
  of AV(ADG) st a,b // c,d holds a,c // b,d;

definition
  let IT be non empty AffinStruct;

  attr IT is AffVect-like means


  (for a,b,c being Element of IT st a,b
// c,c holds a=b) & (for a,b,c,d,p,q being Element of IT st a,b // p,q & c,d //
p,q holds a,b // c,d) & (for a,b,c being Element of IT ex d being Element of IT
st a,b // c,d) & (for a,b,c,a9,b9,c9 being Element of IT st a,b // a9,b9 & a,c
// a9,c9 holds b,c // b9,c9) & (for a,c being Element of IT ex b being Element
  of IT st a,b // b,c) & (for a,b,c,b9 being Element of IT st a,b // b,c & a,b9
// b9,c holds b = b9) & for a,b,c,d being Element of IT st a,b // c,d holds a,c
  // b,d;
end;

registration
  cluster strict AffVect-like for non trivial AffinStruct;
end;

definition
  mode AffVect is AffVect-like non trivial AffinStruct;
end;

theorem 
  for AS holds (ex a,b being Element of AS st a<>b) & (for a,b,c being
  Element of AS st a,b // c,c holds a=b) & (for a,b,c,d,p,q being Element of AS
  st a,b // p,q & c,d // p,q holds a,b // c,d) & (for a,b,c being Element of AS
ex d being Element of AS st a,b // c,d) & (for a,b,c,a9,b9,c9 being Element of
AS st a,b // a9,b9 & a,c // a9,c9 holds b,c // b9,c9) & (for a,c being Element
of AS ex b being Element of AS st a,b // b,c) & (for a,b,c,b9 being Element of
  AS st a,b // b,c & a,b9 // b9,c holds b = b9) & (for a,b,c,d being Element of
  AS st a,b // c,d holds a,c // b,d) iff AS is AffVect;

theorem 
  (ex a,b being Element of ADG st a<>b) implies AV(ADG) is AffVect;














begin

reserve A for non empty set,
  a,b,x,y,z,t for Element of A,
  f,g,h for Permutation of A;

definition
  let A be set, f,g be Permutation of A;
  redefine func g*f -> Permutation of A;
end;

theorem 
  ex x st f.x=y;

theorem 
  f.x=y iff (f").y=x;

definition
  let A,f,g;
  func f\g -> Permutation of A equals

  (g*f)*g";
end;

scheme 

  EXPermutation{A() -> non empty set,P[set,set]}: ex f being Permutation of A(
  ) st for x,y being Element of A() holds f.x=y iff P[x,y]
provided
 for x being Element of A() ex y being Element of A() st P[x,y] and
 for y being Element of A() ex x being Element of A() st P[x,y] and
 for x,y,x9 being Element of A() st P[x,y] & P[x9,y] holds x=x9 and
 for x,y,y9 being Element of A() st P[x,y] & P[x,y9] holds y=y9;

theorem 
  f.(f".x) = x & f".(f.x) = x;

theorem 
  f*(id A) = (id A)*f;

theorem 
  g*f=h*f or f*g=f*h implies g=h;

theorem 
  (f*g)\h = (f\h)*(g\h);

theorem 
  (f")\g = (f\g)";

theorem 
  f\(g*h) = (f\h)\g;

theorem 
  (id A)\f = id A;

theorem 
  f\(id A) = f;

theorem 
  f.a=a implies (f\g).(g.a)=g.a;

reserve R for Relation of [:A,A:];

definition
  let A,f,R;
  pred f is_FormalIz_of R means


  for x,y holds [[x,y],[f.x,f.y]] in R;
end;

theorem 
  R is_reflexive_in [:A,A:] implies id A is_FormalIz_of R;

theorem 
  R is_symmetric_in [:A,A:] & f is_FormalIz_of R implies f" is_FormalIz_of R;

theorem 
  R is_transitive_in [:A,A:] & f is_FormalIz_of R & g is_FormalIz_of R
  implies (f*g) is_FormalIz_of R;

theorem 
  (for a,b,x,y,z,t st [[x,y],[a,b]] in R & [[a,b],[z,t]] in R & a
  <>b holds [[x,y],[z,t]] in R) & (for x,y,z holds [[x,x],[y,z]] in R) & f
  is_FormalIz_of R & g is_FormalIz_of R implies f*g is_FormalIz_of R;

definition
  let A;
  let f;
  let R;
  pred f is_automorphism_of R means


  for x,y,z,t holds ([[x,y],[z,t]] in R iff [[f.x,f.y],[f.z,f.t]] in R);
end;

theorem 
  id A is_automorphism_of R;

theorem 
  f is_automorphism_of R implies f" is_automorphism_of R;

theorem 
  f is_automorphism_of R & g is_automorphism_of R implies g*f
  is_automorphism_of R;

theorem 
  R is_symmetric_in [:A,A:] & R is_transitive_in [:A,A:] & f
  is_FormalIz_of R implies f is_automorphism_of R;

theorem 
  (for a,b,x,y,z,t st [[x,y],[a,b]] in R & [[a,b],[z,t]] in R & a<>b
  holds [[x,y],[z,t]] in R) & (for x,y,z holds [[x,x],[y,z]] in R) & R
  is_symmetric_in [:A,A:] & f is_FormalIz_of R implies f is_automorphism_of R;

theorem 
  f is_FormalIz_of R & g is_automorphism_of R implies f\g is_FormalIz_of R;

reserve AS for non empty AffinStruct;

definition
  let AS;
  let f be Permutation of the carrier of AS;
  pred f is_DIL_of AS means


  f is_FormalIz_of the CONGR of AS;
end;

reserve a,b,x,y for Element of AS;

theorem 
  for f being Permutation of the carrier of AS holds (f is_DIL_of
  AS iff for a,b holds a,b // f.a,f.b );

definition
  let IT be non empty AffinStruct;
  attr IT is CongrSpace-like means


  (for x,y,z,t,a,b being Element of IT
st x,y // a,b & a,b // z,t & a<>b holds x,y // z,t) & (for x,y,z being Element
of IT holds x,x // y,z) & (for x,y,z,t being Element of IT st x,y // z,t holds
  z,t // x,y) & for x,y being Element of IT holds x,y // x,y;
end;

registration
  cluster strict CongrSpace-like for non empty AffinStruct;
end;

definition
  mode CongrSpace is CongrSpace-like non empty AffinStruct;
end;

reserve CS for CongrSpace;

theorem 
  id the carrier of CS is_DIL_of CS;

theorem 
  for f being Permutation of the carrier of CS st f is_DIL_of CS
  holds f" is_DIL_of CS;

theorem 
  for f,g being Permutation of the carrier of CS st f is_DIL_of CS
  & g is_DIL_of CS holds f*g is_DIL_of CS;

reserve OAS for OAffinSpace;
reserve a,b,c,d,p,q,r,x,y,z,t,u for Element of OAS;

theorem 
  OAS is CongrSpace-like;

reserve f,g for Permutation of the carrier of OAS;

definition
  let OAS;
  let f be Permutation of the carrier of OAS;
  attr f is positive_dilatation means


  f is_DIL_of OAS;
end;

theorem 
  for f being Permutation of the carrier of OAS holds (f is
  positive_dilatation iff for a,b holds a,b // f.a,f.b );

definition
  let OAS;
  let f be Permutation of the carrier of OAS;
  attr f is negative_dilatation means


  for a,b holds a,b // f.b,f.a;
end;

theorem 
  id the carrier of OAS is positive_dilatation;

theorem 
  for f being Permutation of the carrier of OAS st f is
  positive_dilatation holds f" is positive_dilatation;

theorem 
  for f,g being Permutation of the carrier of OAS st f is
positive_dilatation & g is positive_dilatation holds f*g is positive_dilatation
;

theorem 
  not ex f st f is negative_dilatation & f is positive_dilatation;

theorem 
  f is negative_dilatation implies f" is negative_dilatation;

theorem 
  f is positive_dilatation & g is negative_dilatation implies f*g is
  negative_dilatation & g*f is negative_dilatation;

definition
  let OAS;
  let f be Permutation of the carrier of OAS;
  attr f is dilatation means


  f is_FormalIz_of lambda(the CONGR of OAS);
end;

theorem 
  for f being Permutation of the carrier of OAS holds (f is
  dilatation iff for a,b holds a,b '||' f.a,f.b );

theorem 
  f is positive_dilatation or f is negative_dilatation implies f is dilatation;

theorem 
  for f being Permutation of the carrier of OAS st f is dilatation ex f9
being Permutation of the carrier of Lambda(OAS) st f=f9 & f9 is_DIL_of Lambda(
  OAS);

theorem 
  for f being Permutation of the carrier of Lambda(OAS) st f is_DIL_of
  Lambda(OAS) ex f9 being Permutation of the carrier of OAS st f=f9 & f9 is
  dilatation;

theorem 
  id the carrier of OAS is dilatation;

theorem 
  f is dilatation implies f" is dilatation;

theorem 
  f is dilatation & g is dilatation implies f*g is dilatation;

theorem 
  f is dilatation implies for a,b,c,d holds a,b '||' c,d iff f.a,f
  .b '||' f.c,f.d;

theorem 
  f is dilatation implies for a,b,c holds LIN a,b,c iff LIN f.a,f. b,f.c;

theorem 
  f is dilatation & LIN x,f.x,y implies LIN x,f.x,f.y;

theorem 
  a,b '||' c,d implies (a,c '||' b,d or ex x st LIN a,c,x & LIN b, d,x );

theorem 
  f is dilatation implies ((f=id the carrier of OAS or for x holds
  f.x<>x) iff for x,y holds x,f.x '||' y,f.y );

theorem 
  f is dilatation & f.a=a & f.b=b & not LIN a,b,x implies f.x=x;

theorem 
  f is dilatation & f.a=a & f.b=b & a<>b implies f=(id the carrier of OAS);

theorem 
  f is dilatation & g is dilatation & f.a=g.a & f.b=g.b implies a=b or f =g;

definition
  let OAS;
  let f be Permutation of the carrier of OAS;
  attr f is translation means


  f is dilatation & (f = id the carrier of OAS or for a holds a<>f.a);
end;

theorem 
  f is dilatation implies (f is translation iff for x,y holds x,f.
  x '||' y,f.y );

theorem 
  f is translation & g is translation & f.a=g.a & not LIN a,f.a,x
  implies f.x=g.x;

theorem 
  f is translation & g is translation & f.a=g.a implies f=g;

theorem 
  f is translation implies f" is translation;

theorem 
  f is translation & g is translation implies (f*g) is translation;

theorem 
  f is translation implies f is positive_dilatation;

theorem 
  f is dilatation & f.p=p & Mid q,p,f.q & not LIN p,q,x implies Mid x,p,f.x;

theorem 
  f is dilatation & f.p=p & Mid q,p,f.q & q<>p implies Mid x,p,f.x;

theorem 
  f is dilatation & f.p=p & q<>p & Mid q,p,f.q & not LIN p,x,y
  implies x,y // f.y,f.x;

theorem 
  f is dilatation & f.p=p & q<>p & Mid q,p,f.q & LIN p,x,y implies
  x,y // f.y,f.x;

theorem 
  f is dilatation & f.p=p & q<>p & Mid q,p,f.q implies f is negative_dilatation
;

theorem 
  f is dilatation & f.p=p & (for x holds p,x // p,f.x) implies for
  y,z holds y,z // f.y,f.z;

theorem 
  f is dilatation implies f is positive_dilatation or f is negative_dilatation;

reserve AFS for AffinSpace;
reserve a,b,c,d,d1,d2,p,x,y,z,t for Element of AFS;

theorem 
  AFS is CongrSpace-like;

theorem 
  Lambda(OAS) is CongrSpace;

reserve f,g for Permutation of the carrier of AFS;

definition
  let AFS;
  let f;
  attr f is dilatation means


  f is_DIL_of AFS;
end;

theorem 
  f is dilatation iff for a,b holds a,b // f.a,f.b;

theorem 
  id the carrier of AFS is dilatation;

theorem 
  f is dilatation implies f" is dilatation;

theorem 
  f is dilatation & g is dilatation implies (f*g) is dilatation;

theorem 
  f is dilatation implies for a,b,c,d holds a,b // c,d iff f.a,f.b // f.c,f.d;

theorem 
  f is dilatation implies for a,b,c holds LIN a,b,c iff LIN f.a,f.b,f.c;

theorem 
  f is dilatation & LIN x,f.x,y implies LIN x,f.x,f.y;

theorem 
  a,b // c,d implies (a,c // b,d or ex x st LIN a,c,x & LIN b,d,x );

theorem 
  f is dilatation implies ((f=id the carrier of AFS or for x holds
  f.x<>x) iff for x,y holds x,f.x // y,f.y );

theorem 
  f is dilatation & f.a=a & f.b=b & not LIN a,b,x implies f.x=x;

theorem 
  f is dilatation & f.a=a & f.b=b & a<>b implies f=id the carrier of AFS;

theorem 
  f is dilatation & g is dilatation & f.a=g.a & f.b=g.b implies a=b or f =g;

theorem 
  not LIN a,b,c & a,b // c,d1 & a,b // c,d2 & a,c // b,d1 & a,c //
  b,d2 implies d1=d2;

definition
  let AFS;
  let f;
  attr f is translation means


  f is dilatation & (f = id the carrier of AFS or for a holds a<>f.a );
end;

theorem 
  id the carrier of AFS is translation;

theorem 
  f is dilatation implies (f is translation iff for x,y holds x,f .x // y,f.y )
;

theorem 
  f is translation & g is translation & f.a=g.a & not LIN a,f.a,x
  implies f.x=g.x;

theorem 
  f is translation & g is translation & f.a=g.a implies f=g;

theorem 
  f is translation implies f" is translation;

theorem 
  f is translation & g is translation implies (f*g) is translation;

definition
  let AFS;
  let f;
  attr f is collineation means

  f is_automorphism_of the CONGR of AFS;
end;

theorem 
  f is collineation iff for x,y,z,t holds (x,y // z,t iff f.x,f.y // f.z,f.t);

theorem 
  f is collineation implies (LIN x,y,z iff LIN f.x,f.y,f.z);

theorem 
  f is collineation & g is collineation implies f" is collineation & f*g
  is collineation & id the carrier of AFS is collineation;

reserve A,C,K for Subset of AFS;

theorem 
  a in A implies f.a in f.:A;

theorem 
  x in f.:A iff ex y st y in A & f.y=x;

theorem 
  f.:A=f.:C implies A=C;

theorem 
  f is collineation implies f.:(Line(a,b))=Line(f.a,f.b);

theorem 
  f is collineation & K is being_line implies f.:K is being_line;

theorem 
  f is collineation & A // C implies f.:A // f.:C;

reserve AFP for AffinPlane,
  A,C,D,K for Subset of AFP,
  a,b,c,d,p,x,y for Element of AFP,
  f for Permutation of the carrier of AFP;

theorem 
  (for A st A is being_line holds f.:A is being_line) implies f is collineation
;

theorem 
  f is collineation & K is being_line & (for x st x in K holds f.x=x) &
  not p in K & f.p=p implies f=id the carrier of AFP;














begin

canceled 4;

reserve B,C,D,C9,D9 for Category;



definition
  let B,C;
  let c be Object of C;
  func B --> c -> Functor of B,C equals

  (the carrier' of B) --> (id c);
end;

theorem 
  for c being Object of C, b being Object of B holds (Obj (B --> c)).b = c;

definition
  let C,D;
  func Funct(C,D) -> set means


  for x being set holds x in it iff x is Functor of C,D;
end;

registration
  let C,D;
  cluster Funct(C,D) -> non empty;
end;

definition
  let C,D;
  mode FUNCTOR-DOMAIN of C,D -> non empty set means


    for x being Element of it holds x is Functor of C,D;
end;

definition
  let C,D;
  let F be FUNCTOR-DOMAIN of C,D;
  redefine mode Element of F -> Functor of C,D;
end;

definition
  let A be non empty set;
  let C,D;
  let F be FUNCTOR-DOMAIN of C,D, T be Function of A,F, x be Element of A;
  redefine func T.x -> Element of F;
end;

definition
  let C,D;
  redefine func Funct(C,D) -> FUNCTOR-DOMAIN of C,D;
end;



definition
  let C;
  mode Subcategory of C -> Category means


    the carrier of it c= the carrier of C &
     (for a,b being Object of it, a9,b9 being Object of C
        st a = a9 & b = b9
    holds Hom(a,b) c= Hom(a9,b9)) & the Comp of it c= the Comp of C &
    for a being Object of it, a9 being Object of C st a = a9
      holds id a = id a9;
end;

registration
  let C;
  cluster strict for Subcategory of C;
end;

reserve E for Subcategory of C;

theorem 
  for e being Object of E holds e is Object of C;

theorem 
  the carrier' of E c= the carrier' of C;

theorem 
  for f being Morphism of E holds f is Morphism of C;

theorem 
  for f being (Morphism of E), f9 being Morphism of C st f = f9
  holds dom f = dom f9 & cod f = cod f9;

theorem 
  for a,b being Object of E, a9,b9 being Object of C,f being Morphism of
  a, b st a = a9 & b = b9 & Hom(a,b)<>{} holds f is Morphism of a9,b9;

theorem 
  for f,g being (Morphism of E), f9,g9 being Morphism of C st f =
  f9 & g = g9 & dom g = cod f holds g(*)f = g9(*)f9;

theorem 
  C is Subcategory of C;

theorem 
  id E is Functor of E,C;

definition
  let C,E;
  func incl(E) -> Functor of E,C equals

  id E;
end;

theorem 
  for a being Object of E holds (Obj incl E).a = a;

theorem 
  for a being Object of E holds (incl E).a = a;

theorem 
  incl E is faithful;

theorem 
  incl E is full iff for a,b being Object of E, a9,b9 being Object
  of C st a = a9 & b = b9 holds Hom(a,b) = Hom(a9,b9);

definition let D;
  let C be Subcategory of D;
  attr C is full means

  for c1,c2 being Object of C, d1,d2 being Object of D
   st c1 = d1 & c2 = d2
  holds Hom(c1,c2) = Hom(d1,d2);
end;

registration let D;
 cluster full for Subcategory of D;
end;

theorem 
  E is full iff incl(E) is full;

theorem 
  for O being non empty Subset of the carrier of C holds union{Hom
  (a,b) where a is Object of C,b is Object of C: a in O & b in O} is non empty
  Subset of the carrier' of C;

theorem 
  for O being non empty Subset of the carrier of C, M being non
empty set st M = union{Hom(a,b) where a is Object of C,b is Object of C: a in O
& b in O} holds (the Source of C)|M is Function of M,O & (the Target of C)|M is
Function of M,O & (the Comp of C)||M is PartFunc of [:M,M:],M;

registration
  let O, M be non empty set, d,c being Function of M,O, p being PartFunc of [:
  M,M:],M;
  cluster CatStr(#O,M,d,c,p#) -> non void non empty;
end;

theorem 
  for O being non empty Subset of the carrier of C, M being non empty
set, d,c being Function of M,O, p being PartFunc of [:M,M:],M, i being Function
of O,M st M = union{Hom(a,b) where a is Object of C,b is Object of C: a in O &
b in O} & d = (the Source of C)|M & c = (the Target of C)|M & p = (the Comp of
C)||M
  holds CatStr(#O,M,d,c,p#) is full Subcategory of C;

theorem 
  for O being non empty Subset of the carrier of C, M being non empty
  set , d,c being Function of M,O, p being PartFunc of [:M,M:],M
  st CatStr(#O,M,d,c,p#) is full Subcategory of C
  holds M =
union{Hom(a,b) where a is Object of C,b is Object of C: a in O & b in O} & d =
(the Source of C)|M & c = (the Target of C)|M & p = (the Comp of C)||M;



definition
  let X1,X2,Y1,Y2 be non empty set;
  let f1 be Function of X1,Y1;
  let f2 be Function of X2,Y2;
  redefine func [:f1,f2:] -> Function of [:X1,X2:],[:Y1,Y2:];
end;

definition
  let A,B be non empty set;
  let f be PartFunc of [:A,A:],A;
  let g be PartFunc of [:B,B:],B;
  redefine func |:f,g:| -> PartFunc of [:[:A,B:],[:A,B:]:],[:A,B:];
end;

definition
  let C,D;
  func [:C,D:] -> Category equals

  CatStr (# [:the carrier of C,the carrier of D:],
     [:the carrier' of C,the carrier' of D:],
     [:the Source of C,the Source of D:],
     [:the Target of C,the Target of D:],
     |:the Comp of C, the Comp of D:| #);
end;

theorem 
  the carrier of [:C,D:] = [:the carrier of C,the carrier of D:] & the
  carrier' of [:C,D:] = [:the carrier' of C,the carrier' of D:] & the Source of
  [:C,D:] = [:the Source of C,the Source of D:] & the Target of [:C,D:] = [:the
Target of C,the Target of D:] & the Comp of [:C,D:] = |:the Comp of C, the Comp
  of D:|;

definition
  let C,D;
  let c be Object of C;
  let d be Object of D;
  redefine func [c,d] -> Object of [:C,D:];
end;

canceled;

theorem 
  for cd being Object of [:C,D:] ex c being Object of C, d being Object
  of D st cd = [c,d];

definition
  let C,D;
  let f be Morphism of C;
  let g be Morphism of D;
  redefine func [f,g] -> Morphism of [:C,D:];
end;

canceled;

theorem 
  for fg being Morphism of [:C,D:] ex f being (Morphism of C), g being
  Morphism of D st fg = [f,g];

theorem 
  for f being Morphism of C for g being Morphism of D
   holds dom [f,g] = [dom f,dom g] & cod [f,g] = [cod f,cod g];

theorem 
  for f,f9 being Morphism of C for g,g9 being Morphism of D st dom
  f9 = cod f & dom g9 = cod g holds [f9,g9](*)[f,g] = [f9(*)f,g9(*)g];

theorem 
  for f,f9 being Morphism of C for g,g9 being Morphism of D st dom
  [f9,g9] = cod [f,g] holds [f9,g9](*)[f,g] = [f9(*)f,g9(*)g];

theorem 
  for c being Object of C, d being Object of D holds id [c,d] = [id c,id d];

theorem 
  for c,c9 being Object of C, d,d9 being Object of D
   holds Hom([c,d],[c9,d9]) = [:Hom(c,c9),Hom(d,d9):];

theorem 
  for c,c9 being Object of C, f being Morphism of c,c9, d,d9 being
  Object of D, g being Morphism of d,d9 st Hom(c,c9) <> {} & Hom(d,d9) <> {}
  holds [f,g] is Morphism of [c,d],[c9,d9];



definition
  let C,C9,D;
  let S being Functor of [:C,C9:],D;
  let m be Morphism of C;
  let m9 be Morphism of C9;
  redefine func S.(m,m9) -> Morphism of D;
end;

theorem 
  for S being Functor of [:C,C9:],D, c being Object of C holds (
  curry S).(id c) is Functor of C9,D;

theorem 
  for S being Functor of [:C,C9:],D, c9 being Object of C9 holds (
  curry' S).(id c9) is Functor of C,D;



definition
  let C,C9,D;
  let S be Functor of [:C,C9:],D, c be Object of C;
  func S?-c -> Functor of C9,D equals

  (curry S).(id c);
end;

theorem 
  for S being Functor of [:C,C9:],D, c being Object of C, f being
  Morphism of C9 holds (S?-c).f = S.(id c,f);

theorem 
  for S being Functor of [:C,C9:],D, c being Object of C, c9 being
  Object of C9 holds (Obj S?-c).c9 = (Obj S).(c,c9);

definition
  let C,C9,D;
  let S be Functor of [:C,C9:],D, c9 be Object of C9;
  func S-?c9 -> Functor of C,D equals

  (curry' S).(id c9);
end;

theorem 
  for S being Functor of [:C,C9:],D, c9 being Object of C9, f being
  Morphism of C holds (S-?c9).f = S.(f,id c9);

theorem 
  for S being Functor of [:C,C9:],D, c being Object of C, c9 being
  Object of C9 holds (Obj S-?c9).c = (Obj S).(c,c9);

theorem 
  for L being Function of the carrier of C,Funct(B,D), M being Function
of the carrier of B,Funct(C,D) st ( for c being Object of C,b being Object of B
  holds (M.b).(id c) = (L.c).(id b) ) & ( for f being Morphism of B for g being
Morphism of C
  holds ((M.(cod f)).g)(*)((L.(dom g)).f) = ((L.(cod g)).f)(*)((M.(dom
  f)).g) ) ex S being Functor of [:B,C:],D st for f being Morphism of B for g
  being Morphism of C holds S.(f,g) = ((L.(cod g)).f)(*)((M.(dom f)).g);

theorem 
  for L being Function of the carrier of C,Funct(B,D),
      M being Function of the carrier of B,Funct(C,D)
   st ex S being Functor of [:B,C:],D st
    for c being Object of C,b being Object of B
     holds S-?c = L.c & S?-b = M.b
  for f being Morphism of B for g being Morphism of C
   holds ((M.(cod f)).g)(*)((L.(dom g)).f) =
     ((L.(cod g)).f)(*)((M.(dom f)).g);

definition
  let C,D;
  func pr1(C,D) -> Functor of [:C,D:],C equals

   pr1(the carrier' of C,the carrier' of D);
  func pr2(C,D) -> Functor of [:C,D:],D equals

   pr2(the carrier' of C,the carrier' of D);
end;

canceled 2;

theorem 
  for c being Object of C, d being Object of D holds (Obj pr1(C,D)).(c,d ) = c;

theorem 
  for c being Object of C, d being Object of D holds (Obj pr2(C,D)).(c,d ) = d;

definition
  let C,D,D9;
  let T be Functor of C,D, T9 be Functor of C,D9;
  redefine func <:T,T9:> -> Functor of C,[:D,D9:];
end;

canceled;

theorem 
  for T being Functor of C,D, T9 being Functor of C,D9, c being Object
  of C holds (Obj <:T,T9:>).c = [(Obj T).c,(Obj T9).c];

theorem 
  for T being Functor of C,D, T9 being Functor of C9,D9 holds [:T,
  T9:] = <:T*pr1(C,C9),T9*pr2(C,C9):>;

definition
  let C,C9,D,D9;
  let T be Functor of C,D, T9 be Functor of C9,D9;
  redefine func [:T,T9:] -> Functor of [:C,C9:],[:D,D9:];
end;

canceled;

theorem 
  for T being Functor of C,D, T9 being Functor of C9,D9, c being Object
of C, c9 being Object of C9 holds (Obj [:T,T9:]).(c,c9) = [(Obj T).c,(Obj T9).
  c9];














begin

reserve AS for AffinSpace,
  a,b,c,d,p,q,r,s,x for Element of AS;

definition
  let AS;
  attr AS is Fanoian means


  for a,b,c,d st a,b // c,d & a,c // b,d & a,d // b,c holds LIN a,b,c;
end;

theorem 
  (ex a,b,c st LIN a,b,c & a<>b & a<>c & b<>c) implies for p,q
  holds ex r st LIN p,q,r & p<>r & q<>r;

reserve AFP for AffinPlane,
  a,a9,b,b9,c,c9,d,p,p9,q,q9,r,x,x9,y,y9,z for Element of AFP,
  A,C,P for Subset of AFP,
  f,g,h,f1,f2 for Permutation of the carrier of AFP;

theorem 
  AFP is Fanoian & a,b // c,d & a,c // b,d & not LIN a,b,c implies
  ex p st LIN b,c,p & LIN a,d,p;

theorem 
  f is translation & not LIN a,f.a,x & a,f.a // x,y & a,x // f.a,y
  implies y=f.x;

theorem 
  AFP is translational iff for a,a9,b,c,b9,c9 st not LIN a,a9,b &
  not LIN a,a9,c & a,a9 // b,b9 & a,a9 // c,c9 & a,b // a9,b9 & a,c // a9,c9
  holds b,c // b9,c9;

theorem 
  ex f st f is translation & f.a=a;

theorem 
  (for p,q,r st p<>q & LIN p,q,r holds r = p or r = q) & a,b // p,q
  & a,p // b,q & not LIN a,b,p implies a,q // b,p;

theorem 
  AFP is translational implies ex f st f is translation & f.a=b;

theorem 
  (for a,b ex f st f is translation & f.a=b) implies AFP is translational;

theorem 
  f is translation & g is translation & not LIN a,f.a,g.a implies f*g=g*f;

theorem 
  AFP is translational & f is translation & g is translation implies f*g=g*f;

theorem 
  f is translation & g is translation & p,f.p // p,g.p implies p,f
  .p // p,(f*g).p;

theorem 
  AFP is Fanoian & AFP is translational & f is translation implies ex g
  st g is translation & g*g=f;

theorem 
  AFP is Fanoian & f is translation & f*f=id the carrier of AFP
  implies f=id the carrier of AFP;

theorem 
  AFP is translational & AFP is Fanoian & f1 is translation & f2 is
  translation & g=f1*f1 & g=f2*f2 implies f1=f2;














begin

reserve V for RealLinearSpace;
reserve p,q,r,u,v,w,y,u1,v1,w1 for Element of V;
reserve a,b,c,d,a1,b1,c1,a2,b2,c2,a3,b3,e,f for Real;

definition
  let V,p,q;

  pred are_Prop p,q means


  ex a,b st a*p = b*q & a<>0 & b<>0;
  reflexivity;
  symmetry;
end;

theorem 
  are_Prop p,q iff ex a st a<>0 & p = a*q;

theorem 
  are_Prop p,u & are_Prop u,q implies are_Prop p,q;

theorem 
  are_Prop p,0.V iff p = 0.V;

definition
  let V,u,v,w;
  pred u,v,w are_LinDep means


  ex a,b,c st a*u + b*v + c*w = 0.V & (a<>0 or b<>0 or c <>0);
end;

theorem 
  are_Prop u,u1 & are_Prop v,v1 & are_Prop w,w1 & u,v,w are_LinDep
  implies u1,v1,w1 are_LinDep;

theorem 
  u,v,w are_LinDep implies u,w,v are_LinDep & v,u,w are_LinDep & w
  ,v,u are_LinDep & w,u,v are_LinDep & v,w,u are_LinDep;

theorem 
  v is not zero & w is not zero & not are_Prop v,w implies (v,w,u
  are_LinDep iff ex a,b st u = a*v + b*w);

theorem 
  not are_Prop p,q & a1*p + b1*q = a2*p + b2*q & p is not zero & q is
  not zero implies a1 = a2 & b1 = b2;

theorem 
  not u,v,w are_LinDep & a1*u + b1*v + c1*w = a2*u + b2*v + c2*w implies
  a1 = a2 & b1 = b2 & c1 = c2;

theorem 
  not are_Prop p,q & u = a1*p + b1*q & v = a2*p + b2*q & a1*b2 -
a2*b1=0 & p is not zero & q is not zero implies (are_Prop u,v or u = 0.V or v =
  0.V);

theorem 
  (u = 0.V or v = 0.V or w = 0.V) implies u,v,w are_LinDep;

theorem 
  (are_Prop u,v or are_Prop w,u or are_Prop v,w) implies w,u,v are_LinDep;

theorem 
  not u,v,w are_LinDep implies u is not zero & v is not zero & w
  is not zero & not are_Prop u,v & not are_Prop v,w & not are_Prop w,u;

theorem 
  p + q = 0.V implies are_Prop p,q;

theorem 
  not are_Prop p,q & p,q,u are_LinDep & p,q,v are_LinDep & p,q,w
  are_LinDep & p is not zero & q is not zero implies u,v,w are_LinDep;

theorem 
  not u,v,w are_LinDep & u,v,p are_LinDep & v,w,q are_LinDep implies ex
  y st u,w,y are_LinDep & p,q,y are_LinDep & y is not zero;

theorem 
  not are_Prop p,q & p is not zero & q is not zero implies for u,v ex y
  st y is not zero & u,v,y are_LinDep & not are_Prop u,y & not are_Prop v,y;

theorem 
  not p,q,r are_LinDep implies for u,v st u is not zero & v is not zero
  & not are_Prop u,v ex y st y is not zero & not u,v,y are_LinDep;

theorem 
  u,v,q are_LinDep & w,y,q are_LinDep & u,w,p are_LinDep & v,y,p
are_LinDep & u,y,r are_LinDep & v,w,r are_LinDep & p,q,r are_LinDep & p is not
  zero & q is not zero & r is not zero implies (u,v,y are_LinDep or u,v,w
  are_LinDep or u,w,y are_LinDep or v,w,y are_LinDep);

reserve x,y,z for set;

definition

  let V;
  func Proportionality_as_EqRel_of V -> Equivalence_Relation of NonZero V
  means


  for x,y holds [x,y] in it iff (x in NonZero V & y in NonZero V &
  ex u,v being Element of V st x=u & y=v & are_Prop u,v );
end;

theorem 
  [x,y] in Proportionality_as_EqRel_of V implies x is Element of V & y
  is Element of V;

theorem 
  [u,v] in Proportionality_as_EqRel_of V iff u is not zero & v is
  not zero & are_Prop u,v;

definition
  let V;
  let v;
  func Dir(v) -> Subset of NonZero V equals

  Class(Proportionality_as_EqRel_of
  V,v);
end;

definition
  let V;
  func ProjectivePoints(V) means


  ex Y being Subset-Family of NonZero V
  st Y = Class Proportionality_as_EqRel_of V & it = Y;
end;

registration
  cluster strict non trivial for RealLinearSpace;
end;

reserve V for non trivial RealLinearSpace;
reserve p,q,r,u,v,w for Element of V;

registration
  let V;
  cluster ProjectivePoints V -> non empty;
end;

theorem 
  p is not zero implies Dir(p) is Element of ProjectivePoints(V);

theorem 
  p is not zero & q is not zero implies (Dir(p) = Dir(q) iff are_Prop p,q);

definition

  let V;
  func ProjectiveCollinearity(V) -> Relation3 of ProjectivePoints(V) means


   for
 x,y,z being set holds ([x,y,z] in it iff ex p,q,r st x = Dir(p) & y =
  Dir(q) & z = Dir(r) & p is not zero & q is not zero & r is not zero & p,q,r
  are_LinDep);
end;

definition
  let V;
  func ProjectiveSpace(V) -> strict CollStr equals

  CollStr (# ProjectivePoints
    (V),ProjectiveCollinearity(V) #);
end;

registration
  let V;
  cluster ProjectiveSpace V -> non empty;
end;

theorem 
  for V holds (the carrier of ProjectiveSpace(V)) = ProjectivePoints(V)
  & (the Collinearity of ProjectiveSpace(V)) = ProjectiveCollinearity(V);

theorem 
  [x,y,z] in the Collinearity of ProjectiveSpace(V) implies ex p,q,r st
x = Dir(p) & y = Dir(q) & z = Dir(r) & p is not zero & q is not zero & r is not
  zero & p,q,r are_LinDep;

theorem 
  u is not zero & v is not zero & w is not zero implies ([Dir(u),Dir(v),
  Dir(w)] in the Collinearity of ProjectiveSpace(V) iff u,v,w are_LinDep);

theorem 
  x is Element of ProjectiveSpace(V) iff ex u st u is not zero & x = Dir (u);














begin

reserve V for RealLinearSpace,
  o,p,q,r,s,u,v,w,y,y1,u1,v1,w1,u2,v2,w2 for Element of V,
  a,b,c,d,a1,b1,c1,d1,a2,b2,c2,d2,a3,b3,c3,d3 for Real,
  z for set;

theorem 
  (for a,b,c st a*u + b*v + c*w = 0.V holds a = 0 & b = 0 & c = 0)
implies u is not zero & v is not zero & w is not zero & not u,v,w are_LinDep &
  not are_Prop u,v;

theorem 
  for u,v,u1,v1 holds ((for a,b,a1,b1 st a*u + b*v + a1*u1 + b1*v1
  = 0.V holds a=0 & b=0 & a1=0 & b1=0) implies u is not zero & v is not zero &
not are_Prop u,v & u1 is not zero & v1 is not zero & not are_Prop u1,v1 & not u
  ,v,u1 are_LinDep & not u1,v1,u are_LinDep);

theorem 
  (for w ex a,b,c st w = a*p + b*q + c*r) & (for a,b,c st a*p + b*q
  + c*r = 0.V holds a = 0 & b = 0 & c = 0) implies for u,u1 ex y st p,q,y
  are_LinDep & u,u1,y are_LinDep & y is not zero;

theorem 
  (for w ex a,b,c,d st w = a*p + b*q + c*r + d*s) & (for a,b,c,d st
a*p + b*q + c*r + d*s = 0.V holds a = 0 & b = 0 & c = 0 & d = 0) implies for u,
  v st u is not zero & v is not zero ex y,w st u,v,w are_LinDep & q,r,y
  are_LinDep & p,w,y are_LinDep & y is not zero & w is not zero;

theorem 
  (for a,b,a1,b1 st a*u + b*v + a1*u1 + b1*v1 = 0.V holds a=0 & b=0
  & a1=0 & b1=0) implies not ex y st y is not zero & u,v,y are_LinDep & u1,v1,y
  are_LinDep;

definition
  let V,u,v,w;
  pred u,v,w are_Prop_Vect means


  u is not zero & v is not zero & w is not zero;
end;

definition
  let V,u,v,w,u1,v1,w1;
  pred u,v,w,u1,v1,w1 lie_on_a_triangle means


  u,v,w1 are_LinDep & u,w, v1 are_LinDep & v,w,u1 are_LinDep;
end;

definition
  let V,o,u,v,w,u2,v2,w2;
  pred o,u,v,w,u2,v2,w2 are_perspective means


  o,u,u2 are_LinDep & o,v, v2 are_LinDep & o,w,w2 are_LinDep;
end;

theorem 
  o,u,u2 are_LinDep & not are_Prop o,u & not are_Prop o,u2 & not
are_Prop u,u2 & o,u,u2 are_Prop_Vect implies (ex a1,b1 st b1*u2=o+a1*u & a1<>0
  & b1<>0) & ex a2,c2 st u2=c2*o+a2*u & c2<>0 & a2<>0;

theorem 
  p,q,r are_LinDep & not are_Prop p,q & p,q,r are_Prop_Vect implies
  ex a,b st r = a*p + b*q;

theorem 
  o is not zero & u,v,w are_Prop_Vect & u2,v2,w2 are_Prop_Vect & u1
  ,v1,w1 are_Prop_Vect & o,u,v,w,u2,v2,w2 are_perspective & not are_Prop o,u2 &
not are_Prop o,v2 & not are_Prop o,w2 & not are_Prop u,u2 & not are_Prop v,v2 &
  not are_Prop w,w2 & not o,u,v are_LinDep & not o,u,w are_LinDep & not o,v,w
  are_LinDep & u,v,w,u1,v1,w1 lie_on_a_triangle & u2,v2,w2,u1,v1,w1
  lie_on_a_triangle implies u1,v1,w1 are_LinDep;

definition
  let V,o,u,v,w,u2,v2,w2;
  pred o,u,v,w,u2,v2,w2 lie_on_an_angle means


  not o,u,u2 are_LinDep & o
  ,u,v are_LinDep & o,u,w are_LinDep & o,u2,v2 are_LinDep & o,u2,w2 are_LinDep;
end;

definition
  let V,o,u,v,w,u2,v2,w2;
  pred o,u,v,w,u2,v2,w2 are_half_mutually_not_Prop means


  not are_Prop o
,v & not are_Prop o,w & not are_Prop o,v2 & not are_Prop o,w2 & not are_Prop u,
v & not are_Prop u,w & not are_Prop u2,v2 & not are_Prop u2,w2 & not are_Prop v
  ,w & not are_Prop v2,w2;
end;

theorem 
  o is not zero & u,v,w are_Prop_Vect & u2,v2,w2 are_Prop_Vect & u1
  ,v1,w1 are_Prop_Vect & o,u,v,w,u2,v2,w2 lie_on_an_angle & o,u,v,w,u2,v2,w2
are_half_mutually_not_Prop & u,v2,w1 are_LinDep & u2,v,w1 are_LinDep & u,w2,v1
  are_LinDep & w,u2,v1 are_LinDep & v,w2,u1 are_LinDep & w,v2,u1 are_LinDep
  implies u1,v1,w1 are_LinDep;

reserve A for non empty set;
reserve f,g,h,f1 for Element of Funcs(A,REAL);
reserve x1,x2,x3,x4 for Element of A;

theorem 
  ex f st f.x1 = 1 & for z st z in A & z<>x1 holds f.z = 0;

theorem 
  x1<>x2 & x1<>x3 & x2<>x3 & f.x1 = 1 & (for z st z in A holds(z<>
x1 implies f.z = 0)) & g.x2 = 1 & (for z st z in A holds(z<>x2 implies g.z = 0)
) & h.x3 = 1 & (for z st z in A holds(z<>x3 implies h.z = 0)) implies for a,b,c
  st (RealFuncAdd(A)).((RealFuncAdd(A)). ((RealFuncExtMult(A)).[a,f],(
RealFuncExtMult(A)).[b,g]), (RealFuncExtMult(A)).[c,h]) = RealFuncZero(A) holds
  a=0 & b=0 & c = 0;

theorem 
  x1<>x2 & x1<>x3 & x2<>x3 implies ex f,g,h st for a,b,c st (RealFuncAdd
(A)).((RealFuncAdd(A)). ((RealFuncExtMult(A)).[a,f],(RealFuncExtMult(A)).[b,g])
  , (RealFuncExtMult(A)).[c,h]) = RealFuncZero(A) holds a=0 & b=0 & c = 0;

theorem 
  A = {x1,x2,x3} & x1<>x2 & x1<>x3 & x2<>x3 & f.x1 = 1 & (for z st
z in A holds (z<>x1 implies f.z = 0)) & g.x2 = 1 & (for z st z in A holds (z<>
x2 implies g.z = 0)) & h.x3 = 1 & (for z st z in A holds (z<>x3 implies h.z = 0
  )) implies for h9 being Element of Funcs(A,REAL) holds ex a,b,c st h9 = (
RealFuncAdd(A)).((RealFuncAdd(A)). ((RealFuncExtMult(A)).[a,f],(RealFuncExtMult
  (A)).[b,g]), (RealFuncExtMult(A)).[c,h]);

theorem 
  A = {x1,x2,x3} & x1<>x2 & x1<>x3 & x2<>x3 implies ex f,g,h st for h9
  being Element of Funcs(A,REAL) holds ex a,b,c st h9 = (RealFuncAdd(A)).((
  RealFuncAdd(A)). ((RealFuncExtMult(A)).[a,f],(RealFuncExtMult(A)).[b,g]), (
  RealFuncExtMult(A)).[c,h]);

theorem 
  A = {x1,x2,x3} & x1<>x2 & x1<>x3 & x2<>x3 implies ex f,g,h st (
for a,b,c st (RealFuncAdd(A)).((RealFuncAdd(A)). ((RealFuncExtMult(A)).[a,f],(
RealFuncExtMult(A)).[b,g]), (RealFuncExtMult(A)).[c,h]) = RealFuncZero(A) holds
a=0 & b=0 & c = 0) & for h9 being Element of Funcs(A,REAL) holds ex a,b,c st h9
  = (RealFuncAdd(A)).((RealFuncAdd(A)). ((RealFuncExtMult(A)).[a,f],(
  RealFuncExtMult(A)).[b,g]), (RealFuncExtMult(A)).[c,h]);

theorem 
  ex V being non trivial RealLinearSpace st ex u,v,w being Element
  of V st (for a,b,c st a*u + b*v + c*w = 0.V holds a=0 & b=0 & c = 0) & for y
  being Element of V ex a,b,c st y = a*u + b*v + c*w;

theorem 
  x1<>x2 & x1<>x3 & x1<>x4 & x2<>x3 & x2<>x4 & x3<>x4 & f.x1 = 1 &
  (for z st z in A holds(z<>x1 implies f.z = 0)) & g.x2 = 1 & (for z st z in A
holds(z<>x2 implies g.z = 0)) & h.x3 = 1 & (for z st z in A holds(z<>x3 implies
h.z = 0)) & f1.x4 = 1 & (for z st z in A holds(z<>x4 implies f1.z = 0)) implies
  for a,b,c,d st (RealFuncAdd(A)).((RealFuncAdd(A)).((RealFuncAdd(A)). ((
RealFuncExtMult(A)).[a,f],(RealFuncExtMult(A)).[b,g]), (RealFuncExtMult(A)).[c,
h]),(RealFuncExtMult(A)).[d,f1]) = RealFuncZero(A) holds a=0 & b=0 & c = 0 & d=
  0;

theorem 
  x1<>x2 & x1<>x3 & x1<>x4 & x2<>x3 & x2<>x4 & x3<>x4 implies ex f,g,h,
  f1 st for a,b,c,d st (RealFuncAdd(A)).((RealFuncAdd(A)).((RealFuncAdd(A)). ((
RealFuncExtMult(A)).[a,f],(RealFuncExtMult(A)).[b,g]), (RealFuncExtMult(A)).[c,
h]),(RealFuncExtMult(A)).[d,f1]) = RealFuncZero(A) holds a = 0 & b = 0 & c = 0
  & d = 0;

theorem 
  A = {x1,x2,x3,x4} & x1<>x2 & x1<>x3 & x1<>x4 & x2<>x3 & x2<>x4 &
x3<>x4 & f.x1 = 1 & (for z st z in A holds(z<>x1 implies f.z = 0)) & g.x2 = 1 &
  (for z st z in A holds(z<>x2 implies g.z = 0)) & h.x3 = 1 & (for z st z in A
  holds(z<>x3 implies h.z = 0)) & f1.x4 = 1 & (for z st z in A holds(z<>x4
implies f1.z = 0)) implies for h9 being Element of Funcs(A,REAL) holds ex a,b,c
  ,d st h9 = (RealFuncAdd(A)).((RealFuncAdd(A)).((RealFuncAdd(A)). ((
RealFuncExtMult(A)).[a,f],(RealFuncExtMult(A)).[b,g]), (RealFuncExtMult(A)).[c,
  h]),(RealFuncExtMult(A)).[d,f1]);

theorem 
  A = {x1,x2,x3,x4} & x1<>x2 & x1<>x3 & x1<>x4 & x2<>x3 & x2<>x4 & x3<>
x4 implies ex f,g,h,f1 st for h9 being Element of Funcs(A,REAL) holds ex a,b,c,
  d st h9 = (RealFuncAdd(A)).((RealFuncAdd(A)).((RealFuncAdd(A)). ((
RealFuncExtMult(A)).[a,f],(RealFuncExtMult(A)).[b,g]), (RealFuncExtMult(A)).[c,
  h]),(RealFuncExtMult(A)).[d,f1]);

theorem 
  A = {x1,x2,x3,x4} & x1<>x2 & x1<>x3 & x1<>x4 & x2<>x3 & x2<>x4 &
x3<>x4 implies ex f,g,h,f1 st (for a,b,c,d st (RealFuncAdd(A)).((RealFuncAdd(A)
).((RealFuncAdd(A)). ((RealFuncExtMult(A)).[a,f],(RealFuncExtMult(A)).[b,g]), (
RealFuncExtMult(A)).[c,h]),(RealFuncExtMult(A)).[d,f1]) = RealFuncZero(A) holds
a = 0 & b = 0 & c = 0 & d = 0) & for h9 being Element of Funcs(A,REAL) holds ex
  a,b,c,d st h9 = (RealFuncAdd(A)).((RealFuncAdd(A)).((RealFuncAdd(A)). ((
RealFuncExtMult(A)).[a,f],(RealFuncExtMult(A)).[b,g]), (RealFuncExtMult(A)).[c,
  h]),(RealFuncExtMult(A)).[d,f1]);

theorem 
  ex V being non trivial RealLinearSpace st ex u,v,w,u1 being
Element of V st (for a,b,c,d st a*u + b*v + c*w + d*u1 = 0.V holds a = 0 & b =
0 & c = 0 & d = 0) & for y being Element of V ex a,b,c,d st y = a*u + b*v + c*w
  + d*u1;

definition
  let IT be RealLinearSpace;
  attr IT is up-3-dimensional means


  ex u,v,w1 being Element of IT st
  for a,b,c st a*u + b*v + c*w1 = 0.IT holds a = 0 & b = 0 & c = 0;
end;

registration
  cluster up-3-dimensional for RealLinearSpace;
end;

registration
  cluster up-3-dimensional -> non trivial for RealLinearSpace;
end;

definition
  let CS be non empty CollStr;
  redefine attr CS is reflexive means


  for p,q,r being Element of CS
  holds p,q,p is_collinear & p,p,q is_collinear & p,q,q is_collinear;
  redefine attr CS is transitive means


  for p,q,r,r1,r2 being Element of CS st p
<>q & p,q,r is_collinear & p,q,r1 is_collinear & p,q,r2 is_collinear holds r,r1
  ,r2 is_collinear;
end;

definition
  let IT be non empty CollStr;
  attr IT is Vebleian means


  for p,p1,p2,r,r1 being Element of IT st p,
p1,r is_collinear & p1,p2,r1 is_collinear ex r2 being Element of IT st p,p2,r2
  is_collinear & r,r1,r2 is_collinear;
  attr IT is at_least_3rank means


  for p,q being Element of IT ex r
  being Element of IT st p<>r & q<>r & p,q,r is_collinear;
end;

reserve V for non trivial RealLinearSpace;
reserve u,v,w,y,u1,v1,w1,u2,w2 for Element of V;
reserve p,p1,p2,p3,q,q1,q2,q3,r,r1,r2,r3 for Element of ProjectiveSpace(V);

theorem 
  p,q,r is_collinear iff ex u,v,w st p = Dir(u) & q = Dir(v) & r =
  Dir(w) & u is not zero & v is not zero & w is not zero & u,v,w are_LinDep;

registration
  let V;
  cluster ProjectiveSpace V -> reflexive transitive;
end;

theorem 
  p,q,r is_collinear implies p,r,q is_collinear & q,p,r
  is_collinear & r,q,p is_collinear & r,p,q is_collinear & q,r,p is_collinear;

registration
  let V;
  cluster ProjectiveSpace(V) -> Vebleian;
end;

registration
  let V be up-3-dimensional RealLinearSpace;
  cluster ProjectiveSpace(V) -> proper;
end;

theorem 
  (ex u,v st for a,b st a*u + b*v = 0.V holds a = 0 & b = 0 )
  implies ProjectiveSpace(V) is at_least_3rank;

registration
  let V be up-3-dimensional RealLinearSpace;
  cluster ProjectiveSpace(V) -> at_least_3rank;
end;

registration
  cluster transitive reflexive proper Vebleian at_least_3rank for non empty
    CollStr;
end;

definition
  mode CollProjectiveSpace is reflexive transitive Vebleian at_least_3rank
    proper non empty CollStr;
end;

definition
  let IT be CollProjectiveSpace;
  attr IT is Fanoian means


  for p1,r2,q,r1,q1,p,r being Element of IT
holds (p1,r2,q is_collinear & r1,q1,q is_collinear & p1,r1,p is_collinear & r2,
  q1,p is_collinear & p1,q1,r is_collinear & r2,r1,r is_collinear & p,q,r
is_collinear implies (p1,r2,q1 is_collinear or p1,r2,r1 is_collinear or p1,r1,
  q1 is_collinear or r2,r1,q1 is_collinear));
  attr IT is Desarguesian means

  for o,p1,p2,p3,q1,q2,q3,r1,r2,r3 being Element
  of IT st o<>q1 & p1<>q1 & o<>q2 & p2<>q2 & o<>q3 & p3<>q3 & not o,p1,p2
  is_collinear & not o,p1,p3 is_collinear & not o,p2,p3 is_collinear & p1,p2,r3
  is_collinear & q1,q2,r3 is_collinear & p2,p3,r1 is_collinear & q2,q3,r1
  is_collinear & p1,p3,r2 is_collinear & q1,q3,r2 is_collinear & o,p1,q1
  is_collinear & o,p2,q2 is_collinear & o,p3,q3 is_collinear holds r1,r2,r3
  is_collinear;
  attr IT is Pappian means

  for o,p1,p2,p3,q1,q2,q3,r1,r2,r3 being Element of
IT st o<>p2 & o<>p3 & p2<>p3 & p1<>p2 & p1<>p3 & o<>q2 & o<>q3 & q2<>q3 & q1<>
  q2 & q1<>q3 & not o,p1,q1 is_collinear & o,p1,p2 is_collinear & o,p1,p3
  is_collinear & o,q1,q2 is_collinear & o,q1,q3 is_collinear & p1,q2,r3
  is_collinear & q1,p2,r3 is_collinear & p1,q3,r2 is_collinear & p3,q1,r2
  is_collinear & p2,q3,r1 is_collinear & p3,q2,r1 is_collinear holds r1,r2,r3
  is_collinear;
end;

definition
  let IT be CollProjectiveSpace;
  attr IT is 2-dimensional means


  for p,p1,q,q1 being Element of IT ex
  r being Element of IT st p,p1,r is_collinear & q,q1,r is_collinear;
end;

notation
  let IT be CollProjectiveSpace;
  antonym IT is up-3-dimensional for IT is 2-dimensional;
end;

definition
  let IT be CollProjectiveSpace;
  attr IT is at_most-3-dimensional means


  for p,p1,q,q1,r2 being
  Element of IT ex r,r1 being Element of IT st p,q,r is_collinear & p1,q1,r1
  is_collinear & r2,r,r1 is_collinear;
end;

theorem 
  p1,r2,q is_collinear & r1,q1,q is_collinear & p1,r1,p
  is_collinear & r2,q1,p is_collinear & p1,q1,r is_collinear & r2,r1,r
  is_collinear & p,q,r is_collinear implies (p1,r2,q1 is_collinear or p1,r2,r1
  is_collinear or p1,r1,q1 is_collinear or r2,r1,q1 is_collinear);

registration
  let V be up-3-dimensional RealLinearSpace;

  cluster ProjectiveSpace V -> Fanoian Desarguesian Pappian;
end;

theorem 
  (ex u,v,w st (for a,b,c st a*u + b*v + c*w = 0.V holds a=0 & b=0
  & c = 0) & (for y ex a,b,c st y = a*u + b*v + c*w)) implies ex x1,x2 being
  Element of ProjectiveSpace(V) st (x1<>x2 & for r1,r2 ex q st x1,x2,q
  is_collinear & r1,r2,q is_collinear);

theorem 
  (ex x1,x2 being Element of ProjectiveSpace(V) st (x1<>x2 & for
r1,r2 ex q st x1,x2,q is_collinear & r1,r2,q is_collinear)) implies for p,p1,q,
  q1 ex r st p,p1,r is_collinear & q,q1,r is_collinear;

theorem 
  (ex u,v,w st (for a,b,c st a*u + b*v + c*w = 0.V holds a=0 & b=0
  & c = 0) & (for y ex a,b,c st y = a*u + b*v + c*w)) implies ex CS being
  CollProjectiveSpace st CS = ProjectiveSpace(V) & CS is 2-dimensional;

theorem 
  (ex y,u,v,w st (for w1 ex a,b,a1,b1 st w1 = a*y + b*u + a1*v +
b1*w) & (for a,b,a1,b1 st a*y + b*u + a1*v + b1*w = 0.V holds a=0 & b=0 & a1=0
& b1=0)) implies ex p,q1,q2 st not p,q1,q2 is_collinear & for r1,r2 ex q3,r3 st
  r1,r2,r3 is_collinear & q1,q2,q3 is_collinear & p,r3,q3 is_collinear;

reserve x,z,x1,y1,z1,x2,x3,y2,z2,p4,q4 for Element of ProjectiveSpace(V);

theorem 
  ProjectiveSpace(V) is proper at_least_3rank & (ex p,q1,q2 st not
p,q1,q2 is_collinear & (for r1,r2 ex q3,r3 st r1,r2,r3 is_collinear & q1,q2,q3
  is_collinear & p,r3,q3 is_collinear)) implies ex CS being CollProjectiveSpace
  st CS = ProjectiveSpace(V) & CS is at_most-3-dimensional;

theorem 
  (ex y,u,v,w st (for w1 ex a,b,c,c1 st w1 = a*y + b*u + c*v + c1*
  w) & (for a,b,a1,b1 st a*y + b*u + a1*v + b1*w = 0.V holds a=0 & b=0 & a1=0 &
b1=0)) implies ex CS being CollProjectiveSpace st CS = ProjectiveSpace(V) & CS
  is at_most-3-dimensional;

theorem 
  (ex u,v,u1,v1 st (for a,b,a1,b1 st a*u + b*v + a1*u1 + b1*v1 =
0.V holds a=0 & b=0 & a1=0 & b1=0)) implies ex CS being CollProjectiveSpace st
  CS = ProjectiveSpace(V) & CS is non 2-dimensional;

theorem 
  (ex u,v,u1,v1 st (for w ex a,b,a1,b1 st w = a*u + b*v + a1*u1 +
b1*v1) & (for a,b,a1,b1 st a*u + b*v + a1*u1 + b1*v1 = 0.V holds a=0 & b=0 & a1
=0 & b1=0)) implies ex CS being CollProjectiveSpace st CS = ProjectiveSpace(V)
  & CS is up-3-dimensional at_most-3-dimensional;

registration
  cluster strict Fanoian Desarguesian Pappian 2-dimensional
    for CollProjectiveSpace;
  cluster strict Fanoian Desarguesian Pappian at_most-3-dimensional
    up-3-dimensional for CollProjectiveSpace;
end;

definition
  mode CollProjectivePlane is 2-dimensional CollProjectiveSpace;
end;

theorem 
  for CS being non empty CollStr holds CS is 2-dimensional
  CollProjectiveSpace iff (CS is at_least_3rank proper CollSp & for p,p1,q,q1
  being Element of CS ex r being Element of CS st p,p1,r is_collinear & q,q1,r
  is_collinear);














begin

reserve x,y,X,Y,Z for set;
reserve a,b for Real;
reserve k for Element of NAT;
reserve V for RealLinearSpace;
reserve W1,W2,W3 for Subspace of V;
reserve v,v1,v2,u for VECTOR of V;
reserve A,B,C for Subset of V;
reserve T for finite Subset of V;
reserve L,L1,L2 for Linear_Combination of V;
reserve l for Linear_Combination of A;
reserve F,G,H for FinSequence of the carrier of V;
reserve f,g for Function of the carrier of V, REAL;
reserve p,q,r for FinSequence;
reserve M for non empty set;
reserve CF for Choice_Function of M;

theorem 
  Sum(L1 + L2) = Sum(L1) + Sum(L2);

theorem 
  Sum(a * L) = a * Sum(L);

theorem 
  Sum(- L) = - Sum(L);

theorem 
  Sum(L1 - L2) = Sum(L1) - Sum(L2);

definition
  let V;
  let A;
  attr A is linearly-independent means


  for l st Sum(l) = 0.V holds Carrier(l) = {};
end;

notation
  let V;
  let A;
  antonym A is linearly-dependent for A is linearly-independent;
end;

theorem 
  A c= B & B is linearly-independent implies A is linearly-independent;

theorem 
  A is linearly-independent implies not 0.V in A;

theorem 
  {}(the carrier of V) is linearly-independent;

registration
  let V;
  cluster linearly-independent for Subset of V;
end;

theorem 
  {v} is linearly-independent iff v <> 0.V;

theorem 
  {0.V} is linearly-dependent;

theorem 
  {v1,v2} is linearly-independent implies v1 <> 0.V & v2 <> 0.V;

theorem 
  {v,0.V} is linearly-dependent & {0.V,v} is linearly-dependent;

theorem 
  v1 <> v2 & {v1,v2} is linearly-independent iff v2 <> 0.V & for a
  holds v1 <> a * v2;

theorem 
  v1 <> v2 & {v1,v2} is linearly-independent iff for a,b st a * v1 + b *
  v2 = 0.V holds a = 0 & b = 0;

definition
  let V;
  let A;
  func Lin(A) -> strict Subspace of V means


  the carrier of it = {Sum(l) : not contradiction};
end;

theorem 
  x in Lin(A) iff ex l st x = Sum(l);

theorem 
  x in A implies x in Lin(A);

reserve l0 for Linear_Combination of {}(the carrier of V);

theorem 
  Lin({}(the carrier of V)) = (0).V;

theorem 
  Lin(A) = (0).V implies A = {} or A = {0.V};

theorem 
  for W being strict Subspace of V holds A = the carrier of W
  implies Lin(A) = W;

theorem 
  for V being strict RealLinearSpace,A being Subset of V holds A = the
  carrier of V implies Lin(A) = V;

theorem 
  A c= B implies Lin(A) is Subspace of Lin(B);

theorem 
  for V being strict RealLinearSpace,A,B being Subset of V holds Lin(A)
  = V & A c= B implies Lin(B) = V;

theorem 
  Lin(A \/ B) = Lin(A) + Lin(B);

theorem 
  Lin(A /\ B) is Subspace of Lin(A) /\ Lin(B);

theorem 
  A is linearly-independent implies ex B st A c= B & B is
  linearly-independent & Lin(B) = the RLSStruct of V;

theorem 
  Lin(A) = V implies ex B st B c= A & B is linearly-independent & Lin(B) = V;

definition
  let V be RealLinearSpace;
  mode Basis of V -> Subset of V means


    it is linearly-independent & Lin (it) = the RLSStruct of V;
end;

reserve I for Basis of V;

theorem 
  for V being strict RealLinearSpace,A being Subset of V holds A is
  linearly-independent implies ex I being Basis of V st A c= I;

theorem 
  Lin(A) = V implies ex I st I c= A;





theorem 
  not {} in M implies dom CF = M;

theorem 
  x in (0).V iff x = 0.V;

theorem 
  W1 is Subspace of W3 implies W1 /\ W2 is Subspace of W3;

theorem 
  W1 is Subspace of W2 & W1 is Subspace of W3 implies W1 is Subspace of
  W2 /\ W3;

theorem 
  W1 is Subspace of W3 & W2 is Subspace of W3 implies W1 + W2 is
  Subspace of W3;

theorem 
  W1 is Subspace of W2 implies W1 is Subspace of W2 + W3;

theorem 
  f (#) (F ^ G) = (f (#) F) ^ (f (#) G);














begin

reserve x for set;
reserve G for non empty 1-sorted;
reserve A for Subset of G;

theorem 
  G is finite implies A is finite;

reserve y,y1,y2,Y,Z for set;
reserve k for Nat;
reserve G for Group;
reserve a,g,h for Element of G;
reserve A for Subset of G;

definition
  let G,A;
  func A" -> Subset of G equals

  {g" : g in A};
  involutiveness;
end;

theorem 
  x in A" iff ex g st x = g" & g in A;

theorem 
  {g}" = {g"};

theorem 
  {g,h}" = {g",h"};

theorem 
  ({}(the carrier of G))" = {};

theorem 
  ([#](the carrier of G))" = the carrier of G;

theorem 
  A <> {} iff A" <> {};

registration
  let G;
  let A be empty Subset of G;
  cluster A" -> empty;
end;

registration
  let G;
  let A be non empty Subset of G;
  cluster A" -> non empty;
end;

reserve G for non empty multMagma,
  A,B,C for Subset of G;
reserve a,b,g,g1,g2,h,h1,h2 for Element of G;

definition
  let G;
  let A,B;
  func A * B -> Subset of G equals

  {g * h : g in A & h in B};
end;

definition
  let G be commutative non empty multMagma;
  let A,B be Subset of G;
  redefine func A * B;
  commutativity;
end;

theorem 
  x in A * B iff ex g,h st x = g * h & g in A & h in B;

theorem 
  A <> {} & B <> {} iff A * B <> {};

theorem 
  G is associative implies A * B * C = A * (B * C);

theorem 
  for G being Group, A,B being Subset of G holds (A * B)" = B" * A";

theorem 
  A * (B \/ C) = A * B \/ A * C;

theorem 
  (A \/ B) * C = A * C \/ B * C;

theorem 
  A * (B /\ C) c= (A * B) /\ (A * C);

theorem 
  (A /\ B) * C c= (A * C) /\ (B * C);

theorem 
  {}(the carrier of G) * A = {} & A * {}(the carrier of G) = {};

theorem 
  for G being Group, A being Subset of G holds A <> {} implies [#]
  (the carrier of G) * A = the carrier of G & A * [#](the carrier of G) = the
  carrier of G;

theorem 
  {g} * {h} = {g * h};

theorem 
  {g} * {g1,g2} = {g * g1,g * g2};

theorem 
  {g1,g2} * {g} = {g1 * g,g2 * g};

theorem 
  {g,h} * {g1,g2} = {g * g1, g * g2, h * g1, h * g2};

theorem 
  for G being Group, A being Subset of G holds (for g1,g2 being
Element of G st g1 in A & g2 in A holds g1 * g2 in A) & (for g being Element of
  G st g in A holds g" in A) implies A * A = A;

theorem 
  for G being Group, A being Subset of G holds (for g being
  Element of G st g in A holds g" in A) implies A" = A;

theorem 
  (for a,b st a in A & b in B holds a * b = b * a) implies A * B = B * A;

theorem 
  G is commutative Group implies A * B = B * A;

theorem 
  for G being commutative Group, A,B being Subset of G holds (A * B)" = A" * B"
;

definition
  let G,g,A;
  func g * A -> Subset of G equals

  {g} * A;
  func A * g -> Subset of G equals

  A * {g};
end;

theorem 
  x in g * A iff ex h st x = g * h & h in A;

theorem 
  x in A * g iff ex h st x = h * g & h in A;

theorem 
  G is associative implies g * A * B = g * (A * B);

theorem 
  G is associative implies A * g * B = A * (g * B);

theorem 
  G is associative implies A * B * g = A * (B * g);

theorem 
  G is associative implies g * h * A = g * (h * A);

theorem 
  G is associative implies g * A * h = g * (A * h);

theorem 
  G is associative implies A * g * h = A * (g * h);

theorem 
  {}(the carrier of G) * a = {} & a * {}(the carrier of G) = {};

reserve G for Group-like non empty multMagma;
reserve h,g,g1,g2 for Element of G;
reserve A for Subset of G;

theorem 
  for G being Group, a being Element of G holds [#](the carrier of G) *
  a = the carrier of G & a * [#](the carrier of G) = the carrier of G;

theorem 
  1_G * A = A & A * 1_G = A;

theorem 
  G is commutative Group implies g * A = A * g;

definition
  let G be Group-like non empty multMagma;
  mode Subgroup of G -> Group-like non empty multMagma means


    the
    carrier of it c= the carrier of G & the multF of it = (the multF of G)||the
    carrier of it;
end;

reserve H for Subgroup of G;
reserve h,h1,h2 for Element of H;

theorem 
  G is finite implies H is finite;

theorem 
  x in H implies x in G;

theorem 
  h in G;

theorem 
  h is Element of G;

theorem 
  h1 = g1 & h2 = g2 implies h1 * h2 = g1 * g2;

registration
  let G be Group;
  cluster -> associative for Subgroup of G;
end;

reserve G,G1,G2,G3 for Group;
reserve a,a1,a2,b,b1,b2,g,g1,g2 for Element of G;
reserve A,B for Subset of G;
reserve H,H1,H2,H3 for Subgroup of G;
reserve h,h1,h2 for Element of H;

theorem 
  1_H = 1_G;

theorem 
  1_H1 = 1_H2;

theorem 
  1_G in H;

theorem 
  1_H1 in H2;

theorem 
  h = g implies h" = g";

theorem 
  inverse_op(H) = inverse_op(G) | the carrier of H;

theorem 
  g1 in H & g2 in H implies g1 * g2 in H;

theorem 
  g in H implies g" in H;

registration
  let G;
  cluster strict for Subgroup of G;
end;

theorem 
  A <> {} & (for g1,g2 st g1 in A & g2 in A holds g1 * g2 in A) &
(for g st g in A holds g" in A) implies ex H being strict Subgroup of G st the
  carrier of H = A;

theorem 
  G is commutative Group implies H is commutative;

registration
  let G be commutative Group;
  cluster -> commutative for Subgroup of G;
end;

theorem 
  G is Subgroup of G;

theorem 
  G1 is Subgroup of G2 & G2 is Subgroup of G1 implies the
  multMagma of G1 = the multMagma of G2;

theorem 
  G1 is Subgroup of G2 & G2 is Subgroup of G3 implies G1 is Subgroup of G3;

theorem 
  the carrier of H1 c= the carrier of H2 implies H1 is Subgroup of H2;

theorem 
  (for g st g in H1 holds g in H2) implies H1 is Subgroup of H2;

theorem 
  the carrier of H1 = the carrier of H2 implies the multMagma of
  H1 = the multMagma of H2;

theorem 
  (for g holds g in H1 iff g in H2) implies the multMagma of H1 =
  the multMagma of H2;

definition
  let G;
  let H1,H2 be strict Subgroup of G;
  redefine pred H1 = H2 means

  for g holds g in H1 iff g in H2;
end;

theorem 
  for G being Group, H being Subgroup of G st the carrier of G c=
  the carrier of H holds the multMagma of H = the multMagma of G;

theorem 
  (for g being Element of G holds g in H) implies the multMagma of
  H = the multMagma of G;

definition
  let G;
  func (1).G -> strict Subgroup of G means


  the carrier of it = {1_G};
end;

definition
  let G;
  func (Omega).G -> strict Subgroup of G equals

  the multMagma of G;
 projectivity;
end;

theorem 
  (1).H = (1).G;

theorem 
  (1).H1 = (1).H2;

theorem 
  (1).G is Subgroup of H;

theorem 
  for G being strict Group, H being Subgroup of G holds H is Subgroup of
  (Omega).G;

theorem 
  for G being strict Group holds G is Subgroup of (Omega).G;

theorem 
  (1).G is finite;

registration
  let G;
  cluster (1).G -> finite;
  cluster strict finite for Subgroup of G;
end;

registration
  cluster strict finite for Group;
end;

registration
  let G be finite Group;
  cluster -> finite for Subgroup of G;
end;

theorem 
  card (1).G = 1;

theorem 
  for H being strict finite Subgroup of G holds card H = 1 implies H = (1).G;

theorem 
  card H c= card G;

theorem 
  for G being finite Group, H being Subgroup of G holds card H <= card G;

theorem 
  for G being finite Group, H being Subgroup of G holds card G = card H
  implies the multMagma of H = the multMagma of G;

definition
  let G,H;
  func carr(H) -> Subset of G equals

  the carrier of H;
end;

theorem 
  g1 in carr(H) & g2 in carr(H) implies g1 * g2 in carr(H);

theorem 
  g in carr(H) implies g" in carr(H);

theorem 
  carr(H) * carr(H) = carr(H);

theorem 
  carr(H)" = carr H;

theorem 
  (carr H1 * carr H2 = carr H2 * carr H1 implies ex H being strict
Subgroup of G st the carrier of H = carr H1 * carr H2) & ((ex H st the carrier
  of H = carr H1 * carr H2) implies carr H1 * carr H2 = carr H2 * carr H1);

theorem 
  G is commutative Group implies ex H being strict Subgroup of G st the
  carrier of H = carr(H1) * carr(H2);

definition
  let G,H1,H2;
  func H1 /\ H2 -> strict Subgroup of G means


  the carrier of it = carr (H1) /\ carr(H2);
end;

theorem 
  (for H being Subgroup of G st H = H1 /\ H2 holds the carrier of
  H = (the carrier of H1) /\ (the carrier of H2)) & for H being strict Subgroup
  of G holds the carrier of H = (the carrier of H1) /\ (the carrier of H2)
  implies H = H1 /\ H2;

theorem 
  carr(H1 /\ H2) = carr(H1) /\ carr(H2);

theorem 
  x in H1 /\ H2 iff x in H1 & x in H2;

theorem 
  for H being strict Subgroup of G holds H /\ H = H;

definition
  let G,H1,H2;
  redefine func H1 /\ H2;
  commutativity;
end;

theorem 
  H1 /\ H2 /\ H3 = H1 /\ (H2 /\ H3);

theorem 
  (1).G /\ H = (1).G & H /\ (1).G = (1).G;

theorem 
  for G being strict Group, H being strict Subgroup of G holds H /\
  (Omega).G = H & (Omega).G /\ H = H;

theorem 
  for G being strict Group holds (Omega).G /\ (Omega).G = G;

theorem 
  H1 /\ H2 is Subgroup of H1 & H1 /\ H2 is Subgroup of H2;

theorem 
  for H1 being Subgroup of G holds H1 is Subgroup of H2 iff the
  multMagma of (H1 /\ H2) = the multMagma of H1;

theorem 
  H1 is Subgroup of H2 implies H1 /\ H3 is Subgroup of H2;

theorem 
  H1 is Subgroup of H2 & H1 is Subgroup of H3 implies H1 is Subgroup of
  H2 /\ H3;

theorem 
  H1 is Subgroup of H2 implies H1 /\ H3 is Subgroup of H2 /\ H3;

theorem 
  H1 is finite or H2 is finite implies H1 /\ H2 is finite;

definition
  let G,H,A;
  func A * H -> Subset of G equals

  A * carr H;
  func H * A -> Subset of G equals

  carr H * A;
end;

theorem 
  x in A * H iff ex g1,g2 st x = g1 * g2 & g1 in A & g2 in H;

theorem 
  x in H * A iff ex g1,g2 st x = g1 * g2 & g1 in H & g2 in A;

theorem 
  A * B * H = A * (B * H);

theorem 
  A * H * B = A * (H * B);

theorem 
  H * A * B = H * (A * B);

theorem 
  A * H1 * H2 = A * (H1 * carr H2);

theorem 
  H1 * A * H2 = H1 * (A * H2);

theorem 
  H1 * carr(H2) * A = H1 * (H2 * A);

theorem 
  G is commutative Group implies A * H = H * A;

definition
  let G,H,a;
  func a * H -> Subset of G equals

  a * carr(H);
  func H * a -> Subset of G equals

  carr(H) * a;
end;

theorem 
  x in a * H iff ex g st x = a * g & g in H;

theorem 
  x in H * a iff ex g st x = g * a & g in H;

theorem 
  a * b * H = a * (b * H);

theorem 
  a * H * b = a * (H * b);

theorem 
  H * a * b = H * (a * b);

theorem 
  a in a * H & a in H * a;

theorem 
  1_G * H = carr(H) & H * 1_G = carr(H);

theorem 
  (1).G * a = {a} & a * (1).G = {a};

theorem 
  a * (Omega).G = the carrier of G & (Omega).G * a = the carrier of G;

theorem 
  G is commutative Group implies a * H = H * a;

theorem 
  a in H iff a * H = carr(H);

theorem 
  a * H = b * H iff b" * a in H;

theorem 
  a * H = b * H iff a * H meets b * H;

theorem 
  a * b * H c= (a * H) * (b * H);

theorem 
  carr(H) c= (a * H) * (a" * H) & carr(H) c= (a" * H) * (a * H);

theorem 
  a |^ 2 * H c= (a * H) * (a * H);

theorem 
  a in H iff H * a = carr(H);

theorem 
  H * a = H * b iff b * a" in H;

theorem 
  H * a = H * b iff H * a meets H * b;

theorem 
  H * a * b c= (H * a) * (H * b);

theorem 
  carr(H) c= (H * a) * (H * a") & carr(H) c= (H * a") * (H * a);

theorem 
  H * (a |^ 2) c= (H * a) * (H * a);

theorem 
  a * (H1 /\ H2) = (a * H1) /\ (a * H2);

theorem 
  (H1 /\ H2) * a = (H1 * a) /\ (H2 * a);

theorem 
  ex H1 being strict Subgroup of G st the carrier of H1 = a * H2 * a";

theorem 
  a * H,b * H are_equipotent;

theorem 
  a * H,H * b are_equipotent;

theorem 
  H * a,H * b are_equipotent;

theorem 
  carr(H),a * H are_equipotent & carr(H),H * a are_equipotent;

theorem 
  card(H) = card(a * H) & card(H) = card(H * a);

theorem 
  for H being finite Subgroup of G ex B,C being finite set st B =
  a * H & C = H * a & card H = card B & card H = card C;

definition
  let G,H;
  func Left_Cosets H -> Subset-Family of G means


  A in it iff ex a st A = a * H;
  func Right_Cosets H -> Subset-Family of G means


  A in it iff ex a st A = H * a;
end;

theorem 
  G is finite implies Right_Cosets H is finite & Left_Cosets H is finite;

theorem 
  carr H in Left_Cosets H & carr H in Right_Cosets H;

theorem 
  Left_Cosets H, Right_Cosets H are_equipotent;

theorem 
  union Left_Cosets H = the carrier of G & union Right_Cosets H =
  the carrier of G;

theorem 
  Left_Cosets (1).G = {{a} : not contradiction};

theorem 
  Right_Cosets (1).G = {{a} : not contradiction};

theorem 
  for H being strict Subgroup of G holds Left_Cosets H = {{a} : not
  contradiction} implies H = (1).G;

theorem 
  for H being strict Subgroup of G holds Right_Cosets H = {{a} : not
  contradiction} implies H = (1).G;

theorem 
  Left_Cosets (Omega).G = {the carrier of G} & Right_Cosets
  (Omega).G = {the carrier of G};

theorem 
  for G being strict Group, H being strict Subgroup of G holds
  Left_Cosets H = {the carrier of G} implies H = G;

theorem 
  for G being strict Group, H being strict Subgroup of G holds
  Right_Cosets H = {the carrier of G} implies H = G;

definition
  let G,H;
  func Index H -> Cardinal equals

  card Left_Cosets H;
end;

theorem 
  Index H = card Left_Cosets H & Index H = card Right_Cosets H;

definition
  let G,H;
  assume
 Left_Cosets(H) is finite;
  func index H -> Element of NAT means


  ex B being finite set st B = Left_Cosets H & it = card B;
end;

theorem 
  Left_Cosets H is finite implies (ex B being finite set st B =
Left_Cosets H & index H = card B) & ex C being finite set st C = Right_Cosets H
  & index H = card C;:$N Lagrange Theorem for Groups
theorem 
  for G being finite Group, H being Subgroup of G holds card G =
  card H * index H;

theorem 
  for G being finite Group, H being Subgroup of G holds card H divides card G;

theorem 
  for G being finite Group, I, H being Subgroup of G, J being Subgroup
  of H holds I = J implies index I = index J * index H;

theorem 
  index (Omega).G = 1;

theorem 
  for G being strict Group, H being strict Subgroup of G holds
  Left_Cosets H is finite & index H = 1 implies H = G;

theorem 
  Index (1).G = card G;

theorem 
  for G being finite Group holds index (1).G = card G;

theorem 
  for G being finite Group, H being strict Subgroup of G holds
  index H = card G implies H = (1).G;

theorem 
  for H being strict Subgroup of G holds Left_Cosets H is finite & Index
  H = card G implies G is finite & H = (1).G;





theorem 
  for X being finite set st (for Y st Y in X ex B being finite set st B
= Y & card B = k & for Z st Z in X & Y <> Z holds Y,Z are_equipotent & Y misses
  Z) ex C being finite set st C = union X & card C = k * card X;














begin

reserve x,y,y1,y2 for set;

definition
  let GF be non empty multMagma;
  let V be non empty VectSpStr over GF;
  let V1 be Subset of V;
  attr V1 is linearly-closed means


  (for v,u being Element of V st v in
V1 & u in V1 holds v + u in V1) & for a being Element of GF, v being Element of
  V st v in V1 holds a * v in V1;
end;

theorem 
  for GF be add-associative right_zeroed right_complementable
  Abelian associative well-unital distributive non empty doubleLoopStr, V be
  Abelian add-associative right_zeroed right_complementable
  vector-distributive scalar-distributive scalar-associative scalar-unital non
empty VectSpStr over GF, V1 be Subset of V st V1 <> {} & V1 is linearly-closed
  holds 0.V in V1;

theorem 
  for GF be add-associative right_zeroed right_complementable
  Abelian associative well-unital distributive non empty doubleLoopStr, V be
  Abelian add-associative right_zeroed right_complementable
  vector-distributive scalar-distributive scalar-associative scalar-unital non
  empty VectSpStr over GF, V1 be Subset of V st V1 is linearly-closed for v
  being Element of V st v in V1 holds - v in V1;

theorem 
  for GF be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr, V be Abelian
  add-associative right_zeroed right_complementable vector-distributive
  scalar-distributive scalar-associative scalar-unital non empty
  VectSpStr over GF, V1 be Subset of V st V1 is linearly-closed for v,u being
  Element of V st v in V1 & u in V1 holds v - u in V1;

theorem 
  for GF be add-associative right_zeroed right_complementable
  Abelian associative well-unital distributive non empty doubleLoopStr, V be
  Abelian add-associative right_zeroed right_complementable
  vector-distributive scalar-distributive scalar-associative scalar-unital non
  empty VectSpStr over GF holds {0.V} is linearly-closed;

theorem 
  for GF be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr, V be Abelian
  add-associative right_zeroed right_complementable vector-distributive
  scalar-distributive scalar-associative scalar-unital non empty
  VectSpStr over GF, V1 be Subset of V st the carrier of V = V1 holds V1 is
  linearly-closed;

theorem 
  for GF be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr, V be Abelian
  add-associative right_zeroed right_complementable vector-distributive
  scalar-distributive scalar-associative scalar-unital non empty
  VectSpStr over GF, V1,V2,V3 be Subset of V st V1 is linearly-closed & V2 is
linearly-closed & V3 = {v + u where v is Element of V, u is Element of V : v in
  V1 & u in V2} holds V3 is linearly-closed;

theorem 
  for GF be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr, V be Abelian
  add-associative right_zeroed right_complementable vector-distributive
  scalar-distributive scalar-associative scalar-unital non empty
  VectSpStr over GF, V1,V2 be Subset of V st V1 is linearly-closed & V2 is
  linearly-closed holds V1 /\ V2 is linearly-closed;

definition
  let GF be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr, V be Abelian
  add-associative right_zeroed right_complementable vector-distributive
  scalar-distributive scalar-associative scalar-unital non empty
  VectSpStr over GF;
  mode Subspace of V -> Abelian add-associative right_zeroed
    right_complementable vector-distributive scalar-distributive
    scalar-associative scalar-unital non empty VectSpStr over GF means


    the
carrier of it c= the carrier of V & 0.it = 0.V & the addF of it = (the addF of
V)||the carrier of it & the lmult of it = (the lmult of V) |([:the carrier of
    GF, the carrier of it:] qua set);
end;

reserve GF for add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr,
  V,X,Y for Abelian add-associative right_zeroed right_complementable
  vector-distributive scalar-distributive scalar-associative scalar-unital non
  empty VectSpStr over GF;
reserve a for Element of GF;
reserve u,u1,u2,v,v1,v2 for Element of V;
reserve W,W1,W2 for Subspace of V;
reserve V1 for Subset of V;
reserve w,w1,w2 for Element of W;

theorem 
  x in W1 & W1 is Subspace of W2 implies x in W2;

theorem 
  x in W implies x in V;

theorem 
  w is Element of V;

theorem 
  0.W = 0.V;

theorem 
  0.W1 = 0.W2;

theorem 
  w1 = v & w2 = u implies w1 + w2 = v + u;

theorem 
  w = v implies a * w = a * v;

theorem 
  w = v implies - v = - w;

theorem 
  w1 = v & w2 = u implies w1 - w2 = v - u;

theorem 
  0.V in W;

theorem 
  0.W1 in W2;

theorem 
  0.W in V;

theorem 
  u in W & v in W implies u + v in W;

theorem 
  v in W implies a * v in W;

theorem 
  v in W implies - v in W;

theorem 
  u in W & v in W implies u - v in W;

theorem 
  V is Subspace of V;

theorem 
  for X,V being strict Abelian add-associative right_zeroed
  right_complementable vector-distributive scalar-distributive
  scalar-associative scalar-unital non empty VectSpStr over GF holds V is
  Subspace of X & X is Subspace of V implies V = X;

theorem 
  V is Subspace of X & X is Subspace of Y implies V is Subspace of Y;

theorem 
  the carrier of W1 c= the carrier of W2 implies W1 is Subspace of W2;

theorem 
  (for v st v in W1 holds v in W2) implies W1 is Subspace of W2;

registration
  let GF be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr, V be Abelian
  add-associative right_zeroed right_complementable vector-distributive
  scalar-distributive scalar-associative scalar-unital non empty
  VectSpStr over GF;
  cluster strict for Subspace of V;
end;

theorem 
  for W1,W2 being strict Subspace of V st the carrier of W1 = the
  carrier of W2 holds W1 = W2;

theorem 
  for W1,W2 being strict Subspace of V st (for v holds v in W1 iff
  v in W2) holds W1 = W2;

theorem 
  for V being strict Abelian add-associative right_zeroed
right_complementable vector-distributive scalar-distributive
scalar-associative scalar-unital non empty VectSpStr over GF, W being strict
  Subspace of V holds the carrier of W = the carrier of V implies W = V;

theorem 
  for V being strict Abelian add-associative right_zeroed
right_complementable vector-distributive scalar-distributive
scalar-associative scalar-unital non empty VectSpStr over GF, W being strict
  Subspace of V holds (for v being Element of V holds v in W) implies W = V;

theorem 
  the carrier of W = V1 implies V1 is linearly-closed;

theorem 
  V1 <> {} & V1 is linearly-closed implies ex W being strict
  Subspace of V st V1 = the carrier of W;

definition
  let GF;
  let V;
  func (0).V -> strict Subspace of V means


  the carrier of it = {0.V};
end;

definition
  let GF;
  let V;
  func (Omega).V -> strict Subspace of V equals

  the VectSpStr of V;
end;

theorem 
  x in (0).V iff x = 0.V;

theorem 
  (0).W = (0).V;

theorem 
  (0).W1 = (0).W2;

theorem 
  (0).W is Subspace of V;

theorem 
  (0).V is Subspace of W;

theorem 
  (0).W1 is Subspace of W2;

theorem 
  for V being strict Abelian add-associative right_zeroed
  right_complementable vector-distributive scalar-distributive
  scalar-associative scalar-unital non empty VectSpStr over GF holds V is
  Subspace of (Omega).V;

definition
  let GF;
  let V;
  let v,W;
  func v + W -> Subset of V equals

  {v + u : u in W};
end;

definition
  let GF;
  let V;
  let W;
  mode Coset of W -> Subset of V means


    ex v st it = v + W;
end;

reserve B,C for Coset of W;

theorem 
  x in v + W iff ex u st u in W & x = v + u;

theorem 
  0.V in v + W iff v in W;

theorem 
  v in v + W;

theorem 
  0.V + W = the carrier of W;

theorem 
  v + (0).V = {v};

theorem 
  v + (Omega).V = the carrier of V;

theorem 
  0.V in v + W iff v + W = the carrier of W;

theorem 
  v in W iff v + W = the carrier of W;

theorem 
  v in W implies (a * v) + W = the carrier of W;

theorem 
  for GF being Field, V being VectSp of GF, a being Element of GF,
  v being Element of V, W being Subspace of V st a <> 0.GF & (a * v) + W = the
  carrier of W holds v in W;

theorem 
  for GF being Field, V being VectSp of GF, v being Element of V, W
  being Subspace of V holds v in W iff - v + W = the carrier of W;

theorem 
  u in W iff v + W = (v + u) + W;

theorem 
  u in W iff v + W = (v - u) + W;

theorem 
  v in u + W iff u + W = v + W;

theorem 
  u in v1 + W & u in v2 + W implies v1 + W = v2 + W;

theorem 
  for GF being Field, V being VectSp of GF, a being Element of GF, v
being Element of V, W being Subspace of V st a <> 1_GF & a * v in v + W holds v
  in W;

theorem 
  v in W implies a * v in v + W;

theorem 
  v in W implies - v in v + W;

theorem 
  u + v in v + W iff u in W;

theorem 
  v - u in v + W iff u in W;

theorem 
  u in v + W iff ex v1 st v1 in W & u = v - v1;

theorem 
  (ex v st v1 in v + W & v2 in v + W) iff v1 - v2 in W;

theorem 
  v + W = u + W implies ex v1 st v1 in W & v + v1 = u;

theorem 
  v + W = u + W implies ex v1 st v1 in W & v - v1 = u;

theorem 
  for W1,W2 being strict Subspace of V holds v + W1 = v + W2 iff W1 = W2;

theorem 
  for W1,W2 being strict Subspace of V st v + W1 = u + W2 holds W1 = W2;

theorem 
  ex C st v in C;

theorem 
  C is linearly-closed iff C = the carrier of W;

theorem 
  for W1,W2 being strict Subspace of V, C1 being Coset of W1, C2 being
  Coset of W2 st C1 = C2 holds W1 = W2;

theorem 
  {v} is Coset of (0).V;

theorem 
  V1 is Coset of (0).V implies ex v st V1 = {v};

theorem 
  the carrier of W is Coset of W;

theorem 
  the carrier of V is Coset of (Omega).V;

theorem 
  V1 is Coset of (Omega).V implies V1 = the carrier of V;

theorem 
  0.V in C iff C = the carrier of W;

theorem 
  u in C iff C = u + W;

theorem 
  u in C & v in C implies ex v1 st v1 in W & u + v1 = v;

theorem 
  u in C & v in C implies ex v1 st v1 in W & u - v1 = v;

theorem 
  (ex C st v1 in C & v2 in C) iff v1 - v2 in W;

theorem 
  u in B & u in C implies B = C;





theorem 
  for GF be add-associative right_zeroed right_complementable Abelian
  commutative associative well-unital distributive non empty doubleLoopStr, V
  be Abelian add-associative right_zeroed right_complementable
  vector-distributive scalar-distributive scalar-associative scalar-unital non
empty VectSpStr over GF, a,b being Element of GF, v being Element of V holds (
  a - b) * v = a * v - b * v;














begin

reserve GF for add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr;
reserve M for Abelian add-associative right_zeroed right_complementable
  vector-distributive scalar-distributive scalar-associative scalar-unital
   non empty VectSpStr over GF;
reserve W,W1,W2,W3 for Subspace of M;
reserve u,u1,u2,v,v1,v2 for Element of M;
reserve X,Y,x,y,y1,y2 for set;

definition
  let GF;
  let M;
  let W1,W2;
  func W1 + W2 -> strict Subspace of M means


  the carrier of it = {v + u : v in W1 & u in W2};
end;

definition
  let GF;
  let M;
  let W1,W2;
  func W1 /\ W2 -> strict Subspace of M means


  the carrier of it = (the carrier of W1) /\ (the carrier of W2);
  commutativity;
end;

theorem 
  x in W1 + W2 iff ex v1,v2 st v1 in W1 & v2 in W2 & x = v1 + v2;

theorem 
  v in W1 or v in W2 implies v in W1 + W2;

theorem 
  x in W1 /\ W2 iff x in W1 & x in W2;

theorem 
  for W being strict Subspace of M holds W + W = W;

theorem 
  W1 + W2 = W2 + W1;

theorem 
  W1 + (W2 + W3) = (W1 + W2) + W3;

theorem 
  W1 is Subspace of W1 + W2 & W2 is Subspace of W1 + W2;

theorem 
  for W2 being strict Subspace of M holds W1 is Subspace of W2 iff W1 + W2 = W2
;

theorem 
  for W being strict Subspace of M holds (0).M + W = W & W + (0).M = W;

theorem 
  (0).M + (Omega).M = the VectSpStr of M & (Omega). M + (0).M = the
  VectSpStr of M;

theorem 
  (Omega).M + W = the VectSpStr of M & W + (Omega).M = the VectSpStr of M;

theorem 
  for M being strict Abelian add-associative right_zeroed
right_complementable vector-distributive scalar-distributive
scalar-associative scalar-unital non empty VectSpStr over GF holds (Omega).M
  + (Omega).M = M;

theorem 
  for W being strict Subspace of M holds W /\ W = W;

theorem 
  W1 /\ (W2 /\ W3) = (W1 /\ W2) /\ W3;

theorem 
  W1 /\ W2 is Subspace of W1 & W1 /\ W2 is Subspace of W2;

theorem 
  (for W1 being strict Subspace of M holds W1 is Subspace of W2
  implies W1 /\ W2 = W1) & for W1 st W1 /\ W2 = W1 holds W1 is Subspace of W2;

theorem 
  W1 is Subspace of W2 implies W1 /\ W3 is Subspace of W2 /\ W3;

theorem 
  W1 is Subspace of W3 implies W1 /\ W2 is Subspace of W3;

theorem 
  W1 is Subspace of W2 & W1 is Subspace of W3 implies W1 is Subspace of
  W2 /\ W3;

theorem 
  (0).M /\ W = (0).M & W /\ (0).M = (0).M;

theorem 
  for W being strict Subspace of M holds (Omega).M /\ W = W & W /\
  (Omega).M = W;

theorem 
  for M being strict Abelian add-associative right_zeroed
right_complementable vector-distributive scalar-distributive
scalar-associative scalar-unital non empty VectSpStr over GF holds (Omega).M
  /\ (Omega).M = M;

theorem 
  W1 /\ W2 is Subspace of W1 + W2;

theorem 
  for W2 being strict Subspace of M holds (W1 /\ W2) + W2 = W2;

theorem 
  for W1 being strict Subspace of M holds W1 /\ (W1 + W2) = W1;

theorem 
  (W1 /\ W2) + (W2 /\ W3) is Subspace of W2 /\ (W1 + W3);

theorem 
  W1 is Subspace of W2 implies W2 /\ (W1 + W3) = (W1 /\ W2) + (W2 /\ W3);

theorem 
  W2 + (W1 /\ W3) is Subspace of (W1 + W2) /\ (W2 + W3);

theorem 
  W1 is Subspace of W2 implies W2 + (W1 /\ W3) = (W1 + W2) /\ (W2 + W3);

theorem 
  for W1 being strict Subspace of M holds W1 is Subspace of W3
  implies W1 + (W2 /\ W3) = (W1 + W2) /\ W3;

theorem 
  for W1,W2 being strict Subspace of M holds W1 + W2 = W2 iff W1 /\ W2 = W1;

theorem 
  for W2,W3 being strict Subspace of M holds W1 is Subspace of W2
  implies W1 + W3 is Subspace of W2 + W3;

theorem 
  W1 is Subspace of W2 implies W1 is Subspace of W2 + W3;

theorem 
  W1 is Subspace of W3 & W2 is Subspace of W3 implies W1 + W2 is Subspace of W3
;

theorem 
  (ex W st the carrier of W = (the carrier of W1) \/ (the carrier of W2)
  ) iff W1 is Subspace of W2 or W2 is Subspace of W1;

definition
  let GF;
  let M;
  func Subspaces(M) -> set means


  for x holds x in it iff ex W being strict Subspace of M st W = x;
end;

registration
  let GF;
  let M;
  cluster Subspaces(M) -> non empty;
end;

theorem 
  for M being strict Abelian add-associative right_zeroed
  right_complementable vector-distributive scalar-distributive
  scalar-associative scalar-unital non empty VectSpStr over GF holds M in
  Subspaces(M);

definition
  let GF;
  let M;
  let W1,W2;
  pred M is_the_direct_sum_of W1,W2 means


  the VectSpStr of M = W1 + W2 & W1 /\ W2 = (0).M;
end;

reserve F for Field;
reserve V for VectSp of F;
reserve W for Subspace of V;

definition
  let F,V,W;
  mode Linear_Compl of W -> Subspace of V means


    V is_the_direct_sum_of it,W;
end;

reserve W,W1,W2 for Subspace of V;

theorem 
  V is_the_direct_sum_of W1,W2 implies W2 is Linear_Compl of W1;

theorem 
  for L being Linear_Compl of W holds V is_the_direct_sum_of L,W &
  V is_the_direct_sum_of W,L;

theorem 
  for L being Linear_Compl of W holds W + L = the VectSpStr of V &
  L + W = the VectSpStr of V;

theorem 
  for L being Linear_Compl of W holds W /\ L = (0).V & L /\ W = (0).V;

reserve W1,W2 for Subspace of M;

theorem 
  M is_the_direct_sum_of W1,W2 implies M is_the_direct_sum_of W2,W1;

theorem 
  M is_the_direct_sum_of (0).M,(Omega).M & M is_the_direct_sum_of
  (Omega). M,(0).M;

reserve W for Subspace of V;

theorem 
  for L being Linear_Compl of W holds W is Linear_Compl of L;

theorem 
  (0).V is Linear_Compl of (Omega).V & (Omega).V is Linear_Compl of (0). V;

reserve W1,W2 for Subspace of M;
reserve u,u1,u2,v for Element of M;
reserve C1 for Coset of W1;
reserve C2 for Coset of W2;

theorem 
  C1 meets C2 implies C1 /\ C2 is Coset of W1 /\ W2;

theorem 
  M is_the_direct_sum_of W1,W2 iff for C1 being Coset of W1, C2
  being Coset of W2 ex v being Element of M st C1 /\ C2 = {v};

theorem 
  for M being strict Abelian add-associative right_zeroed
  right_complementable vector-distributive scalar-distributive
  scalar-associative scalar-unital
   non empty VectSpStr over GF, W1,W2 being
  Subspace of M holds W1 + W2 = M iff for v being Element of M ex v1,v2 being
  Element of M st v1 in W1 & v2 in W2 & v = v1 + v2;

theorem 
  for v,v1,v2,u1,u2 being Element of M holds M
is_the_direct_sum_of W1,W2 & v = v1 + v2 & v = u1 + u2 & v1 in W1 & u1 in W1 &
  v2 in W2 & u2 in W2 implies v1 = u1 & v2 = u2;

theorem 
  M = W1 + W2 & (ex v st for v1,v2,u1,u2 being Element of M st v = v1 +
v2 & v = u1 + u2 & v1 in W1 & u1 in W1 & v2 in W2 & u2 in W2 holds v1 = u1 & v2
  = u2) implies M is_the_direct_sum_of W1,W2;

reserve t1,t2 for Element of [:the carrier of M, the carrier of M:];

definition
  let GF,M,v,W1,W2;
  assume
 M is_the_direct_sum_of W1,W2;
  func v |-- (W1,W2) -> Element of [:the carrier of M,the carrier of M:] means


  v = it`1 + it`2 & it`1 in W1 & it`2 in W2;
end;

theorem 
  M is_the_direct_sum_of W1,W2 implies (v |-- (W1,W2))`1 = (v |-- (W2,W1))`2;

theorem 
  M is_the_direct_sum_of W1,W2 implies (v |-- (W1,W2))`2 = (v |-- (W2,W1))`1;

reserve W for Subspace of V;

theorem 
  for L being Linear_Compl of W, v being Element of V, t being Element
  of [:the carrier of V,the carrier of V:] holds t`1 + t`2 = v & t`1 in W & t`2
  in L implies t = v |-- (W,L);

theorem 
  for L being Linear_Compl of W, v being Element of V holds (v |-- (W,L)
  )`1 + (v |-- (W,L))`2 = v;

theorem 
  for L being Linear_Compl of W, v being Element of V holds (v |-- (W,L)
  )`1 in W & (v |-- (W,L))`2 in L;

theorem 
  for L being Linear_Compl of W, v being Element of V holds (v |-- (W,L)
  )`1 = (v |-- (L,W))`2;

theorem 
  for L being Linear_Compl of W, v being Element of V holds (v |-- (W,L)
  )`2 = (v |-- (L,W))`1;

reserve A1,A2,B for Element of Subspaces(M),
  W1,W2 for Subspace of M;

definition
  let GF;
  let M;
  func SubJoin M -> BinOp of Subspaces M means


  for A1,A2,W1,W2 st A1 = W1 & A2 = W2 holds it.(A1,A2) = W1 + W2;
end;

definition
  let GF;
  let M;
  func SubMeet M -> BinOp of Subspaces M means


  for A1,A2,W1,W2 st A1 = W1 & A2 = W2 holds it.(A1,A2) = W1 /\ W2;
end;

theorem 
  LattStr (# Subspaces(M), SubJoin(M), SubMeet(M) #) is Lattice;

theorem 
  LattStr (# Subspaces(M), SubJoin(M), SubMeet(M) #) is 0_Lattice;

theorem 
  LattStr (# Subspaces(M), SubJoin(M), SubMeet(M) #) is 1_Lattice;

theorem 
  LattStr (# Subspaces(M), SubJoin(M), SubMeet(M) #) is 01_Lattice;

theorem 
  LattStr (# Subspaces(M), SubJoin(M), SubMeet(M) #) is M_Lattice;

theorem 
  for F being Field, V being VectSp of F holds LattStr (# Subspaces(V),
    SubJoin(V), SubMeet(V) #) is C_Lattice;














begin

definition
  struct(1-sorted) N-Str (# carrier -> set,
    normF -> Function of the carrier, REAL #);
end;

registration
  cluster non empty strict for N-Str;
end;

definition    
  let X be non empty N-Str, x be Element of X;
  func ||.x.|| -> Real equals

  (the normF of X).x;
end;

reserve X for non empty N-Str;

definition
 let X; let f be (the carrier of X)-valued Function;
  func ||.f.|| -> Function means

  dom it = dom f &
  for e being set st e in dom it holds it.e = ||. f/.e .||;
end;

registration
  let X; let f be (the carrier of X)-valued Function;
  cluster ||.f.|| -> REAL-valued;
end;

definition let C be non empty set, X;



 let f be PartFunc of C, the carrier of X;
 redefine func ||.f.|| -> PartFunc of C, REAL means

 dom it = dom f &
  for c being Element of C st c in dom it holds it.c = ||. f/.c .||;
end;

definition    
  let X; let s be sequence of X;
  redefine func ||.s.|| -> Real_Sequence means

  for n being Element of NAT holds it.n = ||. s.n .||;
end;

definition
  struct(N-Str, ZeroStr) N-ZeroStr (# carrier -> set,
    ZeroF -> Element of the carrier,
    normF -> Function of the carrier, REAL #);
end;

registration
  cluster non empty strict for N-ZeroStr;
end;

reserve X for non empty N-ZeroStr, x for Element of X;

definition let X;
  attr X is discerning means

    ||.x.|| = 0 implies x = 0.X;
  attr X is reflexive means

 ||.0.X.|| = 0;
end;

registration
 cluster reflexive discerning for non empty strict N-ZeroStr;
end;

registration
  let X be reflexive non empty N-ZeroStr;
  cluster ||.0.X.|| -> zero;
end;














begin

definition
  struct(RLSStruct, N-ZeroStr) NORMSTR (# carrier -> set,
   ZeroF -> Element of the carrier,
   addF -> BinOp of the carrier, Mult -> Function of [:REAL, the carrier:], the
    carrier, normF -> Function of the carrier, REAL #);
end;

registration
  cluster non empty strict for NORMSTR;
end;

reserve a, b for Real;

definition

  let IT be non empty NORMSTR;
  attr IT is RealNormSpace-like means


  for x, y being Point of IT, a holds ||.a * x.|| = abs(a) * ||.x.|| & ||.x + y
  .|| <= ||.x.|| + ||.y.||;
end;

registration
  cluster reflexive discerning RealNormSpace-like vector-distributive
  scalar-distributive scalar-associative scalar-unital Abelian add-associative
    right_zeroed right_complementable strict for non empty NORMSTR;
end;

definition
  mode RealNormSpace is reflexive discerning RealNormSpace-like
  vector-distributive scalar-distributive scalar-associative scalar-unital
  Abelian add-associative right_zeroed right_complementable
   non empty NORMSTR;
end;

reserve RNS for RealNormSpace;
reserve x, y, z, g, g1, g2 for Point of RNS;

theorem 
  ||.0.RNS.|| = 0;

theorem 
  ||.-x.|| = ||.x.||;

theorem 
  ||.x - y.|| <= ||.x.|| + ||.y.||;

theorem 
  0 <= ||.x.||;

registration
  let RNS,x;
  cluster ||.x.|| -> non negative;
end;

theorem 
  ||.a * x + b * y.|| <= abs(a) * ||.x.|| + abs(b) * ||.y.||;

theorem 
  ||.x - y.|| = 0 iff x = y;

theorem 
  ||.x - y.|| = ||.y - x.||;

theorem 
  ||.x.|| - ||.y.|| <= ||.x - y.||;

theorem 
  abs(||.x.|| - ||.y.||) <= ||.x - y.||;

theorem 
  ||.x - z.|| <= ||.x - y.|| + ||.y - z.||;

theorem 
  x <> y implies ||.x - y.|| <> 0;

reserve S, S1, S2 for sequence of RNS;
reserve k, n, m, m1, m2 for Element of NAT;
reserve r for Real;
reserve f for Function;
reserve d, s, t for set;

theorem 
  for RNS being non empty 1-sorted, x being Element of RNS holds f is
  sequence of RNS iff ( dom f = NAT & for d st d in NAT holds f.d is Element of
  RNS );

theorem 
  for RNS being non empty 1-sorted, x being Element of RNS ex S being
  sequence of RNS st rng S = {x};

theorem 
  for RNS being non empty 1-sorted, S being sequence of RNS st (ex x
  being Element of RNS st for n being Nat holds S.n = x) ex x being Element of
  RNS st rng S={x};

theorem 
  for RNS being non empty 1-sorted, S being sequence of RNS st ex x
  being Element of RNS st rng S = {x} holds for n holds S.n = S.(n+1);

theorem 
  for RNS being non empty 1-sorted, S being sequence of RNS st for n
  holds S.n = S.(n+1) holds for n, k holds S.n = S.(n+k);

theorem 
  for RNS being non empty 1-sorted, S being sequence of RNS st for n, k
  holds S.n = S.(n+k) holds for n, m holds S.n = S.m;

theorem 
  for RNS being non empty 1-sorted, S being sequence of RNS st for n, m
  holds S.n = S.m ex x being Element of RNS st for n being Nat holds S.n = x;

definition

  let RNS be non empty 1-sorted;
  let S be sequence of RNS;
  let n;
  redefine func S.n -> Element of RNS;
end;

definition
  let RNS be non empty addLoopStr;
  let S1, S2 be sequence of RNS;

  func S1 + S2 -> sequence of RNS means


  for n holds it.n = S1.n + S2.n;
end;

definition
  let RNS be non empty addLoopStr;
  let S1, S2 be sequence of RNS;
  func S1 - S2 -> sequence of RNS means


  for n holds it.n = S1.n - S2.n;
end;

definition
  let RNS be non empty addLoopStr;
  let S be sequence of RNS;
  let x be Element of RNS;
  func S - x -> sequence of RNS means


  for n holds it.n = S.n - x;
end;

definition
  let RNS be non empty RLSStruct;
  let S be sequence of RNS;
  let a;
  func a * S -> sequence of RNS means


  for n holds it.n = a * S.n;
end;

definition
  let RNS, S;
  attr S is convergent means


  ex g st for r st 0 < r ex m st for n st m <= n holds ||.(S.n) - g.|| < r;
end;

theorem 
  S1 is convergent & S2 is convergent implies S1 + S2 is convergent;

theorem 
  S1 is convergent & S2 is convergent implies S1 - S2 is convergent;

theorem 
  S is convergent implies S - x is convergent;

theorem 
  S is convergent implies a * S is convergent;

theorem 
  S is convergent implies ||.S.|| is convergent;

definition

  let RNS, S;
  assume
 S is convergent;
  func lim S -> Point of RNS means


  for r st 0 < r ex m st for n st m <= n holds ||.(S.n) - it.|| < r;
end;

theorem 
  S is convergent & lim S = g implies ||.S - g.|| is convergent & lim
  ||.S - g.|| = 0;

theorem 
  S1 is convergent & S2 is convergent implies lim (S1 + S2) = (lim S1) +
  (lim S2);

theorem 
  S1 is convergent & S2 is convergent implies lim (S1 - S2) = (lim S1) -
  (lim S2);

theorem 
  S is convergent implies lim (S - x) = (lim S) - x;

theorem 
  S is convergent implies lim (a * S) = a * (lim S);














begin

reserve x,X,Y for set;
reserve C for non empty set;
reserve c for Element of C;
reserve V for RealNormSpace;
reserve f,f1,f2,f3 for PartFunc of C,V;
reserve r,r1,r2,p for Real;





definition
  let C;
  let V be non empty addLoopStr;
  let f1,f2 be PartFunc of C,V;
  func f1+f2 -> PartFunc of C,V means


  dom it = dom f1 /\ dom f2 &
  for c st c in dom it holds it/.c = (f1/.c) + (f2/.c);
  func f1-f2 -> PartFunc of C,V means


  dom it = dom f1 /\ dom f2 &
  for c st c in dom it holds it/.c = (f1/.c) - (f2/.c);
end;

registration
  let C;
  let V be non empty addLoopStr;
  let f1,f2 be Function of C,V;
  cluster f1+f2 -> total;
  cluster f1-f2 -> total;
end;

definition
  let C;
  let V be non empty RLSStruct;
  let f1 be PartFunc of C,REAL;
  let f2 be PartFunc of C,V;
  func f1(#)f2 -> PartFunc of C,V means


  dom it = dom f1 /\ dom f2 &
  for c st c in dom it holds it/.c = f1.c * (f2/.c);
end;

registration
  let C;
  let V be non empty RLSStruct;
  let f1 be Function of C,REAL;
  let f2 be Function of C,V;
  cluster f1(#)f2 -> total;
end;

definition
  let C;
  let V be non empty RLSStruct;
  let f be PartFunc of C,V;
  let r;
  func r(#)f -> PartFunc of C,V means


  dom it = dom f & for c st c in dom it holds it/.c = r * (f/.c);
end;

registration
  let C;
  let V be non empty RLSStruct;
  let f be Function of C,V;
  let r;
  cluster r(#)f -> total;
end;

definition

  let C;
  let V be non empty addLoopStr;
  let f be PartFunc of C,V;
  func -f -> PartFunc of C,V means


  dom it = dom f & for c st c in dom it holds it/.c = -(f/.c);
end;

registration
  let C;
  let V be non empty addLoopStr;
  let f be Function of C,V;
  cluster -f -> total;
end;

theorem 
  for f1 be PartFunc of C,REAL holds dom (f1(#)f2) \ (f1(#)f2)"{0.V} = (
  dom f1 \ (f1)"{0}) /\ (dom f2 \ (f2)"{0.V});

theorem 
  (||.f.||)"{0} = f"{0.V} & (-f)"{0.V} = f"{0.V};

theorem 
  r<>0 implies (r(#)f)"{0.V} = f"{0.V};





theorem 
  f1 + f2 = f2 + f1;

definition
  let C,V; let f1,f2;
  redefine func f1+f2;
  commutativity;
end;

theorem 
  (f1 + f2) + f3 = f1 + (f2 + f3);

theorem 
  for f1,f2 be PartFunc of C,REAL,f3 be PartFunc of C,V
  holds (f1 (#) f2) (#) f3 = f1 (#) (f2 (#) f3);

theorem 
  for f1,f2 be PartFunc of C,REAL holds (f1 + f2) (#) f3=f1 (#) f3 + f2 (#) f3;

theorem 
  for f3 be PartFunc of C,REAL holds f3 (#) (f1 + f2)=f3(#)f1 + f3(#)f2;

theorem 
  for f1 be PartFunc of C,REAL holds r(#)(f1(#)f2)=r(#)f1(#)f2;

theorem 
  for f1 be PartFunc of C,REAL holds r(#)(f1(#)f2)=f1(#)(r(#)f2);

theorem 
  for f1,f2 be PartFunc of C,REAL holds (f1 - f2)(#)f3=f1(#)f3 - f2(#)f3;

theorem 
  for f3 be PartFunc of C,REAL holds f3(#)f1 - f3(#)f2 = f3(#)(f1 - f2);

theorem 
  r(#)(f1 + f2) = r(#)f1 + r(#)f2;

theorem 
  (r*p)(#)f = r(#)(p(#)f);

theorem 
  r(#)(f1 - f2) = r(#)f1 - r(#)f2;

theorem 
  f1-f2 = (-1)(#)(f2-f1);

theorem 
  f1 - (f2 + f3) = f1 - f2 - f3;

theorem 
  1(#)f = f;

theorem 
  f1 - (f2 - f3) = f1 - f2 + f3;

theorem 
  f1 + (f2 - f3) = f1 + f2 - f3;

theorem 
  for f1 be PartFunc of C,REAL holds ||.f1(#)f2.|| = abs(f1)(#)||.f2.||;

theorem 
  ||.r(#)f.|| = abs(r)(#)||.f.||;

theorem 
  -f = (-1)(#)f;

theorem 
  -(-f) = f;

theorem 
  f1 - f2 = f1 + -f2;

theorem 
  f1 - (-f2) = f1 + f2;

theorem 
  (f1+f2)|X = f1|X + f2|X & (f1+f2)|X = f1|X + f2 & (f1+f2)|X = f1 + f2|X;

theorem 
  for f1 be PartFunc of C,REAL holds (f1(#)f2)|X = f1|X (#) f2|X & (f1
  (#)f2)|X = f1|X (#) f2 & (f1(#)f2)|X = f1 (#) f2|X;

theorem 
  (-f)|X = -(f|X) & (||.f.||)|X = ||.(f|X).||;

theorem 
  (f1-f2)|X = f1|X - f2|X & (f1-f2)|X = f1|X - f2 &(f1-f2)|X = f1 - f2|X;

theorem 
  (r(#)f)|X = r(#)(f|X);





theorem 
  (f1 is total & f2 is total iff f1+f2 is total) & (f1 is total &
  f2 is total iff f1-f2 is total);

theorem 
  for f1 be PartFunc of C,REAL holds (f1 is total & f2 is total
  iff f1(#)f2 is total);

theorem 
  f is total iff r(#)f is total;

theorem 
  f is total iff -f is total;

theorem 
  f is total iff ||.f.|| is total;

theorem 
  f1 is total & f2 is total implies (f1+f2)/.c = (f1/.c) + (f2/.c) &
  (f1-f2)/.c = (f1/.c) - (f2/.c);

theorem 
  for f1 be PartFunc of C,REAL holds f1 is total & f2 is total implies
  (f1(#)f2)/.c = f1.c * (f2/.c);

theorem 
  f is total implies (r(#)f)/.c = r * (f/.c);

theorem 
  f is total implies (-f)/.c = - f/.c & (||.f.||).c = ||. f/.c .||;





definition
  let C;
  let V be non empty NORMSTR;
  let f be PartFunc of C,V;
  let Y;
  pred f is_bounded_on Y means


  ex r st for c st c in Y /\ dom f holds ||.f/.c.|| <= r;
end;

theorem 
  Y c= X & f is_bounded_on X implies f is_bounded_on Y;

theorem 
  X misses dom f implies f is_bounded_on X;

theorem 
  0(#)f is_bounded_on Y;

theorem 
  f is_bounded_on Y implies r(#)f is_bounded_on Y;

theorem 
  f is_bounded_on Y implies ||.f.|||Y is bounded & -f is_bounded_on Y;

theorem 
  f1 is_bounded_on X & f2 is_bounded_on Y implies f1+f2 is_bounded_on (X /\ Y);

theorem 
  for f1 be PartFunc of C,REAL holds f1|X is bounded & f2 is_bounded_on
  Y implies f1(#)f2 is_bounded_on (X /\ Y);

theorem 
  f1 is_bounded_on X & f2 is_bounded_on Y implies f1-f2 is_bounded_on X /\ Y;

theorem 
  f is_bounded_on X & f is_bounded_on Y implies f is_bounded_on X \/ Y;

theorem 
  f1|X is constant & f2|Y is constant implies (f1+f2)|(X /\ Y) is
  constant & (f1-f2)|(X /\ Y) is constant;

theorem 
  for f1 be PartFunc of C,REAL holds f1|X is constant & f2|Y is constant
  implies (f1(#)f2)|(X /\ Y) is constant;

theorem 
  f|Y is constant implies (p(#)f)|Y is constant;

theorem 
  f|Y is constant implies ||.f.|||Y is constant & (-f)|Y is constant;

theorem 
  f|Y is constant implies f is_bounded_on Y;

theorem 
  f|Y is constant implies (for r holds r(#)f is_bounded_on Y) & -f
  is_bounded_on Y & ||.f.|||Y is bounded;

theorem 
  f1 is_bounded_on X & f2|Y is constant implies f1+f2 is_bounded_on (X /\ Y);

theorem 
  f1 is_bounded_on X & f2|Y is constant implies f1-f2 is_bounded_on X /\
  Y & f2-f1 is_bounded_on X /\ Y;














begin

reserve p,q,r for FinSequence,
  x,y,y1,y2 for set,
  i,k for Element of NAT,
  GF for add-associative right_zeroed right_complementable Abelian associative
  well-unital distributive non empty doubleLoopStr,
  V for Abelian
  add-associative right_zeroed right_complementable vector-distributive
  scalar-distributive scalar-associative scalar-unital
   non empty VectSpStr over GF,
  u,v,v1,v2,v3,w for Element of V,
  a,b for Element of GF,
  F,G ,H for FinSequence of V,
  A,B for Subset of V,
  f for Function of V, GF;

definition
  let GF be non empty ZeroStr;
  let V be non empty VectSpStr over GF;

  mode Linear_Combination of V ->
       Element of Funcs(the carrier of V, the carrier of GF) means


  ex T being finite Subset of V st
  for v being Element of V st not v in T holds it.v = 0.GF;
end;

reserve L,L1,L2,L3 for Linear_Combination of V;

definition
  let GF be non empty ZeroStr;
  let V be non empty VectSpStr over GF;
  let L be Linear_Combination of V;
  func Carrier(L) -> finite Subset of V equals

  {v where v is Element of V: L.v <> 0.GF};
end;

theorem 
  x in Carrier(L) iff ex v st x = v & L.v <> 0.GF;

theorem 
  L.v = 0.GF iff not v in Carrier(L);

definition
  let GF be non empty ZeroStr;
  let V be non empty VectSpStr over GF;
  func ZeroLC(V) -> Linear_Combination of V means


  Carrier(it) = {};
end;

theorem 
  ZeroLC(V).v = 0.GF;

definition
  let GF be non empty ZeroStr;
  let V be non empty VectSpStr over GF;
  let A be Subset of V;
  mode Linear_Combination of A -> Linear_Combination of V means


    Carrier (it) c= A;
end;

reserve l for Linear_Combination of A;

theorem 
  A c= B implies l is Linear_Combination of B;

theorem 
  ZeroLC(V) is Linear_Combination of A;

theorem 
  for l being Linear_Combination of {}(the carrier of V) holds l = ZeroLC(V);

theorem 
  L is Linear_Combination of Carrier(L);

definition
  let GF be non empty addLoopStr;
  let V be non empty VectSpStr over GF;
  let F be FinSequence of the carrier of V;
  let f be Function of V, GF;
  func f (#) F -> FinSequence of V means


  len it = len F & for i be Nat st i in dom it holds it.i = f.(F/.i) * F/.i;
end;

theorem 
  i in dom F & v = F.i implies (f (#) F).i = f.v * v;

theorem 
  f (#) <*>(the carrier of V) = <*>(the carrier of V);

theorem 
  f (#) <* v *> = <* f.v * v *>;

theorem 
  f (#) <* v1,v2 *> = <* f.v1 * v1, f.v2 * v2 *>;

theorem 
  f (#) <* v1,v2,v3 *> = <* f.v1 * v1, f.v2 * v2, f.v3 * v3 *>;

theorem 
  f (#) (F ^ G) = (f (#) F) ^ (f (#) G);

definition
  let GF be non empty addLoopStr;
  let V be non empty VectSpStr over GF;
  let L be Linear_Combination of V;
  assume
 V is Abelian add-associative right_zeroed right_complementable;
  func Sum(L) -> Element of V means


  ex F being FinSequence of the carrier of V st
  F is one-to-one & rng F = Carrier(L) & it = Sum(L (#) F);
end;

theorem 
  0.GF <> 1.GF implies (A <> {} & A is linearly-closed iff for l holds
  Sum(l) in A);

theorem 
  Sum(ZeroLC(V)) = 0.V;

theorem 
  for l being Linear_Combination of {}(the carrier of V) holds Sum(l) = 0.V;

theorem 
  for l being Linear_Combination of {v} holds Sum(l) = l.v * v;

theorem 
  v1 <> v2 implies for l being Linear_Combination of {v1,v2} holds
  Sum(l) = l.v1 * v1 + l.v2 * v2;

theorem 
  Carrier(L) = {} implies Sum(L) = 0.V;

theorem 
  Carrier(L) = {v} implies Sum(L) = L.v * v;

theorem 
  Carrier(L) = {v1,v2} & v1 <> v2 implies Sum(L) = L.v1 * v1 + L.v2 * v2;

definition
  let GF be non empty ZeroStr;
  let V be non empty VectSpStr over GF;
  let L1,L2 be Linear_Combination of V;
  redefine pred L1 = L2 means

  for v being Element of V holds L1.v = L2.v;
end;

definition
  let GF,V,L1,L2;
  func L1 + L2 -> Linear_Combination of V equals

  L1 + L2;
end;

theorem 
  (L1+L2).v = L1.v + L2.v;

theorem 
  Carrier(L1 + L2) c= Carrier(L1) \/ Carrier(L2);

theorem 
  L1 is Linear_Combination of A & L2 is Linear_Combination of A
  implies L1 + L2 is Linear_Combination of A;

theorem 
  L1 + L2 = L2 + L1;

theorem 
  L1 + (L2 + L3) = L1 + L2 + L3;

theorem 
  L + ZeroLC(V) = L & ZeroLC(V) + L = L;

definition
  let GF,V,a,L;
  func a * L -> Linear_Combination of V means


  for v holds it.v = a * L .v;
end;

theorem 
  Carrier(a * L) c= Carrier(L);

theorem 
  for GF being Field, V being VectSp of GF, a being Element of GF,
L being Linear_Combination of V st a <> 0.GF holds Carrier(a * L) = Carrier(L);

theorem 
  0.GF * L = ZeroLC(V);

theorem 
  L is Linear_Combination of A implies a * L is Linear_Combination of A;

theorem 
  (a + b) * L = a * L + b * L;

theorem 
  a * (L1 + L2) = a * L1 + a * L2;

theorem 
  a * (b * L) = (a * b) * L;

theorem 
  1.GF * L = L;

definition
  let GF,V,L;
  func - L -> Linear_Combination of V equals

  (- 1.GF) * L;
  involutiveness;
end;

theorem 
  (- L).v = - L.v;

theorem 
  L1 + L2 = ZeroLC(V) implies L2 = - L1;

theorem 
  Carrier(- L) = Carrier(L);

theorem 
  L is Linear_Combination of A implies - L is Linear_Combination of A;

definition
  let GF,V,L1,L2;
  func L1 - L2 -> Linear_Combination of V equals

  L1 + (- L2);
end;

theorem 
  (L1 - L2).v = L1.v - L2.v;

theorem 
  Carrier(L1 - L2) c= Carrier(L1) \/ Carrier(L2);

theorem 
  L1 is Linear_Combination of A & L2 is Linear_Combination of A implies
  L1 - L2 is Linear_Combination of A;

theorem 
  L - L = ZeroLC(V);

theorem 
  Sum(L1 + L2) = Sum(L1) + Sum(L2);

theorem 
  for GF being Field, V being VectSp of GF, L being Linear_Combination
  of V, a being Element of GF holds Sum(a * L) = a * Sum(L);

theorem 
  Sum(- L) = - Sum(L);

theorem 
  Sum(L1 - L2) = Sum(L1) - Sum(L2);





theorem 
  (- 1.GF) * a = - a;

theorem 
  for GF being Field holds - 1.GF <> 0.GF;














begin

reserve x,y,X,Y,Z for set;
reserve GF for Field;
reserve a,b for Element of GF;
reserve V for VectSp of GF;
reserve v,v1,v2,u for Vector of V;
reserve A,B,C for Subset of V;
reserve T for finite Subset of V;
reserve l for Linear_Combination of A;
reserve f,g for Function of the carrier of V, the carrier of GF;

definition
  let GF;
  let V;
  let IT be Subset of V;
  attr IT is linearly-independent means


  for l being Linear_Combination of IT st Sum(l) = 0.V holds Carrier(l) = {};
end;

notation
  let GF;
  let V;
  let IT be Subset of V;
  antonym IT is linearly-dependent for IT is linearly-independent;
end;

theorem 
  A c= B & B is linearly-independent implies A is linearly-independent;

theorem 
  A is linearly-independent implies not 0.V in A;

registration
  let GF,V;
  cluster empty -> linearly-independent for Subset of V;
end;

registration
  let GF, V;
  cluster finite linearly-independent for Subset of V;
end;

theorem 
  {v} is linearly-independent iff v <> 0.V;

theorem 
  {v1,v2} is linearly-independent implies v1 <> 0.V;

theorem 
  v1 <> v2 & {v1,v2} is linearly-independent iff v2 <> 0.V & for a
  holds v1 <> a * v2;

theorem 
  v1 <> v2 & {v1,v2} is linearly-independent iff for a,b st a * v1 + b *
  v2 = 0.V holds a = 0.GF & b = 0.GF;

definition
  let GF;
  let V;
  let A;
  func Lin(A) -> strict Subspace of V means


  the carrier of it = {Sum(l) : not contradiction};
end;

theorem 
  x in Lin(A) iff ex l st x = Sum(l);

theorem 
  x in A implies x in Lin(A);

reserve l0 for Linear_Combination of {}(the carrier of V);

theorem 
  Lin({}(the carrier of V)) = (0).V;

theorem 
  Lin(A) = (0).V implies A = {} or A = {0.V};

theorem 
  for W being strict Subspace of V st A = the carrier of W holds Lin(A) = W;

theorem 
  for V being strict VectSp of GF, A being Subset of V st A = the
  carrier of V holds Lin(A) = V;

theorem 
  A c= B implies Lin(A) is Subspace of Lin(B);

theorem 
  for V being strict VectSp of GF, A,B being Subset of V st Lin(A) = V &
  A c= B holds Lin(B) = V;

theorem 
  Lin(A \/ B) = Lin(A) + Lin(B);

theorem 
  Lin(A /\ B) is Subspace of Lin(A) /\ Lin(B);

theorem 
  for V being VectSp of GF, A being Subset of V st A is
  linearly-independent holds ex B being Subset of V st A c= B & B is
  linearly-independent & Lin(B) = the VectSpStr of V;

theorem 
  Lin(A) = V implies ex B st B c= A & B is linearly-independent & Lin(B) = V;

definition
  let GF;
  let V be VectSp of GF;
  mode Basis of V -> Subset of V means


    it is linearly-independent & Lin (it) = the VectSpStr of V;
end;

theorem 
  for V being VectSp of GF, A being Subset of V st A is
  linearly-independent holds ex I being Basis of V st A c= I;

theorem 
  for V being VectSp of GF, A being Subset of V st Lin(A) = V holds ex I
  being Basis of V st I c= A;














begin

reserve V for RealLinearSpace;
reserve u,u1,u2,v,v1,v2,w,w1,y for VECTOR of V;
reserve a,a1,a2,b,b1,b2,c1,c2 for Real;
reserve x,z for set;

definition
  let V;
  let w,y;
  pred Gen w,y means


  (for u ex a1,a2 st u = a1*w + a2*y) & for a1,a2 st
  a1*w + a2*y = 0.V holds a1=0 & a2=0;
end;

definition
  let V;
  let u,v,w,y;
  pred u,v are_Ort_wrt w,y means


  ex a1,a2,b1,b2 st u = a1*w + a2*y & v = b1*w + b2*y & a1*b1 + a2*b2 = 0;
end;

theorem 
  for w,y st Gen w,y holds (u,v are_Ort_wrt w,y iff for a1,a2,b1,b2
  st u = a1*w + a2*y & v = b1*w + b2*y holds a1*b1 + a2*b2 = 0 );

theorem 
  w,y are_Ort_wrt w,y;

theorem 
  ex V st ex w,y st Gen w,y;

theorem 
  u,v are_Ort_wrt w,y implies v,u are_Ort_wrt w,y;

theorem 
  Gen w,y implies for u,v holds u,0.V are_Ort_wrt w,y & 0.V,v are_Ort_wrt w,y;

theorem 
  u,v are_Ort_wrt w,y implies a*u,b*v are_Ort_wrt w,y;

theorem 
  u,v are_Ort_wrt w,y implies a*u,v are_Ort_wrt w,y & u,b*v are_Ort_wrt w,y;

theorem 
  Gen w,y implies for u ex v st u,v are_Ort_wrt w,y & v<>0.V;

theorem 
  Gen w,y & v,u1 are_Ort_wrt w,y & v,u2 are_Ort_wrt w,y & v<>0.V
  implies ex a,b st a*u1 = b*u2 & (a<>0 or b<>0);

theorem 
  Gen w,y & u,v1 are_Ort_wrt w,y & u,v2 are_Ort_wrt w,y implies u,
  v1+v2 are_Ort_wrt w,y & u,v1-v2 are_Ort_wrt w,y;

theorem 
  Gen w,y & u,u are_Ort_wrt w,y implies u = 0.V;

theorem 
  Gen w,y & u,u1-u2 are_Ort_wrt w,y & u1,u2-u are_Ort_wrt w,y
  implies u2,u-u1 are_Ort_wrt w,y;

theorem 
  Gen w,y & u <> 0.V implies ex a st v - a*u,u are_Ort_wrt w,y;

theorem 
  (u,v // u1,v1 or u,v // v1,u1) iff ex a,b st a*(v-u) = b*(v1-u1)
  & (a<>0 or b<>0);

theorem 
  [[u,v],[u1,v1]] in lambda(DirPar(V)) iff ex a,b st a*(v-u) = b*(
  v1-u1) & (a<>0 or b<>0);

definition
  let V;
  let u,u1,v,v1,w,y;
  pred u,u1,v,v1 are_Ort_wrt w,y means


  u1-u,v1-v are_Ort_wrt w,y;
end;

definition
  let V;
  let w,y;
  func Orthogonality(V,w,y) -> Relation of [:the carrier of V,the carrier of V
  :] means


  [x,z] in it iff ex u,u1,v,v1 st x=[u,u1] & z=[v,v1] & u,u1,v,v1
  are_Ort_wrt w,y;
end;

reserve p,p1,q,q1 for Element of Lambda(OASpace(V));

theorem 
  the carrier of Lambda(OASpace(V)) = the carrier of V;

theorem 
  the CONGR of Lambda(OASpace(V)) = lambda(DirPar(V));

theorem 
  p=u & q=v & p1=u1 & q1=v1 implies (p,q // p1,q1 iff ex a,b st a*(v-u)
  = b*(v1-u1) & (a<>0 or b<>0) );

definition
  struct(AffinStruct) ParOrtStr (# carrier -> set, CONGR -> (Relation of [:the
carrier,the carrier:]), orthogonality -> Relation of [:the carrier,the carrier
    :] #);
end;

registration
  cluster non empty for ParOrtStr;
end;

reserve POS for non empty ParOrtStr;

definition
  let POS;
  let a,b,c,d be Element of POS;

  pred a,b _|_ c,d means


  [[a,b],[c,d]] in the orthogonality of POS;
end;

definition
  let V,w,y;
  func AMSpace(V,w,y) -> strict ParOrtStr equals

  ParOrtStr(#the carrier of V,
    lambda(DirPar(V)),Orthogonality(V,w,y)#);
end;

registration
  let V,w,y;
  cluster AMSpace(V,w,y) -> non empty;
end;

theorem 
  the carrier of AMSpace(V,w,y) = the carrier of V & the CONGR of
  AMSpace(V,w,y) = lambda(DirPar(V)) & the orthogonality of AMSpace(V,w,y) =
  Orthogonality(V,w,y);

definition
  let POS;
  func Af(POS) -> strict AffinStruct equals

  AffinStruct (# the carrier of POS,
    the CONGR of POS #);
end;

registration
  let POS;
  cluster Af POS -> non empty;
end;

theorem 
  Af(AMSpace(V,w,y)) = Lambda(OASpace(V));

reserve p,p1,p2,q,q1,r,r1,r2 for Element of AMSpace(V,w,y);

theorem 
  p=u & p1=u1 & q=v & q1=v1 implies (p,q _|_ p1,q1 iff u,v,u1,v1
  are_Ort_wrt w,y);

theorem 
  p=u & q=v & p1=u1 & q1=v1 implies (p,q // p1,q1 iff ex a,b st a*
  (v-u) = b*(v1-u1) & (a<>0 or b<>0) );

theorem 
  p,q _|_ p1,q1 implies p1,q1 _|_ p,q;

theorem 
  p,q _|_ p1,q1 implies p,q _|_ q1,p1;

theorem 
  Gen w,y implies for p,q,r holds p,q _|_ r,r;

theorem 
  p,p1 _|_ q,q1 & p,p1 // r,r1 implies p=p1 or q,q1 _|_ r,r1;

theorem 
  Gen w,y implies for p,q,r ex r1 st p,q _|_ r,r1 & r<>r1;

theorem 
  Gen w,y & p,p1 _|_ q,q1 & p,p1 _|_ r,r1 implies p=p1 or q,q1 // r,r1;

theorem 
  Gen w,y & p,q _|_ r,r1 & p,q _|_ r,r2 implies p,q _|_ r1,r2;

theorem 
  Gen w,y & p,q _|_ p,q implies p = q;

theorem 
  Gen w,y & p,q _|_ p1,p2 & p1,q _|_ p2,p implies p2,q _|_ p,p1;

theorem 
  Gen w,y & p<>p1 implies for q ex q1 st p,p1 // p,q1 & p,p1 _|_ q1,q;

definition
  let IT be non empty ParOrtStr;
  attr IT is OrtAfSp-like means


  AffinStruct(#the carrier of IT,the
CONGR of IT#) is AffinSpace & (for a,b,c,d,p,q,r,s being Element of IT holds (a
,b _|_ a,b implies a=b) & a,b _|_ c,c & (a,b _|_ c,d implies a,b _|_ d,c & c,d
_|_ a,b) & (a,b _|_ p,q & a,b // r,s implies p,q _|_ r,s or a=b) & (a,b _|_ p,q
& a,b _|_ p,s implies a,b _|_ q,s)) & (for a,b,c being Element of IT st a<>b ex
x being Element of IT st a,b // a,x & a,b _|_ x,c) & for a,b,c being Element of
  IT ex x being Element of IT st a,b _|_ c,x & c <>x;
end;

registration
  cluster strict OrtAfSp-like for non empty ParOrtStr;
end;

definition
  mode OrtAfSp is OrtAfSp-like non empty ParOrtStr;
end;

theorem 
  Gen w,y implies AMSpace(V,w,y) is OrtAfSp;

definition
  let IT be non empty ParOrtStr;
  attr IT is OrtAfPl-like means


  AffinStruct(#the carrier of IT,the
CONGR of IT#) is AffinPlane & (for a,b,c,d,p,q,r,s being Element of IT holds (a
,b _|_ a,b implies a=b) & a,b _|_ c,c & (a,b _|_ c,d implies a,b _|_ d,c & c,d
_|_ a,b) & (a,b _|_ p,q & a,b // r,s implies p,q _|_ r,s or a=b) & (a,b _|_ p,q
& a,b _|_ r,s implies p,q // r,s or a=b)) & for a,b,c being Element of IT ex x
  being Element of IT st a,b _|_ c,x & c <>x;
end;

registration
  cluster strict OrtAfPl-like for non empty ParOrtStr;
end;

definition
  mode OrtAfPl is OrtAfPl-like non empty ParOrtStr;
end;

theorem 
  Gen w,y implies AMSpace(V,w,y) is OrtAfPl;

theorem 
  for x being set holds (x is Element of POS iff x is Element of Af(POS) );

theorem 
  for a,b,c,d being Element of POS, a9,b9,c9,d9 being Element of
  Af(POS) st a=a9& b=b9 & c = c9 & d=d9 holds (a,b // c,d iff a9,b9 // c9,d9);

registration
  let POS be OrtAfSp;
  cluster Af(POS) -> AffinSpace-like non trivial;
end;

registration
  let POS be OrtAfPl;
  cluster Af(POS) -> 2-dimensional AffinSpace-like non trivial;
end;

theorem 
  for POS being OrtAfPl holds POS is OrtAfSp;

registration
  cluster OrtAfPl-like -> OrtAfSp-like for non empty ParOrtStr;
end;

theorem 
  for POS being OrtAfSp st Af(POS) is AffinPlane holds POS is OrtAfPl;

theorem 
  for POS being non empty ParOrtStr holds POS is OrtAfPl-like iff (ex a,
  b being Element of POS st a<>b) & for a,b,c,d,p,q,r,s being Element of POS
holds a,b // b,a & a,b // c,c & (a,b // p,q & a,b // r,s implies p,q // r,s or
a=b) & (a,b // a,c implies b,a // b,c) & (ex x being Element of POS st a,b // c
  ,x & a,c // b,x) & (ex x,y,z being Element of POS st not x,y // x,z ) & (ex x
  being Element of POS st a,b // c,x & c <>x) & (a,b // b,d & b<>a implies ex x
being Element of POS st c,b // b,x & c,a // d,x) & (a,b _|_ a,b implies a=b) &
a,b _|_ c,c & (a,b _|_ c,d implies a,b _|_ d,c & c,d _|_ a,b) & (a,b _|_ p,q &
a,b // r,s implies p,q _|_ r,s or a=b) & (a,b _|_ p,q & a,b _|_ r,s implies p,q
// r,s or a=b) & (ex x being Element of POS st a,b _|_ c,x & c <>x) & (not a,b
  // c,d implies ex x being Element of POS st a,b // a,x & c,d // c,x );

reserve x,a,b,c,d,p,q,y for Element of POS;

definition
  let POS;
  let a,b,c;
  pred LIN a,b,c means


  a,b // a,c;
end;

definition
  let POS,a,b;
  func Line(a,b) -> Subset of POS means


  for x being Element of POS holds x in it iff LIN a,b,x;
end;

reserve A,K,M for Subset of POS;

definition
  let POS;
  let A;
  attr A is being_line means


  ex a,b st a<>b & A=Line(a,b);
end;

theorem 
  for POS being OrtAfSp for a,b,c being Element of POS, a9,b9,c9
being Element of Af(POS) st a=a9& b=b9 & c = c9 holds (LIN a,b,c iff LIN a9,b9,
  c9);

theorem 
  for POS being OrtAfSp for a,b being Element of POS, a9,b9 being
  Element of Af(POS) st a=a9 & b=b9 holds Line(a,b) = Line(a9,b9);

theorem 
  for X being set holds ( X is Subset of POS iff X is Subset of Af(POS));

theorem 
  for POS being OrtAfSp for X being Subset of POS, Y being Subset
  of Af(POS) st X=Y holds ( X is being_line iff Y is being_line);

definition
  let POS;
  let a,b,K;
  pred a,b _|_ K means


  ex p,q st p<>q & K = Line(p,q) & a,b _|_ p,q;
end;

definition
  let POS;
  let K,M;
  pred K _|_ M means


  ex p,q st p<>q & K = Line(p,q) & p,q _|_ M;
end;

definition
  let POS;
  let K,M;
  pred K // M means


  ex a,b,c,d st a<>b & c <>d & K = Line(a,b) & M = Line(c,d) & a,b // c,d;
end;

theorem 
  (a,b _|_ K implies K is being_line) & (K _|_ M implies K is
  being_line & M is being_line );

theorem 
  K _|_ M iff ex a,b,c,d st a<>b & c <>d & K = Line(a,b) & M =
  Line(c,d) & a,b _|_ c,d;

theorem 
  for POS being OrtAfSp for M,N being Subset of POS, M9,N9 being
  Subset of Af(POS) st M = M9 & N = N9 holds (M // N iff M9 // N9);

reserve POS for OrtAfSp;
reserve A,K,M,N for Subset of POS;
reserve a,b,c,d,p,q,r,s for Element of POS;

theorem 
  K is being_line implies a,a _|_ K;

theorem 
  a,b _|_ K & (a,b // c,d or c,d // a,b) & a<>b implies c,d _|_ K;

theorem 
  a,b _|_ K implies b,a _|_ K;

definition
  let POS;
  let K,M be Subset of POS;
  redefine pred K // M;
  symmetry;
end;

theorem 
  r,s _|_ K & K // M implies r,s _|_ M;

theorem 
  a in K & b in K & a,b _|_ K implies a=b;

definition
  let POS;
  let K,M be Subset of POS;
  redefine pred K _|_ M;
  irreflexivity;
  symmetry;
end;

theorem 
  K _|_ M & K // N implies N _|_ M;

theorem 
  a in K & b in K & c,d _|_ K implies c,d _|_ a,b & a,b _|_ c,d;

theorem 
  a in K & b in K & a<>b & K is being_line implies K =Line(a,b);

theorem 
  a in K & b in K & a<>b & K is being_line & (a,b _|_ c,d or c,d _|_ a,b
  ) implies c,d _|_ K;

theorem 
  a in M & b in M & c in N & d in N & M _|_ N implies a,b _|_ c,d;

theorem 
  p in M & p in N & a in M & b in N & a<>b & a in K & b in K & A _|_ M &
  A _|_ N & K is being_line implies A _|_ K;

theorem 
  b,c _|_ a,a & a,a _|_ b,c & b,c // a,a & a,a // b,c;

theorem 
  a,b // c,d implies a,b // d,c & b,a // c,d & b,a // d,c & c,d //
  a,b & c,d // b,a & d,c // a,b & d,c // b,a;

theorem 
  p<>q & ( p,q // a,b & p,q // c,d or p,q // a,b & c,d // p,q or a,b //
  p,q & c,d // p,q or a,b // p,q & p,q // c,d ) implies a,b // c,d;

theorem 
  a,b _|_ c,d implies a,b _|_ d,c & b,a _|_ c,d & b,a _|_ d,c & c,
  d _|_ a,b & c,d _|_ b,a & d,c _|_ a,b & d,c _|_ b,a;

theorem 
  p<>q & ( p,q // a,b & p,q _|_ c,d or p,q // c,d & p,q _|_ a,b or
p,q // a,b & c,d _|_ p,q or p,q // c,d & a,b _|_ p,q or a,b // p,q & c,d _|_ p,
  q or c,d // p,q & a,b _|_ p,q or a,b // p,q & p,q _|_ c,d or c,d // p,q & p,q
  _|_ a,b ) implies a,b _|_ c,d;

reserve POS for OrtAfPl;
reserve K,M,N for Subset of POS;
reserve x,a,b,c,d,p,q for Element of POS;

theorem 
  p<>q & ( p,q _|_ a,b & p,q _|_ c,d or p,q _|_ a,b & c,d _|_ p,q
or a,b _|_ p,q & c,d _|_ p,q or a,b _|_ p,q & p,q _|_ c,d ) implies a,b // c,d;

theorem 
  a in M & b in M & a<>b & M is being_line & c in N & d in N & c <>d & N
  is being_line & a,b // c,d implies M // N;

theorem 
  M _|_ K & N _|_ K implies M // N;

theorem 
  M _|_ N implies ex p st p in M & p in N;

theorem 
  a,b _|_ c,d implies ex p st LIN a,b,p & LIN c,d,p;

theorem 
  a,b _|_ K implies ex p st LIN a,b,p & p in K;

theorem 
  ex x st a,x _|_ p,q & LIN p,q,x;

theorem 
  K is being_line implies ex x st a,x _|_ K & x in K;














begin

reserve x,y,y1,y2 for set;
reserve G for Group;
reserve a,b,c,d,g,h for Element of G;
reserve A,B,C,D for Subset of G;
reserve H,H1,H2,H3 for Subgroup of G;
reserve n for Nat;
reserve i for Integer;

theorem 
  a * b * b" = a & a * b" * b = a & b" * b * a = a & b * b" * a = a
  & a * (b * b") = a & a * (b" * b) = a & b" * (b * a) = a & b * (b" * a) = a;

theorem 
  G is commutative Group iff the multF of G is commutative;

theorem 
  (1).G is commutative;

theorem 
  A c= B & C c= D implies A * C c= B * D;

theorem 
  A c= B implies a * A c= a * B & A * a c= B * a;

theorem 
  H1 is Subgroup of H2 implies a * H1 c= a * H2 & H1 * a c= H2 * a;

theorem 
  a * H = {a} * H;

theorem 
  H * a = H * {a};

theorem 
  A * a * H = A * (a * H);

theorem 
  a * H * A = a * (H * A);

theorem 
  A * H * a = A * (H * a);

theorem 
  H * a * A = H * (a * A);

theorem 
  H1 * a * H2 = H1 * (a * H2);

definition
  let G;
  func Subgroups G -> set means


  x in it iff x is strict Subgroup of G;
end;

registration
  let G;
  cluster Subgroups G -> non empty;
end;

theorem 
  for G being strict Group holds G in Subgroups G;

theorem 
  G is finite implies Subgroups G is finite;

definition
  let G,a,b;
  func a |^ b -> Element of G equals

  b" * a * b;
end;

theorem 
  a |^ g = b |^ g implies a = b;

theorem 
  (1_G) |^ a = 1_G;

theorem 
  a |^ b = 1_G implies a = 1_G;

theorem 
  a |^ 1_G = a;

theorem 
  a |^ a = a;

theorem 
  a |^ a" = a & a" |^ a = a";

theorem 
  a |^ b = a iff a * b = b * a;

theorem 
  (a * b) |^ g = a |^ g * (b |^ g);

theorem 
  a |^ g |^ h = a |^ (g * h);

theorem 
  a |^ b |^ b" = a & a |^ b" |^ b = a;

theorem 
  a" |^ b = (a |^ b)";

theorem 
  (a |^ n) |^ b = (a |^ b) |^ n;

theorem 
  (a |^ i) |^ b = (a |^ b) |^ i;

theorem 
  G is commutative Group implies a |^ b = a;

theorem 
  (for a,b holds a |^ b = a) implies G is commutative;

definition
  let G,A,B;
  func A |^ B -> Subset of G equals

  {g |^ h : g in A & h in B};
end;

theorem 
  x in A |^ B iff ex g,h st x = g |^ h & g in A & h in B;

theorem 
  A |^ B <> {} iff A <> {} & B <> {};

theorem 
  A |^ B c= B" * A * B;

theorem 
  (A * B) |^ C c= A |^ C * (B |^ C);

theorem 
  A |^ B |^ C = A |^ (B * C);

theorem 
  A" |^ B = (A |^ B)";

theorem 
  {a} |^ {b} = {a |^ b};

theorem 
  {a} |^ {b,c} = {a |^ b,a |^ c};

theorem 
  {a,b} |^ {c} = {a |^ c,b |^ c};

theorem 
  {a,b} |^ {c,d} = {a |^ c,a |^ d,b |^ c,b |^ d};

definition
  let G,A,g;
  func A |^ g -> Subset of G equals

  A |^ {g};
  func g |^ A -> Subset of G equals

  {g} |^ A;
end;

theorem 
  x in A |^ g iff ex h st x = h |^ g & h in A;

theorem 
  x in g |^ A iff ex h st x = g |^ h & h in A;

theorem 
  g |^ A c= A" * g * A;

theorem 
  A |^ B |^ g = A |^ (B * g);

theorem 
  A |^ g |^ B = A |^ (g * B);

theorem 
  g |^ A |^ B = g |^ (A * B);

theorem 
  A |^ a |^ b = A |^ (a * b);

theorem 
  a |^ A |^ b = a |^ (A * b);

theorem 
  a |^ b |^ A = a |^ (b * A);

theorem 
  A |^ g = g" * A * g;

theorem 
  (A * B) |^ a c= (A |^ a) * (B |^ a);

theorem 
  A |^ 1_G = A;

theorem 
  A <> {} implies (1_G) |^ A = {1_G};

theorem 
  A |^ a |^ a" = A & A |^ a" |^ a = A;

theorem 
  G is commutative Group iff for A,B st B <> {} holds A |^ B = A;

theorem 
  G is commutative Group iff for A,g holds A |^ g = A;

theorem 
  G is commutative Group iff for A,g st A <> {} holds g |^ A = {g};

definition
  let G,H,a;
  func H |^ a -> strict Subgroup of G means


  the carrier of it = carr(H) |^ a;
end;

theorem 
  x in H |^ a iff ex g st x = g |^ a & g in H;

theorem 
  the carrier of H |^ a = a" * H * a;

theorem 
  H |^ a |^ b = H |^ (a * b);

theorem 
  for H being strict Subgroup of G holds H |^ 1_G = H;

theorem 
  for H being strict Subgroup of G holds H |^ a |^ a" = H & H |^ a " |^ a = H;

theorem 
  (H1 /\ H2) |^ a = (H1 |^ a) /\ (H2 |^ a);

theorem 
  card H = card(H |^ a);

theorem 
  H is finite iff H |^ a is finite;

registration
  let G,a;
  let H be finite Subgroup of G;
  cluster H |^ a -> finite;
end;

theorem 
  for H being finite Subgroup of G holds card H = card(H |^ a);

theorem 
  (1).G |^ a = (1).G;

theorem 
  for H being strict Subgroup of G holds H |^ a = (1).G implies H = (1). G;

theorem 
  for G being Group, a being Element of G holds (Omega).G |^ a = (Omega).G;

theorem 
  for H being strict Subgroup of G holds H |^ a = G implies H = G;

theorem 
  Index H = Index(H |^ a);

theorem 
  Left_Cosets H is finite implies index H = index(H |^ a);

theorem 
  G is commutative Group implies for H being strict Subgroup of G
  for a holds H |^ a = H;

definition
  let G,a,b;
  pred a,b are_conjugated means


  ex g st a = b |^ g;
end;

notation
  let G,a,b;
  antonym a,b are_not_conjugated for a,b are_conjugated;
end;

theorem 
  a,b are_conjugated iff ex g st b = a |^ g;

theorem 
  a,a are_conjugated;

theorem 
  a,b are_conjugated implies b,a are_conjugated;

definition
  let G,a,b;
  redefine pred a,b are_conjugated;
  reflexivity;
  symmetry;
end;

theorem 
  a,b are_conjugated & b,c are_conjugated implies a,c are_conjugated;

theorem 
  a,1_G are_conjugated or 1_G,a are_conjugated implies a = 1_G;

theorem 
  a |^ carr (Omega).G = {b : a,b are_conjugated};

definition
  let G,a;
  func con_class a -> Subset of G equals

  a |^ carr (Omega).G;
end;

theorem 
  x in con_class a iff ex b st b = x & a,b are_conjugated;

theorem 
  a in con_class b iff a,b are_conjugated;

theorem 
  a |^ g in con_class a;

theorem 
  a in con_class a;

theorem 
  a in con_class b implies b in con_class a;

theorem 
  con_class a = con_class b iff con_class a meets con_class b;

theorem 
  con_class a = {1_G} iff a = 1_G;

theorem 
  con_class a * A = A * con_class a;

definition
  let G,A,B;
  pred A,B are_conjugated means


  ex g st A = B |^ g;
end;

notation
  let G,A,B;
  antonym A,B are_not_conjugated for A,B are_conjugated;
end;

theorem 
  A,B are_conjugated iff ex g st B = A |^ g;

theorem 
  A,A are_conjugated;

theorem 
  A,B are_conjugated implies B,A are_conjugated;

definition
  let G,A,B;
  redefine pred A,B are_conjugated;
  reflexivity;
  symmetry;
end;

theorem 
  A,B are_conjugated & B,C are_conjugated implies A,C are_conjugated;

theorem 
  {a},{b} are_conjugated iff a,b are_conjugated;

theorem 
  A,carr H1 are_conjugated implies ex H2 being strict Subgroup of
  G st the carrier of H2 = A;

definition
  let G,A;
  func con_class A -> Subset-Family of G equals

  {B : A,B are_conjugated};
end;

theorem 
  x in con_class A iff ex B st x = B & A,B are_conjugated;

theorem 
  A in con_class B iff A,B are_conjugated;

theorem 
  A |^ g in con_class A;

theorem 
  A in con_class A;

theorem 
  A in con_class B implies B in con_class A;

theorem 
  con_class A = con_class B iff con_class A meets con_class B;

theorem 
  con_class{a} = {{b} : b in con_class a};

theorem 
  G is finite implies con_class A is finite;

definition
  let G,H1,H2;
  pred H1,H2 are_conjugated means


  ex g st the multMagma of H1 = H2 |^ g;
end;

notation
  let G,H1,H2;
  antonym H1,H2 are_not_conjugated for H1,H2 are_conjugated;
end;

theorem 
  for H1,H2 being strict Subgroup of G holds H1,H2 are_conjugated
  iff ex g st H2 = H1 |^ g;

theorem 
  for H1 being strict Subgroup of G holds H1,H1 are_conjugated;

theorem 
  for H1,H2 being strict Subgroup of G holds H1,H2 are_conjugated
  implies H2,H1 are_conjugated;

definition
  let G;
  let H1,H2 be strict Subgroup of G;
  redefine pred H1,H2 are_conjugated;
  reflexivity;
  symmetry;
end;

theorem 
  for H1,H2 being strict Subgroup of G holds H1,H2 are_conjugated
  & H2,H3 are_conjugated implies H1,H3 are_conjugated;

reserve L for Subset of Subgroups G;

definition
  let G,H;
  func con_class H -> Subset of Subgroups G means


  x in it iff ex H1 being strict Subgroup of G st x = H1 & H,H1 are_conjugated;
end;

theorem 
  x in con_class H implies x is strict Subgroup of G;

theorem 
  for H1,H2 being strict Subgroup of G holds H1 in con_class H2
  iff H1,H2 are_conjugated;

theorem 
  for H being strict Subgroup of G holds H |^ g in con_class H;

theorem 
  for H being strict Subgroup of G holds H in con_class H;

theorem 
  for H1,H2 being strict Subgroup of G holds H1 in con_class H2 implies
  H2 in con_class H1;

theorem 
  for H1,H2 being strict Subgroup of G holds con_class H1 = con_class H2
  iff con_class H1 meets con_class H2;

theorem 
  G is finite implies con_class H is finite;

theorem 
  for H1 being strict Subgroup of G holds H1,H2 are_conjugated
  iff carr H1,carr H2 are_conjugated;

definition
  let G;
  let IT be Subgroup of G;
  attr IT is normal means


  for a holds IT |^ a = the multMagma of IT;
end;

registration
  let G;
  cluster strict normal for Subgroup of G;
end;

reserve N2 for normal Subgroup of G;

theorem 
  (1).G is normal & (Omega).G is normal;

theorem 
  for N1,N2 being strict normal Subgroup of G holds N1 /\ N2 is normal;

theorem 
  for H being strict Subgroup of G holds G is commutative Group implies
  H is normal;

theorem 
  H is normal Subgroup of G iff for a holds a * H = H * a;

theorem 
  for H being Subgroup of G holds H is normal Subgroup of G iff
  for a holds a * H c= H * a;

theorem 
  for H being Subgroup of G holds H is normal Subgroup of G iff
  for a holds H * a c= a * H;

theorem 
  for H being Subgroup of G holds H is normal Subgroup of G iff for A
  holds A * H = H * A;

theorem 
  for H being strict Subgroup of G holds H is normal Subgroup of G iff
  for a holds H is Subgroup of H |^ a;

theorem 
  for H being strict Subgroup of G holds H is normal Subgroup of G iff
  for a holds H |^ a is Subgroup of H;

theorem 
  for H being strict Subgroup of G holds H is normal Subgroup of G iff
  con_class H = {H};

theorem 
  for H being strict Subgroup of G holds H is normal Subgroup of G iff
  for a st a in H holds con_class a c= carr H;

theorem 
  for N1,N2 being strict normal Subgroup of G holds carr N1 *
  carr N2 = carr N2 * carr N1;

theorem 
  for N1,N2 being strict normal Subgroup of G ex N being strict normal
  Subgroup of G st the carrier of N = carr N1 * carr N2;

theorem 
  for N being normal Subgroup of G holds Left_Cosets N = Right_Cosets N;

theorem 
  for H being Subgroup of G holds Left_Cosets H is finite & index H = 2
  implies H is normal Subgroup of G;

definition
  let G;
  let A;
  func Normalizer A -> strict Subgroup of G means


  the carrier of it = {h : A |^ h = A};
end;

theorem 
  x in Normalizer A iff ex h st x = h & A |^ h = A;

theorem 
  card con_class A = Index Normalizer A;

theorem 
  con_class A is finite or Left_Cosets Normalizer A is finite implies
  ex C being finite set st C = con_class A & card C = index Normalizer A;

theorem 
  card con_class a = Index Normalizer{a};

theorem 
  con_class a is finite or Left_Cosets Normalizer{a} is finite implies
  ex C being finite set st C = con_class a & card C = index Normalizer{a};

definition
  let G;
  let H;
  func Normalizer H -> strict Subgroup of G equals

  Normalizer carr H;
end;

theorem 
  for H being strict Subgroup of G holds x in Normalizer H iff
  ex h st x = h & H |^ h = H;

theorem 
  for H being strict Subgroup of G holds card con_class H = Index
  Normalizer H;

theorem 
  for H being strict Subgroup of G holds con_class H is finite or
  Left_Cosets Normalizer H is finite implies ex C being finite set st C =
  con_class H & card C = index Normalizer H;

theorem 
  for G being strict Group, H being strict Subgroup of G holds H
  is normal Subgroup of G iff Normalizer H = G;

theorem 
  for G being strict Group holds Normalizer (1).G = G;

theorem 
  for G being strict Group holds Normalizer (Omega).G = G;














begin

reserve FCPS for up-3-dimensional CollProjectiveSpace;
reserve a,a9,b,b9,c,c9,d,d9,o,p,q,r,s,t,u,x,y,z for Element of FCPS;

theorem 
  a,b,c is_collinear implies b,c,a is_collinear & c,a,b
  is_collinear & b,a,c is_collinear & a,c,b is_collinear & c,b,a is_collinear;

theorem 
  ex q,r st not p,q,r is_collinear;

theorem 
  not a,b,c is_collinear & a,b,b9 is_collinear & a<>b9 implies not a,b9,
  c is_collinear;

theorem 
  not a,b,c is_collinear & a,b,d is_collinear & a,c,d is_collinear implies a=d;

theorem 
  not o,a,d is_collinear & o,d,d9 is_collinear & d<>d9 & a9,d9,s
  is_collinear & o,a,a9 is_collinear & o<>a9 implies s<>d;

definition
  let FCPS,a,b,c,d;
  pred a,b,c,d are_coplanar means


  ex x being Element of FCPS st a,b,x is_collinear & c,d,x is_collinear;
end;

theorem 
  a,b,c is_collinear or b,c,d is_collinear or c,d,a is_collinear
  or d,a,b is_collinear implies a,b,c,d are_coplanar;

theorem 
  a,b,c,d are_coplanar implies b,c,d,a are_coplanar & c,d,a,b
  are_coplanar & d,a,b,c are_coplanar & b,a,c,d are_coplanar & c,b,d,a
  are_coplanar & d,c,a,b are_coplanar & a,d,b,c are_coplanar & a,c,d,b
  are_coplanar & b,d,a,c are_coplanar & c,a,b,d are_coplanar & d,b,c,a
  are_coplanar & c,a,d,b are_coplanar & d,b,a,c are_coplanar & a,c,b,d
  are_coplanar & b,d,c,a are_coplanar & a,b,d,c are_coplanar & a,d,c,b
  are_coplanar & b,c,a,d are_coplanar & b,a,d,c are_coplanar & c,b,a,d
  are_coplanar & c,d,b,a are_coplanar & d,a,c,b are_coplanar & d,c,b,a
  are_coplanar;

theorem 
  not a,b,c is_collinear & a,b,c,p are_coplanar & a,b,c,q
  are_coplanar & a,b,c,r are_coplanar & a,b,c,s are_coplanar implies p,q,r,s
  are_coplanar;

theorem 
  not p,q,r is_collinear & a,b,c,p are_coplanar & a,b,c,r are_coplanar &
  a,b,c,q are_coplanar & p,q,r,s are_coplanar implies a,b,c,s are_coplanar;

theorem 
  p<>q & p,q,r is_collinear & a,b,c,p are_coplanar & a,b,c,q
  are_coplanar implies a,b,c,r are_coplanar;

theorem 
  not a,b,c is_collinear & a,b,c,p are_coplanar & a,b,c,q are_coplanar &
a,b,c,r are_coplanar & a,b,c,s are_coplanar implies ex x st p,q,x is_collinear
  & r,s,x is_collinear;

theorem 
  ex a,b,c,d st not a,b,c,d are_coplanar;

theorem 
  not p,q,r is_collinear implies ex s st not p,q,r,s are_coplanar;

theorem 
  a=b or a=c or b=c or a=d or b=d or d=c implies a,b,c,d are_coplanar;

theorem 
  not a,b,c,o are_coplanar & o,a,a9 is_collinear & a<>a9 implies
  not a,b,c,a9 are_coplanar;

theorem 
  not a,b,c is_collinear & not a9,b9,c9 is_collinear & a,b,c,p
  are_coplanar & a,b,c,q are_coplanar & a,b,c,r are_coplanar & a9,b9,c9,p
are_coplanar & a9,b9,c9,q are_coplanar & a9,b9,c9,r are_coplanar & not a,b,c,a9
  are_coplanar implies p,q,r is_collinear;

theorem 
  a<>a9 & o,a,a9 is_collinear & not a,b,c,o are_coplanar & not a9,
  b9,c9 is_collinear & a,b,p is_collinear & a9,b9,p is_collinear & b,c,q
is_collinear & b9,c9,q is_collinear & a,c,r is_collinear & a9,c9,r is_collinear
  implies p,q,r is_collinear;

theorem 
  not a,b,c,d are_coplanar & a,b,c,o are_coplanar & not a,b,o
  is_collinear implies not a,b,d,o are_coplanar;

theorem 
  not a,b,c,o are_coplanar & o,a,a9 is_collinear & o,b,b9
is_collinear & o,c,c9 is_collinear & o<>a9 & o<>b9 & o<>c9 implies not a9,b9,c9
  is_collinear & not a9,b9,c9,o are_coplanar;

theorem 
  a,b,c,o are_coplanar & not a,b,c,d are_coplanar & not a,b,d,o
are_coplanar & o,d,d9 is_collinear & o,a,a9 is_collinear & o,b,b9 is_collinear
  & a,d,s is_collinear & a9,d9,s is_collinear & b,d,t is_collinear & b9,d9,t
  is_collinear & c,d,u is_collinear & o<>a9 & d<>d9 & o<>b9 implies not s,t,u
  is_collinear;

definition
  let FCPS,o,a,b,c;
  pred o,a,b,c constitute_a_quadrangle means


  not a,b,c is_collinear &
  not o,a,b is_collinear & not o,b,c is_collinear & not o,c,a is_collinear;
end;

theorem 
  not o,a,b is_collinear & not o,b,c is_collinear & not o,a,c
is_collinear & o,a,a9 is_collinear & o,b,b9 is_collinear & o,c,c9 is_collinear
& a,b,p is_collinear & a9,b9,p is_collinear & a<>a9 & b,c,r is_collinear & b9,
c9,r is_collinear & a,c,q is_collinear & b<>b9 & a9,c9,q is_collinear & o<>a9 &
  o<>b9 & o<>c9 implies r,q,p is_collinear;

theorem 
  for CS being up-3-dimensional CollProjectiveSpace holds CS is Desarguesian;

registration
  cluster -> Desarguesian for up-3-dimensional CollProjectiveSpace;
end;














begin

definition
  let D be non empty set;
  let F be FinSequence of D;
  let X be set;
  redefine func F - X -> FinSequence of D;
end;

scheme 

  MeetSbgEx{G() -> Group, P[set]}: ex H being strict Subgroup of G() st the
carrier of H = meet{A where A is Subset of G() : ex K being strict Subgroup of
  G() st A = the carrier of K & P[K]}
provided
 ex H being strict Subgroup of G() st P[H];

reserve x,y,X,Y for set,
  k,l,n for Element of NAT,
  i,i1,i2,i3,j for Integer,
  G for Group,
  a,b,c,d for Element of G,
  A,B,C for Subset of G,
  H,H1,H2, H3 for Subgroup of G,
  h for Element of H,
  F,F1,F2 for FinSequence of the carrier of G,
  I,I1,I2 for FinSequence of INT;

scheme 

  SubgrSep{G() -> Group,P[set]}: ex X st X c= Subgroups G() & for H being
  strict Subgroup of G() holds H in X iff P[H];

definition
  let i;

  func @i -> Element of INT equals

  i;
end;

theorem 
  a = h implies a |^ n = h |^ n;

theorem 
  a = h implies a |^ i = h |^ i;

theorem 
  a in H implies a |^ n in H;

theorem 
  a in H implies a |^ i in H;

definition
  let G be non empty multMagma;
  let F be FinSequence of the carrier of G;
  func Product F -> Element of G equals

  (the multF of G) "**" F;
end;

theorem 
  for G being associative unital non empty multMagma,
     F1,F2 being FinSequence of the carrier of G holds
     Product(F1 ^ F2) = Product(F1) * Product(F2);

theorem 
  for G being unital non empty multMagma, F being FinSequence of the
carrier of G, a being Element of G holds Product(F ^ <* a *>) = Product(F) * a;

theorem 
  for G being associative unital non empty multMagma, F being
FinSequence of the carrier of G, a being Element of G holds Product(<* a *> ^ F
  ) = a * Product(F);

theorem 
  for G being unital non empty multMagma holds Product <*> the
  carrier of G = 1_G;

theorem 
  for G being non empty multMagma, a being Element of G holds Product<*
  a *> = a;

theorem 
  for G being non empty multMagma, a,b being Element of G holds Product
  <* a,b *> = a * b;

theorem 
  Product<* a,b,c *> = a * b * c & Product<* a,b,c *> = a * (b * c);

theorem 
  Product(n |-> a) = a |^ n;

theorem 
  Product(F - {1_G}) = Product(F);

theorem 
  len F1 = len F2 & (for k st k in dom F1 holds F2.(len F1 - k + 1
  ) = (F1/.k)") implies Product(F1) = Product(F2)";

theorem 
  G is commutative Group implies for P being Permutation of dom F1 st F2
  = F1 * P holds Product(F1) = Product(F2);

theorem 
  G is commutative Group & F1 is one-to-one & F2 is one-to-one & rng F1
  = rng F2 implies Product(F1) = Product(F2);

theorem 
  G is commutative Group & len F = len F1 & len F = len F2 & (for k st k
  in dom F holds F.k = (F1/.k) * (F2/.k)) implies Product(F) = Product(F1) *
  Product(F2);

theorem 
  rng F c= carr H implies Product(F) in H;

definition
  let G,I,F;
  func F |^ I -> FinSequence of the carrier of G means


  len it = len F & for k st k in dom F holds it.k = (F/.k) |^ @(I/.k);
end;

theorem 
  len F1 = len I1 & len F2 = len I2 implies (F1 ^ F2) |^ (I1 ^ I2)
  = (F1 |^ I1) ^ (F2 |^ I2);

theorem 
  rng F c= carr H implies Product(F |^ I) in H;

theorem 
  (<*> the carrier of G) |^ (<*> INT) = {};

theorem 
  <* a *> |^ <* @i *> = <* a |^ i *>;

theorem 
  <* a,b *> |^ <* @i,@j *> = <* a |^ i,b |^ j *>;

theorem 
  <* a,b,c *> |^ <* @i1,@i2,@i3 *> = <* a |^ i1,b |^ i2,c |^ i3 *>;

theorem 
  F |^ (len F |-> @(1)) = F;

theorem 
  F |^ (len F |-> @(0)) = len F |-> 1_G;

theorem 
  len I = n implies (n |-> 1_G) |^ I = n |-> 1_G;

definition
  let G,A;
  func gr A -> strict Subgroup of G means


  A c= the carrier of it & for
H being strict Subgroup of G st A c= the carrier of H holds it is Subgroup of H
  ;
end;

theorem 
  a in gr A iff ex F,I st len F = len I & rng F c= A & Product(F |^ I) = a;

theorem 
  a in A implies a in gr A;

theorem 
  gr {} the carrier of G = (1).G;

theorem 
  for H being strict Subgroup of G holds gr carr H = H;

theorem 
  A c= B implies gr A is Subgroup of gr B;

theorem 
  gr(A /\ B) is Subgroup of gr A /\ gr B;

theorem 
  the carrier of gr A = meet{B : ex H being strict Subgroup of G
  st B = the carrier of H & A c= carr H};

theorem 
  gr A = gr(A \ {1_G});

definition
  let G,a;
  attr a is generating means


  not for A st gr A = the multMagma of G
  holds gr(A \ {a}) = the multMagma of G;
end;

theorem 
  1_G is non generating;

definition
  let G, H;
  attr H is maximal means


  the multMagma of H <> the multMagma of G &
for K being strict Subgroup of G st the multMagma of H <> K & H is Subgroup of
  K holds K = the multMagma of G;
end;

theorem 
  for G being strict Group, H being strict Subgroup of G, a being
  Element of G holds H is maximal & not a in H implies gr(carr H \/ {a}) = G;





definition
  let G be Group;

  func Phi(G) -> strict Subgroup of G means


  the carrier of it = meet{A
where A is Subset of G : ex H being strict Subgroup of G st A = the carrier of
H & H is maximal} if ex H being strict Subgroup of G st H is maximal otherwise
  it = the multMagma of G;
end;

theorem 
  for G being Group holds (ex H being strict Subgroup of G st H is
  maximal) implies (a in Phi(G) iff for H being strict Subgroup of G st H is
  maximal holds a in H);

theorem 
  for G being Group, a being Element of G holds (for H being strict
  Subgroup of G holds H is not maximal) implies a in Phi(G);

theorem 
  for G being Group, H being strict Subgroup of G holds H is
  maximal implies Phi(G) is Subgroup of H;

theorem 
  for G being strict Group holds the carrier of Phi(G) = {a where
  a is Element of G: a is non generating};

theorem 
  for G being strict Group, a being Element of G holds a in Phi(G) iff a
  is non generating;

definition
  let G,H1,H2;
  func H1 * H2 -> Subset of G equals

  carr H1 * carr H2;
end;

theorem 
  H1 * H2 = carr H1 * carr H2 & H1 * H2 = H1 * carr H2 & H1 * H2 = carr
  H1 * H2;

theorem 
  H1 * H2 * H3 = H1 * (H2 * H3);

theorem 
  a * H1 * H2 = a * (H1 * H2);

theorem 
  H1 * H2 * a = H1 * (H2 * a);

theorem 
  A * H1 * H2 = A * (H1 * H2);

theorem 
  H1 * H2 * A = H1 * (H2 * A);

definition
  let G,H1,H2;
  func H1 "\/" H2 -> strict Subgroup of G equals

  gr(carr H1 \/ carr H2);
end;

theorem 
  a in H1 "\/" H2 iff ex F,I st len F = len I & rng F c= carr H1 \/ carr
  H2 & a = Product(F |^ I);

theorem 
  H1 "\/" H2 = gr(H1 * H2);

theorem 
  H1 * H2 = H2 * H1 implies the carrier of H1 "\/" H2 = H1 * H2;

theorem 
  G is commutative Group implies the carrier of H1 "\/" H2 = H1 * H2;

theorem 
  for N1,N2 being strict normal Subgroup of G holds the carrier of
  N1 "\/" N2 = N1 * N2;

theorem 
  for N1,N2 being strict normal Subgroup of G holds N1 "\/" N2 is normal
  Subgroup of G;

theorem 
  for H being strict Subgroup of G holds H "\/" H = H;

theorem 
  H1 "\/" H2 = H2 "\/" H1;

theorem 
  H1 "\/" H2 "\/" H3 = H1 "\/" (H2 "\/" H3);

theorem 
  for H being strict Subgroup of G holds (1).G "\/" H = H & H "\/" (1).G = H;

theorem 
  (Omega).G "\/" H = (Omega).G & H "\/" (Omega).G = (Omega).G;

theorem 
  H1 is Subgroup of H1 "\/" H2 & H2 is Subgroup of H1 "\/" H2;

theorem 
  for H2 being strict Subgroup of G holds H1 is Subgroup of H2 iff
  H1 "\/" H2 = H2;

theorem 
  H1 is Subgroup of H2 implies H1 is Subgroup of H2 "\/" H3;

theorem 
  for H3 being strict Subgroup of G holds H1 is Subgroup of H3 & H2 is
  Subgroup of H3 implies H1 "\/" H2 is Subgroup of H3;

theorem 
  for H3,H2 being strict Subgroup of G holds H1 is Subgroup of H2
  implies H1 "\/" H3 is Subgroup of H2 "\/" H3;

theorem 
  H1 /\ H2 is Subgroup of H1 "\/" H2;

theorem 
  for H2 being strict Subgroup of G holds (H1 /\ H2) "\/" H2 = H2;

theorem 
  for H1 being strict Subgroup of G holds H1 /\ (H1 "\/" H2) = H1;

theorem 
  for H1,H2 being strict Subgroup of G holds H1 "\/" H2 = H2 iff H1 /\ H2 = H1;

reserve S1,S2 for Element of Subgroups G;

definition
  let G;
  func SubJoin G -> BinOp of Subgroups G means


  for H1,H2 being strict Subgroup of G holds it.(H1,H2) = H1 "\/" H2;
end;

definition
  let G;
  func SubMeet G -> BinOp of Subgroups G means


  for H1,H2 being strict Subgroup of G holds it.(H1,H2) = H1 /\ H2;
end;

definition
  let G be Group;
  func lattice G -> strict Lattice equals

  LattStr (# Subgroups G, SubJoin G,
    SubMeet G #);
end;

theorem 
  the carrier of lattice G = Subgroups G;

theorem 
  the L_join of lattice G = SubJoin G;

theorem 
  the L_meet of lattice G = SubMeet G;

registration
  let G be Group;
  cluster lattice G -> lower-bounded upper-bounded;
end;

theorem 
  Bottom lattice G = (1).G;

theorem 
  Top lattice G = (Omega).G;














begin

reserve i1 for Element of INT;
reserve j1,j2,j3 for Integer;
reserve p,s,k,n for Nat;
reserve x,y,xp,yp for set;
reserve G for Group;
reserve a,b for Element of G;
reserve F for FinSequence of G;
reserve I for FinSequence of INT;

registration
  let n be non zero Nat;
  cluster Segm n -> non empty;
end;

definition

  redefine func addint means

  for i1,i2 being Element of INT holds it.(i1,i2) = addreal.(i1,i2);
end;

theorem 
  for i1 st i1 = 0 holds i1 is_a_unity_wrt addint;

theorem 
  Sum I = addint $$ I;

definition
  let I;
  redefine func Sum(I) -> Element of INT equals

  addint $$ I;
end;

theorem 
  Sum (<*> INT) = 0;

theorem 
  for I being FinSequence of INT holds Product(((len I)|->a)|^I) = a|^Sum I;



theorem 
  b in gr {a} iff ex j1 st b=a|^j1;

theorem 
  for G being finite Group, a being Element of G holds a is not
  being_of_order_0;

theorem 
  for G being finite Group, a being Element of G holds ord a = card gr {a};

theorem 
  for G being finite Group, a being Element of G holds ord a divides card G;

theorem 
  for G being finite Group, a being Element of G holds a|^card G = 1_G;

theorem 
  for G being finite Group, a being Element of G holds (a|^n)" = a
  |^(card G - (n mod card G));

registration
  let G be associative non empty multMagma;
  cluster the multMagma of G -> associative;
end;

registration
  let G be Group;
  cluster the multMagma of G -> Group-like;
end;

theorem 
  for G being strict finite Group st card G > 1 ex a being Element
  of G st a <> 1_G;

theorem 
  for G being strict finite Group st card G = p & p is prime holds for H
  being strict Subgroup of G holds H = (1).G or H = G;

definition
  func INT.Group -> non empty strict multMagma equals

  multMagma(#INT,addint#);
end;

registration
 cluster INT.Group -> associative Group-like;
end;

registration
  cluster the carrier of INT.Group -> integer-membered;
end;

registration
  let a,b be Element of INT.Group;
  identify a*b with a+b;
end;

registration
  let n be Nat;
  cluster Segm n -> natural-membered;
end;

definition
  let n be Nat such that
 n > 0;
  func addint(n) -> BinOp of Segm(n) means


  for k,l being Element of Segm(n) holds it.(k,l) = (k+l) mod n;
end;

definition
  let n be non zero Nat;
  func INT.Group(n) -> non empty strict multMagma equals

  multMagma(#Segm(n),addint(n)#);
end;

registration
  let n be non zero Nat;
  cluster INT.Group(n) -> finite associative Group-like;
end;

theorem 
  1_INT.Group = 0;

theorem 
  for n be non zero Nat holds 1_INT.Group(n) = 0;

definition
  let h be Integer;

  func @'h -> Element of INT.Group equals

  h;
end;

theorem 
  for h being Element of INT.Group holds h" = -h;

reserve G1 for Subgroup of INT.Group;

theorem 
  j1 = (@'1) |^ j1;

definition
  let IT be Group;
  attr IT is cyclic means


  ex a being Element of IT st the multMagma of IT = gr {a};
end;

registration
  cluster strict cyclic for Group;
end;

registration
  let G be Group;
  cluster (1).G -> cyclic;
end;

registration
  cluster strict finite cyclic for Group;
end;

theorem 
  G is cyclic Group iff ex a being Element of G st for b being
  Element of G ex j1 st b=a|^j1;

theorem 
  for G being finite Group holds G is cyclic iff ex a being
  Element of G st for b being Element of G ex n st b = a|^n;

theorem 
  for G being finite Group holds ( G is cyclic iff ex a being
  Element of G st ord a = card G );

theorem 
  for G being finite Group, H being strict Subgroup of G st G is cyclic
  holds H is cyclic;

theorem 
  for G being strict finite Group holds card G is prime implies
  G is cyclic Group;

theorem 
  for n being non zero Nat
   ex g being Element of INT.Group(n) st for b being
  Element of INT.Group(n) ex j1 st b = g|^j1;

registration
  cluster cyclic -> commutative for Group;
end;

theorem 
  INT.Group = gr {@'1};

registration
  cluster INT.Group -> cyclic;
end;

registration
  let n be non zero Nat;
  cluster INT.Group(n) -> cyclic;
end;














begin

definition

  func add_2 -> BinOp of 2 equals

  ((0,0) .--> 0) +* ((0,1).-->1) +* ((1,0).-->1) +* ((1,1).-->0);
  func mult_2 -> BinOp of 2 equals

  ((0,0).-->0) +* ((0,1).-->0) +* ((1,0).-->0
  ) +* ((1,1).-->1);
end;

reserve x,y for set;

definition
  func dL-Z_2 -> doubleLoopStr equals

  doubleLoopStr(#2,add_2,mult_2,In(1,2),In(0,2)#);
end;

registration
  cluster dL-Z_2 -> strict non empty non degenerated;
end;

registration
  cluster dL-Z_2 -> add-associative distributive;
end;

registration
  cluster add-associative for non trivial strict doubleLoopStr;
end;

registration
  cluster the carrier of dL-Z_2 -> natural-membered;
end;

registration
  cluster empty for Element of dL-Z_2;
  cluster non empty for Element of dL-Z_2;
end;

definition
  let L be doubleLoopStr;
  attr L is Field-like means


  the multF of L is DnT of 0.L,the carrier
  of L & for B being non empty set, P being BinOp of B, e being Element of B
  holds B = NonZero L & e = 1.L & P = (the multF of L)||NonZero L implies
  addLoopStr(#B,P,e#) is AbGroup;
end;

registration
  let A be non empty set, od be BinOp of A, nd be Element of A, om be BinOp
  of A, nm be Element of A;
  cluster doubleLoopStr(#A,od,om,nm,nd#) -> non empty;
end;

registration
  cluster strict Field-like Abelian distributive add-associative right_zeroed
    right_complementable for non degenerated doubleLoopStr;
end;

registration
  cluster add-associative right_zeroed right_complementable Abelian
    commutative associative well-unital distributive almost_left_invertible ->
    Field-like for non degenerated doubleLoopStr;
end;

definition
  let F be Field-like Abelian distributive add-associative right_zeroed
  right_complementable non degenerated doubleLoopStr;

  func omf(F) -> DnT of 0.F,the carrier of F equals

  the multF of F;
end;

theorem 
  for F being Field holds the addLoopStr of F is AbGroup;

theorem 
  for F being Field, a being Element of F holds a+0.F = a & 0.F+a = a;

theorem 
  for F being AbGroup, a being Element of F ex b being Element of F
  st a+b = 0.F & b+a = 0.F;

theorem 
  for F being Field-like Abelian distributive add-associative
right_zeroed right_complementable non degenerated doubleLoopStr, a,b,c being
  Element of NonZero F holds (a*b)*c = a*(b*c);

theorem 
  for F being Field-like Abelian distributive add-associative
  right_zeroed right_complementable non degenerated doubleLoopStr, a,b being
  Element of NonZero F holds a*b = b*a;

theorem 
  for F being Field-like Abelian distributive add-associative
  right_zeroed right_complementable non degenerated doubleLoopStr, a being
  Element of NonZero F holds a*1.F = a & 1.F*a = a;

theorem 
  for F being Field-like Abelian distributive add-associative
  right_zeroed right_complementable non degenerated doubleLoopStr, a being
  Element of NonZero F ex b being Element of NonZero F st a*b = 1.F & b*a = 1.F
;

theorem 
  for F being Field, x,y being Element of F holds x+y = 0.F implies y =
  (comp F).x;

theorem 
  for F being Field, x being Element of F holds x = (comp F).((comp F).x );

theorem 
  for F being Field, a,b being Element of (the carrier of F)holds (the
addF of F).(a,b) is Element of (the carrier of F)& omf(F).(a,b) is Element of (
  the carrier of F)& (comp F).a is Element of the carrier of F;

theorem 
  for F being Field, a,b,c being Element of F holds a*(b-c) = a*b-a*c;

theorem 
  for F being Field, a,b,c being Element of F holds (a-b)*c = a*c-b*c;

theorem 
  for F being Field, a being Element of F holds a*0.F = 0.F;

theorem 
  for F being Field, a being Element of F holds 0.F*a = 0.F;

theorem 
  for F being Field, a,b being Element of F holds -(a*b) = a*-b;

theorem 
  for F being Field holds 1.F*0.F = 0.F;

theorem 
  for F being Field holds 0.F*1.F = 0.F;

theorem 
  for F being Field, a,b being Element of (the carrier of F)holds omf(F)
  .(a,b) is Element of the carrier of F;

theorem 
  for F being Field-like Abelian distributive add-associative
right_zeroed right_complementable non degenerated doubleLoopStr, a,b,c being
  Element of F holds (a*b)*c = a*(b*c);

theorem 
  for F being Field-like Abelian distributive add-associative
  right_zeroed right_complementable non degenerated doubleLoopStr, a,b being
  Element of F holds a*b = b*a;

theorem 
  for F being Field-like Abelian distributive add-associative
  right_zeroed right_complementable non degenerated doubleLoopStr, a being
  Element of F holds a*1.F = a & 1.F*a = a;

definition
  let F be Field;

  func revf(F) -> UnOp of NonZero F means


  for x being Element of NonZero F holds omf(F).(x,it.x) = 1.F;
end;

theorem 
  for F being Field, x,y being Element of NonZero F holds x*y = 1.F
  implies y = revf(F).x;

theorem 
  for F being Field, x being Element of NonZero F holds x =revf(F).(revf (F).x)
;

theorem 
  for F being Field, a,b being Element of NonZero F holds omf(F).(a,b)
  is Element of NonZero F & revf(F).a is Element of NonZero F;

theorem 
  for F being Field, a,b,c being Element of F holds a+b = a+c implies b
  = c;

theorem 
  for F being Field, a being Element of NonZero F, b,c being Element of
  (the carrier of F)holds a*b = a*c implies b = c;

registration
  cluster Field-like Abelian distributive add-associative right_zeroed
    right_complementable -> commutative associative well-unital
    almost_left_invertible for non degenerated doubleLoopStr;
end;














begin





definition
  let X be non empty TopSpace, x be Point of X;
  mode a_neighborhood of x -> Subset of X means


    x in Int(it);
end;





definition
  let X be TopSpace,A be Subset of X;
  mode a_neighborhood of A -> Subset of X means


    A c= Int(it);
end;

reserve X for non empty TopSpace;
reserve x for Point of X;
reserve U1 for Subset of X;

theorem 
  for A,B being Subset of X holds A is a_neighborhood of x & B is
  a_neighborhood of x implies A \/ B is a_neighborhood of x;

theorem 
  for A,B being Subset of X holds A is a_neighborhood of x & B is
  a_neighborhood of x iff A /\ B is a_neighborhood of x;

theorem 
  for U1 being Subset of X, x being Point of X st U1 is open & x in
  U1 holds U1 is a_neighborhood of x;

theorem 
  for U1 being Subset of X, x being Point of X st U1 is
  a_neighborhood of x holds x in U1;

theorem 
  U1 is a_neighborhood of x implies ex V being non empty Subset of
  X st V is a_neighborhood of x & V is open & V c= U1;

theorem 
  U1 is a_neighborhood of x iff ex V being Subset of X st V is open
  & V c= U1 & x in V;

theorem 
  for U1 being Subset of X holds U1 is open iff for x st x in U1 ex A
  being Subset of X st A is a_neighborhood of x & A c= U1;

theorem 
  for V being Subset of X holds V is a_neighborhood of {x} iff V is
  a_neighborhood of x;

theorem 
  for B being non empty Subset of X, x being Point of X|B, A being
  Subset of X|B, A1 being Subset of X, x1 being Point of X st B is open & A is
  a_neighborhood of x & A = A1 & x = x1 holds A1 is a_neighborhood of x1;

theorem 
  for B being non empty Subset of X, x being Point of X|B, A being
  Subset of X|B, A1 being Subset of X, x1 being Point of X st A1 is
  a_neighborhood of x1 & A=A1 & x=x1 holds A is a_neighborhood of x;

theorem 
  for A being Subset of X, B being Subset of X st A is a_component & A c= B
  holds A is_a_component_of B;

theorem 
  for X1 being non empty SubSpace of X, x being Point of X, x1 being
  Point of X1 st x = x1 holds Component_of x1 c= Component_of x;





definition
  let X be non empty TopSpace, x be Point of X;
  pred X is_locally_connected_in x means


  for U1 being Subset of X st U1
  is a_neighborhood of x ex V being Subset of X st V is a_neighborhood of x & V
  is connected & V c= U1;
end;

definition
  let X be non empty TopSpace;
  attr X is locally_connected means


  for x being Point of X holds X is_locally_connected_in x;
end;

definition
  let X be non empty TopSpace, A be Subset of X, x be Point of X;
  pred A is_locally_connected_in x means


  for B being non empty Subset
of X st A = B ex x1 being Point of X|B st x1=x & X|B is_locally_connected_in x1
  ;
end;

definition
  let X be non empty TopSpace, A be non empty Subset of X;
  attr A is locally_connected means


  X|A is locally_connected;
end;

theorem 
  for x holds X is_locally_connected_in x iff for V,S being Subset
  of X st V is a_neighborhood of x & S is_a_component_of V & x in S holds S is
  a_neighborhood of x;

theorem 
  for x holds X is_locally_connected_in x iff for U1 being non
empty Subset of X st U1 is open & x in U1 ex x1 being Point of X|U1 st x1=x & x
  in Int(Component_of x1);

theorem 
  X is locally_connected implies
  for S being Subset of X st S is a_component holds S is open;

theorem 
  X is_locally_connected_in x implies for A being non empty Subset
  of X st A is open & x in A holds A is_locally_connected_in x;

theorem 
  X is locally_connected implies for A being non empty Subset of X
  st A is open holds A is locally_connected;

theorem 
  X is locally_connected iff for A being non empty Subset of X, B
  being Subset of X st A is open & B is_a_component_of A holds B is open;

theorem 
  X is locally_connected implies for E being non empty Subset of X, C
  being non empty Subset of X|E st C is connected & C is open ex H being Subset
  of X st H is open & H is connected & C = E /\ H;

theorem 
  X is normal iff for A,C being Subset of X st A <> {} & C <> [#]
X & A c= C & A is closed & C is open ex G being Subset of X st G is open & A c=
  G & Cl G c= C;

theorem 
  X is locally_connected & X is normal implies for A,B being Subset of X
  st A <> {} & B <> {} & A is closed & B is closed & A misses B holds (A is
connected & B is connected implies ex R,S being Subset of X st R is connected &
  S is connected & R is open & S is open & A c= R & B c= S & R misses S);

theorem 
  for x being Point of X, F being Subset-Family of X st for A
  being Subset of X holds A in F iff A is open closed & x in A holds F <> {};





definition
  let X be non empty TopSpace, x be Point of X;
  func qComponent_of x -> Subset of X means


  ex F being Subset-Family of
  X st (for A being Subset of X holds A in F iff A is open closed & x in A) &
  meet F = it;
end;

theorem 
  x in qComponent_of x;

theorem 
  for A being Subset of X st A is open closed & x in A holds A c=
  qComponent_of x implies A = qComponent_of x;

theorem 
  qComponent_of x is closed;

theorem 
  Component_of x c= qComponent_of x;



theorem 
  for T being non empty TopSpace, A being Subset of T for p being Point
  of T holds p in Cl A iff for G being a_neighborhood of p holds G meets A;

theorem 
  for X be non empty TopSpace, A be Subset of X holds [#]X is
  a_neighborhood of A;

theorem 
  for X be non empty TopSpace, A be Subset of X, Y being a_neighborhood
  of A holds A c= Y;















begin

reserve i,k,l,m,n for Nat,
  x for set;

theorem 
  k in Segm n iff k < n;

theorem 
  Segm 0 = {} & Segm 1 = { 0 } & Segm 2 = { 0,1 };

theorem 
  n in Segm(n+1);

theorem 
  n <= m iff Segm n c= Segm m;

theorem 
  Segm n = Segm m implies n = m;

theorem 
  k <= n implies Segm k = Segm k /\ Segm n & Segm k = Segm n /\ Segm k;

theorem 
  (Segm k = Segm k /\ Segm n or Segm k = Segm n /\ Segm k) implies k <=
  n;





reserve R for non empty ZeroStr;

definition
  let R;

  let F be sequence of R;
  attr F is finite-Support means


  ex n st for i st i >= n holds F.i = 0. R;
end;

registration
  let R;
  cluster finite-Support for sequence of R;
end;

definition
  let R;
  mode AlgSequence of R is finite-Support sequence of R;
end;

reserve p,q for AlgSequence of R;

definition
  let R,p;
  let k be Nat;
  pred k is_at_least_length_of p means


  for i st i>=k holds p.i=0.R;
end;

definition
  let R,p;
  func len p -> Element of NAT means


  it is_at_least_length_of p & for m st m is_at_least_length_of p holds it<=m;
end;

theorem 
  i>=len p implies p.i=0.R;

theorem 
  (for i st i < k holds p.i<>0.R) implies len p>=k;

theorem 
  len p=k+1 implies p.k<>0.R;





definition
  let R,p;
  func support p -> Subset of NAT equals

  Segm len p;
end;

theorem 
  k = len p iff Segm k = support p;

scheme 

  AlgSeqLambdaF{R()->non empty ZeroStr,A()->Nat, F(Nat)->Element of R()}: ex p
  being AlgSequence of R() st len p <= A() & for k st k < A() holds p.k=F(k);

theorem 
  len p = len q & (for k st k < len p holds p.k = q.k) implies p=q;

theorem 
  the carrier of R <> {0.R} implies for k ex p being AlgSequence of R st
  len p = k;





reserve x for Element of R;

definition
  let R,x;
  func <%x%> -> AlgSequence of R means


  len it <= 1 & it.0 = x;
end;

theorem 
  p=<%0.R%> iff len p = 0;

theorem 
  p=<%0.R%> iff support p = {};

theorem 
  <%0.R%>.i=0.R;

theorem 
  p=<%0.R%> iff rng p = {0.R};














begin

reserve AFP for AffinPlane;
reserve a,a9,b,b9,c,c9,d,d9,o,p,p9,q,q9,r,s,t,x,y,z for Element of AFP;
reserve A,A9,C,D,P,B9,M,N,K for Subset of AFP;
reserve f for Permutation of the carrier of AFP;

theorem 
  not LIN o,a,p & LIN o,a,b & LIN o,a,x & LIN o,a,y & LIN o,p,p9 &
  LIN o,p,q & LIN o,p,q9 & p<>q & o<>q & o<>x & a,p // b,p9 & a,q // b,q9 & x,p
  // y,p9 & AFP is Desarguesian implies x,q // y,q9;

theorem 
  (for o,a,b st o<>a & o<>b & LIN o,a,b ex f st f is dilatation & f
  .o=o & f.a=b) implies AFP is Desarguesian;

theorem 
  AFP is Desarguesian implies for o,a,b st o<>a & o<>b & LIN o,a,b
  ex f st f is dilatation & f.o=o & f.a=b;

theorem 
  AFP is Desarguesian iff for o,a,b st o<>a & o<>b & LIN o,a,b ex f st f
  is dilatation & f.o=o & f.a=b;

definition
  let AFP,f,K;
  pred f is_Sc K means


  f is collineation & K is being_line & (for x st
  x in K holds f.x = x) & for x holds x,f.x // K;
end;

theorem 
  f is_Sc K & f.p=p & not p in K implies f=id the carrier of AFP;

theorem 
  (for a,b,K st a,b // K & not a in K ex f st f is_Sc K & f.a=b)
  implies AFP is Moufangian;

theorem 
  K // M & p in K & q in K & p9 in K & q9 in K & AFP is Moufangian
& a in M & b in M & x in M & y in M & a<>b & q<>p & p,a // p9,x & p,b // p9,y &
  q,a // q9,x implies q,b // q9,y;

theorem 
  a,b // K & not a in K & AFP is Moufangian implies ex f st f is_Sc K & f.a=b;

theorem 
  AFP is Moufangian iff for a,b,K st a,b // K & not a in K ex f st f
  is_Sc K & f.a=b;














begin

definition
  let IT be non empty AffinStruct;
  attr IT is WeakAffVect-like means


  (for a,b,c being Element of IT st a
,b // c,c holds a=b) & (for a,b,c,d,p,q being Element of IT st a,b // p,q & c,d
// p,q holds a,b // c,d) & (for a,b,c being Element of IT ex d being Element of
IT st a,b // c,d) & (for a,b,c,a9,b9,c9 being Element of IT st a,b // a9,b9 & a
  ,c // a9,c9 holds b,c // b9,c9) & (for a,c being Element of IT ex b being
  Element of IT st a,b // b,c) & for a,b,c,d being Element of IT st a,b // c,d
  holds a,c // b,d;
end;

registration
  cluster strict WeakAffVect-like for non trivial AffinStruct;
end;

definition
  mode WeakAffVect is WeakAffVect-like non trivial AffinStruct;
end;

registration
  cluster AffVect-like -> WeakAffVect-like for non empty AffinStruct;
end;

reserve AFV for WeakAffVect;
reserve a,b,c,d,e,f,a9,b9,c9,d9,f9,p,q,r,o,x99 for Element of AFV;





theorem 
  a,b // a,b;

theorem 
  a,a // a,a;

theorem 
  a,b // c,d implies c,d // a,b;

theorem 
  a,b // a,c implies b = c;

theorem 
  a,b // c,d & a,b // c,d9 implies d = d9;

theorem 
  for a,b holds a,a // b,b;

theorem 
  a,b // c,d implies b,a // d,c;

theorem 
  a,b // c,d & a,c // b9,d implies b = b9;

theorem 
  b,c // b9,c9 & a,d // b,c & a,d9 // b9,c9 implies d = d9;

theorem 
  a,b // a9,b9 & c,d // b,a & c,d9 // b9,a9 implies d = d9;

theorem 
  a,b // a9,b9 & c,d // c9,d9 & b,f // c,d & b9,f9 // c9,d9 implies a,f
  // a9,f9;

theorem 
  a,b // a9,b9 & a,c // c9,b9 implies b,c // c9,a9;





definition
  let AFV;
  let a,b;
  pred MDist a,b means


  a,b // b,a & a <> b;
  irreflexivity;
  symmetry;
end;

theorem 
  ex a,b st a<>b & not MDist a,b;

theorem 
  MDist a,b & MDist a,c implies b = c or MDist b,c;

theorem 
  MDist a,b & a,b // c,d implies MDist c,d;





definition
  let AFV;
  let a,b,c;
  pred Mid a,b,c means


  a,b // b,c;
end;

theorem 
  Mid a,b,c implies Mid c,b,a;

theorem 
  Mid a,b,b iff a = b;

theorem 
  Mid a,b,a iff a = b or MDist a,b;

theorem 
  ex b st Mid a,b,c;

theorem 
  Mid a,b,c & Mid a,b9,c implies b =b9 or MDist b,b9;

theorem 
  ex c st Mid a,b,c;

theorem 
  Mid a,b,c & Mid a,b,c9 implies c = c9;

theorem 
  Mid a,b,c & MDist b,b9 implies Mid a,b9,c;

theorem 
  Mid a,b,c & Mid a,b9,c9 & MDist b,b9 implies c = c9;

theorem 
  Mid a,p,a9 & Mid b,p,b9 implies a,b // b9,a9;

theorem 
  Mid a,p,a9 & Mid b,q,b9 & MDist p,q implies a,b // b9,a9;





definition
  let AFV;
  let a,b;
  func PSym(a,b) -> Element of AFV means


  Mid b,a,it;
end;

theorem 
  PSym(p,a) = b iff a,p // p,b;

theorem 
  PSym(p,a) = a iff a = p or MDist a,p;

theorem 
  PSym(p,PSym(p,a)) = a;

theorem 
  PSym(p,a) = PSym(p,b) implies a = b;

theorem 
  ex a st PSym(p,a) = b;

theorem 
  a,b // PSym(p,b),PSym(p,a);

theorem 
  a,b // c,d iff PSym(p,a),PSym(p,b) // PSym(p,c),PSym(p,d);

theorem 
  MDist a,b iff MDist PSym(p,a),PSym(p,b);

theorem 
  Mid a,b,c iff Mid PSym(p,a),PSym(p,b),PSym(p,c);

theorem 
  PSym(p,a) = PSym(q,a) iff p = q or MDist p,q;

theorem 
  PSym(q,PSym(p,PSym(q,a))) = PSym(PSym(q,p),a);

theorem 
  PSym(p,PSym(q,a)) = PSym(q,PSym(p,a)) iff p = q or MDist p,q or MDist
  q,PSym(p,q);

theorem 
  PSym(p,PSym(q,PSym(r,a))) = PSym(r,PSym(q,PSym(p,a)));

theorem 
  ex d st PSym(a,PSym(b,PSym(c,p))) = PSym(d,p);

theorem 
  ex c st PSym(a,PSym(c,p)) = PSym(c,PSym(b,p));





definition
  let AFV,o;
  let a,b;
  func Padd(o,a,b) -> Element of AFV means


  o,a // b,it;
end;

notation
  let AFV,o;
  let a;
  synonym Pcom(o,a) for PSym(o,a);
end;

definition
  let AFV,o;

  func Padd(o) -> BinOp of the carrier of AFV means


  for a,b holds it.(a ,b) = Padd(o,a,b);
end;

definition
  let AFV,o;
  func Pcom(o) -> UnOp of the carrier of AFV means


  for a holds it.a = Pcom(o,a);
end;

definition
  let AFV,o;
  func GroupVect(AFV,o) -> strict addLoopStr equals

  addLoopStr(#the carrier of
    AFV,Padd(o),o#);
end;

registration
  let AFV,o;
  cluster GroupVect(AFV,o) -> non empty;
end;

theorem 
  the carrier of GroupVect(AFV,o) = the carrier of AFV & the addF of
  GroupVect(AFV,o) = Padd(o) & 0.GroupVect(AFV,o) = o;

reserve a,b,c for Element of GroupVect(AFV,o);

theorem 
  for a,b being Element of GroupVect(AFV,o), a9,b9 being Element of AFV
  st a=a9 & b=b9 holds a + b = (Padd(o)).(a9,b9);

registration
  let AFV,o;
  cluster GroupVect(AFV,o) -> Abelian add-associative right_zeroed
    right_complementable;
end;

theorem 
  for a being Element of GroupVect(AFV,o), a9 being Element of AFV
  st a=a9 holds -a = (Pcom(o)).a9;

theorem 
  0.GroupVect(AFV,o) = o;

reserve a,b for Element of GroupVect(AFV,o);

theorem 
  for a ex b st b + b = a;

registration
  let AFV,o;
  cluster GroupVect(AFV,o) -> Two_Divisible;
end;





reserve AFV for AffVect,
  o for Element of AFV;

theorem 
  for a being Element of GroupVect(AFV,o) st a + a = 0.(GroupVect(
  AFV,o)) holds a = 0.(GroupVect(AFV,o));

registration
  let AFV,o;
  cluster GroupVect(AFV,o) -> Fanoian;
end;

registration
  cluster strict non trivial for Uniquely_Two_Divisible_Group;
end;

definition
  mode Proper_Uniquely_Two_Divisible_Group is non trivial
    Uniquely_Two_Divisible_Group;
end;

theorem 
  GroupVect(AFV,o) is Proper_Uniquely_Two_Divisible_Group;

registration
  let AFV,o;
  cluster GroupVect(AFV,o) -> non trivial;
end;

theorem 
  for ADG being Proper_Uniquely_Two_Divisible_Group holds AV(ADG) is AffVect;

registration
  let ADG be Proper_Uniquely_Two_Divisible_Group;
  cluster AV(ADG) -> AffVect-like non trivial;
end;

theorem 
  for AFV being strict AffVect holds for o being Element of AFV
  holds AFV = AV(GroupVect(AFV,o));

theorem 
  for AS being strict AffinStruct holds (AS is AffVect iff ex ADG being
  Proper_Uniquely_Two_Divisible_Group st AS = AV(ADG) );

definition
  let X,Y be non empty addLoopStr;
  let f be Function of the carrier of X,the carrier of Y;
  pred f is_Iso_of X,Y means


  f is one-to-one & rng(f) = the carrier of
Y & for a,b being Element of X holds f.(a+b) = (f.a)+(f.b) & f.(0.X) = 0.Y & f.
  (-a) = -(f.a);
end;

definition
  let X,Y be non empty addLoopStr;
  pred X,Y are_Iso means


  ex f being Function of the carrier of X,the carrier of Y st f is_Iso_of X,Y;
end;

reserve ADG for Proper_Uniquely_Two_Divisible_Group;
reserve f for Function of the carrier of ADG,the carrier of ADG;

theorem 
  for o9 being Element of ADG, o being Element of AV(ADG) st (for
x being Element of ADG holds f.x = o9+x) & o=o9 holds for a,b being Element of
ADG holds f.(a+b) =(Padd(o)).(f.a,f.b) & f.(0.ADG) = 0.(GroupVect(AV(ADG),o)) &
  f.(-a) = (Pcom(o)).(f.a);

theorem 
  for o9 being Element of ADG st (for b being Element of ADG holds
  f.b = o9+b) holds f is one-to-one;

theorem 
  for o9 being Element of ADG, o being Element of AV(ADG) st (for
  b being Element of ADG holds f.b = o9+b) holds rng(f) = the carrier of
  GroupVect(AV(ADG),o);

theorem 
  for ADG being Proper_Uniquely_Two_Divisible_Group, o9 being Element of
ADG, o being Element of AV(ADG) st o=o9 holds ADG,GroupVect(AV(ADG),o) are_Iso;














begin

reserve n for Element of NAT,
        x for Element of COMPLEX n;

definition let n;
  func the_Complex_Space n -> strict TopSpace equals

  TopStruct(#COMPLEX n,ComplexOpenSets(n)#);
end;

registration
  let n;
  cluster the_Complex_Space n -> non empty;
end;

theorem 
  the topology of the_Complex_Space n = ComplexOpenSets n;

theorem 
  the carrier of the_Complex_Space n = COMPLEX n;

reserve p,q for Point of the_Complex_Space n,
  V for Subset of the_Complex_Space n;

theorem 
  p is Element of COMPLEX n;

theorem 
  for A being Subset of COMPLEX n st A = V holds A is open iff V is open;

theorem 
  for A being Subset of COMPLEX n st A = V holds A is closed iff V is closed;

theorem 
  the_Complex_Space n is T_2;

theorem 
  the_Complex_Space n is regular;














begin



theorem 
  for F being Field holds revf(F).1.F = 1.F;

theorem 
  for F being Field holds for a,b being Element of NonZero F holds
  revf(F).(omf(F).(a,revf(F).b)) = omf(F).(b,revf(F).a);

theorem 
  for F being Field, a,b being Element of NonZero F holds revf(F).(
  omf(F).(a,b)) = omf(F).(revf(F).a,revf(F).b);

theorem 
  for F being Field holds for a,b,c,d being Element
  of F holds a-b = c-d iff a+d = b+c;

theorem 
  for F being Field holds for a,c being Element of F
holds for b,d being Element of NonZero F holds omf(F).(a,revf(F).b) = omf(F).(c
  ,revf(F).d) iff omf(F).(a,d) = omf(F).(b,c);

theorem 
  for F being Field holds for a,b being Element of F
holds for c,d being Element of NonZero F holds omf(F).(omf(F).(a,revf(F).c),omf
  (F).(b,revf(F).d)) = omf(F).(omf(F).(a,b),revf(F).(omf(F).(c,d)));

theorem 
  for F being Field holds for a,b being Element of F
holds for c,d being Element of NonZero F holds (the addF of F).(omf(F).(a,revf(
F).c),omf(F).(b,revf(F).d)) = omf(F).((the addF of F).(omf(F).(a,d),omf(F).(b,c
  )),revf(F).(omf(F).(c,d)));

definition 
  let F be Field;
  func osf(F) -> BinOp of the carrier of F means


  for x,y being Element of F holds it.(x,y) = (the addF of F).(x,(comp F).y);
end;

theorem 
  for F being Field holds for x being Element of F holds osf(F).(x,x) = 0.F;

theorem 
  for F being Field holds for a,b,c being Element
  of F holds omf(F).(a,osf(F).(b,c)) = osf(F).(omf(F).(a,b),omf(F).(a,c));

theorem 
  for F being Field holds for a,b,c being Element of F
  holds omf(F).(osf(F).(a,b),c) = osf(F).(omf(F).(a,c),omf(F).(b,c));

theorem 
  for F being Field holds for a,b being Element of F
  holds osf(F).(a,b) = (comp F).(osf(F).(b,a));

theorem 
  for F being Field holds for a,b being Element of F
  holds osf(F).((comp F).a,b) = (comp F).((the addF of F).(a,b));

theorem 
  for F being Field holds for a,b,c,d being Element
  of F holds osf(F).(a,b) = osf(F).(c,d) iff a+d = b+c;

theorem 
  for F being Field holds for a being Element of F holds
  osf(F).(0.F,a) = (comp F).a;

theorem 
  for F being Field holds for a being Element of F holds osf(F).(a,0.F) = a;

theorem 
  for F being Field holds for a,b,c being Element of F
  holds a+b = c iff osf(F).(c,a) = b;

theorem 
  for F being Field holds for a,b,c being Element of F
  holds a+b = c iff osf(F).(c,b) = a;

theorem 
  for F being Field holds for a,b,c being Element of F
  holds osf(F).(a,osf(F).(b,c)) = (the addF of F).(osf(F).(a,b),c);

theorem 
  for F being Field holds for a,b,c being Element of F
  holds osf(F).(a,(the addF of F).(b,c)) = osf(F).(osf(F).(a,b),c);

definition 
  let F be Field;
  func ovf(F) -> Function of [:the carrier of F, NonZero F:],the carrier of F
  means


  for x being Element of F, y being Element of
  NonZero F holds it.(x,y) = omf(F).(x,revf(F).y);
end;

theorem 
  for F being Field holds for x being Element of NonZero F holds
  ovf(F).(x,x) = 1.F;

theorem 
  for F being Field holds for a,b being Element of
F holds for c being Element of NonZero F holds omf(F).(a,ovf(F).(b,c)) = ovf(F)
  .(omf(F).(a,b),c);

theorem 
  for F being Field holds for a being Element of NonZero F holds omf(F).
  (a,ovf(F).(1.F,a)) = 1.F & omf(F).(ovf(F).(1.F,a),a) = 1.F;

theorem 
  for F being Field holds for a,b being Element of NonZero F holds ovf(F
  ).(a,b) = revf(F).(ovf(F).(b,a));

theorem 
  for F being Field holds for a,b being Element of NonZero F holds ovf(F
  ).(revf(F).a,b) = revf(F).(omf(F).(a,b));

theorem 
  for F being Field holds for a,c being Element of
  F holds for b,d being Element of NonZero F holds ovf(F).(a,b) = ovf(F).(c,d)
  iff omf(F).(a,d) = omf(F).(b,c);

theorem 
  for F being Field holds for a being Element of NonZero F holds ovf(F).
  (1.F,a) = revf(F).a;

theorem 
  for F being Field holds for a being Element of F holds ovf(F).(a,1.F) = a;

theorem 
  for F being Field holds for a being Element of NonZero F holds for b,c
  being Element of F holds omf(F).(a,b) = c iff ovf(F).(c,a) = b;

theorem 
  for F being Field holds for a,c being Element of F
holds for b being Element of NonZero F holds omf(F).(a,b) = c iff ovf(F).(c,b)
  = a;

theorem 
  for F being Field holds for a being Element of F holds
for b,c being Element of NonZero F holds ovf(F).(a,ovf(F).(b,c)) = omf(F).(ovf(
  F).(a,b),c);

theorem 
  for F being Field holds for a being Element of F holds
for b,c being Element of NonZero F holds ovf(F).(a,omf(F).(b,c)) = ovf(F).(ovf(
  F).(a,b),c);














begin 

reserve L for non empty doubleLoopStr;





registration
  cluster F_Real -> multLoop_0-like;
end;






definition
  let L be left_add-cancelable add-right-invertible non empty addLoopStr;
  let a be Element of L;

  func -a -> Element of L means


  a+it = 0.L;
end;

definition
  let L be left_add-cancelable add-right-invertible non empty addLoopStr;
  let a,b be Element of L;
  func a-b -> Element of L equals

  a+ -b;
end;

registration
  cluster strict Abelian add-associative commutative associative distributive
non degenerated left_zeroed right_zeroed Loop-like well-unital multLoop_0-like
    for non empty doubleLoopStr;
end;

definition
  mode doubleLoop is left_zeroed right_zeroed Loop-like well-unital
    multLoop_0-like non empty doubleLoopStr;
end;

definition
  mode leftQuasi-Field is Abelian add-associative right-distributive non
    degenerated doubleLoop;
end;

reserve a,b,c,x,y,z for Element of L;





theorem 
  L is leftQuasi-Field iff (for a holds a + 0.L = a) & (for a ex x st a+
x = 0.L) & (for a,b,c holds (a+b)+c = a+(b+c)) & (for a,b holds a+b = b+a) & 0.
L <> 1.L & (for a holds a * 1.L = a) & (for a holds 1.L * a = a) & (for a,b st
a<>0.L ex x st a*x=b) & (for a,b st a<>0.L ex x st x*a=b) & (for a,x,y st a<>0.
L holds a*x=a*y implies x=y) & (for a,x,y st a<>0.L holds x*a=y*a implies x=y)
& (for a holds a*0.L = 0.L) & (for a holds 0.L*a = 0.L) & for a,b,c holds a*(b+
  c) = a*b + a*c;

theorem 
  for G being Abelian right-distributive doubleLoop, a,b being
  Element of G holds a*(-b) = -(a*b);

theorem 
  for G being Abelian left_add-cancelable add-right-invertible
  non empty addLoopStr, a being Element of G holds -(-a) = a;

theorem 
  for G being Abelian right-distributive doubleLoop holds (-1.G)*(-1.G) = 1.G;

theorem 
  for G being Abelian right-distributive doubleLoop, a,x,y being Element
  of G holds a*(x-y) = a*x - a*y;






definition
  mode rightQuasi-Field is Abelian add-associative left-distributive non
    degenerated doubleLoop;
end;

theorem 
  L is rightQuasi-Field iff (for a holds a + 0.L = a) & (for a ex x st a
  +x = 0.L) & (for a,b,c holds (a+b)+c = a+(b+c)) & (for a,b holds a+b = b+a) &
  0.L <> 1.L & (for a holds a * 1.L = a) & (for a holds 1.L * a = a) & (for a,b
st a<>0.L ex x st a*x=b) & (for a,b st a<>0.L ex x st x*a=b) & (for a,x,y st a
<>0.L holds a*x=a*y implies x=y) & (for a,x,y st a<>0.L holds x*a=y*a implies x
=y) & (for a holds a*0.L = 0.L) & (for a holds 0.L*a = 0.L) & for a,b,c holds (
  b+c)*a = b*a + c*a;






reserve G for left-distributive doubleLoop,
  a,b,x,y for Element of G;

theorem 
  (-b)*a = -(b*a);

theorem 
  for G being Abelian left-distributive doubleLoop holds (-1.G)*(-1.G) = 1.G;

theorem 
  (x-y)*a = x*a - y*a;








definition
  mode doublesidedQuasi-Field is Abelian add-associative distributive non
    degenerated doubleLoop;
end;

reserve a,b,c,x,y,z for Element of L;

theorem 
  L is doublesidedQuasi-Field iff (for a holds a + 0.L = a) & (for a ex
x st a+x = 0.L) & (for a,b,c holds (a+b)+c = a+(b+c)) & (for a,b holds a+b = b+
a) & 0.L <> 1.L & (for a holds a * 1.L = a) & (for a holds 1.L * a = a) & (for
  a,b st a<>0.L ex x st a*x=b) & (for a,b st a<>0.L ex x st x*a=b) & (for a,x,y
  st a<>0.L holds a*x=a*y implies x=y) & (for a,x,y st a<>0.L holds x*a=y*a
implies x=y) & (for a holds a*0.L = 0.L) & (for a holds 0.L*a = 0.L) & (for a,b
  ,c holds a*(b+c) = a*b + a*c) & for a,b,c holds (b+c)*a = b*a + c*a;





definition
  mode _Skew-Field is associative doublesidedQuasi-Field;
end;






theorem 
  L is _Skew-Field iff (for a holds a + 0.L = a) & (for a ex x st a+x = 0.L)
  & (for a,b,c holds (a+b)+c = a+(b+c)) & (for a,b holds a+b = b+a)
  & 0.L <> 1.L & (for a holds a * 1.L = a)
  & (for a st a<>0.L ex x st a*x = 1.L) & (for a holds a*0.L = 0.L)
  & (for a holds 0.L*a = 0.L) & (for a,b,c holds (a*b)*c = a*(b*c))
  & (for a,b,c holds a*(b+c) = a*b + a*c)
  & (for a,b,c holds (b+c)*a = b*a + c*a);





definition
  mode _Field is commutative _Skew-Field;
end;

theorem 
  L is _Field iff (for a holds a + 0.L = a) & (for a ex x st a+x = 0.L)
& (for a,b,c holds (a+b)+c = a+(b+c)) & (for a,b holds a+b = b+a) & 0.L <> 1.L
  & (for a holds a * 1.L = a) & (for a st a<>0.L ex x st a*x = 1.L) & (for a
holds a*0.L = 0.L) & (for a,b,c holds (a*b)*c = a*(b*c)) & (for a,b,c holds a*(
  b+c) = a*b + a*c) & for a,b holds a*b = b*a;














begin 

definition
  let M be non empty MetrStruct, x,y be Element of M;
  pred x tolerates y means


  dist(x,y)=0;
end;

definition
  let M be Reflexive non empty MetrStruct, x, y be Element of M;
  redefine pred x tolerates y;
  reflexivity;
end;

definition
  let M be symmetric non empty MetrStruct, x, y be Element of M;
  redefine pred x tolerates y;
  symmetry;
end;

definition
  let M be non empty MetrStruct, x be Element of M;
  func x-neighbour -> Subset of M equals

  {y where y is Element of M: x tolerates y};
end;

definition
  let M be non empty MetrStruct;
  mode equivalence_class of M -> Subset of M means


    ex x being Element of M st it=x-neighbour;
end;

theorem 
  for M being PseudoMetricSpace, x,y,z being Element of M holds x
  tolerates y & y tolerates z implies x tolerates z;

theorem 
  for M being PseudoMetricSpace,x,y being Element of M holds y in x
  -neighbour iff y tolerates x;

theorem 
  for M being PseudoMetricSpace,x,p,q being Element of M st
  p in x-neighbour & q in x-neighbour holds p tolerates q;

theorem 
  for M being PseudoMetricSpace, x being Element of M holds x in x-neighbour;

theorem 
  for M being PseudoMetricSpace, x,y being Element of M holds
  x in y-neighbour implies y in x-neighbour;

theorem 
  for M being PseudoMetricSpace, p,x,y being Element of M holds p in x
  -neighbour & x tolerates y implies p in y-neighbour;

theorem 
  for M being PseudoMetricSpace, x,y being Element of M holds y in
  x-neighbour implies x-neighbour = y-neighbour;

theorem 
  for M being PseudoMetricSpace, x,y being Element of M holds x
  -neighbour = y-neighbour iff x tolerates y;

theorem 
  for M being PseudoMetricSpace, x,y being Element of M holds x
  -neighbour meets y-neighbour iff x tolerates y;

registration
  let M be PseudoMetricSpace;
  cluster -> non empty for equivalence_class of M;
end;

theorem 
  for M being PseudoMetricSpace, x,p,q being Element of M holds p
  in x-neighbour & q in x-neighbour implies dist(p,q)=0;

theorem 
  for M being Reflexive discerning non empty MetrStruct, x,y
  being Element of M holds x tolerates y iff x = y;

theorem 
  for M being non empty MetrSpace,x,y being Element of M holds y
  in x-neighbour iff y = x;

theorem 
  for M being non empty MetrSpace,x being Element of M holds x -neighbour = {x}
;

theorem 
  for M being non empty MetrSpace, V being Subset of M holds (V is
  equivalence_class of M iff ex x being Element of M st V={x});



definition
  let M be non empty MetrStruct;
  func M-neighbour -> set equals

  {s where s is Subset of M: ex x being Element of M st x-neighbour = s};
end;

registration
  let M be non empty MetrStruct;
  cluster M-neighbour -> non empty;
end;

reserve V for set;

theorem 
  for M being non empty MetrStruct holds V in M-neighbour iff ex x
  being Element of M st V=x -neighbour;

theorem 
  for M being non empty MetrStruct, x being Element of M holds x
  -neighbour in M-neighbour;

theorem 
  for M being non empty MetrStruct holds V in M-neighbour iff V is
  equivalence_class of M;

theorem 
  for M being non empty MetrSpace, x being Element of M holds
  {x} in M-neighbour;

theorem 
  for M being non empty MetrSpace holds V in M-neighbour iff ex x being
  Element of M st V={x};

theorem 
  for M being PseudoMetricSpace, V,Q being Element of M-neighbour
for p1,p2,q1,q2 being Element of M holds ( p1 in V & q1 in Q & p2 in V & q2 in
  Q implies dist(p1,q1)=dist(p2,q2));

definition
  let M be non empty MetrStruct, V, Q be Element of M-neighbour,
      v be Element of REAL;
  pred V,Q is_dst v means


  for p,q being Element of M st p in V & q in Q holds dist(p,q)=v;
end;

theorem 
  for M being PseudoMetricSpace, V,Q being Element of M-neighbour,
  v being Element of REAL holds V,Q is_dst v iff ex p,q being Element of M st p
  in V & q in Q & dist(p,q)=v;

theorem 
  for M being PseudoMetricSpace, V,Q being Element of M-neighbour,
  v being Element of REAL st V,Q is_dst v holds Q,V is_dst v;

definition
  let M be non empty MetrStruct, V,Q be Element of M-neighbour;
  func ev_eq_1(V,Q) -> Subset of REAL equals

  {v where v is Element of REAL: V,
  Q is_dst v};
end;

theorem 
  for M being PseudoMetricSpace, V,Q being Element of M-neighbour, v
  being Element of REAL holds v in ev_eq_1(V,Q) iff V,Q is_dst v;

definition
  let M be non empty MetrStruct, v be Element of REAL;
  func ev_eq_2(v,M) -> Subset of [:M-neighbour,M-neighbour:] equals

  {W where W
is Element of [:M-neighbour,M-neighbour:]: ex V,Q being Element of M-neighbour
  st W=[V,Q] & V,Q is_dst v};
end;

theorem 
  for M being PseudoMetricSpace, v being Element of REAL, W being
Element of [:M-neighbour,M-neighbour:] holds W in ev_eq_2(v,M) iff ex V,Q being
  Element of M-neighbour st W=[V,Q] & V,Q is_dst v;

definition
  let M be non empty MetrStruct;
  func real_in_rel M -> Subset of REAL equals

  {v where v is Element of REAL:
  ex V,Q being Element of M-neighbour st (V,Q is_dst v)};
end;

theorem 
  for M being PseudoMetricSpace, v being Element of REAL holds v in
  real_in_rel M iff ex V,Q being Element of M-neighbour st V,Q is_dst v;

definition
  let M be non empty MetrStruct;
  func elem_in_rel_1 M -> Subset of M-neighbour equals

  {V where V is Element
of M-neighbour: ex Q being Element of M-neighbour , v being Element of REAL st
  V,Q is_dst v};
end;

theorem 
  for M being PseudoMetricSpace, V being Element of M-neighbour
  holds V in elem_in_rel_1 M iff ex Q being Element of M-neighbour , v being
  Element of REAL st V,Q is_dst v;

definition
  let M be non empty MetrStruct;
  func elem_in_rel_2 M -> Subset of M-neighbour equals

  {Q where Q is Element
of M-neighbour: ex V being Element of M-neighbour , v being Element of REAL st
  V,Q is_dst v};
end;

theorem 
  for M being PseudoMetricSpace, Q being Element of M-neighbour
  holds Q in elem_in_rel_2 M iff ex V being Element of M-neighbour , v being
  Element of REAL st V,Q is_dst v;

definition
  let M be non empty MetrStruct;
  func elem_in_rel M -> Subset of [:M-neighbour,M-neighbour:] equals

  {VQ where
  VQ is Element of [:M-neighbour,M-neighbour:]: ex V,Q being Element of M
  -neighbour, v being Element of REAL st VQ = [V,Q] & V,Q is_dst v};
end;

theorem 
  for M being PseudoMetricSpace, VQ being Element of [:M-neighbour,M
-neighbour:] holds VQ in elem_in_rel M iff ex V,Q being Element of M-neighbour,
  v being Element of REAL st VQ = [V,Q] & V,Q is_dst v;

definition
  let M be non empty MetrStruct;
  func set_in_rel M -> Subset of [:M-neighbour,M-neighbour,REAL:] equals

  {VQv
where VQv is Element of [:M-neighbour,M-neighbour,REAL:]: ex V,Q being Element
  of M-neighbour ,v being Element of REAL st VQv = [V,Q,v] & V,Q is_dst v};
end;

theorem 
  for M being PseudoMetricSpace,VQv being Element of [:M-neighbour
  ,M -neighbour,REAL:] holds VQv in set_in_rel M iff ex V,Q being Element of M
  -neighbour,v being Element of REAL st VQv = [V,Q,v] & V,Q is_dst v;

theorem 
  for M being PseudoMetricSpace holds elem_in_rel_1 M = elem_in_rel_2 M;

theorem 
  for M being PseudoMetricSpace holds set_in_rel M c= [:elem_in_rel_1 M,
  elem_in_rel_2 M,real_in_rel M:];

theorem 
  for M being PseudoMetricSpace, V,Q being Element of M-neighbour, v1,v2
  being Element of REAL holds V,Q is_dst v1 & V,Q is_dst v2 implies v1=v2;

theorem 
  for M being PseudoMetricSpace, V,Q being Element of M-neighbour
  holds ex v being Element of REAL st V,Q is_dst v;

definition
  let M be PseudoMetricSpace;
  func nbourdist M -> Function of [:M-neighbour,M-neighbour:],REAL means


  for V,Q being Element of M-neighbour for p,q being Element of M st p in
  V & q in Q holds it.(V,Q)=dist(p,q);
end;

theorem 
  for M being PseudoMetricSpace, V,Q being Element of M-neighbour
  holds (nbourdist M).(V,Q) = 0 iff V = Q;

theorem 
  for M being PseudoMetricSpace, V,Q being Element of M-neighbour
  holds (nbourdist M).(V,Q) = (nbourdist M).(Q,V);

theorem 
  for M being PseudoMetricSpace, V,Q,W being Element of M
-neighbour holds (nbourdist M).(V,W) <= (nbourdist M).(V,Q) + (nbourdist M).(Q,
  W);

definition
  let M be PseudoMetricSpace;
  func Eq_classMetricSpace M -> MetrSpace equals

  MetrStruct(#M-neighbour, nbourdist M#);
end;

registration
  let M be PseudoMetricSpace;
  cluster Eq_classMetricSpace M -> strict non empty;
end;














begin

reserve X, Y, Z, W for non empty MetrSpace;

scheme 
 LambdaMCART { X, Y, Z() -> non empty set,
   F(set,set,set,set) -> Element of Z()} :
   ex f being Function of [:[:X(),Y():],[:X(),Y():]:],Z() st
   for x1,y1 being Element of X()
   for x2,y2 being Element of Y()
   for x,y being Element of [:X(),Y():] st
     x = [x1,x2] & y = [y1,y2] holds f.(x,y) = F(x1,y1,x2,y2);

definition let X,Y;
  func dist_cart2(X,Y) -> Function of [:[:the carrier of X,the carrier of Y:],
  [:the carrier of X,the carrier of Y:]:], REAL means


  for x1, y1 being Element of X, x2, y2 being Element of Y,
      x, y being Element of [:the carrier of X,the carrier of Y:] st
      x = [x1,x2] & y = [y1,y2] holds it.(x,y) = dist(x1,y1) + dist(x2,y2);
end;

theorem 
  for x, y being Element of [:the carrier of X,the carrier of Y:]
  holds dist_cart2(X,Y).(x,y) = 0 iff x = y;

theorem 
  for x,y being Element of [:the carrier of X,the carrier of Y:]
  holds dist_cart2(X,Y).(x,y) = dist_cart2(X,Y).(y,x);

theorem 
  for x,y,z being Element of [:the carrier of X,the carrier of Y:]
  holds dist_cart2(X,Y).(x,z) <= dist_cart2(X,Y).(x,y) + dist_cart2(X,Y).(y,z);

definition let X,Y;
  let x,y be Element of [:the carrier of X,the carrier of Y:];
  func dist2(x,y) -> Real equals

  dist_cart2(X,Y).(x,y);
end;

registration
  let A be non empty set, r be Function of [:A,A:], REAL;
  cluster MetrStruct(#A,r#) -> non empty;
end;

definition
  let X,Y;
  func MetrSpaceCart2(X,Y) -> strict non empty MetrSpace equals

  MetrStruct (#[:the carrier of X,the carrier of Y:], dist_cart2(X,Y)#);
end;



scheme 

  LambdaMCART1 { X, Y, Z, T() -> non empty set, F(set,set,set,set,set,set) ->
Element of T()}: ex f being Function of [:[:X(),Y(),Z():],[:X(),Y(),Z():]:],T()
  st for x1,y1 being Element of X() for x2,y2 being Element of Y() for x3,y3
being Element of Z() for x,y being Element of [:X(),Y(),Z():] st x = [x1,x2,x3]
  & y = [y1,y2,y3] holds f.(x,y) = F(x1,y1,x2,y2,x3,y3);

definition
  let X,Y,Z;
  func dist_cart3(X,Y,Z) -> Function of [:[:the carrier of X,the carrier of Y,
  the carrier of Z:], [:the carrier of X,the carrier of Y,the carrier of Z:]:],
  REAL means


  for x1,y1 being Element of X for x2,y2 being Element of Y for
  x3,y3 being Element of Z for x,y being Element of [:the carrier of X,the
carrier of Y,the carrier of Z:] st x = [x1,x2,x3] & y = [y1,y2,y3] holds it.(x,
  y) = (dist(x1,y1) + dist(x2,y2)) + dist(x3,y3);
end;

theorem 
  for x,y being Element of [:the carrier of X,the carrier of Y,the
  carrier of Z:] holds dist_cart3(X,Y,Z).(x,y) = 0 iff x = y;

theorem 
  for x,y being Element of [:the carrier of X,the carrier of Y,the
  carrier of Z:] holds dist_cart3(X,Y,Z).(x,y) = dist_cart3(X,Y,Z).(y,x);

theorem 
  for x,y,z being Element of [:the carrier of X,the carrier of Y,
  the carrier of Z:] holds dist_cart3(X,Y,Z).(x,z) <= dist_cart3(X,Y,Z).(x,y) +
  dist_cart3(X,Y,Z).(y,z);

definition
  let X,Y,Z;
  func MetrSpaceCart3(X,Y,Z) -> strict non empty MetrSpace equals

  MetrStruct(#
[:the carrier of X,the carrier of Y,the carrier of Z:], dist_cart3(X,Y,Z)#);
end;

definition
  let X,Y,Z;
  let x,y be Element of [:the carrier of X,the carrier of Y,the carrier of Z:];
  func dist3(x,y) -> Real equals

  dist_cart3(X,Y,Z).(x,y);
end;



scheme 

  LambdaMCART2 { X, Y, Z, W, T() -> non empty set, F(set,set,set,set,set,set,
set,set) ->Element of T()}: ex f being Function of [:[:X(),Y(),Z(),W():],[:X(),
  Y(),Z(),W():]:],T() st for x1,y1 being Element of X() for x2,y2 being Element
  of Y() for x3,y3 being Element of Z() for x4,y4 being Element of W() for x,y
  being Element of [:X(),Y(),Z(),W():] st x = [x1,x2,x3,x4] & y = [y1,y2,y3,y4]
  holds f.(x,y) = F(x1,y1,x2,y2,x3,y3,x4,y4);

definition
  let X,Y,Z,W;
  func dist_cart4(X,Y,Z,W) -> Function of [:[:the carrier of X,the carrier of
Y,the carrier of Z,the carrier of W:], [:the carrier of X,the carrier of Y,the
  carrier of Z,the carrier of W:]:], REAL means


  for x1,y1 being Element of
  X for x2,y2 being Element of Y for x3,y3 being Element of Z for x4,y4 being
  Element of W for x,y being Element of [:the carrier of X,the carrier of Y,the
carrier of Z,the carrier of W:] st x = [x1,x2,x3,x4] & y = [y1,y2,y3,y4] holds
  it.(x,y) = (dist(x1,y1) + dist(x2,y2)) + (dist(x3,y3) + dist(x4,y4));
end;

theorem 
  for x,y being Element of [:the carrier of X,the carrier of Y,the
  carrier of Z,the carrier of W:] holds dist_cart4(X,Y,Z,W).(x,y) = 0 iff x = y
;

theorem 
  for x,y being Element of [:the carrier of X,the carrier of Y,the
carrier of Z,the carrier of W:] holds dist_cart4(X,Y,Z,W).(x,y) = dist_cart4(X,
  Y,Z,W).(y,x);

theorem 
  for x,y,z being Element of [:the carrier of X,the carrier of Y,
  the carrier of Z,the carrier of W:] holds dist_cart4(X,Y,Z,W).(x,z) <=
  dist_cart4(X,Y,Z,W).(x,y) + dist_cart4(X,Y,Z,W).(y,z);

definition
  let X,Y,Z,W;
  func MetrSpaceCart4(X,Y,Z,W) -> strict non empty MetrSpace equals

  MetrStruct
  (#[:the carrier of X, the carrier of Y, the carrier of Z, the carrier of W:],
    dist_cart4(X,Y,Z,W)#);
end;

definition let X,Y,Z,W;
  let x,y be Element of [:the carrier of X,the carrier of Y,the carrier of Z,
  the carrier of W:];
  func dist4(x,y) -> Real equals

  dist_cart4(X,Y,Z,W).(x,y);
end;

begin 

reserve X,Y for non empty MetrSpace;

definition let X,Y;
  func dist_cart2S(X,Y) -> Function of [:[:the carrier of X,the carrier of Y:]
  , [:the carrier of X,the carrier of Y:]:],REAL means


  for x1,y1 being
  Element of X for x2,y2 being Element of Y for x,y being Element of [:the
  carrier of X,the carrier of Y:] st x = [x1,x2] & y = [y1,y2] holds it.(x,y) =
  sqrt((dist(x1,y1))^2 + (dist(x2,y2)^2));
end;

theorem 
  for x,y being Element of [:the carrier of X,the carrier of Y:]
  holds dist_cart2S(X,Y).(x,y) = 0 iff x = y;

theorem 
  for x,y being Element of [:the carrier of X,the carrier of Y:]
  holds dist_cart2S(X,Y).(x,y) = dist_cart2S(X,Y).(y,x);

theorem 
  for a,b,c,d being real number st 0 <= a & 0 <= b & 0 <= c & 0 <= d holds
    sqrt((a + c)^2 + (b + d)^2) <= sqrt(a^2 + b^2) + sqrt(c^2 + d^2);

theorem 
  for x,y,z being Element of [:the carrier of X,the carrier of Y:]
holds dist_cart2S(X,Y).(x,z) <= dist_cart2S(X,Y).(x,y) + dist_cart2S(X,Y).(y,z)
;

definition let X,Y;
  let x,y be Element of [:the carrier of X,the carrier of Y:];
  func dist2S(x,y) -> Real equals

  dist_cart2S(X,Y).(x,y);
end;

definition let X,Y;
  func MetrSpaceCart2S(X,Y) -> strict non empty MetrSpace equals

  MetrStruct(#[:the carrier of X,the carrier of Y:],dist_cart2S(X,Y)#);
end;

begin 

reserve Z for non empty MetrSpace;

definition let X,Y,Z;
  func dist_cart3S(X,Y,Z) -> Function of [:[:the carrier of X,the carrier of Y
,the carrier of Z:], [:the carrier of X,the carrier of Y,the carrier of Z:]:],
  REAL means


  for x1,y1 being Element of X for x2,y2 being Element of Y
  for x3,y3 being Element of Z
  for x,y being Element of [:the carrier of X,the carrier of Y,
    the carrier of Z:] st x = [x1,x2,x3] & y = [y1,y2,y3] holds
    it.(x,y) =sqrt((dist(x1,y1))^2 + (dist(x2,y2))^2 + (dist(x3,y3))^2);
end;

theorem 
  for x,y being Element of [:the carrier of X,the carrier of Y,the
  carrier of Z:] holds dist_cart3S(X,Y,Z).(x,y) = 0 iff x = y;

theorem 
  for x,y being Element of [:the carrier of X,the carrier of Y,the
  carrier of Z:] holds dist_cart3S(X,Y,Z).(x,y) = dist_cart3S(X,Y,Z).(y,x);

theorem 
  for a,b,c,d,e,f being real number holds (2*(a*d)*(c*b) + 2*(a*f)
*(e*c) + 2*(b*f)*(e*d)) <= (((a*d)^2 + (c*b)^2 + (a*f)^2 + (e*c)^2 + (b*f)^2) +
  (e*d)^2);

theorem 
  for a,b,c,d,e,f being real number holds ((a*c) + (b*d) + (e*f))
  ^2 <= (a^2 + b^2 + e^2)*(c^2 + d^2 + f^2);

theorem 
  for x,y,z being Element of [:the carrier of X,the carrier of Y,
the carrier of Z:] holds dist_cart3S(X,Y,Z).(x,z) <= dist_cart3S(X,Y,Z).(x,y) +
  dist_cart3S(X,Y,Z).(y,z);

definition let X,Y,Z;
  let x,y be Element of [:the carrier of X,the carrier of Y,the carrier of Z:];
  func dist3S(x,y) -> Real equals

  dist_cart3S(X,Y,Z).(x,y);
end;

definition let X,Y,Z;
  func MetrSpaceCart3S(X,Y,Z) -> strict non empty MetrSpace equals

  MetrStruct
(#[:the carrier of X,the carrier of Y,the carrier of Z:], dist_cart3S(X,Y,Z)#);
end;

definition
  func taxi_dist2 -> Function of [:[:REAL,REAL:],[:REAL,REAL:]:],REAL means


   for x1,y1,x2,y2 being Element of REAL for x,y being Element of [:REAL,
  REAL:] st x = [x1,x2] & y = [y1,y2] holds it.(x,y) = real_dist.(x1,y1) +
  real_dist.(x2,y2);
end;

theorem 
  for x,y being Element of [:REAL,REAL:] holds taxi_dist2.(x,y) = 0 iff x = y;

theorem 
  for x,y being Element of [:REAL,REAL:] holds taxi_dist2.(x,y) =
  taxi_dist2.(y,x);

theorem 
  for x,y,z being Element of [:REAL,REAL:] holds taxi_dist2.(x,z)
  <= taxi_dist2.(x,y) + taxi_dist2.(y,z);

definition
  func RealSpaceCart2 -> strict non empty MetrSpace equals

  MetrStruct(#[:REAL,REAL:],taxi_dist2#);
end;

definition
  func Eukl_dist2 -> Function of [:[:REAL,REAL:],[:REAL,REAL:]:],REAL means


   for x1,y1,x2,y2 being Element of REAL for x,y being Element of [:REAL,
REAL:] st x = [x1,x2] & y = [y1,y2] holds it.(x,y) = sqrt((real_dist.(x1,y1))^2
  + (real_dist.(x2,y2)^2));
end;

theorem 
  for x,y being Element of [:REAL,REAL:] holds Eukl_dist2.(x,y) = 0 iff x = y;

theorem 
  for x,y being Element of [:REAL,REAL:] holds Eukl_dist2.(x,y) =
  Eukl_dist2.(y,x);

theorem 
  for x,y,z being Element of [:REAL,REAL:] holds Eukl_dist2.(x,z)
  <= Eukl_dist2.(x,y) + Eukl_dist2.(y,z);

definition
  func EuklSpace2 -> strict non empty MetrSpace equals

  MetrStruct(#[:REAL,REAL:],Eukl_dist2#);
end;

definition
  func taxi_dist3 -> Function of [:[:REAL,REAL,REAL:], [:REAL,REAL,REAL:]:],
  REAL means


  for x1,y1,x2,y2,x3,y3 being Element of REAL for x,y being
Element of [:REAL,REAL,REAL:] st x = [x1,x2,x3] & y = [y1,y2,y3] holds it.(x,y)
  = real_dist.(x1,y1) + real_dist.(x2,y2) + real_dist.(x3,y3);
end;

theorem 
  for x,y being Element of [:REAL,REAL,REAL:] holds
  taxi_dist3.(x,y) = 0 iff x = y;

theorem 
  for x,y being Element of [:REAL,REAL,REAL:] holds taxi_dist3.(x,
  y) = taxi_dist3.(y,x);

theorem 
  for x,y,z being Element of [:REAL,REAL,REAL:] holds taxi_dist3.(
  x,z) <= taxi_dist3.(x,y) + taxi_dist3.(y,z);

definition
  func RealSpaceCart3 -> strict non empty MetrSpace equals

  MetrStruct(#[:REAL,REAL,REAL:],taxi_dist3#);
end;

definition
  func Eukl_dist3 -> Function of [:[:REAL,REAL,REAL:], [:REAL,REAL,REAL:]:],
  REAL means


  for x1,y1,x2,y2,x3,y3 being Element of REAL for x,y being
Element of [:REAL,REAL,REAL:] st x = [x1,x2,x3] & y = [y1,y2,y3] holds it.(x,y)
= sqrt((real_dist.(x1,y1))^2 + (real_dist.(x2,y2)^2) + (real_dist.(x3,y3)^2));
end;

theorem 
  for x,y being Element of [:REAL,REAL,REAL:] holds
  Eukl_dist3.(x,y) = 0 iff x = y;

theorem 
  for x,y being Element of [:REAL,REAL,REAL:] holds Eukl_dist3.(x,
  y) = Eukl_dist3.(y,x);

theorem 
  for x,y,z being Element of [:REAL,REAL,REAL:] holds Eukl_dist3.(
  x,z) <= Eukl_dist3.(x,y) + Eukl_dist3.(y,z);

definition
  func EuklSpace3 -> strict non empty MetrSpace equals

  MetrStruct(#[:REAL,REAL,REAL:],Eukl_dist3#);
end;














begin

reserve PCPP for CollProjectiveSpace,
  a,a9,a1,a2,a3,b,b9,b1,b2,c,c1,c3,d,d9,e,
  o,p,p1,p2,p3,r,q, q1,q2,q3,x,y for Element of PCPP;

theorem 
  a,b,c is_collinear implies b,c,a is_collinear & c,a,b
  is_collinear & b,a,c is_collinear & a,c,b is_collinear & c,b,a is_collinear;

theorem 
  a<>b & a,b,c is_collinear & a,b,d is_collinear implies a,c,d is_collinear;

theorem 
  p<>q & a,b,p is_collinear & a,b,q is_collinear & p,q,r is_collinear
  implies a,b,r is_collinear;

theorem 
  p<>q implies ex r st not p,q,r is_collinear;

theorem 
  ex q,r st not p,q,r is_collinear;

theorem 
  not a,b,c is_collinear & a,b,b9 is_collinear & a<>b9 implies not
  a,b9,c is_collinear;

theorem 
  not a,b,c is_collinear & a,b,d is_collinear & a,c,d is_collinear implies a=d;

theorem 
  not o,a,d is_collinear & o,d,d9 is_collinear & d<>d9 & a9,d9,x
  is_collinear & o,a,a9 is_collinear & o<>a9 implies x<>d;

theorem 
  not a1,a2,a3 is_collinear & a1,a2,c3 is_collinear & a2,a3,c1
is_collinear & c1,c3,x is_collinear & c3<>a1 & c3<>a2 & c1<>a2 & c1<>a3 implies
  a1<>x & a3<>x;

theorem 
  not a,b,c is_collinear & a,b,d is_collinear & c,e,d is_collinear
  & e<>c & d<>a implies not e,a,c is_collinear;

theorem 
  not p1,p2,q1 is_collinear & p1,p2,q2 is_collinear & q1,q2,q3
  is_collinear & q2<>q3 implies not p2,p1,q3 is_collinear;

theorem 
  not p1,p2,q1 is_collinear & p1,p2,p3 is_collinear & q1,q2,p3
  is_collinear & p3<>q2 & p2<>p3 implies not p3,p2,q2 is_collinear;

theorem 
  not p1,p2,q1 is_collinear & p1,p2,p3 is_collinear & q1,q2,p1
  is_collinear & p1<>p3 & p1<>q2 implies not p3,p1,q2 is_collinear;

theorem 
  a1<>a2 & b1<>b2 & b1,b2,x is_collinear & b1,b2,y is_collinear &
a1,a2,x is_collinear & a1,a2,y is_collinear & not a1,a2,b1 is_collinear implies
  x=y;

theorem 
  not o,a1,a2 is_collinear & o,a1,b1 is_collinear & o,a2,b2
  is_collinear & o<>b1 & o<>b2 implies not o,b1,b2 is_collinear;

reserve PCPP for Pappian CollProjectivePlane,
  a,a1,a2,a3,b1,b2,b3,c1,c2,c3,o,p
  ,p1,p2,p3,q,q9, q1,q2,q3,r,r1,r2,r3,x,y,z for Element of PCPP;

theorem 
  p2<>p3 & p1<>p3 & q2<>q3 & q1<>q2 & q1<>q3 & not p1,p2,q1
  is_collinear & p1,p2,p3 is_collinear & q1,q2,q3 is_collinear & p1,q2,r3
  is_collinear & q1,p2,r3 is_collinear & p1,q3,r2 is_collinear & p3,q1,r2
  is_collinear & p2,q3,r1 is_collinear & p3,q2,r1 is_collinear implies r1,r2,r3
  is_collinear;

theorem 
  o<>b1 & a1<>b1 & o<>b2 & a2<>b2 & o<>b3 & a3<>b3 & not o,a1,a2
  is_collinear & not o,a1,a3 is_collinear & not o,a2,a3 is_collinear & a1,a2,c3
  is_collinear & b1,b2,c3 is_collinear & a2,a3,c1 is_collinear & b2,b3,c1
  is_collinear & a1,a3,c2 is_collinear & b1,b3,c2 is_collinear & o,a1,b1
  is_collinear & o,a2,b2 is_collinear & o,a3,b3 is_collinear implies c1,c2,c3
  is_collinear;

registration
  cluster Pappian -> Desarguesian for CollProjectiveSpace;
end;














begin

reserve CPS for proper CollSp,
  B for Subset of CPS,
  p for Point of CPS,
  x, y, z, Y for set;

definition
  let CPS;
  redefine mode LINE of CPS -> Subset of CPS;
end;

definition
  let CPS;
  func ProjectiveLines(CPS) -> set equals

  {B : B is LINE of CPS};
end;

registration
  let CPS;
  cluster ProjectiveLines(CPS) -> non empty;
end;

theorem 
  x is LINE of CPS iff x is Element of ProjectiveLines(CPS);

definition
  let CPS;
  func Proj_Inc(CPS) -> Relation of the carrier of CPS, ProjectiveLines(CPS)
  means


  for x,y holds [x,y] in it iff x in the carrier of CPS & y in
  ProjectiveLines(CPS) & ex Y st y=Y & x in Y;
end;

definition
  let CPS;
  func IncProjSp_of(CPS) -> IncProjStr equals

  IncProjStr (# the carrier of CPS
    , ProjectiveLines(CPS), Proj_Inc(CPS) #);
end;

registration
  let CPS;
  cluster IncProjSp_of(CPS) -> strict;
end;

theorem 
  the Points of IncProjSp_of(CPS) = the carrier of CPS & the Lines of
  IncProjSp_of(CPS) = ProjectiveLines(CPS) & the Inc of IncProjSp_of(CPS) =
  Proj_Inc(CPS);

theorem 
  x is Point of CPS iff x is POINT of IncProjSp_of(CPS);

theorem 
  x is LINE of CPS iff x is LINE of IncProjSp_of(CPS);

reserve a,b,c,p,q for POINT of IncProjSp_of(CPS),
  P,Q for LINE of IncProjSp_of(CPS),
  a9,b9,c9,p9,q9,r9 for Point of CPS,
  P9 for LINE of CPS;

theorem 
  p = p9 & P = P9 implies (p on P iff p9 in P9);

theorem 
  ex a9, b9, c9 st a9<>b9 & b9<>c9 & c9<>a9;

theorem 
  ex b9 st a9<>b9;

theorem 
  p on P & q on P & p on Q & q on Q implies p = q or P = Q;

theorem 
  ex P st p on P & q on P;

theorem 
  a = a9 & b = b9 & c = c9 implies (a9,b9,c9 is_collinear iff ex P
  st a on P & b on P & c on P);

theorem 
  ex p, P st not p on P;

reserve CPS for CollProjectiveSpace,
  a,b,c,d,p,q for POINT of IncProjSp_of(CPS ),
  P,Q,S,M,N for LINE of IncProjSp_of(CPS),
  a9,b9,c9,d9,p9,q9 for Point of CPS;

theorem 
  ex a, b, c st a<>b & b<>c & c <>a & a on P & b on P & c on P;

theorem 
  a on M & b on M & c on N & d on N & p on M & p on N & a on P & c
on P & b on Q & d on Q & not p on P & not p on Q & M<>N implies ex q st q on P
  & q on Q;

theorem 
  (for a9,b9,c9,d9 ex p9 st a9, b9, p9 is_collinear & c9, d9, p9
  is_collinear) implies for M, N ex q st q on M & q on N;

theorem 
  (ex p, p1, r, r1 being Point of CPS st not ex s being Point of
CPS st (p, p1, s is_collinear & r, r1, s is_collinear)) implies ex M, N st not
  ex q st q on M & q on N;

theorem 
  (for p, p1, q, q1, r2 being Point of CPS ex r, r1 being Point of
  CPS st p,q,r is_collinear & p1,q1,r1 is_collinear & r2,r,r1 is_collinear)
  implies for a, M, N ex b, c, S st a on S & b on S & c on S & b on M & c on N;

theorem 
  (for p1, r2, q, r1, q1, p, r being Point of CPS holds (p1,r2,q
  is_collinear & r1,q1,q is_collinear & p1,r1,p is_collinear & r2,q1,p
is_collinear & p1,q1,r is_collinear & r2,r1,r is_collinear & p,q,r is_collinear
  implies (p1,r2,q1 is_collinear or p1,r2,r1 is_collinear or p1,r1,q1
is_collinear or r2,r1,q1 is_collinear))) implies for p, q, r, s, a, b, c being
POINT of IncProjSp_of(CPS) for L, Q, R, S, A, B, C being LINE of IncProjSp_of(
CPS) st not q on L & not r on L & not p on Q & not s on Q & not p on R & not r
on R & {a,p,s} on L & {a,q,r} on Q & {b,q,s} on R & {b,p,r} on S & {c,p,q} on A
  & {c,r,s} on B & {a,b} on C holds not c on C;

theorem 
  (for o,p1,p2,p3,q1,q2,q3,r1,r2,r3 being Point of CPS st o<>q1 &
p1<>q1 & o<>q2 & p2<>q2 & o<>q3 & p3<>q3 & not o,p1,p2 is_collinear & not o,p1,
  p3 is_collinear & not o,p2,p3 is_collinear & p1,p2,r3 is_collinear & q1,q2,r3
  is_collinear & p2,p3,r1 is_collinear & q2,q3,r1 is_collinear & p1,p3,r2
  is_collinear & q1,q3,r2 is_collinear & o,p1,q1 is_collinear & o,p2,q2
is_collinear & o,p3,q3 is_collinear holds r1,r2,r3 is_collinear) implies for o,
b1,a1,b2,a2,b3,a3,r,s,t being POINT of IncProjSp_of(CPS) for C1,C2,C3,A1,A2,A3,
B1,B2,B3 being LINE of IncProjSp_of(CPS) st {o,b1,a1} on C1 & {o,a2,b2} on C2 &
{o,a3,b3} on C3 & {a3,a2,t} on A1 & {a3,r,a1} on A2 & {a2,s,a1} on A3 & {t,b2,
b3} on B1 & {b1,r,b3} on B2 & {b1,s,b2} on B3 & C1,C2,C3 are_mutually_different
  & o<>a1 & o<>a2 & o<>a3 & o<>b1 & o<>b2 & o<>b3 & a1<>b1 & a2<>b2 & a3<>b3
  holds ex O being LINE of IncProjSp_of(CPS) st {r,s,t} on O;

theorem 
  (for o,p1,p2,p3,q1,q2,q3,r1,r2,r3 being Point of CPS st o<>p2 &
  o<>p3 & p2<>p3 & p1<>p2 & p1<>p3 & o<>q2 & o<>q3 & q2<>q3 & q1<>q2 & q1<>q3 &
not o,p1,q1 is_collinear & o,p1,p2 is_collinear & o,p1,p3 is_collinear & o,q1,
  q2 is_collinear & o,q1,q3 is_collinear & p1,q2,r3 is_collinear & q1,p2,r3
  is_collinear & p1,q3,r2 is_collinear & p3,q1,r2 is_collinear & p2,q3,r1
is_collinear & p3,q2,r1 is_collinear holds r1,r2,r3 is_collinear) implies for o
,a1,a2,a3,b1,b2,b3,c1,c2,c3 being POINT of IncProjSp_of(CPS) for A1,A2,A3,B1,B2
  ,B3,C1,C2,C3 being LINE of IncProjSp_of(CPS) st o,a1,a2,a3
are_mutually_different & o,b1,b2,b3 are_mutually_different & A3<>B3 & o on A3 &
  o on B3 & {a2,b3,c1} on A1 & {a3,b1,c2} on B1 & {a1,b2,c3} on C1 & {a1,b3,c2}
on A2 & {a3,b2,c1} on B2 & {a2,b1,c3} on C2 & {b1,b2,b3} on A3 & {a1,a2,a3} on
  B3 & {c1,c2} on C3 holds c3 on C3;

definition
  let S be IncProjStr;
  attr S is partial means


  for p, q being POINT of S, P, Q being LINE of
  S st p on P & q on P & p on Q & q on Q holds p = q or P = Q;
  redefine attr S is linear means


  for p,q being POINT of S ex P being LINE of S st p on P & q on P;
end;

definition
  let S be IncProjStr;
  attr S is up-2-dimensional means


  ex p being POINT of S, P being LINE of S st not p on P;
  attr S is up-3-rank means


  for P being LINE of S ex a, b, c being
  POINT of S st a <> b & b <> c & c <> a & a on P & b on P & c on P;
  attr S is Vebleian means


  for a, b, c, d, p, q being POINT of S for M
, N, P, Q being LINE of S st a on M & b on M & c on N & d on N & p on M & p on
N & a on P & c on P & b on Q & d on Q & not p on P & not p on Q & M<>N holds ex
  q being POINT of S st q on P & q on Q;
end;

registration
  let CPS be CollProjectiveSpace;
  cluster IncProjSp_of(CPS) -> partial linear up-2-dimensional up-3-rank
    Vebleian;
end;

registration
  cluster strict partial linear up-2-dimensional up-3-rank Vebleian for
IncProjStr;
end;

definition
  mode IncProjSp is partial linear up-2-dimensional up-3-rank Vebleian
    IncProjStr;
end;

registration
  let CPS be CollProjectiveSpace;
  cluster IncProjSp_of(CPS) -> partial linear up-2-dimensional up-3-rank
    Vebleian;
end;

definition
  let IT be IncProjSp;
  attr IT is 2-dimensional means


  for M,N being LINE of IT ex q being POINT of IT st q on M & q on N;
end;

notation
  let IT be IncProjSp;
  antonym IT is up-3-dimensional for IT is 2-dimensional;
end;

definition
  let IT be IncProjStr;

  attr IT is at_most-3-dimensional means


  for a being POINT of IT, M, N
being LINE of IT ex b,c being POINT of IT, S being LINE of IT st a on S & b on
  S & c on S & b on M & c on N;
end;

definition
  let IT be IncProjSp;
  attr IT is 3-dimensional means

  IT is at_most-3-dimensional up-3-dimensional;
end;

definition
  let IT be IncProjStr;
  attr IT is Fanoian means


  for p,q,r,s,a,b,c being POINT of IT for L,Q
,R,S,A,B,C being LINE of IT st not q on L & not r on L & not p on Q & not s on
Q & not p on R & not r on R & not q on S & not s on S & {a,p,s} on L & {a,q,r}
  on Q & {b,q,s} on R & {b,p,r} on S & {c,p,q} on A & {c,r,s} on B & {a,b} on C
  holds not c on C;
end;

definition
  let IT be IncProjStr;
  attr IT is Desarguesian means


  for o,b1,a1,b2,a2,b3,a3,r,s,t being
POINT of IT for C1,C2,C3,A1,A2,A3,B1,B2,B3 being LINE of IT st {o,b1,a1} on C1
& {o,a2,b2} on C2 & {o,a3,b3} on C3 & {a3,a2,t} on A1 & {a3,r,a1} on A2 & {a2,s
  ,a1} on A3 & {t,b2,b3} on B1 & {b1,r,b3} on B2 & {b1,s,b2} on B3 & C1,C2,C3
are_mutually_different & o<>a1 & o<>a2 & o<>a3 & o<>b1 & o<>b2 & o<>b3 & a1<>b1
  & a2<>b2 & a3<>b3 holds ex O being LINE of IT st {r,s,t} on O;
end;

definition
  let IT be IncProjStr;
  attr IT is Pappian means


  for o,a1,a2,a3,b1,b2,b3,c1,c2,c3 being
  POINT of IT for A1,A2,A3,B1,B2,B3,C1,C2,C3 being LINE of IT st o,a1,a2,a3
are_mutually_different & o,b1,b2,b3 are_mutually_different & A3<>B3 & o on A3 &
  o on B3 & {a2,b3,c1} on A1 & {a3,b1,c2} on B1 & {a1,b2,c3} on C1 & {a1,b3,c2}
on A2 & {a3,b2,c1} on B2 & {a2,b1,c3} on C2 & {b1,b2,b3} on A3 & {a1,a2,a3} on
  B3 & {c1,c2} on C3 holds c3 on C3;
end;

registration
  cluster Desarguesian Fanoian at_most-3-dimensional up-3-dimensional
    for IncProjSp;
end;

registration
  cluster Pappian Fanoian at_most-3-dimensional up-3-dimensional for IncProjSp;
end;

registration
  cluster Desarguesian Fanoian 2-dimensional for IncProjSp;
end;

registration
  cluster Pappian Fanoian 2-dimensional for IncProjSp;
end;















begin

reserve AFV for WeakAffVect;
reserve a,a9,b,b9,c,d,p,p9,q,q9,r,r9 for Element of AFV;

registration
  let A be non empty set, C be Relation of [:A,A:];
  cluster AffinStruct(#A,C#) -> non empty;
end;

definition
  let IT be non empty AffinStruct;

  attr IT is WeakAffSegm-like means


  (for a,b being Element of IT holds
a,b // b,a) & (for a,b being Element of IT st a,b // a,a holds a=b) & (for a,b,
c,d,p,q being Element of IT st a,b // p,q & c,d // p,q holds a,b // c,d) & (for
a,c being Element of IT ex b being Element of IT st a,b // b,c) & (for a,a9,b,
b9,p being Element of IT st a<>a9 & b<>b9& p,a // p,a9 & p,b // p,b9 holds a,b
// a9,b9) & (for a,b being Element of IT holds a=b or ex c being Element of IT
st ( a<>c & a,b // b,c) or ex p,p9 being Element of IT st (p<>p9 & a,b // p,p9
  & a,p // p,b & a,p9 // p9,b)) & (for a,b,b9,p,p9,c being Element of IT st a,b
// b,c & b,b9 // p,p9 & b,p // p,b9 & b,p9 // p9,b9 holds a,b9 // b9,c) & (for
a,b,b9,c being Element of IT st a<>c & b<>b9 & a,b // b,c & a,b9 // b9,c holds
ex p,p9 being Element of IT st p<>p9 & b,b9 // p,p9& b,p // p,b9 & b,p9 // p9,
b9) & for a,b,c,p,p9,q,q9 being Element of IT st a,b // p,p9 & a,c // q,q9 & a,
p // p,b & a,q // q,c & a,p9 // p9,b & a,q9 // q9,c holds ex r,r9 being Element
  of IT st b,c // r,r9 & b,r // r,c & b,r9 // r9,c;
end;

registration
  cluster strict WeakAffSegm-like for non trivial AffinStruct;
end;

definition
  mode WeakAffSegm is WeakAffSegm-like non trivial AffinStruct;
end;





reserve AFV for WeakAffSegm;
reserve a,b,b9,b99,c,d,p,p9 for Element of AFV;

theorem 
  a,b // a,b;

theorem 
  a,b // c,d implies c,d // a,b;

theorem 
  a,b // c,d implies a,b // d,c;

theorem 
  a,b // c,d implies b,a // c,d;

theorem 
  for a,b holds a,a // b,b;

theorem 
  a,b // c,c implies a=b;

theorem 
  a,b // p,p9 & a,b // b,c & a,p // p,b & a,p9 // p9,b implies a=c;

theorem 
  a,b9 // a,b99 & a,b // a,b99 implies b=b9 or b=b99 or b9=b99;





definition
  let AFV;
  let a,b;

  pred MDist a,b means


  ex p,p9 st p<>p9 & a,b // p,p9 & a,p // p,b & a, p9 // p9,b;
end;

definition
  let AFV;
  let a,b,c;
  pred Mid a,b,c means

  a=b & b=c & a=c or a=c & MDist a,b or a<>c & a,b // b,c;
end;

theorem 
  a<>b & not MDist a,b implies ex c st a<>c & a,b // b,c;

theorem 
  MDist a,b & a,b // b,c implies a=c;

theorem 
  MDist a,b implies a<>b;














begin




reserve A, B for non empty preBoolean set,
  x, y for Element of [:A,B:];

definition
  let A,B,x,y;
  pred x c= y means

  x`1 c= y`1 & x`2 c= y`2;
  reflexivity;
  func x \/ y -> Element of [:A, B:] equals

  [x`1 \/ y`1, x`2 \/ y`2];
  commutativity;
  idempotence;
  func x /\ y -> Element of [:A, B:] equals

  [x`1 /\ y`1, x`2 /\ y`2];
  commutativity;
  idempotence;
  func x \ y -> Element of [:A, B:] equals

  [x`1 \ y`1, x`2 \ y`2];
  func x \+\ y -> Element of [:A, B:] equals

  [x`1 \+\ y`1, x`2 \+\ y`2];
  commutativity;
end;

reserve X for set,
  a,b,c for Element of [:A,B:];

theorem 
  a c= b & b c= a implies a = b;

theorem 
  a c= b & b c= c implies a c= c;

theorem 
  (a \/ b) \/ c = a \/ (b \/ c);

theorem 
  (a /\ b) /\ c = a /\ (b /\ c);

theorem 
  a /\ (b \/ c) = a /\ b \/ a /\ c;

theorem 
  a \/ (b /\ a) = a;

theorem 
  a /\ (b \/ a) = a;

theorem 
  a \/ (b /\ c) = (a \/ b) /\ (a \/ c);

theorem 
  a c= c & b c= c implies a \/ b c= c;

theorem 
  a c= a \/ b & b c= a \/ b;

theorem 
  a = a \/ b implies b c= a;

theorem 
  a c= b implies c \/ a c= c \/ b & a \/ c c= b \/ c;

theorem 
  a\b \/ b = a \/ b;

theorem 
  a \ b c= c implies a c= b \/ c;

theorem 
  a c= b \/ c implies a \ c c= b;

reserve a for Element of [:Fin X, Fin X:];

definition
  let A be set;
  func FinPairUnion A -> BinOp of [:Fin A, Fin A:] means


  for x,y being Element of [:Fin A, Fin A:] holds it.(x,y) = x \/ y;
end;

reserve A for set;

definition
  let X be non empty set, A be set;
  let B be Element of Fin X;
  let f be Function of X, [:Fin A, Fin A:];
  func FinPairUnion(B,f) -> Element of [:Fin A, Fin A:] equals

  FinPairUnion A $$(B,f);
end;

registration
  let A be set;
  cluster FinPairUnion A -> commutative idempotent associative;
end;

theorem 
  for X being non empty set for f being Function of X, [:Fin A,Fin A:]
  for B being Element of Fin X for x being Element of X st x in B holds f.x c=
  FinPairUnion(B,f);

theorem 
  [{}.A, {}.A] is_a_unity_wrt FinPairUnion A;

theorem 
  FinPairUnion A is having_a_unity;

theorem 
  the_unity_wrt FinPairUnion A = [{}.A, {}.A];

theorem 
  for x being Element of [:Fin A, Fin A:] holds the_unity_wrt
  FinPairUnion A c= x;

theorem 
  for X being non empty set for f being (Function of X,[:Fin A,Fin A:]),
  B being (Element of Fin X) for c being Element of [:Fin A, Fin A:] st for x
  being Element of X st x in B holds f.x c= c holds FinPairUnion(B,f) c= c;

theorem 
  for X being non empty set, B being Element of Fin X for f,g being
  Function of X,[:Fin A,Fin A:] st f|B = g|B holds FinPairUnion(B,f) =
  FinPairUnion(B,g);



definition
  let X;
  func DISJOINT_PAIRS(X) -> Subset of [:Fin X, Fin X:] equals

  { a : a`1 misses
  a`2 };
end;

registration
  let X;
  cluster DISJOINT_PAIRS(X) -> non empty;
end;

theorem 
  for y being Element of [:Fin X, Fin X:] holds y in
  DISJOINT_PAIRS X iff y`1 misses y`2;

reserve x,y for Element of [:Fin X, Fin X:],
  a,b for Element of DISJOINT_PAIRS X;

theorem 
  y in DISJOINT_PAIRS X & x in DISJOINT_PAIRS X implies (y \/ x in
  DISJOINT_PAIRS X iff y`1 /\ x`2 \/ x`1 /\ y`2 = {});

theorem 
  a`1 misses a`2;

theorem 
  x c= b implies x is Element of DISJOINT_PAIRS X;

theorem 
  not (ex x being set st x in a`1 & x in a`2);

theorem 
  not a \/ b in DISJOINT_PAIRS X implies ex p being Element of X st p in
  a`1 & p in b`2 or p in b`1 & p in a`2;

theorem 
  x`1 misses x`2 implies x is Element of DISJOINT_PAIRS X;

theorem 
  for V,W being set st V c= a`1 & W c= a`2 holds [V,W] is Element of
  DISJOINT_PAIRS X;

reserve A for set,
  x for Element of [:Fin A, Fin A:],
  a,b,c,d,s,t for Element of DISJOINT_PAIRS A,
  B,C,D for Element of Fin DISJOINT_PAIRS A;

definition
  let A;
  func Normal_forms_on A -> Subset of Fin DISJOINT_PAIRS A equals

  { B : a in B
  & b in B & a c= b implies a = b};
end;

registration
  let A;
  cluster Normal_forms_on A -> non empty;
end;

reserve K,L,M for Element of Normal_forms_on A;

theorem 
  {} in Normal_forms_on A;

theorem 
  B in Normal_forms_on A & a in B & b in B & a c= b implies a = b;

theorem 
  (for a,b st a in B & b in B & a c= b holds a = b) implies B in
  Normal_forms_on A;

definition
  let A,B;
  func mi B -> Element of Normal_forms_on A equals

  { t : s in B & s c= t iff s
  = t };
  let C;
  func B^C -> Element of Fin DISJOINT_PAIRS A equals

  DISJOINT_PAIRS A /\ { s
  \/ t: s in B & t in C };
end;

theorem 
  x in B^C implies ex b,c st b in B & c in C & x = b \/ c;

theorem 
  b in B & c in C & b \/ c in DISJOINT_PAIRS A implies b \/ c in B ^C;

theorem 
  a in mi B implies a in B & (b in B & b c= a implies b = a);

theorem 
  a in mi B implies a in B;

theorem 
  a in mi B & b in B & b c= a implies b = a;

theorem 
  a in B & (for b st b in B & b c= a holds b = a) implies a in mi B;

definition
  let A be non empty set;
  let B be non empty Subset of A;
  let O be BinOp of B;
  let a,b be Element of B;
  redefine func O.(a,b) -> Element of B;
end;

theorem 
  mi B c= B;

theorem 
  b in B implies ex c st c c= b & c in mi B;

theorem 
  mi K = K;

theorem 
  mi (B \/ C) c= mi B \/ C;

theorem 
  mi(mi B \/ C) = mi (B \/ C);

theorem 
  mi(B \/ mi C) = mi (B \/ C);

theorem 
  B c= C implies B ^ D c= C ^ D;

theorem 
  mi(B ^ C) c= mi B ^ C;

theorem 
  B^C = C^B;

theorem 
  B c= C implies D ^ B c= D ^ C;

theorem 
  mi(mi B ^ C) = mi (B ^ C);

theorem 
  mi(B ^ mi C) = mi (B ^ C);

theorem 
  K^(L^M) = K^L^M;

theorem 
  K^(L \/ M) = K^L \/ K^M;

theorem 
  B c= B ^ B;

theorem 
  mi(K ^ K) = mi K;

definition
  let A;

  func NormForm A -> strict LattStr means


  the carrier of it =
  Normal_forms_on A & for B, C being Element of Normal_forms_on A holds (the
  L_join of it).(B, C) = mi (B \/ C) & (the L_meet of it).(B, C) = mi (B^C);
end;

registration
  let A;
  cluster NormForm A -> non empty;
end;

reserve K, L, M for Element of Normal_forms_on A;

registration
  let A;
  cluster NormForm A -> Lattice-like;
end;

registration
  let A;
  cluster NormForm A -> distributive lower-bounded;
end;

theorem 
  {} is Element of NormForm A;

theorem 
  Bottom NormForm A = {};














begin 

reserve i,j,k,m,n for Nat;
reserve R for non empty doubleLoopStr;
reserve x,y for Scalar of R;
reserve f,g,h for FinSequence of R;

definition
  let R be non empty doubleLoopStr, x be Scalar of R;

  func x^2 -> Scalar of R equals

  x*x;
end;

definition
  let R be non empty doubleLoopStr, x be Scalar of R;
  attr x is being_a_square means

  ex y being Scalar of R st x=y^2;
end;

definition
  let R,f;
  attr f is being_a_Sum_of_squares means


  len f<>0 & f/.1 is
being_a_square & for n st n<>0 & n<len f ex y st y is being_a_square & f/.(n+1)
  =f/.n+y;
end;

definition
  let R be non empty doubleLoopStr, x be Scalar of R;
  attr x is being_a_sum_of_squares means


  ex f being FinSequence of R st f is being_a_Sum_of_squares & x=f/.len f;
end;

definition
  let R,f;
  attr f is being_a_Product_of_squares means


  len f<>0 & f/.1 is
being_a_square & for n st n<>0 & n<len f ex y st y is being_a_square & f/.(n+1)
  =f/.n*y;
end;

definition
  let R,x;
  attr x is being_a_product_of_squares means


  ex f st f is being_a_Product_of_squares & x=f/.len f;
end;

definition
  let R,f;
  attr f is being_a_Sum_of_products_of_squares means


  len f<>0 & f/.1 is
  being_a_product_of_squares & for n st n<>0 & n<len f ex y st y is
  being_a_product_of_squares & f/.(n+1)=f/.n+y;
end;

definition
  let R,x;
  attr x is being_a_sum_of_products_of_squares means


  ex f st f is being_a_Sum_of_products_of_squares & x=f/.len f;
end;

definition
  let R,f;
  attr f is being_an_Amalgam_of_squares means


  len f<>0 & for n st n<>0
& n<=len f holds f/.n is being_a_product_of_squares or ex i,j st f/.n=f/.i*f/.j
  & i<>0 & i<n & j<>0 & j<n;
end;

definition
  let R,x;
  attr x is being_an_amalgam_of_squares means


  ex f st f is being_an_Amalgam_of_squares & x=f/.len f;
end;

definition
  let R,f;
  attr f is being_a_Sum_of_amalgams_of_squares means


  len f<>0 & f/.1
  is being_an_amalgam_of_squares & for n st n<>0 & n<len f ex y st y is
  being_an_amalgam_of_squares & f/.(n+1)=f/.n+y;
end;

definition
  let R,x;
  attr x is being_a_sum_of_amalgams_of_squares means


  ex f st f is being_a_Sum_of_amalgams_of_squares & x=f/.len f;
end;

definition
  let R,f;
  attr f is being_a_generation_from_squares means


  len f<>0 & for n st
n<>0 & n<=len f holds f/.n is being_an_amalgam_of_squares or ex i,j st (f/.n=f
  /.i*f/.j or f/.n=f/.i+f/.j) & i<>0 & i<n & j<>0 & j<n;
end;

definition
  let R,x;
  attr x is generated_from_squares means


  ex f st f is being_a_generation_from_squares & x=f/.len f;
end;

theorem 
  x is being_a_sum_of_amalgams_of_squares implies x is generated_from_squares;

theorem 
  x is being_a_square implies x is being_a_sum_of_squares & x is
  being_a_product_of_squares & x is being_a_sum_of_products_of_squares & x is
  being_an_amalgam_of_squares & x is being_a_sum_of_amalgams_of_squares & x is
  generated_from_squares;

theorem 
  x is being_a_sum_of_squares implies x is
being_a_sum_of_products_of_squares & x is being_a_sum_of_amalgams_of_squares &
  x is generated_from_squares;

theorem 
  x is being_a_product_of_squares implies x is
  being_a_sum_of_products_of_squares & x is being_an_amalgam_of_squares & x is
being_a_sum_of_amalgams_of_squares & x is generated_from_squares;

theorem 
  x is being_a_sum_of_products_of_squares implies x is
being_a_sum_of_amalgams_of_squares & x is generated_from_squares;

theorem 
  x is being_an_amalgam_of_squares implies x is
being_a_sum_of_amalgams_of_squares & x is generated_from_squares;

begin

theorem 
  x is being_a_square & y is being_a_square or x is
  being_a_sum_of_squares & y is being_a_square implies x+y is
  being_a_sum_of_squares;

theorem 
  x is being_a_sum_of_products_of_squares & y is being_a_square or x is
being_a_sum_of_products_of_squares & y is being_a_product_of_squares implies x+
  y is being_a_sum_of_products_of_squares;

theorem 
  x is being_an_amalgam_of_squares & (y is being_a_product_of_squares or
y is being_an_amalgam_of_squares) or x is being_a_sum_of_amalgams_of_squares &
  (y is being_a_square or y is being_a_product_of_squares or y is
being_an_amalgam_of_squares) implies x+y is being_a_sum_of_amalgams_of_squares;

theorem 
  x is being_a_square & (y is being_a_sum_of_squares or y is
  being_a_product_of_squares or y is being_a_sum_of_products_of_squares or y is
being_an_amalgam_of_squares or y is being_a_sum_of_amalgams_of_squares or y is
generated_from_squares) implies x+y is generated_from_squares;

theorem 
  x is being_a_sum_of_squares & y is being_a_sum_of_squares implies x+y
  is generated_from_squares;

theorem 
  x is being_a_sum_of_squares & y is being_a_product_of_squares implies
  x+y is generated_from_squares;

theorem 
  x is being_a_sum_of_squares & y is being_a_sum_of_products_of_squares
  implies x+y is generated_from_squares;

theorem 
  x is being_a_sum_of_squares & y is being_an_amalgam_of_squares implies
  x+y is generated_from_squares;

theorem 
  x is being_a_sum_of_squares & y is being_a_sum_of_amalgams_of_squares
  implies x+y is generated_from_squares;

theorem 
  x is being_a_sum_of_squares & y is generated_from_squares implies x+y
  is generated_from_squares;

theorem 
  x is being_a_product_of_squares & y is generated_from_squares implies
  x+y is generated_from_squares;

theorem 
  x is being_a_product_of_squares & y is
  being_a_sum_of_amalgams_of_squares implies x+y is generated_from_squares;

theorem 
  x is being_a_product_of_squares & y is being_an_amalgam_of_squares
  implies x+y is generated_from_squares;

theorem 
  x is being_a_product_of_squares & y is
  being_a_sum_of_products_of_squares implies x+y is generated_from_squares;

theorem 
  x is being_a_product_of_squares & y is being_a_product_of_squares
  implies x+y is generated_from_squares;

theorem 
  x is being_a_product_of_squares & y is being_a_sum_of_squares implies
  x+y is generated_from_squares;

theorem 
  x is being_a_product_of_squares & y is being_a_square implies x+y is
  generated_from_squares;

theorem 
  x is being_a_sum_of_products_of_squares & y is generated_from_squares
  implies x+y is generated_from_squares;

theorem 
  x is being_a_sum_of_products_of_squares & y is being_a_sum_of_squares
  implies x+y is generated_from_squares;

theorem 
  x is being_a_sum_of_products_of_squares & y is
  being_a_sum_of_products_of_squares implies x+y is generated_from_squares;

theorem 
  x is being_a_sum_of_products_of_squares & y is
  being_an_amalgam_of_squares implies x+y is generated_from_squares;

theorem 
  x is being_a_sum_of_products_of_squares & y is
  being_a_sum_of_amalgams_of_squares implies x+y is generated_from_squares;

theorem 
  x is being_an_amalgam_of_squares & y is generated_from_squares implies
  x+y is generated_from_squares;

theorem 
  x is being_an_amalgam_of_squares & y is being_a_square implies x+y is
  generated_from_squares;

theorem 
  x is being_an_amalgam_of_squares & y is being_a_sum_of_squares implies
  x+y is generated_from_squares;

theorem 
  x is being_an_amalgam_of_squares & y is
  being_a_sum_of_products_of_squares implies x+y is generated_from_squares;

theorem 
  x is being_an_amalgam_of_squares & y is
  being_a_sum_of_amalgams_of_squares implies x+y is generated_from_squares;

theorem 
  x is being_a_sum_of_amalgams_of_squares & y is being_a_sum_of_squares
  implies x+y is generated_from_squares;

theorem 
  x is being_a_sum_of_amalgams_of_squares & y is
  being_a_sum_of_products_of_squares implies x+y is generated_from_squares;

theorem 
  x is being_a_sum_of_amalgams_of_squares & y is
  being_a_sum_of_amalgams_of_squares implies x+y is generated_from_squares;

theorem 
  x is being_a_sum_of_amalgams_of_squares & y is generated_from_squares
  implies x+y is generated_from_squares;

theorem 
  x is generated_from_squares & y is being_a_square or x is
  generated_from_squares & y is being_a_sum_of_squares or x is
  generated_from_squares & y is being_a_product_of_squares or x is
  generated_from_squares & y is being_a_sum_of_products_of_squares or x is
  generated_from_squares & y is being_an_amalgam_of_squares or x is
  generated_from_squares & y is being_a_sum_of_amalgams_of_squares or x is
  generated_from_squares & y is generated_from_squares implies x+y is
  generated_from_squares;

begin

theorem 
  x is being_a_product_of_squares & y is being_a_square implies x*y is
  being_a_product_of_squares;

theorem 
  x is being_a_square & y is being_a_square implies x*y is
  being_a_product_of_squares;

theorem 
  x is being_a_square & y is being_a_product_of_squares implies x*y is
  being_an_amalgam_of_squares;

theorem 
  x is being_a_square & y is being_an_amalgam_of_squares implies x*y is
  being_an_amalgam_of_squares;

theorem 
  x is being_a_product_of_squares & y is being_a_product_of_squares
  implies x*y is being_an_amalgam_of_squares;

theorem 
  x is being_a_product_of_squares & y is being_an_amalgam_of_squares
  implies x*y is being_an_amalgam_of_squares;

theorem 
  x is being_an_amalgam_of_squares & y is being_a_square implies x*y is
  being_an_amalgam_of_squares;

theorem 
  x is being_an_amalgam_of_squares & y is being_a_product_of_squares
  implies x*y is being_an_amalgam_of_squares;

theorem 
  x is being_an_amalgam_of_squares & y is being_an_amalgam_of_squares
  implies x*y is being_an_amalgam_of_squares;

theorem 
  x is being_a_square & y is being_a_sum_of_squares implies x*y is
  generated_from_squares;

theorem 
  x is being_a_square & y is being_a_sum_of_products_of_squares implies
  x*y is generated_from_squares;

theorem 
  x is being_a_square & y is being_a_sum_of_amalgams_of_squares implies
  x*y is generated_from_squares;

theorem 
  x is being_a_square & y is generated_from_squares implies x*y is
  generated_from_squares;

theorem 
  x is being_a_sum_of_squares & y is being_a_square implies x*y is
  generated_from_squares;

theorem 
  x is being_a_sum_of_squares & y is being_a_sum_of_squares implies x*y
  is generated_from_squares;

theorem 
  x is being_a_sum_of_squares & y is being_a_product_of_squares implies
  x*y is generated_from_squares;

theorem 
  x is being_a_sum_of_squares & y is being_a_sum_of_products_of_squares
  implies x*y is generated_from_squares;

theorem 
  x is being_a_sum_of_squares & y is being_an_amalgam_of_squares implies
  x*y is generated_from_squares;

theorem 
  x is being_a_sum_of_squares & y is being_a_sum_of_amalgams_of_squares
  implies x*y is generated_from_squares;

theorem 
  x is being_a_sum_of_squares & y is generated_from_squares implies x*y
  is generated_from_squares;

theorem 
  x is being_a_product_of_squares & y is being_a_sum_of_squares implies
  x*y is generated_from_squares;

theorem 
  x is being_a_product_of_squares & y is
  being_a_sum_of_products_of_squares implies x*y is generated_from_squares;

theorem 
  x is being_a_product_of_squares & y is
  being_a_sum_of_amalgams_of_squares implies x*y is generated_from_squares;

theorem 
  x is being_a_product_of_squares & y is generated_from_squares implies
  x*y is generated_from_squares;

theorem 
  x is being_a_sum_of_products_of_squares & y is being_a_square implies
  x*y is generated_from_squares;

theorem 
  x is being_a_sum_of_products_of_squares & y is being_a_sum_of_squares
  implies x*y is generated_from_squares;

theorem 
  x is being_a_sum_of_products_of_squares & y is
  being_a_product_of_squares implies x*y is generated_from_squares;

theorem 
  x is being_a_sum_of_products_of_squares & y is
  being_a_sum_of_products_of_squares implies x*y is generated_from_squares;

theorem 
  x is being_a_sum_of_products_of_squares & y is
  being_an_amalgam_of_squares implies x*y is generated_from_squares;

theorem 
  x is being_a_sum_of_products_of_squares & y is
  being_a_sum_of_amalgams_of_squares implies x*y is generated_from_squares;

theorem 
  x is being_a_sum_of_products_of_squares & y is generated_from_squares
  implies x*y is generated_from_squares;

theorem 
  x is being_an_amalgam_of_squares & y is being_a_sum_of_squares implies
  x*y is generated_from_squares;

theorem 
  x is being_an_amalgam_of_squares & y is
  being_a_sum_of_products_of_squares implies x*y is generated_from_squares;

theorem 
  x is being_an_amalgam_of_squares & y is
  being_a_sum_of_amalgams_of_squares implies x*y is generated_from_squares;

theorem 
  x is being_an_amalgam_of_squares & y is generated_from_squares implies
  x*y is generated_from_squares;

theorem 
  x is being_a_sum_of_amalgams_of_squares & y is being_a_square implies
  x*y is generated_from_squares;

theorem 
  x is being_a_sum_of_amalgams_of_squares & y is being_a_sum_of_squares
  implies x*y is generated_from_squares;

theorem 
  x is being_a_sum_of_amalgams_of_squares & y is
  being_a_product_of_squares implies x*y is generated_from_squares;

theorem 
  x is being_a_sum_of_amalgams_of_squares & y is
  being_a_sum_of_products_of_squares implies x*y is generated_from_squares;

theorem 
  x is being_a_sum_of_amalgams_of_squares & y is
  being_an_amalgam_of_squares implies x*y is generated_from_squares;

theorem 
  x is being_a_sum_of_amalgams_of_squares & y is
  being_a_sum_of_amalgams_of_squares implies x*y is generated_from_squares;

theorem 
  x is being_a_sum_of_amalgams_of_squares & y is generated_from_squares
  implies x*y is generated_from_squares;

theorem 
  x is generated_from_squares & y is being_a_square implies x*y is
  generated_from_squares;

theorem 
  x is generated_from_squares & y is being_an_amalgam_of_squares implies
  x*y is generated_from_squares;

theorem 
  x is generated_from_squares & y is being_a_sum_of_squares implies x*y
  is generated_from_squares;

theorem 
  x is generated_from_squares & y is being_a_product_of_squares implies
  x*y is generated_from_squares;

theorem 
  x is generated_from_squares & y is being_a_sum_of_products_of_squares
  implies x*y is generated_from_squares;

theorem 
  x is generated_from_squares & y is being_a_sum_of_amalgams_of_squares
  implies x*y is generated_from_squares;














begin





definition
  struct(ZeroOneStr) TernaryFieldStr (# carrier -> set, ZeroF, OneF -> Element
    of the carrier, TernOp -> TriOp of the carrier #);
end;

registration
  cluster non empty for TernaryFieldStr;
end;

reserve F for non empty TernaryFieldStr;



definition
  let F;
  mode Scalar of F is Element of F;
end;

reserve a,b,c for Scalar of F;

definition
  let F,a,b,c;
  func Tern(a,b,c) -> Scalar of F equals

  (the TernOp of F).(a,b,c);
end;





definition

  func ternaryreal -> TriOp of REAL means


  for a,b,c being Real holds it .(a,b,c) = a*b + c;
end;




definition
  func TernaryFieldEx -> strict TernaryFieldStr equals

  TernaryFieldStr (# REAL
    , 0, 1, ternaryreal #);
end;

registration
  cluster TernaryFieldEx -> non empty;
end;




definition
  let a,b,c be Scalar of TernaryFieldEx;
  func tern(a,b,c) -> Scalar of TernaryFieldEx equals

  (the TernOp of
  TernaryFieldEx).(a,b,c);
end;

theorem 
  for u,u9,v,v9 being Real holds u <> u9 implies ex x being Real st
  u*x+v = u9*x+v9;

theorem 
  for u,a,v being Scalar of TernaryFieldEx for z,x,y being Real holds u=
  z & a=x & v=y implies Tern(u,a,v) = z*x + y;




theorem 
  1 = 1.TernaryFieldEx;

definition
  let IT be non empty TernaryFieldStr;
  attr IT is Ternary-Field-like means


  0.IT <> 1.IT & (for a being
  Scalar of IT holds Tern(a, 1.IT, 0.IT) = a) & (for a being Scalar of IT holds
Tern(1.IT, a, 0.IT) = a) & (for a,b being Scalar of IT holds Tern(a, 0.IT, b )
  = b) & (for a,b being Scalar of IT holds Tern(0.IT, a, b ) = b) & (for u,a,b
being Scalar of IT ex v being Scalar of IT st Tern(u,a,v) = b) & (for u,a,v,v9
being Scalar of IT holds Tern(u,a,v) = Tern(u,a,v9) implies v = v9) & (for a,a9
  being Scalar of IT holds a <> a9 implies for b,b9 being Scalar of IT ex u,v
  being Scalar of IT st Tern(u,a,v) = b & Tern(u,a9,v) = b9) & (for u,u9 being
  Scalar of IT holds u <> u9 implies for v,v9 being Scalar of IT ex a being
Scalar of IT st Tern(u,a,v) = Tern(u9,a,v9)) & for a,a9,u,u9,v,v9 being Scalar
of IT holds Tern(u,a,v) = Tern(u9,a,v9) & Tern(u,a9,v) = Tern(u9,a9,v9) implies
  a = a9 or u = u9;
end;

registration
  cluster strict Ternary-Field-like for non empty TernaryFieldStr;
end;

definition
  mode Ternary-Field is Ternary-Field-like non empty TernaryFieldStr;
end;

reserve F for Ternary-Field;
reserve a,a9,b,c,x,x9,u,u9,v,v9,z for Scalar of F;

theorem 
  a<>a9 & Tern(u,a,v) = Tern(u9,a,v9) & Tern(u,a9,v) = Tern(u9,a9,v9)
  implies u=u9 & v=v9;

theorem 
  a<>0.F implies for b,c ex x st Tern(a,x,b) = c;

theorem 
  a<>0.F & Tern(a,x,b) = Tern(a,x9,b) implies x=x9;

theorem 
  a<>0.F implies for b,c ex x st Tern(x,a,b) = c;

theorem 
  a<>0.F & Tern(x,a,b) = Tern(x9,a,b) implies x=x9;














begin

reserve IPP for IncProjSp;
reserve a,b,c,d,p,q,o,r,s,t,u,v,w,x,y for POINT of IPP;
reserve A,B,C,D,L,P,Q,S for LINE of IPP;

theorem 
  ex a st not a on A;

theorem 
  ex A st not a on A;

theorem 
  A<>B implies ex a,b st a on A & not a on B & b on B & not b on A;

theorem 
  a<>b implies ex A,B st a on A & not a on B & b on B & not b on A;

theorem 
  ex A,B,C st a on A & a on B & a on C & A<>B & B<>C & C<>A;

theorem 
  ex a st not a on A & not a on B;

theorem 
  ex a st a on A;

theorem 
  ex c st c on A & c <>a & c <>b;

theorem 
  ex A st not a on A & not b on A;

theorem 
  o on A & o on B & A<>B & a on A & o<>a & b on B & c on B & b<>c
  & a on P & b on P & c on Q implies P<>Q;

theorem 
  {a,b,c} on A implies {a,c,b} on A & {b,a,c} on A & {b,c,a} on A
  & {c,a,b} on A & {c,b,a} on A;

theorem 
  for IPP being Desarguesian IncProjSp holds for o,b1,a1,b2,a2,b3,
a3,r,s,t being POINT of IPP, C1,C2,C3,A1,A2,A3,B1,B2,B3 being LINE of IPP st {o
,b1,a1} on C1 & {o,a2,b2} on C2 & {o,a3,b3} on C3 & {a3,a2,t} on A1 & {a3,r,a1}
on A2 & {a2,s,a1} on A3 & {t,b2,b3} on B1 & {b1,r,b3} on B2 & {b1,s,b2} on B3 &
  C1,C2,C3 are_mutually_different & o<>a3 & o<>b1 & o<>b2 & a2<>b2 ex O being
  LINE of IPP st {r,s,t} on O;

theorem 
  (ex A,a,b,c,d st a on A & b on A & c on A & d on A & a,b,c,d
are_mutually_different) implies for B ex p,q,r,s st p on B & q on B & r on B &
  s on B & p,q,r,s are_mutually_different;

reserve IPP for Fanoian IncProjSp;
reserve a,b,c,d,p,q,r,s for POINT of IPP;
reserve A,B,C,D,L,Q,R,S for LINE of IPP;

theorem 
  ex p,q,r,s,a,b,c,A,B,C,Q,L,R,S,D st not q on L & not r on L & not p on
Q & not s on Q & not p on R & not r on R & not q on S & not s on S & {a,p,s} on
L & {a,q,r} on Q & {b,q,s} on R & {b,p,r} on S & {c,p,q} on A & {c,r,s} on B &
  {a,b} on C & not c on C;

theorem 
  ex a,A,B,C,D st a on A & a on B & a on C & a on D & A,B,C,D
  are_mutually_different;

theorem 
  ex a,b,c,d,A st a on A & b on A & c on A & d on A & a,b,c,d
  are_mutually_different;

theorem 
  ex p,q,r,s st p on B & q on B & r on B & s on B & p,q,r,s
  are_mutually_different;

reserve IPP for Desarguesian 2-dimensional IncProjSp;
reserve c,p,q,x,y for POINT of IPP;
reserve A,B,C,D,K,L,R,X for LINE of IPP;
reserve f for PartFunc of the Points of IPP,the Points of IPP;

definition
  let IPP,K,L,p;
  assume that
 not p on K and
 not p on L;
  func IncProj(K,p,L) -> PartFunc of the Points of IPP,the Points of IPP means


  dom it c= the Points of IPP & (for x holds x in dom it iff x on K) & for
  x,y st x on K & y on L holds it.x=y iff ex X st p on X & x on X & y on X;
end;

theorem 
  not p on K implies for x st x on K holds IncProj(K,p,K).x=x;

theorem 
  not p on K & not p on L & x on K implies IncProj(K,p,L).x is POINT of IPP;

theorem 
  not p on K & not p on L & x on K & y = IncProj (K,p,L).x implies y on L;

theorem 
  not p on K & not p on L & y in rng IncProj(K,p,L) implies y on L;

theorem 
  not p on K & not p on L & not q on L & not q on R implies dom (
  IncProj(L,q,R)*IncProj(K,p,L)) = dom IncProj(K,p,L) & rng (IncProj(L,q,R)*
  IncProj(K,p,L)) = rng IncProj(L,q,R);

theorem 
  for a1,b1,a2,b2 being POINT of IPP holds not p on K & not p on L
  & a1 on K & b1 on K & IncProj(K,p,L).a1=a2 & IncProj(K,p,L).b1=b2 & a2=b2
  implies a1=b1;

theorem 
  not p on K & not p on L & x on K & x on L implies IncProj (K,p,L ).x=x;

reserve X for set;

theorem 
  not p on K & not p on L & not q on L & not q on R & c on K & c on L &
  c on R & K <> R implies ex o being POINT of IPP st not o on K & not o on R &
  IncProj(L,q,R)*IncProj(K,p,L)=IncProj(K,o,R);














begin

reserve x for set,
  R for Ring,
  V for LeftMod of R,
  v,v1,v2 for Vector of V,
  A, B for Subset of V;

definition
  let R be non empty doubleLoopStr;
  let V be non empty VectSpStr over R;
  let IT be Subset of V;
  attr IT is linearly-independent means


  for l be Linear_Combination of IT st Sum(l) = 0.V holds Carrier(l) = {};
end;

notation
  let R be non empty doubleLoopStr;
  let V be non empty VectSpStr over R;
  let IT be Subset of V;
  antonym IT is linearly-dependent for IT is linearly-independent;
end;

theorem 
  A c= B & B is linearly-independent implies A is linearly-independent;

theorem 
  0.R <> 1.R & A is linearly-independent implies not 0.V in A;

theorem 
  {}(the carrier of V) is linearly-independent;

theorem 
  0.R <> 1.R & {v1,v2} is linearly-independent implies v1 <> 0.V & v2 <> 0.V;

theorem 
  0.R <> 1.R implies {v,0.V} is linearly-dependent & {0.V,v} is
  linearly-dependent;

theorem 
  for R being domRing, V being LeftMod of R, L being
Linear_Combination of V, a being Scalar of R holds a <> 0.R implies Carrier(a *
  L) = Carrier(L);

theorem 
  for R being domRing, V being LeftMod of R, L being
  Linear_Combination of V, a being Scalar of R holds Sum(a * L) = a * Sum(L);

reserve R for domRing,
  V for LeftMod of R,
  A,B for Subset of V,
  l for Linear_Combination of A,
  f,g for Function of the carrier of V, the carrier of R;

definition
  let R;
  let V;
  let A;
  func Lin(A) -> strict Subspace of V means


  the carrier of it = {Sum(l) : not contradiction};
end;

theorem 
  x in Lin(A) iff ex l st x = Sum(l);

theorem 
  x in A implies x in Lin(A);

theorem 
  Lin({}(the carrier of V)) = (0).V;

theorem 
  Lin(A) = (0).V implies A = {} or A = {0.V};

theorem 
  for W being strict Subspace of V st 0.R <> 1.R & A = the carrier
  of W holds Lin(A) = W;

theorem 
  for V being strict LeftMod of R, A being Subset of V st 0.R <> 1.R & A
  = the carrier of V holds Lin(A) = V;

theorem 
  A c= B implies Lin(A) is Subspace of Lin(B);

theorem 
  for V being strict LeftMod of R, A,B being Subset of V st Lin(A) = V &
  A c= B holds Lin(B) = V;

theorem 
  Lin(A \/ B) = Lin(A) + Lin(B);

theorem 
  Lin(A /\ B) is Subspace of Lin(A) /\ Lin(B);














begin

reserve x,y,y1,y2 for set;
reserve R for Ring;
reserve a for Scalar of R;
reserve V,X,Y for RightMod of R;
reserve u,u1,u2,v,v1,v2 for Vector of V;
reserve V1,V2,V3 for Subset of V;

definition
  let R, V, V1;
  attr V1 is linearly-closed means


  (for v,u st v in V1 & u in V1 holds
  v + u in V1) & for a,v st v in V1 holds v * a in V1;
end;

theorem 
  V1 <> {} & V1 is linearly-closed implies 0.V in V1;

theorem 
  V1 is linearly-closed implies for v st v in V1 holds - v in V1;

theorem 
  V1 is linearly-closed implies for v,u st v in V1 & u in V1 holds v - u in V1;

theorem 
  {0.V} is linearly-closed;

theorem 
  the carrier of V = V1 implies V1 is linearly-closed;

theorem 
  V1 is linearly-closed & V2 is linearly-closed & V3 = {v + u : v in V1
  & u in V2} implies V3 is linearly-closed;

theorem 
  V1 is linearly-closed & V2 is linearly-closed implies V1 /\ V2 is
  linearly-closed;

definition
  let R;
  let V;
  mode Submodule of V -> RightMod of R means


    the carrier of it c= the
carrier of V & 0.it = 0.V & the addF of it = (the addF of V) | ([:the carrier
of it,the carrier of it:] qua set) & the rmult of it = (the rmult of V)|([:the
    carrier of it, the carrier of R:] qua set);
end;

reserve W,W1,W2 for Submodule of V;
reserve w,w1,w2 for Vector of W;

theorem 
  x in W1 & W1 is Submodule of W2 implies x in W2;

theorem 
  x in W implies x in V;

theorem 
  w is Vector of V;

theorem 
  0.W = 0.V;

theorem 
  0.W1 = 0.W2;

theorem 
  w1 = v & w2 = u implies w1 + w2 = v + u;

theorem 
  w = v implies w * a = v * a;

theorem 
  w = v implies - v = - w;

theorem 
  w1 = v & w2 = u implies w1 - w2 = v - u;

theorem 
  0.V in W;

theorem 
  0.W1 in W2;

theorem 
  0.W in V;

theorem 
  u in W & v in W implies u + v in W;

theorem 
  v in W implies v * a in W;

theorem 
  v in W implies - v in W;

theorem 
  u in W & v in W implies u - v in W;

theorem 
  V is Submodule of V;

theorem 
  for X,V being strict RightMod of R holds V is Submodule of X & X
  is Submodule of V implies V = X;

registration
  let R,V;
  cluster strict for Submodule of V;
end;

theorem 
  V is Submodule of X & X is Submodule of Y implies V is Submodule of Y;

theorem 
  the carrier of W1 c= the carrier of W2 implies W1 is Submodule of W2;

theorem 
  (for v st v in W1 holds v in W2) implies W1 is Submodule of W2;

theorem 
  for W1,W2 being strict Submodule of V holds the carrier of W1 =
  the carrier of W2 implies W1 = W2;

theorem 
  for W1,W2 being strict Submodule of V holds (for v being Vector
  of V holds v in W1 iff v in W2) implies W1 = W2;

theorem 
  for V being strict RightMod of R, W being strict Submodule of V holds
  the carrier of W = the carrier of V implies W = V;

theorem 
  for V being strict RightMod of R, W being strict Submodule of V holds
  (for v being Vector of V holds v in W) implies W = V;

theorem 
  the carrier of W = V1 implies V1 is linearly-closed;

theorem 
  V1 <> {} & V1 is linearly-closed implies ex W being strict
  Submodule of V st V1 = the carrier of W;

definition
  let R;
  let V;
  func (0).V -> strict Submodule of V means


  the carrier of it = {0.V};
end;

definition
  let R;
  let V;
  func (Omega).V -> strict Submodule of V equals

  the RightModStr of V;
end;

theorem 
  x in (0).V iff x = 0.V;

theorem 
  (0).W = (0).V;

theorem 
  (0).W1 = (0).W2;

theorem 
  (0).W is Submodule of V;

theorem 
  (0).V is Submodule of W;

theorem 
  (0).W1 is Submodule of W2;

theorem 
  for V being strict RightMod of R holds V is Submodule of (Omega).V;

definition
  let R;
  let V;
  let v,W;
  func v + W -> Subset of V equals

  {v + u : u in W};
end;

definition
  let R;
  let V;
  let W;
  mode Coset of W -> Subset of V means


    ex v st it = v + W;
end;

reserve B,C for Coset of W;

theorem 
  x in v + W iff ex u st u in W & x = v + u;

theorem 
  0.V in v + W iff v in W;

theorem 
  v in v + W;

theorem 
  0.V + W = the carrier of W;

theorem 
  v + (0).V = {v};

theorem 
  v + (Omega).V = the carrier of V;

theorem 
  0.V in v + W iff v + W = the carrier of W;

theorem 
  v in W iff v + W = the carrier of W;

theorem 
  v in W implies (v * a) + W = the carrier of W;

theorem 
  u in W iff v + W = (v + u) + W;

theorem 
  u in W iff v + W = (v - u) + W;

theorem 
  v in u + W iff u + W = v + W;

theorem 
  u in v1 + W & u in v2 + W implies v1 + W = v2 + W;

theorem 
  v in W implies v * a in v + W;

theorem 
  v in W implies - v in v + W;

theorem 
  u + v in v + W iff u in W;

theorem 
  v - u in v + W iff u in W;

theorem 
  u in v + W iff ex v1 st v1 in W & u = v - v1;

theorem 
  (ex v st v1 in v + W & v2 in v + W) iff v1 - v2 in W;

theorem 
  v + W = u + W implies ex v1 st v1 in W & v + v1 = u;

theorem 
  v + W = u + W implies ex v1 st v1 in W & v - v1 = u;

theorem 
  for W1,W2 being strict Submodule of V holds v + W1 = v + W2 iff W1 = W2;

theorem 
  for W1,W2 being strict Submodule of V holds v + W1 = u + W2 implies W1 = W2;

theorem 
  ex C st v in C;

theorem 
  C is linearly-closed iff C = the carrier of W;

theorem 
  for W1,W2 being strict Submodule of V for C1 being Coset of W1, C2
  being Coset of W2 holds C1 = C2 implies W1 = W2;

theorem 
  {v} is Coset of (0).V;

theorem 
  V1 is Coset of (0).V implies ex v st V1 = {v};

theorem 
  the carrier of W is Coset of W;

theorem 
  the carrier of V is Coset of (Omega).V;

theorem 
  V1 is Coset of (Omega).V implies V1 = the carrier of V;

theorem 
  0.V in C iff C = the carrier of W;

theorem 
  u in C iff C = u + W;

theorem 
  u in C & v in C implies ex v1 st v1 in W & u + v1 = v;

theorem 
  u in C & v in C implies ex v1 st v1 in W & u - v1 = v;

theorem 
  (ex C st v1 in C & v2 in C) iff v1 - v2 in W;

theorem 
  u in B & u in C implies B = C;














begin

reserve R for Ring,
  V for RightMod of R,
  W,W1,W2,W3 for Submodule of V,
  u,u1, u2,v,v1,v2 for Vector of V,
  x,y,y1,y2 for set;

definition
  let R;
  let V;
  let W1,W2;
  func W1 + W2 -> strict Submodule of V means


  the carrier of it = {v + u: v in W1 & u in W2};
end;

definition
  let R;
  let V;
  let W1,W2;
  func W1 /\ W2 -> strict Submodule of V means


  the carrier of it = (the carrier of W1) /\ (the carrier of W2);
end;

theorem 
  x in W1 + W2 iff ex v1,v2 st v1 in W1 & v2 in W2 & x = v1 + v2;

theorem 
  v in W1 or v in W2 implies v in W1 + W2;

theorem 
  x in W1 /\ W2 iff x in W1 & x in W2;

theorem 
  for W being strict Submodule of V holds W + W = W;

theorem 
  W1 + W2 = W2 + W1;

theorem 
  W1 + (W2 + W3) = (W1 + W2) + W3;

theorem 
  W1 is Submodule of W1 + W2 & W2 is Submodule of W1 + W2;

theorem 
  for W2 being strict Submodule of V holds W1 is Submodule of W2
  iff W1 + W2 = W2;

theorem 
  for W being strict Submodule of V holds (0).V + W = W & W + (0). V = W;

theorem 
  for V being strict RightMod of R holds (0).V + (Omega).V = V &
  (Omega).V + (0).V = V;

theorem 
  for V being RightMod of R, W being Submodule of V holds (Omega).
  V + W = the RightModStr of V & W + (Omega). V = the RightModStr of V;

theorem 
  for V being strict RightMod of R holds (Omega).V + (Omega).V = V;

theorem 
  for W being strict Submodule of V holds W /\ W = W;

theorem 
  W1 /\ W2 = W2 /\ W1;

theorem 
  W1 /\ (W2 /\ W3) = (W1 /\ W2) /\ W3;

theorem 
  W1 /\ W2 is Submodule of W1 & W1 /\ W2 is Submodule of W2;

theorem 
  (for W1 being strict Submodule of V holds W1 is Submodule of W2
  implies W1 /\ W2 = W1) & for W1 st W1 /\ W2 = W1 holds W1 is Submodule of W2;

theorem 
  W1 is Submodule of W2 implies W1 /\ W3 is Submodule of W2 /\ W3;

theorem 
  W1 is Submodule of W3 implies W1 /\ W2 is Submodule of W3;

theorem 
  W1 is Submodule of W2 & W1 is Submodule of W3 implies W1 is Submodule
  of W2 /\ W3;

theorem 
  (0).V /\ W = (0).V & W /\ (0).V = (0).V;

theorem 
  for W being strict Submodule of V holds (Omega).V /\ W = W & W
  /\ (Omega).V = W;

theorem 
  for V being strict RightMod of R holds (Omega).V /\ (Omega).V = V;

theorem 
  W1 /\ W2 is Submodule of W1 + W2;

theorem 
  for W2 being strict Submodule of V holds (W1 /\ W2) + W2 = W2;

theorem 
  for W1 being strict Submodule of V holds W1 /\ (W1 + W2) = W1;

theorem 
  (W1 /\ W2) + (W2 /\ W3) is Submodule of W2 /\ (W1 + W3);

theorem 
  W1 is Submodule of W2 implies W2 /\ (W1 + W3) = (W1 /\ W2) + (W2 /\ W3
  );

theorem 
  W2 + (W1 /\ W3) is Submodule of (W1 + W2) /\ (W2 + W3);

theorem 
  W1 is Submodule of W2 implies W2 + (W1 /\ W3) = (W1 + W2) /\ (W2 + W3);

theorem 
  for W1 being strict Submodule of V holds W1 is Submodule of W3
  implies W1 + (W2 /\ W3) = (W1 + W2) /\ W3;

theorem 
  for W1,W2 being strict Submodule of V holds W1 + W2 = W2 iff W1 /\ W2 = W1;

theorem 
  for W2,W3 being strict Submodule of V holds W1 is Submodule of W2
  implies W1 + W3 is Submodule of W2 + W3;

theorem 
  W1 is Submodule of W2 implies W1 is Submodule of W2 + W3;

theorem 
  W1 is Submodule of W3 & W2 is Submodule of W3 implies W1 + W2 is
  Submodule of W3;

theorem 
  (ex W st the carrier of W = (the carrier of W1) \/ (the carrier of W2)
  ) iff W1 is Submodule of W2 or W2 is Submodule of W1;

definition
  let R;
  let V;
  func Submodules(V) -> set means


  for x holds x in it iff ex W being strict Submodule of V st W = x;
end;

registration
  let R;
  let V;
  cluster Submodules(V) -> non empty;
end;

theorem 
  for V being strict RightMod of R holds V in Submodules(V);

definition
  let R;
  let V;
  let W1,W2;
  pred V is_the_direct_sum_of W1,W2 means


  the RightModStr of V = W1 + W2 & W1 /\ W2 = (0).V;
end;

theorem 
  V is_the_direct_sum_of W1,W2 implies V is_the_direct_sum_of W2, W1;

theorem 
  for V being strict RightMod of R holds V is_the_direct_sum_of (0).V,
  (Omega).V & V is_the_direct_sum_of (Omega).V,(0).V;

reserve C1 for Coset of W1;
reserve C2 for Coset of W2;

theorem 
  C1 meets C2 implies C1 /\ C2 is Coset of W1 /\ W2;

theorem 
  for V being RightMod of R, W1,W2 being Submodule of V holds V
  is_the_direct_sum_of W1,W2 iff for C1 being Coset of W1, C2 being Coset of W2
  ex v being Vector of V st C1 /\ C2 = {v};

theorem 
  for V being strict RightMod of R, W1,W2 being Submodule of V holds W1
  + W2 = V iff for v being Vector of V ex v1,v2 being Vector of V st v1 in W1 &
  v2 in W2 & v = v1 + v2;

theorem 
  for V being RightMod of R, W1,W2 being Submodule of V, v,v1,v2,
u1,u2 being Vector of V holds V is_the_direct_sum_of W1,W2 & v = v1 + v2 & v =
  u1 + u2 & v1 in W1 & u1 in W1 & v2 in W2 & u2 in W2 implies v1 = u1 & v2 = u2
;

theorem 
  V = W1 + W2 & (ex v st for v1,v2,u1,u2 st v = v1 + v2 & v = u1 + u2 &
  v1 in W1 & u1 in W1 & v2 in W2 & u2 in W2 holds v1 = u1 & v2 = u2) implies V
  is_the_direct_sum_of W1,W2;

definition
  let R;
  let V be RightMod of R;
  let v be Vector of V;
  let W1,W2 be Submodule of V;
  assume
 V is_the_direct_sum_of W1,W2;
  func v |-- (W1,W2) -> Element of [:the carrier of V, the carrier of V:]
  means


  v = it`1 + it`2 & it`1 in W1 & it`2 in W2;
end;

theorem 
  V is_the_direct_sum_of W1,W2 implies (v |-- (W1,W2))`1 = (v |-- (W2,W1 ))`2;

theorem 
  V is_the_direct_sum_of W1,W2 implies (v |-- (W1,W2))`2 = (v |-- (W2,W1 ))`1;

reserve A1,A2,B for Element of Submodules(V);

definition
  let R;
  let V;
  func SubJoin(V) -> BinOp of Submodules(V) means


  for A1,A2,W1,W2 st A1 = W1 & A2 = W2 holds it.(A1,A2) = W1 + W2;
end;

definition
  let R;
  let V;
  func SubMeet(V) -> BinOp of Submodules(V) means


  for A1,A2,W1,W2 st A1 = W1 & A2 = W2 holds it.(A1,A2) = W1 /\ W2;
end;

theorem 
  LattStr (# Submodules(V), SubJoin(V), SubMeet(V) #) is Lattice;

theorem 
  LattStr (# Submodules(V), SubJoin(V), SubMeet(V) #) is 0_Lattice;

theorem 
  for V being RightMod of R holds LattStr (# Submodules(V),
    SubJoin(V), SubMeet(V) #) is 1_Lattice;

theorem 
  for V being RightMod of R holds LattStr (# Submodules(V), SubJoin(V),
    SubMeet(V) #) is 01_Lattice;

theorem 
  LattStr (# Submodules(V), SubJoin(V), SubMeet(V) #) is M_Lattice;














begin

reserve R for Ring,
  V for RightMod of R,
  a,b for Scalar of R,
  x,y for set,
  p,q ,r for FinSequence,
  i,k for Nat,
  u,v,v1,v2,v3,w for Vector of V,
  F,G,H for FinSequence of V,
  A,B for Subset of V,
  f for Function of V, R,
  S,T for finite Subset of V;

theorem 
  len F = len G & (for k,v st k in dom F & v = G.k holds F.k = v *
  a) implies Sum(F) = Sum(G) * a;

theorem 
  Sum(<*>(the carrier of V)) * a = 0.V;

theorem 
  Sum<* v,u *> * a = v * a + u * a;

theorem 
  Sum<* v,u,w *> * a = v * a + u * a + w * a;

definition
  let R, V, T;

  func Sum(T) -> Vector of V means


  ex F st rng F = T & F is one-to-one & it = Sum(F);
end;

theorem 
  Sum({}V) = 0.V;

theorem 
  Sum{v} = v;

theorem 
  v1 <> v2 implies Sum{v1,v2} = v1 + v2;

theorem 
  v1 <> v2 & v2 <> v3 & v1 <> v3 implies Sum{v1,v2,v3} = v1 + v2 + v3;

theorem 
  T misses S implies Sum(T \/ S) = Sum(T) + Sum(S);

theorem 
  Sum(T \/ S) = Sum(T) + Sum(S) - Sum(T /\ S);

theorem 
  Sum(T /\ S) = Sum(T) + Sum(S) - Sum(T \/ S);

theorem 
  Sum(T \ S) = Sum(T \/ S) - Sum(S);

theorem 
  Sum(T \ S) = Sum(T) - Sum(T /\ S);

theorem 
  Sum(T \+\ S) = Sum(T \/ S) - Sum(T /\ S);

theorem 
  Sum(T \+\ S) = Sum(T \ S) + Sum(S \ T);

definition
  let R, V;
  mode Linear_Combination of V -> Element of Funcs(the carrier of V, the
    carrier of R) means


    ex T st for v st not v in T holds it.v = 0.R;
end;

reserve L,L1,L2,L3 for Linear_Combination of V;

definition
  let R, V, L;
  func Carrier(L) -> finite Subset of V equals

  {v : L.v <> 0.R};
end;

theorem 
  x in Carrier(L) iff ex v st x = v & L.v <> 0.R;

theorem 
  L.v = 0.R iff not v in Carrier(L);

definition
  let R, V;
  func ZeroLC(V) -> Linear_Combination of V means


  Carrier(it) = {};
end;

theorem 
  ZeroLC(V).v = 0.R;

definition
  let R, V, A;
  mode Linear_Combination of A -> Linear_Combination of V means


    Carrier (it) c= A;
end;

reserve l for Linear_Combination of A;

theorem 
  A c= B implies l is Linear_Combination of B;

theorem 
  ZeroLC(V) is Linear_Combination of A;

theorem 
  for l being Linear_Combination of {}(the carrier of V) holds l = ZeroLC(V);

theorem 
  L is Linear_Combination of Carrier(L);

definition
  let R, V, F, f;
  func f (#) F -> FinSequence of V means


  len it = len F & for i being
  Nat st i in dom it holds it.i = (F/.i) * f.(F/.i);
end;

theorem 
  i in dom F & v = F.i implies (f (#) F).i = v * f.v;

theorem 
  f (#) <*>(the carrier of V) = <*>(the carrier of V);

theorem 
  f (#) <* v *> = <* v * f.v *>;

theorem 
  f (#) <* v1,v2 *> = <* v1 * f.v1, v2 * f.v2 *>;

theorem 
  f (#) <* v1,v2,v3 *> = <* v1 * f.v1, v2 * f.v2, v3 * f.v3 *>;

theorem 
  f (#) (F ^ G) = (f (#) F) ^ (f (#) G);

definition
  let R, V, L;
  func Sum(L) -> Vector of V means


  ex F st F is one-to-one & rng F = Carrier(L) & it = Sum(L (#) F);
end;

theorem 
  0.R <> 1_R implies (A <> {} & A is linearly-closed iff for l
  holds Sum l in A);

theorem 
  Sum(ZeroLC(V)) = 0.V;

theorem 
  for l being Linear_Combination of {}(the carrier of V) holds Sum (l) = 0.V;

theorem 
  for l being Linear_Combination of {v} holds Sum(l) = v * l.v;

theorem 
  v1 <> v2 implies for l being Linear_Combination of {v1,v2} holds
  Sum (l) = v1 * l.v1 + v2 * l.v2;

theorem 
  Carrier(L) = {} implies Sum(L) = 0.V;

theorem 
  Carrier(L) = {v} implies Sum(L) = v * L.v;

theorem 
  Carrier(L) = {v1,v2} & v1 <> v2 implies Sum(L) = v1 * L.v1 + v2 * L.v2;

definition
  let R, V, L1, L2;
  redefine pred L1 = L2 means

  for v holds L1.v = L2.v;
end;

definition
  let R, V, L1, L2;
  func L1 + L2 -> Linear_Combination of V means


  for v holds it.v = L1. v + L2.v;
end;

theorem 
  Carrier(L1 + L2) c= Carrier(L1) \/ Carrier(L2);

theorem 
  L1 is Linear_Combination of A & L2 is Linear_Combination of A
  implies L1 + L2 is Linear_Combination of A;

theorem 
  for R being comRing for V being RightMod of R for L1, L2 being
  Linear_Combination of V holds L1 + L2 = L2 + L1;

theorem 
  L1 + (L2 + L3) = L1 + L2 + L3;

theorem 
  for R being comRing for V being RightMod of R for L being
  Linear_Combination of V holds L + ZeroLC(V) = L & ZeroLC(V) + L = L;

definition
  let R, V, a, L;
  func L * a -> Linear_Combination of V means


  for v holds it.v = L.v * a;
end;

theorem 
  Carrier(L * a) c= Carrier(L);

reserve RR for domRing;
reserve VV for RightMod of RR;
reserve LL for Linear_Combination of VV;
reserve aa for Scalar of RR;
reserve uu, vv for Vector of VV;

theorem 
  aa <> 0.RR implies Carrier(LL * aa) = Carrier(LL);

theorem 
  L * 0.R = ZeroLC(V);

theorem 
  L is Linear_Combination of A implies L * a is Linear_Combination of A;

theorem 
  L * (a + b) = L * a + L * b;

theorem 
  (L1 + L2) * a = L1 * a + L2 * a;

theorem 
  (L * b) * a = L * (b * a);

theorem 
  L * 1_R = L;

definition
  let R, V, L;
  func - L -> Linear_Combination of V equals

  L * (- 1_R);
  involutiveness;
end;

theorem 
  (- L).v = - L.v;

theorem 
  L1 + L2 = ZeroLC(V) implies L2 = - L1;

theorem 
  Carrier(- L) = Carrier(L);

theorem 
  L is Linear_Combination of A implies - L is Linear_Combination of A;

definition
  let R, V, L1, L2;
  func L1 - L2 -> Linear_Combination of V equals

  L1 + (- L2);
end;

theorem 
  (L1 - L2).v = L1.v - L2.v;

theorem 
  Carrier(L1 - L2) c= Carrier(L1) \/ Carrier(L2);

theorem 
  L1 is Linear_Combination of A & L2 is Linear_Combination of A implies
  L1 - L2 is Linear_Combination of A;

theorem 
  L - L = ZeroLC(V);

theorem 
  Sum(L1 + L2) = Sum(L1) + Sum(L2);

reserve R for domRing;
reserve V for RightMod of R;
reserve L,L1,L2 for Linear_Combination of V;
reserve a for Scalar of R;

theorem 
  Sum(L * a) = Sum(L) * a;

theorem 
  Sum(- L) = - Sum(L);

theorem 
  Sum(L1 - L2) = Sum(L1) - Sum(L2);

begin 

reserve x for set;
reserve R for Ring;
reserve V for RightMod of R;
reserve v,v1,v2 for Vector of V;
reserve A,B for Subset of V;

definition
  let R, V;
  let IT be Subset of V;
  attr IT is linearly-independent means


  for l being Linear_Combination of IT st Sum(l) = 0.V holds Carrier(l) = {};
end;

notation
  let R, V;
  let IT be Subset of V;
  antonym IT is linearly-dependent for IT is linearly-independent;
end;

theorem 
  A c= B & B is linearly-independent implies A is linearly-independent;

theorem 
  0.R <> 1_R & A is linearly-independent implies not 0.V in A;

theorem 
  {}(the carrier of V) is linearly-independent;

theorem 
  0.R <> 1_R & {v1,v2} is linearly-independent implies v1 <> 0.V & v2 <> 0.V;

theorem 
  0.R <> 1_R implies {v,0.V} is linearly-dependent & {0.V,v} is
  linearly-dependent;

reserve R for domRing;
reserve V for RightMod of R;
reserve v,u for Vector of V;
reserve A,B for Subset of V;
reserve l for Linear_Combination of A;
reserve f,g for Function of the carrier of V, the carrier of R;

definition
  let R, V, A;
  func Lin(A) -> strict Submodule of V means


  the carrier of it = {Sum( l) : not contradiction};
end;

theorem 
  x in Lin(A) iff ex l st x = Sum(l);

theorem 
  x in A implies x in Lin(A);

theorem 
  Lin({}(the carrier of V)) = (0).V;

theorem 
  Lin(A) = (0).V implies A = {} or A = {0.V};

theorem 
  for W being strict Submodule of V st 0.R <> 1_R & A = the
  carrier of W holds Lin(A) = W;

theorem 
  for V being strict RightMod of R, A being Subset of V st 0.R <> 1_R &
  A = the carrier of V holds Lin(A) = V;

theorem 
  A c= B implies Lin(A) is Submodule of Lin(B);

theorem 
  for V being strict RightMod of R, A,B being Subset of V st Lin(A) = V
  & A c= B holds Lin(B) = V;

theorem 
  Lin(A \/ B) = Lin(A) + Lin(B);

theorem 
  Lin(A /\ B) is Submodule of Lin(A) /\ Lin(B);














begin

reserve V for RealLinearSpace;
reserve u,u1,u2,v,v1,v2,w,w1,y for VECTOR of V;
reserve a,a1,a2,b,b1,b2,c1,c2 for Real;
reserve x,z for set;

definition
  let V;
  let u,v,u1,v1;
  pred u,v '||' u1,v1 means


  u,v // u1,v1 or u,v // v1,u1;
end;

theorem 
  Gen w,y implies OASpace(V) is OAffinSpace;

theorem 
  for p,q,p1,q1 being Element of OASpace(V) st p=u & q=v & p1=u1 &
  q1=v1 holds (p,q // p1,q1 iff u,v // u1,v1);

theorem 
  Gen w,y implies for p,q,p1,q1 being Element of (the carrier of
  Lambda(OASpace(V))) st p=u & q=v & p1=u1 & q1=v1 holds (p,q // p1,q1 iff u,v
  '||' u1,v1);

theorem 
  for p,q,p1,q1 being Element of (the carrier of AMSpace(V,w,y)) st
  p=u & q=v & p1=u1 & q1=v1 holds (p,q // p1,q1 iff u,v '||' u1,v1);

definition
  let V;
  let u,v;
  func u#v -> VECTOR of V means


  it+it = u+v;
  commutativity;
  idempotence;
end;

theorem 
  ex y st u#y=w;

theorem 
  (u#u1)#(v#v1)=(u#v)#(u1#v1);

theorem 
  u#y=u#w implies y=w;

theorem 
  u,v // y#u,y#v;

theorem 
  u,v '||' w#u,w#v;

theorem 
  2*(u#v-u) = v-u & 2*(v-u#v) = v-u;

theorem 
  u,u#v // u#v,v;

theorem 
  u,v // u,u#v & u,v // u#v,v;

theorem 
  u,y // y,v implies u#y,y // y,y#v;

theorem 
  u,v // u1,v1 implies u,v // (u#u1),(v#v1);

definition
  let V;
  let w,y,u,u1,v,v1;
  pred u,u1,v,v1 are_DTr_wrt w,y means


  u,u1 // v,v1 & u,u1,u#u1,v#v1
  are_Ort_wrt w,y & v,v1,u#u1,v#v1 are_Ort_wrt w,y;
end;

theorem 
  Gen w,y implies u,u,v,v are_DTr_wrt w,y;

theorem 
  Gen w,y implies u,v,u,v are_DTr_wrt w,y;

theorem 
  u,v,v,u are_DTr_wrt w,y implies u=v;

theorem 
  Gen w,y & v1,u,u,v2 are_DTr_wrt w,y implies v1=u & u=v2;

theorem 
  Gen w,y & u,v,u1,v1 are_DTr_wrt w,y & u,v,u2,v2 are_DTr_wrt w,y
  & u<>v implies u1,v1,u2,v2 are_DTr_wrt w,y;

theorem 
  Gen w,y implies ex t being VECTOR of V st (u,v,u1,t are_DTr_wrt
  w,y or u,v,t,u1 are_DTr_wrt w,y);

theorem 
  u,v,u1,v1 are_DTr_wrt w,y implies u1,v1,u,v are_DTr_wrt w,y;

theorem 
  u,v,u1,v1 are_DTr_wrt w,y implies v,u,v1,u1 are_DTr_wrt w,y;

theorem 
  Gen w,y & v,u1,v,u2 are_DTr_wrt w,y implies u1=u2;

theorem 
  Gen w,y & u,v,u1,v1 are_DTr_wrt w,y & u,v,u1,v2 are_DTr_wrt w,y
  implies (u=v or v1=v2);

theorem 
  Gen w,y & u<>u1 & u,u1,v,v1 are_DTr_wrt w,y & (u,u1,v,v2
  are_DTr_wrt w,y or u,u1,v2,v are_DTr_wrt w,y) implies v1=v2;

theorem 
  Gen w,y & u,v,u1,v1 are_DTr_wrt w,y implies u,v,(u#u1),(v#v1) are_DTr_wrt w,y
;

theorem 
  Gen w,y & u,v,u1,v1 are_DTr_wrt w,y implies (u,v,(u#v1),(v#u1)
  are_DTr_wrt w,y or u,v,(v#u1),(u#v1) are_DTr_wrt w,y);

theorem 
  for u,u1,u2,v1,v2,t1,t2,w1,w2 being VECTOR of V holds ( u=u1#t1
& u=u2#t2 & u=v1#w1 & u=v2#w2 & u1,u2,v1,v2 are_DTr_wrt w,y implies t1,t2,w1,w2
  are_DTr_wrt w,y);

definition
  let V,w,y,u such that
 Gen w,y;
  func pr1(w,y,u) -> Real means


  ex b st u=it*w+b*y;
end;

definition
  let V,w,y,u such that
 Gen w,y;
  func pr2(w,y,u) -> Real means


  ex a st u=a*w+it*y;
end;

definition
  let V,w,y,u,v;
  func PProJ(w,y,u,v) -> Real equals

  pr1(w,y,u)*pr1(w,y,v) + pr2(w,y,u)*pr2(w,
  y,v);
end;

theorem 
  for u,v holds PProJ(w,y,u,v) = PProJ(w,y,v,u);

theorem 
  Gen w,y implies for u,v,v1 holds PProJ(w,y,u,v+v1)=PProJ(w,y,u,v
)+PProJ(w,y,u,v1) & PProJ(w,y,u,v-v1)=PProJ(w,y,u,v)-PProJ(w,y,u,v1) & PProJ(w,
  y,v-v1,u)=PProJ(w,y,v,u)-PProJ(w,y,v1,u) & PProJ(w,y,v+v1,u)=PProJ(w,y,v,u)+
  PProJ(w,y,v1,u);

theorem 
  Gen w,y implies for u,v being VECTOR of V, a being Real holds
PProJ(w,y,a*u,v)=a*PProJ(w,y,u,v) & PProJ(w,y,u,a*v)=a*PProJ(w,y,u,v) & PProJ(w
  ,y,a*u,v)=PProJ(w,y,u,v)*a & PProJ(w,y,u,a*v)=PProJ(w,y,u,v)*a;

theorem 
  Gen w,y implies for u,v being VECTOR of V holds (u,v are_Ort_wrt
  w,y iff PProJ(w,y,u,v)=0);

theorem 
  Gen w,y implies for u,v,u1,v1 being VECTOR of V holds (u,v,u1,v1
  are_Ort_wrt w,y iff PProJ (w,y,v-u,v1-u1)=0);

theorem 
  Gen w,y implies for u,v,v1 being VECTOR of V holds 2*PProJ(w,y,u
  ,v#v1) = PProJ(w,y,u,v)+PProJ(w,y,u,v1);

theorem 
  Gen w,y implies for u,v being VECTOR of V st u<>v holds PProJ(w,
  y,u-v,u-v) <> 0;

theorem 
  Gen w,y implies for p,q,u,v,v9 being VECTOR of V, A being Real
st p,q,u,v are_DTr_wrt w,y & p<>q & A = (PProJ(w,y,p-q,p+q) - 2*PProJ(w,y,p-q,u
  ))*(PProJ(w,y,p-q,p-q))" & v9=u+A*(p-q) holds v=v9;

theorem 
  Gen w,y implies for u,u9,u1,u2,v1,v2,t1,t2,w1,w2 being VECTOR of
V st u<>u9 & u,u9,u1,t1 are_DTr_wrt w,y & u,u9,u2,t2 are_DTr_wrt w,y & u,u9,v1,
w1 are_DTr_wrt w,y & u,u9,v2,w2 are_DTr_wrt w,y & u1,u2 // v1,v2 holds t1,t2 //
  w1,w2;

theorem 
  Gen w,y implies for u,u9,u1,u2,v1,t1,t2,w1 being VECTOR of V st u<>u9
  & u,u9,u1,t1 are_DTr_wrt w,y & u,u9,u2,t2 are_DTr_wrt w,y & u,u9,v1,w1
  are_DTr_wrt w,y & v1=u1#u2 holds w1 = t1#t2;

theorem 
  Gen w,y implies for u,u9,u1,u2,t1,t2 being VECTOR of V st u<>u9
& u,u9,u1,t1 are_DTr_wrt w,y & u,u9,u2,t2 are_DTr_wrt w,y holds u,u9,u1#u2,t1#
  t2 are_DTr_wrt w,y;

theorem 
  Gen w,y implies for u,u9,u1,u2,v1,v2,t1,t2,w1,w2 being VECTOR of
V st u<>u9 & u,u9,u1,t1 are_DTr_wrt w,y & u,u9,u2,t2 are_DTr_wrt w,y & u,u9,v1,
  w1 are_DTr_wrt w,y & u,u9,v2,w2 are_DTr_wrt w,y & u1,u2,v1,v2 are_Ort_wrt w,y
  holds t1,t2,w1,w2 are_Ort_wrt w,y;

theorem 
  for u,u9,u1,u2,v1,v2,t1,t2,w1,w2 being VECTOR of V holds (Gen w,
y & u<>u9 & u,u9,u1,t1 are_DTr_wrt w,y & u,u9,u2,t2 are_DTr_wrt w,y & u,u9,v1,
  w1 are_DTr_wrt w,y & u,u9,v2,w2 are_DTr_wrt w,y & u1,u2,v1,v2 are_DTr_wrt w,y
  implies t1,t2,w1,w2 are_DTr_wrt w,y);

definition
  let V;
  let w,y;
  func DTrapezium(V,w,y) -> Relation of [:the carrier of V,the carrier of V:]
  means


  [x,z] in it iff ex u,u1,v,v1 st x=[u,u1] & z=[v,v1] & u,u1,v,v1
  are_DTr_wrt w,y;
end;

theorem 
  [[u,v],[u1,v1]] in DTrapezium(V,w,y) iff u,v,u1,v1 are_DTr_wrt w ,y;

definition
  let V;
  func MidPoint(V) -> BinOp of the carrier of V means


  for u,v holds it. (u,v) = u#v;
end;

definition
  struct(AffinStruct,MidStr) AfMidStruct (# carrier -> set, MIDPOINT -> BinOp
    of the carrier, CONGR -> Relation of [:the carrier,the carrier:] #);
end;

registration
  cluster non empty strict for AfMidStruct;
end;

definition
  let V,w,y;
  func DTrSpace(V,w,y) -> strict AfMidStruct equals

  AfMidStruct(#the carrier
    of V, MidPoint(V),DTrapezium(V,w,y)#);
end;

registration
  let V,w,y;
  cluster DTrSpace(V,w,y) -> non empty;
end;

definition
  let AMS be AfMidStruct;
  func Af(AMS) -> strict AffinStruct equals

  AffinStruct(#the carrier of AMS,
    the CONGR of AMS#);
end;

registration
  let AMS be non empty AfMidStruct;
  cluster Af(AMS) -> non empty;
end;

definition
  let AMS be non empty AfMidStruct, a,b be Element of AMS;

  func a#b -> Element of AMS equals

  (the MIDPOINT of AMS).(a,b);
end;

reserve a,b,c,d,a1,a2,b1,c1,d1,d2,p,q for Element of DTrSpace(V,w,y);

theorem 
  for x being set holds x is Element of the carrier of DTrSpace(V,w,y)
  iff x is VECTOR of V;

theorem 
  u=a & v=b & u1=a1 & v1=b1 implies (a,b // a1,b1 iff u,v,u1,v1
  are_DTr_wrt w,y);

theorem 
  Gen w,y & u=a & v=b implies u#v = a#b;

definition
  let IT be non empty AfMidStruct;
  attr IT is MidOrdTrapSpace-like means


  for a,b,c,d,a1,b1,c1,d1,p,q
  being Element of IT holds a#b=b#a & a#a=a & (a#b)#(c#d)=(a#c)#(b#d) & (ex p
being Element of IT st p#a=b) & (a#b=a#c implies b=c) & (a,b // c,d implies a,b
// (a#c),(b#d)) & (a,b // c,d implies (a,b // (a#d),(b#c) or a,b // (b#c),(a#d)
)) & (a,b // c,d & a#a1=p & b#b1=p & c#c1=p & d#d1=p implies a1,b1 // c1,d1) &
  (p<>q & p,q // a,a1 & p,q // b,b1 & p,q // c,c1 & p,q // d,d1 & a,b // c,d
implies a1,b1 // c1,d1) & (a,b // b,c implies a=b & b=c) & (a,b // a1,b1 & a,b
// c1,d1 & a<>b implies a1,b1 // c1,d1) & (a,b // c,d implies c,d // a,b & b,a
// d,c) & (ex d being Element of IT st a,b // c,d or a,b // d,c) & (a,b // c,p
  & a,b // c,q implies a=b or p=q);
end;

registration
  cluster strict MidOrdTrapSpace-like for non empty AfMidStruct;
end;

definition
  mode MidOrdTrapSpace is MidOrdTrapSpace-like non empty AfMidStruct;
end;

theorem 
  Gen w,y implies DTrSpace(V,w,y) is MidOrdTrapSpace;

definition
  let IT be non empty AffinStruct;
  attr IT is OrdTrapSpace-like means


  for a,b,c,d,a1,b1,c1,d1,p,q being
Element of IT holds (a,b // b,c implies a=b & b=c) & (a,b // a1,b1 & a,b // c1,
d1 & a<>b implies a1,b1 // c1,d1) & (a,b // c,d implies c,d // a,b & b,a // d,c
) & (ex d being Element of IT st a,b // c,d or a,b // d,c) & (a,b // c,p & a,b
  // c,q implies a=b or p=q);
end;

registration
  cluster strict OrdTrapSpace-like for non empty AffinStruct;
end;

definition
  mode OrdTrapSpace is OrdTrapSpace-like non empty AffinStruct;
end;

registration
  let MOS be MidOrdTrapSpace;
  cluster Af(MOS) -> OrdTrapSpace-like;
end;

reserve OTS for OrdTrapSpace;
reserve a,b,c,d for Element of OTS;
reserve a9,b9,c9,d9,a19,b19,d19 for Element of Lambda(OTS);

theorem 
  for x being set holds (x is Element of OTS iff x is Element of Lambda(OTS));

theorem 
  a=a9 & b=b9 & c =c9 & d=d9 implies (a9,b9 // c9,d9 iff a,b // c,
  d or a,b // d,c);

definition
  let IT be non empty AffinStruct;
  attr IT is TrapSpace-like means

  for a9,b9,c9,d9,p9,q9 being Element of IT
holds a9,b9 // b9,a9 & (a9,b9 // c9,d9 & a9,b9 // c9,q9 implies a9=b9 or d9=q9)
& (p9<>q9 & p9,q9 // a9,b9 & p9,q9 // c9,d9 implies a9,b9 // c9,d9) & (a9,b9 //
  c9,d9 implies c9,d9 // a9,b9) & ex x9 being Element of IT st a9,b9 // c9,x9;
end;

registration
  cluster strict TrapSpace-like for non empty AffinStruct;
end;

definition
  mode TrapSpace is TrapSpace-like non empty AffinStruct;
end;

registration
  let OTS be OrdTrapSpace;
  cluster Lambda(OTS) -> TrapSpace-like;
end;

definition
  let IT be non empty AffinStruct;
  attr IT is Regular means


  for p,q,a,a1,b,b1,c,c1,d,d1 being Element
of IT st p<>q & p,q // a,a1 & p,q // b,b1 & p,q // c,c1 & p,q // d,d1 & a,b //
  c,d holds a1,b1 // c1,d1;
end;

registration
  cluster strict Regular for non empty OrdTrapSpace;
end;

registration
  let MOS be MidOrdTrapSpace;
  cluster Af(MOS) -> Regular;
end;














begin

reserve IPS for IncProjSp,
  z for POINT of IPS;

definition
  let IPS;
  let A,B,C be LINE of IPS;
  pred A,B,C are_concurrent means


  ex o being Element of the Points of IPS st o on A & o on B & o on C;
end;

definition
  let IPS;
  let Z be LINE of IPS;
  func CHAIN(Z) -> Subset of the Points of IPS equals

  {z: z on Z};
end;

reserve IPP for Desarguesian 2-dimensional IncProjSp,
  a,b,c,d,p,pp9,q,o,o9,o99 ,oo9 for POINT of IPP,
  r,s,x,y,o1,o2 for POINT of IPP,
  O1,O2,O3,O4,A,B,C,O,Q,Q1 ,Q2,Q3,R,S,X for LINE of IPP;

definition
  let IPP;
  mode Projection of IPP -> PartFunc of the Points of IPP,the Points of IPP
    means


    ex a,A,B st not a on A & not a on B & it = IncProj(A,a,B);
end;

theorem 
  A=B or B=C or C=A implies A,B,C are_concurrent;

theorem 
  A,B,C are_concurrent implies A,C,B are_concurrent & B,A,C
  are_concurrent & B,C,A are_concurrent & C,A,B are_concurrent & C,B,A
  are_concurrent;

theorem 
  not o on A & not o on B & y on B implies ex x st x on A & IncProj
  (A,o,B).x = y;

theorem 
  not o on A & not o on B implies dom IncProj(A,o,B) = CHAIN(A);

theorem 
  not o on A & not o on B implies rng IncProj(A,o,B) = CHAIN(B);

theorem 
  for x being set holds x in CHAIN(A) iff ex a st x=a & a on A;

theorem 
  not o on A & not o on B implies IncProj(A,o,B) is one-to-one;

theorem 
  not o on A & not o on B implies IncProj(A,o,B)" = IncProj(B,o,A);

theorem 
  for f being Projection of IPP holds f" is Projection of IPP;

theorem 
  not o on A implies IncProj(A,o,A) = id CHAIN(A);

theorem 
  id CHAIN(A) is Projection of IPP;

theorem 
  not o on A & not o on B & not o on C implies IncProj(C,o,B)*IncProj(A,
  o,C) = IncProj(A,o,B);

theorem 
  not o1 on O1 & not o1 on O2 & not o2 on O2 & not o2 on O3 & O1,O2,O3
are_concurrent & O1<>O3 implies ex o st not o on O1 & not o on O3 & IncProj(O2,
  o2,O3)*IncProj(O1,o1,O2) = IncProj(O1,o,O3);

theorem 
  not a on A & not b on B & not a on C & not b on C & not A,B,C
are_concurrent & c on A & c on C & c on Q & not b on Q & A<>Q & a on O & b on O
  & not B,C,O are_concurrent & d on C & d on B & a on O1 & d on O1 & p on A & p
on O1 & q on O & q on O2 & p on O2 & pp9 on O2 & d on O3 & b on O3 & pp9 on O3
& pp9 on Q & q<>a & not q on A & not q on Q implies IncProj(C,b,B)*IncProj(A,a,
  C) = IncProj(Q,b,B)*IncProj(A,q,Q);

theorem 
  not a on A & not a on C & not b on B & not b on C & not b on Q &
not A,B,C are_concurrent & a<>b & b<>q & A<>Q & {c,o} on A & {o,o99,d} on B & {
c,d,o9} on C & {a,b,d} on O & {c,oo9} on Q & {a,o,o9} on O1 & {b,o9,oo9} on O2
& {o,oo9,q} on O3 & q on O implies IncProj(C,b,B)*IncProj(A,a,C) = IncProj(Q,b,
  B)*IncProj(A,q,Q);

theorem 
  not a on A & not a on C & not b on C & not b on Q & not A,B,C
are_concurrent & not B,C,O are_concurrent & A<>Q & Q<>C & a<>b & {c,p} on A & d
on B & {c,d} on C & {a,b,q} on O & {c,pp9} on Q & {a,d,p} on O1 & {q,p,pp9} on
  O2 & {b,d,pp9} on O3 implies q<>a & q<>b & not q on A & not q on Q;

theorem 
  not a on A & not a on C & not b on B & not b on C & not b on Q &
not A,B,C are_concurrent & a<>b & A<>Q & {c,o} on A & {o,o99,d} on B & {c,d,o9}
on C & {a,b,d} on O & {c,oo9} on Q & {a,o,o9} on O1 & {b,o9,oo9} on O2 & {o,oo9
  ,q} on O3 & q on O implies not q on A & not q on Q & b<>q;

theorem 
  not a on A & not a on C & not b on C & not q on A & not A,B,C
are_concurrent & not B,C,O are_concurrent & a<>b & b<>q & q<>a & {c,p} on A & d
on B & {c,d} on C & {a,b,q} on O & {c,pp9} on Q & {a,d,p} on O1 & {q,p,pp9} on
  O2 & {b,d,pp9} on O3 implies Q<>A & Q<>C & not q on Q & not b on Q;

theorem 
  not a on A & not a on C & not b on B & not b on C & not q on A &
not A,B,C are_concurrent & a<>b & b<>q & {c,o} on A & {o,o99,d} on B & {c,d,o9}
on C & {a,b,d} on O & {c,oo9} on Q & {a,o,o9} on O1 & {b,o9,oo9} on O2 & {o,oo9
  ,q} on O3 & q on O implies not b on Q & not q on Q & A<>Q;

theorem 
  not a on A & not b on B & not a on C & not b on C & not A,B,C
  are_concurrent & A,C,Q are_concurrent & not b on Q & A<>Q & a<>b & a on O & b
on O implies ex q st q on O & not q on A & not q on Q & IncProj(C,b,B)*IncProj(
  A,a,C) = IncProj(Q,b,B)*IncProj(A,q,Q);

theorem 
  not a on A & not b on B & not a on C & not b on C & not A,B,C
  are_concurrent & B,C,Q are_concurrent & not a on Q & B<>Q & a<>b & a on O & b
on O implies ex q st q on O & not q on B & not q on Q & IncProj(C,b,B)*IncProj(
  A,a,C) = IncProj(Q,q,B)*IncProj(A,a,Q);

theorem 
  not a on A & not b on B & not a on C & not b on C & not a on B & not b
on A & c on A & c on C & d on B & d on C & a on S & d on S & c on R & b on R &
s on A & s on S & r on B & r on R & s on Q & r on Q & not A,B,C are_concurrent
  implies IncProj(C,b,B)*IncProj(A,a,C) = IncProj(Q,a,B)*IncProj(A,b,Q);

theorem 
  not a on A & not b on B & not a on C & not b on C & a<>b & a on
O & b on O & q on O & not q on A & q<>b & not A,B,C are_concurrent implies ex Q
st A,C,Q are_concurrent & not b on Q & not q on Q & IncProj(C,b,B)*IncProj(A,a,
  C) = IncProj(Q,b,B)* IncProj(A,q,Q);

theorem 
  not a on A & not b on B & not a on C & not b on C & a<>b & a on O & b
on O & q on O & not q on B & q<>a & not A,B,C are_concurrent implies ex Q st B,
C,Q are_concurrent & not a on Q & not q on Q & IncProj(C,b,B)*IncProj(A,a,C) =
  IncProj(Q,q,B)* IncProj(A,a,Q);














begin

reserve X for OrtAfPl;
reserve o,a,a1,a2,b,b1,b2,c,c1,c2,d,e1,e2 for Element of X;
reserve b29,c29,d19 for Element of Af(X);

definition
  let X;
  attr X is satisfying_DES means

  for o,a,a1,b,b1,c,c1 st o<>a & o<>a1 & o<>b & o<>b1 & o<>c & o<>c1 &
  not LIN b,b1,a & not LIN a,a1,c & LIN o,a,a1 & LIN o,b,b1 &
  LIN o,c,c1 & a,b // a1,b1 & a,c // a1,c1 holds b,c // b1,c1;
  attr X is satisfying_AH means

  for o,a,a1,b,b1,c,c1 st o,a _|_ o,a1 & o,b _|_ o,b1
  & o,c _|_ o,c1 & a,b _|_ a1,b1 & o,a // b,c &
  a,c _|_ a1,c1 & not o,c // o,a & not o,a // o,b holds b,c _|_ b1,c1;
  attr X is satisfying_3H means

  for a,b,c st not LIN a,b,c holds ex d st d,a _|_ b,c & d,b _|_ a,c &
  d,c _|_ a,b;
  attr X is satisfying_ODES means


  for o,a,a1,b,b1,c,c1 st o,a _|_ o,a1 & o,b _|_ o,b1 & o,c _|_ o,c1 &
  a,b _|_ a1,b1 & a,c _|_ a1,c1 & not o,c // o,a & not o,a // o,b
  holds b,c _|_ b1,c1;
  attr X is satisfying_LIN means


  for o,a,a1,b,b1,c,c1 st o<>a & o<>a1 & o<>b & o<>b1 & o<>c &
  o<>c1 & a<>b & o,c _|_ o,c1 & o,a _|_ o,a1 & o,b _|_ o,b1 &
  not LIN o,c,a & LIN o,a,b & LIN o,a1,b1 & a,c _|_ a1,c1 & b,c _|_ b1,c1
  holds a,a1 // b,b1;
  attr X is satisfying_LIN1 means


  for o,a,a1,b,b1,c,c1 st o<>a & o<>a1 & o<>b & o<>b1 & o<>c &
  o<>c1 & a<>b & o,c _|_ o,c1 & o,a _|_ o,a1 & o,b _|_ o,b1 &
  not LIN o,c,a & LIN o,a,b & LIN o,a1,b1 & a,c _|_ a1,c1 & a,a1 // b,b1
  holds b,c _|_ b1,c1;
  attr X is satisfying_LIN2 means

  for o,a,a1,b,b1,c,c1 st o<>a & o<>a1 & o<>b & o<>b1 & o<>c &
  o<>c1 & a<>b & a,a1 // b,b1 & o,a _|_ o,a1 & o,b _|_ o,b1 &
  not LIN o,c,a & LIN o,a,b & LIN o,a1,b1 & a,c _|_ a1,c1 & b,c _|_ b1,c1
  holds o,c _|_ o,c1;
end;

theorem 
  X is satisfying_ODES implies X is satisfying_DES;

theorem 
  X is satisfying_ODES implies X is satisfying_AH;

theorem 
  X is satisfying_LIN implies X is satisfying_LIN1;

theorem 
  X is satisfying_LIN1 implies X is satisfying_LIN2;

theorem 
  X is satisfying_LIN implies X is satisfying_ODES;

theorem 
  X is satisfying_LIN implies X is satisfying_3H;














begin

reserve X for OrtAfPl;
reserve o,a,a1,a2,a3,a4,b,b1,b2,b3,b4,c,c1,c2,c3,d,d1,d2,d3,d4,e1,e2 for
  Element of X;
reserve a29,a39,b29,x9 for Element of Af(X);
reserve A,K,M,N for Subset of X;
reserve A9,K9 for Subset of Af(X);

definition
  let X;
  attr X is satisfying_OPAP means


  for o,a1,a2,a3,b1,b2,b3,M,N st o in M
  & a1 in M & a2 in M & a3 in M & o in N & b1 in N & b2 in N & b3 in N & not b2
in M & not a3 in N & M _|_ N & o<>a1 & o<>a2 & o<>a3 & o<>b1 & o<>b2 & o<>b3 &
  a3,b2 // a2,b1 & a3,b3 // a1,b1 holds a1,b2 // a2,b3;
  attr X is satisfying_PAP means

  for o,a1,a2,a3,b1,b2,b3,M,N st M is
being_line & N is being_line & o in M & a1 in M & a2 in M & a3 in M & o in N &
b1 in N & b2 in N & b3 in N & not b2 in M & not a3 in N & o<>a1 & o<>a2 & o<>a3
& o<>b1 & o<>b2 & o<>b3 & a3,b2 // a2,b1 & a3,b3 // a1,b1 holds a1,b2 // a2,b3;
  attr X is satisfying_MH1 means


  for a1,a2,a3,a4,b1,b2,b3,b4,M,N st M
  _|_ N & a1 in M & a3 in M & b1 in M & b3 in M & a2 in N & a4 in N & b2 in N &
b4 in N & not a2 in M & not a4 in M & a1,a2 _|_ b1,b2 & a2,a3 _|_ b2,b3 & a3,a4
  _|_ b3,b4 holds a1,a4 _|_ b1,b4;
  attr X is satisfying_MH2 means


  for a1,a2,a3,a4,b1,b2,b3,b4,M,N st M
  _|_ N & a1 in M & a3 in M & b2 in M & b4 in M & a2 in N & a4 in N & b1 in N &
b3 in N & not a2 in M & not a4 in M & a1,a2 _|_ b1,b2 & a2,a3 _|_ b2,b3 & a3,a4
  _|_ b3,b4 holds a1,a4 _|_ b1,b4;
  attr X is satisfying_TDES means


  for o,a,a1,b,b1,c,c1 st o<>a & o<>a1
& o<>b & o<>b1 & o<>c & o<>c1 & not LIN b,b1,a & not LIN b,b1,c & LIN o,a,a1 &
LIN o,b,b1 & LIN o,c,c1 & a,b // a1,b1 & a,b // o,c & b,c // b1,c1 holds a,c //
  a1,c1;
  attr X is satisfying_SCH means

  for a1,a2,a3,a4,b1,b2,b3,b4,M,N st M is
being_line & N is being_line & a1 in M & a3 in M & b1 in M & b3 in M & a2 in N
  & a4 in N & b2 in N & b4 in N & not a4 in M & not a2 in M & not b2 in M & not
b4 in M & not a1 in N & not a3 in N & not b1 in N & not b3 in N & a3,a2 // b3,
  b2 & a2,a1 // b2,b1 & a1,a4 // b1,b4 holds a3,a4 // b3,b4;
  attr X is satisfying_OSCH means


  for a1,a2,a3,a4,b1,b2,b3,b4,M,N st M
  _|_ N & a1 in M & a3 in M & b1 in M & b3 in M & a2 in N & a4 in N & b2 in N &
b4 in N & not a4 in M & not a2 in M & not b2 in M & not b4 in M & not a1 in N &
not a3 in N & not b1 in N & not b3 in N & a3,a2 // b3,b2 & a2,a1 // b2,b1 & a1,
  a4 // b1,b4 holds a3,a4 // b3,b4;
  attr X is satisfying_des means


  for a,a1,b,b1,c,c1 st not LIN a,a1,b &
  not LIN a,a1,c & a,a1 // b,b1 & a,a1 // c,c1 & a,b // a1,b1 & a,c // a1,c1
  holds b,c // b1,c1;
end;

theorem 
  ex a,b,c st LIN a,b,c & a<>b & b<>c & c <>a;

theorem 
  for a,b ex c st LIN a,b,c & a<>c & b<>c;

theorem 
  for A,a st A is being_line ex K st a in K & A _|_ K;

theorem 
  A is being_line & a in A & b in A & c in A implies LIN a,b,c;

theorem 
  A is being_line & M is being_line & a in A & b in A & a in M & b
  in M implies a=b or A=M;

theorem 
  for a,b,c,d,M holds for M9 being Subset of Af(X), c9,d9 being
Element of Af(X) st c =c9 & d=d9 & M=M9 & a in M & b in M & c9,d9 // M9 holds c
  ,d // a,b;

theorem 
  X is satisfying_TDES implies Af(X) is Moufangian;

theorem 
  Af(X) is translational implies X is satisfying_des;

theorem 
  X is satisfying_MH1 implies X is satisfying_OSCH;

theorem 
  X is satisfying_MH2 implies X is satisfying_OSCH;

theorem 
  X is satisfying_AH implies X is satisfying_TDES;

theorem 
  X is satisfying_OSCH & X is satisfying_TDES implies X is satisfying_SCH;

theorem 
  X is satisfying_OPAP & X is satisfying_DES implies X is satisfying_PAP;

theorem 
  X is satisfying_MH1 & X is satisfying_MH2 implies X is satisfying_OPAP;

theorem 
  X is satisfying_3H implies X is satisfying_OPAP;














begin

registration
  let OAS be OAffinSpace;
  cluster Lambda(OAS) -> AffinSpace-like non trivial;
end;

registration
  let OAS be OAffinPlane;
  cluster Lambda(OAS) -> 2-dimensional;
end;

theorem 
  for OAS being OAffinSpace, x being set holds (x is Element of OAS
  iff x is Element of Lambda(OAS)) & (x is Subset of OAS iff x is Subset of
  Lambda(OAS));

theorem 
  for OAS being OAffinSpace holds for a,b,c being (Element of OAS),
a9,b9,c9 being (Element of Lambda(OAS)) st a=a9 & b=b9 & c =c9 holds LIN a,b,c
  iff LIN a9,b9,c9;

theorem 
  for V being RealLinearSpace, x being set holds (x is Element of
  OASpace(V) iff x is VECTOR of V);

theorem 
  for V being RealLinearSpace, OAS being OAffinSpace st OAS=OASpace
(V) holds for a,b,c,d being Element of OAS,u,v,w,y being VECTOR of V st a=u & b
  =v & c =w & d=y holds (a,b '||' c,d iff u,v '||' w,y);

theorem 
  for V being RealLinearSpace, OAS being OAffinSpace st OAS=OASpace(V)
holds ex u,v being VECTOR of V st for a,b being Real st a*u + b*v = 0.V holds a
  =0 & b=0;

definition
  let AS be AffinSpace;

  redefine attr AS is Fanoian means


  for a,b,c,d being Element of AS st a,b // c,
  d & a,c // b,d & a,d // b,c holds a,b // a,c;
end;

definition
  let IT be OAffinSpace;

  attr IT is Pappian means


  Lambda(IT) is Pappian;
  attr IT is Desarguesian means


  Lambda(IT) is Desarguesian;
  attr IT is Moufangian means


  Lambda(IT) is Moufangian;
  attr IT is translation means


  Lambda(IT) is translational;
end;

definition
  let OAS be OAffinSpace;
  attr OAS is satisfying_DES means


  for o,a,b,c,a1,b1,c1 being Element
of OAS st o,a // o,a1 & o,b // o,b1 & o,c // o,c1 & not LIN o,a,b & not LIN o,a
  ,c & a,b // a1,b1 & a,c // a1,c1 holds b,c // b1,c1;
end;

definition
  let OAS be OAffinSpace;
  attr OAS is satisfying_DES_1 means


  for o,a,b,c,a1,b1,c1 being
Element of OAS st a,o // o,a1 & b,o // o,b1 & c,o // o,c1 & not LIN o,a,b & not
  LIN o,a,c & a,b // b1,a1 & a,c // c1,a1 holds b,c // c1,b1;
end;

theorem 
  for OAS being OAffinSpace st OAS is satisfying_DES_1 holds OAS
  is satisfying_DES;

theorem 
  for OAS being OAffinSpace holds for o,a,b,a9,b9 being Element
 of OAS st not LIN o,a,b & a,o // o,a9 & LIN o,b,b9 & a,b '||' a9,b9
  holds b,o // o,b9 & a,b // b9,a9;

theorem 
  for OAS being OAffinSpace holds for o,a,b,a9,b9 being Element
 of OAS st not LIN o,a,b & o,a // o,a9 & LIN o,b,b9 & a,b '||' a9,b9
  holds o,b // o,b9 & a,b // a9,b9;

theorem 
  for OAP being OAffinSpace st OAP is satisfying_DES_1 holds
  Lambda(OAP) is Desarguesian;

theorem 
  for V being RealLinearSpace holds for o,u,v,u1,v1 being VECTOR
of V, r being Real st o-u=r*(u1-o) & r<>0 & o,v '||' o,v1 & not o,u '||' o,v &
u,v '||' u1,v1 holds v1 = u1 + (-r)"*(v-u) & v1 = o + (-r)"*(v-o) & v-u = (-r)*
  (v1-u1);

theorem 
  for V being RealLinearSpace, OAS being OAffinSpace st OAS =
  OASpace(V) holds OAS is satisfying_DES_1;

theorem 
  for V being RealLinearSpace, OAS being OAffinSpace st OAS = OASpace(V)
  holds OAS is satisfying_DES_1 & OAS is satisfying_DES;

theorem 
  for V being RealLinearSpace, OAS being OAffinSpace st OAS =
  OASpace(V) holds Lambda(OAS) is Pappian;

theorem 
  for V being RealLinearSpace, OAS being OAffinSpace st OAS =
  OASpace(V) holds Lambda(OAS) is Desarguesian;

theorem 
  for AS being AffinSpace st AS is Desarguesian holds AS is Moufangian;

theorem 
  for V being RealLinearSpace, OAS being OAffinSpace st OAS =
  OASpace(V) holds Lambda(OAS) is Moufangian;

theorem 
  for V being RealLinearSpace, OAS being OAffinSpace st OAS =
  OASpace(V) holds Lambda(OAS) is translational;

theorem 
  for OAS being OAffinSpace holds Lambda(OAS) is Fanoian;

registration
  cluster Pappian Desarguesian Moufangian translation for OAffinSpace;
end;

registration
  cluster strict Fanoian Pappian Desarguesian Moufangian translational
    for AffinPlane;
end;

registration
  cluster strict Fanoian Pappian Desarguesian Moufangian translational
    for AffinSpace;
end;

registration
  let OAS be OAffinSpace;
  cluster Lambda(OAS) -> Fanoian;
end;

registration
  let OAS be Pappian OAffinSpace;
  cluster Lambda(OAS) -> Pappian;
end;

registration
  let OAS be Desarguesian OAffinSpace;
  cluster Lambda(OAS) -> Desarguesian;
end;

registration
  let OAS be Moufangian OAffinSpace;
  cluster Lambda(OAS) -> Moufangian;
end;

registration
  let OAS be translation OAffinSpace;
  cluster Lambda(OAS) -> translational;
end;














begin

reserve SAS for AffinPlane;

theorem 
  SAS is Pappian implies for a1,a2,a3,b1,b2,b3 being Element of SAS
  holds ( a1,a2 // a1,a3 & b1,b2 // b1,b3 & a1,b2 // a2,b1 & a2,b3 // a3,b2
  implies a3,b1 // a1,b3 );

theorem 
  SAS is Desarguesian implies for o,a,a9,b,b9,c,c9 being Element of
  SAS holds ( not o,a // o,b & not o,a // o,c & o,a // o,a9 & o,b // o,b9 & o,c
  // o,c9 & a,b // a9,b9 & a,c // a9,c9 implies b,c // b9,c9 );

theorem 
  SAS is translational implies for a,a9,b,b9,c,c9 being Element of
SAS holds ( not a,a9 // a,b & not a,a9 // a,c & a,a9 // b,b9 & a,a9 // c,c9 & a
  ,b // a9,b9 & a,c // a9,c9 implies b,c // b9,c9 );

theorem 
  ex SAS st (for o,a,a9,b,b9,c,c9 being Element of SAS holds ( not o,a
// o,b & not o,a // o,c & o,a // o,a9 & o,b // o,b9 & o,c // o,c9 & a,b // a9,
  b9 & a,c // a9,c9 implies b,c // b9,c9 )) & (for a,a9,b,b9,c,c9 being Element
of SAS holds ( not a,a9 // a,b & not a,a9 // a,c & a,a9 // b,b9 & a,a9 // c,c9
& a,b // a9,b9 & a,c // a9,c9 implies b,c // b9,c9 )) & (for a1,a2,a3,b1,b2,b3
being Element of SAS holds ( a1,a2 // a1,a3 & b1,b2 // b1,b3 & a1,b2 // a2,b1 &
  a2,b3 // a3,b2 implies a3,b1 // a1,b3 )) & for a,b,c,d being Element of SAS
  holds ( not a,b // a,c & a,b // c,d & a,c // b,d implies not a,d // b,c );

theorem 
  for o,a being Element of SAS holds ex p being Element of SAS st for b,
  c being Element of SAS holds (o,a // o,p & ex d being Element of SAS st ( o,p
  // o,b implies o,c // o,d & p,c // b,d ));














begin

definition
  let IT be non empty AffinStruct;
  attr IT is Semi_Affine_Space-like means


  (for a,b being Element of IT holds a,b // b,a) &
  (for a,b,c being Element of IT holds a,b // c,c) &
  (for a,b,p,q,r,s being Element of IT holds
  ( a<>b & a,b // p,q & a,b // r,s implies p,q // r,s )) &
  (for a,b,c being Element of IT holds ( a,b // a,c implies b,a // b,c )) &
  (ex a,b,c being Element of IT st not a,b // a,c) &
  (for a,b,p being Element of IT
    ex q being Element of IT st ( a,b // p,q & a,p // b,q )) &
  (for o,a being Element of IT holds
   (ex p being Element of IT st
   (for b,c being Element of IT holds o,a // o,p &
   (ex d being Element of IT st
    ( o,p // o,b implies o,c // o,d & p,c // b,d ))))) &
  (for o,a,a9,b,b9,c,c9 being Element of IT holds
    ( not o,a // o,b & not o,a // o,c & o,a // o,a9 & o,b // o,b9 & o,c //
      o,c9 & a,b // a9,b9 & a,c // a9,c9 implies b,c // b9,c9 )) &
  (for a,a9,b,b9,c,c9 being Element of IT holds
    ( not a,a9 // a,b & not a,a9 // a,c & a,a9 // b,b9 & a,a9 // c,c9 &
      a,b // a9,b9 & a,c // a9,c9 implies b,c // b9,c9 )) &
  (for a1,a2,a3,b1,b2,b3 being Element of IT holds
    ( a1,a2 // a1,a3 & b1,b2 // b1,b3 & a1,b2 // a2,b1 & a2,b3 // a3,b2
      implies a3,b1 // a1,b3 )) &
  for a,b,c,d being Element of IT holds
    ( not a,b // a,c & a,b // c,d & a,c // b,d implies not a,d // b,c );
end;

registration
  cluster Semi_Affine_Space-like for non empty AffinStruct;
end;

definition
  mode Semi_Affine_Space is Semi_Affine_Space-like non empty AffinStruct;
end;





reserve SAS for Semi_Affine_Space;
reserve a,a9,a1,a2,a3,a4,b,b9,c,c9,d,d9,d1,d2,o,p,p1,p2,q,r,r1,r2,s,x, y,t,z
  for Element of SAS;

theorem 
  a,b // a,b;

theorem 
  a,b // c,d implies c,d // a,b;

theorem 
  a,a // b,c;

theorem 
  a,b // c,d implies b,a // c,d;

theorem 
  a,b // c,d implies a,b // d,c;

theorem 
  a,b // c,d implies b,a // c,d & a,b // d,c & b,a // d,c & c,d //
  a,b & d,c // a,b & c,d // b,a & d,c // b,a;

theorem 
  a,b // a,c implies a,c // a,b & b,a // a,c & a,b // c,a & a,c //
b,a & b,a // c,a & c,a // a,b & c,a // b,a & b,a // b,c & a,b // b,c & b,a // c
,b & b,c // b,a & a,b // c,b & c,b // b,a & b,c // a,b & c,b // a,b & c,a // c,
b & a,c // c,b & c,a // b,c & a,c // b,c & c,b // c,a & b,c // c,a & c,b // a,c
  & b,c // a,c;

theorem 
  a<>b & p,q // a,b & a,b // r,s implies p,q // r,s;

theorem 
  not a,b // a,d implies a<>b & b<>d & d<>a;

theorem 
  not a,b // p,q implies a<>b & p<>q;

theorem 
  a,b // a,x & b,c // b,x & c,a // c,x implies a,b // a,c;

theorem 
  not a,b // a,c & p<>q implies not p,q // p,a or not p,q // p,b
  or not p,q // p,c;

theorem 
  p<>q implies ex r st not p,q // p,r;

theorem 
  not a,b // a,c implies not a,b // c,a & not b,a // a,c & not b,a
  // c,a & not a,c // a,b & not a,c // b,a & not c,a // a,b & not c,a // b,a &
not b,a // b,c & not b,a // c,b & not a,b // b,c & not a,b // c,b & not b,c //
b,a & not b,c // a,b & not c,b // a,b & not c,b // b,a & not c,b // c,a & not c
,b // a,c & not b,c // c,a & not b,c // a,c & not c,a // c,b & not c,a // b,c &
  not a,c // b,c & not a,c // c,b;

theorem 
  not a,b // c,d & a,b // p,q & c,d // r,s & p<>q & r<>s implies not p,q // r,s
;

theorem 
  not a,b // a,c & a,b // p,q & a,c // p,r & b,c // q,r & p<>q
  implies not p,q // p,r;

theorem 
  not a,b // a,c & a,c // p,r & b,c // p,r implies p=r;

theorem 
  not p,q // p,r1 & p,r1 // p,r2 & q,r1 // q,r2 implies r1=r2;

theorem 
  not a,b // a,c & a,b // p,q & a,c // p,r1 & a,c // p,r2 & b,c //
  q,r1 & b,c // q,r2 implies r1=r2;

theorem 
  a=b or c =d or a=c & b=d or a=d & b=c implies a,b // c,d;

theorem 
  a=b or a=c or b=c implies a,b // a,c;





definition
  let SAS,a,b,c;
  pred a,b,c is_collinear means


  a,b // a,c;
end;

theorem 
  a1,a2,a3 is_collinear implies a1,a3,a2 is_collinear & a2,a1,a3
  is_collinear & a2,a3,a1 is_collinear & a3,a1,a2 is_collinear & a3,a2,a1
  is_collinear;

theorem 
  not a,b,c is_collinear & a,b // p,q & a,c // p,r & p<>q & p<>r
  implies not p,q,r is_collinear;

theorem 
  a=b or b=c or c =a implies a,b,c is_collinear;

theorem 
  p<>q implies ex r st not p,q,r is_collinear;

theorem 
  a,b,c is_collinear & a,b,d is_collinear implies a,b // c,d;

theorem 
  not a,b,c is_collinear & a,b // c,d implies not a,b,d is_collinear;

theorem 
  not a,b,c is_collinear & a,b // c,d & c <>d & c,d,x is_collinear
  implies not a,b,x is_collinear;

theorem 
  not o,a,b is_collinear & o,a,x is_collinear & o,b,x is_collinear implies o=x;

theorem 
  o<>a & o<>b & o,a,b is_collinear & o,a,a9 is_collinear & o,b,b9
  is_collinear implies a,b // a9,b9;

theorem 
  not a,b // c,d & a,b,p1 is_collinear & a,b,p2 is_collinear & c,d,p1
  is_collinear & c,d,p2 is_collinear implies p1=p2;

theorem 
  a<>b & a,b,c is_collinear & a,b // c,d implies a,c // b,d;

theorem 
  a<>b & a,b,c is_collinear & a,b // c,d implies c,b // c,d;

theorem 
  not o,a,c is_collinear & o,a,b is_collinear & o,c,d1
  is_collinear & o,c,d2 is_collinear & a,c // b,d1 & a,c // b,d2 implies d1=d2;

theorem 
  a<>b & a,b,c is_collinear & a,b,d is_collinear implies a,c,d is_collinear;





definition
  let SAS,a,b,c,d;
  pred parallelogram a,b,c,d means


  not a,b,c is_collinear & a,b // c,d & a,c // b,d;
end;

theorem 
  parallelogram a,b,c,d implies a<>b & a<>c & c <>b & a<>d & b<>d & c <>d;

theorem 
  parallelogram a,b,c,d implies not a,b,c is_collinear & not b,a,d
  is_collinear & not c,d,a is_collinear & not d,c,b is_collinear;

theorem 
  parallelogram a1,a2,a3,a4 implies not a1,a2,a3 is_collinear &
  not a1,a3,a2 is_collinear & not a1,a2,a4 is_collinear & not a1,a4,a2
is_collinear & not a1,a3,a4 is_collinear & not a1,a4,a3 is_collinear & not a2,
  a1,a3 is_collinear & not a2,a3,a1 is_collinear & not a2,a1,a4 is_collinear &
  not a2,a4,a1 is_collinear & not a2,a3,a4 is_collinear & not a2,a4,a3
is_collinear & not a3,a1,a2 is_collinear & not a3,a2,a1 is_collinear & not a3,
  a1,a4 is_collinear & not a3,a4,a1 is_collinear & not a3,a2,a4 is_collinear &
  not a3,a4,a2 is_collinear & not a4,a1,a2 is_collinear & not a4,a2,a1
is_collinear & not a4,a1,a3 is_collinear & not a4,a3,a1 is_collinear & not a4,
  a2,a3 is_collinear & not a4,a3,a2 is_collinear;

theorem 
  parallelogram a,b,c,d implies not a,b,x is_collinear or not c,d,
  x is_collinear;

theorem 
  parallelogram a,b,c,d implies parallelogram a,c,b,d;

theorem 
  parallelogram a,b,c,d implies parallelogram c,d,a,b;

theorem 
  parallelogram a,b,c,d implies parallelogram b,a,d,c;

theorem 
  parallelogram a,b,c,d implies parallelogram a,c,b,d &
  parallelogram c,d,a,b & parallelogram b,a,d,c & parallelogram c,a,d,b &
  parallelogram d,b,c,a & parallelogram b,d,a,c;

theorem 
  not a,b,c is_collinear implies ex d st parallelogram a,b,c,d;

theorem 
  parallelogram a,b,c,d1 & parallelogram a,b,c,d2 implies d1=d2;

theorem 
  parallelogram a,b,c,d implies not a,d // b,c;

theorem 
  parallelogram a,b,c,d implies not parallelogram a,b,d,c;

theorem 
  a<>b implies ex c st a,b,c is_collinear & c <>a & c <>b;

theorem 
  parallelogram a,a9,b,b9 & parallelogram a,a9,c,c9 implies b,c // b9,c9;

theorem 
  not b,b9,c is_collinear & parallelogram a,a9,b,b9 &
  parallelogram a,a9,c,c9 implies parallelogram b,b9,c,c9;

theorem 
  a,b,c is_collinear & b<>c & parallelogram a,a9,b,b9 &
  parallelogram a,a9,c,c9 implies parallelogram b,b9,c,c9;

theorem 
  parallelogram a,a9,b,b9 & parallelogram a,a9,c,c9 &
  parallelogram b,b9,d,d9 implies c,d // c9,d9;

theorem 
  a<>d implies ex b,c st parallelogram a,b,c,d;





definition
  let SAS,a,b,r,s;
  pred congr a,b,r,s means


  a=b & r =s or ex p,q st parallelogram p,q,a, b & parallelogram p,q,r,s;
end;

theorem 
  congr a,a,b,c implies b=c;

theorem 
  congr a,b,c,c implies a=b;

theorem 
  congr a,b,b,a implies a=b;

theorem 
  congr a,b,c,d implies a,b // c,d;

theorem 
  congr a,b,c,d implies a,c // b,d;

theorem 
  congr a,b,c,d & not a,b,c is_collinear implies parallelogram a,b ,c,d;

theorem 
  parallelogram a,b,c,d implies congr a,b,c,d;

theorem 
  congr a,b,c,d & a,b,c is_collinear & parallelogram r,s,a,b
  implies parallelogram r,s,c,d;

theorem 
  congr a,b,c,x & congr a,b,c,y implies x=y;

theorem 
  ex d st congr a,b,c,d;

theorem 
  congr a,b,a,b;

theorem 
  congr r,s,a,b & congr r,s,c,d implies congr a,b,c,d;

theorem 
  congr a,b,c,d implies congr c,d,a,b;

theorem 
  congr a,b,c,d implies congr b,a,d,c;

theorem 
  congr a,b,c,d implies congr a,c,b,d;

theorem 
  congr a,b,c,d implies congr c,d,a,b & congr b,a,d,c & congr a,c,
  b,d & congr d,c,b,a & congr b,d,a,c & congr c,a,d,b & congr d,b,c,a;

theorem 
  congr a,b,p,q & congr b,c,q,s implies congr a,c,p,s;

theorem 
  congr b,a,p,q & congr c,a,p,r implies congr b,c,r,q;

theorem 
  congr a,o,o,p & congr b,o,o,q implies congr a,b,q,p;

theorem 
  congr b,a,p,q & congr c,a,p,r implies b,c // q,r;

theorem 
  congr a,o,o,p & congr b,o,o,q implies a,b // p,q;





definition
  let SAS,a,b,o;
  func sum(a,b,o) -> Element of SAS means


  congr o,a,b,it;
end;

definition
  let SAS,a,o;
  func opposite(a,o) -> Element of SAS means


  sum(a,it,o) = o;
end;

definition
  let SAS,a,b,o;
  func diff(a,b,o) -> Element of SAS equals

  sum(a,opposite(b,o),o);
end;

theorem 
  sum(a,o,o)=a;

theorem 
  ex x st sum(a,x,o)=o;

theorem 
  sum(sum(a,b,o),c,o)=sum(a,sum(b,c,o),o);

theorem 
  sum(a,b,o)=sum(b,a,o);

theorem 
  sum(a,a,o)=o implies a=o;

theorem 
  sum(a,x,o)=sum(a,y,o) implies x=y;

theorem 
  congr a,o,o,opposite(a,o);

theorem 
  opposite(a,o)=opposite(b,o) implies a=b;

theorem 
  a,b // opposite(a,o),opposite(b,o);

theorem 
  opposite(o,o)=o;

theorem 
  p,q // sum(p,r,o),sum(q,r,o);

theorem 
  p,q // r,s implies p,q // sum(p,r,o),sum(q,s,o);

theorem 
  diff(a,b,o)=o iff a=b;

theorem 
  o,diff(b,a,o) // a,b;

theorem 
  o,diff(b,a,o),diff(d,c,o) is_collinear iff a,b // c,d;





definition
  let SAS,a,b,c,d,o;
  pred trap a,b,c,d,o means


  not o,a,c is_collinear & o,a,b is_collinear
  & o,c,d is_collinear & a,c // b,d;
end;

definition
  let SAS,o,p;
  pred qtrap o,p means


  for b,c holds ex d st ( o,p,b is_collinear
  implies o,c,d is_collinear & p,c // b,d);
end;

theorem 
  trap a,b,c,d,o implies o<>a & a<>c & c <>o;

theorem 
  trap a,b,c,x,o & trap a,b,c,y,o implies x=y;

theorem 
  not o,a,b is_collinear implies trap a,o,b,o,o;

theorem 
  trap a,b,c,d,o implies trap c,d,a,b,o;

theorem 
  trap a,b,c,d,d implies d=b;

theorem 
  o<>b & trap a,b,c,d,o implies not o,b,d is_collinear;

theorem 
  o<>b & trap a,b,c,d,o implies trap b,a,d,c,o;

theorem 
  trap a,b,c,d,b implies b=d;

theorem 
  trap a,p,b,q,o & trap a,p,c,r,o implies b,c // q,r;

theorem 
  trap a,p,b,q,o & trap a,p,c,r,o & not o,b,c is_collinear
  implies trap b,q,c,r,o;

theorem 
  trap a,p,b,q,o & trap a,p,c,r,o & trap b,q,d,s,o implies c,d // r,s;

theorem 
  for o,a holds ex p st o,a,p is_collinear & qtrap o,p;

theorem 
  ex x,y,z st x<>y & y<>z & z<>x;

theorem 
  qtrap o,p implies o<>p;

theorem 
  qtrap o,p implies ex q st not o,p,q is_collinear & qtrap o,q;

theorem 
  not o,p,c is_collinear & o,p,b is_collinear & qtrap o,p implies ex d
  st trap p,b,c,d,o;














begin

reserve AS for AffinSpace;
reserve a,b,c,d,a9,b9,c9,d9,p,q,r,x,y for Element of AS;
reserve A,C,K,M,N,P,Q,X,Y,Z for Subset of AS;

theorem 
  (LIN p,a,a9 or LIN p,a9,a) & p<>a implies ex b9 st LIN p,b,b9 & a ,b // a9,b9
;

theorem 
  (a,b // A or b,a // A) & a in A implies b in A;

theorem 
  (a,b // A or b,a // A) & A // K implies a,b // K & b,a // K;

theorem 
  (a,b // A or b,a // A) & (a,b // c,d or c,d // a,b) & a<>b
  implies c,d // A & d,c // A;

theorem 
  (a,b // M or b,a // M) & (a,b // N or b,a // N) & a<>b implies M // N;

theorem 
  (a,b // M or b,a // M) & (c,d // M or d,c // M) implies a,b // c,d;

theorem 
  (A // C or C // A) & a<>b & (a,b // c,d or c,d // a,b) & a in A &
  b in A & c in C implies d in C;

theorem 
  q in M & q in N & a in M & b in N & b9 in N & q<>a & q<>b & M<>N
  & (a,b // a9,b9 or b,a // b9,a9) & M is being_line & N is being_line & q=a9
  implies q=b9;

theorem 
  q in M & q in N & a in M & a9 in M & b in N & b9 in N & q<>a & q
<>b & M<>N & (a,b // a9,b9 or b,a // b9,a9) & M is being_line & N is being_line
  & a=a9 implies b=b9;

theorem 
  (M // N or N // M) & a in M & b in N & b9 in N & M<>N & (a,b //
  a9,b9 or b,a // b9,a9) & a=a9 implies b=b9;

theorem 
  ex A st a in A & b in A & A is being_line;

theorem 
  A is being_line implies ex q st not q in A;

definition
  let AS,K,P;
  func Plane(K,P) -> Subset of AS equals

  {a: ex b st a,b // K & b in P};
end;

definition
  let AS,X;
  attr X is being_plane means


  ex K,P st K is being_line & P is being_line & not K // P & X = Plane(K,P);
end;

theorem 
  not K is being_line implies Plane(K,P) = {};

theorem 
  K is being_line implies P c= Plane(K,P);

theorem 
  K // P implies Plane(K,P) = P;

theorem 
  K // M implies Plane(K,P) = Plane(M,P);

theorem 
  p in M & a in M & b in M & p in N & a9 in N & b9 in N & not p in P &
  not p in Q & M<>N & a in P & a9 in P & b in Q & b9 in Q & M is being_line & N
is being_line & P is being_line & Q is being_line implies (P // Q or ex q st q
  in P & q in Q);

theorem 
  a in M & b in M & a9 in N & b9 in N & a in P & a9 in P & b in Q
  & b9 in Q & M<>N & M // N & P is being_line & Q is being_line implies (P // Q
  or ex q st q in P & q in Q);

theorem 
  X is being_plane & a in X & b in X & a<>b implies Line(a,b) c= X;

theorem 
  K is being_line & P is being_line & Q is being_line & not K // Q
  & Q c= Plane(K,P) implies Plane(K,Q) = Plane(K,P);

theorem 
  K is being_line & P is being_line & Q is being_line & Q c= Plane
  (K,P) implies P // Q or ex q st q in P & q in Q;

theorem 
  X is being_plane & M is being_line & N is being_line & M c= X &
  N c= X implies M // N or ex q st q in M & q in N;

theorem 
  X is being_plane & a in X & M c= X & a in N & (M // N or N // M)
  implies N c= X;

theorem 
  X is being_plane & Y is being_plane & a in X & b in X & a in Y &
  b in Y & X<>Y & a<>b implies X /\ Y is being_line;

theorem 
  X is being_plane & Y is being_plane & a in X & b in X & c in X &
  a in Y & b in Y & c in Y & not LIN a,b,c implies X = Y;

theorem 
  X is being_plane & Y is being_plane & M is being_line & N is
  being_line & M c= X & N c= X & M c= Y & N c= Y & M<>N implies X = Y;

definition
  let AS,a,K such that
 K is being_line;
  func a*K -> Subset of AS means


  a in it & K // it;
end;

theorem 
  A is being_line implies a*A is being_line;

theorem 
  X is being_plane & M is being_line & a in X & M c= X implies a*M c= X;

theorem 
  X is being_plane & a in X & b in X & c in X & a,b // c,d & a<>b
  implies d in X;

theorem 
  A is being_line implies ( a in A iff a*A = A );

theorem 
  A is being_line implies a*A = a*(q*A);

theorem 
  K // M implies a*K=a*M;

definition
  let AS,X,Y;
  pred X '||' Y means


  for a,A st a in Y & A is being_line & A c= X holds a*A c= Y;
end;

theorem 
  X c= Y & ( X is being_line & Y is being_line or X is being_plane
  & Y is being_plane ) implies X=Y;

theorem 
  X is being_plane implies ex a,b,c st a in X & b in X & c in X & not LIN a,b,c
;

theorem 
  M is being_line & X is being_plane implies ex q st q in X & not q in M;

theorem 
  for a,A st A is being_line ex X st a in X & A c= X & X is being_plane;

theorem 
  ex X st a in X & b in X & c in X & X is being_plane;

theorem 
  q in M & q in N & M is being_line & N is being_line implies ex X
  st M c= X & N c= X & X is being_plane;

theorem 
  M // N implies ex X st M c= X & N c= X & X is being_plane;

theorem 
  M is being_line & N is being_line implies (M // N iff M '||' N);

theorem 
  M is being_line & X is being_plane implies (M '||' X iff ex N st
  N c= X & (M // N or N // M) );

theorem 
  M is being_line & X is being_plane & M c= X implies M '||' X;

theorem 
  A is being_line & X is being_plane & a in A & a in X & A '||' X
  implies A c= X;

definition
  let AS,K,M,N;
  pred K,M,N is_coplanar means


  ex X st K c= X & M c= X & N c= X & X is being_plane;
end;

theorem 
  K,M,N is_coplanar implies K,N,M is_coplanar & M,K,N is_coplanar
  & M,N,K is_coplanar & N,K,M is_coplanar & N,M,K is_coplanar;

theorem 
  M is being_line & N is being_line & M,N,K is_coplanar & M,N,A
  is_coplanar & M<>N implies M,K,A is_coplanar;

theorem 
  K is being_line & M is being_line & X is being_plane & K c= X &
  M c= X & K<>M implies (K,M,A is_coplanar iff A c= X);

theorem 
  q in K & q in M & K is being_line & M is being_line implies K,M,
  M is_coplanar & M,K,M is_coplanar & M,M,K is_coplanar;

theorem 
  AS is not AffinPlane & X is being_plane implies ex q st not q in X;

theorem 
  AS is not AffinPlane & q in A & q in P & q in C & q<>a & q<>b &
q<>c & a in A & a9 in A & b in P & b9 in P & c in C & c9 in C & A is being_line
& P is being_line & C is being_line & A<>P & A<>C & a,b // a9,b9 & a,c // a9,c9
  implies b,c // b9,c9;

theorem 
  AS is not AffinPlane implies AS is Desarguesian;

theorem 
  AS is not AffinPlane & A // P & A // C & a in A & a9 in A & b in
  P & b9 in P & c in C & c9 in C & A is being_line & P is being_line & C is
  being_line & A<>P & A<>C & a,b // a9,b9 & a,c // a9,c9 implies b,c // b9,c9;

theorem 
  AS is not AffinPlane implies AS is translational;

theorem 
  AS is AffinPlane & not LIN a,b,c implies ex c9 st a,c // a9,c9 & b,c // b9,c9
;

theorem 
  not LIN a,b,c & a9<>b9 & a,b // a9,b9 implies ex c9 st a,c // a9
  ,c9 & b,c // b9,c9;

theorem 
  X is being_plane & Y is being_plane implies (X '||' Y iff ex A,P
,M,N st not A // P & A c= X & P c= X & M c= Y & N c= Y & (A // M or M // A) & (
  P // N or N // P) );

theorem 
  A // M & M '||' X implies A '||' X;

theorem 
  X is being_plane implies X '||' X;

theorem 
  X is being_plane & Y is being_plane & X '||' Y implies Y '||' X;

theorem 
  X is being_plane implies X <> {};

theorem 
  X '||' Y & Y '||' Z & Y <> {} implies X '||' Z;

theorem 
  X is being_plane & Y is being_plane & Z is being_plane & ( X
'||' Y & Y '||' Z or X '||' Y & Z '||' Y or Y '||' X & Y '||' Z or Y '||' X & Z
  '||' Y ) implies X '||' Z;

theorem 
  X is being_plane & Y is being_plane & a in X & a in Y & X '||' Y
  implies X=Y;

theorem 
  X is being_plane & Y is being_plane & Z is being_plane & X '||'
Y & X<>Y & a in X /\ Z & b in X /\ Z & c in Y /\ Z & d in Y /\ Z implies a,b //
  c,d;

theorem 
  X is being_plane & Y is being_plane & Z is being_plane & X '||' Y & a
  in X /\ Z & b in X /\ Z & c in Y /\ Z & d in Y /\ Z & X<>Y & a<>b & c <>d
  implies X/\Z // Y/\Z;

theorem 
  for a,X st X is being_plane ex Y st a in Y & X '||' Y & Y is being_plane;

definition
  let AS,a,X such that
 X is being_plane;
  func a+X -> Subset of AS means


  a in it & X '||' it & it is being_plane;
end;

theorem 
  X is being_plane implies ( a in X iff a+X = X );

theorem 
  X is being_plane implies a+X = a+(q+X);

theorem 
  A is being_line & X is being_plane & A '||' X implies a*A c= a+X;

theorem 
  X is being_plane & Y is being_plane & X '||' Y implies a+X = a+Y;














begin

reserve AS for AffinSpace;
reserve A,K,M,X,Y,Z,X9,Y9 for Subset of AS;
reserve zz for Element of AS;
reserve x,y for set;





theorem 
  AS is AffinPlane & X=the carrier of AS implies X is being_plane;

theorem 
  AS is AffinPlane & X is being_plane implies X = the carrier of AS;

theorem 
  AS is AffinPlane & X is being_plane & Y is being_plane implies X= Y;

theorem 
  X=the carrier of AS & X is being_plane implies AS is AffinPlane;

theorem 
  not A // K & A '||' X & A '||' Y & K '||' X & K '||' Y & A is
  being_line & K is being_line & X is being_plane & Y is being_plane implies X
  '||' Y;

theorem 
  X is being_plane & A '||' X & X '||' Y implies A '||' Y;









definition
  let AS;
  func AfLines(AS) -> Subset-Family of AS equals

  {A: A is being_line};
end;

definition
  let AS;
  func AfPlanes(AS) -> Subset-Family of AS equals

  {A: A is being_plane};
end;

theorem 
  for x holds (x in AfLines(AS) iff ex X st x=X & X is being_line);

theorem 
  for x holds (x in AfPlanes(AS) iff ex X st x=X & X is being_plane);

definition
  let AS;
  func LinesParallelity(AS) -> Equivalence_Relation of AfLines(AS) equals

  {[K,
  M]: K is being_line & M is being_line & K '||' M};
end;

definition
  let AS;
  func PlanesParallelity(AS) -> Equivalence_Relation of AfPlanes(AS) equals

  {[
  X,Y]: X is being_plane & Y is being_plane & X '||' Y};
end;

definition
  let AS,X;
  func LDir(X) -> Subset of AfLines(AS) equals

  Class(LinesParallelity(AS),X);
end;

definition
  let AS,X;
  func PDir(X) -> Subset of AfPlanes(AS) equals

  Class(PlanesParallelity(AS),X);
end;

theorem 
  X is being_line implies for x holds x in LDir(X) iff ex Y st x=Y
  & Y is being_line & X '||' Y;

theorem 
  X is being_plane implies for x holds x in PDir(X) iff ex Y st x=
  Y & Y is being_plane & X '||' Y;

theorem 
  X is being_line & Y is being_line implies (LDir(X)=LDir(Y) iff X // Y);

theorem 
  X is being_line & Y is being_line implies (LDir(X)=LDir(Y) iff X '||' Y);

theorem 
  X is being_plane & Y is being_plane implies (PDir(X)=PDir(Y) iff X '||' Y);

definition
  let AS;
  func Dir_of_Lines(AS) -> non empty set equals

  Class LinesParallelity(AS);
end;

definition
  let AS;
  func Dir_of_Planes(AS) -> non empty set equals

  Class PlanesParallelity(AS);
end;

theorem 
  for x holds x in Dir_of_Lines(AS) iff ex X st x=LDir(X) & X is being_line;

theorem 
  for x holds x in Dir_of_Planes(AS) iff ex X st x=PDir(X) & X is being_plane;









theorem 
  the carrier of AS misses Dir_of_Lines(AS);

theorem 
  AS is AffinPlane implies AfLines(AS) misses Dir_of_Planes(AS);

theorem 
  for x holds (x in [:AfLines(AS),{1}:] iff ex X st x=[X,1] & X is being_line);

theorem 
  for x holds (x in [:Dir_of_Planes(AS),{2}:] iff ex X st x=[PDir(
  X),2] & X is being_plane);

definition
  let AS;
  func ProjectivePoints(AS) -> non empty set equals

  (the carrier of AS) \/
  Dir_of_Lines(AS);
end;

definition
  let AS;
  func ProjectiveLines(AS) -> non empty set equals

  [:AfLines(AS),{1}:] \/ [:
  Dir_of_Planes(AS),{2}:];
end;

definition
  let AS;
  func Proj_Inc(AS) -> Relation of ProjectivePoints(AS),ProjectiveLines(AS)
  means


  for x,y holds [x,y] in it iff (ex K st K is being_line & y=[K,1]
  & (x in the carrier of AS & x in K or x = LDir(K))) or ex K,X st K is
  being_line & X is being_plane & x=LDir(K) & y=[PDir(X),2] & K '||' X;
end;

definition
  let AS;
  func Inc_of_Dir(AS) -> Relation of Dir_of_Lines(AS),Dir_of_Planes(AS) means


  for x,y holds [x,y] in it iff ex A,X st x=LDir(A) & y=PDir(X) & A is
  being_line & X is being_plane & A '||' X;
end;

definition
  let AS;
  func IncProjSp_of(AS) -> strict IncProjStr equals

  IncProjStr (#
    ProjectivePoints(AS), ProjectiveLines(AS), Proj_Inc(AS) #);
end;

definition
  let AS;
  func ProjHorizon(AS) -> strict IncProjStr equals

  IncProjStr (#Dir_of_Lines(
    AS), Dir_of_Planes(AS), Inc_of_Dir(AS) #);
end;

theorem 
  for x holds (x is POINT of IncProjSp_of(AS) iff (x is Element of
  AS or ex X st x=LDir(X) & X is being_line));

theorem 
  x is Element of the Points of ProjHorizon(AS) iff ex X st x=LDir(X) &
  X is being_line;

theorem 
  x is Element of the Points of ProjHorizon(AS) implies x is POINT
  of IncProjSp_of(AS);

theorem 
  for x holds (x is LINE of IncProjSp_of(AS) iff ex X st (x=[X,1]
  & X is being_line or x=[PDir(X),2] & X is being_plane));

theorem 
  x is Element of the Lines of ProjHorizon(AS) iff ex X st x=PDir(X) & X
  is being_plane;

theorem 
  x is Element of the Lines of ProjHorizon(AS) implies [x,2] is
  LINE of IncProjSp_of(AS);

reserve x,y,z,t,u,w for Element of AS;
reserve K,X,Y,Z,X9,Y9 for Subset of AS;
reserve a,b,c,d,p,q,r,p9 for POINT of IncProjSp_of(AS);
reserve A for LINE of IncProjSp_of(AS);

theorem 
  x=a & [X,1]=A implies (a on A iff X is being_line & x in X);

theorem 
  x=a & [PDir(X),2]=A implies not a on A;

theorem 
  a=LDir(Y) & [X,1]=A & Y is being_line & X is being_line implies
  (a on A iff Y '||' X);

theorem 
  a=LDir(Y) & A=[PDir(X),2] & Y is being_line & X is being_plane
  implies (a on A iff Y '||' X);

theorem 
  X is being_line & a=LDir(X) & A=[X,1] implies a on A;

theorem 
  X is being_line & Y is being_plane & X c= Y & a=LDir(X) & A=[
  PDir(Y),2] implies a on A;

theorem 
  Y is being_plane & X c= Y & X9 // X & a=LDir(X9) & A=[PDir(Y),2]
  implies a on A;

theorem 
  A=[PDir(X),2] & X is being_plane & a on A implies a is not Element of
  AS;

theorem 
  A=[X,1] & X is being_line & p on A & p is not Element of AS implies p=LDir(X)
;

theorem 
  A=[X,1] & X is being_line & p on A & a on A & a<>p & not p is
  Element of AS implies a is Element of AS;

theorem 
  for a being Element of the Points of ProjHorizon(AS),A being
  Element of the Lines of ProjHorizon(AS) st a=LDir(X) & A=PDir(Y) & X is
  being_line & Y is being_plane holds (a on A iff X '||' Y);

theorem 
  for a being Element of the Points of ProjHorizon(AS),a9 being
  Element of the Points of IncProjSp_of(AS),A being Element of the Lines of
  ProjHorizon(AS),A9 being LINE of IncProjSp_of(AS) st a9=a & A9=[A,2] holds (a
  on A iff a9 on A9);

reserve A,K,M,N,P,Q for LINE of IncProjSp_of(AS);

theorem 
  for a,b being Element of the Points of ProjHorizon(AS), A,K
  being Element of the Lines of ProjHorizon(AS) st a on A & a on K & b on A & b
  on K holds a=b or A=K;

theorem 
  for A being Element of the Lines of ProjHorizon(AS) ex a,b,c
being Element of the Points of ProjHorizon(AS) st a on A & b on A & c on A & a
  <>b & b<>c & c <>a;

theorem 
  for a,b being Element of the Points of ProjHorizon(AS) ex A
  being Element of the Lines of ProjHorizon(AS) st a on A & b on A;

theorem 
  for x,y being Element of the Points of ProjHorizon(AS), X being
  Element of the Lines of IncProjSp_of(AS) st x<>y & [x,X] in the Inc of
  IncProjSp_of(AS) & [y,X] in the Inc of IncProjSp_of(AS) ex Y being Element of
  the Lines of ProjHorizon(AS) st X=[Y,2];

theorem 
  for x being POINT of IncProjSp_of(AS),X being Element of the
Lines of ProjHorizon(AS) st [x,[X,2]] in the Inc of IncProjSp_of(AS) holds x is
  Element of the Points of ProjHorizon(AS);

theorem 
  Y is being_plane & X is being_line & X9 is being_line & X c= Y &
  X9 c= Y & P=[X,1] & Q=[X9,1] implies ex q st q on P & q on Q;

theorem 
  for a,b,c,d,p being Element of the Points of ProjHorizon(AS),M,N
,P,Q being Element of the Lines of ProjHorizon(AS) st a on M & b on M & c on N
  & d on N & p on M & p on N & a on P & c on P & b on Q & d on Q & not p on P &
not p on Q & M<>N ex q being Element of the Points of ProjHorizon(AS) st q on P
  & q on Q;

registration
  let AS;
  cluster IncProjSp_of(AS) -> partial linear up-2-dimensional up-3-rank
    Vebleian;
end;

registration
  cluster strict 2-dimensional for IncProjSp;
end;

registration
  let AS be AffinPlane;
  cluster IncProjSp_of(AS) -> 2-dimensional;
end;

theorem 
  IncProjSp_of(AS) is 2-dimensional implies AS is AffinPlane;

theorem 
  AS is not AffinPlane implies ProjHorizon(AS) is IncProjSp;

theorem 
  ProjHorizon(AS) is IncProjSp implies AS is not AffinPlane;

theorem 
  for M,N being Subset of AS, o,a,b,c,a9,b9,c9 being Element
 of AS st M is being_line & N is being_line & M<>N & o in M & o in N
  & o<>b & o<>b9 & o<>c9 & b in M & c in M & a9 in N & b9 in N & c9 in N & a,b9
  // b,a9 & b,c9 // c,b9 & (a=b or b=c or a=c) holds a,c9 // c,a9;

theorem 
  IncProjSp_of(AS) is Pappian implies AS is Pappian;

theorem 
  for A,P,C being Subset of AS, o,a,b,c,a9,b9,c9 being Element
 of AS st o in A & o in P & o in C & o<>a & o<>b & o<>c & a in A & b
  in P & b9 in P & c in C & c9 in C & A is being_line & P is being_line & C is
being_line & A<>P & A<>C & a,b // a9,b9 & a,c // a9,c9 & (o=a9 or a=a9) holds b
  ,c // b9,c9;

theorem 
  IncProjSp_of(AS) is Desarguesian implies AS is Desarguesian;

theorem 
  IncProjSp_of(AS) is Fanoian implies AS is Fanoian;














begin



theorem 
  for A,B,C being non empty set, f being Function of A,B st for x
  being Element of A holds f.x in C holds f is Function of A,C;

reserve A for non empty set,
  a for Element of A;

definition
  let A;
  let B,C be Element of Fin A;
  redefine pred B c= C means

  for a st a in B holds a in C;
end;

reserve A for set;

definition
  let A;
  assume
 A is non empty;
  func [A] -> non empty set equals


  A;
end;

reserve B,C for Element of Fin DISJOINT_PAIRS A,
  x for Element of [:Fin A, Fin A:],
  a,b,c,d,s,t,s9,t9,t1,t2,s1,s2 for Element of DISJOINT_PAIRS A,
  u,v,w for Element of NormForm A;

theorem 
  B = {} implies mi B = {};

registration
  let A;
  cluster non empty for Element of Normal_forms_on A;
end;

definition
  let A,a;
  redefine func { a } -> Element of Normal_forms_on A;
end;

definition
  let A;
  let u be Element of NormForm A;
  func @u -> Element of Normal_forms_on A equals

  u;
end;

reserve K,L for Element of Normal_forms_on A;

theorem 
  mi (K^K) = K;

theorem 
  for X being set st X c= K holds X in Normal_forms_on A;

theorem 
  for X being set st X c= u holds X is Element of NormForm A;

definition
  let A;
  func Atom(A) -> Function of DISJOINT_PAIRS A, the carrier of NormForm A
  means


  it.a = { a };
end;

theorem 
  c in Atom(A).a implies c = a;

theorem 
  a in Atom(A).a;

theorem 
  Atom(A).a = singleton DISJOINT_PAIRS A .a;

theorem 
  FinJoin(K, Atom(A)) = FinUnion(K, singleton DISJOINT_PAIRS A);

theorem 
  u = FinJoin(@u, Atom(A));

reserve f,f9 for (Element of Funcs(DISJOINT_PAIRS A, [:Fin A,Fin A:])),
  g,h for Element of Funcs(DISJOINT_PAIRS A, [A]);

definition
  let A be set;
  func pair_diff A -> BinOp of [:Fin A,Fin A:] means


  for a,b being Element of [:Fin A, Fin A:] holds it.(a,b) = a \ b;
end;

definition
  let A,B;
  func -B -> Element of Fin DISJOINT_PAIRS A equals

  DISJOINT_PAIRS A /\ { [{ g
  .t1 : g.t1 in t1`2 & t1 in B }, { g.t2 : g.t2 in t2`1 & t2 in B }] : s in B
  implies g.s in s`1 \/ s`2 };
  let C;
  func B =>> C -> Element of Fin DISJOINT_PAIRS A equals

  DISJOINT_PAIRS A /\ {
  FinPairUnion(B,pair_diff A.:(f,incl DISJOINT_PAIRS A)) : f.:B c= C };
end;

theorem 
  c in -B implies ex g st (for s st s in B holds g.s in s`1 \/ s`2
) & c = [{ g.t1 : g.t1 in t1`2 & t1 in B }, { g.t2 : g.t2 in t2`1 & t2 in B }];

theorem 
  [{},{}] is Element of DISJOINT_PAIRS A;

theorem 
  for K st K = {} holds -K = {[{},{}]};

theorem 
  for K,L st K = {} & L = {} holds K =>> L = {[{},{}]};

theorem 
  for a being Element of DISJOINT_PAIRS {} holds a = [{},{}];

theorem 
  DISJOINT_PAIRS {} = {[{},{}]};

theorem 
  {[{},{}]} is Element of Normal_forms_on A;

theorem 
  c in B =>> C implies ex f st f.:B c= C & c = FinPairUnion(B,
  pair_diff A.:(f,incl DISJOINT_PAIRS A));

theorem 
  K ^ { a } = {} implies ex b st b in -K & b c= a;

theorem 
  (for c st c in u ex b st b in v & b c= c \/ a) implies ex b st b
  in @u =>> @v & b c= a;

theorem 
  K ^ -K = {};

definition
  let A;
  func pseudo_compl(A) -> UnOp of the carrier of NormForm A means


  it.u = mi(-@u);
  func StrongImpl(A) -> BinOp of the carrier of NormForm A means


  it.(u, v) = mi (@u =>> @v);
  let u;
  func SUB u -> Element of Fin the carrier of NormForm A equals

  bool u;
  func diff(u) -> UnOp of the carrier of NormForm A means


  it.v = u \ v;
end;

theorem 
  (diff u).v [= u;

theorem 
  u "/\" pseudo_compl(A).u = Bottom NormForm A;

theorem 
  u "/\" StrongImpl(A).(u, v) [= v;

theorem 
  @u ^ { a } = {} implies Atom(A).a [= pseudo_compl(A).u;

theorem 
  (for b st b in u holds b \/ a in DISJOINT_PAIRS A ) & u "/\"
  Atom(A).a [= w implies Atom(A).a [= StrongImpl(A).(u, w);

registration
  let A;
  cluster NormForm A -> implicative;
end;

theorem 
  u => v = FinJoin(SUB u, (the L_meet of NormForm A).:(
  pseudo_compl(A), StrongImpl(A)[:](diff u, v)));

theorem 
  Top NormForm A = {[{},{}]};














begin 

definition
  struct (1-sorted) typealg
        (#carrier -> set,
    left_quotient, right_quotient, inner_product -> BinOp of the carrier #);
end;

registration
  cluster non empty strict for typealg;
end;

definition
  let s be non empty typealg;
  mode type of s is Element of s;
end;

reserve s for non empty typealg,
  T,X,Y,T9,X9,Y9 for FinSequence of s,
  x,y,z,y9,z9 for type of s;

definition
  let s,x,y;
  func x\y -> type of s equals

  (the left_quotient of s).(x,y);
  func x/"y -> type of s equals

  (the right_quotient of s).(x,y);
  func x*y -> type of s equals

  (the inner_product of s).(x,y);
end;

definition
  let s;
  mode PreProof of s is finite DecoratedTree of [:[: (the carrier of s)*,
    the carrier of s :], NAT :];
end;

reserve Tr for PreProof of s;

definition
  let s, Tr;
  let v be Element of dom Tr;

  attr v is correct means


  branchdeg v = 0 & ex x st (Tr.v)`1 = [<*x*>,x] if (Tr.v)`2 = 0,
  branchdeg v = 1 & ex T,x,y st (Tr.v)`1 = [T,x/"y] & (Tr.(v^<*0*>))`1 =
  [T^<*y*>,x] if (Tr.v)`2 = 1,
  branchdeg v = 1 & ex T,x,y st (Tr.v)`1 = [T,y\x] & (Tr.(v^<*0*>))`1 =
  [<*y*>^T,x] if (Tr.v)`2 = 2,
  branchdeg v = 2 & ex T,X,Y,x,y,z st (Tr.v)`1 = [X^<*x/"y*>^T^Y,z] &
  (Tr.(v^<*0*>))`1 = [T,y] & (Tr.(v^<*1*>))`1 = [X^<*x*>^Y,z] if (Tr.v)`2 = 3,
  branchdeg v = 2 & ex T,X,Y,x,y,z st (Tr.v)`1 = [X^T^<*y\x*>^Y,z] &
  (Tr.(v^<*0*>))`1 = [T,y] & (Tr.(v^<*1*>))`1 = [X^<*x*>^Y,z] if (Tr.v)`2 = 4,
  branchdeg v = 1 & ex X,x,y,Y st (Tr.v)`1 = [X^<*x*y*>^Y,z] &
  (Tr.(v^<*0*>))`1 = [X^<*x*>^<*y*>^Y,z] if (Tr.v)`2 = 5,
  branchdeg v = 2 & ex X,Y,x,y st (Tr.v)`1 = [X^Y,x*y] & (Tr.(v^<*0*>))`1 =
  [X,x] & (Tr.(v^<*1*>))`1 = [Y,y] if (Tr.v)`2 = 6,
  branchdeg v = 2 & ex T,X,Y,y,z st (Tr.v)`1 = [X^T^Y,z] &
  (Tr.(v^<*0*>))`1 = [T,y] & (Tr.(v^<*1*>))`1 = [X^<*y*>^Y,z] if (Tr.v)`2 = 7
  otherwise contradiction;
end;

definition
  let s;
  let IT be type of s;
  attr IT is left means

  ex x,y st IT = x\y;
  attr IT is right means

  ex x,y st IT = x/"y;
  attr IT is middle means

  ex x,y st IT = x*y;
end;

definition
  let s;
  let IT be type of s;
  attr IT is primitive means

  not (IT is left or IT is right or IT is middle);
end;

definition
  let s;
  let Tr be finite DecoratedTree of the carrier of s;
  let v be Element of dom Tr;
  redefine func Tr.v -> type of s;
end;

definition
  let s;
  let Tr be finite DecoratedTree of the carrier of s, x;
  pred Tr represents x means

  dom Tr is finite &
  for v being Element of dom Tr holds (branchdeg v = 0 or branchdeg v = 2)
  & (branchdeg v = 0 implies Tr.v is primitive) & (branchdeg v = 2 implies
  ex y,z st (Tr.v = y/"z or Tr.v = y\z or Tr.v = y*z) &
  Tr.(v^<*0*>) = y & Tr.(v^<*1*>)= z);
end;

notation
  let s;
  let Tr be finite DecoratedTree of the carrier of s, x;
  antonym Tr does_not_represent x for Tr represents x;
end;

definition
  let IT be non empty typealg;
  attr IT is free means


  not (ex x being type of IT st x is left right
  or x is left middle or x is right middle) & for x being type of IT ex Tr
  being finite DecoratedTree of the carrier of IT st
  for Tr1 being finite DecoratedTree of
  the carrier of IT holds Tr1 represents x iff Tr = Tr1;
end;

definition
  let s,x such that
 s is free;
  func repr_of x -> finite DecoratedTree of the carrier of s means

  for Tr being finite DecoratedTree of the carrier of s holds
    Tr represents x iff it = Tr;
end;

definition
  let s;
  let f be FinSequence of s;
  let t be type of s;
  redefine func [f,t] -> Element of [:(the carrier of s)*, the carrier of s:];
end;

definition
  let s;
  mode Proof of s -> PreProof of s means


    dom it is finite & for v being Element of dom it holds v is correct;
end;

reserve p for Proof of s,
  v for Element of dom p;

theorem 
  branchdeg v = 1 implies v^<*0*> in dom p;

theorem 
  branchdeg v = 2 implies v^<*0*> in dom p & v^<*1*> in dom p;

theorem 
  (p.v)`2 = 0 implies ex x st (p.v)`1 = [<*x*>,x];

theorem 
  (p.v)`2 = 1 implies ex w being Element of dom p, T,x,y st w = v^<*0*> &
  (p.v)`1 = [T,x/"y] & (p.w)`1 = [T^<*y*>,x];

theorem 
  (p.v)`2 = 2 implies ex w being Element of dom p, T,x,y st w = v^<*0*> &
  (p.v)`1 = [T,y\x] & (p.w)`1 = [<*y*>^T,x];

theorem 
  (p.v)`2 = 3 implies ex w,u being Element of dom p, T,X,Y,x,y,z st
  w = v^<*0*> & u = v^<*1*> & (p.v)`1 = [X^<*x/"y*>^T^Y,z] &
  (p.w)`1 = [T,y] & (p.u)`1 = [X^<*x*>^Y,z];

theorem 
  (p.v)`2 = 4 implies ex w,u being Element of dom p, T,X,Y,x,y,z st
  w = v^<*0*> & u = v^<*1*> & (p.v)`1 = [X^T^<*y\x*>^Y,z] &
  (p.w)`1 = [T,y] & (p.u)`1 = [X^<*x*>^Y,z];

theorem 
  (p.v)`2 = 5 implies ex w being Element of dom p, X,x,y,Y st w = v^<*0*> &
  (p.v)`1 = [X^<*x*y*>^Y,z] & (p.w)`1 = [X^<*x*>^<*y*>^Y,z];

theorem 
  (p.v)`2 = 6 implies ex w,u being Element of dom p, X,Y,x,y st w = v^<*0*> &
  u = v^<*1*> & (p.v)`1 = [X^Y,x*y] & (p.w)`1 = [X,x] & (p.u)`1 = [Y,y];

theorem 
  (p.v)`2 = 7 implies ex w,u being Element of dom p, T,X,Y,y,z st w = v^<*0 *>
  & u = v^<*1*> & (p.v)`1 = [X^T^Y,z] & (p.w)`1 = [T,y] & (p.u)`1 =
  [X^<*y*>^Y,z];

theorem 
  (p.v)`2 = 0 or (p.v)`2 = 1 or (p.v)`2 = 2 or (p.v)`2 = 3 or (p.v)`2 = 4 or
  (p.v)`2 = 5 or (p.v)`2 = 6 or (p.v)`2 = 7;

definition
  let s;
  let IT be PreProof of s;
  attr IT is cut-free means

  for v being Element of dom IT holds (IT.v)`2 <> 7;
end;

definition
  let s;
  func size_w.r.t. s -> Function of the carrier of s, NAT means

  for x holds it.x = card dom repr_of x;
end;

definition
  let D be non empty set, T be FinSequence of D, f be Function of D,NAT;
  redefine func f*T -> FinSequence of REAL;
end;

definition
  let s;
  let p be Proof of s;
  func cutdeg p -> Nat means

  ex T,X,Y,y,z st (p.{})`1 = [X^T^Y,z] & (p.<*0*>)`1 = [T,y] &
  (p.<*1*>)`1 = [X^<*y*>^Y,z] & it = (size_w.r.t. s).y + (size_w.r.t. s).z
  + Sum((size_w.r.t. s)*(X^T^Y)) if (p.{})`2 = 7 otherwise it = 0;
end;



reserve A for non empty set,
  a,a1,a2,b for Element of A*;

definition
  let s,A;
  mode Model of s,A -> Function of the carrier of s, bool (A*) means

    for x,y holds it.(x*y) = { a ^ b : a in it.x & b in it.y } &
    it.(x/"y) = { a1 : for b st b in it.y holds a1 ^ b in it.x } &
    it.(y\x) = {a2: for b st b in it.y holds b ^ a2 in it.x };
end;



definition
  struct(typealg) typestr (# carrier -> set,
    left_quotient, right_quotient, inner_product -> BinOp of the carrier,
    derivability -> Relation of (the carrier)*,the carrier #);
end;

registration
  cluster non empty strict for typestr;
end;

reserve s for non empty typestr,
  x for type of s;

definition
  let s;
  let f be FinSequence of s, x;
  pred f ==>. x means


  [f,x] in the derivability of s;
end;

definition
  let IT be non empty typestr;
  attr IT is SynTypes_Calculus-like means


  (for x being type of IT holds <*x*> ==>. x) &
  (for T being FinSequence of IT, x,y being type of IT
  st T^<*y*> ==>. x holds T ==>. x/"y) &
  (for T being FinSequence of IT, x,y being type of IT
  st <*y*>^T ==>. x holds T ==>. y\x) &
  (for T,X,Y being FinSequence of IT, x,y,z being type of IT
  st T ==>. y & X^<*x*>^Y ==>. z holds X^<*x/"y*>^T^Y ==>. z) &
  (for T,X,Y being FinSequence of IT, x,y,z being type of IT
  st T ==>. y & X^<*x*>^Y ==>. z holds X^T^<*y\x*>^Y ==>. z) &
  (for X,Y being FinSequence of IT, x,y,z being type of IT
  st X^<*x*>^<*y*>^Y ==>. z holds X^<*x*y*>^Y ==>.z) &
  for X,Y being FinSequence of IT, x,y being type of IT
  st X ==>. x & Y ==>. y holds X^Y ==>. x*y;
end;

registration
  cluster SynTypes_Calculus-like for non empty typestr;
end;

definition
  mode SynTypes_Calculus is SynTypes_Calculus-like non empty typestr;
end;

reserve s for SynTypes_Calculus,
  T,X,Y for FinSequence of s,
  x,y,z for type of s;

theorem 
  <*x/"y*>^<*y*> ==>. x & <*y*>^<*y\x*> ==>. x;

theorem 
  <*x*> ==>. y/"(x\y) & <*x*> ==>. (y/"x)\y;

theorem 
  <*x/"y*> ==>. (x/"z)/"(y/"z);

theorem 
  <*y\x*> ==>. (z\y)\(z\x);

theorem 
  <*x*> ==>. y implies <*x/"z*> ==>. y/"z & <*z\x*> ==>. z\y;

theorem 
  <*x*> ==>. y implies <*z/"y*> ==>. z/"x & <*y\z*> ==>. x\z;

theorem 
  <*y/"((y/"x)\y)*> ==>. y/"x;

theorem 
  <*x*> ==>. y implies
  <*>the carrier of s ==>. y/"x & <*>the carrier of s ==>. x\y;

theorem 
  <*>the carrier of s ==>. x/"x & <*>the carrier of s ==>. x\x;

theorem 
  <*>the carrier of s ==>. (y/"(x\y))/"x &
  <*>the carrier of s ==>. x\((y/"x)\ y );

theorem 
  <*>the carrier of s ==>. ((x/"z)/"(y/"z))/"(x/"y) &
  <*>the carrier of s ==>. (y\x)\((z\y)\(z\x));

theorem 
  <*>the carrier of s ==>. x implies
  <*>the carrier of s ==>. y/"(y/"x) & <*>the carrier of s ==>. (x\y)\y;

theorem 
  <*x/"(y/"y)*> ==>. x;

definition
  let s,x,y;
  pred x <==>. y means


  <*x*> ==>. y & <*y*> ==>. x;
  reflexivity;
  symmetry;
end;

theorem 
  x/"y <==>. x/"((x/"y)\x);

theorem 
  x/"(z*y) <==>. (x/"y)/"z;

theorem 
  <*x*(y/"z)*> ==>. (x*y)/"z;

theorem 
  <*x*> ==>. (x*y)/"y & <*x*> ==>. y\(y*x);

theorem 
  x*y*z <==>. x*(y*z);














begin

reserve B,C,D for Category;

definition
  let X,Y,Z be non empty set;
  let f be PartFunc of [:X,Y:],Z;
  redefine func ~f -> PartFunc of [:Y,X:],Z;
end;




definition
  let C;
  func C opp -> strict non empty non void CatStr equals

  CatStr (#the carrier of C, the carrier'
    of C, the Target of C, the Source of C, ~the Comp of C#);
end;

definition
  let C;
  let c be Object of C;
  func c opp -> Object of C opp equals

  c;
end;

registration let C;
 cluster C opp -> Category-like
  transitive associative reflexive with_identities;
end;

definition
  let C;
  let c be Object of C opp;
  func opp c -> Object of C equals

  c opp;
end;

canceled;

theorem 
  for c being Object of C holds c opp opp = c;

theorem 
  for c being Object of C holds opp (c opp) = c;

theorem 
  for c being Object of C opp holds (opp c) opp = c;

theorem 
  for a,b being Object of C
   holds Hom(a,b) = Hom(b opp,a opp);

theorem 
  for a,b being Object of C opp
  holds Hom(a,b) = Hom(opp b,opp a);

definition
  let C;
  let f be Morphism of C;
  func f opp -> Morphism of C opp equals

  f;
end;

definition
  let C;
  let f be Morphism of C opp;
  func opp f -> Morphism of C equals

  f opp;
end;

definition let C; let a,b be Object of C such that
 Hom(a,b) <> {};
 let f be Morphism of a,b;
 func f opp -> Morphism of b opp, a opp equals

  f;
end;

definition let C; let a,b be Object of C such that
 Hom(a opp,b opp) <> {};
 let f be Morphism of a opp, b opp;
 func opp f -> Morphism of b, a equals

  f;
end;

theorem 
  for a,b being Object of C st Hom(a,b)<>{}
  for f being Morphism of a,b holds f opp opp = f;

theorem 
  for a,b being Object of C st Hom(a,b)<>{}
  for f being Morphism of a,b holds opp(f opp) = f;

theorem 
  for a,b being Object of C opp
  for f being Morphism of a,b holds (opp f)opp = f;

theorem 
  for a,b being Object of C st Hom(a,b)<>{}
  for f being Morphism of a,b holds dom(f opp) = cod f & cod(f opp) = dom f;

theorem 
  for a,b being Object of C opp
  for f being Morphism of a,b
   holds dom(opp f) = cod f & cod(opp f) = dom f;

theorem 
  for a,b being Object of C st Hom(a,b)<>{}
  for f being Morphism of a,b
 holds (dom f) opp = cod (f opp) & (cod f)opp = dom (f opp);

theorem 
  for a,b being Object of C opp st Hom(a,b)<>{}
  for f being Morphism of a,b
  holds opp (dom f) = cod (opp f) & opp (cod f) = dom (opp f);

canceled;

theorem 
 for a,b being Object of C opp,f being Morphism of a,b st Hom(a,b) <> {}
  holds opp f is Morphism of opp b,opp a;

theorem 
  for a,b,c being Object of C st Hom(a,b) <> {} & Hom(b,c) <> {}
  for f being Morphism of a,b, g being Morphism of b,c
   holds (g(*)f) opp = (f opp)(*)(g opp);

theorem 
  for a,b,c being Object of C
st Hom(b opp,a opp) <> {} & Hom(c opp,b opp) <> {}
  for f be Morphism of a,b, g being Morphism of b,c
  holds (g(*)f) opp = (f opp)(*)(g opp);

theorem 
  for f,g being Morphism of C opp st dom g = cod f holds opp (g(*)f)
  = (opp f)(*)(opp g);

theorem 
  for a,b,c being Object of C, f being Morphism of a,b, g being Morphism
  of b, c st Hom(a,b) <> {} & Hom(b,c) <> {}
    holds (g*f) opp = (f opp)(*)(g opp);

theorem 
  for a being Object of C holds (id a) opp = id(a opp);

theorem 
  for a being Object of C opp holds opp id a = id opp a;

theorem 
 for a,b being Object of C
  for f being Morphism of a,b holds f opp is monic iff f is epi;

theorem 
  for b,c being Object of C st Hom(b,c) <> {}
  for f being Morphism of b,c holds f opp is epi iff f is monic;

theorem 
  for a,b being Object of C
  for f being Morphism of a,b holds f opp is invertible iff f is invertible;

theorem 
  for c being Object of C holds c is initial iff c opp is terminal;

theorem 
  for c being Object of C holds c opp is initial iff c is terminal;



definition
  let C,B;
  let S be Function of the carrier' of C opp,the carrier' of B;
  func /*S -> Function of the carrier' of C,the carrier' of B means


  for f being Morphism of C holds it.f = S.(f opp);
end;

theorem 
  for S being Function of the carrier' of C opp,the carrier' of B for f
  being Morphism of C opp holds (/*S).(opp f) = S.f;

theorem 
  for S being Functor of C opp,B, c being Object of C holds (Obj
  /*S).c = (Obj S).(c opp);

theorem 
  for S being Functor of C opp,B, c being Object of C opp holds (Obj /*S
  ).(opp c) = (Obj S).c;

definition
  let C,D;
  mode Contravariant_Functor of C,D -> Function of the carrier' of C,the
    carrier' of D means


    ( for c being Object of C ex d being Object of D st it.(id c) = id d ) &
    ( for f being Morphism of C holds it.(id dom f) = id cod (it.f) &
         it.(id cod f) = id dom (it.f) ) &



    for f,g being Morphism of C
     st dom g = cod f
    holds it.(g(*)f) = (it.f)(*)(it.g);
end;

theorem 
  for S being Contravariant_Functor of C,D, c being Object of C, d
  being Object of D st S.(id c) = id d holds (Obj S).c = d;

theorem 
  for S being Contravariant_Functor of C,D,c being Object of C
  holds S.(id c) = id((Obj S).c);

theorem 
  for S being Contravariant_Functor of C,D, f being Morphism of C
  holds (Obj S).(dom f) = cod (S.f) & (Obj S).(cod f) = dom (S.f);

theorem 
  for S being Contravariant_Functor of C,D, f,g being Morphism of
  C st dom g = cod f holds dom (S.f) = cod (S.g);

theorem 
  for S being Functor of C opp,B holds /*S is Contravariant_Functor of C,B;

theorem 
  for S1 being Contravariant_Functor of C,B, S2 being
  Contravariant_Functor of B,D holds S2*S1 is Functor of C,D;

theorem 
  for S being Contravariant_Functor of C opp,B, c being Object of
  C holds (Obj /*S).c = (Obj S).(c opp);

theorem 
  for S being Contravariant_Functor of C opp,B, c being Object of C opp
  holds (Obj /*S).(opp c) = (Obj S).c;

theorem 
  for S being Contravariant_Functor of C opp,B holds /*S is Functor of C , B;



definition
  let C,B;
  let S be Function of the carrier' of C,the carrier' of B;
  func *'S -> Function of the carrier' of C opp,the carrier' of B means


  for f being Morphism of C opp holds it.f = S.(opp f);
  func S*' -> Function of the carrier' of C,the carrier' of B opp means


  for f being Morphism of C holds it.f = (S.f) opp;
end;

theorem 
  for S being Function of the carrier' of C,the carrier' of B for f
  being Morphism of C holds (*'S).(f opp) = S.f;

theorem 
  for S being Functor of C,B, c being Object of C opp holds (Obj
  *'S).c = (Obj S).(opp c);

theorem 
  for S being Functor of C,B, c being Object of C holds (Obj *'S).(c opp
  ) = (Obj S).c;

theorem 
  for S being Functor of C,B, c being Object of C holds (Obj S*').
  c = ((Obj S).c) opp;

theorem 
  for S being Contravariant_Functor of C,B, c being Object of C
  opp holds (Obj *'S).c = (Obj S).(opp c);

theorem 
  for S being Contravariant_Functor of C,B, c being Object of C holds (
  Obj *'S).(c opp) = (Obj S).c;

theorem 
  for S being Contravariant_Functor of C,B, c being Object of C
  holds (Obj S*').c = ((Obj S).c) opp;

theorem 
  for F being Function of the carrier' of C,the carrier' of D for
  f being Morphism of C holds *'F*'.(f opp) = (F.f) opp;

theorem 
  for S being Function of the carrier' of C,the carrier' of D holds /*(*'S) = S
;

theorem 
  for S being Function of the carrier' of C opp,the carrier' of D holds
  *'(/*S) = S;

theorem 
  for S being Function of the carrier' of C, the carrier' of D holds *'S
  *' = *'(S*');

theorem 
  for D being strict Category, S being Function of the carrier' of C,
  the carrier' of D holds S*'*' = S;

theorem 
  for C being strict Category, S being Function of the carrier' of C,
  the carrier' of D holds *'*'S = S;

theorem 
  for S being Function of the carrier' of C,the carrier' of B for T
  being Function of the carrier' of B,the carrier' of D holds *'(T*S) = T*(*'S)
;

theorem 
  for S being Function of the carrier' of C,the carrier' of B for T
  being Function of the carrier' of B,the carrier' of D holds (T*S)*' = T*'*S;

theorem 
  for F1 being Function of the carrier' of C,the carrier' of B for F2
being Function of the carrier' of B,the carrier' of D holds *'(F2*F1)*' = (*'F2
  *')*(*'F1*');

theorem 
  for S being Contravariant_Functor of C,D holds *'S is Functor of C opp,D;

theorem 
  for S being Contravariant_Functor of C,D holds S*' is Functor of C, D opp;

theorem 
  for S being Functor of C,D holds *'S is Contravariant_Functor of C opp,D;

theorem 
  for S being Functor of C,D holds S*' is Contravariant_Functor of C, D opp;

theorem 
  for S1 being Contravariant_Functor of C,B, S2 being Functor of B,D
  holds S2*S1 is Contravariant_Functor of C,D;

theorem 
  for S1 being Functor of C,B, S2 being Contravariant_Functor of B,D
  holds S2*S1 is Contravariant_Functor of C,D;

theorem 
  for F being Functor of C,D, c being Object of C holds (Obj *'F*').(c
  opp) = ((Obj F).c) opp;

theorem 
  for F being Contravariant_Functor of C,D, c being Object of C holds (
  Obj *'F*').(c opp) = ((Obj F).c) opp;

theorem 
  for F being Functor of C,D holds *'F*' is Functor of C opp,D opp;

theorem 
  for F being Contravariant_Functor of C,D holds *'F*' is
  Contravariant_Functor of C opp,D opp;



definition
  let C;
  func id* C -> Contravariant_Functor of C,C opp equals

  (id C)*';
  func *id C -> Contravariant_Functor of C opp,C equals

  *'(id C);
end;

theorem 
  for f being Morphism of C holds (id* C).f = f opp;

theorem 
  for c being Object of C holds (Obj id* C).c = c opp;

theorem 
  for f being Morphism of C opp holds (*id C).f = opp f;

theorem 
  for c being Object of C opp holds (Obj *id C).c = opp c;

theorem 
  for S being Function of the carrier' of C,the carrier' of D holds *'S
  = S*(*id C) & S*' = (id* D)*S;

theorem 
  for a,b,c being Object of C st Hom(a,b) <> {} & Hom(b,c) <> {}
  for f being Morphism of a,b, g being Morphism of b,c
   holds g*f = (f opp)*(g opp);

theorem 
 for a being Object of C holds id a = id(a opp);

theorem 
 for a being Object of C opp holds id a = id opp a;














begin

definition
  let IT be OrtAfSp;
  attr IT is Euclidean means


  for a,b,c,d being Element
  of IT st a,b _|_ c,d & b,c _|_ a,d holds b,d _|_ a,c;
end;

definition
  let IT be OrtAfSp;
  attr IT is Pappian means


  Af(IT) is Pappian;
end;

definition
  let IT be OrtAfSp;
  attr IT is Desarguesian means


  Af(IT) is Desarguesian;
end;

definition
  let IT be OrtAfSp;
  attr IT is Fanoian means


  Af(IT) is Fanoian;
end;

definition
  let IT be OrtAfSp;
  attr IT is Moufangian means


  Af(IT) is Moufangian;
end;

definition
  let IT be OrtAfSp;
  attr IT is translation means


  Af(IT) is translational;
end;

definition
  let IT be OrtAfSp;
  attr IT is Homogeneous means


  for o,a,a1,b,b1,c,c1 being Element of IT
st o,a _|_ o,a1 & o,b _|_ o,b1 & o,c _|_ o,c1 & a,b _|_ a1,b1 & a,c _|_ a1,c1 &
  not o,c // o,a & not o,a // o,b holds b,c _|_ b1,c1;
end;

reserve MS for OrtAfPl;
reserve MP for OrtAfSp;

theorem 
  for a,b,c being Element of MP st not LIN a,b,c holds a<>b & b<>c & a<>c;

theorem 
  for a,b,c,d being Element of MS, K being Subset of the carrier of
  MS st a,b _|_ K & c,d _|_ K holds a,b // c,d & a,b // d,c;

theorem 
  for a,b being Element of MS, A,K being Subset of the carrier of MS st
  a<>b & (a,b _|_ K or b,a _|_ K) & a,b _|_ A holds K // A;

theorem 
  for x,y,z being Element of MP st LIN x,y,z holds LIN x,z,y & LIN
  y,x,z & LIN y,z,x & LIN z,x,y & LIN z,y,x;

theorem 
  for a,b,c being Element of MS st not LIN a,b,c ex d being Element
  of MS st d,a _|_ b,c & d,b _|_ a,c;

theorem 
  for a,b,c,d1,d2 being Element of MS st not LIN a,b,c & d1,a _|_ b
  ,c & d1,b _|_ a,c & d2,a _|_ b,c & d2,b _|_ a,c holds d1=d2;

theorem 
  for a,b,c,d being Element of MS st a,b _|_ c,d & b,c _|_ a,d &
  LIN a,b,c holds (a=c or a=b or b=c);

theorem 
  MS is Euclidean iff MS is satisfying_3H;

theorem 
  MS is Homogeneous iff MS is satisfying_ODES;

theorem 
  MS is Pappian iff MS is satisfying_PAP;

theorem 
  MS is Desarguesian iff MS is satisfying_DES;

theorem 
  MS is Moufangian iff MS is satisfying_TDES;

theorem 
  MS is translation iff MS is satisfying_des;

theorem 
  MS is Homogeneous implies MS is Desarguesian;

theorem 
  MS is Euclidean Desarguesian implies MS is Pappian;

reserve V for RealLinearSpace;
reserve w,y,u,v for VECTOR of V;

theorem 
  for o,c,c1,a,a1,a2 being Element of MS st not LIN o,c,a & o<>c1
  & o,c _|_ o,c1 & o,a _|_ o,a1 & o,a _|_ o,a2 & c,a _|_ c1,a1 & c,a _|_ c1,a2
  holds a1=a2;

theorem 
  for o,c,c1,a being Element of MS st not LIN o,c,a ex a1 being Element
  of MS st o,a _|_ o,a1 & c,a _|_ c1,a1;

theorem 
  for a,b being Real st Gen w,y & 0.V<>u & 0.V<>v & u,v
  are_Ort_wrt w,y & u=a*w+b*y ex c being Real st c <>0 & v=(c*b)*w+(-c*a)*y;

theorem 
  Gen w,y & 0.V<>u & 0.V<>v & u,v are_Ort_wrt w,y implies ex c
being Real st for a,b being Real holds a*w+b*y,(c*b)*w+(-c*a)*y are_Ort_wrt w,y
  & (a*w+b*y)-u,((c*b)*w+(-c*a)*y)-v are_Ort_wrt w,y;

theorem 
  Gen w,y & MS = AMSpace(V,w,y) implies MS is satisfying_LIN;

theorem 
  for o,a,a1,b,b1,c,c1 being Element of MS st o,b _|_ o,b1 & o,c
_|_ o,c1 & a,b _|_ a1,b1 & a,c _|_ a1,c1 & not o,c // o,a & not o,a // o,b & o=
  a1 holds b,c _|_ b1,c1;

theorem 
  Gen w,y & MS = AMSpace(V,w,y) implies MS is Homogeneous;

registration
  cluster Euclidean Pappian Desarguesian Homogeneous translation Fanoian
    Moufangian for OrtAfPl;
end;

registration
  cluster Euclidean Pappian Desarguesian Homogeneous translation Fanoian
    Moufangian for OrtAfSp;
end;

theorem 
  Gen w,y & MS=AMSpace(V,w,y) implies MS is Euclidean Pappian
  Desarguesian Homogeneous translation Fanoian Moufangian OrtAfPl;

registration
  let MS be Pappian OrtAfPl;
  cluster Af(MS) -> Pappian;
end;

registration
  let MS be Desarguesian OrtAfPl;
  cluster Af(MS) -> Desarguesian;
end;

registration
  let MS be Moufangian OrtAfPl;
  cluster Af(MS) -> Moufangian;
end;

registration
  let MS be translation OrtAfPl;
  cluster Af(MS) -> translational;
end;

registration
  let MS be Fanoian OrtAfPl;
  cluster Af(MS) -> Fanoian;
end;

registration
  let MS be Homogeneous OrtAfPl;
  cluster Af(MS) -> Desarguesian;
end;

registration
  let MS be Euclidean Desarguesian OrtAfPl;
  cluster Af(MS) -> Pappian;
end;

registration
  let MS be Pappian OrtAfSp;
  cluster Af(MS) -> Pappian;
end;

registration
  let MS be Desarguesian OrtAfSp;
  cluster Af(MS) -> Desarguesian;
end;

registration
  let MS be Moufangian OrtAfSp;
  cluster Af(MS) -> Moufangian;
end;

registration
  let MS be translation OrtAfSp;
  cluster Af(MS) -> translational;
end;

registration
  let MS be Fanoian OrtAfSp;
  cluster Af(MS) -> Fanoian;
end;















begin

reserve L,L1,L2 for Lattice,
  F1,F2 for Filter of L,
  p,q,r,s for Element of L,
  p1,q1,r1,s1 for Element of L1,
  p2,q2,r2,s2 for Element of L2,
  X,x,x1,x2,y,y1,y2 for set,
  D,D1,D2 for non empty set,
  R for Relation,
  RD for Equivalence_Relation of D,
  a,b,d for Element of D,
  a1,b1,c1 for Element of D1,
  a2,b2,c2 for Element of D2,
  B for B_Lattice,
  FB for Filter of B,
  I for I_Lattice,
  FI for Filter of I ,
  i,i1,i2,j,j1,j2,k for Element of I,
  f1,g1 for BinOp of D1,
  f2,g2 for BinOp of D2;

theorem 
  F1 /\ F2 is Filter of L;

theorem 
  <.p.) = <.q.) implies p = q;

definition
  let L,F1,F2;
  redefine func F1 /\ F2 -> Filter of L;
end;

definition
  let D,R;
  mode UnOp of D,R -> UnOp of D means


    for x,y being Element of D st [x, y] in R holds [it.x,it.y] in R;
  mode BinOp of D,R -> BinOp of D means


    for x1,y1, x2,y2 being Element
    of D st [x1,y1] in R & [x2,y2] in R holds [it.(x1,x2),it.(y1,y2)] in R;
end;

reserve F,G for BinOp of D,RD;

definition
  let D;
  let R be Equivalence_Relation of D;
  mode UnOp of R is UnOp of D,R;
  mode BinOp of R is BinOp of D,R;
end;

definition
  let D;
  let R be Equivalence_Relation of D;
  let u be UnOp of D;
  assume
 u is UnOp of D,R;
  func u /\/ R -> UnOp of Class R means

  for x,y st x in Class R & y in x holds it.x = Class(R,u.y);
end;

definition
  let D;
  let R be Equivalence_Relation of D;
  let b be BinOp of D;
  assume
 b is BinOp of D,R;
  func b /\/ R -> BinOp of Class R means


  for x,y, x1,y1 st x in Class R
  & y in Class R & x1 in x & y1 in y holds it.(x,y) = Class(R,b.(x1,y1));
end;

theorem 
  (F /\/ RD).(Class(RD,a), Class(RD,b)) = Class(RD, F.(a,b));

scheme 

  SchAux1 { D()->non empty set, R()->Equivalence_Relation of D(), P[set] }:
  for x being Element of Class R() holds P[x]
provided
 for x being Element of D() holds P[EqClass(R(),x)];

scheme 

  SchAux2 { D()->non empty set, R()->Equivalence_Relation of D(), P[set,set] }
  : for x,y being Element of Class R() holds P[x,y]
provided
 for x,y being Element of D() holds P[EqClass(R(),x),EqClass(R(),y)];

scheme 

  SchAux3 { D()->non empty set, R()->Equivalence_Relation of D(), P[set,set,
  set] }: for x,y,z being Element of Class R() holds P[x,y,z]
provided
 for x,y,z being Element of D() holds P[EqClass(R(),x),EqClass(R(),y)
,EqClass(R(),z)];

theorem 
  F is commutative implies F/\/RD is commutative;

theorem 
  F is associative implies F/\/RD is associative;

theorem 
  d is_a_left_unity_wrt F implies EqClass(RD,d) is_a_left_unity_wrt F/\/RD;

theorem 
  d is_a_right_unity_wrt F implies EqClass(RD,d) is_a_right_unity_wrt F/\/RD;

theorem 
  d is_a_unity_wrt F implies EqClass(RD,d) is_a_unity_wrt F/\/RD;

theorem 
  F is_left_distributive_wrt G implies F/\/RD is_left_distributive_wrt G/\/RD;

theorem 
  F is_right_distributive_wrt G implies F/\/RD is_right_distributive_wrt G/\/RD
;

theorem 
  F is_distributive_wrt G implies F/\/RD is_distributive_wrt G/\/RD;

theorem 
  F absorbs G implies F/\/RD absorbs G/\/RD;

theorem 
  the L_join of I is BinOp of the carrier of I, equivalence_wrt FI;

theorem 
  the L_meet of I is BinOp of the carrier of I, equivalence_wrt FI;

definition
  let L be Lattice, F be Filter of L;
  assume
 L is I_Lattice;
  func L /\/ F -> strict Lattice means


  for R being
  Equivalence_Relation of the carrier of L st R = equivalence_wrt F holds it =
  LattStr (#Class R, (the L_join of L)/\/R, (the L_meet of L)/\/R#);
end;

definition
  let L be Lattice, F be Filter of L, a be Element of L;
  assume
 L is I_Lattice;
  func a /\/ F -> Element of L /\/ F means


  for R being
  Equivalence_Relation of the carrier of L st R = equivalence_wrt F holds it =
  Class(R, a);
end;

theorem 
  (i/\/FI) "\/" (j/\/FI) = (i"\/"j)/\/FI & (i/\/FI) "/\" (j/\/FI)
  = (i"/\"j)/\/FI;

theorem 
  i/\/FI [= j/\/FI iff i => j in FI;

theorem 
  (i"/\"j) => k = i => (j => k);

theorem 
  I is lower-bounded implies I/\/FI is 0_Lattice & Bottom (I/\/FI)
  = (Bottom I)/\/FI;

theorem 
  I/\/FI is 1_Lattice & Top (I/\/FI) = (Top I)/\/FI;

registration
  let I,FI;
  cluster I/\/FI -> implicative;
end;

theorem 
  B/\/FB is B_Lattice;

definition
  let D1,D2 be set;
  let f1 be BinOp of D1;
  let f2 be BinOp of D2;
  redefine func |:f1,f2:| -> BinOp of [:D1,D2:];
end;

theorem 
  |:f1,f2:|.([a1,a2],[b1,b2]) = [f1.(a1,b1),f2.(a2,b2)];

scheme 

  AuxCart1 { D1() -> non empty set, D2() -> non empty set, P[set] }: for d
  being Element of [:D1(),D2():] holds P[d]
provided
 for d1 being Element of D1(), d2 being Element of D2() holds P[[d1, d2]];

scheme 

  AuxCart2 { D1() -> non empty set, D2() -> non empty set, P[set,set] }: for d
  ,d9 being Element of [:D1(),D2():] holds P[d,d9]
provided
 for d1,d19 being Element of D1(), d2,d29 being Element of D2() holds
P[[d1,d2],[d19,d29]];

scheme 

  AuxCart3 { D1() -> non empty set, D2() -> non empty set, P[set,set,set] }:
  for a,b,c being Element of [:D1(),D2():] holds P[a,b,c]
provided
 for a1,b1,c1 being Element of D1(), a2,b2,c2 being Element of D2()
holds P[[a1,a2],[b1,b2],[c1,c2]];

theorem 
  f1 is commutative & f2 is commutative iff |:f1,f2:| is commutative;

theorem 
  f1 is associative & f2 is associative iff |:f1,f2:| is associative;

theorem 
  a1 is_a_left_unity_wrt f1 & a2 is_a_left_unity_wrt f2 iff [a1,a2
  ] is_a_left_unity_wrt |:f1,f2:|;

theorem 
  a1 is_a_right_unity_wrt f1 & a2 is_a_right_unity_wrt f2 iff [a1,
  a2] is_a_right_unity_wrt |:f1,f2:|;

theorem 
  a1 is_a_unity_wrt f1 & a2 is_a_unity_wrt f2 iff [a1,a2] is_a_unity_wrt
  |:f1,f2:|;

theorem 
  f1 is_left_distributive_wrt g1 & f2 is_left_distributive_wrt g2
  iff |:f1,f2:| is_left_distributive_wrt |:g1,g2:|;

theorem 
  f1 is_right_distributive_wrt g1 & f2 is_right_distributive_wrt
  g2 iff |:f1,f2:| is_right_distributive_wrt |:g1,g2:|;

theorem 
  f1 is_distributive_wrt g1 & f2 is_distributive_wrt g2 iff |:f1,
  f2:| is_distributive_wrt |:g1,g2:|;

theorem 
  f1 absorbs g1 & f2 absorbs g2 iff |:f1,f2:| absorbs |:g1,g2:|;

definition
  let L1,L2 be non empty LattStr;
  func [:L1,L2:] -> strict LattStr equals

  LattStr (#[:the carrier of L1, the
carrier of L2:], |:the L_join of L1, the L_join of L2:|, |:the L_meet of L1,
    the L_meet of L2:|#);
end;

registration
  let L1,L2 be non empty LattStr;
  cluster [:L1,L2:] -> non empty;
end;

definition
  let L be Lattice;
  func LattRel L -> Relation equals

  { [p,q] where p is Element of L, q is
  Element of L: p [= q };
end;

theorem 
  [p,q] in LattRel L iff p [= q;

theorem 
  dom LattRel L = the carrier of L & rng LattRel L = the carrier
  of L & field LattRel L = the carrier of L;

definition
  let L1,L2 be Lattice;
  pred L1,L2 are_isomorphic means

  LattRel L1, LattRel L2 are_isomorphic;
  reflexivity;
  symmetry;
end;

registration
  let L1,L2 be Lattice;
  cluster [:L1,L2:] -> Lattice-like;
end;

theorem 
  for L1,L2,L3 being Lattice st L1,L2 are_isomorphic & L2,L3
  are_isomorphic holds L1,L3 are_isomorphic;

theorem 
  for L1,L2 being non empty LattStr st [:L1,L2:] is Lattice holds L1 is
  Lattice & L2 is Lattice;

definition
  let L1,L2 be Lattice;
  let a be Element of L1, b be Element of L2;
  redefine func [a,b] -> Element of [:L1,L2:];
end;

theorem 
  [p1,p2] "\/" [q1,q2] = [p1"\/"q1,p2"\/"q2] & [p1,p2] "/\" [q1,q2] = [
  p1"/\"q1,p2"/\"q2];

theorem 
  [p1,p2] [= [q1,q2] iff p1 [= q1 & p2 [= q2;

theorem 
  L1 is modular & L2 is modular iff [:L1,L2:] is modular;

theorem 
  L1 is D_Lattice & L2 is D_Lattice iff [:L1,L2:] is D_Lattice;

theorem 
  L1 is lower-bounded & L2 is lower-bounded iff [:L1,L2:] is lower-bounded;

theorem 
  L1 is upper-bounded & L2 is upper-bounded iff [:L1,L2:] is upper-bounded;

theorem 
  L1 is bounded & L2 is bounded iff [:L1,L2:] is bounded;

theorem 
  L1 is 0_Lattice & L2 is 0_Lattice implies Bottom [:L1,L2:] = [
  Bottom L1, Bottom L2];

theorem 
  L1 is 1_Lattice & L2 is 1_Lattice implies Top [:L1,L2:] = [Top L1,Top L2];

theorem 
  L1 is 01_Lattice & L2 is 01_Lattice implies (p1
is_a_complement_of q1 & p2 is_a_complement_of q2 iff [p1,p2] is_a_complement_of
  [q1,q2]);

theorem 
  L1 is C_Lattice & L2 is C_Lattice iff [:L1,L2:] is C_Lattice;

theorem 
  L1 is B_Lattice & L2 is B_Lattice iff [:L1,L2:] is B_Lattice;

theorem 
  L1 is implicative & L2 is implicative iff [:L1,L2:] is implicative;

theorem 
  [:L1,L2:].: = [:L1.:,L2.: :];

theorem 
  [:L1,L2:], [:L2,L1:] are_isomorphic;

reserve B for B_Lattice,
  a,b,c,d for Element of B;

theorem 
  a <=> b = (a"/\"b)"\/"(a`"/\"b`);

theorem 
  (a => b)` = a "/\" b` & (a <=> b)` = (a "/\" b`) "\/" (a` "/\" b
  ) & (a <=> b)` = a <=> b` & (a <=> b)` = a` <=> b;

theorem 
  a <=> b = a <=> c implies b = c;

theorem 
  a <=> (a <=> b) = b;

theorem 
  (i"\/"j) => i = j => i & i => (i"/\"j) = i => j;

theorem 
  i => j [= i => (j"\/"k) & i => j [= (i"/\"k) => j & i => j [= i
  => (k"\/"j) & i => j [= (k"/\"i) => j;

theorem 
  (i => k)"/\"(j => k) [= (i"\/"j) => k;

theorem 
  (i => j)"/\"(i => k) [= i => (j"/\"k);

theorem 
  i1 <=> i2 in FI & j1 <=> j2 in FI implies (i1"\/"j1) <=> (i2"\/"
  j2) in FI & (i1"/\"j1) <=> (i2"/\"j2) in FI;

theorem 
  i in Class(equivalence_wrt FI,k) & j in Class(equivalence_wrt FI
  ,k) implies i"\/"j in Class(equivalence_wrt FI,k) & i"/\" j in Class(
  equivalence_wrt FI,k);

theorem 
  c"\/"(c <=>d) in Class(equivalence_wrt <.d.),c) & for b st b in
  Class(equivalence_wrt <.d.),c) holds b [= c"\/"(c <=>d);

theorem 
  B, [:B/\/<.a.),latt <.a.):] are_isomorphic;














begin

reserve X for AffinPlane;
reserve o,a,a1,a2,a3,a4,b,b1,b2,b3,b4,c,c1,c2,d,d1,d2, d3,d4,d5,e1,e2,x,y,z
  for Element of X;
reserve Y,Z,M,N,A,K,C for Subset of X;

definition
  let X;
  attr X is satisfying_minor_Scherungssatz means


  for a1,a2,a3,a4,b1,b2,
b3,b4,M,N st M // N & a1 in M & a3 in M & b1 in M & b3 in M & a2 in N & a4 in N
  & b2 in N & b4 in N & not a4 in M & not a2 in M & not b2 in M & not b4 in M &
not a1 in N & not a3 in N & not b1 in N & not b3 in N & a3,a2 // b3,b2 & a2,a1
  // b2,b1 & a1,a4 // b1,b4 holds a3,a4 // b3,b4;
end;

definition
  let X;
  attr X is satisfying_major_Scherungssatz means


  for o,a1,a2,a3,a4,b1,
b2,b3,b4,M,N st M is being_line & N is being_line & o in M & o in N & a1 in M &
a3 in M & b1 in M & b3 in M & a2 in N & a4 in N & b2 in N & b4 in N & not a4 in
  M & not a2 in M & not b2 in M & not b4 in M & not a1 in N & not a3 in N & not
b1 in N & not b3 in N & a3,a2 // b3,b2 & a2,a1 // b2,b1 & a1,a4 // b1,b4 holds
  a3,a4 // b3,b4;
end;

definition
  let X;
  attr X is satisfying_Scherungssatz means


  for a1,a2,a3,a4,b1,b2,b3,b4,
M,N st M is being_line & N is being_line & a1 in M & a3 in M & b1 in M & b3 in
M & a2 in N & a4 in N & b2 in N & b4 in N & not a4 in M & not a2 in M & not b2
in M & not b4 in M & not a1 in N & not a3 in N & not b1 in N & not b3 in N & a3
  ,a2 // b3,b2 & a2,a1 // b2,b1 & a1,a4 // b1,b4 holds a3,a4 // b3,b4;
end;

definition
  let X;
  attr X is satisfying_indirect_Scherungssatz means


  for a1,a2,a3,a4,b1,
b2,b3,b4,M,N st M is being_line & N is being_line & a1 in M & a3 in M & b2 in M
& b4 in M & a2 in N & a4 in N & b1 in N & b3 in N & not a4 in M & not a2 in M &
not b1 in M & not b3 in M & not a1 in N & not a3 in N & not b2 in N & not b4 in
  N & a3,a2 // b3,b2 & a2,a1 // b2,b1 & a1,a4 // b1,b4 holds a3,a4 // b3,b4;
end;

definition
  let X;
  attr X is satisfying_minor_indirect_Scherungssatz means


  for a1,a2,a3,
a4,b1,b2,b3,b4,M,N st M // N & a1 in M & a3 in M & b2 in M & b4 in M & a2 in N
  & a4 in N & b1 in N & b3 in N & not a4 in M & not a2 in M & not b1 in M & not
b3 in M & not a1 in N & not a3 in N & not b2 in N & not b4 in N & a3,a2 // b3,
  b2 & a2,a1 // b2,b1 & a1,a4 // b1,b4 holds a3,a4 // b3,b4;
end;

definition
  let X;
  attr X is satisfying_major_indirect_Scherungssatz means


  for o,a1,a2,
a3,a4,b1,b2,b3,b4,M,N st M is being_line & N is being_line & o in M & o in N &
a1 in M & a3 in M & b2 in M & b4 in M & a2 in N & a4 in N & b1 in N & b3 in N &
not a4 in M & not a2 in M & not b1 in M & not b3 in M & not a1 in N & not a3 in
N & not b2 in N & not b4 in N & a3,a2 // b3,b2 & a2,a1 // b2,b1 & a1,a4 // b1,
  b4 holds a3,a4 // b3,b4;
end;

theorem 
  X is satisfying_indirect_Scherungssatz iff X is
  satisfying_minor_indirect_Scherungssatz & X is
  satisfying_major_indirect_Scherungssatz;

theorem 
  X is satisfying_Scherungssatz iff X is
  satisfying_minor_Scherungssatz & X is satisfying_major_Scherungssatz;

theorem 
  X is satisfying_minor_indirect_Scherungssatz implies X is
  satisfying_minor_Scherungssatz;

theorem 
  X is satisfying_major_indirect_Scherungssatz implies X is
  satisfying_major_Scherungssatz;

theorem 
  X is satisfying_indirect_Scherungssatz implies X is satisfying_Scherungssatz;

theorem 
  X is translational implies X is satisfying_minor_Scherungssatz;

theorem 
  X is Desarguesian implies X is satisfying_major_Scherungssatz;

theorem 
  X is Desarguesian iff X is satisfying_Scherungssatz;

theorem 
  X is satisfying_pap iff X is satisfying_minor_indirect_Scherungssatz;

theorem 
  X is Pappian iff X is satisfying_major_indirect_Scherungssatz;

theorem 
  X is satisfying_PPAP iff X is satisfying_indirect_Scherungssatz;

theorem 
  X is satisfying_major_indirect_Scherungssatz implies X is
  satisfying_minor_indirect_Scherungssatz;

reserve X for OrtAfPl;
reserve o9,a9,a19,a29,a39,a49,b9,b19,b29,b39,b49,c9,c19 for Element of X;
reserve o,a,a1,a2,a3,a4,b,b1,b2,b3,b4,c,c1 for Element of Af(X);
reserve M9,N9 for Subset of X;
reserve A,M,N for Subset of Af(X);

theorem 
  Af(X) is satisfying_Scherungssatz iff X is satisfying_SCH;

theorem 
  X is satisfying_TDES iff Af(X) is Moufangian;

theorem 
  Af(X) is translational iff X is satisfying_des;

theorem 
  X is satisfying_PAP iff Af(X) is Pappian;

theorem 
  X is satisfying_DES iff Af(X) is Desarguesian;















begin 

reserve n,m for Nat;

definition

  func hcflat -> BinOp of NAT means


  it.(m,n) = m gcd n;
  func lcmlat -> BinOp of NAT means


  it.(m,n) = m lcm n;
end;

definition
  func Nat_Lattice -> strict non empty LattStr equals

  LattStr(# NAT, lcmlat, hcflat #);
end;

registration
  cluster the carrier of Nat_Lattice -> natural-membered;
end;

reserve p,q,r for Element of Nat_Lattice;

registration
  let p,q;
  identify p"\/"q with p lcm q;
  identify p"/\"q with p gcd q;
end;

theorem 
  p"\/"q =p lcm q;

theorem 
  p"/\"q = p gcd q;

theorem 
  for a,b being Element of Nat_Lattice st a [= b holds a divides b;

definition
  func 0_NN -> Element of Nat_Lattice equals

  1;
  func 1_NN -> Element of Nat_Lattice equals

  0;
end;

theorem 
  0_NN=1;

registration
  cluster Nat_Lattice -> Lattice-like;
end;

registration
  cluster Nat_Lattice -> strict;
end;

reserve p,q,r for Element of Nat_Lattice;

registration
  cluster Nat_Lattice -> lower-bounded;
end;

theorem 
  lcmlat.(p,q)=lcmlat.(q,p);

theorem 
  hcflat.(q,p)=hcflat.(p,q);

theorem 
  lcmlat.(p,lcmlat.(q,r)) = lcmlat.(lcmlat.(p,q),r);

theorem 
  lcmlat.(p,lcmlat.(q,r)) = lcmlat.(lcmlat.(q,p),r) & lcmlat.(p,lcmlat.(
q,r)) = lcmlat.(lcmlat.(p,r),q) & lcmlat.(p,lcmlat.(q,r)) = lcmlat.(lcmlat.(r,q
  ),p) & lcmlat.(p,lcmlat.(q,r)) = lcmlat.(lcmlat.(r,p),q);

theorem 
  hcflat.(p,hcflat.(q,r)) = hcflat.(hcflat.(p,q),r);

theorem 
  hcflat.(p,hcflat.(q,r)) = hcflat.(hcflat.(q,p),r) & hcflat.(p,hcflat.(
q,r)) = hcflat.(hcflat.(p,r),q) & hcflat.(p,hcflat.(q,r)) = hcflat.(hcflat.(r,q
  ),p) & hcflat.(p,hcflat.(q,r)) = hcflat.(hcflat.(r,p),q);

theorem 
  hcflat.(q,lcmlat.(q,p))=q & hcflat.(lcmlat.(p,q),q)=q & hcflat.(q,
  lcmlat.(p,q))=q & hcflat.(lcmlat.(q,p),q)=q;

theorem 
  lcmlat.(q,hcflat.(q,p))=q & lcmlat.(hcflat.(p,q),q)=q & lcmlat.(q,
  hcflat.(p,q))=q & lcmlat.(hcflat.(q,p),q)=q;



definition

  func NATPLUS -> Subset of NAT means


  for n being Nat holds n in it iff 0 < n;
end;

registration
  cluster NATPLUS -> non empty;
end;

definition
  let D be non empty set, S be non empty Subset of D,
      N be non empty Subset of S;
  redefine mode Element of N -> Element of S;
end;

registration
  let D be Subset of REAL;
  cluster -> real for Element of D;
end;

registration
  let D be Subset of NAT;
  cluster -> real for Element of D;
end;

definition
  mode NatPlus is Element of NATPLUS;
end;



definition
  let k be Nat such that
 k > 0;
  func @k -> NatPlus equals


  k;
end;

registration
  cluster -> natural non zero for NatPlus;
end;

reserve m,n for NatPlus;

definition

  func hcflatplus -> BinOp of NATPLUS means


  it.(m,n) = m gcd n;
  func lcmlatplus -> BinOp of NATPLUS means


  it.(m,n) = m lcm n;
end;

definition
  func NatPlus_Lattice -> strict LattStr equals

  LattStr (# NATPLUS, lcmlatplus, hcflatplus #);
end;

registration
  cluster NatPlus_Lattice -> non empty;
end;

definition
  let m be Element of NatPlus_Lattice;
  func @m -> NatPlus equals

  m;
end;

registration
  cluster -> natural non zero for Element of NatPlus_Lattice;
end;

reserve p,q for Element of NatPlus_Lattice;

registration
  let p,q be Element of NatPlus_Lattice;
  identify p"\/"q with p lcm q;
  identify p"/\"q with p gcd q;
end;

theorem 
  p"\/"q =@p lcm @q;

theorem 
  p"/\"q = @p gcd @q;

registration
  cluster NatPlus_Lattice -> join-commutative join-associative
    meet-commutative meet-associative join-absorbing meet-absorbing;
end;

definition
  let L be Lattice;
  mode SubLattice of L -> Lattice means


    the carrier of it c= the
carrier of L & the L_join of it = (the L_join of L)||the carrier of it & the
    L_meet of it = (the L_meet of L)||the carrier of it;
end;

registration
  let L be Lattice;
  cluster strict for SubLattice of L;
end;

theorem 
  for L being Lattice holds L is SubLattice of L;

theorem 
  NatPlus_Lattice is SubLattice of Nat_Lattice;














begin 

reserve x,y for set,
  k,n for Element of NAT,
  i for Integer,
  G for Group,
  a,b,c ,d,e for Element of G,
  A,B,C,D for Subset of G,
  H,H1,H2,H3,H4 for Subgroup of G ,
  N1,N2 for normal Subgroup of G,
  F,F1,F2 for FinSequence of the carrier of G,
  I,I1,I2 for FinSequence of INT;

theorem 
  x in (1).G iff x = 1_G;

theorem 
  a in H & b in H implies a |^ b in H;

theorem 
  for N being strict normal Subgroup of G holds a in N implies a |^ b in N;

theorem 
  x in H1 * H2 iff ex a,b st x = a * b & a in H1 & b in H2;

theorem 
  H1 * H2 = H2 * H1 implies (x in H1 "\/" H2 iff ex a,b st x = a *
  b & a in H1 & b in H2);

theorem 
  G is commutative Group implies (x in H1 "\/" H2 iff ex a,b st x = a *
  b & a in H1 & b in H2);

theorem 
  for N1,N2 being strict normal Subgroup of G holds x in N1 "\/" N2
  iff ex a,b st x = a * b & a in N1 & b in N2;

theorem 
  for N being normal Subgroup of G holds H * N = N * H;

definition
  let G,F,a;
  func F |^ a -> FinSequence of the carrier of G means


  len it = len F & for k be Nat st k in dom F holds it.k = (F/.k) |^ a;
end;

theorem 
  (F1 |^ a) ^ (F2 |^ a) = (F1 ^ F2) |^ a;

theorem 
  (<*> the carrier of G) |^ a = {};

theorem 
  <* a *> |^ b = <* a |^ b *>;

theorem 
  <* a,b *> |^ c = <* a |^ c,b |^ c *>;

theorem 
  <* a,b,c *> |^ d = <* a |^ d,b |^ d,c |^ d *>;

theorem 
  Product(F |^ a) = Product(F) |^ a;

theorem 
  (F |^ a) |^ I = (F |^ I) |^ a;

begin 

definition
  let G,a,b;
  func [.a,b.] -> Element of G equals

  a" * b" * a * b;
end;

theorem 
  [.a,b.] = a" * b" * a * b & [.a,b.] = a" * (b" * a) * b & [.a,b
.] = a" * (b" * a * b) & [.a,b.] = a" * (b" * (a * b)) & [.a,b.] = (a" * b") *
  (a * b);

theorem 
  [.a,b.] = (b * a)" * (a * b);

theorem 
  [.a,b.] = (b" |^ a) * b & [.a,b.] = a" * (a |^ b);

theorem 
  [.1_G,a.] = 1_G & [.a,1_G.] = 1_G;

theorem 
  [.a,a.] = 1_G;

theorem 
  [.a,a".] = 1_G & [.a",a.] = 1_G;

theorem 
  [.a,b.]" = [.b,a.];

theorem 
  [.a,b.] |^ c = [.a |^ c,b |^ c.];

theorem 
  [.a,b.] = (a" |^ 2) * ((a * b") |^ 2)* (b |^ 2);

theorem 
  [.a * b,c.] = [.a,c.] |^ b * [.b,c.];

theorem 
  [.a,b * c.] = [.a,c.] * ([.a,b.] |^ c);

theorem 
  [.a",b.] = [.b,a.] |^ a";

theorem 
  [.a,b".] = [.b,a.] |^ b";

theorem 
  [.a",b".] = [.a,b.] |^ (a * b)" & [.a",b".] = [.a,b.] |^ (b * a)";

theorem 
  [.a,b |^ a".] = [.b,a".];

theorem 
  [.a |^ b",b.] = [.b",a.];

theorem 
  [.a |^ n,b.] = a |^ (- n) * ((a |^ b) |^ n);

theorem 
  [.a,b |^ n.] = (b |^ a) |^ (- n) * (b |^ n);

theorem 
  [.a |^ i,b.] = a |^ (- i) * ((a |^ b) |^ i);

theorem 
  [.a,b |^ i.] = (b |^ a) |^ (- i) * (b |^ i);

theorem 
  [.a,b.] = 1_G iff a * b = b * a;

theorem 
  G is commutative Group iff for a,b holds [.a,b.] = 1_G;

theorem 
  a in H & b in H implies [.a,b.] in H;

definition
  let G,a,b,c;
  func [.a,b,c.] -> Element of G equals

  [.[.a,b.],c.];
end;

theorem 
  [.a,b,1_G.] = 1_G & [.a,1_G,b.] = 1_G & [.1_G,a,b.] = 1_G;

theorem 
  [.a,a,b.] = 1_G;

theorem 
  [.a,b,a.] = [.a |^ b,a.];

theorem 
  [.b,a,a.] = ([.b,a".] * [.b,a.]) |^ a;

theorem 
  [.a,b,b |^ a.] = [.b,[.b,a.].];

theorem 
  [.a * b,c.] = [.a,c.] * [.a,c,b.] * [.b,c.];

theorem 
  [.a,b * c.] = [.a,c.] * [.a,b.] * [.a,b,c.];





theorem 
  ([.a,b",c.] |^ b) * ([.b,c",a.] |^ c) * ([.c,a",b.] |^ a) = 1_G;

definition
  let G,A,B;
  func commutators(A,B) -> Subset of G equals

  {[.a,b.] : a in A & b in B};
end;

theorem 
  x in commutators(A,B) iff ex a,b st x = [.a,b.] & a in A & b in B;

theorem 
  commutators({} the carrier of G,A) = {} & commutators(A,{} the carrier
  of G) = {};

theorem 
  commutators({a},{b}) = {[.a,b.]};

theorem 
  A c= B & C c= D implies commutators(A,C) c= commutators(B,D);

theorem 
  G is commutative Group iff for A,B st A <> {} & B <> {} holds
  commutators(A,B) = {1_G};

definition
  let G,H1,H2;
  func commutators(H1,H2) -> Subset of G equals

  commutators(carr H1,carr H2);
end;

theorem 
  x in commutators(H1,H2) iff ex a,b st x = [.a,b.] & a in H1 & b in H2;

theorem 
  1_G in commutators(H1,H2);

theorem 
  commutators((1).G,H) = {1_G} & commutators(H,(1).G) = {1_G};

theorem 
  for N being strict normal Subgroup of G holds commutators(H,N)
  c= carr N & commutators(N,H) c= carr N;

theorem 
  H1 is Subgroup of H2 & H3 is Subgroup of H4 implies commutators(
  H1,H3) c= commutators(H2,H4);

theorem 
  G is commutative Group iff for H1,H2 holds commutators(H1,H2) = {1_G};

definition
  let G;
  func commutators G -> Subset of G equals

  commutators((Omega).G,(Omega).G);
end;

theorem 
  x in commutators G iff ex a,b st x = [.a,b.];

theorem 
  G is commutative Group iff commutators G = {1_G};

definition
  let G,A,B;
  func [.A,B.] -> strict Subgroup of G equals

  gr commutators(A,B);
end;

theorem 
  a in A & b in B implies [.a,b.] in [.A,B.];

theorem 
  x in [.A,B.] iff ex F,I st len F = len I & rng F c= commutators(
  A,B) & x = Product(F |^ I);

theorem 
  A c= C & B c= D implies [.A,B.] is Subgroup of [.C,D.];

definition
  let G,H1,H2;
  func [.H1,H2.] -> strict Subgroup of G equals

  [.carr H1,carr H2.];
end;

theorem 
  [.H1,H2.] = gr commutators(H1,H2);

theorem 
  x in [.H1,H2.] iff ex F,I st len F = len I & rng F c= commutators(H1,
  H2) & x = Product(F |^ I);

theorem 
  a in H1 & b in H2 implies [.a,b.] in [.H1,H2.];

theorem 
  H1 is Subgroup of H2 & H3 is Subgroup of H4 implies [.H1,H3.] is
  Subgroup of [.H2,H4.];

theorem 
  for N being strict normal Subgroup of G holds [.N,H.] is Subgroup of N
  & [.H,N.] is Subgroup of N;

theorem 
  for N1,N2 being strict normal Subgroup of G holds [.N1,N2.] is
  normal Subgroup of G;

theorem 
  [.N1,N2.] = [.N2,N1.];

theorem 
  for N1,N2,N3 being strict normal Subgroup of G holds [.N1 "\/"
  N2,N3.] = [.N1,N3.] "\/" [.N2,N3.];

theorem 
  for N1,N2,N3 being strict normal Subgroup of G holds [.N1,N2 "\/" N3.]
  = [.N1,N2.] "\/" [.N1,N3.];

definition
  let G be Group;
  func G` -> strict normal Subgroup of G equals

  [.(Omega).G,(Omega).G.];
end;

theorem 
  for G being Group holds G` = gr commutators G;

theorem 
  for G being Group holds x in G` iff ex F being FinSequence of
the carrier of G,I st len F = len I & rng F c= commutators G & x = Product(F |^
  I);

theorem 
  for G being strict Group, a,b be Element of G holds [.a,b.] in G `;

theorem 
  for G being strict Group holds G is commutative Group iff G` = (1).G;

theorem 
  for G being Group, H being strict Subgroup of G holds Left_Cosets H is
  finite & index H = 2 implies G` is Subgroup of H;

begin 

definition
  let G;
  func center G -> strict Subgroup of G means


  the carrier of it = {a : for b holds a * b = b * a};
end;

theorem 
  a in center G iff for b holds a * b = b * a;

theorem 
  center G is normal Subgroup of G;

theorem 
  for H being Subgroup of G holds H is Subgroup of center G implies H is
  normal Subgroup of G;

theorem 
  center G is commutative;

theorem 
  a in center G iff con_class a = {a};

theorem 
  for G being strict Group holds G is commutative Group iff center G = G;














begin 

reserve I for set,
  x,x1,x2,y,z for set,
  A for non empty set;
reserve C,D for Category;
reserve a,b,c,d for Object of C;
reserve f,g,h,i,j,k,p1,p2,q1,q2,i1,i2,j1,j2 for Morphism of C;

scheme 

  LambdaIdx{I()->set,A()->non empty set,F(set)->Element of A()}: ex F being
  Function of I(),A() st for x st x in I() holds F/.x = F(x);

theorem 
  for F1,F2 being Function of I,A st for x st x in I holds F1/.x =
  F2/.x holds F1 = F2;

scheme 

  FuncIdxcorrectness{I()->set,A()->non empty set,F(set)->Element of A()}: (ex
F being Function of I(),A() st for x st x in I() holds F/.x = F(x)) & for F1,F2
being Function of I(),A() st (for x st x in I() holds F1/.x = F(x)) & (for x st
  x in I() holds F2/.x = F(x)) holds F1 = F2;

definition
  let A,x;
  let a be Element of A;
  redefine func x .--> a -> Function of {x},A;
end;

theorem 
  for a being Element of A st x in I holds (I --> a)/.x = a;

theorem 
  x1 <> x2 implies for y1,y2 being Element of A holds ((x1,x2) -->
  (y1,y2))/.x1 = y1 & ((x1,x2) --> (y1,y2))/.x2 = y2;

begin 

definition
  let C,I;
  let F be Function of I,the carrier' of C;

  func doms F -> Function of I, the carrier of C means


  for x st x in I holds it/.x = dom(F/.x);
  func cods F -> Function of I, the carrier of C means


  for x st x in I holds it/.x = cod(F/.x);
end;

theorem 
  doms(I-->f) = I-->(dom f);

theorem 
  cods(I-->f) = I-->(cod f);

theorem 
  doms((x1,x2)-->(p1,p2)) = (x1,x2)-->(dom p1,dom p2);

theorem 
  cods((x1,x2)-->(p1,p2)) = (x1,x2)-->(cod p1,cod p2);

definition
  let C,I;
  let F be Function of I,the carrier' of C;
  func F opp -> Function of I,the carrier' of C opp means


  for x st x in I holds it/.x = (F/.x) opp;
end;

theorem 
  (I --> f) opp = I --> f opp;

theorem 
  x1 <> x2 implies ((x1,x2)-->(p1,p2)) opp = (x1,x2)-->(p1 opp,p2 opp);

theorem 
  for F being Function of I,the carrier' of C holds F opp opp = F;

definition
  let C,I;
  let F be Function of I,the carrier' of C opp;
  func opp F -> Function of I,the carrier' of C means


  for x st x in I holds it/.x = opp (F/.x);
end;

theorem 
  for f being Morphism of C opp holds opp(I --> f) = I --> (opp f);

theorem 
  x1 <> x2 implies for p1,p2 being Morphism of C opp holds opp ((x1,x2)
  -->(p1,p2)) = (x1,x2)-->(opp p1,opp p2);

theorem 
  for F being Function of I,the carrier' of C holds opp(F opp) = F;

definition
  let C,I;
  let F be Function of I,the carrier' of C, f;
  func F*f -> Function of I,the carrier' of C means


  for x st x in I holds it/.x = (F/.x)(*)f;
  func f*F -> Function of I,the carrier' of C means


  for x st x in I holds it/.x = f(*)(F/.x);
end;

theorem 
  x1 <> x2 implies ((x1,x2)-->(p1,p2))*f = (x1,x2)-->(p1(*)f,p2(*)f);

theorem 
  x1 <> x2 implies f*((x1,x2)-->(p1,p2)) = (x1,x2)-->(f(*)p1,f(*)p2);

theorem 
  for F being Function of I,the carrier' of C st doms F = I-->cod
  f holds doms(F*f) = I-->dom f & cods(F*f) = cods F;

theorem 
  for F being Function of I,the carrier' of C st cods F = I-->dom
  f holds doms(f*F) = doms F & cods(f*F) = I-->cod f;

definition
  let C,I;
  let F,G be Function of I,the carrier' of C;
  func F"*"G -> Function of I,the carrier' of C means


  for x st x in I holds it/.x = (F/.x)(*)(G/.x);
end;

theorem 
  for F,G being Function of I,the carrier' of C st doms F = cods G
  holds doms(F"*"G) = doms G & cods(F"*"G) = cods F;

theorem 
  x1 <> x2 implies ((x1,x2)-->(p1,p2))"*"((x1,x2)-->(q1,q2)) = (x1,x2)
  -->(p1(*)q1,p2(*)q2);

theorem 
  for F being Function of I,the carrier' of C holds F*f = F"*"(I-->f);

theorem 
  for F being Function of I,the carrier' of C holds f*F = (I-->f)"*"F;

begin 

reserve f for Morphism of a,b,
        g for Morphism of b,a;

definition
  let C,a,b;
  let IT be Morphism of a,b;
  attr IT is retraction means


  Hom(a,b) <> {} & Hom(b,a) <> {} &
  ex g st IT*g = id b;
  attr IT is coretraction means


  Hom(a,b) <> {} & Hom(b,a) <> {} &
  ex g st g*IT = id a;
end;

theorem 
  f is retraction implies f is epi;

theorem 
  f is coretraction implies f is monic;

reserve g for Morphism of b,c;

theorem 
  f is retraction & g is retraction implies g*f is retraction;

theorem 
  f is coretraction & g is coretraction implies g*f is coretraction;

theorem 
 Hom(a,b) <> {} & Hom(b,a) <> {} &
  g*f is retraction implies g is retraction;

theorem 
 Hom(b,c) <> {} & Hom(c,b) <> {} &
  g*f is coretraction implies f is coretraction;

theorem 
  f is retraction & f is monic implies f is invertible;

theorem 
  f is coretraction & f is epi implies f is invertible;

theorem 
  f is invertible iff f is retraction & f is coretraction;

definition let C,a,b such that
 Hom(a,b) <> {};
 let D; let T be Functor of C,D, f be Morphism of a,b;
 func T/.f -> Morphism of T.a, T.b equals

  T.f;
end;

theorem 
  for T being Functor of C,D st f is retraction holds T/.f is retraction;

theorem 
  for T being Functor of C,D st f is coretraction holds T/.f is coretraction;

theorem 
  f is retraction iff f opp is coretraction;

theorem 
  f is coretraction iff f opp is retraction;

begin 

reserve f,g for Morphism of C;

definition
  let C,a,b;
  assume
 b is terminal;
  func term(a,b) -> Morphism of a,b means

  not contradiction;
end;

theorem 
  b is terminal implies dom(term(a,b)) = a & cod(term(a,b)) = b;

theorem 
  b is terminal & dom f = a & cod f = b implies term(a,b) = f;

theorem 
  for f being Morphism of a,b st b is terminal holds term(a,b) = f;

begin 

definition
  let C,a,b;
  assume
 a is initial;
  func init(a,b) -> Morphism of a,b means

  not contradiction;
end;

theorem 
  a is initial implies dom(init(a,b)) = a & cod(init(a,b)) = b;

theorem 
  a is initial & dom f = a & cod f = b implies init(a,b) = f;

theorem 
  for f being Morphism of a,b st a is initial holds init(a,b) = f;

begin 

definition
  let C,a,I;
  mode Projections_family of a,I -> Function of I,the carrier' of C means

 doms it = I --> a;
end;

theorem 
  for F being Projections_family of a,I st x in I holds dom(F/.x) = a;

theorem 
  for F being Function of {},the carrier' of C holds F is
  Projections_family of a,{};

theorem 
  dom f = a implies y .--> f is Projections_family of a,{y};

theorem 
  dom p1 = a & dom p2 = a implies (x1,x2)-->(p1,p2) is
  Projections_family of a,{x1,x2};

theorem 
  for F being Projections_family of a,I st cod f = a holds F*f is
  Projections_family of dom f,I;

theorem 
  for F being Function of I,the carrier' of C, G being
Projections_family of a,I st doms F = cods G holds F"*"G is Projections_family
  of a,I;

theorem 
  for F being Projections_family of cod f,I holds (f opp)*(F opp) = (F*f ) opp;

definition
  let C,a,I;
  let F be Function of I,the carrier' of C;
  pred a is_a_product_wrt F means


  F is Projections_family of a,I &
  for b for F9 being Projections_family of b,I
    st cods F = cods F9
   ex h st h in Hom(b,a) &
    for k st k in Hom(b,a) holds
     (for x st x in I holds (F/.x)(*)k = F9/.x) iff h = k;
end;

theorem 
  for F being Projections_family of c,I, F9 being
  Projections_family of d,I st c is_a_product_wrt F & d is_a_product_wrt F9 &
  cods F = cods F9 holds c,d are_isomorphic;

theorem 
  for F being Projections_family of c,I
   st c is_a_product_wrt F &
    for x1,x2 st x1 in I & x2 in I holds Hom(cod(F/.x1),cod(F/.x2)) <> {}
  for x st x in I
  for d being Object of C st d = cod(F/.x) & Hom(c,d) <> {}
  for f being Morphism of c,d st f = F/.x
    holds f is retraction;

theorem 
  for F being Function of {},the carrier' of C holds a
  is_a_product_wrt F iff a is terminal;

theorem 
  for F being Projections_family of a,I st a is_a_product_wrt F
  for f being Morphism of b,a st
  dom f = b & cod f = a &
  f is invertible holds b is_a_product_wrt F*f;

theorem 
  a is_a_product_wrt y .--> id a;

theorem 
  for F being Projections_family of a,I st a is_a_product_wrt F & for x
  st x in I holds cod(F/.x) is terminal holds a is terminal;

definition
  let C,c,p1,p2;
  pred c is_a_product_wrt p1,p2 means


  dom p1 = c & dom p2 = c & for d,
f,g st f in Hom(d,cod p1) & g in Hom(d,cod p2) ex h st h in Hom(d,c) & for k st
  k in Hom(d,c) holds p1(*)k = f & p2(*)k = g iff h = k;
end;

theorem 
  x1 <> x2 implies (c is_a_product_wrt p1,p2 iff c
  is_a_product_wrt (x1,x2)-->(p1,p2));

theorem 
  Hom(c,a) <> {} & Hom(c,b) <> {} implies for p1 being Morphism of c,a,
p2 being Morphism of c,b holds c is_a_product_wrt p1,p2 iff for d st Hom(d,a)<>
  {} & Hom(d,b)<>{} holds Hom(d,c) <> {} & for f being Morphism of d,a, g being
Morphism of d,b ex h being Morphism of d,c st for k being Morphism of d,c holds
  p1*k = f & p2*k = g iff h = k;

theorem 
  c is_a_product_wrt p1,p2 & d is_a_product_wrt q1,q2 & cod p1 = cod q1
  & cod p2 = cod q2 implies c,d are_isomorphic;

theorem 
  for p1 being Morphism of c,a, p2 being Morphism of c,b st
    Hom(c,a) <> {} & Hom(c,b) <> {} &
    c is_a_product_wrt p1,p2 &
    Hom(a,b) <> {} & Hom(b,a) <> {}
 holds p1 is retraction & p2 is retraction;

theorem 
  c is_a_product_wrt p1,p2 & h in Hom(c,c) & p1(*)h = p1 & p2(*)h = p2
  implies h = id c;

theorem 
 for f being Morphism of d,c
  st c is_a_product_wrt p1,p2 & dom f = d & cod f = c & f is invertible
 holds d is_a_product_wrt p1(*)f,p2(*)f;

theorem 
  c is_a_product_wrt p1,p2 & cod p2 is terminal implies c,cod p1 are_isomorphic
;

theorem 
  c is_a_product_wrt p1,p2 & cod p1 is terminal implies c,cod p2 are_isomorphic
;

begin 

definition
  let C,c,I;
  mode Injections_family of c,I -> Function of I,the carrier' of C means


     cods it = I --> c;
end;

theorem 
  for F being Injections_family of c,I st x in I holds cod(F/.x) = c;

theorem 
  for F being Function of {},the carrier' of C holds F is
  Injections_family of a,{};

theorem 
  cod f = a implies y .--> f is Injections_family of a,{y};

theorem 
  cod p1 = c & cod p2 = c implies (x1,x2)-->(p1,p2) is
  Injections_family of c,{x1,x2};

theorem 
  for F being Injections_family of b,I st dom f = b holds f*F is
  Injections_family of cod f,I;

theorem 
  for F being Injections_family of b,I, G being Function of I,the
  carrier' of C st doms F = cods G holds F"*"G is Injections_family of b,I;

theorem 
  for F be Function of I,the carrier' of C holds F is
  Projections_family of c,I iff F opp is Injections_family of c opp,I;

theorem 
  for F be Function of I,the carrier' of C opp, c being Object of
  C opp holds F is Injections_family of c,I iff opp F is Projections_family of
  opp c,I;

theorem 
  for F being Injections_family of dom f,I holds (F opp)*(f opp) = (f*F) opp;

definition
  let C,c,I;
  let F be Function of I,the carrier' of C;
  pred c is_a_coproduct_wrt F means


  F is Injections_family of c,I &
  for d for F9 being Injections_family of d,I st doms F = doms F9 ex h st h in
Hom(c,d) & for k st k in Hom(c,d) holds (for x st x in I
     holds k(*)(F/.x) = F9/.x
  ) iff h = k;
end;

theorem 
  for F being Function of I,the carrier' of C holds c is_a_product_wrt F
  iff c opp is_a_coproduct_wrt F opp;

theorem 
  for F being Injections_family of c,I, F9 being Injections_family
  of d,I st c is_a_coproduct_wrt F & d is_a_coproduct_wrt F9 & doms F = doms F9
  holds c,d are_isomorphic;

theorem 
  for F being Injections_family of c,I st c is_a_coproduct_wrt F &
for x1,x2 st x1 in I & x2 in I holds Hom(dom(F/.x1),dom(F/.x2)) <> {}
  for x st x in I
  for d being Object of C st d = dom(F/.x) & Hom(d,c) <> {}
  for f being Morphism of d,c st f = F/.x
    holds f is coretraction;

theorem 
  for f being Morphism of a,b
  for F being Injections_family of a,I st a is_a_coproduct_wrt F &
  dom f = a & cod f = b & f is invertible holds b is_a_coproduct_wrt f*F;

theorem 
  for F being Injections_family of a,{} holds a is_a_coproduct_wrt
  F iff a is initial;

theorem 
  a is_a_coproduct_wrt y .--> id a;

theorem 
  for F being Injections_family of a,I st a is_a_coproduct_wrt F & for x
  st x in I holds dom(F/.x) is initial holds a is initial;

definition
  let C,c,i1,i2;
  pred c is_a_coproduct_wrt i1,i2 means


  cod i1 = c & cod i2 = c & for
d,f,g st f in Hom(dom i1,d) & g in Hom(dom i2,d) ex h st h in Hom(c,d) & for k
  st k in Hom(c,d) holds k(*)i1 = f & k(*)i2 = g iff h = k;
end;

theorem 
  c is_a_product_wrt p1,p2 iff c opp is_a_coproduct_wrt p1 opp, p2 opp;

theorem 
  x1 <> x2 implies (c is_a_coproduct_wrt i1,i2 iff c
  is_a_coproduct_wrt (x1,x2)-->(i1,i2));

theorem 
  c is_a_coproduct_wrt i1,i2 & d is_a_coproduct_wrt j1,j2 & dom i1 = dom
  j1 & dom i2 = dom j2 implies c,d are_isomorphic;

theorem 
  Hom(a,c) <> {} & Hom(b,c) <> {} implies for i1 being Morphism of a,c,
i2 being Morphism of b,c holds c is_a_coproduct_wrt i1,i2 iff for d st Hom(a,d)
<>{} & Hom(b,d)<>{} holds Hom(c,d) <> {} & for f being Morphism of a,d, g being
Morphism of b,d ex h being Morphism of c,d st for k being Morphism of c,d holds
  k*i1 = f & k*i2 = g iff h = k;

theorem 
  for i1 being Morphism of a,c, i2 being Morphism of b,c
   st Hom(a,c) <> {} & Hom(b,c) <> {}
  holds
  c is_a_coproduct_wrt i1,i2 & Hom(a,b) <> {} & Hom(b,a) <> {}
  implies i1 is coretraction & i2 is coretraction;

theorem 
  c is_a_coproduct_wrt i1,i2 & h in Hom(c,c) & h(*)i1 = i1 & h(*)i2 =
  i2 implies h = id c;

theorem 
 for f being Morphism of c,d holds
  c is_a_coproduct_wrt i1,i2 & dom f = c & cod f = d & f is invertible
  implies d is_a_coproduct_wrt f(*)i1,f(*)i2;

theorem 
  c is_a_coproduct_wrt i1,i2 & dom i2 is initial implies dom i1,c
  are_isomorphic;

theorem 
  c is_a_coproduct_wrt i1,i2 & dom i1 is initial implies dom i2,c
  are_isomorphic;














begin



reserve A1,A2,B1,B2 for non empty set,
  f for Function of A1,B1,
  g for Function of A2,B2,
  Y1 for non empty Subset of A1,
  Y2 for non empty Subset of A2;

definition
  let A1 be set, B1 be non empty set, f be Function of A1, B1, Y1 be Subset of
  A1;
  redefine func f|Y1 -> Function of Y1,B1;
end;

theorem 
  [:f,g:]|[:Y1,Y2:] = [:f|Y1,g|Y2:];

definition
  let A,B be non empty set;
  let A1 be non empty Subset of A, B1 be non empty Subset of B;
  let f be PartFunc of [:A1,A1:],A1;
  let g be PartFunc of [:B1,B1:],B1;
  redefine func |:f,g:| -> PartFunc of [:[:A1,B1:],[:A1,B1:]:],[:A1,B1:];
end;

theorem 
  for f being PartFunc of [:A1,A1:],A1, g being PartFunc of [:A2,A2
:],A2 for F being PartFunc of [:Y1,Y1:],Y1 st F = f||Y1 for G being PartFunc of
  [:Y2,Y2:],Y2 st G = g||Y2 holds |:F,G:| = |:f,g:| ||[:Y1,Y2:];

reserve A,B,C for Category,
  F,F1,F2,F3 for Functor of A,B,
  G for Functor of B, C;

reserve m,o for set;

canceled;

theorem 
  for f,g being Morphism of 1Cat(o,m) holds f = g;

theorem 
  for a being Object of A holds [[id a,id a],id a] in the Comp of A;

theorem 
  the Comp of 1Cat(o,m) = {[[m,m],m]};

theorem 
  for a being Object of A holds 1Cat(a,id a) is Subcategory of A;

theorem 
  for C being Subcategory of A holds the Source of C = (the Source
of A)|the carrier' of C & the Target of C = (the Target of A)|the carrier' of C
& the Comp of C = (the Comp of A)||the carrier' of C;

theorem 
  for O being non empty Subset of the carrier of A,
      M being non empty Subset of the carrier' of A st
  for o being Element of A st o in O holds id o in M
  for DOM,COD being Function of M,O st DOM = (the Source of A) |M &
     COD = (the Target of A)|M
  for COMP being PartFunc of [:M,M qua non empty set:], M
   st COMP = (the Comp of A)||M
   holds CatStr(#O,M,DOM,COD,COMP#) is Subcategory of A;

theorem 
  for C being strict Category, A being strict Subcategory of C st
  the carrier of A = the carrier of C & the carrier' of A = the carrier' of C
  holds A = C;

begin 

definition
  canceled;
end;

theorem 
  for a,b being Object of A st Hom(a,b) <> {} for f being Morphism of a,
  b holds (G*F)/.f = G/.(F/.f);




theorem 
  for F1,F2 being Functor of A,B
   st for a,b being Object of A st Hom(a,b) <> {}
       for f being Morphism of a,b holds F1.f = F2.f
  holds F1 = F2;

theorem 
  for a,b,c being Object of A st Hom(a,b) <> {} & Hom(b,c) <> {}
  for f being Morphism of a,b, g being Morphism of b,c
   holds F/.(g*f) = (F/.g)*(F/.f);

theorem 
  for c being Object of A, d being Object of B st F/.(id c) = id d
   holds F.c = d;

theorem 
  for a being Object of A holds F/.id a = id (F.a);

theorem 
  for a,b being Object of A st Hom(a,b) <> {} for f being Morphism of a,
  b holds (id A)/.f = f;

theorem 
  for a,b,c,d being Object of A st Hom(a,b) meets Hom(c,d) holds a = c & b = d;

begin 

definition
  let A,B,F1,F2;
  pred F1 is_transformable_to F2 means


  for a being Object of A holds Hom(F1.a,F2.a) <> {};
  reflexivity;
end;

theorem 
  F is_transformable_to F1 & F1 is_transformable_to F2 implies F
  is_transformable_to F2;

definition
  let A,B,F1,F2;
  assume
 F1 is_transformable_to F2;
  mode transformation of F1,F2 -> Function of the carrier of A, the carrier'
    of B means


    for a being Object of A holds it.a is Morphism of F1.a,F2.a;
end;

definition
  let A,B;
  let F be Functor of A,B;
  func id F ->transformation of F,F means


  for a being Object of A holds it.a = id (F.a);
end;

definition
  let A,B,F1,F2;
  assume
 F1 is_transformable_to F2;
  let t be transformation of F1,F2;
  let a be Object of A;
  func t.a -> Morphism of F1.a, F2.a equals


  t.a;
end;

definition
  let A,B,F,F1,F2;
  assume that
 F is_transformable_to F1 and
 F1 is_transformable_to F2;
  let t1 be transformation of F,F1;
  let t2 be transformation of F1,F2;
  func t2`*`t1 -> transformation of F,F2 means


  for a being Object of A holds it.a = (t2.a)*(t1.a);
end;

theorem 
  F1 is_transformable_to F2 implies for t1,t2 being transformation
  of F1,F2 st for a being Object of A holds t1.a = t2.a holds t1 = t2;

theorem 
  for a being Object of A holds id F.a = id(F.a);

theorem 
  F1 is_transformable_to F2 implies for t being transformation of
  F1,F2 holds (id F2)`*`t = t & t`*`(id F1) = t;

theorem 
  F is_transformable_to F1 & F1 is_transformable_to F2 & F2
  is_transformable_to F3 implies for t1 being transformation of F,F1, t2 being
transformation of F1,F2, t3 being transformation of F2,F3 holds t3`*`t2`*`t1 =
  t3`*`(t2`*`t1);

begin

definition
  let A,B,F1,F2;
  pred F1 is_naturally_transformable_to F2 means


  F1 is_transformable_to
F2 & ex t being transformation of F1,F2 st for a,b being Object of A st Hom(a,b
  ) <> {} for f being Morphism of a,b holds t.b*F1/.f = F2/.f*t.a;
  reflexivity;
end;

theorem 
  F is_naturally_transformable_to F1 & F1
  is_naturally_transformable_to F2 implies F is_naturally_transformable_to F2;

definition
  let A,B,F1,F2;
  assume
 F1 is_naturally_transformable_to F2;
  mode natural_transformation of F1,F2 -> transformation of F1,F2 means


for a,b being Object of A st Hom(a,b) <> {} for f being Morphism of a,b holds
    it.b*F1/.f = F2/.f*it.a;
end;

definition
  let A,B,F;
  redefine func id F -> natural_transformation of F,F;
end;

definition
  let A,B,F,F1,F2 such that
 F is_naturally_transformable_to F1 and
 F1 is_naturally_transformable_to F2;
  let t1 be natural_transformation of F,F1;
  let t2 be natural_transformation of F1,F2;
  func t2`*`t1 -> natural_transformation of F,F2 equals


  t2`*`t1;
end;

theorem 
  F1 is_naturally_transformable_to F2 implies for t being
  natural_transformation of F1,F2 holds (id F2)`*`t = t & t`*`(id F1) = t;

reserve t for natural_transformation of F,F1,
  t1 for natural_transformation of F1,F2;

theorem 
  F is_naturally_transformable_to F1 & F1
is_naturally_transformable_to F2 implies for t1 being natural_transformation of
F,F1 for t2 being natural_transformation of F1,F2 for a being Object of A holds
  (t2`*`t1).a = (t2.a)*(t1.a);

theorem 
  F is_naturally_transformable_to F1 & F1
is_naturally_transformable_to F2 & F2 is_naturally_transformable_to F3 implies
for t3 being natural_transformation of F2,F3 holds t3`*`t1`*`t = t3`*`(t1`*`t);



definition
  let A,B,F1,F2;
  let IT be transformation of F1,F2;
  attr IT is invertible means


  for a being Object of A holds IT.a is invertible;
end;

definition
  let A,B,F1,F2;
  pred F1,F2 are_naturally_equivalent means


  F1
  is_naturally_transformable_to F2 & ex t being natural_transformation of F1,F2
  st t is invertible;
  reflexivity;
end;

notation
  let A,B,F1,F2;
  synonym F1 ~= F2 for F1,F2 are_naturally_equivalent;
end;

definition
  let A,B,F1,F2 such that
 F1 is_transformable_to F2;
  let t1 be transformation of F1,F2 such that
 t1 is invertible;
  func t1" -> transformation of F2,F1 means


  for a being Object of A holds it.a = (t1.a)";
end;

definition
  let A,B,F1,F2,t1 such that
 F1 is_naturally_transformable_to F2 and
 t1 is invertible;
  func t1" -> natural_transformation of F2,F1 equals


  (t1 qua
  transformation of F1,F2)";
end;

theorem 
  for A,B,F1,F2,t1 st F1 is_naturally_transformable_to F2 & t1 is
  invertible for a being Object of A holds t1".a = (t1.a)";

theorem 
  F1 ~= F2 implies F2 ~= F1;

theorem 
  F1 ~= F2 & F2 ~= F3 implies F1 ~= F3;

definition
  let A,B,F1,F2;
  assume
 F1,F2 are_naturally_equivalent;
  mode natural_equivalence of F1,F2 -> natural_transformation of F1,F2 means


     it is invertible;
end;

theorem 
  id F is natural_equivalence of F,F;

theorem 
  F1 ~= F2 & F2 ~= F3 implies for t being natural_equivalence of F1,F2,
t9 being natural_equivalence of F2,F3 holds t9`*`t is natural_equivalence of F1
  ,F3;

begin 

definition
  let A,B;
  mode NatTrans-DOMAIN of A,B -> non empty set means


    for x being set
    holds x in it implies ex F1,F2 being Functor of A,B, t being
    natural_transformation of F1,F2 st x = [[F1,F2],t] & F1
    is_naturally_transformable_to F2;
end;

definition
  let A,B;
  func NatTrans(A,B) -> NatTrans-DOMAIN of A,B means


  for x being set
holds x in it iff ex F1,F2 being Functor of A,B, t being natural_transformation
  of F1,F2 st x = [[F1,F2],t] & F1 is_naturally_transformable_to F2;
end;

theorem 
  F1 is_naturally_transformable_to F2 iff [[F1,F2],t1] in NatTrans (A,B);

definition
  let A,B;
  func Functors(A,B) -> strict Category means


  the carrier of it =
  Funct(A,B) & the carrier' of it = NatTrans(A,B) & (for f being Morphism of it
holds dom f = f`1`1 & cod f = f`1`2) & (for f,g being Morphism of it st dom g =
cod f holds [g,f] in dom the Comp of it) & (for f,g being Morphism of it st [g,
f] in dom (the Comp of it) ex F,F1,F2,t,t1 st f = [[F,F1],t] & g = [[F1,F2],t1]
& (the Comp of it).[g,f] = [[F,F2],t1`*`t])
& for a being Object of it, F st F
  = a holds id a = [[F,F],id F];
end;



theorem 
  for f being Morphism of Functors(A,B) st f = [[F,F1],t] holds
  dom f = F & cod f = F1;

theorem 
  for a,b being Object of Functors(A,B), f being Morphism of a,b st Hom(
  a,b) <> {} ex F,F1,t st a = F & b = F1 & f = [[F,F1],t];

theorem 
  for t9 being natural_transformation of F2,F3 for f,g being
  Morphism of Functors(A,B) st f = [[F,F1],t] & g = [[F2,F3],t9] holds [g,f] in
  dom the Comp of Functors(A,B) iff F1 = F2;

theorem 
  for f,g being Morphism of Functors(A,B) st f = [[F,F1],t] & g = [[F1,
  F2],t1] holds g(*)f = [[F,F2],t1`*`t];

begin 

definition
  let C be Category;
  attr C is discrete means


  for f being Morphism of C ex a being Object of C st f = id a;
end;

registration
  cluster discrete for Category;
end;

theorem 
  for A being discrete Category, a being Object of A holds Hom(a,a ) = { id a};

theorem 
  A is discrete iff (for a being Object of A ex B being finite set
st B = Hom(a,a) & card B = 1) & for a,b being Object of A st a <> b holds Hom(a
  ,b) = {};

theorem 
  1Cat(o,m) is discrete;

theorem 
  for A being discrete Category, C being Subcategory of A holds C is discrete;

theorem 
  A is discrete & B is discrete implies [:A,B:] is discrete;

theorem 
  for A being discrete Category, B being Category, F1,F2 being
  Functor of B,A st F1 is_transformable_to F2 holds F1 = F2;

theorem 
  for A being discrete Category, B being Category, F being Functor
  of B,A, t being transformation of F,F holds t = id F;

theorem 
  A is discrete implies Functors(B,A) is discrete;

registration
  let C be Category;
  cluster strict discrete for Subcategory of C;
end;

definition
  let C;
  func IdCat(C) -> strict discrete Subcategory of C means


  the carrier
of it = the carrier of C & the carrier' of it = { id a where a is Object of C:
  not contradiction};
end;

theorem 
  for C being strict Category holds C is discrete implies IdCat(C) = C;

theorem 
  IdCat(IdCat(C)) = IdCat(C);

theorem 
  IdCat(1Cat(o,m)) = 1Cat(o,m);

theorem 
  IdCat([:A,B:]) = [:IdCat(A), IdCat(B):];














begin

reserve x,y,z for set,
  i,j,n,m for Nat,
  D for non empty set,
  K for non empty doubleLoopStr,
  s,t for FinSequence,
  a,a1,a2,b1,b2,d for Element of D,
  p, p1,p2,q,r for FinSequence of D,
  F for add-associative right_zeroed
  right_complementable Abelian non empty doubleLoopStr;

definition
  let f be FinSequence;
  attr f is tabular means


  ex n being Nat st for x st x in rng f ex s
  being FinSequence st s=x & len s = n;
end;

registration
  cluster tabular for FinSequence;
end;

theorem 
  <*<*d*>*> is tabular;

theorem 
  m |-> (n |-> x) is tabular;

theorem 
  <*s*> is tabular;

theorem 
  for s1,s2 be FinSequence st len s1 =n & len s2 = n holds <*s1,s2
  *> is tabular;

theorem 
  {} is tabular;

theorem 
  <*{},{}*> is tabular;

theorem 
  <*<*a1*>,<*a2*>*> is tabular;

theorem 
  <*<*a1,a2*>,<*b1,b2*>*> is tabular;

registration
  let D be set;
  cluster tabular for FinSequence of D*;
end;

definition
  let D be set;
  mode Matrix of D is tabular FinSequence of D*;
end;

registration
  let D be non empty set;
  cluster non empty-yielding for Matrix of D;
end;

theorem 
  s is Matrix of D iff ex n st for x st x in rng s ex p st x = p & len p = n;

definition
  let D;
  let m,n;

  mode Matrix of m,n,D -> Matrix of D means


    len it = m & for p st p in rng it holds len p = n;
end;

definition
  let D,n;
  mode Matrix of n,D is Matrix of n,n,D;
end;

definition
  let K be non empty 1-sorted;
  mode Matrix of K is Matrix of the carrier of K;
  let n;
  mode Matrix of n,K is Matrix of n,n,the carrier of K;
  let m;
  mode Matrix of n,m,K is Matrix of n,m,the carrier of K;
end;

theorem 
  m |-> (n |-> a) is Matrix of m,n,D;

theorem 
  for p being FinSequence of D holds <*p*> is Matrix of 1,len p,D;

theorem 
  for p1,p2 st len p1 =n & len p2 = n holds <*p1,p2*> is Matrix of 2,n,D;

theorem 
  {} is Matrix of 0,m,D;

theorem 
  <*{}*> is Matrix of 1,0,D;

theorem 
  <*<*a*>*> is Matrix of 1,D;

theorem 
  <*{},{}*> is Matrix of 2,0,D;

theorem 
  <*<*a1,a2*>*> is Matrix of 1,2,D;

theorem 
  <*<*a1*>,<*a2*>*> is Matrix of 2,1,D;

theorem 
  <*<*a1,a2*>,<*b1,b2*>*> is Matrix of 2,D;

reserve M,M1,M2 for Matrix of D;

definition
  let M be tabular FinSequence;
  func width M -> Element of NAT means


  ex s st s in rng M & len s = it if len M > 0 otherwise it = 0;
end;

theorem 
  len M > 0 implies for n holds M is Matrix of len M, n, D iff n = width M;

definition
  let M be tabular FinSequence;
  func Indices M -> set equals

  [:dom M,Seg width M:];
end;

definition
  let D be set;
  let M be Matrix of D;
  let i,j;
  assume
 [i,j] in Indices M;
  func M*(i,j) -> Element of D means


  ex p being FinSequence of D st p = M.i & it = p.j;
end;

theorem 
  len M1 = len M2 & width M1 = width M2 & (for i,j st [i,j] in
  Indices M1 holds M1*(i,j) = M2*(i,j)) implies M1 = M2;

scheme 

  MatrixLambda { D() -> non empty set, n, m() -> Element of NAT, f(set,set) ->
  Element of D()} : ex M being Matrix of n(),m(),D() st for i,j st [i,j] in
  Indices M holds M*(i,j) = f(i,j);

scheme 

  MatrixEx { D() -> non empty set, n, m() -> Element of NAT, P[set,set,set] }
: ex M being Matrix of n(),m(),D() st for i,j st [i,j] in Indices M holds P[i,j
  ,M*(i,j)]
provided
 for i,j st [i,j] in [:Seg n(), Seg m():] ex x being Element of D()
st P[i,j,x];

theorem 
  for M being Matrix of 0,m,D holds len M = 0 & width M = 0 & Indices M = {};

theorem 
  n > 0 implies for M being Matrix of n,m,D holds len M = n &
  width M = m & Indices M = [:Seg n, Seg m:];

theorem 
  for M being Matrix of n,D holds len M = n & width M = n &
  Indices M = [:Seg n, Seg n:];

theorem 
  for M being Matrix of n,m,D holds len M = n & Indices M = [:Seg
  n,Seg width M:];

theorem 
  for M1,M2 being Matrix of n,m,D holds Indices M1 = Indices M2;

theorem 
  for M1,M2 being Matrix of n,m,D st (for i,j st [i,j] in Indices
  M1 holds M1*(i,j) = M2*(i,j)) holds M1 = M2;

theorem 
  for M1 being Matrix of n,D holds for i,j st [i,j] in Indices M1 holds
  [j,i] in Indices M1;

definition
  let D;
  let M be Matrix of D;
  func M@ -> Matrix of D means


  len it = width M & (for i,j holds [i,j]
in Indices it iff [j,i] in Indices M) & for i,j st [j,i] in Indices M holds it*
  (i,j) = M*(j,i);
end;

definition
  let n,D;
  let M be Matrix of n,D;
  redefine func M@ -> Matrix of n,D;
end;

definition
  let D,M,i;
  func Line(M,i) -> FinSequence of D means


  len it = width M & for j st j in Seg width M holds it.j = M*(i,j);
  func Col(M,i) -> FinSequence of D means


  len it = len M & for j st j in dom M holds it.j = M*(j,i);
end;

definition
  let D;
  let M be Matrix of D;
  let i;
  redefine func Line(M,i) -> Element of (width M)-tuples_on D;
  redefine func Col(M,i) -> Element of (len M)-tuples_on D;
end;

reserve A,B for Matrix of n,K;

definition
  let K,n;
  func n-Matrices_over K -> set equals

  n-tuples_on (n-tuples_on the carrier of
  K);
  func 0.(K,n) -> Matrix of n,K equals

  n |-> (n |-> 0.K);
  func 1.(K,n) -> Matrix of n,K means


  (for i st [i,i] in Indices it
holds it*(i,i) = 1.K) & for i,j st [i,j] in Indices it & i <> j holds it*(i,j)
  = 0.K;
  let A;
  func -A -> Matrix of n,K means


  for i,j holds [i,j] in Indices A implies it*(i,j) = -(A*(i,j));
  let B;
  func A+B -> Matrix of n,K means


  for i,j holds [i,j] in Indices A implies it*(i,j) = A*(i,j) + B*(i,j);
end;

registration
  let K,n;
  cluster n-Matrices_over K -> non empty;
end;

theorem 
  [i,j] in Indices (0.(K,n)) implies (0.(K,n))*(i,j)= 0.K;

theorem 
  x is Element of n-Matrices_over K iff x is Matrix of n,K;

definition
  let K be non empty ZeroStr;
  let M be Matrix of K;
  attr M is diagonal means

  for i,j st [i,j] in Indices M & M*(i,j) <> 0.K holds i=j;
end;

registration
  let n, K;
  cluster diagonal for Matrix of n,K;
end;

definition
  let K,n;
  mode Diagonal of n,K is diagonal Matrix of n,K;
end;

reserve A,A9,B,B9,C for Matrix of n,F;

theorem 
  A + B = B + A;

theorem 
  (A + B) + C = A + (B + C);

theorem 
  A + 0.(F,n)= A;

theorem 
  A + (-A) = 0.(F,n);

definition
  let F,n;
  func n-G_Matrix_over F -> strict AbGroup means

  the carrier of it = n
-Matrices_over F & (for A,B holds (the addF of it).(A,B) = A+B) & 0.it = 0.(F,n
  );
end;

theorem 
  for M1 being Matrix of 0, n, K, M2 being Matrix of 0, m, K holds M1 = M2;

begin 


theorem 
  for D being set for i,j for M being Matrix of D st 1 <= i & i <=
  len M & 1 <= j & j <= width M holds [i,j] in Indices M;

theorem 
  for M being Matrix of n,m,D st 1 <= i & i <= n & 1 <= j & j <= m holds
  [i,j] in Indices M;



theorem 
  for M being tabular FinSequence, i,j st [i,j] in Indices M holds
  1 <= i & i <= len M & 1 <= j & j <= width M;

theorem 
  for M being Matrix of n,m,D st [i,j] in Indices M holds 1 <= i & i <=
  n & 1 <= j & j <= m;



definition
  let F be Function;
  func Values F -> set equals

  Union rngs F;
end;

theorem 
  for M being FinSequence of D* holds M.i is FinSequence of D;

theorem 
  for M being FinSequence of D* holds Values M = union {rng f where
  f is Element of D*: f in rng M};

registration
  let D be non empty set, M be FinSequence of D*;
  cluster Values M -> finite;
end;

reserve D for non empty set,
  f for FinSequence of D;

theorem 
  for M being Matrix of D st i in dom M & M.i = f holds len f = width M;

theorem 
  for M being Matrix of D st i in dom M & M.i = f & j in dom f
  holds [i,j] in Indices M;

theorem 
  for M being Matrix of D st [i,j] in Indices M & M.i = f holds len
  f = width M & j in dom f;

theorem 
  for M being Matrix of D
   holds Values M =
    { M*(i,j) where i is Element of NAT, j is Element of NAT:
     [i,j] in Indices M };

theorem 
  for D being non empty set, M being Matrix of D
   holds card Values M <= (len M)*(width M);

reserve i,j,i1,j1 for Element of NAT;

theorem 
 for M being Matrix of D st 1 <= i & i <= len M & 1 <= j & j <= width M
holds M*(i,j) in Values M;















begin

reserve PM for MetrStruct;
reserve x,y for Element of PM;
reserve r,p,q,s,t for Real;

theorem 
  for r, p being real number st r <= p holds Ball(x,r) c= Ball(x,p);

reserve T for TopSpace;
reserve A for Subset of T;

theorem 
  Cl(A) <> {} iff A <> {};

reserve T for non empty TopSpace;
reserve x for Point of T;
reserve Z,X,V,W,Y,Q for Subset of T;
reserve FX for Subset-Family of T;

theorem 
  FX is Cover of T implies for x ex W st x in W & W in FX;

reserve a for set;

theorem 
  the topology of 1TopSp a = bool a;

theorem 
  the carrier of 1TopSp a = a;

theorem 
  1TopSp {a} is compact;

theorem 
  T is T_2 implies {x} is closed;



reserve x,y for Point of T;
reserve A,B for Subset of T;
reserve FX,GX for Subset-Family of T;

definition
  let T be TopStruct;
  let IT be Subset-Family of T;

  attr IT is locally_finite means


  for x being Point of T ex W being
  Subset of T st x in W & W is open & { V where V is Subset of T: V in IT & V
  meets W } is finite;
end;

theorem 
  for W holds { V : V in FX & V meets W} c= FX;

theorem 
  FX c= GX & GX is locally_finite implies FX is locally_finite;

theorem 
  FX is finite implies FX is locally_finite;

definition
  let T be TopStruct, FX be Subset-Family of T;
  func clf FX -> Subset-Family of T means


  for Z being Subset of T holds
  Z in it iff ex W being Subset of T st Z = Cl W & W in FX;
end;

theorem 
  for T being TopSpace, FX being Subset-Family of T holds clf FX is closed;

theorem 
  for T being TopSpace, FX being Subset-Family of T st FX = {}
  holds clf FX = {};

theorem 
  FX = { V } implies clf FX = { Cl V };

theorem 
  FX c= GX implies clf FX c= clf GX;

theorem 
  clf(FX \/ GX) = (clf FX) \/ (clf GX);

theorem 
  FX is finite implies Cl(union FX) = union (clf FX);

theorem 
  FX is_finer_than clf FX;

scheme 

  Lambda1top{T()->TopSpace, X()->Subset-Family of T(), Y()->Subset-Family of T
  (), F(set)->Subset of T()}: ex f being Function of X(),Y() st for Z being
  Subset of T() st Z in X() holds f.Z = F(Z)
provided
 for Z being Subset of T() st Z in X() holds F(Z) in Y();

theorem 
  FX is locally_finite implies clf FX is locally_finite;

theorem 
  union FX c= union(clf FX);

theorem 
  FX is locally_finite implies Cl union FX = union clf FX;

theorem 
  FX is locally_finite & FX is closed implies union FX is closed;

definition
  let IT be TopStruct;
  attr IT is paracompact means


  for FX being Subset-Family of IT st FX
is Cover of IT & FX is open ex GX being Subset-Family of IT st GX is open & GX
  is Cover of IT & GX is_finer_than FX & GX is locally_finite;
end;

registration
  cluster paracompact for non empty TopSpace;
end;

theorem 
  T is compact implies T is paracompact;

theorem 
  T is paracompact & B is closed & (for x st x in B ex V,W being
Subset of T st V is open & W is open & A c= V & x in W & V misses W) implies ex
  Y,Z being Subset of T st Y is open & Z is open & A c=Y & B c= Z & Y misses Z;

theorem 
  T is T_2 & T is paracompact implies T is regular;

theorem 
  T is T_2 & T is paracompact implies T is normal;



reserve x,y,z for Element of PM;
reserve V,W,Y for Subset of PM;

definition
  let PM;
  func Family_open_set(PM) -> Subset-Family of PM means


  for V holds V in it iff for x st x in V holds ex r st r>0 & Ball(x,r) c= V;
end;

theorem 
  for x ex r st r>0 & Ball(x,r) c= the carrier of PM;

theorem 
  for r being real number st PM is triangle & y in Ball(x,r) holds
  ex p st p>0 & Ball(y,p) c= Ball(x,r);

theorem 
  PM is triangle & y in Ball(x,r) /\ Ball(z,p) implies ex q st Ball(y,q)
  c= Ball(x,r) & Ball(y,q) c= Ball(z,p);

theorem 
  for r being real number st PM is triangle holds Ball(x,r) in
  Family_open_set(PM);

theorem 
  the carrier of PM in Family_open_set(PM);

theorem 
  for V,W st V in Family_open_set(PM) & W in Family_open_set(PM)
  holds V /\ W in Family_open_set(PM);

theorem 
  for A being Subset-Family of PM st A c= Family_open_set(PM)
  holds union A in Family_open_set(PM);

theorem 
  TopStruct (#the carrier of PM,Family_open_set(PM)#) is TopSpace;

definition
  let PM;
  func TopSpaceMetr PM -> TopStruct equals

  TopStruct (#the carrier of PM,
    Family_open_set(PM)#);
end;

registration
  let PM;
  cluster TopSpaceMetr PM -> strict TopSpace-like;
end;

registration
  let PM be non empty MetrStruct;
  cluster TopSpaceMetr PM -> non empty;
end;

theorem 
  for PM being non empty MetrSpace holds TopSpaceMetr PM is T_2;

registration
  cluster T_2 non empty strict for TopSpace;
end;



definition
  let D be set,f be Function of [:D,D:],REAL;
  pred f is_metric_of D means


  for a,b,c be Element of D holds (f.(a,b)
  = 0 iff a=b) & f.(a,b) = f.(b,a) & f.(a,c)<=f.(a,b)+f.(b,c);
end;

theorem 
  for D being set,f being Function of [:D,D:],REAL holds f
  is_metric_of D iff MetrStruct (#D,f#) is MetrSpace;

definition
  let D be set, f be Function of [:D,D:],REAL;
  assume
 f is_metric_of D;
  func SpaceMetr(D,f) -> strict MetrSpace equals


  MetrStruct(#D,f#);
end;



definition
  let IT be TopStruct;
  attr IT is metrizable means

  ex f being Function of [:the carrier of IT,the
  carrier of IT:],REAL st f is_metric_of (the carrier of IT) & Family_open_set(
  SpaceMetr (the carrier of IT,f) ) = the topology of IT;
end;

registration
  cluster strict metrizable for non empty TopSpace;
end;

theorem 
  for D be non empty set, f be Function of [:D,D:],REAL st f
  is_metric_of D holds SpaceMetr(D,f) is non empty;














begin 

reserve G for non empty addLoopStr;
reserve x for Element of G;
reserve M for non empty MidStr;
reserve p,q,r for Point of M;
reserve w for Function of [:the carrier of M,the carrier of M:], the carrier
  of G;

definition
  let G,x;
  func Double x -> Element of G equals

  x + x;
end;

definition let M,G,w;
  attr w is associating means

  p@q = r iff w.(p,r) = w.(r,q);
end;

theorem 
  w is associating implies p@p = p;

reserve S for non empty set;
reserve a,b,b9,c,c9,d for Element of S;
reserve w for Function of [:S,S:],the carrier of G;

definition
  let S,G,w;
  pred w is_atlas_of S,G means


  (for a,x ex b st w.(a,b) = x) &
  (for a,b,c holds w.(a,b) = w.(a,c) implies b = c) &
  for a,b,c holds w.(a,b) + w.(b,c) = w.(a,c);
end;

definition
  let S,G,w,a,x;
  assume
 w is_atlas_of S,G;
  func (a,x).w -> Element of S means


  w.(a,it) = x;
end;

reserve G for add-associative right_zeroed right_complementable non empty
  addLoopStr;
reserve x for Element of G;
reserve w for Function of [:S,S:],the carrier of G;

theorem 
  w is_atlas_of S,G implies w.(a,a) = 0.G;

theorem 
  w is_atlas_of S,G & w.(a,b) = 0.G implies a = b;

theorem 
  w is_atlas_of S,G implies w.(a,b) = -w.(b,a);

theorem 
  w is_atlas_of S,G & w.(a,b) = w.(c,d) implies w.(b,a) = w.(d,c);

theorem 
  w is_atlas_of S,G implies for b,x ex a st w.(a,b) = x;

theorem 
  w is_atlas_of S,G & w.(b,a) = w.(c,a) implies b = c;

theorem 
  for w being Function of [:the carrier of M,the carrier of M:],
  the carrier of G holds w is_atlas_of the carrier of M,G &
  w is associating implies p@q = q@p;

theorem 
  for w being Function of [:the carrier of M,the carrier of M:],
  the carrier of G holds w is_atlas_of the carrier of M,G &
  w is associating implies ex r st r@p = q;

reserve G for add-associative right_zeroed right_complementable Abelian non
  empty addLoopStr;
reserve x for Element of G;

theorem 
  for G being add-associative Abelian non empty addLoopStr, x,y,
  z,t being Element of G holds (x+y)+(z+t) = (x+z)+(y+t);

theorem 
  for G being add-associative Abelian non empty addLoopStr, x,y being
  Element of G holds Double (x + y) = Double x + Double y;

theorem 
  Double (-x) = -Double x;

theorem 
  for w being Function of [:the carrier of M,the carrier of M:],
  the carrier of G holds w is_atlas_of the carrier of M,G &
w is associating implies for a,b,c,d being Point of M holds (a@b = c@d iff
  w.(a,d) = w.(c,b));

reserve w for Function of [:S,S:],the carrier of G;

theorem 
  w is_atlas_of S,G implies for a,b,b9,c,c9 holds w.(a,b) = w.(b,c
  ) & w.(a,b9) = w.(b9,c9) implies w.(c,c9) = Double w.(b,b9);

reserve M for MidSp;
reserve p,q,r,s for Point of M;

registration
  let M;
  cluster vectgroup(M) -> Abelian add-associative right_zeroed
    right_complementable;
end;

theorem 
  (for a being set holds a is Element of vectgroup(M) iff a is
Vector of M) & 0.vectgroup(M) = ID(M) & for a,b being Element of vectgroup(M),
  x,y being Vector of M st a=x & b=y holds a+b = x+y;

definition
  let IT be non empty addLoopStr;
  attr IT is midpoint_operator means


  (for a being Element of IT ex x
being Element of IT st Double x = a) & for a being Element of IT holds Double a
  = 0.IT implies a = 0.IT;
end;

registration
  cluster midpoint_operator -> Fanoian for non empty addLoopStr;
end;

registration
  cluster strict midpoint_operator add-associative right_zeroed
    right_complementable Abelian for non empty addLoopStr;
end;

reserve G for midpoint_operator add-associative right_zeroed
  right_complementable Abelian non empty addLoopStr;
reserve x,y for Element of G;

theorem 
  for G being Fanoian add-associative right_zeroed
right_complementable non empty addLoopStr, x being Element of G holds x = -x
  implies x = 0.G;

theorem 
  for G being Fanoian add-associative right_zeroed
  right_complementable Abelian non empty addLoopStr, x,y being Element of G
  holds Double x = Double y implies x = y;

definition
  let G be midpoint_operator add-associative right_zeroed right_complementable
  Abelian non empty addLoopStr, x be Element of G;
  func Half x -> Element of G means


  Double it = x;
end;

theorem 
  Half 0.G = 0.G & Half (x+y) = Half x + Half y & (Half x = Half y
  implies x = y) & Half Double x = x;

theorem 
  for M being non empty MidStr, w being Function of [:the carrier
of M,the carrier of M:],the carrier of G holds w is_atlas_of the carrier of M,G
& w is associating implies for a,b,c,d being Point of M holds (a@b)@(c@
  d) = (a@c)@(b@d);

theorem 
  for M being non empty MidStr, w being Function of [:the carrier
of M,the carrier of M:],the carrier of G holds w is_atlas_of the carrier of M,G
  & w is associating implies M is MidSp;

reserve x,y for Element of vectgroup(M);

registration
  let M;
  cluster vectgroup(M) -> midpoint_operator;
end;

definition
  let M,p,q;
  func vector(p,q) -> Element of vectgroup(M) equals

  vect(p,q);
end;

definition
  let M;
  func vect(M) -> Function of [:the carrier of M,the carrier of M:], the
  carrier of vectgroup(M) means


  it.(p,q) = vect(p,q);
end;

theorem 
  vect(M) is_atlas_of the carrier of M, vectgroup(M);

theorem 
  vect(p,q) = vect(r,s) iff p@s = q@r;

theorem 
  p@q = r iff vect(p,r) = vect(r,q);

canceled;

registration let M;
  cluster vect M -> associating;
end;



reserve w for Function of [:S,S:],the carrier of G;

definition
  let S,G,w;
  assume
 w is_atlas_of S,G;
  func @(w) -> BinOp of S means


  w.(a,it.(a,b)) = w.(it.(a,b),b);
end;

theorem 
  w is_atlas_of S,G implies for a,b,c holds @(w).(a,b) = c iff w.(
  a,c) = w.(c,b);

registration
  let D be non empty set, M be BinOp of D;
  cluster MidStr(#D,M#) -> non empty;
end;

reserve a,b,c for Point of MidStr(#S,@(w)#);

definition let S,G,w;
  func Atlas(w) -> Function of [:the carrier of MidStr(#S,@(w)#),the carrier
  of MidStr(#S,@(w)#):], the carrier of G equals

  w;
end;

theorem 
  w is_atlas_of S,G implies Atlas(w) is associating;

definition
  let S,G,w;
  assume
 w is_atlas_of S,G;
  func MidSp.w -> strict MidSp equals

  MidStr (# S, @(w) #);
end;

reserve M for non empty MidStr;
reserve w for Function of [:the carrier of M,the carrier of M:], the carrier
  of G;
reserve a,b,b1,b2,c for Point of M;

theorem 
  M is MidSp iff ex G st ex w st w is_atlas_of the carrier of M,G
  & w is associating;

definition
  let M be non empty MidStr;
  struct AtlasStr over M
    (# algebra -> non empty addLoopStr,
      function -> Function of [:the carrier of M,the carrier of M:],
        the carrier of the algebra #);
end;

definition
  let M be non empty MidStr;
  let IT be AtlasStr over M;
  attr IT is ATLAS-like means


  the algebra of IT is midpoint_operator add-associative right_zeroed
  right_complementable Abelian &
  the function of IT is associating &
  the function of IT is_atlas_of the carrier of M,the algebra of IT;
end;

registration
  let M be MidSp;
  cluster ATLAS-like for AtlasStr over M;
end;

definition
  let M be non empty MidSp;
  mode ATLAS of M is ATLAS-like AtlasStr over M;
end;

definition
  let M be non empty MidStr, W be AtlasStr over M;
  mode Vector of W is Element of the algebra of W;
end;

definition
  let M be MidSp;
  let W be AtlasStr over M;
  let a,b be Point of M;
  func W.(a,b) -> Element of the algebra of W equals

  (the function of W).(a,b);
end;

definition
  let M be MidSp;
  let W be AtlasStr over M;
  let a be Point of M;
  let x be Vector of W;
  func (a,x).W -> Point of M equals

  (a,x).(the function of W);
end;

definition
  let M be MidSp, W be ATLAS of M;
  func 0.W -> Vector of W equals

  0.(the algebra of W);
end;

theorem 
  w is_atlas_of the carrier of M,G & w is associating
  implies (a@c = b1@b2 iff w.(a,c) = w.(a,b1) + w.(a,b2));

theorem 
  w is_atlas_of the carrier of M,G & w is associating
  implies (a@c = b iff w.(a,c) = Double w.(a,b));

reserve M for MidSp;
reserve W for ATLAS of M;
reserve a,b,b1,b2,c,d for Point of M;
reserve x for Vector of W;

theorem 
  a@c = b1@b2 iff W.(a,c) = W.(a,b1) + W.(a,b2);

theorem 
  a@c = b iff W.(a,c) = Double W.(a,b);

theorem 
  (for a,x ex b st W.(a,b) = x) & (for a,b,c holds W.(a,b) = W.(a,c)
  implies b = c) & for a,b,c holds W.(a,b) + W.(b,c) = W.(a,c);

theorem 
  W.(a,a) = 0.W & (W.(a,b) = 0.W implies a = b) & W.(a,b) = -W.(b,
a) & (W.(a,b) = W.(c,d) implies W.(b,a) = W.(d,c)) & (for b,x ex a st W.(a,b) =
x) & (W.(b,a) = W.(c,a) implies b = c) & (a@b = c iff W.(a,c) = W.(c,b)) & (a@b
  = c@d iff W.(a,d) = W.(c,b)) & (W.(a,b) = x iff (a,x).W = b);

theorem 
  (a,0.W).W = a;














begin

reserve M for non empty MetrSpace;

definition
  let M be non empty MetrSpace;
  let f be Function of M, M;
  attr f is contraction means


  ex L being Real st 0 < L & L < 1 &
   for x,y being Point of M holds dist(f.x,f.y) <= L*dist(x,y);
end;

registration
  let M be non empty MetrSpace;
  cluster contraction for Function of M, M;
end;

definition
 let M be non empty MetrSpace;
 mode Contraction of M is contraction Function of M, M;
end;


theorem 
  for f being Contraction of M st TopSpaceMetr(M) is compact ex c being
  Point of M st f.c =c & for x being Point of M st f.x=x holds x=c;














begin

definition
  struct(RLSStruct) UNITSTR (#
  carrier -> set,
  ZeroF -> Element of the carrier,
  addF -> BinOp of the carrier,
  Mult -> Function of [:REAL, the carrier:], the carrier,
  scalar -> Function of [: the carrier, the carrier :], REAL #);
end;

registration
  cluster non empty strict for UNITSTR;
end;

registration
  let D be non empty set, Z be Element of D, a be BinOp of D,m be Function of
  [:REAL, D:], D, s be Function of [: D,D:],REAL;
  cluster UNITSTR (#D,Z,a,m,s#) -> non empty;
end;

reserve X for non empty UNITSTR;
reserve a, b for Real;
reserve x, y for Point of X;

definition
  let X;
  let x, y;
  func x .|. y -> Real equals

  (the scalar of X).[x,y];
end;

definition
  let IT be non empty UNITSTR;
  attr IT is RealUnitarySpace-like means


  for x, y, z being Point of IT, a holds
  ( x .|. x = 0 iff x = 0.IT ) & 0 <= x .|. x & x .|. y = y .|. x &
  (x+y) .|. z = x .|. z + y .|. z & (a*x) .|. y = a * ( x .|. y );
end;

registration
  cluster RealUnitarySpace-like vector-distributive scalar-distributive
  scalar-associative scalar-unital Abelian add-associative
    right_zeroed right_complementable strict for non empty UNITSTR;
end;

definition
  mode RealUnitarySpace is RealUnitarySpace-like vector-distributive
  scalar-distributive scalar-associative scalar-unital Abelian
    add-associative right_zeroed right_complementable non empty UNITSTR;
end;

reserve X for RealUnitarySpace;
reserve x, y, z, u, v for Point of X;

definition
  let X, x, y;
  redefine func x .|. y;
  commutativity;
end;

theorem 
  (0.X) .|. (0.X) = 0;

theorem 
  x .|. (y+z) = x .|. y + x .|. z;

theorem 
  x .|. (a*y) = a * x .|. y;

theorem 
  (a*x) .|. y = x .|. (a*y);

theorem 
  (a*x+b*y) .|. z = a * x .|. z + b * y .|. z;

theorem 
  x .|. (a*y + b*z) = a * x .|. y + b * x .|. z;

theorem 
  (-x) .|. y = x .|. (-y);

theorem 
  (-x) .|. y = - x .|. y;

theorem 
  x .|. (-y) = - x .|. y;

theorem 
  (-x) .|. (-y) = x .|. y;

theorem 
  (x - y) .|. z = x .|. z - y .|. z;

theorem 
  x .|. (y - z) = x .|. y - x .|. z;

theorem 
  (x - y) .|. (u - v) = x .|. u - x .|. v - y .|. u + y .|. v;

theorem 
  (0.X) .|. x = 0;

theorem 
  x .|. 0.X = 0;

theorem 
  (x + y) .|. (x + y) = x .|. x + 2 * x .|. y + y .|. y;

theorem 
  (x + y) .|. (x - y) = x .|. x - y .|. y;

theorem 
  (x - y) .|. (x - y) = x .|. x - 2 * x .|. y + y .|. y;

theorem 
  abs(x .|. y) <= sqrt (x .|. x) * sqrt (y .|. y);

definition
  let X, x, y;
  pred x, y are_orthogonal means


  x .|. y = 0;
  symmetry;
end;

theorem 
  x, y are_orthogonal implies x, - y are_orthogonal;

theorem 
  x, y are_orthogonal implies -x, y are_orthogonal;

theorem 
  x, y are_orthogonal implies -x, -y are_orthogonal;

theorem 
  x, 0.X are_orthogonal;

theorem 
  x, y are_orthogonal implies (x + y) .|. (x + y) = x .|. x + y .|. y;

theorem 
  x, y are_orthogonal implies (x - y) .|. (x - y) = x .|. x + y .|. y;

definition
  let X, x;
  func ||.x.|| -> Real equals

  sqrt (x .|. x);
end;

theorem 
  ||.x.|| = 0 iff x = 0.X;

theorem 
  ||.a * x.|| = abs(a) * ||.x.||;

theorem 
  0 <= ||.x.||;

theorem 
  abs(x .|. y) <= ||.x.|| * ||.y.||;

theorem 
  ||.x + y.|| <= ||.x.|| + ||.y.||;

theorem 
  ||.-x.|| = ||.x.||;

theorem 
  ||.x.|| - ||.y.|| <= ||.x - y.||;

theorem 
  abs(||.x.|| - ||.y.||) <= ||.x - y.||;

definition
  let X, x, y;
  func dist(x,y) -> Real equals

  ||.x - y.||;
  commutativity;
end;

theorem 
  dist(x,x) = 0;

theorem 
  dist(x,z) <= dist(x,y) + dist(y,z);

theorem 
  x <> y iff dist(x,y) <> 0;

theorem 
  dist(x,y) >= 0;

theorem 
  x <> y iff dist(x,y) > 0;

theorem 
  dist(x,y) = sqrt ((x-y) .|. (x-y));

theorem 
  dist(x + y,u + v) <= dist(x,u) + dist(y,v);

theorem 
  dist(x - y,u - v) <= dist(x,u) + dist(y,v);

theorem 
  dist(x - z, y - z) = dist(x,y);

theorem 
  dist(x - z,y - z) <= dist(z,x) + dist(z,y);

reserve seq, seq1, seq2, seq3 for sequence of X;
reserve  n for Element of NAT;

definition
  let X be non empty addLoopStr;
  let seq be sequence of X;
  let x be Point of X;

  func seq + x -> sequence of X means


  for n holds it.n = seq.n + x;
end;

theorem 
  for X being non empty addLoopStr, seq being sequence of X holds
  (-seq).n = - seq.n;

definition
  let X, seq1, seq2;
  redefine func seq1 + seq2;
  commutativity;
end;

theorem 
  seq1 + (seq2 + seq3) = (seq1 + seq2) + seq3;

theorem 
  seq1 is constant & seq2 is constant implies seq1 + seq2 is constant;

theorem 
  seq1 is constant & seq2 is constant implies seq1 - seq2 is constant;

theorem 
  seq1 is constant implies a * seq1 is constant;

theorem 
  seq1 - seq2 = seq1 + -seq2;

theorem 
  seq = seq + 0.X;

theorem 
  a * (seq1 + seq2) = a * seq1 + a * seq2;

theorem 
  (a + b) * seq = a * seq + b * seq;

theorem 
  (a * b) * seq = a * (b * seq);

theorem 
  1 * seq = seq;

theorem 
  (-1) * seq = - seq;

theorem 
  seq - x = seq + -x;

theorem 
  seq1 - seq2 = - (seq2 - seq1);

theorem 
  seq = seq - 0.X;

theorem 
  seq = - ( - seq );

theorem 
  seq1 - (seq2 + seq3) = (seq1 - seq2) - seq3;

theorem 
  (seq1 + seq2) - seq3 = seq1 + (seq2 - seq3);

theorem 
  seq1 - (seq2 - seq3) = (seq1 - seq2) + seq3;

theorem 
  a * (seq1 - seq2) = a * seq1 - a * seq2;














begin

reserve X for RealUnitarySpace;
reserve x, y, z, g, g1, g2 for Point of X;
reserve a, q, r for Real;
reserve seq, seq1, seq2, seq9 for sequence of X;
reserve k, n, m, m1, m2 for Element of NAT;

definition
  let X, seq;
  attr seq is convergent means


  ex g st for r st r > 0 ex m st for n st n >= m holds dist(seq.n, g) < r;
end;

theorem 
  seq is constant implies seq is convergent;

theorem 
  seq is convergent & (ex k st for n st k <= n holds seq9.n = seq.n
  ) implies seq9 is convergent;

theorem 
  seq1 is convergent & seq2 is convergent implies seq1 + seq2 is convergent;

theorem 
  seq1 is convergent & seq2 is convergent implies seq1 - seq2 is convergent;

theorem 
  seq is convergent implies a * seq is convergent;

theorem 
  seq is convergent implies - seq is convergent;

theorem 
  seq is convergent implies seq + x is convergent;

theorem 
  seq is convergent implies seq - x is convergent;

theorem 
  seq is convergent iff ex g st for r st r > 0 ex m st for n st n
  >= m holds ||.(seq.n) - g.|| < r;

definition
  let X, seq;
  assume
 seq is convergent;
  func lim seq -> Point of X means


  for r st r > 0 ex m st for n st n >= m holds dist((seq.n) , it) < r;
end;

theorem 
  seq is constant & x in rng seq implies lim seq = x;

theorem 
  seq is constant & (ex n st seq.n = x) implies lim seq = x;

theorem 
  seq is convergent & (ex k st for n st n >= k holds seq9.n = seq.n)
  implies lim seq = lim seq9;

theorem 
  seq1 is convergent & seq2 is convergent implies lim (seq1 + seq2
  ) = (lim seq1) + (lim seq2);

theorem 
  seq1 is convergent & seq2 is convergent implies lim (seq1 - seq2
  ) = (lim seq1) - (lim seq2);

theorem 
  seq is convergent implies lim (a * seq) = a * (lim seq);

theorem 
  seq is convergent implies lim (- seq) = - (lim seq);

theorem 
  seq is convergent implies lim (seq + x) = (lim seq) + x;

theorem 
  seq is convergent implies lim (seq - x) = (lim seq) - x;

theorem 
  seq is convergent implies ( lim seq = g iff for r st r > 0 ex m
  st for n st n >= m holds ||.(seq.n) - g.|| < r );

definition
  let X, seq;
  func ||.seq.|| -> Real_Sequence means


  for n holds it.n =||.(seq.n).||;
end;

theorem 
  seq is convergent implies ||.seq.|| is convergent;

theorem 
  seq is convergent & lim seq = g implies ||.seq.|| is convergent
  & lim ||.seq.|| = ||.g.||;

theorem 
  seq is convergent & lim seq = g implies ||.seq - g.|| is
  convergent & lim ||.seq - g.|| = 0;

definition
  let X;
  let seq;
  let x;
  func dist(seq, x) -> Real_Sequence means


  for n holds it.n =dist((seq. n) , x);
end;

theorem 
  seq is convergent & lim seq = g implies dist(seq, g) is convergent;

theorem 
  seq is convergent & lim seq = g implies dist(seq, g) is
  convergent & lim dist(seq, g) = 0;

theorem 
  seq1 is convergent & lim seq1 = g1 & seq2 is convergent & lim seq2 =
g2 implies ||.seq1 + seq2.|| is convergent & lim ||.seq1 + seq2.|| = ||.g1 + g2
  .||;

theorem 
  seq1 is convergent & lim seq1 = g1 & seq2 is convergent & lim seq2 =
g2 implies ||.(seq1 + seq2) - (g1 + g2).|| is convergent & lim ||.(seq1 + seq2)
  - (g1 + g2).|| = 0;

theorem 
  seq1 is convergent & lim seq1 = g1 & seq2 is convergent & lim seq2 =
g2 implies ||.seq1 - seq2.|| is convergent & lim ||.seq1 - seq2.|| = ||.g1 - g2
  .||;

theorem 
  seq1 is convergent & lim seq1 = g1 & seq2 is convergent & lim seq2 =
g2 implies ||.(seq1 - seq2) - (g1 - g2).|| is convergent & lim ||.(seq1 - seq2)
  - (g1 - g2).|| = 0;

theorem 
  seq is convergent & lim seq = g implies ||.a * seq.|| is convergent &
  lim ||.a * seq.|| = ||.a * g.||;

theorem 
  seq is convergent & lim seq = g implies ||.(a * seq) - (a * g).|| is
  convergent & lim ||.(a * seq) - (a * g).|| = 0;

theorem 
  seq is convergent & lim seq = g implies ||.- seq.|| is convergent &
  lim ||.- seq.|| = ||.- g.||;

theorem 
  seq is convergent & lim seq = g implies ||.(- seq) - (- g).|| is
  convergent & lim ||.(- seq) - (- g).|| = 0;

theorem 
  seq is convergent & lim seq = g implies ||.(seq + x) - (g + x)
  .|| is convergent & lim ||.(seq + x) - (g + x).|| = 0;

theorem 
  seq is convergent & lim seq = g implies ||.seq - x.|| is convergent &
  lim ||.seq - x.|| = ||.g - x.||;

theorem 
  seq is convergent & lim seq = g implies ||.(seq - x) - (g - x).|| is
  convergent & lim ||.(seq - x) - (g - x).|| = 0;

theorem 
  seq1 is convergent & lim seq1 = g1 & seq2 is convergent & lim seq2 =
  g2 implies dist((seq1 + seq2) , (g1 + g2)) is convergent & lim dist((seq1 +
  seq2) , (g1 + g2)) = 0;

theorem 
  seq1 is convergent & lim seq1 = g1 & seq2 is convergent & lim seq2 =
  g2 implies dist((seq1 - seq2) , (g1 - g2)) is convergent & lim dist((seq1 -
  seq2) , (g1 - g2)) = 0;

theorem 
  seq is convergent & lim seq = g implies dist((a * seq) , (a * g)) is
  convergent & lim dist((a * seq) , (a * g)) = 0;

theorem 
  seq is convergent & lim seq = g implies dist((seq + x) , (g + x)) is
  convergent & lim dist((seq + x) , (g + x)) = 0;

definition
  let X, x, r;
  func Ball(x,r) -> Subset of X equals

  {y where y is Point of X : ||.x - y.||
  < r};
  func cl_Ball(x,r) -> Subset of X equals

  {y where y is Point of X : ||.x - y
  .|| <= r};
  func Sphere(x,r) -> Subset of X equals

  {y where y is Point of X : ||.x - y
  .|| = r};
end;

theorem 
  z in Ball(x,r) iff ||.x - z.|| < r;

theorem 
  z in Ball(x,r) iff dist(x,z) < r;

theorem 
  r > 0 implies x in Ball(x,r);

theorem 
  y in Ball(x,r) & z in Ball(x,r) implies dist(y,z) < 2 * r;

theorem 
  y in Ball(x,r) implies y - z in Ball(x - z,r);

theorem 
  y in Ball(x,r) implies (y - x) in Ball (0.(X),r);

theorem 
  y in Ball(x,r) & r <= q implies y in Ball(x,q);

theorem 
  z in cl_Ball(x,r) iff ||.x - z.|| <= r;

theorem 
  z in cl_Ball(x,r) iff dist(x,z) <= r;

theorem 
  r >= 0 implies x in cl_Ball(x,r);

theorem 
  y in Ball(x,r) implies y in cl_Ball(x,r);

theorem 
  z in Sphere(x,r) iff ||.x - z.|| = r;

theorem 
  z in Sphere(x,r) iff dist(x,z) = r;

theorem 
  y in Sphere(x,r) implies y in cl_Ball(x,r);

theorem 
  Ball(x,r) c= cl_Ball(x,r);

theorem 
  Sphere(x,r) c= cl_Ball(x,r);

theorem 
  Ball(x,r) \/ Sphere(x,r) = cl_Ball(x,r);














begin

reserve X for RealUnitarySpace,
  x, g, g1, h for Point of X,
  a, p, r, M, M1, M2 for Real,
  seq, seq1, seq2, seq3 for sequence of X,
  Nseq for increasing sequence of NAT,

  k, l, l1, l2, l3, n, m, m1, m2 for Element of NAT;

definition
  let X;
  let seq;
  attr seq is Cauchy means


  for r st r > 0 ex k st for n, m st n >= k &
  m >= k holds dist(seq.n, seq.m) < r;
end;

theorem 
  seq is constant implies seq is Cauchy;

theorem 
  seq is Cauchy iff for r st r > 0 ex k st for n, m st n >= k & m >= k
  holds ||.(seq.n) - (seq.m).|| < r;

theorem 
  seq1 is Cauchy & seq2 is Cauchy implies seq1 + seq2 is Cauchy;

theorem 
  seq1 is Cauchy & seq2 is Cauchy implies seq1 - seq2 is Cauchy;

theorem 
  seq is Cauchy implies a * seq is Cauchy;

theorem 
  seq is Cauchy implies - seq is Cauchy;

theorem 
  seq is Cauchy implies seq + x is Cauchy;

theorem 
  seq is Cauchy implies seq - x is Cauchy;

theorem 
  seq is convergent implies seq is Cauchy;

definition
  let X;
  let seq1, seq2;
  pred seq1 is_compared_to seq2 means


  for r st r > 0 ex m st for n st n >= m holds dist(seq1.n, seq2.n) < r;
end;

theorem 
  seq is_compared_to seq;

theorem 
  seq1 is_compared_to seq2 implies seq2 is_compared_to seq1;

definition
  let X;
  let seq1, seq2;
  redefine pred seq1 is_compared_to seq2;
  reflexivity;
  symmetry;
end;

theorem 
  seq1 is_compared_to seq2 & seq2 is_compared_to seq3 implies seq1
  is_compared_to seq3;

theorem 
  seq1 is_compared_to seq2 iff for r st r > 0 ex m st for n st n >= m
  holds ||.(seq1.n) - (seq2.n).|| < r;

theorem 
  ( ex k st for n st n >= k holds seq1.n = seq2.n ) implies seq1
  is_compared_to seq2;

theorem 
  seq1 is Cauchy & seq1 is_compared_to seq2 implies seq2 is Cauchy;

theorem 
  seq1 is convergent & seq1 is_compared_to seq2 implies seq2 is convergent;

theorem 
  seq1 is convergent & lim seq1 = g & seq1 is_compared_to seq2 implies
  seq2 is convergent & lim seq2 = g;

definition
  let X;
  let seq;
  attr seq is bounded means


  ex M st M > 0 & for n holds ||.seq.n.|| <= M;
end;

theorem 
  seq1 is bounded & seq2 is bounded implies seq1 + seq2 is bounded;

theorem 
  seq is bounded implies -seq is bounded;

theorem 
  seq1 is bounded & seq2 is bounded implies seq1 - seq2 is bounded;

theorem 
  seq is bounded implies a * seq is bounded;

theorem 
  seq is constant implies seq is bounded;

theorem 
  for m ex M st ( M > 0 & for n st n <= m holds ||.seq.n.|| < M );

theorem 
  seq is convergent implies seq is bounded;

theorem 
  seq1 is bounded & seq1 is_compared_to seq2 implies seq2 is bounded;

theorem 
  seq is bounded & seq1 is subsequence of seq implies seq1 is bounded;

theorem 
  seq is convergent & seq1 is subsequence of seq implies seq1 is convergent;

theorem 
  seq1 is subsequence of seq & seq is convergent implies lim seq1= lim seq;

theorem 
  seq is Cauchy & seq1 is subsequence of seq implies seq1 is Cauchy;

theorem 
  (seq ^\k)^\m = (seq ^\m)^\k;

theorem 
  (seq ^\k)^\m=seq ^\(k + m);

theorem 
  (seq1 + seq2) ^\k = (seq1 ^\k) + (seq2 ^\k);

theorem 
  (-seq) ^\k = -(seq ^\k);

theorem 
  (seq1 - seq2) ^\k = (seq1 ^\k) - (seq2 ^\k);

theorem 
  (a * seq) ^\k = a * (seq ^\k);

theorem 
  seq is convergent implies (seq ^\k) is convergent & lim (seq ^\k)=lim
  seq;

theorem 
  seq is convergent & (ex k st seq = seq1 ^\k) implies seq1 is convergent;

theorem 
  seq is Cauchy & (ex k st seq = seq1 ^\k) implies seq1 is Cauchy;

theorem 
  seq is Cauchy implies (seq ^\k) is Cauchy;

theorem 
  seq1 is_compared_to seq2 implies (seq1 ^\k) is_compared_to (seq2 ^\k);

theorem 
  seq is bounded implies (seq ^\k) is bounded;

theorem 
  seq is constant implies (seq ^\k) is constant;

definition

  let X;
  attr X is complete means


  for seq holds seq is Cauchy implies seq is convergent;
end;

theorem 
  X is complete & seq is Cauchy implies seq is bounded;














begin 

reserve V for non empty set,
  A,B,A9,B9 for Element of V;

definition
  let V;
  func Funcs(V) -> set equals

  union { Funcs(A,B): not contradiction };
end;

registration
  let V;
  cluster Funcs(V) -> functional non empty;
end;

theorem 
  for f being set holds f in Funcs(V) iff ex A,B st (B={} implies A
  ={}) & f is Function of A,B;

theorem 
  Funcs(A,B) c= Funcs(V);

theorem 
  for W be non empty Subset of V holds Funcs W c= Funcs V;

reserve f,f9 for Element of Funcs(V);

definition
  let V;
  func Maps(V) -> set equals

  { [[A,B],f]: (B={} implies A={}) & f is Function
  of A,B};
end;

registration
  let V;
  cluster Maps(V) -> non empty;
end;

reserve m,m1,m2,m3,m9 for Element of Maps V;

theorem 
  ex f,A,B st m = [[A,B],f] & (B = {} implies A = {}) & f is Function of A,B;

theorem 
  for f being Function of A,B st B={} implies A={} holds [[A,B],f] in Maps V;

theorem 
  Maps V c= [:[:V,V:],Funcs V:];

theorem 
  for W be non empty Subset of V holds Maps W c= Maps V;

registration
  let V be non empty set, m be Element of Maps V;
  cluster m`2 -> Function-like Relation-like;
end;

definition
  let V,m;

  func dom m -> Element of V equals

  m`1`1;
  func cod m -> Element of V equals

  m`1`2;
end;

theorem 
  m = [[dom m,cod m],m`2];

theorem 
  (cod m <> {} or dom m = {}) & m`2 is Function of dom m,cod m;

theorem 
  for f being Function, A,B being set st [[A,B],f] in Maps(V)
  holds (B = {} implies A = {}) & f is Function of A,B;

definition
  let V,A;
  func id$ A -> Element of Maps V equals

  [[A,A],id A];
end;

theorem 
  (id$ A)`2 = id A & dom id$ A = A & cod id$ A = A;

definition
  let V,m1,m2;
  assume
 cod m1 = dom m2;
  func m2*m1 -> Element of Maps V equals


  [[dom m1,cod m2],m2`2*m1`2];
end;

theorem 
  dom m2 = cod m1 implies (m2*m1)`2 = m2`2*m1`2 & dom(m2*m1) = dom
  m1 & cod(m2*m1) = cod m2;

theorem 
  dom m2 = cod m1 & dom m3 = cod m2 implies m3*(m2*m1) = (m3*m2)* m1;

theorem 
  m*(id$ dom m) = m & (id$ cod m)*m = m;

definition
  let V,A,B;
  func Maps(A,B) -> set equals

  { [[A,B],f] where f is Element of Funcs V: [[A,
  B],f] in Maps V };
end;

theorem 
  for f being Function of A,B st B = {} implies A = {} holds [[A,B
  ],f] in Maps(A,B);

theorem 
  m in Maps(A,B) implies m = [[A,B],m`2];

theorem 
  Maps(A,B) c= Maps V;

theorem 
  Maps V = union { Maps(A,B): not contradiction };

theorem 
  m in Maps(A,B) iff dom m = A & cod m = B;

theorem 
  m in Maps(A,B) implies m`2 in Funcs(A,B);

definition
  let V,m;
  attr m is surjective means

  rng m`2 = cod(m);
end;

begin  

definition
  let V;
  func fDom V -> Function of Maps V,V means


  for m holds it.m = dom m;
  func fCod V -> Function of Maps V,V means


  for m holds it.m = cod m;
  func fComp V -> PartFunc of [:Maps V,Maps V:],Maps V means


  (for m2,
m1 holds [m2,m1] in dom it iff dom m2 = cod m1) & for m2,m1 st dom m2 = cod m1
  holds it.[m2,m1] = m2*m1;
end;

definition
 canceled;
  let V;
  func Ens(V) -> non empty non void strict CatStr equals

  CatStr(# V,Maps V,fDom V,fCod V,fComp V#);
end;

registration
  let V;
  cluster Ens(V) -> Category-like
   reflexive transitive associative with_identities;
end;

reserve a,b for Object of Ens(V);

canceled;

theorem 
  A is Object of Ens(V);

definition
  let V,A;
  func @A -> Object of Ens(V) equals

  A;
end;

theorem 
  a is Element of V;

definition
  let V,a;
  func @a -> Element of V equals

  a;
end;

reserve f,g,f1,f2 for Morphism of Ens(V);

theorem 
  m is Morphism of Ens(V);

definition
  let V,m;
  func @m -> Morphism of Ens(V) equals

  m;
end;

theorem 
  f is Element of Maps(V);

definition
  let V,f;
  func @f -> Element of Maps(V) equals

  f;
end;

theorem 
  dom f = dom(@f) & cod f = cod(@f);

theorem 
  Hom(a,b) = Maps(@a,@b);

theorem 
  dom g = cod f implies g(*)f = (@g)*(@f);

theorem 
  id a = id$ @a;

theorem 
  a = {} implies a is initial;

theorem 
  {} in V & a is initial implies a = {};

theorem 
  for W being Universe, a being Object of Ens(W) st a is initial holds a
  = {};

theorem 
  (ex x being set st a = {x}) implies a is terminal;

theorem 
  V <> {{}} & a is terminal implies ex x being set st a = {x};

theorem 
  for W being Universe, a being Object of Ens(W) st a is terminal ex x
  being set st a = {x};

theorem 
 for a,b being Object of Ens(V), f being Morphism of a,b st Hom(a,b) <> {}
  holds f is monic iff (@f)`2 is one-to-one;

theorem 
 for a,b being Object of Ens(V), f being Morphism of a,b
   st Hom(a,b) <> {}
  holds f is epi & (ex A st ex x1,x2 being set st x1 in A & x2 in A & x1
  <> x2) implies @f is surjective;

theorem 
 for a,b being Object of Ens(V) st Hom(a,b) <> {}
 for f being Morphism of a,b st  @f is surjective
  holds f is epi;

theorem 
  for W being Universe, a,b being Object of Ens(W) st Hom(a,b) <> {}
  for f being Morphism of a,b st f is epi holds @f
  is surjective;

theorem 
  for W being non empty Subset of V
   holds Ens W is full Subcategory of Ens V;

begin 

reserve C for Category,
  a,b,a9,b9,c for Object of C,
  f,g,h,f9,g9 for Morphism of C;

definition
  let C;
  func Hom(C) -> set equals

  { Hom(a,b): not contradiction };
end;

registration
  let C;
  cluster Hom(C) -> non empty;
end;

theorem 
  Hom(a,b) in Hom(C);



theorem 
  (Hom(a,cod f) = {} implies Hom(a,dom f) = {}) & (Hom(dom f,a) = {}
  implies Hom(cod f,a) = {});

definition
  let C,a,f;
  func hom(a,f) -> Function of Hom(a,dom f),Hom(a,cod f) means


  for g st g in Hom(a,dom f) holds it.g = f(*)g;
  func hom(f,a) -> Function of Hom(cod f,a),Hom(dom f,a) means


  for g st g in Hom(cod f,a) holds it.g = g(*)f;
end;

theorem 
  hom(a,id c) = id Hom(a,c);

theorem 
  hom(id c,a) = id Hom(c,a);

theorem 
  dom g = cod f implies hom(a,g(*)f) = hom(a,g)*hom(a,f);

theorem 
  dom g = cod f implies hom(g(*)f,a) = hom(f,a)*hom(g,a);

theorem 
  [[Hom(a,dom f),Hom(a,cod f)],hom(a,f)] is Element of Maps(Hom(C) );

theorem 
  [[Hom(cod f,a),Hom(dom f,a)],hom(f,a)] is Element of Maps(Hom(C) );

definition
  let C,a;
  func hom?-(a) -> Function of the carrier' of C, Maps(Hom(C)) means


  for f holds it.f = [[Hom(a,dom f),Hom(a,cod f)],hom(a,f)];
  func hom-?(a) -> Function of the carrier' of C, Maps(Hom(C)) means


  for f holds it.f = [[Hom(cod f,a),Hom(dom f,a)],hom(f,a)];
end;

theorem 
  Hom(C) c= V implies hom?-(a) is Functor of C,Ens(V);

theorem 
  Hom(C) c= V implies hom-?(a) is Contravariant_Functor of C,Ens(V );



theorem 
  Hom(dom f,cod f9) = {} implies Hom(cod f,dom f9) = {};

definition
  let C,f,g;
  func hom(f,g) -> Function of Hom(cod f,dom g),Hom(dom f,cod g) means


  for h st h in Hom(cod f,dom g) holds it.h = g(*)h(*)f;
end;

theorem 
  [[Hom(cod f,dom g),Hom(dom f,cod g)],hom(f,g)] is Element of Maps(Hom(C));

theorem 
  hom(id a,f) = hom(a,f) & hom(f,id a) = hom(f,a);

theorem 
  hom(id a,id b) = id Hom(a,b);

theorem 
  hom(f,g) = hom(dom f,g)*hom(f,dom g);

theorem 
  cod g = dom f & dom g9 = cod f9 implies
    hom(f(*)g,g9(*)f9) = hom(g, g9)*hom(f,f9);

definition
  let C;
  func hom??(C) -> Function of the carrier' of [:C,C:], Maps(Hom(C)) means


   for
 f,g holds it.[f,g] = [[Hom(cod f,dom g),Hom(dom f,cod g)],hom(f,g)];
end;

theorem 
  hom?-(a) = (curry (hom??(C))).(id a) & hom-?(a) = (curry' (hom?? (C))).(id a)
;

theorem 
  Hom(C) c= V implies hom??(C) is Functor of [:C opp,C:],Ens(V);

definition
  let V,C,a;
  assume
 Hom(C) c= V;
  func hom?-(V,a) -> Functor of C,Ens(V) equals


  hom?-(a);
  func hom-?(V,a) -> Contravariant_Functor of C,Ens(V) equals


  hom-?(a);
end;

definition
  let V,C;
  assume
 Hom(C) c= V;
  func hom??(V,C) -> Functor of [:C opp,C:],Ens(V) equals


  hom??(C);
end;

theorem 
  Hom(C) c= V implies (hom?-(V,a)).f = [[Hom(a,dom f),Hom(a,cod f)],hom(
  a, f ) ];

theorem 
  Hom(C) c= V implies (Obj (hom?-(V,a))).b = Hom(a,b);

theorem 
  Hom(C) c= V implies (hom-?(V,a)).f = [[Hom(cod f,a),Hom(dom f,a)],hom(
  f, a ) ];

theorem 
  Hom(C) c= V implies (Obj (hom-?(V,a))).b = Hom(b,a);

theorem 
  Hom(C) c= V implies hom??(V,C).[f opp,g] = [[Hom(cod f,dom g),Hom(dom
  f,cod g)],hom(f,g)];

theorem 
  Hom(C) c= V implies (Obj (hom??(V,C))).[a opp,b] = Hom(a,b);

theorem 
  Hom(C) c= V implies hom??(V,C)?-(a opp) = hom?-(V,a);

theorem 
  Hom(C) c= V implies hom??(V,C)-?a = hom-?(V,a);














begin

reserve e,u for set;



theorem 
  for X being TopStruct, Y being SubSpace of X holds the carrier
  of Y c= the carrier of X;

definition

  let X, Y be non empty TopSpace, F be Function of X, Y;
  redefine attr F is continuous means

  for W being Point of X, G being
  a_neighborhood of F.W ex H being a_neighborhood of W st F.:H c= G;
end;

reserve X, Y for non empty TopSpace;

registration
  let X,Y,Z be non empty TopSpace, F be continuous Function of X,Y, G be
  continuous Function of Y,Z;
  cluster G*F -> continuous for Function of X,Z;
end;

theorem 
  for A being continuous Function of X,Y, G being Subset of Y
  holds A"Int G c= Int(A"G);

theorem 
  for W being Point of Y, A being continuous Function of X,Y, G
  being a_neighborhood of W holds A"G is a_neighborhood of A"{W};

definition
  let X,Y be non empty TopSpace, W be Point of Y, A be continuous Function of
  X,Y, G be a_neighborhood of W;
  redefine func A"G -> a_neighborhood of A"{W};
end;

theorem 
  for X being non empty TopSpace, A,B being Subset of X, U being
  a_neighborhood of B st A c= B holds U is a_neighborhood of A;

registration
  let X be non empty TopSpace, x be Point of X;
  cluster {x} -> compact for Subset of X;
end;

begin





definition
  let X,Y be TopSpace;

  func [:X,Y:] -> strict TopSpace means


  the carrier of it = [: the
  carrier of X, the carrier of Y:] & the topology of it = { union A where A is
Subset-Family of it: A c= { [:X1,Y1:] where X1 is Subset of X, Y1 is Subset of
Y: X1 in the topology of X & Y1 in the topology of Y}};
end;

registration
  let T1 be TopSpace, T2 be empty TopSpace;
  cluster [:T1, T2:] -> empty;
  cluster [:T2, T1:] -> empty;
end;

registration
  let X,Y be non empty TopSpace;
  cluster [:X,Y:] -> non empty;
end;

theorem 
  for X, Y being TopSpace for B being Subset of [:X,Y:] holds B is
  open iff ex A being Subset-Family of [:X,Y:] st B = union A & for e st e in A
  ex X1 being Subset of X, Y1 being Subset of Y st e = [:X1,Y1:] & X1 is open &
  Y1 is open;

definition
  let X,Y be TopSpace, A be Subset of X, B be Subset of Y;
  redefine func [:A,B:] -> Subset of [:X,Y:];
end;

definition
  let X,Y be non empty TopSpace, x be Point of X, y be Point of Y;
  redefine func [x,y] -> Point of [:X,Y:];
end;

theorem 
  for X, Y being TopSpace for V being Subset of X, W being Subset
  of Y st V is open & W is open holds [:V,W:] is open;

theorem 
  for X, Y being TopSpace for V being Subset of X, W being Subset
  of Y holds Int [:V,W:] = [:Int V, Int W:];

theorem 
  for x being Point of X, y being Point of Y, V being
  a_neighborhood of x, W being a_neighborhood of y holds [:V,W:] is
  a_neighborhood of [x,y];

theorem 
  for A being Subset of X, B being Subset of Y, V being
  a_neighborhood of A, W being a_neighborhood of B holds [:V,W:] is
  a_neighborhood of [:A,B:];

definition
  let X,Y be non empty TopSpace, x be Point of X, y be Point of Y, V be
  a_neighborhood of x, W be a_neighborhood of y;
  redefine func [:V,W:] -> a_neighborhood of [x,y];
end;

theorem 
  for XT being Point of [:X,Y:] ex W being Point of X, T being
  Point of Y st XT=[W,T];

definition
  let X,Y be non empty TopSpace, A be Subset of X, t be Point of Y, V be
  a_neighborhood of A, W be a_neighborhood of t;
  redefine func [:V,W:] -> a_neighborhood of [:A,{t}:];
end;

definition
  let X,Y be TopSpace;
  let A be Subset of [:X,Y:];
  func Base-Appr A -> Subset-Family of [:X,Y:] equals

  { [:X1,Y1:] where X1 is
  Subset of X, Y1 is Subset of Y: [:X1,Y1:] c= A & X1 is open & Y1 is open};
end;

registration
  let X, Y be TopSpace, A be Subset of [:X,Y:];
  cluster Base-Appr A -> open;
end;

theorem 
  for X, Y being TopSpace for A,B being Subset of [:X,Y:] st A c=
  B holds Base-Appr A c= Base-Appr B;

theorem 
  for X, Y being TopSpace, A being Subset of [:X,Y:] holds union
  Base-Appr A c= A;

theorem 
  for X, Y being TopSpace, A being Subset of [:X,Y:] st A is open
  holds A = union Base-Appr A;

theorem 
  for X, Y being TopSpace, A being Subset of [:X,Y:] holds Int A =
  union Base-Appr A;

definition
  let X,Y be non empty TopSpace;
  func Pr1(X,Y) -> Function of bool the carrier of [:X,Y:], bool the carrier
  of X equals

  .:pr1(the carrier of X,the carrier of Y);
  func Pr2(X,Y) -> Function of bool the carrier of [:X,Y:], bool the carrier
  of Y equals

  .:pr2(the carrier of X,the carrier of Y);
end;

theorem 
  for A being Subset of [:X,Y:], H being Subset-Family of [:X,Y:]
st for e st e in H holds e c= A & ex X1 being Subset of X, Y1 being Subset of Y
  st e =[:X1,Y1:] holds [:union(Pr1(X,Y).:H), meet(Pr2(X,Y).:H):] c= A;

theorem 
  for H being Subset-Family of [:X,Y:], C being set st C in Pr1(X,
  Y).:H ex D being Subset of [:X,Y:] st D in H & C = pr1(the carrier of X, the
  carrier of Y).:D;

theorem 
  for H being Subset-Family of [:X,Y:], C being set st C in Pr2(X,
  Y).:H ex D being Subset of [:X,Y:] st D in H & C = pr2(the carrier of X, the
  carrier of Y).:D;

theorem 
  for D being Subset of [:X,Y:] st D is open holds for X1 being
Subset of X, Y1 being Subset of Y holds (X1 = pr1(the carrier of X, the carrier
of Y).:D implies X1 is open) & (Y1 = pr2(the carrier of X, the carrier of Y).:D
  implies Y1 is open);

theorem 
  for H being Subset-Family of [:X,Y:] st H is open holds Pr1(X,Y)
  .:H is open & Pr2(X,Y).:H is open;

theorem 
  for H being Subset-Family of [:X,Y:] st Pr1(X,Y).:H = {} or Pr2(
  X,Y).:H = {} holds H = {};

theorem 
  for H being Subset-Family of [:X,Y:], X1 being Subset of X, Y1
being Subset of Y st H is Cover of [:X1,Y1:] holds (Y1 <> {} implies Pr1(X,Y).:
  H is Cover of X1) & (X1 <> {} implies Pr2(X,Y).:H is Cover of Y1);

theorem 
  for X, Y being TopSpace, H being Subset-Family of X, Y being
  Subset of X st H is Cover of Y ex F being Subset-Family of X st F c= H & F is
  Cover of Y & for C being set st C in F holds C meets Y;

theorem 
  for F being Subset-Family of X, H being Subset-Family of [:X,Y:]
st F is finite & F c= Pr1(X,Y).:H ex G being Subset-Family of [:X,Y:] st G c= H
  & G is finite & F = Pr1(X,Y).:G;

theorem 
  for X1 being Subset of X, Y1 being Subset of Y st [:X1,Y1:] <> {}
  holds Pr1(X,Y). [:X1,Y1:] = X1 & Pr2(X,Y). [:X1,Y1:] = Y1;

theorem 
  for t being Point of Y, A being Subset of X st A is compact for
  G being a_neighborhood of [:A,{t}:] ex V being a_neighborhood of A, W being
  a_neighborhood of t st [:V,W:] c= G;

begin





definition
  let X be 1-sorted;
  func TrivDecomp X -> a_partition of the carrier of X equals

  Class(id the
  carrier of X);
end;

registration
  let X be non empty 1-sorted;
  cluster TrivDecomp X -> non empty;
end;

theorem 
  for A being Subset of X st A in TrivDecomp X ex x being Point of X st A = {x}
;

definition
  let X be TopSpace, D be a_partition of the carrier of X;
  func space D -> strict TopSpace means


  the carrier of it = D & the
  topology of it = { A where A is Subset of D : union A in the topology of X};
end;

registration
  let X be non empty TopSpace, D be a_partition of the carrier of X;
  cluster space D -> non empty;
end;

theorem 
  for D being non empty a_partition of the carrier of X, A being
Subset of D holds union A in the topology of X iff A in the topology of space D
;

definition
  let X be non empty TopSpace, D be non empty a_partition of the carrier of X;
  func Proj D -> continuous Function of X, space D equals

  proj D;
end;

theorem 
  for D being non empty a_partition of the carrier of X, W being Point
  of X holds W in Proj D.W;

theorem 
  for D being non empty a_partition of the carrier of X, W being
  Point of space D ex W9 being Point of X st Proj(D).W9=W;

theorem 
  for D being non empty a_partition of the carrier of X holds rng
  Proj D = the carrier of space D;

definition
  let XX be non empty TopSpace, X be non empty SubSpace of XX, D be non empty
  a_partition of the carrier of X;
  func TrivExt D -> non empty a_partition of the carrier of XX equals

  D \/ {{p
  } where p is Point of XX : not p in the carrier of X};
end;

theorem 
  for XX being non empty TopSpace, X being non empty SubSpace of
XX, D being non empty a_partition of the carrier of X, A being Subset of XX st
A in TrivExt D holds A in D or ex x being Point of XX st not x in [#]X & A = {x
  };

theorem 
  for XX being non empty TopSpace, X being non empty SubSpace of
  XX, D being non empty a_partition of the carrier of X, x being Point of XX st
  not x in the carrier of X holds {x} in TrivExt D;

theorem 
  for XX being non empty TopSpace, X being non empty SubSpace of
XX, D being non empty a_partition of the carrier of X, W being Point of XX st W
  in the carrier of X holds Proj(TrivExt D).W=Proj(D).W;

theorem 
  for XX being non empty TopSpace, X being non empty SubSpace of
  XX, D being non empty a_partition of the carrier of X, W being Point of XX st
  not W in the carrier of X holds Proj TrivExt D.W = {W};

theorem 
  for XX being non empty TopSpace, X being non empty SubSpace of
  XX, D being non empty a_partition of the carrier of X, W,W9 being Point of XX
st not W in the carrier of X & Proj(TrivExt D).W=Proj(TrivExt D).W9 holds W=W9;

theorem 
  for XX being non empty TopSpace , X being non empty SubSpace of
  XX for D being non empty a_partition of the carrier of X for e being Point of
  XX st Proj TrivExt D.e in the carrier of space D holds e in the carrier of X;

theorem 
  for XX being non empty TopSpace , X being non empty SubSpace of
  XX for D being non empty a_partition of the carrier of X for e st e in the
  carrier of X holds Proj TrivExt D.e in the carrier of space D;

begin





definition
  let X be non empty TopSpace;
  mode u.s.c._decomposition of X -> non empty a_partition of the carrier of X
    means


    for A being Subset of X st A in it for V being a_neighborhood of
A ex W being Subset of X st W is open & A c= W & W c= V & for B being Subset of
    X st B in it & B meets W holds B c= W;
end;

theorem 
  for D being u.s.c._decomposition of X, t being Point of space D,
G being a_neighborhood of Proj D " {t} holds Proj(D).:G is a_neighborhood of t;

theorem 
  TrivDecomp X is u.s.c._decomposition of X;

definition
  let X be TopSpace;
  let IT be SubSpace of X;
  attr IT is closed means


  for A being Subset of X st A = the carrier of IT holds A is closed;
end;

registration
  let X be TopSpace;
  cluster strict closed for SubSpace of X;
end;

registration
  let X;
  cluster strict closed non empty for SubSpace of X;
end;

definition
  let XX be non empty TopSpace, X be closed non empty SubSpace of XX,D be
  u.s.c._decomposition of X;
  redefine func TrivExt D -> u.s.c._decomposition of XX;
end;

definition
  let X be non empty TopSpace;
  let IT be u.s.c._decomposition of X;
  attr IT is DECOMPOSITION-like means


  for A being Subset of X st A in IT holds A is compact;
end;



registration
  let X be non empty TopSpace;
  cluster DECOMPOSITION-like for u.s.c._decomposition of X;
end;

definition
  let X be non empty TopSpace;
  mode DECOMPOSITION of X is DECOMPOSITION-like u.s.c._decomposition of X;
end;

definition
  let XX be non empty TopSpace, X be closed non empty SubSpace of XX, D be
  DECOMPOSITION of X;
  redefine func TrivExt D -> DECOMPOSITION of XX;
end;

definition
  let X be non empty TopSpace, Y be closed non empty SubSpace of X, D be
  DECOMPOSITION of Y;
  redefine func space D -> strict closed SubSpace of space TrivExt D;
end;

begin

definition
  func I[01] -> TopStruct means


  for P being Subset of TopSpaceMetr(
  RealSpace) st P = [.0,1.] holds it = (TopSpaceMetr RealSpace)|P;
end;

registration
  cluster I[01] -> strict non empty TopSpace-like;
end;

theorem 
  the carrier of I[01] = [.0,1.];

definition
  func 0[01] -> Point of I[01] equals

  0;
  func 1[01] -> Point of I[01] equals

  1;
end;

definition
  let A be non empty TopSpace, B be non empty SubSpace of A, F be Function of
  A,B;
  attr F is being_a_retraction means


  for W being Point of A st W in the carrier of B holds F.W=W;
end;

definition
  let X be non empty TopSpace,Y be non empty SubSpace of X;
  pred Y is_a_retract_of X means

  ex F being continuous Function of X,Y st F is being_a_retraction;
  pred Y is_an_SDR_of X means

  ex H being continuous Function of [:X,I[01]:],X
st for A being Point of X holds H. [A,0[01]] = A & H. [A,1[01]] in the carrier
of Y & (A in the carrier of Y implies for T being Point of I[01] holds H. [A,T]
  =A);
end;

theorem 
  for XX being non empty TopSpace, X being closed non empty SubSpace of
  XX, D being DECOMPOSITION of X st X is_a_retract_of XX holds space D
  is_a_retract_of space TrivExt D;


theorem 
  for XX being non empty TopSpace, X being closed non empty SubSpace of
XX, D being DECOMPOSITION of X st X is_an_SDR_of XX holds space(D) is_an_SDR_of
  space(TrivExt D);

theorem 
  for r being real number holds 0 <= r & r <= 1 iff r in the carrier of I[01];














begin

reserve M for non empty MetrSpace,
  c,g1,g2 for Element of M;
reserve N for non empty MetrStruct,
  w for Element of N,
  G for Subset-Family of N,
  C for Subset of N;
reserve R for Reflexive non empty MetrStruct;
reserve T for Reflexive symmetric triangle non empty MetrStruct,
  t1 for Element of T,
  Y for Subset-Family of T,
  P for Subset of T;
reserve f for Function,
  n,m,p,n1,n2,k for Element of NAT,
  r,s,L for Real,
  x,y for set;

theorem 
  for L st 0<L & L<1 holds for n,m st n<=m holds L to_power m <= L to_power n;

theorem 
  for L st 0<L & L<1 holds for k holds L to_power k <= 1 & 0 < L to_power k;

theorem 
  for L st 0<L & L<1 holds for s st 0<s ex n st L to_power n<s;

definition
  let N;
  attr N is totally_bounded means


  for r st r>0 ex G st G is finite &
  the carrier of N = union G & for C st C in G ex w st C = Ball(w,r);
end;

reserve S1 for sequence of M,
  S2 for sequence of N;

theorem 
  f is sequence of N iff dom f = NAT & for n holds f.n is Element of N;

definition
  let N,S2;

  attr S2 is convergent means


  ex x being Element of N st for r st r>0
  ex n st for m st n<=m holds dist(S2.m,x)<r;
end;

definition
  let M,S1;
  assume
 S1 is convergent;
  func lim S1 -> Element of M means

  for r st r>0 ex n st for m st m>=n holds dist(S1.m,it)<r;
end;

definition
  let N,S2;
  attr S2 is Cauchy means


  for r st r>0 ex p st for n,m st p<=n & p<=m holds dist(S2.n,S2.m)<r;
end;

definition
  let N;
  attr N is complete means


  for S2 st S2 is Cauchy holds S2 is convergent;
end;

definition let N,S2; let n be Element of NAT;
 redefine func S2.n -> Element of N;
end;

theorem 
  N is triangle symmetric & S2 is convergent implies S2 is Cauchy;

registration
  let M be triangle symmetric non empty MetrStruct;
  cluster convergent -> Cauchy for sequence of M;
end;

theorem 
  for N being symmetric non empty MetrStruct, S2 being sequence of N
   holds S2 is Cauchy iff for r st r>0 ex p st for
         n,k st p<=n holds dist(S2.(n+k),S2.n)<r;

theorem 
  for f being Contraction of M st M is complete ex c st f.c = c & for y
  being Element of M st f.y=y holds y=c;

theorem 
  TopSpaceMetr(T) is compact implies T is complete;

theorem 
  N is Reflexive triangle & TopSpaceMetr(N) is compact implies N is
  totally_bounded;

definition
  let N be non empty MetrStruct;

  attr N is bounded means


  ex r st 0<r & for x,y being Point of N holds dist(x,y)<=r;
  let C be Subset of N;
  attr C is bounded means


  ex r st 0<r & for x,y being Point of N st x in C & y in C holds dist(x,y)<=r;
end;

registration
  let A be non empty set;
  cluster DiscreteSpace(A) -> bounded;
end;

registration
  cluster bounded for non empty MetrSpace;
end;

registration
  let N;
  cluster empty -> bounded for Subset of N;
end;

registration
  let N;
  cluster bounded for Subset of N;
end;

theorem 
  for C being Subset of N holds ( C <> {} & C is bounded implies
ex r,w st 0<r & w in C & for z being Point of N st z in C holds dist(w,z)<=r )
& (N is symmetric triangle & (ex r,w st 0<r & for z being Point of N st z in C
  holds dist(w,z)<=r) implies C is bounded);

theorem 
  for r being real number holds N is Reflexive & 0<r implies w in Ball(w,r);

theorem 
  for r being real number holds r<=0 implies Ball(t1,r) = {};

registration
  let T,t1; let r be real number;
  cluster Ball(t1,r) -> bounded;
end;

theorem 
  for P, Q being Subset of T holds P is bounded & Q is bounded
  implies P \/ Q is bounded;

theorem 
  for C, D being Subset of N holds C is bounded & D c= C implies D is bounded;

theorem 
  for P being Subset of T holds P = {t1} implies P is bounded;

theorem 
  for P being Subset of T holds P is finite implies P is bounded;

registration
  let T;
  cluster finite -> bounded for Subset of T;
end;

registration
  let T;
  cluster finite non empty for Subset of T;
end;

theorem 
  Y is finite & (for P being Subset of T st P in Y holds P is
  bounded) implies union Y is bounded;

theorem 
  N is bounded iff [#]N is bounded;

registration
  let N be bounded non empty MetrStruct;
  cluster [#]N -> bounded;
end;

theorem 
  T is totally_bounded implies T is bounded;

definition
  let N be Reflexive non empty MetrStruct, C be Subset of N;
  assume
 C is bounded;
  func diameter C -> Real means


  (for x,y being Point of N st x in C &
y in C holds dist(x,y)<=it) & for s st (for x,y being Point of N st x in C & y
  in C holds dist(x,y)<=s) holds it<=s if C <> {} otherwise it = 0;
end;

theorem 
  for P being Subset of T holds P = {x} implies diameter P = 0;

theorem 
  for S being Subset of R st S is bounded holds 0 <= diameter S;

theorem 
  for A being Subset of M holds A <> {} & A is bounded & diameter A = 0
  implies ex g being Point of M st A = {g};

theorem 
  0<r implies diameter Ball(t1,r) <= 2*r;

theorem 
  for S, V being Subset of R holds S is bounded & V c= S implies
  diameter V <= diameter S;

theorem 
  for P, Q being Subset of T holds P is bounded & Q is bounded & P meets
  Q implies diameter (P \/ Q) <= diameter P + diameter Q;

theorem 
  for S1 being sequence of T holds S1 is Cauchy implies rng S1 is bounded;














begin 

reserve x, y for set;
reserve D for non empty set;
reserve UN for Universe;

theorem 
  for u1,u2,u3,u4 being Element of UN holds [u1,u2,u3] in UN & [u1,
  u2,u3,u4] in UN;



theorem 
  op2.({},{}) = {} & op1.{} = {} & op0 = {};

theorem 
  {{}} in UN & [{{}},{{}}] in UN & [:{{}},{{}}:] in UN & op2 in UN & op1 in UN;

registration
  cluster Trivial-addLoopStr -> midpoint_operator;
end;

theorem 
  (for x being Element of Trivial-addLoopStr holds x = {}) & (for x,y
  being Element of Trivial-addLoopStr holds x+y = {}) & (for x being Element of
  Trivial-addLoopStr holds -x = {}) & 0.Trivial-addLoopStr = {};



reserve C for Category;
reserve O for non empty Subset of the carrier of C;

definition
  let C,O;

  func Morphs(O) -> Subset of the carrier' of C equals

  union{Hom(a,b) where a
  is Object of C,b is Object of C : a in O & b in O};
end;

registration
  let C,O;
  cluster Morphs(O) -> non empty;
end;

definition
  let C,O;
  func dom(O) -> Function of Morphs(O),O equals

  (the Source of C)|Morphs(O);
  func cod(O) -> Function of Morphs(O),O equals

  (the Target of C)|Morphs(O);
  func comp(O) -> PartFunc of [:Morphs(O),(Morphs(O)):],Morphs(O) equals

  (the Comp of C)||Morphs(O);
 canceled;
end;

definition
  let C,O;
  func cat(O) -> Subcategory of C equals

  CatStr (# O,Morphs(O),dom(O),cod(O),comp(O)#);
end;

registration
  let C,O;
  cluster cat(O) -> strict;
end;

theorem 
  the carrier of cat(O) = O;



definition
  let G be non empty 1-sorted, H be non empty ZeroStr;

  func ZeroMap(G,H) -> Function of G,H equals

  (the carrier of G) --> 0.H;
end;

theorem 
  comp Trivial-addLoopStr = op1;

registration
 let G be non empty addMagma, H being right_zeroed non empty addLoopStr;
 cluster ZeroMap(G,H) -> additive;
end;

registration
 let G be non empty addMagma, H be right_zeroed non empty addLoopStr;
 cluster additive for Function of G,H;
end;

theorem 
  for G1,G2,G3 being non empty addMagma, f being Function of G1,
  G2, g being Function of G2,G3 st f is additive & g is additive holds g*f is
  additive;

registration
 let G1 be non empty addMagma,
     G2,G3 being right_zeroed non empty addLoopStr,
     f being additive Function of G1, G2,
     g being additive Function of G2, G3;
 cluster g*f -> additive for Function of G1, G3;
end;



reserve G,H for AddGroup;

definition
  struct GroupMorphismStr (# Source,Target -> AddGroup, Fun -> Function of the
    Source, the Target #);
end;

definition
 canceled;
  let f be GroupMorphismStr;
  func dom(f) -> AddGroup equals

  the Source of f;
  func cod(f) -> AddGroup equals

  the Target of f;
end;

definition
  let f be GroupMorphismStr;
  func fun(f) -> Function of dom(f),cod(f) equals

  the Fun of f;
end;

theorem 
  for f being GroupMorphismStr, G1,G2 being AddGroup, f0 being Function
  of G1,G2 st f = GroupMorphismStr(# G1,G2,f0#) holds dom f = G1 & cod f = G2 &
  fun f = f0;

definition
  let G,H;
  func ZERO(G,H) -> GroupMorphismStr equals

  GroupMorphismStr(# G,H,ZeroMap(G,H)#);
end;

registration
  let G,H;
  cluster ZERO(G,H) -> strict;
end;

definition
  let IT be GroupMorphismStr;
  attr IT is GroupMorphism-like means


  fun(IT) is additive;
end;

registration
  cluster strict GroupMorphism-like for GroupMorphismStr;
end;

definition
  mode GroupMorphism is GroupMorphism-like GroupMorphismStr;
end;

theorem 
  for F being GroupMorphism holds the Fun of F is additive;

registration
  let G,H;
  cluster ZERO(G,H) -> GroupMorphism-like;
end;

definition
  let G,H;
  mode Morphism of G,H -> GroupMorphism means


    dom(it) = G & cod(it) = H;
end;

registration
  let G,H;
  cluster strict for Morphism of G,H;
end;

theorem 
  for f being strict GroupMorphismStr st dom(f) = G & cod(f) = H &
  fun(f) is additive holds f is strict Morphism of G,H;

theorem 
  for f being Function of G,H st f is additive holds
  GroupMorphismStr (# G,H,f#) is strict Morphism of G,H;

registration let G be non empty addMagma;
 cluster id G -> additive;
end;

definition
  let G;
  func ID G -> Morphism of G,G equals

  GroupMorphismStr(# G,G,id G#);
end;

registration
  let G;
  cluster ID G -> strict;
end;

definition
  let G,H;
  redefine func ZERO(G,H) -> strict Morphism of G,H;
end;

theorem 
  for F being Morphism of G,H ex f being Function of G,H st the
  GroupMorphismStr of F = GroupMorphismStr(# G,H,f#) & f is additive;

theorem 
  for F being strict Morphism of G,H ex f being Function of G,H st
  F = GroupMorphismStr(# G,H,f#);

theorem 
  for F being GroupMorphism ex G,H st F is Morphism of G,H;

theorem 
  for F being strict GroupMorphism ex G,H being AddGroup, f being
Function of G,H st F is Morphism of G,H & F = GroupMorphismStr(# G,H,f#) & f is
  additive;

theorem 
  for g,f being GroupMorphism st dom(g) = cod(f) ex G1,G2,G3 being
  AddGroup st g is Morphism of G2,G3 & f is Morphism of G1,G2;

definition
  let G,F be GroupMorphism;
  assume
 dom(G) = cod(F);
  func G*F -> strict GroupMorphism means


  for G1,G2,G3 being AddGroup,
g being Function of G2,G3, f being Function of G1,G2 st the GroupMorphismStr of
G = GroupMorphismStr(# G2,G3,g#) & the GroupMorphismStr of F = GroupMorphismStr
  (# G1,G2,f#) holds it = GroupMorphismStr(# G1,G3,g*f#);
end;

theorem 
  for G1,G2,G3 being AddGroup, G being Morphism of G2,G3, F being
  Morphism of G1,G2 holds G*F is Morphism of G1,G3;

definition
  let G1,G2,G3 be AddGroup, G be Morphism of G2,G3, F be Morphism of G1,G2;
  redefine func G*F -> strict Morphism of G1,G3;
end;

theorem 
  for G1,G2,G3 being AddGroup, G being Morphism of G2,G3, F being
Morphism of G1,G2, g being Function of G2,G3, f being Function of G1,G2 st G =
  GroupMorphismStr(# G2,G3,g#) & F = GroupMorphismStr(# G1,G2,f#) holds G*F =
  GroupMorphismStr(# G1,G3,g*f#);

theorem 
  for f,g being strict GroupMorphism st dom g = cod f holds ex G1,
G2,G3 being AddGroup, f0 being Function of G1,G2, g0 being Function of G2,G3 st
  f = GroupMorphismStr(# G1,G2,f0#) & g = GroupMorphismStr(# G2,G3,g0#) & g*f =
  GroupMorphismStr(# G1,G3,g0*f0#);

theorem 
  for f,g being strict GroupMorphism st dom g = cod f holds dom(g*
  f) = dom f & cod (g*f) = cod g;

theorem 
  for G1,G2,G3,G4 being AddGroup, f being strict Morphism of G1,G2
, g being strict Morphism of G2,G3, h being strict Morphism of G3,G4 holds h*(g
  *f) = (h*g)*f;

theorem 
  for f,g,h being strict GroupMorphism st dom h = cod g & dom g =
  cod f holds h*(g*f) = (h*g)*f;

theorem 
  dom ID(G) = G & cod ID(G) = G & (for f being strict
  GroupMorphism st cod f = G holds (ID G)*f = f) & for g being strict
  GroupMorphism st dom g = G holds g*(ID G) = g;



definition
  let IT be set;
  attr IT is Group_DOMAIN-like means


  for x being set st x in IT holds x is strict AddGroup;
end;

registration
  cluster Group_DOMAIN-like non empty for set;
end;

definition
  mode Group_DOMAIN is Group_DOMAIN-like non empty set;
end;

reserve V for Group_DOMAIN;

definition
  let V;
  redefine mode Element of V -> AddGroup;
end;

registration
  let V;
  cluster strict for Element of V;
end;



definition
  let IT be set;
  attr IT is GroupMorphism_DOMAIN-like means


  for x being set st x in IT holds x is strict GroupMorphism;
end;

registration
  cluster GroupMorphism_DOMAIN-like non empty for set;
end;

definition
  mode GroupMorphism_DOMAIN is GroupMorphism_DOMAIN-like non empty set;
end;

definition
  let M be GroupMorphism_DOMAIN;
  redefine mode Element of M -> GroupMorphism;
end;

registration
  let M be GroupMorphism_DOMAIN;
  cluster strict for Element of M;
end;

theorem 
  for f being strict GroupMorphism holds {f} is GroupMorphism_DOMAIN;

definition
  let G,H;
  mode GroupMorphism_DOMAIN of G,H -> GroupMorphism_DOMAIN means


    for x being Element of it holds x is strict Morphism of G,H;
end;

theorem 
  D is GroupMorphism_DOMAIN of G,H iff for x being Element of D
  holds x is strict Morphism of G,H;

theorem 
  for f being strict Morphism of G,H holds {f} is GroupMorphism_DOMAIN of G, H;

definition
  let G,H be 1-sorted;
  mode MapsSet of G,H means


    for x being set st x in it holds x is Function of G,H;
end;

definition
  let G,H be 1-sorted;
  func Maps(G,H) -> MapsSet of G,H equals

  Funcs(the carrier of G, the carrier
  of H);
end;

registration
  let G be 1-sorted, H be non empty 1-sorted;
  cluster Maps(G,H) -> non empty;
end;

registration
  let G be 1-sorted, H be non empty 1-sorted;
  cluster non empty for MapsSet of G,H;
end;

definition
  let G be 1-sorted, H be non empty 1-sorted;
  let M be non empty MapsSet of G,H;
  redefine mode Element of M -> Function of G,H;
end;

definition
  let G,H;
  func Morphs(G,H) -> GroupMorphism_DOMAIN of G,H means


  x in it iff x is strict Morphism of G,H;
end;

definition
  let G,H;
  let M be GroupMorphism_DOMAIN of G,H;
  redefine mode Element of M -> Morphism of G,H;
end;

registration
  let G,H;
  let M be GroupMorphism_DOMAIN of G,H;
  cluster strict for Element of M;
end;



definition
  let x,y;
  pred GO x,y means


  ex x1,x2,x3,x4 being set st x = [x1,x2,x3,x4] & ex
G being strict AddGroup st y = G & x1 = the carrier of G & x2 = the addF of G &
  x3 = comp G & x4 = 0.G;
end;

theorem 
  for x,y1,y2 being set st GO x,y1 & GO x,y2 holds y1 = y2;

theorem 
  ex x st x in UN & GO x,Trivial-addLoopStr;

definition
  let UN;
  func GroupObjects(UN) -> set means


  for y holds y in it iff ex x st x in UN & GO x,y;
end;

theorem 
  Trivial-addLoopStr in GroupObjects(UN);

registration
  let UN;
  cluster GroupObjects(UN) -> non empty;
end;

theorem 
  for x being Element of GroupObjects(UN) holds x is strict AddGroup;

registration
  let UN;
  cluster GroupObjects(UN) -> Group_DOMAIN-like;
end;



definition
  let V;
  func Morphs(V) -> GroupMorphism_DOMAIN means


  for x holds x in it iff
  ex G,H being strict Element of V st x is strict Morphism of G,H;
end;





definition
  let V;
  let F be Element of Morphs(V);
  redefine func dom(F) -> strict Element of V;
  redefine func cod(F) -> strict Element of V;
end;

definition
  let V;
  let G be Element of V;
  func ID(G) -> strict Element of Morphs(V) equals

  ID(G);
end;

definition
  let V;
  func dom(V) -> Function of Morphs(V),V means


  for f being Element of Morphs(V) holds it.f = dom(f);
  func cod(V) -> Function of Morphs(V),V means


  for f being Element of Morphs(V) holds it.f = cod(f);
end;





theorem 
  for g,f being Element of Morphs(V) st dom(g) = cod(f) ex G1,G2,
G3 being strict Element of V st g is Morphism of G2,G3 & f is Morphism of G1,G2
;

theorem 
  for g,f being Element of Morphs(V) st dom(g) = cod(f) holds g*f in Morphs(V);

definition
  let V;
  func comp(V) -> PartFunc of [:Morphs(V),Morphs(V):],Morphs(V) means


(for g,f being Element of Morphs(V) holds [g,f] in dom it iff dom(g) = cod(f))
  & for g,f being Element of Morphs(V) st [g,f] in dom it holds it.(g,f) = g*f;
end;





definition
  let UN;
  func GroupCat(UN) -> non empty non void strict CatStr equals

  CatStr(# GroupObjects(UN),Morphs(
    GroupObjects(UN)), dom(GroupObjects(UN)),cod(GroupObjects(UN)), comp(
    GroupObjects(UN))#);
end;

registration
  let UN;
  cluster GroupCat(UN) -> strict non void non empty;
end;

theorem 
  for f,g being Morphism of GroupCat(UN) holds [g,f] in dom(the
  Comp of GroupCat(UN)) iff dom g = cod f;

theorem 
  for f being (Morphism of GroupCat(UN)), f9 being Element of
  Morphs(GroupObjects(UN)), b being Object of GroupCat(UN), b9 being Element of
GroupObjects(UN) holds f is strict Element of Morphs(GroupObjects(UN)) & f9 is
  Morphism of GroupCat(UN) & b is strict Element of GroupObjects(UN) & b9 is
  Object of GroupCat(UN);

canceled;

theorem 
  for f,g being (Morphism of GroupCat(UN)),
      f9,g9 being Element of Morphs(GroupObjects(UN)) st f = f9 & g = g9
 holds
  (dom g = cod f iff dom g9 = cod f9) &
  (dom g = cod f iff [g9,f9] in dom comp(GroupObjects(UN))) &
  (dom g = cod f implies g(*)f = g9*f9) &
  (dom f = dom g iff dom f9 = dom g9) &
  (cod f = cod g iff cod f9 = cod g9);

registration
  let UN;
  cluster GroupCat UN -> reflexive Category-like;
end;

registration
  let UN;
  cluster GroupCat UN ->
   transitive associative with_identities;
end;

definition
  let UN;
  func AbGroupObjects(UN) -> Subset of the carrier of GroupCat(UN) equals

  {G
where G is Element of GroupCat(UN) : ex H being AbGroup st G = H
  };
end;

theorem 
  Trivial-addLoopStr in AbGroupObjects(UN);

registration
  let UN;
  cluster AbGroupObjects(UN) -> non empty;
end;

definition
  let UN;
  func AbGroupCat UN -> Subcategory of GroupCat(UN) equals

  cat AbGroupObjects UN;
end;

registration
  let UN;
  cluster AbGroupCat(UN) -> strict;
end;

theorem 
  the carrier of AbGroupCat(UN) = AbGroupObjects(UN);



definition
  let UN;
  func MidOpGroupObjects(UN) -> Subset of the carrier of AbGroupCat(UN) equals

  {G where G is Element of AbGroupCat(UN) : ex H being
  midpoint_operator AbGroup st G = H};
end;

registration
  let UN;
  cluster MidOpGroupObjects(UN) -> non empty;
end;

definition
  let UN;
  func MidOpGroupCat UN -> Subcategory of AbGroupCat(UN) equals

  cat MidOpGroupObjects UN;
end;

registration
  let UN;
  cluster MidOpGroupCat(UN) -> strict;
end;

theorem 
  the carrier of MidOpGroupCat(UN) = MidOpGroupObjects(UN);

theorem 
  Trivial-addLoopStr in MidOpGroupObjects(UN);

theorem 
  for S, T being non empty 1-sorted for f being Function of S, T st f is
  one-to-one onto holds f*f" = id T & f"*f = id S & f" is one-to-one onto;

theorem 
  for a being Object of GroupCat(UN), aa being Element of
  GroupObjects(UN) st a = aa holds id a = ID aa;














begin

theorem 
  for A,B being non empty set, f being Function of A,B holds f is
  one-to-one iff for a,b being Element of A st f.a = f.b holds a = b;

definition
  let G be Group, A be Subgroup of G;
  redefine mode Subgroup of A -> Subgroup of G;
end;

registration
  let G be Group;
  cluster (1).G -> normal;
  cluster (Omega).G -> normal;
end;

reserve n for Element of NAT;
reserve i for Integer;
reserve G,H,I for Group;
reserve A,B for Subgroup of G;
reserve N for normal Subgroup of G;
reserve a,a1,a2,a3,b,b1 for Element of G;
reserve c,d for Element of H;
reserve f for Function of the carrier of G, the carrier of H;
reserve x,y,y1,y2,z for set;
reserve A1,A2 for Subset of G;

theorem 
  for X being Subgroup of A, x being Element of A st x = a holds x
  * X = a * (X qua Subgroup of G) & X * x = (X qua Subgroup of G) * a;

theorem 
  for X,Y being Subgroup of A holds (X qua Subgroup of G) /\ (Y qua
  Subgroup of G) = X /\ Y;

theorem 
  a * b * a" = b |^ a" & a * (b * a") = b |^ a";

theorem 
  a * A * A = a * A & a * (A * A) = a * A & A * A * a = A * a & A *
  (A * a) = A *a;

theorem 
  for G being Group, A1 being Subset of G holds A1 = {[.a,b.] where
  a is Element of G, b is Element of G : not contradiction} implies G` = gr A1;

theorem 
  for G being strict Group, B being strict Subgroup of G holds G`
  is Subgroup of B iff for a,b being Element of G holds [.a,b.] in B;

theorem 
  for N being normal Subgroup of G holds N is Subgroup of B implies
  N is normal Subgroup of B;

definition
  let G,B;
  let M be normal Subgroup of G;
  assume
 the multMagma of M is Subgroup of B;
  func (B,M)`*` -> strict normal Subgroup of B equals


  the multMagma of
  M;
end;

theorem 
  B /\ N is normal Subgroup of B & N /\ B is normal Subgroup of B;

definition
  let G,B;
  let N be normal Subgroup of G;
  redefine func B /\ N -> strict normal Subgroup of B;
end;

definition
  let G;
  let N be normal Subgroup of G;
  let B;
  redefine func N /\ B -> strict normal Subgroup of B;
end;

definition
  let G be non empty 1-sorted;
  redefine attr G is trivial means


  ex x st the carrier of G = {x};
end;

theorem 
  (1).G is trivial;

registration
  let G;
  cluster (1).G -> trivial;
end;

registration
  cluster strict trivial for Group;
end;

theorem 
  (for G being trivial Group holds card G = 1 & G is finite) & for
  G being finite Group st card G = 1 holds G is trivial;

theorem 
  for G being strict trivial Group holds (1).G = G;

notation
  let G,N;
  synonym Cosets N for Left_Cosets N;
end;

registration
  let G,N;
  cluster Cosets N -> non empty;
end;

theorem 
  for N being normal Subgroup of G holds x in Cosets N implies ex
  a st x = a * N & x = N * a;

theorem 
  for N being normal Subgroup of G holds a * N in Cosets N & N * a in Cosets N;

theorem 
  for N being normal Subgroup of G holds x in Cosets N implies x
  is Subset of G;

theorem 
  for N being normal Subgroup of G holds A1 in Cosets N & A2 in
  Cosets N implies A1 * A2 in Cosets N;

definition
  let G;
  let N be normal Subgroup of G;
  func CosOp N -> BinOp of Cosets N means


  for W1,W2 being Element of
  Cosets N for A1,A2 st W1 = A1 & W2 = A2 holds it.(W1,W2) = A1 * A2;
end;

definition
  let G;
  let N be normal Subgroup of G;
  func G./.N -> multMagma equals

  multMagma (# Cosets N, CosOp N #);
end;

registration
  let G;
  let N be normal Subgroup of G;
  cluster G./.N -> strict non empty;
end;

theorem 
  for N being normal Subgroup of G holds the carrier of G./.N = Cosets N;

theorem 
  for N being normal Subgroup of G holds the multF of G./.N = CosOp N;

reserve N for normal Subgroup of G;
reserve S,T1,T2 for Element of G./.N;

definition
  let G,N,S;
  func @S -> Subset of G equals

  S;
end;

theorem 
  for N being normal Subgroup of G, T1,T2 being Element of G./.N holds @
  T1 * @T2 = T1 * T2;

theorem 
  @(T1 * T2) = @T1 * @T2;

registration
  let G;
  let N be normal Subgroup of G;
  cluster G./.N -> associative Group-like;
end;

theorem 
  for N being normal Subgroup of G, S being Element of G./.N
  ex a st S = a * N & S = N * a;

theorem 
  N * a is Element of G./.N & a * N is Element of G./.N &
  carr N is Element of G./.N;

theorem 
  for N being normal Subgroup of G holds x in G./.N iff
  ex a st x = a * N & x = N * a;

theorem 
  for N being normal Subgroup of G holds 1_(G./.N) = carr N;

theorem 
  for N being normal Subgroup of G, S being Element of G./.N st S
  = a * N holds S" = a" * N;

theorem 
  for N being normal Subgroup of G holds card(G./.N) = Index N;

theorem 
  for N being normal Subgroup of G holds Left_Cosets N is finite implies
  card(G./.N) = index N;

theorem 
  for M being strict normal Subgroup of G holds M is Subgroup of B
  implies B./.(B,M)`*` is Subgroup of G./.M;

theorem 
  for N,M being strict normal Subgroup of G holds M is Subgroup of N
  implies N./.(N,M)`*` is normal Subgroup of G./.M;

theorem 
  for G being strict Group, N be strict normal Subgroup of G holds G./.N
  is commutative Group iff G` is Subgroup of N;

definition
  let G, H be non empty multMagma;
  let f be Function of G, H;
  attr f is multiplicative means


  for a, b being Element of G holds f.(a * b) = f.a * f.b;
end;

registration
  let G, H;
  cluster multiplicative for Function of G, H;
end;

definition
  let G,H;
  mode Homomorphism of G,H is multiplicative Function of G, H;
end;

reserve g,h for Homomorphism of G,H;
reserve h1 for Homomorphism of H,I;

theorem 
  g.(1_G) = 1_H;

registration
  let G,H;
  cluster -> unity-preserving for Homomorphism of G,H;
end;

theorem 
  g.(a") = (g.a)";

theorem 
  g.(a |^ b) = (g.a) |^ (g.b);

theorem 
  g. [.a,b.] = [.g.a,g.b.];

theorem 
  g. [.a1,a2,a3.] = [.g.a1,g.a2,g.a3.];

theorem 
  g.(a |^ n) = (g.a) |^ n;

theorem 
  g.(a |^ i) = (g.a) |^ i;

theorem 
  id the carrier of G is multiplicative;

theorem 
  h1 * h is multiplicative;

registration
  let G,H,I,h,h1;
  cluster h1 * h -> multiplicative for Function of G,I;
end;

definition
  let G,H;
  func 1:(G,H) -> Function of G,H means


  for a holds it.a = 1_H;
end;

registration
  let G,H;
  cluster 1:(G,H) -> multiplicative;
end;

theorem 
  h1 * 1:(G,H) = 1:(G,I) & 1:(H,I) * h = 1:(G,I);

definition
  let G;
  let N be normal Subgroup of G;
  func nat_hom N -> Function of G,G./.N means


  for a holds it.a = a * N;
end;

registration
  let G;
  let N be normal Subgroup of G;
  cluster nat_hom N -> multiplicative;
end;

definition
  let G,H,g;
  func Ker g -> strict Subgroup of G means


  the carrier of it = {a : g. a = 1_H};
end;

registration
  let G,H,g;
  cluster Ker g -> normal;
end;

theorem 
  a in Ker h iff h.a = 1_H;

theorem 
  for G,H being strict Group holds Ker 1:(G,H) = G;

theorem 
  for N being strict normal Subgroup of G holds Ker nat_hom N = N;

definition
  let G,H,g;
  func Image g -> strict Subgroup of H means


  the carrier of it = g .: (the carrier of G);
end;

theorem 
  rng g = the carrier of Image g;

theorem 
  x in Image g iff ex a st x = g.a;

theorem 
  Image g = gr rng g;

theorem 
  Image 1:(G,H) = (1).H;

theorem 
  for N being normal Subgroup of G holds Image nat_hom N = G./.N;

theorem 
  h is Homomorphism of G,Image h;

theorem 
  G is finite implies Image g is finite;

registration
  let G be finite Group;
  let H be Group;
  let g be Homomorphism of G,H;
  cluster Image g -> finite;
end;

theorem 
  G is commutative Group implies Image g is commutative;

theorem 
  card Image g c= card G;

theorem 
  for G being finite Group, H being Group, g being Homomorphism of G,H
  holds card Image g <= card G;

theorem 
  h is one-to-one & c in Image h implies h.(h".c) = c;

theorem 
  h is one-to-one implies h" is Homomorphism of Image h,G;

theorem 
  h is one-to-one iff Ker h = (1).G;

theorem 
  for H being strict Group, h being Homomorphism of G,H holds h is
  onto iff Image h = H;

theorem 
  for G,H being non empty set, h being Function of G,H st
  h is onto for c being Element of H ex a being Element of G st h.a = c;

theorem 
  for N being normal Subgroup of G holds nat_hom N is onto;

theorem 
  for G,H being set for h being Function of G,H holds
  h is bijective iff rng h = H & h is one-to-one;

theorem 
  for G being set, H being non empty set for h being Function of G,H holds
  h is bijective implies dom h = G & rng h = H;

theorem 
  for H being strict Group, h being Homomorphism of G,H st h is
  bijective holds h" is Homomorphism of H,G;

theorem 
  for G being set, H being non empty set for h being Function of G,H holds
  for g1 being Function of H,G holds
  h is bijective & g1 = h" implies g1 is bijective;

theorem 
  for G being set, H,I being non empty set for h being Function of G,H holds
  for h1 being Function of H,I holds
  h is bijective & h1 is bijective implies h1 * h is bijective;

theorem 
  for G being Group holds nat_hom (1).G is bijective;

definition
  let G,H;

  pred G,H are_isomorphic means


  ex h st h is bijective;
  reflexivity;
end;

theorem 
  for G,H being strict Group holds G,H are_isomorphic implies
  H,G are_isomorphic;

definition
  let G,H be strict Group;
  redefine pred G,H are_isomorphic;
  symmetry;
end;

theorem 
  G,H are_isomorphic & H,I are_isomorphic implies G,I are_isomorphic;

theorem 
  h is one-to-one implies G,Image h are_isomorphic;

theorem 
  for G,H being strict Group holds G is trivial & H is trivial
  implies G,H are_isomorphic;

theorem 
  (1).G,(1).H are_isomorphic;

theorem 
  for G being strict Group holds G,G./.(1).G are_isomorphic;

theorem 
  for G being Group holds G./.(Omega).G is trivial;

theorem 
  for G,H being strict Group holds G,H are_isomorphic implies card G = card H;

theorem 
  G,H are_isomorphic & G is finite implies H is finite;

theorem 
  for G,H being strict Group holds G,H are_isomorphic & G is finite
  implies card G = card H;

theorem 
  for G being strict trivial Group, H being strict Group holds G,H
  are_isomorphic implies H is trivial;

theorem 
  for H being strict Group st G,H are_isomorphic & G is commutative
  holds H is commutative;

theorem 
  G./.Ker g, Image g are_isomorphic;


theorem 
  ex h being Homomorphism of G./.Ker g,Image g st h is bijective & g = h
  * nat_hom Ker g;


theorem 
  for M being strict normal Subgroup of G for J being strict normal
Subgroup of G./.M st J = N./.(N,M)`*` & M is Subgroup of N holds (G./.M)./.J,G
  ./.N are_isomorphic;


theorem 
  for N being strict normal Subgroup of G holds (B "\/" N)./.(B "\/" N,N
  )`*`, B./.(B /\ N) are_isomorphic;














begin 

reserve x,y,x1,x2,y1,y2 for set,
  i,j,k,l,n,m for Nat,
  D for non empty set,
  K for Field,
  s,s2 for FinSequence,
  a,b,c,d for Element of D,
  q,r for FinSequence of D,
  a9,b9 for Element of K;

definition
  let n,m;
  let a be set;
  func (n,m) --> a -> tabular FinSequence equals

  n |-> (m |-> a);
end;

definition
  let D,n,m;
  let d;
  redefine func (n,m) --> d -> Matrix of n,m,D;
end;

theorem 
  [i,j] in Indices ((n,m)-->a) implies ((n,m)-->a) * (i,j)=a;

theorem 
  ((n,n)-->a9) + ((n,n)-->b9)= (n,n)-->(a9+b9);

definition
  let a,b,c,d be set;
  func (a,b)][(c,d) ->tabular FinSequence equals

  <*<*a,b*>,<*c,d*>*>;
end;

theorem 
  len (x1,x2)][(y1,y2)=2 & width (x1,x2)][(y1,y2)=2 & Indices (x1,
  x2)][(y1,y2)=[:Seg 2,Seg 2:];

theorem 
  [1,1] in Indices (x1,x2)][(y1,y2) & [1,2] in Indices (x1,x2)][(y1
  ,y2) & [2,1] in Indices (x1,x2)][(y1,y2) & [2,2] in Indices (x1,x2)][(y1,y2);

definition
  let D;
  let a be Element of D;
  redefine func <*a*> -> Element of 1-tuples_on D;
end;

definition
  let D;
  let n;
  let p be Element of n-tuples_on D;
  redefine func <*p*> -> Matrix of 1,n,D;
end;

theorem 
  [1,1] in Indices <*<*a*>*> & <*<*a*>*>*(1,1)=a;

definition
  let D;
  let a,b,c,d be Element of D;
  redefine func (a,b)][(c,d) -> Matrix of 2,D;
end;

theorem 
  (a,b)][(c,d)*(1,1)=a & (a,b)][(c,d)*(1,2)=b & (a,b)][(c,d)*(2,1)=c & (
  a,b)][(c,d)*(2,2)=d;

definition
  let n, K;
  let M be Matrix of n,K;
  attr M is upper_triangular means


  for i,j st [i,j] in Indices M & i>j holds M*(i,j) = 0.K;
  attr M is lower_triangular means

  for i,j st [i,j] in Indices M & i<j holds M *(i,j) = 0.K;
end;

registration
  let n, K;
  cluster -> upper_triangular lower_triangular for Diagonal of n,K;
end;

registration
  let n, K;
  cluster lower_triangular upper_triangular for Matrix of n,K;
end;

definition
  let n, K;
  mode Upper_Triangular_Matrix of n,K is upper_triangular Matrix of n,K;
  mode Lower_Triangular_Matrix of n,K is lower_triangular Matrix of n,K;
end;

theorem 
  for M being Matrix of D st len M=n holds M is Matrix of n,width M,D;

begin 

theorem 
  for M be Matrix of n,m,D holds for k st k in Seg n holds M.k= Line(M,k);

definition
  let i, K;
  let M be Matrix of K;

  func DelCol(M,i) -> Matrix of K means

  len it=len M & for k st k in dom M holds it.k=Del(Line(M,k),i);
end;

theorem 
  for M1,M2 being Matrix of D st M1@=M2@ & len M1=len M2 holds M1 = M2;

theorem 
  for M being Matrix of D st width M > 0 holds len (M@)=width M &
  width (M@)=len M;

theorem 
  for M1,M2 being Matrix of D st width M1>0 & width M2>0 & M1@=M2@ holds M1=M2;

theorem 
  for M1,M2 being Matrix of D st width M1>0 & width M2>0 holds M1=M2 iff
  M1@=M2@ & width M1 = width M2;

theorem 
  for M being Matrix of D st len M>0 & width M>0 holds (M@)@=M;

theorem 
  for M being Matrix of D holds for i st i in dom M holds Line(M,i )=Col(M@,i);

theorem 
  for M being Matrix of D holds for j st j in Seg width M holds Line(M@,
  j)=Col(M,j);

theorem 
  for M being Matrix of D holds for i st i in dom M holds M.i=Line(M,i);

notation
  let K, i;
  let M be Matrix of K;
  synonym DelLine(M,i) for Del(M,i);
end;

registration
  let K, i;
  let M be Matrix of K;
  cluster DelLine(M,i) -> tabular;
end;

definition
  let K, i;
  let M be Matrix of K;
  redefine func DelLine(M,i) -> Matrix of K;
end;

definition
  let i,j,n,K;
  let M be Matrix of n,K;

  func Deleting(M,i,j) -> Matrix of K equals

  DelCol(DelLine(M,i),j);
end;

begin 

definition
  let IT be set;
  attr IT is permutational means


  ex n st for x st x in IT holds x is Permutation of Seg n;
end;

registration
  cluster permutational non empty for set;
end;

definition
  let P be permutational non empty set;
  func len P -> Nat means


  ex s st s in P & it=len s;
end;

definition
  let P be permutational non empty set;
  redefine func len P -> Element of NAT;
end;

definition
  let P be permutational non empty set;
  redefine mode Element of P -> Permutation of Seg len P;
end;

theorem 
  ex P being permutational non empty set st len P =n;

definition
  let n;
  func Permutations n -> set means


  x in it iff x is Permutation of Seg n;
end;

registration
  let n;
  cluster Permutations(n) -> permutational non empty;
end;

theorem 
  len Permutations(n)=n;

theorem 
  Permutations 1 = {idseq 1};

begin 

reserve p,q for Element of Permutations(n);

definition
  let n;

  func Group_of_Perm(n) -> strict multMagma means


  the carrier of it =
Permutations(n) & for q,p be Element of Permutations(n) holds (the multF of it)
  .(q,p)=p*q;
end;

registration
  let n;
  cluster Group_of_Perm(n) -> non empty;
end;

theorem 
  idseq n is Element of Group_of_Perm(n);

theorem 
  p *(idseq n)=p & (idseq n)*p=p;

theorem 
  p *p"=idseq n & p"*p=idseq n;

theorem 
  p" is Element of Group_of_Perm(n);

registration
  let n;
  cluster Group_of_Perm(n) -> associative Group-like;
end;

theorem 
  idseq n= 1_Group_of_Perm(n);

definition
  let n;
  let p be Permutation of Seg n;
  attr p is being_transposition means

  ex i,j st i in dom p & j in dom p & i<>j
  & p.i=j & p.j=i & for k st k <>i & k<>j & k in dom p holds p.k=k;
end;

definition
  let n;
  let IT be Permutation of Seg n;
  attr IT is even means


  ex l be FinSequence of Group_of_Perm(n) st (
  len l) mod 2=0 & IT=Product l & for i st i in dom l ex q st l.i=q & q is
  being_transposition;
end;

notation
  let n;
  let IT be Permutation of Seg n;
  antonym IT is odd for IT is even;
end;

theorem 
  id Seg n is even;

definition
  let K,n;
  let x be Element of K;
  let p be Element of Permutations(n);
  func -(x,p) -> Element of K equals

  x if p is even otherwise -x;
end;

definition
  let X be set;
  assume
 X is finite;
  func FinOmega X -> Element of Fin X equals

  X;
end;

theorem 
  Permutations n is finite;














begin 

reserve i,j,k for Element of NAT;

theorem 
  for K being Abelian non empty addLoopStr holds the addF of K is commutative;

theorem 
  for K being add-associative non empty addLoopStr holds the addF
  of K is associative;

theorem 
  for K being commutative non empty multMagma holds the multF of
  K is commutative;

registration
  let K be Abelian non empty addLoopStr;
  cluster the addF of K -> commutative;
end;

registration
  let K be add-associative non empty addLoopStr;
  cluster the addF of K -> associative;
end;

registration
  let K be commutative non empty multMagma;
  cluster the multF of K -> commutative;
end;

theorem 
  for K being commutative left_unital non empty multLoopStr holds
  1.K is_a_unity_wrt the multF of K;

theorem 
  for K being commutative left_unital non empty multLoopStr holds
  the_unity_wrt the multF of K = 1.K;

theorem 
  for K being left_zeroed right_zeroed non empty addLoopStr holds
  0.K is_a_unity_wrt the addF of K;

theorem 
  for K being left_zeroed right_zeroed non empty addLoopStr holds
  the_unity_wrt the addF of K = 0.K;

theorem 
  for K being left_zeroed right_zeroed non empty addLoopStr
  holds the addF of K is having_a_unity;

theorem 
  for K being commutative left_unital non empty multLoopStr
  holds the multF of K is having_a_unity;

theorem 
  for K being distributive non empty doubleLoopStr holds the
  multF of K is_distributive_wrt the addF of K;

definition
  let K be non empty multMagma;
  let a be Element of K;
  func a multfield -> UnOp of the carrier of K equals

  (the multF of K)[;](a,id
  (the carrier of K));
end;

definition
  let K be non empty addLoopStr;
  func diffield(K) -> BinOp of the carrier of K equals

  (the addF of K)*(id the
  carrier of K,comp K);
end;

theorem 
  for K being non empty addLoopStr, a1,a2 being Element of K holds
  (diffield(K)).(a1,a2) = a1 - a2;

theorem 
  for K being distributive non empty doubleLoopStr, a being
  Element of K holds a multfield is_distributive_wrt the addF of K;

theorem 
  for K being left_zeroed right_zeroed add-associative
  right_complementable non empty addLoopStr holds comp K is_an_inverseOp_wrt
  the addF of K;

theorem 
  for K being left_zeroed right_zeroed add-associative
  right_complementable non empty addLoopStr holds the addF of K is
  having_an_inverseOp;

theorem 
  for K being left_zeroed right_zeroed add-associative
right_complementable non empty addLoopStr holds the_inverseOp_wrt the addF of
  K = comp K;

theorem 
  for K being right_zeroed add-associative right_complementable Abelian
  non empty addLoopStr holds comp K is_distributive_wrt the addF of K;

begin





definition
  let K be non empty addLoopStr;
  let p1,p2 be FinSequence of the carrier of K;
  func p1 + p2 -> FinSequence of the carrier of K equals

  (the addF of K).:(p1,
  p2);
end;

theorem 
  for K being non empty addLoopStr, p1, p2 be FinSequence of the carrier
  of K, a1, a2 being Element of K, i being Element of NAT st i in dom (p1+p2) &
  a1 = p1.i & a2 = p2.i holds (p1+p2).i = a1 + a2;

definition
  let i;
  let K be non empty addLoopStr;
  let R1,R2 be Element of i-tuples_on the carrier of K;
  redefine func R1 + R2 -> Element of i-tuples_on the carrier of K;
end;

theorem 
  for K being non empty addLoopStr, a1,a2 being Element of K, R1,R2
being Element of i-tuples_on the carrier of K holds j in Seg i & a1 = R1.j & a2
  = R2.j implies (R1+R2).j = a1 + a2;

theorem 
  for K being non empty addLoopStr, a1,a2 being Element of K holds <*a1
  *> + <*a2*> = <*a1+a2*>;

theorem 
  for K being non empty addLoopStr, a1,a2 being Element of K holds (i|->
  a1) + (i|->a2) = i|->(a1+a2);

theorem 
  for K being Abelian left_zeroed right_zeroed non empty
addLoopStr, R being Element of i-tuples_on the carrier of K holds R + (i|->(0.
  K)) = R & R = (i|->(0.K)) + R;

definition
  let K be non empty addLoopStr;
  let p be FinSequence of the carrier of K;
  func -p -> FinSequence of the carrier of K equals

  (comp K)*p;
end;

reserve K for non empty addLoopStr,
  a for Element of K,
  p for FinSequence of the carrier of K,
  R for Element of i-tuples_on the carrier of K;

theorem 
  i in dom -p & a = p.i implies (-p).i = -a;

definition
  let i;
  let K be non empty addLoopStr;
  let R be Element of i-tuples_on the carrier of K;
  redefine func -R -> Element of i-tuples_on the carrier of K;
end;

theorem 
  j in Seg i & a = R.j implies (-R).j = -a;

theorem 
  -<*a*> = <*-a*>;

theorem 
  -(i|->a) = i|->-a;

theorem 
  for K being Abelian right_zeroed add-associative
right_complementable non empty addLoopStr, R being Element of i-tuples_on the
  carrier of K holds R + -R = (i|->0.K) & -R + R = (i|->0.K);

reserve K for left_zeroed right_zeroed add-associative right_complementable
  non empty addLoopStr,
  R,R1,R2 for Element of i-tuples_on the carrier of K;

theorem 
  R1 + R2 = (i|->0.K) implies R1 = -R2 & R2 = -R1;

theorem 
  --R = R;

theorem 
  -R1 = -R2 implies R1 = R2;

theorem 
  for K being Abelian right_zeroed add-associative right_complementable
  non empty addLoopStr, R,R1,R2 being Element of i-tuples_on the carrier of K
  holds R1 + R = R2 + R or R1 + R = R + R2 implies R1 = R2;

theorem 
  for K being Abelian right_zeroed add-associative
right_complementable non empty addLoopStr, R1,R2 being Element of i-tuples_on
  the carrier of K holds -(R1 + R2) = -R1 + -R2;

definition
  let K be non empty addLoopStr;
  let p1,p2 be FinSequence of the carrier of K;
  func p1 - p2 -> FinSequence of the carrier of K equals

  (diffield(K)).:(p1,p2
  );
end;

reserve K for non empty addLoopStr,
  a1,a2 for Element of K,
  p1,p2 for FinSequence of the carrier of K,
  R1,R2 for Element of i-tuples_on the carrier of K;

theorem 
  i in dom (p1-p2) & a1 = p1.i & a2 = p2.i implies (p1-p2).i = a1 - a2;

definition
  let i;
  let K be non empty addLoopStr;
  let R1,R2 be Element of i-tuples_on the carrier of K;
  redefine func R1 - R2 -> Element of i-tuples_on the carrier of K;
end;

theorem 
  j in Seg i & a1 = R1.j & a2 = R2.j implies (R1-R2).j = a1 - a2;

theorem 
  <*a1*> - <*a2*> = <*a1-a2*>;

theorem 
  (i|->a1) - (i|->a2) = i|->(a1-a2);

theorem 
  for K being add-associative right_complementable left_zeroed
right_zeroed non empty addLoopStr, R being Element of i-tuples_on the carrier
  of K holds R - (i|->(0.K)) = R;

theorem 
  for K being Abelian left_zeroed right_zeroed non empty addLoopStr, R
  being Element of i-tuples_on the carrier of K holds (i|->(0.K)) - R = -R;

theorem 
  for K being left_zeroed right_zeroed add-associative
right_complementable non empty addLoopStr, R1,R2 being Element of i-tuples_on
  the carrier of K holds R1 - -R2 = R1 + R2;

reserve K for Abelian right_zeroed add-associative right_complementable non
  empty addLoopStr,
  R,R1,R2,R3 for Element of i-tuples_on the carrier of K;

theorem 
  -(R1 - R2) = R2 - R1;

theorem 
  -(R1 - R2) = -R1 + R2;

theorem 
  R - R = (i|->0.K);

theorem 
  R1 - R2 = (i|->0.K) implies R1 = R2;

theorem 
  R1 - R2 - R3 = R1 - (R2 + R3);

theorem 
  R1 + (R2 - R3) = R1 + R2 - R3;

theorem 
  R1 - (R2 - R3) = R1 - R2 + R3;

theorem 
  R1 = R1 + R - R;

theorem 
  R1 = R1 - R + R;

reserve K for non empty multMagma,
  a,a9,a1,a2 for Element of K,
  p for FinSequence of the carrier of K,
  R for Element of i-tuples_on the carrier of K;

theorem 
  for a,b being Element of K holds ((the multF of K)[;](a,id the
  carrier of K)).b = a*b;

theorem 
  for a,b being Element of K holds (a multfield).b = a*b;

definition
  let K be non empty multMagma;
  let p be FinSequence of the carrier of K;
  let a be Element of K;
  func a*p -> FinSequence of the carrier of K equals

  (a multfield)*p;
end;

theorem 
  i in dom (a*p) & a9 = p.i implies (a*p).i = a*a9;

definition
  let i;
  let K be non empty multMagma;
  let R be Element of i-tuples_on the carrier of K;
  let a be Element of K;
  redefine func a*R -> Element of i-tuples_on the carrier of K;
end;

theorem 
  j in Seg i & a9 = R.j implies (a*R).j = a*a9;

theorem 
  a*<*a1*> = <*a*a1*>;

theorem 
  a1*(i|->a2) = i|->(a1*a2);

theorem 
  for K being associative non empty multMagma, a1,a2 being Element of
K, R being Element of i-tuples_on the carrier of K holds (a1*a2)*R = a1*(a2*R);

reserve K for distributive non empty doubleLoopStr,
  a,a1,a2 for Element of K ,
  R,R1,R2 for Element of i-tuples_on the carrier of K;

theorem 
  (a1 + a2)*R = a1*R + a2*R;

theorem 
  a*(R1+R2) = a*R1 + a*R2;

theorem 
  for K being distributive commutative left_unital non empty
doubleLoopStr, R being Element of i-tuples_on the carrier of K holds 1.K * R =
  R;

theorem 
  for K being add-associative right_zeroed right_complementable
  distributive non empty doubleLoopStr, R being Element of i-tuples_on the
  carrier of K holds 0.K*R = i|->0.K;

theorem 
  for K being add-associative right_zeroed right_complementable
commutative left_unital distributive non empty doubleLoopStr, R being Element
  of i-tuples_on the carrier of K holds (-1.K) * R = -R;

definition
  let M be non empty multMagma, p1, p2 be FinSequence of the carrier of M;
  func mlt(p1,p2) -> FinSequence of the carrier of M equals

  (the multF of M).:
  (p1,p2);
end;

reserve K for non empty multMagma,
  a1,a2,b1,b2 for Element of K,
  p1,p2 for FinSequence of the carrier of K,
  R1,R2 for Element of i-tuples_on the carrier of K;

theorem 
  i in dom mlt(p1,p2) & a1 = p1.i & a2 = p2.i implies mlt(p1,p2).i = a1
  * a2;

definition
  let i;
  let K be non empty multMagma;
  let R1,R2 be Element of i-tuples_on the carrier of K;
  redefine func mlt(R1,R2) -> Element of i-tuples_on the carrier of K;
end;

theorem 
  j in Seg i & a1 = R1.j & a2 = R2.j implies mlt(R1,R2).j = a1 * a2;

theorem 
  mlt(<*a1*>,<*a2*>) = <*a1*a2*>;

reserve K for commutative non empty multMagma,
  p,q for FinSequence of the carrier of K,
  R1,R2 for Element of i-tuples_on the carrier of K;

theorem 
  mlt(R1,R2) = mlt(R2,R1);

theorem 
  mlt(p,q)=mlt(q,p);

theorem 
  for K being associative non empty multMagma, R1,R2,R3 being Element
  of i-tuples_on the carrier of K holds mlt(R1,mlt(R2,R3)) = mlt(mlt(R1,R2),R3)
;

reserve K for commutative associative non empty multMagma,
  a,a1,a2 for Element of K,
  R for Element of i-tuples_on the carrier of K;

theorem 
  mlt(i|->a,R) = a*R & mlt(R,i|->a) = a*R;

theorem 
  mlt(i|->a1,i|->a2) = i|->(a1*a2);

theorem 
  for K being associative non empty multMagma, a being Element of K,
R1,R2 being Element of i-tuples_on the carrier of K holds a*mlt(R1,R2) = mlt(a*
  R1,R2);

reserve K for commutative associative non empty multMagma,
  a for Element of K,
  R,R1,R2 for Element of i-tuples_on the carrier of K;

theorem 
  a*mlt(R1,R2) = mlt(a*R1,R2) & a*mlt(R1,R2) = mlt(R1,a*R2);

theorem 
  a*R = mlt(i|->a,R);

begin





registration
  cluster Abelian right_zeroed -> left_zeroed for non empty addLoopStr;
end;

definition
  let K be Abelian add-associative right_zeroed right_complementable non
  empty addLoopStr;
  let p be FinSequence of the carrier of K;
  redefine func Sum(p) equals

  (the addF of K) $$ p;
end;

reserve K for add-associative right_zeroed right_complementable non empty
  addLoopStr,
  a for Element of K,
  p for FinSequence of the carrier of K;

theorem 
  Sum(p^<*a*>) = Sum p + a;

theorem 
  Sum(<*a*>^p) = a + Sum p;

theorem 
  for K being Abelian add-associative right_zeroed right_complementable
  distributive non empty doubleLoopStr, a being Element of K, p being
  FinSequence of the carrier of K holds Sum(a*p) = a*(Sum p);

theorem 
  for K being non empty addLoopStr for R being Element of 0-tuples_on
  the carrier of K holds Sum R = 0.K;

reserve K for Abelian add-associative right_zeroed right_complementable non
  empty addLoopStr,
  p for FinSequence of the carrier of K,
  R1,R2 for Element of i-tuples_on the carrier of K;

theorem 
  Sum -p = -(Sum p);

theorem 
  Sum(R1 + R2) = Sum R1 + Sum R2;

theorem 
  Sum(R1 - R2) = Sum R1 - Sum R2;

begin

reserve K for commutative associative well-unital non empty doubleLoopStr,
  a ,a1,a2,a3 for Element of K,
  p1 for FinSequence of the carrier of K,
  R1,R2 for Element of i-tuples_on the carrier of K;

theorem 
  Product(<*a*>^p1) = a * Product p1;

theorem 
  Product<*a1,a2,a3*> = a1 * a2 * a3;

theorem 
  for R being Element of 0-tuples_on the carrier of K holds Product R = 1.K;

theorem 
  Product(i|->(1_K)) = 1_K;

theorem 
  for K being add-associative right_zeroed right_complementable Abelian
  commutative associative well-unital distributive almost_left_invertible non
degenerated non empty doubleLoopStr for p being FinSequence of the carrier of
  K holds (ex k st k in dom p & p.k = 0.K) iff Product p = 0.K;

theorem 
  Product((i+j) |-> a) = (Product(i|->a))*(Product(j|->a));

theorem 
  Product((i*j) |-> a) = Product(j|->(Product(i|->a)));

theorem 
  Product(i|->(a1*a2)) = (Product(i|->a1))*(Product(i|->a2));

theorem 
  Product mlt(R1,R2) = Product R1 * Product R2;

theorem 
  Product(a*R1) = Product (i|->a) * Product R1;

begin 

definition
  let K be non empty doubleLoopStr;
  let p,q be FinSequence of the carrier of K;
  func p "*" q -> Element of K equals

  Sum(mlt(p,q));
end;

theorem 
  for K being commutative associative left_unital Abelian
add-associative right_zeroed right_complementable non empty doubleLoopStr for
  a,b being Element of K holds <*a*> "*" <*b*>= a * b;

theorem 
  for K being commutative associative left_unital Abelian
add-associative right_zeroed right_complementable non empty doubleLoopStr for
  a1,a2,b1,b2 being Element of K holds <*a1,a2*> "*" <*b1,b2*>= a1*b1 + a2*b2;

theorem 
  for p,q be FinSequence of the carrier of K holds p "*" q = q "*" p;














begin

reserve x,y,z,x1,x2,y1,y2,z1,z2 for set,
  i,j,k,l,n,m for Nat,
  D for non empty set,
  K for Field;

definition
  let K;
  let n,m be Nat;
  func 0.(K,n,m) -> Matrix of n,m,K equals

  n |-> (m |-> 0.K);
end;

definition
  let K;
  let A be Matrix of K;
  func -A -> Matrix of K means


  len it= len A & width it =width A & for
  i,j holds [i,j] in Indices A implies it*(i,j)= -(A*(i,j));
end;

definition
  let K;
  let A,B be Matrix of K;
  func A+B -> Matrix of K means


  len it =len A & width it=width A & for
  i,j holds [i,j] in Indices A implies it*(i,j) = A*(i,j) + B*(i,j);
end;

theorem 
  for i,j st [i,j] in Indices (0.(K,n,m)) holds (0.(K,n,m))*(i,j)= 0.K;

theorem 
  for A,B being Matrix of K st len A= len B & width A=width B holds A +
  B = B + A;

theorem 
  for A,B,C being Matrix of K st len A=len B & width A=width B holds (A
  + B) + C= A + (B + C);

theorem 
  for A being Matrix of n,m,K holds A + 0.(K,n,m)= A;

theorem 
  for A being Matrix of n,m,K holds A + (-A) = 0.(K,n,m);

definition
  let K;
  let A,B be Matrix of K;
  assume
 width A=len B;
  func A*B -> Matrix of K means


  len it=len A & width it=width B & for i
  ,j st [i,j] in Indices it holds it*(i,j)=Line(A,i) "*" Col(B,j);
end;

definition
  let n,k,m;
  let K;
  let A be Matrix of n,k,K;
  let B be Matrix of width A,m,K;
  redefine func A*B -> Matrix of len A,width B,K;
end;

definition
  let K;
  let M be Matrix of K;
  let a be Element of K;
  func a*M -> Matrix of K means

  len it=len M & width it =width M & for i,j st
  [i,j] in Indices M holds it*(i,j)=a*(M*(i,j));
end;

definition
  let K;
  let M be Matrix of K;
  let a be Element of K;
  func M*a -> Matrix of K equals

  a*M;
end;

theorem 
  for p,q being FinSequence of K st len p=len q holds len mlt(p,q)=len p
  & len mlt(p,q)=len q;

theorem 
  for i,l st [i,l] in Indices (1.(K,n)) & l=i holds (Line(1.(K,n),i)).l= 1.K;

theorem 
  for i,l st [i,l] in Indices (1.(K,n)) & l<>i holds (Line(1.(K,n),i)).l =0.K;

theorem 
  for l,j st [l,j] in Indices (1.(K,n)) & l=j holds (Col(1.(K,n),j)).l= 1.K;

theorem 
  for l,j st [l,j] in Indices (1.(K,n)) & l<>j holds (Col(1.(K,n),j)).l= 0.K;

theorem 
  for n being Element of NAT for K being add-associative
right_zeroed right_complementable non empty addLoopStr holds Sum (n |-> 0.K)
  = 0.K;

theorem 
  for K being add-associative right_zeroed right_complementable
non empty addLoopStr for p being FinSequence of K for i st i in dom p & for k
  st k in dom p & k<>i holds p.k=0.K holds Sum p=p.i;

theorem 
  for p,q being FinSequence of K holds len (mlt(p,q))=min(len p, len q);

theorem 
  for p,q being FinSequence of K for i st p.i=1.K & for k st k in
dom p & k<>i holds p.k=0.K for j st j in dom (mlt(p,q)) holds (i=j implies mlt(
  p,q).j=(q.i)) & (i<>j implies mlt(p,q).j=0.K);

theorem 
  for i,j st [i,j] in Indices (1.(K,n)) holds (i=j implies (Line((
  1.(K,n)),i)).j=1.K) & (i<>j implies (Line((1.(K,n)),i)).j=0.K);

theorem 
  for i,j st [i,j] in Indices (1.(K,n)) holds (i=j implies (Col((
  1.(K,n)),j)).i=1.K) & (i<>j implies (Col((1.(K,n)),j)).i=0.K);

theorem 
  for p,q being FinSequence of K for i st i in dom p & i in dom q
  & p.i=1.K & for k st k in dom p & k<>i holds p.k=0.K holds Sum(mlt(p,q))=q.i;

theorem 
  for A being Matrix of n,K holds 1.(K,n)*A=A;

theorem 
  for A being Matrix of n,K holds A*(1.(K,n))=A;

theorem 
  for a,b being Element of K holds <*<*a*>*> * <*<*b*>*> =<*<*a*b*>*>;

theorem 
  for a1,a2,b1,b2,c1,c2,d1,d2 being Element of K holds (a1,b1)][(c1,d1)*
  (a2,b2)][(c2,d2) = (a1*a2+b1*c2,a1*b2+b1*d2)][(c1*a2+d1*c2,c1*b2+ d1*d2);

theorem 
  for A,B being Matrix of K st width A=len B & width B<>0 holds (A*B) @=
  (B @)*(A @);

begin 

definition
  let I,J be non empty set;
  let X be Element of Fin I;
  let Y be Element of Fin J;
  redefine func [:X,Y:]-> Element of Fin [:I,J:];
end;

definition
  let I,J,D be non empty set;
  let G be BinOp of D;
  let f be Function of I,D;
  let g be Function of J,D;
  redefine func G*(f,g)-> Function of [:I,J:],D;
end;

theorem 
  for I, J,D be non empty set for F,G be BinOp of D for f be
Function of I,D for g being Function of J,D for X being Element of Fin I for Y
  being Element of Fin J st F is commutative & F is associative & ( [:Y,X:]<>{}
or F is having_a_unity )& G is commutative holds F $$ ([:X,Y:],G*(f,g))=F$$([:Y
  ,X:],G*(g,f));

theorem 
  for I, J be non empty set for F,G be BinOp of D for f be
  Function of I,D for g being Function of J,D st F is commutative & F is
associative holds for x being Element of I for y being Element of J holds F $$(
  [:{.x.},{.y.}:],G*(f,g))=F$$({.x.},G[:](f,F$$({.y.},g)));

theorem 
  for I, J be non empty set for F,G be BinOp of D for f be
Function of I,D for g being Function of J,D for X being Element of Fin I for Y
  being Element of Fin J st F is commutative & F is associative & F is
having_a_unity & F is having_an_inverseOp & G is_distributive_wrt F holds for x
being Element of I holds F $$([:{.x.},Y:],G*(f,g))=F$$({.x.},G[:](f,F$$(Y,g)));

theorem 
  for I, J being non empty set for F,G being BinOp of D for f
being Function of I,D for g being Function of J,D for X being Element of Fin I
  for Y being Element of Fin J st F is having_a_unity & F is commutative & F is
associative & F is having_an_inverseOp & G is_distributive_wrt F holds F$$([:X,
  Y:],G*(f,g))=F$$(X,G[:](f,F$$(Y,g)));

theorem 
  for I, J be non empty set for F,G be BinOp of D for f be Function of I
  ,D for g being Function of J,D st F is commutative associative & G is
commutative holds for x being Element of I for y being Element of J holds F $$(
  [:{.x.},{.y.}:],G*(f,g))=F$$({.y.},G[;](F$$({.x.},f),g));

theorem 
  for I, J being non empty set for F,G being BinOp of D for f being
Function of I,D for g being Function of J,D for X being Element of Fin I for Y
being Element of Fin J st F is having_a_unity & F is commutative associative &
F is having_an_inverseOp & G is_distributive_wrt F & G is commutative holds F$$
  ([:X,Y:],G*(f,g))=F$$(Y,G[;](F$$(X,f),g));

theorem 
  for I, J being non empty set for F being BinOp of D for f being
Function of [:I,J:],D for g being Function of I,D for Y being Element of Fin J
  st F is having_a_unity commutative associative holds for x being Element of I
holds (for i being Element of I holds g.i=F$$(Y,(curry f).i)) implies F$$([:{.x
  .},Y:],f)=F$$({.x.},g);

theorem 
  for I, J being non empty set for F being BinOp of D for f being
Function of [:I,J:],D for g being Function of I,D for X being Element of Fin I
  for Y being Element of Fin J st (for i being Element of I holds g.i=F$$(Y,(
curry f).i))& F is having_a_unity & F is commutative & F is associative holds F
  $$([:X,Y:],f)=F$$(X,g);

theorem 
  for I, J being non empty set for F being BinOp of D for f being
Function of [:I,J:],D for g being Function of J,D for X being Element of Fin I
st F is having_a_unity & F is commutative & F is associative holds for y being
  Element of J holds (for j being Element of J holds g.j=F$$(X,(curry' f).j))
  implies F$$([:X,{.y.}:],f)=F$$({.y.},g);

theorem 
  for I, J being non empty set for F being BinOp of D for f being
Function of [:I,J:],D for g being Function of J,D for X being Element of Fin I
  for Y being Element of Fin J st (for j being Element of J holds g.j=F$$ (X, (
curry' f).j) )& F is having_a_unity & F is commutative & F is associative holds
  F$$([:X,Y:],f)=F$$(Y,g);

theorem 
  for A,B,C being Matrix of K st width A=len B & width B=len C holds (A*
  B)*C=A*(B*C);

begin 

definition
  let n,K;
  let M be Matrix of n,K;
  let p be Element of Permutations(n);
  func Path_matrix(p,M) -> FinSequence of K means


  len it=n & for i,j st i in dom it & j=p.i holds it.i=M*(i,j);
end;

definition
  let n,K;
  let M be Matrix of n,K;
  func Path_product(M) -> Function of Permutations(n), the carrier of K means


  for p being Element of Permutations(n) holds it.p = -((the multF of K)
  $$ Path_matrix(p,M),p);
end;

definition
  let n;
  let K;
  let M be Matrix of n,K;
  func Det M -> Element of K equals

  (the addF of K) $$ (FinOmega(Permutations(
  n)),Path_product(M));
end;

reserve a for Element of K;

theorem 
  Det <*<*a*>*> =a;

definition
  let n;
  let K;
  let M be Matrix of n,K;
  func diagonal_of_Matrix M -> FinSequence of K means

  len it = n & for i st i in Seg n holds it.i=M*(i,i);
end;














begin 

reserve x,y,X,Y for set;

definition
  let G be 1-sorted;
  mode BinOp of G is BinOp of the carrier of G;
end;

definition
  let IT be 1-sorted;
  attr IT is constituted-Functions means


  for a being Element of IT holds a is Function;
  attr IT is constituted-FinSeqs means


  for a being Element of IT holds a is FinSequence;
end;

registration
  cluster constituted-Functions for 1-sorted;
  cluster constituted-FinSeqs for 1-sorted;
end;

registration
  let X be constituted-Functions 1-sorted;
  cluster -> Function-like Relation-like for Element of X;
end;

registration
  cluster constituted-FinSeqs -> constituted-Functions for 1-sorted;
end;

registration
  let X be constituted-FinSeqs 1-sorted;
  cluster -> FinSequence-like for Element of X;
end;

definition
  let D be set, p,q be FinSequence of D;
  redefine func p^q -> Element of D*;
end;

notation
  let g,f be Function;
  synonym f(*)g for f*g;
end;

definition
  let D be non empty set;
  let IT be BinOp of D;
  attr IT is left-invertible means

  for a,b being Element of D ex l being Element of D st IT.(l,a) = b;
  attr IT is right-invertible means

  for a,b being Element of D ex r being Element of D st IT.(a,r) = b;
  attr IT is invertible means


  for a,b being Element of D ex r,l being
  Element of D st IT.(a,r) = b & IT.(l,a) = b;
  attr IT is left-cancelable means

  for a,b,c being Element of D st IT.(a,b) = IT.(a,c) holds b = c;
  attr IT is right-cancelable means

  for a,b,c being Element of D st IT.(b,a) = IT.(c,a) holds b = c;
  attr IT is cancelable means

  for a,b,c being Element of D st IT.(a,b) = IT.(a
  ,c) or IT.(b,a) = IT.(c,a) holds b = c;
  attr IT is uniquely-decomposable means

  IT is having_a_unity & for a,b being
Element of D st IT.(a,b) = the_unity_wrt IT holds a = b & b = the_unity_wrt IT;
end;

theorem 
  for D be non empty set, f being BinOp of D holds f is invertible
  iff f is left-invertible right-invertible;

theorem 
  for D be non empty set, f being BinOp of D holds f is cancelable
  iff f is left-cancelable right-cancelable;

theorem 
  for f being BinOp of {x} holds f = (x,x) .--> x & f is
  having_a_unity & f is commutative & f is associative & f is idempotent & f is
  invertible cancelable uniquely-decomposable;

begin 

reserve G for non empty multMagma,
  D for non empty set,
  a,b,c,r,l for Element of G;

definition
  let IT be non empty multMagma;
  redefine attr IT is unital means


  the multF of IT is having_a_unity;
end;

definition
  let G;
  redefine attr G is commutative means


  the multF of G is commutative;
  redefine attr G is associative means


  the multF of G is associative;
end;

definition
  let IT be non empty multMagma;
  attr IT is idempotent means

  the multF of IT is idempotent;
  attr IT is left-invertible means

  the multF of IT is left-invertible;
  attr IT is right-invertible means

  the multF of IT is right-invertible;
  attr IT is invertible means


  the multF of IT is invertible;
  attr IT is left-cancelable means

  the multF of IT is left-cancelable;
  attr IT is right-cancelable means

  the multF of IT is right-cancelable;
  attr IT is cancelable means

  the multF of IT is cancelable;
  attr IT is uniquely-decomposable means


  the multF of IT is uniquely-decomposable;
end;

registration
  cluster unital commutative associative cancelable idempotent invertible
    uniquely-decomposable constituted-Functions constituted-FinSeqs strict for
non
    empty multMagma;
end;

theorem 
  G is unital implies the_unity_wrt the multF of G is_a_unity_wrt
  the multF of G;

theorem 
  G is unital iff for a holds (the_unity_wrt the multF of G)*a = a & a*(
  the_unity_wrt the multF of G) = a;

theorem 
  G is unital iff ex a st for b holds a*b = b & b*a = b;

theorem 
  G is idempotent iff for a holds a*a = a;

theorem 
  G is left-invertible iff for a,b ex l st l*a = b;

theorem 
  G is right-invertible iff for a,b ex r st a*r = b;

theorem 
  G is invertible iff for a,b ex r,l st a*r = b & l*a = b;

theorem 
  G is left-cancelable iff for a,b,c st a*b = a*c holds b = c;

theorem 
  G is right-cancelable iff for a,b,c st b*a = c*a holds b = c;

theorem 
  G is cancelable iff for a,b,c st a*b = a*c or b*a = c*a holds b = c;

theorem 
  G is uniquely-decomposable iff the multF of G is having_a_unity
& for a,b being Element of G st a*b = the_unity_wrt the multF of G holds a = b
  & b = the_unity_wrt the multF of G;

theorem 
  G is associative implies (G is invertible iff G is unital & the
  multF of G is having_an_inverseOp);

registration
  cluster associative Group-like -> invertible for non empty multMagma;
  cluster associative invertible -> Group-like for non empty multMagma;
end;

registration
  cluster invertible -> left-invertible right-invertible for
non empty multMagma;
  cluster left-invertible right-invertible -> invertible for
non empty multMagma;
  cluster cancelable -> left-cancelable right-cancelable for
non empty multMagma;
  cluster left-cancelable right-cancelable -> cancelable for
non empty multMagma;
  cluster associative invertible -> unital cancelable for
non empty multMagma;
end;

begin

reserve M for non empty multLoopStr;

definition
  let IT be non empty multLoopStr;
  redefine attr IT is well-unital means


  1.IT is_a_unity_wrt the multF of IT;
end;

theorem 
  M is well-unital iff for a being Element of M holds (1.M)*a = a & a*(1.M) = a
;

theorem 
  for M being non empty multLoopStr st M is well-unital holds 1.M
  = the_unity_wrt the multF of M;

registration
  cluster well-unital commutative associative cancelable idempotent invertible
uniquely-decomposable unital constituted-Functions constituted-FinSeqs strict
for
    non empty multLoopStr;
end;

definition
  mode Monoid is well-unital associative non empty multLoopStr;
end;

definition
  let G be multMagma;
  mode MonoidalExtension of G -> multLoopStr means


    the multMagma of it = the multMagma of G;
end;

registration
  let G be non empty multMagma;
  cluster -> non empty for MonoidalExtension of G;
end;

theorem 
  for M being MonoidalExtension of G holds the carrier of M = the
carrier of G & the multF of M = the multF of G & for a,b being Element of M, a9
  ,b9 being Element of G st a = a9 & b = b9 holds a*b = a9*b9;

registration
  let G be multMagma;
  cluster strict for MonoidalExtension of G;
end;

theorem 
  for G being non empty multMagma, M being MonoidalExtension of G
  holds (G is unital implies M is unital) & (G is commutative implies M is
  commutative) & (G is associative implies M is associative) & (G is invertible
  implies M is invertible) & (G is uniquely-decomposable implies M is
  uniquely-decomposable) & (G is cancelable implies M is cancelable);

registration
  let G be constituted-Functions multMagma;
  cluster -> constituted-Functions for MonoidalExtension of G;
end;

registration
  let G be constituted-FinSeqs multMagma;
  cluster -> constituted-FinSeqs for MonoidalExtension of G;
end;

registration
  let G be unital non empty multMagma;
  cluster -> unital for MonoidalExtension of G;
end;

registration
  let G be associative non empty multMagma;
  cluster -> associative for MonoidalExtension of G;
end;

registration
  let G be commutative non empty multMagma;
  cluster -> commutative for MonoidalExtension of G;
end;

registration
  let G be invertible non empty multMagma;
  cluster -> invertible for MonoidalExtension of G;
end;

registration
  let G be cancelable non empty multMagma;
  cluster -> cancelable for MonoidalExtension of G;
end;

registration
  let G be uniquely-decomposable non empty multMagma;
  cluster -> uniquely-decomposable for MonoidalExtension of G;
end;

registration
  let G be unital non empty multMagma;
  cluster well-unital strict for MonoidalExtension of G;
end;

theorem 
  for G being unital non empty multMagma for M1,M2 being
  well-unital strict MonoidalExtension of G holds M1 = M2;

begin 

definition
  let G be multMagma;
  mode SubStr of G -> multMagma means


    the multF of it c= the multF of G;
end;

registration
  let G be multMagma;
  cluster strict for SubStr of G;
end;

registration
  let G be non empty multMagma;
  cluster strict non empty for SubStr of G;
end;

registration
  let G be unital non empty multMagma;
  cluster unital associative commutative cancelable idempotent invertible
    uniquely-decomposable strict for non empty SubStr of G;
end;

definition
  let G be multMagma;
  mode MonoidalSubStr of G -> multLoopStr means


    the multF of it c= the
    multF of G & for M being multLoopStr st G = M holds 1.it = 1.M;
end;

registration
  let G be multMagma;
  cluster strict for MonoidalSubStr of G;
end;

registration
  let G be non empty multMagma;
  cluster strict non empty for MonoidalSubStr of G;
end;

definition
  let M be multLoopStr;
  redefine mode MonoidalSubStr of M means


    the multF of it c= the multF of M & 1.it = 1.M;
end;

registration
  let G be well-unital non empty multLoopStr;
  cluster well-unital associative commutative cancelable idempotent invertible
    uniquely-decomposable strict for non empty MonoidalSubStr of G;
end;

theorem 
  for G being multMagma, M being MonoidalSubStr of G holds M is SubStr of G;

definition
  let G be multMagma, M be MonoidalExtension of G;
  redefine mode SubStr of M -> SubStr of G;
end;

definition
  let G1 be multMagma, G2 be SubStr of G1;
  redefine mode SubStr of G2 -> SubStr of G1;
end;

definition
  let G1 be multMagma, G2 be MonoidalSubStr of G1;
  redefine mode SubStr of G2 -> SubStr of G1;
end;

definition
  let G be multMagma, M be MonoidalSubStr of G;
  redefine mode MonoidalSubStr of M -> MonoidalSubStr of G;
end;

theorem 
  G is SubStr of G & M is MonoidalSubStr of M;

reserve H for non empty SubStr of G,
  N for non empty MonoidalSubStr of G;

theorem 
  the carrier of H c= the carrier of G & the carrier of N c= the carrier of G;

theorem 
  for G being non empty multMagma, H being non empty SubStr of G
  holds the multF of H = (the multF of G)||the carrier of H;

theorem 
  for a,b being Element of H, a9,b9 being Element of G st a = a9 &
  b = b9 holds a*b = a9*b9;

theorem 
  for H1,H2 being non empty SubStr of G st the carrier of H1 = the
  carrier of H2 holds the multMagma of H1 = the multMagma of H2;

theorem 
  for H1,H2 being non empty MonoidalSubStr of M st the carrier of H1 =
  the carrier of H2 holds the multLoopStr of H1 = the multLoopStr of H2;

theorem 
  for H1,H2 being non empty SubStr of G st the carrier of H1 c=
  the carrier of H2 holds H1 is SubStr of H2;

theorem 
  for H1,H2 being non empty MonoidalSubStr of M st the carrier of H1 c=
  the carrier of H2 holds H1 is MonoidalSubStr of H2;

theorem 
  G is unital & the_unity_wrt the multF of G in the carrier of H
implies H is unital & the_unity_wrt the multF of G = the_unity_wrt the multF of
  H;

theorem 
  for M being well-unital non empty multLoopStr for N being non
  empty MonoidalSubStr of M holds N is well-unital;

theorem 
  G is commutative implies H is commutative;

theorem 
  G is associative implies H is associative;

theorem 
  G is idempotent implies H is idempotent;

theorem 
  G is cancelable implies H is cancelable;

theorem 
  the_unity_wrt the multF of G in the carrier of H & G is
  uniquely-decomposable implies H is uniquely-decomposable;

theorem 
  for M being well-unital uniquely-decomposable non empty
  multLoopStr for N being non empty MonoidalSubStr of M holds N is
  uniquely-decomposable;

registration
  let G be constituted-Functions non empty multMagma;
  cluster -> constituted-Functions for non empty SubStr of G;
  cluster -> constituted-Functions for non empty MonoidalSubStr of G;
end;

registration
  let G be constituted-FinSeqs non empty multMagma;
  cluster -> constituted-FinSeqs for non empty SubStr of G;
  cluster -> constituted-FinSeqs for non empty MonoidalSubStr of G;
end;

registration
  let M be well-unital non empty multLoopStr;
  cluster -> well-unital for non empty MonoidalSubStr of M;
end;

registration
  let G be commutative non empty multMagma;
  cluster -> commutative for non empty SubStr of G;
  cluster -> commutative for non empty MonoidalSubStr of G;
end;

registration
  let G be associative non empty multMagma;
  cluster -> associative for non empty SubStr of G;
  cluster -> associative for non empty MonoidalSubStr of G;
end;

registration
  let G be idempotent non empty multMagma;
  cluster -> idempotent for non empty SubStr of G;
  cluster -> idempotent for non empty MonoidalSubStr of G;
end;

registration
  let G be cancelable non empty multMagma;
  cluster -> cancelable for non empty SubStr of G;
  cluster -> cancelable for non empty MonoidalSubStr of G;
end;

registration
  let M be well-unital uniquely-decomposable non empty multLoopStr;
  cluster -> uniquely-decomposable for non empty MonoidalSubStr of M;
end;

scheme 

  SubStrEx2 {G() -> non empty multMagma, P[set]}: ex H being strict non empty
SubStr of G() st for x being Element of G()
 holds x in the carrier of H iff P[x]
provided
 for x,y being Element of G() holds P[x] & P[y] implies P[x*y] and
 ex x being Element of G() st P[x];

scheme 

  MonoidalSubStrEx2 {G() -> non empty multLoopStr, P[set]}: ex M being strict
  non empty MonoidalSubStr of G() st for x being Element of G() holds x in the
  carrier of M iff P[x]
provided
 for x,y being Element of G() holds P[x] & P[y] implies P[x*y] and
 P[1.G()];

notation
  let G be multMagma, a,b be Element of G;
  synonym a [*] b for a*b;
end;

begin 

definition
  func <REAL,+> -> non empty multMagma equals

  multMagma(#REAL, addreal#);
end;

registration
  cluster <REAL,+> -> unital associative invertible commutative cancelable
  strict;
end;

theorem 
  x is Element of <REAL,+> iff x is Real;

theorem 
  for N being non empty SubStr of <REAL,+> for a,b being Element
  of N, x,y being Real st a = x & b = y holds a*b = x+y;

theorem 
  for N being unital non empty SubStr of <REAL,+> holds
  the_unity_wrt the multF of N = 0;

registration
  let G be unital non empty multMagma;
  cluster associative invertible -> unital cancelable Group-like for non empty
    SubStr of G;
end;






definition
  redefine func INT.Group -> strict non empty SubStr of <REAL,+>;
end;




theorem 
  for G being strict non empty SubStr of <REAL,+> holds G = INT.Group
  iff the carrier of G = INT;

theorem 
  x is Element of INT.Group iff x is Integer;

definition
  func <NAT,+> -> unital uniquely-decomposable strict non empty SubStr of
  INT.Group means


  the carrier of it = NAT;
end;




definition
  func <NAT,+,0> -> well-unital strict non empty MonoidalExtension of <NAT,+>
   means

  not contradiction;
end;





definition
  redefine func addnat equals

  the multF of <NAT,+>;
end;

theorem 
  <NAT,+> = multMagma(#NAT,addnat#);

theorem 
  x is Element of <NAT,+,0> iff x is Element of NAT;

theorem 
  for n1,n2 being Element of NAT, m1,m2 being Element of <NAT,+,0> st n1
  = m1 & n2 = m2 holds m1*m2 = n1+n2;

theorem 
  <NAT,+,0> = multLoopStr(#NAT,addnat,0#);

theorem 
  addnat = addreal||NAT & addnat = addint||NAT;

theorem 
  0 is_a_unity_wrt addnat & addnat is uniquely-decomposable;

definition
  func <REAL,*> -> unital commutative associative strict non empty multMagma
  equals

  multMagma(#REAL,multreal#);
end;

theorem 
  x is Element of <REAL,*> iff x is Real;

theorem 
  for N being non empty SubStr of <REAL,*> for a,b being Element
  of N, x,y being Real st a = x & b = y holds a*b = x*y;

theorem 
  for N being unital non empty SubStr of <REAL,*> holds the_unity_wrt
  the multF of N = 0 or the_unity_wrt the multF of N = 1;

definition
  func <NAT,*> -> unital uniquely-decomposable strict non empty SubStr of
  <REAL,*> means


  the carrier of it = NAT;
end;




definition
  func <NAT,*,1> -> well-unital strict non empty MonoidalExtension of <NAT,*>
   means

  not contradiction;
end;




definition
  redefine func multnat equals

  the multF of <NAT,*>;
end;

theorem 
  <NAT,*> = multMagma(#NAT,multnat#);

theorem 
  for n1,n2 being Element of NAT, m1,m2 being Element of <NAT,*> st n1 =
  m1 & n2 = m2 holds m1*m2 = n1*n2;

theorem 
  the_unity_wrt the multF of <NAT,*> = 1;

theorem 
  for n1,n2 being Element of NAT, m1,m2 being Element of <NAT,*,1> st n1
  = m1 & n2 = m2 holds m1*m2 = n1*n2;

theorem 
  <NAT,*,1> = multLoopStr(#NAT,multnat,1#);

theorem 
  multnat = multreal||NAT;

theorem 
  1 is_a_unity_wrt multnat & multnat is uniquely-decomposable;

begin 

definition
  let D be non empty set;
  func D*+^ -> unital associative cancelable uniquely-decomposable
  constituted-FinSeqs strict non empty multMagma means


  the carrier of it = D* & for p,q being Element of it holds p [*] q = p^q;
end;

definition
  let D;
  func D*+^+<0> -> well-unital strict non empty MonoidalExtension of D*+^
  means

  not contradiction;
  func D-concatenation -> BinOp of D* equals

  the multF of D*+^;
end;

theorem 
  D*+^ = multMagma(#D*, D-concatenation#);

theorem 
  the_unity_wrt the multF of D*+^ = {};

theorem 
  the carrier of D*+^+<0> = D* & the multF of D*+^+<0> = D-concatenation
  & 1.(D*+^+<0>) = {};

theorem 
  for a,b being Element of D*+^+<0> holds a [*] b = a^b;

theorem 
  for F being non empty SubStr of D*+^ for p,q being Element of F
  holds p[*]q = p^q;

theorem 
  for F being unital non empty SubStr of D*+^ holds the_unity_wrt the
  multF of F = {};

theorem 
  for F being non empty SubStr of D*+^ st {} is Element of F holds F is
  unital & the_unity_wrt the multF of F = {};

theorem 
  for A,B being non empty set st A c= B holds A*+^ is SubStr of B*+^;

theorem 
  D-concatenation is having_a_unity & the_unity_wrt (D-concatenation) =
  {} & D-concatenation is associative;

begin 

definition
  let X be set;
  func GPFuncs X -> constituted-Functions strict multMagma means


  the carrier of it = PFuncs(X,X) &
  for f,g being Element of it holds f [*] g = g (*) f;
end;

registration
  let X be set;
  cluster GPFuncs X -> unital associative non empty;
end;

definition
  let X be set;
  func MPFuncs X -> well-unital strict non empty MonoidalExtension of GPFuncs
  X means

  not contradiction;
  func X-composition -> BinOp of PFuncs(X,X) equals

  the multF of GPFuncs X;
end;




theorem 
  x is Element of GPFuncs X iff x is PartFunc of X,X;

theorem 
  the_unity_wrt the multF of GPFuncs X = id X;

theorem 
  for F being non empty SubStr of GPFuncs X for f,g being Element
  of F holds f [*] g = g (*) f;

theorem 
  for F being non empty SubStr of GPFuncs X st id X is Element of
  F holds F is unital & the_unity_wrt the multF of F = id X;

theorem 
  Y c= X implies GPFuncs Y is SubStr of GPFuncs X;

definition
  let X be set;
  func GFuncs X -> strict SubStr of GPFuncs X means


  the carrier of it = Funcs(X,X);
end;

registration
  let X be set;
  cluster GFuncs X -> unital non empty;
end;




definition
  let X be set;
  func MFuncs X -> well-unital strict MonoidalExtension of GFuncs X means

  not contradiction;
end;




theorem 
  x is Element of GFuncs X iff x is Function of X,X;

theorem 
  the multF of GFuncs X = (X-composition)||Funcs(X,X);

theorem 
  the_unity_wrt the multF of GFuncs X = id X;

theorem 
  the carrier of MFuncs X = Funcs(X,X) & the multF of MFuncs X = (X
  -composition)||Funcs(X,X) & 1.MFuncs X = id X;

definition
  let X be set;
  func GPerms X -> strict non empty SubStr of GFuncs X
  means


  for f being Element of GFuncs X holds f in the carrier of it iff
  f is Permutation of X;
end;

registration
  let X be set;
  cluster GPerms X -> unital invertible;
end;




theorem 
  x is Element of GPerms X iff x is Permutation of X;

theorem 
  the_unity_wrt the multF of GPerms X = id X & 1_GPerms X = id X;

theorem 
  for f being Element of GPerms X holds f" = (f qua Function)";



theorem 
  for S being 1-sorted st the carrier of S is functional holds S is
  constituted-Functions;

theorem 
  for G be non empty multMagma, D be non empty Subset of G st
  for x,y being Element of D holds x*y in D
 ex H being strict non empty SubStr of G st the carrier of H = D;

theorem 
  for G be non empty multLoopStr, D be non empty Subset of G st
    (for x,y being Element of D holds x*y in D) & 1.G in D
  ex H being strict non empty MonoidalSubStr of G st the carrier of H = D;














begin 

definition
  let V be RealUnitarySpace;
  mode Subspace of V -> RealUnitarySpace means


    the carrier of it c= the
carrier of V & 0.it = 0.V & the addF of it = (the addF of V)||the carrier of it
& the Mult of it = (the Mult of V)|([:REAL, the carrier of it:]) & the scalar
    of it = (the scalar of V)||the carrier of it;
end;

theorem 
  for V being RealUnitarySpace, W1,W2 being Subspace of V, x being set
  st x in W1 & W1 is Subspace of W2 holds x in W2;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, x being set
  st x in W holds x in V;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, w being
  VECTOR of W holds w is VECTOR of V;

theorem 
  for V being RealUnitarySpace, W being Subspace of V holds 0.W = 0.V;

theorem 
  for V being RealUnitarySpace, W1,W2 being Subspace of V holds 0.W1 = 0.W2;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, u,v being
  VECTOR of V, w1,w2 being VECTOR of W st w1 = v & w2 = u holds w1 + w2 = v + u
;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, v being
  VECTOR of V, w being VECTOR of W, a being Real st w = v holds a * w = a * v;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, v1,v2 being
VECTOR of V, w1,w2 being VECTOR of W st w1 = v1 & w2 = v2 holds w1 .|. w2 = v1
  .|. v2;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, v being
  VECTOR of V, w being VECTOR of W st w = v holds - v = - w;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, u,v being
  VECTOR of V, w1,w2 being VECTOR of W st w1 = v & w2 = u holds w1 - w2 = v - u
;

theorem 
  for V being RealUnitarySpace, W being Subspace of V holds 0.V in W;

theorem 
  for V being RealUnitarySpace, W1,W2 being Subspace of V holds 0.W1 in W2;

theorem 
  for V being RealUnitarySpace, W being Subspace of V holds 0.W in V;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, u,v being
  VECTOR of V st u in W & v in W holds u + v in W;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, v being
  VECTOR of V, a being Real st v in W holds a * v in W;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, v being
  VECTOR of V st v in W holds - v in W;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, u,v being
  VECTOR of V st u in W & v in W holds u - v in W;

theorem 
  for V being RealUnitarySpace, V1 being Subset of V, D being non
  empty set, d1 being Element of D, A being BinOp of D, M being Function of [:
REAL, D:], D, S being Function of [:D,D:],REAL st V1 = D & d1 = 0.V & A = (the
addF of V)||V1 & M = (the Mult of V) | [:REAL,V1:] & S = (the scalar of V)||V1
  holds UNITSTR (# D,d1,A,M,S #) is Subspace of V;

theorem 
  for V being RealUnitarySpace holds V is Subspace of V;

theorem 
  for V,X being strict RealUnitarySpace holds V is Subspace of X &
  X is Subspace of V implies V = X;

theorem 
  for V,X,Y being RealUnitarySpace st V is Subspace of X & X is
  Subspace of Y holds V is Subspace of Y;

theorem 
  for V being RealUnitarySpace, W1,W2 being Subspace of V st the
  carrier of W1 c= the carrier of W2 holds W1 is Subspace of W2;

theorem 
  for V being RealUnitarySpace, W1,W2 being Subspace of V st (for v
  being VECTOR of V st v in W1 holds v in W2) holds W1 is Subspace of W2;

registration
  let V be RealUnitarySpace;
  cluster strict for Subspace of V;
end;

theorem 
  for V being RealUnitarySpace, W1,W2 being strict Subspace of V
  st the carrier of W1 = the carrier of W2 holds W1 = W2;

theorem 
  for V being RealUnitarySpace, W1,W2 being strict Subspace of V
  st (for v being VECTOR of V holds v in W1 iff v in W2) holds W1 = W2;

theorem 
  for V being strict RealUnitarySpace, W being strict Subspace of V st
  the carrier of W = the carrier of V holds W = V;

theorem 
  for V being strict RealUnitarySpace, W being strict Subspace of V st (
  for v being VECTOR of V holds v in W iff v in V) holds W = V;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, V1 being Subset
  of V st the carrier of W = V1 holds V1 is linearly-closed;

theorem 
  for V being RealUnitarySpace, V1 being Subset of V st V1 <> {} &
V1 is linearly-closed holds ex W being strict Subspace of V st V1 = the carrier
  of W;

begin



definition
  let V being RealUnitarySpace;
  func (0).V -> strict Subspace of V means


  the carrier of it = {0.V};
end;

definition
  let V being RealUnitarySpace;
  func (Omega).V -> strict Subspace of V equals

  the UNITSTR of V;
end;

begin 

theorem 
  for V being RealUnitarySpace, W being Subspace of V holds (0).W = (0).V;

theorem 
  for V being RealUnitarySpace, W1,W2 being Subspace of V holds (0).W1 = (0).W2
;

theorem 
  for V being RealUnitarySpace, W being Subspace of V holds (0).W is
  Subspace of V;

theorem 
  for V being RealUnitarySpace, W being Subspace of V holds (0).V is
  Subspace of W;

theorem 
  for V being RealUnitarySpace, W1,W2 being Subspace of V holds (0).W1
  is Subspace of W2;

theorem 
  for V being strict RealUnitarySpace holds V is Subspace of (Omega).V;

begin 

definition
  let V be RealUnitarySpace, v be VECTOR of V, W be Subspace of V;
  func v + W -> Subset of V equals

  {v + u where u is VECTOR of V : u in W};
end;

definition
  let V be RealUnitarySpace;
  let W be Subspace of V;
  mode Coset of W -> Subset of V means


    ex v be VECTOR of V st it = v + W;
end;

begin 

theorem 
  for V being RealUnitarySpace, W being Subspace of V, v being
  VECTOR of V holds 0.V in v + W iff v in W;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, v being
  VECTOR of V holds v in v + W;

theorem 
  for V being RealUnitarySpace, W being Subspace of V holds 0.V + W =
  the carrier of W;

theorem 
  for V being RealUnitarySpace, v being VECTOR of V holds v + (0). V = {v};

theorem 
  for V being RealUnitarySpace, v being VECTOR of V holds v +
  (Omega).V = the carrier of V;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, v being
  VECTOR of V holds 0.V in v + W iff v + W = the carrier of W;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, v being VECTOR of
  V holds v in W iff v + W = the carrier of W;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, v being
  VECTOR of V, a being Real st v in W holds (a * v) + W = the carrier of W;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, v being
VECTOR of V, a being Real st a <> 0 & (a * v) + W = the carrier of W holds v in
  W;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, v being
  VECTOR of V holds v in W iff - v + W = the carrier of W;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, u,v being
  VECTOR of V holds u in W iff v + W = (v + u) + W;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, u,v being VECTOR
  of V holds u in W iff v + W = (v - u) + W;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, u,v being
  VECTOR of V holds v in u + W iff u + W = v + W;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, v being
  VECTOR of V holds v + W = (- v) + W iff v in W;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, u,v1,v2
  being VECTOR of V st u in v1 + W & u in v2 + W holds v1 + W = v2 + W;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, u,v being VECTOR
  of V st u in v + W & u in (- v) + W holds v in W;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, v being
  VECTOR of V, a being Real st a <> 1 & a * v in v + W holds v in W;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, v being
  VECTOR of V, a being Real st v in W holds a * v in v + W;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, v being VECTOR of
  V holds - v in v + W iff v in W;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, u,v being
  VECTOR of V holds u + v in v + W iff u in W;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, u,v being VECTOR
  of V holds v - u in v + W iff u in W;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, u,v being
  VECTOR of V holds u in v + W iff ex v1 being VECTOR of V st v1 in W & u = v +
  v1;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, u,v being VECTOR
  of V holds u in v + W iff ex v1 being VECTOR of V st v1 in W & u = v - v1;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, v1,v2 being
VECTOR of V holds (ex v being VECTOR of V st v1 in v + W & v2 in v + W) iff v1
  - v2 in W;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, u,v being
VECTOR of V st v + W = u + W holds ex v1 being VECTOR of V st v1 in W & v + v1
  = u;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, u,v being
VECTOR of V st v + W = u + W holds ex v1 being VECTOR of V st v1 in W & v - v1
  = u;

theorem 
  for V being RealUnitarySpace, W1,W2 being strict Subspace of V,
  v being VECTOR of V holds v + W1 = v + W2 iff W1 = W2;

theorem 
  for V being RealUnitarySpace, W1,W2 being strict Subspace of V,
  u,v being VECTOR of V st v + W1 = u + W2 holds W1 = W2;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, C being Coset of
  W holds C is linearly-closed iff C = the carrier of W;

theorem 
  for V being RealUnitarySpace, W1,W2 being strict Subspace of V, C1
  being Coset of W1, C2 being Coset of W2 holds C1 = C2 implies W1 = W2;

theorem 
  for V being RealUnitarySpace, v being VECTOR of V holds {v} is Coset of (0).V
;

theorem 
  for V being RealUnitarySpace, V1 being Subset of V holds V1 is Coset
  of (0).V implies ex v being VECTOR of V st V1 = {v};

theorem 
  for V being RealUnitarySpace, W being Subspace of V holds the carrier
  of W is Coset of W;

theorem 
  for V being RealUnitarySpace holds the carrier of V is Coset of (Omega).V;

theorem 
  for V being RealUnitarySpace, V1 being Subset of V st V1 is Coset of
  (Omega).V holds V1 = the carrier of V;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, C being Coset of
  W holds 0.V in C iff C = the carrier of W;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, C being
  Coset of W, u being VECTOR of V holds u in C iff C = u + W;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, C being Coset of
W, u,v being VECTOR of V st u in C & v in C holds ex v1 being VECTOR of V st v1
  in W & u + v1 = v;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, C being Coset of
W, u,v being VECTOR of V st u in C & v in C holds ex v1 being VECTOR of V st v1
  in W & u - v1 = v;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, v1,v2 being
VECTOR of V holds (ex C being Coset of W st v1 in C & v2 in C) iff v1 - v2 in W
;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, u being VECTOR of
  V, B,C being Coset of W st u in B & u in C holds B = C;














begin 

definition
  let V be RealUnitarySpace, W1,W2 be Subspace of V;
  func W1 + W2 -> strict Subspace of V means


  the carrier of it = {v + u where v,u is VECTOR of V: v in W1 & u in W2};
end;

definition
  let V be RealUnitarySpace, W1,W2 be Subspace of V;
  func W1 /\ W2 -> strict Subspace of V means


  the carrier of it = (the carrier of W1) /\ (the carrier of W2);
end;

begin 

theorem 
  for V being RealUnitarySpace, W1,W2 being Subspace of V, x being
set holds x in W1 + W2 iff ex v1,v2 being VECTOR of V st v1 in W1 & v2 in W2 &
  x = v1 + v2;

theorem 
  for V being RealUnitarySpace, W1,W2 being Subspace of V, v being
  VECTOR of V st v in W1 or v in W2 holds v in W1 + W2;

theorem 
  for V being RealUnitarySpace, W1,W2 being Subspace of V, x being
  set holds x in W1 /\ W2 iff x in W1 & x in W2;

theorem 
  for V being RealUnitarySpace, W being strict Subspace of V holds W + W
  = W;

theorem 
  for V being RealUnitarySpace, W1,W2 being Subspace of V holds W1 + W2
  = W2 + W1;

theorem 
  for V being RealUnitarySpace, W1,W2,W3 being Subspace of V holds
  W1 + (W2 + W3) = (W1 + W2) + W3;

theorem 
  for V being RealUnitarySpace, W1,W2 being Subspace of V holds W1
  is Subspace of W1 + W2 & W2 is Subspace of W1 + W2;

theorem 
  for V being RealUnitarySpace, W1 being Subspace of V, W2 being
  strict Subspace of V holds W1 is Subspace of W2 iff W1 + W2 = W2;

theorem 
  for V being RealUnitarySpace, W being strict Subspace of V holds
  (0).V + W = W & W + (0).V = W;

theorem 
  for V being RealUnitarySpace holds (0).V + (Omega).V = the
  UNITSTR of V & (Omega).V + (0).V = the UNITSTR of V;

theorem 
  for V being RealUnitarySpace, W being Subspace of V holds
  (Omega).V + W = the UNITSTR of V & W + (Omega).V = the UNITSTR of V;

theorem 
  for V being strict RealUnitarySpace holds (Omega).V + (Omega).V = V;

theorem 
  for V being RealUnitarySpace, W being strict Subspace of V holds W /\ W = W;

theorem 
  for V being RealUnitarySpace, W1,W2 being Subspace of V holds W1
  /\ W2 = W2 /\ W1;

theorem 
  for V being RealUnitarySpace, W1,W2,W3 being Subspace of V holds
  W1 /\ (W2 /\ W3) = (W1 /\ W2) /\ W3;

theorem 
  for V being RealUnitarySpace, W1,W2 being Subspace of V holds W1
  /\ W2 is Subspace of W1 & W1 /\ W2 is Subspace of W2;

theorem 
  for V being RealUnitarySpace, W2 being Subspace of V, W1 being
  strict Subspace of V holds W1 is Subspace of W2 iff W1 /\ W2 = W1;

theorem 
  for V being RealUnitarySpace, W being Subspace of V holds (0).V
  /\ W = (0).V & W /\ (0).V = (0).V;

theorem 
  for V being RealUnitarySpace holds (0).V /\ (Omega).V = (0).V &
  (Omega).V /\ (0).V = (0).V;

theorem 
  for V being RealUnitarySpace, W being strict Subspace of V holds
  (Omega).V /\ W = W & W /\ (Omega).V = W;

theorem 
  for V being strict RealUnitarySpace holds (Omega).V /\ (Omega).V = V;

theorem 
  for V being RealUnitarySpace, W1,W2 being Subspace of V holds W1 /\ W2
  is Subspace of W1 + W2;

theorem 
  for V being RealUnitarySpace, W1 being Subspace of V, W2 being strict
  Subspace of V holds (W1 /\ W2) + W2 = W2;

theorem 
  for V being RealUnitarySpace, W1 being Subspace of V, W2 being strict
  Subspace of V holds W2 /\ (W2 + W1) = W2;

theorem 
  for V being RealUnitarySpace, W1,W2,W3 being Subspace of V holds (W1
  /\ W2) + (W2 /\ W3) is Subspace of W2 /\ (W1 + W3);

theorem 
  for V being RealUnitarySpace, W1,W2,W3 being Subspace of V st W1 is
Subspace of W2 holds W2 /\ (W1 + W3) = (W1 /\ W2) + (W2 /\ W3);

theorem 
  for V being RealUnitarySpace, W1,W2,W3 being Subspace of V holds W2 +
  (W1 /\ W3) is Subspace of (W1 + W2) /\ (W2 + W3);

theorem 
  for V being RealUnitarySpace, W1,W2,W3 being Subspace of V st W1 is
Subspace of W2 holds W2 + (W1 /\ W3) = (W1 + W2) /\ (W2 + W3);

theorem 
  for V being RealUnitarySpace, W1,W2,W3 being Subspace of V st W1
  is strict Subspace of W3 holds W1 + (W2 /\ W3) = (W1 + W2) /\ W3;

theorem 
  for V being RealUnitarySpace, W1,W2 being strict Subspace of V holds
  W1 + W2 = W2 iff W1 /\ W2 = W1;

theorem 
  for V being RealUnitarySpace, W1 being Subspace of V, W2,W3 being
strict Subspace of V holds W1 is Subspace of W2 implies W1 + W3 is Subspace of
  W2 + W3;

theorem 
  for V being RealUnitarySpace, W1,W2 being Subspace of V holds (ex W
  being Subspace of V st the carrier of W = (the carrier of W1) \/ (the carrier
  of W2)) iff W1 is Subspace of W2 or W2 is Subspace of W1;

begin 

definition
  let V be RealUnitarySpace;
  func Subspaces(V) -> set means


  for x being set holds x in it iff x is strict Subspace of V;
end;

registration
  let V be RealUnitarySpace;
  cluster Subspaces(V) -> non empty;
end;

theorem 
  for V being strict RealUnitarySpace holds V in Subspaces(V);

begin 

definition
  let V be RealUnitarySpace;
  let W1,W2 be Subspace of V;
  pred V is_the_direct_sum_of W1,W2 means


  the UNITSTR of V = W1 + W2 & W1 /\ W2 = (0).V;
end;

definition
  let V be RealUnitarySpace;
  let W be Subspace of V;
  mode Linear_Compl of W -> Subspace of V means


    V is_the_direct_sum_of it,W;
end;

registration
  let V be RealUnitarySpace;
  let W be Subspace of V;
  cluster strict for Linear_Compl of W;
end;

theorem 
  for V being RealUnitarySpace, W1,W2 being Subspace of V holds V
  is_the_direct_sum_of W1,W2 implies W2 is Linear_Compl of W1;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, L being
Linear_Compl of W holds V is_the_direct_sum_of L,W & V is_the_direct_sum_of W,L
;

begin




theorem 
  for V being RealUnitarySpace, W being Subspace of V, L being
  Linear_Compl of W holds W + L = the UNITSTR of V & L + W = the UNITSTR of V;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, L being
  Linear_Compl of W holds W /\ L = (0).V & L /\ W = (0).V;

theorem 
  for V being RealUnitarySpace, W1,W2 being Subspace of V st V
  is_the_direct_sum_of W1,W2 holds V is_the_direct_sum_of W2,W1;

theorem 
  for V being RealUnitarySpace holds V is_the_direct_sum_of (0).V,
  (Omega).V & V is_the_direct_sum_of (Omega).V,(0).V;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, L being
  Linear_Compl of W holds W is Linear_Compl of L;

theorem 
  for V being RealUnitarySpace holds (0).V is Linear_Compl of (Omega).V
  & (Omega).V is Linear_Compl of (0).V;

theorem 
  for V being RealUnitarySpace, W1,W2 being Subspace of V, C1
being Coset of W1, C2 being Coset of W2 st C1 meets C2 holds C1 /\ C2 is Coset
  of W1 /\ W2;

theorem 
  for V being RealUnitarySpace, W1,W2 being Subspace of V holds V
  is_the_direct_sum_of W1,W2 iff for C1 being Coset of W1, C2 being Coset of W2
  ex v being VECTOR of V st C1 /\ C2 = {v};

begin 

theorem 
  for V being RealUnitarySpace, W1,W2 being Subspace of V holds W1 + W2
= the UNITSTR of V iff for v being VECTOR of V ex v1,v2 being VECTOR of V st v1
  in W1 & v2 in W2 & v = v1 + v2;

theorem 
  for V being RealUnitarySpace, W1,W2 being Subspace of V, v,v1,v2
,u1,u2 being VECTOR of V st V is_the_direct_sum_of W1,W2 & v = v1 + v2 & v = u1
  + u2 & v1 in W1 & u1 in W1 & v2 in W2 & u2 in W2 holds v1 = u1 & v2 = u2;

theorem 
  for V being RealUnitarySpace, W1,W2 being Subspace of V st V = W1 + W2
& (ex v being VECTOR of V st for v1,v2,u1,u2 being VECTOR of V st v = v1 + v2 &
v = u1 + u2 & v1 in W1 & u1 in W1 & v2 in W2 & u2 in W2 holds v1 = u1 & v2 = u2
  ) holds V is_the_direct_sum_of W1,W2;

definition
  let V be RealUnitarySpace;
  let v be VECTOR of V;
  let W1,W2 be Subspace of V;
  assume
 V is_the_direct_sum_of W1,W2;
  func v |-- (W1,W2) -> Element of [:the carrier of V, the carrier of V:]
  means


  v = it`1 + it`2 & it`1 in W1 & it`2 in W2;
end;

theorem 
  for V being RealUnitarySpace, v being VECTOR of V, W1,W2 being
Subspace of V st V is_the_direct_sum_of W1,W2 holds (v |-- (W1,W2))`1 = (v |--
  (W2,W1))`2;

theorem 
  for V being RealUnitarySpace, v being VECTOR of V, W1,W2 being
Subspace of V st V is_the_direct_sum_of W1,W2 holds (v |-- (W1,W2))`2 = (v |--
  (W2,W1))`1;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, L being
Linear_Compl of W, v being VECTOR of V, t being Element of [:the carrier of V,
the carrier of V:] st t`1 + t`2 = v & t`1 in W & t`2 in L holds t = v |-- (W,L)
;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, L being
Linear_Compl of W, v being VECTOR of V holds (v |-- (W,L))`1 + (v |-- (W,L))`2
  = v;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, L being
Linear_Compl of W, v being VECTOR of V holds (v |-- (W,L))`1 in W & (v |-- (W,L
  ))`2 in L;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, L being
Linear_Compl of W, v being VECTOR of V holds (v |-- (W,L))`1 = (v |-- (L,W))`2;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, L being
Linear_Compl of W, v being VECTOR of V holds (v |-- (W,L))`2 = (v |-- (L,W))`1;

begin 

definition
  let V be RealUnitarySpace;
  func SubJoin(V) -> BinOp of Subspaces(V) means


  for A1,A2 being
  Element of Subspaces(V), W1,W2 being Subspace of V st A1 = W1 & A2 = W2 holds
  it.(A1,A2) = W1 + W2;
end;

definition
  let V be RealUnitarySpace;
  func SubMeet(V) -> BinOp of Subspaces(V) means


  for A1,A2 being
  Element of Subspaces(V), W1,W2 being Subspace of V st A1 = W1 & A2 = W2 holds
  it.(A1,A2) = W1 /\ W2;
end;

begin 

theorem 
  for V being RealUnitarySpace holds LattStr (# Subspaces(V),
    SubJoin(V), SubMeet(V) #) is Lattice;

registration
  let V be RealUnitarySpace;
  cluster LattStr (# Subspaces(V), SubJoin(V), SubMeet(V) #) -> Lattice-like;
end;

theorem 
  for V being RealUnitarySpace holds LattStr (# Subspaces(V),
    SubJoin(V), SubMeet(V) #) is lower-bounded;

theorem 
  for V being RealUnitarySpace holds LattStr (# Subspaces(V),
    SubJoin(V), SubMeet(V) #) is upper-bounded;

theorem 
  for V being RealUnitarySpace holds LattStr (# Subspaces(V),
    SubJoin(V), SubMeet(V) #) is 01_Lattice;

theorem 
  for V being RealUnitarySpace holds LattStr (# Subspaces(V),
    SubJoin(V), SubMeet(V) #) is modular;

theorem 
  for V being RealUnitarySpace holds LattStr (# Subspaces(V),
    SubJoin(V), SubMeet(V) #) is complemented;

registration
  let V be RealUnitarySpace;
  cluster LattStr (# Subspaces(V), SubJoin(V), SubMeet(V) #) -> lower-bounded
    upper-bounded modular complemented;
end;

theorem 
  for V being RealUnitarySpace, W1,W2,W3 being strict Subspace of V
  holds W1 is Subspace of W2 implies W1 /\ W3 is Subspace of W2 /\ W3;

begin 

theorem 
  for V being RealUnitarySpace, W being strict Subspace of V holds (for
  v being VECTOR of V holds v in W) implies W = the UNITSTR of V;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, v being VECTOR of
  V holds ex C being Coset of W st v in C;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, v being VECTOR of
V, x being set holds x in v + W iff ex u being VECTOR of V st u in W & x = v +
  u;















begin

reserve x for set;
reserve a,b,c,d,e,r1,r2,r3,r4,r5,r6 for Real;
reserve V for RealLinearSpace;
reserve u,v,v1,v2,v3,w,w1,w2,w3 for VECTOR of V;
reserve W,W1,W2 for Subspace of V;

scheme 

  LambdaSep3{D, R() -> non empty set, A1, A2, A3() -> Element of D(), B1, B2,
B3() -> Element of R(), F(set) -> Element of R()}: ex f being Function of D(),R
() st f.A1() = B1() & f.A2() = B2() & f.A3() = B3() & for C being Element of D(
  ) st C <> A1() & C <> A2() & C <> A3() holds f.C = F(C)
provided
 A1() <> A2() and
 A1() <> A3() and
 A2() <> A3();

theorem 
  v + w - v = w & w + v - v = w & v - v + w = w & w - v + v = w & v + (w
  - v) = w & w + (v - v) = w & v - (v - w) = w;



theorem 
  v1 - w = v2 - w implies v1 = v2;



theorem 
  - (a * v) = (- a) * v;

theorem 
  W1 is Subspace of W2 implies v + W1 c= v + W2;

theorem 
  u in v + W implies v + W = u + W;

theorem 
  for l being Linear_Combination of {u,v,w} st u <> v & u <> w & v
  <> w holds Sum(l) = l.u * u + l.v * v + l.w * w;

theorem 
  u <> v & u <> w & v <> w & {u,v,w} is linearly-independent iff
  for a,b,c st a * u + b * v + c * w = 0.V holds a = 0 & b = 0 & c = 0;

theorem 
  x in Lin{v} iff ex a st x = a * v;

theorem 
  v in Lin{v};

theorem 
  x in v + Lin{w} iff ex a st x = v + a * w;

theorem 
  x in Lin{w1,w2} iff ex a,b st x = a * w1 + b * w2;

theorem 
  w1 in Lin{w1,w2} & w2 in Lin{w1,w2};

theorem 
  x in v + Lin{w1,w2} iff ex a,b st x = v + a * w1 + b * w2;

theorem 
  x in Lin{v1,v2,v3} iff ex a,b,c st x = a * v1 + b * v2 + c * v3;

theorem 
  w1 in Lin{w1,w2,w3} & w2 in Lin{w1,w2,w3} & w3 in Lin{w1,w2,w3};

theorem 
  x in v + Lin{w1,w2,w3} iff ex a,b,c st x = v + a * w1 + b * w2 + c * w3;

theorem 
  {u,v} is linearly-independent & u <> v implies {u,v - u} is
  linearly-independent;

theorem 
  {u,v} is linearly-independent & u <> v implies {u,v + u} is
  linearly-independent;

theorem 
  {u,v} is linearly-independent & u <> v & a <> 0 implies {u,a * v
  } is linearly-independent;

theorem 
  {u,v} is linearly-independent & u <> v implies {u,- v} is
  linearly-independent;

theorem 
  a <> b implies {a * v,b * v} is linearly-dependent;

theorem 
  a <> 1 implies {v,a * v} is linearly-dependent;

theorem 
  {u,w,v} is linearly-independent & u <> v & u <> w & v <> w implies {u,
  w,v - u} is linearly-independent;

theorem 
  {u,w,v} is linearly-independent & u <> v & u <> w & v <> w implies {u,
  w - u,v - u} is linearly-independent;

theorem 
  {u,w,v} is linearly-independent & u <> v & u <> w & v <> w implies {u,
  w,v + u} is linearly-independent;

theorem 
  {u,w,v} is linearly-independent & u <> v & u <> w & v <> w implies {u,
  w + u,v + u} is linearly-independent;

theorem 
  {u,w,v} is linearly-independent & u <> v & u <> w & v <> w & a
  <> 0 implies {u,w,a * v} is linearly-independent;

theorem 
  {u,w,v} is linearly-independent & u <> v & u <> w & v <> w & a
  <> 0 & b <> 0 implies {u,a * w,b * v} is linearly-independent;

theorem 
  {u,w,v} is linearly-independent & u <> v & u <> w & v <> w implies {u,
  w,- v} is linearly-independent;

theorem 
  {u,w,v} is linearly-independent & u <> v & u <> w & v <> w implies {u,
  - w,- v} is linearly-independent;

theorem 
  a <> b implies {a * v,b * v,w} is linearly-dependent;

theorem 
  a <> 1 implies {v,a * v,w} is linearly-dependent;

theorem 
  v in Lin{w} & v <> 0.V implies Lin{v} = Lin{w};

theorem 
  v1 <> v2 & {v1,v2} is linearly-independent & v1 in Lin{w1,w2} & v2 in
Lin{w1,w2} implies Lin{w1,w2} = Lin{v1,v2} & {w1,w2} is linearly-independent &
  w1 <> w2;

theorem 
  w <> 0.V & {v,w} is linearly-dependent implies ex a st v = a * w;

theorem 
  v <> w & {v,w} is linearly-independent & {u,v,w} is linearly-dependent
  implies ex a,b st u = a * v + b * w;

theorem 
  for V be RealLinearSpace, v be VECTOR of V, a be Real
  ex l being Linear_Combination of {v} st l.v = a;

theorem 
  for V be RealLinearSpace, v1, v2 be VECTOR of V, a, b be Real st
  v1 <> v2
  ex l being Linear_Combination of {v1,v2} st l.v1 = a & l.v2 = b;

theorem 
 for V be RealLinearSpace, v1, v2, v3 be VECTOR of V,  a, b, c be Real st
 v1 <> v2 & v1 <> v3 & v2 <> v3
 ex l being Linear_Combination of {v1,v2,v3} st l.v1 = a & l.v2 = b & l.v3 = c;














begin 

definition
  let V be RealUnitarySpace;
  let A be Subset of V;
  func Lin(A) -> strict Subspace of V means


  the carrier of it = {Sum(l)
  where l is Linear_Combination of A: not contradiction};
end;

theorem 
  for V being RealUnitarySpace, A being Subset of V, x be set holds
  x in Lin(A) iff ex l being Linear_Combination of A st x = Sum(l);

theorem 
  for V being RealUnitarySpace, A being Subset of V, x being set st
  x in A holds x in Lin(A);

theorem 
  for V being RealUnitarySpace holds Lin({}(the carrier of V)) = (0).V;

theorem 
  for V being RealUnitarySpace, A being Subset of V st Lin(A) = (0).V
  holds A = {} or A = {0.V};

theorem 
  for V being RealUnitarySpace, W being strict Subspace of V, A
  being Subset of V st A = the carrier of W holds Lin(A) = W;

theorem 
  for V being strict RealUnitarySpace,A being Subset of V holds A = the
  carrier of V implies Lin(A) = V;

theorem 
  for V being RealUnitarySpace, A,B being Subset of V st A c= B
  holds Lin(A) is Subspace of Lin(B);

theorem 
  for V being strict RealUnitarySpace, A,B being Subset of V st Lin(A) =
  V & A c= B holds Lin(B) = V;

theorem 
  for V being RealUnitarySpace, A,B being Subset of V holds Lin(A \/ B)
  = Lin(A) + Lin(B);

theorem 
  for V being RealUnitarySpace, A,B being Subset of V holds Lin(A /\ B)
  is Subspace of Lin(A) /\ Lin(B);

theorem 
  for V being RealUnitarySpace, A being Subset of V st A is
  linearly-independent holds ex B being Subset of V st A c= B & B is
  linearly-independent & Lin(B) = the UNITSTR of V;

theorem 
  for V being RealUnitarySpace, A being Subset of V st Lin(A) = V
holds ex B being Subset of V st B c= A & B is linearly-independent & Lin(B) = V
;

begin 

definition
  let V be RealUnitarySpace;
  mode Basis of V -> Subset of V means


    it is linearly-independent & Lin (it) = the UNITSTR of V;
end;

theorem 
  for V being strict RealUnitarySpace, A being Subset of V st A is
  linearly-independent holds ex I being Basis of V st A c= I;

theorem 
  for V being RealUnitarySpace, A being Subset of V st Lin(A) = V holds
  ex I being Basis of V st I c= A;

theorem 
  for V being RealUnitarySpace, A being Subset of V st A is
  linearly-independent holds ex I being Basis of V st A c= I;

begin 

theorem 
  for V being RealUnitarySpace, L being Linear_Combination of V, A
  being Subset of V, F being FinSequence of V st rng F c= the carrier of Lin(A)
  holds ex K being Linear_Combination of A st Sum(L (#) F) = Sum(K);

theorem 
  for V being RealUnitarySpace, L being Linear_Combination of V, A being
  Subset of V st Carrier(L) c= the carrier of Lin(A) holds ex K being
  Linear_Combination of A st Sum(L) = Sum(K);

theorem 
  for V being RealUnitarySpace, W being Subspace of V, L being
  Linear_Combination of V st Carrier(L) c= the carrier of W for K being
Linear_Combination of W st K = L|the carrier of W holds Carrier(L) = Carrier(K)
  & Sum(L) = Sum(K);

theorem 
  for V being RealUnitarySpace, W being Subspace of V, K being
Linear_Combination of W holds ex L being Linear_Combination of V st Carrier(K)
  = Carrier(L) & Sum(K) = Sum(L);

theorem 
  for V being RealUnitarySpace, W being Subspace of V, L being
  Linear_Combination of V st Carrier(L) c= the carrier of W holds ex K being
  Linear_Combination of W st Carrier(K) = Carrier(L) & Sum(K) = Sum (L);

theorem 
  for V being RealUnitarySpace, I being Basis of V, v being VECTOR
  of V holds v in Lin(I);

theorem 
  for V being RealUnitarySpace, W being Subspace of V, A being
Subset of W st A is linearly-independent holds A is linearly-independent Subset
  of V;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, A being Subset of
  V st A is linearly-independent & A c= the carrier of W holds A is
  linearly-independent Subset of W;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, A being Basis of
  W ex B being Basis of V st A c= B;

theorem 
  for V being RealUnitarySpace, A being Subset of V st A is
linearly-independent for v being VECTOR of V st v in A for B being Subset of V
  st B = A \ {v} holds not v in Lin(B);

theorem 
  for V being RealUnitarySpace, I being Basis of V, A being non empty
  Subset of V st A misses I for B being Subset of V st B = I \/ A holds B is
  linearly-dependent;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, A being Subset of
  V st A c= the carrier of W holds Lin(A) is Subspace of W;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, A being Subset of
  V, B being Subset of W st A = B holds Lin(A) = Lin(B);

begin 

theorem 
  for V being RealUnitarySpace, v being VECTOR of V, x being set
  holds x in Lin{v} iff ex a being Real st x = a * v;

theorem 
  for V being RealUnitarySpace, v being VECTOR of V holds v in Lin{v};

theorem 
  for V being RealUnitarySpace, v,w being VECTOR of V, x being set holds
  x in v + Lin{w} iff ex a being Real st x = v + a * w;

theorem 
  for V being RealUnitarySpace, w1,w2 being VECTOR of V, x being
  set holds x in Lin{w1,w2} iff ex a,b being Real st x = a * w1 + b * w2;

theorem 
  for V being RealUnitarySpace, w1,w2 being VECTOR of V holds w1 in Lin{
  w1,w2} & w2 in Lin{w1,w2};

theorem 
  for V being RealUnitarySpace, v,w1,w2 being VECTOR of V, x being set
  holds x in v + Lin{w1,w2} iff ex a,b being Real st x = v + a * w1 + b * w2;

theorem 
  for V being RealUnitarySpace, v1,v2,v3 being VECTOR of V, x
being set holds x in Lin{v1,v2,v3} iff ex a,b,c being Real st x = a * v1 + b *
  v2 + c * v3;

theorem 
  for V being RealUnitarySpace, w1,w2,w3 being VECTOR of V holds w1 in
  Lin{w1,w2,w3} & w2 in Lin{w1,w2,w3} & w3 in Lin{w1,w2,w3};

theorem 
  for V being RealUnitarySpace, v,w1,w2,w3 being VECTOR of V, x being
set holds x in v + Lin{w1,w2,w3} iff ex a,b,c being Real st x = v + a * w1 + b
  * w2 + c * w3;

theorem 
  for V being RealUnitarySpace, v,w being VECTOR of V st v in Lin{w} & v
  <> 0.V holds Lin{v} = Lin{w};

theorem 
  for V being RealUnitarySpace, v1,v2,w1,w2 being VECTOR of V st v1 <>
  v2 & {v1,v2} is linearly-independent & v1 in Lin{w1,w2} & v2 in Lin{w1,w2}
  holds Lin{w1,w2} = Lin{v1,v2} & {w1,w2} is linearly-independent & w1 <> w2;

begin 

theorem 
  for V being RealUnitarySpace, x being set holds x in (0).V iff x = 0.V;

theorem 
  for V being RealUnitarySpace, W1,W2,W3 being Subspace of V st W1 is
  Subspace of W3 holds W1 /\ W2 is Subspace of W3;

theorem 
  for V being RealUnitarySpace, W1,W2,W3 being Subspace of V st W1 is
Subspace of W2 & W1 is Subspace of W3 holds W1 is Subspace of W2 /\ W3;

theorem 
  for V being RealUnitarySpace, W1,W2,W3 being Subspace of V st W1 is
  Subspace of W3 & W2 is Subspace of W3 holds W1 + W2 is Subspace of W3;

theorem 
  for V being RealUnitarySpace, W1,W2,W3 being Subspace of V st W1 is
  Subspace of W2 holds W1 is Subspace of W2 + W3;

theorem 
  for V being RealUnitarySpace, W1,W2 being Subspace of V, v being
  VECTOR of V st W1 is Subspace of W2 holds v + W1 c= v + W2;














begin  

reserve V for RealLinearSpace,
  W for Subspace of V,
  x, y, y1, y2 for set,
  i, n for Element of NAT,
  v for VECTOR of V,
  KL1, KL2 for Linear_Combination of V,
  X for Subset of V;

theorem 
  X is linearly-independent & Carrier(KL1) c= X & Carrier(KL2) c= X
  & Sum(KL1) = Sum(KL2) implies KL1 = KL2;

theorem 
  for V being RealLinearSpace, A being Subset of V st A is
  linearly-independent holds ex I being Basis of V st A c= I;

theorem 
  for L being Linear_Combination of V, x being VECTOR of V holds x
  in Carrier L iff ex v st x = v & L.v <> 0;



theorem 
  for L being Linear_Combination of V for F, G being FinSequence of
the carrier of V for P being Permutation of dom F st G = F*P holds Sum(L (#) F)
  = Sum(L (#) G);

theorem 
  for L being Linear_Combination of V for F being FinSequence of
  the carrier of V st Carrier(L) misses rng F holds Sum(L (#) F) = 0.V;

theorem 
  for F being FinSequence of the carrier of V st F is one-to-one
for L being Linear_Combination of V st Carrier(L) c= rng F holds Sum(L (#) F) =
  Sum(L);

theorem 
  for L being Linear_Combination of V for F being FinSequence of
the carrier of V holds ex K being Linear_Combination of V st Carrier(K) = rng F
  /\ Carrier(L) & L (#) F = K (#) F;

theorem 
  for L being Linear_Combination of V for A being Subset of V for F
  being FinSequence of the carrier of V st rng F c= the carrier of Lin(A) holds
  ex K being Linear_Combination of A st Sum(L (#) F) = Sum(K);

theorem 
  for L being Linear_Combination of V for A being Subset of V st
Carrier(L) c= the carrier of Lin(A) holds ex K being Linear_Combination of A st
  Sum(L) = Sum(K);

theorem 
  for L being Linear_Combination of V st Carrier(L) c= the carrier
  of W for K being Linear_Combination of W st K = L|the carrier of W holds
  Carrier(L) = Carrier(K) & Sum(L) = Sum(K);

theorem 
  for K being Linear_Combination of W holds ex L being
  Linear_Combination of V st Carrier(K) = Carrier(L) & Sum(K) = Sum(L);

theorem 
  for L being Linear_Combination of V st Carrier(L) c= the carrier
of W holds ex K being Linear_Combination of W st Carrier(K) = Carrier(L) & Sum(
  K) = Sum (L);



theorem 
  for I being Basis of V, v being VECTOR of V holds v in Lin(I);

theorem 
  for A being Subset of W st A is linearly-independent holds A is
  linearly-independent Subset of V;

theorem 
  for A being Subset of V st A is linearly-independent & A c= the
  carrier of W holds A is linearly-independent Subset of W;

theorem 
  for A being Basis of W ex B being Basis of V st A c= B;

theorem 
  for A being Subset of V st A is linearly-independent for v being
VECTOR of V st v in A for B being Subset of V st B = A \ {v} holds not v in Lin
  (B);

theorem 
  for I being Basis of V for A being non empty Subset of V st A
  misses I for B being Subset of V st B = I \/ A holds B is linearly-dependent;

theorem 
  for A being Subset of V st A c= the carrier of W holds Lin(A) is
  Subspace of W;

theorem 
  for A being Subset of V, B being Subset of W st A = B holds Lin( A) = Lin(B);

begin  


theorem 
  for A, B being finite Subset of V for v being VECTOR of V st v
in Lin(A \/ B) & not v in Lin(B) holds ex w being VECTOR of V st w in A & w in
  Lin(A \/ B \ {w} \/ {v});



theorem 
  for A, B being finite Subset of V st the RLSStruct of V = Lin(A)
  & B is linearly-independent holds card B <= card A & ex C being finite Subset
  of V st C c= A & card C = card A - card B & the RLSStruct of V = Lin(B \/ C);

begin  

definition
  let V be RealLinearSpace;
  attr V is finite-dimensional means


  ex A being finite Subset of V st A is Basis of V;
end;

registration
  cluster strict finite-dimensional for RealLinearSpace;
end;

theorem 
  V is finite-dimensional implies for I being Basis of V holds I is finite;

theorem 
  V is finite-dimensional implies for A being Subset of V st A is
  linearly-independent holds A is finite;

theorem 
  V is finite-dimensional implies for A, B being Basis of V holds
  card A = card B;

theorem 
  (0).V is finite-dimensional;

theorem 
  V is finite-dimensional implies W is finite-dimensional;

registration
  let V be RealLinearSpace;
  cluster finite-dimensional strict for Subspace of V;
end;

registration
  let V be finite-dimensional RealLinearSpace;
  cluster -> finite-dimensional for Subspace of V;
end;

registration
  let V be finite-dimensional RealLinearSpace;
  cluster strict for Subspace of V;
end;

begin  

definition

  let V be RealLinearSpace;
  assume
 V is finite-dimensional;
  func dim V -> Element of NAT means


  for I being Basis of V holds it = card I;
end;

reserve V for finite-dimensional RealLinearSpace,
  W, W1, W2 for Subspace of V,
  u, v for VECTOR of V;

theorem 
  dim W <= dim V;

theorem 
  for A being Subset of V st A is linearly-independent holds card
  A = dim Lin(A);

theorem 
  dim V = dim (Omega).V;

theorem 
  dim V = dim W iff (Omega).V = (Omega).W;

theorem 
  dim V = 0 iff (Omega).V = (0).V;

theorem 
  dim V = 1 iff ex v st v <> 0.V & (Omega).V = Lin{v};

theorem 
  dim V = 2 iff ex u, v st u <> v & {u, v} is linearly-independent &
  (Omega).V = Lin{u, v};

theorem 
  dim(W1 + W2) + dim(W1 /\ W2) = dim W1 + dim W2;

theorem 
  dim(W1 /\ W2) >= dim W1 + dim W2 - dim V;

theorem 
  V is_the_direct_sum_of W1, W2 implies dim V = dim W1 + dim W2;

theorem 
  n <= dim V iff ex W being strict Subspace of V st dim W = n;

definition
  let V be finite-dimensional RealLinearSpace, n be Element of NAT;
  func n Subspaces_of V -> set means


  x in it iff ex W being strict Subspace of V st W = x & dim W = n;
end;

theorem 
  n <= dim V implies n Subspaces_of V is non empty;

theorem 
  dim V < n implies n Subspaces_of V = {};

theorem 
  n Subspaces_of W c= n Subspaces_of V;














begin  

theorem 
  for V being RealUnitarySpace, A,B being finite Subset of V, v
being VECTOR of V st v in Lin(A \/ B) & not v in Lin(B) holds ex w being VECTOR
  of V st w in A & w in Lin(A \/ B \ {w} \/ {v});

theorem 
  for V being RealUnitarySpace, A,B being finite Subset of V st the
UNITSTR of V = Lin(A) & B is linearly-independent holds card B <= card A & ex C
being finite Subset of V st C c= A & card C = card A - card B & the UNITSTR of
  V = Lin(B \/ C);

definition
  let V be RealUnitarySpace;
  attr V is finite-dimensional means


  ex A being finite Subset of V st A is Basis of V;
end;

registration
  cluster strict finite-dimensional for RealUnitarySpace;
end;

theorem 
  for V being RealUnitarySpace st V is finite-dimensional holds for
  I being Basis of V holds I is finite;

theorem 
  for V being RealUnitarySpace, A being Subset of V st V is
  finite-dimensional & A is linearly-independent holds A is finite;

theorem 
  for V being RealUnitarySpace, A,B being Basis of V st V is
  finite-dimensional holds card A = card B;

theorem 
  for V being RealUnitarySpace holds (0).V is finite-dimensional;

theorem 
  for V being RealUnitarySpace, W being Subspace of V st V is
  finite-dimensional holds W is finite-dimensional;

registration
  let V be RealUnitarySpace;
  cluster finite-dimensional strict for Subspace of V;
end;

registration
  let V be finite-dimensional RealUnitarySpace;
  cluster -> finite-dimensional for Subspace of V;
end;

registration
  let V be finite-dimensional RealUnitarySpace;
  cluster strict for Subspace of V;
end;

begin  

definition

  let V be RealUnitarySpace;
  assume
 V is finite-dimensional;
  func dim V -> Element of NAT means


  for I being Basis of V holds it = card I;
end;

theorem 
  for V being finite-dimensional RealUnitarySpace, W being Subspace
  of V holds dim W <= dim V;

theorem 
  for V being finite-dimensional RealUnitarySpace, A being Subset
  of V st A is linearly-independent holds card A = dim Lin(A);

theorem 
  for V being finite-dimensional RealUnitarySpace holds dim V = dim (Omega).V;

theorem 
  for V being finite-dimensional RealUnitarySpace, W being Subspace of V
  holds dim V = dim W iff (Omega).V = (Omega).W;

theorem 
  for V being finite-dimensional RealUnitarySpace holds dim V = 0
  iff (Omega).V = (0).V;

theorem 
  for V being finite-dimensional RealUnitarySpace holds dim V = 1 iff ex
  v being VECTOR of V st v <> 0.V & (Omega).V = Lin{v};

theorem 
  for V being finite-dimensional RealUnitarySpace holds dim V = 2 iff ex
u,v being VECTOR of V st u <> v & {u, v} is linearly-independent & (Omega).V =
  Lin{u, v};

theorem 
  for V being finite-dimensional RealUnitarySpace, W1,W2 being
  Subspace of V holds dim(W1 + W2) + dim(W1 /\ W2) = dim W1 + dim W2;

theorem 
  for V being finite-dimensional RealUnitarySpace, W1,W2 being Subspace
  of V holds dim(W1 /\ W2) >= dim W1 + dim W2 - dim V;

theorem 
  for V being finite-dimensional RealUnitarySpace, W1,W2 being Subspace
  of V st V is_the_direct_sum_of W1, W2 holds dim V = dim W1 + dim W2;

begin

theorem 
  for V being finite-dimensional RealUnitarySpace, W being Subspace of V
  , n being Element of NAT holds n <= dim V iff ex W being strict Subspace of V
  st dim W = n;

definition
  let V be finite-dimensional RealUnitarySpace, n be Element of NAT;
  func n Subspaces_of V -> set means


  for x being set holds x in it iff
  ex W being strict Subspace of V st W = x & dim W = n;
end;

theorem 
  for V being finite-dimensional RealUnitarySpace, n being Element of
  NAT st n <= dim V holds n Subspaces_of V is non empty;

theorem 
  for V being finite-dimensional RealUnitarySpace, n being Element of
  NAT st dim V < n holds n Subspaces_of V = {};

theorem 
  for V being finite-dimensional RealUnitarySpace, W being Subspace of V
  , n being Element of NAT holds n Subspaces_of W c= n Subspaces_of V;

begin  

definition
  let V be non empty RLSStruct, S be Subset of V;
  attr S is Affine means


  for x,y being VECTOR of V, a being Real st x
  in S & y in S holds (1 - a) * x + a * y in S;
end;

theorem 
  for V being non empty RLSStruct holds [#]V is Affine & {}V is Affine;

theorem 
  for V being vector-distributive scalar-distributive scalar-associative
  scalar-unital non empty RLSStruct, v being VECTOR
  of V holds {v} is Affine;

registration
  let V be non empty RLSStruct;
  cluster non empty Affine for Subset of V;
  cluster empty Affine for Subset of V;
end;

definition
  let V be RealLinearSpace, W be Subspace of V;
  func Up(W) -> non empty Subset of V equals

  the carrier of W;
end;

definition
  let V be RealUnitarySpace, W be Subspace of V;
  func Up(W) -> non empty Subset of V equals

  the carrier of W;
end;

theorem 
  for V being RealLinearSpace, W being Subspace of V holds Up(W) is
  Affine & 0.V in the carrier of W;

theorem 
  for V being RealLinearSpace, A being Affine Subset of V st 0.V
  in A holds for x being VECTOR of V, a being Real st x in A holds a * x in A;

definition
  let V be non empty RLSStruct, S be non empty Subset of V;
  attr S is Subspace-like means


  0.V in S & for x,y being Element of V,
  a being Real st x in S & y in S holds x + y in S & a * x in S;
end;

theorem 
  for V being RealLinearSpace, A being non empty Affine Subset of
  V st 0.V in A holds A is Subspace-like & A = the carrier of Lin(A);

theorem 
  for V being RealLinearSpace, W being Subspace of V holds Up(W) is
  Subspace-like;

theorem 
  for V being RealUnitarySpace, A being non empty Affine Subset of V st
  0.V in A holds A = the carrier of Lin(A);

theorem 
  for V being RealUnitarySpace, W being Subspace of V holds Up(W) is
  Subspace-like;

definition
  let V be non empty addLoopStr, M be Subset of V, v be Element of V;
  func v + M -> Subset of V equals

  {v + u where u is Element of V: u in M};
end;

theorem 
  for V being RealLinearSpace, W being strict Subspace of V, M being
  Subset of V, v being VECTOR of V st Up(W) = M holds v + W = v + M;

theorem 
  for V being Abelian add-associative vector-distributive scalar-distributive
  scalar-associative scalar-unital non
  empty RLSStruct, M being Affine Subset of V, v being VECTOR of V holds v + M
  is Affine;

theorem 
  for V being RealUnitarySpace, W being strict Subspace of V, M being
  Subset of V, v being VECTOR of V st Up(W) = M holds v + W = v + M;

definition
  let V be non empty addLoopStr, M,N be Subset of V;
  func M + N -> Subset of V equals

  {u + v where u,v is Element of V: u in M &
  v in N};
end;

definition
  let V be Abelian non empty addLoopStr, M,N be Subset of V;
  redefine func M + N;
  commutativity;
end;

theorem 
  for V being non empty addLoopStr, M being Subset of V, v being
  Element of V holds {v} + M = v + M;

theorem 
  for V being Abelian add-associative vector-distributive scalar-distributive
  scalar-associative scalar-unital non empty
  RLSStruct, M being Affine Subset of V, v being VECTOR of V holds {v} + M is
  Affine;

theorem 
  for V being non empty RLSStruct, M,N being Affine Subset of V holds M
  /\ N is Affine;

theorem 
  for V being Abelian add-associative vector-distributive scalar-distributive
  scalar-associative scalar-unital non empty
  RLSStruct, M,N being Affine Subset of V holds M + N is Affine;














begin





theorem 
  for X,Y being non empty set, f being Function of X,Y holds for A
  being Subset of X st for x1,x2 being Element of X holds x1 in A & f.x1=f.x2
  implies x2 in A holds f"(f.:A) = A;



definition
  let T,S be TopStruct;
  pred T,S are_homeomorphic means

  ex f being Function of T,S st f is being_homeomorphism;
end;



definition
  let T,S be TopStruct;
  let f be Function of T,S;
  attr f is open means


  for A being Subset of T st A is open holds f.:A is open;
end;





definition
  let T be non empty TopStruct;
  func Indiscernibility(T) -> Equivalence_Relation of the carrier of T means


   for
 p,q being Point of T holds [p,q] in it iff for A being Subset of T st
  A is open holds p in A iff q in A;
end;





definition
  let T be non empty TopStruct;
  func Indiscernible(T) -> non empty a_partition of the carrier of T equals

  Class Indiscernibility(T);
end;





definition
  let T be non empty TopSpace;
  func T_0-reflex(T) -> TopSpace equals

  space Indiscernible(T);
end;

registration
  let T be non empty TopSpace;
  cluster T_0-reflex(T) -> non empty;
end;





definition
  let T be non empty TopSpace;
  func T_0-canonical_map T -> continuous Function of T,T_0-reflex T equals

  Proj Indiscernible T;
end;

theorem 
  for T being non empty TopSpace, V being Subset of T_0-reflex(T)
  holds V is open iff union V in the topology of T;

theorem 
  for T being non empty TopSpace, C being set holds C is Point of
  T_0-reflex(T) iff ex p being Point of T st C = Class(Indiscernibility(T),p);

theorem 
  for T being non empty TopSpace, p being Point of T holds (
  T_0-canonical_map(T)).p = Class(Indiscernibility(T),p);

theorem 
  for T being non empty TopSpace, p,q being Point of T holds (
  T_0-canonical_map(T)).q = (T_0-canonical_map(T)).p iff [q,p] in
  Indiscernibility(T);

theorem 
  for T being non empty TopSpace, A being Subset of T st A is open
  holds for p,q being Point of T holds p in A & (T_0-canonical_map(T)).p = (
  T_0-canonical_map(T)).q implies q in A;

theorem 
  for T being non empty TopSpace, A being Subset of T st A is open
  for C being Subset of T st C in Indiscernible(T) & C meets A holds C c= A;

theorem 
  for T being non empty TopSpace holds T_0-canonical_map(T) is open;





definition
  let T be TopStruct;
  redefine attr T is T_0 means


  T is empty or for x,y being Point of T
st x <> y holds ex V being Subset of T st V is open & ( x in V & not y in V or
  y in V & not x in V );
end;

registration
  cluster T_0 non empty for TopSpace;
end;





definition
  mode T_0-TopSpace is T_0 non empty TopSpace;
end;

theorem 
  for T being non empty TopSpace holds T_0-reflex(T) is T_0-TopSpace;





theorem 
  for T,S being non empty TopSpace st ex h being Function of T_0-reflex(
  S),T_0-reflex(T) st h is being_homeomorphism & T_0-canonical_map(T),h*
  T_0-canonical_map(S) are_fiberwise_equipotent holds T,S are_homeomorphic;





theorem 
  for T being non empty TopSpace, T0 being T_0-TopSpace, f being
  continuous Function of T,T0 holds for p,q being Point of T holds [p,q] in
  Indiscernibility(T) implies f.p = f.q;

theorem 
  for T being non empty TopSpace, T0 being T_0-TopSpace, f being
  continuous Function of T,T0 holds for p being Point of T holds f.:Class(
  Indiscernibility(T),p) = {f.p};





theorem 
  for T being non empty TopSpace, T0 being T_0-TopSpace, f being
continuous Function of T,T0 ex h being continuous Function of T_0-reflex(T),T0
  st f = h*T_0-canonical_map(T);














begin

definition
  let X be set;
  let A be Subset-Family of X;
  func UniCl(A) -> Subset-Family of X means


  for x being Subset of X
  holds x in it iff ex Y being Subset-Family of X st Y c=A & x = union Y;
end;

definition
  let X be TopStruct, F be Subset-Family of X;
  attr F is quasi_basis means


  the topology of X c= UniCl F;
end;

registration
  let X be TopStruct;
  cluster the topology of X -> quasi_basis;
end;

registration
  let X be TopStruct;
  cluster open quasi_basis for Subset-Family of X;
end;

definition
  let X be TopStruct;
  mode Basis of X is open quasi_basis Subset-Family of X;
end;

theorem 
  for X being set for A being Subset-Family of X holds A c= UniCl A;

theorem 
  for S being TopStruct holds the topology of S is Basis of S;

theorem 
  for S being TopStruct holds the topology of S is open;

definition
  let X be set;
  let A be Subset-Family of X;

  func FinMeetCl(A) -> Subset-Family of X means


  for x being Subset of X holds x in it iff
  ex Y being Subset-Family of X st Y c= A & Y is finite & x = Intersect Y;
end;

theorem 
  for X being set for A being Subset-Family of X holds A c= FinMeetCl A;

theorem 
  for T being non empty TopSpace holds the topology of T =
  FinMeetCl the topology of T;

theorem 
  for T being TopSpace holds the topology of T = UniCl the topology of T;

theorem 
  for T being non empty TopSpace holds the topology of T = UniCl
  FinMeetCl the topology of T;

theorem 
  for X being set, A being Subset-Family of X holds X in FinMeetCl A;

theorem 
  for X being set for A, B being Subset-Family of X holds A c= B
  implies UniCl A c= UniCl B;

theorem 
  for X being set for R being non empty Subset-Family of bool X, F
  being Subset-Family of X st F = { Intersect x where x is Element of R: not
  contradiction} holds Intersect F = Intersect union R;

theorem 
  for X be set, A be Subset-Family of X holds FinMeetCl A =
  FinMeetCl FinMeetCl A;

theorem 
  for X being set, A being Subset-Family of X, a, b being set st a in
  FinMeetCl A & b in FinMeetCl A holds a /\ b in FinMeetCl A;

theorem 
  for X being set, A being Subset-Family of X, a, b being set st a
  c= FinMeetCl A & b c= FinMeetCl A holds INTERSECTION(a,b) c= FinMeetCl A;

theorem 
  for X being set, A,B being Subset-Family of X holds A c= B
  implies FinMeetCl A c= FinMeetCl B;

registration
  let X be set;
  let A be Subset-Family of X;
  cluster FinMeetCl(A) -> non empty;
end;

theorem 
  for X be non empty set, A be Subset-Family of X holds TopStruct
  (#X,UniCl FinMeetCl A#) is TopSpace-like;

definition
  let X be TopStruct, F be Subset-Family of X;
  attr F is quasi_prebasis means


  ex G being Basis of X st G c= FinMeetCl F;
end;

registration
  let X be TopStruct;
  cluster the topology of X -> quasi_prebasis;
  cluster -> quasi_prebasis for Basis of X;
  cluster open quasi_prebasis for Subset-Family of X;
end;

definition
  let X be TopStruct;
  mode prebasis of X is open quasi_prebasis Subset-Family of X;
end;

theorem 
  for X being non empty set, Y being Subset-Family of X holds
  Y is Basis of TopStruct (#X, UniCl Y#);

theorem 
  for T1, T2 being strict non empty TopSpace, P being prebasis of
T1 st the carrier of T1 = the carrier of T2 & P is prebasis of T2 holds T1 = T2
;

theorem 
  for X being non empty set, Y being Subset-Family of X holds
  Y is prebasis of TopStruct (#X, UniCl FinMeetCl Y#);

definition
  func the_Cantor_set -> strict non empty TopSpace means

  the carrier of it = product (NAT-->{0,1}) &
  ex P being prebasis of it st for X being Subset of product (NAT-->{0,1})
  holds X in P iff ex N,n being Nat st
  for F being Element of product (NAT-->{0,1}) holds F in X iff F.N=n;
end;
 















begin



reserve X for TopSpace;

theorem 
  for X being TopStruct, X0 being SubSpace of X holds the carrier
  of X0 is Subset of X;

theorem 
  for X being TopStruct holds X is SubSpace of X;

theorem 
  for X being strict TopStruct holds X|[#]X = X;

theorem 
  for X1, X2 being SubSpace of X holds the carrier of X1 c= the
  carrier of X2 iff X1 is SubSpace of X2;

theorem 
  for X being TopStruct for X1, X2 being SubSpace of X st the
carrier of X1 = the carrier of X2 holds the TopStruct of X1 = the TopStruct of
  X2;

theorem 
  for X1, X2 being SubSpace of X st X1 is SubSpace of X2 & X2 is
  SubSpace of X1 holds the TopStruct of X1 = the TopStruct of X2;

theorem 
  for X1 being SubSpace of X for X2 being SubSpace of X1 holds X2
  is SubSpace of X;

theorem 
  for X0 being SubSpace of X, C, A being Subset of X, B being
  Subset of X0 st C is closed & C c= the carrier of X0 & A c= C & A = B holds B
  is closed iff A is closed;

theorem 
  for X0 being SubSpace of X, C, A being Subset of X, B being
Subset of X0 st C is open & C c= the carrier of X0 & A c= C & A = B holds B is
  open iff A is open;

theorem 
  for X being non empty TopStruct, A0 being non empty Subset of X
  ex X0 being strict non empty SubSpace of X st A0 = the carrier of X0;



theorem 
  for X0 being SubSpace of X, A being Subset of X st A = the
  carrier of X0 holds X0 is closed SubSpace of X iff A is closed;

theorem 
  for X0 being closed SubSpace of X, A being Subset of X, B being Subset
  of X0 st A = B holds B is closed iff A is closed;

theorem 
  for X1 being closed SubSpace of X, X2 being closed SubSpace of X1
  holds X2 is closed SubSpace of X;

theorem 
  for X being non empty TopSpace, X1 being closed non empty SubSpace of
  X, X2 being non empty SubSpace of X st the carrier of X1 c= the carrier of X2
  holds X1 is closed non empty SubSpace of X2;

theorem 
  for X be non empty TopSpace, A0 being non empty Subset of X st
  A0 is closed ex X0 being strict closed non empty SubSpace of X st A0 = the
  carrier of X0;

definition
  let X be TopStruct;
  let IT be SubSpace of X;
  attr IT is open means


  for A being Subset of X st A = the carrier of IT holds A is open;
end;

registration
  let X be TopSpace;
  cluster strict open for SubSpace of X;
end;

registration
  let X be non empty TopSpace;
  cluster strict open non empty for SubSpace of X;
end;



theorem 
  for X0 being SubSpace of X, A being Subset of X st A = the
  carrier of X0 holds X0 is open SubSpace of X iff A is open;

theorem 
  for X0 being open SubSpace of X, A being Subset of X, B being Subset
  of X0 st A = B holds B is open iff A is open;

theorem 
  for X1 being open SubSpace of X, X2 being open SubSpace of X1 holds X2
  is open SubSpace of X;

theorem 
  for X be non empty TopSpace, X1 being open SubSpace of X, X2 being non
empty SubSpace of X st the carrier of X1 c= the carrier of X2 holds X1 is open
  SubSpace of X2;

theorem 
  for X be non empty TopSpace, A0 being non empty Subset of X st
A0 is open ex X0 being strict open non empty SubSpace of X st A0 = the carrier
  of X0;

begin



reserve X for non empty TopSpace;

definition
  let X be non empty TopStruct;
  let X1, X2 be non empty SubSpace of X;
  func X1 union X2 -> strict non empty SubSpace of X means


  the carrier of it = (the carrier of X1) \/ (the carrier of X2);
  commutativity;
end;

reserve X1, X2, X3 for non empty SubSpace of X;



theorem 
  (X1 union X2) union X3 = X1 union (X2 union X3);

theorem 
  X1 is SubSpace of X1 union X2;

theorem 
  for X1,X2 being non empty SubSpace of X holds X1 is SubSpace of X2 iff
  X1 union X2 = the TopStruct of X2;

theorem 
  for X1, X2 being closed non empty SubSpace of X holds X1 union X2 is
  closed SubSpace of X;

theorem 
  for X1, X2 being open non empty SubSpace of X holds X1 union X2 is
  open SubSpace of X;

definition
  let X1, X2 be 1-sorted;
  pred X1 misses X2 means


  the carrier of X1 misses the carrier of X2;
  symmetry;
end;

notation
  let X1, X2 be 1-sorted;
  antonym X1 meets X2 for X1 misses X2;
end;

definition
  let X be non empty TopStruct;
  let X1, X2 be non empty SubSpace of X;
  assume
 X1 meets X2;

  func X1 meet X2 -> strict non empty SubSpace of X means


  the carrier of it = (the carrier of X1) /\ (the carrier of X2);
end;

reserve X1, X2, X3 for non empty SubSpace of X;



theorem 
  (X1 meets X2 implies X1 meet X2 = X2 meet X1) & ((X1 meets X2 &
(X1 meet X2) meets X3 or X2 meets X3 & X1 meets (X2 meet X3)) implies (X1 meet
  X2) meet X3 = X1 meet (X2 meet X3));

theorem 
  X1 meets X2 implies X1 meet X2 is SubSpace of X1 & X1 meet X2 is
  SubSpace of X2;

theorem 
  for X1,X2 being non empty SubSpace of X holds X1 meets X2 implies (X1
is SubSpace of X2 iff X1 meet X2 = the TopStruct of X1) & (X2 is SubSpace of X1
  iff X1 meet X2 = the TopStruct of X2);

theorem 
  for X1, X2 being closed non empty SubSpace of X st X1 meets X2 holds
  X1 meet X2 is closed SubSpace of X;

theorem 
  for X1, X2 being open non empty SubSpace of X st X1 meets X2 holds X1
  meet X2 is open SubSpace of X;



theorem 
  X1 meets X2 implies X1 meet X2 is SubSpace of X1 union X2;

theorem 
  for Y being non empty SubSpace of X st X1 meets Y & Y meets X2 holds (
X1 union X2) meet Y = (X1 meet Y) union (X2 meet Y) & Y meet (X1 union X2) = (Y
  meet X1) union (Y meet X2);

theorem 
  for Y being non empty SubSpace of X holds X1 meets X2 implies (X1 meet
X2) union Y = (X1 union Y) meet (X2 union Y) & Y union (X1 meet X2) = (Y union
  X1) meet (Y union X2);

begin



notation
  let X be TopStruct, A1, A2 be Subset of X;
  antonym A1,A2 are_not_separated for A1,A2 are_separated;
end;

reserve X for TopSpace;
reserve A1, A2 for Subset of X;



theorem 
  A1 is closed & A2 is closed implies (A1 misses A2 iff A1,A2 are_separated);

theorem 
  A1 \/ A2 is closed & A1,A2 are_separated implies A1 is closed & A2 is closed;

theorem 
  A1 misses A2 & A1 is open implies A1 misses Cl A2;

theorem 
  A1 is open & A2 is open implies (A1 misses A2 iff A1,A2 are_separated);

theorem 
  A1 \/ A2 is open & A1,A2 are_separated implies A1 is open & A2 is open;



reserve A1,A2 for Subset of X;

theorem 
  for C being Subset of X holds A1,A2 are_separated implies A1 /\
  C,A2 /\ C are_separated;

theorem 
  for B being Subset of X holds A1,B are_separated or A2,B
  are_separated implies A1 /\ A2,B are_separated;

theorem 
  for B being Subset of X holds A1,B are_separated & A2,B
  are_separated iff A1 \/ A2,B are_separated;

theorem 
  A1,A2 are_separated iff ex C1, C2 being Subset of X st A1 c= C1
  & A2 c= C2 & C1 misses A2 & C2 misses A1 & C1 is closed & C2 is closed;



theorem 
  A1,A2 are_separated iff ex C1, C2 being Subset of X st A1 c= C1
  & A2 c= C2 & C1 /\ C2 misses A1 \/ A2 & C1 is closed & C2 is closed;

theorem 
  A1,A2 are_separated iff ex C1, C2 being Subset of X st A1 c= C1
  & A2 c= C2 & C1 misses A2 & C2 misses A1 & C1 is open & C2 is open;



theorem 
  A1,A2 are_separated iff ex C1, C2 being Subset of X st A1 c= C1
  & A2 c= C2 & C1 /\ C2 misses A1 \/ A2 & C1 is open & C2 is open;

definition
  let X be TopStruct, A1, A2 be Subset of X;

  pred A1,A2 are_weakly_separated means


  A1 \ A2,A2 \ A1 are_separated;
  symmetry;
end;

notation
  let X be TopStruct, A1, A2 be Subset of X;
  antonym A1,A2 are_not_weakly_separated for A1,A2 are_weakly_separated;
end;

reserve X for TopSpace,
  A1, A2 for Subset of X;



theorem 
  A1 misses A2 & A1,A2 are_weakly_separated iff A1,A2 are_separated;

theorem 
  A1 c= A2 implies A1,A2 are_weakly_separated;

theorem 
  for A1,A2 being Subset of X holds A1 is closed & A2 is closed
  implies A1,A2 are_weakly_separated;

theorem 
  for A1,A2 being Subset of X holds A1 is open & A2 is open
  implies A1,A2 are_weakly_separated;



theorem 
  for C being Subset of X holds A1,A2 are_weakly_separated implies
  A1 \/ C,A2 \/ C are_weakly_separated;

theorem 
  for B1, B2 being Subset of X st B1 c= A2 & B2 c= A1 holds A1,A2
  are_weakly_separated implies A1 \/ B1,A2 \/ B2 are_weakly_separated;

theorem 
  for B being Subset of X holds A1,B are_weakly_separated & A2,B
  are_weakly_separated implies A1 /\ A2,B are_weakly_separated;

theorem 
  for B being Subset of X holds A1,B are_weakly_separated & A2,B
  are_weakly_separated implies A1 \/ A2,B are_weakly_separated;



theorem 
  A1,A2 are_weakly_separated iff ex C1, C2, C being Subset of X st
C1 /\ (A1 \/ A2) c= A1 & C2 /\ (A1 \/ A2) c= A2 & C /\ (A1 \/ A2) c= A1 /\ A2 &
  the carrier of X = (C1 \/ C2) \/ C & C1 is closed & C2 is closed & C is open;

reserve X for non empty TopSpace,
  A1, A2 for Subset of X;

theorem 
  A1,A2 are_weakly_separated & not A1 c= A2 & not A2 c= A1 implies
ex C1, C2 being non empty Subset of X st C1 is closed & C2 is closed & C1 /\ (
A1 \/ A2) c= A1 & C2 /\ (A1 \/ A2) c= A2 & (A1 \/ A2 c= C1 \/ C2 or ex C being
non empty Subset of X st C is open & C /\ (A1 \/ A2) c= A1 /\ A2 & the carrier
  of X = (C1 \/ C2) \/ C);

theorem 
  A1 \/ A2 = the carrier of X implies (A1,A2 are_weakly_separated
  iff ex C1, C2, C being Subset of X st A1 \/ A2 = (C1 \/ C2) \/ C & C1 c= A1 &
  C2 c= A2 & C c= A1 /\ A2 & C1 is closed & C2 is closed & C is open);

theorem 
  A1 \/ A2 = the carrier of X & A1,A2 are_weakly_separated & not
A1 c= A2 & not A2 c= A1 implies ex C1, C2 being non empty Subset of X st C1 is
  closed & C2 is closed & C1 c= A1 & C2 c= A2 & (A1 \/ A2 = C1 \/ C2 or ex C
  being non empty Subset of X st A1 \/ A2 = (C1 \/ C2) \/ C & C c= A1 /\ A2 & C
  is open);



theorem 
  A1,A2 are_weakly_separated iff ex C1, C2, C being Subset of X st
C1 /\ (A1 \/ A2) c= A1 & C2 /\ (A1 \/ A2) c= A2 & C /\ (A1 \/ A2) c= A1 /\ A2 &
  the carrier of X = (C1 \/ C2) \/ C & C1 is open & C2 is open & C is closed;

theorem 
  A1,A2 are_weakly_separated & not A1 c= A2 & not A2 c= A1 implies
ex C1, C2 being non empty Subset of X st C1 is open & C2 is open & C1 /\ (A1 \/
  A2) c= A1 & C2 /\ (A1 \/ A2) c= A2 & (A1 \/ A2 c= C1 \/ C2 or ex C being non
empty Subset of X st C is closed & C /\ (A1 \/ A2) c= A1 /\ A2 & the carrier of
  X = (C1 \/ C2) \/ C);

theorem 
  A1 \/ A2 = the carrier of X implies (A1,A2 are_weakly_separated
  iff ex C1, C2, C being Subset of X st A1 \/ A2 = (C1 \/ C2) \/ C & C1 c= A1 &
  C2 c= A2 & C c= A1 /\ A2 & C1 is open & C2 is open & C is closed);

theorem 
  A1 \/ A2 = the carrier of X & A1,A2 are_weakly_separated & not
A1 c= A2 & not A2 c= A1 implies ex C1, C2 being non empty Subset of X st C1 is
  open & C2 is open & C1 c= A1 & C2 c= A2 & (A1 \/ A2 = C1 \/ C2 or ex C being
  non empty Subset of X st A1 \/ A2 = (C1 \/ C2) \/ C & C c= A1 /\ A2 & C is
  closed);



theorem 
  A1,A2 are_separated iff ex B1, B2 being Subset of X st B1,B2
  are_weakly_separated & A1 c= B1 & A2 c= B2 & B1 /\ B2 misses A1 \/ A2;

begin



reserve X for non empty TopSpace;

definition
  let X be TopStruct;
  let X1, X2 be SubSpace of X;
  pred X1,X2 are_separated means


  for A1, A2 being Subset of X st A1 =
  the carrier of X1 & A2 = the carrier of X2 holds A1,A2 are_separated;
  symmetry;
end;

notation
  let X be TopStruct;
  let X1, X2 be SubSpace of X;
  antonym X1,X2 are_not_separated for X1,X2 are_separated;
end;

reserve X1, X2 for non empty SubSpace of X;



theorem 
  X1,X2 are_separated implies X1 misses X2;

theorem 
  for X1, X2 being closed non empty SubSpace of X holds X1 misses X2 iff
  X1,X2 are_separated;

theorem 
  X = X1 union X2 & X1,X2 are_separated implies X1 is closed SubSpace of X;

theorem 
  X1 union X2 is closed SubSpace of X & X1,X2 are_separated implies X1
  is closed SubSpace of X;

theorem 
  for X1, X2 being open non empty SubSpace of X holds X1 misses X2 iff
  X1,X2 are_separated;

theorem 
  X = X1 union X2 & X1,X2 are_separated implies X1 is open SubSpace of X;

theorem 
  X1 union X2 is open SubSpace of X & X1,X2 are_separated implies X1 is
  open SubSpace of X;



theorem 
  for Y, X1, X2 being non empty SubSpace of X st X1 meets Y & X2 meets Y
holds X1,X2 are_separated implies X1 meet Y,X2 meet Y are_separated & Y meet X1
  ,Y meet X2 are_separated;

theorem 
  for Y1, Y2 being SubSpace of X st Y1 is SubSpace of X1 & Y2 is
  SubSpace of X2 holds X1,X2 are_separated implies Y1,Y2 are_separated;

theorem 
  for Y being non empty SubSpace of X st X1 meets X2 holds X1,Y
  are_separated implies X1 meet X2,Y are_separated;

theorem 
  for Y being non empty SubSpace of X holds X1,Y are_separated & X2,Y
  are_separated iff X1 union X2,Y are_separated;

theorem 
  X1,X2 are_separated iff ex Y1, Y2 being closed non empty SubSpace of X
  st X1 is SubSpace of Y1 & X2 is SubSpace of Y2 & Y1 misses X2 & Y2 misses X1;



theorem 
  X1,X2 are_separated iff ex Y1, Y2 being closed non empty SubSpace of X
  st X1 is SubSpace of Y1 & X2 is SubSpace of Y2 & (Y1 misses Y2 or Y1 meet Y2
  misses X1 union X2);

theorem 
  X1,X2 are_separated iff ex Y1, Y2 being open non empty SubSpace of X
  st X1 is SubSpace of Y1 & X2 is SubSpace of Y2 & Y1 misses X2 & Y2 misses X1;



theorem 
  X1,X2 are_separated iff ex Y1, Y2 being open non empty SubSpace
of X st X1 is SubSpace of Y1 & X2 is SubSpace of Y2 & (Y1 misses Y2 or Y1 meet
  Y2 misses X1 union X2);

definition
  let X be TopStruct, X1, X2 be SubSpace of X;
  pred X1,X2 are_weakly_separated means


  for A1, A2 being Subset of X st
  A1 = the carrier of X1 & A2 = the carrier of X2 holds A1,A2
  are_weakly_separated;
  symmetry;
end;

notation
  let X be TopStruct, X1, X2 be SubSpace of X;
  antonym X1,X2 are_not_weakly_separated for X1,X2 are_weakly_separated;
end;

reserve X1, X2 for non empty SubSpace of X;



theorem 
  X1 misses X2 & X1,X2 are_weakly_separated iff X1,X2 are_separated;

theorem 
  X1 is SubSpace of X2 implies X1,X2 are_weakly_separated;

theorem 
  for X1, X2 being closed SubSpace of X holds X1,X2 are_weakly_separated;

theorem 
  for X1, X2 being open SubSpace of X holds X1,X2 are_weakly_separated;



theorem 
  for Y being non empty SubSpace of X holds X1,X2 are_weakly_separated
  implies X1 union Y,X2 union Y are_weakly_separated;

theorem 
  for Y1, Y2 being non empty SubSpace of X st Y1 is SubSpace of X2 & Y2
is SubSpace of X1 holds X1,X2 are_weakly_separated implies X1 union Y1,X2 union
  Y2 are_weakly_separated & Y1 union X1,Y2 union X2 are_weakly_separated;

theorem 
  for Y, X1, X2 being non empty SubSpace of X st X1 meets X2 holds (X1,Y
  are_weakly_separated & X2,Y are_weakly_separated implies X1 meet X2,Y
are_weakly_separated) & (Y,X1 are_weakly_separated & Y,X2 are_weakly_separated
  implies Y,X1 meet X2 are_weakly_separated);

theorem 
  for Y being non empty SubSpace of X holds (X1,Y are_weakly_separated &
  X2,Y are_weakly_separated implies X1 union X2,Y are_weakly_separated) & (Y,X1
  are_weakly_separated & Y,X2 are_weakly_separated implies Y,X1 union X2
  are_weakly_separated);



theorem 
  for X being non empty TopSpace, X1,X2 being non empty SubSpace of X
holds X1 meets X2 implies (X1,X2 are_weakly_separated iff (X1 is SubSpace of X2
or X2 is SubSpace of X1 or ex Y1, Y2 being closed non empty SubSpace of X st Y1
meet (X1 union X2) is SubSpace of X1 & Y2 meet (X1 union X2) is SubSpace of X2
& (X1 union X2 is SubSpace of Y1 union Y2 or ex Y being open non empty SubSpace
  of X st the TopStruct of X = (Y1 union Y2) union Y & Y meet (X1 union X2) is
  SubSpace of X1 meet X2)));

theorem 
  X = X1 union X2 & X1 meets X2 implies (X1,X2 are_weakly_separated iff
  (X1 is SubSpace of X2 or X2 is SubSpace of X1 or ex Y1, Y2 being closed non
  empty SubSpace of X st Y1 is SubSpace of X1 & Y2 is SubSpace of X2 & (X = Y1
union Y2 or ex Y being open non empty SubSpace of X st X = (Y1 union Y2) union
  Y & Y is SubSpace of X1 meet X2)));

theorem 
  X = X1 union X2 & X1 misses X2 implies (X1,X2 are_weakly_separated iff
  X1 is closed SubSpace of X & X2 is closed SubSpace of X);



theorem 
  for X being non empty TopSpace, X1,X2 being non empty SubSpace of X
holds X1 meets X2 implies (X1,X2 are_weakly_separated iff (X1 is SubSpace of X2
  or X2 is SubSpace of X1 or ex Y1, Y2 being open non empty SubSpace of X st Y1
meet (X1 union X2) is SubSpace of X1 & Y2 meet (X1 union X2) is SubSpace of X2
  & (X1 union X2 is SubSpace of Y1 union Y2 or ex Y being closed non empty
SubSpace of X st the TopStruct of X = (Y1 union Y2) union Y & Y meet (X1 union
  X2) is SubSpace of X1 meet X2)));

theorem 
  X = X1 union X2 & X1 meets X2 implies (X1,X2 are_weakly_separated iff
(X1 is SubSpace of X2 or X2 is SubSpace of X1 or ex Y1, Y2 being open non empty
SubSpace of X st Y1 is SubSpace of X1 & Y2 is SubSpace of X2 & (X = Y1 union Y2
  or ex Y being closed non empty SubSpace of X st X = (Y1 union Y2) union Y & Y
  is SubSpace of X1 meet X2)));

theorem 
  X = X1 union X2 & X1 misses X2 implies (X1,X2 are_weakly_separated iff
  X1 is open SubSpace of X & X2 is open SubSpace of X);



theorem 
  X1,X2 are_separated iff ex Y1, Y2 being non empty SubSpace of X st Y1,
  Y2 are_weakly_separated & X1 is SubSpace of Y1 & X2 is SubSpace of Y2 & (Y1
  misses Y2 or Y1 meet Y2 misses X1 union X2);

theorem 
  for T being TopStruct holds T|[#]T = the TopStruct of T;














begin



reserve T for 1-sorted;

theorem 
  for A,B being Subset of T holds A \/ B = [#] T iff A` c= B;

theorem 
  for A,B being Subset of T holds A misses B iff B c= A`;

reserve T for TopSpace;

theorem 
  for A being Subset of T holds Cl Int Cl A c= Cl A;

theorem 
  for A being Subset of T holds Int A c= Int Cl Int A;

theorem 
  for A being Subset of T holds Int Cl A = Int Cl Int Cl A;

theorem 
  for A,B being Subset of T st A is closed or B is closed holds Cl
  Int A \/ Cl Int B = Cl Int(A \/ B);

theorem 
  for A,B being Subset of T st A is open or B is open holds Int Cl
  A /\ Int Cl B = Int Cl(A /\ B);

theorem 
  for A being Subset of T holds Int(A /\ Cl A`) = {} T;

theorem 
  for A being Subset of T holds Cl(A \/ Int A`) = [#] T;

theorem 
  for A,B being Subset of T holds Int(Cl(A \/ (Int(Cl B) \/ B)))
  \/ (A \/ (Int(Cl B) \/ B)) = Int Cl(A \/ B) \/ (A \/ B);

theorem 
  for A,C being Subset of T holds Int(Cl((Int(Cl A) \/ A) \/ C)) \/ ((
  Int(Cl A) \/ A) \/ C) = Int Cl(A \/ C) \/ (A \/ C);

theorem 
  for A,B being Subset of T holds Cl(Int(A /\ (Cl(Int B) /\ B)))
  /\ (A /\ (Cl(Int B) /\ B)) = Cl Int(A /\ B) /\ (A /\ B);

theorem 
  for A,C being Subset of T holds Cl(Int((Cl(Int A) /\ A) /\ C)) /\ ((Cl
  (Int A) /\ A) /\ C) = Cl Int(A /\ C) /\ (A /\ C);

begin



theorem 
  {}T is condensed;

theorem 
  [#] T is condensed;

theorem 
  for A being Subset of T st A is condensed holds A` is condensed;

theorem 
  for A,B being Subset of T st A is condensed & B is condensed
holds Int(Cl(A \/ B)) \/ (A \/ B) is condensed & Cl(Int(A /\ B)) /\ (A /\ B) is
  condensed;

theorem 
  {} T is closed_condensed;

theorem 
  [#] T is closed_condensed;

theorem 
  {} T is open_condensed;

theorem 
  [#] T is open_condensed;

theorem 
  for A being Subset of T holds Cl(Int A) is closed_condensed;

theorem 
  for A being Subset of T holds Int(Cl A) is open_condensed;

theorem 
  for A being Subset of T st A is condensed holds Cl A is closed_condensed;

theorem 
  for A being Subset of T st A is condensed holds Int A is open_condensed;

theorem 
  for A being Subset of T st A is condensed holds Cl A` is
  closed_condensed;

theorem 
  for A being Subset of T st A is condensed holds Int A` is
  open_condensed;

theorem 
  for A,B,C being Subset of T st A is closed_condensed & B is
closed_condensed & C is closed_condensed holds Cl(Int(A /\ (Cl(Int(B /\ C)))))
  = Cl(Int((Cl(Int(A /\ B)) /\ C)));

theorem 
  for A,B,C being Subset of T st A is open_condensed & B is
  open_condensed & C is open_condensed holds Int(Cl(A \/ (Int(Cl(B \/ C))))) =
  Int(Cl((Int(Cl(A \/ B)) \/ C)));

begin



definition
  let T be TopStruct;
  func Domains_of T -> Subset-Family of T equals

  { A where A is Subset of T :
  A is condensed };
end;

registration
  let T be TopSpace;
  cluster Domains_of T -> non empty;
end;

definition
  let T be TopSpace;
  func Domains_Union T -> BinOp of Domains_of T means


  for A,B being
  Element of Domains_of T holds it.(A,B) = Int(Cl(A \/ B)) \/ (A \/ B);
end;

notation
  let T be TopSpace;
  synonym D-Union T for Domains_Union T;
end;

definition
  let T be TopSpace;
  func Domains_Meet T -> BinOp of Domains_of T means


  for A,B being
  Element of Domains_of T holds it.(A,B) = Cl(Int(A /\ B)) /\ (A /\ B);
end;

notation
  let T be TopSpace;
  synonym D-Meet T for Domains_Meet T;
end;

theorem 
  for T being TopSpace holds LattStr(#Domains_of T,D-Union T,
    D-Meet T#) is C_Lattice;

definition
  let T be TopSpace;
  func Domains_Lattice T -> C_Lattice equals

  LattStr(#Domains_of T,
    Domains_Union T,Domains_Meet T#);
end;

begin



definition
  let T be TopStruct;
  func Closed_Domains_of T -> Subset-Family of T equals

  { A where A is Subset
  of T : A is closed_condensed };
end;

registration
  let T be TopSpace;
  cluster Closed_Domains_of T -> non empty;
end;

theorem 
  for T being TopSpace holds Closed_Domains_of T c= Domains_of T;

definition
  let T be TopSpace;
  func Closed_Domains_Union T -> BinOp of Closed_Domains_of T means


  for A,B being Element of Closed_Domains_of T holds it.(A,B) = A \/ B;
end;

notation
  let T be TopSpace;
  synonym CLD-Union T for Closed_Domains_Union T;
end;

theorem 
  for A,B being Element of Closed_Domains_of T holds (CLD-Union T)
  .(A,B) = (D-Union T).(A,B);

definition
  let T be TopSpace;
  func Closed_Domains_Meet T -> BinOp of Closed_Domains_of T means


  for
  A,B being Element of Closed_Domains_of T holds it.(A,B) = Cl(Int(A /\ B));
end;

notation
  let T be TopSpace;
  synonym CLD-Meet T for Closed_Domains_Meet T;
end;

theorem 
  for A,B being Element of Closed_Domains_of T holds (CLD-Meet T).
  (A,B) = (D-Meet T).(A,B);

theorem 
  for T being TopSpace holds LattStr(#Closed_Domains_of T,
    CLD-Union T,CLD-Meet T#) is B_Lattice;

definition
  let T be TopSpace;
  func Closed_Domains_Lattice T-> B_Lattice equals

  LattStr(#Closed_Domains_of
    T,Closed_Domains_Union T,Closed_Domains_Meet T #);
end;

begin



definition
  let T be TopStruct;
  func Open_Domains_of T -> Subset-Family of T equals

  { A where A is Subset of
T: A is open_condensed };
end;

registration
  let T be TopSpace;
  cluster Open_Domains_of T -> non empty;
end;

theorem 
  for T being TopSpace holds Open_Domains_of T c= Domains_of T;

definition
  let T be TopSpace;
  func Open_Domains_Union T -> BinOp of Open_Domains_of T means


  for A, B being Element of Open_Domains_of T holds it.(A,B) = Int(Cl(A \/ B));
end;

notation
  let T be TopSpace;
  synonym OPD-Union T for Open_Domains_Union T;
end;

theorem 
  for A,B being Element of Open_Domains_of T holds (OPD-Union T).(
  A,B) = (D-Union T).(A,B);

definition
  let T be TopSpace;
  func Open_Domains_Meet T -> BinOp of Open_Domains_of T means


  for A,B being Element of Open_Domains_of T holds it.(A,B) = A /\ B;
end;

notation
  let T be TopSpace;
  synonym OPD-Meet T for Open_Domains_Meet T;
end;

theorem 
  for A,B being Element of Open_Domains_of T holds (OPD-Meet T).(A
  ,B) = (D-Meet T).(A,B);

theorem 
  for T being TopSpace holds LattStr(#Open_Domains_of T,OPD-Union
    T,OPD-Meet T#) is B_Lattice;

definition
  let T be TopSpace;
  func Open_Domains_Lattice T-> B_Lattice equals

  LattStr(#Open_Domains_of T,
    Open_Domains_Union T,Open_Domains_Meet T#);
end;

begin



theorem 
  CLD-Union T = (D-Union T)||Closed_Domains_of T;

theorem 
  CLD-Meet T = (D-Meet T)||Closed_Domains_of T;

theorem 
  Closed_Domains_Lattice T is SubLattice of Domains_Lattice T;

theorem 
  OPD-Union T = (D-Union T)||Open_Domains_of T;

theorem 
  OPD-Meet T = (D-Meet T)||Open_Domains_of T;

theorem 
  Open_Domains_Lattice T is SubLattice of Domains_Lattice T;














begin

definition
  let X be set;
  func BooleLatt X -> strict LattStr means


  the carrier of it = bool X & for Y,Z being Subset of X holds
  (the L_join of it).(Y,Z) = Y \/ Z & (the L_meet of it).(Y,Z) = Y /\ Z;
end;

reserve X for set,
  x,y,z for Element of BooleLatt X,
  s for set;

registration
  let X be set;
  cluster BooleLatt X -> non empty;
end;

registration
  let X;
  let x,y;
  let x9,y9 be set;
  identify x "\/" y with x9 \/ y9 when x = x9, y = y9;
  identify x "/\" y with x9 /\ y9 when x = x9, y = y9;
end;

theorem 
  x "\/" y = x \/ y & x "/\" y = x /\ y;

theorem 
  x [= y iff x c= y;

registration
  let X;
  cluster BooleLatt X -> Lattice-like;
end;

reserve y for Element of BooleLatt X;

theorem 
  BooleLatt X is lower-bounded & Bottom BooleLatt X = {};

theorem 
  BooleLatt X is upper-bounded & Top BooleLatt X = X;

registration
  let X;
  cluster BooleLatt X -> Boolean;
end;

theorem 
  for x being Element of BooleLatt X holds x` = X \ x;

begin 

definition
  let L be Lattice;
  redefine func LattRel L -> Order of the carrier of L;
end;

definition
  let L be Lattice;
  func LattPOSet L -> strict Poset equals

  RelStr(#the carrier of L, LattRel L#);
end;

registration
  let L be Lattice;
  cluster LattPOSet L -> non empty;
end;

theorem 
  for L1,L2 being Lattice st LattPOSet L1 = LattPOSet L2 holds
  the LattStr of L1 = the LattStr of L2;

definition
  let L be Lattice, p be Element of L;
  func p% -> Element of LattPOSet L equals

  p;
end;

definition
  let L be Lattice, p be Element of LattPOSet L;
  func %p -> Element of L equals

  p;
end;

reserve L for Lattice,
  p,q for Element of L;

theorem 
  p [= q iff p% <= q%;

definition
  let X be set, O be Order of X;
  redefine func O~ -> Order of X;
end;

definition
  let A be RelStr;
  func A~ -> strict RelStr equals

  RelStr(#the carrier of A, (the InternalRel of A)~#);
end;

registration
  let A be Poset;
  cluster A~ -> reflexive transitive antisymmetric;
end;

registration
  let A be non empty RelStr;
  cluster A~ -> non empty;
end;

reserve A for RelStr,
  a,b,c for Element of A;

theorem 
  A~~ = the RelStr of A;

definition
  let A be RelStr, a be Element of A;
  func a~ -> Element of A~ equals

  a;
end;

definition
  let A be RelStr, a be Element of A~;
  func ~a -> Element of A equals

  a;
end;

theorem 
  a <= b iff b~ <= a~;

definition
  let A be RelStr, X be set, a be Element of A;
  pred a is_<=_than X means

  for b being Element of A st b in X holds a <= b;
  pred X is_<=_than a means


   for b being Element of A st b in X holds b <= a;
end;

notation
  let A be RelStr, X be set, a be Element of A;
  synonym X is_>=_than a for a is_<=_than X; synonym a is_>=_than X for
  X is_<=_than a;
end;

definition
  let IT be RelStr;
  attr IT is with_suprema means


  for x,y being Element of IT ex z being Element of IT st x <= z & y <= z &
  for z9 being Element of IT st x <= z9 & y <= z9 holds z <= z9;
  attr IT is with_infima means


  for x,y being Element of IT ex z being Element of IT st z <= x & z <= y &
  for z9 being Element of IT st z9 <= x & z9 <= y holds z9 <= z;
end;

registration
  cluster with_suprema -> non empty for RelStr;
  cluster with_infima -> non empty for RelStr;
end;

theorem 
  A is with_suprema iff A~ is with_infima;

theorem 
  for L being Lattice holds LattPOSet L is with_suprema with_infima;

definition
  let IT be RelStr;
  attr IT is complete means


   for X being set ex a being Element of IT st X is_<=_than a &
  for b being Element of IT st X is_<=_than b holds a <= b;
end;

registration
  cluster strict complete non empty for Poset;
end;

reserve A for non empty RelStr,
  a,b,c,c9 for Element of A;

theorem 
  A is complete implies A is with_suprema with_infima;

registration
  cluster complete with_suprema with_infima strict non empty for Poset;
end;

definition
  let A be RelStr such that
 A is antisymmetric;
  let a,b be Element of A such that
 ex x being Element of A st a <= x & b <= x &
  for c being Element of A st a <= c & b <= c holds x <= c;
  func a"\/"b -> Element of A means


  a <= it & b <= it &
  for c being Element of A st a <= c & b <= c holds it <= c;
end;

definition
  let A be RelStr such that
 A is antisymmetric;
  let a,b be Element of A such that
 ex x being Element of A st a >= x & b >= x &
  for c being Element of A st a >= c & b >= c holds x >= c;
  func a"/\"b -> Element of A means


  it <= a & it <= b &
  for c being Element of A st c <= a & c <= b holds c <= it;
end;

reserve V for with_suprema antisymmetric RelStr,
  u1,u2,u3,u4 for Element of V;
reserve N for with_infima antisymmetric RelStr,
  n1,n2,n3,n4 for Element of N;
reserve K for with_suprema with_infima reflexive antisymmetric RelStr,
  k1,k2,k3 for Element of K;

theorem 
  u1 "\/" u2 = u2 "\/" u1;

theorem 
  V is transitive implies (u1 "\/" u2) "\/" u3 = u1 "\/" (u2 "\/" u3);

theorem 
  n1 "/\" n2 = n2 "/\" n1;

theorem 
  N is transitive implies (n1 "/\" n2) "/\" n3 = n1 "/\" (n2 "/\" n3);

definition
  let L be with_infima antisymmetric RelStr, x, y be Element of L;
  redefine func x "/\" y;
  commutativity;
end;

definition
  let L be with_suprema antisymmetric RelStr, x, y be Element of L;
  redefine func x "\/" y;
  commutativity;
end;

theorem 
  (k1 "/\" k2) "\/" k2 = k2;

theorem 
  k1 "/\" (k1 "\/" k2) = k1;

theorem 
  for A being with_suprema with_infima Poset
  ex L being strict Lattice st the RelStr of A = LattPOSet L;

definition
  let A be RelStr such that
 A is with_suprema with_infima Poset;
  func latt A -> strict Lattice means


  the RelStr of A = LattPOSet it;
end;

theorem 
  (LattRel L)~ = LattRel (L.:) & (LattPOSet L)~ = LattPOSet (L.:);

begin 

definition
  let L be non empty LattStr, p be Element of L, X be set;
  pred p is_less_than X means


  for q being Element of L st q in X holds p [= q;
  pred X is_less_than p means


  for q being Element of L st q in X holds q [= p;
end;

notation
  let L be non empty LattStr, p be Element of L, X be set;
  synonym X is_greater_than p for p is_less_than X;
  synonym p is_greater_than X for X is_less_than p;
end;

theorem 
  for L being Lattice, p,q,r being Element of L holds
  p is_less_than {q,r} iff p [= q"/\"r;

theorem 
  for L being Lattice, p,q,r being Element of L holds
  p is_greater_than {q,r} iff q"\/"r [= p;

definition
  let IT be non empty LattStr;
  attr IT is complete means


  for X being set ex p being Element of IT st X is_less_than p &
  for r being Element of IT st X is_less_than r holds p [= r;
  attr IT is \/-distributive means


  for X for a,b,c being Element of IT st X is_less_than a &
  (for d being Element of IT st X is_less_than d holds a [= d)
  & {b"/\"a9 where a9 is Element of IT: a9 in X} is_less_than c &
  for d being Element of IT st
  {b"/\"a9 where a9 is Element of IT: a9 in X} is_less_than d holds c [= d
  holds b"/\"a [= c;
  attr IT is /\-distributive means

  for X for a,b,c being Element of IT st X is_greater_than a &
  (for d being Element of IT st X is_greater_than d holds d [= a)
  & {b"\/"a9 where a9 is Element of IT: a9 in X} is_greater_than c &
  for d being Element of IT st
  {b"\/"a9 where a9 is Element of IT: a9 in X} is_greater_than d holds d [= c
  holds c [= b"\/"a;
end;

theorem 
  for B being B_Lattice, a being Element of B holds
  X is_less_than a iff {b` where b is Element of B: b in X} is_greater_than a`;

theorem 
  for B being B_Lattice, a being Element of B holds
  X is_greater_than a iff {b` where b is Element of B: b in X} is_less_than a`;

theorem 
  BooleLatt X is complete;

registration
  let X be set;
  cluster BooleLatt X -> complete;
end;

theorem 
  BooleLatt X is \/-distributive;

theorem 
  BooleLatt X is /\-distributive;

registration
  cluster complete \/-distributive /\-distributive strict for Lattice;
end;

reserve p9,q9 for Element of LattPOSet L;

theorem 
  p is_less_than X iff p% is_<=_than X;

theorem 
  p9 is_<=_than X iff %p9 is_less_than X;

theorem 
  X is_less_than p iff X is_<=_than p%;

theorem 
  X is_<=_than p9 iff X is_less_than %p9;

registration
  let A be complete non empty Poset;
  cluster latt A -> complete;
end;

definition
  let L be non empty LattStr such that
 L is complete Lattice;
  let X be set;
  func "\/"(X,L) -> Element of L means


  X is_less_than it &
  for r being Element of L st X is_less_than r holds it [= r;
end;

definition
  let L be non empty LattStr, X be set;
  func "/\"(X,L) -> Element of L equals

  "\/"({p where p is Element of L: p is_less_than X},L);
end;

notation
  let L be non empty LattStr, X be Subset of L;
  synonym "\/" X for "\/"(X,L); synonym "/\" X for "/\"(X,L);
end;

reserve C for complete Lattice,
  a,a9,b,b9,c,d for Element of C,
  X,Y for set;

theorem 
  "\/"({a"/\"b: b in X}, C) [= a"/\""\/"(X,C);

theorem 
  C is \/-distributive iff for X, a holds a"/\""\/"(X,C) [= "\/"({a"/\"
b: b in X}, C);

theorem 
  a = "/\"(X,C) iff a is_less_than X & for b st b is_less_than X holds b [= a;

theorem 
  a"\/""/\"(X,C) [= "/\"({a"\/"b: b in X}, C);

theorem 
C is /\-distributive iff for X, a holds "/\"({a"\/"b: b in X}, C) [= a"\/""/\"
  (X,C);

theorem 
  "\/"(X,C) = "/\"({a: a is_greater_than X}, C);

theorem 
  a in X implies a [= "\/"(X,C) & "/\"(X,C) [= a;

theorem 
  a is_less_than X implies a [= "/\"(X,C);

theorem 
  a in X & X is_less_than a implies "\/"(X,C) = a;

theorem 
  a in X & a is_less_than X implies "/\"(X,C) = a;

theorem 
  "\/"{a} = a & "/\"{a} = a;

theorem 
  a"\/"b = "\/"{a,b} & a"/\"b = "/\"{a,b};

theorem 
  a = "\/"({b: b [= a}, C) & a = "/\"({c: a [= c}, C);

theorem 
  X c= Y implies "\/"(X,C) [= "\/"(Y,C) & "/\"(Y,C) [= "/\"(X,C);

theorem 
  "\/"(X,C) = "\/"({a: ex b st a [= b & b in X}, C) &
  "/\"(X,C) = "/\"({b: ex a st a [= b & a in X}, C);

theorem 
  (for a st a in X ex b st a [= b & b in Y) implies "\/"(X,C) [= "\/"(Y, C );

theorem 
  X c= bool the carrier of C implies "\/"(union X, C) = "\/"({"\/"
  Y where Y is Subset of C: Y in X}, C);

theorem 
  C is 0_Lattice & Bottom C = "\/"({},C);

theorem 
  C is 1_Lattice & Top C = "\/"(the carrier of C, C);

theorem 
  C is I_Lattice implies a => b = "\/"({c: a"/\"c [= b}, C);

theorem 
  C is I_Lattice implies C is \/-distributive;

theorem 
  for D being complete \/-distributive Lattice, a being Element of D holds
  a "/\" "\/"(X,D) = "\/"({a"/\" b1 where b1 is Element of D: b1 in X}, D) &
  "\/"(X,D) "/\" a = "\/"({b2"/\" a where b2 is Element of D: b2 in X}, D);

theorem 
  for D being complete /\-distributive Lattice, a being Element of D holds
  a "\/" "/\"(X,D) = "/\"({a"\/"b1 where b1 is Element of D: b1 in X}, D) &
  "/\"(X,D) "\/" a = "/\"({b2"\/" a where b2 is Element of D: b2 in X}, D);

scheme 
 SingleFraenkel{A()->set, B()->non empty set, P[set]}:
  {A() where a is Element of B(): P[a]} = {A()}
provided
 ex a being Element of B() st P[a];

scheme 
 FuncFraenkel{B()->non empty set, C()->non empty set,
  A(set)->Element of C(),f()->Function, P[set]}:
  f().:{A(x) where x is Element of B(): P[x]} =
  {f().A(x) where x is Element of B(): P[x]}
provided
 C() c= dom f();

theorem 
  for D being non empty set, f being Function of bool D, D st
  (for a being Element of D holds f.{a} = a) &
  for X being Subset-Family of D holds f.(f.:X) = f.(union X)
  ex L being complete strict Lattice st the carrier of L = D &
  for X being Subset of L holds "\/" X = f.X;














begin



reserve T for TopSpace;

theorem 
  for A being Subset of T holds Int Cl Int A c= Int Cl A & Int Cl
  Int A c= Cl Int A;

theorem 
  for A being Subset of T holds Cl Int A c= Cl Int Cl A & Int Cl A
  c= Cl Int Cl A;

theorem 
  for A, B being Subset of T st B is closed holds Cl(Int(A /\ B)) = A
  implies A c= B;

theorem 
  for A, B being Subset of T st A is open holds Int(Cl(A \/ B)) = B
  implies A c= B;

theorem 
  for A being Subset of T st A c= Cl Int A holds A \/ Int Cl A c=
  Cl Int(A \/ Int Cl A);

theorem 
  for A being Subset of T st Int Cl A c= A holds Int Cl(A /\ Cl Int
  A) c= A /\ Cl Int A;

begin





notation
  let T;
  let F be Subset-Family of T;
  synonym Cl F for clf F;
end;



theorem 
  for F being Subset-Family of T holds Cl F = {A where A is Subset
  of T : ex B being Subset of T st A = Cl B & B in F};

theorem 
  for F being Subset-Family of T holds Cl F = Cl Cl F;

theorem 
  for F being Subset-Family of T holds F = {} iff Cl F = {};

theorem 
  for F,G being Subset-Family of T holds Cl(F /\ G) c= (Cl F) /\ (Cl G);

theorem 
  for F,G being Subset-Family of T holds (Cl F) \ (Cl G) c= Cl(F \ G);

theorem 
  for F being Subset-Family of T, A being Subset of T st A in F holds
  meet(Cl F) c= Cl A & Cl A c= union(Cl F);




theorem 
  for F being Subset-Family of T holds meet F c= meet(Cl F);

theorem 
  for F being Subset-Family of T holds Cl(meet F) c= meet(Cl F);

theorem 
  for F being Subset-Family of T holds union(Cl F) c= Cl(union F);

definition
  let T;
  let F be Subset-Family of T;
  func Int F -> Subset-Family of T means


  for A being Subset of T holds
  A in it iff ex B being Subset of T st A = Int B & B in F;
 projectivity;
end;



theorem 
  for F being Subset-Family of T holds Int F = {A where A is
  Subset of T : ex B being Subset of T st A = Int B & B in F};

canceled;

theorem 
  for F being Subset-Family of T holds Int F is open;

theorem 
  for F being Subset-Family of T holds F = {} iff Int F = {};

theorem 
  for A being Subset of T, F being Subset-Family of T st F = { A }
  holds Int F = { Int A };

theorem 
  for F,G being Subset-Family of T holds F c= G implies Int F c= Int G;

theorem 
  for F,G being Subset-Family of T holds Int(F \/ G) = (Int F) \/ (Int G);

theorem 
  for F,G being Subset-Family of T holds Int(F /\ G) c= (Int F) /\ (Int G);

theorem 
  for F,G being Subset-Family of T holds (Int F) \ (Int G) c= Int(F \ G);

theorem 
  for F being Subset-Family of T, A being Subset of T holds A in F
  implies Int A c= union(Int F) & meet(Int F) c= Int A;

theorem 
  for F being Subset-Family of T holds union(Int F) c= union F;

theorem 
  for F being Subset-Family of T holds meet(Int F) c= meet F;

theorem 
  for F being Subset-Family of T holds union(Int F) c= Int(union F );

theorem 
  for F being Subset-Family of T holds Int(meet F) c= meet(Int F);

theorem 
  for F being Subset-Family of T holds F is finite implies Int(meet F) =
  meet(Int F);



reserve T for non empty TopSpace;
reserve F for Subset-Family of T;

theorem 
  Cl Int F = {A where A is Subset of T : ex B being Subset of T st
  A = Cl Int B & B in F};

theorem 
  Int Cl F = {A where A is Subset of T : ex B being Subset of T st
  A = Int Cl B & B in F};

theorem 
  Cl Int Cl F = {A where A is Subset of T : ex B being Subset of T
  st A = Cl Int Cl B & B in F};

theorem 
  Int Cl Int F = {A where A is Subset of T : ex B being Subset of
  T st A = Int Cl Int B & B in F};

theorem 
  Cl Int Cl Int F = Cl Int F;

theorem 
  Int Cl Int Cl F = Int Cl F;

theorem 
  union(Int Cl F) c= union(Cl Int Cl F);

theorem 
  meet(Int Cl F) c= meet(Cl Int Cl F);

theorem 
  union(Cl Int F) c= union(Cl Int Cl F);

theorem 
  meet(Cl Int F) c= meet(Cl Int Cl F);

theorem 
  union(Int Cl Int F) c= union(Int Cl F);

theorem 
  meet(Int Cl Int F) c= meet(Int Cl F);

theorem 
  union(Int Cl Int F) c= union(Cl Int F);

theorem 
  meet(Int Cl Int F) c= meet(Cl Int F);

theorem 
  union(Cl Int Cl F) c= union(Cl F);

theorem 
  meet(Cl Int Cl F) c= meet(Cl F);

theorem 
  union(Int F) c= union(Int Cl Int F);

theorem 
  meet(Int F) c= meet(Int Cl Int F);

theorem 
  union(Cl Int F) c= Cl Int(union F);

theorem 
  Cl Int(meet F) c= meet(Cl Int F);

theorem 
  union(Int Cl F) c= Int Cl(union F);

theorem 
  Int Cl(meet F) c= meet(Int Cl F);

theorem 
  union(Cl Int Cl F) c= Cl Int Cl(union F);

theorem 
  Cl Int Cl(meet F) c= meet(Cl Int Cl F);

theorem 
  union(Int Cl Int F) c= Int Cl Int(union F);

theorem 
  Int Cl Int(meet F) c= meet(Int Cl Int F);

theorem 
  for F being Subset-Family of T holds (for A being Subset of T st
A in F holds A c= Cl Int A) implies union F c= Cl Int(union F) & Cl(union F) =
  Cl Int Cl(union F);

theorem 
  for F being Subset-Family of T holds (for A being Subset of T st
A in F holds Int Cl A c= A) implies Int Cl(meet F) c= meet F & Int Cl Int(meet
  F) = Int(meet F);

begin



reserve T for non empty TopSpace;

theorem 
  for A, B being Subset of T st B is condensed holds Int(Cl(A \/ B
  )) \/ (A \/ B) = B iff A c= B;

theorem 
  for A, B being Subset of T st A is condensed holds Cl(Int(A /\ B)) /\
  (A /\ B) = A iff A c= B;

theorem 
  for A, B being Subset of T st A is closed_condensed & B is
  closed_condensed holds Int A c= Int B iff A c= B;

theorem 
  for A, B being Subset of T st A is open_condensed & B is
  open_condensed holds Cl A c= Cl B iff A c= B;

theorem 
  for A, B being Subset of T st A is closed_condensed holds A c= B
  implies Cl(Int(A /\ B)) = A;

theorem 
  for A, B being Subset of T st B is open_condensed holds A c= B
  implies Int(Cl(A \/ B)) = B;

definition
  let T;
  let IT be Subset-Family of T;
  attr IT is domains-family means


  for A being Subset of T holds A in IT implies A is condensed;
end;

theorem 
  for F being Subset-Family of T holds F c= Domains_of T iff F is
  domains-family;

theorem 
  for F being Subset-Family of T holds F is domains-family implies
  union F c= Cl Int(union F) & Cl(union F) = Cl Int Cl(union F);

theorem 
  for F being Subset-Family of T holds F is domains-family implies
  Int Cl(meet F) c= meet F & Int Cl Int(meet F) = Int(meet F);

theorem 
  for F being Subset-Family of T holds F is domains-family implies
  (union F) \/ (Int Cl(union F)) is condensed;

theorem 
  for F being Subset-Family of T holds (for B being Subset of T st
B in F holds B c= (union F) \/ (Int Cl(union F))) & for A being Subset of T st
A is condensed holds (for B being Subset of T st B in F holds B c= A) implies (
  union F) \/ (Int Cl(union F)) c= A;

theorem 
  for F being Subset-Family of T holds F is domains-family implies
  (meet F) /\ (Cl Int(meet F)) is condensed;

theorem 
  for F being Subset-Family of T holds (for B being Subset of T st
B in F holds (meet F) /\ (Cl Int(meet F)) c= B) & (F = {} or for A being Subset
  of T st A is condensed holds (for B being Subset of T st B in F holds A c= B)
  implies A c= (meet F) /\ (Cl Int(meet F)));

definition
  let T;
  let IT be Subset-Family of T;
  attr IT is closed-domains-family means


  for A being Subset of T holds A in IT implies A is closed_condensed;
end;

theorem 
  for F being Subset-Family of T holds F c= Closed_Domains_of T
  iff F is closed-domains-family;

theorem 
  for F being Subset-Family of T holds F is closed-domains-family
  implies F is domains-family;

theorem 
  for F being Subset-Family of T holds F is closed-domains-family
  implies F is closed;

theorem 
  for F being Subset-Family of T holds F is domains-family implies Cl F
  is closed-domains-family;

theorem 
  for F being Subset-Family of T holds F is closed-domains-family
  implies Cl(union F) is closed_condensed & Cl Int(meet F) is closed_condensed;

theorem 
  for F being Subset-Family of T holds (for B being Subset of T st
  B in F holds B c= Cl(union F)) & for A being Subset of T st A is
closed_condensed holds (for B being Subset of T st B in F holds B c= A) implies
  Cl(union F) c= A;

theorem 
  for F being Subset-Family of T holds (F is closed implies for B
being Subset of T st B in F holds Cl Int(meet F) c= B) & (F = {} or for A being
  Subset of T st A is closed_condensed holds (for B being Subset of T st B in F
  holds A c= B) implies A c= Cl Int(meet F));

definition
  let T;
  let IT be Subset-Family of T;
  attr IT is open-domains-family means


  for A being Subset of T holds A in IT implies A is open_condensed;
end;

theorem 
  for F being Subset-Family of T holds F c= Open_Domains_of T iff
  F is open-domains-family;

theorem 
  for F being Subset-Family of T holds F is open-domains-family
  implies F is domains-family;

theorem 
  for F being Subset-Family of T holds F is open-domains-family
  implies F is open;

theorem 
  for F being Subset-Family of T holds F is domains-family implies Int F
  is open-domains-family;

theorem 
  for F being Subset-Family of T holds F is open-domains-family
  implies Int(meet F) is open_condensed & Int Cl(union F) is open_condensed;

theorem 
  for F being Subset-Family of T holds (F is open implies for B
being Subset of T st B in F holds B c= Int Cl(union F)) & for A being Subset of
T st A is open_condensed holds (for B being Subset of T st B in F holds B c= A)
  implies Int Cl(union F) c= A;

theorem 
  for F being Subset-Family of T holds (for B being Subset of T st
  B in F holds Int(meet F) c= B) & (F = {} or for A being Subset of T st A is
open_condensed holds (for B being Subset of T st B in F holds A c= B) implies A
  c= Int(meet F));

begin



reserve T for non empty TopSpace;

theorem 
  the carrier of Domains_Lattice T = Domains_of T;

theorem 
  for a, b being Element of Domains_Lattice T for A, B being
Element of Domains_of T st a = A & b = B holds a "\/" b = Int(Cl(A \/ B)) \/ (A
  \/ B) & a "/\" b = Cl(Int(A /\ B)) /\ (A /\ B);

theorem 
  Bottom (Domains_Lattice T) = {}T & Top (Domains_Lattice T) = [#]T;

theorem 
  for a, b being Element of Domains_Lattice T for A, B being
  Element of Domains_of T st a = A & b = B holds a [= b iff A c= B;

theorem 
  for X being Subset of Domains_Lattice T ex a being Element of
Domains_Lattice T st X is_less_than a & for b being Element of Domains_Lattice
  T st X is_less_than b holds a [= b;

theorem 
  Domains_Lattice T is complete;

theorem 
  for F being Subset-Family of T st F is domains-family for X
being Subset of Domains_Lattice T st X = F holds "\/"(X,Domains_Lattice T) = (
  union F) \/ (Int Cl(union F));

theorem 
  for F being Subset-Family of T st F is domains-family for X
  being Subset of Domains_Lattice T st X = F holds (X <> {} implies "/\"(X,
  Domains_Lattice T) = (meet F) /\ (Cl Int(meet F))) & (X = {} implies "/\"(X,
  Domains_Lattice T) = [#]T);

begin



reserve T for non empty TopSpace;



theorem 
  the carrier of Closed_Domains_Lattice T = Closed_Domains_of T;

theorem 
  for a, b being Element of Closed_Domains_Lattice T for A, B
being Element of Closed_Domains_of T st a = A & b = B holds a "\/" b = A \/ B &
  a "/\" b = Cl(Int(A /\ B));

theorem 
  Bottom (Closed_Domains_Lattice T) = {}T & Top (Closed_Domains_Lattice
  T) = [#]T;

theorem 
  for a, b being Element of Closed_Domains_Lattice T for A, B
  being Element of Closed_Domains_of T st a = A & b = B holds a [= b iff A c= B
;

theorem 
  for X being Subset of Closed_Domains_Lattice T ex a being
  Element of Closed_Domains_Lattice T st X is_less_than a & for b being Element
  of Closed_Domains_Lattice T st X is_less_than b holds a [= b;

theorem 
  Closed_Domains_Lattice T is complete;

theorem 
  for F being Subset-Family of T st F is closed-domains-family for X
  being Subset of Closed_Domains_Lattice T st X = F holds "\/"(X,
  Closed_Domains_Lattice T) = Cl(union F);

theorem 
  for F being Subset-Family of T st F is closed-domains-family for X
being Subset of Closed_Domains_Lattice T st X = F holds (X <> {} implies "/\"(X
  ,Closed_Domains_Lattice T) = Cl(Int(meet F))) & (X = {} implies "/\"(X,
  Closed_Domains_Lattice T) = [#]T);

theorem 
  for F being Subset-Family of T st F is closed-domains-family for X
  being Subset of Domains_Lattice T st X = F holds (X <> {} implies "/\"(X,
Domains_Lattice T) = Cl(Int(meet F))) & (X = {} implies "/\"(X,Domains_Lattice
  T) = [#]T);



theorem 
  the carrier of Open_Domains_Lattice T = Open_Domains_of T;

theorem 
  for a, b being Element of Open_Domains_Lattice T for A, B being
Element of Open_Domains_of T st a = A & b = B holds a "\/" b = Int(Cl(A \/ B))
  & a "/\" b = A /\ B;

theorem 
  Bottom (Open_Domains_Lattice T) = {}T & Top (Open_Domains_Lattice T) = [#] T;

theorem 
  for a, b being Element of Open_Domains_Lattice T for A, B being
  Element of Open_Domains_of T st a = A & b = B holds a [= b iff A c= B;

theorem 
  for X being Subset of Open_Domains_Lattice T ex a being Element
  of Open_Domains_Lattice T st X is_less_than a & for b being Element of
  Open_Domains_Lattice T st X is_less_than b holds a [= b;

theorem 
  Open_Domains_Lattice T is complete;

theorem 
  for F being Subset-Family of T st F is open-domains-family for X being
Subset of Open_Domains_Lattice T st X = F holds "\/"(X,Open_Domains_Lattice T)
  = Int Cl(union F);

theorem 
  for F being Subset-Family of T st F is open-domains-family for X being
  Subset of Open_Domains_Lattice T st X = F holds (X <> {} implies "/\"(X,
  Open_Domains_Lattice T) = Int(meet F)) & (X = {} implies "/\"(X,
  Open_Domains_Lattice T) = [#]T);

theorem 
  for F being Subset-Family of T st F is open-domains-family for X being
Subset of Domains_Lattice T st X = F holds "\/"(X,Domains_Lattice T) = Int Cl(
  union F);














begin



reserve X for TopSpace;


reserve C for Subset of X;

theorem 
  Cl C = (Int C`)`;

theorem 
  Cl C` = (Int C)`;

theorem 
  Int C` = (Cl C)`;

reserve A, B for Subset of X;

theorem 
  A \/ B = the carrier of X implies (A is closed implies A \/ Int B =
  the carrier of X);

theorem 
  A is open closed iff Cl A = Int A;

theorem 
  A is open & A is closed implies Int Cl A = Cl Int A;



theorem 
  A is condensed & Cl Int A c= Int Cl A implies A is open_condensed
  & A is closed_condensed;

theorem 
  A is condensed & Cl Int A c= Int Cl A implies A is open & A is closed;

theorem 
  A is condensed implies Int Cl A = Int A & Cl A = Cl Int A;

begin



definition
  let IT be TopStruct;
  attr IT is discrete means


  the topology of IT = bool the carrier of IT;
  attr IT is anti-discrete means


  the topology of IT = {{}, the carrier of IT};
end;

theorem 
  for Y being TopStruct holds Y is discrete & Y is anti-discrete implies
  bool the carrier of Y = {{}, the carrier of Y};

theorem 
  for Y being TopStruct st {} in the topology of Y & the carrier
of Y in the topology of Y holds bool the carrier of Y = {{}, the carrier of Y}
  implies Y is discrete & Y is anti-discrete;

registration
  cluster discrete anti-discrete strict non empty for TopStruct;
end;

theorem 
  for Y being discrete TopStruct, A being Subset of Y holds (the
  carrier of Y) \ A in the topology of Y;

theorem 
  for Y being anti-discrete TopStruct, A being Subset of Y st A in
  the topology of Y holds (the carrier of Y) \ A in the topology of Y;

registration
  cluster discrete -> TopSpace-like for TopStruct;
  cluster anti-discrete -> TopSpace-like for TopStruct;
end;

theorem 
  for Y being TopSpace-like TopStruct holds bool the carrier of Y = {{},
  the carrier of Y} implies Y is discrete & Y is anti-discrete;

definition
  let IT be TopStruct;
  attr IT is almost_discrete means


  for A being Subset of IT st A in the
  topology of IT holds (the carrier of IT) \ A in the topology of IT;
end;

registration
  cluster discrete -> almost_discrete for TopStruct;
  cluster anti-discrete -> almost_discrete for TopStruct;
end;

registration
  cluster almost_discrete strict for TopStruct;
end;

begin



registration
  cluster discrete anti-discrete strict non empty for TopSpace;
end;

theorem 
  X is discrete iff for A being Subset of X holds A is open;

theorem 
  X is discrete iff for A being Subset of X holds A is closed;

theorem 
  (for A being Subset of X, x being Point of X st A = {x} holds A
  is open) implies X is discrete;

registration
  let X be discrete non empty TopSpace;
  cluster -> open closed discrete for SubSpace of X;
end;

registration
  let X be discrete non empty TopSpace;
  cluster discrete strict for SubSpace of X;
end;

theorem 
  X is anti-discrete iff for A being Subset of X st A is open
  holds A = {} or A = the carrier of X;

theorem 
  X is anti-discrete iff for A being Subset of X st A is closed
  holds A = {} or A = the carrier of X;

theorem 
  (for A being Subset of X, x being Point of X st A = {x} holds Cl A =
  the carrier of X) implies X is anti-discrete;

registration
  let X be anti-discrete non empty TopSpace;
  cluster -> anti-discrete for SubSpace of X;
end;

registration
  let X be anti-discrete non empty TopSpace;
  cluster anti-discrete for SubSpace of X;
end;

theorem 
  X is almost_discrete iff for A being Subset of X st A is open
  holds A is closed;

theorem 
  X is almost_discrete iff for A being Subset of X st A is closed
  holds A is open;

theorem 
  X is almost_discrete iff for A being Subset of X st A is open holds Cl A = A;

theorem 
  X is almost_discrete iff for A being Subset of X st A is closed holds
  Int A = A;

registration
  cluster almost_discrete strict for TopSpace;
end;

theorem 
  (for A being Subset of X, x being Point of X st A = {x} holds Cl A is
  open) implies X is almost_discrete;

theorem 
  X is discrete iff X is almost_discrete & for A being Subset of X, x
  being Point of X st A = {x} holds A is closed;

registration
  cluster discrete -> almost_discrete for TopSpace;
  cluster anti-discrete -> almost_discrete for TopSpace;
end;

registration
  let X be almost_discrete non empty TopSpace;
  cluster -> almost_discrete for non empty SubSpace of X;
end;

registration
  let X be almost_discrete non empty TopSpace;
  cluster open -> closed for SubSpace of X;
  cluster closed -> open for SubSpace of X;
end;

registration
  let X be almost_discrete non empty TopSpace;
  cluster almost_discrete strict non empty for SubSpace of X;
end;

begin



definition
  let IT be non empty TopSpace;
  attr IT is extremally_disconnected means


  for A being Subset of IT st A is open holds Cl A is open;
end;

registration
  cluster extremally_disconnected strict for non empty TopSpace;
end;

reserve X for non empty TopSpace;

theorem 
  X is extremally_disconnected iff for A being Subset of X st A is
  closed holds Int A is closed;

theorem 
  X is extremally_disconnected iff for A, B being Subset of X st A
  is open & B is open holds A misses B implies Cl A misses Cl B;

theorem 
  X is extremally_disconnected iff for A, B being Subset of X st A is
closed & B is closed holds A \/ B = the carrier of X implies (Int A) \/ (Int B)
  = the carrier of X;

theorem 
  X is extremally_disconnected iff for A being Subset of X st A is
  open holds Cl A = Int Cl A;

theorem 
  X is extremally_disconnected iff for A being Subset of X st A is
  closed holds Int A = Cl Int A;

theorem 
  X is extremally_disconnected iff for A being Subset of X st A is
  condensed holds A is closed & A is open;

theorem 
  X is extremally_disconnected iff for A being Subset of X st A is
  condensed holds A is closed_condensed & A is open_condensed;

theorem 
  X is extremally_disconnected iff for A being Subset of X st A is
  condensed holds Int Cl A = Cl Int A;

theorem 
  X is extremally_disconnected iff for A being Subset of X st A is
  condensed holds Int A = Cl A;

theorem 
  X is extremally_disconnected iff for A being Subset of X holds (
  A is open_condensed implies A is closed_condensed) & (A is closed_condensed
  implies A is open_condensed);

definition
  let IT be non empty TopSpace;
  attr IT is hereditarily_extremally_disconnected means


  for X0 being non empty SubSpace of IT holds X0 is extremally_disconnected;
end;

registration
  cluster hereditarily_extremally_disconnected strict for non empty TopSpace;
end;

registration
  cluster hereditarily_extremally_disconnected -> extremally_disconnected for
non
    empty TopSpace;
  cluster almost_discrete -> hereditarily_extremally_disconnected for
non empty
    TopSpace;
end;

theorem 
  for X being extremally_disconnected non empty TopSpace, X0
being non empty SubSpace of X, A being Subset of X st A = the carrier of X0 & A
  is dense holds X0 is extremally_disconnected;

registration
  let X be extremally_disconnected non empty TopSpace;
  cluster open -> extremally_disconnected for non empty SubSpace of X;
end;

registration
  let X be extremally_disconnected non empty TopSpace;
  cluster extremally_disconnected strict for non empty SubSpace of X;
end;

registration
  let X be hereditarily_extremally_disconnected non empty TopSpace;
  cluster -> hereditarily_extremally_disconnected for
non empty SubSpace of X;
end;

registration
  let X be hereditarily_extremally_disconnected non empty TopSpace;
  cluster hereditarily_extremally_disconnected strict for
non empty SubSpace of X
    ;
end;

theorem 
  (for X0 being closed non empty SubSpace of X holds X0 is
  extremally_disconnected) implies X is hereditarily_extremally_disconnected;

begin




reserve Y for extremally_disconnected non empty TopSpace;

theorem 
  Domains_of Y = Closed_Domains_of Y;

theorem 
  D-Union Y = CLD-Union Y & D-Meet Y = CLD-Meet Y;

theorem 
  Domains_Lattice Y = Closed_Domains_Lattice Y;

theorem 
  Domains_of Y = Open_Domains_of Y;

theorem 
  D-Union Y = OPD-Union Y & D-Meet Y = OPD-Meet Y;

theorem 
  Domains_Lattice Y = Open_Domains_Lattice Y;

theorem 
  for A, B being Element of Domains_of Y holds (D-Union Y).(A,B) =
  A \/ B & (D-Meet Y).(A,B) = A /\ B;

theorem 
  for a, b being Element of Domains_Lattice Y for A, B being Element of
  Domains_of Y st a = A & b = B holds a "\/" b = A \/ B & a "/\" b = A /\ B;

theorem 
  for F being Subset-Family of Y st F is domains-family for S being
Subset of Domains_Lattice Y st S = F holds "\/"(S,Domains_Lattice Y) = Cl(union
  F);

theorem 
  for F being Subset-Family of Y st F is domains-family for S being
  Subset of Domains_Lattice Y st S = F holds (S <> {} implies "/\"(S,
Domains_Lattice Y) = Int(meet F)) & (S = {} implies "/\"(S,Domains_Lattice Y) =
  [#]Y);



reserve X for non empty TopSpace;

theorem 
  X is extremally_disconnected iff Domains_Lattice X is M_Lattice;

theorem 
  Domains_Lattice X = Closed_Domains_Lattice X implies X is
  extremally_disconnected;

theorem 
  Domains_Lattice X = Open_Domains_Lattice X implies X is
  extremally_disconnected;

theorem 
  X is extremally_disconnected;

theorem 
  X is extremally_disconnected iff Domains_Lattice X is B_Lattice;














begin



reserve X for TopStruct,
  A for Subset of X;

theorem 
  (A = {}X iff A` = [#]X) & (A = {} iff A` = the carrier of X);

theorem 
  (A = [#]X iff A` = {}X) & (A = the carrier of X iff A` = {});

theorem 
  for X being TopSpace, A,B being Subset of X holds Int A /\ Cl B c= Cl(A /\ B)
;

reserve X for TopSpace,
  A,B for Subset of X;

theorem 
  Int(A \/ B) c= (Cl A) \/ Int B;

theorem 
  for A being Subset of X st A is closed holds Int(A \/ B) c= A \/ Int B;

theorem 
  for A being Subset of X st A is closed holds Int(A \/ B) = Int(A \/ Int B);

theorem 
  A misses Int Cl A implies Int Cl A = {};

theorem 
  A \/ Cl Int A = the carrier of X implies Cl Int A = the carrier of X;

begin



definition
  let X be TopStruct, A be Subset of X;
  redefine attr A is boundary means


  Int A = {};
end;

theorem 
  {}X is boundary;

reserve X for non empty TopSpace,
  A for Subset of X;

theorem 
  A is boundary implies A <> the carrier of X;

reserve X for TopSpace,
  A,B for Subset of X;

theorem 
  B is boundary & A c= B implies A is boundary;

theorem 
  A is boundary iff for C being Subset of X st A` c= C & C is closed
  holds C = the carrier of X;

theorem 
  A is boundary iff for G being Subset of X st G <> {} & G is open holds
  ( A`) meets G;

theorem 
  A is boundary iff for F being Subset of X holds F is closed implies
  Int F = Int(F \/ A);

theorem 
  A is boundary implies A /\ B is boundary;

definition
  let X be TopStruct, A be Subset of X;
  redefine attr A is dense means


  Cl A = the carrier of X;
end;

theorem 
  [#]X is dense;

reserve X for non empty TopSpace,
  A, B for Subset of X;

theorem 
  A is dense implies A <> {};

theorem 
  A is dense iff A` is boundary;

theorem 
  A is dense iff for C being Subset of X st A c= C & C is closed holds C
  = the carrier of X;

theorem 
  A is dense iff for G being Subset of X holds G is open implies Cl G =
  Cl(G /\ A);

theorem 
  A is dense implies A \/ B is dense;

definition
  let X be TopStruct, A be Subset of X;
  redefine attr A is nowhere_dense means


  Int(Cl A) = {};
end;

theorem 
  {}X is nowhere_dense;

theorem 
  A is nowhere_dense implies A <> the carrier of X;

theorem 
  A is nowhere_dense implies Cl A is nowhere_dense;

theorem 
  A is nowhere_dense implies A is not dense;

theorem 
  B is nowhere_dense & A c= B implies A is nowhere_dense;

theorem 
  A is nowhere_dense iff ex C being Subset of X st A c= C & C is
  closed & C is boundary;

theorem 
  A is nowhere_dense iff for G being Subset of X st G <> {} & G is
  open ex H being Subset of X st H c= G & H <> {} & H is open & A misses H;

theorem 
  A is nowhere_dense implies A /\ B is nowhere_dense;

theorem 
  A is nowhere_dense & B is boundary implies A \/ B is boundary;

definition
  let X be TopStruct, A be Subset of X;
  attr A is everywhere_dense means


  Cl(Int A) = [#]X;
end;

definition
  let X be TopStruct, A be Subset of X;
  redefine attr A is everywhere_dense means

  Cl(Int A) = the carrier of X;
end;

theorem 
  [#]X is everywhere_dense;

theorem 
  A is everywhere_dense implies Int A is everywhere_dense;

theorem 
  A is everywhere_dense implies A is dense;

theorem 
  A is everywhere_dense implies A <> {};

theorem 
  A is everywhere_dense iff Int A is dense;

theorem 
  A is open & A is dense implies A is everywhere_dense;

theorem 
  A is everywhere_dense implies A is not boundary;

theorem 
  A is everywhere_dense & A c= B implies B is everywhere_dense;

theorem 
  A is everywhere_dense iff A` is nowhere_dense;

theorem 
  A is nowhere_dense iff A` is everywhere_dense;

theorem 
  A is everywhere_dense iff ex C being Subset of X st C c= A & C
  is open & C is dense;

theorem 
  A is everywhere_dense iff for F being Subset of X st F <> the carrier
of X & F is closed ex H being Subset of X st F c= H & H <> the carrier of X & H
  is closed & A \/ H = the carrier of X;

theorem 
  A is everywhere_dense implies A \/ B is everywhere_dense;

theorem 
  A is everywhere_dense & B is everywhere_dense implies A /\ B is
  everywhere_dense;

theorem 
  A is everywhere_dense & B is dense implies A /\ B is dense;

theorem 
  A is dense & B is nowhere_dense implies A \ B is dense;

theorem 
  A is everywhere_dense & B is boundary implies A \ B is dense;

theorem 
  A is everywhere_dense & B is nowhere_dense implies A \ B is everywhere_dense;

reserve D for Subset of X;

theorem 
  D is everywhere_dense implies ex C,B being Subset of X st C is open &
  C is dense & B is nowhere_dense & C \/ B = D & C misses B;

theorem 
  D is everywhere_dense implies ex C,B being Subset of X st C is open &
  C is dense & B is closed & B is boundary & C \/ (D /\ B) = D & C misses B & C
  \/ B = the carrier of X;

theorem 
  D is nowhere_dense implies ex C,B being Subset of X st C is closed & C
  is boundary & B is everywhere_dense & C /\ B = D & C \/ B = the carrier of X;

theorem 
  D is nowhere_dense implies ex C,B being Subset of X st C is closed & C
is boundary & B is open & B is dense & C /\ (D \/ B) = D & C misses B & C \/ B
  = the carrier of X;

begin



reserve Y0 for SubSpace of X;

theorem 
  for A being Subset of X, B being Subset of Y0 st B c= A holds Cl B c= Cl A;

theorem 
  for C, A being Subset of X, B being Subset of Y0 st C is closed
  & C c= the carrier of Y0 & A c= C & A = B holds Cl A = Cl B;

theorem 
  for Y0 being closed non empty SubSpace of X for A being Subset of X, B
  being Subset of Y0 st A = B holds Cl A = Cl B;

theorem 
  for A being Subset of X, B being Subset of Y0 st A c= B holds Int A c= Int B;

theorem 
  for Y0 being non empty SubSpace of X, C, A being Subset of X, B
being Subset of Y0 st C is open & C c= the carrier of Y0 & A c= C & A = B holds
  Int A = Int B;

theorem 
  for Y0 being open non empty SubSpace of X for A being Subset of X, B
  being Subset of Y0 st A = B holds Int A = Int B;

reserve X0 for SubSpace of X;

theorem 
  for A being Subset of X, B being Subset of X0 st A c= B holds A
  is dense implies B is dense;

theorem 
  for C, A being Subset of X, B being Subset of X0 st C c= the
  carrier of X0 & A c= C & A = B holds C is dense & B is dense iff A is dense;

reserve X0 for non empty SubSpace of X;

theorem 
  for A being Subset of X, B being Subset of X0 st A c= B holds A
  is everywhere_dense implies B is everywhere_dense;

theorem 
  for C, A being Subset of X, B being Subset of X0 st C is open &
  C c= the carrier of X0 & A c= C & A = B holds C is dense & B is
  everywhere_dense iff A is everywhere_dense;

theorem 
  for X0 being open non empty SubSpace of X for A,C being Subset of X, B
  being Subset of X0 st C = the carrier of X0 & A = B holds C is dense & B is
  everywhere_dense iff A is everywhere_dense;

theorem 
  for C, A being Subset of X, B being Subset of X0 st C c= the carrier
of X0 & A c= C & A = B holds C is everywhere_dense & B is everywhere_dense iff
  A is everywhere_dense;

theorem 
  for A being Subset of X, B being Subset of X0 st A c= B holds B
  is boundary implies A is boundary;

theorem 
  for C, A being Subset of X, B being Subset of X0 st C is open &
  C c= the carrier of X0 & A c= C & A = B holds A is boundary implies B is
  boundary;

theorem 
  for X0 being open non empty SubSpace of X for A being Subset of X, B
  being Subset of X0 st A = B holds A is boundary iff B is boundary;

theorem 
  for A being Subset of X, B being Subset of X0 st A c= B holds B
  is nowhere_dense implies A is nowhere_dense;

theorem 
  for C, A being Subset of X, B being Subset of X0 st C is open &
  C c= the carrier of X0 & A c= C & A = B holds A is nowhere_dense implies B is
  nowhere_dense;

theorem 
  for X0 being open non empty SubSpace of X for A being Subset of X, B
  being Subset of X0 st A = B holds A is nowhere_dense iff B is nowhere_dense;

begin



theorem 
  for X1, X2 being 1-sorted holds the carrier of X1 = the carrier of X2
implies for C1 being Subset of X1, C2 being Subset of X2 holds C1 = C2 iff C1`
  = C2`;

reserve X1,X2 for TopStruct;

theorem 
  the carrier of X1 = the carrier of X2 & (for C1 being Subset of
X1, C2 being Subset of X2 st C1 = C2 holds (C1 is open iff C2 is open)) implies
  the TopStruct of X1 = the TopStruct of X2;

theorem 
  the carrier of X1 = the carrier of X2 & (for C1 being Subset of
  X1, C2 being Subset of X2 st C1 = C2 holds (C1 is closed iff C2 is closed))
  implies the TopStruct of X1 = the TopStruct of X2;

reserve X1,X2 for TopSpace;

theorem 
  the carrier of X1 = the carrier of X2 & (for C1 being Subset of X1, C2
  being Subset of X2 st C1 = C2 holds Int C1 = Int C2) implies the TopStruct of
  X1 = the TopStruct of X2;

theorem 
  the carrier of X1 = the carrier of X2 & (for C1 being Subset of X1, C2
being Subset of X2 st C1 = C2 holds Cl C1 = Cl C2) implies the TopStruct of X1
  = the TopStruct of X2;

reserve D1 for Subset of X1,
  D2 for Subset of X2;

theorem 
  D1 = D2 & the TopStruct of X1 = the TopStruct of X2 implies (D1
  is open implies D2 is open);

theorem 
  D1 = D2 & the TopStruct of X1 = the TopStruct of X2 implies Int D1 = Int D2;

theorem 
  D1 c= D2 & the TopStruct of X1 = the TopStruct of X2 implies Int D1 c= Int D2
;

theorem 
  D1 = D2 & the TopStruct of X1 = the TopStruct of X2 implies (D1
  is closed implies D2 is closed);

theorem 
  D1 = D2 & the TopStruct of X1 = the TopStruct of X2 implies Cl D1 = Cl D2;

theorem 
  D1 c= D2 & the TopStruct of X1 = the TopStruct of X2 implies Cl D1 c= Cl D2;

theorem 
  D2 c= D1 & the TopStruct of X1 = the TopStruct of X2 implies (D1
  is boundary implies D2 is boundary);

theorem 
  D1 c= D2 & the TopStruct of X1 = the TopStruct of X2 implies (D1
  is dense implies D2 is dense);

theorem 
  D2 c= D1 & the TopStruct of X1 = the TopStruct of X2 implies (D1 is
  nowhere_dense implies D2 is nowhere_dense);

reserve X1,X2 for non empty TopSpace;
reserve D1 for Subset of X1,
  D2 for Subset of X2;

theorem 
  D1 c= D2 & the TopStruct of X1 = the TopStruct of X2 implies (D1 is
  everywhere_dense implies D2 is everywhere_dense);














begin

definition

  let n be Nat;
  func dyadic(n) -> Subset of REAL means


  for x being Real holds x in it
  iff ex i being Element of NAT st i <= 2|^n & x = i/(2|^n);
end;

definition
  func DYADIC -> Subset of REAL means


  for a being Real holds a in it
  iff ex n being Element of NAT st a in dyadic(n);
end;

definition
  func DOM -> Subset of REAL equals

  (halfline 0) \/ DYADIC \/ right_open_halfline 1;
end;

definition
  let T be TopSpace;
  let A be non empty Subset of REAL;
  let F be Function of A,bool the carrier of T;
  let r be Element of A;
  redefine func F.r -> Subset of T;
end;

theorem 
  for n being Element of NAT holds for x being Real st
  x in dyadic(n) holds 0 <= x & x <= 1;

theorem 
  dyadic(0) = {0,1};

theorem 
  dyadic(1) = {0,1/2,1};

registration
  let n be Nat;
  cluster dyadic(n) -> non empty;
end;

definition
  let n be Nat;
  func dyad(n) -> FinSequence means


  dom it = Seg((2|^n)+1) &
  for i being Element of NAT st i in dom it holds it.i = (i-1)/(2|^n);
end;

theorem 
  for n being Element of NAT holds
  dom dyad(n) = Seg((2|^n)+1) & rng dyad(n) = dyadic(n);

registration
  cluster DYADIC -> non empty;
end;

registration
  cluster DOM -> non empty;
end;

theorem 
  for n being Element of NAT holds dyadic(n) c= dyadic(n+1);

theorem 
  for n being Element of NAT holds 0 in dyadic(n) & 1 in dyadic(n);

theorem 
  for n,i being Element of NAT st 0 < i & i <= 2|^n holds (i*2-1)/
  (2|^(n+1)) in dyadic(n+1) \ dyadic(n);

theorem 
  for n,i being Element of NAT st 0 <= i & i < 2|^n holds (i*2+1)/
  (2|^(n+1)) in dyadic(n+1) \ dyadic(n);

theorem 
  for n being Element of NAT holds 1/(2|^(n+1)) in dyadic(n+1) \ dyadic(n);

definition
  let n be Nat;
  let x be Element of dyadic(n);
  func axis(x) -> Element of NAT means


  x = it/(2|^n);
end;

theorem 
  for n being Element of NAT holds for x being Element of dyadic(n) holds
  x = axis(x)/(2|^n) & axis(x) <= (2|^n);

theorem 
  for n being Element of NAT holds for x being Element of dyadic(n)
  holds (axis(x)-1)/(2|^n) < x & x < (axis(x)+1)/(2|^n);

theorem 
  for n being Element of NAT holds for x being Element of dyadic(n) holds
  (axis(x)-1)/(2|^n) < (axis(x)+1)/(2|^n);

theorem 
  for n being Element of NAT holds for x being Element of dyadic(n
+1) holds (not x in dyadic(n) implies (axis(x)-1)/(2|^(n+1)) in dyadic(n) &
  (axis(x)+1)/(2|^(n+1)) in dyadic(n) );

theorem 
  for n being Element of NAT holds for x1,x2 being Element of dyadic(n) st
  x1 < x2 holds axis(x1) < axis(x2);

theorem 
  for n being Element of NAT holds for x1,x2 being Element of
dyadic(n) st x1 < x2 holds x1 <= (axis(x2)-1)/(2|^n) & (axis(x1)+1)/(2|^n)
  <= x2;

theorem 
  for n being Element of NAT holds for x1,x2 being Element of
dyadic(n+1) st x1 < x2 & not x1 in dyadic(n) & not x2 in dyadic(n) holds
(axis(x1)+1)/(2|^(n+1)) <= (axis(x2)-1)/(2|^(n+1));

begin





notation
  let T be non empty TopSpace;
  let x be Point of T;
  synonym Nbhd of x,T for a_neighborhood of x;
end;

definition
  let T be non empty TopSpace;
  let x be Point of T;
  redefine mode Nbhd of x,T means

    ex A being Subset of T st A is open & x in A & A c= it;
end;

theorem 
  for T being non empty TopSpace for A being Subset of T holds A
is open iff for x being Point of T holds x in A implies ex B being Nbhd of x,T
  st B c= A;

theorem 
  for T being non empty TopSpace holds for A being Subset of T holds (
  for x being Point of T st x in A holds A is Nbhd of x,T) implies A is open;

definition
  let T be TopSpace;
  redefine attr T is T_1 means


  for p,q being Point of T st not p = q ex
W,V being Subset of T st W is open & V is open & p in W & not q in W & q in V &
  not p in V;
end;

theorem 
  for T being non empty TopSpace holds T is T_1 iff for p being
  Point of T holds {p} is closed;

theorem 
  for T being non empty TopSpace st T is normal holds for A,B
being open Subset of T st A <> {} & Cl(A) c=B holds ex C being Subset of T st C
  <> {} & C is open & Cl(A) c= C & Cl(C) c= B;

theorem 
  for T being non empty TopSpace holds T is regular iff for A being open
Subset of T for p being Point of T st p in A holds ex B being open Subset of T
  st p in B & Cl(B) c= A;

theorem 
  for T being non empty TopSpace st T is normal & T is T_1 holds for A
being open Subset of T st A <> {} holds ex B being Subset of T st B <> {} & Cl(
  B) c= A;

theorem 
  for T being non empty TopSpace st T is normal for A,B being Subset of
T st A is open & B is closed & B <> {} & B c= A ex C being Subset of T st C is
  open & B c= C & Cl(C) c= A;

begin





definition
  let T be non empty TopSpace;
  let A,B be Subset of T;
  assume
 T is normal & A <> {} & A is open & B is open & Cl(A) c= B;
  mode Between of A,B -> Subset of T means


    it <> {} & it is open & Cl( A) c= it & Cl(it) c= B;
end;

theorem 
  for T being non empty TopSpace st T is normal for A,B being closed
  Subset of T st A <> {} for n being Element of NAT for G being Function of
  dyadic(n),bool the carrier of T st A c= G.0 & B = [#](T) \ G.1 & for r1,r2
being Element of dyadic(n) st r1 < r2 holds G.r1 is open & G.r2 is open & Cl(G.
r1) c= G.r2 ex F being Function of dyadic(n+1),bool the carrier of T st A c= F.
  0 & B = [#](T) \ F.1 & for r1,r2,r being Element of dyadic(n+1) st r1 < r2
holds F.r1 is open & F.r2 is open & Cl(F.r1) c= F.r2 & (r in dyadic(n) implies
  F.r = G.r);














begin

reserve

  n for Nat;

definition
  struct (1-sorted) UAStr (# carrier -> set, charact -> PFuncFinSequence of
    the carrier #);
end;

registration
  cluster non empty strict for UAStr;
end;

registration
  let D be non empty set, c be PFuncFinSequence of D;
  cluster UAStr (#D,c #) -> non empty;
end;

definition
  let IT be UAStr;

  attr IT is partial means


  the charact of IT is homogeneous;
  attr IT is quasi_total means


  the charact of IT is quasi_total;
  attr IT is non-empty means


  the charact of IT <> {} & the charact of IT is non-empty;
end;

registration
  cluster quasi_total partial non-empty strict non empty for UAStr;
end;

registration
  let U1 be partial UAStr;
  cluster the charact of U1 -> homogeneous;
end;

registration
  let U1 be quasi_total UAStr;
  cluster the charact of U1 -> quasi_total;
end;

registration
  let U1 be non-empty UAStr;
  cluster the charact of U1 -> non-empty non empty;
end;

definition
  mode Universal_Algebra is quasi_total partial non-empty non empty UAStr;
end;

reserve U1 for partial non-empty non empty UAStr;

theorem 
  n in dom the charact of U1 implies (the charact of U1).n is
  PartFunc of (the carrier of U1)*,the carrier of U1;

definition

  let U1;
  func signature U1 ->FinSequence of NAT means

  len it = len the charact of U1
  & for n st n in dom it holds for h be homogeneous non empty PartFunc of (the
  carrier of U1 )*,the carrier of U1 st h = (the charact of U1).n holds it.n =
  arity(h);
end;

begin 


registration
  let U0 be Universal_Algebra;
  cluster the charact of U0 -> Function-yielding;
end;














begin

reserve U0,U1,U2,U3 for Universal_Algebra,
  n for Nat,
  x,y for set;

definition
  let U1;
  mode PFuncsDomHQN of U1 is PFuncsDomHQN of (the carrier of U1);
end;

definition
  let U1 be UAStr;
  mode PartFunc of U1 is PartFunc of (the carrier of U1)*,the carrier of U1;
end;

definition

  let U1,U2;
  pred U1,U2 are_similar means


  signature (U1) = signature (U2);
  symmetry;
  reflexivity;
end;

theorem 
  U1,U2 are_similar implies len the charact of(U1) = len the charact of( U2);

theorem 
  U1,U2 are_similar & U2,U3 are_similar implies U1,U3 are_similar;

theorem 
  rng the charact of(U0) is non empty Subset of PFuncs((the carrier of
  U0)*,the carrier of U0);

definition
  let U0;
  func Operations(U0) -> PFuncsDomHQN of U0 equals

  rng the charact of(U0);
end;

definition
  let U1;
  mode operation of U1 is Element of Operations(U1);
end;

reserve A for non empty Subset of U0,
  o for operation of U0,
  x1,y1 for FinSequence of A;

definition
  let U0 be Universal_Algebra, A be Subset of U0, o be operation of U0;
  pred A is_closed_on o means


  for s being FinSequence of A st len s = arity o holds o.s in A;
end;

definition
  let U0 be Universal_Algebra, A be Subset of U0;
  attr A is opers_closed means


  for o be operation of U0 holds A is_closed_on o;
end;

definition
  let U0,A,o;
  assume
 A is_closed_on o;
  func o/.A ->homogeneous quasi_total non empty PartFunc of A*,A equals


  o|((arity o)-tuples_on A);
end;

definition
  let U0,A;
  func Opers(U0,A) -> PFuncFinSequence of A means


  dom it = dom the
  charact of(U0) & for n being set,o st n in dom it & o =(the charact of(U0)).n
  holds it.n = o/.A;
end;

theorem 
  for B being non empty Subset of U0 st B=the carrier of U0 holds B
  is opers_closed & for o holds o/.B = o;

theorem 
  for U1 be Universal_Algebra, A be non empty Subset of U1, o be
  operation of U1 st A is_closed_on o holds arity (o/.A) = arity o;

definition
  let U0;
  mode SubAlgebra of U0 -> Universal_Algebra means


    the carrier of it is
Subset of U0 & for B be non empty Subset of U0 st B=the carrier of it holds the
    charact of it = Opers(U0,B) & B is opers_closed;
end;

registration
  let U0 be Universal_Algebra;
  cluster strict for SubAlgebra of U0;
end;

theorem 
  for U0,U1 be Universal_Algebra, o0 be operation of U0, o1 be
operation of U1, n be Nat st U0 is SubAlgebra of U1 & n in dom the charact of(
U0) & o0 = (the charact of(U0)).n & o1 = (the charact of(U1)).n holds arity o0
  = arity o1;

theorem 
  U0 is SubAlgebra of U1 implies dom the charact of(U0)=dom the charact of(U1);

theorem 
  U0 is SubAlgebra of U0;

theorem 
  U0 is SubAlgebra of U1 & U1 is SubAlgebra of U2 implies U0 is
  SubAlgebra of U2;

theorem 
  U1 is strict SubAlgebra of U2 & U2 is strict SubAlgebra of U1 implies U1 = U2
;

theorem 
  for U1,U2 be SubAlgebra of U0 st the carrier of U1 c= the
  carrier of U2 holds U1 is SubAlgebra of U2;

theorem 
  for U1,U2 be strict SubAlgebra of U0 st the carrier of U1 = the
  carrier of U2 holds U1 = U2;

theorem 
  U1 is SubAlgebra of U2 implies U1,U2 are_similar;

theorem 
  for A be non empty Subset of U0 holds UAStr (#A,Opers(U0,A)#) is
  strict Universal_Algebra;

definition
  let U0 be Universal_Algebra, A be non empty Subset of U0;
  assume
 A is opers_closed;
  func UniAlgSetClosed(A) -> strict SubAlgebra of U0 equals


  UAStr (# A,
    Opers(U0,A) #);
end;

definition
  let U0;
  let U1,U2 be SubAlgebra of U0;
  assume
 the carrier of U1 meets the carrier of U2;
  func U1 /\ U2 -> strict SubAlgebra of U0 means


  the carrier of it = (
the carrier of U1) /\ (the carrier of U2) & for B be non empty Subset of U0 st
B=the carrier of it holds the charact of(it) = Opers(U0,B) & B is opers_closed;
end;

definition
  let U0;
  func Constants(U0) -> Subset of U0 equals

  { a where a is Element of U0: ex o
  be operation of U0 st arity o=0 & a in rng o};
end;

definition
  let IT be Universal_Algebra;
  attr IT is with_const_op means


  ex o being operation of IT st arity o =0;
end;

registration
  cluster with_const_op strict for Universal_Algebra;
end;

registration
  let U0 be with_const_op Universal_Algebra;
  cluster Constants(U0) -> non empty;
end;

theorem 
  for U0 be Universal_Algebra, U1 be SubAlgebra of U0 holds
  Constants(U0) is Subset of U1;

theorem 
  for U0 be with_const_op Universal_Algebra, U1 be SubAlgebra of U0
  holds Constants(U0) is non empty Subset of U1;

theorem 
  for U0 be with_const_op Universal_Algebra,U1,U2 be SubAlgebra of
  U0 holds the carrier of U1 meets the carrier of U2;

definition
  let U0 be Universal_Algebra, A be Subset of U0;
  assume
 Constants(U0) <> {} or A <> {};
  func GenUnivAlg(A) -> strict SubAlgebra of U0 means


  A c= the carrier
  of it & for U1 be SubAlgebra of U0 st A c= the carrier of U1 holds it is
  SubAlgebra of U1;
end;

theorem 
  for U0 be strict Universal_Algebra holds GenUnivAlg([#](the carrier of
  U0)) = U0;

theorem 
  for U0 be Universal_Algebra, U1 be strict SubAlgebra of U0, B be
  non empty Subset of U0 st B = the carrier of U1 holds GenUnivAlg(B) = U1;

definition
  let U0 be Universal_Algebra, U1,U2 be SubAlgebra of U0;
  func U1 "\/" U2 -> strict SubAlgebra of U0 means


  for A be non empty
  Subset of U0 st A = (the carrier of U1) \/ (the carrier of U2) holds it =
  GenUnivAlg(A);
end;

theorem 
  for U0 be Universal_Algebra, U1 be SubAlgebra of U0, A,B be
  Subset of U0 st (A <> {} or Constants(U0) <> {}) & B = A \/ the carrier of U1
  holds GenUnivAlg(A) "\/" U1 = GenUnivAlg(B);

theorem 
  for U0 be Universal_Algebra, U1,U2 be SubAlgebra of U0 holds U1
  "\/" U2 = U2 "\/" U1;

theorem 
  for U0 be with_const_op Universal_Algebra,U1,U2 be strict
  SubAlgebra of U0 holds U1 /\ (U1"\/"U2) = U1;

theorem 
  for U0 be with_const_op Universal_Algebra,U1,U2 be strict
  SubAlgebra of U0 holds (U1 /\ U2)"\/"U2 = U2;

definition
  let U0 be Universal_Algebra;
  func Sub(U0) -> set means


  for x holds x in it iff x is strict SubAlgebra of U0;
end;

registration
  let U0 be Universal_Algebra;
  cluster Sub(U0) -> non empty;
end;

definition
  let U0 be Universal_Algebra;
  func UniAlg_join(U0) -> BinOp of Sub(U0) means


  for x,y be Element of
Sub(U0) holds for U1,U2 be strict SubAlgebra of U0 st x = U1 & y = U2 holds it.
  (x,y) = U1 "\/" U2;
end;

definition
  let U0 be Universal_Algebra;
  func UniAlg_meet(U0) -> BinOp of Sub(U0) means


  for x,y be Element of
Sub(U0) holds for U1,U2 be strict SubAlgebra of U0 st x = U1 & y = U2 holds it.
  (x,y) = U1 /\ U2;
end;

theorem 
  UniAlg_join(U0) is commutative;

theorem 
  UniAlg_join(U0) is associative;

theorem 
  for U0 be with_const_op Universal_Algebra holds UniAlg_meet(U0)
  is commutative;

theorem 
  for U0 be with_const_op Universal_Algebra holds UniAlg_meet(U0)
  is associative;

definition
  let U0 be with_const_op Universal_Algebra;
  func UnSubAlLattice(U0) -> strict Lattice equals

  LattStr (# Sub(U0),
    UniAlg_join(U0), UniAlg_meet(U0) #);
end;














begin





definition
  struct(1-sorted) DTConstrStr (# carrier -> set, Rules -> Relation of the
    carrier, (the carrier)* #);
end;

registration
  cluster non empty strict for DTConstrStr;
end;

definition
  struct(DTConstrStr) GrammarStr (# carrier -> set, InitialSym -> Element of
    the carrier, Rules -> Relation of the carrier, (the carrier)* #);
end;

registration
  cluster non empty for GrammarStr;
end;

definition
  let G be DTConstrStr;
  mode Symbol of G is Element of G;
  mode String of G is Element of (the carrier of G)*;
end;

reserve G for non empty DTConstrStr,
  s for Symbol of G,
  n,m for String of G;

definition
  let G,s;
  let n be FinSequence;
  pred s ==> n means


  [s,n] in the Rules of G;
end;

definition
  let G;
  func Terminals G equals

  { s : not ex n being FinSequence st s ==> n};
  func NonTerminals G equals

  { s : ex n being FinSequence st s ==> n};
end;

theorem 
  Terminals(G) \/ NonTerminals(G) = the carrier of G;

definition
  let G,n,m;
  pred n ==> m means

  ex n1,n2,n3 being String of G, s st n = n1^<*s*>^n2 & m =
  n1^n3^n2 & s ==> n3;
end;

reserve n1,n2,n3 for String of G;

theorem 
  s ==> n implies n1^<*s*>^n2 ==> n1^n^n2;

theorem 
  s ==> n implies <*s*> ==> n;

theorem 
  <*s*> ==> n implies s ==> n;

theorem 
  n1 ==> n2 implies n^n1 ==> n^n2 & n1^n ==> n2^n;

definition
  let G, n, m;
  pred m is_derivable_from n means


  ex p being FinSequence st len p >= 1
& p.1 = n & p.len p = m & for i being Element of NAT st i >= 1 & i < len p ex a
  ,b being String of G st p.i = a & p.(i+1) = b & a ==> b;
end;

theorem 
  n is_derivable_from n;

theorem 
  n ==> m implies m is_derivable_from n;

theorem 
  n1 is_derivable_from n2 & n2 is_derivable_from n3 implies n1
  is_derivable_from n3;



definition
  let G be non empty GrammarStr;
  func Lang(G) equals

  {a where a is Element of (the carrier of G)*: rng a c=
  Terminals(G) & a is_derivable_from <*the InitialSym of G*>};
end;

theorem 
  for G being non empty GrammarStr, n being String of G holds n in Lang(
  G) iff rng n c= Terminals(G) & n is_derivable_from <*the InitialSym of G*>;






definition
  let D,E be non empty set, a be Element of [:D,E:];
  redefine func {a} -> Relation of D,E;
  let b be Element of [:D,E:];
  redefine func {a,b} -> Relation of D,E;
end;

definition
  let a be set;
  func EmptyGrammar a -> strict GrammarStr means


  the carrier of it = {a } & the Rules of it = {[a,{}]};
  let b be set;
  func SingleGrammar(a,b) -> strict GrammarStr means


  the carrier of it
  = {a,b} & the InitialSym of it = a & the Rules of it = {[a,<*b*>]};
  func IterGrammar(a,b) -> strict GrammarStr means


  the carrier of it =
  {a,b} & the InitialSym of it = a & the Rules of it = {[a,<*b,a*>],[a,{}]};
end;

registration
  let a be set;
  cluster EmptyGrammar a -> non empty;
  let b be set;
  cluster SingleGrammar(a,b) -> non empty;
  cluster IterGrammar(a,b) -> non empty;
end;

definition
  let D be non empty set;
  func TotalGrammar D -> strict GrammarStr means


  the carrier of it =
  succ D & the InitialSym of it = D & the Rules of it = {[D,<*d,D*>] where d is
  Element of D: d = d} \/ {[D,{}]};
end;

registration
  let D be non empty set;
  cluster TotalGrammar D -> non empty;
end;

reserve a,b,c for set,
  D for non empty set,
  d for Element of D;

theorem 
  Terminals EmptyGrammar a = {};

theorem 
  Lang EmptyGrammar a = {{}};

theorem 
  a <> b implies Terminals SingleGrammar(a,b) = {b};

theorem 
  a <> b implies Lang SingleGrammar(a,b) = {<*b*>};

theorem 
  a <> b implies Terminals IterGrammar(a,b) = {b};

theorem 
  a <> b implies Lang IterGrammar(a,b) = {b}*;

theorem 
  Terminals TotalGrammar D = D;

theorem 
  Lang TotalGrammar D = D*;

definition
  let IT be non empty GrammarStr;
  attr IT is efective means


  Lang IT is non empty & the InitialSym of
  IT in NonTerminals IT & for s being Symbol of IT st s in Terminals IT ex p
  being String of IT st p in Lang(IT) & s in rng p;
end;

definition
  let IT be GrammarStr;
  attr IT is finite means

  the Rules of IT is finite;
end;

registration
  cluster efective finite for non empty GrammarStr;
end;

definition
  let G be efective non empty GrammarStr;
  redefine func NonTerminals G -> non empty Subset of G;
end;

definition
  let X,Y be non empty set, p be FinSequence of X, f be Function of X,Y;
  redefine func f*p -> Element of Y*;
end;

definition
  let X,Y be non empty set;
  let f be Function of X,Y;

  func f* -> Function of X*,Y* means

  for p being Element of X* holds it.p = f* p;
end;

reserve R for Relation,
  x,y for set;

theorem 
  R c= R[*];

definition
  let X be non empty set, R be Relation of X;
  redefine func R[*] -> Relation of X;
end;

definition
  let G be non empty GrammarStr;
  let X be non empty set;
  let f be Function of the carrier of G, X;
  func G.f -> strict GrammarStr equals

  GrammarStr (#X, f.the InitialSym of G,
    (f)~*(the Rules of G)*(f*) #);
end;
 
















begin

theorem 
  for D being non empty set, p being FinSequence of FinTrees D holds
  p is FinSequence of Trees D;

theorem 
  for x,y being set, p being FinSequence of x st y in dom p holds p.y in x;

registration
  let D be non empty set, T be DTree-set of D;
  cluster -> DTree-yielding for FinSequence of T;
end;

definition
  let D be non empty set;
  let F be non empty DTree-set of D;
  let Tset be non empty Subset of F;
  redefine mode Element of Tset -> Element of F;
end;

definition
  let D be non empty set, T be DTree-set of D;
  let p be FinSequence of T;
  redefine func roots p -> FinSequence of D;
end;

theorem 
  roots {} = {};

theorem 
  for T being DecoratedTree holds roots <*T*> = <*T.{}*>;

theorem 
  for D being non empty set, F being (Subset of FinTrees D),
  p being FinSequence of F st len roots p = 1
  ex x being Element of FinTrees D st p = <*x*> & x in F;

theorem 
  for T1, T2 being DecoratedTree holds roots <*T1, T2*> = <*T1.{}, T2.{}*>;

definition
  let X, Y be set, f be FinSequence of [:X, Y:];
  redefine func pr1 f -> FinSequence of X;
  redefine func pr2 f -> FinSequence of Y;
end;

theorem 
  pr1 {} = {} & pr2 {} = {};

begin

registration
  let A be non empty set, R be Relation of A,A*;
  cluster DTConstrStr(#A,R#) -> non empty;
end;

scheme 
 DTConstrStrEx { S() -> non empty set, P[set, set] }:
  ex G be strict non empty DTConstrStr st the carrier of G = S() &
  for x being Symbol of G, p being FinSequence of the carrier of G
  holds x ==> p iff P[x, p];

scheme 
 DTConstrStrUniq { S() -> non empty set, P[set, set] }:
  for G1, G2 being strict non empty DTConstrStr st (the carrier of G1 = S() &
  for x being Symbol of G1, p being FinSequence of the carrier of G1
  holds x ==> p iff P[x, p]) & (the carrier of G2 = S() &
  for x being Symbol of G2, p being FinSequence of the carrier of G2
  holds x ==> p iff P[x, p]) holds G1 = G2;

theorem 
  for G being non empty DTConstrStr holds Terminals G misses NonTerminals G;

scheme 
 DTCMin { f() -> Function,
  G() -> non empty DTConstrStr, D() -> non empty set,
  TermVal(set) -> Element of D(), NTermVal(set, set, set) -> Element of D()}:
  ex X being Subset of FinTrees [:the carrier of G(), D():] st X = Union f() &
  (for d being Symbol of G() st d in Terminals G()
  holds root-tree [d, TermVal(d)] in X) & (for o being Symbol of G(),
  p being FinSequence of X st o ==> pr1 roots p
  holds [o, NTermVal(o, pr1 roots p, pr2 roots p)]-tree p in X ) &
  for F being Subset of FinTrees [:the carrier of G(), D():] st
  (for d being Symbol of G() st d in Terminals G()
  holds root-tree [d, TermVal(d)] in F ) & (for o being Symbol of G(),
  p being FinSequence of F st o ==> pr1 roots p
  holds [o, NTermVal(o, pr1 roots p, pr2 roots p)]-tree p in F) holds X c= F
provided
 dom f() = NAT and
 f().0 = { root-tree [t, d] where t is Symbol of G(), d is Element of D() :
t in Terminals G() & d = TermVal(t) or t ==> {} & d = NTermVal(t, {}, {}) } and
 for n being Element of NAT holds f().(n+1) =
f().n \/ { [o, NTermVal(o, pr1 roots p, pr2 roots p)]-tree p
where o is Symbol of G(), p is Element of (f().n)* :
ex q being FinSequence of FinTrees [:the carrier of G(), D():] st
p = q & o ==> pr1 roots q };

scheme 
 DTCSymbols { f() -> Function,
  G() -> non empty DTConstrStr, D() -> non empty set,
  TermVal(set) -> Element of D(), NTermVal(set, set, set) -> Element of D()}:
  ex X1 being Subset of FinTrees(the carrier of G()) st
  X1 = { t`1 where t is Element of FinTrees [:(the carrier of G()), D():] :
  t in Union f() } &
  (for d being Symbol of G() st d in Terminals G() holds root-tree d in X1) &
  (for o being Symbol of G(), p being FinSequence of X1 st o ==> roots p
  holds o-tree p in X1) & for F being Subset of FinTrees the carrier of G() st
  (for d being Symbol of G() st d in Terminals G() holds root-tree d in F) &
  (for o being Symbol of G(), p being FinSequence of F st o ==> roots p
  holds o-tree p in F) holds X1 c= F
provided
 dom f() = NAT and
 f().0 = { root-tree [t, d] where t is Symbol of G(), d is Element of D() :
t in Terminals G() & d = TermVal(t) or t ==> {} & d = NTermVal(t, {}, {}) } and
 for n being Element of NAT holds f().(n+1) =
f().n \/ { [o, NTermVal(o, pr1 roots p, pr2 roots p)]-tree p
where o is Symbol of G(), p is Element of (f().n)* :
ex q being FinSequence of FinTrees [:the carrier of G(), D():] st
p = q & o ==> pr1 roots q };

scheme 
 DTCHeight { f() -> Function,
  G() -> non empty DTConstrStr, D() -> non empty set,
  TermVal(set) -> Element of D(), NTermVal(set, set, set) -> Element of D()}:
  for n being Element of NAT,
  dt being Element of FinTrees [:the carrier of G(), D():]
  st dt in Union f() holds dt in f().n iff height dom dt <= n
provided
 dom f() = NAT and
 f().0 = { root-tree [t, d] where t is Symbol of G(), d is Element of D() :
t in Terminals G() & d = TermVal(t) or t ==> {} & d = NTermVal(t, {}, {}) } and
 for n being Element of NAT holds f().(n+1) =
f().n \/ { [o, NTermVal(o, pr1 roots p, pr2 roots p)]-tree p
where o is Symbol of G(), p is Element of (f().n)* :
ex q being FinSequence of FinTrees [:the carrier of G(), D():] st
p = q & o ==> pr1 roots q };

scheme 
 DTCUniq { f() -> Function,
  G() -> non empty DTConstrStr, D() -> non empty set,
  TermVal(set) -> Element of D(), NTermVal(set, set, set) -> Element of D()}:
  for dt1, dt2 being DecoratedTree of [:(the carrier of G()), D():]
  st dt1 in Union f() & dt2 in Union f() & dt1`1 = dt2`1 holds dt1 = dt2
provided
 dom f() = NAT and
 f().0 = { root-tree [t, d] where t is Symbol of G(), d is Element of D() :
t in Terminals G() & d = TermVal(t) or t ==> {} & d = NTermVal(t, {}, {}) } and
 for n being Element of NAT holds f().(n+1) =
f().n \/ { [o, NTermVal(o, pr1 roots p, pr2 roots p)]-tree p
where o is Symbol of G(), p is Element of (f().n)* :
ex q being FinSequence of FinTrees [:the carrier of G(), D():] st
p = q & o ==> pr1 roots q };

definition
  let G be non empty DTConstrStr;

  func TS(G) -> Subset of FinTrees(the carrier of G) means


  (for d being Symbol of G st d in Terminals G holds root-tree d in it) &
  (for o being Symbol of G, p being FinSequence of it st o ==> roots p
  holds o-tree p in it) & for F being Subset of FinTrees the carrier of G st
  (for d being Symbol of G st d in Terminals G holds root-tree d in F) &
  (for o being Symbol of G, p being FinSequence of F st o ==> roots p
  holds o-tree p in F) holds it c= F;
end;

scheme 
 DTConstrInd{ G()->non empty DTConstrStr, P[set] }:
  for t being DecoratedTree of the carrier of G() st t in TS(G()) holds P[t]
provided
 for s being Symbol of G() st s in Terminals G() holds P[root-tree s] and
 for nt being Symbol of G(),
ts being FinSequence of TS(G()) st nt ==> roots ts &
for t being DecoratedTree of the carrier of G() st t in rng ts holds P[t]
holds P[nt-tree ts];

scheme 
 DTConstrIndDef{G()->non empty DTConstrStr, D()->non empty set,
  TermVal(set) -> Element of D(), NTermVal(set, set, set) -> Element of D() }:
  ex f being Function of TS(G()), D() st
  (for t being Symbol of G() st t in Terminals G()
  holds f.(root-tree t) = TermVal(t)) & for nt being Symbol of G(),
  ts being FinSequence of TS(G()) st nt ==> roots ts
  holds f.(nt-tree ts) = NTermVal(nt, roots ts, f * ts);

scheme 
 DTConstrUniqDef{G()->non empty DTConstrStr, D()->non empty set,
  TermVal(set) -> Element of D(), NTermVal(set, set, set) -> Element of D(),
  f1, f2() -> Function of TS(G()), D() }: f1() = f2()
provided
 (for t being Symbol of G() st t in Terminals G()
holds f1().(root-tree t) = TermVal(t)) & for nt being Symbol of G(),
ts being FinSequence of TS(G()) st nt ==> roots ts
holds f1().(nt-tree ts) = NTermVal(nt, roots ts, f1() * ts) and
 (for t being Symbol of G() st t in Terminals G()
holds f2().(root-tree t) = TermVal(t)) & for nt being Symbol of G(),
ts being FinSequence of TS(G()) st nt ==> roots ts
holds f2().(nt-tree ts) = NTermVal(nt, roots ts, f2() * ts);

begin

definition
  func PeanoNat -> strict non empty DTConstrStr means


  the carrier of it = {0, 1} &
  for x being Symbol of it, y being FinSequence of the carrier of it
  holds x ==> y iff x=1 & (y=<*0*> or y=<*1*>);
end;

begin



definition
  let G be non empty DTConstrStr;
  attr G is with_terminals means


  Terminals G <> {};
  attr G is with_nonterminals means


  NonTerminals G <> {};
  attr G is with_useful_nonterminals means


  for nt being Symbol of G st nt in NonTerminals G
  ex p being FinSequence of TS(G) st nt ==> roots p;
end;

registration
  cluster with_terminals with_nonterminals with_useful_nonterminals strict
    for non empty DTConstrStr;
end;

definition
  let G be with_terminals non empty DTConstrStr;
  redefine func Terminals G -> non empty Subset of G;
end;

registration
  let G be with_terminals non empty DTConstrStr;
  cluster TS G -> non empty;
end;

registration
  let G be with_useful_nonterminals non empty DTConstrStr;
  cluster TS G -> non empty;
end;

definition
  let G be with_nonterminals non empty DTConstrStr;
  redefine func NonTerminals G -> non empty Subset of G;
end;

definition
  let G be with_terminals non empty DTConstrStr;
  mode Terminal of G is Element of Terminals G;
end;

definition
  let G be with_nonterminals non empty DTConstrStr;
  mode NonTerminal of G is Element of NonTerminals G;
end;

definition
  let G be with_nonterminals with_useful_nonterminals non empty DTConstrStr;
  let nt be NonTerminal of G;
  mode SubtreeSeq of nt -> FinSequence of TS(G) means


    nt ==> roots it;
end;

definition
  let G be with_terminals non empty DTConstrStr;
  let t be Terminal of G;
  redefine func root-tree t -> Element of TS(G);
end;

definition
  let G be with_nonterminals with_useful_nonterminals non empty DTConstrStr;
  let nt be NonTerminal of G;
  let p be SubtreeSeq of nt;
  redefine func nt-tree p -> Element of TS(G);
end;

theorem 
  for G being with_terminals non empty DTConstrStr,
  tsg being Element of TS G, s being Terminal of G
  st tsg.{} = s holds tsg = root-tree s;

theorem 
  for G being with_terminals with_nonterminals non empty DTConstrStr,
  tsg being Element of TS G, nt being NonTerminal of G st tsg.{} = nt
  ex ts being FinSequence of TS G st tsg = nt-tree ts & nt ==> roots ts;

begin



registration
  cluster PeanoNat ->
    with_terminals with_nonterminals with_useful_nonterminals;
end;

definition
  let nt be NonTerminal of PeanoNat, t be Element of TS PeanoNat;
  redefine func nt-tree t -> Element of TS PeanoNat;
end;

definition
  let x be FinSequence of NAT;
  func plus-one x -> Element of NAT equals

  (x.1) + 1;
end;

definition
  func PN-to-NAT -> Function of TS(PeanoNat), NAT means


  (for t being Symbol of PeanoNat st t in Terminals PeanoNat
  holds it.(root-tree t) = 0) & for nt being Symbol of PeanoNat,
  ts being FinSequence of TS(PeanoNat) st nt ==> roots ts
  holds it.(nt-tree ts) = plus-one(it * ts);
end;

definition
  let x be Element of TS(PeanoNat);
  func PNsucc x -> Element of TS(PeanoNat) equals

  1-tree <*x*>;
end;

definition
  func NAT-to-PN -> Function of NAT, TS(PeanoNat) means


  it.0 = root-tree 0 & for n being Nat holds it.(n+1) = PNsucc it.n;
end;

theorem 
  for pn being Element of TS(PeanoNat) holds pn = NAT-to-PN.(PN-to-NAT.pn);

theorem 
  for n being Element of NAT holds n = PN-to-NAT.(NAT-to-PN.n);

begin



definition
  let G be non empty DTConstrStr, tsg be DecoratedTree of the carrier of G;

  assume
 tsg in TS G;
  func TerminalString tsg -> FinSequence of Terminals G means


  ex f being Function of (TS G), (Terminals G)* st it = f.tsg &
  (for t being Symbol of G st t in Terminals G
  holds f.(root-tree t) = <*t*>) & for nt being Symbol of G,
  ts being FinSequence of TS(G) st nt ==> roots ts
  holds f.(nt-tree ts) = FlattenSeq(f * ts);
  func PreTraversal tsg -> FinSequence of the carrier of G means


  ex f being Function of (TS G), (the carrier of G)* st it = f.tsg &
  (for t being Symbol of G st t in Terminals G
  holds f.(root-tree t) = <*t*>) & for nt being Symbol of G,
  ts being FinSequence of TS(G),
  rts being FinSequence st rts = roots ts & nt ==> rts
  for x being FinSequence of (the carrier of G)* st x = f * ts
  holds f.(nt-tree ts) = <*nt*>^FlattenSeq(x);
  func PostTraversal tsg -> FinSequence of the carrier of G means


  ex f being Function of (TS G), (the carrier of G)* st it = f.tsg &
  (for t being Symbol of G st t in Terminals G
  holds f.(root-tree t) = <*t*>) & for nt being Symbol of G,
  ts being FinSequence of TS(G),
  rts being FinSequence st rts = roots ts & nt ==> rts
  for x being FinSequence of (the carrier of G)* st x = f * ts
  holds f.(nt-tree ts) = FlattenSeq(x)^<*nt*>;
end;

definition
  let G be with_nonterminals non empty non empty DTConstrStr,
  nt be Symbol of G;
  func TerminalLanguage nt -> Subset of (Terminals G)* equals

  { TerminalString tsg where tsg is Element of FinTrees the carrier of G :
  tsg in TS G & tsg.{} = nt };
  func PreTraversalLanguage nt -> Subset of (the carrier of G)* equals

  { PreTraversal tsg where tsg is Element of FinTrees the carrier of G :
  tsg in TS G & tsg.{} = nt };
  func PostTraversalLanguage nt -> Subset of (the carrier of G)* equals

  { PostTraversal tsg where tsg is Element of FinTrees the carrier of G :
  tsg in TS G & tsg.{} = nt };
end;

theorem 
  for t being DecoratedTree of the carrier of PeanoNat
  st t in TS PeanoNat holds TerminalString t = <*0*>;

theorem 
  for nt being Symbol of PeanoNat holds TerminalLanguage nt = {<*0*>};

theorem 
  for t being Element of TS PeanoNat
  holds PreTraversal t = ((height dom t) |-> 1)^<*0*>;

theorem 
  for nt being Symbol of PeanoNat holds
  (nt = 0 implies PreTraversalLanguage nt = {<*0*>}) &
  (nt = 1 implies PreTraversalLanguage nt = { (n|->1)^<*0*>
  where n is Element of NAT : n <> 0 });

theorem 
  for t being Element of TS PeanoNat
  holds PostTraversal t = <*0*>^((height dom t) |-> 1);

theorem 
  for nt being Symbol of PeanoNat holds
  (nt = 0 implies PostTraversalLanguage nt = {<*0*>}) &
  (nt = 1 implies PostTraversalLanguage nt = { <*0*>^(n|->1)
  where n is Element of NAT : n <> 0 });
 


















begin





reserve U1,U2,U3 for Universal_Algebra,
  n,m for Nat,
  x,y,z for set,
  A,B for non empty set,
  h1 for FinSequence of [:A,B:];

definition
  let A,B;
  let h1;
  redefine func pr1 h1 -> FinSequence of A means


  len it = len h1 & for n st n in dom it holds it.n = (h1.n)`1;
  redefine func pr2 h1 -> FinSequence of B means


  len it = len h1 & for n st n in dom it holds it.n = (h1.n)`2;
end;

definition
  let A,B;
  let f1 be homogeneous quasi_total non empty PartFunc of A*,A;
  let f2 be homogeneous quasi_total non empty PartFunc of B*,B;
  assume
 arity (f1) = arity (f2);
  func [[:f1,f2:]] -> homogeneous quasi_total non empty PartFunc of ([:A,B:])*
  ,[:A,B:] means


  dom it = (arity f1)-tuples_on [:A,B:] & for h be
  FinSequence of [:A,B:] st h in dom it holds it.h = [f1.pr1 h,f2.pr2 h];
end;

reserve h1 for homogeneous quasi_total non empty PartFunc of (the carrier of
  U1)*,the carrier of U1,
  h2 for homogeneous quasi_total non empty PartFunc of (
  the carrier of U2)*,the carrier of U2;

definition
  let U1,U2;
  assume
 U1,U2 are_similar;
  func Opers(U1,U2) -> PFuncFinSequence of [:the carrier of U1,the carrier of
  U2:] means


  len it = len the charact of(U1) & for n st n in dom it holds
for h1,h2 st h1=(the charact of(U1)).n & h2=(the charact of(U2)).n holds it.n =
  [[:h1,h2:]];
end;

theorem 
  U1,U2 are_similar implies UAStr (# [:the carrier of U1,the
    carrier of U2:], Opers(U1,U2) #) is strict Universal_Algebra;

definition
  let U1,U2;
  assume
 U1,U2 are_similar;
  func [:U1,U2:] -> strict Universal_Algebra equals


  UAStr (# [:the
    carrier of U1,the carrier of U2:], Opers(U1,U2) #);
end;

definition
  let A,B be non empty set;
  func Inv (A,B) -> Function of [:A,B:],[:B,A:] means


  for a be Element of [:A,B:] holds it.a = [a`2,a`1];
end;

theorem 
  for A,B be non empty set holds rng (Inv (A,B)) = [:B,A:];

theorem 
  for A,B be non empty set holds Inv (A,B) is one-to-one;

theorem 
  U1,U2 are_similar implies Inv (the carrier of U1,the carrier of U2) is
  Function of the carrier of [:U1,U2:], the carrier of [:U2,U1:];

theorem 
  U1,U2 are_similar implies for o1 be operation of U1,o2 be
  operation of U2,o be operation of [:U1,U2:], n be Nat st o1 = (the charact of
  U1).n & o2 = (the charact of U2).n & o = (the charact of [:U1,U2:]).n & n in
dom the charact of(U1) holds arity o = arity o1 & arity o = arity o2 & o = [[:
  o1,o2:]];

theorem 
  U1,U2 are_similar implies [:U1,U2:],U1 are_similar;

theorem 
  for U1,U2,U3,U4 be Universal_Algebra st U1 is SubAlgebra of U2 & U3 is
SubAlgebra of U4 & U2,U4 are_similar holds [:U1,U3:] is SubAlgebra of [:U2,U4:]
;

begin





definition
  let k be Nat;
  func TrivialOp(k) -> PartFunc of {{}}*,{{}} means


  dom it = { k |-> {} } & rng it = {{}};
end;

registration
  let k be Nat;
  cluster TrivialOp k -> homogeneous quasi_total non empty;
end;

theorem 
  for k being Nat holds arity TrivialOp(k) = k;

definition
  let f be FinSequence of NAT;
  func TrivialOps(f) -> PFuncFinSequence of {{}} means


  len it = len f &
  for n st n in dom it for m st m = f.n holds it.n=TrivialOp(m);
end;

theorem 
  for f be FinSequence of NAT holds TrivialOps(f) is homogeneous
  quasi_total non-empty;

theorem 
  for f be FinSequence of NAT st f <> {} holds UAStr (#{{}},
    TrivialOps(f)#) is strict Universal_Algebra;

registration
  let D be non empty set;
  cluster non empty for Element of D*;
end;

definition
  let f be non empty FinSequence of NAT;
  func Trivial_Algebra(f) -> strict Universal_Algebra equals

  UAStr (#{{}},
    TrivialOps(f)#);
end;

begin





definition
  let IT be Function;
  attr IT is Univ_Alg-yielding means


  for x st x in dom IT holds IT.x is Universal_Algebra;
end;

definition
  let IT be Function;
  attr IT is 1-sorted-yielding means


  for x st x in dom IT holds IT.x is 1-sorted;
end;

registration
  cluster Univ_Alg-yielding for Function;
end;

registration
  cluster Univ_Alg-yielding -> 1-sorted-yielding for Function;
end;

registration
  let I be set;
  cluster 1-sorted-yielding for ManySortedSet of I;
end;

definition
  let IT be Function;
  attr IT is equal-signature means


  for x,y st x in dom IT & y in dom
IT holds for U1,U2 st U1 = IT.x & U2 = IT.y holds signature U1 = signature U2;
end;

registration
  let J be non empty set;
  cluster equal-signature Univ_Alg-yielding for ManySortedSet of J;
end;

definition
  let J be non empty set, A be 1-sorted-yielding ManySortedSet of J, j be
  Element of J;
  redefine func A.j -> 1-sorted;
end;

definition
  let J be non empty set, A be Univ_Alg-yielding ManySortedSet of J, j be
  Element of J;
  redefine func A.j -> Universal_Algebra;
end;

definition
  let J be set, A be 1-sorted-yielding ManySortedSet of J;
  func Carrier A -> ManySortedSet of J means


  for j be set st j in J ex
  R being 1-sorted st R = A.j & it.j = the carrier of R;
end;

registration
  let J be non empty set, A be Univ_Alg-yielding ManySortedSet of J;
  cluster Carrier A -> non-empty;
end;

definition
  let J be non empty set, A be equal-signature Univ_Alg-yielding ManySortedSet
  of J;
  func ComSign A -> FinSequence of NAT means


  for j be Element of J holds it = signature (A.j);
end;

registration
  let J be non empty set, B be non-empty ManySortedSet of J;
  cluster product B -> non empty;
end;

definition
  let J be non empty set, B be non-empty ManySortedSet of J;
  mode ManySortedOperation of B -> ManySortedFunction of J means


    for j
be Element of J holds it.j is homogeneous quasi_total non empty PartFunc of (B.
    j)*,B.j;
end;

definition
  let J be non empty set, B be non-empty ManySortedSet of J, O be
  ManySortedOperation of B, j be Element of J;
  redefine func O.j ->homogeneous quasi_total non empty PartFunc of (B.j)*,B.j;
end;

definition
  let IT be Function;
  attr IT is equal-arity means


  for x,y be set st x in dom IT & y in
dom IT for f,g be Function st IT.x = f & IT.y = g holds for n,m be Nat for X,Y
be non empty set st dom f = n-tuples_on X & dom g = m-tuples_on Y holds for o1
  be homogeneous quasi_total non empty PartFunc of X*,X, o2 be homogeneous
  quasi_total non empty PartFunc of Y*,Y st f = o1 & g = o2 holds arity o1 =
  arity o2;
end;

registration
  let J be non empty set, B be non-empty ManySortedSet of J;
  cluster equal-arity for ManySortedOperation of B;
end;

theorem 
  for J be non empty set, B be non-empty ManySortedSet of J, O be
  ManySortedOperation of B holds O is equal-arity iff for i,j be Element of J
  holds arity (O.i) = arity (O.j);

definition
  let F be Function-yielding Function, f be Function;
  func F..f -> Function means


  dom it = dom F & for x be set st x in dom F holds it.x = (F.x).(f.x);
end;

registration
  let I be set, f be (ManySortedFunction of I), x be ManySortedSet of I;
  cluster f..x -> I-defined;
end;

registration
  let I be set, f be (ManySortedFunction of I), x be ManySortedSet of I;
  cluster f..x -> total for I-defined Function;
end;

definition
  let I be set, f be (ManySortedFunction of I), x be ManySortedSet of I;
  redefine func f..x means


  dom it = I & for i be set st i in I holds
  for g be Function st g = f.i holds it.i = g.(x.i);
end;

registration
  let J be non empty set, B be non-empty ManySortedSet of J, p be FinSequence
  of product B;
  cluster uncurry p -> [:dom p, J:]-defined;
end;

registration
  let J be non empty set, B be non-empty ManySortedSet of J, p be FinSequence
  of product B;
  cluster uncurry p -> total for [:dom p, J:]-defined Function;
end;

registration
  let I,J be set, X be ManySortedSet of [:I,J:];
  cluster ~X -> [:J,I:]-defined;
end;

registration
  let I,J be set, X be ManySortedSet of [:I,J:];
  cluster ~X -> total for [:J,I:]-defined Function;
end;

registration
  let X be set, Y be non empty set, f be ManySortedSet of [:X,Y:];
  cluster curry f -> X-defined;
end;

registration
  let X be set, Y be non empty set, f be ManySortedSet of [:X,Y:];
  cluster curry f -> total for X-defined Function;
end;

definition
  let J be non empty set, B be non-empty ManySortedSet of J, O be equal-arity
  ManySortedOperation of B;
  func ComAr(O) -> Nat means


  for j be Element of J holds it = arity (O .j);
end;

definition
  let I be set, A be ManySortedSet of I;
  func EmptySeq(A) -> ManySortedSet of I means


  for i be set st i in I holds it.i = {}(A.i);
end;

definition
  let J be non empty set, B be non-empty ManySortedSet of J, O be equal-arity
  ManySortedOperation of B;
  func [[: O :]] -> homogeneous quasi_total non empty PartFunc of (product B)*
  ,(product B) means

  dom it = (ComAr O)-tuples_on (product B) & for p being
  Element of (product B)* st p in dom it holds ( dom p = {} implies it.p = O..(
  EmptySeq B) ) & ( dom p <> {} implies for Z be non empty set, w be
ManySortedSet of [:J,Z:] st Z = dom p & w = ~uncurry p holds it.p = O..(curry w
  ));
end;

definition
  let J be non empty set, A be equal-signature Univ_Alg-yielding ManySortedSet
  of J, n be Nat;
  assume
 n in dom (ComSign A);
  func ProdOp(A,n) -> equal-arity ManySortedOperation of (Carrier A) means

  for
j be Element of J holds for o be operation of A.j st (the charact of A.j).n = o
  holds it.j = o;
end;

definition
  let J be non empty set, A be equal-signature Univ_Alg-yielding ManySortedSet
  of J;
  func ProdOpSeq(A) -> PFuncFinSequence of product Carrier A means


  len
  it = len (ComSign A) & for n st n in dom it holds it.n = [[: ProdOp(A,n) :]];
end;

definition
  let J be non empty set, A be equal-signature Univ_Alg-yielding ManySortedSet
  of J;
  func ProdUnivAlg A -> strict Universal_Algebra equals

  UAStr (# product
    Carrier A, ProdOpSeq(A) #);
end;














begin 

scheme 

  RelStrEx {X() -> non empty set, P[set,set]}: ex L being non empty strict
RelStr st the carrier of L = X() & for a,b being Element of L holds a <= b iff
  P[a,b];

definition
  let A be non empty RelStr;
  redefine attr A is reflexive means

  for x being Element of A holds x <= x;
end;

definition
  let A be RelStr;
  redefine attr A is transitive means

  for x,y,z being Element of A st x <= y & y <= z holds x <= z;
  redefine attr A is antisymmetric means

  for x,y being Element of A st x <= y & y <= x holds x = y;
end;

registration
  cluster complete -> with_suprema with_infima for non empty RelStr;
  cluster -> complete transitive antisymmetric
         for 1-element reflexive RelStr;
end;

registration
  let x be set;
  let R be Relation of {x};
  cluster RelStr(#{x},R#) -> 1-element;
end;

registration
  cluster strict 1-element reflexive for RelStr;
end;

theorem 
  for P1,P2 being RelStr st the RelStr of P1 = the RelStr of P2 for
  a1,b1 being Element of P1 for a2,b2 being Element of P2 st a1 = a2 & b1 = b2
  holds (a1 <= b1 implies a2 <= b2) & (a1 < b1 implies a2 < b2);

theorem 
  for P1,P2 being RelStr st the RelStr of P1 = the RelStr of P2 for
  X being set for a1 being Element of P1 for a2 being Element of P2 st a1 = a2
  holds (X is_<=_than a1 implies X is_<=_than a2) & (X is_>=_than a1 implies X
  is_>=_than a2);

theorem 
  for P1,P2 being RelStr st the RelStr of P1 = the RelStr of P2 & P1 is
  complete holds P2 is complete;

theorem 
  for L being transitive RelStr, x,y being Element of L st x <= y
for X being set holds (y is_<=_than X implies x is_<=_than X) & (x is_>=_than X
  implies y is_>=_than X);

theorem 
  for L being non empty RelStr, X being set, x being Element of L
holds (x is_>=_than X iff x is_>=_than X /\ the carrier of L) & (x is_<=_than X
  iff x is_<=_than X /\ the carrier of L);

theorem 
  for L being RelStr, a being Element of L holds {} is_<=_than a &
  {} is_>=_than a;

theorem 
  for L being RelStr, a,b being Element of L holds (a is_<=_than {b
  } iff a <= b) & (a is_>=_than {b} iff b <= a);

theorem 
  for L being RelStr, a,b,c being Element of L holds (a is_<=_than
  {b,c} iff a <= b & a <= c) & (a is_>=_than {b,c} iff b <= a & c <= a);

theorem 
  for L being RelStr, X,Y being set st X c= Y for x being Element
of L holds (x is_<=_than Y implies x is_<=_than X) & (x is_>=_than Y implies x
  is_>=_than X);

theorem 
  for L being RelStr, X,Y being set, x being Element of L holds (x
is_<=_than X & x is_<=_than Y implies x is_<=_than X \/ Y) & (x is_>=_than X &
  x is_>=_than Y implies x is_>=_than X \/ Y);

theorem 
  for L being transitive RelStr for X being set, x,y being Element
  of L st X is_<=_than x & x <= y holds X is_<=_than y;

theorem 
  for L being transitive RelStr for X being set, x,y being Element
  of L st X is_>=_than x & x >= y holds X is_>=_than y;

registration
  let L be non empty RelStr;
  cluster [#]L -> non empty;
end;

begin 

definition
  let L be RelStr;
  attr L is lower-bounded means


  ex x being Element of L st x is_<=_than the carrier of L;
  attr L is upper-bounded means


  ex x being Element of L st x is_>=_than the carrier of L;
end;

definition
  let L be RelStr;
  attr L is bounded means

  L is lower-bounded upper-bounded;
end;

theorem 
  for P1,P2 being RelStr st the RelStr of P1 = the RelStr of P2 holds (
P1 is lower-bounded implies P2 is lower-bounded) & (P1 is upper-bounded implies
  P2 is upper-bounded);

registration
  cluster complete -> bounded for non empty RelStr;
  cluster bounded -> lower-bounded upper-bounded for RelStr;
  cluster lower-bounded upper-bounded -> bounded for RelStr;
end;

registration
  cluster complete for non empty Poset;
end;

definition
  let L be RelStr;
  let X be set;
  pred ex_sup_of X,L means


  ex a being Element of L st X is_<=_than a &
(for b being Element of L st X is_<=_than b holds b >= a) & for c being Element
of L st X is_<=_than c & for b being Element of L st X is_<=_than b holds b >=
  c holds c = a;
  pred ex_inf_of X,L means


  ex a being Element of L st X is_>=_than a &
(for b being Element of L st X is_>=_than b holds b <= a) & for c being Element
of L st X is_>=_than c & for b being Element of L st X is_>=_than b holds b <=
  c holds c = a;
end;

theorem 
  for L1,L2 being RelStr st the RelStr of L1 = the RelStr of L2
for X being set holds (ex_sup_of X,L1 implies ex_sup_of X,L2) & (ex_inf_of X,L1
  implies ex_inf_of X,L2);

theorem 
  for L being antisymmetric RelStr, X being set holds ex_sup_of X,
L iff ex a being Element of L st X is_<=_than a & for b being Element of L st X
  is_<=_than b holds a <= b;

theorem 
  for L being antisymmetric RelStr, X being set holds ex_inf_of X,
L iff ex a being Element of L st X is_>=_than a & for b being Element of L st X
  is_>=_than b holds a >= b;

theorem 
  for L being complete non empty antisymmetric RelStr, X being set
  holds ex_sup_of X,L & ex_inf_of X,L;

theorem 
  for L being antisymmetric RelStr for a,b,c being Element of L
holds c = a"\/"b & ex_sup_of {a,b},L iff c >= a & c >= b & for d being Element
  of L st d >= a & d >= b holds c <= d;

theorem 
  for L being antisymmetric RelStr for a,b,c being Element of L
holds c = a"/\"b & ex_inf_of {a,b},L iff c <= a & c <= b & for d being Element
  of L st d <= a & d <= b holds c >= d;

theorem 
  for L being antisymmetric RelStr holds L is with_suprema iff for
  a,b being Element of L holds ex_sup_of {a,b},L;

theorem 
  for L being antisymmetric RelStr holds L is with_infima iff for
  a,b being Element of L holds ex_inf_of {a,b},L;

theorem 
  for L being antisymmetric with_suprema RelStr for a,b,c being
Element of L holds c = a"\/"b iff c >= a & c >= b & for d being Element of L st
  d >= a & d >= b holds c <= d;

theorem 
  for L being antisymmetric with_infima RelStr for a,b,c being
Element of L holds c = a"/\"b iff c <= a & c <= b & for d being Element of L st
  d <= a & d <= b holds c >= d;

theorem 
  for L being antisymmetric reflexive with_suprema RelStr for a,b being
  Element of L holds a = a"\/"b iff a >= b;

theorem 
  for L being antisymmetric reflexive with_infima RelStr for a,b being
  Element of L holds a = a"/\"b iff a <= b;

definition
  let L be RelStr;
  let X be set;
  func "\/"(X,L) -> Element of L means


  X is_<=_than it & for a being
  Element of L st X is_<=_than a holds it <= a if ex_sup_of X,L;
  func "/\"(X,L) -> Element of L means


  X is_>=_than it & for a being
  Element of L st X is_>=_than a holds a <= it if ex_inf_of X,L;
end;

theorem 
  for L1,L2 being RelStr st the RelStr of L1 = the RelStr of L2 for X
  being set st ex_sup_of X,L1 holds "\/"(X,L1) = "\/"(X,L2);

theorem 
  for L1,L2 being RelStr st the RelStr of L1 = the RelStr of L2 for X
  being set st ex_inf_of X,L1 holds "/\"(X,L1) = "/\"(X,L2);

theorem 
  for L being complete non empty Poset, X being set holds "\/"(X,L) =
  "\/"(X, latt L) & "/\"(X,L) = "/\"(X, latt L);

theorem 
  for L being complete Lattice, X being set holds "\/"(X,L) = "\/"(X,
  LattPOSet L) & "/\"(X,L) = "/\"(X, LattPOSet L);

theorem 
  for L being antisymmetric RelStr for a being Element of L, X
being set holds a = "\/"(X,L) & ex_sup_of X,L iff a is_>=_than X & for b being
  Element of L st b is_>=_than X holds a <= b;

theorem 
  for L being antisymmetric RelStr for a being Element of L, X
being set holds a = "/\"(X,L) & ex_inf_of X,L iff a is_<=_than X & for b being
  Element of L st b is_<=_than X holds a >= b;

theorem 
  for L being complete antisymmetric non empty RelStr for a being
Element of L, X being set holds a = "\/"(X,L) iff a is_>=_than X & for b being
  Element of L st b is_>=_than X holds a <= b;

theorem 
  for L being complete antisymmetric non empty RelStr for a being
Element of L, X being set holds a = "/\"(X,L) iff a is_<=_than X & for b being
  Element of L st b is_<=_than X holds a >= b;

theorem 
  for L being RelStr, X,Y being set st X c= Y & ex_sup_of X,L &
  ex_sup_of Y,L holds "\/"(X,L) <= "\/"(Y,L);

theorem 
  for L being RelStr, X,Y being set st X c= Y & ex_inf_of X,L &
  ex_inf_of Y,L holds "/\"(X,L) >= "/\"(Y,L);

theorem 
  for L being antisymmetric transitive RelStr, X,Y being set st
  ex_sup_of X,L & ex_sup_of Y,L & ex_sup_of X \/ Y, L holds "\/"(X \/ Y, L) =
  "\/"(X,L)"\/""\/"(Y,L);

theorem 
  for L being antisymmetric transitive RelStr, X,Y being set st
  ex_inf_of X,L & ex_inf_of Y,L & ex_inf_of X \/ Y, L holds "/\"(X \/ Y, L) =
  "/\"(X,L) "/\" "/\"(Y,L);

notation
  let L be RelStr;
  let X be Subset of L;
  synonym sup X for "\/"(X,L);
  synonym inf X for "/\"(X,L);
end;

theorem 
  for L being non empty reflexive antisymmetric RelStr for a being
  Element of L holds ex_sup_of {a},L & ex_inf_of {a},L;

theorem 
  for L being non empty reflexive antisymmetric RelStr for a being
  Element of L holds sup {a} = a & inf {a} = a;

theorem 
  for L being with_infima Poset, a,b being Element of L holds inf
  {a,b} = a"/\"b;

theorem 
  for L being with_suprema Poset, a,b being Element of L holds sup
  {a,b} = a"\/" b;

theorem 
  for L being lower-bounded antisymmetric non empty RelStr holds
  ex_sup_of {},L & ex_inf_of the carrier of L, L;

theorem 
  for L being upper-bounded antisymmetric non empty RelStr holds
  ex_inf_of {},L & ex_sup_of the carrier of L, L;

definition
  let L be RelStr;
  func Bottom L -> Element of L equals

  "\/"({},L);
  func Top L -> Element of L equals

  "/\"({},L);
end;

theorem 
  for L being lower-bounded antisymmetric non empty RelStr for x being
  Element of L holds Bottom L <= x;

theorem 
  for L being upper-bounded antisymmetric non empty RelStr for x being
  Element of L holds x <= Top L;

theorem 
  for L being non empty RelStr, X,Y being set st for x being
  Element of L holds x is_>=_than X iff x is_>=_than Y holds ex_sup_of X,L
  implies ex_sup_of Y,L;

theorem 
  for L being non empty RelStr, X,Y being set st ex_sup_of X,L &
for x being Element of L holds x is_>=_than X iff x is_>=_than Y holds "\/"(X,L
  ) = "\/"(Y,L);

theorem 
  for L being non empty RelStr, X,Y being set st for x being
  Element of L holds x is_<=_than X iff x is_<=_than Y holds ex_inf_of X,L
  implies ex_inf_of Y,L;

theorem 
  for L being non empty RelStr, X,Y being set st ex_inf_of X,L &
for x being Element of L holds x is_<=_than X iff x is_<=_than Y holds "/\"(X,L
  ) = "/\"(Y,L);

theorem 
  for L being non empty RelStr, X being set holds (ex_sup_of X,L
iff ex_sup_of X /\ the carrier of L, L) & (ex_inf_of X,L iff ex_inf_of X /\ the
  carrier of L, L);

theorem 
  for L being non empty RelStr, X being set st ex_sup_of X,L or
ex_sup_of X /\ the carrier of L, L holds "\/"(X,L) = "\/"(X /\ the carrier of L
  , L);

theorem 
  for L being non empty RelStr, X being set st ex_inf_of X,L or
ex_inf_of X /\ the carrier of L, L holds "/\"(X,L) = "/\"(X /\ the carrier of L
  , L);

theorem 
  for L being non empty RelStr st for X being Subset of L holds
  ex_sup_of X,L holds L is complete;

theorem 
  for L being non empty Poset holds L is with_suprema iff for X being
  finite non empty Subset of L holds ex_sup_of X,L;

theorem 
  for L being non empty Poset holds L is with_infima iff for X being
  finite non empty Subset of L holds ex_inf_of X,L;

begin

definition
  let L be RelStr;
  mode SubRelStr of L -> RelStr means


    the carrier of it c= the carrier
    of L & the InternalRel of it c= the InternalRel of L;
end;

definition
  let L be RelStr;
  let S be SubRelStr of L;
  attr S is full means


  the InternalRel of S = (the InternalRel of L) |_2 the carrier of S;
end;

registration
  let L be RelStr;
  cluster strict full for SubRelStr of L;
end;

registration
  let L be non empty RelStr;
  cluster non empty full strict for SubRelStr of L;
end;

theorem 
  for L being RelStr, X being Subset of L holds RelStr(#X, (the
    InternalRel of L)|_2 X#) is full SubRelStr of L;

theorem 
  for L being RelStr, S1,S2 being full SubRelStr of L st the
  carrier of S1 = the carrier of S2 holds the RelStr of S1 = the RelStr of S2;

definition
  let L be RelStr;
  let X be Subset of L;
  func subrelstr X -> full strict SubRelStr of L means

  the carrier of it = X;
end;

theorem 
  for L being non empty RelStr, S being non empty SubRelStr of L
  for x being Element of S holds x is Element of L;

theorem 
  for L being RelStr, S being SubRelStr of L for a,b being Element
  of L for x,y being Element of S st x = a & y = b & x <= y holds a <= b;

theorem 
  for L being RelStr, S being full SubRelStr of L for a,b being
  Element of L for x,y being Element of S st x = a & y = b & a <= b & x in the
  carrier of S holds x <= y;

theorem 
  for L being non empty RelStr, S being non empty full SubRelStr
  of L for X being set, a being Element of L for x being Element of S st x = a
  holds (a is_<=_than X implies x is_<=_than X) & (a is_>=_than X implies x
  is_>=_than X);

theorem 
  for L being non empty RelStr, S being non empty SubRelStr of L
for X being Subset of S for a being Element of L for x being Element of S st x
  = a holds (x is_<=_than X implies a is_<=_than X) & (x is_>=_than X implies a
  is_>=_than X);

registration
  let L be reflexive RelStr;
  cluster -> reflexive for full SubRelStr of L;
end;

registration
  let L be transitive RelStr;
  cluster -> transitive for full SubRelStr of L;
end;

registration
  let L be antisymmetric RelStr;
  cluster -> antisymmetric for full SubRelStr of L;
end;

definition
  let L be non empty RelStr;
  let S be SubRelStr of L;
  attr S is meet-inheriting means


  for x,y being Element of L st x in
the carrier of S & y in the carrier of S & ex_inf_of {x,y},L holds inf {x,y} in
  the carrier of S;
  attr S is join-inheriting means


  for x,y being Element of L st x in
the carrier of S & y in the carrier of S & ex_sup_of {x,y},L holds sup {x,y} in
  the carrier of S;
end;

definition
  let L be non empty RelStr;
  let S be SubRelStr of L;
  attr S is infs-inheriting means

  for X being Subset of S st ex_inf_of X,L holds "/\"(X,L) in the carrier of S;
  attr S is sups-inheriting means

  for X being Subset of S st ex_sup_of X,L holds "\/"(X,L) in the carrier of S;
end;

registration
  let L be non empty RelStr;
  cluster infs-inheriting -> meet-inheriting for SubRelStr of L;
  cluster sups-inheriting -> join-inheriting for SubRelStr of L;
end;

registration
  let L be non empty RelStr;
  cluster infs-inheriting sups-inheriting non empty full strict for
SubRelStr of L;
end;

theorem 
  for L being non empty transitive RelStr for S being non empty
full SubRelStr of L for X being Subset of S st ex_inf_of X,L & "/\"(X,L) in the
  carrier of S holds ex_inf_of X,S & "/\"(X,S) = "/\"(X,L);

theorem 
  for L being non empty transitive RelStr for S being non empty
full SubRelStr of L for X being Subset of S st ex_sup_of X,L & "\/"(X,L) in the
  carrier of S holds ex_sup_of X,S & "\/"(X,S) = "\/"(X,L);

theorem 
  for L being non empty transitive RelStr for S being non empty full
SubRelStr of L for x,y being Element of S st ex_inf_of {x,y},L & "/\"({x,y},L)
in the carrier of S holds ex_inf_of {x,y},S & "/\"({x,y},S) = "/\"({x,y},L);

theorem 
  for L being non empty transitive RelStr for S being non empty full
SubRelStr of L for x,y being Element of S st ex_sup_of {x,y},L & "\/"({x,y},L)
in the carrier of S holds ex_sup_of {x,y},S & "\/"({x,y},S) = "\/"({x,y},L);

registration
  let L be with_infima antisymmetric transitive RelStr;
  cluster -> with_infima for non empty meet-inheriting full SubRelStr of L;
end;

registration
  let L be with_suprema antisymmetric transitive RelStr;
  cluster -> with_suprema for non empty join-inheriting full SubRelStr of L;
end;

theorem 
  for L being complete non empty Poset for S being non empty full
  SubRelStr of L for X being Subset of S st "/\"(X,L) in the carrier of S holds
  "/\"(X,S) = "/\"(X,L);

theorem 
  for L being complete non empty Poset for S being non empty full
  SubRelStr of L for X being Subset of S st "\/"(X,L) in the carrier of S holds
  "\/"(X,S) = "\/"(X,L);

theorem 
  for L being with_infima Poset for S being meet-inheriting non empty
full SubRelStr of L for x,y being Element of S, a,b be Element of L st a = x &
  b = y holds x"/\"y = a"/\"b;

theorem 
  for L being with_suprema Poset for S being join-inheriting non empty
full SubRelStr of L for x,y being Element of S, a,b be Element of L st a = x &
  b = y holds x"\/"y = a"\/"b;














begin 

theorem 
  for C being Category,
    D being non empty non void CatStr
   st the CatStr of C = the CatStr of D holds
      D is Category-like transitive associative reflexive with_identities;

definition
  let IT be non void non empty CatStr;
  attr IT is with_triple-like_morphisms means


  for f being Morphism of IT ex x being set st f = [[dom f, cod f], x];
end;

registration
  cluster with_triple-like_morphisms for strict Category;
end;

theorem 
  for C being with_triple-like_morphisms non void non empty CatStr,
  f being Morphism of C holds
  dom f = f`11 & cod f = f`12 & f = [[dom f, cod f], f`2];

definition
  let C be with_triple-like_morphisms non void non empty CatStr;
  let f be Morphism of C;
  redefine func f`11 -> Object of C;
  redefine func f`12 -> Object of C;
end;

scheme 
 CatEx { A, B() -> non empty set, P[set, set, set], F(set,set) -> set }:
  ex C being with_triple-like_morphisms strict Category st
  the carrier of C = A() &
  (for a,b being Element of A(), f being Element of B() st
      P[a,b,f] holds [[a,b],f] is Morphism of C) &
  (for m being Morphism of C
  ex a,b being Element of A(), f being Element of B() st
    m = [[a,b],f] & P[a,b,f]) &
    for m1,m2 being (Morphism of C), a1,a2,a3 being Element of A(),
        f1,f2 being Element of B() st m1 = [[a1,a2],f1] & m2 = [[a2,a3],f2]
  holds m2(*)m1 = [[a1,a3], F(f2,f1)]
provided
 for a,b,c being Element of A(), f,g being Element of B() st
   P[a,b,f] & P[b,c,g] holds F(g,f) in B() & P[a,c,F(g,f)] and
 for a being Element of A()
   ex f being Element of B() st P[a,a,f] &
    for b being Element of A(), g being Element of B() holds
    (P[a,b,g] implies F(g,f) = g) & (P[b,a,g] implies F(f,g) = g) and
 for a,b,c,d being Element of A(), f,g,h being Element of B() st
   P[a,b,f] & P[b,c,g] & P[c,d,h] holds F(h, F(g,f)) = F(F(h,g), f);

scheme 
 CatUniq
  { A, B() -> non empty set, P[set, set, set], F(set,set) -> set }:
  for C1, C2 being strict with_triple-like_morphisms Category st
  the carrier of C1 = A() &
  (for a,b being Element of A(), f being Element of B() st
  P[a,b,f] holds [[a,b],f] is Morphism of C1) & (for m being Morphism of C1
  ex a,b being Element of A(), f being Element of B() st
  m = [[a,b],f] & P[a,b,f]) &
  (for m1,m2 being (Morphism of C1), a1,a2,a3 being Element of A(),
  f1,f2 being Element of B() st m1 = [[a1,a2],f1] & m2 = [[a2,a3],f2]
  holds m2(*)m1 = [[a1,a3], F(f2,f1)]) & the carrier of C2 = A() &
  (for a,b being Element of A(), f being Element of B() st
  P[a,b,f] holds [[a,b],f] is Morphism of C2) & (for m being Morphism of C2
  ex a,b being Element of A(), f being Element of B() st
  m = [[a,b],f] & P[a,b,f]) &
  for m1,m2 being (Morphism of C2), a1,a2,a3 being Element of A(),
  f1,f2 being Element of B() st m1 = [[a1,a2],f1] & m2 = [[a2,a3],f2]
  holds m2(*)m1 = [[a1,a3], F(f2,f1)] holds C1 = C2
provided
 for a being Element of A() ex f being Element of B() st P[a,a,f] &
for b being Element of A(), g being Element of B() holds
(P[a,b,g] implies F(g,f) = g) & (P[b,a,g] implies F(f,g) = g);

scheme 
 FunctorEx { A,B() -> Category, O(set) -> Object of B(),
  F(set) -> set }: ex F being Functor of A(),B() st
  for f being Morphism of A() holds F.f = F(f)
provided
 for f being Morphism of A() holds F(f) is Morphism of B() &
for g being Morphism of B() st g = F(f) holds
dom g = O(dom f) & cod g = O(cod f) and
 for a being Object of A() holds F(id a) = id O(a) and
 for f1,f2 being Morphism of A() for g1,g2 being Morphism of B() st
g1 = F(f1) & g2 = F(f2) & dom f2 = cod f1 holds F(f2(*)f1) = g2(*)g1;

theorem 
  for C1 being Category, C2 being Subcategory of C1 st C1 is Subcategory of C2
  holds the CatStr of C1 = the CatStr of C2;

theorem 
  for C being Category, D being Subcategory of C, E being Subcategory of D
  holds E is Subcategory of C;

definition
  let C1,C2 be Category;
  given C being Category such that
 C1 is Subcategory of C and
 C2 is Subcategory of C;
  given o1 being Object of C1 such that
 o1 is Object of C2;
  func C1 /\ C2 -> strict Category means


   the carrier of it = (the carrier of C1) /\ the carrier of C2 &
  the carrier' of it = (the carrier' of C1) /\ the carrier' of C2 &
  the Source of it = (the Source of C1)|the carrier' of C2 &
  the Target of it = (the Target of C1)|the carrier' of C2 &
  the Comp of it = (the Comp of C1)||the carrier' of C2;
end;

reserve C for Category,
  C1,C2 for Subcategory of C;

theorem 
  the carrier of C1 meets the carrier of C2 implies C1 /\ C2 = C2 /\ C1;

theorem 
  the carrier of C1 meets the carrier of C2 implies
  C1 /\ C2 is Subcategory of C1 & C1 /\ C2 is Subcategory of C2;

definition
  let C,D be Category;
  let F be Functor of C,D;
  func Image F -> strict Subcategory of D means


  the carrier of it = rng Obj F & rng F c= the carrier' of it &
  for E being Subcategory of D st
  the carrier of E = rng Obj F & rng F c= the carrier' of E
  holds it is Subcategory of E;
end;

theorem 
  for C,D being Category, E be Subcategory of D, F being Functor of C,D st
  rng F c= the carrier' of E holds F is Functor of C, E;

theorem 
  for C,D being Category, F being Functor of C,D holds
  F is Functor of C, Image F;

theorem 
  for C,D being Category, E being Subcategory of D, F being Functor of C,E
  for G being Functor of C,D st F = G holds Image F = Image G;

begin 

definition
  let IT be set;
  attr IT is categorial means


  for x being set st x in IT holds x is Category;
end;

definition
  let X be non empty set;
  redefine attr X is categorial means


   for x being Element of X holds x is Category;
end;

registration
  cluster categorial for non empty set;
end;

definition
  let X be non empty categorial set;
  redefine mode Element of X -> Category;
end;

definition
  let C be Category;
  attr C is Categorial means


  the carrier of C is categorial &
  (for a being Object of C, A being Category st a = A holds
  id a = [[A,A], id A]) & (for m being Morphism of C
  for A,B being Category st A = dom m & B = cod m
  ex F being Functor of A,B st m = [[A,B], F]) & for m1,m2 being Morphism of C
  for A,B,C being Category for F being Functor of A,B
  for G being Functor of B,C st m1 = [[A,B],F] & m2 = [[B,C],G]
  holds m2(*)m1 = [[A,C],G*F];
end;

registration
  cluster Categorial -> with_triple-like_morphisms for Category;
end;

theorem 
  for C,D being Category st the CatStr of C = the CatStr of D holds
  C is Categorial implies D is Categorial;

theorem 
  for C being Category holds 1Cat(C, [[C,C], id C]) is Categorial;

registration
  cluster Categorial for strict Category;
end;

theorem 
  for C being Categorial Category, a being Object of C holds a is Category;

theorem 
  for C being Categorial Category, f being Morphism of C holds
  dom f = f`11 & cod f = f`12;

definition
  let C be Categorial Category;
  let m be Morphism of C;
  redefine func m`11 -> Category;
  redefine func m`12 -> Category;
end;

theorem 
  for C1, C2 being Categorial Category st
  the carrier of C1 = the carrier of C2 &
  the carrier' of C1 = the carrier' of C2
  holds the CatStr of C1 = the CatStr of C2;

registration
  let C be Categorial Category;
  cluster -> Categorial for Subcategory of C;
end;

theorem 
  for C,D being Categorial Category st the carrier' of C c= the carrier' of D
  holds C is Subcategory of D;

definition
  let a be set such that
 a is Category;
  func cat a -> Category equals


  a;
end;

theorem 
  for C being Categorial Category, c being Object of C holds cat c = c;

definition
  let C be Categorial Category;
  let m be Morphism of C;
  redefine func m`2 -> Functor of cat dom m, cat cod m;
end;

theorem 
  for X being categorial non empty set, Y being non empty set st
  (for A,B,C being Element of X
  for F being Functor of A,B, G being Functor of B,C st
  F in Y & G in Y holds G*F in Y) & (for A being Element of X holds id A in Y)
  ex C being strict Categorial Category st the carrier of C = X &
  for A,B being Element of X, F being Functor of A,B holds
  [[A,B],F] is Morphism of C iff F in Y;

theorem 
  for X being categorial non empty set, Y being non empty set
  for C1, C2 being strict Categorial Category st the carrier of C1 = X &
  (for A,B being Element of X, F being Functor of A,B holds
  [[A,B],F] is Morphism of C1 iff F in Y) & the carrier of C2 = X &
  (for A,B being Element of X, F being Functor of A,B holds
  [[A,B],F] is Morphism of C2 iff F in Y) holds C1 = C2;

definition
  let IT be Categorial Category;
  attr IT is full means


  for a,b being Category st a is Object of IT & b is Object of IT
  for F being Functor of a, b holds [[a,b],F] is Morphism of IT;
end;

registration
  cluster full for Categorial strict Category;
end;

theorem 
  for C1,C2 being full Categorial Category st
  the carrier of C1 = the carrier of C2 holds
  the CatStr of C1 = the CatStr of C2;

theorem 
  for A being categorial non empty set
  ex C being full Categorial strict Category st the carrier of C = A;

theorem 
  for C being Categorial Category, D being full Categorial Category st
  the carrier of C c= the carrier of D holds C is Subcategory of D;

theorem 
  for C being Category, D1,D2 being Categorial Category
  for F1 being Functor of C,D1 for F2 being Functor of C,D2 st
  F1 = F2 holds Image F1 = Image F2;

begin 

definition
  let C be Category;
  let o be Object of C;
  func Hom o -> Subset of the carrier' of C equals

  (the Target of C)"{o};
  func o Hom -> Subset of the carrier' of C equals

  (the Source of C)"{o};
end;

registration
  let C be Category;
  let o be Object of C;
  cluster Hom o -> non empty;
  cluster o Hom -> non empty;
end;

theorem 
  for C being Category, a being Object of C, f being Morphism of C holds
  f in Hom a iff cod f = a;

theorem 
  for C being Category, a being Object of C, f being Morphism of C holds
  f in a Hom iff dom f = a;

theorem 
  for C being Category, a,b being Object of C holds
  Hom(a,b) = (a Hom) /\ (Hom b);

theorem 
  for C being Category, f being Morphism of C holds
  f in (dom f) Hom & f in Hom (cod f);

theorem 
  for C being Category, f being (Morphism of C), g being Element of Hom dom f
  holds f(*)g in Hom cod f;

theorem 
  for C being Category, f being (Morphism of C),
  g being Element of (cod f) Hom holds g(*)f in (dom f) Hom;

definition
  let C be Category, o be Object of C;
  func C-SliceCat(o) -> strict with_triple-like_morphisms Category means

 the carrier of it = Hom o &
  (for a,b being Element of Hom o, f being Morphism of C st
  dom b = cod f & a = b(*)f holds [[a,b],f] is Morphism of it) &
  (for m being Morphism of it
  ex a,b being Element of Hom o, f being Morphism of C st
  m = [[a,b],f] & dom b = cod f & a = b(*)f) &
  for m1,m2 being (Morphism of it), a1,a2,a3 being Element of Hom o,
  f1,f2 being Morphism of C st m1 = [[a1,a2],f1] & m2 = [[a2,a3],f2]
  holds m2(*)m1 = [[a1,a3], f2(*)f1];
  func o-SliceCat(C) -> strict with_triple-like_morphisms Category means


   the carrier of it = o Hom &
  (for a,b being Element of o Hom, f being Morphism of C st
  dom f = cod a & f(*)a = b holds [[a,b],f] is Morphism of it) &
  (for m being Morphism of it
  ex a,b being Element of o Hom, f being Morphism of C st
  m = [[a,b],f] & dom f = cod a & f(*)a = b) &
  for m1,m2 being (Morphism of it), a1,a2,a3 being Element of o Hom,
  f1,f2 being Morphism of C st m1 = [[a1,a2],f1] & m2 = [[a2,a3],f2]
  holds m2(*)m1 = [[a1,a3], f2(*)f1];
end;

definition
  let C be Category;
  let o be Object of C;
  let m be Morphism of C-SliceCat(o);
  redefine func m`2 -> Morphism of C;
  redefine func m`11 -> Element of Hom o;
  redefine func m`12 -> Element of Hom o;
end;

theorem 
  for C being Category, a being Object of C, m being Morphism of C-SliceCat a
  holds m = [[m`11,m`12],m`2] & dom m`12 = cod m`2 & m`11 = m`12(*)m`2 &
  dom m = m`11 & cod m = m`12;

theorem 
  for C being Category, o being Object of C, f being Element of Hom o
  for a being Object of C-SliceCat o st a = f holds id a = [[a,a], id dom f];

definition
  let C be Category;
  let o be Object of C;
  let m be Morphism of o-SliceCat(C);
  redefine func m`2 -> Morphism of C;
  redefine func m`11 -> Element of o Hom;
  redefine func m`12 -> Element of o Hom;
end;

theorem 
  for C being Category, a being Object of C, m being Morphism of a-SliceCat C
  holds m = [[m`11,m`12],m`2] & dom m`2 = cod m`11 & m`2(*)m`11 = m`12 &
  dom m = m`11 & cod m = m`12;

theorem 
  for C being Category, o being Object of C, f being Element of o Hom
  for a being Object of o-SliceCat C st a = f holds id a = [[a,a], id cod f];

begin 

definition
  let C be Category, f be Morphism of C;
  func SliceFunctor f -> Functor of C-SliceCat dom f, C-SliceCat cod f means


   for m being Morphism of C-SliceCat dom f holds
  it.m = [[f(*)m`11, f(*)m`12], m`2];
  func SliceContraFunctor f ->
  Functor of (cod f)-SliceCat C, (dom f)-SliceCat C means


   for m being Morphism of (cod f)-SliceCat C holds
  it.m = [[m`11(*)f, m`12(*)f], m`2];
end;

theorem 
  for C being Category, f,g being Morphism of C st dom g = cod f holds
  SliceFunctor (g(*)f) = (SliceFunctor g)*(SliceFunctor f);

theorem 
  for C being Category, f,g being Morphism of C st dom g = cod f holds
  SliceContraFunctor (g(*)f) = (SliceContraFunctor f)*(SliceContraFunctor g);














begin 

reserve i,j,k,x for set;

theorem 
  for A being set holds id A in Funcs(A,A);

theorem 
  Funcs({},{}) = { id {} };

theorem 
  for A,B,C being set, f,g being Function st f in Funcs(A,B) & g in
  Funcs(B,C) holds g*f in Funcs(A,C);

theorem 
  for A,B,C being set st Funcs(A,B) <> {} & Funcs(B,C) <> {} holds
  Funcs(A,C) <> {};

theorem 
  for A,B being set, F being ManySortedSet of [:B,A:], C being Subset of
A, D being Subset of B, x,y being set st x in C & y in D holds F.(y,x) = (F|([:
  D,C:] qua set)).(y,x);

scheme 

  MSSLambda2{ A,B() -> set, F(set,set) -> set }: ex M being ManySortedSet of
  [:A(),B():] st for i,j st i in A() & j in B() holds M.(i,j) = F(i,j);

scheme 

  MSSLambda2D{ A,B() -> non empty set, F(set,set) -> set }: ex M being
ManySortedSet of [:A(),B():] st for i being Element of A(), j being Element of
  B() holds M.(i,j) = F(i,j);

scheme 

  MSSLambda3{ A,B,C() -> set, F(set,set,set) -> set }: ex M being
ManySortedSet of [:A(),B(),C():] st for i,j,k st i in A() & j in B() & k in C()
  holds M.(i,j,k) = F(i,j,k);

scheme 

  MSSLambda3D{ A,B,C() -> non empty set, F(set,set,set) -> set }: ex M being
ManySortedSet of [:A(),B(),C():] st for i being Element of A(), j being Element
  of B(), k being Element of C() holds M.(i,j,k) = F(i,j,k);

theorem 
  for A,B being set, N,M being ManySortedSet of [:A,B:] st for i,j
  st i in A & j in B holds N.(i,j) = M.(i,j) holds M = N;

theorem 
  for A,B being non empty set, N,M being ManySortedSet of [:A,B:]
st for i being Element of A, j being Element of B holds N.(i,j) = M.(i,j) holds
  M = N;

theorem 
  for A being set, N,M being ManySortedSet of [:A,A,A:] st for i,j
  ,k st i in A & j in A & k in A holds N.(i,j,k) = M.(i,j,k) holds M = N;

theorem 
  (i,j):->k = [i,j].-->k;

theorem 
  ((i,j):->k).(i,j) = k;

begin 

definition
  struct(1-sorted) AltGraph (# carrier -> set, Arrows -> ManySortedSet of [:
    the carrier, the carrier:] #);
end;

definition
  let G be AltGraph;
  mode object of G is Element of G;
end;

definition
  let G be AltGraph;
  let o1,o2 be object of G;

  func <^o1,o2^> equals

  (the Arrows of G).(o1,o2);
end;

definition
  let G be AltGraph;
  let o1,o2 be object of G;
  mode Morphism of o1,o2 is Element of <^o1,o2^>;
end;

definition
  let G be AltGraph;

  attr G is transitive means


  for o1,o2,o3 being object of G st <^o1,o2
  ^> <> {} & <^o2,o3^> <> {} holds <^o1,o3^> <> {};
end;

begin 

definition
  let I be set;
  let G be ManySortedSet of [:I,I:];
  func {|G|} -> ManySortedSet of [:I,I,I:] means


  for i,j,k st i in I & j in I & k in I holds it.(i,j,k) = G.(i,k);
  let H be ManySortedSet of [:I,I:];
  func {|G,H|} -> ManySortedSet of [:I,I,I:] means


  for i,j,k st i in I & j in I & k in I holds it.(i,j,k) = [:H.(j,k),G.(i,j):];
end;

definition
  let I be set;
  let G be ManySortedSet of [:I,I:];
  mode BinComp of G is ManySortedFunction of {|G,G|},{|G|};
end;

definition
  let I be non empty set;
  let G be ManySortedSet of [:I,I:];
  let o be BinComp of G;
  let i,j,k be Element of I;
  redefine func o.(i,j,k) -> Function of [:G.(j,k),G.(i,j):], G.(i,k);
end;

definition
  let I be non empty set;
  let G be ManySortedSet of [:I,I:];
  let IT be BinComp of G;
  attr IT is associative means


  for i,j,k,l being Element of I for f,g,h
being set st f in G.(i,j) & g in G.(j,k) & h in G.(k,l) holds IT.(i,k,l).(h,IT.
  (i,j,k).(g,f)) = IT.(i,j,l).(IT.(j,k,l).(h,g),f);
  attr IT is with_right_units means


  for i being Element of I ex e being
set st e in G.(i,i) & for j being Element of I, f be set st f in G.(i,j) holds
  IT.(i,i,j).(f,e) = f;
  attr IT is with_left_units means


  for j being Element of I ex e being
set st e in G.(j,j) & for i being Element of I, f be set st f in G.(i,j) holds
  IT.(i,j,j).(e,f) = f;
end;

begin 

definition
  struct(AltGraph) AltCatStr (# carrier -> set, Arrows -> ManySortedSet of [:
    the carrier, the carrier:], Comp -> BinComp of the Arrows #);
end;

registration
  cluster strict non empty for AltCatStr;
end;

definition
  let C be non empty AltCatStr;
  let o1,o2,o3 be object of C such that
 <^o1,o2^> <> {} & <^o2,o3^> <> {};
  let f be Morphism of o1,o2, g be Morphism of o2,o3;
  func g*f -> Morphism of o1,o3 equals


  (the Comp of C).(o1,o2,o3).(g,f
  );
end;

definition
  let IT be Function;
  attr IT is compositional means


  x in dom IT implies ex f,g being Function st x = [g,f] & IT.x = g*f;
end;

registration
  let A,B be functional set;
  cluster compositional for ManySortedFunction of [:A,B:];
end;

theorem 
  for A,B being functional set for F being compositional
ManySortedSet of [:A,B:], g,f being Function st g in A & f in B holds F.(g,f) =
  g*f;

definition
  let A,B be functional set;
  func FuncComp(A,B) -> compositional ManySortedFunction of [:B,A:] means


   not contradiction;
end;

theorem 
  for A,B,C being set holds rng FuncComp(Funcs(A,B),Funcs(B,C)) c= Funcs(A,C);

theorem 
  for o be set holds FuncComp({id o},{id o}) = (id o,id o) :-> id o;

theorem 
  for A,B being functional set, A1 being Subset of A, B1 being
  Subset of B holds FuncComp(A1,B1) = FuncComp(A,B)|([:B1,A1:] qua set);



definition
  let C be non empty AltCatStr;
  attr C is quasi-functional means


  for a1,a2 being object of C holds <^a1,a2^> c= Funcs(a1,a2);
  attr C is semi-functional means


  for a1,a2,a3 being object of C st <^
a1,a2^> <> {} & <^a2,a3^> <> {} & <^a1,a3^> <> {} for f being Morphism of a1,a2
, g being Morphism of a2,a3, f9,g9 being Function st f = f9 & g = g9 holds g*f
  =g9*f9;
  attr C is pseudo-functional means


  for o1,o2,o3 being object of C
holds (the Comp of C).(o1,o2,o3) = FuncComp(Funcs(o1,o2),Funcs(o2,o3))|([:<^o2,
  o3^>,<^o1,o2^>:] qua set);
end;

registration
  let X be non empty set, A be ManySortedSet of [:X,X:], C be BinComp of A;
  cluster AltCatStr(#X,A,C#) -> non empty;
end;

registration
  cluster strict pseudo-functional for non empty AltCatStr;
end;

theorem 
  for C being non empty AltCatStr, a1,a2,a3 being object of C holds (the
  Comp of C).(a1,a2,a3) is Function of [:<^a2,a3^>,<^a1,a2^>:],<^a1,a3^>;

theorem 
  for C being pseudo-functional non empty AltCatStr for a1,a2,a3
being object of C st <^a1,a2^> <> {} & <^a2,a3^> <> {} & <^a1,a3^> <> {} for f
being Morphism of a1,a2, g being Morphism of a2,a3, f9,g9 being Function st f =
  f9 & g = g9 holds g*f =g9*f9;




definition
  let A be non empty set;
  func EnsCat A -> strict pseudo-functional non empty AltCatStr means



  the carrier of it = A & for a1,a2 being object of it holds <^a1,a2^> = Funcs(
  a1,a2);
end;

definition
  let C be non empty AltCatStr;
  attr C is associative means


  the Comp of C is associative;
  attr C is with_units means


  the Comp of C is with_left_units with_right_units;
end;

registration
  cluster transitive associative with_units strict for non empty AltCatStr;
end;

theorem 
  for C being transitive non empty AltCatStr, a1,a2,a3 being object of C
holds dom((the Comp of C).(a1,a2,a3)) = [:<^a2,a3^>,<^a1,a2^>:] & rng((the Comp
  of C).(a1,a2,a3)) c= <^a1,a3^>;

theorem 
  for C being with_units non empty AltCatStr for o being object
  of C holds <^o,o^> <> {};

registration
  let A be non empty set;
  cluster EnsCat A -> transitive associative with_units;
end;

registration
  cluster quasi-functional semi-functional transitive -> pseudo-functional for

    non empty AltCatStr;
  cluster with_units pseudo-functional transitive -> quasi-functional
    semi-functional for non empty AltCatStr;
end;



definition
  mode category is transitive associative with_units non empty AltCatStr;
end;

begin

definition
  let C be with_units non empty AltCatStr;
  let o be object of C;
  func idm o -> Morphism of o,o means


  for o9 being object of C st <^o,
  o9^> <> {} for a being Morphism of o,o9 holds a*it = a;
end;

theorem 
  for C being with_units non empty AltCatStr for o being object
  of C holds idm o in <^o,o^>;

theorem 
  for C being with_units non empty AltCatStr for o1,o2 being object of
  C st <^o1,o2^> <> {} for a being Morphism of o1,o2 holds (idm o2)*a = a;

theorem 
  for C being associative transitive non empty AltCatStr for o1,o2,o3,
o4 being object of C st <^o1,o2^> <> {} & <^o2,o3^> <> {} & <^o3,o4^> <> {} for
a being Morphism of o1,o2, b being Morphism of o2,o3, c being Morphism of o3,o4
  holds c*(b*a) = (c*b)*a;

begin



definition
  let C be AltCatStr;
  attr C is quasi-discrete means


  for i,j being object of C st <^i,j^> <> {} holds i = j;


  attr C is pseudo-discrete means


  for i being object of C holds <^i,i ^> is trivial;
end;

theorem 
  for C being with_units non empty AltCatStr holds C is
  pseudo-discrete iff for o being object of C holds <^o,o^> = { idm o };

registration
  cluster 1-element -> quasi-discrete for AltCatStr;
end;

theorem 
  EnsCat 1 is pseudo-discrete 1-element;

registration
  cluster pseudo-discrete trivial strict for category;
end;

registration
  cluster quasi-discrete pseudo-discrete trivial strict for category;
end;

definition
  mode discrete_category is quasi-discrete pseudo-discrete category;
end;

definition
  let A be non empty set;
  func DiscrCat A -> quasi-discrete strict non empty AltCatStr means


  the carrier of it = A & for i being object of it holds <^i,i^> = { id i };
end;

registration
  cluster quasi-discrete -> transitive for AltCatStr;
end;

theorem 
  for A being non empty set, o1,o2,o3 being object of DiscrCat A
  st o1 <> o2 or o2 <> o3 holds (the Comp of DiscrCat A).(o1,o2,o3) = {};

theorem 
  for A being non empty set, o being object of DiscrCat A holds (
  the Comp of DiscrCat A).(o,o,o) = (id o,id o) :-> id o;

registration
  let A be non empty set;
  cluster DiscrCat A -> pseudo-functional pseudo-discrete with_units
    associative;
end;














begin 

definition
  let IT be RelStr;
  attr IT is discrete means


  the InternalRel of IT = id (the carrier of IT);
end;

registration
  cluster strict discrete non empty for Poset;
end;

registration
  cluster RelStr (#{},id {}#) -> empty;
  let P be empty RelStr;
  cluster the InternalRel of P -> empty;
end;

registration
  cluster empty -> discrete for RelStr;
end;

definition
  let P be RelStr;
  let IT be Subset of P;
  attr IT is disconnected means


  ex A,B be Subset of P st A <> {} & B <>
  {} & IT = A \/ B & A misses B & the InternalRel of P = (the InternalRel of P)
  |_2 A \/ (the InternalRel of P) |_2 B;
end;

notation
  let P be RelStr;
  let IT be Subset of P;
  antonym IT is connected for IT is disconnected;
end;

definition
  let IT be RelStr;
  attr IT is disconnected means


  [#] IT is disconnected;
end;

notation
  let IT be RelStr;
  antonym IT is connected for IT is disconnected;
end;

reserve T for non empty RelStr,
  a for Element of T;

theorem 
  for DP be discrete non empty RelStr, x,y be Element of DP holds x <= y
  iff x = y;

theorem 
  for R be Relation, a be set st R is Order of {a} holds R = id {a};

theorem 
  T is reflexive & [#] T = {a} implies T is discrete;

reserve a for set;

theorem 
  [#] T = {a} implies T is connected;

theorem 
  for DP be discrete non empty Poset st (ex a,b be Element of DP st
  a <> b) holds DP is disconnected;

registration
  cluster strict connected for non empty Poset;
  cluster strict disconnected discrete for non empty Poset;
end;

begin  

definition
  let IT be set;
  attr IT is POSet_set-like means


  for a be set st a in IT holds a is non empty Poset;
end;

registration
  cluster non empty POSet_set-like for set;
end;

definition
  mode POSet_set is POSet_set-like set;
end;

definition
  let P be non empty POSet_set;
  redefine mode Element of P -> non empty Poset;
end;

definition
  let L1,L2 be RelStr;
  let f be Function of L1, L2;
  attr f is monotone means


  for x,y being Element of L1 st x <= y for a,
  b being Element of L2 st a = f.x & b = f.y holds a <= b;
end;

reserve P for non empty POSet_set,
  A,B for Element of P;

definition
  let A,B be RelStr;
  func MonFuncs (A,B) means


  a in it iff ex f be Function of A, B st a =
  f & f in Funcs (the carrier of A, the carrier of B) & f is monotone;
end;

theorem 
  for A,B,C be non empty RelStr for f,g be Function st f in
  MonFuncs (A,B) & g in MonFuncs (B,C) holds (g*f) in MonFuncs (A,C);

theorem 
  id the carrier of T in MonFuncs (T,T);

registration
  let T;
  cluster MonFuncs (T,T) -> non empty;
end;

definition
  let X be set;
  func Carr X -> set means


  a in it iff ex s be 1-sorted st s in X & a = the carrier of s;
end;

registration
  let P;
  cluster Carr P -> non empty;
end;

theorem 
  for f be 1-sorted holds Carr {f} = {the carrier of f};

theorem 
  for f,g be 1-sorted holds Carr {f,g} = {the carrier of f, the carrier of g };

theorem 
  MonFuncs (A,B) c= Funcs Carr P;

theorem 
  for A,B be RelStr holds MonFuncs (A,B) c= Funcs (the carrier of
  A,the carrier of B);

registration
  let A,B be non empty Poset;
  cluster MonFuncs (A,B) -> functional;
end;

definition
  let P be non empty POSet_set;
  func POSCat P -> strict with_triple-like_morphisms Category means

  the
carrier of it = P & (for a,b be Element of P, f be Element of Funcs Carr P st f
in MonFuncs (a,b) holds [[a,b],f] is Morphism of it) & (for m be Morphism of it
ex a,b be Element of P, f be Element of Funcs (Carr P) st m = [[a,b],f] & f in
MonFuncs (a,b)) & for m1,m2 be (Morphism of it), a1,a2,a3 be Element of P, f1,
f2 be Element of Funcs (Carr P) st m1 = [[a1,a2],f1] & m2 = [[a2,a3],f2] holds
  m2(*)m1 = [[a1,a3], f2*f1];
end;

begin   

scheme 

  AltCatEx {A() -> non empty set, F(set,set) -> functional set }: ex C be
strict AltCatStr st the carrier of C = A() & for i,j be Element of A() holds (
the Arrows of C).(i,j) = F (i,j) & for i,j,k be Element of A() holds (the Comp
  of C).(i,j,k) = FuncComp ( F(i,j) , F(j,k) )
provided
 for i,j,k be Element of A() for f,g be Function st f in F(i,j) & g
in F(j,k) holds g * f in F (i,k);

scheme 

  AltCatUniq {A() -> non empty set, F(set,set) -> functional set } : for C1,C2
  be strict AltCatStr st ( the carrier of C1 = A() & for i,j be Element of A()
holds (the Arrows of C1).(i,j) = F (i,j) & for i,j,k be Element of A() holds (
the Comp of C1).(i,j,k) = FuncComp ( F(i,j) , F(j,k) ) ) & ( the carrier of C2
  = A() & for i,j be Element of A() holds (the Arrows of C2).(i,j) = F (i,j) &
for i,j,k be Element of A() holds (the Comp of C2).(i,j,k) = FuncComp ( F(i,j)
  , F(j,k) ) ) holds C1 = C2;

definition
  let P be non empty POSet_set;
  func POSAltCat P -> strict AltCatStr means


  the carrier of it = P &
for i,j be Element of P holds (the Arrows of it).(i,j) = MonFuncs (i,j) & for i
,j,k be Element of P holds (the Comp of it).(i,j,k) = FuncComp ( MonFuncs (i,j)
  , MonFuncs (j,k) );
end;

registration
  let P be non empty POSet_set;
  cluster POSAltCat P -> transitive non empty;
end;

registration
  let P be non empty POSet_set;
  cluster POSAltCat P -> associative with_units;
end;

theorem 
  for o1,o2 be object of POSAltCat P, A,B be Element of P st o1 = A & o2
  = B holds <^ o1, o2 ^> c= Funcs (the carrier of A, the carrier of B);















begin 

reserve X for set;

registration
  let L be Lattice;
  cluster LattPOSet L -> with_suprema with_infima;
end;

registration
  let L be upper-bounded Lattice;
  cluster LattPOSet L -> upper-bounded;
end;

registration
  let L be lower-bounded Lattice;
  cluster LattPOSet L -> lower-bounded;
end;

registration
  let L be complete Lattice;
  cluster LattPOSet L -> complete;
end;

definition
  let X be set;
  redefine func RelIncl X -> Order of X;
end;

definition
  let X be set;
  func InclPoset X -> strict RelStr equals

  RelStr(#X, RelIncl X#);
end;

registration
  let X be set;
  cluster InclPoset X -> reflexive antisymmetric transitive;
end;

registration
  let X be non empty set;
  cluster InclPoset X -> non empty;
end;

theorem 
  the carrier of InclPoset X = X & the InternalRel of InclPoset X = RelIncl X;

definition
  let X be set;
  func BoolePoset X -> strict RelStr equals

  LattPOSet BooleLatt X;
end;

registration
  let X be set;
  cluster BoolePoset X -> non empty reflexive antisymmetric transitive;
end;

registration
  let X be set;
  cluster BoolePoset X -> complete;
end;

theorem 
  for x,y be Element of BoolePoset X holds x <= y iff x c= y;

theorem 
  for X be non empty set, x,y be Element of InclPoset X holds x <= y iff x c= y
;

theorem 
  BoolePoset X = InclPoset bool X;

theorem 
  for Y be Subset-Family of X holds InclPoset Y is full SubRelStr of
  BoolePoset X;

theorem 
  for X be non empty set holds InclPoset X is with_suprema implies for x
  ,y be Element of InclPoset X holds x \/ y c= x "\/" y;

theorem 
  for X be non empty set holds InclPoset X is with_infima implies for x,
  y be Element of InclPoset X holds x "/\" y c= x /\ y;

theorem 
  for X be non empty set holds for x,y be Element of InclPoset X st
  x \/ y in X holds x "\/" y = x \/ y;

theorem 
  for X be non empty set for x,y be Element of InclPoset X st x /\
  y in X holds x "/\" y = x /\ y;

theorem 
  for L be RelStr st for x,y be Element of L holds x <= y iff x c= y
  holds the InternalRel of L = RelIncl the carrier of L;

theorem 
  for X be non empty set st (for x,y be set st (x in X & y in X) holds x
  \/ y in X) holds InclPoset X is with_suprema;

theorem 
  for X be non empty set st for x,y be set st x in X & y in X holds x /\
  y in X holds InclPoset X is with_infima;

theorem 
  for X be non empty set holds {} in X implies Bottom InclPoset X = {};

theorem 
  for X be non empty set holds union X in X implies Top InclPoset X = union X;

theorem 
  for X being non empty set holds InclPoset X is upper-bounded implies
  union X in X;

theorem 
  for X be non empty set holds InclPoset X is lower-bounded implies meet X in X
;

theorem 
  for x,y be Element of BoolePoset X holds x "\/" y = x \/ y & x "/\" y
  = x /\ y;

theorem 
  Bottom BoolePoset X = {};

theorem 
  Top BoolePoset X = X;

theorem 
  for Y being non empty Subset of BoolePoset X holds inf Y = meet Y;

theorem 
  for Y being Subset of BoolePoset X holds sup Y = union Y;

theorem 
  for T being non empty TopSpace, X being Subset of InclPoset the
  topology of T holds sup X = union X;

theorem 
  for T be non empty TopSpace holds Bottom InclPoset the topology of T =
  {};

theorem 
  for T be non empty TopSpace holds Top InclPoset the topology of T =
  the carrier of T;

registration
  let T be non empty TopSpace;
  cluster InclPoset the topology of T -> complete non trivial;
end;

theorem 
  for T being TopSpace, F being Subset-Family of T holds F is open iff F
  is Subset of InclPoset the topology of T;

begin  

reserve x,y,z for set;

definition
  let R be Relation;
  attr R is RelStr-yielding means


  for v being set st v in rng R holds v is RelStr;
end;

registration
  cluster RelStr-yielding -> 1-sorted-yielding for Function;
end;

registration
  let I be set;
  cluster RelStr-yielding for ManySortedSet of I;
end;

definition
  let J be non empty set, A be RelStr-yielding ManySortedSet of J, j be
  Element of J;
  redefine func A.j -> RelStr;
end;

definition
  let I be set;
  let J be RelStr-yielding ManySortedSet of I;
  func product J -> strict RelStr means


  the carrier of it = product
Carrier J & for x,y being Element of it st x in product Carrier J holds x <= y
iff ex f,g being Function st f = x & g = y & for i be set st i in I ex R being
  RelStr, xi,yi being Element of R st R = J.i & xi = f.i & yi = g.i & xi <= yi;
end;

registration
  let X be set;
  let L be RelStr;
  cluster X --> L -> RelStr-yielding;
end;

definition
  let I be set;
  let T be RelStr;
  func T|^I -> strict RelStr equals

  product (I --> T);
end;

theorem 
  for J be RelStr-yielding ManySortedSet of {} holds product J =
  RelStr (#{{}}, id {{}}#);

theorem 
  for Y be RelStr holds Y|^{} = RelStr (#{{}}, id {{}}#);

theorem 
  for X be set, Y be RelStr holds Funcs (X, the carrier of Y) =
  the carrier of Y|^X;

registration
  let X be set;
  let Y be non empty RelStr;
  cluster Y|^X -> non empty;
end;

registration
  let X be set;
  let Y be reflexive non empty RelStr;
  cluster Y|^X -> reflexive;
end;

registration
  let Y be non empty RelStr;
  cluster Y|^{} -> 1-element;
end;

registration
  let Y be non empty reflexive RelStr;
  cluster Y|^{} -> with_infima with_suprema antisymmetric;
end;

registration
  let X be set;
  let Y be transitive non empty RelStr;
  cluster Y|^X -> transitive;
end;

registration
  let X be set;
  let Y be antisymmetric non empty RelStr;
  cluster Y|^X -> antisymmetric;
end;

registration
  let X be non empty set;
  let Y be non empty with_infima antisymmetric RelStr;
  cluster Y|^X -> with_infima;
end;

registration
  let X be non empty set;
  let Y be non empty with_suprema antisymmetric RelStr;
  cluster Y|^X -> with_suprema;
end;

definition
  let S,T be RelStr;
  func MonMaps (S,T) -> strict full SubRelStr of T|^the carrier of S means

  for f being Function of S,T holds f in the carrier of it iff f in Funcs (the
  carrier of S, the carrier of T) & f is monotone;
end;














begin 

definition
  let L be RelStr;
  let X be Subset of L;
  attr X is directed means

       
  for x,y being Element of L st x in X & y in X
  ex z being Element of L st z in X & x <= z & y <= z;
  attr X is filtered means

       
  for x,y being Element of L st x in X & y in X
  ex z being Element of L st z in X & z <= x & z <= y;
end;




theorem 
  for L being non empty transitive RelStr, X being Subset of L holds
  X is non empty directed iff for Y being finite Subset of X
  ex x being Element of L st x in X & x is_>=_than Y;




theorem 
  for L being non empty transitive RelStr, X being Subset of L holds
  X is non empty filtered iff for Y being finite Subset of X
  ex x being Element of L st x in X & x is_<=_than Y;

registration
  let L be RelStr;
  cluster empty -> directed filtered for Subset of L;
end;

registration
  let L be RelStr;
  cluster directed filtered for Subset of L;
end;

theorem 
  for L1,L2 being RelStr st the RelStr of L1 = the RelStr of L2
  for X1 being Subset of L1, X2 being Subset of L2 st X1 = X2 & X1 is directed
  holds X2 is directed;

theorem 
  for L1,L2 being RelStr st the RelStr of L1 = the RelStr of L2
  for X1 being Subset of L1, X2 being Subset of L2 st X1 = X2 & X1 is filtered
  holds X2 is filtered;

theorem 
  for L being non empty reflexive RelStr, x being Element of L
  holds {x} is directed filtered;

registration
  let L be non empty reflexive RelStr;
  cluster directed filtered non empty finite for Subset of L;
end;

registration
  let L be with_suprema RelStr;
  cluster [#]L -> directed;
end;

registration
  let L be upper-bounded non empty RelStr;
  cluster [#]L -> directed;
end;

registration
  let L be with_infima RelStr;
  cluster [#]L -> filtered;
end;

registration
  let L be lower-bounded non empty RelStr;
  cluster [#]L -> filtered;
end;

definition
  let L be non empty RelStr;
  let S be SubRelStr of L;
  attr S is filtered-infs-inheriting means


  for X being filtered Subset of S st X <> {} & ex_inf_of X,L
  holds "/\"(X,L) in the carrier of S;
  attr S is directed-sups-inheriting means


  for X being directed Subset of S st X <> {} & ex_sup_of X,L
  holds "\/"(X,L) in the carrier of S;
end;

registration
  let L be non empty RelStr;
  cluster infs-inheriting -> filtered-infs-inheriting for SubRelStr of L;
  cluster sups-inheriting -> directed-sups-inheriting for SubRelStr of L;
end;

registration
  let L be non empty RelStr;
  cluster infs-inheriting sups-inheriting non empty full strict for
SubRelStr of L;
end;

theorem 
  for L being non empty transitive RelStr
  for S being filtered-infs-inheriting non empty full SubRelStr of L
  for X being filtered Subset of S st X <> {} & ex_inf_of X,L
  holds ex_inf_of X,S & "/\"(X,S) = "/\"(X,L);

theorem 
  for L being non empty transitive RelStr
  for S being directed-sups-inheriting non empty full SubRelStr of L
  for X being directed Subset of S st X <> {} & ex_sup_of X,L
  holds ex_sup_of X,S & "\/"(X,S) = "\/"(X,L);

begin 

definition
  let L1,L2 be RelStr;
  let f be Function of L1,L2;
  attr f is antitone means

  for x,y being Element of L1 st x <= y
  for a,b being Element of L2 st a = f.x & b = f.y holds a >= b;
end;



definition
  let L be 1-sorted;
  struct (RelStr) NetStr over L (# carrier -> set,
    InternalRel -> (Relation of the carrier),
    mapping -> Function of the carrier, the carrier of L #);
end;

registration
  let L be 1-sorted;
  let X be non empty set;
  let O be Relation of X;
  let F be Function of X, the carrier of L;
  cluster NetStr(#X,O,F#) -> non empty;
end;

definition
  let N be RelStr;
  attr N is directed means


  [#]N is directed;
end;

registration
  let L be 1-sorted;
  cluster non empty reflexive transitive antisymmetric directed
    for strict NetStr over L;
end;

definition
  let L be 1-sorted;
  mode prenet of L is directed non empty NetStr over L;
end;

definition
  let L be 1-sorted;
  mode net of L is transitive prenet of L;
end;

definition
  let L be non empty 1-sorted;
  let N be non empty NetStr over L;
  func netmap(N,L) -> Function of N,L equals

  the mapping of N;
  let i be Element of N;
  func N.i -> Element of L equals

  (the mapping of N).i;
end;

definition
  let L be non empty RelStr;
  let N be non empty NetStr over L;
  attr N is monotone means

  netmap(N,L) is monotone;
  attr N is antitone means

  netmap(N,L) is antitone;
end;

definition
  let L be non empty 1-sorted;
  let N be non empty NetStr over L;
  let X be set;
  pred N is_eventually_in X means


  ex i being Element of N st for j being Element of N st i <= j holds N.j in X;
  pred N is_often_in X means

  for i being Element of N ex j being Element of N st i <= j & N.j in X;
end;

theorem 
  for L being non empty 1-sorted, N being non empty NetStr over L
  for X,Y being set st X c= Y holds
  (N is_eventually_in X implies N is_eventually_in Y) &
  (N is_often_in X implies N is_often_in Y);

theorem 
  for L being non empty 1-sorted, N being non empty NetStr over L
  for X being set holds
  N is_eventually_in X iff not N is_often_in (the carrier of L) \ X;

theorem 
  for L being non empty 1-sorted, N being non empty NetStr over L
  for X being set holds
  N is_often_in X iff not N is_eventually_in (the carrier of L) \ X;

scheme 
 HoldsEventually
  {L() -> non empty RelStr, N() -> non empty NetStr over L(), P[set]}:
  N() is_eventually_in {N().k where k is Element of N(): P[N().k]} iff
  ex i being Element of N() st
  for j being Element of N() st i <= j holds P[N().j];

definition
  let L be non empty RelStr;
  let N be non empty NetStr over L;
  attr N is eventually-directed means


  for i being Element of N holds N is_eventually_in
  {N.j where j is Element of N: N.i <= N.j};
  attr N is eventually-filtered means


  for i being Element of N holds N is_eventually_in
  {N.j where j is Element of N: N.i >= N.j};
end;

theorem 
  for L being non empty RelStr, N being non empty NetStr over L holds
  N is eventually-directed iff
  for i being Element of N ex j being Element of N st
  for k being Element of N st j <= k holds N.i <= N.k;

theorem 
  for L being non empty RelStr, N being non empty NetStr over L holds
  N is eventually-filtered iff
  for i being Element of N ex j being Element of N st
  for k being Element of N st j <= k holds N.i >= N.k;

registration
  let L be non empty RelStr;
  cluster monotone -> eventually-directed for prenet of L;
  cluster antitone -> eventually-filtered for prenet of L;
end;

registration
  let L be non empty reflexive RelStr;
  cluster monotone antitone strict for prenet of L;
end;

begin 


definition
  let L be RelStr;
  let X be Subset of L;
  func downarrow X -> Subset of L means


  for x being Element of L holds x in it iff
  ex y being Element of L st y >= x & y in X;
  func uparrow X -> Subset of L means


  for x being Element of L holds x in it iff
  ex y being Element of L st y <= x & y in X;
end;

theorem 
  for L1,L2 being RelStr st the RelStr of L1 = the RelStr of L2
  for X being Subset of L1 for Y being Subset of L2
  st X = Y holds downarrow X = downarrow Y & uparrow X = uparrow Y;

theorem 
  for L being non empty RelStr, X being Subset of L holds downarrow X =
  {x where x is Element of L: ex y being Element of L st x <= y & y in X};

theorem 
  for L being non empty RelStr, X being Subset of L holds uparrow X =
  {x where x is Element of L: ex y being Element of L st x >= y & y in X};

registration
  let L be non empty reflexive RelStr;
  let X be non empty Subset of L;
  cluster downarrow X -> non empty;
  cluster uparrow X -> non empty;
end;

theorem 
  for L being reflexive RelStr, X being Subset of L holds
  X c= downarrow X & X c= uparrow X;

definition
  let L be non empty RelStr;
  let x be Element of L;
  func downarrow x -> Subset of L equals

  downarrow {x};
  func uparrow x -> Subset of L equals

  uparrow {x};
end;

theorem 
  for L being non empty RelStr, x,y being Element of L
  holds y in downarrow x iff y <= x;

theorem 
  for L being non empty RelStr, x,y being Element of L
  holds y in uparrow x iff x <= y;

theorem 
  for L being non empty reflexive antisymmetric RelStr
  for x,y being Element of L st downarrow x = downarrow y holds x = y;

theorem 
  for L being non empty reflexive antisymmetric RelStr
  for x,y being Element of L st uparrow x = uparrow y holds x = y;

theorem 
  for L being non empty transitive RelStr for x,y being Element of L st x <= y
  holds downarrow x c= downarrow y;

theorem 
  for L being non empty transitive RelStr for x,y being Element of L st x <= y
  holds uparrow y c= uparrow x;

registration
  let L be non empty reflexive RelStr;
  let x be Element of L;
  cluster downarrow x -> non empty directed;
  cluster uparrow x -> non empty filtered;
end;

definition
  let L be RelStr;
  let X be Subset of L;
  attr X is lower means

                    
  for x,y being Element of L st x in X & y <= x holds y in X;
  attr X is upper means

                    
  for x,y being Element of L st x in X & x <= y holds y in X;
end;

registration
  let L be RelStr;
  cluster lower upper for Subset of L;
end;

theorem 
  for L being RelStr, X being Subset of L holds X is lower iff downarrow X c= X
;

theorem 
  for L being RelStr, X being Subset of L holds X is upper iff uparrow X c= X;

theorem 
  for L1,L2 being RelStr st the RelStr of L1 = the RelStr of L2
  for X1 being Subset of L1, X2 being Subset of L2 st X1 = X2 holds
  (X1 is lower implies X2 is lower) & (X1 is upper implies X2 is upper);

theorem 
  for L being RelStr, A being Subset-Family of L st
  for X being Subset of L st X in A holds X is lower
  holds union A is lower Subset of L;

theorem 
  for L being RelStr, X,Y being Subset of L st X is lower & Y is lower
  holds X /\ Y is lower & X \/ Y is lower;

theorem 
  for L being RelStr, A being Subset-Family of L st
  for X being Subset of L st X in A holds X is upper
  holds union A is upper Subset of L;

theorem 
  for L being RelStr, X,Y being Subset of L st X is upper & Y is upper
  holds X /\ Y is upper & X \/ Y is upper;

registration
  let L be non empty transitive RelStr;
  let X be Subset of L;
  cluster downarrow X -> lower;
  cluster uparrow X -> upper;
end;

registration
  let L be non empty transitive RelStr;
  let x be Element of L;
  cluster downarrow x -> lower;
  cluster uparrow x -> upper;
end;

registration
  let L be non empty RelStr;
  cluster [#]L -> lower upper;
end;

registration
  let L be non empty RelStr;
  cluster non empty lower upper for Subset of L;
end;

registration
  let L be non empty reflexive transitive RelStr;
  cluster non empty lower directed for Subset of L;
  cluster non empty upper filtered for Subset of L;
end;

registration
  let L be with_infima with_suprema Poset;
  cluster non empty directed filtered lower upper for Subset of L;
end;

theorem 
  for L being non empty transitive reflexive RelStr, X be Subset of L holds
  X is directed iff downarrow X is directed;

registration
  let L be non empty transitive reflexive RelStr;
  let X be directed Subset of L;
  cluster downarrow X -> directed;
end;

theorem 
  for L being non empty transitive reflexive RelStr, X be Subset of L
  for x be Element of L holds x is_>=_than X iff x is_>=_than downarrow X;

theorem 
  for L being non empty transitive reflexive RelStr, X be Subset of L holds
  ex_sup_of X,L iff ex_sup_of downarrow X,L;

theorem 
  for L being non empty transitive reflexive RelStr, X be Subset of L
  st ex_sup_of X,L holds sup X = sup downarrow X;

theorem 
  for L being non empty Poset, x being Element of L holds
  ex_sup_of downarrow x, L & sup downarrow x = x;

theorem 
  for L being non empty transitive reflexive RelStr, X be Subset of L holds
  X is filtered iff uparrow X is filtered;

registration
  let L be non empty transitive reflexive RelStr;
  let X be filtered Subset of L;
  cluster uparrow X -> filtered;
end;

theorem 
  for L being non empty transitive reflexive RelStr, X be Subset of L
  for x be Element of L holds x is_<=_than X iff x is_<=_than uparrow X;

theorem 
  for L being non empty transitive reflexive RelStr, X be Subset of L holds
  ex_inf_of X,L iff ex_inf_of uparrow X,L;

theorem 
  for L being non empty transitive reflexive RelStr, X be Subset of L
  st ex_inf_of X,L holds inf X = inf uparrow X;

theorem 
  for L being non empty Poset, x being Element of L holds
  ex_inf_of uparrow x, L & inf uparrow x = x;

begin 

definition
  let L be non empty reflexive transitive RelStr;
  mode Ideal of L is directed lower non empty Subset of L;


  mode Filter of L is filtered upper non empty Subset of L;


end;

theorem 
for L being with_suprema antisymmetric RelStr, X being lower Subset of L holds
  X is directed iff for x,y being Element of L st x in X & y in X holds x"\/"
  y in X;

theorem 
  for L being with_infima antisymmetric RelStr, X being upper Subset of L holds
  X is filtered iff for x,y being Element of L st x in X & y in X holds x"/\"
  y in X;

theorem 
  for L being with_suprema Poset for X being non empty lower Subset of L holds
  X is directed iff for Y being finite Subset of X st Y <> {} holds "\/"
  (Y,L) in X;

theorem 
  for L being with_infima Poset for X being non empty upper Subset of L holds
  X is filtered iff for Y being finite Subset of X st Y <> {} holds "/\"
  (Y,L) in X;

theorem 
  for L being non empty antisymmetric RelStr
  st L is with_suprema or L is with_infima for X,Y being Subset of L
  st X is lower directed & Y is lower directed holds X /\ Y is directed;

theorem 
  for L being non empty antisymmetric RelStr
  st L is with_suprema or L is with_infima for X,Y being Subset of L
  st X is upper filtered & Y is upper filtered holds X /\ Y is filtered;

theorem 
  for L being RelStr, A being Subset-Family of L st
  (for X being Subset of L st X in A holds X is directed) &
  (for X,Y being Subset of L st X in A & Y in A
  ex Z being Subset of L st Z in A & X \/ Y c= Z)
  for X being Subset of L st X = union A holds X is directed;

theorem 
  for L being RelStr, A being Subset-Family of L st
  (for X being Subset of L st X in A holds X is filtered) &
  (for X,Y being Subset of L st X in A & Y in A
  ex Z being Subset of L st Z in A & X \/ Y c= Z)
  for X being Subset of L st X = union A holds X is filtered;

definition
  let L be non empty reflexive transitive RelStr;
  let I be Ideal of L;
  attr I is principal means

  ex x being Element of L st x in I & x is_>=_than I;
end;

definition
  let L be non empty reflexive transitive RelStr;
  let F be Filter of L;
  attr F is principal means

  ex x being Element of L st x in F & x is_<=_than F;
end;

theorem 
  for L being non empty reflexive transitive RelStr, I being Ideal of L holds
  I is principal iff ex x being Element of L st I = downarrow x;

theorem 
  for L being non empty reflexive transitive RelStr, F being Filter of L holds
  F is principal iff ex x being Element of L st F = uparrow x;

definition
  let L be non empty reflexive transitive RelStr;
  func Ids L -> set equals

  {X where X is Ideal of L: not contradiction};
  func Filt L -> set equals

  {X where X is Filter of L: not contradiction};
end;

definition
  let L be non empty reflexive transitive RelStr;
  func Ids_0 L -> set equals

  Ids L \/ {{}};
  func Filt_0 L -> set equals

  Filt L \/ {{}};
end;

definition
  let L be non empty RelStr;
  let X be Subset of L;
  func finsups X -> Subset of L equals

  {"\/"(Y,L) where Y is finite Subset of X: ex_sup_of Y,L};
  func fininfs X -> Subset of L equals

  {"/\"(Y,L) where Y is finite Subset of X: ex_inf_of Y,L};
end;

registration
  let L be non empty antisymmetric lower-bounded RelStr;
  let X be Subset of L;
  cluster finsups X -> non empty;
end;

registration
  let L be non empty antisymmetric upper-bounded RelStr;
  let X be Subset of L;
  cluster fininfs X -> non empty;
end;

registration
  let L be non empty reflexive antisymmetric RelStr;
  let X be non empty Subset of L;
  cluster finsups X -> non empty;
  cluster fininfs X -> non empty;
end;

theorem 
  for L being non empty reflexive antisymmetric RelStr for X being Subset of L
  holds X c= finsups X & X c= fininfs X;

theorem 
  for L being non empty transitive RelStr for X,F being Subset of L st
  (for Y being finite Subset of X st Y <> {} holds ex_sup_of Y,L) &
  (for x being Element of L st x in F
  ex Y being finite Subset of X st ex_sup_of Y,L & x = "\/"(Y,L)) &
  (for Y being finite Subset of X st Y <> {} holds "\/"(Y,L) in F)
  holds F is directed;

registration
  let L be with_suprema Poset;
  let X be Subset of L;
  cluster finsups X -> directed;
end;

theorem 
  for L being non empty transitive reflexive RelStr, X,F being Subset of L st
  (for Y being finite Subset of X st Y <> {} holds ex_sup_of Y,L) &
  (for x being Element of L st x in F
  ex Y being finite Subset of X st ex_sup_of Y,L & x = "\/"(Y,L)) &
  (for Y being finite Subset of X st Y <> {} holds "\/"(Y,L) in F)
  for x being Element of L holds x is_>=_than X iff x is_>=_than F;

theorem 
  for L being non empty transitive reflexive RelStr, X,F being Subset of L st
  (for Y being finite Subset of X st Y <> {} holds ex_sup_of Y,L) &
  (for x being Element of L st x in F
  ex Y being finite Subset of X st ex_sup_of Y,L & x = "\/"(Y,L)) &
  (for Y being finite Subset of X st Y <> {} holds "\/"(Y,L) in F)
  holds ex_sup_of X,L iff ex_sup_of F,L;

theorem 
  for L being non empty transitive reflexive RelStr, X,F being Subset of L st
  (for Y being finite Subset of X st Y <> {} holds ex_sup_of Y,L) &
  (for x being Element of L st x in F
  ex Y being finite Subset of X st ex_sup_of Y,L & x = "\/"(Y,L)) &
  (for Y being finite Subset of X st Y <> {} holds "\/"(Y,L) in F) &
  ex_sup_of X,L holds sup F = sup X;

theorem 
  for L being with_suprema Poset, X being Subset of L
  st ex_sup_of X,L or L is complete holds sup X = sup finsups X;

theorem 
  for L being non empty transitive RelStr for X,F being Subset of L st
  (for Y being finite Subset of X st Y <> {} holds ex_inf_of Y,L) &
  (for x being Element of L st x in F
  ex Y being finite Subset of X st ex_inf_of Y,L & x = "/\"(Y,L)) &
  (for Y being finite Subset of X st Y <> {} holds "/\"(Y,L) in F)
  holds F is filtered;

registration
  let L be with_infima Poset;
  let X be Subset of L;
  cluster fininfs X -> filtered;
end;

theorem 
  for L being non empty transitive reflexive RelStr, X,F being Subset of L st
  (for Y being finite Subset of X st Y <> {} holds ex_inf_of Y,L) &
  (for x being Element of L st x in F
  ex Y being finite Subset of X st ex_inf_of Y,L & x = "/\"(Y,L)) &
  (for Y being finite Subset of X st Y <> {} holds "/\"(Y,L) in F)
  for x being Element of L holds x is_<=_than X iff x is_<=_than F;

theorem 
  for L being non empty transitive reflexive RelStr, X,F being Subset of L st
  (for Y being finite Subset of X st Y <> {} holds ex_inf_of Y,L) &
  (for x being Element of L st x in F
  ex Y being finite Subset of X st ex_inf_of Y,L & x = "/\"(Y,L)) &
  (for Y being finite Subset of X st Y <> {} holds "/\"(Y,L) in F)
  holds ex_inf_of X,L iff ex_inf_of F,L;

theorem 
  for L being non empty transitive reflexive RelStr, X,F being Subset of L st
  (for Y being finite Subset of X st Y <> {} holds ex_inf_of Y,L) &
  (for x being Element of L st x in F
  ex Y being finite Subset of X st ex_inf_of Y,L & x = "/\"(Y,L)) &
  (for Y being finite Subset of X st Y <> {} holds "/\"(Y,L) in F) &
  ex_inf_of X, L holds inf F = inf X;

theorem 
  for L being with_infima Poset, X being Subset of L
  st ex_inf_of X,L or L is complete holds inf X = inf fininfs X;

theorem 
  for L being with_suprema Poset, X being Subset of L holds
  X c= downarrow finsups X &
  for I being Ideal of L st X c= I holds downarrow finsups X c= I;

theorem 
  for L being with_infima Poset, X being Subset of L holds
  X c= uparrow fininfs X &
  for F being Filter of L st X c= F holds uparrow fininfs X c= F;

begin 

definition
  let L be non empty RelStr;
  attr L is connected means


  for x,y being Element of L holds x <= y or y <= x;
end;

registration
  cluster trivial -> connected for non empty reflexive RelStr;
end;

registration
  cluster connected for non empty Poset;
end;

definition
  mode Chain is connected non empty Poset;
end;

registration
  let L be Chain;
  cluster L~ -> connected;
end;

begin 

definition
  mode Semilattice is with_infima Poset;
  mode sup-Semilattice is with_suprema Poset;
  mode LATTICE is with_infima with_suprema Poset;
end;

theorem 
  for L being Semilattice for X being upper non empty Subset of L holds
  X is Filter of L iff subrelstr X is meet-inheriting;

theorem 
  for L being sup-Semilattice for X being lower non empty Subset of L holds
  X is Ideal of L iff subrelstr X is join-inheriting;

begin 

definition
  let S,T be non empty RelStr;
  let f be Function of S,T;
  let X be Subset of S;
  pred f preserves_inf_of X means


  ex_inf_of X,S implies ex_inf_of f.:X,T & inf (f.:X) = f.inf X;
  pred f preserves_sup_of X means


  ex_sup_of X,S implies ex_sup_of f.:X,T & sup (f.:X) = f.sup X;
end;

theorem 
  for S1,S2, T1,T2 being non empty RelStr st
  the RelStr of S1 = the RelStr of T1 & the RelStr of S2 = the RelStr of T2
  for f being Function of S1,S2, g being Function of T1,T2 st f = g
  for X being Subset of S1, Y being Subset of T1 st X = Y holds
  (f preserves_sup_of X implies g preserves_sup_of Y) &
  (f preserves_inf_of X implies g preserves_inf_of Y);

definition
  let L1,L2 be non empty RelStr;
  let f be Function of L1,L2;
  attr f is infs-preserving means

  for X being Subset of L1 holds f preserves_inf_of X;
  attr f is sups-preserving means

  for X being Subset of L1 holds f preserves_sup_of X;
  attr f is meet-preserving means

  for x,y being Element of L1 holds f preserves_inf_of {x,y};
  attr f is join-preserving means

  for x,y being Element of L1 holds f preserves_sup_of {x,y};
  attr f is filtered-infs-preserving means

  for X being Subset of L1 st X is non empty filtered
  holds f preserves_inf_of X;
  attr f is directed-sups-preserving means

  for X being Subset of L1 st X is non empty directed
  holds f preserves_sup_of X;
end;

registration
  let L1,L2 be non empty RelStr;
  cluster infs-preserving ->
    filtered-infs-preserving meet-preserving for Function of L1,L2;
  cluster sups-preserving ->
    directed-sups-preserving join-preserving for Function of L1,L2;
end;

definition
  let S,T be RelStr;
  let f be Function of S,T;
  attr f is isomorphic means


  f is one-to-one monotone & ex g being Function
  of T,S st g = f" & g is monotone if S is non empty & T is non empty
  otherwise S is empty & T is empty;
end;

theorem 
  for S,T being non empty RelStr, f being Function
  of S,T holds f is isomorphic iff
  f is one-to-one & rng f = the carrier of T &
  for x,y being Element of S holds x <= y iff f.x <= f.y;

registration
  let S,T be non empty RelStr;
  cluster isomorphic -> one-to-one monotone for Function of S,T;
end;

theorem 
  for S,T being non empty RelStr, f being Function of S,T st f is isomorphic
  holds f" is Function of T,S & rng (f") = the carrier of S;

theorem 
  for S,T being non empty RelStr, f being Function of S,T st f is isomorphic
  for g being Function of T,S st g = f" holds g is isomorphic;

theorem 
  for S,T being non empty Poset, f being Function of S,T st
  for X being Filter of S holds f preserves_inf_of X holds f is monotone;

theorem 
  for S,T being non empty Poset, f being Function of S,T st
  for X being Filter of S holds f preserves_inf_of X
  holds f is filtered-infs-preserving;

theorem 
  for S being Semilattice, T being non empty Poset, f being Function of S,T st
  (for X being finite Subset of S holds f preserves_inf_of X) &
  (for X being non empty filtered Subset of S holds f preserves_inf_of X)
  holds f is infs-preserving;

theorem 
  for S,T being non empty Poset, f being Function of S,T st
  for X being Ideal of S holds f preserves_sup_of X holds f is monotone;

theorem 
  for S,T being non empty Poset, f being Function of S,T st
  for X being Ideal of S holds f preserves_sup_of X
  holds f is directed-sups-preserving;

theorem 
  for S being sup-Semilattice, T being non empty Poset, f being Function
  of S,T st (for X being finite Subset of S holds f preserves_sup_of X) &
  (for X being non empty directed Subset of S holds f preserves_sup_of X)
  holds f is sups-preserving;

begin 

definition
  let L be non empty reflexive RelStr;
  attr L is up-complete means


  for X being non empty directed Subset of L
  ex x being Element of L st x is_>=_than X &
  for y being Element of L st y is_>=_than X holds x <= y;
end;

registration
  cluster up-complete -> upper-bounded for with_suprema reflexive RelStr;
end;

theorem 
  for L being non empty reflexive antisymmetric RelStr holds L is up-complete
  iff for X being non empty directed Subset of L holds ex_sup_of X,L;

definition
  let L be non empty reflexive RelStr;
  attr L is /\-complete means


  for X being non empty Subset of L ex x being Element of L st x is_<=_than X &
  for y being Element of L st y is_<=_than X holds x >= y;
end;

theorem 
  for L being non empty reflexive antisymmetric RelStr holds L is /\-complete
  iff for X being non empty Subset of L holds ex_inf_of X,L;

registration
  cluster complete -> up-complete /\-complete for non empty reflexive RelStr;
  cluster /\-complete -> lower-bounded for non empty reflexive RelStr;
  cluster up-complete with_suprema lower-bounded -> complete for
non empty Poset;



end;

registration
cluster /\-complete -> with_infima for
non empty reflexive antisymmetric RelStr;
end;

registration
  cluster /\-complete -> with_suprema
    for non empty reflexive antisymmetric upper-bounded RelStr;
end;

registration
  cluster complete strict for LATTICE;
end;














begin

scheme 

  DenestFraenkel {A()->non empty set, B()->non empty set, F(set)->set, G(set)
->Element of B(), P[set]}: {F(a) where a is Element of B(): a in {G(b) where b
  is Element of A(): P[b]}} = {F(G(a)) where a is Element of A(): P[a]};

scheme 

  EmptyFraenkel {A() -> non empty set, f(set) -> set, P[set]}: {f(a) where a
  is Element of A(): P[a]} = {}
provided
 not ex a being Element of A() st P[a];

theorem 
  for L1,L2 being non empty LattStr st the LattStr of L1 = the
LattStr of L2 for a1,b1 being Element of L1, a2,b2 being Element of L2 st a1 =
a2 & b1 = b2 holds a1"\/"b1 = a2"\/"b2 & a1"/\"b1 = a2"/\"b2 & (a1 [= b1 iff a2
  [= b2);

theorem 
  for L1,L2 being non empty LattStr st the LattStr of L1 = the
LattStr of L2 for a being Element of L1, b being Element of L2, X being set st
a = b holds (a is_less_than X iff b is_less_than X) & (a is_greater_than X iff
  b is_greater_than X);

definition
  let L be 1-sorted;
  mode UnOp of L is Function of L,L;
end;

definition
  let L be non empty LattStr, X be Subset of L;
  attr X is directed means

  for Y being finite Subset of X ex x being Element
  of L st "\/"(Y, L) [= x & x in X;
end;

theorem 
  for L being non empty LattStr, X being Subset of L st X is directed
  holds X is non empty;

definition
  struct (LattStr, multMagma) QuantaleStr (# carrier -> set, L_join, L_meet,
    multF -> BinOp of the carrier #);
end;

registration
  cluster non empty for QuantaleStr;
end;

definition
  struct (QuantaleStr, multLoopStr) QuasiNetStr (# carrier -> set, L_join,
    L_meet, multF -> (BinOp of the carrier), OneF -> Element of the carrier #);
end;

registration
  cluster non empty for QuasiNetStr;
end;

definition
  let IT be non empty multMagma;
  attr IT is with_left-zero means

  ex a being Element of IT st for b being Element of IT holds a*b = a;
  attr IT is with_right-zero means

  ex b being Element of IT st for a being Element of IT holds a*b = b;
end;

definition
  let IT be non empty multMagma;
  attr IT is with_zero means


  IT is with_left-zero with_right-zero;
end;

registration
  cluster with_zero -> with_left-zero with_right-zero for
non empty multMagma;
  cluster with_left-zero with_right-zero -> with_zero for
non empty multMagma;
end;

registration
  cluster with_zero for non empty multMagma;
end;

definition
  let IT be non empty QuantaleStr;
  attr IT is right-distributive means


  for a being Element of IT, X
being set holds a [*] "\/"(X,IT) = "\/"({a [*] b where b is Element of IT: b in
  X},IT);
  attr IT is left-distributive means


  for a being Element of IT, X
being set holds "\/"(X,IT) [*] a = "\/"({b [*] a where b is Element of IT: b in
  X},IT);
  attr IT is times-additive means

  for a,b,c being Element of IT holds (a"\/"b)
  [*]c = (a[*]c)"\/"(b[*]c) & c[*](a"\/"b) = (c[*]a)"\/"(c[*]b);
  attr IT is times-continuous means

  for X1, X2 being Subset of IT st X1 is
directed & X2 is directed holds ("\/"X1)[*]("\/"X2) = "\/"({a [*] b where a is
  Element of IT, b is Element of IT: a in X1 & b in X2},IT);
end;

reserve x,y,z for set;

theorem 
  for Q being non empty QuantaleStr st the LattStr of Q = BooleLatt
  {} holds Q is associative commutative unital with_zero complete
  right-distributive left-distributive Lattice-like;

registration
  let A be non empty set, b1,b2,b3 be BinOp of A;
  cluster QuantaleStr(#A,b1,b2,b3#) -> non empty;
end;

registration
  cluster associative commutative unital with_zero left-distributive
    right-distributive complete Lattice-like for non empty QuantaleStr;
end;

scheme 

  LUBFraenkelDistr {Q() -> complete Lattice-like non empty QuantaleStr, f(
  set, set) -> Element of Q(), X, Y() -> set}: "\/"({"\/"({f(a,b) where b is
  Element of Q(): b in Y()},Q()) where a is Element of Q(): a in X()}, Q()) =
"\/"({f(a,b) where a is Element of Q(), b is Element of Q(): a in X() & b in Y(
  )}, Q());

reserve Q for left-distributive right-distributive complete Lattice-like non
  empty QuantaleStr,
  a, b, c, d for Element of Q;

theorem 
  for Q for X,Y being set holds "\/"(X,Q) [*] "\/"(Y,Q) = "\/"({a
  [*] b: a in X & b in Y}, Q);

theorem 
  (a"\/"b) [*] c = (a [*] c) "\/" (b [*] c) & c [*] (a"\/"b) = (c
  [*] a) "\/" (c [*] b);

registration
  let A be non empty set, b1,b2,b3 be (BinOp of A), e be Element of A;
  cluster QuasiNetStr(#A,b1,b2,b3,e#) -> non empty;
end;

registration
  cluster complete Lattice-like for non empty QuasiNetStr;
end;

registration
  cluster left-distributive right-distributive -> times-continuous
    times-additive for complete Lattice-like non empty QuasiNetStr;
end;

registration
  cluster associative commutative unital with_zero with_left-zero
    left-distributive right-distributive complete Lattice-like for non empty
    QuasiNetStr;
end;

definition
  mode Quantale is associative left-distributive right-distributive complete
    Lattice-like non empty QuantaleStr;
  mode QuasiNet is unital associative with_left-zero times-continuous
    times-additive complete Lattice-like non empty QuasiNetStr;
end;

definition
  mode BlikleNet is with_zero non empty QuasiNet;
end;

theorem 
  for Q being unital non empty QuasiNetStr st Q is Quantale holds Q is
  BlikleNet;

reserve Q for Quantale,
  a,a9,b,b9,c,d,d1,d2,D for Element of Q;

theorem 
  a [= b implies a [*] c [= b [*] c & c [*] a [= c [*] b;

theorem 
  a [= b & c [= d implies a [*] c [= b [*] d;

definition
  let f be Function;
  attr f is idempotent means

  f * f = f;
end;

definition
  let L be non empty LattStr;
  let IT be UnOp of L;
  attr IT is inflationary means

  for p being Element of L holds p [= IT.p;
  attr IT is deflationary means

  for p being Element of L holds IT.p [= p;
  attr IT is monotone means


  for p,q being Element of L st p [= q holds IT.p [= IT.q;
  attr IT is \/-distributive means

  for X being Subset of L holds IT."\/"X [=
  "\/"({IT.a where a is Element of L: a in X}, L);
end;

registration
  let L be Lattice;
  cluster inflationary deflationary monotone for UnOp of L;
end;

theorem 
  for L being complete Lattice, j being UnOp of L st j is monotone
holds j is \/-distributive iff for X being Subset of L holds j."\/"X = "\/"({j.
  a where a is Element of L: a in X}, L);

definition
  let Q be non empty QuantaleStr;
  let IT be UnOp of Q;
  attr IT is times-monotone means

  for a,b being Element of Q holds IT.a [*] IT .b [= IT.(a [*] b);
end;

definition
  let Q be non empty QuantaleStr, a,b be Element of Q;
  func a -r> b -> Element of Q equals

  "\/"({ c where c is Element of Q: c [*]
  a [= b }, Q);
  func a -l> b -> Element of Q equals

  "\/"({ c where c is Element of Q: a [*]
  c [= b }, Q);
end;

theorem 
  a [*] b [= c iff b [= a -l> c;

theorem 
  a [*] b [= c iff a [= b -r> c;

theorem 
  for Q being Quantale, s,a,b being Element of Q st a [= b holds b
  -r>s [= a-r>s & b-l>s [= a-l>s;

theorem 
  for Q being Quantale, s being Element of Q, j being UnOp of Q st for a
  being Element of Q holds j.a = (a-r>s)-r>s holds j is monotone;

definition
  let Q be non empty QuantaleStr;
  let IT be Element of Q;
  attr IT is dualizing means


  for a being Element of Q holds (a-r>IT) -l>IT = a & (a-l>IT)-r>IT = a;
  attr IT is cyclic means


  for a being Element of Q holds a -r> IT = a -l> IT;
end;

theorem 
  c is cyclic iff for a,b st a [*] b [= c holds b [*] a [= c;

theorem 
  for Q being Quantale, s,a being Element of Q st s is cyclic
  holds a [= (a-r>s)-r>s & a [= (a-l>s)-l>s;

theorem 
  for Q being Quantale, s,a being Element of Q st s is cyclic holds a-r>
  s = ((a-r>s)-r>s)-r>s & a-l>s = ((a-l>s)-l>s)-l>s;

theorem 
  for Q being Quantale, s,a,b being Element of Q holds ((a-r>s)-r>s)[*](
  (b-r>s)-r>s) [= ((a[*]b)-r>s)-r>s;

theorem 
  D is dualizing implies Q is unital & the_unity_wrt the multF of
  Q = D -r> D & the_unity_wrt the multF of Q = D -l> D;

theorem 
  a is dualizing implies b -r> c = (b [*] (c -l> a)) -r> a & b -l> c = (
  (c -r> a) [*] b) -l> a;

definition
  struct (QuasiNetStr) Girard-QuantaleStr (# carrier -> set, L_join, L_meet,
    multF -> (BinOp of the carrier), OneF, absurd -> Element of the carrier #);
end;

registration
  cluster non empty for Girard-QuantaleStr;
end;

definition
  let IT be non empty Girard-QuantaleStr;
  attr IT is cyclic means


  the absurd of IT is cyclic;
  attr IT is dualized means


  the absurd of IT is dualizing;
end;

theorem 
  for Q being non empty Girard-QuantaleStr st the LattStr of Q =
  BooleLatt {} holds Q is cyclic dualized;

registration
  let A be non empty set, b1,b2,b3 be (BinOp of A), e1,e2 be Element of A;
  cluster Girard-QuantaleStr(#A,b1,b2,b3,e1,e2#) -> non empty;
end;

registration
  cluster associative commutative unital left-distributive right-distributive
complete Lattice-like cyclic dualized strict for
non empty Girard-QuantaleStr;
end;

definition
  mode Girard-Quantale is associative unital left-distributive
    right-distributive complete Lattice-like cyclic dualized non empty
    Girard-QuantaleStr;
end;

definition
  let G be Girard-QuantaleStr;
  func Bottom G -> Element of G equals

  the absurd of G;
end;

definition
  let G be non empty Girard-QuantaleStr;
  func Top G -> Element of G equals

  (Bottom G) -r> Bottom G;
  let a be Element of G;
  func Bottom a -> Element of G equals

  a -r> Bottom G;
end;

definition
  let G be non empty Girard-QuantaleStr;
  func Negation G -> UnOp of G means

  for a being Element of G holds it.a = Bottom a;
end;

definition
  let G be non empty Girard-QuantaleStr, u be UnOp of G;
  func Bottom u -> UnOp of G equals

  Negation(G)*u;
end;

definition
  let G be non empty Girard-QuantaleStr, o be BinOp of G;
  func Bottom o -> BinOp of G equals

  Negation(G)*o;
end;

reserve Q for Girard-Quantale,
  a,a1,a2,b,b1,b2,c,d for Element of Q,
  X for set;

theorem 
  Bottom Bottom a = a;

theorem 
  a [= b implies Bottom b [= Bottom a;

theorem 
  Bottom "\/"(X,Q) = "/\"({Bottom a: a in X}, Q);

theorem 
  Bottom "/\"(X,Q) = "\/"({Bottom a: a in X}, Q);

theorem 
  Bottom (a"\/"b) = Bottom a"/\"Bottom b & Bottom (a"/\"b) =
  Bottom a"\/"Bottom b;

definition
  let Q,a,b;
  func a delta b -> Element of Q equals

  Bottom (Bottom a [*] Bottom b);
end;

theorem 
  a [*] "\/"(X,Q) = "\/"({a [*] b: b in X}, Q) & a delta "/\"(X,Q) =
  "/\"({a delta c: c in X}, Q);

theorem 
  "\/"(X,Q) [*] a = "\/"({b [*] a: b in X}, Q) & "/\"(X,Q) delta a =
  "/\"({c delta a: c in X}, Q);

theorem 
  a delta (b"/\"c) = (a delta b)"/\"(a delta c) & (b"/\"c) delta a = (b
  delta a)"/\"(c delta a);

theorem 
  a1 [= b1 & a2 [= b2 implies a1 delta a2 [= b1 delta b2;

theorem 
  a delta b delta c = a delta (b delta c);

theorem 
  a [*] Top Q = a & Top Q [*] a = a;

theorem 
  a delta Bottom Q = a & (Bottom Q) delta a = a;

theorem 
  for Q being Quantale for j being UnOp of Q st j is monotone idempotent
\/-distributive ex L being complete Lattice st the carrier of L = rng j & for X
  being Subset of L holds "\/"X = j."\/"(X,Q);














begin 

reserve x, X, Y for set;

theorem 
  for L being non empty RelStr for x being Element of L for X being
  Subset of L holds X c= downarrow x iff X is_<=_than x;

theorem 
  for L being non empty RelStr for x being Element of L for X being
  Subset of L holds X c= uparrow x iff x is_<=_than X;

theorem 
  for L being antisymmetric transitive with_suprema RelStr for X, Y
being set st ex_sup_of X,L & ex_sup_of Y,L holds ex_sup_of (X \/ Y),L & "\/"(X
  \/ Y, L) = "\/"(X, L) "\/" "\/"(Y, L);

theorem 
  for L being antisymmetric transitive with_infima RelStr for X, Y being
set st ex_inf_of X,L & ex_inf_of Y,L holds ex_inf_of (X \/ Y),L & "/\"(X \/ Y,
  L) = "/\"(X, L) "/\" "/\"(Y, L);

begin 

theorem 
  for R being Relation for X, Y being set holds X c= Y implies R
  |_2 X c= R |_2 Y;

theorem 
  for L being RelStr for S, T being full SubRelStr of L st the carrier
  of S c= the carrier of T holds the InternalRel of S c= the InternalRel of T;

theorem 
  for L being non empty RelStr for S being non empty SubRelStr of L
  holds (X is directed Subset of S implies X is directed Subset of L) & (X is
  filtered Subset of S implies X is filtered Subset of L);

theorem 
  for L being non empty RelStr for S, T being non empty full SubRelStr
of L st the carrier of S c= the carrier of T for X being Subset of S holds X is
  Subset of T & for Y being Subset of T st X = Y holds (X is filtered implies Y
  is filtered) & (X is directed implies Y is directed);

begin 

definition
  let J be set, L be RelStr;
  let f, g be Function of J, the carrier of L;
  pred f <= g means


  for j being set st j in J ex a, b being Element of
  L st a = f.j & b = g.j & a <= b;
end;

notation
  let J be set, L be RelStr;
  let f, g be Function of J, the carrier of L;
  synonym g >= f for f <= g;
end;

theorem 
  for L, M being non empty RelStr, f,g being Function of L, M holds f <=
  g iff for x being Element of L holds f.x <= g.x;

begin 

definition
  let L, M be non empty RelStr;
  let f be Function of L, M;
  func Image f -> strict full SubRelStr of M equals

  subrelstr rng f;
end;

theorem 
  for L, M being non empty RelStr for f being Function of L, M for y
  being Element of Image f ex x being Element of L st f.x = y;

registration
  let L be non empty RelStr;
  let X be non empty Subset of L;
  cluster subrelstr X -> non empty;
end;

registration
  let L, M be non empty RelStr;
  let f be Function of L, M;
  cluster Image f -> non empty;
end;

begin 

theorem 
  for L being non empty RelStr holds id L is monotone;

theorem 
  for L, M, N being non empty RelStr for f being Function of L, M, g
  being Function of M, N holds f is monotone & g is monotone implies g*f is
  monotone;

theorem 
  for L, M being non empty RelStr for f being Function of L, M for X
  being Subset of L, x being Element of L holds f is monotone & x is_<=_than X
  implies f.x is_<=_than f.:X;

theorem 
  for L, M being non empty RelStr for f being Function of L, M for X
  being Subset of L, x being Element of L holds f is monotone & X is_<=_than x
  implies f.:X is_<=_than f.x;

theorem 
  for S, T being non empty RelStr for f being Function of S, T for X
  being directed Subset of S holds f is monotone implies f.:X is directed;

theorem 
  for L being with_suprema Poset for f being Function of L, L
  holds f is directed-sups-preserving implies f is monotone;

theorem 
  for L being with_infima Poset for f being Function of L, L holds f is
  filtered-infs-preserving implies f is monotone;

begin 

theorem 
  for S being non empty 1-sorted for f being Function of S, S holds f is
  idempotent implies for x being Element of S holds f.(f.x) = f.x;

theorem 
  for S being non empty 1-sorted for f being Function of S, S
  holds f is idempotent implies rng f = {x where x is Element of S: x = f.x};

theorem 
  for S being non empty 1-sorted for f being Function of S, S st f
  is idempotent holds X c= rng f implies f.:X = X;

theorem 
  for L being non empty RelStr holds id L is idempotent;

begin 

reserve L for complete LATTICE,
  a for Element of L;

theorem 
  a in X implies a <= "\/"(X, L) & "/\"(X, L) <= a;

theorem 
  for L being non empty RelStr holds (for X holds ex_sup_of X,L)
  iff (for Y holds ex_inf_of Y,L);

theorem 
  for L being non empty RelStr holds (for X holds ex_sup_of X,L)
  implies L is complete;

theorem 
  for L being non empty RelStr holds (for X holds ex_inf_of X,L)
  implies L is complete;

theorem 
  for L being non empty RelStr holds (for A being Subset of L
  holds ex_inf_of A, L) implies for X holds ex_inf_of X,L & "/\"(X, L) = "/\"(X
  /\ the carrier of L, L);

theorem 
  for L being non empty RelStr holds (for A being Subset of L holds
ex_sup_of A, L) implies for X holds ex_sup_of X,L & "\/"(X, L) = "\/"(X /\ the
  carrier of L, L);

theorem 
  for L being non empty RelStr holds (for A being Subset of L
  holds ex_inf_of A,L) implies L is complete;

registration
  cluster up-complete /\-complete upper-bounded -> complete for
non empty Poset;
end;

theorem 
  for f being Function of L, L st f is monotone for M being Subset
of L st M = {x where x is Element of L: x = f.x} holds subrelstr M is complete
  LATTICE;

theorem 
  for S being infs-inheriting non empty full SubRelStr of L holds
  S is complete LATTICE;

theorem 
  for S being sups-inheriting non empty full SubRelStr of L holds
  S is complete LATTICE;

theorem 
  for M being non empty RelStr for f being Function of L, M st f
  is sups-preserving holds Image f is sups-inheriting;

theorem 
  for M being non empty RelStr for f being Function of L, M st f
  is infs-preserving holds Image f is infs-inheriting;

theorem 
  for L, M being complete LATTICE for f being Function of L, M st f is
  sups-preserving or f is infs-preserving holds Image f is complete LATTICE;

theorem 
  for f being Function of L, L st f is idempotent
directed-sups-preserving holds Image f is directed-sups-inheriting & Image f is
  complete LATTICE;

begin 

theorem 
  for L being RelStr for F being Subset-Family of L st for X being
  Subset of L st X in F holds X is lower holds meet F is lower Subset of L;

theorem 
  for L being RelStr for F being Subset-Family of L st for X being
  Subset of L st X in F holds X is upper holds meet F is upper Subset of L;

theorem 
  for L being with_suprema antisymmetric RelStr for F being
  Subset-Family of L st for X being Subset of L st X in F holds X is lower
  directed holds meet F is directed Subset of L;

theorem 
  for L being with_infima antisymmetric RelStr for F being Subset-Family
of L st for X being Subset of L st X in F holds X is upper filtered holds meet
  F is filtered Subset of L;

theorem 
  for L being with_infima Poset for I, J being Ideal of L holds I
  /\ J is Ideal of L;

registration
  let L be non empty reflexive transitive RelStr;
  cluster Ids L -> non empty;
end;

theorem 
  for L being non empty reflexive transitive RelStr holds (x is
  Element of InclPoset(Ids L) iff x is Ideal of L);

theorem 
  for L being non empty reflexive transitive RelStr for I being
  Element of InclPoset(Ids L) holds x in I implies x is Element of L;

theorem 
  for L being with_infima Poset for x, y being Element of InclPoset(Ids
  L) holds x "/\" y = x /\ y;

registration
  let L be with_infima Poset;
  cluster InclPoset(Ids L) -> with_infima;
end;

theorem 
  for L being with_suprema Poset for x, y being Element of
InclPoset(Ids L) holds ex Z being Subset of L st Z = {z where z is Element of L
  : z in x or z in y or ex a, b being Element of L st a in x & b in y & z = a
  "\/" b} & ex_sup_of {x, y},InclPoset(Ids L) & x "\/" y = downarrow Z;

registration
  let L be with_suprema Poset;
  cluster InclPoset(Ids L) -> with_suprema;
end;

theorem 
  for L being lower-bounded sup-Semilattice for X being non empty
  Subset of Ids L holds meet X is Ideal of L;

theorem 
  for L being lower-bounded sup-Semilattice for A being non empty
Subset of InclPoset(Ids L) holds ex_inf_of A,InclPoset(Ids L) & inf A = meet A;

theorem 
  for L being with_suprema Poset holds ex_inf_of {},InclPoset(Ids
  L) & "/\"({}, InclPoset(Ids L)) = [#]L;

theorem 
  for L being lower-bounded sup-Semilattice holds InclPoset(Ids L) is complete;

registration
  let L be lower-bounded sup-Semilattice;
  cluster InclPoset(Ids L) -> complete;
end;

begin 

definition
  let L be non empty Poset;
  func SupMap L -> Function of InclPoset(Ids L), L means


  for I being Ideal of L holds it.I = sup I;
end;

theorem 
  for L being non empty Poset holds dom SupMap L = Ids L & rng
  SupMap L is Subset of L;

theorem 
  for L being non empty Poset holds x in dom SupMap L iff x is Ideal of L;

theorem 
  for L being up-complete non empty Poset holds SupMap L is monotone;

registration
  let L be up-complete non empty Poset;
  cluster SupMap L -> monotone;
end;

definition
  let L be non empty Poset;
  func IdsMap L -> Function of L, InclPoset(Ids L) means


  for x being Element of L holds it.x = downarrow x;
end;

theorem 
  for L being non empty Poset holds IdsMap L is monotone;

registration
  let L be non empty Poset;
  cluster IdsMap L -> monotone;
end;

begin 

definition
  let L be non empty RelStr;
  let F be Relation;
  func \\/(F, L) -> Element of L equals

  "\/"(rng F, L);
  func //\(F, L) -> Element of L equals

  "/\"(rng F, L);
end;

notation
  let J be set, L be non empty RelStr;
  let F be Function of J, the carrier of L;
  synonym Sup F for \\/(F, L);
  synonym Inf F for //\(F, L);
end;

reserve J for non empty set,
  j for Element of J;

theorem 
  for F being Function of J, the carrier of L holds F.j <= Sup F & Inf F <= F.j
;

theorem 
  for F being Function of J, the carrier of L holds (for j holds F.j <=
  a) implies Sup F <= a;

theorem 
  for F being Function of J, the carrier of L holds (for j holds a <= F.
  j) implies a <= Inf F;














begin 

definition
  let L1,L2 be non empty 1-sorted, f be Function of L1,L2;
  redefine attr f is one-to-one means

  for x,y being Element of L1 st f.x = f.y holds x=y;
end;

definition
  let L1,L2 be non empty RelStr, f be Function of L1,L2;
  redefine attr f is monotone means


  for x,y being Element of L1 st x <= y holds f.x <= f.y;
end;

theorem 
  for L being antisymmetric transitive with_infima RelStr, x,y,z
  being Element of L st x <= y holds x "/\" z <= y "/\" z;

theorem 
  for L being antisymmetric transitive with_suprema RelStr, x,y,z
  being Element of L st x <= y holds x "\/" z <= y "\/" z;

theorem 
  for L being non empty lower-bounded antisymmetric RelStr for x
being Element of L holds (L is with_infima implies Bottom L "/\" x = Bottom L)
  & (L is with_suprema reflexive transitive implies Bottom L "\/" x = x);

theorem 
  for L being non empty upper-bounded antisymmetric RelStr for x
  being Element of L holds (L is with_infima transitive reflexive implies Top L
  "/\" x = x) & (L is with_suprema implies Top L "\/" x = Top L);

definition
  let L be non empty RelStr;
  attr L is distributive means


  for x,y,z being Element of L holds x
  "/\" (y "\/" z) = (x "/\" y) "\/" (x "/\" z);
end;

theorem 
  for L being LATTICE holds L is distributive iff for x,y,z being
  Element of L holds x "\/" (y "/\" z) = (x "\/" y) "/\" (x "\/" z);

registration
  let X be set;
  cluster BoolePoset X -> distributive;
end;

definition
  let S be non empty RelStr, X be set;
  pred ex_min_of X,S means

  ex_inf_of X,S & "/\"(X,S) in X;
  pred ex_max_of X,S means


  ex_sup_of X,S & "\/"(X,S) in X;
end;

notation
  let S be non empty RelStr, X be set;
  synonym X has_the_min_in S for ex_min_of X,S;
  synonym X has_the_max_in S for ex_max_of X,S;
end;

definition
  let S be non empty RelStr, s be Element of S, X be set;
  pred s is_minimum_of X means


  ex_inf_of X,S & s = "/\"(X,S) & "/\"(X,S ) in X;
  pred s is_maximum_of X means


  ex_sup_of X,S & s = "\/"(X,S) & "\/"(X,S )in X;
end;

registration
  let L be RelStr;
  cluster id L -> isomorphic;
end;

definition
  let L1,L2 be RelStr;
  pred L1,L2 are_isomorphic means


  ex f being Function of L1,L2 st f is isomorphic;
  reflexivity;
end;

theorem 
  for L1,L2 be non empty RelStr st L1,L2 are_isomorphic holds L2,L1
  are_isomorphic;

theorem 
  for L1,L2,L3 being RelStr st L1,L2 are_isomorphic & L2,L3
  are_isomorphic holds L1,L3 are_isomorphic;

begin 

definition
  let S,T be RelStr;
  mode Connection of S,T -> set means


    ex g being Function of S,T, d being Function of T,S st it = [g,d];
end;

definition
  let S,T be RelStr, g be Function of S,T, d be Function of T,S;
  redefine func [g,d] -> Connection of S,T;
end;



definition
  let S,T be non empty RelStr, gc be Connection of S,T;
  attr gc is Galois means


  ex g being Function of S,T, d being Function
of T,S st gc = [g,d] & g is monotone & d is monotone & for t being Element of T
  , s being Element of S holds t <= g.s iff d.t <= s;
end;

theorem 
  for S,T being non empty Poset,g being Function of S,T, d being
Function of T,S holds [g,d] is Galois iff g is monotone & d is monotone & for t
  being Element of T, s being Element of S holds t <= g.s iff d.t <= s;



definition
  let S,T be non empty RelStr, g be Function of S,T;
  attr g is upper_adjoint means


  ex d being Function of T,S st [g,d] is Galois;
end;



definition
  let S,T be non empty RelStr, d be Function of T,S;
  attr d is lower_adjoint means


  ex g being Function of S,T st [g,d] is Galois;
end;

theorem 
  for S,T being non empty Poset,g being Function of S,T, d being
  Function of T,S st [g,d] is Galois holds g is upper_adjoint & d is
  lower_adjoint;



theorem 
  for S,T being non empty Poset,g being Function of S,T, d being
  Function of T,S holds [g,d] is Galois iff g is monotone & for t being Element
  of T holds d.t is_minimum_of g"(uparrow t);



theorem 
  for S,T being non empty Poset,g being Function of S,T, d being
  Function of T,S holds [g,d] is Galois iff d is monotone & for s being Element
  of S holds g.s is_maximum_of d"(downarrow s);



theorem 
  for S,T being non empty Poset,g being Function of S,T st g is
  upper_adjoint holds g is infs-preserving;

registration
  let S,T be non empty Poset;
  cluster upper_adjoint -> infs-preserving for Function of S,T;
end;



theorem 
  for S,T being non empty Poset, d being Function of T,S st d is
  lower_adjoint holds d is sups-preserving;

registration
  let S,T be non empty Poset;
  cluster lower_adjoint -> sups-preserving for Function of S,T;
end;



theorem 
  for S,T being non empty Poset,g being Function of S,T st S is
complete & g is infs-preserving ex d being Function of T,S st [g,d] is Galois &
  for t being Element of T holds d.t is_minimum_of g"(uparrow t);



theorem 
  for S,T being non empty Poset, d being Function of T,S st T is
complete & d is sups-preserving ex g being Function of S,T st [g,d] is Galois &
  for s being Element of S holds g.s is_maximum_of d"(downarrow s);



theorem 
  for S,T being non empty Poset, g being Function of S,T st S is
  complete holds (g is infs-preserving iff g is monotone & g is upper_adjoint);



theorem 
  for S,T being non empty Poset, d being Function of T,S st T is
  complete holds d is sups-preserving iff d is monotone & d is lower_adjoint;



theorem 
  for S,T being non empty Poset,g being Function of S,T, d being
  Function of T,S st [g,d] is Galois holds d*g <= id S & id T <= g*d;



theorem 
  for S,T being non empty Poset,g being Function of S,T, d being
  Function of T,S st g is monotone & d is monotone & d*g <= id S & id T <= g*d
  holds [g,d] is Galois;



theorem 
  for S,T being non empty Poset,g being Function of S,T, d being
  Function of T,S st g is monotone & d is monotone & d*g <= id S & id T <= g*d
  holds d = d*g*d & g = g*d*g;



theorem 
  for S,T being non empty RelStr, g being Function of S,T, d being
  Function of T,S st g = g*d*g holds g*d is idempotent;



theorem 
  for S,T being non empty Poset,g being Function of S,T, d being
Function of T,S st [g,d] is Galois & g is onto for t being Element of T holds d
  .t is_minimum_of g"{t};



theorem 
  for S,T being non empty Poset,g being Function of S,T, d being
Function of T,S st for t being Element of T holds d.t is_minimum_of g"{t} holds
  g*d = id T;



theorem 
  for S,T being non empty Poset,g being Function of S,T, d being
  Function of T,S st [g,d] is Galois holds g is onto iff d is one-to-one;



theorem 
  for S,T being non empty Poset,g being Function of S,T, d being
Function of T,S st [g,d] is Galois & d is onto for s being Element of S holds g
  .s is_maximum_of d"{s};



theorem 
  for S,T being non empty Poset,g being Function of S,T, d being
Function of T,S st for s being Element of S holds g.s is_maximum_of d"{s} holds
  d*g = id S;



theorem 
  for S,T being non empty Poset,g being Function of S,T, d being
  Function of T,S st [g,d] is Galois holds g is one-to-one iff d is onto;



definition
  let L be non empty RelStr, p be Function of L,L;
  attr p is projection means


  p is idempotent monotone;
end;

registration
  let L be non empty RelStr;
  cluster id L -> projection;
end;

registration
  let L be non empty RelStr;
  cluster projection for Function of L,L;
end;



definition
  let L be non empty RelStr, c be Function of L,L;
  attr c is closure means


  c is projection & id(L) <= c;
end;

registration
  let L be non empty RelStr;
  cluster closure -> projection for Function of L,L;
end;

registration
  let L be non empty reflexive RelStr;
  cluster closure for Function of L,L;
end;

registration
  let L be non empty reflexive RelStr;
  cluster id L -> closure;
end;



definition
  let L be non empty RelStr, k be Function of L,L;
  attr k is kernel means


  k is projection & k <= id(L);
end;

registration
  let L be non empty RelStr;
  cluster kernel -> projection for Function of L,L;
end;

registration
  let L be non empty reflexive RelStr;
  cluster kernel for Function of L,L;
end;

registration
  let L be non empty reflexive RelStr;
  cluster id L -> kernel;
end;

theorem 
  for L being non empty Poset, c being Function of L,L, X being
Subset of L st c is closure & ex_inf_of X,L & X c= rng c holds inf X = c.(inf X
  );

theorem 
  for L being non empty Poset, k being Function of L,L, X being
Subset of L st k is kernel & ex_sup_of X,L & X c= rng k holds sup X = k.(sup X)
;

definition
  let L1, L2 be non empty RelStr, g be Function of L1,L2;
  func corestr(g) -> Function of L1,Image g equals

  (the carrier of Image g)|`g;
end;

theorem 
  for L1, L2 being non empty RelStr,g being Function of L1,L2
  holds corestr g = g;

registration
  let L1, L2 be non empty RelStr, g be Function of L1,L2;
  cluster corestr g -> onto;
end;

theorem 
  for L1, L2 being non empty RelStr, g being Function of L1,L2 st
  g is monotone holds corestr g is monotone;

definition
  let L1, L2 be non empty RelStr, g be Function of L1,L2;
  func inclusion(g) -> Function of Image g,L2 equals

  id Image g;
end;

registration
  let L1, L2 be non empty RelStr, g be Function of L1,L2;
  cluster inclusion g -> one-to-one monotone;
end;

theorem 
  for L being non empty RelStr, f being Function of L,L holds (
  inclusion f)*(corestr f) = f;



theorem 
  for L being non empty Poset, f being Function of L,L st f is
  idempotent holds (corestr f)*(inclusion f) = id(Image f);



theorem 
  for L being non empty Poset, f being Function of L,L st f is
  projection ex T being non empty Poset, q being Function of L,T, i being
Function of T,L st q is monotone & q is onto & i is monotone & i is one-to-one
  & f = i*q & id(T) = q*i;



theorem 
  for L being non empty Poset, f being Function of L,L st (ex T being
  non empty Poset, q being Function of L,T, i being Function of T,L st q is
  monotone & i is monotone & f = i*q & id(T) = q*i) holds f is projection;



theorem 
  for L being non empty Poset, f being Function of L,L st f is
  closure holds [inclusion f,corestr f] is Galois;



theorem 
  for L being non empty Poset, f being Function of L,L st f is closure
ex S being non empty Poset, g being Function of S,L, d being Function of L,S st
  [g,d] is Galois & f = g*d;



theorem 
  for L being non empty Poset, f being Function of L,L st f is
  monotone & ex S being non empty Poset, g being Function of S,L, d being
  Function of L,S st [g,d] is Galois & f = g*d holds f is closure;



theorem 
  for L being non empty Poset, f being Function of L,L st f is
  kernel holds [corestr f,inclusion f] is Galois;



theorem 
  for L being non empty Poset, f being Function of L,L st f is kernel ex
T being non empty Poset, g being Function of L,T, d being Function of T,L st [g
  ,d] is Galois & f = d*g;



theorem 
  for L being non empty Poset, f being Function of L,L st f is monotone
& ex T being non empty Poset, g being Function of L,T, d being Function of T,L
  st [g,d] is Galois & f = d*g holds f is kernel;



theorem 
  for L being non empty Poset, p being Function of L,L st p is
projection holds rng p = {c where c is Element of L: c <= p.c} /\ {k where k is
  Element of L: p.k <= k};

theorem 
  for L being non empty Poset, p being Function of L,L st p is
projection holds {c where c is Element of L: c <= p.c} is non empty Subset of L
  & {k where k is Element of L: p.k <= k} is non empty Subset of L;



theorem 
  for L being non empty Poset, p being Function of L,L st p is
projection holds rng(p|{c where c is Element of L: c <= p.c}) = rng p & rng(p|{
  k where k is Element of L: p.k <= k}) = rng p;

theorem 
  for L being non empty Poset, p being Function of L,L st p is
  projection for Lc being non empty Subset of L, Lk being non empty Subset of L
  st Lc = {c where c is Element of L: c <= p.c} holds p|Lc is Function of
  subrelstr Lc,subrelstr Lc;

theorem 
  for L being non empty Poset, p being Function of L,L st p is
projection for Lk being non empty Subset of L st Lk = {k where k is Element of
L: p.k <= k} holds p|Lk is Function of subrelstr Lk,subrelstr Lk;



theorem 
  for L being non empty Poset, p being Function of L,L st p is
projection for Lc being non empty Subset of L st Lc = {c where c is Element of
L: c <= p.c} for pc being Function of subrelstr Lc,subrelstr Lc st pc = p|Lc
  holds pc is closure;



theorem 
  for L being non empty Poset, p being Function of L,L st p is
projection for Lk being non empty Subset of L st Lk = {k where k is Element of
L: p.k <= k} for pk being Function of subrelstr Lk,subrelstr Lk st pk = p|Lk
  holds pk is kernel;



theorem 
  for L being non empty Poset, p being Function of L,L st p is
monotone for Lc being Subset of L st Lc = {c where c is Element of L: c <= p.c}
  holds subrelstr Lc is sups-inheriting;



theorem 
  for L being non empty Poset, p being Function of L,L st p is
monotone for Lk being Subset of L st Lk = {k where k is Element of L: p.k <= k}
  holds subrelstr Lk is infs-inheriting;



theorem 
  for L being non empty Poset, p being Function of L,L st p is
projection for Lc being non empty Subset of L st Lc = {c where c is Element of
L: c <= p.c} holds (p is infs-preserving implies subrelstr Lc is
infs-inheriting & Image p is infs-inheriting) & (p is filtered-infs-preserving
  implies subrelstr Lc is filtered-infs-inheriting & Image p is
  filtered-infs-inheriting);



theorem 
  for L being non empty Poset, p being Function of L,L st p is
projection for Lk being non empty Subset of L st Lk = {k where k is Element of
L: p.k <= k} holds (p is sups-preserving implies subrelstr Lk is
sups-inheriting & Image p is sups-inheriting) & (p is directed-sups-preserving
  implies subrelstr Lk is directed-sups-inheriting & Image p is
  directed-sups-inheriting);



theorem 
  for L being non empty Poset, p being Function of L,L holds (p is
  closure implies Image p is infs-inheriting) & (p is kernel implies Image p is
  sups-inheriting);



theorem 
  for L being complete non empty Poset, p being Function of L,L st p
  is projection holds Image p is complete;



theorem 
  for L being non empty Poset, c being Function of L,L st c is closure
  holds corestr c is sups-preserving & for X being Subset of L st X c= the
carrier of Image c & ex_sup_of X,L holds ex_sup_of X,Image c & "\/"(X,Image c)
  = c.("\/"(X,L));



theorem 
  for L being non empty Poset, k being Function of L,L st k is kernel
  holds (corestr k) is infs-preserving & for X being Subset of L st X c= the
carrier of Image k & ex_inf_of X,L holds ex_inf_of X,Image k & "/\"(X,Image k)
  = k.("/\"(X,L));

begin 


theorem 
  for L being complete non empty Poset holds [IdsMap L,SupMap L]
  is Galois & SupMap L is sups-preserving;



theorem 
  for L being complete non empty Poset holds (IdsMap L)*(SupMap L) is
  closure & Image ((IdsMap L)*(SupMap L)),L are_isomorphic;

definition
  let S be non empty RelStr;
  let x be Element of S;
  func x "/\" -> Function of S,S means


  for s being Element of S holds it.s = x"/\"s;
end;

theorem 
  for S being non empty RelStr, x,t being Element of S holds {s
  where s is Element of S: x"/\"s <= t} = (x "/\")"(downarrow t);

theorem 
  for S being Semilattice, x be Element of S holds x "/\" is monotone;

registration
  let S be Semilattice, x be Element of S;
  cluster x "/\" -> monotone;
end;

theorem 
  for S being non empty RelStr, x being Element of S, X being
  Subset of S holds (x "/\").:X = {x"/\"y where y is Element of S: y in X};



theorem 
  for S being Semilattice holds (for x being Element of S holds x
"/\" is lower_adjoint) iff for x,t being Element of S holds ex_max_of {s where
  s is Element of S: x"/\"s <= t},S;



theorem 
  for S being Semilattice st for x being Element of S holds x "/\"
  is lower_adjoint for X being Subset of S st ex_sup_of X,S for x being Element
of S holds x "/\" "\/"(X,S) = "\/"({x"/\"y where y is Element of S: y in X},S);



theorem 
  for S being complete non empty Poset holds (for x being Element of S
holds x "/\" is lower_adjoint) iff for X being Subset of S, x being Element of
  S holds x "/\" "\/"(X,S) = "\/"({x"/\"y where y is Element of S: y in X},S);



theorem 
  for S being LATTICE st for X being Subset of S st ex_sup_of X,S
  for x being Element of S holds x"/\"("\/"(X,S)) = "\/"({x"/\" y where y is
  Element of S: y in X},S) holds S is distributive;

definition
  let H be non empty RelStr;
  attr H is Heyting means


  H is LATTICE & for x being Element of H holds x "/\" is lower_adjoint;
end;

registration
  cluster Heyting -> with_infima with_suprema reflexive transitive
    antisymmetric for non empty RelStr;
end;

definition
  let H be non empty RelStr, a be Element of H;
  assume
 H is Heyting;
  func a => -> Function of H,H means


  [it,a "/\"] is Galois;
end;

theorem 
  for H being non empty RelStr st H is Heyting holds H is distributive;

registration
  cluster Heyting -> distributive for non empty RelStr;
end;

definition
  let H be non empty RelStr, a,y be Element of H;
  func a => y -> Element of H equals

  (a=>).y;
end;

theorem 
  for H being non empty RelStr st H is Heyting for x,a,y being
  Element of H holds x >= a "/\" y iff a => x >= y;

theorem 
  for H being non empty RelStr st H is Heyting holds H is upper-bounded;

registration
  cluster Heyting -> upper-bounded for non empty RelStr;
end;

theorem 
  for H being non empty RelStr st H is Heyting for a,b being
  Element of H holds Top H = a => b iff a <= b;

theorem 
  for H being non empty RelStr st H is Heyting for a being Element of H
  holds Top H = a => a;

theorem 
  for H being non empty RelStr st H is Heyting for a,b being Element of
  H st Top H = a => b & Top H = b => a holds a = b;

theorem 
  for H being non empty RelStr st H is Heyting for a,b being
  Element of H holds b <= (a => b);

theorem 
  for H being non empty RelStr st H is Heyting for a being Element of H
  holds Top H = a => Top H;

theorem 
  for H being non empty RelStr st H is Heyting for b being Element of H
  holds b = (Top H) => b;

theorem 
  for H being non empty RelStr st H is Heyting for a,b,c being
  Element of H st a <= b holds (b => c) <= (a => c);

theorem 
  for H being non empty RelStr st H is Heyting for a,b,c being Element
  of H st b <= c holds (a => b) <= (a => c);

theorem 
  for H being non empty RelStr st H is Heyting for a,b being
  Element of H holds a"/\"(a => b) = a"/\"b;

theorem 
  for H being non empty RelStr st H is Heyting for a,b,c being
  Element of H holds (a"\/"b)=> c = (a => c) "/\" (b => c);

definition
  let H be non empty RelStr, a be Element of H;
  func 'not' a -> Element of H equals

  a => Bottom H;
end;

theorem 
  for H being non empty RelStr st H is Heyting & H is lower-bounded for
a being Element of H holds 'not' a is_maximum_of {x where x is Element of H: a
  "/\"x = Bottom H};

theorem 
  for H being non empty RelStr st H is Heyting & H is
  lower-bounded holds 'not' Bottom H = Top H & 'not' Top H = Bottom H;



theorem 
  for H being non empty lower-bounded RelStr st H is Heyting for a,b
  being Element of H holds 'not' a >= b iff 'not' b >= a;



theorem 
  for H being non empty lower-bounded RelStr st H is Heyting for a
  ,b being Element of H holds 'not' a >= b iff a "/\" b = Bottom H;

theorem 
  for H being non empty lower-bounded RelStr st H is Heyting for a,b
  being Element of H st a <= b holds 'not' b <= 'not' a;

theorem 
  for H being non empty lower-bounded RelStr st H is Heyting for a,b
  being Element of H holds 'not' (a"\/"b) = 'not' a"/\"'not' b;

theorem 
  for H being non empty lower-bounded RelStr st H is Heyting for a,b
  being Element of H holds 'not' (a"/\"b) >= 'not' a"\/"'not' b;

definition
  let L be non empty RelStr, x,y be Element of L;
  pred y is_a_complement_of x means


  x "\/" y = Top L & x "/\" y = Bottom L;
end;

definition
  let L be non empty RelStr;
  attr L is complemented means


  for x being Element of L ex y being Element of L st y is_a_complement_of x;
end;

registration
  let X be set;
  cluster BoolePoset X -> complemented;
end;



theorem 
  for L being bounded LATTICE st L is Heyting & for x being
  Element of L holds 'not' 'not' x = x for x being Element of L holds 'not' x
  is_a_complement_of x;



theorem 
  for L being bounded LATTICE holds L is distributive complemented
  iff L is Heyting & for x being Element of L holds 'not' 'not' x = x;



definition
  let B be non empty RelStr;
  attr B is Boolean means


  B is LATTICE & B is bounded distributive complemented;
end;

registration
  cluster Boolean -> reflexive transitive antisymmetric with_infima
    with_suprema bounded distributive complemented for non empty RelStr;
end;

registration
  cluster reflexive transitive antisymmetric with_infima with_suprema bounded
    distributive complemented -> Boolean for non empty RelStr;
end;

registration
  cluster Boolean -> Heyting for non empty RelStr;
end;

registration
  cluster strict Boolean non empty for LATTICE;
end;

registration
  cluster strict Heyting non empty for LATTICE;
end;














begin 

scheme 

  FraenkelA2 {A() -> non empty set, F(set, set) -> set, P[set, set], Q[set,
set] } : { F(s,t) where s is Element of A(), t is Element of A() : P[s,t] } is
  Subset of A()
provided
 for s being Element of A(), t being Element of A() holds F(s,t) in A ();

registration
  let L be RelStr, X be empty Subset of L;
  cluster downarrow X -> empty;
  cluster uparrow X -> empty;
end;

theorem 
  for X, Y being set, D being Subset of [:X,Y:] holds D c= [:proj1 D, proj2 D:]
;

theorem 
  for L being with_infima transitive antisymmetric RelStr for a, b, c, d
  being Element of L st a <= c & b <= d holds a "/\" b <= c "/\" d;

theorem 
  for L being with_suprema transitive antisymmetric RelStr for a, b, c,
  d being Element of L st a <= c & b <= d holds a "\/" b <= c "\/" d;

theorem 
  for L being complete reflexive antisymmetric non empty RelStr for D
  being Subset of L, x being Element of L st x in D holds (sup D) "/\" x = x;

theorem 
  for L being complete reflexive antisymmetric non empty RelStr for D
  being Subset of L, x being Element of L st x in D holds (inf D) "\/" x = x;

theorem 
  for L being RelStr, X, Y being Subset of L st X c= Y holds downarrow X
  c= downarrow Y;

theorem 
  for L being RelStr, X, Y being Subset of L st X c= Y holds uparrow X
  c= uparrow Y;

theorem 
  for S, T being with_infima Poset, f being Function of S, T for x, y
being Element of S holds f preserves_inf_of {x,y} iff f.(x "/\" y) = f.x "/\" f
  .y;

theorem 
  for S, T being with_suprema Poset, f being Function of S, T for x, y
being Element of S holds f preserves_sup_of {x,y} iff f.(x "\/" y) = f.x "\/" f
  .y;

scheme 

  InfUnion { L() -> complete antisymmetric non empty RelStr, P[set] } : "/\"
({ "/\"(X,L()) where X is Subset of L(): P[X] },L()) >= "/\" (union {X where X
  is Subset of L(): P[X]},L());

scheme 

  InfofInfs { L() -> complete LATTICE, P[set] } : "/\" ({ "/\"(X,L()) where X
is Subset of L(): P[X] },L()) = "/\" (union {X where X is Subset of L(): P[X]},
  L());

scheme 

  SupUnion { L() -> complete antisymmetric non empty RelStr, P[set] } : "\/"
({ "\/"(X,L()) where X is Subset of L(): P[X] },L()) <= "\/" (union {X where X
  is Subset of L(): P[X]},L());

scheme 

  SupofSups { L() -> complete LATTICE, P[set] } : "\/" ({ "\/"(X,L()) where X
is Subset of L(): P[X] },L()) = "\/" (union {X where X is Subset of L(): P[X]},
  L());

begin 

definition
  let P, R be Relation;
  func ["P,R"] -> Relation means


  for x, y being set holds [x,y] in it
  iff ex p,q,s,t being set st x = [p,q] & y = [s,t] & [p,s] in P & [q,t] in R;
end;

theorem 
  for P, R being Relation, x being set holds x in ["P,R"] iff [x`1
`1,x`2`1] in P & [x`1`2,x`2`2] in R & (ex a, b being set st x = [a,b]) & (ex c,
  d being set st x`1 = [c,d]) & ex e, f being set st x`2 = [e,f];

definition
  let A, B, X, Y be set;
  let P be Relation of A, B;
  let R be Relation of X, Y;
  redefine func ["P,R"] -> Relation of [:A,X:],[:B,Y:];
end;

definition
  let X, Y be RelStr;
  func [:X,Y:] -> strict RelStr means


  the carrier of it = [:the carrier
of X, the carrier of Y:] & the InternalRel of it = ["the InternalRel of X, the
  InternalRel of Y"];
end;

definition
  let L1, L2 be RelStr, D be Subset of [:L1,L2:];
  redefine func proj1 D -> Subset of L1;
  redefine func proj2 D -> Subset of L2;
end;

definition
  let S1, S2 be RelStr, D1 be Subset of S1, D2 be Subset of S2;
  redefine func [:D1,D2:] -> Subset of [:S1,S2:];
end;

definition
  let S1, S2 be non empty RelStr, x be Element of S1, y be Element of S2;
  redefine func [x,y] -> Element of [:S1,S2:];
end;

definition
  let L1, L2 be non empty RelStr, x be Element of [:L1,L2:];
  redefine func x`1 -> Element of L1;
  redefine func x`2 -> Element of L2;
end;

theorem 
  for S1, S2 being non empty RelStr for a, c being Element of S1,
  b, d being Element of S2 holds a <= c & b <= d iff [a,b] <= [c,d];

theorem 
  for S1, S2 being non empty RelStr, x, y being Element of [:S1,S2
  :] holds x <= y iff x`1 <= y`1 & x`2 <= y`2;

theorem 
  for A, B being RelStr, C being non empty RelStr for f, g being
Function of [:A,B:],C st for x being Element of A, y being Element of B holds f
  .(x,y) = g.(x,y) holds f = g;

registration
  let X, Y be non empty RelStr;
  cluster [:X,Y:] -> non empty;
end;

registration
  let X, Y be reflexive RelStr;
  cluster [:X,Y:] -> reflexive;
end;

registration
  let X, Y be antisymmetric RelStr;
  cluster [:X,Y:] -> antisymmetric;
end;

registration
  let X, Y be transitive RelStr;
  cluster [:X,Y:] -> transitive;
end;

registration
  let X, Y be with_suprema RelStr;
  cluster [:X,Y:] -> with_suprema;
end;

registration
  let X, Y be with_infima RelStr;
  cluster [:X,Y:] -> with_infima;
end;

theorem 
  for X, Y being RelStr st [:X,Y:] is non empty holds X is non empty & Y
  is non empty;

theorem 
  for X, Y being non empty RelStr st [:X,Y:] is reflexive holds X is
  reflexive & Y is reflexive;

theorem 
  for X, Y being non empty reflexive RelStr st [:X,Y:] is antisymmetric
  holds X is antisymmetric & Y is antisymmetric;

theorem 
  for X, Y being non empty reflexive RelStr st [:X,Y:] is transitive
  holds X is transitive & Y is transitive;

theorem 
  for X, Y being non empty reflexive RelStr st [:X,Y:] is with_suprema
  holds X is with_suprema & Y is with_suprema;

theorem 
  for X, Y being non empty reflexive RelStr st [:X,Y:] is with_infima
  holds X is with_infima & Y is with_infima;

definition
  let S1, S2 be RelStr, D1 be directed Subset of S1, D2 be directed Subset of
  S2;
  redefine func [:D1,D2:] -> directed Subset of [:S1,S2:];
end;

theorem 
  for S1, S2 being non empty RelStr for D1 being non empty Subset of S1,
D2 being non empty Subset of S2 st [:D1,D2:] is directed holds D1 is directed &
  D2 is directed;

theorem 
  for S1, S2 being non empty RelStr for D being non empty Subset
  of [:S1,S2:] holds proj1 D is non empty & proj2 D is non empty;

theorem 
  for S1, S2 being non empty reflexive RelStr for D being non empty
  directed Subset of [:S1,S2:] holds proj1 D is directed & proj2 D is directed;

definition
  let S1, S2 be RelStr, D1 be filtered Subset of S1, D2 be filtered Subset of
  S2;
  redefine func [:D1,D2:] -> filtered Subset of [:S1,S2:];
end;

theorem 
  for S1, S2 being non empty RelStr for D1 being non empty Subset of S1,
D2 being non empty Subset of S2 st [:D1,D2:] is filtered holds D1 is filtered &
  D2 is filtered;

theorem 
  for S1, S2 being non empty reflexive RelStr for D being non empty
  filtered Subset of [:S1,S2:] holds proj1 D is filtered & proj2 D is filtered;

definition
  let S1, S2 be RelStr, D1 be upper Subset of S1, D2 be upper Subset of S2;
  redefine func [:D1,D2:] -> upper Subset of [:S1,S2:];
end;

theorem 
  for S1, S2 being non empty reflexive RelStr for D1 being non empty
Subset of S1, D2 being non empty Subset of S2 st [:D1,D2:] is upper holds D1 is
  upper & D2 is upper;

theorem 
  for S1, S2 being non empty reflexive RelStr for D being non empty
  upper Subset of [:S1,S2:] holds proj1 D is upper & proj2 D is upper;

definition
  let S1, S2 be RelStr, D1 be lower Subset of S1, D2 be lower Subset of S2;
  redefine func [:D1,D2:] -> lower Subset of [:S1,S2:];
end;

theorem 
  for S1, S2 being non empty reflexive RelStr for D1 being non empty
Subset of S1, D2 being non empty Subset of S2 st [:D1,D2:] is lower holds D1 is
  lower & D2 is lower;

theorem 
  for S1, S2 being non empty reflexive RelStr for D being non empty
  lower Subset of [:S1,S2:] holds proj1 D is lower & proj2 D is lower;

definition
  let R be RelStr;
  attr R is void means


  the InternalRel of R is empty;
end;

registration
  cluster empty -> void for RelStr;
end;

registration
  cluster non void non empty strict for Poset;
end;

registration
  cluster non void -> non empty for RelStr;
end;

registration
  cluster non empty reflexive -> non void for RelStr;
end;

registration
  let R be non void RelStr;
  cluster the InternalRel of R -> non empty;
end;

theorem 
  for S1, S2 being non empty RelStr for D1 being non empty Subset
  of S1, D2 being non empty Subset of S2 for x being Element of S1, y being
  Element of S2 st [x,y] is_>=_than [:D1,D2:] holds x is_>=_than D1 & y
  is_>=_than D2;

theorem 
  for S1, S2 being non empty RelStr for D1 being Subset of S1, D2
  being Subset of S2 for x being Element of S1, y being Element of S2 st x
  is_>=_than D1 & y is_>=_than D2 holds [x,y] is_>=_than [:D1,D2:];

theorem 
  for S1, S2 being non empty RelStr for D being Subset of [:S1,S2
  :] for x being Element of S1, y being Element of S2 holds [x,y] is_>=_than D
  iff x is_>=_than proj1 D & y is_>=_than proj2 D;

theorem 
  for S1, S2 being non empty RelStr for D1 being non empty Subset
  of S1, D2 being non empty Subset of S2 for x being Element of S1, y being
  Element of S2 st [x,y] is_<=_than [:D1,D2:] holds x is_<=_than D1 & y
  is_<=_than D2;

theorem 
  for S1, S2 being non empty RelStr for D1 being Subset of S1, D2
  being Subset of S2 for x being Element of S1, y being Element of S2 st x
  is_<=_than D1 & y is_<=_than D2 holds [x,y] is_<=_than [:D1,D2:];

theorem 
  for S1, S2 being non empty RelStr for D being Subset of [:S1,S2
  :] for x being Element of S1, y being Element of S2 holds [x,y] is_<=_than D
  iff x is_<=_than proj1 D & y is_<=_than proj2 D;

theorem 
  for S1, S2 being antisymmetric non empty RelStr for D1 being
Subset of S1, D2 being Subset of S2 for x being Element of S1, y being Element
  of S2 st ex_sup_of D1,S1 & ex_sup_of D2,S2 & for b being Element of [:S1,S2:]
st b is_>=_than [:D1,D2:] holds [x,y] <= b holds (for c being Element of S1 st
  c is_>=_than D1 holds x <= c) & for d being Element of S2 st d is_>=_than D2
  holds y <= d;

theorem 
  for S1, S2 being antisymmetric non empty RelStr for D1 being
Subset of S1, D2 being Subset of S2 for x being Element of S1, y being Element
  of S2 st ex_inf_of D1,S1 & ex_inf_of D2,S2 & for b being Element of [:S1,S2:]
st b is_<=_than [:D1,D2:] holds [x,y] >= b holds (for c being Element of S1 st
  c is_<=_than D1 holds x >= c) & for d being Element of S2 st d is_<=_than D2
  holds y >= d;

theorem 
  for S1, S2 being antisymmetric non empty RelStr for D1 being non empty
  Subset of S1, D2 being non empty Subset of S2 for x being Element of S1, y
being Element of S2 st (for c being Element of S1 st c is_>=_than D1 holds x <=
  c) & for d being Element of S2 st d is_>=_than D2 holds y <= d holds for b
  being Element of [:S1,S2:] st b is_>=_than [:D1,D2:] holds [x,y] <= b;

theorem 
  for S1, S2 being antisymmetric non empty RelStr for D1 being non empty
  Subset of S1, D2 being non empty Subset of S2 for x being Element of S1, y
being Element of S2 st (for c being Element of S1 st c is_>=_than D1 holds x >=
  c) & for d being Element of S2 st d is_>=_than D2 holds y >= d holds for b
  being Element of [:S1,S2:] st b is_>=_than [:D1,D2:] holds [x,y] >= b;

theorem 
  for S1, S2 being antisymmetric non empty RelStr for D1 being non
  empty Subset of S1, D2 being non empty Subset of S2 holds ex_sup_of D1,S1 &
  ex_sup_of D2,S2 iff ex_sup_of [:D1,D2:],[:S1,S2:];

theorem 
  for S1, S2 being antisymmetric non empty RelStr for D1 being non
  empty Subset of S1, D2 being non empty Subset of S2 holds ex_inf_of D1,S1 &
  ex_inf_of D2,S2 iff ex_inf_of [:D1,D2:],[:S1,S2:];

theorem 
  for S1, S2 being antisymmetric non empty RelStr for D being
  Subset of [:S1,S2:] holds ex_sup_of proj1 D,S1 & ex_sup_of proj2 D,S2 iff
  ex_sup_of D,[:S1,S2:];

theorem 
  for S1, S2 being antisymmetric non empty RelStr for D being
  Subset of [:S1,S2:] holds ex_inf_of proj1 D,S1 & ex_inf_of proj2 D,S2 iff
  ex_inf_of D,[:S1,S2:];

theorem 
  for S1, S2 being antisymmetric non empty RelStr for D1 being non
  empty Subset of S1, D2 being non empty Subset of S2 st ex_sup_of D1,S1 &
  ex_sup_of D2,S2 holds sup [:D1,D2:] = [sup D1,sup D2];

theorem 
  for S1, S2 being antisymmetric non empty RelStr for D1 being non
  empty Subset of S1, D2 being non empty Subset of S2 st ex_inf_of D1,S1 &
  ex_inf_of D2,S2 holds inf [:D1,D2:] = [inf D1,inf D2];

registration
  let X, Y be complete antisymmetric non empty RelStr;
  cluster [:X,Y:] -> complete;
end;

theorem 
  for X, Y being non empty lower-bounded antisymmetric RelStr st [:X,Y:]
  is complete holds X is complete & Y is complete;

theorem 
  for L1,L2 being antisymmetric non empty RelStr for D being non empty
Subset of [:L1,L2:] st [:L1,L2:] is complete or ex_sup_of D,[:L1,L2:] holds sup
  D = [sup proj1 D,sup proj2 D];

theorem 
  for L1,L2 being antisymmetric non empty RelStr for D being non empty
Subset of [:L1,L2:] st [:L1,L2:] is complete or ex_inf_of D,[:L1,L2:] holds inf
  D = [inf proj1 D,inf proj2 D];

theorem 
  for S1,S2 being non empty reflexive RelStr for D being non empty
  directed Subset of [:S1,S2:] holds [:proj1 D,proj2 D:] c= downarrow D;

theorem 
  for S1,S2 being non empty reflexive RelStr for D being non empty
  filtered Subset of [:S1,S2:] holds [:proj1 D,proj2 D:] c= uparrow D;

scheme 

  Kappa2DS { X,Y,Z() -> non empty RelStr, F(set,set) -> set }: ex f being
Function of [:X(),Y():], Z() st for x being Element of X(), y being Element of
  Y() holds f.(x,y)=F(x,y)
provided
 for x being Element of X(), y being Element of Y() holds F(x,y) is
Element of Z();














begin 

theorem 
  for L being RelStr, X being set, a being Element of L st a in X &
  ex_sup_of X,L holds a <= "\/"(X,L);

theorem 
  for L being RelStr, X being set, a being Element of L st a in X &
  ex_inf_of X,L holds "/\"(X,L) <= a;

definition
  let L be RelStr, A, B be Subset of L;
  pred A is_finer_than B means


  for a being Element of L st a in A ex b
  being Element of L st b in B & a <= b;
  pred B is_coarser_than A means


  for b being Element of L st b in B ex
  a being Element of L st a in A & a <= b;
end;

definition
  let L be non empty reflexive RelStr, A, B be Subset of L;
  redefine pred A is_finer_than B;
  reflexivity;
  redefine pred B is_coarser_than A;
  reflexivity;
end;

theorem 
  for L being RelStr, B being Subset of L holds {}L is_finer_than B;

theorem 
  for L being transitive RelStr, A, B, C being Subset of L st A
  is_finer_than B & B is_finer_than C holds A is_finer_than C;

theorem 
  for L being RelStr, A, B being Subset of L st B is_finer_than A & A is
  lower holds B c= A;

theorem 
  for L being RelStr, A being Subset of L holds {}L is_coarser_than A;

theorem 
  for L being transitive RelStr, A, B, C being Subset of L st C
  is_coarser_than B & B is_coarser_than A holds C is_coarser_than A;

theorem 
  for L being RelStr, A, B being Subset of L st A is_coarser_than B & B
  is upper holds A c= B;

begin 

definition
  let L be non empty RelStr, D1, D2 be Subset of L;
  func D1 "\/" D2 -> Subset of L equals

  { x "\/" y where x, y is Element of L
  : x in D1 & y in D2 };
end;

definition
  let L be with_suprema antisymmetric RelStr, D1, D2 be Subset of L;
  redefine func D1 "\/" D2;
  commutativity;
end;

theorem 
  for L being non empty RelStr, X being Subset of L holds X "\/" {}L = {};

theorem 
  for L being non empty RelStr, X, Y being Subset of L, x, y being
  Element of L st x in X & y in Y holds x "\/" y in X "\/" Y;

theorem 
  for L being antisymmetric with_suprema RelStr for A being Subset of L,
  B being non empty Subset of L holds A is_finer_than A "\/" B;

theorem 
  for L being antisymmetric with_suprema RelStr, A, B being Subset of L
  holds A "\/" B is_coarser_than A;

theorem 
  for L being antisymmetric reflexive with_suprema RelStr for A being
  Subset of L holds A c= A "\/" A;

theorem 
  for L being with_suprema antisymmetric transitive RelStr for D1, D2,
  D3 being Subset of L holds (D1 "\/" D2) "\/" D3 = D1 "\/" (D2 "\/" D3);

registration
  let L be non empty RelStr, D1, D2 be non empty Subset of L;
  cluster D1 "\/" D2 -> non empty;
end;

registration
  let L be with_suprema transitive antisymmetric RelStr, D1, D2 be directed
  Subset of L;
  cluster D1 "\/" D2 -> directed;
end;

registration
  let L be with_suprema transitive antisymmetric RelStr, D1, D2 be filtered
  Subset of L;
  cluster D1 "\/" D2 -> filtered;
end;

registration
  let L be with_suprema Poset, D1, D2 be upper Subset of L;
  cluster D1 "\/" D2 -> upper;
end;

theorem 
  for L being non empty RelStr, Y being Subset of L, x being
  Element of L holds {x} "\/" Y = {x "\/" y where y is Element of L: y in Y};

theorem 
  for L being non empty RelStr, A, B, C being Subset of L holds A "\/" (
  B \/ C) = (A "\/" B) \/ (A "\/" C);

theorem 
  for L being antisymmetric reflexive with_suprema RelStr for A, B, C
  being Subset of L holds A \/ (B "\/" C) c= (A \/ B) "\/" (A \/ C);

theorem 
  for L being antisymmetric with_suprema RelStr, A being upper Subset of
  L for B, C being Subset of L holds (A \/ B) "\/" (A \/ C) c= A \/ (B "\/" C);

theorem 
  for L being non empty RelStr, x, y being Element of L holds {x} "\/" {
  y} = {x "\/" y};

theorem 
  for L being non empty RelStr, x, y, z being Element of L holds {x}
  "\/" {y,z} = {x "\/" y, x "\/" z};

theorem 
  for L being non empty RelStr, X1, X2, Y1, Y2 being Subset of L st X1
  c= Y1 & X2 c= Y2 holds X1 "\/" X2 c= Y1 "\/" Y2;

theorem 
  for L being with_suprema reflexive antisymmetric RelStr for D being
  Subset of L, x being Element of L st x is_<=_than D holds {x} "\/" D = D;

theorem 
  for L being with_suprema antisymmetric RelStr for D being Subset of L,
  x being Element of L holds x is_<=_than {x} "\/" D;

theorem 
  for L being with_suprema Poset, X being Subset of L, x being Element
  of L st ex_inf_of {x} "\/" X,L & ex_inf_of X,L holds x "\/" inf X <= inf ({x}
  "\/" X);

theorem 
  for L being complete transitive antisymmetric non empty RelStr
for A being Subset of L, B being non empty Subset of L holds A is_<=_than sup (
  A "\/" B);

theorem 
  for L being with_suprema transitive antisymmetric RelStr for a, b
  being Element of L, A, B being Subset of L st a is_<=_than A & b is_<=_than B
  holds a "\/" b is_<=_than A "\/" B;

theorem 
  for L being with_suprema transitive antisymmetric RelStr for a,
b being Element of L, A, B being Subset of L st a is_>=_than A & b is_>=_than B
  holds a "\/" b is_>=_than A "\/" B;

theorem 
  for L being complete non empty Poset for A, B being non empty Subset
  of L holds sup (A "\/" B) = sup A "\/" sup B;

theorem 
  for L being with_suprema antisymmetric RelStr for X being Subset
  of L, Y being non empty Subset of L holds X c= downarrow (X "\/" Y);

theorem 
  for L being with_suprema Poset for x, y being Element of InclPoset Ids
  L for X, Y being Subset of L st x = X & y = Y holds x "\/" y = downarrow (X
  "\/" Y);

theorem 
  for L being non empty RelStr, D being Subset of [:L,L:] holds union {X
where X is Subset of L: ex x being Element of L st X = {x} "\/" proj2 D & x in
  proj1 D} = proj1 D "\/" proj2 D;

theorem 
  for L being transitive antisymmetric with_suprema RelStr for D1,
  D2 being Subset of L holds downarrow ((downarrow D1) "\/" (downarrow D2)) c=
  downarrow (D1 "\/" D2);

theorem 
  for L being with_suprema Poset, D1, D2 being Subset of L holds
  downarrow ((downarrow D1) "\/" (downarrow D2)) = downarrow (D1 "\/" D2);

theorem 
  for L being transitive antisymmetric with_suprema RelStr for D1,
D2 being Subset of L holds uparrow ((uparrow D1) "\/" (uparrow D2)) c= uparrow
  (D1 "\/" D2);

theorem 
  for L being with_suprema Poset, D1, D2 being Subset of L holds uparrow
  ((uparrow D1) "\/" (uparrow D2)) = uparrow (D1 "\/" D2);

begin 

definition
  let L be non empty RelStr, D1, D2 be Subset of L;
  func D1 "/\" D2 -> Subset of L equals

  { x "/\" y where x, y is Element of L
  : x in D1 & y in D2 };
end;

definition
  let L be with_infima antisymmetric RelStr, D1, D2 be Subset of L;
  redefine func D1 "/\" D2;
  commutativity;
end;

theorem 
  for L being non empty RelStr, X being Subset of L holds X "/\" {}L = {};

theorem 
  for L being non empty RelStr, X, Y being Subset of L, x, y being
  Element of L st x in X & y in Y holds x "/\" y in X "/\" Y;

theorem 
  for L being antisymmetric with_infima RelStr for A being Subset of L,
  B being non empty Subset of L holds A is_coarser_than A "/\" B;

theorem 
  for L being antisymmetric with_infima RelStr for A, B being Subset of
  L holds A "/\" B is_finer_than A;

theorem 
  for L being antisymmetric reflexive with_infima RelStr for A being
  Subset of L holds A c= A "/\" A;

theorem 
  for L being with_infima antisymmetric transitive RelStr for D1, D2, D3
  being Subset of L holds (D1 "/\" D2) "/\" D3 = D1 "/\" (D2 "/\" D3);

registration
  let L be non empty RelStr, D1, D2 be non empty Subset of L;
  cluster D1 "/\" D2 -> non empty;
end;

registration
  let L be with_infima transitive antisymmetric RelStr, D1, D2 be directed
  Subset of L;
  cluster D1 "/\" D2 -> directed;
end;

registration
  let L be with_infima transitive antisymmetric RelStr, D1, D2 be filtered
  Subset of L;
  cluster D1 "/\" D2 -> filtered;
end;

registration
  let L be Semilattice, D1, D2 be lower Subset of L;
  cluster D1 "/\" D2 -> lower;
end;

theorem 
  for L being non empty RelStr, Y being Subset of L, x being
  Element of L holds {x} "/\" Y = {x "/\" y where y is Element of L: y in Y};

theorem 
  for L being non empty RelStr, A, B, C being Subset of L holds A "/\" (
  B \/ C) = (A "/\" B) \/ (A "/\" C);

theorem 
  for L being antisymmetric reflexive with_infima RelStr for A, B, C
  being Subset of L holds A \/ (B "/\" C) c= (A \/ B) "/\" (A \/ C);

theorem 
  for L being antisymmetric with_infima RelStr, A being lower Subset of
  L for B, C being Subset of L holds (A \/ B) "/\" (A \/ C) c= A \/ (B "/\" C);

theorem 
  for L being non empty RelStr, x, y being Element of L holds {x} "/\" {
  y} = {x "/\" y};

theorem 
  for L being non empty RelStr, x, y, z being Element of L holds {x}
  "/\" {y,z} = {x "/\" y, x "/\" z};

theorem 
  for L being non empty RelStr, X1, X2, Y1, Y2 being Subset of L st X1
  c= Y1 & X2 c= Y2 holds X1 "/\" X2 c= Y1 "/\" Y2;

theorem 
  for L being antisymmetric reflexive with_infima RelStr for A, B
  being Subset of L holds A /\ B c= A "/\" B;

theorem 
  for L being antisymmetric reflexive with_infima RelStr for A, B
  being lower Subset of L holds A "/\" B = A /\ B;

theorem 
  for L being with_infima reflexive antisymmetric RelStr for D being
  Subset of L, x being Element of L st x is_>=_than D holds {x} "/\" D = D;

theorem 
  for L being with_infima antisymmetric RelStr for D being Subset of L,
  x being Element of L holds {x} "/\" D is_<=_than x;

theorem 
  for L being Semilattice, X being Subset of L, x being Element of L st
  ex_sup_of {x} "/\" X,L & ex_sup_of X,L holds sup ({x} "/\" X) <= x "/\" sup X
;

theorem 
  for L being complete transitive antisymmetric non empty RelStr
for A being Subset of L, B being non empty Subset of L holds A is_>=_than inf (
  A "/\" B);

theorem 
  for L being with_infima transitive antisymmetric RelStr for a, b
  being Element of L, A, B being Subset of L st a is_<=_than A & b is_<=_than B
  holds a "/\" b is_<=_than A "/\" B;

theorem 
  for L being with_infima transitive antisymmetric RelStr for a, b being
Element of L, A, B being Subset of L st a is_>=_than A & b is_>=_than B holds a
  "/\" b is_>=_than A "/\" B;

theorem 
  for L being complete non empty Poset for A, B being non empty Subset
  of L holds inf (A "/\" B) = inf A "/\" inf B;

theorem 
  for L being Semilattice, x, y being Element of InclPoset Ids L for x1,
  y1 being Subset of L st x = x1 & y = y1 holds x "/\" y = x1 "/\" y1;

theorem 
  for L being with_infima antisymmetric RelStr for X being Subset of L,
  Y being non empty Subset of L holds X c= uparrow (X "/\" Y);

theorem 
  for L being non empty RelStr, D being Subset of [:L,L:] holds union {X
where X is Subset of L: ex x being Element of L st X = {x} "/\" proj2 D & x in
  proj1 D} = proj1 D "/\" proj2 D;

theorem 
  for L being transitive antisymmetric with_infima RelStr for D1,
  D2 being Subset of L holds downarrow ((downarrow D1) "/\" (downarrow D2)) c=
  downarrow (D1 "/\" D2);

theorem 
  for L being Semilattice, D1, D2 being Subset of L holds downarrow ((
  downarrow D1) "/\" (downarrow D2)) = downarrow (D1 "/\" D2);

theorem 
  for L being transitive antisymmetric with_infima RelStr for D1,
D2 being Subset of L holds uparrow ((uparrow D1) "/\" (uparrow D2)) c= uparrow
  (D1 "/\" D2);

theorem 
  for L being Semilattice, D1, D2 being Subset of L holds uparrow ((
  uparrow D1) "/\" (uparrow D2)) = uparrow (D1 "/\" D2);














begin 

registration
  let X be non empty TopSpace;
  let X1, X2 be non empty SubSpace of X;
  cluster X1 union X2 -> TopSpace-like;
end;

definition
  let A,B be non empty set;
  let A1,A2 be non empty Subset of A;
  let f1 be Function of A1,B, f2 be Function of A2,B;
  assume
 f1|(A1 /\ A2) = f2|(A1 /\ A2);
  func f1 union f2 -> Function of A1 \/ A2,B means


  it|A1 = f1 & it|A2 = f2;
end;

theorem 
  for A, B be non empty set, A1, A2 being non empty Subset of A st
A1 misses A2 for f1 being Function of A1,B, f2 being Function of A2,B holds f1|
  (A1 /\ A2) = f2|(A1 /\ A2) & (f1 union f2)|A1 = f1 & (f1 union f2)|A2 = f2;

reserve A, B for non empty set,
  A1, A2, A3 for non empty Subset of A;

theorem 
  for g being Function of A1 \/ A2,B, g1 being Function of A1,B, g2
  being Function of A2,B st g|A1 = g1 & g|A2 = g2 holds g = g1 union g2;

theorem 
  for f1 being Function of A1,B, f2 being Function of A2,B st f1|(A1 /\
  A2) = f2|(A1 /\ A2) holds f1 union f2 = f2 union f1;

theorem 
  for A12, A23 being non empty Subset of A st A12 = A1 \/ A2 & A23 = A2
  \/ A3 for f1 being Function of A1,B, f2 being Function of A2,B, f3 being
  Function of A3,B st f1|(A1 /\ A2) = f2|(A1 /\ A2) & f2|(A2 /\ A3) = f3|(A2 /\
A3) & f1|(A1 /\ A3) = f3|(A1 /\ A3) for f12 being Function of A12,B, f23 being
Function of A23,B st f12 = f1 union f2 & f23 = f2 union f3 holds f12 union f3 =
  f1 union f23;

theorem 
  for f1 being Function of A1,B, f2 being Function of A2,B st f1|(A1 /\
  A2) = f2|(A1 /\ A2) holds (A1 is Subset of A2 iff f1 union f2 = f2) & (A2 is
  Subset of A1 iff f1 union f2 = f1);

begin 

reserve X for TopSpace;

theorem 
  for X being TopStruct, X0 being SubSpace of X holds the
  TopStruct of X0 is strict SubSpace of X;

theorem 
  for X being TopStruct for X1,X2 being TopSpace st X1 = the
  TopStruct of X2 holds X1 is SubSpace of X iff X2 is SubSpace of X;

theorem 
  for X1,X2 being TopSpace st X2 = the TopStruct of X1 holds X1 is
  closed SubSpace of X iff X2 is closed SubSpace of X;

theorem 
  for X1,X2 being TopSpace st X2 = the TopStruct of X1 holds X1 is
  open SubSpace of X iff X2 is open SubSpace of X;

reserve X for non empty TopSpace;
reserve X1, X2 for non empty SubSpace of X;

theorem 
  X1 is SubSpace of X2 implies for x1 being Point of X1 ex x2
  being Point of X2 st x2 = x1;

theorem 
  for x being Point of X1 union X2 holds (ex x1 being Point of X1
  st x1 = x) or ex x2 being Point of X2 st x2 = x;

theorem 
  X1 meets X2 implies for x being Point of X1 meet X2 holds (ex x1
  being Point of X1 st x1 = x) & ex x2 being Point of X2 st x2 = x;

theorem 
  for x being Point of X1 union X2 for F1 being Subset of X1, F2 being
  Subset of X2 st F1 is closed & x in F1 & F2 is closed & x in F2 ex H being
  Subset of X1 union X2 st H is closed & x in H & H c= F1 \/ F2;

theorem 
  for x being Point of X1 union X2 for U1 being Subset of X1, U2
  being Subset of X2 st U1 is open & x in U1 & U2 is open & x in U2 ex V being
  Subset of X1 union X2 st V is open & x in V & V c= U1 \/ U2;

theorem 
  for x being Point of X1 union X2 for x1 being Point of X1, x2
  being Point of X2 st x1 = x & x2 = x for A1 being a_neighborhood of x1, A2
being a_neighborhood of x2 ex V being Subset of X1 union X2 st V is open & x in
  V & V c= A1 \/ A2;

theorem 
  for x being Point of X1 union X2 for x1 being Point of X1, x2
  being Point of X2 st x1 = x & x2 = x for A1 being a_neighborhood of x1, A2
  being a_neighborhood of x2 ex A being a_neighborhood of x st A c= A1 \/ A2;

reserve X0, X1, X2, Y1, Y2 for non empty SubSpace of X;

theorem 
  X0 is SubSpace of X1 implies X0 meets X1 & X1 meets X0;

theorem 
  X0 is SubSpace of X1 & (X0 meets X2 or X2 meets X0) implies X1
  meets X2 & X2 meets X1;

theorem 
  X0 is SubSpace of X1 & (X1 misses X2 or X2 misses X1) implies X0
  misses X2 & X2 misses X0;

theorem 
  X0 union X0 = the TopStruct of X0;

theorem 
  X0 meet X0 = the TopStruct of X0;

theorem 
  Y1 is SubSpace of X1 & Y2 is SubSpace of X2 implies Y1 union Y2
  is SubSpace of X1 union X2;

theorem 
  Y1 meets Y2 & Y1 is SubSpace of X1 & Y2 is SubSpace of X2 implies Y1
  meet Y2 is SubSpace of X1 meet X2;

theorem 
  X1 is SubSpace of X0 & X2 is SubSpace of X0 implies X1 union X2
  is SubSpace of X0;

theorem 
  X1 meets X2 & X1 is SubSpace of X0 & X2 is SubSpace of X0 implies X1
  meet X2 is SubSpace of X0;

theorem 
  ((X1 misses X0 or X0 misses X1) & (X2 meets X0 or X0 meets X2)
implies (X1 union X2) meet X0 = X2 meet X0 & X0 meet (X1 union X2) = X0 meet X2
) & ((X1 meets X0 or X0 meets X1) & (X2 misses X0 or X0 misses X2) implies (X1
  union X2) meet X0 = X1 meet X0 & X0 meet (X1 union X2) = X0 meet X1);

theorem 
  X1 meets X2 implies (X1 is SubSpace of X0 implies X1 meet X2 is
SubSpace of X0 meet X2) & (X2 is SubSpace of X0 implies X1 meet X2 is SubSpace
  of X1 meet X0);

theorem 
  X1 is SubSpace of X0 & (X0 misses X2 or X2 misses X0) implies X0
  meet (X1 union X2) = the TopStruct of X1 & X0 meet (X2 union X1) = the
  TopStruct of X1;

theorem 
  X1 meets X2 implies (X1 is SubSpace of X0 implies (X0 meet X2)
meets X1 & (X2 meet X0) meets X1) & (X2 is SubSpace of X0 implies (X1 meet X0)
  meets X2 & (X0 meet X1) meets X2);

theorem 
  X1 is SubSpace of Y1 & X2 is SubSpace of Y2 & (Y1 misses Y2 or
  Y1 meet Y2 misses X1 union X2) implies Y1 misses X2 & Y2 misses X1;

theorem 
  X1 is not SubSpace of X2 & X2 is not SubSpace of X1 & X1 union
  X2 is SubSpace of Y1 union Y2 & Y1 meet (X1 union X2) is SubSpace of X1 & Y2
meet (X1 union X2) is SubSpace of X2 implies Y1 meets X1 union X2 & Y2 meets X1
  union X2;

theorem 
  X1 meets X2 & X1 is not SubSpace of X2 & X2 is not SubSpace of
  X1 & the TopStruct of X = (Y1 union Y2) union X0 & Y1 meet (X1 union X2) is
SubSpace of X1 & Y2 meet (X1 union X2) is SubSpace of X2 & X0 meet (X1 union X2
) is SubSpace of X1 meet X2 implies Y1 meets X1 union X2 & Y2 meets X1 union X2
;

theorem 
  X1 meets X2 & X1 is not SubSpace of X2 & X2 is not SubSpace of
  X1 & not X1 union X2 is SubSpace of Y1 union Y2 & the TopStruct of X = (Y1
  union Y2) union X0 & Y1 meet (X1 union X2) is SubSpace of X1 & Y2 meet (X1
  union X2) is SubSpace of X2 & X0 meet (X1 union X2) is SubSpace of X1 meet X2
  implies Y1 union Y2 meets X1 union X2 & X0 meets X1 union X2;

theorem 
  ((X1 union X2) meets X0 iff X1 meets X0 or X2 meets X0) & (X0
  meets (X1 union X2) iff X0 meets X1 or X0 meets X2);

theorem 
  ((X1 union X2) misses X0 iff X1 misses X0 & X2 misses X0) & (X0 misses
  (X1 union X2) iff X0 misses X1 & X0 misses X2);

theorem 
  X1 meets X2 implies ((X1 meet X2) meets X0 implies X1 meets X0 & X2
  meets X0) & (X0 meets (X1 meet X2) implies X0 meets X1 & X0 meets X2);

theorem 
  X1 meets X2 implies (X1 misses X0 or X2 misses X0 implies (X1 meet X2)
  misses X0) & (X0 misses X1 or X0 misses X2 implies X0 misses (X1 meet X2));

theorem 
  for X0 being closed non empty SubSpace of X holds X0 meets X1
  implies X0 meet X1 is closed SubSpace of X1;

theorem 
  for X0 being open non empty SubSpace of X holds X0 meets X1
  implies X0 meet X1 is open SubSpace of X1;

theorem 
  for X0 being closed non empty SubSpace of X holds X1 is SubSpace of X0
  & X0 misses X2 implies X1 is closed SubSpace of X1 union X2 & X1 is closed
  SubSpace of X2 union X1;

theorem 
  for X0 being open non empty SubSpace of X holds X1 is SubSpace
  of X0 & X0 misses X2 implies X1 is open SubSpace of X1 union X2 & X1 is open
  SubSpace of X2 union X1;

begin 

definition
  let X, Y be non empty TopSpace, f be Function of X,Y, x be Point of X;
  pred f is_continuous_at x means


  for G being a_neighborhood of f.x ex
  H being a_neighborhood of x st f.:H c= G;
end;

notation
  let X, Y be non empty TopSpace, f be Function of X,Y, x be Point of X;
  antonym f is_not_continuous_at x for f is_continuous_at x;
end;

reserve X, Y for non empty TopSpace;
reserve f for Function of X,Y;

theorem 
  for x being Point of X holds f is_continuous_at x iff for G
  being a_neighborhood of f.x holds f"G is a_neighborhood of x;

theorem 
  for x being Point of X holds f is_continuous_at x iff for G
being Subset of Y st G is open & f.x in G ex H being Subset of X st H is open &
  x in H & f.:H c= G;

theorem 
  f is continuous iff for x being Point of X holds f is_continuous_at x;

theorem 
  for X,Y,Z being non empty TopSpace st the carrier of Y = the
carrier of Z & the topology of Z c= the topology of Y for f being Function of X
  ,Y, g being Function of X,Z st f = g holds for x being Point of X holds f
  is_continuous_at x implies g is_continuous_at x;

theorem 
  for X,Y,Z being non empty TopSpace st the carrier of X = the
carrier of Y & the topology of Y c= the topology of X for f being Function of X
  ,Z, g being Function of Y,Z st f = g holds for x being Point of X, y being
  Point of Y st x = y holds g is_continuous_at y implies f is_continuous_at x;

reserve X,Y,Z for non empty TopSpace;
reserve f for Function of X,Y,
  g for Function of Y,Z;

theorem 
  for x being Point of X, y being Point of Y st y = f.x holds f
  is_continuous_at x & g is_continuous_at y implies g*f is_continuous_at x;

theorem 
  for y being Point of Y holds f is continuous & g is_continuous_at y
  implies for x being Point of X st x in f"{y} holds g*f is_continuous_at x;

theorem 
  for x being Point of X holds f is_continuous_at x & g is continuous
  implies g*f is_continuous_at x;

theorem 
  f is continuous Function of X,Y iff for x being Point of X holds f
  is_continuous_at x;

theorem 
  for X,Y,Z being non empty TopSpace st the carrier of Y = the
  carrier of Z & the topology of Z c= the topology of Y for f being continuous
  Function of X,Y holds f is continuous Function of X,Z;

theorem 
  for X,Y,Z being non empty TopSpace st the carrier of X = the carrier
  of Y & the topology of Y c= the topology of X for f being continuous Function
  of Y,Z holds f is continuous Function of X,Z;

definition
  let S,T be 1-sorted;
  let f be Function of S,T;
  let R be 1-sorted such that
 the carrier of R c= the carrier of S;
  func f|R -> Function of R,T equals


  f | the carrier of R;
end;

definition
  let X, Y be non empty TopSpace, f be Function of X,Y;
  let X0 be SubSpace of X;
  redefine func f | X0 equals

  f | the carrier of X0;
end;

reserve X, Y for non empty TopSpace,
  X0 for non empty SubSpace of X;
reserve f for Function of X,Y;

theorem 
  for f0 being Function of X0,Y st for x being Point of X st x in
  the carrier of X0 holds f.x = f0.x holds f|X0 = f0;

theorem 
  the TopStruct of X0 = the TopStruct of X implies f = f|X0;

theorem 
  for A being Subset of X st A c= the carrier of X0 holds f.:A = (f|X0)
  .:A;

theorem 
  for B being Subset of Y st f"B c= the carrier of X0 holds f"B = (f|X0)
  "B;

theorem 
  for g being Function of X0,Y ex h being Function of X,Y st h|X0 = g;

reserve f for Function of X,Y,
  X0 for non empty SubSpace of X;

theorem 
  for x being Point of X, x0 being Point of X0 st x = x0 holds f
  is_continuous_at x implies f|X0 is_continuous_at x0;



theorem 
  for A being Subset of X, x being Point of X, x0 being Point of
  X0 st A c= the carrier of X0 & A is a_neighborhood of x & x = x0 holds f
  is_continuous_at x iff f|X0 is_continuous_at x0;

theorem 
  for A being Subset of X, x being Point of X, x0 being Point of
  X0 st A is open & x in A & A c= the carrier of X0 & x = x0 holds f
  is_continuous_at x iff f|X0 is_continuous_at x0;

theorem 
  for X0 being open non empty SubSpace of X, x being Point of X, x0
  being Point of X0 st x = x0 holds f is_continuous_at x iff f|X0
  is_continuous_at x0;

registration let X,Y;
  let f be continuous Function of X,Y, X0 be non empty SubSpace of X;
  cluster f|X0 -> continuous;
end;

theorem 
  for X,Y,Z being non empty TopSpace, X0 being non empty SubSpace
of X, f being Function of X,Y, g being Function of Y,Z holds (g*f)|X0 = g*(f|X0
  );

theorem 
  for X,Y,Z being non empty TopSpace, X0 being non empty SubSpace
of X, g being Function of Y,Z, f being Function of X,Y st g is continuous & f|
  X0 is continuous holds (g*f)|X0 is continuous;

theorem 
  for X,Y,Z being non empty TopSpace, X0 being non empty SubSpace of X,
  g being continuous Function of Y,Z, f being Function of X,Y st f|X0 is
  continuous Function of X0,Y holds (g*f)|X0 is continuous Function of X0,Z;



definition
  let X,Y be non empty TopSpace, X0, X1 be SubSpace of X, g be Function of X0,
  Y;
  assume
 X1 is SubSpace of X0;
  func g|X1 -> Function of X1,Y equals


  g | the carrier of X1;
end;

reserve X, Y for non empty TopSpace,
  X0, X1 for non empty SubSpace of X;
reserve f for Function of X,Y,
  g for Function of X0,Y;

theorem 
  X1 is SubSpace of X0 implies for x0 being Point of X0 st x0 in
  the carrier of X1 holds g.x0 = (g|X1).x0;

theorem 
  X1 is SubSpace of X0 implies for g1 being Function of X1,Y st for x0
being Point of X0 st x0 in the carrier of X1 holds g.x0 = g1.x0 holds g|X1 = g1
;

theorem 
  g = g|X0;

theorem 
  X1 is SubSpace of X0 implies for A being Subset of X0 st A c=
  the carrier of X1 holds g.:A = (g|X1).:A;

theorem 
  X1 is SubSpace of X0 implies for B being Subset of Y st g"B c= the
  carrier of X1 holds g"B = (g|X1)"B;

theorem 
  for g being Function of X0,Y st g = f|X0 holds X1 is SubSpace of
  X0 implies g|X1 = f|X1;

theorem 
  X1 is SubSpace of X0 implies (f|X0)|X1 = f|X1;

theorem 
  for X0, X1, X2 being non empty SubSpace of X st X1 is SubSpace
of X0 & X2 is SubSpace of X1 for g being Function of X0,Y holds (g|X1)|X2 = g|
  X2;

theorem 
  for f being Function of X,Y, f0 being Function of X1,Y, g being
Function of X0,Y holds X0 = X & f = g implies (g|X1 = f0 iff f|X1 = f0)
;

reserve X0, X1, X2 for non empty SubSpace of X;
reserve f for Function of X,Y,
  g for Function of X0,Y;

theorem 
  for x0 being Point of X0, x1 being Point of X1 st x0 = x1 holds
  X1 is SubSpace of X0 & g is_continuous_at x0 implies g|X1 is_continuous_at x1
;

theorem 
  X1 is SubSpace of X0 implies for x0 being Point of X0, x1 being
  Point of X1 st x0 = x1 holds f|X0 is_continuous_at x0 implies f|X1
  is_continuous_at x1;



theorem 
  X1 is SubSpace of X0 implies for A being Subset of X0, x0 being
  Point of X0, x1 being Point of X1 st A c= the carrier of X1 & A is
  a_neighborhood of x0 & x0 = x1 holds g is_continuous_at x0 iff g|X1
  is_continuous_at x1;

theorem 
  X1 is SubSpace of X0 implies for A being Subset of X0, x0 being
Point of X0, x1 being Point of X1 st A is open & x0 in A & A c= the carrier of
  X1 & x0 = x1 holds g is_continuous_at x0 iff g|X1 is_continuous_at x1;

theorem 
  X1 is SubSpace of X0 implies for A being Subset of X, x0 being Point
  of X0, x1 being Point of X1 st A is open & x0 in A & A c= the carrier of X1 &
  x0 = x1 holds g is_continuous_at x0 iff g|X1 is_continuous_at x1;

theorem 
  X1 is open SubSpace of X0 implies for x0 being Point of X0, x1
  being Point of X1 st x0 = x1 holds g is_continuous_at x0 iff g|X1
  is_continuous_at x1;

theorem 
  X1 is open SubSpace of X & X1 is SubSpace of X0 implies for x0 being
Point of X0, x1 being Point of X1 st x0 = x1 holds g is_continuous_at x0 iff g|
  X1 is_continuous_at x1;

theorem 
  the TopStruct of X1 = X0 implies for x0 being Point of X0, x1
  being Point of X1 st x0 = x1 holds g|X1 is_continuous_at x1 implies g
  is_continuous_at x0;

theorem 
  for g being continuous Function of X0,Y holds X1 is SubSpace of
  X0 implies g|X1 is continuous Function of X1,Y;

theorem 
  X1 is SubSpace of X0 & X2 is SubSpace of X1 implies for g being
  Function of X0,Y holds g|X1 is continuous Function of X1,Y implies g|X2 is
  continuous Function of X2,Y;

registration let X;
 cluster id X -> continuous;
end;



definition
  let X be non empty TopSpace, X0 be SubSpace of X;

  func incl X0 -> Function of X0,X equals

  (id X)|X0;
end;

notation
  let X be non empty TopSpace, X0 be SubSpace of X;
  synonym X0 incl X for incl X0;
end;

theorem 
  for X0 being non empty SubSpace of X, x being Point of X st x in the
  carrier of X0 holds (incl X0).x = x;

theorem 
  for X0 being non empty SubSpace of X, f0 being Function of X0,X st for
x being Point of X st x in the carrier of X0 holds x = f0.x holds incl X0 = f0;

theorem 
  for X0 being non empty SubSpace of X, f being Function of X,Y holds f|
  X0 = f*(incl X0);

theorem 
  for X0 being non empty SubSpace of X holds incl X0 is continuous
  Function of X0,X;

begin 

reserve X for non empty TopSpace,
  H, G for Subset of X;

definition
  let X;
  let A be Subset of X;
  func A-extension_of_the_topology_of X -> Subset-Family of X equals

  {H \/ (G
  /\ A) : H in the topology of X & G in the topology of X};
end;

theorem 
  for A being Subset of X holds the topology of X c= A
  -extension_of_the_topology_of X;

theorem 
  for A being Subset of X holds {G /\ A where G is Subset of X :
  G in the topology of X} c= A-extension_of_the_topology_of X;

theorem 
  for A being Subset of X holds for C, D being Subset of X st C
in the topology of X & D in {G /\ A where G is Subset of X : G in the topology
  of X} holds C \/ D in A-extension_of_the_topology_of X & C /\ D in A
  -extension_of_the_topology_of X;

theorem 
  for A being Subset of X holds A in A -extension_of_the_topology_of X;

theorem 
  for A being Subset of X holds A in the topology of X iff the
  topology of X = A-extension_of_the_topology_of X;

definition
  let X be non empty TopSpace, A be Subset of X;
  func X modified_with_respect_to A -> strict TopSpace equals

  TopStruct(#the
    carrier of X, A-extension_of_the_topology_of X#);
end;

registration
  let X be non empty TopSpace, A be Subset of X;
  cluster X modified_with_respect_to A -> non empty;
end;

reserve A for Subset of X;

theorem 
  the carrier of (X modified_with_respect_to A) = the carrier of X & the
topology of (X modified_with_respect_to A) = A-extension_of_the_topology_of X;

theorem 
  for B being Subset of X modified_with_respect_to A st B = A holds B is open;

theorem 
  for A being Subset of X holds A is open iff the TopStruct of X
  = X modified_with_respect_to A;

definition
  let X be non empty TopSpace, A be Subset of X;
  func modid(X,A) -> Function of X,X modified_with_respect_to A equals

  id (the
  carrier of X);
end;

theorem 
  for x being Point of X st not x in A holds modid(X,A) is_continuous_at x;

theorem 
  for X0 being non empty SubSpace of X st the carrier of X0
  misses A for x0 being Point of X0 holds (modid(X,A))|X0 is_continuous_at x0;

theorem 
  for X0 being non empty SubSpace of X st the carrier of X0 = A
  for x0 being Point of X0 holds (modid(X,A))|X0 is_continuous_at x0;

theorem 
  for X0 being non empty SubSpace of X st the carrier of X0
  misses A holds (modid(X,A))|X0 is continuous Function of X0,X
  modified_with_respect_to A;

theorem 
  for X0 being non empty SubSpace of X st the carrier of X0 = A
holds (modid(X,A))|X0 is continuous Function of X0,X modified_with_respect_to A
;

theorem 
  for A being Subset of X holds A is open iff modid(X,A) is
  continuous Function of X,X modified_with_respect_to A;

definition
  let X be non empty TopSpace, X0 be SubSpace of X;
  func X modified_with_respect_to X0 -> strict TopSpace means


  for A being Subset of X st A = the carrier of X0 holds it = X
  modified_with_respect_to A;
end;

registration
  let X be non empty TopSpace, X0 be SubSpace of X;
  cluster X modified_with_respect_to X0 -> non empty;
end;

reserve X0 for non empty SubSpace of X;

theorem 
  the carrier of (X modified_with_respect_to X0) = the carrier of
  X & for A being Subset of X st A = the carrier of X0 holds the topology of (X
  modified_with_respect_to X0) = A-extension_of_the_topology_of X;

theorem 
  for Y0 being SubSpace of X modified_with_respect_to X0 st the carrier
  of Y0 = the carrier of X0 holds Y0 is open SubSpace of X
  modified_with_respect_to X0;

theorem 
  X0 is open SubSpace of X iff the TopStruct of X = X
  modified_with_respect_to X0;

definition
  let X be non empty TopSpace, X0 be SubSpace of X;
  func modid(X,X0) -> Function of X,X modified_with_respect_to X0 means



  for A being Subset of X st A = the carrier of X0 holds it = modid(X,A);
end;

theorem 
  modid(X,X0) = id X;

theorem 
  for X0, X1 being non empty SubSpace of X st X0 misses X1 for x1
  being Point of X1 holds (modid(X,X0))|X1 is_continuous_at x1;

theorem 
  for X0 being non empty SubSpace of X for x0 being Point of X0
  holds (modid(X,X0))|X0 is_continuous_at x0;

theorem 
  for X0, X1 being non empty SubSpace of X st X0 misses X1 holds (modid(
  X,X0))|X1 is continuous Function of X1,X modified_with_respect_to X0;

theorem 
  for X0 being non empty SubSpace of X holds (modid(X,X0))|X0 is
  continuous Function of X0,X modified_with_respect_to X0;

theorem 
  for X0 being SubSpace of X holds X0 is open SubSpace of X iff modid(X,
  X0) is continuous Function of X,X modified_with_respect_to X0;

begin 

reserve X, Y for non empty TopSpace;



theorem 
  for X1, X2 being non empty SubSpace of X, g being Function of
X1 union X2,Y for x1 being Point of X1, x2 being Point of X2, x being Point of
  X1 union X2 st x = x1 & x = x2 holds g is_continuous_at x iff g|X1
  is_continuous_at x1 & g|X2 is_continuous_at x2;

theorem 
  for f being Function of X,Y, X1, X2 being non empty SubSpace of X for
x being Point of X1 union X2, x1 being Point of X1, x2 being Point of X2 st x =
x1 & x = x2 holds f|(X1 union X2) is_continuous_at x iff f|X1 is_continuous_at
  x1 & f|X2 is_continuous_at x2;

theorem 
  for f being Function of X,Y, X1, X2 being non empty SubSpace of X st X
  = X1 union X2 for x being Point of X, x1 being Point of X1, x2 being Point of
X2 st x = x1 & x = x2 holds f is_continuous_at x iff f|X1 is_continuous_at x1 &
  f|X2 is_continuous_at x2;

reserve X1, X2 for non empty SubSpace of X;



theorem 
  X1,X2 are_weakly_separated implies for g being Function of X1
  union X2,Y holds g is continuous Function of X1 union X2,Y iff g|X1 is
  continuous Function of X1,Y & g|X2 is continuous Function of X2,Y;

theorem 
  for X1, X2 being closed non empty SubSpace of X for g being
Function of X1 union X2,Y holds g is continuous Function of X1 union X2,Y iff g
  |X1 is continuous Function of X1,Y & g|X2 is continuous Function of X2,Y;

theorem 
  for X1, X2 being open non empty SubSpace of X for g being
Function of X1 union X2,Y holds g is continuous Function of X1 union X2,Y iff g
  |X1 is continuous Function of X1,Y & g|X2 is continuous Function of X2,Y;

theorem 
  X1,X2 are_weakly_separated implies for f being Function of X,Y
  holds f|(X1 union X2) is continuous Function of X1 union X2,Y iff f|X1 is
  continuous Function of X1,Y & f|X2 is continuous Function of X2,Y;

theorem 
  for f being Function of X,Y, X1, X2 being closed non empty SubSpace of
  X holds f|(X1 union X2) is continuous Function of X1 union X2,Y iff f|X1 is
  continuous Function of X1,Y & f|X2 is continuous Function of X2,Y;

theorem 
  for f being Function of X,Y, X1, X2 being open non empty SubSpace of X
  holds f|(X1 union X2) is continuous Function of X1 union X2,Y iff f|X1 is
  continuous Function of X1,Y & f|X2 is continuous Function of X2,Y;

theorem 
  for f being Function of X,Y, X1, X2 being non empty SubSpace of
  X st X = X1 union X2 & X1,X2 are_weakly_separated holds f is continuous
  Function of X,Y iff f|X1 is continuous Function of X1,Y & f|X2 is continuous
  Function of X2,Y;

theorem 
  for f being Function of X,Y, X1, X2 being closed non empty
SubSpace of X st X = X1 union X2 holds f is continuous Function of X,Y iff f|X1
  is continuous Function of X1,Y & f|X2 is continuous Function of X2,Y;

theorem 
  for f being Function of X,Y, X1, X2 being open non empty
SubSpace of X st X = X1 union X2 holds f is continuous Function of X,Y iff f|X1
  is continuous Function of X1,Y & f|X2 is continuous Function of X2,Y;



theorem 
  X1,X2 are_separated iff X1 misses X2 & for Y being non empty
  TopSpace, g being Function of X1 union X2,Y st g|X1 is continuous Function of
X1,Y & g|X2 is continuous Function of X2,Y holds g is continuous Function of X1
  union X2,Y;

theorem 
  X1,X2 are_separated iff X1 misses X2 & for Y being non empty
TopSpace, f being Function of X,Y st f|X1 is continuous Function of X1,Y & f|X2
is continuous Function of X2,Y holds f|(X1 union X2) is continuous Function of
  X1 union X2,Y;

theorem 
  for X1, X2 being non empty SubSpace of X st X = X1 union X2 holds X1,
  X2 are_separated iff X1 misses X2 & for Y being non empty TopSpace, f being
  Function of X,Y st f|X1 is continuous Function of X1,Y & f|X2 is continuous
  Function of X2,Y holds f is continuous Function of X,Y;

begin 

definition
  let X,Y be non empty TopSpace, X1, X2 be non empty SubSpace of X;
  let f1 be Function of X1,Y, f2 be Function of X2,Y;
  assume
 X1 misses X2 or f1|(X1 meet X2) = f2|(X1 meet X2);
  func f1 union f2 -> Function of X1 union X2,Y means


  it|X1 = f1 & it| X2 = f2;
end;

reserve X, Y for non empty TopSpace;

theorem 
  for X1, X2 being non empty SubSpace of X for g being Function
  of X1 union X2,Y holds g = (g|X1) union (g|X2);

theorem 
  for X1, X2 being non empty SubSpace of X st X = X1 union X2 for g
  being Function of X,Y holds g = (g|X1) union (g|X2);

theorem 
  for X1, X2 being non empty SubSpace of X st X1 meets X2 for f1
being Function of X1,Y, f2 being Function of X2,Y holds (f1 union f2)|X1 = f1 &
  (f1 union f2)|X2 = f2 iff f1|(X1 meet X2) = f2|(X1 meet X2);

theorem 
  for X1, X2 being non empty SubSpace of X, f1 being Function of X1,Y,
  f2 being Function of X2,Y st f1|(X1 meet X2) = f2|(X1 meet X2) holds (X1 is
SubSpace of X2 iff f1 union f2 = f2) & (X2 is SubSpace of X1 iff f1 union f2 =
  f1);

theorem 
  for X1, X2 being non empty SubSpace of X, f1 being Function of X1,Y,
f2 being Function of X2,Y st X1 misses X2 or f1|(X1 meet X2) = f2|(X1 meet X2)
  holds f1 union f2 = f2 union f1;

theorem 
  for X1, X2, X3 being non empty SubSpace of X, f1 being Function of X1,
Y, f2 being Function of X2,Y, f3 being Function of X3,Y st (X1 misses X2 or f1|
  (X1 meet X2) = f2|(X1 meet X2)) & (X1 misses X3 or f1|(X1 meet X3) = f3|(X1
meet X3)) & (X2 misses X3 or f2|(X2 meet X3) = f3|(X2 meet X3)) holds (f1 union
  f2) union f3 = f1 union (f2 union f3);




theorem 
  for X1, X2 being non empty SubSpace of X st X1 meets X2 for f1 being
  continuous Function of X1,Y, f2 being continuous Function of X2,Y st f1|(X1
meet X2) = f2|(X1 meet X2) holds X1,X2 are_weakly_separated implies f1 union f2
  is continuous Function of X1 union X2,Y;

theorem 
  for X1, X2 being non empty SubSpace of X st X1 misses X2 for f1
  being continuous Function of X1,Y, f2 being continuous Function of X2,Y holds
  X1,X2 are_weakly_separated implies f1 union f2 is continuous Function of X1
  union X2,Y;

theorem 
  for X1, X2 being closed non empty SubSpace of X st X1 meets X2 for f1
being continuous Function of X1,Y, f2 being continuous Function of X2,Y st f1|(
  X1 meet X2) = f2|(X1 meet X2) holds f1 union f2 is continuous Function of X1
  union X2,Y;

theorem 
  for X1, X2 being open non empty SubSpace of X st X1 meets X2 for f1
being continuous Function of X1,Y, f2 being continuous Function of X2,Y st f1|(
  X1 meet X2) = f2|(X1 meet X2) holds f1 union f2 is continuous Function of X1
  union X2,Y;

theorem 
  for X1, X2 being closed non empty SubSpace of X st X1 misses X2 for f1
  being continuous Function of X1,Y, f2 being continuous Function of X2,Y holds
  f1 union f2 is continuous Function of X1 union X2,Y;

theorem 
  for X1, X2 being open non empty SubSpace of X st X1 misses X2 for f1
  being continuous Function of X1,Y, f2 being continuous Function of X2,Y holds
  f1 union f2 is continuous Function of X1 union X2,Y;




theorem 
  for X1, X2 being non empty SubSpace of X holds X1,X2 are_separated iff
X1 misses X2 & for Y being non empty TopSpace, f1 being continuous Function of
  X1,Y, f2 being continuous Function of X2,Y holds f1 union f2 is continuous
  Function of X1 union X2,Y;



theorem 
  for X1, X2 being non empty SubSpace of X st X = X1 union X2 for f1
being continuous Function of X1,Y, f2 being continuous Function of X2,Y st (f1
  union f2)|X1 = f1 & (f1 union f2)|X2 = f2 holds X1,X2 are_weakly_separated
  implies f1 union f2 is continuous Function of X,Y;

theorem 
  for X1, X2 being closed non empty SubSpace of X, f1 being continuous
Function of X1,Y, f2 being continuous Function of X2,Y st X = X1 union X2 & (f1
  union f2)|X1 = f1 & (f1 union f2)|X2 = f2 holds f1 union f2 is continuous
  Function of X,Y;

theorem 
  for X1, X2 being open non empty SubSpace of X, f1 being continuous
Function of X1,Y, f2 being continuous Function of X2,Y st X = X1 union X2 & (f1
  union f2)|X1 = f1 & (f1 union f2)|X2 = f2 holds f1 union f2 is continuous
  Function of X,Y;














begin



reserve X for non empty TopSpace,
  D for Subset of X;

theorem 
  for B being Subset of X, C being Subset of X
  modified_with_respect_to D st B = C holds B is open implies C is open;

theorem 
  for B being Subset of X, C being Subset of X modified_with_respect_to
  D st B = C holds B is closed implies C is closed;

theorem 
  for C being Subset of X modified_with_respect_to D` st C = D
  holds C is closed;

theorem 
  for C being Subset of X modified_with_respect_to D st C = D holds
  D is dense implies C is dense & C is open;

theorem 
  for C being Subset of X modified_with_respect_to D st D c= C
  holds D is dense implies C is everywhere_dense;

theorem 
  for C being Subset of X modified_with_respect_to D` st C = D
  holds D is boundary implies C is boundary & C is closed;

theorem 
  for C being Subset of X modified_with_respect_to D` st C c= D
  holds D is boundary implies C is nowhere_dense;

begin



definition
  let Y be non empty 1-sorted;
  redefine attr Y is trivial means


  ex d being Element of Y st the carrier of Y = {d};
end;

registration
  cluster 1-element strict for TopStruct;
  cluster non trivial strict for TopStruct;
end;

theorem 
  for Y being 1-element TopStruct st the topology of Y is non
  empty holds Y is almost_discrete implies Y is TopSpace-like;

registration
  cluster 1-element strict for TopSpace;
end;

registration
  cluster -> anti-discrete discrete for 1-element TopSpace;
  cluster discrete anti-discrete -> trivial for non empty TopSpace;
end;

registration
  cluster non trivial strict for TopSpace;
end;

registration
  cluster non discrete -> non trivial for non empty TopSpace;
  cluster non anti-discrete -> non trivial for non empty TopSpace;
end;

begin



definition
  let D be set;
  func cobool D -> Subset-Family of D equals

  {{},D};
end;

registration
  let D be set;
  cluster cobool D -> non empty;
end;

definition
  let D be set;
  func ADTS(D) -> TopStruct equals

  TopStruct(#D,cobool D#);
end;

registration
  let D be set;
  cluster ADTS(D) -> strict anti-discrete TopSpace-like;
end;

registration
  let D be non empty set;
  cluster ADTS(D) -> non empty;
end;

theorem 
  for X being anti-discrete non empty TopSpace for A being Subset
of X holds (A is empty implies Cl A = {}) & (A is non empty implies Cl A = the
  carrier of X);

theorem 
  for X being anti-discrete non empty TopSpace for A being Subset
  of X holds (A <> the carrier of X implies Int A = {}) & (A = the carrier of X
  implies Int A = the carrier of X);

theorem 
  for X being non empty TopSpace holds (for A being Subset of X
  holds (A is non empty implies Cl A = the carrier of X)) implies X is
  anti-discrete;

theorem 
  for X being non empty TopSpace holds (for A being Subset of X
  holds (A <> the carrier of X implies Int A = {})) implies X is anti-discrete;

theorem 
  for X being anti-discrete non empty TopSpace for A being Subset of X
  holds (A <> {} implies A is dense) & (A <> the carrier of X implies A is
  boundary);

theorem 
  for X being non empty TopSpace holds (for A being Subset of X holds (A
  <> {} implies A is dense)) implies X is anti-discrete;

theorem 
  for X being non empty TopSpace holds (for A being Subset of X holds (A
  <> the carrier of X implies A is boundary)) implies X is anti-discrete;

registration
  let D be set;
  cluster 1TopSp D -> discrete;
end;

theorem 
  for X being discrete non empty TopSpace for A being Subset of X holds
  Cl A = A & Int A = A;

theorem 
  for X being non empty TopSpace holds (for A being Subset of X holds Cl
  A = A) implies X is discrete;

theorem 
  for X being non empty TopSpace holds (for A being Subset of X holds
  Int A = A) implies X is discrete;

theorem 
  for D being non empty set holds ADTS(D) = 1TopSp(D) iff ex d0
  being Element of D st D = {d0};

registration
  cluster discrete non anti-discrete strict non empty for TopSpace;
  cluster anti-discrete non discrete strict non empty for TopSpace;
end;

begin



definition
  let D be set, d0 be Element of D;

  func STS(D,d0) -> TopStruct equals

  TopStruct (#D,(bool D) \ {A where A is
    Subset of D : d0 in A & A <> D}#);
end;

registration
  let D be set, d0 be Element of D;
  cluster STS(D,d0) -> strict TopSpace-like;
end;

registration
  let D be non empty set, d0 be Element of D;
  cluster STS(D,d0) -> non empty;
end;

reserve D for non empty set,
  d0 for Element of D;

theorem 
  for A being Subset of STS(D,d0) holds ({d0} c= A implies A is
  closed) & (A is non empty & A is closed implies {d0} c= A);

theorem 
  D \ {d0} is non empty implies for A being Subset of STS(D,d0)
  holds (A = {d0} implies A is closed & A is boundary) & (A is non empty & A is
  closed & A is boundary implies A = {d0});

theorem 
  for A being Subset of STS(D,d0) holds (A c= D \ {d0} implies A
  is open) & (A <> D & A is open implies A c= D \ {d0});

theorem 
  D \ {d0} is non empty implies for A being Subset of STS(D,d0) holds (A
  = D \ {d0} implies A is open & A is dense) & (A <> D & A is open & A is dense
  implies A = D \ {d0});

registration
  cluster non anti-discrete non discrete strict non empty for TopSpace;
end;

theorem 
  for Y being non empty TopSpace holds the TopStruct of Y = the
TopStruct of STS(D,d0) iff the carrier of Y = D & for A being Subset of Y holds
({d0} c= A implies A is closed) & (A is non empty & A is closed implies {d0} c=
  A);

theorem 
  for Y being non empty TopSpace holds the TopStruct of Y = the
TopStruct of STS(D,d0) iff the carrier of Y = D & for A being Subset of Y holds
(A c= D \ {d0} implies A is open) & (A <> D & A is open implies A c= D \ {d0});

theorem 
  for Y being non empty TopSpace holds the TopStruct of Y = the
TopStruct of STS(D,d0) iff the carrier of Y = D & for A being non empty Subset
  of Y holds Cl A = A \/ {d0};

theorem 
  for Y being non empty TopSpace holds the TopStruct of Y = the
TopStruct of STS(D,d0) iff the carrier of Y = D & for A being Subset of Y st A
  <> D holds Int A = A \ {d0};

theorem 
  STS(D,d0) = ADTS(D) iff D = {d0};

theorem 
  STS(D,d0) = 1TopSp(D) iff D = {d0};

theorem 
  for D being non empty set, d0 being Element of D for A being Subset of
  STS(D,d0) st A = {d0} holds 1TopSp(D) = STS(D,d0) modified_with_respect_to A;

begin



definition
  let X be non empty TopSpace;
  redefine attr X is discrete means


  for A being non empty Subset of X holds A is not boundary;
end;

theorem 
  X is discrete iff for A being Subset of X holds A <> the carrier of X
  implies A is not dense;

registration
  cluster non almost_discrete -> non discrete non anti-discrete for non empty
    TopSpace;
end;

definition
  let X be non empty TopSpace;
  redefine attr X is almost_discrete means


  for A being non empty Subset of X holds A is not nowhere_dense;
end;

theorem 
  X is almost_discrete iff for A being Subset of X holds A <> the
  carrier of X implies A is not everywhere_dense;

theorem 
  X is non almost_discrete iff ex A being non empty Subset of X st
  A is boundary & A is closed;

theorem 
  X is non almost_discrete iff ex A being Subset of X st A <> the
  carrier of X & A is dense & A is open;

registration
  cluster almost_discrete non discrete non anti-discrete strict non empty
    for TopSpace;
end;

theorem 
  for C being non empty set, c0 being Element of C holds C \ {c0}
  is non empty iff STS(C,c0) is non almost_discrete;

registration
  cluster non almost_discrete strict non empty for TopSpace;
end;

theorem 
  for A being non empty Subset of X st A is boundary holds X
  modified_with_respect_to A` is non almost_discrete;

theorem 
  for A being Subset of X st A <> the carrier of X & A is dense holds X
  modified_with_respect_to A is non almost_discrete;














begin 

registration
  let X, Y be non empty set, f be Function of X, Y, Z be non empty Subset of X;
  cluster f.:Z -> non empty;
end;

registration
  cluster reflexive connected -> with_infima with_suprema for
non empty RelStr;
end;

registration
  let C be Chain;
  cluster [#]C -> directed;
end;

theorem 
  for L being up-complete Semilattice for D being non empty
  directed Subset of L, x being Element of L holds ex_sup_of {x} "/\" D,L;

theorem 
  for L being up-complete sup-Semilattice for D being non empty directed
  Subset of L, x being Element of L holds ex_sup_of {x} "\/" D,L;

theorem 
  for L being up-complete sup-Semilattice for A, B being non empty
  directed Subset of L holds A is_<=_than sup (A "\/" B);

theorem 
  for L being up-complete sup-Semilattice for A, B being non empty
  directed Subset of L holds sup (A "\/" B) = sup A "\/" sup B;

theorem 
  for L being up-complete Semilattice for D being non empty
directed Subset of [:L,L:] holds { sup ({x} "/\" proj2 D) where x is Element of
L: x in proj1 D } = { sup X where X is non empty directed Subset of L: ex x
  being Element of L st X = {x} "/\" proj2 D & x in proj1 D };

theorem 
  for L being Semilattice, D being non empty directed Subset of [:L
  ,L:] holds union {X where X is non empty directed Subset of L: ex x being
  Element of L st X = {x} "/\" proj2 D & x in proj1 D} = proj1 D "/\" proj2 D;

theorem 
  for L being up-complete Semilattice for D being non empty
  directed Subset of [:L,L:] holds ex_sup_of union {X where X is non empty
  directed Subset of L: ex x being Element of L st X = {x} "/\" proj2 D & x in
  proj1 D},L;

theorem 
  for L being up-complete Semilattice for D being non empty
directed Subset of [:L,L:] holds ex_sup_of {sup X where X is non empty directed
Subset of L: ex x being Element of L st X = {x} "/\" proj2 D & x in proj1 D},L;

theorem 
  for L being up-complete Semilattice for D being non empty
  directed Subset of [:L,L:] holds "\/" ({ sup X where X is non empty directed
Subset of L: ex x being Element of L st X = {x} "/\" proj2 D & x in proj1 D },L
  ) <= "\/" (union {X where X is non empty directed Subset of L: ex x being
  Element of L st X = {x} "/\" proj2 D & x in proj1 D},L);

theorem 
  for L being up-complete Semilattice for D being non empty
  directed Subset of [:L,L:] holds "\/" ({ sup X where X is non empty directed
Subset of L: ex x being Element of L st X = {x} "/\" proj2 D & x in proj1 D},L)
= "\/" (union {X where X is non empty directed Subset of L: ex x being Element
  of L st X = {x} "/\" proj2 D & x in proj1 D},L);

registration
  let S, T be up-complete non empty reflexive RelStr;
  cluster [:S,T:] -> up-complete;
end;

theorem 
  for S, T being non empty reflexive antisymmetric RelStr st [:S,T:] is
  up-complete holds S is up-complete & T is up-complete;

theorem 
  for L being up-complete antisymmetric non empty reflexive
  RelStr for D being non empty directed Subset of [:L,L:] holds sup D = [sup
  proj1 D,sup proj2 D];

theorem 
  for S1, S2 being RelStr, D being Subset of S1 for f being
  Function of S1,S2 st f is monotone holds f.:(downarrow D) c= downarrow (f.:D)
;

theorem 
  for S1, S2 being RelStr, D being Subset of S1 for f being
  Function of S1,S2 st f is monotone holds f.:(uparrow D) c= uparrow (f.:D);

registration
  cluster -> distributive complemented for 1-element reflexive RelStr;
end;

registration
  cluster strict 1-element for LATTICE;
end;

theorem 
  for H being distributive complete LATTICE for a being Element of
  H, X being finite Subset of H holds sup ({a} "/\" X) = a "/\" sup X;

theorem 
  for H being distributive complete LATTICE for a being Element of H, X
  being finite Subset of H holds inf ({a} "\/" X) = a "\/" inf X;

theorem 
  for H being complete distributive LATTICE, a being Element of H
  for X being finite Subset of H holds a "/\" preserves_sup_of X;

begin 

scheme 

  ExNet { L() -> non empty RelStr, N() -> prenet of L(), F(set) -> Element of
L()} : ex M being prenet of L() st the RelStr of M = the RelStr of N() & for i
being Element of M holds (the mapping of M).i = F((the mapping of N()).i);

theorem 
  for L being non empty RelStr for N being prenet of L st N is
  eventually-directed holds rng netmap (N,L) is directed;

theorem 
  for L being non empty reflexive RelStr, D being non empty
  directed Subset of L for n being Function of D, the carrier of L holds NetStr
  (#D,(the InternalRel of L)|_2 D,n#) is prenet of L;

theorem 
  for L being non empty reflexive RelStr, D being non empty
  directed Subset of L for n being Function of D, the carrier of L, N being
prenet of L st n = id D & N = NetStr (#D,(the InternalRel of L)|_2 D,n#) holds
  N is eventually-directed;

definition
  let L be non empty RelStr, N be NetStr over L;
  func sup N -> Element of L equals

  Sup the mapping of N;
end;

definition
  let L be non empty RelStr, J be set, f be Function of J,the carrier of L;
  func FinSups f -> prenet of L means


  ex g being Function of Fin J, the
  carrier of L st for x being Element of Fin J holds g.x = sup (f.:x) & it =
  NetStr (# Fin J, RelIncl Fin J, g #);
end;

theorem 
  for L being non empty RelStr, J, x being set for f being Function of J
  ,the carrier of L holds x is Element of FinSups f iff x is Element of Fin J;

registration
  let L be complete antisymmetric non empty reflexive RelStr, J be set, f be
  Function of J,the carrier of L;
  cluster FinSups f -> monotone;
end;

definition
  let L be non empty RelStr, x be Element of L, N be non empty NetStr over L;
  func x "/\" N -> strict NetStr over L means


  the RelStr of it = the
  RelStr of N & for i being Element of it ex y being Element of L st y = (the
  mapping of N).i & (the mapping of it).i = x "/\" y;
end;

theorem 
  for L being non empty RelStr, N being non empty NetStr over L
for x being Element of L, y being set holds y is Element of N iff y is Element
  of x "/\" N;

registration
  let L be non empty RelStr, x be Element of L, N be non empty NetStr over L;
  cluster x "/\" N -> non empty;
end;

registration
  let L be non empty RelStr, x be Element of L, N be prenet of L;
  cluster x "/\" N -> directed;
end;

theorem 
  for L being non empty RelStr, x being Element of L for F being
non empty NetStr over L holds rng (the mapping of x "/\" F) = {x} "/\" rng the
  mapping of F;

theorem 
  for L being non empty RelStr, J being set for f being Function
  of J,the carrier of L st for x being set holds ex_sup_of f.:x,L holds rng
  netmap(FinSups f,L) c= finsups rng f;

theorem 
  for L being non empty reflexive antisymmetric RelStr, J being
  set for f being Function of J,the carrier of L holds rng f c= rng netmap (
  FinSups f,L);

theorem 
  for L being non empty reflexive antisymmetric RelStr, J being
set for f being Function of J,the carrier of L st ex_sup_of rng f,L & ex_sup_of
rng netmap (FinSups f,L),L & for x being Element of Fin J holds ex_sup_of f.:x,
  L holds Sup f = sup FinSups f;

theorem 
  for L being with_infima antisymmetric transitive RelStr, N being
prenet of L for x being Element of L st N is eventually-directed holds x "/\" N
  is eventually-directed;

theorem 
  for L being up-complete Semilattice st for x being Element of L,
E being non empty directed Subset of L st x <= sup E holds x <= sup ({x} "/\" E
) holds for D being non empty directed Subset of L, x being Element of L holds
  x "/\" sup D = sup ({x} "/\" D);

theorem 
  for L being with_suprema Poset st for X being directed Subset of L, x
  being Element of L holds x "/\" sup X = sup ({x} "/\" X) holds for X being
Subset of L, x being Element of L st ex_sup_of X,L holds x "/\" sup X = sup ({x
  } "/\" finsups X);

theorem 
  for L being up-complete LATTICE st for X being Subset of L, x being
  Element of L holds x "/\" sup X = sup ({x} "/\" finsups X) holds for X being
non empty directed Subset of L, x being Element of L holds x "/\" sup X = sup (
  {x} "/\" X);

begin 

definition
  let L be non empty RelStr;
  func inf_op L -> Function of [:L,L:], L means


  for x, y being Element of L holds it.(x,y) = x "/\" y;
end;

theorem 
  for L being non empty RelStr, x being Element of [:L,L:] holds (
  inf_op L).x = x`1 "/\" x`2;

registration
  let L be with_infima transitive antisymmetric RelStr;
  cluster inf_op L -> monotone;
end;

theorem 
  for S being non empty RelStr, D1, D2 being Subset of S holds (
  inf_op S).:[:D1,D2:] = D1 "/\" D2;

theorem 
  for L being up-complete Semilattice for D being non empty
directed Subset of [:L,L:] holds sup ((inf_op L).:D) = sup (proj1 D "/\" proj2
  D);

definition
  let L be non empty RelStr;
  func sup_op L -> Function of [:L,L:], L means


  for x, y being Element of L holds it.(x,y) = x "\/" y;
end;

theorem 
  for L being non empty RelStr, x being Element of [:L,L:] holds (
  sup_op L).x = x`1 "\/" x`2;

registration
  let L be with_suprema transitive antisymmetric RelStr;
  cluster sup_op L -> monotone;
end;

theorem 
  for S being non empty RelStr, D1, D2 being Subset of S holds (
  sup_op S).:[:D1,D2:] = D1 "\/" D2;

theorem 
  for L being complete non empty Poset for D being non empty filtered
  Subset of [:L,L:] holds inf ((sup_op L).:D) = inf (proj1 D "\/" proj2 D);

begin 


definition
  let R be non empty reflexive RelStr;
  attr R is satisfying_MC means


  for x being Element of R, D being non
  empty directed Subset of R holds x "/\" sup D = sup ({x} "/\" D);
end;

definition
  let R be non empty reflexive RelStr;
  attr R is meet-continuous means


  R is up-complete satisfying_MC;
end;

registration
  cluster -> satisfying_MC for 1-element reflexive RelStr;
end;

registration
  cluster meet-continuous -> up-complete satisfying_MC for non empty reflexive
    RelStr;
  cluster up-complete satisfying_MC -> meet-continuous for non empty reflexive
    RelStr;
end;

theorem 
  for S being non empty reflexive RelStr st for X being Subset of
S, x being Element of S holds x "/\" sup X = "\/"({x"/\"y where y is Element of
S: y in X},S) holds S is satisfying_MC;



theorem 
  for L being up-complete Semilattice st SupMap L is
meet-preserving holds for I1, I2 being Ideal of L holds (sup I1) "/\" (sup I2)
  = sup (I1 "/\" I2);

registration
  let L be up-complete sup-Semilattice;
  cluster SupMap L -> join-preserving;
end;



theorem 
  for L being up-complete Semilattice st for I1, I2 being Ideal of
  L holds (sup I1) "/\" (sup I2) = sup (I1 "/\" I2) holds SupMap L is
  meet-preserving;



theorem 
  for L being up-complete Semilattice st for I1, I2 being Ideal of
L holds (sup I1) "/\" (sup I2) = sup (I1 "/\" I2) holds for D1, D2 be directed
  non empty Subset of L holds (sup D1) "/\" (sup D2) = sup (D1 "/\" D2);



theorem 
  for L being non empty reflexive RelStr st L is satisfying_MC
  holds for x being Element of L, N being non empty prenet of L st N is
  eventually-directed holds x "/\" sup N = sup ({x} "/\" rng netmap (N,L));



theorem 
  for L being non empty reflexive RelStr st for x being Element of
L, N being prenet of L st N is eventually-directed holds x "/\" sup N = sup ({x
  } "/\" rng netmap (N,L)) holds L is satisfying_MC;



theorem 
  for L being up-complete antisymmetric non empty reflexive
  RelStr st inf_op L is directed-sups-preserving holds for D1, D2 being non
  empty directed Subset of L holds (sup D1) "/\" (sup D2) = sup (D1 "/\" D2);



theorem 
  for L being non empty reflexive antisymmetric RelStr st for D1,
D2 being non empty directed Subset of L holds (sup D1) "/\" (sup D2) = sup (D1
  "/\" D2) holds L is satisfying_MC;



theorem 
  for L being satisfying_MC with_infima antisymmetric non empty
  reflexive RelStr holds for x being Element of L, D being non empty directed
  Subset of L st x <= sup D holds x = sup ({x} "/\" D);



theorem 
  for L being up-complete Semilattice st for x being Element of L,
E being non empty directed Subset of L st x <= sup E holds x <= sup ({x} "/\" E
  ) holds inf_op L is directed-sups-preserving;



theorem 
  for L being complete antisymmetric non empty reflexive RelStr
  st for x being Element of L, N being prenet of L st N is eventually-directed
holds x "/\" sup N = sup ({x} "/\" rng netmap (N,L)) holds for x being Element
of L, J being set, f being Function of J,the carrier of L holds x "/\" Sup f =
  sup(x "/\" FinSups f);



theorem 
  for L being complete Semilattice st for x being Element of L, J
  being set, f being Function of J,the carrier of L holds x "/\" Sup f = sup (x
  "/\" FinSups f) holds for x being Element of L, N being prenet of L st N is
  eventually-directed holds x "/\" sup N = sup ({x} "/\" rng netmap (N,L));



theorem 
  for L being up-complete LATTICE holds L is meet-continuous iff
  SupMap L is meet-preserving join-preserving;

registration
  let L be meet-continuous LATTICE;
  cluster SupMap L -> meet-preserving join-preserving;
end;



theorem 
  for L being up-complete LATTICE holds L is meet-continuous iff
  for I1, I2 being Ideal of L holds (sup I1) "/\" (sup I2) = sup (I1 "/\" I2);



theorem 
  for L being up-complete LATTICE holds L is meet-continuous iff
for D1, D2 being non empty directed Subset of L holds (sup D1) "/\" (sup D2) =
  sup (D1 "/\" D2);



theorem 
  for L being up-complete LATTICE holds L is meet-continuous iff for x
being Element of L, D being non empty directed Subset of L st x <= sup D holds
  x = sup ({x} "/\" D);



theorem 
  for L being up-complete Semilattice holds L is meet-continuous
  iff inf_op L is directed-sups-preserving;

registration
  let L be meet-continuous Semilattice;
  cluster inf_op L -> directed-sups-preserving;
end;



theorem 
  for L being up-complete Semilattice holds L is meet-continuous
  iff for x being Element of L, N being non empty prenet of L st N is
  eventually-directed holds x "/\" sup N = sup ({x} "/\" rng netmap (N,L));



theorem 
  for L being complete Semilattice holds L is meet-continuous iff for x
  being Element of L, J being set for f being Function of J,the carrier of L
  holds x "/\" Sup f = sup(x "/\" FinSups f);

registration
  let L be meet-continuous Semilattice, x be Element of L;
  cluster x "/\" -> directed-sups-preserving;
end;



theorem 
  for H being complete non empty Poset holds H is Heyting iff H
  is meet-continuous distributive;

registration
  cluster complete Heyting -> meet-continuous distributive for
non empty Poset;
  cluster complete meet-continuous distributive -> Heyting for
non empty Poset;
end;














begin 

definition  
  let L be non empty reflexive RelStr;
  let x,y be Element of L;
  pred x is_way_below y means


  for D being non empty directed Subset of L st y <= sup D
  ex d being Element of L st d in D & x <= d;
end;

notation  
  let L be non empty reflexive RelStr;
  let x,y be Element of L;
  synonym x << y for x is_way_below y; synonym y >> x for x is_way_below y;
end;

definition  
  let L be non empty reflexive RelStr;
  let x be Element of L;
  attr x is compact means


  x is_way_below x;
end;

notation  
  let L be non empty reflexive RelStr;
  let x be Element of L;
  synonym x is isolated_from_below for x is compact;
end;

theorem 
  for L being non empty reflexive antisymmetric RelStr
  for x,y being Element of L st x << y holds x <= y;

theorem 
  for L being non empty reflexive transitive RelStr, u,x,y,z being Element of L
  st u <= x & x << y & y <= z holds u << z;

theorem 
  for L being non empty Poset st L is with_suprema or L is /\-complete
  for x,y,z being Element of L
  st x << z & y << z holds ex_sup_of {x,y}, L & x "\/" y << z;

theorem 
  for L being lower-bounded antisymmetric reflexive non empty RelStr
  for x being Element of L holds Bottom L << x;

theorem 
  for L being non empty Poset, x,y,z being Element of L
  st x << y & y << z holds x << z;

theorem 
  for L being non empty reflexive antisymmetric RelStr, x,y being Element of L
  st x << y & x >> y holds x = y;

definition  
  let L be non empty reflexive RelStr;
  let x be Element of L;
  func waybelow x -> Subset of L equals

  {y where y is Element of L: y << x};
  func wayabove x -> Subset of L equals

  {y where y is Element of L: y >> x};
end;

theorem 
  for L being non empty reflexive RelStr, x,y being Element of L holds
  x in waybelow y iff x << y;

theorem 
  for L being non empty reflexive RelStr, x,y being Element of L holds
  x in wayabove y iff x >> y;

theorem 
  for L being non empty reflexive antisymmetric RelStr
  for x being Element of L holds x is_>=_than waybelow x;

theorem 
  for L being non empty reflexive antisymmetric RelStr
  for x being Element of L holds x is_<=_than wayabove x;

theorem 
  for L being non empty reflexive antisymmetric RelStr
  for x being Element of L holds
  waybelow x c= downarrow x & wayabove x c= uparrow x;

theorem 
  for L being non empty reflexive transitive RelStr
  for x,y being Element of L st x <= y
  holds waybelow x c= waybelow y & wayabove y c= wayabove x;

registration
  let L be lower-bounded non empty reflexive antisymmetric RelStr;
  let x be Element of L;
  cluster waybelow x -> non empty;
end;

registration
  let L be non empty reflexive transitive RelStr;
  let x be Element of L;
  cluster waybelow x -> lower;
  cluster wayabove x -> upper;
end;

registration
  let L be sup-Semilattice;
  let x be Element of L;
  cluster waybelow x -> directed;
end;

registration
  let L be /\-complete non empty Poset;
  let x be Element of L;
  cluster waybelow x -> directed;
end;



registration
  let L be connected non empty RelStr;
  cluster -> directed filtered for Subset of L;
end;

registration
  cluster up-complete lower-bounded -> complete for non empty Chain;
end;

registration
  cluster complete for non empty Chain;
end;

theorem 
  for L being up-complete non empty Chain
  for x,y being Element of L st x < y holds x << y;

theorem 
  for L being non empty reflexive antisymmetric RelStr
  for x,y being Element of L st x is not compact & x << y holds x < y;

theorem 
  for L being non empty lower-bounded reflexive antisymmetric RelStr
  holds Bottom L is compact;

theorem 
  for L being up-complete non empty Poset
  for D being non empty finite directed Subset of L holds sup D in D;

theorem 
  for L being up-complete non empty Poset st L is finite
  for x being Element of L holds x is isolated_from_below;

begin 

theorem 
  for L being complete LATTICE, x,y being Element of L st x << y
  for X being Subset of L st y <= sup X
  ex A being finite Subset of L st A c= X & x <= sup A;

theorem 
  for L being complete LATTICE, x,y being Element of L
  st for X being Subset of L st y <= sup X
  ex A being finite Subset of L st A c= X & x <= sup A holds x << y;

theorem 
  for L being non empty reflexive transitive RelStr
  for x,y being Element of L st x << y
  for I being Ideal of L st y <= sup I holds x in I;

theorem 
  for L being up-complete non empty Poset, x,y being Element of L st
  for I being Ideal of L st y <= sup I holds x in I holds x << y;

theorem 
  for L being lower-bounded LATTICE st L is meet-continuous
  for x,y being Element of L holds
  x << y iff for I being Ideal of L st y = sup I holds x in I;

theorem 
  for L being complete LATTICE holds
  (for x being Element of L holds x is compact) iff
  for X being non empty Subset of L ex x being Element of L st x in X &
  for y being Element of L st y in X holds not x < y;

begin 

definition
  let L be non empty reflexive RelStr;
  attr L is satisfying_axiom_of_approximation means


   for x being Element of L holds x = sup waybelow x;
end;

registration
  cluster  -> satisfying_axiom_of_approximation
     for 1-element reflexive RelStr;
end;

definition
  let L be non empty reflexive RelStr;
  attr L is continuous means


   (for x being Element of L holds waybelow x is non empty directed) &
  L is up-complete satisfying_axiom_of_approximation;
end;

registration
  cluster continuous -> up-complete satisfying_axiom_of_approximation
    for non empty reflexive RelStr;
  cluster up-complete satisfying_axiom_of_approximation -> continuous
    for lower-bounded sup-Semilattice;
end;

registration
  cluster continuous complete strict for LATTICE;
end;

registration
  let L be continuous non empty reflexive RelStr;
  let x be Element of L;
  cluster waybelow x -> non empty directed;
end;

theorem 
  for L being up-complete Semilattice
  st for x being Element of L holds waybelow x is non empty directed holds
  L is satisfying_axiom_of_approximation iff
  for x,y being Element of L st not x <= y
  ex u being Element of L st u << x & not u <= y;

theorem 
  for L being continuous LATTICE, x,y being Element of L
  holds x <= y iff waybelow x c= waybelow y;

registration
  cluster complete -> satisfying_axiom_of_approximation for non empty Chain;
end;

theorem 
  for L being complete LATTICE st for x being Element of L holds x is compact
  holds L is satisfying_axiom_of_approximation;

begin 

definition
  let f be Relation;
  attr f is non-Empty means


  for S being 1-sorted st S in rng f holds S is non empty;
  attr f is reflexive-yielding means


  for S being RelStr st S in rng f holds S is reflexive;
end;

registration
  let I be set;
  cluster RelStr-yielding non-Empty reflexive-yielding for ManySortedSet of I;
end;

registration
  let I be set;
  let J be RelStr-yielding non-Empty ManySortedSet of I;
  cluster product J -> non empty;
end;

definition
  let I be non empty set;
  let J be RelStr-yielding ManySortedSet of I;
  let i be Element of I;
  redefine func J.i -> RelStr;
end;

registration
  let I be non empty set;
  let J be RelStr-yielding non-Empty ManySortedSet of I;
  let i be Element of I;
  cluster J.i -> non empty for RelStr;
end;

registration
  let I be set;
  let J be RelStr-yielding non-Empty ManySortedSet of I;
  cluster product J -> constituted-Functions;
end;

definition
  let I be non empty set;
  let J be RelStr-yielding non-Empty ManySortedSet of I;
  let x be Element of product J;
  let i be Element of I;
  redefine func x.i -> Element of J.i;
end;

definition
  let I be non empty set;
  let J be RelStr-yielding non-Empty ManySortedSet of I;
  let i be Element of I;
  let X be Subset of product J;
  redefine func pi(X,i) -> Subset of J.i;
end;

theorem 
  for I being non empty set
  for J being RelStr-yielding non-Empty ManySortedSet of I
  for x being Function holds x is Element of product J iff dom x = I &
  for i being Element of I holds x.i is Element of J.i;

theorem 
  for I being non empty set
  for J being RelStr-yielding non-Empty ManySortedSet of I
  for x,y being Element of product J holds
  x <= y iff for i being Element of I holds x.i <= y.i;

registration
  let I be non empty set;
  let J be RelStr-yielding reflexive-yielding ManySortedSet of I;
  let i be Element of I;
  cluster J.i -> reflexive for RelStr;
end;

registration
  let I be non empty set;
  let J be RelStr-yielding non-Empty reflexive-yielding ManySortedSet of I;
  cluster product J -> reflexive;
end;

theorem 
  for I being non empty set
  for J being RelStr-yielding non-Empty ManySortedSet of I
  st for i being Element of I holds J.i is transitive
  holds product J is transitive;

theorem 
  for I being non empty set
  for J being RelStr-yielding non-Empty ManySortedSet of I
  st for i being Element of I holds J.i is antisymmetric
  holds product J is antisymmetric;

theorem 
  for I being non empty set
  for J being RelStr-yielding non-Empty reflexive-yielding ManySortedSet of I
  st for i being Element of I holds J.i is complete LATTICE
  holds product J is complete LATTICE;

theorem 
  for I being non empty set
  for J being RelStr-yielding non-Empty reflexive-yielding ManySortedSet of I
  st for i being Element of I holds J.i is complete LATTICE
  for X being Subset of product J, i being Element of I holds
  (sup X).i = sup pi(X,i);

theorem 
  for I being non empty set
  for J being RelStr-yielding non-Empty reflexive-yielding ManySortedSet of I
  st for i being Element of I holds J.i is complete LATTICE
  for x,y being Element of product J holds x << y iff
  (for i being Element of I holds x.i << y.i) &
  ex K being finite Subset of I st
  for i being Element of I st not i in K holds x.i = Bottom (J.i);

begin 

theorem 
  for T being non empty TopSpace
  for x,y being Element of InclPoset the topology of T st x is_way_below y
  for F being Subset-Family of T st F is open & y c= union F
  ex G being finite Subset of F st x c= union G;

theorem 
  for T being non empty TopSpace
  for x,y being Element of InclPoset the topology of T
  st for F being Subset-Family of T st F is open & y c= union F
  ex G being finite Subset of F st x c= union G holds x is_way_below y;

theorem 
  for T being non empty TopSpace
  for x being Element of InclPoset the topology of T
  for X being Subset of T st x = X holds x is compact iff X is compact;

theorem 
  for T being non empty TopSpace
  for x being Element of InclPoset the topology of T st x = the carrier of T
  holds x is compact iff T is compact;

definition
  let T be non empty TopSpace;
  attr T is locally-compact means


   for x being Point of T, X being Subset of T st x in X & X is open
  ex Y being Subset of T st x in Int Y & Y c= X & Y is compact;
end;

registration
  cluster compact T_2 -> regular normal locally-compact
    for non empty TopSpace;
end;

registration
  cluster compact T_2 for non empty TopSpace;
end;

theorem 
  for T being non empty TopSpace
  for x,y being Element of InclPoset the topology of T
  st ex Z being Subset of T st x c= Z & Z c= y & Z is compact holds x << y;

theorem 
  for T being non empty TopSpace st T is locally-compact
  for x,y being Element of InclPoset the topology of T st x << y
  ex Z being Subset of T st x c= Z & Z c= y & Z is compact;

theorem 
  for T being non empty TopSpace st T is locally-compact & T is T_2
  for x,y being Element of InclPoset the topology of T st x << y
  ex Z being Subset of T st Z = x & Cl Z c= y & Cl Z is compact;

theorem 
  for X being non empty TopSpace st X is regular &
  InclPoset the topology of X is continuous holds X is locally-compact;

theorem 
  for T being non empty TopSpace st T is locally-compact
  holds InclPoset the topology of T is continuous;














begin



theorem 
  for A being non empty set, B being 1-element set st A c=
  B holds A = B;

theorem 
  for A being 1-element set, B being set st A /\ B is non empty
  holds A c= B;

registration
  let S be 1-element set;
  cluster proper -> empty for Subset of S;
  cluster non empty -> non proper for Subset of S;
end;

theorem 
  for S being non empty set, y being Element of S holds {y} is proper
  implies S is non trivial;

theorem 
  for S being non trivial set, y being Element of S holds {y}
  is proper;

registration
  let S be 1-element set;
  cluster non proper -> trivial for non empty Subset of S;
end;

registration
  let S be non trivial set;
  cluster trivial -> proper for non empty Subset of S;
  cluster non proper -> non trivial for non empty Subset of S;
end;

registration
  let S be non trivial set;
  cluster trivial proper for non empty Subset of S;
  cluster non trivial non proper for non empty Subset of S;
end;

theorem 
  for Y being non empty 1-sorted, y being Element of Y holds {y} is
  proper implies Y is non trivial;

theorem 
  for Y being non trivial 1-sorted, y being Element of Y holds
  {y} is proper;

registration
  let Y be 1-element 1-sorted;
  cluster -> non proper for non empty Subset of Y;
  cluster non proper -> trivial for non empty Subset of Y;
end;

registration
  let Y be non trivial 1-sorted;
  cluster trivial -> proper for non empty Subset of Y;
  cluster non proper -> non trivial for non empty Subset of Y;
end;

registration
  let Y be non trivial 1-sorted;
  cluster trivial proper for non empty Subset of Y;
  cluster non trivial non proper for non empty Subset of Y;
end;

registration
  let Y be non trivial 1-sorted;
  cluster non empty trivial proper for Subset of Y;
end;

registration
  let X be non empty set;
  let A be proper Subset of X;
  cluster A` -> non empty;
end;

begin



theorem 
  for Y0, Y1 being TopStruct st the TopStruct of Y0 = the TopStruct of
  Y1 holds Y0 is TopSpace-like implies Y1 is TopSpace-like;

definition

  let Y be TopStruct;
  let IT be SubSpace of Y;
  attr IT is proper means


  for A being Subset of Y st A = the carrier of IT holds A is proper;
end;

reserve Y for TopStruct;

theorem 
  for Y0 being SubSpace of Y, A being Subset of Y st A = the
  carrier of Y0 holds A is proper iff Y0 is proper;

theorem 
  for Y0, Y1 being SubSpace of Y st the TopStruct of Y0 = the TopStruct
  of Y1 holds Y0 is proper implies Y1 is proper;

theorem 
  for Y0 being SubSpace of Y holds the carrier of Y0 = the carrier
  of Y implies Y0 is non proper;

registration
  let Y be 1-element TopStruct;
  cluster -> non proper for non empty SubSpace of Y;
  cluster non proper -> trivial for non empty SubSpace of Y;
end;

registration
  let Y be non trivial TopStruct;
  cluster trivial -> proper for non empty SubSpace of Y;
  cluster non proper -> non trivial for non empty SubSpace of Y;
end;

registration
  let Y be non empty TopStruct;
  cluster non proper strict non empty for SubSpace of Y;
end;

theorem 
  for Y being non empty TopStruct, Y0 being non proper SubSpace of Y
  holds the TopStruct of Y0 = the TopStruct of Y;

registration
  let Y be non empty TopStruct;
  cluster discrete -> TopSpace-like for SubSpace of Y;
  cluster anti-discrete -> TopSpace-like for SubSpace of Y;
  cluster non TopSpace-like -> non discrete for SubSpace of Y;
  cluster non TopSpace-like -> non anti-discrete for SubSpace of Y;
end;

theorem 
  for Y0, Y1 being TopStruct st the TopStruct of Y0 = the
  TopStruct of Y1 holds Y0 is discrete implies Y1 is discrete;

theorem 
  for Y0, Y1 being TopStruct st the TopStruct of Y0 = the TopStruct of
  Y1 holds Y0 is anti-discrete implies Y1 is anti-discrete;

registration
  let Y be non empty TopStruct;
  cluster discrete -> almost_discrete for SubSpace of Y;
  cluster non almost_discrete -> non discrete for SubSpace of Y;
  cluster anti-discrete -> almost_discrete for SubSpace of Y;
  cluster non almost_discrete -> non anti-discrete for SubSpace of Y;
end;

theorem 
  for Y0, Y1 being TopStruct st the TopStruct of Y0 = the TopStruct of
  Y1 holds Y0 is almost_discrete implies Y1 is almost_discrete;

registration
  let Y be non empty TopStruct;
  cluster discrete anti-discrete -> trivial for non empty SubSpace of Y;
  cluster anti-discrete non trivial -> non discrete for
non empty SubSpace of Y;
  cluster discrete non trivial -> non anti-discrete for
non empty SubSpace of Y;
end;

definition
  let Y be non empty TopStruct, y be Point of Y;
  func Sspace(y) -> strict non empty SubSpace of Y means


  the carrier of it = {y};
end;

registration
  let Y be non empty TopStruct;
  cluster strict 1-element for SubSpace of Y;
end;

registration
  let Y be non empty TopStruct, y be Point of Y;
  cluster Sspace(y) -> 1-element;
end;

theorem 
  for Y being non empty TopStruct, y being Point of Y holds Sspace(y) is
  proper iff {y} is proper;

theorem 
  for Y being non empty TopStruct, y being Point of Y holds Sspace(y) is
  proper implies Y is non trivial;

registration
  let Y be non trivial TopStruct;
  cluster proper trivial strict for non empty SubSpace of Y;
end;

registration let Y be non empty TopStruct;
 cluster 1-element for SubSpace of Y;
end;

theorem 
  for Y being non empty TopStruct, Y0 be 1-element SubSpace of Y
holds ex y being Point of Y st the TopStruct of Y0 = the TopStruct of Sspace(y)
;

theorem 
  for Y being non empty TopStruct, y being Point of Y holds Sspace(y) is
  TopSpace-like implies Sspace(y) is discrete anti-discrete;

registration
  let Y be non empty TopStruct;
  cluster trivial TopSpace-like -> discrete anti-discrete for
non empty SubSpace
    of Y;
end;

registration
  let X be non empty TopSpace;
  cluster trivial strict TopSpace-like non empty for SubSpace of X;
end;

registration
  let X be non empty TopSpace, x be Point of X;
  cluster Sspace(x) -> TopSpace-like;
end;

registration
  let X be non empty TopSpace;
  cluster discrete anti-discrete strict non empty for SubSpace of X;
end;

registration
  let X be non empty TopSpace, x be Point of X;
  cluster Sspace(x) -> discrete anti-discrete;
end;

registration
  let X be non empty TopSpace;
  cluster non proper -> open closed for SubSpace of X;
  cluster non open -> proper for SubSpace of X;
  cluster non closed -> proper for SubSpace of X;
end;

registration
  let X be non empty TopSpace;
  cluster open closed strict for SubSpace of X;
end;

registration
  let X be discrete non empty TopSpace;
  cluster anti-discrete -> trivial for non empty SubSpace of X;
  cluster non trivial -> non anti-discrete for non empty SubSpace of X;
end;

registration
  let X be discrete non trivial TopSpace;
  cluster discrete open closed proper strict for SubSpace of X;
end;

registration
  let X be anti-discrete non empty TopSpace;
  cluster discrete -> trivial for non empty SubSpace of X;
  cluster non trivial -> non discrete for non empty SubSpace of X;
end;

registration
  let X be anti-discrete non trivial TopSpace;
  cluster -> non open non closed for proper non empty SubSpace of X;
  cluster -> trivial proper for discrete non empty SubSpace of X;
end;

registration
  let X be anti-discrete non trivial TopSpace;
  cluster anti-discrete non open non closed proper strict for SubSpace of X;
end;

registration
  let X be almost_discrete non trivial TopSpace;
  cluster almost_discrete proper strict non empty for SubSpace of X;
end;

begin



definition
  let Y be TopStruct, IT be Subset of Y;
  attr IT is discrete means


  for D being Subset of Y st D c= IT ex G
  being Subset of Y st G is open & IT /\ G = D;
end;

definition
  let Y be TopStruct;
  let A be Subset of Y;
  redefine attr A is discrete means


  for D being Subset of Y st D c= A
  ex F being Subset of Y st F is closed & A /\ F = D;
end;

theorem 
  for Y0, Y1 being TopStruct, D0 being Subset of Y0, D1 being
Subset of Y1 st the TopStruct of Y0 = the TopStruct of Y1 & D0 = D1 holds D0 is
  discrete implies D1 is discrete;

theorem 
  for Y being non empty TopStruct, Y0 being non empty SubSpace of
  Y, A being Subset of Y st A = the carrier of Y0 holds A is discrete iff Y0 is
  discrete;

theorem 
  for Y being non empty TopStruct, A being Subset of Y st A = the
  carrier of Y holds A is discrete iff Y is discrete;

theorem 
  for A, B being Subset of Y st B c= A holds A is discrete implies
  B is discrete;

theorem 
  for A, B being Subset of Y holds A is discrete or B is discrete
  implies A /\ B is discrete;

theorem 
  (for P, Q being Subset of Y st P is open & Q is open holds P /\
Q is open & P \/ Q is open) implies for A, B being Subset of Y st A is open & B
  is open holds A is discrete & B is discrete implies A \/ B is discrete;

theorem 
  (for P, Q being Subset of Y st P is closed & Q is closed holds P
  /\ Q is closed & P \/ Q is closed) implies for A, B being Subset of Y st A is
  closed & B is closed holds A is discrete & B is discrete implies A \/ B is
  discrete;

theorem 
  for A being Subset of Y holds A is discrete implies for x being
  Point of Y st x in A ex G being Subset of Y st G is open & A /\ G = {x};

theorem 
  for A being Subset of Y holds A is discrete implies for x being Point
  of Y st x in A ex F being Subset of Y st F is closed & A /\ F = {x};

reserve X for non empty TopSpace;

theorem 
  for A0 being non empty Subset of X st A0 is discrete ex X0 being
  discrete strict non empty SubSpace of X st A0 = the carrier of X0;

theorem 
  for A being empty Subset of X holds A is discrete;

theorem 
  for x being Point of X holds {x} is discrete;

theorem 
  for A being Subset of X holds (for x being Point of X st x in A
  ex G being Subset of X st G is open & A /\ G = {x}) implies A is discrete;

theorem 
  for A, B being Subset of X st A is open & B is open holds A is
  discrete & B is discrete implies A \/ B is discrete;

theorem 
  for A, B being Subset of X st A is closed & B is closed holds A is
  discrete & B is discrete implies A \/ B is discrete;

theorem 
  for A being Subset of X st A is everywhere_dense holds A is discrete
  implies A is open;

theorem 
  for A being Subset of X holds A is discrete iff for D being
  Subset of X st D c= A holds A /\ Cl D = D;

theorem 
  for A being Subset of X holds A is discrete implies for x being
  Point of X st x in A holds A /\ Cl {x} = {x};

theorem 
  for X being discrete non empty TopSpace, A being Subset of X holds A
  is discrete;

theorem 
  for X being anti-discrete non empty TopSpace, A being non empty
  Subset of X holds A is discrete iff A is trivial;

definition
  let Y be TopStruct, IT be Subset of Y;
  attr IT is maximal_discrete means


  IT is discrete & for D being Subset
  of Y st D is discrete & IT c= D holds IT = D;
end;

theorem 
  for Y0, Y1 being TopStruct, D0 being Subset of Y0, D1 being Subset of
  Y1 st the TopStruct of Y0 = the TopStruct of Y1 & D0 = D1 holds D0 is
  maximal_discrete implies D1 is maximal_discrete;

theorem 
  for A being empty Subset of X holds A is not maximal_discrete;

theorem 
  for A being Subset of X st A is open holds A is maximal_discrete
  implies A is dense;

theorem 
  for A being Subset of X st A is dense holds A is discrete implies A is
  maximal_discrete;

theorem 
  for X being discrete non empty TopSpace, A being Subset of X
  holds A is maximal_discrete iff A is non proper;

theorem 
  for X being anti-discrete non empty TopSpace, A being non empty
  Subset of X holds A is maximal_discrete iff A is trivial;

definition
  let Y be non empty TopStruct;
  let IT be SubSpace of Y;
  attr IT is maximal_discrete means


  for A being Subset of Y st A = the carrier of IT holds A is maximal_discrete;
end;

theorem 
  for Y being non empty TopStruct, Y0 being SubSpace of Y, A being
  Subset of Y st A = the carrier of Y0 holds A is maximal_discrete iff Y0 is
  maximal_discrete;

registration
  let Y be non empty TopStruct;
  cluster maximal_discrete -> discrete for non empty SubSpace of Y;
  cluster non discrete -> non maximal_discrete for non empty SubSpace of Y;
end;

theorem 
  for X0 being non empty SubSpace of X holds X0 is maximal_discrete iff
  X0 is discrete & for Y0 being discrete non empty SubSpace of X st X0 is
  SubSpace of Y0 holds the TopStruct of X0 = the TopStruct of Y0;

theorem 
  for A0 being non empty Subset of X st A0 is maximal_discrete ex
  X0 being strict non empty SubSpace of X st X0 is maximal_discrete & A0 = the
  carrier of X0;

registration
  let X be discrete non empty TopSpace;
  cluster maximal_discrete -> non proper for SubSpace of X;
  cluster proper -> non maximal_discrete for SubSpace of X;
  cluster non proper -> maximal_discrete for SubSpace of X;
  cluster non maximal_discrete -> proper for SubSpace of X;
end;

registration
  let X be anti-discrete non empty TopSpace;
  cluster maximal_discrete -> trivial for non empty SubSpace of X;
  cluster non trivial -> non maximal_discrete for non empty SubSpace of X;
  cluster trivial -> maximal_discrete for non empty SubSpace of X;
  cluster non maximal_discrete -> non trivial for non empty SubSpace of X;
end;

begin



scheme 

  ExChoiceFCol{X()->non empty TopStruct,F()->Subset-Family of X(),P[set,set]}:
ex f being Function of F(),the carrier of X() st for S being Subset of X() st S
  in F() holds P[S,f.S]
provided
 for S being Subset of X() st S in F() ex x being Point of X() st P[S ,x];

reserve X for almost_discrete non empty TopSpace;

theorem 
  for A being Subset of X holds Cl A = union {Cl {a} where a is
  Point of X : a in A};

theorem 
  for a, b being Point of X holds a in Cl {b} implies Cl {a} = Cl {b};

theorem 
  for a, b being Point of X holds Cl {a} misses Cl {b} or Cl {a} = Cl {b};

theorem 
  for A being Subset of X holds (for x being Point of X st x in A
  ex F being Subset of X st F is closed & A /\ F = {x}) implies A is discrete;

theorem 
  for A being Subset of X holds (for x being Point of X st x in A
  holds A /\ Cl {x} = {x}) implies A is discrete;

theorem 
  for A being Subset of X holds A is discrete iff for a, b being Point
  of X st a in A & b in A holds a <> b implies Cl {a} misses Cl {b};

theorem 
  for A being Subset of X holds A is discrete iff for x being
  Point of X st x in Cl A ex a being Point of X st a in A & A /\ Cl {x} = {a};

theorem 
  for A being Subset of X st A is open or A is closed holds A is
  maximal_discrete implies A is not proper;

theorem 
  for A being Subset of X holds A is maximal_discrete implies A is dense;

theorem 
  for A being Subset of X st A is maximal_discrete holds union {Cl
  {a} where a is Point of X : a in A} = the carrier of X;

theorem 
  for A being Subset of X holds A is maximal_discrete iff for x
  being Point of X ex a being Point of X st a in A & A /\ Cl {x} = {a};

theorem 
  for A being Subset of X holds A is discrete implies ex M being
  Subset of X st A c= M & M is maximal_discrete;

theorem 
  ex M being Subset of X st M is maximal_discrete;

theorem 
  for Y0 being discrete non empty SubSpace of X ex X0 being strict
  non empty SubSpace of X st Y0 is SubSpace of X0 & X0 is maximal_discrete;

registration
  let X be almost_discrete non discrete non empty TopSpace;
  cluster maximal_discrete -> proper for non empty SubSpace of X;
  cluster non proper -> non maximal_discrete for non empty SubSpace of X;
end;

registration
  let X be almost_discrete non anti-discrete non empty TopSpace;
  cluster maximal_discrete -> non trivial for non empty SubSpace of X;
  cluster trivial -> non maximal_discrete for non empty SubSpace of X;
end;

registration
  let X be almost_discrete non empty TopSpace;
  cluster maximal_discrete strict non empty non empty for SubSpace of X;
end;

begin



reserve X,Y for non empty TopSpace;

theorem 
  for X being discrete TopSpace, Y being TopSpace, f being
  Function of X,Y holds f is continuous;

theorem 
  (for Y being non empty TopSpace, f being Function of X,Y holds f is
  continuous) implies X is discrete;

theorem 
  for Y being anti-discrete non empty TopSpace, f being Function of X,Y
  holds f is continuous;

theorem 
  (for X being non empty TopSpace, f being Function of X,Y holds f is
  continuous ) implies Y is anti-discrete;

reserve X for discrete non empty TopSpace,
  X0 for non empty SubSpace of X;

theorem 
  ex r being continuous Function of X,X0 st r is being_a_retraction;

theorem 
  X0 is_a_retract_of X;

reserve X for almost_discrete non empty TopSpace,
  X0 for maximal_discrete non empty SubSpace of X;

theorem 
  ex r being continuous Function of X,X0 st r is being_a_retraction;

theorem 
  X0 is_a_retract_of X;

theorem 
  for r being continuous Function of X,X0 holds r is
being_a_retraction implies for F being Subset of X0, E being Subset of X st F =
  E holds r" F = Cl E;

theorem 
  for r being continuous Function of X,X0 holds r is being_a_retraction
implies for a being Point of X0, b being Point of X st a = b holds r" {a} = Cl
  {b};

reserve X0 for discrete non empty SubSpace of X;

theorem 
  ex r being continuous Function of X,X0 st r is being_a_retraction;

theorem 
  X0 is_a_retract_of X;














begin



registration
  let X be non empty TopSpace, A be non empty Subset of X;
  cluster Cl A -> non empty;
end;

registration
  let X be TopSpace, A be empty Subset of X;
  cluster Cl A -> empty;
end;

registration
  let X be non empty TopSpace, A be non proper Subset of X;
  cluster Cl A -> non proper;
end;

registration
  let X be non trivial TopSpace, A be non trivial Subset of X;
  cluster Cl A -> non trivial;
end;

reserve X for non empty TopSpace;

theorem 
  for A being Subset of X holds Cl A = meet {F where F is Subset of
X: F is closed & A c= F};

theorem 
  for x being Point of X holds Cl {x} = meet {F where F is Subset
  of X : F is closed & x in F};

registration
  let X be non empty TopSpace, A be non proper Subset of X;
  cluster Int A -> non proper;
end;

registration
  let X be non empty TopSpace, A be proper Subset of X;
  cluster Int A -> proper;
end;

registration
  let X be non empty TopSpace, A be empty Subset of X;
  cluster Int A -> empty;
end;

theorem 
  for A being Subset of X holds Int A = union {G where G is Subset of X
  : G is open & G c= A};

begin



definition
  let Y be TopStruct;
  let IT be Subset of Y;
  attr IT is anti-discrete means


  for x being Point of Y, G being Subset
  of Y st G is open & x in G holds x in IT implies IT c= G;
end;

definition
  let Y be non empty TopStruct;
  let A be Subset of Y;
  redefine attr A is anti-discrete means


  for x being Point of Y, F
  being Subset of Y st F is closed & x in F holds x in A implies A c= F;
end;

definition
  let Y be TopStruct;
  let A be Subset of Y;
  redefine attr A is anti-discrete means


  for G being Subset of Y st G is open holds A misses G or A c= G;
end;

definition
  let Y be TopStruct;
  let A be Subset of Y;
  redefine attr A is anti-discrete means


  for F being Subset of Y st F is closed holds A misses F or A c= F;
end;

theorem 
  for Y0, Y1 being TopStruct, D0 being Subset of Y0, D1 being
Subset of Y1 st the TopStruct of Y0 = the TopStruct of Y1 & D0 = D1 holds D0 is
  anti-discrete implies D1 is anti-discrete;

reserve Y for non empty TopStruct;

theorem 
  for A, B being Subset of Y st B c= A holds A is anti-discrete
  implies B is anti-discrete;

theorem 
  for x being Point of Y holds {x} is anti-discrete;

theorem 
  for A being empty Subset of Y holds A is anti-discrete;

definition
  let Y be TopStruct;
  let IT be Subset-Family of Y;
  attr IT is anti-discrete-set-family means


  for A being Subset of Y st A in IT holds A is anti-discrete;
end;

theorem 
  for F being Subset-Family of Y st F is anti-discrete-set-family
  holds meet F <> {} implies union F is anti-discrete;

theorem 
  for F being Subset-Family of Y st F is anti-discrete-set-family holds
  meet F is anti-discrete;

definition
  let Y be TopStruct, x be Point of Y;
  func MaxADSF(x) -> Subset-Family of Y equals

  {A where A is Subset of Y : A
  is anti-discrete & x in A};
end;

registration
  let Y be non empty TopStruct, x be Point of Y;
  cluster MaxADSF(x) -> non empty;
end;

reserve x for Point of Y;

theorem 
  MaxADSF(x) is anti-discrete-set-family;

theorem 
  {x} = meet MaxADSF(x);

theorem 
  {x} c= union MaxADSF(x);

theorem 
  union MaxADSF(x) is anti-discrete;

begin



definition
  let Y be TopStruct;
  let IT be Subset of Y;
  attr IT is maximal_anti-discrete means


  IT is anti-discrete & for D
  being Subset of Y st D is anti-discrete & IT c= D holds IT = D;
end;

theorem 
  for Y0, Y1 being TopStruct, D0 being Subset of Y0, D1 being Subset of
  Y1 st the TopStruct of Y0 = the TopStruct of Y1 & D0 = D1 holds D0 is
  maximal_anti-discrete implies D1 is maximal_anti-discrete;

reserve Y for non empty TopStruct;

theorem 
  for A being empty Subset of Y holds A is not maximal_anti-discrete;

theorem 
  for A being non empty Subset of Y holds A is anti-discrete & A
  is open implies A is maximal_anti-discrete;

theorem 
  for A being non empty Subset of Y holds A is anti-discrete & A
  is closed implies A is maximal_anti-discrete;

definition
  let Y be TopStruct, x be Point of Y;
  func MaxADSet(x) -> Subset of Y equals

  union MaxADSF(x);
end;

registration
  let Y be non empty TopStruct, x be Point of Y;
  cluster MaxADSet(x) -> non empty;
end;

theorem 
  for x being Point of Y holds {x} c= MaxADSet(x);

theorem 
  for D being Subset of Y, x being Point of Y st D is
  anti-discrete & x in D holds D c= MaxADSet(x);

theorem 
  for x being Point of Y holds MaxADSet(x) is maximal_anti-discrete;

theorem 
  for x, y being Point of Y holds y in MaxADSet(x) iff MaxADSet(y)
  = MaxADSet(x);

theorem 
  for x, y being Point of Y holds MaxADSet(x) misses MaxADSet(y)
  or MaxADSet(x) = MaxADSet(y);

theorem 
  for F being Subset of Y, x being Point of Y st F is closed & x
  in F holds MaxADSet(x) c= F;

theorem 
  for G being Subset of Y, x being Point of Y st G is open & x in
  G holds MaxADSet(x) c= G;

theorem 
  for x being Point of Y holds MaxADSet(x) c= meet {F where F is Subset
  of Y : F is closed & x in F};

theorem 
  for x being Point of Y holds MaxADSet(x) c= meet {G where G is Subset
  of Y : G is open & x in G};

definition
  let Y be non empty TopStruct;
  let A be Subset of Y;
  redefine attr A is maximal_anti-discrete means


  ex x being Point of Y st x in A & A = MaxADSet(x);
end;

theorem 
  for A being Subset of Y, x being Point of Y st x in A holds A is
  maximal_anti-discrete implies A = MaxADSet(x);

definition
  let Y be non empty TopStruct;
  let A be non empty Subset of Y;
  redefine attr A is maximal_anti-discrete means

  for x being Point of Y st x in A holds A = MaxADSet(x);
end;

definition
  let Y be non empty TopStruct, A be Subset of Y;
  func MaxADSet(A) -> Subset of Y equals

  union {MaxADSet(a) where a is Point
  of Y : a in A};
end;

theorem 
  for x being Point of Y holds MaxADSet(x) = MaxADSet({x});

theorem 
  for A being Subset of Y, x being Point of Y holds MaxADSet(x)
  meets MaxADSet(A) implies MaxADSet(x) meets A;

theorem 
  for A being Subset of Y, x being Point of Y holds MaxADSet(x)
  meets MaxADSet(A) implies MaxADSet(x) c= MaxADSet(A);

theorem 
  for A, B being Subset of Y holds A c= B implies MaxADSet(A) c= MaxADSet(B);

theorem 
  for A being Subset of Y holds A c= MaxADSet(A);

theorem 
  for A being Subset of Y holds MaxADSet(A) = MaxADSet(MaxADSet(A) );

theorem 
  for A, B being Subset of Y holds A c= MaxADSet(B) implies
  MaxADSet(A) c= MaxADSet(B);

theorem 
  for A, B being Subset of Y st B c= MaxADSet(A) & A c= MaxADSet(B
  ) holds MaxADSet(A) = MaxADSet(B);

theorem 
  for A, B being Subset of Y holds MaxADSet(A \/ B) = MaxADSet(A) \/
  MaxADSet(B);

theorem 
  for A, B being Subset of Y holds MaxADSet(A /\ B) c= MaxADSet(A)
  /\ MaxADSet(B);

registration
  let Y be non empty TopStruct, A be non empty Subset of Y;
  cluster MaxADSet(A) -> non empty;
end;

registration
  let Y be non empty TopStruct, A be empty Subset of Y;
  cluster MaxADSet(A) -> empty;
end;

registration
  let Y be non empty TopStruct, A be non proper Subset of Y;
  cluster MaxADSet(A) -> non proper;
end;

registration
  let Y be non trivial TopStruct, A be non trivial Subset of Y;
  cluster MaxADSet(A) -> non trivial;
end;

theorem 
  for G being Subset of Y, A being Subset of Y st G is open & A c=
  G holds MaxADSet(A) c= G;

theorem 
  for A being Subset of Y holds {G where G is Subset of Y : G is
open & A c= G} <> {} implies MaxADSet(A) c= meet {G where G is Subset of Y : G
  is open & A c= G};

theorem 
  for F being Subset of Y, A being Subset of Y st F is closed & A
  c= F holds MaxADSet(A) c= F;

theorem 
  for A being Subset of Y holds {F where F is Subset of Y : F is
closed & A c= F} <> {} implies MaxADSet(A) c= meet {F where F is Subset of Y :
  F is closed & A c= F};

begin



definition
  let X be non empty TopSpace;
  let A be Subset of X;
  redefine attr A is anti-discrete means


  for x being Point of X st x in A holds A c= Cl {x};
end;

definition
  let X be non empty TopSpace;
  let A be Subset of X;
  redefine attr A is anti-discrete means

  for x being Point of X st x in A holds Cl A = Cl {x};
end;

definition
  let X be non empty TopSpace;
  let A be Subset of X;
  redefine attr A is anti-discrete means


  for x, y being Point of X st x in A & y in A holds Cl {x} = Cl {y};
end;

reserve X for non empty TopSpace;

theorem 
  for x being Point of X, D being Subset of X st D is anti-discrete & Cl
  {x} c= D holds D = Cl {x};

theorem 
  for A being Subset of X holds A is anti-discrete & A is closed iff for
  x being Point of X st x in A holds A = Cl {x};

theorem 
  for A being Subset of X holds A is anti-discrete & A is not open
  implies A is boundary;

theorem 
  for x being Point of X st Cl {x} = {x} holds {x} is maximal_anti-discrete;

reserve x,y for Point of X;

theorem 
  MaxADSet(x) c= meet {G where G is Subset of X : G is open & x in G};

theorem 
  MaxADSet(x) c= meet {F where F is Subset of X : F is closed & x in F};

theorem 
  MaxADSet(x) c= Cl {x};

theorem 
  MaxADSet(x) = MaxADSet(y) iff Cl {x} = Cl {y};

theorem 
  MaxADSet(x) misses MaxADSet(y) iff Cl {x} <> Cl {y};

definition
  let X be non empty TopSpace, x be Point of X;
  redefine func MaxADSet(x) -> non empty Subset of X equals

  (Cl {x}) /\ meet {
  G where G is Subset of X : G is open & x in G};
end;

theorem 
  for x, y being Point of X holds Cl {x} c= Cl {y} iff meet {G
where G is Subset of X : G is open & y in G} c= meet {G where G is Subset of X
  : G is open & x in G};

theorem 
  for x, y being Point of X holds Cl {x} c= Cl {y} iff MaxADSet(y) c=
  meet {G where G is Subset of X : G is open & x in G};

theorem 
  for x, y being Point of X holds MaxADSet(x) misses MaxADSet(y)
iff (ex V being Subset of X st V is open & MaxADSet(x) c= V & V misses MaxADSet
(y)) or ex W being Subset of X st W is open & W misses MaxADSet(x) & MaxADSet(y
  ) c= W;

theorem 
  for x, y being Point of X holds MaxADSet(x) misses MaxADSet(y) iff (ex
  E being Subset of X st E is closed & MaxADSet(x) c= E & E misses MaxADSet(y))
  or ex F being Subset of X st F is closed & F misses MaxADSet(x) & MaxADSet(y)
  c= F;

reserve A, B for Subset of X;
reserve P, Q for Subset of X;

theorem 
  MaxADSet(A) c= meet {G where G is Subset of X : G is open & A c= G};

theorem 
  P is open implies MaxADSet(P) = P;

theorem 
  MaxADSet(Int A) = Int A;

theorem 
  MaxADSet(A) c= meet {F where F is Subset of X : F is closed & A c= F};

theorem 
  MaxADSet(A) c= Cl A;

theorem 
  P is closed implies MaxADSet(P) = P;

theorem 
  MaxADSet(Cl A) = Cl A;

theorem 
  Cl MaxADSet(A) = Cl A;

theorem 
  MaxADSet(A) = MaxADSet(B) implies Cl A = Cl B;

theorem 
  P is closed or Q is closed implies MaxADSet(P /\ Q) = MaxADSet(P) /\
  MaxADSet(Q);

theorem 
  P is open or Q is open implies MaxADSet(P /\ Q) = MaxADSet(P) /\ MaxADSet(Q);

begin



reserve Y for non empty TopStruct;

theorem 
  for Y0 being SubSpace of Y, A being Subset of Y st A = the
  carrier of Y0 holds Y0 is anti-discrete implies A is anti-discrete;

theorem 
  for Y0 being SubSpace of Y st Y0 is TopSpace-like for A being
  Subset of Y st A = the carrier of Y0 holds A is anti-discrete implies Y0 is
  anti-discrete;

reserve X for non empty TopSpace,
  Y0 for non empty SubSpace of X;

theorem 
  (for X0 being open SubSpace of X holds Y0 misses X0 or Y0 is SubSpace
  of X0) implies Y0 is anti-discrete;

theorem 
  (for X0 being closed SubSpace of X holds Y0 misses X0 or Y0 is
  SubSpace of X0) implies Y0 is anti-discrete;

theorem 
  for Y0 being anti-discrete SubSpace of X for X0 being open SubSpace of
  X holds Y0 misses X0 or Y0 is SubSpace of X0;

theorem 
  for Y0 being anti-discrete SubSpace of X for X0 being closed SubSpace
  of X holds Y0 misses X0 or Y0 is SubSpace of X0;

definition
  let Y be non empty TopStruct;
  let IT be SubSpace of Y;
  attr IT is maximal_anti-discrete means


  IT is anti-discrete & for Y0
  being SubSpace of Y st Y0 is anti-discrete holds the carrier of IT c= the
  carrier of Y0 implies the carrier of IT = the carrier of Y0;
end;

registration
  let Y be non empty TopStruct;
  cluster maximal_anti-discrete -> anti-discrete for SubSpace of Y;
  cluster non anti-discrete -> non maximal_anti-discrete for SubSpace of Y;
end;

theorem 
  for Y0 being non empty SubSpace of X, A being Subset of X st A =
  the carrier of Y0 holds Y0 is maximal_anti-discrete iff A is
  maximal_anti-discrete;

registration
  let X be non empty TopSpace;
  cluster open anti-discrete -> maximal_anti-discrete for
non empty SubSpace of X
    ;
  cluster open non maximal_anti-discrete -> non anti-discrete for non empty
    SubSpace of X;
  cluster anti-discrete non maximal_anti-discrete -> non open for non empty
    SubSpace of X;
  cluster closed anti-discrete -> maximal_anti-discrete for
non empty SubSpace of
    X;
  cluster closed non maximal_anti-discrete -> non anti-discrete for non empty
    SubSpace of X;
  cluster anti-discrete non maximal_anti-discrete -> non closed for non empty
    SubSpace of X;
end;

definition
  let Y be TopStruct, x be Point of Y;
  func MaxADSspace(x) -> strict SubSpace of Y means


  the carrier of it = MaxADSet(x);
end;

registration
  let Y be non empty TopStruct, x be Point of Y;
  cluster MaxADSspace(x) -> non empty;
end;

theorem 
  for x being Point of Y holds Sspace(x) is SubSpace of MaxADSspace(x);

theorem 
  for x, y being Point of Y holds y is Point of MaxADSspace(x) iff the
  TopStruct of MaxADSspace(y) = the TopStruct of MaxADSspace(x);

theorem 
  for x, y being Point of Y holds the carrier of MaxADSspace(x) misses
  the carrier of MaxADSspace(y) or the TopStruct of MaxADSspace(x) = the
  TopStruct of MaxADSspace(y);

registration
  let X be non empty TopSpace;
  cluster maximal_anti-discrete strict for SubSpace of X;
end;

registration
  let X be non empty TopSpace, x be Point of X;
  cluster MaxADSspace(x) -> maximal_anti-discrete;
end;

theorem 
  for X0 being closed non empty SubSpace of X, x being Point of X holds
  x is Point of X0 implies MaxADSspace(x) is SubSpace of X0;

theorem 
  for X0 being open non empty SubSpace of X, x being Point of X holds x
  is Point of X0 implies MaxADSspace(x) is SubSpace of X0;

theorem 
  for x being Point of X st Cl {x} = {x} holds Sspace(x) is
  maximal_anti-discrete;

notation
  let Y be TopStruct, A be Subset of Y;
  synonym Sspace(A) for Y|A;
end;

theorem 
  for A being non empty Subset of Y holds A is Subset of Sspace(A);

theorem 
  for Y0 being SubSpace of Y, A being non empty Subset of Y holds A is
  Subset of Y0 implies Sspace(A) is SubSpace of Y0;

registration
  let Y be non trivial TopStruct;
  cluster non proper strict for SubSpace of Y;
end;

registration
  let Y be non trivial TopStruct, A be non trivial Subset
  of Y;
  cluster Sspace(A) -> non trivial;
end;

registration
  let Y be non empty TopStruct, A be non proper Subset of Y;
  cluster Sspace(A) -> non proper;
end;

definition
  let Y be non empty TopStruct, A be Subset of Y;
  func MaxADSspace(A) -> strict SubSpace of Y means


  the carrier of it = MaxADSet(A);
end;

registration
  let Y be non empty TopStruct, A be non empty Subset of Y;
  cluster MaxADSspace(A) -> non empty;
end;

theorem 
  for A being non empty Subset of Y holds A is Subset of MaxADSspace(A);

theorem 
  for A being non empty Subset of Y holds Sspace(A) is SubSpace of
  MaxADSspace(A);

theorem 
  for x being Point of Y holds the TopStruct of MaxADSspace(x) = the
  TopStruct of MaxADSspace({x});

theorem 
  for A, B being non empty Subset of Y holds A c= B implies MaxADSspace(
  A) is SubSpace of MaxADSspace(B);

theorem 
  for A being non empty Subset of Y holds the TopStruct of MaxADSspace(A
  ) = the TopStruct of MaxADSspace(MaxADSet(A));

theorem 
  for A, B being non empty Subset of Y holds A is Subset of MaxADSspace(
  B) implies MaxADSspace(A) is SubSpace of MaxADSspace(B);

theorem 
  for A, B being non empty Subset of Y holds B is Subset of MaxADSspace(
  A) & A is Subset of MaxADSspace(B) iff the TopStruct of MaxADSspace(A) = the
  TopStruct of MaxADSspace(B);

registration
  let Y be non trivial TopStruct, A be non trivial Subset of Y;
  cluster MaxADSspace(A) -> non trivial;
end;

registration
  let Y be non empty TopStruct, A be non proper Subset of Y;
  cluster MaxADSspace(A) -> non proper;
end;

theorem 
  for X0 being open SubSpace of X, A being non empty Subset of X holds A
  is Subset of X0 implies MaxADSspace(A) is SubSpace of X0;

theorem 
  for X0 being closed SubSpace of X, A being non empty Subset of X holds
  A is Subset of X0 implies MaxADSspace(A) is SubSpace of X0;














begin



definition
  let Y be TopStruct;
  redefine mode SubSpace of Y means


    the carrier of it c= the carrier of Y &
    for G0 being Subset of it holds G0 is open iff ex G being
    Subset of Y st G is open & G0 = G /\ the carrier of it;
end;

theorem 
  for Y being TopStruct, Y0 being SubSpace of Y for G being Subset
of Y st G is open holds ex G0 being Subset of Y0 st G0 is open & G0 = G /\ the
  carrier of Y0;

definition
  let Y be TopStruct;
  redefine mode SubSpace of Y means


    the carrier of it c= the carrier of Y &
    for F0 being Subset of it holds F0 is closed iff ex F being
    Subset of Y st F is closed & F0 = F /\ the carrier of it;
end;

theorem 
  for Y being TopStruct, Y0 being SubSpace of Y for F being Subset
of Y st F is closed holds ex F0 being Subset of Y0 st F0 is closed & F0 = F /\
  the carrier of Y0;

begin



definition
  let T be TopStruct;
  redefine attr T is T_0 means


  T is empty or for x, y being Point of T
st x <> y holds (ex V being Subset of T st V is open & x in V & not y in V) or
  ex W being Subset of T st W is open & not x in W & y in W;
end;

definition
  let Y be TopStruct;
  redefine attr Y is T_0 means


  Y is empty or for x, y being Point of Y
  st x <> y holds (ex E being Subset of Y st E is closed & x in E & not y in E)
  or ex F being Subset of Y st F is closed & not x in F & y in F;
end;

registration
  cluster trivial -> T_0 for non empty TopStruct;
end;

registration
  cluster strict T_0 non empty for TopSpace;
  cluster strict non T_0 non empty for TopSpace;
end;

registration
  cluster discrete -> T_0 for non empty TopSpace;
  cluster non T_0 -> non discrete for non empty TopSpace;
  cluster anti-discrete non trivial -> non T_0 for non empty TopSpace;
  cluster anti-discrete T_0 -> trivial for non empty TopSpace;
  cluster T_0 non trivial -> non anti-discrete for non empty TopSpace;
end;

definition
  let X be non empty TopSpace;
  redefine attr X is T_0 means


  for x, y being Point of X st x <> y holds Cl {x} <> Cl {y};
end;

definition
  let X be non empty TopSpace;
  redefine attr X is T_0 means


  for x, y being Point of X st x <> y holds not x in Cl {y} or not y in Cl {x};
end;

definition
  let X be non empty TopSpace;
  redefine attr X is T_0 means

  for x, y being Point of X st x <> y & x in Cl {
  y} holds not Cl {y} c= Cl {x};
end;

registration
  cluster almost_discrete T_0 -> discrete for non empty TopSpace;
  cluster almost_discrete non discrete -> non T_0 for non empty TopSpace;
  cluster non discrete T_0 -> non almost_discrete for non empty TopSpace;
end;

definition
  mode Kolmogorov_space is T_0 non empty TopSpace;
  mode non-Kolmogorov_space is non T_0 non empty TopSpace;
end;

registration
  cluster non trivial strict for Kolmogorov_space;
  cluster non trivial strict for non-Kolmogorov_space;
end;

begin



definition
  let Y be TopStruct;
  let IT be Subset of Y;
  attr IT is T_0 means


  for x, y being Point of Y st x in IT & y in IT &
x <> y holds (ex V being Subset of Y st V is open & x in V & not y in V) or ex
  W being Subset of Y st W is open & not x in W & y in W;
end;

definition
  let Y be non empty TopStruct;
  let A be Subset of Y;
  redefine attr A is T_0 means


  for x, y being Point of Y st x in A & y
in A & x <> y holds (ex E being Subset of Y st E is closed & x in E & not y in
  E) or ex F being Subset of Y st F is closed & not x in F & y in F;
end;

theorem 
  for Y0, Y1 being TopStruct, D0 being Subset of Y0, D1 being Subset of
  Y1 st the TopStruct of Y0 = the TopStruct of Y1 & D0 = D1 holds D0 is T_0
  implies D1 is T_0;

theorem 
  for Y being non empty TopStruct, A being Subset of Y st A = the
  carrier of Y holds A is T_0 iff Y is T_0;

reserve Y for non empty TopStruct;

theorem 
  for A, B being Subset of Y st B c= A holds A is T_0 implies B is T_0;

theorem 
  for A, B being Subset of Y holds A is T_0 or B is T_0 implies A /\ B is T_0;

theorem 
  for A, B being Subset of Y st A is open or B is open holds A is
  T_0 & B is T_0 implies A \/ B is T_0;

theorem 
  for A, B being Subset of Y st A is closed or B is closed holds A
  is T_0 & B is T_0 implies A \/ B is T_0;

theorem 
  for A being Subset of Y holds A is discrete implies A is T_0;

theorem 
  for A being non empty Subset of Y holds A is anti-discrete & A is not
  trivial implies A is not T_0;

definition
  let X be non empty TopSpace;
  let A be Subset of X;
  redefine attr A is T_0 means


  for x, y being Point of X st x in A & y in A & x <> y holds Cl {x} <> Cl {y};
end;

definition
  let X be non empty TopSpace;
  let A be Subset of X;
  redefine attr A is T_0 means


  for x, y being Point of X st x in A & y
  in A & x <> y holds not x in Cl {y} or not y in Cl {x};
end;

definition
  let X be non empty TopSpace;
  let A be Subset of X;
  redefine attr A is T_0 means

  for x, y being Point of X st x in A & y in A &
  x <> y holds x in Cl {y} implies not Cl {y} c= Cl {x};
end;

reserve X for non empty TopSpace;

theorem 
  for A being empty Subset of X holds A is T_0;

theorem 
  for x being Point of X holds {x} is T_0;

begin



registration
  let Y be non empty TopStruct;
  cluster strict T_0 non empty for SubSpace of Y;
end;

definition
  let Y be TopStruct;
  let Y0 be SubSpace of Y;
  redefine attr Y0 is T_0 means

  Y0 is empty or for x, y being Point of Y st x
  is Point of Y0 & y is Point of Y0 & x <> y holds (ex V being Subset of Y st V
  is open & x in V & not y in V) or ex W being Subset of Y st W is open & not x
  in W & y in W;
end;

definition
  let Y be TopStruct;
  let Y0 be SubSpace of Y;
  redefine attr Y0 is T_0 means


  Y0 is empty or for x, y being Point of
Y st x is Point of Y0 & y is Point of Y0 & x <> y holds (ex E being Subset of Y
st E is closed & x in E & not y in E) or ex F being Subset of Y st F is closed
  & not x in F & y in F;
end;

reserve Y for non empty TopStruct;

theorem 
  for Y0 being non empty SubSpace of Y, A being Subset of Y st A =
  the carrier of Y0 holds A is T_0 iff Y0 is T_0;

theorem 
  for Y0 being non empty SubSpace of Y, Y1 being T_0 non empty SubSpace
  of Y st Y0 is SubSpace of Y1 holds Y0 is T_0;

reserve X for non empty TopSpace;

theorem 
  for X1 being T_0 non empty SubSpace of X, X2 being non empty SubSpace
  of X holds X1 meets X2 implies X1 meet X2 is T_0;

theorem 
  for X1, X2 being T_0 non empty SubSpace of X holds X1 is open or X2 is
  open implies X1 union X2 is T_0;

theorem 
  for X1, X2 being T_0 non empty SubSpace of X holds X1 is closed or X2
  is closed implies X1 union X2 is T_0;

definition
  let X be non empty TopSpace;
  mode Kolmogorov_subspace of X is T_0 non empty SubSpace of X;
end;

theorem 
  for X being non empty TopSpace, A0 being non empty Subset of X st A0
  is T_0 ex X0 being strict Kolmogorov_subspace of X st A0 = the carrier of X0;

registration
  let X be non trivial TopSpace;
  cluster proper strict for Kolmogorov_subspace of X;
end;

registration
  let X be Kolmogorov_space;
  cluster -> T_0 for non empty SubSpace of X;
end;

registration
  let X be non-Kolmogorov_space;
  cluster non proper -> non T_0 for non empty SubSpace of X;
  cluster T_0 -> proper for non empty SubSpace of X;
end;

registration
  let X be non-Kolmogorov_space;
  cluster strict non T_0 for SubSpace of X;
end;

definition
  let X be non-Kolmogorov_space;
  mode non-Kolmogorov_subspace of X is non T_0 SubSpace of X;
end;

theorem 
  for X being non empty non-Kolmogorov_space, A0 being Subset of X st A0
is not T_0 ex X0 being strict non-Kolmogorov_subspace of X st A0 = the carrier
  of X0;














begin 

theorem 
  for X,A,B being set st A in Fin X & B c= A holds B in Fin X;

theorem 
  for X being set, F being Subset-Family of X st F c= Fin X holds
  meet F in Fin X;

begin 

theorem 
  for X being set, F being Subset-Family of X holds F,COMPLEMENT F
  are_equipotent;

theorem 
  for X,Y being set st X,Y are_equipotent & X is countable holds Y is countable
;

theorem 
  for X being 1-sorted, F being Subset-Family of X, P being Subset of X
  holds P` in COMPLEMENT F iff P in F;

theorem 
  for X being 1-sorted, F being Subset-Family of X holds Intersect
  COMPLEMENT F = (union F)`;

theorem 
  for X being 1-sorted, F being Subset-Family of X holds union
  COMPLEMENT F = (Intersect F)`;

begin 

theorem 
  for T being non empty TopSpace, A,B being Subset of T st B c= A & A is
closed & (for C being Subset of T st B c= C & C is closed holds A c= C) holds A
  = Cl B;

theorem 
  for T being TopStruct, B being Basis of T, V being Subset of T
  st V is open holds V = union { G where G is Subset of T: G in B & G c= V };

theorem 
  for T being TopStruct, B being Basis of T, S being Subset of T
  st S in B holds S is open;

theorem 
  for T being non empty TopSpace, B being Basis of T, V being Subset of
  T holds Int V = union { G where G is Subset of T: G in B & G c= V };

begin 

definition

  let T be non empty TopStruct, x be Point of T, F be Subset-Family of T;
  attr F is x-quasi_basis means


  x in Intersect F &
  for S being Subset of T st S is open & x in S ex V being Subset of T st
  V in F & V c= S;
end;

registration
  let T be non empty TopStruct, x be Point of T;
  cluster open x-quasi_basis for Subset-Family of T;
end;

definition
  let T be non empty TopStruct, x be Point of T;
  mode Basis of x is open x-quasi_basis Subset-Family of T;
end;

theorem 
  for T being non empty TopStruct, x being Point of T, B being
  Basis of x, V being Subset of T st V in B holds V is open & x in V;

theorem 
  for T being non empty TopStruct, x being Point of T, B being Basis of
x, V being Subset of T st x in V & V is open ex W being Subset of T st W in B &
  W c= V;

theorem 
  for T being non empty TopStruct, P being Subset-Family of T st P c=
  the topology of T & for x being Point of T ex B being Basis of x st B c= P
  holds P is Basis of T;

definition
  let T be non empty TopSpace;
  attr T is Baire means


  for F being Subset-Family of T st F is
countable & for S being Subset of T st S in F holds S is everywhere_dense ex I
  being Subset of T st I = Intersect F & I is dense;
end;

theorem 
  for T being non empty TopSpace holds T is Baire iff for F being
Subset-Family of T st F is countable & for S being Subset of T st S in F holds
  S is nowhere_dense holds union F is boundary;

begin 

definition
  let T be TopStruct, S be Subset of T;
  attr S is irreducible means


  S is non empty closed & for S1,S2 being
Subset of T st S1 is closed & S2 is closed & S = S1 \/ S2 holds S1 = S or S2 =
  S;
end;

registration
  let T be TopStruct;
  cluster irreducible -> non empty for Subset of T;
end;

definition
  let T be non empty TopSpace, S be Subset of T;
  let p be Point of T;
  pred p is_dense_point_of S means


  p in S & S c= Cl{p};
end;

theorem 
  for T being non empty TopSpace, S being Subset of T st S is closed for
  p being Point of T st p is_dense_point_of S holds S = Cl{p};

theorem 
  for T being non empty TopSpace, p being Point of T holds Cl{p} is irreducible
;

registration
  let T be non empty TopSpace;
  cluster irreducible for Subset of T;
end;

definition
  let T be non empty TopSpace;
  attr T is sober means


  for S being irreducible Subset of T ex p being
  Point of T st p is_dense_point_of S & for q being Point of T st q
  is_dense_point_of S holds p = q;
end;

theorem 
  for T being non empty TopSpace, p being Point of T holds p
  is_dense_point_of Cl{p};

theorem 
  for T being non empty TopSpace, p being Point of T holds p
  is_dense_point_of {p};

theorem 
  for T being non empty TopSpace, G,F being Subset of T st G is
  open & F is closed holds F \ G is closed;

theorem 
  for T being Hausdorff non empty TopSpace, S being irreducible
  Subset of T holds S is trivial;
            registration
  let T be Hausdorff non empty TopSpace;
  cluster irreducible -> trivial for Subset of T;
end;

theorem 
  for T being Hausdorff non empty TopSpace holds T is sober;

registration
  cluster Hausdorff -> sober for non empty TopSpace;
end;

registration
  cluster sober for non empty TopSpace;
end;

theorem 
  for T being non empty TopSpace holds T is T_0 iff for p,q being
  Point of T st Cl{p} = Cl{q} holds p = q;

theorem 
  for T being sober non empty TopSpace holds T is T_0;

registration
  cluster sober -> T_0 for non empty TopSpace;
end;

definition
  let X be set;
  func CofinTop X -> strict TopStruct means


  the carrier of it = X & COMPLEMENT the topology of it = {X} \/ Fin X;
end;

registration
  let X be non empty set;
  cluster CofinTop X -> non empty;
end;

registration
  let X be set;
  cluster CofinTop X -> TopSpace-like;
end;

theorem 
  for X being non empty set, P being Subset of CofinTop X holds P
  is closed iff P = X or P is finite;

theorem 
  for T being non empty TopSpace st T is T_1 for p being Point of
  T holds Cl{p} = {p};

registration
  let X be non empty set;
  cluster CofinTop X -> T_1;
end;

registration
  let X be infinite set;
  cluster CofinTop X -> non sober;
end;

registration
  cluster T_1 non sober for non empty TopSpace;
end;

begin 

theorem 
  for T being non empty TopSpace holds T is regular iff for p
being Point of T, P being Subset of T st p in Int P ex Q being Subset of T st Q
  is closed & Q c= P & p in Int Q;

theorem 
  for T being non empty TopSpace st T is regular holds T is
locally-compact iff for x being Point of T ex Y being Subset of T st x in Int Y
  & Y is compact;














begin

reserve r for Real;
reserve a, b for real number;
reserve T for non empty TopSpace;



theorem 
  for T being TopStruct, F being Subset-Family of T holds F is Cover of
  T iff the carrier of T c= union F;

reserve A for non empty SubSpace of T;

theorem 
  T is T_2 implies A is T_2;

theorem 
  for T being TopSpace, A,B being SubSpace of T st the carrier of A
  c= the carrier of B holds A is SubSpace of B;

reserve P,Q for Subset of T,
  p for Point of T;

theorem 
  T|P is SubSpace of T|(P \/ Q) & T|Q is SubSpace of T|(P \/ Q);

theorem 
  for P being non empty Subset of T st p in P for Q being a_neighborhood
  of p holds for p9 being Point of T|P, Q9 being Subset of T|P st Q9 = Q /\ P &
  p9= p holds Q9 is a_neighborhood of p9;

theorem 
  for A,B being TopSpace for f being Function of A,B for C being Subset
of B holds f is continuous implies for h being Function of A,B|C st h = f holds
  h is continuous;

theorem 
  for X being TopStruct, Y being non empty TopStruct, K0 being Subset of
X, f being Function of X,Y, g being Function of X|K0,Y st f is continuous & g =
  f|K0 holds g is continuous;



reserve M for non empty MetrSpace,
  p for Point of M;

definition
  let M be MetrSpace;
  mode SubSpace of M -> MetrSpace means


    the carrier of it c= the
carrier of M & for x,y being Point of it holds (the distance of it).(x,y) = (
    the distance of M).(x,y);
end;

registration
  let M be MetrSpace;
  cluster strict for SubSpace of M;
end;

registration
  let M be non empty MetrSpace;
  cluster strict non empty for SubSpace of M;
end;

reserve A for non empty SubSpace of M;

theorem 
  for p being Point of A holds p is Point of M;

theorem 
  for r being real number for M being MetrSpace, A being SubSpace
  of M for x being Point of M, x9 being Point of A st x = x9 holds Ball(x9,r) =
  Ball(x,r) /\ the carrier of A;

definition
  let M be non empty MetrSpace, A be non empty Subset of M;
  func M|A -> strict SubSpace of M means


  the carrier of it = A;
end;

registration
  let M be non empty MetrSpace, A be non empty Subset of M;
  cluster M|A -> non empty;
end;

definition
  let a,b be real number;
  assume
 a <= b;
  func Closed-Interval-MSpace(a,b) -> strict non empty SubSpace of RealSpace
  means


  for P being non empty Subset of RealSpace st P = [. a,b .] holds
  it = RealSpace | P;
end;

theorem 
  a <= b implies the carrier of Closed-Interval-MSpace(a,b) = [. a ,b .];

reserve F,G for Subset-Family of M;

definition
  let M be MetrStruct, F be Subset-Family of M;
  attr F is being_ball-family means


  for P being set holds P in F
  implies ex p being Point of M, r st P = Ball(p,r);
end;

theorem 
  for p,q being Point of RealSpace, x,y being real number holds x=
  p & y=q implies dist(p,q) = abs(x-y);



theorem 
  for M being MetrStruct holds the carrier of M = the carrier of
  TopSpaceMetr M & the topology of TopSpaceMetr M = Family_open_set M;

theorem 
  TopSpaceMetr(A) is SubSpace of TopSpaceMetr(M);

theorem 
  for r being real number for M being triangle MetrStruct, p being
  Point of M for P being Subset of TopSpaceMetr(M) st P = Ball(p,r) holds P is
  open;

theorem 
  for P being Subset of TopSpaceMetr(M) holds P is open iff for p
  being Point of M st p in P ex r being real number st r>0 & Ball(p,r) c= P;

definition

  let M be MetrStruct;
  attr M is compact means


  TopSpaceMetr(M) is compact;
end;

theorem 
  M is compact iff for F st F is being_ball-family & F is Cover of M ex
  G st G c= F & G is Cover of M & G is finite;



definition
  func R^1 -> TopSpace equals

  TopSpaceMetr(RealSpace);
end;

registration
  cluster R^1 -> strict non empty;
end;

theorem 
  the carrier of R^1 = REAL;

definition
  let a,b be real number;
  func Closed-Interval-TSpace(a,b) -> strict non empty SubSpace of R^1 equals

  TopSpaceMetr(Closed-Interval-MSpace(a,b));
end;

theorem 
  a <= b implies the carrier of Closed-Interval-TSpace(a,b) = [. a,b .];

theorem 
  a <= b implies for P being Subset of R^1 st P = [. a,b .] holds
  Closed-Interval-TSpace(a,b) = R^1|P;

theorem 
  Closed-Interval-TSpace(0,1) = I[01];

definition
  redefine func I[01] -> SubSpace of R^1;
end;

theorem 
  for f being Function of R^1,R^1 st ex a,b being Real st for x being
  Real holds f.x = a*x + b holds f is continuous;



theorem 
  for T being non empty TopSpace, A,B being Subset of T st A c= B holds
  T|A is SubSpace of T|B;



theorem 
  for a,b,d,e being real number, B being Subset of
  Closed-Interval-TSpace(d,e) st d<=a & a<=b & b<=e & B=[.a,b.] holds
  Closed-Interval-TSpace(a,b)=Closed-Interval-TSpace(d,e)|B;

theorem 
  for a,b being real number, B being Subset of I[01] st 0<=a & a<=b & b
  <=1 & B=[.a,b.] holds Closed-Interval-TSpace(a,b)=I[01]|B;



definition
  let T be 1-sorted;
  attr T is real-membered means


  the carrier of T is real-membered;
end;

registration
  cluster I[01] -> real-membered;
end;



registration
  cluster non empty real-membered for 1-sorted;
end;

registration
  let S be real-membered 1-sorted;
  cluster the carrier of S -> real-membered;
end;



registration
  cluster R^1 -> real-membered;
end;



registration
  cluster strict non empty real-membered for TopSpace;
end;

registration
  let T be real-membered TopStruct;
  cluster -> real-membered for SubSpace of T;
end;



registration
  cluster RealSpace -> real-membered;
end;















begin

reserve a,b,x,y for real number,
  i,k,n,m for Element of NAT;
reserve p,w for Real;

theorem 
  for A being SubSpace of RealSpace, p,q being Point of A st x = p
  & y = q holds dist(p,q) = abs( x - y );

reserve seq for Real_Sequence;

theorem 
  seq is increasing & rng seq c= NAT implies n <= seq.n;

definition
  let seq,k;
  func k to_power seq -> Real_Sequence means


  for n holds it.n = k to_power (seq.n);
end;

theorem 
  seq is divergent_to+infty implies 2 to_power seq is divergent_to+infty;


theorem 
  a <= b implies Closed-Interval-TSpace(a,b) is compact;














begin



reserve a,b,c,d for real number;

theorem 
  for A being Subset of R^1 st A = [.a,b.] holds A is closed;

theorem 
  a <= b implies Closed-Interval-TSpace(a,b) is closed;

theorem 
  a <= c & d <= b & c <= d implies
  Closed-Interval-TSpace(c,d) is closed SubSpace of Closed-Interval-TSpace(a,b)
;

theorem 
  a <= c & b <= d & c <= b implies Closed-Interval-TSpace(a,d) =
  Closed-Interval-TSpace(a,b) union Closed-Interval-TSpace(c,d) &
  Closed-Interval-TSpace(c,b) = Closed-Interval-TSpace(a,b) meet
  Closed-Interval-TSpace(c,d);

definition
  let a,b be real number;
  assume
 a <= b;
  func (#)(a,b) -> Point of Closed-Interval-TSpace(a,b) equals


  a;
  func (a,b)(#) -> Point of Closed-Interval-TSpace(a,b) equals


  b;
end;

theorem 
  0[01] = (#)(0,1) & 1[01] = (0,1)(#);

theorem 
  a <= b & b <= c implies (#)(a,b) = (#)(a,c) & (b,c)(#) = (a,c)(#);

begin



definition
  let a,b be real number such that
 a <= b;
  let t1,t2 be Point of Closed-Interval-TSpace(a,b);
  func L[01](t1,t2) -> Function of Closed-Interval-TSpace(0,1),
  Closed-Interval-TSpace(a,b) means


  for s being Point of Closed-Interval-TSpace(0,1) holds
  it.s = (1-s)*t1 + s*t2;
end;

theorem 
  a <= b implies for t1,t2 being Point of Closed-Interval-TSpace(a,b)
  for s being Point of Closed-Interval-TSpace(0,1) holds
  L[01](t1,t2).s = (t2 - t1)*s + t1;

theorem 
  a <= b implies for t1,t2 being Point of Closed-Interval-TSpace(a,b) holds
  L[01](t1,t2) is continuous;

theorem 
  a <= b implies for t1,t2 being Point of Closed-Interval-TSpace(a,b)
  holds L[01](t1,t2).(#)(0,1) = t1 & L[01](t1,t2).(0,1)(#) = t2;

theorem 
  L[01]((#)(0,1),(0,1)(#)) = id Closed-Interval-TSpace(0,1);

definition
  let a,b be real number such that
 a < b;
  let t1,t2 be Point of Closed-Interval-TSpace(0,1);
  func P[01](a,b,t1,t2) -> Function of Closed-Interval-TSpace(a,b),
  Closed-Interval-TSpace(0,1) means


  for s being Point of Closed-Interval-TSpace(a,b) holds
  it.s = ((b-s)*t1 + (s-a)*t2)/(b-a);
end;

theorem 
  a < b implies for t1,t2 being Point of Closed-Interval-TSpace(0,1)
  for s being Point of Closed-Interval-TSpace(a,b) holds
  P[01](a,b,t1,t2).s = ((t2 - t1)/(b-a))*s + (b*t1 -a*t2)/(b-a);

theorem 
  a < b implies for t1,t2 being Point of Closed-Interval-TSpace(0,1)
  holds P[01](a,b,t1,t2) is continuous;

theorem 
  a < b implies for t1,t2 being Point of Closed-Interval-TSpace(0,1)
  holds P[01](a,b,t1,t2).(#)(a,b) = t1 & P[01](a,b,t1,t2).(a,b)(#) = t2;

theorem 
  P[01](0,1,(#)(0,1),(0,1)(#)) = id Closed-Interval-TSpace(0,1);

theorem 
  a < b implies
  id Closed-Interval-TSpace(a,b) =
     L[01]((#)(a,b),(a,b)(#)) * P[01](a,b,(#)(0,1),(0,1)(#)) &
  id Closed-Interval-TSpace(0,1) =
     P[01](a,b,(#)(0,1),(0,1)(#)) * L[01]((#)(a,b),(a,b)(#));

theorem 
  a < b implies
  id Closed-Interval-TSpace(a,b) =
     L[01]((a,b)(#),(#)(a,b)) * P[01](a,b,(0,1)(#),(#)(0,1)) &
  id Closed-Interval-TSpace(0,1) =
     P[01](a,b,(0,1)(#),(#)(0,1)) * L[01]((a,b)(#),(#)(a,b));

theorem 
  a < b implies
  L[01]((#)(a,b),(a,b)(#)) is being_homeomorphism &
  L[01]((#)(a,b),(a,b)(#))" = P[01](a,b,(#)(0,1),(0,1)(#)) &
  P[01](a,b,(#)(0,1),(0,1)(#)) is being_homeomorphism &
  P[01](a,b,(#)(0,1),(0,1)(#))" = L[01]((#)(a,b),(a,b)(#));

theorem 
  a < b implies
  L[01]((a,b)(#),(#)(a,b)) is being_homeomorphism &
  L[01]((a,b)(#),(#)(a,b))" = P[01](a,b,(0,1)(#),(#)(0,1)) &
  P[01](a,b,(0,1)(#),(#)(0,1)) is being_homeomorphism &
  P[01](a,b,(0,1)(#),(#)(0,1))" = L[01]((a,b)(#),(#)(a,b));

begin



theorem 
  I[01] is connected;

theorem 
  a <= b implies Closed-Interval-TSpace(a,b) is connected;

theorem 
  for f being continuous Function of I[01],I[01]
  ex x being Point of I[01] st f.x = x;

theorem 
  a <= b implies for f being continuous Function of
  Closed-Interval-TSpace(a,b), Closed-Interval-TSpace(a,b)
  ex x being Point of Closed-Interval-TSpace(a,b) st f.x = x;

theorem 
  for X, Y being non empty SubSpace of R^1, f being continuous Function of X,Y
  holds
  (ex a,b being Real st a <= b & [.a,b.] c= the carrier of X &
      [.a,b.] c= the carrier of Y & f.:[.a,b.] c= [.a,b.]) implies
  ex x being Point of X st f.x = x;


theorem 
  for X, Y being non empty SubSpace of R^1, f being continuous Function of X,Y
  holds
  (ex a,b being Real st a <= b & [.a,b.] c= the carrier of X &
     f.:[.a,b.] c= [.a,b.]) implies
  ex x being Point of X st f.x = x;














begin 

reserve T,T1,T2,S for non empty TopSpace;

scheme 

  FrCard { A() -> non empty set, X() -> set, F(set) -> set, P[set] }: card { F
  (w) where w is Element of A(): w in X() & P[w] } c= card X();

theorem 
  for f being Function of T1,S, g being Function of T2,S st T1 is
  SubSpace of T & T2 is SubSpace of T & ([#] T1) \/ ([#] T2) = [#] T & T1 is
compact & T2 is compact & T is T_2 & f is continuous & g is continuous & ( for
p be set st p in ([#] T1) /\ ([#] T2) holds f.p = g.p ) ex h being Function of
  T,S st h = f+*g & h is continuous;

registration
  let T be TopStruct;
  cluster id T -> open continuous;
end;

registration
  let T be TopStruct;
  cluster continuous one-to-one for Function of T, T;
end;

theorem 
  for S, T being non empty TopSpace, f being Function of S, T st f is
  being_homeomorphism holds f" is open;

begin 

theorem 
  for T be non empty TopSpace, a be Point of T ex f be Function of
  I[01], T st f is continuous & f.0 = a & f.1 = a;

definition
  let T be TopStruct, a,b be Point of T;
  pred a,b are_connected means


  ex f being Function of I[01], T st f is continuous & f.0 = a & f.1 = b;
end;

definition
  let T be non empty TopSpace, a,b be Point of T;
  redefine pred a,b are_connected;
  reflexivity;
end;

definition
  let T be TopStruct;
  let a, b be Point of T;
  assume
 a, b are_connected;
  mode Path of a, b -> Function of I[01], T means


    it is continuous & it .0 = a & it.1 = b;
end;

registration
  let T be non empty TopSpace;
  let a be Point of T;
  cluster continuous for Path of a, a;
end;

definition
  let T be TopStruct;
  attr T is pathwise_connected means


  for a, b being Point of T holds a, b are_connected;
end;

registration
  cluster strict pathwise_connected non empty for TopSpace;
end;

definition
  let T be pathwise_connected TopStruct;
  let a, b be Point of T;
  redefine mode Path of a, b means


  it is continuous & it.0 = a & it.1 = b;
end;

registration
  let T be pathwise_connected TopStruct;
  let a, b be Point of T;
  cluster -> continuous for Path of a, b;
end;

reserve GY for non empty TopSpace,
  r,s for Real;

registration
  cluster pathwise_connected -> connected for non empty TopSpace;
end;

begin

definition
  let T be non empty TopSpace;
  let a, b, c be Point of T;
  let P be Path of a, b, Q be Path of b, c such that
 a,b are_connected and
 b,c are_connected;
  func P + Q -> Path of a, c means


  for t being Point of I[01] holds ( t
  <= 1/2 implies it.t = P.(2*t) ) & ( 1/2 <= t implies it.t = Q.(2*t-1) );
end;

registration
  let T be non empty TopSpace;
  let a be Point of T;
  cluster constant for Path of a, a;
end;

canceled;

theorem 
  for T being non empty TopSpace, a being Point of T, P being constant
  Path of a, a holds P = I[01] --> a;

theorem 
  for T being non empty TopSpace, a being Point of T, P being
  constant Path of a, a holds P + P = P;

registration
  let T be non empty TopSpace, a be Point of T, P be constant Path of a, a;
  cluster P + P -> constant;
end;

definition
  let T be non empty TopSpace;
  let a, b be Point of T;
  let P be Path of a, b;
  assume
 a,b are_connected;
  func - P -> Path of b, a means


  for t being Point of I[01] holds it.t = P.(1-t);
end;

theorem 
  for T being non empty TopSpace, a being Point of T, P being
  constant Path of a, a holds - P = P;

registration
  let T be non empty TopSpace, a be Point of T, P be constant Path of a, a;
  cluster - P -> constant;
end;

begin 

theorem 
  for X, Y being non empty TopSpace for A being Subset-Family of Y
  for f being Function of X, Y holds f"(union A) = union (f"A);

definition
  let S1, S2, T1, T2 be non empty TopSpace;
  let f be Function of S1, S2, g be Function of T1, T2;
  redefine func [:f, g:] -> Function of [:S1, T1:], [:S2, T2:];
end;

theorem 
  for S1, S2, T1, T2 be non empty TopSpace, f be continuous
Function of S1, T1, g be continuous Function of S2, T2, P1, P2 being Subset of
  [:T1, T2:] holds (P2 in Base-Appr P1 implies [:f,g:]"P2 is open);

theorem 
  for S1, S2, T1, T2 be non empty TopSpace, f be continuous
Function of S1, T1, g be continuous Function of S2, T2, P2 being Subset of [:T1
  , T2:] holds (P2 is open implies [:f,g:]"P2 is open);

registration
  let S1, S2, T1, T2 be non empty TopSpace,
      f be continuous Function of S1, T1, g be continuous Function of S2, T2;
  cluster [:f,g:] -> continuous for Function of [:S1,S2:], [:T1,T2:];
end;

registration
  let T1, T2 be T_0 TopSpace;
  cluster [:T1, T2:] -> T_0;
end;

registration
  let T1, T2 be T_1 TopSpace;
  cluster [:T1, T2:] -> T_1;
end;

registration
  let T1, T2 be T_2 TopSpace;
  cluster [:T1, T2:] -> T_2;
end;

registration
  cluster I[01] -> compact T_2;
end;

definition
  let T be non empty TopStruct;
  let a, b be Point of T;
  let P, Q be Path of a, b;
  pred P, Q are_homotopic means

  ex f being Function of [:I[01],I[01]:], T st f
is continuous & for t being Point of I[01] holds f.(t,0) = P.t & f.(t,1) = Q.t
  & f.(0,t) = a & f.(1,t) = b;
  symmetry;
end;

canceled;

theorem 
  for T being non empty TopSpace, a, b being Point of T, P being
  Path of a, b st a,b are_connected holds P, P are_homotopic;

definition
  let T be non empty pathwise_connected TopSpace;
  let a, b be Point of T;
  let P, Q be Path of a, b;
  redefine pred P, Q are_homotopic;
  reflexivity;
end;

theorem 
  for G being non empty TopSpace, w1,w2,w3 being Point of G, h1,h2 being
Function of I[01],G st h1 is continuous & w1=h1.0 & w2=h1.1 & h2 is continuous
& w2=h2.0 & w3=h2.1 holds ex h3 being Function of I[01],G st h3 is continuous &
  w1=h3.0 & w3=h3.1 & rng h3 c= (rng h1) \/ (rng h2);

theorem 
  for T being non empty TopSpace,a,b,c being Point of T, G1 being Path
of a,b, G2 being Path of b,c st G1 is continuous & G2 is continuous & G1.0=a &
G1.1=b & G2.0=b & G2.1=c holds G1+G2 is continuous & (G1+G2).0=a & (G1+G2).1=c;

registration
  let T be non empty TopSpace;
  cluster non empty compact connected for Subset of T;
end;



theorem 
  for T being non empty TopSpace, a, b being Point of T st (ex f
  being Function of I[01], T st f is continuous & f.0 = a & f.1 = b) holds ex g
  being Function of I[01], T st g is continuous & g.0 = b & g.1 = a;

registration
  cluster I[01] -> pathwise_connected;
end;














begin 

reserve x,y,z,X for set,
  T for Universe;

definition
  let X;

  func the_universe_of X equals

  Tarski-Class the_transitive-closure_of X;
end;

registration
  let X;
  cluster the_universe_of X -> epsilon-transitive Tarski;
end;

registration
  let X;
  cluster the_universe_of X -> universal non empty;
end;

theorem 
  for f being Function st dom f in T & rng f c= T holds product f in T;

begin

begin 

theorem 
  for Y be non empty set for J being 1-sorted-yielding
ManySortedSet of Y, i being Element of Y holds (Carrier J).i = the carrier of J
  .i;

registration
  cluster non empty constant 1-sorted-yielding for Function;
end;

notation
  let J be 1-sorted-yielding Function;
  synonym J is yielding_non-empty_carriers for J is non-Empty;
end;

definition
  let J be 1-sorted-yielding Function;
  redefine attr J is yielding_non-empty_carriers means


  for i being set st i in rng J holds i is non empty 1-sorted;
end;

registration
  let X be set;
  let L be 1-sorted;
  cluster X --> L -> 1-sorted-yielding;
end;

registration
  let I be set;
  cluster yielding_non-empty_carriers for
1-sorted-yielding ManySortedSet of I;
end;

registration
  let I be non empty set;
  let J be RelStr-yielding ManySortedSet of I;
  cluster the carrier of product J -> functional;
end;

registration
  let I be set;
  let J be yielding_non-empty_carriers 1-sorted-yielding ManySortedSet of I;
  cluster Carrier J -> non-empty;
end;

begin 

registration
  let T be non empty RelStr, A be lower Subset of T;
  cluster A` -> upper;
end;

registration
  let T be non empty RelStr, A be upper Subset of T;
  cluster A` -> lower;
end;

definition
  let N be non empty RelStr;
  redefine attr N is directed means


  for x,y being Element of N ex z being Element of N st x <= z & y <= z;
end;

registration
  let X be set;
  cluster BoolePoset X -> directed;
end;

registration
  cluster non empty directed transitive strict for RelStr;
end;

definition
  let M be non empty set, N be non empty RelStr, f be Function of M, the
  carrier of N, m be Element of M;
  redefine func f.m -> Element of N;
end;

registration
  let I be set;
  cluster yielding_non-empty_carriers for RelStr-yielding ManySortedSet of I;
end;

registration
  let I be non empty set;
  let J be yielding_non-empty_carriers RelStr-yielding ManySortedSet of I;
  cluster product J -> non empty;
end;

registration
  let Y1,Y2 be directed RelStr;
  cluster [:Y1,Y2:] -> directed;
end;

theorem 
  for R being RelStr holds the carrier of R = the carrier of R~;

definition
  let S be 1-sorted, N be NetStr over S;
  attr N is constant means


  the mapping of N is constant;
end;

definition
  let R be RelStr, T be non empty 1-sorted, p be Element of T;
  func ConstantNet(R,p) -> strict NetStr over T means


  the RelStr of it
  = the RelStr of R & the mapping of it = (the carrier of it) --> p;
end;

registration
  let R be RelStr, T be non empty 1-sorted, p be Element of T;
  cluster ConstantNet(R,p) -> constant;
end;

registration
  let R be non empty RelStr, T be non empty 1-sorted, p be Element of T;
  cluster ConstantNet(R,p) -> non empty;
end;

registration
  let R be non empty directed RelStr, T be non empty 1-sorted, p be Element of
  T;
  cluster ConstantNet(R,p) -> directed;
end;

registration
  let R be non empty transitive RelStr, T be non empty 1-sorted, p be Element
  of T;
  cluster ConstantNet(R,p) -> transitive;
end;

theorem 
  for R be RelStr, T be non empty 1-sorted, p be Element of T
  holds the carrier of ConstantNet(R,p) = the carrier of R;

theorem 
  for R be non empty RelStr, T be non empty 1-sorted, p be Element
  of T, q be Element of ConstantNet(R,p) holds ConstantNet(R,p).q = p;

registration
  let T be non empty 1-sorted, N be non empty NetStr over T;
  cluster the mapping of N -> non empty;
end;

begin 

theorem 
  for R being RelStr holds R is full SubRelStr of R;

theorem 
  for R being RelStr, S being SubRelStr of R, T being SubRelStr of
  S holds T is SubRelStr of R;

definition
  let S be 1-sorted, N be NetStr over S;
  mode SubNetStr of N -> NetStr over S means


    it is SubRelStr of N & the
    mapping of it = (the mapping of N)|the carrier of it;
end;

theorem 
  for S being 1-sorted, N being NetStr over S holds N is SubNetStr of N;

theorem 
  for Q being 1-sorted, R being NetStr over Q, S being SubNetStr of R, T
  being SubNetStr of S holds T is SubNetStr of R;

definition
  let S be 1-sorted, N be NetStr over S, M be SubNetStr of N;
  attr M is full means


  M is full SubRelStr of N;
end;

registration
  let S be 1-sorted, N be NetStr over S;
  cluster full strict for SubNetStr of N;
end;

registration
  let S be 1-sorted, N be non empty NetStr over S;
  cluster full non empty strict for SubNetStr of N;
end;

theorem 
  for S being 1-sorted, N being NetStr over S, M be SubNetStr of N
  holds the carrier of M c= the carrier of N;

theorem 
  for S being 1-sorted, N being NetStr over S, M be SubNetStr of N
  , x,y being Element of N, i,j being Element of M st x = i & y = j & i <= j
  holds x <= y;

theorem 
  for S being 1-sorted, N being non empty NetStr over S, M be non
empty full SubNetStr of N, x,y being Element of N, i,j being Element of M st x
  = i & y = j & x <= y holds i <= j;

begin 

registration
  let T be non empty 1-sorted;
  cluster constant strict for net of T;
end;

registration
  let T be non empty 1-sorted, N be constant NetStr over T;
  cluster the mapping of N -> constant;
end;

definition
  let T be non empty 1-sorted, N be NetStr over T;
  assume
 N is constant non empty;
  func the_value_of N -> Element of T equals


  the_value_of the mapping
  of N;
end;

theorem 
  for R be non empty RelStr, T be non empty 1-sorted, p be Element
  of T holds the_value_of (ConstantNet(R,p)) = p;

definition
  let T be non empty 1-sorted, N be net of T;

  mode subnet of N -> net of T means


    ex f being Function of it, N st
the mapping of it = (the mapping of N)*f & for m being Element of N ex n being
    Element of it st for p being Element of it st n <= p holds m <= f.p;
end;

theorem 
  for T being non empty 1-sorted, N be net of T holds N is subnet of N;

theorem 
  for T being non empty 1-sorted, N1,N2,N3 be net of T st N1 is subnet
  of N2 & N2 is subnet of N3 holds N1 is subnet of N3;

theorem 
  for T being non empty 1-sorted, N be constant net of T, i being
  Element of N holds N.i = the_value_of N;

theorem 
  for L being non empty 1-sorted, N being net of L, X,Y being set
  st N is_eventually_in X & N is_eventually_in Y holds X meets Y;

theorem 
  for S being non empty 1-sorted, N being net of S, M being subnet
  of N, X st M is_often_in X holds N is_often_in X;

theorem 
  for S being non empty 1-sorted, N being net of S, X st N
  is_eventually_in X holds N is_often_in X;

theorem 
  for S being non empty 1-sorted, N being net of S holds N
  is_eventually_in the carrier of S;

begin 

definition
  let S be 1-sorted, N be NetStr over S, X;
  func N"X -> strict SubNetStr of N means


  it is full SubRelStr of N & the carrier of it = (the mapping of N)"X;
end;

registration
  let S be 1-sorted, N be transitive NetStr over S, X;
  cluster N"X -> transitive full;
end;

theorem 
  for S being non empty 1-sorted, N be net of S, X st N
  is_often_in X holds N"X is non empty directed;

theorem 
  for S being non empty 1-sorted, N being net of S, X st N
  is_often_in X holds N"X is subnet of N;

theorem 
  for S being non empty 1-sorted, N being net of S, X for M being
  subnet of N st M = N"X holds M is_eventually_in X;

begin 

definition
  let X be non empty 1-sorted;
  func NetUniv X means


  for x holds x in it iff ex N being strict net
  of X st N = x & the carrier of N in the_universe_of the carrier of X;
end;

registration
  let X be non empty 1-sorted;
  cluster NetUniv X -> non empty;
end;

begin 

definition
  let X be set, T be 1-sorted;
  mode net_set of X,T -> ManySortedSet of X means


    for i being set st i in rng it holds i is net of T;
end;

theorem 
  for X being set, T being 1-sorted, F being ManySortedSet of X
  holds F is net_set of X,T iff for i being set st i in X holds F.i is net of T
;

definition
  let X be non empty set, T be 1-sorted;
  let J be net_set of X,T, i be Element of X;
  redefine func J.i -> net of T;
end;

registration
  let X be set, T be 1-sorted;
  cluster -> RelStr-yielding for net_set of X,T;
end;

registration
  let T be 1-sorted, Y be net of T;
  cluster -> yielding_non-empty_carriers for net_set of the carrier of Y,T;
end;

registration
  let T be non empty 1-sorted, Y be net of T, J be net_set of the carrier of Y
  ,T;
  cluster product J -> directed transitive;
end;

registration
  let X be set, T be 1-sorted;
  cluster -> yielding_non-empty_carriers for net_set of X,T;
end;

registration
  let X be set, T be 1-sorted;
  cluster yielding_non-empty_carriers for net_set of X,T;
end;

definition
  let T be non empty 1-sorted, Y be net of T, J be net_set of the carrier of Y
  ,T;
  func Iterated J -> strict net of T means


  the RelStr of it = [:Y,
product J:] & for i being Element of Y, f being Function st i in the carrier of
Y & f in the carrier of product J holds (the mapping of it).(i,f) =(the mapping
  of J.i).(f.i);
end;

theorem 
  for T being non empty 1-sorted, Y being net of T, J being
  net_set of the carrier of Y,T st Y in NetUniv T & for i being Element of Y
  holds J.i in NetUniv T holds Iterated J in NetUniv T;

theorem 
  for T being non empty 1-sorted, N being net of T for J being
net_set of the carrier of N, T holds the carrier of Iterated J = [:the carrier
  of N, product Carrier J:];

theorem 
  for T being non empty 1-sorted, N being net of T, J being
  net_set of the carrier of N, T, i being Element of N, f being Element of
product J, x being Element of Iterated J st x = [i,f] holds (Iterated J).x = (
  the mapping of J.i).(f.i);

theorem 
  for T being non empty 1-sorted, Y being net of T, J being
  net_set of the carrier of Y,T holds rng the mapping of Iterated J c= union {
  rng the mapping of J.i where i is Element of Y: not contradiction };

begin 

definition
  let T be non empty TopSpace, p be Point of T;
  func OpenNeighborhoods p -> RelStr equals

  (InclPoset { V where V is Subset
  of T: p in V & V is open })~;
end;

registration
  let T be non empty TopSpace, p be Point of T;
  cluster OpenNeighborhoods p -> non empty;
end;

theorem 
  for T being non empty TopSpace, p being Point of T, x being
Element of OpenNeighborhoods p ex W being Subset of T st W = x & p in W & W is
  open;

theorem 
  for T be non empty TopSpace, p be Point of T for x being Subset
  of T holds x in the carrier of OpenNeighborhoods p iff p in x & x is open;

theorem 
  for T be non empty TopSpace, p be Point of T for x,y being
  Element of OpenNeighborhoods p holds x <= y iff y c= x;

registration
  let T be non empty TopSpace, p be Point of T;
  cluster OpenNeighborhoods p -> transitive directed;
end;

begin 

definition
  let T be non empty TopSpace, N be net of T;
  func Lim N -> Subset of T means


  for p being Point of T holds p in it
  iff for V being a_neighborhood of p holds N is_eventually_in V;
end;

theorem 
  for T being non empty TopSpace, N being net of T, Y being subnet
  of N holds Lim N c= Lim Y;

theorem 
  for T being non empty TopSpace, N be constant net of T holds
  the_value_of N in Lim N;

theorem 
  for T being non empty TopSpace, N be net of T, p be Point of T
  st p in Lim N for d being Element of N ex S being Subset of T st S = { N.c
  where c is Element of N : d <= c } & p in Cl S;

theorem 
  for T being non empty TopSpace holds T is Hausdorff iff for N
  being net of T, p,q being Point of T st p in Lim N & q in Lim N holds p = q;

registration
  let T be Hausdorff non empty TopSpace, N be net of T;
  cluster Lim N -> trivial;
end;

definition
  let T be non empty TopSpace, N be net of T;
  attr N is convergent means


  Lim N <> {};
end;

registration
  let T be non empty TopSpace;
  cluster constant -> convergent for net of T;
end;

registration
  let T be non empty TopSpace;
  cluster convergent strict for net of T;
end;

definition
  let T be Hausdorff non empty TopSpace, N be convergent net of T;
  func lim N -> Element of T means


  it in Lim N;
end;

theorem 
  for T be Hausdorff non empty TopSpace, N be constant net of T holds
  lim N = the_value_of N;

theorem 
  for T being non empty TopSpace, N being net of T for p being Point of
  T st not p in Lim N ex Y being subnet of N st not ex Z being subnet of Y st p
  in Lim Z;

theorem 
  for T being non empty TopSpace, N being net of T st N in NetUniv
  T for p being Point of T st not p in Lim N ex Y being subnet of N st Y in
  NetUniv T & not ex Z being subnet of Y st p in Lim Z;

theorem 
  for T being non empty TopSpace, N being net of T, p being Point
  of T st p in Lim N for J being net_set of the carrier of N, T st for i being
  Element of N holds N.i in Lim(J.i) holds p in Lim Iterated J;

begin 

definition
  let S be non empty 1-sorted;
  mode Convergence-Class of S means


    it c= [:NetUniv S,the carrier of S :];
end;

registration
  let S be non empty 1-sorted;
  cluster -> Relation-like for Convergence-Class of S;
end;

definition
  let T be non empty TopSpace;
  func Convergence T -> Convergence-Class of T means


  for N being net
  of T, p being Point of T holds [N,p] in it iff N in NetUniv T & p in Lim N;
end;

definition
  let T be non empty 1-sorted, C be Convergence-Class of T;
  attr C is (CONSTANTS) means


  for N being constant net of T st N in
  NetUniv T holds [N,the_value_of N] in C;
  attr C is (SUBNETS) means


  for N being net of T, Y being subnet of N
st Y in NetUniv T for p being Element of T holds [N,p] in C implies [Y,p] in C;
  attr C is (DIVERGENCE) means


  for X being net of T, p being Element
of T st X in NetUniv T & not [X,p] in C ex Y being subnet of X st Y in NetUniv
  T & not ex Z being subnet of Y st [Z,p] in C;
  attr C is (ITERATED_LIMITS) means


  for X being net of T, p being
Element of T st [X,p] in C for J being net_set of the carrier of X, T st for i
  being Element of X holds [J.i,X.i] in C holds [Iterated J,p] in C;
end;

registration
  let T be non empty TopSpace;
  cluster Convergence T -> (CONSTANTS) (SUBNETS) (DIVERGENCE)
    (ITERATED_LIMITS);
end;

definition
  let S be non empty 1-sorted, C be Convergence-Class of S;
  func ConvergenceSpace C -> strict TopStruct means


  the carrier of it
  = the carrier of S & the topology of it = { V where V is Subset of S: for p
  being Element of S st p in V for N being net of S st [N,p] in C holds N
  is_eventually_in V};
end;

registration
  let S be non empty 1-sorted, C be Convergence-Class of S;
  cluster ConvergenceSpace C -> non empty;
end;

registration
  let S be non empty 1-sorted, C be Convergence-Class of S;
  cluster ConvergenceSpace C -> TopSpace-like;
end;

theorem 
  for S be non empty 1-sorted, C be Convergence-Class of S holds C
  c= Convergence ConvergenceSpace C;

definition
  let T be non empty 1-sorted, C be Convergence-Class of T;
  attr C is topological means


  C is (CONSTANTS) (SUBNETS) (DIVERGENCE) (ITERATED_LIMITS);
end;

registration
  let T be non empty 1-sorted;
  cluster non empty topological for Convergence-Class of T;
end;

registration
  let T be non empty 1-sorted;
  cluster topological -> (CONSTANTS) (SUBNETS) (DIVERGENCE) (ITERATED_LIMITS)
    for Convergence-Class of T;
  cluster (CONSTANTS) (SUBNETS) (DIVERGENCE) (ITERATED_LIMITS) -> topological
    for Convergence-Class of T;
end;

theorem 
  for T being non empty 1-sorted, C being topological
  Convergence-Class of T, S being Subset of (ConvergenceSpace C qua non empty
  TopSpace) holds S is open iff for p being Element of T st p in S for N being
  net of T st [N,p] in C holds N is_eventually_in S;

theorem 
  for T being non empty 1-sorted, C being topological
  Convergence-Class of T, S being Subset of (ConvergenceSpace C qua non empty
TopSpace) holds S is closed iff for p being Element of T holds for N being net
  of T st [N,p] in C & N is_often_in S holds p in S;

theorem 
  for T being non empty 1-sorted, C being topological
Convergence-Class of T, S being Subset of ConvergenceSpace C, p being Point of
  ConvergenceSpace C st p in Cl S ex N being net of ConvergenceSpace C st [N,p]
  in C & rng the mapping of N c= S & p in Lim N;

theorem 
  for T be non empty 1-sorted, C be Convergence-Class of T holds
  Convergence ConvergenceSpace C = C iff C is topological;














begin

reserve i for set;

begin 

definition
  struct(2-sorted) ManySortedSign (# carrier,carrier' -> set, Arity ->
Function of the carrier', the carrier*, ResultSort -> Function of the carrier',
    the carrier #);
end;

registration
  cluster void strict non empty for ManySortedSign;
  cluster non void strict non empty for ManySortedSign;
end;

reserve S for non empty ManySortedSign;

definition
  let S;
  mode SortSymbol of S is Element of S;
  mode OperSymbol of S is Element of the carrier' of S;
end;

definition

  let S be non void non empty ManySortedSign;
  let o be OperSymbol of S;
  func the_arity_of o -> Element of (the carrier of S)* equals

  (the Arity of S).o;
  func the_result_sort_of o -> Element of S equals

  (the ResultSort of S).o;
end;

begin 

definition
  let S be 1-sorted;
  struct many-sorted over S (# Sorts -> ManySortedSet of the carrier of S #);
end;

definition
  let S;
  struct(many-sorted over S) MSAlgebra over S
   (# Sorts -> ManySortedSet of the carrier of S,
      Charact -> ManySortedFunction of
    ((the Sorts)# * the Arity of S), the Sorts * the ResultSort of S#);
end;

definition
  let S be 1-sorted;
  let A be many-sorted over S;
  attr A is non-empty means


  the Sorts of A is non-empty;
end;

registration
  let S;
  cluster strict non-empty for MSAlgebra over S;
end;

registration
  let S be 1-sorted;
  cluster strict non-empty for many-sorted over S;
end;

registration
  let S be 1-sorted;
  let A be non-empty many-sorted over S;
  cluster the Sorts of A -> non-empty;
end;

registration
  let S;
  let A be non-empty MSAlgebra over S;
  cluster -> non empty for Component of the Sorts of A;
  cluster -> non empty for Component of (the Sorts of A)#;
end;

definition
  let S be non void non empty ManySortedSign;
  let o be OperSymbol of S;
  let A be MSAlgebra over S;
  func Args(o,A) -> Component of (the Sorts of A)# equals

  ((the Sorts of A)# *
  the Arity of S).o;
  func Result(o,A) -> Component of the Sorts of A equals

  ((the Sorts of A) *
  the ResultSort of S).o;
end;

definition
  let S be non void non empty ManySortedSign;
  let o be OperSymbol of S;
  let A be MSAlgebra over S;
  func Den(o,A) -> Function of Args(o,A), Result(o,A) equals

  (the Charact of A
  ).o;
end;

theorem 
  for S being non void non empty ManySortedSign, o being OperSymbol of S
  , A being non-empty MSAlgebra over S holds Den(o,A) is non empty;

begin 

reserve D for non empty set,
  n for Nat;

theorem 
  for C being set, A,B being non empty set, F being PartFunc of C,A
  , G being Function of A,B holds G*F is Function of dom F,B;

theorem 
  for h being homogeneous quasi_total non empty PartFunc of D*,D
  holds dom h = Funcs(Seg(arity h),D);

theorem 
  for A being Universal_Algebra holds signature A is non empty;

begin 

definition
  let IT be ManySortedSign;
  attr IT is segmental means


  ex n st the carrier' of IT = Seg n;
end;

theorem 
  for S being non empty ManySortedSign st S is trivial for A being
  MSAlgebra over S, c1,c2 being Component of the Sorts of A holds c1 = c2;

registration
  cluster segmental non void strict 1-element for ManySortedSign;
end;

definition
  let A be Universal_Algebra;
  func MSSign A -> non void strict segmental trivial ManySortedSign means

 the carrier of it = {0} & the carrier' of it = dom signature A & the
Arity of it = (*-->0)*signature A &
     the ResultSort of it = dom signature(A)-->0;
end;

registration
  let A be Universal_Algebra;
  cluster MSSign A -> 1-element;
end;

definition
  let A be Universal_Algebra;
  func MSSorts A -> non-empty ManySortedSet of the carrier of MSSign A equals

  0.-->the carrier of A;
end;

definition
  let A be Universal_Algebra;
  func MSCharact A -> ManySortedFunction of (MSSorts A)# * the Arity of MSSign
  A, (MSSorts A)* the ResultSort of MSSign A equals

  the charact of A;
end;

definition
  let A be Universal_Algebra;
  func MSAlg A -> strict MSAlgebra over MSSign A equals

  MSAlgebra(#MSSorts A, MSCharact A#);
end;

registration
  let A be Universal_Algebra;
  cluster MSAlg A -> non-empty;
end;



definition
  let MS be 1-element ManySortedSign;
  let A be MSAlgebra over MS;
  func the_sort_of A -> set means


  it is Component of the Sorts of A;
end;

registration
  let MS be 1-element ManySortedSign;
  let A be non-empty MSAlgebra over MS;
  cluster the_sort_of A -> non empty;
end;

theorem 
  for MS being segmental non void 1-element ManySortedSign
, i being OperSymbol of MS, A being non-empty MSAlgebra over MS holds Args(i,A)
  = (len the_arity_of i)-tuples_on the_sort_of A;

theorem 
  for MS being segmental non void 1-element ManySortedSign
, i being OperSymbol of MS, A being non-empty MSAlgebra over MS holds Args(i,A)
  c= (the_sort_of A)*;

theorem 
  for MS being segmental non void 1-element ManySortedSign
, A being non-empty MSAlgebra over MS holds the Charact of A is FinSequence of
  PFuncs((the_sort_of A)*,the_sort_of A);

definition
  let MS be segmental non void 1-element ManySortedSign;
  let A be non-empty MSAlgebra over MS;
  func the_charact_of A -> PFuncFinSequence of the_sort_of A equals

  the
  Charact of A;
end;

reserve MS for segmental non void 1-element ManySortedSign,
  A for non-empty MSAlgebra over MS,
  h for PartFunc of (the_sort_of A)*,(the_sort_of A) ,
  x,y for FinSequence of the_sort_of A;

definition
  let MS,A;
  func 1-Alg A -> non-empty strict Universal_Algebra equals

  UAStr(#the_sort_of
    A, the_charact_of A#);
end;

theorem 
  for A being strict Universal_Algebra holds A = 1-Alg MSAlg A;

theorem 
  for A being Universal_Algebra for f being Function of dom signature A,
  {0}* for z being Element of {0} st f = (*-->0)*signature A holds MSSign A =
  ManySortedSign(#{0},dom signature A,f,dom signature(A)-->z#);














begin

reserve I,J,i,j,x for set,
  S for non empty ManySortedSign;





registration
  let X be with_common_domain functional non empty set;
  cluster -> DOM X -defined for Element of X;
end;

registration
  let X be with_common_domain functional non empty set;
  cluster -> total for Element of X;
end;

begin



definition
  let F be Function;

  func Commute F -> Function means


  (for x holds x in dom it iff ex f
  being Function st f in dom F & x = commute f) & for f being Function st f in
  dom it holds it.f = F.commute f;
end;

theorem 
  for F be Function st dom F = {{}} holds Commute F = F;

definition
  let f be Function-yielding Function;

  redefine func Frege f -> ManySortedFunction of product doms f means


  for g be Function st g in product doms f holds it.g = f..g;
end;

registration
  let I;
  let A,B be non-empty ManySortedSet of I;
  cluster [|A,B|] -> non-empty;
end;

theorem 
  for I be non empty set, J be set, A,B be ManySortedSet of I, f be
  Function of J,I holds [|A,B|]*f = [|A*f,B*f|];

definition
  let I be non empty set;
  let A,B be non-empty ManySortedSet of I, pj being Element of I*, rj being
  Element of I, f be Function of A#.pj,A.rj, g be Function of B#.pj,B.rj;

  func [[:f,g:]] -> Function of [|A,B|]#.pj,[|A,B|].rj means

  for h be Function st h in [|A,B|]#.pj holds it.h = [f.(pr1 h),g.(pr2 h)];
end;

definition
  let I be non empty set,J;
  let A,B be non-empty ManySortedSet of I, p be Function of J,I*, r be
  Function of J,I, F be ManySortedFunction of A#*p,A*r, G be ManySortedFunction
  of B#*p,B*r;
  func [[:F,G:]] -> ManySortedFunction of [|A,B|]#*p,[|A,B|]*r means

  for j st
j in J for pj being Element of I*, rj being Element of I st pj = p.j & rj = r.j
for f be Function of A#.pj,A.rj, g be Function of B#.pj,B.rj st f = F.j & g = G
  .j holds it.j = [[:f,g:]];
end;

begin





definition
  let I,S;
  mode MSAlgebra-Family of I,S -> ManySortedSet of I means


    for i st i in I holds it.i is non-empty MSAlgebra over S;
end;

definition
  let I be non empty set, S;
  let A be MSAlgebra-Family of I,S, i be Element of I;
  redefine func A.i -> non-empty MSAlgebra over S;
end;

definition
  let S be non empty ManySortedSign, U1 be MSAlgebra over S;
  func |.U1.| -> set equals

  union (rng the Sorts of U1);
end;

registration
  let S be non empty ManySortedSign, U1 be non-empty MSAlgebra over S;
  cluster |.U1.| -> non empty;
end;

definition
  let I be non empty set, S be non empty ManySortedSign, A be MSAlgebra-Family
  of I,S;
  func |.A.| -> set equals

  union {|.A.i.| where i is Element of I: not
  contradiction};
end;

registration
  let I be non empty set, S be non empty ManySortedSign, A be MSAlgebra-Family
  of I,S;
  cluster |.A.| -> non empty;
end;

begin





theorem 
  for S be non void non empty ManySortedSign, U0 be MSAlgebra over
  S, o be OperSymbol of S holds Args(o,U0) = product ((the Sorts of U0)*(
the_arity_of o)) & dom ((the Sorts of U0)*(the_arity_of o)) = dom (the_arity_of
  o) & Result(o,U0) = (the Sorts of U0).(the_result_sort_of o);

theorem 
  for S be non void non empty ManySortedSign, U0 be MSAlgebra over
  S, o be OperSymbol of S st the_arity_of o = {} holds Args(o,U0) = {{}};

definition
  let S;
  let U1,U2 be non-empty MSAlgebra over S;
  func [:U1,U2:] -> MSAlgebra over S equals

  MSAlgebra (# [|the Sorts of U1,the
    Sorts of U2|], [[:the Charact of U1,the Charact of U2:]] #);
end;

registration
  let S;
  let U1,U2 be non-empty MSAlgebra over S;
  cluster [:U1,U2:] -> strict;
end;

definition
  let I,S;
  let s be SortSymbol of S, A be MSAlgebra-Family of I,S;
  func Carrier (A,s) -> ManySortedSet of I means


  for i be set st i in
I ex U0 being MSAlgebra over S st U0 = A.i & it.i = (the Sorts of U0).s if I <>
  {} otherwise it = {};
end;

registration
  let I,S;
  let s be SortSymbol of S, A be MSAlgebra-Family of I,S;
  cluster Carrier (A,s) -> non-empty;
end;

definition
  let I,S;
  let A be MSAlgebra-Family of I,S;
  func SORTS(A) -> ManySortedSet of the carrier of S means


  for s be SortSymbol of S holds it.s = product Carrier(A,s);
end;

registration
  let I, S;
  let A be MSAlgebra-Family of I,S;
  cluster SORTS(A) -> non-empty;
end;

definition
  let I;
  let S be non empty ManySortedSign, A be MSAlgebra-Family of I,S;
  func OPER(A) -> ManySortedFunction of I means


  for i be set st i in I
ex U0 being MSAlgebra over S st U0 = A.i & it.i = the Charact of U0 if I <> {}
  otherwise it = {};
end;

theorem 
  for S be non empty ManySortedSign, A be MSAlgebra-Family of I,S
  holds dom uncurry (OPER A) = [:I,the carrier' of S:];

theorem 
  for I be non empty set, S be non void non empty ManySortedSign,
  A be MSAlgebra-Family of I,S, o be OperSymbol of S holds commute (OPER A) in
  Funcs(the carrier' of S, Funcs(I,rng uncurry (OPER A)));

definition
  let I be set, S be non void non empty ManySortedSign, A be MSAlgebra-Family
  of I,S, o be OperSymbol of S;
  func A?.o -> ManySortedFunction of I equals

  (commute (OPER A)).o;
end;

theorem 
  for I be non empty set, i be Element of I, S be non void non
empty ManySortedSign, A be MSAlgebra-Family of I,S, o be OperSymbol of S holds
  (A?.o).i = Den(o,A.i);

theorem 
  for I be non empty set, S be non void non empty ManySortedSign, A be
MSAlgebra-Family of I,S, o be OperSymbol of S, x be set st x in rng (Frege (A?.
  o)) holds x is Function;

theorem 
  for I be non empty set, S be non void non empty ManySortedSign,
A be MSAlgebra-Family of I,S, o be OperSymbol of S, f be Function st f in rng (
Frege (A?.o)) holds dom f = I & for i be Element of I holds f.i in Result(o,A.i
  );

theorem 
  for I be non empty set, S be non void non empty ManySortedSign,
A be MSAlgebra-Family of I,S, o be OperSymbol of S, f be Function st f in dom (
Frege (A?.o)) holds dom f = I & (for i be Element of I holds f.i in Args(o,A.i)
  ) & rng f c= Funcs(dom(the_arity_of o),|.A.|);

theorem 
  for I be non empty set, S be non void non empty ManySortedSign,
A be MSAlgebra-Family of I,S, o be OperSymbol of S holds dom doms (A?.o) = I &
  for i be Element of I holds (doms (A?.o)).i = Args(o,A.i);

definition
  let I;
  let S be non void non empty ManySortedSign, A be MSAlgebra-Family of I,S;
  func OPS(A) -> ManySortedFunction of (SORTS A)# * the Arity of S, (SORTS A)
  * the ResultSort of S means

  for o be OperSymbol of S holds it.o=IFEQ(
  the_arity_of o,{},commute(A?.o),Commute Frege(A?.o)) if I <> {} otherwise not
  contradiction;
end;

definition
  let I be set, S be non void non empty ManySortedSign, A be MSAlgebra-Family
  of I,S;
  func product A -> MSAlgebra over S equals

  MSAlgebra (# SORTS A, OPS A #);
end;

registration
  let I be set, S be non void non empty ManySortedSign, A be MSAlgebra-Family
  of I,S;
  cluster product A -> strict;
end;

theorem 
  for S be non void non empty ManySortedSign, A be MSAlgebra-Family of I
  ,S holds the Sorts of product A = SORTS A & the Charact of product A = OPS A;














begin





reserve x,y for set;

registration
  let I be set, X be ManySortedSet of I, Y be non-empty ManySortedSet of I;
  cluster X \/ Y -> non-empty;
  cluster Y \/ X -> non-empty;
end;

theorem 
  for I be non empty set, X, Y be ManySortedSet of I, i be Element
  of I* holds product ((X /\ Y)*i) = product(X * i) /\ product(Y * i);

begin





reserve S for non void non empty ManySortedSign,
  o for OperSymbol of S,
  U0,U1, U2 for MSAlgebra over S;

definition
  let S be non empty ManySortedSign, U0 be MSAlgebra over S;
  mode MSSubset of U0 is ManySortedSubset of the Sorts of U0;
end;

definition
  let S be non empty ManySortedSign;
  let IT be SortSymbol of S;

  attr IT is with_const_op means


  ex o be OperSymbol of S st (the Arity
  of S).o = {} & (the ResultSort of S).o = IT;
end;

definition
  let IT be non empty ManySortedSign;
  attr IT is all-with_const_op means


  for s be SortSymbol of IT holds s is with_const_op;
end;

registration
  let A be non empty set, B be set, a be Function of B,A*, r be Function of B,
  A;
  cluster ManySortedSign(#A,B,a,r#) -> non empty;
end;

registration
  cluster non void all-with_const_op strict for non empty ManySortedSign;
end;

definition
  let S be non void non empty ManySortedSign, U0 be MSAlgebra over S, s be
  SortSymbol of S;
  func Constants(U0,s) -> Subset of (the Sorts of U0).s means


  ex A
being non empty set st A =(the Sorts of U0).s & it = { a where a is Element of
A: ex o be OperSymbol of S st (the Arity of S).o = {} & (the ResultSort of S).
  o = s & a in rng Den(o,U0)} if (the Sorts of U0).s <> {} otherwise it = {};
end;

definition
  let S be non void non empty ManySortedSign, U0 be MSAlgebra over S;
  func Constants (U0) -> MSSubset of U0 means


  for s be SortSymbol of S holds it.s = Constants(U0,s);
end;

registration
  let S be all-with_const_op non void non empty ManySortedSign, U0 be
  non-empty MSAlgebra over S, s be SortSymbol of S;
  cluster Constants(U0,s) -> non empty;
end;

registration
  let S be non void all-with_const_op non empty ManySortedSign, U0 be
  non-empty MSAlgebra over S;
  cluster Constants(U0) -> non-empty;
end;

begin





definition
  let S be non void non empty ManySortedSign, U0 be MSAlgebra over S, o be
  OperSymbol of S, A be MSSubset of U0;
  pred A is_closed_on o means


  rng ((Den(o,U0))|((A# * the Arity of S).o )) c= (A * the ResultSort of S).o;
end;

definition
  let S be non void non empty ManySortedSign, U0 be MSAlgebra over S, A be
  MSSubset of U0;
  attr A is opers_closed means


  for o be OperSymbol of S holds A is_closed_on o;
end;

theorem 
  for S be non void non empty ManySortedSign, o be OperSymbol of S,
U0 be MSAlgebra over S, B0, B1 be MSSubset of U0 st B0 c= B1 holds ((B0# * the
  Arity of S).o) c= ((B1# * the Arity of S).o);

definition
  let S be non void non empty ManySortedSign, U0 be MSAlgebra over S, o be
  OperSymbol of S, A be MSSubset of U0;
  assume
 A is_closed_on o;
  func o/.A ->Function of (A# * the Arity of S).o, (A * the ResultSort of S).o
  equals


  (Den(o,U0)) | ((A# * the Arity of S).o);
end;

definition
  let S be non void non empty ManySortedSign, U0 be MSAlgebra over S, A be
  MSSubset of U0;
  func Opers(U0,A) -> ManySortedFunction of (A# * the Arity of S),(A * the
  ResultSort of S) means


  for o be OperSymbol of S holds it.o = o/.A;
end;

theorem 
  for U0 being MSAlgebra over S for B being MSSubset of U0 st B=the
  Sorts of U0 holds B is opers_closed & for o holds o/.B = Den(o,U0);

theorem 
  for B being MSSubset of U0 st B=the Sorts of U0 holds Opers(U0,B)
  = the Charact of U0;

definition
  let S be non void non empty ManySortedSign, U0 be MSAlgebra over S;
  mode MSSubAlgebra of U0 -> MSAlgebra over S means


    the Sorts of it is
    MSSubset of U0 & for B be MSSubset of U0 st B = the Sorts of it holds B is
    opers_closed & the Charact of it = Opers(U0,B);
end;

registration
  let S be non void non empty ManySortedSign, U0 be MSAlgebra over S;
  cluster strict for MSSubAlgebra of U0;
end;

registration
  let S be non void non empty ManySortedSign, U0 be non-empty MSAlgebra over S;
  cluster MSAlgebra (#the Sorts of U0,the Charact of U0#) -> non-empty;
end;

registration
  let S be non void non empty ManySortedSign, U0 be non-empty MSAlgebra over S;
  cluster non-empty strict for MSSubAlgebra of U0;
end;

theorem 
  the MSAlgebra of U0 = the MSAlgebra of U1 implies U0 is MSSubAlgebra of U1;

theorem 
  U0 is MSSubAlgebra of U1 & U1 is MSSubAlgebra of U2 implies U0 is
  MSSubAlgebra of U2;

theorem 
  U1 is MSSubAlgebra of U2 & U2 is MSSubAlgebra of U1
  implies the MSAlgebra of U1 = the MSAlgebra of U2;

theorem 
  for U1,U2 be MSSubAlgebra of U0 st the Sorts of U1 c= the Sorts
  of U2 holds U1 is MSSubAlgebra of U2;

theorem 
  for U1,U2 be MSSubAlgebra of U0 st the Sorts of U1 = the
  Sorts of U2 holds the MSAlgebra of U1 = the MSAlgebra of U2;

theorem 
  for S be non void non empty ManySortedSign, U0 be MSAlgebra over
  S, U1 be MSSubAlgebra of U0 holds Constants(U0) is MSSubset of U1;

theorem 
  for S be non void all-with_const_op non empty ManySortedSign, U0 be
non-empty MSAlgebra over S, U1 be non-empty MSSubAlgebra of U0 holds Constants(
  U0) is non-empty MSSubset of U1;

theorem 
  for S be non void all-with_const_op non empty ManySortedSign, U0 be
  non-empty MSAlgebra over S, U1,U2 be non-empty MSSubAlgebra of U0 holds (the
  Sorts of U1) /\ (the Sorts of U2) is non-empty;

begin





definition
  let S be non void non empty ManySortedSign, U0 be MSAlgebra over S, A be
  MSSubset of U0;
  func SubSort(A) -> set means


  for x be set holds x in it iff x in
Funcs(the carrier of S, bool (Union (the Sorts of U0))) & x is MSSubset of U0 &
for B be MSSubset of U0 st B = x holds B is opers_closed & Constants(U0) c= B &
  A c= B;
end;

registration
  let S be non void non empty ManySortedSign, U0 be MSAlgebra over S, A be
  MSSubset of U0;
  cluster SubSort(A) -> non empty;
end;

definition
  let S be non void non empty ManySortedSign, U0 be MSAlgebra over S;
  func SubSort(U0) -> set means


  for x be set holds x in it iff x in
Funcs(the carrier of S, bool Union the Sorts of U0) & x is MSSubset of U0 & for
  B be MSSubset of U0 st B = x holds B is opers_closed;
end;

registration
  let S be non void non empty ManySortedSign, U0 be MSAlgebra over S;
  cluster SubSort(U0) -> non empty;
end;

definition
  let S be non void non empty ManySortedSign, U0 be MSAlgebra over S, e be
  Element of SubSort(U0);
  func @e -> MSSubset of U0 equals

  e;
end;

theorem 
  for A,B be MSSubset of U0 holds B in SubSort(A) iff B is
  opers_closed & Constants(U0) c= B & A c= B;

theorem 
  for B be MSSubset of U0 holds B in SubSort(U0) iff B is opers_closed;

definition
  let S be non void non empty ManySortedSign, U0 be MSAlgebra over S, A be
  MSSubset of U0, s be SortSymbol of S;
  func SubSort(A,s) -> set means


  for x be set holds x in it iff ex B
  be MSSubset of U0 st B in SubSort(A) & x = B.s;
end;

registration
  let S be non void non empty ManySortedSign, U0 be MSAlgebra over S, A be
  MSSubset of U0, s be SortSymbol of S;
  cluster SubSort(A,s) -> non empty;
end;

definition
  let S be non void non empty ManySortedSign, U0 be MSAlgebra over S, A be
  MSSubset of U0;
  func MSSubSort(A) -> MSSubset of U0 means


  for s be SortSymbol of S holds it.s = meet (SubSort(A,s));
end;

theorem 
  for A be MSSubset of U0 holds Constants(U0) \/ A c= MSSubSort(A);

theorem 
  for A be MSSubset of U0 st Constants(U0) \/ A is non-empty holds
  MSSubSort(A) is non-empty;

theorem 
  for A be MSSubset of U0 for B be MSSubset of U0 st B in SubSort(
  A) holds ((MSSubSort A)# * (the Arity of S)).o c= (B# * (the Arity of S)).o;

theorem 
  for A be MSSubset of U0 for B be MSSubset of U0 st B in SubSort(
  A) holds rng (Den(o,U0)|(((MSSubSort A)# * (the Arity of S)).o)) c= (B * (the
  ResultSort of S)).o;

theorem 
  for A be MSSubset of U0 holds rng ((Den(o,U0))|(((MSSubSort A)#
  * (the Arity of S)).o)) c= ((MSSubSort A) * (the ResultSort of S)).o;

theorem 
  for A be MSSubset of U0 holds MSSubSort(A) is opers_closed & A
  c= MSSubSort(A);

begin





definition
  let S be non void non empty ManySortedSign, U0 be MSAlgebra over S, A be
  MSSubset of U0;
  assume
 A is opers_closed;
  func U0|A -> strict MSSubAlgebra of U0 equals


  MSAlgebra (#A, Opers(
U0,A) qua ManySortedFunction of (A# * the Arity of S),(A * the ResultSort of S)
  #);
end;

definition
  let S be non void non empty ManySortedSign, U0 be MSAlgebra over S, U1,U2 be
  MSSubAlgebra of U0;
  func U1 /\ U2 -> strict MSSubAlgebra of U0 means


  the Sorts of it = (
the Sorts of U1) /\ (the Sorts of U2) & for B be MSSubset of U0 st B=the Sorts
  of it holds B is opers_closed & the Charact of it = Opers(U0,B);
end;

definition
  let S be non void non empty ManySortedSign, U0 be MSAlgebra over S, A be
  MSSubset of U0;
  func GenMSAlg(A) -> strict MSSubAlgebra of U0 means


  A is MSSubset of
  it & for U1 be MSSubAlgebra of U0 st A is MSSubset of U1 holds it is
  MSSubAlgebra of U1;
end;

registration
  let S be non void non empty ManySortedSign, U0 be non-empty MSAlgebra over S
  , A be non-empty MSSubset of U0;
  cluster GenMSAlg(A) -> non-empty;
end;

theorem 
  for S be non void non empty ManySortedSign, U0 be
MSAlgebra over S, B be MSSubset of U0 st B = the Sorts of U0 holds GenMSAlg(B)
  = the MSAlgebra of U0;

theorem 
  for S be non void non empty ManySortedSign, U0 be MSAlgebra over
S, U1 be MSSubAlgebra of U0, B be MSSubset of U0 st B = the Sorts of U1
  holds GenMSAlg(B) = the MSAlgebra of U1;

theorem 
  for S be non void non empty ManySortedSign, U0 be non-empty
MSAlgebra over S, U1 be MSSubAlgebra of U0 holds GenMSAlg(Constants(U0)) /\ U1
  = GenMSAlg(Constants(U0));

definition
  let S be non void non empty ManySortedSign, U0 be non-empty MSAlgebra over S
  , U1,U2 be MSSubAlgebra of U0;
  func U1 "\/" U2 -> strict MSSubAlgebra of U0 means


  for A be MSSubset
  of U0 st A = (the Sorts of U1) \/ (the Sorts of U2) holds it = GenMSAlg(A);
end;

theorem 
  for S be non void non empty ManySortedSign,U0 be non-empty
  MSAlgebra over S, U1 be MSSubAlgebra of U0, A,B be MSSubset of U0 st B = A \/
  the Sorts of U1 holds GenMSAlg(A) "\/" U1 = GenMSAlg(B);

theorem 
  for S be non void non empty ManySortedSign, U0 be non-empty
  MSAlgebra over S, U1 be MSSubAlgebra of U0, B be MSSubset of U0 st B = the
  Sorts of U0 holds GenMSAlg(B) "\/" U1 = GenMSAlg(B);

theorem 
  for S be non void non empty ManySortedSign,U0 be non-empty
  MSAlgebra over S, U1,U2 be MSSubAlgebra of U0 holds U1 "\/" U2 = U2 "\/" U1;

theorem 
  for S be non void non empty ManySortedSign, U0 be non-empty
  MSAlgebra over S, U1,U2 be MSSubAlgebra of U0 holds U1 /\ (U1"\/"U2) =
  the MSAlgebra of U1;

theorem 
  for S be non void non empty ManySortedSign, U0 be non-empty
  MSAlgebra over S, U1,U2 be MSSubAlgebra of U0 holds (U1 /\ U2)"\/"U2 =
  the MSAlgebra of U2;

begin





definition
  let S be non void non empty ManySortedSign, U0 be MSAlgebra over S;
  func MSSub(U0) -> set means


  for x holds x in it iff x is strict MSSubAlgebra of U0;
end;

registration
  let S be non void non empty ManySortedSign, U0 be MSAlgebra over S;
  cluster MSSub(U0) -> non empty;
end;

definition
  let S be non void non empty ManySortedSign, U0 be non-empty MSAlgebra over S;
  func MSAlg_join(U0) -> BinOp of (MSSub(U0)) means


  for x,y be Element
  of MSSub(U0) holds for U1,U2 be strict MSSubAlgebra of U0 st x = U1 & y = U2
  holds it.(x,y) = U1 "\/" U2;
end;

definition
  let S be non void non empty ManySortedSign, U0 be non-empty MSAlgebra over S;
  func MSAlg_meet(U0) -> BinOp of (MSSub(U0)) means


  for x,y be Element
  of MSSub(U0) holds for U1,U2 be strict MSSubAlgebra of U0 st x = U1 & y = U2
  holds it.(x,y) = U1 /\ U2;
end;

reserve U0 for non-empty MSAlgebra over S;

theorem 
  MSAlg_join(U0) is commutative;

theorem 
  MSAlg_join(U0) is associative;

theorem 
  for S be non void non empty ManySortedSign, U0 be non-empty
  MSAlgebra over S holds MSAlg_meet(U0) is commutative;

theorem 
  for S be non void non empty ManySortedSign, U0 be non-empty
  MSAlgebra over S holds MSAlg_meet(U0) is associative;

definition
  let S be non void non empty ManySortedSign, U0 be non-empty MSAlgebra over S;
  func MSSubAlLattice(U0) -> strict Lattice equals

  LattStr (# MSSub(U0),
    MSAlg_join(U0), MSAlg_meet(U0) #);
end;

theorem 
  for S be non void non empty ManySortedSign, U0 be non-empty
  MSAlgebra over S holds MSSubAlLattice(U0) is bounded;

registration
  let S be non void non empty ManySortedSign, U0 be non-empty MSAlgebra over S;
  cluster MSSubAlLattice(U0) -> bounded;
end;

theorem 
  for S be non void non empty ManySortedSign, U0 be non-empty MSAlgebra
  over S holds Bottom (MSSubAlLattice(U0)) = GenMSAlg(Constants(U0));

theorem 
  for S be non void non empty ManySortedSign, U0 be non-empty
  MSAlgebra over S, B be MSSubset of U0 st B = the Sorts of U0 holds Top (
  MSSubAlLattice(U0)) = GenMSAlg(B);

theorem 
  for S be non void non empty ManySortedSign, U0 be non-empty
  MSAlgebra over S holds Top (MSSubAlLattice(U0)) = the MSAlgebra of U0;

theorem 
  for S being non void non empty ManySortedSign, U0 being MSAlgebra over
  S holds MSAlgebra (#the Sorts of U0,the Charact of U0#) is MSSubAlgebra of U0
;

theorem 
  for S being non void non empty ManySortedSign, U0 being MSAlgebra over
  S, A being MSSubset of U0 holds the Sorts of U0 in SubSort(A);

theorem 
  for S being non void non empty ManySortedSign, U0 being MSAlgebra over
  S, A being MSSubset of U0 holds SubSort(A) c= SubSort(U0);














begin

reserve S for non void non empty ManySortedSign,
  U1,U2 for MSAlgebra over S,
  o for OperSymbol of S,
  n for Nat;



definition
  let I be non empty set, A,B be ManySortedSet of I, F be ManySortedFunction
  of A,B, i be Element of I;
  redefine func F.i -> Function of A.i,B.i;
end;

definition
  let S be non empty ManySortedSign;
  let U1,U2 be MSAlgebra over S;
  mode ManySortedFunction of U1,U2 is ManySortedFunction of the Sorts of U1,
    the Sorts of U2;
end;

definition
  let I be set,A be ManySortedSet of I;
  func id A -> ManySortedFunction of A,A means


  for i be set st i in I holds it.i = id (A.i);
end;

definition
  let IT be Function;
  attr IT is "1-1" means


  for i be set, f be Function st i in dom IT & IT.i = f holds f is one-to-one;
end;

registration
  let I be set;
  cluster "1-1" for ManySortedFunction of I;
end;

theorem 
  for I be set,F be ManySortedFunction of I holds F is "1-1" iff
  for i be set st i in I holds F.i is one-to-one;

definition
  let I be set, A,B be ManySortedSet of I;
  let IT be ManySortedFunction of A,B;
  attr IT is "onto" means


  for i be set st i in I holds rng(IT.i) = B.i;
end;

theorem 
  for I be set, A,B,C be ManySortedSet of I, F be
ManySortedFunction of A,B, G be ManySortedFunction of B,C holds dom (G ** F) =
  I & for i be set st i in I holds (G**F).i = (G.i)*(F.i);

definition
  let I be set, A be ManySortedSet of I, B,C be non-empty ManySortedSet of I,
  F be ManySortedFunction of A,B, G be ManySortedFunction of B,C;
  redefine func G**F -> ManySortedFunction of A,C;
end;

theorem 
  for I be set,A,B be ManySortedSet of I, F be ManySortedFunction of A,B
  holds F**(id A) = F;

theorem 
  for I be set, A,B be ManySortedSet of I for F be
  ManySortedFunction of A, B holds (id B)**F = F;

definition
  let I be set, A,B be ManySortedSet of I, F be ManySortedFunction of A,B;
  assume that
 F is "1-1" and
 F is "onto";

  func F"" -> ManySortedFunction of B,A means


  for i be set st i in I holds it.i = (F.i)";
end;

theorem 
  for I be set,A,B be non-empty ManySortedSet of I, H be
ManySortedFunction of A,B, H1 be ManySortedFunction of B,A st H is "1-1" "onto"
  & H1 = H"" holds H**H1 = id B & H1**H = id A;

registration
  let S;
  let U1 be non-empty MSAlgebra over S;
  let o;
  cluster Args(o,U1) -> functional;
end;

begin



theorem 
  for U1 being MSAlgebra over S for x be Function st x in Args(o,U1
) holds dom x = dom (the_arity_of o) & for y be set st y in dom ((the Sorts of
  U1) * (the_arity_of o)) holds x.y in ((the Sorts of U1) * (the_arity_of o)).y
;

definition
  let S;
  let U1,U2 be MSAlgebra over S;
  let o;
  let F be ManySortedFunction of U1,U2;
  let x be Element of Args(o,U1);
  assume that
 Args(o,U1) <> {} and
 Args(o,U2) <> {};

  func F # x -> Element of Args(o,U2) equals


  (Frege(F*the_arity_of o)).
  x;
end;

definition
  let S;
  let U1,U2 be non-empty MSAlgebra over S;
  let o;
  let F be ManySortedFunction of U1,U2;
  let x be Element of Args(o,U1);
  redefine func F # x means


  for n st n in dom x holds it.n = (F.((the_arity_of o)/.n)).(x.n);
end;

theorem 
  for S,o for U1 being MSAlgebra over S st Args(o,U1) <> {} for x
  be Element of Args(o,U1) holds x = ((id (the Sorts of U1))#x);

theorem 
  for U1,U2,U3 being non-empty MSAlgebra over S for H1 be
ManySortedFunction of U1,U2, H2 be ManySortedFunction of U2,U3, x be Element of
  Args(o,U1) holds (H2**H1)#x = H2#(H1#x);

definition
  let S;
  let U1,U2 be MSAlgebra over S;
  let F be ManySortedFunction of U1,U2;
  pred F is_homomorphism U1,U2 means


  for o be OperSymbol of S st Args(o
,U1) <> {} for x be Element of Args(o,U1) holds (F.(the_result_sort_of o)).(Den
  (o,U1).x) = Den(o,U2).(F#x);
end;

theorem 
  for U1 being MSAlgebra over S holds id (the Sorts of U1)
  is_homomorphism U1,U1;

theorem 
  for U1,U2,U3 being non-empty MSAlgebra over S for H1 be
  ManySortedFunction of U1,U2, H2 be ManySortedFunction of U2,U3 st H1
is_homomorphism U1,U2 & H2 is_homomorphism U2,U3 holds H2 ** H1 is_homomorphism
  U1,U3;

definition
  let S;
  let U1,U2 be MSAlgebra over S;
  let F be ManySortedFunction of U1,U2;
  pred F is_epimorphism U1,U2 means


  F is_homomorphism U1,U2 & F is "onto";
end;

theorem 
  for U1,U2,U3 being non-empty MSAlgebra over S for F be
  ManySortedFunction of U1,U2, G be ManySortedFunction of U2,U3 st F
  is_epimorphism U1,U2 & G is_epimorphism U2,U3 holds G**F is_epimorphism U1,U3
;

definition
  let S;
  let U1,U2 be MSAlgebra over S;
  let F be ManySortedFunction of U1,U2;
  pred F is_monomorphism U1,U2 means


  F is_homomorphism U1,U2 & F is "1-1";
end;

theorem 
  for U1,U2,U3 being non-empty MSAlgebra over S for F be
  ManySortedFunction of U1,U2, G be ManySortedFunction of U2,U3 st F
is_monomorphism U1,U2 & G is_monomorphism U2,U3 holds G**F is_monomorphism U1,
  U3;

definition
  let S;
  let U1,U2 be MSAlgebra over S;
  let F be ManySortedFunction of U1,U2;
  pred F is_isomorphism U1,U2 means


  F is_epimorphism U1,U2 & F is_monomorphism U1,U2;
end;

theorem 
  for F be ManySortedFunction of U1,U2 holds F is_isomorphism U1,
  U2 iff F is_homomorphism U1,U2 & F is "onto" & F is "1-1";

theorem 
  for U1,U2 being non-empty MSAlgebra over S for H be
  ManySortedFunction of U1,U2, H1 be ManySortedFunction of U2,U1 st H
  is_isomorphism U1,U2 & H1 = H"" holds H1 is_isomorphism U2,U1;

theorem 
  for U1,U2,U3 being non-empty MSAlgebra over S for H be
  ManySortedFunction of U1,U2, H1 be ManySortedFunction of U2,U3 st H
is_isomorphism U1,U2 & H1 is_isomorphism U2,U3 holds H1 ** H is_isomorphism U1,
  U3;

definition
  let S;
  let U1,U2 be MSAlgebra over S;
  pred U1,U2 are_isomorphic means


  ex F be ManySortedFunction of U1,U2 st F is_isomorphism U1,U2;
end;

theorem 
  for U1 being MSAlgebra over S holds id the Sorts of U1
  is_isomorphism U1,U1 & U1,U1 are_isomorphic;

definition
  let S;
  let U1, U2 be MSAlgebra over S;
  redefine pred U1, U2 are_isomorphic;
  reflexivity;
end;

theorem 
  for U1,U2 being non-empty MSAlgebra over S holds U1,U2 are_isomorphic
  implies U2,U1 are_isomorphic;

theorem 
  for U1,U2,U3 being non-empty MSAlgebra over S holds U1,U2
  are_isomorphic & U2,U3 are_isomorphic implies U1,U3 are_isomorphic;

definition
  let S;
  let U1,U2 be non-empty MSAlgebra over S;
  let F be ManySortedFunction of U1,U2;
  assume
 F is_homomorphism U1,U2;
  func Image F -> strict non-empty MSSubAlgebra of U2 means


  the Sorts of it = F.:.:(the Sorts of U1);
end;

theorem 
  for U1 being non-empty MSAlgebra over S, U2 being non-empty
  MSAlgebra over S, F be ManySortedFunction of U1,U2 st F is_homomorphism U1,U2
  holds F is_epimorphism U1,U2 iff Image F = the MSAlgebra of U2;

theorem 
  for U1,U2 being non-empty MSAlgebra over S for F be
ManySortedFunction of U1,U2, G be ManySortedFunction of U1,Image F st F = G & F
  is_homomorphism U1,U2 holds G is_epimorphism U1,Image F;

theorem 
  for U1,U2 being non-empty MSAlgebra over S for F be ManySortedFunction
of U1,U2 st F is_homomorphism U1,U2 ex G be ManySortedFunction of U1,Image F st
  F = G & G is_epimorphism U1,Image F;

theorem 
  for U1 being non-empty MSAlgebra over S for U2 be non-empty
MSSubAlgebra of U1, G be ManySortedFunction of U2,U1 st G = id (the Sorts of U2
  ) holds G is_monomorphism U2,U1;

theorem 
  for U1,U2 being non-empty MSAlgebra over S for F be ManySortedFunction
of U1,U2 st F is_homomorphism U1,U2 ex F1 be ManySortedFunction of U1,Image F,
  F2 be ManySortedFunction of Image F,U2 st F1 is_epimorphism U1,Image F & F2
  is_monomorphism Image F,U2 & F = F2**F1;

theorem 
  for S for U1,U2 being MSAlgebra over S for o for F being
  ManySortedFunction of U1,U2 for x being Element of Args(o,U1), f,u being
  Function st x = f & x in Args(o,U1) & u in Args(o,U2) holds u = F#x iff for n
  st n in dom f holds u.n = (F.((the_arity_of o)/.n)).(f.n);














begin  

reserve x, y, i for set,
  L for up-complete Semilattice;

theorem 
  L is continuous iff for x being Element of L holds waybelow x is Ideal
  of L & x <= sup waybelow x & for I being Ideal of L st x <= sup I holds
  waybelow x c= I;

theorem 
  L is continuous iff for x being Element of L ex I being Ideal of L st
  x <= sup I & for J being Ideal of L st x <= sup J holds I c= J;

theorem 
  for L being continuous lower-bounded sup-Semilattice holds SupMap L is
  upper_adjoint;

theorem 
  for L being up-complete lower-bounded LATTICE holds SupMap L is
  upper_adjoint implies L is continuous;

theorem 
  for L being complete Semilattice holds SupMap L is infs-preserving
  sups-preserving implies SupMap L is upper_adjoint;



definition
  let J, D be set, K be ManySortedSet of J;
  mode DoubleIndexedSet of K, D is ManySortedFunction of K, (J --> D);
end;

definition
  let J be set, K be ManySortedSet of J, S be 1-sorted;
  mode DoubleIndexedSet of K, S is DoubleIndexedSet of K, the carrier of S;
end;

theorem 
  for J, D being set, K being ManySortedSet of J for F being
DoubleIndexedSet of K, D for j being set st j in J holds F.j is Function of K.j
  , D;

definition
  let J, D be non empty set, K be ManySortedSet of J;
  let F be DoubleIndexedSet of K, D;
  let j be Element of J;
  redefine func F.j -> Function of K.j, D;
end;

registration
  let J, D be non empty set, K be non-empty ManySortedSet of J;
  let F be DoubleIndexedSet of K, D;
  let j be Element of J;
  cluster rng(F.j) -> non empty;
end;

registration
  let J be set, D be non empty set;
  let K be non-empty ManySortedSet of J;
  cluster -> non-empty for DoubleIndexedSet of K, D;
end;

theorem 
  for F being Function-yielding Function for f being set holds f in
  dom(Frege F) implies f is Function;

theorem 
  for F being Function-yielding Function for f being Function st f
  in dom Frege F holds dom f = dom F & dom F = dom((Frege F).f);

theorem 
  for F being Function-yielding Function for f being Function st f
in dom Frege F for i being set st i in dom F holds f.i in dom(F.i) & ((Frege F)
  .f).i = (F.i).(f.i) & (F.i).(f.i) in rng((Frege F).f);

theorem 
  for J, D being set, K being ManySortedSet of J for F being
DoubleIndexedSet of K, D for f being Function st f in dom(Frege F) holds (Frege
  F).f is Function of J, D;

registration
  let f be non-empty Function;
  cluster doms f -> non-empty;
end;

definition
  let J, D be set, K be ManySortedSet of J;
  let F be DoubleIndexedSet of K, D;
  redefine func Frege F -> DoubleIndexedSet of (product doms F --> J), D;
end;

definition
  let J, D be non empty set, K be non-empty ManySortedSet of J;
  let F be DoubleIndexedSet of K, D;
  let G be DoubleIndexedSet of (product doms F --> J), D;
  let f be Element of product doms F;
  redefine func G.f -> Function of J, D;
end;

definition
  let L be non empty RelStr;
  let F be Function-yielding Function;
  func \//(F, L) -> Function of dom F, the carrier of L means


  for x st x in dom F holds it.x = \\/(F.x, L);
  func /\\(F, L) -> Function of dom F, the carrier of L means


  for x st x in dom F holds it.x = //\(F.x, L);
end;

notation
  let J be set, K be ManySortedSet of J, L be non empty RelStr;
  let F be DoubleIndexedSet of K, L;
  synonym Sups F for \//(F, L);
  synonym Infs F for /\\(F, L);
end;

notation
  let I, J be set, L be non empty RelStr;
  let F be DoubleIndexedSet of (I --> J), L;
  synonym Sups F for \//(F, L);
  synonym Infs F for /\\(F, L);
end;

theorem 
  for L being non empty RelStr for F, G being Function-yielding
Function st dom F = dom G & (for x st x in dom F holds \\/(F.x, L) = \\/(G.x, L
  )) holds \//(F, L) = \//(G, L);

theorem 
  for L being non empty RelStr for F, G being Function-yielding
Function st dom F = dom G & (for x st x in dom F holds //\(F.x, L) = //\(G.x, L
  )) holds /\\(F, L) = /\\(G, L);

theorem 
  for L being non empty RelStr for F being Function-yielding
Function holds (y in rng \//(F, L) iff ex x st x in dom F & y = \\/(F.x, L)) &
  (y in rng /\\(F, L) iff ex x st x in dom F & y = //\(F.x, L));

theorem 
  for L being non empty RelStr for J being non empty set, K being
ManySortedSet of J for F being DoubleIndexedSet of K, L holds (x in rng Sups F
iff ex j being Element of J st x = Sup(F.j)) & (x in rng Infs F iff ex j being
  Element of J st x = Inf(F.j));

registration
  let J be non empty set, K be ManySortedSet of J, L be non empty RelStr;
  let F be DoubleIndexedSet of K, L;
  cluster rng Sups F -> non empty;
  cluster rng Infs F -> non empty;
end;

reserve L for complete LATTICE,
  a, b, c for Element of L,
  J for non empty set,
  K for non-empty ManySortedSet of J;

theorem 
  for F being Function-yielding Function holds (for f being
  Function st f in dom Frege F holds //\((Frege F).f, L) <= a) implies Sup /\\(
  Frege F, L) <= a;

theorem 
  for F being DoubleIndexedSet of K, L holds Inf Sups F >= Sup Infs Frege F;

theorem 
  (L is continuous & for c st c << a holds c <= b) implies a <= b;

theorem 
  (for J being non empty set st J in the_universe_of the carrier
of L for K being non-empty ManySortedSet of J st for j being Element of J holds
K.j in the_universe_of the carrier of L for F being DoubleIndexedSet of K, L st
for j being Element of J holds rng(F.j) is directed holds Inf Sups F = Sup Infs
  Frege F) implies L is continuous;

theorem 
  L is continuous iff for J, K for F being DoubleIndexedSet of K, L st
for j being Element of J holds rng(F.j) is directed holds Inf Sups F = Sup Infs
  Frege F;

definition
  let J, K, D be non empty set;
  let F be Function of [:J, K:], D;
  redefine func curry F -> DoubleIndexedSet of (J --> K), D;
end;

reserve J, K, D for non empty set,
  j for Element of J,
  k for Element of K;

theorem 
  for F being Function of [:J, K:], D holds dom curry F = J & dom(
  (curry F).j) = K & F.(j, k) = ((curry F).j).k;

theorem 
  L is continuous iff for J, K being non empty set for F being Function
of [:J, K:], the carrier of L st for j being Element of J holds rng((curry F).j
  ) is directed holds Inf Sups curry F = Sup Infs Frege curry F;

theorem 
  for F being Function of [:J, K:], the carrier of L for X being
  Subset of L st X = {a where a is Element of L: ex f being non-empty
ManySortedSet of J st f in Funcs(J, Fin K) & ex G being DoubleIndexedSet of f,
  L st (for j, x st x in f.j holds (G.j).x = F.(j, x)) & a = Inf Sups G} holds
  Inf Sups curry F >= sup X;

theorem 
  L is continuous iff for J, K for F being Function of [:J, K:], the
  carrier of L for X being Subset of L st X = {a where a is Element of L: ex f
  being non-empty ManySortedSet of J st f in Funcs(J, Fin K) & ex G being
DoubleIndexedSet of f, L st (for j, x st x in f.j holds (G.j).x = F.(j, x)) & a
  = Inf Sups G} holds Inf Sups curry F = sup X;

begin  

definition
  let L be non empty RelStr;
  attr L is completely-distributive means


  L is complete & for J being
  non empty set, K being non-empty ManySortedSet of J for F being
  DoubleIndexedSet of K, L holds Inf Sups F = Sup Infs Frege F;
end;

reserve J for non empty set,
  K for non-empty ManySortedSet of J;

registration
  cluster -> completely-distributive for 1-element Poset;
end;

registration
  cluster completely-distributive for LATTICE;
end;

theorem 
  for L being completely-distributive LATTICE holds L is continuous;

registration
  cluster completely-distributive -> complete continuous for LATTICE;
end;

theorem 
  for L being non empty antisymmetric transitive with_infima
  RelStr for x being Element of L for X, Y being Subset of L st ex_sup_of X,L &
ex_sup_of Y,L & Y = {x"/\"y where y is Element of L: y in X} holds x "/\" sup X
  >= sup Y;

theorem 
  for L being completely-distributive LATTICE for X being Subset
  of L for x being Element of L holds x "/\" sup X = "\/"({x"/\"y where y is
  Element of L: y in X}, L);

registration
  cluster completely-distributive -> Heyting for LATTICE;
end;



begin  

definition
  let L be non empty RelStr;
  mode CLSubFrame of L is infs-inheriting directed-sups-inheriting non empty
    full SubRelStr of L;
end;

theorem 
  for F being DoubleIndexedSet of K, L st for j being Element of J
  holds rng(F.j) is directed holds rng Infs Frege F is directed;

theorem 
  L is continuous implies for S being CLSubFrame of L holds S is
  continuous LATTICE;

theorem 
  for S being non empty Poset st ex g being Function of L, S st g
  is infs-preserving onto holds S is complete LATTICE;

notation
  let J be set, y be set;
  synonym J => y for J --> y;
end;

registration
  let J be set, y be set;
  cluster J => y -> total for J-defined Function;
end;

definition
  let A, B, J be set, f be Function of A, B;
  redefine func J => f -> ManySortedFunction of (J --> A), (J --> B);
end;

theorem 
  for A, B being set for f being Function of A, B, g being
  Function of B, A st g*f = id A holds (J => g)**(J => f) = id (J --> A);

theorem 
  for J, A being non empty set, B being set, K being ManySortedSet
of J for F being DoubleIndexedSet of K, A for f being Function of A, B holds (J
  => f)**F is DoubleIndexedSet of K, B;

theorem 
  for J, A, B being non empty set, K being ManySortedSet of J for
F being DoubleIndexedSet of K, A for f being Function of A, B holds doms((J =>
  f)**F) = doms F;

theorem 
  L is continuous implies for S being non empty Poset st ex g being
  Function of L, S st g is infs-preserving directed-sups-preserving & g is onto
  holds S is continuous LATTICE;














begin 

theorem 
  for L being reflexive antisymmetric with_suprema RelStr for a being
  Element of L holds a "\/" a = a;

theorem 
  for L being reflexive antisymmetric with_infima RelStr for a
  being Element of L holds a "/\" a = a;

theorem 
  for L be transitive antisymmetric with_suprema RelStr for a,b,c being
  Element of L holds a"\/"b <= c implies a <= c;

theorem 
  for L be transitive antisymmetric with_infima RelStr for a,b,c being
  Element of L holds c <= a"/\"b implies c <= a;

theorem 
  for L be antisymmetric transitive with_suprema with_infima RelStr for
  a,b,c being Element of L holds a"/\"b <= a"\/"c;

theorem 
  for L be antisymmetric transitive with_infima RelStr for a,b,c be
  Element of L holds a <= b implies a"/\"c <= b"/\"c;

theorem 
  for L be antisymmetric transitive with_suprema RelStr for a,b,c
  be Element of L holds a <= b implies a"\/"c <= b"\/"c;

theorem 
  for L be sup-Semilattice for a,b be Element of L holds a <= b
  implies a "\/" b = b;

theorem 
  for L be sup-Semilattice for a,b,c being Element of L holds a <=
  c & b <= c implies a"\/"b <= c;

theorem 
  for L be Semilattice for a,b be Element of L holds b <= a implies a"/\"b = b;



begin

theorem 
  for L being Boolean LATTICE, x,y being Element of L holds y
  is_a_complement_of x iff y = 'not' x;

definition
  let L be non empty RelStr, a,b be Element of L;
  func a \ b -> Element of L equals

  a "/\" 'not' b;
end;

definition
  let L be non empty RelStr, a, b be Element of L;
  func a \+\ b -> Element of L equals

  (a \ b) "\/" (b \ a);
end;

definition
  let L be antisymmetric with_infima with_suprema RelStr, a, b be Element of L;
  redefine func a \+\ b;
  commutativity;
end;

definition
  let L be non empty RelStr, a, b be Element of L;
  pred a meets b means


  a "/\" b <> Bottom L;
end;

notation
  let L be non empty RelStr, a, b be Element of L;
  antonym a misses b for a meets b;
end;

notation
  let L be with_infima antisymmetric RelStr, a, b be Element of L;
  antonym a misses b for a meets b;
end;

definition
  let L be with_infima antisymmetric RelStr, a, b be Element of L;
  redefine pred a meets b;
  symmetry;
end;

theorem 
  for L be antisymmetric transitive with_infima with_suprema RelStr for
  a,b,c be Element of L holds a <= c implies a \ b <= c;

theorem 
  for L be antisymmetric transitive with_infima with_suprema RelStr for
  a,b,c be Element of L holds a <= b implies a \ c <= b \ c;

theorem 
  for L be LATTICE for a,b,c be Element of L holds a \ b <= c & b \ a <=
  c implies a \+\ b <= c;

theorem 
  for L be LATTICE for a be Element of L holds a meets a iff a <> Bottom L;

theorem 
  for L be antisymmetric transitive with_infima RelStr st L is
  distributive for a,b,c be Element of L holds (a "/\" b) "\/" (a "/\" c) = a
  implies a <= b "\/" c;

theorem 
  for L be LATTICE st L is distributive for a,b,c be Element of L
  holds a"\/"(b"/\"c) = (a"\/"b) "/\" (a"\/"c);

theorem 
  for L be LATTICE st L is distributive for a,b,c be Element of L holds
  (a "\/" b) \ c = (a \ c) "\/" (b \ c);



begin

theorem 
  for L be lower-bounded non empty antisymmetric RelStr for a be
  Element of L holds a <= Bottom L implies a = Bottom L;

theorem 
  for L be lower-bounded Semilattice for a,b,c be Element of L holds a
  <= b & a <= c & b"/\"c = Bottom L implies a = Bottom L;

theorem 
  for L be lower-bounded antisymmetric with_suprema RelStr for a,b be
  Element of L holds a"\/"b = Bottom L implies a = Bottom L & b = Bottom L;

theorem 
  for L be lower-bounded antisymmetric transitive with_infima RelStr for
a,b,c be Element of L holds a <= b & b"/\"c = Bottom L implies a"/\"c = Bottom
  L;

theorem 
  for L be lower-bounded Semilattice for a be Element of L holds Bottom
  L \ a = Bottom L;

theorem 
  for L be lower-bounded antisymmetric transitive with_infima RelStr for
  a,b,c be Element of L holds a meets b & b <= c implies a meets c;

theorem 
  for L be lower-bounded with_infima antisymmetric RelStr for a be
  Element of L holds a"/\"Bottom L = Bottom L;

theorem 
  for L be lower-bounded antisymmetric transitive with_infima
  with_suprema RelStr for a,b,c be Element of L holds a meets b"/\"c implies a
  meets b;

theorem 
  for L be lower-bounded antisymmetric transitive with_infima
with_suprema RelStr for a,b,c be Element of L holds a meets b\c implies a meets
  b;

theorem 
  for L be lower-bounded antisymmetric transitive with_infima RelStr for
  a be Element of L holds a misses Bottom L;

theorem 
  for L be lower-bounded antisymmetric transitive with_infima RelStr for
  a,b,c be Element of L holds a misses c & b <= c implies a misses b;

theorem 
  for L be lower-bounded antisymmetric transitive with_infima RelStr for
  a,b,c be Element of L holds a misses b or a misses c implies a misses b"/\"c;

theorem 
  for L be lower-bounded LATTICE for a,b,c be Element of L holds a <= b
  & a <= c & b misses c implies a = Bottom L;

theorem 
  for L be lower-bounded antisymmetric transitive with_infima RelStr for
  a,b,c be Element of L holds a misses b implies (a"/\"c) misses (b"/\"c);



begin

reserve L for Boolean non empty RelStr;
reserve a,b,c,d for Element of L;

theorem 
  (a"/\"b) "\/" (b"/\"c) "\/" (c"/\"a) = (a"\/"b) "/\" (b"\/"c) "/\" (c
  "\/" a );

theorem 
  a"/\"'not' a = Bottom L & a"\/"'not' a = Top L;

theorem 
  a \ b <= c implies a <= b"\/"c;

theorem 
  'not' (a"\/"b) = 'not' a"/\" 'not' b & 'not' (a"/\"b) = 'not' a "\/" 'not' b;

theorem 
  a <= b implies 'not' b <= 'not' a;

theorem 
  a <= b implies c\b <= c\a;

theorem 
  a <= b & c <= d implies a\d <= b\c;

theorem 
  a <= b"\/"c implies a\b <= c & a\c <= b;

theorem 
  'not' a <= 'not' (a"/\"b) & 'not' b <= 'not' (a"/\"b);

theorem 
  'not' (a"\/"b) <= 'not' a & 'not' (a"\/"b) <= 'not' b;

theorem 
  a <= b\a implies a = Bottom L;

theorem 
  a <= b implies b = a "\/" (b\a);

theorem 
  a\b = Bottom L iff a <= b;

theorem 
  a <= b"\/"c & a"/\"c = Bottom L implies a <= b;

theorem 
  a"\/"b = (a\b)"\/"b;

theorem 
  a\(a"\/"b) = Bottom L;

theorem 
  a\a"/\"b = a\b;

theorem 
  (a\b)"/\"b = Bottom L;

theorem 
  a"\/"(b\a) = a"\/"b;

theorem 
  (a"/\"b)"\/"(a\b) = a;

theorem 
  a\(b\c)= (a\b)"\/"(a"/\"c);

theorem 
  a\(a\b) = a"/\"b;

theorem 
  (a"\/"b)\b = a\b;

theorem 
  a"/\"b = Bottom L iff a\b = a;

theorem 
  a\(b"\/"c) = (a\b)"/\"(a\c);

theorem 
  a\(b"/\"c) = (a\b)"\/"(a\c);

theorem 
  a"/\"(b\c) = a"/\"b \ a"/\"c;

theorem 
  (a"\/"b)\(a"/\"b) = (a\b)"\/"(b\a);

theorem 
  (a\b)\c = a\(b"\/"c);

theorem 
  'not' (Bottom L) = Top L;

theorem 
  'not' (Top L) = Bottom L;

theorem 
  a\a = Bottom L;

theorem 
  a \ Bottom L = a;

theorem 
  'not' (a\b) = 'not' a"\/"b;

theorem 
  a"/\"b misses a\b;

theorem 
  (a\b) misses b;

theorem 
  a misses b implies (a"\/"b)\b = a;














begin

notation
  let L be RelStr;
  synonym L opp for L~;
end;

theorem 
  for L being RelStr, x,y being Element of L opp holds x <= y iff ~ x >= ~y;

theorem 
  for L being RelStr, x being Element of L, y being Element of L
  opp holds (x <= ~y iff x~ >= y) & (x >= ~y iff x~ <= y);

theorem 
  for L being RelStr holds L is empty iff L opp is empty;

theorem 
  for L being RelStr holds L is reflexive iff L opp is reflexive;

theorem 
  for L being RelStr holds L is antisymmetric iff L opp is antisymmetric;

theorem 
  for L being RelStr holds L is transitive iff L opp is transitive;

theorem 
  for L being non empty RelStr holds L is connected iff L opp is connected;

registration
  let L be reflexive RelStr;
  cluster L opp -> reflexive;
end;

registration
  let L be transitive RelStr;
  cluster L opp -> transitive;
end;

registration
  let L be antisymmetric RelStr;
  cluster L opp -> antisymmetric;
end;

registration
  let L be connected non empty RelStr;
  cluster L opp -> connected;
end;

theorem 
  for L being RelStr, x being Element of L, X being set holds (x
  is_<=_than X iff x~ is_>=_than X) & (x is_>=_than X iff x~ is_<=_than X);

theorem 
  for L being RelStr, x being Element of L opp, X being set holds (
  x is_<=_than X iff ~x is_>=_than X) & (x is_>=_than X iff ~x is_<=_than X);

theorem 
  for L being RelStr, X being set holds ex_sup_of X,L iff ex_inf_of X,L opp;

theorem 
  for L being RelStr, X being set holds ex_sup_of X,L opp iff ex_inf_of X,L;

theorem 
  for L being non empty RelStr, X being set st ex_sup_of X,L or
  ex_inf_of X,L opp holds "\/"(X,L) = "/\"(X,L opp);

theorem 
  for L being non empty RelStr, X being set st ex_inf_of X,L or
  ex_sup_of X,L opp holds "/\"(X,L) = "\/"(X,L opp);

theorem 
  for L1,L2 being RelStr st the RelStr of L1 = the RelStr of L2 &
  L1 is with_infima holds L2 is with_infima;

theorem 
  for L1,L2 being RelStr st the RelStr of L1 = the RelStr of L2 & L1 is
  with_suprema holds L2 is with_suprema;

theorem 
  for L being RelStr holds L is with_infima iff L opp is with_suprema;




theorem 
  for L being non empty RelStr holds L is complete iff L opp is complete;

registration
  let L be with_infima RelStr;
  cluster L opp -> with_suprema;
end;

registration
  let L be with_suprema RelStr;
  cluster L opp -> with_infima;
end;

registration
  let L be complete non empty RelStr;
  cluster L opp -> complete;
end;

theorem 
  for L being non empty RelStr for X being Subset of L, Y being Subset
  of L opp st X = Y holds fininfs X = finsups Y & finsups X = fininfs Y;

theorem 
  for L being RelStr for X being Subset of L, Y being Subset of L
  opp st X = Y holds downarrow X = uparrow Y & uparrow X = downarrow Y;

theorem 
  for L being non empty RelStr for x being Element of L, y being Element
  of L opp st x = y holds downarrow x = uparrow y & uparrow x = downarrow y;

theorem 
  for L being with_infima Poset, x,y being Element of L holds x
  "/\"y = (x~)"\/"(y~);

theorem 
  for L being with_infima Poset, x,y being Element of L opp holds
  (~x)"/\"(~y) = x"\/"y;

theorem 
  for L being with_suprema Poset, x,y being Element of L holds x
  "\/"y = (x~)"/\"(y~);

theorem 
  for L being with_suprema Poset, x,y being Element of L opp holds
  (~x)"\/"(~y) = x"/\"y;

theorem 
  for L being LATTICE holds L is distributive iff L opp is distributive;

registration
  let L be distributive LATTICE;
  cluster L opp -> distributive;
end;

theorem 
  for L being RelStr, x be set holds x is directed Subset of L iff
  x is filtered Subset of L opp;

theorem 
  for L being RelStr, x be set holds x is directed Subset of L opp iff x
  is filtered Subset of L;

theorem 
  for L being RelStr, x be set holds x is lower Subset of L iff x
  is upper Subset of L opp;

theorem 
  for L being RelStr, x be set holds x is lower Subset of L opp iff x is
  upper Subset of L;

theorem 
  for L being RelStr holds L is lower-bounded iff L opp is upper-bounded;

theorem 
  for L being RelStr holds L opp is lower-bounded iff L is upper-bounded;

theorem 
  for L being RelStr holds L is bounded iff L opp is bounded;

theorem 
  for L being lower-bounded antisymmetric non empty RelStr holds (Bottom
  L)~ = Top (L opp) & ~Top (L opp) = Bottom L;

theorem 
  for L being upper-bounded antisymmetric non empty RelStr holds (Top L)
  ~ = Bottom (L opp) & ~Bottom (L opp) = Top L;

theorem 
  for L being bounded LATTICE, x,y being Element of L holds y
  is_a_complement_of x iff y~ is_a_complement_of x~;

theorem 
  for L being bounded LATTICE holds L is complemented iff L opp is complemented
;

registration
  let L be lower-bounded RelStr;
  cluster L opp -> upper-bounded;
end;

registration
  let L be upper-bounded RelStr;
  cluster L opp -> lower-bounded;
end;

registration
  let L be complemented bounded LATTICE;
  cluster L opp -> complemented;
end;



theorem 
  for L being Boolean LATTICE, x being Element of L holds 'not'(x~) = 'not' x;

definition
  let L be non empty RelStr;
  func ComplMap L -> Function of L, L opp means


  for x being Element of L holds it.x = 'not' x;
end;

registration
  let L be Boolean LATTICE;
  cluster ComplMap L -> one-to-one;
end;

registration
  let L be Boolean LATTICE;
  cluster ComplMap L -> isomorphic;
end;

theorem 
  for L being Boolean LATTICE holds L, L opp are_isomorphic;

theorem 
  for S,T being non empty RelStr, f be set holds (f is Function of S,T
iff f is Function of S opp,T) & (f is Function of S,T iff f is Function of S,T
  opp) & (f is Function of S,T iff f is Function of S opp,T opp);

theorem 
  for S,T being non empty RelStr for f being Function of S,T, g being
  Function of S,T opp st f = g holds (f is monotone iff g is antitone) & (f is
  antitone iff g is monotone);

theorem 
  for S,T being non empty RelStr for f being Function of S,T opp, g
being Function of S opp,T st f = g holds (f is monotone iff g is monotone) & (f
  is antitone iff g is antitone);

theorem 
  for S,T being non empty RelStr for f being Function of S,T, g
being Function of S opp,T opp st f = g holds (f is monotone iff g is monotone)
  & (f is antitone iff g is antitone);

theorem 
  for S,T being non empty RelStr, f be set holds (f is Connection of S,T
iff f is Connection of S~,T) & (f is Connection of S,T iff f is Connection of S
  ,T~) & (f is Connection of S,T iff f is Connection of S~,T~);

theorem 
  for S,T being non empty Poset for f1 being Function of S,T, g1 being
  Function of T,S for f2 being Function of S~,T~, g2 being Function of T~,S~ st
  f1 = f2 & g1 = g2 holds [f1,g1] is Galois iff [g2,f2] is Galois;

theorem 
  for J being set, D being non empty set, K being ManySortedSet of
  J for F being DoubleIndexedSet of K,D holds doms F = K;

definition
  let J, D be non empty set, K be non-empty ManySortedSet of J;
  let F be DoubleIndexedSet of K, D;
  let j be Element of J;
  let k be Element of K.j;
  redefine func F..(j,k) -> Element of D;
end;

theorem 
  for L being non empty RelStr for J being set, K being ManySortedSet of
J for x being set holds x is DoubleIndexedSet of K,L iff x is DoubleIndexedSet
  of K,L opp;

theorem 
  for L being complete LATTICE for J being non empty set, K being
non-empty ManySortedSet of J for F being DoubleIndexedSet of K,L holds Sup Infs
  F <= Inf Sups Frege F;

theorem 
  for L being complete LATTICE holds L is completely-distributive
iff for J being non empty set, K being non-empty ManySortedSet of J for F being
  DoubleIndexedSet of K,L holds Sup Infs F = Inf Sups Frege F;

theorem 
  for L being complete antisymmetric non empty RelStr, F be
  Function holds \\/(F, L) = //\(F, L opp) & //\(F, L) = \\/(F, L opp);

theorem 
  for L being complete antisymmetric non empty RelStr for F be
Function-yielding Function holds \//(F, L) = /\\(F, L opp) & /\\(F, L) = \//(F,
  L opp);

registration
  cluster completely-distributive -> complete for non empty RelStr;
end;

registration
  cluster completely-distributive strict for 1-element Poset;
end;

theorem 
  for L being non empty Poset holds L is completely-distributive iff L
  opp is completely-distributive;














begin

reserve U1,U2,U3 for Universal_Algebra,
  n,m for Element of NAT,
  o1 for operation of U1,
  o2 for operation of U2,
  o3 for operation of U3,
  x,y for set;

theorem 
  for B be non empty Subset of U1 st B = the carrier of U1 holds
  Opers(U1,B) = the charact of(U1);

reserve a for FinSequence of U1,
  f for Function of U1,U2;

theorem 
  f*(<*>the carrier of U1) = <*>the carrier of U2;

theorem 
  (id the carrier of U1)*a = a;

theorem 
  for h1 be Function of U1,U2, h2 be Function of U2,U3,a be
  FinSequence of U1 holds h2*(h1*a) = (h2 * h1)*a;

definition
  let U1,U2,f;
  pred f is_homomorphism U1,U2 means


  U1,U2 are_similar & for n st n in
dom the charact of(U1) for o1,o2 st o1=(the charact of U1).n & o2=(the charact
  of U2).n for x be FinSequence of U1 st x in dom o1 holds f.(o1.x) = o2.(f*x);
end;

definition
  let U1,U2,f;
  pred f is_monomorphism U1,U2 means


  f is_homomorphism U1,U2 & f is one-to-one;
  pred f is_epimorphism U1,U2 means


  f is_homomorphism U1,U2 & rng f = the carrier of U2;
end;

definition
  let U1,U2,f;
  pred f is_isomorphism U1,U2 means


  f is_monomorphism U1,U2 & f is_epimorphism U1,U2;
end;

definition
  let U1,U2;
  pred U1,U2 are_isomorphic means


  ex f st f is_isomorphism U1,U2;
end;

theorem 
  id the carrier of U1 is_homomorphism U1,U1;

theorem 
  for h1 be Function of U1,U2, h2 be Function of U2,U3 st h1
is_homomorphism U1,U2 & h2 is_homomorphism U2,U3 holds h2 * h1 is_homomorphism
  U1,U3;

theorem 
  f is_isomorphism U1,U2 iff f is_homomorphism U1,U2 & rng f = the
  carrier of U2 & f is one-to-one;

theorem 
  f is_isomorphism U1,U2 implies dom f = the carrier of U1 & rng f
  = the carrier of U2;

theorem 
  for h be Function of U1,U2, h1 be Function of U2,U1 st h
  is_isomorphism U1,U2 & h1=h" holds h1 is_homomorphism U2,U1;

theorem 
  for h be Function of U1,U2, h1 be Function of U2,U1 st h
  is_isomorphism U1,U2 & h1 = h" holds h1 is_isomorphism U2,U1;

theorem 
  for h be Function of U1,U2, h1 be Function of U2,U3 st h
is_isomorphism U1,U2 & h1 is_isomorphism U2,U3 holds h1 * h is_isomorphism U1,
  U3;

theorem 
  U1,U1 are_isomorphic;

theorem 
  U1,U2 are_isomorphic implies U2,U1 are_isomorphic;

theorem 
  U1,U2 are_isomorphic & U2,U3 are_isomorphic implies U1,U3 are_isomorphic;

definition
  let U1,U2,f;
  assume
 f is_homomorphism U1,U2;
  func Image f -> strict SubAlgebra of U2 means


  the carrier of it = f .: (the carrier of U1);
end;

theorem 
  for h be Function of U1,U2 st h is_homomorphism U1,U2 holds rng h =
  the carrier of Image h;

theorem 
  for U2 being strict Universal_Algebra, f be Function of U1,U2 st f
  is_homomorphism U1,U2 holds f is_epimorphism U1,U2 iff Image f = U2;

begin





definition
  let U1 be 1-sorted;
  mode Relation of U1 is Relation of the carrier of U1;
  mode Equivalence_Relation of U1 is Equivalence_Relation of the carrier of U1;
end;

definition
  let U1;
  mode Congruence of U1 -> Equivalence_Relation of U1 means


    for n,o1
    st n in dom the charact of(U1) & o1 = (the charact of U1).n for x,y be
FinSequence of U1 st x in dom o1 & y in dom o1 & [x,y] in ExtendRel(it) holds [
    o1.x,o1.y] in it;
end;

reserve E for Congruence of U1;

definition

  let U1 be Universal_Algebra, E be Congruence of U1, o be operation of U1;
  func QuotOp(o,E) -> homogeneous quasi_total non empty PartFunc of (Class E)*
  ,(Class E) means


  dom it = (arity o)-tuples_on (Class E) & for y be
FinSequence of (Class E) st y in dom it for x be FinSequence of the carrier of
  U1 st x is_representatives_FS y holds it.y = Class(E,o.x);
end;

definition
  let U1,E;
  func QuotOpSeq(U1,E) -> PFuncFinSequence of Class E means


  len it =
len the charact of(U1) & for n st n in dom it for o1 st (the charact of(U1)).n
  = o1 holds it.n = QuotOp(o1,E);
end;

definition
  let U1,E;
  func QuotUnivAlg(U1,E) -> strict Universal_Algebra equals

  UAStr (# Class(E),QuotOpSeq(U1,E) #);
end;

definition
  let U1,E;
  func Nat_Hom(U1,E) -> Function of U1,QuotUnivAlg(U1,E) means


  for u be Element of U1 holds it.u = Class(E,u);
end;

theorem 
  for U1,E holds Nat_Hom(U1,E) is_homomorphism U1,QuotUnivAlg(U1,E);

theorem 
  for U1,E holds Nat_Hom(U1,E) is_epimorphism U1,QuotUnivAlg(U1,E);

definition
  let U1,U2;
  let f be Function of U1,U2;
  assume
 f is_homomorphism U1,U2;
  func Cng(f) -> Congruence of U1 means


  for a,b be Element of U1 holds [a,b] in it iff f.a = f.b;
end;

definition
  let U1,U2 be Universal_Algebra, f be Function of U1,U2;
  assume
 f is_homomorphism U1,U2;
  func HomQuot(f) -> Function of QuotUnivAlg(U1,Cng(f)),U2 means


  for a be Element of U1 holds it.(Class(Cng f,a)) = f.a;
end;

theorem 
  f is_homomorphism U1,U2 implies HomQuot(f) is_homomorphism
QuotUnivAlg(U1,Cng(f)),U2 & HomQuot(f) is_monomorphism QuotUnivAlg(U1,Cng(f)),
  U2;


theorem 
  f is_epimorphism U1,U2 implies HomQuot(f) is_isomorphism
  QuotUnivAlg(U1,Cng(f)),U2;

theorem 
  f is_epimorphism U1,U2 implies QuotUnivAlg(U1,Cng(f)),U2 are_isomorphic;














begin 

definition
  let L be non empty reflexive RelStr;

  func L-waybelow -> Relation of L means


  for x,y being Element of L holds [x,y] in it iff x << y;
end;

definition
  let L be RelStr;
  func IntRel L -> Relation of L equals

  the InternalRel of L;
end;

definition
  let L be RelStr, R be Relation of L;
  attr R is auxiliary(i) means


  for x, y being Element of L holds [x,y] in R implies x <= y;
  attr R is auxiliary(ii) means


  for x, y, z, u being Element of L holds
  ( u <= x & [x,y] in R & y <= z implies [u,z] in R );
end;

definition
  let L be non empty RelStr, R be Relation of L;
  attr R is auxiliary(iii) means


  for x, y, z being Element of L holds
  ( [x,z] in R & [y,z] in R implies [(x "\/" y),z] in R );
  attr R is auxiliary(iv) means


  for x being Element of L holds [Bottom L,x] in R;
end;



definition
  let L be non empty RelStr, R be Relation of L;
  attr R is auxiliary means


  R is auxiliary(i) auxiliary(ii) auxiliary(iii) auxiliary(iv);
end;

registration
  let L be non empty RelStr;
  cluster auxiliary ->
    auxiliary(i) auxiliary(ii) auxiliary(iii) auxiliary(iv) for Relation of L;
  cluster auxiliary(i) auxiliary(ii) auxiliary(iii) auxiliary(iv) ->
    auxiliary for Relation of L;
end;

registration
  let L be lower-bounded with_suprema transitive antisymmetric RelStr;
  cluster auxiliary for Relation of L;
end;

theorem 
  for L being lower-bounded sup-Semilattice
  for AR being auxiliary(ii) auxiliary(iii) Relation of L
  for x, y, z, u being Element of L holds
  [x, z] in AR & [y, u] in AR implies [x "\/" y, z "\/" u] in AR;

registration
  let L be lower-bounded sup-Semilattice;
  cluster auxiliary(i) auxiliary(ii) -> transitive for Relation of L;
end;

registration
  let L be RelStr;
  cluster IntRel L -> auxiliary(i);
end;

registration
  let L be transitive RelStr;
  cluster IntRel L -> auxiliary(ii);
end;

registration
  let L be with_suprema antisymmetric RelStr;
  cluster IntRel L -> auxiliary(iii);
end;

registration
  let L be lower-bounded antisymmetric non empty RelStr;
  cluster IntRel L -> auxiliary(iv);
end;

reserve a for set;

definition
  let L be lower-bounded sup-Semilattice;
  func Aux L means


  a in it iff a is auxiliary Relation of L;
end;

registration
  let L be lower-bounded sup-Semilattice;
  cluster Aux L -> non empty;
end;

theorem 
  for L being lower-bounded sup-Semilattice
  for AR being auxiliary(i) Relation of L holds AR c= IntRel L;

theorem 
  for L being lower-bounded sup-Semilattice holds
  Top InclPoset Aux L = IntRel L;

registration
  let L be lower-bounded sup-Semilattice;
  cluster InclPoset Aux L -> upper-bounded;
end;

definition
  let L be non empty RelStr;
  func AuxBottom L -> Relation of L means


  for x,y be Element of L holds [x,y] in it iff x = Bottom L;
end;

registration
  let L be lower-bounded sup-Semilattice;
  cluster AuxBottom L -> auxiliary;
end;

theorem 
  for L being lower-bounded sup-Semilattice
  for AR being auxiliary(iv) Relation of L holds AuxBottom L c= AR;

theorem 
  for L being lower-bounded sup-Semilattice holds
  Bottom InclPoset Aux L = AuxBottom L;

registration
  let L be lower-bounded sup-Semilattice;
  cluster InclPoset Aux L -> lower-bounded;
end;

theorem 
  for L being lower-bounded sup-Semilattice
  for a,b being auxiliary(i) Relation of L holds
  a /\ b is auxiliary(i) Relation of L;

theorem 
  for L being lower-bounded sup-Semilattice
  for a,b being auxiliary(ii) Relation of L holds
  a /\ b is auxiliary(ii) Relation of L;

theorem 
  for L being lower-bounded sup-Semilattice
  for a,b being auxiliary(iii) Relation of L holds
  a /\ b is auxiliary(iii) Relation of L;

theorem 
  for L being lower-bounded sup-Semilattice
  for a,b being auxiliary(iv) Relation of L holds
  a /\ b is auxiliary(iv) Relation of L;

theorem 
  for L being lower-bounded sup-Semilattice
  for a,b being auxiliary Relation of L holds
  a /\ b is auxiliary Relation of L;

theorem 
  for L being lower-bounded sup-Semilattice
  for X being non empty Subset of InclPoset Aux L holds
  meet X is auxiliary Relation of L;

registration
  let L be lower-bounded sup-Semilattice;
  cluster InclPoset Aux L -> with_infima;
end;

registration
  let L be lower-bounded sup-Semilattice;
  cluster InclPoset Aux L -> complete;
end;

definition
  let L be non empty RelStr, x be Element of L;
  let AR be Relation of the carrier of L;
  func AR-below x -> Subset of L equals

  {y where y is Element of L: [y,x] in AR};
  func AR-above x -> Subset of L equals

  {y where y is Element of L: [x,y] in AR};
end;

theorem 
  for L being lower-bounded sup-Semilattice, x being Element of L
  for AR being auxiliary(i) Relation of L holds AR-below x c= downarrow x;

registration
  let L be lower-bounded sup-Semilattice, x be Element of L;
  let AR be auxiliary(iv) Relation of L;
  cluster AR-below x -> non empty;
end;

registration
  let L be lower-bounded sup-Semilattice, x be Element of L;
  let AR be auxiliary(ii) Relation of L;
  cluster AR-below x -> lower;
end;

registration
  let L be lower-bounded sup-Semilattice, x be Element of L;
  let AR be auxiliary(iii) Relation of L;
  cluster AR-below x -> directed;
end;

definition
  let L be lower-bounded sup-Semilattice;
  let AR be auxiliary(ii) auxiliary(iii) auxiliary(iv) Relation of L;
  func AR-below -> Function of L, InclPoset Ids L means


  for x be Element of L holds it.x = AR-below x;
end;

theorem 
  for L being non empty RelStr, AR being Relation of L
  for a being set, y being Element of L holds a in AR-below y iff [a,y] in AR;

theorem 
  for L being sup-Semilattice, AR being Relation of L
  for y being Element of L holds a in AR-above y iff [y,a] in AR;

theorem 
  for L being lower-bounded sup-Semilattice,
  AR being auxiliary(i) Relation of L for x being Element of L holds
  AR = the InternalRel of L implies AR-below x = downarrow x;

definition
  let L be non empty Poset;
  func MonSet L -> strict RelStr means


  ( a in the carrier of it iff
  ex s be Function of L, InclPoset Ids L st a = s & s is monotone &
  for x be Element of L holds s.x c= downarrow x ) &
  for c, d be set holds [c,d] in the InternalRel of it iff
  ex f,g be Function of L, InclPoset Ids L st c = f & d = g &
  c in the carrier of it & d in the carrier of it & f <= g;
end;

theorem 
  for L being lower-bounded sup-Semilattice holds
  MonSet L is full SubRelStr of (InclPoset Ids L)|^(the carrier of L);

theorem 
  for L being lower-bounded sup-Semilattice,
  AR being auxiliary(ii) Relation of L for x, y being Element of L holds
  x <= y implies AR-below x c= AR-below y;

registration
  let L be lower-bounded sup-Semilattice;
  let AR be auxiliary(ii) auxiliary(iii) auxiliary(iv) Relation of L;
  cluster AR-below -> monotone;
end;

theorem 
  for L being lower-bounded sup-Semilattice, AR being auxiliary Relation of L
  holds AR-below in the carrier of MonSet L;

registration
  let L be lower-bounded sup-Semilattice;
  cluster MonSet L -> non empty;
end;

theorem 
  for L being lower-bounded sup-Semilattice holds
  IdsMap L in the carrier of MonSet L;

theorem 
  for L being lower-bounded sup-Semilattice, AR being auxiliary Relation of L
  holds AR-below <= IdsMap L;

theorem 
  for L being lower-bounded non empty Poset
  for I being Ideal of L holds Bottom L in I;

theorem 
  for L being upper-bounded non empty Poset
  for F being Filter of L holds Top L in F;

theorem 
  for L being lower-bounded non empty Poset holds
  downarrow Bottom L = {Bottom L};

theorem 
  for L being upper-bounded non empty Poset holds uparrow Top L = {Top L};

reserve L for lower-bounded sup-Semilattice;
reserve x for Element of L;

theorem 
  (the carrier of L) --> {Bottom L} is Function of L, InclPoset Ids L;

theorem 
  (the carrier of L) --> {Bottom L} in the carrier of MonSet L;

theorem 
  for AR being auxiliary Relation of L holds
  [(the carrier of L) --> {Bottom L} , AR-below] in the InternalRel of MonSet L
;

registration
  let L;
  cluster MonSet L -> upper-bounded;
end;

definition
  let L;
  func Rel2Map L -> Function of InclPoset Aux L, MonSet L means


  for AR being auxiliary Relation of L holds it.AR = AR-below;
end;

theorem 
  for R1, R2 being auxiliary Relation of L st R1 c= R2 holds
  R1-below <= R2-below;

theorem 
  for R1, R2 being Relation of L st R1 c= R2 holds R1-below x c= R2-below x;

registration
  let L;
  cluster Rel2Map L -> monotone;
end;

definition
  let L;
  func Map2Rel L -> Function of MonSet L, InclPoset Aux L means


  for s be set st s in the carrier of MonSet L
  ex AR be auxiliary Relation of L st AR = it.s & for x,y be set holds
  [x,y] in AR iff ex x9,y9 be Element of L,
  s9 be Function of L, InclPoset Ids L st
  x9 = x & y9 = y & s9 = s & x9 in s9.y9;
end;

registration
  let L;
  cluster Map2Rel L -> monotone;
end;

theorem 
  (Map2Rel L) * (Rel2Map L) = id dom (Rel2Map L);

theorem 
  (Rel2Map L) * (Map2Rel L) = id (the carrier of MonSet L);

registration
  let L;
  cluster Rel2Map L -> one-to-one;
end;



theorem 
  (Rel2Map L)" = Map2Rel L;



theorem 
  Rel2Map L is isomorphic;

theorem 
  for L being complete LATTICE, x being Element of L holds
  meet { I where I is Ideal of L : x <= sup I } = waybelow x;

definition
  let L be Semilattice, I be Ideal of L;
  func DownMap I -> Function of L, InclPoset Ids L means


  for x be Element of L holds
  ( x <= sup I implies it.x = ( downarrow x ) /\ I ) &
  ( not x <= sup I implies it.x = downarrow x );
end;

theorem 
  for L being Semilattice, I being Ideal of L holds
  DownMap I in the carrier of MonSet L;

theorem 
  for L being with_infima antisymmetric reflexive RelStr, x being Element of L
  for D being non empty lower Subset of L holds
  {x} "/\" D = (downarrow x) /\ D;

begin  


definition
  let L be non empty RelStr, AR be Relation of L;
  attr AR is approximating means


  for x be Element of L holds x = sup (AR-below x);
end;

definition
  let L be non empty Poset;
  let mp be Function of L, InclPoset Ids L;
  attr mp is approximating means


  for x be Element of L ex ii be Subset of L st ii = mp.x & x = sup ii;
end;



theorem 
  for L being lower-bounded meet-continuous Semilattice, I being Ideal of L
  holds DownMap I is approximating;



theorem 
  for L being lower-bounded continuous LATTICE holds L is meet-continuous;

registration
  cluster continuous -> meet-continuous for lower-bounded LATTICE;
end;



theorem 
  for L being lower-bounded continuous LATTICE,
  I being Ideal of L holds DownMap I is approximating;

registration
  let L be non empty reflexive antisymmetric RelStr;
  cluster L-waybelow -> auxiliary(i);
end;

registration
  let L be non empty reflexive transitive RelStr;
  cluster L-waybelow -> auxiliary(ii);
end;

registration
  let L be with_suprema Poset;
  cluster L-waybelow -> auxiliary(iii);
end;

registration
  let L be /\-complete non empty Poset;
  cluster L-waybelow -> auxiliary(iii);
end;

registration
  let L be lower-bounded antisymmetric reflexive non empty RelStr;
  cluster L-waybelow -> auxiliary(iv);
end;

theorem 
  for L being complete LATTICE, x being Element of L holds
  (L-waybelow)-below x = waybelow x;

theorem 
  for L being LATTICE holds IntRel L is approximating;

registration
  let L be lower-bounded continuous LATTICE;
  cluster L-waybelow -> approximating;
end;

registration
  let L be complete LATTICE;
  cluster approximating auxiliary for Relation of L;
end;

definition
  let L be complete LATTICE;
  func App L means


  a in it iff a is approximating auxiliary Relation of L;
end;

registration
  let L be complete LATTICE;
  cluster App L -> non empty;
end;

theorem 
  for L being complete LATTICE for mp being Function of L, InclPoset Ids L st
  mp is approximating & mp in the carrier of MonSet L
  ex AR being approximating auxiliary Relation of L st AR = (Map2Rel L).mp;

theorem 
  for L being complete LATTICE, x being Element of L holds
  meet { (DownMap I).x where I is Ideal of L : not contradiction} = waybelow x;



theorem 
  for L being lower-bounded meet-continuous LATTICE, x being Element of L holds
  meet {AR-below x where AR is auxiliary Relation of L : AR in App L}
  = waybelow x;

reserve L for complete LATTICE;



theorem 
  L is continuous iff for R being approximating auxiliary Relation of L holds
  L-waybelow c= R & L-waybelow is approximating;



theorem 
  L is continuous iff (L is meet-continuous &
  ex R being approximating auxiliary Relation of L st
  for R9 being approximating auxiliary Relation of L holds R c= R9);



definition
  let L be RelStr, AR be Relation of L;
  attr AR is satisfying_SI means


  for x, z be Element of L holds ( [x,z] in AR & x <> z implies
  ex y be Element of L st [x,y] in AR & [y,z] in AR & x <> y );
end;



definition
  let L be RelStr, AR be Relation of L;
  attr AR is satisfying_INT means


  for x, z be Element of L holds ( [x,z] in AR implies
  ex y be Element of L st [x,y] in AR & [y,z] in AR );
end;

theorem 
  for L being RelStr, AR being Relation of L
  holds AR is satisfying_SI implies AR is satisfying_INT;

registration
  let L be non empty RelStr;
  cluster satisfying_SI -> satisfying_INT for Relation of L;
end;

reserve AR for Relation of L;
reserve x, y, z for Element of L;

theorem 
  for AR being approximating Relation of L st
  not x <= y holds ex u being Element of L st [u,x] in AR & not u <= y;



theorem 
  for R being approximating auxiliary(i) auxiliary(iii) Relation of L holds
  [x,z] in R & x <> z implies ex y st x <= y & [y,z] in R & x <> y;



theorem 
  for R being approximating auxiliary Relation of L holds
  x << z & x <> z implies
  ex y being Element of L st [x,y] in R & [y,z] in R & x <> y;



theorem 
  for L being lower-bounded continuous LATTICE
  holds L-waybelow is satisfying_SI;

registration
  let L be lower-bounded continuous LATTICE;
  cluster L-waybelow -> satisfying_SI;
end;

theorem 
  for L being lower-bounded continuous LATTICE,
  x,y being Element of L st x << y
  ex x9 being Element of L st x << x9 & x9 << y;



theorem 
  for L being lower-bounded continuous LATTICE holds
  for x,y being Element of L holds ( x << y iff
  for D being non empty directed Subset of L st y <= sup D
  ex d being Element of L st d in D & x << d );

begin 

definition
  let L be RelStr, X be Subset of L, R be Relation of the carrier of L;
  pred X is_directed_wrt R means


  for x,y being Element of L st x in X & y in X
  ex z being Element of L st z in X & [x,z] in R & [y,z] in R;
end;

theorem 
  for L being RelStr, X being Subset of L st
  X is_directed_wrt (the InternalRel of L) holds X is directed;

definition
  let X, x be set;
  let R be Relation;
  pred x is_maximal_wrt X,R means


  x in X & not ex y being set st y in X & y <> x & [x,y] in R;
end;

definition
  let L be RelStr, X be set, x be Element of L;
  pred x is_maximal_in X means


  x is_maximal_wrt X, the InternalRel of L;
end;

theorem 
  for L being RelStr, X being set, x being Element of L holds
  x is_maximal_in X iff x in X & not ex y being Element of L st y in X & x < y;

definition
  let X, x be set;
  let R be Relation;
  pred x is_minimal_wrt X,R means


  x in X & not ex y being set st y in X & y <> x & [y,x] in R;
end;

definition
  let L be RelStr, X be set, x be Element of L;
  pred x is_minimal_in X means


  x is_minimal_wrt X, the InternalRel of L;
end;

theorem 
  for L being RelStr, X being set, x being Element of L holds
  x is_minimal_in X iff x in X & not ex y being Element of L st y in X & x > y;



theorem 
  AR is satisfying_SI implies
  for x holds ( ex y st y is_maximal_wrt (AR-below x), AR )
  implies [x,x] in AR;



theorem 
  ( for x holds ( ex y st y is_maximal_wrt (AR-below x), AR )
  implies [x,x] in AR ) implies AR is satisfying_SI;



theorem 
  for AR being auxiliary(ii) auxiliary(iii) Relation of L holds
  AR is satisfying_INT implies for x holds AR-below x is_directed_wrt AR;



theorem 
  ( for x holds AR-below x is_directed_wrt AR) implies AR is satisfying_INT;



theorem 
  for R being approximating auxiliary(i) auxiliary(ii) auxiliary(iii)
  Relation of L st R is satisfying_INT holds R is satisfying_SI;

registration
  let L;
  cluster satisfying_INT ->
    satisfying_SI for approximating auxiliary Relation of L;
end;














begin

reserve x,y,Y,Z for set,
  L for LATTICE,
  l for Element of L;



scheme 

  NonUniqExD1 { Z() ->non empty RelStr, X() -> Subset of Z(), Y() -> non empty
Subset of Z(), P[set,set] }: ex f being Function of X(),Y() st for e be Element
  of Z() st e in X() ex u be Element of Z() st u in Y() & u = f.e & P[e,u]
provided
 for e be Element of Z() st e in X() ex u be Element of Z() st u in Y
() & P[e,u];

definition
  let L be LATTICE;
  let A be non empty Subset of L;
  let f be Function of A,A;
  let n be Element of NAT;
  redefine func iter (f,n) -> Function of A,A;
end;

definition
  let L be LATTICE;
  let C,D be non empty Subset of L;
  let f be Function of C,D;
  let c be Element of C;
  redefine func f.c -> Element of L;
end;

registration
  let L be non empty Poset;
  cluster -> filtered directed for Chain of L;
end;

registration
  cluster strict continuous distributive lower-bounded for LATTICE;
end;

theorem 
  for S,T being Semilattice, f being Function of S,T holds f is
meet-preserving iff for x,y being Element of S holds f.(x "/\" y) = f. x "/\" f
  .y;

theorem 
  for S,T being sup-Semilattice, f being Function of S,T holds f is
join-preserving iff for x,y being Element of S holds f.(x "\/" y) = f. x "\/" f
  .y;

theorem 
  for S,T being LATTICE, f being Function of S,T st T is
  distributive & f is meet-preserving join-preserving one-to-one holds S is
  distributive;

registration
  let S,T be complete LATTICE;
  cluster sups-preserving for Function of S,T;
end;

theorem 
  for S,T being complete LATTICE, f being sups-preserving Function
  of S,T st T is meet-continuous & f is meet-preserving one-to-one holds S is
  meet-continuous;

begin 

definition
  let L be non empty reflexive RelStr, X be Subset of L;
  attr X is Open means


  for x be Element of L st x in X ex y be Element of L st y in X & y << x;
end;

theorem 
  for L be up-complete LATTICE, X be upper Subset of L holds X is Open
  iff for x be Element of L st x in X holds waybelow x meets X;

theorem 
  for L be up-complete LATTICE, X be upper Subset of L holds X is Open
  iff X = union {wayabove x where x is Element of L : x in X};

registration
  let L be up-complete lower-bounded LATTICE;
  cluster Open for Filter of L;
end;

theorem 
  for L be lower-bounded continuous LATTICE, x be Element of L holds (
  wayabove x) is Open;

theorem 
  for L be lower-bounded continuous LATTICE, x,y be Element of L st
  x << y holds ex F be Open Filter of L st y in F & F c= wayabove x;

theorem 
  for L being complete LATTICE, X being Open upper Subset of L
holds for x being Element of L st x in (X`) ex m being Element of L st x <= m &
  m is_maximal_in (X`);

begin 

definition 
  let G be non empty RelStr, g be Element of G;
  attr g is meet-irreducible means


  for x,y being Element of G st g = x "/\" y holds x = g or y = g;
end;

notation 
  let G be non empty RelStr, g be Element of G;
  synonym g is irreducible for g is meet-irreducible;
end;

definition
  let G be non empty RelStr, g be Element of G;
  attr g is join-irreducible means

  for x,y being Element of G st g = x "\/" y holds x = g or y = g;
end;

definition
  let L be non empty RelStr;
  func IRR L -> Subset of L means


  for x be Element of L holds x in it iff x is irreducible;
end;

theorem 
  for L being upper-bounded antisymmetric with_infima non empty
  RelStr holds Top L is irreducible;

registration
  let L be upper-bounded antisymmetric with_infima non empty RelStr;
  cluster irreducible for Element of L;
end;

theorem 
  for L being Semilattice, x being Element of L holds x is irreducible
  iff for A being finite non empty Subset of L st x = inf A holds x in A;

theorem 
  for L be LATTICE,l be Element of L st (uparrow l \ {l}) is Filter of L
  holds l is irreducible;

theorem 
  for L be LATTICE, p be Element of L, F be Filter of L st p
  is_maximal_in (F`) holds p is irreducible;

theorem 
  for L be lower-bounded continuous LATTICE, x,y be Element of L
  st not y <= x holds ex p be Element of L st p is irreducible & x <= p & not y
  <= p;

begin 

definition
  let L be non empty RelStr, X be Subset of L;
  attr X is order-generating means


  for x be Element of L holds
  ex_inf_of (uparrow x) /\ X,L & x = inf ((uparrow x) /\ X);
end;

theorem 
  for L be up-complete lower-bounded LATTICE, X be Subset of L
holds X is order-generating iff for l being Element of L ex Y be Subset of X st
  l = "/\" (Y,L);

theorem 
  for L be up-complete lower-bounded LATTICE, X be Subset of L holds X
  is order-generating iff for Y be Subset of L st X c= Y & for Z be Subset of Y
  holds "/\" (Z,L) in Y holds the carrier of L = Y;

theorem 
  for L be up-complete lower-bounded LATTICE, X be Subset of L
holds X is order-generating iff for l1,l2 be Element of L st not l2 <= l1 ex p
  be Element of L st p in X & l1 <= p & not l2 <= p;

theorem 
  for L be lower-bounded continuous LATTICE, X be Subset of L st X
  = IRR L \ { Top L} holds X is order-generating;

theorem 
  for L being lower-bounded continuous LATTICE, X,Y being Subset
  of L st X is order-generating & X c= Y holds Y is order-generating;

begin 

definition
  let L be non empty RelStr;
  let l be Element of L;
  attr l is prime means


  for x,y be Element of L st x "/\" y <= l holds x <= l or y <= l;
end;

definition
  let L be non empty RelStr;
  func PRIME L -> Subset of L means


  for x be Element of L holds x in it iff x is prime;
end;

definition
  let L be non empty RelStr;
  let l be Element of L;
  attr l is co-prime means


  l~ is prime;
end;

theorem 
  for L being upper-bounded antisymmetric non empty RelStr holds Top L is prime
;

theorem 
  for L being lower-bounded antisymmetric non empty RelStr holds Bottom
  L is co-prime;

registration
  let L be upper-bounded antisymmetric non empty RelStr;
  cluster prime for Element of L;
end;

theorem 
  for L being Semilattice, l being Element of L holds l is prime
  iff for A being finite non empty Subset of L st l >= inf A ex a being Element
  of L st a in A & l >= a;

theorem 
  for L being sup-Semilattice, x being Element of L holds x is
co-prime iff for A being finite non empty Subset of L st x <= sup A ex a being
  Element of L st a in A & x <= a;

theorem 
  for L being LATTICE, l being Element of L st l is prime holds l
  is irreducible;

theorem 
  for l holds l is prime iff for x being set, f being Function of
  L,BoolePoset {x} st (for p be Element of L holds f.p = {} iff p <= l) holds f
  is meet-preserving join-preserving;

theorem 
  for L being upper-bounded LATTICE, l being Element of L st l <>
  Top L holds l is prime iff (downarrow l)` is Filter of L;

theorem 
  for L being distributive LATTICE for l being Element of L holds
  l is prime iff l is irreducible;

theorem 
  for L being distributive LATTICE holds PRIME L = IRR L;

theorem 
  for L being Boolean LATTICE for l being Element of L st l <> Top L
  holds l is prime iff for x be Element of L st x > l holds x = Top L;

theorem 
  for L being continuous distributive lower-bounded LATTICE for l being
Element of L st l <> Top L holds l is prime iff ex F being Open Filter of L st
  l is_maximal_in (F`);

theorem 
  for L being RelStr, X being Subset of L holds chi(X, the carrier
  of L) is Function of L, BoolePoset {{}};

theorem 
  for L being non empty RelStr, p,x being Element of L holds chi((
  downarrow p)`,the carrier of L).x = {} iff x <= p;

theorem 
  for L being upper-bounded LATTICE, f being Function of L,
  BoolePoset {{}}, p being prime Element of L st chi((downarrow p)`,the carrier
  of L) = f holds f is meet-preserving join-preserving;

theorem 
  for L being complete LATTICE st PRIME L is order-generating
  holds L is distributive meet-continuous;

theorem 
  for L being lower-bounded continuous LATTICE holds L is
  distributive iff PRIME L is order-generating;

theorem 
  for L being lower-bounded continuous LATTICE holds L is distributive
  iff L is Heyting;

theorem 
  for L being continuous complete LATTICE st for l being Element
  of L ex X being Subset of L st l = sup X & for x being Element of L st x in X
  holds x is co-prime for l being Element of L holds l = "\/"((waybelow l) /\
  PRIME(L opp), L);

theorem 
  for L being complete LATTICE holds L is completely-distributive iff L
is continuous & for l being Element of L ex X being Subset of L st l = sup X &
  for x being Element of L st x in X holds x is co-prime;

theorem 
  for L being complete LATTICE holds L is completely-distributive iff L
  is distributive continuous & L opp is continuous;














begin

theorem 
  for L being complete LATTICE, X,Y being set st X c= Y holds "\/"(
  X,L) <= "\/"(Y,L) & "/\"(X,L) >= "/\"(Y,L);

theorem 
  for X being set holds the carrier of BoolePoset X = bool X;

theorem 
  for L being bounded antisymmetric non empty RelStr holds L is
  trivial iff Top L = Bottom L;

registration
  let X be set;
  cluster BoolePoset X -> Boolean;
end;

registration
  let X be non empty set;
  cluster BoolePoset X -> non trivial;
end;

theorem 
  for L being lower-bounded non empty Poset, F being Filter of L
  holds F is proper iff not Bottom L in F;

registration
  cluster non trivial Boolean strict for LATTICE;
end;

registration
  let L be upper-bounded non trivial Poset;
  cluster proper for Filter of L;
end;

theorem 
  for X being set, a being Element of BoolePoset X holds 'not' a = X \ a;

theorem 
  for X being set, Y being Subset of BoolePoset X holds Y is lower iff
  for x,y being set st x c= y & y in Y holds x in Y;

theorem 
  for X being set, Y being Subset of BoolePoset X holds Y is upper
  iff for x,y being set st x c= y & y c= X & x in Y holds y in Y;

theorem 
  for X being set, Y being lower Subset of BoolePoset X holds Y is
  directed iff for x,y being set st x in Y & y in Y holds x \/ y in Y;

theorem 
  for X being set, Y being upper Subset of BoolePoset X holds Y is
  filtered iff for x,y being set st x in Y & y in Y holds x /\ y in Y;

theorem 
  for X being set, Y being non empty lower Subset of BoolePoset X holds
Y is directed iff for Z being finite Subset-Family of X st Z c= Y holds union Z
  in Y;

theorem 
  for X being set, Y being non empty upper Subset of BoolePoset X
  holds Y is filtered iff for Z being finite Subset-Family of X st Z c= Y holds
  Intersect Z in Y;

begin 

definition
  let L be with_infima Poset;
  let I be Ideal of L;
  attr I is prime means


  for x,y being Element of L st x"/\"y in I holds x in I or y in I;
end;

theorem 
  for L being with_infima Poset, I being Ideal of L holds I is
  prime iff for A being finite non empty Subset of L st inf A in I ex a being
  Element of L st a in A & a in I;

registration
  let L be LATTICE;
  cluster prime for Ideal of L;
end;

theorem 
  for L1, L2 being LATTICE st the RelStr of L1 = the RelStr of L2 for x
  being set st x is prime Ideal of L1 holds x is prime Ideal of L2;

definition
  let L be with_suprema Poset;
  let F be Filter of L;
  attr F is prime means


  for x,y being Element of L st x"\/"y in F holds x in F or y in F;
end;

theorem 
  for L being with_suprema Poset, F being Filter of L holds F is prime
  iff for A being finite non empty Subset of L st sup A in F ex a being Element
  of L st a in A & a in F;

registration
  let L be LATTICE;
  cluster prime for Filter of L;
end;

theorem 
  for L1, L2 being LATTICE st the RelStr of L1 = the RelStr of L2
  for x being set st x is prime Filter of L1 holds x is prime Filter of L2;

theorem 
  for L being LATTICE, x being set holds x is prime Ideal of L iff
  x is prime Filter of L opp;

theorem 
  for L being LATTICE, x being set holds x is prime Filter of L
  iff x is prime Ideal of L opp;



theorem 
  for L being with_infima Poset, I being Ideal of L holds I is prime iff
  I` is Filter of L or I` = {};



theorem 
  for L being LATTICE, I being Ideal of L holds I is prime iff I in
  PRIME InclPoset Ids L;

theorem 
  for L being Boolean LATTICE, F being Filter of L holds F is
  prime iff for a being Element of L holds a in F or 'not' a in F;



theorem 
  for X being set, F being Filter of BoolePoset X holds F is prime
  iff for A being Subset of X holds A in F or X\A in F;

definition
  let L be non empty Poset;
  let F be Filter of L;
  attr F is ultra means


  F is proper & for G being Filter of L st F c=
  G holds F = G or G = the carrier of L;
end;

registration
  let L be non empty Poset;
  cluster ultra -> proper for Filter of L;
end;



theorem 
  for L being Boolean LATTICE, F being Filter of L holds F is
  proper prime iff F is ultra;



theorem 
  for L being distributive LATTICE, I being Ideal of L, F being
  Filter of L st I misses F ex P being Ideal of L st P is prime & I c= P & P
  misses F;

theorem 
  for L being distributive LATTICE, I being Ideal of L, x being
Element of L st not x in I ex P being Ideal of L st P is prime & I c= P & not x
  in P;

theorem 
  for L being distributive LATTICE, I being Ideal of L, F being
  Filter of L st I misses F ex P being Filter of L st P is prime & F c= P & I
  misses P;

theorem 
  for L being non trivial Boolean LATTICE, F being proper Filter
  of L ex G being Filter of L st F c= G & G is ultra;

begin 

definition
  let T be TopSpace;
  let F,x be set;
  pred x is_a_cluster_point_of F,T means


  for A being Subset of T st A
  is open & x in A for B being set st B in F holds A meets B;
  pred x is_a_convergence_point_of F,T means


  for A being Subset of T st A is open & x in A holds A in F;
end;

registration
  let X be non empty set;
  cluster ultra for Filter of BoolePoset X;
end;

theorem 
  for T being non empty TopSpace for F being ultra Filter of
  BoolePoset the carrier of T for p being set holds p is_a_cluster_point_of F,T
  iff p is_a_convergence_point_of F,T;



theorem 
  for T being non empty TopSpace for x,y being Element of
  InclPoset the topology of T st x << y for F being proper Filter of BoolePoset
  the carrier of T st x in F ex p being Element of T st p in y & p
  is_a_cluster_point_of F,T;



theorem 
  for T being non empty TopSpace for x,y being Element of InclPoset the
topology of T st x << y for F being ultra Filter of BoolePoset the carrier of T
  st x in F ex p being Element of T st p in y & p is_a_convergence_point_of F,T
;



theorem 
  for T being non empty TopSpace for x,y being Element of
InclPoset the topology of T st x c= y & for F being ultra Filter of BoolePoset
  the carrier of T st x in F ex p being Element of T st p in y & p
  is_a_convergence_point_of F,T holds x << y;




theorem 
  for T being non empty TopSpace for B being prebasis of T for x,y being
  Element of InclPoset the topology of T st x c= y holds x << y iff for F being
  Subset of B st y c= union F ex G being finite Subset of F st x c= union G;



theorem 
  for L being distributive complete LATTICE for x,y being Element of L
  holds x << y iff for P being prime Ideal of L st y <= sup P holds x in P;

theorem 
  for L being LATTICE, p being Element of L st p is prime holds
  downarrow p is prime;

begin 

definition
  let L be LATTICE;
  let p be Element of L;
  attr p is pseudoprime means


  ex P being prime Ideal of L st p = sup P;
end;

theorem 
  for L being LATTICE for p being Element of L st p is prime holds
  p is pseudoprime;



theorem 
  for L being continuous LATTICE for p being Element of L st p is
  pseudoprime for A being finite non empty Subset of L st inf A << p ex a being
  Element of L st a in A & a <= p;



theorem 
  for L being continuous LATTICE for p being Element of L st (p <> Top L
or Top L is not compact) & for A being finite non empty Subset of L st inf A <<
p ex a being Element of L st a in A & a <= p holds uparrow fininfs (downarrow p
  )` misses waybelow p;



theorem 
  for L being continuous LATTICE st Top L is compact holds (for A being
finite non empty Subset of L st inf A << Top L ex a being Element of L st a in
  A & a <= Top L) & uparrow fininfs (downarrow Top L)` meets waybelow Top L;



theorem 
  for L being continuous LATTICE for p being Element of L st uparrow
fininfs (downarrow p)` misses waybelow p for A being finite non empty Subset of
  L st inf A << p ex a being Element of L st a in A & a <= p;



theorem 
  for L being distributive continuous LATTICE for p being Element of L
  st uparrow fininfs (downarrow p)` misses waybelow p holds p is pseudoprime;

definition
  let L be non empty RelStr;
  let R be Relation of the carrier of L;
  attr R is multiplicative means


  for a,x,y being Element of L st [a,x]
  in R & [a,y] in R holds [a,x"/\" y] in R;
end;

registration
  let L be lower-bounded sup-Semilattice;
  let R be auxiliary Relation of L;
  let x be Element of L;
  cluster R-above x -> upper;
end;



theorem 
  for L being lower-bounded LATTICE, R being auxiliary Relation of L
  holds R is multiplicative iff for x being Element of L holds R-above x is
  filtered;



theorem 
  for L being lower-bounded LATTICE, R being auxiliary Relation of
L holds R is multiplicative iff for a,b,x,y being Element of L st [a,x] in R &
  [b,y] in R holds [a"/\"b,x"/\"y] in R;



theorem 
  for L being lower-bounded LATTICE, R being auxiliary Relation of L
  holds R is multiplicative iff for S being full SubRelStr of [:L,L:] st the
  carrier of S = R holds S is meet-inheriting;



theorem 
  for L being lower-bounded LATTICE, R being auxiliary Relation of L
  holds R is multiplicative iff R-below is meet-preserving;

theorem 
  for L being continuous lower-bounded LATTICE st L-waybelow is
  multiplicative for p being Element of L holds p is pseudoprime iff for a,b
  being Element of L st a"/\"b << p holds a <= p or b <= p;

theorem 
  for L being continuous lower-bounded LATTICE st L-waybelow is
  multiplicative for p being Element of L st p is pseudoprime holds p is prime;

theorem 
  for L being distributive continuous lower-bounded LATTICE st for p
  being Element of L st p is pseudoprime holds p is prime holds L-waybelow is
  multiplicative;














begin 

definition 
  let L be non empty reflexive RelStr;
  func CompactSublatt L -> strict full SubRelStr of L means


  for x be Element of L holds x in the carrier of it iff x is compact;
end;

registration
  let L be lower-bounded non empty reflexive antisymmetric RelStr;
  cluster CompactSublatt L -> non empty;
end;

theorem 
  for L be complete LATTICE for x,y,k be Element of L holds x <= k & k
  <= y & k in the carrier of CompactSublatt L implies x << y;

theorem 
  for L be complete LATTICE for x be Element of L holds uparrow x is
  Open Filter of L iff x is compact;

theorem 
  for L be lower-bounded with_suprema non empty Poset holds
CompactSublatt L is join-inheriting & Bottom L in the carrier of CompactSublatt
  L;

definition
  let L be non empty reflexive RelStr;
  let x be Element of L;
  func compactbelow x -> Subset of L equals

  {y where y is Element of L: x >= y
  & y is compact};
end;

theorem 
  for L be non empty reflexive RelStr for x,y be Element of L holds
  y in compactbelow x iff x >= y & y is compact;

theorem 
  for L be non empty reflexive RelStr for x be Element of L holds
  compactbelow x = downarrow x /\ the carrier of CompactSublatt L;

theorem 
  for L be non empty reflexive transitive RelStr for x be Element
  of L holds compactbelow x c= waybelow x;

registration
  let L be non empty lower-bounded reflexive antisymmetric RelStr;
  let x be Element of L;
  cluster compactbelow x -> non empty;
end;

begin 

definition
  let L be non empty reflexive RelStr;
  attr L is satisfying_axiom_K means


  for x be Element of L holds x = sup compactbelow x;
end;

definition 
  let L be non empty reflexive RelStr;
  attr L is algebraic means


  (for x being Element of L holds
  compactbelow x is non empty directed) & L is up-complete satisfying_axiom_K;
end;

theorem 
  for L be LATTICE holds L is algebraic iff ( L is continuous & for
  x,y be Element of L st x << y ex k be Element of L st k in the carrier of
  CompactSublatt L & x <= k & k <= y );

registration
  cluster algebraic -> continuous for LATTICE;
end;

registration
  cluster algebraic -> up-complete satisfying_axiom_K for non empty reflexive
    RelStr;
end;

registration
  let L be non empty with_suprema Poset;
  cluster CompactSublatt L -> join-inheriting;
end;

definition
  let L be non empty reflexive RelStr;
  attr L is arithmetic means


  L is algebraic & CompactSublatt L is meet-inheriting;
end;

begin 

registration
  cluster arithmetic -> algebraic for LATTICE;
end;

registration
  cluster trivial -> arithmetic for LATTICE;
end;

registration
  cluster 1-element strict for LATTICE;
end;

theorem 
  for L1,L2 be non empty reflexive antisymmetric RelStr st the
RelStr of L1 = the RelStr of L2 & L1 is up-complete for x1,y1 be Element of L1
  for x2,y2 be Element of L2 st x1 = x2 & y1 = y2 & x1 << y1 holds x2 << y2;

theorem 
  for L1,L2 be non empty reflexive antisymmetric RelStr st the
RelStr of L1 = the RelStr of L2 & L1 is up-complete for x be Element of L1 for
  y be Element of L2 st x = y & x is compact holds y is compact;

theorem 
  for L1,L2 be up-complete non empty reflexive antisymmetric
RelStr st the RelStr of L1 = the RelStr of L2 for x be Element of L1 for y be
  Element of L2 st x = y holds compactbelow x = compactbelow y;

theorem 
  for L1,L2 be RelStr st the RelStr of L1 = the RelStr of L2 & L1 is non
  empty holds L2 is non empty;

theorem 
  for L1,L2 be RelStr st the RelStr of L1 = the RelStr of L2 & L1
  is reflexive holds L2 is reflexive;

theorem 
  for L1,L2 be RelStr st the RelStr of L1 = the RelStr of L2 & L1
  is transitive holds L2 is transitive;

theorem 
  for L1,L2 be RelStr st the RelStr of L1 = the RelStr of L2 & L1
  is antisymmetric holds L2 is antisymmetric;

theorem 
  for L1,L2 be non empty reflexive RelStr st the RelStr of L1 =
  the RelStr of L2 & L1 is up-complete holds L2 is up-complete;

theorem 
  for L1,L2 be up-complete non empty reflexive antisymmetric
RelStr st the RelStr of L1 = the RelStr of L2 & L1 is satisfying_axiom_K & for
  x be Element of L1 holds compactbelow x is non empty directed holds L2 is
  satisfying_axiom_K;

theorem 
  for L1,L2 be non empty reflexive antisymmetric RelStr st the
  RelStr of L1 = the RelStr of L2 & L1 is algebraic holds L2 is algebraic;

theorem 
  for L1,L2 be LATTICE st the RelStr of L1 = the RelStr of L2 & L1
  is arithmetic holds L2 is arithmetic;

registration
  let L be non empty RelStr;
  cluster the RelStr of L -> non empty;
end;

registration
  let L be non empty reflexive RelStr;
  cluster the RelStr of L -> reflexive;
end;

registration
  let L be transitive RelStr;
  cluster the RelStr of L -> transitive;
end;

registration
  let L be antisymmetric RelStr;
  cluster the RelStr of L -> antisymmetric;
end;

registration
  let L be with_infima RelStr;
  cluster the RelStr of L -> with_infima;
end;

registration
  let L be with_suprema RelStr;
  cluster the RelStr of L -> with_suprema;
end;

registration
  let L be up-complete non empty reflexive RelStr;
  cluster the RelStr of L -> up-complete;
end;

registration
  let L be algebraic non empty reflexive antisymmetric RelStr;
  cluster the RelStr of L -> algebraic;
end;

registration
  let L be arithmetic LATTICE;
  cluster the RelStr of L -> arithmetic;
end;

theorem 
  for L be algebraic LATTICE holds L is arithmetic iff CompactSublatt L
  is LATTICE;

theorem 
  for L be algebraic lower-bounded LATTICE holds L is arithmetic
  iff L-waybelow is multiplicative;

theorem 
  for L be arithmetic lower-bounded LATTICE, p be Element of L holds p
  is pseudoprime implies p is prime;

theorem 
  for L be algebraic distributive lower-bounded LATTICE st for p being
  Element of L st p is pseudoprime holds p is prime holds L is arithmetic;

registration
  let L be algebraic LATTICE;
  let c be closure Function of L,L;
  cluster non empty directed for Subset of Image c;
end;

theorem 
  for L be algebraic LATTICE for c be closure Function of L,L st c
is directed-sups-preserving holds c.:([#]CompactSublatt L) c= [#]CompactSublatt
  Image c;

theorem 
  for L be algebraic lower-bounded LATTICE for c be closure Function of
  L,L st c is directed-sups-preserving holds Image c is algebraic LATTICE;

theorem 
  for L be algebraic lower-bounded LATTICE, c be closure Function of L,L
  st c is directed-sups-preserving holds c.:([#]CompactSublatt L) = [#]
  CompactSublatt Image c;

begin 

theorem 
  for X,x be set holds x is Element of BoolePoset X iff x c= X;

theorem 
  for X be set for x,y be Element of BoolePoset X holds x << y iff
for Y be Subset-Family of X st y c= union Y ex Z be finite Subset of Y st x c=
  union Z;

theorem 
  for X be set for x be Element of BoolePoset X holds x is finite
  iff x is compact;

theorem 
  for X be set for x be Element of BoolePoset X holds compactbelow
  x = {y where y is finite Subset of x : not contradiction};

theorem 
  for X be set for F be Subset of X holds F in the carrier of
  CompactSublatt BoolePoset X iff F is finite;

registration
  let X be set;
  let x be Element of BoolePoset X;
  cluster compactbelow x -> lower directed;
end;

theorem 
  for X be set holds BoolePoset X is algebraic;

registration
  let X be set;
  cluster BoolePoset X -> algebraic;
end;














begin 








registration
  let L be non empty RelStr;
  cluster id L -> monotone;
end;

definition
  let S, T be non empty RelStr, f be Function of S,T;
  redefine attr f is antitone means


  for x, y being Element of S st x <= y holds f.x >= f.y;
end;

theorem 
  for S, T being RelStr, K, L being non empty RelStr for f being
Function of S, T, g being Function of K, L st the RelStr of S = the RelStr of K
& the RelStr of T = the RelStr of L & f = g & f is monotone holds g is monotone
;

theorem 
  for S, T being RelStr, K, L being non empty RelStr for f being
Function of S, T, g being Function of K, L st the RelStr of S = the RelStr of K
& the RelStr of T = the RelStr of L & f = g & f is antitone holds g is antitone
;

theorem 
  for A, B being 1-sorted for F being Subset-Family of A, G being
Subset-Family of B st the carrier of A = the carrier of B & F = G & F is Cover
  of A holds G is Cover of B;

theorem 
  for L being antisymmetric reflexive with_suprema RelStr, x being
  Element of L holds uparrow x = {x} "\/" [#]L;

theorem 
  for L being antisymmetric reflexive with_infima RelStr, x being
  Element of L holds downarrow x = {x} "/\" [#]L;

theorem 
  for L being antisymmetric reflexive with_infima RelStr, y being
  Element of L holds (y"/\").:(uparrow y) = {y};

theorem 
  for L being antisymmetric reflexive with_infima RelStr, x being
  Element of L holds (x"/\")"{x} = uparrow x;

theorem 
  for T being non empty 1-sorted, N being non empty NetStr over T
  holds N is_eventually_in rng the mapping of N;

registration
  let L be non empty reflexive RelStr, D be non empty directed Subset of L, n
  be Function of D, the carrier of L;
  cluster NetStr (#D,(the InternalRel of L)|_2 D,n#) -> directed;
end;

registration
  let L be non empty reflexive transitive RelStr, D be non empty directed
  Subset of L, n be Function of D, the carrier of L;
  cluster NetStr (#D,(the InternalRel of L)|_2 D,n#) -> transitive;
end;



theorem 
  for L being non empty reflexive transitive RelStr st for x being
Element of L, N being net of L st N is eventually-directed holds x "/\" sup N =
  sup ({x} "/\" rng netmap (N,L)) holds L is satisfying_MC;

theorem 
  for L being non empty RelStr, a being Element of L, N being net
  of L holds a "/\" N is net of L;

registration
  let L be non empty RelStr, x be Element of L, N be net of L;
  cluster x "/\" N -> transitive;
end;

registration
  let L be non empty RelStr, x be Element of L, N be non empty reflexive
  NetStr over L;
  cluster x "/\" N -> reflexive;
end;

registration
  let L be non empty RelStr, x be Element of L, N be non empty antisymmetric
  NetStr over L;
  cluster x "/\" N -> antisymmetric;
end;

registration
  let L be non empty RelStr, x be Element of L, N be non empty transitive
  NetStr over L;
  cluster x "/\" N -> transitive;
end;

registration
  let L be non empty RelStr, J be set, f be Function of J,the carrier of L;
  cluster FinSups f -> transitive;
end;

begin 

definition
  let L be non empty RelStr, N be NetStr over L;
  func inf N -> Element of L equals

  Inf the mapping of N;
end;

definition
  let L be RelStr, N be NetStr over L;
  pred ex_sup_of N means


  ex_sup_of rng the mapping of N,L;
  pred ex_inf_of N means


  ex_inf_of rng the mapping of N,L;
end;

definition
  let L be RelStr;
  func L+id -> strict NetStr over L means


  the RelStr of it = the RelStr of L & the mapping of it = id L;
end;

registration
  let L be non empty RelStr;
  cluster L+id -> non empty;
end;

registration
  let L be reflexive RelStr;
  cluster L+id -> reflexive;
end;

registration
  let L be antisymmetric RelStr;
  cluster L+id -> antisymmetric;
end;

registration
  let L be transitive RelStr;
  cluster L+id -> transitive;
end;

registration
  let L be with_suprema RelStr;
  cluster L+id -> directed;
end;

registration
  let L be directed RelStr;
  cluster L+id -> directed;
end;

registration
  let L be non empty RelStr;
  cluster L+id -> monotone eventually-directed;
end;

definition
  let L be RelStr;
  func L opp+id -> strict NetStr over L means


  the carrier of it = the
carrier of L & the InternalRel of it = (the InternalRel of L)~ & the mapping of
  it = id L;
end;

theorem 
  for L being RelStr holds the RelStr of L~ = the RelStr of L opp+id;

registration
  let L be non empty RelStr;
  cluster L opp+id -> non empty;
end;

registration
  let L be reflexive RelStr;
  cluster L opp+id -> reflexive;
end;

registration
  let L be antisymmetric RelStr;
  cluster L opp+id -> antisymmetric;
end;

registration
  let L be transitive RelStr;
  cluster L opp+id -> transitive;
end;

registration
  let L be with_infima RelStr;
  cluster L opp+id -> directed;
end;

registration
  let L be non empty RelStr;
  cluster L opp+id -> antitone eventually-filtered;
end;

definition
  let L be non empty 1-sorted, N be non empty NetStr over L, i be Element of N;
  func N|i -> strict NetStr over L means


  (for x being set holds x in
  the carrier of it iff ex y being Element of N st y = x & i <= y) & the
  InternalRel of it = (the InternalRel of N)|_2 the carrier of it & the mapping
  of it = (the mapping of N)|the carrier of it;
end;

theorem 
  for L being non empty 1-sorted, N being non empty NetStr over L for i
  being Element of N holds the carrier of N|i = { y where y is Element of N : i
  <= y };

theorem 
  for L being non empty 1-sorted, N being non empty NetStr over L
  for i being Element of N holds the carrier of N|i c= the carrier of N;

theorem 
  for L being non empty 1-sorted, N being non empty NetStr over L
  for i being Element of N holds N|i is full SubNetStr of N;

registration
  let L be non empty 1-sorted, N be non empty reflexive NetStr over L, i be
  Element of N;
  cluster N|i -> non empty reflexive;
end;

registration
  let L be non empty 1-sorted, N be non empty directed NetStr over L, i be
  Element of N;
  cluster N|i -> non empty;
end;

registration
  let L be non empty 1-sorted, N be non empty reflexive antisymmetric NetStr
  over L, i be Element of N;
  cluster N|i -> antisymmetric;
end;

registration
  let L be non empty 1-sorted, N be non empty directed antisymmetric NetStr
  over L, i be Element of N;
  cluster N|i -> antisymmetric;
end;

registration
  let L be non empty 1-sorted, N be non empty reflexive transitive NetStr over
  L, i be Element of N;
  cluster N|i -> transitive;
end;

registration
  let L be non empty 1-sorted, N be net of L, i be Element of N;
  cluster N|i -> transitive directed;
end;

theorem 
  for L being non empty 1-sorted, N being non empty reflexive NetStr
over L for i, x being Element of N, x1 being Element of N|i st x = x1 holds N.x
  = (N|i).x1;

theorem 
  for L being non empty 1-sorted, N being non empty directed
  NetStr over L for i, x being Element of N, x1 being Element of N|i st x = x1
  holds N.x = (N|i).x1;

theorem 
  for L being non empty 1-sorted, N being net of L, i being
  Element of N holds N|i is subnet of N;

registration
  let T be non empty 1-sorted, N be net of T;
  cluster strict for subnet of N;
end;

definition
  let L be non empty 1-sorted, N be net of L, i be Element of N;
  redefine func N|i -> strict subnet of N;
end;

definition
  let S be non empty 1-sorted, T be 1-sorted, f be Function of S, T, N be
  NetStr over S;
  func f * N -> strict NetStr over T means


  the RelStr of it = the
  RelStr of N & the mapping of it = f * the mapping of N;
end;

registration
  let S be non empty 1-sorted, T be 1-sorted, f be Function of S, T, N be non
  empty NetStr over S;
  cluster f * N -> non empty;
end;

registration
  let S be non empty 1-sorted, T be 1-sorted, f be Function of S, T, N be
  reflexive NetStr over S;
  cluster f * N -> reflexive;
end;

registration
  let S be non empty 1-sorted, T be 1-sorted, f be Function of S, T, N be
  antisymmetric NetStr over S;
  cluster f * N -> antisymmetric;
end;

registration
  let S be non empty 1-sorted, T be 1-sorted, f be Function of S, T, N be
  transitive NetStr over S;
  cluster f * N -> transitive;
end;

registration
  let S be non empty 1-sorted, T be 1-sorted, f be Function of S, T, N be
  directed NetStr over S;
  cluster f * N -> directed;
end;

theorem 
  for L being non empty RelStr, N being non empty NetStr over L
  for x being Element of L holds (x"/\")*N = x "/\" N;

begin 

theorem 
  for S, T being TopStruct for F being Subset-Family of S, G being
  Subset-Family of T st the TopStruct of S = the TopStruct of T & F = G & F is
  open holds G is open;

theorem 
  for S, T being TopStruct for F being Subset-Family of S, G being
  Subset-Family of T st the TopStruct of S = the TopStruct of T & F = G & F is
  closed holds G is closed;

definition
  struct(TopStruct,RelStr) TopRelStr (# carrier -> set, InternalRel -> (
    Relation of the carrier), topology -> Subset-Family of the carrier #);
end;

registration
  let A be non empty set, R be Relation of A,A, T be Subset-Family of A;
  cluster TopRelStr (#A,R,T#) -> non empty;
end;

registration
  let x be set, R be Relation of {x};
  let T be Subset-Family of {x};
  cluster TopRelStr (#{x}, R, T#) -> 1-element;
end;

registration
  let X be set, O be Order of X, T be Subset-Family of X;
  cluster TopRelStr (#X, O, T#) -> reflexive transitive antisymmetric;
end;

registration
  cluster reflexive discrete strict finite 1-element for TopRelStr;
end;

definition
  mode TopLattice is with_infima with_suprema reflexive transitive
    antisymmetric TopSpace-like TopRelStr;
end;

registration
  cluster strict discrete finite compact Hausdorff 1-element for TopLattice;
end;

registration
  let T be Hausdorff non empty TopSpace;
  cluster -> Hausdorff for non empty SubSpace of T;
end;

theorem 
  for T being non empty TopSpace, p being Point of T for A being
  Element of OpenNeighborhoods p holds A is a_neighborhood of p;

theorem 
  for T being non empty TopSpace, p being Point of T for A, B
  being Element of OpenNeighborhoods p holds A /\ B is Element of
  OpenNeighborhoods p;

theorem 
  for T being non empty TopSpace, p being Point of T for A, B being
  Element of OpenNeighborhoods p holds A \/ B is Element of OpenNeighborhoods p
;

theorem 
  for T being non empty TopSpace, p being Element of T for N being
  net of T st p in Lim N for S being Subset of T st S = rng the mapping of N
  holds p in Cl S;

theorem 
  for T being Hausdorff TopLattice, N being convergent net of T
for f being Function of T, T st f is continuous holds f.(lim N) in Lim (f * N);

theorem 
  for T being Hausdorff TopLattice, N being convergent net of T
  for x being Element of T st x"/\" is continuous holds x "/\" lim N in Lim (x
  "/\" N);

theorem 
  for S being Hausdorff TopLattice, x being Element of S st for a
  being Element of S holds a"/\" is continuous holds uparrow x is closed;

theorem 
  for S being compact Hausdorff TopLattice, x being Element of S
  st for b being Element of S holds b"/\" is continuous holds downarrow x is
  closed;

begin 

definition
  let T be non empty TopSpace, N be non empty NetStr over T, p be Point of T;
  pred p is_a_cluster_point_of N means


  for O being a_neighborhood of p holds N is_often_in O;
end;

theorem 
  for L being non empty TopSpace, N being net of L for c being Point of
  L st c in Lim N holds c is_a_cluster_point_of N;

theorem 
  for T being compact Hausdorff non empty TopSpace, N being net
  of T ex c being Point of T st c is_a_cluster_point_of N;

theorem 
  for L being non empty TopSpace, N being net of L, M being subnet
  of N for c being Point of L st c is_a_cluster_point_of M holds c
  is_a_cluster_point_of N;

theorem 
  for T being non empty TopSpace, N being net of T for x being
  Point of T st x is_a_cluster_point_of N holds ex M being subnet of N st x in
  Lim M;

theorem 
  for L being compact Hausdorff non empty TopSpace, N being net
  of L st for c, d being Point of L st c is_a_cluster_point_of N & d
  is_a_cluster_point_of N holds c = d holds for s being Point of L st s
  is_a_cluster_point_of N holds s in Lim N;

theorem 
  for S being non empty TopSpace, c being Point of S for N being
net of S, A being Subset of S st c is_a_cluster_point_of N & A is closed & rng
  the mapping of N c= A holds c in A;

theorem 
  for S being compact Hausdorff TopLattice, c being Point of S for
N being net of S st (for x being Element of S holds x"/\" is continuous) & N is
  eventually-directed & c is_a_cluster_point_of N holds c = sup N;

theorem 
  for S being compact Hausdorff TopLattice, c being Point of S for
N being net of S st (for x being Element of S holds x"/\" is continuous) & N is
  eventually-filtered & c is_a_cluster_point_of N holds c = inf N;

begin 


theorem 
  for S being Hausdorff TopLattice st (for N being net of S st N
  is eventually-directed holds ex_sup_of N & sup N in Lim N) & (for x being
  Element of S holds x"/\" is continuous) holds S is meet-continuous;



theorem 
  for S being compact Hausdorff TopLattice st for x being Element
  of S holds x"/\" is continuous holds for N being net of S st N is
  eventually-directed holds ex_sup_of N & sup N in Lim N;



theorem 
  for S being compact Hausdorff TopLattice st for x being Element
  of S holds x"/\" is continuous holds for N being net of S st N is
  eventually-filtered holds ex_inf_of N & inf N in Lim N;

theorem 
  for S being compact Hausdorff TopLattice st for x being Element of S
  holds x"/\" is continuous holds S is bounded;

theorem 
  for S being compact Hausdorff TopLattice st for x being Element of S
  holds x"/\" is continuous holds S is meet-continuous;














begin

scheme 
 Irrel{D,I() -> non empty set, P[set], F(set)->set, F(set,set)-> set}:
  { F(u) where u is Element of D(): P[u]}
  = { F(i,v) where i is Element of I(), v is Element of D(): P[v]}
provided
 for i being Element of I(), u being Element of D() holds F(u) = F(i,u);

theorem 
  for L being complete LATTICE, X,Y being Subset of L st Y is_coarser_than X
  holds "/\"(X,L) <= "/\"(Y,L);

theorem 
  for L being complete LATTICE, X,Y being Subset of L st X is_finer_than Y
  holds "\/"(X,L) <= "\/"(Y,L);

theorem 
  for T being RelStr, A being upper Subset of T, B being directed Subset of T
  holds A /\ B is directed;

registration
  let T be reflexive non empty RelStr;
  cluster non empty directed finite for Subset of T;
end;

theorem 
  for T being with_suprema Poset,
  D being non empty directed finite Subset of T holds sup D in D;

registration
  cluster reflexive transitive 1-element antisymmetric
    with_suprema with_infima finite strict for RelStr;
end;

registration
  let T be finite 1-sorted;
  cluster -> finite for Subset of T;
end;

registration
  let R be RelStr;
  cluster empty -> lower upper for Subset of R;
end;

registration
  let R be 1-element RelStr;
  cluster -> upper for Subset of R;
end;

theorem 
  for T being non empty RelStr, x being Element of T,
  A being upper Subset of T st not x in A holds A misses downarrow x;

theorem 
  for T being non empty RelStr, x being Element of T,
  A being lower Subset of T st x in A holds downarrow x c= A;

begin 

definition
  let T be non empty reflexive RelStr, S be Subset of T;
  attr S is inaccessible_by_directed_joins means


  for D being non empty directed Subset of T st sup D in S holds D meets S;
  attr S is closed_under_directed_sups means


  for D being non empty directed Subset of T st D c= S holds sup D in S;
  attr S is property(S) means


  for D being non empty directed Subset of T st sup D in S
  ex y being Element of T st y in D &
  for x being Element of T st x in D & x >= y holds x in S;
end;

notation
  let T be non empty reflexive RelStr, S be Subset of T;
  synonym S is inaccessible for S is inaccessible_by_directed_joins; synonym
  S is directly_closed for S is closed_under_directed_sups;
end;

registration
  let T be non empty reflexive RelStr;
  cluster empty -> property(S) directly_closed for Subset of T;
end;

registration
  let T be non empty reflexive RelStr;
  cluster property(S) directly_closed for Subset of T;
end;

registration
  let T be non empty reflexive RelStr, S be property(S) Subset of T;
  cluster S` -> directly_closed;
end;

definition
  let T be reflexive non empty TopRelStr;
  attr T is Scott means


  for S being Subset of T holds S is open iff S is inaccessible upper;
end;

registration
  let T be reflexive transitive antisymmetric non empty with_suprema
  finite RelStr;
  cluster -> inaccessible for Subset of T;
end;

definition
  let T be reflexive transitive antisymmetric non empty with_suprema
  finite TopRelStr;
  redefine attr T is Scott means

  for S being Subset of T holds S is open iff S is upper;
end;

registration
  cluster complete strict 1-element Scott for TopLattice;
end;

registration
  let T be non empty reflexive RelStr;
  cluster [#]T -> directly_closed inaccessible;
end;

registration
  let T be non empty reflexive RelStr;
  cluster directly_closed lower inaccessible upper for Subset of T;
end;

registration
  let T be non empty reflexive RelStr, S be inaccessible Subset of T;
  cluster S` -> directly_closed;
end;

registration
  let T be non empty reflexive RelStr, S be directly_closed Subset of T;
  cluster S` -> inaccessible;
end;

theorem 
  for T being up-complete Scott non empty reflexive transitive TopRelStr,
  S being Subset of T holds S is closed iff S is directly_closed lower;

theorem 
  for T being up-complete non empty reflexive transitive antisymmetric
  TopRelStr, x being Element of T holds downarrow x is directly_closed;

theorem 
  for T being complete Scott TopLattice, x being Element of T
  holds Cl {x} = downarrow x;

theorem 
  for T being complete Scott TopLattice holds T is T_0-TopSpace;

theorem 
  for T being Scott up-complete non empty reflexive transitive antisymmetric
  TopRelStr, x being Element of T holds downarrow x is closed;

theorem 
  for T being up-complete Scott TopLattice, x being Element of T
  holds (downarrow x)` is open;

theorem 
  for T being up-complete Scott TopLattice, x being Element of T,
  A being upper Subset of T st not x in A
  holds (downarrow x)` is a_neighborhood of A;

theorem 
  for T being complete Scott TopLattice, S being upper Subset of T
  ex F being Subset-Family of T st S = meet F &
  for X being Subset of T st X in F holds X is a_neighborhood of S;

theorem 
  for T being Scott TopLattice, S being Subset of T
  holds S is open iff S is upper property(S);

registration
  let T be complete TopLattice;


  cluster lower -> property(S) for Subset of T;
end;

theorem 
  for T being non empty transitive reflexive TopRelStr st
  the topology of T = { S where S is Subset of T: S is property(S)}
  holds T is TopSpace-like;

begin 

reserve R for non empty RelStr,
  N for net of R,
  i for Element of N;

definition
  let R,N;
  func lim_inf N -> Element of R equals

  "\/"({"/\"({N.i:i >= j},R) where j is Element of N: not contradiction},R);
end;

definition
  let R be reflexive non empty RelStr;
  let N be net of R, p be Element of R;
  pred p is_S-limit_of N means


  p <= lim_inf N;
end;

definition
  let R be reflexive non empty RelStr;
  func Scott-Convergence R -> Convergence-Class of R means


  for N being strict net of R st N in NetUniv R for p being Element of R
  holds [N,p] in it iff p is_S-limit_of N;
end;



theorem 
  for R being complete LATTICE, N being net of R, p,q being Element of R
  st p is_S-limit_of N & N is_eventually_in downarrow q holds p <= q;

theorem 
  for R being complete LATTICE, N being net of R, p,q being Element of R
  st N is_eventually_in uparrow q holds lim_inf N >= q;

definition
  let R be reflexive non empty RelStr, N be non empty NetStr over R;
  redefine attr N is monotone means


  for i,j being Element of N st i <= j holds N.i <= N.j;
end;

definition
  let R be non empty RelStr;
  let S be non empty set, f be Function of S, the carrier of R;
  func Net-Str(S,f) -> strict non empty NetStr over R means


  the carrier of it = S & the mapping of it = f &
  for i,j being Element of it holds i <= j iff it.i <= it.j;
end;

theorem 
  for L being non empty 1-sorted, N being non empty NetStr over L
  holds rng the mapping of N =
  { N.i where i is Element of N: not contradiction};

theorem 
  for R being non empty RelStr,
  S being non empty set, f be Function of S, the carrier of R
  st rng f is directed holds Net-Str(S,f) is directed;

registration
  let R be non empty RelStr;
  let S be non empty set, f be Function of S, the carrier of R;
  cluster Net-Str(S,f) -> monotone;
end;

registration
  let R be transitive non empty RelStr;
  let S be non empty set, f be Function of S, the carrier of R;
  cluster Net-Str(S,f) -> transitive;
end;

registration
  let R be reflexive non empty RelStr;
  let S be non empty set, f be Function of S, the carrier of R;
  cluster Net-Str(S,f) -> reflexive;
end;

theorem 
  for R being non empty transitive RelStr,
  S being non empty set, f be Function of S, the carrier of R
  st S c= the carrier of R & Net-Str(S,f) is directed
  holds Net-Str(S,f) in NetUniv R;

registration
  let R be LATTICE;
  cluster monotone reflexive strict for net of R;
end;

theorem 
  for R being complete LATTICE, N being monotone reflexive net of R
  holds lim_inf N = sup N;

theorem 
  for R being complete LATTICE, N being constant net of R
  holds the_value_of N = lim_inf N;

theorem 
  for R being complete LATTICE, N being constant net of R
  holds the_value_of N is_S-limit_of N;

definition
  let S be non empty 1-sorted, e be Element of S;
  func Net-Str e -> strict NetStr over S means


  the carrier of it = {e} & the InternalRel of it = {[e,e]} &
  the mapping of it = id {e};
end;

registration
  let S be non empty 1-sorted, e be Element of S;
  cluster Net-Str e -> non empty;
end;

theorem 
  for S being non empty 1-sorted, e being Element of S,
  x being Element of Net-Str e holds x = e;

theorem 
  for S being non empty 1-sorted, e being Element of S,
  x being Element of Net-Str e holds (Net-Str e).x = e;

registration
  let S be non empty 1-sorted, e be Element of S;
  cluster Net-Str e -> reflexive transitive directed antisymmetric;
end;

theorem 
  for S being non empty 1-sorted, e being Element of S, X being set holds
  Net-Str e is_eventually_in X iff e in X;

theorem 
  for S being reflexive antisymmetric non empty RelStr, e being Element of S
  holds e = lim_inf Net-Str e;

theorem 
  for S being non empty reflexive RelStr, e being Element of S
  holds Net-Str e in NetUniv S;

theorem 
  for R being complete LATTICE, Z be net of R, D be Subset of R st
  D = {"/\"({Z.k where k is Element of Z: k >= j},R)
  where j is Element of Z: not contradiction} holds D is non empty directed;

theorem 
  for L being complete LATTICE for S being Subset of L
  holds S in the topology of ConvergenceSpace Scott-Convergence L
  iff S is inaccessible upper;

theorem 
  for T being complete Scott TopLattice
  holds the TopStruct of T = ConvergenceSpace Scott-Convergence T;

theorem 
  for T being complete TopLattice
  st the TopStruct of T = ConvergenceSpace Scott-Convergence T
  for S being Subset of T holds S is open iff S is inaccessible upper;

theorem 
  for T being complete TopLattice
  st the TopStruct of T = ConvergenceSpace Scott-Convergence T
  holds T is Scott;

registration
  let R be complete LATTICE;


  cluster Scott-Convergence R -> (CONSTANTS);
end;

registration
  let R be complete LATTICE;


  cluster Scott-Convergence R -> (SUBNETS);
end;

theorem 
  for S being non empty 1-sorted, N being net of S, X being set
  for M being subnet of N st M = N"X for i being Element of M holds M.i in X;

definition
  let L be non empty reflexive RelStr;
  func sigma L -> Subset-Family of L equals

  the topology of ConvergenceSpace Scott-Convergence L;
end;

theorem 
  for L being continuous complete Scott TopLattice, x be Element of L
  holds wayabove x is open;

theorem 
  for T being complete TopLattice st the topology of T = sigma T
  holds T is Scott;

registration
  let R be continuous complete LATTICE;


  cluster Scott-Convergence R -> topological;
end;

theorem 
  for T be continuous complete Scott TopLattice, x be Element of T,
  N be net of T st N in NetUniv T holds x is_S-limit_of N iff x in Lim N;

theorem 
  for L being complete non empty Poset
  st Scott-Convergence L is (ITERATED_LIMITS) holds L is continuous;

theorem 
  for T being complete Scott TopLattice holds
  T is continuous iff Convergence T = Scott-Convergence T;

theorem 
  for T being complete Scott TopLattice,
  S being upper Subset of T st S is Open holds S is open;

theorem 
  for L being non empty RelStr, S being upper Subset of L,
  x being Element of L st x in S holds uparrow x c= S;

theorem 
  for L being complete continuous Scott TopLattice,
  p be Element of L, S be Subset of L st S is open & p in S
  ex q being Element of L st q << p & q in S;

theorem 
  for L being complete continuous Scott TopLattice, p be Element of L
  holds { wayabove q where q is Element of L: q << p } is Basis of p;

theorem 
  for T being complete continuous Scott TopLattice holds
  { wayabove x where x is Element of T: not contradiction } is Basis of T;

theorem 
  for T being complete continuous Scott TopLattice, S being upper Subset of T
  holds S is open iff S is Open;

theorem 
  for T being complete continuous Scott TopLattice, p being Element of T
  holds Int uparrow p = wayabove p;

theorem 
  for T being complete continuous Scott TopLattice, S being Subset of T
  holds Int S = union{wayabove x where x is Element of T: wayabove x c= S};














begin 

scheme 
 FraenkelInvolution
  {A() -> non empty set, X,Y() -> Subset of A(), F(set) -> Element of A()}:
  X() = {F(a) where a is Element of A(): a in Y()}
provided
 Y() = {F(a) where a is Element of A(): a in X()} and
 for a being Element of A() holds F(F(a)) = a;

scheme 
 FraenkelComplement1
  {A() -> non empty RelStr, X() -> Subset-Family of A(), Y() -> set,
  F(set) -> Subset of A()}:
  COMPLEMENT X() = {F(a)` where a is Element of A(): a in Y()}
provided
 X() = {F(a) where a is Element of A(): a in Y()};

scheme 
 FraenkelComplement2
  {A() -> non empty RelStr, X() -> Subset-Family of A(), Y() -> set,
  F(set) -> Subset of A()}:
  COMPLEMENT X() = {F(a) where a is Element of A(): a in Y()}
provided
 X() = {F(a)` where a is Element of A(): a in Y()};

theorem 
  for R being non empty RelStr, x,y being Element of R holds
  y in (uparrow x)` iff not x <= y;

scheme 
 ABC {A() -> TopSpace, F(set) -> set, f() -> Function, P[set]}:
  f()"union {F(x) where x is Subset of A(): P[x]} =
  union {f()"(F(y)) where y is Subset of A(): P[y]};

theorem 
  for S being 1-sorted, T being non empty 1-sorted, f being Function of S,T
  for X being Subset of T holds (f"X)` = f"X`;

theorem 
  for T being 1-sorted, F being Subset-Family of T holds
  COMPLEMENT F = {a` where a is Subset of T: a in F};

theorem 
  for R being non empty RelStr for F being Subset of R holds
  uparrow F = union {uparrow x where x is Element of R: x in F} &
  downarrow F = union {downarrow x where x is Element of R: x in F};

theorem 
  for R being non empty RelStr
  for A being Subset-Family of R, F being Subset of R
  st A = {(uparrow x)` where x is Element of R: x in F}
  holds Intersect A = (uparrow F)`;

registration
  cluster strict complete 1-element for TopLattice;
end;

registration
  let S be non empty RelStr,
  T be upper-bounded non empty reflexive antisymmetric RelStr;
  cluster infs-preserving for Function of S,T;
end;

registration
  let S be non empty RelStr,
  T be lower-bounded non empty reflexive antisymmetric RelStr;
  cluster sups-preserving for Function of S,T;
end;

definition
  let R,S be 1-sorted;
  assume
 the carrier of S c= the carrier of R;
  func incl(S,R) -> Function of S,R equals


  id the carrier of S;
end;

registration
  let R be non empty RelStr;
  let S be non empty SubRelStr of R;
  cluster incl(S,R) -> monotone;
end;

definition
  let R be non empty RelStr, X be non empty Subset of R;
  func X+id -> strict non empty NetStr over R equals

  (incl(subrelstr X, R))* (
  ( subrelstr X)+id);
  func X opp+id -> strict non empty NetStr over R equals

  (incl(subrelstr X, R
  ) )*((subrelstr X)opp+id);
end;

theorem 
  for R being non empty RelStr, X being non empty Subset of R holds
  the carrier of X+id = X & X+id is full SubRelStr of R &
  for x being Element of X+id holds X+id.x = x;

theorem 
  for R being non empty RelStr, X being non empty Subset of R holds
  the carrier of X opp+id = X & X opp+id is full SubRelStr of R opp &
  for x being Element of X opp+id holds X opp+id.x = x;

registration
  let R be non empty reflexive RelStr;
  let X be non empty Subset of R;
  cluster X +id -> reflexive;
  cluster X opp+id -> reflexive;
end;

registration
  let R be non empty transitive RelStr;
  let X be non empty Subset of R;
  cluster X +id -> transitive;
  cluster X opp+id -> transitive;
end;

registration
  let R be non empty reflexive RelStr;
  let I be directed Subset of R;
  cluster subrelstr I -> directed;
end;

registration
  let R be non empty reflexive RelStr;
  let I be directed non empty Subset of R;
  cluster I+id -> directed;
end;

registration
  let R be non empty reflexive RelStr;
  let F be filtered non empty Subset of R;
  cluster (subrelstr F) opp+id -> directed;
end;

registration
  let R be non empty reflexive RelStr;
  let F be filtered non empty Subset of R;
  cluster F opp+id -> directed;
end;

begin 

theorem 
  for T being TopSpace st T is empty holds the topology of T = {{}};

theorem 
  for T being 1-element TopSpace holds
  the topology of T = bool the carrier of T & for x being Point of T holds
  the carrier of T = {x} & the topology of T = {{},{x}};

theorem 
  for T being 1-element TopSpace holds
  {the carrier of T} is Basis of T &
  {} is prebasis of T & {{}} is prebasis of T;

theorem 
  for X,Y being set, A being Subset-Family of X st A = {Y}
  holds FinMeetCl A = {Y,X} & UniCl A = {Y,{}};

theorem 
  for X being set, A,B being Subset-Family of X st A = B \/ {X} or B = A \ { X
  } holds Intersect A = Intersect B;

theorem 
  for X being set, A,B being Subset-Family of X st A = B \/ {X} or B = A \ { X
  } holds FinMeetCl A = FinMeetCl B;

theorem 
  for X being set, A being Subset-Family of X st X in A
  for x being set holds x in FinMeetCl A iff
  ex Y being finite non empty Subset-Family of X st Y c= A & x = Intersect Y;

theorem 
  for X being set, A being Subset-Family of X holds UniCl UniCl A = UniCl A;

theorem 
  for X being set, A being empty Subset-Family of X holds UniCl A = {{}};

theorem 
  for X being set, A being empty Subset-Family of X holds FinMeetCl A = {X};

theorem 
  for X being set, A being Subset-Family of X st A = {{},X}
  holds UniCl A = A & FinMeetCl A = A;

theorem 
  for X,Y being set, A being Subset-Family of X, B being Subset-Family of Y
  holds (A c= B implies UniCl A c= UniCl B) &
  (A = B implies UniCl A = UniCl B);

theorem 
  for X,Y being set, A being Subset-Family of X, B being Subset-Family of Y
  st A = B & X in A
  holds FinMeetCl B = {Y} \/ FinMeetCl A;

theorem 
  for X being set, A being Subset-Family of X holds
  UniCl FinMeetCl UniCl A = UniCl FinMeetCl A;

begin 

theorem 
  for T being TopSpace, K being Subset-Family of T
  holds the topology of T = UniCl K iff K is Basis of T;

theorem 
  for T being TopSpace, K being Subset-Family of T
  holds K is prebasis of T iff FinMeetCl K is Basis of T;

theorem 
  for T being non empty TopSpace, B being Subset-Family of T
  st UniCl B is prebasis of T holds B is prebasis of T;

theorem 
  for T1, T2 being TopSpace, B being Basis of T1
  st the carrier of T1 = the carrier of T2 & B is Basis of T2
  holds the topology of T1 = the topology of T2;

theorem 
  for T1, T2 being TopSpace, P being prebasis of T1
  st the carrier of T1 = the carrier of T2 & P is prebasis of T2
  holds the topology of T1 = the topology of T2;

theorem 
  for T being TopSpace, K being Basis of T holds
  K is open & K is prebasis of T;

theorem 
  for T being TopSpace, K being prebasis of T holds K is open;

theorem 
  for T being non empty TopSpace, B being prebasis of T holds
  B \/ {the carrier of T} is prebasis of T;

theorem 
  for T being TopSpace, B being Basis of T holds
  B \/ {the carrier of T} is Basis of T;

theorem 
  for T being TopSpace, B being Basis of T for A being Subset of T holds
  A is open iff for p being Point of T st p in A
  ex a being Subset of T st a in B & p in a & a c= A;

theorem 
  for T being TopSpace, B being Subset-Family of T st B c= the topology of T &
  for A being Subset of T st A is open for p being Point of T st p in A
  ex a being Subset of T st a in B & p in a & a c= A holds B is Basis of T;

theorem 
  for S being TopSpace, T being non empty TopSpace, K being Basis of T
  for f being Function of S,T holds
  f is continuous iff for A being Subset of T st A in K holds f"A` is closed;

theorem 
  for S being TopSpace,T being non empty TopSpace, K being Basis of T
  for f being Function of S,T holds
  f is continuous iff for A being Subset of T st A in K holds f"A is open;

theorem 
  for S being TopSpace,T being non empty TopSpace, K being prebasis of T
  for f being Function of S,T holds
  f is continuous iff for A being Subset of T st A in K holds f"A` is closed;

theorem 
  for S being TopSpace,T being non empty TopSpace, K being prebasis of T
  for f being Function of S,T holds
  f is continuous iff for A being Subset of T st A in K holds f"A is open;

theorem 
  for T being non empty TopSpace, x being Point of T, X being Subset of T
  for K being Basis of T
  st for A being Subset of T st A in K & x in A holds A meets X
  holds x in Cl X;

theorem 
  for T being non empty TopSpace, x being Point of T, X being Subset of T
  for K being prebasis of T
  st for Z being finite Subset-Family of T st Z c= K & x in Intersect Z
  holds Intersect Z meets X holds x in Cl X;

theorem 
  for T being non empty TopSpace, K being prebasis of T, x being Point of T
  for N being net of T
  st for A being Subset of T st A in K & x in A holds N is_eventually_in A
  for S being Subset of T st rng netmap(N,T) c= S holds x in Cl S;

begin 

theorem 
  for T1,T2 being non empty TopSpace
  for B1 being Basis of T1, B2 being Basis of T2 holds
  {[:a,b:] where a is Subset of T1, b is Subset of T2: a in B1 & b in B2}
  is Basis of [:T1,T2:];

theorem 
  for T1,T2 being non empty TopSpace
  for B1 being prebasis of T1, B2 being prebasis of T2 holds
  {[:the carrier of T1, b:] where b is Subset of T2: b in B2} \/
  {[:a, the carrier of T2:] where a is Subset of T1: a in B1}
  is prebasis of [:T1,T2:];

theorem 
  for X1,X2 being set, A being Subset-Family of [:X1,X2:]
  for A1 being non empty Subset-Family of X1
  for A2 being non empty Subset-Family of X2
  st A = {[:a,b:] where a is Subset of X1, b is Subset of X2: a in A1 & b in
  A2} holds Intersect A = [:Intersect A1, Intersect A2:];

theorem 
  for T1,T2 being non empty TopSpace
  for B1 being prebasis of T1, B2 being prebasis of T2
  st union B1 = the carrier of T1 & union B2 = the carrier of T2 holds
  {[:a,b:] where a is Subset of T1, b is Subset of T2: a in B1 & b in B2}
  is prebasis of [:T1,T2:];

begin 

definition
  let R be RelStr;
  mode TopAugmentation of R -> TopRelStr means


     the RelStr of it = the RelStr of R;
end;

notation
  let R be RelStr;
  let T be TopAugmentation of R;
  synonym T is correct for T is TopSpace-like;
end;

registration
  let R be RelStr;
  cluster correct discrete strict for TopAugmentation of R;
end;

theorem 
  for T being TopRelStr holds T is TopAugmentation of T;

theorem 
  for S being TopRelStr, T being TopAugmentation of S holds
  S is TopAugmentation of T;

theorem 
  for R being RelStr, T1 being TopAugmentation of R
  for T2 being TopAugmentation of T1 holds T2 is TopAugmentation of R;

registration
  let R be non empty RelStr;
  cluster -> non empty for TopAugmentation of R;
end;

registration
  let R be reflexive RelStr;
  cluster -> reflexive for TopAugmentation of R;
end;

registration
  let R be transitive RelStr;
  cluster -> transitive for TopAugmentation of R;
end;

registration
  let R be antisymmetric RelStr;
  cluster -> antisymmetric for TopAugmentation of R;
end;

registration
  let R be complete non empty RelStr;
  cluster -> complete for TopAugmentation of R;
end;

theorem 
  for S being up-complete antisymmetric non empty reflexive RelStr,
  T being non empty reflexive RelStr st the RelStr of S = the RelStr of T
  for A being Subset of S, C being Subset of T st A = C & A is inaccessible
  holds C is inaccessible;

theorem 
  for S being non empty reflexive RelStr, T being TopAugmentation of S
  st the topology of T = sigma S holds T is correct;

theorem 
  for S being complete LATTICE, T being TopAugmentation of S
  st the topology of T = sigma S holds T is Scott;

registration
  let R be complete LATTICE;
  cluster Scott strict correct for TopAugmentation of R;
end;

theorem 
  for S,T being complete
  Scott non empty reflexive transitive antisymmetric TopRelStr
  st the RelStr of S = the RelStr of T
  for F being Subset of S, G being Subset of T st F = G
  holds F is open implies G is open;

theorem 
  for S being complete LATTICE, T being Scott TopAugmentation of S
  holds the topology of T = sigma S;

theorem 
  for S,T being complete LATTICE st the RelStr of S = the RelStr of T
  holds sigma S = sigma T;

registration
  let R be complete LATTICE;
  cluster Scott -> correct for TopAugmentation of R;
end;

begin 

definition
  let T be TopStruct;
  mode TopExtension of T -> TopSpace means


     the carrier of T = the carrier of it &
    the topology of T c= the topology of it;
end;

theorem 
  for S being TopStruct ex T being TopExtension of S st
  T is strict & the topology of S is prebasis of T;

registration
  let T be TopStruct;
  cluster strict discrete for TopExtension of T;
end;

definition
  let T1,T2 be TopStruct;
  mode Refinement of T1,T2 -> TopSpace means


     the carrier of it = (the carrier of T1) \/ (the carrier of T2) &
    (the topology of T1) \/ (the topology of T2) is prebasis of it;
end;

registration
  let T1 be non empty TopStruct, T2 be TopStruct;
  cluster -> non empty for Refinement of T1,T2;
  cluster -> non empty for Refinement of T2,T1;
end;

theorem 
  for T1,T2 being TopStruct, T, T9 being Refinement of T1,T2 holds
  the TopStruct of T = the TopStruct of T9;

theorem 
  for T1,T2 being TopStruct, T being Refinement of T1,T2
  holds T is Refinement of T2,T1;

theorem 
  for T1,T2 being TopStruct, T being Refinement of T1,T2
  for X being Subset-Family of T
  st X = (the topology of T1) \/ (the topology of T2)
  holds the topology of T = UniCl FinMeetCl X;

theorem 
  for T1, T2 being TopStruct st the carrier of T1 = the carrier of T2
  for T being Refinement of T1, T2
  holds T is TopExtension of T1 & T is TopExtension of T2;

theorem 
  for T1,T2 being non empty TopSpace, T be Refinement of T1, T2
  for B1 being prebasis of T1, B2 being prebasis of T2
  holds B1 \/ B2 \/ {the carrier of T1, the carrier of T2} is prebasis of T;

theorem 
  for T1,T2 being non empty TopSpace
  for B1 being Basis of T1, B2 being Basis of T2
  for T being Refinement of T1, T2
  holds B1 \/ B2 \/ INTERSECTION(B1,B2) is Basis of T;

theorem 
  for T1,T2 being non empty TopSpace st the carrier of T1 = the carrier of T2
  for T being Refinement of T1, T2
  holds INTERSECTION(the topology of T1, the topology of T2) is Basis of T;

theorem 
  for L being non empty RelStr for T1,T2 being correct TopAugmentation of L
  for T be Refinement of T1, T2
  holds INTERSECTION(the topology of T1, the topology of T2) is Basis of T;














begin  

reserve S, R for 1-sorted,
  X for Subset of R,
  T for TopStruct,
  x for set;

registration
  let X be set;
  cluster one-to-one onto for Function of X, X;
end;

theorem 
  rng id S = [#]S;

registration
  let R be 1-sorted;
  cluster (id R)/" -> one-to-one;
end;

theorem 
  (id R)/" = id R;

theorem 
  (id R)"X = X;

begin  

reserve H for non empty multMagma,
  P, Q, P1, Q1 for Subset of H,
  h for Element of H;

theorem 
  P c= P1 & Q c= Q1 implies P * Q c= P1 * Q1;

theorem 
  P c= Q implies P * h c= Q * h;

theorem 
  P c= Q implies h * P c= h * Q;

reserve G for Group,
  A, B for Subset of G,
  a for Element of G;

theorem 
  a in A" iff a" in A;

canceled;

theorem 
  A c= B iff A" c= B";

theorem 
  (inverse_op G).:A = A";

theorem 
  (inverse_op G)"A = A";

theorem 
  inverse_op G is one-to-one;

theorem 
  rng inverse_op G = the carrier of G;

registration
  let G be Group;
  cluster inverse_op G -> one-to-one onto;
end;

theorem 
  (inverse_op G)" = inverse_op G;

theorem 
  (the multF of H).:[:P,Q:] = P*Q;

definition
  let G be non empty multMagma, a be Element of G;
  func a* -> Function of G, G means


  for x being Element of G holds it.x = a * x;
  func *a -> Function of G, G means


  for x being Element of G holds it.x = x * a;
end;

registration
  let G be Group, a be Element of G;
  cluster a* -> one-to-one onto;
  cluster *a -> one-to-one onto;
end;

theorem 
  h*.:P = h * P;

theorem 
  (*h).:P = P * h;

theorem 
  a*/" = a"*;

theorem 
  (*a)/" = *(a");

begin  

registration
  let T be TopStruct;
  cluster (id T)/" -> continuous;
end;

theorem 
  id T is being_homeomorphism;

registration
  let T be non empty TopSpace, p be Point of T;
  cluster -> non empty for a_neighborhood of p;
end;

theorem 
  for T being non empty TopSpace, p being Point of T holds [#]T is
  a_neighborhood of p;

registration
  let T be non empty TopSpace, p be Point of T;
  cluster non empty open for a_neighborhood of p;
end;

theorem 
  for S, T being non empty TopSpace, f being Function of S, T st f is
open holds for p being Point of S, P being a_neighborhood of p ex R being open
  a_neighborhood of f.p st R c= f.:P;

theorem 
  for S, T being non empty TopSpace, f being Function of S, T st for p
being Point of S, P being open a_neighborhood of p ex R being a_neighborhood of
  f.p st R c= f.:P holds f is open;

theorem 
  for S, T being non empty TopStruct, f being Function of S, T holds f
is being_homeomorphism iff dom f = [#]S & rng f = [#]T & f is one-to-one & for
  P being Subset of T holds P is closed iff f"P is closed;

theorem 
  for S, T being non empty TopStruct, f being Function of S, T
  holds f is being_homeomorphism iff dom f = [#]S & rng f = [#]T & f is
  one-to-one & for P being Subset of S holds P is open iff f.:P is open;

theorem 
  for S, T being non empty TopStruct, f being Function of S, T holds f
is being_homeomorphism iff dom f = [#]S & rng f = [#]T & f is one-to-one & for
  P being Subset of T holds P is open iff f"P is open;

theorem 
  for S being TopSpace, T being non empty TopSpace, f being Function of
S, T holds f is continuous iff for P being Subset of T holds f"(Int P) c= Int(f
  "P);

registration
  let T be non empty TopSpace;
  cluster non empty dense for Subset of T;
end;

theorem 
  for S, T being non empty TopSpace, f being Function of S, T, A
  being dense Subset of S st f is being_homeomorphism holds f.:A is dense;

theorem 
  for S, T being non empty TopSpace, f being Function of S, T, A
  being dense Subset of T st f is being_homeomorphism holds f"A is dense;

registration
  let S, T be TopStruct;
  cluster being_homeomorphism -> onto one-to-one continuous for
Function of S, T;
end;

registration
  let S, T be non empty TopStruct;
  cluster being_homeomorphism -> open for Function of S, T;
end;

registration
  let T be TopStruct;
  cluster being_homeomorphism for Function of T, T;
end;

registration
  let T be TopStruct, f be being_homeomorphism Function of T, T;
  cluster f/" -> being_homeomorphism;
end;

begin  

definition
  let S,T be TopStruct;
  assume
 S,T are_homeomorphic;
  mode Homeomorphism of S,T -> Function of S,T means


    it is being_homeomorphism;
end;

definition
  let T be TopStruct;
  mode Homeomorphism of T -> Function of T,T means


    it is being_homeomorphism;
end;

definition
  let T be TopStruct;
  redefine mode Homeomorphism of T -> Homeomorphism of T,T;
end;

definition
  let T be TopStruct;
  redefine func id T -> Homeomorphism of T,T;
end;

definition
  let T be TopStruct;
  redefine func id T -> Homeomorphism of T;
end;

registration
  let T be TopStruct;
  cluster -> being_homeomorphism for Homeomorphism of T;
end;

theorem 
  for f being Homeomorphism of T holds f/" is Homeomorphism of T;

theorem 
  for f, g being Homeomorphism of T holds f * g is Homeomorphism of T;

definition
  let T be TopStruct;
  func HomeoGroup T -> strict multMagma means


  (x in the carrier of it
  iff x is Homeomorphism of T) & for f, g being Homeomorphism of T holds (the
  multF of it).(f,g) = g * f;
end;

registration
  let T be TopStruct;
  cluster HomeoGroup T -> non empty;
end;

theorem 
  for f, g being Homeomorphism of T for a, b being Element of HomeoGroup
  T st f = a & g = b holds a * b = g * f;

registration
  let T be TopStruct;
  cluster HomeoGroup T -> Group-like associative;
end;

theorem 
  id T = 1_HomeoGroup T;

theorem 
  for f being Homeomorphism of T for a being Element of HomeoGroup T st
  f = a holds a" = f/";

definition
  let T be TopStruct;
  attr T is homogeneous means


  for p, q being Point of T ex f being Homeomorphism of T st f.p = q;
end;

registration
  cluster -> homogeneous for 1-element TopStruct;
end;

theorem 
  for T being homogeneous non empty TopSpace st ex p being Point of T st
  {p} is closed holds T is T_1;

theorem 
  for T being homogeneous non empty TopSpace st ex p being Point
  of T st for A being Subset of T st A is open & p in A holds ex B being Subset
  of T st p in B & B is open & Cl B c= A holds T is regular;

begin  

definition
  struct (multMagma, TopStruct) TopGrStr (# carrier -> set, multF -> BinOp of
    the carrier, topology -> Subset-Family of the carrier #);
end;

registration
  let A be non empty set, R be BinOp of A, T be Subset-Family of A;
  cluster TopGrStr (#A, R, T#) -> non empty;
end;

registration
  let x be set, R be BinOp of {x}, T be Subset-Family of {x};
  cluster TopGrStr (#{x}, R, T#) -> trivial;
end;

registration
  cluster -> Group-like associative commutative for 1-element multMagma;
end;

registration
  let a be set;
  cluster 1TopSp {a} -> trivial;
end;

registration
  cluster strict non empty for TopGrStr;
end;

registration
  cluster strict TopSpace-like 1-element for TopGrStr;
end;







definition
  let G be Group-like associative non empty TopGrStr;
  attr G is UnContinuous means


  inverse_op G is continuous;
end;

definition
  let G be TopSpace-like TopGrStr;
  attr G is BinContinuous means


  for f being Function of [:G,G:], G st f
  = the multF of G holds f is continuous;
end;

registration
  cluster strict commutative UnContinuous BinContinuous for TopSpace-like
    Group-like associative 1-element TopGrStr;
end;

definition
  mode TopGroup is TopSpace-like Group-like associative non empty TopGrStr;
end;

definition
  mode TopologicalGroup is UnContinuous BinContinuous TopGroup;
end;

theorem 
  for T being BinContinuous non empty TopSpace-like TopGrStr, a,
  b being Element of T, W being a_neighborhood of a*b ex A being open
  a_neighborhood of a, B being open a_neighborhood of b st A*B c= W;

theorem 
  for T being TopSpace-like non empty TopGrStr st (for a, b being
  Element of T, W being a_neighborhood of a*b ex A being a_neighborhood of a, B
  being a_neighborhood of b st A*B c= W) holds T is BinContinuous;

theorem 
  for T being UnContinuous TopGroup, a being Element of T, W being
  a_neighborhood of a" ex A being open a_neighborhood of a st A" c= W;

theorem 
  for T being TopGroup st for a being Element of T, W being
  a_neighborhood of a" ex A being a_neighborhood of a st A" c= W holds T is
  UnContinuous;

theorem 
  for T being TopologicalGroup, a, b being Element of T for W
  being a_neighborhood of a*(b") ex A being open a_neighborhood of a, B being
  open a_neighborhood of b st A*(B") c= W;

theorem 
  for T being TopGroup st for a, b being Element of T, W being
a_neighborhood of a*(b") ex A being a_neighborhood of a, B being a_neighborhood
  of b st A*(B") c= W holds T is TopologicalGroup;

registration
  let G be BinContinuous non empty TopSpace-like TopGrStr, a be Element of G;
  cluster a* -> continuous;
  cluster *a -> continuous;
end;

theorem 
  for G being BinContinuous TopGroup, a being Element of G holds a
  * is Homeomorphism of G;

theorem 
  for G being BinContinuous TopGroup, a being Element of G holds *
  a is Homeomorphism of G;

definition
  let G be BinContinuous TopGroup, a be Element of G;
  redefine func a* -> Homeomorphism of G;
  redefine func *a -> Homeomorphism of G;
end;

theorem 
  for G being UnContinuous TopGroup holds inverse_op G is Homeomorphism of G;

definition
  let G be UnContinuous TopGroup;
  redefine func inverse_op G -> Homeomorphism of G;
end;

registration
  cluster BinContinuous -> homogeneous for TopGroup;
end;

theorem 
  for G being BinContinuous TopGroup, F being closed Subset of G,
  a being Element of G holds F * a is closed;

theorem 
  for G being BinContinuous TopGroup, F being closed Subset of G,
  a being Element of G holds a * F is closed;

registration
  let G be BinContinuous TopGroup, F be closed Subset of G, a be Element of G;
  cluster F * a -> closed;
  cluster a * F -> closed;
end;

theorem 
  for G being UnContinuous TopGroup, F being closed Subset of G
  holds F" is closed;

registration
  let G be UnContinuous TopGroup, F be closed Subset of G;
  cluster F" -> closed;
end;

theorem 
  for G being BinContinuous TopGroup, O being open Subset of G, a
  being Element of G holds O * a is open;

theorem 
  for G being BinContinuous TopGroup, O being open Subset of G, a
  being Element of G holds a * O is open;

registration
  let G be BinContinuous TopGroup, A be open Subset of G, a be Element of G;
  cluster A * a -> open;
  cluster a * A -> open;
end;

theorem 
  for G being UnContinuous TopGroup, O being open Subset of G holds O" is open;

registration
  let G be UnContinuous TopGroup, A be open Subset of G;
  cluster A" -> open;
end;

theorem 
  for G being BinContinuous TopGroup, A, O being Subset of G st O
  is open holds O * A is open;

theorem 
  for G being BinContinuous TopGroup, A, O being Subset of G st O
  is open holds A * O is open;

registration
  let G be BinContinuous TopGroup, A be open Subset of G, B be Subset of G;
  cluster A * B -> open;
  cluster B * A -> open;
end;

theorem 
  for G being UnContinuous TopGroup, a being Point of G, A being
  a_neighborhood of a holds A" is a_neighborhood of a";

theorem 
  for G being TopologicalGroup, a being Point of G, A being
  a_neighborhood of a*a" ex B being open a_neighborhood of a st B*B" c= A;

theorem 
  for G being UnContinuous TopGroup, A being dense Subset of G
  holds A" is dense;

registration
  let G be UnContinuous TopGroup, A be dense Subset of G;
  cluster A" -> dense;
end;

theorem 
  for G being BinContinuous TopGroup, A being dense Subset of G, a
  being Point of G holds a*A is dense;

theorem 
  for G being BinContinuous TopGroup, A being dense Subset of G, a
  being Point of G holds A*a is dense;

registration
  let G be BinContinuous TopGroup, A be dense Subset of G, a be Point of G;
  cluster A * a -> dense;
  cluster a * A -> dense;
end;

theorem 
  for G being TopologicalGroup, B being Basis of 1_G, M being dense
  Subset of G holds { V * x where V is Subset of G, x is Point of G: V in B & x
  in M } is Basis of G;

theorem 
  for G being TopologicalGroup holds G is regular;

registration
  cluster -> regular for TopologicalGroup;
end;

theorem 
  for T being TopStruct, f be Function of T,T st T is empty holds f is
  being_homeomorphism;














begin  

definition
  let V be non empty RLSStruct, M,N be Affine Subset of V;
  pred M is_parallel_to N means


  ex v being VECTOR of V st M = N + {v};
end;

theorem 
  for V being right_zeroed non empty RLSStruct, M be Affine Subset of
  V holds M is_parallel_to M;

theorem 
  for V being add-associative right_zeroed right_complementablenon
  empty RLSStruct, M,N be Affine Subset of V st M is_parallel_to N holds N
  is_parallel_to M;

theorem 
  for V being Abelian add-associative right_zeroed
  right_complementable non empty RLSStruct, M,L,N be Affine Subset of V st M
  is_parallel_to L & L is_parallel_to N holds M is_parallel_to N;

definition
  let V be non empty addLoopStr, M,N be Subset of V;
  func M - N -> Subset of V equals

  {u - v where u,v is Element of V: u in M &
  v in N};
end;

theorem 
  for V being RealLinearSpace, M,N being Affine Subset of V holds M
  - N is Affine;

theorem 
  for V being non empty addLoopStr, M,N being Subset of V st M is empty
  or N is empty holds M + N is empty;

theorem 
  for V being non empty addLoopStr, M,N being non empty Subset of V
  holds M + N is non empty;

theorem 
  for V being non empty addLoopStr, M,N being Subset of V st M is empty
  or N is empty holds M - N is empty;

theorem 
  for V being non empty addLoopStr, M,N being non empty Subset of V
  holds M - N is non empty;

theorem 
  for V being Abelian add-associative right_zeroed
  right_complementable non empty addLoopStr, M,N being Subset of V, v being
  Element of V holds M = N + {v} iff M - {v} = N;

theorem 
  for V being Abelian add-associative right_zeroed right_complementable
  non empty addLoopStr, M,N being Subset of V, v being Element of V st v in N
  holds M + {v} c= M + N;

theorem 
  for V being Abelian add-associative right_zeroed right_complementable
  non empty addLoopStr, M,N being Subset of V, v being Element of V st v in N
  holds M - {v} c= M - N;

theorem 
  for V being RealLinearSpace, M being non empty Subset of V holds 0.V in M - M
;

theorem 
  for V being RealLinearSpace, M being non empty Affine Subset of
  V, v being VECTOR of V st M is Subspace-like & v in M holds M + {v} c= M;

theorem 
  for V being RealLinearSpace, M being non empty Affine Subset of
  V, N1,N2 being non empty Affine Subset of V st N1 is Subspace-like & N2 is
  Subspace-like & M is_parallel_to N1 & M is_parallel_to N2 holds N1 = N2;

theorem 
  for V being RealLinearSpace, M being non empty Affine Subset of
  V, v being VECTOR of V st v in M holds 0.V in M - {v};

theorem 
  for V being RealLinearSpace, M being non empty Affine Subset of
V, v being VECTOR of V st v in M holds ex N being non empty Affine Subset of V
  st N = M - {v} & M is_parallel_to N & N is Subspace-like;

theorem 
  for V being RealLinearSpace, M being non empty Affine Subset of
  V, u,v being VECTOR of V st u in M & v in M holds M - {v} = M - {u};

theorem 
  for V being RealLinearSpace, M being non empty Affine Subset of
  V holds M - M = union {M - {v} where v is VECTOR of V : v in M};

theorem 
  for V being RealLinearSpace, M being non empty Affine Subset of
  V, v being VECTOR of V st v in M holds M - {v} = union {M - {u} where u is
  VECTOR of V : u in M};

theorem 
  for V being RealLinearSpace, M be non empty Affine Subset of V holds
  ex L being non empty Affine Subset of V st L = M - M & L is Subspace-like & M
  is_parallel_to L;

begin 

definition
  let V be RealUnitarySpace, W be Subspace of V;
  func Ort_Comp W -> strict Subspace of V means


  the carrier of it = {v
  where v is VECTOR of V : for w being VECTOR of V st w in W holds w, v
  are_orthogonal};
end;

definition
  let V be RealUnitarySpace, M be non empty Subset of V;
  func Ort_Comp M -> strict Subspace of V means


  the carrier of it = {v
  where v is VECTOR of V : for w being VECTOR of V st w in M holds w, v
  are_orthogonal};
end;

theorem 
  for V being RealUnitarySpace, W being Subspace of V holds 0.V in Ort_Comp W;

theorem 
  for V being RealUnitarySpace holds Ort_Comp (0).V = (Omega).V;

theorem 
  for V being RealUnitarySpace holds Ort_Comp (Omega).V = (0).V;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, v being VECTOR of
  V st v <> 0.V holds v in W implies not v in Ort_Comp W;

theorem 
  for V being RealUnitarySpace, M being non empty Subset of V
  holds M c= the carrier of Ort_Comp (Ort_Comp M);

theorem 
  for V being RealUnitarySpace, M,N being non empty Subset of V st
  M c= N holds the carrier of Ort_Comp N c= the carrier of Ort_Comp M;

theorem 
  for V being RealUnitarySpace, W being Subspace of V, M being non
  empty Subset of V st M = the carrier of W holds Ort_Comp M = Ort_Comp W;

theorem 
  for V being RealUnitarySpace, M being non empty Subset of V holds
  Ort_Comp M = Ort_Comp (Ort_Comp (Ort_Comp M));

theorem 
  for V being RealUnitarySpace, x,y being VECTOR of V holds ||.x +
y.||^2 = ||.x.||^2 + 2 * x .|. y + ||.y.||^2 & ||.x - y.||^2 = ||.x.||^2 - 2 *
  x .|. y + ||.y.||^2;

theorem 
  for V being RealUnitarySpace, x,y being VECTOR of V st x,y
  are_orthogonal holds ||.x+y.||^2 = ||.x.||^2 + ||.y.||^2;



theorem 
  for V being RealUnitarySpace, x,y being VECTOR of V holds ||.x+y.||^2
  + ||.x-y.||^2 = 2*||.x.||^2 + 2*||.y.||^2;

theorem 
  for V being RealUnitarySpace, v being VECTOR of V ex W being Subspace
  of V st the carrier of W = {u where u is VECTOR of V : u .|. v = 0};

begin  

definition
  let V be RealUnitarySpace;
  func Family_open_set(V) -> Subset-Family of V means


  for M being
Subset of V holds M in it iff for x being Point of V st x in M holds ex r being
  Real st r>0 & Ball(x,r) c= M;
end;

theorem 
  for V being RealUnitarySpace, v being Point of V, r,p being Real
  st r <= p holds Ball(v,r) c= Ball(v,p);

theorem 
  for V being RealUnitarySpace, v being Point of V ex r being Real
  st r>0 & Ball(v,r) c= the carrier of V;

theorem 
  for V being RealUnitarySpace, v,u being Point of V, r being Real
  st u in Ball(v,r) holds ex p being Real st p>0 & Ball(u,p) c= Ball(v,r);

theorem 
  for V being RealUnitarySpace, u,v,w being Point of V, r,p being Real
st v in Ball(u,r) /\ Ball(w,p) holds ex q being Real st Ball(v,q) c= Ball(u,r)
  & Ball(v,q) c= Ball(w,p);

theorem 
  for V being RealUnitarySpace, v being Point of V, r being Real
  holds Ball(v,r) in Family_open_set(V);

theorem 
  for V being RealUnitarySpace holds the carrier of V in Family_open_set(V);

theorem 
  for V being RealUnitarySpace, M,N being Subset of V st M in
Family_open_set(V) & N in Family_open_set(V) holds M /\ N in Family_open_set(V)
;

theorem 
  for V being RealUnitarySpace, A being Subset-Family of V st A c=
  Family_open_set(V) holds union A in Family_open_set(V);

theorem 
  for V being RealUnitarySpace holds TopStruct (#the carrier of V,
    Family_open_set(V)#) is TopSpace;

definition
  let V be RealUnitarySpace;
  func TopUnitSpace V -> TopStruct equals

  TopStruct (#the carrier of V,
    Family_open_set(V)#);
end;

registration
  let V be RealUnitarySpace;
  cluster TopUnitSpace V -> TopSpace-like;
end;

registration
  let V be RealUnitarySpace;
  cluster TopUnitSpace V -> non empty;
end;

theorem 
  for V being RealUnitarySpace, M being Subset of TopUnitSpace V st M =
  [#]V holds M is open & M is closed;

theorem 
  for V being RealUnitarySpace, M being Subset of TopUnitSpace V st M =
  {}V holds M is open & M is closed;

theorem 
  for V being RealUnitarySpace, v being VECTOR of V, r being Real st the
  carrier of V = {0.V} & r <> 0 holds Sphere(v,r) is empty;

theorem 
  for V being RealUnitarySpace, v being VECTOR of V, r being Real st the
  carrier of V <> {0.V} & r > 0 holds Sphere(v,r) is non empty;

theorem 
  for V being RealUnitarySpace, v being VECTOR of V, r being Real st r =
  0 holds Ball(v,r) is empty;

theorem 
  for V being RealUnitarySpace, v being VECTOR of V, r being Real st the
  carrier of V = {0.V} & r > 0 holds Ball(v,r) = {0.V};

theorem 
  for V being RealUnitarySpace, v being VECTOR of V, r being Real st the
carrier of V <> {0.V} & r > 0 ex w being VECTOR of V st w <> v & w in Ball(v,r)
;

theorem 
  for V being RealUnitarySpace holds the carrier of V = the carrier of
  TopUnitSpace V & the topology of TopUnitSpace V = Family_open_set V;

theorem 
  for V being RealUnitarySpace, M being Subset of TopUnitSpace(V),
  r being Real, v being Point of V st M = Ball(v,r) holds M is open;

theorem 
  for V being RealUnitarySpace, M being Subset of TopUnitSpace(V) holds
M is open iff for v being Point of V st v in M ex r being Real st r>0 & Ball(v,
  r) c= M;

theorem 
  for V being RealUnitarySpace, v1,v2 being Point of V, r1,r2 being Real
ex u being Point of V, r being Real st Ball(v1,r1) \/ Ball(v2,r2) c= Ball(u,r);

theorem 
  for V being RealUnitarySpace, M being Subset of TopUnitSpace V,
  v being VECTOR of V, r being Real st M = cl_Ball(v,r) holds M is closed;

theorem 
  for V being RealUnitarySpace, M being Subset of TopUnitSpace V, v
  being VECTOR of V, r being Real st M = Sphere(v,r) holds M is closed;














begin  

definition
  let V be non empty RLSStruct, M be Subset of V, r be Real;
  func r*M -> Subset of V equals

  {r * v where v is Element of V: v in M};
end;

definition
  let V be non empty RLSStruct, M be Subset of V;
  attr M is convex means


  for u,v being VECTOR of V, r be Real st 0 < r
  & r < 1 & u in M & v in M holds r*u + (1-r)*v in M;
end;

theorem 
  for V being vector-distributive scalar-distributive scalar-associative
  scalar-unital non empty RLSStruct, M being Subset
  of V, r being Real st M is convex holds r*M is convex;

theorem 
  for V being Abelian add-associative vector-distributive scalar-distributive
  scalar-associative scalar-unital non empty
  RLSStruct, M,N being Subset of V st M is convex & N is convex holds M + N is
  convex;

theorem 
  for V being RealLinearSpace, M,N being Subset of V st M is convex & N
  is convex holds M - N is convex;

theorem 
  for V being non empty RLSStruct, M being Subset of V holds M is
  convex iff for r being Real st 0 < r & r < 1 holds r*M + (1-r)*M c= M;

theorem 
  for V being Abelian non empty RLSStruct, M being Subset of V st M is
  convex holds (for r being Real st 0 < r & r < 1 holds (1-r)*M + r*M c= M);

theorem 
  for V being Abelian add-associative vector-distributive scalar-distributive
  scalar-associative scalar-unital non empty
  RLSStruct, M,N being Subset of V st M is convex & N is convex holds for r
  being Real holds r*M + (1-r)*N is convex;

theorem 
  for V being RealLinearSpace, M being Subset of V, v being VECTOR of V
  holds M is convex iff v + M is convex;

theorem 
  for V being RealLinearSpace holds Up((0).V) is convex;

theorem 
  for V being RealLinearSpace holds Up((Omega).V) is convex;

theorem 
  for V being non empty RLSStruct, M being Subset of V st M = {}
  holds M is convex;

theorem 
  for V being Abelian add-associative vector-distributive scalar-distributive
  scalar-associative scalar-unital non
  empty RLSStruct, M1,M2 being Subset of V, r1,r2 being Real st M1 is convex &
  M2 is convex holds r1*M1 + r2*M2 is convex;

theorem 
  for V being vector-distributive scalar-distributive scalar-associative
  scalar-unital non empty RLSStruct, M being
  Subset of V, r1,r2 being Real holds (r1 + r2)*M c= r1*M + r2*M;

theorem 
  for V being RealLinearSpace, M being Subset of V, r1,r2 being Real st
  r1 >= 0 & r2 >= 0 & M is convex holds r1*M + r2*M = (r1 + r2)*M;

theorem 
  for V being Abelian add-associative vector-distributive scalar-distributive
  scalar-associative scalar-unital non empty
  RLSStruct, M1,M2,M3 being Subset of V, r1,r2,r3 being Real st M1 is convex &
  M2 is convex & M3 is convex holds r1*M1 + r2*M2 + r3*M3 is convex;

theorem 
  for V being non empty RLSStruct, F being Subset-Family of V st (
  for M being Subset of V st M in F holds M is convex) holds meet F is convex;

theorem 
  for V being non empty RLSStruct, M being Subset of V st M is
  Affine holds M is convex;

registration
  let V be non empty RLSStruct;
  cluster non empty convex for Subset of V;
end;

registration
  let V be non empty RLSStruct;
  cluster empty convex for Subset of V;
end;

theorem 
  for V being RealUnitarySpace-like non empty UNITSTR, M being Subset
  of V, v being VECTOR of V, r being Real st M = {u where u is VECTOR of V : u
  .|. v >= r} holds M is convex;

theorem 
  for V being RealUnitarySpace-like non empty UNITSTR, M being Subset
  of V, v being VECTOR of V, r being Real st M = {u where u is VECTOR of V : u
  .|. v > r} holds M is convex;

theorem 
  for V being RealUnitarySpace-like non empty UNITSTR, M being Subset
  of V, v being VECTOR of V, r being Real st M = {u where u is VECTOR of V : u
  .|. v <= r} holds M is convex;

theorem 
  for V being RealUnitarySpace-like non empty UNITSTR, M being Subset
  of V, v being VECTOR of V, r being Real st M = {u where u is VECTOR of V : u
  .|. v < r} holds M is convex;

begin  

definition
  let V be RealLinearSpace, L be Linear_Combination of V;
  attr L is convex means


  ex F being FinSequence of the carrier of V st
F is one-to-one & rng F = Carrier L & ex f being FinSequence of REAL st len f =
len F & Sum(f) = 1 & for n being Nat st n in dom f holds f.n = L.(F.n) & f.n >=
  0;
end;

theorem 
  for V being RealLinearSpace, L being Linear_Combination of V st
  L is convex holds Carrier(L) <> {};

theorem 
  for V being RealLinearSpace, L being Linear_Combination of V, v being
  VECTOR of V st L is convex & L.v <= 0 holds not v in Carrier(L);

theorem 
  for V being RealLinearSpace, L being Linear_Combination of V st L is
  convex holds L <> ZeroLC(V);

theorem 
  for V being RealLinearSpace, v being VECTOR of V, L being
  Linear_Combination of {v} st L is convex holds L.v = 1 & Sum(L) = L.v * v;

theorem 
  for V being RealLinearSpace, v1,v2 being VECTOR of V, L being
Linear_Combination of {v1,v2} st v1 <> v2 & L is convex holds L.v1 + L.v2 = 1 &
  L.v1 >= 0 & L.v2 >= 0 & Sum(L) = L.v1 * v1 + L.v2 * v2;

theorem 
  for V being RealLinearSpace, v1,v2,v3 being VECTOR of V, L being
  Linear_Combination of {v1,v2,v3} st v1 <> v2 & v2 <> v3 & v3 <> v1 & L is
convex holds L.v1 + L.v2 + L.v3 = 1 & L.v1 >= 0 & L.v2 >= 0 & L.v3 >= 0 & Sum(L
  ) = L.v1 * v1 + L.v2 * v2 + L.v3 * v3;

theorem 
  for V being RealLinearSpace, v being VECTOR of V, L being
Linear_Combination of V st L is convex & Carrier(L) = {v} holds L.v = 1
;

theorem 
  for V being RealLinearSpace, v1,v2 being VECTOR of V, L being
Linear_Combination of V st L is convex & Carrier(L) = {v1,v2} & v1 <> v2 holds
  L.v1 + L.v2 = 1 & L.v1 >= 0 & L.v2 >= 0;

theorem 
  for V being RealLinearSpace, v1,v2,v3 being VECTOR of V, L being
  Linear_Combination of V st L is convex & Carrier(L) = {v1,v2,v3} & v1 <> v2 &
v2 <> v3 & v3 <> v1 holds L.v1 + L.v2 + L.v3 = 1 & L.v1 >= 0 & L.v2 >= 0 & L.v3
  >= 0 & Sum(L) = L.v1 * v1 + L.v2 * v2 + L.v3 * v3;

begin  

definition
  let V be non empty RLSStruct, M be Subset of V;
  func Convex-Family M -> Subset-Family of V means


  for N being Subset of V holds N in it iff N is convex & M c= N;
end;

definition
  let V be non empty RLSStruct, M be Subset of V;
  func conv(M) -> convex Subset of V equals

  meet (Convex-Family M);
end;

theorem 
  for V being non empty RLSStruct, M being Subset of V, N being convex
  Subset of V st M c= N holds conv(M) c= N;

begin  

theorem 
  for p being FinSequence, x,y,z being set st p is one-to-one & rng p =
{x,y,z} & x <> y & y <> z & z <> x holds p = <* x,y,z *> or p = <* x,z,y *> or
  p = <* y,x,z *> or p = <* y,z,x *> or p = <* z,x,y *> or p = <* z,y,x *>;

theorem 
  for V being vector-distributive scalar-distributive scalar-associative
  scalar-unital non empty RLSStruct, M being Subset
  of V holds 1*M = M;

theorem 
  for V being non empty RLSStruct, M being empty Subset of V, r being
  Real holds r * M = {};

theorem 
  for V being RealLinearSpace, M be non empty Subset of V holds 0 * M =
  {0.V};

theorem 
  for V being right_zeroed non empty addLoopStr, M being Subset of V
  holds M + {0.V} = M;

theorem 
  for V be add-associative non empty addLoopStr, M1,M2,M3 be Subset of
  V holds (M1 + M2) + M3 = M1 + (M2 + M3);

theorem 
  for V being vector-distributive scalar-distributive scalar-associative
  scalar-unital non empty RLSStruct, M being Subset
  of V, r1,r2 being Real holds r1*(r2*M) = (r1*r2)*M;

theorem 
  for V being vector-distributive scalar-distributive scalar-associative
  scalar-unital non empty RLSStruct, M1,M2 being
  Subset of V, r being Real holds r*(M1 + M2) = r*M1 + r*M2;

theorem 
  for V being non empty RLSStruct, M,N being Subset of V, r being Real
  st M c= N holds r*M c= r*N;

theorem 
  for V being non empty addLoopStr, M being empty Subset of V, N being
  Subset of V holds M + N = {};

begin 


registration
  let V be non empty RLSStruct, M,N be convex Subset of V;
  cluster M /\ N -> convex for Subset of V;
end;

registration
  let V be RealLinearSpace, M be Subset of V;
  cluster Convex-Family M -> non empty;
end;

theorem 
  for V being RealLinearSpace, M being Subset of V holds M c= conv(M);














begin





theorem 
  for I be set, J be non empty set, f be Function of I,J*, X be
ManySortedSet of J, p be Element of J*, x be set st x in I & p = f.x holds (X#
  * f).x = product (X * p);

definition
  let I be set, A,B be ManySortedSet of I, C be ManySortedSubset of A, F be
  ManySortedFunction of A,B;
  func F || C -> ManySortedFunction of C,B means


  for i be set st i in I
  for f be Function of A.i,B.i st f = F.i holds it.i = f | (C.i);
end;

definition
  let I be set, X be ManySortedSet of I, i be set;
  assume
 i in I;
  func coprod(i,X) -> set means


  for x be set holds x in it iff ex a be set st a in X.i & x = [a,i];
end;

notation
  let I be set, X be ManySortedSet of I;
  synonym coprod X for disjoin X;
end;

registration
  let I be set, X be ManySortedSet of I;
  cluster coprod X -> I-defined;
end;

registration
  let I be set, X be ManySortedSet of I;
  cluster coprod X -> total;
end;

definition
  let I be set, X be ManySortedSet of I;
  redefine func coprod X means


  dom it = I & for i be set st i in I holds it.i = coprod(i,X);
end;

registration
  let I be non empty set, X be non-empty ManySortedSet of I;
  cluster coprod X -> non-empty;
end;

registration
  let I be non empty set, X be non-empty ManySortedSet of I;
  cluster Union X -> non empty;
end;

theorem 
  for I be set, X be ManySortedSet of I, i be set st i in I holds X.i <>
  {} iff (coprod X).i <> {};

begin





reserve S for non void non empty ManySortedSign,
  U0 for MSAlgebra over S;

definition
  let S be non void non empty ManySortedSign, U0 be MSAlgebra over S;
  mode GeneratorSet of U0 -> MSSubset of U0 means


    the Sorts of GenMSAlg (it) = the Sorts of U0;
end;

theorem 
  for S be non void non empty ManySortedSign, U0 be strict non-empty
  MSAlgebra over S, A be MSSubset of U0 holds A is GeneratorSet of U0 iff
  GenMSAlg(A) = U0;

definition
  let S,U0;
  let IT be GeneratorSet of U0;
  attr IT is free means


  for U1 be non-empty MSAlgebra over S for f be
ManySortedFunction of IT,the Sorts of U1 ex h be ManySortedFunction of U0,U1 st
  h is_homomorphism U0,U1 & h || IT = f;
end;

definition
  let S be non void non empty ManySortedSign;
  let IT be MSAlgebra over S;
  attr IT is free means


  ex G being GeneratorSet of IT st G is free;
end;

theorem 
  for S be non void non empty ManySortedSign, X be ManySortedSet of
  the carrier of S holds Union coprod X misses [:the carrier' of S,{the carrier
  of S}:];

begin





definition
  let S be non void non empty ManySortedSign, X be ManySortedSet of the
  carrier of S;

  func REL(X) -> Relation of ([:the carrier' of S,{the carrier of S}:] \/
Union (coprod X)), (([:the carrier' of S,{the carrier of S}:] \/ Union (coprod
  X))*) means


  for a be Element of [:the carrier' of S,{the carrier of S}:]
\/ Union (coprod X), b be Element of ([:the carrier' of S,{the carrier of S}:]
  \/ Union (coprod X))* holds [a,b] in it iff a in [:the carrier' of S,{the
  carrier of S}:] & for o be OperSymbol of S st [o,the carrier of S] = a holds
  len b = len (the_arity_of o) & for x be set st x in dom b holds (b.x in [:the
carrier' of S,{the carrier of S}:] implies for o1 be OperSymbol of S st [o1,the
carrier of S] = b.x holds the_result_sort_of o1 = (the_arity_of o).x) & (b.x in
  Union (coprod X) implies b.x in coprod((the_arity_of o).x,X));
end;

reserve S for non void non empty ManySortedSign,
  X for ManySortedSet of the carrier of S,
  o for OperSymbol of S,
  b for Element of ([:the carrier' of S,{the
  carrier of S}:] \/ Union (coprod X))*;

theorem 
  [[o,the carrier of S],b] in REL(X) iff len b = len (the_arity_of
o) & for x be set st x in dom b holds (b.x in [:the carrier' of S,{the carrier
of S}:] implies for o1 be OperSymbol of S st [o1,the carrier of S] = b.x holds
the_result_sort_of o1 = (the_arity_of o).x) & (b.x in Union (coprod X) implies
  b.x in coprod((the_arity_of o).x,X));

definition
  let S be non void non empty ManySortedSign, X be ManySortedSet of the
  carrier of S;
  func DTConMSA(X) -> DTConstrStr equals

  DTConstrStr (# [:the carrier' of S,{
    the carrier of S}:] \/ Union (coprod X), REL(X) #);
end;

registration
  let S be non void non empty ManySortedSign, X be ManySortedSet of the
  carrier of S;
  cluster DTConMSA(X) -> strict non empty;
end;

theorem 
  for S be non void non empty ManySortedSign, X be ManySortedSet of
  the carrier of S holds NonTerminals(DTConMSA(X))c= [:the carrier' of S,{the
carrier of S}:] & Union (coprod X) c= Terminals (DTConMSA(X)) & (X is non-empty
implies NonTerminals(DTConMSA(X)) = [:the carrier' of S,{the carrier of S}:] &
  Terminals (DTConMSA(X)) = Union (coprod X));

reserve x for set;

registration
  let S be non void non empty ManySortedSign, X be non-empty ManySortedSet of
  the carrier of S;
  cluster DTConMSA(X) -> with_terminals with_nonterminals
    with_useful_nonterminals;
end;

theorem 
  for S be non void non empty ManySortedSign, X be ManySortedSet of
  the carrier of S, t be set holds (t in Terminals DTConMSA(X) & X is non-empty
  implies ex s be SortSymbol of S, x be set st x in X.s & t = [x,s]) & for s be
  SortSymbol of S, x be set st x in X.s holds [x,s] in Terminals DTConMSA(X);

definition
  let S be non void non empty ManySortedSign, X be non-empty ManySortedSet of
  the carrier of S, o be OperSymbol of S;
  func Sym(o,X) ->Symbol of DTConMSA(X) equals

  [o,the carrier of S];
end;

definition
  let S be non void non empty ManySortedSign, X be non-empty ManySortedSet of
  the carrier of S, s be SortSymbol of S;
  func FreeSort(X,s) -> Subset of TS(DTConMSA(X)) equals

  {a where a is Element
of TS(DTConMSA(X)): (ex x be set st x in X.s & a = root-tree [x,s]) or ex o be
  OperSymbol of S st [o,the carrier of S] = a.{} & the_result_sort_of o = s};
end;

registration
  let S be non void non empty ManySortedSign, X be non-empty ManySortedSet of
  the carrier of S, s be SortSymbol of S;
  cluster FreeSort(X,s) -> non empty;
end;

definition
  let S be non void non empty ManySortedSign, X be non-empty ManySortedSet of
  the carrier of S;
  func FreeSort(X) -> ManySortedSet of the carrier of S means


  for s be SortSymbol of S holds it.s = FreeSort(X,s);
end;

registration
  let S be non void non empty ManySortedSign, X be non-empty ManySortedSet of
  the carrier of S;
  cluster FreeSort(X) -> non-empty;
end;

theorem 
  for S be non void non empty ManySortedSign, X be non-empty
  ManySortedSet of the carrier of S, o be OperSymbol of S, x be set st x in ((
  FreeSort X)# * (the Arity of S)).o holds x is FinSequence of TS(DTConMSA(X));

theorem 
  for S be non void non empty ManySortedSign, X be non-empty
ManySortedSet of the carrier of S, o be OperSymbol of S, p be FinSequence of TS
(DTConMSA(X)) holds p in ((FreeSort X)# * (the Arity of S)).o iff dom p = dom (
  the_arity_of o) & for n be Nat st n in dom p holds p.n in FreeSort(X,(
  the_arity_of o)/.n);

theorem 
  for S be non void non empty ManySortedSign, X be non-empty
ManySortedSet of the carrier of S, o be OperSymbol of S, p be FinSequence of TS
  (DTConMSA(X)) holds Sym(o,X) ==> roots p iff p in ((FreeSort X)# * (the Arity
  of S)).o;

theorem 
  for S be non void non empty ManySortedSign, X be non-empty
ManySortedSet of the carrier of S holds union rng (FreeSort X) = TS (DTConMSA(X
  ));

theorem 
  for S be non void non empty ManySortedSign, X be non-empty
ManySortedSet of the carrier of S, s1,s2 be SortSymbol of S st s1 <> s2 holds (
  FreeSort X).s1 misses (FreeSort X).s2;

definition
  let S be non void non empty ManySortedSign, X be non-empty ManySortedSet of
  the carrier of S, o be OperSymbol of S;
  func DenOp(o,X) -> Function of ((FreeSort X)# * (the Arity of S)).o, ((
  FreeSort X) * (the ResultSort of S)).o means


  for p be FinSequence of TS
  (DTConMSA(X)) st Sym(o,X) ==> roots p holds it.p = (Sym(o,X))-tree p;
end;

definition
  let S be non void non empty ManySortedSign, X be non-empty ManySortedSet of
  the carrier of S;
  func FreeOper(X) -> ManySortedFunction of (FreeSort X)# * (the Arity of S),
  (FreeSort X) * (the ResultSort of S) means


  for o be OperSymbol of S holds it.o = DenOp(o,X);
end;

definition
  let S be non void non empty ManySortedSign, X be non-empty ManySortedSet of
  the carrier of S;
  func FreeMSA(X) -> MSAlgebra over S equals

  MSAlgebra (# FreeSort(X),
    FreeOper(X) #);
end;

registration
  let S be non void non empty ManySortedSign, X be non-empty ManySortedSet of
  the carrier of S;
  cluster FreeMSA(X) -> strict non-empty;
end;

definition
  let S be non void non empty ManySortedSign, X be non-empty ManySortedSet of
  the carrier of S, s be SortSymbol of S;
  func FreeGen(s,X) -> Subset of (FreeSort(X)).s means


  for x be set holds x in it iff ex a be set st a in X.s & x = root-tree [a,s];
end;

registration
  let S be non void non empty ManySortedSign, X be non-empty ManySortedSet of
  the carrier of S, s be SortSymbol of S;
  cluster FreeGen(s,X) -> non empty;
end;

theorem 
  for S be non void non empty ManySortedSign, X be non-empty
ManySortedSet of the carrier of S, s be SortSymbol of S holds FreeGen(s,X) = {
root-tree t where t is Symbol of DTConMSA(X): t in Terminals DTConMSA(X) & t`2
  = s};

definition
  let S be non void non empty ManySortedSign, X be non-empty ManySortedSet of
  the carrier of S;
  func FreeGen(X) -> GeneratorSet of FreeMSA(X) means


  for s be SortSymbol of S holds it.s = FreeGen(s,X);
end;

theorem 
  for S be non void non empty ManySortedSign, X be non-empty
  ManySortedSet of the carrier of S holds FreeGen(X)is non-empty;

theorem 
  for S be non void non empty ManySortedSign, X be non-empty
  ManySortedSet of the carrier of S holds union rng FreeGen(X) = {root-tree t
  where t is Symbol of DTConMSA(X): t in Terminals DTConMSA(X)};

definition
  let S be non void non empty ManySortedSign, X be non-empty ManySortedSet of
  the carrier of S, s be SortSymbol of S;
  func Reverse(s,X) -> Function of FreeGen(s,X),X.s means


  for t be
Symbol of DTConMSA(X) st root-tree t in FreeGen(s,X) holds it.(root-tree t) = t
  `1;
end;

definition
  let S be non void non empty ManySortedSign, X be non-empty ManySortedSet of
  the carrier of S;
  func Reverse(X) -> ManySortedFunction of FreeGen(X),X means


  for s be SortSymbol of S holds it.s = Reverse(s,X);
end;

definition
  let S be non void non empty ManySortedSign, X be non-empty ManySortedSet of
  the carrier of S, A be non-empty ManySortedSet of the carrier of S, F be
  ManySortedFunction of FreeGen(X), A, t be Symbol of DTConMSA(X);
  assume
 t in Terminals (DTConMSA(X));
  func pi(F,A,t) -> Element of Union A means


  for f be Function st f = F.(t`2) holds it = f.(root-tree t);
end;

definition
  let S be non void non empty ManySortedSign, X be non-empty ManySortedSet of
  the carrier of S, t be Symbol of DTConMSA(X);
  assume
 ex p be FinSequence st t ==> p;
  func @(X,t) -> OperSymbol of S means


  [it,the carrier of S] = t;
end;

definition
  let S be non void non empty ManySortedSign, U0 be non-empty MSAlgebra over S
  , o be OperSymbol of S, p be FinSequence;
  assume
 p in Args(o,U0);
  func pi(o,U0,p) -> Element of Union (the Sorts of U0) equals


  Den(o,
  U0).p;
end;

theorem 
  for S be non void non empty ManySortedSign, X be non-empty
  ManySortedSet of the carrier of S holds FreeGen(X) is free;

theorem 
  for S be non void non empty ManySortedSign, X be non-empty
  ManySortedSet of the carrier of S holds FreeMSA(X) is free;

registration
  let S be non void non empty ManySortedSign;
  cluster free strict for non-empty MSAlgebra over S;
end;

registration
  let S be non void non empty ManySortedSign, U0 be free MSAlgebra over S;
  cluster free for GeneratorSet of U0;
end;

theorem 
  for S be non void non empty ManySortedSign, U1 be non-empty
  MSAlgebra over S ex U0 be strict free non-empty MSAlgebra over S, F be
  ManySortedFunction of U0,U1 st F is_epimorphism U0,U1;

theorem 
  for S be non void non empty ManySortedSign, U1 be strict non-empty
  MSAlgebra over S ex U0 be strict free non-empty MSAlgebra over S, F be
  ManySortedFunction of U0,U1 st F is_epimorphism U0,U1 & Image F = U1;














begin

reserve S for non void non empty ManySortedSign,
  U1 for MSAlgebra over S,
  o for OperSymbol of S,
  s for SortSymbol of S;

registration
  let I be set;
  cluster Relation-yielding for ManySortedSet of I;
end;

definition

  let I be set, A,B be ManySortedSet of I;
  mode ManySortedRelation of A,B -> ManySortedSet of I means


    for i be set st i in I holds it.i is Relation of A.i,B.i;
end;

registration
  let I be set, A,B be ManySortedSet of I;
  cluster -> Relation-yielding for ManySortedRelation of A,B;
end;

definition
  let I be set, A be ManySortedSet of I;
  mode ManySortedRelation of A is ManySortedRelation of A,A;
end;

definition
  let I be set, A be ManySortedSet of I;
  let IT be ManySortedRelation of A;
  attr IT is MSEquivalence_Relation-like means


  for i be set, R be
  Relation of A.i st i in I & IT.i = R holds R is Equivalence_Relation of A.i;
end;

definition
  let I be non empty set, A,B be ManySortedSet of I, F be ManySortedRelation
  of A,B, i be Element of I;
  redefine func F.i -> Relation of A.i,B.i;
end;

definition
  let S be non empty ManySortedSign, U1 be MSAlgebra over S;
  mode ManySortedRelation of U1 is ManySortedRelation of the Sorts of U1;
end;

definition
  let S be non empty ManySortedSign, U1 be MSAlgebra over S;
  let IT be ManySortedRelation of U1;

  attr IT is MSEquivalence-like means


  IT is MSEquivalence_Relation-like;
end;

registration
  let S be non void non empty ManySortedSign, U1 be MSAlgebra over S;
  cluster MSEquivalence-like for ManySortedRelation of U1;
end;

theorem 
  for R be MSEquivalence-like ManySortedRelation of U1 holds R.s is
  Equivalence_Relation of (the Sorts of U1).s;

definition
  let S be non void non empty ManySortedSign, U1 be non-empty MSAlgebra over S
  , R be MSEquivalence-like ManySortedRelation of U1;
  attr R is MSCongruence-like means


  for o be OperSymbol of S, x,y be
  Element of Args(o,U1) st (for n be Nat st n in dom x holds [x.n,y.n] in R.((
the_arity_of o)/.n)) holds [Den(o,U1).x,Den(o,U1).y] in R.(the_result_sort_of o
  );
end;

registration
  let S be non void non empty ManySortedSign, U1 be non-empty MSAlgebra over S;
  cluster MSCongruence-like for MSEquivalence-like ManySortedRelation of U1;
end;

definition
  let S be non void non empty ManySortedSign, U1 be non-empty MSAlgebra over S;
  mode MSCongruence of U1 is MSCongruence-like MSEquivalence-like
    ManySortedRelation of U1;
end;

definition
  let S be non void non empty ManySortedSign, U1 be MSAlgebra over S, R be
  MSEquivalence-like (ManySortedRelation of U1), i be Element of S;
  redefine func R.i -> Equivalence_Relation of ((the Sorts of U1).i);
end;

definition
  let S be non void non empty ManySortedSign, U1 be MSAlgebra over S, R be
  MSEquivalence-like (ManySortedRelation of U1), i be Element of S,
  x be Element of (the Sorts of U1).i;
  func Class(R,x) -> Subset of (the Sorts of U1).i equals

  Class(R.i,x);
end;

definition
  let S;
  let U1 be non-empty MSAlgebra over S;
  let R be MSCongruence of U1;
  func Class R -> non-empty ManySortedSet of the carrier of S means


  for s being Element of S holds it.s = Class (R.s);
end;

begin 

definition
  let S;
  let M1,M2 be ManySortedSet of the carrier' of S;
  let F be ManySortedFunction of M1,M2;
  let o be OperSymbol of S;
  redefine func F.o -> Function of M1.o,M2.o;
end;

registration
  let I be non empty set, p be FinSequence of I, X be ManySortedSet of I;
  cluster X * p -> dom p-defined for Function;
end;

registration
  let I be non empty set, p be FinSequence of I, X be ManySortedSet of I;
  cluster X * p -> total for dom p-defined Function;
end;

definition
  let S,o;
  let A be non-empty MSAlgebra over S;
  let R be MSCongruence of A;
  let x be Element of Args(o,A);
  func R # x -> Element of product ((Class R) * (the_arity_of o)) means


for n be Nat st n in dom (the_arity_of o) holds it.n = Class(R.((the_arity_of o
  )/.n),x.n);
end;

definition
  let S,o;
  let A be non-empty MSAlgebra over S;
  let R be MSCongruence of A;
  func QuotRes(R,o) -> Function of ((the Sorts of A) * the ResultSort of S).o,
  ((Class R) * the ResultSort of S).o means


  for x being Element of (the
  Sorts of A).(the_result_sort_of o) holds it.x = Class(R,x);
  func QuotArgs(R,o) -> Function of ((the Sorts of A)# * the Arity of S).o, ((
  Class R)# * the Arity of S).o means

  for x be Element of Args(o,A) holds it.x = R # x;
end;

definition
  let S;
  let A be non-empty MSAlgebra over S;
  let R be MSCongruence of A;
  func QuotRes R -> ManySortedFunction of ((the Sorts of A) * the ResultSort
  of S), ((Class R) * the ResultSort of S) means

  for o being OperSymbol of S holds it.o = QuotRes(R,o);
  func QuotArgs R -> ManySortedFunction of (the Sorts of A)# * the Arity of S,
  (Class R)# * the Arity of S means

  for o be OperSymbol of S holds it.o = QuotArgs(R,o);
end;

theorem 
  for A be non-empty MSAlgebra over S, R be MSCongruence of A, x be
set st x in ((Class R)# * the Arity of S).o ex a be Element of Args(o,A) st x =
  R # a;

definition
  let S,o;
  let A be non-empty MSAlgebra over S;
  let R be MSCongruence of A;
  func QuotCharact(R,o) -> Function of ((Class R)# * the Arity of S).o, ((
  Class R) * the ResultSort of S).o means


  for a be Element of Args(o,A)
st R # a in ((Class R)# * the Arity of S).o holds it.(R # a) = ((QuotRes(R,o))
  * (Den(o,A))).a;
end;

definition
  let S;
  let A be non-empty MSAlgebra over S;
  let R be MSCongruence of A;
  func QuotCharact R -> ManySortedFunction of (Class R)# * the Arity of S, (
  Class R) * the ResultSort of S means


  for o be OperSymbol of S holds it. o = QuotCharact(R,o);
end;

definition
  let S;
  let U1 be non-empty MSAlgebra over S;
  let R be MSCongruence of U1;
  func QuotMSAlg(U1,R) -> MSAlgebra over S equals

  MSAlgebra(# Class R,
    QuotCharact R #);
end;

registration
  let S;
  let U1 be non-empty MSAlgebra over S;
  let R be MSCongruence of U1;
  cluster QuotMSAlg (U1,R) -> strict non-empty;
end;

definition
  let S;
  let U1 be non-empty MSAlgebra over S;
  let R be MSCongruence of U1;
  let s be SortSymbol of S;
  func MSNat_Hom(U1,R,s) -> Function of (the Sorts of U1).s,(Class R).s means


  for x be set st x in (the Sorts of U1).s holds it.x = Class(R.s,x);
end;

definition
  let S;
  let U1 be non-empty MSAlgebra over S;
  let R be MSCongruence of U1;
  func MSNat_Hom(U1,R) -> ManySortedFunction of U1, QuotMSAlg (U1,R) means


   for s be SortSymbol of S holds it.s = MSNat_Hom(U1,R,s);
end;

theorem 
  for U1 be non-empty MSAlgebra over S, R be MSCongruence of U1 holds
  MSNat_Hom(U1,R) is_epimorphism U1, QuotMSAlg (U1,R);

definition
  let S;
  let U1,U2 be non-empty MSAlgebra over S;
  let F be ManySortedFunction of U1,U2;
  let s be SortSymbol of S;
  func MSCng(F,s) -> Equivalence_Relation of (the Sorts of U1).s means


for x,y be Element of (the Sorts of U1).s holds [x,y] in it iff (F.s).x = (F.s)
  .y;
end;

definition
  let S;
  let U1,U2 be non-empty MSAlgebra over S;
  let F be ManySortedFunction of U1,U2;
  assume
 F is_homomorphism U1,U2;
  func MSCng(F) -> MSCongruence of U1 means


  for s be SortSymbol of S holds it.s = MSCng(F,s);
end;

definition
  let S;
  let U1,U2 be non-empty MSAlgebra over S;
  let F be ManySortedFunction of U1,U2;
  let s be SortSymbol of S;
  assume
 F is_homomorphism U1,U2;
  func MSHomQuot(F,s) -> Function of (the Sorts of (QuotMSAlg (U1,MSCng F))).s
  ,(the Sorts of U2).s means


  for x be Element of (the Sorts of U1).s
  holds it.(Class(MSCng(F,s),x)) = (F.s).x;
end;

definition
  let S;
  let U1,U2 be non-empty MSAlgebra over S;
  let F be ManySortedFunction of U1,U2;
  func MSHomQuot(F) -> ManySortedFunction of (QuotMSAlg (U1, MSCng F)),U2
  means


  for s be SortSymbol of S holds it.s = MSHomQuot(F,s);
end;

theorem 
  for U1,U2 be non-empty MSAlgebra over S, F be ManySortedFunction
  of U1,U2 st F is_homomorphism U1,U2 holds MSHomQuot(F) is_monomorphism
  QuotMSAlg (U1,MSCng F),U2;

theorem 
  for U1,U2 be non-empty MSAlgebra over S, F be ManySortedFunction
of U1,U2 st F is_epimorphism U1,U2 holds MSHomQuot(F) is_isomorphism QuotMSAlg
  (U1,MSCng F),U2;

theorem 
  for U1,U2 be non-empty MSAlgebra over S, F be ManySortedFunction of U1
  ,U2 st F is_epimorphism U1,U2 holds QuotMSAlg (U1,MSCng F),U2 are_isomorphic;














begin

theorem 
  for f,g being Function st g in product f holds rng g c= Union f;

scheme 

  DTConstrUniq{DT()->non empty DTConstrStr, D()->non empty set, G(set) ->
Element of D(), H(set, set, set) -> Element of D(), f1, f2() -> Function of TS(
  DT()), D() }: f1() = f2()
provided
 for t being Symbol of DT() st t in Terminals DT()
     holds f1().(root-tree t) = G(t) and
 for nt being Symbol of DT(), ts being Element of (TS DT())*
     st nt ==> roots ts
    for x being Element of D()* st x = f1() * ts
     holds f1().(nt-tree ts) = H(nt, ts, x) and
 for t being Symbol of DT() st t in Terminals DT()
     holds f2().(root-tree t) = G(t) and
 for nt being Symbol of DT(), ts being Element of (TS DT())*
     st nt ==> roots ts
    for x being Element of D()* st x = f2() * ts
       holds f2().(nt-tree ts) = H(nt, ts, x);

theorem 
  for S being non void non empty ManySortedSign, X being
ManySortedSet of the carrier of S for o,b being set st [o,b] in REL(X) holds o
  in [:the carrier' of S,{the carrier of S}:] & b in ([:the carrier' of S,{the
  carrier of S}:] \/ Union coprod X)*;

theorem 
  for S being non void non empty ManySortedSign, X being ManySortedSet
of the carrier of S for o being OperSymbol of S, b being FinSequence st [[o,the
carrier of S],b] in REL(X) holds len b = len (the_arity_of o) & for x be set st
  x in dom b holds (b.x in [:the carrier' of S,{the carrier of S}:] implies for
  o1 be OperSymbol of S st [o1,the carrier of S] = b.x holds the_result_sort_of
  o1 = (the_arity_of o).x) & (b.x in Union(coprod X) implies b.x in coprod((
  the_arity_of o).x,X));

registration
  let I be non empty set, M be ManySortedSet of I;
  cluster rng M -> non empty;
end;

registration
  let I be set;
  cluster empty-yielding -> disjoint_valued for ManySortedSet of I;
end;

registration
  let I be set;
  cluster disjoint_valued for ManySortedSet of I;
end;

definition
  let I be non empty set;
  let X be disjoint_valued ManySortedSet of I;
  let D be non-empty ManySortedSet of I;
  let F be ManySortedFunction of X,D;
  func Flatten F -> Function of Union X, Union D means


  for i being Element of I, x being set st x in X.i holds it.x = F.i.x;
end;

theorem 
  for I being non empty set, X being disjoint_valued ManySortedSet
of I, D being non-empty ManySortedSet of I for F1,F2 be ManySortedFunction of X
  ,D st Flatten F1 = Flatten F2 holds F1 = F2;

definition
  let S be non empty ManySortedSign;
  let A be MSAlgebra over S;
  attr A is disjoint_valued means


  the Sorts of A is disjoint_valued;
end;

definition
  let S be non empty ManySortedSign;
  func SingleAlg S -> strict MSAlgebra over S means


  for i being set st i in the carrier of S holds (the Sorts of it).i = {i};
end;

registration
  let S be non empty ManySortedSign;
  cluster non-empty disjoint_valued for MSAlgebra over S;
end;

registration
  let S be non empty ManySortedSign;
  cluster SingleAlg S -> non-empty disjoint_valued;
end;

registration
  let S be non empty ManySortedSign;
  let A be disjoint_valued MSAlgebra over S;
  cluster the Sorts of A -> disjoint_valued;
end;

theorem 
  for S being non void non empty ManySortedSign, o being OperSymbol
  of S, A1 be non-empty disjoint_valued MSAlgebra over S, A2 be non-empty
MSAlgebra over S, f be ManySortedFunction of A1,A2, a be Element of Args(o,A1)
  holds (Flatten f)*a = f#a;

registration
  let S be non void non empty ManySortedSign, X be non-empty ManySortedSet of
  the carrier of S;
  cluster FreeSort X -> disjoint_valued;
end;

scheme 
 FreeSortUniq{ S() -> non void non empty ManySortedSign,
    X,D() -> non-empty ManySortedSet of the carrier of S(),
    G(set) -> Element of Union D(),
    H(set, set, set) -> Element of Union D(),
    f1, f2() -> ManySortedFunction of FreeSort X(),D() }:
   f1() = f2()
provided
 for o being OperSymbol of S(), ts being Element of Args(o,FreeMSA X())
   for x being Element of (Union D())* st x = (Flatten f1()) * ts holds
     f1().(the_result_sort_of o).(Den(o,FreeMSA X()).ts) = H(o, ts, x) and
 for s being SortSymbol of S(), y be set st y in FreeGen(s,X())
     holds f1().s.y = G(y) and
 for o being OperSymbol of S(), ts being Element of Args(o,FreeMSA X())
   for x being Element of (Union D())* st x = (Flatten f2()) * ts holds
    f2().(the_result_sort_of o).(Den(o,FreeMSA X()).ts) = H(o, ts, x) and
 for s being SortSymbol of S(), y be set st y in FreeGen(s,X())
      holds f2().s.y = G(y);

registration
  let S be non void non empty ManySortedSign;
  let X be non-empty ManySortedSet of the carrier of S;
  cluster FreeMSA X -> non-empty;
end;

registration
  let S be non void non empty ManySortedSign;
  let o be OperSymbol of S;
  let A be non-empty MSAlgebra over S;
  cluster Args(o,A) -> non empty;
  cluster Result(o,A) -> non empty;
end;

registration
  let S be non void non empty ManySortedSign, X be non-empty ManySortedSet of
  the carrier of S;
  cluster the Sorts of FreeMSA X -> disjoint_valued;
end;

registration
  let S be non void non empty ManySortedSign, X be non-empty ManySortedSet of
  the carrier of S;
  cluster FreeMSA X -> disjoint_valued;
end;

scheme 

  ExtFreeGen{ S() -> non void non empty ManySortedSign, X() -> non-empty
ManySortedSet of the carrier of S(), MSA() -> non-empty MSAlgebra over S(), P[
set,set,set], IT1, IT2() -> ManySortedFunction of FreeMSA X(), MSA() }: IT1() =
  IT2()
provided
 IT1() is_homomorphism FreeMSA X(), MSA() and
 for s being SortSymbol of S(), x,y being set st y in FreeGen(s,X())
holds IT1().s.y = x iff P[s,x,y] and
 IT2() is_homomorphism FreeMSA X(), MSA() and
 for s being SortSymbol of S(), x,y being set st y in FreeGen(s,X())
holds IT2().s.y = x iff P[s,x,y];














begin





definition
  let S be ManySortedSign;
  mode Vertex of S is Element of S;
end;

definition
  let S be non empty ManySortedSign;
  func SortsWithConstants S -> Subset of S equals


  { v where v is
  SortSymbol of S : v is with_const_op } if S is non void otherwise {};
end;

definition
  let G be non empty ManySortedSign;
  func InputVertices G -> Subset of G equals

  (the carrier of G) \ rng the ResultSort of G;
  func InnerVertices G -> Subset of G equals

  rng the ResultSort of G;
end;

theorem 
  for G being void non empty ManySortedSign holds InputVertices G = the
  carrier of G;

theorem 
  for G being non void non empty ManySortedSign, v being Vertex of
  G st v in InputVertices G holds not ex o being OperSymbol of G st
  the_result_sort_of o = v;

theorem 
  for G being non empty ManySortedSign holds SortsWithConstants G
  c= InnerVertices G;

theorem 
  for G being non empty ManySortedSign holds InputVertices G misses
  SortsWithConstants G;

definition
  let IT be non empty ManySortedSign;
  attr IT is with_input_V means


  InputVertices IT <> {};
end;

registration
  cluster non void with_input_V for non empty ManySortedSign;
end;

registration
  let G be with_input_V non empty ManySortedSign;
  cluster InputVertices G -> non empty;
end;

registration
  let G be non void non empty ManySortedSign;
  cluster InnerVertices G -> non empty;
end;

definition
  let S be non empty ManySortedSign;
  let MSA be non-empty MSAlgebra over S;
  mode InputValues of MSA -> ManySortedSet of InputVertices S means

    for v
being Vertex of S st v in InputVertices S holds it.v in (the Sorts of MSA).v;
end;



definition
  let S be non empty ManySortedSign;
  attr S is Circuit-like means


  for S9 being non void non empty
  ManySortedSign st S9 = S for o1, o2 being OperSymbol of S9 st
  the_result_sort_of o1 = the_result_sort_of o2 holds o1 = o2;
end;

registration
  cluster void -> Circuit-like for non empty ManySortedSign;
end;

registration
  cluster non void Circuit-like strict for non empty ManySortedSign;
end;

definition
  let IIG be Circuit-like non void non empty ManySortedSign;
  let v be Vertex of IIG such that
 v in InnerVertices IIG;
  func action_at v -> OperSymbol of IIG means

  the_result_sort_of it = v;
end;

begin





theorem 
  for S being non void non empty ManySortedSign, A being MSAlgebra over
S, o being OperSymbol of S, p being FinSequence st len p = len the_arity_of o &
for k being Nat st k in dom p holds p.k in (the Sorts of A).((the_arity_of o)/.
  k) holds p in Args (o, A);

definition
  let S be non void non empty ManySortedSign, MSA be non-empty MSAlgebra over
  S;
  func FreeEnv MSA -> free strict non-empty MSAlgebra over S equals

  FreeMSA
  (the Sorts of MSA);
end;

definition
  let S be non void non empty ManySortedSign, MSA be non-empty MSAlgebra over
  S;
  func Eval MSA -> ManySortedFunction of FreeEnv MSA, MSA means

  it
is_homomorphism FreeEnv MSA, MSA & for s being SortSymbol of S, x, y being set
st y in FreeSort(the Sorts of MSA, s) & y = root-tree [x, s] & x in (the Sorts
  of MSA).s holds it.s.y = x;
end;

theorem 
  for S being non void non empty ManySortedSign, A being non-empty
  MSAlgebra over S holds the Sorts of A is GeneratorSet of A;

definition
  let S be non empty ManySortedSign;
  let IT be MSAlgebra over S;
  attr IT is finitely-generated means


  for S9 being non void non empty
  ManySortedSign st S9 = S for A being MSAlgebra over S9 st A = IT ex G being
GeneratorSet of A st G is finite-yielding if S is not void otherwise the Sorts
  of IT is finite-yielding;
end;

definition
  let S be non empty ManySortedSign;
  let IT be MSAlgebra over S;
  attr IT is finite-yielding means


  the Sorts of IT is finite-yielding;
end;

registration
  let S be non empty ManySortedSign;
  cluster finite-yielding -> finitely-generated for
non-empty MSAlgebra over S;
end;

definition
  let S be non empty ManySortedSign;
  func Trivial_Algebra S -> strict MSAlgebra over S means


  the Sorts of it = (the carrier of S) --> {0};
end;

registration
  let S be non empty ManySortedSign;
  cluster finite-yielding non-empty strict for MSAlgebra over S;
end;

definition
  let IT be non empty ManySortedSign;
  attr IT is monotonic means

  for A being finitely-generated non-empty
  MSAlgebra over IT holds A is finite-yielding;
end;

registration
  cluster non void finite monotonic Circuit-like for
non empty ManySortedSign;
end;

theorem 
  for S being non void non empty ManySortedSign for X being
non-empty ManySortedSet of the carrier of S, v be SortSymbol of S, e be Element
  of (the Sorts of FreeMSA X).v holds e is finite DecoratedTree;

theorem 
  for S being non void non empty ManySortedSign, X being non-empty
  finite-yielding ManySortedSet of the carrier of S holds FreeMSA X is
  finitely-generated;

theorem 
  for S being non void non empty ManySortedSign, A being non-empty
MSAlgebra over S, v being Vertex of S, e being Element of (the Sorts of FreeEnv
  A).v st v in InputVertices S ex x being Element of (the Sorts of A).v st e =
  root-tree [x, v];

theorem 
  for S being non void non empty ManySortedSign, X being non-empty
  ManySortedSet of the carrier of S, o being OperSymbol of S, p being
  DTree-yielding FinSequence st [o,the carrier of S]-tree p in (the Sorts of
  FreeMSA X).(the_result_sort_of o) holds len p = len the_arity_of o;

theorem 
  for S being non void non empty ManySortedSign, X being non-empty
  ManySortedSet of the carrier of S, o being OperSymbol of S, p being
  DTree-yielding FinSequence st [o,the carrier of S]-tree p in (the Sorts of
  FreeMSA X).(the_result_sort_of o) holds for i being Nat st i in dom
  the_arity_of o holds p.i in (the Sorts of FreeMSA X).((the_arity_of o).i);

registration
  let S be non void non empty ManySortedSign, X be non-empty ManySortedSet of
  the carrier of S, v be Vertex of S;
  cluster -> finite non empty Function-like Relation-like for Element of (the
    Sorts of FreeMSA X).v;
end;

registration
  let S be non void non empty ManySortedSign, X be non-empty ManySortedSet of
  the carrier of S, v be Vertex of S;
  cluster Function-like Relation-like for
Element of (the Sorts of FreeMSA X).v;
end;

registration
  let S be non void non empty ManySortedSign, X be non-empty ManySortedSet of
  the carrier of S, v be Vertex of S;
  cluster -> DecoratedTree-like for
Function-like Relation-like Element of (the
    Sorts of FreeMSA X).v;
end;

registration
  let IIG be non void non empty ManySortedSign;
  let X be non-empty ManySortedSet of the carrier of IIG, v be Vertex of IIG;
  cluster finite for Element of (the Sorts of FreeMSA X).v;
end;

theorem 
  for S being non void non empty ManySortedSign, X being non-empty
ManySortedSet of the carrier of S, v being Vertex of S, o being OperSymbol of S
, e being Element of (the Sorts of FreeMSA X).v st e.{} = [o,the carrier of S]
  ex p being DTree-yielding FinSequence st len p = len the_arity_of o & for i
being Nat st i in dom p holds p.i in (the Sorts of FreeMSA X).((the_arity_of o)
  .i);

definition
  let S be non void non empty ManySortedSign, X be non-empty ManySortedSet of
the carrier of S, v be SortSymbol of S, e be Element of (the Sorts of FreeMSA X
  ).v;
  func depth e -> Nat means

  ex dt being finite DecoratedTree, t being finite
  Tree st dt = e & t = dom dt & it = height t;
end;














begin



reserve I,X,x,d,i for set;
reserve M for ManySortedSet of I;

reserve EqR1,EqR2 for Equivalence_Relation of X;

definition
  let X be set, R be Relation of X;
  func EqCl R -> Equivalence_Relation of X means


  R c= it & for EqR2 be
  Equivalence_Relation of X st R c= EqR2 holds it c= EqR2;
end;

theorem 
  EqR1 "\/" EqR2 = EqCl (EqR1 \/ EqR2);

theorem 
  EqCl EqR1 = EqR1;

begin



definition
  let X be set;
  func EqRelLatt X -> strict Lattice means

  the carrier of it = {x where x is
  Relation of X,X : x is Equivalence_Relation of X} & for x,y being
Equivalence_Relation of X holds (the L_meet of it).(x,y) = x /\ y & (the L_join
  of it).(x,y) = x "\/" y;
end;

begin



registration
  let I,M;
  cluster MSEquivalence_Relation-like for ManySortedRelation of M;
end;

definition
  let I,M;
  mode Equivalence_Relation of M is MSEquivalence_Relation-like
    ManySortedRelation of M;
end;

reserve I for non empty set;
reserve M for ManySortedSet of I;
reserve EqR,EqR1,EqR2,EqR3,EqR4 for Equivalence_Relation of M;

definition
  let I be non empty set;
  let M be ManySortedSet of I, R be ManySortedRelation of M;
  func EqCl R -> Equivalence_Relation of M means


  for i being Element of I holds it.i = EqCl(R.i);
end;

theorem 
  EqCl EqR = EqR;

begin



definition
  let I be non empty set, M be ManySortedSet of I;
  let EqR1,EqR2 be Equivalence_Relation of M;
  func EqR1 "\/" EqR2 -> Equivalence_Relation of M means


  ex EqR3 being
  ManySortedRelation of M st EqR3 = EqR1 \/ EqR2 & it = EqCl EqR3;
  commutativity;
end;

theorem 
  EqR1 \/ EqR2 c= EqR1 "\/" EqR2;

theorem 
  for EqR be Equivalence_Relation of M st EqR1 \/ EqR2 c= EqR holds
  EqR1 "\/" EqR2 c= EqR;

theorem 
  ( EqR1 \/ EqR2 c= EqR3 & for EqR be Equivalence_Relation of M st
  EqR1 \/ EqR2 c= EqR holds EqR3 c= EqR ) implies EqR3 = EqR1 "\/" EqR2;

theorem 
  EqR "\/" EqR = EqR;

theorem 
  (EqR1 "\/" EqR2) "\/" EqR3 = EqR1 "\/" (EqR2 "\/" EqR3);

theorem 
  EqR1 /\ (EqR1 "\/" EqR2) = EqR1;

theorem 
  for EqR be Equivalence_Relation of M st EqR = EqR1 /\ EqR2 holds
  EqR1 "\/" EqR = EqR1;

theorem 
  for EqR1,EqR2 be Equivalence_Relation of M holds EqR1 /\ EqR2 is
  Equivalence_Relation of M;

definition
  let I be non empty set;
  let M be ManySortedSet of I;
  func EqRelLatt M -> strict Lattice means


  (for x being set holds x in
  the carrier of it iff x is Equivalence_Relation of M) & for x,y being
Equivalence_Relation of M holds (the L_meet of it).(x,y) = x /\ y & (the L_join
  of it).(x,y) = x "\/" y;
end;

begin



registration
  let S be non empty ManySortedSign;
  let A be MSAlgebra over S;
  cluster MSEquivalence-like -> MSEquivalence_Relation-like for
ManySortedRelation
    of A;
end;

reserve S for non void non empty ManySortedSign;
reserve A for non-empty MSAlgebra over S;

theorem 
  for o be OperSymbol of S for C1,C2 being MSCongruence of A for
x1,y1 be set for a1,b1 be FinSequence holds [x1,y1] in C1.((the_arity_of o)/.(
len a1 + 1)) \/ C2.((the_arity_of o)/.(len a1 + 1)) implies for x,y be Element
of Args(o,A) st x = (a1 ^ <*x1*> ^ b1) & y = (a1 ^ <*y1*> ^ b1) holds [Den(o,A)
  .x,Den(o,A).y] in C1.(the_result_sort_of o) \/ C2.(the_result_sort_of o);

theorem 
  for o be OperSymbol of S for C1,C2 being MSCongruence of A for C
being MSEquivalence-like ManySortedRelation of A st C = C1 "\/" C2 for x1,y1 be
set for n be Element of NAT for a1,a2,b1 being FinSequence st len a1 = n & len
a1 = len a2 & for k be Element of NAT st k in dom a1 holds [a1.k,a2.k] in C.((
the_arity_of o)/.k) holds ( [Den(o,A).(a1 ^ <*x1*> ^ b1),Den(o,A).(a2 ^ <*x1*>
  ^ b1)] in C.(the_result_sort_of o) & [x1,y1] in C.((the_arity_of o)/.(n+1))
implies for x be Element of Args(o,A) st x = a1 ^ <*x1*> ^ b1 holds [Den(o,A).x
  ,Den(o,A).(a2 ^ <*y1*> ^ b1)] in C.(the_result_sort_of o));

theorem 
  for o be OperSymbol of S for C1,C2 being MSCongruence of A for C
  being MSEquivalence-like ManySortedRelation of A st C = C1 "\/" C2 for x,y be
Element of Args(o,A) holds (( for n be Nat st n in dom x holds [x.n,y.n] in C.(
(the_arity_of o)/.n)) implies [Den(o,A).x,Den(o,A).y] in C.(the_result_sort_of
  o));

theorem 
  for C1,C2 being MSCongruence of A holds C1 "\/" C2 is MSCongruence of A;

theorem 
  for C1,C2 being MSCongruence of A holds C1 /\ C2 is MSCongruence of A;

definition
  let S;
  let A be non-empty MSAlgebra over S;
  func CongrLatt A -> strict SubLattice of EqRelLatt the Sorts of A means


   for
 x being set holds x in the carrier of it iff x is MSCongruence of A;
end;

theorem 
  id (the Sorts of A) is MSCongruence of A;

theorem 
  [|the Sorts of A,the Sorts of A|] is MSCongruence of A;

registration
  let S, A;
  cluster CongrLatt A -> bounded;
end;

theorem 
  Bottom CongrLatt A = id (the Sorts of A);

theorem 
  Top CongrLatt A = [|the Sorts of A,the Sorts of A|];



theorem 
  for X be set holds x in the carrier of EqRelLatt X iff x is
  Equivalence_Relation of X;














begin 

reserve V for RealLinearSpace;

theorem 
  for W1,W2 being Subspace of V holds the carrier of W1 c= the
  carrier of W1 + W2;

theorem 
  for W1,W2 being Subspace of V st V is_the_direct_sum_of W1,W2
for v,v1,v2 being VECTOR of V st v1 in W1 & v2 in W2 & v = v1 + v2 holds v |--
  (W1,W2) = [v1,v2];

theorem 
  for W1,W2 being Subspace of V st V is_the_direct_sum_of W1,W2
  for v,v1,v2 being VECTOR of V st v |-- (W1,W2) = [v1,v2] holds v = v1 + v2;

theorem 
  for W1,W2 being Subspace of V st V is_the_direct_sum_of W1,W2
for v,v1,v2 being VECTOR of V st v |-- (W1,W2) = [v1,v2] holds v1 in W1 & v2 in
  W2;

theorem 
  for W1,W2 being Subspace of V st V is_the_direct_sum_of W1,W2
for v,v1,v2 being VECTOR of V st v |-- (W1,W2) = [v1,v2] holds v |-- (W2,W1) =
  [v2,v1];

theorem 
  for W1,W2 being Subspace of V st V is_the_direct_sum_of W1,W2
  for v being VECTOR of V st v in W1 holds v |-- (W1,W2) = [v,0.V];

theorem 
  for W1,W2 being Subspace of V st V is_the_direct_sum_of W1,W2
  for v being VECTOR of V st v in W2 holds v |-- (W1,W2) = [0.V,v];

theorem 
  for V1 being Subspace of V, W1 being Subspace of V1, v being
  VECTOR of V st v in W1 holds v is VECTOR of V1;

theorem 
  for V1,V2,W being Subspace of V, W1,W2 being Subspace of W st W1
  = V1 & W2 = V2 holds W1 + W2 = V1 + V2;

theorem 
  for W being Subspace of V for v being VECTOR of V, w being
  VECTOR of W st v = w holds Lin{w} = Lin{v};

theorem 
  for v being VECTOR of V, X being Subspace of V st not v in X for
  y being VECTOR of X + Lin{v}, W being Subspace of X + Lin{v} st v = y & W = X
  holds X + Lin{v} is_the_direct_sum_of W,Lin{y};

theorem 
  for v being VECTOR of V, X being Subspace of V, y being VECTOR
  of X + Lin{v}, W being Subspace of X + Lin{v} st v = y & X = W & not v in X
  holds y |-- (W,Lin{y}) = [0.W,y];

theorem 
  for v being VECTOR of V, X being Subspace of V, y being VECTOR
of X + Lin{v}, W being Subspace of X + Lin{v} st v = y & X = W & not v in X for
  w being VECTOR of X + Lin{v} st w in X holds w |-- (W,Lin{y}) = [w,0.V];

theorem 
  for v being VECTOR of V, W1,W2 being Subspace of V ex v1,v2
  being VECTOR of V st v |-- (W1,W2) = [v1,v2];

theorem 
  for v being VECTOR of V, X being Subspace of V, y being VECTOR
of X + Lin{v}, W being Subspace of X + Lin{v} st v = y & X = W & not v in X for
w being VECTOR of X + Lin{v} ex x being VECTOR of X, r being Real st w |-- (W,
  Lin{y}) = [x,r*v];

theorem 
  for v being VECTOR of V, X being Subspace of V, y being VECTOR
of X + Lin{v}, W being Subspace of X + Lin{v} st v = y & X = W & not v in X for
w1,w2 being VECTOR of X + Lin{v}, x1,x2 being VECTOR of X, r1,r2 being Real st
w1 |-- (W,Lin{y}) = [x1,r1*v] & w2 |-- (W,Lin{y}) = [x2,r2*v] holds w1 + w2 |--
  (W,Lin{y}) = [x1 + x2, (r1+r2)*v];

theorem 
  for v being VECTOR of V, X being Subspace of V, y being VECTOR
of X + Lin{v}, W being Subspace of X + Lin{v} st v = y & X = W & not v in X for
w being VECTOR of X + Lin{v}, x being VECTOR of X, t,r being Real st w |-- (W,
  Lin{y}) = [x,r*v] holds t*w |-- (W,Lin{y}) = [t*x, t*r*v];

begin 

definition
  let V be RLSStruct;
  mode Functional of V is Function of the carrier of V,REAL;
end;

definition
  let V;
  let IT be Functional of V;

  attr IT is subadditive means


  for x,y being VECTOR of V holds IT.(x+y) <= IT.x+IT.y;
  attr IT is additive means


  for x,y being VECTOR of V holds IT.(x+y) = IT.x+IT.y;
  attr IT is homogeneous means


  for x being VECTOR of V, r being Real holds IT.(r*x) = r*IT.x;
  attr IT is positively_homogeneous means


  for x being VECTOR of V, r being Real st r > 0 holds IT.(r*x) = r*IT.x;
  attr IT is semi-homogeneous means


  for x being VECTOR of V, r being Real st r >= 0 holds IT.(r*x) = r*IT.x;
  attr IT is absolutely_homogeneous means


  for x being VECTOR of V, r being Real holds IT.(r*x) = abs(r)*IT.x;
  attr IT is 0-preserving means


  IT.(0.V) = 0;
end;

registration
  let V;
  cluster additive -> subadditive for Functional of V;
  cluster homogeneous -> positively_homogeneous for Functional of V;
  cluster semi-homogeneous -> positively_homogeneous for Functional of V;
  cluster semi-homogeneous -> 0-preserving for Functional of V;
  cluster absolutely_homogeneous -> semi-homogeneous for Functional of V;
  cluster 0-preserving positively_homogeneous -> semi-homogeneous for
Functional
    of V;
end;

registration
  let V;
  cluster additive absolutely_homogeneous homogeneous for Functional of V;
end;

definition
  let V;
  mode Banach-Functional of V is subadditive positively_homogeneous Functional
    of V;
  mode linear-Functional of V is additive homogeneous Functional of V;
end;

theorem 
  for L being homogeneous Functional of V, v being VECTOR of V
  holds L.(-v) = - L.v;

theorem 
  for L being linear-Functional of V, v1,v2 being VECTOR of V
  holds L.(v1 - v2) = L.v1 - L.v2;

theorem 
  for L being additive Functional of V holds L.(0.V) = 0;

theorem 
  for X being Subspace of V, fi being linear-Functional of X, v
  being VECTOR of V, y being VECTOR of X + Lin{v} st v = y & not v in X for r
being Real ex psi being linear-Functional of X + Lin{v} st psi|the carrier of X
  =fi & psi.y = r;

begin

theorem 
  for V being RealLinearSpace, X being Subspace of V, q being
  Banach-Functional of V, fi being linear-Functional of X st for x being VECTOR
  of X, v being VECTOR of V st x=v holds fi.x <= q.v ex psi being
  linear-Functional of V st psi|the carrier of X=fi & for x being VECTOR of V
  holds psi.x <= q.x;

theorem 
  for V being RealNormSpace holds the normF of V is
  absolutely_homogeneous subadditive Functional of V;


theorem 
  for V being RealNormSpace, X being Subspace of V, fi being
  linear-Functional of X st for x being VECTOR of X, v being VECTOR of V st x=v
holds fi.x <= ||.v.|| ex psi being linear-Functional of V st psi|the carrier of
  X=fi & for x being VECTOR of V holds psi.x <= ||.x.||;














begin  

reserve i, x, I for set,
  A, B, M for ManySortedSet of I,
  f, f1 for Function;

notation
  let I, A, B;
  synonym A in' B for A in B;
end;

notation
  let I, A, B;
  synonym A c=' B for A c= B;
end;

theorem 
  for M being non empty set for X, Y being Element of M st X c= Y holds
  (id M).X c= (id M).Y;

theorem 
  for I being non empty set for A being ManySortedSet of I for B
  being ManySortedSubset of A holds rng B c= union rng bool A;

begin  

definition
  let I, M;
  func Bool M -> set means


  x in it iff x is ManySortedSubset of M;
end;

registration
  let I, M;
  cluster Bool M -> non empty functional with_common_domain;
end;

definition
  let I, M;
  mode SubsetFamily of M is Subset of Bool M;
end;

definition
  let I, M;
  redefine func Bool M -> SubsetFamily of M;
end;

registration
  let I, M;
  cluster non empty functional with_common_domain for SubsetFamily of M;
end;

registration
  let I, M;
  cluster empty finite for SubsetFamily of M;
end;

reserve SF, SG for SubsetFamily of M;

definition
  let I, M;
  let S be non empty SubsetFamily of M;
  redefine mode Element of S -> ManySortedSubset of M;
end;

theorem 
  SF \/ SG is SubsetFamily of M;

theorem 
  SF /\ SG is SubsetFamily of M;

theorem 
  SF \ x is SubsetFamily of M;

theorem 
  SF \+\ SG is SubsetFamily of M;

theorem 
  A c= M implies {A} is SubsetFamily of M;

theorem 
  A c= M & B c= M implies {A,B} is SubsetFamily of M;

reserve E, T for Element of Bool M;

theorem 
  E /\ T in Bool M;

theorem 
  E \/ T in Bool M;

theorem 
  E \ A in Bool M;

theorem 
  E \+\ T in Bool M;

begin  


definition
  let S be functional set;

  func |. S .| -> Function means


  ex A being non empty functional set st
  A = S & dom it = meet { dom x where x is Element of A : not contradiction } &
  for i st i in dom it holds it.i = { x.i where x is Element of A : not
  contradiction } if S <> {} otherwise it = {};
end;

theorem 
  for SF being non empty SubsetFamily of M holds dom |.SF.| = I;

registration
  let S be empty functional set;
  cluster |. S .| -> empty;
end;

definition
  let I, M;
  let S be SubsetFamily of M;
  func |: S :| -> ManySortedSet of I equals


  |. S .| if S <> {}
  otherwise [[0]]I;
end;

registration
  let I, M;
  let S be empty SubsetFamily of M;
  cluster |: S :| -> empty-yielding;
end;

theorem 
  SF is non empty implies for i st i in I holds |:SF:|.i = { x.i
  where x is Element of Bool M : x in SF };

registration
  let I, M;
  let SF be non empty SubsetFamily of M;
  cluster |: SF :| -> non-empty;
end;

theorem 
  dom |.{f}.| = dom f;

theorem 
  dom |.{f,f1}.| = dom f /\ dom f1;

theorem 
  i in dom f implies |.{f}.|.i = {f.i};

theorem 
  i in I & SF = {f} implies |:SF:|.i = {f.i};

theorem 
  i in dom |.{f,f1}.| implies |.{f,f1}.|.i = { f.i, f1.i };

theorem 
  i in I & SF = {f,f1} implies |:SF:|.i = { f.i, f1.i };

definition
  let I, M, SF;
  redefine func |:SF:| -> MSSubsetFamily of M;
end;

theorem 
  A in SF implies A in' |:SF:|;

theorem 
  SF = {A,B} implies union |:SF:| = A \/ B;

theorem 
  SF = {E,T} implies meet |:SF:| = E /\ T;

theorem 
  for Z being ManySortedSubset of M st for Z1 being ManySortedSet
  of I st Z1 in SF holds Z c=' Z1 holds Z c=' meet |:SF:|;

theorem 
  |: Bool M :| = bool M;

definition
  let I, M;
  let IT be SubsetFamily of M;
  attr IT is additive means

  for A, B st A in IT & B in IT holds A \/ B in IT;
  attr IT is absolutely-additive means


  for F be SubsetFamily of M st F c= IT holds union |:F:| in IT;
  attr IT is multiplicative means

  for A, B st A in IT & B in IT holds A /\ B in IT;
  attr IT is absolutely-multiplicative means


  for F be SubsetFamily of M st F c= IT holds meet |:F:| in IT;
  attr IT is properly-upper-bound means


  M in IT;
  attr IT is properly-lower-bound means


  [[0]]I in IT;
end;

registration
  let I, M;
  cluster non empty functional with_common_domain additive absolutely-additive
    multiplicative absolutely-multiplicative properly-upper-bound
    properly-lower-bound for SubsetFamily of M;
end;

definition
  let I, M;
  redefine func Bool M -> additive absolutely-additive multiplicative
  absolutely-multiplicative properly-upper-bound properly-lower-bound
  SubsetFamily of M;
end;

registration
  let I, M;
  cluster absolutely-additive -> additive for SubsetFamily of M;
end;

registration
  let I, M;
  cluster absolutely-multiplicative -> multiplicative for SubsetFamily of M;
end;

registration
  let I, M;
  cluster absolutely-multiplicative -> properly-upper-bound for
SubsetFamily of M;
end;

registration
  let I, M;
  cluster properly-upper-bound -> non empty for SubsetFamily of M;
end;

registration
  let I, M;
  cluster absolutely-additive -> properly-lower-bound for SubsetFamily of M;
end;

registration
  let I, M;
  cluster properly-lower-bound -> non empty for SubsetFamily of M;
end;

begin  

definition
  let I, M;
  mode SetOp of M is Function of Bool M, Bool M;
end;

definition
  let I, M;
  let f be SetOp of M;
  let x be Element of Bool M;
  redefine func f.x -> Element of Bool M;
end;

definition
  let I, M;
  let IT be SetOp of M;

  attr IT is reflexive means


  for x being Element of Bool M holds x c=' IT.x;
  attr IT is monotonic means


  for x, y being Element of Bool M st x c=' y holds IT.x c=' IT.y;
  attr IT is idempotent means


  for x being Element of Bool M holds IT.x = IT.(IT.x);
  attr IT is topological means


  for x, y being Element of Bool M holds IT.(x \/ y) = (IT.x) \/ (IT.y);
end;

registration
  let I, M;
  cluster reflexive monotonic idempotent topological for SetOp of M;
end;

theorem 
  id (Bool A) is reflexive SetOp of A;

theorem 
  id (Bool A) is monotonic SetOp of A;

theorem 
  id (Bool A) is idempotent SetOp of A;

theorem 
  id (Bool A) is topological SetOp of A;

reserve g, h for SetOp of M;

theorem 
  E = M & g is reflexive implies E = g.E;

theorem 
  (g is reflexive & for X being Element of Bool M holds g.X c= X)
  implies g is idempotent;

theorem 
  for A being Element of Bool M st A = E /\ T holds g is monotonic
  implies g.A c= g.E /\ g.T;

registration
  let I, M;
  cluster topological -> monotonic for SetOp of M;
end;

theorem 
  for A being Element of Bool M st A = E \ T holds g is topological
  implies g.E \ g.T c= g.A;

definition
  let I, M, h, g;
  redefine func g * h -> SetOp of M;
end;

theorem 
  g is reflexive & h is reflexive implies g * h is reflexive;

theorem 
  g is monotonic & h is monotonic implies g * h is monotonic;

theorem 
  g is idempotent & h is idempotent & g*h = h*g implies g * h is idempotent;

theorem 
  g is topological & h is topological implies g * h is topological;

begin  

reserve S for 1-sorted;

definition
  let S;
  struct(many-sorted over S) ClosureStr over S (# Sorts -> ManySortedSet of
    the carrier of S, Family -> SubsetFamily of the Sorts #);
end;

reserve MS for many-sorted over S;

definition
  let S;
  let IT be ClosureStr over S;
  attr IT is additive means


  the Family of IT is additive;
  attr IT is absolutely-additive means


  the Family of IT is absolutely-additive;
  attr IT is multiplicative means


  the Family of IT is multiplicative;
  attr IT is absolutely-multiplicative means


  the Family of IT is absolutely-multiplicative;
  attr IT is properly-upper-bound means


  the Family of IT is properly-upper-bound;
  attr IT is properly-lower-bound means


  the Family of IT is properly-lower-bound;
end;

definition
  let S, MS;
  func Full MS -> ClosureStr over S equals

  ClosureStr (#the Sorts of MS, Bool the Sorts of MS#);
end;

registration
  let S, MS;
  cluster Full MS -> strict additive absolutely-additive multiplicative
    absolutely-multiplicative properly-upper-bound properly-lower-bound;
end;

registration
  let S;
  let MS be non-empty many-sorted over S;
  cluster Full MS -> non-empty;
end;

registration
  let S;
  cluster strict non-empty additive absolutely-additive multiplicative
absolutely-multiplicative properly-upper-bound properly-lower-bound for
ClosureStr
    over S;
end;

registration
  let S;
  let CS be additive ClosureStr over S;
  cluster the Family of CS -> additive;
end;

registration
  let S;
  let CS be absolutely-additive ClosureStr over S;
  cluster the Family of CS -> absolutely-additive;
end;

registration
  let S;
  let CS be multiplicative ClosureStr over S;
  cluster the Family of CS -> multiplicative;
end;

registration
  let S;
  let CS be absolutely-multiplicative ClosureStr over S;
  cluster the Family of CS -> absolutely-multiplicative;
end;

registration
  let S;
  let CS be properly-upper-bound ClosureStr over S;
  cluster the Family of CS -> properly-upper-bound;
end;

registration
  let S;
  let CS be properly-lower-bound ClosureStr over S;
  cluster the Family of CS -> properly-lower-bound;
end;

registration
  let S;
  let M be non-empty ManySortedSet of the carrier of S;
  let F be SubsetFamily of M;
  cluster ClosureStr (#M, F#) -> non-empty;
end;

registration
  let S, MS;
  let F be additive SubsetFamily of the Sorts of MS;
  cluster ClosureStr (#the Sorts of MS, F#) -> additive;
end;

registration
  let S, MS;
  let F be absolutely-additive SubsetFamily of the Sorts of MS;
  cluster ClosureStr (#the Sorts of MS, F#) -> absolutely-additive;
end;

registration
  let S, MS;
  let F be multiplicative SubsetFamily of the Sorts of MS;
  cluster ClosureStr (#the Sorts of MS, F#) -> multiplicative;
end;

registration
  let S, MS;
  let F be absolutely-multiplicative SubsetFamily of the Sorts of MS;
  cluster ClosureStr (#the Sorts of MS, F#) -> absolutely-multiplicative;
end;

registration
  let S, MS;
  let F be properly-upper-bound SubsetFamily of the Sorts of MS;
  cluster ClosureStr (#the Sorts of MS, F#) -> properly-upper-bound;
end;

registration
  let S, MS;
  let F be properly-lower-bound SubsetFamily of the Sorts of MS;
  cluster ClosureStr (#the Sorts of MS, F#) -> properly-lower-bound;
end;

registration
  let S;
  cluster absolutely-additive -> additive for ClosureStr over S;
end;

registration
  let S;
  cluster absolutely-multiplicative -> multiplicative for ClosureStr over S;
end;

registration
  let S;
  cluster absolutely-multiplicative -> properly-upper-bound for
ClosureStr over S;
end;

registration
  let S;
  cluster absolutely-additive -> properly-lower-bound for ClosureStr over S;
end;

definition
  let S;
  mode ClosureSystem of S is absolutely-multiplicative ClosureStr over S;
end;

definition
  let I, M;
  mode ClosureOperator of M is reflexive monotonic idempotent SetOp of M;
end;

definition
  let S;
  let A be ManySortedSet of the carrier of S;
  let g be ClosureOperator of A;
  func ClOp->ClSys g -> strict ClosureStr over S means


  the Sorts of it = A &
  the Family of it = { x where x is Element of Bool A : g.x = x };
end;

registration
  let S;
  let A be ManySortedSet of the carrier of S;
  let g be ClosureOperator of A;
  cluster ClOp->ClSys g -> absolutely-multiplicative;
end;

definition
  let S;
  let A be ClosureSystem of S;
  let C be ManySortedSubset of the Sorts of A;
  func Cl C -> Element of Bool the Sorts of A means


  ex F being
SubsetFamily of the Sorts of A st it = meet |:F:| & F = { X where X is Element
  of Bool the Sorts of A : C c=' X & X in the Family of A };
end;

theorem 
  for D being ClosureSystem of S for a being Element of Bool the
Sorts of D for f being SetOp of the Sorts of D st a in the Family of D & for x
  being Element of Bool the Sorts of D holds f.x = Cl x holds f.a = a;

theorem 
  for D being ClosureSystem of S for a being Element of Bool the Sorts
  of D for f being SetOp of the Sorts of D st f.a = a & for x being Element of
  Bool the Sorts of D holds f.x = Cl x holds a in the Family of D;

theorem 
  for D being ClosureSystem of S for f being SetOp of the Sorts of
  D st for x being Element of Bool the Sorts of D holds f.x = Cl x holds f is
  reflexive monotonic idempotent;

definition
  let S;
  let D be ClosureSystem of S;
  func ClSys->ClOp D -> ClosureOperator of the Sorts of D means


  for x being Element of Bool the Sorts of D holds it.x = Cl x;
end;

theorem 
  for A being ManySortedSet of the carrier of S for f being
  ClosureOperator of A holds ClSys->ClOp (ClOp->ClSys f) = f;

theorem 
  for D being ClosureSystem of S holds ClOp->ClSys (ClSys->ClOp D) = the
  ClosureStr of D;














begin 

reserve x,y,X,X1,Y,Z for set;

theorem 
  for X st X <> {} & for Z st Z <> {} & Z c= X & Z is c=-linear ex Y st
  Y in X & for X1 st X1 in Z holds X1 c= Y ex Y st Y in X & for Z st Z in X & Z
  <> Y holds not Y c= Z;

begin 

reserve L for Lattice;
reserve F,H for Filter of L;
reserve p,q,r for Element of L;

registration
  let L;
  cluster <.L.) -> prime;
end;

theorem 
  F c= <.F \/ H.) & H c= <.F \/ H.);

theorem 
  p in <.<.q.) \/ F.) implies ex r st r in F & q "/\" r [= p;

reserve L1, L2 for Lattice;
reserve a1,b1 for Element of L1;
reserve a2 for Element of L2;

definition
  let L1,L2;
  mode Homomorphism of L1,L2 -> Function of the carrier of L1, the carrier of
    L2 means


    it.(a1 "\/" b1) = it.a1 "\/" it.b1 & it.(a1 "/\" b1) = it.a1 "/\" it.b1;
end;

reserve f for Homomorphism of L1,L2;

theorem 
  a1 [= b1 implies f.a1 [= f.b1;

theorem 
  f is one-to-one implies (a1 [= b1 iff (f.a1) [= (f.b1));

theorem 
  for f being Function of the carrier of L1, the carrier of L2
  holds f is onto implies for a2 ex a1 st a2 = f.a1;

definition
  let L1,L2;

  redefine pred L1,L2 are_isomorphic means

  ex f st f is bijective;
end;

definition
  let L1,L2,f;
  pred f preserves_implication means


  f.(a1 => b1) = (f.a1) => (f.b1);
  pred f preserves_top means


  f.(Top L1) = Top L2;
  pred f preserves_bottom means


  f.(Bottom L1) = Bottom L2;
  pred f preserves_complement means


  f.(a1`) = (f.a1)`;
end;

definition
  let L;

  mode ClosedSubset of L is meet-closed join-closed Subset of L;
end;

theorem 
  the carrier of L is ClosedSubset of L;

registration
  let L;
  cluster non empty for ClosedSubset of L;
end;

theorem 
  for F being Filter of L holds F is ClosedSubset of L;

reserve B for Finite_Subset of the carrier of L;

definition
  let L,B;

  func FinJoin B -> Element of L equals

  FinJoin (B,id L);
  func FinMeet B -> Element of L equals

  FinMeet (B,id L);
end;

theorem 
  FinJoin {.p.} = p;

theorem 
  FinMeet {.p.} = p;

begin 

reserve DL for distributive Lattice;
reserve f for Homomorphism of DL,L2;

theorem 
  f is onto implies L2 is distributive;

begin 

reserve 0L for lower-bounded Lattice,
  B,B1,B2 for Finite_Subset of the carrier of 0L,
  b for Element of 0L;

theorem 
  for f being Homomorphism of 0L,L2 st f is onto holds L2 is
  lower-bounded & f preserves_bottom;

reserve f for UnOp of the carrier of 0L;

theorem 
  FinJoin(B \/ {.b.},f) = FinJoin (B,f) "\/" f.b;

theorem 
  FinJoin(B \/ {.b.}) = FinJoin B "\/" b;

theorem 
  FinJoin B1 "\/" FinJoin B2 = FinJoin (B1 \/ B2);

theorem 
  FinJoin {}.the carrier of 0L = Bottom 0L;

theorem 
  for A being ClosedSubset of 0L st Bottom 0L in A for B holds B
  c= A implies FinJoin B in A;

begin 

reserve 1L for upper-bounded Lattice,
  B,B1,B2 for Finite_Subset of the carrier of 1L,
  b for Element of 1L;

theorem 
  for f being Homomorphism of 1L,L2 st f is onto holds L2 is
  upper-bounded & f preserves_top;

theorem 
  FinMeet {}.the carrier of 1L = Top 1L;

reserve f,g for UnOp of the carrier of 1L;

theorem 
  FinMeet(B \/ {.b.},f) = FinMeet (B,f) "/\" f.b;

theorem 
  FinMeet(B \/ {.b.}) = FinMeet B "/\" b;

theorem 
  FinMeet(f.:B,g) = FinMeet(B,g*f);

theorem 
  FinMeet B1 "/\" FinMeet B2 = FinMeet (B1 \/ B2);

theorem 
  for F being ClosedSubset of 1L st Top 1L in F for B holds B c= F
  implies FinMeet B in F;

begin 

reserve DL for distributive upper-bounded Lattice,
  B for Finite_Subset of the carrier of DL,
  p for Element of DL,
  f for UnOp of the carrier of DL;

theorem 
  FinMeet B "\/" p = FinMeet (((the L_join of DL)[:](id DL,p)).:B);

begin 

reserve CL for C_Lattice;
reserve IL for implicative Lattice;
reserve f for Homomorphism of IL,CL;
reserve i,j,k for Element of IL;

theorem 
  f.i "/\" f.(i => j) [= f.j;

theorem 
  f is one-to-one implies (f.i "/\" f.k [= f.j implies f.k [= f.(i => j));

theorem 
  f is bijective implies CL is implicative & f preserves_implication;

begin 

reserve BL for Boolean Lattice;
reserve f for Homomorphism of BL,CL;
reserve A for non empty Subset of BL;
reserve a1,a,b,c,p,q for Element of BL;
reserve B,B0,B1,B2,A1,A2 for Finite_Subset of the carrier of BL;

theorem 
  (Top BL)`=Bottom BL;

theorem 
  (Bottom BL)`=Top BL;

theorem 
  f is onto implies CL is Boolean & f preserves_complement;

definition
  let BL;
  mode Field of BL -> non empty Subset of BL means


    a in it & b in it implies a "/\" b in it & a` in it;
end;

reserve F,H for Field of BL;

theorem 
  a in F & b in F implies a "\/" b in F;

theorem 
  a in F & b in F implies a => b in F;

theorem 
  the carrier of BL is Field of BL;

theorem 
  F is ClosedSubset of BL;

definition
  let BL,A;
  func field_by A -> Field of BL means


  A c= it & for F st A c= F holds it c= F;
end;

definition
  let BL,A;
  func SetImp A -> Subset of BL equals

  { a => b : a in A & b in A};
end;

registration
  let BL,A;
  cluster SetImp A -> non empty;
end;

theorem 
  x in SetImp A iff ex p,q st x = p => q & p in A & q in A;

theorem 
  c in SetImp A iff ex p,q st c = p` "\/" q & p in A & q in A;

definition
  let BL;
  func comp BL -> Function of the carrier of BL, the carrier of BL means


   it.a = a`;
end;

theorem 
  FinJoin(B \/ {.b.},comp BL) = FinJoin (B,comp BL) "\/" b`;

theorem 
  (FinJoin B)` = FinMeet (B,comp BL);

theorem 
  FinMeet(B \/ {.b.},comp BL) = FinMeet (B,comp BL) "/\" b`;

theorem 
  (FinMeet B)` = FinJoin (B,comp BL);

theorem 
  for AF being non empty ClosedSubset of BL st Bottom BL in AF &
  Top BL in AF for B holds B c= SetImp AF implies ex B0 st B0 c= SetImp AF &
  FinJoin( B,comp BL) = FinMeet B0;

theorem 
  for AF being non empty ClosedSubset of BL st Bottom BL in AF & Top BL
  in AF holds { FinMeet B : B c= SetImp AF } = field_by AF;














begin

definition
  let T be TopStruct, P be Subset of T;
  redefine attr P is closed means

  P` is open;
end;

definition
  let T be TopStruct, F be Subset-Family of T;
  attr F is dense means


  for X being Subset of T st X in F holds X is dense;
end;

theorem 
  for X, Y being set st card X c= card Y & Y is countable holds X is countable;

theorem 
  for A being denumerable set holds NAT,A are_equipotent;

theorem 
  for L being non empty transitive RelStr, A, B being Subset of L st A
  is_finer_than B holds downarrow A c= downarrow B;

theorem 
  for L being non empty transitive RelStr, A, B being Subset of L
  st A is_coarser_than B holds uparrow A c= uparrow B;

theorem 
  for L being non empty Poset, D being non empty finite filtered Subset
  of L st ex_inf_of D,L holds inf D in D;

theorem 
  for L being lower-bounded antisymmetric non empty RelStr for X being
  non empty lower Subset of L holds Bottom L in X;

theorem 
  for L being lower-bounded antisymmetric non empty RelStr for X being
  non empty Subset of L holds Bottom L in downarrow X;

theorem 
  for L being upper-bounded antisymmetric non empty RelStr for X
  being non empty upper Subset of L holds Top L in X;

theorem 
  for L being upper-bounded antisymmetric non empty RelStr for X
  being non empty Subset of L holds Top L in uparrow X;

theorem 
  for L being lower-bounded with_infima antisymmetric RelStr for X
  being Subset of L holds X "/\" {Bottom L} c= {Bottom L};

theorem 
  for L being lower-bounded with_infima antisymmetric RelStr for X being
  non empty Subset of L holds X "/\" {Bottom L} = {Bottom L};

theorem 
  for L being upper-bounded with_suprema antisymmetric RelStr for
  X being Subset of L holds X "\/" {Top L} c= {Top L};

theorem 
  for L being upper-bounded with_suprema antisymmetric RelStr for X
  being non empty Subset of L holds X "\/" {Top L} = {Top L};

theorem 
  for L being upper-bounded Semilattice, X being Subset of L holds
  {Top L} "/\" X = X;

theorem 
  for L being lower-bounded with_suprema Poset, X being Subset of L
  holds {Bottom L} "\/" X = X;

theorem 
  for L being non empty reflexive RelStr, A, B being Subset of L
  st A c= B holds A is_finer_than B & A is_coarser_than B;

theorem 
  for L being antisymmetric transitive with_infima RelStr for V
  being Subset of L, x, y being Element of L st x <= y holds {y} "/\" V
  is_coarser_than {x} "/\" V;

theorem 
  for L being antisymmetric transitive with_suprema RelStr for V being
Subset of L, x, y being Element of L st x <= y holds {x} "\/" V is_finer_than {
  y} "\/" V;

theorem 
  for L being non empty RelStr, V, S, T being Subset of L st S
  is_coarser_than T & V is upper & T c= V holds S c= V;

theorem 
  for L being non empty RelStr, V, S, T being Subset of L st S
  is_finer_than T & V is lower & T c= V holds S c= V;

theorem 
  for L being Semilattice, F being upper filtered Subset of L
  holds F "/\" F = F;

theorem 
  for L being sup-Semilattice, I being lower directed Subset of L holds
  I "\/" I = I;

theorem 
  for L being upper-bounded Semilattice, V being Subset of L holds
  {x where x is Element of L : V "/\" {x} c= V} is non empty;

theorem 
  for L being antisymmetric transitive with_infima RelStr, V being
  Subset of L holds {x where x is Element of L : V "/\" {x} c= V} is filtered
  Subset of L;

theorem 
  for L being antisymmetric transitive with_infima RelStr for V
being upper Subset of L holds {x where x is Element of L : V "/\" {x} c= V} is
  upper Subset of L;

theorem 
  for L being with_infima Poset, X being Subset of L st X is Open
  lower holds X is filtered;

registration
  let L be with_infima Poset;
  cluster Open lower -> filtered for Subset of L;
end;

registration
  let L be continuous antisymmetric non empty reflexive RelStr;
  cluster lower -> Open for Subset of L;
end;

registration
  let L be continuous Semilattice, x be Element of L;
  cluster (downarrow x)` -> Open;
end;

theorem 
  for L being Semilattice, C being non empty Subset of L st for x,
y being Element of L st x in C & y in C holds x <= y or y <= x for Y being non
  empty finite Subset of C holds "/\"(Y,L) in Y;

theorem 
  for L being sup-Semilattice, C being non empty Subset of L st for x, y
  being Element of L st x in C & y in C holds x <= y or y <= x for Y being non
  empty finite Subset of C holds "\/"(Y,L) in Y;

definition
  let L be Semilattice, F be Filter of L;
  mode GeneratorSet of F -> Subset of L means


    F = uparrow fininfs it;
end;

registration
  let L be Semilattice, F be Filter of L;
  cluster non empty for GeneratorSet of F;
end;

theorem 
  for L being Semilattice, A being Subset of L for B being non
  empty Subset of L st A is_coarser_than B holds fininfs A is_coarser_than
  fininfs B;

theorem 
  for L being Semilattice, F being Filter of L, G being
GeneratorSet of F for A being non empty Subset of L st G is_coarser_than A & A
  is_coarser_than F holds A is GeneratorSet of F;

theorem 
  for L being Semilattice, A being Subset of L for f, g being
  Function of NAT, the carrier of L st rng f = A & for n being Element of NAT
  holds g.n = "/\"({f.m where m is Element of NAT: m <= n},L) holds A
  is_coarser_than rng g;

theorem 
  for L being Semilattice, F being Filter of L, G being
GeneratorSet of F for f, g being Function of NAT, the carrier of L st rng f = G
& for n being Element of NAT holds g.n = "/\"({f.m where m is Element of NAT: m
  <= n},L) holds rng g is GeneratorSet of F;

begin  


theorem 
  for L being lower-bounded continuous LATTICE, V being Open upper
Subset of L for F being Filter of L, v being Element of L st V "/\" F c= V & v
in V & ex A being non empty GeneratorSet of F st A is countable ex O being Open
  Filter of L st O c= V & v in O & F c= O;



theorem 
  for L being lower-bounded continuous LATTICE, V being Open upper
Subset of L for N being non empty countable Subset of L for v being Element of
L st V "/\" N c= V & v in V ex O being Open Filter of L st {v} "/\" N c= O & O
  c= V & v in O;



theorem 
  for L being lower-bounded continuous LATTICE, V being Open upper
Subset of L for N being non empty countable Subset of L, x, y being Element of
L st V "/\" N c= V & y in V & not x in V ex p being irreducible Element of L st
  x <= p & not p in uparrow ({y} "/\" N);



theorem 
  for L being lower-bounded continuous LATTICE, x being Element of
L for N being non empty countable Subset of L st for n, y being Element of L st
  not y <= x & n in N holds not y "/\" n <= x for y being Element of L st not y
<= x ex p being irreducible Element of L st x <= p & not p in uparrow ({y} "/\"
  N);



definition
  let L be non empty RelStr, u be Element of L;
  attr u is dense means


  for v being Element of L st v <> Bottom L holds u "/\" v <> Bottom L;
end;

registration
  let L be upper-bounded Semilattice;
  cluster Top L -> dense;
end;

registration
  let L be upper-bounded Semilattice;
  cluster dense for Element of L;
end;

theorem 
  for L being non trivial bounded Semilattice for x being Element of L
  st x is dense holds x <> Bottom L;

definition
  let L be non empty RelStr, D be Subset of L;
  attr D is dense means


  for d being Element of L st d in D holds d is dense;
end;

theorem 
  for L being upper-bounded Semilattice holds {Top L} is dense;

registration
  let L be upper-bounded Semilattice;
  cluster non empty finite countable dense for Subset of L;
end;




theorem 
  for L being lower-bounded continuous LATTICE for D being non
  empty countable dense Subset of L, u being Element of L st u <> Bottom L ex p
  being irreducible Element of L st p <> Top L & not p in uparrow ({u} "/\" D);

theorem 
  for T being non empty TopSpace for A being Element of InclPoset
the topology of T for B being Subset of T st A = B & B` is irreducible holds A
  is irreducible;

theorem 
  for T being non empty TopSpace for A being Element of InclPoset
  the topology of T for B being Subset of T st A = B & A <> Top InclPoset the
  topology of T holds A is irreducible iff B` is irreducible;

theorem 
  for T being non empty TopSpace for A being Element of InclPoset
  the topology of T for B being Subset of T st A = B holds A is dense iff B is
  everywhere_dense;



theorem 
  for T being non empty TopSpace st T is locally-compact for D
being countable Subset-Family of T st D is non empty dense open for O being non
  empty Subset of T st O is open ex A being irreducible Subset of T st for V
  being Subset of T st V in D holds A /\ O meets V;

definition
  let T be non empty TopSpace;
  redefine attr T is Baire means

  for F being Subset-Family of T st F is
countable & for S being Subset of T st S in F holds S is open dense ex I being
  Subset of T st I = Intersect F & I is dense;
end;



theorem 
  for T being non empty TopSpace st T is sober locally-compact holds T is Baire
;














begin 

theorem 
  for X being set, F being finite Subset-Family of X ex G being
finite Subset-Family of X st G c= F & union G = union F & for g being Subset of
  X st g in G holds not g c= union (G\{g});

theorem 
  for S being 1-sorted, X being Subset of S holds X` = the carrier
  of S iff X is empty;

theorem 
  for R being antisymmetric with_infima transitive non empty RelStr
, x, y being Element of R holds downarrow (x"/\"y) = (downarrow x) /\ downarrow
  y;

theorem 
  for R being antisymmetric with_suprema transitive non empty RelStr, x,
  y being Element of R holds uparrow (x"\/"y) = (uparrow x) /\ uparrow y;

theorem 
  for L being complete antisymmetric non empty RelStr, X being
  lower Subset of L st sup X in X holds X = downarrow sup X;

theorem 
  for L being complete antisymmetric non empty RelStr, X being upper
  Subset of L st inf X in X holds X = uparrow inf X;

theorem 
  for R being non empty reflexive transitive RelStr, x, y being
  Element of R holds x << y iff uparrow y c= wayabove x;

theorem 
  for R being non empty reflexive transitive RelStr, x, y being Element
  of R holds x << y iff downarrow x c= waybelow y;

theorem 
  for R being complete reflexive antisymmetric non empty RelStr,
  x being Element of R holds sup waybelow x <= x & x <= inf wayabove x;

theorem 
  for L being lower-bounded antisymmetric non empty RelStr holds
  uparrow Bottom L = the carrier of L;

theorem 
  for L being upper-bounded antisymmetric non empty RelStr holds
  downarrow Top L = the carrier of L;

theorem 
  for P being with_suprema Poset, x, y being Element of P holds (
  wayabove x)"\/"(wayabove y) c= uparrow (x"\/"y);

theorem 
  for P being with_infima Poset, x, y being Element of P holds (waybelow
  x)"/\"(waybelow y) c= downarrow (x"/\"y);

theorem 
  for R being with_suprema non empty Poset, l being Element of R
  holds l is co-prime iff for x,y be Element of R st l <= x "\/" y holds l <= x
  or l <= y;

theorem 
  for P being complete non empty Poset, V being non empty Subset
of P holds downarrow inf V = meet {downarrow u where u is Element of P : u in V
  };

theorem 
  for P being complete non empty Poset, V being non empty Subset of P
  holds uparrow sup V = meet {uparrow u where u is Element of P : u in V};

registration
  let L be sup-Semilattice, x be Element of L;
  cluster compactbelow x -> directed;
end;

theorem 



  for T being non empty TopSpace, S being irreducible Subset of T,
  V being Element of InclPoset the topology of T st V = S` holds V is prime;

theorem 
  for T being non empty TopSpace, x, y be Element of InclPoset the
  topology of T holds x "\/" y = x \/ y & x "/\" y = x /\ y;

theorem 
  for T being non empty TopSpace, V being Element of InclPoset the
  topology of T holds V is prime iff for X, Y being Element of InclPoset the
  topology of T st X/\Y c= V holds X c= V or Y c= V;

theorem 
  for T being non empty TopSpace, V being Element of InclPoset the
  topology of T holds V is co-prime iff for X, Y being Element of InclPoset the
  topology of T st V c= X \/ Y holds V c= X or V c= Y;

registration
  let T be non empty TopSpace;
  cluster InclPoset the topology of T -> distributive;
end;

theorem 
  for T being non empty TopSpace, L being TopLattice, t being
Point of T, l being Point of L, X being Subset-Family of L st the TopStruct of
  T = the TopStruct of L & t = l & X is Basis of l holds X is Basis of t;

theorem 
  for L being TopLattice, x being Element of L st for X being
  Subset of L st X is open holds X is upper holds uparrow x is compact;

begin 

reserve L for complete Scott TopLattice,
  x for Element of L,
  X, Y for Subset of L,
  V, W for Element of InclPoset sigma L,
  VV for Subset of InclPoset sigma L;

registration
  let L be complete LATTICE;
  cluster sigma L -> non empty;
end;

theorem 
  sigma L = the topology of L;

theorem 
  X in sigma L iff X is open;

theorem 
  for X being filtered Subset of L st VV = {(downarrow x)` : x in
  X} holds VV is directed;

theorem 
  X is open & x in X implies inf X << x;



definition
  let R be non empty reflexive RelStr, f be Function of [:R, R:], R;
  attr f is jointly_Scott-continuous means


  for T being non empty
  TopSpace st the TopStruct of T = ConvergenceSpace Scott-Convergence R ex ft
  being Function of [:T, T:], T st ft = f & ft is continuous;
end;

theorem 
  V = X implies (V is co-prime iff X is filtered upper);

theorem 
  (V = X & ex x st X = (downarrow x)`) implies V is prime & V <> the
  carrier of L;

theorem 
  V = X & sup_op L is jointly_Scott-continuous & V is prime & V <>
  the carrier of L implies ex x st X = (downarrow x)`;

theorem 
  L is continuous implies sup_op L is jointly_Scott-continuous;

theorem 
  sup_op L is jointly_Scott-continuous implies L is sober;

theorem 
  L is continuous implies L is compact locally-compact sober Baire;

theorem 
  L is continuous & X in sigma L implies X = union {wayabove x : x in X};

theorem 
  (for X st X in sigma L holds X = union {wayabove x : x in X}) implies
  L is continuous;

theorem 
  L is continuous implies ex B being Basis of x st for X st X in B holds
  X is open filtered;

theorem 
  L is continuous implies InclPoset sigma L is continuous;

theorem 
  (for x ex B being Basis of x st for Y st Y in B holds Y is open
filtered) & InclPoset sigma L is continuous implies x = "\/" ({inf X : x in X &
  X in sigma L}, L);

theorem 
  (for x holds x = "\/" ({inf X : x in X & X in sigma L}, L))
  implies L is continuous;

theorem 

  (for x ex B being Basis of x st for Y st Y in B holds Y is open
filtered) iff for V ex VV st V = sup VV & for W st W in VV holds W is co-prime;

theorem 
  (for V ex VV st V = sup VV & for W st W in VV holds W is co-prime) &
  InclPoset sigma L is continuous iff InclPoset sigma L is
  completely-distributive;

theorem 
  InclPoset sigma L is completely-distributive iff InclPoset sigma L is
  continuous & (InclPoset sigma L) opp is continuous;

theorem 
  L is algebraic implies ex B being Basis of L st B = {uparrow x : x in
  the carrier of CompactSublatt L};

theorem 
  (ex B being Basis of L st B = {uparrow x :x in the carrier of
CompactSublatt L}) implies InclPoset sigma L is algebraic & for V ex VV st V =
  sup VV & for W st W in VV holds W is co-prime;

theorem 


  InclPoset sigma L is algebraic & (for V ex VV st V = sup VV & for W st
W in VV holds W is co-prime) implies ex B being Basis of L st B = {uparrow x :
  x in the carrier of CompactSublatt L};

theorem 
  (ex B being Basis of L st B = {uparrow x :x in the carrier of
  CompactSublatt L}) implies L is algebraic;














begin  

reserve A, B, X, Y for set;

registration
  let X be empty set;
  cluster union X -> empty;
end;

theorem 
  (delta X).:A c= [:A,A:];

theorem 
  (delta X)"[:A,A:] c= A;

theorem 
  for A being Subset of X holds (delta X)"[:A,A:] = A;

theorem 
  dom <:pr2(X,Y),pr1(X,Y):> = [:X,Y:] & rng <:pr2(X,Y),pr1(X,Y):> = [:Y,X:];

theorem 
  <:pr2(X,Y),pr1(X,Y):>.:[:A,B:] c= [:B,A:];

theorem 
  for A being Subset of X, B being Subset of Y holds <:pr2(X,Y),pr1(X,Y)
  :>.:[:A,B:] = [:B,A:];

theorem 
  <:pr2(X,Y),pr1(X,Y):> is one-to-one;

registration
  let X, Y be set;
  cluster <:pr2(X,Y),pr1(X,Y):> -> one-to-one;
end;

theorem 
  <:pr2(X,Y),pr1(X,Y):>" = <:pr2(Y,X),pr1(Y,X):>;

begin  

theorem 
  for L1 being Semilattice, L2 being non empty RelStr for x, y
  being Element of L1, x1, y1 being Element of L2 st the RelStr of L1 = the
  RelStr of L2 & x = x1 & y = y1 holds x "/\" y = x1 "/\" y1;

theorem 
  for L1 being sup-Semilattice, L2 being non empty RelStr for x, y
  being Element of L1, x1, y1 being Element of L2 st the RelStr of L1 = the
  RelStr of L2 & x = x1 & y = y1 holds x "\/" y = x1 "\/" y1;

theorem 
  for L1 being Semilattice, L2 being non empty RelStr for X, Y
being Subset of L1, X1, Y1 being Subset of L2 st the RelStr of L1 = the RelStr
  of L2 & X = X1 & Y = Y1 holds X "/\" Y = X1 "/\" Y1;

theorem 
  for L1 being sup-Semilattice, L2 being non empty RelStr for X, Y being
Subset of L1, X1, Y1 being Subset of L2 st the RelStr of L1 = the RelStr of L2
  & X = X1 & Y = Y1 holds X "\/" Y = X1 "\/" Y1;

theorem 
  for L1 being antisymmetric up-complete non empty reflexive
  RelStr, L2 being non empty reflexive RelStr, x being Element of L1, y being
Element of L2 st the RelStr of L1 = the RelStr of L2 & x = y holds waybelow x =
  waybelow y & wayabove x = wayabove y;

theorem 
  for L1 being meet-continuous Semilattice, L2 being non empty reflexive
  RelStr st the RelStr of L1 = the RelStr of L2 holds L2 is meet-continuous;

theorem 
  for L1 being continuous antisymmetric non empty reflexive RelStr, L2
  being non empty reflexive RelStr st the RelStr of L1 = the RelStr of L2 holds
  L2 is continuous;

theorem 
  for L1, L2 being RelStr, A being Subset of L1, J being Subset of L2 st
  the RelStr of L1 = the RelStr of L2 & A = J holds subrelstr A = subrelstr J;

theorem 
  for L1, L2 being non empty RelStr, A being SubRelStr of L1, J being
SubRelStr of L2 st the RelStr of L1 = the RelStr of L2 & the RelStr of A = the
  RelStr of J & A is meet-inheriting holds J is meet-inheriting;

theorem 
  for L1, L2 being non empty RelStr, A being SubRelStr of L1, J being
SubRelStr of L2 st the RelStr of L1 = the RelStr of L2 & the RelStr of A = the
  RelStr of J & A is join-inheriting holds J is join-inheriting;

theorem 
  for L1 being up-complete antisymmetric non empty reflexive RelStr,
L2 being non empty reflexive RelStr, X being Subset of L1, Y being Subset of L2
  st the RelStr of L1 = the RelStr of L2 & X = Y & X is property(S) holds Y is
  property(S);

theorem 
  for L1 being up-complete antisymmetric non empty reflexive RelStr,
L2 being non empty reflexive RelStr, X being Subset of L1, Y being Subset of L2
  st the RelStr of L1 = the RelStr of L2 & X = Y & X is directly_closed holds Y
  is directly_closed;

theorem 
  for N being antisymmetric with_infima RelStr, D, E being Subset of N
  for X being upper Subset of N st D misses X holds D "/\" E misses X;

theorem 
  for R being reflexive non empty RelStr holds id the carrier of R c= (
  the InternalRel of R) /\ the InternalRel of (R~);

theorem 
  for R being antisymmetric RelStr holds (the InternalRel of R) /\ the
  InternalRel of (R~) c= id the carrier of R;

definition
  let L be non empty RelStr;
  let f be Function of [:L,L:], L;
  let a,b be Element of L;
  redefine func f.(a,b) -> Element of L;
end;

theorem 
  for R being upper-bounded Semilattice, X being Subset of [:R,R:]
  st ex_inf_of (inf_op R).:X,R holds inf_op R preserves_inf_of X;

registration
  let R be complete Semilattice;
  cluster inf_op R -> infs-preserving;
end;

theorem 
  for R being lower-bounded sup-Semilattice, X being Subset of [:R
  ,R:] st ex_sup_of (sup_op R).:X,R holds sup_op R preserves_sup_of X;

registration
  let R be complete sup-Semilattice;
  cluster sup_op R -> sups-preserving;
end;

theorem 
  for N being Semilattice, A being Subset of N st subrelstr A is
  meet-inheriting holds A is filtered;

theorem 
  for N being sup-Semilattice, A being Subset of N st subrelstr A is
  join-inheriting holds A is directed;

theorem 
  for N being transitive RelStr, A, J being Subset of N st A
  is_coarser_than uparrow J holds uparrow A c= uparrow J;

theorem 
  for N being transitive RelStr, A, J being Subset of N st A
  is_finer_than downarrow J holds downarrow A c= downarrow J;

theorem 
  for N being non empty reflexive RelStr for x being Element of N, X
  being Subset of N st x in X holds uparrow x c= uparrow X;

theorem 
  for N being non empty reflexive RelStr for x being Element of N, X
  being Subset of N st x in X holds downarrow x c= downarrow X;

begin  

reserve R, S, T for non empty TopSpace;

theorem 
  for S, T being TopStruct, B being Basis of S st the TopStruct of
  S = the TopStruct of T holds B is Basis of T;

theorem 
  for S, T being TopStruct, B being prebasis of S st the TopStruct
  of S = the TopStruct of T holds B is prebasis of T;

theorem 
  for J being Basis of T holds J is non empty;

registration
  let T be non empty TopSpace;
  cluster -> non empty for Basis of T;
end;

theorem 
  for x being Point of T, J being Basis of x holds J is non empty;

registration
  let T be non empty TopSpace, x be Point of T;
  cluster -> non empty for Basis of x;
end;

theorem 
  for S1, T1, S2, T2 being TopSpace, f being Function of S1, S2, g being
Function of T1, T2 st the TopStruct of S1 = the TopStruct of T1 & the TopStruct
  of S2 = the TopStruct of T2 & f = g & f is continuous holds g is continuous;

theorem 
  id the carrier of T = {p where p is Point of [:T,T:]: pr1(the
  carrier of T,the carrier of T).p = pr2(the carrier of T,the carrier of T).p};

theorem 
  delta the carrier of T is continuous Function of T, [:T,T:];

theorem 
  pr1(the carrier of S,the carrier of T) is continuous Function of [:S,T:], S;

theorem 
  pr2(the carrier of S,the carrier of T) is continuous Function of [:S,T:], T;

theorem 
  for f being continuous Function of T, S, g being continuous
  Function of T, R holds <:f,g:> is continuous Function of T, [:S,R:];

theorem 
  <:pr2(the carrier of S,the carrier of T), pr1(the carrier of S,
  the carrier of T):> is continuous Function of [:S,T:],[:T,S:];

theorem 
  for f being Function of [:S,T:], [:T,S:] st f = <:pr2(the
carrier of S,the carrier of T), pr1(the carrier of S,the carrier of T):> holds
  f is being_homeomorphism;

theorem 
  [:S,T:], [:T,S:] are_homeomorphic;

theorem 
  for T being Hausdorff non empty TopSpace for f, g being
continuous Function of S, T holds (for X being Subset of S st X = {p where p is
  Point of S: f.p <> g.p} holds X is open) & for X being Subset of S st X = {p
  where p is Point of S: f.p = g.p} holds X is closed;

theorem 
  T is Hausdorff iff for A being Subset of [:T,T:] st A = id the carrier
  of T holds A is closed;

registration
  let S, T be TopStruct;
  cluster strict for Refinement of S, T;
end;

registration
  let S be non empty TopStruct, T be TopStruct;
  cluster strict non empty for Refinement of S, T;
  cluster strict non empty for Refinement of T, S;
end;

theorem 
  for R, S, T being TopStruct holds R is Refinement of S, T iff the
  TopStruct of R is Refinement of S, T;

reserve S1, S2, T1, T2 for non empty TopSpace,
  R for Refinement of [:S1,T1:], [:S2,T2:],
  R1 for Refinement of S1, S2,
  R2 for Refinement of T1, T2;

theorem 
  the carrier of S1 = the carrier of S2 & the carrier of T1 = the
carrier of T2 implies { [:U1,V1:] /\ [:U2,V2:] where U1 is Subset of S1, U2 is
Subset of S2, V1 is Subset of T1, V2 is Subset of T2 : U1 is open & U2 is open
  & V1 is open & V2 is open } is Basis of R;

theorem 
  the carrier of S1 = the carrier of S2 & the carrier of T1 = the
  carrier of T2 implies the carrier of [:R1,R2:] = the carrier of R & the
  topology of [:R1,R2:] = the topology of R;

theorem 
  the carrier of S1 = the carrier of S2 & the carrier of T1 = the
  carrier of T2 implies [:R1,R2:] is Refinement of [:S1,T1:], [:S2,T2:];














begin 

theorem 
  for f being Function, F being Function-yielding Function st f =
  union rng F holds dom f = union rng doms F;

theorem 
  for A,B being non empty set holds [:union A, union B:] = union {
  [:a,b:] where a is Element of A, b is Element of B : a in A & b in B };

theorem 
  for A being non empty set st A is c=-linear holds [:union A,
  union A:] = union { [:a,a:] where a is Element of A : a in A };

begin 

reserve X for non empty set;

definition
  let A be set;
  func EqRelLATT A -> Poset equals

  LattPOSet EqRelLatt A;
end;

registration
  let A be set;
  cluster EqRelLATT A -> with_infima with_suprema;
end;

theorem 
  for A, x being set holds x in the carrier of EqRelLATT A iff x is
  Equivalence_Relation of A;

theorem 
  for A being set, x,y being Element of EqRelLatt A holds x [= y iff x c= y;

theorem 
  for A being set, a,b being Element of EqRelLATT A holds a <= b iff a c= b;

theorem 
  for L being Lattice, a,b being Element of LattPOSet L holds a
  "/\" b = %a "/\" %b;

theorem 
  for A being set, a,b being Element of EqRelLATT A holds a "/\" b = a /\ b;

theorem 
  for L being Lattice, a,b being Element of LattPOSet L holds a
  "\/" b = %a "\/" %b;

theorem 
  for A being set, a,b being Element of EqRelLATT A for E1,E2
being Equivalence_Relation of A st a = E1 & b = E2 holds a "\/" b = E1 "\/" E2;

definition
  let L be non empty RelStr;
  redefine attr L is complete means

  for X being Subset of L ex a being Element
of L st a is_<=_than X & for b being Element of L st b is_<=_than X holds b <=
  a;
end;

registration
  let A be set;
  cluster EqRelLATT A -> complete;
end;

begin 

registration
  let L1,L2 be LATTICE;
  cluster meet-preserving join-preserving for Function of L1,L2;
end;

definition
  let L1,L2 be LATTICE;
  mode Homomorphism of L1,L2 is meet-preserving join-preserving Function of L1
    ,L2;
end;

registration
  let L be LATTICE;
  cluster meet-inheriting join-inheriting strict for SubRelStr of L;
end;

definition
  let L be non empty RelStr;
  mode Sublattice of L is meet-inheriting join-inheriting SubRelStr of L;
end;

registration
  let L1, L2 be LATTICE;
  let f be Homomorphism of L1,L2;
  cluster Image f -> meet-inheriting join-inheriting;
end;

reserve e,e1,e2,e19,e29 for Equivalence_Relation of X,
  x,y,x9,y9 for set;

definition
  let X;
  let f be non empty FinSequence of X;
  let x,y;
  let R1, R2 be Relation;
  pred x,y are_joint_by f,R1,R2 means


  f.1 = x & f.(len f) = y & for i
being Element of NAT st 1 <= i & i < len f holds (i is odd implies [f.i,f.(i+1)
  ] in R1) & (i is even implies [f.i,f.(i+1)] in R2);
end;

theorem 
  for x being set, o being Element of NAT, R1,R2 being Relation, f
being non empty FinSequence of X st R1 is_reflexive_in X & R2 is_reflexive_in X
  & f = o |-> x holds x,x are_joint_by f,R1,R2;

theorem 
  for x,y being set, R1,R2 being Relation, n,m being Element of
  NAT st (n <= m & R1 is_reflexive_in X & R2 is_reflexive_in X & ex f being non
empty FinSequence of X st len f = n & x,y are_joint_by f,R1,R2) ex h being non
  empty FinSequence of X st len h = m & x,y are_joint_by h,R1,R2;

definition
  let X;
  let Y be Sublattice of EqRelLATT X;
  given e such that
 e in the carrier of Y and
 e <> id X;
  given o being Element of NAT such that
 for e1,e2,x,y st e1 in the carrier of Y & e2 in the carrier of Y & [
x,y] in e1 "\/" e2 holds ex F being non empty FinSequence of X st len F = o & x
  ,y are_joint_by F,e1,e2;
  func type_of Y -> Element of NAT means


  (for e1,e2,x,y st e1 in the
  carrier of Y & e2 in the carrier of Y & [x,y] in e1 "\/" e2 holds (ex F being
non empty FinSequence of X st len F = it+2 & x,y are_joint_by F,e1,e2)) & ex e1
  ,e2,x,y st e1 in the carrier of Y & e2 in the carrier of Y & [x,y] in e1 "\/"
  e2 & not (ex F being non empty FinSequence of X st len F = it+1 & x,y
  are_joint_by F,e1,e2);
end;

theorem 
  for Y being Sublattice of EqRelLATT X, n being Element of NAT st
  (ex e st e in the carrier of Y & e <> id X) & (for e1,e2,x,y st e1 in the
  carrier of Y & e2 in the carrier of Y & [x,y] in e1 "\/" e2 holds (ex F being
  non empty FinSequence of X st len F = n+2 & x,y are_joint_by F,e1,e2)) holds
  type_of Y <= n;

begin 

reserve A for non empty set,
  L for lower-bounded LATTICE;

definition
  let A be set, L be 1-sorted;
  mode BiFunction of A,L is Function of [:A,A:],the carrier of L;
end;

definition
  let A be non empty set, L be 1-sorted;
  let f be BiFunction of A,L;
  let x,y be Element of A;
  redefine func f.(x,y) -> Element of L;
end;

definition
  let A;
  let L be 1-sorted;
  let f be BiFunction of A,L;

  attr f is symmetric means


  for x,y being Element of A holds f.(x,y) = f.(y,x);
end;

definition
  let A,L;
  let f be BiFunction of A,L;
  attr f is zeroed means


  for x being Element of A holds f.(x,x) = Bottom L;
  attr f is u.t.i. means


  for x,y,z being Element of A holds f.(x,y) "\/" f.(y,z) >= f.(x,z);
end;



registration
  let A, L;
  cluster symmetric zeroed u.t.i. for BiFunction of A,L;
end;

definition
  let A, L;
  mode distance_function of A,L is symmetric zeroed u.t.i. BiFunction of A,L;
end;

definition
  let A, L;
  let d be distance_function of A,L;
  func alpha d -> Function of L,EqRelLATT A means


  for e being Element
of L ex E being Equivalence_Relation of A st E = it.e & for x,y be Element of A
  holds [x,y] in E iff d.(x,y) <= e;
end;

theorem 
  for d being distance_function of A,L holds alpha d is meet-preserving;

theorem 
  for d being distance_function of A,L st d is onto holds alpha d is one-to-one
;

begin 

definition
  let A be set;
  func new_set A equals

  A \/ {{A}, {{A}}, {{{A}}} };
end;

registration
  let A be set;
  cluster new_set A -> non empty;
end;

definition
  let A,L;
  let d be BiFunction of A,L;
  let q be Element of [:A,A,the carrier of L,the carrier of L:];
  func new_bi_fun(d,q) -> BiFunction of new_set A,L means


  (for u,v
being Element of A holds it.(u,v) = d.(u,v) ) & it.({A},{A}) = Bottom L & it.({
{A}},{{A}}) = Bottom L & it.({{{A}}},{{{A}}}) = Bottom L & it.({{A}},{{{A}}}) =
q`3_4 & it.({{{A}}},{{A}}) = q`3_4 & it.({A},{{A}}) = q`4_4 &
  it.({{A}},{A}) = q`4_4 &
  it.({A},{{{A}}}) = (q`3_4)"\/"(q`4_4) &
  it.({{{A}}},{A}) = (q`3_4)"\/"(q`4_4) &
  for u being
Element of A holds it.(u,{A}) = d.(u,q`1_4)"\/"(q`3_4) &
  it.({A},u) = d.(u,q`1_4)"\/"(q`3_4) &
it.(u,{{A}}) = d.(u,q`1_4)"\/"(q`3_4)"\/"(q`4_4) &
 it.({{A}},u) = d.(u,q`1_4)"\/"(q`3_4)
"\/" (q`4_4) & it.(u,{{{A}}}) = d.(u,q`2_4)"\/"(q`4_4) &
it.({{{A}}},u) = d.(u,q`2_4)"\/"(q`4_4);
end;

theorem 
  for d being BiFunction of A,L st d is zeroed for q being Element
  of [:A,A,the carrier of L,the carrier of L:] holds new_bi_fun(d,q) is zeroed;

theorem 
  for d being BiFunction of A,L st d is symmetric for q being
  Element of [:A,A,the carrier of L,the carrier of L:] holds new_bi_fun(d,q) is
  symmetric;

theorem 
  for d being BiFunction of A,L st d is symmetric & d is u.t.i.
for q being Element of [:A,A,the carrier of L,the carrier of L:]
  st d.(q`1_4,q`2_4)
  <= (q`3_4)"\/"(q`4_4) holds new_bi_fun(d,q) is u.t.i.;

theorem 
  for d be BiFunction of A,L for q be Element of [:A,A,the carrier
  of L,the carrier of L:] holds d c= new_bi_fun(d,q);

definition
  let A,L;
  let d be BiFunction of A,L;
  func DistEsti(d) -> Cardinal means


  it,{ [x,y,a,b] where x is Element
of A, y is Element of A, a is Element of L, b is Element of L: d.(x,y) <= a"\/"
  b} are_equipotent;
end;

theorem 
  for d be distance_function of A,L holds DistEsti(d) <> {};

reserve T,L1 for T-Sequence,
  O,O1,O2,O3,C for Ordinal;

definition
  let A;
  let O;
  func ConsecutiveSet(A,O) means


  ex L0 being T-Sequence st it = last
  L0 & dom L0 = succ O & L0.{} = A & (for C being Ordinal st succ C in succ O
holds L0.succ C = new_set L0.C) & for C being Ordinal st C in succ O & C <> {}
  & C is limit_ordinal holds L0.C = union rng (L0|C);
end;

theorem 
  ConsecutiveSet(A,{}) = A;

theorem 
  ConsecutiveSet(A,succ O) = new_set ConsecutiveSet(A,O);

theorem 
  O <> {} & O is limit_ordinal & dom T = O & (for O1 being Ordinal
  st O1 in O holds T.O1 = ConsecutiveSet(A,O1)) implies ConsecutiveSet(A,O) =
  union rng T;

registration
  let A;
  let O;
  cluster ConsecutiveSet(A,O) -> non empty;
end;

theorem 
  A c= ConsecutiveSet(A,O);

definition
  let A,L;
  let d be BiFunction of A,L;
  mode QuadrSeq of d -> T-Sequence of [:A,A,the carrier of L,the carrier of L
    :] means


    dom it is Cardinal & it is one-to-one & rng it ={[x,y,a,b]
where x is Element of A, y is Element of A, a is Element of L, b is Element of
L:  d.(x,y) <= a"\/"b};
end;

definition
  let A,L;
  let d be BiFunction of A,L;
  let q be QuadrSeq of d;
  let O;
  assume
 O in dom q;
  func Quadr(q,O) -> Element of [:ConsecutiveSet(A,O),ConsecutiveSet(A,O), the
  carrier of L,the carrier of L:] equals


  q.O;
end;

theorem 
  for d being BiFunction of A,L, q being QuadrSeq of d holds O in
  DistEsti(d) iff O in dom q;

definition
  let A,L;
  let z be set;
  assume
 z is BiFunction of A,L;
  func BiFun(z,A,L) -> BiFunction of A,L equals


  z;
end;

definition
  let A,L;
  let d be BiFunction of A,L;
  let q be QuadrSeq of d;
  let O;
  func ConsecutiveDelta(q,O) means


  ex L0 being T-Sequence st it = last
  L0 & dom L0 = succ O & L0.{} = d & (for C being Ordinal st succ C in succ O
  holds L0.succ C = new_bi_fun(BiFun(L0.C,ConsecutiveSet(A,C),L),Quadr(q,C))) &
for C being Ordinal st C in succ O & C <> {} & C is limit_ordinal holds L0.C =
  union rng(L0|C);
end;

theorem 
  for d being BiFunction of A,L for q being QuadrSeq of d holds
  ConsecutiveDelta(q,{}) = d;

theorem 
  for d be BiFunction of A,L for q being QuadrSeq of d holds
  ConsecutiveDelta(q,succ O) = new_bi_fun(BiFun(ConsecutiveDelta(q,O),
  ConsecutiveSet(A,O),L),Quadr(q,O));

theorem 
  for d be BiFunction of A,L for q being QuadrSeq of d holds O <>
{} & O is limit_ordinal & dom T = O & (for O1 being Ordinal st O1 in O holds T.
  O1 = ConsecutiveDelta(q,O1)) implies ConsecutiveDelta(q,O) = union rng T;

theorem 
  O1 c= O2 implies ConsecutiveSet(A,O1) c= ConsecutiveSet(A,O2);

theorem 
  for d be BiFunction of A,L for q being QuadrSeq of d holds
  ConsecutiveDelta(q,O) is BiFunction of ConsecutiveSet(A,O),L;

definition
  let A,L;
  let d be BiFunction of A,L;
  let q be QuadrSeq of d;
  let O;
  redefine func ConsecutiveDelta(q,O) -> BiFunction of ConsecutiveSet(A,O),L;
end;

theorem 
  for d be BiFunction of A,L for q being QuadrSeq of d holds d c=
  ConsecutiveDelta(q,O);

theorem 
  for d being BiFunction of A,L for q being QuadrSeq of d st O1 c=
  O2 holds ConsecutiveDelta(q,O1) c= ConsecutiveDelta(q,O2);

theorem 
  for d be BiFunction of A,L st d is zeroed for q being QuadrSeq
  of d holds ConsecutiveDelta(q,O) is zeroed;

theorem 
  for d be BiFunction of A,L st d is symmetric for q being
  QuadrSeq of d holds ConsecutiveDelta(q,O) is symmetric;

theorem 
  for d be BiFunction of A,L st d is symmetric u.t.i. for q being
  QuadrSeq of d st O c= DistEsti(d) holds ConsecutiveDelta(q,O) is u.t.i.;

theorem 
  for d being distance_function of A,L for q being QuadrSeq of d st O c=
DistEsti(d) holds ConsecutiveDelta(q,O) is distance_function of ConsecutiveSet(
  A,O),L;

definition
  let A,L;
  let d be BiFunction of A,L;
  func NextSet(d) equals

  ConsecutiveSet(A,DistEsti(d));
end;

registration
  let A,L;
  let d be BiFunction of A,L;
  cluster NextSet(d) -> non empty;
end;

definition
  let A,L;
  let d be BiFunction of A,L;
  let q be QuadrSeq of d;
  func NextDelta(q) equals

  ConsecutiveDelta(q,DistEsti(d));
end;

definition
  let A,L;
  let d be distance_function of A,L;
  let q be QuadrSeq of d;
  redefine func NextDelta(q) -> distance_function of NextSet(d),L;
end;

definition
  let A,L;
  let d be distance_function of A,L;
  let Aq be non empty set, dq be distance_function of Aq,L;
  pred Aq, dq is_extension_of A,d means


  ex q being QuadrSeq of d st Aq = NextSet(d) & dq = NextDelta(q);
end;

theorem 
  for d be distance_function of A,L for Aq be non empty set, dq be
  distance_function of Aq,L st Aq, dq is_extension_of A,d for x,y being Element
  of A, a,b being Element of L st d.(x,y) <= a "\/" b ex z1,z2,z3 being Element
  of Aq st dq.(x,z1) = a & dq.(z2,z3) = a & dq.(z1,z2) = b & dq.(z3,y) = b;

definition
  let A,L;
  let d be distance_function of A,L;
  mode ExtensionSeq of A,d -> Function means


    dom it = NAT & it.0 = [A,
    d] & for n being Element of NAT holds ex A9 being non empty set, d9 being
distance_function of A9,L, Aq being non empty set, dq being distance_function
of Aq,L st Aq, dq is_extension_of A9,d9 & it.n = [A9,d9] & it.(n+1) = [Aq,dq];
end;

theorem 
  for d be distance_function of A,L for S being ExtensionSeq of A,
  d for k,l being Element of NAT st k <= l holds (S.k)`1 c= (S.l)`1;

theorem 
  for d be distance_function of A,L for S being ExtensionSeq of A,
  d for k,l being Element of NAT st k <= l holds (S.k)`2 c= (S.l)`2;

definition
  let L;
  func BasicDF(L) -> distance_function of the carrier of L,L means


  for x,y being Element of L holds (x <> y implies it.(x,y) = x"\/"y) & (x = y
  implies it.(x,y) = Bottom L);
end;

theorem 
  BasicDF(L) is onto;

theorem 
  for S being ExtensionSeq of the carrier of L, BasicDF(L) for FS
  being non empty set st FS = union { (S.i)`1 where i is Element of NAT: not
  contradiction} holds union { (S.i)`2 where i is Element of NAT: not
  contradiction} is distance_function of FS,L;

theorem 
  for S being ExtensionSeq of the carrier of L, BasicDF(L) for FS
  being non empty set, FD being distance_function of FS,L for x,y being Element
of FS for a,b being Element of L
   st FS = union { (S.i)`1 where i is Element of
  NAT: not contradiction} &
    FD = union { (S.i)`2 where i is Element of NAT: not
contradiction} & FD.(x,y) <= a"\/"b ex z1,z2,z3 being Element of FS st FD.(x,z1
  ) = a & FD.(z2,z3) = a & FD.(z1,z2) = b & FD.(z3,y) = b;



theorem 
  for S being ExtensionSeq of the carrier of L, BasicDF(L) for FS
  being non empty set for FD being distance_function of FS,L for f being
  Homomorphism of L,EqRelLATT FS for x, y being Element of FS for e1,e2 being
  Equivalence_Relation of FS,x,y st f = alpha FD &
   FS = union { (S.i)`1 where i
is Element of NAT: not contradiction} &
   FD = union { (S.i)`2 where i is Element
  of NAT: not contradiction} & e1 in the carrier of Image f & e2 in the carrier
of Image f & [x,y] in e1 "\/" e2 ex F being non empty FinSequence of FS st len
  F = 3+2 & x,y are_joint_by F,e1,e2;


theorem 
  ex A being non empty set, f being Homomorphism of L,EqRelLATT A st f
  is one-to-one & type_of Image f <= 3;














begin

reserve x for set;



theorem 
  3 = {0,1,2};

theorem 
  2\1={1};

theorem 
  3\1 = {1,2};

theorem 
  3\2 = {2};

begin

theorem 
  for L being antisymmetric reflexive with_infima with_suprema
  RelStr for a,b being Element of L holds a"/\"b = b iff a"\/"b = a;

theorem 
  for L being LATTICE for a,b,c being Element of L holds (a"/\"b)
  "\/"(a"/\"c) <= a"/\"(b"\/"c);

theorem 
  for L being LATTICE for a,b,c being Element of L holds a"\/"(b
  "/\"c) <= (a"\/"b)"/\"(a"\/"c);

theorem 
  for L being LATTICE for a,b,c being Element of L holds a <= c
  implies a"\/"(b"/\"c) <= (a"\/"b) "/\"c;

definition
  func N_5 -> RelStr equals

  InclPoset {0, 3 \ 1, 2, 3 \ 2, 3};
end;

registration
  cluster N_5 -> strict reflexive transitive antisymmetric;
  cluster N_5 -> with_infima with_suprema;
end;

definition
  func M_3 -> RelStr equals

  InclPoset{ 0, 1, 2 \ 1, 3 \ 2, 3 };
end;

registration
  cluster M_3 -> strict reflexive transitive antisymmetric;
  cluster M_3 -> with_infima with_suprema;
end;

theorem 
  for L being LATTICE holds (ex K being full Sublattice of L st N_5
,K are_isomorphic) iff ex a,b,c,d,e being Element of L st a<>b & a<>c & a<>d &
a<>e & b<>c & b<>d & b<>e & c <>d & c <>e & d<>e & a"/\"b = a & a"/\"c = a & c
"/\"e = c & d"/\"e = d & b"/\"c = a & b"/\"d = b & c"/\"d = a & b"\/"c = e & c
  "\/"d = e;

theorem 
  for L being LATTICE holds (ex K being full Sublattice of L st
M_3,K are_isomorphic) iff ex a,b,c,d,e being Element of L st a<>b & a<>c & a<>d
& a<>e & b<>c & b<>d & b<>e & c <>d & c <>e & d<>e & a"/\"b = a & a"/\"c = a &
a"/\"d = a & b"/\"e = b & c"/\"e = c & d"/\"e = d & b"/\"c = a & b"/\"d = a & c
  "/\"d = a & b"\/"c = e & b"\/"d = e & c"\/"d = e;

begin

definition
  let L be non empty RelStr;
  attr L is modular means


  for a,b,c being Element of L st a <= c holds a"\/"(b"/\"c) = (a"\/"b)"/\"c;
end;

registration
  cluster distributive -> modular for non empty antisymmetric reflexive
    with_infima RelStr;
end;

theorem 
  for L being LATTICE holds L is modular iff not ex K being full
  Sublattice of L st N_5,K are_isomorphic;

theorem 
  for L being LATTICE st L is modular holds L is distributive iff not ex
  K being full Sublattice of L st M_3,K are_isomorphic;

begin

definition
  let L be non empty RelStr;
  let a,b be Element of L;
  func [#a,b#] -> Subset of L means


  for c being Element of L holds c in it iff a <= c & c <= b;
end;

definition
  let L be non empty RelStr;
  let IT be Subset of L;
  attr IT is interval means


  ex a,b being Element of L st IT = [#a,b#];
end;

registration
  let L be non empty reflexive transitive RelStr;
  cluster non empty interval -> directed for (Subset of L);
  cluster non empty interval -> filtered for (Subset of L);
end;

registration
  let L be non empty RelStr;
  let a,b be Element of L;
  cluster [#a,b#] -> interval;
end;

theorem 
  for L being non empty reflexive transitive RelStr, a,b being Element
  of L holds [#a,b#] = uparrow a /\ downarrow b;

registration
  let L be with_infima Poset;
  let a,b be Element of L;
  cluster subrelstr[#a,b#] -> meet-inheriting;
end;

registration
  let L be with_suprema Poset;
  let a,b be Element of L;
  cluster subrelstr[#a,b#] -> join-inheriting;
end;

theorem 
  for L being LATTICE, a,b being Element of L holds L is modular implies
  subrelstr[#b,a"\/"b#],subrelstr[#a"/\" b,a#] are_isomorphic;

registration
  cluster finite non empty for LATTICE;
end;

registration
  cluster finite -> lower-bounded for Semilattice;
end;

registration
  cluster finite -> complete for LATTICE;
end;














begin  

theorem 
  for T being T_1 non empty TopSpace, A being finite Subset of T
  holds A is closed;

registration
  let T be T_1 non empty TopSpace;
  cluster finite -> closed for Subset of T;
end;

registration
  let T be compact TopStruct;
  cluster [#]T -> compact;
end;

registration
  cluster finite T_1 -> discrete for non empty TopSpace;
end;

registration
  cluster finite -> compact for TopSpace;
end;

theorem 
  for T being discrete non empty TopSpace holds T is normal;

theorem 
  for T being discrete non empty TopSpace holds T is regular;

theorem 
  for T being discrete non empty TopSpace holds T is T_2;

theorem 
  for T being discrete non empty TopSpace holds T is T_1;

registration
  cluster discrete non empty -> normal regular T_2 T_1 for TopSpace;
end;

registration
  cluster T_4 -> regular for non empty TopSpace;
end;

registration
  cluster T_3 -> T_2 for TopSpace;
end;

theorem 
  for S being reflexive RelStr, T being reflexive transitive RelStr
  , f being Function of S, T, X being Subset of S holds downarrow (f.:X) c=
  downarrow (f.:downarrow X);

theorem 
  for S being reflexive RelStr, T being reflexive transitive RelStr, f
being Function of S, T, X being Subset of S st f is monotone holds downarrow (f
  .:X) = downarrow (f.:downarrow X);

theorem 
  for N being non empty Poset holds IdsMap N is one-to-one;

registration
  let N be non empty Poset;
  cluster IdsMap N -> one-to-one;
end;

theorem 
  for N being finite LATTICE holds SupMap N is one-to-one;

registration
  let N be finite LATTICE;
  cluster SupMap N -> one-to-one;
end;

theorem 
  for N being finite LATTICE holds N, InclPoset Ids N are_isomorphic;

theorem 
  for N being complete non empty Poset, x being Element of N, X
  being non empty Subset of N holds x"/\" preserves_inf_of X;

theorem 
  for N being complete non empty Poset, x being Element of N
  holds x"/\" is meet-preserving;

registration
  let N be complete non empty Poset, x be Element of N;
  cluster x"/\" -> meet-preserving;
end;

begin  

theorem 
  for T being anti-discrete non empty TopStruct, p being Point of T
  holds {the carrier of T} is Basis of p;

theorem 
  for T being anti-discrete non empty TopStruct, p being Point of T, D
  being Basis of p holds D = {the carrier of T};

theorem 
  for T being non empty TopSpace, P being Basis of T, p being Point of T
  holds {A where A is Subset of T: A in P & p in A} is Basis of p;

theorem 
  for T being non empty TopStruct, A being Subset of T, p being Point of
  T holds p in Cl A iff for K being Basis of p, Q being Subset of T st Q in K
  holds A meets Q;

theorem 
  for T being non empty TopStruct, A being Subset of T, p being Point of
T holds p in Cl A iff ex K being Basis of p st for Q being Subset of T st Q in
  K holds A meets Q;

definition
  let T be TopStruct, p be Point of T;
  mode basis of p -> Subset-Family of T means


    for A being Subset of T
    st p in Int A ex P being Subset of T st P in it & p in Int P & P c= A;
end;

definition
  let T be non empty TopSpace, p be Point of T;
  redefine mode basis of p means

    for A being a_neighborhood of p ex P being
    a_neighborhood of p st P in it & P c= A;
end;

theorem 
  for T being TopStruct, p being Point of T holds bool the carrier
  of T is basis of p;

theorem 
  for T being non empty TopSpace, p being Point of T, P being
  basis of p holds P is non empty;

registration
  let T be non empty TopSpace, p be Point of T;
  cluster -> non empty for basis of p;
end;

registration
  let T be TopStruct, p be Point of T;
  cluster non empty for basis of p;
end;

definition
  let T be TopStruct, p be Point of T, P be basis of p;
  attr P is correct means


  for A being Subset of T holds A in P iff p in Int A;
end;

registration
  let T be TopStruct, p be Point of T;
  cluster correct for basis of p;
end;

theorem 
  for T being TopStruct, p being Point of T holds {A where A is Subset
  of T: p in Int A} is correct basis of p;

registration
  let T be non empty TopSpace, p be Point of T;
  cluster non empty correct for basis of p;
end;

theorem 
  for T being anti-discrete non empty TopStruct, p being Point of T
  holds {the carrier of T} is correct basis of p;

theorem 
  for T being anti-discrete non empty TopStruct, p being Point of T, D
  being correct basis of p holds D = {the carrier of T};

theorem 
  for T being non empty TopSpace, p being Point of T, P being Basis of p
  holds P is basis of p;

definition
  let T be TopStruct;
  mode basis of T -> Subset-Family of T means


    for p being Point of T holds it is basis of p;
end;

theorem 
  for T being TopStruct holds bool the carrier of T is basis of T;

theorem 
  for T being non empty TopSpace, P being basis of T holds P is non empty;

registration
  let T be non empty TopSpace;
  cluster -> non empty for basis of T;
end;

registration
  let T be TopStruct;
  cluster non empty for basis of T;
end;

theorem 
  for T being non empty TopSpace, P being basis of T holds the topology
  of T c= UniCl Int P;

theorem 
  for T being TopSpace, P being Basis of T holds P is basis of T;

definition
  let T be non empty TopSpace-like TopRelStr;
  attr T is topological_semilattice means


  for f being Function of [:T,T qua TopSpace:], T st f = inf_op T
   holds f is continuous;
end;

registration
  cluster reflexive -> topological_semilattice
    for 1-element TopSpace-like TopRelStr;
end;

theorem 
  for T being topological_semilattice non empty TopSpace-like
  TopRelStr, x being Element of T holds x"/\" is continuous;

registration
  let T be topological_semilatticenon empty TopSpace-like TopRelStr, x be
  Element of T;
  cluster x"/\" -> continuous;
end;














begin 

reserve r,s,t for Real;

theorem 
  for X being non empty RLSStruct, M being Subset of X, x being Point of
  X, r being Real st x in M holds r*x in r*M;

registration
  cluster non zero for Real;
end;

theorem 
  for T being non empty TopSpace, X being non empty Subset of T, FX
  being Subset-Family of T st FX is Cover of X for x being Point of T st x in X
  ex W being Subset of T st x in W & W in FX;

theorem 
  for X being non empty addLoopStr, M,N being Subset of X, x,y
  being Point of X st x in M & y in N holds x+y in M+N;

theorem 
  for X being non empty addLoopStr, M,N being Subset of X, F being
Subset-Family of X st F = {x+N where x is Point of X: x in M} holds M+N = union
  F;

theorem 
  for X being add-associative right_zeroed right_complementable
  non empty addLoopStr, M being Subset of X holds 0.X+M = M;

theorem 
  for X being add-associative non empty addLoopStr,x,y being
  Point of X, M being Subset of X holds x+y+M = x+(y+M);

theorem 
  for X being add-associative non empty addLoopStr, x being Point
  of X, M,N being Subset of X holds x+M+N = x+(M+N);

theorem 
  for X being non empty addLoopStr, M,N being Subset of X, x being
  Point of X st M c= N holds x+M c= x+N;

theorem 
  for X being add-associative right_zeroed right_complementable
non empty addLoopStr, M being Subset of X, x being Point of X st x in M holds
  0.X in -x+M;

theorem 
  for X being non empty addLoopStr, M,N,V being Subset of X st M
  c= N holds M+V c= N+V;

theorem 
  for X being non empty addLoopStr, V1,V2,W1,W2 being Subset of X
  st V1 c= W1 & V2 c= W2 holds V1+V2 c= W1+W2;

theorem 
  for X being right_zeroed non empty addLoopStr, V1,V2 being
  Subset of X st 0.X in V2 holds V1 c= V1+V2;

theorem 
  for X being RealLinearSpace, r being Real holds r*{0.X} = {0.X};

theorem 
  for X being RealLinearSpace, M being Subset of X, r being non zero
  Real st 0.X in r*M holds 0.X in M;

theorem 
  for X being RealLinearSpace, M,N being Subset of X, r being non
  zero Real holds (r * M) /\ (r * N) = r * (M /\ N);

theorem 
  for X being non empty TopSpace, x being Point of X, A being
a_neighborhood of x, B being Subset of X st A c= B holds B is a_neighborhood of
  x;

definition
  let V be RealLinearSpace, M be Subset of V;
  redefine attr M is convex means


  for u,v being Point of V, r being
  Real st 0 <= r & r <= 1 & u in M & v in M holds r*u + (1-r)*v in M;
end;

registration
  let X be RealLinearSpace, M be empty Subset of X;
  cluster conv(M) -> empty;
end;

theorem 
  for X being RealLinearSpace, M being convex Subset of X holds conv(M) = M;

theorem 
  for X being RealLinearSpace, M being Subset of X, r being Real
  holds r*conv(M) = conv(r*M);

theorem 
  for X being RealLinearSpace, M1,M2 being Subset of X st M1 c= M2
  holds Convex-Family M2 c= Convex-Family M1;

theorem 
  for X being RealLinearSpace, M1,M2 being Subset of X st M1 c= M2
  holds conv(M1) c= conv(M2);

theorem 
  for X being RealLinearSpace, M being convex Subset of X, r being Real
  st 0 <= r & r <= 1 & 0.X in M holds r*M c= M;

definition
  let X be RealLinearSpace, v,w be Point of X;
  func LSeg(v,w) -> Subset of X equals

  {(1-r)*v + r*w : 0 <= r & r <= 1 };
  commutativity;
end;

registration
  let X be RealLinearSpace, v,w be Point of X;
  cluster LSeg(v,w) -> non empty convex;
end;

theorem 
  for X being RealLinearSpace, M being Subset of X holds M is convex iff
  for u,w being Point of X st u in M & w in M holds LSeg(u,w) c= M;

definition
  let V be non empty RLSStruct, P be Subset-Family of V;
  attr P is convex-membered means


  for M being Subset of V st M in P holds M is convex;
end;

registration
  let V be non empty RLSStruct;
  cluster non empty convex-membered for Subset-Family of V;
end;

theorem 
  for V being non empty RLSStruct, F being convex-membered Subset-Family
  of V holds meet F is convex;

definition
  let X be non empty RLSStruct, A be Subset of X;
  func -A -> Subset of X equals

  (-1)*A;
end;

theorem 
  for X being RealLinearSpace, M,N being Subset of X, v being
  Point of X holds v+M meets N iff v in N+(-M);

definition
  let X be non empty RLSStruct, A be Subset of X;
  attr A is symmetric means


  A = -A;
end;

registration
  let X be RealLinearSpace;
  cluster non empty symmetric for Subset of X;
end;

theorem 
  for X being RealLinearSpace, A being symmetric Subset of X, x
  being Point of X st x in A holds -x in A;

definition
  let X be non empty RLSStruct, A be Subset of X;
  attr A is circled means


  for r being Real st abs(r) <= 1 holds r*A c= A;
end;

registration
  let X be non empty RLSStruct;
  cluster empty -> circled for Subset of X;
end;

theorem 
  for X being RealLinearSpace holds {0.X} is circled;

registration
  let X be RealLinearSpace;
  cluster non empty circled for Subset of X;
end;

theorem 
  for X being RealLinearSpace, B being non empty circled Subset of
  X holds 0.X in B;

registration
  let X be RealLinearSpace, A,B be circled Subset of X;
  cluster A+B -> circled;
end;

theorem 
  for X being RealLinearSpace, A being circled Subset of X for r
  being Real st abs(r) = 1 holds r*A = A;

registration
  let X be RealLinearSpace;
  cluster circled -> symmetric for Subset of X;
end;

registration
  let X be RealLinearSpace, M be circled Subset of X;
  cluster conv(M) -> circled;
end;

definition
  let X be non empty RLSStruct, F be Subset-Family of X;
  attr F is circled-membered means


  for V being Subset of X st V in F holds V is circled;
end;

registration
  let V be non empty RLSStruct;
  cluster non empty circled-membered for Subset-Family of V;
end;

theorem 
  for X being non empty RLSStruct, F being circled-membered
  Subset-Family of X holds union F is circled;

theorem 
  for X being non empty RLSStruct, F being circled-membered
  Subset-Family of X holds meet F is circled;

begin

definition
  struct(RLSStruct,TopStruct) RLTopStruct (# carrier -> set, ZeroF -> Element
of the carrier, addF -> BinOp of the carrier, Mult -> Function of [:REAL, the
    carrier:],the carrier, topology -> Subset-Family of the carrier #);
end;

registration
  let X be non empty set, O be Element of X, F be BinOp of X, G be Function of
  [:REAL,X:],X, T be Subset-Family of X;
  cluster RLTopStruct (# X,O,F,G,T #) -> non empty;
end;

registration
  cluster strict non empty for RLTopStruct;
end;

definition
  let X be non empty RLTopStruct;
  attr X is add-continuous means


  for x1,x2 being Point of X, V being
Subset of X st V is open & x1+x2 in V ex V1,V2 being Subset of X st V1 is open
  & V2 is open & x1 in V1 & x2 in V2 & V1+V2 c= V;
  attr X is Mult-continuous means


  for a being Real, x being Point of X,
  V being Subset of X st V is open & a*x in V ex r being positive Real, W being
Subset of X st W is open & x in W & for s being Real st abs(s - a) < r holds s*
  W c= V;
end;

registration
  cluster strict add-continuous Mult-continuous TopSpace-like Abelian
    add-associative right_zeroed right_complementable vector-distributive
    scalar-distributive scalar-associative scalar-unital for non
    empty RLTopStruct;
end;

definition
  mode LinearTopSpace is add-continuous Mult-continuous TopSpace-like Abelian
    add-associative right_zeroed right_complementable vector-distributive
    scalar-distributive scalar-associative scalar-unital
     non empty RLTopStruct;
end;

theorem 
  for X being LinearTopSpace, x1,x2 being Point of X, V being
  a_neighborhood of x1+x2 ex V1 being a_neighborhood of x1, V2 being
  a_neighborhood of x2 st V1+V2 c= V;

theorem 
  for X being LinearTopSpace, a being Real, x being Point of X, V
being a_neighborhood of a*x ex r being positive Real, W being a_neighborhood of
  x st for s being Real st abs(s - a) < r holds s*W c= V;

definition
  let X be non empty RLTopStruct, a be Point of X;
  func transl(a,X) -> Function of X,X means


  for x being Point of X holds it.x = a+x;
end;

theorem 
  for X being non empty RLTopStruct, a being Point of X, V being
  Subset of X holds transl(a,X).:V = a+V;

theorem 
  for X being LinearTopSpace, a being Point of X holds rng transl( a,X) = [#]X;

theorem 
  for X being LinearTopSpace, a being Point of X holds transl(a,X)
  " = transl(-a,X);

registration
  let X be LinearTopSpace, a be Point of X;
  cluster transl(a,X) -> being_homeomorphism;
end;

registration
  let X be LinearTopSpace, E be open Subset of X, x be Point of X;
  cluster x+E -> open;
end;

registration
  let X be LinearTopSpace, E be open Subset of X, K be Subset of X;
  cluster K+E -> open;
end;

registration
  let X be LinearTopSpace, D be closed Subset of X, x be Point of X;
  cluster x+D -> closed;
end;

theorem 
  for X being LinearTopSpace, V1,V2,V being Subset of X st V1+V2
  c= V holds Int V1 + Int V2 c= Int V;

theorem 
  for X being LinearTopSpace, x being Point of X, V being Subset
  of X holds x+Int(V) = Int(x+V);

theorem 
  for X being LinearTopSpace, x being Point of X, V being Subset of X
  holds x+Cl(V) = Cl(x+V);

theorem 
  for X being LinearTopSpace, x,v being Point of X, V being
  a_neighborhood of x holds v+V is a_neighborhood of v+x;

theorem 
  for X being LinearTopSpace, x being Point of X, V being a_neighborhood
  of x holds -x+V is a_neighborhood of 0.X;

definition
  let X be non empty RLTopStruct;
  mode local_base of X is basis of 0.X;
end;

definition
  let X be non empty RLTopStruct;
  attr X is locally-convex means


  ex P being local_base of X st P is convex-membered;
end;

definition
  let X be LinearTopSpace, E be Subset of X;
  attr E is bounded means


  for V being a_neighborhood of 0.X ex s st s
  > 0 & for t st t > s holds E c= t*V;
end;

registration
  let X be LinearTopSpace;
  cluster empty -> bounded for Subset of X;
end;

registration
  let X be LinearTopSpace;
  cluster bounded for Subset of X;
end;

theorem 
  for X being LinearTopSpace, V1,V2 being bounded Subset of X
  holds V1 \/ V2 is bounded;

theorem 
  for X being LinearTopSpace, P being bounded Subset of X, Q being
  Subset of X st Q c= P holds Q is bounded;

theorem 
  for X being LinearTopSpace, F being Subset-Family of X st F is finite
  & F = {P where P is bounded Subset of X: not contradiction} holds union F is
  bounded;

theorem 
  for X being LinearTopSpace, P being Subset-Family of X st P = {U
where U is a_neighborhood of 0.X: not contradiction} holds P is local_base of X
;

theorem 
  for X being LinearTopSpace, O being local_base of X, P being
Subset-Family of X st P = {a+U where a is Point of X, U is Subset of X: U in O}
  holds P is basis of X;

definition
  let X be non empty RLTopStruct, r be Real;
  func mlt(r,X) -> Function of X,X means


  for x being Point of X holds it.x = r*x;
end;

theorem 
  for X being non empty RLTopStruct, V being Subset of X, r being
  non zero Real holds mlt(r,X).:V = r*V;

theorem 
  for X being LinearTopSpace, r being non zero Real holds rng mlt( r,X) = [#]X;

theorem 
  for X being LinearTopSpace, r being non zero Real holds mlt(r,X)
  " = mlt(r",X);

registration
  let X be LinearTopSpace, r be non zero Real;
  cluster mlt(r,X) -> being_homeomorphism;
end;

theorem 
  for X being LinearTopSpace, V being open Subset of X, r being
  non zero Real holds r*V is open;

theorem 
  for X being LinearTopSpace, V being closed Subset of X, r being
  non zero Real holds r*V is closed;

theorem 
  for X being LinearTopSpace, V being Subset of X, r be non zero
  Real holds r*Int(V) = Int(r*V);

theorem 
  for X being LinearTopSpace, A being Subset of X, r being non
  zero Real holds r*Cl(A) = Cl(r*A);

theorem 
  for X being LinearTopSpace,A being Subset of X st X is T_1 holds 0*Cl(
  A) = Cl(0*A);

theorem 
  for X being LinearTopSpace, x being Point of X, V being
  a_neighborhood of x, r be non zero Real holds r*V is a_neighborhood of r*x;

theorem 
  for X being LinearTopSpace, V being a_neighborhood of 0.X, r be
  non zero Real holds r*V is a_neighborhood of 0.X;

registration
  let X be LinearTopSpace, V be bounded Subset of X, r be Real;
  cluster r*V -> bounded;
end;

theorem 
  for X being LinearTopSpace, W being a_neighborhood of 0.X ex U
  being open a_neighborhood of 0.X st U is symmetric & U+U c= W;

theorem 
  for X being LinearTopSpace, K being compact Subset of X, C being
closed Subset of X st K misses C ex V being a_neighborhood of 0.X st K+V misses
  C+V;

theorem 
  for X being LinearTopSpace, B being local_base of X, V being
  a_neighborhood of 0.X ex W being a_neighborhood of 0.X st W in B & Cl W c= V;

theorem 
  for X being LinearTopSpace, V being a_neighborhood of 0.X ex W
  being a_neighborhood of 0.X st Cl W c= V;

registration
  cluster T_1 -> Hausdorff for LinearTopSpace;
end;

theorem 
  for X being LinearTopSpace, A being Subset of X holds Cl A = meet {A+V
  where V is a_neighborhood of 0.X: not contradiction};

theorem 
  for X being LinearTopSpace, A,B being Subset of X holds Int A +
  Int B c= Int(A+B);

theorem 
  for X being LinearTopSpace, A,B being Subset of X holds Cl A +
  Cl B c= Cl(A+B);

registration
  let X be LinearTopSpace, C be convex Subset of X;
  cluster Cl C -> convex;
end;

registration
  let X be LinearTopSpace, C be convex Subset of X;
  cluster Int C -> convex;
end;

registration
  let X be LinearTopSpace, B be circled Subset of X;
  cluster Cl B -> circled;
end;

theorem 
  for X being LinearTopSpace, B being circled Subset of X st 0.X in Int
  B holds Int B is circled;

registration
  let X be LinearTopSpace, E be bounded Subset of X;
  cluster Cl E -> bounded;
end;

theorem 
  for X being LinearTopSpace, U being a_neighborhood of 0.X ex W
  being a_neighborhood of 0.X st W is circled & W c= U;

theorem 
  for X being LinearTopSpace, U being a_neighborhood of 0.X st U
  is convex ex W being a_neighborhood of 0.X st W is circled convex & W c= U;

theorem 
  for X being LinearTopSpace ex P being local_base of X st P is
  circled-membered;

theorem 
  for X being LinearTopSpace st X is locally-convex ex P being
  local_base of X st P is convex-membered;

begin 


reserve V for RealLinearSpace,
  v,w for Point of V;

theorem 
  v in LSeg(v,w);

theorem 
  1/2*(v+w) in LSeg(v,w);

theorem 
  LSeg(v,v) = {v};

theorem 
  0.V in LSeg(v,w) implies ex r st v = r*w or w = r*v;














begin

definition
  func the_set_of_RealSequences -> non empty set means


  for x being set holds x in it iff x is Real_Sequence;
end;

definition
  let a be set such that
 a in the_set_of_RealSequences;
  func seq_id(a) -> Real_Sequence equals


  a;
end;

definition
  let a be set such that
 a in REAL;
  func R_id(a) -> Real equals


  a;
end;

definition
  func l_add -> BinOp of the_set_of_RealSequences means


  for a,b being
  Element of the_set_of_RealSequences holds it.(a,b) = seq_id(a)+seq_id(b);
end;

definition
  func l_mult -> Function of [: REAL, the_set_of_RealSequences :],
  the_set_of_RealSequences means


  for r,x be set st r in REAL & x in
  the_set_of_RealSequences holds it.(r,x) = R_id(r)(#)seq_id(x);
end;

definition
  func Zeroseq -> Element of the_set_of_RealSequences means


  for n be Element of NAT holds (seq_id it).n=0;
end;

theorem 
  for x be Real_Sequence holds seq_id x = x;

theorem 
  for v,w being VECTOR of RLSStruct(#the_set_of_RealSequences,Zeroseq,
    l_add,l_mult#) holds v + w = seq_id(v)+seq_id(w);

theorem 
  for r being Real, v being VECTOR of RLSStruct(#
the_set_of_RealSequences,Zeroseq,l_add,l_mult #) holds r * v = r(#)seq_id(v);

registration
  cluster RLSStruct (# the_set_of_RealSequences, Zeroseq, l_add, l_mult #) ->
    Abelian;
end;

theorem 
  for u,v,w being VECTOR of RLSStruct(# the_set_of_RealSequences,
    Zeroseq,l_add,l_mult #) holds (u + v) + w = u + (v + w);

theorem 
  for v being VECTOR of RLSStruct(# the_set_of_RealSequences,
    Zeroseq,l_add,l_mult #) holds v + 0.RLSStruct(# the_set_of_RealSequences,
    Zeroseq,l_add,l_mult #) = v;

theorem 
  for v being VECTOR of RLSStruct(# the_set_of_RealSequences,
    Zeroseq,l_add,l_mult #) ex w being VECTOR of RLSStruct(#
    the_set_of_RealSequences,Zeroseq,l_add,l_mult #) st v + w = 0.RLSStruct(#
    the_set_of_RealSequences,Zeroseq,l_add,l_mult #);

theorem 
  for a being Real, v,w being VECTOR of RLSStruct(#
the_set_of_RealSequences,Zeroseq,l_add,l_mult #) holds a * (v + w) = a * v + a
  * w;

theorem 
  for a,b being Real, v being VECTOR of RLSStruct(#
the_set_of_RealSequences,Zeroseq,l_add,l_mult #) holds (a + b) * v = a * v + b
  * v;

theorem 
  for a,b be Real, v being VECTOR of RLSStruct(#
the_set_of_RealSequences,Zeroseq,l_add,l_mult #) holds (a * b) * v = a * (b * v
  );

theorem 
  for v being VECTOR of RLSStruct(# the_set_of_RealSequences,
    Zeroseq,l_add,l_mult #) holds 1 * v = v;

definition
  func Linear_Space_of_RealSequences -> RLSStruct equals

  RLSStruct (#
    the_set_of_RealSequences, Zeroseq, l_add, l_mult #);
end;

registration
  cluster Linear_Space_of_RealSequences -> strict non empty;
end;

registration
  cluster Linear_Space_of_RealSequences -> Abelian add-associative
    right_zeroed right_complementable vector-distributive
    scalar-distributive scalar-associative scalar-unital;
end;

definition
  let X be RealLinearSpace;
  let X1 be Subset of X such that
 X1 is linearly-closed non empty;
  func Add_(X1,X) -> BinOp of X1 equals


  (the addF of X)||X1;
end;

definition
  let X be RealLinearSpace;
  let X1 be Subset of X such that
 X1 is linearly-closed non empty;
  func Mult_(X1,X) -> Function of [:REAL,X1:], X1 equals


  (the Mult of X) | [:REAL,X1:];
end;

definition
  let X be RealLinearSpace, X1 be Subset of X such that
 X1 is linearly-closed non empty;
  func Zero_(X1,X) -> Element of X1 equals


  0.X;
end;

theorem 
  for V be RealLinearSpace, V1 be Subset of V st V1 is
linearly-closed non empty holds RLSStruct (# V1,Zero_(V1,V), Add_(V1,V),Mult_(
    V1,V) #) is Subspace of V;

definition
  func the_set_of_l2RealSequences -> Subset of Linear_Space_of_RealSequences
  means


  for x being set holds x in it iff x in the_set_of_RealSequences &
  seq_id(x)(#)seq_id(x) is summable;
end;

registration
  cluster the_set_of_l2RealSequences -> linearly-closed non empty;
end;

theorem 
  RLSStruct(# the_set_of_l2RealSequences, Zero_(
    the_set_of_l2RealSequences,Linear_Space_of_RealSequences), Add_(
    the_set_of_l2RealSequences,Linear_Space_of_RealSequences), Mult_(
    the_set_of_l2RealSequences,Linear_Space_of_RealSequences) #) is Subspace of
  Linear_Space_of_RealSequences;

theorem 
  RLSStruct (# the_set_of_l2RealSequences, Zero_(
    the_set_of_l2RealSequences,Linear_Space_of_RealSequences), Add_(
    the_set_of_l2RealSequences,Linear_Space_of_RealSequences), Mult_(
the_set_of_l2RealSequences,Linear_Space_of_RealSequences) #) is RealLinearSpace
;

theorem 
  the carrier of Linear_Space_of_RealSequences =
  the_set_of_RealSequences & (for x be set holds x is VECTOR of
  Linear_Space_of_RealSequences iff x is Real_Sequence ) & (for u be VECTOR of
  Linear_Space_of_RealSequences holds u =seq_id(u) ) & (for u,v be VECTOR of
Linear_Space_of_RealSequences holds u+v =seq_id(u)+seq_id(v) ) & for r be Real
  for u be VECTOR of Linear_Space_of_RealSequences holds r*u =r(#)seq_id(u);

definition
  func l_scalar -> Function of [:the_set_of_l2RealSequences,
  the_set_of_l2RealSequences:], REAL means

  for x,y be set st x in
  the_set_of_l2RealSequences & y in the_set_of_l2RealSequences holds it.(x,y) =
  Sum(seq_id(x)(#)seq_id(y));
end;

registration
  cluster UNITSTR (# the_set_of_l2RealSequences, Zero_(
      the_set_of_l2RealSequences,Linear_Space_of_RealSequences), Add_(
      the_set_of_l2RealSequences,Linear_Space_of_RealSequences), Mult_(
the_set_of_l2RealSequences,Linear_Space_of_RealSequences), l_scalar #) -> non
    empty;
end;

definition
  func l2_Space -> non empty UNITSTR equals

  UNITSTR (#
    the_set_of_l2RealSequences, Zero_(the_set_of_l2RealSequences,
    Linear_Space_of_RealSequences), Add_(the_set_of_l2RealSequences,
    Linear_Space_of_RealSequences), Mult_(the_set_of_l2RealSequences,
    Linear_Space_of_RealSequences), l_scalar #);
end;

theorem 
  for l be RLSStruct st the RLSStruct of l is RealLinearSpace
  holds l is RealLinearSpace;

theorem 
  for rseq be Real_Sequence st (for n be Element of NAT holds rseq.n=0)
  holds rseq is summable & Sum rseq = 0;

theorem 
  for rseq be Real_Sequence st (for n be Element of NAT holds 0 <= rseq.
n) & rseq is summable & Sum rseq=0 holds for n be Element of NAT holds rseq.n =
  0;

registration
  cluster l2_Space -> Abelian add-associative right_zeroed
    right_complementable vector-distributive scalar-distributive
    scalar-associative scalar-unital;
end;














begin

reserve k,j,n for Nat,
  r for real number;

definition
  let n be Nat;
  func REAL n -> FinSequenceSet of REAL equals

  n-tuples_on REAL;
end;

registration
  let n be Nat;
  cluster REAL n -> non empty;
end;

registration
  let n;
  cluster -> n-element for Element of REAL n;
end;

definition
  func absreal -> Function of REAL,REAL means


  for r holds it.r = abs r;
end;

definition
  let x be real-valued FinSequence;
  redefine func abs x -> FinSequence of REAL equals

  absreal*x;
end;

definition
  let n;
  func 0*n -> real-valued FinSequence equals

  n |-> (0 qua Real);
end;

definition
  let n;
  redefine func 0*n -> Element of REAL n;
end;

reserve x,x1,x2,y for Element of REAL n;

definition
  let n,x;
  redefine func -x -> Element of REAL n;
end;

definition
  let n,x,y;
  redefine func x + y -> Element of REAL n;
  redefine func x - y -> Element of REAL n;
end;

definition
  let n, x;
  let r be real number;
  redefine func r*x -> Element of REAL n;
end;

definition
  let n,x;
  redefine func abs x -> Element of n-tuples_on REAL;
end;

definition
  let n,x;
  redefine func sqr x -> Element of n-tuples_on REAL;
end;

reserve f for real-valued FinSequence;

definition
  let f;
  func |. f .| -> Real equals

  sqrt Sum sqr f;
end;

canceled 3;

theorem 
  abs 0*n = n |-> (0 qua Real);

theorem 
  for f being complex-valued Function holds abs -f = abs f;

theorem 
  abs(r*f) = abs(r)*(abs f);

theorem 
  |.0*n.| = 0;

theorem 
  |. x .| = 0 implies x = 0*n;

theorem 
  |.f.| >= 0;

registration
  let f;
  cluster |.f.| -> non negative;
end;

theorem 
  |.-f.| = |.f.|;

theorem 
  |.r*f.| = abs(r)*|.f.|;

theorem 
  |.x1 + x2.| <= |.x1.| + |.x2.|;

theorem 
  |.x1 - x2.| <= |.x1.| + |.x2.|;

theorem 
  |.x1.| - |.x2.| <= |.x1 + x2.|;

theorem 
  |.x1.| - |.x2.| <= |.x1 - x2.|;

theorem 
  |.x1 - x2.| = 0 iff x1 = x2;

registration
  let n,x1;
  cluster |. x1 - x1 .| -> zero;
end;

theorem 
  x1 <> x2 implies |.x1 - x2.| > 0;

theorem 
  |.x1 - x2.| = |.x2 - x1.|;

theorem 
  |.x1 - x2.| <= |.x1 - x .| + |.x - x2.|;

definition
  let n be Nat;
  func Pitag_dist n -> Function of [:REAL n,REAL n:],REAL means


  for x,y being Element of REAL n holds it.(x,y) = |.x-y.|;
end;

theorem 
  for x, y being real-valued FinSequence holds sqr(x-y) = sqr(y-x);

theorem 
  for n being Nat holds Pitag_dist n is_metric_of REAL n;

definition
  let n be Nat;
  func Euclid n -> strict MetrSpace equals

  MetrStruct(#REAL n,Pitag_dist n#);
end;

registration
  let n be Nat;
  cluster Euclid n -> non empty;
end;

definition
  let n be Nat;
  func TOP-REAL n -> strict RLTopStruct means


  the TopStruct of it =
  TopSpaceMetr Euclid n & the RLSStruct of it = RealVectSpace Seg n;
end;

registration
  let n be Nat;
  cluster TOP-REAL n -> non empty;
end;

registration
  let n be Nat;
  cluster TOP-REAL n -> TopSpace-like Abelian add-associative right_zeroed
    right_complementable vector-distributive scalar-distributive
    scalar-associative scalar-unital;
end;

reserve p,p1,p2,p3 for Point of TOP-REAL n,
  x,x1,x2,y,y1,y2 for real number;

theorem 
  the carrier of TOP-REAL n = REAL n;

theorem 
  p is Function of Seg n, REAL;

theorem 
  p is FinSequence of REAL;

registration
  let n;
  cluster TOP-REAL n -> constituted-FinSeqs;
end;

registration
  let n;
  cluster -> FinSequence-like for Point of TOP-REAL n;
end;

registration
  let n;
  cluster -> real-valued for Point of TOP-REAL n;
end;

registration
  let r,s be real number;
  let n;
  let p be Element of TOP-REAL n;
  let f be real-valued FinSequence;
  identify r*p with s*f when r=s, p=f;
end;

registration
  let n;
  let p,q be Element of TOP-REAL n;
  let f,g be real-valued FinSequence;
  identify p+q with f+g when p=f, q=g;
end;

registration
  let n;
  let p be Element of TOP-REAL n;
  let f be real-valued FinSequence;
  identify -p with -f when p=f;
end;

registration
  let n;
  let p,q be Element of TOP-REAL n;
  let f,g be real-valued FinSequence;
  identify p-q with f-g when p=f, q=g;
end;

registration
  let n;
  cluster -> n-element for Point of TOP-REAL n;
end;

notation
  let n;
  synonym 0.REAL n for 0*n;
end;

definition
  let n;
  redefine func 0.REAL n -> Point of TOP-REAL n;
end;

theorem 
  for x being Element of REAL n holds sqr abs x = sqr x;

theorem 
  p1 + p2 + p3 = p1 + (p2 + p3);

theorem 
  0.TOP-REAL n + p = p & p + 0.TOP-REAL n = p;

theorem 
  x*0.TOP-REAL n = 0.TOP-REAL n;

theorem 
  1 * p = p & 0 * p = 0.TOP-REAL n;

theorem 
  (x*y)*p = x*(y*p);

theorem 
  x*p = 0.TOP-REAL n implies x = 0 or p = 0.TOP-REAL n;

theorem 
  x*(p1 + p2) = x*p1 + x*p2;

theorem 
  (x + y)*p = x*p + y*p;

theorem 
  x*p1 = x*p2 implies x = 0 or p1 = p2;

canceled;

theorem 
  p + -p = 0.TOP-REAL n;

theorem 
  p1 + p2 = 0.TOP-REAL n implies p1 = -p2;

theorem 
  -(p1 + p2) = -p1 - p2;

theorem 
  -p = (-1)*p;

theorem 
  -x*p = (-x)*p & -x*p = x*(-p);

theorem 
  p1 - p2 = p1 + -p2;

theorem 
  p - p = 0.TOP-REAL n;

theorem 
  p1 - p2 = 0.TOP-REAL n implies p1 = p2;

theorem 
  -(p1 - p2) = p2 - p1 & -(p1 - p2) = -p1 + p2;

theorem 
  p1 + (p2 - p3) = p1 + p2 - p3;

theorem 
  p1 - (p2 + p3) = p1 - p2 - p3;

theorem 
  p1 - (p2 - p3) = p1 - p2 + p3;

theorem 
  p = p + p1 - p1 & p = p - p1 + p1;

theorem 
  x*(p1 - p2) = x*p1 - x*p2;

theorem 
  (x-y)*p = x*p - y*p;

reserve p,p1,p2 for Point of TOP-REAL 2;

theorem 
  ex x,y being Real st p=<*x,y*>;

definition

  let p;
  func p`1 -> Real equals

  p.1;
  func p`2 -> Real equals

  p.2;
end;

notation
  let x,y be real number;
  synonym |[ x,y ]| for <*x,y*>;
end;

definition
  let x,y be real number;
  redefine func |[ x,y ]| -> Point of TOP-REAL 2;
end;

theorem 
  |[x,y]|`1 = x & |[x,y]|`2 = y;

theorem 
  p = |[p`1, p`2]|;

theorem 
  0.TOP-REAL 2 = |[0,0]|;

theorem 
  p1 + p2 = |[ p1`1 + p2`1, p1`2 + p2`2]|;

theorem 
  |[x1, y1]| + |[x2, y2]| = |[ x1 + x2, y1 + y2]|;

theorem 
  x*p = |[ x*p`1 ,x*p`2 ]|;

theorem 
  x*|[x1,y1]| = |[ x*x1,x*y1 ]|;

theorem 
  -p = |[ -p`1, -p`2]|;

theorem 
  -|[x1,y1]| = |[ -x1, -y1]|;

theorem 
  p1 - p2 = |[ p1`1 - p2`1, p1`2 - p2`2]|;

theorem 
  |[x1, y1]| - |[x2, y2]| = |[ x1 - x2, y1 - y2]|;

theorem 
  for P being Subset of TOP-REAL n, Q being non empty Subset of Euclid n
  holds P = Q implies (TOP-REAL n) |P = TopSpaceMetr((Euclid n) |Q);



theorem 
  for p1,p2 being Point of TOP-REAL n for r1,r2 being real-valued
  Function st p1 = r1 & p2 =r2 holds p1+p2 = r1+r2;

theorem 
  for p being Point of TOP-REAL n for r being real-valued Function st
  p = r holds x*p = x(#)r;

theorem 
  0.REAL n = 0.TOP-REAL n;

theorem 
  the carrier of Euclid n = the carrier of TOP-REAL n;

theorem 
  for p1 being Point of TOP-REAL n for r1 being real-valued Function st
  p1 = r1 holds -p1 = -r1;

theorem 
  for p1,p2 being Point of TOP-REAL n for r1,r2 being real-valued
  Function st p1 = r1 & p2 =r2 holds p1-p2 = r1-r2;

theorem 
  0.TOP-REAL n = 0*n;

theorem 
  for p being Point of TOP-REAL n holds |.-p.| = |.p.|;

registration
  let n; let D be set;
  cluster n-tuples_on D -> FinSequence-membered;
end;

registration
  let n;
  cluster REAL n -> FinSequence-membered;
end;

registration
  let n;
  cluster REAL n -> real-functions-membered;
end;



definition
  let n be Nat;
  func 1*n -> FinSequence of REAL equals

  n |-> (1 qua Real);
end;

definition
  let n be Nat;
  redefine func 1*n -> Element of REAL n;
end;

definition
  let n be Nat;
  func 1.REAL n -> Point of TOP-REAL n equals

  1*n;
end;

theorem 
  abs 1*n = n |-> (1 qua Real);

theorem 
  |.1*n.| = sqrt n;

theorem 
  |. (1.REAL n) .| = sqrt n;

theorem 
  1<=n implies 1<=|. (1.REAL n) .|;

theorem 
  for f being FinSequence of REAL holds
   f is Element of REAL len f & f is Point of TOP-REAL len f;

theorem 
  REAL 0 = {0.TOP-REAL 0};















begin

reserve x,r,a for Real;
reserve f,g for Function,
  x1,x2 for set;

theorem 
  f is one-to-one & g is one-to-one & (for x1,x2 st x1 in dom g & x2 in
  dom f \ dom g holds g.x1 <> f.x2) implies f+*g is one-to-one;

theorem 
  f.:(dom f /\ dom g) c= rng g implies rng f \/ rng g = rng(f+*g);

reserve T for T_2 TopSpace;

theorem 
  for P, Q being Subset of T for p being Point of T, f being Function of
  I[01], T|P, g being Function of I[01], T|Q st P /\ Q = {p} & f is
  being_homeomorphism & f.1 = p & g is being_homeomorphism & g.0 = p ex h being
Function of I[01], T|(P \/ Q) st h is being_homeomorphism & h.0 = f.0 & h.1 = g
  .1;















begin

reserve r,lambda for Real,
  i,j,n for Nat;



scheme 

  FraenkelAlt {A() -> non empty set, P[set], Q[set]}: {v where v is Element of
A(): P[v] or Q[v]} = {v1 where v1 is Element of A(): P[v1]} \/ {v2 where v2 is
  Element of A(): Q[v2]};



reserve p,p1,p2,q1,q2 for Point of TOP-REAL 2,
  P, P1 for Subset of TOP-REAL 2;
reserve T for TopSpace;

definition
  let T;
  let p1, p2 be Point of T, P be Subset of T;

  pred P is_an_arc_of p1,p2 means


  ex f being Function of I[01], T|P st
  f is being_homeomorphism & f.0 = p1 & f.1 = p2;
end;

theorem 
  for P being Subset of T, p1,p2 being Point of T st P is_an_arc_of
  p1,p2 holds p1 in P & p2 in P;

theorem 
  for T being T_2 TopSpace for P,Q being Subset of T, p1,p2,q1
being Point of T st P is_an_arc_of p1,p2 & Q is_an_arc_of p2,q1 & P /\ Q = {p2}
  holds P \/ Q is_an_arc_of p1,q1;

definition

  func R^2-unit_square -> Subset of TOP-REAL 2 equals

  ( LSeg(|[0,0]|,|[0,1]|)
\/ LSeg(|[0,1]|,|[1,1]|) ) \/ ( LSeg(|[1,1]|,|[1,0]|) \/ LSeg(|[1,0]|,|[0,0]|)
  );
end;

theorem 
  p1`1 <= p2`1 & p in LSeg(p1,p2) implies p1`1 <= p`1 & p`1 <= p2`1;

theorem 
  p1`2 <= p2`2 & p in LSeg(p1,p2) implies p1`2 <= p`2 & p`2 <= p2`2;

theorem 
  for p,p1,p2 being Point of TOP-REAL n st p in LSeg(p1,p2) holds
  LSeg(p1,p2) = LSeg(p1,p) \/ LSeg(p,p2);

theorem 
  for p1,p2,q1,q2 being Point of TOP-REAL n st q1 in LSeg(p1,p2) &
  q2 in LSeg(p1,p2) holds LSeg(q1,q2) c= LSeg(p1,p2);

theorem 
  for p,q,p1,p2 being Point of TOP-REAL n st p in LSeg(p1,p2) & q in
  LSeg(p1,p2) holds LSeg(p1,p2) = LSeg(p1,p) \/ LSeg(p,q) \/ LSeg(q,p2);

theorem 
  for p, p1, p2 being Point of TOP-REAL n st p in LSeg(p1,p2) holds LSeg
  (p1,p) /\ LSeg(p,p2) = {p};

registration
  let n;
  cluster the carrier of TOP-REAL n -> functional;
end;

theorem 
  for p1,p2 being Point of TOP-REAL n st p1 <> p2 holds
  LSeg(p1,p2) is_an_arc_of p1,p2;

registration
  let n;
  cluster TOP-REAL n -> T_2;
end;

theorem 
  for P being Subset of TOP-REAL n, p1,p2,q1 being Point of
TOP-REAL n st P is_an_arc_of p1,p2 & P /\ LSeg(p2,q1) = {p2} holds P \/ LSeg(p2
  ,q1) is_an_arc_of p1,q1;

theorem 
  for P being Subset of TOP-REAL n, p1,p2,q1 being Point of
TOP-REAL n st P is_an_arc_of p2,p1 & LSeg(q1,p2) /\ P = {p2} holds LSeg(q1,p2)
  \/ P is_an_arc_of q1,p1;

theorem 
  for p1,p2,q1 being Point of TOP-REAL n st (p1 <> p2 or p2 <> q1) &
LSeg(p1,p2) /\ LSeg(p2,q1) = {p2} holds LSeg(p1,p2) \/ LSeg(p2,q1) is_an_arc_of
  p1,q1;

theorem 
  LSeg(|[ 0,0 ]|, |[ 0,1 ]|) = { p1 : p1`1 = 0 & p1`2 <= 1 & p1`2
>= 0} & LSeg(|[ 0,1 ]|, |[ 1,1 ]|) = { p2 : p2`1 <= 1 & p2`1 >= 0 & p2`2 = 1} &
LSeg(|[ 0,0 ]|, |[ 1,0 ]|) = { q1 : q1`1 <= 1 & q1`1 >= 0 & q1`2 = 0} & LSeg(|[
  1,0 ]|, |[ 1,1 ]|) = { q2 : q2`1 = 1 & q2`2 <= 1 & q2`2 >= 0};

theorem 
  R^2-unit_square ={ p : p`1 = 0 & p`2 <= 1 & p`2 >= 0 or p`1 <= 1 & p`1
>= 0 & p`2 = 1 or p`1 <= 1 & p`1 >= 0 & p`2 = 0 or p`1 = 1 & p`2 <= 1 & p`2 >=
  0};

registration
  cluster R^2-unit_square -> non empty;
end;

theorem 
  LSeg(|[0,0]|,|[0,1]|) /\ LSeg(|[0,1]|,|[1,1]|) = {|[0,1]|};

theorem 
  LSeg(|[0,0]|,|[1,0]|) /\ LSeg(|[1,0]|,|[1,1]|) = {|[1,0]|};

theorem 
  LSeg(|[0,0]|,|[0,1]|) /\ LSeg(|[0,0]|,|[1,0]|) = {|[0,0]|};

theorem 
  LSeg(|[0,1]|,|[1,1]|) /\ LSeg(|[1,0]|,|[1,1]|) = {|[1,1]|};

theorem 
  LSeg(|[0,0]|,|[1,0]|) misses LSeg(|[0,1]|,|[1,1]|);

theorem 
  LSeg(|[0,0]|,|[0,1]|) misses LSeg(|[1,0]|,|[1,1]|);

definition
  let n;
  let f be FinSequence of TOP-REAL n;
  let i;
  func LSeg(f,i) -> Subset of TOP-REAL n equals


  LSeg(f/.i,f/.(i+1)) if
  1 <= i & i+1 <= len f otherwise {};
end;

theorem 
  for f being FinSequence of TOP-REAL n st 1 <= i & i+1 <= len f
  holds f/.i in LSeg(f,i) & f/.(i+1) in LSeg(f,i);

definition
  let n;
  let f be FinSequence of TOP-REAL n;
  func L~f -> Subset of TOP-REAL n equals

  union { LSeg(f,i) where i is Element
  of NAT : 1 <= i & i+1 <= len f };
end;

theorem 
  for f being FinSequence of TOP-REAL n holds len f = 0 or len f =
  1 iff L~f = {};

theorem 
  for f being FinSequence of TOP-REAL n holds len f >= 2 implies L~f <> {};

definition
  let IT be FinSequence of TOP-REAL 2;
  attr IT is special means

  for i st 1 <= i & i+1 <= len IT holds (IT/.i)`1 = (
  IT/.(i+1))`1 or (IT/.i)`2 = (IT/.(i+1))`2;
  attr IT is unfolded means


  for i st 1 <= i & i + 2 <= len IT holds
  LSeg(IT,i) /\ LSeg(IT,i+1) = {IT/.(i+1)};
  attr IT is s.n.c. means


  for i,j st i+1 < j holds LSeg(IT,i) misses LSeg(IT,j);
end;

reserve f,f1,f2,h for FinSequence of TOP-REAL 2;

definition
  let f;
  attr f is being_S-Seq means


  f is one-to-one & len f >= 2 & f is unfolded s.n.c. special;
end;

theorem 
  ex f1,f2 st f1 is being_S-Seq & f2 is being_S-Seq &
R^2-unit_square = L~f1 \/ L~f2 & L~f1 /\ L~f2 = {|[ 0,0 ]|, |[ 1,1 ]|} & f1/.1
  = |[0,0]| & f1/.len f1=|[1,1]| & f2/.1 = |[0,0]| & f2/.len f2 = |[1,1]|;

theorem 
  h is being_S-Seq implies L~h is_an_arc_of h/.1,h/.len h;

definition
  let P be Subset of TOP-REAL 2;
  attr P is being_S-P_arc means


  ex f st f is being_S-Seq & P = L~f;
end;

theorem 
  P1 is being_S-P_arc implies P1 <> {};

registration
  cluster being_S-P_arc -> non empty for Subset of TOP-REAL 2;
end;

theorem 
  ex P1, P2 being non empty Subset of TOP-REAL 2 st P1 is being_S-P_arc
& P2 is being_S-P_arc & R^2-unit_square = P1 \/ P2 & P1 /\ P2 = {|[ 0,0 ]|, |[
  1,1 ]|};

theorem 
  P is being_S-P_arc implies ex p1,p2 st P is_an_arc_of p1,p2;

theorem 
  P is being_S-P_arc implies ex f being Function of I[01], (TOP-REAL 2)|
  P st f is being_homeomorphism;



scheme 

  TRSubsetEx { n() -> Nat, P[set] } : ex A being Subset of TOP-REAL n() st for
  p being Point of TOP-REAL n() holds p in A iff P[p];

scheme 

  TRSubsetUniq { n() -> Nat, P[set] } : for A, B being Subset of TOP-REAL n()
  st (for p being Point of TOP-REAL n() holds p in A iff P[p]) & (for p being
  Point of TOP-REAL n() holds p in B iff P[p]) holds A = B;

definition
  let p be Point of TOP-REAL 2;
  func north_halfline p -> Subset of TOP-REAL 2 means


  for x being Point of TOP-REAL 2 holds x in it iff x`1 = p`1 & x`2 >= p`2;
  func east_halfline p -> Subset of TOP-REAL 2 means


  for x being Point of TOP-REAL 2 holds x in it iff x`1 >= p`1 & x`2 = p`2;
  func south_halfline p -> Subset of TOP-REAL 2 means


  for x being Point of TOP-REAL 2 holds x in it iff x`1 = p`1 & x`2 <= p`2;
  func west_halfline p -> Subset of TOP-REAL 2 means


  for x being Point of TOP-REAL 2 holds x in it iff x`1 <= p`1 & x`2 = p`2;
end;

theorem 
  north_halfline p = {q where q is Point of TOP-REAL 2: q`1 = p`1 & q`2 >= p`2}
;

theorem 
  north_halfline p = { |[ p`1,r ]| where r is Element of REAL: r >= p`2 };

theorem 
  east_halfline p = {q where q is Point of TOP-REAL 2: q`1 >= p`1 & q`2 = p`2};

theorem 
  east_halfline p = { |[ r,p`2 ]| where r is Element of REAL: r >= p`1 };

theorem 
  south_halfline p = {q where q is Point of TOP-REAL 2: q`1 = p`1 & q`2 <= p`2}
;

theorem 
  south_halfline p = { |[ p`1,r ]| where r is Element of REAL: r <= p`2 };

theorem 
  west_halfline p = {q where q is Point of TOP-REAL 2: q`1 <= p`1 & q`2 = p`2};

theorem 
  west_halfline p = { |[ r,p`2 ]| where r is Element of REAL: r <= p`1 };

registration
  let p be Point of TOP-REAL 2;
  cluster north_halfline p -> non empty;
  cluster east_halfline p -> non empty;
  cluster south_halfline p -> non empty;
  cluster west_halfline p -> non empty;
end;



theorem 
  p in west_halfline p & p in east_halfline p & p in north_halfline p &
  p in south_halfline p;















begin

reserve p,p1,p2,p3,p11,p22,q,q1,q2 for Point of TOP-REAL 2,
  f,h for FinSequence of TOP-REAL 2,
  r,r1,r2,s,s1,s2 for real number,
  u,u1,u2,u5 for Point of Euclid 2,
  n,m,i,j,k for Element of NAT,
  x,y,z for set;

begin 

theorem 
  1 in dom <*x,y,z*> & 2 in dom <*x,y,z*> & 3 in dom <*x,y,z*>;

theorem 
  (p1+p2)`1 = p1`1 + p2`1 & (p1+p2)`2 = p1`2 + p2`2;

theorem 
  (p1-p2)`1 = p1`1 - p2`1 & (p1-p2)`2 = p1`2 - p2`2;

theorem 
  (r*p)`1 = r*(p`1) & (r*p)`2 = r*(p`2);

theorem 
  p1=<*r1,s1*> & p2=<*r2,s2*> implies p1+p2=<*r1+r2,s1+s2*> & p1-
  p2=<*r1-r2,s1-s2*>;

theorem 
  p`1 = q`1 & p`2 = q`2 implies p=q;

theorem 
  u1 = p1 & u2 = p2 implies (Pitag_dist 2).(u1,u2) = sqrt ((p1`1 -
  p2`1)^2 + (p1`2 - p2`2)^2);

theorem 
  for n being Nat holds the carrier of TOP-REAL n = the carrier of
  Euclid n;

reserve lambda for Real;

theorem 
  r1 <= s1 implies {p1: p1`1=r & r1<=p1`2 & p1`2<=s1} = LSeg(|[r,
  r1]|,|[r,s1]|);

theorem 
  r1 <= s1 implies {p1: p1`2=r & r1<=p1`1 & p1`1<=s1} = LSeg(|[r1,
  r]|,|[s1,r]|);

theorem 
  p in LSeg(|[r,r1]|,|[r,s1]|) implies p`1 = r;

theorem 
  p in LSeg(|[r1,r]|,|[s1,r]|) implies p`2 = r;

theorem 
  p`1 <> q`1 & p`2 = q`2 implies |[(p`1+q`1)/2,p`2]| in LSeg(p,q);

theorem 
  p`1 = q`1 & p`2 <> q`2 implies |[p`1,(p`2+q`2)/2]| in LSeg(p,q);

theorem 
  for i,j be Nat holds f = <* p,p1,q *> & i<>0 & j>i+1 implies LSeg(f,j) = {};

theorem 
  f = <* p1,p2,p3 *> implies L~f = LSeg(p1,p2) \/ LSeg(p2,p3);

theorem 
  j in dom(f|i) & j+1 in dom(f|i) implies LSeg(f,j) = LSeg(f|i,j);

theorem 
  j in dom f & j+1 in dom f implies LSeg(f^h,j) = LSeg(f,j);

theorem 
  for f being FinSequence of TOP-REAL n,i being Nat holds LSeg(f,i ) c= L~f;

theorem 
  L~(f|i) c= L~f;

theorem 
  for p1,p2 being Point of TOP-REAL n, u being Point of Euclid n
  st p1 in Ball(u,r) & p2 in Ball(u,r) holds LSeg(p1,p2) c= Ball(u,r);

theorem 
  u=p1 & p1=|[r1,s1]| & p2=|[r2,s2]| & p=|[r2,s1]| & p2 in Ball(u,r)
  implies p in Ball(u,r);

theorem 
  |[s,r1]| in Ball(u,r) & |[s,s1]| in Ball(u,r) implies |[s,(r1+s1)/2]|
  in Ball(u,r);

theorem 
  |[r1,s]| in Ball(u,r) & |[s1,s]| in Ball(u,r) implies |[(r1+s1)/2,s]|
  in Ball(u,r);

theorem 
  |[r1,r2]| in Ball(u,r) & |[s1,s2]| in Ball(u,r) implies |[r1,s2]| in
  Ball(u,r) or |[s1,r2]| in Ball(u,r);

theorem 
  not f/.1 in Ball(u,r) & 1<=m & m<=len f - 1 & (for i st 1<=i & i<=len
f - 1 & LSeg(f,i) /\ Ball(u,r) <> {} holds m<=i) implies not f/.m in Ball(u,r);

theorem 
  for q,p2,p st q`2 = p2`2 & p`2 <> p2`2 holds (LSeg(p2,|[p2`1,p`2]|) \/
  LSeg(|[p2`1,p`2]|,p)) /\ LSeg(q,p2) = {p2};

theorem 
  for q,p2,p st q`1 = p2`1 & p`1 <> p2`1 holds (LSeg(p2,|[p`1,p2`2]|) \/
  LSeg(|[p`1,p2`2]|,p)) /\ LSeg(q,p2) = {p2};

theorem 
  LSeg(p,|[p`1,q`2]|) /\ LSeg(|[p`1,q`2]|,q) ={|[p`1,q`2]|};

theorem 
  LSeg(p,|[q`1,p`2]|) /\ LSeg(|[q`1,p`2]|,q) ={|[q`1,p`2]|};

theorem 
  p`1 = q`1 & p`2 <> q`2 implies LSeg(p,|[p`1,(p`2+q`2)/2]|) /\
  LSeg(|[p`1,(p`2+q`2)/2]|,q)={|[p`1,(p`2+q`2)/2]|};

theorem 
  p`1 <> q`1 & p`2 = q`2 implies LSeg(p,|[(p`1+q`1)/2,p`2]|) /\
  LSeg(|[(p`1+q`1)/2,p`2]|,q)={|[(p`1+q`1)/2,p`2]|};

theorem 
  i>2 & i in dom f & f is being_S-Seq implies f|i is being_S-Seq;

theorem 
  p`1 <> q`1 & p`2 <> q`2 & f = <* p,|[p`1,q`2]|,q *> implies f/.1 = p &
  f/.len f = q & f is being_S-Seq;

theorem 
  p`1 <> q`1 & p`2 <> q`2 & f = <* p,|[q`1,p`2]|,q *> implies f/.1 = p &
  f/.len f = q & f is being_S-Seq;

theorem 
  p`1 = q`1 & p`2 <> q`2 & f = <* p,|[p`1,(p`2 + q`2)/2]|,q *> implies f
  /.1 = p & f/.len f = q & f is being_S-Seq;

theorem 
  p`1 <> q`1 & p`2 = q`2 & f = <* p,|[(p`1 + q`1)/2,p`2]|,q *> implies f
  /.1 = p & f/.len f = q & f is being_S-Seq;

theorem 
  i in dom f & i+1 in dom f implies L~(f| (i+1)) = L~(f|i) \/ LSeg(f/.i,f
  /.(i+1));

theorem 
  len f>=2 & not p in L~f implies for n st 1<=n & n<=len f holds f/.n<>p;

theorem 
  q<>p & LSeg(q,p) /\ L~f = {q} implies not p in L~f;

theorem 
  f is being_S-Seq & f/.len f in LSeg(f,m) & 1<=m & m + 1 <=len f
  implies m + 1 = len f;

theorem 
  not p1 in Ball(u,r) & q in Ball(u,r) & p in Ball(u,r) & not p in LSeg(
p1,q ) & ( q`1=p`1 & q`2<>p`2 or q`1<>p`1 & q`2=p`2 ) & (p1`1=q`1 or p1`2=q`2)
  implies LSeg(p1,q) /\ LSeg(q,p) = {q};

theorem 
  not p1 in Ball(u,r) & p in Ball(u,r) & |[p`1,q`2]| in Ball(u,r) & not
|[p`1,q`2]| in LSeg(p1,p) & p1`1 = p`1 & p`1<>q`1 & p`2<>q`2 implies (LSeg(p,|[
  p`1,q`2]|) \/ LSeg(|[p`1,q`2]|,q)) /\ LSeg(p1,p) = {p};

theorem 
  not p1 in Ball(u,r) & p in Ball(u,r) & |[q`1,p`2]| in Ball(u,r) & not
|[q`1,p`2]| in LSeg(p1,p) & p1`2 = p`2 & p`1<>q`1 & p`2<>q`2 implies (LSeg(p,|[
  q`1,p`2]|) \/ LSeg(|[q`1,p`2]|,q)) /\ LSeg(p1,p) = {p};

reserve f for FinSequence of REAL;

theorem 
  len f = n implies f in the carrier of Euclid n;

theorem 
  len f = n implies f in the carrier of TOP-REAL n;















begin

reserve a for set;
reserve p,p1,p2,q,q1,q2 for Point of TOP-REAL 2;
reserve h1,h2 for FinSequence of TOP-REAL 2;

theorem 
  p1 <> p2 & p1 in R^2-unit_square & p2 in R^2-unit_square implies
  ex P1, P2 being non empty Subset of TOP-REAL 2 st P1 is_an_arc_of p1,p2 & P2
  is_an_arc_of p1,p2 & R^2-unit_square = P1 \/ P2 & P1 /\ P2 = {p1,p2};

theorem 
  R^2-unit_square is compact;

theorem 
  for Q, P being non empty Subset of TOP-REAL 2 for f being
  Function of (TOP-REAL 2)|Q, (TOP-REAL 2)|P st f is being_homeomorphism & Q
  is_an_arc_of q1,q2 holds for p1, p2 st p1 = f.q1 & p2 = f.q2 holds P
  is_an_arc_of p1,p2;

definition
  let P be Subset of TOP-REAL 2;
  attr P is being_simple_closed_curve means


  ex f being Function of (
  TOP-REAL 2)|R^2-unit_square, (TOP-REAL 2)|P st f is being_homeomorphism;
end;

registration
  cluster R^2-unit_square -> being_simple_closed_curve;
end;

registration
  cluster being_simple_closed_curve non empty for Subset of TOP-REAL 2;
end;

definition
  mode Simple_closed_curve is being_simple_closed_curve Subset of TOP-REAL 2;
end;

theorem 
  for P being non empty Subset of TOP-REAL 2 st P is
  being_simple_closed_curve ex p1,p2 st p1 <> p2 & p1 in P & p2 in P;

theorem 
  for P being non empty Subset of TOP-REAL 2 holds P is
being_simple_closed_curve iff (ex p1,p2 st p1 <> p2 & p1 in P & p2 in P) & for
  p1,p2 st p1 <> p2 & p1 in P & p2 in P ex P1,P2 being non empty Subset of
TOP-REAL 2 st P1 is_an_arc_of p1,p2 & P2 is_an_arc_of p1,p2 & P = P1 \/ P2 & P1
  /\ P2 = {p1,p2};

theorem 
  for P being non empty Subset of TOP-REAL 2 holds P is
  being_simple_closed_curve iff ex p1,p2 being Point of TOP-REAL 2, P1,P2 being
  non empty Subset of TOP-REAL 2 st p1 <> p2 & p1 in P & p2 in P & P1
is_an_arc_of p1,p2 & P2 is_an_arc_of p1,p2 & P = P1 \/ P2 & P1 /\ P2 = {p1,p2};

registration
  cluster being_simple_closed_curve -> non empty compact for
Subset of TOP-REAL 2;
end;














begin

reserve P,P1,P2,R for Subset of TOP-REAL 2,
  p,p1,p2,p3,p11,p22,q,q1,q2,q3,q4 for Point of TOP-REAL 2,
  f,h for FinSequence of TOP-REAL 2,
  r for Real,
  u for Point of Euclid 2,
  n,m,i,j,k for Element of NAT,
  x,y for set;

definition
  let P,p,q;
  pred P is_S-P_arc_joining p,q means


  ex f st f is being_S-Seq & P = L~ f & p=f/.1 & q=f/.len f;
end;

definition
  let P;
  attr P is being_special_polygon means

  ex p1,p2,P1,P2 st p1 <> p2 & p1 in P &
p2 in P & P1 is_S-P_arc_joining p1,p2 & P2 is_S-P_arc_joining p1,p2 & P1 /\ P2
  = {p1,p2} & P = P1 \/ P2;
end;

definition
  let T be TopStruct, P be Subset of T;
  attr P is being_Region means


  P is open connected;
end;

theorem 
  P is_S-P_arc_joining p,q implies P is being_S-P_arc;

theorem 
  P is_S-P_arc_joining p,q implies P is_an_arc_of p,q;

theorem 
  P is_S-P_arc_joining p,q implies p in P & q in P;

theorem 
  P is_S-P_arc_joining p,q implies p<>q;

theorem 
  P is being_special_polygon implies P is being_simple_closed_curve;

theorem 
  p`1 = q`1 & p`2 <> q`2 & p in Ball(u,r) & q in Ball(u,r) & f =<*
p,|[p`1,(p`2+q`2)/2]|,q *> implies f is being_S-Seq & f/.1 =p & f/.len f = q &
  L~f is_S-P_arc_joining p,q & L~f c= Ball(u,r);

theorem 
  p`1 <> q`1 & p`2 = q`2 & p in Ball(u,r) & q in Ball(u,r) & f = <*
p,|[(p`1+q`1)/2,p`2]|,q *> implies f is being_S-Seq & f/.1 =p & f/.len f = q &
  L~f is_S-P_arc_joining p,q & L~f c= Ball(u,r);

theorem 
  p`1 <> q`1 & p`2 <> q`2 & p in Ball(u,r) & q in Ball(u,r) & |[p`1
,q`2]| in Ball(u,r) & f =<* p,|[p`1,q`2]|,q *> implies f is being_S-Seq & f/.1
  =p & f/.len f = q & L~f is_S-P_arc_joining p,q & L~f c= Ball(u,r);

theorem 
  p`1 <> q`1 & p`2 <> q`2 & p in Ball(u,r) & q in Ball(u,r) & |[q
`1,p`2]| in Ball(u,r) & f =<* p,|[q`1,p`2]|,q *> implies f is being_S-Seq & f/.
  1 =p & f/.len f = q & L~f is_S-P_arc_joining p,q & L~f c= Ball(u,r);

theorem 
  p <> q & p in Ball(u,r) & q in Ball(u,r) implies ex P st P
  is_S-P_arc_joining p,q & P c= Ball(u,r);

theorem 
  p<>f/.1 & (f/.1)`2 = p`2 & f is being_S-Seq & p in LSeg(f,1) & h
= <* f/.1,|[((f/.1)`1+p`1)/2,(f/.1)`2]|,p *> implies h is being_S-Seq & h/.1=f
  /.1 & h/.len h=p & L~h is_S-P_arc_joining f/.1,p & L~h c= L~f & L~h = L~(f|1)
  \/ LSeg(f/.1,p);

theorem 
  p<>f/.1 & (f/.1)`1 = p`1 & f is being_S-Seq & p in LSeg(f,1) & h
= <* f/.1,|[(f/.1)`1,((f/.1)`2+p`2)/2]|,p *> implies h is being_S-Seq & h/.1=f
  /.1 & h/.len h=p & L~h is_S-P_arc_joining f/.1,p & L~h c= L~f & L~h = L~(f|1)
  \/ LSeg(f/.1,p);

theorem 
  f is being_S-Seq & i in dom f & i+1 in dom f & i>1 & p in LSeg(f
,i) & p<>f/.i & h = (f|i)^<*p*> implies h is being_S-Seq & h/.1=f/.1 & h/.len h
=p & L~h is_S-P_arc_joining f/.1,p & L~h c= L~f & L~h = L~(f|i) \/ LSeg(f/.i,p)
;

theorem 
  f/.2<>f/.1 & f is being_S-Seq & (f/.2)`2 = (f/.1)`2 & h = <* f/.
1,|[((f/.1)`1+(f/.2)`1)/2,(f/.1)`2]|,f/.2 *> implies h is being_S-Seq & h/.1=f
/.1 & h/.len h=f/.2 & L~h is_S-P_arc_joining f/.1,f/.2 & L~h c= L~f & L~h = L~(
  f|1) \/ LSeg(f/.1,f/.2) & L~h = L~(f|2) \/ LSeg(f/.2,f/.2);

theorem 
  f/.2<>f/.1 & f is being_S-Seq & (f/.2)`1 = (f/.1)`1 & h = <* f/.
1,|[(f/.1)`1,((f/.1)`2+(f/.2)`2)/2]|,f/.2 *> implies h is being_S-Seq & h/.1=f
/.1 & h/.len h=f/.2 & L~h is_S-P_arc_joining f/.1,f/.2 & L~h c= L~f & L~h = L~(
  f|1) \/ LSeg(f/.1,f/.2) & L~h = L~(f|2) \/ LSeg(f/.2,f/.2);

theorem 
  f is being_S-Seq & i>2 & i in dom f & h = f|i implies h is
being_S-Seq & h/.1=f/.1 & h/.len h=f/.i & L~h is_S-P_arc_joining f/.1,f/.i & L~
  h c= L~f & L~h = L~(f|i) \/ LSeg(f/.i,f/.i);

theorem 
  p<>f/.1 & f is being_S-Seq & p in LSeg(f,n) implies ex h st h is
being_S-Seq & h/.1=f/.1 & h/.len h = p & L~h is_S-P_arc_joining f/.1,p & L~h c=
  L~f & L~h = L~(f|n) \/ LSeg(f/.n,p);

theorem 
  p<>f/.1 & f is being_S-Seq & p in L~f implies ex h st h is
being_S-Seq & h/.1=f/.1 & h/.len h = p & L~h is_S-P_arc_joining f/.1,p & L~h c=
  L~f;

theorem 
  ( p`1=(f/.len f)`1 & p`2<>(f/.len f)`2 or p`1<>(f/.len f)`1 & p
`2=(f/.len f)`2 ) & f/.len f in Ball(u,r) & p in Ball(u,r) & f is being_S-Seq &
LSeg(f/.len f,p) /\ L~f = {f/.len f} & h=f^<*p*> implies h is being_S-Seq & L~h
  is_S-P_arc_joining f/.1,p & L~h c= L~f \/ Ball(u,r);

theorem 
  f/.len f in Ball(u,r) & p in Ball(u,r) & |[p`1,(f/.len f)`2]| in
Ball(u,r) & f is being_S-Seq & p`1<>(f/.len f)`1 & p`2<>(f/.len f)`2 & h=f^<*|[
p`1,(f/.len f)`2]|,p*> & (LSeg(f/.len f,|[p`1,(f/.len f)`2]|) \/ LSeg(|[p`1,(f
/.len f)`2]|,p)) /\ L~f = {f/.len f} implies L~h is_S-P_arc_joining f/.1,p & L~
  h c= L~f \/ Ball(u,r);

theorem 
  f/.len f in Ball(u,r) & p in Ball(u,r) & |[(f/.len f)`1,p`2]| in
Ball(u,r) & f is being_S-Seq & p`1<>(f/.len f)`1 & p`2<>(f/.len f)`2 & h=f^<*|[
(f/.len f)`1,p`2]|,p*> & (LSeg(f/.len f,|[(f/.len f)`1,p`2]|) \/ LSeg(|[(f/.len
f)`1,p`2]|,p)) /\ L~f = {f/.len f} implies L~h is_S-P_arc_joining f/.1,p & L~h
  c= L~f \/ Ball(u,r);

theorem 
  not f/.1 in Ball(u,r) & f/.len f in Ball(u,r) & p in Ball(u,r) &
f is being_S-Seq & not p in L~f implies ex h st L~h is_S-P_arc_joining f/.1,p &
  L~h c= L~f \/ Ball(u,r);

theorem 
  for R,p,p1,p2,P,r,u st p<>p1 & P is_S-P_arc_joining p1,p2 & P c=
  R & p in Ball(u,r) & p2 in Ball(u,r) & Ball(u,r) c= R ex P1 being Subset of
  TOP-REAL 2 st P1 is_S-P_arc_joining p1,p & P1 c= R;

reserve P, R for Subset of TOP-REAL 2;

theorem 
  for p st R is being_Region & P = {q: q<>p & q in R & not ex P1
  being Subset of TOP-REAL 2 st P1 is_S-P_arc_joining p,q & P1 c=R} holds P is
  open;

theorem 
  R is being_Region & p in R & P = {q: q=p or ex P1 being Subset
  of TOP-REAL 2 st P1 is_S-P_arc_joining p,q & P1 c=R} implies P is open;

theorem 
  p in R & P={q: q=p or ex P1 being Subset of TOP-REAL 2 st P1
  is_S-P_arc_joining p,q & P1 c=R} implies P c= R;

theorem 
  R is being_Region & p in R & P={q: q=p or ex P1 be Subset of
  TOP-REAL 2 st P1 is_S-P_arc_joining p,q & P1 c=R} implies R c= P;

theorem 
  R is being_Region & p in R & P={q: q=p or ex P1 being Subset of
  TOP-REAL 2 st P1 is_S-P_arc_joining p,q & P1 c=R} implies R = P;

theorem 
  R is being_Region & p in R & q in R & p<>q implies ex P st P
  is_S-P_arc_joining p,q & P c=R;














begin

reserve p for Point of TOP-REAL 2,
  f,f1,f2,g for FinSequence of TOP-REAL 2,
  v, v1,v2 for FinSequence of REAL,
  r,s for Real,
  n,m,i,j,k for Element of NAT,
  x for set;

definition
  let f;

  func X_axis(f) -> FinSequence of REAL means


  len it = len f & for n st n in dom it holds it.n = (f/.n)`1;
  func Y_axis(f) -> FinSequence of REAL means


  len it = len f & for n st n in dom it holds it.n = (f/.n)`2;
end;

theorem 
  i in dom f & 2<=len f implies f/.i in L~f;

begin



theorem 
  for D being non empty set,M being Matrix of D holds for i,j st j
  in dom M & i in Seg width M holds Col(M,i).j = Line(M,j).i;

definition
  let D be non empty set;
  let M be Matrix of D;
  redefine attr M is empty-yielding means


  0 = len M or 0 = width M;
end;

definition
  let M be Matrix of TOP-REAL 2;
  attr M is X_equal-in-line means


  for n st n in dom M holds X_axis(Line (M,n)) is constant;
  attr M is Y_equal-in-column means


  for n st n in Seg width M holds Y_axis(Col(M,n)) is constant;
  attr M is Y_increasing-in-line means


  for n st n in dom M holds Y_axis (Line(M,n)) is increasing;
  attr M is X_increasing-in-column means


  for n st n in Seg width M holds X_axis(Col(M,n)) is increasing;
end;

registration
  cluster non empty-yielding X_equal-in-line Y_equal-in-column
    Y_increasing-in-line X_increasing-in-column for Matrix of TOP-REAL 2;
end;

theorem 
  for M being X_increasing-in-column X_equal-in-line Matrix of
  TOP-REAL 2 holds for x,n,m st x in rng Line(M,n) & x in rng Line(M,m) & n in
  dom M & m in dom M holds n=m;

theorem 
  for M being Y_increasing-in-line Y_equal-in-column Matrix of
TOP-REAL 2 holds for x,n,m st x in rng Col(M,n) & x in rng Col(M,m) & n in Seg
  width M & m in Seg width M holds n=m;

begin



definition
  mode Go-board is non empty-yielding X_equal-in-line Y_equal-in-column
    Y_increasing-in-line X_increasing-in-column Matrix of TOP-REAL 2;
end;

reserve G for Go-board;

theorem 
  x=G*(m,k) & x=G*(i,j) & [m,k] in Indices G & [i,j] in Indices G
  implies m=i & k=j;

theorem 
  m in dom f & f/.1 in rng Col(G,1) implies (f|m)/.1 in rng Col(G,1);

theorem 
  m in dom f & f/.m in rng Col(G,width G) implies (f|m)/.len(f|m) in rng
  Col(G,width G);

theorem 
  rng f misses rng Col(G,i) & f/.n = G*(m,k) & n in dom f & m in
  dom G implies i<>k;

definition
  let G;
  let i be Element of NAT;
  assume that
  i in Seg width G & width G > 1 ;
  func DelCol(G,i) -> Go-board means


  len it = len G & for k st k in dom G holds it.k = Del(Line(G,k),i);
end;

theorem 
  i in Seg width G & width G > 1 & k in dom G implies Line(DelCol(
  G,i),k) = Del(Line(G,k),i);

theorem 
  i in Seg width G & width G = m+1 & m>0 implies width DelCol(G,i) = m;

theorem 
  i in Seg width G & width G > 1 implies width G = width DelCol(G,i) + 1;

theorem 
  i in Seg width G & width G > 1 & n in dom G & m in Seg width
  DelCol(G,i) implies DelCol(G,i)*(n,m)=Del(Line(G,n),i).m;

theorem 
  i in Seg width G & width G = m+1 & m>0 & 1<=k & k<i implies Col(
  DelCol(G,i),k) = Col(G,k) & k in Seg width DelCol(G,i) & k in Seg width G;

theorem 
  i in Seg width G & width G = m+1 & m>0 & i<=k & k<=m implies Col
(DelCol(G,i),k) = Col(G,k+1) & k in Seg width DelCol(G,i) & k+1 in Seg width G;

theorem 
  i in Seg width G & width G = m+1 & m>0 & n in dom G & 1<=k & k<i
  implies DelCol(G,i)*(n,k) = G*(n,k) & k in Seg width G;

theorem 
  i in Seg width G & width G = m+1 & m>0 & n in dom G & i<=k & k<=
  m implies DelCol(G,i)*(n,k) = G*(n,k+1) & k+1 in Seg width G;

theorem 
  width G = m+1 & m>0 & k in Seg m implies Col(DelCol(G,1),k) = Col(G,k+
  1) & k in Seg width DelCol(G,1) & k+1 in Seg width G;

theorem 
  width G = m+1 & m>0 & k in Seg m & n in dom G implies DelCol(G,1)*(n,k
  ) = G*(n,k+1) & 1 in Seg width G;

theorem 
  width G = m+1 & m>0 & k in Seg m implies Col(DelCol(G,width G),k) =
  Col(G,k) & k in Seg width DelCol(G,width G);

theorem 
  width G = m+1 & m>0 & k in Seg m & n in dom G implies k in Seg
  width G & DelCol(G,width G)*(n,k) = G*(n,k) & width G in Seg width G;

theorem 
  rng f misses rng Col(G,i) & f/.n in rng Line(G,m) & n in dom f & i in
  Seg width G & m in dom G & width G>1 implies f/.n in rng Line(DelCol(G,i),m);

reserve D for set,
  f for FinSequence of D,
  M for Matrix of D;

definition
  let D,f,M;
  pred f is_sequence_on M means


  (for n st n in dom f ex i,j st [i,j]
in Indices M & f/.n = M*(i,j)) & for n st n in dom f & n+1 in dom f holds for m
,k,i,j st [m,k] in Indices M & [i,j] in Indices M & f/.n = M*(m,k) & f/.(n+1) =
  M*(i,j) holds abs(m-i)+abs(k-j) = 1;
end;

theorem 
  (m in dom f implies 1 <= len(f|m)) & (f is_sequence_on M implies f|m
  is_sequence_on M);

theorem 
  (for n st n in dom f1 ex i,j st [i,j] in Indices M & f1/.n=M*(i,j)) &
(for n st n in dom f2 ex i,j st [i,j] in Indices M & f2/.n=M*(i,j)) implies for
  n st n in dom(f1^f2) ex i,j st [i,j] in Indices M & (f1^f2)/.n=M*(i,j);

theorem 
  (for n st n in dom f1 & n+1 in dom f1 holds for m,k,i,j st [m,k] in
Indices M & [i,j] in Indices M & f1/.n=M*(m,k) & f1/.(n+1)=M*(i,j) holds abs(m-
i)+abs(k-j)=1) & (for n st n in dom f2 & n+1 in dom f2 holds for m,k,i,j st [m,
k] in Indices M & [i,j] in Indices M & f2/.n=M*(m,k) & f2/.(n+1)=M*(i,j) holds
abs(m-i)+abs(k-j)=1) & (for m,k,i,j st [m,k] in Indices M & [i,j] in Indices M
& f1/.len f1=M*(m,k) & f2/.1=M*(i,j) & len f1 in dom f1 & 1 in dom f2 holds abs
  (m-i)+abs(k-j)=1) implies for n st n in dom(f1^f2) & n+1 in dom(f1^f2) holds
for m,k,i,j st [m,k] in Indices M & [i,j] in Indices M & (f1^f2)/.n =M* (m,k) &
  (f1^f2)/.(n+1)=M*(i,j) holds abs(m-i)+abs(k-j)=1;

reserve f for FinSequence of TOP-REAL 2;

theorem 
  f is_sequence_on G & i in Seg width G & rng f misses rng Col(G,i) &
  width G > 1 implies f is_sequence_on DelCol(G,i);

theorem 
  f is_sequence_on G & i in dom f implies ex n st n in dom G & f/.
  i in rng Line(G,n);

theorem 
  f is_sequence_on G & i in dom f & i+1 in dom f & n in dom G & f
/.i in rng Line(G,n) implies f/.(i+1) in rng Line(G,n) or for k st f/.(i+1) in
  rng Line(G,k) & k in dom G holds abs(n-k) = 1;

theorem 
  1<=len f & f/.len f in rng Line(G,len G) & f is_sequence_on G &
i in dom G & i+1 in dom G & m in dom f & f/.m in rng Line(G,i) & (for k st k in
  dom f & f/.k in rng Line(G,i) holds k<=m) implies m+1 in dom f & f/.(m+1) in
  rng Line(G,i+1);

theorem 
  1<=len f & f/.1 in rng Line(G,1) & f/.len f in rng Line(G,len G) & f
is_sequence_on G implies (for i st 1<=i & i<=len G holds ex k st k in dom f & f
  /.k in rng Line(G,i)) & (for i st 1<=i & i<=len G & 2<=len f holds L~f meets
rng Line(G,i)) & for i,j,k,m st 1<=i & i<=len G & 1<=j & j<=len G & k in dom f
& m in dom f & f/.k in rng Line(G,i) & (for n st n in dom f & f/.n in rng Line(
  G,i) holds n<=k) & k<m & f/.m in rng Line(G,j) holds i<j;

theorem 
  f is_sequence_on G & i in dom f implies ex n st n in Seg width G
  & f/.i in rng Col(G,n);

theorem 
  f is_sequence_on G & i in dom f & i+1 in dom f & n in Seg width
G & f/.i in rng Col(G,n) implies f/.(i+1) in rng Col(G,n) or for k st f/.(i+1)
  in rng Col(G,k) & k in Seg width G holds abs(n-k) = 1;

theorem 
  1<=len f & f/.len f in rng Col(G,width G) & f is_sequence_on G &
  i in Seg width G & i+1 in Seg width G & m in dom f & f/.m in rng Col(G,i) & (
for k st k in dom f & f/.k in rng Col(G,i) holds k<=m) implies m+1 in dom f & f
  /.(m+1) in rng Col(G,i+1);

theorem 
  1<=len f & f/.1 in rng Col(G,1) & f/.len f in rng Col(G,width G)
& f is_sequence_on G implies (for i st 1<=i & i<=width G holds ex k st k in dom
  f & f/.k in rng Col(G,i)) & (for i st 1<=i & i<=width G & 2<=len f holds L~f
meets rng Col(G,i)) & for i,j,k,m st 1<=i & i<=width G & 1<=j & j<=width G & k
  in dom f & m in dom f & f/.k in rng Col(G,i) & (for n st n in dom f & f/.n in
  rng Col(G,i) holds n<=k) & k<m & f/.m in rng Col(G,j) holds i<j;

theorem 
  k in Seg width G & f/.1 in rng Col(G,1) & f is_sequence_on G & (
  for i st i in dom f & f/.i in rng Col(G,k) holds n<=i) implies for i st i in
dom f & i<=n holds for m st m in Seg width G & f/.i in rng Col(G,m) holds m<=k;

theorem 
  f is_sequence_on G & f/.1 in rng Col(G,1) & f/.len f in rng Col(G,
  width G) & width G > 1 & 1<=len f implies ex g st g/.1 in rng Col(DelCol(G,
width G),1) & g/.len g in rng Col(DelCol(G,width G),width DelCol(G,width G)) &
  1<=len g & g is_sequence_on DelCol(G,width G) & rng g c= rng f;

theorem 
  f is_sequence_on G & rng f /\ rng Col(G,1)<>{} & rng f /\ rng Col(G,
  width G)<>{} implies ex g st rng g c= rng f & g/.1 in rng Col(G,1) & g/.len g
  in rng Col(G,width G) & 1<=len g & g is_sequence_on G;

theorem 
  k in dom G & f is_sequence_on G & f/.len f in rng Line(G,len G) & n in
  dom f & f/.n in rng Line(G,k) implies (for i st k<=i & i<=len G ex j st j in
  dom f & n<=j & f/.j in rng Line(G,i)) & for i st k<i & i<=len G ex j st j in
  dom f & n<j & f/.j in rng Line(G,i);















begin

reserve p,p1,p2,q for Point of TOP-REAL 2,
  f,f1,f2,g,g1,g2 for FinSequence of TOP-REAL 2,
  r,s for Real,

  n,m,i,j,k for Element of NAT,
  G for Go-board,
  x for set;

theorem 
  (for n,m st m>n+1 & n in dom f & n+1 in dom f & m in dom f & m+1 in
  dom f holds LSeg(f,n) misses LSeg(f,m)) implies f is s.n.c.;

theorem 
  f is unfolded s.n.c. one-to-one & f/.len f in LSeg(f,i) & i in dom f &
  i+1 in dom f implies i+1=len f;

theorem 
  k<>0 & len f = k+1 implies L~f = L~(f|k) \/ LSeg(f,k);

theorem 
  1 < k & len f = k+1 & f is unfolded s.n.c. implies L~(f|k) /\ LSeg(f,k
  ) = {f/.k};

theorem 
  len f1 < n & n+1 <= len (f1^f2) & m+len f1 = n implies LSeg(f1^f2,n) =
  LSeg(f2,m);

theorem 
  L~f c= L~(f^g);

theorem 
  f is s.n.c. implies f|i is s.n.c.;

theorem 
  f1 is special & f2 is special & ((f1/.len f1)`1=(f2/.1)`1 or (f1/.len
  f1)`2=(f2/.1)`2) implies f1^f2 is special;

theorem 
  f <> {} implies X_axis(f) <> {};

theorem 
  f <> {} implies Y_axis(f) <> {};

registration
  let f be non empty FinSequence of TOP-REAL 2;
  cluster X_axis f -> non empty;
  cluster Y_axis f -> non empty;
end;

theorem 
  f is special implies for n st n in dom f & n+1 in dom f holds
for i,j,m,k st [i,j] in Indices G & [m,k] in Indices G & f/.n=G*(i,j) & f/.(n+1
  )=G*(m,k) holds i=m or k=j;

theorem 
  (for n st n in dom f ex i,j st [i,j] in Indices G & f/.n=G*(i,j)) & f
  is special & (for n st n in dom f & n+1 in dom f holds f/.n <> f/.(n+1))
implies ex g st g is_sequence_on G & L~f = L~g & g/.1=f/.1 & g/.len g=f/.len f
  & len f<=len g;

definition
  let v1,v2 be FinSequence of REAL;
  assume
 v1 <> {};
  func GoB(v1,v2) -> Matrix of TOP-REAL 2 means


  len it = len v1 & width
  it = len v2 & for n,m st [n,m] in Indices it holds it*(n,m) = |[v1.n,v2.m]|;
end;

registration
  let v1,v2 be non empty FinSequence of REAL;
  cluster GoB(v1,v2) -> non empty-yielding X_equal-in-line Y_equal-in-column;
end;

registration
  let v1,v2 be non empty increasing FinSequence of REAL;
  cluster GoB(v1,v2) -> Y_increasing-in-line X_increasing-in-column;
end;

definition
  let f be non empty FinSequence of TOP-REAL 2;

  func GoB(f) -> Matrix of TOP-REAL 2 equals

  GoB(Incr(X_axis(f)),Incr(Y_axis(f)));
end;

registration
  let f be non empty FinSequence of TOP-REAL 2;
  cluster GoB(f) -> non empty-yielding X_equal-in-line Y_equal-in-column
    Y_increasing-in-line X_increasing-in-column;
end;

reserve f for non empty FinSequence of TOP-REAL 2;

theorem 
  len GoB(f) = card rng X_axis(f) & width GoB(f) = card rng Y_axis (f);

theorem 
  for n st n in dom f holds ex i,j st [i,j] in Indices GoB(f) & f/.n =
  GoB(f)*(i,j);

theorem 
  n in dom f & (for m st m in dom f holds (X_axis(f)).n <= (X_axis(f)).m
  ) implies f/.n in rng Line(GoB(f),1);

theorem 
  n in dom f & (for m st m in dom f holds (X_axis(f)).m <= (X_axis(f)).n
  ) implies f/.n in rng Line(GoB(f),len GoB(f));

theorem 
  n in dom f & (for m st m in dom f holds (Y_axis(f)).n <= (Y_axis(f)).m
  ) implies f/.n in rng Col(GoB(f),1);

theorem 
  n in dom f & (for m st m in dom f holds (Y_axis(f)).m <= (Y_axis(f)).n
  ) implies f/.n in rng Col(GoB(f),width GoB(f));














begin 

reserve n,i,k,m for Element of NAT;

theorem 
  for n,k being Nat holds n<k implies n<=k-1;

theorem 
  1<=k-m & k-m<=n implies k-m in Seg n & k-m is Element of NAT;

scheme 

  FinSeqFam{D()-> non empty set,f()->FinSequence of D(), F(FinSequence of D(),
  Element of NAT)->set,P[Nat]}: {F(f(),i): i in dom f() & P[i]} is finite;

scheme 

  FinSeqFam9{D()-> non empty set,f()-> FinSequence of D(), F(FinSequence of D(
),Element of NAT)->set,P[set]}: {F(f(),i): 1<=i & i<=len f() & P[i]} is finite;

theorem 
  for x1,x2,x3 being Element of REAL n holds |.x1 - x2.|- |.x2 -
  x3.| <= |.x1 - x3.|;

theorem 
  for x1,x2,x3 being Element of REAL n holds |.x2 - x1.|- |.x2 - x3.| <=
  |.x3 - x1.|;

begin




reserve r,r1,r2,s,s1,s2 for Real;
reserve p,p1,p2,q1,q2 for Point of TOP-REAL n;

theorem 
  for u1,u2 being Point of Euclid n, v1,v2 being Element of REAL n
  st v1=u1 & v2=u2 holds dist(u1,u2) = |.v1-v2.|;

theorem 
  for P being non empty Subset of TOP-REAL n st P is closed & P c= LSeg(
  p1,p2) ex s st (1-s)*p1+s*p2 in P & for r st 0<=r & r<=1 & (1-r)*p1+r*p2 in P
  holds s<=r;

theorem 
  for p1,p2,q1,q2 st LSeg(q1,q2) c= LSeg(p1,p2) & p1 in LSeg(q1,q2
  ) holds p1=q1 or p1=q2;

theorem 
  for p1,p2,q1,q2 st LSeg(p1,p2) = LSeg(q1,q2) holds p1=q1 & p2=q2 or p1
  =q2 & p2=q1;

registration
  let n,p1,p2;
  cluster LSeg(p1,p2) -> compact;
 cluster LSeg(p1,p2) -> closed;
end;

definition
  let n,p;
  let P be Subset of TOP-REAL n;
  pred p is_extremal_in P means


  p in P & for p1,p2 st p in LSeg(p1,p2) & LSeg(p1,p2) c= P holds p=p1 or p=p2;
end;

theorem 
  for P,Q being Subset of TOP-REAL n st p is_extremal_in P & Q c= P & p
  in Q holds p is_extremal_in Q;

theorem 
  p is_extremal_in {p};

theorem 
  p1 is_extremal_in LSeg(p1,p2);

theorem 
  p2 is_extremal_in LSeg(p1,p2);

theorem 
  p is_extremal_in LSeg(p1,p2) implies p = p1 or p = p2;

begin



reserve P,Q for Subset of TOP-REAL 2,
  f,f1,f2 for FinSequence of the carrier of TOP-REAL 2,
  p,p1,p2,p3,q,q3 for Point of TOP-REAL 2;

theorem 
  for p1,p2 st p1`1<>p2`1 & p1`2<>p2`2 ex p st p in LSeg(p1,p2) &
  p`1<>p1`1 & p`1<>p2`1 & p`2<>p1`2 & p`2<>p2`2;

definition
  let P;
  attr P is horizontal means


  for p,q st p in P & q in P holds p`2=q`2;
  attr P is vertical means


  for p,q st p in P & q in P holds p`1=q`1;
end;

registration
  cluster non trivial horizontal -> non vertical for Subset of TOP-REAL 2;
  cluster non trivial vertical -> non horizontal for Subset of TOP-REAL 2;
end;

theorem 
  p`2=q`2 iff LSeg(p,q) is horizontal;

theorem 
  p`1=q`1 iff LSeg(p,q) is vertical;

theorem 
  p1 in LSeg(p,q) & p2 in LSeg(p,q) & p1`1<>p2`1 & p1`2=p2`2 implies
  LSeg(p,q) is horizontal;

theorem 
  p1 in LSeg(p,q) & p2 in LSeg(p,q) & p1`2<>p2`2 & p1`1=p2`1 implies
  LSeg(p,q) is vertical;

registration
  let f,i;
  cluster LSeg(f,i) -> closed;
end;

theorem 
  f is special implies LSeg(f,i) is vertical or LSeg(f,i) is horizontal;

theorem 
  f is one-to-one & 1 <= i & i+1 <= len f implies LSeg(f,i) is non trivial;

theorem 
  f is one-to-one & 1 <= i & i+1 <= len f & LSeg(f,i) is vertical
  implies LSeg(f,i) is non horizontal;

theorem 
  for f holds {LSeg(f,i): 1<=i & i<=len f} is finite;

theorem 
  for f holds {LSeg(f,i): 1<=i & i+1<=len f} is finite;

theorem 
  for f holds {LSeg(f,i): 1<=i & i<=len f} is Subset-Family of TOP-REAL 2;

theorem 
  for f holds {LSeg(f,i): 1<=i & i+1<=len f} is Subset-Family of TOP-REAL 2;

theorem 
  for f st Q = union{LSeg(f,i): 1<=i & i+1<=len f} holds Q is closed;

registration
  let f;
  cluster L~f -> closed;
end;

definition
  let IT be FinSequence of TOP-REAL 2;
  attr IT is alternating means


  for i st 1 <= i & i+2 <= len IT holds (
  IT/.i)`1 <> (IT/.(i+2))`1 & (IT/.i)`2 <> (IT/.(i+2))`2;
end;

theorem 
  f is special alternating & 1 <= i & i+2 <= len f & (f/.i)`1 = (f
  /.(i+1))`1 implies (f/.(i+1))`2 = (f/.(i+2))`2;

theorem 
  f is special alternating & 1 <= i & i+2 <= len f & (f/.i)`2 = (f
  /.(i+1))`2 implies (f/.(i+1))`1 = (f/.(i+2))`1;

theorem 
  f is special alternating & 1 <= i & i+2 <= len f & p1 = f/.i &
p2 = f/.(i+1) & p3 = f/.(i+2) implies p1`1 = p2`1 & p3`1 <> p2`1 or p1`2 = p2`2
  & p3`2 <> p2`2;

theorem 
  f is special alternating & 1 <= i & i+2 <= len f & p1 = f/.i & p2 = f
/.(i+1) & p3 = f/.(i+2) implies p2`1 = p3`1 & p1`1 <> p2`1 or p2`2 = p3`2 & p1
  `2 <> p2`2;

theorem 
  f is special alternating & 1<=i & i+2<=len f implies not LSeg(f/.i,f/.
  (i+2)) c= LSeg(f,i) \/ LSeg(f,i+1);

theorem 
  f is special alternating & 1<=i & i+2<=len f & LSeg(f,i) is
  vertical implies LSeg(f,i+1) is horizontal;

theorem 
  f is special alternating & 1<=i & i+2<=len f & LSeg(f,i) is
  horizontal implies LSeg(f,i+1) is vertical;

theorem 
  f is special alternating & 1<=i & i+2<=len f implies LSeg(f,i) is
  vertical & LSeg(f,i+1) is horizontal or LSeg(f,i) is horizontal & LSeg(f,i+1)
  is vertical;

theorem 
  f is special alternating & 1<=i & i+2<=len f & f/.(i+1) in LSeg(
  p,q) & LSeg(p,q) c= LSeg(f,i) \/ LSeg(f,i+1) implies f/.(i+1)=p or f/.(i+1)=q
;

theorem 
  f is special alternating & 1<=i & i+2<=len f implies f/.(i+1)
  is_extremal_in LSeg(f,i) \/ LSeg(f,i+1);

theorem 
  for u being Point of Euclid 2 st f is special alternating & 1<=i
  & i+2<=len f & u = f/.(i+1) & f/.(i+1) in LSeg(p,q) & f/.(i+1)<>q & not p in
  LSeg(f,i) \/ LSeg(f,i+1) holds for s st s>0 ex p3 st not p3 in LSeg(f,i) \/
  LSeg(f,i+1) & p3 in LSeg(p,q) & p3 in Ball(u,s);

definition
  let f1,f2,P;
  pred f1,f2 are_generators_of P means


  f1 is alternating being_S-Seq &
f2 is alternating being_S-Seq & f1/.1 = f2/.1 & f1/.len f1 = f2/.len f2 & <*f1
/.2,f1/.1,f2/.2*> is alternating & <*f1/.(len f1 - 1),f1/.len f1,f2/.(len f2 -
1)*> is alternating & f1/.1 <> f1/.len f1 & L~f1 /\ L~f2 = {f1/.1,f1/.len f1} &
  P = L~f1 \/ L~f2;
end;

theorem 
  f1,f2 are_generators_of P & 1<i & i<len f1 implies f1/.i is_extremal_in P;



theorem 
  for p, q being Point of TOP-REAL n, p9, q9 being Point of Euclid n st
  p = p9 & q = q9 holds dist (p9, q9) = |. p - q .|;



theorem 
  for p,q,r being Point of TOP-REAL 2 st LSeg(p,q) is horizontal & r in
  LSeg(p,q) holds p`2 = r`2;

theorem 
  for p,q,r being Point of TOP-REAL 2 st LSeg(p,q) is vertical & r in
  LSeg(p,q) holds p`1 = r`1;

registration
  cluster compact non empty horizontal for Subset of TOP-REAL 2;
  cluster compact non empty vertical for Subset of TOP-REAL 2;
end;














begin 

reserve P for Subset of TOP-REAL 2,
  f,f1,f2,g for FinSequence of TOP-REAL 2,
  p,p1,p2,q,q1,q2 for Point of TOP-REAL 2,
  r1,r2,r19,r29 for real number,
  i,j,k,n for Element of NAT;

theorem 
  |[ r1,r2 ]| = |[ r19,r29 ]| implies r1 = r19 & r2 = r29;

theorem 
  for i, j being Nat holds i+j = len f implies LSeg(f,i) = LSeg(Rev f,j);

theorem 
  for i, n being Nat holds i+1 <= len(f|n) implies LSeg(f|n,i) = LSeg(f,i);

theorem 
  for i, n being Nat holds n <= len f & 1 <= i implies LSeg(f/^n,i)
  = LSeg(f,n+i);

theorem 
  for i, n being Nat holds 1 <= i & i+1 <= len f - n implies LSeg(f
  /^n,i) = LSeg(f,n+i);

theorem 
  for i being Nat holds i+1 <= len f implies LSeg(f^g,i) = LSeg(f,i );

theorem 
  for i being Nat holds 1 <= i implies LSeg(f^g,len f + i) = LSeg(g ,i);

theorem 
  f is non empty & g is non empty implies LSeg(f^g,len f) = LSeg(f
  /.len f,g/.1);

theorem 
  for i being Nat holds i+1 <= len(f-:p) implies LSeg(f-:p,i) = LSeg(f,i);

theorem 
  for i being Nat holds p in rng f implies LSeg(f:-p,i+1) = LSeg(f ,i+p..f);

theorem 
  L~<*>(the carrier of TOP-REAL 2) = {};

theorem 
  L~<*p*> = {};

theorem 
  p in L~f implies ex i st 1 <= i & i+1 <= len f & p in LSeg(f,i);

theorem 
  p in L~f implies ex i st 1 <= i & i+1 <= len f & p in LSeg(f/.i, f/.(i+1));

theorem 
  1 <= i & i+1 <= len f & p in LSeg(f/.i,f/.(i+1)) implies p in L~ f;

theorem 
  1 <= i & i+1 <= len f implies LSeg(f/.i,f/.(i+1)) c= L~f;

theorem 
  p in LSeg(f,i) implies p in L~f;

theorem 
  len f >= 2 implies rng f c= L~f;

theorem 
  f is non empty implies L~(f^<*p*>) = L~f \/ LSeg(f/.len f,p);

theorem 
  f is non empty implies L~(<*p*>^f) = LSeg(p,f/.1) \/ L~f;

theorem 
  L~<*p,q*> = LSeg(p,q);

theorem 
  L~f = L~(Rev f);

theorem 
  f1 is non empty & f2 is non empty implies L~(f1^f2) = L~f1 \/
  LSeg(f1/.len f1,f2/.1) \/ L~f2;

theorem 
  q in rng f implies L~f = L~(f-:q) \/ L~(f:-q);

theorem 
  p in LSeg(f,n) implies L~f = L~Ins(f,n,p);

begin

registration
  cluster being_S-Seq for FinSequence of TOP-REAL 2;
  cluster being_S-Seq -> one-to-one unfolded s.n.c. special non trivial
    for FinSequence of TOP-REAL 2;
  cluster one-to-one unfolded s.n.c. special non trivial -> being_S-Seq
    for FinSequence of TOP-REAL 2;
  cluster being_S-Seq -> non empty for FinSequence of TOP-REAL 2;
end;

registration
  cluster one-to-one unfolded s.n.c. special non trivial for FinSequence of
    TOP-REAL 2;
end;

theorem 
  len f <= 2 implies f is unfolded;

registration
  let f be unfolded FinSequence of TOP-REAL 2, n;
  cluster f|n -> unfolded for FinSequence of TOP-REAL 2;
  cluster f/^n -> unfolded for FinSequence of TOP-REAL 2;
end;

theorem 
  p in rng f & f is unfolded implies f:-p is unfolded;

registration
  let f be unfolded FinSequence of TOP-REAL 2, p;
  cluster f-:p -> unfolded;
end;

theorem 
  f is unfolded implies Rev f is unfolded;

theorem 
  g is unfolded & LSeg(p,g/.1) /\ LSeg(g,1) = {g/.1} implies <*p*>
  ^g is unfolded;

theorem 
  f is unfolded & k+1 = len f & LSeg(f,k) /\ LSeg(f/.len f,p) = {f
  /.len f} implies f^<*p*> is unfolded;

theorem 
  f is unfolded & g is unfolded & k+1 = len f & LSeg(f,k) /\ LSeg(
f/.len f,g/.1) = {f/.len f} & LSeg(f/.len f,g/.1) /\ LSeg(g,1) = {g/.1} implies
  f^g is unfolded;

theorem 
  f is unfolded & p in LSeg(f,n) implies Ins(f,n,p) is unfolded;

theorem 
  len f <= 2 implies f is s.n.c.;

registration
  let f be s.n.c. FinSequence of TOP-REAL 2, n;
  cluster f|n -> s.n.c. for FinSequence of TOP-REAL 2;
  cluster f/^n -> s.n.c. for FinSequence of TOP-REAL 2;
end;

registration
  let f be s.n.c. FinSequence of TOP-REAL 2, p;
  cluster f-:p -> s.n.c.;
end;

theorem 
  p in rng f & f is s.n.c. implies f:-p is s.n.c.;

theorem 
  f is s.n.c. implies Rev f is s.n.c.;

theorem 
  f is s.n.c. & g is s.n.c. & L~f misses L~g & (for i st 1<=i & i+
  2 <= len f holds LSeg(f,i) misses LSeg(f/.len f,g/.1)) & (for i st 2<=i & i+1
  <= len g holds LSeg(g,i) misses LSeg(f/.len f,g/.1)) implies f^g is s.n.c.;

theorem 
  f is unfolded s.n.c. & p in LSeg(f,n) & not p in rng f implies
  Ins(f,n,p) is s.n.c.;

registration
  cluster <*>(the carrier of TOP-REAL 2) -> special;
end;

registration
  let p;
  cluster <*p*> -> special for FinSequence of TOP-REAL 2;
end;

theorem 
  p`1 = q`1 or p`2 = q`2 implies <*p,q*> is special;

registration
  let f be special FinSequence of TOP-REAL 2, n;
  cluster f|n -> special for FinSequence of TOP-REAL 2;
  cluster f/^n -> special for FinSequence of TOP-REAL 2;
end;

theorem 
  p in rng f & f is special implies f:-p is special;

registration
  let f be special FinSequence of TOP-REAL 2, p;
  cluster f-:p -> special;
end;

theorem 
  f is special implies Rev f is special;

theorem 
  f is special & p in LSeg(f,n) implies Ins(f,n,p) is special;

theorem 
  q in rng f & 1<>q..f & q..f<>len f & f is unfolded s.n.c.
  implies L~(f-:q) /\ L~(f:-q) = {q};

theorem 
  p <> q & (p`1 = q`1 or p`2 = q`2) implies <*p,q*> is being_S-Seq;

definition
  mode S-Sequence_in_R2 is being_S-Seq FinSequence of TOP-REAL 2;
end;

registration
  let f be S-Sequence_in_R2;
  cluster Rev f -> being_S-Seq for FinSequence of TOP-REAL 2;
end;

theorem 
  for f being S-Sequence_in_R2 st i in dom f holds f/.i in L~f;

theorem 
  p <> q & (p`1 = q`1 or p`2 = q`2) implies LSeg(p,q) is being_S-P_arc;

theorem 
  for f being S-Sequence_in_R2 st p in rng f & p..f <> 1 holds f-:
  p is being_S-Seq;

theorem 
  for f being S-Sequence_in_R2 st p in rng f & p..f <> len f holds f:-p
  is being_S-Seq;

theorem 
  for f being S-Sequence_in_R2 st p in LSeg(f,i) & not p in rng f
  holds Ins(f,i,p) is being_S-Seq;

begin 

registration
  cluster being_S-P_arc for Subset of TOP-REAL 2;
end;

theorem 
  P is_S-P_arc_joining p1,p2 implies P is_S-P_arc_joining p2,p1;

definition
  let p1,p2;
  let P be Subset of TOP-REAL 2;
  pred p1,p2 split P means


  p1 <> p2 & ex f1,f2 being S-Sequence_in_R2
st p1 = f1/.1 & p1 = f2/.1 & p2 = f1/.len f1 & p2 = f2/.len f2 & L~f1 /\ L~f2 =
  {p1,p2} & P = L~f1 \/ L~f2;
end;

theorem 
  p1,p2 split P implies p2,p1 split P;

theorem 
  p1,p2 split P & q in P & q <> p1 implies p1,q split P;

theorem 
  p1,p2 split P & q in P & q <> p2 implies q,p2 split P;

theorem 
  p1,p2 split P & q1 in P & q2 in P & q1 <> q2 implies q1,q2 split P;

notation
  let P be Subset of TOP-REAL 2;
  synonym P is special_polygonal for P is being_special_polygon;
end;

definition
  let P be Subset of TOP-REAL 2;
  redefine attr P is special_polygonal means


  ex p1,p2 st p1,p2 split P;
end;

definition
  let r1,r2,r19,r29;
  func [.r1,r2,r19,r29.] -> Subset of TOP-REAL 2 equals

  ( LSeg(|[r1,r19]|,|[r1
  ,r29]|) \/ LSeg(|[r1,r29]|,|[r2,r29]|) ) \/ ( LSeg(|[r2,r29]|,|[r2,r19]|) \/
  LSeg(|[r2,r19]|,|[r1,r19]|) );
end;

registration
  let n be Element of NAT;
  let p1, p2 be Point of TOP-REAL n;
  cluster LSeg(p1,p2) -> compact;
end;

registration
  let r1,r2,r19,r29;
  cluster [.r1,r2,r19,r29.] -> non empty compact;
end;

theorem 
  r1<=r2 & r19<=r29 implies [.r1,r2,r19,r29.] = { p: p`1 = r1 & p`2 <=
r29 & p`2 >= r19 or p`1 <= r2 & p`1 >= r1 & p`2 = r29 or p`1 <= r2 & p`1 >= r1
  & p`2 = r19 or p`1 = r2 & p`2 <= r29 & p`2 >= r19};

theorem 
  r1<>r2 & r19<>r29 implies [.r1,r2,r19,r29.] is special_polygonal;

theorem 
  R^2-unit_square = [.0,1,0,1.];

registration
  cluster special_polygonal for Subset of TOP-REAL 2;
end;

registration
  cluster R^2-unit_square -> special_polygonal;
end;

registration
  cluster special_polygonal for Subset of TOP-REAL 2;
  cluster special_polygonal -> non empty for Subset of TOP-REAL 2;
  cluster special_polygonal -> non trivial for Subset of TOP-REAL 2;
end;

definition
  mode Special_polygon_in_R2 is special_polygonal Subset of TOP-REAL 2;
end;

theorem 
  P is being_S-P_arc implies P is compact;

registration
  cluster -> compact for Special_polygon_in_R2;
end;

theorem 
  P is special_polygonal implies for p1,p2 st p1 <> p2 & p1 in P &
  p2 in P holds p1,p2 split P;

theorem 
  P is special_polygonal implies for p1,p2 st p1 <> p2 & p1 in P & p2 in
  P ex P1,P2 being Subset of TOP-REAL 2 st P1 is_S-P_arc_joining p1,p2 & P2
  is_S-P_arc_joining p1,p2 & P1 /\ P2 = {p1,p2} & P = P1 \/ P2;














begin





reserve GX,GY for non empty TopSpace,
  x,y for Point of GX,
  r,s for Real;

theorem 
  for GX being non empty TopSpace st (for x,y being Point of GX
  ex h being Function of I[01],GX st h is continuous & x=h.0 & y=h.1)
  holds GX is connected;

theorem 
  for A being Subset of GX st
  (for xa,ya being Point of GX st xa in A & ya in A & xa<>ya
  ex h being Function of I[01],GX|A st h is continuous & xa=h.0 & ya=h.1)
  holds A is connected;

theorem 
  for A0 being Subset of GX, A1 being Subset of GX st
  A0 is connected & A1 is connected & A0 meets A1
  holds A0 \/ A1 is connected;

theorem 
  for A0,A1,A2 being Subset of GX st
  A0 is connected & A1 is connected & A2 is connected & A0 meets A1 &
  A1 meets A2 holds A0 \/ A1 \/ A2 is connected;

theorem 
  for A0,A1,A2,A3 being Subset of GX st A0 is connected & A1 is connected &
  A2 is connected & A3 is connected & A0 meets A1 & A1 meets A2 &
  A2 meets A3 holds A0 \/ A1 \/ A2 \/ A3 is connected;

begin





reserve Q,P1,P2 for Subset of TOP-REAL 2;
reserve P for Subset of TOP-REAL 2;
reserve w1,w2 for Point of TOP-REAL 2;

definition
  let V be RealLinearSpace, P be Subset of V;
  redefine attr P is convex means

  for w1,w2 being Element of V st w1 in P & w2 in P holds LSeg(w1,w2) c= P;
end;

registration let n be Nat;
 cluster convex -> connected for Subset of TOP-REAL n;
end;

reserve pa,pb for Point of TOP-REAL 2,
  s1,t1,s2,t2,s,t,s3,t3,s4,t4,s5,t5,s6,t6, l,sa,sd,ta,td for Real;
reserve s1a,t1a,s2a,t2a,s3a,t3a,sb,tb,sc,tc for Real;

canceled;

theorem 
  {|[ s,t ]|: s1<s & s<s2 & t1<t & t<t2} =
  {|[ s3,t3 ]|:s1<s3} /\ {|[s4,t4]|:s4<s2} /\ {|[s5,t5]|:t1<t5} /\
  {|[s6,t6]|:t6<t2};

theorem 
  {|[ s,t ]|:not (s1<=s & s<=s2 & t1<=t & t<=t2)} =
  {|[ s3,t3 ]|:s3<s1} \/ {|[s4,t4]|:t4<t1} \/ {|[s5,t5]|:s2<s5} \/
  {|[s6,t6]|:t2<t6};

theorem 
  for s1,t1,s2,t2,P st P = {|[ s,t ]|:s1<s & s<s2 & t1<t & t<t2}
  holds P is convex;

canceled;

theorem 
  for s1,P st P = { |[ s,t ]|:s1<s } holds P is convex;

canceled;

theorem 
  for s2,P st P = {|[ s,t ]|:s<s2 } holds P is convex;

canceled;

theorem 
  for t1,P st P = {|[ s,t ]|:t1<t } holds P is convex;

canceled;

theorem 
  for t2,P st P = { |[ s,t ]|: t<t2 } holds P is convex;

canceled;

theorem 
  for s1,t1,s2,t2,P st P = { |[ s,t ]|:not (s1<=s & s<=s2 & t1<=t & t<=t2)}
  holds P is connected;

theorem 
  for s1 for P being Subset of TOP-REAL 2 st P = { |[ s,t ]|:s1<s } holds
  P is open;

theorem 
  for s1 for P being Subset of TOP-REAL 2 st P = { |[ s,t ]|:s1>s } holds
  P is open;

theorem 
  for s1 for P being Subset of TOP-REAL 2 st
  P = { |[ s,t ]|:s1<t } holds P is open;

theorem 
  for s1 for P being Subset of TOP-REAL 2 st P = { |[ s,t ]|:s1>t } holds
  P is open;

theorem 
  for s1,t1,s2,t2 for P being Subset of TOP-REAL 2 st
  P = { |[ s,t ]|:s1<s & s<s2 & t1<t & t<t2} holds P is open;

theorem 
  for s1,t1,s2,t2 for P being Subset of TOP-REAL 2 st
  P = { |[ s,t ]|:not (s1<=s & s<=s2 & t1<=t & t<=t2)} holds P is open;

theorem 
  for s1,t1,s2,t2,P,Q st P = { |[ sa,ta ]|:s1<sa & sa<s2 & t1<ta & ta<t2} &
  Q = { |[ sb,tb ]|:not (s1<=sb & sb<=s2 & t1<=tb & tb<=t2)} holds P misses Q;

theorem 
  for s1,s2,t1,t2 be Real holds
  {p where p is Point of TOP-REAL 2:s1<p`1 & p`1<s2 & t1<p`2 & p`2<t2} =
  {|[sa,ta]|:s1<sa & sa<s2 & t1<ta & ta<t2};

theorem 
  for s1,s2,t1,t2 holds {qc where qc is Point of TOP-REAL 2:
  not (s1<=qc`1 & qc`1<=s2 & t1<=qc`2 & qc`2<=t2)} =
  {|[sb,tb]| : not (s1<=sb & sb<=s2 & t1<=tb & tb<=t2)};

theorem 
  for s1,s2,t1,t2 holds
  { p0 where p0 is Point of TOP-REAL 2:s1<p0`1 & p0`1<s2 & t1<p0`2 & p0`2<t2}
  is Subset of TOP-REAL 2;

theorem 
  for s1,s2,t1,t2 holds { pq where pq is Point of TOP-REAL 2:
  not (s1<=pq`1 & pq`1<=s2 & t1<=pq`2 & pq`2<=t2)} is Subset of TOP-REAL 2;

theorem 
  for s1,t1,s2,t2,P st
  P = { p0 where p0 is Point of TOP-REAL 2:s1<p0`1 & p0`1<s2
  & t1<p0`2 & p0`2<t2} holds P is convex;

theorem 
  for s1,t1,s2,t2,P st P = { pq where pq is Point of TOP-REAL 2:
  not (s1<=pq`1 & pq`1<=s2 & t1<=pq`2 & pq`2<=t2)} holds P is connected;

theorem 
  for s1,t1,s2,t2 for P being Subset of TOP-REAL 2 st
  P = { p0 where p0 is Point of TOP-REAL 2:s1<p0`1 & p0`1<s2
  & t1<p0`2 & p0`2<t2} holds P is open;

theorem 
  for s1,t1,s2,t2 for P being Subset of TOP-REAL 2 st
  P = { pq where pq is Point of TOP-REAL 2:
  not (s1<=pq`1 & pq`1<=s2 & t1<=pq`2 & pq`2<=t2)} holds P is open;

theorem 
  for s1,t1,s2,t2,P,Q st
  P = {p where p is Point of TOP-REAL 2:s1<p`1 & p`1<s2 & t1<p`2 & p`2<t2} &
  Q = {qc where qc is Point of TOP-REAL 2:
  not (s1<=qc`1 & qc`1<=s2 & t1<=qc`2 & qc`2<=t2)} holds P misses Q;

theorem 
  for s1,t1,s2,t2 for P,P1,P2 being Subset of TOP-REAL 2 st s1<s2 & t1<t2 &
  P = { p where p is Point of TOP-REAL 2: p`1 = s1 & p`2 <= t2 & p`2 >= t1 or
  p`1 <= s2 & p`1 >= s1 & p`2 = t2 or p`1 <= s2 & p`1 >= s1 & p`2 = t1 or
  p`1 = s2 & p`2 <= t2 & p`2 >= t1} &
  P1 = {pa where pa is Point of TOP-REAL 2:
  s1<pa`1 & pa`1<s2 & t1 <pa`2 & pa`2 < t2} &
  P2 = {pb where pb is Point of TOP-REAL 2:
  not( s1<=pb`1 & pb`1<=s2 & t1<=pb`2 & pb`2<=t2)} holds
  P`= P1 \/ P2 & P`<> {} & P1 misses P2 &
  for P1A,P2B being Subset of (TOP-REAL 2)|P` st P1A = P1 & P2B = P2 holds
  P1A is a_component & P2B is a_component;

theorem 
  for s1,t1,s2,t2 for P,P1,P2 being Subset of TOP-REAL 2 st s1<s2 & t1<t2 &
  P = { p where p is Point of TOP-REAL 2: p`1 = s1 & p`2 <= t2 & p`2 >= t1 or
  p`1 <= s2 & p`1 >= s1 & p`2 = t2 or p`1 <= s2 & p`1 >= s1 & p`2 = t1 or
  p`1 = s2 & p`2 <= t2 & p`2 >= t1} &
  P1 = {pa where pa is Point of TOP-REAL 2:
  s1<pa`1 & pa`1<s2 & t1 <pa`2 & pa`2 < t2} &
  P2 = {pb where pb is Point of TOP-REAL 2:
  not( s1<=pb`1 & pb`1<=s2 & t1<=pb`2 & pb`2<=t2)}
  holds P = (Cl P1) \ P1 & P = (Cl P2) \P2;

theorem 
  for s1,s2,t1,t2,P,P1 st P = { p where p is Point of TOP-REAL 2:
  p`1 = s1 & p`2 <= t2 & p`2 >= t1 or p`1 <= s2 & p`1 >= s1 & p`2 = t2 or
  p`1 <= s2 & p`1 >= s1 & p`2 = t1 or p`1 = s2 & p`2 <= t2 & p`2 >= t1} &
  P1 = {pa where pa is Point of TOP-REAL 2:
  s1<pa`1 & pa`1<s2 & t1 <pa`2 & pa`2 < t2} holds P1 c= [#] ((TOP-REAL 2)|P`);

theorem 
  for s1,s2,t1,t2,P,P1 st P = { p where p is Point of TOP-REAL 2:
  p`1 = s1 & p`2 <= t2 & p`2 >= t1 or p`1 <= s2 & p`1 >= s1 & p`2 = t2 or
  p`1 <= s2 & p`1 >= s1 & p`2 = t1 or p`1 = s2 & p`2 <= t2 & p`2 >= t1} &
  P1 = {pa where pa is Point of TOP-REAL 2:
  s1<pa`1 & pa`1<s2 & t1 <pa`2 & pa`2 < t2} holds
  P1 is Subset of (TOP-REAL 2)|P`;

theorem 
  for s1,s2,t1,t2,P,P2 st s1<s2 & t1<t2 &
  P = { p where p is Point of TOP-REAL 2: p`1 = s1 & p`2 <= t2 & p`2 >= t1 or
  p`1 <= s2 & p`1 >= s1 & p`2 = t2 or p`1 <= s2 & p`1 >= s1 & p`2 = t1 or
  p`1 = s2 & p`2 <= t2 & p`2 >= t1} &
  P2 = {pb where pb is Point of TOP-REAL 2:
  not( s1<=pb`1 & pb`1<=s2 & t1<=pb`2 & pb`2<=t2)} holds
  P2 c= [#]((TOP-REAL 2)|P`);

theorem 
  for s1,s2,t1,t2,P,P2 st s1<s2 & t1< t2 &
  P = { p where p is Point of TOP-REAL 2: p`1 = s1 & p`2 <= t2 & p`2 >= t1 or
  p`1 <= s2 & p`1 >= s1 & p`2 = t2 or p`1 <= s2 & p`1 >= s1 & p`2 = t1 or
  p`1 = s2 & p`2 <= t2 & p`2 >= t1} &
  P2 = {pb where pb is Point of TOP-REAL 2:
  not( s1<=pb`1 & pb`1<=s2 & t1<=pb`2 & pb`2<=t2)} holds
  P2 is Subset of (TOP-REAL 2)|P`;

begin





definition
  let S be Subset of TOP-REAL 2;
  attr S is Jordan means


  S`<> {} & ex A1,A2 being Subset of TOP-REAL 2 st
  S` = A1 \/ A2 & A1 misses A2 & (Cl A1) \ A1 = (Cl A2) \ A2 &
  for C1,C2 being Subset of (TOP-REAL 2)|S` st C1 = A1 & C2 = A2 holds
  C1 is a_component & C2 is a_component;
end;

theorem 
  for S being Subset of TOP-REAL 2 st S is Jordan holds S`<> {} &
  ex A1,A2 being Subset of TOP-REAL 2 st
  ex C1,C2 being Subset of (TOP-REAL 2)|S` st S` = A1 \/ A2 & A1 misses A2 &
  (Cl A1) \ A1 = (Cl A2) \ A2 & C1 = A1 & C2 = A2 &
  C1 is a_component & C2 is a_component &
  for C3 being Subset of (TOP-REAL 2)|S` st C3 is a_component holds
  C3 = C1 or C3 = C2;

theorem 
  for s1,s2,t1,t2 for P being Subset of TOP-REAL 2 st s1<s2 & t1<t2 &
  P = { p where p is Point of TOP-REAL 2: p`1 = s1 & p`2 <= t2 & p`2 >= t1 or
  p`1 <= s2 & p`1 >= s1 & p`2 = t2 or p`1 <= s2 & p`1 >= s1 & p`2 = t1 or
  p`1 = s2 & p`2 <= t2 & p`2 >= t1} holds P is Jordan;

theorem 
  for s1,t1,s2,t2 for P,P2 being Subset of TOP-REAL 2 st s1<s2 & t1<t2 &
  P = { p where p is Point of TOP-REAL 2: p`1 = s1 & p`2 <= t2 & p`2 >= t1 or
  p`1 <= s2 & p`1 >= s1 & p`2 = t2 or p`1 <= s2 & p`1 >= s1 & p`2 = t1 or
  p`1 = s2 & p`2 <= t2 & p`2 >= t1} &
  P2 = {pb where pb is Point of TOP-REAL 2:
  not( s1<=pb`1 & pb`1<=s2 & t1<=pb`2 & pb`2<=t2)}
  holds Cl P2 = P \/ P2;

theorem 
  for s1,t1,s2,t2 for P,P1 being Subset of TOP-REAL 2 st s1<s2 & t1<t2 &
  P = { p where p is Point of TOP-REAL 2: p`1 = s1 & p`2 <= t2 & p`2 >= t1 or
  p`1 <= s2 & p`1 >= s1 & p`2 = t2 or p`1 <= s2 & p`1 >= s1 & p`2 = t1 or
  p`1 = s2 & p`2 <= t2 & p`2 >= t1} &
  P1 = {pa where pa is Point of TOP-REAL 2:
  s1<pa`1 & pa`1<s2 & t1 <pa`2 & pa`2 < t2} holds Cl P1 = P \/ P1;



theorem 
  for p,q being Point of TOP-REAL 2 holds LSeg(p,q) \ {p,q} is convex;

registration
  let p be Point of TOP-REAL 2;
  cluster north_halfline p -> convex;
  cluster east_halfline p -> convex;
  cluster south_halfline p -> convex;
  cluster west_halfline p -> convex;
end;














begin

reserve p,q for Point of TOP-REAL 2,
  i,i1,i2,j,j1,j2,k for Element of NAT,
  r,s for Real,
  G for Matrix of TOP-REAL 2;

definition
  let G be Matrix of TOP-REAL 2;
  let i be Nat;
  func v_strip(G,i) -> Subset of TOP-REAL 2 equals


  { |[r,s]| : G*(i,1)`1 <= r & r <= G*(i+1,1)`1 } if 1 <= i & i < len G,
  { |[r,s]| : G*(i,1)`1 <= r } if i >= len G
  otherwise { |[r,s]| : r <= G*(i+1,1)`1 };
  func h_strip(G,i) -> Subset of TOP-REAL 2 equals


  { |[r,s]| : G*(1,i)`2 <= s & s <= G*(1,i+1)`2 } if 1 <= i & i < width G,
  { |[r,s]| : G*(1,i)`2 <= s } if i >= width G
  otherwise { |[r,s]| : s <= G*(1,i+1)`2 };
end;

theorem 
  G is Y_equal-in-column & 1 <= j & j <= width G & 1 <= i & i <= len G
  implies G*(i,j)`2 = G*(1,j)`2;

theorem 
  G is X_equal-in-line & 1 <= j & j <= width G & 1 <= i & i <= len G
  implies G*(i,j)`1 = G*(i,1)`1;

theorem 
  G is X_increasing-in-column &
  1 <= j & j <= width G & 1 <= i1 & i1 < i2 & i2 <= len G
  implies G*(i1,j)`1 < G*(i2,j)`1;

theorem 
  G is Y_increasing-in-line &
  1 <= j1 & j1 < j2 & j2 <= width G & 1 <= i & i <= len G
  implies G*(i,j1)`2 < G*(i,j2)`2;

theorem 
  G is Y_equal-in-column & 1 <= j & j < width G & 1 <= i & i <= len G
  implies h_strip(G,j) = { |[r,s]| : G*(i,j)`2 <= s & s <= G*(i,j+1)`2 };

theorem 
  G is non empty-yielding Y_equal-in-column & 1 <= i & i <= len G
  implies h_strip(G,width G) = { |[r,s]| : G*(i,width G)`2 <= s };

theorem 
  G is non empty-yielding Y_equal-in-column & 1 <= i & i <= len G
  implies h_strip(G,0) = { |[r,s]| : s <= G*(i,1)`2 };

theorem 
  G is X_equal-in-line & 1 <= i & i < len G & 1 <= j & j <= width G
  implies v_strip(G,i) = { |[r,s]| : G*(i,j)`1 <= r & r <= G*(i+1,j)`1 };

theorem 
  G is non empty-yielding X_equal-in-line & 1 <= j & j <= width G
  implies v_strip(G,len G) = { |[r,s]| : G*(len G,j)`1 <= r };

theorem 
  G is non empty-yielding X_equal-in-line & 1 <= j & j <= width G
  implies v_strip(G,0) = { |[r,s]| : r <= G*(1,j)`1 };

definition
  let G be Matrix of TOP-REAL 2;
  let i,j be Nat;
  func cell(G,i,j) -> Subset of TOP-REAL 2 equals

  v_strip(G,i) /\ h_strip(G,j);
end;

definition
  let IT be FinSequence of TOP-REAL 2;
  attr IT is s.c.c. means

  for i,j st i+1 < j & (i > 1 & j < len IT or j+1 < len IT)
  holds LSeg(IT,i) misses LSeg(IT,j);
end;

definition
  let IT be non empty FinSequence of TOP-REAL 2;
  attr IT is standard means


  IT is_sequence_on GoB IT;
end;

registration
  cluster non constant special unfolded circular s.c.c.
    standard for non empty FinSequence of TOP-REAL 2;
end;

theorem 
  for f being non empty FinSequence of TOP-REAL 2
  for n being Element of NAT st n in dom f
  ex i,j st [i,j] in Indices GoB f & f/.n = (GoB f)*(i,j);

theorem 
  for f being standard non empty FinSequence of TOP-REAL 2,
  n being Element of NAT st n in dom f & n+1 in dom f
  for m,k,i,j being Element of NAT
  st [m,k] in Indices GoB f & [i,j] in Indices GoB f &
  f/.n = (GoB f)*(m,k) & f/.(n+1) = (GoB f)*(i,j) holds abs(m-i)+abs(k-j) = 1;

definition
  mode special_circular_sequence is
    special unfolded circular s.c.c. non empty FinSequence of TOP-REAL 2;
end;

reserve f for standard special_circular_sequence;

definition
  let f,k;
  assume that
 1 <= k and
 k+1 <= len f;
  func right_cell(f,k) -> Subset of TOP-REAL 2 means


  for i1,j1,i2,j2 being Element of NAT st
  [i1,j1] in Indices GoB f & [i2,j2] in Indices GoB f &
  f/.k = (GoB f)*(i1,j1) & f/.(k+1) = (GoB f)*(i2,j2) holds
  i1 = i2 & j1+1 = j2 & it = cell(GoB f,i1,j1) or
  i1+1 = i2 & j1 = j2 & it = cell(GoB f,i1,j1-'1) or
  i1 = i2+1 & j1 = j2 & it = cell(GoB f,i2,j2) or
  i1 = i2 & j1 = j2+1 & it = cell(GoB f,i1-'1,j2);
  func left_cell(f,k) -> Subset of TOP-REAL 2 means


  for i1,j1,i2,j2 being Element of NAT st
  [i1,j1] in Indices GoB f & [i2,j2] in Indices GoB f &
  f/.k = (GoB f)*(i1,j1) & f/.(k+1) = (GoB f)*(i2,j2) holds
  i1 = i2 & j1+1 = j2 & it = cell(GoB f,i1-'1,j1) or
  i1+1 = i2 & j1 = j2 & it = cell(GoB f,i1,j1) or
  i1 = i2+1 & j1 = j2 & it = cell(GoB f,i2,j2-'1) or
  i1 = i2 & j1 = j2+1 & it = cell(GoB f,i1,j2);
end;

theorem 
  G is non empty-yielding X_equal-in-line X_increasing-in-column &
  i < len G & 1 <= j & j < width G
  implies LSeg(G*(i+1,j),G*(i+1,j+1)) c= v_strip(G,i);

theorem 
  G is non empty-yielding X_equal-in-line X_increasing-in-column &
  1 <= i & i <= len G & 1 <= j & j < width G
  implies LSeg(G*(i,j),G*(i,j+1)) c= v_strip(G,i);

theorem 
  G is non empty-yielding Y_equal-in-column Y_increasing-in-line &
  j < width G & 1 <= i & i < len G
  implies LSeg(G*(i,j+1),G*(i+1,j+1)) c= h_strip(G,j);

theorem 
  G is non empty-yielding Y_equal-in-column Y_increasing-in-line &
  1 <= j & j <= width G & 1 <= i & i < len G
  implies LSeg(G*(i,j),G*(i+1,j)) c= h_strip(G,j);

theorem 
  G is Y_equal-in-column Y_increasing-in-line &
  1 <= i & i <= len G & 1 <= j & j+1 <= width G
  implies LSeg(G*(i,j),G*(i,j+1)) c= h_strip(G,j);

theorem 
  for G being Go-board holds i < len G & 1 <= j & j < width G
  implies LSeg(G*(i+1,j),G*(i+1,j+1)) c= cell(G,i,j);

theorem 
  for G being Go-board holds 1 <= i & i <= len G & 1 <= j & j < width G
  implies LSeg(G*(i,j),G*(i,j+1)) c= cell(G,i,j);

theorem 
  G is X_equal-in-line X_increasing-in-column &
  1 <= j & j <= width G & 1 <= i & i+1 <= len G
  implies LSeg(G*(i,j),G*(i+1,j)) c= v_strip(G,i);

theorem 
  for G being Go-board holds j < width G & 1 <= i & i < len G
  implies LSeg(G*(i,j+1),G*(i+1,j+1)) c= cell(G,i,j);

theorem 
  for G being Go-board holds 1 <= i & i < len G & 1 <= j & j <= width G
  implies LSeg(G*(i,j),G*(i+1,j)) c= cell(G,i,j);

theorem 
  G is non empty-yielding X_equal-in-line X_increasing-in-column &
  i+1 <= len G implies
  v_strip(G,i) /\ v_strip(G,i+1) = { q : q`1 = G*(i+1,1)`1 };

theorem 
  G is non empty-yielding Y_equal-in-column Y_increasing-in-line &
  j+1 <= width G implies
  h_strip(G,j) /\ h_strip(G,j+1) = { q : q`2 = G*(1,j+1)`2 };

theorem 
  for G being Go-board holds i < len G & 1 <= j & j < width G
  implies cell(G,i,j) /\ cell(G,i+1,j) = LSeg(G*(i+1,j),G*(i+1,j+1));

theorem 
  for G being Go-board holds j < width G & 1 <= i & i < len G
  implies cell(G,i,j) /\ cell(G,i,j+1) = LSeg(G*(i,j+1),G*(i+1,j+1));

theorem 
  1 <= k & k+1 <= len f & [i+1,j] in Indices GoB f & [i+1,j+1] in
  Indices GoB f &
  f/.k = (GoB f)*(i+1,j) & f/.(k+1) = (GoB f)*(i+1,j+1) implies
  left_cell(f,k) = cell(GoB f,i,j) & right_cell(f,k) = cell(GoB f,i+1,j);

theorem 
  1 <= k & k+1 <= len f & [i,j+1] in Indices GoB f & [i+1,j+1] in
  Indices GoB f &
  f/.k = (GoB f)*(i,j+1) & f/.(k+1) = (GoB f)*(i+1,j+1) implies
  left_cell(f,k) = cell(GoB f,i,j+1) & right_cell(f,k) = cell(GoB f,i,j);

theorem 
  1 <= k & k+1 <= len f & [i,j+1] in Indices GoB f & [i+1,j+1] in
  Indices GoB f &
  f/.k = (GoB f)*(i+1,j+1) & f/.(k+1) = (GoB f)*(i,j+1) implies
  left_cell(f,k) = cell(GoB f,i,j) & right_cell(f,k) = cell(GoB f,i,j+1);

theorem 
  1 <= k & k+1 <= len f & [i+1,j+1] in Indices GoB f & [i+1,j] in
  Indices GoB f &
  f/.k = (GoB f)*(i+1,j+1) & f/.(k+1) = (GoB f)*(i+1,j) implies
  left_cell(f,k) = cell(GoB f,i+1,j) & right_cell(f,k) = cell(GoB f,i,j);

theorem 
  1 <= k & k+1 <= len f implies left_cell(f,k) /\ right_cell(f,k) = LSeg(f, k )
;














begin

reserve n for Nat,
  i,j for Element of NAT,
  r,s,r1,s1,r2,s2,r9,s9 for Real,
  p,q for Point of TOP-REAL 2,
  G for Go-board,
  x,y for set,
  v for Point of Euclid 2;

theorem 
  for M being non empty Reflexive MetrStruct, u being Point of M, r
  being real number holds r > 0 implies u in Ball(u,r);

theorem 
  for p being Point of Euclid n, q being Point of TOP-REAL n, r
  being real number st p = q & r > 0 holds Ball (p, r) is a_neighborhood of q;

theorem 
  for B being Subset of TOP-REAL n, u being Point of Euclid n st B
  = Ball(u,r) holds B is open;

theorem 
  for M being non empty MetrSpace, u being Point of M, P being
Subset of TopSpaceMetr(M) holds u in Int P iff ex r being real number st r > 0
  & Ball(u,r) c= P;

theorem 
  for u being Point of Euclid n, P being Subset of TOP-REAL n holds
  u in Int P iff ex r being real number st r > 0 & Ball(u,r) c= P;

theorem 
  for u,v being Point of Euclid 2 st u = |[r1,s1]| & v = |[r2,s2]|
  holds dist(u,v) =sqrt ((r1 - r2)^2 + (s1 - s2)^2);

theorem 
  for u being Point of Euclid 2 st u = |[r,s]| holds 0 <= r2 & r2
  < r1 implies |[r+r2,s]| in Ball(u,r1);

theorem 
  for u being Point of Euclid 2 st u = |[r,s]| holds 0 <= s2 & s2
  < s1 implies |[r,s+s2]| in Ball(u,s1);

theorem 
  for u being Point of Euclid 2 st u = |[r,s]| holds 0 <= r2 & r2
  < r1 implies |[r-r2,s]| in Ball(u,r1);

theorem 
  for u being Point of Euclid 2 st u = |[r,s]| holds 0 <= s2 & s2
  < s1 implies |[r,s-s2]| in Ball(u,s1);

theorem 
  1 <= i & i < len G & 1 <= j & j < width G implies G*(i,j)+G*(i+1
  ,j+1) = G*(i,j+1)+G*(i+1,j);

theorem 
  Int v_strip(G,0) = { |[r,s]| : r < G*(1,1)`1 };

theorem 
  Int v_strip(G,len G) = { |[r,s]| : G*(len G,1)`1 < r };

theorem 
  1 <= i & i < len G implies Int v_strip(G,i) = { |[r,s]| : G*(i,1
  )`1 < r & r < G*(i+1,1)`1 };

theorem 
  Int h_strip(G,0) = { |[r,s]| : s < G*(1,1)`2 };

theorem 
  Int h_strip(G,width G) = { |[r,s]| : G*(1,width G)`2 < s };

theorem 
  1 <= j & j < width G implies Int h_strip(G,j) = { |[r,s]| : G*(1
  ,j)`2 < s & s < G*(1,j+1)`2 };

theorem 
  Int cell(G,0,0) = { |[r,s]| : r < G*(1,1)`1 & s < G*(1,1)`2 };

theorem 
  Int cell(G,0,width G) = { |[r,s]| : r < G*(1,1)`1 & G*(1,width G )`2 < s };

theorem 
  1 <= j & j < width G implies Int cell(G,0,j) = { |[r,s]| : r < G
  *(1,1)`1 & G*(1,j)`2 < s & s < G*(1,j+1)`2 };

theorem 
  Int cell(G,len G,0) = { |[r,s]| : G*(len G,1)`1 < r & s < G*(1,1 )`2 };

theorem 
  Int cell(G,len G,width G) = { |[r,s]| : G*(len G,1)`1 < r & G*(1
  ,width G)`2 < s };

theorem 
  1 <= j & j < width G implies Int cell(G,len G,j) = { |[r,s]| : G
  *(len G,1)`1 < r & G*(1,j)`2 < s & s < G*(1,j+1)`2 };

theorem 
  1 <= i & i < len G implies Int cell(G,i,0) = { |[r,s]| : G*(i,1)
  `1 < r & r < G*(i+1,1)`1 & s < G*(1,1)`2 };

theorem 
  1 <= i & i < len G implies Int cell(G,i,width G) = { |[r,s]| : G
  *(i,1)`1 < r & r < G*(i+1,1)`1 & G*(1,width G)`2 < s };

theorem 
  1 <= i & i < len G & 1 <= j & j < width G implies Int cell(G,i,j
) = { |[r,s]| : G*(i,1)`1 < r & r < G*(i+1,1)`1 & G*(1,j)`2 < s & s < G*(1,j+1)
  `2 };

theorem 
  1 <= j & j <= width G & p in Int h_strip(G,j) implies p`2 > G*(1,j)`2;

theorem 
  j < width G & p in Int h_strip(G,j) implies p`2 < G*(1,j+1)`2;

theorem 
  1 <= i & i <= len G & p in Int v_strip(G,i) implies p`1 > G*(i,1)`1;

theorem 
  i < len G & p in Int v_strip(G,i) implies p`1 < G*(i+1,1)`1;

theorem 
  1 <= i & i+1 <= len G & 1 <= j & j+1 <= width G implies 1/2*(G*(
  i,j)+G*(i+1,j+1)) in Int cell(G,i,j);

theorem 
  1 <= i & i+1 <= len G implies 1/2*(G*(i,width G)+G*(i+1,width G)
  )+|[0,1]| in Int cell(G,i,width G);

theorem 
  1 <= i & i+1 <= len G implies 1/2*(G*(i,1)+G*(i+1,1))-|[0,1]| in
  Int cell(G,i,0);

theorem 
  1 <= j & j+1 <= width G implies 1/2*(G*(len G,j)+G*(len G,j+1))+
  |[1,0]| in Int cell(G,len G,j);

theorem 
  1 <= j & j+1 <= width G implies 1/2*(G*(1,j)+G*(1,j+1))-|[1,0]|
  in Int cell(G,0,j);

theorem 
  G*(1,1)-|[1,1]| in Int cell(G,0,0);

theorem 
  G*(len G,width G)+|[1,1]| in Int cell(G,len G,width G);

theorem 
  G*(1,width G)+|[-1,1]| in Int cell(G,0,width G);

theorem 
  G*(len G,1)+|[1,-1]| in Int cell(G,len G,0);

theorem 
  1 <= i & i < len G & 1 <= j & j < width G implies LSeg(1/2*(G*(i
,j)+G*(i+1,j+1)),1/2*(G*(i,j)+G*(i,j+1))) c= Int cell(G,i,j) \/ { 1/2*(G*(i,j)+
  G*(i,j+1)) };

theorem 
  1 <= i & i < len G & 1 <= j & j < width G implies LSeg(1/2*(G*(i
,j)+G*(i+1,j+1)),1/2*(G*(i,j+1)+G*(i+1,j+1))) c= Int cell(G,i,j) \/ { 1/2*(G*(i
  ,j+1)+G*(i+1,j+1)) };

theorem 
  1 <= i & i < len G & 1 <= j & j < width G implies LSeg(1/2*(G*(i
,j)+G*(i+1,j+1)),1/2*(G*(i+1,j)+G*(i+1,j+1))) c= Int cell(G,i,j) \/ { 1/2*(G*(i
  +1,j)+G*(i+1,j+1)) };

theorem 
  1 <= i & i < len G & 1 <= j & j < width G implies LSeg(1/2*(G*(i
,j)+G*(i+1,j+1)),1/2*(G*(i,j)+G*(i+1,j))) c= Int cell(G,i,j) \/ { 1/2*(G*(i,j)+
  G*(i+1,j)) };

theorem 
  1 <= j & j < width G implies LSeg(1/2*(G*(1,j)+G*(1,j+1)) - |[1,
0]|,1/2*(G*(1,j)+G*(1,j+1))) c= Int cell(G,0,j) \/ { 1/2*(G*(1,j)+G*(1,j+1)) };

theorem 
  1 <= j & j < width G implies LSeg(1/2*(G*(len G,j)+G*(len G,j+1)
) + |[1,0]|,1/2*(G*(len G,j)+G*(len G,j+1))) c= Int cell(G,len G,j) \/ { 1/2*(G
  *(len G,j)+G*(len G,j+1)) };

theorem 
  1 <= i & i < len G implies LSeg(1/2*(G*(i,1)+G*(i+1,1)) - |[0,1
  ]|,1/2*(G*(i,1)+G*(i+1,1))) c= Int cell(G,i,0) \/ { 1/2*(G*(i,1)+G*(i+1,1)) }
;

theorem 
  1 <= i & i < len G implies LSeg(1/2*(G*(i,width G)+G*(i+1,width
G))+ |[0,1]|, 1/2*(G*(i,width G)+G*(i+1,width G))) c= Int cell(G,i,width G) \/
  { 1/2*(G*(i,width G)+G*(i+1,width G)) };

theorem 
  1 <= j & j < width G implies LSeg(1/2*(G*(1,j)+G*(1,j+1)) - |[1,
  0]|,G*(1,j) - |[1,0]|) c= Int cell(G,0,j) \/ { G*(1,j) - |[1,0]| };

theorem 
  1 <= j & j < width G implies LSeg(1/2*(G*(1,j)+G*(1,j+1)) - |[1,
  0]|,G*(1,j+1) - |[1,0]|) c= Int cell(G,0,j) \/ { G*(1,j+1) - |[1,0]| };

theorem 
  1 <= j & j < width G implies LSeg(1/2*(G*(len G,j)+G*(len G,j+1)
) + |[1,0]|,G*(len G,j) + |[1,0]|) c= Int cell(G,len G,j) \/ { G*(len G,j) + |[
  1,0]| };

theorem 
  1 <= j & j < width G implies LSeg(1/2*(G*(len G,j)+G*(len G,j+1)
) + |[1,0]|,G*(len G,j+1) + |[1,0]|) c= Int cell(G,len G,j) \/ { G*(len G,j+1)
  + |[1,0]| };

theorem 
  1 <= i & i < len G implies LSeg(1/2*(G*(i,1)+G*(i+1,1)) - |[0,1
  ]|,G*(i,1) - |[0,1]|) c= Int cell(G,i,0) \/ { G*(i,1) - |[0,1]| };

theorem 
  1 <= i & i < len G implies LSeg(1/2*(G*(i,1)+G*(i+1,1)) - |[0,1
  ]|,G*(i+1,1) - |[0,1]|) c= Int cell(G,i,0) \/ { G*(i+1,1) - |[0,1]| };

theorem 
  1 <= i & i < len G implies LSeg(1/2*(G*(i,width G)+G*(i+1,width
  G)) + |[0,1]|,G* (i,width G) + |[0,1]|) c= Int cell(G,i,width G) \/ { G*(i,
  width G) + |[0,1]| };

theorem 
  1 <= i & i < len G implies LSeg(1/2*(G*(i,width G)+G*(i+1,width
G)) + |[0,1]|,G* (i+1,width G) + |[0,1]|) c= Int cell(G,i,width G) \/ { G*(i+1,
  width G) + |[0,1]| };

theorem 
  LSeg(G*(1,1) - |[1,1]|,G*(1,1) - |[1,0]|) c= Int cell(G,0,0) \/
  { G*(1,1) - |[1,0]| };

theorem 
  LSeg(G*(len G,1) + |[1,-1]|,G*(len G,1) + |[1,0]|) c= Int cell(G
  ,len G,0) \/ { G*(len G,1) + |[1,0]| };

theorem 
  LSeg(G*(1,width G) + |[-1,1]|,G*(1,width G) - |[1,0]|) c= Int
  cell(G,0,width G) \/ { G*(1,width G) - |[1,0]| };

theorem 
  LSeg(G*(len G,width G) + |[1,1]|,G*(len G,width G) + |[1,0]|) c=
  Int cell(G,len G,width G) \/ { G*(len G,width G) + |[1,0]| };

theorem 
  LSeg(G*(1,1) - |[1,1]|,G*(1,1) - |[0,1]|) c= Int cell(G,0,0) \/
  { G*(1,1) - |[0,1]| };

theorem 
  LSeg(G*(len G,1) + |[1,-1]|,G*(len G,1) - |[0,1]|) c= Int cell(G
  ,len G,0) \/ { G*(len G,1) - |[0,1]| };

theorem 
  LSeg(G*(1,width G) + |[-1,1]|,G*(1,width G) + |[0,1]|) c= Int
  cell(G,0,width G) \/ { G*(1,width G) + |[0,1]| };

theorem 
  LSeg(G*(len G,width G) + |[1,1]|,G*(len G,width G) + |[0,1]|) c=
  Int cell(G,len G,width G) \/ { G*(len G,width G) + |[0,1]| };

theorem 
  1 <= i & i < len G & 1 <= j & j+1 < width G implies LSeg(1/2*(G*(i,j)+
G*(i+1,j+1)),1/2*(G*(i,j+1)+G*(i+1,j+2))) c= Int cell(G,i,j) \/ Int cell(G,i,j+
  1) \/ { 1/2*(G*(i,j+1)+G*(i+1,j+1)) };

theorem 
  1 <= j & j < width G & 1 <= i & i+1 < len G implies LSeg(1/2*(G*(i,j)+
G*(i+1,j+1)),1/2*(G*(i+1,j)+G*(i+2,j+1))) c= Int cell(G,i,j) \/ Int cell(G,i+1,
  j) \/ { 1/2*(G*(i+1,j)+G*(i+1,j+1)) };

theorem 
  1 <= i & i < len G & 1 < width G implies LSeg(1/2*(G*(i,1)+G*(i+1,1))-
|[0,1]|,1/2*(G*(i,1)+G*(i+1,2))) c= Int cell(G,i,0) \/ Int cell(G,i,1) \/ { 1/2
  *(G*(i,1)+G*(i+1,1)) };

theorem 
  1 <= i & i < len G & 1 < width G implies LSeg(1/2*(G*(i,width G)+G*(i+
1,width G))+|[0,1]|, 1/2*(G*(i,width G)+G*(i+1,width G -' 1))) c= Int cell(G,i,
width G -'1) \/ Int cell(G,i,width G) \/ { 1/2*(G*(i,width G)+G*(i+1,width G))
  };

theorem 
  1 <= j & j < width G & 1 < len G implies LSeg(1/2*(G*(1,j)+G*(1,j+1))-
|[1,0]|,1/2*(G*(1,j)+G*(2,j+1))) c= Int cell(G,0,j) \/ Int cell(G,1,j) \/ { 1/2
  *(G*(1,j)+G*(1,j+1)) };

theorem 
  1 <= j & j < width G & 1 < len G implies LSeg(1/2*(G*(len G,j)+G*(len
G,j+1))+|[1,0]|, 1/2*(G*(len G,j)+G*(len G -' 1,j+1))) c= Int cell(G,len G -' 1
  ,j) \/ Int cell(G,len G,j) \/ { 1/2*(G*(len G,j)+G*(len G,j+1)) };

theorem 
  1 < len G & 1 <= j & j+1 < width G implies LSeg(1/2*(G*(1,j)+G*(1,j+1)
)-|[1,0]|,1/2*(G*(1,j+1)+G*(1,j+2))-|[1,0]|) c= Int cell(G,0,j) \/ Int cell(G,0
  ,j+1) \/ { G*(1,j+1)-|[1,0]| };

theorem 
  1 < len G & 1 <= j & j+1 < width G implies LSeg(1/2*(G*(len G,j)+G*(
len G,j+1))+|[1,0]|, 1/2*(G*(len G,j+1)+G*(len G,j+2))+|[1,0]|) c= Int cell(G,
  len G,j) \/ Int cell(G,len G,j+1) \/ { G*(len G,j+1)+|[1,0]| };

theorem 
  1 < width G & 1 <= i & i+1 < len G implies LSeg(1/2*(G*(i,1)+G*(i+1,1)
)-|[0,1]|,1/2*(G*(i+1,1)+G*(i+2,1))-|[0,1]|) c= Int cell(G,i,0) \/ Int cell(G,i
  +1,0) \/ { G*(i+1,1)-|[0,1]| };

theorem 
  1 < width G & 1 <= i & i+1 < len G implies LSeg(1/2*(G*(i,width G)+G*(
  i+1,width G))+|[0,1]|, 1/2*(G*(i+1,width G)+G*(i+2,width G))+|[0,1]|) c= Int
  cell(G,i,width G) \/ Int cell(G,i+1,width G) \/ { G*(i+1,width G)+|[0,1]| };

theorem 
  1 < len G & 1 < width G implies LSeg(G*(1,1)-|[1,1]|,1/2*(G*(1,1)+G*(1
  ,2))-|[1,0]|) c= Int cell(G,0,0) \/ Int cell(G,0,1) \/ { G*(1,1)-|[1,0]| };

theorem 
  1 < len G & 1 < width G implies LSeg(G*(len G,1)+|[1,-1]|,1/2*(G*(len
G,1)+G*(len G,2))+|[1,0]|) c= Int cell(G,len G,0) \/ Int cell(G,len G,1) \/ { G
  *(len G,1)+|[1,0]| };

theorem 
  1 < len G & 1 < width G implies LSeg(G*(1,width G)+|[-1,1]|,1/2*(G*(1,
width G)+G* (1,width G -' 1))-|[1,0]|) c= Int cell(G,0,width G) \/ Int cell(G,0
  ,width G -' 1) \/ { G*(1,width G)-|[1,0]| };

theorem 
  1 < len G & 1 < width G implies LSeg(G*(len G,width G)+|[1,1]|, 1/2*(G
*(len G,width G)+G*(len G,width G -' 1))+|[1,0]|) c= Int cell(G,len G,width G)
  \/ Int cell(G,len G,width G -' 1) \/ { G*(len G,width G)+|[1,0]| };

theorem 
  1 < width G & 1 < len G implies LSeg(G*(1,1)-|[1,1]|,1/2*(G*(1,1)+G*(2
  ,1))-|[0,1]|) c= Int cell(G,0,0) \/ Int cell(G,1,0) \/ { G*(1,1)-|[0,1]| };

theorem 
  1 < width G & 1 < len G implies LSeg(G*(1,width G)+|[-1,1]|,1/2*(G*(1,
width G)+G*(2,width G))+|[0,1]|) c= Int cell(G,0,width G) \/ Int cell(G,1,width
  G) \/ { G*(1,width G)+|[0,1]| };

theorem 
  1 < width G & 1 < len G implies LSeg(G*(len G,1)+|[1,-1]|,1/2*(G*(len
G,1)+G*(len G -' 1,1))-|[0,1]|) c= Int cell(G,len G,0) \/ Int cell(G,len G -' 1
  ,0) \/ { G*(len G,1)-|[0,1]| };

theorem 
  1 < width G & 1 < len G implies LSeg(G*(len G,width G)+|[1,1]|, 1/2*(G
*(len G,width G)+G*(len G -' 1,width G))+|[0,1]|) c= Int cell(G,len G,width G)
  \/ Int cell(G,len G -' 1,width G) \/ { G*(len G,width G)+|[0,1]| };

theorem 
  1 <= i & i+1 <= len G & 1 <= j & j+1 <= width G implies LSeg(1/2*(G*(i
  ,j)+G*(i+1,j+1)),p) meets Int cell(G,i,j);

theorem 
  1 <= i & i+1 <= len G implies LSeg(p,1/2*(G*(i,width G)+G*(i+1,width G
  ))+|[0,1]|) meets Int cell(G,i,width G);

theorem 
  1 <= i & i+1 <= len G implies LSeg(1/2*(G*(i,1)+G*(i+1,1))-|[0,1]|,p)
  meets Int cell(G,i,0);

theorem 
  1 <= j & j+1 <= width G implies LSeg(1/2*(G*(1,j)+G*(1,j+1))-|[1,0]|,p
  ) meets Int cell(G,0,j);

theorem 
  1 <= j & j+1 <= width G implies LSeg(p,1/2*(G*(len G,j)+G*(len G,j+1))
  +|[1,0]|) meets Int cell(G,len G,j);

theorem 
  LSeg(p,G*(1,1)-|[1,1]|) meets Int cell(G,0,0);

theorem 
  LSeg(p,G*(len G,width G)+|[1,1]|) meets Int cell(G,len G,width G);

theorem 
  LSeg(p,G*(1,width G)+|[-1,1]|) meets Int cell(G,0,width G);

theorem 
  LSeg(p,G*(len G,1)+|[1,-1]|) meets Int cell(G,len G,0);

theorem 
  for M being non empty MetrSpace, p being Point of M, q being
Point of TopSpaceMetr M, r being real number st p = q & r > 0 holds Ball (p, r)
  is a_neighborhood of q;

theorem 
  for M being non empty MetrSpace, A being Subset of TopSpaceMetr M, p
  being Point of M holds p in Cl A iff for r being real number st r > 0 holds
  Ball (p, r) meets A;



theorem 
  for A be Subset of TOP-REAL n for p be Point of TOP-REAL n for p9 be
  Point of Euclid n st p = p9 for s be real number st s > 0 holds p in Cl A iff
  for r be real number st 0 < r & r < s holds Ball (p9,r) meets A;














begin

reserve f for non empty FinSequence of TOP-REAL 2,
  i,j,k,k1,k2,n,i1,i2,j1,j2 for Element of NAT,
  r,s,r1,r2 for Real,
  p,q,p1,q1 for Point of TOP-REAL 2,
  G for Go-board;

theorem 
  abs(r1-r2) > s implies r1+s < r2 or r2+s < r1;

theorem 
  abs(r - s) = 0 iff r = s;

theorem 
  for p,p1,q being Point of TOP-REAL n st p + p1 = q + p1 holds p = q;

theorem 
  for p,p1,q being Point of TOP-REAL n st p1 + p = p1 + q holds p = q;

theorem 
  p1 in LSeg(p,q) & p`1 = q`1 implies p1`1 = q`1;

theorem 
  p1 in LSeg(p,q) & p`2 = q`2 implies p1`2 = q`2;

theorem 
  p`1 = q`1 & q`1 = p1`1 & p`2 <= q`2 & q`2 <= p1`2 implies q in LSeg(p,p1);

theorem 
  p`1 <= q`1 & q`1 <= p1`1 & p`2 = q`2 & q`2 = p1`2 implies q in LSeg(p,p1);

theorem 
  1 <= i & i+1 <= len G & 1 <= j & j+1 <= width G implies 1/2*(G*(i,j)+G
  *(i+1,j+1)) = 1/2*(G*(i,j+1)+G*(i+1,j));

theorem 
  LSeg(f,k) is horizontal implies ex j st 1 <= j & j <= width GoB
  f & for p st p in LSeg(f,k) holds p`2 = (GoB f)*(1,j)`2;

theorem 
  LSeg(f,k) is vertical implies ex i st 1 <= i & i <= len GoB f &
  for p st p in LSeg(f,k) holds p`1 = (GoB f)*(i,1)`1;

theorem 
  f is special & i <= len GoB f & j <= width GoB f implies Int cell(GoB
  f,i,j) misses L~f;

begin 

theorem 
  1 <= i & i <= len G & 1 <= j & j+2 <= width G implies LSeg(G*(i,
  j),G*(i,j+1)) /\ LSeg(G*(i,j+1),G*(i,j+2)) = { G*(i,j+1) };

theorem 
  1 <= i & i+2 <= len G & 1 <= j & j <= width G implies LSeg(G*(i,
  j),G*(i+1,j)) /\ LSeg(G*(i+1,j),G*(i+2,j)) = { G*(i+1,j) };

theorem 
  1 <= i & i+1 <= len G & 1 <= j & j+1 <= width G implies LSeg(G*(
  i,j),G*(i,j+1)) /\ LSeg(G*(i,j+1),G*(i+1,j+1)) = { G*(i,j+1) };

theorem 
  1 <= i & i+1 <= len G & 1 <= j & j+1 <= width G implies LSeg(G*(
  i,j+1),G*(i+1,j+1)) /\ LSeg(G*(i+1,j),G*(i+1,j+1)) = { G* (i+1,j+1) };

theorem 
  1 <= i & i+1 <= len G & 1 <= j & j+1 <= width G implies LSeg(G*(
  i,j),G*(i+1,j)) /\ LSeg(G*(i,j),G*(i,j+1)) = { G*(i,j) };

theorem 
  1 <= i & i+1 <= len G & 1 <= j & j+1 <= width G implies LSeg(G*(
  i,j),G*(i+1,j)) /\ LSeg(G*(i+1,j),G*(i+1,j+1)) = { G*(i+1,j) };

theorem 
  for i1,j1,i2,j2 being Element of NAT st 1 <= i1 & i1 <= len G &
1 <= j1 & j1+1 <= width G & 1 <= i2 & i2 <= len G & 1 <= j2 & j2+1 <= width G &
  LSeg(G*(i1,j1),G*(i1,j1+1)) meets LSeg(G*(i2,j2),G*(i2,j2+1)) holds i1 = i2 &
  abs(j1-j2) <= 1;

theorem 
  for i1,j1,i2,j2 being Element of NAT st 1 <= i1 & i1+1 <= len G
& 1 <= j1 & j1 <= width G & 1 <= i2 & i2+1 <= len G & 1 <= j2 & j2 <= width G &
  LSeg(G*(i1,j1),G*(i1+1,j1)) meets LSeg(G*(i2,j2),G*(i2+1,j2)) holds j1 = j2 &
  abs(i1-i2) <= 1;

theorem 
  for i1,j1,i2,j2 being Element of NAT st 1 <= i1 & i1 <= len G &
1 <= j1 & j1+1 <= width G & 1 <= i2 & i2+1 <= len G & 1 <= j2 & j2 <= width G &
LSeg(G*(i1,j1),G*(i1,j1+1)) meets LSeg(G*(i2,j2),G*(i2+1,j2)) holds (i1 = i2 or
  i1 = i2+1) & (j1 = j2 or j1+1 = j2);

theorem 
  for i1,j1,i2,j2 being Element of NAT st 1 <= i1 & i1 <= len G & 1 <=
j1 & j1+1 <= width G & 1 <= i2 & i2 <= len G & 1 <= j2 & j2+1 <= width G & LSeg
(G*(i1,j1),G*(i1,j1+1)) meets LSeg(G*(i2,j2),G*(i2,j2+1)) holds j1 = j2 & LSeg(
G*(i1,j1),G*(i1,j1+1)) = LSeg(G*(i2,j2),G*(i2,j2+1)) or j1 = j2+1 & LSeg(G*(i1,
j1),G*(i1,j1+1)) /\ LSeg(G*(i2,j2),G*(i2,j2+1)) = { G* (i1,j1) } or j1+1 = j2 &
  LSeg(G*(i1,j1),G*(i1,j1+1)) /\ LSeg(G*(i2,j2),G*(i2,j2+1)) = { G* (i2,j2) };

theorem 
  for i1,j1,i2,j2 being Element of NAT st 1 <= i1 & i1+1 <= len G & 1 <=
j1 & j1 <= width G & 1 <= i2 & i2+1 <= len G & 1 <= j2 & j2 <= width G & LSeg(G
*(i1,j1),G*(i1+1,j1)) meets LSeg(G*(i2,j2),G*(i2+1,j2)) holds i1 = i2 & LSeg(G*
(i1,j1),G*(i1+1,j1)) = LSeg(G*(i2,j2),G*(i2+1,j2)) or i1 = i2+1 & LSeg(G*(i1,j1
  ),G*(i1+1,j1)) /\ LSeg(G*(i2,j2),G*(i2+1,j2)) = { G* (i1,j1) } or i1+1 = i2 &
  LSeg(G*(i1,j1),G*(i1+1,j1)) /\ LSeg(G*(i2,j2),G*(i2+1,j2)) = { G* (i2,j2) };

theorem 
  for i1,j1,i2,j2 being Element of NAT st 1 <= i1 & i1 <= len G & 1 <=
j1 & j1+1 <= width G & 1 <= i2 & i2+1 <= len G & 1 <= j2 & j2 <= width G & LSeg
(G*(i1,j1),G*(i1,j1+1)) meets LSeg(G*(i2,j2),G*(i2+1,j2)) holds j1 = j2 & LSeg(
G*(i1,j1),G*(i1,j1+1)) /\ LSeg(G*(i2,j2),G*(i2+1,j2)) = { G* (i1,j1) } or j1+1
= j2 & LSeg(G*(i1,j1),G*(i1,j1+1)) /\ LSeg(G*(i2,j2),G*(i2+1,j2)) = { G* (i1,j1
  +1) };

theorem 
  1 <= i1 & i1 <= len G & 1 <= j1 & j1+1 <= width G & 1 <= i2 & i2
<= len G & 1 <= j2 & j2+1 <= width G & 1/2*(G*(i1,j1)+G*(i1,j1+1)) in LSeg(G*(
  i2,j2),G*(i2,j2+1)) implies i1 = i2 & j1 = j2;

theorem 
  1 <= i1 & i1+1 <= len G & 1 <= j1 & j1 <= width G & 1 <= i2 & i2
+1 <= len G & 1 <= j2 & j2 <= width G & 1/2*(G*(i1,j1)+G*(i1+1,j1)) in LSeg(G*(
  i2,j2),G*(i2+1,j2)) implies i1 = i2 & j1 = j2;

theorem 
  1 <= i1 & i1+1 <= len G & 1 <= j1 & j1 <= width G implies not ex
i2,j2 st 1 <= i2 & i2 <= len G & 1 <= j2 & j2+1 <= width G & 1/2*(G*(i1,j1)+G*(
  i1+1,j1)) in LSeg(G*(i2,j2),G*(i2,j2+1));

theorem 
  1 <= i1 & i1 <= len G & 1 <= j1 & j1+1 <= width G implies not ex
i2,j2 st 1 <= i2 & i2+1 <= len G & 1 <= j2 & j2 <= width G & 1/2*(G*(i1,j1)+G*(
  i1,j1+1)) in LSeg(G*(i2,j2),G*(i2+1,j2));

begin 

reserve f for non constant standard special_circular_sequence;

theorem 
  for f being standard non empty FinSequence of TOP-REAL 2 st i
  in dom f & i+1 in dom f holds f/.i <> f/.(i+1);

theorem 
  ex i st i in dom f & (f/.i)`1 <> (f/.1)`1;

theorem 
  ex i st i in dom f & (f/.i)`2 <> (f/.1)`2;

theorem 
  len GoB f > 1;

theorem 
  width GoB f > 1;

theorem 
  len f > 4;

theorem 
  for f being circular s.c.c. FinSequence of TOP-REAL 2 st len f >
4 for i,j being Element of NAT st 1 <= i & i < j & j < len f holds f/.i <> f/.j
;

theorem 
  for i,j being Element of NAT st 1 <= i & i < j & j < len f holds f/.i <> f/.j
;

theorem 
  for i,j being Element of NAT st 1 < i & i < j & j <= len f holds f/.i <> f/.j
;

theorem 
  for i being Element of NAT st 1 < i & i <= len f & f/.i = f/.1
  holds i = len f;

theorem 
  1 <= i & i <= len GoB f & 1 <= j & j+1 <= width GoB f & 1/2*((
  GoB f)*(i,j)+(GoB f)*(i,j+1)) in L~f implies ex k st 1 <= k & k+1 <= len f &
  LSeg((GoB f)*(i,j),(GoB f)*(i,j+1)) = LSeg(f,k);

theorem 
  1 <= i & i+1 <= len GoB f & 1 <= j & j <= width GoB f & 1/2*((
  GoB f)*(i,j)+(GoB f)*(i+1,j)) in L~f implies ex k st 1 <= k & k+1 <= len f &
  LSeg((GoB f)*(i,j),(GoB f)*(i+1,j)) = LSeg(f,k);

theorem 
  1 <= i & i+1 <= len GoB f & 1 <= j & j+1 <= width GoB f & 1 <= k & k+1
< len f & LSeg((GoB f)*(i,j+1),(GoB f)*(i+1,j+1)) = LSeg(f,k) & LSeg((GoB f)*(i
+1,j),(GoB f)*(i+1,j+1)) = LSeg(f,k+1) implies f/.k = (GoB f)*(i,j+1) & f/.(k+1
  ) = (GoB f)*(i+1,j+1) & f/.(k+2) = (GoB f)*(i+1,j);

theorem 
  1 <= i & i <= len GoB f & 1 <= j & j+1 < width GoB f & 1 <= k & k+1 <
len f & LSeg((GoB f)*(i,j+1),(GoB f)*(i,j+2)) = LSeg(f,k) & LSeg((GoB f)*(i,j),
(GoB f)*(i,j+1)) = LSeg(f,k+1) implies f/.k = (GoB f)*(i,j+2) & f/.(k+1) = (GoB
  f)*(i,j+1) & f/.(k+2) = (GoB f)*(i,j);

theorem 
  1 <= i & i+1 <= len GoB f & 1 <= j & j+1 <= width GoB f & 1 <= k & k+1
< len f & LSeg((GoB f)*(i,j+1),(GoB f)*(i+1,j+1)) = LSeg(f,k) & LSeg((GoB f)*(i
,j),(GoB f)*(i,j+1)) = LSeg(f,k+1) implies f/.k = (GoB f)*(i+1,j+1) & f/.(k+1)
  = (GoB f)*(i,j+1) & f/.(k+2) = (GoB f)*(i,j);

theorem 
  1 <= i & i+1 <= len GoB f & 1 <= j & j+1 <= width GoB f & 1 <= k & k+1
< len f & LSeg((GoB f)*(i+1,j),(GoB f)*(i+1,j+1)) = LSeg(f,k) & LSeg((GoB f)*(i
,j+1),(GoB f)*(i+1,j+1)) = LSeg(f,k+1) implies f/.k = (GoB f)*(i+1,j) & f/.(k+1
  ) = (GoB f)*(i+1,j+1) & f/.(k+2) = (GoB f)*(i,j+1);

theorem 
  1 <= i & i+1 < len GoB f & 1 <= j & j <= width GoB f & 1 <= k & k+1 <
len f & LSeg((GoB f)*(i+1,j),(GoB f)*(i+2,j)) = LSeg(f,k) & LSeg((GoB f)*(i,j),
(GoB f)*(i+1,j)) = LSeg(f,k+1) implies f/.k = (GoB f)*(i+2,j) & f/.(k+1) = (GoB
  f)*(i+1,j) & f/.(k+2) = (GoB f)*(i,j);

theorem 
  1 <= i & i+1 <= len GoB f & 1 <= j & j+1 <= width GoB f & 1 <= k & k+1
< len f & LSeg((GoB f)*(i+1,j),(GoB f)*(i+1,j+1)) = LSeg(f,k) & LSeg((GoB f)*(i
,j),(GoB f)*(i+1,j)) = LSeg(f,k+1) implies f/.k = (GoB f)*(i+1,j+1) & f/.(k+1)
  = (GoB f)*(i+1,j) & f/.(k+2) = (GoB f)*(i,j);

theorem 
  1 <= i & i+1 <= len GoB f & 1 <= j & j+1 <= width GoB f & 1 <= k & k+1
< len f & LSeg((GoB f)*(i+1,j),(GoB f)*(i+1,j+1)) = LSeg(f,k) & LSeg((GoB f)*(i
,j+1),(GoB f)*(i+1,j+1)) = LSeg(f,k+1) implies f/.k = (GoB f)*(i+1,j) & f/.(k+1
  ) = (GoB f)*(i+1,j+1) & f/.(k+2) = (GoB f)*(i,j+1);

theorem 
  1 <= i & i <= len GoB f & 1 <= j & j+1 < width GoB f & 1 <= k & k+1 <
len f & LSeg((GoB f)*(i,j),(GoB f)*(i,j+1)) = LSeg(f,k) & LSeg((GoB f)*(i,j+1),
(GoB f)*(i,j+2)) = LSeg(f,k+1) implies f/.k = (GoB f)*(i,j) & f/.(k+1) = (GoB f
  )*(i,j+1) & f/.(k+2) = (GoB f)*(i,j+2);

theorem 
  1 <= i & i+1 <= len GoB f & 1 <= j & j+1 <= width GoB f & 1 <= k & k+1
< len f & LSeg((GoB f)*(i,j),(GoB f)*(i,j+1)) = LSeg(f,k) & LSeg((GoB f)*(i,j+1
),(GoB f)*(i+1,j+1)) = LSeg(f,k+1) implies f/.k = (GoB f)*(i,j) & f/.(k+1) = (
  GoB f)*(i,j+1) & f/.(k+2) = (GoB f)*(i+1,j+1);

theorem 
  1 <= i & i+1 <= len GoB f & 1 <= j & j+1 <= width GoB f & 1 <= k & k+1
< len f & LSeg((GoB f)*(i,j+1),(GoB f)*(i+1,j+1)) = LSeg(f,k) & LSeg((GoB f)*(i
+1,j),(GoB f)*(i+1,j+1)) = LSeg(f,k+1) implies f/.k = (GoB f)*(i,j+1) & f/.(k+1
  ) = (GoB f)*(i+1,j+1) & f/.(k+2) = (GoB f)*(i+1,j);

theorem 
  1 <= i & i+1 < len GoB f & 1 <= j & j <= width GoB f & 1 <= k & k+1 <
len f & LSeg((GoB f)*(i,j),(GoB f)*(i+1,j)) = LSeg(f,k) & LSeg((GoB f)*(i+1,j),
(GoB f)*(i+2,j)) = LSeg(f,k+1) implies f/.k = (GoB f)*(i,j) & f/.(k+1) = (GoB f
  )*(i+1,j) & f/.(k+2) = (GoB f)*(i+2,j);

theorem 
  1 <= i & i+1 <= len GoB f & 1 <= j & j+1 <= width GoB f & 1 <= k & k+1
< len f & LSeg((GoB f)*(i,j),(GoB f)*(i+1,j)) = LSeg(f,k) & LSeg((GoB f)*(i+1,j
),(GoB f)*(i+1,j+1)) = LSeg(f,k+1) implies f/.k = (GoB f)*(i,j) & f/.(k+1) = (
  GoB f)*(i+1,j) & f/.(k+2) = (GoB f)*(i+1,j+1);

theorem 
  1 <= i & i <= len GoB f & 1 <= j & j+1 < width GoB f & LSeg((GoB
f)*(i,j),(GoB f)*(i,j+1)) c= L~f & LSeg((GoB f)*(i,j+1),(GoB f)*(i,j+2)) c= L~f
implies f/.1 = (GoB f)*(i,j+1) & (f/.2 = (GoB f)*(i,j) & f/.(len f-'1) = (GoB f
)*(i,j+2) or f/.2 = (GoB f)*(i,j+2) & f/.(len f-'1) = (GoB f)*(i,j)) or ex k st
1 <= k & k+1 < len f & f/.(k+1) = (GoB f)*(i,j+1) & (f/.k = (GoB f)*(i,j) & f/.
  (k+2) = (GoB f)*(i,j+2) or f/.k = (GoB f)*(i,j+2) & f/.(k+2) = (GoB f)*(i,j))
;

theorem 
  1 <= i & i+1 <= len GoB f & 1 <= j & j+1 <= width GoB f & LSeg((
GoB f)*(i,j),(GoB f)*(i,j+1)) c= L~f & LSeg((GoB f)*(i,j+1),(GoB f)*(i+1,j+1))
c= L~f implies f/.1 = (GoB f)*(i,j+1) & (f/.2 = (GoB f)*(i,j) & f/.(len f-'1) =
(GoB f)*(i+1,j+1) or f/.2 = (GoB f)*(i+1,j+1) & f/.(len f-'1) = (GoB f)*(i,j))
or ex k st 1 <= k & k+1 < len f & f/.(k+1) = (GoB f)*(i,j+1) & (f/.k = (GoB f)*
(i,j) & f/.(k+2) = (GoB f)*(i+1,j+1) or f/.k = (GoB f)*(i+1,j+1) & f/.(k+2) = (
  GoB f)*(i,j));

theorem 
  1 <= i & i+1 <= len GoB f & 1 <= j & j+1 <= width GoB f & LSeg((
GoB f)*(i,j+1),(GoB f)*(i+1,j+1)) c= L~f & LSeg((GoB f)*(i+1,j+1),(GoB f)*(i+1,
j)) c= L~f implies f/.1 = (GoB f)*(i+1,j+1) & (f/.2 = (GoB f)*(i,j+1) & f/.(len
f-'1) = (GoB f)*(i+1,j) or f/.2 = (GoB f)*(i+1,j) & f/.(len f-'1) = (GoB f)*(i,
j+1)) or ex k st 1 <= k & k+1 < len f & f/.(k+1) = (GoB f)*(i+1,j+1) & (f/.k =
(GoB f)*(i,j+1) & f/.(k+2) = (GoB f)*(i+1,j) or f/.k = (GoB f)*(i+1,j) & f/.(k+
  2) = (GoB f)*(i,j+1));

theorem 
  1 <= i & i+1 < len GoB f & 1 <= j & j <= width GoB f & LSeg((GoB
f)*(i,j),(GoB f)*(i+1,j)) c= L~f & LSeg((GoB f)*(i+1,j),(GoB f)*(i+2,j)) c= L~f
implies f/.1 = (GoB f)*(i+1,j) & (f/.2 = (GoB f)*(i,j) & f/.(len f-'1) = (GoB f
)*(i+2,j) or f/.2 = (GoB f)*(i+2,j) & f/.(len f-'1) = (GoB f)*(i,j)) or ex k st
1 <= k & k+1 < len f & f/.(k+1) = (GoB f)*(i+1,j) & (f/.k = (GoB f)*(i,j) & f/.
  (k+2) = (GoB f)*(i+2,j) or f/.k = (GoB f)*(i+2,j) & f/.(k+2) = (GoB f)*(i,j))
;

theorem 
  1 <= i & i+1 <= len GoB f & 1 <= j & j+1 <= width GoB f & LSeg((
GoB f)*(i,j),(GoB f)*(i+1,j)) c= L~f & LSeg((GoB f)*(i+1,j),(GoB f)*(i+1,j+1))
c= L~f implies f/.1 = (GoB f)*(i+1,j) & (f/.2 = (GoB f)*(i,j) & f/.(len f-'1) =
(GoB f)*(i+1,j+1) or f/.2 = (GoB f)*(i+1,j+1) & f/.(len f-'1) = (GoB f)*(i,j))
or ex k st 1 <= k & k+1 < len f & f/.(k+1) = (GoB f)*(i+1,j) & (f/.k = (GoB f)*
(i,j) & f/.(k+2) = (GoB f)*(i+1,j+1) or f/.k = (GoB f)*(i+1,j+1) & f/.(k+2) = (
  GoB f)*(i,j));

theorem 
  1 <= i & i+1 <= len GoB f & 1 <= j & j+1 <= width GoB f & LSeg((
GoB f)*(i+1,j),(GoB f)*(i+1,j+1)) c= L~f & LSeg((GoB f)*(i+1,j+1),(GoB f)*(i,j+
1)) c= L~f implies f/.1 = (GoB f)*(i+1,j+1) & (f/.2 = (GoB f)*(i+1,j) & f/.(len
f-'1) = (GoB f)*(i,j+1) or f/.2 = (GoB f)*(i,j+1) & f/.(len f-'1) = (GoB f)*(i+
1,j)) or ex k st 1 <= k & k+1 < len f & f/.(k+1) = (GoB f)*(i+1,j+1) & (f/.k =
(GoB f)*(i+1,j) & f/.(k+2) = (GoB f)*(i,j+1) or f/.k = (GoB f)*(i,j+1) & f/.(k+
  2) = (GoB f)*(i+1,j));

theorem 
  1 <= i & i < len GoB f & 1 <= j & j+1 < width GoB f implies not ( LSeg
((GoB f)*(i,j),(GoB f)*(i,j+1)) c= L~f & LSeg((GoB f)*(i,j+1),(GoB f)*(i,j+2))
  c= L~f & LSeg((GoB f)*(i,j+1),(GoB f)*(i+1,j+1)) c= L~f);

theorem 
  1 <= i & i < len GoB f & 1 <= j & j+1 < width GoB f implies not ( LSeg
((GoB f)*(i+1,j),(GoB f)*(i+1,j+1)) c= L~f & LSeg((GoB f)*(i+1,j+1),(GoB f)*(i+
  1,j+2)) c= L~f & LSeg((GoB f)*(i,j+1),(GoB f)*(i+1,j+1)) c= L~f);

theorem 
  1 <= j & j < width GoB f & 1 <= i & i+1 < len GoB f implies not ( LSeg
((GoB f)*(i,j),(GoB f)*(i+1,j)) c= L~f & LSeg((GoB f)*(i+1,j),(GoB f)*(i+2,j))
  c= L~f & LSeg((GoB f)*(i+1,j),(GoB f)*(i+1,j+1)) c= L~f);

theorem 
  1 <= j & j < width GoB f & 1 <= i & i+1 < len GoB f implies not ( LSeg
((GoB f)*(i,j+1),(GoB f)*(i+1,j+1)) c= L~f & LSeg((GoB f)*(i+1,j+1),(GoB f)*(i+
  2,j+1)) c= L~f & LSeg((GoB f)*(i+1,j),(GoB f)*(i+1,j+1)) c= L~f);



theorem 
  for p,q,p1,q1 be Point of TOP-REAL 2 st LSeg(p,q) is vertical & LSeg(
  p1,q1) is vertical & p`1 = p1`1 & p`2 <= p1`2 & p1`2 <= q1`2 & q1`2 <= q`2
  holds LSeg(p1,q1) c= LSeg(p,q);

theorem 
  for p,q,p1,q1 be Point of TOP-REAL 2 st LSeg(p,q) is horizontal & LSeg
  (p1,q1) is horizontal & p`2 = p1`2 & p`1 <= p1`1 & p1`1 <= q1`1 & q1`1 <= q`1
  holds LSeg(p1,q1) c= LSeg(p,q);














begin 

reserve r, s, t, g for real number,

          r3, r1, r2, q3, p3 for Real;

begin 

definition
  let T be 1-sorted;
  mode RealMap of T is Function of the carrier of T, REAL;
end;

registration
  let T be non empty 1-sorted;
  cluster bounded for RealMap of T;
end;

definition
  let T be 1-sorted, f be RealMap of T;

  func lower_bound f -> Real equals

  lower_bound (f.:the carrier of T);
  func upper_bound f -> Real equals

  upper_bound (f.:the carrier of T);
end;

theorem 
  for T being non empty TopSpace, f being bounded_below RealMap of
  T for p being Point of T holds f.p >= lower_bound f;

theorem 
  for T being non empty TopSpace, f being bounded_below RealMap of T for
  s being Real st for t being Point of T holds f.t >= s
  holds lower_bound f >= s;

theorem 
  for T being non empty TopSpace, f being RealMap of T st (for p being
  Point of T holds f.p >= r) & for t st for p being Point of T holds f.p >= t
  holds r >= t holds r = lower_bound f;

theorem 
  for T being non empty TopSpace, f being bounded_above RealMap of
  T for p being Point of T holds f.p <= upper_bound f;

theorem 
  for T being non empty TopSpace, f being bounded_above RealMap of T for
  t st for p being Point of T holds f.p <= t holds upper_bound f <= t;

theorem 
  for T being non empty TopSpace, f being RealMap of T st (for p being
  Point of T holds f.p <= r) & (for t st for p being Point of T holds f.p <= t
  holds r <= t) holds r = upper_bound f;

theorem 
  for T being non empty 1-sorted, f being bounded RealMap of T
  holds lower_bound f <= upper_bound f;

definition
  let T be TopStruct, f be RealMap of T;

  attr f is continuous means


  for Y being Subset of REAL st Y is closed holds f"Y is closed;
end;

registration
  let T be non empty TopSpace;
  cluster continuous for RealMap of T;
end;

registration
  let T be non empty TopSpace, S be non empty SubSpace of T;
  cluster continuous for RealMap of S;
end;

reserve T for TopStruct,
  f for RealMap of T;

theorem 
  f is continuous iff for Y being Subset of REAL st Y is open holds f"Y is open
;

theorem 
  f is continuous implies -f is continuous;

theorem 
  f is continuous implies r3+f is continuous;

theorem 
  f is continuous & not 0 in rng f implies Inv f is continuous;

theorem 
  for R being Subset-Family of REAL st f is continuous & R is open holds
  ("f).:R is open;

theorem 
  for R being Subset-Family of REAL st f is continuous & R is
  closed holds ("f).:R is closed;

definition
  let T be non empty TopStruct, f be RealMap of T, X be Subset of T;
  redefine func f|X -> RealMap of T|X;
end;

registration
  let T be non empty TopSpace, f be continuous RealMap of T, X be Subset of T;
  cluster f|X -> continuous for RealMap of T|X;
end;

registration
  let T be non empty TopSpace, P be compact non empty Subset of T;
  cluster T|P -> compact;
end;

begin 

theorem 
  for T being non empty TopSpace holds (for f being RealMap of T
  st f is continuous holds f is with_max) iff for f being RealMap of T st f is
  continuous holds f is with_min;

theorem 
  for T being non empty TopSpace holds (for f being RealMap of T
  st f is continuous holds f is bounded) iff for f being RealMap of T st f is
  continuous holds f is with_max;

definition

  let T be TopStruct;
  attr T is pseudocompact means


  for f being RealMap of T st f is continuous holds f is bounded;
end;

registration
  cluster compact -> pseudocompact for non empty TopSpace;
end;

registration
  cluster non empty compact for TopSpace;
end;

registration
  let T be pseudocompact non empty TopSpace;
  cluster continuous -> bounded with_max with_min for RealMap of T;
end;

theorem 
  for T being non empty TopSpace, X being non empty Subset of T, Y
being compact Subset of T, f being continuous RealMap of T st X c= Y
holds lower_bound
  (f|Y) <= lower_bound (f|X);

theorem 
  for T being non empty TopSpace, X being non empty Subset of T, Y
being compact Subset of T, f being continuous RealMap of T st X c= Y
holds upper_bound
  (f|X) <= upper_bound (f|Y);

begin 

registration
  let n be Element of NAT, X, Y be compact Subset of TOP-REAL n;
  cluster X /\ Y -> compact for Subset of TOP-REAL n;
end;

reserve p for Point of TOP-REAL 2,
  P for Subset of TOP-REAL 2,
  Z for non empty Subset of TOP-REAL 2,
  X for non empty compact Subset of TOP-REAL 2;

definition
  func proj1 -> RealMap of TOP-REAL 2 means


  for p being Point of TOP-REAL 2 holds it.p = p`1;
  func proj2 -> RealMap of TOP-REAL 2 means


  for p being Point of TOP-REAL 2 holds it.p = p`2;
end;

theorem 
  proj1"].r,s.[ = {|[ r1, r2 ]| : r < r1 & r1 < s};

theorem 
  for r3, q3 st P = {|[ r1, r2 ]| : r3 < r1 & r1 < q3} holds P is open;

theorem 
  proj2"].r,s.[ = {|[ r1, r2 ]| : r < r2 & r2 < s};

theorem 
  for r3, q3 st P = {|[ r1, r2 ]| : r3 < r2 & r2 < q3} holds P is open;

registration
  cluster proj1 -> continuous;
  cluster proj2 -> continuous;
end;

theorem 
  for X being Subset of TOP-REAL 2, p being Point of TOP-REAL 2 st
  p in X holds (proj1|X).p = p`1;

theorem 
  for X being Subset of TOP-REAL 2, p being Point of TOP-REAL 2 st
  p in X holds (proj2|X).p = p`2;

definition
  let X be Subset of TOP-REAL 2;
  func W-bound X -> Real equals

  lower_bound (proj1|X);
  func N-bound X -> Real equals

  upper_bound (proj2|X);
  func E-bound X -> Real equals

  upper_bound (proj1|X);
  func S-bound X -> Real equals

  lower_bound (proj2|X);
end;

theorem 
  p in X implies W-bound X <= p`1 & p`1 <= E-bound X & S-bound X <= p`2
  & p`2 <= N-bound X;

definition
  let X be Subset of TOP-REAL 2;
  func SW-corner X -> Point of TOP-REAL 2 equals

  |[W-bound X, S-bound X]|;
  func NW-corner X -> Point of TOP-REAL 2 equals

  |[W-bound X, N-bound X]|;
  func NE-corner X -> Point of TOP-REAL 2 equals

  |[E-bound X, N-bound X]|;
  func SE-corner X -> Point of TOP-REAL 2 equals

  |[E-bound X, S-bound X]|;
end;

theorem 
  (SW-corner P)`1 = (NW-corner P)`1;

theorem 
  (SE-corner P)`1 = (NE-corner P)`1;

theorem 
  (NW-corner P)`2 = (NE-corner P)`2;

theorem 
  (SW-corner P)`2 = (SE-corner P)`2;

definition
  let X be Subset of TOP-REAL 2;
  func W-most X -> Subset of TOP-REAL 2 equals

  LSeg(SW-corner X, NW-corner X)
  /\X;
  func N-most X -> Subset of TOP-REAL 2 equals

  LSeg(NW-corner X, NE-corner X)
  /\X;
  func E-most X -> Subset of TOP-REAL 2 equals

  LSeg(SE-corner X, NE-corner X)
  /\X;
  func S-most X -> Subset of TOP-REAL 2 equals

  LSeg(SW-corner X, SE-corner X)
  /\X;
end;

registration
  let X be non empty compact Subset of TOP-REAL 2;
  cluster W-most X -> non empty compact;
  cluster N-most X -> non empty compact;
  cluster E-most X -> non empty compact;
  cluster S-most X -> non empty compact;
end;

definition
  let X be Subset of TOP-REAL 2;
  func W-min X -> Point of TOP-REAL 2 equals

  |[W-bound X, lower_bound (proj2|W-most X)]|;
  func W-max X -> Point of TOP-REAL 2 equals

  |[W-bound X, upper_bound (proj2|W-most X)]|;
  func N-min X -> Point of TOP-REAL 2 equals

  |[lower_bound (proj1|N-most X), N-bound X]|;
  func N-max X -> Point of TOP-REAL 2 equals

  |[upper_bound (proj1|N-most X), N-bound X]|;
  func E-max X -> Point of TOP-REAL 2 equals

  |[E-bound X, upper_bound (proj2|E-most X)]|;
  func E-min X -> Point of TOP-REAL 2 equals

  |[E-bound X, lower_bound (proj2|E-most X)]|;
  func S-max X -> Point of TOP-REAL 2 equals

  |[upper_bound (proj1|S-most X), S-bound X]|;
  func S-min X -> Point of TOP-REAL 2 equals

  |[lower_bound (proj1|S-most X), S-bound X]|;
end;

theorem 
  (SW-corner P)`1 = (W-min P)`1 & (SW-corner P)`1 = (W-max P)`1 &
  (W-min P)`1 = (W-max P)`1 & (W-min P)`1 = (NW-corner P)`1 & (W-max P)`1 = (
  NW-corner P)`1;

theorem 
  (SW-corner X)`2 <= (W-min X)`2 & (SW-corner X)`2 <= (W-max X)`2
& (SW-corner X)`2 <= (NW-corner X)`2 & (W-min X)`2 <= (W-max X)`2 & (W-min X)`2
  <= (NW-corner X)`2 & (W-max X)`2 <= (NW-corner X)`2;

theorem 
  p in W-most Z implies p`1 = (W-min Z)`1 & (Z is compact implies
  (W-min Z)`2 <= p`2 & p`2 <= (W-max Z)`2);

theorem 
  W-most X c= LSeg(W-min X, W-max X);

theorem 
  LSeg(W-min X, W-max X) c= LSeg(SW-corner X, NW-corner X);

theorem 
  W-min X in W-most X & W-max X in W-most X;

theorem 
  LSeg(SW-corner X, W-min X)/\X = {W-min X} & LSeg(W-max X, NW-corner X)
  /\X = {W-max X};

theorem 
  W-min X = W-max X implies W-most X = {W-min X};

theorem 
  (NW-corner P)`2 = (N-min P)`2 & (NW-corner P)`2 = (N-max P)`2 &
  (N-min P)`2 = (N-max P)`2 & (N-min P)`2 = (NE-corner P)`2 & (N-max P)`2 = (
  NE-corner P)`2;

theorem 
  (NW-corner X)`1 <= (N-min X)`1 & (NW-corner X)`1 <= (N-max X)`1
& (NW-corner X)`1 <= (NE-corner X)`1 & (N-min X)`1 <= (N-max X)`1 & (N-min X)`1
  <= (NE-corner X)`1 & (N-max X)`1 <= (NE-corner X)`1;

theorem 
  p in N-most Z implies p`2 = (N-min Z)`2 & (Z is compact implies
  (N-min Z)`1 <= p`1 & p`1 <= (N-max Z)`1);

theorem 
  N-most X c= LSeg(N-min X, N-max X);

theorem 
  LSeg(N-min X, N-max X) c= LSeg(NW-corner X, NE-corner X);

theorem 
  N-min X in N-most X & N-max X in N-most X;

theorem 
  LSeg(NW-corner X, N-min X)/\X = {N-min X} & LSeg(N-max X, NE-corner X)
  /\X = {N-max X};

theorem 
  N-min X = N-max X implies N-most X = {N-min X};

theorem 
  (SE-corner P)`1 = (E-min P)`1 & (SE-corner P)`1 = (E-max P)`1 &
  (E-min P)`1 = (E-max P)`1 & (E-min P)`1 = (NE-corner P)`1 & (E-max P)`1 = (
  NE-corner P)`1;

theorem 
  (SE-corner X)`2 <= (E-min X)`2 & (SE-corner X)`2 <= (E-max X)`2
& (SE-corner X)`2 <= (NE-corner X)`2 & (E-min X)`2 <= (E-max X)`2 & (E-min X)`2
  <= (NE-corner X)`2 & (E-max X)`2 <= (NE-corner X)`2;

theorem 
  p in E-most Z implies p`1 = (E-min Z)`1 & (Z is compact implies
  (E-min Z)`2 <= p`2 & p`2 <= (E-max Z)`2);

theorem 
  E-most X c= LSeg(E-min X, E-max X);

theorem 
  LSeg(E-min X, E-max X) c= LSeg(SE-corner X, NE-corner X);

theorem 
  E-min X in E-most X & E-max X in E-most X;

theorem 
  LSeg(SE-corner X, E-min X)/\X = {E-min X} & LSeg(E-max X, NE-corner X)
  /\X = {E-max X};

theorem 
  E-min X = E-max X implies E-most X = {E-min X};

theorem 
  (SW-corner P)`2 = (S-min P)`2 & (SW-corner P)`2 = (S-max P)`2 &
  (S-min P)`2 = (S-max P)`2 & (S-min P)`2 = (SE-corner P)`2 & (S-max P)`2 = (
  SE-corner P)`2;

theorem 
  (SW-corner X)`1 <= (S-min X)`1 & (SW-corner X)`1 <= (S-max X)`1
& (SW-corner X)`1 <= (SE-corner X)`1 & (S-min X)`1 <= (S-max X)`1 & (S-min X)`1
  <= (SE-corner X)`1 & (S-max X)`1 <= (SE-corner X)`1;

theorem 
  p in S-most Z implies p`2 = (S-min Z)`2 & (Z is compact implies
  (S-min Z)`1 <= p`1 & p`1 <= (S-max Z)`1);

theorem 
  S-most X c= LSeg(S-min X, S-max X);

theorem 
  LSeg(S-min X, S-max X) c= LSeg(SW-corner X, SE-corner X);

theorem 
  S-min X in S-most X & S-max X in S-most X;

theorem 
  LSeg(SW-corner X, S-min X)/\X = {S-min X} & LSeg(S-max X, SE-corner X)
  /\X = {S-max X};

theorem 
  S-min X = S-max X implies S-most X = {S-min X};



theorem 
  W-max P = N-min P implies W-max P = NW-corner P;

theorem 
  N-max P = E-max P implies N-max P = NE-corner P;

theorem 
  E-min P = S-max P implies E-min P = SE-corner P;

theorem 
  S-min P = W-min P implies S-min P = SW-corner P;

theorem 
  proj2. |[r,s]| = s & proj1. |[r,s]| = r;



theorem 
  for X be non empty Subset of TOP-REAL 2 for Y be compact Subset of
  TOP-REAL 2 st X c= Y holds N-bound X <= N-bound Y;

theorem 
  for X be non empty Subset of TOP-REAL 2 for Y be compact Subset of
  TOP-REAL 2 st X c= Y holds E-bound X <= E-bound Y;

theorem 
  for X be non empty Subset of TOP-REAL 2 for Y be compact Subset of
  TOP-REAL 2 st X c= Y holds S-bound X >= S-bound Y;

theorem 
  for X be non empty Subset of TOP-REAL 2 for Y be compact Subset of
  TOP-REAL 2 st X c= Y holds W-bound X >= W-bound Y;














begin 

theorem 
  the carrier of l2_Space = the_set_of_l2RealSequences & (for x be
set holds x is VECTOR of l2_Space iff x is Real_Sequence & seq_id(x)(#)seq_id(x
) is summable) & 0.l2_Space = Zeroseq & (for u be VECTOR of l2_Space holds u =
seq_id(u)) & (for u,v be VECTOR of l2_Space holds u+v =seq_id(u)+seq_id(v)) & (
for r be Real for u be VECTOR of l2_Space holds r*u =r(#)seq_id(u)) & (for u be
VECTOR of l2_Space holds -u =-seq_id(u) & seq_id(-u)=-seq_id(u)) & (for u,v be
  VECTOR of l2_Space holds u-v =seq_id(u)-seq_id(v)) & for v,w be VECTOR of
  l2_Space holds seq_id(v)(#)seq_id(w) is summable & for v,w be VECTOR of
  l2_Space holds v.|.w = Sum(seq_id(v)(#)seq_id(w));

theorem 
  for x, y, z being Point of l2_Space for a be Real holds ( x .|. x
  = 0 iff x = 0.l2_Space ) & 0 <= x .|. x & x .|. y = y .|. x & (x+y) .|. z = x
  .|. z + y .|. z & (a*x) .|. y = a * ( x .|. y );

registration
  cluster l2_Space -> RealUnitarySpace-like;
end;

registration
  cluster l2_Space -> complete;
end;

registration
 cluster complete for RealUnitarySpace;
end;

definition
  mode RealHilbertSpace is complete RealUnitarySpace;
end;

begin  

theorem 
  for r be Real_Sequence st (for n be Element of NAT holds 0 <= r.n)
  holds ( for n be Element of NAT holds 0 <= (Partial_Sums r).n ) & ( for n be
  Element of NAT holds r.n <= (Partial_Sums r).n ) & ( r is summable implies (
  for n be Element of NAT holds (Partial_Sums r).n <= Sum r) & for n be Element
  of NAT holds r.n <= Sum r );

theorem 
  (for x,y be Real holds (x+y)*(x+y) <= 2*x*x + 2*y*y) & for x,y be Real
  holds x*x <= 2*(x-y)*(x-y) + 2*y*y;

theorem 
  for e being Real, s being Real_Sequence st (s is convergent & ex k
  being Element of NAT st for i being Element of NAT st k <= i holds s.i <= e )
  holds lim s <=e;

theorem 
  for c being Real, s being Real_Sequence st s is convergent for r be
Real_Sequence st (for i be Element of NAT holds r.i = (s.i-c)*(s.i-c)) holds r
  is convergent & lim r = (lim s-c)*(lim s-c);

theorem 
  for c being Real, s,s1 being Real_Sequence st s is convergent & s1 is
convergent for r be Real_Sequence st (for i be Element of NAT holds r.i = (s.i-
c)*(s.i-c)+s1.i) holds r is convergent & lim r = (lim s-c)*(lim s-c)+lim s1;














begin 

definition
  func the_set_of_l1RealSequences -> Subset of Linear_Space_of_RealSequences
  means


  for x being set holds x in it iff x in the_set_of_RealSequences &
  seq_id(x) is absolutely_summable;
end;

theorem 
  for c be Real, seq be Real_Sequence st seq is convergent for rseq
  be Real_Sequence st ( for i be Element of NAT holds rseq .i = abs(seq.i-c) )
  holds rseq is convergent & lim rseq = abs(lim seq-c);

registration
  cluster the_set_of_l1RealSequences -> non empty;
end;

registration
  cluster the_set_of_l1RealSequences -> linearly-closed;
end;

registration
  cluster RLSStruct (# the_set_of_l1RealSequences, Zero_(
      the_set_of_l1RealSequences,Linear_Space_of_RealSequences), Add_(
      the_set_of_l1RealSequences,Linear_Space_of_RealSequences), Mult_(
      the_set_of_l1RealSequences,Linear_Space_of_RealSequences) #) -> Abelian
    add-associative right_zeroed right_complementable vector-distributive
    scalar-distributive scalar-associative scalar-unital;
end;

definition
  func l_norm -> Function of the_set_of_l1RealSequences, REAL means


  for
  x be set st x in the_set_of_l1RealSequences holds it.x = Sum abs seq_id x;
end;

registration
  let X be non empty set, Z be Element of X, A be BinOp of X, M be Function of
  [:REAL, X:], X, N be Function of X, REAL;
  cluster NORMSTR (# X, Z, A, M, N #) -> non empty;
end;

theorem 
  for l be NORMSTR st the RLSStruct of l is RealLinearSpace holds l is
  RealLinearSpace;

theorem 
  for rseq be Real_Sequence st (for n be Element of NAT holds rseq.
  n=0) holds rseq is absolutely_summable & Sum abs rseq = 0;

theorem 
  for rseq be Real_Sequence st rseq is absolutely_summable & Sum
  abs rseq=0 holds for n be Element of NAT holds rseq.n =0;

theorem 
  NORMSTR (# the_set_of_l1RealSequences, Zero_(
    the_set_of_l1RealSequences,Linear_Space_of_RealSequences), Add_(
    the_set_of_l1RealSequences,Linear_Space_of_RealSequences), Mult_(
    the_set_of_l1RealSequences,Linear_Space_of_RealSequences), l_norm #) is
  RealLinearSpace;

definition
  func l1_Space -> non empty NORMSTR equals

  NORMSTR (#
    the_set_of_l1RealSequences, Zero_(the_set_of_l1RealSequences,
    Linear_Space_of_RealSequences), Add_(the_set_of_l1RealSequences,
    Linear_Space_of_RealSequences), Mult_(the_set_of_l1RealSequences,
    Linear_Space_of_RealSequences), l_norm #);
end;

begin 

theorem 
  the carrier of l1_Space = the_set_of_l1RealSequences & ( for x be
  set holds x is VECTOR of l1_Space iff x is Real_Sequence & seq_id x is
  absolutely_summable ) & 0.l1_Space = Zeroseq & ( for u be VECTOR of l1_Space
  holds u =seq_id u ) & ( for u,v be VECTOR of l1_Space holds u+v =seq_id(u)+
seq_id(v) ) & ( for r be Real for u be VECTOR of l1_Space holds r*u =r(#)seq_id
  (u) ) & ( for u be VECTOR of l1_Space holds -u = -seq_id u & seq_id(-u) = -
seq_id(u) ) & ( for u,v be VECTOR of l1_Space holds u-v =seq_id(u)-seq_id v ) &
  ( for v be VECTOR of l1_Space holds seq_id v is absolutely_summable ) & for v
  be VECTOR of l1_Space holds ||.v.|| = Sum abs seq_id v;

theorem 
  for x, y being Point of l1_Space, a be Real holds ( ||.x.|| = 0
iff x = 0.l1_Space ) & 0 <= ||.x.|| & ||.x+y.|| <= ||.x.|| + ||.y.|| & ||. a*x
  .|| = abs(a) * ||.x.||;

registration
  cluster l1_Space -> reflexive discerning RealNormSpace-like
  vector-distributive scalar-distributive scalar-associative scalar-unital
  Abelian add-associative right_zeroed right_complementable;
end;

definition
  let X be non empty NORMSTR, x, y be Point of X;
  func dist(x,y) -> Real equals

  ||.x - y.||;
end;

definition
  let NRM be non empty NORMSTR;
  let seqt be sequence of NRM;
  attr seqt is CCauchy means


  for r1 be Real st r1 > 0 ex k1 be Element
of NAT st for n1, m1 be Element of NAT st n1 >= k1 & m1 >= k1 holds dist(seqt.
  n1, seqt.m1) < r1;
end;

notation
  let NRM be non empty NORMSTR;
  let seqt be sequence of NRM;
  synonym seqt is Cauchy_sequence_by_Norm for seqt is CCauchy;
end;

reserve NRM for non empty RealNormSpace;
reserve seq for sequence of NRM;

theorem 
  seq is Cauchy_sequence_by_Norm iff for r be Real st r > 0 ex k
  be Element of NAT st for n, m be Element of NAT st n >= k & m >= k holds ||.(
  seq.n) - (seq.m).|| < r;

theorem 
  for vseq be sequence of l1_Space st vseq is Cauchy_sequence_by_Norm
  holds vseq is convergent;














begin 

definition
  let X be set;
  let Y be non empty set;
  let F be Function of [:REAL, Y:], Y;
  let a be real number, f be Function of X, Y;
  redefine func F[;](a,f) -> Element of Funcs(X, Y);
end;

definition
  let X be non empty set;
  let Y be non empty addLoopStr;
  func FuncAdd(X,Y) -> BinOp of Funcs(X,the carrier of Y) means


  for f,g being Element of Funcs(X,the carrier of Y)
   holds it.(f,g) = (the addF of Y).:(f,g);
end;

definition
  let X be non empty set;
  let Y be RealLinearSpace;
  func FuncExtMult(X,Y) -> Function of [:REAL,Funcs(X,the carrier of Y):],
  Funcs(X,the carrier of Y) means


  for a being Real, f being Element of
  Funcs(X,the carrier of Y), x being Element of X holds (it.[a,f]).x = a*(f.x);
end;

definition
  let X be set;
  let Y be non empty ZeroStr;
  func FuncZero(X,Y) -> Element of Funcs (X,the carrier of Y) equals

  X --> 0.Y;
end;

reserve X for non empty set;
reserve Y for RealLinearSpace;
reserve f,g,h for Element of Funcs(X,the carrier of Y);

theorem 
  for Y being non empty addLoopStr, f,g,h being Element of Funcs(X,
  the carrier of Y) holds h = FuncAdd(X,Y).(f,g) iff for x being Element of X
  holds h.x = f.x + g.x;

reserve a,b for Real;

theorem 
  h = (FuncExtMult(X,Y)).[a,f] iff for x being Element of X holds h
  .x = a*(f.x);

reserve u,v,w for VECTOR of RLSStruct(#Funcs(X,the carrier of Y), (FuncZero(X,
    Y)),FuncAdd(X,Y),FuncExtMult(X,Y)#);

theorem 
  (FuncAdd(X,Y)).(f,g) = (FuncAdd(X,Y)).(g,f);

theorem 
  (FuncAdd(X,Y)).(f,(FuncAdd(X,Y)).(g,h)) = (FuncAdd(X,Y)).((
  FuncAdd(X,Y)).(f,g),h);

theorem 
  (FuncAdd(X,Y)).(FuncZero(X,Y),f) = f;

theorem 
  (FuncAdd(X,Y)).(f,(FuncExtMult(X,Y)).[-1,f]) = FuncZero(X,Y);

theorem 
  (FuncExtMult(X,Y)).[1,f] = f;

theorem 
  (FuncExtMult(X,Y)).[a,(FuncExtMult(X,Y)).[b,f]] = (FuncExtMult(X ,Y)).[a*b,f]
;

theorem 
  (FuncAdd(X,Y)). ((FuncExtMult(X,Y)).[a,f],(FuncExtMult(X,Y)).[b,
  f]) = (FuncExtMult(X,Y)).[a+b,f];

theorem 
  RLSStruct(#Funcs(X,the carrier of Y), (FuncZero(X,Y)),FuncAdd(X,
    Y),FuncExtMult(X,Y)#) is RealLinearSpace;

definition
  let X be non empty set;
  let Y be RealLinearSpace;
  func RealVectSpace(X,Y) -> RealLinearSpace equals

  RLSStruct(#Funcs(X,the
    carrier of Y), (FuncZero(X,Y)),FuncAdd(X,Y),FuncExtMult(X,Y)#);
end;

registration
  let X be non empty set;
  let Y be RealLinearSpace;
  cluster RealVectSpace(X,Y) -> strict;
end;

registration
  let X be non empty set;
  let Y be RealLinearSpace;
  cluster RealVectSpace(X,Y) -> constituted-Functions;
end;

definition
  let X be non empty set;
  let Y be RealLinearSpace;
  let f be VECTOR of RealVectSpace(X,Y);
  let x be Element of X;
  redefine func f.x -> VECTOR of Y;
end;

theorem 
  for X be non empty set for Y be RealLinearSpace for f,g,h be VECTOR of
RealVectSpace(X,Y) holds h = f+g iff for x be Element of X holds h.x = f.x + g.
  x;

theorem 
  for X be non empty set for Y be RealLinearSpace for f,h be VECTOR of
RealVectSpace(X,Y) for a be Real holds h = a*f iff for x be Element of X holds
  h.x = a * f.x;

theorem 
  for X be non empty set for Y be RealLinearSpace holds 0.RealVectSpace(
  X,Y) = X --> 0.Y;

begin 

definition
  let X, Y be non empty RLSStruct;
  let IT be Function of X,Y;
  attr IT is homogeneous means


  for x being VECTOR of X, r being Real holds IT.(r*x) = r*IT.x;
end;

registration
  let X be non empty RLSStruct;
  let Y be RealLinearSpace;
  cluster additive homogeneous for Function of X,Y;
end;

definition
  let X, Y be RealLinearSpace;
  mode LinearOperator of X,Y is additive homogeneous Function of X,Y;
end;

definition
  let X, Y be RealLinearSpace;
  func LinearOperators(X,Y) -> Subset of RealVectSpace(the carrier of X, Y)
  means


  for x being set holds x in it iff x is LinearOperator of X,Y;
end;

registration
  let X, Y be RealLinearSpace;
  cluster LinearOperators(X,Y) -> non empty functional;
end;

theorem 
  for X, Y be RealLinearSpace holds LinearOperators(X,Y) is linearly-closed;

theorem 
  for X, Y be RealLinearSpace holds RLSStruct (# LinearOperators(X,Y),
    Zero_(LinearOperators(X,Y),RealVectSpace(the carrier of X,Y)), Add_(
LinearOperators(X,Y), RealVectSpace(the carrier of X,Y)), Mult_(LinearOperators
(X,Y), RealVectSpace(the carrier of X,Y)) #) is Subspace of RealVectSpace(the
  carrier of X,Y);

registration
  let X, Y be RealLinearSpace;
  cluster RLSStruct (# LinearOperators(X,Y), Zero_(LinearOperators(X,Y),
RealVectSpace(the carrier of X,Y)), Add_(LinearOperators(X,Y), RealVectSpace(
the carrier of X,Y)), Mult_(LinearOperators(X,Y), RealVectSpace(the carrier of
      X,Y)) #) -> Abelian add-associative right_zeroed right_complementable
    vector-distributive scalar-distributive scalar-associative scalar-unital;
end;

definition
  let X, Y be RealLinearSpace;
  func R_VectorSpace_of_LinearOperators(X,Y) -> RealLinearSpace equals

RLSStruct (# LinearOperators(X,Y), Zero_(LinearOperators(X,Y),RealVectSpace(the
carrier of X,Y)), Add_(LinearOperators(X,Y), RealVectSpace(the carrier of X,Y))
    , Mult_(LinearOperators(X,Y), RealVectSpace(the carrier of X,Y)) #);
end;

registration
  let X, Y be RealLinearSpace;
  cluster R_VectorSpace_of_LinearOperators(X,Y) -> strict;
end;

registration
  let X,Y be RealLinearSpace;
  cluster R_VectorSpace_of_LinearOperators(X,Y) -> constituted-Functions;
end;

definition
  let X,Y be RealLinearSpace;
  let f be Element of R_VectorSpace_of_LinearOperators(X,Y);
  let v be VECTOR of X;
  redefine func f.v -> VECTOR of Y;
end;

theorem 
  for X, Y be RealLinearSpace for f,g,h be VECTOR of
  R_VectorSpace_of_LinearOperators(X,Y) holds h = f+g iff for x be VECTOR of X
  holds h.x = f.x + g.x;

theorem 
  for X, Y be RealLinearSpace for f,h be VECTOR of
R_VectorSpace_of_LinearOperators(X,Y) for a be Real holds h = a*f iff for x be
  VECTOR of X holds h.x = a * f.x;

theorem 
  for X, Y be RealLinearSpace holds 0.
  R_VectorSpace_of_LinearOperators(X,Y) = (the carrier of X) -->0.Y;

theorem 
  for X,Y be RealLinearSpace holds (the carrier of X) --> 0.Y is
  LinearOperator of X,Y;

begin 

theorem 
  for X be RealNormSpace for seq be sequence of X for g be Point
  of X holds seq is convergent & lim seq = g implies ||.seq.|| is convergent &
  lim ||.seq.|| = ||.g.||;

definition
  let X, Y be RealNormSpace;
  let IT be LinearOperator of X,Y;
  attr IT is Lipschitzian means


  ex K being Real st 0 <= K &
  for x being VECTOR of X holds ||. IT.x .|| <= K * ||. x .||;
end;

theorem 
  for X, Y be RealNormSpace holds for f be LinearOperator of X,Y
  st (for x be VECTOR of X holds f.x=0.Y) holds f is Lipschitzian;

registration
  let X, Y be RealNormSpace;
  cluster Lipschitzian for LinearOperator of X,Y;
end;

definition
  let X, Y be RealNormSpace;
  func BoundedLinearOperators(X,Y) -> Subset of
  R_VectorSpace_of_LinearOperators(X,Y) means


  for x being set holds x in it iff x is Lipschitzian LinearOperator of X,Y;
end;

registration
  let X, Y be RealNormSpace;
  cluster BoundedLinearOperators(X,Y) -> non empty;
end;

theorem 
  for X, Y be RealNormSpace holds BoundedLinearOperators(X,Y) is
  linearly-closed;

theorem 
  for X, Y be RealNormSpace holds RLSStruct (# BoundedLinearOperators(X,
Y), Zero_(BoundedLinearOperators(X,Y), R_VectorSpace_of_LinearOperators(X,Y)),
Add_(BoundedLinearOperators(X,Y), R_VectorSpace_of_LinearOperators(X,Y)), Mult_
    (BoundedLinearOperators(X,Y), R_VectorSpace_of_LinearOperators(X,Y)) #) is
  Subspace of R_VectorSpace_of_LinearOperators(X,Y);

registration
  let X, Y be RealNormSpace;
  cluster RLSStruct (# BoundedLinearOperators(X,Y), Zero_(
BoundedLinearOperators(X,Y), R_VectorSpace_of_LinearOperators(X,Y)), Add_(
BoundedLinearOperators(X,Y), R_VectorSpace_of_LinearOperators(X,Y)), Mult_(
      BoundedLinearOperators(X,Y), R_VectorSpace_of_LinearOperators(X,Y)) #) ->
Abelian add-associative right_zeroed right_complementable vector-distributive
scalar-distributive scalar-associative scalar-unital;
end;

definition
  let X, Y be RealNormSpace;
  func R_VectorSpace_of_BoundedLinearOperators(X,Y) -> RealLinearSpace equals

  RLSStruct (# BoundedLinearOperators(X,Y), Zero_(BoundedLinearOperators(X,Y),
    R_VectorSpace_of_LinearOperators(X,Y)), Add_(BoundedLinearOperators(X,Y),
    R_VectorSpace_of_LinearOperators(X,Y)), Mult_(BoundedLinearOperators(X,Y),
    R_VectorSpace_of_LinearOperators(X,Y)) #);
end;

registration
  let X, Y be RealNormSpace;
  cluster R_VectorSpace_of_BoundedLinearOperators(X,Y) -> strict;
end;

registration
  let X,Y be RealNormSpace;
  cluster -> Function-like Relation-like for Element of
    R_VectorSpace_of_BoundedLinearOperators(X,Y);
end;

definition
  let X,Y be RealNormSpace;
  let f be Element of R_VectorSpace_of_BoundedLinearOperators(X,Y);
  let v be VECTOR of X;
  redefine func f.v -> VECTOR of Y;
end;

theorem 
  for X, Y be RealNormSpace for f,g,h be VECTOR of
R_VectorSpace_of_BoundedLinearOperators(X,Y) holds h = f+g iff for x be VECTOR
  of X holds h.x = f.x + g.x;

theorem 
  for X, Y be RealNormSpace for f,h be VECTOR of
  R_VectorSpace_of_BoundedLinearOperators(X,Y) for a be Real holds h = a*f iff
  for x be VECTOR of X holds h.x = a * f.x;

theorem 
  for X, Y be RealNormSpace holds 0.
  R_VectorSpace_of_BoundedLinearOperators(X,Y) = (the carrier of X) --> 0.Y;

definition
  let X, Y be RealNormSpace;
  let f be set such that
 f in BoundedLinearOperators(X,Y);
  func modetrans(f,X,Y) -> Lipschitzian LinearOperator of X,Y equals


  f;
end;

definition
  let X, Y be RealNormSpace;
  let u be LinearOperator of X,Y;
  func PreNorms(u) -> non empty Subset of REAL equals

  {||.u.t.|| where t is
  VECTOR of X : ||.t.|| <= 1 };
end;

theorem 
  for X, Y be RealNormSpace for g be Lipschitzian LinearOperator of X,Y
  holds PreNorms(g) is bounded_above;

theorem 
  for X, Y be RealNormSpace for g be LinearOperator of X,Y holds g is
  Lipschitzian iff PreNorms(g) is bounded_above;

definition
  let X, Y be RealNormSpace;
  func BoundedLinearOperatorsNorm(X,Y) -> Function of BoundedLinearOperators(X
  ,Y), REAL means


  for x be set st x in BoundedLinearOperators(X,Y) holds
  it.x = upper_bound PreNorms(modetrans(x,X,Y));
end;

theorem 
  for X, Y be RealNormSpace for f be Lipschitzian LinearOperator of X,Y
  holds modetrans(f,X,Y)=f;

theorem 
  for X, Y be RealNormSpace for f be Lipschitzian LinearOperator of X,Y
  holds BoundedLinearOperatorsNorm(X,Y).f = upper_bound PreNorms(f);

definition
  let X, Y be RealNormSpace;
  func R_NormSpace_of_BoundedLinearOperators(X,Y) -> non empty NORMSTR equals

  NORMSTR (# BoundedLinearOperators(X,Y), Zero_(BoundedLinearOperators(X,Y),
    R_VectorSpace_of_LinearOperators(X,Y)), Add_(BoundedLinearOperators(X,Y),
    R_VectorSpace_of_LinearOperators(X,Y)), Mult_(BoundedLinearOperators(X,Y),
    R_VectorSpace_of_LinearOperators(X,Y)), BoundedLinearOperatorsNorm(X,Y) #);
end;

theorem 
  for X, Y be RealNormSpace holds (the carrier of X) --> 0.Y = 0.
  R_NormSpace_of_BoundedLinearOperators(X,Y);

theorem 
  for X, Y be RealNormSpace for f being Point of
R_NormSpace_of_BoundedLinearOperators(X,Y)
for g be Lipschitzian LinearOperator of X
  ,Y st g=f holds for t be VECTOR of X holds ||.g.t.|| <= ||.f.|| * ||.t.||;

theorem 
  for X, Y be RealNormSpace for f being Point of
  R_NormSpace_of_BoundedLinearOperators(X,Y) holds 0 <= ||.f.||;

theorem 
  for X, Y be RealNormSpace for f being Point of
  R_NormSpace_of_BoundedLinearOperators(X,Y) st f = 0.
  R_NormSpace_of_BoundedLinearOperators(X,Y) holds 0 = ||.f.||;

registration
  let X,Y be RealNormSpace;
  cluster -> Function-like Relation-like for Element of
    R_NormSpace_of_BoundedLinearOperators(X,Y);
end;

definition
  let X,Y be RealNormSpace;
  let f be Element of R_NormSpace_of_BoundedLinearOperators(X,Y);
  let v be VECTOR of X;
  redefine func f.v -> VECTOR of Y;
end;

theorem 
  for X, Y be RealNormSpace for f,g,h be Point of
R_NormSpace_of_BoundedLinearOperators(X,Y) holds h = f+g iff for x be VECTOR of
  X holds h.x = f.x + g.x;

theorem 
  for X, Y be RealNormSpace for f,h be Point of
R_NormSpace_of_BoundedLinearOperators(X,Y) for a be Real holds h = a*f iff for
  x be VECTOR of X holds h.x = a * f.x;

theorem 
  for X be RealNormSpace for Y be RealNormSpace for f, g being
Point of R_NormSpace_of_BoundedLinearOperators(X,Y) for a be Real holds ( ||.f
  .|| = 0 iff f = 0.R_NormSpace_of_BoundedLinearOperators(X,Y) ) & ||.a*f.|| =
  abs(a) * ||.f.|| & ||.f+g.|| <= ||.f.|| + ||.g.||;

theorem 
  for X,Y be RealNormSpace holds R_NormSpace_of_BoundedLinearOperators(X,Y) is
   reflexive discerning RealNormSpace-like;

theorem 
  for X, Y be RealNormSpace holds
  R_NormSpace_of_BoundedLinearOperators(X,Y) is RealNormSpace;

registration
  let X, Y be RealNormSpace;
  cluster R_NormSpace_of_BoundedLinearOperators(X,Y) ->
   reflexive discerning RealNormSpace-like
vector-distributive scalar-distributive scalar-associative scalar-unital
Abelian add-associative right_zeroed right_complementable;
end;

theorem 
  for X, Y be RealNormSpace for f,g,h be Point of
R_NormSpace_of_BoundedLinearOperators(X,Y) holds h = f-g iff for x be VECTOR of
  X holds h.x = f.x - g.x;

begin 

definition
  let X be RealNormSpace;
  attr X is complete means


  for seq be sequence of X holds seq is
  Cauchy_sequence_by_Norm implies seq is convergent;
end;

registration
  cluster complete for RealNormSpace;
end;

definition
  mode RealBanachSpace is complete RealNormSpace;
end;

theorem 
  for X be RealNormSpace for seq be sequence of X st seq is
  convergent holds ||.seq.|| is convergent & lim ||.seq.|| = ||.lim seq.||;

theorem 
  for X, Y be RealNormSpace st Y is complete for seq be sequence
of R_NormSpace_of_BoundedLinearOperators(X,Y) st seq is Cauchy_sequence_by_Norm
  holds seq is convergent;

theorem 
  for X be RealNormSpace for Y be RealBanachSpace holds
  R_NormSpace_of_BoundedLinearOperators(X,Y) is RealBanachSpace;

registration
  let X be RealNormSpace;
  let Y be RealBanachSpace;
  cluster R_NormSpace_of_BoundedLinearOperators (X,Y) -> complete;
end;














begin

reserve D,D9 for non empty set;
reserve R for Ring;
reserve G,H,S for non empty VectSpStr over R;
reserve UN for Universe;

definition
  let R;

  func TrivialLMod(R) -> strict LeftMod of R equals

  VectSpStr (#1,op2,op0,pr2(the carrier of R,1)#);
end;

theorem 
  for x being Vector of TrivialLMod R holds x = 0.TrivialLMod R;

definition
  let R be non empty multMagma;
  let G,H be non empty VectSpStr over R;
  let f be Function of G,H;
  attr f is homogeneous means


  for a being Scalar of R, x being Vector of G holds f.(a*x) = a*f.x;
end;

theorem 
  for f being Function of G,H, g being Function of H,S st f is
  homogeneous & g is homogeneous holds g*f is homogeneous;

reserve R for Ring;
reserve G, H for LeftMod of R;

registration let R,G,H;
 cluster ZeroMap(G,H) -> homogeneous;
end;





reserve G1, G2, G3 for LeftMod of R;

definition
  let R;
  struct LModMorphismStr over R (# Dom,Cod -> LeftMod of R, Fun -> Function of
    the Dom, the Cod #);
end;

reserve f for LModMorphismStr over R;

definition
  let R,f;

  func dom(f) -> LeftMod of R equals

  the Dom of f;
  func cod(f) -> LeftMod of R equals

  the Cod of f;
end;

definition
  let R,f;
  func fun(f) -> Function of dom(f),cod(f) equals

  the Fun of f;
end;

theorem 
  for f0 being Function of G1,G2 st f = LModMorphismStr(#G1,G2,f0#)
  holds dom f = G1 & cod f = G2 & fun f = f0;

definition
  let R,G,H;
  func ZERO(G,H) -> strict LModMorphismStr over R equals

  LModMorphismStr(# G,H,ZeroMap(G,H)#);
end;

definition
  let R;
  let IT be LModMorphismStr over R;
  attr IT is LModMorphism-like means


  fun(IT) is additive homogeneous;
end;

registration
  let R;
  cluster strict LModMorphism-like for LModMorphismStr over R;
end;

definition
  let R;
  mode LModMorphism of R is LModMorphism-like LModMorphismStr over R;
end;

theorem 
  for F being LModMorphism of R holds the Fun of F is additive homogeneous;

registration
  let R,G,H;
  cluster ZERO(G,H) -> LModMorphism-like;
end;

definition
  let R,G,H;
  mode Morphism of G,H -> LModMorphism of R means


    dom(it) = G & cod(it) = H;
end;

registration
  let R,G,H;
  cluster strict for Morphism of G,H;
end;

theorem 
  for f being LModMorphismStr over R holds dom(f) = G & cod(f) = H
  & fun(f) is additive homogeneous implies f is Morphism of G,H;

theorem 
  for f being Function of G,H st f is additive homogeneous
   holds LModMorphismStr
  (#G,H,f#) is strict Morphism of G,H;

registration let R,G;
 cluster id G -> homogeneous;
end;

definition
  let R,G;
  func ID G -> strict Morphism of G,G equals

  LModMorphismStr(# G,G,id G#);
end;

definition
  let R,G,H;
  redefine func ZERO(G,H) -> strict Morphism of G,H;
end;

theorem 
  for F being Morphism of G,H ex f being Function of G,H st the
  LModMorphismStr of F = LModMorphismStr(#G,H,f#) & f is additive homogeneous;

theorem 
  for F being strict Morphism of G,H ex f being Function of G,H st
  F = LModMorphismStr(#G,H,f#);

theorem 
  for F being LModMorphism of R ex G,H st F is Morphism of G,H;

theorem 
  for F being strict LModMorphism of R ex G,H being LeftMod of R, f
being Function of G,H st F is strict Morphism of G,H & F = LModMorphismStr(#G,H
    ,f#) & f is additive homogeneous;

theorem 
  for g,f being LModMorphism of R st dom(g) = cod(f) ex G1,G2,G3
  st g is Morphism of G2,G3 & f is Morphism of G1,G2;

definition
  let R;
  let G,F be LModMorphism of R;
  assume
 dom(G) = cod(F);
  func G*F -> strict LModMorphism of R means


  for G1,G2,G3 being
  LeftMod of R, g being Function of G2,G3, f being Function of G1,G2 st the
LModMorphismStr of G = LModMorphismStr(#G2,G3,g#) & the LModMorphismStr of F =
  LModMorphismStr(#G1,G2,f#) holds it = LModMorphismStr(#G1,G3,g*f#);
end;

theorem 
  for G being Morphism of G2,G3, F being Morphism of G1,G2 holds G
  *F is strict Morphism of G1,G3;

definition
  let R,G1,G2,G3;
  let G be Morphism of G2,G3;
  let F be Morphism of G1,G2;
  func G*'F -> strict Morphism of G1,G3 equals

  G*F;
end;

theorem 
  for G being Morphism of G2,G3, F being Morphism of G1,G2, g
being Function of G2,G3, f being Function of G1,G2 st G = LModMorphismStr(#G2,
G3,g#) & F = LModMorphismStr(#G1,G2,f#) holds G*'F = LModMorphismStr(#G1,G3,g*f
  #) & G*F = LModMorphismStr(# G1,G3,g*f#);

theorem 
  for f,g being strict LModMorphism of R st dom g = cod f holds ex
  G1,G2,G3 being LeftMod of R, f0 being Function of G1,G2, g0 being Function of
G2,G3 st f = LModMorphismStr(#G1,G2,f0#) & g = LModMorphismStr(#G2,G3,g0#) & g*
  f = LModMorphismStr(#G1,G3,g0*f0#);

theorem 
  for f,g being strict LModMorphism of R st dom g = cod f holds dom(g*f)
  = dom f & cod (g*f) = cod g;

theorem 
  for G1,G2,G3,G4 being LeftMod of R, f being strict Morphism of
G1,G2, g being strict Morphism of G2,G3, h being strict Morphism of G3,G4 holds
  h*(g*f) = (h*g)*f;

theorem 
  for f,g,h being strict LModMorphism of R st dom h = cod g & dom g =
  cod f holds h*(g*f) = (h*g)*f;

theorem 
  dom ID(G) = G & cod ID(G) = G & (for f being strict LModMorphism of R
st cod f = G holds (ID G)*f = f) & for g being strict LModMorphism of R st dom
  g = G holds g*(ID G) = g;

theorem 
  for u,v,w being Element of UN holds {u,v,w} is Element of UN;

theorem 
  for u being Element of UN holds succ u is Element of UN;

theorem 
  0 is Element of UN & 1 is Element of UN & 2 is Element of UN;

reserve a,b,c for Element of {0,1,2};

definition
  let a;
  func -a -> Element of {0,1,2} equals


  0 if a = 0, 2 if a = 1, 1 if a
  = 2;
  let b;
  func a+b -> Element of {0,1,2} equals


  b if a = 0, a if b = 0, 2 if a
  = 1 & b = 1, 0 if a = 1 & b = 2, 0 if a = 2 & b = 1, 1 if a = 2 & b = 2;
  func a*b -> Element of {0,1,2} equals


  0 if b = 0, 0 if a = 0, a if b
  = 1, b if a = 1, 1 if a = 2 & b = 2;
end;

definition
  func add3 -> BinOp of {0,1,2} means


  it.(a,b) = a+b;
  func mult3 -> BinOp of {0,1,2} means


  it.(a,b) = a*b;
  func compl3 -> UnOp of {0,1,2} means


  it.a = -a;
  func unit3 -> Element of {0,1,2} equals

  1;
  func zero3 -> Element of {0,1,2} equals

  0;
end;

definition
  func Z_3 -> strict doubleLoopStr equals


  doubleLoopStr (#{0,1,2},add3,mult3,unit3,zero3#);
end;

registration
  cluster Z_3 -> non empty;
end;

registration
  cluster Z_3 -> well-unital;
end;

theorem 
  0.Z_3 = 0 & 1.Z_3 = 1 & 0.Z_3 is Element of {0,1,2} & 1.Z_3 is
  Element of {0,1,2} & the addF of Z_3 = add3 & the multF of Z_3 = mult3;

registration
  cluster Z_3 -> add-associative right_zeroed right_complementable;
end;

theorem 
  for x,y being Scalar of Z_3, X,Y being Element of {0,1,2} st X=x
  & Y=y holds x+y = X+Y & x*y = X*Y & -x = -X;

theorem 
  for x,y,z being Scalar of Z_3, X,Y,Z being Element of {0,1,2} st
X=x & Y=y & Z=z holds (x+y)+z = (X+Y)+Z & x+(y+z) = X+(Y+Z) & (x*y)*z = (X*Y)*Z
  & x*(y*z) = X*(Y*Z);

theorem 
  for x,y,z,a,b being Element of {0,1,2} st a = 0 & b = 1 holds x+
y = y+x & (x+y)+z = x+(y+z) & x+a = x & x+(-x) = a & x*y = y*x & (x*y)*z = x*(y
*z) & b*x = x & (x<>a implies ex y be Element of {0,1,2} st x*y = b) & a <> b &
  x*(y+z) = x*y+x*z;

theorem 
  for F being non empty doubleLoopStr st for x,y,z being Scalar of
F holds x+y = y+x & (x+y)+z = x+(y+z) & x+(0.F) = x & x+(-x) = (0.F) & x*y = y*
  x & (x*y)*z = x*(y*z) & 1.F*x = x & x*(1.F) = x & (x<>(0.F) implies ex y be
  Scalar of F st x*y = 1.F) & 0.F <> 1.F & x*(y+z) = x*y+x*z holds F is Field;

theorem 
  Z_3 is Fanoian Field;

registration
  cluster Z_3 -> Fanoian add-associative right_zeroed right_complementable
Abelian commutative associative well-unital distributive almost_left_invertible
  ;
end;

theorem 
  for f being Function of D,D9 st D in UN & D9 in UN holds f in UN;

theorem 
  the carrier of Z_3 in UN & the addF of Z_3 in UN & comp Z_3 in UN &
0.Z_3
  in UN & the multF of Z_3 in UN & 1.Z_3 in UN;














begin 

reserve k,t,i,j,m,n for Nat,
  x,y,y1,y2 for set,
  D for non empty set;

definition
  let D be non empty set;
  let k;
  let M be Matrix of D;
  redefine func Del(M,k) -> Matrix of D;
end;

theorem 
  for M be FinSequence st len M = n+1 holds len Del(M,n+1) = n;

theorem 
  for M be Matrix of n+1,m,D for M1 be Matrix of D holds
  ( n > 0 implies width M = width Del(M,n+1) ) &
  ( M1 = <*M.(n+1)*> implies width M = width M1 );

theorem 
  for M be Matrix of n+1,m,D holds Del(M,n+1) is Matrix of n,m,D;

theorem 
  for M being FinSequence st M <> {} holds M = Del(M,len M) ^ <*M.(len M)*>;

definition
  let D;
  let P be FinSequence of D;
  redefine func <*P*> -> Matrix of 1,len P,D;
end;

begin 

begin 

reserve K for Field,
  V for VectSp of K,
  a for Element of K,
  W for Element of V;
reserve KL1,KL2,KL3 for Linear_Combination of V,
  X for Subset of V;

theorem 
  X is linearly-independent & Carrier KL1 c= X & Carrier KL2 c= X &
  Sum KL1 = Sum KL2 implies KL1 = KL2;

theorem 
  X is linearly-independent & Carrier KL1 c= X & Carrier KL2 c= X
  & Carrier KL3 c= X & Sum KL1 = Sum KL2 + Sum KL3 implies KL1 = KL2 + KL3;

theorem 
  X is linearly-independent & Carrier KL1 c= X & Carrier KL2 c= X
  & a <> 0.K & Sum KL1 = a * Sum KL2 implies KL1 = a * KL2;

theorem 
  for b2 be Basis of V ex KL be Linear_Combination of V st W = Sum
  KL & Carrier KL c= b2;

definition

  let K be Field;
  let V be VectSp of K;
  attr V is finite-dimensional means


  ex A being finite Subset of V st A is Basis of V;
end;

registration
  let K be Field;
  cluster strict finite-dimensional for VectSp of K;
end;

definition
  let K be Field;
  let V be finite-dimensional VectSp of K;
  mode OrdBasis of V -> FinSequence of V means


    it is one-to-one & rng it is Basis of V;
end;

reserve s for FinSequence,
  V1,V2,V3 for finite-dimensional VectSp of K,
  f,f1,f2 for Function of V1,V2,
  g for Function of V2,V3,
  b1 for OrdBasis of V1,
  b2 for OrdBasis of V2,
  b3 for OrdBasis of V3,
  v1,v2 for Vector of V2,
  v,w for Element of V1;
reserve p2,F for FinSequence of V1,
  p1,d for FinSequence of K,
  KL for Linear_Combination of V1;

definition
  let K be non empty doubleLoopStr;
  let V1,V2 be non empty VectSpStr over K;
  let f1,f2 be Function of V1, V2;
  func f1+f2 -> Function of V1,V2 means


  for v be Element of V1 holds it .v = f1.v + f2.v;
end;

definition
  let K be non empty doubleLoopStr;
  let V1,V2 be non empty VectSpStr over K;
  let f be Function of V1,V2;
  let a be Element of K;
  func a*f -> Function of V1,V2 means


  for v be Element of V1 holds it.v = a * (f.v);
end;

theorem 
  for a being Element of V1 for F being FinSequence of V1 for G
  being FinSequence of K st len F = len G & for k for v being Element of K st k
  in dom F & v = G.k holds F.k = v * a holds Sum(F) = Sum(G) * a;

theorem 
  for a be Element of V1 for F being FinSequence of K for G being
FinSequence of V1 st len F = len G & for k st k in dom F holds G.k = (F/.k) * a
  holds Sum(G) = Sum(F) * a;

theorem 
  for V1 being add-associative right_zeroed right_complementable
  non empty addLoopStr
  for F being FinSequence of V1 st for k st k in dom F holds
  F/.k = 0.V1 holds Sum(F) = 0.V1;

definition
  let K, V1, p1,p2;
  func lmlt(p1,p2) -> FinSequence of V1 equals

  (the lmult of V1).:(p1,p2);
end;

theorem 
  dom p1 = dom p2 implies dom lmlt(p1,p2) = dom p1;

definition
  let V1 be non empty addLoopStr, M be FinSequence of (the carrier of V1)*;
  func Sum M -> FinSequence of V1 means


  len it = len M & for k st k in dom it
   holds it/.k = Sum (M/.k);
end;

theorem 
  for M be Matrix of the carrier of V1 st len M = 0 holds Sum Sum M = 0.V1;

theorem 
  for M be Matrix of m+1,0,the carrier of V1 holds Sum Sum M = 0.V1;

theorem 
  for x be Element of D holds <*<*x*>*> = <*<*x*>*>@;

theorem 
  for V1,V2 being VectSp of K, f being Function of V1,V2, p being
  FinSequence of V1 st f is additive homogeneous holds f.Sum p = Sum(f*p);

theorem 
  for a be FinSequence of K, p being FinSequence of V1 st len p =
  len a holds f is additive homogeneous implies f*lmlt(a,p) = lmlt(a,f*p);

theorem 
  for a be FinSequence of K st len a = len b2 & g is additive homogeneous holds
  g.Sum(lmlt(a,b2)) = Sum(lmlt(a,g*b2));

theorem 
  for F, F1 being FinSequence of V1, KL being Linear_Combination
of V1, p being Permutation of dom F st F1 = F * p holds KL (#) F1 = (KL (#) F)
  * p;

theorem 
  F is one-to-one & Carrier KL c= rng F implies Sum(KL (#) F) = Sum KL;

theorem 
  for A be set for p be FinSequence of V1 st rng p c= A holds f1
is additive homogeneous & f2 is additive homogeneous &
 (for v st v in A holds f1.v = f2.v) implies f1.Sum p
  = f2.Sum p;

theorem 
  f1 is additive homogeneous & f2 is additive homogeneous implies
   for b1 being OrdBasis of V1
  st len b1 > 0 holds f1*b1 = f2*b1 implies f1 = f2;

registration
  let D be non empty set;
  cluster -> FinSequence-yielding for Matrix of D;
end;

definition
  let D be non empty set;
  let F,G be Matrix of D;
  redefine func F^^G -> Matrix of D;
end;

definition
  let D be non empty set;
  let n,m,k;
  let M1 be Matrix of n,k,D, M2 be Matrix of m,k,D;
  redefine func M1^M2 -> Matrix of n+m,k,D;
end;

theorem 
  for M1 be Matrix of n,k,D, M2 be Matrix of m,k,D st i in dom M1 holds
  Line(M1^M2,i) = Line(M1,i);

theorem 
  for M1 be Matrix of n,k,D, M2 be Matrix of m,k,D st
  width M1 = width M2 holds width (M1^M2) = width M1;

theorem 
  for M1 be Matrix of t,k,D, M2 be Matrix of m,k,D st n in dom M2 & i =
  len M1 + n holds Line(M1^M2,i) = Line(M2,n);

theorem 
  for M1 be Matrix of n,k,D, M2 be Matrix of m,k,D st width M1 =
  width M2 for i st i in Seg width M1 holds Col(M1^M2,i) = Col(M1,i)^Col(M2,i);

theorem 
  for M1 be Matrix of n,k,the carrier of V, M2 be Matrix of m,k,
  the carrier of V holds Sum(M1^M2) = (Sum M1)^(Sum M2);

theorem 
  for M1 be Matrix of n,k,D, M2 be Matrix of m,k,D st width M1 =
  width M2 holds (M1^M2)@ = M1@ ^^ M2@;

theorem 
  for M1,M2 be Matrix of the carrier of V1 holds Sum M1 + Sum M2 =
  Sum(M1 ^^ M2);

theorem 
  for P1,P2 be FinSequence of V1 st len P1 = len P2 holds
  Sum(P1 + P2) = (Sum P1) + (Sum P2);

theorem 
  for M1,M2 be Matrix of the carrier of V1 st len M1 = len M2
  holds Sum Sum M1 + Sum Sum M2 = Sum Sum(M1 ^^ M2);

theorem 
  for M be Matrix of the carrier of V1 holds Sum Sum M = Sum Sum (M@);

theorem 
  for M being Matrix of n,m,the carrier of K st n > 0 & m > 0
  for p,d being FinSequence of K st len p = n & len d = m &
  for j st j in dom d holds d/.j = Sum mlt(p,Col(M,j))
  for b,c being FinSequence of V1 st len b = m & len c = n &
  for i st i in dom c holds c/.i = Sum lmlt(Line(M,i),b) holds
  Sum lmlt(p,c) = Sum lmlt(d,b);

begin 

definition
  let K be Field;
  let V be finite-dimensional VectSp of K;
  let b1 be OrdBasis of V;
  let W be Element of V;
  func W|--b1 -> FinSequence of K means


  len it = len b1 & ex KL be
Linear_Combination of V st W = Sum(KL) & Carrier KL c= rng b1 & for k st 1<=k &
  k<=len it holds it/.k=KL.(b1/.k);
end;

theorem 
  v1|--b2 = v2|--b2 implies v1 = v2;

theorem 
  v = Sum lmlt(v|--b1,b1);

theorem 
  len d = len b1 implies d = Sum(lmlt(d,b1)) |-- b1;

theorem 
  for a,d be FinSequence of K st len a = len b1
  for j be Nat st j in dom b2 & len d = len b1 &
  for k st k in dom b1 holds d.k = (f.((b1/.k)) |-- b2)/.j holds
    len b1 > 0 implies (Sum(lmlt(a,f*b1)) |-- b2)/.j = Sum(mlt(a,d));

begin 

definition
  let K be Field;
  let V1,V2 be finite-dimensional VectSp of K;
  let f be Function of V1, V2;
  let b1 be FinSequence of V1;
  let b2 be OrdBasis of V2;
  func AutMt(f,b1,b2) -> Matrix of K means


  len it = len b1 & for k st k in dom b1 holds it/.k = f.(b1/.k) |-- b2;
end;

theorem 
  len b1 = 0 implies AutMt(f,b1,b2) = {};

theorem 
  len b1 > 0 implies width AutMt(f,b1,b2) = len b2;

theorem 
  f1 is additive homogeneous & f2 is additive homogeneous &
   AutMt(f1,b1,b2) = AutMt(f2,b1,b2) & len b1 > 0 implies f1 = f2;

theorem 
  g is additive homogeneous & len b1 > 0 & len b2 > 0 implies
   AutMt(g*f,b1,b3) = AutMt(f,b1,b2) * AutMt(g,b2,b3);

theorem 
  AutMt(f1+f2,b1,b2) = AutMt(f1,b1,b2) + AutMt(f2,b1,b2);

theorem 
  a <> 0.K implies AutMt(a*f,b1,b2) = a * AutMt(f,b1,b2);














begin

reserve GF for Field,
  V for VectSp of GF,
  W for Subspace of V,
  x, y, y1, y2 for set,
  i, n, m for Nat;





registration
  let S be non empty 1-sorted;
  cluster non empty for Subset of S;
end;



theorem 
  for L being Linear_Combination of V for F, G being FinSequence of
the carrier of V for P being Permutation of dom F st G = F*P holds Sum(L (#) F)
  = Sum(L (#) G);

theorem 
  for L being Linear_Combination of V for F being FinSequence of
  the carrier of V st Carrier(L) misses rng F holds Sum(L (#) F) = 0.V;

theorem 
  for F being FinSequence of the carrier of V st F is one-to-one
for L being Linear_Combination of V st Carrier(L) c= rng F holds Sum(L (#) F) =
  Sum(L);

theorem 
  for L being Linear_Combination of V for F being FinSequence of
the carrier of V holds ex K being Linear_Combination of V st Carrier(K) = rng F
  /\ Carrier(L) & L (#) F = K (#) F;

theorem 
  for L being Linear_Combination of V for A being Subset of V for F
  being FinSequence of the carrier of V st rng F c= the carrier of Lin(A) holds
  ex K being Linear_Combination of A st Sum(L (#) F) = Sum(K);

theorem 
  for L being Linear_Combination of V for A being Subset of V st
Carrier(L) c= the carrier of Lin(A) holds ex K being Linear_Combination of A st
  Sum(L) = Sum(K);

theorem 
  for L being Linear_Combination of V st Carrier(L) c= the carrier
  of W for K being Linear_Combination of W st K = L|the carrier of W holds
  Carrier(L) = Carrier(K) & Sum(L) = Sum(K);

theorem 
  for K being Linear_Combination of W holds ex L being
  Linear_Combination of V st Carrier(K) = Carrier(L) & Sum(K) = Sum (L);

theorem 
  for L being Linear_Combination of V st Carrier(L) c= the carrier
of W holds ex K being Linear_Combination of W st Carrier(K) = Carrier(L) & Sum(
  K) = Sum (L);



theorem 
  for I being Basis of V, v being Vector of V holds v in Lin(I);

registration
  let GF, V;
  cluster linearly-independent for Subset of V;
end;

theorem 
  for A being Subset of W st A is linearly-independent holds A is
  linearly-independent Subset of V;

theorem 
  for A being Subset of V st A is linearly-independent & A c= the
  carrier of W holds A is linearly-independent Subset of W;

theorem 
  for A being Basis of W ex B being Basis of V st A c= B;

theorem 
  for A being Subset of V st A is linearly-independent for v being
Vector of V st v in A for B being Subset of V st B = A \ {v} holds not v in Lin
  (B);

theorem 
  for I being Basis of V for A being non empty Subset of V st A
  misses I for B being Subset of V st B = I \/ A holds B is linearly-dependent;

theorem 
  for A being Subset of V st A c= the carrier of W holds Lin(A) is
  Subspace of W;

theorem 
  for A being Subset of V, B being Subset of W st A = B holds Lin( A) = Lin(B);

begin






theorem 
  for A, B being finite Subset of V for v being Vector of V st v
in Lin(A \/ B) & not v in Lin(B) holds ex w being Vector of V st w in A & w in
  Lin(A \/ B \ {w} \/ {v});


theorem 
  for A, B being finite Subset of V st the VectSpStr of V = Lin(A)
  & B is linearly-independent holds card B <= card A & ex C being finite Subset
  of V st C c= A & card C = card A - card B & the VectSpStr of V = Lin(B \/ C);

begin





theorem 
  V is finite-dimensional implies for I being Basis of V holds I is finite;

theorem 
  V is finite-dimensional implies for A being Subset of V st A is
  linearly-independent holds A is finite;

theorem 
  V is finite-dimensional implies for A, B being Basis of V holds
  card A = card B;

theorem 
  (0).V is finite-dimensional;

theorem 
  V is finite-dimensional implies W is finite-dimensional;

registration
  let GF be Field, V be VectSp of GF;
  cluster strict finite-dimensional for Subspace of V;
end;

registration
  let GF be Field, V be finite-dimensional VectSp of GF;
  cluster -> finite-dimensional for Subspace of V;
end;

registration
  let GF be Field, V be finite-dimensional VectSp of GF;
  cluster strict for Subspace of V;
end;

begin





definition

  let GF be Field, V be VectSp of GF;
  assume
 V is finite-dimensional;
  func dim V -> Nat means


  for I being Basis of V holds it = card I;
end;

reserve V for finite-dimensional VectSp of GF,
  W, W1, W2 for Subspace of V,
  u, v for Vector of V;

theorem 
  dim W <= dim V;

theorem 
  for A being Subset of V st A is linearly-independent holds card
  A = dim Lin(A);

theorem 
  dim V = dim (Omega).V;

theorem 
  dim V = dim W iff (Omega).V = (Omega).W;

theorem 
  dim V = 0 iff (Omega).V = (0).V;

theorem 
  dim V = 1 iff ex v st v <> 0.V & (Omega).V = Lin{v};

theorem 
  dim V = 2 iff ex u, v st u <> v & {u, v} is linearly-independent &
  (Omega).V = Lin{u, v};

theorem 
  dim(W1 + W2) + dim(W1 /\ W2) = dim W1 + dim W2;

theorem 
  dim(W1 /\ W2) >= dim W1 + dim W2 - dim V;

theorem 
  V is_the_direct_sum_of W1, W2 implies dim V = dim W1 + dim W2;

theorem 
  n <= dim V iff ex W being strict Subspace of V st dim W = n;

definition
  let GF be Field, V be finite-dimensional VectSp of GF, n be Nat;
  func n Subspaces_of V -> set means


  x in it iff ex W being strict Subspace of V st W = x & dim W = n;
end;

theorem 
  n <= dim V implies n Subspaces_of V is non empty;

theorem 
  dim V < n implies n Subspaces_of V = {};

theorem 
  n Subspaces_of W c= n Subspaces_of V;














begin

theorem 
  for f,g being Function st g is one-to-one & f|(rng g) is
  one-to-one & rng g c= dom f holds f*g is one-to-one;




theorem 
  for f being Function, X,Y being set st X c= Y & f|Y is one-to-one
  holds f|X is one-to-one;

theorem 
  for V being 1-sorted, X,Y being Subset of V holds X meets Y iff
  ex v being Element of V st v in X & v in Y;

reserve F for Field,
  V,W for VectSp of F;

registration
  let F be Field, V be finite-dimensional VectSp of F;
  cluster finite for Basis of V;
end;

registration
  let F be Field, V,W be VectSp of F;
  cluster additive homogeneous for Function of V,W;
end;

theorem 
  [#]V is finite implies V is finite-dimensional;

theorem 
  for V being finite-dimensional VectSp of F st card ([#]V) = 1 holds dim V = 0
;

theorem 
  card ([#]V) = 2 implies dim V = 1;

begin 

definition
  let F be Field, V,W be VectSp of F;
  mode linear-transformation of V,W is additive homogeneous Function of V,W;
end;

reserve T for linear-transformation of V,W;

theorem 
  for V, W being non empty 1-sorted, T being Function of V,W holds
  dom T = [#]V & rng T c= [#]W;

theorem 
  for x,y being Element of V holds T.x - T.y = T.(x - y);

theorem 
  T.(0.V) = 0.W;

definition
  let F be Field, V,W be VectSp of F, T be linear-transformation of V,W;
  func ker T -> strict Subspace of V means


  [#]it = { u where u is Element of V : T.u = 0.W };
end;

theorem 
  for x being Element of V holds x in ker T iff T.x = 0.W;

definition
  let V,W be non empty 1-sorted, T be Function of V,W, X be Subset of V;
  redefine func T .: X -> Subset of W;
end;

definition
  let F be Field, V,W be VectSp of F, T be linear-transformation of V,W;
  func im T -> strict Subspace of W means


  [#]it = T .: [#]V;
end;

theorem 
  0.V in ker T;

theorem 
  for X being Subset of V holds T .: X is Subset of im T;

theorem 
  for y being Element of W holds y in im T iff ex x being Element
  of V st y = T.x;

theorem 
  for x being Element of ker T holds T.x = 0.W;

theorem 
  T is one-to-one implies ker T = (0).V;

theorem 
  for V being finite-dimensional VectSp of F holds dim ((0).V) = 0;

theorem 
  for x,y being Element of V st T.x = T.y holds x - y in ker T;

theorem 
  for A being Subset of V, x,y being Element of V st x - y in Lin
  A holds x in Lin (A \/ {y});

begin 


theorem 
  for X being Subset of V st V is Subspace of W holds X is Subset of W;



theorem 
  for A being Subset of V st A is linearly-independent holds A is
  Basis of Lin A;




theorem 
  for A being Subset of V, x being Element of V st x in Lin A &
  not x in A holds A \/ {x} is linearly-dependent;

theorem 
  for A being Subset of V, B being Basis of V st A is Basis of ker
  T & A c= B holds T|(B \ A) is one-to-one;

theorem 
  for A being Subset of V, l being Linear_Combination of A, x being
Element of V, a being Element of F holds l +* (x,a) is Linear_Combination of A
  \/ {x};

definition
  let V be 1-sorted, X be Subset of V;
  func V \ X -> Subset of V equals

  [#]V \ X;
end;

definition
  let F be Field, V be VectSp of F, l be Linear_Combination of V, X be Subset
  of V;
  redefine func l .: X -> Subset of F;
end;

reserve l for Linear_Combination of V;

registration
  let F be Field, V be VectSp of F;
  cluster linearly-dependent for Subset of V;
end;



definition
  let F be Field, V be VectSp of F, l be Linear_Combination of V, A be Subset
  of V;
  func l!A -> Linear_Combination of A equals

  (l|A) +* ((V \ A) --> 0.F);
end;

theorem 
  l = l!Carrier l;

theorem 
  for A being Subset of V, v being Element of V st v in A holds (l !A).v = l.v;

theorem 
  for A being Subset of V, v being Element of V st not v in A
  holds (l!A).v = 0.F;

theorem 
  for A,B being Subset of V, l being Linear_Combination of B st A
  c= B holds l = (l!A) + (l!(B\A));

registration
  let F be Field, V be VectSp of F, l be Linear_Combination of V, X be Subset
  of V;
  cluster l .: X -> finite;
end;

definition
  let V,W be non empty 1-sorted, T be Function of V,W, X be Subset of W;
  redefine func T"X -> Subset of V;
end;

theorem 
  for X being Subset of V st X misses Carrier l holds l .: X c= { 0.F};















definition
  let F be Field, V,W be VectSp of F, l be Linear_Combination of V, T be
  linear-transformation of V,W;
  func T@l -> Linear_Combination of W means


  for w being Element of W holds it.w = Sum (l .: (T"{w}));
end;

theorem 
  T@l is Linear_Combination of T .: (Carrier l);

theorem 
  Carrier (T@l) c= T .: (Carrier l);

theorem 
  for l,m being Linear_Combination of V st (Carrier l) misses (
  Carrier m) holds Carrier (l + m) = (Carrier l) \/ (Carrier m);

theorem 
  for l,m being Linear_Combination of V st (Carrier l) misses (
  Carrier m) holds Carrier (l - m) = (Carrier l) \/ (Carrier m);

theorem 
  for A,B being Subset of V st A c= B & B is Basis of V holds V
  is_the_direct_sum_of Lin A, Lin (B \ A);

theorem 
  for A being Subset of V, l being Linear_Combination of A, v
  being Element of V st T|A is one-to-one & v in A holds ex X being Subset of V
  st X misses A & T"{T.v} = {v} \/ X;

theorem 
  for X being Subset of V st X misses Carrier l & X <> {} holds l .: X = {0.F};

theorem 
  for w being Element of W st w in Carrier (T@l) holds T"{w} meets Carrier l;

theorem 
  for v being Element of V st T|(Carrier l) is one-to-one & v in
  Carrier l holds (T@l).(T.v) = l.v;

theorem 
  for G being FinSequence of V st rng G = Carrier l & T|(Carrier l
  ) is one-to-one holds T*(l (#) G) = (T@l) (#) (T*G);

theorem 
  T|(Carrier l) is one-to-one implies T .: (Carrier l) = Carrier ( T@l);

theorem 
  for A being Subset of V, B being Basis of V, l being
  Linear_Combination of B \ A st A is Basis of ker T & A c= B holds T.(Sum l) =
  Sum (T@l);

theorem 
  for X being Subset of V st X is linearly-dependent holds ex l
  being Linear_Combination of X st Carrier l <> {} & Sum l = 0.V;




definition
  let F be Field, V,W be VectSp of F, X be Subset of V, T be
  linear-transformation of V,W, l be Linear_Combination of T .: X;
  assume
 T|X is one-to-one;
  func T#l -> Linear_Combination of X equals


  (l*T) +* ((V \ X) --> 0.F);
end;

theorem 
  for X being Subset of V, l being Linear_Combination of T .: X, v
  being Element of V st v in X & T|X is one-to-one holds (T#l).v = l.(T.v);



theorem 
  for X being Subset of V, l being Linear_Combination of T .: X st
  T|X is one-to-one holds T@(T#l) = l;

begin 

definition
  let F be Field, V,W be finite-dimensional VectSp of F, T be
  linear-transformation of V,W;
  func rank(T) -> Nat equals

  dim (im T);
  func nullity(T) -> Nat equals

  dim (ker T);
end;


theorem 
  for V,W being finite-dimensional VectSp of F, T being
  linear-transformation of V,W holds dim V = rank(T) + nullity(T);

theorem 
  for V,W being finite-dimensional VectSp of F, T being
  linear-transformation of V,W st T is one-to-one holds dim V = rank T;














begin

theorem 
  for R being non degenerated add-associative right_zeroed
  right_complementable non empty doubleLoopStr holds 0.R <> -1.R;

reserve x,y for set,
  R for Ring,
  V for LeftMod of R,
  L for Linear_Combination of V,
  a for Scalar of R,
  v,u for Vector of V,
  F,G for FinSequence of the carrier of V,
  C for finite Subset of V;

theorem 
  Carrier(L) c= C implies ex F st F is one-to-one & rng F = C & Sum
  (L) = Sum(L (#) F);

theorem 
  Sum(a * L) = a * Sum(L);

reserve X,Y,Z for set,
  A,B for Subset of V,
  T for finite Subset of V,
  l for Linear_Combination of A,
  f,g for Function of the carrier of V,the carrier of R;

definition
  let R,V,A;
  func Lin(A) -> strict Subspace of V means


  the carrier of it = {Sum(l) : not contradiction};
end;

theorem 
  x in Lin(A) iff ex l st x = Sum(l);

theorem 
  x in A implies x in Lin(A);

theorem 
  Lin({}(the carrier of V)) = (0).V;

theorem 
  Lin(A) = (0).V implies A = {} or A = {0.V};

theorem 
  for W being strict Subspace of V holds 0.R <> 1.R & A = the
  carrier of W implies Lin(A) = W;

theorem 
  for V being strict LeftMod of R for A being Subset of V holds 0.R <>
  1.R & A = the carrier of V implies Lin(A) = V;

theorem 
  A c= B implies Lin(A) is Subspace of Lin(B);

theorem 
  Lin(A) = V & A c= B implies Lin(B) = V;

theorem 
  Lin(A \/ B) = Lin(A) + Lin(B);

theorem 
  Lin(A /\ B) is Subspace of Lin(A) /\ Lin(B);

definition
  let R,V;
  let IT be Subset of V;
  attr IT is base means


  IT is linearly-independent & Lin(IT) = the VectSpStr of V;
end;

definition
  let R;
  let IT be LeftMod of R;
  attr IT is free means


  ex B being Subset of IT st B is base;
end;

theorem 
  (0).V is free;

registration
  let R;
  cluster strict free for LeftMod of R;
end;

reserve R for Skew-Field;
reserve a,b for Scalar of R;
reserve V for LeftMod of R;
reserve v,v1,v2,u for Vector of V;
reserve f for Function of the carrier of V,the carrier of R;

theorem 
  {v} is linearly-independent iff v <> 0.V;

theorem 
  v1 <> v2 & {v1,v2} is linearly-independent iff v2 <> 0.V & for a
  holds v1 <> a * v2;

theorem 
  v1 <> v2 & {v1,v2} is linearly-independent iff for a,b st a * v1 + b *
  v2 = 0.V holds a = 0.R & b = 0.R;

theorem 
  for V being LeftMod of R for A being Subset of V holds A is
  linearly-independent implies ex B being Subset of V st A c= B & B is base;

theorem 
  for V being LeftMod of R for A being Subset of V holds Lin(A) =
  V implies ex B being Subset of V st B c= A & B is base;

theorem 
  for V being LeftMod of R holds V is free;

definition
  let R;
  let V be LeftMod of R;

  mode Basis of V -> Subset of V means


    it is base;
end;

theorem 
  for V being LeftMod of R for A being Subset of V holds A is
  linearly-independent implies ex I being Basis of V st A c= I;

theorem 
  for V being LeftMod of R for A being Subset of V holds Lin(A) = V
  implies ex I being Basis of V st I c= A;














begin

reserve V for RealLinearSpace,
  u,u1,u2,v,v1,v2,w,w1,x,y for VECTOR of V,
  a,a1,a2,b,b1,b2,c1,c2,n,k1,k2 for Real;

definition
  let V,x,y;
  let u;
  func Ortm(x,y,u) -> VECTOR of V equals

  pr1(x,y,u)*x + (-pr2(x,y,u))*y;
end;

theorem 
  Gen x,y implies Ortm(x,y,u+v)=Ortm(x,y,u)+Ortm(x,y,v);

theorem 
  Gen x,y implies Ortm(x,y,n*u)= n*Ortm(x,y,u);

theorem 
  Gen x,y implies Ortm(x,y,0.V) = 0.V;

theorem 
  Gen x,y implies Ortm(x,y,-u) = -Ortm(x,y,u);

theorem 
  Gen x,y implies Ortm(x,y,u-v)=Ortm(x,y,u)-Ortm(x,y,v);

theorem 
  Gen x,y & Ortm(x,y,u)=Ortm(x,y,v) implies u=v;

theorem 
  Gen x,y implies Ortm(x,y,Ortm(x,y,u))=u;

theorem 
  Gen x,y implies ex v st u=Ortm(x,y,v);

definition
  let V,x,y;
  let u;
  func Orte(x,y,u) -> VECTOR of V equals

  pr2(x,y,u)*x + (-pr1(x,y,u))*y;
end;

theorem 
  Gen x,y implies Orte(x,y,-v)= -Orte(x,y,v);

theorem 
  Gen x,y implies Orte(x,y,u+v)=Orte(x,y,u) + Orte(x,y,v);

theorem 
  Gen x,y implies Orte(x,y,u-v)=Orte(x,y,u)-Orte(x,y,v);

theorem 
  Gen x,y implies Orte(x,y,n*u)=n*Orte(x,y,u);

theorem 
  Gen x,y & Orte(x,y,u)=Orte(x,y,v) implies u=v;

theorem 
  Gen x,y implies Orte(x,y,Orte(x,y,u)) = -u;

theorem 
  Gen x,y implies ex v st Orte(x,y,v) = u;

definition
  let V;
  let x,y,u,v,u1,v1;
  pred u,v,u1,v1 are_COrte_wrt x,y means


  Orte(x,y,u),Orte(x,y,v) // u1,v1;
  pred u,v,u1,v1 are_COrtm_wrt x,y means


  Ortm(x,y,u),Ortm(x,y,v) // u1,v1;
end;

theorem 
  Gen x,y implies (u,v // u1,v1 implies
  Orte(x,y,u),Orte(x,y,v) // Orte(x,y,u1),Orte(x,y,v1));

theorem 
  Gen x,y implies (u,v // u1,v1 implies
  Ortm(x,y,u),Ortm(x,y,v) // Ortm(x,y,u1),Ortm(x,y,v1));

theorem 
  Gen x,y implies (u,u1,v,v1 are_COrte_wrt x,y implies
  v,v1,u1,u are_COrte_wrt x,y);

theorem 
  Gen x,y implies (u,u1,v,v1 are_COrtm_wrt x,y implies
  v,v1,u,u1 are_COrtm_wrt x,y);

theorem 
  u,u,v,w are_COrte_wrt x,y;

theorem 
  u,u,v,w are_COrtm_wrt x,y;

theorem 
  u,v,w,w are_COrte_wrt x,y;

theorem 
  u,v,w,w are_COrtm_wrt x,y;

theorem 
  Gen x,y implies u,v,Orte(x,y,u),Orte(x,y,v) are_Ort_wrt x,y;

theorem 
  u,v,Orte(x,y,u),Orte(x,y,v) are_COrte_wrt x,y;

theorem 
  u,v,Ortm(x,y,u),Ortm(x,y,v) are_COrtm_wrt x,y;

theorem 
  Gen x,y implies (u,v // u1,v1 iff ex u2,v2 st u2<>v2 &
  u2,v2,u,v are_COrte_wrt x,y & u2,v2,u1,v1 are_COrte_wrt x,y);

theorem 
  Gen x,y implies (u,v // u1,v1 iff ex u2,v2 st u2<>v2 &
  u2,v2,u,v are_COrtm_wrt x,y & u2,v2,u1,v1 are_COrtm_wrt x,y);

theorem 
  Gen x,y implies (u,v,u1,v1 are_Ort_wrt x,y iff
  u,v,u1,v1 are_COrte_wrt x,y or u,v,v1,u1 are_COrte_wrt x,y);

theorem 
  Gen x,y & u,v,u1,v1 are_COrte_wrt x,y & u,v,v1,u1 are_COrte_wrt x,y
  implies u=v or u1=v1;

theorem 
  Gen x,y & u,v,u1,v1 are_COrtm_wrt x,y & u,v,v1,u1 are_COrtm_wrt x,y
  implies u=v or u1=v1;

theorem 
  Gen x,y & u,v,u1,v1 are_COrte_wrt x,y & u,v,u1,w are_COrte_wrt x,y
  implies u,v,v1,w are_COrte_wrt x,y or u,v,w,v1 are_COrte_wrt x,y;

theorem 
  Gen x,y & u,v,u1,v1 are_COrtm_wrt x,y & u,v,u1,w are_COrtm_wrt x,y
  implies u,v,v1,w are_COrtm_wrt x,y or u,v,w,v1 are_COrtm_wrt x,y;

theorem 
  u,v,u1,v1 are_COrte_wrt x,y implies v,u,v1,u1 are_COrte_wrt x,y;

theorem 
  u,v,u1,v1 are_COrtm_wrt x,y implies v,u,v1,u1 are_COrtm_wrt x,y;

theorem 
  Gen x,y & u,v,u1,v1 are_COrte_wrt x,y & u,v,v1,w are_COrte_wrt x,y
  implies u,v,u1,w are_COrte_wrt x,y;

theorem 
  Gen x,y & u,v,u1,v1 are_COrtm_wrt x,y & u,v,v1,w are_COrtm_wrt x,y
  implies u,v,u1,w are_COrtm_wrt x,y;

theorem 
  Gen x,y implies for u,v,w ex u1 st w<>u1 & w,u1,u,v are_COrte_wrt x,y;

theorem 
  Gen x,y implies for u,v,w ex u1 st w<>u1 & w,u1,u,v are_COrtm_wrt x,y;

theorem 
  Gen x,y implies for u,v,w ex u1 st w<>u1 & u,v,w,u1 are_COrte_wrt x,y;

theorem 
  Gen x,y implies for u,v,w ex u1 st w<>u1 & u,v,w,u1 are_COrtm_wrt x,y;

theorem 
  Gen x,y & u,u1,v,v1 are_COrte_wrt x,y & w,w1,v,v1 are_COrte_wrt x,y &
  w,w1,u2,v2 are_COrte_wrt x,y implies
  w=w1 or v=v1 or u,u1,u2,v2 are_COrte_wrt x,y;

theorem 
  Gen x,y & u,u1,v,v1 are_COrtm_wrt x,y & w,w1,v,v1 are_COrtm_wrt x,y &
  w,w1,u2,v2 are_COrtm_wrt x,y implies
  w=w1 or v=v1 or u,u1,u2,v2 are_COrtm_wrt x,y;

theorem 
  Gen x,y & u,u1,v,v1 are_COrte_wrt x,y & v,v1,w,w1 are_COrte_wrt x,y
  & u2,v2,w,w1 are_COrte_wrt x,y implies
  u,u1,u2,v2 are_COrte_wrt x,y or v=v1 or w=w1;

theorem 
  Gen x,y & u,u1,v,v1 are_COrtm_wrt x,y & v,v1,w,w1 are_COrtm_wrt x,y
  & u2,v2,w,w1 are_COrtm_wrt x,y implies
  u,u1,u2,v2 are_COrtm_wrt x,y or v=v1 or w=w1;

theorem 
  Gen x,y & u,u1,v,v1 are_COrte_wrt x,y & v,v1,w,w1 are_COrte_wrt x,y
  & u,u1,u2,v2 are_COrte_wrt x,y implies
  u2,v2,w,w1 are_COrte_wrt x,y or v=v1 or u=u1;

theorem 
  Gen x,y & u,u1,v,v1 are_COrtm_wrt x,y & v,v1,w,w1 are_COrtm_wrt x,y
  & u,u1,u2,v2 are_COrtm_wrt x,y implies
  u2,v2,w,w1 are_COrtm_wrt x,y or v=v1 or u=u1;

theorem 
  Gen x,y implies for v,w,u1,v1,w1 holds not v,v1,w,u1 are_COrte_wrt x,y &
  not v,v1,u1,w are_COrte_wrt x,y & u1,w1,u1,w are_COrte_wrt x,y
  implies ex u2 st
  (v,v1,v,u2 are_COrte_wrt x,y or v,v1,u2,v are_COrte_wrt x,y) &
  (u1,w1,u1,u2 are_COrte_wrt x,y or u1,w1,u2,u1 are_COrte_wrt x,y);

theorem 
  Gen x,y implies ex u,v,w st (u,v,u,w are_COrte_wrt x,y &
  for v1,w1 st v1,w1,u,v are_COrte_wrt x,y holds
  (not v1,w1,u,w are_COrte_wrt x,y & not v1,w1,w,u are_COrte_wrt x,y
  or v1=w1));

theorem 
  Gen x,y implies for v,w,u1,v1,w1 holds not v,v1,w,u1 are_COrtm_wrt x,y &
  not v,v1,u1,w are_COrtm_wrt x,y & u1,w1,u1,w are_COrtm_wrt x,y
  implies ex u2 st
  (v,v1,v,u2 are_COrtm_wrt x,y or v,v1,u2,v are_COrtm_wrt x,y) &
  (u1,w1,u1,u2 are_COrtm_wrt x,y or u1,w1,u2,u1 are_COrtm_wrt x,y);

theorem 
  Gen x,y implies ex u,v,w st (u,v,u,w are_COrtm_wrt x,y &
  for v1,w1 holds (v1,w1,u,v are_COrtm_wrt x,y implies
  (not v1,w1,u,w are_COrtm_wrt x,y & not v1,w1,w,u are_COrtm_wrt x,y
  or v1=w1)));

reserve uu,vv for set;

definition
  let V;
  let x,y;
  func CORTE(V,x,y) -> Relation of [:the carrier of V,the carrier of V:] means


  [uu,vv] in it iff
  ex u1,u2,v1,v2 st uu=[u1,u2] & vv=[v1,v2] & u1,u2,v1,v2 are_COrte_wrt x,y;
end;

definition
  let V;
  let x,y;
  func CORTM(V,x,y) -> Relation of [:the carrier of V,the carrier of V:] means


  [uu,vv] in it iff
  ex u1,u2,v1,v2 st uu=[u1,u2] & vv=[v1,v2] & u1,u2,v1,v2 are_COrtm_wrt x,y;
end;

definition
  let V;
  let x,y;
  func CESpace(V,x,y) -> strict AffinStruct equals

  AffinStruct (# the carrier of V,CORTE(V,x,y) #);
end;

registration
  let V;
  let x,y;
  cluster CESpace(V,x,y) -> non empty;
end;

definition
  let V;
  let x,y;
  func CMSpace(V,x,y) -> strict AffinStruct equals

  AffinStruct (# the carrier of V,CORTM(V,x,y) #);
end;

registration
  let V;
  let x,y;
  cluster CMSpace(V,x,y) -> non empty;
end;

theorem 
  uu is Element of CESpace(V,x,y) iff uu is VECTOR of V;

theorem 
  uu is Element of CMSpace(V,x,y) iff uu is VECTOR of V;

reserve p,q,r,s for Element of CESpace(V,x,y);

theorem 
  u=p & v=q & u1=r & v1=s implies (p,q // r,s iff u,v,u1,v1 are_COrte_wrt x,y )
;

reserve p,q,r,s for Element of CMSpace(V,x,y);

theorem 
  u=p & v=q & u1=r & v1=s implies (p,q // r,s iff u,v,u1,v1 are_COrtm_wrt x,y )
;














begin 

reserve G for Abelian add-associative right_complementable right_zeroed non
  empty addLoopStr;

theorem 
  0.G is_a_unity_wrt the addF of G;

theorem 
  for G being AbGroup holds comp G is_an_inverseOp_wrt the addF of G;

reserve GS for non empty addLoopStr;

theorem 
  the addF of GS is commutative associative & 0.GS is_a_unity_wrt the
  addF of GS & comp GS is_an_inverseOp_wrt the addF of GS implies GS is AbGroup
;

reserve F for Field;

theorem 
  0.F is_a_unity_wrt the addF of F;

theorem 
  1_F is_a_unity_wrt the multF of F;

begin 

reserve F for Field,
  n for Nat,
  D for non empty set,
  d for Element of D,
  B for BinOp of D,
  C for UnOp of D;

definition
  let D,n;
  let F be BinOp of D;
  let x,y be Element of n-tuples_on D;
  redefine func F.:(x,y) -> Element of n-tuples_on D;
end;

definition
  let D be non empty set;
  let F be BinOp of D;
  let n be Nat;
  func product(F,n) -> BinOp of n-tuples_on D means


  for x,y being Element of n-tuples_on D holds it.(x,y)=F.:(x,y);
end;

definition
  let D;
  let F be UnOp of D;
  let n;
  func product(F,n) -> UnOp of n-tuples_on D means


  for x being Element of n-tuples_on D holds it.x=F*x;
end;

theorem 
  B is commutative implies product(B,n) is commutative;

theorem 
  B is associative implies product(B,n) is associative;

theorem 
  d is_a_unity_wrt B implies n |-> d is_a_unity_wrt product(B,n);

theorem 
  B is having_a_unity & B is associative & C is_an_inverseOp_wrt B
  implies product(C,n) is_an_inverseOp_wrt product(B,n);

begin 

definition
  let F be non empty addLoopStr, n;
  assume
 F is Abelian add-associative right_zeroed right_complementable;
  func n -Group_over F -> strict AbGroup equals


  addLoopStr(# n
-tuples_on the carrier of F, product(the addF of F,n), (n |-> 0.F) qua Element
    of n-tuples_on the carrier of F#);
end;

registration
  let F be AbGroup, n;
  cluster n-Group_over F -> non empty;
end;

reserve x,y for set;

definition
  let F,n;
  func n -Mult_over F -> Function of [:the carrier of F,n-tuples_on the
  carrier of F:], n-tuples_on the carrier of F means


  for x being Element
  of F, v being Element of n-tuples_on the carrier of F holds it.(x,v) = (the
  multF of F)[;](x,v);
end;

definition
  let F,n;
  func n -VectSp_over F -> strict VectSpStr over F means


  the addLoopStr of it = n -Group_over F & the lmult of it = n -Mult_over F;
end;

registration
  let F,n;
  cluster n -VectSp_over F -> non empty;
end;

reserve D for non empty set,
  H,G for BinOp of D,
  d for Element of D,
  t1,t2 for Element of n-tuples_on D;

theorem 
  H is_distributive_wrt G implies H[;](d,G.:(t1,t2)) = G.: (H[;](d
  ,t1),H[;](d,t2));

definition
  let D be non empty set, n be Nat, F be BinOp of D, x be Element of D, v be
  Element of n-tuples_on D;
  redefine func F[;](x,v) -> Element of n-tuples_on D;
end;

registration
  let F,n;
  cluster n -VectSp_over F -> vector-distributive scalar-distributive
  scalar-associative scalar-unital;
end;

begin 

reserve x,y,z for set,
  A for AbGroup;

definition
  mode Domain-Sequence is non empty non-empty FinSequence;
end;

scheme 

  NEFinSeqLambda {w()-> non empty FinSequence, F(set)->set}: ex p being non
empty FinSequence st len p = len w() & for i being Element of dom w() holds p.i
  = F(i);

definition
  let a be non-empty non empty Function;
  let f be Element of product a;
  let i be Element of dom a;
  redefine func f.i -> Element of a.i;
end;

begin 

reserve a for Domain-Sequence,
  i for Element of dom a,
  p for FinSequence;

definition
  let a be non-empty non empty Function;

  mode BinOps of a -> Function means


    dom it = dom a & for i being Element of dom a holds it.i is BinOp of a.i;
  mode UnOps of a -> Function means


    dom it = dom a & for i being Element of dom a holds it.i is UnOp of a.i;
end;

registration
  let a;
  cluster -> FinSequence-like for BinOps of a;
  cluster -> FinSequence-like for UnOps of a;
end;

theorem 
  p is BinOps of a iff len p = len a & for i holds p.i is BinOp of a.i;

theorem 
  p is UnOps of a iff len p = len a & for i holds p.i is UnOp of a .i;

definition
  let a;
  let b be BinOps of a;
  let i;
  redefine func b.i -> BinOp of a.i;
end;

definition
  let a;
  let u be UnOps of a;
  let i;
  redefine func u.i -> UnOp of a.i;
end;

theorem 
  for d,d9 being UnOp of product a st for f being Element of product a,
  i being Element of dom a holds (d.f).i = (d9.f).i holds d = d9;

theorem 
  for u being UnOps of a holds doms u = a & product rngs u c= product a;

definition
  let a;
  let u be UnOps of a;
  redefine func Frege u -> UnOp of product a;
end;

theorem 
  for u being UnOps of a for f being Element of product a, i being
  Element of dom a holds (Frege u).f.i = (u.i).(f.i);

definition
  let F be functional non empty set;
  let b be BinOp of F, f,g be Element of F;
  redefine func b.(f,g) -> Element of F;
end;

theorem 
  for d,d9 being BinOp of product a st for f,g being Element of
product a, i being Element of dom a holds (d.(f,g)).i = (d9.(f,g)).i holds d =
  d9;

reserve i for Element of dom a;

definition
  let a;
  let b be BinOps of a;
  func [:b:] -> BinOp of product a means


  for f,g being Element of
  product a, i being Element of dom a holds (it.(f,g)).i = (b.i).(f.i,g.i);
end;

theorem 
  for b being BinOps of a st for i holds b.i is commutative holds
  [:b:] is commutative;

theorem 
  for b being BinOps of a st for i holds b.i is associative holds
  [:b:] is associative;

theorem 
  for b being BinOps of a, f being Element of product a st for i
  holds f.i is_a_unity_wrt b.i holds f is_a_unity_wrt [:b:];

theorem 
  for b being BinOps of a, u being UnOps of a st for i holds u.i
  is_an_inverseOp_wrt b.i & b.i is having_a_unity holds Frege u
  is_an_inverseOp_wrt [:b:];

begin 

definition
  let F be Relation;
  attr F is AbGroup-yielding means


  x in rng F implies x is AbGroup;
end;

registration
  cluster non empty AbGroup-yielding for FinSequence;
end;

definition
  mode Group-Sequence is non empty AbGroup-yielding FinSequence;
end;

definition
  let g be Group-Sequence;
  let i be Element of dom g;
  redefine func g.i -> AbGroup;
end;

definition
  let g be Group-Sequence;
  func carr g -> Domain-Sequence means


  len it = len g & for j be Element of dom g holds it.j = the carrier of g.j;
end;

reserve g for Group-Sequence,
  i for Element of dom carr g;

definition
  let g,i;
  redefine func g.i -> AbGroup;
end;

definition
  let g;
  func addop g -> BinOps of carr g means


  len it = len carr g & for i holds it.i = the addF of g.i;
  func complop g -> UnOps of carr g means


  len it = len carr g & for i holds it.i = comp g.i;
  func zeros g -> Element of product carr g means


  for i holds it.i = 0.(g.i);
end;

definition
  let G be Group-Sequence;
  func product G -> strict AbGroup equals

  addLoopStr(# product carr G, [:addop
    G:], zeros G #);
end;














begin

reserve F for Field;
reserve VS for strict VectSp of F;

definition
  let F, VS;
  func lattice VS -> strict bounded Lattice equals

  LattStr (# Subspaces(VS),
    SubJoin(VS), SubMeet(VS) #);
end;

definition
  let F,VS;
  mode SubVS-Family of VS means


    for x be set st x in it holds x is Subspace of VS;
end;

registration
  let F,VS;
  cluster non empty for SubVS-Family of VS;
end;

definition
  let F,VS;
  redefine func Subspaces(VS) -> non empty SubVS-Family of VS;
  let X be non empty SubVS-Family of VS;
  redefine mode Element of X -> Subspace of VS;
end;

definition
  let F,VS;
  let x be Element of Subspaces VS;
  func carr(x) -> Subset of VS means


  ex X being Subspace of VS st x=X & it = the carrier of X;
end;

reserve u,e for set;

definition
  let F,VS;
  func carr VS -> Function of Subspaces(VS),bool the carrier of VS means



  for h being Element of Subspaces(VS), H being Subspace of VS st h = H holds
  it.h = the carrier of H;
end;

theorem 
  for VS being strict VectSp of F for H being non empty Subset of
  Subspaces VS holds (carr VS).:H is non empty;

theorem 
  for VS being strict VectSp of F for H being strict Subspace of VS
  holds 0.VS in (carr VS).H;

reserve x for set;

definition
  let F,VS;
  let G be non empty Subset of Subspaces(VS);
  func meet G -> strict Subspace of VS means


  the carrier of it = meet ( (carr VS).:G);
end;

theorem 
  Subspaces(VS) = the carrier of lattice VS;

theorem 
  the L_meet of lattice VS = SubMeet(VS);

theorem 
  the L_join of lattice VS = SubJoin(VS);

theorem 
  for VS being strict VectSp of F, p,q being Element of lattice VS,
  H1,H2 being strict Subspace of VS st p=H1 & q=H2 holds p [= q iff the carrier
  of H1 c= the carrier of H2;

theorem 
  for VS being strict VectSp of F, p,q being Element of lattice VS,
  H1,H2 being Subspace of VS st p=H1 & q=H2 holds p"\/"q = H1+H2;

theorem 
  for VS being strict VectSp of F, p,q being Element of lattice VS,
  H1,H2 being Subspace of VS st p=H1 & q=H2 holds p"/\"q = H1 /\ H2;

definition
  let L be non empty LattStr;
  redefine attr L is complete means

  for X being Subset of L ex a being Element
of L st a is_less_than X & for b being Element of L st b is_less_than X holds b
  [= a;
end;

reserve Z1 for set;

theorem 
  for VS holds lattice VS is complete;

theorem 
  for x being set for VS being strict VectSp of F for S being
Subset of VS st S is non empty & S is linearly-closed holds x in Lin S implies
  x in S;

definition
  let F be Field;
  let A,B be strict VectSp of F;
  let f be Function of the carrier of A,the carrier of B;
  func FuncLatt f -> Function of the carrier of lattice A, the carrier of
  lattice B means


  for S being strict Subspace of A, B0 being Subset of B
  st B0 = f.:the carrier of S holds it.S = Lin B0;
end;

definition
  let L1, L2 be Lattice;
  mode Semilattice-Homomorphism of L1,L2 -> Function of the carrier of L1, the
    carrier of L2 means


    for a, b being Element of L1 holds it.(a "/\" b) = it.a "/\" it.b;
end;

definition
  let L1, L2 be Lattice;
  mode sup-Semilattice-Homomorphism of L1, L2 -> Function of the carrier of L1
    , the carrier of L2 means


    for a, b being Element of L1 holds it.(a "\/" b) = it.a "\/" it.b;
end;

theorem 
  for L1,L2 being Lattice for f being Function of the carrier of L1, the
  carrier of L2 holds f is Homomorphism of L1, L2 iff f is
  sup-Semilattice-Homomorphism of L1, L2 & f is Semilattice-Homomorphism of L1,
  L2;

theorem 
  for F being Field for A,B being strict VectSp of F for f be
  Function of A, B st f is additive homogeneous holds FuncLatt f is
  sup-Semilattice-Homomorphism of lattice A, lattice B;

theorem 
  for F being Field for A,B being strict VectSp of F for f be Function
of A,B st f is one-to-one additive homogeneous
 holds FuncLatt f is Homomorphism of lattice A,
  lattice B;

theorem 
  for A,B being strict VectSp of F for f being Function of A, B st f is
  additive homogeneous & f is one-to-one holds FuncLatt f is one-to-one;

theorem 
  for A being strict VectSp of F holds FuncLatt id the carrier of A = id
  the carrier of lattice A;














begin 

reserve I for non empty set;
reserve M for ManySortedSet of I;
reserve Y,x,y,i for set;
reserve r,r1,r2 for Real;

theorem 
  id M is Equivalence_Relation of M;

theorem 
  [|M,M|] is Equivalence_Relation of M;

registration
  let I,M;
  cluster EqRelLatt M -> bounded;
end;

theorem 
  Bottom EqRelLatt M = id M;

theorem 
  Top EqRelLatt M = [|M,M|];

theorem 
  for X be Subset of EqRelLatt M holds X is SubsetFamily of [|M,M|];

theorem 
  for a,b be Element of EqRelLatt M, A,B be Equivalence_Relation of
  M st a = A & b = B holds a [= b iff A c= B;

theorem 
  for X be Subset of EqRelLatt M, X1 be SubsetFamily of [|M,M|] st
X1 = X for a,b be Equivalence_Relation of M st a = meet |:X1:| & b in X holds a
  c= b;

theorem 
  for X be Subset of EqRelLatt M, X1 be SubsetFamily of [|M,M|] st
  X1 = X & X is non empty holds meet |:X1:| is Equivalence_Relation of M;

definition
  let L be non empty LattStr;
  redefine attr L is complete means


  for X being Subset of L ex a being
Element of L st X is_less_than a & for b being Element of L st X is_less_than b
  holds a [= b;
end;

theorem 
  EqRelLatt M is complete;

registration
  let I,M;
  cluster EqRelLatt M -> complete;
end;

theorem 
  for X be Subset of EqRelLatt M, X1 be SubsetFamily of [|M,M|] st X1 =
X & X is non empty for a,b be Equivalence_Relation of M st a = meet |:X1:| & b
  = "/\" (X,EqRelLatt M) holds a = b;

begin 

definition
  let L be Lattice;
  let IT be SubLattice of L;
  attr IT is /\-inheriting means


  for X being Subset of IT holds "/\" (X ,L) in the carrier of IT;
  attr IT is \/-inheriting means


  for X being Subset of IT holds "\/" (X ,L) in the carrier of IT;
end;

theorem 
  for L be Lattice, L9 be SubLattice of L, a,b be Element of L, a9
,b9 be Element of L9 st a = a9 & b = b9 holds a "\/" b = a9 "\/" b9 & a "/\" b
  = a9 "/\" b9;

theorem 
  for L be Lattice, L9 be SubLattice of L, X be Subset of L9, a be
  Element of L, a9 be Element of L9 st a = a9 holds a is_less_than X iff a9
  is_less_than X;

theorem 
  for L be Lattice, L9 be SubLattice of L, X be Subset of L9, a be
  Element of L, a9 be Element of L9 st a = a9 holds X is_less_than a iff X
  is_less_than a9;

theorem 
  for L be complete Lattice, L9 be SubLattice of L st L9 is
  /\-inheriting holds L9 is complete;

theorem 
  for L be complete Lattice, L9 be SubLattice of L st L9 is
  \/-inheriting holds L9 is complete;

registration
  let L be complete Lattice;
  cluster complete for SubLattice of L;
end;

registration
  let L be complete Lattice;
  cluster /\-inheriting -> complete for SubLattice of L;
  cluster \/-inheriting -> complete for SubLattice of L;
end;

theorem 
  for L be complete Lattice, L9 be SubLattice of L st L9 is
  /\-inheriting for A9 be Subset of L9 holds "/\" (A9,L) = "/\" (A9,L9);

theorem 
  for L be complete Lattice, L9 be SubLattice of L st L9 is
  \/-inheriting for A9 be Subset of L9 holds "\/" (A9,L) = "\/" (A9,L9);

theorem 
  for L be complete Lattice, L9 be SubLattice of L st L9 is
/\-inheriting for A be Subset of L, A9 be Subset of L9 st A = A9 holds "/\" A =
  "/\" A9;

theorem 
  for L be complete Lattice, L9 be SubLattice of L st L9 is
\/-inheriting for A be Subset of L, A9 be Subset of L9 st A = A9 holds "\/" A =
  "\/" A9;

begin 

definition
  let r1,r2 such that
 r1 <= r2;
  func RealSubLatt(r1,r2) -> strict Lattice means


  the carrier of it =
[.r1,r2.] & the L_join of it = maxreal||[.r1,r2.] & the L_meet of it = minreal
  ||[.r1,r2.];
end;

theorem 
  for r1,r2 st r1 <= r2 holds RealSubLatt(r1,r2) is complete;

theorem 
  ex L9 be SubLattice of RealSubLatt(0,1) st L9 is \/-inheriting
  non /\-inheriting;

theorem 
  ex L be complete Lattice, L9 be SubLattice of L st L9 is \/-inheriting
  non /\-inheriting;

theorem 
  ex L9 be SubLattice of RealSubLatt(0,1) st L9 is /\-inheriting
  non \/-inheriting;

theorem 
  ex L be complete Lattice, L9 be SubLattice of L st L9 is /\-inheriting
  non \/-inheriting;














begin

reserve y,w for set;

theorem 
  for T being non empty TopSpace, A being non empty a_partition of
  the carrier of T, y being Subset of space A holds (Proj(A))"y = union y;

theorem 
  for T being non empty TopSpace, S being non empty a_partition of
  the carrier of T, A being Subset of space S, B being Subset of T holds B =
  union A implies (A is closed iff B is closed);




reserve T for non empty TopSpace;

theorem 
  { A where A is a_partition of the carrier of T : A is closed }
  is Part-Family of the carrier of T;

definition
  let T;
  func Closed_Partitions T -> non empty Part-Family of the carrier of T equals

  { A where A is a_partition of the carrier of T : A is closed };
end;



definition
  let T be non empty TopSpace;
  func T_1-reflex T -> TopSpace equals

  space (Intersection Closed_Partitions T
  );
end;

registration
  let T;
  cluster T_1-reflex T -> strict non empty;
end;

theorem 
  for T being non empty TopSpace holds T_1-reflex T is T_1;

registration
  let T;
  cluster T_1-reflex T -> T_1;
end;

registration
  cluster T_1 non empty for TopSpace;
end;

definition
  let T be non empty TopSpace;
  func T_1-reflect T -> continuous Function of T,T_1-reflex T equals

  Proj
  Intersection Closed_Partitions T;
end;

theorem 
  for T,T1 being non empty TopSpace,f being continuous Function of
  T,T1 holds T1 is T_1 implies {f"{z} where z is Element of T1 : z in rng f} is
a_partition of the carrier of T & for A being Subset of T st A in {f"{z} where
  z is Element of T1 : z in rng f} holds A is closed;

theorem 
  for T,T1 being non empty TopSpace,f being continuous Function of
T,T1 holds T1 is T_1 implies for w for x being Element of T holds w = EqClass(x
  ,(Intersection Closed_Partitions T)) implies w c= f"{f.x};

theorem 
  for T,T1 being non empty TopSpace,f being continuous Function of
  T,T1 holds T1 is T_1 implies for w st w in the carrier of T_1-reflex T ex z
  being Element of T1 st z in rng f & w c= f"{z};



theorem 
  for T,T1 being non empty TopSpace,f being continuous Function of
T,T1 holds T1 is T_1 implies ex h being continuous Function of T_1-reflex T, T1
  st f = h*T_1-reflect T;

definition
  let T,S be non empty TopSpace;
  let f be continuous Function of T,S;
  func T_1-reflex f -> continuous Function of T_1-reflex T, T_1-reflex S means

  (T_1-reflect S) * f = it * (T_1-reflect T);
end;














begin 

theorem 
  for S, T being TopSpace holds [#][:S, T:] = [:[#]S, [#]T:];

theorem 
  for X, Y being non empty TopSpace, x being Point of X holds Y -->
  x is continuous Function of Y, X|{x};

registration
  let T be TopStruct;
  cluster id T -> being_homeomorphism;
end;

definition
  let S, T be TopStruct;
  redefine pred S, T are_homeomorphic;
  reflexivity;
end;

definition
  let S, T be non empty TopStruct;
  redefine pred S, T are_homeomorphic;
  reflexivity;
  symmetry;
end;

theorem 
  for S, T, V being non empty TopSpace st S, T are_homeomorphic & T, V
  are_homeomorphic holds S, V are_homeomorphic;

begin 

registration
  let T be TopStruct, P be empty Subset of T;
  cluster T | P -> empty;
end;

registration
  cluster empty -> compact for TopSpace;
end;

theorem 
  for X, Y being non empty TopSpace, x being Point of X, f being
  Function of [:Y, X | {x}:], Y st f = pr1(the carrier of Y, {x}) holds f is
  one-to-one;

theorem 
  for X, Y being non empty TopSpace, x being Point of X, f being
  Function of [:X | {x}, Y:], Y st f = pr2({x}, the carrier of Y) holds f is
  one-to-one;

theorem 
  for X, Y being non empty TopSpace, x being Point of X, f being
Function of [:Y, X | {x}:], Y st f = pr1(the carrier of Y, {x}) holds f" = <:id
  Y, Y --> x:>;

theorem 
  for X, Y being non empty TopSpace, x being Point of X, f being
Function of [:X | {x}, Y:], Y st f = pr2({x}, the carrier of Y) holds f" = <:Y
  --> x, id Y:>;

theorem 
  for X, Y being non empty TopSpace, x being Point of X, f being
  Function of [:Y, X | {x}:], Y st f = pr1(the carrier of Y, {x}) holds f is
  being_homeomorphism;

theorem 
  for X, Y being non empty TopSpace, x being Point of X, f being
  Function of [:X | {x}, Y:], Y st f = pr2({x}, the carrier of Y) holds f is
  being_homeomorphism;

begin 

theorem 
  for X being non empty TopSpace, Y being compact non empty TopSpace, G
being open Subset of [:X, Y:], x being set st [:{x}, the carrier of Y:] c= G ex
  f being ManySortedSet of the carrier of Y st for i being set st i in the
carrier of Y ex G1 being Subset of X, H1 being Subset of Y st f.i = [G1,H1] & [
  x, i] in [:G1, H1:] & G1 is open & H1 is open & [:G1, H1:] c= G;

theorem 
  for X being non empty TopSpace, Y being compact non empty
TopSpace, G being open Subset of [:Y, X:] holds for x being set st [:[#]Y, {x}
:] c= G holds ex R be open Subset of X st x in R & R c= { y where y is Point of
X: [:[#]Y, {y}:] c= G };

theorem 
  for X being non empty TopSpace, Y being compact non empty
TopSpace, G being open Subset of [:Y, X:] holds { x where x is Point of X : [:
  [#]Y, {x}:] c= G } in the topology of X;

theorem 
  for X, Y being non empty TopSpace, x being Point of X holds [: X
  | {x}, Y :], Y are_homeomorphic;

theorem 
  for S, T being non empty TopSpace st S, T are_homeomorphic & S
  is compact holds T is compact;

theorem 
  for X, Y being TopSpace, XV being SubSpace of X holds [:Y, XV:]
  is SubSpace of [:Y, X:];

theorem 
  for X being non empty TopSpace, Y being compact non empty
  TopSpace, x being Point of X, Z being Subset of [:Y, X:] st Z = [:[#]Y, {x}:]
  holds Z is compact;

registration
  let X be non empty TopSpace, Y be compact non empty TopSpace,
      x be Point of X;
  cluster [:Y, X|{x}:] -> compact;
end;

theorem 
  for X, Y being compact non empty TopSpace, R being Subset-Family of X
st R = { Q where Q is open Subset of X : [:[#]Y, Q:] c= union Base-Appr [#][:Y,
  X:] } holds R is open & R is Cover of [#]X;

theorem 
  for X, Y being compact non empty TopSpace, R being Subset-Family
of X, F being Subset-Family of [:Y, X:] st F is Cover of [:Y, X:] & F is open &
R = { Q where Q is open Subset of X : ex FQ being Subset-Family of [:Y, X:] st
FQ c= F & FQ is finite & [:[#]Y, Q:] c= union FQ } holds R is open & R is Cover
  of X;

theorem 
  for X, Y being compact non empty TopSpace, R being Subset-Family
of X, F being Subset-Family of [:Y, X:] st F is Cover of [:Y, X:] & F is open &
R = { Q where Q is open Subset of X : ex FQ being Subset-Family of [:Y, X:] st
  FQ c= F & FQ is finite & [:[#]Y, Q:] c= union FQ } holds ex C being
  Subset-Family of X st C c= R & C is finite & C is Cover of X;

theorem 
  for X, Y being compact non empty TopSpace, F being Subset-Family
  of [:Y, X:] st F is Cover of [:Y, X:] & F is open ex G being Subset-Family of
  [:Y, X:] st G c= F & G is Cover of [:Y, X:] & G is finite;

registration
  let T1,T2 be compact TopSpace;
  cluster [:T1, T2:] -> compact;
end;

theorem 
  for X, Y being TopSpace, XV being SubSpace of X, YV being
  SubSpace of Y holds [:XV, YV:] is SubSpace of [:X, Y:];

theorem 
  for X, Y being TopSpace, Z being Subset of [:Y, X:], V being
Subset of X, W being Subset of Y st Z = [:W, V:] holds the TopStruct of [:Y | W
  , X | V:] = the TopStruct of [:Y, X:] | Z;

registration
  let T be TopSpace;
  cluster empty for Subset of T;
end;

registration
  let T be TopSpace, P be compact Subset of T;
  cluster T | P -> compact;
end;

theorem 
  for T1, T2 being TopSpace, S1 being Subset of T1, S2 being Subset of
T2 st S1 is compact & S2 is compact holds [:S1, S2:] is compact Subset of [:T1,
  T2:];














begin

definition
  let N be Nat;
  mode Real_Sequence of N is sequence of TOP-REAL N;
end;

reserve N,n,m,n1,n2 for Element of NAT;
reserve q,r,r1,r2 for Real;
reserve x,y for set;
reserve w,w1,w2,g,g1,g2 for Point of TOP-REAL N;
reserve seq,seq1,seq2,seq3,seq9 for Real_Sequence of N;

theorem 
  for f being Function holds f is Real_Sequence of N iff (dom f=NAT
  & for n holds f.n is Point of TOP-REAL N);

definition
  let N;
  let IT be Real_Sequence of N;
  attr IT is non-zero means


  rng IT c= NonZero TOP-REAL N;
end;

theorem 
  seq is non-zero iff for x st x in NAT holds seq.x<>0.TOP-REAL N;

theorem 
  seq is non-zero iff for n holds seq.n<>0.TOP-REAL N;

definition
  let N be Nat,seq1,seq2 be Real_Sequence of N;
  func seq1 + seq2 -> Real_Sequence of N equals

  seq1 + seq2;
end;

definition
  let r;
  let N be Nat,seq be Real_Sequence of N;
  func r * seq -> Real_Sequence of N equals

  r(#)seq;
end;

definition
  let N be Nat,seq be Real_Sequence of N;
  func - seq -> Real_Sequence of N equals

  - seq;
end;

definition
  let N be Nat,seq1,seq2 be Real_Sequence of N;
  func seq1 - seq2 -> Real_Sequence of N equals

  seq1 +- seq2;
end;

definition

  let N be Nat,seq be Real_Sequence of N;
  func |.seq.| -> Real_Sequence means


  for n holds it.n = |.seq.n.|;
end;

theorem 
  for N,n be Nat,seq1,seq2 be Real_Sequence of N holds
  (seq1+seq2).n = seq1.n + seq2.n;

theorem 
  for N,n be Nat,seq be Real_Sequence of N holds
  (r*seq).n = r*seq.n;

theorem 
  for N,n be Nat,seq be Real_Sequence of N holds
  (-seq).n = -seq.n;

theorem 
  abs(r)*|.w.| = |.r*w.|;

theorem 
  |.r*seq.| = abs(r)(#)|.seq.|;

theorem 
  seq1 + seq2 = seq2 + seq1;

theorem 
  (seq1 + seq2) + seq3 = seq1 + (seq2 + seq3);

theorem 
  -seq = (-1)*seq;

theorem 
  r*(seq1 + seq2) = r*seq1 + r*seq2;

theorem 
  (r*q)*seq = r*(q*seq);

theorem 
  r*(seq1 - seq2) = r*seq1 - r*seq2;

theorem 
  seq1 - (seq2 + seq3) = seq1 - seq2 - seq3;

theorem 
  1*seq=seq;

theorem 
  -(-seq) = seq;

theorem 
  seq1 - (-seq2) = seq1 + seq2;

theorem 
  seq1 - (seq2 - seq3) = seq1 - seq2 + seq3;

theorem 
  seq1 + (seq2 - seq3) = seq1 + seq2 - seq3;

theorem 
  r <> 0 & seq is non-zero implies r*seq is non-zero;

theorem 
  seq is non-zero implies -seq is non-zero;

theorem 
  |.0.TOP-REAL N.| = 0;

theorem 
  |.w.| = 0 implies w = 0.TOP-REAL N;

theorem 
  |.w.| >= 0;

theorem 
  |.-w.| = |.w.|;

theorem 
  |.w1 - w2.| = |.w2 - w1.|;

theorem 
  |.w1 - w2.| = 0 iff w1 = w2;

theorem 
  |.w1 + w2.| <= |.w1.| + |.w2.|;

theorem 
  |.w1 - w2.| <= |.w1.| + |.w2.|;

theorem 
  |.w1.| - |.w2.| <= |.w1 + w2.|;

theorem 
  |.w1.| - |.w2.| <= |.w1 - w2.|;

theorem 
  w1 <> w2 implies |.w1 - w2.| > 0;

theorem 
  |.w1 - w2.| <= |.w1 - w.| + |.w - w2.|;

definition
  let N;
  let IT be Real_Sequence of N;
  attr IT is bounded means


  ex r st for n holds |.IT.n.| < r;
end;

theorem 
  for n ex r st (0<r & for m st m<=n holds |.seq.m.| < r);

definition
  let N;
  let IT be Real_Sequence of N;
  attr IT is convergent means


  ex g st for r st 0<r ex n st for m st n<= m holds |.IT.m-g.| < r;
end;

definition
  let N,seq;
  assume
 seq is convergent;
  func lim seq -> Point of TOP-REAL N means


  for r st 0<r ex n st for m st n<=m holds |.seq.m-it.| < r;
end;

theorem 
  seq is convergent & seq9 is convergent implies seq + seq9 is convergent;

theorem 
  seq is convergent & seq9 is convergent implies lim (seq + seq9)=
  (lim seq)+(lim seq9);

theorem 
  seq is convergent implies r*seq is convergent;

theorem 
  seq is convergent implies lim(r*seq)=r*(lim seq);

theorem 
  seq is convergent implies - seq is convergent;

theorem 
  seq is convergent implies lim(-seq)=-(lim seq);

theorem 
  seq is convergent & seq9 is convergent implies seq - seq9 is convergent;

theorem 
  seq is convergent & seq9 is convergent implies
  lim(seq - seq9) = (lim seq)-(lim seq9);

theorem 
  seq is convergent implies seq is bounded;

theorem 
  seq is convergent implies ((lim seq) <> 0.TOP-REAL N implies ex n st
  for m st n<=m holds |.(lim seq).|/2 < |.seq.m.|);














begin



reserve A,B,C,D for Category,
  F for Functor of A,B,
  G for Functor of B,C;

canceled 2;

theorem 
 for a,b being Object of A
  for f being Morphism of a,b st f is invertible holds F/.f is invertible;

theorem 
  for F1,F2 being Functor of A,B st F1 is_transformable_to F2 for t
being transformation of F1,F2, a being Object of A holds t.a in Hom(F1.a,F2.a);

theorem 
  for F1,F2 being Functor of A,B, G1,G2 being Functor of B,C st F1
  is_transformable_to F2 & G1 is_transformable_to G2 holds G1*F1
  is_transformable_to G2*F2;

theorem 
  for F1,F2 being Functor of A,B st F1 is_transformable_to F2 for t
being transformation of F1,F2 st t is invertible for a being Object of A holds
  F1.a, F2.a are_isomorphic;

definition
  let C,D;
  redefine mode Functor of C,D means

    (for c being Object of C ex d being
Object of D st it.id c = id d) & (for f being Morphism of C holds it.id dom f =
id dom(it.f) & it.id cod f = id cod(it.f)) & for f,g being Morphism of C st dom
    g = cod f holds it.(g(*)f) = (it.g)(*)(it.f);
end;

reserve o,m for set;

theorem 
  F is isomorphic implies for g being Morphism of B ex f being
  Morphism of A st F.f = g;

theorem 
  F is isomorphic implies for b being Object of B ex a being
  Object of A st F.a = b;

theorem 
  F is one-to-one implies Obj F is one-to-one;

definition
  let A,B,F;
  assume
 F is isomorphic;
  func F" -> Functor of B,A equals


  F";
end;

definition
  let A,B,F;
  redefine attr F is isomorphic means


  F is one-to-one & rng F = the carrier' of B;
end;

theorem 
  F is isomorphic implies F" is isomorphic;

theorem 
  F is isomorphic implies (Obj F)" = Obj F";

theorem 
  F is isomorphic implies F"" = F;

theorem 
  F is isomorphic implies F*F" = id B & F"*F = id A;

theorem 
  F is isomorphic & G is isomorphic implies G*F is isomorphic;



definition
  let A,B;
  pred A,B are_isomorphic means

  ex F being Functor of A,B st F is isomorphic;
  reflexivity;
  symmetry;
end;

notation
  let A,B;
  synonym A ~= B for A,B are_isomorphic;
end;

theorem 
  A ~= B & B ~= C implies A ~= C;

theorem 
  [:1Cat(o,m),A:] ~= A;

theorem 
  [:A,B:] ~= [:B,A:];

theorem 
  [:[:A,B:],C:] ~= [:A,[:B,C:]:];

theorem 
  A ~= B & C ~= D implies [:A,C:] ~= [:B,D:];

definition
  let A,B,C;
  let F1,F2 be Functor of A,B such that
 F1 is_transformable_to F2;
  let t be transformation of F1,F2;
  let G be Functor of B,C;
  func G*t -> transformation of G*F1,G*F2 equals


  G*t;
end;

definition
  let A,B,C;
  let G1,G2 be Functor of B,C such that
 G1 is_transformable_to G2;
  let F be Functor of A,B;
  let t be transformation of G1,G2;
  func t*F -> transformation of G1*F,G2*F equals


  t*Obj F;
end;

theorem 
  for G1,G2 be Functor of B,C st G1 is_transformable_to G2 for F
be Functor of A,B, t be transformation of G1,G2, a be Object of A holds (t*F).a
  = t.(F.a);

theorem 
  for F1,F2 be Functor of A,B st F1 is_transformable_to F2 for t
be transformation of F1,F2, G be Functor of B,C, a being Object of A
  holds (G*t).a = G/.(t.a);

theorem 
  for F1,F2 being Functor of A,B, G1,G2 being Functor of B,C st F1
is_naturally_transformable_to F2 & G1 is_naturally_transformable_to G2 holds G1
  *F1 is_naturally_transformable_to G2*F2;

definition
  let A,B,C;
  let F1,F2 be Functor of A,B such that
 F1 is_naturally_transformable_to F2;
  let t be natural_transformation of F1,F2;
  let G be Functor of B,C;
  func G*t -> natural_transformation of G*F1,G*F2 equals


  G*t;
end;

theorem 
  for F1,F2 be Functor of A,B st F1 is_naturally_transformable_to
  F2 for t be natural_transformation of F1,F2, G be Functor of B,C, a being
  Object of A holds (G*t).a = G/.(t.a);

definition
  let A,B,C;
  let G1,G2 be Functor of B,C such that
 G1 is_naturally_transformable_to G2;
  let F be Functor of A,B;
  let t be natural_transformation of G1,G2;
  func t*F -> natural_transformation of G1*F,G2*F equals


  t*F;
end;

theorem 
  for G1,G2 be Functor of B,C st G1 is_naturally_transformable_to
  G2 for F be Functor of A,B, t be natural_transformation of G1,G2, a be Object
  of A holds (t*F).a = t.(F.a);

reserve F,F1,F2,F3 for Functor of A,B,
  G,G1,G2,G3 for Functor of B,C,
  H,H1,H2 for Functor of C,D,
  s for natural_transformation of F1,F2,
  s9 for natural_transformation of F2,F3,
  t for natural_transformation of G1,G2,
  t9 for natural_transformation of G2,G3,
  u for natural_transformation of H1,H2;

theorem 
  F1 is_naturally_transformable_to F2 implies for a being Object
  of A holds Hom(F1.a,F2.a) <> {};

theorem 
  F1 is_naturally_transformable_to F2 implies for t1,t2 being
  natural_transformation of F1,F2 st for a being Object of A holds t1.a = t2.a
  holds t1 = t2;

theorem 
  F1 is_naturally_transformable_to F2 & F2
  is_naturally_transformable_to F3 implies G*(s9`*`s) = (G*s9)`*`(G*s);

theorem 
  G1 is_naturally_transformable_to G2 & G2
  is_naturally_transformable_to G3 implies (t9`*`t)*F = (t9*F)`*`(t*F);

theorem 
  H1 is_naturally_transformable_to H2 implies u*G*F = u*(G*F);

theorem 
  G1 is_naturally_transformable_to G2 implies H*t*F = H*(t*F);

theorem 
  F1 is_naturally_transformable_to F2 implies H*G*s = H*(G*s);

theorem 
  (id G)*F = id(G*F);

theorem 
  G*id F = id(G*F);

theorem 
  G1 is_naturally_transformable_to G2 implies t*id B = t;

theorem 
  F1 is_naturally_transformable_to F2 implies (id B)*s = s;

definition
  let A,B,C,F1,F2,G1,G2;
  let s,t;
  func t(#)s -> natural_transformation of G1*F1,G2*F2 equals

  (t*F2)`*`(G1*s);
end;

theorem 
  F1 is_naturally_transformable_to F2 & G1
  is_naturally_transformable_to G2 implies t(#)s = (G2*s)`*`(t*F1);

theorem 
  F1 is_naturally_transformable_to F2 implies (id id B)(#)s = s;

theorem 
  G1 is_naturally_transformable_to G2 implies t(#)(id id B) = t;

theorem 
  F1 is_naturally_transformable_to F2 & G1 is_naturally_transformable_to
  G2 & H1 is_naturally_transformable_to H2 implies u(#)(t(#)s) = (u(#)t)(#)s;

theorem 
  G1 is_naturally_transformable_to G2 implies t*F = t(#)id F;

theorem 
  F1 is_naturally_transformable_to F2 implies G*s = (id G)(#)s;

theorem 
  F1 is_naturally_transformable_to F2 & F2 is_naturally_transformable_to
F3 & G1 is_naturally_transformable_to G2 & G2 is_naturally_transformable_to G3
  implies (t9`*`t)(#)(s9`*`s) = (t9(#)s9)`*`(t(#)s);

theorem 
  for F being Functor of A,B, G being Functor of C,D for I,J being
  Functor of B,C st I ~= J holds G*I ~= G*J & I*F ~= J*F;

theorem 
  for F being Functor of A,B, G being Functor of B,A for I being
  Functor of A,A st I ~= id A holds F*I ~= F & I*G ~= G;

definition
  let A,B be Category;
  pred A is_equivalent_with B means


  ex F being Functor of A,B, G being
  Functor of B,A st G*F ~= id A & F*G ~= id B;
  reflexivity;
  symmetry;
end;

notation
  let A,B be Category;
  synonym A,B are_equivalent for A is_equivalent_with B;
end;

theorem 
  A ~= B implies A is_equivalent_with B;

theorem 
  A,B are_equivalent & B,C are_equivalent implies A,C are_equivalent;

definition
  let A,B;
  assume
 A,B are_equivalent;
  mode Equivalence of A,B -> Functor of A,B means


    ex G being Functor of B,A st G*it ~= id A & it*G ~= id B;
end;

theorem 
  id A is Equivalence of A,A;

theorem 
  A,B are_equivalent & B,C are_equivalent implies for F being
Equivalence of A,B, G being Equivalence of B,C holds G*F is Equivalence of A,C;

theorem 
  A,B are_equivalent implies for F being Equivalence of A,B ex G
  being Equivalence of B,A st G*F ~= id A & F*G ~= id B;

theorem 
  for F being Functor of A,B, G being Functor of B,A st G*F ~= id
  A holds F is faithful;

theorem 
  A,B are_equivalent implies for F being Equivalence of A,B holds F is
full & F is faithful & for b being Object of B ex a being Object of A st b, F.a
  are_isomorphic;





definition let C be Category;
 func IdMap C -> Function of the carrier of C, the carrier' of C means

  for o being Object of C holds it.o = id o;
end;
















begin

reserve x,y for set;
reserve D for non empty set;
reserve UN for Universe;





definition
  let G,H be non empty doubleLoopStr;
  let IT be Function of G,H;

  attr IT is linear means


  IT is additive multiplicative unity-preserving;
end;

registration
  let G,H be non empty doubleLoopStr;
  cluster linear -> additive multiplicative unity-preserving for
Function of G,H;
  cluster additive multiplicative unity-preserving -> linear for
Function of G,H;
end;

theorem 
  for G1,G2,G3 being non empty doubleLoopStr, f being Function of
  G1,G2, g being Function of G2,G3 st f is linear & g is linear holds g*f is
  linear;





definition
  struct RingMorphismStr (# Dom,Cod -> Ring, Fun -> Function of the Dom, the
    Cod #);
end;

reserve f for RingMorphismStr;

definition
  let f;
  func dom(f) -> Ring equals

  the Dom of f;
  func cod(f) -> Ring equals

  the Cod of f;
  func fun(f) -> Function of the Dom of f, the Cod of f equals

  the Fun of f;
end;

reserve G,H,G1,G2,G3,G4 for Ring;

registration
  let G be non empty doubleLoopStr;
  cluster id G -> linear;
end;

definition
  let IT be RingMorphismStr;
  attr IT is RingMorphism-like means


  fun(IT) is linear;
end;

registration
  cluster strict RingMorphism-like for RingMorphismStr;
end;

definition
  mode RingMorphism is RingMorphism-like RingMorphismStr;
end;

definition
  let G;
  func ID G -> RingMorphism equals

  RingMorphismStr(# G,G,id G#);
end;

registration
  let G;
  cluster ID G -> strict;
end;

reserve F for RingMorphism;

definition
  let G,H;
  pred G <= H means


  ex F being RingMorphism st dom(F) = G & cod(F) = H;
  reflexivity;
end;

definition
  let G,H;
  assume
 G <= H;
  mode Morphism of G,H -> strict RingMorphism means


    dom(it) = G & cod( it) = H;
end;

registration
  let G,H;
  cluster strict for Morphism of G,H;
end;

definition
  let G;
  redefine func ID G -> strict Morphism of G,G;
end;

theorem 
  for g,f being RingMorphism st dom(g) = cod(f) ex G1,G2,G3 st G1
  <= G2 & G2 <= G3 & the RingMorphismStr of g is Morphism of G2,G3 & the
  RingMorphismStr of f is Morphism of G1,G2;

theorem 
  for F being strict RingMorphism holds F is Morphism of dom(F),cod
  (F) & dom(F) <= cod(F);

theorem 
  for F being strict RingMorphism ex G,H st ex f being Function of G,H
  st F is Morphism of G,H & F = RingMorphismStr(#G,H,f#) & f is linear;

definition
  let G,F be RingMorphism;
  assume
 dom(G) = cod(F);
  func G*F -> strict RingMorphism means


  for G1,G2,G3 for g being
  Function of G2,G3, f being Function of G1,G2 st the RingMorphismStr of G =
RingMorphismStr(#G2,G3,g#) & the RingMorphismStr of F = RingMorphismStr(#G1,G2,
    f#) holds it = RingMorphismStr(#G1,G3,g*f#);
end;

theorem 
  G1 <= G2 & G2 <= G3 implies G1 <= G3;

theorem 
  for G being Morphism of G2,G3, F being Morphism of G1,G2 st G1 <=
  G2 & G2 <= G3 holds G*F is Morphism of G1,G3;

definition
  let G1,G2,G3;
  let G be Morphism of G2,G3, F be Morphism of G1,G2;
  assume
 G1 <= G2 & G2 <= G3;
  func G*'F -> strict Morphism of G1,G3 equals


  G*F;
end;

theorem 
  for f,g being strict RingMorphism st dom g = cod f holds ex G1,
  G2,G3 st ex f0 being Function of G1,G2, g0 being Function of G2,G3 st f =
  RingMorphismStr(#G1,G2,f0#) & g = RingMorphismStr(#G2,G3,g0#) & g*f =
  RingMorphismStr(#G1,G3,g0*f0#);

theorem 
  for f,g being strict RingMorphism st dom g = cod f holds dom(g*f
  ) = dom f & cod (g*f) = cod g;

theorem 
  for f being Morphism of G1,G2, g being Morphism of G2,G3, h
being Morphism of G3,G4 st G1 <= G2 & G2 <= G3 & G3 <= G4 holds h*(g*f) = (h*g)
  *f;

theorem 
  for f,g,h being strict RingMorphism st dom h = cod g & dom g =
  cod f holds h*(g*f) = (h*g)*f;

theorem 
  dom ID(G) = G & cod ID(G) = G & (for f being strict RingMorphism
st cod f = G holds (ID G)*f = f) & for g being strict RingMorphism st dom g = G
  holds g*(ID G) = g;





definition
  let IT be set;
  attr IT is Ring_DOMAIN-like means


  for x being Element of IT holds x is strict Ring;
end;

registration
  cluster Ring_DOMAIN-like non empty for set;
end;

definition
  mode Ring_DOMAIN is Ring_DOMAIN-like non empty set;
end;

reserve V for Ring_DOMAIN;

definition
  let V;
  redefine mode Element of V -> Ring;
end;

registration
  let V;
  cluster strict for Element of V;
end;

definition
  let IT be set;
  attr IT is RingMorphism_DOMAIN-like means


  for x being set st x in IT holds x is strict RingMorphism;
end;

registration
  cluster RingMorphism_DOMAIN-like for non empty set;
end;

definition
  mode RingMorphism_DOMAIN is RingMorphism_DOMAIN-like non empty set;
end;

definition
  let M be RingMorphism_DOMAIN;
  redefine mode Element of M -> RingMorphism;
end;

registration
  let M be RingMorphism_DOMAIN;
  cluster strict for Element of M;
end;

theorem 
  for f being strict RingMorphism holds {f} is RingMorphism_DOMAIN;

definition
  let G,H;
  mode RingMorphism_DOMAIN of G,H -> RingMorphism_DOMAIN means


    for x being Element of it holds x is Morphism of G,H;
end;

theorem 
  D is RingMorphism_DOMAIN of G,H iff for x being Element of D
  holds x is Morphism of G,H;

theorem 
  for f being Morphism of G,H holds {f} is RingMorphism_DOMAIN of G,H;

definition
  let G,H;
  assume
 G <= H;
  func Morphs(G,H) -> RingMorphism_DOMAIN of G,H means


  x in it iff x is Morphism of G,H;
end;

definition
  let G,H;
  let M be RingMorphism_DOMAIN of G,H;
  redefine mode Element of M -> Morphism of G,H;
end;

registration
  let G,H;
  let M be RingMorphism_DOMAIN of G,H;
  cluster strict for Element of M;
end;





definition
  let x,y;
  pred GO x,y means


  ex x1,x2,x3,x4,x5,x6 being set st x = [[x1,x2,x3,x4],x5,x6] &
   ex G being strict Ring st y = G & x1 = the carrier of G & x2 = the
  addF of G & x3 = comp G & x4 = 0.G & x5 = the multF of G & x6 = 1.G;
end;

theorem 
  for x,y1,y2 being set st GO x,y1 & GO x,y2 holds y1 = y2;

theorem 
  ex x st x in UN & GO x,Z_3;

definition
  let UN;
  func RingObjects(UN) -> set means


  for y holds y in it iff ex x st x in UN & GO x,y;
end;

theorem 
  Z_3 in RingObjects(UN);

registration
  let UN;
  cluster RingObjects(UN) -> non empty;
end;

theorem 
  for x being Element of RingObjects(UN) holds x is strict Ring;

registration
  let UN;
  cluster RingObjects(UN) -> Ring_DOMAIN-like;
end;





definition
  let V;
  func Morphs(V) -> RingMorphism_DOMAIN means


  x in it iff ex G,H being Element of V st G <= H & x is Morphism of G,H;
end;





definition
  let V;
  let F be Element of Morphs(V);
  redefine func dom(F) -> Element of V;
  redefine func cod(F) -> Element of V;
end;

definition
  let V;
  let G be Element of V;
   func ID(G) -> strict Element of Morphs(V) equals

   ID(G);
 canceled;
end;

definition
  let V;
  func dom(V) -> Function of Morphs(V),V means


  for f being Element of Morphs(V) holds it.f = dom(f);
  func cod(V) -> Function of Morphs(V),V means


  for f being Element of Morphs(V) holds it.f = cod(f);
 canceled;
end;





theorem 
  for g,f being Element of Morphs(V) st dom(g) = cod(f) ex G1,G2,
  G3 being Element of V st G1 <= G2 & G2 <= G3 & g is Morphism of G2,G3 & f is
  Morphism of G1,G2;

theorem 
  for g,f being Element of Morphs(V) st dom(g) = cod(f) holds g*f in Morphs(V);

definition
  let V;
  func comp(V) -> PartFunc of [:Morphs(V),Morphs(V):],Morphs(V) means


(for g,f being Element of Morphs(V) holds [g,f] in dom it iff dom(g) = cod(f))
  & for g,f being Element of Morphs(V) st [g,f] in dom it holds it.(g,f) = g*f;
end;





definition
  let UN;
  func RingCat(UN) -> CatStr equals

  CatStr(#RingObjects UN,Morphs RingObjects UN,
    dom RingObjects UN,cod RingObjects UN, comp RingObjects UN#);
end;

registration
  let UN;
  cluster RingCat(UN) -> strict non void non empty;
end;

theorem 
  for f,g being Morphism of RingCat(UN) holds [g,f] in dom(the
  Comp of RingCat(UN)) iff dom g = cod f;

theorem 
  for f being (Morphism of RingCat(UN)), f9 being Element of
  Morphs(RingObjects(UN)), b being Object of RingCat(UN), b9 being Element of
  RingObjects(UN) holds f is strict Element of Morphs(RingObjects(UN)) & f9 is
Morphism of RingCat(UN) & b is strict Element of RingObjects(UN) & b9 is Object
  of RingCat(UN);

canceled;

theorem 
  for f,g being (Morphism of RingCat(UN)), f9,g9 being Element of
  Morphs(RingObjects(UN)) st f = f9 & g = g9 holds (dom g = cod f iff dom g9 =
  cod f9) & (dom g = cod f iff [g9,f9] in dom comp(RingObjects(UN))) & (dom g =
cod f implies g(*)f = g9*f9) & (dom f = dom g iff dom f9 = dom g9) &
(cod f = cod
  g iff cod f9 = cod g9);

registration
  let UN;
  cluster RingCat(UN) -> Category-like
     transitive associative reflexive;
end;

registration
  let UN;
  cluster RingCat(UN) -> with_identities;
end;

theorem 
  for a being Object of RingCat(UN), aa being Element of
  RingObjects(UN) st a = aa holds id a = ID aa;














begin

reserve x,y for set;
reserve D for non empty set;
reserve UN for Universe;
reserve R for Ring;
reserve G,H for LeftMod of R;





definition
  let R;
  mode LeftMod_DOMAIN of R -> non empty set means


    for x being Element of it holds x is strict LeftMod of R;
end;

reserve V for LeftMod_DOMAIN of R;

definition
  let R,V;
  redefine mode Element of V -> LeftMod of R;
end;

registration
  let R,V;
  cluster strict for Element of V;
end;

definition
  let R;
  mode LModMorphism_DOMAIN of R -> non empty set means


    for x being Element of it holds x is strict LModMorphism of R;
end;

definition
  let R;
  let M be LModMorphism_DOMAIN of R;
  redefine mode Element of M -> LModMorphism of R;
end;

registration
  let R;
  let M be LModMorphism_DOMAIN of R;
  cluster strict for Element of M;
end;

theorem 
  for f being strict LModMorphism of R holds {f} is LModMorphism_DOMAIN of R;

definition
  let R,G,H;
  mode LModMorphism_DOMAIN of G,H -> LModMorphism_DOMAIN of R means


    for x being Element of it holds x is strict Morphism of G,H;
end;

theorem 
  D is LModMorphism_DOMAIN of G,H iff for x being Element of D
  holds x is strict Morphism of G,H;

theorem 
  for f being strict Morphism of G,H holds {f} is LModMorphism_DOMAIN of G,H;

definition
  let R,G,H;
  func Morphs(G,H) -> LModMorphism_DOMAIN of G,H means


  x in it iff x is strict Morphism of G,H;
end;

definition
  let R,G,H;
  let M be LModMorphism_DOMAIN of G,H;
  redefine mode Element of M -> Morphism of G,H;
end;





definition
  let x,y,R;
  pred GO x,y,R means


  ex x1,x2 being set st x = [x1,x2] & ex G being
strict LeftMod of R st y = G & x1 = the addLoopStr of G & x2 = the lmult of G;
end;

theorem 
  for x,y1,y2 being set st GO x,y1,R & GO x,y2,R holds y1 = y2;

theorem 
  for UN ex x st x in {[G,f] where G is Element of GroupObjects(UN)
, f is Element of Funcs([:the carrier of R,1:],1) : not contradiction} & GO x,
  TrivialLMod(R),R;

definition
  let UN,R;
  func LModObjects(UN,R) -> set means


  for y holds y in it iff ex x st x
  in {[G,f] where G is Element of GroupObjects(UN), f is Element of Funcs([:the
  carrier of R,1:],1) : not contradiction} & GO x,y,R;
end;

theorem 
  TrivialLMod(R) in LModObjects(UN,R);

registration
  let UN,R;
  cluster LModObjects(UN,R) -> non empty;
end;

theorem 
  for x being Element of LModObjects(UN,R) holds x is strict LeftMod of R;

definition
  let UN,R;
  redefine func LModObjects(UN,R) -> LeftMod_DOMAIN of R;
end;





definition
  let R,V;
  func Morphs(V) -> LModMorphism_DOMAIN of R means


  for x holds x in it
  iff ex G,H being strict Element of V st x is strict Morphism of G,H;
end;





definition
  let R,V;
  let F be Element of Morphs(V);
  func dom'(F) -> Element of V equals

  dom(F);
  func cod'(F) -> Element of V equals

  cod(F);
end;

definition
  let R,V;
  let G be Element of V;
  func ID(G) -> strict Element of Morphs(V) equals

  ID(G);
end;

definition
  let R,V;
  func dom(V) -> Function of Morphs(V),V means


  for f being Element of Morphs(V) holds it.f = dom'(f);
  func cod(V) -> Function of Morphs(V),V means


  for f being Element of Morphs(V) holds it.f = cod'(f);
 canceled;
end;





theorem 
  for g,f being Element of Morphs(V) st dom'(g) = cod'(f) ex G1,G2
,G3 being strict Element of V st g is Morphism of G2,G3 & f is Morphism of G1,
  G2;

theorem 
  for g,f being Element of Morphs(V) st dom'(g) = cod'(f) holds g*
  f in Morphs(V);

theorem 
  for g,f being Element of Morphs(V) st dom(g) = cod(f) holds g*f in Morphs(V);

definition
  let R,V;
  func comp(V) -> PartFunc of [:Morphs(V),Morphs(V):],Morphs(V) means


(for g,f being Element of Morphs(V) holds [g,f] in dom it iff dom'(g) = cod'(f)
) & for g,f being Element of Morphs(V) st [g,f] in dom it holds it.(g,f) = g*f;
end;

theorem 
  for g,f being Element of Morphs(V) holds [g,f] in dom comp(V)
  iff dom(g) = cod(f);





definition
  let UN,R;
  func LModCat(UN,R) -> strict CatStr equals

  CatStr(#LModObjects(UN,R),Morphs(
    LModObjects(UN,R)), dom(LModObjects(UN,R)),cod(LModObjects(UN,R)), comp(
    LModObjects(UN,R))

   #);
end;

registration
  let UN,R;
  cluster LModCat(UN,R) -> non void non empty;
end;

theorem 
  for f,g being Morphism of LModCat(UN,R) holds [g,f] in dom(the
  Comp of LModCat(UN,R)) iff dom g = cod f;

registration let UN,R;
 cluster -> strict for Element of Morphs LModObjects(UN,R);
end;

canceled 2;

theorem 
  for f being Morphism of LModCat(UN,R) for f9 being Element of
  Morphs(LModObjects(UN,R)) st f = f9 holds dom f = dom f9 & cod f = cod f9;

theorem 
  for f,g being (Morphism of LModCat(UN,R)), f9,g9 being Element
of Morphs(LModObjects(UN,R)) st f = f9 & g = g9 holds (dom g = cod f iff dom g9
= cod f9) & (dom g = cod f iff [g9,f9] in dom comp(LModObjects(UN,R))) & (dom g
  = cod f implies g(*)f = g9*f9) & (dom f = dom g iff dom f9 = dom g9) &
(cod f =
  cod g iff cod f9 = cod g9);

registration
  let UN,R;
  cluster LModCat(UN,R) -> Category-like
    transitive associative reflexive;
end;















begin 

reserve X for MetrSpace,
  x,y,z for Element of X,
  A for non empty set,
  G for Function of [:A,A:],REAL,
  f for Function,
  k,n,m,m1,m2 for Element of NAT,
  q,r for Real;

theorem 
  abs(dist(x,z) - dist(y,z)) <= dist(x,y);

theorem 
  G is_metric_of A implies for a,b being Element of A holds 0 <= G.(a,b);

theorem 
  G is_metric_of A iff G is Reflexive discerning symmetric triangle;

theorem 
  for X being strict non empty MetrSpace holds the distance of X is
  Reflexive discerning symmetric triangle;

theorem 
  G is_metric_of A iff (G is Reflexive discerning & for a,b,c being
  Element of A holds G.(b,c) <= G.(a,b) + G.(a,c));

definition
  let A, G;

  func bounded_metric(A,G) -> Function of [:A,A:],REAL means


  for a,b being Element of A holds it.(a,b) = G.(a,b)/(1 + G.(a,b));
end;

theorem 
  G is_metric_of A implies bounded_metric(A,G) is_metric_of A;



reserve X for non empty MetrSpace,
  x,y for Element of X,
  V for Subset of X,
  S,S1,T for sequence of X,
  Nseq for increasing sequence of NAT;

theorem 
  for x ex S st rng S = {x};

definition
  let X be non empty MetrStruct;
  let S be sequence of X;
  let x be Element of X;

  pred S is_convergent_in_metrspace_to x means


  for r st 0 < r ex m st for n st m <= n holds dist(S.n,x) < r;
end;

definition
  let X be symmetric triangle non empty MetrStruct;
  let V be Subset of X;
  redefine attr V is bounded means

 ex r being Real, x being Element of X st 0 < r & V c= Ball(x,r);
end;

definition
  let X be non empty MetrStruct;
  let S be sequence of X;
  attr S is bounded means


  ex r being Real, x being Element of X st 0 < r & rng S c= Ball(x,r);
end;

definition
  let X, V, S;
  pred V contains_almost_all_sequence S means


  ex m st for n st m <= n holds S.n in V;
end;

theorem 
  S is bounded iff ex r,x st (0 < r & for n holds S.n in Ball(x,r));

theorem 
  S is_convergent_in_metrspace_to x implies S is convergent;

theorem 
  S is convergent implies ex x st S is_convergent_in_metrspace_to x;

definition
  let X, S, x;

  func dist_to_point(S,x) -> Real_Sequence means


  for n holds it.n = dist(S.n,x);
end;

definition
  let X, S, T;
  func sequence_of_dist(S,T) -> Real_Sequence means


  for n holds it.n = dist(S.n,T.n);
end;

theorem 
  S is_convergent_in_metrspace_to x implies lim S = x;

theorem 
  S is_convergent_in_metrspace_to x iff S is convergent & lim S = x;

theorem 
  S is convergent implies ex x st S is_convergent_in_metrspace_to x & lim S = x
;

theorem 
  S is_convergent_in_metrspace_to x iff dist_to_point(S,x) is
  convergent & lim dist_to_point(S,x) = 0;

theorem 
  S is_convergent_in_metrspace_to x implies for r st 0 < r holds
  Ball(x,r) contains_almost_all_sequence S;

theorem 
  (for r st 0 < r holds Ball(x,r) contains_almost_all_sequence S)
  implies for V st x in V & V in Family_open_set X holds V
  contains_almost_all_sequence S;

theorem 
  (for V st x in V & V in Family_open_set X holds V
  contains_almost_all_sequence S) implies S is_convergent_in_metrspace_to x;

theorem 
  S is_convergent_in_metrspace_to x iff for r st 0 < r holds Ball(x,r)
  contains_almost_all_sequence S;

theorem 
  S is_convergent_in_metrspace_to x iff for V st x in V & V in
  Family_open_set X holds V contains_almost_all_sequence S;

theorem 
  (for r st 0 < r holds Ball(x,r) contains_almost_all_sequence S) iff
for V st x in V & V in Family_open_set X holds V contains_almost_all_sequence S
;

theorem 
  S is convergent & T is convergent implies dist(lim S,lim T) =
  lim sequence_of_dist(S,T);

theorem 
  S is_convergent_in_metrspace_to x & S is_convergent_in_metrspace_to y
  implies x = y;

theorem 
  S is constant implies S is convergent;

theorem 
  S is_convergent_in_metrspace_to x & S1 is subsequence of S implies S1
  is_convergent_in_metrspace_to x;

theorem 
  S is Cauchy & S1 is subsequence of S implies S1 is Cauchy;

theorem 
  S is constant implies S is Cauchy;

theorem 
  S is convergent implies S is bounded;

theorem 
  S is Cauchy implies S is bounded;

registration
  let M be non empty MetrSpace;
  cluster constant -> convergent for sequence of M;
  cluster Cauchy -> bounded for sequence of M;
end;

registration
  let M be non empty MetrSpace;
  cluster constant convergent Cauchy bounded for sequence of M;
end;



theorem 
 for X being symmetric triangle non empty Reflexive MetrStruct,
     V being bounded Subset of X, x being Element of X
  ex r being Real st 0 < r & V c= Ball(x,r);














begin 

reserve x,y,X,Y for set;
reserve M for Pnet;

definition
  let X,Y;
  assume
 X misses Y;

  func PTempty_f_net(X,Y) -> strict Pnet equals


  PT_net_Str (# X, Y, {}(X,Y), {}(Y,X) #);
end;

definition
  let X;
  func Tempty_f_net(X) -> strict Pnet equals

  PTempty_f_net(X,{});
  func Pempty_f_net(X) -> strict Pnet equals

  PTempty_f_net({},X);
end;

definition
  let x;
  func Tsingle_f_net(x) -> strict Pnet equals

  PTempty_f_net({},{x});
  func Psingle_f_net(x) -> strict Pnet equals

  PTempty_f_net({x},{});
end;

definition
  func empty_f_net -> strict Pnet equals

  PTempty_f_net({},{});
end;

theorem 
  X misses Y implies the carrier of PTempty_f_net(X,Y) = X &
  the carrier' of PTempty_f_net(X,Y) = Y &
    Flow PTempty_f_net(X,Y) = {};

theorem 
  the carrier of Tempty_f_net(X) = X &
  the carrier' of Tempty_f_net(X) = {} & Flow Tempty_f_net(X) = {};

theorem 
  for X holds the carrier of Pempty_f_net(X) = {} &
  the carrier' of Pempty_f_net(X) = X & Flow Pempty_f_net(X) = {};

theorem 
  for x holds the carrier of (Tsingle_f_net(x)) = {} &
  the carrier' of (Tsingle_f_net(x)) = {x} &
   Flow Tsingle_f_net x = {};

theorem 
  for x holds the carrier of (Psingle_f_net(x)) = {x} &
  the carrier' of (Psingle_f_net(x)) = {} &
   Flow (Psingle_f_net(x)) = {};

theorem 
  the carrier of empty_f_net = {} & the carrier' of empty_f_net = {} &
  Flow empty_f_net = {};

theorem 
  ( [x,y] in Flow M & x in the carrier' of M implies
  not x in the carrier of M & not y in the carrier' of M &
  y in the carrier of M) &
  ( [x,y] in Flow M & y in the carrier' of M implies
  not y in the carrier of M & not x in the carrier' of M &
  x in the carrier of M) &
  ( [x,y] in Flow M & x in the carrier of M implies
  not y in the carrier of M & not x in the carrier' of M &
  y in the carrier' of M) &
  ( [x,y] in Flow M & y in the carrier of M implies
  not x in the carrier of M & not y in the carrier' of M &
  x in the carrier' of M);

theorem 
  (Flow M) c= [:Elements(M), Elements(M):] &
  (Flow M)~ c= [:Elements(M), Elements(M):];

theorem 
  rng ((Flow M)|(the carrier' of M)) c= (the carrier of M) &
  rng ((Flow M)~|(the carrier' of M)) c= (the carrier of M) &
  rng ((Flow M)|(the carrier of M)) c= (the carrier' of M) &
  rng ((Flow M)~|(the carrier of M)) c= (the carrier' of M) &
  rng id(the carrier' of M) c= (the carrier' of M) &
  dom id(the carrier' of M) c= (the carrier' of M) &
  rng id(the carrier of M) c= (the carrier of M) &
  dom id(the carrier of M) c= (the carrier of M);

theorem 
  rng ((Flow M)|(the carrier' of M)) misses dom((Flow M)|(the carrier' of M)) &
  rng ((Flow M)|(the carrier' of M)) misses
  dom((Flow M)~|(the carrier' of M)) &
  rng ((Flow M)|(the carrier' of M)) misses
  dom(id(the carrier' of M)) &
  rng ((Flow M)~|(the carrier' of M)) misses
  dom((Flow M)|(the carrier' of M)) &
  rng ((Flow M)~|(the carrier' of M)) misses
  dom((Flow M)~|(the carrier' of M)) &
  rng ((Flow M)~|(the carrier' of M)) misses
  dom(id(the carrier' of M)) &
  dom ((Flow M)|(the carrier' of M)) misses
  rng((Flow M)|(the carrier' of M)) &
  dom ((Flow M)|(the carrier' of M)) misses
  rng((Flow M)~|(the carrier' of M)) &
  dom ((Flow M)|(the carrier' of M)) misses
  rng(id(the carrier of M)) &
  dom ((Flow M)~|(the carrier' of M)) misses
  rng((Flow M)|(the carrier' of M)) &
  dom ((Flow M)~|(the carrier' of M)) misses
  rng((Flow M)~|(the carrier' of M)) &
  dom ((Flow M)~|(the carrier' of M)) misses
  rng(id(the carrier of M)) & rng ((Flow M)|(the carrier of M)) misses
  dom((Flow M)|(the carrier of M)) &
  rng ((Flow M)|(the carrier of M)) misses
  dom((Flow M)~|(the carrier of M)) &
  rng ((Flow M)|(the carrier of M)) misses dom(id(the carrier of M)) &
  rng ((Flow M)~|(the carrier of M)) misses
  dom((Flow M)|(the carrier of M)) &
  rng ((Flow M)~|(the carrier of M)) misses
  dom((Flow M)~|(the carrier of M)) &
  rng ((Flow M)~|(the carrier of M)) misses dom(id(the carrier of M)) &
  dom ((Flow M)|(the carrier of M)) misses
  rng((Flow M)|(the carrier of M)) &
  dom ((Flow M)|(the carrier of M)) misses
  rng((Flow M)~|(the carrier of M)) &
  dom ((Flow M)|(the carrier of M)) misses
  rng(id(the carrier' of M)) &
  dom ((Flow M)~|(the carrier of M)) misses
  rng((Flow M)|(the carrier of M)) &
  dom ((Flow M)~|(the carrier of M)) misses
  rng((Flow M)~|(the carrier of M)) &
  dom ((Flow M)~|(the carrier of M)) misses
  rng(id(the carrier' of M));

theorem 
  ((Flow M)|(the carrier' of M)) * ((Flow M)|(the carrier' of M)) = {} &
  ((Flow M)~|(the carrier' of M)) *
  ((Flow M)~|(the carrier' of M)) = {} &
  ((Flow M)|(the carrier' of M)) *
  ((Flow M)~|(the carrier' of M)) = {} &
  ((Flow M)~|(the carrier' of M)) *
  ((Flow M)|(the carrier' of M)) = {} &
  ((Flow M)|(the carrier of M)) *
  ((Flow M)|(the carrier of M)) = {} &
  ((Flow M)~|(the carrier of M)) *
  ((Flow M)~|(the carrier of M)) = {} &
  ((Flow M)|(the carrier of M)) *
  ((Flow M)~|(the carrier of M)) = {} &
  ((Flow M)~|(the carrier of M)) *
  ((Flow M)|(the carrier of M)) = {};

theorem 
  ((Flow M)|(the carrier' of M)) *
  id(the carrier of M) = (Flow M)|(the carrier' of M) &
  ((Flow M)~|(the carrier' of M)) *
  id(the carrier of M) = (Flow M)~|(the carrier' of M) &
  (id(the carrier' of M) * ((Flow M)|(the carrier' of M))) =
  (Flow M)|(the carrier' of M) & (id(the carrier' of M) *
  ((Flow M)~|(the carrier' of M))) =
  (Flow M)~|(the carrier' of M) &
  ((Flow M)|(the carrier of M)) *
  id(the carrier' of M) = (Flow M)|(the carrier of M) &
  ((Flow M)~|(the carrier of M)) *
  id(the carrier' of M) = (Flow M)~|(the carrier of M) &
  (id(the carrier of M)) * ((Flow M)|(the carrier of M)) =
  (Flow M)|(the carrier of M) &
  (id(the carrier of M)) * ((Flow M)~|(the carrier of M)) =
  (Flow M)~|(the carrier of M) &
  ((Flow M)|(the carrier of M)) * id(the carrier' of M) =
  (Flow M)|(the carrier of M) &
  ((Flow M)~|(the carrier of M)) * id(the carrier' of M) =
  (Flow M)~|(the carrier of M) &
  (id(the carrier' of M) * ((Flow M)|(the carrier of M))) = {} &
  (id(the carrier' of M) * ((Flow M)~|(the carrier of M))) = {} &
  ((Flow M)|(the carrier of M)) * id(the carrier of M) = {} &
  ((Flow M)~|(the carrier of M)) * id(the carrier of M) = {} &
  (id(the carrier of M)) * ((Flow M)|(the carrier' of M)) = {} &
  (id(the carrier of M)) * ((Flow M)~|(the carrier' of M)) = {} &
  ((Flow M)|(the carrier' of M)) * (id(the carrier' of M)) = {} &
  ((Flow M)~|(the carrier' of M)) * (id(the carrier' of M)) = {};

theorem 
  ((Flow M)~|(the carrier' of M)) misses (id(Elements(M))) &
  ((Flow M)|(the carrier' of M)) misses (id(Elements(M))) &
  ((Flow M)~|(the carrier of M)) misses (id(Elements(M))) &
  ((Flow M)|(the carrier of M)) misses (id(Elements(M)));

theorem 
  ((Flow M)~|(the carrier' of M)) \/ (id(the carrier of M)) \ id(Elements(M)) =
  (Flow M)~|(the carrier' of M) &
  ((Flow M)|(the carrier' of M)) \/
  (id(the carrier of M)) \ id(Elements(M)) =
  (Flow M)|(the carrier' of M) &
  (((Flow M)~|(the carrier of M)) \/
  (id(the carrier of M))) \ id(Elements(M)) =
  (Flow M)~|(the carrier of M) &
   (((Flow M)|(the carrier of M)) \/
  (id(the carrier of M))) \ id(Elements(M)) =
  (Flow M)|(the carrier of M) & ((Flow M)~|(the carrier of M)) \/
  (id(the carrier' of M)) \ id(Elements(M)) =
  (Flow M)~|(the carrier of M) & ((Flow M)|(the carrier of M)) \/
  (id(the carrier' of M)) \ id(Elements(M)) =
  (Flow M)|(the carrier of M) &
  (((Flow M)~|(the carrier' of M)) \/
  (id(the carrier' of M))) \ id(Elements(M)) =
  (Flow M)~|(the carrier' of M) &
  (((Flow M)|(the carrier' of M)) \/
  (id(the carrier' of M))) \ id(Elements(M)) =
  (Flow M)|(the carrier' of M);

theorem 
  ((Flow M)|(the carrier of M))~ = ((Flow M)~)|(the carrier' of M) &
  ((Flow M)|(the carrier' of M))~ =
  ((Flow M)~)|(the carrier of M);

theorem 
  ((Flow M)|(the carrier of M)) \/ ((Flow M)|(the carrier' of M)) = (Flow M) &
  ((Flow M)|(the carrier' of M)) \/
  ((Flow M)|(the carrier of M)) = (Flow M) &
  (((Flow M)|(the carrier of M))~) \/
  (((Flow M)|(the carrier' of M))~) = (Flow M)~ &
  (((Flow M)|(the carrier' of M))~) \/
  (((Flow M)|(the carrier of M))~) = (Flow M)~;




definition
  let M;
  func f_enter(M) -> Relation equals

  ((Flow M)~|(the carrier' of M)) \/ id(the carrier of M);
  func f_exit(M) -> Relation equals

  ((Flow M)|(the carrier' of M)) \/ id(the carrier of M);
end;

theorem 
  f_exit(M) c= [:Elements(M),Elements(M):] &
  f_enter(M) c= [:Elements(M),Elements(M):];

theorem 
  dom(f_exit(M)) c= Elements(M) & rng(f_exit(M)) c= Elements(M) &
  dom(f_enter(M)) c= Elements(M) & rng(f_enter(M)) c= Elements(M);

theorem 
  (f_exit(M)) * (f_exit(M)) = f_exit(M) &
  (f_exit(M)) * (f_enter(M)) = f_exit(M) &
  (f_enter(M)) * (f_enter(M)) = f_enter(M) &
  (f_enter(M)) * (f_exit(M)) = f_enter(M);

theorem 
  (f_exit(M)) * (f_exit(M) \ id(Elements(M))) = {} &
  (f_enter(M)) * (f_enter(M) \ id(Elements(M))) = {};



definition
  let M;
  func f_prox(M) -> Relation equals

  ((Flow M)|(the carrier of M) \/
  (Flow M)~|(the carrier of M)) \/ id(the carrier of M);
  func f_flow(M) -> Relation equals

  (Flow M) \/ id(Elements(M));
end;

theorem 
  f_prox(M) * f_prox(M) = f_prox(M) &
  (f_prox(M) \ id(Elements(M))) * f_prox(M) = {} &
  (f_prox(M) \/ ((f_prox(M))~)) \/ id(Elements(M)) = f_flow(M) \/ (f_flow(M))~;



definition
  let M;
  func f_places(M) -> set equals

  the carrier of M;
  func f_transitions(M) -> set equals

  the carrier' of M;
  func f_pre(M) -> Relation equals

  (Flow M)|(the carrier' of M);
  func f_post(M) -> Relation equals

  (Flow M)~|(the carrier' of M);
end;

theorem 
  f_pre(M) c= [:f_transitions(M),f_places(M):] &
  f_post(M) c= [:f_transitions(M),f_places(M):];

theorem 
  f_prox(M) c= [:Elements(M), Elements(M):] &
  f_flow(M) c= [:Elements(M), Elements(M):];



definition
  let M;
  func f_entrance(M) -> Relation equals

  ((Flow M)~|(the carrier of M)) \/ id(the carrier' of M);
  func f_escape(M) -> Relation equals

  ((Flow M)|(the carrier of M)) \/ id(the carrier' of M);
end;

theorem 
  f_escape(M) c= [:Elements(M),Elements(M):] &
  f_entrance(M) c= [:Elements(M),Elements(M):];

theorem 
  dom(f_escape(M)) c= Elements(M) & rng(f_escape(M)) c= Elements(M) &
  dom(f_entrance(M)) c= Elements(M) & rng(f_entrance(M)) c= Elements(M);

theorem 
  (f_escape(M)) * (f_escape(M)) = f_escape(M) &
  (f_escape(M)) * (f_entrance(M)) = f_escape(M) &
  (f_entrance(M)) * (f_entrance(M)) =f_entrance(M) &
  (f_entrance(M)) * (f_escape(M)) = f_entrance(M);

theorem 
  (f_escape(M)) * (f_escape(M) \ id(Elements(M))) = {} &
  (f_entrance(M)) * (f_entrance(M) \ id(Elements(M))) = {};



notation
  let M;
  synonym f_circulation(M) for f_flow(M);
end;

definition
  let M;
  func f_adjac(M) -> Relation equals

  ((Flow M)|(the carrier' of M) \/
  (Flow M)~|(the carrier' of M)) \/ id(the carrier' of M);
end;

theorem 
  f_adjac(M) * f_adjac(M) = f_adjac(M) &
  (f_adjac(M) \ id(Elements(M))) * f_adjac(M) = {} &
  (f_adjac(M) \/ ((f_adjac(M))~)) \/ id(Elements(M)) = f_circulation(M) \/
  (f_circulation(M))~;














begin

reserve x,y,z,X,Y for set;

definition
  struct (1-sorted) G_Net (# carrier -> set, entrance, escape -> Relation #);
end;

definition
  let IT be G_Net;

  attr IT is GG means

  the entrance of IT c= [:the carrier of IT,the carrier of IT:] &
  the escape of IT c= [:the carrier of IT,the carrier of IT:] &
  (the entrance of IT) * (the entrance of IT) = the entrance of IT &
  (the entrance of IT) * (the escape of IT) = the entrance of IT &
  (the escape of IT) * (the escape of IT) = the escape of IT &
  (the escape of IT) * (the entrance of IT) = the escape of IT;
end;

registration
  cluster GG for G_Net;
end;

definition
  mode gg_net is GG G_Net;
end;

definition
  let IT be G_Net;
  attr IT is EE means


  (the entrance of IT) * ((the entrance of IT) \ id the carrier of IT) = {} &
  (the escape of IT) * ((the escape of IT) \ id the carrier of IT) = {};
end;

registration
  cluster EE for G_Net;
end;

registration
  cluster strict GG EE for G_Net;
end;

definition
  mode e_net is EE GG G_Net;
end;

reserve N for e_net;

theorem 
  for R, S being Relation holds G_Net (# X, R, S #) is e_net iff
  R c= [:X,X:] & S c= [:X,X:] & R * R = R & R * S = R &
  S * S = S & S * R = S & R * (R \ id X) = {} & S * (S \ id X) = {};

theorem 
  G_Net (# X, {}, {} #) is e_net;

theorem 
  G_Net (# X, id X, id X #) is e_net;

theorem 
  G_Net (# {}, {}, {} #) is e_net;

theorem 
  G_Net (# X, id(X \ Y), id(X \ Y) #) is e_net;

definition
  func empty_e_net -> strict e_net equals

  G_Net (# {}, {}, {} #);
end;

definition
  let X;
  func Tempty_e_net X -> strict e_net equals

  G_Net (# X, id X, id X #);
  func Pempty_e_net(X) -> strict e_net equals

  G_Net (# X, {}, {} #);
end;

theorem 
  the carrier of Tempty_e_net(X) = X & the entrance of Tempty_e_net(X) = id X &
  the escape of Tempty_e_net(X) = id X;

theorem 
  the carrier of Pempty_e_net(X) = X & the entrance of Pempty_e_net(X) = {} &
  the escape of Pempty_e_net(X) = {};

definition
  let x;
  func Psingle_e_net(x) -> strict e_net equals

  G_Net (#{x}, id{x}, id{x}#);
  func Tsingle_e_net(x) -> strict e_net equals

  G_Net (# {x}, {}, {} #);
end;

theorem 
  the carrier of Psingle_e_net(x) = {x} &
  the entrance of Psingle_e_net(x) = id{x} &
  the escape of Psingle_e_net(x) = id{x};

theorem 
  the carrier of Tsingle_e_net(x) = {x} &
  the entrance of Tsingle_e_net(x) = {} &
  the escape of Tsingle_e_net(x) = {};

theorem 
  G_Net (# X \/ Y, id X, id X #) is e_net;

definition
  let X,Y;
  func PTempty_e_net(X,Y) -> strict e_net equals

  G_Net (#X \/ Y, id(X), id(X)#);
end;

theorem 
  (the entrance of N) \ id(dom(the entrance of N)) =
    (the entrance of N) \ id the carrier of N &
  (the escape of N) \ id(dom(the escape of N)) =
    (the escape of N) \ id the carrier of N &
  (the entrance of N) \ id(rng(the entrance of N)) =
    (the entrance of N) \ id the carrier of N &
  (the escape of N) \ id(rng(the escape of N)) =
    (the escape of N) \ id the carrier of N;

theorem 
  CL the entrance of N = CL the escape of N;

theorem 
  rng (the entrance of N) = rng (CL(the entrance of N)) &
  rng (the entrance of N) = dom (CL(the entrance of N)) &
  rng (the escape of N) = rng (CL(the escape of N)) &
  rng (the escape of N) = dom (CL(the escape of N)) &
  rng the entrance of N = rng the escape of N;

theorem 
  dom (the entrance of N) c= the carrier of N & rng (the entrance
  of N) c= the carrier of N & dom (the escape of N) c= the carrier of N & rng (
  the escape of N) c= the carrier of N;

theorem 
  (the entrance of N) * ((the escape of N) \ id the carrier of N) = {} &
  (the escape of N) * ((the entrance of N) \ id the carrier of N) = {};

theorem 
  ((the entrance of N) \ id(the carrier of N)) *
    ((the entrance of N) \ id(the carrier of N)) = {} &
  ((the escape of N) \ id(the carrier of N)) *
    ((the escape of N) \ id(the carrier of N)) = {} &
  ((the entrance of N) \ id(the carrier of N)) *
    ((the escape of N) \ id(the carrier of N)) = {} &
  ((the escape of N) \ id(the carrier of N)) *
    ((the entrance of N) \ id(the carrier of N)) = {};

definition
  let N;
  func e_Places(N) -> set equals

  rng (the entrance of N);
end;

definition
  let N;
  func e_Transitions(N) -> set equals

  (the carrier of N) \ e_Places(N);
end;

theorem 
  ([x,y] in the entrance of N or [x,y] in the escape of N) &
  x <> y implies x in e_Transitions(N) & y in e_Places(N);

theorem 
  (the entrance of N) \ id(the carrier of N) c=
    [:e_Transitions(N),e_Places(N):] &
  (the escape of N) \ id(the carrier of N) c=
    [:e_Transitions(N),e_Places(N):];

definition
  let N;
  func e_Flow N -> Relation equals

  ((the entrance of N)~ \/ (the escape of N)) \ id N;
end;

theorem 
  e_Flow N c= [:e_Places(N), e_Transitions(N):] \/
    [:e_Transitions(N), e_Places(N):];

definition
  let N;

  func e_pre(N) -> Relation equals

  (the entrance of N) \ id(the carrier of N);
  func e_post(N) -> Relation equals

  (the escape of N) \ id(the carrier of N);
end;

theorem 
  e_pre(N) c= [:e_Transitions(N),e_Places(N):] &
  e_post(N) c= [:e_Transitions(N),e_Places(N):];

definition
  let N;
  func e_shore(N) -> set equals

  the carrier of N;
  func e_prox(N) -> Relation equals

  ((the entrance of N) \/ (the escape of N))~;
  func e_flow(N) -> Relation equals

  ((the entrance of N)~ \/ (the escape of N)) \/ id(the carrier of N);
end;

theorem 
  e_prox(N) c= [:e_shore(N),e_shore(N):] &
  e_flow(N) c= [:e_shore(N),e_shore(N):];

theorem 
  (e_prox(N)) * (e_prox(N)) = e_prox(N) &
  (e_prox(N) \ id(e_shore(N))) * e_prox(N) = {} &
  (e_prox(N) \/ (e_prox(N))~) \/ id(e_shore(N)) = e_flow(N) \/ (e_flow(N))~;

theorem 
  id((the carrier of N) \ rng(the escape of N)) *
    ((the escape of N) \ id(the carrier of N)) =
    ((the escape of N) \ id(the carrier of N)) &
  id((the carrier of N) \ rng(the entrance of N)) *
    ((the entrance of N) \ id(the carrier of N)) =
    ((the entrance of N) \ id(the carrier of N));

theorem 
  ((the escape of N) \ id the carrier of N) *
    ((the escape of N) \ id the carrier of N) = {} &
  ((the entrance of N) \ id the carrier of N) *
    ((the entrance of N) \ id the carrier of N) = {} &
  ((the escape of N) \ id(the carrier of N)) *
    ((the entrance of N) \ id the carrier of N) = {} &
  ((the entrance of N) \ id the carrier of N) *
    ((the escape of N) \ id the carrier of N) = {};

theorem 
  ((the escape of N) \ id(the carrier of N))~ *
    ((the escape of N) \ id(the carrier of N))~ = {} &
  ((the entrance of N) \ id(the carrier of N))~ *
    ((the entrance of N) \ id(the carrier of N))~ = {};

theorem 
  ((the escape of N) \ id(the carrier of N))~ * id((the carrier of N) \
    rng(the escape of N))~ = ((the escape of N) \ id(the carrier of N))~ &
  ((the entrance of N) \ id(the carrier of N))~ *
    id((the carrier of N) \ rng(the entrance of N))~ =
      ((the entrance of N) \ id(the carrier of N))~;

theorem 
  ((the escape of N) \ id(the carrier of N)) *
    (id((the carrier of N) \ rng(the escape of N))) = {} &
  ((the entrance of N) \ id(the carrier of N)) *
    (id((the carrier of N) \ rng(the entrance of N))) = {};

theorem 
  id((the carrier of N) \ rng(the escape of N)) *
    ((the escape of N) \ id(the carrier of N))~ = {} &
  id((the carrier of N) \ rng(the entrance of N)) *
    ((the entrance of N) \ id(the carrier of N))~ = {};

definition
  let N;

  func e_entrance(N) -> Relation equals

  (((the escape of N) \ id(the carrier of N))~) \/
    id((the carrier of N) \ rng(the escape of N));
  func e_escape(N) -> Relation equals

  (((the entrance of N) \ id(the carrier of N))~) \/
    id((the carrier of N) \ rng(the entrance of N));
end;

theorem 
  e_entrance(N) * e_entrance(N) = e_entrance(N) &
  e_entrance(N) * e_escape(N) = e_entrance(N) &
  e_escape(N) * e_entrance(N) = e_escape(N) &
  e_escape(N) * e_escape(N) = e_escape(N);

theorem 
  e_entrance(N) * (e_entrance(N) \ id(e_shore N)) = {} &
  e_escape(N) * (e_escape(N) \ id(e_shore N)) = {};

definition
  let N;

  func e_adjac(N) -> Relation equals

  (((the entrance of N) \/ (the escape of N)) \ id(the carrier of N))
   \/ id((the carrier of N) \ rng(the entrance of N));
end;

theorem 
  e_adjac(N) c= [:e_shore(N),e_shore(N):] &
  e_flow(N) c= [:e_shore(N),e_shore(N):];

theorem 
  (e_adjac(N)) * (e_adjac(N)) = e_adjac(N) &
  (e_adjac(N) \ id(e_shore(N))) * e_adjac(N) = {} &
  (e_adjac(N) \/ (e_adjac(N))~) \/ id(e_shore(N)) = e_flow(N) \/ (e_flow(N))~;

reserve N for e_net;

theorem 
  ((the entrance of N) \ id(the carrier of N))~ c=
    [:e_Places(N), e_Transitions(N):] &
  ((the escape of N) \ id(the carrier of N))~ c=
    [:e_Places(N),e_Transitions(N):];

definition
  let N be G_Net;
  func s_pre(N) -> Relation equals

  ((the escape of N) \ id(the carrier of N))~;
  func s_post(N) -> Relation equals

  ((the entrance of N) \ id(the carrier of N))~;
end;

theorem 
  s_post(N) c= [:e_Places(N),e_Transitions(N):] &
  s_pre(N) c= [:e_Places(N),e_Transitions(N):];














begin

reserve y for set;

reserve C,D,E for Category,
  c,c1,c2 for Object of C,
  d,d1 for Object of D,
  x for set,
  f,f1 for (Morphism of E),
  g,g1 for (Morphism of C),
  h,h1 for (Morphism of D) ,
  F for Functor of C,E,
  G for Functor of D,E;

definition
  let C,D,E;
  let F be Functor of C,E, G be Functor of D,E;
  given c1,d1,f1 such that
 f1 in Hom(F.c1,G.d1);
  func commaObjs(F,G) -> non empty Subset of [:[:the carrier of C, the carrier
  of D:], the carrier' of E:] equals


  {[[c,d],f] : f in Hom(F.c,G.d)};
end;

reserve o,o1,o2 for Element of commaObjs(F,G);

theorem 
  (ex c,d,f st f in Hom(F.c,G.d)) implies o = [[o`11,o`12],o`2] & o
  `2 in Hom(F.o`11,G.o`12) & dom o`2 = F.o`11 & cod o`2 = G.o`12;

definition
  let C,D,E,F,G;
  given c1,d1,f1 such that
 f1 in Hom(F.c1,G.d1);
  func commaMorphs(F,G) -> non empty Subset of [:[:commaObjs(F,G), commaObjs(F
  ,G):], [:the carrier' of C, the carrier' of D:]:] equals


  {[[o1,o2], [g,h]] :
    dom g = o1`11 & cod g = o2`11 & dom h = o1`12 & cod h = o2`12 &
   (o2`2)(*)(F.g) = (G.h)(*)(o1`2)};
end;

reserve k,k1,k2,k9 for Element of commaMorphs(F,G);

definition
  let C,D,E,F,G,k;
  redefine func k`11 -> Element of commaObjs(F,G);
  redefine func k`12 -> Element of commaObjs(F,G);
end;

theorem 
  (ex c,d,f st f in Hom(F.c,G.d)) implies k = [[k`11,k`12], [k`21,k
`22]] & dom k`21 = k`11`11 & cod k`21 = k`12`11 & dom k`22 = k`11`12 & cod k`22
  = k`12`12 & (k`12`2)(*)(F.k`21) = (G.k`22)(*)(k`11`2);

definition
  let C,D,E,F,G,k1,k2;
  given c1,d1,f1 such that
 f1 in Hom(F.c1,G.d1);
  assume
 k1`12 = k2`11;
  func k2*k1 -> Element of commaMorphs(F,G) equals


  [[k1`11,k2`12],[k2`21(*)k1`21,k2`22(*)k1`22]];
end;

definition
  let C,D,E,F,G;
  func commaComp(F,G) -> PartFunc of [:commaMorphs(F,G),commaMorphs(F,G):],
  commaMorphs(F,G) means


  dom it = { [k1,k2]: k1`11 = k2`12 } & for k,k9
  st [k,k9] in dom it holds it.[k,k9] = k*k9;
end;

definition
  let C,D,E,F,G;
  given c1,d1,f1 such that
 f1 in Hom(F.c1,G.d1);
  func F comma G -> strict Category means

  the carrier of it = commaObjs(F,G) &
  the carrier' of it = commaMorphs(F,G) & (for k holds (the Source of it).k = k
`11) & (for k holds (the Target of it).k = k`12) &
    the Comp of it = commaComp(F,G);
end;

theorem 
  the carrier of 1Cat(x,y) = {x} & the carrier' of 1Cat(x,y) = {y};

theorem 
  for a,b being Object of 1Cat(x,y) holds Hom(a,b) = {y};

definition
  let C, c;
  func 1Cat c -> strict Subcategory of C equals

  1Cat(c, id c);
end;

definition
  let C, c;
  func c comma C -> strict Category equals

  (incl 1Cat c) comma (id C);
  func C comma c -> strict Category equals

  (id C) comma (incl 1Cat c);
end;














begin

reserve a, b, r, M2 for Real;
reserve Rseq,Rseq1,Rseq2 for Real_Sequence;
reserve k, n, m, m1, m2 for Element of NAT;

definition
  let X be non empty addLoopStr;
  let seq be sequence of X;
  func Partial_Sums(seq) -> sequence of X means


  it.0 = seq.0 & for n holds it.(n + 1) = it.n + seq.(n + 1);
end;

theorem 
  for X being Abelian add-associative non empty addLoopStr, seq1,
  seq2 being sequence of X holds Partial_Sums(seq1) + Partial_Sums(seq2) =
  Partial_Sums(seq1 + seq2);

theorem 
  for X being Abelian add-associative right_zeroed
  right_complementable non empty addLoopStr, seq1, seq2 being sequence of X
  holds Partial_Sums(seq1) - Partial_Sums(seq2) = Partial_Sums(seq1 - seq2);

theorem 
  for X being vector-distributive scalar-distributive scalar-associative
  scalar-unital non empty RLSStruct, seq being
  sequence of X holds Partial_Sums(a * seq) = a * Partial_Sums(seq);

reserve X for RealUnitarySpace;
reserve g for Point of X;
reserve seq, seq1, seq2 for sequence of X;

theorem 
  Partial_Sums(- seq) = - Partial_Sums(seq);

theorem 
  a * Partial_Sums(seq1) + b * Partial_Sums(seq2) = Partial_Sums(a *
  seq1 + b * seq2);

definition
  let X, seq;
  attr seq is summable means


  Partial_Sums(seq) is convergent;
  func Sum(seq) -> Point of X equals

  lim Partial_Sums(seq);
end;

theorem 
  seq1 is summable & seq2 is summable implies seq1 + seq2 is summable &
  Sum(seq1 + seq2) = Sum(seq1) + Sum(seq2);

theorem 
  seq1 is summable & seq2 is summable implies seq1 - seq2 is summable &
  Sum(seq1 - seq2) = Sum(seq1) - Sum(seq2);

theorem 
  seq is summable implies a * seq is summable & Sum(a * seq) = a * Sum( seq);

theorem 
  seq is summable implies seq is convergent & lim seq = 0.X;

theorem 
  for X being RealHilbertSpace, seq being sequence of X
   holds seq is summable iff for r st r > 0 ex k
st for n, m st n >= k & m >= k holds ||.(Partial_Sums(seq)).n - (Partial_Sums(
  seq)).m.|| < r;

theorem 
  seq is summable implies Partial_Sums(seq) is bounded;

theorem 
  for seq, seq1 st for n holds seq1.n = seq.0 holds Partial_Sums(
  seq^\1) = (Partial_Sums(seq)^\1) - seq1;

theorem 
  seq is summable implies for k holds seq^\k is summable;

theorem 
  (ex k st seq^\k is summable) implies seq is summable;

definition
  let X, seq, n;
  func Sum(seq,n) -> Point of X equals

  Partial_Sums(seq).n;
end;

theorem 
  Sum(seq, 0) = seq.0;

theorem 
  Sum(seq, 1) = Sum(seq, 0) + seq.1;

theorem 
  Sum(seq, 1) = seq.0 + seq.1;

theorem 
  Sum(seq, n + 1) = Sum(seq, n) + seq.(n + 1);

theorem 
  seq.(n + 1) = Sum(seq, n + 1) - Sum(seq, n);

theorem 
  seq.1 = Sum(seq, 1) - Sum(seq, 0);

definition
  let X, seq, n, m;
  func Sum(seq, n, m) -> Point of X equals

  Sum(seq, n) - Sum(seq, m);
end;

theorem 
  Sum(seq, 1, 0) = seq.1;

theorem 
  Sum(seq, n+1, n) = seq.(n+1);

theorem 
  for X being RealHilbertSpace, seq being sequence of X
   holds seq is summable iff for r st r > 0 ex k
  st for n, m st n >= k & m >= k holds ||.Sum(seq, n) - Sum(seq, m).|| < r;

theorem 
  for X being RealHilbertSpace, seq being sequence of X
   holds seq is summable iff for r st r > 0 ex k st for
  n, m st n >= k & m >= k holds ||.Sum(seq, n, m).|| < r;

definition
  let X, seq;

  attr seq is absolutely_summable means


  ||.seq.|| is summable;
end;

theorem 
  seq1 is absolutely_summable & seq2 is absolutely_summable implies seq1
  + seq2 is absolutely_summable;

theorem 
  seq is absolutely_summable implies a * seq is absolutely_summable;

theorem 
  ( for n holds ||.seq.||.n <= Rseq.n ) & Rseq is summable implies seq
  is absolutely_summable;

theorem 
  ( for n holds seq.n <> 0.X & Rseq.n = ||.seq.(n+1).||/||.seq.n.|| ) &
  Rseq is convergent & lim Rseq < 1 implies seq is absolutely_summable;

theorem 
  r > 0 & ( ex m st for n st n >= m holds ||.seq.n.|| >= r)
  implies not seq is convergent or lim seq <> 0.X;

theorem 
  ( for n holds seq.n <> 0.X ) & ( ex m st for n st n >= m holds
  ||.seq.(n+1).||/||.seq.n.|| >= 1 ) implies not seq is summable;

theorem 
  (for n holds seq.n <> 0.X) & (for n holds Rseq.n = ||.seq.(n+1).||/||.
  seq.n.||) & Rseq is convergent & lim Rseq > 1 implies not seq is summable;

theorem 
  ( for n holds Rseq.n = n-root (||.seq.n.||) ) & Rseq is convergent &
  lim Rseq < 1 implies seq is absolutely_summable;

theorem 
  (for n holds Rseq.n = n-root (||.seq.||.n)) & (ex m st for n st n >= m
  holds Rseq.n >= 1) implies not seq is summable;

theorem 
  (for n holds Rseq.n = n-root (||.seq.||.n)) & Rseq is convergent & lim
  Rseq > 1 implies not seq is summable;

theorem 
  Partial_Sums(||.seq.||) is non-decreasing;

theorem 
  for n holds Partial_Sums(||.seq.||).n >= 0;

theorem 
  for n holds ||.Partial_Sums(seq).n.|| <= Partial_Sums(||.seq.||) .n;

theorem 
  for n holds ||.Sum(seq, n).|| <= Sum(||.seq.||, n);

theorem 
  for n, m holds ||.Partial_Sums(seq).m - Partial_Sums(seq).n.||
  <= abs(Partial_Sums(||.seq.||).m - Partial_Sums(||.seq.||).n);

theorem 
  for n, m holds ||.Sum(seq, m) - Sum(seq, n).|| <= abs(Sum(||.seq.||, m
  ) - Sum(||.seq.||, n));

theorem 
  for n, m holds ||.Sum(seq, m, n).|| <= abs(Sum(||.seq.||, m, n));

theorem 
  for X being RealHilbertSpace, seq being sequence of X
   holds seq is absolutely_summable implies seq is
  summable;

definition
  let X, seq, Rseq;
  func Rseq * seq -> sequence of X means


  for n holds it.n = Rseq.n * seq.n;
end;

theorem 
  Rseq * (seq1 + seq2) = Rseq * seq1 + Rseq * seq2;

theorem 
  (Rseq1 + Rseq2) * seq = Rseq1 * seq + Rseq2 * seq;

theorem 
  (Rseq1 (#) Rseq2) * seq = Rseq1 * (Rseq2 * seq);

theorem 
  (a (#) Rseq) * seq = a * (Rseq * seq);

theorem 
  Rseq * (- seq) = (- Rseq) * seq;

theorem 
  Rseq is convergent & seq is convergent implies Rseq * seq is convergent;

theorem 
  Rseq is bounded & seq is bounded implies Rseq * seq is bounded;

theorem 
  Rseq is convergent & seq is convergent implies Rseq * seq is
  convergent & lim (Rseq * seq) = lim Rseq * lim seq;

definition
  let Rseq;
  attr Rseq is Cauchy means


  for r st r > 0 ex k st for n, m st n >= k
  & m >= k holds abs((Rseq.n - Rseq.m)) < r;
end;

theorem 
  for X being RealHilbertSpace, seq being sequence of X
   holds seq is Cauchy & Rseq is Cauchy implies Rseq *
  seq is Cauchy;

theorem 
  for n holds Partial_Sums((Rseq - Rseq^\1) * Partial_Sums(seq)).n
  = Partial_Sums(Rseq * seq).(n+1) - (Rseq * Partial_Sums(seq)).(n+1);

theorem 
  for n holds Partial_Sums(Rseq * seq).(n+1) = (Rseq *
Partial_Sums(seq)).(n+1) - Partial_Sums((Rseq^\1 - Rseq) * Partial_Sums(seq)).n
;

theorem 
  for n holds Sum(Rseq * seq, n+1) = (Rseq * Partial_Sums(seq)).(n+1) -
  Sum((Rseq^\1 - Rseq) * Partial_Sums(seq), n);














begin

reserve n,i,j,k,l for Element of NAT;
reserve D for non empty set;
reserve c,d for Element of D;
reserve p,q,q9,r for FinSequence of D;

theorem 
  len p = j+1+k implies ex q,r,c st len q = j & len r = k & p = q^<*c*>^ r;

theorem 
  i in Seg n implies ex j,k st n = j+1+k & i = j+1;

theorem 
  p = q^<*c*>^r & i = len q + 1 implies (for l st 1 <= l & l <= len q
holds p.l = q.l) & p.i = c & for l st i + 1 <= l & l <= len p holds p.l = r.(l-
  i);

theorem 
  l<=j or l=j+1 or j+2<=l;

theorem 
  l in Seg(n)\{i} & i=j+1 implies 1<=l & l<=j or i+1<=l & l<=n;

definition
  let D,n;
  let p be Element of n-tuples_on D;
  let i,d;
  redefine func p+*(i,d) -> Element of n-tuples_on D;
end;



begin

definition
  let n;
  struct(MidStr) ReperAlgebraStr over n (#carrier -> set, MIDPOINT -> BinOp of
    the carrier, reper -> Function of n-tuples_on the carrier, the carrier#);
end;

registration
  let n;
  let A be non empty set, m be BinOp of A, r be Function of n-tuples_on A,A;
  cluster ReperAlgebraStr(#A,m,r#) -> non empty;
end;

registration
  let n;
  cluster non empty for ReperAlgebraStr over n;
end;

registration
  let n;
  cluster MidSp-like for non empty ReperAlgebraStr over n+2;
end;

reserve RAS for MidSp-like non empty ReperAlgebraStr over n+2;
reserve a,b,d,pii,p9i for Point of RAS;

definition
  let n,RAS,i;
  mode Tuple of i,RAS is Element of i-tuples_on the carrier of RAS;
end;

reserve p,q for Tuple of (n+1),RAS;

definition
  let n,RAS,a;
  redefine func <*a*> -> Tuple of 1,RAS;
end;

definition
  let n,RAS,i,j;
  let p be Tuple of i,RAS, q be Tuple of j,RAS;
  redefine func p^q -> Tuple of (i+j),RAS;
end;

definition
  let n,RAS,a,p;
  func *'(a,p) -> Point of RAS equals

  (the reper of RAS).(<*a*>^p);
end;

theorem 
  i in Seg(n+1) implies (p+*(i,d)).i = d & for l st l in (dom p)\{i}
  holds (p+*(i,d)).l = p.l;

definition
  let n;
  mode Nat of n -> Element of NAT means


    1<=it & it<=n+1;
end;

reserve m for Nat of n;

theorem 
  i is Nat of n iff i in Seg(n+1);

theorem 
  i<=n implies i+1 is Nat of n;

theorem 
  (for m holds p.m = q.m) implies p = q;

theorem 
  for l being Nat of n st l=i holds (p+*(i,d)).l = d;

definition
  let n,D;
  let p be Element of (n+1)-tuples_on D;
  let m;
  redefine func p.m -> Element of D;
end;

definition
  let n,RAS;
  attr RAS is being_invariance means


  for a,b,p,q st (for m holds a@(q.m ) = b@(p.m)) holds a@*'(b,q) = b@*'(a,p);
end;

definition
 let n,RAS,p,i,a;
 redefine func p+*(i,a) -> Tuple of (n+1),RAS;
end;

definition
  let n,i,RAS;
  pred RAS has_property_of_zero_in i means


  for a,p holds *'(a,(p+*(i,a) )) = a;
end;

definition
  let n,i,RAS;
  pred RAS is_semi_additive_in i means


  for a,pii,p st p.i = pii holds *'(a,(p+*(i,a@pii))) = a@*'(a,p);
end;

theorem 
  RAS is_semi_additive_in m implies for a,d,p,q st q = (p+*(m,d))
  holds *'(a,(p+*(m,a@d))) = a@*'(a,q);

definition
  let n,i,RAS;
  pred RAS is_additive_in i means


  for a,pii,p9i,p st p.i = pii holds *'
  (a,(p+*(i,pii@p9i))) = *'(a,p)@*'(a,(p+*(i,p9i)));
end;

definition
  let n,i,RAS;
  pred RAS is_alternative_in i means


  for a,p,pii st p.i = pii holds *'( a,(p+*(i+1,pii))) = a;
end;

reserve W for ATLAS of RAS;
reserve v for Vector of W;

definition
  let n,RAS,W,i;
  mode Tuple of i,W is Element of i-tuples_on the carrier of the algebra of W;
end;

reserve x,y for Tuple of (n+1),W;

theorem 
  i in Seg(n+1) implies (x+*(i,v)).i = v & for l st l in (dom x)\{i}
  holds (x+*(i,v)).l = x.l;

theorem 
  (for l being Nat of n st l=i holds (x+*(i,v)).l = v) & for l,i
  being Nat of n st l<>i holds (x+*(i,v)).l = x.l;

theorem 
  (for m holds x.m = y.m) implies x = y;

scheme 

  SeqLambdaD9{n()->Element of NAT,D()->non empty set, F(set)->Element of D()}:
ex z being FinSequence of D() st len z = n()+1 & for j being Nat of n() holds z
  .j = F(j);

definition
  let n,RAS,W,a,x;

  func (a,x).W -> Tuple of (n+1),RAS means


  it.m = (a,x.m).W;
end;

definition
  let n,RAS,W,a,p;
  func W.(a,p) -> Tuple of (n+1),W means


  it.m = W.(a,p.m);
end;

theorem 
  W.(a,p) = x iff (a,x).W = p;

theorem 
  W.(a,(a,x).W) = x;

theorem 
  (a,W.(a,p)).W = p;

definition
  let n,RAS,W,a,x;
  func Phi(a,x) -> Vector of W equals

  W.(a,*'(a,(a,x).W));
end;

theorem 
  W.(a,p) = x & W.(a,b) = v implies (*'(a,p) = b iff Phi(a,x) = v);

theorem 
  RAS is being_invariance iff for a,b,x holds Phi(a,x) = Phi(b,x);

theorem 
  1 in Seg(n+1);

theorem 
  1 is Nat of n;



begin

definition
  let n;
  mode ReperAlgebra of n -> MidSp-like non empty ReperAlgebraStr over n+2
    means


    it is being_invariance;
end;

reserve RAS for ReperAlgebra of n;
reserve a,b,pm,p9m,p99m for Point of RAS;
reserve p for Tuple of (n+1),RAS;
reserve W for ATLAS of RAS;
reserve v for Vector of W;
reserve x for Tuple of (n+1),W;

theorem 
  Phi(a,x) = Phi(b,x);

definition
  let n,RAS,W,x;
  func Phi(x) -> Vector of W means


  for a holds it = Phi(a,x);
end;

theorem 
  W.(a,p) = x & W.(a,b) = v & Phi(x) = v implies *'(a,p) = b;

theorem 
  (a,x).W = p & (a,v).W = b & *'(a,p) = b implies Phi(x) = v;

theorem 
  W.(a,p) = x & W.(a,b) = v implies W.(a,(p+*(m,b))) = (x+*(m,v));

theorem 
  (a,x).W = p & (a,v).W = b implies (a,(x+*(m,v))).W = (p+*(m,b));

theorem 
  RAS has_property_of_zero_in m iff for x holds Phi((x+*(m,0.W))) = 0.W;

theorem 
  RAS is_semi_additive_in m iff for x holds Phi((x+*(m,Double(x.m)
  ))) = Double Phi(x);

theorem 
  RAS has_property_of_zero_in m & RAS is_additive_in m implies RAS
  is_semi_additive_in m;

theorem 
  RAS has_property_of_zero_in m implies (RAS is_additive_in m iff for x,
  v holds Phi((x+*(m,(x.m)+v))) = Phi(x) + Phi ((x+*(m,v))));

theorem 
  W.(a,p) = x & m<= n implies W.(a,(p+*(m+1,p.m))) = (x+*(m+1,x.m) );

theorem 
  (a,x).W = p & m<=n implies (a,(x+*(m+1,x.m))).W = (p+*(m+1,p.m));

theorem 
  m<=n implies (RAS is_alternative_in m iff for x holds Phi((x+*(m+1,x.m
  ))) = 0. W );














begin

reserve F,G for Group;
reserve G1 for Subgroup of G;
reserve Gc for cyclic Group;
reserve H for Subgroup of Gc;
reserve f for Homomorphism of G,Gc;
reserve a,b for Element of G;
reserve g for Element of Gc;
reserve a1 for Element of G1;
reserve k,m,n,p,s for Element of NAT;
reserve i0,i,i1,i2 for Integer;
reserve j,j1 for Element of INT.Group;
reserve x,y,t for set;

theorem 
  ord a>1 & a=b|^k implies k<>0;



theorem 
  a in gr {a};

theorem 
  a=a1 implies gr {a} = gr {a1};

theorem 
  gr {a} is cyclic Group;

theorem 
  for G being strict Group,b being Element of G holds ( for a
  being Element of G holds ex i st a=b|^i ) iff G = gr {b};

theorem 
  for G being strict finite Group,b being Element of G holds (for
  a being Element of G holds ex p st a=b|^p) iff G = gr {b};

theorem 
  for G being strict Group,a being Element of G holds G is finite
& G = gr {a} implies for G1 being strict Subgroup of G holds ex p st G1 = gr {a
  |^p};

theorem 
  for G being finite Group, a being Element of G holds G=gr {a} &
  card G = n & n = p * s implies ord (a|^p) = s;

theorem 
  s divides k implies a|^k in gr {a|^s};

theorem 
  for G being finite Group, a being Element of G holds card gr {a
  |^s} = card gr {a|^k} & a|^k in gr {a|^s} implies gr {a|^s} = gr {a|^k};

theorem 
  for G being finite Group, G1 being Subgroup of G, a being
Element of G holds card G = n & G=gr {a} & card G1 = p & G1= gr{a|^k} implies n
  divides k*p;

theorem 
  for G being strict finite Group, a be Element of G holds G = gr {a} &
  card G = n implies ( G = gr {a|^k} iff k gcd n = 1 );

theorem 
  Gc = gr {g} & g in H implies the multMagma of Gc = the multMagma of H;

theorem 
  Gc = gr {g} implies ( Gc is finite iff ex i,i1 st i<>i1 & g|^i = g|^i1 );

registration
  let n be non zero Nat;
  cluster -> natural for Element of INT.Group(n);
end;



theorem 
  for Gc being strict finite cyclic Group
   holds INT.Group(card Gc),Gc are_isomorphic;

theorem 
  for Gc being strict cyclic Group st Gc is infinite holds INT.Group,Gc
  are_isomorphic;

theorem 
  for Gc, Hc being strict finite cyclic Group st card Hc = card Gc
  holds Hc,Gc are_isomorphic;

theorem 
  for F,G being strict finite Group st card F = p & card G = p & p
  is prime holds F,G are_isomorphic;

theorem 
  for F,G being strict finite Group st card F = 2 & card G = 2 holds F,G
  are_isomorphic;

theorem 
  for G being strict finite Group holds card G = 2 implies for H being
  strict Subgroup of G holds H = (1).G or H = G;

theorem 
  for G being strict finite Group st card G = 2 holds G is cyclic Group;

theorem 
  for G being strict finite Group st G is cyclic & card G = n holds for
p st p divides n holds ex G1 being strict Subgroup of G st card G1 = p & for G2
  being strict Subgroup of G st card G2 = p holds G2=G1;

theorem 
  Gc=gr{g} implies for G,f holds g in Image f implies f is onto;

theorem 
  for Gc being strict finite cyclic Group st (ex k st card Gc = 2*
  k) holds ex g1 being Element of Gc st ord g1 = 2 & for g2 being Element of Gc
  st ord g2 = 2 holds g1=g2;

registration
  let G;
  cluster center G -> normal;
end;

theorem 
  for Gc being strict finite cyclic Group st ex k st card Gc = 2*k holds
  ex H being Subgroup of Gc st card H = 2 & H is cyclic Group;

theorem 
  for G being strict Group holds for g being Homomorphism of G,F
  st G is cyclic holds Image g is cyclic;

theorem 
  for G,F being strict Group st G,F are_isomorphic & G is cyclic holds F
  is cyclic;














begin 

definition
  let A,B,C be non empty set;
  let f be Function of A, Funcs(B,C);
  redefine func uncurry f -> Function of [:A,B:],C;
end;

theorem 
  for A,B,C being non empty set, f being Function of A,Funcs(B,C)
  holds curry uncurry f = f;

theorem 
  for A,B,C being non empty set, f being Function of A, Funcs(B,C)
for a being Element of A, b being Element of B
      holds (uncurry f).(a,b) = f.a.b;

canceled 2;



reserve A,B,C for Category,
  F,F1 for Functor of A,B;

theorem 
  for f being Morphism of A holds (id cod f)(*)f = f;

theorem 
  for f being Morphism of A holds f(*)(id dom f) = f;

reserve o,m for set;
reserve t for natural_transformation of F,F1;

theorem 
  o is Object of Functors(A,B) iff o is Functor of A,B;

theorem 
  for f being Morphism of Functors(A,B) ex F1,F2 being Functor of A
,B, t being natural_transformation of F1,F2 st F1 is_naturally_transformable_to
  F2 & dom f = F1 & cod f = F2 & f = [[F1,F2],t];

begin 

definition
  let A,B;
  let a be Object of A;
  func a |-> B -> Functor of Functors(A,B), B means


  for F1,F2 being Functor of A,B, t being natural_transformation of F1,F2 st F1
  is_naturally_transformable_to F2 holds it.[[F1,F2],t] = t.a;
end;

theorem 
  Functors(1Cat(o,m),A) ~= A;

begin 

theorem 
  for F being Functor of [:A,B:],C, a being Object of A, b being
  Object of B holds (F?-a).b = F.[a,b];

theorem 
  for a1,a2 being Object of A, b1,b2 being Object of B holds Hom(
  a1,a2) <> {} & Hom(b1,b2) <> {} iff Hom([a1,b1],[a2,b2]) <> {};

theorem 
  for a1,a2 being Object of A, b1,b2 being Object of B st Hom([a1,
b1],[a2,b2]) <> {} for f being (Morphism of A), g being Morphism of B holds [f,
g] is Morphism of [a1,b1],[a2,b2] iff f is Morphism of a1,a2 & g is Morphism of
  b1,b2;

theorem 
  for F1,F2 being Functor of [:A,B:],C st F1
is_naturally_transformable_to F2 for t being natural_transformation of F1,F2, a
being Object of A holds F1?-a is_naturally_transformable_to F2?-a & (curry t).a
  is natural_transformation of F1?-a,F2?-a;

definition
  let A,B,C;
  let F be Functor of [:A,B:],C;
  let f be Morphism of A;
  func curry(F,f) -> Function of the carrier' of B,the carrier' of C equals

  (
  curry F).f;
end;

theorem 
  for a1,a2 being Object of A, b1,b2 being Object of B, f being (
  Morphism of A), g being Morphism of B st f in Hom(a1,a2) & g in Hom(b1,b2)
  holds [f,g] in Hom([a1,b1],[a2,b2]);

theorem 
  for F being Functor of [:A,B:], C for a,b being Object of A st
  Hom(a,b) <> {} for f being Morphism of a,b holds F?-a
  is_naturally_transformable_to F?-b & curry(F,f)*IdMap B is
  natural_transformation of F?-a,F?-b;

definition
  let A,B,C;
  let F be Functor of [:A,B:],C;
  let f be Morphism of A;
  func F?-f -> natural_transformation of F?-dom f, F?-cod f equals

  curry(F,f)*
  IdMap B;
end;

theorem 
  for F being Functor of [:A,B:],C, g being Morphism of A holds F
  ?-dom(g) is_naturally_transformable_to F?-cod(g);

theorem 
  for F being Functor of [:A,B:],C, f being (Morphism of A), b
  being Object of B holds (F?-f).b = F.(f, id b);

theorem 
  for F being Functor of [:A,B:],C, a being Object of A holds id(F
  ?-a) = F?-id a;

theorem 
  for F being Functor of [:A,B:],C, g,f being Morphism of A st dom
g = cod f for t being natural_transformation of F?-dom f, F?-dom g st t = F?-f
  holds F?-(g(*)f) = (F?-g)`*`t;

definition
  let A,B,C;
  let F be Functor of [:A,B:],C;
  func export F -> Functor of A, Functors(B,C) means


  for f being Morphism of A holds it.f =[[F?-dom f,F?-cod f],F?-f];
end;

theorem 
  for F being Functor of [:A,B:],C, a being Object of A holds (
  export F).a = F?-a;

theorem 
  for F being Functor of [:A,B:],C, a being Object of A holds (
  export F).a is Functor of B,C;

theorem 
  for F1,F2 being Functor of [:A,B:],C holds export F1 = export F2
  implies F1 = F2;

theorem 
  for F1,F2 being Functor of [:A,B:], C st F1
  is_naturally_transformable_to F2 for t being natural_transformation of F1,F2
  holds export F1 is_naturally_transformable_to export F2 & ex G being
natural_transformation of export F1, export F2 st for s being Function of [:the
carrier of A, the carrier of B:], the carrier' of C st t = s for a being Object
  of A holds G.a = [[(export F1).a,(export F2).a],(curry s).a];

definition
  let A,B,C;
  let F1,F2 be Functor of [:A,B:],C such that
 F1 is_naturally_transformable_to F2;
  let t be natural_transformation of F1,F2;
  func export t -> natural_transformation of export F1, export F2 means


for s being Function of [:the carrier of A, the carrier of B:], the carrier' of
C st t = s for a being Object of A holds it.a = [[(export F1).a,(export F2).a],
  (curry s).a];
end;

theorem 
  for F being Functor of [:A,B:],C holds id export F = export id F;

theorem 
  for F1,F2,F3 being Functor of [:A,B:],C st F1
  is_naturally_transformable_to F2 & F2 is_naturally_transformable_to F3 for t1
being natural_transformation of F1,F2, t2 being natural_transformation of F2,F3
  holds export(t2`*`t1) = (export t2)`*`(export t1);

theorem 
  for F1,F2 being Functor of [:A,B:],C st F1
is_naturally_transformable_to F2 for t1,t2 being natural_transformation of F1,
  F2 holds export t1 = export t2 implies t1 = t2;

theorem 
  for G being Functor of A, Functors(B,C) ex F being Functor of [:
  A,B:],C st G = export F;

theorem 
  for F1,F2 being Functor of [:A,B:],C st export F1
  is_naturally_transformable_to export F2 for t being natural_transformation of
  export F1, export F2 holds F1 is_naturally_transformable_to F2 & ex u being
  natural_transformation of F1,F2 st t = export u;

definition
  let A,B,C;
  func export(A,B,C)-> Functor of Functors([:A,B:],C),Functors(A,Functors(B,C)
  ) means


  for F1,F2 being Functor of [:A,B:], C st F1
  is_naturally_transformable_to F2 for t being natural_transformation of F1,F2
  holds it.[[F1,F2],t] = [[export F1, export F2],export t];
end;

registration
  let A,B,C;
  cluster export(A,B,C) -> isomorphic;
end;

theorem 
  Functors([:A,B:],C) ~= Functors(A,Functors(B,C));

begin 

theorem 
  for F1,F2 being Functor of A,B, G being Functor of B,C st F1
  is_naturally_transformable_to F2 for t being natural_transformation of F1,F2
  holds G*t = G*(t qua Function);

definition
  let A,B,C;
  let F be Functor of A,B, G be Functor of A,C;
  redefine func <:F,G:> -> Functor of A, [:B,C:];
end;

definition
  let A,B,C;
  let F be Functor of A, [:B,C:];
  func Pr1 F -> Functor of A,B equals

  pr1(B,C)*F;
  func Pr2 F -> Functor of A,C equals

  pr2(B,C)*F;
end;

theorem 
  for F being Functor of A,B, G being Functor of A,C holds Pr1<:F,
  G:> = F & Pr2<:F,G:> = G;

theorem 
  for F,G being Functor of A, [:B,C:] st Pr1 F = Pr1 G & Pr2 F =
  Pr2 G holds F = G;

definition
  let A,B,C;
  let F1,F2 be Functor of A, [:B,C:];
  let t be natural_transformation of F1,F2;
  func Pr1 t -> natural_transformation of Pr1 F1, Pr1 F2 equals

  pr1(B,C)*t;
  func Pr2 t -> natural_transformation of Pr2 F1, Pr2 F2 equals

  pr2(B,C)*t;
end;

theorem 
  for F1,F2,G1,G2 being Functor of A, [:B,C:] st F1
  is_naturally_transformable_to F2 & G1 is_naturally_transformable_to G2 for s
being natural_transformation of F1,F2, t being natural_transformation of G1,G2
  st Pr1 s = Pr1 t & Pr2 s = Pr2 t holds s = t;

theorem 
  for F being Functor of A,B, G being Functor of A,C for a,b being
Object of A st Hom(a,b) <> {} for f being Morphism of a,b
   holds <:F,G:>.f = [F.f,G.f];

theorem 
  for F being Functor of A,B, G being Functor of A,C for a being
  Object of A holds <:F,G:>.a = [F.a,G.a];

theorem 
  for F1,G1 being Functor of A,B, F2,G2 being Functor of A,C st F1
  is_transformable_to G1 & F2 is_transformable_to G2 holds <:F1,F2:>
  is_transformable_to <:G1,G2:>;

definition
  let A,B,C;
  let F1,G1 be Functor of A,B, F2,G2 be Functor of A,C such that
 F1 is_transformable_to G1 & F2 is_transformable_to G2;
  let t1 be transformation of F1,G1, t2 be transformation of F2,G2;
  func <:t1,t2:> -> transformation of <:F1,F2:>,<:G1,G2:> equals


  <:t1,
  t2:>;
end;

theorem 
  for F1,G1 being Functor of A,B, F2,G2 being Functor of A,C st F1
is_transformable_to G1 & F2 is_transformable_to G2 for t1 being transformation
of F1,G1, t2 being transformation of F2,G2 for a being Object of A holds <:t1,
  t2:>.a = [t1.a,t2.a];

theorem 
  for F1,G1 being Functor of A,B, F2,G2 being Functor of A,C st F1
is_naturally_transformable_to G1 & F2 is_naturally_transformable_to G2 holds <:
  F1,F2:> is_naturally_transformable_to <:G1,G2:>;

definition
  let A,B,C;
  let F1,G1 be Functor of A,B, F2,G2 be Functor of A,C such that
 F1 is_naturally_transformable_to G1 & F2 is_naturally_transformable_to G2;
  let t1 be natural_transformation of F1,G1, t2 be natural_transformation of
  F2,G2;
  func <:t1,t2:> -> natural_transformation of <:F1,F2:>,<:G1,G2:> equals


   <:t1,t2:>;
end;

theorem 
  for F1,G1 being Functor of A,B, F2,G2 being Functor of A,C st F1
  is_naturally_transformable_to G1 & F2 is_naturally_transformable_to G2 for t1
being natural_transformation of F1,G1, t2 being natural_transformation of F2,G2
  holds Pr1<:t1,t2:> = t1 & Pr2<:t1,t2:> = t2;

definition
  let A,B,C;
  func distribute(A,B,C) -> Functor of Functors(A,[:B,C:]), [:Functors(A,B),
  Functors(A,C):] means


  for F1,F2 being Functor of A,[:B,C:] st F1
  is_naturally_transformable_to F2 for t being natural_transformation of F1,F2
  holds it.[[F1,F2],t] = [[[Pr1 F1, Pr1 F2],Pr1 t],[[Pr2 F1, Pr2 F2],Pr2 t]];
end;

registration
  let A,B,C;
  cluster distribute(A,B,C) -> isomorphic;
end;

theorem 
  Functors(A,[:B,C:]) ~= [:Functors(A,B),Functors(A,C):];














begin

reserve x for set,
  K for Ring,
  r for Scalar of K,
  V, M, M1, M2, N for LeftMod of K,
  a for Vector of V,
  m, m1, m2 for Vector of M,
  n, n1, n2 for Vector of N,
  A for Subset of V,
  l for Linear_Combination of A,
  W, W1, W2, W3 for Subspace of V;

notation
  let K, V;
  synonym Submodules(V) for Subspaces(V);
end;

theorem 
  M1 = the VectSpStr of M2 implies (x in M1 iff x in M2);

theorem 
  for v being Vector of the VectSpStr of V st a=v holds r*a = r*v;

theorem 
  the VectSpStr of V is strict Subspace of V;

theorem 
  V is Subspace of (Omega).V;

begin

definition
  let K;

  redefine attr K is trivial means


  0.K = 1_K;
end;

theorem 
  K is trivial implies (for r holds r = 0.K) & for a holds a = 0.V;

theorem 
  K is trivial implies V is trivial;

theorem 
  V is trivial iff the VectSpStr of V = (0).V;

begin 

definition
  let K,V;
  let W be strict Subspace of V;
  func @W -> Element of Submodules(V) equals

  W;
end;

theorem 
  for A being Subset of W holds A is Subset of V;

definition
  let K,V,W;
  let A be Subset of W;

  func @A -> Subset of V equals

  A;
end;

registration
  let K,V,W;
  let A be non empty Subset of W;
  cluster @A -> non empty;
end;

theorem 
  x in [#]V iff x in V;

theorem 
  x in @[#]W iff x in W;

theorem 
  A c= [#]Lin(A);

theorem 
  A<>{} & A is linearly-closed implies Sum(l) in A;

theorem 
  0.V in A & A is linearly-closed implies A = [#]Lin(A);

begin 

definition
  let K,V,a;
  func <:a:> -> strict Subspace of V equals

  Lin({a});
end;

begin 

definition
  let K,M,N;
  pred M c= N means


  M is Subspace of N;
  reflexivity;
end;

theorem 
  M c= N implies (x in M implies x in N) & (x is Vector of M
  implies x is Vector of N);

theorem 
  M c= N implies 0.M = 0.N & (m1 = n1 & m2 = n2 implies m1 + m2 = n1 +
n2) & (m = n implies r * m = r * n) & (m = n implies - n = - m) & (m1 = n1 & m2
  = n2 implies m1 - m2 = n1 - n2) & 0.N in M & 0.M in N & (n1 in M & n2 in M
implies n1 + n2 in M) & (n in M implies r * n in M) & (n in M implies - n in M)
  & (n1 in M & n2 in M implies n1 - n2 in M);

theorem 
  M1 c= N & M2 c= N implies 0.M1 = 0.M2 & 0.M1 in M2 & (the carrier of
  M1 c= the carrier of M2 implies M1 c= M2) & ((for n st n in M1 holds n in M2)
implies M1 c= M2) & (the carrier of M1 = the carrier of M2 & M1 is strict & M2
  is strict implies M1 = M2) & (0).M1 c= M2;

theorem 
  for V,M being strict LeftMod of K holds V c= M & M c= V implies V = M;

theorem 
  V c= M & M c= N implies V c= N;

theorem 
  M c= N implies (0).M c= N;

theorem 
  M c= N implies (0).N c= M;

theorem 
  M c= N implies M c= (Omega).N;

theorem 
  W1 c= W1 + W2 & W2 c= W1 + W2;

theorem 
  W1 /\ W2 c= W1 & W1 /\ W2 c= W2;

theorem 
  W1 c= W2 implies W1 /\ W3 c= W2 /\ W3;

theorem 
  W1 c= W3 implies W1 /\ W2 c= W3;

theorem 
  W1 c= W2 & W1 c= W3 implies W1 c= W2 /\ W3;

theorem 
  W1 /\ W2 c= W1 + W2;

theorem 
  (W1 /\ W2) + (W2 /\ W3) c= W2 /\ (W1 + W3);

theorem 
  W1 c= W2 implies W2 /\ (W1 + W3) = (W1 /\ W2) + (W2 /\ W3);

theorem 
  W2 + (W1 /\ W3) c= (W1 + W2) /\ (W2 + W3);

theorem 
  W1 c= W2 implies W2 + (W1 /\ W3) = (W1 + W2) /\ (W2 + W3);

theorem 
  W1 c= W2 implies W1 c= W2 + W3;

theorem 
  W1 c= W3 & W2 c= W3 implies W1 + W2 c= W3;

theorem 
  for A,B being Subset of V st A c= B holds Lin(A) c= Lin(B);

theorem 
  for A,B being Subset of V holds Lin(A /\ B) c= Lin(A) /\ Lin(B);

theorem 
  M1 c= M2 implies [#]M1 c= [#]M2;

theorem 
  W1 c= W2 iff for a st a in W1 holds a in W2;

theorem 
  W1 c= W2 iff [#]W1 c= [#]W2;

theorem 
  W1 c= W2 iff @[#]W1 c= @[#]W2;

theorem 
  (0).W c= V & (0).V c= W & (0).W1 c= W2;














begin

reserve V for RealLinearSpace;
reserve x,y for VECTOR of V;

notation
  let AS be non empty AffinStruct;
  let a,b,c,d be Element of AS;
  synonym a,b '//' c,d for a,b // c,d;
end;

theorem 
  Gen x,y implies (for u,u1,v,v1,w being Element of CESpace(V,x,y)
  holds ((u,u '//' v,w) & (u,v '//' w,w) & (u,v '//' u1,v1 & u,v '//' v1,u1
  implies u=v or u1=v1) & (u,v '//' u1,v1 & u,v '//' u1,w implies u,v '//' v1,w
or u,v '//' w,v1) & (u,v '//' u1,v1 implies v,u '//' v1,u1) & (u,v '//' u1,v1 &
  u,v '//' v1,w implies u,v '//' u1,w) & (u,u1 '//' v,v1 implies v,v1 '//' u,u1
  or v,v1 '//' u1,u))) & (for u,v,w being Element of CESpace(V,x,y) holds ex u1
  being Element of CESpace(V,x,y) st w<>u1 & w,u1 '//' u,v ) & for u,v,w being
Element of CESpace(V,x,y) holds ex u1 being Element of CESpace(V,x,y) st w<>u1
  & u,v '//' w,u1;

theorem 
  Gen x,y implies (for u,u1,v,v1,w being Element of CMSpace(V,x,y)
  holds ((u,u '//' v,w) & (u,v '//' w,w) & (u,v '//' u1,v1 & u,v '//' v1,u1
  implies u=v or u1=v1) & (u,v '//' u1,v1 & u,v '//' u1,w implies u,v '//' v1,w
or u,v '//' w,v1) & (u,v '//' u1,v1 implies v,u '//' v1,u1) & (u,v '//' u1,v1 &
  u,v '//' v1,w implies u,v '//' u1,w) & (u,u1 '//' v,v1 implies v,v1 '//' u,u1
  or v,v1 '//' u1,u))) & (for u,v,w being Element of CMSpace(V,x,y) holds ex u1
  being Element of CMSpace(V,x,y) st w<>u1 & w,u1 '//' u,v ) & for u,v,w being
Element of CMSpace(V,x,y) holds ex u1 being Element of CMSpace(V,x,y) st w<>u1
  & u,v '//' w,u1;

definition
  let IT be non empty AffinStruct;
  attr IT is Oriented_Orthogonality_Space-like means


  (for u,u1,v,v1,w
being Element of IT holds ((u,u '//' v,w) & (u,v '//' w,w) & (u,v '//' u1,v1 &
u,v '//' v1,u1 implies u=v or u1=v1) & (u,v '//' u1,v1 & u,v '//' u1,w implies
u,v '//' v1,w or u,v '//' w,v1) & (u,v '//' u1,v1 implies v,u '//' v1,u1) & (u,
v '//' u1,v1 & u,v '//' v1,w implies u,v '//' u1,w) & (u,u1 '//' v,v1 implies v
,v1 '//' u,u1 or v,v1 '//' u1,u))) & (for u,v,w being Element of IT holds ex u1
being Element of IT st w<>u1 & w,u1 '//' u,v ) & for u,v,w being Element of IT
  holds ex u1 being Element of IT st w<>u1 & u,v '//' w,u1;
end;

registration
  cluster Oriented_Orthogonality_Space-like for non empty AffinStruct;
end;

definition
  mode Oriented_Orthogonality_Space is Oriented_Orthogonality_Space-like non
    empty AffinStruct;
end;

theorem 
  Gen x,y implies CMSpace(V,x,y) is Oriented_Orthogonality_Space;

theorem 
  Gen x,y implies CESpace(V,x,y) is Oriented_Orthogonality_Space;

reserve AS for Oriented_Orthogonality_Space;
reserve u,u1,u2,u3,v,v1,v2,v3,w,w1 for Element of AS;

theorem 
  for u,v,w being Element of AS holds ex u1 being Element of AS st u1,w
  '//' u,v & u1<>w;

theorem 
  for u,v,w being Element of AS holds ex u1 being Element of AS st u<>u1
  & (v,w '//' u,u1 or v,w '//' u1,u);

definition
  let AS be Oriented_Orthogonality_Space;
  let a,b,c,d be Element of AS;
  pred a,b _|_ c,d means

  a,b '//' c,d or a,b '//' d,c;
end;

definition
  let AS be Oriented_Orthogonality_Space;
  let a,b,c,d be Element of AS;
  pred a,b // c,d means


  ex e,f being Element of AS st e<>f & e,f '//' a ,b & e,f '//' c,d;
end;

definition
  let IT be Oriented_Orthogonality_Space;
  attr IT is bach_transitive means


  for u,u1,u2,v,v1,v2,w,w1 being
Element of IT holds ( u,u1 '//' v,v1 & w,w1 '//' v,v1 & w,w1 '//' u2,v2 implies
  (w=w1 or v=v1 or u,u1 '//' u2,v2) );
end;

definition
  let IT be Oriented_Orthogonality_Space;
  attr IT is right_transitive means


  for u,u1,u2,v,v1,v2,w,w1 being
Element of IT holds ( u,u1 '//' v,v1 & v,v1 '//' w,w1 & u2,v2 '//' w,w1 implies
  (w=w1 or v=v1 or u,u1 '//' u2,v2) );
end;

definition
  let IT be Oriented_Orthogonality_Space;
  attr IT is left_transitive means


  for u,u1,u2,v,v1,v2,w,w1 being
Element of IT holds ( u,u1 '//' v,v1 & v,v1 '//' w,w1 & u,u1 '//' u2,v2 implies
  (u=u1 or v=v1 or u2,v2 '//' w,w1) );
end;

definition
  let IT be Oriented_Orthogonality_Space;
  attr IT is Euclidean_like means


  for u,u1,v,v1 being Element of IT
  holds (u,u1 '//' v,v1 implies v,v1 '//' u1,u );
end;

definition
  let IT be Oriented_Orthogonality_Space;
  attr IT is Minkowskian_like means


  for u,u1,v,v1 being Element of IT
  holds (u,u1 '//' v,v1 implies v,v1 '//' u,u1 );
end;

theorem 
  u,u1 // w,w & w,w // u,u1;

theorem 
  u,u1 // v,v1 implies v,v1 // u,u1;

theorem 
  u,u1 // v,v1 implies u1,u // v1,v;

theorem 
  AS is left_transitive iff for v,v1,w,w1,u2,v2 holds (v,v1 // u2,v2 & v
  ,v1 '//' w,w1 & v<>v1 implies u2,v2 '//' w,w1);

theorem 
  AS is bach_transitive iff for u,u1,u2,v,v1,v2 holds (u,u1 '//' v
  ,v1 & v,v1 // u2,v2 & v<>v1 implies u,u1 '//' u2,v2);

theorem 
  AS is bach_transitive implies for u,u1,v,v1,w,w1 holds (u,u1 // v,v1 &
  v,v1 // w,w1 & v<>v1 implies u,u1 // w,w1);

theorem 
  Gen x,y & AS=CESpace(V,x,y) implies AS is Euclidean_like
  left_transitive right_transitive bach_transitive;

registration
  cluster Euclidean_like left_transitive right_transitive bach_transitive
    for Oriented_Orthogonality_Space;
end;

theorem 
  Gen x,y & AS=CMSpace(V,x,y) implies AS is Minkowskian_like
  left_transitive right_transitive bach_transitive;

registration
  cluster Minkowskian_like left_transitive right_transitive bach_transitive
    for Oriented_Orthogonality_Space;
end;

theorem 
  AS is left_transitive implies AS is right_transitive;

theorem 
  AS is left_transitive implies AS is bach_transitive;

theorem 
  AS is bach_transitive implies (AS is right_transitive iff for u,u1,v,
v1,u2,v2 holds ( u,u1 '//' u2,v2 & v,v1 '//' u2,v2 & u2<>v2 implies u,u1 // v,
  v1) );

theorem 
  AS is right_transitive & (AS is Euclidean_like or AS is
  Minkowskian_like) implies AS is left_transitive;














begin 

registration let G be non empty addMagma;
  cluster id G -> bijective;
end;

reserve A,B,C for non empty set,
  f for Function of [:A,B:],C;

definition
  let A,B,C,f;
  redefine func ~f -> Function of [:B,A:],C;
end;

theorem 
  for x being Element of A, y being Element of B holds f.(x,y) = ~f .(y,x);

begin 

reserve K for non empty doubleLoopStr;

definition let K;
  func opp K -> strict doubleLoopStr equals

  doubleLoopStr
    (# the carrier of K, the addF of K, ~(the multF of K), 1.K, 0.K #);
end;

registration let K;
  cluster opp(K) -> non empty;
end;

registration
  let K be well-unital non empty doubleLoopStr;
  cluster opp(K) -> well-unital;
end;

registration
  let K be add-associative right_complementable right_zeroed non empty
  doubleLoopStr;
  cluster opp K -> add-associative right_zeroed right_complementable;
end;

theorem 
  the addLoopStr of opp(K) = the addLoopStr of K & (K is add-associative
  right_zeroed right_complementable implies comp opp K = comp K) & for x being
  set holds x is Scalar of opp(K) iff x is Scalar of K;

theorem 
  (for K being unital non empty doubleLoopStr holds 1.K = 1.opp(K)) &
  for K being add-associative right_zeroed right_complementable non empty
doubleLoopStr holds 0.K = 0.opp(K) & for x,y,z,u being (Scalar of K), a,b,c,d
being Scalar of opp(K) st x = a & y = b & z = c & u = d holds x+y = a+b & x*y =
b*a & -x = -a & (x+y)+z = (a+b)+c & x+(y+z) = a+(b+c) & (x*y)*z = c*(b*a) & x*(
  y*z) = (c*b)*a & x*(y+z) = (b+c)*a & (y+z)*x = a*(b+c) & x*y+z*u = b*a+d*c;

registration
  let K be Abelian non empty doubleLoopStr;
  cluster opp K -> Abelian;
end;

registration
  let K be add-associative non empty doubleLoopStr;
  cluster opp K -> add-associative;
end;

registration
  let K be right_zeroed non empty doubleLoopStr;
  cluster opp K -> right_zeroed;
end;

registration
  let K be right_complementable non empty doubleLoopStr;
  cluster opp K -> right_complementable;
end;

registration
  let K be associative non empty doubleLoopStr;
  cluster opp K -> associative;
end;

registration
  let K be distributive non empty doubleLoopStr;
  cluster opp K -> distributive;
end;

theorem 
  for K being Ring holds opp(K) is strict Ring;

theorem 
  for K being Skew-Field holds opp(K) is Skew-Field;

registration
  let K be Skew-Field;
  cluster opp(K) -> non degenerated almost_left_invertible associative Abelian
    add-associative right_zeroed right_complementable unital distributive;
end;

theorem 
  for K being Field holds opp(K) is strict Field;

registration let K be Field;
  cluster opp(K) -> almost_left_invertible;
end;

begin 

reserve V for non empty VectSpStr over K;

definition let K,V;
  func opp(V) -> strict RightModStr over opp(K) means


  for o being
Function of [:the carrier of V, the carrier of opp(K):], the carrier of V st o
= ~(the lmult of V) holds it = RightModStr (# the carrier of V, the addF of V,
    0.V, o #);
end;

registration let K,V;
  cluster opp(V) -> non empty;
end;

theorem 
  the addLoopStr of opp(V) = the addLoopStr of V & for x being set
  holds x is Vector of V iff x is Vector of opp(V);

definition
  let K,V;
  let o be Function of [:the carrier of K, the carrier of V:], the carrier of
  V;
  func opp(o) -> Function of [:the carrier of opp(V), the carrier of opp(K):],
  the carrier of opp(V) equals

  ~o;
end;

theorem 
  the rmult of opp(V) = opp(the lmult of V);

reserve W for non empty RightModStr over K;

definition let K,W;
  func opp(W) -> strict VectSpStr over opp(K) means

  for o being
Function of [:the carrier of opp(K), the carrier of W:], the carrier of W st o
= ~(the rmult of W) holds it = VectSpStr (# the carrier of W, the addF of W, 0.
    W, o #);
end;

registration let K,W;
  cluster opp(W) -> non empty;
end;

theorem 
  the addLoopStr of opp(W) = the addLoopStr of W & for x being set
  holds x is Vector of W iff x is Vector of opp(W);

definition let K,W;
  let o be Function of [:the carrier of W, the carrier of K:], the carrier of
  W;
  func opp(o) -> Function of [:the carrier of opp(K), the carrier of opp(W):],
  the carrier of opp(W) equals

  ~o;
end;

theorem 
  the lmult of opp(W) = opp(the rmult of W);

theorem 
  for o being Function of [:the carrier of K, the carrier of V:], the
carrier of V, x being Scalar of K, y being Scalar of opp(K), v being Vector of
V, w being Vector of opp(V) st x=y & v=w holds (opp(o)).(w,y) = o.(x,v);

theorem 
  for K,L being Ring, V being non empty VectSpStr over K for W
being non empty RightModStr over L for x being Scalar of K, y being Scalar of L
  , v being Vector of V, w being Vector of W st L=opp(K) & W=opp(V) & x=y & v=w
  holds w*y = x*v;

theorem 
  for K,L being Ring, V being non empty VectSpStr over K for W
  being non empty RightModStr over L for v1,v2 being Vector of V, w1,w2 being
  Vector of W st W=opp(V) & v1=w1 & v2=w2 holds w1+w2=v1+v2;

theorem 
  for o being Function of [:the carrier of W, the carrier of K:], the
carrier of W, x being Scalar of K, y being Scalar of opp(K), v being Vector of
W, w being Vector of opp(W) st x=y & v=w holds (opp(o)).(y,w) = o.(v,x);

theorem 
  for K,L being Ring, V being non empty VectSpStr over K for W
being non empty RightModStr over L for x being Scalar of K, y being Scalar of L
, v being Vector of V, w being Vector of W st V=opp(W) & x=y & v=w holds w*y =
  x*v;

theorem 
  for K,L being Ring, V being non empty VectSpStr over K for W
  being non empty RightModStr over L for v1,v2 being Vector of V, w1,w2 being
  Vector of W st V=opp(W) & v1=w1 & v2=w2 holds w1+w2=v1+v2;

theorem 
  for K being strict non empty doubleLoopStr, V being non empty
  VectSpStr over K holds opp(opp(V)) = the VectSpStr of V;

theorem 
  for K being strict non empty doubleLoopStr, W being non empty
  RightModStr over K holds opp(opp(W)) = the RightModStr of W;

theorem 
  for K being Ring, V being LeftMod of K holds opp V is strict
  RightMod of opp K;

registration let K be Ring, V be LeftMod of K;
  cluster opp(V) -> Abelian add-associative right_zeroed right_complementable
    RightMod-like;
end;

theorem 
  for K being Ring, W being RightMod of K holds
    opp W is strict LeftMod of opp K;

registration
  let K be Ring, W be RightMod of K;
  cluster opp(W) -> Abelian add-associative right_zeroed right_complementable
    vector-distributive scalar-distributive scalar-associative scalar-unital;
end;

begin 

definition
  let K,L be non empty multMagma;
  let IT be Function of K,L;
  attr IT is antimultiplicative means

  for x,y being Scalar of K holds IT.(x*y) = IT.y*IT.x;
end;

definition
  let K,L be non empty doubleLoopStr;
  let IT be Function of K,L;
  attr IT is antilinear means

  IT is additive antimultiplicative unity-preserving;
end;

registration
  let K,L be non empty doubleLoopStr;
  cluster antilinear -> additive antimultiplicative unity-preserving for
Function
    of K,L;
  cluster additive antimultiplicative unity-preserving -> antilinear for
Function
    of K,L;
end;

definition
  let K,L be non empty doubleLoopStr;
  let IT be Function of K,L;
  attr IT is monomorphism means

  IT is linear one-to-one;
  attr IT is antimonomorphism means

  IT is antilinear one-to-one;
end;

definition
  let K,L be non empty doubleLoopStr;
  let IT be Function of K,L;
  attr IT is epimorphism means

  IT is linear onto;
  attr IT is antiepimorphism means

  IT is antilinear onto;
end;

definition
  let K,L be non empty doubleLoopStr;
  let IT be Function of K,L;
  attr IT is isomorphism means

  IT is monomorphism onto;
  attr IT is antiisomorphism means

  IT is antimonomorphism onto;
end;

reserve J for Function of K,K;

definition
  let K be non empty doubleLoopStr;
  let IT be Function of K,K;
  attr IT is endomorphism means

  IT is linear;
  attr IT is antiendomorphism means

  IT is antilinear;

end;

theorem 
  J is isomorphism iff J is additive &
  (for x,y being Scalar of K holds J.(x*y) = J.x*J.y) & J.(1_K) = 1_K & J
  is one-to-one onto;

theorem 
  J is antiisomorphism iff J is additive
  & (for x,y being Scalar of K holds J.(x*y) = J.y*J.x) & J.(1_K) =
  1_K & J is one-to-one & J is onto;

registration let K;
  cluster id K -> isomorphism;
end;

reserve K,L for Ring;
reserve J for Function of K,L;
reserve x,y for Scalar of K;

theorem 
  J is linear implies J.(0.K) = 0.L & J.(-x) = -J.x & J.(x-y) = J.x-J.y;

theorem 
  J is antilinear implies J.(0.K) = 0.L & J.(-x) = -J.x & J.(x-y) = J.x-
  J.y;

theorem 
  for K being Ring holds id K is antiisomorphism iff K is comRing;

theorem 
  for K being Skew-Field holds id K is antiisomorphism iff K is Field;

begin 

definition
  let K,L be non empty doubleLoopStr, J be Function of K,L;
  func opp(J) -> Function of K,opp(L) equals

  J;
end;

reserve K,L for add-associative right_zeroed right_complementable non empty
  doubleLoopStr;
reserve J for Function of K,L;

reserve K for add-associative right_zeroed right_complementable non empty
  doubleLoopStr;
reserve L for add-associative right_zeroed right_complementable well-unital
  non empty doubleLoopStr;
reserve J for Function of K,L;

canceled;

theorem 
  J is linear iff opp(J) is antilinear;

theorem 
  J is antilinear iff opp(J) is linear;

theorem 
  J is monomorphism iff opp(J) is antimonomorphism;

theorem 
  J is antimonomorphism iff opp(J) is monomorphism;

theorem 
  J is epimorphism iff opp(J) is antiepimorphism;

theorem 
  J is antiepimorphism iff opp(J) is epimorphism;

theorem 
  J is isomorphism iff opp(J) is antiisomorphism;

theorem 
  J is antiisomorphism iff opp(J) is isomorphism;

reserve K for add-associative right_zeroed right_complementable well-unital
  non empty doubleLoopStr;
reserve J for Function of K,K;

theorem 
  J is endomorphism iff opp(J) is antilinear;

theorem 
  J is antiendomorphism iff opp(J) is linear;

theorem 
  J is isomorphism iff opp(J) is antiisomorphism;

theorem 
  J is antiisomorphism iff opp(J) is isomorphism;

begin 

definition let G,H be AddGroup;
  mode Homomorphism of G,H is additive Function of G,H;
end;

definition let G be AddGroup;
  mode Endomorphism of G is Homomorphism of G,G;
end;

registration let G be AddGroup;
  cluster bijective for Endomorphism of G;
end;

definition let G be AddGroup;
  mode Automorphism of G is bijective Endomorphism of G;
end;

reserve G,H for AddGroup;
reserve f for Homomorphism of G,H;
reserve x,y for Element of G;

theorem 
  f.(0.G) = 0.H & f.(-x) = -f.x & f.(x-y) = f.x-f.y;

begin 

reserve G,H for AbGroup;
reserve f for Homomorphism of G,H;
reserve x,y for Element of G;
reserve K,L for Ring;
reserve J for Function of K,L;
reserve V for LeftMod of K;
reserve W for LeftMod of L;

definition let K,L,J,V,W;

  mode Homomorphism of J,V,W -> Function of V,W means

    (for x,y being Vector of V holds it.(x+y) = it.x+it.y) &
    for a being Scalar of K, x being Vector of V holds it.(a*x) = J.a*it.x;
end;

theorem 
  ZeroMap(V,W) is Homomorphism of J,V,W;

reserve J for Function of K,K;
reserve f for Homomorphism of J,V,V;
reserve W for LeftMod of K;

definition let K,J,V;
  mode Endomorphism of J,V is Homomorphism of J,V,V;
end;

definition let K,V,W;
  mode Homomorphism of V,W is Homomorphism of (id K),V,W;
end;

theorem 
  for f being Function of V,W holds f is Homomorphism of V,W iff
  (for x, y being Vector of V holds f.(x+y) = f.x+f.y) &
  for a being Scalar of K, x being Vector of V holds f.(a*x) = a*f.x;

definition let K,V;
  mode Endomorphism of V is Homomorphism of V,V;
end;















begin 

reserve i for Element of NAT;

begin 
reserve R for Relation;
reserve A for set;

theorem 
  R well_orders A implies R |_2 A well_orders A & A = field (R |_2 A);

scheme 

  MinSet{A()->set,R()->Relation,P[set]}: ex X be set st X in A() & P[X] & for
  Y be set st Y in A() & P[Y] holds [X,Y] in R()
provided
 R() well_orders A() and
 ex X be set st X in A() & P[X];

definition
  let FX be set, R be Relation, B be Element of FX;
  func PartUnion(B,R) equals

  union (R-Seg(B));
end;

definition
  let FX be set, R be Relation;
  func DisjointFam(FX,R) means

  A in it iff ex B be Element of FX st B in FX & A = B\PartUnion(B,R);
end;

definition
  let X be set, n be Element of NAT, f be Function of NAT,bool X;
  func PartUnionNat(n,f) equals

  union (f.:(Seg(n)\{n}));
end;

begin 

reserve PT for non empty TopSpace;
reserve PM for MetrSpace;
reserve FX,GX,HX for Subset-Family of PT;
reserve Y,V,W for Subset of PT;

theorem 
  PT is regular implies for FX st FX is Cover of PT & FX is open ex
HX st HX is open & HX is Cover of PT & for V st V in HX ex W st W in FX & Cl V
  c= W;

theorem 
  for PT,FX st PT is T_2 & PT is paracompact & FX is Cover of PT & FX is
open ex GX st GX is open & GX is Cover of PT & clf GX is_finer_than FX & GX is
  locally_finite;

theorem 
  for f being Function of [:the carrier of PT,the carrier of PT:],
REAL st f is_metric_of ( the carrier of PT) holds PM = SpaceMetr(the carrier of
  PT,f) implies the carrier of PM = the carrier of PT;

theorem 
  for f being Function of [:the carrier of PT,the carrier of PT:],REAL
st f is_metric_of ( the carrier of PT) holds PM = SpaceMetr(the carrier of PT,f
  ) implies (FX is Subset-Family of PT iff FX is Subset-Family of PM);

reserve Mn for Relation;
reserve n,k,l,q,p,q1 for Element of NAT;

definition
  let PM be non empty set;
  let g be Function of NAT,(bool bool PM)*;
  let n;
  redefine func g.n -> FinSequence of bool bool PM;
end;

scheme 

  XXX1 { PM() -> non empty set, UB() -> Subset-Family of PM(), F(set,set) ->
Subset of PM(), P[set], Q[set,set,set,set]} : ex f being Function of NAT, bool
  bool PM() st f.0 = UB() & for n holds f.(n+1) = {union { F(c,n) where c is
Element of PM(): for fq be Subset-Family of PM(),q st q <= n & fq = f.q holds Q
  [c,V,n,fq] } where V is Subset of PM() : P[V]};

scheme 

  XXX { PM() -> non empty set, UB() -> Subset-Family of PM(), F(set,set) ->
Subset of PM(), P[set], Q[set,set,set]} : ex f being Function of NAT, bool bool
PM() st f.0 = UB() & for n holds f.(n+1) = { union { F(c,n) where c is Element
of PM(): Q[c,V,n] & not c in union{union(f.q): q <= n } } where V is Subset of
  PM() : P[V]};

theorem 
  PT is metrizable implies for FX being Subset-Family of PT st FX
is Cover of PT & FX is open ex GX being Subset-Family of PT st GX is open & GX
  is Cover of PT & GX is_finer_than FX & GX is locally_finite;

theorem 
  PT is metrizable implies PT is paracompact;














begin

reserve p,p1,p2,q for Point of TOP-REAL 2,
  f,g,g1,g2 for FinSequence of TOP-REAL 2,
  n,m,i,j,k for Element of NAT,
  G for Go-board,
  x for set;

theorem 
  (for n st n in dom f ex i,j st [i,j] in Indices G & f/.n=G*(i,j))
& f is one-to-one unfolded s.n.c. special implies ex g st g is_sequence_on G &
g is one-to-one unfolded s.n.c. special & L~f = L~g & f/.1 = g/.1 & f/.len f =
  g/.len g & len f <= len g;

theorem 
  (for n st n in dom f ex i,j st [i,j] in Indices G & f/.n=G*(i,j)) & f
is being_S-Seq implies ex g st g is_sequence_on G & g is being_S-Seq & L~f = L~
  g & f/.1 = g/.1 & f/.len f = g/.len g & len f<=len g;














begin

reserve p,p1,p2,q1,q2 for Point of TOP-REAL 2,
  P1,P2 for Subset of TOP-REAL 2,
  f,f1,f2,g1,g2 for FinSequence of TOP-REAL 2,
  n,m,i,j,k for Element of NAT,
  G,G1 for Go-board,
  x,y for set;

theorem 
  for G,f1,f2 st 1<=len f1 & 1<=len f2 & f1 is_sequence_on G & f2
  is_sequence_on G & f1/.1 in rng Line(G,1) & f1/.len f1 in rng Line(G,len G) &
f2/.1 in rng Col(G,1) & f2/.len f2 in rng Col(G,width G) holds rng f1 meets rng
  f2;

theorem 
  for G,f1,f2 st 2<=len f1 & 2<=len f2 & f1 is_sequence_on G & f2
  is_sequence_on G & f1/.1 in rng Line(G,1) & f1/.len f1 in rng Line(G,len G) &
f2/.1 in rng Col(G,1) & f2/.len f2 in rng Col(G,width G) holds L~f1 meets L~f2;

theorem 
  for G,f1,f2 st 2 <= len f1 & 2 <= len f2 & f1 is_sequence_on G & f2
  is_sequence_on G & f1/.1 in rng Line(G,1) & f1/.len f1 in rng Line(G,len G) &
f2/.1 in rng Col(G,1) & f2/.len f2 in rng Col(G,width G) holds L~f1 meets L~f2;

definition
  let f be Relation, r,s be Real;
  pred f lies_between r,s means


  rng f c= [. r,s .];
end;

definition
  let f be FinSequence of REAL, r,s be Real;
  redefine pred f lies_between r,s means


  for n st n in dom f holds r <= f.n & f.n <= s;
end;

theorem 
  for f1,f2 being FinSequence of TOP-REAL 2 st 2<=len f1 & 2<=len
  f2 & f1 is special & f2 is special & (for n st n in dom f1 & n+1 in dom f1
  holds f1/.n <> f1/.(n+1)) & (for n st n in dom f2 & n+1 in dom f2 holds f2/.n
<> f2/.(n+1)) & X_axis(f1) lies_between (X_axis(f1)).1, (X_axis(f1)).(len f1) &
  X_axis(f2) lies_between (X_axis(f1)).1, (X_axis(f1)).(len f1) & Y_axis(f1)
lies_between (Y_axis(f2)).1, (Y_axis(f2)).(len f2) & Y_axis(f2) lies_between (
  Y_axis(f2)).1, (Y_axis(f2)).(len f2) holds L~f1 meets L~f2;

theorem 
  for f1,f2 being FinSequence of TOP-REAL 2 st f1 is one-to-one
  special & 2 <= len f1 & f2 is one-to-one special & 2 <= len f2 & X_axis(f1)
lies_between (X_axis(f1)).1, (X_axis(f1)).(len f1) & X_axis(f2) lies_between (
X_axis(f1)).1, (X_axis(f1)).(len f1) & Y_axis(f1) lies_between (Y_axis(f2)).1,
(Y_axis(f2)).(len f2) & Y_axis(f2) lies_between (Y_axis(f2)).1, (Y_axis(f2)).(
  len f2) holds L~f1 meets L~f2;

theorem 
  for P1,P2,p1,p2,q1,q2 st P1 is_S-P_arc_joining p1,q1 & P2
is_S-P_arc_joining p2,q2 & (for p st p in P1 \/ P2 holds p1`1<=p`1 & p`1<=q1`1)
  & (for p st p in P1 \/ P2 holds p2`2<=p`2 & p`2<=q2`2) holds P1 meets P2;














begin

reserve o,m for set;

definition
  let C be Category, a,b be Object of C;

  redefine pred a,b are_isomorphic means

  Hom(a,b)<>{} & Hom(b,a)<>{} & ex f
  being Morphism of a,b, f9 being Morphism of b,a st f*f9 = id b & f9*f = id a;
end;

begin 

definition
  let C be Category;
  attr C is with_finite_product means

  for I being finite set, F being Function
of I,the carrier of C ex a being Object of C, F9 being Projections_family of a,
  I st cods F9 = F & a is_a_product_wrt F9;
end;

theorem 
  for C being Category holds C is with_finite_product iff (ex a
  being Object of C st a is terminal) & for a,b being Object of C ex c being
Object of C, p1,p2 being Morphism of C st dom p1 = c & dom p2 = c & cod p1 = a
  & cod p2 = b & c is_a_product_wrt p1,p2;

definition
  struct (CatStr)ProdCatStr (# carrier,carrier' -> set, Source,Target ->
Function of the carrier', the carrier, Comp -> PartFunc of [:the carrier', the
    carrier' :],the carrier',
TerminalObj -> Element of the carrier, CatProd -> Function of [:the carrier,the
carrier:],the carrier, Proj1,Proj2 -> Function of [:the carrier,the carrier:],
    the carrier' #);
end;

registration
  cluster non void non empty for ProdCatStr;
end;

definition
  let C be non void non empty ProdCatStr;
  func [1]C -> Object of C equals

  the TerminalObj of C;
  let a,b be Object of C;
  func a[x]b -> Object of C equals

  (the CatProd of C).(a,b);
  func pr1(a,b) -> Morphism of C equals

  (the Proj1 of C).(a,b);
  func pr2(a,b) -> Morphism of C equals

  (the Proj2 of C).(a,b);
end;

definition
  let o,m;
  func c1Cat(o,m) -> strict ProdCatStr equals

  ProdCatStr(# {o},{m},m:->o,m:->o,(m,m):->m,
  Extract(o),(o,o):->o,(o,o):->m,(o,o):->m #);
end;

registration let o,m be set;
 cluster c1Cat(o,m) -> non empty trivial non void trivial';
end;

theorem 
  the CatStr of c1Cat(o,m) = 1Cat(o,m);

registration
  cluster strict Category-like reflexive transitive
   associative with_identities
   non void non empty for non void non empty ProdCatStr;
end;

registration
  let o,m be set;
  cluster c1Cat(o,m) -> Category-like reflexive transitive
   associative with_identities non empty non void;
end;

theorem 
  for a,b being Object of c1Cat(o,m) holds a = b;

theorem 
  for f,g being Morphism of c1Cat(o,m) holds f = g;

theorem 
  for a,b being Object of c1Cat(o,m), f being Morphism of c1Cat(o,m
  ) holds f in Hom(a,b);

theorem 
  for a,b being Object of c1Cat(o,m), f being Morphism of c1Cat(o,m)
  holds f is Morphism of a,b;

theorem 
  for a,b being Object of c1Cat(o,m) holds Hom(a,b) <> {};

theorem 
  for a being Object of c1Cat(o,m) holds a is terminal;

theorem 
  for c being Object of c1Cat(o,m), p1,p2 being Morphism of c1Cat(
  o,m) holds c is_a_product_wrt p1,p2;

definition
  let IT be Category-like reflexive transitive
    associative with_identities
    non void non empty ProdCatStr;
  attr IT is Cartesian means


  the TerminalObj of IT is terminal & for a,
b being Object of IT holds cod((the Proj1 of IT).(a,b)) = a & cod((the Proj2 of
IT).(a,b)) = b & (the CatProd of IT).(a,b) is_a_product_wrt (the Proj1 of IT).(
  a,b),(the Proj2 of IT).(a,b);
end;

theorem 
  for o,m being set holds c1Cat(o,m) is Cartesian;

registration
  cluster strict Cartesian
  for Category-like reflexive transitive associative with_identities
   non void non empty ProdCatStr;
end;

definition
  mode Cartesian_category is Cartesian
   Category-like non void non empty
     reflexive transitive associative with_identities
   non void non empty
    ProdCatStr;
end;

reserve C for Cartesian_category;
reserve a,b,c,d,e,s for Object of C;

theorem 
  [1]C is terminal;

theorem 
  for f1,f2 being Morphism of a,[1]C holds f1 = f2;

theorem 
  Hom(a,[1]C) <> {};

definition
  let C,a;
  func term(a) -> Morphism of a,[1]C means

  not contradiction;
end;

theorem 
  term a = term(a,[1]C);

theorem 
  dom(term a) = a & cod(term a) = [1]C;

theorem 
  Hom(a,[1]C) = {term a};

theorem 
  dom pr1(a,b) = a[x]b & cod pr1(a,b) = a;

theorem 
  dom pr2(a,b) = a[x]b & cod pr2(a,b) = b;

definition
  let C,a,b;
  redefine func pr1(a,b) -> Morphism of a[x]b,a;
  redefine func pr2(a,b) -> Morphism of a[x]b,b;
end;

theorem 
  Hom(a[x]b,a) <> {} & Hom(a[x]b,b) <> {};

theorem 
  a[x]b is_a_product_wrt pr1(a,b),pr2(a,b);

theorem 
  C is with_finite_product;

theorem 
  Hom(a,b) <> {} & Hom(b,a) <> {}
  implies pr1(a,b) is retraction & pr2(a,b) is retraction;

definition
  let C,a,b,c;
  let f be Morphism of c,a, g be Morphism of c,b;
  assume
 Hom(c,a) <> {} & Hom(c,b) <> {};
  func <:f,g:> -> Morphism of c,a[x]b means


  pr1(a,b)*it = f & pr2(a,b) *it = g;
end;

theorem 
  Hom(c,a) <> {} & Hom(c,b) <> {} implies Hom(c,a[x]b) <> {};

theorem 
  <:pr1(a,b),pr2(a,b):> = id(a[x]b);

theorem 
  for f being Morphism of c,a, g being Morphism of c,b, h being
Morphism of d,c st Hom(c,a)<>{} & Hom(c,b)<>{} & Hom(d,c)<>{} holds <:f*h,g*h:>
  = <:f,g:>*h;

theorem 
  for f,k being Morphism of c,a, g,h being Morphism of c,b st Hom(
  c,a) <> {} & Hom(c,b) <> {} & <:f,g:> = <:k,h:> holds f = k & g = h;

theorem 
  for f being Morphism of c,a, g being Morphism of c,b st Hom(c,a) <> {}
  & Hom(c,b) <> {} & (f is monic or g is monic) holds <:f,g:> is monic;

theorem 
  Hom(a,a[x][1]C) <> {} & Hom(a,[1]C[x]a) <> {};

definition
  let C,a;
  func lambda(a) -> Morphism of [1]C[x]a,a equals

  pr2([1]C,a);
  func lambda'(a) -> Morphism of a,[1]C[x]a equals

  <:term a,id a:>;
  func rho(a) -> Morphism of a[x][1]C,a equals

  pr1(a,[1]C);
  func rho'(a) -> Morphism of a,a[x][1]C equals

  <:id a,term a:>;
end;

theorem 
  lambda(a)*lambda'(a) = id a & lambda'(a)*lambda(a) = id([1]C[x]a
  ) & rho(a)*rho'(a) = id a & rho'(a)*rho(a) = id(a[x][1]C);

theorem 
  a, a[x][1]C are_isomorphic & a,[1]C[x]a are_isomorphic;

definition
  let C,a,b;
  func Switch(a,b) -> Morphism of a[x]b,b[x]a equals

  <:pr2(a,b),pr1(a,b):>;
end;

theorem 
  Hom(a[x]b,b[x]a)<>{};

theorem 
  Switch(a,b)*Switch(b,a) = id(b[x]a);

theorem 
  a[x]b,b[x]a are_isomorphic;

definition
  let C,a;
  func Delta a -> Morphism of a,a[x]a equals

  <:id a,id a:>;
end;

theorem 
  Hom(a,a[x]a) <> {};

theorem 
  for f being Morphism of a,b st Hom(a,b) <> {} holds <:f,f:> = Delta(b) *f;

definition
  let C,a,b,c;
  func Alpha(a,b,c) -> Morphism of (a[x]b)[x]c,a[x](b[x]c) equals

  <:pr1(a,b)*
  pr1(a[x]b,c),<:pr2(a,b)*pr1(a[x]b,c),pr2(a[x]b,c):>:>;
  func Alpha'(a,b,c) -> Morphism of a[x](b[x]c),(a[x]b)[x]c equals

  <:<:pr1(a,b
  [x]c),pr1(b,c)*pr2(a,b[x]c):>,pr2(b,c)*pr2(a,b[x]c):>;
end;

theorem 
  Hom((a[x]b)[x]c,a[x](b[x]c)) <> {} & Hom(a[x](b[x]c),(a[x]b)[x]c ) <> {};

theorem 
  Alpha(a,b,c)*Alpha'(a,b,c) = id(a[x](b[x]c)) & Alpha'(a,b,c)*
  Alpha(a,b,c) = id((a[x]b)[x]c);

theorem 
  (a[x]b)[x]c,a[x](b[x]c) are_isomorphic;

definition
  let C,a,b,c,d;
  let f be Morphism of a,b, g be Morphism of c,d;
  func f[x]g -> Morphism of a[x]c,b[x]d equals

  <:f*pr1(a,c),g*pr2(a,c):>;
end;

theorem 
  Hom(a,c) <> {} & Hom(b,d) <> {} implies Hom(a[x]b,c[x]d) <> {};

theorem 
  (id a)[x](id b) = id(a[x]b);

theorem 
  for f being Morphism of a,b, h being Morphism of c,d, g being
  Morphism of e,a, k being Morphism of e,c st Hom(a,b) <> {} & Hom(c,d) <> {} &
  Hom(e,a) <> {} & Hom(e,c) <> {} holds (f[x]h)*<:g,k:> = <:f*g,h*k:>;

theorem 
  for f being Morphism of c,a, g being Morphism of c,b st Hom(c,a) <> {}
  & Hom(c,b) <> {} holds <:f,g:> = (f[x]g)*Delta(c);

theorem 
  for f being Morphism of a,b, h being Morphism of c,d, g being Morphism
  of e,a, k being Morphism of s,c st Hom(a,b) <> {} & Hom(c,d) <> {} & Hom(e,a)
  <> {} & Hom(s,c) <> {} holds (f[x]h)*(g[x]k) = (f*g)[x](h*k);

begin 

definition
  let C be Category;
  attr C is with_finite_coproduct means

  for I being finite set, F being
  Function of I,the carrier of C ex a being Object of C, F9 being
  Injections_family of a,I st doms F9 = F & a is_a_coproduct_wrt F9;
end;

theorem 
  for C being Category holds C is with_finite_coproduct iff (ex a
  being Object of C st a is initial) & for a,b being Object of C ex c being
Object of C, i1,i2 being Morphism of C st dom i1 = a & dom i2 = b & cod i1 = c
  & cod i2 = c & c is_a_coproduct_wrt i1,i2;

definition
  struct (CatStr)CoprodCatStr (# carrier,carrier' -> set, Source,Target ->
Function of the carrier', the carrier, Comp -> PartFunc of [:the carrier', the
carrier' :],the carrier',
  Initial
-> Element of the carrier, Coproduct -> Function of [:the carrier,the carrier:]
    ,the carrier, Incl1,Incl2 -> Function of [:the carrier,the carrier:],the
    carrier' #);
end;

registration
  cluster non void non empty for CoprodCatStr;
end;

definition
  let C be non void non empty CoprodCatStr;
  func [[0]]C -> Object of C equals

  the Initial of C;
  let a,b be Object of C;
  func a+b -> Object of C equals

  (the Coproduct of C).(a,b);
  func in1(a,b) -> Morphism of C equals

  (the Incl1 of C).(a,b);
  func in2(a,b) -> Morphism of C equals

  (the Incl2 of C).(a,b);
end;

definition
  let o,m;
  func c1Cat*(o,m) -> strict CoprodCatStr equals

  CoprodCatStr(# {o},{m},m:->o,m:->o,(m,m):->m,
Extract(o),(o,o):->o,(o,o):->m,(o,o):->m #);
end;

canceled;

registration
  let o,m;
  cluster c1Cat*(o,m) -> non void non empty trivial trivial';
end;

registration
  cluster strict Category-like
    reflexive transitive associative with_identities
   for  non void non empty CoprodCatStr;
end;

registration
  let o,m be set;
  cluster c1Cat*(o,m) -> Category-like
    reflexive transitive associative with_identities
   non void non empty;
end;

theorem 
  for a,b being Object of c1Cat*(o,m) holds a = b;

theorem 
  for f,g being Morphism of c1Cat*(o,m) holds f = g;

theorem 
  for a,b being Object of c1Cat*(o,m), f being Morphism of c1Cat*(
  o,m) holds f in Hom(a,b);

theorem 
  for a,b being Object of c1Cat*(o,m), f being Morphism of c1Cat*(o,m)
  holds f is Morphism of a,b;

theorem 
  for a,b being Object of c1Cat*(o,m) holds Hom(a,b) <> {};

theorem 
  for a being Object of c1Cat*(o,m) holds a is initial;

theorem 
  for c being Object of c1Cat*(o,m), i1,i2 being Morphism of
  c1Cat*(o,m) holds c is_a_coproduct_wrt i1,i2;

definition
  let IT be Category-like
   reflexive transitive associative with_identities
    non void non empty CoprodCatStr;
  attr IT is Cocartesian means


  the Initial of IT is initial & for a,b
  being Object of IT holds dom((the Incl1 of IT).(a,b)) = a & dom((the Incl2 of
  IT).(a,b)) = b & (the Coproduct of IT).(a,b) is_a_coproduct_wrt (the Incl1 of
  IT).(a,b),(the Incl2 of IT).(a,b);
end;

theorem 
  for o,m being set holds c1Cat*(o,m) is Cocartesian;

registration
  cluster strict Cocartesian for
    reflexive transitive associative with_identities
Category-like non void non empty CoprodCatStr;
end;

definition
  mode Cocartesian_category is Cocartesian
    reflexive transitive associative with_identities
Category-like non void non empty
    CoprodCatStr;
end;

reserve C for Cocartesian_category;
reserve a,b,c,d,e,s for Object of C;

theorem 
  [[0]]C is initial;

theorem 
  for f1,f2 being Morphism of [[0]]C,a holds f1 = f2;

definition
  let C,a;
  func init a -> Morphism of [[0]]C, a means

  not contradiction;
end;

theorem 
  Hom([[0]]C,a) <> {};

theorem 
  init a = init([[0]]C,a);

theorem 
  dom(init a) = [[0]]C & cod(init a) = a;

theorem 
  Hom([[0]]C,a) = {init a};

theorem 
  dom in1(a,b) = a & cod in1(a,b) = a+b;

theorem 
  dom in2(a,b) = b & cod in2(a,b) = a+b;

theorem 
  Hom(a,a+b) <> {} & Hom(b,a+b) <> {};

theorem 
  a+b is_a_coproduct_wrt in1(a,b),in2(a,b);

theorem 
  C is with_finite_coproduct;

definition
  let C,a,b;
  redefine func in1(a,b) -> Morphism of a,a+b;
  redefine func in2(a,b) -> Morphism of b,a+b;
end;

theorem 
  Hom(a,b) <> {} & Hom(b,a) <> {} implies in1(a,b) is coretraction & in2
  (a,b) is coretraction;

definition
  let C,a,b;
  redefine func in1(a,b) -> Morphism of a,a+b;
  redefine func in2(a,b) -> Morphism of b,a+b;
end;

definition
  let C,a,b,c;
  let f be Morphism of a,c, g be Morphism of b,c;
  assume
 Hom(a,c) <> {} & Hom(b,c) <> {};
  func [$f,g$] -> Morphism of a+b,c means


  it*in1(a,b) = f & it*in2(a,b ) = g;
end;

theorem 
  Hom(a,c) <> {} & Hom(b,c) <> {} implies Hom(a+b,c) <> {};

theorem 
  [$in1(a,b),in2(a,b)$] = id(a+b);

theorem 
  for f being Morphism of a,c, g being Morphism of b,c, h being
Morphism of c,d st Hom(a,c)<>{} & Hom(b,c)<>{} & Hom(c,d)<>{} holds [$h*f,h*g$]
  = h*[$f,g$];

theorem 
  for f,k being Morphism of a,c, g,h being Morphism of b,c st Hom(
  a,c) <> {} & Hom(b,c) <> {} & [$f,g$] = [$k,h$] holds f = k & g = h;

theorem 
  for f being Morphism of a,c, g being Morphism of b,c st Hom(a,c) <> {}
  & Hom(b,c) <> {} & (f is epi or g is epi) holds [$f,g$] is epi;

theorem 
  a, a+[[0]]C are_isomorphic & a,[[0]]C+a are_isomorphic;

theorem 
  a+b,b+a are_isomorphic;

theorem 
  (a+b)+c,a+(b+c) are_isomorphic;

definition
  let C,a;
  func nabla a -> Morphism of a+a,a equals

  [$id a,id a$];
end;

definition
  let C,a,b,c,d;
  let f be Morphism of a,c, g be Morphism of b,d;
  func f+g -> Morphism of a+b,c+d equals

  [$in1(c,d)*f,in2(c,d)*g$];
end;

theorem 
  Hom(a,c) <> {} & Hom(b,d) <> {} implies Hom(a+b,c+d) <> {};

theorem 
  (id a)+(id b) = id(a+b);

theorem 
  for f being Morphism of a,c, h being Morphism of b,d, g being
  Morphism of c,e, k being Morphism of d,e st Hom(a,c) <> {} & Hom(b,d) <> {} &
  Hom(c,e) <> {} & Hom(d,e) <> {} holds [$g,k$]*(f+h) = [$g*f,k*h$];

theorem 
  for f being Morphism of a,c, g being Morphism of b,c st Hom(a,c) <> {}
  & Hom(b,c) <> {} holds nabla(c)*(f+g) = [$f,g$];

theorem 
  for f being Morphism of a,c, h being Morphism of b,d, g being Morphism
  of c,e, k being Morphism of d,s st Hom(a,c) <> {} & Hom(b,d) <> {} & Hom(c,e)
  <> {} & Hom(d,s) <> {} holds (g+k)*(f+h) = (g*f)+(k*h);














begin 

reserve X for non empty 1-sorted;

theorem 
  for A, B being Subset of X holds ( A`) \ B` = B \ A;



definition
  let X be 1-sorted, A1, A2 be Subset of X;
  pred A1,A2 constitute_a_decomposition means


  A1 misses A2 & A1 \/ A2 = the carrier of X;
  symmetry;
end;

notation
  let X be 1-sorted, A1, A2 be Subset of X;
  antonym A1,A2 do_not_constitute_a_decomposition for A1,A2
  constitute_a_decomposition;
end;

reserve A, A1, A2, B1, B2 for Subset of X;

theorem 
  A1,A2 constitute_a_decomposition iff A1 misses A2 & A1 \/ A2 = [#]X;

theorem 
  A1,A2 constitute_a_decomposition implies A1 = A2` & A2 = A1`;

theorem 
  A1 = A2` or A2 = A1` implies A1,A2 constitute_a_decomposition;

theorem 
  A, A` constitute_a_decomposition;

theorem 
  {}X,[#]X constitute_a_decomposition;

theorem 
  A,A do_not_constitute_a_decomposition;

definition
  let X be non empty 1-sorted, A1, A2 be Subset of X;
  redefine pred A1,A2 constitute_a_decomposition;
  irreflexivity;
end;

theorem 
  A1,A constitute_a_decomposition & A,A2 constitute_a_decomposition
  implies A1 = A2;

reserve X for non empty TopSpace;
reserve A, A1, A2, B1, B2 for Subset of X;

theorem 
  A1,A2 constitute_a_decomposition implies (Cl A1),(Int A2)
  constitute_a_decomposition & (Int A1),(Cl A2) constitute_a_decomposition;

theorem 
  (Cl A),(Int A`) constitute_a_decomposition &
  (Cl A`),(Int A) constitute_a_decomposition &
  (Int A),(Cl A`) constitute_a_decomposition &
  (Int A`),(Cl A) constitute_a_decomposition;

theorem 
  for A1, A2 being Subset of X st A1,A2 constitute_a_decomposition
  holds (A1 is open iff A2 is closed);

theorem 
  for A1, A2 being Subset of X st A1,A2 constitute_a_decomposition holds
  (A1 is closed iff A2 is open);

reserve X for non empty 1-sorted;
reserve A, A1, A2, B1, B2 for Subset of X;

theorem 
  A1,A2 constitute_a_decomposition & B1,B2
  constitute_a_decomposition implies (A1 /\ B1),(A2 \/ B2)
  constitute_a_decomposition;

theorem 
  A1,A2 constitute_a_decomposition & B1,B2 constitute_a_decomposition
  implies (A1 \/ B1),(A2 /\ B2) constitute_a_decomposition;

begin



reserve X for non empty TopSpace,
  A1, A2 for Subset of X;

theorem 
  for A1, A2, C1, C2 being Subset of X st A1,C1
  constitute_a_decomposition & A2,C2 constitute_a_decomposition holds A1,A2
  are_weakly_separated iff C1,C2 are_weakly_separated;

theorem 
  A1,A2 are_weakly_separated iff A1`, A2` are_weakly_separated;

theorem 
  for A1, A2, C1, C2 being Subset of X st A1,C1
  constitute_a_decomposition & A2,C2 constitute_a_decomposition holds A1,A2
  are_separated implies C1,C2 are_weakly_separated;

theorem 
  for A1, A2, C1, C2 being Subset of X st A1,C1
  constitute_a_decomposition & A2,C2 constitute_a_decomposition holds A1 misses
  A2 & C1,C2 are_weakly_separated implies A1,A2 are_separated;

theorem 
  for A1, A2, C1, C2 being Subset of X st A1,C1
constitute_a_decomposition & A2,C2 constitute_a_decomposition holds C1 \/ C2 =
  the carrier of X & C1,C2 are_weakly_separated implies A1,A2 are_separated;

theorem 
  A1,A2 constitute_a_decomposition implies (A1,A2 are_weakly_separated
  iff A1,A2 are_separated);

theorem 
  A1,A2 are_weakly_separated iff (A1 \/ A2) \ A1,(A1 \/ A2) \ A2 are_separated;



theorem 
  for A1, A2, C1, C2 being Subset of X st C1 c= A1 & C2 c= A2 & C1
  \/ C2 = A1 \/ A2 holds C1,C2 are_weakly_separated implies A1,A2
  are_weakly_separated;

theorem 
  A1,A2 are_weakly_separated iff A1 \ (A1 /\ A2),A2 \ (A1 /\ A2) are_separated;



theorem 
  for A1, A2, C1, C2 being Subset of X st C1 c= A1 & C2 c= A2 & C1
  /\ C2 = A1 /\ A2 holds A1,A2 are_weakly_separated implies C1,C2
  are_weakly_separated;



reserve X0 for non empty SubSpace of X,
  B1, B2 for Subset of X0;

theorem 
  B1 = A1 & B2 = A2 implies (A1,A2 are_separated iff B1,B2 are_separated);

theorem 
  B1 = (the carrier of X0) /\ A1 & B2 = (the carrier of X0) /\ A2
  implies (A1,A2 are_separated implies B1,B2 are_separated);

theorem 
  B1 = A1 & B2 = A2 implies (A1,A2 are_weakly_separated iff B1,B2
  are_weakly_separated);

theorem 
  B1 = (the carrier of X0) /\ A1 & B2 = (the carrier of X0) /\ A2
  implies (A1,A2 are_weakly_separated implies B1,B2 are_weakly_separated);

begin



definition
  let X be non empty TopSpace, X1, X2 be SubSpace of X;
  pred X1,X2 constitute_a_decomposition means


  for A1, A2 being Subset
  of X st A1 = the carrier of X1 & A2 = the carrier of X2 holds A1,A2
  constitute_a_decomposition;
  symmetry;
end;

notation
  let X be non empty TopSpace, X1, X2 be SubSpace of X;
  antonym X1,X2 do_not_constitute_a_decomposition for X1,X2
  constitute_a_decomposition;
end;

reserve X0, X1, X2, Y1, Y2 for non empty SubSpace of X;

theorem 
  X1,X2 constitute_a_decomposition iff X1 misses X2 & the
  TopStruct of X = X1 union X2;

theorem 
  X0,X0 do_not_constitute_a_decomposition;

definition
  let X be non empty TopSpace, A1, A2 be non empty SubSpace of X;
  redefine pred A1,A2 constitute_a_decomposition;
  irreflexivity;
end;

theorem 
  X1,X0 constitute_a_decomposition & X0,X2 constitute_a_decomposition
  implies the TopStruct of X1 = the TopStruct of X2;

theorem 
  for X1, X2, Y1, Y2 being non empty SubSpace of X st X1,Y1
constitute_a_decomposition & X2,Y2 constitute_a_decomposition holds Y1 union Y2
  = the TopStruct of X iff X1 misses X2;

theorem 
  X1,X2 constitute_a_decomposition implies (X1 is open iff X2 is closed);

theorem 
  X1,X2 constitute_a_decomposition implies (X1 is closed iff X2 is open);

theorem 
  X1 meets Y1 & X1,X2 constitute_a_decomposition & Y1,Y2
  constitute_a_decomposition implies (X1 meet Y1),(X2 union Y2)
  constitute_a_decomposition;

theorem 
  X2 meets Y2 & X1,X2 constitute_a_decomposition & Y1,Y2
  constitute_a_decomposition implies (X1 union Y1),(X2 meet Y2)
  constitute_a_decomposition;

begin



reserve X for non empty TopSpace;

theorem 
  for X1, X2, Y1, Y2 being SubSpace of X st X1,Y1
  constitute_a_decomposition & X2,Y2 constitute_a_decomposition holds X1,X2
  are_weakly_separated implies Y1,Y2 are_weakly_separated;

theorem 
  for X1, X2, Y1, Y2 being non empty SubSpace of X st X1,Y1
  constitute_a_decomposition & X2,Y2 constitute_a_decomposition holds X1,X2
  are_separated implies Y1,Y2 are_weakly_separated;

theorem 
  for X1, X2, Y1, Y2 being non empty SubSpace of X st X1,Y1
  constitute_a_decomposition & X2,Y2 constitute_a_decomposition holds X1 misses
  X2 & Y1,Y2 are_weakly_separated implies X1,X2 are_separated;

theorem 
  for X1, X2, Y1, Y2 being non empty SubSpace of X st X1,Y1
constitute_a_decomposition & X2,Y2 constitute_a_decomposition holds Y1 union Y2
  = the TopStruct of X & Y1,Y2 are_weakly_separated implies X1,X2 are_separated
;

theorem 
  for X1, X2 being non empty SubSpace of X st X1,X2
  constitute_a_decomposition holds (X1,X2 are_weakly_separated iff X1,X2
  are_separated);



theorem 
  for X1, X2, Y1, Y2 being non empty SubSpace of X st Y1 is SubSpace of
  X1 & Y2 is SubSpace of X2 & Y1 union Y2 = X1 union X2 holds Y1,Y2
  are_weakly_separated implies X1,X2 are_weakly_separated;



theorem 
  for X1, X2, Y1, Y2 being non empty SubSpace of X st Y1 is SubSpace of
  X1 & Y2 is SubSpace of X2 & Y1 meets Y2 & Y1 meet Y2 = X1 meet X2 holds X1,X2
  are_weakly_separated implies Y1,Y2 are_weakly_separated;



reserve X0 for non empty SubSpace of X;

theorem 
  for X1, X2 being SubSpace of X, Y1, Y2 being SubSpace of X0 st
  the carrier of X1 = the carrier of Y1 & the carrier of X2 = the carrier of Y2
  holds X1,X2 are_separated iff Y1,Y2 are_separated;

theorem 
  for X1, X2 being non empty SubSpace of X st X1 meets X0 & X2 meets X0
for Y1, Y2 being SubSpace of X0 st Y1 = X1 meet X0 & Y2 = X2 meet X0 holds X1,
  X2 are_separated implies Y1,Y2 are_separated;

theorem 
  for X1, X2 being SubSpace of X, Y1, Y2 being SubSpace of X0 st the
carrier of X1 = the carrier of Y1 & the carrier of X2 = the carrier of Y2 holds
  X1,X2 are_weakly_separated iff Y1,Y2 are_weakly_separated;

theorem 
  for X1, X2 being non empty SubSpace of X st X1 meets X0 & X2 meets X0
for Y1, Y2 being SubSpace of X0 st Y1 = X1 meet X0 & Y2 = X2 meet X0 holds X1,
  X2 are_weakly_separated implies Y1,Y2 are_weakly_separated;














begin

theorem 
  for A being set, f being FinSequence of bool A st (for i being
  Element of NAT st 1 <= i & i < len f holds f/.i c= f/.(i+1)) for i, j being
  Element of NAT st i <= j & 1 <= i & j <= len f holds f/.i c= f/.j;

theorem 
  for A being set, f being FinSequence of bool A st (for i being
  Element of NAT st 1 <= i & i < len f holds f/.i c= f/.(i+1)) for i, j being
Element of NAT st 1 <= i & j <= len f & f/.j c= f/.i for k being Element of NAT
  st i <= k & k <= j holds f/.j = f/.k;

scheme 

  MaxFinSeqEx {X() -> non empty set, A,B() -> Subset of X(), F(Subset of X())
-> Subset of X()}: ex f being FinSequence of bool X() st len f > 0 & f/.1=B() &
(for i being Element of NAT st i > 0 & i < len f holds f/.(i+1)=F(f/.i)) & F(f
/.len f)=f/.len f & for i, j being Element of NAT st i > 0 & i < j & j <= len f
  holds f/.i c= A() & f/.i c< f/.j
provided
 A() is finite and
 B() c= A() and
 for A being Subset of X() st A c= A() holds A c= F(A) & F(A) c= A();

registration
  cluster non empty strict for RelStr;
end;

reserve FT for non empty RelStr;
reserve x, y, z for Element of FT;

definition
  let FT be RelStr;
  let x be Element of FT;
  func U_FT x -> Subset of FT equals

  Class(the InternalRel of FT,x);
end;

definition
  let x be set, y be Subset of {x};
  redefine func x.-->y -> Function of {x}, bool {x};
end;

definition
  let x be set;
  func SinglRel x -> Relation of {x} equals

  {[x,x]};
end;

definition
  func FT{0} -> strict RelStr equals

  RelStr (#{0},SinglRel 0#);
end;

registration
  cluster FT{0} -> non empty;
end;

notation
  let IT be non empty RelStr;
  synonym IT is filled for IT is reflexive;
end;

definition
  let IT be non empty RelStr;
  redefine attr IT is filled means


  for x being Element of IT holds x in U_FT x;
end;

theorem 
  FT{0} is filled;

registration
  cluster FT{0} -> filled finite;
end;

registration
  cluster finite filled strict for non empty RelStr;
end;

theorem 
  for FT being filled non empty RelStr holds {U_FT x where x is
  Element of FT : not contradiction} is Cover of FT;

reserve A for Subset of FT;

definition

  let FT;
  let A be Subset of FT;
  func A^delta -> Subset of FT equals

  {x:U_FT x meets A & U_FT x meets A` };
end;

theorem 
  x in A^delta iff U_FT x meets A & U_FT x meets A`;

definition
  let FT;
  let A be Subset of FT;
  func A^deltai -> Subset of FT equals

  A /\ (A^delta);
  func A^deltao -> Subset of FT equals

  A` /\ (A^delta);
end;

theorem 
  A^delta = A^deltai \/ A^deltao;

definition
  let FT;
  let A be Subset of FT;
  func A^i -> Subset of FT equals

  {x:U_FT x c= A};
  func A^b -> Subset of FT equals

  {x:U_FT x meets A};
  func A^s -> Subset of FT equals

  {x:x in A & U_FT x \ {x} misses A };
end;

definition
  let FT;
  let A be Subset of FT;
  func A^n -> Subset of FT equals

  A \ A^s;
  func A^f -> Subset of FT equals

  {x:ex y st y in A & x in U_FT y};
end;

definition
  let IT be non empty RelStr;
  attr IT is symmetric means


  for x, y being Element of IT holds y in U_FT x implies x in U_FT y;
end;

theorem 
  x in A^i iff U_FT x c= A;

theorem 
  x in A^b iff U_FT x meets A;

theorem 
  x in A^s iff x in A & U_FT x \ {x} misses A;

theorem 
  x in A^n iff x in A & U_FT x \ {x} meets A;

theorem 
  x in A^f iff ex y st y in A & x in U_FT y;

theorem 
  FT is symmetric iff for A holds A^b = A^f;

reserve F for Subset of FT;

definition
  let FT;
  let IT be Subset of FT;
  attr IT is open means


  IT = IT^i;
  attr IT is closed means


  IT = IT^b;
  attr IT is connected means


  for B,C being Subset of FT st IT = B \/ C
  & B <> {} & C <> {} & B misses C holds B^b meets C;
end;

definition
  let FT;
  let A be Subset of FT;
  func A^fb -> Subset of FT equals

  meet{F:A c= F & F is closed};
  func A^fi -> Subset of FT equals

  union{F:A c= F & F is open};
end;

theorem 
  for FT being filled non empty RelStr, A being Subset of FT holds A c= A^b;

theorem 
  for FT being non empty RelStr, A, B being Subset of FT holds A
  c= B implies A^b c= B^b;

theorem 
  for FT being filled finite non empty RelStr, A being Subset of FT
  holds A is connected iff for x being Element of FT st x in A ex S being
FinSequence of bool the carrier of FT st len S > 0 & S/.1 = {x} & (for i being
Element of NAT st i > 0 & i < len S holds S/.(i+1) = (S/.i)^b /\ A) & A c= S/.
  len S;

theorem 
  ((A`)^i)` = A^b;

theorem 
  ((A`)^b)` = A^i;

theorem 
  A^delta = (A^b) /\ ((A`)^b);

theorem 
  (A`)^delta = A^delta;

theorem 
  x in A^s implies not x in (A \ {x})^b;

theorem 
  A^s <> {} & card A <> 1 implies A is not connected;

theorem 
  for FT being filled non empty RelStr, A being Subset of FT holds A^i c= A;

theorem 
  A is open implies A` is closed;

theorem 
  A is closed implies A` is open;














begin

reserve x,y,z,a,b,c,X,A for set;



definition
  let IT be set;

  attr IT is binary_complete means


  for A st A c= IT & (for a,b st a in
  A & b in A holds a \/ b in IT) holds union A in IT;
end;

registration
  cluster subset-closed binary_complete non empty for set;
end;

definition
  mode Coherence_Space is subset-closed binary_complete non empty set;
end;

reserve C,D for Coherence_Space;

theorem 
  {} in C;

theorem 
  bool X is Coherence_Space;

theorem 
  {{}} is Coherence_Space;

theorem 
  x in union C implies {x} in C;

definition
  let C be Coherence_Space;
  func Web(C) -> Tolerance of union C means


  for x,y holds [x,y] in it iff ex X st X in C & x in X & y in X;
end;

reserve T for Tolerance of union C;

theorem 
  T = Web(C) iff for x,y holds [x,y] in T iff {x,y} in C;

theorem 
  a in C iff for x,y st x in a & y in a holds {x,y} in C;

theorem 
  a in C iff for x,y st x in a & y in a holds [x,y] in Web(C);

theorem 
  (for x,y st x in a & y in a holds {x,y} in C) implies a c= union C;

theorem 
  Web(C) = Web(D) implies C = D;

theorem 
  union C in C implies C = bool union C;

theorem 
  C = bool union C implies Web(C) = Total union C;

definition
  let X be set;
  let E be Tolerance of X;
  func CohSp(E) -> Coherence_Space means


  for a holds a in it iff for x, y st x in a & y in a holds [x,y] in E;
end;

reserve E for Tolerance of X;

theorem 
  Web(CohSp(E)) = E;

theorem 
  CohSp(Web(C)) = C;

theorem 
  a in CohSp(E) iff a is TolSet of E;

theorem 
  CohSp(E) = TolSets E;

begin 

definition
  let X;
  func CSp(X) -> set equals

  { x where x is Subset-Family of X : x is
  Coherence_Space };
end;

registration
  let X;
  cluster CSp(X) -> non empty;
end;

registration
  let X be set;
  cluster -> subset-closed binary_complete non empty for Element of CSp(X);
end;

reserve C,C1,C2 for Element of CSp(X);

theorem 
  {x,y} in C implies x in union C & y in union C;

definition
  let X;

  func FuncsC(X) -> set equals

  union { Funcs(union x,union y) where x is
  Element of CSp(X), y is Element of CSp(X): not contradiction };
end;

registration
  let X;
  cluster FuncsC(X) -> non empty functional;
end;

reserve g for Element of FuncsC(X);

theorem 
  x in FuncsC(X) iff ex C1,C2 st (union C2 = {} implies union C1 =
  {}) & x is Function of union C1,union C2;

definition
  let X;
  func MapsC(X) -> set equals

  { [[C,CC],f] where C is Element of CSp(X), CC is
Element of CSp(X), f is Element of FuncsC(X) : (union CC = {} implies union C =
{}) & f is Function of union C,union CC & for x,y st {x,y} in C holds {f.x,f.y}
  in CC};
end;

registration
  let X;
  cluster MapsC(X) -> non empty;
end;

reserve l,l1,l2,l3 for Element of MapsC(X);

theorem 
  ex g,C1,C2 st l = [[C1,C2],g] & (union C2 = {} implies union C1
= {}) & g is Function of union C1,union C2 & for x,y st {x,y} in C1 holds {g.x,
  g.y} in C2;

theorem 
  for f being Function of union C1,union C2 st (union C2={}
implies union C1={}) & (for x,y st {x,y} in C1 holds {f.x,f.y} in C2) holds [[
  C1,C2],f] in MapsC(X);

registration
  let X be set, l be Element of MapsC(X);
  cluster l`2 -> Function-like Relation-like;
end;

definition
  let X,l;
  func dom l -> Element of CSp(X) equals

  l`1`1;
  func cod l -> Element of CSp(X) equals

  l`1`2;
end;

theorem 
  l = [[dom l,cod l],l`2];

definition
  let X,C;
  func id$ C -> Element of MapsC(X) equals

  [[C,C],id union C];
end;

theorem 
  (union cod l <> {} or union dom l = {}) & l`2 is Function of
union dom l,union cod l & for x,y st {x,y} in dom l holds {l`2.x,l`2.y} in cod
  l;

definition
  let X,l1,l2;
  assume
 cod l1 = dom l2;
  func l2*l1 -> Element of MapsC(X) equals


  [[dom l1,cod l2],l2`2*l1`2];
end;

theorem 
  dom l2 = cod l1 implies (l2*l1)`2 = l2`2*l1`2 & dom(l2*l1) = dom
  l1 & cod(l2*l1) = cod l2;

theorem 
  dom l2 = cod l1 & dom l3 = cod l2 implies l3*(l2*l1) = (l3*l2)* l1;

theorem 
  (id$ C)`2 = id union C & dom id$ C = C & cod id$ C = C;

theorem 
  l*(id$ dom l) = l & (id$ cod l)*l = l;

definition
  let X;
  func CDom X -> Function of MapsC(X),CSp(X) means


  for l holds it.l = dom l;
  func CCod X -> Function of MapsC(X),CSp(X) means


  for l holds it.l = cod l;
  func CComp X -> PartFunc of [:MapsC(X),MapsC(X):],MapsC(X) means


  (for l2,l1 holds [l2,l1] in dom it iff dom l2 = cod l1) &
   for l2,l1 st dom l2 = cod l1 holds it.[l2,l1] = l2*l1;
end;

canceled;

definition
 canceled;
  let X;
  func CohCat(X) -> non empty non void strict CatStr equals

  CatStr(# CSp(X),MapsC(X),CDom X,CCod X,CComp X #);
end;

registration let X;
 cluster CohCat X -> Category-like transitive associative reflexive;
end;

registration let X;
 cluster CohCat X -> with_identities;
end;

begin 

definition
  let X be set;
  func Toler(X) -> set means


  x in it iff x is Tolerance of X;
end;

registration
  let X be set;
  cluster Toler(X) -> non empty;
end;

definition
  let X be set;
  func Toler_on_subsets(X) -> set equals

  union {Toler(Y) where Y is Subset of
X: not contradiction};
end;

registration
  let X be set;
  cluster Toler_on_subsets(X) -> non empty;
end;

theorem 
  x in Toler_on_subsets(X) iff ex A st A c= X & x is Tolerance of A;

theorem 
  Total a in Toler(a);

theorem 
  {} in Toler_on_subsets(X);

theorem 
  a c= X implies Total a in Toler_on_subsets(X);

theorem 
  a c= X implies id a in Toler_on_subsets(X);

theorem 
  Total X in Toler_on_subsets(X);

theorem 
  id X in Toler_on_subsets(X);

definition
  let X;
  func TOL(X) -> set equals

  { [t,Y] where t is Element of Toler_on_subsets(X),
  Y is Subset of X : t is Tolerance of Y};
end;

registration
  let X;
  cluster TOL(X) -> non empty;
end;

reserve T,T1,T2 for Element of TOL(X);

theorem 
  [{},{}] in TOL(X);

theorem 
  a c= X implies [id a,a] in TOL(X);

theorem 
  a c= X implies [Total a,a] in TOL(X);

theorem 
  [id X,X] in TOL(X);

theorem 
  [Total X,X] in TOL(X);

definition
  let X,T;
  redefine func T`2 -> Subset of X;
  redefine func T`1 -> Tolerance of T`2;
end;

definition
  let X;
  func FuncsT(X) -> set equals

  union { Funcs(T`2,TT`2) where T is Element of
  TOL(X), TT is Element of TOL(X): not contradiction };
end;

registration
  let X;
  cluster FuncsT(X) -> non empty functional;
end;

reserve f for Element of FuncsT(X);

theorem 
  x in FuncsT(X) iff ex T1,T2 st (T2`2 = {} implies T1`2 = {}) & x
  is Function of T1`2,T2`2;

definition
  let X;
  func MapsT(X) -> set equals

  { [[T,TT],f] where T is Element of TOL(X), TT is
Element of TOL(X), f is Element of FuncsT(X) : (TT`2 = {} implies T`2 = {}) & f
  is Function of T`2,TT`2 & for x,y st [x,y] in T`1 holds [f.x,f.y] in TT`1};
end;

registration
  let X;
  cluster MapsT(X) -> non empty;
end;

reserve m,m1,m2,m3 for Element of MapsT(X);

theorem 
  ex f,T1,T2 st m = [[T1,T2],f] & (T2`2 = {} implies T1`2 = {}) &
  f is Function of T1`2,T2`2 & for x,y st [x,y] in T1`1 holds [f.x,f.y] in T2`1
;

theorem 
  for f being Function of T1`2,T2`2 st (T2`2={} implies T1`2={}) &
(for x,y st [x,y] in T1`1 holds [f.x,f.y] in T2`1) holds [[T1,T2],f] in MapsT(X
  );

registration
  let X be set,m be Element of MapsT(X);
  cluster m`2 -> Function-like Relation-like;
end;

definition
  let X,m;

  func dom m -> Element of TOL(X) equals

  m`1`1;
  func cod m -> Element of TOL(X) equals

  m`1`2;
end;

theorem 
  m = [[dom m,cod m],m`2];

definition
  let X,T;
  func id$ T -> Element of MapsT(X) equals

  [[T,T],id T`2];
end;

theorem 
  ((cod m)`2 <> {} or (dom m)`2 = {}) & m`2 is Function of (dom m)
  `2,(cod m)`2 & for x,y st [x,y] in (dom m)`1 holds [m`2.x,m`2.y] in (cod m)`1
;

definition
  let X,m1,m2;
  assume
 cod m1 = dom m2;
  func m2*m1 -> Element of MapsT(X) equals


  [[dom m1,cod m2],m2`2*m1`2];
end;

theorem 
  dom m2 = cod m1 implies (m2*m1)`2 = m2`2*m1`2 & dom(m2*m1) = dom
  m1 & cod(m2*m1) = cod m2;

theorem 
  dom m2 = cod m1 & dom m3 = cod m2 implies m3*(m2*m1) = (m3*m2)* m1;

theorem 
  (id$ T)`2 = id T`2 & dom id$ T = T & cod id$ T = T;

theorem 
  m*(id$ dom m) = m & (id$ cod m)*m = m;

definition
  let X;
  func fDom X -> Function of MapsT(X),TOL(X) means


  for m holds it.m = dom m;
  func fCod X -> Function of MapsT(X),TOL(X) means


  for m holds it.m = cod m;
  func fComp X -> PartFunc of [:MapsT(X),MapsT(X):],MapsT(X) means


  (
for m2,m1 holds [m2,m1] in dom it iff dom m2 = cod m1) & for m2,m1 st dom m2 =
  cod m1 holds it.[m2,m1] = m2*m1;
end;

definition
 canceled;
  let X;
  func TolCat(X) -> non empty non void strict CatStr equals

  CatStr(# TOL(X),MapsT(X),fDom X,fCod X,fComp X#);
end;

registration
  let X;
  cluster TolCat(X) -> Category-like transitive associative reflexive;
end;

registration
  let X;
  cluster TolCat(X) -> with_identities;
end;















begin 

reserve x,y,z, X,Y,Z for set,
  n for Element of NAT;

definition
  let f be Function, x1,x2,y be set;
  func f..(x1,x2,y) equals

  f..([x1,x2],y);
end;

definition
  let A,D1,D2,D be non empty set;
  let f be Function of [:D1, D2:], Funcs(A,D);
  let x1 be Element of D1;
  let x2 be Element of D2;
  let x be Element of A;
  redefine func f..(x1,x2,x) -> Element of D;
end;

definition
  let A be set;
  let D1,D2,D be non empty set, f be Function of [:D1,D2:],D;
  let g1 be Function of A,D1;
  let g2 be Function of A,D2;
  redefine func f.:(g1,g2) -> Element of Funcs(A,D);
end;

notation
  let A be non empty set;
  let n be Element of NAT, x be Element of A;
  synonym n .--> x for n |-> x;
end;

definition
  let A be non empty set;
  let n be Element of NAT, x be Element of A;
  redefine func n .--> x -> FinSequence of A;
end;

definition
  let D be non empty set, A be set, d be Element of D;
  redefine func A --> d -> Element of Funcs(A,D);
end;

definition
  let A be set;
  let D1,D2,D be non empty set, f be Function of [:D1,D2:],D;
  let d be Element of D1;
  let g be Function of A,D2;
  redefine func f[;](d,g) -> Element of Funcs(A,D);
end;

definition
  let A be set;
  let D1,D2,D be non empty set, f be Function of [:D1,D2:],D;
  let g be Function of A,D1;
  let d be Element of D2;
  redefine func f[:](g,d) -> Element of Funcs(A,D);
end;

theorem 
  for f,g being Function, X being set holds (f|X)*g = f*(X|`g);

scheme 

  NonUniqFuncDEx { X() -> set, Y() -> non empty set, P[set,set] }: ex f being
  Function of X(), Y() st for x st x in X() holds P[x,f.x]
provided
 for x st x in X() ex y being Element of Y() st P[x,y];

begin 

definition
  let D1,D2,D be non empty set;
  let f be Function of [:D1,D2:],D;
  let A be set;
  func (f,D).:A -> Function of [:Funcs(A,D1), Funcs(A,D2):], Funcs(A,D)
    means


   for f1 being Element of Funcs(A,D1) for f2 being Element of Funcs(A,D2)
  holds it.(f1,f2) = f.:(f1,f2);
end;

theorem 
  for D1,D2,D being non empty set for f being Function of [:D1,D2:],D for A
being set, f1 being (Function of A,D1), f2 being Function of A,D2 for x st x in
  A holds ((f,D).:A)..(f1,f2,x) = f.(f1.x,f2.x);

reserve A for set,
  D for non empty set,
  a,b,c,l,r for Element of D,
  o,o9 for BinOp of D,
  f,g,h for Function of A,D;

theorem 
  o is commutative implies o.:(f,g) = o.:(g,f);

theorem 
  o is associative implies o.:(o.:(f,g),h) = o.:(f,o.:(g,h));

theorem 
  a is_a_unity_wrt o implies o[;](a,f) = f & o[:](f,a) = f;

theorem 
  o is idempotent implies o.:(f,f) = f;

theorem 
  o is commutative implies (o,D).:A is commutative;

theorem 
  o is associative implies (o,D).:A is associative;

theorem 
  a is_a_unity_wrt o implies A --> a is_a_unity_wrt (o,D).:A;

theorem 
  o is having_a_unity implies the_unity_wrt (o,D).:A = A -->
  the_unity_wrt o & (o,D).:A is having_a_unity;

theorem 
  o is idempotent implies (o,D).:A is idempotent;

theorem 
  o is invertible implies (o,D).:A is invertible;

theorem 
  o is cancelable implies (o,D).:A is cancelable;

theorem 
  o is uniquely-decomposable implies (o,D).:A is uniquely-decomposable;

theorem 
  o absorbs o9 implies (o,D).:A absorbs (o9,D).:A;

theorem 
  for D1, D2, D, E1, E2, E being non empty set, o1 being Function
of [:D1, D2:], D, o2 being Function of [:E1, E2:], E st o1 c= o2
  holds (o1,D).:A c= (o2,E).:A;

definition
  let G be non empty multMagma;
  let A be set;
  func .:(G,A) -> multMagma equals


  multLoopStr (# Funcs(A, the carrier
of G), (the multF of G,the carrier of G).:A, A --> the_unity_wrt the multF of G
#) if G is unital otherwise multMagma (# Funcs(A, the carrier of G), (the multF
    of G,the carrier of G).:A #);
end;

registration
  let G be non empty multMagma;
  let A be set;
  cluster .:(G,A) -> non empty;
end;

reserve G for non empty multMagma;

theorem 
  the carrier of .:(G,X) = Funcs(X, the carrier of G) & the multF
  of .:(G,X) = (the multF of G, the carrier of G).:X;

theorem 
  x is Element of .: (G,X) iff x is Function of X, the carrier of G;

registration
  let G be non empty multMagma, A be set;
  cluster .:(G,A) -> constituted-Functions;
end;

theorem 
  for f being Element of .:(G,X) holds dom f = X & rng f c= the carrier of G;

theorem 
  for f,g being Element of .:(G,X) st for x st x in X holds f.x =
  g.x holds f = g;

definition
  let G be non empty multMagma, A be non empty set;
  let f be Element of .:(G,A);
  let a be Element of A;
  redefine func f.a -> Element of G;
end;

registration
  let G be non empty multMagma, A be non empty set;
  let f be Element of .:(G,A);
  cluster rng f -> non empty;
end;

theorem 
  for f1,f2 being Element of .:(G,D), a being Element of D holds (
  f1*f2).a = (f1.a)*(f2.a);

definition
  let G be unital non empty multMagma;
  let A be set;
  redefine func .:(G,A) -> well-unital constituted-Functions strict non empty
  multLoopStr;
end;

theorem 
  for G being unital non empty multMagma holds 1..:(G,X) = X -->
  the_unity_wrt the multF of G;

theorem 
  for G being non empty multMagma, A being set holds (G is
commutative implies .:(G,A) is commutative) & (G is associative implies .:(G,A)
  is associative) & (G is idempotent implies .:(G,A) is idempotent) & (G is
invertible implies .:(G,A) is invertible) & (G is cancelable implies .:(G,A) is
  cancelable) & (G is uniquely-decomposable implies .:(G,A) is
  uniquely-decomposable);

theorem 
  for H being non empty SubStr of G holds .:(H,X) is SubStr of .:(G,X);

theorem 
  for G being unital non empty multMagma, H being non empty SubStr of
  G st the_unity_wrt the multF of G in the carrier of H holds .:(H,X) is
  MonoidalSubStr of .:(G,X);

definition
  let G be unital associative commutative cancelable uniquely-decomposable
  non empty multMagma;
  let A be set;
  redefine func .:(G,A) -> commutative cancelable uniquely-decomposable
  constituted-Functions strict Monoid;
end;

begin 

definition
  let A be set;
  func MultiSet_over A -> commutative cancelable uniquely-decomposable
  constituted-Functions strict Monoid equals

  .:(<NAT,+,0>, A);
end;

theorem 
  the carrier of MultiSet_over X = Funcs(X,NAT) & the multF of
  MultiSet_over X = (addnat,NAT).:X & 1.MultiSet_over X = X --> 0;

definition
  let A be set;
  mode Multiset of A is Element of MultiSet_over A;
end;

theorem 
  x is Multiset of X iff x is Function of X,NAT;

theorem 
  for m being Multiset of X holds dom m = X & rng m c= NAT;

definition
  let A be non empty set;
  let m be Multiset of A;
  redefine func rng m -> Subset of NAT;
  let a be Element of A;
  redefine func m.a -> Element of NAT;
end;

theorem 
  for m1,m2 being Multiset of D, a being Element of D holds (m1
  [*] m2).a = (m1.a)+(m2.a);

theorem 
  chi(Y,X) is Multiset of X;

definition
  let Y,X;
  redefine func chi(Y,X) -> Multiset of X;
end;

definition
  let X;
  let n be Element of NAT;
  redefine func X --> n -> Multiset of X;
end;

definition
  let A be non empty set, a be Element of A;
  func chi a -> Multiset of A equals

  chi({a},A);
end;

theorem 
  for A being non empty set, a,b being Element of A holds (chi a).
  a = 1 & (b <> a implies (chi a).b = 0);

reserve A for non empty set,
  a for Element of A,
  p for FinSequence of A,
  m1,m2 for Multiset of A;

theorem 
  (for a holds m1.a = m2.a) implies m1 = m2;

definition
  let A be set;
  func finite-MultiSet_over A -> strict non empty MonoidalSubStr of
  MultiSet_over A means


  for f being Multiset of A holds f in the carrier
  of it iff f"(NAT\{0}) is finite;
end;

theorem 
  chi a is Element of finite-MultiSet_over A;

theorem 
  dom ({x}|`(p^<*x*>)) = dom ({x}|`p) \/ {len p+1};

theorem 
  x <> y implies dom ({x}|`(p^<*y*>)) = dom ({x}|`p);

definition
  let A be non empty set, p be FinSequence of A;
  func |.p.| -> Multiset of A means


  for a being Element of A holds it. a = card dom ({a}|`p);
end;

theorem 
  |.<*> A.|.a = 0;

theorem 
  |.<*> A.| = A --> 0;

theorem 
  |.<*a*>.| = chi a;

reserve p,q for FinSequence of A;

theorem 
  |.p^<*a*>.| = |.p.| [*] chi a;

theorem 
  |.p^q.| = |.p.|[*]|.q.|;

theorem 
  |.n .--> a.|.a = n & for b being Element of A st b <> a holds |.
  n .--> a.|.b = 0;

reserve fm for Element of finite-MultiSet_over A;

theorem 
  |.p.| is Element of finite-MultiSet_over A;

theorem 
  x is Element of finite-MultiSet_over A implies ex p st x = |.p.|;

begin 

reserve a,b,c for Element of D;

definition
  let D1,D2,D be non empty set, f be Function of [:D1,D2:],D;
  func f.:^2 -> Function of [:bool D1, bool D2:], bool D means


  for x being Element of [:bool D1, bool D2:] holds it.x = f.:[:x`1,x`2:];
end;

theorem 
  for D1,D2,D being non empty set, f being Function of [:D1,D2:],D for
X1 being Subset of D1, X2 being Subset of D2 holds (f.:^2).(X1,X2) = f.:[:X1,X2
  :];

theorem 
  for D1,D2,D being non empty set, f being Function of [:D1,D2:],D for
X1 being Subset of D1, X2 being Subset of D2, x1,x2 being set st x1 in X1 & x2
  in X2 holds f.(x1,x2) in (f.:^2).(X1,X2);

theorem 
  for D1,D2,D being non empty set, f being Function of [:D1,D2:],D for X1
  being Subset of D1, X2 being Subset of D2 holds (f.:^2).(X1,X2) = {f.(a,b)
  where a is Element of D1, b is Element of D2: a in X1 & b in X2};

theorem 
  o is commutative implies o.:[:X,Y:] = o.:[:Y,X:];

theorem 
  o is associative implies o.:[:o.:[:X,Y:],Z:] = o.:[:X,o.:[:Y,Z:] :];

theorem 
  o is commutative implies o.:^2 is commutative;

theorem 
  o is associative implies o.:^2 is associative;

theorem 
  a is_a_unity_wrt o implies o.:[:{a},X:] = D /\ X & o.:[:X,{a}:] = D /\ X;

theorem 
  a is_a_unity_wrt o implies {a} is_a_unity_wrt o.:^2 & o.:^2 is
  having_a_unity & the_unity_wrt o.:^2 = {a};

theorem 
  o is having_a_unity implies o.:^2 is having_a_unity & {
the_unity_wrt o} is_a_unity_wrt o.:^2 & the_unity_wrt o.:^2 = {the_unity_wrt o}
;

theorem 
  o is uniquely-decomposable implies o.:^2 is uniquely-decomposable;

definition
  let G be non empty multMagma;
  func bool G -> multMagma equals


  multLoopStr(#bool the carrier of G,
(the multF of G).:^2, {the_unity_wrt the multF of G}#) if G is unital otherwise
  multMagma(#bool the carrier of G, (the multF of G).:^2#);
end;

registration
  let G be non empty multMagma;
  cluster bool G -> non empty;
end;

definition
  let G be unital non empty multMagma;
  redefine func bool G -> well-unital strict non empty multLoopStr;
end;

theorem 
  the carrier of bool G = bool the carrier of G & the multF of
  bool G = (the multF of G).:^2;

theorem 
  for G being unital non empty multMagma holds 1.bool G = {
  the_unity_wrt the multF of G};

theorem 
  for G being non empty multMagma holds (G is commutative implies bool G
  is commutative) & (G is associative implies bool G is associative) & (G is
  uniquely-decomposable implies bool G is uniquely-decomposable);















begin 

scheme 
 ElementEq {A()->set,P[set]} : for X1,X2 being Element of A() st
  (for x being set holds x in X1 iff P[x]) &
  (for x being set holds x in X2 iff P[x]) holds X1 = X2;

scheme 
 UnOpEq {A() -> non empty set, F(Element of A()) -> set}:
  for f1,f2 being UnOp of A() st
  (for a being Element of A() holds f1.(a) = F(a))
  & (for a being Element of A() holds f2.(a) = F(a)) holds f1 = f2;

scheme 
 TriOpEq {A() -> non empty set,
  F(Element of A(),Element of A(),Element of A()) -> set}:
  for f1,f2 being TriOp of A() st
  (for a,b,c being Element of A() holds f1.(a,b,c) = F(a,b,c))
  & (for a,b,c being Element of A() holds f2.(a,b,c) = F(a,b,c)) holds f1 = f2;

scheme 
 QuaOpEq {A() -> non empty set,
  F(Element of A(),Element of A(),Element of A(),Element of A()) -> set}:
  for f1,f2 being QuaOp of A() st
  (for a,b,c,d being Element of A() holds f1.(a,b,c,d) = F(a,b,c,d))
  & (for a,b,c,d being Element of A() holds f2.(a,b,c,d) = F(a,b,c,d))
  holds f1 = f2;

scheme 
 Fraenkel1Ex {A, D() -> non empty set,
  F(set) -> Element of D(), P[set]} : ex S being Subset of D()
  st S = {F(x) where x is Element of A() : P[x]};

scheme 
 Fr0 {A() -> non empty set, x() -> Element of A(), P[set]} : P[x()]
provided
 x() in {a where a is Element of A() : P[a]};

scheme 
 Fr1 {X() -> set, A() -> non empty set, a() -> Element of A(), P[set]} :
  a() in X() iff P[a()]
provided
 X() = {a where a is Element of A() : P[a]};

scheme 
 Fr2 {X() -> set, A() -> non empty set, a() -> Element of A(), P[set]}:
  P[a()]
provided
 a() in X() and
 X() = {a where a is Element of A() : P[a]};

scheme 
 Fr3 {x() -> set, X() -> set, A() -> non empty set, P[set]} :
  x() in X() iff ex a being Element of A() st x()=a & P[a]
provided
 X() = {a where a is Element of A() : P[a]};

scheme 
 Fr4 {D1,D2() -> non empty set, B() -> set,
  a() -> Element of D1(), F(set) -> set, P[set,set], Q[set,set]} :
  a() in F(B()) iff for b being Element of D2() st b in B() holds P[a(),b]
provided
 F(B()) = {a where a is Element of D1() : Q[a,B()]} and
 Q[a(),B()] iff for b being Element of D2() st b in B() holds P[a(),b];

begin 

reserve x for set,
  K for Ring,
  r for Scalar of K,
  V for LeftMod of K,
  a,b,a1,a2 for Vector of V,
  A,A1,A2 for Subset of V,
  l for Linear_Combination of A,
  W for Subspace of V,
  Li for FinSequence of Submodules(V);



theorem 
  K is non trivial & A is linearly-independent implies not 0.V in A;

theorem 
  not a in A implies l.a = 0.K;

theorem 
  K is trivial implies (for l holds Carrier(l) = {}) & Lin A is trivial;

theorem 
  V is non trivial implies for A st A is base holds A <> {};

theorem 
  A1 \/ A2 is linearly-independent & A1 misses A2
  implies Lin A1 /\ Lin A2 = (0).V;

theorem 
  A is base & A = A1 \/ A2 & A1 misses A2 implies
  V is_the_direct_sum_of Lin A1,Lin A2;

begin 

definition
  let K,V;
  mode SUBMODULE_DOMAIN of V -> non empty set means


    x in it implies x is strict Subspace of V;
end;

definition
  let K,V;
  redefine func Submodules(V) -> SUBMODULE_DOMAIN of V;
end;

definition
  let K,V;
  let D be SUBMODULE_DOMAIN of V;
  redefine mode Element of D -> strict Subspace of V;
end;

registration
  let K,V;
  let D be SUBMODULE_DOMAIN of V;
  cluster strict for Element of D;
end;

definition
  let K,V;
  assume
 V is non trivial;
  mode LINE of V -> strict Subspace of V means

    ex a st a<>0.V & it = <:a:>;
end;

definition
  let K,V;
  mode LINE_DOMAIN of V -> non empty set means


    x in it implies x is LINE of V;
end;

definition
  let K,V;
  func lines(V) -> LINE_DOMAIN of V means

  x in it iff x is LINE of V;
end;

definition
  let K,V;
  let D be LINE_DOMAIN of V;
  redefine mode Element of D -> LINE of V;
end;

definition
  let K,V;
  assume that
 V is non trivial and
 V is free;
  mode HIPERPLANE of V -> strict Subspace of V means

    ex a st a<>0.V & V is_the_direct_sum_of <:a:>,it;
end;

definition
  let K,V;
  mode HIPERPLANE_DOMAIN of V -> non empty set means


    x in it implies x is HIPERPLANE of V;
end;

definition
  let K,V;
  func hiperplanes(V) -> HIPERPLANE_DOMAIN of V means

  x in it iff x is HIPERPLANE of V;
end;

definition
  let K,V;
  let D be HIPERPLANE_DOMAIN of V;
  redefine mode Element of D -> HIPERPLANE of V;
end;

begin 

definition
  let K,V,Li;
  func Sum Li -> Element of Submodules(V) equals

  SubJoin(V) $$ Li;
  func /\ Li -> Element of Submodules(V) equals

  SubMeet(V) $$ Li;
end;

theorem 
  SubJoin(V) is commutative associative & SubJoin(V) is having_a_unity
  & (0).V = the_unity_wrt SubJoin(V);

theorem 
  SubMeet(V) is commutative associative & SubMeet(V)
  is having_a_unity & (Omega).V = the_unity_wrt SubMeet(V);

begin 

definition
  let K,V,A1,A2;
  func A1 + A2 -> Subset of V means

  x in it iff ex a1,a2 st a1 in A1 & a2 in A2 & x = a1+a2;
end;

begin 

definition
  let K,V,A;
  assume
 A <> {};
  mode Vector of A -> Vector of V means


    it is Element of A;
end;

theorem 
  A1 <> {} & A1 c= A2 implies for x st x is Vector of A1 holds x is Vector of
  A2;



theorem 
  a2 in a1 + W iff a1 - a2 in W;

theorem 
  a1 + W = a2 + W iff a1 - a2 in W;

definition
  let K,V,W;
  func V..W -> set means


  x in it iff ex a st x = a + W;
end;

registration
  let K,V,W;
  cluster V..W -> non empty;
end;

definition
  let K,V,W,a;
  func a..W -> Element of V..W equals

  a + W;
end;

theorem 
  for x being Element of V..W ex a st x = a..W;

theorem 
  a1..W = a2..W iff a1 - a2 in W;

reserve S1,S2 for Element of V..W;

definition
  let K,V,W,S1;
  func -S1 -> Element of V..W means

  S1 = a..W implies it = (-a)..W;
  let S2;
  func S1 + S2 -> Element of V..W means


  S1 = a1..W & S2 = a2..W implies it = (a1+a2)..W;
end;

definition
  let K,V,W;
  func COMPL W -> UnOp of V..W means

  it.S1 = -S1;
  func ADD W -> BinOp of V..W means


  it.(S1,S2) = S1 + S2;
end;

definition
  let K,V,W;
  func V.W -> strict addLoopStr equals

  addLoopStr(#V..W,ADD W,(0.V)..W#);
end;

registration
  let K,V,W;
  cluster V.W -> non empty;
end;

theorem 
  a..W is Element of V.W;

definition
  let K,V,W,a;
  func a.W -> Element of V.W equals

  a..W;
end;

theorem 
  for x being Element of V.W ex a st x = a.W;

theorem 
  a1.W = a2.W iff a1 - a2 in W;

theorem 
  a.W + b.W = (a+b).W & 0.(V.W) = (0.V).W;

registration
  let K,V,W;
  cluster V.W -> Abelian add-associative right_zeroed right_complementable;
end;

reserve S for Element of V.W;

definition
  let K,V,W,r,S;
  func r*S -> Element of V.W means


  S = a.W implies it = (r*a).W;
end;

definition
  let K,V,W;
  func LMULT W -> Function of [:the carrier of K,the carrier of V.W:],
  the carrier of V.W means


  it.(r,S) = r*S;
end;

begin

definition
  let K,V,W;
  func V/W -> strict VectSpStr over K equals

  VectSpStr(#the carrier of V.W,the addF of V.W,0.V.W,LMULT W#);
end;

registration
  let K,V,W;
  cluster V/W -> non empty;
end;

theorem 
  a.W is Vector of V/W;

theorem 
  for x being Vector of V/W holds x is Element of V.W;

definition
  let K,V,W,a;
  func a/W -> Vector of V/W equals

  a.W;
end;

theorem 
  for x being Vector of V/W ex a st x = a/W;

theorem 
  a1/W = a2/W iff a1 - a2 in W;

theorem 
  a/W + b/W = (a+b)/W & r*(a/W) = (r*a)/W;

theorem 
  V/W is strict LeftMod of K;

registration
  let K,V,W;
  cluster V/W -> vector-distributive scalar-distributive
  scalar-associative scalar-unital;
end;















begin

canceled;

theorem 
  for x1,y1,x2,y2 being real number holds (x1+y1*<i>) * (x2+y2*<i>) = x1
  *x2-y1*y2 + (x1*y2+x2*y1)*<i>;

theorem 
  for z be Element of COMPLEX holds |.z.|+0*<i> = (z*'/(|.z.|+0*<i> ))*z;

begin 

definition
  let x,y be real number;
  func [**x,y**] -> Element of F_Complex equals

  x+y*<i>;
end;

definition
  func i_FC -> Element of F_Complex equals

  <i>;
end;

theorem 
  i_FC * i_FC = -1_F_Complex;

theorem 
  (-1_F_Complex) * (-1_F_Complex) = 1_F_Complex;

theorem 
  for x1,y1,x2,y2 be Real holds [**x1,y1**] + [**x2,y2**] = [**x1 + x2,
  y1 + y2**];

theorem 
  for x1,y1,x2,y2 be real number holds [**x1,y1**] * [**x2,y2**] = [**x1
  *x2 - y1*y2,x1*y2+x2*y1**];

canceled;

theorem 
  for r be Real holds |.[**r,0**].| = abs r;

theorem 
  for x,y be Element of F_Complex holds Re (x+y) = Re x + Re y & Im (x+y
  ) = Im x + Im y;

theorem 
  for x,y be Element of F_Complex holds Re (x*y) = Re x * Re y - Im x *
  Im y & Im (x*y) = Re x * Im y + Re y * Im x;

begin 

definition
  let K be 1-sorted;
  let V be VectSpStr over K;
  mode Functional of V is Function of the carrier of V, the carrier of K;
end;

definition
  let K be non empty addLoopStr;
  let V be non empty VectSpStr over K;
  let f,g be Functional of V;

  func f+g -> Functional of V means


  for x be Element of V holds it.x = f.x + g.x;
end;

definition
  let K be non empty addLoopStr;
  let V be non empty VectSpStr over K;
  let f be Functional of V;
  func -f -> Functional of V means


  for x be Element of V holds it.x = - (f.x);
end;

definition
  let K be non empty addLoopStr;
  let V be non empty VectSpStr over K;
  let f,g be Functional of V;
  func f-g -> Functional of V equals

  f+-g;
end;

definition
  let K be non empty multMagma;
  let V be non empty VectSpStr over K;
  let v be Element of K;
  let f be Functional of V;
  func v*f -> Functional of V means


  for x be Element of V holds it.x = v*(f.x);
end;

definition
  let K be non empty ZeroStr;
  let V be VectSpStr over K;
  func 0Functional(V) -> Functional of V equals

  [#]V --> 0.K;
end;

definition
  let K be non empty multMagma;
  let V be non empty VectSpStr over K;
  let F be Functional of V;

  attr F is homogeneous means


  for x be Vector of V, r be Scalar of V holds F.(r*x) = r*F.x;
end;

definition
  let K be non empty ZeroStr;
  let V be non empty VectSpStr over K;
  let F be Functional of V;
  attr F is 0-preserving means

  F.(0.V) = 0.K;
end;

registration
  let K be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr;
  let V be VectSp of K;
  cluster homogeneous -> 0-preserving for Functional of V;
end;

registration
  let K be right_zeroed non empty addLoopStr;
  let V be non empty VectSpStr over K;
  cluster 0Functional(V) -> additive;
end;

registration
  let K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let V be non empty VectSpStr over K;
  cluster 0Functional(V) -> homogeneous;
end;

registration
  let K be non empty ZeroStr;
  let V be non empty VectSpStr over K;
  cluster 0Functional(V) -> 0-preserving;
end;

registration
  let K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let V be non empty VectSpStr over K;
  cluster additive homogeneous 0-preserving for Functional of V;
end;

theorem 
  for K be Abelian non empty addLoopStr for V be non empty
  VectSpStr over K for f,g be Functional of V holds f+g = g+f;

theorem 
  for K be add-associative non empty addLoopStr for V be non
  empty VectSpStr over K for f,g,h be Functional of V holds f+g+h = f+(g+h);

theorem 
  for K be non empty ZeroStr for V be non empty VectSpStr over K for x
  be Element of V holds (0Functional(V)).x = 0.K;

theorem 
  for K be right_zeroed non empty addLoopStr for V be non empty
  VectSpStr over K for f be Functional of V holds f + 0Functional(V) = f;

theorem 
  for K be add-associative right_zeroed right_complementable non
empty addLoopStr for V be non empty VectSpStr over K for f be Functional of V
  holds f-f = 0Functional(V);

theorem 
  for K be right-distributive non empty doubleLoopStr for V be
  non empty VectSpStr over K for r be Element of K for f,g be Functional of V
  holds r*(f+g) = r*f+r*g;

theorem 
  for K be left-distributive non empty doubleLoopStr for V be
  non empty VectSpStr over K for r,s be Element of K for f be Functional of V
  holds (r+s)*f = r*f+s*f;

theorem 
  for K be associative non empty multMagma for V be non empty
VectSpStr over K for r,s be Element of K for f be Functional of V holds (r*s)*f
  = r*(s*f);

theorem 
  for K be left_unital non empty doubleLoopStr for V be non
  empty VectSpStr over K for f be Functional of V holds (1.K)*f = f;

registration
  let K be Abelian add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let V be non empty VectSpStr over K;
  let f,g be additive Functional of V;
  cluster f+g -> additive;
end;

registration
  let K be Abelian add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let V be non empty VectSpStr over K;
  let f be additive Functional of V;
  cluster -f -> additive;
end;

registration
  let K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let V be non empty VectSpStr over K;
  let v be Element of K;
  let f be additive Functional of V;
  cluster v*f -> additive;
end;

registration
  let K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let V be non empty VectSpStr over K;
  let f,g be homogeneous Functional of V;
  cluster f+g -> homogeneous;
end;

registration
  let K be Abelian add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let V be non empty VectSpStr over K;
  let f be homogeneous Functional of V;
  cluster -f -> homogeneous;
end;

registration
  let K be add-associative right_zeroed right_complementable
  right-distributive associative commutative non empty doubleLoopStr;
  let V be non empty VectSpStr over K;
  let v be Element of K;
  let f be homogeneous Functional of V;
  cluster v*f -> homogeneous;
end;

definition
  let K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let V be non empty VectSpStr over K;
  mode linear-Functional of V is additive homogeneous Functional of V;
end;

begin 

definition
  let K be Abelian add-associative right_zeroed right_complementable
  right-distributive associative commutative non empty doubleLoopStr;
  let V be non empty VectSpStr over K;
  func V*' -> non empty strict VectSpStr over K means


  (for x be set
  holds x in the carrier of it iff x is linear-Functional of V) & (for f,g be
linear-Functional of V holds (the addF of it).(f,g) = f+g) & 0.it = 0Functional
(V) & for f be linear-Functional of V for x be Element of K holds (the lmult of
  it).(x,f) = x*f;
end;

registration
  let K be Abelian add-associative right_zeroed right_complementable
  right-distributive associative commutative non empty doubleLoopStr;
  let V be non empty VectSpStr over K;
  cluster V*' -> Abelian;
end;

registration
  let K be Abelian add-associative right_zeroed right_complementable
  right-distributive associative commutative non empty doubleLoopStr;
  let V be non empty VectSpStr over K;
  cluster V*' -> add-associative;
  cluster V*' -> right_zeroed;
  cluster V*' -> right_complementable;
end;

registration
  let K be Abelian add-associative right_zeroed right_complementable
  left_unital distributive associative commutative non empty doubleLoopStr;
  let V be non empty VectSpStr over K;
  cluster V*' -> vector-distributive scalar-distributive
  scalar-associative scalar-unital;
end;

begin 

definition
  let K be 1-sorted;
  let V be VectSpStr over K;
  mode RFunctional of V is Function of the carrier of V,REAL;
end;

definition
  let K be 1-sorted;
  let V be non empty VectSpStr over K;
  let F be RFunctional of V;

  attr F is subadditive means


  for x,y be Vector of V holds F.(x+y) <= F.x+F.y;
end;

definition
  let K be 1-sorted;
  let V be non empty VectSpStr over K;
  let F be RFunctional of V;
  attr F is additive means


  for x,y be Vector of V holds F.(x+y) = F.x+ F.y;
end;

definition
  let V be non empty VectSpStr over F_Complex;
  let F be RFunctional of V;
  attr F is Real_homogeneous means


  for v be Vector of V for r be Real holds F.([**r,0**]*v) = r*F.v;
end;

theorem 
  for V be vector-distributive scalar-distributive scalar-associative
  scalar-unital non empty VectSpStr over F_Complex for F
be RFunctional of V st F is Real_homogeneous for v be Vector of V for r be Real
  holds F.([**0,r**]*v) = r*F.(i_FC*v);

definition
  let V be non empty VectSpStr over F_Complex;
  let F be RFunctional of V;
  attr F is homogeneous means


  for v be Vector of V for r be Scalar of V holds F.(r*v) = |.r.|*F.v;
end;

definition
  let K be 1-sorted;
  let V be VectSpStr over K;
  let F be RFunctional of V;
  attr F is 0-preserving means

  F.(0.V) = 0;
end;

registration
  let K be 1-sorted;
  let V be non empty VectSpStr over K;
  cluster additive -> subadditive for RFunctional of V;
end;

registration
  let V be VectSp of F_Complex;
  cluster Real_homogeneous -> 0-preserving for RFunctional of V;
end;

definition
  let K be 1-sorted;
  let V be VectSpStr over K;
  func 0RFunctional(V) -> RFunctional of V equals

  [#]V --> 0;
end;

registration
  let K be 1-sorted;
  let V be non empty VectSpStr over K;
  cluster 0RFunctional(V) -> additive;
  cluster 0RFunctional(V) -> 0-preserving;
end;

registration
  let V be non empty VectSpStr over F_Complex;
  cluster 0RFunctional(V) -> Real_homogeneous;
  cluster 0RFunctional(V) -> homogeneous;
end;

registration
  let K be 1-sorted;
  let V be non empty VectSpStr over K;
  cluster additive 0-preserving for RFunctional of V;
end;

registration
  let V be non empty VectSpStr over F_Complex;
  cluster additive Real_homogeneous homogeneous for RFunctional of V;
end;

definition
  let V be non empty VectSpStr over F_Complex;
  mode Semi-Norm of V is subadditive homogeneous RFunctional of V;
end;

begin 

definition
  let V be non empty VectSpStr over F_Complex;
  func RealVS(V) -> strict RLSStruct means


  the addLoopStr of it = the
addLoopStr of V & for r be Real, v be Vector of V holds (the Mult of it).(r,v)=
  [**r,0**]*v;
end;

registration
  let V be non empty VectSpStr over F_Complex;
  cluster RealVS(V) -> non empty;
end;

registration
  let V be Abelian non empty VectSpStr over F_Complex;
  cluster RealVS(V) -> Abelian;
end;

registration
  let V be add-associative non empty VectSpStr over F_Complex;
  cluster RealVS(V) -> add-associative;
end;

registration
  let V be right_zeroed non empty VectSpStr over F_Complex;
  cluster RealVS(V) -> right_zeroed;
end;

registration
  let V be right_complementable non empty VectSpStr over F_Complex;
  cluster RealVS(V) -> right_complementable;
end;

registration
  let V be vector-distributive scalar-distributive scalar-associative
  scalar-unital non empty VectSpStr over F_Complex;
  cluster RealVS(V) -> vector-distributive scalar-distributive
  scalar-associative scalar-unital;
end;

theorem 
  for V be non empty VectSp of F_Complex for M be Subspace of V
  holds RealVS(M) is Subspace of RealVS(V);

theorem 
  for V be non empty VectSpStr over F_Complex for p be RFunctional
  of V holds p is Functional of RealVS(V);

theorem 
  for V be non empty VectSp of F_Complex for p be Semi-Norm of V
  holds p is Banach-Functional of RealVS(V);

definition
  let V be non empty VectSpStr over F_Complex;
  let l be Functional of V;
  func projRe(l) -> Functional of RealVS(V) means


  for i be Element of V holds it.i = Re(l.i);
end;

definition
  let V be non empty VectSpStr over F_Complex;
  let l be Functional of V;
  func projIm(l) -> Functional of RealVS(V) means


  for i be Element of V holds it.i = Im(l.i);
end;

definition
  let V be non empty VectSpStr over F_Complex;
  let l be Functional of RealVS(V);
  func RtoC(l) -> RFunctional of V equals

  l;
end;

definition
  let V be non empty VectSpStr over F_Complex;
  let l be RFunctional of V;
  func CtoR(l) -> Functional of RealVS(V) equals

  l;
end;

registration
  let V be non empty VectSp of F_Complex;
  let l be additive Functional of RealVS(V);
  cluster RtoC(l) -> additive;
end;

registration
  let V be non empty VectSp of F_Complex;
  let l be additive RFunctional of V;
  cluster CtoR(l) -> additive;
end;

registration
  let V be non empty VectSp of F_Complex;
  let l be homogeneous Functional of RealVS(V);
  cluster RtoC(l) -> Real_homogeneous;
end;

registration
  let V be non empty VectSp of F_Complex;
  let l be Real_homogeneous RFunctional of V;
  cluster CtoR(l) -> homogeneous;
end;

definition
  let V be non empty VectSpStr over F_Complex;
  let l be RFunctional of V;
  func i-shift(l) -> RFunctional of V means


  for v be Element of V holds it.v = l.(i_FC*v);
end;

definition
  let V be non empty VectSpStr over F_Complex;
  let l be Functional of RealVS(V);
  func prodReIm(l) -> Functional of V means


  for v be Element of V holds it.v = [**(RtoC l).v,-(i-shift(RtoC l)).v**];
end;

theorem 
  for V be non empty VectSp of F_Complex for l be
  linear-Functional of V holds projRe(l) is linear-Functional of RealVS(V);

theorem 
  for V be non empty VectSp of F_Complex for l be linear-Functional of V
  holds projIm(l) is linear-Functional of RealVS(V);

theorem 
  for V be non empty VectSp of F_Complex for l be
  linear-Functional of RealVS(V) holds prodReIm(l) is linear-Functional of V;




theorem 
  for V be non empty VectSp of F_Complex for p be Semi-Norm of V for M
be Subspace of V for l be linear-Functional of M st for e be Vector of M for v
be Vector of V st v=e holds |.l.e.| <= p.v ex L be linear-Functional of V st L|
  the carrier of M = l & for e be Vector of V holds |.L.e.| <= p.e;

begin 


theorem 
  for x be Real st x > 0 for n be Element of NAT holds (power F_Complex)
  .([**x,0**],n) = [**x to_power n,0**];














begin

registration
  cluster Heyting -> implicative for 0_Lattice;
  cluster implicative -> upper-bounded for Lattice;
end;

reserve T for TopSpace;
reserve A,B for Subset of T;

theorem 
  A /\ Int(A` \/ B) c= B;

theorem 
  for C being Subset of T st C is open & A /\ C c= B holds C c= Int (A` \/ B);

definition
  let T be TopStruct;
  func Topology_of T -> Subset-Family of T equals

  the topology of T;
end;

registration
  let T;
  cluster Topology_of T -> non empty;
end;

definition
  let T be non empty TopSpace, P, Q be Element of Topology_of T;
  redefine func P \/ Q -> Element of Topology_of T;
  redefine func P /\ Q -> Element of Topology_of T;
end;

reserve T for non empty TopSpace;
reserve P,Q for Element of Topology_of T;

definition
  let T;
  func Top_Union T -> BinOp of Topology_of T means


  it.(P,Q) = P \/ Q;
  func Top_Meet T -> BinOp of Topology_of T means


  it.(P,Q) = P /\ Q;
end;

theorem 
  for T being non empty TopSpace holds LattStr(#Topology_of T,
    Top_Union T,Top_Meet T#) is Lattice;

definition
  let T;
  func Open_setLatt(T) -> Lattice equals

  LattStr(#Topology_of T,Top_Union T,
    Top_Meet T#);
end;

theorem 
  the carrier of Open_setLatt(T) = Topology_of T;

reserve p,q for Element of Open_setLatt(T);

theorem 
  p "\/" q = p \/ q & p "/\" q = p /\ q;

theorem 
  p [= q iff p c= q;

theorem 
  for p9,q9 being Element of Topology_of T st p=p9 & q=q9 holds p
  [= q iff p9 c= q9;

registration
  let T;
  cluster Open_setLatt(T) -> implicative;
end;

theorem 
  Open_setLatt(T) is lower-bounded & Bottom Open_setLatt(T) = {};

registration
  let T;
  cluster Open_setLatt(T) -> Heyting;
end;

theorem 
  Top Open_setLatt(T) = the carrier of T;

reserve L for D_Lattice;
reserve F for Filter of L;
reserve a,b for Element of L;
reserve x,X,X1,X2,Y,Z for set;

definition
  let L;
  func F_primeSet(L) -> set equals

  { F: F <> the carrier of L & F is prime};
end;

theorem 
  F in F_primeSet(L) iff F <> the carrier of L & F is prime;

definition
  let L;
  func StoneH(L) -> Function means


  dom it = the carrier of L & it.a = { F: F in F_primeSet(L) & a in F};
end;

theorem 
  F in StoneH(L).a iff F in F_primeSet(L) & a in F;

theorem 
  x in StoneH(L).a iff ex F st F=x & F <> the carrier of L & F is
  prime & a in F;

definition
  let L;
  func StoneS(L) -> set equals

  rng StoneH(L);
end;

registration
  let L;
  cluster StoneS(L) -> non empty;
end;

theorem 
  x in StoneS(L) iff ex a st x=StoneH(L).a;

theorem 
  StoneH(L).(a "\/" b) = StoneH(L).a \/ StoneH(L).b;

theorem 
  StoneH(L).(a "/\" b) = StoneH(L).a /\ StoneH(L).b;

definition
  let L, a;
  func SF_have a -> Subset-Family of L equals

  { F : a in F };
end;

registration
  let L;
  let a;
  cluster SF_have a -> non empty;
end;

theorem 
  x in SF_have a iff x is Filter of L & a in x;

theorem 
  x in SF_have b \ SF_have a implies x is Filter of L & b in x & not a in x;

theorem 
  for Z st Z <> {} & Z c= SF_have b \ SF_have a & Z is c=-linear
  ex Y st Y in SF_have b \ SF_have a & for X1 st X1 in Z holds X1 c= Y;

theorem 
  not b [= a implies <.b.) in SF_have b \ SF_have a;

theorem 
  not b [= a implies ex F st F in F_primeSet(L) & not a in F & b in F;

theorem 
  a <> b implies ex F st F in F_primeSet(L);

theorem 
  a <> b implies StoneH(L).a <> StoneH(L).b;

registration
  let L;
  cluster StoneH(L) -> one-to-one;
end;

definition
  let L;
  let A,B be Element of StoneS(L);
  redefine func A \/ B -> Element of StoneS(L);
  redefine func A /\ B -> Element of StoneS(L);
end;

definition
  let L;
  func Set_Union L -> BinOp of StoneS(L) means


  for A,B being Element of StoneS(L) holds it.(A,B) = A \/ B;
  func Set_Meet L -> BinOp of StoneS(L) means


  for A,B being Element of StoneS(L) holds it.(A,B) = A /\ B;
end;

theorem 
  LattStr(#StoneS(L),Set_Union L,Set_Meet L#) is Lattice;

definition
  let L;
  func StoneLatt L -> Lattice equals

  LattStr(#StoneS(L),Set_Union L,Set_Meet L
  #);
end;

reserve p,q for Element of StoneLatt(L);

theorem 
  for L holds the carrier of StoneLatt(L) = StoneS(L);

theorem 
  p "\/" q = p \/ q & p "/\" q = p /\ q;

theorem 
  p [= q iff p c= q;

definition
  let L;

  redefine func StoneH(L) -> Homomorphism of L,StoneLatt L;
end;

registration
  let L;
  cluster StoneH(L) -> bijective for Function of L,StoneLatt L;
  cluster StoneLatt(L) -> distributive;
end;

theorem 
  L,StoneLatt L are_isomorphic;

registration
  cluster non trivial for H_Lattice;
end;

reserve H for non trivial H_Lattice;
reserve p9,q9 for Element of H;

theorem 
  StoneH(H).(Top H) = F_primeSet(H);

theorem 
  StoneH(H).(Bottom H) = {};

theorem 
  StoneS(H) c= bool F_primeSet(H);

registration
  let H;
  cluster F_primeSet(H) -> non empty;
end;

definition
  let H;
  func HTopSpace H -> strict TopStruct means


  the carrier of it =
F_primeSet(H) & the topology of it ={union A where A is Subset of StoneS(H):not
  contradiction};
end;

registration
  let H;
  cluster HTopSpace H -> non empty TopSpace-like;
end;

theorem 
  the carrier of Open_setLatt(HTopSpace H) = {union A where A is Subset
  of StoneS(H):not contradiction};

theorem 
  StoneS(H) c= the carrier of Open_setLatt(HTopSpace H);

definition
  let H;
  redefine func StoneH(H) -> Homomorphism of H,Open_setLatt(HTopSpace H);
end;

theorem 
  StoneH(H).(p9 => q9) = (StoneH(H).p9) => (StoneH(H).q9);

theorem 
  StoneH(H) preserves_implication;

theorem 
  StoneH(H) preserves_top;

theorem 
  StoneH(H) preserves_bottom;














begin

reserve T for non empty TopSpace,
  X,Z for Subset of T;

definition
  let T be non empty TopStruct;
  func OpenClosedSet(T) -> Subset-Family of T equals

  {x where x is Subset of T: x is open closed};
end;

registration
  let T be non empty TopSpace;
  cluster OpenClosedSet(T) -> non empty;
end;

theorem 
  X in OpenClosedSet(T) implies X is open;

theorem 
  X in OpenClosedSet(T) implies X is closed;

theorem 
  X is open closed implies X in OpenClosedSet(T);

reserve x,y for Element of OpenClosedSet(T);

definition
  let T;
  let C,D be Element of OpenClosedSet(T);
  redefine func C \/ D -> Element of OpenClosedSet(T);
  redefine func C /\ D -> Element of OpenClosedSet(T);
end;

definition
  let T;
  func T_join T -> BinOp of OpenClosedSet(T) means


  for A,B being Element of OpenClosedSet(T) holds it.(A,B) = A \/ B;
  func T_meet T -> BinOp of OpenClosedSet(T) means


  for A,B being Element of OpenClosedSet(T) holds it.(A,B) = A /\ B;
end;

theorem 
  for x,y be Element of LattStr(#OpenClosedSet(T),T_join T,T_meet T#),
  x9,y9 be Element of OpenClosedSet(T)
  st x=x9 & y=y9 holds x"\/"y = x9 \/ y9;

theorem 
  for x,y be Element of LattStr(#OpenClosedSet(T),T_join T,T_meet T#),
  x9,y9 be Element of OpenClosedSet(T)
  st x=x9 & y=y9 holds x"/\"y = x9 /\ y9;

theorem 
  {} T is Element of OpenClosedSet(T);

theorem 
  [#] T is Element of OpenClosedSet(T);

theorem 
  x` is Element of OpenClosedSet(T);

theorem 
  LattStr(#OpenClosedSet(T),T_join T,T_meet T#) is Lattice;

definition
  let T be non empty TopSpace;
  func OpenClosedSetLatt(T) -> Lattice equals

  LattStr(#OpenClosedSet(T),T_join T,T_meet T#);
end;

theorem 
  for T being non empty TopSpace, x,y being Element of
  OpenClosedSetLatt(T) holds x"\/"y = x \/ y;

theorem 
  for T being non empty TopSpace , x,y being Element of
  OpenClosedSetLatt(T) holds x"/\"y = x /\ y;

theorem 
  the carrier of OpenClosedSetLatt(T) = OpenClosedSet(T);

registration
  let T;
  cluster OpenClosedSetLatt(T) -> Boolean;
end;

theorem 
  [#] T is Element of OpenClosedSetLatt(T);

theorem 
  {} T is Element of OpenClosedSetLatt(T);

reserve x,y,X for set;

registration
  cluster non trivial for B_Lattice;
end;

reserve BL for non trivial B_Lattice,
  a,b,c,p,q for Element of BL,
  UF,F,F0,F1,F2 for Filter of BL;

definition
  let BL;
  func ultraset BL -> Subset-Family of BL equals

  {F : F is being_ultrafilter};
end;

registration
  let BL;
  cluster ultraset BL -> non empty;
end;

theorem 
  x in ultraset BL iff ex UF st UF = x & UF is being_ultrafilter;

theorem 
  for a holds { F :F is being_ultrafilter & a in F} c= ultraset BL;

definition
  let BL;
  func UFilter BL -> Function means


  dom it = the carrier of BL & for a being Element of BL
  holds it.a = {UF:  UF is being_ultrafilter & a in UF };
end;

theorem 
  x in UFilter BL.a iff ex F st F=x & F is being_ultrafilter & a in F;

theorem 
  F in UFilter BL.a iff F is being_ultrafilter & a in F;

theorem 
  for F st F is being_ultrafilter holds a "\/" b in F iff a in F or b in F;

theorem 
  UFilter BL.(a "/\" b) = UFilter BL.a /\ UFilter BL.b;

theorem 
  UFilter BL.(a "\/" b) = UFilter BL.a \/ UFilter BL.b;

definition
  let BL;
  redefine func UFilter BL -> Function of the carrier of BL, bool ultraset BL;
end;

definition
  let BL;
  func StoneR BL -> set equals

  rng UFilter BL;
end;

registration
  let BL;
  cluster StoneR BL -> non empty;
end;

theorem 
  StoneR BL c= bool ultraset BL;

theorem 
  x in StoneR BL iff ex a st (UFilter BL).a =x;

definition
  let BL;
  func StoneSpace BL -> strict TopSpace means


  the carrier of it =ultraset BL & the topology of it =
  {union A where A is Subset-Family of ultraset BL : A c= StoneR BL };
end;

registration
  let BL;
  cluster StoneSpace BL -> non empty;
end;

theorem 
  F is being_ultrafilter & not F in UFilter BL.a implies not a in F;

theorem 
  ultraset BL \ UFilter BL.a = UFilter BL.a`;

definition
  let BL;
  func StoneBLattice BL -> Lattice equals

  OpenClosedSetLatt(StoneSpace BL );
end;

registration
  let BL;
  cluster UFilter BL -> one-to-one;
end;

theorem 
  union StoneR BL = ultraset BL;

theorem 
  for X being non empty set ex Y being Finite_Subset of X st Y is non empty;

registration
  let D be non empty set;
  cluster non empty for Finite_Subset of D;
end;

theorem 
  for L being non trivial B_Lattice, D being non empty Subset of L
  st Bottom L in <.D.) ex B being non empty Finite_Subset of the carrier of L
  st B c= D & FinMeet(B) = Bottom L;

theorem 
  for L being 0_Lattice holds
  not ex F being Filter of L st F is being_ultrafilter & Bottom L in F;

theorem 
  UFilter BL.Bottom BL = {};

theorem 
  UFilter BL.Top BL = ultraset BL;

theorem 
  ultraset BL = union X & X is Subset of StoneR BL implies
  ex Y being Finite_Subset of X st ultraset BL = union Y;

theorem 
  StoneR BL = OpenClosedSet(StoneSpace BL);

definition
  let BL;
  redefine func UFilter BL -> Homomorphism of BL,StoneBLattice BL;
end;

theorem 
  rng UFilter BL = the carrier of StoneBLattice BL;

registration
  let BL;
  cluster UFilter BL -> bijective for Function of BL,StoneBLattice BL;
end;

theorem 
  BL,StoneBLattice BL are_isomorphic;


theorem 
  for BL being non trivial B_Lattice ex T being non empty TopSpace st
  BL, OpenClosedSetLatt(T) are_isomorphic;















begin

theorem 
  for A, B being non empty set, f being Function of A,B, C being
  Subset of A, v being Element of B holds f +* (C-->v) is Function of A,B;

theorem 
  for X, Y being non empty set, A, B being Subset of X, f being
  Function of X,Y st f.:A misses f.:B holds A misses B;

theorem 
  for A, B being set, f being Function, x being set holds A misses
  B implies (f +* (A --> x)).:B = f.:B;



begin



definition
  let PTN be PT_net_Str;
  func Bool_marks_of PTN -> FUNCTION_DOMAIN of the carrier of PTN, BOOLEAN
  equals

  Funcs(the carrier of PTN, BOOLEAN);
end;

definition
  let PTN be PT_net_Str;
  mode Boolean_marking of PTN is Element of Bool_marks_of PTN;
end;



definition
  let PTN be Petri_net;
  let M0 be Boolean_marking of PTN;
  let t be transition of PTN;
  pred t is_firable_on M0 means


  M0.:*'{t} c= {TRUE};
end;

notation
  let PTN be Petri_net;
  let M0 be Boolean_marking of PTN;
  let t be transition of PTN;
  antonym t is_not_firable_on M0 for t is_firable_on M0;
end;

definition
  let PTN be Petri_net;
  let M0 be Boolean_marking of PTN;
  let t be transition of PTN;
  func Firing(t,M0) -> Boolean_marking of PTN equals

  M0 +* (*'{t}-->FALSE) +*
  ({t}*'-->TRUE);
end;



definition
  let PTN be Petri_net;
  let M0 be Boolean_marking of PTN;
  let Q be FinSequence of the carrier' of PTN;
  pred Q is_firable_on M0 means


  Q = {} or ex M being FinSequence of
Bool_marks_of PTN st len Q = len M & Q/.1 is_firable_on M0 & M/.1 = Firing(Q/.1
  ,M0) & for i being Element of NAT st i < len Q & i > 0 holds Q/.(i+1)
  is_firable_on M/.i & M/.(i+1) = Firing(Q/.(i+1),M/.i);
end;

notation
  let PTN be Petri_net;
  let M0 be Boolean_marking of PTN;
  let Q be FinSequence of the carrier' of PTN;
  antonym Q is_not_firable_on M0 for Q is_firable_on M0;
end;

definition
  let PTN be Petri_net;
  let M0 be Boolean_marking of PTN;
  let Q be FinSequence of the carrier' of PTN;
  func Firing(Q,M0) -> Boolean_marking of PTN means


  it = M0 if Q = {}
otherwise ex M being FinSequence of Bool_marks_of PTN st len Q = len M & it = M
/.len M & M/.1 = Firing(Q/.1,M0) & for i being Element of NAT st i < len Q & i
  > 0 holds M/.(i+1) = Firing(Q/.(i+1),M/.i);
end;

theorem 
  for A being non empty set, y being set, f being Function holds (f
  +*(A --> y)).:A = {y};

theorem 
  for PTN being Petri_net, M0 being Boolean_marking of PTN, t
being transition of PTN, s being place of PTN st s in {t}*' holds Firing(t,M0).
  s = TRUE;

theorem 
  for PTN being Petri_net, Sd being non empty Subset of the carrier of
PTN holds Sd is Deadlock-like iff for M0 being Boolean_marking of PTN st M0.:Sd
= {FALSE} for t being transition of PTN st t is_firable_on M0 holds Firing(t,M0
  ).:Sd = {FALSE};

theorem 
  for D being non empty set for Q0,Q1 being FinSequence of D, i
  being Element of NAT st 1<=i & i<=len Q0 holds (Q0^Q1)/.i=Q0/.i;

theorem 
  for PTN being Petri_net, M0 being Boolean_marking of PTN, Q0,
Q1 being FinSequence of the carrier' of PTN holds Firing(Q0^Q1,M0) = Firing(
  Q1,Firing(Q0,M0));

theorem 
  for PTN being Petri_net, M0 being Boolean_marking of PTN, Q0,
Q1 being FinSequence of the carrier' of PTN st Q0^Q1 is_firable_on M0 holds
  Q1 is_firable_on Firing(Q0,M0) & Q0 is_firable_on M0;

theorem 
  for PTN being Petri_net, M0 being Boolean_marking of PTN, t
  being transition of PTN holds t is_firable_on M0 iff <*t*> is_firable_on M0;

theorem 
  for PTN being Petri_net, M0 being Boolean_marking of PTN, t
  being transition of PTN holds Firing(t,M0) = Firing(<*t*>,M0);

theorem 
  for PTN being Petri_net, Sd being non empty Subset of the carrier of
PTN holds Sd is Deadlock-like iff for M0 being Boolean_marking of PTN st M0.:Sd
= {FALSE} for Q being FinSequence of the carrier' of PTN st Q is_firable_on
  M0 holds Firing(Q,M0).:Sd = {FALSE};














begin





reserve x,y for set,
  n for Element of NAT;

definition
  let IT be set;
  attr IT is disjoint_with_NAT means


  IT misses NAT;
end;

registration
  cluster non empty disjoint_with_NAT for set;
end;

notation
  let IT be Relation;
  antonym IT is with_zero for IT is non-empty;
  synonym IT is without_zero for IT is non-empty;
end;

definition
  let IT be Relation;
  redefine attr IT is with_zero means


  0 in rng IT;
end;

registration
  cluster non empty with_zero for FinSequence of NAT;
  cluster non empty without_zero for FinSequence of NAT;
end;

begin





definition
  let U1 be Universal_Algebra, n be Element of NAT;
  assume
 n in dom (the charact of U1);

  func oper(n,U1) -> operation of U1 equals


  (the charact of U1).n;
end;

definition
  let U0 be Universal_Algebra;
  mode GeneratorSet of U0 -> Subset of U0 means

    for A being Subset of U0 st A
    is opers_closed & it c= A holds A = the carrier of U0;
end;

definition
  let U0 be Universal_Algebra;
  let IT be GeneratorSet of U0;
  attr IT is free means


  for U1 be Universal_Algebra st U0,U1
are_similar holds for f be Function of IT,the carrier of U1 ex h be Function of
  U0,U1 st h is_homomorphism U0,U1 & h|IT = f;
end;

definition
  let IT be Universal_Algebra;
  attr IT is free means


  ex G being GeneratorSet of IT st G is free;
end;

registration
  cluster free strict for Universal_Algebra;
end;

registration
  let U0 be free Universal_Algebra;
  cluster free for GeneratorSet of U0;
end;

theorem 
  for U0 be strict Universal_Algebra,A be Subset of U0 st Constants U0
  <> {} or A <> {} holds A is GeneratorSet of U0 iff GenUnivAlg(A) = U0;

begin





definition
  let f be non empty FinSequence of NAT, X be set;
  func REL(f,X) -> Relation of ((dom f) \/ X),(((dom f) \/ X)*) means


  for a be Element of (dom f) \/ X, b be Element of ((dom f) \/ X)* holds [a,b]
  in it iff a in dom f & f.a = len b;
end;

definition
  let f be non empty FinSequence of NAT, X be set;
  func DTConUA(f,X) -> strict DTConstrStr equals

  DTConstrStr (# (dom f) \/ X,
    REL(f,X) #);
end;

registration
  let f be non empty FinSequence of NAT, X be set;
  cluster DTConUA(f,X) -> non empty;
end;

theorem 
  for f be non empty FinSequence of NAT, X be set holds (Terminals
  (DTConUA(f,X))) c= X & NonTerminals(DTConUA(f,X)) = dom f;

theorem 
  for f be non empty FinSequence of NAT, X be disjoint_with_NAT set
  holds (Terminals (DTConUA(f,X))) = X;

registration
  let f be non empty FinSequence of NAT, X be set;
  cluster DTConUA(f,X) -> with_nonterminals;
end;

registration
  let f be with_zero non empty FinSequence of NAT, X be set;
  cluster DTConUA(f,X) -> with_nonterminals with_useful_nonterminals;
end;

registration
  let f be non empty FinSequence of NAT, D be disjoint_with_NAT non empty set;
  cluster DTConUA(f,D) -> with_terminals with_nonterminals
    with_useful_nonterminals;
end;

definition
  let f be non empty FinSequence of NAT, X be set, n be Nat;
  assume
 n in dom f;
  func Sym(n,f,X) -> Symbol of DTConUA(f,X) equals


  n;
end;

begin





definition
  let f be non empty FinSequence of NAT, D be disjoint_with_NAT non empty set,
  n be Nat;
  assume
 n in dom f;
  func FreeOpNSG(n,f,D) -> homogeneous quasi_total non empty PartFunc of (TS
  DTConUA(f,D))*, TS(DTConUA(f,D)) means


  dom it = (f/.n)-tuples_on TS(
  DTConUA(f,D)) & for p be FinSequence of TS(DTConUA(f,D)) st p in dom it holds
  it.p = Sym(n,f,D)-tree(p);
end;

definition
  let f be non empty FinSequence of NAT, D be disjoint_with_NAT non empty set;
  func FreeOpSeqNSG(f,D) -> PFuncFinSequence of TS DTConUA(f,D) means


  len it = len f & for n st n in dom it holds it.n = FreeOpNSG(n,f,D);
end;

definition
  let f be non empty FinSequence of NAT, D be disjoint_with_NAT non empty set;
  func FreeUnivAlgNSG(f,D) -> strict Universal_Algebra equals

  UAStr (# TS(
    DTConUA(f,D)), FreeOpSeqNSG(f,D)#);
end;

theorem 
  for f be non empty FinSequence of NAT, D be disjoint_with_NAT non
  empty set holds signature (FreeUnivAlgNSG(f,D)) = f;

definition
  let f be non empty FinSequence of NAT, D be non empty disjoint_with_NAT set;
  func FreeGenSetNSG(f,D) -> Subset of FreeUnivAlgNSG(f,D) equals

  {root-tree s
  where s is Symbol of DTConUA(f,D): s in Terminals DTConUA(f,D)};
end;

theorem 
  for f be non empty FinSequence of NAT,D be non empty
  disjoint_with_NAT set holds FreeGenSetNSG(f,D) is non empty;

definition
  let f be non empty FinSequence of NAT, D be non empty disjoint_with_NAT set;
  redefine func FreeGenSetNSG(f,D) -> GeneratorSet of FreeUnivAlgNSG(f,D);
end;

definition
  let f be non empty FinSequence of NAT, D be non empty disjoint_with_NAT set,
  C be non empty set, s be Symbol of (DTConUA(f,D)), F be Function of
  FreeGenSetNSG(f,D),C;
  assume
 s in Terminals (DTConUA(f,D));
  func pi(F,s) -> Element of C equals


  F.(root-tree s);
end;

definition
  let f be non empty FinSequence of NAT, D be set, s be Symbol of (DTConUA(f,D
  ));
  given p be FinSequence such that
 s ==> p;
  func @s -> Element of NAT equals


  s;
end;

theorem 
  for f be non empty FinSequence of NAT,D be non empty
  disjoint_with_NAT set holds FreeGenSetNSG(f,D) is free;

registration
  let f be non empty FinSequence of NAT, D be non empty disjoint_with_NAT set;
  cluster FreeUnivAlgNSG(f,D) -> free;
end;

definition
  let f be non empty FinSequence of NAT, D be non empty disjoint_with_NAT set;
  redefine func FreeGenSetNSG(f,D) -> free GeneratorSet of FreeUnivAlgNSG(f,D);
end;

begin






definition
  let f be with_zero non empty FinSequence of NAT, D be disjoint_with_NAT set,
  n be Nat;
  assume
 n in dom f;
  func FreeOpZAO(n,f,D) -> homogeneous quasi_total non empty PartFunc of (TS
  DTConUA(f,D))*, TS(DTConUA(f,D)) means


  dom it = (f/.n)-tuples_on TS(
  DTConUA(f,D)) & for p be FinSequence of TS(DTConUA(f,D)) st p in dom it holds
  it.p = Sym(n,f,D)-tree(p);
end;

definition
  let f be with_zero non empty FinSequence of NAT, D be disjoint_with_NAT set;
  func FreeOpSeqZAO(f,D) -> PFuncFinSequence of TS DTConUA(f,D) means


  len it = len f & for n st n in dom it holds it.n = FreeOpZAO(n,f,D);
end;

definition
  let f be with_zero non empty FinSequence of NAT, D be disjoint_with_NAT set;
  func FreeUnivAlgZAO(f,D) -> strict Universal_Algebra equals

  UAStr (# TS(
    DTConUA(f,D)), FreeOpSeqZAO(f,D)#);
end;

theorem 
  for f be with_zero non empty FinSequence of NAT, D be
  disjoint_with_NAT set holds signature (FreeUnivAlgZAO(f,D)) = f;

theorem 
  for f be with_zero non empty FinSequence of NAT,D be
  disjoint_with_NAT set holds FreeUnivAlgZAO(f,D) is with_const_op;

theorem 
  for f be with_zero non empty FinSequence of NAT,D be
  disjoint_with_NAT set holds Constants(FreeUnivAlgZAO(f,D)) <> {};

definition
  let f be with_zero non empty FinSequence of NAT, D be disjoint_with_NAT set;
  func FreeGenSetZAO(f,D) -> Subset of FreeUnivAlgZAO(f,D) equals

  {root-tree s
  where s is Symbol of DTConUA(f,D): s in Terminals DTConUA(f,D)};
end;

definition
  let f be with_zero non empty FinSequence of NAT, D be disjoint_with_NAT set;
  redefine func FreeGenSetZAO(f,D) -> GeneratorSet of FreeUnivAlgZAO(f,D);
end;

definition
  let f be with_zero non empty FinSequence of NAT, D be disjoint_with_NAT set,
  C be non empty set, s be Symbol of (DTConUA(f,D)), F be Function of (
  FreeGenSetZAO(f,D)),C;
  assume
 s in Terminals (DTConUA(f,D));
  func pi(F,s) -> Element of C equals


  F.(root-tree s);
end;

theorem 
  for f be with_zero non empty FinSequence of NAT,D be
  disjoint_with_NAT set holds FreeGenSetZAO(f,D) is free;

registration
  let f be with_zero non empty FinSequence of NAT, D be disjoint_with_NAT set;
  cluster FreeUnivAlgZAO(f,D) -> free;
end;

definition
  let f be with_zero non empty FinSequence of NAT, D be disjoint_with_NAT set;
  redefine func FreeGenSetZAO(f,D) -> free GeneratorSet of FreeUnivAlgZAO(f,D);
end;

registration
  cluster strict free with_const_op for Universal_Algebra;
end;














begin



reserve X for non empty TopSpace,
  A,B for Subset of X;

theorem 
  A,B constitute_a_decomposition implies (A is non empty iff B is proper);

theorem 
  A,B constitute_a_decomposition implies (A is dense iff B is boundary);

theorem 
  A,B constitute_a_decomposition implies (A is boundary iff B is dense);

theorem 
  A,B constitute_a_decomposition implies (A is everywhere_dense iff
  B is nowhere_dense);

theorem 
  A,B constitute_a_decomposition implies (A is nowhere_dense iff B is
  everywhere_dense);

reserve Y1,Y2 for non empty SubSpace of X;

theorem 
  Y1,Y2 constitute_a_decomposition implies Y1 is proper & Y2 is proper;

theorem 
  for X being non trivial TopSpace, D being non empty proper
  Subset of X ex Y0 being proper strict non empty SubSpace of X st D = the
  carrier of Y0;

theorem 
  for X being non trivial TopSpace, Y1 being proper non
empty SubSpace of X ex Y2 being proper strict non empty SubSpace of X st Y1,Y2
  constitute_a_decomposition;

begin



definition
  let X be non empty TopSpace;
  let IT be SubSpace of X;
  attr IT is dense means


  for A being Subset of X st A = the carrier of IT holds A is dense;
end;

theorem 
  for X0 being SubSpace of X, A being Subset of X st A = the
  carrier of X0 holds X0 is dense iff A is dense;

registration
  let X be non empty TopSpace;
  cluster dense closed -> non proper for SubSpace of X;
  cluster dense proper -> non closed for SubSpace of X;
  cluster proper closed -> non dense for SubSpace of X;
end;

registration
  let X be non empty TopSpace;
  cluster dense strict non empty for SubSpace of X;
end;



theorem 
  for A0 being non empty Subset of X st A0 is dense ex X0 being
  dense strict non empty SubSpace of X st A0 = the carrier of X0;

theorem 
  for X0 being dense non empty SubSpace of X, A being Subset of X, B
  being Subset of X0 st A = B holds B is dense iff A is dense;

theorem 
  for X1 being dense SubSpace of X, X2 being SubSpace of X holds X1 is
  SubSpace of X2 implies X2 is dense;

theorem 
  for X1 being dense non empty SubSpace of X, X2 being non empty
  SubSpace of X holds X1 is SubSpace of X2 implies X1 is dense SubSpace of X2;

theorem 
  for X1 being dense non empty SubSpace of X, X2 being dense non empty
  SubSpace of X1 holds X2 is dense non empty SubSpace of X;

theorem 
  for Y1, Y2 being non empty TopSpace st Y2 = the TopStruct of Y1 holds
  Y1 is dense SubSpace of X iff Y2 is dense SubSpace of X;

definition
  let X be non empty TopSpace;
  let IT be SubSpace of X;
  attr IT is everywhere_dense means


  for A being Subset of X st A = the carrier of IT holds A is everywhere_dense;
end;

theorem 
  for X0 being SubSpace of X, A being Subset of X st A = the
  carrier of X0 holds X0 is everywhere_dense iff A is everywhere_dense;

registration
  let X be non empty TopSpace;
  cluster everywhere_dense -> dense for SubSpace of X;
  cluster non dense -> non everywhere_dense for SubSpace of X;
  cluster non proper -> everywhere_dense for SubSpace of X;
  cluster non everywhere_dense -> proper for SubSpace of X;
end;

registration
  let X be non empty TopSpace;
  cluster everywhere_dense strict non empty for SubSpace of X;
end;



theorem 
  for A0 being non empty Subset of X st A0 is everywhere_dense ex
X0 being everywhere_dense strict non empty SubSpace of X st A0 = the carrier of
  X0;

theorem 
  for X0 being everywhere_dense non empty SubSpace of X, A being Subset
  of X, B being Subset of X0 st A = B holds B is everywhere_dense iff A is
  everywhere_dense;

theorem 
  for X1 being everywhere_dense SubSpace of X, X2 being SubSpace of X
  holds X1 is SubSpace of X2 implies X2 is everywhere_dense;

theorem 
  for X1 being everywhere_dense non empty SubSpace of X, X2 being non
  empty SubSpace of X holds X1 is SubSpace of X2 implies X1 is everywhere_dense
  SubSpace of X2;

theorem 
  for X1 being everywhere_dense non empty SubSpace of X, X2 being
everywhere_dense non empty SubSpace of X1 holds X2 is everywhere_dense SubSpace
  of X;

theorem 
  for Y1, Y2 being non empty TopSpace st Y2 = the TopStruct of Y1 holds
  Y1 is everywhere_dense SubSpace of X iff Y2 is everywhere_dense SubSpace of X
;

registration
  let X be non empty TopSpace;
  cluster dense open -> everywhere_dense for SubSpace of X;
  cluster dense non everywhere_dense -> non open for SubSpace of X;
  cluster open non everywhere_dense -> non dense for SubSpace of X;
end;

registration
  let X be non empty TopSpace;
  cluster dense open strict non empty for SubSpace of X;
end;



theorem 
  for A0 being non empty Subset of X st A0 is dense open ex X0
  being dense open strict non empty SubSpace of X st A0 = the carrier of X0;

theorem 
  for X0 being SubSpace of X holds X0 is everywhere_dense iff ex X1
  being dense open strict SubSpace of X st X1 is SubSpace of X0;

reserve X1, X2 for non empty SubSpace of X;

theorem 
  X1 is dense or X2 is dense implies X1 union X2 is dense SubSpace of X;

theorem 
  X1 is everywhere_dense or X2 is everywhere_dense implies X1 union X2
  is everywhere_dense SubSpace of X;

theorem 
  X1 is everywhere_dense & X2 is everywhere_dense implies X1 meet X2 is
  everywhere_dense SubSpace of X;

theorem 
  X1 is everywhere_dense & X2 is dense or X1 is dense & X2 is
  everywhere_dense implies X1 meet X2 is dense SubSpace of X;

begin



definition
  let X be non empty TopSpace;
  let IT be SubSpace of X;
  attr IT is boundary means


  for A being Subset of X st A = the carrier of IT holds A is boundary;
end;

theorem 
  for X0 being SubSpace of X, A being Subset of X st A = the
  carrier of X0 holds X0 is boundary iff A is boundary;

registration
  let X be non empty TopSpace;
  cluster open -> non boundary for non empty SubSpace of X;
  cluster boundary -> non open for non empty SubSpace of X;
  cluster everywhere_dense -> non boundary for SubSpace of X;
  cluster boundary -> non everywhere_dense for SubSpace of X;
end;



theorem 
  for A0 being non empty Subset of X st A0 is boundary ex X0 being
  strict SubSpace of X st X0 is boundary & A0 = the carrier of X0;

theorem 
  for X1,X2 being SubSpace of X st X1,X2
  constitute_a_decomposition holds X1 is dense iff X2 is boundary;

theorem 
  for X1,X2 being non empty SubSpace of X st X1,X2
  constitute_a_decomposition holds X1 is boundary iff X2 is dense;

theorem 
  for X0 being SubSpace of X st X0 is boundary for A being Subset
  of X st A c= the carrier of X0 holds A is boundary;

theorem 
  for X1,X2 being SubSpace of X st X1 is boundary holds X2 is
  SubSpace of X1 implies X2 is boundary;

definition
  let X be non empty TopSpace;
  let IT be SubSpace of X;
  attr IT is nowhere_dense means


  for A being Subset of X st A = the carrier of IT holds A is nowhere_dense;
end;

theorem 
  for X0 being SubSpace of X, A being Subset of X st A = the
  carrier of X0 holds X0 is nowhere_dense iff A is nowhere_dense;

registration
  let X be non empty TopSpace;
  cluster nowhere_dense -> boundary for SubSpace of X;
  cluster non boundary -> non nowhere_dense for SubSpace of X;
  cluster nowhere_dense -> non dense for SubSpace of X;
  cluster dense -> non nowhere_dense for SubSpace of X;
end;

reserve X for non empty TopSpace;



theorem 
  for A0 being non empty Subset of X st A0 is nowhere_dense ex X0 being
  strict SubSpace of X st X0 is nowhere_dense & A0 = the carrier of X0;

theorem 
  for X1,X2 being SubSpace of X st X1,X2
constitute_a_decomposition holds X1 is everywhere_dense iff X2 is nowhere_dense
;

theorem 
  for X1,X2 being non empty SubSpace of X st X1,X2
constitute_a_decomposition holds X1 is nowhere_dense iff X2 is everywhere_dense
;

theorem 
  for X0 being SubSpace of X st X0 is nowhere_dense for A being
  Subset of X st A c= the carrier of X0 holds A is nowhere_dense;

theorem 
  for X1,X2 being SubSpace of X st X1 is nowhere_dense holds X2 is
  SubSpace of X1 implies X2 is nowhere_dense;

registration
  let X be non empty TopSpace;
  cluster boundary closed -> nowhere_dense for SubSpace of X;
  cluster boundary non nowhere_dense -> non closed for SubSpace of X;
  cluster closed non nowhere_dense -> non boundary for SubSpace of X;
end;



theorem 
  for A0 being non empty Subset of X st A0 is boundary closed ex
  X0 being closed strict non empty SubSpace of X st X0 is boundary & A0 = the
  carrier of X0;

theorem 
  for X0 being non empty SubSpace of X holds X0 is nowhere_dense iff ex
  X1 being closed strict non empty SubSpace of X st X1 is boundary & X0 is
  SubSpace of X1;

reserve X1, X2 for non empty SubSpace of X;

theorem 
  (X1 is boundary or X2 is boundary) & X1 meets X2 implies X1 meet X2 is
  boundary;

theorem 
  X1 is nowhere_dense & X2 is nowhere_dense implies X1 union X2 is
  nowhere_dense;

theorem 
  X1 is nowhere_dense & X2 is boundary or X1 is boundary & X2 is
  nowhere_dense implies X1 union X2 is boundary;

theorem 
  (X1 is nowhere_dense or X2 is nowhere_dense) & X1 meets X2 implies X1
  meet X2 is nowhere_dense;

begin



theorem 
  for X being non empty TopSpace holds (for X0 being SubSpace of X holds
  X0 is non boundary) implies X is discrete;

theorem 
  for X being non trivial TopSpace holds (for X0 being
  proper SubSpace of X holds X0 is non dense) implies X is discrete;

registration
  let X be discrete non empty TopSpace;
  cluster -> non boundary for non empty SubSpace of X;
  cluster proper -> non dense for SubSpace of X;
  cluster dense -> non proper for SubSpace of X;
end;

registration
  let X be discrete non empty TopSpace;
  cluster non boundary strict non empty for SubSpace of X;
end;

registration
  let X be discrete non trivial TopSpace;
  cluster non dense strict for SubSpace of X;
end;

theorem 
  for X being non empty TopSpace holds (ex X0 being non empty SubSpace
  of X st X0 is boundary) implies X is non discrete;

theorem 
  for X being non empty TopSpace holds (ex X0 being non empty SubSpace
  of X st X0 is dense proper) implies X is non discrete;

registration
  let X be non discrete non empty TopSpace;
  cluster boundary strict non empty for SubSpace of X;
  cluster dense proper strict non empty for SubSpace of X;
end;

reserve X for non discrete non empty TopSpace;

theorem 
  for A0 being non empty Subset of X st A0 is boundary ex X0 being
  boundary strict SubSpace of X st A0 = the carrier of X0;

theorem 
  for A0 being non empty proper Subset of X st A0 is dense ex X0 being
  dense proper strict SubSpace of X st A0 = the carrier of X0;

theorem 
  for X1 being boundary non empty SubSpace of X ex X2 being dense proper
  strict non empty SubSpace of X st X1,X2 constitute_a_decomposition;

theorem 
  for X1 being dense proper non empty SubSpace of X ex X2 being boundary
  strict non empty SubSpace of X st X1,X2 constitute_a_decomposition;

theorem 
  for Y1, Y2 being non empty TopSpace st Y2 = the TopStruct of Y1 holds
  Y1 is boundary SubSpace of X iff Y2 is boundary SubSpace of X;

begin



theorem 
  for X being non empty TopSpace holds (for X0 being SubSpace of X holds
  X0 is non nowhere_dense) implies X is almost_discrete;

theorem 
  for X being non trivial TopSpace holds (for X0 being
  proper SubSpace of X holds X0 is non everywhere_dense) implies X is
  almost_discrete;

registration
  let X be almost_discrete non empty TopSpace;
  cluster -> non nowhere_dense for non empty SubSpace of X;
  cluster proper -> non everywhere_dense for SubSpace of X;
  cluster everywhere_dense -> non proper for SubSpace of X;
  cluster boundary -> non closed for non empty SubSpace of X;
  cluster closed -> non boundary for non empty SubSpace of X;
  cluster dense proper -> non open for SubSpace of X;
  cluster dense open -> non proper for SubSpace of X;
  cluster open proper -> non dense for SubSpace of X;
end;

registration
  let X be almost_discrete non empty TopSpace;
  cluster non nowhere_dense strict non empty for SubSpace of X;
end;

registration
  let X be almost_discrete non trivial TopSpace;
  cluster non everywhere_dense strict for SubSpace of X;
end;

theorem 
  for X being non empty TopSpace holds (ex X0 being non empty SubSpace
  of X st X0 is nowhere_dense) implies X is non almost_discrete;

theorem 
  for X being non empty TopSpace holds (ex X0 being non empty SubSpace
  of X st X0 is boundary closed) implies X is non almost_discrete;

theorem 
  for X being non empty TopSpace holds (ex X0 being non empty SubSpace
  of X st X0 is everywhere_dense proper) implies X is non almost_discrete;

theorem 
  for X being non empty TopSpace holds (ex X0 being non empty SubSpace
  of X st X0 is dense open proper) implies X is non almost_discrete;

registration
  let X be non almost_discrete non empty TopSpace;
  cluster nowhere_dense strict non empty for SubSpace of X;
  cluster everywhere_dense proper strict non empty for SubSpace of X;
end;

reserve X for non almost_discrete non empty TopSpace;

theorem 
  for A0 being non empty Subset of X st A0 is nowhere_dense ex X0
  being nowhere_dense strict non empty SubSpace of X st A0 = the carrier of X0;

theorem 
  for A0 being non empty proper Subset of X st A0 is everywhere_dense ex
X0 being everywhere_dense proper strict SubSpace of X st A0 = the carrier of X0
;

theorem 
  for X1 being nowhere_dense non empty SubSpace of X ex X2 being
  everywhere_dense proper strict non empty SubSpace of X st X1,X2
  constitute_a_decomposition;

theorem 
  for X1 being everywhere_dense proper non empty SubSpace of X ex X2
  being nowhere_dense strict non empty SubSpace of X st X1,X2
  constitute_a_decomposition;

theorem 
  for Y1, Y2 being non empty TopSpace st Y2 = the TopStruct of Y1 holds
  Y1 is nowhere_dense SubSpace of X iff Y2 is nowhere_dense SubSpace of X;

registration
  let X be non almost_discrete non empty TopSpace;
  cluster boundary closed strict non empty for SubSpace of X;
  cluster dense open proper strict non empty for SubSpace of X;
end;

theorem 
  for A0 being non empty Subset of X st A0 is boundary closed ex
X0 being boundary closed strict non empty SubSpace of X st A0 = the carrier of
  X0;

theorem 
  for A0 being non empty proper Subset of X st A0 is dense open ex X0
  being dense open proper strict SubSpace of X st A0 = the carrier of X0;

theorem 
  for X1 being boundary closed non empty SubSpace of X ex X2 being dense
open proper strict non empty SubSpace of X st X1,X2 constitute_a_decomposition;

theorem 
  for X1 being dense open proper non empty SubSpace of X ex X2 being
  boundary closed strict non empty SubSpace of X st X1,X2
  constitute_a_decomposition;

theorem 
  for X0 being non empty SubSpace of X holds X0 is nowhere_dense iff ex
X1 being boundary closed strict non empty SubSpace of X st X0 is SubSpace of X1
;

theorem 
  for X0 being nowhere_dense non empty SubSpace of X holds X0 is
  boundary closed or ex X1 being everywhere_dense proper strict non empty
  SubSpace of X, X2 being boundary closed strict non empty SubSpace of X st X1
  meet X2 = the TopStruct of X0 & X1 union X2 = the TopStruct of X;

theorem 
  for X0 being everywhere_dense non empty SubSpace of X holds X0 is
dense open or ex X1 being dense open proper strict non empty SubSpace of X, X2
  being nowhere_dense strict non empty SubSpace of X st X1 misses X2 & X1 union
  X2 = the TopStruct of X0;

theorem 
  for X0 being nowhere_dense non empty SubSpace of X ex X1 being dense
open proper strict non empty SubSpace of X, X2 being boundary closed strict non
empty SubSpace of X st X1,X2 constitute_a_decomposition & X0 is SubSpace of X2;

theorem 
  for X0 being everywhere_dense proper SubSpace of X ex X1 being dense
open proper strict SubSpace of X, X2 being boundary closed strict SubSpace of X
  st X1,X2 constitute_a_decomposition & X1 is SubSpace of X0;














begin

definition
  let D be non empty set, t be DecoratedTree of D;
  func root-label t -> Element of D equals

  t.{};
end;

theorem 
  for D being non empty set, t being DecoratedTree of D holds roots <*t
  *> = <*root-label t*>;

theorem 
  for D being non empty set, t1, t2 being DecoratedTree of D holds roots
  <*t1, t2*> = <*root-label t1, root-label t2*>;

definition
  let IT be Tree;
  attr IT is binary means


  for t being Element of IT st not t in Leaves
  IT holds succ t = { t^<*0*>, t^<*1*> };
end;

theorem 
  for T being Tree, t being Element of T holds succ t = {} iff t in Leaves T;

registration
  cluster elementary_tree 0 -> binary;

  cluster elementary_tree 2 -> binary;
end;

theorem 
  elementary_tree 0 is binary;

theorem 
  elementary_tree 2 is binary;

registration
  cluster binary finite for Tree;
end;

definition
  let IT be DecoratedTree;
  attr IT is binary means


  dom IT is binary;
end;

registration
  let D be non empty set;
  cluster binary finite for DecoratedTree of D;
end;

registration
  cluster binary finite for DecoratedTree;
end;

registration
  cluster binary -> finite-order for Tree;
end;

theorem 
  for T0,T1 being Tree, t being Element of tree(T0,T1) holds (for p
  being Element of T0 st t = <*0*>^p holds t in Leaves tree(T0,T1) iff p in
Leaves T0) & for p being Element of T1 st t = <*1*>^p holds t in Leaves tree(T0
  ,T1) iff p in Leaves T1;

theorem 
  for T0,T1 being Tree, t being Element of tree(T0,T1) holds (t =
  {} implies succ t = { t^<*0*>, t^<*1*> }) & (for p being Element of T0 st t =
  <*0*>^p for sp being FinSequence holds sp in succ p iff <*0*>^sp in succ t) &
  for p being Element of T1 st t = <*1*>^p for sp being FinSequence holds sp in
  succ p iff <*1*>^sp in succ t;

theorem 
  for T1,T2 being Tree holds T1 is binary & T2 is binary iff tree(
  T1,T2) is binary;

theorem 
  for T1,T2 being DecoratedTree, x being set holds T1 is binary &
  T2 is binary iff x-tree (T1,T2) is binary;

registration
  let D be non empty set, x be Element of D, T1, T2 be binary finite
  DecoratedTree of D;
  cluster x-tree (T1,T2) -> binary finite D-valued;
end;

definition
  let IT be non empty DTConstrStr;
  attr IT is binary means


  for s being Symbol of IT, p being FinSequence
  st s ==> p ex x1, x2 being Symbol of IT st p = <* x1, x2 *>;
end;

registration
  cluster binary with_terminals with_nonterminals with_useful_nonterminals
    strict for non empty DTConstrStr;
end;

scheme 

  BinDTConstrStrEx { S() -> non empty set, P[set, set, set] }: ex G be binary
  strict non empty DTConstrStr st the carrier of G = S() & for x, y, z being
  Symbol of G holds x ==> <*y,z*> iff P[x, y, z];

theorem 
  for G being binary with_terminals with_nonterminals non empty
  DTConstrStr, ts being FinSequence of TS G, nt being Symbol of G st nt ==>
  roots ts holds nt is NonTerminal of G & dom ts = {1, 2} & 1 in dom ts & 2 in
  dom ts & ex tl, tr being Element of TS G st roots ts = <*root-label tl,
root-label tr*> & tl = ts.1 & tr = ts.2 & nt-tree ts = nt-tree (tl, tr) & tl in
  rng ts & tr in rng ts;

scheme 

  BinDTConstrInd { G() -> binary with_terminals with_nonterminals non empty
  DTConstrStr, P[set] }: for t being Element of TS(G()) holds P[t]
provided
 for s being Terminal of G() holds P[root-tree s] and
 for nt being NonTerminal of G(), tl, tr being Element of TS(G()) st
nt ==> <*root-label tl, root-label tr*> & P[tl] & P[tr] holds P[nt-tree(tl, tr)
];

scheme 

  BinDTConstrIndDef { G() -> binary with_terminals with_nonterminals
with_useful_nonterminals non empty DTConstrStr, D()->non empty set, TermVal(
set) -> Element of D(), NTermVal(set, set, set, set, set) -> Element of D() }:
  ex f being Function of TS(G()), D() st (for t being Terminal of G() holds f.(
  root-tree t) = TermVal(t)) & for nt being NonTerminal of G(), tl, tr being
Element of TS(G()), rtl, rtr being Symbol of G() st rtl = root-label tl & rtr =
root-label tr & nt ==> <* rtl, rtr *> for xl, xr being Element of D() st xl = f
  .tl & xr = f.tr holds f.(nt-tree (tl, tr)) = NTermVal(nt, rtl, rtr, xl, xr);

scheme 

  BinDTConstrUniqDef { G() -> binary with_terminals with_nonterminals
with_useful_nonterminals non empty DTConstrStr, D()->non empty set, f1, f2()
-> Function of TS(G()), D(), TermVal(set) -> Element of D(), NTermVal(set, set,
  set, set, set) -> Element of D() }: f1() = f2()
provided
 (for t being Terminal of G() holds f1().(root-tree t) = TermVal(t))
& for nt being NonTerminal of G(), tl, tr being Element of TS(G()), rtl, rtr
being Symbol of G() st rtl = root-label tl & rtr = root-label tr & nt ==> <*
rtl, rtr *> for xl, xr being Element of D() st xl = f1().tl & xr = f1().tr
holds f1().(nt-tree (tl, tr)) = NTermVal(nt, rtl, rtr, xl, xr) and
 (for t being Terminal of G() holds f2().(root-tree t) = TermVal(t))
& for nt being NonTerminal of G(), tl, tr being Element of TS(G()), rtl, rtr
being Symbol of G() st rtl = root-label tl & rtr = root-label tr & nt ==> <*
rtl, rtr *> for xl, xr being Element of D() st xl = f2().tl & xr = f2().tr
holds f2().(nt-tree (tl, tr)) = NTermVal(nt, rtl, rtr, xl, xr);

definition
  let A, B, C be non empty set, a be Element of A, b be Element of B, c be
  Element of C;
  redefine func [a, b, c] -> Element of [:A, B, C:];
end;

scheme 

  BinDTCDefLambda { G() -> binary with_terminals with_nonterminals
  with_useful_nonterminals non empty DTConstrStr, A, B() -> non empty set, F(
  set, set) -> Element of B(), H(set, set, set, set) -> Element of B() }: ex f
being Function of TS G(), Funcs(A(), B()) st (for t being Terminal of G() ex g
being Function of A(), B() st g = f.(root-tree t) & for a being Element of A()
holds g.a = F(t, a)) & for nt being NonTerminal of G(), t1, t2 being Element of
TS G(), rtl, rtr being Symbol of G() st rtl = root-label t1 & rtr = root-label
t2 & nt ==> <* rtl, rtr *> ex g, f1, f2 being Function of A(), B() st g = f.(nt
-tree (t1, t2)) & f1 = f.t1 & f2 = f.t2 & for a being Element of A() holds g.a
  = H(nt, f1, f2, a);

scheme 

  BinDTCDefLambdaUniq { G() -> binary with_terminals with_nonterminals
with_useful_nonterminals non empty DTConstrStr, A, B() -> non empty set, f1,
f2() -> Function of TS G(), Funcs (A(), B()), F(set, set) -> Element of B(), H(
  set, set, set, set) -> Element of B() }: f1() = f2()
provided
 (for t being Terminal of G() ex g being Function of A(), B() st g =
f1().(root-tree t) & for a being Element of A() holds g.a = F(t, a)) & for nt
being NonTerminal of G(), t1, t2 being Element of TS G(), rtl, rtr being Symbol
of G() st rtl = root-label t1 & rtr = root-label t2 & nt ==> <* rtl, rtr *> ex
g, f1, f2 being Function of A(), B() st g = f1().(nt-tree (t1, t2)) & f1 = f1()
.t1 & f2 = f1().t2 & for a being Element of A() holds g.a = H(nt, f1, f2, a)
and
 (for t being Terminal of G() ex g being Function of A(), B() st g =
f2().(root-tree t) & for a being Element of A() holds g.a = F(t, a)) & for nt
being NonTerminal of G(), t1, t2 being Element of TS G(), rtl, rtr being Symbol
of G() st rtl = root-label t1 & rtr = root-label t2 & nt ==> <* rtl, rtr *> ex
g, f1, f2 being Function of A(), B() st g = f2().(nt-tree (t1, t2)) & f1 = f2()
.t1 & f2 = f2().t2 & for a being Element of A() holds g.a = H(nt, f1, f2, a);

registration
  let G be binary with_terminals with_nonterminals non empty DTConstrStr;
  cluster -> binary for Element of TS G;
end;














begin 

reserve L for Lattice;
reserve X,Y,Z,V for Element of L;

definition
  let L,X,Y;
  func X \ Y -> Element of L equals

  X "/\" Y`;
end;

definition
  let L,X,Y;
  func X \+\ Y -> Element of L equals

  (X \ Y) "\/" (Y \ X);
end;

definition
  let L,X,Y;
  redefine pred X = Y means


  X [= Y & Y [= X;
end;

definition
  let L,X,Y;
  pred X meets Y means


  X "/\" Y <> Bottom L;
end;

notation
  let L,X,Y;
  antonym X misses Y for X meets Y;
end;

theorem 
  X "\/" Y [= Z implies X [= Z;

theorem 
  X "/\" Y [= X "\/" Z;

theorem 
  X [= Z implies X \ Y [= Z;

theorem 
  X \ Y [= Z & Y \ X [= Z implies X \+\ Y [= Z;

theorem 
  X = Y "\/" Z iff Y [= X & Z [= X & for V st Y [= V & Z [= V holds X [= V;

theorem 
  X = Y "/\" Z iff X [= Y & X [= Z & for V st V [= Y & V [= Z holds V [= X;

theorem 
  X meets X iff X <> Bottom L;

definition
  let L, X, Y;
  redefine pred X meets Y;
  symmetry;
  redefine func X \+\ Y;
  commutativity;
  redefine pred X misses Y;
  symmetry;
end;

begin

begin 

reserve L for D_Lattice;
reserve X,Y,Z for Element of L;

theorem 
  (X "/\" Y) "\/" (X "/\" Z) = X implies X [= Y "\/" Z;

begin 

reserve L for 0_Lattice;
reserve X,Y,Z for Element of L;

theorem 
  X [= Bottom L implies X = Bottom L;

theorem 
  X [= Y & X [= Z & Y "/\" Z = Bottom L implies X = Bottom L;

theorem 
  X "\/" Y = Bottom L iff X = Bottom L & Y = Bottom L;

theorem 
  X [= Y & Y "/\" Z = Bottom L implies X "/\" Z = Bottom L;

theorem 
  X meets Y & Y [= Z implies X meets Z;

theorem 
  X meets Y "/\" Z implies X meets Y & X meets Z;

theorem 
  X meets Y \ Z implies X meets Y;

theorem 
  X misses Bottom L;

theorem 
  X misses Z & Y [= Z implies X misses Y;

theorem 
  X misses Y or X misses Z implies X misses Y "/\" Z;

theorem 
  X [= Y & X [= Z & Y misses Z implies X = Bottom L;

theorem 
  X misses Y implies (Z "/\" X) misses (Z "/\" Y);

begin 

reserve L for B_Lattice;
reserve X,Y,Z,V for Element of L;

theorem 
  X \ Y [= Z implies X [= Y "\/" Z;

theorem 
  X [= Y implies Z \ Y [= Z \ X;

theorem 
  X [= Y & Z [= V implies X \ V [= Y \ Z;

theorem 
  X [= Y "\/" Z implies X \ Y [= Z;

theorem 
  X` [= (X "/\" Y)`;

theorem 
  (X "\/" Y)` [= X`;

theorem 
  X [= Y \ X implies X = Bottom L;

theorem 
  X [= Y implies Y = X "\/" (Y \ X);

theorem 
  X \ Y = Bottom L iff X [= Y;

theorem 
  X [= (Y "\/" Z) & X "/\" Z = Bottom L implies X [= Y;

theorem 
  X "\/" Y = (X \ Y) "\/" Y;

theorem 
  X \ (X "\/" Y) = Bottom L;

theorem 
  X \ X "/\" Y = X \ Y;

theorem 
  (X \ Y) "/\" Y = Bottom L;

theorem 
  X "\/" (Y \ X) = X "\/" Y;

theorem 
  (X "/\" Y) "\/" (X \ Y) = X;

theorem 
  X \ (Y \ Z) = (X \ Y) "\/" (X "/\" Z);

theorem 
  X \ (X \ Y) = X "/\" Y;

theorem 
  (X "\/" Y) \ Y = X \ Y;

theorem 
  X "/\" Y = Bottom L iff X \ Y = X;

theorem 
  X \ (Y "\/" Z) = (X \ Y) "/\" (X \ Z);

theorem 
  X \ (Y "/\" Z) = (X \ Y) "\/" (X \ Z);

theorem 
  X "/\" (Y \ Z) = X "/\" Y \ X "/\" Z;

theorem 
  (X "\/" Y) \ (X "/\" Y) = (X \ Y) "\/" (Y \ X);

theorem 
  (X \ Y) \ Z = X \ (Y "\/" Z);

theorem 
  X \ Y = Y \ X implies X = Y;

theorem 
  X \ Bottom L = X;

theorem 
  (X \ Y)` = X` "\/" Y;

theorem 
  X meets Y "\/" Z iff X meets Y or X meets Z;

theorem 
  X "/\" Y misses X \ Y;

theorem 
  X misses Y "\/" Z iff X misses Y & X misses Z;

theorem 
  (X \ Y) misses Y;

theorem 
  X misses Y implies (X "\/" Y) \ Y = X;

theorem 
  X` "\/" Y` = X "\/" Y & X misses X` & Y misses Y` implies X = Y` & Y = X`;

theorem 
  X` "\/" Y` = X "\/" Y & Y misses X` & X misses Y` implies X = X` & Y = Y`;

theorem 
  X \+\ Bottom L = X;

theorem 
  X \+\ X = Bottom L;

theorem 
  X "/\" Y misses X \+\ Y;

theorem 
  X "\/" Y = X \+\ (Y \ X);

theorem 
  X \+\ (X "/\" Y) = X \ Y;

theorem 
  X "\/" Y = (X \+\ Y) "\/" (X "/\" Y);

theorem 
  (X \+\ Y) \+\ (X "/\" Y) = X "\/" Y;

theorem 
  (X \+\ Y) \+\ (X "\/" Y) = X "/\" Y;

theorem 
  X \+\ Y = (X "\/" Y) \ (X "/\" Y);

theorem 
  (X \+\ Y) \ Z = (X \ (Y "\/" Z)) "\/" (Y \ (X "\/" Z));

theorem 
  X \ (Y \+\ Z) = (X \ (Y "\/" Z)) "\/" (X "/\" Y "/\" Z);

theorem 
  (X \+\ Y) \+\ Z = X \+\ (Y \+\ Z);

theorem 
  (X \+\ Y)` = (X "/\" Y) "\/" (X` "/\" Y`);














begin

reserve G for strict Group;
reserve H for Subgroup of G;
reserve a, b, c, x, y for Element of G;
reserve h for Homomorphism of G, G;
reserve q, q1 for set;

theorem 
  (for a, b st b is Element of H holds b |^ a in H) iff H is normal;

definition
  let G;
  func Aut G -> FUNCTION_DOMAIN of the carrier of G, the carrier of G means


   ( for f being Element of it holds f is Homomorphism of G, G ) & for h
  holds h in it iff h is one-to-one & h is onto;
end;

theorem 
  Aut G c= Funcs (the carrier of G, the carrier of G);

theorem 
  id the carrier of G is Element of Aut G;

theorem 
  for h holds h in Aut G iff h is bijective;

theorem 
  for f being Element of Aut G holds f" is Homomorphism of G, G;

theorem 
  for f being Element of Aut G holds f" is Element of Aut G;

theorem 
  for f1, f2 being Element of Aut G holds f1 * f2 is Element of Aut G;

definition
  let G;
  func AutComp G -> BinOp of Aut G means


  for x, y being Element of Aut G holds it.(x,y) = x * y;
end;

definition
  let G;
  func AutGroup G -> strict Group equals

  multMagma (# Aut G, AutComp G #);
end;

theorem 
  for x, y being Element of AutGroup G for f, g being Element of Aut G
  st x = f & y = g holds x * y = f * g;

theorem 
  id the carrier of G = 1_AutGroup G;

theorem 
  for f being Element of Aut G for g being Element of AutGroup G
  st f = g holds f" = g";

definition
  let G;
  func InnAut G -> FUNCTION_DOMAIN of the carrier of G,the carrier of G means


  for f being Element of Funcs (the carrier of G, the carrier of G) holds
  f in it iff ex a st for x holds f.x = x |^ a;
end;

theorem 
  InnAut G c= Funcs (the carrier of G, the carrier of G);

theorem 
  for f being Element of InnAut G holds f is Element of Aut G;

theorem 
  InnAut G c= Aut G;

theorem 
  for f, g being Element of InnAut G holds (AutComp G).(f, g) = f * g;

theorem 
  id the carrier of G is Element of InnAut G;

theorem 
  for f being Element of InnAut G holds f" is Element of InnAut G;

theorem 
  for f, g being Element of InnAut G holds f * g is Element of InnAut G;

definition
  let G;
  func InnAutGroup G -> normal strict Subgroup of AutGroup G means


  the carrier of it = InnAut G;
end;

theorem 
  for x, y being Element of InnAutGroup G for f, g being Element
  of InnAut G st x = f & y = g holds x * y = f * g;

theorem 
  id the carrier of G = 1_InnAutGroup G;

theorem 
  for f being Element of InnAut G for g being Element of InnAutGroup G
  st f = g holds f" = g";

definition
  let G, b;
  func Conjugate b -> Element of InnAut G means


  for a holds it.a = a |^ b;
end;

theorem 
  for a, b holds Conjugate (a * b) = (Conjugate b) * (Conjugate a);

theorem 
  Conjugate 1_G = id the carrier of G;

theorem 
  for a holds (Conjugate 1_G).a = a;

theorem 
  for a holds (Conjugate a) * (Conjugate a") = Conjugate 1_G;

theorem 
  for a holds (Conjugate a") * (Conjugate a) = Conjugate 1_G;

theorem 
  for a holds Conjugate a" = (Conjugate a)";

theorem 
  for a holds (Conjugate a) * (Conjugate 1_G) = Conjugate a & (Conjugate
  1_G) * (Conjugate a) = Conjugate a;

theorem 
  for f being Element of InnAut G holds f * Conjugate 1_G = f & (
  Conjugate 1_G) * f = f;

theorem 
  for G holds InnAutGroup G, G./.center G are_isomorphic;

theorem 
  for G holds ( G is commutative Group implies for f being Element of
  InnAutGroup G holds f = 1_InnAutGroup G );















begin



definition
  let X be non empty TopSpace;
  let A be Subset of X;
  redefine attr A is T_0 means


  for a, b being Point of X st a in A & b
  in A holds a <> b implies MaxADSet(a) misses MaxADSet(b);
end;

definition
  let X be non empty TopSpace;
  let A be Subset of X;
  redefine attr A is T_0 means


  for a being Point of X st a in A holds A /\ MaxADSet(a) = {a};
end;

definition
  let X be non empty TopSpace;
  let A be Subset of X;
  redefine attr A is T_0 means

  for a being Point of X st a in A ex D being
  Subset of X st D is maximal_anti-discrete & A /\ D = {a};
end;

definition
  let Y be TopStruct;
  let IT be Subset of Y;
  attr IT is maximal_T_0 means


  IT is T_0 & for D being Subset of Y st D is T_0 & IT c= D holds IT = D;
end;

theorem 
  for Y0, Y1 being TopStruct, D0 being Subset of Y0, D1 being Subset of
  Y1 st the TopStruct of Y0 = the TopStruct of Y1 & D0 = D1 holds D0 is
  maximal_T_0 implies D1 is maximal_T_0;

definition
  let X be non empty TopSpace;
  let M be Subset of X;
  redefine attr M is maximal_T_0 means


  M is T_0 & MaxADSet(M) = the carrier of X;
end;

reserve X for non empty TopSpace;

theorem 
  for M being Subset of X holds M is maximal_T_0 implies M is dense;

theorem 
  for A being Subset of X st A is open or A is closed holds A is
  maximal_T_0 implies A is not proper;

theorem 
  for A being empty Subset of X holds A is not maximal_T_0;

theorem 
  for M being Subset of X st M is maximal_T_0 for A being Subset of
  X st A is closed holds A = MaxADSet(M /\ A);

theorem 
  for M being Subset of X st M is maximal_T_0 for A being Subset of
  X st A is open holds A = MaxADSet(M /\ A);

theorem 
  for M being Subset of X st M is maximal_T_0 for A being Subset of X
  holds Cl A = MaxADSet(M /\ Cl A);

theorem 
  for M being Subset of X st M is maximal_T_0 for A being Subset of X
  holds Int A = MaxADSet(M /\ Int A);

definition
  let X be non empty TopSpace;
  let M be Subset of X;
  redefine attr M is maximal_T_0 means


  for x being Point of X ex a
  being Point of X st a in M & M /\ MaxADSet(x) = {a};
end;

theorem 
  for A being Subset of X holds A is T_0 implies ex M being Subset
  of X st A c= M & M is maximal_T_0;

theorem 
  ex M being Subset of X st M is maximal_T_0;

begin



definition
  let Y be non empty TopStruct;
  let IT be SubSpace of Y;
  attr IT is maximal_T_0 means


  for A being Subset of Y st A = the carrier of IT holds A is maximal_T_0;
end;

theorem 
  for Y being non empty TopStruct, Y0 being SubSpace of Y, A being
  Subset of Y st A = the carrier of Y0 holds A is maximal_T_0 iff Y0 is
  maximal_T_0;

registration
  let Y be non empty TopStruct;
  cluster maximal_T_0 -> T_0 for non empty SubSpace of Y;
  cluster non T_0 -> non maximal_T_0 for non empty SubSpace of Y;
end;

definition
  let X be non empty TopSpace;
  let X0 be non empty SubSpace of X;
  redefine attr X0 is maximal_T_0 means

  X0 is T_0 & for Y0 being T_0 non empty
SubSpace of X st X0 is SubSpace of Y0 holds the TopStruct of X0 = the TopStruct
  of Y0;
end;

reserve X for non empty TopSpace;

theorem 
  for A0 being non empty Subset of X st A0 is maximal_T_0 ex X0
being strict non empty SubSpace of X st X0 is maximal_T_0 & A0 = the carrier of
  X0;

registration
  let X be non empty TopSpace;
  cluster maximal_T_0 -> dense for SubSpace of X;
  cluster non dense -> non maximal_T_0 for SubSpace of X;
  cluster open maximal_T_0 -> non proper for SubSpace of X;
  cluster open proper -> non maximal_T_0 for SubSpace of X;
  cluster proper maximal_T_0 -> non open for SubSpace of X;
  cluster closed maximal_T_0 -> non proper for SubSpace of X;
  cluster closed proper -> non maximal_T_0 for SubSpace of X;
  cluster proper maximal_T_0 -> non closed for SubSpace of X;
end;

theorem 
  for Y0 being T_0 non empty SubSpace of X ex X0 being strict SubSpace
  of X st Y0 is SubSpace of X0 & X0 is maximal_T_0;

registration
  let X be non empty TopSpace;
  cluster maximal_T_0 strict non empty for SubSpace of X;
end;

definition
  let X be non empty TopSpace;
  mode maximal_Kolmogorov_subspace of X is maximal_T_0 SubSpace of X;
end;

theorem 
  for X0 being maximal_Kolmogorov_subspace of X for G being Subset
of X, G0 being Subset of X0 st G0 = G holds G0 is open iff MaxADSet(G) is open
  & G0 = MaxADSet(G) /\ the carrier of X0;

theorem 
  for X0 being maximal_Kolmogorov_subspace of X for G being Subset of X
holds G is open iff G = MaxADSet(G) & ex G0 being Subset of X0 st G0 is open &
  G0 = G /\ the carrier of X0;

theorem 
  for X0 being maximal_Kolmogorov_subspace of X for F being Subset
  of X, F0 being Subset of X0 st F0 = F holds F0 is closed iff MaxADSet(F) is
  closed & F0 = MaxADSet(F) /\ the carrier of X0;

theorem 
  for X0 being maximal_Kolmogorov_subspace of X for F being Subset of X
  holds F is closed iff F = MaxADSet(F) & ex F0 being Subset of X0 st F0 is
  closed & F0 = F /\ the carrier of X0;

begin



reserve X for non empty TopSpace,
  X0 for non empty maximal_Kolmogorov_subspace of X;

theorem 
  for r being Function of X,X0 for M being Subset of X st M = the
  carrier of X0 holds (for a being Point of X holds M /\ MaxADSet(a) = {r.a})
  implies r is continuous Function of X,X0;

theorem 
  for r being Function of X,X0 holds (for a being Point of X holds r.a
  in MaxADSet(a)) implies r is continuous Function of X,X0;

theorem 
  for r being continuous Function of X,X0 for M being Subset of X
st M = the carrier of X0 holds (for a being Point of X holds M /\ MaxADSet(a) =
  {r.a}) implies r is being_a_retraction;

theorem 
  for r being continuous Function of X,X0 holds (for a being Point
  of X holds r.a in MaxADSet(a)) implies r is being_a_retraction;

theorem 
  ex r being continuous Function of X,X0 st r is being_a_retraction;

theorem 
  X0 is_a_retract_of X;

definition
  let X be non empty TopSpace, X0 be non empty maximal_Kolmogorov_subspace of
  X;
  func Stone-retraction(X,X0) -> continuous Function of X,X0 means


  it is being_a_retraction;
end;

theorem 
  for a being Point of X, b being Point of X0 st a = b holds (
  Stone-retraction(X,X0))" Cl {b} = Cl {a};

theorem 
  for a being Point of X, b being Point of X0 st a = b holds (
  Stone-retraction(X,X0))" {b} = MaxADSet(a);

theorem 
  for E being Subset of X, F being Subset of X0 st F = E holds (
  Stone-retraction(X,X0))" (F) = MaxADSet(E);

definition
  let X be non empty TopSpace, X0 be non empty maximal_Kolmogorov_subspace of
  X;
  redefine func Stone-retraction(X,X0) means


   for
 M being Subset of X st M = the carrier of X0 for a being Point of X
  holds M /\ MaxADSet(a) = {it.a};
end;

definition
  let X be non empty TopSpace, X0 be non empty maximal_Kolmogorov_subspace of
  X;
  redefine func Stone-retraction(X,X0) means


   for a being Point of X holds it.a in MaxADSet(a);
end;

theorem 
  for a being Point of X holds (Stone-retraction(X,X0))" {(
  Stone-retraction(X,X0)).a} = MaxADSet(a);

theorem 
  for a being Point of X holds Im(Stone-retraction(X,X0),a) = (
  Stone-retraction(X,X0)).: MaxADSet(a);

definition
  let X be non empty TopSpace, X0 be non empty maximal_Kolmogorov_subspace of
  X;
  redefine func Stone-retraction(X,X0) means


   for
 M being Subset of X st M = the carrier of X0 for A being Subset of X
  holds M /\ MaxADSet(A) = it.: A;
end;

theorem 
  for A being Subset of X holds (Stone-retraction(X,X0))"((
  Stone-retraction(X,X0)).: A) = MaxADSet(A);

theorem 
  for A being Subset of X holds (Stone-retraction(X,X0)).: A = (
  Stone-retraction(X,X0)).: MaxADSet(A);

theorem 
  for A, B being Subset of X holds (Stone-retraction(X,X0)).:(A \/ B) =
  (Stone-retraction(X,X0)).:(A) \/ (Stone-retraction(X,X0)).:(B);

theorem 
  for A, B being Subset of X st A is open or B is open holds (
  Stone-retraction(X,X0)).:(A /\ B) = (Stone-retraction(X,X0)).:(A) /\ (
  Stone-retraction(X,X0)).:(B);

theorem 
  for A, B being Subset of X st A is closed or B is closed holds (
  Stone-retraction(X,X0)).:(A /\ B) = (Stone-retraction(X,X0)).:(A) /\ (
  Stone-retraction(X,X0)).:(B);

theorem 
  for A being Subset of X holds A is open implies (Stone-retraction(X,X0
  )).:(A) is open;

theorem 
  for A being Subset of X holds A is closed implies (Stone-retraction(X,
  X0)).:(A) is closed;














begin 

reserve G for IncProjStr;
reserve a,a1,a2,b,b1,b2,c,d,p,q,r for POINT of G;
reserve A,B,C,D,M,N,P,Q,R for LINE of G;

notation
  let G,a,P;
  antonym a|'P for a on P;
end;

definition
  let G,a,b,P;
  pred a,b|'P means


  a|'P & b|'P;
end;

definition
  let G,a,P,Q;
  pred a on P,Q means


  a on P & a on Q;
end;

definition
  let G,a,P,Q,R;
  pred a on P,Q,R means


  a on P & a on Q & a on R;
end;

theorem 
  ({a,b} on P implies {b,a} on P) & ({a,b,c} on P implies {a,c,b}
  on P & {b,a,c} on P & {b,c,a} on P & {c,a,b} on P & {c,b,a} on P) & (a on P,Q
implies a on Q,P) & (a on P,Q,R implies a on P,R,Q & a on Q,P,R & a on Q,R,P &
  a on R,P,Q & a on R,Q,P);

definition
  let IT be IncProjStr;
  attr IT is configuration means


  for p,q being POINT of IT, P,Q being
  LINE of IT st p on P & q on P & p on Q & q on Q holds p = q or P = Q;
end;

theorem 
  G is configuration iff for p,q,P,Q st {p,q} on P & {p,q} on Q
  holds p = q or P = Q;

theorem 
  G is configuration iff for p,q,P,Q st p on P,Q & q on P,Q holds p
  = q or P = Q;

theorem 
  G is IncProjSp iff G is configuration & (for p,q ex P st {p,q} on
P) & (ex p,P st p|'P) & (for P ex a,b,c st a,b,c are_mutually_different & {a,b,
c} on P) & for a,b,c,d,p,M,N,P,Q st {a,b,p} on M & {c,d,p} on N & {a,c} on P &
  {b,d} on Q & p|'P & p|'Q & M<>N holds ex q st q on P,Q;

definition
  mode IncProjectivePlane is 2-dimensional IncProjSp;
end;

definition
  let G,a,b,c;
  pred a,b,c is_collinear means


  ex P st {a,b,c} on P;
end;

notation
  let G,a,b,c;
  antonym a,b,c is_a_triangle for a,b,c is_collinear;
end;

theorem 
  a,b,c is_collinear iff ex P st a on P & b on P & c on P;

theorem 
  a,b,c is_a_triangle iff for P holds a|'P or b|'P or c|'P;

definition
  let G,a,b,c,d;
  pred a,b,c,d is_a_quadrangle means


  a,b,c is_a_triangle & b,c,d
  is_a_triangle & c,d,a is_a_triangle & d,a,b is_a_triangle;
end;

theorem 
  G is IncProjSp implies ex A,B st A<>B;

theorem 
  G is IncProjSp implies ex b,c st {b,c} on A & a,b,c are_mutually_different;

theorem 
  G is IncProjSp & A<>B implies ex b st b on A & b|'B & a<>b;

theorem 
  G is configuration & {a1,a2} on A & a1<>a2 & b|'A implies a1,a2,
  b is_a_triangle;

theorem 
  a,b,c is_collinear implies a,c,b is_collinear & b,a,c
  is_collinear & b,c,a is_collinear & c,a,b is_collinear & c,b,a is_collinear;

theorem 
  a,b,c is_a_triangle implies a,c,b is_a_triangle & b,a,c is_a_triangle
  & b,c,a is_a_triangle & c,a,b is_a_triangle & c,b,a is_a_triangle;

theorem 
  a,b,c,d is_a_quadrangle implies a,c,b,d is_a_quadrangle & b,a,c,
d is_a_quadrangle & b,c,a,d is_a_quadrangle & c,a,b,d is_a_quadrangle & c,b,a,d
  is_a_quadrangle & a,b,d,c is_a_quadrangle & a,c,d,b is_a_quadrangle & b,a,d,c
  is_a_quadrangle & b,c,d,a is_a_quadrangle & c,a,d,b is_a_quadrangle & c,b,d,a
  is_a_quadrangle & a,d,b,c is_a_quadrangle & a,d,c,b is_a_quadrangle & b,d,a,c
  is_a_quadrangle & b,d,c,a is_a_quadrangle & c,d,a,b is_a_quadrangle & c,d,b,a
  is_a_quadrangle & d,a,b,c is_a_quadrangle & d,a,c,b is_a_quadrangle & d,b,a,c
  is_a_quadrangle & d,b,c,a is_a_quadrangle & d,c,a,b is_a_quadrangle & d,c,b,a
  is_a_quadrangle;

theorem 
  G is configuration & {a1,a2} on A & {b1,b2} on B & a1,a2|'B & b1
  ,b2|'A & a1<>a2 & b1<>b2 implies a1,a2,b1,b2 is_a_quadrangle;

theorem 
  G is IncProjSp implies ex a,b,c,d st a,b,c,d is_a_quadrangle;

definition
  let G be IncProjSp;
  mode Quadrangle of G -> Element of [:the Points of G,the Points of G,the
    Points of G,the Points of G:] means

    it`1_4,it`2_4,it`3_4,it`4_4 is_a_quadrangle;
end;

definition
  let G be IncProjSp, a,b be POINT of G;
  assume
 a <> b;
  func a*b -> LINE of G means


  {a,b} on it;
end;

theorem 
  for G be IncProjSp, a,b be POINT of G, L be LINE of G st a <> b
  holds a on a*b & b on a*b & a*b = b*a & (a on L & b on L implies L = a*b);

begin 

theorem 
  (ex a,b,c st a,b,c is_a_triangle) & (for p,q ex M st {p,q} on M)
  implies ex p,P st p|'P;

theorem 
  (ex a,b,c,d st a,b,c,d is_a_quadrangle) implies ex a,b,c st a,b,
  c is_a_triangle;

theorem 
  a,b,c is_a_triangle & {a,b} on P & {a,c} on Q implies P<>Q;

theorem 
  a,b,c,d is_a_quadrangle & {a,b} on P & {a,c} on Q & {a,d} on R
  implies P,Q,R are_mutually_different;

theorem 
  G is configuration & a on P,Q,R & P,Q,R are_mutually_different &
  a|'A & p on A,P & q on A,Q & r on A,R implies p,q,r are_mutually_different;

theorem 
  G is configuration & (for p,q ex M st {p,q} on M) & (for P,Q ex
a st a on P,Q) & (ex a,b,c,d st a,b,c,d is_a_quadrangle) implies for P ex a,b,c
  st a,b,c are_mutually_different & {a,b,c} on P;

theorem 
  G is IncProjectivePlane iff G is configuration & (for p,q ex M
  st {p,q} on M) & (for P,Q ex a st a on P,Q) & ex a,b,c,d st a,b,c,d
  is_a_quadrangle;

reserve G for IncProjectivePlane;
reserve a,q for POINT of G;
reserve A,B for LINE of G;

definition
  let G,A,B;
  assume
 A <> B;
  func A*B -> POINT of G means


  it on A,B;
end;

theorem 
  A <> B implies A*B on A & A*B on B & A*B = B*A & (a on A & a on
  B implies a=A*B);

theorem 
  A<>B & a on A & q|'A & a<>A*B implies (q*a)*B on B & (q*a)*B|'A;

begin 

reserve G for IncProjSp;
reserve a,b,c,d for POINT of G;
reserve P for LINE of G;

theorem 
  a,b,c is_a_triangle implies a,b,c are_mutually_different;

theorem 
  a,b,c,d is_a_quadrangle implies a,b,c,d are_mutually_different;

reserve G for IncProjectivePlane;

theorem 
  for a,b,c,d being POINT of G st a*c = b*d holds a = c or b = d
  or c = d or a*c = c*d;

theorem 
  for a,b,c,d being POINT of G st a*c = b*d holds a = c or b = d or c =
  d or a on c*d;

theorem 
  for G being IncProjectivePlane, e,m,m9 being POINT of G, I being LINE
  of G st m on I & m9 on I & m<>m9 & e|'I holds m*e<>m9*e & e*m<>e*m9;

theorem 
  for G being IncProjectivePlane, e being POINT of G, I,L1,L2 being LINE
  of G st e on L1 & e on L2 & L1<>L2 & e|'I holds I*L1<>I*L2 & L1*I<>L2*I;

theorem 
  for G being IncProjSp, a,b,q,q1 being POINT of G st q on a*b & q on a*
  q1 & q<>a & q1<>a & a<>b holds q1 on a*b;

theorem 
  for G being IncProjSp, a,b,c being POINT of G st c on a*b & a<>c holds
  b on a*c;

theorem 
  for G being IncProjectivePlane, q1,q2,r1,r2 being POINT of G, H being
  LINE of G st r1<>r2 & r1 on H & r2 on H & q1|'H & q2|'H holds q1*r1<>q2*r2;

theorem 
  for a,b,c being POINT of G st a on b*c holds a=c or b=c or b on c*a;

theorem 
  for a,b,c being POINT of G st a on b*c holds b=a or b=c or c on b*a;

theorem 
  for e,x1,x2,p1,p2 being POINT of G for H,I being LINE of G st x1 on I
& x2 on I & e |'I & x1<>x2 & p1<>e & p2 <>e & p1 on e*x1 & p2 on e*x2 holds ex
  r being POINT of G st r on p1*p2 & r on H & r<>e;














begin









definition
  let m,n be Nat;
  func nat_interval(m,n) -> Subset of NAT equals

  {i where i is Element of NAT
  : m<=i & i<=n};
end;

notation
  let m,n be Nat;
  synonym Seg (m,n) for nat_interval (m,n);
end;

registration
  let m,n be Nat;
  cluster nat_interval(m,n) -> finite;
end;

theorem 
  for m,n being Element of NAT, e being set holds e in nat_interval(m,n)
  iff ex i being Element of NAT st e=i & m<=i & i<=n;

theorem 
  for m,n,k being Element of NAT holds k in nat_interval(m,n) iff m<=k & k<=n;

theorem 
  for n being Element of NAT holds nat_interval (1,n) = Seg n;

theorem 
  for m,n being Element of NAT st 1 <= m holds nat_interval(m,n) c= Seg n;

theorem 
  for k,m,n being Element of NAT st k<m holds Seg k misses nat_interval(m,n);

theorem 
  for m,n being Element of NAT st n<m holds nat_interval(m,n)={};

definition
  let A be set;

  func TWOELEMENTSETS(A) -> set equals

  {z where z is finite Subset of A : card
  z = 2};
end;

theorem 
  for A be set, e be set holds (e in TWOELEMENTSETS(A) iff ex z
  being finite Subset of A st e = z & (card z)=2 );

theorem 
  for A be set, e be set holds (e in TWOELEMENTSETS(A) iff (e is
finite Subset of A & ex x,y being set st x in A & y in A & x<>y & e = {x,y} ));

theorem 
  for A being set holds TWOELEMENTSETS(A) c= (bool A);

theorem 
  for A being set, e1,e2 being set st {e1,e2} in TWOELEMENTSETS(A)
  holds e1 in A & e2 in A & e1<>e2;

theorem 
  TWOELEMENTSETS {} = {};

theorem 
  for t,u being set st t c= u holds TWOELEMENTSETS(t) c= TWOELEMENTSETS( u);

theorem 
  for A being finite set holds TWOELEMENTSETS(A) is finite;

theorem 
  for A being non trivial set holds TWOELEMENTSETS(A) is non empty;

theorem 
  for a being set holds TWOELEMENTSETS {a} = {};

reserve X for set;

begin 











definition
  struct (1-sorted) SimpleGraphStruct (# carrier -> set, SEdges -> Subset of
    TWOELEMENTSETS(the carrier) #);
end;











definition
  let X be set;

  func SIMPLEGRAPHS(X) -> set equals

  {SimpleGraphStruct (# v,e #) where v is
finite Subset of X, e is finite Subset of TWOELEMENTSETS(v) : not contradiction
  };
end;

theorem 
  SimpleGraphStruct (#{},{}TWOELEMENTSETS{}#) in SIMPLEGRAPHS(X);

registration
  let X be set;
  cluster SIMPLEGRAPHS(X) -> non empty;
end;

definition
  let X be set;
  mode SimpleGraph of X -> strict SimpleGraphStruct means


    it is Element of SIMPLEGRAPHS(X);
end;

theorem 
  for g being set holds (g in SIMPLEGRAPHS(X) iff ex v being
  finite Subset of X, e being finite Subset of TWOELEMENTSETS(v) st g =
  SimpleGraphStruct (#v,e#));

begin 

theorem 
  for g being SimpleGraph of X holds (the carrier of g) c= X & (
  the SEdges of g) c= TWOELEMENTSETS (the carrier of g);

theorem 
  for g being SimpleGraph of X, e being set st e in the SEdges of g
  holds ex v1,v2 being set st v1 in the carrier of g & v2 in the carrier of g &
  v1 <> v2 & e={v1,v2};

theorem 
  for g being SimpleGraph of X, v1,v2 being set st {v1,v2} in the SEdges
of g holds v1 in (the carrier of g) & v2 in the carrier of g & v1 <> v2
;

theorem 
  for g being SimpleGraph of X holds (the carrier of g) is finite
Subset of X & (the SEdges of g) is finite Subset of TWOELEMENTSETS(the carrier
  of g);







definition
  let X;
  let G,G9 be SimpleGraph of X;
  pred G is_isomorphic_to G9 means

  ex Fv being Function of the carrier of G,
the carrier of G9 st Fv is bijective & for v1,v2 being Element of G holds ({v1,
  v2} in (the SEdges of G) iff {Fv.v1, Fv.v2} in the SEdges of G);
end;

begin 


scheme 

  IndSimpleGraphs0 { X()-> set, P[set] } : for G being set st G in
  SIMPLEGRAPHS(X()) holds P[G]
provided
 P[SimpleGraphStruct (#{},{}TWOELEMENTSETS{}#)] and
 for g being SimpleGraph of X(), v being set st g in SIMPLEGRAPHS(X()
) & P[g] & v in X() & not v in (the carrier of g) holds P[SimpleGraphStruct (#(
  the carrier of g)\/{v}, {}TWOELEMENTSETS((the carrier of g)\/{v})#)] and
 for g being SimpleGraph of X(), e being set st P[g] & e in
TWOELEMENTSETS(the carrier of g) & not e in (the SEdges of g) holds ex sege
being Subset of TWOELEMENTSETS(the carrier of g) st sege=((the SEdges of g)\/{e
}) & P[SimpleGraphStruct (#(the carrier of g),sege#)];




theorem 
  for g being SimpleGraph of X holds (g=SimpleGraphStruct (#{},{}
TWOELEMENTSETS{}#) or ex v being set, e being Subset of TWOELEMENTSETS(v) st v
  is non empty & g=SimpleGraphStruct (#v,e#) );

theorem 
  for V being Subset of X, E being Subset of TWOELEMENTSETS(V), n
  being set, Evn being finite Subset of TWOELEMENTSETS(V \/ {n}) st
  SimpleGraphStruct (#V,E#) in SIMPLEGRAPHS(X) & n in X holds SimpleGraphStruct
  (#(V \/ {n}),Evn#) in SIMPLEGRAPHS(X);

theorem 
  for V being Subset of X, E being Subset of TWOELEMENTSETS(V), v1
  ,v2 being set st v1 in V & v2 in V & v1<>v2 & SimpleGraphStruct (#V,E#) in
SIMPLEGRAPHS(X) holds ex v1v2 being finite Subset of TWOELEMENTSETS(V) st v1v2
  = (E \/ {{v1,v2}}) & SimpleGraphStruct (#V,v1v2#) in SIMPLEGRAPHS(X);






definition
  let X be set, GG be set;
  pred GG is_SetOfSimpleGraphs_of X means


  SimpleGraphStruct (#{},{}
    TWOELEMENTSETS{}#) in GG & (for V being Subset of X, E being Subset of
TWOELEMENTSETS(V), n being set, Evn being finite Subset of TWOELEMENTSETS(V \/
  {n}) st (SimpleGraphStruct (#V,E#) in GG & n in X & not n in V) holds
SimpleGraphStruct (#(V \/ {n}),Evn#) in GG) & for V being Subset of X, E being
Subset of TWOELEMENTSETS(V), v1,v2 being set st SimpleGraphStruct (#V,E#) in GG
  & v1 in V & v2 in V & v1<>v2 & (not {v1,v2} in E) holds ex v1v2 being finite
Subset of TWOELEMENTSETS(V) st v1v2 = (E \/ {{v1,v2}}) & SimpleGraphStruct (#V,
    v1v2#) in GG;
end;

theorem 
  SIMPLEGRAPHS(X) is_SetOfSimpleGraphs_of X;

theorem 
  for OTHER being set st OTHER is_SetOfSimpleGraphs_of X holds
  SIMPLEGRAPHS(X) c= OTHER;

theorem 
  SIMPLEGRAPHS(X) is_SetOfSimpleGraphs_of X & for OTHER being set st
  OTHER is_SetOfSimpleGraphs_of X holds SIMPLEGRAPHS(X) c= OTHER;

begin 







definition
  let X be set, G be SimpleGraph of X;
  mode SubGraph of G -> SimpleGraph of X means

    the carrier of it c= the
    carrier of G & the SEdges of it c= the SEdges of G;
end;

begin 











definition
  let X be set, G be SimpleGraph of X;
  let v be set;
  func degree (G,v) -> Element of NAT means


  ex X being finite set st (
for z being set holds (z in X iff z in (the SEdges of G) & v in z)) & it = card
  X;
end;

theorem 
  for X being non empty set, G being SimpleGraph of X, v being set
  holds ex ww being finite set st ww = {w where w is Element of X : w in the
  carrier of G & {v,w} in the SEdges of G} & degree(G,v) = card ww;

theorem 
  for X being non empty set,g being SimpleGraph of X, v being set st v
  in the carrier of g holds ex VV being finite set st VV=(the carrier of g) &
  degree(g,v)<(card VV);

theorem 
  for g being SimpleGraph of X, v,e being set st e in the SEdges of g &
  degree (g,v)=0 holds not v in e;

theorem 
  for g being SimpleGraph of X, v being set, vg being finite set st vg=(
the carrier of g) & v in vg & 1+degree(g,v)=(card vg) holds for w being Element
  of vg st v<>w holds ex e being set st e in (the SEdges of g) & e={v,w};

begin 




definition
  let X be set, g be SimpleGraph of X, v1,v2 be Element of g, p be FinSequence
  of the carrier of g;
  pred p is_path_of v1,v2 means


  (p.1)=v1 & (p.(len p))=v2 & (for i
being Element of NAT st (1<=i & i<(len p)) holds {p.i, p.(i+1)} in (the SEdges
  of g)) & for i,j being Element of NAT st 1<=i & i<(len p) & i<j & j<(len p)
  holds p.i <> p.j & {p.i,p.(i+1)}<>{p.j,p.(j+1)};
end;

definition
  let X be set, g be SimpleGraph of X, v1,v2 be Element of (the carrier of g);
  func PATHS(v1,v2) -> Subset of ((the carrier of g)*) equals

  {ss where ss is
  Element of (the carrier of g)* : ss is_path_of v1,v2};
end;

theorem 
  for g being SimpleGraph of X, v1,v2 being Element of (the carrier of g
), e being set holds (e in PATHS(v1,v2) iff ex ss being Element of (the carrier
  of g)* st e=ss & ss is_path_of v1,v2 );

theorem 
  for g being SimpleGraph of X, v1,v2 being Element of (the carrier of g
  ), e being Element of (the carrier of g)* st e is_path_of v1,v2 holds e in
  PATHS(v1,v2);









definition
  let X be set, g be SimpleGraph of X, p be set;
  pred p is_cycle_of g means


  ex v being Element of (the carrier of g) st p in PATHS(v,v);
end;



begin 







definition
  let n,m be Element of NAT;

  func K_(m,n) -> SimpleGraph of NAT means

  ex ee being Subset of
  TWOELEMENTSETS(Seg (m+n)) st ee = {{i,j} where i,j is Element of NAT : i in (
Seg m) & j in (nat_interval(m+1,m+n))} & it = SimpleGraphStruct (# (Seg (m+n)),
    ee#);
end;

definition
  let n be Element of NAT;
  func K_(n) -> SimpleGraph of NAT means


  ex ee being finite Subset of
TWOELEMENTSETS(Seg n) st ee = {{i,j} where i,j is Element of NAT : i in (Seg n)
  & j in (Seg n) & i<>j} & it = SimpleGraphStruct (# (Seg n), ee #);
end;



definition
  func TriangleGraph -> SimpleGraph of NAT equals

  K_(3);
end;

theorem 
  ex ee being Subset of TWOELEMENTSETS(Seg 3) st ee = {.{.1,2.},{.
  2,3.},{.3,1.}.} & TriangleGraph = SimpleGraphStruct (#(Seg 3),ee#);

theorem 
  (the carrier of TriangleGraph)=(Seg 3) & (the SEdges of TriangleGraph)
  = {.{.1,2.},{.2,3.},{.3,1.}.};

theorem 
  {1,2} in (the SEdges of TriangleGraph) & {2,3} in (the SEdges of
TriangleGraph) & {3,1} in (the SEdges of TriangleGraph);

theorem 
  <*1*>^<*2*>^<*3*>^<*1*> is_cycle_of TriangleGraph;














begin

reserve i for Element of NAT;

definition
  let IT be Group;
  attr IT is solvable means


  ex F being FinSequence of Subgroups IT st
len F>0 & F.1=(Omega).IT & F.(len F)=(1).IT & for i st i in dom F & i+1 in dom
  F for G1,G2 being strict Subgroup of IT st G1=F.i & G2=F.(i+1) holds G2 is
strict normal Subgroup of G1 & for N being normal Subgroup of G1 st N=G2 holds
  G1./.N is commutative;
end;

registration
  cluster solvable strict for Group;
end;

theorem 
  for G being strict Group, H,F1,F2 being strict Subgroup of G st
  F1 is normal Subgroup of F2 holds F1 /\ H is normal Subgroup of F2 /\ H;

theorem 
  for G being strict Group for F2 being strict Subgroup of G for F1
being strict normal Subgroup of F2 for a,b being Element of F2 holds (a*F1) *(b
  *F1)=a *b *F1;

theorem 
  for G being strict Group for H,F2 being strict Subgroup of G for F1
  being strict normal Subgroup of F2 holds for G2 being strict Subgroup of G st
G2=H/\F2 for G1 being normal Subgroup of G2 st G1=H /\ F1 ex G3 being Subgroup
  of F2./.F1 st G2./.G1, G3 are_isomorphic;

theorem 
  for G being strict Group for H,F2 being strict Subgroup of G for
  F1 being strict normal Subgroup of F2 holds for G2 being strict Subgroup of G
st G2=F2/\H for G1 being normal Subgroup of G2 st G1=F1/\H ex G3 being Subgroup
  of F2./.F1 st G2./.G1, G3 are_isomorphic;

theorem 
  for G being solvable strict Group for H being strict Subgroup of G
  holds H is solvable;

theorem 
  for G being strict Group st ex F being FinSequence of Subgroups G st
len F>0 & F.1=(Omega).G & F.(len F)=(1).G & for i st i in dom F & i+1 in dom F
for G1,G2 being strict Subgroup of G st G1=F.i & G2=F.(i+1) holds G2 is strict
normal Subgroup of G1 & for N being normal Subgroup of G1 st N=G2 holds G1./.N
  is cyclic Group holds G is solvable;

theorem 
  for G being strict commutative Group holds G is solvable;

definition
  let G,H be Group;
  let g be Homomorphism of G,H;
  let A be Subgroup of G;
  func g|A -> Homomorphism of A,H equals

  g|(the carrier of A);
end;

definition
  let G,H be strict Group;
  let g be Homomorphism of G,H;
  let A be Subgroup of G;
  func g.:A -> strict Subgroup of H equals

  Image (g| A);
end;

theorem 
  for G,H being strict Group, g being Homomorphism of G,H for A
  being strict Subgroup of G holds the carrier of (g.: A)=g.:(the carrier of A)
;

theorem 
  for G,H being strict Group, h being Homomorphism of G,H holds
for A being strict Subgroup of G holds Image(h|A) is strict Subgroup of Image h
;

theorem 
  for G,H being strict Group, h being Homomorphism of G,H holds for A
  being strict Subgroup of G holds h.:A is strict Subgroup of Image h;

theorem 
  for G,H being strict Group, h being Homomorphism of G,H holds h
  .:((1).G)=(1).H & h.:((Omega).G)=(Omega).(Image h);

theorem 
  for G,H being strict Group, h being Homomorphism of G,H for A,B
being strict Subgroup of G holds A is Subgroup of B implies h.:A is Subgroup of
  h.:B;

theorem 
  for G,H being strict Group, h being Homomorphism of G,H for A
being strict Subgroup of G for a being Element of G holds h.a* h.:A=h.:(a*A) &
  h.:A * h.a=h.:(A*a);

theorem 
  for G,H being strict Group, h being Homomorphism of G,H for A,B
  being Subset of G holds h.:A* h.:B=h.:(A*B);

theorem 
  for G,H being strict Group, h being Homomorphism of G,H for A,B
being strict Subgroup of G holds A is strict normal Subgroup of B implies h.:A
  is strict normal Subgroup of h.:B;

theorem 
  for G,H being strict Group, h being Homomorphism of G,H holds G is
  solvable Group implies Image h is solvable;














begin 

theorem 
  for D being non empty set, S being non empty Subset of D, f being
BinOp of D, g being BinOp of S st g = f||S holds (f is commutative implies g is
  commutative) & (f is idempotent implies g is idempotent) & (f is associative
  implies g is associative);

theorem 
  for D being non empty set, S being non empty Subset of D, f being
BinOp of D, g being BinOp of S for d being Element of D, d9 being Element of S
  st g = f||S & d9 = d holds (d is_a_left_unity_wrt f implies d9
  is_a_left_unity_wrt g) & (d is_a_right_unity_wrt f implies d9
  is_a_right_unity_wrt g) & (d is_a_unity_wrt f implies d9 is_a_unity_wrt g);

theorem 
  for D being non empty set, S being non empty Subset of D, f1,f2
  being BinOp of D, g1,g2 being BinOp of S st g1 = f1||S & g2 = f2||S holds (f1
  is_left_distributive_wrt f2 implies g1 is_left_distributive_wrt g2) & (f1
  is_right_distributive_wrt f2 implies g1 is_right_distributive_wrt g2);

theorem 
  for D being non empty set, S being non empty Subset of D, f1,f2 being
  BinOp of D, g1,g2 being BinOp of S st g1 = f1||S & g2 = f2||S holds f1
  is_distributive_wrt f2 implies g1 is_distributive_wrt g2;

theorem 
  for D being non empty set, S being non empty Subset of D, f1,f2
  being BinOp of D, g1,g2 being BinOp of S st g1 = f1||S & g2 = f2||S holds f1
  absorbs f2 implies g1 absorbs g2;

begin 

definition
  let D be non empty set, X1,X2 be Subset of D;
  redefine pred X1 = X2 means

  for x being Element of D holds x in X1 iff x in X2;
end;

reserve L for Lattice,
  p,q,r for Element of L,
  p9,q9,r9 for Element of L.:,
  x, y for set;

theorem 
  for L1,L2 being LattStr st the LattStr of L1 = the LattStr of L2 holds
  L1.: = L2.:;

theorem 
  L .: .: = the LattStr of L;

theorem 
  for L1,L2 being non empty LattStr st the LattStr of L1 = the LattStr
of L2 for a1,b1 being Element of L1, a2,b2 being Element of L2 st a1 = a2 & b1
= b2 holds a1"\/"b1 = a2"\/"b2 & a1"/\"b1 = a2"/\"b2 & (a1 [= b1 iff a2 [= b2);

theorem 
  for L1,L2 being 0_Lattice st the LattStr of L1 = the LattStr of
  L2 holds Bottom L1 = Bottom L2;

theorem 
  for L1,L2 being 1_Lattice st the LattStr of L1 = the LattStr of
  L2 holds Top L1 = Top L2;

theorem 
  for L1,L2 being C_Lattice st the LattStr of L1 = the LattStr of
  L2 for a1,b1 being Element of L1, a2,b2 being Element of L2 st a1 = a2 & b1 =
  b2 & a1 is_a_complement_of b1 holds a2 is_a_complement_of b2;

theorem 
  for L1,L2 being B_Lattice st the LattStr of L1 = the LattStr of L2 for
  a being Element of L1, b being Element of L2 st a = b holds a` = b`;

theorem 
  for X being Subset of L st for p,q holds p in X & q in X iff p"/\"q in
  X holds X is ClosedSubset of L;

theorem 
  for X being Subset of L st for p,q holds p in X & q in X iff p
  "\/"q in X holds X is ClosedSubset of L;

definition
  let L;

  mode Ideal of L is non empty initial join-closed Subset of L;
end;

theorem 
  for L1,L2 being Lattice st the LattStr of L1 = the LattStr of L2
  for x st x is Filter of L1 holds x is Filter of L2;

theorem 
  for L1,L2 being Lattice st the LattStr of L1 = the LattStr of L2
  for x st x is Ideal of L1 holds x is Ideal of L2;

definition
  let L,p;
  func p.: -> Element of L.: equals

  p;
end;

definition
  let L;
  let p be Element of L.:;
  func .:p -> Element of L equals

  p;
end;

theorem 
  .:(p.:) = p & ( .:p9).: = p9;

theorem 
  p"/\"q = p.:"\/"q.: & p"\/"q = p.:"/\"q.: & p9"/\"q9 = .:p9"\/".: q9 &
  p9"\/"q9 = .:p9 "/\".:q9;

theorem 
  (p [= q iff q.: [= p.:) & (p9 [= q9 iff .:q9 [= .:p9);

definition
  let L;
  let X be Subset of L;
  func X.: -> Subset of L.: equals

  X;
end;

definition
  let L;
  let X be Subset of L.:;
  func .:X -> Subset of L equals

  X;
end;

registration
  let L;
  let D be non empty Subset of L;
  cluster D.: -> non empty;
end;

registration
  let L;
  let D be non empty Subset of L.:;
  cluster .:D -> non empty;
end;

registration
  let L;
  let S be meet-closed Subset of L;
  cluster S.: -> join-closed for Subset of L.:;
end;

registration
  let L;
  let S be join-closed Subset of L;
  cluster S.: -> meet-closed for Subset of L.:;
end;

registration
  let L;
  let S be meet-closed Subset of L.:;
  cluster .:S -> join-closed for Subset of L;
end;

registration
  let L;
  let S be join-closed Subset of L.:;
  cluster .:S -> meet-closed for Subset of L;
end;

registration
  let L;
  let F be final Subset of L;
  cluster F.: -> initial for Subset of L.:;
end;

registration
  let L;
  let F be initial Subset of L;
  cluster F.: -> final for Subset of L.:;
end;

registration
  let L;
  let F be final Subset of L.:;
  cluster .:F -> initial for Subset of L;
end;

registration
  let L;
  let F be initial Subset of L.:;
  cluster F.: -> final for Subset of L;
end;

theorem 
  x is Ideal of L iff x is Filter of L.:;

theorem 
  for D being non empty Subset of L holds D is Ideal of L iff (for
p,q st p in D & q in D holds p "\/" q in D) & for p,q st p in D & q [= p holds
  q in D;

reserve I,J for Ideal of L,
  F for Filter of L;

theorem 
  p in I implies p"/\"q in I & q"/\"p in I;

theorem 
  ex p st p in I;

theorem 
  L is lower-bounded implies Bottom L in I;

theorem 
  L is lower-bounded implies {Bottom L} is Ideal of L;

theorem 
  {p} is Ideal of L implies L is lower-bounded;

begin 

theorem 
  the carrier of L is Ideal of L;

definition
  let L;
  func (.L.> -> Ideal of L equals

  the carrier of L;
end;

definition
  let L,p;
  func (.p.> -> Ideal of L equals

  { q : q [= p };
end;

theorem 
  q in (.p.> iff q [= p;

theorem 
  (.p.> = <.p.:.) & (.p.:.> = <.p.);

theorem 
  p in (.p.> & p "/\" q in (.p.> & q "/\" p in (.p.>;

theorem 
  L is upper-bounded implies (.L.> = (.Top L.>;

definition
  let L,I;
  pred I is_max-ideal means

  I <> the carrier of L & for J st I c= J & J <> the carrier of L holds I = J;
end;

theorem 
  I is_max-ideal iff I.: is being_ultrafilter;

theorem 
  L is upper-bounded implies for I st I <> the carrier of L ex J st I c=
  J & J is_max-ideal;

theorem 
  (ex r st p "\/" r <> p) implies (.p.> <> the carrier of L;

theorem 
  L is upper-bounded & p <> Top L implies ex I st p in I & I is_max-ideal;

reserve D for non empty Subset of L,
  D9 for non empty Subset of L.:;

definition
  let L,D;
  func (.D.> -> Ideal of L means


  D c= it & for I st D c= I holds it c= I;
end;

theorem 
  <.D.:.) = (.D.> & <.D.) = (.D.:.> & <..:D9.) = (.D9.> & <.D9.) = (..: D9.>;

theorem 
  (.I.> = I;

reserve D1,D2 for non empty Subset of L,
  D19,D29 for non empty Subset of L.:;

theorem 
  (D1 c= D2 implies (.D1.> c= (.D2.>) & (.(.D.>.> c= (.D.>;

theorem 
  p in D implies (.p.> c= (.D.>;

theorem 
  D = {p} implies (.D.> = (.p.>;

theorem 
  L is upper-bounded & Top L in D implies (.D.> = (.L.> & (.D.> =
  the carrier of L;

theorem 
  L is upper-bounded & Top L in I implies I = (.L.> & I = the carrier of L;

definition
  let L,I;
  attr I is prime means

  p "/\" q in I iff p in I or q in I;
end;

theorem 
  I is prime iff I.: is prime;

definition
  let L,D1,D2;
  func D1 "\/" D2 -> Subset of L equals

  { p"\/"q : p in D1 & q in D2 };
end;

registration
  let L,D1,D2;
  cluster D1 "\/" D2 -> non empty;
end;

theorem 
  D1 "\/" D2 = D1.: "/\" D2.: & D1.: "\/" D2.: = D1 "/\" D2 & D19
  "\/" D29 = .:D19 "/\" .:D29 & .:D19 "\/" .:D29 = D19 "/\" D29;

theorem 
  p in D1 & q in D2 implies p"\/"q in D1 "\/" D2 & q"\/"p in D1 "\/" D2;

theorem 
  x in D1 "\/" D2 implies ex p,q st x = p"\/"q & p in D1 & q in D2;

theorem 
  D1 "\/" D2 = D2 "\/" D1;

registration
  let L be D_Lattice;
  let I1,I2 be Ideal of L;
  cluster I1 "\/" I2 -> initial join-closed;
end;

theorem 
  (.D1 \/ D2.> = (.(.D1.> \/ D2.> & (.D1 \/ D2.> = (.D1 \/ (.D2.>.>;

theorem 
  (.I \/ J.> = { r : ex p,q st r [= p"\/"q & p in I & q in J };

theorem 
  I c= I "\/" J & J c= I "\/" J;

theorem 
  (.I \/ J.> = (.I "\/" J.>;

reserve B for B_Lattice,
  IB,JB for Ideal of B,
  a,b for Element of B;

theorem 
  L is C_Lattice iff L.: is C_Lattice;

theorem 
  L is B_Lattice iff L.: is B_Lattice;

registration
  let B be B_Lattice;
  cluster B.: -> Boolean Lattice-like;
end;

reserve a9 for Element of (B qua Lattice).:;

theorem 
  a.:` = a` & ( .:a9)` = a9`;

theorem 
  (.IB \/ JB.> = IB "\/" JB;

theorem 
  IB is_max-ideal iff IB <> the carrier of B & for a holds a in IB or a` in IB;

theorem 
  IB <> (.B.> & IB is prime iff IB is_max-ideal;

theorem 
  IB is_max-ideal implies for a holds a in IB iff not a` in IB;

theorem 
  a <> b implies ex IB st IB is_max-ideal & (a in IB & not b in IB or
  not a in IB & b in IB);

reserve P for non empty ClosedSubset of L,
  o1,o2 for BinOp of P;

theorem 
  (the L_join of L)||P is BinOp of P & (the L_meet of L)||P is BinOp of P;

theorem 
  o1 = (the L_join of L)||P & o2 = (the L_meet of L)||P implies o1
is commutative & o1 is associative & o2 is commutative & o2 is associative & o1
  absorbs o2 & o2 absorbs o1;

definition
  let L,p,q;
  assume
 p [= q;
  func [#p,q#] -> non empty ClosedSubset of L equals


  {r: p [= r & r [=
  q};
end;

theorem 
  p [= q implies (r in [#p,q#] iff p [= r & r [= q);

theorem 
  p [= q implies p in [#p,q#] & q in [#p,q#];

theorem 
  [#p,p#] = {p};

theorem 
  L is upper-bounded implies <.p.) = [#p,Top L#];

theorem 
  L is lower-bounded implies (.p.> = [#Bottom L,p#];

theorem 
  for L1,L2 being Lattice for F1 being Filter of L1, F2 being Filter of
  L2 st the LattStr of L1 = the LattStr of L2 & F1 = F2 holds latt F1 = latt F2
;

begin 

notation
  let L;
  synonym Sublattice of L for SubLattice of L;
end;

definition
  let L;
  redefine mode Sublattice of L means


    ex P,o1,o2 st o1 = (the L_join
of L)||P & o2 = (the L_meet of L)||P & the LattStr of it = LattStr (#P, o1, o2
    #);
end;

theorem 
  for K being Sublattice of L, a being Element of K holds a is Element of L;

definition
  let L,P;
  func latt (L,P) -> Sublattice of L means


  ex o1,o2 st o1 = (the
  L_join of L)||P & o2 = (the L_meet of L)||P & it = LattStr (#P, o1, o2#);
end;

registration
  let L,P;
  cluster latt (L,P) -> strict;
end;

definition
  let L;
  let l be Sublattice of L;
  redefine func l.: -> strict Sublattice of L.:;
end;

theorem 
  latt F = latt (L,F);

theorem 
  latt (L,P) = (latt (L.:,P.:)).:;

theorem 
  latt (L,(.L.>) = the LattStr of L & latt (L,<.L.)) = the LattStr of L;

theorem 
  the carrier of latt (L,P) = P & the L_join of latt (L,P) = (the
  L_join of L)||P & the L_meet of latt (L,P) = (the L_meet of L)||P;

theorem 
  for p,q for p9,q9 being Element of latt (L,P) st p = p9 & q = q9
  holds p"\/"q = p9"\/"q9 & p"/\"q = p9"/\"q9;

theorem 
  for p,q for p9,q9 being Element of latt (L,P) st p = p9 & q = q9
  holds p [= q iff p9 [= q9;

theorem 
  L is lower-bounded implies latt (L,I) is lower-bounded;

theorem 
  L is modular implies latt (L,P) is modular;

theorem 
  L is distributive implies latt (L,P) is distributive;

theorem 
  L is implicative & p [= q implies latt (L,[#p,q#]) is implicative;

registration
  let L,p;
  cluster latt (L,(.p.>) -> upper-bounded;
end;

theorem 
  Top latt (L,(.p.>) = p;

theorem 
  L is lower-bounded implies latt (L,(.p.>) is lower-bounded &
  Bottom latt (L,(.p.>) = Bottom L;

theorem 
  L is lower-bounded implies latt (L,(.p.>) is bounded;

theorem 
  p [= q implies latt (L,[#p,q#]) is bounded & Top latt (L,[#p,q#]
  ) = q & Bottom latt (L,[#p,q#]) = p;

theorem 
  L is C_Lattice & L is modular implies latt (L,(.p.>) is C_Lattice;

theorem 
  L is C_Lattice & L is modular & p [= q implies latt (L,[#p,q#]) is C_Lattice;

theorem 
  L is B_Lattice & p [= q implies latt (L,[#p,q#]) is B_Lattice;

theorem 
for S being non empty Subset of L holds
  S is Ideal of L iff for p,q being Element of L holds
    p in S & q in S iff p "\/" q in S;














begin 

reserve m, n, i, k for Element of NAT;

definition
  let IAlph be set;
  struct (1-sorted) FSM over IAlph (# carrier -> set, Tran -> Function of [:
    the carrier, IAlph :], the carrier, InitS -> Element of the carrier #);
end;

definition
  let IAlph be set, fsm be FSM over IAlph;
  mode State of fsm is Element of fsm;
end;

registration
  let X be set;
  cluster non empty finite for FSM over X;
end;

reserve IAlph, OAlph for non empty set,
  fsm for non empty FSM over IAlph,
  s for Element of IAlph,
  w, w1, w2 for FinSequence of IAlph,
  q, q9, q1, q2 for State of fsm;

definition
  let IAlph be non empty set;
  let fsm be non empty FSM over IAlph;
  let s be Element of IAlph, q be State of fsm;
  func s -succ_of q -> State of fsm equals

  (the Tran of fsm).[q, s];
end;

definition
  let IAlph be non empty set;
  let fsm be non empty FSM over IAlph;
  let q be State of fsm;
  let w be FinSequence of IAlph;
  func (q, w)-admissible -> FinSequence of the carrier of fsm means


  it.
1 = q & len it = len w + 1 & for i being Nat st 1 <= i & i <= len w ex wi being
Element of IAlph, qi, qi1 being State of fsm st wi = w.i & qi = it.i & qi1 = it
  .(i+1) & wi-succ_of qi = qi1;
end;

theorem 
  (q, <*>IAlph)-admissible = <*q*>;

definition
  let IAlph be non empty set;
  let fsm be non empty FSM over IAlph;
  let w be FinSequence of IAlph;
  let q1, q2 be State of fsm;
  pred q1, w-leads_to q2 means


  (q1, w)-admissible.(len w + 1) = q2;
end;

theorem 
  q, <*>IAlph-leads_to q;

definition
  let IAlph be non empty set;
  let fsm be non empty FSM over IAlph;
  let w be FinSequence of IAlph;
  let qseq be FinSequence of the carrier of fsm;
  pred qseq is_admissible_for w means


  ex q1 being State of fsm st q1 = qseq.1 & (q1, w)-admissible = qseq;
end;

theorem 
  <*q*> is_admissible_for <*>IAlph;

definition
  let IAlph, fsm, q, w;
  func q leads_to_under w -> State of fsm means


  q, w-leads_to it;
end;

theorem 
  ((q, w)-admissible).(len (q, w)-admissible) = q9 iff q, w -leads_to q9;

theorem 
  for k st 1 <= k & k <= len w1 holds (q1,w1^w2)-admissible.k = (
  q1,w1)-admissible.k;

theorem 
  q1,w1-leads_to q2 implies (q1,w1^w2)-admissible.(len w1 + 1) = q2;

theorem 
  q1,w1-leads_to q2 implies for k st 1 <= k & k <= len w2 + 1
  holds (q1,w1^w2)-admissible.(len w1 + k) = (q2,w2)-admissible.k;

theorem 
  q1,w1-leads_to q2 implies (q1,w1^w2)-admissible = Del((q1,w1)
  -admissible,(len w1 + 1))^(q2,w2)-admissible;

begin 

definition
  let IAlph be set, OAlph be non empty set;
  struct (FSM over IAlph) Mealy-FSM over IAlph, OAlph (# carrier -> set, Tran
-> Function of [: the carrier, IAlph :], the carrier, OFun -> Function of [:
    the carrier, IAlph :], OAlph, InitS -> Element of the carrier #);
  struct (FSM over IAlph) Moore-FSM over IAlph, OAlph (# carrier -> set, Tran
-> Function of [: the carrier, IAlph :], the carrier, OFun -> Function of the
    carrier, OAlph, InitS -> Element of the carrier #);
end;

registration
  let IAlph be set, X be finite non empty set, T be Function of [: X, IAlph :]
  , X, I be Element of X;
  cluster FSM (# X, T, I #) -> finite non empty;
end;

registration
  let IAlph be set, OAlph be non empty set, X be finite non empty set, T be
  Function of [: X, IAlph :], X, O be Function of [: X, IAlph :], OAlph, I be
  Element of X;
  cluster Mealy-FSM (# X, T, O, I #) -> finite non empty;
end;

registration
  let IAlph be set, OAlph be non empty set, X be finite non empty set, T be
  Function of [: X, IAlph :], X, O be Function of X, OAlph, I be Element of X;
  cluster Moore-FSM (# X, T, O, I #) -> finite non empty;
end;

registration
  let IAlph be set, OAlph be non empty set;
  cluster finite non empty for Mealy-FSM over IAlph, OAlph;
  cluster finite non empty for Moore-FSM over IAlph, OAlph;
end;

reserve tfsm, tfsm1, tfsm2, tfsm3 for non empty Mealy-FSM over IAlph, OAlph,
  sfsm for non empty Moore-FSM over IAlph, OAlph,
  qs for State of sfsm,
  q, q1, q2 , q3, qa, qb, qc, qa9, qt, q1t, q2t for State of tfsm,
  q11, q12 for State of tfsm1,
  q21, q22 for State of tfsm2;

definition
  let IAlph, OAlph, tfsm, qt, w;
  func (qt, w)-response -> FinSequence of OAlph means


  len it = len w &
for i st i in dom w holds it.i = (the OFun of tfsm).[(qt, w)-admissible.i, w.i]
  ;
end;

theorem 
  (qt, <*>IAlph)-response = <*>OAlph;

definition
  let IAlph, OAlph, sfsm, qs, w;
  func (qs, w)-response -> FinSequence of OAlph means


  len it = len w +
  1 & for i st i in Seg (len w + 1) holds it.i = (the OFun of sfsm).((qs, w)
  -admissible.i);
end;

theorem 
  ((qs, w)-response).1 = (the OFun of sfsm).qs;

theorem 
  q1t,w1-leads_to q2t implies (q1t,w1^w2)-response = (q1t,w1)
  -response ^ (q2t,w2)-response;

theorem 
  q11, w1 -leads_to q12 & q21, w1 -leads_to q22 & (q12,w2)
  -response <> (q22,w2)-response implies (q11,w1^w2)-response <> (q21,w1^w2)
  -response;

reserve OAlphf for finite non empty set,
  tfsmf for finite non empty Mealy-FSM over IAlph, OAlphf,
  sfsmf for finite non empty Moore-FSM over IAlph, OAlphf;

definition
  let IAlph, OAlph;
  let tfsm be non empty Mealy-FSM over IAlph, OAlph;
  let sfsm be non empty Moore-FSM over IAlph, OAlph;
  pred tfsm is_similar_to sfsm means

  for tw being FinSequence of IAlph holds
<*(the OFun of sfsm).(the InitS of sfsm)*>^((the InitS of tfsm, tw)-response) =
  (the InitS of sfsm, tw)-response;
end;

theorem 
  for sfsm being non empty finite Moore-FSM over IAlph, OAlph ex tfsm
  being non empty finite Mealy-FSM over IAlph, OAlph st tfsm is_similar_to sfsm
;

theorem 
  ex sfsmf st tfsmf is_similar_to sfsmf;

begin 

definition
  let IAlph, OAlph be non empty set, tfsm1, tfsm2 be non empty Mealy-FSM over
  IAlph, OAlph;
  pred tfsm1, tfsm2-are_equivalent means


  for w being FinSequence of
IAlph holds (the InitS of tfsm1,w)-response = (the InitS of tfsm2,w)-response;
  reflexivity;
  symmetry;
end;

theorem 
  tfsm1, tfsm2-are_equivalent & tfsm2, tfsm3-are_equivalent
  implies tfsm1, tfsm3-are_equivalent;

definition
  let IAlph, OAlph, tfsm, qa, qb;
  pred qa, qb-are_equivalent means


  for w holds (qa, w)-response = (qb, w)-response;
  reflexivity;
  symmetry;
end;

theorem 
  q1, q2-are_equivalent & q2, q3-are_equivalent implies q1, q3 -are_equivalent;

theorem 
  qa9 = (the Tran of tfsm).[qa, s] implies for i st i in Seg (len
  w + 1) holds (qa, <*s*>^w)-admissible.(i+1) = (qa9, w)-admissible.i;

theorem 
  qa9 = (the Tran of tfsm).[qa, s] implies (qa, <*s*>^w)-response
  = <*(the OFun of tfsm).[qa, s]*>^(qa9, w)-response;

theorem 
  qa, qb-are_equivalent iff for s holds (the OFun of tfsm).[qa, s]
= (the OFun of tfsm).[qb, s] & (the Tran of tfsm).[qa, s], (the Tran of tfsm).[
  qb, s]-are_equivalent;

theorem 
  qa, qb-are_equivalent implies for w, i st i in dom w ex qai, qbi being
  State of tfsm st qai = (qa, w)-admissible.i & qbi = ((qb, w)-admissible.i) &
  qai, qbi-are_equivalent;

definition
  let IAlph, OAlph,tfsm, qa, qb;
  let k be Nat;
  pred k-equivalent qa, qb means


  for w st len w<=k holds (qa,w) -response = (qb,w)-response;
end;

theorem 
  for k be Nat holds k-equivalent qa, qa;

theorem 
  for k be Nat st k-equivalent qa, qb holds k-equivalent qb, qa;

theorem 
  for k be Nat st k-equivalent qa, qb & k-equivalent qb, qc holds
  k-equivalent qa, qc;

theorem 
  qa,qb-are_equivalent implies k-equivalent qa,qb;

theorem 
  0-equivalent qa, qb;

theorem 
  for k, m be Nat st (k+m)-equivalent qa, qb holds k-equivalent qa , qb;

theorem 
  for k be Nat st 1 <= k holds (k-equivalent qa, qb iff 1
  -equivalent qa, qb & for s being Element of IAlph, k1 being Element of NAT st
k1 = k - 1 holds k1-equivalent (the Tran of tfsm).[qa, s], (the Tran of tfsm).[
  qb, s]);

definition
  let IAlph, OAlph, tfsm;
  let i be Nat;
  func i-eq_states_EqR tfsm -> Equivalence_Relation of the carrier of tfsm
  means


  for qa, qb holds [qa, qb] in it iff i-equivalent qa, qb;
end;

definition
  let IAlph, OAlph;
  let tfsm be non empty Mealy-FSM over IAlph, OAlph;
  let i be Nat;
  func i-eq_states_partition tfsm -> non empty a_partition of the carrier of
  tfsm equals

  Class (i-eq_states_EqR tfsm);
end;

theorem 
  (k+1)-eq_states_partition tfsm is_finer_than k -eq_states_partition tfsm;

theorem 
  for k be Nat holds Class (k-eq_states_EqR tfsm) = Class ((k+1)
-eq_states_EqR tfsm)implies for m be Nat holds Class ((k+m)-eq_states_EqR tfsm)
  = Class (k-eq_states_EqR tfsm);

theorem 
  k-eq_states_partition tfsm = (k+1)-eq_states_partition tfsm implies
for m holds (k+m)-eq_states_partition tfsm = k-eq_states_partition tfsm
;

theorem 
  (k+1)-eq_states_partition tfsm <> k-eq_states_partition tfsm
  implies for i st i <= k holds (i+1)-eq_states_partition tfsm <> i
  -eq_states_partition tfsm;

theorem 
  for tfsm being finite non empty Mealy-FSM over IAlph, OAlph
  holds k-eq_states_partition tfsm = (k+1)-eq_states_partition tfsm or card (k
  -eq_states_partition tfsm) < card ((k+1)-eq_states_partition tfsm);

theorem 
  Class (0-eq_states_EqR tfsm, q) = the carrier of tfsm;

theorem 
  0-eq_states_partition tfsm = { the carrier of tfsm };

theorem 
  for tfsm being finite non empty Mealy-FSM over IAlph, OAlph st n
  +1 = card the carrier of tfsm holds (n+1)-eq_states_partition tfsm = n
  -eq_states_partition tfsm;

definition
  let IAlph, OAlph;
  let tfsm be non empty Mealy-FSM over IAlph, OAlph;
  let IT be a_partition of the carrier of tfsm;
  attr IT is final means


  for qa, qb being State of tfsm holds qa, qb
  -are_equivalent iff ex X being Element of IT st qa in X & qb in X;
end;

theorem 
  k-eq_states_partition tfsm is final implies (k+1)-eq_states_EqR tfsm =
  k-eq_states_EqR tfsm;

theorem 
  k-eq_states_partition tfsm = (k+1)-eq_states_partition tfsm
  implies k-eq_states_partition tfsm is final;

theorem 
  for tfsm being finite non empty Mealy-FSM over IAlph, OAlph st n+1 =
  card the carrier of tfsm holds ex k being Element of NAT st k <= n & k
  -eq_states_partition tfsm is final;

definition
  let IAlph, OAlph;
  let tfsm be finite non empty Mealy-FSM over IAlph, OAlph;
  func final_states_partition tfsm -> a_partition of the carrier of tfsm means


  it is final;
end;

theorem 
  for tfsm being finite non empty Mealy-FSM over IAlph, OAlph
  holds n+1 = card the carrier of tfsm implies final_states_partition tfsm = n
  -eq_states_partition tfsm;

begin 

reserve tfsm, rtfsm for finite non empty Mealy-FSM over IAlph, OAlph,
  q for State of tfsm;

definition
  let IAlph, OAlph be non empty set;
  let tfsm be finite non empty Mealy-FSM over IAlph, OAlph;
  let qf be Element of final_states_partition tfsm;
  let s be Element of IAlph;
  func (s,qf)-succ_class -> Element of final_states_partition tfsm means


   ex q being State of tfsm, n being Element of NAT st q in qf & (n+1) =
card the carrier of tfsm & it = Class(n-eq_states_EqR tfsm, (the Tran of tfsm).
  [q,s]);
end;

definition
  let IAlph, OAlph, tfsm;
  let qf be Element of final_states_partition tfsm, s;
  func (qf,s)-class_response -> Element of OAlph means


  ex q st q in qf & it = (the OFun of tfsm).[q,s];
end;

definition
  let IAlph, OAlph, tfsm;
  func the_reduction_of tfsm -> strict Mealy-FSM over IAlph, OAlph means


   the
 carrier of it = final_states_partition tfsm & (for Q being State of
it, s for q being State of tfsm st q in Q holds (the Tran of tfsm).(q, s) in (
the Tran of it).(Q, s) & (the OFun of tfsm).(q, s) = (the OFun of it).(Q, s)) &
  the InitS of tfsm in the InitS of it;
end;

registration
  let IAlph, OAlph, tfsm;
  cluster the_reduction_of tfsm -> non empty finite;
end;

theorem 
  for qr being State of rtfsm st rtfsm = the_reduction_of tfsm & q
  in qr holds for k being Element of NAT st k in Seg (len w +1) holds (q,w)
  -admissible.k in (qr,w)-admissible.k;

theorem 
  tfsm, the_reduction_of tfsm-are_equivalent;

begin 

reserve qr1, qr2 for State of rtfsm,
  Tf for Function of the carrier of tfsm1, the carrier of tfsm2;

definition
  let IAlph, OAlph, tfsm1, tfsm2;
  pred tfsm1, tfsm2-are_isomorphic means


  ex Tf st Tf is bijective & Tf
  .the InitS of tfsm1 = the InitS of tfsm2 & for q11, s holds Tf.((the Tran of
tfsm1).(q11,s))=(the Tran of tfsm2).(Tf.q11, s) & (the OFun of tfsm1).(q11,s) =
  (the OFun of tfsm2).(Tf.q11, s);
  reflexivity;
  symmetry;
end;

theorem 
  tfsm1,tfsm2-are_isomorphic & tfsm2,tfsm3-are_isomorphic implies
  tfsm1,tfsm3-are_isomorphic;

theorem 
  (for q being State of tfsm1, s holds Tf.((the Tran of tfsm1).(q,
  s)) = (the Tran of tfsm2).(Tf.q,s)) implies for k st 1 <= k & k <= len w + 1
  holds Tf.((q11,w)-admissible.k) = (Tf.q11,w)-admissible.k;

theorem 
  ( for q being State of tfsm1, s holds Tf.((the Tran of tfsm1).(q
  , s)) = (the Tran of tfsm2).(Tf.q, s) & (the OFun of tfsm1).(q,s) = (the OFun
  of tfsm2).(Tf.q, s)) implies (q11,q12-are_equivalent iff Tf.q11, Tf.q12
  -are_equivalent);

theorem 
  rtfsm = the_reduction_of tfsm & qr1<>qr2 implies not qr1,qr2 -are_equivalent;

begin 

definition
  let IAlph, OAlph be non empty set;
  let IT be non empty Mealy-FSM over IAlph,OAlph;
  attr IT is reduced means


  for qa, qb being State of IT st qa <> qb holds not qa, qb-are_equivalent;
end;

registration
  let IAlph,OAlph,tfsm;
  cluster the_reduction_of tfsm -> reduced;
end;

registration
  let IAlph, OAlph;
  cluster reduced finite for non empty Mealy-FSM over IAlph,OAlph;
end;

reserve Rtfsm for reduced finite non empty Mealy-FSM over IAlph, OAlph;

theorem 
  Rtfsm, the_reduction_of Rtfsm-are_isomorphic;

theorem 
  tfsm is reduced iff ex M being finite non empty Mealy-FSM over
  IAlph,OAlph st tfsm, the_reduction_of M-are_isomorphic;

definition
  let IAlph, OAlph;
  let tfsm be non empty Mealy-FSM over IAlph,OAlph;
  let IT be State of tfsm;
  attr IT is accessible means


  ex w st the InitS of tfsm, w-leads_to IT;
end;

definition
  let IAlph, OAlph;
  let IT be non empty Mealy-FSM over IAlph, OAlph;
  attr IT is connected means


  for q being State of IT holds q is accessible;
end;

registration
  let IAlph, OAlph;
  cluster connected for finite non empty Mealy-FSM over IAlph,OAlph;
end;

reserve Ctfsm, Ctfsm1, Ctfsm2 for connected finite non empty Mealy-FSM over
  IAlph, OAlph;

registration
  let IAlph,OAlph,Ctfsm;
  cluster the_reduction_of Ctfsm -> connected;
end;

registration
  let IAlph, OAlph;
  cluster connected reduced finite for non empty Mealy-FSM over IAlph,OAlph;
end;

definition
  let IAlph, OAlph;
  let tfsm be non empty Mealy-FSM over IAlph,OAlph;
  func accessibleStates tfsm equals

  { q where q is State of tfsm : q is
  accessible };
end;

registration
  let IAlph, OAlph, tfsm;
  cluster accessibleStates tfsm -> finite non empty;
end;

theorem 
  accessibleStates tfsm c= the carrier of tfsm & for q holds q in
  accessibleStates tfsm iff q is accessible;

theorem 
  (the Tran of tfsm)|[:accessibleStates tfsm, IAlph:] is Function
  of [:accessibleStates tfsm, IAlph:], accessibleStates tfsm;

theorem 
  for cTran being Function of [:accessibleStates tfsm, IAlph:],
accessibleStates tfsm, cOFun being Function of [:accessibleStates tfsm, IAlph:]
, OAlph, cInitS being Element of accessibleStates tfsm st cTran = (the Tran of
  tfsm) | [:accessibleStates tfsm, IAlph:] & cOFun = (the OFun of tfsm) | [:
  accessibleStates tfsm, IAlph:] & cInitS = the InitS of tfsm holds tfsm,
  Mealy-FSM(#accessibleStates tfsm, cTran, cOFun, cInitS#) -are_equivalent;

theorem 
  ex Ctfsm st the Tran of Ctfsm = (the Tran of tfsm)|[:accessibleStates
tfsm, IAlph:] & the OFun of Ctfsm = (the OFun of tfsm)|[:accessibleStates tfsm,
  IAlph:] & the InitS of Ctfsm = the InitS of tfsm & tfsm, Ctfsm-are_equivalent
;

begin 

definition
  let IAlph be set, OAlph be non empty set;
  let tfsm1, tfsm2 be non empty Mealy-FSM over IAlph, OAlph;
  func tfsm1-Mealy_union tfsm2 -> strict Mealy-FSM over IAlph, OAlph means


   the carrier of it = (the carrier of tfsm1) \/ (the carrier of tfsm2) &
the Tran of it = (the Tran of tfsm1) +* (the Tran of tfsm2) & the OFun of it =
  (the OFun of tfsm1) +* (the OFun of tfsm2) & the InitS of it = the InitS of
  tfsm1;
end;

registration
  let IAlph be set, OAlph be non empty set;
  let tfsm1, tfsm2 be non empty finite Mealy-FSM over IAlph, OAlph;
  cluster tfsm1-Mealy_union tfsm2 -> non empty finite;
end;

theorem 
  tfsm = tfsm1-Mealy_union tfsm2 & the carrier of tfsm1 misses the
  carrier of tfsm2 & q11 = q implies (q11,w)-admissible = (q,w)-admissible;

theorem 
  tfsm = tfsm1-Mealy_union tfsm2 & the carrier of tfsm1 misses the
  carrier of tfsm2 & q11 = q implies (q11,w)-response = (q,w)-response;

theorem 
  tfsm = tfsm1-Mealy_union tfsm2 & q21 = q implies (q21,w)
  -admissible = (q,w)-admissible;

theorem 
  tfsm = tfsm1-Mealy_union tfsm2 & q21 = q implies (q21,w)
  -response = (q,w)-response;

reserve Rtfsm1, Rtfsm2 for reduced non empty Mealy-FSM over IAlph, OAlph;

theorem 
  tfsm = Rtfsm1-Mealy_union Rtfsm2 & the carrier of Rtfsm1 misses
the carrier of Rtfsm2 & Rtfsm1, Rtfsm2-are_equivalent implies ex Q being State
of the_reduction_of tfsm st the InitS of Rtfsm1 in Q & the InitS of Rtfsm2 in Q
  & Q = the InitS of the_reduction_of tfsm;

reserve CRtfsm1, CRtfsm2 for connected reduced non empty Mealy-FSM over IAlph
  , OAlph,
  q1u, q2u for State of tfsm;

theorem 
  for crq11, crq12 being State of CRtfsm1 holds crq11 = q1u &
  crq12 = q2u & the carrier of CRtfsm1 misses the carrier of CRtfsm2 & tfsm =
CRtfsm1-Mealy_union CRtfsm2 & not crq11, crq12-are_equivalent implies not q1u,
  q2u-are_equivalent;

theorem 
  for crq21, crq22 being State of CRtfsm2 holds crq21 = q1u &
  crq22 = q2u & tfsm = CRtfsm1-Mealy_union CRtfsm2 & not crq21, crq22
  -are_equivalent implies not q1u, q2u-are_equivalent;

reserve CRtfsm1, CRtfsm2 for connected reduced finite non empty Mealy-FSM
  over IAlph, OAlph;

theorem 
  the carrier of CRtfsm1 misses the carrier of CRtfsm2 & tfsm =
CRtfsm1-Mealy_union CRtfsm2 implies for Q being State of the_reduction_of tfsm
holds not ex q1, q2 being Element of Q st q1 in the carrier of CRtfsm1 & q2 in
  the carrier of CRtfsm1 & q1 <> q2;

theorem 
  tfsm = CRtfsm1-Mealy_union CRtfsm2 implies for Q being State of
  the_reduction_of tfsm holds not ex q1, q2 being Element of Q st q1 in the
  carrier of CRtfsm2 & q2 in the carrier of CRtfsm2 & q1 <> q2;

theorem 
  the carrier of CRtfsm1 misses the carrier of CRtfsm2 & CRtfsm1,
CRtfsm2-are_equivalent & tfsm = CRtfsm1-Mealy_union CRtfsm2 implies for Q being
  State of the_reduction_of tfsm ex q1, q2 being Element of Q st q1 in the
  carrier of CRtfsm1 & q2 in the carrier of CRtfsm2 & for q being Element of Q
  holds q = q1 or q = q2;

begin 

theorem 
  for tfsm1, tfsm2 being finite non empty Mealy-FSM over IAlph,
  OAlph ex fsm1, fsm2 being finite non empty Mealy-FSM over IAlph, OAlph st the
carrier of fsm1 misses the carrier of fsm2 & fsm1, tfsm1-are_isomorphic & fsm2,
  tfsm2-are_isomorphic;

theorem 
  tfsm1, tfsm2-are_isomorphic implies tfsm1, tfsm2-are_equivalent;

theorem 
  the carrier of CRtfsm1 misses the carrier of CRtfsm2 & CRtfsm1,
  CRtfsm2-are_equivalent implies CRtfsm1, CRtfsm2-are_isomorphic;

theorem 
  Ctfsm1, Ctfsm2-are_equivalent implies the_reduction_of Ctfsm1,
  the_reduction_of Ctfsm2-are_isomorphic;


theorem 
  for M1, M2 being connected reduced finite non empty Mealy-FSM over
  IAlph, OAlph holds M1, M2-are_isomorphic iff M1, M2-are_equivalent;














begin

reserve S for non void non empty ManySortedSign,
  V for non-empty ManySortedSet of the carrier of S;

definition
  let S;
  let V be ManySortedSet of the carrier of S;
  func S-Terms V -> Subset of FinTrees the carrier of DTConMSA V equals


  TS DTConMSA V;
end;

registration
  let S, V;
  cluster S-Terms V -> non empty;
end;

definition
  let S, V;
  mode Term of S,V is Element of S-Terms V;
end;

reserve A for MSAlgebra over S,
  t for Term of S,V;

definition
  let S, V;
  let o be OperSymbol of S;
  redefine func Sym(o, V) -> NonTerminal of DTConMSA V;
end;

definition
  let S, V;
  let sy be NonTerminal of DTConMSA V;
  mode ArgumentSeq of sy -> FinSequence of S-Terms V means


    it is SubtreeSeq of sy;
end;

theorem 
  for o being OperSymbol of S, a being FinSequence holds [o,the
carrier of S]-tree a in S-Terms V & a is DTree-yielding iff a is ArgumentSeq of
  Sym(o,V);

scheme 

  TermInd { S() -> non void non empty ManySortedSign, V() -> non-empty
  ManySortedSet of the carrier of S(), P[set] }: for t being Term of S(),V()
  holds P[t]
provided
 for s being SortSymbol of S(), v being Element of V().s holds P[
root-tree [v,s]] and
 for o being OperSymbol of S(), p being ArgumentSeq of Sym(o,V()) st
for t being Term of S(),V() st t in rng p holds P[t] holds P[[o,the carrier of
S()]-tree p];

definition
  let S, A, V;
  mode c-Term of A,V is Term of S, (the Sorts of A) \/ V;
end;

definition
  let S, A, V;
  let o be OperSymbol of S;
  mode ArgumentSeq of o,A,V is ArgumentSeq of Sym(o,(the Sorts of A) \/ V);
end;

scheme 

  CTermInd { S() -> non void non empty ManySortedSign, A() -> non-empty
MSAlgebra over S(), V() -> non-empty ManySortedSet of the carrier of S(), P[set
  ] }: for t being c-Term of A(),V() holds P[t]
provided
 for s being SortSymbol of S(), x being Element of (the Sorts of A())
.s holds P[root-tree [x,s]] and
 for s being SortSymbol of S(), v being Element of V().s holds P[
root-tree [v,s]] and
 for o being OperSymbol of S(), p being ArgumentSeq of o,A(),V() st
for t being c-Term of A(),V() st t in rng p holds P[t] holds P[Sym(o,(the Sorts
of A()) \/ V())-tree p];

definition
  let S, V, t;
  let p be Node of t;
  redefine func t.p -> Symbol of DTConMSA V;
end;

registration
  let S, V;
  cluster -> finite for Term of S,V;
end;

theorem 
  (ex s being SortSymbol of S, v being Element of V.s st t.{} = [v,
  s]) or t.{} in [:the carrier' of S,{the carrier of S}:];

theorem 
  for t being c-Term of A,V holds (ex s being SortSymbol of S, x being
set st x in (the Sorts of A).s & t.{} = [x,s]) or (ex s being SortSymbol of S,
  v being Element of V.s st t.{} = [v,s]) or t.{} in [:the carrier' of S,{the
  carrier of S}:];

theorem 
  for s being SortSymbol of S, v being Element of V.s holds
  root-tree [v,s] is Term of S, V;

theorem 
  for s being SortSymbol of S, v being Element of V.s st t.{} = [v,
  s] holds t = root-tree [v,s];

theorem 
  for s being SortSymbol of S, x being set st x in (the Sorts of A)
  .s holds root-tree [x,s] is c-Term of A, V;

theorem 
  for t being c-Term of A,V for s being SortSymbol of S, x being set st
  x in (the Sorts of A).s & t.{} = [x,s] holds t = root-tree [x,s];

theorem 
  for s being SortSymbol of S, v being Element of V.s holds
  root-tree [v,s] is c-Term of A, V;

theorem 
  for t being c-Term of A,V for s being SortSymbol of S, v being Element
  of V.s st t.{} = [v,s] holds t = root-tree [v,s];

theorem 
  for o being OperSymbol of S st t.{} = [o,the carrier of S] ex a
  being ArgumentSeq of Sym(o,V) st t = [o,the carrier of S]-tree a;

definition
  let S;
  let A be non-empty MSAlgebra over S;
  let V;
  let s be SortSymbol of S;
  let x be Element of (the Sorts of A).s;
  func x-term(A,V) -> c-Term of A,V equals

  root-tree [x,s];
end;

definition
  let S, A, V;
  let s be SortSymbol of S;
  let v be Element of V.s;
  func v-term A -> c-Term of A,V equals

  root-tree [v,s];
end;

definition
  let S, V;
  let sy be NonTerminal of DTConMSA V;
  let p be ArgumentSeq of sy;
  redefine func sy-tree p -> Term of S,V;
end;

scheme 

  TermInd2 { S() -> non void non empty ManySortedSign, A() -> non-empty
MSAlgebra over S(), V() -> non-empty ManySortedSet of the carrier of S(), P[set
  ] }: for t being c-Term of A(),V() holds P[t]
provided
 for s being SortSymbol of S(), x being Element of (the Sorts of A())
.s holds P[x-term (A(), V())] and
 for s being SortSymbol of S(), v being Element of V().s holds P[v
-term A()] and
 for o being OperSymbol of S(), p being ArgumentSeq of Sym(o,(the
Sorts of A()) \/ V()) st for t being c-Term of A(),V() st t in rng p holds P[t]
holds P[Sym(o,(the Sorts of A()) \/ V())-tree p];

begin 

theorem 
  for t being Term of S,V ex s being SortSymbol of S st t in FreeSort (V, s);

theorem 
  for s being SortSymbol of S holds FreeSort (V, s) c= S-Terms V;

theorem 
  S-Terms V = Union FreeSort V;

definition
  let S, V, t;
  func the_sort_of t -> SortSymbol of S means


  t in FreeSort (V, it);
end;

theorem 
  for s being SortSymbol of S, v be Element of V.s st t =
  root-tree [v,s] holds the_sort_of t = s;

theorem 
  for t being c-Term of A,V for s being SortSymbol of S, x be set
  st x in (the Sorts of A).s & t = root-tree [x,s] holds the_sort_of t = s;

theorem 
  for t being c-Term of A,V for s being SortSymbol of S, v being Element
  of V.s st t = root-tree [v,s] holds the_sort_of t = s;

theorem 
  for o being OperSymbol of S st t.{} = [o,the carrier of S] holds
  the_sort_of t = the_result_sort_of o;

theorem 
  for A being non-empty MSAlgebra over S for s being SortSymbol of S, x
  being Element of (the Sorts of A).s holds the_sort_of (x-term (A,V)) = s;

theorem 
  for s being SortSymbol of S, v being Element of V.s holds
  the_sort_of (v-term A) = s;

theorem 
  for o being OperSymbol of S, p being ArgumentSeq of Sym(o,V)
  holds the_sort_of (Sym(o,V)-tree p qua Term of S,V) = the_result_sort_of o;

begin 

theorem 
  for o being OperSymbol of S, a being FinSequence of S-Terms V
  holds a is ArgumentSeq of Sym(o,V) iff Sym(o, V) ==> roots a;

theorem 
  for o being OperSymbol of S, a being ArgumentSeq of Sym(o,V)
holds len a = len the_arity_of o & dom a = dom the_arity_of o & for i being Nat
  st i in dom a holds a.i is Term of S,V;

theorem 
  for o being OperSymbol of S, a being ArgumentSeq of Sym(o,V) for i
  being Nat st i in dom a for t being Term of S,V st t = a.i holds t = (a qua
FinSequence of S-Terms V qua non empty set)/.i & the_sort_of t = (the_arity_of
  o).i & the_sort_of t = (the_arity_of o)/.i;

theorem 
  for o being OperSymbol of S, a being FinSequence st (len a = len
the_arity_of o or dom a = dom the_arity_of o) & ((for i being Nat st i in dom a
ex t being Term of S,V st t = a.i & the_sort_of t = (the_arity_of o).i) or for
i being Nat st i in dom a ex t being Term of S,V st t = a.i & the_sort_of t = (
  the_arity_of o)/.i) holds a is ArgumentSeq of Sym(o,V);

theorem 
  for o being OperSymbol of S, a being FinSequence of S-Terms V st (len
a = len the_arity_of o or dom a = dom the_arity_of o) & ((for i being Nat st i
in dom a for t being Term of S,V st t = a.i holds the_sort_of t = (the_arity_of
o).i) or for i being Nat st i in dom a for t being Term of S,V st t = a.i holds
  the_sort_of t = (the_arity_of o)/.i) holds a is ArgumentSeq of Sym(o,V);

theorem 
  for S being non void non empty ManySortedSign, V1,V2 being
non-empty ManySortedSet of the carrier of S st V1 c= V2 for t being Term of S,
  V1 holds t is Term of S, V2;

theorem 
  for S being non void non empty ManySortedSign, A being MSAlgebra over
  S, V being non-empty ManySortedSet of the carrier of S, t being Term of S, V
  holds t is c-Term of A, V;

begin 

definition
  let S be non void non empty ManySortedSign;
  let V be non-empty ManySortedSet of the carrier of S;
  mode CompoundTerm of S,V -> Term of S,V means

    it.{} in [:the carrier' of S, {the carrier of S}:];
end;

definition
  let S be non void non empty ManySortedSign;
  let V be non-empty ManySortedSet of the carrier of S;
  mode SetWithCompoundTerm of S,V -> non empty Subset of S-Terms V means

    ex t being CompoundTerm of S,V st t in it;
end;

theorem 
  t is not root implies t is CompoundTerm of S,V;

theorem 
  for p being Node of t holds t|p is Term of S,V;

definition
  let S be non void non empty ManySortedSign;
  let V be non-empty ManySortedSet of the carrier of S;
  let t be Term of S,V;
  let p be Node of t;
  redefine func t|p -> Term of S,V;
end;

begin 

definition
  let S be non void non empty ManySortedSign;
  let A be MSAlgebra over S;
  mode Variables of A -> non-empty ManySortedSet of the carrier of S means


     it misses the Sorts of A;
end;

theorem 
  for V being Variables of A for s being SortSymbol of S, x being
  set st x in (the Sorts of A).s for v being Element of V.s holds x <> v;

definition
  let S be non void non empty ManySortedSign;
  let A be non-empty MSAlgebra over S;
  let V be non-empty ManySortedSet of the carrier of S;
  let t be c-Term of A,V;
  let f be ManySortedFunction of V, the Sorts of A;
  let vt be finite DecoratedTree;
  pred vt is_an_evaluation_of t,f means


  dom vt = dom t & for p being
Node of vt holds (for s being SortSymbol of S, v being Element of V.s st t.p =
[v,s] holds vt.p = f.s.v) & (for s being SortSymbol of S, x being Element of (
the Sorts of A).s st t.p = [x,s] holds vt.p = x) & for o being OperSymbol of S
  st t.p = [o,the carrier of S] holds vt.p = Den(o, A).succ(vt,p);
end;

reserve S for non void non empty ManySortedSign,
  A for non-empty MSAlgebra over S,
  V for Variables of A,
  t for c-Term of A,V,
  f for ManySortedFunction of V, the Sorts of A;

theorem 
  for s being SortSymbol of S, x being Element of (the Sorts of A)
  .s st t = root-tree [x,s] holds root-tree x is_an_evaluation_of t,f;

theorem 
  for s being SortSymbol of S, v being Element of V.s st t =
  root-tree [v,s] holds root-tree (f.s.v) is_an_evaluation_of t,f;

theorem 
  for o being OperSymbol of S, p being ArgumentSeq of o,A,V for q
  being DTree-yielding FinSequence st len q = len p & for i being Nat, t being
c-Term of A,V st i in dom p & t = p.i ex vt being finite DecoratedTree st vt =
q.i & vt is_an_evaluation_of t,f ex vt being finite DecoratedTree st vt = (Den(
  o,A).roots q)-tree q & vt is_an_evaluation_of (Sym(o,(the Sorts of A) \/ V)
  -tree p qua c-Term of A,V), f;

theorem 
  for t being c-Term of A,V, e being finite DecoratedTree st e
is_an_evaluation_of t,f for p being Node of t, n being Node of e st n = p holds
  e|n is_an_evaluation_of t|p, f;

theorem 
  for o being OperSymbol of S, p being ArgumentSeq of o,A,V for vt
being finite DecoratedTree st vt is_an_evaluation_of (Sym(o,(the Sorts of A) \/
V)-tree p qua c-Term of A,V), f ex q being DTree-yielding FinSequence st len q
= len p & vt = (Den(o,A).roots q)-tree q & for i being Nat, t being c-Term of A
  ,V st i in dom p & t = p.i ex vt being finite DecoratedTree st vt = q.i & vt
  is_an_evaluation_of t,f;

theorem 
  ex vt being finite DecoratedTree st vt is_an_evaluation_of t,f;

theorem 
  for e1, e2 being finite DecoratedTree st e1 is_an_evaluation_of
  t,f & e2 is_an_evaluation_of t,f holds e1 = e2;

theorem 
  for vt being finite DecoratedTree st vt is_an_evaluation_of t,f
  holds vt.{} in (the Sorts of A).the_sort_of t;

definition
  let S be non void non empty ManySortedSign;
  let A be non-empty MSAlgebra over S;
  let V be Variables of A;
  let t be c-Term of A,V;
  let f be ManySortedFunction of V, the Sorts of A;
  func t@f -> Element of (the Sorts of A).the_sort_of t means


  ex vt being finite DecoratedTree st vt is_an_evaluation_of t,f & it = vt.{};
end;

reserve t for c-Term of A,V;

theorem 
  for vt being finite DecoratedTree st vt is_an_evaluation_of t,f
  holds t@f = vt.{};

theorem 
  for vt being finite DecoratedTree st vt is_an_evaluation_of t,f for p
  being Node of t holds vt.p = (t|p)@f;

theorem 
  for s being SortSymbol of S, x being Element of (the Sorts of A).s
  holds (x-term(A,V))@f = x;

theorem 
  for s being SortSymbol of S, v being Element of V.s holds (v-term A)@f
  = f.s.v;

theorem 
  for o being OperSymbol of S, p being ArgumentSeq of o,A,V for q being
FinSequence st len q = len p & for i being Nat st i in dom p for t being c-Term
  of A,V st t = p.i holds q.i = t@f holds (Sym(o,(the Sorts of A) \/ V)-tree p
  qua c-Term of A,V)@f = Den(o,A).q;














begin

definition
  let T be TopStruct;
  mode alpha-set of T -> Subset of T means


    it c= Int Cl Int it;
  let IT be Subset of T;
  attr IT is semi-open means


  IT c= Cl Int IT;
  attr IT is pre-open means


  IT c= Int Cl IT;
  attr IT is pre-semi-open means


  IT c= Cl Int Cl IT;
  attr IT is semi-pre-open means


  IT c= Cl Int IT \/ Int Cl IT;
end;

definition
  let T be TopStruct;
  let B be Subset of T;
  func sInt B -> Subset of T equals

  B /\ Cl Int B;
  func pInt B -> Subset of T equals

  B /\ Int Cl B;
  func alphaInt B -> Subset of T equals

  B /\ Int Cl Int B;
  func psInt B -> Subset of T equals

  B /\ Cl Int Cl B;
end;

definition
  let T be TopStruct;
  let B be Subset of T;
  func spInt B -> Subset of T equals

  sInt B \/ pInt B;
end;

definition
  let T be TopSpace;
  func T^alpha -> Subset-Family of T equals

  {B where B is Subset of T: B is
  alpha-set of T};
  func SO T -> Subset-Family of T equals

  {B where B is Subset of T : B is
  semi-open};
  func PO T -> Subset-Family of T equals

  {B where B is Subset of T : B is
  pre-open};
  func SPO T -> Subset-Family of T equals

  {B where B is Subset of T:B is
  semi-pre-open};
  func PSO T -> Subset-Family of T equals

  {B where B is Subset of T:B is
  pre-semi-open};
  func D(c,alpha)(T) -> Subset-Family of T equals

  {B where B is Subset of T:
  Int B = alphaInt B};
  func D(c,p)(T) -> Subset-Family of T equals

  {B where B is Subset of T: Int B
  = pInt B};
  func D(c,s)(T) -> Subset-Family of T equals

  {B where B is Subset of T: Int B
  = sInt B};
  func D(c,ps)(T) -> Subset-Family of T equals

  {B where B is Subset of T: Int
  B = psInt B};
  func D(alpha,p)(T) -> Subset-Family of T equals

  {B where B is Subset of T:
  alphaInt B = pInt B};
  func D(alpha,s)(T) -> Subset-Family of T equals

  {B where B is Subset of T:
  alphaInt B = sInt B};
  func D(alpha,ps)(T) -> Subset-Family of T equals

  {B where B is Subset of T:
  alphaInt B = psInt B};
  func D(p,sp)(T) -> Subset-Family of T equals

  {B where B is Subset of T: pInt
  B = spInt B};
  func D(p,ps)(T) -> Subset-Family of T equals

  {B where B is Subset of T: pInt
  B = psInt B};
  func D(sp,ps)(T) -> Subset-Family of T equals

  {B where B is Subset of T:
  spInt B = psInt B};
end;

reserve T for TopSpace,
  B for Subset of T;

theorem 
  alphaInt B = pInt B iff sInt B = psInt B;

theorem 
  B is alpha-set of T iff B = alphaInt B;

theorem 
  B is semi-open iff B = sInt B;

theorem 
  B is pre-open iff B = pInt B;

theorem 
  B is pre-semi-open iff B = psInt B;

theorem 
  B is semi-pre-open iff B = spInt B;

theorem 
  T^alpha /\ D(c,alpha)(T) = the topology of T;

theorem 
  SO T /\ D(c,s)(T) = the topology of T;

theorem 
  PO T /\ D(c,p)(T) = the topology of T;

theorem 
  PSO T /\ D(c,ps)(T) = the topology of T;

theorem 
  PO T /\ D(alpha,p)(T) = T^alpha;

theorem 
  SO T /\ D(alpha,s)(T) = T^alpha;

theorem 
  PSO T /\ D(alpha,ps)(T) = T^alpha;

theorem 
  SPO T /\ D(p,sp)(T) = PO T;

theorem 
  PSO T /\ D(p,ps)(T) = PO T;

theorem 
  PSO T /\ D(alpha,p)(T) = SO T;

theorem 
  PSO T /\ D(sp,ps)(T) = SPO T;

definition
  let X,Y be non empty TopSpace;
  let f be Function of X,Y;
  attr f is s-continuous means


  for G being Subset of Y st G is open holds f"G in SO X;
  attr f is p-continuous means


  for G being Subset of Y st G is open holds f"G in PO X;
  attr f is alpha-continuous means


  for G being Subset of Y st G is open holds f"G in X^alpha;
  attr f is ps-continuous means


  for G being Subset of Y st G is open holds f"G in PSO X;
  attr f is sp-continuous means


  for G being Subset of Y st G is open holds f"G in SPO X;
  attr f is (c,alpha)-continuous means


  for G being Subset of Y st G is open holds f"G in D(c,alpha)(X);
  attr f is (c,s)-continuous means


  for G being Subset of Y st G is open holds f"G in D(c,s)(X);
  attr f is (c,p)-continuous means


  for G being Subset of Y st G is open holds f"G in D(c,p)(X);
  attr f is (c,ps)-continuous means


  for G being Subset of Y st G is open holds f"G in D(c,ps)(X);
  attr f is (alpha,p)-continuous means


  for G being Subset of Y st G is open holds f"G in D(alpha,p)(X);
  attr f is (alpha,s)-continuous means


  for G being Subset of Y st G is open holds f"G in D(alpha,s)(X);
  attr f is (alpha,ps)-continuous means


  for G being Subset of Y st G is open holds f"G in D(alpha,ps)(X);
  attr f is (p,ps)-continuous means

  for G being Subset of Y st G is open holds f"G in D(p,ps)(X);
  attr f is (p,sp)-continuous means

  for G being Subset of Y st G is open holds f"G in D(p,sp)(X);
  attr f is (sp,ps)-continuous means

  for G being Subset of Y st G is open holds f"G in D(sp,ps)(X);
end;

reserve X,Y for non empty TopSpace;
reserve f for Function of X,Y;

theorem 
  f is alpha-continuous iff f is p-continuous (alpha,p)-continuous;

theorem 
  f is alpha-continuous iff f is s-continuous (alpha,s)-continuous;

theorem 
  f is alpha-continuous iff f is ps-continuous (alpha,ps)-continuous;

theorem 
  f is p-continuous iff f is sp-continuous (p,sp)-continuous;

theorem 
  f is p-continuous iff f is ps-continuous (p,ps)-continuous;

theorem 
  f is s-continuous iff f is ps-continuous (alpha,p)-continuous;

theorem 
  f is sp-continuous iff f is ps-continuous (sp,ps)-continuous;

theorem 
  f is continuous iff f is alpha-continuous (c,alpha)-continuous;

theorem 
  f is continuous iff f is s-continuous (c,s)-continuous;

theorem 
  f is continuous iff f is p-continuous (c,p)-continuous;

theorem 
  f is continuous iff f is ps-continuous (c,ps)-continuous;















begin

reserve U1,U2,U3 for Universal_Algebra,
  m,n for Nat,
  a for set,
  A for non empty set,
  h for Function of U1,U2;

theorem 
  for f,g be Function, C be set st rng f c= C holds (g|C)*f = g*f;

theorem 
  for I be set, C be Subset of I holds C* c= I*;

theorem 
  for f be Function, C be set st f is Function-yielding holds f|C is
  Function-yielding;

theorem 
  for I be set, C be Subset of I, M be ManySortedSet of I holds (M|
  C)# = M#|(C*);

definition
  let S,S9 be non empty ManySortedSign;
  pred S <= S9 means


  the carrier of S c= the carrier of S9 & the
carrier' of S c= the carrier' of S9 & (the Arity of S9)|the carrier' of S = the
  Arity of S & (the ResultSort of S9)|the carrier' of S = the ResultSort of S;
  reflexivity;
end;

theorem 
  for S,S9,S99 be non empty ManySortedSign st S <= S9 & S9 <= S99 holds
  S <= S99;

theorem 
  for S,S9 be strict non empty ManySortedSign st S <= S9 & S9 <= S holds S = S9
;

theorem 
  for g be Function, a be Element of A for k be Nat st 1 <= k & k <= n
  holds (a .--> g).((n |-> a)/.k) = g;

theorem 
  for I be set,I0 be Subset of I, A,B be ManySortedSet of I, F be
ManySortedFunction of A,B for A0,B0 be ManySortedSet of I0 st A0 = A | I0 & B0
  = B | I0 holds F|I0 is ManySortedFunction of A0,B0;

definition
  let S,S9 be strict non void non empty ManySortedSign;
  let A be non-empty strict MSAlgebra over S9;
  assume
 S <= S9;
  func A Over S -> non-empty strict MSAlgebra over S means


  the Sorts of
it = (the Sorts of A)|the carrier of S & the Charact of it = (the Charact of A)
  |the carrier' of S;
end;

theorem 
  for S be strict non void non empty ManySortedSign, A be non-empty
  strict MSAlgebra over S holds A = A Over S;

theorem 
  for U1,U2 st U1,U2 are_similar holds MSSign U1 = MSSign U2;

definition
  let U1,U2 be Universal_Algebra, h be Function of U1,U2;
  assume
 MSSign U1 = MSSign U2;
  func MSAlg h -> ManySortedFunction of MSAlg U1, ((MSAlg U2) Over MSSign U1)
  equals


  0 .--> h;
end;

theorem 
  for U1,U2,h st U1,U2 are_similar for o be OperSymbol of MSSign
  U1 holds ((MSAlg h).(the_result_sort_of o)) = h;

theorem 
  for o be OperSymbol of MSSign U1 holds Den(o,MSAlg U1) = (the
  charact of U1).o;

theorem 
  for o be OperSymbol of MSSign U1 holds Den(o,MSAlg U1) is operation of U1;

theorem 
  for o be OperSymbol of MSSign U1 for y be Element of Args(o,
  MSAlg U1) holds y is FinSequence of the carrier of U1;

theorem 
  for U1,U2,h st U1,U2 are_similar for o be OperSymbol of MSSign
  U1,y be Element of Args(o,MSAlg U1) holds (MSAlg h)#y = h * y;

theorem 
  h is_homomorphism U1,U2 implies MSAlg h is_homomorphism MSAlg U1
  ,(MSAlg U2 Over MSSign U1);

theorem 
  U1,U2 are_similar implies MSAlg h is ManySortedSet of {0};

theorem 
  h is_epimorphism U1, U2 implies MSAlg h is_epimorphism MSAlg U1,
  (MSAlg U2 Over MSSign U1);

theorem 
  h is_monomorphism U1, U2 implies MSAlg h is_monomorphism MSAlg
  U1,(MSAlg U2 Over MSSign U1);

theorem 
  h is_isomorphism U1,U2 implies MSAlg h is_isomorphism MSAlg U1,(MSAlg
  U2 Over MSSign U1);

theorem 
  for U1,U2,h st U1,U2 are_similar holds MSAlg h is_homomorphism
  MSAlg U1,(MSAlg U2 Over MSSign U1) implies h is_homomorphism U1,U2;

theorem 
  for U1,U2,h st U1, U2 are_similar holds MSAlg h is_epimorphism
  MSAlg U1, (MSAlg U2 Over MSSign U1) implies h is_epimorphism U1, U2;

theorem 
  for U1, U2, h st U1, U2 are_similar holds MSAlg h
  is_monomorphism MSAlg U1, (MSAlg U2 Over MSSign U1) implies h is_monomorphism
  U1, U2;

theorem 
  for U1, U2, h st U1, U2 are_similar holds MSAlg h is_isomorphism MSAlg
  U1, (MSAlg U2 Over MSSign U1) implies h is_isomorphism U1, U2;

theorem 
  MSAlg (id the carrier of U1) = (id the Sorts of MSAlg U1);

theorem 
  for U1,U2,U3 st U1,U2 are_similar & U2,U3 are_similar for h1 be
  Function of U1,U2, h2 be Function of U2,U3 holds (MSAlg h2) ** (MSAlg h1) =
  MSAlg (h2*h1);















begin



reserve UA for Universal_Algebra,
  f, g for Function of UA, UA;

theorem 
  id the carrier of UA is_isomorphism UA, UA;

definition
  let UA;
  func UAAut UA -> FUNCTION_DOMAIN of the carrier of UA, the carrier of UA
  means


  for h be Function of UA, UA holds h in it iff h is_isomorphism UA, UA;
end;

theorem 
  UAAut UA c= Funcs (the carrier of UA, the carrier of UA);

theorem 
  id the carrier of UA in UAAut UA;

theorem 
  for f, g st f is Element of UAAut UA & g = f" holds g is_isomorphism UA, UA;

theorem 
  for f be Element of UAAut UA holds f" in UAAut UA;

theorem 
  for f1, f2 be Element of UAAut UA holds f1 * f2 in UAAut UA;

definition
  let UA;
  func UAAutComp UA -> BinOp of UAAut UA means


  for x, y be Element of UAAut UA holds it.(x, y) = y * x;
end;

definition
  let UA;
  func UAAutGroup UA -> Group equals

  multMagma (# UAAut UA, UAAutComp UA #);
end;

registration
  let UA;
  cluster UAAutGroup UA -> strict;
end;

theorem 
  for x, y be Element of UAAutGroup UA for f, g be Element of UAAut UA
  st x = f & y = g holds x * y = g * f;

theorem 
  id the carrier of UA = 1_UAAutGroup UA;

theorem 
  for f be Element of UAAut UA for g be Element of UAAutGroup UA st f =
  g holds f" = g";

begin



reserve I for set,
  A, B, C for ManySortedSet of I;

theorem 
  A is_transformable_to B & B is_transformable_to C implies A
  is_transformable_to C;

theorem 
  for x be set, A be ManySortedSet of {x} holds A = x .--> A.x;

theorem 
  for A, B be non-empty ManySortedSet of I for F be
  ManySortedFunction of A, B st F is "1-1" "onto" holds F"" is "1-1" "onto";

theorem 
  for A, B be non-empty ManySortedSet of I for F be ManySortedFunction
  of A, B st F is "1-1" "onto" holds (F"")"" = F;

theorem 
  for F, G being Function-yielding Function st F is "1-1" & G is
  "1-1" holds G ** F is "1-1";

theorem 
  for B, C be non-empty ManySortedSet of I for F be
ManySortedFunction of A, B for G be ManySortedFunction of B, C st F is "onto" &
  G is "onto" holds G ** F is "onto";

theorem 
  for A, B, C be non-empty ManySortedSet of I for F be
  ManySortedFunction of A, B for G be ManySortedFunction of B, C st F is "1-1"
  "onto" & G is "1-1" "onto" holds (G ** F)"" = (F"") ** (G"");

theorem 
  for A, B be non-empty ManySortedSet of I for F be
ManySortedFunction of A, B for G be ManySortedFunction of B, A st F is "1-1" &
  F is "onto" & G ** F = id A holds G = F"";

theorem 
  A is_transformable_to B implies (Funcs)(A,B) is non-empty;

definition
  let I, A, B;
  assume
 A is_transformable_to B;
  func MSFuncs(A,B) -> non empty set equals


  product (Funcs)(A,B);
end;

theorem 
  A is_transformable_to B implies
  for x be set st x in MSFuncs(A,B) holds
  x is ManySortedFunction of A,B;

theorem 
  A is_transformable_to B implies
  for g be ManySortedFunction of A, B holds g in MSFuncs(A,B);

registration
  let I, A;
  cluster (Funcs)(A,A) -> non-empty;
end;

definition
  let I be set;
  let D be ManySortedSet of I;
  let A be non empty Subset of MSFuncs(D,D);
  redefine mode Element of A -> ManySortedFunction of D,D;
end;

registration
  let I,A;
  cluster id A -> "onto";
  cluster id A -> "1-1";
end;

begin



reserve S for non void non empty ManySortedSign,
  U1, U2 for non-empty MSAlgebra over S;

definition
  let S, U1, U2;
  mode MSFunctionSet of U1, U2 is
       non empty Subset of MSFuncs(the Sorts of U1, the Sorts of U2);
end;

theorem 
  id the Sorts of U1 in MSFuncs(the Sorts of U1, the Sorts of U1);

definition
  let S, U1;
  func MSAAut U1 -> MSFunctionSet of U1,U1 means


  for h be ManySortedFunction of U1, U1 holds h in it iff
  h is_isomorphism U1, U1;
end;

theorem 
  for f be Element of MSAAut U1 holds
  f in MSFuncs(the Sorts of U1, the Sorts of U1);

theorem 
  MSAAut U1 c= MSFuncs(the Sorts of U1, the Sorts of U1);

theorem 
  id the Sorts of U1 in MSAAut U1;

theorem 
  for f be Element of MSAAut U1 holds f"" in MSAAut U1;

theorem 
  for f1, f2 be Element of MSAAut U1 holds f1 ** f2 in MSAAut U1;

theorem 
  for F be ManySortedFunction of MSAlg UA, MSAlg UA
  for f be Element of UAAut UA st F = 0 .--> f holds F in MSAAut MSAlg UA;

definition
  let S, U1;
  func MSAAutComp U1 -> BinOp of MSAAut U1 means


  for x, y be Element of MSAAut U1 holds it.(x, y) = y ** x;
end;

definition
  let S, U1;
  func MSAAutGroup U1 -> Group equals

  multMagma (# MSAAut U1, MSAAutComp U1 #);
end;

registration
  let S, U1;
  cluster MSAAutGroup U1 -> strict;
end;

theorem 
  for x, y be Element of MSAAutGroup U1 for f, g be Element of MSAAut U1
  st x = f & y = g holds x * y = g ** f;

theorem 
  id the Sorts of U1 = 1_MSAAutGroup U1;

theorem 
  for f be Element of MSAAut U1 for g be Element of MSAAutGroup U1 st
  f = g holds f"" = g";

begin



theorem 
  for UA1, UA2 be Universal_Algebra st UA1, UA2 are_similar
  for F be ManySortedFunction of MSAlg UA1, (MSAlg UA2 Over MSSign UA1) holds
  F.0 is Function of UA1, UA2;

theorem 
  for f be Element of UAAut UA holds
  0 .--> f is ManySortedFunction of MSAlg UA, MSAlg UA;

theorem 
  for h be Function st (dom h = UAAut UA & for x be set st x in
  UAAut UA holds h.x = 0 .--> x) holds h is Homomorphism of UAAutGroup UA,
  MSAAutGroup (MSAlg UA);

theorem 
  for h be Homomorphism of UAAutGroup UA, MSAAutGroup (MSAlg UA)
  st for x be set st x in UAAut UA holds h.x = 0 .--> x holds h is bijective;

theorem 
  UAAutGroup UA, MSAAutGroup (MSAlg UA) are_isomorphic;















begin





definition
  let S be non void Circuit-like non empty ManySortedSign;
  mode Circuit of S is finite-yielding MSAlgebra over S;
end;

reserve IIG for Circuit-like non void non empty ManySortedSign;

definition
  let IIG;
  let SCS be non-empty Circuit of IIG;
  func Set-Constants SCS -> ManySortedSet of SortsWithConstants IIG means


   for
 x being Vertex of IIG st x in dom it holds it.x in Constants (SCS, x);
end;

theorem 
  for IIG for SCS being non-empty Circuit of IIG, v being Vertex of IIG,
  e being Element of (the Sorts of SCS).v st v in SortsWithConstants IIG & e in
  Constants (SCS, v) holds (Set-Constants SCS).v = e;

definition
  let IIG;
  let CS be Circuit of IIG;
  mode InputFuncs of CS is ManySortedFunction of ((InputVertices IIG) --> NAT
qua ManySortedSet of InputVertices IIG), ((the Sorts of CS) | InputVertices IIG
    qua ManySortedSet of InputVertices IIG);
end;

theorem 
  for IIG for SCS being non-empty Circuit of IIG, InpFs being
InputFuncs of SCS, n being Element of NAT st IIG is with_input_V holds (commute
  InpFs).n is InputValues of SCS;

definition
  let IIG such that
 IIG is with_input_V;
  let SCS be non-empty Circuit of IIG, InpFs be InputFuncs of SCS, n be
  Element of NAT;
  func n-th_InputValues InpFs -> InputValues of SCS equals

  (commute InpFs).n;
end;

definition
  let IIG;
  let SCS be Circuit of IIG;
  mode State of SCS is Element of product (the Sorts of SCS);
end;

theorem 
  for IIG for SCS being non-empty Circuit of IIG, s being State of SCS
  holds dom s = the carrier of IIG;

theorem 
  for IIG for SCS being non-empty Circuit of IIG, s being State of SCS,
  v being Vertex of IIG holds s.v in (the Sorts of SCS).v;

definition
  let IIG;
  let SCS be non-empty Circuit of IIG, s be State of SCS, o be OperSymbol of
  IIG;
  func o depends_on_in s -> Element of Args (o, SCS) equals

  s * (the_arity_of
  o);
end;

reserve IIG for monotonic Circuit-like non void non empty ManySortedSign;

theorem 
  for IIG for SCS being finite-yielding non-empty MSAlgebra over
IIG, v, w being Vertex of IIG, e1 being Element of (the Sorts of FreeEnv SCS).v
  , q1 being DTree-yielding FinSequence st v in InnerVertices IIG & e1 = [
  action_at v,the carrier of IIG]-tree q1 holds for k being Element of NAT st k
  in dom q1 & q1.k in (the Sorts of FreeEnv SCS).w holds w = (the_arity_of
  action_at v)/.k;

registration
  let IIG;
  let SCS be finite-yielding non-empty MSAlgebra over IIG, v be Vertex of IIG;
  cluster -> finite non empty Function-like Relation-like for Element of (the
    Sorts of FreeEnv SCS).v;
end;

registration
  let IIG;
  let SCS be finite-yielding non-empty MSAlgebra over IIG, v be Vertex of IIG;
  cluster -> DecoratedTree-like for Element of (the Sorts of FreeEnv SCS).v;
end;

theorem 
  for IIG for SCS being finite-yielding non-empty MSAlgebra over
IIG, v, w being Vertex of IIG, e1 being Element of (the Sorts of FreeEnv SCS).v
  , e2 being Element of (the Sorts of FreeEnv SCS).w, q1 being DTree-yielding
  FinSequence, k1 being Element of NAT st v in InnerVertices IIG \
  SortsWithConstants IIG & e1 = [action_at v,the carrier of IIG]-tree q1 & k1+1
in dom q1 & q1.(k1+1) in (the Sorts of FreeEnv SCS).w holds e1 with-replacement
  (<*k1*>,e2) in (the Sorts of FreeEnv SCS).v;

theorem 
  for IIG for A being finite-yielding non-empty MSAlgebra over IIG,
  v being Element of IIG, e being Element of (the Sorts of FreeEnv A).v st 1 <
  card e ex o being OperSymbol of IIG st e.{} = [o,the carrier of IIG];

theorem 
  for IIG being non void Circuit-like non empty ManySortedSign for SCS
being non-empty Circuit of IIG, s being State of SCS, o being OperSymbol of IIG
  holds (Den(o,SCS)).(o depends_on_in s) in (the Sorts of SCS).(
  the_result_sort_of o);

theorem 
  for IIG for A being non-empty Circuit of IIG, v being Vertex of
  IIG, e being Element of (the Sorts of FreeEnv A).v st e.{} = [action_at v,the
  carrier of IIG] ex p being DTree-yielding FinSequence st e = [action_at v,the
  carrier of IIG]-tree p;

begin 

registration
  let IIG be monotonic non void non empty ManySortedSign;
  let A be finite-yielding non-empty MSAlgebra over IIG;
  let v be SortSymbol of IIG;
  cluster (the Sorts of FreeEnv A).v -> finite;
end;

definition
  let IIG;
  let A be finite-yielding non-empty MSAlgebra over IIG;
  let v be SortSymbol of IIG;
  func size(v,A) -> Nat means


  ex s being finite non empty
Subset of NAT st s = { card t where t is Element of (the Sorts of FreeEnv A).v
  : not contradiction } & it = max s;
end;

theorem 
  for IIG for A being finite-yielding non-empty MSAlgebra over IIG
  , v being Element of IIG holds size(v,A) = 1 iff v in InputVertices IIG \/
  SortsWithConstants IIG;

theorem 
  for IIG for SCS being finite-yielding non-empty MSAlgebra over IIG, v,
  w being Vertex of IIG, e1 being Element of (the Sorts of FreeEnv SCS).v, e2
  being Element of (the Sorts of FreeEnv SCS).w, q1 being DTree-yielding
FinSequence st v in InnerVertices IIG \ SortsWithConstants IIG & card e1 = size
  (v,SCS) & e1 = [action_at v,the carrier of IIG]-tree q1 & e2 in rng q1 holds
  card e2 = size(w,SCS);

theorem 
  for IIG for A being finite-yielding non-empty MSAlgebra over IIG
, v being Vertex of IIG, e being Element of (the Sorts of FreeEnv A).v st v in
  (InnerVertices IIG \ SortsWithConstants IIG) & card e = size(v,A) ex q being
  DTree-yielding FinSequence st e = [action_at v,the carrier of IIG]-tree q;

theorem 
  for IIG for A being finite-yielding non-empty MSAlgebra over IIG, v
  being Vertex of IIG, e being Element of (the Sorts of FreeEnv A).v st v in (
  InnerVertices IIG \ SortsWithConstants IIG) & card e = size(v,A) ex o being
  OperSymbol of IIG st e.{} = [o,the carrier of IIG];

definition
  let S be non void non empty ManySortedSign, A be finite-yielding non-empty
MSAlgebra over S, v be SortSymbol of S, e be Element of (the Sorts of FreeEnv A
  ).v;
  func depth e -> Element of NAT means


  ex e9 being Element of (the
  Sorts of FreeMSA the Sorts of A).v st e = e9 & it = depth e9;
end;

theorem 
  for IIG for A being finite-yielding non-empty MSAlgebra over IIG
  , v, w being Element of IIG st v in InnerVertices IIG & w in rng the_arity_of
  action_at v holds size(w,A) < size(v,A);

theorem 
  for IIG for A being finite-yielding non-empty MSAlgebra over IIG
  , v being SortSymbol of IIG holds size(v,A) > 0;

theorem 
  for IIG for A being non-empty Circuit of IIG, v being Vertex of IIG, e
being Element of (the Sorts of FreeEnv A).v, p being DTree-yielding FinSequence
st v in InnerVertices IIG & e = [action_at v,the carrier of IIG]-tree p & for k
being Element of NAT st k in dom p ex ek being Element of (the Sorts of FreeEnv
A) .((the_arity_of action_at v)/.k) st ek = p.k & card ek = size ((the_arity_of
  action_at v)/.k, A) holds card e = size(v,A);

begin 

definition
  let S be monotonic non void non empty ManySortedSign, A be finite-yielding
  non-empty MSAlgebra over S, v be SortSymbol of S;
  func depth(v,A) -> Nat means


  ex s being finite non empty
Subset of NAT st s = { depth t where t is Element of (the Sorts of FreeEnv A).v
  : not contradiction } & it = max s;
end;

definition
  let IIG be finite monotonic Circuit-like non void non empty ManySortedSign
  , A be non-empty Circuit of IIG;
  func depth A -> Nat means


  ex Ds being finite non empty
Subset of NAT st Ds = { depth(v,A) where v is Element of IIG : v in the carrier
  of IIG } & it = max Ds;
end;

theorem 
  for IIG being finite monotonic Circuit-like non void non empty
ManySortedSign, A being non-empty Circuit of IIG, v being Vertex of IIG holds
  depth(v,A) <= depth A;

theorem 
  for IIG for A being non-empty Circuit of IIG, v being Vertex of
IIG holds depth(v,A) = 0 iff v in InputVertices IIG or v in SortsWithConstants
  IIG;

theorem 
  for IIG for A being finite-yielding non-empty MSAlgebra over IIG, v,
  v1 being SortSymbol of IIG st v in InnerVertices IIG & v1 in rng the_arity_of
  action_at v holds depth(v1,A) < depth(v,A);














begin 

reserve S for non void non empty ManySortedSign,
  U1, U2, U3 for non-empty MSAlgebra over S,
  I for set,
  A for ManySortedSet of I,
  B, C for non-empty ManySortedSet of I;

begin 

theorem 
  for F be ManySortedFunction of A, B for X be ManySortedSubset of A st
  A c= X holds F || X = F;

theorem 
  for A, B be ManySortedSet of I for M be ManySortedSubset of A for F be
  ManySortedFunction of A, B holds F.:.:M c= F.:.:A;

theorem 
  for F be ManySortedFunction of A, B for M1, M2 be ManySortedSubset of
  A st M1 c= M2 holds (F||M2).:.:M1 = F.:.:M1;

theorem 
  for F be ManySortedFunction of A, B for G be ManySortedFunction
  of B, C for X be ManySortedSubset of A holds (G ** F) || X = G ** (F || X);

theorem 
  for A, B be ManySortedSet of I st A is_transformable_to B for F be
ManySortedFunction of A, B for C be ManySortedSet of I st B is ManySortedSubset
  of C holds F is ManySortedFunction of A, C;

theorem 
  for F be ManySortedFunction of A, B for X be ManySortedSubset of A
  holds F is "1-1" implies F || X is "1-1";

begin 

theorem 
  for F be ManySortedFunction of A, B for X be ManySortedSubset of A
  holds doms (F || X) c= doms F;

theorem 
  for F be ManySortedFunction of A, B for X be ManySortedSubset of A
  holds rngs (F || X) c= rngs F;

theorem 
  for A, B be ManySortedSet of I for F be ManySortedFunction of A, B
  holds F is "onto" iff rngs F = B;

theorem 
  for X be non-empty ManySortedSet of the carrier of S holds rngs Reverse X = X
;

theorem 
  for F be ManySortedFunction of A, B for G be ManySortedFunction of B,
C for X be non-empty ManySortedSubset of B st rngs F c= X holds (G || X) ** F =
  G ** F;

begin 

theorem 
  for F be ManySortedFunction of A, B holds F is "onto" iff for C
  for G, H be ManySortedFunction of B, C st G**F = H**F holds G = H;

theorem 
  for F be ManySortedFunction of A, B st A is non-empty holds F is
"1-1" iff for C be ManySortedSet of I for G, H be ManySortedFunction of C, A st
  F**G = F**H holds G = H;

begin 

theorem 
  for X be non-empty ManySortedSet of the carrier of S for h1, h2
be ManySortedFunction of FreeMSA X, U1 st h1 is_homomorphism FreeMSA X, U1 & h2
is_homomorphism FreeMSA X, U1 & h1 || FreeGen (X) = h2 || FreeGen (X) holds h1
  = h2;

theorem 
  for F be ManySortedFunction of U1, U2 st F is_epimorphism U1, U2 for
U3 be non-empty MSAlgebra over S for h1, h2 be ManySortedFunction of U2, U3 st
  h1**F = h2**F holds h1 = h2;

theorem 
  for F be ManySortedFunction of U2, U3 st F is_homomorphism U2, U3
holds F is_monomorphism U2, U3 iff for U1 be non-empty MSAlgebra over S for h1,
  h2 be ManySortedFunction of U1, U2 st h1 is_homomorphism U1, U2 & h2
  is_homomorphism U1, U2 holds (F**h1 = F**h2 implies h1 = h2);

registration
  let S, U1;
  cluster non-empty for GeneratorSet of U1;
end;

theorem 
  for U1 being MSAlgebra over S for A, B being MSSubset of U1 st A is
  ManySortedSubset of B holds GenMSAlg A is MSSubAlgebra of GenMSAlg B;

theorem 
  for U1 being MSAlgebra over S, U2 being MSSubAlgebra of U1 for B1
  being MSSubset of U1, B2 being MSSubset of U2 st B1 = B2 holds GenMSAlg B1 =
  GenMSAlg B2;

theorem 
  for U1 being non-empty MSAlgebra over S for U2 being non-empty
  MSAlgebra over S for Gen being GeneratorSet of U1 for h1, h2 being
ManySortedFunction of U1, U2 st h1 is_homomorphism U1, U2 & h2 is_homomorphism
  U1, U2 & h1 || Gen = h2 || Gen holds h1 = h2;














begin

reserve IIG for monotonic Circuit-like non void non empty ManySortedSign;

theorem 
  for X being non-empty ManySortedSet of the carrier of IIG, H
  being ManySortedFunction of FreeMSA X, FreeMSA X, HH being Function-yielding
  Function, v being SortSymbol of IIG, p being DTree-yielding FinSequence, t
  being Element of (the Sorts of FreeMSA X).v st v in InnerVertices IIG & t = [
action_at v,the carrier of IIG]-tree p & H is_homomorphism FreeMSA X, FreeMSA X
& HH = H * the_arity_of action_at v ex HHp being DTree-yielding FinSequence st
  HHp = HH..p & H.v.t = [action_at v,the carrier of IIG]-tree HHp;

definition
  let IIG;
  let SCS be non-empty Circuit of IIG, s be State of SCS, iv be InputValues of
  SCS;
  redefine func s +* iv -> State of SCS;
end;

definition
  let IIG;
  let A be non-empty Circuit of IIG, iv be InputValues of A;
  func Fix_inp iv -> ManySortedFunction of FreeGen the Sorts of A, the Sorts
  of FreeEnv A means


  for v being Vertex of IIG holds (v in InputVertices
  IIG implies it.v = FreeGen(v, the Sorts of A) --> root-tree[iv.v, v]) & (v in
SortsWithConstants IIG implies it.v = FreeGen(v, the Sorts of A) --> root-tree
  [action_at v,the carrier of IIG]) & (v in (InnerVertices IIG \
  SortsWithConstants IIG) implies it.v = id FreeGen(v, the Sorts of A));
end;

definition
  let IIG;
  let A be non-empty Circuit of IIG, iv be InputValues of A;
  func Fix_inp_ext iv -> ManySortedFunction of FreeEnv A, FreeEnv A means


   it is_homomorphism FreeEnv A, FreeEnv A & Fix_inp iv c= it;
end;

theorem 
  for A being non-empty Circuit of IIG, iv being InputValues of A,
  v being Vertex of IIG, e being Element of (the Sorts of FreeEnv A).v, x being
  set st v in InnerVertices IIG \ SortsWithConstants IIG & e = root-tree[x,v]
  holds (Fix_inp_ext iv).v.e = e;

theorem 
  for A being non-empty Circuit of IIG, iv being InputValues of A,
  v being Vertex of IIG, x being Element of (the Sorts of A).v st v in
InputVertices IIG holds (Fix_inp_ext iv).v.(root-tree[x,v]) = root-tree[iv.v,v]
;

theorem 
  for A being non-empty Circuit of IIG, iv being InputValues of A,
  v being Vertex of IIG, e being Element of (the Sorts of FreeEnv A).v, p, q
being DTree-yielding FinSequence st v in InnerVertices IIG & e = [action_at v,
the carrier of IIG]-tree p & dom p = dom q & for k being Element of NAT st k in
dom p holds q.k = (Fix_inp_ext iv).((the_arity_of action_at v)/.k).(p.k) holds
  (Fix_inp_ext iv).v.e = [action_at v,the carrier of IIG]-tree q;

theorem 
  for A being non-empty Circuit of IIG, iv being InputValues of A,
  v being Vertex of IIG, e being Element of (the Sorts of FreeEnv A).v st v in
  SortsWithConstants IIG holds (Fix_inp_ext iv).v.e = root-tree[action_at v,the
  carrier of IIG];

theorem 
  for A being non-empty Circuit of IIG, iv being InputValues of A,
v being Vertex of IIG, e, e1 being Element of (the Sorts of FreeEnv A).v, t, t1
being DecoratedTree st t = e & t1 = e1 & e1 = (Fix_inp_ext iv).v.e holds dom t
  = dom t1;

theorem 
  for A being non-empty Circuit of IIG, iv being InputValues of A,
v being Vertex of IIG, e, e1 being Element of (the Sorts of FreeEnv A).v st e1
  = (Fix_inp_ext iv).v.e holds card e = card e1;

definition
  let IIG;
  let SCS be non-empty Circuit of IIG, v be Vertex of IIG, iv be InputValues
  of SCS;
  func IGTree(v,iv) -> Element of (the Sorts of FreeEnv SCS).v means


  ex
e being Element of (the Sorts of FreeEnv SCS).v st card e = size(v,SCS) & it =
  (Fix_inp_ext iv).v.e;
end;

theorem 
  for SCS being non-empty Circuit of IIG, v being Vertex of IIG, iv
  being InputValues of SCS holds IGTree(v,iv) = (Fix_inp_ext iv).v.IGTree(v,iv)
;

theorem 
  for SCS being non-empty Circuit of IIG, v being Vertex of IIG, iv
  being InputValues of SCS, p being DTree-yielding FinSequence st v in
InnerVertices IIG & dom p = dom the_arity_of action_at v & for k being Element
  of NAT st k in dom p holds p.k = IGTree((the_arity_of action_at v)/.k, iv)
  holds IGTree(v,iv) = [action_at v,the carrier of IIG]-tree p;

definition
  let IIG;
  let SCS be non-empty Circuit of IIG, v be Vertex of IIG, iv be InputValues
  of SCS;
  func IGValue(v,iv) -> Element of (the Sorts of SCS).v equals

  (Eval SCS).v.(
  IGTree(v,iv));
end;

theorem 
  for SCS being non-empty Circuit of IIG, v being Vertex of IIG,
iv being InputValues of SCS st v in InputVertices IIG holds IGValue(v,iv) = iv.
  v;

theorem 
  for SCS being non-empty Circuit of IIG, v being Vertex of IIG,
iv being InputValues of SCS st v in SortsWithConstants IIG holds IGValue(v,iv)
  = (Set-Constants SCS).v;

begin





definition
  let IIG be Circuit-like non void non empty ManySortedSign;
  let SCS be non-empty Circuit of IIG, s be State of SCS;
  func Following s -> State of SCS means


  for v being Vertex of IIG
  holds (v in InputVertices IIG implies it.v = s.v) & (v in InnerVertices IIG
  implies it.v = (Den(action_at v,SCS)).(action_at v depends_on_in s));
end;

theorem 
  for SCS being non-empty Circuit of IIG, s being State of SCS, iv
  being InputValues of SCS st iv c= s holds iv c= Following s;

definition
  let IIG be Circuit-like non void non empty ManySortedSign;
  let SCS be non-empty Circuit of IIG;
  let IT be State of SCS;
  attr IT is stable means


  IT = Following IT;
end;

definition
  let IIG;
  let SCS be non-empty Circuit of IIG, s be State of SCS, iv be InputValues of
  SCS;
  func Following(s,iv) -> State of SCS equals

  Following(s+*iv);
end;

definition
  let IIG;
  let SCS be non-empty Circuit of IIG, InpFs be InputFuncs of SCS, s be State
  of SCS;
  func InitialComp(s,InpFs) -> State of SCS equals

  s +* (0-th_InputValues
  InpFs) +* Set-Constants SCS;
end;

definition
  let IIG;
  let SCS be non-empty Circuit of IIG, InpFs be InputFuncs of SCS, s be State
  of SCS;
  func Computation(s,InpFs) -> Function of NAT, (product the Sorts of SCS)
  means


  it.0 = InitialComp(s,InpFs) & for i being Nat holds it.(i+1) =
  Following(it.i,(i+1)-th_InputValues InpFs);
end;

reserve SCS for non-empty Circuit of IIG;
reserve s for State of SCS;
reserve iv for InputValues of SCS;

theorem 
  for k being Element of NAT st for v being Vertex of IIG st depth
  (v,SCS) <= k holds s.v = IGValue(v,iv) holds for v1 being Vertex of IIG st
  depth(v1,SCS) <= k+1 holds (Following s).v1 = IGValue(v1,iv);

reserve IIG for finite monotonic Circuit-like non void non empty
  ManySortedSign;
reserve SCS for non-empty Circuit of IIG;
reserve InpFs for InputFuncs of SCS;
reserve s for State of SCS;
reserve iv for InputValues of SCS;

theorem 
  commute InpFs is constant & InputVertices IIG is non empty
implies for s, iv st iv = (commute InpFs).0 for k being Element of NAT holds iv
  c= (Computation(s,InpFs)).k;

theorem 
  for n being Element of NAT st commute InpFs is constant &
InputVertices IIG is non empty & (Computation(s,InpFs)).n is stable for m being
Element of NAT st n <= m holds (Computation(s,InpFs)).n = (Computation(s,InpFs)
  ).m;

theorem 
  commute InpFs is constant & InputVertices IIG is non empty
implies for s, iv st iv = (commute InpFs).0 for k being Element of NAT, v being
Vertex of IIG st depth(v,SCS) <= k holds ((Computation(s,InpFs)).k qua Element
  of product the Sorts of SCS).v = IGValue(v,iv);

theorem 
  commute InpFs is constant & InputVertices IIG is non empty & iv
= (commute InpFs).0 implies for s being State of SCS, v being Vertex of IIG, n
being Element of NAT st n = depth SCS holds ((Computation(s,InpFs)).n qua State
  of SCS).v = IGValue(v,iv);

theorem 
  commute InpFs is constant & InputVertices IIG is non empty implies for
s being State of SCS, n be Element of NAT st n = depth SCS holds (Computation(s
  ,InpFs)).n is stable;

theorem 
  commute InpFs is constant & InputVertices IIG is non empty implies for
  s1, s2 being State of SCS holds (Computation(s1,InpFs)).(depth SCS) = (
  Computation(s2,InpFs)).(depth SCS);














begin 

definition
  let S be ManySortedSign;
  mode Gate of S is Element of the carrier' of S;
end;

registration
  let A,B be set;
  let f be ManySortedSet of A;
  let g be ManySortedSet of B;
  cluster f+*g -> A \/ B-defined;
end;

registration
  let A,B be set;
  let f be ManySortedSet of A;
  let g be ManySortedSet of B;
  cluster f+*g -> total for A \/ B-defined Function;
end;

registration
  let A,B be set;
  cluster A .--> B -> {A}-defined;
end;

registration
  let A,B be set;
  cluster A .--> B -> total for {A}-defined Function;
end;

registration
  let A be set, B be non empty set;
  cluster A .--> B -> non-empty;
end;

theorem 
  for A,B being set, f being ManySortedSet of A for g being
  ManySortedSet of B st f c= g holds f# c= g#;

theorem 
  for X being set, Y being non empty set, p being FinSequence of X
  holds (X --> Y)#.p = (len p)-tuples_on Y;

definition
  let A be set;
  let f1,g1 be non-empty ManySortedSet of A;
  let B be set;
  let f2,g2 be non-empty ManySortedSet of B;
  let h1 be ManySortedFunction of f1,g1;
  let h2 be ManySortedFunction of f2,g2;
  redefine func h1+*h2 -> ManySortedFunction of f1+*f2, g1+*g2;
end;

definition
  let S1,S2 be ManySortedSign;
  pred S1 tolerates S2 means

  the Arity of S1 tolerates the Arity of S2 & the
  ResultSort of S1 tolerates the ResultSort of S2;
  reflexivity;
  symmetry;
end;

definition
  let S1,S2 be non empty ManySortedSign;
  func S1 +* S2 -> strict non empty ManySortedSign means


  the carrier of
  it = (the carrier of S1) \/ (the carrier of S2) & the carrier' of it = (the
  carrier' of S1) \/ (the carrier' of S2) & the Arity of it = (the Arity of S1)
  +* (the Arity of S2) & the ResultSort of it = (the ResultSort of S1) +* (the
  ResultSort of S2);
end;

theorem 
  for S1,S2,S3 being non empty ManySortedSign st S1 tolerates S2 &
  S2 tolerates S3 & S3 tolerates S1 holds S1+*S2 tolerates S3;

theorem 
  for S being non empty ManySortedSign holds S+*S = the ManySortedSign of S;

theorem 
  for S1,S2 being non empty ManySortedSign st S1 tolerates S2 holds
  S1+*S2 = S2+*S1;

theorem 
  for S1,S2,S3 being non empty ManySortedSign holds (S1+*S2)+*S3 = S1+*(
  S2+*S3 );

theorem 
  for f being one-to-one Function for S1,S2 being Circuit-like non
empty ManySortedSign st the ResultSort of S1 c= f & the ResultSort of S2 c= f
  holds S1+*S2 is Circuit-like;

theorem 
  for S1,S2 being Circuit-like non empty ManySortedSign st
  InnerVertices S1 misses InnerVertices S2 holds S1+*S2 is Circuit-like;

theorem 
  for S1,S2 being non empty ManySortedSign st S1 is not void or S2
  is not void holds S1+*S2 is non void;

theorem 
  for S1,S2 being finite non empty ManySortedSign holds S1+*S2 is finite;

registration
  let S1 be non void non empty ManySortedSign;
  let S2 be non empty ManySortedSign;
  cluster S1 +* S2 -> non void;
  cluster S2 +* S1 -> non void;
end;







theorem 
  for S1,S2 being non empty ManySortedSign st S1 tolerates S2
  holds InnerVertices (S1+*S2) = (InnerVertices S1) \/ (InnerVertices S2) &
  InputVertices (S1+*S2) c= (InputVertices S1) \/ (InputVertices S2);

theorem 
  for S1,S2 being non empty ManySortedSign for v2 being Vertex of
  S2 st v2 in InputVertices (S1+*S2) holds v2 in InputVertices S2;

theorem 
  for S1,S2 being non empty ManySortedSign st S1 tolerates S2 for
v1 being Vertex of S1 st v1 in InputVertices (S1+*S2) holds v1 in InputVertices
  S1;

theorem 
  for S1 being non empty ManySortedSign, S2 being non void non
empty ManySortedSign for o2 being OperSymbol of S2, o being OperSymbol of S1+*
  S2 st o2 = o holds the_arity_of o = the_arity_of o2 & the_result_sort_of o =
  the_result_sort_of o2;

theorem 
  for S1 being non empty ManySortedSign, S2,S being Circuit-like
non void non empty ManySortedSign st S = S1+*S2 for v2 being Vertex of S2 st
  v2 in InnerVertices S2 for v being Vertex of S st v2 = v holds v in
  InnerVertices S & action_at v = action_at v2;

theorem 
  for S1 being non void non empty ManySortedSign, S2 being non
empty ManySortedSign st S1 tolerates S2 for o1 being OperSymbol of S1, o being
  OperSymbol of S1+*S2 st o1 = o holds the_arity_of o = the_arity_of o1 &
  the_result_sort_of o = the_result_sort_of o1;

theorem 
  for S1,S being Circuit-like non void non empty ManySortedSign,
S2 being non empty ManySortedSign st S1 tolerates S2 & S = S1+*S2 for v1 being
Vertex of S1 st v1 in InnerVertices S1 for v being Vertex of S st v1 = v holds
  v in InnerVertices S & action_at v = action_at v1;

begin 

definition
  let S1,S2 be non empty ManySortedSign;
  let A1 be MSAlgebra over S1;
  let A2 be MSAlgebra over S2;
  pred A1 tolerates A2 means


  S1 tolerates S2 & the Sorts of A1
  tolerates the Sorts of A2 & the Charact of A1 tolerates the Charact of A2;
end;

definition
  let S1,S2 be non empty ManySortedSign;
  let A1 be non-empty MSAlgebra over S1;
  let A2 be non-empty MSAlgebra over S2;
  assume
 the Sorts of A1 tolerates the Sorts of A2;
  func A1 +* A2 -> strict non-empty MSAlgebra over S1+*S2 means


  the Sorts of it = (the Sorts of A1) +* (the Sorts of A2) &
  the Charact of it = (the Charact of A1) +* (the Charact of A2);
end;

theorem 
  for S being non void non empty ManySortedSign, A being MSAlgebra over
  S holds A tolerates A;

theorem 
  for S1,S2 be non void non empty ManySortedSign for A1 be
  MSAlgebra over S1, A2 be MSAlgebra over S2 st A1 tolerates A2 holds A2
  tolerates A1;

theorem 
  for S1,S2,S3 being non empty ManySortedSign, A1 being non-empty
  MSAlgebra over S1, A2 being non-empty MSAlgebra over S2, A3 being MSAlgebra
  over S3 st A1 tolerates A2 & A2 tolerates A3 & A3 tolerates A1 holds A1+*A2
  tolerates A3;

theorem 
  for S being strict non empty ManySortedSign, A being non-empty
  MSAlgebra over S holds A+*A = the MSAlgebra of A;

theorem 
  for S1,S2 being non empty ManySortedSign, A1 being non-empty
  MSAlgebra over S1, A2 being non-empty MSAlgebra over S2 st A1 tolerates A2
  holds A1+*A2 = A2+*A1;

theorem 
  for S1,S2,S3 being non empty ManySortedSign, A1 being non-empty
  MSAlgebra over S1, A2 being non-empty MSAlgebra over S2, A3 being non-empty
  MSAlgebra over S3 st the Sorts of A1 tolerates the Sorts of A2 & the Sorts of
A2 tolerates the Sorts of A3 & the Sorts of A3 tolerates the Sorts of A1 holds
  (A1+*A2)+*A3 = A1+*(A2+*A3);

theorem 
  for S1,S2 being non empty ManySortedSign for A1 being finite-yielding
  non-empty MSAlgebra over S1 for A2 being finite-yielding non-empty MSAlgebra
  over S2 st the Sorts of A1 tolerates the Sorts of A2 holds A1+*A2 is
  finite-yielding;

theorem 
  for S1,S2 being non empty ManySortedSign for A1 being non-empty
  MSAlgebra over S1, s1 being Element of product the Sorts of A1 for A2 being
non-empty MSAlgebra over S2, s2 being Element of product the Sorts of A2 st the
Sorts of A1 tolerates the Sorts of A2 holds s1+*s2 in product the Sorts of A1+*
  A2;

theorem 
  for S1,S2 being non empty ManySortedSign for A1 being non-empty
  MSAlgebra over S1, A2 being non-empty MSAlgebra over S2 st the Sorts of A1
  tolerates the Sorts of A2 for s being Element of product the Sorts of A1+*A2
  holds s|the carrier of S1 in product the Sorts of A1 & s|the carrier of S2 in
  product the Sorts of A2;

theorem 
  for S1,S2 being non void non empty ManySortedSign for A1 being
non-empty MSAlgebra over S1, A2 being non-empty MSAlgebra over S2 st the Sorts
  of A1 tolerates the Sorts of A2 for o being OperSymbol of S1+*S2, o2 being
  OperSymbol of S2 st o = o2 holds Den(o, A1+*A2) = Den(o2, A2);

theorem 
  for S1,S2 being non void non empty ManySortedSign for A1 being
non-empty MSAlgebra over S1, A2 being non-empty MSAlgebra over S2 st the Sorts
of A1 tolerates the Sorts of A2 & the Charact of A1 tolerates the Charact of A2
for o being OperSymbol of S1+*S2, o1 being OperSymbol of S1 st o = o1 holds Den
  (o, A1+*A2) = Den(o1, A1);

theorem 
  for S1,S2,S being non void Circuit-like non empty
  ManySortedSign st S = S1+*S2 for A1 being non-empty Circuit of S1, A2 being
non-empty Circuit of S2, A being non-empty Circuit of S for s being State of A,
  s2 being State of A2 st s2 = s|the carrier of S2 for g being Gate of S, g2
  being Gate of S2 st g = g2 holds g depends_on_in s = g2 depends_on_in s2;

theorem 
  for S1,S2,S being non void Circuit-like non empty
ManySortedSign st S = S1+*S2 & S1 tolerates S2 for A1 being non-empty Circuit
  of S1, A2 being non-empty Circuit of S2, A being non-empty Circuit of S for s
being State of A, s1 being State of A1 st s1 = s|the carrier of S1 for g being
  Gate of S, g1 being Gate of S1 st g = g1 holds g depends_on_in s = g1
  depends_on_in s1;

theorem 
  for S1,S2,S being non void Circuit-like non empty
  ManySortedSign st S = S1+*S2 for A1 being non-empty Circuit of S1, A2 being
non-empty Circuit of S2 for A being non-empty Circuit of S st A1 tolerates A2 &
  A = A1+*A2 for s being State of A, v being Vertex of S holds (for s1 being
State of A1 st s1 = s|the carrier of S1 holds v in InnerVertices S1 or v in the
carrier of S1 & v in InputVertices S implies (Following s).v = (Following s1).v
  ) & (for s2 being State of A2 st s2 = s|the carrier of S2 holds v in
  InnerVertices S2 or v in the carrier of S2 & v in InputVertices S implies (
  Following s).v = (Following s2).v);

theorem 
  for S1,S2,S being non void Circuit-like non empty
ManySortedSign st InnerVertices S1 misses InputVertices S2 & S = S1+*S2 for A1
  being non-empty Circuit of S1, A2 being non-empty Circuit of S2 for A being
non-empty Circuit of S st A1 tolerates A2 & A = A1+*A2 for s being State of A,
s1 being State of A1, s2 being State of A2 st s1 = s|the carrier of S1 & s2 = s
  |the carrier of S2 holds Following s = (Following s1)+*(Following s2);

theorem 
  for S1,S2,S being non void Circuit-like non empty
ManySortedSign st InnerVertices S2 misses InputVertices S1 & S = S1+*S2 for A1
  being non-empty Circuit of S1, A2 being non-empty Circuit of S2 for A being
non-empty Circuit of S st A1 tolerates A2 & A = A1+*A2 for s being State of A,
s1 being State of A1, s2 being State of A2 st s1 = s|the carrier of S1 & s2 = s
  |the carrier of S2 holds Following s = (Following s2)+*(Following s1);

theorem 
  for S1,S2,S being non void Circuit-like non empty ManySortedSign st
  InputVertices S1 c= InputVertices S2 & S = S1+*S2 for A1 being non-empty
  Circuit of S1, A2 being non-empty Circuit of S2 for A being non-empty Circuit
of S st A1 tolerates A2 & A = A1+*A2 for s being State of A, s1 being State of
A1, s2 being State of A2 st s1 = s|the carrier of S1 & s2 = s|the carrier of S2
  holds Following s = (Following s2)+*(Following s1);

theorem 
  for S1,S2,S being non void Circuit-like non empty ManySortedSign st
  InputVertices S2 c= InputVertices S1 & S = S1+*S2 for A1 being non-empty
  Circuit of S1, A2 being non-empty Circuit of S2 for A being non-empty Circuit
of S st A1 tolerates A2 & A = A1+*A2 for s being State of A, s1 being State of
A1, s2 being State of A2 st s1 = s|the carrier of S1 & s2 = s|the carrier of S2
  holds Following s = (Following s1)+*(Following s2);

begin 

definition
  let f be set;
  let p be FinSequence;
  let x be set;
  func 1GateCircStr(p,f,x) -> non void strict ManySortedSign means


  the
  carrier of it = (rng p) \/ {x} & the carrier' of it = {[p,f]} & (the Arity of
  it).[p,f] = p & (the ResultSort of it).[p,f] = x;
end;

registration
  let f be set;
  let p be FinSequence;
  let x be set;
  cluster 1GateCircStr(p,f,x) -> non empty;
end;

theorem 
  for f,x being set, p being FinSequence holds the Arity of
1GateCircStr(p,f,x) = (p,f) .--> p & the ResultSort of 1GateCircStr(p,f,x) = (p
  ,f) .--> x;

theorem 
  for f,x being set, p being FinSequence for g being Gate of
1GateCircStr(p,f,x) holds g = [p,f] & the_arity_of g = p & the_result_sort_of g
  = x;

theorem 
  for f,x being set, p being FinSequence holds InputVertices
  1GateCircStr(p,f,x) = (rng p) \ {x} & InnerVertices 1GateCircStr(p,f,x) = {x}
;

definition
  let f be set;
  let p be FinSequence;
  func 1GateCircStr(p,f) -> non void strict ManySortedSign means


  the
carrier of it = (rng p) \/ {[p,f]} & the carrier' of it = {[p,f]} & (the Arity
  of it).[p,f] = p & (the ResultSort of it).[p,f] = [p,f];
end;

registration
  let f be set;
  let p be FinSequence;
  cluster 1GateCircStr(p,f) -> non empty;
end;

theorem 
  for f being set, p being FinSequence holds 1GateCircStr(p,f) =
  1GateCircStr(p,f,[p,f]);

theorem 
  for f being set, p being FinSequence holds the Arity of
1GateCircStr(p,f) = (p,f) .--> p & the ResultSort of 1GateCircStr(p,f) = (p,f)
  .--> [p,f];

theorem 
  for f being set, p being FinSequence for g being Gate of
1GateCircStr(p,f) holds g = [p,f] & the_arity_of g = p & the_result_sort_of g =
  g;

theorem 
  for f being set, p being FinSequence holds InputVertices
  1GateCircStr(p,f) = rng p & InnerVertices 1GateCircStr(p,f) = {[p,f]};

theorem 
  for f being set, p,q being FinSequence holds 1GateCircStr(p,f)
  tolerates 1GateCircStr(q,f);

begin 

definition
  let IT be ManySortedSign;
  attr IT is unsplit means


  the ResultSort of IT = id the carrier' of IT;
  attr IT is gate`1=arity means


  for g being set st g in the carrier'
  of IT holds g = [(the Arity of IT).g, g`2];
  attr IT is gate`2isBoolean means


  for g being set st g in the
  carrier' of IT for p being FinSequence st p = (the Arity of IT).g ex f being
  Function of (len p)-tuples_on BOOLEAN, BOOLEAN st g = [g`1, f];
end;

definition
  let S be non empty ManySortedSign;
  let IT be MSAlgebra over S;
  attr IT is gate`2=den means


  for g being set st g in the carrier' of
  S holds g = [g`1, (the Charact of IT).g];
end;

definition
  let IT be non empty ManySortedSign;
  attr IT is gate`2=den means

  ex A being MSAlgebra over IT st A is gate`2=den;
end;

scheme 

  MSSLambdaWeak {A,B() -> set, g() -> Function of A(),B(), f(set,set) -> set}:
ex f being ManySortedSet of A() st for a being set, b being Element of B() st a
  in A() & b = g().a holds f.a = f(a,b);

scheme 

  Lemma {S() -> non empty ManySortedSign, F(set,set) -> set}: ex A being
strict MSAlgebra over S() st the Sorts of A = (the carrier of S()) --> BOOLEAN
  & for g being set, p being Element of (the carrier of S())* st g in the
carrier' of S() & p = (the Arity of S()).g holds (the Charact of A).g = F(g,p)
provided
 for g being set, p being Element of (the carrier of S())* st g in
the carrier' of S() & p = (the Arity of S()).g holds F(g,p) is Function of (len
p)-tuples_on BOOLEAN, BOOLEAN;

registration
  cluster gate`2isBoolean -> gate`2=den for non empty ManySortedSign;
end;

theorem 
  for S being non empty ManySortedSign holds S is unsplit iff for
  o being set st o in the carrier' of S holds (the ResultSort of S).o = o;

theorem 
  for S being non empty ManySortedSign st S is unsplit holds the
  carrier' of S c= the carrier of S;

registration
  cluster unsplit -> Circuit-like for non empty ManySortedSign;
end;

theorem 
  for f being set, p being FinSequence holds 1GateCircStr(p,f) is
  unsplit gate`1=arity;

registration
  let f be set, p be FinSequence;
  cluster 1GateCircStr(p,f) -> unsplit gate`1=arity;
end;

registration
  cluster unsplit gate`1=arity non void strict non empty for ManySortedSign;
end;

theorem 
  for S1,S2 being unsplit gate`1=arity non empty ManySortedSign
  holds S1 tolerates S2;

theorem 
  for S1,S2 being non empty ManySortedSign, A1 being MSAlgebra
  over S1 for A2 being MSAlgebra over S2 st A1 is gate`2=den & A2 is gate`2=den
  holds the Charact of A1 tolerates the Charact of A2;

theorem 
  for S1,S2 being unsplit non empty ManySortedSign holds S1+*S2 is unsplit;

registration
  let S1,S2 be unsplit non empty ManySortedSign;
  cluster S1+*S2 -> unsplit;
end;

theorem 
  for S1,S2 being gate`1=arity non empty ManySortedSign holds S1+*
  S2 is gate`1=arity;

registration
  let S1,S2 be gate`1=arity non empty ManySortedSign;
  cluster S1+*S2 -> gate`1=arity;
end;

theorem 
  for S1,S2 being non empty ManySortedSign st S1 is
  gate`2isBoolean & S2 is gate`2isBoolean holds S1+*S2 is gate`2isBoolean;

begin 

definition
  let n be Nat;
  mode FinSeqLen of n is n-element FinSequence;
end;

definition
  let n be Nat;
  let X,Y be non empty set;
  let f be Function of n-tuples_on X, Y;
  let p be FinSeqLen of n;
  let x be set such that
 x in rng p implies X = Y;
  func 1GateCircuit(p,f,x) -> strict non-empty MSAlgebra over 1GateCircStr(p,f
  ,x) means

  the Sorts of it = ((rng p) --> X) +* (x .--> Y) & (the Charact of it)
  .[p,f] = f;
end;

definition
  let n be Nat;
  let X be non empty set;
  let f be Function of n-tuples_on X, X;
  let p be FinSeqLen of n;
  func 1GateCircuit(p,f) -> strict non-empty MSAlgebra over 1GateCircStr(p,f)
  means


  the Sorts of it = (the carrier of 1GateCircStr(p,f)) --> X & (
  the Charact of it).[p,f] = f;
end;

theorem 
  for n being Nat, X being non empty set for f being Function of n
  -tuples_on X, X for p being FinSeqLen of n holds 1GateCircuit(p,f) is
  gate`2=den & 1GateCircStr(p,f) is gate`2=den;

registration
  let n be Nat, X be non empty set;
  let f be Function of n-tuples_on X, X;
  let p be FinSeqLen of n;
  cluster 1GateCircuit(p,f) -> gate`2=den;
  cluster 1GateCircStr(p,f) -> gate`2=den;
end;

theorem 
  for n being Nat for p being FinSeqLen of n for f being Function
  of n-tuples_on BOOLEAN, BOOLEAN holds 1GateCircStr(p,f) is gate`2isBoolean;

registration
  let n be Nat;
  let f be Function of n-tuples_on BOOLEAN, BOOLEAN;
  let p be FinSeqLen of n;
  cluster 1GateCircStr(p,f) -> gate`2isBoolean;
end;

registration
  cluster gate`2isBoolean non empty for ManySortedSign;
end;

registration
  let S1,S2 be gate`2isBoolean non empty ManySortedSign;
  cluster S1+*S2 -> gate`2isBoolean;
end;

theorem 
  for n being Nat, X being non empty set, f being Function of n
-tuples_on X, X for p being FinSeqLen of n holds the Charact of 1GateCircuit(p,
f) = (p,f) .--> f & for v being Vertex of 1GateCircStr(p,f) holds (the Sorts of
  1GateCircuit(p,f)).v = X;

registration
  let n be Nat;
  let X be non empty finite set;
  let f be Function of n-tuples_on X, X;
  let p be FinSeqLen of n;
  cluster 1GateCircuit(p,f) -> finite-yielding;
end;

theorem 
  for n being Nat, X being non empty set, f being Function of n
  -tuples_on X, X, p,q being FinSeqLen of n holds 1GateCircuit(p,f) tolerates
  1GateCircuit(q,f);

theorem 
  for n being Nat, X being finite non empty set, f being Function of n
-tuples_on X, X, p being FinSeqLen of n for s being State of 1GateCircuit(p,f)
  holds (Following s).[p,f] = f.(s*p);

begin 






definition
  let S be non empty ManySortedSign;
  let IT be MSAlgebra over S;
  attr IT is Boolean means


  for v being Vertex of S holds (the Sorts of IT).v = BOOLEAN;
end;

theorem 
  for S being non empty ManySortedSign, A being MSAlgebra over S
  holds A is Boolean iff the Sorts of A = (the carrier of S) --> BOOLEAN;

registration
  let S be non empty ManySortedSign;
  cluster Boolean -> non-empty finite-yielding for MSAlgebra over S;
end;

theorem 
  for S being non empty ManySortedSign, A being MSAlgebra over S holds A
  is Boolean iff rng the Sorts of A c= {BOOLEAN};

theorem 
  for S1,S2 being non empty ManySortedSign for A1 being MSAlgebra
over S1, A2 being MSAlgebra over S2 st A1 is Boolean & A2 is Boolean holds the
  Sorts of A1 tolerates the Sorts of A2;

theorem 
  for S1,S2 being unsplit gate`1=arity non empty ManySortedSign
  for A1 being MSAlgebra over S1, A2 being MSAlgebra over S2 st A1 is Boolean
  gate`2=den & A2 is Boolean gate`2=den holds A1 tolerates A2;

registration
  let S be non empty ManySortedSign;
  cluster Boolean for strict MSAlgebra over S;
end;

theorem 
  for n being Nat, f being Function of n-tuples_on BOOLEAN, BOOLEAN for
  p being FinSeqLen of n holds 1GateCircuit(p,f) is Boolean;

theorem 
  for S1,S2 being non empty ManySortedSign for A1 be Boolean
  MSAlgebra over S1 for A2 be Boolean MSAlgebra over S2 holds A1+*A2 is Boolean
;

theorem 
  for S1,S2 being non empty ManySortedSign for A1 be non-empty
  MSAlgebra over S1, A2 be non-empty MSAlgebra over S2 st A1 is gate`2=den & A2
  is gate`2=den & the Sorts of A1 tolerates the Sorts of A2 holds A1+*A2 is
  gate`2=den;

registration
  cluster unsplit gate`1=arity gate`2=den gate`2isBoolean non void strict for
non
    empty ManySortedSign;
end;

registration
  let S be gate`2isBoolean non empty ManySortedSign;
  cluster Boolean gate`2=den for strict MSAlgebra over S;
end;

registration
  let S1,S2 be unsplit gate`2isBoolean non void non empty ManySortedSign;
  let A1 be Boolean gate`2=den Circuit of S1;
  let A2 be Boolean gate`2=den Circuit of S2;
  cluster A1+*A2 -> Boolean gate`2=den;
end;

registration
  let n be Nat;
  let X be finite non empty set;
  let f be Function of n-tuples_on X, X;
  let p be FinSeqLen of n;
  cluster gate`2=den strict non-empty for Circuit of 1GateCircStr(p,f);
end;

registration
  let n be Nat;
  let X be finite non empty set;
  let f be Function of n-tuples_on X, X;
  let p be FinSeqLen of n;
  cluster 1GateCircuit(p,f) -> gate`2=den;
end;

theorem 
  for S1,S2 being unsplit gate`1=arity gate`2isBoolean non void non
empty ManySortedSign for A1 being Boolean gate`2=den Circuit of S1 for A2 being
Boolean gate`2=den Circuit of S2 for s being State of A1+*A2, v being Vertex of
  S1+*S2 holds (for s1 being State of A1 st s1 = s|the carrier of S1 holds v in
InnerVertices S1 or v in the carrier of S1 & v in InputVertices(S1+*S2) implies
  (Following s).v = (Following s1).v) & for s2 being State of A2 st s2 = s|the
  carrier of S2 holds v in InnerVertices S2 or v in the carrier of S2 & v in
  InputVertices(S1+*S2) implies (Following s).v = (Following s2).v;














begin 

reserve p, q for FinSequence,
  X, Y, x, y for set,
  D for non empty set,
  i, j, k , l, m, n, r for Element of NAT;

theorem 
  for m,k,n being Nat holds m+1<=k & k<=n iff ex i being Element of
  NAT st m<=i & i<n & k=i+1;

theorem 
  q = p|Seg n implies len q<=len p & for i st 1<=i & i<=len q holds p.i = q.i;

theorem 
  X c= Seg k & Y c= dom Sgm X implies (Sgm X)*(Sgm Y) = Sgm rng (( Sgm X)|Y);

theorem 
  for m, n being Element of NAT holds card {k: m<=k & k<=m+n} = n+1;

theorem 
  for l st 1<=l & l<=n holds Sgm {kk where kk is Element of NAT: m+
  1<=kk & kk<=m+n}.l = m+l;

begin 

definition
  let p be FinSequence, m, n be Nat;
  func (m, n)-cut p -> FinSequence means


  len it +m = n+1 & for i being
Nat st i<len it holds it.(i+1)=p.(m+i) if 1<=m & m<=n & n<=len p otherwise it =
  {};
end;

theorem 
  1<=m & m<=len p implies (m,m)-cut p = <*p.m*>;

theorem 
  (1, len p)-cut p = p;

theorem 
  m<=n & n<=r & r<=len p implies (m+1, n)-cut p ^ (n+1, r)-cut p =
  (m+1, r)-cut p;

theorem 
  m<=len p implies (1, m)-cut p ^ (m+1, len p)-cut p = p;

theorem 
  m<=n & n<=len p implies (1, m)-cut p ^ (m+1, n)-cut p ^ (n+1, len p)
  -cut p = p;

theorem 
  rng ((m,n)-cut p) c= rng p;

definition
  let D be set, p be FinSequence of D, m, n be Nat;
  redefine func (m, n)-cut p -> FinSequence of D;
end;

theorem 
  1<=m & m<=n & n<=len p implies ((m,n)-cut p).1 = p.m & ((m,n)
  -cut p).len ((m,n)-cut p)=p.n;

begin  

definition
  let p, q be FinSequence;
  func p ^' q -> FinSequence equals

  p^(2, len q)-cut q;
end;

theorem 
  q<>{} implies len (p^'q) +1 = len p + len q;

theorem 
  1<=k & k<=len p implies (p^'q).k=p.k;

theorem 
  1<=k & k<len q implies (p^'q).(len p +k) = q.(k+1);

theorem 
  1<len q implies (p^'q).len (p^'q) = q.len q;

theorem 
  rng (p^'q) c= rng p \/ rng q;

definition
  let D be set, p, q be FinSequence of D;
  redefine func p^'q -> FinSequence of D;
end;

theorem 
  p<>{} & q<>{} & p.len p = q.1 implies rng (p^'q) = rng p \/ rng q;

begin 

definition
  let f be FinSequence;
  attr f is TwoValued means


  card rng f = 2;
end;

theorem 
  p is TwoValued iff len p >1 & ex x,y being set st x<>y & rng p = {x, y};

definition
  let f be FinSequence;
  attr f is Alternating means


  for i being Nat st 1<=i & (i+1)<=len f holds f.i <> f.(i+1);
end;

registration
  cluster TwoValued Alternating for FinSequence;
end;

reserve a, a1, a2 for TwoValued Alternating FinSequence;

theorem 
  len a1 = len a2 & rng a1 = rng a2 & a1.1 = a2.1 implies a1 = a2;

theorem 
  a1<>a2 & len a1 = len a2 & rng a1 = rng a2 implies for i st 1<=i
  & i<=len a1 holds a1.i<>a2.i;

theorem 
  a1<>a2 & len a1 = len a2 & rng a1 = rng a2 implies for a st len
  a=len a1 & rng a=rng a1 holds a=a1 or a=a2;

theorem 
  X <> Y & n > 1 implies ex a1 st rng a1 = {X, Y} & len a1 = n & a1.1 = X;

begin    

registration
  let X;
  let fs be FinSequence of X;
  cluster -> FinSubsequence-like for Subset of fs;
end;

theorem 
  for f being FinSubsequence, g, h, fg, fh, fgh being FinSequence
st rng g c= dom f & rng h c= dom f & fg=f*g & fh=f*h & fgh=f*(g^h) holds fgh =
  fg^fh;

reserve fs, fs1, fs2 for FinSequence of X,
  fss, fss2 for Subset of fs;

theorem 
  dom fss c= dom fs & rng fss c= rng fs;

theorem 
  fs is Subset of fs;

theorem 
  fss|Y is Subset of fs;

theorem 
  for fss1 being Subset of fs1 st Seq fss = fs1 & Seq fss1 = fs2 &
  fss2 = fss|rng((Sgm dom fss)|dom fss1) holds Seq fss2 = fs2;

begin   

reserve G for Graph;
reserve v, v1, v2, v3, v4 for Element of G,
  e for set;

theorem 
  e joins v1,v2 implies e joins v2,v1;

theorem 
  e joins v1,v2 & e joins v3,v4 implies v1=v3 & v2=v4 or v1=v4 & v2=v3;

reserve vs, vs1, vs2 for FinSequence of the carrier of G,
  c, c1, c2 for Chain of G;

definition
  let G, X;

  func G-VSet X -> set equals

  { v: ex e being Element of the carrier' of G st
  e in X & (v = (the Source of G).e or v = (the Target of G).e) };
end;

definition
  let G, vs;
  let c be FinSequence;
  pred vs is_vertex_seq_of c means


  len vs = len c + 1 & for n st 1<=n &
  n<=len c holds c.n joins vs/.n, vs/.(n+1);
end;

theorem 
  c <>{} & vs is_vertex_seq_of c implies G-VSet rng c = rng vs;

theorem 
  <*v*> is_vertex_seq_of {};

theorem 
  ex vs st vs is_vertex_seq_of c;

theorem 
  c <>{} & vs1 is_vertex_seq_of c & vs2 is_vertex_seq_of c & vs1
<> vs2 implies vs1.1<>vs2.1 & for vs st vs is_vertex_seq_of c holds vs = vs1 or
  vs = vs2;

definition
  let G;
  let c be FinSequence;
  pred c alternates_vertices_in G means


  len c>=1 & card (G-VSet rng c)
= 2 & for n st n in dom c holds (the Source of G).(c.n) <> (the Target of G).(c
  .n);
end;

theorem 
  c alternates_vertices_in G & vs is_vertex_seq_of c implies for k
  st k in dom c holds vs.k <> vs.(k+1);

theorem 
  c alternates_vertices_in G & vs is_vertex_seq_of c implies rng
  vs = {(the Source of G).(c.1), (the Target of G).(c.1)};

theorem 
  c alternates_vertices_in G & vs is_vertex_seq_of c implies vs is
  TwoValued Alternating FinSequence;

theorem 
  c alternates_vertices_in G implies ex vs1,vs2 st vs1<>vs2 & vs1
  is_vertex_seq_of c & vs2 is_vertex_seq_of c & for vs st vs is_vertex_seq_of c
  holds vs=vs1 or vs=vs2;

theorem 
  vs is_vertex_seq_of c implies (card the carrier of G = 1 or c <>
{} & not c alternates_vertices_in G iff for vs1 st vs1 is_vertex_seq_of c holds
  vs1 = vs);

definition
  let G, c;
  assume
 card the carrier of G = 1 or c <>{} & not c alternates_vertices_in G;
  func vertex-seq c -> FinSequence of the carrier of G means

  it is_vertex_seq_of c;
end;

theorem 
  vs is_vertex_seq_of c & c1 = c|Seg n & vs1= vs|Seg (n+1) implies
  vs1 is_vertex_seq_of c1;

theorem 
  1<=m & m<=n & n<=len c & q = (m,n)-cut c implies q is Chain of G;

theorem 
  1<=m & m<=n & n<=len c & c1 = (m,n)-cut c & vs is_vertex_seq_of
  c & vs1 = (m,n+1)-cut vs implies vs1 is_vertex_seq_of c1;

theorem 
  vs1 is_vertex_seq_of c1 & vs2 is_vertex_seq_of c2 & vs1.len vs1
  = vs2.1 implies c1^c2 is Chain of G;

theorem 
  vs1 is_vertex_seq_of c1 & vs2 is_vertex_seq_of c2 & vs1.len vs1
  = vs2.1 & c = c1^c2 & vs = vs1^'vs2 implies vs is_vertex_seq_of c;

begin

definition
  let G;
  let IT be Chain of G;
  attr IT is simple means


  ex vs st vs is_vertex_seq_of IT & for n,m st
  1<=n & n<m & m<=len vs & vs.n=vs.m holds n=1 & m=len vs;
end;

registration
  let G;
  cluster simple for Chain of G;
end;

reserve sc for simple Chain of G;

theorem 
  sc|(Seg n) is simple Chain of G;

theorem 
  2<len sc & vs1 is_vertex_seq_of sc & vs2 is_vertex_seq_of sc implies vs1=vs2;

theorem 
  vs is_vertex_seq_of sc implies for n, m st 1<=n & n<m & m<=len vs & vs
  .n = vs.m holds n=1 & m=len vs;












theorem 
  not c is simple Chain of G & vs is_vertex_seq_of c implies ex fc
  being Subset of c, fvs being Subset of vs, c1, vs1 st len c1 < len c & vs1
is_vertex_seq_of c1 & len vs1 < len vs & vs.1 = vs1.1 & vs.len vs = vs1.len vs1
  & Seq fc = c1 & Seq fvs = vs1;

theorem 
  vs is_vertex_seq_of c implies ex fc being Subset of c, fvs being
Subset of vs, sc, vs1 st Seq fc = sc & Seq fvs = vs1 & vs1 is_vertex_seq_of sc
  & vs.1 = vs1.1 & vs.len vs = vs1.len vs1;

registration
  let G;
  cluster empty -> one-to-one for Chain of G;
end;

theorem 
  p is Path of G implies p|Seg(n) is Path of G;

registration
  let G;
  cluster simple for Path of G;
end;

theorem 
  2<len sc implies sc is Path of G;

theorem 
  sc is Path of G iff len sc = 0 or len sc = 1 or sc.1<>sc.2;

registration
  let G;
  cluster empty -> oriented for Chain of G;
end;

definition
  let G;
  let oc be oriented Chain of G;
  assume
 oc <> {};
  func vertex-seq oc -> FinSequence of the carrier of G means

  it is_vertex_seq_of oc & it.1 = (the Source of G).(oc.1);
end;

begin 


theorem 
  for f1 being non empty FinSequence of D, f2 being FinSequence of D
  holds (f1^'f2)/.1 = f1/.1;

theorem 
  for f1 being FinSequence of D, f2 being non trivial FinSequence of D
  holds (f1^'f2)/.len(f1^'f2) = f2/.len f2;

theorem 
  for f being FinSequence holds f^'{} = f;

theorem 
  for f being FinSequence holds f^'<*x*> = f;

theorem 
  for f1, f2 being FinSequence of D holds 1<=n & n<=len f1 implies (f1^'
  f2)/.n = f1/.n;

theorem 
  for f1, f2 being FinSequence of D holds 1<=n & n<len f2 implies (f1^'
  f2)/.(len f1 + n) = f2/.(n+1);



definition
  let F be FinSequence of INT, m, n be Element of NAT;
  assume that
 1 <= m and
 m <= n and
 n <= len F;
  func min_at(F, m, n) -> Element of NAT means


  ex X being finite non
empty Subset of INT st X = rng ((m,n)-cut F) & it+1 = (min X)..(m,n)-cut F +m;
end;

reserve F, F1 for FinSequence of INT,
  k, m, n, ma for Element of NAT;

theorem 
  1 <= m & m <= n & n <= len F implies (ma = min_at(F, m, n) iff m
<= ma & ma <= n & (for i being Element of NAT st m <= i & i <= n holds F.ma <=
  F.i) & for i being Element of NAT st m <= i & i < ma holds F.ma < F.i);

theorem 
  1 <= m & m <= len F implies min_at(F, m, m) = m;

definition
  let F be FinSequence of INT, m, n be Element of NAT;
  pred F is_non_decreasing_on m, n means


  for i, j being Element of NAT st m <= i & i <= j & j <= n holds F.i <= F.j;
end;

definition
  let F be FinSequence of INT, n be Element of NAT;
  pred F is_split_at n means


  for i, j being Element of NAT st 1 <= i &
  i <= n & n < j & j <= len F holds F.i <= F.j;
end;

theorem 
  k+1 <= len F & ma = min_at(F, k+1, len F) & F is_split_at k & F
  is_non_decreasing_on 1, k & F1 = F+*(k+1, F.ma)+*(ma, F.(k+1)) implies F1
  is_non_decreasing_on 1, k+1;

theorem 
  k+1 <= len F & ma = min_at(F, k+1, len F) & F is_split_at k & F1 = F+*
  (k+1, F.ma)+*(ma, F.(k+1)) implies F1 is_split_at k+1;



theorem 
  for f being FinSequence of INT,m,n be Element of NAT st m >= n
  holds f is_non_decreasing_on m,n;















begin

theorem 
  for G being Group for H1, H2 being Subgroup of G holds the
  carrier of H1 /\ H2 = (the carrier of H1) /\ the carrier of H2;

theorem 
  for G being Group for h being set holds h in Subgroups G iff ex H
  being strict Subgroup of G st h = H;

theorem 
  for G being Group for A being Subset of G for H being strict
  Subgroup of G st A = the carrier of H holds gr A = H;

theorem 
  for G being Group for H1, H2 being Subgroup of G for A being
Subset of G st A = (the carrier of H1) \/ the carrier of H2 holds H1 "\/" H2 =
  gr A;

theorem 
  for G being Group for H1, H2 being Subgroup of G for g being
  Element of G holds g in H1 or g in H2 implies g in H1 "\/" H2;

theorem 
  for G1, G2 being Group for f being Homomorphism of G1, G2 for H1 being
Subgroup of G1 holds ex H2 being strict Subgroup of G2 st the carrier of H2 = f
  .:the carrier of H1;

theorem 
  for G1, G2 being Group for f being Homomorphism of G1, G2 for H2 being
  Subgroup of G2 ex H1 being strict Subgroup of G1 st the carrier of H1 = f"the
  carrier of H2;

theorem 
  for G1, G2 being Group for f being Homomorphism of G1, G2 for H1, H2
being Subgroup of G1 for H3, H4 being Subgroup of G2 st the carrier of H3 = f.:
  the carrier of H1 & the carrier of H4 = f.:the carrier of H2 holds H1 is
  Subgroup of H2 implies H3 is Subgroup of H4;

theorem 
  for G1, G2 being Group for f being Homomorphism of G1, G2 for H1, H2
being Subgroup of G2 for H3, H4 being Subgroup of G1 st the carrier of H3 = f"
  the carrier of H1 & the carrier of H4 = f"the carrier of H2 holds H1 is
  Subgroup of H2 implies H3 is Subgroup of H4;

theorem 
  for G1, G2 being Group for f being Function of the carrier of G1, the
  carrier of G2 for A being Subset of G1 holds f.:A c= f.:the carrier of gr A;

theorem 
  for G1, G2 being Group for H1, H2 being Subgroup of G1 for f being
Function of the carrier of G1, the carrier of G2 for A being Subset of G1 st A
= (the carrier of H1) \/ the carrier of H2 holds f.:the carrier of H1 "\/" H2 =
  f.:the carrier of gr A;

theorem 
  for G being Group for A being Subset of G st A = {1_G} holds gr A = (1).G;

definition
  let G be Group;
  func carr G -> Function of Subgroups G, bool the carrier of G means


  for H being strict Subgroup of G holds it.H = the carrier of H;
end;

theorem 
  for G being Group for H being strict Subgroup of G for x being
  Element of G holds x in carr G.H iff x in H;

theorem 
  for G being Group for H being strict Subgroup of G holds 1_G in carr G .H;

theorem 
  for G being Group for H being strict Subgroup of G holds carr G.H <>
  {};

theorem 
  for G being Group for H being strict Subgroup of G for g1, g2 being
Element of G holds g1 in carr G.H & g2 in carr G.H implies g1 * g2 in carr G.H;

theorem 
  for G being Group for H being strict Subgroup of G for g being Element
  of G holds g in carr G.H implies g" in carr G.H;

theorem 
  for G being Group for H1, H2 being strict Subgroup of G holds
  the carrier of H1 /\ H2 = carr G.H1 /\ carr G.H2;

theorem 
  for G being Group for H1, H2 being strict Subgroup of G holds carr G.(
  H1 /\ H2) = carr G.H1 /\ carr G.H2;

definition
  let G be Group;
  let F be non empty Subset of Subgroups G;
  func meet F -> strict Subgroup of G means


  the carrier of it = meet ( carr G.:F);
end;

theorem 
  for G being Group for F being non empty Subset of Subgroups G holds
  (1).G in F implies meet F = (1).G;

theorem 
  for G being Group for h being Element of Subgroups G for F being non
  empty Subset of Subgroups G st F = { h } holds meet F = h;

theorem 
  for G being Group for H1, H2 being Subgroup of G for h1, h2
  being Element of lattice G st h1 = H1 & h2 = H2 holds h1 "\/" h2 = H1 "\/" H2
;

theorem 
  for G being Group for H1, H2 being Subgroup of G for h1, h2
  being Element of lattice G st h1 = H1 & h2 = H2 holds h1 "/\" h2 = H1 /\ H2;

theorem 
  for G being Group for p being Element of lattice G for H being
  Subgroup of G st p = H holds H is strict Subgroup of G;

theorem 
  for G being Group for H1, H2 being Subgroup of G for p, q being
  Element of lattice G st p = H1 & q = H2 holds p [= q iff the carrier of H1 c=
  the carrier of H2;

theorem 
  for G being Group for H1, H2 being Subgroup of G for p, q being
  Element of lattice G st p = H1 & q = H2 holds p [= q iff H1 is Subgroup of H2
;

theorem 
  for G being Group holds lattice G is complete;

definition
  let G1, G2 be Group;
  let f be Function of the carrier of G1, the carrier of G2;
  func FuncLatt f -> Function of the carrier of lattice G1, the carrier of
  lattice G2 means


  for H being strict Subgroup of G1, A being Subset of G2
  st A = f.:the carrier of H holds it.H = gr A;
end;

theorem 
  for G being Group holds FuncLatt id the carrier of G = id the carrier
  of lattice G;

theorem 
  for G1, G2 being Group for f being Homomorphism of G1, G2 st f is
  one-to-one holds FuncLatt f is one-to-one;

theorem 
  for G1, G2 being Group for f being Homomorphism of G1, G2 holds (
  FuncLatt f).(1).G1 = (1).G2;

theorem 
  for G1, G2 being Group for f being Homomorphism of G1, G2 st f
  is one-to-one holds FuncLatt f is Semilattice-Homomorphism of lattice G1,
  lattice G2;

theorem 
  for G1, G2 being Group for f being Homomorphism of G1, G2 holds
  FuncLatt f is sup-Semilattice-Homomorphism of lattice G1, lattice G2;

theorem 
  for G1, G2 being Group for f being Homomorphism of G1, G2 st f is
  one-to-one holds FuncLatt f is Homomorphism of lattice G1, lattice G2;














begin

reserve U0 for Universal_Algebra,
  U1 for SubAlgebra of U0,
  o for operation of U0;

definition
  let U0;
  mode SubAlgebra-Family of U0 means


    for U1 be set st U1 in it holds U1 is SubAlgebra of U0;
end;

registration
  let U0;
  cluster non empty for SubAlgebra-Family of U0;
end;

definition
  let U0;
  redefine func Sub(U0) -> non empty SubAlgebra-Family of U0;
  let U00 be non empty SubAlgebra-Family of U0;
  redefine mode Element of U00 -> SubAlgebra of U0;
end;

definition
  let U0;
  let u be Element of Sub(U0);
  func carr u -> Subset of U0 means


  ex U1 being SubAlgebra of U0 st u = U1 & it = the carrier of U1;
end;

definition
  let U0;
  func Carr U0 -> Function of Sub(U0), bool the carrier of U0 means


  for u being Element of Sub(U0) holds it.u = carr u;
end;

theorem 
  for u being set holds u in Sub(U0) iff ex U1 be strict SubAlgebra
  of U0 st u = U1;

theorem 
  for H being non empty Subset of U0 for o holds arity o = 0 implies (H
  is_closed_on o iff o.{} in H);

theorem 
  for U1 be SubAlgebra of U0 holds the carrier of U1 c= the carrier of U0;

theorem 
  for H being non empty Subset of U0 for o holds H is_closed_on o &
  arity o = 0 implies (o/.H) = o;

theorem 
  Constants(U0) = { o.{} where o is operation of U0: arity o = 0 };

theorem 
  for U0 be with_const_op Universal_Algebra for U1 be SubAlgebra of
  U0 holds Constants(U0) = Constants(U1);

registration
  let U0 be with_const_op Universal_Algebra;
  cluster -> with_const_op for SubAlgebra of U0;
end;

theorem 
  for U0 be with_const_op Universal_Algebra for U1,U2 be SubAlgebra of
  U0 holds Constants(U1) = Constants(U2);

definition
  let U0;
  redefine func Carr U0 means


  for u being Element of Sub(U0), U1 being SubAlgebra of U0 st u = U1 holds
  it.u = the carrier of U1;
end;

theorem 
  for H being strict SubAlgebra of U0 for u being Element of U0 holds u
  in (Carr U0).H iff u in H;

theorem 
  for H be non empty Subset of Sub(U0) holds ((Carr U0).:H) is non empty;

theorem 
  for U0 being with_const_op Universal_Algebra for U1 being strict
  SubAlgebra of U0 holds Constants(U0) c= (Carr U0).U1;

theorem 
  for U0 being with_const_op Universal_Algebra for U1 be
SubAlgebra of U0 for a be set holds a is Element of Constants(U0) implies a in
  the carrier of U1;

theorem 
  for U0 being with_const_op Universal_Algebra for H be non empty
  Subset of Sub(U0) holds meet ((Carr U0).:H) is non empty Subset of U0;

theorem 
  for U0 being with_const_op Universal_Algebra holds the carrier of
  UnSubAlLattice(U0) = Sub(U0);

theorem 
  for U0 being with_const_op Universal_Algebra for H be non empty
Subset of Sub(U0) for S being non empty Subset of U0 st S = meet ((Carr U0).:H)
  holds S is opers_closed;

definition
  let U0 be with_const_op strict Universal_Algebra;
  let H be non empty Subset of Sub(U0);
  func meet H -> strict SubAlgebra of U0 means


  the carrier of it = meet ((Carr U0).:H);
end;

theorem 
  for U0 being with_const_op Universal_Algebra for l1,l2 being
Element of UnSubAlLattice(U0), U1,U2 being strict SubAlgebra of U0 st l1 = U1 &
  l2 = U2 holds l1 [= l2 iff the carrier of U1 c= the carrier of U2;

theorem 
  for U0 being with_const_op Universal_Algebra for l1,l2 being Element
of UnSubAlLattice(U0), U1,U2 being strict SubAlgebra of U0 st l1 = U1 & l2 = U2
  holds l1 [= l2 iff U1 is SubAlgebra of U2;

theorem 
  for U0 being with_const_op strict Universal_Algebra holds
  UnSubAlLattice(U0) is bounded;

registration
  let U0 be with_const_op strict Universal_Algebra;
  cluster UnSubAlLattice U0 -> bounded;
end;

theorem 
  for U0 being with_const_op strict Universal_Algebra for U1 be
  strict SubAlgebra of U0 holds GenUnivAlg(Constants(U0)) /\ U1 = GenUnivAlg(
  Constants(U0));

theorem 
  for U0 being with_const_op strict Universal_Algebra holds Bottom (
  UnSubAlLattice(U0)) = GenUnivAlg(Constants(U0));

theorem 
  for U0 being with_const_op strict Universal_Algebra for U1 be
  SubAlgebra of U0 for H be Subset of U0 st H = the carrier of U0 holds
  GenUnivAlg(H) "\/" U1 = GenUnivAlg(H);

theorem 
  for U0 being with_const_op strict Universal_Algebra for H be
  Subset of U0 st H = the carrier of U0 holds Top (UnSubAlLattice(U0)) =
  GenUnivAlg(H);

theorem 
  for U0 being with_const_op strict Universal_Algebra holds Top (
  UnSubAlLattice(U0)) = U0;

theorem 
  for U0 being with_const_op strict Universal_Algebra holds
  UnSubAlLattice(U0) is complete;

definition
  let U01,U02 be with_const_op Universal_Algebra;
  let F be Function of the carrier of U01, the carrier of U02;
  func FuncLatt F -> Function of the carrier of UnSubAlLattice(U01), the
  carrier of UnSubAlLattice(U02) means


  for U1 being strict SubAlgebra of
  U01, H being Subset of U02 st H = F.: the carrier of U1 holds it.U1 =
  GenUnivAlg(H);
end;

theorem 
  for U0 being with_const_op strict Universal_Algebra for F being
  Function of the carrier of U0, the carrier of U0 st F = id the carrier of U0
  holds FuncLatt F = id the carrier of UnSubAlLattice(U0);














begin 

registration
  let A be non empty set;
  cluster non empty-yielding for ManySortedSet of A;
end;

definition
  let C be Categorial Category;
  let f be Morphism of C;
  redefine func f`2 -> Functor of f`11, f`12;
end;

theorem 
  for C being Categorial Category, f,g being Morphism of C st dom g =
  cod f holds g(*)f = [[dom f, cod g], g`2*f`2];

theorem 
  for C being Category, D,E being Categorial Category for F being
  Functor of C,D for G being Functor of C,E st F = G holds Obj F = Obj G;

definition
  let IT be Function;
  attr IT is Category-yielding means


  for x being set st x in dom IT holds IT.x is Category;
end;

registration
  cluster Category-yielding for Function;
end;

registration
  let X be set;
  cluster Category-yielding for ManySortedSet of X;
end;

definition
  let A be set;
  mode ManySortedCategory of A is Category-yielding ManySortedSet of A;
end;

definition
  let C be Category;
  mode ManySortedCategory of C is ManySortedCategory of the carrier of C;
end;

registration
  let X be set, x be Category;
  cluster X --> x -> Category-yielding;
end;

registration
  let X be non empty set;
  cluster -> non empty for ManySortedSet of X;
end;

registration
  let f be Category-yielding Function;
  cluster rng f -> categorial;
end;

definition
  let X be non empty set;
  let f be ManySortedCategory of X;
  let x be Element of X;
  redefine func f.x -> Category;
end;

registration
  let f be Function;
  let g be Category-yielding Function;
  cluster g*f -> Category-yielding;
end;



definition
  let F be Category-yielding Function;
  func Objs F -> non-empty Function means


  dom it = dom F & for x being
set st x in dom F for C being Category st C = F.x holds it.x = the carrier of C
  ;
  func Mphs F -> non-empty Function means


  dom it = dom F & for x being
set st x in dom F for C being Category st C = F.x holds it.x = the carrier' of
  C;
end;

registration
  let A be non empty set;
  let F be ManySortedCategory of A;
  cluster Objs F -> A-defined;
  cluster Mphs F -> A-defined;
end;

registration
  let A be non empty set;
  let F be ManySortedCategory of A;
  cluster Objs F -> total;
  cluster Mphs F -> total;
end;

theorem 
  for X being set, C being Category holds Objs (X --> C) = X --> the
  carrier of C & Mphs (X --> C) = X --> the carrier' of C;

begin 

definition
  let A,B be set;
  mode ManySortedSet of A,B means


    ex f being (ManySortedSet of A), g being ManySortedSet of B st it = [f,g];
end;

definition
  let A,B be set;
  let f be ManySortedSet of A;
  let g be ManySortedSet of B;
  redefine func [f,g] -> ManySortedSet of A,B;
end;

registration
  let A, B be set;
  let X be ManySortedSet of A,B;
  cluster X`1 -> Function-like Relation-like;
  cluster X`2 -> Function-like Relation-like;
end;

registration
  let A, B be set;
  let X be ManySortedSet of A,B;
  cluster X`1 -> A-defined;
  cluster X`2 -> B-defined;
end;

registration
  let A, B be set;
  let X be ManySortedSet of A,B;
  cluster X`1 -> total for A-defined Function;
  cluster X`2 -> total for B-defined Function;
end;

definition
  let A,B be set;
  let IT be ManySortedSet of A,B;
  attr IT is Category-yielding_on_first means


  IT`1 is Category-yielding;
  attr IT is Function-yielding_on_second means


  IT`2 is Function-yielding;
end;

registration
  let A,B be set;
  cluster Category-yielding_on_first Function-yielding_on_second for
ManySortedSet
    of A,B;
end;

registration
  let A, B be set;
  let X be Category-yielding_on_first ManySortedSet of A,B;
  cluster X`1 -> Category-yielding;
end;

registration
  let A, B be set;
  let X be Function-yielding_on_second ManySortedSet of A,B;
  cluster X`2 ->  Function-yielding;
end;

registration
  let f be Function-yielding Function;
  cluster rng f -> functional;
end;

definition
  let A,B be set;
  let f be ManySortedCategory of A;
  let g be ManySortedFunction of B;
  redefine func [f,g] -> Category-yielding_on_first
  Function-yielding_on_second ManySortedSet of A,B;
end;

definition
  let A be non empty set;
  let F,G be ManySortedCategory of A;
  mode ManySortedFunctor of F,G -> ManySortedFunction of A means


    for a being Element of A holds it.a is Functor of F.a, G.a;
end;

scheme 

  LambdaMSFr {A() -> non empty set, C1, C2() -> ManySortedCategory of A(), F(
set) -> set}: ex F being ManySortedFunctor of C1(), C2() st for a being Element
  of A() holds F.a = F(a)
provided
 for a being Element of A() holds F(a) is Functor of C1().a, C2().a;

definition
  let A be non empty set;
  let F,G be ManySortedCategory of A;
  let f be ManySortedFunctor of F,G;
  let a be Element of A;
  redefine func f.a -> Functor of F.a, G.a;
end;

begin 

definition
  let A,B be non empty set;
  let F,G be Function of B,A;
  mode Indexing of F,G -> Category-yielding_on_first ManySortedSet of A,B
    means


    it`2 is ManySortedFunctor of it`1*F, it`1*G;
end;

theorem 
  for A,B being non empty set, F,G being Function of B,A for I
being Indexing of F,G for m being Element of B holds I`2.m is Functor of I`1.(F
  .m), I`1.(G.m);

theorem 
  for C being Category, I being Indexing of the Source of C, the Target
  of C for m being Morphism of C holds I`2.m is Functor of I`1.dom m, I`1.cod m
;

definition
  let A,B be non empty set;
  let F,G be Function of B,A;
  let I be Indexing of F,G;
  redefine func I`2 -> ManySortedFunctor of I`1*F,I`1*G;
end;

definition
  let A,B be non empty set;
  let F,G be Function of B,A;
  let I be Indexing of F,G;
  mode TargetCat of I -> Categorial Category means


    (for a being
Element of A holds I`1.a is Object of it) & for b being Element of B holds [[I
    `1.(F.b),I`1.(G.b)],I`2.b] is Morphism of it;
end;

registration
  let A,B be non empty set;
  let F,G be Function of B,A;
  let I be Indexing of F,G;
  cluster full strict for TargetCat of I;
end;

definition



  let A,B be non empty set;
  let F,G be Function of B,A;
  let c be PartFunc of [:B,B:], B;
  let i be Function of A,B;
  given C being Category such that
 C = CatStr(#A, B, F, G, c#);
  mode Indexing of F, G, c, i -> Indexing of F,G means


    (for a being
Element of A holds it`2.(i.a) = id (it`1.a)) & for m1, m2 being Element of B st
    F.m2 = G.m1 holds it`2.(c.[m2,m1]) = (it`2.m2)*(it`2.m1);
end;

definition
  let C be Category;
  mode Indexing of C is Indexing of the Source of C, the Target of C, the Comp
    of C, IdMap C;
  mode coIndexing of C is Indexing of the Target of C, the Source of C, ~(the
    Comp of C), IdMap C;
end;

theorem 
  for C being Category, I being Indexing of the Source of C, the
Target of C holds I is Indexing of C iff (for a being Object of C holds I`2.id
a = id (I`1.a)) & for m1, m2 being Morphism of C st dom m2 = cod m1 holds I`2.(
  m2(*)m1) = (I`2.m2)*(I`2.m1);

theorem 
  for C being Category, I being Indexing of the Target of C, the
Source of C holds I is coIndexing of C iff (for a being Object of C holds I`2.
id a = id (I`1.a)) & for m1, m2 being Morphism of C st dom m2 = cod m1 holds I
  `2.(m2(*)m1) = (I`2.m1)*(I`2.m2);

theorem 
  for C being Category, x be set holds x is coIndexing of C iff x is
  Indexing of C opp;

theorem 
  for C being Category, I being Indexing of C for c1,c2 being Object of
  C st Hom(c1,c2) is non empty for m being Morphism of c1,c2 holds I`2.m is
  Functor of I`1.c1, I`1.c2;

theorem 
  for C being Category, I being coIndexing of C for c1,c2 being Object
  of C st Hom(c1,c2) is non empty for m being Morphism of c1,c2 holds I`2.m is
  Functor of I`1.c2, I`1.c1;

definition
  let C be Category;
  let I be Indexing of C;
  let T be TargetCat of I;
  func I-functor(C,T) -> Functor of C,T means


  for f being Morphism of C holds it.f = [[I`1.dom f, I`1.cod f], I`2.f];
end;

theorem 
  for C being Category, I being Indexing of C for T1,T2 being
TargetCat of I holds I-functor(C,T1) = I-functor(C,T2) & Obj (I-functor(C,T1))
  = Obj (I-functor(C,T2));

theorem 
  for C being Category, I being Indexing of C for T being TargetCat of I
  holds Obj (I-functor(C,T)) = I`1;

theorem 
  for C being Category, I being Indexing of C for T being TargetCat of I
  , x being Object of C holds (I-functor(C,T)).x = I`1.x;

definition
  let C be Category;
  let I be Indexing of C;
  func rng I -> strict TargetCat of I means


  for T being TargetCat of I holds it = Image (I-functor(C,T));
end;

theorem 
  for C being Category, I be Indexing of C for D being Categorial
  Category holds rng I is Subcategory of D iff D is TargetCat of I;

definition
  let C be Category;
  let I be Indexing of C;
  let m be Morphism of C;
  func I.m -> Functor of I`1.dom m, I`1.cod m equals

  I`2.m;
end;

definition
  let C be Category;
  let I be coIndexing of C;
  let m be Morphism of C;
  func I.m -> Functor of I`1.cod m, I`1.dom m equals

  I`2.m;
end;

theorem 
  for C,D being Category holds [(the carrier of C) --> D, (the carrier'
of C) --> id D] is Indexing of C & [(the carrier of C) --> D, (the carrier' of
  C) --> id D] is coIndexing of C;

begin 

registration
  let C be Category, D be Categorial Category;
  let F be Functor of C,D;
  cluster Obj F -> Category-yielding;
end;

theorem 
  for C being Category, D being Categorial Category, F being
  Functor of C,D holds [Obj F, pr2 F] is Indexing of C;

definition
  let C be Category;
  let D be Categorial Category;
  let F be Functor of C,D;
  func F-indexing_of C -> Indexing of C equals

  [Obj F, pr2 F];
end;

theorem 
  for C being Category, D being Categorial Category, F being Functor of
  C,D holds D is TargetCat of F-indexing_of C;

theorem 
  for C being Category, D being Categorial Category, F being
  Functor of C,D for T being TargetCat of F-indexing_of C holds F = (F
  -indexing_of C)-functor(C,T);

theorem 
  for C being Category, D,E being Categorial Category for F being
  Functor of C,D for G being Functor of C,E st F = G holds F-indexing_of C = G
  -indexing_of C;

theorem 
  for C being Category, I being (Indexing of C), T being TargetCat
  of I holds pr2 (I-functor(C,T)) = I`2;

theorem 
  for C being Category, I being (Indexing of C), T being TargetCat of I
  holds (I-functor(C,T))-indexing_of C = I;

begin

definition
  let C,D,E be Category;
  let F be Functor of C,D;
  let I be Indexing of E;
  assume
 Image F is Subcategory of E;
  func I*F -> Indexing of C means


  for F9 being Functor of C,E st F9 =
  F holds it = (I-functor(E,rng I)*F9)-indexing_of C;
end;

theorem 
  for C,D1,D2,E being Category, I being Indexing of E for F being
  Functor of C,D1 for G being Functor of C,D2 st Image F is Subcategory of E &
  Image G is Subcategory of E & F = G holds I*F = I*G;

theorem 
  for C,D being Category, F being Functor of C,D, I being Indexing
of D for T being TargetCat of I holds I*F = ((I-functor(D,T))*F)-indexing_of C;

theorem 
  for C,D being Category, F being Functor of C,D, I being Indexing
  of D for T being TargetCat of I holds T is TargetCat of I*F;

theorem 
  for C,D being Category, F being Functor of C,D, I being Indexing of D
  for T being TargetCat of I holds rng (I*F) is Subcategory of T;

theorem 
  for C,D,E being Category, F being Functor of C,D for G being
  Functor of D,E, I being Indexing of E holds (I*G)*F = I*(G*F);

definition
  let C be Category;
  let I be Indexing of C;
  let D be Categorial Category such that
 D is TargetCat of I;
  let E be Categorial Category;
  let F be Functor of D,E;
  func F*I -> Indexing of C means


  for T being TargetCat of I, G being
Functor of T,E st T = D & G = F holds it = (G*(I-functor(C,T)))-indexing_of C;
end;

theorem 
  for C being Category, I being Indexing of C for T being
TargetCat of I, D,E being Categorial Category for F being Functor of T,D for G
  being Functor of T,E st F = G holds F*I = G*I;

theorem 
  for C being Category, I being Indexing of C for T being
  TargetCat of I, D being Categorial Category for F being Functor of T,D holds
  Image F is TargetCat of F*I;

theorem 
  for C being Category, I being Indexing of C for T being
TargetCat of I, D being Categorial Category for F being Functor of T,D holds D
  is TargetCat of F*I;

theorem 
  for C being Category, I being Indexing of C for T being TargetCat of I
  , D being Categorial Category for F being Functor of T,D holds rng (F*I) is
  Subcategory of Image F;

theorem 
  for C be Category, I being Indexing of C for T being TargetCat of I
  for D,E being Categorial Category, F being Functor of T,D for G being Functor
  of D,E holds (G*F)*I = G*(F*I);

definition
  let C,D be Category;
  let I1 be Indexing of C;
  let I2 be Indexing of D;
  func I2*I1 -> Indexing of C equals

  I2*(I1-functor(C,rng I1));
end;

theorem 
  for C being Category, D being Categorial Category, I1 being
  Indexing of C for I2 being Indexing of D for T being TargetCat of I1 st D is
  TargetCat of I1 holds I2*I1 = I2*(I1-functor(C,T));

theorem 
  for C being Category, D being Categorial Category, I1 being Indexing
  of C for I2 being Indexing of D for T being TargetCat of I2 st D is TargetCat
  of I1 holds I2*I1 = (I2-functor(D,T))*I1;

theorem 
  for C,D being Category, F being Functor of C,D, I being Indexing
  of D for T being TargetCat of I, E being Categorial Category for G being
  Functor of T,E holds (G*I)*F = G*(I*F);

theorem 
  for C being Category, I being Indexing of C for T being TargetCat of I
, D being Categorial Category for F being Functor of T,D, J being Indexing of D
  holds (J*F)*I = J*(F*I);

theorem 
  for C being Category, I being Indexing of C for T1 being TargetCat of
  I, J being Indexing of T1 for T2 being TargetCat of J for D being Categorial
  Category, F being Functor of T2,D holds (F*J)*I = F*(J*I);

theorem 
  for C,D being Category, F being Functor of C,D, I being Indexing
of D for T being TargetCat of I, J being Indexing of T holds (J*I)*F = J*(I*F);

theorem 
  for C being Category, I being Indexing of C for D being TargetCat of I
, J being Indexing of D for E being TargetCat of J, K being Indexing of E holds
  (K*J)*I = K*(J*I);

theorem 
 for C being Category holds IdMap C = IdMap(C opp);














begin

theorem 
  for M being MetrSpace, x1,x2 being Point of M, r1,r2 being Real
ex x being Point of M, r being Real st Ball(x1,r1) \/ Ball(x2,r2) c= Ball(x,r);

theorem 
  for M being MetrSpace, n being Nat, F being Subset-Family of M, p
  being FinSequence st F is being_ball-family & rng p = F & dom p = Seg(n+1)
holds ex G being Subset-Family of M st (G is finite & G is being_ball-family &
ex q being FinSequence st rng q = G & dom q = Seg(n) & ex x being Point of M st
  ex r being Real st union F c= union G \/ Ball(x,r) );

theorem 
  for M being MetrSpace, F being Subset-Family of M st F is finite
  & F is being_ball-family holds ex x being Point of M, r being Real st union F
  c= Ball(x,r);

theorem 
  for T,S being non empty TopSpace, f being Function of T,S, B
  being Subset-Family of S st f is continuous & B is open holds f"B is open;

theorem 
  for T,S being non empty TopSpace holds for f being Function of T,S
  holds for Q being Subset-Family of S holds Q is finite implies f"Q is finite;

theorem 
  for T,S being non empty TopSpace holds for f being Function of T,S
  holds for P being Subset-Family of T holds P is finite implies f.:P is finite
;

theorem 
  for T,S being non empty TopSpace holds for f being Function of T
,S holds for P being Subset of T holds for F being Subset-Family of S holds (ex
  B being Subset-Family of T st (B c= f"F & B is Cover of P & B is finite))
  implies ex G being Subset-Family of S st G c= F & G is Cover of f.:P & G is
  finite;

begin





theorem 
  for T,S being non empty TopSpace holds for f being Function of T
,S holds for P being Subset of T holds P is compact & f is continuous implies f
  .:P is compact;

theorem 
  for T being non empty TopSpace holds for f being Function of T,R^1
holds for P being Subset of T holds P is compact & f is continuous implies f.:P
  is compact;

theorem 
  for f being Function of TOP-REAL 2,R^1 holds for P being Subset of
TOP-REAL 2 holds P is compact & f is continuous implies f.:P is compact
;

definition

  let P be Subset of R^1;
  func [#](P) -> Subset of REAL equals

  P;
end;

theorem 
  for P being Subset of R^1 holds P is compact implies [#](P) is real-bounded;

theorem 
  for P being Subset of R^1 holds P is compact implies [#](P) is closed;

theorem 
  for P being Subset of R^1 holds P is compact implies [#](P) is compact;

definition
  let P be Subset of R^1;
  func upper_bound(P) -> Real equals

  upper_bound([#](P));
  func lower_bound(P) -> Real equals

  lower_bound([#](P));
end;

theorem 
  for T being non empty TopSpace holds for f being Function of T,
  R^1 holds for P being Subset of T holds P <> {} & P is compact & f is
continuous implies ex x1 being Point of T st x1 in P & f.x1 = upper_bound(f.:P)
;


theorem 
  for T being non empty TopSpace holds for f being Function of T,
  R^1 holds for P being Subset of T holds P <> {} & P is compact & f is
continuous implies ex x2 being Point of T st x2 in P & f.x2 = lower_bound(f.:P)
;

begin





definition
  let M be non empty MetrSpace;
  let x be Point of M;
  func dist(x) -> Function of TopSpaceMetr(M),R^1 means


  for y being Point of M holds it.y = dist(y,x);
end;

theorem 
  for M being non empty MetrSpace holds for x being Point of M
  holds dist(x) is continuous;

theorem 
  for M being non empty MetrSpace holds for x being Point of M holds for
  P being Subset of TopSpaceMetr(M) holds P <> {} & P is compact implies ex x1
being Point of TopSpaceMetr(M) st x1 in P & (dist(x)).x1 = upper_bound((dist(x)
  ).:P);

theorem 
  for M being non empty MetrSpace holds for x being Point of M holds for
  P being Subset of TopSpaceMetr(M) holds P <> {} & P is compact implies ex x2
being Point of TopSpaceMetr(M) st x2 in P & (dist(x)).x2 = lower_bound((dist(x)
  ).:P);

definition
  let M be non empty MetrSpace;
  let P be Subset of TopSpaceMetr(M);
  func dist_max(P) -> Function of TopSpaceMetr(M),R^1 means


  for x being Point of M holds it.x = upper_bound((dist(x)).:P);
  func dist_min(P) -> Function of TopSpaceMetr(M),R^1 means


  for x being Point of M holds it.x = lower_bound((dist(x)).:P);
end;

theorem 
  for M being non empty MetrSpace holds for P being Subset of
  TopSpaceMetr(M) st P is compact for p1,p2 being Point of M holds p1 in P
implies dist(p1,p2) <= upper_bound((dist(p2)).:P) & lower_bound((dist(p2)).:P)
  <= dist(p1,p2);

theorem 
  for M being non empty MetrSpace holds for P being Subset of
  TopSpaceMetr(M) st P <> {} & P is compact holds for p1,p2 being Point of M
holds abs(upper_bound((dist(p1)).:P) - upper_bound((dist(p2)).:P)) <= dist(p1,
  p2);

theorem 
  for M being non empty MetrSpace holds for P being Subset of
  TopSpaceMetr(M) st P <> {} & P is compact holds for p1,p2 being Point of M
holds for x1,x2 being Real holds x1 = (dist_max(P)).p1 & x2 = (dist_max(P)).p2
  implies abs(x1 - x2) <= dist(p1,p2);

theorem 
  for M being non empty MetrSpace holds for P being Subset of
  TopSpaceMetr(M) st P <> {} & P is compact holds for p1,p2 being Point of M
holds abs(lower_bound((dist(p1)).:P) - lower_bound((dist(p2)).:P)) <= dist(p1,
  p2);

theorem 
  for M being non empty MetrSpace holds for P being Subset of
  TopSpaceMetr(M) st P <> {} & P is compact holds for p1,p2 being Point of M
holds for x1,x2 being Real holds x1 = (dist_min(P)).p1 & x2 = (dist_min(P)).p2
  implies abs(x1 - x2) <= dist(p1,p2);

theorem 
  for M being non empty MetrSpace holds for X being Subset of
  TopSpaceMetr(M) st X <> {} & X is compact holds dist_max(X) is continuous;

theorem 
  for M being non empty MetrSpace holds for P,Q being Subset of
  TopSpaceMetr(M) holds P <> {} & P is compact & Q <> {} & Q is compact implies
  ex x1 being Point of TopSpaceMetr(M) st x1 in Q & (dist_max(P)).x1 =
  upper_bound((dist_max(P)).:Q);

theorem 
  for M being non empty MetrSpace holds for P,Q being Subset of
  TopSpaceMetr(M) holds P <> {} & P is compact & Q <> {} & Q is compact implies
  ex x2 being Point of TopSpaceMetr(M) st x2 in Q & (dist_max(P)).x2 =
  lower_bound((dist_max(P)).:Q);

theorem 
  for M being non empty MetrSpace holds for X being Subset of
  TopSpaceMetr(M) st X <> {} & X is compact holds dist_min(X) is continuous;

theorem 
  for M being non empty MetrSpace holds for P,Q being Subset of
  TopSpaceMetr(M) holds P <> {} & P is compact & Q <> {} & Q is compact implies
  ex x1 being Point of TopSpaceMetr(M) st x1 in Q & (dist_min(P)).x1 =
  upper_bound((dist_min(P)).:Q);

theorem 
  for M being non empty MetrSpace holds for P,Q being Subset of
  TopSpaceMetr(M) holds P <> {} & P is compact & Q <> {} & Q is compact implies
  ex x2 being Point of TopSpaceMetr(M) st x2 in Q & (dist_min(P)).x2 =
  lower_bound((dist_min(P)).:Q);

definition
  let M be non empty MetrSpace;
  let P,Q be Subset of TopSpaceMetr(M);
  func min_dist_min(P,Q) -> Real equals

  lower_bound((dist_min(P)).:Q);
  func max_dist_min(P,Q) -> Real equals

  upper_bound((dist_min(P)).:Q);
  func min_dist_max(P,Q) -> Real equals

  lower_bound((dist_max(P)).:Q);
  func max_dist_max(P,Q) -> Real equals

  upper_bound((dist_max(P)).:Q);
end;

theorem 
  for M being non empty MetrSpace holds for P,Q being Subset of
TopSpaceMetr(M) st P <> {} & P is compact & Q <> {} & Q is compact holds ex x1,
  x2 being Point of M st x1 in P & x2 in Q & dist(x1,x2) = min_dist_min(P,Q);

theorem 
  for M being non empty MetrSpace holds for P,Q being Subset of
TopSpaceMetr(M) st P <> {} & P is compact & Q <> {} & Q is compact holds ex x1,
  x2 being Point of M st x1 in P & x2 in Q & dist(x1,x2) = min_dist_max(P,Q);

theorem 
  for M being non empty MetrSpace holds for P,Q being Subset of
TopSpaceMetr(M) st P <> {} & P is compact & Q <> {} & Q is compact holds ex x1,
  x2 being Point of M st x1 in P & x2 in Q & dist(x1,x2) = max_dist_min(P,Q);

theorem 
  for M being non empty MetrSpace holds for P,Q being Subset of
TopSpaceMetr(M) st P <> {} & P is compact & Q <> {} & Q is compact holds ex x1,
  x2 being Point of M st x1 in P & x2 in Q & dist(x1,x2) = max_dist_max(P,Q);

theorem 
  for M being non empty MetrSpace holds for P,Q being Subset of
TopSpaceMetr(M) st P is compact & Q is compact holds for x1,x2 being Point of M
  st x1 in P & x2 in Q holds min_dist_min(P,Q) <= dist(x1,x2) & dist(x1,x2) <=
  max_dist_max(P,Q);



















begin 

registration
  cluster pair -> non empty for set;
end;

registration
  cluster non pair for set;
end;

registration
  cluster -> non pair for Nat;
end;

definition
 canceled;
  let IT be set;
  attr IT is with_pair means


  ex x being pair set st x in IT;
end;

notation
  let IT be set;
  antonym IT is without_pairs for IT is with_pair;
end;

registration
  cluster empty -> without_pairs for set;
  let x be non pair set;
  cluster {x} -> without_pairs;
  let y be non pair set;
  cluster {x,y} -> without_pairs;
  let z be non pair set;
  cluster {x,y,z} -> without_pairs;
end;

registration
  cluster without_pairs for non empty set;
end;

registration
  let X, Y be without_pairs set;
  cluster X \/ Y -> without_pairs;
end;

registration
  let X be without_pairs set, Y be set;
  cluster X \ Y -> without_pairs;
  cluster X /\ Y -> without_pairs;
  cluster Y /\ X -> without_pairs;
end;

registration
  let x be pair set;
  cluster {x} -> Relation-like;
  let y be pair set;
  cluster {x,y} -> Relation-like;
  let z be pair set;
  cluster {x,y,z} -> Relation-like;
end;

registration
  cluster without_pairs Relation-like -> empty for set;
end;

definition
  let IT be Function;
  attr IT is nonpair-yielding means

  for x being set st x in dom IT holds IT.x is non pair;
end;

registration
  let x be non pair set;
  cluster <*x*> -> nonpair-yielding;
  let y be non pair set;
  cluster <*x,y*> -> nonpair-yielding;
  let z be non pair set;
  cluster <*x,y,z*> -> nonpair-yielding;
end;

theorem 
  for f being Function st f is nonpair-yielding holds rng f is without_pairs;

registration
  let n be Nat;
  cluster one-to-one nonpair-yielding for FinSeqLen of n;
end;

registration
  cluster one-to-one nonpair-yielding for FinSequence;
end;

registration
  let f be nonpair-yielding Function;
  cluster rng f -> without_pairs;
end;

theorem 
  for S1,S2 being non empty ManySortedSign st S1 tolerates S2 &
InnerVertices S1 is Relation & InnerVertices S2 is Relation holds InnerVertices
  (S1+*S2) is Relation;

theorem 
  for S1,S2 being unsplit gate`1=arity non empty ManySortedSign st
InnerVertices S1 is Relation & InnerVertices S2 is Relation holds InnerVertices
  (S1+*S2) is Relation;

theorem 
  for S1,S2 being non empty ManySortedSign st S1 tolerates S2 &
  InnerVertices S2 misses InputVertices S1 holds InputVertices S1 c=
  InputVertices (S1+*S2) & InputVertices (S1+*S2) = (InputVertices S1) \/ (
  InputVertices S2 \ InnerVertices S1);

theorem 
  for X,R being set st X is without_pairs & R is Relation holds X misses R;

theorem 
  for S1,S2 being unsplit gate`1=arity non empty ManySortedSign st
  InputVertices S1 is without_pairs & InnerVertices S2 is Relation holds
  InputVertices S1 c= InputVertices (S1+*S2) & InputVertices (S1+*S2) = (
  InputVertices S1) \/ (InputVertices S2 \ InnerVertices S1);

theorem 
  for S1,S2 being unsplit gate`1=arity non empty ManySortedSign st
  InputVertices S1 is without_pairs & InnerVertices S1 is Relation &
  InputVertices S2 is without_pairs & InnerVertices S2 is Relation holds
  InputVertices (S1+*S2) = (InputVertices S1) \/ (InputVertices S2);

theorem 
  for S1,S2 being non empty ManySortedSign st S1 tolerates S2 &
  InputVertices S1 is without_pairs & InputVertices S2 is without_pairs holds
  InputVertices (S1+*S2) is without_pairs;

theorem 
  for S1,S2 being unsplit gate`1=arity non empty ManySortedSign st
  InputVertices S1 is without_pairs & InputVertices S2 is without_pairs holds
  InputVertices (S1+*S2) is without_pairs;

begin 

definition
  let i be Nat, D be non empty set;
  mode Tuple of i,D is Element of i-tuples_on D;
end;

scheme 

  2AryBooleEx {F(set,set) -> Element of BOOLEAN}: ex f being Function of 2
-tuples_on BOOLEAN, BOOLEAN st for x,y being Element of BOOLEAN holds f.<*x,y*>
  = F(x,y);

scheme 

  2AryBooleUniq {F(set,set) -> Element of BOOLEAN}: for f1,f2 being Function
of 2-tuples_on BOOLEAN, BOOLEAN st (for x,y being Element of BOOLEAN holds f1.
<*x,y*> = F(x,y)) & (for x,y being Element of BOOLEAN holds f2.<*x,y*> = F(x,y)
  ) holds f1 = f2;

scheme 

  2AryBooleDef {F(set,set) -> Element of BOOLEAN}: (ex f being Function of 2
-tuples_on BOOLEAN, BOOLEAN st for x,y being Element of BOOLEAN holds f.<*x,y*>
= F(x,y)) & for f1,f2 being Function of 2-tuples_on BOOLEAN, BOOLEAN st (for x,
y being Element of BOOLEAN holds f1.<*x,y*> = F(x,y)) & (for x,y being Element
  of BOOLEAN holds f2.<*x,y*> = F(x,y)) holds f1 = f2;

scheme 

  3AryBooleEx {F(set,set,set) -> Element of BOOLEAN}: ex f being Function of 3
-tuples_on BOOLEAN, BOOLEAN st for x,y,z being Element of BOOLEAN holds f.<*x,y
  ,z*> = F(x,y,z);

scheme 

  3AryBooleUniq {F(set,set,set) -> Element of BOOLEAN}: for f1,f2 being
Function of 3-tuples_on BOOLEAN, BOOLEAN st (for x,y,z being Element of BOOLEAN
holds f1.<*x,y,z*> = F(x,y,z)) & (for x,y,z being Element of BOOLEAN holds f2.
  <*x,y,z*> = F(x,y,z)) holds f1 = f2;

scheme 

  3AryBooleDef {F(set,set,set) -> Element of BOOLEAN}: (ex f being Function of
3-tuples_on BOOLEAN, BOOLEAN st for x,y,z being Element of BOOLEAN holds f.<*x,
y,z*> = F(x,y,z)) & for f1,f2 being Function of 3-tuples_on BOOLEAN, BOOLEAN st
(for x,y,z being Element of BOOLEAN holds f1.<*x,y,z*> = F(x,y,z)) & (for x,y,z
  being Element of BOOLEAN holds f2.<*x,y,z*> = F(x,y,z)) holds f1 = f2;

definition
  func 'xor' -> Function of 2-tuples_on BOOLEAN, BOOLEAN means


  for x,y being Element of BOOLEAN holds it.<*x,y*> = x 'xor' y;
  func 'or' -> Function of 2-tuples_on BOOLEAN, BOOLEAN means


  for x,y being Element of BOOLEAN holds it.<*x,y*> = x 'or' y;
  func '&' -> Function of 2-tuples_on BOOLEAN, BOOLEAN means


  for x,y being Element of BOOLEAN holds it.<*x,y*> = x '&' y;
end;

definition
  func or3 -> Function of 3-tuples_on BOOLEAN, BOOLEAN means


  for x,y,z being Element of BOOLEAN holds it.<*x,y,z*> = x 'or' y 'or' z;
end;

begin 

theorem 
  for S being Circuit-like non void non empty ManySortedSign for
A being non-empty Circuit of S for s being State of A, g being Gate of S holds
  (Following s).the_result_sort_of g = Den(g, A).(s*the_arity_of g);

definition
  let S be non void Circuit-like non empty ManySortedSign;
  let A be non-empty Circuit of S;
  let s be State of A;
  let n be Nat;
  func Following(s,n) -> State of A means


  ex f being Function of NAT,
product the Sorts of A st it = f.n & f.0 = s & for n being Nat holds f.(n+1) =
  Following f.n;
end;

theorem 
  for S being Circuit-like non void non empty ManySortedSign for
  A being non-empty Circuit of S, s being State of A holds Following(s,0) = s;

theorem 
  for S being Circuit-like non void non empty ManySortedSign for
  A being non-empty Circuit of S, s being State of A for n being Nat holds
  Following(s,n+1) = Following Following(s,n);

theorem 
  for S being Circuit-like non void non empty ManySortedSign for
  A being non-empty Circuit of S, s being State of A for n,m being Nat holds
  Following(s,n+m) = Following(Following(s,n),m);

theorem 
  for S being non void Circuit-like non empty ManySortedSign for
  A being non-empty Circuit of S, s being State of A holds Following(s,1) =
  Following s;

theorem 
  for S being non void Circuit-like non empty ManySortedSign for
  A being non-empty Circuit of S, s being State of A holds Following(s,2) =
  Following Following s;

theorem 
  for S being Circuit-like non void non empty ManySortedSign for
  A being non-empty Circuit of S, s being State of A for n being Nat holds
  Following(s,n+1) = Following(Following s, n);

definition
  let S be non void Circuit-like non empty ManySortedSign;
  let A be non-empty Circuit of S;
  let s be State of A;
  let x be set;
  pred s is_stable_at x means


  for n being Nat holds (Following(s,n)).x = s.x;
end;

theorem 
  for S being non void Circuit-like non empty ManySortedSign for A
  being non-empty Circuit of S, s being State of A for x being set st s
  is_stable_at x for n being Nat holds Following(s,n) is_stable_at x;

theorem 
  for S being non void Circuit-like non empty ManySortedSign for A
  being non-empty Circuit of S, s being State of A for x being set st x in
  InputVertices S holds s is_stable_at x;

theorem 
  for S being non void Circuit-like non empty ManySortedSign for
A being non-empty Circuit of S, s being State of A for g being Gate of S st for
x being set st x in rng the_arity_of g holds s is_stable_at x holds Following s
  is_stable_at the_result_sort_of g;

begin 

theorem 
  for S1,S2 being non empty ManySortedSign, v being Vertex of S1
  holds v in the carrier of S1+*S2 & v in the carrier of S2+*S1;

theorem 
  for S1,S2 being unsplit gate`1=arity non empty ManySortedSign
for x being set st x in InnerVertices S1 holds x in InnerVertices (S1+*S2) & x
  in InnerVertices (S2+*S1);

theorem 
  for S1,S2 being non empty ManySortedSign for x being set st x in
  InnerVertices S2 holds x in InnerVertices (S1+*S2);

theorem 
  for S1,S2 being unsplit gate`1=arity non empty ManySortedSign holds S1
  +*S2 = S2+*S1;

theorem 
  for S1,S2 being unsplit gate`1=arity gate`2isBoolean non void non
empty ManySortedSign for A1 being Boolean gate`2=den Circuit of S1 for A2 being
  Boolean gate`2=den Circuit of S2 holds A1+*A2 = A2+*A1;

theorem 
  for S1,S2,S3 be unsplit gate`1=arity gate`2isBoolean non void
  non empty ManySortedSign for A1 being Boolean Circuit of S1, A2 being Boolean
Circuit of S2 for A3 being Boolean Circuit of S3 holds (A1+*A2)+*A3 = A1+*(A2+*
  A3);

theorem 
  for S1,S2 being unsplit gate`1=arity gate`2isBoolean non void
  non empty ManySortedSign for A1 being Boolean gate`2=den non-empty Circuit of
S1 for A2 being Boolean gate`2=den non-empty Circuit of S2 for s being State of
A1+*A2 holds s|the carrier of S1 is State of A1 & s|the carrier of S2 is State
  of A2;

theorem 
  for S1,S2 being unsplit gate`1=arity non empty ManySortedSign
  holds InnerVertices (S1+*S2) = (InnerVertices S1) \/ InnerVertices S2;

theorem 
  for S1,S2 being unsplit gate`1=arity gate`2isBoolean non void
  non empty ManySortedSign st InnerVertices S2 misses InputVertices S1 for A1
being Boolean gate`2=den Circuit of S1 for A2 being Boolean gate`2=den Circuit
  of S2 for s being State of A1+*A2, s1 being State of A1 st s1 = s|the carrier
  of S1 holds (Following s)|the carrier of S1 = Following s1;

theorem 
  for S1,S2 being unsplit gate`1=arity gate`2isBoolean non void
  non empty ManySortedSign st InnerVertices S1 misses InputVertices S2 for A1
being Boolean gate`2=den Circuit of S1 for A2 being Boolean gate`2=den Circuit
  of S2 for s being State of A1+*A2, s2 being State of A2 st s2 = s|the carrier
  of S2 holds (Following s)|the carrier of S2 = Following s2;

theorem 
  for S1,S2 being unsplit gate`1=arity gate`2isBoolean non void
  non empty ManySortedSign st InnerVertices S2 misses InputVertices S1 for A1
being Boolean gate`2=den Circuit of S1 for A2 being Boolean gate`2=den Circuit
  of S2 for s being State of A1+*A2, s1 being State of A1 st s1 = s|the carrier
of S1 for n being Nat holds Following(s,n)|the carrier of S1 = Following(s1,n);

theorem 
  for S1,S2 being unsplit gate`1=arity gate`2isBoolean non void
  non empty ManySortedSign st InnerVertices S1 misses InputVertices S2 for A1
being Boolean gate`2=den Circuit of S1 for A2 being Boolean gate`2=den Circuit
  of S2 for s being State of A1+*A2, s2 being State of A2 st s2 = s|the carrier
of S2 for n being Nat holds Following(s,n)|the carrier of S2 = Following(s2,n);

theorem 
  for S1,S2 being unsplit gate`1=arity gate`2isBoolean non void
  non empty ManySortedSign st InnerVertices S2 misses InputVertices S1 for A1
being Boolean gate`2=den Circuit of S1 for A2 being Boolean gate`2=den Circuit
  of S2 for s being State of A1+*A2, s1 being State of A1 st s1 = s|the carrier
  of S1 holds for v being set st v in the carrier of S1 for n being Nat holds (
  Following(s,n)).v = (Following(s1,n)).v;

theorem 
  for S1,S2 being unsplit gate`1=arity gate`2isBoolean non void
  non empty ManySortedSign st InnerVertices S1 misses InputVertices S2 for A1
being Boolean gate`2=den Circuit of S1 for A2 being Boolean gate`2=den Circuit
  of S2 for s being State of A1+*A2, s2 being State of A2 st s2 = s|the carrier
  of S2 holds for v being set st v in the carrier of S2 for n being Nat holds (
  Following(s,n)).v = (Following(s2,n)).v;

registration
  let S be gate`2=den non void non empty ManySortedSign;
  let g be Gate of S;
  cluster g`2 -> Function-like Relation-like;
end;

theorem 
  for S being gate`2=den Circuit-like non void non empty
  ManySortedSign for A being non-empty Circuit of S st A is gate`2=den for s
being State of A, g being Gate of S holds (Following s).the_result_sort_of g =
  g`2.(s*the_arity_of g);

theorem 
  for S being gate`1=arity gate`2isBoolean unsplit non void non
empty ManySortedSign for A being Boolean gate`2=den non-empty Circuit of S for
  s being State of A, p being FinSequence, f being Function st [p,f] in the
  carrier' of S holds (Following s).[p,f] = f.(s*p);

theorem 
  for S being gate`1=arity gate`2isBoolean unsplit non void non empty
  ManySortedSign for A being Boolean gate`2=den non-empty Circuit of S for s
  being State of A, p being FinSequence, f being Function st [p,f] in the
  carrier' of S & for x being set st x in rng p holds s is_stable_at x holds
  Following s is_stable_at [p,f];

theorem 
  for S being unsplit non empty ManySortedSign holds InnerVertices
  S = the carrier' of S;

begin 

theorem 
  for f being set, p being FinSequence holds InnerVertices
  1GateCircStr(p,f) is Relation;

theorem 
  for f being set, p being nonpair-yielding FinSequence holds
  InputVertices 1GateCircStr(p,f) is without_pairs;

theorem 
  for f being set, x,y being set holds InputVertices 1GateCircStr(
  <*x,y*>,f) = {x,y};

theorem 
  for f being set, x,y being non pair set holds InputVertices
  1GateCircStr(<*x,y*>,f) is without_pairs;

theorem 
  for f being set, x,y,z being set holds InputVertices
  1GateCircStr(<*x,y,z*>,f) = {x,y,z};

theorem 
  for x,y,f being set holds x in the carrier of 1GateCircStr(<*x,y
  *>,f) & y in the carrier of 1GateCircStr(<*x,y*>,f) & [<*x,y*>,f] in the
  carrier of 1GateCircStr(<*x,y*>,f);

theorem 
  for x,y,z,f being set holds x in the carrier of 1GateCircStr(<*x
,y,z*>,f) & y in the carrier of 1GateCircStr(<*x,y,z*>,f) & z in the carrier of
  1GateCircStr(<*x,y,z*>,f);

theorem 
  for f,x being set, p being FinSequence holds x in the carrier of
  1GateCircStr(p,f,x) & for y being set st y in rng p holds y in the carrier of
  1GateCircStr(p,f,x);

theorem 
  for f,x being set, p being FinSequence holds 1GateCircStr(p,f,x) is
  gate`1=arity Circuit-like;

theorem 
  for p being FinSequence, f be set holds [p,f] in InnerVertices
  1GateCircStr(p,f);

definition
  let x,y be set;
  let f be Function of 2-tuples_on BOOLEAN, BOOLEAN;
  func 1GateCircuit(x,y,f) -> Boolean gate`2=den strict Circuit of
  1GateCircStr(<*x,y*>, f) equals

  1GateCircuit(<*x,y*>, f);
end;

reserve x,y,z,c for set,
  f for Function of 2-tuples_on BOOLEAN, BOOLEAN;

theorem 
  for X being finite non empty set, f being Function of 2
-tuples_on X, X for s being State of 1GateCircuit(<*x,y*>,f) holds (Following s
).[<*x,y*>, f] = f.<*s.x, s.y*> & (Following s).x = s.x & (Following s).y = s.y
;

theorem 
  for X being finite non empty set, f being Function of 2
-tuples_on X, X for s being State of 1GateCircuit(<*x,y*>,f) holds Following s
  is stable;

theorem 
  for s being State of 1GateCircuit(x,y,f) holds (Following s).[<*x,y*>,
  f] = f.<*s.x, s.y*> & (Following s).x = s.x & (Following s).y = s.y;

theorem 
  for s being State of 1GateCircuit(x,y,f) holds Following s is stable;

definition
  let x,y,z be set;
  let f be Function of 3-tuples_on BOOLEAN, BOOLEAN;
  func 1GateCircuit(x,y,z,f) -> Boolean gate`2=den strict Circuit of
  1GateCircStr(<*x,y,z*>, f) equals

  1GateCircuit(<*x,y,z*>, f);
end;

theorem 
  for X being finite non empty set, f being Function of 3
-tuples_on X, X for s being State of 1GateCircuit(<*x,y,z*>,f) holds (Following
s).[<*x,y,z*>, f] = f.<*s.x, s.y, s.z*> & (Following s).x = s.x & (Following s)
  .y = s.y & (Following s).z = s.z;

theorem 
  for X being finite non empty set, f being Function of 3
-tuples_on X, X for s being State of 1GateCircuit(<*x,y,z*>,f) holds Following
  s is stable;

theorem 
  for f being Function of 3-tuples_on BOOLEAN, BOOLEAN for s being State
of 1GateCircuit(x,y,z,f) holds (Following s).[<*x,y,z*>, f] = f.<*s.x, s.y, s.z
  *> & (Following s).x = s.x & (Following s).y = s.y & (Following s).z = s.z;

theorem 
  for f being Function of 3-tuples_on BOOLEAN, BOOLEAN for s being State
  of 1GateCircuit(x,y,z,f) holds Following s is stable;

begin 

definition
  let x,y,c be set;
  let f be Function of 2-tuples_on BOOLEAN, BOOLEAN;
  func 2GatesCircStr(x,y,c,f) -> unsplit gate`1=arity gate`2isBoolean non void
  strict non empty ManySortedSign equals

  1GateCircStr(<*x,y*>, f) +* 1GateCircStr
  (<*[<*x,y*>, f], c*>, f);
end;

definition
  let x,y,c be set;
  let f be Function of 2-tuples_on BOOLEAN, BOOLEAN;
  func 2GatesCircOutput(x,y,c,f) -> Element of InnerVertices 2GatesCircStr(x,y
  ,c,f) equals

  [<*[<*x,y*>, f], c*>, f];
end;

registration
  let x,y,c be set;
  let f be Function of 2-tuples_on BOOLEAN, BOOLEAN;
  cluster 2GatesCircOutput(x,y,c,f) -> pair;
end;

theorem 
  InnerVertices 2GatesCircStr(x,y,c,f) = {[<*x,y*>, f],
  2GatesCircOutput(x,y,c,f)};

theorem 
  c <> [<*x,y*>, f] implies InputVertices 2GatesCircStr(x,y,c,f) = {x,y,c};

definition
  let x,y,c be set;
  let f be Function of 2-tuples_on BOOLEAN, BOOLEAN;
  func 2GatesCircuit(x,y,c,f) -> strict Boolean gate`2=den Circuit of
  2GatesCircStr(x,y,c,f) equals

  1GateCircuit(x,y, f) +* 1GateCircuit([<*x,y*>, f]
  , c, f);
end;

theorem 
  InnerVertices 2GatesCircStr(x,y,c,f) is Relation;

theorem 
  for x,y,c being non pair set holds InputVertices 2GatesCircStr(x
  ,y,c,f) is without_pairs;

theorem 
  x in the carrier of 2GatesCircStr(x,y,c,f) & y in the carrier of
  2GatesCircStr(x,y,c,f) & c in the carrier of 2GatesCircStr(x,y,c,f);

theorem 
  [<*x,y*>,f] in the carrier of 2GatesCircStr(x,y,c,f) & [<*[<*x,y*>,f],
  c*>, f] in the carrier of 2GatesCircStr(x,y,c,f);

definition
  let S be unsplit non void non empty ManySortedSign;
  let A be Boolean Circuit of S;
  let s be State of A;
  let v be Vertex of S;
  redefine func s.v -> Element of BOOLEAN;
end;

reserve s for State of 2GatesCircuit(x,y,c,f);

theorem 
  c <> [<*x,y*>, f] implies (Following(s,2)).2GatesCircOutput(x,y,
c,f) = f.<*f.<*s.x, s.y*>, s.c*> & (Following(s,2)).[<*x,y*>,f] = f.<*s.x, s.y
*> & (Following(s,2)).x = s.x & (Following(s,2)).y = s.y & (Following(s,2)).c =
  s.c;

theorem 
  c <> [<*x,y*>, f] implies Following(s,2) is stable;

theorem 
  c <> [<*x,y*>, 'xor'] implies for s being State of 2GatesCircuit
(x,y,c,'xor') for a1,a2,a3 being Element of BOOLEAN st a1 = s.x & a2 = s.y & a3
= s.c holds (Following(s,2)).2GatesCircOutput(x,y,c,'xor') = a1 'xor' a2 'xor'
  a3;

theorem 
  c <> [<*x,y*>, 'or'] implies for s being State of 2GatesCircuit(x,y,c,
  'or') for a1,a2,a3 being Element of BOOLEAN st a1 = s.x & a2 = s.y & a3 = s.c
  holds (Following(s,2)).2GatesCircOutput(x,y,c,'or') = a1 'or' a2 'or' a3;

theorem 
  c <> [<*x,y*>, '&'] implies for s being State of 2GatesCircuit(x,y,c,
  '&') for a1,a2,a3 being Element of BOOLEAN st a1 = s.x & a2 = s.y & a3 = s.c
  holds (Following(s,2)).2GatesCircOutput(x,y,c,'&') = a1 '&' a2 '&' a3;

begin 

definition
  let x,y,c be set;
  func BitAdderOutput(x,y,c) -> Element of InnerVertices 2GatesCircStr(x,y,c,
  'xor') equals

  2GatesCircOutput(x,y,c, 'xor');
end;

definition
  let x,y,c be set;
  func BitAdderCirc(x,y,c) -> strict Boolean gate`2=den Circuit of
  2GatesCircStr(x,y,c, 'xor') equals

  2GatesCircuit(x,y,c, 'xor');
end;

definition
  let x,y,c be set;
  func MajorityIStr(x,y,c) -> unsplit gate`1=arity gate`2isBoolean non void
  strict non empty ManySortedSign equals

  1GateCircStr(<*x,y*>, '&') +*
  1GateCircStr(<*y,c*>, '&') +* 1GateCircStr(<*c,x*>, '&');
end;

definition
  let x,y,c be set;
  func MajorityStr(x,y,c) -> unsplit gate`1=arity gate`2isBoolean non void
  strict non empty ManySortedSign equals

  MajorityIStr(x,y,c) +* 1GateCircStr(<*[
  <*x,y*>, '&'], [<*y,c*>, '&'], [<*c,x*>, '&']*>, or3);
end;

definition
  let x,y,c be set;
  func MajorityICirc(x,y,c) -> strict Boolean gate`2=den Circuit of
  MajorityIStr(x,y,c) equals

  1GateCircuit(x,y, '&') +* 1GateCircuit(y,c, '&') +*
  1GateCircuit(c,x, '&');
end;

theorem 
  InnerVertices MajorityStr(x,y,c) is Relation;

theorem 
  for x,y,c being non pair set holds InputVertices MajorityStr(x,y
  ,c) is without_pairs;

theorem 
  for s being State of MajorityICirc(x,y,c), a,b being Element of
  BOOLEAN st a = s.x & b = s.y holds (Following s).[<*x,y*>, '&'] = a '&' b;

theorem 
  for s being State of MajorityICirc(x,y,c), a,b being Element of
  BOOLEAN st a = s.y & b = s.c holds (Following s).[<*y,c*>, '&'] = a '&' b;

theorem 
  for s being State of MajorityICirc(x,y,c), a,b being Element of
  BOOLEAN st a = s.c & b = s.x holds (Following s).[<*c,x*>, '&'] = a '&' b;

definition
  let x,y,c be set;
  func MajorityOutput(x,y,c) -> Element of InnerVertices MajorityStr(x,y,c)
  equals

  [<*[<*x,y*>, '&'], [<*y,c*>, '&'], [<*c,x*>, '&']*>, or3];
end;

definition
  let x,y,c be set;
  func MajorityCirc(x,y,c) -> strict Boolean gate`2=den Circuit of MajorityStr
  (x,y,c) equals

  MajorityICirc(x,y,c) +* 1GateCircuit([<*x,y*>, '&'], [<*y,c*>,
  '&'], [<*c,x*>, '&'], or3);
end;

theorem 
  x in the carrier of MajorityStr(x,y,c) & y in the carrier of
  MajorityStr(x,y,c) & c in the carrier of MajorityStr(x,y,c);

theorem 
  [<*x,y*>,'&'] in InnerVertices MajorityStr(x,y,c) & [<*y,c*>,'&'
  ] in InnerVertices MajorityStr(x,y,c) & [<*c,x*>,'&'] in InnerVertices
  MajorityStr(x,y,c);

theorem 
  for x,y,c being non pair set holds x in InputVertices
MajorityStr(x,y,c) & y in InputVertices MajorityStr(x,y,c) & c in InputVertices
  MajorityStr(x,y,c);

theorem 
  for x,y,c being non pair set holds InputVertices MajorityStr(x,y
,c) = {x,y,c} & InnerVertices MajorityStr(x,y,c) = {[<*x,y*>,'&'], [<*y,c*>,'&'
  ], [<*c,x*>,'&']} \/ {MajorityOutput(x,y,c)};

theorem 
  for x,y,c being non pair set for s being State of MajorityCirc(x,y,c)
for a1,a2 being Element of BOOLEAN st a1 = s.x & a2 = s.y holds (Following s).[
  <*x,y*>,'&'] = a1 '&' a2;

theorem 
  for x,y,c being non pair set for s being State of MajorityCirc(x,y,c)
for a2,a3 being Element of BOOLEAN st a2 = s.y & a3 = s.c holds (Following s).[
  <*y,c*>,'&'] = a2 '&' a3;

theorem 
  for x,y,c being non pair set for s being State of MajorityCirc(x,y,c)
for a1,a3 being Element of BOOLEAN st a1 = s.x & a3 = s.c holds (Following s).[
  <*c,x*>,'&'] = a3 '&' a1;

theorem 
  for x,y,c being non pair set for s being State of MajorityCirc(x
,y,c) for a1,a2,a3 being Element of BOOLEAN st a1 = s.[<*x,y*>,'&'] & a2 = s.[
<*y,c*>,'&'] & a3 = s.[<*c,x*>,'&'] holds (Following s).MajorityOutput(x,y,c) =
  a1 'or' a2 'or' a3;

theorem 
  for x,y,c being non pair set for s being State of MajorityCirc(x,y,c)
for a1,a2 being Element of BOOLEAN st a1 = s.x & a2 = s.y holds (Following(s,2)
  ).[<*x,y*>,'&'] = a1 '&' a2;

theorem 
  for x,y,c being non pair set for s being State of MajorityCirc(x,y,c)
for a2,a3 being Element of BOOLEAN st a2 = s.y & a3 = s.c holds (Following(s,2)
  ).[<*y,c*>,'&'] = a2 '&' a3;

theorem 
  for x,y,c being non pair set for s being State of MajorityCirc(x,y,c)
for a1,a3 being Element of BOOLEAN st a1 = s.x & a3 = s.c holds (Following(s,2)
  ).[<*c,x*>,'&'] = a3 '&' a1;

theorem 
  for x,y,c being non pair set for s being State of MajorityCirc(x,y,c)
for a1,a2,a3 being Element of BOOLEAN st a1 = s.x & a2 = s.y & a3 = s.c holds (
Following(s,2)).MajorityOutput(x,y,c) = a1 '&' a2 'or' a2 '&' a3 'or' a3 '&' a1
;

theorem 
  for x,y,c being non pair set for s being State of MajorityCirc(x
  ,y,c) holds Following(s,2) is stable;

definition
  let x,y,c be set;
  func BitAdderWithOverflowStr(x,y,c) -> unsplit gate`1=arity gate`2isBoolean
  non void strict non empty ManySortedSign equals

  2GatesCircStr(x,y,c, 'xor') +*
  MajorityStr(x,y,c);
end;

theorem 
  for x,y,c being non pair set holds InputVertices
  BitAdderWithOverflowStr(x,y,c) = {x,y,c};

theorem 
  for x,y,c being non pair set holds InnerVertices
  BitAdderWithOverflowStr(x,y,c) = {[<*x,y*>, 'xor'], 2GatesCircOutput(x,y,c,
'xor')} \/ {[<*x,y*>,'&'], [<*y,c*>,'&'], [<*c,x*>,'&']} \/ {MajorityOutput(x,y
  ,c)};

theorem 
  for S being non empty ManySortedSign st S = BitAdderWithOverflowStr(x,
y,c ) holds x in the carrier of S & y in the carrier of S & c in the carrier of
  S;

definition
  let x,y,c be set;
  func BitAdderWithOverflowCirc(x,y,c) -> strict Boolean gate`2=den Circuit of
  BitAdderWithOverflowStr(x,y,c) equals

  BitAdderCirc(x,y,c) +* MajorityCirc(x,y,c
  );
end;

theorem 
  InnerVertices BitAdderWithOverflowStr(x,y,c) is Relation;

theorem 
  for x,y,c being non pair set holds InputVertices
  BitAdderWithOverflowStr(x,y,c) is without_pairs;

theorem 
  BitAdderOutput(x,y,c) in InnerVertices BitAdderWithOverflowStr(x,y,c)
& MajorityOutput(x,y,c) in InnerVertices BitAdderWithOverflowStr(x,y,c)
;

theorem 
  for x,y,c being non pair set for s being State of
BitAdderWithOverflowCirc(x,y,c) for a1,a2,a3 being Element of BOOLEAN st a1 = s
  .x & a2 = s.y & a3 = s.c holds (Following(s,2)).BitAdderOutput(x,y,c) = a1
'xor' a2 'xor' a3 & (Following(s,2)).MajorityOutput(x,y,c) = a1 '&' a2 'or' a2
  '&' a3 'or' a3 '&' a1;

theorem 
  for x,y,c being non pair set for s being State of
  BitAdderWithOverflowCirc(x,y,c) holds Following(s,2) is stable;














begin

definition
  let X be set;
  redefine attr X is binary_complete means


  for A being set st for a,b
  being set st a in A & b in A holds a \/ b in X holds union A in X;
end;

registration
  cluster finite for Coherence_Space;
end;

definition
  let X be set;
  func FlatCoh X -> set equals

  CohSp id X;
  func Sub_of_Fin X -> Subset of X means


  for x being set holds x in it iff x in X & x is finite;
end;

theorem 
  for X,x being set holds x in FlatCoh X iff x = {} or ex y being
  set st x = {y} & y in X;

theorem 
  for X being set holds union FlatCoh X = X;

theorem 
  for X being finite subset-closed set holds Sub_of_Fin X = X;

registration
  cluster {{}} -> subset-closed binary_complete;
  let X be set;
  cluster bool X -> subset-closed binary_complete;
  cluster FlatCoh X -> non empty subset-closed binary_complete;
end;

registration
  let C be non empty subset-closed set;
  cluster Sub_of_Fin C -> non empty subset-closed;
end;

theorem 
  Web {{}} = {};

scheme 

  MinimalElementwrtIncl { a, A() -> set, P[set] }: ex a being set st a in A()
  & P[a] & for b being set st b in A() & P[b] & b c= a holds b = a
provided
 a() in A() & P[a()] and
 a() is finite;

registration
  let C be Coherence_Space;
  cluster finite for Element of C;
end;

definition
  let X be set;
  attr X is c=directed means

  for Y being finite Subset of X ex a being set st union Y c= a & a in X;
  attr X is c=filtered means

  for Y being finite Subset of X ex a being set st
  (for y being set st y in Y holds a c= y) & a in X;
end;

registration
  cluster c=directed -> non empty for set;
  cluster c=filtered -> non empty for set;
end;

theorem 
  for X being set st X is c=directed for a,b being set st a in X &
  b in X ex c being set st a \/ b c= c & c in X;

theorem 
  for X being non empty set st for a,b being set st a in X & b in X
  ex c being set st a \/ b c= c & c in X holds X is c=directed;

theorem 
  for X being set st X is c=filtered for a,b being set st a in X & b in
  X ex c being set st c c= a /\ b & c in X;

theorem 
  for X being non empty set st for a,b being set st a in X & b in X
  ex c being set st c c= a /\ b & c in X holds X is c=filtered;

theorem 
  for x being set holds {x} is c=directed c=filtered;

theorem 
  for x,y being set holds {x,y,x \/ y} is c=directed;

theorem 
  for x,y being set holds {x,y,x /\ y} is c=filtered;

registration
  cluster c=directed c=filtered finite for set;
end;

registration
  let C be non empty set;
  cluster c=directed c=filtered finite for Subset of C;
end;

theorem 
  for X being set holds Fin X is c=directed c=filtered;

registration
  let X be set;
  cluster Fin X -> c=directed c=filtered;
end;

registration
  let C be subset-closed non empty set;
  cluster preBoolean non empty for Subset of C;
end;

definition
  let C be subset-closed non empty set;
  let a be Element of C;
  redefine func Fin a -> preBoolean non empty Subset of C;
end;

theorem 
  for X being non empty set, Y being set st X is c=directed & Y c=
  union X & Y is finite ex Z being set st Z in X & Y c= Z;

notation
  let X be set;
  synonym X is multiplicative for X is cap-closed;
end;

definition
  let X be set;

  attr X is d.union-closed means


  for A being Subset of X st A is c=directed holds union A in X;
end;

registration
  cluster subset-closed -> multiplicative for set;
end;

theorem 
  for C being Coherence_Space, A being c=directed Subset of C
  holds union A in C;

registration
  cluster -> d.union-closed for Coherence_Space;
end;

registration
  cluster multiplicative d.union-closed for Coherence_Space;
end;

definition
  let C be d.union-closed non empty set, A be c=directed Subset of C;
  redefine func union A -> Element of C;
end;

definition
  let X, Y be set;
  pred X includes_lattice_of Y means

  for a,b being set st a in Y & b in Y holds a /\ b in X & a \/ b in X;
end;

theorem 
  for X being non empty set st X includes_lattice_of X holds X is
  c=directed c=filtered;

definition
  let X, x, y be set;
  pred X includes_lattice_of x, y means

  X includes_lattice_of {x, y};
end;

theorem 
  for X,x,y being set holds X includes_lattice_of x, y iff x in X
  & y in X & x /\ y in X & x \/ y in X;

begin 

definition
  let f be Function;
  attr f is union-distributive means


  for A being Subset of dom f st
  union A in dom f holds f.union A = union (f.:A);
  attr f is d.union-distributive means


  for A being Subset of dom f st
  A is c=directed & union A in dom f holds f.union A = union (f.:A);
end;

definition
  let f be Function;
  attr f is c=-monotone means


  for a, b being set st a in dom f & b in dom f & a c= b holds f.a c= f.b;
  attr f is cap-distributive means


  for a,b being set st dom f
  includes_lattice_of a, b holds f.(a/\b) = f.a /\ f.b;
end;

registration
  cluster d.union-distributive -> c=-monotone for Function;
  cluster union-distributive -> d.union-distributive for Function;
end;

theorem 
  for f being Function st f is union-distributive for x,y being set st x
  in dom f & y in dom f & x \/ y in dom f holds f.(x \/ y) = (f.x) \/ (f.y);

theorem 
  for f being Function st f is union-distributive holds f.{} = {};

registration
  let C1,C2 be Coherence_Space;
  cluster union-distributive cap-distributive for Function of C1, C2;
end;

registration
  let C be Coherence_Space;
  cluster union-distributive cap-distributive for ManySortedSet of C;
end;





definition
  let f be Function;
  attr f is U-continuous means


  dom f is d.union-closed & f is d.union-distributive;
end;

definition
  let f be Function;
  attr f is U-stable means


  dom f is multiplicative & f is U-continuous cap-distributive;
end;

definition
  let f be Function;
  attr f is U-linear means


  f is U-stable union-distributive;
end;

registration
  cluster U-continuous -> d.union-distributive for Function;
  cluster U-stable -> cap-distributive U-continuous for Function;
  cluster U-linear -> union-distributive U-stable for Function;
end;

registration
  let X be d.union-closed set;
  cluster d.union-distributive -> U-continuous for ManySortedSet of X;
end;

registration
  let X be multiplicative set;
  cluster U-continuous cap-distributive -> U-stable for ManySortedSet of X;
end;

registration
  cluster U-stable union-distributive -> U-linear for Function;
end;

registration
  cluster U-linear for Function;
  let C be Coherence_Space;
  cluster U-linear for ManySortedSet of C;
  let B be Coherence_Space;
  cluster U-linear for Function of B,C;
end;

registration
  let f be U-continuous Function;
  cluster dom f -> d.union-closed;
end;

registration
  let f be U-stable Function;
  cluster dom f -> multiplicative;
end;

theorem 
  for X being set holds union Fin X = X;

theorem 
  for f being U-continuous Function st dom f is subset-closed for
  a being set st a in dom f holds f.a = union (f.:Fin a);

theorem 
  for f being Function st dom f is subset-closed holds f is
  U-continuous iff dom f is d.union-closed & f is c=-monotone & for a, y being
set st a in dom f & y in f.a ex b being set st b is finite & b c= a & y in f.b;

theorem 
  for f being Function st dom f is subset-closed d.union-closed
holds f is U-stable iff f is c=-monotone & for a, y being set st a in dom f & y
in f.a ex b being set st b is finite & b c= a & y in f.b & for c being set st c
  c= a & y in f.c holds b c= c;

theorem 
  for f being Function st dom f is subset-closed d.union-closed
holds f is U-linear iff f is c=-monotone & for a, y being set st a in dom f & y
in f.a ex x being set st x in a & y in f.{x} & for b being set st b c= a & y in
  f.b holds x in b;

begin 

definition
  let f be Function;
  func graph f -> set means


  for x being set holds x in it iff ex y
  being finite set, z being set st x = [y,z] & y in dom f & z in f.y;
end;

definition
  let C1,C2 be non empty set;
  let f be Function of C1,C2;
  redefine func graph f -> Subset of [:C1, union C2:];
end;

registration
  let f be Function;
  cluster graph f -> Relation-like;
end;

theorem 
  for f being Function, x,y being set holds [x,y] in graph f iff x
  is finite & x in dom f & y in f.x;

theorem 
  for f being c=-monotone Function for a,b being set st b in dom f
& a c= b & b is finite for y being set st [a,y] in graph f holds [b,y] in graph
  f;

theorem 
  for C1, C2 being Coherence_Space for f being Function of C1,C2
for a being Element of C1 for y1,y2 being set st [a,y1] in graph f & [a,y2] in
  graph f holds {y1,y2} in C2;

theorem 
  for C1, C2 being Coherence_Space for f being c=-monotone Function of
C1,C2 for a,b being Element of C1 st a \/ b in C1 for y1,y2 being set st [a,y1]
  in graph f & [b,y2] in graph f holds {y1,y2} in C2;

theorem 
  for C1, C2 being Coherence_Space for f,g being U-continuous
  Function of C1,C2 st graph f = graph g holds f = g;

theorem 
  for C1, C2 being Coherence_Space for X being Subset of [:C1, union C2
  :] st (for x being set st x in X holds x`1 is finite) & (for a,b being finite
Element of C1 st a c= b for y being set st [a,y] in X holds [b,y] in X) & (for
  a being finite Element of C1 for y1,y2 being set st [a,y1] in X & [a,y2] in X
  holds {y1,y2} in C2) ex f being U-continuous Function of C1,C2 st X = graph f
;

theorem 
  for C1, C2 being Coherence_Space for f being U-continuous Function of
  C1,C2 for a being Element of C1 holds f.a = (graph f).:Fin a;

begin 

definition
  let f be Function;
  func Trace f -> set means


  for x being set holds x in it iff ex a, y
being set st x = [a,y] & a in dom f & y in f.a & for b being set st b in dom f
  & b c= a & y in f.b holds a = b;
end;

theorem 
  for f being Function for a, y being set holds [a,y] in Trace f
  iff a in dom f & y in f.a & for b being set st b in dom f & b c= a & y in f.b
  holds a = b;

definition
  let C1, C2 be non empty set;
  let f be Function of C1, C2;
  redefine func Trace f -> Subset of [:C1, union C2:];
end;

registration
  let f be Function;
  cluster Trace f -> Relation-like;
end;

theorem 
  for f being U-continuous Function st dom f is subset-closed holds
  Trace f c= graph f;

theorem 
  for f being U-continuous Function st dom f is subset-closed for
  a, y being set st [a,y] in Trace f holds a is finite;

theorem 
  for C1, C2 being Coherence_Space for f being c=-monotone
Function of C1,C2 for a1,a2 being set st a1 \/ a2 in C1 for y1,y2 being set st
  [a1,y1] in Trace f & [a2,y2] in Trace f holds {y1,y2} in C2;

theorem 
  for C1, C2 being Coherence_Space for f being cap-distributive
Function of C1,C2 for a1,a2 being set st a1 \/ a2 in C1 for y being set st [a1,
  y] in Trace f & [a2,y] in Trace f holds a1 = a2;

theorem 
  for C1, C2 being Coherence_Space for f,g being U-stable Function
  of C1,C2 st Trace f c= Trace g for a being Element of C1 holds f.a c= g.a;

theorem 
  for C1, C2 being Coherence_Space for f,g being U-stable Function
  of C1,C2 st Trace f = Trace g holds f = g;

theorem 
  for C1, C2 being Coherence_Space for X being Subset of [:C1,
union C2:] st (for x being set st x in X holds x`1 is finite) & (for a,b being
Element of C1 st a \/ b in C1 for y1,y2 being set st [a,y1] in X & [b,y2] in X
holds {y1,y2} in C2) & (for a,b being Element of C1 st a \/ b in C1 for y being
set st [a,y] in X & [b,y] in X holds a = b) ex f being U-stable Function of C1,
  C2 st X = Trace f;

theorem 
  for C1, C2 being Coherence_Space for f being U-stable Function of C1,
  C2 for a being Element of C1 holds f.a = (Trace f).:Fin a;

theorem 
  for C1,C2 being Coherence_Space, f being U-stable Function of C1
  ,C2 for a being Element of C1, y being set holds y in f.a iff ex b being
  Element of C1 st [b,y] in Trace f & b c= a;

theorem 
  for C1, C2 being Coherence_Space ex f being U-stable Function of C1,
  C2 st Trace f = {};

theorem 
  for C1, C2 being Coherence_Space for a being finite Element of
  C1, y being set st y in union C2 ex f being U-stable Function of C1, C2 st
  Trace f = {[a,y]};

theorem 
  for C1, C2 being Coherence_Space for a being Element of C1, y being
  set for f being U-stable Function of C1, C2 st Trace f = {[a,y]} for b being
Element of C1 holds (a c= b implies f.b = {y}) & (not a c= b implies f.b = {});

theorem 
  for C1, C2 being Coherence_Space for f being U-stable Function
  of C1,C2 for X being Subset of Trace f ex g being U-stable Function of C1, C2
  st Trace g = X;

theorem 
  for C1, C2 being Coherence_Space for A being set st for x,y
being set st x in A & y in A ex f being U-stable Function of C1,C2 st x \/ y =
  Trace f ex f being U-stable Function of C1,C2 st union A = Trace f;

definition
  let C1, C2 be Coherence_Space;
  func StabCoh(C1,C2) -> set means


  for x being set holds x in it iff
  ex f being U-stable Function of C1,C2 st x = Trace f;
end;

registration
  let C1, C2 be Coherence_Space;
  cluster StabCoh(C1,C2) -> non empty subset-closed binary_complete;
end;

theorem 
  for C1,C2 being Coherence_Space, f being U-stable Function of C1
  ,C2 holds Trace f c= [:Sub_of_Fin C1, union C2:];

theorem 
  for C1,C2 being Coherence_Space holds union StabCoh(C1,C2) = [:
  Sub_of_Fin C1, union C2:];

theorem 
  for C1,C2 being Coherence_Space for a,b being finite Element of
C1, y1,y2 being set holds [[a,y1],[b,y2]] in Web StabCoh(C1,C2) iff not a \/ b
in C1 & y1 in union C2 & y2 in union C2 or [y1,y2] in Web C2 & (y1 = y2 implies
  a = b);

begin 

theorem 
  for C1, C2 being Coherence_Space for f being U-stable Function
  of C1,C2 holds f is U-linear iff for a,y being set st [a,y] in Trace f ex x
  being set st a = {x};

definition
  let f be Function;
  func LinTrace f -> set means


  for x being set holds x in it iff ex y
  ,z being set st x = [y,z] & [{y},z] in Trace f;
end;

theorem 
  for f being Function, x,y being set holds [x,y] in LinTrace f
  iff [{x},y] in Trace f;

theorem 
  for f being Function st f.{} = {} for x,y being set st {x} in
  dom f & y in f.{x} holds [x,y] in LinTrace f;

theorem 
  for f being Function, x,y being set st [x,y] in LinTrace f holds
  {x} in dom f & y in f.{x};

definition
  let C1, C2 be non empty set;
  let f be Function of C1, C2;
  redefine func LinTrace f -> Subset of [:union C1, union C2:];
end;

registration
  let f be Function;
  cluster LinTrace f -> Relation-like;
end;

definition
  let C1, C2 be Coherence_Space;
  func LinCoh(C1,C2) -> set means


  for x being set holds x in it iff
  ex f being U-linear Function of C1,C2 st x = LinTrace f;
end;

theorem 
  for C1, C2 being Coherence_Space for f being c=-monotone
Function of C1,C2 for x1,x2 being set st {x1,x2} in C1 for y1,y2 being set st [
  x1,y1] in LinTrace f & [x2,y2] in LinTrace f holds {y1,y2} in C2;

theorem 
  for C1, C2 being Coherence_Space for f being cap-distributive
Function of C1,C2 for x1,x2 being set st {x1,x2} in C1 for y being set st [x1,y
  ] in LinTrace f & [x2,y] in LinTrace f holds x1 = x2;

theorem 
  for C1, C2 being Coherence_Space for f,g being U-linear Function
  of C1,C2 st LinTrace f = LinTrace g holds f = g;

theorem 
  for C1, C2 being Coherence_Space for X being Subset of [:union
C1, union C2:] st (for a,b being set st {a,b} in C1 for y1,y2 being set st [a,
y1] in X & [b,y2] in X holds {y1,y2} in C2) & (for a,b being set st {a,b} in C1
  for y being set st [a,y] in X & [b,y] in X holds a = b) ex f being U-linear
  Function of C1,C2 st X = LinTrace f;

theorem 
  for C1, C2 being Coherence_Space for f being U-linear Function of C1,
  C2 for a being Element of C1 holds f.a = (LinTrace f).:a;

theorem 
  for C1, C2 being Coherence_Space ex f being U-linear Function of C1,
  C2 st LinTrace f = {};

theorem 
  for C1, C2 being Coherence_Space for x being set, y being set st
  x in union C1 & y in union C2 ex f being U-linear Function of C1, C2 st
  LinTrace f = {[x,y]};

theorem 
  for C1, C2 being Coherence_Space for x being set, y being set st x in
union C1 for f being U-linear Function of C1, C2 st LinTrace f = {[x,y]} for a
being Element of C1 holds (x in a implies f.a = {y}) & (not x in a implies f.a
  = {});

theorem 
  for C1, C2 being Coherence_Space for f being U-linear Function
  of C1,C2 for X being Subset of LinTrace f ex g being U-linear Function of C1,
  C2 st LinTrace g = X;

theorem 
  for C1, C2 being Coherence_Space for A being set st for x,y
being set st x in A & y in A ex f being U-linear Function of C1,C2 st x \/ y =
  LinTrace f ex f being U-linear Function of C1,C2 st union A = LinTrace f;

registration
  let C1, C2 be Coherence_Space;
  cluster LinCoh(C1,C2) -> non empty subset-closed binary_complete;
end;

theorem 
  for C1,C2 being Coherence_Space holds union LinCoh(C1,C2) = [:union C1
  , union C2:];

theorem 
  for C1,C2 being Coherence_Space for x1,x2 being set, y1,y2 being set
  holds [[x1,y1],[x2,y2]] in Web LinCoh(C1,C2) iff x1 in union C1 & x2 in union
C1 & (not [x1,x2] in Web C1 & y1 in union C2 & y2 in union C2 or [y1,y2] in Web
  C2 & (y1 = y2 implies x1 = x2));

begin 

definition
  let C be Coherence_Space;
  func 'not' C -> set equals

  {a where a is Subset of union C: for b being
  Element of C ex x being set st a /\ b c= {x}};
end;

theorem 
  for C being Coherence_Space, x being set holds x in 'not' C iff
  x c= union C & for a being Element of C ex z being set st x /\ a c= {z};

registration
  let C be Coherence_Space;
  cluster 'not' C -> non empty subset-closed binary_complete;
end;

theorem 
  for C being Coherence_Space holds union 'not' C = union C;

theorem 
  for C being Coherence_Space, x,y being set st x <> y & {x,y} in
  C holds not {x,y} in 'not' C;

theorem 
  for C being Coherence_Space, x,y being set st {x,y} c= union C &
  not {x,y} in C holds {x,y} in 'not' C;

theorem 
  for C being Coherence_Space for x,y being set holds [x,y] in Web 'not'
  C iff x in union C & y in union C & (x = y or not [x,y] in Web C);

theorem 
  for C being Coherence_Space holds 'not' 'not' C = C;

theorem 
  'not' {{}} = {{}};

theorem 
  for X being set holds 'not' FlatCoh X = bool X & 'not' bool X = FlatCoh X;

begin 

definition
  let x,y be set;
  func x U+ y -> set equals

  Union disjoin <*x,y*>;
end;

theorem 
  for x,y being set holds x U+ y = [:x,{1}:] \/ [:y,{2}:];

theorem 
  for x being set holds x U+ {} = [:x,{1}:] & {} U+ x = [:x,{2}:];

theorem 
  for x,y,z being set st z in x U+ y holds z = [z`1,z`2] & (z`2 =
  1 & z`1 in x or z`2 = 2 & z`1 in y);

theorem 
  for x,y,z being set holds [z,1] in x U+ y iff z in x;

theorem 
  for x,y,z being set holds [z,2] in x U+ y iff z in y;

theorem 
  for x1,y1, x2,y2 being set holds x1 U+ y1 c= x2 U+ y2 iff x1 c= x2 & y1 c= y2
;

theorem 
  for x,y, z being set st z c= x U+ y ex x1,y1 being set st z = x1
  U+ y1 & x1 c= x & y1 c= y;

theorem 
  for x1,y1, x2,y2 being set holds x1 U+ y1 = x2 U+ y2 iff x1 = x2 & y1 = y2;

theorem 
  for x1,y1, x2,y2 being set holds x1 U+ y1 \/ x2 U+ y2 = (x1 \/
  x2) U+ (y1 \/ y2);

theorem 
  for x1,y1, x2,y2 being set holds (x1 U+ y1) /\ (x2 U+ y2) = (x1
  /\ x2) U+ (y1 /\ y2);

definition
  let C1, C2 be Coherence_Space;
  func C1 "/\" C2 -> set equals

  {a U+ b where a is Element of C1, b is Element
  of C2: not contradiction};
  func C1 "\/" C2 -> set equals

  {a U+ {} where a is Element of C1: not
  contradiction} \/ {{} U+ b where b is Element of C2: not contradiction};
end;

theorem 
  for C1,C2 being Coherence_Space for x being set holds x in C1
  "/\" C2 iff ex a being Element of C1, b being Element of C2 st x = a U+ b;

theorem 
  for C1,C2 being Coherence_Space for x,y being set holds x U+ y
  in C1 "/\" C2 iff x in C1 & y in C2;

theorem 
  for C1,C2 being Coherence_Space holds union (C1 "/\" C2) = (
  union C1) U+ (union C2);

theorem 
  for C1,C2 being Coherence_Space for x,y being set holds x U+ y
  in C1 "\/" C2 iff x in C1 & y = {} or x = {} & y in C2;

theorem 
  for C1,C2 being Coherence_Space for x being set st x in C1 "\/"
C2 ex a being Element of C1, b being Element of C2 st x = a U+ b & (a = {} or b
  = {});

theorem 
  for C1,C2 being Coherence_Space holds union (C1 "\/" C2) = (union C1)
  U+ (union C2);

registration
  let C1, C2 be Coherence_Space;
  cluster C1 "/\" C2 -> non empty subset-closed binary_complete;
  cluster C1 "\/" C2 -> non empty subset-closed binary_complete;
end;

reserve C1, C2 for Coherence_Space;

theorem 
  for x,y being set holds [[x,1],[y,1]] in Web (C1 "/\" C2) iff [x,y] in Web C1
;

theorem 
  for x,y being set holds [[x,2],[y,2]] in Web (C1 "/\" C2) iff [x,y] in Web C2
;

theorem 
  for x,y being set st x in union C1 & y in union C2 holds [[x,1],[y,2]]
  in Web (C1 "/\" C2) & [[y,2],[x,1]] in Web (C1 "/\" C2);

theorem 
  for x,y being set holds [[x,1],[y,1]] in Web (C1 "\/" C2) iff [x,y] in Web C1
;

theorem 
  for x,y being set holds [[x,2],[y,2]] in Web (C1 "\/" C2) iff [x,y] in Web C2
;

theorem 
  for x,y being set holds not [[x,1],[y,2]] in Web (C1 "\/" C2) & not [[
  y,2],[x,1]] in Web (C1 "\/" C2);

theorem 
  'not' (C1 "/\" C2) = 'not' C1 "\/" 'not' C2;

definition
  let C1,C2 be Coherence_Space;
  func C1 [*] C2 -> set equals

  union {bool [:a,b:] where a is Element of C1, b
  is Element of C2: not contradiction};
end;

theorem 
  for C1,C2 being Coherence_Space, x being set holds x in C1 [*]
  C2 iff ex a being Element of C1, b being Element of C2 st x c= [:a,b:];

registration
  let C1,C2 be Coherence_Space;
  cluster C1 [*] C2 -> non empty;
end;

theorem 
  for C1,C2 being Coherence_Space, a being Element of C1 [*] C2
  holds proj1 a in C1 & proj2 a in C2 & a c= [:proj1 a, proj2 a:];

registration
  let C1,C2 be Coherence_Space;
  cluster C1 [*] C2 -> subset-closed binary_complete;
end;

theorem 
  for C1,C2 being Coherence_Space holds union (C1 [*] C2) = [:union C1,
  union C2:];

theorem 
  for x1,y1, x2,y2 being set holds [[x1,x2],[y1,y2]] in Web (C1 [*] C2)
  iff [x1,y1] in Web C1 & [x2,y2] in Web C2;














begin

registration
  let X be with_non-empty_elements set;
  cluster -> non-empty for FinSequence of X;
end;

registration
  let A be non empty set;
  cluster homogeneous quasi_total non-empty non empty for
PFuncFinSequence of A;
end;

registration
  cluster non-empty -> non empty for UAStr;
end;

theorem 
  for f,g being non-empty Function st product f c= product g holds
  dom f = dom g & for x being set st x in dom f holds f.x c= g.x;

theorem 
  for f,g being non-empty Function st product f = product g holds f = g;

definition
  let A be non empty set;
  let f be PFuncFinSequence of A;
  redefine func rng f -> Subset of PFuncs(A*, A);
end;

definition
  let A,B be non empty set;
  let S be non empty Subset of PFuncs(A, B);
  redefine mode Element of S -> PartFunc of A,B;
end;

definition
  let A be non-empty UAStr;
  mode OperSymbol of A is Element of dom the charact of A;
  mode operation of A is Element of rng the charact of A;
end;

definition
  let A be non-empty UAStr;
  let o be OperSymbol of A;
  func Den(o, A) -> operation of A equals

  (the charact of A).o;
end;

begin 

canceled;

theorem 
  for X,Y being set st X is_finer_than Y
  for p being FinSequence of X ex q being FinSequence of Y st
  product p c= product q;

theorem 
  for X being set, P,Q being a_partition of X
  for f being Function of P,Q st for a being set st a in P holds a c= f.a
  for p being FinSequence of P, q being FinSequence of Q holds
  product p c= product q iff f*p = q;

theorem 
  for P being set, f being Function st rng f c= union P
  ex p being Function st dom p = dom f & rng p c= P & f in product p;

theorem 
  for X be set, P being a_partition of X, f being FinSequence of X
  ex p being FinSequence of P st f in product p;

theorem 
  for X,Y being non empty set
  for P being a_partition of X, Q being a_partition of Y holds
  {[:p,q:] where p is Element of P, q is Element of Q: not contradiction}
  is a_partition of [:X,Y:];

theorem 
  for X being non empty set for P being a_partition of X holds
  {product p where p is Element of P*: not contradiction} is a_partition of X*;

theorem 
  for X being non empty set, n be Element of NAT
  for P being a_partition of X holds
  {product p where p is Element of n-tuples_on P: not contradiction}
  is a_partition of n-tuples_on X;

theorem 
  for X being non empty set, Y be set st Y c= X
  for P being a_partition of X holds
  {a /\ Y where a is Element of P: a meets Y} is a_partition of Y;

theorem 
  for f being non empty Function, P being a_partition of dom f holds
  {f|a where a is Element of P: not contradiction} is a_partition of f;

theorem 
  for X being set, p being FinSequence of SmallestPartition X
  ex q being FinSequence of X st product p = {q};

definition
  let X be set;

  mode IndexedPartition of X -> Function means


     rng it is a_partition of X & it is one-to-one;
end;

definition
  let X be set;
  let P be IndexedPartition of X;
  redefine func rng P -> a_partition of X;
end;

registration
  let X be set;
  cluster -> one-to-one non-empty for IndexedPartition of X;
end;

registration
  let X be non empty set;
  cluster -> non empty for IndexedPartition of X;
end;

definition
  let X be set, P be a_partition of X;
  redefine func id P -> IndexedPartition of X;
end;

definition
  let X be set;
  let P be IndexedPartition of X;
  let x be set;
  assume
 x in X;
  func P-index_of x -> set means


  it in dom P & x in P.it;
end;

theorem 
  for X being set, P being non-empty Function st Union P = X &
  for x,y being set st x in dom P & y in dom P & x <> y holds P.x misses P.y
  holds P is IndexedPartition of X;

theorem 
  for X,Y being non empty set, P being a_partition of Y
  for f being Function of X, P st P c= rng f & f is one-to-one
  holds f is IndexedPartition of Y;

begin 

scheme 
 IndRelationEx {A, B() -> non empty set, i() -> Element of NAT,
  R0() -> (Relation of A(),B()), RR(set,set) -> Relation of A(),B()}:
  ex R being Relation of A(),B(), F being ManySortedSet of NAT st
  R = F.i() & F.0 = R0() &
  for i being Element of NAT, R being Relation of A(),B() st R = F.i
  holds F.(i+1) = RR(R,i);

scheme 
 RelationUniq {A, B() -> non empty set, P[set,set]}:
  for R1, R2 being Relation of A(), B() st
  (for x being Element of A(), y being Element of B() holds
  [x,y] in R1 iff P[x,y]) &
  (for x being Element of A(), y being Element of B() holds
  [x,y] in R2 iff P[x,y]) holds R1 = R2;

scheme 
 IndRelationUniq {A, B() -> non empty set, i() -> Element of NAT,
  R0() -> (Relation of A(),B()), RR(set,set) -> Relation of A(),B()}:
  for R1, R2 being Relation of A(),B() st (ex F being ManySortedSet of NAT st
  R1 = F.i() & F.0 = R0() &
  for i being Element of NAT, R being Relation of A(),B() st R = F.i
  holds F.(i+1) = RR(R,i)) & (ex F being ManySortedSet of NAT st
  R2 = F.i() & F.0 = R0() &
  for i being Element of NAT, R being Relation of A(),B() st R = F.i
  holds F.(i+1) = RR(R,i)) holds R1 = R2;

definition
  let A be partial non-empty UAStr;
  func DomRel A -> Relation of the carrier of A means


  for x,y being Element of A holds [x,y] in it iff
  for f being operation of A, p,q being FinSequence holds
  p^<*x*>^q in dom f iff p^<*y*>^q in dom f;
end;

registration
  let A be partial non-empty UAStr;
  cluster DomRel A -> total symmetric transitive;
end;

definition
  let A be non-empty partial UAStr;
  let R be Relation of the carrier of A;
  func R|^A -> Relation of the carrier of A means


   for x,y being Element of A holds [x,y] in it iff [x,y] in R &
  for f being operation of A for p,q being FinSequence
  st p^<*x*>^q in dom f & p^<*y*>^q in dom f
  holds [f.(p^<*x*>^q), f.(p^<*y*>^q)] in R;
end;

definition
  let A be non-empty partial UAStr;
  let R be Relation of the carrier of A;
  let i be Element of NAT;
  func R|^(A,i) -> Relation of the carrier of A means


   ex F being ManySortedSet of NAT st it = F.i & F.0 = R &
  for i being Element of NAT, R being Relation of the carrier of A st R = F.i
  holds F.(i+1) = R|^A;
end;

theorem 
  for A being non-empty partial UAStr, R being Relation of the carrier of A
  holds R|^(A,0) = R & R|^(A,1) = R|^A;

theorem 
  for A being non-empty partial UAStr, i being Element of NAT,
  R being Relation of the carrier of A holds R|^(A,i+1) = R|^(A,i)|^A;

theorem 
  for A being non-empty partial UAStr, i,j being Element of NAT,
  R being Relation of the carrier of A holds R|^(A,i+j) = R|^(A,i)|^(A,j);

theorem 
  for A being non-empty partial UAStr
  for R being Equivalence_Relation of the carrier of A st R c= DomRel A
  holds R|^A is total symmetric transitive;

theorem 
  for A being non-empty partial UAStr
  for R being Relation of the carrier of A holds R|^A c= R;

theorem 
  for A being non-empty partial UAStr
  for R being Equivalence_Relation of the carrier of A st R c= DomRel A
  for i being Element of NAT holds R|^(A,i) is total symmetric transitive;

definition
  let A be non-empty partial UAStr;
  func LimDomRel A -> Relation of the carrier of A means


   for x,y being Element of A holds
  [x,y] in it iff for i being Element of NAT holds [x,y] in (DomRel A)|^(A,i);
end;

theorem 
  for A being non-empty partial UAStr holds LimDomRel A c= DomRel A;

registration
  let A be non-empty partial UAStr;
  cluster LimDomRel A -> total symmetric transitive;
end;

begin 

definition
  let X be non empty set;
  let f be PartFunc of X*, X;
  let P be a_partition of X;
  pred f is_partitable_wrt P means


  for p being FinSequence of P ex a being Element of P st f.:product p c= a;
end;

definition
  let X be non empty set;
  let f be PartFunc of X*, X;
  let P be a_partition of X;
  pred f is_exactly_partitable_wrt P means


  f is_partitable_wrt P &
  for p being FinSequence of P st product p meets dom f holds
  product p c= dom f;
end;

theorem 
  for A being non-empty partial UAStr for f being operation of A holds
  f is_exactly_partitable_wrt SmallestPartition the carrier of A;

scheme 
 FiniteTransitivity {x, y() -> FinSequence, P[set], R[set,set]}: P[y()]
provided
 P[x()] and
 len x() = len y() and
 for p,q being FinSequence, z1,z2 being set
st P[p^<*z1*>^q] & R[z1,z2] holds P[p^<*z2*>^q] and
 for i being Element of NAT st i in dom x() holds R[x().i, y().i];

theorem 
  for A being non-empty partial UAStr for f being operation of A holds
  f is_exactly_partitable_wrt Class LimDomRel A;

definition
  let A be partial non-empty UAStr;
  mode a_partition of A -> a_partition of the carrier of A means


     for f being operation of A holds f is_exactly_partitable_wrt it;
end;

definition
  let A be partial non-empty UAStr;
  mode IndexedPartition of A -> IndexedPartition of the carrier of A means


     rng it is a_partition of A;
end;

definition
  let A be partial non-empty UAStr;
  let P be IndexedPartition of A;
  redefine func rng P -> a_partition of A;
end;

theorem 
  for A being non-empty partial UAStr holds
  Class LimDomRel A is a_partition of A;

theorem 
  for X being non empty set, P being a_partition of X
  for p being FinSequence of P, q1,q2 being FinSequence, x,y being set
  st q1^<*x*>^q2 in product p & ex a being Element of P st x in a & y in a
  holds q1^<*y*>^q2 in product p;

theorem 
  for A being partial non-empty UAStr, P being a_partition of A holds
  P is_finer_than Class LimDomRel A;

begin 

definition
  let S1,S2 be ManySortedSign;
  let f,g be Function;
  pred f,g form_morphism_between S1,S2 means


   dom f = the carrier of S1 & dom g = the carrier' of S1 &
  rng f c= the carrier of S2 & rng g c= the carrier' of S2 &
  f*the ResultSort of S1 = (the ResultSort of S2)*g &
  for o being set, p being Function
  st o in the carrier' of S1 & p = (the Arity of S1).o
  holds f*p = (the Arity of S2).(g.o);
end;

theorem 
  for S being non void non empty ManySortedSign holds
  id the carrier of S, id the carrier' of S form_morphism_between S,S;

theorem 
  for S1,S2,S3 being ManySortedSign for f1,f2, g1,g2 being Function st
  f1, g1 form_morphism_between S1,S2 & f2, g2 form_morphism_between S2,S3
  holds f2*f1, g2*g1 form_morphism_between S1,S3;

definition
  let S1,S2 be ManySortedSign;
  pred S1 is_rougher_than S2 means

  ex f,g being Function st f,g form_morphism_between S2,S1 &
  rng f = the carrier of S1 & rng g = the carrier' of S1;
end;

definition
  let S1,S2 be non void non empty ManySortedSign;
  redefine pred S1 is_rougher_than S2;
  reflexivity;
end;

theorem 
  for S1,S2,S3 being ManySortedSign
  st S1 is_rougher_than S2 & S2 is_rougher_than S3 holds S1 is_rougher_than S3;

begin 

definition
  let A be partial non-empty UAStr;
  let P be a_partition of A;
  func MSSign(A,P) -> strict ManySortedSign means


   the carrier of it = P & the carrier' of it =
  {[o,p] where o is OperSymbol of A, p is Element of P*:
  product p meets dom Den(o,A)} &
  for o being OperSymbol of A, p being Element of P*
  st product p meets dom Den(o,A) holds (the Arity of it).[o,p] = p &
  Den(o, A).:product p c= (the ResultSort of it).[o,p];
end;

registration
  let A be partial non-empty UAStr;
  let P be a_partition of A;
  cluster MSSign(A,P) -> non empty non void;
end;

definition
  let A be partial non-empty UAStr;
  let P be a_partition of A;
  let o be OperSymbol of MSSign(A,P);
  redefine func o`1 -> OperSymbol of A;
  redefine func o`2 -> Element of P*;
end;

definition
  let A be partial non-empty UAStr;
  let S be non void non empty ManySortedSign;
  let G be MSAlgebra over S;
  let P be IndexedPartition of the carrier' of S;
  pred A can_be_characterized_by S,G,P means


   the Sorts of G is IndexedPartition of A &
  dom P = dom the charact of A & for o being OperSymbol of A holds
  (the Charact of G)|(P.o) is IndexedPartition of Den(o, A);
end;

definition
  let A be partial non-empty UAStr;
  let S be non void non empty ManySortedSign;
  pred A can_be_characterized_by S means

  ex G being MSAlgebra over S, P being IndexedPartition of the carrier' of S st
  A can_be_characterized_by S,G,P;
end;

theorem 
  for A being partial non-empty UAStr, P being a_partition of A
  holds A can_be_characterized_by MSSign(A, P);

theorem 
  for A being partial non-empty UAStr
  for S being non void non empty ManySortedSign for G being MSAlgebra over S
  for Q being IndexedPartition of the carrier' of S
  st A can_be_characterized_by S,G,Q
  for o being OperSymbol of A, r being FinSequence of rng the Sorts of G
  st product r c= dom Den(o,A) ex s being OperSymbol of S st
  (the Sorts of G)*the_arity_of s = r & s in Q.o;

theorem 
  for A being partial non-empty UAStr, P being a_partition of A
  st P = Class LimDomRel A
  for S being non void non empty ManySortedSign st A can_be_characterized_by S
  holds MSSign(A,P) is_rougher_than S;















begin

reserve UA for Universal_Algebra;

definition
  let UA;
  func UAEnd UA -> FUNCTION_DOMAIN of the carrier of UA, the carrier of UA
  means


  for h be Function of UA, UA holds h in it iff h is_homomorphism UA , UA;
end;

theorem 
  UAEnd UA c= Funcs (the carrier of UA, the carrier of UA);

theorem 
  id the carrier of UA in UAEnd UA;

theorem 
  for f1, f2 be Element of UAEnd UA holds f1 * f2 in UAEnd UA;

definition
  let UA;
  func UAEndComp UA -> BinOp of UAEnd UA means


  for x, y be Element of UAEnd UA holds it.(x, y) = y * x;
end;

definition
  let UA;
  func UAEndMonoid UA -> strict multLoopStr means


  the carrier of it = UAEnd UA &
  the multF of it = UAEndComp UA & 1.it = id the carrier of UA;
end;

registration
  let UA;
  cluster UAEndMonoid UA -> non empty;
end;

registration
  let UA;
  cluster UAEndMonoid UA -> well-unital associative;
end;

theorem 
  for x, y be Element of UAEndMonoid UA for f, g be Element of
  UAEnd UA st x = f & y = g holds x * y = g * f;

theorem 
  id the carrier of UA = 1_UAEndMonoid UA;

reserve S for non void non empty ManySortedSign,
  U1 for non-empty MSAlgebra over S;

definition
  let S, U1;
  func MSAEnd U1 -> MSFunctionSet of U1,U1 means


  (for f be Element of it holds f is ManySortedFunction of U1, U1) & for h
  be ManySortedFunction of U1, U1 holds h in it iff h is_homomorphism U1, U1;
end;

theorem 
  MSAEnd U1 c= MSFuncs(the Sorts of U1, the Sorts of U1);

theorem 
  id the Sorts of U1 in MSAEnd U1;

theorem 
  for f1, f2 be Element of MSAEnd U1 holds f1 ** f2 in MSAEnd U1;

theorem 
  for F be ManySortedFunction of MSAlg UA, MSAlg UA for f be
  Element of UAEnd UA st F = 0 .--> f holds F in MSAEnd MSAlg UA;

definition
  let S, U1;
  func MSAEndComp U1 -> BinOp of MSAEnd U1 means


  for x, y be Element of MSAEnd U1 holds it.(x, y) = y ** x;
end;

definition
  let S, U1;
  func MSAEndMonoid U1 -> strict multLoopStr means


  the carrier of it =
  MSAEnd U1 & the multF of it = MSAEndComp U1 & 1.it = id the Sorts of U1;
end;

registration
  let S, U1;
  cluster MSAEndMonoid U1 -> non empty;
end;

registration
  let S,U1;
  cluster MSAEndMonoid U1 -> well-unital associative;
end;

theorem 
  for x, y be Element of MSAEndMonoid U1 for f, g be Element of
  MSAEnd U1 st x = f & y = g holds x * y = g ** f;

theorem 
  id the Sorts of U1 = 1_MSAEndMonoid U1;

theorem 
  for f be Element of UAEnd UA holds 0 .--> f is
  ManySortedFunction of MSAlg UA, MSAlg UA;

registration
  cluster left_unital for non empty multLoopStr;
end;

registration
  let G,H be well-unital non empty multLoopStr;
  cluster multiplicative unity-preserving for Function of G,H;
end;

definition
  let G,H be well-unital non empty multLoopStr;
  mode Homomorphism of G,H is multiplicative unity-preserving Function of G,H;
end;

theorem 
  for G be well-unital non empty multLoopStr holds id the
  carrier of G is Homomorphism of G,G;

definition
  let G,H be well-unital non empty multLoopStr;

  pred G,H are_isomorphic means


  ex h be Homomorphism of G,H st h is bijective;
  reflexivity;
end;

theorem 
  for h be Function st (dom h = UAEnd UA & for x be set st x in
  UAEnd UA holds h.x = 0 .--> x) holds h is Homomorphism of UAEndMonoid UA,
  MSAEndMonoid (MSAlg UA);

theorem 
  for h be Homomorphism of UAEndMonoid UA, MSAEndMonoid (MSAlg UA)
  st for x be set st x in UAEnd UA holds h.x = 0 .--> x holds h is bijective;

theorem 
  UAEndMonoid UA, MSAEndMonoid (MSAlg UA) are_isomorphic;














begin

reserve i,j,k,i1,j1 for Element of NAT,
  p for Point of TOP-REAL 2,
  x for set;
reserve f for non constant standard special_circular_sequence;

theorem 
  for k st 1 <= k & k+2 <= len f for i,j st 1 <= i & i+1 <= len GoB f &
1 <= j & j+2 <= width GoB f & f/.(k+1) = (GoB f)*(i+1,j+1) & (f/.k = (GoB f)*(i
  +1,j) & f/.(k+2) = (GoB f)*(i+1,j+2) or f/.(k+2) = (GoB f)*(i+1,j) & f/.k = (
GoB f)*(i+1,j+2)) holds LSeg(1/2*((GoB f)*(i,j)+(GoB f)*(i+1,j+1)), 1/2*((GoB f
  )*(i,j+1)+(GoB f)*(i+1,j+2))) misses L~f;

theorem 
  for k st 1 <= k & k+2 <= len f for i,j st 1 <= i & i+2 <= len GoB f &
1 <= j & j+2 <= width GoB f & f/.(k+1) = (GoB f)*(i+1,j+1) & (f/.k = (GoB f)*(i
+2,j+1) & f/.(k+2) = (GoB f)*(i+1,j+2) or f/.(k+2) = (GoB f)*(i+2,j+1) & f/.k =
(GoB f)*(i+1,j+2)) holds LSeg(1/2*((GoB f)*(i,j)+(GoB f)*(i+1,j+1)), 1/2*((GoB
  f)*(i,j+1)+(GoB f)*(i+1,j+2))) misses L~f;

theorem 
  for k st 1 <= k & k+2 <= len f for i,j st 1 <= i & i+2 <= len GoB f &
1 <= j & j+2 <= width GoB f & f/.(k+1) = (GoB f)*(i+1,j+1) & (f/.k = (GoB f)*(i
+2,j+1) & f/.(k+2) = (GoB f)*(i+1,j) or f/.(k+2) = (GoB f)*(i+2,j+1) & f/.k = (
GoB f)*(i+1,j)) holds LSeg(1/2*((GoB f)*(i,j)+(GoB f)*(i+1,j+1)), 1/2*((GoB f)*
  (i,j+1)+(GoB f)*(i+1,j+2))) misses L~f;

theorem 
  for k st 1 <= k & k+2 <= len f for i,j st 1 <= i & i+1 <= len GoB f &
1 <= j & j+2 <= width GoB f & f/.(k+1) = (GoB f)*(i,j+1) & (f/.k = (GoB f)*(i,j
) & f/.(k+2) = (GoB f)*(i,j+2) or f/.(k+2) = (GoB f)*(i,j) & f/.k = (GoB f)*(i,
j+2)) holds LSeg(1/2*((GoB f)*(i,j)+(GoB f)*(i+1,j+1)), 1/2*((GoB f)*(i,j+1)+(
  GoB f)*(i+1,j+2))) misses L~f;

theorem 
  for k st 1 <= k & k+2 <= len f for i,j st 1 <= i & i+2 <= len GoB f &
1 <= j & j+2 <= width GoB f & f/.(k+1) = (GoB f)*(i+1,j+1) & (f/.k = (GoB f)*(i
  ,j+1) & f/.(k+2) = (GoB f)*(i+1,j+2) or f/.(k+2) = (GoB f)*(i,j+1) & f/.k = (
GoB f)*(i+1,j+2)) holds LSeg(1/2*((GoB f)*(i+1,j)+(GoB f)*(i+2,j+1)), 1/2*((GoB
  f)*(i+1,j+1)+(GoB f)*(i+2,j+2))) misses L~f;

theorem 
  for k st 1 <= k & k+2 <= len f for i,j st 1 <= i & i+2 <= len GoB f &
1 <= j & j+2 <= width GoB f & f/.(k+1) = (GoB f)*(i+1,j+1) & (f/.k = (GoB f)*(i
,j+1) & f/.(k+2) = (GoB f)*(i+1,j) or f/.(k+2) = (GoB f)*(i,j+1) & f/.k = (GoB
f)*(i+1,j)) holds LSeg(1/2*((GoB f)*(i+1,j)+(GoB f)*(i+2,j+1)), 1/2*((GoB f)*(i
  +1,j+1)+(GoB f)*(i+2,j+2))) misses L~f;

theorem 
  for k st 1 <= k & k+2 <= len f for i st 1 <= i & i+2 <= len GoB f & f
/.(k+1) = (GoB f)*(i+1,1) & (f/.k = (GoB f)*(i+2,1) & f/.(k+2) = (GoB f)*(i+1,2
) or f/.(k+2) = (GoB f)*(i+2,1) & f/.k = (GoB f)*(i+1,2)) holds LSeg(1/2*((GoB
f)*(i,1)+(GoB f)*(i+1,1))- |[0,1]|, 1/2*((GoB f)*(i,1)+(GoB f)*(i+1,2))) misses
  L~f;

theorem 
  for k st 1 <= k & k+2 <= len f for i st 1 <= i & i+2 <= len GoB f & f
/.(k+1) = (GoB f)*(i+1,1) & (f/.k = (GoB f)*(i,1) & f/.(k+2) = (GoB f)*(i+1,2)
or f/.(k+2) = (GoB f)*(i,1) & f/.k = (GoB f)*(i+1,2)) holds LSeg(1/2*((GoB f)*(
i+1,1)+(GoB f)*(i+2,1))- |[0,1]|, 1/2*((GoB f)*(i+1,1)+(GoB f)*(i+2,2))) misses
  L~f;

theorem 
  for k st 1 <= k & k+2 <= len f for i st 1 <= i & i+2 <= len GoB f & f
/.(k+1) = (GoB f)*(i+1,width GoB f) & (f/.k = (GoB f)*(i+2,width GoB f) & f/.(k
+2) = (GoB f)*(i+1,width GoB f -' 1) or f/.(k+2) = (GoB f)*(i+2,width GoB f) &
  f/.k = (GoB f)*(i+1,width GoB f -' 1)) holds LSeg(1/2*((GoB f)*(i,width GoB f
  -' 1)+(GoB f)*(i+1,width GoB f)), 1/2*((GoB f)*(i,width GoB f)+(GoB f)*(i+1,
  width GoB f))+|[0,1]|) misses L~f;

theorem 
  for k st 1 <= k & k+2 <= len f for i st 1 <= i & i+2 <= len GoB f & f
/.(k+1) = (GoB f)*(i+1,width GoB f) & (f/.k = (GoB f)*(i,width GoB f) & f/.(k+2
) = (GoB f)*(i+1,width GoB f -' 1) or f/.(k+2) = (GoB f)*(i,width GoB f) & f/.k
= (GoB f)*(i+1,width GoB f -' 1)) holds LSeg(1/2*((GoB f)*(i+1,width GoB f -' 1
)+(GoB f)*(i+2,width GoB f)), 1/2*((GoB f)*(i+1,width GoB f)+(GoB f)*(i+2,width
  GoB f))+|[0,1]|) misses L~f;

theorem 
  for k st 1 <= k & k+2 <= len f for i,j st 1 <= j & j+1 <= width GoB f
& 1 <= i & i+2 <= len GoB f & f/.(k+1) = (GoB f)*(i+1,j+1) & (f/.k = (GoB f)*(i
  ,j+1) & f/.(k+2) = (GoB f)*(i+2,j+1) or f/.(k+2) = (GoB f)*(i,j+1) & f/.k = (
GoB f)*(i+2,j+1)) holds LSeg(1/2*((GoB f)*(i,j)+(GoB f)*(i+1,j+1)), 1/2*((GoB f
  )*(i+1,j)+(GoB f)*(i+2,j+1))) misses L~f;

theorem 
  for k st 1 <= k & k+2 <= len f for j,i st 1 <= j & j+2 <= width GoB f
& 1 <= i & i+2 <= len GoB f & f/.(k+1) = (GoB f)*(i+1,j+1) & (f/.k = (GoB f)*(i
+1,j+2) & f/.(k+2) = (GoB f)*(i+2,j+1) or f/.(k+2) = (GoB f)*(i+1,j+2) & f/.k =
(GoB f)*(i+2,j+1)) holds LSeg(1/2*((GoB f)*(i,j)+(GoB f)*(i+1,j+1)), 1/2*((GoB
  f)*(i+1,j)+(GoB f)*(i+2,j+1))) misses L~f;

theorem 
  for k st 1 <= k & k+2 <= len f for j,i st 1 <= j & j+2 <= width GoB f
& 1 <= i & i+2 <= len GoB f & f/.(k+1) = (GoB f)*(i+1,j+1) & (f/.k = (GoB f)*(i
+1,j+2) & f/.(k+2) = (GoB f)*(i,j+1) or f/.(k+2) = (GoB f)*(i+1,j+2) & f/.k = (
GoB f)*(i,j+1)) holds LSeg(1/2*((GoB f)*(i,j)+(GoB f)*(i+1,j+1)), 1/2*((GoB f)*
  (i+1,j)+(GoB f)*(i+2,j+1))) misses L~f;

theorem 
  for k st 1 <= k & k+2 <= len f for j,i st 1 <= j & j+1 <= width GoB f
& 1 <= i & i+2 <= len GoB f & f/.(k+1) = (GoB f)*(i+1,j) & (f/.k = (GoB f)*(i,j
) & f/.(k+2) = (GoB f)*(i+2,j) or f/.(k+2) = (GoB f)*(i,j) & f/.k = (GoB f)*(i+
2,j)) holds LSeg(1/2*((GoB f)*(i,j)+(GoB f)*(i+1,j+1)), 1/2*((GoB f)*(i+1,j)+(
  GoB f)*(i+2,j+1))) misses L~f;

theorem 
  for k st 1 <= k & k+2 <= len f for j,i st 1 <= j & j+2 <= width GoB f
& 1 <= i & i+2 <= len GoB f & f/.(k+1) = (GoB f)*(i+1,j+1) & (f/.k = (GoB f)*(i
  +1,j) & f/.(k+2) = (GoB f)*(i+2,j+1) or f/.(k+2) = (GoB f)*(i+1,j) & f/.k = (
GoB f)*(i+2,j+1)) holds LSeg(1/2*((GoB f)*(i,j+1)+(GoB f)*(i+1,j+2)), 1/2*((GoB
  f)*(i+1,j+1)+(GoB f)*(i+2,j+2))) misses L~f;

theorem 
  for k st 1 <= k & k+2 <= len f for j,i st 1 <= j & j+2 <= width GoB f
& 1 <= i & i+2 <= len GoB f & f/.(k+1) = (GoB f)*(i+1,j+1) & (f/.k = (GoB f)*(i
+1,j) & f/.(k+2) = (GoB f)*(i,j+1) or f/.(k+2) = (GoB f)*(i+1,j) & f/.k = (GoB
f)*(i,j+1)) holds LSeg(1/2*((GoB f)*(i,j+1)+(GoB f)*(i+1,j+2)), 1/2*((GoB f)*(i
  +1,j+1)+(GoB f)*(i+2,j+2))) misses L~f;

theorem 
  for k st 1 <= k & k+2 <= len f for j st 1 <= j & j+2 <= width GoB f &
f/.(k+1) = (GoB f)*(1,j+1) & (f/.k = (GoB f)*(1,j+2) & f/.(k+2) = (GoB f)*(2,j+
1) or f/.(k+2) = (GoB f)*(1,j+2) & f/.k = (GoB f)*(2,j+1)) holds LSeg(1/2*((GoB
f)*(1,j)+(GoB f)*(1,j+1))- |[1,0]|, 1/2*((GoB f)*(1,j)+(GoB f)*(2,j+1))) misses
  L~f;

theorem 
  for k st 1 <= k & k+2 <= len f for j st 1 <= j & j+2 <= width GoB f &
f/.(k+1) = (GoB f)*(1,j+1) & (f/.k = (GoB f)*(1,j) & f/.(k+2) = (GoB f)*(2,j+1)
or f/.(k+2) = (GoB f)*(1,j) & f/.k = (GoB f)*(2,j+1)) holds LSeg(1/2*((GoB f)*(
1,j+1)+(GoB f)*(1,j+2))- |[1,0]|, 1/2*((GoB f)*(1,j+1)+(GoB f)*(2,j+2))) misses
  L~f;

theorem 
  for k st 1 <= k & k+2 <= len f for j st 1 <= j & j+2 <= width GoB f &
f/.(k+1) = (GoB f)*(len GoB f,j+1) & (f/.k = (GoB f)*(len GoB f,j+2) & f/.(k+2)
= (GoB f)*(len GoB f -' 1,j+1) or f/.(k+2) = (GoB f)*(len GoB f,j+2) & f/.k = (
GoB f)*(len GoB f -' 1,j+1)) holds LSeg(1/2*((GoB f)*(len GoB f -' 1,j)+(GoB f)
*(len GoB f,j+1)), 1/2*((GoB f)*(len GoB f,j)+(GoB f)*(len GoB f,j+1))+|[1,0]|)
  misses L~f;

theorem 
  for k st 1 <= k & k+2 <= len f for j st 1 <= j & j+2 <= width GoB f &
f/.(k+1) = (GoB f)*(len GoB f,j+1) & (f/.k = (GoB f)*(len GoB f,j) & f/.(k+2) =
(GoB f)*(len GoB f -' 1,j+1) or f/.(k+2) = (GoB f)*(len GoB f,j) & f/.k = (GoB
f)*(len GoB f -' 1,j+1)) holds LSeg(1/2*((GoB f)*(len GoB f -' 1,j+1)+(GoB f)*(
len GoB f,j+2)), 1/2*((GoB f)*(len GoB f,j+1)+(GoB f)*(len GoB f,j+2))+|[1,0]|)
  misses L~f;

reserve P for Subset of TOP-REAL 2;

theorem 
  (for p st p in P holds p`1 < (GoB f)*(1,1)`1) implies P misses L~f;

theorem 
  (for p st p in P holds p`1 > (GoB f)*(len GoB f,1)`1) implies P misses L~f;

theorem 
  (for p st p in P holds p`2 < (GoB f)*(1,1)`2) implies P misses L~f;

theorem 
  (for p st p in P holds p`2 > (GoB f)*(1,width GoB f)`2) implies P misses L~f;

theorem 
  for i st 1 <= i & i+2 <= len GoB f holds LSeg(1/2*((GoB f)*(i,1)+(GoB
f)*(i+1,1))- |[0,1]|, 1/2*((GoB f)*(i+1,1)+(GoB f)*(i+2,1))- |[0,1]|) misses L~
  f;

theorem 
  LSeg((GoB f)*(1,1)- |[1,1]|,1/2*((GoB f)*(1,1)+(GoB f)*(2,1))- |[0,1]|
  ) misses L~f;

theorem 
  LSeg(1/2*((GoB f)*(len GoB f -' 1,1)+(GoB f)*(len GoB f,1))- |[0,1]|,
  (GoB f)*(len GoB f,1)+|[1,-1]|) misses L~f;

theorem 
  for i st 1 <= i & i+2 <= len GoB f holds LSeg(1/2*((GoB f)*(i,width
GoB f)+(GoB f)*(i+1,width GoB f))+|[0,1]|, 1/2*((GoB f)*(i+1,width GoB f)+(GoB
  f)*(i+2,width GoB f))+|[0,1]|) misses L~f;

theorem 
  LSeg((GoB f)*(1,width GoB f)+|[-1,1]|, 1/2*((GoB f)*(1,width GoB f)+(
  GoB f)*(2,width GoB f))+|[0,1]|) misses L~f;

theorem 
  LSeg(1/2*((GoB f)*(len GoB f -' 1,width GoB f)+ (GoB f)*(len GoB f,
  width GoB f))+|[0,1]|, (GoB f)*(len GoB f,width GoB f)+|[1,1]|) misses L~f;

theorem 
  for j st 1 <= j & j+2 <= width GoB f holds LSeg(1/2*((GoB f)*(1,j)+(
  GoB f)*(1,j+1))- |[1,0]|, 1/2*((GoB f)*(1,j+1)+(GoB f)*(1,j+2))- |[1,0]|)
  misses L~f;

theorem 
  LSeg((GoB f)*(1,1)- |[1,1]|,1/2*((GoB f)*(1,1)+(GoB f)*(1,2))- |[1,0]|
  ) misses L~f;

theorem 
  LSeg(1/2*((GoB f)*(1,width GoB f -' 1)+(GoB f)*(1,width GoB f))- |[1,0
  ]| , (GoB f)*(1,width GoB f)+|[-1,1]|) misses L~f;

theorem 
  for j st 1 <= j & j+2 <= width GoB f holds LSeg(1/2*((GoB f)*(len GoB
  f,j)+(GoB f)*(len GoB f,j+1))+|[1,0]|, 1/2*((GoB f)*(len GoB f,j+1)+(GoB f)*(
  len GoB f,j+2))+|[1,0]|) misses L~f;

theorem 
  LSeg((GoB f)*(len GoB f,1)+|[1,-1]|, 1/2*((GoB f)*(len GoB f,1)+(GoB f
  )*(len GoB f,2))+|[1,0]|) misses L~f;

theorem 
  LSeg(1/2*((GoB f)*(len GoB f,width GoB f -' 1)+ (GoB f)*(len GoB f,
  width GoB f))+|[1,0]|, (GoB f)*(len GoB f,width GoB f)+|[1,1]|) misses L~f;

theorem 
  1 <= k & k+1 <= len f implies Int left_cell(f,k) misses L~f;

theorem 
  1 <= k & k+1 <= len f implies Int right_cell(f,k) misses L~f;














begin

reserve A,x,y,z,u for set,
  m,n for Element of NAT;

registration
  let X be non empty set, R be Order of X;
  cluster RelStr (#X,R#) -> non empty;
end;

theorem 
  {}|_2 A = {};

theorem 
  for F being non empty Poset, A be Subset of F st A is finite & A <> {}
  & for B,C being Element of F st B in A & C in A holds B <= C or C <= B ex m
being Element of F st m in A & for C being Element of F st C in A holds m <= C;

registration
  let P be non empty Poset, A be non empty finite Subset of P, x be Element of
  P;
  cluster InitSegm(A,x) -> finite;
end;

begin 

definition

  let C be non empty Poset;
  func symplexes(C) -> Subset of Fin the carrier of C equals

  {A where A is
  Element of Fin the carrier of C : the InternalRel of C linearly_orders A};
end;

registration
  let C be non empty Poset;
  cluster symplexes(C) -> with_non-empty_element;
end;

reserve C for non empty Poset;

theorem 
  for x be Element of C holds {x} in symplexes(C);

theorem 
  {} in symplexes(C);

theorem 
  for x, s be set st x c= s & s in symplexes(C) holds x in symplexes(C);

theorem 
  for C be non empty Poset, A being non empty Element of symplexes
  (C) st card A = n holds dom(SgmX(the InternalRel of C, A)) = Seg n;

registration
  let C be non empty Poset;
  cluster non empty for Element of symplexes(C);
end;

begin 

definition
  mode SetSequence is ManySortedSet of NAT;
end;

definition
  let IT be SetSequence;
  attr IT is lower_non-empty means


  for n be Nat st IT.n is non empty
  holds for m be Nat st m < n holds IT.m is non empty;
end;

registration
  cluster lower_non-empty for SetSequence;
end;

definition
  let X be SetSequence;
  func FuncsSeq X -> SetSequence means


  for n be Nat holds it.n = Funcs( X.(n+1),X.n);
end;

registration
  let X be lower_non-empty SetSequence;
  let n be Nat;
  cluster (FuncsSeq X).n -> non empty;
end;

definition
  let n be Nat;
  let f be Element of Funcs(Seg n,Seg(n+1));
  func @ f -> FinSequence of REAL equals

  f;
end;

definition
  func NatEmbSeq -> SetSequence means


  for n be Nat holds it.n = {f
  where f is Element of Funcs(Seg n,Seg(n+1)) : @ f is increasing};
end;

registration
  let n be Nat;
  cluster NatEmbSeq.n -> non empty;
end;

registration
  let n be Nat;
  cluster -> Function-like Relation-like for Element of NatEmbSeq.n;
end;

definition
  let X be SetSequence;
  mode triangulation of X is ManySortedFunction of NatEmbSeq, FuncsSeq(X);
end;

definition
  struct TriangStr (# SkeletonSeq -> SetSequence, FacesAssign ->
    ManySortedFunction of NatEmbSeq, FuncsSeq(the SkeletonSeq) #);
end;

definition
  let T be TriangStr;
  attr T is lower_non-empty means


  the SkeletonSeq of T is lower_non-empty;
end;

registration
  cluster lower_non-empty strict for TriangStr;
end;

registration
  let T be lower_non-empty TriangStr;
  cluster the SkeletonSeq of T -> lower_non-empty;
end;

registration
  let S be lower_non-empty SetSequence, F be ManySortedFunction of NatEmbSeq,
  FuncsSeq S;
  cluster TriangStr (#S,F#) -> lower_non-empty;
end;

begin 

definition
  let T be TriangStr;
  let n be Nat;
  mode Symplex of T,n is Element of (the SkeletonSeq of T).n;
end;

definition
  let n be Nat;
  mode Face of n is Element of NatEmbSeq.n;
end;

definition
  let T be lower_non-empty TriangStr, n be Nat, x be Symplex of T,n+1, f be
  Face of n;
  assume
 (the SkeletonSeq of T).(n+1) <> {};
  func face (x,f) -> Symplex of T,n means


  for F,G be Function st F = (
  the FacesAssign of T).n & G = F.f holds it = G.x;
end;

definition
  let C be non empty Poset;
  func Triang C -> lower_non-empty strict TriangStr means

  (the SkeletonSeq of
  it).0 = { {} } & (for n be Nat st n > 0 holds (the SkeletonSeq of it).n = {
  SgmX(the InternalRel of C, A) where A is non empty Element of symplexes(C) :
card A = n }) & for n be Nat, f be Face of n, s be Element of (the SkeletonSeq
  of it).(n+1) st s in (the SkeletonSeq of it).(n+1) for A be non empty Element
of symplexes(C) st SgmX(the InternalRel of C, A) = s holds face (s,f) = (SgmX(
  the InternalRel of C, A)) * f;
end;














begin

reserve f for non constant standard special_circular_sequence,
  i,j,k,i1,i2,j1,j2 for Element of NAT,
  r,s,r1,s1,r2,s2 for Real,
  p,q for Point of TOP-REAL 2,
  G for Go-board;

theorem 
  for GX being TopSpace, A1,A2,B being Subset of GX
  st A1 is_a_component_of B & A2 is_a_component_of B holds
  A1 = A2 or A1 misses A2;

theorem 
  for GX being TopSpace, A,B being Subset of GX,
  AA being Subset of GX|B st A = AA holds GX|A = GX|B|AA;

theorem 
  for GX being non empty TopSpace, A, B being non empty Subset of GX
  st A c= B & A is connected
  ex C being Subset of GX st C is_a_component_of B & A c= C;

theorem 
  for GX being non empty TopSpace, A,B,C,D being Subset of GX
  st B is connected & C is_a_component_of D & A c= C & A meets B & B c= D
  holds B c= C;

registration
  cluster convex non empty for Subset of TOP-REAL 2;
end;

canceled;

theorem 
  for P,Q being convex Subset of TOP-REAL 2 holds P /\ Q is convex;

theorem 
  for f being FinSequence of TOP-REAL 2 holds Rev X_axis f = X_axis Rev f;

theorem 
  for f being FinSequence of TOP-REAL 2 holds Rev Y_axis f = Y_axis Rev f;

registration
  cluster non constant for FinSequence;
end;

registration
  let f be non constant FinSequence;
  cluster Rev f -> non constant;
end;

definition
  let f be standard special_circular_sequence;
  redefine func Rev f -> standard special_circular_sequence;
end;

theorem 
  i >= 1 & j >= 1 & i+j = len f implies left_cell(f,i) = right_cell(Rev f,j);

theorem 
  i >= 1 & j >= 1 & i+j = len f implies left_cell(Rev f,i) = right_cell(f,j);

theorem 
  1 <= k & k+1 <= len f implies ex i,j st i <= len GoB f & j <= width GoB f &
  cell(GoB f,i,j) = left_cell(f,k);

theorem 
  j <= width G implies Int h_strip(G,j) is convex;

theorem 
  i <= len G implies Int v_strip(G,i) is convex;

theorem 
  i <= len G & j <= width G implies Int cell(G,i,j) <> {};

theorem 
  1 <= k & k+1 <= len f implies Int left_cell(f,k) <> {};

theorem 
  1 <= k & k+1 <= len f implies Int right_cell(f,k) <> {};

theorem 
  i <= len G & j <= width G implies Int cell(G,i,j) is convex;

canceled;

theorem 
  1 <= k & k+1 <= len f implies Int left_cell(f,k) is convex;

theorem 
  1 <= k & k+1 <= len f implies Int right_cell(f,k) is convex;

definition
  let f;
  func LeftComp f -> Subset of TOP-REAL 2 means


  it is_a_component_of (L~f)` & Int left_cell(f,1) c= it;
  func RightComp f -> Subset of TOP-REAL 2 means


  it is_a_component_of (L~f)` & Int right_cell(f,1) c= it;
end;

theorem 
  for k st 1 <= k & k+1 <= len f holds Int left_cell(f,k) c= LeftComp f;

theorem 
  GoB Rev f = GoB f;

theorem 
  RightComp f = LeftComp Rev f;

theorem 
  RightComp Rev f = LeftComp f;

theorem 
  for k st 1 <= k & k+1 <= len f holds Int right_cell(f,k) c= RightComp f;














begin 

reserve e for set;

theorem 
  for X1,X2 being set, a1,a2 being set holds [:X1 -->a1,X2-->a2:] = [:X1
  ,X2:] --> [a1,a2];

registration
  let I be set;
  cluster [[0]]I -> Function-yielding;
end;

theorem 
  for f,g being Function holds ~(g*f) = g*~f;

theorem 
  for f,g,h being Function holds ~(f*[:g,h:]) = ~f*[:h,g:];

registration
  let f be Function-yielding Function;
  cluster ~f -> Function-yielding;
end;

theorem 
  for I being set, A,B,C being ManySortedSet of I st A
  is_transformable_to B for F being ManySortedFunction of A,B, G being
  ManySortedFunction of B,C holds G**F is ManySortedFunction of A,C;

registration
  let I be set;
  let A be ManySortedSet of [:I,I:];
  cluster ~A -> [:I,I:]-defined;
end;

registration
  let I be set;
  let A be ManySortedSet of [:I,I:];
  cluster ~A -> total for [:I,I:]-defined Function;
end;

theorem 
  for I1 being set, I2 being non empty set, f being Function of I1,I2, B
  ,C being ManySortedSet of I2, G being ManySortedFunction of B,C holds G*f is
  ManySortedFunction of B*f, C*f;

definition
  let I be set, A,B be ManySortedSet of [:I,I:], F be ManySortedFunction of A,
  B;
  redefine func ~F -> ManySortedFunction of ~A,~B;
end;

theorem 
  for I1,I2 being non empty set, M being ManySortedSet of [:I1,I2:], o1
  being Element of I1, o2 being Element of I2 holds (~M).(o2,o1) = M.(o1,o2);

registration
  let I1 be set, f,g be ManySortedFunction of I1;
  cluster g**f -> I1-defined;
end;

registration
  let I1 be set, f,g be ManySortedFunction of I1;
  cluster g**f -> total;
end;

begin 

definition
  let f,g be Function;
  pred f cc= g means


  dom f c= dom g & for i being set st i in dom f holds f.i c= g.i;
  reflexivity;
end;

definition
  let I,J be set, A be ManySortedSet of I, B be ManySortedSet of J;
  redefine pred A cc= B means


  I c= J & for i being set st i in I holds A.i c= B.i;
end;

theorem 
  for I,J being set, A being ManySortedSet of I, B being
  ManySortedSet of J holds A cc= B & B cc= A implies A = B;

theorem 
  for I,J,K being set, A being ManySortedSet of I, B being
ManySortedSet of J, C being ManySortedSet of K holds A cc= B & B cc= C implies
  A cc= C;

theorem 
  for I being set, A being ManySortedSet of I, B being ManySortedSet of
  I holds A cc= B iff A c= B;

begin 

scheme 

  OnSingletons{X()-> non empty set, F(set)-> set, P[set]}: { [o,F(o)] where o
  is Element of X(): P[o] } is Function;

scheme 

  DomOnSingletons {X()-> non empty set,f()-> Function, F(set)-> set, P[set]}:
  dom f() = { o where o is Element of X(): P[o]}
provided
 f() = { [o,F(o)] where o is Element of X(): P[o] };

scheme 

  ValOnSingletons {X()-> non empty set,f()-> Function, x()-> Element of X(), F
  (set)-> set, P[set]}: f().x() = F(x())
provided
 f() = { [o,F(o)] where o is Element of X(): P[o] } and
 P[x()];

begin 

theorem 
  for C being Category, i,j,k being Object of C holds [:Hom(j,k),
  Hom(i,j):] c= dom the Comp of C;

theorem 
  for C being Category, i,j,k being Object of C holds (the Comp of
  C).:[:Hom(j,k),Hom(i,j):] c= Hom(i,k);

definition
  let C be non void non empty CatStr;
  func the_hom_sets_of C -> ManySortedSet of [:the carrier of C, the carrier
  of C:] means


  for i,j being Object of C holds it.(i,j) = Hom(i,j);
end;

theorem 
  for C be Category, i be Object of C holds id i in ( the_hom_sets_of C).(i,i);

definition
  let C be Category;
  func the_comps_of C -> BinComp of the_hom_sets_of C means


  for i,j,k
being Object of C holds it.(i,j,k) = (the Comp of C)| ([:(the_hom_sets_of C).(j
  ,k),(the_hom_sets_of C).(i,j):] qua set);
end;

theorem 
  for C being Category, i,j,k being Object of C st Hom(i,j) <> {}
  & Hom(j,k) <> {} for f being Morphism of i,j, g being Morphism of j,k holds (
  the_comps_of C).(i,j,k).(g,f) = g*f;

theorem 
  for C being Category holds the_comps_of C is associative;

theorem 
  for C being Category holds the_comps_of C is with_left_units with_right_units
;

begin 

definition
  let C be Category;
  func Alter C -> strict non empty AltCatStr equals

  AltCatStr(#the carrier of
    C,the_hom_sets_of C, the_comps_of C#);
end;

theorem 
  for C being Category holds Alter C is associative;

theorem 
  for C being Category holds Alter C is with_units;

theorem 
  for C being Category holds Alter C is transitive;

registration
  let C be Category;
  cluster Alter C -> transitive associative with_units;
end;

begin 

registration
  cluster non empty strict for AltGraph;
end;

definition
  let C be AltGraph;
  attr C is reflexive means


  for x being set st x in the carrier of C holds (the Arrows of C).(x,x) <> {};
end;

definition
  let C be non empty AltGraph;
  redefine attr C is reflexive means

  for o being object of C holds <^o,o^> <> {};
end;

definition
  let C be non empty transitive AltCatStr;
  redefine attr C is associative means


  for o1,o2,o3,o4 being object of
C for f being Morphism of o1,o2, g being Morphism of o2,o3, h being Morphism of
o3,o4 st <^o1,o2^> <> {} & <^o2,o3^> <> {} & <^o3,o4^> <> {} holds h*g*f = h*(g
  *f);
end;

definition
  let C be non empty AltCatStr;
  redefine attr C is with_units means

  for o being object of C holds <^o,o^> <>
{} & ex i being Morphism of o,o st for o9 being object of C, m9 being Morphism
of o9,o, m99 being Morphism of o,o9 holds (<^o9,o^> <> {} implies i*m9 = m9) &
  (<^o,o9^> <> {} implies m99*i = m99);
end;

registration
  cluster with_units -> reflexive for non empty AltCatStr;
end;

registration
  cluster non empty reflexive for AltGraph;
end;

registration
  cluster non empty reflexive for AltCatStr;
end;

begin

definition
  func the_empty_category -> strict AltCatStr means


  the carrier of it is empty;
end;

registration
  cluster the_empty_category -> empty;
end;

registration
  cluster empty strict for AltCatStr;
end;

theorem 
  for E being empty strict AltCatStr holds E = the_empty_category;

begin 


definition
  let C be AltCatStr;
  mode SubCatStr of C -> AltCatStr means


    the carrier of it c= the
carrier of C & the Arrows of it cc= the Arrows of C & the Comp of it cc= the
    Comp of C;
end;

reserve C,C1,C2,C3 for AltCatStr;

theorem 
  C is SubCatStr of C;

theorem 
  C1 is SubCatStr of C2 & C2 is SubCatStr of C3 implies C1 is SubCatStr of C3;

theorem 
  for C1,C2 being AltCatStr st C1 is SubCatStr of C2 & C2 is
  SubCatStr of C1 holds the AltCatStr of C1 = the AltCatStr of C2;

registration
  let C be AltCatStr;
  cluster strict for SubCatStr of C;
end;

definition
  let C be non empty AltCatStr, o be object of C;
  func ObCat o -> strict SubCatStr of C means


  the carrier of it = { o
  } & the Arrows of it = (o,o):-> <^o,o^> & the Comp of it = [o,o,o] .--> (the
  Comp of C).(o,o,o);
end;

reserve C for non empty AltCatStr,
  o for object of C;

theorem 
  for o9 being object of ObCat o holds o9 = o;

registration
  let C be non empty AltCatStr, o be object of C;
  cluster ObCat o -> transitive non empty;
end;

registration
  let C be non empty AltCatStr;
  cluster transitive non empty strict for SubCatStr of C;
end;

theorem 
  for C being transitive non empty AltCatStr, D1,D2 being
transitive non empty SubCatStr of C st the carrier of D1 c= the carrier of D2 &
  the Arrows of D1 cc= the Arrows of D2 holds D1 is SubCatStr of D2;

definition
  let C be AltCatStr, D be SubCatStr of C;
  attr D is full means


  the Arrows of D = (the Arrows of C)||the carrier of D;
end;

definition
  let C be with_units non empty AltCatStr, D be SubCatStr of C;
  attr D is id-inheriting means


  for o being object of D, o9 being
  object of C st o = o9 holds idm o9 in <^o,o^> if D is non empty otherwise not
  contradiction;
end;

registration
  let C be AltCatStr;
  cluster full strict for SubCatStr of C;
end;

registration
  let C be non empty AltCatStr;
  cluster full non empty strict for SubCatStr of C;
end;

registration
  let C be category, o be object of C;
  cluster ObCat o -> full id-inheriting;
end;

registration
  let C be category;
  cluster full id-inheriting non empty strict for SubCatStr of C;
end;

reserve C for non empty transitive AltCatStr;

theorem 
  for D being SubCatStr of C st the carrier of D = the carrier of
C & the Arrows of D = the Arrows of C holds the AltCatStr of D = the AltCatStr
  of C;

theorem 
  for D1,D2 being non empty transitive SubCatStr of C st the
  carrier of D1 = the carrier of D2 & the Arrows of D1 = the Arrows of D2 holds
  the AltCatStr of D1 = the AltCatStr of D2;

theorem 
  for D being full SubCatStr of C st the carrier of D = the carrier of C
  holds the AltCatStr of D = the AltCatStr of C;

theorem 
  for C being non empty AltCatStr, D being full non empty
  SubCatStr of C, o1,o2 being object of C, p1,p2 being object of D st o1 = p1 &
  o2 = p2 holds <^o1,o2^> = <^p1,p2^>;

theorem 
  for C being non empty AltCatStr, D being non empty SubCatStr of
  C for o being object of D holds o is object of C;

registration
  let C be transitive non empty AltCatStr;
  cluster full non empty -> transitive for SubCatStr of C;
end;

theorem 
  for D1,D2 being full non empty SubCatStr of C st the carrier of D1 =
  the carrier of D2 holds the AltCatStr of D1 = the AltCatStr of D2;

theorem 
  for C being non empty AltCatStr, D being non empty SubCatStr of
C, o1,o2 being object of C, p1,p2 being object of D st o1 = p1 & o2 = p2 holds
  <^p1,p2^> c= <^o1,o2^>;

theorem 
  for C being non empty transitive AltCatStr, D being non empty
transitive SubCatStr of C, p1,p2,p3 being object of D st <^p1,p2^> <> {} & <^p2
,p3^> <> {} for o1,o2,o3 being object of C st o1 = p1 & o2 = p2 & o3 = p3 for f
being Morphism of o1,o2, g being Morphism of o2,o3, ff being Morphism of p1,p2,
  gg being Morphism of p2,p3 st f = ff & g = gg holds g*f = gg*ff;

registration
  let C be associative transitive non empty AltCatStr;
  cluster transitive -> associative for non empty SubCatStr of C;
end;

theorem 
  for C being non empty AltCatStr, D being non empty SubCatStr of
C, o1,o2 being object of C, p1,p2 being object of D st o1 = p1 & o2 = p2 & <^p1
  ,p2^> <> {} for n being Morphism of p1,p2 holds n is Morphism of o1,o2;

registration
  let C be transitive with_units non empty AltCatStr;
  cluster id-inheriting transitive -> with_units for
non empty SubCatStr of C;
end;

registration
  let C be category;
  cluster id-inheriting transitive for non empty SubCatStr of C;
end;

definition
  let C be category;
  mode subcategory of C is id-inheriting transitive SubCatStr of C;
end;

theorem 
  for C being category, D being non empty subcategory of C for o being
  object of D, o9 being object of C st o = o9 holds idm o = idm o9;














begin 

reserve x,X,X2,Y,Y2 for set;
reserve GX for non empty TopSpace;
reserve A2,B2 for Subset of GX;
reserve B for Subset of GX;

definition
  let GX be TopStruct, V be Subset of GX;
  func Component_of V -> Subset of GX means


  ex F being Subset-Family of GX st
  (for A being Subset of GX holds A in F iff A is connected & V c= A) &
  union F = it;
end;

theorem 
  for GX being TopSpace, V being Subset of GX st (ex A being Subset
  of GX st A is connected & V c= A) holds V c= Component_of V;

theorem 
  for GX being TopSpace, V being Subset of GX st (not ex A being Subset
  of GX st A is connected & V c= A) holds Component_of V = {};

theorem 
  Component_of {}GX = the carrier of GX;

theorem 
  for V being Subset of GX st V is connected holds Component_of V <>{};

theorem 
  for GX being TopSpace, V being Subset of GX st V is connected & V
  <> {} holds Component_of V is connected;

theorem 
  for V,C being Subset of GX st V is connected & C is connected
  holds Component_of V c= C implies C = Component_of V;

theorem 
  for A being Subset of GX st A is a_component holds Component_of A=A;

theorem 
  for A being Subset of GX holds A is a_component iff ex V
  being Subset of GX st V is connected & V <> {} & A = Component_of V;

theorem 
  for V being Subset of GX st V is connected & V<>{} holds Component_of
  V is a_component;

theorem 
  for A, V be Subset of GX st A is a_component & V is connected &
  V c= A & V<>{} holds A = Component_of V;

theorem 
  for V being Subset of GX st V is connected & V<>{} holds
  Component_of (Component_of V)=Component_of V;

theorem 
  for A,B being Subset of GX st A is connected & B is connected &
  A<>{} & A c= B holds Component_of A = Component_of B;

theorem 
  for A,B being Subset of GX st A is connected & B is connected &
  A<>{} & A c= B holds B c= Component_of A;

theorem 
  for A being Subset of GX,B being Subset of GX st A is connected
  & A \/ B is connected & A<>{} holds A \/ B c= Component_of A;

theorem 
  for A being Subset of GX, p being Point of GX st A is connected
  & p in A holds Component_of p=Component_of A;

theorem 
  for A,B being Subset of GX st A is connected & B is connected & A
  meets B holds A \/ B c= Component_of A & A \/ B c= Component_of B & A c=
  Component_of B & B c= Component_of A;

theorem 
  for A being Subset of GX st A is connected & A<>{} holds Cl A c=
  Component_of A;

theorem 
  for A,B being Subset of GX st A is a_component & B is connected
  & B<>{} & A misses B holds A misses Component_of B;

begin

definition
  let GX be TopStruct;
  mode a_union_of_components of GX -> Subset of GX means


    ex F being
    Subset-Family of GX st (for B being Subset of GX st B in F holds B
    is a_component) & it = union F;
end;

theorem 
  {}(GX) is a_union_of_components of GX;

theorem 
  for A being Subset of GX st A=(the carrier of GX) holds A is
  a_union_of_components of GX;

theorem 
  for A being Subset of GX,p being Point of GX st p in A & A is
  a_union_of_components of GX holds Component_of p c= A;

theorem 
  for A,B being Subset of GX st A is a_union_of_components of GX & B is
a_union_of_components of GX holds A \/ B is a_union_of_components of GX & A /\
  B is a_union_of_components of GX;

theorem 
  for Fu being Subset-Family of GX st (for A being Subset of GX st A in
  Fu holds A is a_union_of_components of GX) holds union Fu is
  a_union_of_components of GX;

theorem 
  for Fu being Subset-Family of GX st (for A being Subset of GX st A in
  Fu holds A is a_union_of_components of GX) holds meet Fu is
  a_union_of_components of GX;

theorem 
  for A,B being Subset of GX st A is a_union_of_components of GX & B is
  a_union_of_components of GX holds A \ B is a_union_of_components of GX;

begin 

definition
  let GX be TopStruct, B be Subset of GX, p be Point of GX;
  assume
 p in B;
  func Down(p,B) -> Point of GX|B equals


  p;
end;

definition
  let GX be TopStruct, B be Subset of GX, p be Point of GX|B;
  assume
 B<>{};
  func Up(p) -> Point of GX equals

  p;
end;

definition
  let GX be TopStruct, V,B be Subset of GX;
  func Down(V,B) -> Subset of GX|B equals

  V /\ B;
end;

definition
  let GX be TopStruct, B be Subset of GX;
  let V be Subset of GX|B;
  func Up(V) -> Subset of GX equals

  V;
end;

definition
  let GX be TopStruct, B be Subset of GX, p be Point of GX;
  assume
 p in B;
  func Component_of(p,B) -> Subset of GX means


  for q being Point of GX| B st q=p holds it=Component_of q;
end;

theorem 
  for B being Subset of GX, p be Point of GX st p in B holds p in
  Component_of(p,B);

theorem 
  for B being Subset of GX, p be Point of GX st p in B holds
  Component_of(p,B)=Component_of Down(p,B);

theorem 
  for GX being TopSpace for V,B being Subset of GX st V is open holds
  Down(V,B) is open;

theorem 
  for V,B being Subset of GX st V c= B holds Cl Down(V,B) =(Cl V) /\ B;

theorem 
  for B being Subset of GX,V being Subset of GX| B holds Cl V =(Cl Up(V) ) /\ B
;

theorem 
  for V,B being Subset of GX st V c= B holds Cl Down(V,B) c= Cl V;

theorem 
  for B being Subset of GX, V being Subset of GX|B st V c= B holds Down(
  Up(V),B)=V;

theorem 
  for B being Subset of GX, p be Point of GX st p in B holds
  Component_of(p,B) is connected;



registration
  let T be non empty TopSpace;
  cluster non empty for a_union_of_components of T;
end;

theorem 
  for T being non empty TopSpace for A being non empty
  a_union_of_components of T st A is connected holds A is a_component;















begin  

reserve i, x, I for set,
  A, M for ManySortedSet of I,
  f for Function,
  F for ManySortedFunction of I;

scheme 

  MSSUBSET { I() -> set, A() -> non-empty ManySortedSet of I(), B() ->
ManySortedSet of I(), P[set] } : (for X being ManySortedSet of I() holds X in A
  () iff X in B() & P[X]) implies A() c= B();

theorem 
  for X being non empty set for x, y being set st x c= y holds { t
  where t is Element of X : y c= t } c= { z where z is Element of X : x c= z };

theorem 
  (ex A st A in M) implies M is non-empty;

registration
  let I, F, A;
  cluster F..A -> total for I-defined Function;
end;

definition
  let I;
  let A, B be non-empty ManySortedSet of I;
  let F be ManySortedFunction of A, B;
  let X be Element of A;
  redefine func F..X -> Element of B;
end;

theorem 
  for A, X being ManySortedSet of I for B being non-empty ManySortedSet
  of I for F being ManySortedFunction of A, B st X in A holds F..X in B;

theorem 
  for F, G being ManySortedFunction of I for A being ManySortedSet
  of I st A in doms G holds F..(G..A) = (F ** G)..A;

theorem 
  F is "1-1" implies for A, B being ManySortedSet of I st A in doms F &
  B in doms F & F..A = F..B holds A = B;

theorem 
  doms F is non-empty & (for A, B being ManySortedSet of I st A in doms
  F & B in doms F & F..A = F..B holds A = B) implies F is "1-1";

theorem 
  for A, B being non-empty ManySortedSet of I for F, G being
  ManySortedFunction of A, B st for M st M in A holds F..M = G..M holds F = G;

registration
  let I, M;
  cluster empty-yielding finite-yielding for Element of bool M;
end;

begin  

definition
  let I, M;
  mode MSSetOp of M is ManySortedFunction of bool M, bool M;
end;

definition
  let I, M;
  let O be MSSetOp of M;
  let X be Element of bool M;
  redefine func O..X -> Element of bool M;
end;

definition
  let I, M;
  let IT be MSSetOp of M;

  attr IT is reflexive means


  for X being Element of bool M holds X c= IT..X;
  attr IT is monotonic means


  for X, Y being Element of bool M st X c= Y holds IT..X c= IT..Y;
  attr IT is idempotent means


  for X being Element of bool M holds IT..X = IT..(IT..X);
  attr IT is topological means


  for X, Y being Element of bool M holds IT..(X \/ Y) = (IT..X) \/ (IT..Y);
end;

theorem 
  for M being non-empty ManySortedSet of I for X being Element of M
  holds X = (id M)..X;

theorem 
  for M being non-empty ManySortedSet of I for X, Y being Element
  of M st X c= Y holds (id M)..X c= (id M)..Y;

theorem 
  for M being non-empty ManySortedSet of I for X, Y being Element
of M st X \/ Y is Element of M holds (id M)..(X \/ Y) = ((id M)..X) \/ ((id M)
  ..Y);

theorem 
  for X being Element of bool M for i, x being set st i in I & x in ((id
(bool M))..X).i ex Y being finite-yielding Element of bool M st Y c= X & x in (
  (id (bool M))..Y).i;

registration
  let I, M;
  cluster reflexive monotonic idempotent topological for MSSetOp of M;
end;

theorem 
  id (bool A) is reflexive MSSetOp of A;

theorem 
  id (bool A) is monotonic MSSetOp of A;

theorem 
  id (bool A) is idempotent MSSetOp of A;

theorem 
  id (bool A) is topological MSSetOp of A;

reserve P, R for MSSetOp of M,
  E, T for Element of bool M;

theorem 
  E = M & P is reflexive implies E = P..E;

theorem 
  (P is reflexive & for X being Element of bool M holds P..X c= X)
  implies P is idempotent;

theorem 
  P is monotonic implies P..(E /\ T) c= P..E /\ P..T;

registration
  let I, M;
  cluster topological -> monotonic for MSSetOp of M;
end;

theorem 
  P is topological implies P..E \ P..T c= P..(E \ T);

definition
  let I, M, R, P;
  redefine func P ** R -> MSSetOp of M;
end;

theorem 
  P is reflexive & R is reflexive implies P ** R is reflexive;

theorem 
  P is monotonic & R is monotonic implies P ** R is monotonic;

theorem 
  P is idempotent & R is idempotent & P**R = R**P implies P ** R is idempotent;

theorem 
  P is topological & R is topological implies P ** R is topological;

theorem 
  P is reflexive & i in I & f = P.i implies for x being Element of
  bool (M.i) holds x c= f.x;

theorem 
  P is monotonic & i in I & f = P.i implies for x, y being Element
  of bool (M.i) st x c= y holds f.x c= f.y;

theorem 
  P is idempotent & i in I & f = P.i implies for x being Element
  of bool (M.i) holds f.x = f.(f.x);

theorem 
  P is topological & i in I & f = P.i implies for x, y being Element of
  bool (M.i) holds f.(x \/ y) = (f.x) \/ (f.y);

begin  


reserve S for 1-sorted;

definition
  let S;
  struct(many-sorted over S) MSClosureStr over S (# Sorts -> ManySortedSet of
    the carrier of S, Family -> MSSubsetFamily of the Sorts #);
end;

reserve MS for many-sorted over S;

definition
  let S;
  let IT be MSClosureStr over S;
  attr IT is additive means


  the Family of IT is additive;
  attr IT is absolutely-additive means


  the Family of IT is absolutely-additive;
  attr IT is multiplicative means


  the Family of IT is multiplicative;
  attr IT is absolutely-multiplicative means


  the Family of IT is absolutely-multiplicative;
  attr IT is properly-upper-bound means


  the Family of IT is properly-upper-bound;
  attr IT is properly-lower-bound means


  the Family of IT is properly-lower-bound;
end;

definition
  let S, MS;
  func MSFull MS -> MSClosureStr over S equals

  MSClosureStr (#the Sorts of MS,
    bool the Sorts of MS#);
end;

registration
  let S, MS;
  cluster MSFull MS -> strict additive absolutely-additive multiplicative
    absolutely-multiplicative properly-upper-bound properly-lower-bound;
end;

registration
  let S;
  let MS be non-empty many-sorted over S;
  cluster MSFull MS -> non-empty;
end;

registration
  let S;
  cluster strict non-empty additive absolutely-additive multiplicative
    absolutely-multiplicative properly-upper-bound properly-lower-bound
    for MSClosureStr over S;
end;

registration
  let S;
  let CS be additive MSClosureStr over S;
  cluster the Family of CS -> additive;
end;

registration
  let S;
  let CS be absolutely-additive MSClosureStr over S;
  cluster the Family of CS -> absolutely-additive;
end;

registration
  let S;
  let CS be multiplicative MSClosureStr over S;
  cluster the Family of CS -> multiplicative;
end;

registration
  let S;
  let CS be absolutely-multiplicative MSClosureStr over S;
  cluster the Family of CS -> absolutely-multiplicative;
end;

registration
  let S;
  let CS be properly-upper-bound MSClosureStr over S;
  cluster the Family of CS -> properly-upper-bound;
end;

registration
  let S;
  let CS be properly-lower-bound MSClosureStr over S;
  cluster the Family of CS -> properly-lower-bound;
end;

registration
  let S;
  let M be non-empty ManySortedSet of the carrier of S;
  let F be MSSubsetFamily of M;
  cluster MSClosureStr (#M, F#) -> non-empty;
end;

registration
  let S, MS;
  let F be additive MSSubsetFamily of the Sorts of MS;
  cluster MSClosureStr (#the Sorts of MS, F#) -> additive;
end;

registration
  let S, MS;
  let F be absolutely-additive MSSubsetFamily of the Sorts of MS;
  cluster MSClosureStr (#the Sorts of MS, F#) -> absolutely-additive;
end;

registration
  let S, MS;
  let F be multiplicative MSSubsetFamily of the Sorts of MS;
  cluster MSClosureStr (#the Sorts of MS, F#) -> multiplicative;
end;

registration
  let S, MS;
  let F be absolutely-multiplicative MSSubsetFamily of the Sorts of MS;
  cluster MSClosureStr (#the Sorts of MS, F#) -> absolutely-multiplicative;
end;

registration
  let S, MS;
  let F be properly-upper-bound MSSubsetFamily of the Sorts of MS;
  cluster MSClosureStr (#the Sorts of MS, F#) -> properly-upper-bound;
end;

registration
  let S, MS;
  let F be properly-lower-bound MSSubsetFamily of the Sorts of MS;
  cluster MSClosureStr (#the Sorts of MS, F#) -> properly-lower-bound;
end;

registration
  let S;
  cluster absolutely-additive -> additive for MSClosureStr over S;
end;

registration
  let S;
  cluster absolutely-multiplicative -> multiplicative for MSClosureStr over S;
end;

registration
  let S;
  cluster absolutely-multiplicative -> properly-upper-bound for
MSClosureStr over
    S;
end;

registration
  let S;
  cluster absolutely-additive -> properly-lower-bound for MSClosureStr over S;
end;

definition
  let S;
  mode MSClosureSystem of S is absolutely-multiplicative MSClosureStr over S;
end;

definition
  let I, M;
  mode MSClosureOperator of M is reflexive monotonic idempotent MSSetOp of M;
end;

definition
  let I, M;
  let F be ManySortedFunction of M, M;
  func MSFixPoints F -> ManySortedSubset of M means


  for i st i in I
  holds x in it.i iff ex f being Function st f = F.i & x in dom f & f.x = x;
end;

registration
  let I;
  let M be empty-yielding ManySortedSet of I;
  let F be ManySortedFunction of M, M;
  cluster MSFixPoints F -> empty-yielding;
end;

theorem 
  for F being ManySortedFunction of M, M holds A in M & F..A = A
  iff A in MSFixPoints F;

theorem 
  MSFixPoints id A = A;

theorem 
  for A being ManySortedSet of the carrier of S for J being
  reflexive monotonic MSSetOp of A for D being MSSubsetFamily of A st D =
  MSFixPoints J holds MSClosureStr (#A, D#) is MSClosureSystem of S;

theorem 
  for D being properly-upper-bound MSSubsetFamily of M for X being
  Element of bool M ex SF being non-empty MSSubsetFamily of M st for Y being
  ManySortedSet of I holds Y in SF iff Y in D & X c= Y;

theorem 
  for D being properly-upper-bound MSSubsetFamily of M for X being
  Element of bool M for SF being non-empty MSSubsetFamily of M st (for Y being
ManySortedSet of I holds Y in SF iff Y in D & X c= Y) holds for i being set, Di
being non empty set st i in I & Di = D.i holds SF.i = { z where z is Element of
Di: X.i c= z };

theorem 
  for D being properly-upper-bound MSSubsetFamily of M ex J being
  MSSetOp of M st for X being Element of bool M for SF being non-empty
MSSubsetFamily of M st (for Y being ManySortedSet of I holds Y in SF iff Y in D
  & X c= Y) holds J..X = meet SF;

theorem 
  for D being properly-upper-bound MSSubsetFamily of M for A being
  Element of bool M for J being MSSetOp of M st A in D & for X being Element of
bool M for SF being non-empty MSSubsetFamily of M st (for Y being ManySortedSet
  of I holds Y in SF iff Y in D & X c= Y) holds J..X = meet SF holds J..A = A;

theorem 
  for D being absolutely-multiplicative MSSubsetFamily of M for A being
Element of bool M for J being MSSetOp of M st J..A = A & for X being Element of
bool M for SF being non-empty MSSubsetFamily of M st (for Y being ManySortedSet
  of I holds Y in SF iff Y in D & X c= Y) holds J..X = meet SF holds A in D;

theorem 
  for D being properly-upper-bound MSSubsetFamily of M for J being
  MSSetOp of M st for X being Element of bool M for SF being non-empty
MSSubsetFamily of M st (for Y being ManySortedSet of I holds Y in SF iff Y in D
  & X c= Y) holds J..X = meet SF holds J is reflexive monotonic;

theorem 
  for D being absolutely-multiplicative MSSubsetFamily of M for J
  being MSSetOp of M st for X being Element of bool M for SF being non-empty
MSSubsetFamily of M st (for Y being ManySortedSet of I holds Y in SF iff Y in D
  & X c= Y) holds J..X = meet SF holds J is idempotent;

theorem 
  for D being MSClosureSystem of S for J being MSSetOp of the Sorts of D
  st for X being Element of bool the Sorts of D for SF being non-empty
  MSSubsetFamily of the Sorts of D st (for Y being ManySortedSet of the carrier
  of S holds Y in SF iff Y in the Family of D & X c= Y) holds J..X = meet SF
  holds J is MSClosureOperator of the Sorts of D;

definition
  let S;
  let A be ManySortedSet of the carrier of S;
  let C be MSClosureOperator of A;
  func ClOp->ClSys C -> MSClosureSystem of S means


  ex D being
  MSSubsetFamily of A st D = MSFixPoints C & it = MSClosureStr (#A, D#);
end;

registration
  let S;
  let A be ManySortedSet of the carrier of S;
  let C be MSClosureOperator of A;
  cluster ClOp->ClSys C -> strict;
end;

registration
  let S;
  let A be non-empty ManySortedSet of the carrier of S;
  let C be MSClosureOperator of A;
  cluster ClOp->ClSys C -> non-empty;
end;

definition
  let S;
  let D be MSClosureSystem of S;
  func ClSys->ClOp D -> MSClosureOperator of the Sorts of D means


  for
X being Element of bool the Sorts of D for SF being non-empty MSSubsetFamily of
the Sorts of D st (for Y being ManySortedSet of the carrier of S holds Y in SF
  iff Y in the Family of D & X c= Y) holds it..X = meet SF;
end;

theorem 
  for A being ManySortedSet of the carrier of S for J being
  MSClosureOperator of A holds ClSys->ClOp (ClOp->ClSys J) = J;

theorem 
  for D being MSClosureSystem of S holds ClOp->ClSys (ClSys->ClOp D) =
  the MSClosureStr of D;














begin 

definition
  let S be non empty ManySortedSign;
  let A be MSAlgebra over S;
  let s be SortSymbol of S;
  mode Element of A,s is Element of (the Sorts of A).s;
end;

definition
  let I be set;
  let A be ManySortedSet of I;
  let h1,h2 be ManySortedFunction of A,A;
  redefine func h2**h1 -> ManySortedFunction of A,A;
end;

theorem 
  for S being non empty non void ManySortedSign for A being
  MSAlgebra over S for o being OperSymbol of S, a being set st a in Args(o,A)
  holds a is Function;

theorem 
  for S being non empty non void ManySortedSign for A being
MSAlgebra over S for o being OperSymbol of S, a being Function st a in Args(o,A
) holds dom a = dom the_arity_of o & for i being set st i in dom the_arity_of o
  holds a.i in (the Sorts of A).((the_arity_of o)/.i);

definition
  let S be non empty non void ManySortedSign;
  let A be MSAlgebra over S;
  attr A is feasible means


  for o being OperSymbol of S st Args(o,A) <> {} holds Result(o,A) <> {};
end;

theorem 
  for S being non empty non void ManySortedSign for o being
  OperSymbol of S for A being MSAlgebra over S holds Args(o,A) <> {} iff for i
  being Element of NAT st i in dom the_arity_of o holds (the Sorts of A).((
  the_arity_of o)/.i) <> {};

registration
  let S be non empty non void ManySortedSign;
  cluster non-empty -> feasible for MSAlgebra over S;
end;

registration
  let S be non empty non void ManySortedSign;
  cluster non-empty for MSAlgebra over S;
end;

definition
  let S be non empty non void ManySortedSign;
  let A be MSAlgebra over S;
  mode Endomorphism of A -> ManySortedFunction of A,A means


    it is_homomorphism A,A;
end;

reserve S for non empty non void ManySortedSign,
  A for MSAlgebra over S;

theorem 
  id the Sorts of A is Endomorphism of A;

theorem 
  for h1,h2 being ManySortedFunction of A,A for o being OperSymbol
of S for a being Element of Args(o,A) st a in Args(o,A) holds h2#(h1#a) = (h2**
  h1)#a;

theorem 
  for h1,h2 being Endomorphism of A holds h2**h1 is Endomorphism of A;

definition
  let S be non empty non void ManySortedSign;
  let A be MSAlgebra over S;
  let h1,h2 be Endomorphism of A;
  redefine func h2**h1 -> Endomorphism of A;
end;

definition
  let S be non empty non void ManySortedSign;
  func TranslationRel S -> Relation of the carrier of S means


  for s1,
s2 being SortSymbol of S holds [s1,s2] in it iff ex o being OperSymbol of S st
the_result_sort_of o = s2 & ex i being Element of NAT st i in dom the_arity_of
  o & (the_arity_of o)/.i = s1;
end;

theorem 
  for S being non empty non void ManySortedSign, o being OperSymbol
  of S for A being MSAlgebra over S, a being Function st a in Args(o,A) for i
being (Element of NAT), x being Element of A,(the_arity_of o)/.i holds a+*(i,x)
  in Args(o,A);

theorem 
  for A1,A2 being MSAlgebra over S, h being ManySortedFunction of
A1,A2 for o being OperSymbol of S st Args(o,A1) <> {} & Args(o,A2) <> {} for i
  being Element of NAT st i in dom the_arity_of o for x being Element of A1,(
  the_arity_of o)/.i holds h.((the_arity_of o)/.i).x in (the Sorts of A2).((
  the_arity_of o)/.i);

theorem 
  for S being non empty non void ManySortedSign, o being OperSymbol
  of S for i being Element of NAT st i in dom the_arity_of o for A1,A2 being
MSAlgebra over S for h being ManySortedFunction of A1,A2 for a,b being Element
of Args(o,A1) st a in Args(o,A1) & h#a in Args(o,A2) for f,g1,g2 being Function
st f = a & g1 = h#a & g2 = h#b for x being Element of A1,((the_arity_of o)/.i)
  st b = f+*(i,x) holds g2.i = h.((the_arity_of o)/.i).x & h#b = g1+*(i,g2.i);

definition
  let S be non empty non void ManySortedSign, o be OperSymbol of S;
  let i be Element of NAT;
  let A be MSAlgebra over S;
  let a be Function;
  func transl(o,i,a,A) -> Function means


  dom it = (the Sorts of A).((
the_arity_of o)/.i) & for x being set st x in (the Sorts of A).((the_arity_of o
  )/.i) holds it.x = Den(o,A).(a+*(i,x));
end;

theorem 
  for S being non empty non void ManySortedSign, o being
OperSymbol of S for i being Element of NAT for A being feasible MSAlgebra over
S, a being Function st a in Args(o,A) holds transl(o,i,a,A) is Function of (the
  Sorts of A).((the_arity_of o)/.i), (the Sorts of A).the_result_sort_of o;

definition
  let S be non empty non void ManySortedSign, s1,s2 be SortSymbol of S;
  let A be MSAlgebra over S;
  let f be Function;
  pred f is_e.translation_of A,s1,s2 means


  ex o being OperSymbol of S
  st the_result_sort_of o = s2 & ex i being Element of NAT st i in dom
the_arity_of o & ((the_arity_of o)/.i) = s1 & ex a being Function st a in Args(
  o,A) & f = transl(o,i,a,A);
end;

theorem 
  for S being non empty non void ManySortedSign, s1,s2 being
  SortSymbol of S for A being feasible MSAlgebra over S, f being Function st f
  is_e.translation_of A,s1,s2 holds f is Function of (the Sorts of A).s1, (the
  Sorts of A).s2 & (the Sorts of A).s1 <> {} & (the Sorts of A).s2 <> {};

theorem 
  for S being non empty non void ManySortedSign, s1,s2 being
  SortSymbol of S for A being MSAlgebra over S, f being Function st f
  is_e.translation_of A,s1,s2 holds [s1,s2] in TranslationRel S;

theorem 
  for S being non empty non void ManySortedSign, s1,s2 being SortSymbol
of S for A being non-empty MSAlgebra over S st [s1,s2] in TranslationRel S ex f
  being Function st f is_e.translation_of A,s1,s2;

theorem 
  for S being non empty non void ManySortedSign for A being
  feasible MSAlgebra over S for s1,s2 being SortSymbol of S for q being
RedSequence of TranslationRel S, p being Function-yielding FinSequence st len q
  = len p+1 & s1 = q.1 & s2 = q.len q & for i being (Element of NAT), f being
Function, s1,s2 being SortSymbol of S st i in dom p & f = p.i & s1 = q.i & s2 =
q.(i+1) holds f is_e.translation_of A,s1,s2 holds compose(p, (the Sorts of A).
s1) is Function of (the Sorts of A).s1, (the Sorts of A).s2 & (p <> {} implies
  (the Sorts of A).s1 <> {} & (the Sorts of A).s2 <> {});

definition
  let S be non empty non void ManySortedSign;
  let A be non-empty MSAlgebra over S;
  let s1,s2 be SortSymbol of S such that
 TranslationRel S reduces s1,s2;
  mode Translation of A,s1,s2 -> Function of (the Sorts of A).s1,(the Sorts of
    A).s2 means


    ex q being RedSequence of TranslationRel S, p being
Function-yielding FinSequence st it = compose(p, (the Sorts of A).s1) & len q =
    len p+1 & s1 = q.1 & s2 = q.len q & for i being (Element of NAT), f being
Function, s1,s2 being SortSymbol of S st i in dom p & f = p.i & s1 = q.i & s2 =
    q.(i+1) holds f is_e.translation_of A,s1,s2;
end;

theorem 
  for S being non empty non void ManySortedSign for A being non-empty
MSAlgebra over S for s1,s2 being SortSymbol of S st TranslationRel S reduces s1
  ,s2 for q being RedSequence of TranslationRel S, p being Function-yielding
FinSequence st len q = len p+1 & s1 = q.1 & s2 = q.len q & for i being (Element
of NAT), f being Function, s1,s2 being SortSymbol of S st i in dom p & f = p.i
& s1 = q.i & s2 = q.(i+1) holds f is_e.translation_of A,s1,s2 holds compose(p,
  (the Sorts of A).s1) is Translation of A,s1,s2;

reserve A for non-empty MSAlgebra over S;

theorem 
  for s being SortSymbol of S holds id ((the Sorts of A).s) is
  Translation of A,s,s;

theorem 
  for s1,s2 being SortSymbol of S, f being Function st f
  is_e.translation_of A,s1,s2 holds TranslationRel S reduces s1,s2 & f is
  Translation of A,s1,s2;

theorem 
  for s1,s2,s3 being SortSymbol of S st TranslationRel S reduces
s1,s2 & TranslationRel S reduces s2,s3 for t1 being Translation of A,s1,s2 for
  t2 being Translation of A,s2,s3 holds t2*t1 is Translation of A,s1,s3;

theorem 
  for s1,s2,s3 being SortSymbol of S st TranslationRel S reduces
  s1,s2 for t being Translation of A,s1,s2 for f being Function st f
  is_e.translation_of A,s2,s3 holds f*t is Translation of A,s1,s3;

theorem 
  for s1,s2,s3 being SortSymbol of S st TranslationRel S reduces s2,s3
  for f being Function st f is_e.translation_of A,s1,s2 for t being Translation
  of A,s2,s3 holds t*f is Translation of A,s1,s3;

scheme 

  TranslationInd {S() -> non empty non void ManySortedSign, A() -> non-empty
  MSAlgebra over S(), P[set,set,set]}: for s1,s2 being SortSymbol of S() st
TranslationRel S() reduces s1,s2 for t being Translation of A(),s1,s2 holds P[t
  ,s1,s2]
provided
 for s being SortSymbol of S() holds P[id ((the Sorts of A()).s),s,s] and
 for s1,s2,s3 being SortSymbol of S() st TranslationRel S() reduces
s1,s2 for t being Translation of A(),s1,s2 st P[t,s1,s2] for f being Function
st f is_e.translation_of A(),s2,s3 holds P[f*t,s1,s3];

theorem 
  for A1,A2 being non-empty MSAlgebra over S for h being
  ManySortedFunction of A1,A2 st h is_homomorphism A1,A2 for o being OperSymbol
of S, i being Element of NAT st i in dom the_arity_of o for a being Element of
Args(o,A1) holds (h.the_result_sort_of o)*transl(o,i,a,A1) = transl(o,i,h#a,A2)
  *(h.((the_arity_of o)/.i));

theorem 
  for h being Endomorphism of A for o being OperSymbol of S, i being
  Element of NAT st i in dom the_arity_of o for a being Element of Args(o,A)
  holds (h.the_result_sort_of o)*transl(o,i,a,A) = transl(o,i,h#a,A)*(h.((
  the_arity_of o)/.i));

theorem 
  for A1,A2 being non-empty MSAlgebra over S for h being
  ManySortedFunction of A1,A2 st h is_homomorphism A1,A2 for s1,s2 being
SortSymbol of S, t being Function st t is_e.translation_of A1,s1,s2 ex T being
Function of (the Sorts of A2).s1, (the Sorts of A2).s2 st T is_e.translation_of
  A2,s1,s2 & T*(h.s1) = (h.s2)*t;

theorem 
  for h being Endomorphism of A for s1,s2 being SortSymbol of S, t being
Function st t is_e.translation_of A,s1,s2 ex T being Function of (the Sorts of
A).s1, (the Sorts of A).s2 st T is_e.translation_of A,s1,s2 & T*(h.s1) = (h.s2)
  *t;

theorem 
  for A1,A2 being non-empty MSAlgebra over S for h being
  ManySortedFunction of A1,A2 st h is_homomorphism A1,A2 for s1,s2 being
SortSymbol of S st TranslationRel S reduces s1,s2 for t being Translation of A1
  ,s1,s2 ex T being Translation of A2,s1,s2 st T*(h.s1) = (h.s2)*t;

theorem 
  for h being Endomorphism of A for s1,s2 being SortSymbol of S st
  TranslationRel S reduces s1,s2 for t being Translation of A,s1,s2 ex T being
  Translation of A,s1,s2 st T*(h.s1) = (h.s2)*t;

begin 

definition
  let S be non empty non void ManySortedSign;
  let A be MSAlgebra over S;
  let R be ManySortedRelation of A;
  attr R is compatible means


  for o being OperSymbol of S, a,b being
Function st a in Args(o,A) & b in Args(o,A) & (for n be Element of NAT st n in
dom the_arity_of o holds [a.n,b.n] in R.((the_arity_of o)/.n)) holds [Den(o,A).
  a,Den(o,A).b] in R.(the_result_sort_of o);
  attr R is invariant means


  for s1,s2 being SortSymbol of S for t
being Function st t is_e.translation_of A,s1,s2 for a,b being set st [a,b] in R
  .s1 holds [t.a, t.b] in R.s2;
  attr R is stable means


  for h being Endomorphism of A for s being
SortSymbol of S for a,b being set st [a,b] in R.s holds [(h.s).a, (h.s).b] in R
  .s;
end;

theorem 
  for R being MSEquivalence-like ManySortedRelation of A holds R is
  compatible iff R is MSCongruence of A;

theorem 
  for R being ManySortedRelation of A holds R is invariant iff for
  s1,s2 being SortSymbol of S st TranslationRel S reduces s1,s2 for f being
Translation of A,s1,s2 for a,b being set st [a,b] in R.s1 holds [f.a,f.b] in R.
  s2;

registration
  let S be non empty non void ManySortedSign;
  let A be non-empty MSAlgebra over S;
  cluster invariant -> compatible for
MSEquivalence-like ManySortedRelation of A;
  cluster compatible -> invariant for
MSEquivalence-like ManySortedRelation of A;
end;

registration
  let X be non empty set;
  cluster id X -> non empty;
end;

scheme 

  MSRExistence {I() -> non empty set, A() -> non-empty ManySortedSet of I(), P
[set,set,set]}: ex R being ManySortedRelation of A() st for i being Element of
  I() for a,b being Element of A().i holds [a,b] in R.i iff P[i,a,b];

scheme 

  MSRLambdaU{I() -> set, A() -> ManySortedSet of I(), F(set) -> set}: (ex R
being ManySortedRelation of A() st for i being set st i in I() holds R.i = F(i)
  ) & for R1,R2 being ManySortedRelation of A() st (for i being set st i in I()
holds R1.i = F(i)) & (for i being set st i in I() holds R2.i = F(i)) holds R1 =
  R2
provided
 for i being set st i in I() holds F(i) is Relation of A().i, A().i;

definition
  let I be set, A be ManySortedSet of I;
  func id(I,A) -> ManySortedRelation of A means


  for i being set st i in I holds it.i = id (A.i);
end;

registration
  let S be non empty non void ManySortedSign;
  let A be non-empty MSAlgebra over S;
  cluster MSEquivalence-like -> non-empty for ManySortedRelation of A;
end;

registration
  let S be non empty non void ManySortedSign;
  let A be non-empty MSAlgebra over S;
  cluster invariant stable MSEquivalence-like for ManySortedRelation of A;
end;

begin 

reserve S for non empty non void ManySortedSign,
  A for non-empty MSAlgebra over S,
  R for ManySortedRelation of the Sorts of A;

scheme 

  MSRelCl {S() -> non empty non void ManySortedSign, A() -> non-empty
MSAlgebra over S(), P[set,set,set], R[set], R,Q() -> ManySortedRelation of A()}
: R[Q()] & R() c= Q() & for P being ManySortedRelation of A() st R[P] & R() c=
  P holds Q() c= P
provided
 for R being ManySortedRelation of A() holds R[R] iff for s1,s2 being
SortSymbol of S() for f being Function of (the Sorts of A()).s1,(the Sorts of A
()).s2 st P[f,s1,s2] for a,b being set st [a,b] in R.s1 holds [f.a,f.b] in R.s2
and
 for s1,s2,s3 being SortSymbol of S() for f1 being Function of (the
Sorts of A()).s1,(the Sorts of A()).s2 for f2 being Function of (the Sorts of A
()).s2,(the Sorts of A()).s3 st P[f1,s1,s2] & P[f2,s2,s3] holds P[f2*f1,s1,s3]
and
 for s being SortSymbol of S() holds P[id ((the Sorts of A()).s),s,s] and
 for s being SortSymbol of S(), a,b being Element of A(),s holds [a,b
] in Q().s iff ex s9 being SortSymbol of S(), f being Function of (the Sorts of
A()).s9,(the Sorts of A()).s, x,y being Element of A(),s9 st P[f,s9,s] & [x,y]
in R().s9 & a = f.x & b = f.y;

definition
  let S be non empty non void ManySortedSign;
  let A be non-empty MSAlgebra over S;
  let R be ManySortedRelation of the Sorts of A;
  func InvCl R -> invariant ManySortedRelation of A means


  R c= it &
  for Q being invariant ManySortedRelation of A st R c= Q holds it c= Q;
end;

theorem 
  for R being ManySortedRelation of the Sorts of A for s being
SortSymbol of S for a,b being Element of A,s holds [a,b] in (InvCl R).s iff ex
  s9 being SortSymbol of S, x,y being Element of A,s9 st ex t being Translation
of A,s9,s st TranslationRel S reduces s9,s & [x,y] in R.s9 & a = t.x & b = t.y;

theorem 
  for R being stable ManySortedRelation of A holds InvCl R is stable;

definition
  let S be non empty non void ManySortedSign;
  let A be non-empty MSAlgebra over S;
  let R be ManySortedRelation of the Sorts of A;
  func StabCl R -> stable ManySortedRelation of A means


  R c= it & for Q being stable ManySortedRelation of A st R c= Q holds it c= Q;
end;

theorem 
  for R being ManySortedRelation of the Sorts of A for s being
SortSymbol of S for a,b being Element of A,s holds [a,b] in (StabCl R).s iff ex
x,y being Element of A,s, h being Endomorphism of A st [x,y] in R.s & a = h.s.x
  & b = h.s.y;

theorem 
  InvCl StabCl R is stable;

definition
  let S be non empty non void ManySortedSign;
  let A be non-empty MSAlgebra over S;
  let R be ManySortedRelation of the Sorts of A;
  func TRS R -> invariant stable ManySortedRelation of A means


  R c=
it & for Q being invariant stable ManySortedRelation of A st R c= Q holds it c=
  Q;
end;

registration
  let S be non empty non void ManySortedSign;
  let A be non-empty MSAlgebra over S;
  let R be non-empty ManySortedRelation of A;
  cluster InvCl R -> non-empty;
  cluster StabCl R -> non-empty;
  cluster TRS R -> non-empty;
end;

theorem 
  for R being invariant ManySortedRelation of A holds InvCl R = R;

theorem 
  for R being stable ManySortedRelation of A holds StabCl R = R;

theorem 
  for R being invariant stable ManySortedRelation of A holds TRS R = R;

theorem 
  StabCl R c= TRS R & InvCl R c= TRS R & StabCl InvCl R c= TRS R;

theorem 
  InvCl StabCl R = TRS R;

theorem 
  for R being ManySortedRelation of the Sorts of A for s being
  SortSymbol of S, a,b being Element of A,s holds [a,b] in (TRS R).s iff ex s9
being SortSymbol of S st TranslationRel S reduces s9, s & ex l,r being Element
of A,s9, h being Endomorphism of A, t being Translation of A, s9, s st [l,r] in
  R.s9 & a = t.(h.s9.l) & b = t.(h.s9.r);

begin 

theorem 
  for A being set for R,E being Relation of A st for a,b being set
  st a in A & b in A holds [a,b] in E iff a,b are_convertible_wrt R holds E is
  total symmetric transitive;

theorem 
  for A being set, R being Relation of A for E being
  Equivalence_Relation of A st R c= E for a,b being set st a in A & a,b
  are_convertible_wrt R holds [a,b] in E;

theorem 
  for A being non empty set, R being Relation of A for a,b being
  Element of A holds [a,b] in EqCl R iff a,b are_convertible_wrt R;

theorem 
  for S being non empty set, A being non-empty ManySortedSet of S
  for R being ManySortedRelation of A for s being Element of S for a,b being
  Element of A.s holds [a,b] in (EqCl R).s iff a,b are_convertible_wrt R.s;

definition
  let S be non empty non void ManySortedSign;
  let A be non-empty MSAlgebra over S;
  mode EquationalTheory of A is stable invariant MSEquivalence-like
    ManySortedRelation of A;
  let R be ManySortedRelation of A;
  func EqCl(R,A) -> MSEquivalence-like ManySortedRelation of A equals

  EqCl R;
end;

theorem 
  for R being ManySortedRelation of A holds R c= EqCl(R,A);

theorem 
  for R being ManySortedRelation of A for E being
  MSEquivalence-like ManySortedRelation of A st R c= E holds EqCl(R,A) c= E;

theorem 
  for R being stable ManySortedRelation of A for s being
SortSymbol of S for a,b being Element of A,s st a,b are_convertible_wrt R.s for
  h being Endomorphism of A holds h.s.a, h.s.b are_convertible_wrt R.s;

theorem 
  for R being stable ManySortedRelation of A holds EqCl(R,A) is stable;

registration
  let S,A;
  let R be stable ManySortedRelation of A;
  cluster EqCl(R,A) -> stable;
end;

theorem 
  for R being invariant ManySortedRelation of A for s1,s2 being
  SortSymbol of S for a,b being Element of A,s1 st a,b are_convertible_wrt R.s1
  for t being Function st t is_e.translation_of A,s1,s2 holds t.a, t.b
  are_convertible_wrt R.s2;

theorem 
  for R being invariant ManySortedRelation of A holds EqCl(R,A) is invariant;

registration
  let S,A;
  let R be invariant ManySortedRelation of A;
  cluster EqCl(R,A) -> invariant;
end;

theorem 
  for S being non empty set, A being non-empty ManySortedSet of S
for R,E being ManySortedRelation of A st for s being Element of S for a,b being
  Element of A.s holds [a,b] in E.s iff a,b are_convertible_wrt R.s holds E is
  MSEquivalence_Relation-like;

theorem 
  for R,E being ManySortedRelation of A st for s being SortSymbol
of S, a,b being Element of A,s holds [a,b] in E.s iff a,b are_convertible_wrt (
  TRS R).s holds E is EquationalTheory of A;

theorem 
  for S being non empty set, A being non-empty ManySortedSet of S
  for R being ManySortedRelation of A for E being MSEquivalence_Relation-like
  ManySortedRelation of A st R c= E for s being Element of S for a,b being
  Element of A.s st a,b are_convertible_wrt R.s holds [a,b] in E.s;

definition
  let S be non empty non void ManySortedSign;
  let A be non-empty MSAlgebra over S;
  let R be ManySortedRelation of the Sorts of A;
  func EqTh R -> EquationalTheory of A means


  R c= it & for Q being EquationalTheory of A st R c= Q holds it c= Q;
end;

theorem 
  for R being ManySortedRelation of A holds EqCl(R,A) c= EqTh R & InvCl
  R c= EqTh R & StabCl R c= EqTh R & TRS R c= EqTh R;

theorem 
  for R being ManySortedRelation of A for s being SortSymbol of S, a,b
being Element of A,s holds [a,b] in (EqTh R).s iff a,b are_convertible_wrt (TRS
  R).s;

theorem 
  for R being ManySortedRelation of A holds EqTh R = EqCl(TRS R,A);















begin 

reserve G for Graph,
  k, m, n for Element of NAT;

definition
  let G be Graph;
  redefine mode Chain of G means


    it is FinSequence of the carrier' of G
    & ex p being FinSequence of the carrier of G st p is_vertex_seq_of it;
end;

canceled;

theorem 
  for p,q being FinSequence st n<=len p holds (1,n)-cut p = (1,n)-cut (p ^q);

notation
  let G be Graph;
  let IT be Chain of G;
  synonym IT is directed for IT is oriented;
end;

definition
  let G be Graph;
  let IT be Chain of G;
  attr IT is cyclic means


  ex p being FinSequence of the carrier of G st
  p is_vertex_seq_of IT & p.1 = p.(len p);
end;

registration
  cluster void for Graph;
end;

theorem 
  for G being Graph holds rng (the Source of G) \/ rng (the Target
  of G) c= the carrier of G;

registration
  cluster finite simple connected non void strict for Graph;
end;

theorem 
  for e being set for s, t being Element of the carrier of G st s =
  (the Source of G).e & t = (the Target of G).e holds <*s, t*> is_vertex_seq_of
  <*e*>;

theorem 
  for e being set st e in the carrier' of G holds <*e*> is directed Chain of G;

reserve G for non void Graph;

registration
  let G;
  cluster directed non empty one-to-one for Chain of G;
end;

theorem 
  for G being Graph, c being Chain of G, vs being FinSequence of
the carrier of G st c is cyclic & vs is_vertex_seq_of c
 holds vs.1 = vs.(len vs);

theorem 
  for G being Graph, e being set st e in the carrier' of G for fe
being directed Chain of G st fe = <*e*> holds vertex-seq fe = <*(the Source of
  G).e, (the Target of G).e*>;

theorem 
  for f being FinSequence holds len (m,n)-cut f <= len f;

theorem 
  for c being directed Chain of G st 1<=m & m<=n & n<=len c holds (m,n)
  -cut c is directed Chain of G;

theorem 
  for oc being non empty directed Chain of G holds len vertex-seq
  oc = len oc +1;

registration
  let G;
  let oc be directed non empty Chain of G;
  cluster vertex-seq oc -> non empty;
end;

theorem 
  for oc being directed non empty Chain of G, n st 1<=n & n<=len
oc holds (vertex-seq oc).n = (the Source of G).(oc.n) & (vertex-seq oc).(n+1) =
  (the Target of G).(oc.n);

theorem 
  for f being non empty FinSequence st 1<=m & m<=n & n<=len f
  holds (m,n)-cut f is non empty;

theorem 
  for c, c1 being directed Chain of G st 1<=m & m<=n & n<=len c & c1 = (
  m,n)-cut c holds vertex-seq c1 = (m,n+1)-cut vertex-seq c;

theorem 
  for oc being directed non empty Chain of G holds (vertex-seq oc)
  .(len oc +1) = (the Target of G).(oc.len oc);

theorem 
  for c1, c2 being directed non empty Chain of G holds (vertex-seq
c1).(len c1 + 1) = (vertex-seq c2).1 iff c1^c2 is directed non empty Chain of G
;

theorem 
  for c, c1, c2 being directed non empty Chain of G st c =c1^c2
  holds (vertex-seq c).1 = (vertex-seq c1).1 & (vertex-seq c).(len c +1) = (
  vertex-seq c2).(len c2 +1);

theorem 
  for oc being directed non empty Chain of G st oc is cyclic holds
  (vertex-seq oc).1 = (vertex-seq oc).(len oc +1);

theorem 
  for c being directed non empty Chain of G st c is cyclic for n
  ex ch being directed Chain of G st len ch = n & ch^c is directed non empty
  Chain of G;

definition

  let IT be Graph;
  attr IT is directed_cycle-less means


  for dc being directed Chain of IT st dc is non empty holds dc is non cyclic;
end;

notation
  let IT be Graph;
  antonym IT is with_directed_cycle for IT is directed_cycle-less;
end;

registration
  cluster void -> directed_cycle-less for Graph;
end;

definition
  let IT be Graph;
  attr IT is well-founded means


  for v being Element of the carrier of
IT ex n st for c being directed Chain of IT st c is non empty & (vertex-seq c).
  (len c +1) = v holds len c <= n;
end;

registration
  let G be void Graph;
  cluster -> empty for Chain of G;
end;

registration
  cluster void -> well-founded for Graph;
end;

registration
  cluster non well-founded -> non void for Graph;
end;

registration
  cluster well-founded for Graph;
end;

registration
  cluster well-founded -> directed_cycle-less for Graph;
end;

registration
  cluster non well-founded for Graph;
end;

registration
  cluster directed_cycle-less for Graph;
end;

theorem 
  for t being DecoratedTree, p being Node of t, k being Element of NAT
  holds p|k is Node of t;

begin 

theorem 
  for S being non void non empty ManySortedSign, X being non-empty
  ManySortedSet of the carrier of S, t being Term of S,X st t is not root
  ex o being OperSymbol of S st t.{} = [o,the carrier of S];

theorem 
  for S being non void non empty ManySortedSign, A being MSAlgebra
  over S, G being GeneratorSet of A, B being MSSubset of A st G c= B holds B is
  GeneratorSet of A;

registration
  let S be non void non empty ManySortedSign, A be finitely-generated
  non-empty MSAlgebra over S;
  cluster non-empty finite-yielding for GeneratorSet of A;
end;

theorem 
  for S being non void non empty ManySortedSign, A being non-empty
  MSAlgebra over S, X being non-empty GeneratorSet of A ex F being
  ManySortedFunction of FreeMSA X, A st F is_epimorphism FreeMSA X, A;

theorem 
  for S being non void non empty ManySortedSign, A being non-empty
  MSAlgebra over S, X being non-empty GeneratorSet of A st A is non
  finite-yielding holds FreeMSA X is non finite-yielding;

registration
  let S be non void non empty ManySortedSign, X be non-empty finite-yielding
  ManySortedSet of the carrier of S, v be SortSymbol of S;
  cluster FreeGen(v, X) -> finite;
end;

theorem 
  for S being non void non empty ManySortedSign, A being non-empty
MSAlgebra over S, o be OperSymbol of S st (the Arity of S).o = {} holds dom Den
  (o, A) = {{}};

definition
  let IT be non void non empty ManySortedSign;
  attr IT is finitely_operated means


  for s being SortSymbol of IT holds
  {o where o is OperSymbol of IT: the_result_sort_of o = s} is finite;
end;

theorem 
  for S being non void non empty ManySortedSign, A being non-empty
  MSAlgebra over S, v be SortSymbol of S st S is finitely_operated holds
  Constants(A, v) is finite;

theorem 
  for S being non void non empty ManySortedSign, X being non-empty
ManySortedSet of the carrier of S, v being SortSymbol of S holds {t where t is
  Element of (the Sorts of FreeMSA X).v: depth t = 0} = FreeGen(v, X) \/
  Constants(FreeMSA X, v);

theorem 
  for S being non void non empty ManySortedSign, X being non-empty
  ManySortedSet of the carrier of S, v, vk being SortSymbol of S, o being
  OperSymbol of S, t being Element of (the Sorts of FreeMSA X).v, a being (
  ArgumentSeq of Sym(o,X)), k being Element of NAT, ak being Element of (the
Sorts of FreeMSA X).vk st t = [o,the carrier of S]-tree a & k in dom a & ak = a
  .k holds depth ak < depth t;














begin



reserve I for non empty set;
reserve M for ManySortedSet of I;
reserve Y,x,y,y1,i,j for set;
reserve k for Element of NAT;
reserve p for FinSequence;
reserve S for non void non empty ManySortedSign;
reserve A for non-empty MSAlgebra over S;

theorem 
  for n be (Element of NAT), p be FinSequence holds 1 <= n & n <
  len p iff n in dom p & n+1 in dom p;

scheme 

  NonUniqSeqEx{A()->(Element of NAT),P[set,set]}: ex p st dom p = Seg A() &
  for k st k in Seg A() holds P[k,p.k]
provided
 for k st k in Seg A() ex x st P[k,x];

theorem 
  for a,b be Element of EqRelLatt Y for A,B be Equivalence_Relation
  of Y st a = A & b = B holds a [= b iff A c= B;

registration
  let Y;
  cluster EqRelLatt Y -> bounded;
end;

theorem 
  Bottom EqRelLatt Y = id Y;

theorem 
  Top EqRelLatt Y = nabla Y;

theorem 
  EqRelLatt Y is complete;

registration
  let Y;
  cluster EqRelLatt Y -> complete;
end;

theorem 
  for Y be set for X be Subset of EqRelLatt Y holds union X is Relation of Y;

theorem 
  for Y be set for X be Subset of EqRelLatt Y holds union X c= "\/" X;

theorem 
  for Y be set for X be Subset of EqRelLatt Y for R be Relation of
  Y st R = union X holds "\/" X = EqCl R;

theorem 
  for Y be set for X be Subset of EqRelLatt Y for R be Relation st
  R = union X holds R = R~;

theorem 
  for Y be set for X be Subset of EqRelLatt Y holds x in Y & y in
Y implies ( [x,y] in "\/" X iff ex f being FinSequence st 1 <= len f & x = f.1
& y = f.(len f) & for i be Element of NAT st 1 <= i & i < len f holds [f.i,f.(i
  +1)] in union X );

begin 


theorem 
  for B be Subset of CongrLatt A holds "/\" (B,EqRelLatt the Sorts
  of A) is MSCongruence of A;

definition
  let S,A;
  let E be Element of EqRelLatt the Sorts of A;
  func CongrCl E -> MSCongruence of A equals

  "/\" ({x where x is Element of
EqRelLatt the Sorts of A : x is MSCongruence of A & E [= x},EqRelLatt the Sorts
  of A);
end;

definition
  let S,A;
  let X be Subset of EqRelLatt the Sorts of A;
  func CongrCl X -> MSCongruence of A equals

  "/\" ({x where x is Element of
EqRelLatt the Sorts of A : x is MSCongruence of A & X is_less_than x},EqRelLatt
  the Sorts of A);
end;

theorem 
  for C be Element of EqRelLatt the Sorts of A st C is MSCongruence of A
  holds CongrCl C = C;

theorem 
  for X be Subset of EqRelLatt the Sorts of A holds CongrCl "\/" (X,
  EqRelLatt the Sorts of A) = CongrCl X;

theorem 
  for B1,B2 be Subset of CongrLatt A, C1,C2 be MSCongruence of A st C1 =
  "\/"(B1,EqRelLatt the Sorts of A) & C2 = "\/"(B2,EqRelLatt the Sorts of A)
  holds C1 "\/" C2 = "\/"(B1 \/ B2,EqRelLatt the Sorts of A);

theorem 
  for X be Subset of CongrLatt A holds "\/" (X,EqRelLatt the Sorts of A)
  = "\/" ({ "\/" (X0,EqRelLatt the Sorts of A) where X0 is Subset of EqRelLatt
  the Sorts of A : X0 is finite Subset of X },EqRelLatt the Sorts of A);

theorem 
  for i be Element of I for e be Equivalence_Relation of M.i ex E
be Equivalence_Relation of M st E.i = e & for j be Element of I st j <> i holds
  E.j = nabla (M.j);

notation
  let I be non empty set;
  let M be ManySortedSet of I;
  let i be Element of I;
  let X be Subset of EqRelLatt M;
  synonym EqRelSet (X,i) for pi(X,i);
end;

definition
  let I be non empty set;
  let M be ManySortedSet of I;
  let i be Element of I;
  let X be Subset of EqRelLatt M;
  redefine func EqRelSet (X,i) -> Subset of EqRelLatt M.i means


  x in it iff ex Eq be Equivalence_Relation of M st x = Eq.i & Eq in X;
end;

theorem 
  for i be Element of S for X be Subset of EqRelLatt the Sorts of
  A for B be Equivalence_Relation of the Sorts of A st B = "\/" X holds B.i =
  "\/" (EqRelSet (X,i) , EqRelLatt (the Sorts of A).i);

theorem 
  for X be Subset of CongrLatt A holds "\/" (X,EqRelLatt the Sorts
  of A) is MSCongruence of A;

theorem 
  CongrLatt A is /\-inheriting;

theorem 
  CongrLatt A is \/-inheriting;

registration
  let S,A;
  cluster CongrLatt A -> /\-inheriting \/-inheriting;
end;















begin

reserve k, n for Nat;

definition
  let S be ManySortedSign;
  func InducedEdges S -> set means


  for x being set holds x in it iff ex
op, v being set st x = [op, v] & op in the carrier' of S & v in the carrier of
S & ex n being Nat, args being Element of (the carrier of S)* st (the Arity of
  S).op = args & n in dom args & args.n = v;
end;

theorem 
  for S being ManySortedSign holds InducedEdges S c= [: the
  carrier' of S, the carrier of S :];

definition
  let S be ManySortedSign;
  func InducedSource S -> Function of InducedEdges S, the carrier of S means


   for e being set st e in InducedEdges S holds it.e = e`2;
  func InducedTarget S -> Function of InducedEdges S, the carrier of S means


   for
 e being set st e in InducedEdges S holds it.e = (the ResultSort of S)
  .e`1;
end;

definition
  let S be non empty ManySortedSign;
  func InducedGraph S -> Graph equals

  MultiGraphStruct (# the carrier of S,
    InducedEdges S, InducedSource S, InducedTarget S #);
end;

theorem 
  for S being non void non empty ManySortedSign, X being
non-empty ManySortedSet of the carrier of S, v being SortSymbol of S, n st 1<=n
holds (ex t being Element of (the Sorts of FreeMSA X).v st depth t = n) iff (ex
c being directed Chain of InducedGraph S st len c = n & (vertex-seq c).(len c +
  1) = v);

theorem 
  for S being void non empty ManySortedSign holds S is monotonic iff
  InducedGraph S is well-founded;

theorem 
  for S being non void non empty ManySortedSign st S is monotonic
  holds InducedGraph S is well-founded;

theorem 
  for S being non void non empty ManySortedSign, X being non-empty
finite-yielding ManySortedSet of the carrier of S st S is finitely_operated for
n being Nat, v being SortSymbol of S holds {t where t is Element of (the Sorts
  of FreeMSA X).v: depth t <= n} is finite;

theorem 
  for S being non void non empty ManySortedSign st S is
  finitely_operated & InducedGraph S is well-founded holds S is monotonic;














begin 

scheme 
 ValOnPair {X()-> non empty set,f()-> Function,
  x1,x2()-> Element of X(), F(set,set)-> set, P[set,set]}:
  f().(x1(),x2()) = F(x1(),x2())
provided
 f() = { [[o,o9],F(o,o9)]
where o is Element of X(), o9 is Element of X(): P[o,o9] } and
 P[x1(),x2()];

theorem 
  for A being set holds {} is Function of A,{};

theorem 
  for I being set for M being ManySortedSet of I holds M*id I = M;

registration
  let f be empty Function;
  cluster ~f -> empty;
  let g be Function;
  cluster [:f,g:] -> empty;
  cluster [:g,f:] -> empty;
end;

theorem 
  for A being set, f being Function holds f.:id A = (~f).:id A;

theorem 
  for X,Y being set, f being Function of X,Y holds
  f is onto iff [:f,f:] is onto;

registration
  let f be Function-yielding Function;
  cluster ~f -> Function-yielding;
end;

theorem 
  for A,B being set, a being set holds ~([:A,B:] --> a) = [:B,A:] --> a;

theorem 
  for f,g being Function st f is one-to-one & g is one-to-one holds
  [:f,g:]" = [:f",g":];

theorem 
  for f being Function st [:f,f:] is one-to-one holds f is one-to-one;

theorem 
  for f being Function st f is one-to-one holds ~f is one-to-one;

theorem 
  for f,g being Function st ~[:f,g:] is one-to-one holds [:g,f:] is one-to-one;

theorem 
  for f,g being Function st f is one-to-one & g is one-to-one holds
  ~[:f,g:]" = ~([:g,f:]");

theorem 
  for A,B be set, f being Function of A,B st f is onto
  holds id B c= [:f,f:].:id A;

theorem 
  for F,G being Function-yielding Function, f be Function
  holds (G**F)*f = (G*f)**(F*f);

definition
  let A,B,C be set, f be Function of [:A,B:],C;
  redefine func ~f -> Function of [:B,A:],C;
end;

theorem 
  for A,B,C being set, f being Function of [:A,B:],C st ~f is onto
  holds f is onto;

theorem 
  for A be set, B being non empty set, f being Function of A,B
  holds [:f,f:].:id A c= id B;

begin 

definition
  let A,B be set;
  mode bifunction of A,B is Function of [:A,A:],[:B,B:];
end;

definition
  let A,B be set, f be bifunction of A,B;

  attr f is Covariant means


  ex g being Function of A,B st f = [:g,g:];
  attr f is Contravariant means


  ex g being Function of A,B st f = ~[:g,g:];
end;

theorem 
  for A be set, B be non empty set,
  b being Element of B, f being bifunction of A,B st f = [:A,A:] --> [b,b]
  holds f is Covariant Contravariant;

registration
  let A,B be set;
  cluster Covariant Contravariant for bifunction of A,B;
end;

theorem 
  for A,B being non empty set
  for f being Covariant Contravariant bifunction of A,B
  ex b being Element of B st f = [:A,A:] --> [b,b];

begin 

definition
  let I1,I2 be set, f be Function of I1,I2;
  let A be ManySortedSet of I1, B be ManySortedSet of I2;
  mode MSUnTrans of f,A,B -> ManySortedSet of I1 means


    ex I29 being non empty set, B9 being ManySortedSet of I29,
    f9 being Function of I1,I29 st f = f9 & B = B9 &
    it is ManySortedFunction of A,B9*f9 if I2 <> {} otherwise it = [[0]]I1;
end;

definition
  let I1 be set, I2 be non empty set, f be Function of I1,I2;
  let A be ManySortedSet of I1, B be ManySortedSet of I2;
  redefine mode MSUnTrans of f,A,B means


    it is ManySortedFunction of A,B*f;
end;

registration
  let I1,I2 be set;
  let f be Function of I1,I2;
  let A be ManySortedSet of I1, B be ManySortedSet of I2;
  cluster -> Function-yielding for MSUnTrans of f,A,B;
end;

theorem 
  for I1 being set, I2,I3 being non empty set,
  f being Function of I1,I2, g being Function of I2,I3,
  B being ManySortedSet of I2, C being ManySortedSet of I3,
  G being MSUnTrans of g,B,C holds G*f is MSUnTrans of g*f,B*f,C;

definition
  let I1 be set, I2 be non empty set, f be Function of I1,I2,
  A be ManySortedSet of [:I1,I1:], B be ManySortedSet of [:I2,I2:],
  F be MSUnTrans of [:f,f:],A,B;
  redefine func ~F -> MSUnTrans of [:f,f:],~A,~B;
end;

theorem 
  for I1,I2 being non empty set,
  A being ManySortedSet of I1, B being ManySortedSet of I2,
  o being Element of I2 st B.o <> {}
  for m being Element of B.o, f being Function of I1,I2 st f = I1 --> o holds
  { [o9,A.o9 --> m] where o9 is Element of I1: not contradiction }
  is MSUnTrans of f,A,B;

theorem 
  for I1 being set, I2,I3 being non empty set,
  f being Function of I1,I2, g being Function of I2,I3,
  A being ManySortedSet of I1, B being ManySortedSet of I2,
  C being ManySortedSet of I3, F being MSUnTrans of f,A,B,
  G being MSUnTrans of g*f,B*f,C
  st for ii being set st ii in I1 & (B*f).ii = {}
  holds A.ii = {} or (C*(g*f)).ii = {}
  holds G**(F qua Function-yielding Function) is MSUnTrans of g*f,A,C;

begin 

definition
  let C1,C2 be 1-sorted;
  struct BimapStr over C1,C2
  (#ObjectMap -> bifunction of the carrier of C1, the carrier of C2 #);
end;

definition
  let C1,C2 be non empty AltGraph;
  let F be BimapStr over C1,C2;
  let o be object of C1;
  func F.o -> object of C2 equals

  ((the ObjectMap of F).(o,o))`1;
end;

definition
  let A,B be 1-sorted, F be BimapStr over A,B;
  attr F is one-to-one means


  the ObjectMap of F is one-to-one;
  attr F is onto means


  the ObjectMap of F is onto;
  attr F is reflexive means


  (the ObjectMap of F).:id the carrier of A c= id the carrier of B;
  attr F is coreflexive means


  id the carrier of B c= (the ObjectMap of F).:id the carrier of A;
end;

definition
  let A,B be non empty AltGraph, F be BimapStr over A,B;
  redefine attr F is reflexive means


  for o being object of A holds (the ObjectMap of F).(o,o) = [F.o,F.o];
end;

theorem 
  for A,B being reflexive non empty AltGraph,
  F being BimapStr over A,B st F is coreflexive for o being object of B
  ex o9 being object of A st F.o9 = o;

definition
  let C1, C2 be non empty AltGraph;
  let F be BimapStr over C1,C2;
  attr F is feasible means


  for o1,o2 being object of C1 st <^o1,o2^> <> {} holds
  (the Arrows of C2).((the ObjectMap of F).(o1,o2)) <> {};
end;

definition
  let C1,C2 be AltGraph;
  struct(BimapStr over C1,C2) FunctorStr over C1,C2
  (#ObjectMap -> bifunction of the carrier of C1,the carrier of C2,
    MorphMap ->
    MSUnTrans of the ObjectMap, the Arrows of C1, the Arrows of C2 #);
end;

definition
  let C1,C2 be 1-sorted;
  let IT be BimapStr over C1,C2;
  attr IT is Covariant means


  the ObjectMap of IT is Covariant;
  attr IT is Contravariant means


  the ObjectMap of IT is Contravariant;
end;

registration
  let C1,C2 be AltGraph;
  cluster Covariant for FunctorStr over C1,C2;
  cluster Contravariant for FunctorStr over C1,C2;
end;

definition
  let C1,C2 be AltGraph;
  let F be FunctorStr over C1,C2;
  let o1,o2 be object of C1;
  func Morph-Map(F,o1,o2) equals

  (the MorphMap of F).(o1,o2);
end;

registration
  let C1,C2 be AltGraph;
  let F be FunctorStr over C1,C2;
  let o1,o2 be object of C1;
  cluster Morph-Map(F,o1,o2) -> Relation-like Function-like;
end;

definition
  let C1,C2 be non empty AltGraph;
  let F be Covariant FunctorStr over C1,C2;
  let o1,o2 be object of C1;
  redefine func Morph-Map(F,o1,o2) -> Function of <^o1,o2^>, <^F.o1,F.o2^>;
end;

definition
  let C1,C2 be non empty AltGraph;
  let F be Covariant FunctorStr over C1,C2;
  let o1,o2 be object of C1 such that
 <^o1,o2^> <> {} and
 <^F.o1,F.o2^> <> {};
  let m be Morphism of o1,o2;
  func F.m -> Morphism of F.o1, F.o2 equals


  Morph-Map(F,o1,o2).m;
end;

definition
  let C1,C2 be non empty AltGraph;
  let F be Contravariant FunctorStr over C1,C2;
  let o1,o2 be object of C1;
  redefine func Morph-Map(F,o1,o2) -> Function of <^o1,o2^>, <^F.o2,F.o1^>;
end;

definition
  let C1,C2 be non empty AltGraph;
  let F be Contravariant FunctorStr over C1,C2;
  let o1,o2 be object of C1 such that
 <^o1,o2^> <> {} and
 <^F.o2,F.o1^> <> {};
  let m be Morphism of o1,o2;
  func F.m -> Morphism of F.o2, F.o1 equals


  Morph-Map(F,o1,o2).m;
end;

definition
  let C1,C2 be non empty AltGraph;
  let o be object of C2 such that
 <^o,o^> <> {};
  let m be Morphism of o,o;
  func C1 --> m -> strict FunctorStr over C1,C2 means


  the ObjectMap of it = [:the carrier of C1,the carrier of C1:] --> [o,o] &
  the MorphMap of it =
  { [[o1,o2],<^o1,o2^> --> m] where o1 is object of C1, o2 is object of C1:
  not contradiction };
end;

theorem 
  for C1,C2 being non empty AltGraph, o2 being object of C2 st <^o2,o2^> <> {}
  for m be Morphism of o2,o2, o1 being object of C1 holds (C1 --> m).o1 = o2;

registration
  let C1 be non empty AltGraph, C2 be non empty reflexive AltGraph;
  let o be object of C2, m be Morphism of o,o;
  cluster C1 --> m -> Covariant Contravariant feasible;
end;

registration
  let C1 be non empty AltGraph, C2 be non empty reflexive AltGraph;
  cluster feasible Covariant Contravariant for FunctorStr over C1,C2;
end;

theorem 
  for C1, C2 being non empty AltGraph,
  F being Covariant FunctorStr over C1,C2, o1,o2 being object of C1
  holds (the ObjectMap of F).(o1,o2) = [F.o1,F.o2];

definition
  let C1, C2 be non empty AltGraph;
  let F be Covariant FunctorStr over C1,C2;
  redefine attr F is feasible means


  for o1,o2 being object of C1 st <^o1,o2^> <> {} holds <^F.o1,F.o2^> <> {};
end;

theorem 
  for C1, C2 being non empty AltGraph,
  F being Contravariant FunctorStr over C1,C2, o1,o2 being object of C1
  holds (the ObjectMap of F).(o1,o2) = [F.o2,F.o1];

definition
  let C1, C2 be non empty AltGraph;
  let F be Contravariant FunctorStr over C1,C2;
  redefine attr F is feasible means


  for o1,o2 being object of C1 st <^o1,o2^> <> {} holds <^F.o2,F.o1^> <> {};
end;

registration
  let C1,C2 be AltGraph;
  let F be FunctorStr over C1,C2;
  cluster the MorphMap of F -> Function-yielding;
end;

registration
  cluster non empty reflexive for AltCatStr;
end;



definition
  let C1,C2 be with_units non empty AltCatStr;
  let F be FunctorStr over C1,C2;
  attr F is id-preserving means


  for o being object of C1 holds Morph-Map(F,o,o).idm o = idm F.o;
end;

theorem 
  for C1,C2 being non empty AltGraph, o2 being object of C2 st <^o2,o2^> <> {}
  for m be Morphism of o2,o2, o,o9 being object of C1, f being Morphism of o,o9
  st <^o,o9^> <> {} holds Morph-Map(C1 --> m,o,o9).f = m;

registration
  cluster with_units -> reflexive for non empty AltCatStr;
end;

registration
  let C1,C2 be with_units non empty AltCatStr;
  let o2 be object of C2;
  cluster C1 --> idm o2 -> id-preserving;
end;

registration
  let C1 be non empty AltGraph;
  let C2 be non empty reflexive AltGraph;
  let o2 be object of C2;
  let m be Morphism of o2,o2;
  cluster C1 --> m -> reflexive;
end;

registration
  let C1 be non empty AltGraph;
  let C2 be non empty reflexive AltGraph;
  cluster feasible reflexive for FunctorStr over C1,C2;
end;

registration
  let C1,C2 be with_units non empty AltCatStr;
  cluster id-preserving feasible reflexive strict for FunctorStr over C1,C2;
end;

definition
  let C1,C2 be non empty AltCatStr;
  let F be FunctorStr over C1,C2;
  attr F is comp-preserving means


  for o1,o2,o3 being object of C1 st <^o1,o2^> <> {} & <^o2,o3^> <> {}
  for f being Morphism of o1,o2, g being Morphism of o2,o3
  ex f9 being Morphism of F.o1,F.o2, g9 being Morphism of F.o2,F.o3 st
  f9 = Morph-Map(F,o1,o2).f & g9 = Morph-Map(F,o2,o3).g &
  Morph-Map(F,o1,o3).(g*f) = g9*f9;
end;

definition
  let C1,C2 be non empty AltCatStr;
  let F be FunctorStr over C1,C2;
  attr F is comp-reversing means


  for o1,o2,o3 being object of C1 st <^o1,o2^> <> {} & <^o2,o3^> <> {}
  for f being Morphism of o1,o2, g being Morphism of o2,o3
  ex f9 being Morphism of F.o2,F.o1, g9 being Morphism of F.o3,F.o2 st
  f9 = Morph-Map(F,o1,o2).f & g9 = Morph-Map(F,o2,o3).g &
  Morph-Map(F,o1,o3).(g*f) = f9*g9;
end;

definition
  let C1 be non empty transitive AltCatStr;
  let C2 be non empty reflexive AltCatStr;
  let F be Covariant feasible FunctorStr over C1,C2;
  redefine attr F is comp-preserving means

  for o1,o2,o3 being object of C1 st <^o1,o2^> <> {} & <^o2,o3^> <> {}
  for f being Morphism of o1,o2, g being Morphism of o2,o3
  holds F.(g*f) = (F.g)*(F.f);
end;

definition
  let C1 be non empty transitive AltCatStr;
  let C2 be non empty reflexive AltCatStr;
  let F be Contravariant feasible FunctorStr over C1,C2;
  redefine attr F is comp-reversing means

  for o1,o2,o3 being object of C1 st <^o1,o2^> <> {} & <^o2,o3^> <> {}
  for f being Morphism of o1,o2, g being Morphism of o2,o3
  holds F.(g*f) = (F.f)*(F.g);
end;

theorem 
  for C1 being non empty AltGraph, C2 being non empty reflexive AltGraph,
  o2 being object of C2, m be Morphism of o2,o2,
  F being Covariant feasible FunctorStr over C1,C2 st F = C1 --> m
  for o,o9 being object of C1, f being Morphism of o,o9 st <^o,o9^> <> {}
  holds F.f = m;

theorem 
  for C1 being non empty AltGraph, C2 being non empty reflexive AltGraph,
  o2 being object of C2, m be Morphism of o2,o2,
  o,o9 being object of C1, f being Morphism of o,o9 st <^o,o9^> <> {}
  holds (C1 --> m).f = m;

registration
  let C1 be non empty transitive AltCatStr,
  C2 be with_units non empty AltCatStr;
  let o be object of C2;
  cluster C1 --> idm o -> comp-preserving comp-reversing;
end;

definition
  let C1 be transitive with_units non empty AltCatStr,
  C2 be with_units non empty AltCatStr;
  mode Functor of C1,C2 -> FunctorStr over C1,C2 means


    it is feasible id-preserving &
    (it is Covariant comp-preserving or it is Contravariant comp-reversing);
end;

definition
  let C1 be transitive with_units non empty AltCatStr,
  C2 be with_units non empty AltCatStr, F be Functor of C1,C2;
  attr F is covariant means


  F is Covariant comp-preserving;
  attr F is contravariant means


  F is Contravariant comp-reversing;
end;

definition
  let A be AltCatStr, B be SubCatStr of A;
  func incl B -> strict FunctorStr over B,A means


  the ObjectMap of it = id [:the carrier of B, the carrier of B:] &
  the MorphMap of it = id the Arrows of B;
end;

definition
  let A be AltGraph;
  func id A -> strict FunctorStr over A,A means


  the ObjectMap of it = id [:the carrier of A, the carrier of A:] &
  the MorphMap of it = id the Arrows of A;
end;

registration
  let A be AltCatStr, B be SubCatStr of A;
  cluster incl B -> Covariant;
end;

theorem 
  for A being non empty AltCatStr, B being non empty SubCatStr of A,
  o being object of B holds (incl B).o = o;

theorem 
  for A being non empty AltCatStr, B being non empty SubCatStr of A,
  o1,o2 being object of B holds <^o1,o2^> c= <^(incl B).o1,(incl B).o2^>;

registration
  let A be non empty AltCatStr, B be non empty SubCatStr of A;
  cluster incl B -> feasible;
end;

definition
  let A,B be AltGraph, F be FunctorStr over A,B;
  attr F is faithful means


  the MorphMap of F is "1-1";
end;

definition
  let A,B be AltGraph, F be FunctorStr over A,B;
  attr F is full means


  ex B9 being ManySortedSet of [:the carrier of A, the carrier of A:],
  f being ManySortedFunction of (the Arrows of A),B9 st
  B9 = (the Arrows of B)*the ObjectMap of F & f = the MorphMap of F
  & f is "onto";
end;

definition
  let A be AltGraph, B be non empty AltGraph, F be FunctorStr over A,B;
  redefine attr F is full means


  ex f being ManySortedFunction of (the Arrows of A),
  (the Arrows of B)*the ObjectMap of F st f = the MorphMap of F & f is "onto";
end;

definition
  let A,B be AltGraph, F be FunctorStr over A,B;
  attr F is injective means


  F is one-to-one faithful;
  attr F is surjective means


  F is full onto;
end;

definition
  let A,B be AltGraph, F be FunctorStr over A,B;
  attr F is bijective means


  F is injective surjective;
end;

registration
  let A,B be transitive with_units non empty AltCatStr;
  cluster strict covariant contravariant feasible for Functor of A,B;
end;

theorem 
  for A being non empty AltGraph, o being object of A holds (id A).o = o;

theorem 
  for A being non empty AltGraph, o1,o2 being object of A st <^o1,o2^> <> {}
  for m being Morphism of o1,o2 holds Morph-Map(id A,o1,o2).m = m;

registration
  let A be non empty AltGraph;
  cluster id A -> feasible Covariant;
end;

registration
  let A be non empty AltGraph;
  cluster Covariant feasible for FunctorStr over A,A;
end;

theorem 
  for A being non empty AltGraph, o1,o2 being object of A st <^o1,o2^> <> {}
  for F being Covariant feasible FunctorStr over A,A st F = id A
  for m being Morphism of o1,o2 holds F.m = m;

registration
  let A be transitive with_units non empty AltCatStr;
  cluster id A -> id-preserving comp-preserving;
end;

definition
  let A be transitive with_units non empty AltCatStr;
  redefine func id A -> strict covariant Functor of A,A;
end;

registration
  let A be AltGraph;
  cluster id A -> bijective;
end;

begin 

definition
  let C1 be non empty AltGraph, C2,C3 be non empty reflexive AltGraph;
  let F be feasible FunctorStr over C1,C2, G be FunctorStr over C2,C3;
  func G*F -> strict FunctorStr over C1,C3 means


  the ObjectMap of it = (the ObjectMap of G)*the ObjectMap of F &
  the MorphMap of it =
  ((the MorphMap of G)*the ObjectMap of F)**the MorphMap of F;
end;

registration
  let C1 be non empty AltGraph, C2,C3 be non empty reflexive AltGraph;
  let F be Covariant feasible FunctorStr over C1,C2,
  G be Covariant FunctorStr over C2,C3;
  cluster G*F -> Covariant;
end;

registration
  let C1 be non empty AltGraph, C2,C3 be non empty reflexive AltGraph;
  let F be Contravariant feasible FunctorStr over C1,C2,
  G be Covariant FunctorStr over C2,C3;
  cluster G*F -> Contravariant;
end;

registration
  let C1 be non empty AltGraph, C2,C3 be non empty reflexive AltGraph;
  let F be Covariant feasible FunctorStr over C1,C2,
  G be Contravariant FunctorStr over C2,C3;
  cluster G*F -> Contravariant;
end;

registration
  let C1 be non empty AltGraph, C2,C3 be non empty reflexive AltGraph;
  let F be Contravariant feasible FunctorStr over C1,C2,
  G be Contravariant FunctorStr over C2,C3;
  cluster G*F -> Covariant;
end;

registration
  let C1 be non empty AltGraph, C2,C3 be non empty reflexive AltGraph;
  let F be feasible FunctorStr over C1,C2,
  G be feasible FunctorStr over C2,C3;
  cluster G*F -> feasible;
end;

theorem 
  for C1 being non empty AltGraph, C2,C3,C4 being non empty reflexive AltGraph,
  F being feasible FunctorStr over C1,C2,
  G being feasible FunctorStr over C2,C3, H being FunctorStr over C3,C4
  holds H*G*F = H*(G*F);

theorem 
  for C1 being non empty AltCatStr, C2,C3 being non empty reflexive AltCatStr,
  F be feasible reflexive FunctorStr over C1,C2, G be FunctorStr over C2,C3,
  o be object of C1 holds (G*F).o = G.(F.o);

theorem 
  for C1 being non empty AltGraph, C2,C3 being non empty reflexive AltGraph,
  F be feasible reflexive FunctorStr over C1,C2, G be FunctorStr over C2,C3,
  o be object of C1
  holds Morph-Map(G*F,o,o) = Morph-Map(G,F.o,F.o)*Morph-Map(F,o,o);

registration
  let C1,C2,C3 be with_units non empty AltCatStr;
  let F be id-preserving feasible reflexive FunctorStr over C1,C2;
  let G be id-preserving FunctorStr over C2,C3;
  cluster G*F -> id-preserving;
end;

definition
  let A,C be non empty reflexive AltCatStr;
  let B be non empty SubCatStr of A;
  let F be FunctorStr over A,C;
  func F|B -> FunctorStr over B,C equals

  F*incl B;
end;

begin 

definition
  let A,B be non empty AltGraph, F be FunctorStr over A,B;
  assume
 F is bijective;
  func F" -> strict FunctorStr over B,A means


  the ObjectMap of it = (the ObjectMap of F)" &
  ex f being ManySortedFunction of (the Arrows of A),
  (the Arrows of B)*the ObjectMap of F st
  f = the MorphMap of F & the MorphMap of it = f""*(the ObjectMap of F)";
end;

theorem 
  for A,B being transitive with_units non empty AltCatStr,
  F being feasible FunctorStr over A,B st F is bijective
  holds F" is bijective feasible;

theorem 
  for A,B being transitive with_units non empty AltCatStr,
  F being feasible reflexive FunctorStr over A,B st F is bijective coreflexive
  holds F" is reflexive;

theorem 
  for A,B being transitive with_units non empty AltCatStr,
  F being feasible reflexive id-preserving FunctorStr over A,B
  st F is bijective coreflexive holds F" is id-preserving;

theorem 
  for A,B being transitive with_units non empty AltCatStr,
  F being feasible FunctorStr over A,B st F is bijective Covariant
  holds F" is Covariant;

theorem 
  for A,B being transitive with_units non empty AltCatStr,
  F being feasible FunctorStr over A,B st F is bijective Contravariant
  holds F" is Contravariant;

theorem 
  for A,B being transitive with_units non empty AltCatStr,
  F being feasible reflexive FunctorStr over A,B
  st F is bijective coreflexive Covariant
  for o1,o2 being object of B, m being Morphism of o1,o2 st <^o1,o2^> <> {}
  holds Morph-Map(F,F".o1,F".o2).(Morph-Map(F",o1,o2).m) = m;

theorem 
  for A,B being transitive with_units non empty AltCatStr,
  F being feasible reflexive FunctorStr over A,B
  st F is bijective coreflexive Contravariant
  for o1,o2 being object of B, m being Morphism of o1,o2 st <^o1,o2^> <> {}
  holds Morph-Map(F,F".o2,F".o1).(Morph-Map(F",o1,o2).m) = m;

theorem 
  for A,B being transitive with_units non empty AltCatStr,
  F being feasible reflexive FunctorStr over A,B st
  F is bijective comp-preserving Covariant coreflexive
  holds F" is comp-preserving;

theorem 
  for A,B being transitive with_units non empty AltCatStr,
  F being feasible reflexive FunctorStr over A,B st
  F is bijective comp-reversing Contravariant coreflexive
  holds F" is comp-reversing;

registration
  let C1 be 1-sorted, C2 be non empty 1-sorted;
  cluster Covariant -> reflexive for BimapStr over C1,C2;
end;

registration
  let C1 be 1-sorted, C2 be non empty 1-sorted;
  cluster Contravariant -> reflexive for BimapStr over C1,C2;
end;

theorem 
  for C1,C2 being 1-sorted, M being BimapStr over C1,C2
  st M is Covariant onto holds M is coreflexive;

theorem 
  for C1,C2 being 1-sorted, M being BimapStr over C1,C2
  st M is Contravariant onto holds M is coreflexive;

registration
  let C1 be transitive with_units non empty AltCatStr,
  C2 be with_units non empty AltCatStr;
  cluster covariant -> reflexive for Functor of C1,C2;
end;

registration
  let C1 be transitive with_units non empty AltCatStr,
  C2 be with_units non empty AltCatStr;
  cluster contravariant -> reflexive for Functor of C1,C2;
end;

theorem 
  for C1 being transitive with_units non empty AltCatStr,
  C2 being with_units non empty AltCatStr,
  F being Functor of C1,C2 st F is covariant onto holds F is coreflexive;

theorem 
  for C1 being transitive with_units non empty AltCatStr,
  C2 being with_units non empty AltCatStr,
  F being Functor of C1,C2 st F is contravariant onto holds F is coreflexive;

theorem 
  for A,B being transitive with_units non empty AltCatStr,
  F being covariant Functor of A,B st F is bijective
  ex G being Functor of B,A st G = F" & G is bijective covariant;

theorem 
  for A,B being transitive with_units non empty AltCatStr,
  F being contravariant Functor of A,B st F is bijective
  ex G being Functor of B,A st G = F" & G is bijective contravariant;

definition
  let A,B be transitive with_units non empty AltCatStr;
  pred A,B are_isomorphic means

  ex F being Functor of A,B st F is bijective covariant;
  reflexivity;
  symmetry;
  pred A,B are_anti-isomorphic means

  ex F being Functor of A,B st F is bijective contravariant;
  symmetry;
end;














begin

reserve X,Y for set;
reserve Z for non empty set;

registration
  cluster transitive with_units reflexive for non empty AltCatStr;
end;

registration
  let A be non empty reflexive AltCatStr;
  cluster non empty reflexive for SubCatStr of A;
end;

registration
  let C1,C2 be non empty reflexive AltCatStr;
  let F be feasible FunctorStr over C1,C2, A be non empty reflexive SubCatStr
  of C1;
  cluster F|A -> feasible;
end;

begin

registration
  let X be set;
  cluster id X -> onto;
end;

theorem 
  for A being non empty set, B,C being non empty Subset of A, D being
  non empty Subset of B st C=D holds incl C = incl B * incl D;

theorem 
  for f being Function of X,Y st f is bijective holds f" is Function of Y,X;

theorem 
  for f being Function of X,Y, g being Function of Y,Z st f is bijective
  & g is bijective holds ex h being Function of X,Z st h=g*f & h is bijective;

begin

theorem 
  for A being non empty reflexive AltCatStr, B being non empty
  reflexive SubCatStr of A, C being non empty SubCatStr of A, D being non empty
  SubCatStr of B st C = D holds incl C = incl B * incl D;

theorem 
  for A,B being non empty AltCatStr, F being FunctorStr over A,B st
  F is bijective holds the ObjectMap of F is bijective & the MorphMap of F is
  "1-1";





theorem 
  for C1 being non empty AltGraph, C2,C3 being non empty reflexive
AltGraph, F being feasible FunctorStr over C1,C2, G being FunctorStr over C2,C3
  st F is one-to-one & G is one-to-one holds G*F is one-to-one;

theorem 
  for C1 being non empty AltGraph, C2,C3 being non empty reflexive
AltGraph, F being feasible FunctorStr over C1,C2, G being FunctorStr over C2,C3
  st F is faithful & G is faithful holds G*F is faithful;

theorem 
  for C1 being non empty AltGraph, C2,C3 being non empty reflexive
AltGraph, F being feasible FunctorStr over C1,C2, G being FunctorStr over C2,C3
  st F is onto & G is onto holds G*F is onto;

theorem 
  for C1 being non empty AltGraph, C2,C3 being non empty reflexive
AltGraph, F being feasible FunctorStr over C1,C2, G being FunctorStr over C2,C3
  st F is full & G is full holds G*F is full;

theorem 
  for C1 being non empty AltGraph, C2,C3 being non empty reflexive
AltGraph, F being feasible FunctorStr over C1,C2, G being FunctorStr over C2,C3
  st F is injective & G is injective holds G*F is injective;

theorem 
  for C1 being non empty AltGraph, C2,C3 being non empty reflexive
AltGraph, F being feasible FunctorStr over C1,C2, G being FunctorStr over C2,C3
  st F is surjective & G is surjective holds G*F is surjective;

theorem 
  for C1 being non empty AltGraph, C2,C3 being non empty reflexive
AltGraph, F being feasible FunctorStr over C1,C2, G being FunctorStr over C2,C3
  st F is bijective & G is bijective holds G*F is bijective;

begin 

theorem 
  for A,I being non empty reflexive AltCatStr, B being non empty
  reflexive SubCatStr of A, C being non empty SubCatStr of A, D being non empty
  SubCatStr of B st C = D for F being FunctorStr over A,I holds F|C = F|B|D;

theorem 
  for A being non empty AltCatStr, B being non empty SubCatStr of A
  holds B is full iff incl B is full;

begin 

theorem 
  for C1, C2 being non empty AltCatStr, F being Covariant FunctorStr
over C1,C2 holds F is full iff for o1,o2 being object of C1 holds Morph-Map(F,
  o1,o2) is onto;

theorem 
  for C1, C2 being non empty AltCatStr, F being Covariant FunctorStr
over C1,C2 holds F is faithful iff for o1,o2 being object of C1 holds Morph-Map
  (F,o1,o2) is one-to-one;

begin 

theorem 
  for A being transitive with_units non empty AltCatStr holds (id A)" = id A;



theorem 
  for A, B being transitive with_units reflexive non empty AltCatStr
for F being feasible FunctorStr over A,B st F is bijective for G being feasible
  FunctorStr over B,A st the FunctorStr of G=F" holds F * G = id B;



theorem 
  for A, B being transitive with_units reflexive non empty AltCatStr
for F being feasible FunctorStr over A,B st F is bijective holds (F") * F = id
  A;



theorem 
  for A, B being transitive with_units reflexive non empty AltCatStr
  for F being feasible FunctorStr over A,B st F is bijective holds (F")" = the
  FunctorStr of F;

theorem 
  for A, B, C being transitive with_units reflexive non empty AltCatStr
, G being feasible FunctorStr over A,B, F being feasible FunctorStr over B,C,
GI being feasible FunctorStr over B,A, FI being feasible FunctorStr over C,B st
  F is bijective & G is bijective & the FunctorStr of GI=G" & the FunctorStr of
  FI=F" holds (F*G)" = (GI*FI);














begin  








reserve I for non empty set,
  J for ManySortedSet of I,
  S for non void non empty ManySortedSign,
  i for Element of I,
  c for set,
  A for MSAlgebra-Family of I,S,
  EqR for Equivalence_Relation of I,
  U0,U1,U2 for MSAlgebra over S,
  s for SortSymbol of S,
  o for OperSymbol of S,
  f for Function;

registration
  let I be set, S;
  let AF be MSAlgebra-Family of I,S;
  cluster product AF -> non-empty;
end;

registration
  let X be with_non-empty_elements set;
  cluster id X -> non-empty;
end;

theorem 
  for f,F being Function, A being set st f in product F holds f|A
  in product(F|A);

theorem 
  for A be MSAlgebra-Family of I,S, s be SortSymbol of S, a be non
empty Subset of I, Aa be MSAlgebra-Family of a,S st A|a = Aa holds Carrier(Aa,s
  ) = (Carrier(A,s))|a;

theorem 
  for i be set, I be non empty set, EqR be Equivalence_Relation of
  I, c1,c2 be Element of Class EqR st i in c1 & i in c2 holds c1 = c2;

theorem 
  for D being non empty set for F being ManySortedFunction of D for C
  being with_common_domain functional non empty set st C = rng F for d being
  Element of D,e being set st e in DOM C holds F.d.e = (commute F).e.d;

begin  

definition
  let S,U0;
  let o be OperSymbol of S;
  func const(o,U0) equals

  Den(o,U0).{};
end;

theorem 
  the_arity_of o = {} & Result(o,U0) <> {} implies const(o,U0) in Result(o,U0);

theorem 
  (the Sorts of U0).s <> {} implies Constants(U0,s) = { const(o,U0)
  where o is Element of the carrier' of S : the_result_sort_of o = s &
  the_arity_of o = {} };

theorem 
  the_arity_of o = {} implies (commute (OPER A)).o in Funcs(I,Funcs
  ({{}}, union { Result(o,A.i9) where i9 is Element of I: not contradiction }))
;

theorem 
  the_arity_of o = {} implies const(o,product A) in Funcs(I, union
  { Result(o,A.i9) where i9 is Element of I: not contradiction });

registration
  let S,I,o,A;
  cluster const (o,product A) -> Relation-like Function-like;
end;

theorem 
  for o be OperSymbol of S st the_arity_of o = {} holds (const (o,
  product A)).i = const (o,A.i);

theorem 
  the_arity_of o = {} & dom f = I & (for i be Element of I holds f.i =
  const(o,A.i)) implies f = const(o,product A);

theorem 
  for e be Element of Args(o,U1) st e = {} & the_arity_of o = {} &
Args(o,U1) <> {} & Args(o,U2) <> {} for F be ManySortedFunction of U1,U2 holds
  F#e = {};

begin 

theorem 
  for U1,U2 be non-empty MSAlgebra over S for F be
  ManySortedFunction of U1,U2 for x be Element of Args(o,U1) holds x in product
  doms (F*the_arity_of o);

theorem 
  for U1,U2 be non-empty MSAlgebra over S for F be
ManySortedFunction of U1,U2 for x be Element of Args(o,U1) for n be set st n in
  dom (the_arity_of o) holds (F#x).n = F.((the_arity_of o)/.n).(x.n);

theorem 
  for x be Element of Args(o,product A) holds x in Funcs (dom (
the_arity_of o),Funcs (I,union { (the Sorts of A.i9).s9 where i9 is Element of
  I,s9 is Element of (the carrier of S) : not contradiction }));

theorem 
  for x be Element of Args(o,product A) for n be set st n in dom (
  the_arity_of o) holds x.n in product Carrier(A,(the_arity_of o)/.n);

theorem 
  for i be Element of I for n be set st n in dom(the_arity_of o)
for s be SortSymbol of S st s = (the_arity_of o).n for y be Element of Args(o,
  product A) for g be Function st g = y.n holds g.i in (the Sorts of A.i).s;

theorem 
  for y be Element of Args(o,product A) st (the_arity_of o) <> {}
  holds (commute y) in product doms (A?.o);

theorem 
  for y be Element of Args(o,product A) st the_arity_of o <> {}
  holds y in dom (Commute Frege(A?.o));

theorem 
  for I be set, S be non void non empty ManySortedSign, A be
  MSAlgebra-Family of I,S, o be OperSymbol of S for x be Element of Args(o,
product A) holds Den(o,product A).x in product Carrier(A,the_result_sort_of o);

theorem 
  for I,S,A,i for o be OperSymbol of S st (the_arity_of o) <> {}
  for U1 be non-empty MSAlgebra over S for x be Element of Args(o,product A)
  holds (commute x).i is Element of Args(o,A.i);

theorem 
  for I,S,A,i,o for x be Element of Args(o,product A) for n be set
st n in dom(the_arity_of o) for f be Function st f = x.n holds ((commute x).i).
  n = f.i;

theorem 
  for o be OperSymbol of S st (the_arity_of o) <> {} for y be
Element of Args(o,product A), i9 be Element of I for g be Function st g = Den(o
  ,product A).y holds g.i9 = Den(o,A.i9).((commute y).i9);

begin 

definition
  let I,S;

  let A be MSAlgebra-Family of I,S, i be Element of I;
  func proj(A,i) -> ManySortedFunction of product A,A.i means


  for s be Element of S holds it.s = proj (Carrier(A,s), i);
end;

theorem 
  for x be Element of Args(o,product A) st the_arity_of o <> {}
  for i be Element of I holds proj(A,i)#x = (commute x).i;

theorem 
  for i be Element of I for A be MSAlgebra-Family of I,S holds proj(A,i)
  is_homomorphism product A,A.i;

theorem 
  for U1 be non-empty MSAlgebra over S for F being
  ManySortedFunction of I st (for i be Element of I holds ex F1 being
  ManySortedFunction of U1,A.i st F1 = F.i & F1 is_homomorphism U1,A.i) holds F
  in Funcs(I,Funcs(the carrier of S, {F.i9.s1 where s1 is SortSymbol of S,i9 is
  Element of I :not contradiction})) & (commute F).s.i = F.i.s;

theorem 
  for U1 be non-empty MSAlgebra over S for F being
  ManySortedFunction of I st (for i be Element of I holds ex F1 being
  ManySortedFunction of U1,A.i st F1 = F.i & F1 is_homomorphism U1,A.i) holds (
commute F).s in Funcs(I,Funcs((the Sorts of U1).s, union {(the Sorts of A.i9).
  s1 where i9 is Element of I,s1 is SortSymbol of S : not contradiction}));

theorem 
  for U1 be non-empty MSAlgebra over S for F being
  ManySortedFunction of I st (for i be Element of I holds ex F1 being
ManySortedFunction of U1,A.i st F1 = F.i & F1 is_homomorphism U1,A.i) for F9 be
ManySortedFunction of U1,A.i st F9 = F.i for x be set st x in (the Sorts of U1)
  .s for f be Function st f = (commute((commute F).s)).x holds f.i = F9.s.x;

theorem 
  for U1 be non-empty MSAlgebra over S for F being
  ManySortedFunction of I st (for i be Element of I holds ex F1 being
ManySortedFunction of U1,A.i st F1 = F.i & F1 is_homomorphism U1,A.i) for x be
set st x in (the Sorts of U1).s holds (commute ((commute F).s)).x in product (
  Carrier(A,s));

theorem 
  for U1 be non-empty MSAlgebra over S for F being ManySortedFunction of
  I st (for i be Element of I holds ex F1 being ManySortedFunction of U1,A.i st
F1 = F.i & F1 is_homomorphism U1,A.i) holds ex H being ManySortedFunction of U1
,(product A) st H is_homomorphism U1,(product A) & for i be Element of I holds
  proj(A,i) ** H = F.i;

begin 

definition
  let I,J,S;
  mode MSAlgebra-Class of S,J -> ManySortedSet of I means


    for i be set st i in I holds it.i is MSAlgebra-Family of J.i,S;
end;

definition
  let I,S,A,EqR;
  func A / EqR -> MSAlgebra-Class of S,id (Class EqR) means


  for c st c in Class EqR holds it.c = A|c;
end;

definition
  let I,S;
  let J be non-empty ManySortedSet of I;
  let C be MSAlgebra-Class of S,J;
  func product C -> MSAlgebra-Family of I,S means


  for i st i in I ex Ji
be non empty set, Cs be MSAlgebra-Family of Ji,S st Ji = J.i & Cs = C.i & it.i
  = product Cs;
end;

theorem 
  for A be MSAlgebra-Family of I,S, EqR be Equivalence_Relation of I
  holds product A, product (product (A/EqR)) are_isomorphic;














begin

reserve i,j,k,k1,k2,n,m,i1,i2,j1,j2 for Element of NAT,
  x for set;

definition
  let i1,i2;
  pred i1,i2 are_adjacent1 means


  i2=i1+1 or i1=i2+1;
  symmetry;
  irreflexivity;
end;

theorem 
  for i1,i2 st i1,i2 are_adjacent1 holds i1+1,i2+1 are_adjacent1;

theorem 
  for i1,i2 st i1,i2 are_adjacent1 & 1<=i1 & 1<=i2 holds i1-'1,i2-'
  1 are_adjacent1;

definition
  let i1,j1,i2,j2;
  pred i1,j1,i2,j2 are_adjacent2 means


  i1,i2 are_adjacent1 & j1=j2 or i1=i2 & j1,j2 are_adjacent1;
end;

theorem 
  for i1,i2,j1,j2 st i1,j1,i2,j2 are_adjacent2 holds
  i1+1,j1+1,i2+1,j2+1 are_adjacent2;

theorem 
  for i1,i2,j1,j2 st i1,j1,i2,j2 are_adjacent2 & 1<=i1 & 1<=i2 & 1<=j1 &
  1<=j2 holds i1-'1,j1-'1,i2-'1,j2-'1 are_adjacent2;

theorem 
  for n,i,j st i<=n & j<=n holds ex fs1 being FinSequence of NAT st
  fs1.1=i & fs1.(len fs1)=j & len fs1=(i-'j)+(j-'i)+1 & (for k,k1 st 1<=k & k<=
len fs1 & k1=fs1.k holds k1<=n) & for i1 st 1<=i1 & i1<len fs1 holds fs1.(i1+1)
  = (fs1/.i1)+1 or fs1.i1= (fs1/.(i1+1)) +1;

theorem 
  for n,i,j st i<=n & j<=n holds ex fs1 being FinSequence of NAT st
  fs1.1=i & fs1.(len fs1)=j & len fs1=(i-'j)+(j-'i)+1 & (for k,k1 st 1<=k & k<=
  len fs1 & k1=fs1.k holds k1<=n) & for i1 st 1<=i1 & i1<len fs1 holds fs1/.i1,
  fs1/.(i1+1) are_adjacent1;

theorem 
  for n,m,i1,j1,i2,j2 st i1<=n & j1<=m & i2<=n & j2<=m ex fs1,fs2
being FinSequence of NAT st (for i,k1,k2 st i in dom fs1 & k1=fs1.i & k2=fs2.i
  holds k1 <= n & k2 <= m) & fs1.1=i1 & fs1.(len fs1)=i2 & fs2.1=j1 & fs2.(len
fs2)=j2 & len fs1=len fs2 & len fs1=(i1-'i2)+(i2-'i1)+(j1-'j2)+(j2-'j1)+1 & for
  i st 1<=i & i<len fs1 holds fs1/.i,fs2/.i,fs1/.(i+1),fs2/.(i+1) are_adjacent2
;

reserve S for set;

theorem 
  for Y being Subset of S,F being Matrix of n,m, bool S st (ex i,j st i
in Seg n & j in Seg m & F*(i,j) c= Y) & (for i1,j1,i2,j2 st i1 in Seg n & i2 in
Seg n & j1 in Seg m & j2 in Seg m & i1,j1,i2,j2 are_adjacent2 holds F*(i1,j1)c=
  Y iff F*(i2,j2)c=Y) holds for i,j st i in Seg n & j in Seg m holds F*(i,j)c=Y
;














begin 

reserve P for non empty Poset,
  i, j, k for Element of P;
reserve S for non void non empty ManySortedSign;

registration
  let I be non empty set, S;
  let AF be MSAlgebra-Family of I,S;
  let i be Element of I;
  let o be OperSymbol of S;
  cluster ((OPER AF).i).o -> Function-like Relation-like;
end;

registration
  let I be non empty set, S;
  let AF be MSAlgebra-Family of I,S;
  let s be SortSymbol of S;
  cluster (SORTS AF).s -> functional;
end;

definition
  let P, S;
  mode OrderedAlgFam of P,S -> MSAlgebra-Family of the carrier of P,S means


     ex
 F be ManySortedFunction of the InternalRel of P st for i,j,k st i >= j
& j >= k ex f1 be ManySortedFunction of it.i, it.j, f2 be ManySortedFunction of
    it.j, it.k st f1 = F.(j,i) & f2 = F.(k,j) & F.(k,i) = f2 ** f1 & f1
    is_homomorphism it.i, it.j;
end;

reserve OAF for OrderedAlgFam of P, S;

definition
  let P, S, OAF;
  mode Binding of OAF -> ManySortedFunction of the InternalRel of P means


     for
 i,j,k st i >= j & j >= k ex f1 be ManySortedFunction of OAF.i, OAF.j,
f2 be ManySortedFunction of OAF.j, OAF.k st f1 = it.(j,i) & f2 = it.(k,j) & it.
    (k,i) = f2 ** f1 & f1 is_homomorphism OAF.i, OAF.j;
end;

definition
  let P, S, OAF;
  let B be Binding of OAF, i,j;
  assume
 i >= j;
  func bind (B,i,j) -> ManySortedFunction of OAF.i, OAF.j equals


  B.(j,i
  );
end;

reserve B for Binding of OAF;

theorem 
  i >= j & j >= k implies bind (B,j,k) ** bind (B,i,j) = bind (B,i, k);

definition
  let P, S, OAF;
  let IT be Binding of OAF;
  attr IT is normalized means


  for i holds IT.(i,i) = id (the Sorts of OAF.i);
end;

theorem 
  for P,S,OAF,B,i,j st i >= j for f be ManySortedFunction of OAF.i,
  OAF.j st f = bind (B,i,j) holds f is_homomorphism OAF.i,OAF.j;

definition
  let P, S, OAF, B;
  func Normalized B -> Binding of OAF means


  for i, j st i >= j holds it
.(j,i) = IFEQ (j, i, id (the Sorts of OAF.i), bind (B,i,j) ** id (the Sorts of
  OAF.i) );
end;

theorem 
  for i, j st i >= j & i <> j holds B.(j,i) = (Normalized B).(j,i);

registration
  let P, S, OAF, B;
  cluster Normalized B -> normalized;
end;

registration
  let P, S, OAF;
  cluster normalized for Binding of OAF;
end;

theorem 
  for NB be normalized Binding of OAF for i, j st i >= j holds (
  Normalized NB).(j,i) = NB.(j,i);

definition
  let P, S, OAF;
  let B be Binding of OAF;
  func InvLim B -> strict MSSubAlgebra of product OAF means


  for s be
SortSymbol of S for f be Element of (SORTS OAF).s holds f in (the Sorts of it).
  s iff for i,j st i >= j holds (bind (B,i,j).s).(f.i) = f.j;
end;

theorem 
  for DP be discrete non empty Poset, S for OAF be OrderedAlgFam of DP,S
  for B be normalized Binding of OAF holds InvLim B = product OAF;

begin  

reserve x for set,
  A for non empty set;

definition
  let X be set;
  attr X is MSS-membered means


  x in X implies x is strict non empty non void ManySortedSign;
end;

registration
  cluster non empty MSS-membered for set;
end;

definition
  func TrivialMSSign -> strict ManySortedSign means


  it is empty void;
end;

registration
  cluster TrivialMSSign -> empty void;
end;

registration
  cluster strict empty void for ManySortedSign;
end;

theorem 
  for S be void ManySortedSign holds id the carrier of S, id the
  carrier' of S form_morphism_between S,S;

definition
  let A;
  func MSS_set A means


  x in it iff ex S be strict non empty non void
  ManySortedSign st x = S & the carrier of S c= A & the carrier' of S c= A;
end;

registration
  let A;
  cluster MSS_set A -> non empty MSS-membered;
end;

definition
  let A be non empty MSS-membered set;
  redefine mode Element of A -> strict non empty non void ManySortedSign;
end;

definition
  let S1,S2 be ManySortedSign;
  func MSS_morph (S1,S2) means

  x in it iff ex f,g be Function st x = [f,g] & f
  ,g form_morphism_between S1,S2;
end;














begin 

reserve a, I for set,
  S for non empty non void ManySortedSign;

registration
  let I be set, M be ManySortedSet of I;
  cluster finite-yielding for Element of Bool M;
end;

registration
  let I be set, M be non-empty ManySortedSet of I;
  cluster non-empty finite-yielding for ManySortedSubset of M;
end;

registration
  let S be non empty non void ManySortedSign, A be non-empty MSAlgebra over S,
  o be OperSymbol of S;
  cluster -> FinSequence-like for Element of Args(o,A);
end;

registration
  let S be non void non empty ManySortedSign, I be set, s be SortSymbol of S,
  F be MSAlgebra-Family of I, S;
  cluster -> Function-like Relation-like for Element of (SORTS F).s;
end;

registration
  let S be non void non empty ManySortedSign, X be non-empty ManySortedSet of
  the carrier of S;
  cluster FreeGen X -> free non-empty;
end;

registration
  let S be non void non empty ManySortedSign, X be non-empty ManySortedSet of
  the carrier of S;
  cluster FreeMSA X -> free;
end;

registration
  let S be non empty non void ManySortedSign, A, B be non-empty MSAlgebra over
  S;
  cluster [:A,B:] -> non-empty;
end;

theorem 
  for X, Y being set, f being Function st a in dom f & f.a in [:X,Y:]
  holds f.a = [(pr1 f).a, (pr2 f).a];

theorem 
  for X being non empty set, Y being set, f being Function of X, {Y
  } holds rng f = {Y};

theorem 
  Class(nabla I) c= {I};

theorem 
  for I being non empty set holds Class(nabla I) = {I};

theorem 
  ex A being ManySortedSet of I st {A} = I --> {a};

theorem 
  for A being ManySortedSet of I ex B being non-empty ManySortedSet of I
  st A c= B;

theorem 
  for M being non-empty ManySortedSet of I for B being finite-yielding
ManySortedSubset of M ex C being non-empty finite-yielding ManySortedSubset of
  M st B c= C;

theorem 
  for A, B being ManySortedSet of I for F, G being ManySortedFunction of
  A, {B} holds F = G;

theorem 
  for A being non-empty ManySortedSet of I, B being ManySortedSet
  of I for F being ManySortedFunction of A, {B} holds F is "onto";

theorem 
  for A being ManySortedSet of I, B being non-empty ManySortedSet
  of I for F being ManySortedFunction of {A}, B holds F is "1-1";

theorem 
  for X being non-empty ManySortedSet of the carrier of S holds Reverse
  X is "1-1";

theorem 
  for A being non-empty finite-yielding ManySortedSet of I ex F being
  ManySortedFunction of I --> NAT, A st F is "onto";

theorem 
  for S being non empty ManySortedSign for A being non-empty MSAlgebra
  over S for f, g being Element of product the Sorts of A st for i being set
  holds proj(the Sorts of A,i).f = proj(the Sorts of A,i).g holds f = g;

theorem 
  for I being non empty set for s being Element of S for A being
MSAlgebra-Family of I,S for f, g being Element of product Carrier(A,s) st for a
being Element of I holds proj(Carrier(A,s),a).f = proj(Carrier(A,s),a).g holds
  f = g;

theorem 
  for A, B being non-empty MSAlgebra over S for C being non-empty
MSSubAlgebra of A for h1 being ManySortedFunction of B, C st h1 is_homomorphism
  B, C for h2 being ManySortedFunction of B, A st h1 = h2 holds h2
  is_homomorphism B, A;

theorem 
  for A, B being non-empty MSAlgebra over S for F being
  ManySortedFunction of A, B st F is_monomorphism A, B holds A, Image F
  are_isomorphic;

theorem 
  for A, B being non-empty MSAlgebra over S for F being
  ManySortedFunction of A, B st F is "onto" for o being OperSymbol of S for x
  being Element of Args(o,B) holds ex y being Element of Args(o,A) st F # y = x
;

theorem 
  for A being non-empty MSAlgebra over S, o being OperSymbol of S
  for x being Element of Args(o,A) holds Den(o,A).x in (the Sorts of A).(
  the_result_sort_of o);

theorem 
  for A, B, C being non-empty MSAlgebra over S for F1 being
  ManySortedFunction of A, B for F2 being ManySortedFunction of A, C st F1
is_epimorphism A, B & F2 is_homomorphism A, C for G being ManySortedFunction of
  B, C st G ** F1 = F2 holds G is_homomorphism B, C;

reserve A, M for ManySortedSet of I,
  B, C for non-empty ManySortedSet of I;

definition
  let I be set;
  let A be ManySortedSet of I;
  let B, C be non-empty ManySortedSet of I;
  let F be ManySortedFunction of A, [|B,C|];
  func Mpr1 F -> ManySortedFunction of A, B means


  for i being set st i in I holds it.i = pr1 (F.i);
  func Mpr2 F -> ManySortedFunction of A, C means


  for i being set st i in I holds it.i = pr2 (F.i);
end;

theorem 
  for F being ManySortedFunction of A, [| I-->{a} , I-->{a} |] holds
  Mpr1 F = Mpr2 F;

theorem 
  for F being ManySortedFunction of A, [|B,C|] st F is "onto" holds Mpr1
  F is "onto";

theorem 
  for F being ManySortedFunction of A, [|B,C|] st F is "onto" holds Mpr2
  F is "onto";

theorem 
  for F being ManySortedFunction of A, [|B,C|] st M in doms F holds for
  i be set st i in I holds (F..M).i = [((Mpr1 F)..M).i, ((Mpr2 F)..M).i];

begin 

registration
  let S be non empty ManySortedSign;
  cluster the Sorts of Trivial_Algebra S -> finite-yielding non-empty;
end;

registration
  let S be non empty ManySortedSign;
  cluster Trivial_Algebra S -> finite-yielding non-empty;
end;

theorem 
  for A being non-empty MSAlgebra over S for F being
  ManySortedFunction of A, Trivial_Algebra S for o being OperSymbol of S for x
  being Element of Args(o,A) holds (F.the_result_sort_of o).(Den(o,A).x) = 0 &
  Den(o,Trivial_Algebra S).(F#x) = 0;

theorem 
  for A being non-empty MSAlgebra over S for F being
  ManySortedFunction of A, Trivial_Algebra S holds F is_epimorphism A,
  Trivial_Algebra S;

theorem 
  for A being MSAlgebra over S st ex X being ManySortedSet of the
carrier of S st the Sorts of A = {X} holds A, Trivial_Algebra S are_isomorphic;

begin 

theorem 
  for A being non-empty MSAlgebra over S for C being MSCongruence of A
  holds C is ManySortedSubset of [|the Sorts of A, the Sorts of A|];

theorem 
  for A being non-empty MSAlgebra over S for R being Subset of CongrLatt
A for F being SubsetFamily of [|the Sorts of A, the Sorts of A|] st R = F holds
  meet |:F:| is MSCongruence of A;

theorem 
  for A being non-empty MSAlgebra over S for C being MSCongruence of A
st C = [|the Sorts of A, the Sorts of A|] holds the Sorts of QuotMSAlg (A,C) =
  {the Sorts of A};

theorem 
  for A, B being non-empty MSAlgebra over S for F being
  ManySortedFunction of A, B st F is_homomorphism A, B holds MSHomQuot F **
  MSNat_Hom(A,MSCng F) = F;

theorem 
  for A being non-empty MSAlgebra over S for C being MSCongruence
of A for s being SortSymbol of S for a being Element of (the Sorts of QuotMSAlg
  (A,C)).s ex x being Element of (the Sorts of A).s st a = Class(C,x);

theorem 
  for A being MSAlgebra over S for C1, C2 being MSEquivalence-like
  ManySortedRelation of A st C1 c= C2 for i being Element of S for x, y being
Element of (the Sorts of A).i st [x,y] in C1.i holds Class (C1,x) c= Class (C2,
  y) & (A is non-empty implies Class (C1,y) c= Class (C2,x));

theorem 
  for A being non-empty MSAlgebra over S, C being MSCongruence of A for
  s being SortSymbol of S, x, y being Element of (the Sorts of A).s holds (
  MSNat_Hom(A,C)).s.x = (MSNat_Hom(A,C)).s.y iff [x,y] in C.s;

theorem 
  for A being non-empty MSAlgebra over S for C1, C2 being
MSCongruence of A for G being ManySortedFunction of QuotMSAlg (A,C1), QuotMSAlg
  (A,C2) st for i being Element of S for x being Element of (the Sorts of
QuotMSAlg (A,C1)).i for xx being Element of (the Sorts of A).i st x = Class(C1,
  xx) holds G.i.x = Class(C2,xx) holds G ** MSNat_Hom(A,C1) = MSNat_Hom(A,C2);

theorem 
  for A being non-empty MSAlgebra over S for C1, C2 being
MSCongruence of A for G being ManySortedFunction of QuotMSAlg (A,C1), QuotMSAlg
  (A,C2) st for i being Element of S for x being Element of (the Sorts of
QuotMSAlg (A,C1)).i for xx being Element of (the Sorts of A).i st x = Class(C1,
  xx) holds G.i.x = Class(C2,xx) holds G is_epimorphism QuotMSAlg (A,C1),
  QuotMSAlg (A,C2);

theorem 
  for A, B being non-empty MSAlgebra over S for F being
ManySortedFunction of A, B st F is_homomorphism A, B for C1 being MSCongruence
of A st C1 c= MSCng F ex H being ManySortedFunction of QuotMSAlg (A,C1), B st H
  is_homomorphism QuotMSAlg (A,C1), B & F = H ** MSNat_Hom(A,C1);














begin  

reserve A for non empty set,
  S for non void non empty ManySortedSign;
reserve x for set;

definition
  let A;
  func MSSCat A -> strict non empty AltCatStr means


  the carrier of it =
MSS_set A & ( for i, j be Element of MSS_set A holds (the Arrows of it).(i,j) =
MSS_morph (i,j) ) & for i,j,k be object of it st i in MSS_set A & j in MSS_set
A & k in MSS_set A for f1,f2,g1,g2 be Function st [f1,f2] in (the Arrows of it)
.(i,j) & [g1,g2] in (the Arrows of it).(j,k) holds (the Comp of it).(i,j,k).([
  g1,g2],[f1,f2]) = [g1*f1,g2*f2];
end;

registration
  let A;
  cluster MSSCat A -> transitive associative with_units;
end;

theorem 
  for C be category st C = MSSCat A for o be object of C holds o is non
  empty non void ManySortedSign;

registration
  let S;
  cluster strict feasible for MSAlgebra over S;
end;

definition
  let S, A;
  func MSAlg_set (S,A) means


  x in it iff ex M be strict feasible MSAlgebra over S st x = M &
  for C be Component of the Sorts of M holds C c= A;
end;

registration
  let S, A;
  cluster MSAlg_set (S,A) -> non empty;
end;

begin 

reserve o for OperSymbol of S;

theorem 
  for x be MSAlgebra over S st x in MSAlg_set (S,A) holds the Sorts
  of x in Funcs (the carrier of S, bool A) & the Charact of x in Funcs (the
  carrier' of S,PFuncs(PFuncs (NAT ,A),A));

theorem 
  for U1,U2 be MSAlgebra over S st the Sorts of U1
is_transformable_to the Sorts of U2 & Args (o,U1) <> {} holds Args (o,U2) <> {}
;

theorem 
  for U1,U2,U3 be feasible MSAlgebra over S, F be
ManySortedFunction of U1,U2, G be ManySortedFunction of U2,U3, x be Element of
Args(o,U1) st Args (o,U1) <> {} & the Sorts of U1 is_transformable_to the Sorts
  of U2 & the Sorts of U2 is_transformable_to the Sorts of U3 ex GF be
  ManySortedFunction of U1,U3 st GF = G ** F & GF#x = G#(F#x);

theorem 
  for U1,U2,U3 be feasible MSAlgebra over S, F be
  ManySortedFunction of U1,U2, G be ManySortedFunction of U2,U3 st the Sorts of
  U1 is_transformable_to the Sorts of U2 & the Sorts of U2 is_transformable_to
  the Sorts of U3 & F is_homomorphism U1,U2 & G is_homomorphism U2,U3 ex GF be
  ManySortedFunction of U1,U3 st GF = G ** F & GF is_homomorphism U1,U3;

definition
  let S, A;
  let i,j be set;
  assume that
 i in MSAlg_set (S,A) and
 j in MSAlg_set (S,A);
  func MSAlg_morph (S,A,i,j) means

 x in it iff
    ex M,N be strict feasible MSAlgebra over S,
       f be ManySortedFunction of M,N st M = i & N = j &
       f = x & the Sorts of M is_transformable_to the Sorts of N &
       f is_homomorphism M,N;
end;

definition
  let S, A;
  func MSAlgCat (S,A) -> strict non empty AltCatStr means


  the carrier
  of it = MSAlg_set (S,A) & ( for i, j be Element of MSAlg_set (S,A) holds (the
Arrows of it).(i,j) = MSAlg_morph (S,A,i,j) ) & for i,j,k be object of it, f,g
  be Function-yielding Function st f in (the Arrows of it).(i,j) & g in (the
  Arrows of it).(j,k) holds (the Comp of it).(i,j,k).(g,f) = ( g ** f );
end;

registration
  let S, A;
  cluster MSAlgCat (S,A) -> transitive associative with_units;
end;

theorem 
  for C be category st C = MSAlgCat (S,A) for o be object of C holds o
  is strict feasible MSAlgebra over S;














begin

reserve i,j,k for Element of NAT,
  r,s,r1,r2,s1,s2,sb,tb for Real,
  x for set,
  GX for non empty TopSpace;

theorem 
  for A being Subset of GX, p being Point of GX st p in A & A is
  connected holds A c= Component_of p;

theorem 
  for A,B,C being Subset of GX st C is a_component & A c= C & B is
  connected & Cl A meets Cl B holds B c= C;

reserve GZ for non empty TopSpace;

theorem 
  for A,B being Subset of GZ st A is a_component & B
  is a_component holds A \/ B is a_union_of_components of GZ;

theorem 
  for B1,B2,V being Subset of GX holds Down(B1 \/ B2,V)=Down(B1,V) \/
  Down(B2,V);

theorem 
  for B1,B2,V being Subset of GX holds Down(B1 /\ B2,V)=Down(B1,V) /\
  Down(B2,V);

reserve f for non constant standard special_circular_sequence,
  G for non empty-yielding Matrix of TOP-REAL 2;

theorem 
  (L~f)` <> {};

registration
  let f;
  cluster (L~f)` -> non empty;
end;

theorem 
  for f holds the carrier of TOP-REAL 2 = union {cell(GoB f,i,j):i<=len
  GoB f & j<=width GoB f};

theorem 
  for P1,P2 being Subset of TOP-REAL 2 st P1={ |[r,s]| : s <= s1 }
  & P2={ |[r2,s2]| : s2 > s1 } holds P1=P2`;

theorem 
  for P1,P2 being Subset of TOP-REAL 2 st P1={ |[r,s]| : s >= s1 }
  & P2={ |[r2,s2]| : s2 < s1 } holds P1=P2`;

theorem 
  for P1,P2 being Subset of TOP-REAL 2 st P1={ |[s,r]| : s >= s1 }
  & P2={ |[s2,r2]| : s2 < s1 } holds P1=P2`;

theorem 
  for P1,P2 being Subset of TOP-REAL 2 st P1={ |[s,r]| : s <= s1 }
  & P2={ |[s2,r2]| : s2 > s1 } holds P1=P2`;

theorem 
  for P being Subset of TOP-REAL 2, s1 st P= { |[r,s]| : s <= s1 }
  holds P is closed;

theorem 
  for P being Subset of TOP-REAL 2,s1 st P={ |[r,s]| : s1 <= s }
  holds P is closed;

theorem 
  for P being Subset of TOP-REAL 2, s1 st P= { |[s,r]| : s <= s1 }
  holds P is closed;

theorem 
  for P being Subset of TOP-REAL 2,s1 st P={ |[s,r]| : s1 <= s }
  holds P is closed;

theorem 
  for G being Matrix of TOP-REAL 2 holds h_strip(G,j) is closed;

theorem 
  for G being Matrix of TOP-REAL 2 holds v_strip(G,j) is closed;

theorem 
  G is X_equal-in-line implies v_strip(G,0) = { |[r,s]| : r <= G*( 1,1)`1 };

theorem 
  G is X_equal-in-line implies v_strip(G,len G) = { |[r,s]| : G*(
  len G,1)`1 <= r };

theorem 
  G is X_equal-in-line & 1 <= i & i < len G implies v_strip(G,i) =
  { |[r,s]| : G*(i,1)`1 <= r & r <= G*(i+1,1)`1 };

theorem 
  G is Y_equal-in-column implies h_strip(G,0) = { |[r,s]| : s <= G *(1,1)`2 };

theorem 
  G is Y_equal-in-column implies h_strip(G,width G) = { |[r,s]| :
  G*(1,width G)`2 <= s };

theorem 
  G is Y_equal-in-column & 1 <= j & j < width G implies h_strip(G,
  j) = { |[r,s]| : G*(1,j)`2 <= s & s <= G*(1,j+1)`2 };

reserve G for non empty-yielding X_equal-in-line Y_equal-in-column Matrix of
  TOP-REAL 2;

theorem 
  cell(G,0,0) = { |[r,s]| : r <= G*(1,1)`1 & s <= G*(1,1)`2 };

theorem 
  cell(G,0,width G) = { |[r,s]| : r <= G*(1,1)`1 & G*(1,width G)`2 <= s };

theorem 
  1 <= j & j < width G implies cell(G,0,j) = { |[r,s]| : r <= G*(1
  ,1)`1 & G*(1,j)`2 <= s & s <= G*(1,j+1)`2 };

theorem 
  cell(G,len G,0) = { |[r,s]| : G*(len G,1)`1 <= r & s <= G*(1,1) `2 };

theorem 
  cell(G,len G,width G) = { |[r,s]| : G*(len G,1)`1 <= r & G*(1,
  width G)`2 <= s };

theorem 
  1 <= j & j < width G implies cell(G,len G,j) = { |[r,s]| : G*(
  len G,1)`1 <= r & G*(1,j)`2 <= s & s <= G*(1,j+1)`2 };

theorem 
  1 <= i & i < len G implies cell(G,i,0) = { |[r,s]|: G*(i,1)`1 <=
  r & r <= G*(i+1,1)`1 & s <= G* (1,1)`2 };

theorem 
  1 <= i & i < len G implies cell(G,i,width G) = { |[r,s]|: G*(i,1
  )`1 <= r & r <= G*(i+1,1)`1 & G*(1,width G)`2 <= s };

theorem 
  1 <= i & i < len G & 1 <= j & j < width G implies cell(G,i,j) =
{ |[r,s]| : G*(i,1)`1 <= r & r <= G*(i+1,1)`1 & G*(1,j)`2 <= s & s <= G*(1,j+1)
  `2 };

theorem 
  for G being Matrix of TOP-REAL 2 holds cell(G,i,j) is closed;

theorem 
  for G being non empty-yielding Matrix of TOP-REAL 2 holds 1<=len
  G & 1<=width G;

theorem 
  for G being Go-board holds i<=len G & j<=width G implies cell(G,i,j)=
  Cl Int cell(G,i,j);














begin

reserve i,j,k,k1,k2,i1,i2,j1,j2 for Element of NAT,
  r,s for Real,
  x for set,
  f for non constant standard special_circular_sequence;

theorem 
  for i,j st i<=len GoB f & j<=width GoB f holds Int cell(GoB f,i,j )c=(L~f)`;

theorem 
  for i,j st i<=len GoB f & j<=width GoB f holds Cl Down(Int cell(
  GoB f,i,j),(L~f)`)=cell(GoB f,i,j)/\((L~f)`);

theorem 
  for i,j st i<=len GoB f & j<=width GoB f holds Cl Down(Int cell(
GoB f,i,j),(L~f)`) is connected & Down(Int cell(GoB f,i,j),(L~f)`)=Int cell(GoB
  f,i,j);

theorem 
  (L~f)`=union {Cl Down(Int cell(GoB f,i,j),(L~f)`): i<=len GoB f &
  j<=width GoB f};

theorem 
  Down(LeftComp f,(L~f)`) \/ Down(RightComp f,(L~f)`) is
  a_union_of_components of (TOP-REAL 2)|((L~f)`) & Down(LeftComp f,(L~f)`)=
  LeftComp f & Down(RightComp f,(L~f)`)=RightComp f;

theorem 
  for i1,j1,i2,j2 st i1<=len GoB f & j1<=width GoB f & i2<=len GoB
f & j2<=width GoB f & i1,j1,i2,j2 are_adjacent2 holds Int cell(GoB f,i1,j1) c=
LeftComp f \/ RightComp f iff Int cell(GoB f,i2,j2) c= LeftComp f \/ RightComp
  f;

theorem 
  for F1,F2 being FinSequence of NAT st len F1=len F2 & (ex i st i
in dom F1 & Int cell(GoB f,F1/.i,F2/.i) c=LeftComp f \/ RightComp f)& (for i,k1
  ,k2 st i in dom F1 & k1=F1.i & k2=F2.i holds k1<=len GoB f & k2<=width GoB f)
  holds for i st i in dom F1 holds Int cell(GoB f,F1/.i,F2/.i)c=LeftComp f \/
  RightComp f;

theorem 
  ex i,j st i<=len GoB f & j<=width GoB f & Int cell(GoB f,i,j) c=
  LeftComp f \/ RightComp f;

theorem 
  for i,j st i<=len GoB f & j<=width GoB f holds Int cell(GoB f,i,
  j) c= LeftComp f \/ RightComp f;


theorem 
  (L~f)`=LeftComp f \/ RightComp f;














begin 

reserve f, g, h for Function;

theorem 
  h = f \/ g & dom f misses dom g implies (h is one-to-one iff f is
  one-to-one & g is one-to-one & rng f misses rng g);

begin 

reserve x, y, z, u, X for set,
  A for non empty set,
  n for Element of NAT,
  f for Function of X, X;

theorem 
  x is_a_fixpoint_of iter(f,n) implies f.x is_a_fixpoint_of iter(f, n);

theorem 
  (ex n st x is_a_fixpoint_of iter(f,n) & for y st y is_a_fixpoint_of
  iter(f,n) holds x = y) implies x is_a_fixpoint_of f;

definition
  let A, B be non empty set, f be Function of A, B;

  redefine attr f is c=-monotone means


  for x, y being Element of A st x c= y holds f.x c= f.y;
end;

registration
  let A be set, B be non empty set;
  cluster c=-monotone for Function of A, B;
end;

definition
  let X be set;
  let f be c=-monotone Function of bool X, bool X;
  func lfp (X, f) -> Subset of X equals

  meet {h where h is Subset of X : f.h c= h};
  func gfp (X, f) -> Subset of X equals

  union {h where h is Subset of X : h c= f.h };
end;

reserve f for c=-monotone Function of bool X, bool X,
  S for Subset of X;

theorem 
  lfp(X, f) is_a_fixpoint_of f;

theorem 
  gfp(X, f) is_a_fixpoint_of f;

theorem 
  f.S c= S implies lfp(X,f) c= S;

theorem 
  S c= f.S implies S c= gfp(X,f);

theorem 
  S is_a_fixpoint_of f implies lfp(X,f) c= S & S c= gfp(X,f);


scheme 

  Knaster{A() -> set, F(set) -> set}: ex D being set st F(D) = D & D c= A()
provided
 for X, Y being set st X c= Y holds F(X) c= F(Y) and
 F(A()) c= A();

reserve X, Y for non empty set,
  f for Function of X, Y,
  g for Function of Y, X;



theorem 
  ex Xa, Xb, Ya, Yb being set st Xa misses Xb & Ya misses Yb & Xa
  \/ Xb = X & Ya \/ Yb = Y & f.:Xa = Ya & g.:Yb = Xb;


theorem 
  for X, Y being non empty set,
      f being Function of X, Y,
      g being Function of Y, X st
    f is one-to-one & g is one-to-one holds
   ex h being Function of X,Y st h is bijective;

theorem 
  f is bijective implies X,Y are_equipotent;

theorem 
  f is one-to-one & g is one-to-one implies X,Y are_equipotent;

begin 

definition
  let L be Lattice, f be Function of the carrier of L, the carrier of L, x be
  Element of L, O be Ordinal;
  func (f, O)+.x means


  ex L0 being T-Sequence st it = last L0 & dom L0
= succ O & L0.{} = x & (for C being Ordinal st succ C in succ O holds L0.succ C
= f.(L0.C)) & for C being Ordinal st C in succ O & C <> {} & C is limit_ordinal
  holds L0.C = "\/"(rng(L0|C), L);
  func (f, O)-.x means


  ex L0 being T-Sequence st it = last L0 & dom L0
= succ O & L0.{} = x & (for C being Ordinal st succ C in succ O holds L0.succ C
= f.(L0.C)) & for C being Ordinal st C in succ O & C <> {} & C is limit_ordinal
  holds L0.C = "/\"(rng(L0|C) , L);
end;

reserve L for Lattice,
  f for Function of the carrier of L, the carrier of L,
  x for Element of L,
  O, O1, O2, O3, O4 for Ordinal,
  T for T-Sequence;

theorem 
  (f, {})+.x = x;

theorem 
  (f, {})-.x = x;

theorem 
  (f, succ O)+.x = f.(f, O)+.x;

theorem 
  (f, succ O)-.x = f.(f, O)-.x;

theorem 
  O <> {} & O is limit_ordinal & dom T = O & (for A being Ordinal
  st A in O holds T.A = (f, A)+.x) implies (f, O)+.x = "\/"(rng T, L);

theorem 
  O <> {} & O is limit_ordinal & dom T = O & (for A being Ordinal
  st A in O holds T.A = (f, A)-.x) implies (f, O)-.x = "/\"(rng T, L);

theorem 
  iter(f, n).x = (f, n)+.x;

theorem 
  iter(f, n).x = (f, n)-.x;

definition
  let L be Lattice, f be (UnOp of the carrier of L), a be Element of L, O be
  Ordinal;
  redefine func (f, O)+.a -> Element of L;
end;

definition
  let L be Lattice, f be (UnOp of the carrier of L), a be Element of L, O be
  Ordinal;
  redefine func (f, O)-.a -> Element of L;
end;

definition
  let L be non empty LattStr, P be Subset of L;
  attr P is with_suprema means


  for x,y being Element of L st x in P & y
in P ex z being Element of L st z in P & x [= z & y [= z & for z9 being Element
  of L st z9 in P & x [= z9 & y [= z9 holds z [= z9;
  attr P is with_infima means


  for x,y being Element of L st x in P & y
in P ex z being Element of L st z in P & z [= x & z [= y & for z9 being Element
  of L st z9 in P & z9 [= x & z9 [= y holds z9 [= z;
end;

registration
  let L be Lattice;
  cluster non empty with_suprema with_infima for Subset of L;
end;

definition
  let L be Lattice, P be non empty with_suprema with_infima Subset of L;
  func latt P -> strict Lattice means


  the carrier of it = P & for x, y
  being Element of it ex x9, y9 being Element of L st x = x9 & y = y9 & (x [= y
  iff x9 [= y9);
end;

begin 

registration
  cluster complete -> bounded for Lattice;
end;

reserve L for complete Lattice,
  f for monotone UnOp of L,
  a, b for Element of L;

theorem 
  ex a st a is_a_fixpoint_of f;

theorem 
  for a st a [= f.a for O holds a [= (f, O)+.a;

theorem 
  for a st f.a [= a for O holds (f, O)-.a [= a;

theorem 
  for a st a [= f.a for O1, O2 st O1 c= O2 holds (f, O1)+.a [= (f, O2)+.a;

theorem 
  for a st f.a [= a for O1, O2 st O1 c= O2 holds (f, O2)-.a [= (f, O1)-.a;

theorem 
  for a st a [= f.a for O1, O2 st O1 c< O2 & not (f, O2)+.a
  is_a_fixpoint_of f holds (f, O1)+.a <> (f, O2)+.a;

theorem 
  for a st f.a [= a for O1, O2 st O1 c< O2 & not (f, O2)-.a
  is_a_fixpoint_of f holds (f, O1)-.a <> (f, O2)-.a;

theorem 
  a [= f.a & (f, O1)+.a is_a_fixpoint_of f implies for O2 st O1 c=
  O2 holds (f, O1)+.a = (f, O2)+.a;

theorem 
  f.a [= a & (f, O1)-.a is_a_fixpoint_of f implies for O2 st O1 c=
  O2 holds (f, O1)-.a = (f, O2)-.a;

theorem 
  for a st a [= f.a ex O st card O c= card the carrier of L & (f,
  O)+.a is_a_fixpoint_of f;

theorem 
  for a st f.a [= a ex O st card O c= card the carrier of L & (f,
  O)-.a is_a_fixpoint_of f;

theorem 
  for a, b st a is_a_fixpoint_of f & b is_a_fixpoint_of f ex O st
card O c= card the carrier of L & (f, O)+.(a"\/"b) is_a_fixpoint_of f & a [= (f
  , O)+.(a"\/"b) & b [= (f, O)+.(a"\/"b);

theorem 
  for a, b st a is_a_fixpoint_of f & b is_a_fixpoint_of f ex O st
card O c= card the carrier of L & (f, O)-.(a"/\"b) is_a_fixpoint_of f & (f, O)
  -.(a"/\"b) [= a & (f, O)-.(a"/\"b) [= b;

theorem 
  a [= b & b is_a_fixpoint_of f implies for O2 holds (f, O2)+.a [= b;

theorem 
  b [= a & b is_a_fixpoint_of f implies for O2 holds b [= (f, O2) -.a;

definition
  let L be complete Lattice, f be UnOp of L such that
 f is monotone;
  func FixPoints f -> strict Lattice means


  ex P being non empty
  with_suprema with_infima Subset of L st P = {x where x is Element of L: x
  is_a_fixpoint_of f} & it = latt P;
end;

theorem 
  the carrier of FixPoints f = {x where x is Element of L: x
  is_a_fixpoint_of f};

theorem 
  the carrier of FixPoints f c= the carrier of L;

theorem 
  a in the carrier of FixPoints f iff a is_a_fixpoint_of f;

theorem 
  for x, y being Element of FixPoints f, a, b st x = a & y = b
  holds (x [= y iff a [= b);

theorem 
  FixPoints f is complete;

definition
  let L, f;
  func lfp f -> Element of L equals

  (f, nextcard the carrier of L)+.Bottom L;
  func gfp f -> Element of L equals

  (f, nextcard the carrier of L)-.Top L;
end;

theorem 
  lfp f is_a_fixpoint_of f & ex O st card O c= card the carrier of
  L & (f, O)+.Bottom L = lfp f;

theorem 
  gfp f is_a_fixpoint_of f & ex O st card O c= card the carrier of
  L & (f, O)-.Top L = gfp f;

theorem 
  a is_a_fixpoint_of f implies lfp f [= a & a [= gfp f;

theorem 
  f.a [= a implies lfp f [= a;

theorem 
  a [= f.a implies a [= gfp f;

begin 

reserve f for monotone UnOp of BooleLatt A;

theorem 
  for f being UnOp of BooleLatt A holds f is monotone iff f is c=-monotone;

theorem 
  ex g being c=-monotone Function of bool A, bool A st lfp (A, g) = lfp f;

theorem 
  ex g being c=-monotone Function of bool A, bool A st gfp (A, g) = gfp f;















begin 




definition
  let S be unsplit non void non empty ManySortedSign;
  let A be Boolean Circuit of S;
  let s be State of A;
  let v be Vertex of S;
  redefine func s.v -> Element of BOOLEAN;
end;

definition
  func and2 -> Function of 2-tuples_on BOOLEAN, BOOLEAN means


  for x,y being Element of BOOLEAN holds it.<*x,y*> = x '&' y;
  func and2a -> Function of 2-tuples_on BOOLEAN, BOOLEAN means


  for x,y being Element of BOOLEAN holds it.<*x,y*> = 'not' x '&' y;
  func and2b -> Function of 2-tuples_on BOOLEAN, BOOLEAN means


  for x,y being Element of BOOLEAN holds it.<*x,y*> = 'not' x '&' 'not' y;
end;

definition
  func nand2 -> Function of 2-tuples_on BOOLEAN, BOOLEAN means


  for x,y being Element of BOOLEAN holds it.<*x,y*> = 'not' (x '&' y);
  func nand2a -> Function of 2-tuples_on BOOLEAN, BOOLEAN means


  for x, y being Element of BOOLEAN holds it.<*x,y*> = 'not' ('not' x '&' y);
  func nand2b -> Function of 2-tuples_on BOOLEAN, BOOLEAN means


  for x,
  y being Element of BOOLEAN holds it.<*x,y*> = 'not' ('not' x '&' 'not' y);
end;

definition
  func or2 -> Function of 2-tuples_on BOOLEAN, BOOLEAN means


  for x,y being Element of BOOLEAN holds it.<*x,y*> = x 'or' y;
  func or2a -> Function of 2-tuples_on BOOLEAN, BOOLEAN means


  for x,y being Element of BOOLEAN holds it.<*x,y*> = 'not' x 'or' y;
  func or2b -> Function of 2-tuples_on BOOLEAN, BOOLEAN means


  for x,y being Element of BOOLEAN holds it.<*x,y*> = 'not' x 'or' 'not' y;
end;

definition
  func nor2 -> Function of 2-tuples_on BOOLEAN, BOOLEAN means


  for x,y being Element of BOOLEAN holds it.<*x,y*> = 'not' (x 'or' y);
  func nor2a -> Function of 2-tuples_on BOOLEAN, BOOLEAN means


  for x,y being Element of BOOLEAN holds it.<*x,y*> = 'not' ('not' x 'or' y);
  func nor2b -> Function of 2-tuples_on BOOLEAN, BOOLEAN means


  for x,y
  being Element of BOOLEAN holds it.<*x,y*> = 'not' ('not' x 'or' 'not' y);
end;

definition
  func xor2 -> Function of 2-tuples_on BOOLEAN, BOOLEAN means


  for x,y being Element of BOOLEAN holds it.<*x,y*> = x 'xor' y;
  func xor2a -> Function of 2-tuples_on BOOLEAN, BOOLEAN means


  for x, y being Element of BOOLEAN holds it.<*x,y*> = 'not' x 'xor' y;
  func xor2b -> Function of 2-tuples_on BOOLEAN, BOOLEAN means


  for x, y being Element of BOOLEAN holds it.<*x,y*> = 'not' x 'xor' 'not' y;
end;

theorem 
  for x,y being Element of BOOLEAN holds and2.<*x,y*> = x '&' y & and2a.
<*x,y*> = 'not' x '&' y & and2b.<*x,y*> = 'not' x '&' 'not' y
;

theorem 
  for x,y being Element of BOOLEAN holds nand2.<*x,y*> = 'not' (x '&' y)
& nand2a.<*x,y*> = 'not' ('not' x '&' y) & nand2b.<*x,y*> = 'not' ('not' x '&'
  'not' y);

theorem 
  for x,y being Element of BOOLEAN holds or2.<*x,y*> = x 'or' y & or2a.
  <*x,y*> = 'not' x 'or' y & or2b.<*x,y*> = 'not' x 'or' 'not' y;

theorem 
  for x,y being Element of BOOLEAN holds nor2.<*x,y*> = 'not' (x 'or' y)
& nor2a.<*x,y*> = 'not' ('not' x 'or' y) & nor2b.<*x,y*> = 'not' ('not' x 'or'
  'not' y);

theorem 
  for x,y being Element of BOOLEAN holds xor2.<*x,y*> = x 'xor' y &
  xor2a.<*x,y*> = 'not' x 'xor' y & xor2b.<*x,y*> = 'not' x 'xor' 'not' y;

theorem 
  for x,y being Element of BOOLEAN holds and2.<*x,y*> = nor2b.<*x,y*> &
  and2a.<*x,y*> = nor2a.<*y,x*> & and2b.<*x,y*> = nor2.<*x,y*>;

theorem 
  for x,y being Element of BOOLEAN holds or2.<*x,y*> = nand2b.<*x,y*> &
  or2a.<*x,y*> = nand2a.<*y,x*> & or2b.<*x,y*> = nand2.<*x,y*>;

theorem 
  for x,y being Element of BOOLEAN holds xor2b.<*x,y*> = xor2.<*x,y*>;

theorem 
  and2.<*0,0*>=0 & and2.<*0,1*>=0 & and2.<*1,0*>=0 & and2.<*1,1*>=1 &
and2a.<*0,0*>=0 & and2a.<*0,1*>=1 & and2a.<*1,0*>=0 & and2a.<*1,1*>=0 & and2b.
  <*0,0*>=1 & and2b.<*0,1*>=0 & and2b.<*1,0*>=0 & and2b.<*1,1*>=0;

theorem 
  or2.<*0,0*>=0 & or2.<*0,1*>=1 & or2.<*1,0*>=1 & or2.<*1,1*>=1 & or2a.
<*0,0*>=1 & or2a.<*0,1*>=1 & or2a.<*1,0*>=0 & or2a.<*1,1*>=1 & or2b.<*0,0*>=1 &
  or2b.<*0,1*>=1 & or2b.<*1,0*>=1 & or2b.<*1,1*>=0;

theorem 
  xor2.<*0,0*>=0 & xor2.<*0,1*>=1 & xor2.<*1,0*>=1 & xor2.<*1,1*>=0 &
  xor2a.<*0,0*>=1 & xor2a.<*0,1*>=0 & xor2a.<*1,0*>=0 & xor2a.<*1,1*>=1;



definition
  func and3 -> Function of 3-tuples_on BOOLEAN, BOOLEAN means


  for x,y ,z being Element of BOOLEAN holds it.<*x,y,z*> = x '&' y '&' z;
  func and3a -> Function of 3-tuples_on BOOLEAN, BOOLEAN means


  for x, y,z being Element of BOOLEAN holds it.<*x,y,z*> = 'not' x '&' y '&' z;
  func and3b -> Function of 3-tuples_on BOOLEAN, BOOLEAN means


  for x,
  y,z being Element of BOOLEAN holds it.<*x,y,z*> = 'not' x '&' 'not' y '&' z;
  func and3c -> Function of 3-tuples_on BOOLEAN, BOOLEAN means


  for x,
y,z being Element of BOOLEAN holds it.<*x,y,z*> = 'not' x '&' 'not' y '&' 'not'
  z;
end;

definition
  func nand3 -> Function of 3-tuples_on BOOLEAN, BOOLEAN means


  for x,
  y,z being Element of BOOLEAN holds it.<*x,y,z*> = 'not' (x '&' y '&' z);
  func nand3a -> Function of 3-tuples_on BOOLEAN, BOOLEAN means


  for x
,y,z being Element of BOOLEAN holds it.<*x,y,z*> = 'not' ('not' x '&' y '&' z);
  func nand3b -> Function of 3-tuples_on BOOLEAN, BOOLEAN means


  for x
  ,y,z being Element of BOOLEAN holds it.<*x,y,z*> = 'not' ('not' x '&' 'not' y
  '&' z);
  func nand3c -> Function of 3-tuples_on BOOLEAN, BOOLEAN means


  for x
  ,y,z being Element of BOOLEAN holds it.<*x,y,z*> = 'not' ('not' x '&' 'not' y
  '&' 'not' z);
end;

definition
  func or3 -> Function of 3-tuples_on BOOLEAN, BOOLEAN means


  for x,y, z being Element of BOOLEAN holds it.<*x,y,z*> = x 'or' y 'or' z;
  func or3a -> Function of 3-tuples_on BOOLEAN, BOOLEAN means


  for x,y
  ,z being Element of BOOLEAN holds it.<*x,y,z*> = 'not' x 'or' y 'or' z;
  func or3b -> Function of 3-tuples_on BOOLEAN, BOOLEAN means


  for x,y
  ,z being Element of BOOLEAN holds it.<*x,y,z*> = 'not' x 'or' 'not' y 'or' z;
  func or3c -> Function of 3-tuples_on BOOLEAN, BOOLEAN means


  for x,y
  ,z being Element of BOOLEAN holds it.<*x,y,z*> = 'not' x 'or' 'not' y 'or'
  'not' z;
end;

definition
  func nor3 -> Function of 3-tuples_on BOOLEAN, BOOLEAN means


  for x,y
  ,z being Element of BOOLEAN holds it.<*x,y,z*> = 'not' (x 'or' y 'or' z);
  func nor3a -> Function of 3-tuples_on BOOLEAN, BOOLEAN means


  for x,
y,z being Element of BOOLEAN holds it.<*x,y,z*> = 'not' ('not' x 'or' y 'or' z)
  ;
  func nor3b -> Function of 3-tuples_on BOOLEAN, BOOLEAN means


  for x,
  y,z being Element of BOOLEAN holds it.<*x,y,z*> = 'not' ('not' x 'or' 'not' y
  'or' z);
  func nor3c -> Function of 3-tuples_on BOOLEAN, BOOLEAN means


  for x,
  y,z being Element of BOOLEAN holds it.<*x,y,z*> = 'not' ('not' x 'or' 'not' y
  'or' 'not' z);
end;

definition
  func xor3 -> Function of 3-tuples_on BOOLEAN, BOOLEAN means


  for x,y ,z being Element of BOOLEAN holds it.<*x,y,z*> = x 'xor' y 'xor' z;
end;

theorem 
  for x,y,z being Element of BOOLEAN holds and3.<*x,y,z*> = x '&' y '&'
z & and3a.<*x,y,z*> = 'not' x '&' y '&' z & and3b.<*x,y,z*> = 'not' x '&' 'not'
  y '&' z & and3c.<*x,y,z*> = 'not' x '&' 'not' y '&' 'not' z;

theorem 
  for x,y,z being Element of BOOLEAN holds nand3.<*x,y,z*>='not' (x '&'
  y '&' z) & nand3a.<*x,y,z*>='not' ('not' x '&' y '&' z) & nand3b.<*x,y,z*>=
'not' ('not' x '&' 'not' y '&' z) & nand3c.<*x,y,z*>='not' ('not' x '&' 'not' y
  '&' 'not' z);

theorem 
  for x,y,z being Element of BOOLEAN holds or3.<*x,y,z*> = x 'or' y 'or'
  z & or3a.<*x,y,z*> = 'not' x 'or' y 'or' z & or3b.<*x,y,z*> = 'not' x 'or'
  'not' y 'or' z & or3c.<*x,y,z*> = 'not' x 'or' 'not' y 'or' 'not' z;

theorem 
  for x,y,z being Element of BOOLEAN holds nor3.<*x,y,z*>='not' (x 'or'
  y 'or' z) & nor3a.<*x,y,z*>='not' ('not' x 'or' y 'or' z) & nor3b.<*x,y,z*>=
'not' ('not' x 'or' 'not' y 'or' z) & nor3c.<*x,y,z*>='not' ('not' x 'or' 'not'
  y 'or' 'not' z);

theorem 
  for x,y,z being Element of BOOLEAN holds and3.<*x,y,z*> = nor3c.<*x,y,
  z*> & and3a.<*x,y,z*> = nor3b.<*z,y,x*> & and3b.<*x,y,z*> = nor3a.<*z,y,x*> &
  and3c.<*x,y,z*> = nor3.<*x,y,z*>;

theorem 
  for x,y,z being Element of BOOLEAN holds or3.<*x,y,z*> = nand3c.<*x,y,
  z*> & or3a.<*x,y,z*> = nand3b.<*z,y,x*> & or3b.<*x,y,z*> = nand3a.<*z,y,x*> &
  or3c.<*x,y,z*> = nand3.<*x,y,z*>;

theorem 
  and3.<*0,0,0*>=0 & and3.<*0,0,1*>=0 & and3.<*0,1,0*>=0 & and3.<*0,1,1
*>=0 & and3.<*1,0,0*>=0 & and3.<*1,0,1*>=0 & and3.<*1,1,0*>=0 & and3.<*1,1,1*>=
  1;

theorem 
  and3a.<*0,0,0*>=0 & and3a.<*0,0,1*>=0 & and3a.<*0,1,0*>=0 & and3a.<*0,
1,1*>=1 & and3a.<*1,0,0*>=0 & and3a.<*1,0,1*>=0 & and3a.<*1,1,0*>=0 & and3a.<*1
  ,1,1*>=0;

theorem 
  and3b.<*0,0,0*>=0 & and3b.<*0,0,1*>=1 & and3b.<*0,1,0*>=0 & and3b.<*0,
1,1*>=0 & and3b.<*1,0,0*>=0 & and3b.<*1,0,1*>=0 & and3b.<*1,1,0*>=0 & and3b.<*1
  ,1,1*>=0;

theorem 
  and3c.<*0,0,0*>=1 & and3c.<*0,0,1*>=0 & and3c.<*0,1,0*>=0 & and3c.<*0,
1,1*>=0 & and3c.<*1,0,0*>=0 & and3c.<*1,0,1*>=0 & and3c.<*1,1,0*>=0 & and3c.<*1
  ,1,1*>=0;

theorem 
  or3.<*0,0,0*> = 0 & or3.<*0,0,1*> = 1 & or3.<*0,1,0*> = 1 & or3.<*0,1,
1*> = 1 & or3.<*1,0,0*> = 1 & or3.<*1,0,1*> = 1 & or3.<*1,1,0*> = 1 & or3.<*1,1
  ,1*> = 1;

theorem 
  or3a.<*0,0,0*> = 1 & or3a.<*0,0,1*> = 1 & or3a.<*0,1,0*> = 1 & or3a.<*
  0,1,1*> = 1 & or3a.<*1,0,0*> = 0 & or3a.<*1,0,1*> = 1 & or3a.<*1,1,0*> = 1 &
  or3a.<*1,1,1*> = 1;

theorem 
  or3b.<*0,0,0*> = 1 & or3b.<*0,0,1*> = 1 & or3b.<*0,1,0*> = 1 & or3b.<*
  0,1,1*> = 1 & or3b.<*1,0,0*> = 1 & or3b.<*1,0,1*> = 1 & or3b.<*1,1,0*> = 0 &
  or3b.<*1,1,1*> = 1;

theorem 
  or3c.<*0,0,0*> = 1 & or3c.<*0,0,1*> = 1 & or3c.<*0,1,0*> = 1 & or3c.<*
  0,1,1*> = 1 & or3c.<*1,0,0*> = 1 & or3c.<*1,0,1*> = 1 & or3c.<*1,1,0*> = 1 &
  or3c.<*1,1,1*> = 0;

theorem 
  xor3.<*0,0,0*> = 0 & xor3.<*0,0,1*> = 1 & xor3.<*0,1,0*> = 1 & xor3.<*
  0,1,1*> = 0 & xor3.<*1,0,0*> = 1 & xor3.<*1,0,1*> = 0 & xor3.<*1,1,0*> = 0 &
  xor3.<*1,1,1*> = 1;

begin 





definition
  let x,b be set;
  func CompStr(x,b) -> unsplit gate`1=arity gate`2isBoolean non void strict
  non empty ManySortedSign equals

  1GateCircStr(<*x,b*>,xor2a);
end;

definition
  let x,b be set;
  func CompCirc(x,b) -> strict Boolean gate`2=den Circuit of CompStr(x,b)
  equals

  1GateCircuit(x,b,xor2a);
end;

definition
  let x,b be set;
  func CompOutput(x,b) -> Element of InnerVertices CompStr(x,b) equals

  [<*x,b
  *>,xor2a];
end;



definition
  let x,b be set;
  func IncrementStr(x,b) -> unsplit gate`1=arity gate`2isBoolean non void
  strict non empty ManySortedSign equals

  1GateCircStr(<*x,b*>,and2a);
end;

definition
  let x,b be set;
  func IncrementCirc(x,b) -> strict Boolean gate`2=den Circuit of IncrementStr
  (x,b) equals

  1GateCircuit(x,b,and2a);
end;

definition
  let x,b be set;
  func IncrementOutput(x,b) -> Element of InnerVertices IncrementStr(x,b)
  equals

  [<*x,b*>,and2a];
end;



definition
  let x,b be set;
  func BitCompStr(x,b) -> unsplit gate`1=arity gate`2isBoolean non void strict
  non empty ManySortedSign equals

  CompStr(x,b) +* IncrementStr(x,b);
end;

definition
  let x,b be set;
  func BitCompCirc(x,b) -> strict Boolean gate`2=den Circuit of BitCompStr(x,b
  ) equals

  CompCirc(x,b) +* IncrementCirc(x,b);
end;

theorem 
  for x,b being non pair set holds the carrier of CompStr(x,b) = {
  x,b} \/ {[<*x,b*>,xor2a]};

theorem 
  for x,b being non pair set holds [<*x,b*>,xor2a] in InnerVertices
  CompStr(x,b);

theorem 
  for x,b being non pair set holds x in InputVertices CompStr(x,b) & b
  in InputVertices CompStr(x,b);

theorem 
  for x,b being non pair set holds InputVertices CompStr(x,b) is without_pairs;

theorem 
  for x,b being non pair set holds the carrier of IncrementStr(x,b
  ) = {x,b} \/ {[<*x,b*>,and2a]};

theorem 
  for x,b being non pair set holds [<*x,b*>,and2a] in InnerVertices
  IncrementStr(x,b);

theorem 
  for x,b being non pair set holds x in InputVertices IncrementStr(x,b)
  & b in InputVertices IncrementStr(x,b);

theorem 
  for x,b being non pair set holds InputVertices IncrementStr(x,b) is
  without_pairs;



theorem 
  for x,b being non pair set holds InnerVertices BitCompStr(x,b) is Relation;

theorem 
  for x,b being non pair set holds x in the carrier of BitCompStr(
x,b) & b in the carrier of BitCompStr(x,b) & [<*x,b*>,xor2a] in the carrier of
  BitCompStr(x,b) & [<*x,b*>,and2a] in the carrier of BitCompStr(x,b);

theorem 
  for x,b being non pair set holds the carrier of BitCompStr(x,b)
  = {x,b} \/ {[<*x,b*>,xor2a],[<*x,b*>,and2a]};

theorem 
  for x,b being non pair set holds InnerVertices BitCompStr(x,b) =
  {[<*x,b*>,xor2a],[<*x,b*>,and2a]};

theorem 
  for x,b being non pair set holds [<*x,b*>,xor2a] in
InnerVertices BitCompStr(x,b) & [<*x,b*>,and2a] in InnerVertices BitCompStr(x,b
  );

theorem 
  for x,b being non pair set holds InputVertices BitCompStr(x,b) = {x,b};

theorem 
  for x,b being non pair set holds x in InputVertices BitCompStr(x
  ,b) & b in InputVertices BitCompStr(x,b);

theorem 
  for x,b being non pair set holds InputVertices BitCompStr(x,b) is
  without_pairs;





theorem 
  for x,b being non pair set for s being State of CompCirc(x,b)
holds (Following s).CompOutput(x,b) = xor2a.<*s.x,s.b*> & (Following s).x = s.x
  & (Following s).b = s.b;

theorem 
  for x,b being non pair set for s being State of CompCirc(x,b) for a1,
  a2 being Element of BOOLEAN st a1 = s.x & a2 = s.b holds (Following s).
CompOutput(x,b) = 'not' a1 'xor' a2 & (Following s).x = a1 & (Following s).b =
  a2;

theorem 
  for x,b being non pair set for s being State of BitCompCirc(x,b)
holds (Following s).CompOutput(x,b) = xor2a.<*s.x,s.b*> & (Following s).x = s.x
  & (Following s).b = s.b;

theorem 
  for x,b being non pair set for s being State of BitCompCirc(x,b)
for a1,a2 being Element of BOOLEAN st a1 = s.x & a2 = s.b holds (Following s).
CompOutput(x,b) = 'not' a1 'xor' a2 & (Following s).x = a1 & (Following s).b =
  a2;

theorem 
  for x,b being non pair set for s being State of IncrementCirc(x,
b) holds (Following s).IncrementOutput(x,b) = and2a.<*s.x,s.b*> & (Following s)
  .x = s.x & (Following s).b = s.b;

theorem 
  for x,b being non pair set for s being State of IncrementCirc(x,b) for
  a1,a2 being Element of BOOLEAN st a1 = s.x & a2 = s.b holds (Following s).
IncrementOutput(x,b) = 'not' a1 '&' a2 & (Following s).x = a1 & (Following s).b
  = a2;

theorem 
  for x,b being non pair set for s being State of BitCompCirc(x,b)
holds (Following s).IncrementOutput(x,b) = and2a.<*s.x,s.b*> & (Following s).x
  = s.x & (Following s).b = s.b;

theorem 
  for x,b being non pair set for s being State of BitCompCirc(x,b)
for a1,a2 being Element of BOOLEAN st a1 = s.x & a2 = s.b holds (Following s).
IncrementOutput(x,b) = 'not' a1 '&' a2 & (Following s).x = a1 & (Following s).b
  = a2;

theorem 
  for x,b being non pair set for s being State of BitCompCirc(x,b) holds
  (Following s).CompOutput(x,b) = xor2a.<*s.x,s.b*> & (Following s).
IncrementOutput(x,b) = and2a.<*s.x,s.b*> & (Following s).x = s.x & (Following s
  ).b = s.b;

theorem 
  for x,b being non pair set for s being State of BitCompCirc(x,b) for
  a1,a2 being Element of BOOLEAN st a1 = s.x & a2 = s.b holds (Following s).
  CompOutput(x,b) = 'not' a1 'xor' a2 & (Following s).IncrementOutput(x,b) =
  'not' a1 '&' a2 & (Following s).x = a1 & (Following s).b = a2;

theorem 
  for x,b being non pair set for s being State of BitCompCirc(x,b) holds
  (Following s) is stable;














begin

reserve r1,r2 for Real;
reserve n,i,i1,i2,j for Element of NAT;
reserve D for non empty set;
reserve f for FinSequence of D;

theorem 
  for f being FinSequence of TOP-REAL n st 2<=len f holds f.1 in L~f & f
  /.1 in L~f & f.len f in L~f & f/.len f in L~f;

theorem 
  for p1,p2,q1,q2 being Point of TOP-REAL 2 st (p1`1 = p2`1 or p1
  `2 = p2`2)& q1 in LSeg(p1,p2) & q2 in LSeg(p1,p2) holds q1`1 = q2`1 or q1`2 =
  q2`2;

theorem 
  for p1,p2,q1,q2 being Point of TOP-REAL 2 st (p1`1 = p2`1 or p1
  `2 = p2`2)& LSeg(q1,q2) c= LSeg(p1,p2) holds q1`1 = q2`1 or q1`2 = q2`2;

theorem 
  for f being FinSequence of TOP-REAL 2,n being Element of NAT st
  2<=n & f is being_S-Seq holds f|n is being_S-Seq;

theorem 
  for f being FinSequence of TOP-REAL 2,n being Element of NAT st
  n<=len f & 2<=len f-'n & f is being_S-Seq holds f/^n is being_S-Seq;

theorem 
  for f being FinSequence of TOP-REAL 2,k1,k2 being Element of NAT st f
is being_S-Seq & 1<=k1 & k1<=len f & 1<=k2 & k2<=len f & k1<>k2 holds mid(f,k1,
  k2) is being_S-Seq;

begin





definition
  let f be FinSequence of TOP-REAL 2,p be Point of TOP-REAL 2;

  assume
 p in L~f;
  func Index(p,f) -> Element of NAT means


  ex S being non empty Subset of NAT st it = min S & S = { i: p in LSeg(f,i) };
end;

theorem 
  for f being FinSequence of TOP-REAL 2, p being Point of TOP-REAL
  2, i being Element of NAT st p in LSeg(f,i) holds Index(p,f) <= i;

theorem 
  for f being FinSequence of TOP-REAL 2, p being Point of TOP-REAL
  2 st p in L~f holds 1<=Index(p,f) & Index(p,f) < len f;

theorem 
  for f being FinSequence of TOP-REAL 2, p being Point of TOP-REAL
  2 st p in L~f holds p in LSeg(f,Index(p,f));

theorem 
  for f being FinSequence of TOP-REAL 2, p being Point of TOP-REAL
  2 st p in LSeg(f,1) holds Index(p,f) = 1;

theorem 
  for f being FinSequence of TOP-REAL 2, p being Point of TOP-REAL
  2 st len f >= 2 holds Index(f/.1,f) = 1;

theorem 
  for f being FinSequence of TOP-REAL 2, p being Point of TOP-REAL
2,i1 being Nat st f is being_S-Seq & 1<i1 & i1<=len f & p=f.i1 holds Index(p,f)
  + 1 = i1;

theorem 
  for f be FinSequence of TOP-REAL 2 for p be Point of TOP-REAL 2
  for i1 be Element of NAT st f is s.n.c. & p in LSeg(f,i1) holds i1=Index(p,f)
  or i1=Index(p,f)+1;

theorem 
  for f be FinSequence of TOP-REAL 2 for p be Point of TOP-REAL 2
for i1 be Element of NAT st f is unfolded s.n.c. & i1+1<=len f & p in LSeg(f,i1
  ) & p <> f.i1 holds i1=Index(p,f);

definition
  let g be FinSequence of TOP-REAL 2, p1,p2 be Point of TOP-REAL 2;
  pred g is_S-Seq_joining p1,p2 means


  g is being_S-Seq & g.1 = p1 & g. len g = p2;
end;

theorem 
  for g being FinSequence of TOP-REAL 2, p1,p2 being Point of
  TOP-REAL 2 st g is_S-Seq_joining p1,p2 holds Rev g is_S-Seq_joining p2,p1;

theorem 
  for f,g being FinSequence of TOP-REAL 2, p being Point of
TOP-REAL 2,j be Nat st p in L~f & g=<*p*>^mid(f,Index(p,f)+1,len f) & 1<=j & j+
  1<=len g holds LSeg(g,j) c= LSeg(f,Index(p,f)+j-'1);

theorem 
  for f,g being FinSequence of TOP-REAL 2, p being Point of TOP-REAL 2
st f is being_S-Seq & p in L~f & p<>f.(Index(p,f)+1) & g=<*p*>^mid(f,Index(p,f)
  +1,len f) holds g is_S-Seq_joining p,f/.len f;

theorem 
  for f,g being FinSequence of TOP-REAL 2, p being Point of
TOP-REAL 2,j be Nat st p in L~f & 1<=j & j+1<=len g & g=mid(f,1,Index(p,f))^<*p
  *> holds LSeg(g,j) c= LSeg(f,j);

theorem 
  for f,g being FinSequence of TOP-REAL 2, p being Point of
TOP-REAL 2 st f is being_S-Seq & p in L~f & p<>f.1 & g=mid(f,1,Index(p,f))^<*p
  *> holds g is_S-Seq_joining f/.1,p;

begin





definition
  let f be FinSequence of TOP-REAL 2,p be Point of TOP-REAL 2;
  func L_Cut(f,p) -> FinSequence of TOP-REAL 2 equals


  <*p*>^mid(f,Index
  (p,f)+1,len f) if p<>f.(Index(p,f)+1) otherwise mid(f,Index(p,f)+1,len f);
  func R_Cut(f,p) -> FinSequence of TOP-REAL 2 equals


  mid(f,1,Index(p,f
  ))^<*p*> if p<>f.1 otherwise <*p*>;
end;

theorem 
  for f being FinSequence of TOP-REAL 2, p being Point of TOP-REAL
  2 st f is being_S-Seq & p in L~f & p = f.(Index(p,f)+1) & p <> f.len f holds
  Index(p,Rev f) + Index(p,f) + 1 = len f;

theorem 
  for f be FinSequence of TOP-REAL 2 for p be Point of TOP-REAL 2
st f is unfolded s.n.c. & p in L~f & p <> f.(Index(p,f)+1) holds Index(p,Rev f)
  + Index(p,f) = len f;

theorem 
  for f being FinSequence of TOP-REAL 2, p being Point of TOP-REAL
  2 st f is being_S-Seq & p in L~f holds L_Cut(Rev f,p) = Rev R_Cut(f,p);

theorem 
  for f being FinSequence of TOP-REAL 2, p being Point of TOP-REAL
2 st p in L~f holds (L_Cut(f,p)).1=p & for i st 1<i & i<=len L_Cut(f,p) holds (
p = f.(Index(p,f)+1) implies (L_Cut(f,p)).i=f.(Index(p,f)+i)) & (p <> f.(Index(
  p,f)+1) implies (L_Cut(f,p)).i=f.(Index(p,f)+i-1));

theorem 
  for f be FinSequence of TOP-REAL 2 for p be Point of TOP-REAL 2
st p in L~f holds R_Cut(f,p).(len R_Cut(f,p)) = p & for i be Element of NAT st
  1<=i & i<=Index(p,f) holds R_Cut(f,p).i = f.i;

theorem 
  for f be FinSequence of TOP-REAL 2 for p be Point of TOP-REAL 2 st p
  in L~f holds ( p<>f.1 implies len R_Cut(f,p)=Index(p,f)+1 ) & ( p=f.1 implies
  len R_Cut(f,p)=Index(p,f) );

theorem 
  for f be FinSequence of TOP-REAL 2 for p be Point of TOP-REAL 2
st p in L~f holds ( p=f.(Index(p,f)+1) implies len L_Cut(f,p) = len f-Index(p,f
  ) ) & ( p<>f.(Index(p,f)+1) implies len L_Cut(f,p) = len f-Index(p,f)+1 );

definition
  let p1,p2,q1,q2 be Point of TOP-REAL 2;
  pred LE q1,q2,p1,p2 means


  q1 in LSeg(p1,p2) & q2 in LSeg(p1,p2) & for
r1,r2 being Real st 0<=r1 & r1<=1 & q1=(1-r1)*p1+r1*p2 & 0<=r2 & r2<=1 & q2=(1-
  r2)*p1+r2*p2 holds r1<=r2;
end;

definition
  let p1,p2,q1,q2 be Point of TOP-REAL 2;
  pred LT q1,q2,p1,p2 means


  LE q1,q2,p1,p2 & q1<>q2;
end;

theorem 
  for p1,p2,q1,q2 being Point of TOP-REAL 2 st LE q1,q2,p1,p2 & LE q2,q1
  ,p1,p2 holds q1=q2;

theorem 
  for p1,p2,q1,q2 being Point of TOP-REAL 2 st q1 in LSeg(p1,p2) &
q2 in LSeg(p1,p2) & p1<>p2 holds (LE q1,q2,p1,p2 or LT q2,q1,p1,p2) & not(LE q1
  ,q2,p1,p2 & LT q2,q1,p1,p2);

theorem 
  for f be FinSequence of TOP-REAL 2 for p,q be Point of TOP-REAL
  2 st p in L~f & q in L~f & Index(p,f)<Index(q,f) holds q in L~L_Cut(f,p);

theorem 
  for p,q,p1,p2 being Point of TOP-REAL 2 st LE p,q,p1,p2 holds q
  in LSeg(p,p2) & p in LSeg(p1,q);

theorem 
  for f be FinSequence of TOP-REAL 2 for p,q be Point of TOP-REAL
2 st p in L~f & q in L~f & p<>q & Index(p,f) = Index(q,f) & LE p,q,f/.(Index(p,
  f)),f/.(Index(p,f)+1) holds q in L~L_Cut(f,p);

begin






definition
  let f be FinSequence of TOP-REAL 2,p,q be Point of TOP-REAL 2;
  func B_Cut(f,p,q) -> FinSequence of TOP-REAL 2 equals


  R_Cut(L_Cut(f,p
),q) if p in L~f & q in L~f & Index(p,f)<Index(q,f) or Index(p,f)=Index(q,f) &
  LE p,q,f/.(Index(p,f)),f/.(Index(p,f)+1) otherwise Rev (R_Cut(L_Cut(f,q),p));
end;

theorem 
  for f being FinSequence of TOP-REAL 2, p being Point of TOP-REAL
2 st f is being_S-Seq & p in L~f & p<>f.1 holds R_Cut(f,p) is_S-Seq_joining f/.
  1,p;

theorem 
  for f being FinSequence of TOP-REAL 2, p being Point of TOP-REAL
2 st f is being_S-Seq & p in L~f & p<>f.len f holds L_Cut(f,p) is_S-Seq_joining
  p,f/.len f;

theorem 
  for f being FinSequence of TOP-REAL 2, p being Point of TOP-REAL
  2 st f is being_S-Seq & p in L~f & p<>f.len f holds L_Cut(f,p) is being_S-Seq
;

theorem 
  for f being FinSequence of TOP-REAL 2, p being Point of TOP-REAL
  2 st f is being_S-Seq & p in L~f & p<>f.1 holds R_Cut(f,p) is being_S-Seq;

theorem 
  for f being FinSequence of TOP-REAL 2, p,q being Point of
TOP-REAL 2 st f is being_S-Seq & p in L~f & q in L~f & p<>q holds B_Cut(f,p,q)
  is_S-Seq_joining p,q;

theorem 
  for f being FinSequence of TOP-REAL 2, p,q being Point of TOP-REAL 2
  st f is being_S-Seq & p in L~f & q in L~f & p<>q holds B_Cut(f,p,q) is
  being_S-Seq;

theorem 
  for f,g being FinSequence of TOP-REAL 2 st f.len f=g.1 & f is
  being_S-Seq & g is being_S-Seq & L~f /\ L~g={g.1} holds f^mid(g,2,len g) is
  being_S-Seq;

theorem 
  for f,g being FinSequence of TOP-REAL 2 st f.len f=g.1 & f is
  being_S-Seq & g is being_S-Seq & L~f /\ L~g={g.1} holds f^mid(g,2,len g)
  is_S-Seq_joining f/.1,g/.len g;

theorem 
  for f being FinSequence of TOP-REAL 2, n being Element of NAT holds L~
  (f/^n) c= L~f;

theorem 
  for f being FinSequence of TOP-REAL 2, p being Point of TOP-REAL
  2 st p in L~f holds L~R_Cut(f,p) c= L~f;

theorem 
  for f be FinSequence of TOP-REAL 2 for p be Point of TOP-REAL 2
  st p in L~f holds L~L_Cut(f,p) c= L~f;

theorem 
  for f,g being FinSequence of TOP-REAL 2, p being Point of
TOP-REAL 2 st f.len f=g.1 & p in L~f & f is being_S-Seq & g is being_S-Seq & L~
f /\ L~g={g.1} & p<>f.len f holds L_Cut(f,p)^mid(g,2,len g) is_S-Seq_joining p,
  g/.len g;

theorem 
  for f,g being FinSequence of TOP-REAL 2, p being Point of TOP-REAL 2
st f.len f=g.1 & p in L~f & f is being_S-Seq & g is being_S-Seq & L~f /\ L~g={g
  .1} & p<>f.len f holds L_Cut(f,p)^mid(g,2,len g) is being_S-Seq;

theorem 
  for f,g being FinSequence of TOP-REAL 2 st f.len f=g.1 & f is
being_S-Seq & g is being_S-Seq & L~f /\ L~g={g.1} holds mid(f,1,len f-'1)^g is
  being_S-Seq;

theorem 
  for f,g being FinSequence of TOP-REAL 2 st f.len f=g.1 & f is
  being_S-Seq & g is being_S-Seq & L~f /\ L~g={g.1} holds mid(f,1,len f-'1)^g
  is_S-Seq_joining f/.1,g/.len g;

theorem 
  for f,g being FinSequence of TOP-REAL 2, p being Point of
TOP-REAL 2 st f.len f=g.1 & p in L~g & f is being_S-Seq & g is being_S-Seq & L~
f /\ L~g={g.1} & p<>g.1 holds mid(f,1,len f -'1)^R_Cut(g,p) is_S-Seq_joining f
  /.1,p;

theorem 
  for f,g being FinSequence of TOP-REAL 2, p being Point of TOP-REAL 2
st f.len f=g.1 & p in L~g & f is being_S-Seq & g is being_S-Seq & L~f /\ L~g={g
  .1} & p<>g.1 holds mid(f,1,len f -'1)^R_Cut(g,p) is being_S-Seq;















begin 

theorem 
  for S being non empty non void ManySortedSign for o being
  OperSymbol of S for V being non-empty ManySortedSet of the carrier of S for x
  being set holds x is ArgumentSeq of Sym(o,V) iff x is Element of Args(o,
  FreeMSA V);

registration
  let S be non empty non void ManySortedSign;
  let V be non-empty ManySortedSet of the carrier of S;
  let o be OperSymbol of S;
  cluster -> DTree-yielding for Element of Args(o, FreeMSA V);
end;

theorem 
  for S being non empty non void ManySortedSign for A1,A2 being
  MSAlgebra over S st the Sorts of A1 is_transformable_to the Sorts of A2 for o
  being OperSymbol of S st Args(o,A1) <> {} holds Args(o,A2) <> {};

theorem 
  for S being non empty non void ManySortedSign for o being
  OperSymbol of S for V being non-empty ManySortedSet of the carrier of S for x
being Element of Args(o, FreeMSA V) holds Den(o,FreeMSA V).x = [o, the carrier
  of S]-tree x;

theorem 
  for S being non empty non void ManySortedSign for A,B being MSAlgebra
  over S st the MSAlgebra of A = the MSAlgebra of B for o being OperSymbol of S
  holds Den(o,A) = Den(o,B);

theorem 
  for S being non empty non void ManySortedSign for A1,A2,B1,B2
  being MSAlgebra over S st the MSAlgebra of A1 = the MSAlgebra of B1 & the
  MSAlgebra of A2 = the MSAlgebra of B2 for f being ManySortedFunction of A1,A2
for g being ManySortedFunction of B1,B2 st f = g for o being OperSymbol of S st
  Args(o,A1) <> {} & Args(o,A2) <> {} for x being Element of Args(o,A1) for y
  being Element of Args(o,B1) st x = y holds f#x = g#y;

theorem 
  for S being non empty non void ManySortedSign for A1,A2,B1,B2 being
  MSAlgebra over S st the MSAlgebra of A1 = the MSAlgebra of B1 & the MSAlgebra
of A2 = the MSAlgebra of B2 & the Sorts of A1 is_transformable_to the Sorts of
  A2 for h being ManySortedFunction of A1,A2 st h is_homomorphism A1,A2 ex h9
  being ManySortedFunction of B1,B2 st h9 = h & h9 is_homomorphism B1,B2;

definition
  let S be ManySortedSign;
  attr S is feasible means


  the carrier of S = {} implies the carrier' of S = {};
end;

theorem 
  for S being ManySortedSign holds S is feasible iff dom the
  ResultSort of S = the carrier' of S;

registration
  cluster non empty -> feasible for ManySortedSign;
  cluster void -> feasible for ManySortedSign;
  cluster empty feasible -> void for ManySortedSign;
  cluster non void feasible -> non empty for ManySortedSign;
end;

registration
  cluster non void non empty for ManySortedSign;
end;

theorem 
  for S being feasible ManySortedSign holds id the carrier of S, id
  the carrier' of S form_morphism_between S,S;

theorem 
  for S1,S2 being ManySortedSign for f,g being Function st f,g
  form_morphism_between S1,S2 holds f is Function of the carrier of S1, the
  carrier of S2 & g is Function of the carrier' of S1, the carrier' of S2;

begin 

definition
  let S be feasible ManySortedSign;
  mode Subsignature of S -> ManySortedSign means


    id the carrier of it, id the carrier' of it form_morphism_between it,S;
end;

theorem 
  for S being feasible ManySortedSign, T being Subsignature of S
holds the carrier of T c= the carrier of S & the carrier' of T c= the carrier'
  of S;

registration
  let S be feasible ManySortedSign;
  cluster -> feasible for Subsignature of S;
end;

theorem 
  for S being feasible ManySortedSign, T being Subsignature of S
holds the ResultSort of T c= the ResultSort of S & the Arity of T c= the Arity
  of S;

theorem 
  for S being feasible ManySortedSign, T being Subsignature of S
holds the Arity of T = (the Arity of S)|the carrier' of T & the ResultSort of T
  = (the ResultSort of S)|the carrier' of T;

theorem 
  for S,T being feasible ManySortedSign st the carrier of T c= the
  carrier of S & the Arity of T c= the Arity of S & the ResultSort of T c= the
  ResultSort of S holds T is Subsignature of S;

theorem 
  for S,T being feasible ManySortedSign st the carrier of T c= the
  carrier of S & the Arity of T = (the Arity of S)|the carrier' of T & the
  ResultSort of T = (the ResultSort of S)|the carrier' of T holds T is
  Subsignature of S;

theorem 
  for S being feasible ManySortedSign holds S is Subsignature of S;

theorem 
  for S1 being feasible ManySortedSign for S2 being Subsignature of S1
  for S3 being Subsignature of S2 holds S3 is Subsignature of S1;

theorem 
  for S1 being feasible ManySortedSign for S2 being Subsignature of S1
st S1 is Subsignature of S2 holds the ManySortedSign of S1 = the ManySortedSign
  of S2;

registration
  let S be non empty ManySortedSign;
  cluster non empty for Subsignature of S;
end;

registration
  let S be non void feasible ManySortedSign;
  cluster non void for Subsignature of S;
end;

theorem 
  for S being feasible ManySortedSign, S9 being Subsignature of S for T
being ManySortedSign, f,g being Function st f,g form_morphism_between S,T holds
  f|the carrier of S9, g|the carrier' of S9 form_morphism_between S9,T;

theorem 
  for S being ManySortedSign, T being feasible ManySortedSign for T9
  being Subsignature of T, f,g being Function st f,g form_morphism_between S,T9
  holds f,g form_morphism_between S,T;

theorem 
  for S being ManySortedSign, T being feasible ManySortedSign for T9
being Subsignature of T, f,g being Function st f,g form_morphism_between S,T &
  rng f c= the carrier of T9 & rng g c= the carrier' of T9 holds f,g
  form_morphism_between S,T9;

begin 

definition
  let S1,S2 be non empty ManySortedSign;
  let A be MSAlgebra over S2;
  let f,g be Function such that
 f,g form_morphism_between S1,S2;
  func A|(S1,f,g) -> strict MSAlgebra over S1 means


  the Sorts of it =
  (the Sorts of A)*f & the Charact of it = (the Charact of A)*g;
end;

definition
  let S2,S1 be non empty ManySortedSign;
  let A be MSAlgebra over S2;
  func A|S1 -> strict MSAlgebra over S1 equals

  A|(S1, id the carrier of S1, id
  the carrier' of S1);
end;

theorem 
  for S1,S2 being non empty ManySortedSign for A,B being MSAlgebra over
  S2 st the MSAlgebra of A = the MSAlgebra of B for f,g being Function st f,g
  form_morphism_between S1,S2 holds A|(S1,f,g) = B|(S1,f,g);

theorem 
  for S1,S2 being non empty ManySortedSign for A being non-empty
  MSAlgebra over S2 for f,g being Function st f,g form_morphism_between S1,S2
  holds A|(S1,f,g) is non-empty;

registration
  let S2 be non empty ManySortedSign;
  let S1 be non empty Subsignature of S2;
  let A be non-empty MSAlgebra over S2;
  cluster A|S1 -> non-empty;
end;

theorem 
  for S1,S2 being non void non empty ManySortedSign for f,g being
  Function st f,g form_morphism_between S1,S2 for A being MSAlgebra over S2 for
o1 being OperSymbol of S1, o2 being OperSymbol of S2 st o2 = g.o1 holds Den(o1,
  A|(S1,f,g)) = Den(o2,A);

theorem 
  for S1,S2 being non void non empty ManySortedSign for f,g being
  Function st f,g form_morphism_between S1,S2 for A being MSAlgebra over S2 for
o1 being OperSymbol of S1, o2 being OperSymbol of S2 st o2 = g.o1 holds Args(o2
  ,A) = Args(o1,A|(S1,f,g)) & Result(o1,A|(S1,f,g)) = Result(o2,A);

theorem 
  for S being non empty ManySortedSign for A being MSAlgebra over
  S holds A|(S, id the carrier of S, id the carrier' of S) = the MSAlgebra of A
;

theorem 
  for S being non empty ManySortedSign for A being MSAlgebra over S
  holds A|S = the MSAlgebra of A;

theorem 
  for S1,S2,S3 being non empty ManySortedSign for f1,g1 being
Function st f1,g1 form_morphism_between S1,S2 for f2,g2 being Function st f2,g2
form_morphism_between S2,S3 for A being MSAlgebra over S3 holds A|(S1,f2*f1,g2*
  g1) = (A|(S2,f2,g2))|(S1,f1,g1);

theorem 
  for S1 being non empty feasible ManySortedSign for S2 being non empty
  Subsignature of S1 for S3 being non empty Subsignature of S2 for A being
  MSAlgebra over S1 holds A|S3 = (A|S2)|S3;

theorem 
  for S1,S2 being non empty ManySortedSign for f being Function of
  the carrier of S1, the carrier of S2 for g being Function st f,g
  form_morphism_between S1,S2 for A1,A2 being MSAlgebra over S2 for h being
  ManySortedFunction of the Sorts of A1, the Sorts of A2 holds h*f is
  ManySortedFunction of the Sorts of A1|(S1,f,g), the Sorts of A2|(S1,f,g);

theorem 
  for S1 being non empty ManySortedSign for S2 being non empty
  Subsignature of S1 for A1,A2 being MSAlgebra over S1 for h being
  ManySortedFunction of the Sorts of A1, the Sorts of A2 holds h|the carrier of
  S2 is ManySortedFunction of the Sorts of A1|S2, the Sorts of A2|S2;

theorem 
  for S1,S2 being non empty ManySortedSign for f,g being Function
st f,g form_morphism_between S1,S2 for A being MSAlgebra over S2 holds (id the
  Sorts of A)*f = id the Sorts of A|(S1,f,g);

theorem 
  for S1 being non empty ManySortedSign for S2 being non empty
Subsignature of S1 for A being MSAlgebra over S1 holds (id the Sorts of A)|the
  carrier of S2 = id the Sorts of A|S2;

theorem 
  for S1,S2 being non void non empty ManySortedSign for f,g being
Function st f,g form_morphism_between S1,S2 for A,B being MSAlgebra over S2 for
h2 being ManySortedFunction of A,B for h1 being ManySortedFunction of A|(S1,f,g
),B|(S1,f,g) st h1 = h2*f for o1 being OperSymbol of S1, o2 being OperSymbol of
  S2 st o2 = g.o1 & Args(o2,A) <> {} & Args(o2,B) <> {} for x2 being Element of
Args(o2,A) for x1 being Element of Args(o1,A|(S1,f,g)) st x2 = x1 holds h1#x1 =
  h2#x2;

theorem 
  for S,S9 being non empty non void ManySortedSign for A1,A2 being
  MSAlgebra over S st the Sorts of A1 is_transformable_to the Sorts of A2 for h
  being ManySortedFunction of A1,A2 st h is_homomorphism A1,A2 for f being
  Function of the carrier of S9, the carrier of S for g being Function st f,g
form_morphism_between S9,S ex h9 being ManySortedFunction of A1|(S9,f,g), A2|(
  S9,f,g) st h9 = h*f & h9 is_homomorphism A1|(S9,f,g), A2|(S9,f,g);

theorem 
  for S being non void feasible ManySortedSign for S9 being non void
  Subsignature of S for A1,A2 being MSAlgebra over S st the Sorts of A1
is_transformable_to the Sorts of A2 for h being ManySortedFunction of A1,A2 st
h is_homomorphism A1,A2 ex h9 being ManySortedFunction of A1|S9, A2|S9 st h9 =
  h|the carrier of S9 & h9 is_homomorphism A1|S9, A2|S9;

theorem 
  for S,S9 being non empty non void ManySortedSign for A being
  non-empty MSAlgebra over S for f being Function of the carrier of S9, the
carrier of S for g being Function st f,g form_morphism_between S9,S for B being
non-empty MSAlgebra over S9 st B = A|(S9,f,g) for s1,s2 being SortSymbol of S9,
t being Function st t is_e.translation_of B, s1, s2 holds t is_e.translation_of
  A, f.s1, f.s2;

theorem 
  for S,S9 being non empty non void ManySortedSign for f being Function
  of the carrier of S9, the carrier of S for g being Function st f,g
  form_morphism_between S9,S for s1,s2 being SortSymbol of S9 st TranslationRel
  S9 reduces s1,s2 holds TranslationRel S reduces f.s1, f.s2;

theorem 
  for S,S9 being non void non empty ManySortedSign for A being non-empty
  MSAlgebra over S for f being Function of the carrier of S9, the carrier of S
  for g being Function st f,g form_morphism_between S9,S for B being non-empty
  MSAlgebra over S9 st B = A|(S9,f,g) for s1,s2 being SortSymbol of S9 st
TranslationRel S9 reduces s1,s2 for t being Translation of B, s1, s2 holds t is
  Translation of A, f.s1, f.s2;

begin 

scheme 

  GenFuncEx{S() -> non empty non void ManySortedSign, A() -> non-empty
MSAlgebra over S(), X() -> non-empty ManySortedSet of the carrier of S(), F(set
  ,set) -> set}: ex h being ManySortedFunction of FreeMSA X(), A() st h
  is_homomorphism FreeMSA X(), A() & for s being SortSymbol of S() for x being
  Element of X().s holds h.s.root-tree [x,s] = F(x,s)
provided
 for s being SortSymbol of S() for x being Element of X().s holds F(x
,s) in (the Sorts of A()).s;

theorem 
  for I being set, A,B being ManySortedSet of I for C being
ManySortedSubset of A for F being ManySortedFunction of A,B for i being set st
i in I for f,g being Function st f = F.i & g = (F||C).i for x being set st x in
  C.i holds g.x = f.x;

registration
  let S be non void non empty ManySortedSign;
  let X be non-empty ManySortedSet of the carrier of S;
  cluster FreeGen X -> non-empty;
end;

definition
  let S1,S2 be non empty non void ManySortedSign;
  let X be non-empty ManySortedSet of the carrier of S2;
  let f be Function of the carrier of S1, the carrier of S2;
  let g be Function such that
 f,g form_morphism_between S1,S2;
  func hom(f,g,X,S1,S2) -> ManySortedFunction of FreeMSA(X*f), (FreeMSA X)|(S1
  ,f,g) means


  it is_homomorphism FreeMSA(X*f), (FreeMSA X)|(S1,f,g) & for
s being SortSymbol of S1, x being Element of (X*f).s holds it.s.root-tree [x,s]
  = root-tree [x,f.s];
end;

theorem 
  for S1,S2 being non void non empty ManySortedSign for X being
  non-empty ManySortedSet of the carrier of S2 for f being Function of the
  carrier of S1, the carrier of S2 for g being Function st f,g
  form_morphism_between S1,S2 for o being OperSymbol of S1, p being Element of
Args(o,FreeMSA(X*f)) for q being FinSequence st q = hom(f,g,X,S1,S2)#p holds (
  hom(f,g,X,S1,S2).the_result_sort_of o).([o,the carrier of S1]-tree p) = [g.o,
  the carrier of S2]-tree q;

theorem 
  for S1,S2 being non void non empty ManySortedSign for X being
  non-empty ManySortedSet of the carrier of S2 for f being Function of the
  carrier of S1, the carrier of S2 for g being Function st f,g
form_morphism_between S1,S2 for t being Term of S1, X*f holds (hom(f,g,X,S1,S2)
  .the_sort_of t).t is CompoundTerm of S2, X iff t is CompoundTerm of S1, X*f;

theorem 
  for S1,S2 being non void non empty ManySortedSign for X being
  non-empty ManySortedSet of the carrier of S2 for f being Function of the
  carrier of S1, the carrier of S2 for g being one-to-one Function st f,g
form_morphism_between S1,S2 holds hom(f,g,X,S1,S2) is_monomorphism FreeMSA(X*f)
  , (FreeMSA X)|(S1,f,g);

theorem 
  for S being non void non empty ManySortedSign for X being non-empty
  ManySortedSet of the carrier of S holds hom(id the carrier of S, id the
  carrier' of S, X, S, S) = id the Sorts of FreeMSA X;

theorem 
  for S1,S2,S3 being non void non empty ManySortedSign for X being
  non-empty ManySortedSet of the carrier of S3 for f1 being Function of the
  carrier of S1, the carrier of S2 for g1 being Function st f1,g1
  form_morphism_between S1,S2 for f2 being Function of the carrier of S2, the
carrier of S3 for g2 being Function st f2,g2 form_morphism_between S2,S3 holds
  hom(f2*f1,g2*g1,X,S1,S3) = (hom(f2,g2,X,S2,S3)*f1)**hom(f1,g1,X*f2,S1,S2);














begin 

scheme 

  SubrelstrEx {L() -> non empty RelStr, P[set], a() -> set}: ex S being non
  empty full strict SubRelStr of L() st for x being Element of L() holds x is
  Element of S iff P[x]
provided
 P[a()] and
 a() in the carrier of L();

scheme 

  RelstrEq {L1, L2() -> non empty RelStr, P[set], Q[set,set]}: the RelStr of
  L1() = the RelStr of L2()
provided
 for x being set holds x is Element of L1() iff P[x] and
 for x being set holds x is Element of L2() iff P[x] and
 for a,b being Element of L1() holds a <= b iff Q[a,b] and
 for a,b being Element of L2() holds a <= b iff Q[a,b];

scheme 

  SubrelstrEq1 {L() -> non empty RelStr, S1, S2() -> non empty full SubRelStr
  of L(), P[set]}: the RelStr of S1() = the RelStr of S2()
provided
 for x being set holds x is Element of S1() iff P[x] and
 for x being set holds x is Element of S2() iff P[x];

scheme 

  SubrelstrEq2 {L() -> non empty RelStr, S1, S2() -> non empty full SubRelStr
  of L(), P[set]}: the RelStr of S1() = the RelStr of S2()
provided
 for x being Element of L() holds x is Element of S1() iff P[x] and
 for x being Element of L() holds x is Element of S2() iff P[x];

theorem 
  for R,Q being Relation holds (R c= Q iff R~ c= Q~) & (R~ c= Q iff R c= Q~);

theorem 
  for L,S being RelStr holds (S is SubRelStr of L iff S opp is
  SubRelStr of L opp) & (S opp is SubRelStr of L iff S is SubRelStr of L opp);

theorem 
  for L,S being RelStr holds (S is full SubRelStr of L iff S opp is
  full SubRelStr of L opp) & (S opp is full SubRelStr of L iff S is full
  SubRelStr of L opp);

definition
  let L be RelStr, S be full SubRelStr of L;
  redefine func S opp -> strict full SubRelStr of L opp;
end;

registration
  let X be set, L be non empty RelStr;
  cluster X --> L -> non-Empty;
end;

registration
  let S be RelStr, T be non empty reflexive RelStr;
  cluster monotone for Function of S,T;
end;

registration
  let L be non empty RelStr;
  cluster projection -> monotone idempotent for Function of L,L;
end;

registration
  let S,T be non empty reflexive RelStr;
  let f be monotone Function of S,T;
  cluster corestr f -> monotone;
end;

registration
  let L be non empty reflexive RelStr;
  cluster id L -> sups-preserving infs-preserving;
end;

theorem 
  for L being RelStr, S being Subset of L holds id S is Function of
subrelstr S, L & for f being Function of subrelstr S, L st f = id S holds f is
  monotone;

registration
  let L be non empty reflexive RelStr;
  cluster sups-preserving infs-preserving closure kernel one-to-one for
Function
    of L,L;
end;

theorem 
  for L being non empty reflexive RelStr, c being closure Function
  of L,L for x being Element of L holds c.x >= x;

theorem 
  for S,T being RelStr, R being SubRelStr of S for f being Function
  of the carrier of S, the carrier of T holds f|R = f|the carrier of R & for x
  being set st x in the carrier of R holds (f|R).x = f.x;

theorem 
  for S,T being RelStr, f being Function of S,T st f is one-to-one
  for R being SubRelStr of S holds f|R is one-to-one;

registration
  let S,T be non empty reflexive RelStr;
  let f be monotone Function of S,T;
  let R be SubRelStr of S;
  cluster f|R -> monotone;
end;

theorem 
  for S,T being non empty RelStr, R being non empty SubRelStr of S
for f being Function of S,T, g being Function of T,S st f is one-to-one & g = f
  " holds g|Image (f|R) is Function of Image (f|R), R & g|Image (f|R) = (f|R)";

begin 

registration
  let S be RelStr, T be non empty reflexive RelStr;
  cluster MonMaps(S,T) -> non empty;
end;

theorem 
  for S being RelStr, T being non empty reflexive RelStr, x being
  set holds x is Element of MonMaps(S,T) iff x is monotone Function of S,T;

definition

  let L be non empty reflexive RelStr;
  func ClOpers L -> non empty full strict SubRelStr of MonMaps(L,L) means


   for f being Function of L,L holds f is Element of it iff f is closure;
end;

theorem 
  for L being non empty reflexive RelStr, x being set holds x is
  Element of ClOpers L iff x is closure Function of L,L;

theorem 
  for X being set, L being non empty RelStr for f,g being Function
  of X, the carrier of L for x,y being Element of L|^X st x = f & y = g holds x
  <= y iff f <= g;

theorem 
  for L being complete LATTICE for c1,c2 being Function of L,L for
  x,y being Element of ClOpers L st x = c1 & y = c2 holds x <= y iff c1 <= c2;

theorem 
  for L being reflexive RelStr, S1, S2 being full SubRelStr of L
  st the carrier of S1 c= the carrier of S2 holds S1 is SubRelStr of S2;

theorem 
  for L being complete LATTICE for c1,c2 being closure Function of
  L,L holds c1 <= c2 iff Image c2 is SubRelStr of Image c1;

begin 

definition
  let L be RelStr;
  func Sub L -> strict non empty RelStr means


  ( for x being set holds
  x is Element of it iff x is strict SubRelStr of L) & for a,b being Element of
  it holds a <= b iff ex R being RelStr st b = R & a is SubRelStr of R;
end;

theorem 
  for L,R being RelStr for x,y being Element of Sub L st y = R
  holds x <= y iff x is SubRelStr of R;

registration
  let L be RelStr;
  cluster Sub L -> reflexive antisymmetric transitive;
end;

registration
  let L be RelStr;
  cluster Sub L -> complete;
end;

registration
  let L be complete LATTICE;
  cluster infs-inheriting -> non empty for SubRelStr of L;
  cluster sups-inheriting -> non empty for SubRelStr of L;
end;

definition
  let L be RelStr;
  mode System of L is full SubRelStr of L;
end;

notation
  let L be non empty RelStr;
  let S be System of L;
  synonym S is closure for S is infs-inheriting;
end;

registration
  let L be non empty RelStr;
  cluster subrelstr [#]L -> infs-inheriting sups-inheriting;
end;

definition
  let L be non empty RelStr;
  func ClosureSystems L -> full strict non empty SubRelStr of Sub L means


   for R being strict SubRelStr of L holds R is Element of it iff R is
  infs-inheriting full;
end;

theorem 
  for L being non empty RelStr, x being set holds x is Element of
  ClosureSystems L iff x is strict closure System of L;

theorem 
  for L being non empty RelStr, R being RelStr for x,y being
  Element of ClosureSystems L st y = R holds x <= y iff x is SubRelStr of R;

begin 

registration
  let L be non empty Poset;
  let h be closure Function of L,L;
  cluster Image h -> infs-inheriting;
end;

definition
  let L be non empty Poset;
  func ClImageMap L -> Function of ClOpers L, (ClosureSystems L) opp means


   for c being closure Function of L,L holds it.c = Image c;
end;

definition
  let L be non empty RelStr;
  let S be SubRelStr of L;
  func closure_op S -> Function of L,L means


  for x being Element of L
  holds it.x = "/\"((uparrow x) /\ the carrier of S,L);
end;

registration
  let L be complete LATTICE;
  let S be closure System of L;
  cluster closure_op S -> closure;
end;

theorem 
  for L being complete LATTICE for S being closure System of L
  holds Image closure_op S = the RelStr of S;

theorem 
  for L being complete LATTICE for c being closure Function of L,L
  holds closure_op Image c = c;

registration
  let L be complete LATTICE;
  cluster ClImageMap L -> one-to-one;
end;

theorem 
  for L being complete LATTICE holds (ClImageMap L)" is Function
  of (ClosureSystems L) opp, ClOpers L;

theorem 
  for L being complete LATTICE for S being strict closure System
  of L holds (ClImageMap L)".S = closure_op S;

registration
  let L be complete LATTICE;
  cluster ClImageMap L -> isomorphic;
end;

theorem 
  for L being complete LATTICE holds ClOpers L, (ClosureSystems L) opp
  are_isomorphic;

begin 


theorem 
  for L being RelStr, S being full SubRelStr of L for X being
  Subset of S holds (X is directed Subset of L implies X is directed) & (X is
  filtered Subset of L implies X is filtered);



theorem 
  for L being complete LATTICE for S being closure System of L
  holds closure_op S is directed-sups-preserving iff S is
  directed-sups-inheriting;

theorem 
  for L being complete LATTICE for h being closure Function of L,L holds
  h is directed-sups-preserving iff Image h is directed-sups-inheriting;

registration
  let L be complete LATTICE;
  let S be directed-sups-inheriting closure System of L;
  cluster closure_op S -> directed-sups-preserving;
end;

registration
  let L be complete LATTICE;
  let h be directed-sups-preserving closure Function of L,L;
  cluster Image h -> directed-sups-inheriting;
end;

definition
  let L be non empty reflexive RelStr;
  func DsupClOpers L -> non empty full strict SubRelStr of ClOpers L means


   for f being closure Function of L,L holds f is Element of it iff f is
  directed-sups-preserving;
end;

theorem 
  for L being non empty reflexive RelStr, x being set holds x is
Element of DsupClOpers L iff x is directed-sups-preserving closure Function of
  L,L;

definition
  let L be non empty RelStr;
  func Subalgebras L -> full strict non empty SubRelStr of ClosureSystems L
  means


  for R being strict closure System of L holds R is Element of it
  iff R is directed-sups-inheriting;
end;

theorem 
  for L being non empty RelStr, x being set holds x is Element of
  Subalgebras L iff x is strict directed-sups-inheriting closure System of L;

theorem 
  for L being complete LATTICE holds Image ((ClImageMap L)|
  DsupClOpers L) = (Subalgebras L) opp;

registration
  let L be complete LATTICE;
  cluster corestr ((ClImageMap L)|DsupClOpers L) -> isomorphic;
end;

theorem 
  for L being complete LATTICE holds DsupClOpers L, (Subalgebras L) opp
  are_isomorphic;














begin 

definition
  let I be set;
  let A,f be Function;
  func f-MSF(I,A) -> ManySortedFunction of I means


  for i being set st i in I holds it.i = f|(A.i);
end;

theorem 
  for I being set, A being ManySortedSet of I holds (id Union A)-MSF(I,A
  ) = id A;

theorem 
  for I being set, A,B being ManySortedSet of I for f,g being Function
  st rngs (f-MSF(I,A)) c= B holds (g*f)-MSF(I,A) = (g-MSF(I,B))**(f-MSF(I,A));

theorem 
  for f being Function, I being set for A,B being ManySortedSet of I st
for i being set st i in I holds A.i c= dom f & f.:(A.i) c= B.i holds f-MSF(I,A)
  is ManySortedFunction of A,B;

definition
  let S be non empty ManySortedSign;
  let A be MSAlgebra over S;

  attr A is empty means


  the Sorts of A is empty-yielding;
end;

registration
  let S be non empty ManySortedSign;
  cluster non-empty -> non empty for MSAlgebra over S;
end;

registration
  let S be non empty non void ManySortedSign;
  cluster strict non-empty disjoint_valued for MSAlgebra over S;
end;

registration
  let S be non empty non void ManySortedSign;
  let A be non empty MSAlgebra over S;
  cluster the Sorts of A -> non empty-yielding;
end;

registration
  cluster non empty-yielding for Function;
end;

begin 

definition
  let A be set;

  func CatSign A -> strict ManySortedSign means


  the carrier of it = [:
  {0},2-tuples_on A:] & the carrier' of it = [:{1},1-tuples_on A:] \/ [:{2},3
-tuples_on A:] & (for a being set st a in A holds (the Arity of it).[1,<*a*>] =
{} & (the ResultSort of it).[1,<*a*>] = [0,<*a,a*>]) & for a,b,c being set st a
in A & b in A & c in A holds (the Arity of it).[2,<*a,b,c*>] = <*[0,<*b,c*>],[0
  ,<*a,b*>]*> & (the ResultSort of it).[2,<*a,b,c*>] = [0,<*a,c*>];
end;

registration
  let A be set;
  cluster CatSign A -> feasible;
end;

registration
  let A be non empty set;
  cluster CatSign A -> non empty non void;
end;

definition
  mode Signature is feasible ManySortedSign;
end;

definition
  let S be Signature;
  attr S is Categorial means


  ex A being set st CatSign A is
  Subsignature of S & the carrier of S = [:{0},2-tuples_on A:];
end;

registration
  cluster Categorial -> non void for non empty Signature;
end;

registration
  cluster Categorial non empty strict for Signature;
end;

definition
  mode CatSignature is Categorial Signature;
end;

definition
  let A be set;
  mode CatSignature of A -> Signature means


    CatSign A is Subsignature
    of it & the carrier of it = [:{0},2-tuples_on A:];
end;

theorem 
  for A1,A2 being set, S being CatSignature of A1 st S is CatSignature
  of A2 holds A1 = A2;

registration
  let A be set;
  cluster -> Categorial for CatSignature of A;
end;

registration
  let A be non empty set;
  cluster -> non empty for CatSignature of A;
end;

registration
  let A be set;
  cluster strict for CatSignature of A;
end;

definition
  let A be set;
  redefine func CatSign A -> strict CatSignature of A;
end;

definition
  let S be ManySortedSign;
  func underlay S means


  for x being set holds x in it iff ex a being
set, f being Function st [a,f] in (the carrier of S) \/ (the carrier' of S) & x
  in rng f;
end;

theorem 
  for A being set holds underlay CatSign A = A;

definition
  let S be ManySortedSign;
  attr S is delta-concrete means


  ex f being Function of NAT,NAT st (
  for s being set st s in the carrier of S ex i being (Element of NAT), p being
FinSequence st s = [i,p] & len p = f.i & [:{i}, (f.i)-tuples_on underlay S:] c=
  the carrier of S) & (for o being set st o in the carrier' of S ex i being (
Element of NAT), p being FinSequence st o = [i,p] & len p = f.i & [:{i}, (f.i)
  -tuples_on underlay S:] c= the carrier' of S);
end;

registration
  let A be set;
  cluster CatSign A -> delta-concrete;
end;

registration
  cluster delta-concrete non empty strict for CatSignature;
  let A be set;
  cluster delta-concrete strict for CatSignature of A;
end;

theorem 
  for S being delta-concrete ManySortedSign, x being set st x in
the carrier of S or x in the carrier' of S ex i being (Element of NAT), p being
  FinSequence st x = [i,p] & rng p c= underlay S;

theorem 
  for S being delta-concrete ManySortedSign, i being set, p1,p2 being
FinSequence st [i,p1] in the carrier of S & [i,p2] in the carrier of S or [i,p1
  ] in the carrier' of S & [i,p2] in the carrier' of S holds len p1 = len p2;

theorem 
  for S being delta-concrete ManySortedSign, i being set, p1,p2 being
  FinSequence st len p2 = len p1 & rng p2 c= underlay S holds ([i,p1] in the
carrier of S implies [i,p2] in the carrier of S) & ([i,p1] in the carrier' of S
  implies [i,p2] in the carrier' of S);

theorem 
  for S being delta-concrete Categorial non empty Signature holds S is
  CatSignature of underlay S;

begin 

registration
  let S be non empty CatSignature;
  let s be SortSymbol of S;
  cluster s`2 -> Relation-like Function-like;
end;

registration
  let S be non empty delta-concrete ManySortedSign;
  let s be SortSymbol of S;
  cluster s`2 -> Relation-like Function-like;
end;

registration
  let S be non void delta-concrete ManySortedSign;
  let o be Element of the carrier' of S;
  cluster o`2 -> Relation-like Function-like;
end;

registration
  let S be non empty CatSignature;
  let s be SortSymbol of S;
  cluster s`2 -> FinSequence-like;
end;

registration
  let S be non empty delta-concrete ManySortedSign;
  let s be SortSymbol of S;
  cluster s`2 -> FinSequence-like;
end;

registration
  let S be non void delta-concrete ManySortedSign;
  let o be Element of the carrier' of S;
  cluster o`2 -> FinSequence-like;
end;

definition
  let a be set;
  func idsym a equals

  [1,<*a*>];
  let b be set;
  func homsym(a,b) equals

  [0,<*a,b*>];
  let c be set;
  func compsym(a,b,c) equals

  [2,<*a,b,c*>];
end;

theorem 
  for A being non empty set, S being CatSignature of A for a being
  Element of A holds idsym a in the carrier' of S & for b being Element of A
holds homsym(a,b) in the carrier of S & for c being Element of A holds compsym(
  a,b,c) in the carrier' of S;

definition
  let A be non empty set;
  let a be Element of A;
  redefine func idsym a -> OperSymbol of CatSign A;
  let b be Element of A;
  redefine func homsym(a,b) -> SortSymbol of CatSign A;
  let c be Element of A;
  redefine func compsym(a,b,c) -> OperSymbol of CatSign A;
end;

theorem 
  for a,b being set st idsym(a) = idsym(b) holds a = b;

theorem 
  for a1,b1,a2,b2 being set st homsym(a1,a2) = homsym(b1,b2) holds
  a1 = b1 & a2 = b2;

theorem 
  for a1,b1,a2,b2,a3,b3 being set st compsym(a1,a2,a3) = compsym(
  b1,b2,b3) holds a1 = b1 & a2 = b2 & a3 = b3;

theorem 
  for A being non empty set, S being CatSignature of A for s being
  SortSymbol of S ex a,b being Element of A st s = homsym(a,b);

theorem 
  for A being non empty set, o being OperSymbol of CatSign A holds
  o`1 = 1 & len o`2 = 1 or o`1 = 2 & len o`2 = 3;

theorem 
  for A being non empty set, o being OperSymbol of CatSign A st o
  `1 = 1 or len o`2 = 1 ex a being Element of A st o = idsym(a);

theorem 
  for A being non empty set, o being OperSymbol of CatSign A st o
  `1 = 2 or len o`2 = 3 ex a,b,c being Element of A st o = compsym(a,b,c);

theorem 
  for A being non empty set, a being Element of A holds the_arity_of
  idsym(a) = {} & the_result_sort_of idsym(a) = homsym(a,a);

theorem 
  for A being non empty set, a,b,c being Element of A holds the_arity_of
compsym(a,b,c) = <*homsym(b,c),homsym(a,b)*> & the_result_sort_of compsym(a,b,c
  ) = homsym(a,c);

begin 

definition
  let C1,C2 be Category;
  let F be Functor of C1,C2;
  func Upsilon F -> Function of the carrier of CatSign the carrier of C1, the
  carrier of CatSign the carrier of C2 means


  for s being SortSymbol of
  CatSign the carrier of C1 holds it.s = [0,(Obj F)*s`2];
  func Psi F -> Function of the carrier' of CatSign the carrier of C1, the
  carrier' of CatSign the carrier of C2 means


  for o being OperSymbol of
  CatSign the carrier of C1 holds it.o = [o`1,(Obj F)*o`2];
end;

theorem 
  for C1,C2 being Category, F being Functor of C1,C2 for a,b being
  Object of C1 holds (Upsilon F).homsym(a,b) = homsym(F.a,F.b);

theorem 
  for C1,C2 being Category, F being Functor of C1,C2 for a being
  Object of C1 holds (Psi F).idsym(a) = idsym(F.a);

theorem 
  for C1,C2 being Category, F being Functor of C1,C2 for a,b,c
  being Object of C1 holds (Psi F).compsym(a,b,c) = compsym(F.a,F.b,F.c);

theorem 
  for C1,C2 being Category, F being Functor of C1,C2 holds Upsilon
  F, Psi F form_morphism_between CatSign the carrier of C1, CatSign the carrier
  of C2;

begin 

theorem 
  for C being non empty set, A being MSAlgebra over CatSign C for
  a being Element of C holds Args(idsym(a), A) = {{}};

scheme 

  CatAlgEx { X, Y() -> non empty set, H(set,set) -> set, R(set,set,set,set,set
) -> set, I(set) -> set}: ex A being strict MSAlgebra over CatSign X() st (for
a,b being Element of X() holds (the Sorts of A).homsym(a,b) = H(a,b)) & (for a
being Element of X() holds Den(idsym(a),A).{} = I(a)) & for a,b,c being Element
  of X() for f,g being Element of Y() st f in H(a,b) & g in H(b,c) holds Den(
  compsym(a,b,c),A).<*g,f*> = R(a,b,c,g,f)
provided
 for a,b being Element of X() holds H(a,b) c= Y() and
 for a being Element of X() holds I(a) in H(a,a) and
 for a,b,c being Element of X() for f,g being Element of Y() st f in
H(a,b) & g in H(b,c) holds R(a,b,c,g,f) in H(a,c);

definition
  let C be Category;
  func MSAlg C -> strict MSAlgebra over CatSign the carrier of C means



  ( for a,b being Object of C holds (the Sorts of it).homsym(a,b) = Hom(a,b)) &
  (for a being Object of C holds Den(idsym(a),it).{} = id a) & for a,b,c being
Object of C for f,g being Morphism of C st dom f = a & cod f = b & dom g = b &
  cod g = c holds Den(compsym(a,b,c),it).<*g,f*> = g(*)f;
end;

theorem 
  for A being Category, a being Object of A holds Result(idsym a,
  MSAlg A) = Hom(a,a);

theorem 
  for A being Category, a,b,c being Object of A holds Args(compsym
  (a,b,c), MSAlg A) = product <*Hom(b,c), Hom(a,b)*> & Result(compsym(a,b,c),
  MSAlg A) = Hom(a,c);

registration
  let C be Category;
  cluster MSAlg C -> disjoint_valued feasible;
end;

theorem 
  for C1,C2 being Category, F being Functor of C1,C2 holds F-MSF(
  the carrier of CatSign the carrier of C1, the Sorts of MSAlg C1) is
ManySortedFunction of MSAlg C1, (MSAlg C2)|(CatSign the carrier of C1, Upsilon
  F, Psi F);

theorem 
  for C being Category, a,b,c being Object of C for x being set
holds x in Args(compsym(a,b,c), MSAlg C) iff ex g,f being Morphism of C st x =
  <*g,f*> & dom f = a & cod f = b & dom g = b & cod g = c;

theorem 
  for C1,C2 being Category, F being Functor of C1,C2 for a,b,c
being Object of C1 for f,g being Morphism of C1 st f in Hom(a,b) & g in Hom(b,c
  ) for x being Element of Args(compsym(a,b,c),MSAlg C1) st x = <*g,f*> for H
  being ManySortedFunction of MSAlg C1, (MSAlg C2)|(CatSign the carrier of C1,
  Upsilon F, Psi F) st H = F-MSF(the carrier of CatSign the carrier of C1, the
  Sorts of MSAlg C1) holds H#x = <*F.g,F.f*>;

theorem 
  for C being Category, a,b,c being Object of C, f,g being
Morphism of C st f in Hom(a,b) & g in Hom(b,c) holds Den(compsym(a,b,c), MSAlg
  C).<*g,f*> = g(*)f;

theorem 
  for C being Category, a,b,c,d being Object of C, f,g,h being Morphism
of C st f in Hom(a,b) & g in Hom(b,c) & h in Hom(c,d) holds Den(compsym(a,c,d),
  MSAlg C).<*h, Den(compsym(a,b,c), MSAlg C).<*g,f*>*> = Den(compsym(a,b,d),
  MSAlg C).<*Den(compsym(b,c,d), MSAlg C).<*h,g*>, f*>;

theorem 
  for C being Category, a,b being Object of C, f being Morphism of C st
f in Hom(a,b) holds Den(compsym(a,b,b), MSAlg C).<*id b, f*> = f & Den(compsym(
  a,a,b), MSAlg C).<*f, id a*> = f;

theorem 
  for C1,C2 being Category, F being Functor of C1,C2 ex H being
ManySortedFunction of MSAlg C1, (MSAlg C2)|(CatSign the carrier of C1, Upsilon
  F, Psi F) st H = F-MSF(the carrier of CatSign the carrier of C1, the Sorts of
MSAlg C1) & H is_homomorphism MSAlg C1, (MSAlg C2)|(CatSign the carrier of C1,
  Upsilon F, Psi F);















begin

definition
  let C be with_units non empty AltCatStr, o1, o2 be object of C, A be
  Morphism of o1,o2, B be Morphism of o2,o1;
  pred A is_left_inverse_of B means


  A * B = idm o2;
end;

notation
  let C be with_units non empty AltCatStr, o1, o2 be object of C, A be
  Morphism of o1,o2, B be Morphism of o2,o1;
  synonym B is_right_inverse_of A for A is_left_inverse_of B;
end;

definition
  let C be with_units non empty AltCatStr, o1, o2 be object of C, A be
  Morphism of o1,o2;
  attr A is retraction means


  ex B being Morphism of o2,o1 st B is_right_inverse_of A;
end;

definition
  let C be with_units non empty AltCatStr, o1, o2 be object of C, A be
  Morphism of o1,o2;
  attr A is coretraction means


  ex B being Morphism of o2,o1 st B is_left_inverse_of A;
end;

theorem 
  for C being with_units non empty AltCatStr, o being object of C
  holds idm o is retraction & idm o is coretraction;

definition
  let C be category, o1, o2 be object of C such that
 <^o1,o2^> <> {} and
 <^o2,o1^> <> {};
  let A be Morphism of o1,o2 such that
 A is retraction coretraction;
  func A" -> Morphism of o2,o1 means


  it is_left_inverse_of A & it is_right_inverse_of A;
end;

theorem 
  for C being category, o1,o2 being object of C st <^o1,o2^> <> {}
  & <^o2,o1^> <> {} for A being Morphism of o1,o2 st A is retraction & A is
  coretraction holds A" * A = idm o1 & A * A" = idm o2;

theorem 
  for C being category, o1,o2 being object of C st <^o1,o2^> <> {}
  & <^o2,o1^> <> {} for A being Morphism of o1,o2 st A is retraction & A is
  coretraction holds (A")" = A;

theorem 
  for C being category, o being object of C holds (idm o)" = idm o;

definition
  let C be category, o1, o2 be object of C, A be Morphism of o1,o2;
  attr A is iso means


  A*A" = idm o2 & A"*A = idm o1;
end;

theorem 
  for C being category, o1, o2 being object of C, A being Morphism
  of o1,o2 st A is iso holds A is retraction coretraction;

theorem 
  for C being category, o1,o2 being object of C st <^o1,o2^> <> {}
  & <^o2,o1^> <> {} for A being Morphism of o1,o2 holds A is iso iff A is
  retraction & A is coretraction;

theorem 
  for C being category, o1,o2,o3 being object of C, A being
Morphism of o1,o2, B being Morphism of o2,o3 st <^o1,o2^> <> {} & <^o2,o3^> <>
{} & <^o3,o1^> <> {} & A is iso & B is iso holds B * A is iso & (B * A)" = A" *
  B";

definition
  let C be category, o1, o2 be object of C;
  pred o1,o2 are_iso means


  <^o1,o2^> <> {} & <^o2,o1^> <> {} & ex A being Morphism of o1,o2 st A is iso;
  reflexivity;
  symmetry;
end;

theorem 
  for C being category, o1,o2,o3 being object of C st o1,o2 are_iso & o2
  ,o3 are_iso holds o1,o3 are_iso;

definition
  let C be non empty AltCatStr, o1, o2 be object of C, A be Morphism of o1,o2;
  attr A is mono means


  for o being object of C st <^o,o1^> <> {} for B,
  C being Morphism of o,o1 st A * B = A * C holds B = C;
end;

definition
  let C be non empty AltCatStr, o1, o2 be object of C, A be Morphism of o1,o2;
  attr A is epi means


  for o being object of C st <^o2,o^> <> {} for B,C
  being Morphism of o2,o st B * A = C * A holds B = C;
end;

theorem 
  for C being associative transitive non empty AltCatStr, o1,o2,
o3 being object of C st <^o1,o2^> <> {} & <^o2,o3^> <> {} for A being Morphism
  of o1,o2, B being Morphism of o2,o3 st A is mono & B is mono holds B * A is
  mono;

theorem 
  for C being associative transitive non empty AltCatStr, o1,o2,
o3 being object of C st <^o1,o2^> <> {} & <^o2,o3^> <> {} for A being Morphism
  of o1,o2, B being Morphism of o2,o3 st A is epi & B is epi holds B * A is epi
;

theorem 
  for C being associative transitive non empty AltCatStr, o1,o2,o3
being object of C st <^o1,o2^> <> {} & <^o2,o3^> <> {} for A being Morphism of
  o1,o2, B being Morphism of o2,o3 st B * A is mono holds A is mono;

theorem 
  for C being associative transitive non empty AltCatStr, o1,o2,o3
being object of C st <^o1,o2^> <> {} & <^o2,o3^> <> {} for A being Morphism of
  o1,o2, B being Morphism of o2,o3 st B * A is epi holds B is epi;

theorem 
  for X being non empty set for o1,o2 being object of EnsCat X st <^o1,
  o2^> <> {} for A being Morphism of o1,o2, F being Function of o1,o2 st F = A
  holds A is mono iff F is one-to-one;

theorem 
  for X being non empty with_non-empty_elements set for o1,o2 being
  object of EnsCat X st <^o1,o2^> <> {} for A being Morphism of o1,o2, F being
  Function of o1,o2 st F = A holds A is epi iff F is onto;

theorem 
  for C being category, o1,o2 being object of C st <^o1,o2^> <> {}
  & <^o2,o1^> <> {} for A being Morphism of o1,o2 st A is retraction holds A is
  epi;

theorem 
  for C being category, o1,o2 being object of C st <^o1,o2^> <> {}
& <^o2,o1^> <> {} for A being Morphism of o1,o2 st A is coretraction holds A is
  mono;

theorem 
  for C being category, o1,o2 being object of C st <^o1,o2^> <> {} & <^
  o2,o1^> <> {} for A being Morphism of o1,o2 st A is iso holds A is mono epi;

theorem 
  for C being category, o1,o2,o3 being object of C st <^o1,o2^> <>
  {} & <^o2,o3^> <> {} & <^o3,o1^> <> {} for A being Morphism of o1,o2, B being
Morphism of o2,o3 st A is retraction & B is retraction holds B*A is retraction;

theorem 
  for C being category, o1,o2,o3 being object of C st <^o1,o2^> <>
  {} & <^o2,o3^> <> {} & <^o3,o1^> <> {} for A being Morphism of o1,o2, B being
  Morphism of o2,o3 st A is coretraction & B is coretraction holds B*A is
  coretraction;

theorem 
  for C being category, o1, o2 being object of C, A being Morphism
  of o1,o2 st A is retraction & A is mono & <^o1,o2^> <> {} & <^o2,o1^> <> {}
  holds A is iso;

theorem 
  for C being category, o1, o2 being object of C, A being Morphism of o1
, o2 st A is coretraction & A is epi & <^o1,o2^> <> {} & <^o2,o1^> <> {} holds
  A is iso;

theorem 
  for C being category, o1,o2,o3 being object of C, A being Morphism of
o1, o2, B being Morphism of o2,o3 st <^o1,o2^> <> {} & <^o2,o3^> <> {} & <^o3,
  o1^> <> {} & B * A is retraction holds B is retraction;

theorem 
  for C being category, o1,o2,o3 being object of C, A being Morphism of
o1, o2, B being Morphism of o2,o3 st <^o1,o2^> <> {} & <^o2,o3^> <> {} & <^o3,
  o1^> <> {} & B * A is coretraction holds A is coretraction;

theorem 
  for C being category st for o1,o2 being object of C, A1 being Morphism
  of o1,o2 holds A1 is retraction holds for a,b being object of C,A being
  Morphism of a,b st <^a,b^> <> {} & <^b,a^> <> {} holds A is iso;

registration
  let C be with_units non empty AltCatStr, o be object of C;
  cluster mono epi retraction coretraction for Morphism of o,o;
end;

registration
  let C be category, o be object of C;
  cluster mono epi iso retraction coretraction for Morphism of o,o;
end;

registration
  let C be category, o be object of C, A, B be mono Morphism of o,o;
  cluster A * B -> mono;
end;

registration
  let C be category, o be object of C, A, B be epi Morphism of o,o;
  cluster A * B -> epi;
end;

registration
  let C be category, o be object of C, A, B be iso Morphism of o,o;
  cluster A * B -> iso;
end;

registration
  let C be category, o be object of C, A, B be retraction Morphism of o,o;
  cluster A * B -> retraction;
end;

registration
  let C be category, o be object of C, A, B be coretraction Morphism of o,o;
  cluster A * B -> coretraction;
end;

definition
  let C be AltGraph, o be object of C;
  attr o is initial means


  for o1 being object of C holds ex M being
  Morphism of o,o1 st M in <^o,o1^> & <^o,o1^> is trivial;
end;

theorem 
  for C being AltGraph, o being object of C holds o is initial iff for
  o1 being object of C holds ex M being Morphism of o,o1 st M in <^o,o1^> & for
  M1 being Morphism of o,o1 st M1 in <^o,o1^> holds M = M1;

theorem 
  for C being category, o1,o2 being object of C st o1 is initial &
  o2 is initial holds o1,o2 are_iso;

definition
  let C be AltGraph, o be object of C;
  attr o is terminal means


  for o1 being object of C holds ex M being
  Morphism of o1,o st M in <^o1,o^> & <^o1,o^> is trivial;
end;

theorem 
  for C being AltGraph, o being object of C holds o is terminal iff for
  o1 being object of C holds ex M being Morphism of o1,o st M in <^o1,o^> & for
  M1 being Morphism of o1,o st M1 in <^o1,o^> holds M = M1;

theorem 
  for C being category, o1,o2 being object of C st o1 is terminal & o2
  is terminal holds o1,o2 are_iso;

definition
  let C be AltGraph, o be object of C;
  attr o is _zero means


  o is initial terminal;
end;

theorem 
  for C being category, o1,o2 being object of C st o1 is _zero & o2 is
  _zero holds o1,o2 are_iso;

definition
  let C be non empty AltCatStr, o1, o2 be object of C, M be Morphism of o1,o2;
  attr M is _zero means


  for o being object of C st o is _zero for A
  being Morphism of o1,o, B being Morphism of o,o2 holds M = B*A;
end;

theorem 
  for C being category, o1,o2,o3 being object of C for M1 being Morphism
of o1,o2, M2 being Morphism of o2,o3 st M1 is _zero & M2 is _zero holds M2 * M1
  is _zero;














begin 


theorem 
  for X being functional set st for f, g being Function st f in X &
  g in X holds f tolerates g holds union X is Function;

scheme 

  PFSeparation {X, Y() -> set, P[set]}: ex PFS being Subset of PFuncs(X(), Y()
  ) st for pfs being PartFunc of X(), Y() holds pfs in PFS iff P[pfs];



registration
  let X be set;
  cluster nextcard X -> non empty;
end;

registration
  cluster regular for Aleph;
end;

theorem 
  for M being regular Aleph, X being set st X c= M & card X in M
  holds sup X in M;



theorem 
  for R being RelStr, x being set holds (the InternalRel of R)-Seg
  x c= the carrier of R;

definition
  let R be RelStr, X be Subset of R;
  redefine attr X is lower means


  for x, y being set st x in X & [y, x] in the InternalRel of R holds y in X;
end;

theorem 
  for R being RelStr, X being Subset of R, x being set st X is
  lower & x in X holds (the InternalRel of R)-Seg x c= X;

theorem 
  for R being RelStr, X being lower Subset of R, Y being Subset of
  R, x being set st Y = X \/ {x} & (the InternalRel of R)-Seg x c= X holds Y is
  lower;

begin 

definition
  let R be RelStr;
  attr R is well_founded means


  the InternalRel of R is_well_founded_in the carrier of R;
end;

registration
  cluster non empty well_founded for RelStr;
end;

definition
  let R be RelStr, X be Subset of R;
  attr X is well_founded means


  the InternalRel of R is_well_founded_in X;
end;

registration
  let R be RelStr;
  cluster well_founded for Subset of R;
end;

definition
  let R be RelStr;
  func well_founded-Part R -> Subset of R means


  it = union {S where S is Subset of R : S is well_founded lower};
end;

registration
  let R be RelStr;
  cluster well_founded-Part R -> lower well_founded;
end;

theorem 
  for R being non empty RelStr, x be Element of R holds {x} is
  well_founded Subset of R;

theorem 
  for R being RelStr, X, Y being well_founded Subset of R st X is
  lower holds X \/ Y is well_founded Subset of R;

theorem 
  for R being RelStr holds R is well_founded iff well_founded-Part
  R = the carrier of R;

theorem 
  for R being non empty RelStr, x being Element of R st (the
  InternalRel of R)-Seg x c= well_founded-Part R holds x in well_founded-Part R
;



scheme 

  WFMin {R() -> non empty RelStr, x() -> Element of R(), P[set]}: ex x being
Element of R() st P[x] & not ex y being Element of R() st x <> y & P[y] & [y,x]
  in the InternalRel of R()
provided
 P[x()] and
 R() is well_founded;



theorem 
  for R being non empty RelStr holds R is well_founded iff for S
  being set st for x being Element of R st (the InternalRel of R)-Seg x c= S
  holds x in S holds the carrier of R c= S;

scheme 

  WFInduction {R() -> non empty RelStr, P[set]}: for x being Element of R()
  holds P[x]
provided
 for x being Element of R() st for y being Element of R() st y <> x &
[y,x] in the InternalRel of R() holds P[y] holds P[x] and
 R() is well_founded;



definition
  let R be non empty RelStr, V be non empty set, H be Function of [:the
  carrier of R, PFuncs(the carrier of R, V):], V, F be Function;
  pred F is_recursively_expressed_by H means


  for x being Element of R holds F.x = H.(x, F|(the InternalRel of R)-Seg x);
end;



theorem 
  for R being non empty RelStr holds R is well_founded iff for V being
non empty set, H being Function of [:the carrier of R, PFuncs(the carrier of R,
  V):], V ex F being Function of the carrier of R, V st F
  is_recursively_expressed_by H;



theorem 
  for R being non empty RelStr, V being non trivial set st for H being
Function of [:the carrier of R, PFuncs(the carrier of R, V):], V, F1, F2 being
  Function of the carrier of R, V st F1 is_recursively_expressed_by H & F2
  is_recursively_expressed_by H holds F1 = F2 holds R is well_founded;



theorem 
  for R being non empty well_founded RelStr, V being non empty set, H
being Function of [:the carrier of R, PFuncs(the carrier of R, V):], V, F1, F2
being Function of the carrier of R, V st F1 is_recursively_expressed_by H & F2
  is_recursively_expressed_by H holds F1 = F2;



definition
  let R be RelStr, f be sequence of R;

  attr f is descending means


  for n being Nat holds f.(n+1)
  <> f.n & [f.(n+1), f.n] in the InternalRel of R;
end;



theorem 
  for R being non empty RelStr holds R is well_founded iff not ex f
  being sequence of R st f is descending;














begin 

theorem 
  for L be non empty reflexive transitive RelStr for x,y be Element
  of L holds x <= y implies compactbelow x c= compactbelow y;

theorem 
  for L be non empty reflexive RelStr for x be Element of L holds
  compactbelow x is Subset of CompactSublatt L;

theorem 
  for L be RelStr for S be SubRelStr of L for X be Subset of S
  holds X is Subset of L;

theorem 
  for L be with_suprema non empty reflexive transitive RelStr holds
  the carrier of L is Ideal of L;

theorem 
  for L1 be lower-bounded non empty reflexive antisymmetric RelStr
  for L2 be non empty reflexive antisymmetric RelStr st the RelStr of L1 = the
  RelStr of L2 & L1 is up-complete holds the carrier of CompactSublatt L1 = the
  carrier of CompactSublatt L2;

begin 

theorem 
  for L be algebraic lower-bounded LATTICE for S be CLSubFrame of L
  holds S is algebraic;

theorem 
  for X,E be set for L be CLSubFrame of BoolePoset X holds E in the
carrier of CompactSublatt L iff ex F be Element of BoolePoset X st F is finite
  & E = meet { Y where Y is Element of L : F c= Y } & F c= E;

theorem 
  for L be lower-bounded sup-Semilattice holds InclPoset Ids L is
  CLSubFrame of BoolePoset the carrier of L;

registration
  let L be non empty reflexive transitive RelStr;
  cluster principal for Ideal of L;
end;

theorem 
  for L be lower-bounded sup-Semilattice for X be non empty
  directed Subset of InclPoset Ids L holds sup X = union X;

theorem 
  for S be lower-bounded sup-Semilattice holds InclPoset Ids S is algebraic;

theorem 
  for S be lower-bounded sup-Semilattice for x be Element of
  InclPoset Ids S holds x is compact iff x is principal Ideal of S;

theorem 
  for S be lower-bounded sup-Semilattice for x be Element of
InclPoset Ids S holds x is compact iff ex a be Element of S st x = downarrow a;

theorem 
  for L be lower-bounded sup-Semilattice for f be Function of L,
CompactSublatt InclPoset Ids L st for x be Element of L holds f.x = downarrow x
  holds f is isomorphic;

theorem 
  for S be lower-bounded LATTICE holds InclPoset Ids S is arithmetic;

theorem 
  for L be lower-bounded sup-Semilattice holds CompactSublatt L is
  lower-bounded sup-Semilattice;

theorem 
  for L be algebraic lower-bounded sup-Semilattice for f be
Function of L,InclPoset Ids CompactSublatt L st for x be Element of L holds f.x
  = compactbelow x holds f is isomorphic;

theorem 
  for L be algebraic lower-bounded sup-Semilattice for x be Element of L
  holds compactbelow x is principal Ideal of CompactSublatt L iff x is compact;

begin 

theorem 
  for L1,L2 be non empty RelStr for X be Subset of L1, x be
Element of L1 for f be Function of L1,L2 st f is isomorphic holds x is_<=_than
  X iff f.x is_<=_than f.:X;

theorem 
  for L1,L2 be non empty RelStr for X be Subset of L1, x be
Element of L1 for f be Function of L1,L2 st f is isomorphic holds x is_>=_than
  X iff f.x is_>=_than f.:X;

theorem 
  for L1,L2 be non empty antisymmetric RelStr for f be Function of
  L1,L2 holds f is isomorphic implies f is infs-preserving sups-preserving;

registration
  let L1,L2 be non empty antisymmetric RelStr;
  cluster isomorphic -> infs-preserving sups-preserving for Function of L1,L2;
end;

theorem 
  for L1,L2,L3 be non empty transitive antisymmetric RelStr for f
  be Function of L1,L2 st f is infs-preserving holds L2 is full infs-inheriting
SubRelStr of L3 & L3 is complete implies ex g be Function of L1,L3 st f = g & g
  is infs-preserving;

theorem 
  for L1,L2,L3 be non empty transitive antisymmetric RelStr for f
be Function of L1,L2 st f is monotone directed-sups-preserving holds L2 is full
  directed-sups-inheriting SubRelStr of L3 & L3 is complete implies ex g be
  Function of L1,L3 st f = g & g is directed-sups-preserving;

theorem 
  for L be lower-bounded sup-Semilattice holds InclPoset Ids
  CompactSublatt L is CLSubFrame of BoolePoset the carrier of CompactSublatt L;

theorem 
  for L be algebraic lower-bounded LATTICE ex g be Function of L,
  BoolePoset the carrier of CompactSublatt L st g is infs-preserving & g is
directed-sups-preserving & g is one-to-one & for x be Element of L holds g.x =
  compactbelow x;

theorem 
  for I be non empty set for J be RelStr-yielding non-Empty
  reflexive-yielding ManySortedSet of I st for i be Element of I holds J.i is
  algebraic lower-bounded LATTICE holds product J is algebraic lower-bounded
  LATTICE;

theorem 
  for L1,L2 be non empty RelStr st the RelStr of L1 = the RelStr
  of L2 holds L1,L2 are_isomorphic;

theorem 
  for L1,L2 be up-complete non empty Poset for f be Function of
  L1,L2 st f is isomorphic for x,y be Element of L1 holds x << y iff f.x << f.y
;

theorem 
  for L1,L2 be up-complete non empty Poset for f be Function of
  L1,L2 st f is isomorphic for x be Element of L1 holds x is compact iff f.x is
  compact;

theorem 
  for L1,L2 be up-complete non empty Poset for f be Function of
  L1,L2 st f is isomorphic for x be Element of L1 holds f.:(compactbelow x) =
  compactbelow f.x;

theorem 
  for L1,L2 be non empty Poset st L1,L2 are_isomorphic & L1 is
  up-complete holds L2 is up-complete;

theorem 
  for L1,L2 be non empty Poset st L1,L2 are_isomorphic & L1 is
  complete satisfying_axiom_K holds L2 is satisfying_axiom_K;

theorem 
  for L1,L2 be sup-Semilattice st L1,L2 are_isomorphic & L1 is
  lower-bounded algebraic holds L2 is algebraic;

theorem 
  for L be continuous lower-bounded sup-Semilattice holds SupMap L is
  infs-preserving sups-preserving;



theorem 
  for L be lower-bounded LATTICE holds ( L is algebraic implies ex X be
non empty set, S be full SubRelStr of BoolePoset X st S is infs-inheriting & S
is directed-sups-inheriting & L,S are_isomorphic ) & (( ex X be set, S be full
  SubRelStr of BoolePoset X st S is infs-inheriting & S is
  directed-sups-inheriting & L,S are_isomorphic ) implies L is algebraic );



theorem 
  for L be lower-bounded LATTICE holds ( L is algebraic implies ex X be
  non empty set, c be closure Function of BoolePoset X,BoolePoset X st c is
  directed-sups-preserving & L,Image c are_isomorphic ) & (( ex X be set, c be
closure Function of BoolePoset X,BoolePoset X st c is directed-sups-preserving
  & L,Image c are_isomorphic ) implies L is algebraic );















begin 

reserve i, i1, i2, j, k for Element of NAT,
  r, s for Real;

theorem 
  for i, j being Nat holds j<i & i<j+j implies i mod j<>0;

theorem 
  for i,j being Nat holds j<=i & i<j+j implies i mod j=i-j & i mod j=i-'j;

theorem 
  for i,j being Nat holds (j+j)mod j=0;

theorem 
  for j,k being Nat holds 0<k & k<=j & k mod j=0 implies k=j;

begin 

reserve D for non empty set,
  f1 for FinSequence of D;

theorem 
  for f1 st f1 is circular & 1<=len f1 holds f1.1=f1.len f1;

theorem 
  for f1,k st k<len f1 holds (f1/^k).len (f1/^k)=f1.len f1 & (f1/^
  k)/.len (f1/^k)=f1/.len f1;

theorem 
  for g being FinSequence of TOP-REAL 2,i st g is being_S-Seq & i+
  1<len g holds g/^i is being_S-Seq;

theorem 
  for f1,i1,i2 st 1<=i2 & i2<=i1 & i1<=len f1 holds len mid(f1,i2, i1)=i1-'i2+1
;

theorem 
  for f1,i1,i2 st 1<=i2 & i2<=i1 & i1<=len f1 holds len mid(f1,i1, i2)=i1-'i2+1
;

theorem 
  for f1,i1,i2,j st 1<=i1 & i1<=i2 & i2<=len f1 holds mid(f1,i1,i2
  ).(len mid(f1,i1,i2))=f1.i2;

theorem 
  for f1,i1,i2,j st 1<=i1 & i1<=len f1 & 1<=i2 & i2<=len f1 holds
  mid(f1,i1,i2).(len mid(f1,i1,i2))=f1.i2;

theorem 
  for f1,i1,i2,j st 1<=i2 & i2<=i1 & i1<=len f1 & 1<=j & j<=i1-'i2
  +1 holds mid(f1,i1,i2).j=f1.(i1-'j+1);

theorem 
  for f1,i1,i2 st 1<=i2 & i2<=i1 & i1<=len f1 & 1<=j & j<=i1-'i2+1
  holds mid(f1,i1,i2).j=mid(f1,i2,i1).(i1-i2+1-j+1) & i1-i2+1-j+1=i1-'i2+1-'j+1
;

theorem 
  for f1,i1,i2 st 1<=i1 & i1<=i2 & i2<=len f1 & 1<=j & j<=i2-'i1+1 holds
  mid(f1,i1,i2).j=mid(f1,i2,i1).(i2-i1+1-j+1) & i2-i1+1-j+1=i2-'i1+1-'j+1;

theorem 
  for f1,k st 1<=k & k<=len f1 holds mid(f1,k,k)=<*f1/.k*> & len mid(f1,k,k)=1;

theorem 
  mid(f1,0,0)=f1|1;

theorem 
  for f1,k st len f1<k holds mid(f1,k,k)=<*>D;

theorem 
  for f1,i1,i2 holds mid(f1,i1,i2)=Rev mid(f1,i2,i1);

theorem 
  for f being FinSequence of TOP-REAL 2,i1,i2,i st 1<=i1 & i1<i2 &
  i2<=len f & 1<=i & i<i2-'i1+1 holds LSeg(mid(f,i1,i2),i)=LSeg(f,i+i1-'1);

theorem 
  for f being FinSequence of TOP-REAL 2,i1,i2,i st 1<=i1 & i1<i2 &
  i2<=len f & 1<=i & i<i2-'i1+1 holds LSeg(mid(f,i2,i1),i)=LSeg(f,i2-'i);

begin 

definition
  let n be Element of NAT, f be FinSequence;
  func S_Drop(n,f) -> Element of NAT equals


  (n mod (len f -'1)) if n
  mod (len f -'1)<>0 otherwise len f -'1;
end;

theorem 
  for f being FinSequence holds S_Drop(len f-'1,f)=len f-'1;

theorem 
  for n being Element of NAT, f being FinSequence st 1<=n & n<=len
  f-'1 holds S_Drop(n,f)=n;

theorem 
  for n being Element of NAT,f being FinSequence holds S_Drop(n,f)
  =S_Drop(n+(len f-'1),f) & S_Drop(n,f)=S_Drop(len f-'1+n,f);

definition
  let f be non constant standard special_circular_sequence, g be FinSequence
  of TOP-REAL 2,i1,i2 be Element of NAT;
  pred g is_a_part>_of f,i1,i2 means


  1<=i1 & i1+1<=len f & 1<=i2 & i2+1
<=len f & g.len g=f.i2 & 1<=len g & len g<len f & for i being Nat st 1<=i & i<=
  len g holds g.i=f.S_Drop((i1+i)-'1,f);
end;

definition
  let f be non constant standard special_circular_sequence, g be FinSequence
  of TOP-REAL 2,i1,i2 be Element of NAT;
  pred g is_a_part<_of f,i1,i2 means


  1<=i1 & i1+1<=len f & 1<=i2 & i2+1
<=len f & g.len g=f.i2 & 1<=len g & len g<len f & for i being Nat st 1<=i & i<=
  len g holds g.i=f.S_Drop(len f +i1-'i,f);
end;

definition
  let f be non constant standard special_circular_sequence, g be FinSequence
  of TOP-REAL 2,i1,i2 be Element of NAT;
  pred g is_a_part_of f,i1,i2 means


  g is_a_part>_of f,i1,i2 or g is_a_part<_of f,i1,i2;
end;

theorem 
  for f being non constant standard special_circular_sequence, g being
FinSequence of TOP-REAL 2,i1,i2 being Element of NAT st g is_a_part_of f,i1,i2
holds 1<=i1 & i1+1<=len f & 1<=i2 & i2+1<=len f & g.len g=f.i2 & 1<=len g & len
g<len f & ((for i being Element of NAT st 1<=i & i<=len g holds g.i=f.S_Drop((
i1+i)-'1,f))or for i being Element of NAT st 1<=i & i<=len g holds g.i=f.S_Drop
  (len f +i1-'i,f) );

theorem 
  for f being non constant standard special_circular_sequence, g
being FinSequence of TOP-REAL 2,i1,i2 being Element of NAT st g is_a_part>_of f
  ,i1,i2 & i1<=i2 holds len g=i2-'i1+1 & g=mid(f,i1,i2);

theorem 
  for f being non constant standard special_circular_sequence, g
being FinSequence of TOP-REAL 2,i1,i2 being Element of NAT st g is_a_part>_of f
,i1,i2 & i1>i2 holds len g=len f+i2-'i1 & g=mid(f,i1,len f-'1)^(f|i2) & g=mid(f
  ,i1,len f-'1)^mid(f,1,i2);

theorem 
  for f being non constant standard special_circular_sequence, g
being FinSequence of TOP-REAL 2,i1,i2 being Element of NAT st g is_a_part<_of f
  ,i1,i2 & i1>=i2 holds len g=i1-'i2+1 & g=mid(f,i1,i2);

theorem 
  for f being non constant standard special_circular_sequence, g
being FinSequence of TOP-REAL 2,i1,i2 being Element of NAT st g is_a_part<_of f
  ,i1,i2 & i1<i2 holds len g=len f+i1-'i2 & g=mid(f,i1,1)^mid(f,len f-'1,i2);

theorem 
  for f being non constant standard special_circular_sequence, g
being FinSequence of TOP-REAL 2,i1,i2 being Element of NAT st g is_a_part>_of f
  ,i1,i2 holds Rev g is_a_part<_of f,i2,i1;

theorem 
  for f being non constant standard special_circular_sequence, g
being FinSequence of TOP-REAL 2,i1,i2 being Element of NAT st g is_a_part<_of f
  ,i1,i2 holds Rev g is_a_part>_of f,i2,i1;

theorem 
  for f being non constant standard special_circular_sequence, i1,
  i2 being Element of NAT st 1<=i1 & i1<=i2 & i2<len f holds mid(f,i1,i2)
  is_a_part>_of f,i1,i2;

theorem 
  for f being non constant standard special_circular_sequence, i1,
  i2 being Element of NAT st 1<=i1 & i1<=i2 & i2<len f holds mid(f,i2,i1)
  is_a_part<_of f,i2,i1;

theorem 
  for f being non constant standard special_circular_sequence, i1,
  i2 being Element of NAT st 1<=i2 & i1>i2 & i1<len f holds mid(f,i1,len f-'1)^
  mid(f,1,i2) is_a_part>_of f,i1,i2;

theorem 
  for f being non constant standard special_circular_sequence, i1,
i2 being Element of NAT st 1<=i1 & i1<i2 & i2<len f holds mid(f,i1,1)^mid(f,len
  f-'1,i2) is_a_part<_of f,i1,i2;

theorem 
  for h being FinSequence of TOP-REAL 2,i1,i2 st 1<=i1 & i1<=len h
  & 1<=i2 & i2<=len h holds L~mid(h,i1,i2) c= L~h;

theorem 
  for g being FinSequence of D holds g is one-to-one iff for i1,i2
st 1<=i1 & i1<=len g & 1<=i2 & i2<=len g & (g.i1=g.i2 or g/.i1=g/.i2) holds i1=
  i2;

theorem 
  for f being non constant standard special_circular_sequence, i2
  st 1<i2 & i2+1<=len f holds f|i2 is being_S-Seq;

theorem 
  for f being non constant standard special_circular_sequence, i2
  st 1<=i2 & i2+1<len f holds f/^i2 is being_S-Seq;

theorem 
  for f being non constant standard special_circular_sequence, i1,
  i2 st 1<=i1 & i1<i2 & i2+1<=len f holds mid(f,i1,i2) is being_S-Seq;

theorem 
  for f being non constant standard special_circular_sequence, i1,
  i2 st 1<i1 & i1<i2 & i2<=len f holds mid(f,i1,i2) is being_S-Seq;

theorem 
  for p0,p,q1,q2 being Point of TOP-REAL 2 st p0 in LSeg(p,q1) &
  p0 in LSeg(p,q2) & p<>p0 holds q1 in LSeg(p,q2) or q2 in LSeg(p,q1);

theorem 
  for f being non constant standard special_circular_sequence
  holds LSeg(f,1)/\ LSeg(f,len f-'1)={f.1};

theorem 
  for f being non constant standard special_circular_sequence, i1,
i2 being Element of NAT,g1,g2 being FinSequence of TOP-REAL 2 st 1<=i1 & i1<i2
& i2<len f & g1=mid(f,i1,i2) & g2=mid(f,i1,1)^mid(f,len f-'1,i2) holds (L~g1)/\
  (L~g2)={f.i1,f.i2} & (L~g1) \/ (L~g2)=L~f;

theorem 
  for f being non constant standard special_circular_sequence, g
being FinSequence of TOP-REAL 2,i1,i2 being Element of NAT st g is_a_part>_of f
  ,i1,i2 & i1<i2 holds L~g is_S-P_arc_joining f/.i1,f/.i2;

theorem 
  for f being non constant standard special_circular_sequence, g being
FinSequence of TOP-REAL 2,i1,i2 being Element of NAT st g is_a_part<_of f,i1,i2
  & i1>i2 holds L~g is_S-P_arc_joining f/.i1,f/.i2;

theorem 
  for f being non constant standard special_circular_sequence, g
being FinSequence of TOP-REAL 2,i1,i2 being Element of NAT st g is_a_part>_of f
  ,i1,i2 & i1<>i2 holds L~g is_S-P_arc_joining f/.i1,f/.i2;

theorem 
  for f being non constant standard special_circular_sequence, g
being FinSequence of TOP-REAL 2,i1,i2 being Element of NAT st g is_a_part<_of f
  ,i1,i2 & i1<>i2 holds L~g is_S-P_arc_joining f/.i1,f/.i2;

theorem 
  for f being non constant standard special_circular_sequence, g
being FinSequence of TOP-REAL 2,i1,i2 being Element of NAT st g is_a_part_of f,
  i1,i2 & i1<>i2 holds L~g is_S-P_arc_joining f/.i1,f/.i2;

theorem 
  for f being non constant standard special_circular_sequence, g being
FinSequence of TOP-REAL 2,i1,i2 being Element of NAT st g is_a_part_of f,i1,i2
  & g.1<>g.len g holds L~g is_S-P_arc_joining f/.i1,f/.i2;

theorem 
  for f being non constant standard special_circular_sequence, i1,
  i2 being Element of NAT st 1<=i1 & i1+1<=len f & 1<=i2 & i2+1<=len f & i1<>i2
holds ex g1,g2 being FinSequence of TOP-REAL 2 st g1 is_a_part_of f,i1,i2 & g2
is_a_part_of f,i1,i2 & (L~g1)/\(L~g2)={f.i1,f.i2} & (L~g1) \/ (L~g2)=L~f & L~g1
  is_S-P_arc_joining f/.i1,f/.i2 & L~g2 is_S-P_arc_joining f/.i1,f/.i2 & for g
  being FinSequence of TOP-REAL 2 st g is_a_part_of f,i1,i2 holds g=g1 or g=g2;

reserve g, g1, g2 for FinSequence of TOP-REAL 2;

theorem 
  for f being non constant standard special_circular_sequence, P being
non empty Subset of TOP-REAL 2 st P = L~f holds P is being_simple_closed_curve;

theorem 
  for f being non constant standard special_circular_sequence, g1,
  g2 st g1 is_a_part>_of f,i1,i2 & g2 is_a_part>_of f,i1,i2 holds g1=g2;

theorem 
  for f being non constant standard special_circular_sequence, g1,
  g2 st g1 is_a_part<_of f,i1,i2 & g2 is_a_part<_of f,i1,i2 holds g1=g2;

theorem 
  for f being non constant standard special_circular_sequence, g1,
g2 st i1<>i2 & g1 is_a_part>_of f,i1,i2 & g2 is_a_part<_of f,i1,i2 holds g1.2<>
  g2.2;

theorem 
  for f being non constant standard special_circular_sequence, g1,
  g2 st i1<>i2 & g1 is_a_part_of f,i1,i2 & g2 is_a_part_of f,i1,i2 & g1.2=g2.2
  holds g1=g2;

definition
  let f be non constant standard special_circular_sequence, i1,i2 be Element
  of NAT;
  assume that
 1<=i1 and
 i1+1<=len f and
 1<=i2 and
 i2+1<=len f and
 i1<>i2;
  func Lower (f,i1,i2) -> FinSequence of TOP-REAL 2 means

  it is_a_part_of f,i1
,i2 & ((f/.(i1+1))`1<(f/.i1)`1 or (f/.(i1+1))`2<(f/.i1)`2 implies it.2=f.(i1+1)
)& ((f/.(i1+1))`1>=(f/.i1)`1 & (f/.(i1+1))`2>=(f/.i1)`2 implies it.2=f.S_Drop(
  i1-'1,f));
  func Upper (f,i1,i2) -> FinSequence of TOP-REAL 2 means

  it is_a_part_of f,i1
,i2 & ((f/.(i1+1))`1>(f/.i1)`1 or (f/.(i1+1))`2>(f/.i1)`2 implies it.2=f.(i1+1)
)& ((f/.(i1+1))`1<=(f/.i1)`1 & (f/.(i1+1))`2<=(f/.i1)`2 implies it.2=f.S_Drop(
  i1-'1,f));
end;














begin 

reserve V, C for set;

definition
  let V, C;
  func SubstitutionSet (V, C) -> Subset of Fin PFuncs (V, C) equals

  { A where
  A is Element of Fin PFuncs (V,C) : ( for u being set st u in A holds u is
finite ) & for s, t being Element of PFuncs (V, C) holds ( s in A & t in A & s
  c= t implies s = t ) };
end;

theorem 
  {} in SubstitutionSet (V, C);

theorem 
  { {} } in SubstitutionSet (V, C);

registration
  let V, C;
  cluster SubstitutionSet (V, C) -> non empty;
end;

definition
  let V, C;
  let A, B be Element of SubstitutionSet (V, C);
  redefine func A \/ B -> Element of Fin PFuncs (V, C);
end;

registration
  let V, C;
  cluster non empty for Element of SubstitutionSet (V, C);
end;

registration
  let V, C;
  cluster -> finite for Element of SubstitutionSet (V, C);
end;

definition
  let V, C;
  let A be Element of Fin PFuncs (V, C);
  func mi A -> Element of SubstitutionSet (V, C) equals

  { t where t is Element
of PFuncs (V, C) : t is finite & for s being Element of PFuncs (V, C) holds ( s
  in A & s c= t iff s = t ) };
end;

registration
  let V, C;
  cluster -> functional for Element of SubstitutionSet(V, C);
end;

definition
  let V, C;
  let A, B be Element of Fin PFuncs (V, C);
  func A^B -> Element of Fin PFuncs (V, C) equals

  { s \/ t where s,t is
  Element of PFuncs (V,C) : s in A & t in B & s tolerates t };
end;

reserve A, B, D for Element of Fin PFuncs (V, C);

theorem 
  A^B = B^A;

theorem 
  B = { {} } implies A ^ B = A;

theorem 
  for a, b be set holds B in SubstitutionSet (V, C) & a in B & b in
  B & a c= b implies a = b;

theorem 
  for a be set holds a in mi B implies a in B & for b be set holds
  b in B & b c= a implies b = a;

reserve s for Element of PFuncs (V,C);

registration
  let V, C;
  cluster finite for Element of PFuncs (V,C);
end;

theorem 
  for a be finite set holds a in B & (for b be finite set st b in B
  & b c= a holds b = a) implies a in mi B;

theorem 
  mi A c= A;

theorem 
  A = {} implies mi A = {};

theorem 
  for b be finite set holds b in B implies ex c be set st c c= b & c in mi B;

theorem 
  for K be Element of SubstitutionSet (V, C) holds mi K = K;

theorem 
  mi (A \/ B) c= mi A \/ B;

theorem 
  mi(mi A \/ B) = mi (A \/ B);

theorem 
  A c= B implies A ^ D c= B ^ D;

theorem 
  for a be set holds a in A^B implies ex b,c be set st b in A & c
  in B & a = b \/ c;

theorem 
  for b, c be Element of PFuncs (V, C) holds b in A & c in B & b
  tolerates c implies b \/ c in A^B;

theorem 
  mi(A ^ B) c= mi A ^ B;

theorem 
  A c= B implies D ^ A c= D ^ B;

theorem 
  mi(mi A ^ B) = mi (A ^ B);

theorem 
  mi(A ^ mi B) = mi (A ^ B);

theorem 
  for K, L, M being Element of Fin PFuncs (V, C) holds K^(L^M) = K ^L^M;

theorem 
  for K, L, M being Element of Fin PFuncs (V, C) holds K^(L \/ M) = K^L \/ K^M;

theorem 
  B c= B ^ B;

theorem 
  mi (A ^ A) = mi A;

theorem 
  for K be Element of SubstitutionSet (V, C) holds mi (K^K) = K;

begin 

definition
  let V, C;
  func SubstLatt (V, C) -> strict LattStr means


  the carrier of it =
SubstitutionSet (V, C) & for A, B being Element of SubstitutionSet (V, C) holds
  (the L_join of it).(A,B) = mi (A \/ B) & (the L_meet of it).(A,B) = mi (A^B);
end;

registration
  let V, C;
  cluster SubstLatt (V, C) -> non empty;
end;

reserve K, L, M for Element of SubstitutionSet (V,C);

registration
  let V, C;
  cluster SubstLatt (V, C) -> Lattice-like;
end;

registration
  let V, C;
  cluster SubstLatt (V, C) -> distributive bounded;
end;

theorem 
  Bottom SubstLatt (V,C) = {};

theorem 
  Top SubstLatt (V,C) = { {} };














begin  

reserve I for set;

theorem 
  for A being set, B, C being non empty set for f being Function of
  A, B, g being Function of B, C st rng (g * f) = C holds rng g = C;

theorem 
  for A being ManySortedSet of I, B, C being non-empty ManySortedSet of
I for f being ManySortedFunction of A, B, g being ManySortedFunction of B, C st
  g ** f is "onto" holds g is "onto";

theorem 
  for A, B being non empty set, C, y being set for f being Function
  st f in Funcs(A,Funcs(B,C)) & y in B holds dom ((commute f).y) = A & rng ((
  commute f).y) c= C;

theorem 
  for A, B being ManySortedSet of I st A is_transformable_to B for f
  being ManySortedFunction of I st doms f = A & rngs f c= B holds
  f is ManySortedFunction of A, B;

theorem 
  for A, B being ManySortedSet of I, F being ManySortedFunction of
A, B for C, E being ManySortedSubset of A, D being ManySortedSubset of C st E =
  D holds (F || C) || D = F || E;

theorem 
  for B being non-empty ManySortedSet of I, C being ManySortedSet of I
  for A being ManySortedSubset of C, F being ManySortedFunction of A, B
  ex G being ManySortedFunction of C, B st G || A = F;

definition
  let I be set, A be ManySortedSet of I, F be ManySortedFunction of I;
  func F""A -> ManySortedSet of I means


  for i being set st i in I holds it.i = (F.i)"(A.i);
end;

theorem 
  for A, B, C being ManySortedSet of I, F being ManySortedFunction of A,
  B holds F.:.:C is ManySortedSubset of B;

theorem 
  for A, B, C being ManySortedSet of I, F being ManySortedFunction of A,
  B holds F""C is ManySortedSubset of A;

theorem 
  for A, B being ManySortedSet of I, F being ManySortedFunction of A, B
  st F is "onto" holds F.:.:A = B;

theorem 
  for A, B being ManySortedSet of I, F being ManySortedFunction of A, B
  st A is_transformable_to B holds F""B = A;

theorem 
  for A being ManySortedSet of I, F being ManySortedFunction of I st A
  c= rngs F holds F.:.:(F""A) = A;

theorem 
  for f being ManySortedFunction of I for X being ManySortedSet of I
  holds f.:.:X c= rngs f;

theorem 
  for f being ManySortedFunction of I holds f.:.:(doms f) = rngs f;

theorem 
  for f being ManySortedFunction of I holds f""(rngs f) = doms f;

theorem 
  for A being ManySortedSet of I holds (id A).:.:A = A;

theorem 
  for A being ManySortedSet of I holds (id A)""A = A;

begin  

reserve S for non empty non void ManySortedSign,
  U0, U1 for non-empty MSAlgebra over S;

theorem 
  for A being MSAlgebra over S holds A is MSSubAlgebra of the MSAlgebra of A;

theorem 
  for U0 being MSAlgebra over S, A being MSSubAlgebra of U0 for o
  being OperSymbol of S, x being set st x in Args(o,A) holds x in Args(o,U0);

theorem 
  for U0 being MSAlgebra over S, A being MSSubAlgebra of U0 for o
being OperSymbol of S, x being set st x in Args(o,A) holds Den(o,A).x = Den(o,
  U0).x;

theorem 
  for F being MSAlgebra-Family of I, S, B being MSSubAlgebra of
product F for o being OperSymbol of S, x being set st x in Args(o,B) holds Den(
  o,B).x is Function & Den(o,product F).x is Function;

definition
  let S be non void non empty ManySortedSign, A be MSAlgebra over S, B be
  MSSubAlgebra of A;
  func SuperAlgebraSet B means


  for x being set holds x in it iff ex C
  being strict MSSubAlgebra of A st x = C & B is MSSubAlgebra of C;
end;

registration
  let S be non void non empty ManySortedSign, A be MSAlgebra over S, B be
  MSSubAlgebra of A;
  cluster SuperAlgebraSet B -> non empty;
end;

registration
  let S be non empty non void ManySortedSign;
  cluster strict non-empty free for MSAlgebra over S;
end;

registration
  let S be non empty non void ManySortedSign, A be non-empty MSAlgebra over S,
  X be non-empty finite-yielding MSSubset of A;
  cluster GenMSAlg X -> finitely-generated;
end;

registration
  let S be non empty non void ManySortedSign, A be non-empty MSAlgebra over S;
  cluster strict non-empty finitely-generated for MSSubAlgebra of A;
end;

registration
  let S be non empty non void ManySortedSign, A be feasible MSAlgebra over S;
  cluster feasible for MSSubAlgebra of A;
end;

theorem 
  for A being MSAlgebra over S, C being MSSubAlgebra of A for D
  being ManySortedSubset of the Sorts of A st D = the Sorts of C for h being
ManySortedFunction of A, U0 for g being ManySortedFunction of C, U0 st g = h ||
D for o being OperSymbol of S, x being Element of Args(o,A) for y being Element
  of Args(o,C) st Args(o,C) <> {} & x = y holds h#x = g#y;

theorem 
  for A being feasible MSAlgebra over S, C being feasible
  MSSubAlgebra of A for D being ManySortedSubset of the Sorts of A st D = the
  Sorts of C for h being ManySortedFunction of A, U0 st h is_homomorphism A, U0
for g being ManySortedFunction of C, U0 st g = h || D holds g is_homomorphism C
  , U0;

theorem 
  for B being strict non-empty MSAlgebra over S for G being GeneratorSet
of U0, H being non-empty GeneratorSet of B for f being ManySortedFunction of U0
  , B st H c= f.:.:G & f is_homomorphism U0, B holds f is_epimorphism U0, B;

theorem 
  for W being strict free non-empty MSAlgebra over S for F being
  ManySortedFunction of U0, U1 st F is_epimorphism U0, U1 for G being
  ManySortedFunction of W, U1 st G is_homomorphism W, U1 holds ex H being
  ManySortedFunction of W, U0 st H is_homomorphism W, U0 & G = F ** H;

theorem 
  for I being non empty finite set, A being non-empty MSAlgebra
  over S for F being MSAlgebra-Family of I, S st for i being Element of I ex C
  being strict non-empty finitely-generated MSSubAlgebra of A st C = F.i ex B
  being strict non-empty finitely-generated MSSubAlgebra of A st for i being
  Element of I holds F.i is MSSubAlgebra of B;

theorem 
  for A, B being strict non-empty finitely-generated MSSubAlgebra
of U0 ex M being strict non-empty finitely-generated MSSubAlgebra of U0 st A is
  MSSubAlgebra of M & B is MSSubAlgebra of M;

theorem 
  for SG being non empty non void ManySortedSign for AG being non-empty
  MSAlgebra over SG for C being set st C = { A where A is Element of MSSub AG :
  ex R being strict non-empty finitely-generated MSSubAlgebra of AG st R = A }
for F being MSAlgebra-Family of C, SG st for c being set st c in C holds c = F.
  c ex PS being strict non-empty MSSubAlgebra of product F, BA being
  ManySortedFunction of PS, AG st BA is_epimorphism PS, AG;

theorem 
  for U0 being feasible free MSAlgebra over S, A being free GeneratorSet
  of U0 for Z being MSSubset of U0 st Z c= A & GenMSAlg Z is feasible holds
  GenMSAlg Z is free;

begin  

definition
  let S be non empty non void ManySortedSign;
  func TermAlg S -> MSAlgebra over S equals

  FreeMSA ((the carrier of S) -->
  NAT);
end;

registration
  let S be non empty non void ManySortedSign;
  cluster TermAlg S -> strict non-empty free;
end;

definition
  let S be non empty non void ManySortedSign;
  func Equations S -> ManySortedSet of the carrier of S equals

  [|the Sorts of
  TermAlg S, the Sorts of TermAlg S|];
end;

registration
  let S be non empty non void ManySortedSign;
  cluster Equations S -> non-empty;
end;

definition
  let S be non empty non void ManySortedSign;
  mode EqualSet of S is ManySortedSubset of Equations S;
end;

reserve s for SortSymbol of S;
reserve e for Element of (Equations S).s;
reserve E for EqualSet of S;

notation
  let S be non empty non void ManySortedSign, s be SortSymbol of S, x, y be
  Element of (the Sorts of TermAlg S).s;
  synonym x '=' y for [x,y];
end;

definition
  let S be non empty non void ManySortedSign, s be SortSymbol of S, x, y be
  Element of (the Sorts of TermAlg S).s;
  redefine func x '=' y -> Element of (Equations S).s;
end;

theorem 
  e`1 in (the Sorts of TermAlg S).s;

theorem 
  e`2 in (the Sorts of TermAlg S).s;

definition
  let S be non empty non void ManySortedSign, A be MSAlgebra over S, s be
  SortSymbol of S, e be Element of (Equations S).s;
  pred A |= e means


  for h being ManySortedFunction of TermAlg S, A st
  h is_homomorphism TermAlg S, A holds h.s.(e`1) = h.s.(e`2);
end;

definition
  let S be non empty non void ManySortedSign, A be MSAlgebra over S, E be
  EqualSet of S;
  pred A |= E means


  for s being SortSymbol of S for e being Element of
  (Equations S).s st e in E.s holds A |= e;
end;

theorem 
  for U2 being strict non-empty MSSubAlgebra of U0 st U0 |= e holds U2 |= e;

theorem 
  for U2 being strict non-empty MSSubAlgebra of U0 st U0 |= E holds U2 |= E;

theorem 
  U0, U1 are_isomorphic & U0 |= e implies U1 |= e;

theorem 
  U0, U1 are_isomorphic & U0 |= E implies U1 |= E;

theorem 
  for R being MSCongruence of U0 st U0 |= e holds QuotMSAlg (U0,R) |= e;

theorem 
  for R being MSCongruence of U0 st U0 |= E holds QuotMSAlg (U0,R) |= E;

theorem 
  for F being MSAlgebra-Family of I, S st (for i being set st i in
  I ex A being MSAlgebra over S st A = F.i & A |= e) holds product F |= e;

theorem 
  for F being MSAlgebra-Family of I, S st (for i being set st i in I ex
  A being MSAlgebra over S st A = F.i & A |= E) holds product F |= E;














begin

reserve x,y,z for set;

registration
  let S be non empty non void ManySortedSign;
  let A be non empty MSAlgebra over S;
  cluster Union the Sorts of A -> non empty;
end;

definition
  let S be non empty non void ManySortedSign;
  let A be non empty MSAlgebra over S;
  mode Element of A is Element of Union the Sorts of A;
end;

theorem 
  for I being set, A being ManySortedSet of I for F being
  ManySortedFunction of I st F is "1-1" & A c= doms F holds F""(F.:.:A) = A;

definition
  let S be non void Signature;
  let X be ManySortedSet of the carrier of S;

  func Free(S, X) -> strict MSAlgebra over S means


  ex A being MSSubset
  of FreeMSA (X \/ ((the carrier of S) --> {0})) st it = GenMSAlg A & A = (
  Reverse (X \/ ((the carrier of S) --> {0})))""X;
end;

theorem 
  for S being non void Signature for X being ManySortedSet of the
carrier of S for s being SortSymbol of S holds [x,s] in the carrier of DTConMSA
  X iff x in X.s;

theorem 
  for S being non void Signature for Y being non-empty
ManySortedSet of the carrier of S for X being ManySortedSet of the carrier of S
for s being SortSymbol of S holds x in X.s & x in Y.s iff root-tree [x,s] in ((
  Reverse Y)""X).s;

theorem 
  for S being non void Signature for X being ManySortedSet of the
carrier of S for s being SortSymbol of S st x in X.s holds root-tree [x,s] in (
  the Sorts of Free(S, X)).s;

theorem 
  for S being non void Signature for X being ManySortedSet of the
carrier of S for o being OperSymbol of S st the_arity_of o = {} holds root-tree
  [o, the carrier of S] in (the Sorts of Free(S, X)).the_result_sort_of o;

registration
  let S be non void Signature;
  let X be non empty-yielding ManySortedSet of the carrier of S;
  cluster Free(S, X) -> non empty;
end;

theorem 
  for S being non void Signature for X being non-empty ManySortedSet of
  the carrier of S holds x is Element of FreeMSA X iff x is Term of S, X;

theorem 
  for S being non void Signature for X being non-empty
ManySortedSet of the carrier of S for s being SortSymbol of S for x being Term
  of S, X holds x in (the Sorts of FreeMSA X).s iff the_sort_of x = s;

theorem 
  for S being non void Signature for X being non empty-yielding
ManySortedSet of the carrier of S for x being Element of Free(S, X) holds x is
  Term of S, X \/ ((the carrier of S) --> {0});

registration
  let S be non empty non void ManySortedSign;
  let X be non empty-yielding ManySortedSet of the carrier of S;
  cluster -> Relation-like Function-like for Element of Free(S, X);
end;

registration
  let S be non empty non void ManySortedSign;
  let X be non empty-yielding ManySortedSet of the carrier of S;
  cluster -> finite DecoratedTree-like for Element of Free(S, X);
end;

registration
  let S be non empty non void ManySortedSign;
  let X be non empty-yielding ManySortedSet of the carrier of S;
  cluster -> finite-branching for Element of Free(S, X);
end;

registration
  cluster -> non empty for DecoratedTree;
end;

definition
  let S be ManySortedSign;
  let t be non empty Relation;
  func S variables_in t -> ManySortedSet of the carrier of S means


  for
  s being set st s in the carrier of S holds it.s = {a`1 where a is Element of
  rng t: a`2 = s};
end;

definition
  let S be ManySortedSign;
  let X be ManySortedSet of the carrier of S;
  let t be non empty Relation;
  func X variables_in t -> ManySortedSubset of X equals

  X /\ (S variables_in t
  );
end;

theorem 
  for S being ManySortedSign, X being ManySortedSet of the carrier
of S for t being non empty Relation, V being ManySortedSubset of X holds V = X
  variables_in t iff for s being set st s in the carrier of S holds V.s = (X.s)
  /\ {a`1 where a is Element of rng t: a`2 = s};

theorem 
  for S being ManySortedSign, s,x being set holds (s in the
  carrier of S implies (S variables_in root-tree [x,s]).s = {x}) & for s9 being
set st s9 <> s or not s in the carrier of S holds (S variables_in root-tree [x,
  s]).s9 = {};

theorem 
  for S being ManySortedSign, s being set st s in the carrier of S
  for p being DTree-yielding FinSequence holds x in (S variables_in ([z, the
  carrier of S]-tree p)).s iff ex t being DecoratedTree st t in rng p & x in (S
  variables_in t).s;

theorem 
  for S being ManySortedSign for X being ManySortedSet of the
  carrier of S for s,x being set holds (x in X.s implies (X variables_in
root-tree [x,s]).s = {x}) & for s9 being set st s9 <> s or not x in X.s holds (
  X variables_in root-tree [x,s]).s9 = {};

theorem 
  for S being ManySortedSign for X being ManySortedSet of the
  carrier of S for s being set st s in the carrier of S for p being
  DTree-yielding FinSequence holds x in (X variables_in ([z, the carrier of S]
-tree p)).s iff ex t being DecoratedTree st t in rng p & x in (X variables_in t
  ).s;

theorem 
  for S being non void Signature for X being non-empty
ManySortedSet of the carrier of S for t being Term of S, X holds S variables_in
  t c= X;

definition
  let S be non void Signature;
  let X be non-empty ManySortedSet of the carrier of S;
  let t be Term of S, X;
  func variables_in t -> ManySortedSubset of X equals

  S variables_in t;
end;

theorem 
  for S being non void Signature for X being non-empty
ManySortedSet of the carrier of S for t being Term of S, X holds variables_in t
  = X variables_in t;

definition
  let S be non void Signature;
  let Y be non-empty ManySortedSet of the carrier of S;
  let X be ManySortedSet of the carrier of S;
  func S-Terms(X,Y) -> MSSubset of FreeMSA Y means


  for s being
  SortSymbol of S holds it.s = {t where t is Term of S,Y: the_sort_of t = s &
  variables_in t c= X};
end;

theorem 
  for S being non void Signature for Y being non-empty
ManySortedSet of the carrier of S for X being ManySortedSet of the carrier of S
  for s being SortSymbol of S st x in S-Terms(X,Y).s holds x is Term of S,Y;

theorem 
  for S being non void Signature for Y being non-empty
ManySortedSet of the carrier of S for X being ManySortedSet of the carrier of S
  for t being Term of S, Y for s being SortSymbol of S st t in S-Terms(X,Y).s
  holds the_sort_of t = s & variables_in t c= X;

theorem 
  for S being non void Signature for Y being non-empty
ManySortedSet of the carrier of S for X being ManySortedSet of the carrier of S
for s being SortSymbol of S holds root-tree [x,s] in (S-Terms(X,Y)).s iff x in
  X.s & x in Y.s;

theorem 
  for S being non void Signature for Y being non-empty
ManySortedSet of the carrier of S for X being ManySortedSet of the carrier of S
for o being OperSymbol of S for p being ArgumentSeq of Sym(o,Y) holds Sym(o,Y)
-tree p in (S-Terms(X,Y)).the_result_sort_of o iff rng p c= Union (S-Terms(X,Y)
  );

theorem 
  for S being non void Signature for X being non-empty
ManySortedSet of the carrier of S for A being MSSubset of FreeMSA X holds A is
  opers_closed iff for o being OperSymbol of S, p being ArgumentSeq of Sym(o,X)
  st rng p c= Union A holds Sym(o,X)-tree p in A.the_result_sort_of o;

theorem 
  for S being non void Signature for Y being non-empty
ManySortedSet of the carrier of S for X being ManySortedSet of the carrier of S
  holds S-Terms(X,Y) is opers_closed;

theorem 
  for S being non void Signature for Y being non-empty
ManySortedSet of the carrier of S for X being ManySortedSet of the carrier of S
  holds (Reverse Y)""X c= S-Terms(X,Y);

theorem 
  for S being non void Signature for X being ManySortedSet of the
carrier of S for t being Term of S, X \/ ((the carrier of S)-->{0}) for s being
  SortSymbol of S st t in S-Terms(X, X \/ ((the carrier of S)-->{0})).s holds t
  in (the Sorts of Free(S, X)).s;

theorem 
  for S being non void Signature for X being ManySortedSet of the
carrier of S
 holds the Sorts of Free(S, X) = S-Terms(X, X \/ ((the carrier of S)-->{0}));

theorem 
  for S being non void Signature for X being ManySortedSet of the
  carrier of S holds (FreeMSA (X \/ ((the carrier of S)-->{0})))| (S-Terms(X, X
  \/ ((the carrier of S)-->{0}))) = Free(S, X);

theorem 
  for S being non void Signature for X,Y being non-empty
  ManySortedSet of the carrier of S for A being MSSubAlgebra of FreeMSA X for B
  being MSSubAlgebra of FreeMSA Y st the Sorts of A = the Sorts of B holds the
  MSAlgebra of A = the MSAlgebra of B;

theorem 
  for S being non void Signature for X being non empty-yielding
ManySortedSet of the carrier of S for Y being ManySortedSet of the carrier of S
  for t being Element of Free(S, X) holds S variables_in t c= X;

theorem 
  for S being non void Signature for X being non-empty
ManySortedSet of the carrier of S for t being Term of S,X holds variables_in t
  c= X;

theorem 
  for S being non void Signature for X,Y being non-empty
ManySortedSet of the carrier of S for t1 being Term of S,X, t2 being Term of S,
  Y st t1 = t2 holds the_sort_of t1 = the_sort_of t2;

theorem 
  for S being non void Signature for X,Y being non-empty
ManySortedSet of the carrier of S for t being Term of S,Y st variables_in t c=
  X holds t is Term of S,X;

theorem 
  for S being non void Signature for X being non-empty ManySortedSet of
  the carrier of S holds Free(S, X) = FreeMSA X;

theorem 
  for S being non void Signature for Y being non-empty
  ManySortedSet of the carrier of S for t being Term of S,Y for p being Element
  of dom t holds variables_in (t|p) c= variables_in t;

theorem 
  for S being non void Signature for X being non empty-yielding
ManySortedSet of the carrier of S for t being Element of Free(S, X) for p being
  Element of dom t holds t|p is Element of Free(S, X);

theorem 
  for S being non void Signature for X being non-empty
  ManySortedSet of the carrier of S for t being Term of S,X for a being Element
  of rng t holds a = [a`1,a`2];

theorem 
  for S being non void Signature for X being non empty-yielding
ManySortedSet of the carrier of S for t being Element of Free(S, X) for s being
SortSymbol of S holds (x in (S variables_in t).s implies [x,s] in rng t) & ([x,
  s] in rng t implies x in (S variables_in t).s & x in X.s);

theorem 
  for S being non void Signature for X being ManySortedSet of the
  carrier of S st for s being SortSymbol of S st X.s = {} ex o being OperSymbol
  of S st the_result_sort_of o = s & the_arity_of o = {} holds Free(S, X) is
  non-empty;

theorem 
  for S being non void non empty ManySortedSign for A being
  MSAlgebra over S for B being MSSubAlgebra of A for o being OperSymbol of S
  holds Args(o,B) c= Args(o,A);

theorem 
  for S being non void Signature for A being feasible MSAlgebra
  over S for B being MSSubAlgebra of A holds B is feasible;

registration
  let S be non void Signature, A be feasible MSAlgebra over S;
  cluster -> feasible for MSSubAlgebra of A;
end;

theorem 
  for S being non void Signature for X being ManySortedSet of the
  carrier of S holds Free(S, X) is feasible free;

registration
  let S be non void Signature, X be ManySortedSet of the carrier of S;
  cluster Free(S, X) -> feasible free;
end;














begin

registration
  let A be transitive with_units non empty AltCatStr, B be with_units non
  empty AltCatStr;
  cluster -> feasible id-preserving for Functor of A, B;
end;

registration
  let A be transitive with_units non empty AltCatStr, B be with_units non
  empty AltCatStr;
  cluster covariant -> Covariant comp-preserving for Functor of A, B;
  cluster Covariant comp-preserving -> covariant for Functor of A, B;
  cluster contravariant -> Contravariant comp-reversing for Functor of A, B;
  cluster Contravariant comp-reversing -> contravariant for Functor of A, B;
end;

theorem 
  for A,B being transitive with_units non empty AltCatStr, F
being covariant Functor of A,B for a being object of A holds F.idm a = idm (F.a
  );

begin 

definition
  let A,B be transitive with_units non empty AltCatStr,
      F1,F2 be Functor of A,B;
  pred F1 is_transformable_to F2 means


  for a being object of A holds <^ F1.a,F2.a^> <> {};
  reflexivity;
end;

theorem 
  for A,B being transitive with_units non empty AltCatStr, F,F1,
  F2 being Functor of A,B holds F is_transformable_to F1 & F1
  is_transformable_to F2 implies F is_transformable_to F2;

definition
  let A,B be transitive with_units non empty AltCatStr,
  F1,F2 be Functor of A,B;
  assume
 F1 is_transformable_to F2;
  mode transformation of F1,F2 -> ManySortedSet of the carrier of A means

     for a being object of A holds it.a is Morphism of F1.a,F2.a;
end;

definition
  let A,B be transitive with_units non empty AltCatStr;
  let F be Functor of A,B;
  func idt F -> transformation of F,F means


  for a being object of A holds it.a = idm (F.a);
end;

definition
  let A,B be transitive with_units non empty AltCatStr,
  F1,F2 be Functor of A,B;
  assume
 F1 is_transformable_to F2;
  let t be transformation of F1,F2;
  let a be object of A;
  func t!a -> Morphism of F1.a, F2.a means


  it = t.a;
end;

definition
  let A,B be transitive with_units non empty AltCatStr,
      F,F1,F2 be Functor of A,B;
  assume
 F is_transformable_to F1 & F1 is_transformable_to F2;
  let t1 be transformation of F,F1;
  let t2 be transformation of F1,F2;
  func t2`*`t1 -> transformation of F,F2 means


  for a being object of A holds it!a = (t2!a) * (t1!a);
end;

theorem 
  for A,B being transitive with_units non empty AltCatStr, F1,F2
being Functor of A,B holds F1 is_transformable_to F2 implies for t1,
  t2 being transformation of F1,F2 st for a being object of A holds t1!a = t2!a
  holds t1 = t2;

theorem 
  for A,B being transitive with_units non empty AltCatStr, F
being Functor of A,B holds for a being object of A holds (idt F)!a =
  idm(F.a);

theorem 
  for A,B being transitive with_units non empty AltCatStr, F1,F2
  being Functor of A,B holds F1 is_transformable_to F2 implies for t
  being transformation of F1,F2 holds (idt F2)`*`t = t & t`*`(idt F1) = t;

theorem 
  for A,B being category, F,F1,F2,F3 being Functor of A,B
  holds F is_transformable_to F1 & F1 is_transformable_to F2 & F2
  is_transformable_to F3 implies for t1 being transformation of F,F1, t2 being
transformation of F1,F2, t3 being transformation of F2,F3 holds t3`*`t2`*`t1 =
  t3`*`(t2`*`t1);

begin

definition
  let A,B be transitive with_units non empty AltCatStr, F1,F2 be covariant
  Functor of A,B;
  pred F1 is_naturally_transformable_to F2 means


  F1 is_transformable_to
F2 & ex t being transformation of F1,F2 st for a,b being object of A st <^a,b^>
  <> {} for f being Morphism of a,b holds t!b*F1.f = F2.f*(t!a);
  reflexivity;
end;

theorem 
  for A,B be transitive with_units non empty AltCatStr, F be
  covariant Functor of A,B holds F is_naturally_transformable_to F;

theorem 
  for A,B be category, F,F1,F2 be covariant Functor of A,B holds F
is_naturally_transformable_to F1 & F1 is_naturally_transformable_to F2 implies
  F is_naturally_transformable_to F2;

definition
  let A,B be transitive with_units non empty AltCatStr, F1,F2 be covariant
  Functor of A,B;
  assume
 F1 is_naturally_transformable_to F2;
  mode natural_transformation of F1,F2 -> transformation of F1,F2 means


for a,b being object of A st <^a,b^> <> {} for f being Morphism of a,b holds it
    !b*F1.f = F2.f*(it!a);
end;

definition
  let A,B be transitive with_units non empty AltCatStr, F be covariant
  Functor of A,B;
  redefine func idt F -> natural_transformation of F,F;
end;

definition
  let A,B be category, F,F1,F2 be covariant Functor of A,B such that
 F is_naturally_transformable_to F1 & F1 is_naturally_transformable_to F2;
  let t1 be natural_transformation of F,F1;
  let t2 be natural_transformation of F1,F2;
  func t2`*`t1 -> natural_transformation of F,F2 means


  it = t2`*`t1;
end;

theorem 
  for A,B be transitive with_units non empty AltCatStr, F1,F2 be
covariant Functor of A,B holds F1 is_naturally_transformable_to F2 implies for
t being natural_transformation of F1,F2 holds (idt F2)`*`t = t & t`*`(idt F1) =
  t;

theorem 
  for A,B be transitive with_units non empty AltCatStr, F,F1,F2 be
  covariant Functor of A,B holds F is_naturally_transformable_to F1 & F1
is_naturally_transformable_to F2 implies for t1 being natural_transformation of
F,F1 for t2 being natural_transformation of F1,F2 for a being object of A holds
  (t2`*`t1)!a = (t2!a)*(t1!a);

theorem 
  for A,B be category, F,F1,F2,F3 be covariant Functor of A,B for t be
  natural_transformation of F,F1, t1 be natural_transformation of F1,F2 holds F
  is_naturally_transformable_to F1 & F1 is_naturally_transformable_to F2 & F2
is_naturally_transformable_to F3 implies for t3 being natural_transformation of
  F2,F3 holds t3`*`t1`*`t = t3`*`(t1`*`t);

begin 

definition
  let I be set;
  let A,B be ManySortedSet of I;
  func Funcs(A,B) -> set means


  for x be set holds x in it iff x is
ManySortedFunction of A,B if for i being set st i in I holds B.i = {} implies A
  .i = {} otherwise it = {};
end;

definition
  let A,B be transitive with_units non empty AltCatStr;
  func Funct(A,B) -> set means


  for x being set holds x in it iff x is covariant strict Functor of A,B;
end;

definition
  let A,B be category;
  func Functors(A,B) -> strict non empty transitive AltCatStr means

  the
carrier of it = Funct(A,B) & (for F,G being strict covariant Functor of A,B, x
  being set holds x in (the Arrows of it).(F,G) iff F
is_naturally_transformable_to G & x is natural_transformation of F,G) & for F,G
,H being strict covariant Functor of A,B st F is_naturally_transformable_to G &
  G is_naturally_transformable_to H for t1 being natural_transformation of F,G,
t2 being natural_transformation of G,H ex f being Function st f = (the Comp of
  it).(F,G,H) & f.(t2,t1) = t2`*`t1;
end;














begin

reserve y for set;
reserve A for Category,
  a,o for Object of A;
reserve f for Morphism of A;

definition
  let A;
  func EnsHom(A) -> Category equals

  Ens(Hom(A));
end;

theorem 
  for f,g being Function, m1,m2 being Morphism of EnsHom A st cod
  m1 = dom m2 & [[dom m1,cod m1],f] = m1 & [[dom m2,cod m2],g] = m2 holds [[dom
  m1,cod m2],g*f] = m2(*)m1;

definition
  let A,a;
  func <|a,?> -> Functor of A,EnsHom(A) equals

  hom?-(a);
end;

theorem 
  for f being Morphism of A holds <|cod f,?>
  is_naturally_transformable_to <|dom f,?>;

definition
  let A,f;
  func <|f,?> -> natural_transformation of <|cod f,?>, <|dom f,?> means


  for o be Object of A holds it.o = [[Hom(cod f,o),Hom(dom f,o)],hom(f,id o)];
end;

theorem 
  for f being Element of the carrier' of A holds [[<|cod f,?>,<|dom
  f,?>],<|f,?>] is Element of the carrier' of Functors(A,EnsHom(A));

definition
  let A;
  func Yoneda(A) -> Contravariant_Functor of A,Functors(A,EnsHom(A)) means


   for
 f being Morphism of A holds it.f = [[<|cod f,?>,<|dom f,?>],<|f,?>];
end;

definition
  let A,B be Category;
  let F be Contravariant_Functor of A,B;
  let c be Object of A;
  func F.c -> Object of B equals

  (Obj F).c;
end;

theorem 
  for F being Functor of A,Functors(A,EnsHom(A)) st Obj F is one-to-one
  & F is faithful holds F is one-to-one;

definition
  let C,D be Category;
  let T be Contravariant_Functor of C,D;
  attr T is faithful means


  for c,c9 being Object of C st Hom(c,c9) <>
  {} for f1,f2 being Morphism of c,c9 holds T.f1 = T.f2 implies f1 = f2;
end;

theorem 
  for F being Contravariant_Functor of A,Functors(A,EnsHom(A)) st
  Obj F is one-to-one & F is faithful holds F is one-to-one;

registration
  let A;
  cluster Yoneda A -> faithful;
end;

registration
  let A;
  cluster Yoneda A -> one-to-one;
end;

definition
  let C,D be Category;
  let T be Contravariant_Functor of C,D;
  attr T is full means


  for c,c9 being Object of C st Hom(T.c9,T.c) <> {}
  for g being Morphism of T.c9,T.c holds Hom(c,c9) <> {} &
  ex f being Morphism of c,c9 st g = T.f;
end;

registration
  let A;

  cluster Yoneda A -> full;
end;















begin 

reserve X,Y for set;



registration
  cluster commutative right_unital -> left_unital for non empty multLoopStr;
end;

registration
  cluster commutative right-distributive -> distributive for non empty
    doubleLoopStr;
  cluster commutative left-distributive -> distributive for non empty
    doubleLoopStr;
end;

registration
  cluster -> well-unital for Ring;
end;

registration
  cluster F_Real -> domRing-like;
end;

registration
  cluster strict Abelian add-associative right_zeroed right_complementable
associative commutative domRing-like distributive well-unital non degenerated
    almost_left_invertible for non empty doubleLoopStr;
end;

reserve R for domRing-like commutative Ring;
reserve c for Element of R;

theorem 
  for R being domRing-like commutative Ring for a,b,c being Element
  of R holds a <> 0.R implies (a * b = a * c implies b = c) & (b * a = c * a
  implies b = c);



definition
  let R be non empty multMagma;
  let x,y be Element of R;
  pred x divides y means


  ex z being Element of R st y = x * z;
end;

definition
  let R be right_unital non empty multLoopStr;
  let x,y be Element of R;
  redefine pred x divides y;
  reflexivity;
end;

definition
  let R be non empty multLoopStr;
  let x be Element of R;
  attr x is unital means


  x divides 1.R;
end;

definition
  let R be non empty multLoopStr;
  let x,y be Element of R;
  pred x is_associated_to y means


  x divides y & y divides x;
  symmetry;
end;

notation
  let R be non empty multLoopStr;
  let x,y be Element of R;
  antonym x is_not_associated_to y for x is_associated_to y;
end;

definition
  let R be well-unital non empty multLoopStr;
  let x,y be Element of R;
  redefine pred x is_associated_to y;
  reflexivity;
end;

definition
  let R be domRing-like commutative Ring;
  let x,y be Element of R;
  assume
 y divides x;
  assume
 y <> 0.R;
  func x/y -> Element of R means


  it * y = x;
end;



theorem 
  for R being associative non empty multLoopStr for a,b,c being
  Element of R holds a divides b & b divides c implies a divides c;

theorem 
  for R being commutative associative non empty multLoopStr for a
  ,b,c,d being Element of R holds (b divides a & d divides c) implies (b * d)
  divides (a * c);

theorem 
  for R being associative non empty multLoopStr for a,b,c being
  Element of R holds a is_associated_to b & b is_associated_to c implies a
  is_associated_to c;

theorem 
  for R being associative non empty multLoopStr for a,b,c being
  Element of R holds a divides b implies c * a divides c * b;

theorem 
  for R being non empty multLoopStr for a,b being Element of R
  holds a divides a * b & (R is commutative implies b divides a * b);

theorem 
  for R being associative non empty multLoopStr for a,b,c being
  Element of R holds a divides b implies a divides b * c;

theorem 
  for a,b being Element of R holds b divides a & b <> 0.R implies (
  a/b = 0.R iff a = 0.R);

theorem 
  for a being Element of R holds a <> 0.R implies a/a = 1.R;

theorem 
  for R being non degenerated domRing-like commutative Ring for a
  being Element of R holds a/1.R = a;

theorem 
  for a,b,c being Element of R holds c <> 0.R implies ( c divides
(a * b) & c divides a implies (a * b) / c = (a / c) * b) & ( c divides (a * b)
  & c divides b implies (a * b) / c = a * (b / c));

theorem 
  for a,b,c being Element of R holds c <> 0.R & c divides a & c
  divides b & c divides (a + b) implies (a/c) + (b/c) = (a + b)/c;

theorem 
  for a,b,c being Element of R holds c <> 0.R & c divides a & c divides
  b implies (a/c = b/c iff a = b);

theorem 
  for a,b,c,d being Element of R holds b <> 0.R & d <> 0.R & b
  divides a & d divides c implies (a/b) * (c/d) = (a * c) / (b * d);

theorem 
  for a,b,c being Element of R holds a <> 0.R & (a * b) divides (a
  * c) implies b divides c;

theorem 
  for a being Element of R holds a is_associated_to 0.R implies a = 0.R;

theorem 
  for a,b being Element of R holds a <> 0.R & a * b = a implies b = 1.R;

theorem 
  for a,b being Element of R holds a is_associated_to b iff ex c
  st c is unital & a * c = b;

theorem 
  for a,b,c being Element of R holds c <> 0.R & c * a
  is_associated_to c * b implies a is_associated_to b;

begin



definition
  let R be non empty multLoopStr;
  let a be Element of R;
  func Class a -> Subset of R means


  for b being Element of R holds b in it iff b is_associated_to a;
end;

registration
  let R be well-unital non empty multLoopStr;
  let a be Element of R;
  cluster Class a -> non empty;
end;

theorem 
  for R being associative non empty multLoopStr for a,b being
  Element of R holds Class a meets Class b implies Class a = Class b;

definition
  let R be non empty multLoopStr;
  func Classes R -> Subset-Family of R means


  for A being Subset of R
  holds A in it iff ex a being Element of R st A = Class a;
end;

registration
  let R be non empty multLoopStr;
  cluster Classes R -> non empty;
end;

theorem 
  for R being well-unital non empty multLoopStr for X being
  Subset of R holds X in Classes R implies X is non empty;

definition
  let R be associative well-unital non empty multLoopStr;
  mode Am of R -> non empty Subset of R means


    (for a being Element of R
ex z being Element of it st z is_associated_to a) & for x,y being Element of it
    holds x <> y implies x is_not_associated_to y;
end;

definition
  let R be associative well-unital non empty multLoopStr;
  mode AmpleSet of R -> non empty Subset of R means


    it is Am of R & 1.R in it;
end;

theorem 
  for R being associative well-unital non empty multLoopStr for
  Amp being AmpleSet of R holds (1.R in Amp) & (for a being Element of R ex z
  being Element of Amp st z is_associated_to a) & (for x,y being Element of Amp
  holds x <> y implies x is_not_associated_to y);

theorem 
  for R being associative well-unital non empty multLoopStr for Amp
  being AmpleSet of R for x,y being Element of Amp holds x is_associated_to y
  implies x = y;

theorem 
  for Amp being AmpleSet of R holds 0.R is Element of Amp;



definition
  let R be associative well-unital non empty multLoopStr;
  let Amp be AmpleSet of R;
  let x be Element of R;
  func NF(x,Amp) -> Element of R means


  it in Amp & it is_associated_to x;
end;

theorem 
  for Amp being AmpleSet of R holds NF(0.R,Amp) = 0.R & NF(1.R,Amp ) = 1.R;

theorem 
  for Amp being AmpleSet of R for a being Element of R holds a in Amp
  iff a = NF(a,Amp);



definition
  let R be associative well-unital non empty multLoopStr;
  let Amp be AmpleSet of R;
  attr Amp is multiplicative means


  for x,y being Element of Amp holds x * y in Amp;
end;

theorem 
  for Amp being AmpleSet of R holds Amp is multiplicative implies
  for x,y being Element of Amp holds y divides x & y <> 0.R implies x/y in Amp;

begin



definition
  let R be non empty multLoopStr;
  attr R is gcd-like means


  for x,y being Element of R ex z being
  Element of R st z divides x & z divides y & for zz being Element of R st zz
  divides x & zz divides y holds zz divides z;
end;

registration
  cluster gcd-like for domRing;
end;

registration
  cluster gcd-like associative commutative well-unital for
non empty multLoopStr;
end;

registration
  cluster gcd-like associative commutative well-unital for non empty
    multLoopStr_0;
end;

registration
  cluster -> gcd-like for almost_left_invertible add-associative right_zeroed
    right_complementable left_unital well-unital left-distributive
    right-distributive commutative non empty doubleLoopStr;
end;

registration
  cluster gcd-like associative commutative well-unital domRing-like unital
    distributive non degenerated Abelian add-associative right_zeroed
    right_complementable for non empty doubleLoopStr;
end;

definition
  mode gcdDomain is gcd-like domRing-like non degenerated commutative Ring;
end;

definition
  let R be gcd-like associative well-unital non empty multLoopStr;
  let Amp be AmpleSet of R;
  let x,y be Element of R;
  func gcd(x,y,Amp) -> Element of R means


  it in Amp & it divides x &
  it divides y & for z being Element of R st z divides x & z divides y holds z
  divides it;
end;

reserve R for gcdDomain;



theorem 
  for Amp being AmpleSet of R for a,b,c being Element of R holds c
  divides gcd(a,b,Amp) implies c divides a & c divides b;

theorem 
  for Amp being AmpleSet of R for a,b being Element of R holds gcd
  (a,b,Amp) = gcd(b,a,Amp);

theorem 
  for Amp being AmpleSet of R for a being Element of R holds gcd(a
  ,0.R,Amp) = NF(a,Amp) & gcd(0.R,a,Amp) = NF(a,Amp);

theorem 
  for Amp being AmpleSet of R holds gcd(0.R,0.R,Amp) = 0.R;

theorem 
  for Amp being AmpleSet of R for a being Element of R holds gcd(a
  ,1.R,Amp) = 1.R & gcd(1.R,a,Amp) = 1.R;

theorem 
  for Amp being AmpleSet of R for a,b being Element of R holds gcd
  (a,b,Amp) = 0.R iff a = 0.R & b = 0.R;

theorem 
  for Amp being AmpleSet of R for a,b,c being Element of R holds b
is_associated_to c implies gcd(a,b,Amp) is_associated_to gcd(a,c,Amp) & gcd(b,a
  ,Amp) is_associated_to gcd(c,a,Amp);



theorem 
  for Amp being AmpleSet of R for a,b,c being Element of R holds
  gcd(gcd(a,b,Amp),c,Amp) = gcd(a,gcd(b,c,Amp),Amp);

theorem 
  for Amp being AmpleSet of R for a,b,c being Element of R holds
  gcd(a * c,b * c,Amp) is_associated_to (c * gcd(a,b,Amp));

theorem 
  for Amp being AmpleSet of R for a,b,c being Element of R holds
  gcd(a,b,Amp) = 1.R implies gcd(a,(b * c),Amp) = gcd(a,c,Amp);

theorem 
  for Amp being AmpleSet of R for a,b,c being Element of R holds c
  = gcd(a,b,Amp) & c <> 0.R implies gcd((a/c),(b/c),Amp) = 1.R;

theorem 
  for Amp being AmpleSet of R for a,b,c being Element of R holds
  gcd((a + (b * c)),c,Amp) = gcd(a,c,Amp);

begin




theorem 
  for Amp being AmpleSet of R for r1,r2,s1,s2 being Element of R
holds gcd(r1,r2,Amp) = 1.R & gcd(s1,s2,Amp) = 1.R & r2 <> 0.R implies gcd(((r1
* (s2/gcd(r2,s2,Amp))) + (s1 * (r2/gcd(r2,s2,Amp)))), (r2 * (s2/gcd(r2,s2,Amp))
),Amp) = gcd(((r1 * (s2/gcd(r2,s2,Amp))) + (s1 * (r2/gcd(r2,s2,Amp)))), gcd(r2,
  s2,Amp),Amp);


theorem 
  for Amp being AmpleSet of R for r1,r2,s1,s2 being Element of R
  holds gcd(r1,r2,Amp) = 1.R & gcd(s1,s2,Amp) = 1.R & r2 <> 0.R & s2 <> 0.R
implies gcd(((r1/gcd(r1,s2,Amp)) * (s1/gcd(s1,r2,Amp))), ((r2/gcd(s1,r2,Amp)) *
  (s2/gcd(r1,s2,Amp))),Amp) = 1.R;

begin



definition
  let R be gcd-like associative well-unital non empty multLoopStr;
  let Amp be AmpleSet of R;
  let x,y be Element of R;
  pred x,y are_canonical_wrt Amp means


  gcd(x,y,Amp) = 1.R;
end;

theorem 
  for Amp,Amp9 being AmpleSet of R for x,y being Element of R st x
  ,y are_canonical_wrt Amp holds x,y are_canonical_wrt Amp9;

definition
  let R be gcd-like associative well-unital non empty multLoopStr;
  let x,y be Element of R;
  pred x,y are_co-prime means


  ex Amp being AmpleSet of R st gcd(x,y, Amp) = 1.R;
end;

definition
  let R be gcdDomain;
  let x,y be Element of R;
  redefine pred x,y are_co-prime;
  symmetry;
end;

theorem 
  for Amp being AmpleSet of R for x,y being Element of R holds x,y
  are_co-prime implies gcd(x,y,Amp) = 1.R;

definition
  let R be gcd-like associative well-unital non empty multLoopStr_0;
  let Amp be AmpleSet of R;
  let x,y be Element of R;
  pred x,y are_normalized_wrt Amp means


  gcd(x,y,Amp) = 1.R & y in Amp & y <> 0.R;
end;



definition
  let R be gcdDomain;
  let Amp be AmpleSet of R;
  let r1,r2,s1,s2 be Element of R;
  assume that
 r1,r2 are_co-prime and
 s1,s2 are_co-prime and
 r2 = NF(r2,Amp) and
 s2 = NF(s2,Amp);
  func add1(r1,r2,s1,s2,Amp) -> Element of R equals


  s1 if r1 = 0.R, r1
  if s1 = 0.R, (r1 * s2) + (r2 * s1) if gcd(r2,s2,Amp) = 1.R, 0.R if (r1 * (s2/
gcd(r2,s2,Amp))) + (s1 * (r2/gcd(r2,s2,Amp))) = 0.R otherwise ((r1 * (s2/gcd(r2
,s2,Amp))) + (s1 * (r2/gcd(r2,s2,Amp)))) / gcd((r1 * (s2/gcd(r2,s2,Amp))) + (s1
  * (r2/gcd(r2,s2,Amp))), gcd(r2,s2,Amp),Amp);
end;

definition
  let R be gcdDomain;
  let Amp be AmpleSet of R;
  let r1,r2,s1,s2 be Element of R;
  assume that
 r1,r2 are_co-prime and
 s1,s2 are_co-prime and
 r2 = NF(r2,Amp) and
 s2 = NF(s2,Amp);
  func add2(r1,r2,s1,s2,Amp) -> Element of R equals


  s2 if r1 = 0.R, r2
if s1 = 0.R, r2 * s2 if gcd(r2,s2,Amp) = 1.R, 1.R if (r1 * (s2/gcd(r2,s2,Amp)))
+ (s1 * (r2/gcd(r2,s2,Amp))) = 0.R otherwise (r2 * (s2/gcd(r2,s2,Amp))) / gcd((
  r1 * (s2/gcd(r2,s2,Amp))) + (s1 * (r2/gcd(r2,s2,Amp))), gcd(r2,s2,Amp),Amp);
end;

theorem 
  for Amp being AmpleSet of R for r1,r2,s1,s2 being Element of R holds
Amp is multiplicative & r1,r2 are_normalized_wrt Amp & s1,s2 are_normalized_wrt
Amp implies add1(r1,r2,s1,s2,Amp),add2(r1,r2,s1,s2,Amp) are_normalized_wrt Amp;

theorem 
  for Amp being AmpleSet of R for r1,r2,s1,s2 being Element of R holds
r1,r2 are_normalized_wrt Amp & s1,s2 are_normalized_wrt Amp implies add1(r1,r2,
  s1,s2,Amp) * (r2 * s2) = add2(r1,r2,s1,s2,Amp) * ((r1 * s2) + (s1 * r2));



definition
  let R be gcdDomain;
  let Amp be AmpleSet of R;
  let r1,r2,s1,s2 be Element of R;
  func mult1(r1,r2,s1,s2,Amp) -> Element of R equals


  0.R if r1 = 0.R
or s1 = 0.R, r1 * s1 if r2 = 1.R & s2 = 1.R, (r1 * s1)/gcd(r1,s2,Amp) if s2 <>
0.R & r2 = 1.R, (r1 * s1)/gcd(s1,r2,Amp) if r2 <> 0.R & s2 = 1.R otherwise (r1/
  gcd(r1,s2,Amp)) * (s1/gcd(s1,r2,Amp));
end;

definition
  let R be gcdDomain;
  let Amp be AmpleSet of R;
  let r1,r2,s1,s2 be Element of R;
  assume that
 r1,r2 are_co-prime and
 s1,s2 are_co-prime and
 r2 = NF(r2,Amp) and
 s2 = NF(s2,Amp);
  func mult2(r1,r2,s1,s2,Amp) -> Element of R equals


  1.R if r1 = 0.R
or s1 = 0.R, 1.R if r2 = 1.R & s2 = 1.R, s2/gcd(r1,s2,Amp) if s2 <> 0.R & r2 =
1.R, r2/gcd(s1,r2,Amp) if r2 <> 0.R & s2 = 1.R otherwise (r2/gcd(s1,r2,Amp)) *
  (s2/gcd(r1,s2,Amp));
end;

theorem 
  for Amp being AmpleSet of R for r1,r2,s1,s2 being Element of R holds
Amp is multiplicative & r1,r2 are_normalized_wrt Amp & s1,s2 are_normalized_wrt
  Amp implies mult1(r1,r2,s1,s2,Amp),mult2(r1,r2,s1,s2,Amp) are_normalized_wrt
  Amp;

theorem 
  for Amp being AmpleSet of R for r1,r2,s1,s2 being Element of R holds
r1,r2 are_normalized_wrt Amp & s1,s2 are_normalized_wrt Amp implies mult1(r1,r2
  ,s1,s2,Amp) * (r2 * s2) = mult2(r1,r2,s1,s2,Amp) * (r1 * s1);

theorem 
  for F be add-associative right_zeroed right_complementable Abelian
distributive non empty doubleLoopStr, x,y being Element of F holds (-x)*y = -
  x*y & x*(-y) = -x*y;

theorem 
  for F being almost_left_invertible commutative Ring for a, b being
  Element of F st a <> 0.F & b <> 0.F holds a"*b" = (b*a)";














begin  








definition
  let S be non empty non void ManySortedSign, X be non-empty ManySortedSet of
the carrier of S, A be non-empty MSAlgebra over S, F be ManySortedFunction of X
  , the Sorts of A;
  func F-hash -> ManySortedFunction of FreeMSA X, A means


  it is_homomorphism FreeMSA X, A & it || FreeGen X = F ** Reverse X;
end;

theorem 
  for S being non empty non void ManySortedSign for A being
  non-empty MSAlgebra over S for X being non-empty ManySortedSet of the carrier
of S for F being ManySortedFunction of X, the Sorts of A holds rngs F c= rngs (
  F-hash);




scheme 

  ExFreeAlg1 { S() -> non empty non void ManySortedSign, X() -> non-empty
MSAlgebra over S(), P[set] } : ex A being strict non-empty MSAlgebra over S(),
F being ManySortedFunction of X(), A st P[A] & F is_epimorphism X(), A & for B
being non-empty MSAlgebra over S() for G being ManySortedFunction of X(), B st
  G is_homomorphism X(), B & P[B] ex H being ManySortedFunction of A, B st H
is_homomorphism A, B & H ** F = G & for K being ManySortedFunction of A, B st K
  ** F = G holds H = K
provided
 for A, B being non-empty MSAlgebra over S() st A, B are_isomorphic &
P[A] holds P[B] and
 for A being non-empty MSAlgebra over S() for B being strict
non-empty MSSubAlgebra of A st P[A] holds P[B] and
 for I being set, F being MSAlgebra-Family of I, S() st (for i being
set st i in I ex A being MSAlgebra over S() st A = F.i & P[A]) holds P[product
F];

scheme 

  ExFreeAlg2 { S() -> non empty non void ManySortedSign, X() -> non-empty
  ManySortedSet of the carrier of S(), P[set] } : ex A being strict non-empty
MSAlgebra over S(), F being ManySortedFunction of X(), the Sorts of A st P[A] &
for B being non-empty MSAlgebra over S() for G being ManySortedFunction of X(),
  the Sorts of B st P[B] ex H being ManySortedFunction of A, B st H
is_homomorphism A, B & H ** F = G & for K being ManySortedFunction of A, B st K
  is_homomorphism A, B & K ** F = G holds H = K
provided
 for A, B being non-empty MSAlgebra over S() st A, B are_isomorphic &
P[A] holds P[B] and
 for A being non-empty MSAlgebra over S() for B being strict
non-empty MSSubAlgebra of A st P[A] holds P[B] and
 for I being set, F being MSAlgebra-Family of I, S() st (for i being
set st i in I ex A being MSAlgebra over S() st A = F.i & P[A]) holds P[product
F];

scheme 

  Exhash { S() -> non empty non void ManySortedSign, F, A() -> non-empty
MSAlgebra over S(), fi() -> ManySortedFunction of (the carrier of S()) --> NAT,
  the Sorts of F(), a() -> ManySortedFunction of (the carrier of S()) --> NAT,
  the Sorts of A(), P[set] } : ex H being ManySortedFunction of F(), A() st H
  is_homomorphism F(), A() & a()-hash = H ** (fi()-hash)
provided
 P[A()] and
 for C being non-empty MSAlgebra over S() 
for G being ManySortedFunction of (the carrier of S()) --> NAT,
  the Sorts of C st P[C] ex h being ManySortedFunction of F(), C st
  h is_homomorphism F(), C & G = h ** fi();





scheme 

  EqTerms { S() -> non empty non void ManySortedSign, F() -> non-empty
MSAlgebra over S(), fi() -> ManySortedFunction of (the carrier of S()) --> NAT,
  the Sorts of F(), s() -> SortSymbol of S(), t1, t2() -> Element of (the Sorts
of TermAlg S()).s(), P[set] } : for B being non-empty MSAlgebra over S() st P[B
  ] holds B |= t1() '=' t2()
provided
 fi()-hash.s().t1() = fi()-hash.s().t2() and
 for C being non-empty MSAlgebra over S() for G being
ManySortedFunction of (the carrier of S()) --> NAT, the Sorts of C st P[C] ex h
being ManySortedFunction of F(), C st h is_homomorphism F(), C & G = h ** fi();





scheme 

  FreeIsGen { S() -> non empty non void ManySortedSign, X() -> non-empty
ManySortedSet of the carrier of S(), A() -> strict non-empty MSAlgebra over S()
, f() -> ManySortedFunction of X(), the Sorts of A(), P[set] } : f().:.:X() is
  non-empty GeneratorSet of A()
provided
 for C being non-empty MSAlgebra over S() 
for G being ManySortedFunction of X(), the Sorts of C st P[C]
 ex H being ManySortedFunction of A(), C st
   H is_homomorphism A(), C & H ** f() = G &
   for K being ManySortedFunction of A(), C st
     K is_homomorphism A(), C & K ** f() = G holds H = K and
 P[A()] and
 for A being non-empty MSAlgebra over S() for B being strict
non-empty MSSubAlgebra of A st P[A] holds P[B];

scheme 

  Hashisonto { S() -> non empty non void ManySortedSign, A() -> strict
non-empty MSAlgebra over S(), F() -> ManySortedFunction of (the carrier of S())
  --> NAT, the Sorts of A(), P[set] } : F()-hash is_epimorphism FreeMSA ((the
  carrier of S()) --> NAT), A()
provided
 for C being non-empty MSAlgebra over S() for G being
ManySortedFunction of (the carrier of S()) --> NAT, the Sorts of C st P[C] ex H
being ManySortedFunction of A(), C st H is_homomorphism A(), C & H ** F() = G &
for K being ManySortedFunction of A(), C st K is_homomorphism A(), C & K ** F()
= G holds H = K and
 P[A()] and
 for A being non-empty MSAlgebra over S() for B being strict
non-empty MSSubAlgebra of A st P[A] holds P[B];

scheme 

  FinGenAlgInVar { S() -> non empty non void ManySortedSign, A() -> strict
  finitely-generated non-empty MSAlgebra over S(), F() -> non-empty MSAlgebra
over S(), fi() -> ManySortedFunction of (the carrier of S()) --> NAT, the Sorts
  of F(), P, Q[set] } : P[A()]
provided
 Q[A()] and
 P[F()] and
 for C being non-empty MSAlgebra over S() 
for G being ManySortedFunction of (the carrier of S()) --> NAT,
  the Sorts of C st Q[C] ex h being ManySortedFunction of F(), C st
  h is_homomorphism F(), C & G = h ** fi() and
 for A, B being non-empty MSAlgebra over S() st A, B are_isomorphic &
P[A] holds P[B] and
 for A being non-empty MSAlgebra over S(), R being MSCongruence of A
st P[A] holds P[QuotMSAlg (A,R)];

scheme 

  QuotEpi { S() -> non empty non void ManySortedSign, X, Y() -> non-empty
  MSAlgebra over S(), P[set] } : P[Y()]
provided
 ex H being ManySortedFunction of X(), Y() st H is_epimorphism X(), Y () and
 P[X()] and
 for A, B being non-empty MSAlgebra over S() st A, B are_isomorphic &
P[A] holds P[B] and
 for A being non-empty MSAlgebra over S(), R being MSCongruence of A
st P[A] holds P[QuotMSAlg (A,R)];




scheme 

  AllFinGen { S() -> non empty non void ManySortedSign, X() -> non-empty
  MSAlgebra over S(), P[set] } : P[X()]
provided
 for B being strict non-empty finitely-generated MSSubAlgebra of X()
holds P[B] and
 for A, B being non-empty MSAlgebra over S() st A, B are_isomorphic &
P[A] holds P[B] and
 for A being non-empty MSAlgebra over S() for B being strict
non-empty MSSubAlgebra of A st P[A] holds P[B] and
 for A being non-empty MSAlgebra over S(), R being MSCongruence of A
st P[A] holds P[QuotMSAlg (A,R)] and
 for I being set, F being MSAlgebra-Family of I, S() st (for i being
set st i in I ex A being MSAlgebra over S() st A = F.i & P[A]) holds P[product
F];

scheme 

  FreeInModIsInVar1 { S() -> non empty non void ManySortedSign, X() ->
  non-empty MSAlgebra over S(), P, Q[set] } : Q[X()]
provided
 for A being non-empty MSAlgebra over S() holds Q[A] iff for s being
SortSymbol of S(), e being Element of (Equations S()).s st (for B being
non-empty MSAlgebra over S() st P[B] holds B |= e) holds A |= e and
 P[X()];




scheme 

  FreeInModIsInVar { S() -> non empty non void ManySortedSign, X() -> strict
non-empty MSAlgebra over S(), psi() -> ManySortedFunction of (the carrier of S(
  )) --> NAT, the Sorts of X(), P, Q[set] } : P[X()]
provided
 for A being non-empty MSAlgebra over S() holds Q[A] iff for s being
SortSymbol of S(), e being Element of (Equations S()).s st (for B being
non-empty MSAlgebra over S() st P[B] holds B |= e) holds A |= e and
 for C being non-empty MSAlgebra over S() 
 for G being ManySortedFunction of (the carrier of S()) --> NAT,
 the Sorts of C st Q[C] ex H being ManySortedFunction of X(), C st
 H is_homomorphism X(), C & H ** psi() = G
 & for K being ManySortedFunction of X(), C st
 K is_homomorphism X(), C & K ** psi() = G holds H = K and
 Q[X()] and
 for A, B being non-empty MSAlgebra over S() st A, B are_isomorphic &
P[A] holds P[B] and
 for A being non-empty MSAlgebra over S() for B being strict
non-empty MSSubAlgebra of A st P[A] holds P[B] and
 for I being set, F being MSAlgebra-Family of I, S() st (for i being
set st i in I ex A being MSAlgebra over S() st A = F.i & P[A]) holds P[product
F];:$N Birkhoff Variety Theorem
scheme 

  Birkhoff { S() -> non empty non void ManySortedSign, P[set] } : ex E being
EqualSet of S() st for A being non-empty MSAlgebra over S() holds P[A] iff A |=
  E
provided
 for A, B being non-empty MSAlgebra over S() st A, B are_isomorphic &
P[A] holds P[B] and
 for A being non-empty MSAlgebra over S() for B being strict
non-empty MSSubAlgebra of A st P[A] holds P[B] and
 for A being non-empty MSAlgebra over S(), R being MSCongruence of A
st P[A] holds P[QuotMSAlg (A,R)] and
 for I being set, F being MSAlgebra-Family of I, S() st (for i being
set st i in I ex A being MSAlgebra over S() st A = F.i & P[A]) holds P[product
F];














begin  

registration
  let S be non empty 1-sorted;
  cluster the 1-sorted of S -> non empty;
end;

theorem 
  for I be non empty set, M, N be ManySortedSet of I holds M +* N = N;

theorem 
  for I be set, M, N be ManySortedSet of I, F be SubsetFamily of M holds
  N in F implies meet |:F:| c=' N;

theorem 
  for S be non void non empty ManySortedSign, MA be strict
  non-empty MSAlgebra over S for F be SubsetFamily of the Sorts of MA st F c=
  SubSort MA for B be MSSubset of MA st B = meet |:F:| holds B is opers_closed;

begin 

theorem 
  for A,B,C be set holds A is_coarser_than B & B is_coarser_than C
  implies A is_coarser_than C;

definition
  let I be non empty set, M be ManySortedSet of I;
  redefine func support M equals

  { x where x is Element of I : M.x <> {} };
end;

theorem 
  for I be non empty set, M be non-empty ManySortedSet of I holds
  M = [[0]]I +* (M|support M);

theorem 
  for I be non empty set, M1, M2 be non-empty ManySortedSet of I holds
  M1|support M1 = M2|support M2 implies M1 = M2;

canceled;

theorem 
  for I being non empty set, M being ManySortedSet of I, x being
Element of Bool M, i being Element of I for y being set st y in x.i ex a being
Element of Bool M st y in a.i & a is finite-yielding & support a is finite &
a c= x;

definition
  let I be set, M be ManySortedSet of I;
  let A be SubsetFamily of M;
  func MSUnion A -> ManySortedSubset of M means


  for i be set st i in I
  holds it.i = union { f.i where f is Element of Bool M: f in A };
end;

registration
  let I be set, M be ManySortedSet of I, A be empty SubsetFamily of M;
  cluster MSUnion A -> empty-yielding;
end;

theorem 
  for I be set, M be ManySortedSet of I, A be SubsetFamily of M holds
  MSUnion A = union |:A:|;

definition
  let I be set, M be ManySortedSet of I, A, B be SubsetFamily of M;
  redefine func A \/ B -> SubsetFamily of M;
end;

theorem 
  for I be set, M be ManySortedSet of I for A, B be SubsetFamily of M
  holds MSUnion (A \/ B) = MSUnion A \/ MSUnion B;

theorem 
  for I be set, M be ManySortedSet of I for A, B be SubsetFamily of M
  holds A c= B implies MSUnion A c= MSUnion B;

definition
  let I be set, M be ManySortedSet of I, A, B be SubsetFamily of M;
  redefine func A /\ B -> SubsetFamily of M;
end;

theorem 
  for I be set, M be ManySortedSet of I for A, B be SubsetFamily of M
  holds MSUnion (A /\ B) c= MSUnion A /\ MSUnion B;

theorem 
  for I be set, M be ManySortedSet of I, AA be set st for x being set st
  x in AA holds x is SubsetFamily of M for A,B be SubsetFamily of M st B = {
MSUnion X where X is SubsetFamily of M : X in AA} & A = union AA holds MSUnion
  B = MSUnion A;

begin 

definition
  let I be non empty set, M be ManySortedSet of I, S be SetOp of M;
  attr S is algebraic means

  for x be Element of Bool M st x = S.x
  ex A be SubsetFamily of M st A = { S.a where a is Element of Bool M :
  a is finite-yielding & support a is finite & a c= x} & x = MSUnion A;
end;

registration
  let I be non empty set, M be ManySortedSet of I;
  cluster algebraic reflexive monotonic idempotent for SetOp of M;
end;

definition
  let S be non empty 1-sorted, IT be ClosureSystem of S;
  attr IT is algebraic means

  ClSys->ClOp IT is algebraic;
end;

definition
  let S be non void non empty ManySortedSign, MA be non-empty MSAlgebra over S;
  func SubAlgCl MA -> strict ClosureStr over the 1-sorted of S means


  the Sorts of it = the Sorts of MA & the Family of it = SubSort MA;
end;

theorem 
  for S be non void non empty ManySortedSign, MA be strict
  non-empty MSAlgebra over S holds SubSort MA is absolutely-multiplicative
  SubsetFamily of the Sorts of MA;

registration
  let S be non void non empty ManySortedSign, MA be strict non-empty MSAlgebra
  over S;
  cluster SubAlgCl MA -> absolutely-multiplicative;
end;

registration
  let S be non void non empty ManySortedSign, MA be strict non-empty MSAlgebra
  over S;
  cluster SubAlgCl MA -> algebraic;
end;














begin 

definition
  let D be set, T be non empty FinSequenceSet of D,
      S be non empty Subset of T;
  redefine mode Element of S -> FinSequence of D;
end;

registration
  let i, j be even Integer;
  cluster i-j -> even;
end;

theorem 
  for i, j being Integer holds (i is even iff j is even) iff (i-j) is even;

theorem 
  for p being FinSequence, m, n, a being Element of NAT st a in dom
(m, n)-cut p ex k being Element of NAT st k in dom p & p.k = ((m,n)-cut p).a &
  k+1 = m+a & m <= k & k <= n;

definition
  let G be Graph;
  mode Vertex of G is Element of the carrier of G;
end;

reserve G for Graph,
  v, v1, v2 for Vertex of G,
  c for Chain of G,
  p, p1, p2 for Path of G,
  vs, vs1, vs2 for FinSequence of the carrier of G,
  e, X for set,
  n, m for Element of NAT;

theorem 
  vs is_vertex_seq_of c implies vs is non empty;

theorem 
  e in the carrier' of G implies <*e*> is Path of G;

theorem 
  (m,n)-cut p is Path of G;

theorem 
  rng p1 misses rng p2 & vs1 is_vertex_seq_of p1 & vs2
  is_vertex_seq_of p2 & vs1.len vs1 = vs2.1 implies p1^p2 is Path of G;

theorem 
  c = {} implies c is cyclic;

registration
  let G be Graph;
  cluster cyclic for Path of G;
end;

theorem 
  for p being cyclic Path of G holds ((m+1,len p)-cut p)^(1,m)-cut
  p is cyclic Path of G;

theorem 
  m+1 in dom p implies len (((m+1,len p)-cut p)^(1,m)-cut p) = len
p & rng (((m+1,len p)-cut p)^(1,m)-cut p) = rng p & (((m+1,len p)-cut p)^(1,m)
  -cut p).1 = p.(m+1);

theorem 
  for p being cyclic Path of G st n in dom p ex p9 being cyclic
  Path of G st p9.1 = p.n & len p9 = len p & rng p9 = rng p;

theorem 
  for s, t being Vertex of G st s = (the Source of G).e & t = (the
  Target of G).e holds <*t, s*> is_vertex_seq_of <*e*>;

theorem 
  e in the carrier' of G & vs is_vertex_seq_of c & vs.len vs = (
the Source of G).e implies c^<*e*> is Chain of G & ex vs9 being FinSequence of
  the carrier of G st vs9 = vs^'<*(the Source of G).e, (the Target of G).e*> &
vs9 is_vertex_seq_of c^<*e*> & vs9.1 = vs.1 & vs9.len vs9 = (the Target of G).e
;

theorem 
  e in the carrier' of G & vs is_vertex_seq_of c & vs.len vs = (
the Target of G).e implies c^<*e*> is Chain of G & ex vs9 being FinSequence of
  the carrier of G st vs9 = vs^'<*(the Target of G).e, (the Source of G).e*> &
vs9 is_vertex_seq_of c^<*e*> & vs9.1 = vs.1 & vs9.len vs9 = (the Source of G).e
;

theorem 
  vs is_vertex_seq_of c implies for n being Element of NAT st n in dom c
  holds (vs.n = (the Target of G).(c.n) & vs.(n+1) = (the Source of G).(c.n) or
  vs.n = (the Source of G).(c.n) & vs.(n+1) = (the Target of G).(c.n));

theorem 
  vs is_vertex_seq_of c & e in rng c implies (the Target of G).e
  in rng vs & (the Source of G).e in rng vs;

definition
  let G be Graph, X be set;
  redefine func G-VSet X -> Subset of the carrier of G;
end;

theorem 
  G-VSet {} = {};

theorem 
  e in the carrier' of G & e in X implies G-VSet X is non empty;

theorem 
  G is connected iff for v1, v2 st v1 <> v2 ex c, vs st c is non
  empty & vs is_vertex_seq_of c & vs.1 = v1 & vs.len vs = v2;

theorem 
  for G being connected Graph, X being set, v being Vertex of G st
X meets the carrier' of G & not v in G-VSet X ex v9 being Vertex of G, e being
Element of the carrier' of G st v9 in G-VSet X & not e in X & (v9 = (the Target
  of G).e or v9 = (the Source of G).e);

begin 

definition
  let G be Graph, v be Vertex of G, X be set;
  func Edges_In(v, X) -> Subset of the carrier' of G means


  for e being
set holds e in it iff e in the carrier' of G & e in X & (the Target of G).e = v
  ;
  func Edges_Out(v, X) -> Subset of the carrier' of G means


  for e being
set holds e in it iff e in the carrier' of G & e in X & (the Source of G).e = v
  ;
end;

definition
  let G be Graph, v be Vertex of G, X be set;
  func Edges_At(v, X) -> Subset of the carrier' of G equals

  Edges_In(v, X) \/
  Edges_Out(v, X);
end;

registration
  let G be finite Graph, v be Vertex of G, X be set;
  cluster Edges_In(v, X) -> finite;
  cluster Edges_Out(v, X) -> finite;
  cluster Edges_At(v, X) -> finite;
end;

registration
  let G be Graph, v be Vertex of G, X be empty set;
  cluster Edges_In(v, X) -> empty;
  cluster Edges_Out(v, X) -> empty;
  cluster Edges_At(v, X) -> empty;
end;

definition
  let G be Graph, v be Vertex of G;
  func Edges_In v -> Subset of the carrier' of G equals

  Edges_In(v, the
  carrier' of G);
  func Edges_Out v -> Subset of the carrier' of G equals

  Edges_Out(v, the
  carrier' of G);
end;

theorem 
  Edges_In(v, X) c= Edges_In v;

theorem 
  Edges_Out(v, X) c= Edges_Out v;

registration
  let G be finite Graph, v be Vertex of G;
  cluster Edges_In v -> finite;
  cluster Edges_Out v -> finite;
end;

reserve G for finite Graph,
  v for Vertex of G,
  c for Chain of G,
  vs for FinSequence of the carrier of G,
  X1, X2 for set;

theorem 
  card Edges_In v = EdgesIn v;

theorem 
  card Edges_Out v = EdgesOut v;

definition
  let G be finite Graph, v be Vertex of G, X be set;
  func Degree(v, X) -> Element of NAT equals

  card Edges_In(v, X) + card
  Edges_Out(v, X);
end;

theorem 
  Degree v = Degree(v, the carrier' of G);

theorem 
  Degree(v, X) <> 0 implies Edges_At(v, X) is non empty;

theorem 
  e in the carrier' of G & not e in X & (v = (the Target of G).e
  or v = (the Source of G).e) implies Degree v <> Degree(v, X);

theorem 
  X2 c= X1 implies card Edges_In(v, X1\X2) = card Edges_In(v, X1)
  - card Edges_In(v, X2);

theorem 
  X2 c= X1 implies card Edges_Out(v, X1\X2) = card Edges_Out(v, X1
  ) - card Edges_Out(v, X2);

theorem 
  X2 c= X1 implies Degree(v, X1 \ X2) = Degree(v, X1) - Degree(v, X2);

theorem 
  Edges_In(v, X) = Edges_In(v, X/\the carrier' of G) & Edges_Out(v
  , X) = Edges_Out(v, X/\the carrier' of G);

theorem 
  Degree(v, X) = Degree(v, X/\the carrier' of G);

theorem 
  c is non empty & vs is_vertex_seq_of c implies (v in rng vs iff
  Degree(v, rng c) <> 0);

theorem 
  for G being non void finite connected Graph, v being Vertex of G
  holds Degree v <> 0;

begin 

definition
  let G be Graph, v1, v2 be Vertex of G;
  func AddNewEdge(v1, v2) -> strict Graph means


  the carrier of it = the
carrier of G & the carrier' of it = (the carrier' of G) \/ {the carrier' of G}
  & the Source of it = (the Source of G) +* ((the carrier' of G) .--> v1) & the
  Target of it = (the Target of G) +* ((the carrier' of G) .--> v2);
end;

registration
  let G be finite Graph, v1, v2 be Vertex of G;
  cluster AddNewEdge(v1, v2) -> finite;
end;

reserve G for Graph,
  v, v1, v2 for Vertex of G,
  c for Chain of G,
  p for Path of G,
  vs for FinSequence of the carrier of G,
  v9 for Vertex of AddNewEdge(v1, v2),
  p9 for Path of AddNewEdge(v1, v2),
  vs9 for FinSequence of the carrier of AddNewEdge(v1, v2);

theorem 
  (the carrier' of G) in the carrier' of AddNewEdge(v1, v2) & the
carrier' of G = (the carrier' of AddNewEdge(v1, v2)) \ {the carrier' of G} & (
  the Source of AddNewEdge(v1, v2)).(the carrier' of G) = v1 & (the Target of
  AddNewEdge(v1, v2)).(the carrier' of G) = v2;

theorem 
  e in the carrier' of G implies (the Source of AddNewEdge(v1, v2)
).e = (the Source of G).e & (the Target of AddNewEdge(v1, v2)).e = (the Target
  of G).e;

theorem 
  vs9 = vs & vs is_vertex_seq_of c implies vs9 is_vertex_seq_of c;

theorem 
  c is Chain of AddNewEdge(v1, v2);

theorem 
  p is Path of AddNewEdge(v1, v2);

theorem 
  v9 = v1 & v1 <> v2 implies Edges_In(v9, X) = Edges_In(v1, X);

theorem 
  v9 = v2 & v1 <> v2 implies Edges_Out(v9, X) = Edges_Out(v2, X);

theorem 
  v9 = v1 & (the carrier' of G) in X implies Edges_Out(v9, X) =
Edges_Out(v1, X) \/ {the carrier' of G} & Edges_Out(v1, X) misses {the carrier'
  of G};

theorem 
  v9 = v2 & (the carrier' of G) in X implies Edges_In(v9, X) =
  Edges_In(v2, X) \/ {the carrier' of G} & Edges_In(v2, X) misses {the carrier'
  of G};

theorem 
  v9 = v & v <> v2 implies Edges_In(v9, X) = Edges_In(v, X);

theorem 
  v9 = v & v <> v1 implies Edges_Out(v9, X) = Edges_Out(v, X);

theorem 
  not (the carrier' of G) in rng p9 implies p9 is Path of G;

theorem 
  not (the carrier' of G) in rng p9 & vs = vs9 & vs9
  is_vertex_seq_of p9 implies vs is_vertex_seq_of p9;

registration
  let G be connected Graph, v1, v2 be Vertex of G;
  cluster AddNewEdge(v1, v2) -> connected;
end;

reserve G for finite Graph,
  v, v1, v2 for Vertex of G,
  vs for FinSequence of the carrier of G,
  v9 for Vertex of AddNewEdge(v1, v2);

theorem 
  v9 = v & v1 <> v2 & (v = v1 or v = v2) & (the carrier' of G) in
  X implies Degree(v9, X) = Degree(v, X) +1;

theorem 
  v9 = v & v <> v1 & v <> v2 implies Degree(v9, X) = Degree(v, X);

begin

theorem 
  for c being cyclic Path of G holds Degree(v, rng c) is even;

theorem 
  for c being Path of G st c is non cyclic & vs is_vertex_seq_of c
  holds Degree(v, rng c) is even iff v <> vs.1 & v <> vs.len vs;

reserve G for Graph,
  v for Vertex of G,
  vs for FinSequence of the carrier of G;

definition
  let G be Graph;
  func G-CycleSet -> FinSequenceSet of the carrier' of G means


  for x being set holds x in it iff x is cyclic Path of G;
end;

theorem 
  {} in G-CycleSet;

registration let G be Graph;
 cluster G-CycleSet -> non empty;
end;

theorem 
  for c being Element of G-CycleSet st v in G-VSet rng c holds {
  c9 where c9 is Element of G-CycleSet : rng c9 = rng c & ex vs st vs
  is_vertex_seq_of c9 & vs.1 = v} is non empty Subset of G-CycleSet;

definition
  let G, v;
  let c be Element of G-CycleSet;
  assume
 v in G-VSet rng c;
  func Rotate(c, v) -> Element of G-CycleSet equals


  choose { c9 where
c9 is Element of G-CycleSet : rng c9 = rng c & ex vs st vs is_vertex_seq_of c9
  & vs.1 = v };
end;

definition
  let G be Graph, c1, c2 be Element of G-CycleSet;
  assume that
 G-VSet rng c1 meets G-VSet rng c2 and
 rng c1 misses rng c2;
  func CatCycles(c1, c2) -> Element of G-CycleSet means


  ex v being
Vertex of G st v = choose ((G-VSet rng c1) /\ (G-VSet rng c2)) & it = Rotate(c1
  , v)^Rotate(c2, v);
end;

theorem 
  for G being Graph, c1, c2 be Element of G-CycleSet st G-VSet rng
  c1 meets G-VSet rng c2 & rng c1 misses rng c2 & (c1 <> {} or c2 <> {}) holds
  CatCycles(c1, c2) is non empty;

reserve G for finite Graph,
  v for Vertex of G,
  vs for FinSequence of the carrier of G;

definition
  let G, v;
  let X be set;
  assume
 Degree(v, X) <> 0;
  func X-PathSet v -> non empty FinSequenceSet of the carrier' of G equals


  {
  c where c is Element of X* : c is Path of G & c is non empty & ex vs st vs
  is_vertex_seq_of c & vs.1 = v };
end;

theorem 
  for p being Element of X-PathSet v, Y being finite set st Y =
  the carrier' of G & Degree(v, X) <> 0 holds len p <= card Y;

definition
  let G, v;
  let X be set;
  assume that
 for v being Vertex of G holds Degree(v, X) is even and
 Degree(v, X) <> 0;
  func X-CycleSet v -> non empty Subset of G-CycleSet equals


  { c where
  c is Element of G-CycleSet : rng c c= X & c is non empty & ex vs st vs
  is_vertex_seq_of c & vs.1 = v };
end;

theorem 
  Degree(v, X) <> 0 & (for v holds Degree(v, X) is even) implies
for c being Element of X-CycleSet v holds c is non empty & rng c c= X & v in G
  -VSet rng c;

theorem 
  for G be finite connected Graph, c be Element of G-CycleSet st
rng c <> the carrier' of G & c is non empty holds {v9 where v9 is Vertex of G :
v9 in G-VSet rng c & Degree v9 <> Degree(v9, rng c)} is non empty Subset of the
  carrier of G;

definition
  let G be finite connected Graph, c be Element of G-CycleSet;
  assume that
 rng c <> the carrier' of G and
 c is non empty;
  func ExtendCycle c -> Element of G-CycleSet means


  ex c9 being
Element of G-CycleSet, v being Vertex of G st v = choose {v9 where v9 is Vertex
  of G : v9 in G-VSet rng c & Degree v9 <> Degree(v9, rng c)} & c9 = choose (((
  the carrier' of G) \ rng c)-CycleSet v) & it = CatCycles(c, c9);
end;

theorem 
  for G being finite connected Graph, c being Element of G
  -CycleSet st rng c <> the carrier' of G & c is non empty & for v being Vertex
  of G holds Degree v is even holds ExtendCycle c is non empty & card rng c <
  card rng ExtendCycle c;

begin 

definition
  let G be Graph;
  let p be Path of G;
  attr p is Eulerian means


  rng p = the carrier' of G;
end;

theorem 
  for G being connected Graph, p being Path of G, vs being
FinSequence of the carrier of G st p is Eulerian & vs is_vertex_seq_of p holds
  rng vs = the carrier of G;

theorem 
  for G being finite connected Graph holds (ex p being cyclic Path
  of G st p is Eulerian) iff for v being Vertex of G holds Degree v is even;

theorem 
  for G being finite connected Graph holds (ex p being Path of G st p is
non cyclic & p is Eulerian) iff ex v1, v2 being Vertex of G st v1 <> v2 & for v
  being Vertex of G holds Degree v is even iff v<>v1 & v <> v2;














begin 

theorem 
  for n being Element of NAT, p, q being Point of TOP-REAL n, P
  being Subset of TOP-REAL n st P is_an_arc_of p, q holds P is compact;

theorem 
  for n being Element of NAT, p1, p2 being Point of TOP-REAL n, r1,
r2 being real number st (1-r1)*p1+r1*p2 = (1-r2)*p1+r2*p2 holds r1 = r2 or p1 =
  p2;

theorem 
  for n being Element of NAT for p1,p2 being Point of TOP-REAL n st
  p1 <> p2 ex f being Function of I[01], (TOP-REAL n) | LSeg(p1,p2) st (for x
  being Real st x in [.0,1.] holds f.x = (1-x)*p1 + x*p2) & f is
  being_homeomorphism & f.0 = p1 & f.1 = p2;

registration
  let n be Element of NAT;
  cluster TOP-REAL n -> pathwise_connected;
end;

registration
  let n be Element of NAT;
  cluster compact non empty strict for SubSpace of TOP-REAL n;
end;

theorem 
  for a, b being Point of TOP-REAL 2, f being Path of a, b, P being non
  empty compact SubSpace of TOP-REAL 2, g being Function of I[01], P st f is
  one-to-one & g = f & [#]P = rng f holds g is being_homeomorphism;

begin



theorem 
  for X being Subset of REAL holds X in Family_open_set RealSpace iff X
  is open;

theorem 
  for f being Function of R^1, R^1, x being Point of R^1 for g
being PartFunc of REAL, REAL, x1 being Real st f is_continuous_at x & f = g & x
  = x1 holds g is_continuous_in x1;

theorem 
  for f being continuous Function of R^1, R^1, g being PartFunc of
  REAL, REAL st f = g holds g is continuous;

theorem 
  for f being continuous one-to-one Function of R^1, R^1 holds (for x, y
being Point of I[01], p, q, fx, fy being Real st x = p & y = q & p < q & fx = f
  .x & fy = f.y holds fx < fy) or for x, y being Point of I[01], p, q, fx, fy
  being Real st x = p & y = q & p < q & fx = f.x & fy = f.y holds fx > fy;

theorem 
  for r, gg, a, b being Real, x being Element of
  Closed-Interval-MSpace (a, b) st a <= b & x = r & ].r-gg, r+gg.[ c= [.a,b.]
  holds ].r-gg, r+gg.[ = Ball (x, gg);

theorem 
  for a, b being Real, X being Subset of REAL st a < b & not a in
X & not b in X holds X in Family_open_set Closed-Interval-MSpace(a,b) implies X
  is open;

theorem 
  for X being open Subset of REAL, a, b being Real st X c= [.a,b.]
  holds not a in X & not b in X;

theorem 
  for a, b being Real, X being Subset of REAL, V being Subset of
  Closed-Interval-MSpace(a,b) st V = X holds X is open implies V in
  Family_open_set Closed-Interval-MSpace(a,b);

theorem 
  for a, b, c, d, x1 being Real, f being Function of
  Closed-Interval-TSpace(a,b), Closed-Interval-TSpace(c,d), x being Point of
Closed-Interval-TSpace(a,b), g being PartFunc of REAL, REAL st a < b & c < d &
  f is_continuous_at x & f.a = c & f.b = d & f is one-to-one & f = g & x = x1
  holds g| [.a,b.] is_continuous_in x1;

theorem 
  for a, b, c, d being Real, f being Function of
  Closed-Interval-TSpace(a,b), Closed-Interval-TSpace(c,d), g being PartFunc of
REAL, REAL st f is continuous one-to-one & a < b & c < d & f = g & f.a = c & f.
  b = d holds g| [.a,b.] is continuous;

begin



theorem 
  for a, b, c, d being Real for f being Function of
  Closed-Interval-TSpace(a,b), Closed-Interval-TSpace(c,d) st a < b & c < d & f
  is continuous one-to-one & f.a = c & f.b = d holds for x, y be Point of
Closed-Interval-TSpace(a,b), p, q, fx, fy being Real st x = p & y = q & p < q &
  fx = f.x & fy = f.y holds fx < fy;

theorem 
  for f being continuous one-to-one Function of I[01], I[01] st f.0 = 0
& f.1 = 1 holds for x, y being Point of I[01], p, q, fx, fy being Real st x = p
  & y = q & p < q & fx = f.x & fy = f.y holds fx < fy;

theorem 
  for a, b, c, d being Real, f being Function of Closed-Interval-TSpace(
  a,b), Closed-Interval-TSpace(c,d), P being non empty Subset of
Closed-Interval-TSpace(a,b), PP, QQ being Subset of R^1 st a < b & c < d & PP =
P & f is continuous one-to-one & PP is compact & f.a = c & f.b = d & f.:P = QQ
  holds f.(lower_bound [#]PP) = lower_bound [#]QQ;

theorem 
  for a, b, c, d being Real, f being Function of Closed-Interval-TSpace(
  a,b), Closed-Interval-TSpace(c,d), P, Q being non empty Subset of
Closed-Interval-TSpace(a,b), PP, QQ being Subset of R^1 st a < b & c < d & PP =
P & QQ = Q & f is continuous one-to-one & PP is compact & f.a = c & f.b = d & f
  .:P = Q holds f.(upper_bound [#]PP) = upper_bound [#]QQ;

theorem 
  for a, b being real number st a <= b holds lower_bound [.a,b.] = a &
  upper_bound [.a,b.] = b;

theorem 
  for a, b, c, d, e, f, g, h being Real for F being Function of
Closed-Interval-TSpace (a,b), Closed-Interval-TSpace (c,d) st a < b & c < d & e
< f & a <= e & f <= b & F is being_homeomorphism & F.a = c & F.b = d & g = F.e
  & h = F.f holds F.:[.e, f.] = [.g, h.];

theorem 
  for P, Q being Subset of TOP-REAL 2, p1, p2 being Point of TOP-REAL 2
st P meets Q & P /\ Q is closed & P is_an_arc_of p1,p2 holds ex EX being Point
of TOP-REAL 2 st ( EX in P /\ Q & ex g being Function of I[01], (TOP-REAL 2)|P,
s2 being Real st g is being_homeomorphism & g.0 = p1 & g.1 = p2 & g.s2 = EX & 0
  <= s2 & s2 <= 1 & for t being Real st 0 <= t & t < s2 holds not g.t in Q );

theorem 
  for P, Q being Subset of TOP-REAL 2, p1, p2 being Point of TOP-REAL 2
st P meets Q & P /\ Q is closed & P is_an_arc_of p1,p2 holds ex EX be Point of
TOP-REAL 2 st ( EX in P /\ Q & ex g being Function of I[01], (TOP-REAL 2)|P, s2
being Real st g is being_homeomorphism & g.0 = p1 & g.1 = p2 & g.s2 = EX & 0 <=
  s2 & s2 <= 1 & for t being Real st 1 >= t & t > s2 holds not g.t in Q );



registration
  cluster non empty finite real-bounded for Subset of REAL;
end;

theorem 
  for A being Subset of REAL, B being Subset of R^1 st A = B holds
  A is closed iff B is closed;

theorem 
  for A being Subset of REAL, B being Subset of R^1 st A = B holds Cl A = Cl B;

registration
  let a, b be real number;
  cluster [.a,b.] -> compact for Subset of REAL;
end;

theorem 
  for A being Subset of REAL, B being Subset of R^1 st A = B holds
  A is compact iff B is compact;

registration
  cluster finite -> compact for Subset of REAL;
end;

theorem 
  for a, b being real number holds a <> b iff Cl ].a,b.[ = [.a,b.];












theorem 
  for T being TopStruct, f being RealMap of T, g being Function of
  T, R^1 st f = g holds f is continuous iff g is continuous;















begin 

theorem 
  for i1 being Nat st 1 <= i1 holds i1-'1<i1;

theorem 
  for i, k being Nat holds i+1 <= k implies 1 <= k-'i;

theorem 
  for i, k being Nat holds 1 <= i & 1 <= k implies (k-'i)+1 <= k;

theorem 
  for r being real number st r in the carrier of I[01] holds
  1 - r in the carrier of I[01];

theorem 
  for p, q, p1 being Point of TOP-REAL 2 st p`2 <> q`2 & p1 in LSeg (p, q)
  holds ( p1`2 = p`2 implies p1 = p );

theorem 
  for p, q, p1 being Point of TOP-REAL 2 st p`1 <> q`1 & p1 in LSeg (p, q)
  holds ( p1`1 = p`1 implies p1 = p );

theorem 
  for f being FinSequence of TOP-REAL 2,
  P being non empty Subset of TOP-REAL 2,
  F being Function of I[01], (TOP-REAL 2) | P,
  i being Element of NAT st 1 <= i & i+1 <= len f & f is being_S-Seq &
  P = L~f &
  F is being_homeomorphism & F.0 = f/.1 & F.1 = f/.len f
  ex p1, p2 being Real st p1 < p2 & 0 <= p1 & p1 <= 1 & 0 <= p2 & p2 <= 1 &
  LSeg (f, i) = F.:[.p1, p2.] & F.p1 = f/.i & F.p2 = f/.(i+1);

theorem 
  for f being FinSequence of TOP-REAL 2,
  Q, R being non empty Subset of TOP-REAL 2,
  F being Function of I[01], (TOP-REAL 2)|Q, i being Element of NAT,
  P being non empty Subset of I[01] st
  f is being_S-Seq & F is being_homeomorphism & F.0 = f/.1 & F.1 = f/.len f &
  1 <= i & i+1 <= len f & F.:P = LSeg (f,i) & Q = L~f & R = LSeg(f,i)
  ex G being Function of I[01]|P, (TOP-REAL 2)|R st
  G = F|P & G is being_homeomorphism;

begin 

theorem 
  for p1, p2, p being Point of TOP-REAL 2 st
  p1 <> p2 & p in LSeg(p1,p2) holds LE p,p,p1,p2;

theorem 
  for p, p1, p2 being Point of TOP-REAL 2 st p1 <> p2 &
  p in LSeg(p1,p2) holds LE p1,p,p1,p2;

theorem 
  for p, p1, p2 being Point of TOP-REAL 2 st p in LSeg(p1,p2) & p1 <> p2
  holds LE p,p2,p1,p2;

theorem 
  for p1, p2, q1, q2, q3 being Point of TOP-REAL 2 st p1 <> p2 &
  LE q1,q2,p1,p2 & LE q2,q3,p1,p2 holds LE q1,q3,p1,p2;

theorem 
  for p, q being Point of TOP-REAL 2 st p <> q holds LSeg (p, q) =
  { p1 where p1 is Point of TOP-REAL 2 : LE p, p1, p, q & LE p1, q, p, q };

theorem 
  for n being Element of NAT, P being Subset of TOP-REAL n,
  p1, p2 being Point of TOP-REAL n st
  P is_an_arc_of p1,p2 holds P is_an_arc_of p2,p1;

theorem 
  for i being Element of NAT, f being FinSequence of TOP-REAL 2,
  P being Subset of TOP-REAL 2 st
  f is being_S-Seq & 1 <= i & i+1 <= len f & P = LSeg(f,i) holds
  P is_an_arc_of f/.i, f/.(i+1);

begin 

theorem 
  for g1 being FinSequence of TOP-REAL 2, i being Element of NAT
  st 1 <= i & i <= len g1 & g1 is being_S-Seq holds
  g1/.1 in L~mid(g1, i, len g1) implies i = 1;

theorem 
  for f being FinSequence of TOP-REAL 2,
  p being Point of TOP-REAL 2 st f is being_S-Seq & p = f.len f holds
  L_Cut (f,p) = <*p*>;

theorem 
  for f being FinSequence of TOP-REAL 2, p being Point of TOP-REAL 2 st
  p in L~f & p <> f.len f & f is being_S-Seq holds Index (p, L_Cut(f,p)) = 1;

theorem 
  for f being FinSequence of TOP-REAL 2, p being Point of TOP-REAL 2 st
  p in L~f & f is being_S-Seq & p <> f.len f holds p in L~L_Cut (f,p);

theorem 
  for f being FinSequence of TOP-REAL 2, p being Point of TOP-REAL 2 st
  p in L~f & f is being_S-Seq & p <> f.1 holds p in L~R_Cut (f,p);

theorem 
  for f being FinSequence of TOP-REAL 2,
  p being Point of TOP-REAL 2 st p in L~f & f is one-to-one
  holds B_Cut(f,p,p) = <*p*>;

theorem 
  for f being FinSequence of TOP-REAL 2, p, q being Point of TOP-REAL 2 st
  p in L~f & q in L~f & q <> f.len f & p = f.len f & f is being_S-Seq holds
  p in L~L_Cut(f,q);

theorem 
  for f being FinSequence of TOP-REAL 2, p, q being Point of TOP-REAL 2 st
  p <> f.len f & p in L~f & q in L~f & f is being_S-Seq holds
  p in L~L_Cut(f,q) or q in L~L_Cut(f,p);

theorem 
  for f being FinSequence of TOP-REAL 2,
  p, q being Point of TOP-REAL 2 st p in L~f & q in L~f & f is being_S-Seq
  holds L~B_Cut(f,p,q) c= L~f;

theorem 
  for f being non constant standard special_circular_sequence,
  i, j being Element of NAT st 1 <= i & j <= len GoB f & i < j holds
  LSeg((GoB f)*(1,width GoB f), (GoB f)*(i,width GoB f)) /\
  LSeg((GoB f)*(j,width GoB f), (GoB f)*(len GoB f,width GoB f)) = {};

theorem 
  for f being non constant standard special_circular_sequence,
  i, j being Element of NAT st 1 <= i & j <= width GoB f & i < j holds
  LSeg((GoB f)*(len GoB f,1), (GoB f)*(len GoB f,i)) /\
  LSeg((GoB f)*(len GoB f,j), (GoB f)*(len GoB f,width GoB f)) = {};

theorem 
  for f being FinSequence of TOP-REAL 2 st f is being_S-Seq
  holds L_Cut (f,f/.1) = f;

theorem 
  for f being FinSequence of TOP-REAL 2 st f is being_S-Seq holds
  R_Cut (f,f/.len f) = f;

theorem 
  for f being FinSequence of TOP-REAL 2,
  p being Point of TOP-REAL 2 st p in L~f holds
  p in LSeg ( f/.Index(p,f), f/.(Index(p,f)+1) );

theorem 
  for f be FinSequence of TOP-REAL 2 for i be Element of NAT st
  f is unfolded s.n.c. one-to-one & len f >= 2 & f/.1 in LSeg (f,i) holds
  i = 1;

theorem 
  for f be non constant standard special_circular_sequence,
  j be Element of NAT, P be Subset of TOP-REAL 2 st
  1 <= j & j <= width GoB f &
  P = LSeg ((GoB f)*(1,j), (GoB f)*(len (GoB f),j)) holds
  P is_S-P_arc_joining (GoB f)*(1,j), (GoB f)*(len (GoB f),j);

theorem 
  for f be non constant standard special_circular_sequence,
  j be Element of NAT, P be Subset of TOP-REAL 2 st 1 <= j & j <= len GoB f &
  P = LSeg ((GoB f)*(j,1), (GoB f)*(j,width GoB f)) holds
  P is_S-P_arc_joining (GoB f)*(j,1), (GoB f)*(j,width GoB f);

theorem 
  for f be FinSequence of TOP-REAL 2
  for p,q be Point of TOP-REAL 2 st p in L~f & q in L~f &
  ( Index(p,f) < Index(q,f) or
  Index(p,f) = Index(q,f) & LE p,q,f/.Index(p,f),f/.(Index(p,f)+1) ) &
  p <> q holds L~B_Cut(f,p,q) c= L~f;














begin 

theorem 
  for P, Q being Subset of TOP-REAL 2, p1, p2, q1 being Point of
TOP-REAL 2, f being Function of I[01], (TOP-REAL 2)|P, s1 be Real st q1 in P &
f.s1 = q1 & f is being_homeomorphism & f.0 = p1 & f.1 = p2 & 0 <= s1 & s1 <= 1
  & (for t being Real st 0 <= t & t < s1 holds not f.t in Q) holds for g being
Function of I[01], (TOP-REAL 2)|P, s2 be Real st g is being_homeomorphism & g.0
= p1 & g.1 = p2 & g.s2 = q1 & 0 <= s2 & s2 <= 1 holds for t being Real st 0 <=
  t & t < s2 holds not g.t in Q;

definition
  let P, Q be Subset of TOP-REAL 2, p1, p2 be Point of TOP-REAL 2;
  assume that
 P meets Q & P /\ Q is closed and
 P is_an_arc_of p1,p2;
  func First_Point(P,p1,p2,Q) -> Point of TOP-REAL 2 means


  it in P /\ Q
  & for g being Function of I[01], (TOP-REAL 2)|P, s2 being Real st g is
being_homeomorphism & g.0 = p1 & g.1 = p2 & g.s2 = it & 0 <= s2 & s2 <= 1 holds
  for t being Real st 0 <= t & t < s2 holds not g.t in Q;
end;

theorem 
  for P, Q being Subset of TOP-REAL 2, p, p1, p2 being Point of TOP-REAL
2 st p in P & P is_an_arc_of p1, p2 & Q = {p} holds First_Point (P,p1,p2,Q) = p
;

theorem 
  for P, Q being Subset of TOP-REAL 2, p1, p2 being Point of
  TOP-REAL 2 st p1 in Q & P /\ Q is closed & P is_an_arc_of p1, p2 holds
  First_Point (P, p1, p2, Q) = p1;

theorem 
  for P, Q being Subset of TOP-REAL 2, p1, p2, q1 being Point of
TOP-REAL 2, f being Function of I[01], (TOP-REAL 2)|P, s1 be Real st q1 in P &
f.s1 = q1 & f is being_homeomorphism & f.0 = p1 & f.1 = p2 & 0 <= s1 & s1 <= 1
  & (for t being Real st 1 >= t & t > s1 holds not f.t in Q) holds for g being
Function of I[01], (TOP-REAL 2)|P, s2 being Real st g is being_homeomorphism &
g.0 = p1 & g.1 = p2 & g.s2 = q1 & 0 <= s2 & s2 <= 1 holds for t being Real st 1
  >= t & t > s2 holds not g.t in Q;

definition
  let P, Q be Subset of TOP-REAL 2, p1,p2 be Point of TOP-REAL 2;
  assume that
 P meets Q & P /\ Q is closed and
 P is_an_arc_of p1,p2;
  func Last_Point (P,p1,p2,Q) -> Point of TOP-REAL 2 means


  it in P /\ Q
  & for g being Function of I[01], (TOP-REAL 2)|P, s2 be Real st g is
being_homeomorphism & g.0 = p1 & g.1 = p2 & g.s2 = it & 0 <= s2 & s2 <= 1 holds
  for t being Real st 1 >= t & t > s2 holds not g.t in Q;
end;

theorem 
  for P, Q being Subset of TOP-REAL 2, p, p1,p2 being Point of TOP-REAL
2 st p in P & P is_an_arc_of p1, p2 & Q = {p} holds Last_Point (P, p1, p2, Q) =
  p;

theorem 
  for P,Q being Subset of TOP-REAL 2, p1, p2 being Point of
  TOP-REAL 2 st p2 in Q & P /\ Q is closed & P is_an_arc_of p1, p2 holds
  Last_Point (P, p1, p2, Q) = p2;

theorem 
  for P, Q being Subset of TOP-REAL 2, p1, p2 being Point of
TOP-REAL 2 st P c= Q & P is closed & P is_an_arc_of p1, p2 holds First_Point (P
  , p1, p2, Q) = p1 & Last_Point (P, p1, p2, Q) = p2;

begin 

definition
  let P be Subset of TOP-REAL 2, p1, p2, q1, q2 be Point of TOP-REAL 2;
  pred LE q1, q2, P, p1, p2 means


  q1 in P & q2 in P & for g being
  Function of I[01], (TOP-REAL 2)|P, s1, s2 being Real st g is
being_homeomorphism & g.0 = p1 & g.1 = p2 & g.s1 = q1 & 0 <= s1 & s1 <= 1 & g.
  s2 = q2 & 0 <= s2 & s2 <= 1 holds s1 <= s2;
end;

theorem 
  for P being Subset of TOP-REAL 2, p1, p2, q1, q2 being Point of
  TOP-REAL 2, g being Function of I[01], (TOP-REAL 2)|P, s1, s2 being Real st P
is_an_arc_of p1,p2 & g is being_homeomorphism & g.0 = p1 & g.1 = p2 & g.s1 = q1
& 0 <= s1 & s1 <= 1 & g.s2 = q2 & 0 <= s2 & s2 <= 1 & s1 <= s2 holds LE q1,q2,P
  ,p1,p2;

theorem 
  for P being Subset of TOP-REAL 2, p1,p2,q1 being Point of
  TOP-REAL 2 st q1 in P holds LE q1,q1,P,p1,p2;

theorem 
  for P being Subset of TOP-REAL 2, p1,p2,q1 being Point of
TOP-REAL 2 st P is_an_arc_of p1,p2 & q1 in P holds LE p1,q1,P,p1,p2 & LE q1,p2,
  P,p1,p2;

theorem 
  for P being Subset of TOP-REAL 2, p1,p2 being Point of TOP-REAL 2 st P
  is_an_arc_of p1,p2 holds LE p1,p2,P,p1,p2;

theorem 
  for P being Subset of TOP-REAL 2, p1, p2, q1, q2 being Point of
TOP-REAL 2 st P is_an_arc_of p1,p2 & LE q1,q2,P,p1,p2 & LE q2,q1,P,p1,p2 holds
  q1=q2;

theorem 
  for P being Subset of TOP-REAL 2, p1,p2,q1,q2,q3 being Point of
  TOP-REAL 2 st LE q1,q2,P,p1,p2 & LE q2,q3,P,p1,p2 holds LE q1,q3,P,p1,p2;

theorem 
  for P being Subset of TOP-REAL 2, p1, p2, q1, q2 being Point of
TOP-REAL 2 st P is_an_arc_of p1, p2 & q1 in P & q2 in P & q1 <> q2 holds LE q1,
  q2,P,p1,p2 & not LE q2,q1,P,p1,p2 or LE q2,q1,P,p1,p2 & not LE q1,q2,P,p1,p2;

begin 

theorem 
  for f being FinSequence of TOP-REAL 2, Q being Subset of
  TOP-REAL 2, q being Point of TOP-REAL 2 st f is being_S-Seq & L~f /\ Q is
closed & q in L~f & q in Q holds LE First_Point(L~f,f/.1,f/.len f,Q), q, L~f, f
  /.1, f/.len f;

theorem 
  for f being FinSequence of TOP-REAL 2, Q being Subset of
  TOP-REAL 2, q being Point of TOP-REAL 2 st f is being_S-Seq & L~f /\ Q is
closed & q in L~f & q in Q holds LE q, Last_Point(L~f,f/.1,f/.len f,Q), L~f, f
  /.1, f/.len f;

theorem 
  for q1, q2, p1, p2 being Point of TOP-REAL 2 st p1 <> p2 holds
  LE q1, q2, LSeg(p1, p2), p1, p2 implies LE q1, q2, p1, p2;

theorem 
  for P, Q being Subset of TOP-REAL 2, p1, p2 being Point of TOP-REAL 2
st P is_an_arc_of p1,p2 & P meets Q & P /\ Q is closed holds First_Point(P,p1,
p2,Q) = Last_Point(P,p2,p1,Q) & Last_Point(P,p1,p2,Q) = First_Point(P,p2,p1,Q);

theorem 
  for f being FinSequence of TOP-REAL 2, Q being Subset of
  TOP-REAL 2, i being Element of NAT st L~f meets Q & Q is closed & f is
  being_S-Seq & 1 <= i & i+1 <= len f & First_Point (L~f, f/.1, f/.len f, Q) in
LSeg (f, i) holds First_Point (L~f, f/.1, f/.len f, Q) = First_Point (LSeg (f,
  i), f/.i, f/.(i+1), Q);

theorem 
  for f being FinSequence of TOP-REAL 2, Q being Subset of
  TOP-REAL 2, i being Element of NAT st L~f meets Q & Q is closed & f is
  being_S-Seq & 1 <= i & i+1 <= len f & Last_Point (L~f, f/.1, f/.len f, Q) in
LSeg (f, i) holds Last_Point (L~f, f/.1, f/.len f, Q) = Last_Point (LSeg (f, i)
  , f/.i, f/.(i+1), Q);

theorem 
  for f being FinSequence of TOP-REAL 2, i be Element of NAT st 1 <= i &
i+1 <= len f & f is being_S-Seq & First_Point (L~f, f/.1, f/.len f, LSeg (f,i)
  ) in LSeg (f,i) holds First_Point (L~f, f/.1, f/.len f, LSeg (f,i) ) = f/.i;

theorem 
  for f being FinSequence of TOP-REAL 2, i be Element of NAT st 1 <= i &
i+1 <= len f & f is being_S-Seq & Last_Point ( L~f, f/.1, f/.len f, LSeg (f,i)
) in LSeg (f,i) holds Last_Point ( L~f, f/.1, f/.len f, LSeg (f,i) ) = f/.(i+1)
;

theorem 
  for f be FinSequence of TOP-REAL 2, i be Element of NAT st f is
being_S-Seq & 1 <= i & i+1 <= len f holds LE f/.i, f/.(i+1), L~f, f/.1, f/.len
  f;

theorem 
  for f be FinSequence of TOP-REAL 2, i, j be Element of NAT st f
is being_S-Seq & 1 <= i & i <= j & j <= len f holds LE f/.i, f/.j, L~f, f/.1, f
  /.len f;

theorem 
  for f being FinSequence of TOP-REAL 2, q being Point of TOP-REAL
  2, i being Element of NAT st f is being_S-Seq & 1 <= i & i+1 <= len f & q in
  LSeg(f,i) holds LE f/.i, q, L~f, f/.1, f/.len f;

theorem 
  for f being FinSequence of TOP-REAL 2, q being Point of TOP-REAL
2, i being Element of NAT st f is being_S-Seq & 1<=i & i+1<=len f & q in LSeg(f
  ,i) holds LE q, f/.(i+1), L~f, f/.1, f/.len f;

theorem 
  for f being FinSequence of TOP-REAL 2, Q being Subset of TOP-REAL 2, q
  being Point of TOP-REAL 2, i, j being Element of NAT st L~f meets Q & f is
being_S-Seq & Q is closed & First_Point (L~f,f/.1,f/.len f,Q) in LSeg(f,i) & 1
  <=i & i+1<=len f & q in LSeg(f,j) & 1 <= j & j + 1 <= len f & q in Q &
  First_Point (L~f,f/.1,f/.len f,Q) <> q holds i <= j & (i=j implies LE
  First_Point(L~f,f/.1,f/.len f,Q), q, f/.i, f/.(i+1));

theorem 
  for f being FinSequence of TOP-REAL 2, Q being Subset of TOP-REAL 2, q
  being Point of TOP-REAL 2, i, j being Element of NAT st L~f meets Q & f is
being_S-Seq & Q is closed & Last_Point (L~f,f/.1,f/.len f,Q) in LSeg(f,i) & 1<=
i & i+1<=len f & q in LSeg(f,j) & 1 <= j & j + 1 <= len f & q in Q & Last_Point
(L~f,f/.1,f/.len f,Q) <> q holds i >= j & (i=j implies LE q, Last_Point(L~f,f/.
  1,f/.len f,Q), f/.i, f/.(i+1));

theorem 
  for f being FinSequence of TOP-REAL 2, q1, q2 being Point of
TOP-REAL 2, i being Element of NAT st q1 in LSeg(f,i) & q2 in LSeg(f,i) & f is
  being_S-Seq & 1 <= i & i + 1 <= len f holds LE q1, q2, L~f, f/.1, f/.len f
  implies LE q1, q2, LSeg (f,i), f/.i, f/.(i+1);

theorem 
  for f being FinSequence of TOP-REAL 2, q1, q2 being Point of TOP-REAL
2 st q1 in L~f & q2 in L~f & f is being_S-Seq & q1 <> q2 holds LE q1, q2, L~f,
  f/.1, f/.len f iff for i, j being Element of NAT st q1 in LSeg(f,i) & q2 in
LSeg(f,j) & 1 <= i & i+1 <= len f & 1 <= j & j+1 <= len f holds i <= j & (i = j
  implies LE q1,q2,f/.i,f/.(i+1));















begin  

reserve C for category,
  o1, o2, o3 for object of C;

registration
  let C be with_units non empty AltCatStr, o be object of C;
  cluster <^o,o^> -> non empty;
end;

theorem 
  for v being Morphism of o1, o2, u being Morphism of o1, o3 for f
being Morphism of o2, o3 st u = f * v & f" * f = idm o2 & <^o1,o2^> <> {} & <^
  o2,o3^> <> {} & <^o3,o2^> <> {} holds v = f" * u;

theorem 
  for v being Morphism of o2, o3, u being Morphism of o1, o3 for f
being Morphism of o1, o2 st u = v * f & f * f" = idm o2 & <^o1,o2^> <> {} & <^
  o2,o1^> <> {} & <^o2,o3^> <> {} holds v = u * f";

theorem 
  for m being Morphism of o1, o2 st <^o1,o2^> <> {} & <^o2,o1^> <>
  {} & m is iso holds m" is iso;

theorem 
  for C being with_units non empty AltCatStr, o being object of C
  holds idm o is epi mono;

registration
  let C be with_units non empty AltCatStr, o be object of C;
  cluster idm o -> epi mono retraction coretraction;
end;

registration
  let C be category, o be object of C;
  cluster idm o -> iso;
end;

theorem 
  for f being Morphism of o1, o2, g, h being Morphism of o2, o1 st h * f
  = idm o1 & f * g = idm o2 & <^o1,o2^> <> {} & <^o2,o1^> <> {} holds g = h;

theorem 
  (for o1, o2 being object of C, f being Morphism of o1, o2 holds f is
  coretraction) implies for a, b being object of C, g being Morphism of a, b st
  <^a,b^> <> {} & <^b,a^> <> {} holds g is iso;

begin  

theorem 
  for m, m9 being Morphism of o1, o2 st m is _zero & m9 is _zero & ex O
  being object of C st O is _zero holds m = m9;

theorem 
  for C being non empty AltCatStr, O, A being object of C for M being
  Morphism of O, A st O is terminal holds M is mono;

theorem 
  for C being non empty AltCatStr, O, A being object of C for M being
  Morphism of A, O st O is initial holds M is epi;

theorem 
  o2 is terminal & o1, o2 are_iso implies o1 is terminal;

theorem 
  o1 is initial & o1, o2 are_iso implies o2 is initial;

theorem 
  o1 is initial & o2 is terminal & <^o2,o1^> <> {} implies o2 is initial
  & o1 is terminal;

begin  

theorem 
  for A, B being transitive with_units non empty AltCatStr for F
being contravariant Functor of A, B for a being object of A holds F.idm a = idm
  (F.a);

theorem 
  for C1, C2 being non empty AltCatStr for F being Contravariant
FunctorStr over C1, C2 holds F is full iff for o1, o2 being object of C1 holds
  Morph-Map(F,o2,o1) is onto;

theorem 
  for C1, C2 being non empty AltCatStr for F being Contravariant
  FunctorStr over C1, C2 holds F is faithful iff for o1, o2 being object of C1
  holds Morph-Map(F,o2,o1) is one-to-one;

theorem 
  for C1, C2 being non empty AltCatStr for F being Covariant
FunctorStr over C1, C2 for o1, o2 being object of C1, Fm being Morphism of F.o1
, F.o2 st <^o1,o2^> <> {} & F is full feasible ex m being Morphism of o1, o2 st
  Fm = F.m;

theorem 
  for C1, C2 being non empty AltCatStr for F being Contravariant
FunctorStr over C1, C2 for o1, o2 being object of C1, Fm being Morphism of F.o2
, F.o1 st <^o1,o2^> <> {} & F is full feasible ex m being Morphism of o1, o2 st
  Fm = F.m;

theorem 
  for A, B being transitive with_units non empty AltCatStr for F
being covariant Functor of A, B for o1, o2 being object of A, a being Morphism
  of o1, o2 st <^o1,o2^> <> {} & <^o2,o1^> <> {} & a is retraction holds F.a is
  retraction;

theorem 
  for A, B being transitive with_units non empty AltCatStr for F
being covariant Functor of A, B for o1, o2 being object of A, a being Morphism
of o1, o2 st <^o1,o2^> <> {} & <^o2,o1^> <> {} & a is coretraction holds F.a is
  coretraction;

theorem 
  for A, B being category, F being covariant Functor of A, B for
o1, o2 being object of A, a being Morphism of o1, o2 st <^o1,o2^> <> {} & <^o2,
  o1^> <> {} & a is iso holds F.a is iso;

theorem 
  for A, B being category, F being covariant Functor of A, B for o1, o2
  being object of A st o1, o2 are_iso holds F.o1, F.o2 are_iso;

theorem 
  for A, B being transitive with_units non empty AltCatStr for F
  being contravariant Functor of A, B for o1, o2 being object of A, a being
Morphism of o1, o2 st <^o1,o2^> <> {} & <^o2,o1^> <> {} & a is retraction holds
  F.a is coretraction;

theorem 
  for A, B being transitive with_units non empty AltCatStr for F
  being contravariant Functor of A, B for o1, o2 being object of A, a being
  Morphism of o1, o2 st <^o1,o2^> <> {} & <^o2,o1^> <> {} & a is coretraction
  holds F.a is retraction;

theorem 
  for A, B being category, F being contravariant Functor of A, B
  for o1, o2 being object of A, a being Morphism of o1, o2 st <^o1,o2^> <> {} &
  <^o2,o1^> <> {} & a is iso holds F.a is iso;

theorem 
  for A, B being category, F being contravariant Functor of A, B for o1,
  o2 being object of A st o1, o2 are_iso holds F.o2, F.o1 are_iso;

theorem 
  for A, B being transitive with_units non empty AltCatStr for F
being covariant Functor of A, B for o1, o2 being object of A, a being Morphism
  of o1, o2 st F is full faithful & <^o1,o2^> <> {} & <^o2,o1^> <> {} & F.a is
  retraction holds a is retraction;

theorem 
  for A, B being transitive with_units non empty AltCatStr for F
being covariant Functor of A, B for o1, o2 being object of A, a being Morphism
  of o1, o2 st F is full faithful & <^o1,o2^> <> {} & <^o2,o1^> <> {} & F.a is
  coretraction holds a is coretraction;

theorem 
  for A, B being category, F being covariant Functor of A, B for
o1, o2 being object of A, a being Morphism of o1, o2 st F is full faithful & <^
  o1,o2^> <> {} & <^o2,o1^> <> {} & F.a is iso holds a is iso;

theorem 
  for A, B being category, F being covariant Functor of A, B for o1, o2
being object of A st F is full faithful & <^o1,o2^> <> {} & <^o2,o1^> <> {} & F
  .o1, F.o2 are_iso holds o1, o2 are_iso;

theorem 
  for A, B being transitive with_units non empty AltCatStr for F
  being contravariant Functor of A, B for o1, o2 being object of A, a being
Morphism of o1, o2 st F is full faithful & <^o1,o2^> <> {} & <^o2,o1^> <> {} &
  F.a is retraction holds a is coretraction;

theorem 
  for A, B being transitive with_units non empty AltCatStr for F
  being contravariant Functor of A, B for o1, o2 being object of A, a being
Morphism of o1, o2 st F is full faithful & <^o1,o2^> <> {} & <^o2,o1^> <> {} &
  F.a is coretraction holds a is retraction;

theorem 
  for A, B being category, F being contravariant Functor of A, B
for o1, o2 being object of A, a being Morphism of o1, o2 st F is full faithful
  & <^o1,o2^> <> {} & <^o2,o1^> <> {} & F.a is iso holds a is iso;

theorem 
  for A, B being category, F being contravariant Functor of A, B for o1,
o2 being object of A st F is full faithful & <^o1,o2^> <> {} & <^o2,o1^> <> {}
  & F.o2, F.o1 are_iso holds o1, o2 are_iso;

begin  

theorem 
  for C being AltCatStr, D being SubCatStr of C st the carrier of
  C = the carrier of D & the Arrows of C = the Arrows of D holds D is full;

theorem 
  for C being with_units non empty AltCatStr, D being SubCatStr
of C st the carrier of C = the carrier of D & the Arrows of C = the Arrows of D
  holds D is id-inheriting;

registration
  let C be category;
  cluster full non empty strict for subcategory of C;
end;

theorem 
  for B being non empty subcategory of C for A being non empty
  subcategory of B holds A is non empty subcategory of C;

theorem 
  for C being non empty transitive AltCatStr for D being non empty
transitive SubCatStr of C for o1, o2 being object of C, p1, p2 being object of
D for m being Morphism of o1, o2, n being Morphism of p1, p2 st p1 = o1 & p2 =
  o2 & m = n & <^p1,p2^> <> {} holds (m is mono implies n is mono) & (m is epi
  implies n is epi);

theorem 
  for D being non empty subcategory of C for o1, o2 being object
  of C, p1, p2 being object of D for m being Morphism of o1, o2, m1 being
Morphism of o2, o1 for n being Morphism of p1, p2, n1 being Morphism of p2, p1
  st p1 = o1 & p2 = o2 & m = n & m1 = n1 & <^p1,p2^> <> {} & <^p2,p1^> <> {}
  holds (m is_left_inverse_of m1 iff n is_left_inverse_of n1) & (m
  is_right_inverse_of m1 iff n is_right_inverse_of n1);

theorem 
  for D being full non empty subcategory of C for o1, o2 being object of
C, p1, p2 being object of D for m being Morphism of o1, o2, n being Morphism of
p1, p2 st p1 = o1 & p2 = o2 & m = n & <^p1,p2^> <> {} & <^p2,p1^> <> {} holds (
  m is retraction implies n is retraction) & (m is coretraction implies n is
  coretraction) & (m is iso implies n is iso);

theorem 
  for D being non empty subcategory of C for o1, o2 being object
of C, p1, p2 being object of D for m being Morphism of o1, o2, n being Morphism
  of p1, p2 st p1 = o1 & p2 = o2 & m = n & <^p1,p2^> <> {} & <^p2,p1^> <> {}
holds (n is retraction implies m is retraction) & (n is coretraction implies m
  is coretraction) & (n is iso implies m is iso);

definition
  let C be category;
  func AllMono C -> strict non empty transitive SubCatStr of C means


  the carrier of it = the carrier of C & the Arrows of it cc= the Arrows of C &
for o1, o2 being object of C, m being Morphism of o1, o2 holds m in (the Arrows
  of it).(o1,o2) iff <^o1,o2^> <> {} & m is mono;
end;

registration
  let C be category;
  cluster AllMono C -> id-inheriting;
end;

definition
  let C be category;
  func AllEpi C -> strict non empty transitive SubCatStr of C means


  the
  carrier of it = the carrier of C & the Arrows of it cc= the Arrows of C & for
o1, o2 being object of C, m being Morphism of o1, o2 holds m in (the Arrows of
  it).(o1,o2) iff <^o1,o2^> <> {} & m is epi;
end;

registration
  let C be category;
  cluster AllEpi C -> id-inheriting;
end;

definition
  let C be category;
  func AllRetr C -> strict non empty transitive SubCatStr of C means


  the carrier of it = the carrier of C & the Arrows of it cc= the Arrows of C &
for o1, o2 being object of C, m being Morphism of o1, o2 holds m in (the Arrows
  of it).(o1,o2) iff <^o1,o2^> <> {} & <^o2,o1^> <> {} & m is retraction;
end;

registration
  let C be category;
  cluster AllRetr C -> id-inheriting;
end;

definition
  let C be category;
  func AllCoretr C -> strict non empty transitive SubCatStr of C means


  the carrier of it = the carrier of C & the Arrows of it cc= the Arrows of C &
for o1, o2 being object of C, m being Morphism of o1, o2 holds m in (the Arrows
  of it).(o1,o2) iff <^o1,o2^> <> {} & <^o2,o1^> <> {} & m is coretraction;
end;

registration
  let C be category;
  cluster AllCoretr C -> id-inheriting;
end;

definition
  let C be category;
  func AllIso C -> strict non empty transitive SubCatStr of C means


  the
  carrier of it = the carrier of C & the Arrows of it cc= the Arrows of C & for
o1, o2 being object of C, m being Morphism of o1, o2 holds m in (the Arrows of
  it).(o1,o2) iff <^o1,o2^> <> {} & <^o2,o1^> <> {} & m is iso;
end;

registration
  let C be category;
  cluster AllIso C -> id-inheriting;
end;

theorem 
  AllIso C is non empty subcategory of AllRetr C;

theorem 
  AllIso C is non empty subcategory of AllCoretr C;

theorem 
  AllCoretr C is non empty subcategory of AllMono C;

theorem 
  AllRetr C is non empty subcategory of AllEpi C;

theorem 
  (for o1, o2 being object of C, m being Morphism of o1, o2 holds m is
  mono ) implies the AltCatStr of C = AllMono C;

theorem 
  (for o1, o2 being object of C, m being Morphism of o1, o2 holds m is
  epi ) implies the AltCatStr of C = AllEpi C;

theorem 
  (for o1, o2 being object of C, m being Morphism of o1, o2 holds m is
  retraction & <^o2,o1^> <> {}) implies the AltCatStr of C = AllRetr C;

theorem 
  (for o1, o2 being object of C, m being Morphism of o1, o2 holds m is
  coretraction & <^o2,o1^> <> {}) implies the AltCatStr of C = AllCoretr C;

theorem 
  (for o1, o2 being object of C, m being Morphism of o1, o2 holds m is
  iso & <^o2,o1^> <> {}) implies the AltCatStr of C = AllIso C;

theorem 
  for o1, o2 being object of AllMono C for m being Morphism of o1,
  o2 st <^o1,o2^> <> {} holds m is mono;

theorem 
  for o1, o2 being object of AllEpi C for m being Morphism of o1,
  o2 st <^o1,o2^> <> {} holds m is epi;

theorem 
  for o1, o2 being object of AllIso C for m being Morphism of o1,
  o2 st <^o1,o2^> <> {} holds m is iso & m" in <^o2,o1^>;

theorem 
  AllMono AllMono C = AllMono C;

theorem 
  AllEpi AllEpi C = AllEpi C;

theorem 
  AllIso AllIso C = AllIso C;

theorem 
  AllIso AllMono C = AllIso C;

theorem 
  AllIso AllEpi C = AllIso C;

theorem 
  AllIso AllRetr C = AllIso C;

theorem 
  AllIso AllCoretr C = AllIso C;














begin 

theorem 
  for R be RelStr for S be full SubRelStr of R
  for T be full SubRelStr of S holds T is full SubRelStr of R;

theorem 
  for X be set for a be Element of BoolePoset X holds uparrow a = {Y
  where Y is Subset of X : a c= Y};

theorem 
  for L be upper-bounded non empty antisymmetric RelStr for a be Element
  of L holds Top L <= a implies a = Top L;

theorem 
  for S,T be non empty Poset for g be Function of S,T for d be
  Function of T,S holds g is onto & [g,d] is Galois implies T,Image d
  are_isomorphic;

theorem 
  for L1,L2,L3 be non empty Poset for g1 be Function of L1,L2 for
g2 be Function of L2,L3 for d1 be Function of L2,L1 for d2 be Function of L3,L2
  st [g1,d1] is Galois & [g2,d2] is Galois holds [g2*g1,d1*d2] is Galois;

theorem 
  for L1,L2 be non empty Poset for f be Function of L1,L2 for f1 be
  Function of L2,L1 st f1 = (f qua Function)" & f is isomorphic holds [f,f1] is
  Galois & [f1,f] is Galois;

theorem 
  for X be set holds BoolePoset X is arithmetic;

registration
  let X be set;
  cluster BoolePoset X -> arithmetic;
end;

theorem 
  for L1,L2 be up-complete non empty Poset for f be Function of
  L1,L2 st f is isomorphic for x be Element of L1 holds f.:(waybelow x) =
  waybelow f.x;

theorem 
  for L1,L2 be non empty Poset st L1,L2 are_isomorphic & L1 is
  continuous holds L2 is continuous;

theorem 
  for L1,L2 be LATTICE st L1,L2 are_isomorphic & L1 is
  lower-bounded arithmetic holds L2 is arithmetic;

theorem 
  for L1,L2,L3 be non empty Poset for f be Function of L1,L2 for g
  be Function of L2,L3 st f is directed-sups-preserving & g is
  directed-sups-preserving holds g*f is directed-sups-preserving;

begin 

theorem 
  for L1,L2 be non empty RelStr for f be Function of L1,L2 for X be
  Subset of Image f holds (inclusion f).:X = X;

theorem 
  for X be set for c be Function of BoolePoset X,BoolePoset X st c
  is idempotent directed-sups-preserving holds inclusion c is
  directed-sups-preserving;

theorem 
  for L be continuous complete LATTICE for p be kernel Function of
  L,L st p is directed-sups-preserving holds Image p is continuous LATTICE;

theorem 
  for L be continuous complete LATTICE for p be projection
  Function of L,L st p is directed-sups-preserving holds Image p is continuous
  LATTICE;

theorem 
  for L be lower-bounded LATTICE holds L is continuous iff ex A be
  arithmetic lower-bounded LATTICE, g be Function of A,L st g is onto & g is
  infs-preserving & g is directed-sups-preserving;

theorem 
  for L be lower-bounded LATTICE holds L is continuous iff ex A be
  algebraic lower-bounded LATTICE, g be Function of A,L st g is onto & g is
  infs-preserving & g is directed-sups-preserving;

theorem 
  for L be lower-bounded LATTICE holds ( L is continuous implies ex X be
  non empty set, p be projection Function of BoolePoset X,BoolePoset X st p is
  directed-sups-preserving & L,Image p are_isomorphic ) & (( ex X be set, p be
  projection Function of BoolePoset X,BoolePoset X st p is
directed-sups-preserving & L,Image p are_isomorphic ) implies L is continuous )
;

begin 

theorem 
  for L be non empty RelStr for x be Element of L holds x in PRIME (L
  opp) iff x is co-prime;

definition
  let L be non empty RelStr;
  let a be Element of L;
  attr a is atom means


  Bottom L < a & for b be Element of L st Bottom L < b & b <= a holds b = a;
end;

definition
  let L be non empty RelStr;
  func ATOM L -> Subset of L means


  for x be Element of L holds x in it iff x is atom;
end;

theorem 
  for L be Boolean LATTICE for a be Element of L holds a is atom
  iff a is co-prime & a <> Bottom L;

registration
  let L be Boolean LATTICE;
  cluster atom -> co-prime for Element of L;
end;

theorem 
  for L be Boolean LATTICE holds ATOM L = (PRIME (L opp)) \ {Bottom L};

theorem 
  for L be Boolean LATTICE for x,a be Element of L st a is atom holds a
  <= x iff not a <= 'not' x;

theorem 
  for L be complete Boolean LATTICE for X be Subset of L for x be
Element of L holds x "/\" sup X = "\/"({x"/\"y where y is Element of L: y in X}
  ,L);

theorem 
  for L be lower-bounded with_infima antisymmetric non empty
RelStr for x,y be Element of L st x is atom & y is atom & x <> y holds x "/\" y
  = Bottom L;

theorem 
  for L be complete Boolean LATTICE for x be Element of L for A be
  Subset of L st A c= ATOM L holds x in A iff x is atom & x <= sup A;

theorem 
  for L be complete Boolean LATTICE for X,Y be Subset of L st X c=
  ATOM L & Y c= ATOM L holds X c= Y iff sup X <= sup Y;

begin 

theorem 
  for L be Boolean LATTICE holds L is arithmetic iff ex X be set st L,
  BoolePoset X are_isomorphic;

theorem 
  for L be Boolean LATTICE holds L is arithmetic iff L is algebraic;

theorem 
  for L be Boolean LATTICE holds L is arithmetic iff L is continuous;

theorem 
  for L be Boolean LATTICE holds L is arithmetic iff L is continuous & L
  opp is continuous;

theorem 
  for L be Boolean LATTICE holds L is arithmetic iff L is
  completely-distributive;

theorem 
  for L be Boolean LATTICE holds L is arithmetic iff ( L is complete &
  for x be Element of L ex X be Subset of L st X c= ATOM L & x = sup X );














begin 

reserve x,x1,x2,y,z,z1 for set;
reserve s1,r,r1,r2 for real number;
reserve s,w1,w2 for Real;
reserve n,i for Element of NAT;
reserve X for non empty TopSpace;
reserve p,p1,p2,p3 for Point of TOP-REAL n;
reserve P for Subset of TOP-REAL n;

registration let n be Nat;
 cluster -> REAL-valued for Element of TOP-REAL n;
end;

theorem 
  for n being Nat
  ex f being Function of TOP-REAL n,R^1 st for p being Element of
  TOP-REAL n holds f.p=p/.i;

theorem 
  for i st i in Seg n holds (0.TOP-REAL n)/.i=0;

theorem 
  for r,p,i st i in Seg n holds (r*p)/.i=r*p/.i;

theorem 
  for p,i st i in Seg n holds (-p)/.i=-p/.i;

theorem 
  for p1,p2,i st i in Seg n holds (p1+p2)/.i=p1/.i+p2/.i;

theorem 
  for p1,p2,i st i in Seg n holds (p1-p2)/.i=p1/.i-p2/.i;

theorem 
  i<=n implies (0*n) | i=0*i;

theorem 
  (0*n)/^i=0*(n-'i);

theorem 
  Sum(0*i)=0;

theorem 
  for r being Real st i in Seg n holds Sum( (0*n)+*(i,r))=r;

theorem 
  for q being Element of REAL n,p,i st i in Seg n & q=p
   holds p/.i<=|.q.| & (p/.i)^2<=|.q.|^2;

begin 

theorem 
  for s1,P,i st P = { p: s1>p/.i } & i in Seg n holds P is open;

theorem 
  for s1,P,i st P = { p: s1<p/.i } & i in Seg n holds P is open;

theorem 
  for P being Subset of TOP-REAL n,a,b being real number, i st P =
{ p where p is Element of TOP-REAL n: a<p/.i & p/.i<b } & i in Seg n
  holds P is open;

theorem 
  for a,b being real number,f being Function of TOP-REAL n,R^1,i
st (for p being Element of TOP-REAL n holds f.p=p/.i) holds f"({s:a<s & s<
  b})={p where p is Element of TOP-REAL n: a<p/.i & p/.i<b};

theorem 
  for M being non empty MetrSpace,f being Function of X,
  TopSpaceMetr(M) holds (for r being real number,u being Element
of M,P being Subset of TopSpaceMetr(M) st r>0 & P=Ball(u,r) holds f"P is open)
  implies f is continuous;

theorem 
  for u being Point of RealSpace,r,u1 being real number st u1=u
  holds Ball(u,r)={s:u1-r<s & s<u1+r};

theorem 
  for f being Function of TOP-REAL n,R^1,i st i in Seg n & (for p
  being Element of TOP-REAL n holds f.p=p/.i) holds f is continuous;

begin 

theorem 
  for s holds abs <*s*>=<*abs(s)*>;

theorem 
  for p being Element of TOP-REAL 1 ex r being Real st p=<*r*>;

notation
  let r be real number;
  synonym |[ r ]| for <*r*>;
end;

definition
  let r be real number;
  redefine func |[ r ]| -> Point of TOP-REAL 1;
end;

theorem 
  s*|[ r ]|=|[ s*r ]|;

theorem 
  |[ r1+r2 ]|=|[ r1 ]|+|[ r2 ]|;

theorem 
  |[r1]|=|[r2]| implies r1=r2;

theorem 
  for P being Subset of R^1,b being real number st P = { s: s<b }
  holds P is open;

theorem 
  for P being Subset of R^1,a being real number st P = { s: a<s }
  holds P is open;

theorem 
  for P being Subset of R^1,a,b being real number st P = { s: a<s
  & s<b } holds P is open;

theorem 
  for u being Point of Euclid 1,r,u1 being real number st <*u1*>=u
  holds Ball(u,r)={<*s*>:u1-r<s & s<u1+r};

theorem 
  for f being Function of TOP-REAL 1,R^1 st (for p being Element of
  TOP-REAL 1 holds f.p=p/.1) holds f is being_homeomorphism;

theorem 
  for p being Element of TOP-REAL 2 holds p/.1=p`1 & p/.2=p`2;

theorem 
  for p being Element of TOP-REAL 2 holds p/.1=proj1.p & p/.2= proj2.p;














begin 

reserve x for set;
reserve a,b,d,ra,rb,r0,s1,s2 for real number;
reserve r,s,r1,r2,r3,rc for Element of REAL;
reserve p,q,q1,q2 for Point of TOP-REAL 2;
reserve X,Y,Z for non empty TopSpace;

theorem 
  for A,B1,B2 being Subset of X st B1 is open & B2 is open & B1
  meets A & B2 meets A & A c= B1 \/ B2 & B1 misses B2 holds A is not connected;

theorem 
  for ra,rb st ra<=rb holds [#](Closed-Interval-TSpace(ra,rb)) is connected;

theorem 
  for A being Subset of R^1,a st not a in A & ex b,d st b in A & d
  in A & b<a & a<d holds not A is connected;


theorem 
 
  for X being non empty TopSpace,xa,xb being Point of X, a,b,d being
Real,f being continuous Function of X,R^1 st X is connected & f.xa=a & f.xb=b &
  a<=d & d<=b ex xc being Point of X st f.xc =d;

theorem 
  for X being non empty TopSpace,xa,xb being Point of X, B being Subset
of X, a,b,d being Real,f being continuous Function of X,R^1 st B is connected &
f.xa=a & f.xb=b & a<=d & d<=b & xa in B & xb in B ex xc being Point of X st xc
  in B & f.xc =d;



theorem 
  for ra,rb,a,b st ra<rb for f being continuous Function of
Closed-Interval-TSpace(ra,rb),R^1,d st f.ra=a & f.rb=b & a<d & d<b ex rc st f.
  rc =d & ra<rc & rc <rb;

theorem 
  for ra,rb,a,b st ra<rb holds for f being continuous Function of
Closed-Interval-TSpace(ra,rb),R^1,d st f.ra=a & f.rb=b & a>d & d>b holds ex rc
  st f.rc =d & ra<rc & rc <rb;


theorem 
  for ra,rb for g being continuous Function of Closed-Interval-TSpace(ra
,rb),R^1,s1,s2 st ra<rb & s1*s2<0 & s1=g.ra & s2=g.rb ex r1 st g.r1=0 & ra<r1 &
  r1<rb;

theorem 
  for g being Function of I[01],R^1,s1,s2 st g is continuous & g.0
  <>g.1 & s1=g.0 & s2=g.1 holds ex r1 st 0<r1 & r1<1 & g.r1=(s1+s2)/2;

begin 

theorem 
  for f being Function of TOP-REAL 2,R^1 st f=proj1 holds f is continuous;

theorem 
  for f being Function of TOP-REAL 2,R^1 st f=proj2 holds f is continuous;

theorem 
  for P being non empty Subset of TOP-REAL 2, f being Function of
I[01], (TOP-REAL 2)|P st f is continuous ex g being Function of I[01],R^1 st g
  is continuous & for r,q st r in the carrier of I[01] & q= f.r holds q`1=g.r;

theorem 
  for P being non empty Subset of TOP-REAL 2, f being Function of
I[01], (TOP-REAL 2)|P st f is continuous ex g being Function of I[01],R^1 st g
  is continuous & for r,q st r in the carrier of I[01] & q= f.r holds q`2=g.r;

theorem 
  for P being non empty Subset of TOP-REAL 2 st P is
  being_simple_closed_curve holds not (ex r st for p st p in P holds p`2=r);

theorem 
  for P being non empty Subset of TOP-REAL 2 st P is
  being_simple_closed_curve holds not (ex r st for p st p in P holds p`1=r);

theorem 
  for C being compact non empty Subset of TOP-REAL 2 st C is
  being_simple_closed_curve holds N-bound(C) > S-bound(C);

theorem 
  for C being compact non empty Subset of TOP-REAL 2 st C is
  being_simple_closed_curve holds E-bound(C) > W-bound(C);

theorem 
  for P being compact non empty Subset of TOP-REAL 2 st P is
  being_simple_closed_curve holds S-min(P)<>N-max(P);

theorem 
  for P being compact non empty Subset of TOP-REAL 2 st P is
  being_simple_closed_curve holds W-min(P)<>E-max(P);



registration
  cluster -> non vertical non horizontal for Simple_closed_curve;
end;














begin 

reserve x,y for set;
reserve s,s1,s2,s4,r,r1,r2 for Real;
reserve n,m,i,j for Element of NAT;

theorem 
  for r st r>0 ex n being Element of NAT st n>0 & 1/n < r;

definition
  let X,Y be non empty MetrStruct,f be Function of X,Y;
  attr f is uniformly_continuous means


  for r st 0<r ex s st 0<s & for
  u1,u2 being Element of X st dist(u1,u2) < s holds dist(f/.u1,f/.u2) < r;
end;

theorem 
  for X being non empty TopSpace, M being non empty MetrSpace, f
being Function of X,TopSpaceMetr(M) st f is continuous holds for r being Real,u
being Element of M,P being Subset of TopSpaceMetr(M) st P=Ball(u
  ,r) holds f"P is open;

theorem 
  for N, M being non empty MetrSpace, f being Function of
TopSpaceMetr(N),TopSpaceMetr(M) holds (for r being real number,u being Element
  of N,u1 being Element of M st r>0 & u1=f.u ex s being real
  number st s>0 & for w being Element of N, w1 being Element of M st w1=f.w &
  dist(u,w)<s holds dist(u1,w1)<r) implies f is continuous;

theorem 
  for N, M being non empty MetrSpace, f being Function of
  TopSpaceMetr(N),TopSpaceMetr(M) st f is continuous holds for r being Real,u
being Element of N,u1 being Element of M st r>0 & u1=f.u ex s st
  s>0 & for w being Element of N, w1 being Element of M st w1=f.w & dist(u,w)<s
  holds dist(u1,w1)<r;

theorem 
  for N,M being non empty MetrSpace, f being Function of N,M, g being
Function of TopSpaceMetr(N),TopSpaceMetr(M) st f=g & f is uniformly_continuous
  holds g is continuous;

reserve p for Element of NAT;


theorem 
  for N being non empty MetrSpace, G being Subset-Family of
TopSpaceMetr(N) st G is Cover of TopSpaceMetr(N) & G is open & TopSpaceMetr(N)
is compact ex r st r>0 & for w1,w2 being Element of N st dist(w1,w2)<r holds ex
  Ga being Subset of TopSpaceMetr(N) st w1 in Ga & w2 in Ga & Ga in G;

begin 

theorem 
  for N,M being non empty MetrSpace,f being Function of N,M, g
  being Function of TopSpaceMetr(N),TopSpaceMetr(M) st g=f & TopSpaceMetr(N) is
  compact & g is continuous holds f is uniformly_continuous;

theorem 
  for g being Function of I[01],TOP-REAL n, f being Function of
  Closed-Interval-MSpace(0,1),Euclid n st g is continuous & f=g holds f is
  uniformly_continuous;

theorem 
  for P being Subset of TOP-REAL n, Q being non empty Subset of Euclid n
  , g being Function of I[01],(TOP-REAL n)|P, f being Function of
Closed-Interval-MSpace(0,1),((Euclid n)|Q) st P=Q & g is continuous & f=g holds
  f is uniformly_continuous;

begin 

theorem 
  for g being Function of I[01],TOP-REAL n holds g is Function of
  Closed-Interval-MSpace(0,1),Euclid n;

theorem 
  for r,s being real number holds abs(r-s)=abs(s-r);

theorem 
  for r1,r2,s1,s2 st r1 in [.s1,s2.] & r2 in [.s1,s2.] holds abs( r1-r2)<=s2-s1
;

definition
  let IT be FinSequence of REAL;
  attr IT is decreasing means


  for n,m st n in dom IT & m in dom IT & n< m holds IT.n > IT.m;
end;

theorem 
  for e being Real,g being Function of I[01],TOP-REAL n, p1,p2 being
  Element of TOP-REAL n st e>0 & g is continuous ex h being FinSequence of REAL
  st h.1=0 & h.len h=1 & 5<=len h & rng h c=the carrier of I[01] & h is
increasing & for i being Element of NAT,Q being Subset of I[01], W being Subset
of Euclid n st 1<=i & i<len h & Q=[.h/.i,h/.(i+1).] & W=g.:(Q) holds diameter(W
  )<e;

theorem 
  for e being Real,g being Function of I[01], (TOP-REAL n), p1,p2 being
  Element of TOP-REAL n st e>0 & g is continuous ex h being FinSequence of REAL
  st h.1=1 & h.len h=0 & 5<=len h & rng h c= the carrier of I[01] & h is
decreasing & for i being Element of NAT,Q being Subset of I[01], W being Subset
of Euclid n st 1<=i & i<len h & Q=[.h/.(i+1),h/.i.] & W=g.:(Q) holds diameter(W
  )<e;














begin 

registration
  cluster non empty constant for FinSequence;
end;

theorem 
  for f,g being FinSequence st f^g is constant holds f is constant
  & g is constant;

theorem 
  for x,y being set st <*x,y*> is constant holds x = y;

theorem 
  for x,y,z being set st <*x,y,z*> is constant holds x = y & y = z & z = x;

begin 

theorem 
  for GX being non empty TopSpace, A being Subset of GX, B being
  non empty Subset of GX holds A is_a_component_of B implies A <> {};

theorem 
  for GX being TopStruct, A, B being Subset of GX holds A
  is_a_component_of B implies A c= B;

theorem 
  for T being non empty TopSpace, A being non empty Subset of T, B1
,B2,S being Subset of T st B1 is_a_component_of A & B2 is_a_component_of A & S
  is_a_component_of A & B1 \/ B2 = A holds S = B1 or S = B2;

theorem 
  for T being non empty TopSpace, A being non empty Subset of T, B1
,B2,C1,C2 being Subset of T st B1 is_a_component_of A & B2 is_a_component_of A
& C1 is_a_component_of A & C2 is_a_component_of A & B1 \/ B2 = A & C1 \/ C2 = A
  holds { B1,B2 } = { C1,C2 };

begin 

reserve S for Subset of TOP-REAL 2,
  C,C1,C2 for non empty compact Subset of TOP-REAL 2,
  p,q for Point of TOP-REAL 2;

theorem 
  for p,q,r being Point of TOP-REAL 2 holds L~<*p,q,r*> = LSeg(p,q
  ) \/ LSeg(q,r);

registration
  let n be Element of NAT;
  let f be non trivial FinSequence of TOP-REAL n;
  cluster L~f -> non empty;
end;

registration
  let f be FinSequence of TOP-REAL 2;
  cluster L~f -> compact;
end;

theorem 
  for A,B being Subset of TOP-REAL 2 st A c= B & B is horizontal
  holds A is horizontal;

theorem 
  for A,B being Subset of TOP-REAL 2 st A c= B & B is vertical
  holds A is vertical;

registration
  cluster R^2-unit_square -> special_polygonal non horizontal non vertical;
end;

registration
  cluster non vertical non horizontal non empty compact for
Subset of TOP-REAL 2;
end;

begin 

theorem 
  N-min C in C & N-max C in C;

theorem 
  S-min C in C & S-max C in C;

theorem 
  W-min C in C & W-max C in C;

theorem 
  E-min C in C & E-max C in C;

theorem 
  C is vertical iff W-bound C = E-bound C;

theorem 
  C is horizontal iff S-bound C = N-bound C;

theorem 
  NW-corner C = NE-corner C implies C is vertical;

theorem 
  SW-corner C = SE-corner C implies C is vertical;

theorem 
  NW-corner C = SW-corner C implies C is horizontal;

theorem 
  NE-corner C = SE-corner C implies C is horizontal;

reserve i,j,k for Element of NAT,
  t,r1,r2,s1,s2 for Real;

theorem 
  W-bound C <= E-bound C;

theorem 
  S-bound C <= N-bound C;

theorem 
  LSeg(SE-corner C, NE-corner C) = { p : p`1 = E-bound C & p`2 <=
  N-bound C & p`2 >= S-bound C };

theorem 
  LSeg(SW-corner C, SE-corner C) = { p : p`1 <= E-bound C & p`1 >=
  W-bound C & p`2 = S-bound C};

theorem 
  LSeg(NW-corner C, NE-corner C) = { p : p`1 <= E-bound C & p`1 >=
  W-bound C & p`2 = N-bound C};

theorem 
  LSeg(SW-corner C, NW-corner C) = { p : p`1 = W-bound C & p`2 <=
  N-bound C & p`2 >= S-bound C};

theorem 
  LSeg(SW-corner C,NW-corner C) /\ LSeg(NW-corner C,NE-corner C) = {
  NW-corner C };

theorem 
  LSeg(NW-corner C,NE-corner C) /\ LSeg(NE-corner C,SE-corner C) =
  {NE-corner C};

theorem 
  LSeg(SE-corner C,NE-corner C) /\ LSeg(SW-corner C,SE-corner C) =
  {SE-corner C};

theorem 
  LSeg(NW-corner C,SW-corner C) /\ LSeg(SW-corner C,SE-corner C) =
  {SW-corner C};

begin 

reserve D1 for non vertical non empty compact Subset of TOP-REAL 2,
  D2 for non horizontal non empty compact Subset of TOP-REAL 2,
  D for non vertical non horizontal non empty compact Subset of TOP-REAL 2;

theorem 
  W-bound D1 < E-bound D1;

theorem 
  S-bound D2 < N-bound D2;

theorem 
  LSeg(SW-corner D1,NW-corner D1) misses LSeg(SE-corner D1, NE-corner D1);

theorem 
  LSeg(SW-corner D2,SE-corner D2) misses LSeg(NW-corner D2, NE-corner D2);

begin 

definition
  let C be Subset of TOP-REAL 2;
  func SpStSeq C -> FinSequence of TOP-REAL 2 equals

  <*NW-corner C,NE-corner C
  ,SE-corner C*>^ <*SW-corner C,NW-corner C*>;
end;

theorem 
  (SpStSeq S)/.1 = NW-corner S;

theorem 
  (SpStSeq S)/.2 = NE-corner S;

theorem 
  (SpStSeq S)/.3 = SE-corner S;

theorem 
  (SpStSeq S)/.4 = SW-corner S;

theorem 
  (SpStSeq S)/.5 = NW-corner S;

theorem 
  len SpStSeq S = 5;

theorem 
  L~SpStSeq S = (LSeg(NW-corner S,NE-corner S) \/ LSeg(NE-corner S
,SE-corner S)) \/ (LSeg(SE-corner S,SW-corner S) \/ LSeg(SW-corner S,NW-corner
  S));

registration
  let D be non vertical non empty compact Subset of TOP-REAL 2;
  cluster SpStSeq D -> non constant;
end;

registration
  let D be non horizontal non empty compact Subset of TOP-REAL 2;
  cluster SpStSeq D -> non constant;
end;

registration
  let D be non vertical non horizontal non empty compact Subset of TOP-REAL 2;
  cluster SpStSeq D -> special unfolded circular s.c.c. standard;
end;

theorem 
  L~SpStSeq D = [.W-bound D,E-bound D,S-bound D,N-bound D.];

registration
  let T be non empty TopSpace, X be non empty compact Subset of T,
      f be continuous RealMap of T;
  cluster f.:X -> bounded_below;
 cluster f.:X -> bounded_above;
end;

theorem 
  W-bound S = lower_bound(proj1.:S);

theorem 
  S-bound S = lower_bound(proj2.:S);

theorem 
  N-bound S = upper_bound(proj2.:S);

theorem 
  E-bound S = upper_bound(proj1.:S);

theorem 
  S = C1 \/ C2 implies W-bound S = min(W-bound C1, W-bound C2);

theorem 
  S = C1 \/ C2 implies S-bound S = min(S-bound C1, S-bound C2);

theorem 
  S = C1 \/ C2 implies N-bound S = max(N-bound C1, N-bound C2);

theorem 
  S = C1 \/ C2 implies E-bound S = max(E-bound C1, E-bound C2);

registration
  let r1,r2 be real number;
  cluster [.r1,r2.] -> real-bounded for Subset of REAL;
end;

theorem 
  r1 <= r2 implies (t in [.r1,r2.] iff ex s1 st 0 <=s1 & s1 <= 1 &
  t = s1*r1 + (1-s1)*r2);

theorem 
  p`1 <= q`1 implies proj1.:LSeg(p,q) = [.p`1,q`1.];

theorem 
  p`2 <= q`2 implies proj2.:LSeg(p,q) = [.p`2,q`2.];

theorem 
  p`1 <= q`1 implies W-bound LSeg(p,q) = p`1;

theorem 
  p`2 <= q`2 implies S-bound LSeg(p,q) = p`2;

theorem 
  p`2 <= q`2 implies N-bound LSeg(p,q) = q`2;

theorem 
  p`1 <= q`1 implies E-bound LSeg(p,q) = q`1;

theorem 
  W-bound L~SpStSeq C = W-bound C;

theorem 
  S-bound L~SpStSeq C = S-bound C;

theorem 
  N-bound L~SpStSeq C = N-bound C;

theorem 
  E-bound L~SpStSeq C = E-bound C;

theorem 
  NW-corner L~SpStSeq C = NW-corner C;

theorem 
  NE-corner L~SpStSeq C = NE-corner C;

theorem 
  SW-corner L~SpStSeq C = SW-corner C;

theorem 
  SE-corner L~SpStSeq C = SE-corner C;

theorem 
  W-most L~SpStSeq C = LSeg(SW-corner C,NW-corner C);

theorem 
  N-most L~SpStSeq C = LSeg(NW-corner C,NE-corner C);

theorem 
  S-most L~SpStSeq C = LSeg(SW-corner C,SE-corner C);

theorem 
  E-most L~SpStSeq C = LSeg(SE-corner C,NE-corner C);

theorem 
  proj2.:LSeg(SW-corner C,NW-corner C) = [.S-bound C,N-bound C.];

theorem 
  proj1.:LSeg(NW-corner C,NE-corner C) = [.W-bound C,E-bound C.];

theorem 
  proj2.:LSeg(NE-corner C,SE-corner C) = [.S-bound C,N-bound C.];

theorem 
  proj1.:LSeg(SE-corner C,SW-corner C) = [.W-bound C,E-bound C.];

theorem 
  W-min L~SpStSeq C = SW-corner C;

theorem 
  W-max L~SpStSeq C = NW-corner C;

theorem 
  N-min L~SpStSeq C = NW-corner C;

theorem 
  N-max L~SpStSeq C = NE-corner C;

theorem 
  E-min L~SpStSeq C = SE-corner C;

theorem 
  E-max L~SpStSeq C = NE-corner C;

theorem 
  S-min L~SpStSeq C = SW-corner C;

theorem 
  S-max L~SpStSeq C = SE-corner C;

begin 

definition
  let f be FinSequence of TOP-REAL 2;
  attr f is rectangular means


  ex D st f = SpStSeq D;
end;

registration
  let D;
  cluster SpStSeq D -> rectangular;
end;

registration
  cluster rectangular for FinSequence of TOP-REAL 2;
end;

reserve s for rectangular FinSequence of TOP-REAL 2;

theorem 
  len s = 5;

registration
  cluster rectangular -> non constant for FinSequence of TOP-REAL 2;
end;

registration
  cluster rectangular -> standard special unfolded circular s.c.c. for
non empty
    FinSequence of TOP-REAL 2;
end;



theorem 
  s/.1 = N-min L~s & s/.1 = W-max L~s;

theorem 
  s/.2 = N-max L~s & s/.2 = E-max L~s;

theorem 
  s/.3 = S-max L~s & s/.3 = E-min L~s;

theorem 
  s/.4 = S-min L~s & s/.4 = W-min L~s;

begin 

theorem 
  r1 < r2 & s1 < s2 implies [.r1,r2,s1,s2.] is Jordan;

registration
  let f be rectangular FinSequence of TOP-REAL 2;
  cluster L~f -> Jordan;
end;

definition
  let S be Subset of TOP-REAL 2;
  redefine attr S is Jordan means


  S`<> {} & ex A1,A2 being Subset of
  TOP-REAL 2 st S` = A1 \/ A2 & A1 misses A2 & (Cl A1) \ A1 = (Cl A2) \ A2 & A1
  is_a_component_of S` & A2 is_a_component_of S`;
end;

theorem 
  for f being rectangular FinSequence of TOP-REAL 2 holds LeftComp
  f misses RightComp f;

registration
  let f be non constant standard special_circular_sequence;
  cluster LeftComp f -> non empty;
  cluster RightComp f -> non empty;
end;

theorem 
  for f being rectangular FinSequence of TOP-REAL 2 holds LeftComp f <>
  RightComp f;














begin 

reserve i,j,k,l,m,n for Element of NAT,
  D for non empty set,
  f for FinSequence of D;

theorem 
  i <= j & i in dom f & j in dom f & k in dom mid(f,i,j) implies k+
  i-'1 in dom f;

theorem 
  i > j & i in dom f & j in dom f & k in dom mid(f,i,j) implies i
  -' k + 1 in dom f;

theorem 
  i <= j & i in dom f & j in dom f & k in dom mid(f,i,j) implies (
  mid(f,i,j))/.k = f/.(k+i-'1);

theorem 
  i > j & i in dom f & j in dom f & k in dom mid(f,i,j) implies (
  mid(f,i,j))/.k = f/.(i-' k +1);

theorem 
  i in dom f & j in dom f implies len mid(f,i,j) >= 1;

theorem 
  i in dom f & j in dom f & len mid(f,i,j) = 1 implies i = j;

theorem 
  i in dom f & j in dom f implies mid(f,i,j) is non empty;

theorem 
  i in dom f & j in dom f implies (mid(f,i,j))/.1 = f/.i;

theorem 
  i in dom f & j in dom f implies (mid(f,i,j))/.len mid(f,i,j) = f /.j;

begin 

reserve X for compact Subset of TOP-REAL 2;

theorem 
  for p being Point of TOP-REAL 2 st p in X & p`2 = N-bound X
  holds p in N-most X;

theorem 
  for p being Point of TOP-REAL 2 st p in X & p`2 = S-bound X
  holds p in S-most X;

theorem 
  for p being Point of TOP-REAL 2 st p in X & p`1 = W-bound X
  holds p in W-most X;

theorem 
  for p being Point of TOP-REAL 2 st p in X & p`1 = E-bound X
  holds p in E-most X;

begin 

theorem 
  for f being FinSequence of TOP-REAL 2 st 1 <= i & i <= j & j <=
  len f holds L~mid(f,i,j) = union{ LSeg(f,k): i <= k & k < j};

theorem 
  for f being FinSequence of TOP-REAL 2 holds dom X_axis f = dom f;

theorem 
  for f being FinSequence of TOP-REAL 2 holds dom Y_axis f = dom f;

reserve r for Real;

theorem 
  for a,b,c being Point of TOP-REAL 2 st b in LSeg(a,c) & a`1 <= b
  `1 & c`1 <= b`1 holds a = b or b = c or a`1 = b`1 & c`1 = b`1;

theorem 
  for a,b,c being Point of TOP-REAL 2 st b in LSeg(a,c) & a`2 <= b
  `2 & c`2 <= b`2 holds a = b or b = c or a`2 = b`2 & c`2 = b`2;

theorem 
  for a,b,c being Point of TOP-REAL 2 st b in LSeg(a,c) & a`1 >= b
  `1 & c`1 >= b`1 holds a = b or b = c or a`1 = b`1 & c`1 = b`1;

theorem 
  for a,b,c being Point of TOP-REAL 2 st b in LSeg(a,c) & a`2 >= b
  `2 & c`2 >= b`2 holds a = b or b = c or a`2 = b`2 & c`2 = b`2;

begin 

definition
  let f, g be FinSequence of TOP-REAL 2;
  pred g is_in_the_area_of f means


  for n st n in dom g holds W-bound L~
f <= (g/.n)`1 & (g/.n)`1 <= E-bound L~f & S-bound L~f <= (g/.n)`2 & (g/.n)`2 <=
  N-bound L~f;
end;

theorem 
  for f being non trivial FinSequence of TOP-REAL 2 holds f is_in_the_area_of f
;

theorem 
  for f, g being FinSequence of TOP-REAL 2 st g is_in_the_area_of
  f for i,j st i in dom g & j in dom g holds mid(g,i,j) is_in_the_area_of f;

theorem 
  for f being non trivial FinSequence of TOP-REAL 2 for i,j st i in dom
  f & j in dom f holds mid(f,i,j) is_in_the_area_of f;

theorem 
  for f,g,h being FinSequence of TOP-REAL 2 st g is_in_the_area_of
  f & h is_in_the_area_of f holds g^h is_in_the_area_of f;

theorem 
  for f being non trivial FinSequence of TOP-REAL 2 holds <*
  NE-corner L~f*> is_in_the_area_of f;

theorem 
  for f being non trivial FinSequence of TOP-REAL 2 holds <*
  NW-corner L~f*> is_in_the_area_of f;

theorem 
  for f being non trivial FinSequence of TOP-REAL 2 holds <*
  SE-corner L~f*> is_in_the_area_of f;

theorem 
  for f being non trivial FinSequence of TOP-REAL 2 holds <*
  SW-corner L~f*> is_in_the_area_of f;

begin 

definition
  let f, g be FinSequence of TOP-REAL 2;
  pred g is_a_h.c._for f means


  g is_in_the_area_of f & (g/.1)`1 = W-bound L~f & (g/.len g)`1 = E-bound L~f;
  pred g is_a_v.c._for f means


  g is_in_the_area_of f & (g/.1)`2 = S-bound L~f & (g/.len g)`2 = N-bound L~f;
end;

theorem 
  for f being FinSequence of TOP-REAL 2, g,h being one-to-one
special FinSequence of TOP-REAL 2 st 2 <= len g & 2 <= len h & g is_a_h.c._for
  f & h is_a_v.c._for f holds L~g meets L~h;

begin 

definition
  let f be FinSequence of TOP-REAL 2;
  attr f is clockwise_oriented means


  (Rotate(f,N-min L~f))/.2 in N-most L~f;
end;

theorem 
  for f being non constant standard special_circular_sequence st f
  /.1 = N-min L~f holds f is clockwise_oriented iff f/.2 in N-most L~f;

registration
  cluster R^2-unit_square -> compact;
end;

theorem 
  N-bound R^2-unit_square = 1;

theorem 
  W-bound R^2-unit_square = 0;

theorem 
  E-bound R^2-unit_square = 1;

theorem 
  S-bound R^2-unit_square = 0;

theorem 
  N-most R^2-unit_square = LSeg(|[0,1]|,|[1,1]|);

theorem 
  N-min R^2-unit_square = |[0,1]|;

registration
  let X be non vertical non horizontal non empty compact Subset of TOP-REAL 2;
  cluster SpStSeq X -> clockwise_oriented;
end;

registration
  cluster clockwise_oriented for
non constant standard special_circular_sequence;
end;

theorem 
  for f being non constant standard special_circular_sequence, i,j
  st i > j & (1 < j & i <= len f or 1 <= j & i < len f) holds mid(f,i,j) is
  S-Sequence_in_R2;

theorem 
  for f being non constant standard special_circular_sequence, i,j
  st i < j & (1 < i & j <= len f or 1 <= i & j < len f) holds mid(f,i,j) is
  S-Sequence_in_R2;

reserve f for non trivial FinSequence of TOP-REAL 2;

theorem 
  N-min L~f in rng f;

theorem 
  N-max L~f in rng f;

theorem 
  S-min L~f in rng f;

theorem 
  S-max L~f in rng f;

theorem 
  W-min L~f in rng f;

theorem 
  W-max L~f in rng f;

theorem 
  E-min L~f in rng f;

theorem 
  E-max L~f in rng f;

reserve f for non constant standard special_circular_sequence;

theorem 
  1 <= i & i <= j & j < m & m <= n & n <= len f & (1 < i or n <
  len f) implies L~mid(f,i,j) misses L~mid(f,m,n);

theorem 
  1 <= i & i <= j & j < m & m <= n & n <= len f & (1 < i or n <
  len f) implies L~mid(f,i,j) misses L~mid(f,n,m);

theorem 
  1 <= i & i <= j & j < m & m <= n & n <= len f & (1 < i or n <
  len f) implies L~mid(f,j,i) misses L~mid(f,n,m);

theorem 
  1 <= i & i <= j & j < m & m <= n & n <= len f & (1 < i or n <
  len f) implies L~mid(f,j,i) misses L~mid(f,m,n);

theorem 
  (N-min L~f)`1 < (N-max L~f)`1;

theorem 
  N-min L~f <> N-max L~f;

theorem 
  (E-min L~f)`2 < (E-max L~f)`2;

theorem 
  E-min L~f <> E-max L~f;

theorem 
  (S-min L~f)`1 < (S-max L~f)`1;

theorem 
  S-min L~f <> S-max L~f;

theorem 
  (W-min L~f)`2 < (W-max L~f)`2;

theorem 
  W-min L~f <> W-max L~f;

theorem 
  LSeg(NW-corner L~f,N-min L~f) misses LSeg(N-max L~f,NE-corner L~ f);

theorem 
  for f being FinSequence of TOP-REAL 2, p being Point of TOP-REAL
2 st f is being_S-Seq & p <> f/.1 & (p`1 = (f/.1)`1 or p`2 = (f/.1)`2) & LSeg(p
  ,f/.1) /\ L~f = {f/.1} holds <*p*>^f is S-Sequence_in_R2;

theorem 
  for f being FinSequence of TOP-REAL 2, p being Point of TOP-REAL
2 st f is being_S-Seq & p <> f/.len f & (p`1 = (f/.len f)`1 or p`2 = (f/.len f)
  `2) & LSeg(p,f/.len f) /\ L~f = {f/.len f} holds f^<*p*> is S-Sequence_in_R2;

begin  

theorem 
  for i,j st i in dom f & j in dom f & mid(f,i,j) is
S-Sequence_in_R2 & f/.j = N-max L~f & N-max L~f <> NE-corner L~f holds mid(f,i,
  j)^<*NE-corner L~f*> is S-Sequence_in_R2;

theorem 
  for i,j st i in dom f & j in dom f & mid(f,i,j) is S-Sequence_in_R2 &
f/.j = E-max L~f & E-max L~f <> NE-corner L~f holds mid(f,i,j)^<*NE-corner L~f
  *> is S-Sequence_in_R2;

theorem 
  for i,j st i in dom f & j in dom f & mid(f,i,j) is
S-Sequence_in_R2 & f/.j = S-max L~f & S-max L~f <> SE-corner L~f holds mid(f,i,
  j)^<*SE-corner L~f*> is S-Sequence_in_R2;

theorem 
  for i,j st i in dom f & j in dom f & mid(f,i,j) is
S-Sequence_in_R2 & f/.j = E-max L~f & E-max L~f <> NE-corner L~f holds mid(f,i,
  j)^<*NE-corner L~f*> is S-Sequence_in_R2;

theorem 
  for i,j st i in dom f & j in dom f & mid(f,i,j) is
  S-Sequence_in_R2 & f/.i = N-min L~f & N-min L~f <> NW-corner L~f holds <*
  NW-corner L~f*>^mid(f,i,j) is S-Sequence_in_R2;

theorem 
  for i,j st i in dom f & j in dom f & mid(f,i,j) is
  S-Sequence_in_R2 & f/.i = W-min L~f & W-min L~f <> SW-corner L~f holds <*
  SW-corner L~f*>^mid(f,i,j) is S-Sequence_in_R2;

registration
  let f be non constant standard special_circular_sequence;
  cluster L~f -> being_simple_closed_curve;
end;

begin 

theorem 
  f/.1 = N-min L~f implies (N-min L~f)..f < (N-max L~f)..f;

theorem 
  f/.1 = N-min L~f implies (N-max L~f)..f > 1;

reserve z for clockwise_oriented non constant standard
  special_circular_sequence;

theorem 
  z/.1 = N-min L~z & N-max L~z <> E-max L~z implies (N-max L~z)..z < (
  E-max L~z)..z;

theorem 
  z/.1 = N-min L~z implies (E-max L~z)..z < (E-min L~z)..z;

theorem 
  z/.1 = N-min L~z & E-min L~z <> S-max L~z implies (E-min L~z)..z
  < (S-max L~z)..z;

theorem 
  z/.1 = N-min L~z implies (S-max L~z)..z < (S-min L~z)..z;

theorem 
  z/.1 = N-min L~z & S-min L~z <> W-min L~z implies (S-min L~z)..z < (
  W-min L~z)..z;

theorem 
  z/.1 = N-min L~z & N-min L~z <> W-max L~z implies (W-min L~z)..z
  < (W-max L~z)..z;

theorem 
  z/.1 = N-min L~z implies (W-min L~z)..z < len z;

theorem 
  f/.1 = N-min L~f implies (W-max L~f)..f < len f;














begin 

reserve x,y for set;
reserve s,r for real number;
reserve r1,r2 for Real;
reserve n for Element of NAT;
reserve p,q,q1,q2 for Point of TOP-REAL 2;

theorem 
  r<=s implies r <= (r+s)/2 & (r+s)/2 <= s;

theorem 
  for TX being non empty TopSpace, P being Subset of TX,
  A being Subset of TX|P, B being Subset of TX
  st B is closed & A=B/\P holds A is closed;

theorem 
  for TX,TY being non empty TopSpace,
  P being non empty Subset of TY,f being Function of TX,TY|P
  holds f is Function of TX,TY & for f2 being Function of TX,TY
  st f2=f & f is continuous holds f2 is continuous;

theorem 
  for r being real number, P being Subset of TOP-REAL 2
  st P={p where p is Point of TOP-REAL 2: p`1>=r} holds P is closed;

theorem 
  for r being real number, P being Subset of TOP-REAL 2
  st P={p where p is Point of TOP-REAL 2: p`1<=r} holds P is closed;

theorem 
  for r being real number,P being Subset of TOP-REAL 2
  st P={p where p is Point of TOP-REAL 2: p`1=r} holds P is closed;

theorem 
  for r being real number, P being Subset of TOP-REAL 2
  st P={p where p is Point of TOP-REAL 2: p`2>=r} holds P is closed;

theorem 
  for r being real number, P being Subset of TOP-REAL 2
  st P={p where p is Point of TOP-REAL 2: p`2<=r} holds P is closed;

theorem 
  for r being real number, P being Subset of TOP-REAL 2
  st P={p where p is Point of TOP-REAL 2: p`2=r} holds P is closed;

theorem 
  for P being Subset of TOP-REAL n, p1,p2 being Point of TOP-REAL n st
  P is_an_arc_of p1,p2 holds P is connected;

theorem 
  for P being Subset of TOP-REAL 2,p1,p2
  being Point of TOP-REAL 2 st P is_an_arc_of p1,p2 holds P is closed;

theorem 
  for P being Subset of TOP-REAL 2,
  p1,p2 being Point of TOP-REAL 2 st P is_an_arc_of p1,p2
  ex q being Point of TOP-REAL 2 st q in P & q`1 = (p1`1+p2`1)/2;

theorem 
  for P,Q being Subset of TOP-REAL 2,
  p1,p2 being Point of TOP-REAL 2 st P is_an_arc_of p1,p2 &
  Q={q:q`1=(p1`1+p2`1)/2} holds P meets Q & P /\ Q is closed;

theorem 
  for P,Q being Subset of TOP-REAL 2,
  p1,p2 being Point of TOP-REAL 2 st P is_an_arc_of p1,p2 &
  Q={q:q`2=(p1`2+p2`2)/2} holds P meets Q & P /\ Q is closed;

definition
  let P be Subset of TOP-REAL 2, p1,p2 be Point of TOP-REAL 2;
  func x_Middle(P,p1,p2) -> Point of TOP-REAL 2 means


  for Q being Subset of TOP-REAL 2 st Q={q:q`1=(p1`1+p2`1)/2}
  holds it=First_Point(P,p1,p2,Q);
end;

definition
  let P be Subset of TOP-REAL 2, p1,p2 be Point of TOP-REAL 2;
  func y_Middle(P,p1,p2) -> Point of TOP-REAL 2 means


  for Q being Subset of TOP-REAL 2 st Q={q:q`2=(p1`2+p2`2)/2}
  holds it=First_Point(P,p1,p2,Q);
end;

theorem 
  for P being Subset of TOP-REAL 2,
  p1,p2 being Point of TOP-REAL 2 st P is_an_arc_of p1,p2 holds
  x_Middle(P,p1,p2) in P & y_Middle(P,p1,p2) in P;

theorem 
  for P being Subset of TOP-REAL 2,
  p1,p2 being Point of TOP-REAL 2 st P is_an_arc_of p1,p2 holds
  p1=x_Middle(P,p1,p2) iff p1`1=p2`1;

theorem 
  for P being Subset of TOP-REAL 2,
  p1,p2 being Point of TOP-REAL 2 st P is_an_arc_of p1,p2 holds
  p1=y_Middle(P,p1,p2) iff p1`2=p2`2;

begin 

theorem 
  for P being Subset of TOP-REAL 2,
  p1,p2,q1,q2 being Point of TOP-REAL 2 st P is_an_arc_of p1,p2
  & LE q1,q2,P,p1,p2 holds LE q2,q1,P,p2,p1;

definition
  let P be Subset of TOP-REAL 2, p1,p2,q1 be Point of TOP-REAL 2;
  func L_Segment(P,p1,p2,q1) -> Subset of TOP-REAL 2 equals

  {q : LE q,q1,P,p1,p2};
end;

definition
  let P be Subset of TOP-REAL 2, p1,p2,q1 be Point of TOP-REAL 2;
  func R_Segment(P,p1,p2,q1) -> Subset of TOP-REAL 2 equals

  {q: LE q1,q,P,p1,p2};
end;

theorem 
  for P being Subset of TOP-REAL 2, p1,p2,q1 being Point of TOP-REAL 2
  holds L_Segment(P,p1,p2,q1) c= P;

theorem 
  for P being Subset of TOP-REAL 2, p1,p2,q1 being Point of TOP-REAL 2
  holds R_Segment(P,p1,p2,q1) c= P;

theorem 
  for P being Subset of TOP-REAL 2,
  p1,p2 being Point of TOP-REAL 2 st P is_an_arc_of p1,p2 holds
  L_Segment(P,p1,p2,p1)={p1};

theorem 
  for P being Subset of TOP-REAL 2,
  p1,p2 being Point of TOP-REAL 2 st P is_an_arc_of p1,p2 holds
  L_Segment(P,p1,p2,p2)=P;

theorem 
  for P being Subset of TOP-REAL 2,
  p1,p2 being Point of TOP-REAL 2 st P is_an_arc_of p1,p2 holds
  R_Segment(P,p1,p2,p2)={p2};

theorem 
  for P being Subset of TOP-REAL 2,p1,p2 being
  Point of TOP-REAL 2 st P is_an_arc_of p1,p2 holds R_Segment(P,p1,p2,p1)=P;

theorem 
  for P being Subset of TOP-REAL 2,
  p1,p2,q1 being Point of TOP-REAL 2 st P is_an_arc_of p1,p2
  holds
  R_Segment(P,p1,p2,q1)=L_Segment(P,p2,p1,q1);

definition
  let P be Subset of TOP-REAL 2, p1,p2,q1,q2 be Point of TOP-REAL 2;
  func Segment(P,p1,p2,q1,q2) -> Subset of TOP-REAL 2 equals

  R_Segment(P,p1,p2,q1) /\ L_Segment(P,p1,p2,q2);
end;

theorem 
  for P being Subset of TOP-REAL 2, p1,p2,q1,q2 being Point of TOP-REAL 2
  holds Segment(P,p1,p2,q1,q2)={q:LE q1,q,P,p1,p2 & LE q,q2,P,p1,p2};

theorem 
  for P being Subset of TOP-REAL 2, p1,p2,q1,q2 being Point of TOP-REAL 2
  st P is_an_arc_of p1,p2 & LE q2,q1,P,p2,p1
  holds LE q1,q2,P,p1,p2;

theorem 
  for P being Subset of TOP-REAL 2, p1,p2,q being Point of TOP-REAL 2 st
  P is_an_arc_of p1,p2
  holds L_Segment(P,p1,p2,q)=R_Segment(P,p2,p1,q);

theorem 
  for P being Subset of TOP-REAL 2, p1,p2,q1,q2 being Point of TOP-REAL 2 st
  P is_an_arc_of p1,p2
  holds Segment(P,p1,p2,q1,q2)=Segment(P,p2,p1,q2,q1);

begin 

definition
  let s be real number;
  func Vertical_Line(s) -> Subset of TOP-REAL 2 equals

  {p where p is Point of TOP-REAL 2: p`1=s};
  func Horizontal_Line(s) -> Subset of TOP-REAL 2 equals

  {p: p`2=s};
end;

theorem 
  for r being real number holds
  Vertical_Line(r) is closed & Horizontal_Line(r) is closed;

theorem 
  for r being real number,p being Point of TOP-REAL 2 holds
  p in Vertical_Line(r) iff p`1=r;

theorem 
  for r being real number,p being Point of TOP-REAL 2 holds
  p in Horizontal_Line(r) iff p`2=r;

theorem 
  for P being Subset of TOP-REAL 2 st P is being_simple_closed_curve
  ex P1,P2 being non empty Subset of TOP-REAL 2 st
  P1 is_an_arc_of W-min(P),E-max(P) & P2 is_an_arc_of E-max(P),W-min(P)
  & P1 /\ P2={W-min(P),E-max(P)} & P1 \/ P2=P
  & First_Point(P1,W-min(P),E-max(P),
  Vertical_Line((W-bound(P)+E-bound(P))/2))`2>
  Last_Point(P2,E-max(P),W-min(P), Vertical_Line((W-bound(P)+E-bound(P))/2))`2;

begin 

theorem 
  for P being Subset of I[01] st
  P=(the carrier of I[01]) \{0,1} holds P is open;

theorem 
  for P being Subset of R^1, r,s being real number st P=].r,s.[ holds P is open
;

theorem 
  for P7 being Subset of I[01] st
  P7=(the carrier of I[01]) \{0,1} holds P7<>{} & P7 is connected;

theorem 
  for P being Subset of TOP-REAL n,
  p1,p2 being Point of TOP-REAL n st P is_an_arc_of p1,p2 holds p1<>p2;

theorem 
  for P being Subset of TOP-REAL n, Q being Subset of (TOP-REAL n)|P,
  p1,p2 being Point of TOP-REAL n st
  P is_an_arc_of p1,p2 & Q=P\{p1,p2} holds Q is open;



theorem 
  for P,P1,P2 being Subset of TOP-REAL n, Q being Subset of (TOP-REAL n)|P,
  p1,p2 being Point of TOP-REAL n st
  P2 is_an_arc_of p1,p2
  & P1 \/ P2 = P & P1 /\ P2={p1,p2} & Q=P1\{p1,p2} holds Q is open;

theorem 
  for P being Subset of TOP-REAL n, Q being Subset of (TOP-REAL n)|P,
  p1,p2 being Point of TOP-REAL n st
  P is_an_arc_of p1,p2 & Q=P\{p1,p2} holds Q is connected;

theorem 
  for GX being TopSpace, P1, P being Subset of GX, Q9 being Subset of GX|P1,
  Q being Subset of GX|P st P1 c=P & Q=Q9 &
  Q9 is connected holds Q is connected;

theorem 
  for P being Subset of TOP-REAL n, p1,p2 being Point of TOP-REAL n st
  P is_an_arc_of p1,p2 ex p3 being Point of TOP-REAL n st
  p3 in P & p3<>p1 & p3<>p2;

theorem 
  for P being Subset of TOP-REAL n,
  p1,p2 being Point of TOP-REAL n st P is_an_arc_of p1,p2 holds P\{p1,p2}<>{};

theorem 
  for P1 being Subset of TOP-REAL n, P being Subset of TOP-REAL n,
  Q being Subset of (TOP-REAL n)|P, p1,p2 being Point of TOP-REAL n st
  P1 is_an_arc_of p1,p2 & P1 c=P & Q=P1\{p1,p2} holds Q is connected;

theorem 
  for T,S,V being non empty TopSpace, P1 being non empty Subset of S,
  P2 being Subset of S,
  f being Function of T,S|P1, g being Function of S|P2,V st
  P1 c= P2 & f is continuous & g is continuous
  ex h being Function of T,V st h=g*f & h is continuous;

theorem 
  for P1,P2 being Subset of TOP-REAL n, p1,p2 being Point of TOP-REAL n st
  P1 is_an_arc_of p1,p2 & P2 is_an_arc_of p1,p2 & P1 c= P2 holds P1=P2;

theorem 
  for P being Subset of TOP-REAL 2, Q being Subset of (TOP-REAL 2)|P,
  p1,p2 being Point of TOP-REAL 2
  st P is being_simple_closed_curve & p1 in P & p2 in P & p1<>p2 & Q=P\{p1,p2}
  holds not Q is connected;

theorem 
  for P,P1,P2,P19,P29 being Subset of TOP-REAL 2,
  p1,p2 being Point of TOP-REAL 2 st P is being_simple_closed_curve
  & P1 is_an_arc_of p1,p2 & P2 is_an_arc_of p1,p2 & P1 \/ P2=P
  & P19 is_an_arc_of p1,p2 & P29 is_an_arc_of p1,p2 & P19 \/ P29=P
  holds P1=P19 & P2=P29 or P1=P29 & P2=P19;

begin

theorem 
  for P1 being Subset of TOP-REAL 2,
  r being real number,p1,p2 being Point of TOP-REAL 2 st
  p1`1<=r & r<=p2`1 & P1 is_an_arc_of p1,p2 holds P1 meets Vertical_Line(r) &
  P1 /\ Vertical_Line(r) is closed;

definition
  let P be Subset of TOP-REAL 2 such that
 P is being_simple_closed_curve;
  func Upper_Arc(P) -> non empty Subset of TOP-REAL 2 means


  it is_an_arc_of W-min(P),E-max(P) &
  ex P2 being non empty Subset of TOP-REAL 2 st
  P2 is_an_arc_of E-max(P),W-min(P) & it /\ P2={W-min(P),E-max(P)}
  & it \/ P2=P & First_Point(it,W-min(P),E-max(P),
  Vertical_Line((W-bound(P)+E-bound(P))/2))`2>
  Last_Point(P2,E-max(P),W-min(P),
  Vertical_Line((W-bound(P)+E-bound(P))/2))`2;
end;

definition
  let P be Subset of TOP-REAL 2;
  assume
 P is being_simple_closed_curve;
  func Lower_Arc(P) -> non empty Subset of TOP-REAL 2 means


  it is_an_arc_of E-max(P),W-min(P) & Upper_Arc(P) /\ it={W-min(P),E-max(P)}
  & Upper_Arc(P) \/ it=P & First_Point(Upper_Arc(P),W-min(P),E-max(P),
  Vertical_Line((W-bound(P)+E-bound(P))/2))`2>
  Last_Point(it,E-max(P),W-min(P),
  Vertical_Line((W-bound(P)+E-bound(P))/2))`2;
end;

theorem 
  for P being Subset of TOP-REAL 2 st P is being_simple_closed_curve holds
  Upper_Arc(P) is_an_arc_of W-min(P),E-max(P) &
  Upper_Arc(P) is_an_arc_of E-max(P),W-min(P) &
  Lower_Arc(P) is_an_arc_of E-max(P),W-min(P) &
  Lower_Arc(P) is_an_arc_of W-min(P),E-max(P) &
  Upper_Arc(P) /\ Lower_Arc(P)={W-min(P),E-max(P)}
  & Upper_Arc(P) \/ Lower_Arc(P)=P
  & First_Point(Upper_Arc(P),W-min(P),E-max(P),
  Vertical_Line((W-bound(P)+E-bound(P))/2))`2>
  Last_Point(Lower_Arc(P),E-max(P),W-min(P),
  Vertical_Line((W-bound(P)+E-bound(P))/2))`2;

theorem 
  for P being Subset of TOP-REAL 2 st P is being_simple_closed_curve
  holds Lower_Arc(P)=(P\Upper_Arc(P)) \/ {W-min(P),E-max(P)} &
  Upper_Arc(P)=(P\Lower_Arc(P)) \/ {W-min(P),E-max(P)};

theorem 
  for P being Subset of TOP-REAL 2, P1 being Subset of (TOP-REAL 2)|P
  st P is being_simple_closed_curve
  & Upper_Arc(P) /\ P1={W-min(P),E-max(P)} & Upper_Arc(P) \/ P1=P
  holds P1=Lower_Arc(P);

theorem 
  for P being Subset of TOP-REAL 2, P1 being Subset of (TOP-REAL 2)|P
  st P is being_simple_closed_curve
  & P1 /\ Lower_Arc(P)={W-min(P),E-max(P)} & P1 \/ Lower_Arc(P)=P
  holds P1=Upper_Arc(P);

begin 

theorem 
  for P being Subset of TOP-REAL 2,
  p1, p2, q being Point of TOP-REAL 2 st P is_an_arc_of p1,p2 &
  LE q,p1,P,p1,p2 holds q=p1;

theorem 
  for P being Subset of TOP-REAL 2,
  p1, p2, q being Point of TOP-REAL 2 st P is_an_arc_of p1,p2 &
  LE p2,q,P,p1,p2 holds q=p2;

definition
  let P be Subset of TOP-REAL 2, q1,q2 be Point of TOP-REAL 2;
  pred LE q1,q2,P means


  q1 in Upper_Arc(P) & q2 in Lower_Arc(P)& not q2=W-min(P) or
  q1 in Upper_Arc(P) & q2 in Upper_Arc(P) &
  LE q1,q2,Upper_Arc(P),W-min(P),E-max(P) or
  q1 in Lower_Arc(P) & q2 in Lower_Arc(P)& not q2=W-min(P) &
  LE q1,q2,Lower_Arc(P),E-max(P),W-min(P);
end;

theorem 
  for P being Subset of TOP-REAL 2, q being Point of TOP-REAL 2
  st P is being_simple_closed_curve & q in P holds LE q,q,P;

theorem 
  for P being Subset of TOP-REAL 2, q1,q2 being Point of TOP-REAL 2
  st P is being_simple_closed_curve & LE q1,q2,P & LE q2,q1,P holds q1=q2;

theorem 
  for P being Subset of TOP-REAL 2, q1,q2,q3 being Point of TOP-REAL 2
  st P is being_simple_closed_curve & LE q1,q2,P & LE q2,q3,P holds LE q1,q3,P;

theorem 
  for P being Subset of TOP-REAL 2, p1,p2,q being Point of TOP-REAL 2
  st P is_an_arc_of p1,p2 & q <> p2 holds not p2 in L_Segment(P,p1,p2,q);

theorem 
  for P being Subset of TOP-REAL 2, p1,p2,q being Point of TOP-REAL 2
  st P is_an_arc_of p1,p2 & q <> p1 holds not p1 in R_Segment(P,p1,p2,q);

registration
  let S be non empty being_simple_closed_curve Subset of TOP-REAL 2;
  cluster Lower_Arc S -> non empty compact;
  cluster Upper_Arc S -> non empty compact;
end;

theorem 
  for S being being_simple_closed_curve non empty Subset of TOP-REAL 2
  holds Lower_Arc S c= S & Upper_Arc S c= S;

reserve C for Simple_closed_curve;

definition
  let C be Simple_closed_curve;
  func Lower_Middle_Point C -> Point of TOP-REAL 2 equals

  First_Point(Lower_Arc C,W-min C,E-max C,
  Vertical_Line((W-bound C+E-bound C)/2));
  func Upper_Middle_Point C -> Point of TOP-REAL 2 equals

  First_Point(Upper_Arc C,W-min C,E-max C,
  Vertical_Line((W-bound C+E-bound C)/2));
end;

theorem 
  Lower_Arc C meets Vertical_Line((W-bound C+E-bound C)/2);

theorem 
  Upper_Arc C meets Vertical_Line((W-bound C+E-bound C)/2);

theorem 
  (Lower_Middle_Point C)`1 = (W-bound C+E-bound C)/2;

theorem 
  (Upper_Middle_Point C)`1 = (W-bound C+E-bound C)/2;

theorem 
  Lower_Middle_Point C in Lower_Arc C;

theorem 
  Upper_Middle_Point C in Upper_Arc C;

theorem 
  Upper_Middle_Point C in C;

theorem 
  for C be Simple_closed_curve
  for r be real number st W-bound C <= r & r <= E-bound C holds
  LSeg(|[r,S-bound C]|,|[r,N-bound C]|) meets Upper_Arc C;

theorem 
  for C be Simple_closed_curve
  for r be real number st W-bound C <= r & r <= E-bound C holds
  LSeg(|[r,S-bound C]|,|[r,N-bound C]|) meets Lower_Arc C;















begin  

registration
  cluster transitive associative with_units strict for non empty AltCatStr;
end;

registration
  let A be non empty transitive AltCatStr, B be with_units non empty
  AltCatStr;
  cluster strict comp-preserving comp-reversing Covariant Contravariant
    feasible for FunctorStr over A, B;
end;

registration
  let A be with_units transitive non empty AltCatStr, B be with_units non
  empty AltCatStr;
  cluster strict comp-preserving comp-reversing Covariant Contravariant
    feasible id-preserving for FunctorStr over A, B;
end;

registration
  let A be with_units transitive non empty AltCatStr, B be with_units non
  empty AltCatStr;
  cluster strict feasible covariant contravariant for Functor of A, B;
end;

theorem 
  for C being category, o1, o2, o3, o4 being object of C for a being
Morphism of o1, o2, b being Morphism of o2, o3 for c being Morphism of o1, o4,
d being Morphism of o4, o3 st b*a = d*c & a*(a") = idm o2 & d"*d = idm o4 & <^
o1,o2^> <> {} & <^o2,o1^> <> {} & <^o2,o3^> <> {} & <^o3,o4^> <> {} & <^o4,o3^>
  <> {} holds c*(a") = d"*b;

theorem 
  for A being non empty transitive AltCatStr for B, C being with_units
non empty AltCatStr for F being feasible Covariant FunctorStr over A, B for G
being FunctorStr over B, C, o, o1 being object of A holds Morph-Map(G*F,o,o1) =
  Morph-Map(G,F.o,F.o1)*Morph-Map(F,o,o1);

theorem 
  for A being non empty transitive AltCatStr for B, C being with_units
  non empty AltCatStr for F being feasible Contravariant FunctorStr over A, B
for G being FunctorStr over B, C, o, o1 being object of A holds Morph-Map(G*F,o
  ,o1) = Morph-Map(G,F.o1,F.o)*Morph-Map(F,o,o1);

theorem 
  for A being non empty transitive AltCatStr for B being with_units non
  empty AltCatStr for F being feasible FunctorStr over A, B holds (id B) * F =
  the FunctorStr of F;

theorem 
  for A being with_units transitive non empty AltCatStr for B being
  with_units non empty AltCatStr for F being feasible FunctorStr over A, B
  holds F * (id A) = the FunctorStr of F;

reserve A for non empty AltCatStr,
  B, C for non empty reflexive AltCatStr,
  F for feasible Covariant FunctorStr over A, B,
  G for feasible Covariant FunctorStr over B, C,
  M for feasible Contravariant FunctorStr over A, B,
  N for feasible Contravariant FunctorStr over B, C,
  o1, o2 for object of A,
  m for Morphism of o1, o2;

theorem 
  <^o1,o2^> <> {} implies (G*F).m = G.(F.m);

theorem 
  <^o1,o2^> <> {} implies (N*M).m = N.(M.m);

theorem 
  <^o1,o2^> <> {} implies (N*F).m = N.(F.m);

theorem 
  <^o1,o2^> <> {} implies (G*M).m = G.(M.m);

registration
  let A be non empty transitive AltCatStr, B be transitive with_units non
  empty AltCatStr, C be with_units non empty AltCatStr, F be feasible
  Covariant comp-preserving FunctorStr over A, B, G be feasible Covariant
  comp-preserving FunctorStr over B, C;
  cluster G*F -> comp-preserving;
end;

registration
  let A be non empty transitive AltCatStr, B be transitive with_units non
  empty AltCatStr, C be with_units non empty AltCatStr, F be feasible
Contravariant comp-reversing FunctorStr over A, B, G be feasible Contravariant
  comp-reversing FunctorStr over B, C;
  cluster G*F -> comp-preserving;
end;

registration
  let A be non empty transitive AltCatStr, B be transitive with_units non
  empty AltCatStr, C be with_units non empty AltCatStr, F be feasible
  Covariant comp-preserving FunctorStr over A, B, G be feasible Contravariant
  comp-reversing FunctorStr over B, C;
  cluster G*F -> comp-reversing;
end;

registration
  let A be non empty transitive AltCatStr, B be transitive with_units non
  empty AltCatStr, C be with_units non empty AltCatStr, F be feasible
  Contravariant comp-reversing FunctorStr over A, B, G be feasible Covariant
  comp-preserving FunctorStr over B, C;
  cluster G*F -> comp-reversing;
end;

definition
  let A, B be transitive with_units non empty AltCatStr, C be with_units
non empty AltCatStr, F be covariant Functor of A, B, G be covariant Functor of
  B, C;
  redefine func G*F -> strict covariant Functor of A, C;
end;

definition
  let A, B be transitive with_units non empty AltCatStr, C be with_units
  non empty AltCatStr, F be contravariant Functor of A, B, G be contravariant
  Functor of B, C;
  redefine func G*F -> strict covariant Functor of A, C;
end;

definition
  let A, B be transitive with_units non empty AltCatStr, C be with_units
  non empty AltCatStr, F be covariant Functor of A, B, G be contravariant
  Functor of B, C;
  redefine func G*F -> strict contravariant Functor of A, C;
end;

definition
  let A, B be transitive with_units non empty AltCatStr, C be with_units
  non empty AltCatStr, F be contravariant Functor of A, B, G be covariant
  Functor of B, C;
  redefine func G*F -> strict contravariant Functor of A, C;
end;

reserve A, B, C, D for transitive with_units non empty AltCatStr,
  F1, F2, F3 for covariant Functor of A, B,
  G1, G2, G3 for covariant Functor of B, C,
  H1, H2 for covariant Functor of C, D,
  p for transformation of F1, F2,
  p1 for transformation of F2, F3,
  q for transformation of G1, G2,
  q1 for transformation of G2, G3,
  r for transformation of H1, H2;

theorem 
  F1 is_transformable_to F2 & G1 is_transformable_to G2 implies G1
  *F1 is_transformable_to G2*F2;

begin  

definition
  let A, B, C be transitive with_units non empty AltCatStr, F1, F2 be
  covariant Functor of A, B, t be transformation of F1, F2, G be covariant
  Functor of B, C such that
 F1 is_transformable_to F2;
  func G*t -> transformation of G*F1,G*F2 means


  for o being object of A holds it.o = G.(t!o);
end;

theorem 
  for o being object of A st F1 is_transformable_to F2 holds (G1*p
  )!o = G1.(p!o);

definition
  let A, B, C be transitive with_units non empty AltCatStr, G1, G2 be
covariant Functor of B, C, F be covariant Functor of A, B, s be transformation
  of G1, G2 such that
 G1 is_transformable_to G2;
  func s*F -> transformation of G1*F,G2*F means


  for o being object of A holds it.o = s!(F.o);
end;

theorem 
  for o being object of A st G1 is_transformable_to G2 holds (q*F1
  )!o = q!(F1.o);

theorem 
  F1 is_transformable_to F2 & F2 is_transformable_to F3 implies G1
  *(p1`*`p) = (G1*p1)`*`(G1*p);

theorem 
  G1 is_transformable_to G2 & G2 is_transformable_to G3 implies (
  q1`*`q)*F1 = (q1*F1)`*`(q*F1);

theorem 
  H1 is_transformable_to H2 implies r*G1*F1 = r*(G1*F1);

theorem 
  G1 is_transformable_to G2 implies H1*q*F1 = H1*(q*F1);

theorem 
  F1 is_transformable_to F2 implies H1*G1*p = H1*(G1*p);

theorem 
  (idt G1)*F1 = idt (G1*F1);

theorem 
  G1 * idt F1 = idt (G1*F1);

theorem 
  F1 is_transformable_to F2 implies (id B) * p = p;

theorem 
  G1 is_transformable_to G2 implies q * id B = q;

begin  

definition
  let A, B, C be transitive with_units non empty AltCatStr, F1, F2 be
  covariant Functor of A, B, G1, G2 be covariant Functor of B, C, t be
  transformation of F1, F2, s be transformation of G1, G2;
  func s (#) t -> transformation of G1*F1, G2*F2 equals

  (s*F2) `*` (G1*t);
end;

theorem 
  for q being natural_transformation of G1, G2 st F1
is_transformable_to F2 & G1 is_naturally_transformable_to G2 holds q (#) p = (
  G2*p) `*` (q*F1);

theorem 
  F1 is_transformable_to F2 implies (idt id B)(#)p = p;

theorem 
  G1 is_transformable_to G2 implies q(#)(idt id B) = q;

theorem 
  F1 is_transformable_to F2 implies G1*p = (idt G1) (#) p;

theorem 
  G1 is_transformable_to G2 implies q*F1 = q (#) idt F1;

reserve A, B, C, D for category,
  F1, F2, F3 for covariant Functor of A, B,
  G1, G2, G3 for covariant Functor of B, C;

theorem 
  for H1, H2 being covariant Functor of C, D for t being transformation
  of F1, F2, s being transformation of G1, G2 for u being transformation of H1,
  H2 st F1 is_transformable_to F2 & G1 is_transformable_to G2 & H1
  is_transformable_to H2 holds u(#)s(#)t = u(#)(s(#)t);

reserve t for natural_transformation of F1, F2,
  s for natural_transformation of G1, G2,
  s1 for natural_transformation of G2, G3;

theorem 
  F1 is_naturally_transformable_to F2 implies G1*t is
  natural_transformation of G1*F1, G1*F2;

theorem 
  G1 is_naturally_transformable_to G2 implies s*F1 is
  natural_transformation of G1*F1, G2*F1;

theorem 
  F1 is_naturally_transformable_to F2 & G1 is_naturally_transformable_to
  G2 implies G1*F1 is_naturally_transformable_to G2*F2 & s(#)t is
  natural_transformation of G1*F1, G2*F2;

theorem 
  for t being transformation of F1, F2, t1 being transformation of F2,
F3 st F1 is_naturally_transformable_to F2 & F2 is_naturally_transformable_to F3
  & G1 is_naturally_transformable_to G2 & G2 is_naturally_transformable_to G3
  holds (s1`*`s)(#)(t1`*`t) = (s1(#)t1)`*`(s(#)t);

begin  

theorem 
  F1 is_naturally_transformable_to F2 & F2 is_transformable_to F1
  & (for a being object of A holds t!a is iso) implies F2
is_naturally_transformable_to F1 & ex f being natural_transformation of F2, F1
  st for a being object of A holds f.a = (t!a)" & f!a is iso;

definition
  let A, B be category, F1, F2 be covariant Functor of A, B;
  pred F1, F2 are_naturally_equivalent means


  F1 is_naturally_transformable_to F2 & F2 is_transformable_to F1 & ex t being
  natural_transformation of F1, F2 st for a being object of A holds t!a is iso;
  reflexivity;
  symmetry;
end;

definition
  let A, B be category, F1, F2 be covariant Functor of A, B such that
 F1, F2 are_naturally_equivalent;
  mode natural_equivalence of F1, F2 -> natural_transformation of F1, F2 means


    for a being object of A holds it!a is iso;
end;

reserve e for natural_equivalence of F1, F2,
  e1 for natural_equivalence of F2, F3,
  f for natural_equivalence of G1, G2;

theorem 
  F1, F2 are_naturally_equivalent & F2, F3
  are_naturally_equivalent implies F1, F3 are_naturally_equivalent;

theorem 
  F1, F2 are_naturally_equivalent & F2, F3
  are_naturally_equivalent implies e1 `*` e is natural_equivalence of F1, F3;

theorem 
  F1, F2 are_naturally_equivalent implies G1*F1, G1*F2
  are_naturally_equivalent & G1*e is natural_equivalence of G1*F1, G1*F2;

theorem 
  G1, G2 are_naturally_equivalent implies G1*F1, G2*F1
  are_naturally_equivalent & f*F1 is natural_equivalence of G1*F1, G2*F1;

theorem 
  F1, F2 are_naturally_equivalent & G1, G2 are_naturally_equivalent
implies G1*F1, G2*F2 are_naturally_equivalent & f (#) e is natural_equivalence
  of G1*F1, G2*F2;

definition
  let A, B be category, F1, F2 be covariant Functor of A, B, e be
  natural_equivalence of F1, F2 such that
 F1, F2 are_naturally_equivalent;
  func e" -> natural_equivalence of F2, F1 means


  for a being object of A holds it.a = (e!a)";
end;

theorem 
  for o being object of A st F1, F2 are_naturally_equivalent holds
  e"!o = (e!o)";

theorem 
  F1, F2 are_naturally_equivalent implies e `*` e" = idt F2;

theorem 
  F1, F2 are_naturally_equivalent implies e" `*` e = idt F1;

definition
  let A, B be category, F be covariant Functor of A, B;
  redefine func idt F -> natural_equivalence of F, F;
end;

theorem 
  F1, F2 are_naturally_equivalent implies (e")" = e;

theorem 
  for k being natural_equivalence of F1, F3 st k = e1 `*` e & F1, F2
are_naturally_equivalent & F2, F3 are_naturally_equivalent holds k" = e" `*` e1
  ";

theorem 
  (idt F1)" = idt F1;














begin  

theorem 
  for L be sup-Semilattice for x,y be Element of L holds "/\"((
  uparrow x) /\ (uparrow y),L) = x "\/" y;

theorem 
  for L be Semilattice for x,y be Element of L holds "\/"((downarrow x)
  /\ (downarrow y),L) = x "/\" y;

theorem 
  for L be non empty RelStr for x,y be Element of L st x
is_maximal_in (the carrier of L) \ uparrow y holds (uparrow x) \ {x} = (uparrow
  x) /\ (uparrow y);

theorem 
  for L be non empty RelStr for x,y be Element of L st x is_minimal_in (
the carrier of L) \ downarrow y holds (downarrow x) \ {x} = (downarrow x) /\ (
  downarrow y);

theorem 
  for L be with_suprema Poset for X,Y be Subset of L for X9,Y9 be
  Subset of L opp st X = X9 & Y = Y9 holds X "\/" Y = X9 "/\" Y9;

theorem 
  for L be with_infima Poset for X,Y be Subset of L for X9,Y9 be Subset
  of L opp st X = X9 & Y = Y9 holds X "/\" Y = X9 "\/" Y9;

theorem 
  for L be non empty reflexive transitive RelStr holds Filt L = Ids (L opp);

theorem 
  for L be non empty reflexive transitive RelStr holds Ids L = Filt (L opp);

begin  

definition
  let S,T be complete non empty Poset;
  mode CLHomomorphism of S,T -> Function of S,T means

    it is directed-sups-preserving infs-preserving;
end;

definition
  let S be continuous complete non empty Poset;
  let A be Subset of S;
  pred A is_FG_set means

  for T be continuous complete non empty Poset for f
  be Function of A,the carrier of T ex h be CLHomomorphism of S,T st h|A = f &
  for h9 be CLHomomorphism of S,T st h9|A = f holds h9 = h;
end;

registration
  let L be upper-bounded non empty Poset;
  cluster Filt L -> non empty;
end;

theorem 
  for X be set for Y be non empty Subset of InclPoset Filt
  BoolePoset X holds meet Y is Filter of BoolePoset X;

theorem 
  for X be set for Y be non empty Subset of InclPoset Filt BoolePoset X
  holds ex_inf_of Y,InclPoset Filt BoolePoset X & "/\"(Y,InclPoset Filt
  BoolePoset X) = meet Y;

theorem 
  for X be set holds bool X is Filter of BoolePoset X;

theorem 
  for X be set holds {X} is Filter of BoolePoset X;

theorem 
  for X be set holds InclPoset Filt BoolePoset X is upper-bounded;

theorem 
  for X be set holds InclPoset Filt BoolePoset X is lower-bounded;

theorem 
  for X be set holds Top (InclPoset Filt BoolePoset X) = bool X;

theorem 
  for X be set holds Bottom (InclPoset Filt BoolePoset X) = {X};

theorem 
  for X be non empty set for Y be non empty Subset of InclPoset X st
  ex_sup_of Y,InclPoset X holds union Y c= sup Y;

theorem 
  for L be upper-bounded Semilattice holds InclPoset Filt L is complete;

registration
  let L be upper-bounded Semilattice;
  cluster InclPoset Filt L -> complete;
end;

begin  

definition
  let L be non empty RelStr;
  let p be Element of L;
  attr p is completely-irreducible means


  ex_min_of (uparrow p)\{p},L;
end;

theorem 
  for L be non empty RelStr for p be Element of L st p is
  completely-irreducible holds "/\"((uparrow p)\{p},L) <> p;

definition
  let L be non empty RelStr;
  func Irr L -> Subset of L means


  for x be Element of L holds x in it iff x is completely-irreducible;
end;

theorem 
  for L be non empty Poset for p be Element of L holds p is
completely-irreducible iff ex q be Element of L st p < q & (for s be Element of
  L st p < s holds q <= s) & uparrow p = {p} \/ uparrow q;

theorem 
  for L be upper-bounded non empty Poset holds not Top L in Irr L;

theorem 
  for L be Semilattice holds Irr L c= IRR L;

theorem 
  for L be Semilattice for x be Element of L holds x is
  completely-irreducible implies x is irreducible;

theorem 
  for L be non empty Poset for x be Element of L holds x is
completely-irreducible implies for X be Subset of L st ex_inf_of X,L & x = inf
  X holds x in X;

theorem 
  for L be non empty Poset for X be Subset of L st X is
  order-generating holds Irr L c= X;

theorem 
  for L be complete LATTICE for p be Element of L holds (ex k be
  Element of L st p is_maximal_in (the carrier of L) \ uparrow k) implies p is
  completely-irreducible;

theorem 
  for L be transitive antisymmetric with_suprema RelStr for p,q,u
be Element of L st p < q & (for s be Element of L st p < s holds q <= s) & not
  u <= p holds p "\/" u = q "\/" u;

theorem 
  for L be distributive LATTICE for p,q,u be Element of L st p < q
& (for s be Element of L st p < s holds q <= s) & not u <= p holds not u "/\" q
  <= p;

theorem 
  for L be distributive complete LATTICE st L opp is
meet-continuous for p be Element of L st p is completely-irreducible holds (the
  carrier of L) \ downarrow p is Open Filter of L;

theorem 
  for L be distributive complete LATTICE st L opp is meet-continuous for
p be Element of L holds p is completely-irreducible implies ex k be Element of
L st k in the carrier of CompactSublatt L & p is_maximal_in (the carrier of L)
  \ uparrow k;

theorem 
  for L be lower-bounded algebraic LATTICE for x,y be Element of L
holds not y <= x implies ex p be Element of L st p is completely-irreducible &
  x <= p & not y <= p;

theorem 
  for L be lower-bounded algebraic LATTICE holds Irr L is
order-generating & for X be Subset of L st X is order-generating holds Irr L c=
  X;

theorem 
  for L be lower-bounded algebraic LATTICE for s be Element of L holds s
  = "/\" (uparrow s /\ Irr L,L);

theorem 
  for L be complete non empty Poset for X be Subset of L for p
  be Element of L st p is completely-irreducible & p = inf X holds p in X;

theorem 
  for L be complete algebraic LATTICE for p be Element of L st p
  is completely-irreducible holds p = "/\" ({ x where x is Element of L : x in
  uparrow p & ex k be Element of L st k in the carrier of CompactSublatt L & x
  is_maximal_in (the carrier of L) \ uparrow k },L);

theorem 
  for L be complete algebraic LATTICE for p be Element of L holds (ex k
be Element of L st k in the carrier of CompactSublatt L & p is_maximal_in (the
  carrier of L) \ uparrow k) iff p is completely-irreducible;














begin 

definition
  let S be non empty set;
  let a, b be Element of S;
  func (a,b),... -> Function of NAT, S means


  for i being Element of NAT holds
  ((ex k being Element of NAT st i = 2*k) implies it.i = a) &
  ((not ex k being Element of NAT st i = 2*k) implies it.i = b);
end;

scheme 
 FuncFraenkelS{ B, C() -> non empty TopRelStr,
  A(set) -> Element of C(), f() -> Function, P[set]}:
  f().:{A(x) where x is Element of B(): P[x]} =
  {f().A(x) where x is Element of B(): P[x]}
provided
 the carrier of C() c= dom f();

scheme 
 FuncFraenkelSL{ B, C() -> LATTICE,
  A(set) -> Element of C(), f() -> Function, P[set]}:
  f().:{A(x) where x is Element of B(): P[x]} =
  {f().A(x) where x is Element of B(): P[x]}
provided
 the carrier of C() c= dom f();

theorem 
  for S, T being non empty reflexive RelStr, f being Function of S, T,
  P being lower Subset of T st f is monotone holds f"P is lower;

theorem 
  for S, T being non empty reflexive RelStr, f being Function of S, T,
  P being upper Subset of T st f is monotone holds f"P is upper;

theorem 
  for S, T being reflexive antisymmetric non empty RelStr,
  f being Function of S, T st
  f is directed-sups-preserving holds f is monotone;

registration
  let S, T be reflexive antisymmetric non empty RelStr;
  cluster directed-sups-preserving -> monotone for Function of S, T;
end;

theorem 
  for S, T being up-complete Scott TopLattice,
  f being Function of S, T holds f is continuous implies f is monotone;

registration
  let S, T be up-complete Scott TopLattice;
  cluster continuous -> monotone for Function of S, T;
end;

begin 

registration
  let S be set;
  let T be reflexive RelStr;
  cluster S --> T -> reflexive-yielding;
end;

registration
  let S be non empty set, T be complete LATTICE;
  cluster T |^ S -> complete;
end;

definition
  let S, T be up-complete Scott TopLattice;
  func SCMaps (S,T) -> strict full SubRelStr of MonMaps (S, T) means


  for f being Function of S, T holds f in the carrier of it iff
  f is continuous;
end;

registration
  let S, T be up-complete Scott TopLattice;
  cluster SCMaps (S,T) -> non empty;
end;

begin 

definition
  let S be non empty RelStr;
  let a, b be Element of S;
  func Net-Str (a,b) -> strict non empty NetStr over S means


  the carrier of it = NAT & the mapping of it = (a,b),... &
  for i, j being Element of it, i9, j9 being Element of NAT st i = i9 & j = j9
  holds i <= j iff i9 <= j9;
end;

registration
  let S be non empty RelStr;
  let a, b be Element of S;
  cluster Net-Str (a,b) -> reflexive transitive directed antisymmetric;
end;

theorem 
  for S being non empty RelStr, a, b being Element of S,
  i being Element of Net-Str (a, b) holds
  Net-Str (a, b).i = a or Net-Str (a, b).i = b;

theorem 
  for S being non empty RelStr, a, b being Element of S,
  i, j being Element of Net-Str (a,b),
  i9, j9 being Element of NAT st i9 = i & j9 = i9 + 1 & j9 = j holds
  (Net-Str (a, b).i = a implies Net-Str (a, b).j = b) &
  (Net-Str (a, b).i = b implies Net-Str (a, b).j = a);

theorem 
  for S being with_infima Poset, a, b being Element of S holds
  lim_inf Net-Str (a,b) = a "/\" b;

theorem 
  for S, T being with_infima Poset, a, b being Element of S,
  f being Function of S, T holds lim_inf (f*Net-Str (a,b)) = f.a "/\" f.b;

definition
  let S be non empty RelStr;
  let D be non empty Subset of S;
  func Net-Str D -> strict NetStr over S equals

  NetStr (#D, (the InternalRel of S)|_2 D, (id the carrier of S)|D#);
end;

theorem 
  for S being non empty reflexive RelStr, D being non empty Subset of S holds
  Net-Str D = Net-Str (D, (id the carrier of S)|D);

registration
  let S be non empty reflexive RelStr;
  let D be directed non empty Subset of S;
  cluster Net-Str D -> non empty directed reflexive;
end;

registration
  let S be non empty reflexive transitive RelStr;
  let D be directed non empty Subset of S;
  cluster Net-Str D -> transitive;
end;

registration
  let S be non empty reflexive RelStr;
  let D be directed non empty Subset of S;
  cluster Net-Str D -> monotone;
end;

theorem 
  for S being up-complete LATTICE,
  D being directed non empty Subset of S holds lim_inf Net-Str D = sup D;

begin 

theorem 
  for S, T being LATTICE, f being Function of S, T holds
  (for N being net of S holds f.(lim_inf N) <= lim_inf (f*N)) implies
  f is monotone;

scheme 
 NetFraenkelS{B, B1, C() -> non empty TopRelStr,
  A(set)->Element of C(),f() -> Function, P[set]}:
  f().:{A(x) where x is Element of B(): P[x]} =
  {f().A(x) where x is Element of B1(): P[x]}
provided
 the carrier of C() c= dom f() and
 the carrier of B() = the carrier of B1();

theorem 
  for S, T being continuous lower-bounded LATTICE,
  f being Function of S, T holds ( f is directed-sups-preserving implies
  for x being Element of S holds
  f.x = "\/"({ f.w where w is Element of S : w << x },T) );

theorem 
  for S being LATTICE, T being up-complete lower-bounded LATTICE,
  f being Function of S, T holds ( ( for x being Element of S holds
  f.x = "\/"({ f.w where w is Element of S : w << x },T) ) implies
  f is monotone);

theorem 
  for S being up-complete lower-bounded LATTICE,
  T being continuous lower-bounded LATTICE, f being Function of S, T holds
  ( ( for x being Element of S holds
  f.x = "\/"({ f.w where w is Element of S : w << x },T) ) implies
  for x being Element of S, y being Element of T
  holds y << f.x iff ex w being Element of S st w << x & y << f.w );

theorem 
  for S, T being non empty RelStr, D being Subset of S,
  f being Function of S, T st ex_sup_of D,S & ex_sup_of f.:D,T or
  S is complete antisymmetric & T is complete antisymmetric holds
  f is monotone implies sup (f.:D) <= f.(sup D);

theorem 
  for S, T being non empty reflexive antisymmetric RelStr,
  D being directed non empty Subset of S, f being Function of S, T st
  ex_sup_of D,S & ex_sup_of f.:D,T or
  S is up-complete & T is up-complete holds
  f is monotone implies sup (f.:D) <= f.(sup D);

theorem 
  for S, T being non empty RelStr, D being Subset of S,
  f being Function of S, T st ex_inf_of D,S & ex_inf_of f.:D,T or
  S is complete antisymmetric & T is complete antisymmetric holds
  f is monotone implies f.(inf D) <= inf (f.:D);

theorem 
  for S, T being up-complete LATTICE, f being Function of S, T,
  N being monotone non empty NetStr over S holds
  f is monotone implies f * N is monotone;

registration
  let S, T be up-complete LATTICE;
  let f be monotone Function of S, T;
  let N be monotone non empty NetStr over S;
  cluster f * N -> monotone;
end;

theorem 
  for S, T being up-complete LATTICE, f being Function of S, T holds
  (for N being net of S holds f.(lim_inf N) <= lim_inf (f*N)) implies
  for D being directed non empty Subset of S holds sup (f.:D) = f.(sup D);

theorem 
  for S, T being complete LATTICE, f being Function of S, T, N being net of S,
  j being Element of N, j9 being Element of (f*N) st j9 = j
  holds f is monotone implies f."/\"({N.k where k is Element of N: k >= j},S)
  <= "/\"({(f*N).l where l is Element of (f*N) : l >= j9},T);

begin 


theorem 
  for S, T being complete Scott TopLattice, f being Function of S, T holds
  f is continuous iff for N be net of S holds f.(lim_inf N) <= lim_inf (f*N);



theorem 
  for S, T being complete Scott TopLattice, f being Function of S, T holds
  f is continuous iff f is directed-sups-preserving;

registration
  let S, T be complete Scott TopLattice;
  cluster continuous -> directed-sups-preserving for Function of S, T;
  cluster directed-sups-preserving -> continuous for Function of S, T;
end;



theorem 
  for S, T being continuous complete Scott TopLattice,
  f being Function of S, T holds ( f is continuous iff
  for x being Element of S, y being Element of T
  holds y << f.x iff ex w being Element of S st w << x & y << f.w );



theorem 
  for S, T being continuous complete Scott TopLattice,
  f being Function of S, T holds ( f is continuous iff
  for x being Element of S holds
  f.x = "\/"({ f.w where w is Element of S : w << x },T) );

theorem 
  for S being LATTICE, T being complete LATTICE,
  f being Function of S, T holds ( for x being Element of S holds
  f.x = "\/"({ f.w where w is Element of S : w <= x & w is compact },T ) )
  implies f is monotone;

theorem 
  for S, T being complete Scott TopLattice, f being Function of S, T holds
  (( for x being Element of S holds
  f.x = "\/"({ f.w where w is Element of S : w <= x & w is compact },T ) )
  implies for x being Element of S holds
  f.x = "\/"({ f.w where w is Element of S : w << x },T) );



theorem 
  for S, T being complete Scott TopLattice, f being Function of S, T holds
  S is algebraic & T is algebraic implies ( f is continuous iff
  for x being Element of S, k being Element of T st
  k in the carrier of CompactSublatt T
  holds (k <= f.x iff ex j being Element of S st
  j in the carrier of CompactSublatt S & j <= x & k <= f.j) );



theorem 
  for S, T being complete Scott TopLattice, f being Function of S, T holds
  S is algebraic & T is algebraic implies ( f is continuous iff
  for x being Element of S holds
  f.x = "\/"({ f.w where w is Element of S : w <= x & w is compact },T ) );

theorem 
  for S, T being up-complete Scott non empty
  reflexive transitive antisymmetric TopSpace-like TopRelStr,
  f be Function of S, T holds
  f is directed-sups-preserving implies f is continuous;














begin 

theorem 
  for n be non empty Nat for F be Tuple of n,BOOLEAN holds Absval F
  < 2 to_power n;

theorem 
  for n be non empty Nat for F1,F2 be Tuple of n,BOOLEAN st Absval
  F1 = Absval F2 holds F1 = F2;

theorem 
  for t1,t2 be FinSequence st Rev t1 = Rev t2 holds t1 = t2;

theorem 
  for n be Nat holds 0*n in BOOLEAN*;

theorem 
  for n be Nat for y be Tuple of n,BOOLEAN st y = 0*n holds 'not' y = n |-> 1;

theorem 
  for n be non empty Nat for F be Tuple of n,BOOLEAN st F = 0*n
  holds Absval F = 0;

theorem 
  for n be non empty Nat for F be Tuple of n,BOOLEAN st F = 0*n holds
  Absval 'not' F = 2 to_power n - 1;

theorem 
  for n be Nat holds Rev (0*n) = 0*n;

theorem 
  for n be Nat for y be Tuple of n,BOOLEAN st y = 0*n holds Rev 'not' y
  = 'not' y;

theorem 
  Bin1 1 = <*TRUE*>;

theorem 
  for n be non empty Nat holds Absval (Bin1 n) = 1;

theorem 
  for x,y be Element of BOOLEAN holds (x 'or' y = TRUE iff x =
  TRUE or y = TRUE) & (x 'or' y = FALSE iff x = FALSE & y = FALSE);

theorem 
  for x,y be Element of BOOLEAN holds add_ovfl(<*x*>,<*y*>) = TRUE
  iff x = TRUE & y = TRUE;

theorem 
  'not' <*FALSE*> = <*TRUE*>;

theorem 
  'not' <*TRUE*> = <*FALSE*>;

theorem 
  <*FALSE*> + <*FALSE*> = <*FALSE*>;

theorem 
  <*FALSE*> + <*TRUE*> = <*TRUE*> & <*TRUE*> + <*FALSE*> = <*TRUE *>;

theorem 
  <*TRUE*> + <*TRUE*> = <*FALSE*>;

theorem 
  for n be non empty Nat for x,y be Tuple of n,BOOLEAN st x/.n =
  TRUE & (carry(x,Bin1 n))/.n = TRUE holds for k be non empty Nat st k <> 1 & k
  <= n holds x/.k = TRUE & (carry(x,Bin1 n))/.k = TRUE;

theorem 
  for n be non empty Nat for x be Tuple of n,BOOLEAN st x/.n =
  TRUE & (carry(x,Bin1 n))/.n = TRUE holds carry(x,Bin1 n) = 'not' Bin1 n;

theorem 
  for n be non empty Nat for x,y be Tuple of n,BOOLEAN st y = 0*n
  & x/.n = TRUE & (carry(x,Bin1 n))/.n = TRUE holds x = 'not' y;

theorem 
  for n be non empty Nat for y be Tuple of n,BOOLEAN st y = 0*n
  holds carry('not' y,Bin1 n) = 'not' Bin1 n;

theorem 
  for n be non empty Nat for x,y be Tuple of n,BOOLEAN st y = 0*n
  holds add_ovfl(x,Bin1 n) = TRUE iff x = 'not' y;

theorem 
  for n be non empty Nat for z be Tuple of n,BOOLEAN st z = 0*n
  holds 'not' z + Bin1 n = z;

begin 

definition
  let n,k be Nat;
  func n-BinarySequence k -> Tuple of n,BOOLEAN means


  for i be Nat st i
  in Seg n holds it/.i = IFEQ((k div 2 to_power (i-'1)) mod 2,0,FALSE,TRUE);
end;

theorem 
  for n be Nat holds n-BinarySequence 0 = 0*n;

theorem 
  for n,k be Nat st k < 2 to_power n holds ((n+1)-BinarySequence k
  ).(n+1) = FALSE;

theorem 
  for n be non empty Nat for k be Nat st k < 2 to_power n holds (n
  +1)-BinarySequence k = (n-BinarySequence k)^<*FALSE*>;

theorem 
  for i being Nat holds (i+1)-BinarySequence 2 to_power i= 0*i^<*1 *>;

theorem 
  for n be non empty Nat for k be Nat st 2 to_power n <= k & k < 2
  to_power (n+1) holds ((n+1)-BinarySequence k).(n+1) = TRUE;

theorem 
  for n be non empty Nat for k be Nat st 2 to_power n <= k & k < 2
  to_power (n+1) holds (n+1)-BinarySequence k = (n-BinarySequence (k -' 2
  to_power n))^<*TRUE*>;

theorem 
  for n be non empty Nat for k be Nat st k < 2 to_power n for x be Tuple
of n,BOOLEAN st x = 0*n holds n-BinarySequence k = 'not' x iff k = 2 to_power n
  - 1;

theorem 
  for n be non empty Nat for k be Nat st k + 1 < 2 to_power n
  holds add_ovfl(n-BinarySequence k,Bin1 n) = FALSE;

theorem 
  for n be non empty Nat for k be Nat st k + 1 < 2 to_power n
  holds n-BinarySequence (k+1) = n-BinarySequence k + Bin1 n;

theorem 
  for n,i be Nat holds (n+1)-BinarySequence i = <*i mod 2*> ^ (n
  -BinarySequence (i div 2));

theorem 
  for n be non empty Nat for k be Nat holds k < 2 to_power n
  implies Absval (n-BinarySequence k) = k;

theorem 
  for n be non empty Nat for x be Tuple of n,BOOLEAN holds n
  -BinarySequence (Absval x) = x;














begin

theorem 
  for D be set for p be FinSequence for n be Element of NAT holds p
  in D* implies p|Seg n in D*;

theorem 
  for T be binary Tree for t be Element of T holds t is FinSequence of BOOLEAN;

definition
  let T be binary Tree;
  redefine mode Element of T -> FinSequence of BOOLEAN;
end;

theorem 
  for T be Tree st T = {0,1}* holds T is binary;

theorem 
  for T be Tree st T = {0,1}* holds Leaves T = {};

theorem 
  for T be binary Tree for n be Element of NAT for t be Element of T st
  t in T-level n holds t is Element of n-tuples_on BOOLEAN;

theorem 
  for T be Tree st for t be Element of T holds succ t = { t^<* 0 *>, t^
  <* 1 *> } holds Leaves T = {};

theorem 
  for T be Tree st for t be Element of T holds succ t = { t^<* 0 *>
  , t^<* 1 *> } holds T is binary;

theorem 
  for T be Tree holds T = {0,1}* iff for t be Element of T holds
  succ t = { t^<* 0 *>, t^<* 1 *> };

scheme 

  DecoratedBinTreeEx {A() -> non empty set, a() -> Element of A(), P[set,set,
set]}: ex D be binary DecoratedTree of A() st dom D = {0,1}* & D.{} = a() & for
  x be Node of D holds P[D.x,D.(x ^ <* 0 *>),D.(x ^ <*1*>)]
provided
 for a be Element of A() ex b,c be Element of A() st P[a,b,c];

scheme 

  DecoratedBinTreeEx1 {A() -> non empty set, a() -> Element of A(), P[set,set]
, Q[set,set]}: ex D be binary DecoratedTree of A() st dom D = {0,1}* & D.{} = a
  () & for x be Node of D holds P[D.x,D.(x ^ <* 0 *>)] & Q[D.x,D.(x ^ <*1*>)]
provided
 for a be Element of A() ex b be Element of A() st P[a,b] and
 for a be Element of A() ex b be Element of A() st Q[a,b];

definition
  let T be binary Tree;
  let n be non empty Nat;
  func NumberOnLevel(n,T) -> Function of T-level n,NAT means


  for t be Element of T st t in T-level n
   for F be Element of n-tuples_on BOOLEAN st F = Rev t holds
  it.t = (Absval F) + 1;
end;

registration
  let T be binary Tree;
  let n be non empty Element of NAT;
  cluster NumberOnLevel(n,T) -> one-to-one;
end;

begin 

definition
  let T be Tree;
  attr T is full means


  T = {0,1}*;
end;

theorem 
  {0,1}* is Tree;

theorem 
  for T be Tree st T = {0,1}* for n be Nat holds 0*n in T-level n;

theorem 
  for T be Tree st T = {0,1}* for n be non empty Element of NAT
  for y be Element of n-tuples_on BOOLEAN holds y in T-level n;

registration
  let T be binary Tree;
  let n be Element of NAT;
  cluster T-level n -> finite;
end;

registration
  cluster full -> binary for Tree;
end;

registration
  cluster full for Tree;
end;

theorem 
  for T be full Tree for n be non empty Nat holds Seg (2 to_power
  n) c= rng NumberOnLevel(n,T);

definition
  let T be full Tree;
  let n be non empty Nat;
  func FinSeqLevel(n,T) -> FinSequence of T-level n equals

  NumberOnLevel(n,T)";
end;

registration
  let T be full Tree;
  let n be non empty Element of NAT;
  cluster FinSeqLevel(n,T) -> one-to-one;
end;

theorem 
  for T be full Tree for n be non empty Element of NAT holds
  NumberOnLevel(n,T).(0*n) = 1;

theorem 
  for T be full Tree for n be non empty Element of NAT for y be
  Element of n-tuples_on BOOLEAN st y = 0*n
  holds NumberOnLevel(n,T).'not' y = 2 to_power n;

theorem 
  for T be full Tree for n be non empty Element of NAT holds
  FinSeqLevel(n,T).1 = 0*n;

theorem 
  for T be full Tree for n be non empty Element of NAT for y be
  Element of n-tuples_on BOOLEAN
  st y = 0*n holds FinSeqLevel(n,T).(2 to_power n) = 'not' y;

theorem 
  for T be full Tree for n be non empty Element of NAT for i be
  Element of NAT st i in Seg (2 to_power n) holds FinSeqLevel(n,T).i = Rev (n
  -BinarySequence (i-'1));

theorem 
  for T be full Tree for n be Element of NAT holds card (T-level n
  ) = 2 to_power n;

theorem 
  for T be full Tree for n be non empty Element of NAT holds len
  FinSeqLevel(n,T) = 2 to_power n;

theorem 
  for T be full Tree for n be non empty Element of NAT holds dom
  FinSeqLevel(n,T) = Seg (2 to_power n);

theorem 
  for T be full Tree for n be non empty Element of NAT holds rng
  FinSeqLevel(n,T) = T-level n;

theorem 
  for T be full Tree holds FinSeqLevel(1,T).1 = <* 0 *>;

theorem 
  for T be full Tree holds FinSeqLevel(1,T).2 = <* 1 *>;

theorem 
  for T be full Tree for n,i be non empty Element of NAT st i <= 2
to_power (n+1) for F be Element of n-tuples_on BOOLEAN
st F = FinSeqLevel(n,T).((i+1) div 2
  ) holds FinSeqLevel(n+1,T).i = F^<*(i+1) mod 2*>;














begin  

registration
  let S, T be non empty upper-bounded RelStr;
  cluster [:S,T:] -> upper-bounded;
end;

registration
  let S, T be non empty lower-bounded RelStr;
  cluster [:S,T:] -> lower-bounded;
end;

theorem 
  for S, T being non empty RelStr st [:S,T:] is upper-bounded holds S is
  upper-bounded & T is upper-bounded;

theorem 
  for S, T being non empty RelStr st [:S,T:] is lower-bounded holds S is
  lower-bounded & T is lower-bounded;

theorem 
  for S, T being upper-bounded antisymmetric non empty RelStr holds
  Top [:S,T:] = [Top S,Top T];

theorem 
  for S, T being lower-bounded antisymmetric non empty RelStr holds
  Bottom [:S,T:] = [Bottom S,Bottom T];

theorem 
  for S, T being lower-bounded antisymmetric non empty RelStr, D
being Subset of [:S,T:] st [:S,T:] is complete or ex_sup_of D,[:S,T:] holds sup
  D = [sup proj1 D,sup proj2 D];

theorem 
  for S, T being upper-bounded antisymmetric non empty RelStr, D being
Subset of [:S,T:] st [:S,T:] is complete or ex_inf_of D,[:S,T:] holds inf D = [
  inf proj1 D,inf proj2 D];

theorem 
  for S, T being non empty RelStr, x, y being Element of [:S,T:] holds x
  is_<=_than {y} iff x`1 is_<=_than {y`1} & x`2 is_<=_than {y`2};

theorem 
  for S, T being non empty RelStr, x, y, z being Element of [:S,T:]
holds x is_<=_than {y,z} iff x`1 is_<=_than {y`1,z`1} & x`2 is_<=_than {y`2,z`2
  };

theorem 
  for S, T being non empty RelStr, x, y being Element of [:S,T:] holds x
  is_>=_than {y} iff x`1 is_>=_than {y`1} & x`2 is_>=_than {y`2};

theorem 
  for S, T being non empty RelStr, x, y, z being Element of [:S,T:]
holds x is_>=_than {y,z} iff x`1 is_>=_than {y`1,z`1} & x`2 is_>=_than {y`2,z`2
  };

theorem 
  for S, T being non empty antisymmetric RelStr, x, y being Element of
[:S,T:] holds ex_inf_of {x,y},[:S,T:] iff ex_inf_of {x`1,y`1}, S & ex_inf_of {x
  `2,y`2}, T;

theorem 
  for S, T being non empty antisymmetric RelStr, x, y being Element of
[:S,T:] holds ex_sup_of {x,y},[:S,T:] iff ex_sup_of {x`1,y`1}, S & ex_sup_of {x
  `2,y`2}, T;

theorem 
  for S, T being with_infima antisymmetric RelStr, x, y being
Element of [:S,T:] holds (x "/\" y)`1 = x`1 "/\" y`1 & (x "/\" y)`2 = x`2 "/\"
  y`2;

theorem 
  for S, T being with_suprema antisymmetric RelStr, x, y being
Element of [:S,T:] holds (x "\/" y)`1 = x`1 "\/" y`1 & (x "\/" y)`2 = x`2 "\/"
  y`2;

theorem 
  for S, T being with_infima antisymmetric RelStr, x1, y1 being
Element of S, x2, y2 being Element of T holds [x1 "/\" y1, x2 "/\" y2] = [x1,x2
  ] "/\" [y1,y2];

theorem 
  for S, T being with_suprema antisymmetric RelStr, x1, y1 being
Element of S, x2, y2 being Element of T holds [x1 "\/" y1, x2 "\/" y2] = [x1,x2
  ] "\/" [y1,y2];

definition
  let S be with_suprema with_infima antisymmetric RelStr, x, y be Element of S;
  redefine pred y is_a_complement_of x;
  symmetry;
end;

theorem 
  for S, T being bounded with_suprema with_infima antisymmetric
  RelStr, x, y being Element of [:S,T:] holds x is_a_complement_of y iff x`1
  is_a_complement_of y`1 & x`2 is_a_complement_of y`2;

theorem 
  for S, T being antisymmetric up-complete non empty reflexive
  RelStr, a, c being Element of S, b, d being Element of T st [a,b] << [c,d]
  holds a << c & b << d;

theorem 
  for S, T being up-complete non empty Poset for a, c being
Element of S, b, d being Element of T holds [a,b] << [c,d] iff a << c & b << d;

theorem 
  for S, T being antisymmetric up-complete non empty reflexive
RelStr, x, y being Element of [:S,T:] st x << y holds x`1 << y`1 & x`2 << y`2;

theorem 
  for S, T being up-complete non empty Poset, x, y being Element
  of [:S,T:] holds x << y iff x`1 << y`1 & x`2 << y`2;

theorem 
  for S, T being antisymmetric up-complete non empty reflexive
RelStr, x being Element of [:S,T:] st x is compact holds x`1 is compact & x`2
  is compact;

theorem 
  for S, T being up-complete non empty Poset, x being Element of
  [:S,T:] st x`1 is compact & x`2 is compact holds x is compact;

begin  

theorem 
  for S, T being with_infima antisymmetric RelStr, X, Y being
Subset of [:S,T:] holds proj1 (X "/\" Y) = proj1 X "/\" proj1 Y & proj2 (X "/\"
  Y) = proj2 X "/\" proj2 Y;

theorem 
  for S, T being with_suprema antisymmetric RelStr, X, Y being Subset of
  [:S,T:] holds proj1 (X "\/" Y) = proj1 X "\/" proj1 Y & proj2 (X "\/" Y) =
  proj2 X "\/" proj2 Y;

theorem 
  for S, T being RelStr, X being Subset of [:S,T:] holds downarrow X c=
  [:downarrow proj1 X,downarrow proj2 X:];

theorem 
  for S, T being RelStr, X being Subset of S, Y being Subset of T holds
  [:downarrow X,downarrow Y:] = downarrow [:X,Y:];

theorem 
  for S, T being RelStr, X being Subset of [:S,T:] holds proj1
  downarrow X c= downarrow proj1 X & proj2 downarrow X c= downarrow proj2 X;

theorem 
  for S being RelStr, T being reflexive RelStr, X being Subset of [:S,T
  :] holds proj1 downarrow X = downarrow proj1 X;

theorem 
  for S being reflexive RelStr, T being RelStr, X being Subset of [:S,T
  :] holds proj2 downarrow X = downarrow proj2 X;

theorem 
  for S, T being RelStr, X being Subset of [:S,T:] holds uparrow X c= [:
  uparrow proj1 X,uparrow proj2 X:];

theorem 
  for S, T being RelStr, X being Subset of S, Y being Subset of T holds
  [:uparrow X,uparrow Y:] = uparrow [:X,Y:];

theorem 
  for S, T being RelStr, X being Subset of [:S,T:] holds proj1
  uparrow X c= uparrow proj1 X & proj2 uparrow X c= uparrow proj2 X;

theorem 
  for S being RelStr, T being reflexive RelStr, X being Subset of [:S,T
  :] holds proj1 uparrow X = uparrow proj1 X;

theorem 
  for S being reflexive RelStr, T being RelStr, X being Subset of [:S,T
  :] holds proj2 uparrow X = uparrow proj2 X;

theorem 
  for S, T being non empty RelStr, s being Element of S, t being Element
  of T holds [:downarrow s,downarrow t:] = downarrow [s,t];

theorem 
  for S, T being non empty RelStr, x being Element of [:S,T:]
  holds proj1 downarrow x c= downarrow x`1 & proj2 downarrow x c= downarrow x`2
;

theorem 
  for S being non empty RelStr, T being non empty reflexive RelStr, x
  being Element of [:S,T:] holds proj1 downarrow x = downarrow x`1;

theorem 
  for S being non empty reflexive RelStr, T being non empty RelStr, x
  being Element of [:S,T:] holds proj2 downarrow x = downarrow x`2;

theorem 
  for S, T being non empty RelStr, s being Element of S, t being Element
  of T holds [:uparrow s,uparrow t:] = uparrow [s,t];

theorem 
  for S, T being non empty RelStr, x being Element of [:S,T:]
  holds proj1 uparrow x c= uparrow x`1 & proj2 uparrow x c= uparrow x`2;

theorem 
  for S being non empty RelStr, T being non empty reflexive RelStr, x
  being Element of [:S,T:] holds proj1 uparrow x = uparrow x`1;

theorem 
  for S being non empty reflexive RelStr, T being non empty RelStr, x
  being Element of [:S,T:] holds proj2 uparrow x = uparrow x`2;

theorem 
  for S, T being up-complete non empty Poset, s being Element of
  S, t being Element of T holds [:waybelow s,waybelow t:] = waybelow [s,t];

theorem 
  for S, T being antisymmetric up-complete non empty reflexive
  RelStr, x being Element of [:S,T:] holds proj1 waybelow x c= waybelow x`1 &
  proj2 waybelow x c= waybelow x`2;

theorem 
  for S being up-complete non empty Poset, T being up-complete
  lower-bounded non empty Poset, x being Element of [:S,T:] holds proj1
  waybelow x = waybelow x`1;

theorem 
  for S being up-complete lower-bounded non empty Poset, T being
up-complete non empty Poset, x being Element of [:S,T:] holds proj2 waybelow
  x = waybelow x`2;

theorem 
  for S, T being up-complete non empty Poset, s being Element of S, t
  being Element of T holds [:wayabove s,wayabove t:] = wayabove [s,t];

theorem 
  for S, T being antisymmetric up-complete non empty reflexive RelStr,
  x being Element of [:S,T:] holds proj1 wayabove x c= wayabove x`1 & proj2
  wayabove x c= wayabove x`2;

theorem 
  for S, T being up-complete non empty Poset, s being Element of
S, t being Element of T holds [:compactbelow s,compactbelow t:] = compactbelow
  [s,t];

theorem 
  for S, T being antisymmetric up-complete non empty reflexive
RelStr, x being Element of [:S,T:] holds proj1 compactbelow x c= compactbelow
  x`1 & proj2 compactbelow x c= compactbelow x`2;

theorem 
  for S being up-complete non empty Poset, T being up-complete
  lower-bounded non empty Poset, x being Element of [:S,T:] holds proj1
  compactbelow x = compactbelow x`1;

theorem 
  for S being up-complete lower-bounded non empty Poset, T being
  up-complete non empty Poset, x being Element of [:S,T:] holds proj2
  compactbelow x = compactbelow x`2;

registration
  let S be non empty reflexive RelStr;
  cluster empty -> Open for Subset of S;
end;

theorem 
  for S, T being antisymmetric up-complete non empty reflexive RelStr,
X being Subset of [:S,T:] st X is Open holds proj1 X is Open & proj2 X is Open;

theorem 
  for S, T being up-complete non empty Poset, X being Subset of S, Y
  being Subset of T st X is Open & Y is Open holds [:X,Y:] is Open;

theorem 
  for S, T being antisymmetric up-complete non empty reflexive RelStr,
X being Subset of [:S,T:] st X is inaccessible holds proj1 X is inaccessible &
  proj2 X is inaccessible;

theorem 
  for S, T being antisymmetric up-complete non empty reflexive RelStr,
  X being upper Subset of S, Y being upper Subset of T st X is inaccessible & Y
  is inaccessible holds [:X,Y:] is inaccessible;

theorem 
  for S, T being antisymmetric up-complete non empty reflexive RelStr,
X being Subset of S, Y being Subset of T st [:X,Y:] is directly_closed holds (Y
  <> {} implies X is directly_closed) & (X <> {} implies Y is directly_closed);

theorem 
  for S, T being antisymmetric up-complete non empty reflexive RelStr,
  X being Subset of S, Y being Subset of T st X is directly_closed & Y is
  directly_closed holds [:X,Y:] is directly_closed;

theorem 
  for S, T being antisymmetric up-complete non empty reflexive RelStr,
  X being Subset of [:S,T:] st X is property(S) holds proj1 X is property(S) &
  proj2 X is property(S);

theorem 
  for S, T being up-complete non empty Poset, X being Subset of S, Y
  being Subset of T st X is property(S) & Y is property(S) holds [:X,Y:] is
  property(S);

begin  

theorem 
  for S, T being non empty reflexive RelStr st the RelStr of S =
  the RelStr of T & S is /\-complete holds T is /\-complete;

registration
  let S be /\-complete non empty reflexive RelStr;
  cluster the RelStr of S -> /\-complete;
end;

registration
  let S, T be /\-complete non empty reflexive RelStr;
  cluster [:S,T:] -> /\-complete;
end;

theorem 
  for S, T being non empty reflexive RelStr st [:S,T:] is /\-complete
  holds S is /\-complete & T is /\-complete;

registration
  let S, T be complemented bounded with_infima with_suprema antisymmetric non
  empty RelStr;
  cluster [:S,T:] -> complemented;
end;

theorem 
  for S, T being bounded with_infima with_suprema antisymmetric RelStr
  st [:S,T:] is complemented holds S is complemented & T is complemented;

registration
  let S, T be distributive with_infima with_suprema antisymmetric non empty
  RelStr;
  cluster [:S,T:] -> distributive;
end;

theorem 
  for S being with_infima with_suprema antisymmetric RelStr, T being
  with_infima with_suprema reflexive antisymmetric RelStr st [:S,T:] is
  distributive holds S is distributive;

theorem 
  for S being with_infima with_suprema reflexive antisymmetric RelStr, T
being with_infima with_suprema antisymmetric RelStr st [:S,T:] is distributive
  holds T is distributive;

registration
  let S, T be meet-continuous Semilattice;
  cluster [:S,T:] -> satisfying_MC;
end;

theorem 
  for S, T being Semilattice st [:S,T:] is meet-continuous holds S is
  meet-continuous & T is meet-continuous;

registration
  let S, T be satisfying_axiom_of_approximation up-complete /\-complete non
  empty Poset;
  cluster [:S,T:] -> satisfying_axiom_of_approximation;
end;

registration
  let S, T be continuous /\-complete non empty Poset;
  cluster [:S,T:] -> continuous;
end;

theorem 
  for S, T being up-complete lower-bounded non empty Poset st [:S,T:]
  is continuous holds S is continuous & T is continuous;

registration
  let S, T be satisfying_axiom_K up-complete lower-bounded sup-Semilattice;
  cluster [:S,T:] -> satisfying_axiom_K;
end;

registration
  let S, T be complete algebraic lower-bounded sup-Semilattice;
  cluster [:S,T:] -> algebraic;
end;

theorem 
  for S, T being lower-bounded non empty Poset st [:S,T:] is
  algebraic holds S is algebraic & T is algebraic;

registration
  let S, T be arithmetic lower-bounded LATTICE;
  cluster [:S,T:] -> arithmetic;
end;

theorem 
  for S, T being lower-bounded LATTICE st [:S,T:] is arithmetic holds S
  is arithmetic & T is arithmetic;














begin 

theorem 
  for X being set, A,B being Subset-Family of X st B = A \ {{}} or
  A = B \/ {{}} holds UniCl A = UniCl B;

theorem 
  for T being TopSpace, K being Subset-Family of T holds K is Basis
  of T iff K \ {{}} is Basis of T;

definition
  let F be Relation;
  attr F is TopStruct-yielding means


  for x being set st x in rng F holds x is TopStruct;
end;

registration
  cluster TopStruct-yielding -> 1-sorted-yielding for Function;
end;

registration
  let I be set;
  cluster TopStruct-yielding for ManySortedSet of I;
end;

registration
  let I be set;
  cluster TopStruct-yielding non-Empty for ManySortedSet of I;
end;

definition
  let J be non empty set;
  let A be TopStruct-yielding ManySortedSet of J;
  let j be Element of J;
  redefine func A.j -> TopStruct;
end;

definition
  let I be set;
  let J be TopStruct-yielding ManySortedSet of I;
  func product_prebasis J -> Subset-Family of product Carrier J means


  for x being Subset of product Carrier J holds x in it iff ex i being set, T
  being TopStruct, V being Subset of T st i in I & V is open & T = J.i & x =
  product ((Carrier J) +* (i,V));
end;

theorem 
  for X be set, A be Subset-Family of X holds TopStruct (#X,UniCl
    FinMeetCl A#) is TopSpace-like;

definition
  let I be set;
  let J be TopStruct-yielding non-Empty ManySortedSet of I;
  func product J -> strict TopSpace means


  the carrier of it = product Carrier J & product_prebasis J is prebasis of it;
end;

registration
  let I be set;
  let J be TopStruct-yielding non-Empty ManySortedSet of I;
  cluster product J -> non empty;
end;

definition
  let I be non empty set;
  let J be TopStruct-yielding non-Empty ManySortedSet of I;
  let i be Element of I;
  redefine func J.i -> non empty TopStruct;
end;

registration
  let I be set;
  let J be TopStruct-yielding non-Empty ManySortedSet of I;
  cluster product J -> constituted-Functions;
end;

definition
  let I be non empty set;
  let J be TopStruct-yielding non-Empty ManySortedSet of I;
  let x be Element of product J;
  let i be Element of I;
  redefine func x.i -> Element of J.i;
end;

definition
  let I be non empty set;
  let J be TopStruct-yielding non-Empty ManySortedSet of I;
  let i be Element of I;
  func proj(J,i) -> Function of product J, J.i equals

  proj(Carrier J,i);
end;

theorem 
  for I being non empty set, J being TopStruct-yielding non-Empty
ManySortedSet of I, i being Element of I, P being Subset of J.i holds proj(J,i)
  "P = product ((Carrier J) +* (i,P));

theorem 
  for I being non empty set, J being TopStruct-yielding non-Empty
  ManySortedSet of I, i being Element of I holds proj(J,i) is continuous;

theorem 
  for X being non empty TopSpace, I being non empty set, J being
TopStruct-yielding non-Empty ManySortedSet of I, f being Function of X, product
  J holds f is continuous iff for i being Element of I holds proj(J,i)*f is
  continuous;

begin 

definition
  let Z be TopStruct;
  attr Z is injective means


  for X being non empty TopSpace for f being
  Function of X, Z st f is continuous holds for Y being non empty TopSpace st X
is SubSpace of Y ex g being Function of Y,Z st g is continuous & g|(the carrier
  of X) = f;
end;

theorem 
  for I being non empty set, J being TopStruct-yielding non-Empty
  ManySortedSet of I st for i being Element of I holds J.i is injective holds
  product J is injective;

theorem 
  for T being non empty TopSpace st T is injective for S being non empty
  SubSpace of T st S is_a_retract_of T holds S is injective;

definition
  let X be 1-sorted, Y be TopStruct, f be Function of X,Y;
  func Image f -> SubSpace of Y equals

  Y|(rng f);
end;

registration
  let X be non empty 1-sorted, Y be non empty TopStruct, f be Function of X,Y;
  cluster Image f -> non empty;
end;

theorem 
  for X being 1-sorted, Y being TopStruct, f being Function of X,Y
  holds the carrier of Image f = rng f;

definition
  let X be 1-sorted, Y be non empty TopStruct, f be Function of X,Y;
  func corestr(f) -> Function of X,Image f equals

  f;
end;

theorem 
  for X, Y being non empty TopSpace, f being Function of X,Y st f
  is continuous holds corestr f is continuous;

registration
  let X be 1-sorted,Y be non empty TopStruct;
  let f be Function of X,Y;
  cluster corestr f -> onto;
end;

definition
  let X,Y be TopStruct;
  pred X is_Retract_of Y means

  ex f being Function of Y,Y st f is continuous &
  f*f = f & Image f, X are_homeomorphic;
end;

theorem 
  for T,S being non empty TopSpace st T is injective for f being
  Function of T,S st corestr(f) is being_homeomorphism holds T is_Retract_of S;

definition
  func Sierpinski_Space -> strict TopStruct means


  the carrier of it = { 0,1} & the topology of it = {{}, {1}, {0,1} };
end;

registration
  cluster Sierpinski_Space -> non empty TopSpace-like;
end;

registration
  cluster Sierpinski_Space -> T_0;
end;

registration 
  cluster Sierpinski_Space -> injective;
end;

registration
  let I be set;
  let S be non empty 1-sorted;
  cluster I --> S -> non-Empty;
end;

registration
  let I be set;
  let T be TopStruct;
  cluster I --> T -> TopStruct-yielding;
end;

registration
  let I be non empty set;
  let L be non empty antisymmetric RelStr;
  cluster product (I --> L) -> antisymmetric;
end;

registration
  let I be non empty set;
  let L be non empty transitive RelStr;
  cluster product (I --> L) -> transitive;
end;

theorem 
  for T being Scott TopAugmentation of BoolePoset 1 holds the topology
  of T = the topology of Sierpinski_Space;

theorem 
  for I being non empty set holds {product ((Carrier (I -->
  Sierpinski_Space))+*(i,{1})) where i is Element of I: not contradiction } is
  prebasis of product (I --> Sierpinski_Space);

registration
  let I be non empty set;
  let L be complete LATTICE;
  cluster product (I --> L) -> with_suprema complete;
end;

registration
  let I be non empty set;
  let X be algebraic lower-bounded LATTICE;
  cluster product (I --> X) -> algebraic;
end;

theorem 
  for X being non empty set ex f being Function of BoolePoset X,
product (X --> BoolePoset 1) st f is isomorphic & for Y being Subset of X holds
  f.Y = chi(Y,X);

theorem 
  for I being non empty set for T being Scott TopAugmentation of
product (I --> BoolePoset 1) holds the topology of T = the topology of product
  (I --> Sierpinski_Space);

theorem 
  for T,S being non empty TopSpace st the carrier of T = the
  carrier of S & the topology of T = the topology of S & T is injective holds S
  is injective;

theorem 
  for I being non empty set for T being Scott TopAugmentation of product
  (I --> BoolePoset 1) holds T is injective;

theorem 
  for T being T_0-TopSpace ex M being non empty set, f being
  Function of T, product (M --> Sierpinski_Space) st corestr(f) is
  being_homeomorphism;

theorem 
  for T being T_0-TopSpace st T is injective ex M being non empty set st
  T is_Retract_of product (M --> Sierpinski_Space);














begin 

definition
  let I be non empty ZeroStr;
  func Q.I -> Subset of [:the carrier of I,the carrier of I:] means


  for u being set holds
  u in it iff ex a,b being Element of I st u = [a,b] & b <> 0.I;
end;

theorem 
  for I being non degenerated non empty multLoopStr_0 holds Q.I is non empty;

registration
  let I be non degenerated non empty multLoopStr_0;
  cluster Q.I -> non empty;
end;

theorem 
  for I being non degenerated non empty multLoopStr_0 for u being
  Element of Q.I holds u`2 <> 0.I;



definition
  let I be non degenerated domRing-like non empty doubleLoopStr;
  let u,v be Element of Q.I;
  func padd(u,v) -> Element of Q.I equals

  [u`1 * v`2 + v`1 * u`2, u`2 * v`2];
end;

definition
  let I be non degenerated domRing-like non empty doubleLoopStr;
  let u,v be Element of Q.I;
  func pmult(u,v) -> Element of Q.I equals

  [u`1 * v`1, u`2 * v`2];
end;

theorem 
  for I being non degenerated domRing-like associative commutative
Abelian add-associative distributive non empty doubleLoopStr for u,v,w being
Element of Q.I holds padd(u,padd(v,w)) = padd(padd(u,v),w);

theorem 
  for I being non degenerated domRing-like associative commutative
Abelian non empty doubleLoopStr for u,v,w being Element of Q.I holds pmult(u,
  pmult(v,w)) = pmult(pmult(u,v),w);

definition
  let I be non degenerated domRing-like associative commutative Abelian
  add-associative distributive non empty doubleLoopStr;
  let u, v be Element of Q.I;
  redefine func padd(u,v);
  commutativity;
end;

definition
  let I be non degenerated domRing-like associative commutative Abelian non
  empty doubleLoopStr;
  let u, v be Element of Q.I;
  redefine func pmult(u,v);
  commutativity;
end;



definition
  let I be non degenerated non empty multLoopStr_0;
  let u be Element of Q.I;
  func QClass.u -> Subset of Q.I means


  for z being Element of Q.I holds z in it iff z`1 * u`2 = z`2 * u`1;
end;

theorem 
  for I being non degenerated commutative non empty multLoopStr_0
  for u being Element of Q.I holds u in QClass.u;

registration
  let I be non degenerated commutative non empty multLoopStr_0;
  let u be Element of Q.I;
  cluster QClass.u -> non empty;
end;

definition
  let I be non degenerated non empty multLoopStr_0;
  func Quot.I -> Subset-Family of Q.I means


  for A being Subset of Q.I
  holds A in it iff ex u being Element of Q.I st A = QClass.u;
end;

theorem 
  for I being non degenerated non empty multLoopStr_0 holds Quot.
  I is non empty;

registration
  let I be non degenerated non empty multLoopStr_0;
  cluster Quot.I -> non empty;
end;

theorem 
  for I being non degenerated domRing-like commutative Ring for u,v
  being Element of Q.I holds (ex w being Element of Quot.I st u in w & v in w)
  implies u`1 * v`2 = v`1 * u`2;

theorem 
  for I being non degenerated domRing-like commutative Ring for u,v
  being Element of Quot.I holds u meets v implies u = v;

begin 

definition
  let I be non degenerated domRing-like commutative Ring;
  let u,v be Element of Quot.I;
  func qadd(u,v) -> Element of Quot.I means


  for z being Element of Q.I
holds z in it iff ex a,b being Element of Q.I st a in u & b in v & z`1 * (a`2 *
  b`2) = z`2 * (a`1 * b`2 + b`1 * a`2);
end;

definition
  let I be non degenerated domRing-like commutative Ring;
  let u,v be Element of Quot.I;
  func qmult(u,v) -> Element of Quot.I means


  for z being Element of Q.I
holds z in it iff ex a,b being Element of Q.I st a in u & b in v & z`1 * (a`2 *
  b`2) = z`2 * (a`1 * b`1);
end;

definition
  let I be non degenerated non empty multLoopStr_0;
  let u be Element of Q.I;
  redefine func QClass.u -> Element of Quot.I;
end;

theorem 
  for I being non degenerated domRing-like commutative Ring for u,
  v being Element of Q.I holds qadd(QClass.u,QClass.v) = QClass.(padd(u,v));

theorem 
  for I being non degenerated domRing-like commutative Ring for u,
  v being Element of Q.I holds qmult(QClass.u,QClass.v) = QClass.(pmult(u,v));



definition
  let I be non degenerated domRing-like commutative Ring;
  func q0.I -> Element of Quot.I means


  for z being Element of Q.I holds z in it iff z`1 = 0.I;
end;

definition
  let I be non degenerated domRing-like commutative Ring;
  func q1.I -> Element of Quot.I means


  for z being Element of Q.I holds z in it iff z`1 = z`2;
end;

definition
  let I be non degenerated domRing-like commutative Ring;
  let u be Element of Quot.I;
  func qaddinv(u) -> Element of Quot.I means


  for z being Element of Q.
I holds z in it iff ex a being Element of Q.I st a in u & z`1 * a`2 = z`2 * (-(
  a`1));
end;

definition
  let I be non degenerated domRing-like commutative Ring;
  let u be Element of Quot.I;
  assume
 u <> q0.I;
  func qmultinv(u) -> Element of Quot.I means


  for z being Element of
Q.I holds z in it iff ex a being Element of Q.I st a in u & z`1 * a`1 = z`2 * a
  `2;
end;

theorem 
  for I being non degenerated domRing-like commutative Ring for u,
v,w being Element of Quot.I holds qadd(u,qadd(v,w)) = qadd(qadd(u,v),w) & qadd(
  u,v) = qadd(v,u);

theorem 
  for I being non degenerated domRing-like commutative Ring for u
  being Element of Quot.I holds qadd(u,q0.I) = u & qadd(q0.I,u) = u;

theorem 
  for I being non degenerated domRing-like commutative Ring for u,
  v,w being Element of Quot.I holds qmult(u,qmult(v,w)) = qmult(qmult(u,v),w) &
  qmult(u,v) = qmult(v,u);

theorem 
  for I being non degenerated domRing-like commutative Ring for u
  being Element of Quot.I holds qmult(u,q1.I) = u & qmult(q1.I,u) = u;

theorem 
  for I being non degenerated domRing-like commutative Ring for u,
v,w being Element of Quot.I holds qmult(qadd(u,v),w) = qadd(qmult(u,w),qmult(v,
  w));

theorem 
  for I being non degenerated domRing-like commutative Ring for u,
v,w being Element of Quot.I holds qmult(u,qadd(v,w)) = qadd(qmult(u,v),qmult(u,
  w));

theorem 
  for I being non degenerated domRing-like commutative Ring for u
being Element of Quot.I holds qadd(u,qaddinv(u)) = q0.I & qadd(qaddinv(u),u) =
  q0.I;

theorem 
  for I being non degenerated domRing-like commutative Ring for u
being Element of Quot.I st u <> q0.I holds qmult(u,qmultinv(u)) = q1.I & qmult(
  qmultinv(u),u) = q1.I;

theorem 
  for I being non degenerated domRing-like commutative Ring holds q1.I <> q0.I;



definition
  let I be non degenerated domRing-like commutative Ring;
  func quotadd(I) -> BinOp of Quot.I means


  for u,v being Element of Quot.I holds it.(u,v) = qadd(u,v);
end;

definition
  let I be non degenerated domRing-like commutative Ring;
  func quotmult(I) -> BinOp of Quot.I means


  for u,v being Element of Quot.I holds it.(u,v) = qmult(u,v);
end;

definition
  let I be non degenerated domRing-like commutative Ring;
  func quotaddinv(I) -> UnOp of Quot.I means


  for u being Element of Quot.I holds it.(u) = qaddinv(u);
end;

definition
  let I be non degenerated domRing-like commutative Ring;
  func quotmultinv(I) -> UnOp of Quot.I means


  for u being Element of Quot.I holds it.(u) = qmultinv(u);
end;

theorem 
  for I being non degenerated domRing-like commutative Ring for u,
  v,w being Element of Quot.I holds (quotadd(I)).((quotadd(I)).(u,v),w) = (
  quotadd(I)).(u,(quotadd(I)).(v,w));

theorem 
  for I being non degenerated domRing-like commutative Ring for u,
  v being Element of Quot.I holds (quotadd(I)).(u,v) = (quotadd(I)).(v,u);

theorem 
  for I being non degenerated domRing-like commutative Ring for u
being Element of Quot.I holds (quotadd(I)).(u,q0.I) = u & (quotadd(I)).(q0.I,u)
  = u;

theorem 
  for I being non degenerated domRing-like commutative Ring for u,
  v,w being Element of Quot.I holds (quotmult(I)).((quotmult(I)).(u,v),w) = (
  quotmult(I)).(u,(quotmult(I)).(v,w));

theorem 
  for I being non degenerated domRing-like commutative Ring for u,
  v being Element of Quot.I holds (quotmult(I)).(u,v)=(quotmult(I)).(v,u);

theorem 
  for I being non degenerated domRing-like commutative Ring for u
being Element of Quot.I holds (quotmult(I)).(u,q1.I) = u & (quotmult(I)).(q1.I,
  u) = u;

theorem 
  for I being non degenerated domRing-like commutative Ring for u,
  v,w being Element of Quot.I holds (quotmult(I)).((quotadd(I)).(u,v),w) = (
  quotadd(I)).((quotmult(I)).(u,w),(quotmult(I)).(v,w));

theorem 
  for I being non degenerated domRing-like commutative Ring for u,
  v,w being Element of Quot.I holds (quotmult(I)).(u,(quotadd(I)).(v,w)) = (
  quotadd(I)).((quotmult(I)).(u,v),(quotmult(I)).(u,w));

theorem 
  for I being non degenerated domRing-like commutative Ring for u
  being Element of Quot.I holds (quotadd(I)).(u,(quotaddinv(I)).(u)) = q0.I & (
  quotadd(I)).((quotaddinv(I)).(u),u) = q0.I;

theorem 
  for I being non degenerated domRing-like commutative Ring for u
being Element of Quot.I st u <> q0.I holds (quotmult(I)).(u,(quotmultinv(I)).(u
  )) = q1.I & (quotmult(I)).((quotmultinv(I)).(u),u) = q1.I;

begin 

definition
  let I be non degenerated domRing-like commutative Ring;
  func the_Field_of_Quotients(I) -> strict doubleLoopStr equals

  doubleLoopStr
  (# Quot.I,quotadd(I),quotmult(I),q1.I,q0.I #);
end;

registration
  let I be non degenerated domRing-like commutative Ring;
  cluster the_Field_of_Quotients(I) -> non empty;
end;

theorem 
  for I being non degenerated domRing-like commutative Ring holds the
  carrier of the_Field_of_Quotients(I) = Quot.I & the addF of
the_Field_of_Quotients(I) = quotadd(I) & the multF of the_Field_of_Quotients(I)
= quotmult(I) & 0.the_Field_of_Quotients(I) = q0.I & 1.the_Field_of_Quotients(I
  ) = q1.I;

theorem 
  for I being non degenerated domRing-like commutative Ring for u,v
being Element of the_Field_of_Quotients(I) holds (quotadd(I)).(u,v) is Element
  of the_Field_of_Quotients(I);

theorem 
  for I being non degenerated domRing-like commutative Ring for u
being Element of the_Field_of_Quotients(I) holds (quotaddinv(I)).(u) is Element
  of the_Field_of_Quotients(I);

theorem 
  for I being non degenerated domRing-like commutative Ring for u,v
being Element of the_Field_of_Quotients(I) holds (quotmult(I)).(u,v) is Element
  of the_Field_of_Quotients(I);

theorem 
  for I being non degenerated domRing-like commutative Ring for u being
  Element of the_Field_of_Quotients(I) holds (quotmultinv(I)).(u) is Element of
  the_Field_of_Quotients(I);

theorem 
  for I being non degenerated domRing-like commutative Ring for u,v
  being Element of the_Field_of_Quotients(I) holds u + v = (quotadd(I)).(u,v);

registration
  let I be non degenerated domRing-like commutative Ring;
  cluster the_Field_of_Quotients(I) -> add-associative right_zeroed
    right_complementable;
end;

theorem 
  for I being non degenerated domRing-like commutative Ring for u being
  Element of the_Field_of_Quotients(I) holds -u = (quotaddinv(I)).(u);

theorem 
  for I being non degenerated domRing-like commutative Ring for u,v
  being Element of the_Field_of_Quotients(I) holds u * v = (quotmult(I)).(u,v);

registration
  let I be non degenerated domRing-like commutative Ring;
  cluster the_Field_of_Quotients(I) -> commutative;
end;

registration
  let I be non degenerated domRing-like commutative Ring;
  cluster the_Field_of_Quotients(I) -> well-unital;
end;

theorem 
  for I being non degenerated domRing-like commutative Ring holds 1.
  the_Field_of_Quotients(I) = q1.I & 0.the_Field_of_Quotients(I) = q0.I;

theorem 
  for I being non degenerated domRing-like commutative Ring for u,v,w
  being Element of the_Field_of_Quotients(I) holds (u + v) + w = u + (v + w);

theorem 
  for I being non degenerated domRing-like commutative Ring for u,v
  being Element of the_Field_of_Quotients(I) holds u + v = v + u;

theorem 
  for I being non degenerated domRing-like commutative Ring for u being
Element of the_Field_of_Quotients(I) holds u + 0.the_Field_of_Quotients(I) = u;

theorem 
  for I being non degenerated domRing-like commutative Ring for u being
Element of the_Field_of_Quotients(I) holds 1.the_Field_of_Quotients(I) * u = u;

theorem 
  for I being non degenerated domRing-like commutative Ring for u,v
  being Element of the_Field_of_Quotients(I) holds u * v = v * u;

theorem 
  for I being non degenerated domRing-like commutative Ring for u,v,w
  being Element of the_Field_of_Quotients(I) holds (u * v) * w = u * (v * w);

theorem 
  for I being non degenerated domRing-like commutative Ring for u
being Element of the_Field_of_Quotients(I) st u <> 0.the_Field_of_Quotients(I)
  ex v being Element of the_Field_of_Quotients(I) st u * v = 1.
  the_Field_of_Quotients(I);

theorem 
  for I being non degenerated domRing-like commutative Ring holds
the_Field_of_Quotients(I) is add-associative right_zeroed right_complementable
Abelian associative unital distributive almost_left_invertible non degenerated
  non empty doubleLoopStr;

registration
  let I be non degenerated domRing-like commutative Ring;
  cluster the_Field_of_Quotients(I) -> Abelian associative distributive
    almost_left_invertible non degenerated;
end;

theorem 
  for I being non degenerated domRing-like commutative Ring for x
being Element of the_Field_of_Quotients(I) st x <> 0.the_Field_of_Quotients(I)
for a being Element of I st a <> 0.I for u being Element of Q.I st x = QClass.u
  & u = [a,1.I] for v being Element of Q.I st v = [1.I,a] holds x" = QClass.v;



registration
  cluster -> domRing-like right_unital for add-associative right_zeroed
    right_complementable commutative associative well-unital distributive
    almost_left_invertible non empty doubleLoopStr;
end;

registration
  cluster add-associative right_zeroed right_complementable Abelian
    commutative associative left_unital distributive almost_left_invertible non
    degenerated for non empty doubleLoopStr;
end;

definition
  let F be commutative associative well-unital distributive
  almost_left_invertible non empty doubleLoopStr;
  let x, y be Element of F;
  func x/y -> Element of F equals

  x * y";
end;

theorem 
  for F being non degenerated almost_left_invertible commutative
Ring for a,b,c,d being Element of F st b <> 0.F & d <> 0.F holds (a/b) * (c/d)
  = (a * c) / (b * d);

theorem 
  for F being non degenerated almost_left_invertible commutative
Ring for a,b,c,d being Element of F st b <> 0.F & d <> 0.F holds (a/b) + (c/d)
  = (a*d + c*b) / (b * d);

begin 

definition
  let R,S be non empty doubleLoopStr;
  let f be Function of R, S;

  attr f is RingHomomorphism means


  f is additive multiplicative unity-preserving;
end;

registration
  let R,S be non empty doubleLoopStr;
  cluster RingHomomorphism -> additive multiplicative unity-preserving
    for Function of R, S;
  cluster additive multiplicative unity-preserving -> RingHomomorphism
    for Function of R, S;
end;

definition
  let R,S be non empty doubleLoopStr;
  let f be Function of R, S;
  attr f is RingEpimorphism means


  f is RingHomomorphism & rng f = the carrier of S;
  attr f is RingMonomorphism means


  f is RingHomomorphism & f is one-to-one;
end;

notation
  let R,S be non empty doubleLoopStr;
  let f be Function of R, S;
  synonym f is embedding for f is RingMonomorphism;
end;

definition
  let R,S be non empty doubleLoopStr;
  let f be Function of R, S;
  attr f is RingIsomorphism means


  f is RingMonomorphism RingEpimorphism;
end;

registration
  let R,S be non empty doubleLoopStr;
  cluster RingIsomorphism -> RingMonomorphism RingEpimorphism for
Function of R, S;
  cluster RingMonomorphism RingEpimorphism -> RingIsomorphism for
Function of R, S;
end;

theorem 
  for R,S being Ring for f being Function of R, S st f is
  RingHomomorphism holds f.(0.R) = 0.S;

theorem 
  for R,S being Ring for f being Function of R, S st f is
  RingMonomorphism for x being Element of R holds f.x = 0.S iff x = 0.R;

theorem 
  for R,S being non degenerated almost_left_invertible commutative
Ring for f being Function of R, S st f is RingHomomorphism for x being Element
  of R st x <> 0.R holds f.(x") = (f.x)";

theorem 
  for R,S being non degenerated almost_left_invertible commutative
  Ring for f being Function of R, S st f is RingHomomorphism for x,y being
  Element of R st y <> 0.R holds f.(x * y") = f.x * (f.y)";

theorem 
  for R,S,T being Ring for f being Function of R, S st f is
RingHomomorphism for g being Function of S, T st g is RingHomomorphism holds g*
  f is RingHomomorphism;

theorem 
  for R being non empty doubleLoopStr holds id R is RingHomomorphism;

registration
  let R be non empty doubleLoopStr;
  cluster id R -> RingHomomorphism;
end;

definition
  let R,S be non empty doubleLoopStr;
  pred R is_embedded_in S means


  ex f being Function of R, S st f is RingMonomorphism;
end;

definition
  let R,S be non empty doubleLoopStr;
  pred R is_ringisomorph_to S means


  ex f being Function of R, S st f is RingIsomorphism;
  symmetry;
end;

begin 

definition
  let I be non empty ZeroStr;
  let x, y be Element of I;
  assume
 y <> 0.I;
  func quotient(x,y) -> Element of Q.I equals


  [x,y];
end;

definition
  let I be non degenerated domRing-like commutative Ring;
  func canHom(I) -> Function of I, the_Field_of_Quotients(I) means


  for x being Element of I holds it.x = QClass.(quotient(x,1.I));
end;

theorem 
  for I being non degenerated domRing-like commutative Ring holds
  canHom(I) is RingHomomorphism;

theorem 
  for I being non degenerated domRing-like commutative Ring holds
  canHom(I) is embedding;

theorem 
  for I being non degenerated domRing-like commutative Ring holds I
  is_embedded_in the_Field_of_Quotients(I);

theorem 
  for F being non degenerated almost_left_invertible domRing-like
  commutative Ring holds F is_ringisomorph_to the_Field_of_Quotients(F);

registration
  let I be non degenerated domRing-like commutative Ring;
  cluster the_Field_of_Quotients(I) -> domRing-like right_unital
    right-distributive;
end;

theorem 
  for I being non degenerated domRing-like commutative Ring holds
  the_Field_of_Quotients(the_Field_of_Quotients(I)) is_ringisomorph_to
  the_Field_of_Quotients(I);



definition
  let I, F be non empty doubleLoopStr;
  let f be Function of I, F;
  pred I has_Field_of_Quotients_Pair F,f means


  f is RingMonomorphism &
  for F9 being add-associative right_zeroed right_complementable Abelian
  commutative associative well-unital distributive almost_left_invertible non
  degenerated non empty doubleLoopStr for f9 being Function of I, F9 st f9 is
RingMonomorphism holds ex h being Function of F, F9 st h is RingHomomorphism &
h*f = f9 & for h9 being Function of F, F9 st h9 is RingHomomorphism & h9*f = f9
  holds h9 = h;
end;

theorem 
  for I being non degenerated domRing-like commutative Ring holds ex F
  being add-associative right_zeroed right_complementable Abelian commutative
  associative well-unital distributive almost_left_invertible non degenerated
  non empty doubleLoopStr st ex f being Function of I, F st I
  has_Field_of_Quotients_Pair F,f;

theorem 
  for I being domRing-like commutative Ring for F,F9 being
  add-associative right_zeroed right_complementable Abelian commutative
  associative well-unital distributive almost_left_invertible non degenerated
non empty doubleLoopStr for f being Function of I, F for f9 being Function of
I, F9 st I has_Field_of_Quotients_Pair F,f & I has_Field_of_Quotients_Pair F9,
  f9 holds F is_ringisomorph_to F9;














begin





theorem 
  for T being non empty 1-sorted,S being sequence of T holds
  rng S is Subset of T;

theorem 
  for T1 being non empty 1-sorted, T2 being 1-sorted, S being
  sequence of T1 st rng S c= the carrier of T2 holds S is sequence of T2;

theorem 
  for T being non empty TopSpace, x being Point of T, B being Basis
  of x holds B <> {};

registration
  let T be non empty TopSpace;
  let x be Point of T;
  cluster -> non empty for Basis of x;
end;

theorem 
  for T being TopSpace, A,B being Subset of T st A is open & B is
  closed holds A \ B is open;

theorem 
  for T being TopStruct st {}T is closed & [#]T is closed & (for A,
B being Subset of T st A is closed & B is closed holds A \/ B is closed) & for
  F being Subset-Family of T st F is closed holds meet F is closed holds T is
  TopSpace;

theorem 
  for T being TopSpace, S being non empty TopStruct, f being
Function of T,S st for A being Subset of S holds A is closed iff f"A is closed
  holds S is TopSpace;

theorem 
  for x being Point of RealSpace, r being Real holds
  Ball(x,r) = ].x-r, x+r.[;

theorem 
  for A being Subset of R^1 holds A is open iff for x being Real st x in
  A ex r being Real st r >0 & ].x-r, x+r.[ c= A;

theorem 
  for S being sequence of R^1 st (for n being Element of NAT holds
  S.n in ]. n - 1/4 , n + 1/4 .[) holds rng S is closed;

theorem 
  for B being Subset of R^1 holds B = NAT implies B is closed;

definition
  let M be non empty MetrStruct, x be Point of TopSpaceMetr(M);
  func Balls(x) -> Subset-Family of TopSpaceMetr(M) means


  ex y being Point of M st y = x &
  it = { Ball(y,1/n) where n is Element of NAT: n <> 0 };
end;

registration
  let M be non empty MetrSpace, x be Point of TopSpaceMetr(M);
  cluster Balls(x) -> open x -quasi_basis;
 end;

registration
  let M be non empty MetrSpace, x be Point of TopSpaceMetr(M);
  cluster Balls(x) -> countable;
end;

theorem 
  for M being non empty MetrSpace, x being Point of TopSpaceMetr(M),
      x9 being Point of M st x = x9
  ex f being Function of NAT,Balls(x) st
  for n being Element of NAT holds f.n = Ball(x9,1/(n+1));

theorem 
  for f,g being Function holds rng(f+*g)=f.:(dom f\dom g) \/ rng g;

theorem 
  for A,B being set holds B c= A implies (id A).:(B) = B;

theorem 
  for A,B,x being set holds dom((id A)+*(B --> x)) = A \/ B;

theorem 
  for A,B,x being set st B <> {} holds rng((id A)+*(B --> x)) = (A \ B) \/ {x};

theorem 
  for A,B,C,x being set holds C c= A implies ((id A)+*(B --> x))"(
  C \ {x}) = C \ B \ {x};

theorem 
  for A,B,x being set holds not x in A implies ((id A)+*(B --> x)) "({x}) = B;

theorem 
  for A,B,C,x being set holds C c= A & not x in A implies ((id A)
  +*(B --> x))"(C \/ {x}) = C \/ B;

theorem 
  for A,B,C,x being set holds C c= A & not x in A implies ((id A)
  +*(B --> x))"(C \ {x}) = C \ B;

begin






definition
  let T be non empty TopStruct;
  attr T is first-countable means


  for x be Point of T ex B be Basis of x st B is countable;
end;

theorem 
  for M being non empty MetrSpace holds TopSpaceMetr(M) is first-countable;

theorem 
  R^1 is first-countable;

registration
  cluster R^1 -> first-countable;
end;

definition
  let T be TopStruct, S be sequence of T, x be Point of T;
  pred S is_convergent_to x means


  for U1 being Subset of T st U1 is open & x in U1
  ex n being Element of NAT st for m being Element of NAT st n <= m holds
  S.m in U1;
end;

theorem 
  for T being non empty TopStruct, x being Point of T, S being
  sequence of T holds S = (NAT --> x) implies S is_convergent_to x;

definition
  let T be TopStruct, S be sequence of T;
  attr S is convergent means


  ex x being Point of T st S is_convergent_to x;
end;

definition
  let T be non empty TopStruct, S be sequence of T;
  func Lim S -> Subset of T means


  for x being Point of T holds x in it iff S is_convergent_to x;
end;

definition
  let T be non empty TopStruct;
  attr T is Frechet means


  for A being Subset of T,x being Point of T st
  x in Cl(A) ex S being sequence of T st rng S c= A & x in Lim S;
end;

definition
  let T be non empty TopStruct;
  attr T is sequential means

  for A being Subset of T holds A is closed iff for
  S being sequence of T st S is convergent & rng S c= A holds Lim S c= A;
end;

theorem 
  for T being non empty TopSpace holds T is first-countable
  implies T is Frechet;

registration
  cluster first-countable -> Frechet for non empty TopSpace;
end;

theorem 
  for T being non empty TopSpace,A being Subset of T holds A is
  closed implies for S being sequence of T st rng S c= A holds Lim S c= A;

theorem 
  for T being non empty TopSpace holds (for A being Subset of T
holds (for S being sequence of T st S is convergent & rng S c= A holds Lim S c=
  A) implies A is closed) implies T is sequential;

theorem 
  for T being non empty TopSpace holds T is Frechet implies T is sequential;

registration
  cluster Frechet -> sequential for non empty TopSpace;
end;

begin





definition
  func REAL? -> strict non empty TopSpace means


  the carrier of it = (
  REAL \ NAT) \/ {REAL} & ex f being Function of R^1, it st f = (id REAL)+*(NAT
  --> REAL) & for A being Subset of it holds A is closed iff f"A is closed;
end;

theorem 
  REAL is Point of REAL?;

theorem 
  for A being Subset of REAL? holds A is open & REAL in A iff ex O
  being Subset of R^1 st O is open & NAT c= O & A=(O\NAT) \/ {REAL};

theorem 
  for A being set holds A is Subset of REAL? & not REAL in A iff A
  is Subset of R^1 & NAT /\ A = {};

theorem 
  for A being Subset of R^1,B being Subset of REAL? st A = B holds
  NAT /\ A = {} & A is open iff not REAL in B & B is open;

theorem 
  for A being Subset of REAL? st A = {REAL} holds A is closed;

theorem 
  REAL? is not first-countable;

theorem 
  REAL? is Frechet;

theorem 
  not (for T being non empty TopSpace holds T is Frechet implies T is
  first-countable);

begin







theorem 
  for f,g being Function st f tolerates g holds rng (f+*g) = (rng f)\/( rng g);

theorem 
  for r being Real st r>0 ex n being Element of NAT st 1/n < r & n>0;














begin 

reserve p, q for Point of TOP-REAL 2,
  r for Real,
  h for non constant standard special_circular_sequence,
  g for FinSequence of TOP-REAL 2,
  f for non empty FinSequence of TOP-REAL 2,
  I, i1, i, j, k for Element of NAT;

theorem 
  for n be Element of NAT, h be FinSequence of TOP-REAL n st len h
  >= 2 holds h/.len h in LSeg(h,len h-'1);

theorem 
  3 <= i implies i mod (i-'1) = 1;

theorem 
  p in rng h implies ex i be Element of NAT st 1 <= i & i+1 <= len h & h.i = p;

theorem 
  for g being FinSequence of REAL st r in rng g holds Incr g.1 <= r
  & r <= Incr g.len Incr g;

theorem 
  1 <= i & i <= len h & 1 <= I & I <= width GoB h implies (GoB h)*(
  1,I)`1 <= (h/.i)`1 & (h/.i)`1 <= (GoB h)*(len GoB h,I)`1;

theorem 
  1 <= i & i <= len h & 1 <= I & I <= len GoB h implies (GoB h)*(I,
  1)`2 <= (h/.i)`2 & (h/.i)`2 <= (GoB h)*(I,width GoB h)`2;

theorem 
  1 <= i & i <= len GoB f implies ex k,j st k in dom f & [i,j] in
  Indices GoB f & f/.k = (GoB f)*(i,j);

theorem 
  1 <= j & j <= width GoB f implies ex k,i st k in dom f & [i,j]
  in Indices GoB f & f/.k = (GoB f)*(i,j);

theorem 
  1 <= i & i <= len GoB f & 1 <= j & j <= width GoB f implies ex k
  st k in dom f & [i,j] in Indices GoB f & (f/.k)`1 = (GoB f)*(i,j)`1;

theorem 
  1 <= i & i <= len GoB f & 1 <= j & j <= width GoB f implies ex k
  st k in dom f & [i,j] in Indices GoB f & (f/.k)`2 = (GoB f)*(i,j)`2;

begin 

theorem 
  1 <= i & i <= len h implies S-bound L~h <= (h/.i)`2 & (h/.i)`2 <= N-bound L~h
;

theorem 
  1 <= i & i <= len h implies W-bound L~h <= (h/.i)`1 & (h/.i)`1 <= E-bound L~h
;

theorem 
  for X being Subset of REAL st X = { q`2 : q`1 = W-bound L~h & q
in L~h } holds X = (proj2 | W-most L~h).:the carrier of (TOP-REAL 2)|(W-most L~
  h);

theorem 
  for X being Subset of REAL st X = { q`2 : q`1 = E-bound L~h & q
in L~h } holds X = (proj2 | E-most L~h).:the carrier of (TOP-REAL 2)|(E-most L~
  h);

theorem 
  for X being Subset of REAL st X = { q`1 : q`2 = N-bound L~h & q
in L~h } holds X = (proj1 | N-most L~h).:the carrier of (TOP-REAL 2)|(N-most L~
  h);

theorem 
  for X being Subset of REAL st X = { q`1 : q`2 = S-bound L~h & q
in L~h } holds X = (proj1 | S-most L~h).:the carrier of (TOP-REAL 2)|(S-most L~
  h);

theorem 
  for X being Subset of REAL st X = { q`1 : q in L~g } holds X = (
  proj1 | L~g).:the carrier of (TOP-REAL 2)|L~g;

theorem 
  for X being Subset of REAL st X = { q`2 : q in L~g } holds X = (
  proj2 | L~g).:the carrier of (TOP-REAL 2)|L~g;

theorem 
  for X being Subset of REAL st X = { q`2 : q`1 = W-bound L~h & q in L~h
  } holds lower_bound X = lower_bound (proj2 | W-most L~h);

theorem 
  for X being Subset of REAL st X = { q`2 : q`1 = W-bound L~h & q in L~h
  } holds upper_bound X = upper_bound (proj2 | W-most L~h);

theorem 
  for X being Subset of REAL st X = { q`2 : q`1 = E-bound L~h & q in L~h
  } holds lower_bound X = lower_bound (proj2 | E-most L~h);

theorem 
  for X being Subset of REAL st X = { q`2 : q`1 = E-bound L~h & q in L~h
  } holds upper_bound X = upper_bound (proj2 | E-most L~h);

theorem 
  for X being Subset of REAL st X = { q`1 : q in L~g } holds lower_bound
  X = lower_bound (proj1 | L~g);

theorem 
  for X being Subset of REAL st X = { q`1 : q`2 = S-bound L~h & q in L~h
  } holds lower_bound X = lower_bound (proj1 | S-most L~h);

theorem 
  for X being Subset of REAL st X = { q`1 : q`2 = S-bound L~h & q in L~h
  } holds upper_bound X = upper_bound (proj1 | S-most L~h);

theorem 
  for X being Subset of REAL st X = { q`1 : q`2 = N-bound L~h & q in L~h
  } holds lower_bound X = lower_bound (proj1 | N-most L~h);

theorem 
  for X being Subset of REAL st X = { q`1 : q`2 = N-bound L~h & q in L~h
  } holds upper_bound X = upper_bound (proj1 | N-most L~h);

theorem 
  for X being Subset of REAL st X = { q`2 : q in L~g } holds lower_bound
  X = lower_bound (proj2 | L~g);

theorem 
  for X being Subset of REAL st X = { q`1 : q in L~g } holds upper_bound
  X = upper_bound (proj1 | L~g);

theorem 
  for X being Subset of REAL st X = { q`2 : q in L~g } holds upper_bound
  X = upper_bound (proj2 | L~g);

theorem 
  p in L~h & 1 <= I & I <= width GoB h implies (GoB h)*(1,I)`1 <= p`1;

theorem 
  p in L~h & 1 <= I & I <= width GoB h implies p`1 <= (GoB h)*(len GoB h,I)`1;

theorem 
  p in L~h & 1 <= I & I <= len GoB h implies (GoB h)*(I,1)`2 <= p `2;

theorem 
  p in L~h & 1 <= I & I <= len GoB h implies p`2 <= (GoB h)*(I, width GoB h)`2;

theorem 
  1 <= i & i <= len GoB h & 1 <= j & j <= width GoB h implies ex q
  st q`1 = (GoB h)*(i,j)`1 & q in L~h;

theorem 
  1 <= i & i <= len GoB h & 1 <= j & j <= width GoB h implies ex q
  st q`2 = (GoB h)*(i,j)`2 & q in L~h;

theorem 
  W-bound L~h = (GoB h)*(1,1)`1;

theorem 
  S-bound L~h = (GoB h)*(1,1)`2;

theorem 
  E-bound L~h = (GoB h)*(len GoB h,1)`1;

theorem 
  N-bound L~h = (GoB h)*(1,width GoB h)`2;

theorem 
  for Y being non empty finite Subset of NAT st 1 <= i & i <= len
  f & 1 <= I & I <= len GoB f & Y = { j : [I,j] in Indices GoB f & ex k st k in
  dom f & f/.k = (GoB f)*(I,j) } & (f/.i)`1 = ((GoB f)*(I,1))`1 & i1 = min Y
  holds (GoB f)*(I,i1)`2 <= (f/.i)`2;

theorem 
  for Y being non empty finite Subset of NAT st 1 <= i & i <= len
h & 1 <= I & I <= width GoB h & Y = { j : [j,I] in Indices GoB h & ex k st k in
  dom h & h/.k = (GoB h)*(j,I) } & (h/.i)`2 = ((GoB h)* (1,I))`2 & i1 = min Y
  holds (GoB h)*(i1,I)`1 <= (h/.i)`1;

theorem 
  for Y being non empty finite Subset of NAT st 1 <= i & i <= len
h & 1 <= I & I <= width GoB h & Y = { j : [j,I] in Indices GoB h & ex k st k in
  dom h & h/.k = (GoB h)*(j,I) } & (h/.i)`2 = ((GoB h)* (1,I))`2 & i1 = max Y
  holds (GoB h)*(i1,I)`1 >= (h/.i)`1;

theorem 
  for Y being non empty finite Subset of NAT st 1 <= i & i <= len
  f & 1 <= I & I <= len GoB f & Y = { j : [I,j] in Indices GoB f & ex k st k in
  dom f & f/.k = (GoB f)*(I,j) } & (f/.i)`1 = ((GoB f)* (I,1))`1 & i1 = max Y
  holds (GoB f)*(I,i1)`2 >= (f/.i)`2;

begin 

definition
  let g be non constant standard special_circular_sequence;
  func i_s_w g -> Element of NAT means


  [1,it] in Indices GoB g & (GoB g )*(1,it) = W-min L~g;
  func i_n_w g -> Element of NAT means


  [1,it] in Indices GoB g & (GoB g )*(1,it) = W-max L~g;
  func i_s_e g -> Element of NAT means


  [len GoB g,it] in Indices GoB g & (GoB g)*(len GoB g,it) = E-min L~g;
  func i_n_e g -> Element of NAT means


  [len GoB g,it] in Indices GoB g & (GoB g)*(len GoB g,it) = E-max L~g;
  func i_w_s g -> Element of NAT means


  [it, 1] in Indices GoB g & (GoB g)*(it,1) = S-min L~g;
  func i_e_s g -> Element of NAT means


  [it, 1] in Indices GoB g & (GoB g)*(it,1) = S-max L~g;
  func i_w_n g -> Element of NAT means


  [it, width GoB g] in Indices GoB g & (GoB g)*(it,width GoB g) = N-min L~g;
  func i_e_n g -> Element of NAT means


  [it, width GoB g] in Indices GoB g & (GoB g)*(it,width GoB g) = N-max L~g;
end;

theorem 
  1 <= i_w_n h & i_w_n h <= len GoB h & 1 <= i_e_n h & i_e_n h <= len
GoB h & 1 <= i_w_s h & i_w_s h <= len GoB h & 1 <= i_e_s h & i_e_s h <= len GoB
  h;

theorem 
  1 <= i_n_e h & i_n_e h <= width GoB h & 1 <= i_s_e h & i_s_e h <=
width GoB h & 1 <= i_n_w h & i_n_w h <= width GoB h & 1 <= i_s_w h & i_s_w h <=
  width GoB h;

definition
  let g be non constant standard special_circular_sequence;
  func n_s_w g -> Element of NAT means


  1 <= it & it+1 <= len g & g.it = W-min L~g;
  func n_n_w g -> Element of NAT means


  1 <= it & it+1 <= len g & g.it = W-max L~g;
  func n_s_e g -> Element of NAT means


  1 <= it & it+1 <= len g & g.it = E-min L~g;
  func n_n_e g -> Element of NAT means


  1 <= it & it+1 <= len g & g.it = E-max L~g;
  func n_w_s g -> Element of NAT means


  1 <= it & it+1 <= len g & g.it = S-min L~g;
  func n_e_s g -> Element of NAT means


  1 <= it & it+1 <= len g & g.it = S-max L~g;
  func n_w_n g -> Element of NAT means


  1 <= it & it+1 <= len g & g.it = N-min L~g;
  func n_e_n g -> Element of NAT means


  1 <= it & it+1 <= len g & g.it = N-max L~g;
end;

theorem 
  n_w_n h <> n_w_s h;

theorem 
  n_s_w h <> n_s_e h;

theorem 
  n_e_n h <> n_e_s h;

theorem 
  n_n_w h <> n_n_e h;














begin  

reserve i, I for set,
  f, g, h for Function,
  s for ManySortedSet of I;

definition
  let R be Relation;
  attr R is multMagma-yielding means


  for y being set st y in rng R holds y is non empty multMagma;
end;

registration
  cluster multMagma-yielding -> 1-sorted-yielding for Function;
end;

registration
  let I be set;
  cluster multMagma-yielding for ManySortedSet of I;
end;

registration
  cluster multMagma-yielding for Function;
end;

definition
  let I be set;
  mode multMagma-Family of I is multMagma-yielding ManySortedSet of I;
end;

definition
  let I be non empty set, F be multMagma-Family of I, i be Element of I;
  redefine func F.i -> non empty multMagma;
end;

registration
  let I be set, F be multMagma-Family of I;
  cluster Carrier F -> non-empty;
end;

definition
  let I be set, F be multMagma-Family of I;
  func product F -> strict multMagma means


  the carrier of it = product
Carrier F & for f, g being Element of product Carrier F, i being set st i in I
ex Fi being non empty multMagma, h being Function st Fi = F.i & h = (the multF
  of it).(f,g) & h.i = (the multF of Fi).(f.i,g.i);
end;

registration
  let I be set, F be multMagma-Family of I;
  cluster product F -> non empty constituted-Functions;
end;

theorem 
  for F being multMagma-Family of I, G being non empty multMagma, p
, q being Element of product F, x, y being Element of G st i in I & G = F.i & f
  = p & g = q & h = p * q & f.i = x & g.i = y holds x * y = h.i;

definition
  let I be set, F be multMagma-Family of I;
  attr F is Group-like means


  for i being set st i in I ex Fi being
  Group-like non empty multMagma st Fi = F.i;
  attr F is associative means


  for i being set st i in I ex Fi being
  associative non empty multMagma st Fi = F.i;
  attr F is commutative means


  for i being set st i in I ex Fi being
  commutative non empty multMagma st Fi = F.i;
end;

definition
  let I be non empty set, F be multMagma-Family of I;
  redefine attr F is Group-like means


  for i being Element of I holds F. i is Group-like;
  redefine attr F is associative means


  for i being Element of I holds F .i is associative;
  redefine attr F is commutative means

  for i being Element of I holds F.i is commutative;
end;

registration
  let I be set;
  cluster Group-like associative commutative for multMagma-Family of I;
end;

registration
  let I be set, F be Group-like multMagma-Family of I;
  cluster product F -> Group-like;
end;

registration
  let I be set, F be associative multMagma-Family of I;
  cluster product F -> associative;
end;

registration
  let I be set, F be commutative multMagma-Family of I;
  cluster product F -> commutative;
end;

theorem 
  for F being multMagma-Family of I, G being non empty multMagma st i in
  I & G = F.i & product F is Group-like holds G is Group-like;

theorem 
  for F being multMagma-Family of I, G being non empty multMagma st i in
  I & G = F.i & product F is associative holds G is associative;

theorem 
  for F being multMagma-Family of I, G being non empty multMagma st i in
  I & G = F.i & product F is commutative holds G is commutative;

theorem 
  for F being Group-like multMagma-Family of I st for i being set
  st i in I ex G being Group-like non empty multMagma st G = F.i & s.i = 1_G
  holds s = 1_product F;

theorem 
  for F being Group-like multMagma-Family of I, G being Group-like
  non empty multMagma st i in I & G = F.i & f = 1_product F holds f.i = 1_G;

theorem 
  for F being associative Group-like multMagma-Family of I, x
  being Element of product F st x = g & for i being set st i in I ex G being
  Group, y being Element of G st G = F.i & s.i = y" & y = g.i holds s = x";

theorem 
  for F being associative Group-like multMagma-Family of I, x
being Element of product F, G being Group, y being Element of G st i in I & G =
  F.i & f = x & g = x" & f.i = y holds g.i = y";

definition
  let I be set, F be associative Group-like multMagma-Family of I;
  func sum F -> strict Subgroup of product F means


  for x being set
  holds x in the carrier of it iff ex g being Element of product Carrier F, J
being finite Subset of I, f being ManySortedSet of J st g = 1_product F & x = g
+* f & for j being set st j in J ex G being Group-like non empty multMagma st
  G = F.j & f.j in the carrier of G & f.j <> 1_G;
end;

registration
  let I be set, F be associative Group-like multMagma-Family of I, f, g be
  Element of sum F;
  cluster (the multF of sum F).(f,g) -> Function-like Relation-like;
end;

theorem 
  for I being finite set, F being associative Group-like
  multMagma-Family of I holds product F = sum F;

begin  

theorem 
  for G1 being non empty multMagma holds <*G1*> is multMagma-Family of {1};

registration
  let G1 be non empty multMagma;
  cluster <*G1*> -> {1} -defined;
end;

registration
  let G1 be non empty multMagma;
  cluster <*G1*> -> total multMagma-yielding;
end;

theorem 
  for G1 being Group-like non empty multMagma holds <*G1*> is
  Group-like multMagma-Family of {1};

registration
  let G1 be Group-like non empty multMagma;
  cluster <*G1*> -> Group-like;
end;

theorem 
  for G1 being associative non empty multMagma holds <*G1*> is
  associative multMagma-Family of {1};

registration
  let G1 be associative non empty multMagma;
  cluster <*G1*> -> associative;
end;

theorem 
  for G1 being commutative non empty multMagma holds <*G1*> is
  commutative multMagma-Family of {1};

registration
  let G1 be commutative non empty multMagma;
  cluster <*G1*> -> commutative;
end;

theorem 
  for G1 being Group holds <*G1*> is Group-like associative
  multMagma-Family of {1};

theorem 
  for G1 being commutative Group holds <*G1*> is commutative
  Group-like associative multMagma-Family of {1};

registration
  let G1 be non empty multMagma;
  cluster -> FinSequence-like for Element of product Carrier <*G1*>;
end;

registration
  let G1 be non empty multMagma;
  cluster -> FinSequence-like for Element of product <*G1*>;
end;

definition
  let G1 be non empty multMagma, x be Element of G1;
  redefine func <*x*> -> Element of product <*G1*>;
end;

theorem 
  for G1, G2 being non empty multMagma holds <*G1,G2*> is
  multMagma-Family of {1,2};

registration
  let G1, G2 be non empty multMagma;
  cluster <*G1,G2*> -> {1,2} -defined;
end;

registration
  let G1, G2 be non empty multMagma;
  cluster <*G1,G2*> -> total multMagma-yielding;
end;

theorem 
  for G1, G2 being Group-like non empty multMagma holds <*G1,G2
  *> is Group-like multMagma-Family of {1,2};

registration
  let G1, G2 be Group-like non empty multMagma;
  cluster <*G1,G2*> -> Group-like;
end;

theorem 
  for G1, G2 being associative non empty multMagma holds <*G1,G2
  *> is associative multMagma-Family of {1,2};

registration
  let G1, G2 be associative non empty multMagma;
  cluster <*G1,G2*> -> associative;
end;

theorem 
  for G1, G2 being commutative non empty multMagma holds <*G1,G2
  *> is commutative multMagma-Family of {1,2};

registration
  let G1, G2 be commutative non empty multMagma;
  cluster <*G1,G2*> -> commutative;
end;

theorem 
  for G1, G2 being Group holds <*G1,G2*> is Group-like associative
  multMagma-Family of {1,2};

theorem 
  for G1, G2 being commutative Group holds <*G1,G2*> is Group-like
  associative commutative multMagma-Family of {1,2};

registration
  let G1, G2 be non empty multMagma;
  cluster -> FinSequence-like for Element of product Carrier <*G1,G2*>;
end;

registration
  let G1, G2 be non empty multMagma;
  cluster -> FinSequence-like for Element of product <*G1,G2*>;
end;

definition
  let G1, G2 be non empty multMagma, x be Element of G1, y be Element of G2;
  redefine func <*x,y*> -> Element of product <*G1,G2*>;
end;

theorem 
  for G1, G2, G3 being non empty multMagma holds <*G1,G2,G3*> is
  multMagma-Family of {1,2,3};

registration
  let G1, G2, G3 be non empty multMagma;
  cluster <*G1,G2,G3*> -> {1,2,3} -defined;
end;

registration
  let G1, G2, G3 be non empty multMagma;
  cluster <*G1,G2,G3*> -> total multMagma-yielding;
end;

theorem 
  for G1, G2, G3 being Group-like non empty multMagma holds <*G1
  ,G2,G3*> is Group-like multMagma-Family of {1,2,3};

registration
  let G1, G2, G3 be Group-like non empty multMagma;
  cluster <*G1,G2,G3*> -> Group-like;
end;

theorem 
  for G1, G2, G3 being associative non empty multMagma holds <*
  G1,G2,G3*> is associative multMagma-Family of {1,2,3};

registration
  let G1, G2, G3 be associative non empty multMagma;
  cluster <*G1,G2,G3*> -> associative;
end;

theorem 
  for G1, G2, G3 being commutative non empty multMagma holds <*
  G1,G2,G3*> is commutative multMagma-Family of {1,2,3};

registration
  let G1, G2, G3 be commutative non empty multMagma;
  cluster <*G1,G2,G3*> -> commutative;
end;

theorem 
  for G1, G2, G3 being Group holds <*G1,G2,G3*> is Group-like
  associative multMagma-Family of {1,2,3};

theorem 
  for G1, G2, G3 being commutative Group holds <*G1,G2,G3*> is
  Group-like associative commutative multMagma-Family of {1,2,3};

registration
  let G1, G2, G3 be non empty multMagma;
  cluster -> FinSequence-like for Element of product Carrier <*G1,G2,G3*>;
end;

registration
  let G1, G2, G3 be non empty multMagma;
  cluster -> FinSequence-like for Element of product <*G1,G2,G3*>;
end;

definition
  let G1, G2, G3 be non empty multMagma, x be Element of G1, y be Element of
  G2, z be Element of G3;
  redefine func <*x,y,z*> -> Element of product <*G1,G2,G3*>;
end;

reserve G1, G2, G3 for non empty multMagma,
  x1, x2 for Element of G1,
  y1, y2 for Element of G2,
  z1, z2 for Element of G3;

theorem 
  <*x1*> * <*x2*> = <*x1*x2*>;

theorem 
  <*x1,y1*> * <*x2,y2*> = <*x1*x2,y1*y2*>;

theorem 
  <*x1,y1,z1*> * <*x2,y2,z2*> = <*x1*x2,y1*y2,z1*z2*>;

reserve G1, G2, G3 for Group-like non empty multMagma;

theorem 
  1_product <*G1*> = <*1_G1*>;

theorem 
  1_product <*G1,G2*> = <*1_G1,1_G2*>;

theorem 
  1_product <*G1,G2,G3*> = <*1_G1,1_G2,1_G3*>;

reserve G1, G2, G3 for Group,
  x for Element of G1,
  y for Element of G2,
  z for Element of G3;

theorem 
  (<*x*> qua Element of product <*G1*>)" = <*x"*>;

theorem 
  (<*x,y*> qua Element of product <*G1,G2*>)" = <*x",y"*>;

theorem 
  (<*x,y,z*> qua Element of product <*G1,G2,G3*>)" = <*x",y",z" *>;

theorem 
  for f being Function of the carrier of G1, the carrier of
  product <*G1*> st for x being Element of G1 holds f.x = <*x*> holds f is
  Homomorphism of G1, product <*G1*>;

theorem 
  for f being Homomorphism of G1, product <*G1*> st for x being
  Element of G1 holds f.x = <*x*> holds f is bijective;

theorem 
  G1, product <*G1*> are_isomorphic;














begin 

reserve p,p1,p2,p3,q for Point of TOP-REAL 2;

theorem 
  for P being compact non empty Subset of TOP-REAL 2 st P is
  being_simple_closed_curve holds W-min(P) in Lower_Arc(P) & E-max(P) in
  Lower_Arc(P) & W-min(P) in Upper_Arc(P) & E-max(P) in Upper_Arc(P);

theorem 
  for P being compact non empty Subset of TOP-REAL 2,q st P is
  being_simple_closed_curve & LE q,W-min(P),P holds q=W-min(P);

theorem 
  for P being compact non empty Subset of TOP-REAL 2,q st P is
  being_simple_closed_curve & q in P holds LE W-min(P),q,P;

definition
  let P be compact non empty Subset of TOP-REAL 2, q1,q2 be Point of TOP-REAL
  2;
  func Segment(q1,q2,P) -> Subset of TOP-REAL 2 equals


  {p: LE q1,p,P &
LE p,q2,P} if q2<>W-min(P) otherwise {p1: LE q1,p1,P or q1 in P & p1=W-min(P)};
end;

theorem 
  for P being compact non empty Subset of TOP-REAL 2 st P is
  being_simple_closed_curve holds Segment(W-min(P),E-max(P),P)=Upper_Arc(P) &
  Segment(E-max(P),W-min(P),P)=Lower_Arc(P);

theorem 
  for P being compact non empty Subset of TOP-REAL 2, q1,q2 being
Point of TOP-REAL 2 st P is being_simple_closed_curve & LE q1,q2,P holds q1 in
  P & q2 in P;

theorem 
  for P being compact non empty Subset of TOP-REAL 2, q1,q2 being
Point of TOP-REAL 2 st P is being_simple_closed_curve & LE q1,q2,P holds q1 in
  Segment(q1,q2,P) & q2 in Segment(q1,q2,P);

theorem 
  for P being compact non empty Subset of TOP-REAL 2, q1 being
  Point of TOP-REAL 2 st q1 in P & P is being_simple_closed_curve holds q1 in
  Segment(q1,W-min P,P);

theorem 
  for P being compact non empty Subset of TOP-REAL 2, q being Point of
  TOP-REAL 2 st P is being_simple_closed_curve & q in P & q<>W-min(P) holds
  Segment(q,q,P)={q};

theorem 
  for P being compact non empty Subset of TOP-REAL 2, q1,q2 being Point
  of TOP-REAL 2 st P is being_simple_closed_curve & q1<>W-min(P) & q2<>W-min(P)
  holds not W-min(P) in Segment(q1,q2,P);

theorem 
  for P being compact non empty Subset of TOP-REAL 2, q1,q2,q3
  being Point of TOP-REAL 2 st P is being_simple_closed_curve & LE q1,q2,P & LE
q2,q3,P & not(q1=q2 & q1=W-min(P)) & not(q2=q3 & q2=W-min(P)) holds Segment(q1,
  q2,P)/\ Segment(q2,q3,P)={q2};

theorem 
  for P being compact non empty Subset of TOP-REAL 2, q1,q2 being
  Point of TOP-REAL 2 st P is being_simple_closed_curve & LE q1,q2,P & q1 <>
  W-min P & q2 <> W-min P holds Segment(q1,q2,P)/\ Segment(q2,W-min P,P)={q2};

theorem 
  for P being compact non empty Subset of TOP-REAL 2, q1,q2 being
  Point of TOP-REAL 2 st P is being_simple_closed_curve & LE q1,q2,P & q1<>q2 &
  q1<>W-min(P) holds Segment(q2,W-min(P),P)/\ Segment(W-min(P),q1,P)={W-min(P)}
;

theorem 
  for P being compact non empty Subset of TOP-REAL 2, q1,q2,q3,q4
  being Point of TOP-REAL 2 st P is being_simple_closed_curve & LE q1,q2,P & LE
q2,q3,P & LE q3,q4,P & q1<>q2 & q2<>q3 holds Segment(q1,q2,P) misses Segment(q3
  ,q4,P);

theorem 
  for P being compact non empty Subset of TOP-REAL 2, q1,q2,q3
  being Point of TOP-REAL 2 st P is being_simple_closed_curve & LE q1,q2,P & LE
q2,q3,P & q1<>W-min P & q2<>q3 holds Segment(q1,q2,P) misses Segment(q3,W-min P
  ,P);

begin 

reserve n for Element of NAT;

theorem 
  for P being non empty Subset of TOP-REAL n, f being Function of
I[01], (TOP-REAL n)|P st f is being_homeomorphism ex g being Function of I[01],
  TOP-REAL n st f=g & g is continuous & g is one-to-one;

theorem 
  for P being non empty Subset of TOP-REAL n, g being Function of
  I[01], (TOP-REAL n) st g is continuous one-to-one & rng g = P ex f being
  Function of I[01],(TOP-REAL n)|P st f=g & f is being_homeomorphism;

theorem 
  for A being Subset of TOP-REAL 2, p1,p2 being Point of TOP-REAL
  2 st A is_an_arc_of p1,p2 ex g being Function of I[01], TOP-REAL 2 st g is
  continuous one-to-one & rng g = A & g.0 = p1 & g.1 = p2;

theorem 
  for P being non empty Subset of TOP-REAL 2, p1, p2, q1, q2 being
  Point of TOP-REAL 2, g being Function of I[01], TOP-REAL 2, s1, s2 being Real
st P is_an_arc_of p1,p2 & g is continuous one-to-one & rng g = P & g.0 = p1 & g
.1 = p2 & g.s1 = q1 & 0 <= s1 & s1 <= 1 & g.s2 = q2 & 0 <= s2 & s2 <= 1 & s1 <=
  s2 holds LE q1,q2,P,p1,p2;

theorem 
  for P being non empty Subset of TOP-REAL 2, p1, p2, q1, q2 being
  Point of TOP-REAL 2, g being Function of I[01], TOP-REAL 2, s1, s2 being Real
st g is continuous one-to-one & rng g = P & g.0 = p1 & g.1 = p2 & g.s1 = q1 & 0
<= s1 & s1 <= 1 & g.s2 = q2 & 0 <= s2 & s2 <= 1 & LE q1,q2,P,p1,p2 holds s1 <=
  s2;

theorem 
  for P being compact non empty Subset of TOP-REAL 2, e being Real st P
      is being_simple_closed_curve & e > 0
  ex h being FinSequence of the carrier of TOP-REAL 2
   st h.1=W-min(P) & h is one-to-one & 8<=len h & rng h c= P &(for i
being Element of NAT st 1<=i & i<len h holds LE h/.i,h/.(i+1),P) &(for i being
Element of NAT,W being Subset of Euclid 2 st 1<=i & i<len h & W=Segment(h/.i,h
/.(i+1),P) holds diameter(W)<e) & (for W being Subset of Euclid 2 st W=Segment(
h/.len h,h/.1,P) holds diameter(W)<e) & (for i being Element of NAT st 1<=i & i
+1<len h holds Segment(h/.i,h/.(i+1),P)/\ Segment(h/.(i+1),h/.(i+2),P)={h/.(i+1
)}) & Segment(h/.len h,h/.1,P)/\ Segment(h/.1,h/.2,P)={h/.1} & Segment(h/.(len
h-' 1),h/.len h,P)/\ Segment(h/.len h,h/.1,P)={h/.len h} & Segment(h/.(len h-'1
),h/.len h,P) misses Segment(h/.1,h/.2,P) &(for i,j being Element of NAT st 1<=
  i & i < j & j < len h & not(i,j are_adjacent1) holds Segment(h/.i,h/.(i+1),P)
misses Segment(h/.j,h/.(j+1),P)) & for i being Element of NAT st 1 < i & i+1 <
  len h holds Segment(h/.len h,h/.1,P) misses Segment(h/.i,h/.(i+1),P);














begin 

definition 
  let T be non empty TopRelStr;
  attr T is lower means


  { (uparrow x)` where x is Element of T: not contradiction} is prebasis of T;
end;

registration
  cluster -> lower for 1-element reflexive TopSpace-like TopRelStr;
end;

registration
  cluster lower trivial complete strict for TopLattice;
end;

theorem 
  for LL being non empty RelStr ex T being strict correct
  TopAugmentation of LL st T is lower;

registration
  let R be non empty RelStr;
  cluster lower for strict correct TopAugmentation of R;
end;

theorem 
  for L1,L2 being TopSpace-like lower non empty TopRelStr st the
  RelStr of L1 = the RelStr of L2 holds the topology of L1 = the topology of L2
;

definition 
  let R be non empty RelStr;
  func omega R -> Subset-Family of R means


  for T being lower correct TopAugmentation of R holds it = the topology of T;
end;

theorem 
  for R1,R2 being non empty RelStr st the RelStr of R1 = the RelStr
  of R2 holds omega R1 = omega R2;

theorem 
  for T being lower non empty TopRelStr for x being Point of T
  holds (uparrow x)` is open & uparrow x is closed;

theorem 
  for T being transitive lower non empty TopRelStr for A being
  Subset of T st A is open holds A is lower;

theorem 
  for T being transitive lower non empty TopRelStr for A being
  Subset of T st A is closed holds A is upper;

theorem 
  for T being non empty TopSpace-like TopRelStr holds T is lower
  iff {(uparrow F)` where F is Subset of T: F is finite} is Basis of T;

theorem 


  for S,T being lower complete TopLattice, f being Function of S, T
  st for X being non empty Subset of S holds f preserves_inf_of X holds f is
  continuous;

theorem 


  for S,T being lower complete TopLattice, f being Function of S, T
  st f is infs-preserving holds f is continuous;

theorem 
  for T being lower complete TopLattice, BB being prebasis of T
  for F being non empty filtered Subset of T st for A being Subset of T st A in
  BB & inf F in A holds F meets A holds inf F in Cl F;

theorem 


  for S,T being lower complete TopLattice for f being Function of
  S,T st f is continuous holds f is filtered-infs-preserving;

theorem 


  for S,T being lower complete TopLattice for f being Function of S,T st
  f is continuous & for X being finite Subset of S holds f preserves_inf_of X
  holds f is infs-preserving;

theorem 


  for T being lower TopSpace-like reflexive transitive non empty
  TopRelStr  for x being Point of T holds Cl {x} = uparrow x;

definition
  mode TopPoset is TopSpace-like reflexive transitive antisymmetric TopRelStr;
end;

registration


  cluster lower -> T_0 for non empty TopPoset;
end;

registration
  let R be lower-bounded non empty RelStr;
  cluster -> lower-bounded for TopAugmentation of R;
end;

theorem 
  for S, T being non empty RelStr, s being Element of S, t being
Element of T holds (uparrow [s,t])` = [:(uparrow s)`, the carrier of T:] \/ [:
  the carrier of S, (uparrow t)`:];

theorem 


  for S,T being lower-bounded non empty Poset for S9 being lower
  correct TopAugmentation of S for T9 being lower correct TopAugmentation of T
  holds omega [:S,T:] = the topology of [:S9,T9 qua non empty TopSpace:];

theorem 


  for S,T being lower lower-bounded non empty TopPoset holds omega [:S
  ,T qua Poset:] = the topology of [:S,T qua non empty TopSpace:];

theorem 


  for T,T2 being lower complete TopLattice st T2 is TopAugmentation of
  [:T, T qua LATTICE:] for f being Function of T2,T st f = inf_op T holds f is
  continuous;

begin 

scheme 

  TopInd {T() -> TopLattice, P[set]}: for A being Subset of T() st A is open
  holds P[A]
provided
 ex K being prebasis of T() st for A being Subset of T() st A in K
holds P[A] and
 for F being Subset-Family of T() st for A being Subset of T() st A
in F holds P[A] holds P[union F] and
 for A1,A2 being Subset of T() st P[A1] & P[A2] holds P[A1 /\ A2] and
 P[[#]T()];

theorem 
  for L1,L2 being up-complete antisymmetric non empty reflexive RelStr
  st the RelStr of L1 = the RelStr of L2 & for x being Element of L1 holds
waybelow x is directed non empty holds L1 is satisfying_axiom_of_approximation
  implies L2 is satisfying_axiom_of_approximation;

registration
  let T be continuous non empty Poset;
  cluster -> continuous for TopAugmentation of T;
end;

theorem 
  for T,S being TopSpace, R being Refinement of T,S for W being
Subset of R st W in the topology of T or W in the topology of S holds W is open
;

theorem 
  for T,S being TopSpace, R being Refinement of T,S for V being
  Subset of T, W being Subset of R st W = V holds V is open implies W is open;

theorem 
  for T,S being TopSpace st the carrier of T = the carrier of S
for R being Refinement of T,S for V being Subset of T, W being Subset of R st W
  = V holds V is closed implies W is closed;

theorem 
  for T being non empty TopSpace, K,O being set st K c= O & O c=
  the topology of T holds (K is Basis of T implies O is Basis of T) & (K is
  prebasis of T implies O is prebasis of T);

theorem 


  for T1,T2 being non empty TopSpace st the carrier of T1 = the
  carrier of T2 for T be Refinement of T1, T2 for B1 being prebasis of T1, B2
  being prebasis of T2 holds B1 \/ B2 is prebasis of T;

theorem 
  for T1,S1,T2,S2 being non empty TopSpace for R1 being Refinement of T1
  ,S1, R2 being Refinement of T2,S2 for f being Function of T1,T2, g being
  Function of S1,S2 for h being Function of R1,R2 st h = f & h = g holds f is
  continuous & g is continuous implies h is continuous;

theorem 
  for T being non empty TopSpace, K being prebasis of T for N
being net of T, p being Point of T st for A being Subset of T st p in A & A in
  K holds N is_eventually_in A holds p in Lim N;

theorem 
  for T being non empty TopSpace for N being net of T for S being
  Subset of T st N is_eventually_in S holds Lim N c= Cl S;

theorem 
  for R being non empty RelStr, X being non empty Subset of R
  holds the mapping of X+id = id X & the mapping of X opp+id = id X;

theorem 
  for R being reflexive antisymmetric non empty RelStr, x being
  Element of R holds (uparrow x) /\ (downarrow x) = {x};

begin 

definition
  let T be reflexive non empty TopRelStr;
  attr T is Lawson means


  (omega T) \/ (sigma T) is prebasis of T;
end;

theorem 
  for R being complete LATTICE for LL being lower correct
TopAugmentation of R for S being Scott TopAugmentation of R for T being correct
  TopAugmentation of R holds T is Lawson iff T is Refinement of S,LL;

registration
  let R be complete LATTICE;
  cluster Lawson strict correct for TopAugmentation of R;
end;

registration
  cluster Scott complete strict for TopLattice;
  cluster Lawson continuous for complete strict TopLattice;
end;

theorem 
  for T being Lawson complete TopLattice holds (sigma T) \/ {(
  uparrow x)` where x is Element of T: not contradiction} is prebasis of T;

theorem 
  for T being Lawson complete TopLattice holds (sigma T) \/ {W\uparrow
  x where W is Subset of T, x is Element of T: W in sigma T} is prebasis of T;

theorem 
  for T being Lawson complete TopLattice holds {W\uparrow F where W,F
  is Subset of T: W in sigma T & F is finite} is Basis of T;

definition 
  let T be complete LATTICE;
  func lambda T -> Subset-Family of T means


  for S being Lawson correct TopAugmentation of T holds it = the topology of S;
end;

theorem 
  for R being complete LATTICE holds lambda R = UniCl FinMeetCl ((
  sigma R) \/ (omega R));

theorem 
  for R being complete LATTICE for T being lower correct TopAugmentation
of R for S being Scott correct TopAugmentation of R for M being Refinement of S
  ,T holds lambda R = the topology of M;

theorem 
  for T being lower up-complete TopLattice for A being Subset of T
  st A is open holds A is property(S);

theorem 


  for T being Lawson complete TopLattice for A being Subset of T
  st A is open holds A is property(S);

theorem 
  for S being Scott complete TopLattice for T being Lawson correct
TopAugmentation of S for A being Subset of S st A is open for C being Subset of
  T st C = A holds C is open;

theorem 
  for T being Lawson complete TopLattice for x being Element of
  T holds uparrow x is closed & downarrow x is closed & {x} is closed;

theorem 
  for T being Lawson complete TopLattice for x being Element of
  T holds (uparrow x)` is open & (downarrow x)` is open & {x}` is open;

theorem 
  for T being Lawson complete continuous TopLattice for x being
  Element of T holds wayabove x is open & (wayabove x)` is closed;

theorem 


  for S being Scott complete TopLattice for T being Lawson correct
  TopAugmentation of S for A being upper Subset of T st A is open for C being
  Subset of S st C = A holds C is open;

theorem 


  for T being Lawson complete TopLattice for A being lower Subset of T
  holds A is closed iff A is closed_under_directed_sups;

theorem 


  for T being Lawson complete TopLattice for F being non empty
  filtered Subset of T holds Lim (F opp+id) = {inf F};

registration


  cluster Lawson -> T_1 compact for complete TopLattice;
end;

registration


  cluster Lawson -> Hausdorff for complete continuous TopLattice;
end;














begin 

theorem 
  for X being set, S being Subset of id X holds proj1 S = proj2 S;

theorem 
  for X, Y being non empty set, f being Function of X, Y holds [:f,
  f:]"(id Y) is Equivalence_Relation of X;

definition
  let L1, L2, T1, T2 be RelStr, f be Function of L1, T1, g be Function of L2,
  T2;
  redefine func [:f, g:] -> Function of [:L1, L2:], [:T1, T2:];
end;

theorem 
  for f, g being Function, X being set holds proj1 ([:f, g:].:X) c=
  f.:proj1 X & proj2 ([:f, g:].:X) c= g.:proj2 X;

theorem 
  for f, g being Function, X being set st X c= [:dom f, dom g:]
  holds proj1 ([:f, g:].:X) = f.:proj1 X & proj2 ([:f, g:].:X) = g.:proj2 X;

theorem 
  for S being non empty antisymmetric RelStr st ex_inf_of {},S
  holds S is upper-bounded;

theorem 
  for S being non empty antisymmetric RelStr st ex_sup_of {},S
  holds S is lower-bounded;

theorem 
  for L1,L2 being antisymmetric non empty RelStr, D being Subset
  of [:L1,L2:] st ex_inf_of D,[:L1,L2:] holds inf D = [inf proj1 D,inf proj2 D]
;

theorem 
  for L1,L2 being antisymmetric non empty RelStr, D being Subset
  of [:L1,L2:] st ex_sup_of D,[:L1,L2:] holds sup D = [sup proj1 D,sup proj2 D]
;

theorem 
  for L1, L2, T1, T2 being antisymmetric non empty RelStr, f being
  Function of L1, T1, g being Function of L2, T2 st f is infs-preserving & g is
  infs-preserving holds [:f, g:] is infs-preserving;

theorem 
  for L1, L2, T1, T2 being antisymmetric reflexive non empty RelStr, f
  being Function of L1, T1, g being Function of L2, T2 st f is
  filtered-infs-preserving & g is filtered-infs-preserving holds [:f, g:] is
  filtered-infs-preserving;

theorem 
  for L1, L2, T1, T2 being antisymmetric non empty RelStr, f being
  Function of L1, T1, g being Function of L2, T2 st f is sups-preserving & g is
  sups-preserving holds [:f, g:] is sups-preserving;

theorem 
  for L1, L2, T1, T2 being antisymmetric reflexive non empty
  RelStr, f being Function of L1, T1, g being Function of L2, T2 st f is
  directed-sups-preserving & g is directed-sups-preserving holds [:f, g:] is
  directed-sups-preserving;

theorem 
  for L being antisymmetric non empty RelStr, X being Subset of [:
  L, L:] st X c= id the carrier of L & ex_inf_of X, [:L, L:] holds inf X in id
  the carrier of L;

theorem 
  for L being antisymmetric non empty RelStr, X being Subset of [:
  L, L:] st X c= id the carrier of L & ex_sup_of X, [:L, L:] holds sup X in id
  the carrier of L;

theorem 
  for L, M being non empty RelStr st L, M are_isomorphic & L is
  reflexive holds M is reflexive;

theorem 
  for L, M being non empty RelStr st L, M are_isomorphic & L is
  transitive holds M is transitive;

theorem 
  for L, M being non empty RelStr st L, M are_isomorphic & L is
  antisymmetric holds M is antisymmetric;

theorem 
  for L, M being non empty RelStr st L, M are_isomorphic & L is
  complete holds M is complete;

theorem 
  for L being non empty transitive RelStr, k being Function of L,
  L st k is infs-preserving holds corestr k is infs-preserving;

theorem 
  for L being non empty transitive RelStr, k being Function of L, L st k
  is filtered-infs-preserving holds corestr k is filtered-infs-preserving;

theorem 
  for L being non empty transitive RelStr, k being Function of L, L st k
  is sups-preserving holds corestr k is sups-preserving;

theorem 
  for L being non empty transitive RelStr, k being Function of L,
L st k is directed-sups-preserving holds corestr k is directed-sups-preserving;

theorem 
  for S, T being reflexive antisymmetric non empty RelStr, f being
  Function of S, T st f is filtered-infs-preserving holds f is monotone;

theorem 
  for S,T being non empty RelStr, f being Function of S,T st f is
monotone for X being Subset of S holds (X is filtered implies f.:X is filtered)
;

theorem 
  for L1, L2, L3 being non empty RelStr, f be Function of L1,L2, g
  be Function of L2,L3 st f is infs-preserving & g is infs-preserving holds g*f
  is infs-preserving;

theorem 
  for L1, L2, L3 being non empty reflexive antisymmetric RelStr, f be
Function of L1,L2, g be Function of L2,L3 st f is filtered-infs-preserving & g
  is filtered-infs-preserving holds g*f is filtered-infs-preserving;

theorem 
  for L1, L2, L3 being non empty RelStr, f be Function of L1,L2, g be
Function of L2, L3 st f is sups-preserving & g is sups-preserving holds g*f is
  sups-preserving;

theorem 
  for L1, L2, L3 being non empty reflexive antisymmetric RelStr, f be
Function of L1,L2, g be Function of L2,L3 st f is directed-sups-preserving & g
  is directed-sups-preserving holds g*f is directed-sups-preserving;

begin 

theorem 
  for I being non empty set for J being RelStr-yielding non-Empty
  ManySortedSet of I st for i being Element of I holds J.i is lower-bounded
  antisymmetric RelStr holds product J is lower-bounded;

theorem 
  for I being non empty set for J being RelStr-yielding non-Empty
  ManySortedSet of I st for i being Element of I holds J.i is upper-bounded
  antisymmetric RelStr holds product J is upper-bounded;

theorem 
  for I being non empty set for J being RelStr-yielding non-Empty
  ManySortedSet of I st for i being Element of I holds J.i is lower-bounded
antisymmetric RelStr holds for i being Element of I holds Bottom (product J).i
  = Bottom (J.i);

theorem 
  for I being non empty set for J being RelStr-yielding non-Empty
  ManySortedSet of I st for i being Element of I holds J.i is upper-bounded
  antisymmetric RelStr holds for i being Element of I holds Top (product J).i =
  Top (J.i);

theorem 



  for I being non empty set, J being RelStr-yielding non-Empty
reflexive-yielding ManySortedSet of I st for i being Element of I holds J.i is
  continuous complete LATTICE holds product J is continuous;

begin 

theorem 
  for L, T being continuous complete LATTICE, g being
  CLHomomorphism of L, T, S being Subset of [:L, L:] st S = [:g, g:]"(id the
  carrier of T) holds subrelstr S is CLSubFrame of [:L, L:];




definition
  let L be RelStr, R be Subset of [:L, L:] such that
 R is Equivalence_Relation of the carrier of L;
  func EqRel R -> Equivalence_Relation of the carrier of L equals


  R;
end;

definition 
  let L be non empty RelStr, R be Subset of [:L, L:];
  attr R is CLCongruence means


  R is Equivalence_Relation of the carrier
  of L & subrelstr R is CLSubFrame of [:L, L:];
end;

theorem 
  for L being complete LATTICE, R being non empty Subset of [:L, L
:] st R is CLCongruence for x be Element of L holds [inf Class(EqRel R, x), x]
  in R;

definition 
  let L be complete LATTICE, R be non empty Subset of [:L, L:] such that
 R is CLCongruence;
  func kernel_op R -> kernel Function of L, L means


  for x being Element of L holds it.x = inf Class(EqRel R, x);
end;

theorem 
  for L being complete LATTICE, R be non empty Subset of [:L, L:]
  st R is CLCongruence holds kernel_op R is directed-sups-preserving & R = [:
  kernel_op R, kernel_op R:]"(id the carrier of L);

theorem 
  for L being continuous complete LATTICE, R be Subset of [:L, L:]
, k being kernel Function of L, L st k is directed-sups-preserving & R = [:k, k
:]"(id the carrier of L) ex LR being continuous complete strict LATTICE st the
  carrier of LR = Class EqRel R & the InternalRel of LR = {[Class(EqRel R, x),
  Class(EqRel R, y)] where x, y is Element of L : k.x <= k.y } & for g being
  Function of L, LR st for x being Element of L holds g.x = Class(EqRel R, x)
  holds g is CLHomomorphism of L, LR;

theorem 

  for L being continuous complete LATTICE, R being Subset of [:L,
  L:] st R is Equivalence_Relation of the carrier of L & ex LR being continuous
complete LATTICE st the carrier of LR = Class EqRel R & for g being Function of
  L, LR st for x being Element of L holds g.x = Class(EqRel R, x) holds g is
  CLHomomorphism of L, LR holds subrelstr R is CLSubFrame of [:L, L:];

registration
  let L be non empty reflexive RelStr;
  cluster directed-sups-preserving kernel for Function of L, L;
end;

definition
  let L be non empty reflexive RelStr, k be kernel Function of L, L;
  func kernel_congruence k -> non empty Subset of [:L, L:] equals

  [:k, k:]"(id
  the carrier of L);
end;

theorem 
  for L being non empty reflexive RelStr, k being kernel Function of L,
L holds kernel_congruence k is Equivalence_Relation of the carrier of L;

theorem 

  for L being continuous complete LATTICE, k being
  directed-sups-preserving kernel Function of L, L holds kernel_congruence k is
  CLCongruence;

definition 
  let L be continuous complete LATTICE, R be non empty Subset of [:L, L:] such
  that
 R is CLCongruence;
  func L ./. R -> continuous complete strict LATTICE means


  the carrier
of it = Class EqRel R & for x, y being Element of it holds x <= y iff "/\"(x, L
  ) <= "/\"(y, L);
end;

theorem 
  
  for L being continuous complete LATTICE, R being non empty Subset of
[:L, L :] st R is CLCongruence for x being set holds x is Element of L./.R iff
  ex y being Element of L st x = Class(EqRel R, y);

theorem 


  for L being continuous complete LATTICE, R being non empty Subset of
[:L, L:] st R is CLCongruence holds R = kernel_congruence kernel_op R;

theorem 


  for L being continuous complete LATTICE, k being
  directed-sups-preserving kernel Function of L, L holds k = kernel_op
  kernel_congruence k;

theorem 



  for L being continuous complete LATTICE, p being projection Function
  of L, L st p is infs-preserving holds Image p is continuous LATTICE & Image p
  is infs-inheriting;














begin 

definition
  let S,T be Semilattice such that
 S is upper-bounded implies T is upper-bounded;
  mode SemilatticeHomomorphism of S,T -> Function of S,T means


    for X being finite Subset of S holds it preserves_inf_of X;
end;

registration
  let S,T be Semilattice;
  cluster meet-preserving -> monotone for Function of S,T;
end;

registration
  let S be Semilattice, T be upper-bounded Semilattice;
  cluster -> meet-preserving for SemilatticeHomomorphism of S,T;
end;

theorem 
  for S,T being upper-bounded Semilattice
  for f being SemilatticeHomomorphism of S,T holds f.Top S = Top T;

theorem 
  for S,T being Semilattice, f being Function of S,T st f is meet-preserving
  for X being finite non empty Subset of S holds f preserves_inf_of X;

theorem 
  for S,T being upper-bounded Semilattice, f being meet-preserving Function
  of S, T st f.Top S = Top T holds f is SemilatticeHomomorphism of S,T;

theorem 
  for S,T being Semilattice, f being Function of S,T st f is meet-preserving &
  for X being filtered non empty Subset of S holds f preserves_inf_of X
  for X being non empty Subset of S holds f preserves_inf_of X;

theorem 
  for S,T being Semilattice, f being Function of S,T st f is infs-preserving
  holds f is SemilatticeHomomorphism of S,T;

theorem 
  for S1,T1,S2,T2 being non empty RelStr
  st the RelStr of S1 = the RelStr of S2 & the RelStr of T1 = the RelStr of T2
  for f1 being Function of S1,T1, f2 being Function of S2,T2 st f1 = f2 holds
  (f1 is infs-preserving implies f2 is infs-preserving) &
  (f1 is directed-sups-preserving implies f2 is directed-sups-preserving);

theorem 
  for S1,T1,S2,T2 being non empty RelStr
  st the RelStr of S1 = the RelStr of S2 & the RelStr of T1 = the RelStr of T2
  for f1 being Function of S1,T1, f2 being Function of S2,T2 st f1 = f2 holds
  (f1 is sups-preserving implies f2 is sups-preserving) &
  (f1 is filtered-infs-preserving implies f2 is filtered-infs-preserving);

theorem 
  for T being complete LATTICE
  for S being infs-inheriting full non empty SubRelStr of T
  holds incl(S,T) is infs-preserving;

theorem 
  for T being complete LATTICE
  for S being sups-inheriting full non empty SubRelStr of T
  holds incl(S,T) is sups-preserving;

theorem 
  for T being up-complete non empty Poset
  for S being directed-sups-inheriting full non empty SubRelStr of T
  holds incl(S,T) is directed-sups-preserving;

theorem 
  for T being complete LATTICE
  for S being filtered-infs-inheriting full non empty SubRelStr of T
  holds incl(S,T) is filtered-infs-preserving;

theorem 
  for T1,T2,R being RelStr, S being SubRelStr of T1
  st the RelStr of T1 = the RelStr of T2 & the RelStr of S = the RelStr of R
  holds R is SubRelStr of T2 & (S is full implies R is full SubRelStr of T2);

theorem 
  for T being non empty RelStr holds
  T is infs-inheriting sups-inheriting full SubRelStr of T;

registration
  let T be complete LATTICE;
  cluster complete for CLSubFrame of T;
end;

theorem 
  for T being Semilattice for S being full non empty SubRelStr of T
  holds S is meet-inheriting iff
  for X being finite non empty Subset of S holds "/\"
  (X, T) in the carrier of S;

theorem 
  for T being sup-Semilattice for S being full non empty SubRelStr of T
  holds S is join-inheriting iff
  for X being finite non empty Subset of S holds "\/"
  (X, T) in the carrier of S;

theorem 
  for T being upper-bounded Semilattice
  for S being meet-inheriting full non empty SubRelStr of T
  st Top T in the carrier of S & S is filtered-infs-inheriting
  holds S is infs-inheriting;

theorem 
  for T being lower-bounded sup-Semilattice
  for S being join-inheriting full non empty SubRelStr of T
  st Bottom T in the carrier of S & S is directed-sups-inheriting
  holds S is sups-inheriting;

theorem 
  for T being complete LATTICE, S being full non empty SubRelStr of T
  st S is infs-inheriting holds S is complete;

theorem 
  for T being complete LATTICE, S being full non empty SubRelStr of T
  st S is sups-inheriting holds S is complete;

theorem 
  for T1,T2 being non empty RelStr for S1 being non empty full SubRelStr of T1
  for S2 being non empty full SubRelStr of T2
  st the RelStr of T1 = the RelStr of T2 &
  the carrier of S1 = the carrier of S2
  holds S1 is infs-inheriting implies S2 is infs-inheriting;

theorem 
  for T1,T2 being non empty RelStr for S1 being non empty full SubRelStr of T1
  for S2 being non empty full SubRelStr of T2
  st the RelStr of T1 = the RelStr of T2 &
  the carrier of S1 = the carrier of S2
  holds S1 is sups-inheriting implies S2 is sups-inheriting;

theorem 
  for T1,T2 being non empty RelStr for S1 being non empty full SubRelStr of T1
  for S2 being non empty full SubRelStr of T2
  st the RelStr of T1 = the RelStr of T2 &
  the carrier of S1 = the carrier of S2
  holds S1 is directed-sups-inheriting implies S2 is directed-sups-inheriting;

theorem 
  for T1,T2 being non empty RelStr for S1 being non empty full SubRelStr of T1
  for S2 being non empty full SubRelStr of T2
  st the RelStr of T1 = the RelStr of T2 &
  the carrier of S1 = the carrier of S2
  holds S1 is filtered-infs-inheriting implies S2 is filtered-infs-inheriting;

begin 

theorem 
  for S,T being non empty TopSpace, N being net of S
  for f being Function of S,T st f is continuous holds f.:Lim N c= Lim (f*N);

definition
  let T be non empty RelStr;
  let N be non empty NetStr over T;
  redefine attr N is antitone means


   for i,j being Element of N st i <= j holds N.i >= N.j;
end;

registration
  let T be non empty reflexive RelStr;
  let x be Element of T;
  cluster {x} opp+id -> transitive directed monotone antitone;
end;

registration
  let T be non empty reflexive RelStr;
  cluster monotone antitone reflexive strict for net of T;
end;

registration
  let T be non empty RelStr;
  let F be non empty Subset of T;
  cluster F opp+id -> antitone;
end;

registration
  let S,T be non empty reflexive RelStr;
  let f be monotone Function of S,T;
  let N be antitone non empty NetStr over S;
  cluster f*N -> antitone;
end;

theorem 
  for S being complete LATTICE, N be net of S holds
  {"/\"({N.i where i is Element of N:i >= j},S)
  where j is Element of N: not contradiction}
  is directed non empty Subset of S;

theorem 
  for S being non empty Poset, N be monotone reflexive net of S holds
  {"/\"({N.i where i is Element of N: i >= j}, S)
  where j is Element of N: not contradiction}
  is directed non empty Subset of S;

theorem 
  for S being non empty 1-sorted, N being non empty NetStr over S, X being set
  st rng the mapping of N c= X holds N is_eventually_in X;

theorem 
  for R being /\-complete non empty Poset
  for F being non empty filtered Subset of R holds lim_inf (F opp+id) = inf F;

theorem 
  for S,T being /\-complete non empty Poset
  for X being non empty filtered Subset of S
  for f being monotone Function of S,T
  holds lim_inf (f*(X opp+id)) = inf (f.:X);

theorem 
  for S,T being non empty TopPoset for X being non empty filtered Subset of S
  for f being monotone Function of S,T
  for Y being non empty filtered Subset of T st Y = f.:X
  holds f*(X opp+id) is subnet of Y opp+id;

theorem 
  for S,T being non empty TopPoset for X being non empty filtered Subset of S
  for f being monotone Function of S,T
  for Y being non empty filtered Subset of T st Y = f.:X
  holds Lim (Y opp+id) c= Lim (f*(X opp+id));

theorem 
  for S being non empty reflexive RelStr, D being non empty Subset of S
  holds the mapping of Net-Str D = id D & the carrier of Net-Str D = D &
  Net-Str D is full SubRelStr of S;

theorem 
  for S,T being up-complete non empty Poset
  for f being monotone Function of S,T
  for D being non empty directed Subset of S
  holds lim_inf (f*Net-Str D) = sup (f.:D);

theorem 
  for S being non empty reflexive RelStr
  for D being non empty directed Subset of S
  for i,j being Element of Net-Str D
  holds i <= j iff (Net-Str D).i <= (Net-Str D).j;

theorem 
  for T being Lawson complete TopLattice
  for D being directed non empty Subset of T holds sup D in Lim Net-Str D;

definition
  let T be non empty 1-sorted;
  let N be net of T, M be non empty NetStr over T such that
 M is subnet of N;
  mode Embedding of M,N -> Function of M,N means


     the mapping of M = (the mapping of N)*it &
    for m being Element of N ex n being Element of M st
    for p being Element of M st n <= p holds m <= it.p;
end;

theorem 
  for T being non empty 1-sorted for N being net of T, M being subnet of N
  for e being Embedding of M,N, i being Element of M holds M.i = N.(e.i);

theorem 
  for T being complete LATTICE for N being net of T, M being subnet of N
  holds lim_inf N <= lim_inf M;

theorem 
  for T being complete LATTICE for N being net of T, M being subnet of N
  for e being Embedding of M, N
  st for i being Element of N, j being Element of M st e.j <= i
  ex j9 being Element of M st j9 >= j & N.i >= M.j9
  holds lim_inf N = lim_inf M;

theorem 
  for T being non empty RelStr
  for N being net of T, M being non empty full SubNetStr of N
  st for i being Element of N
  ex j being Element of N st j >= i & j in the carrier of M
  holds M is subnet of N & incl(M,N) is Embedding of M,N;

theorem 
  for T being non empty RelStr, N being net of T for i being Element of N holds
  N|i is subnet of N & incl(N|i,N) is Embedding of N|i, N;

theorem 
  for T being complete LATTICE, N being net of T
  for i being Element of N holds lim_inf (N|i) = lim_inf N;

theorem 
  for T being non empty RelStr, N being net of T, X being set
  st N is_eventually_in X
  ex i be Element of N st N.i in X & rng the mapping of N|i c= X;

theorem 
  for T being Lawson complete TopLattice
  for N being eventually-filtered net of T
  holds rng the mapping of N is filtered non empty Subset of T;

theorem 


  for T being Lawson complete TopLattice
  for N being eventually-filtered net of T holds Lim N = {inf N};

begin 

theorem 


  for S,T being Lawson complete TopLattice
  for f being meet-preserving Function of S,T holds
  f is continuous iff f is directed-sups-preserving &
  for X being non empty Subset of S holds f preserves_inf_of X;

theorem 


  for S,T being Lawson complete TopLattice
  for f being SemilatticeHomomorphism of S,T holds
  f is continuous iff f is infs-preserving directed-sups-preserving;

definition
  let S,T be non empty RelStr;
  let f be Function of S,T;
  attr f is lim_infs-preserving means

  for N being net of S holds f.lim_inf N = lim_inf (f*N);
end;

theorem 


  for S,T being Lawson complete TopLattice
  for f being SemilatticeHomomorphism of S,T holds
  f is continuous iff f is lim_infs-preserving;

theorem 


  for T being Lawson complete continuous TopLattice
  for S being meet-inheriting full non empty SubRelStr of T
  st Top T in the carrier of S &
  ex X being Subset of T st X = the carrier of S & X is closed
  holds S is infs-inheriting;

theorem 


  for T being Lawson complete continuous TopLattice
  for S being full non empty SubRelStr of T
  st ex X being Subset of T st X = the carrier of S & X is closed
  holds S is directed-sups-inheriting;

theorem 


  for T being Lawson complete continuous TopLattice
  for S being infs-inheriting directed-sups-inheriting full non empty
  SubRelStr of T ex X being Subset of T st X = the carrier of S & X is closed;

theorem 


  for T being Lawson complete continuous TopLattice
  for S being infs-inheriting directed-sups-inheriting full non empty
  SubRelStr of T for N being net of T st N is_eventually_in the carrier of S
  holds lim_inf N in the carrier of S;

theorem 


  for T being Lawson complete continuous TopLattice
  for S being meet-inheriting full non empty SubRelStr of T
  st Top T in the carrier of S &
  for N being net of T st rng the mapping of N c= the carrier of S
  holds lim_inf N in the carrier of S holds S is infs-inheriting;

theorem 


  for T being Lawson complete continuous TopLattice
  for S being full non empty SubRelStr of T
  st for N being net of T st rng the mapping of N c= the carrier of S
  holds lim_inf N in the carrier of S holds S is directed-sups-inheriting;

theorem 


  for T being Lawson complete continuous TopLattice
  for S being meet-inheriting full non empty SubRelStr of T
  for X being Subset of T st X = the carrier of S & Top T in X holds
  X is closed iff
  for N being net of T st N is_eventually_in X holds lim_inf N in X;














begin

theorem 
  for L being upper-bounded Semilattice, F being non empty directed
  Subset of InclPoset Filt L holds sup F = union F;

theorem 
  for L, S, T being complete non empty Poset, f being
  CLHomomorphism of L, S, g being CLHomomorphism of S, T holds g*f is
  CLHomomorphism of L, T;

theorem 
  for L being non empty RelStr holds id L is infs-preserving;

theorem 
  for L being non empty RelStr holds id L is directed-sups-preserving;

theorem 
  for L being complete non empty Poset holds id L is CLHomomorphism of L, L;

theorem 
  for L being upper-bounded with_infima non empty Poset holds
  InclPoset Filt L is CLSubFrame of BoolePoset the carrier of L;

registration
  let L be upper-bounded with_infima non empty Poset;
  cluster InclPoset Filt L -> continuous;
end;

registration
  let L be upper-bounded non empty Poset;
  cluster -> non empty for Element of InclPoset Filt L;
end;

begin 

definition
  let S be continuous complete non empty Poset;
  let A be set;
  pred A is_FreeGen_set_of S means


  for T be continuous complete non
empty Poset for f be Function of A, the carrier of T ex h be CLHomomorphism of
S, T st h|A = f & for h9 being CLHomomorphism of S,T st h9|A = f holds h9 = h;
end;

theorem 
  for S being continuous complete non empty Poset, A being set st
  A is_FreeGen_set_of S holds A is Subset of S;

theorem 
  for S being continuous complete non empty Poset, A being set st
A is_FreeGen_set_of S for h9 being CLHomomorphism of S, S st h9|A = id A holds
  h9 = id S;

begin 

reserve X for set,
  F for Filter of BoolePoset X,
  x for Element of BoolePoset X ,
  z for Element of X;

definition 
  let X;
  func FixedUltraFilters X -> Subset-Family of BoolePoset X equals

  { uparrow x
  : ex z st x = {z} };
end;

theorem 
  FixedUltraFilters X c= Filt BoolePoset X;

theorem 
  card FixedUltraFilters X = card X;

theorem 
  F = "\/"({"/\"({uparrow x : ex z st x = {z} & z in Y}, InclPoset
Filt BoolePoset X) where Y is Subset of X : Y in F}, InclPoset Filt BoolePoset
  X);

definition 
  let X;
  let L be continuous complete non empty Poset;
  let f be Function of FixedUltraFilters X, the carrier of L;
  func f-extension_to_hom -> Function of InclPoset Filt BoolePoset X, L means


  for Fi being Element of InclPoset Filt BoolePoset X holds it.Fi = "\/"({
"/\"({f.(uparrow x) : ex z st x = {z} & z in Y }, L) where Y is Subset of X : Y
  in Fi }, L);
end;

theorem 
  for L being continuous complete non empty Poset, f being Function of
  FixedUltraFilters X, the carrier of L holds f-extension_to_hom is monotone;

theorem 
  for L being continuous complete non empty Poset, f being
  Function of FixedUltraFilters X, the carrier of L holds (f-extension_to_hom).
  Top (InclPoset Filt BoolePoset X) = Top L;

registration 
  let X;
  let L be continuous complete non empty Poset, f be Function of
  FixedUltraFilters X, the carrier of L;
  cluster f-extension_to_hom -> directed-sups-preserving;
end;

registration 
  let X;
  let L be continuous complete non empty Poset, f be Function of
  FixedUltraFilters X, the carrier of L;
  cluster f-extension_to_hom -> infs-preserving;
end;

theorem 
  for L being continuous complete non empty Poset, f being
  Function of FixedUltraFilters X, the carrier of L holds f-extension_to_hom |
  FixedUltraFilters X = f;

theorem 
  for L being continuous complete non empty Poset, f being
  Function of FixedUltraFilters X, the carrier of L, h being CLHomomorphism of
  InclPoset Filt BoolePoset X, L st h | FixedUltraFilters X = f holds h = f
  -extension_to_hom;

theorem 
  FixedUltraFilters X is_FreeGen_set_of InclPoset Filt BoolePoset X;

theorem 
  for L, M being continuous complete LATTICE, F, G being set st F
  is_FreeGen_set_of L & G is_FreeGen_set_of M & card F = card G holds L, M
  are_isomorphic;


theorem 
  for L being continuous complete LATTICE, G being set st G
  is_FreeGen_set_of L & card G = card X holds L, InclPoset Filt BoolePoset X
  are_isomorphic;














begin   

reserve p, q for FinSequence,
  e,X for set,
  i, j, k, m, n for Element of NAT,
  G for Graph;
reserve x,y,v,v1,v2,v3,v4 for Element of G;

definition
  let G;
  let x, y;
  let e;
  pred e orientedly_joins x, y means


  (the Source of G).e = x & (the Target of G).e = y;
end;

theorem 
  e orientedly_joins v1, v2 implies e joins v1, v2;

definition
  let G;
  let x,y be Element of (the carrier of G);
  pred x,y are_orientedly_incident means

  ex v being set st v in the carrier' of G & v orientedly_joins x, y;
end;

theorem 
  e orientedly_joins v1,v2 & e orientedly_joins v3,v4 implies v1=v3 & v2=v4;

reserve vs, vs1, vs2 for FinSequence of the carrier of G,
  c, c1, c2 for oriented Chain of G;

definition
  let G, X;
  func G-SVSet X -> set equals

  { v: ex e being Element of the carrier' of G st e in X &
  v = (the Source of G).e };
end;

definition
  let G, X;
  func G-TVSet X -> set equals

  { v: ex e being Element of the carrier' of G st e in X &
  v = (the Target of G).e };
end;

theorem 
  G-SVSet {} = {} & G-TVSet {} = {};

definition
  let G, vs;
  let c be FinSequence;
  pred vs is_oriented_vertex_seq_of c means


  len vs = len c + 1 &
  for n st 1<=n & n<=len c holds c.n orientedly_joins vs/.n, vs/.(n+1);
end;

theorem 
  vs is_oriented_vertex_seq_of c implies vs is_vertex_seq_of c;

theorem 
  vs is_oriented_vertex_seq_of c implies G-SVSet rng c c= rng vs;

theorem 
  vs is_oriented_vertex_seq_of c implies G-TVSet rng c c= rng vs;

theorem 
  c <>{} & vs is_oriented_vertex_seq_of c implies
  rng vs c= G-SVSet rng c \/ G-TVSet rng c;

begin 

theorem 
  <*v*> is_oriented_vertex_seq_of {};

theorem 
  ex vs st vs is_oriented_vertex_seq_of c;

theorem 
  c <> {} & vs1 is_oriented_vertex_seq_of c & vs2 is_oriented_vertex_seq_of c
  implies vs1 = vs2;

definition
  let G, c;
  assume
 c <>{};
  func oriented-vertex-seq c -> FinSequence of the carrier of G means

  it is_oriented_vertex_seq_of c;
end;

theorem 
  vs is_oriented_vertex_seq_of c & c1 = c|Seg n & vs1= vs|Seg (n+1)
  implies vs1 is_oriented_vertex_seq_of c1;

theorem 
  1<=m & m<=n & n<=len c & q = (m,n)-cut c implies q is oriented Chain of G;

theorem 
  1<=m & m<=n & n<=len c & c1 = (m,n)-cut c &
  vs is_oriented_vertex_seq_of c & vs1 = (m,n+1)-cut vs
  implies vs1 is_oriented_vertex_seq_of c1;

theorem 
  vs1 is_oriented_vertex_seq_of c1
  & vs2 is_oriented_vertex_seq_of c2 & vs1.len vs1 = vs2.1
  implies c1^c2 is oriented Chain of G;

theorem 
  vs1 is_oriented_vertex_seq_of c1 & vs2 is_oriented_vertex_seq_of c2
  & vs1.len vs1 = vs2.1 & c = c1^c2 & vs = vs1^'vs2
  implies vs is_oriented_vertex_seq_of c;

begin

definition
  let G;
  let IT be oriented Chain of G;
  attr IT is Simple means


  ex vs st vs is_oriented_vertex_seq_of IT &
  for n,m st 1<=n & n<m & m<=len vs & vs.n=vs.m holds n=1 & m=len vs;
end;

registration
  let G;
  cluster Simple for oriented Chain of G;
end;

registration
  let G;
  cluster oriented simple for Chain of G;
end;

theorem 
  for q being oriented Chain of G holds q|(Seg n) is oriented Chain of G;

reserve sc for oriented simple Chain of G;

theorem 
  sc|(Seg n) is oriented simple Chain of G;

theorem 
  for sc9 being oriented Chain of G st sc9=sc holds sc9 is Simple;

theorem 
  for sc9 being Simple oriented Chain of G
  holds sc9 is oriented simple Chain of G;

reserve x,y for set;

theorem 
  not c is Simple & vs is_oriented_vertex_seq_of c implies
  ex fc being Subset of c, fvs being Subset of vs, c1, vs1
  st len c1 < len c & vs1 is_oriented_vertex_seq_of c1 & len vs1 < len vs &
  vs.1 = vs1.1 & vs.len vs = vs1.len vs1 & Seq fc = c1 & Seq fvs = vs1;

theorem 
  vs is_oriented_vertex_seq_of c implies
  ex fc being Subset of c, fvs being Subset of vs, sc, vs1
  st Seq fc = sc & Seq fvs = vs1 & vs1 is_oriented_vertex_seq_of sc &
  vs.1 = vs1.1 & vs.len vs = vs1.len vs1;

theorem 
  p is OrientedPath of G implies p|Seg(n) is OrientedPath of G;

theorem 
  sc is OrientedPath of G;

theorem 
  for c1 being FinSequence holds (c1 is Simple oriented Chain of G iff
  c1 is oriented simple Chain of G)
  &(c1 is oriented simple Chain of G implies c1 is OrientedPath of G);















begin 

reserve x,y for set;
reserve G for Graph;
reserve vs,vs9 for FinSequence of the carrier of G;
reserve IT for oriented Chain of G;
reserve n,m,k,i,j for Element of NAT;
reserve r,r1,r2 for Real;

theorem 
  for vs st IT is Simple & vs is_oriented_vertex_seq_of IT holds
  for n,m st 1<=n & n<m & m<=len vs & vs.n=vs.m holds n=1 & m=len vs;

definition
  let X be set;
  func PGraph(X) -> MultiGraphStruct equals

  MultiGraphStruct(#X,[:X,X:],pr1(X,
    X),pr2(X,X)#);
end;

theorem 
  for X being set holds the carrier of PGraph(X)=X;

definition
  let f be FinSequence;
  func PairF(f) -> FinSequence means


  len it=len f-'1 & for i being
  Element of NAT st 1<=i & i<len f holds it.i=[f.i,f.(i+1)];
end;

reserve X for non empty set;

registration
  let X be non empty set;
  cluster PGraph(X) -> non empty;
end;

theorem 
  for f being FinSequence of X holds f is FinSequence of the carrier of
  PGraph(X);

theorem 
  for f being FinSequence of X holds PairF(f) is FinSequence of the
  carrier' of PGraph(X);

definition
  let X be non empty set,f be FinSequence of X;
  redefine func PairF(f) -> FinSequence of the carrier' of PGraph(X);
end;

theorem 
  for n being Element of NAT,f being FinSequence of X st 1 <= n & n
  <= len PairF(f) holds (PairF(f)).n in the carrier' of PGraph(X);

theorem 
  for f being FinSequence of X holds PairF(f) is oriented Chain of PGraph(X);

definition
  let X be non empty set,f be FinSequence of X;
  redefine func PairF(f) -> oriented Chain of PGraph(X);
end;

theorem 
  for f being FinSequence of X, f1 being FinSequence of the
  carrier of PGraph(X) st len f>=1 & f=f1 holds f1 is_oriented_vertex_seq_of
  PairF(f);

begin 

definition
  let X be non empty set,f,g be FinSequence of X;
  pred g is_Shortcut_of f means


  f.1=g.1 & f.len f=g.len g & ex fc being
  Subset of PairF(f),fvs being Subset of f, sc being oriented simple Chain of
  PGraph(X), g1 being FinSequence of the carrier of PGraph(X) st Seq fc = sc &
  Seq fvs = g & g1=g & g1 is_oriented_vertex_seq_of sc;
end;

theorem 
  for f,g being FinSequence of X st g is_Shortcut_of f holds 1<=
  len g & len g <= len f;

theorem 
  for f being FinSequence of X st len f>=1 holds ex g being
  FinSequence of X st g is_Shortcut_of f;

theorem 
  for f,g being FinSequence of X st g is_Shortcut_of f holds rng
  PairF(g) c= rng PairF(f);

theorem 
  for f,g being FinSequence of X st f.1<>f.len f & g
  is_Shortcut_of f holds g is one-to-one;

definition
  let n;
  let IT be FinSequence of TOP-REAL n;
  attr IT is nodic means


  for i,j st LSeg(IT,i) meets LSeg(IT,j) holds
LSeg(IT,i) /\ LSeg(IT,j)={IT.i} &(IT.i=IT.j or IT.i=IT.(j+1)) or LSeg(IT,i) /\
LSeg(IT,j)={IT.(i+1)} &(IT.(i+1)=IT.j or IT.(i+1)=IT.(j+1)) or LSeg(IT,i)=LSeg(
  IT,j);
end;

theorem 
  for f being FinSequence of TOP-REAL 2 st f is s.n.c. holds f is s.c.c.;

theorem 
  for f being FinSequence of TOP-REAL 2 st f is s.c.c. & LSeg(f,1)
  misses LSeg(f,len f -'1) holds f is s.n.c.;

theorem 
  for f being FinSequence of TOP-REAL 2 st f is nodic & PairF(f)
  is Simple holds f is s.c.c.;

theorem 
  for f being FinSequence of TOP-REAL 2 st f is nodic & PairF(f)
  is Simple & f.1<>f.len f holds f is s.n.c.;

theorem 
  for p1,p2,p3 being Point of TOP-REAL n st (ex x being set st x<>
p2 & x in LSeg(p1,p2)/\ LSeg(p2,p3)) holds p1 in LSeg(p2,p3) or p3 in LSeg(p1,
  p2);

theorem 
  for f being FinSequence of TOP-REAL 2 st f is s.n.c. & LSeg(f,1)
/\ LSeg(f,1+1) c= {f/.(1+1)} & LSeg(f,len f-'2) /\ LSeg(f,len f-'1) c= {f/.(len
  f-'1)} holds f is unfolded;

theorem 
  for f being FinSequence of X holds PairF(f) is Simple & f.1<>f.
  len f implies f is one-to-one & len f<>1;

theorem 
  for f being FinSequence of X holds f is one-to-one & len f>1 implies
  PairF(f) is Simple & f.1<>f.len f;

theorem 
  for f being FinSequence of TOP-REAL 2 st f is nodic & PairF(f) is
  Simple & f.1<>f.len f holds f is unfolded;

theorem 
  for f,g being FinSequence of TOP-REAL 2,i st g is_Shortcut_of f
& 1 <= i & i+1 <= len g holds ex k1 being Element of NAT st 1<=k1 & k1+1<=len f
  & f/.k1=g/.i & f/.(k1+1)=g/.(i+1) & f.k1=g.i & f.(k1+1)=g.(i+1);

theorem 
  for f,g being FinSequence of TOP-REAL 2 st g is_Shortcut_of f
  holds rng g c= rng f;

theorem 
  for f,g being FinSequence of TOP-REAL 2 st g is_Shortcut_of f
  holds L~g c= L~f;

theorem 
  for f,g being FinSequence of TOP-REAL 2 st f is special & g
  is_Shortcut_of f holds g is special;

theorem 
  for f being FinSequence of TOP-REAL 2 st f is special & 2<=len f
& f.1 <> f.len f holds ex g being FinSequence of TOP-REAL 2 st 2<=len g & g is
  special & g is one-to-one & L~g c= L~f & f.1=g.1 & f.len f=g.len g & rng g c=
  rng f;



theorem 
  for f1,f2 being FinSequence of TOP-REAL 2 st f1 is special & f2
is special & 2<=len f1 & 2<=len f2 & f1.1<>f1.len f1 & f2.1<>f2.len f2 & X_axis
  (f1) lies_between (X_axis(f1)).1, (X_axis(f1)).(len f1) & X_axis(f2)
lies_between (X_axis(f1)).1, (X_axis(f1)).(len f1) & Y_axis(f1) lies_between (
Y_axis(f2)).1, (Y_axis(f2)).(len f2) & Y_axis(f2) lies_between (Y_axis(f2)).1,
  (Y_axis(f2)).(len f2) holds L~f1 meets L~f2;

begin  

theorem 
  for a,b,r1,r2 being Real st a<=r1 & r1<=b & a<=r2 & r2<=b holds
  abs(r1-r2)<=b-a;

reserve p,p1,p2 for Point of TOP-REAL n;

theorem 
  for x1,x2 being Point of Euclid n st x1=p1 & x2=p2 holds |.p1 -
  p2.| = dist(x1,x2);

theorem 
  for p being Point of TOP-REAL 2 holds |.p.|^2 = (p`1)^2+(p`2)^2;

theorem 
  for p being Point of TOP-REAL 2 holds |.p.| = sqrt((p`1)^2+(p`2) ^2);

theorem 
  for p being Point of TOP-REAL 2 holds |.p.|<=abs(p`1)+abs(p`2);

theorem 
  for p1,p2 being Point of TOP-REAL 2 holds |.p1-p2.|<=abs(p1`1-p2
  `1)+abs(p1`2-p2`2);

theorem 
  for p being Point of TOP-REAL 2 holds abs(p`1)<=|.p.| & abs(p`2) <=|.p.|;

theorem 
  for p1,p2 being Point of TOP-REAL 2 holds abs(p1`1-p2`1)<=|.p1-
  p2.| & abs(p1`2-p2`2)<=|.p1-p2.|;

theorem 
  p in LSeg(p1,p2) implies ex r st 0<=r & r<=1 & p=(1-r)*p1+r*p2;

theorem 
  p in LSeg(p1,p2) implies |.p-p1.|<=|.p1-p2.| & |.p-p2.|<=|.p1-p2 .|;

begin 

reserve M for non empty MetrSpace;

theorem 
  for P,Q being Subset of TopSpaceMetr(M) st P <> {} & P is
  compact & Q <> {} & Q is compact holds min_dist_min(P,Q)>=0;

theorem 
  for P,Q being Subset of TopSpaceMetr(M) st P <> {} & P is
  compact & Q <> {} & Q is compact holds P misses Q iff min_dist_min(P,Q)>0;



theorem 
  for f being FinSequence of TOP-REAL 2,a,c,d being Real st 1<=len
  f & X_axis(f) lies_between (X_axis(f)).1, (X_axis(f)).(len f) & Y_axis(f)
lies_between c, d & a>0 & (for i st 1<=i & i+1<=len f holds |. f/.i-f/.(i+1) .|
  <a) holds ex g being FinSequence of TOP-REAL 2 st g is special & g.1=f.1 & g.
len g=f.len f & len g>=len f & X_axis(g) lies_between (X_axis(f)).1, (X_axis(f)
).(len f) & Y_axis(g) lies_between c, d & (for j st j in dom g holds ex k st k
in dom f & |. g/.j - f/.k .|<a)& for j st 1<=j & j+1<=len g holds |. g/.j - g/.
  (j+1) .|<a;

theorem 
  for f being FinSequence of TOP-REAL 2,a,c,d being Real st 1<=len
  f & Y_axis(f) lies_between (Y_axis(f)).1, (Y_axis(f)).(len f) & X_axis(f)
lies_between c, d & a>0 & (for i st 1<=i & i+1<=len f holds |. (f/.i)-(f/.(i+1)
) .|<a) holds ex g being FinSequence of TOP-REAL 2 st g is special & g.1=f.1 &
g.len g=f.len f & len g>=len f & Y_axis(g) lies_between (Y_axis(f)).1, (Y_axis(
f)).(len f) & X_axis(g) lies_between c, d & (for j st j in dom g holds ex k st
k in dom f & |. g/.j - f/.k .| < a)& for j st 1<=j & j+1<=len g holds |. g/.j -
  g/.(j+1) .|<a;

theorem 
  for f being FinSequence of TOP-REAL 2 st 1 <=len f holds len
  X_axis(f)=len f & X_axis(f).1=(f/.1)`1 & X_axis(f).len f=(f/.len f)`1;

theorem 
  for f being FinSequence of TOP-REAL 2 st 1 <=len f holds len
  Y_axis(f)=len f & Y_axis(f).1=(f/.1)`2 & Y_axis(f).len f=(f/.len f)`2;

theorem 
  for f being FinSequence of TOP-REAL 2 st i in dom f holds X_axis
  (f).i=(f/.i)`1 & Y_axis(f).i=(f/.i)`2;



theorem 
  for P,Q being non empty Subset of TOP-REAL 2, p1,p2,q1,q2 being
  Point of TOP-REAL 2 st P is_an_arc_of p1,p2 & Q is_an_arc_of q1,q2 & (for p
  being Point of TOP-REAL 2 st p in P holds p1`1<=p`1 & p`1<= p2`1) & (for p
  being Point of TOP-REAL 2 st p in Q holds p1`1<=p`1 & p`1<= p2`1) & (for p
  being Point of TOP-REAL 2 st p in P holds q1`2<=p`2 & p`2<= q2`2) & (for p
being Point of TOP-REAL 2 st p in Q holds q1`2<=p`2 & p`2<= q2`2) holds P meets
  Q;

reserve X,Y for non empty TopSpace;

theorem 
  for f being Function of X,Y, P being non empty Subset of Y, f1
  being Function of X,Y|P st f=f1 & f is continuous holds f1 is continuous;

theorem 
  for f being Function of X,Y, P being non empty Subset of Y st X
is compact & Y is T_2 & f is continuous one-to-one & P=rng f holds ex f1 being
  Function of X,(Y|P) st f=f1 & f1 is being_homeomorphism;


theorem 
  for f,g being Function of I[01],TOP-REAL 2,a,b,c,d being real number ,
  O,I being Point of I[01] st O=0 & I=1 & f is continuous one-to-one & g is
continuous one-to-one & (f.O)`1=a & (f.I)`1=b & (g.O)`2=c & (g.I)`2=d & (for r
being Point of I[01] holds a <=(f.r)`1 & (f.r)`1<=b & a <=(g.r)`1 & (g.r)`1<=b
& c <=(f.r)`2 & (f.r)`2<=d & c <=(g.r)`2 & (g.r)`2<=d) holds rng f meets rng g;















begin 

reserve i,j,k,n for Element of NAT;
reserve x,y,z for Tuple of n, BOOLEAN;

theorem 
  for i,j,k holds j is prime & i<j & k<j & i<>0 implies ex a being
  Element of NAT st (a*i) mod j = k & a < j;

theorem 
  for n,k1,k2 being Element of NAT holds n <> 0 & k1 mod n = k2 mod
  n & k1 <= k2 implies ex t being Element of NAT st k2 - k1 = n*t;

theorem 
  for a, b being Element of NAT holds a - b <= a;

theorem 
  for b1,b2,c being Element of NAT holds b2 <= c implies b2 - b1 <= c;

theorem 
  for a,b,c being Element of NAT holds 0<a & 0<b & a<c & b<c & c is
  prime implies (a * b) mod c <> 0;

begin 








definition
  let n;
  func ZERO( n ) -> Tuple of n, BOOLEAN equals

  n |-> FALSE;
end;

definition
  let n;
  let x, y be Tuple of n, BOOLEAN;
  func x 'xor' y -> Tuple of n, BOOLEAN means


  for i st i in Seg n holds it/.i = (x/.i) 'xor' (y/.i);
end;

theorem 
  for n,x holds x 'xor' x = ZERO(n);

theorem 
  for n,x,y holds x 'xor' y = y 'xor' x;

definition
  let n;
  let x, y be Tuple of n, BOOLEAN;
  redefine func x 'xor' y;
  commutativity;
end;

theorem 
  for n,x holds ZERO(n) 'xor' x = x;

theorem 
  for n,x,y,z holds (x 'xor' y) 'xor' z = x 'xor' (y 'xor' z);

definition
  let n;
  let i be Element of NAT;
  pred i is_expressible_by n means


  i < 2 to_power(n);
end;

theorem 
  for n holds n-BinarySequence 0 = ZERO(n);

definition
  let n;
  let i, j be Nat;
  func ADD_MOD(i,j,n) -> Element of NAT equals

  (i + j) mod 2 to_power(n);
end;

definition
  let n;
  let i be Element of NAT;
  assume
 i is_expressible_by n;
  func NEG_N(i,n) -> Element of NAT equals


  2 to_power(n) - i;
end;

definition
  let n;
  let i be Element of NAT;
  func NEG_MOD(i,n) -> Element of NAT equals

  NEG_N(i,n) mod 2 to_power(n);
end;

theorem 
  i is_expressible_by n implies ADD_MOD(i, NEG_MOD(i,n), n) = 0;

theorem 
  ADD_MOD(i,j,n) = ADD_MOD(j,i,n);

theorem 
  i is_expressible_by n implies ADD_MOD(0,i,n) = i;

theorem 
  ADD_MOD(ADD_MOD(i,j,n),k,n) = ADD_MOD(i,ADD_MOD(j,k,n),n);

theorem 
  ADD_MOD(i,j,n) is_expressible_by n;

theorem 
  NEG_MOD(i,n) is_expressible_by n;

definition
  let n, i be Nat;
  func ChangeVal_1(i,n) -> Element of NAT equals


  2 to_power(n) if i = 0
  otherwise i;
end;

theorem 
  i is_expressible_by n implies ChangeVal_1(i,n) <= 2 to_power(n)
  & ChangeVal_1(i,n) > 0;

theorem 
  for n,a1,a2 be Element of NAT holds a1 is_expressible_by n & a2
  is_expressible_by n & ChangeVal_1(a1,n) = ChangeVal_1(a2,n) implies a1 = a2;

definition
  let n;
  let i be Element of NAT;
  func ChangeVal_2(i,n) -> Element of NAT equals


  0 if i = 2 to_power(n)
  otherwise i;
end;

theorem 
  i is_expressible_by n implies ChangeVal_2(i,n) is_expressible_by n;

theorem 
  for n,a1,a2 be Element of NAT holds a1 <> 0 & a2 <> 0 &
  ChangeVal_2(a1,n) = ChangeVal_2(a2,n) implies a1 = a2;

definition
  let n;
  let i,j be Nat;
  func MUL_MOD(i,j,n) -> Element of NAT equals

  ChangeVal_2((ChangeVal_1(i,n)*
  ChangeVal_1(j,n)) mod (2 to_power(n)+1),n);
end;

definition
  let n be non empty Element of NAT;
  let i be Element of NAT;
  assume that
 i is_expressible_by n and
 (2 to_power(n) + 1) is prime;
  func INV_MOD(i,n) -> Element of NAT means


  MUL_MOD(i,it,n) = 1 & it is_expressible_by n;
end;

theorem 
  MUL_MOD(i,j,n) = MUL_MOD(j,i,n);

theorem 
  i is_expressible_by n implies MUL_MOD(1,i,n) = i;

theorem 
  (2 to_power(n)+1) is prime & i is_expressible_by n & j
is_expressible_by n & k is_expressible_by n implies MUL_MOD(MUL_MOD(i,j,n),k,n)
  = MUL_MOD(i,MUL_MOD(j,k,n),n);

theorem 
  MUL_MOD(i,j,n) is_expressible_by n;

theorem 
  ChangeVal_2(i,n) = 1 implies i = 1;

begin 








definition
  let n;
  let m,k be FinSequence of NAT;
  func IDEAoperationA(m, k, n) -> FinSequence of NAT means


  len(it) =
  len(m) & for i being Element of NAT st i in dom m holds (i=1 implies it.i =
  MUL_MOD(m.1, k.1, n)) & (i=2 implies it.i = ADD_MOD(m.2, k.2, n)) & (i=3
implies it.i = ADD_MOD(m.3, k.3, n)) & (i=4 implies it.i = MUL_MOD(m.4, k.4, n)
  ) & (i<>1 & i <> 2 & i<>3 & i<>4 implies it.i = m.i);
end;



reserve m,k,k1,k2 for FinSequence of NAT;

definition
  let n be non empty Element of NAT;
  let m,k be FinSequence of NAT;
  func IDEAoperationB(m, k, n) -> FinSequence of NAT means


  len(it) =
  len(m) & for i being Element of NAT st i in dom m holds (i=1 implies it.i =
Absval((n-BinarySequence m.1) 'xor' (n-BinarySequence MUL_MOD(ADD_MOD(MUL_MOD(
  Absval((n-BinarySequence m.1) 'xor' (n-BinarySequence m.3)),k.5,n),Absval((n
  -BinarySequence m.2) 'xor' (n-BinarySequence m.4)),n),k.6,n))))& (i=2 implies
  it.i = Absval((n-BinarySequence m.2) 'xor' (n-BinarySequence ADD_MOD(MUL_MOD(
  Absval((n-BinarySequence m.1) 'xor' (n-BinarySequence m.3)),k.5,n),MUL_MOD(
ADD_MOD(MUL_MOD( Absval((n-BinarySequence m.1) 'xor' (n-BinarySequence m.3)), k
.5,n),Absval((n-BinarySequence m.2) 'xor' (n-BinarySequence m.4)),n),k.6,n),n))
  ))& (i=3 implies it.i = Absval((n-BinarySequence m.3) 'xor' (n-BinarySequence
MUL_MOD(ADD_MOD(MUL_MOD(Absval((n-BinarySequence m.1) 'xor' (n-BinarySequence m
.3)),k.5,n),Absval((n-BinarySequence m.2) 'xor' (n-BinarySequence m.4)),n),k.6,
  n))))& (i=4 implies it.i = Absval((n-BinarySequence m.4) 'xor' (n
  -BinarySequence ADD_MOD(MUL_MOD(Absval((n-BinarySequence m.1) 'xor' (n
-BinarySequence m.3)),k.5,n),MUL_MOD(ADD_MOD(MUL_MOD( Absval((n-BinarySequence
m.1) 'xor' (n-BinarySequence m.3)), k.5,n),Absval((n-BinarySequence m.2) 'xor'
  (n-BinarySequence m.4)),n),k.6,n),n))))& (i<>1 & i <> 2 & i<>3 & i<>4 implies
  it.i = m.i);
end;



definition
  let m be FinSequence of NAT;
  func IDEAoperationC(m) -> FinSequence of NAT means


  len(it) = len(m)
& for i being Element of NAT st i in dom m holds it.i = IFEQ(i,2,m.3,IFEQ(i,3,m
  .2,m.i));
end;

theorem 
  len m >= 4 implies IDEAoperationA(m,k,n).1 is_expressible_by n &
  IDEAoperationA(m,k,n).2 is_expressible_by n & IDEAoperationA(m,k,n).3
  is_expressible_by n & IDEAoperationA(m,k,n).4 is_expressible_by n;

theorem 
  for n being non empty Element of NAT holds len m >= 4 implies
  IDEAoperationB(m,k,n).1 is_expressible_by n & IDEAoperationB(m,k,n).2
  is_expressible_by n & IDEAoperationB(m,k,n).3 is_expressible_by n &
  IDEAoperationB(m,k,n).4 is_expressible_by n;

theorem 
  len m >= 4 & m.1 is_expressible_by n & m.2 is_expressible_by n & m.3
  is_expressible_by n & m.4 is_expressible_by n implies IDEAoperationC(m).1
is_expressible_by n & IDEAoperationC(m).2 is_expressible_by n & IDEAoperationC(
  m).3 is_expressible_by n & IDEAoperationC(m).4 is_expressible_by n;

theorem 
  for n being non empty Element of NAT,m,k1,k2 holds 2 to_power(n)
+1 is prime & len m >= 4 & m.1 is_expressible_by n & m.2 is_expressible_by n &
m.3 is_expressible_by n & m.4 is_expressible_by n & k1.1 is_expressible_by n &
k1.2 is_expressible_by n & k1.3 is_expressible_by n & k1.4 is_expressible_by n
  & k2.1=INV_MOD(k1.1,n) & k2.2=NEG_MOD(k1.2,n) & k2.3=NEG_MOD(k1.3,n) & k2.4=
  INV_MOD(k1.4,n) implies IDEAoperationA( IDEAoperationA(m,k1,n), k2, n) = m;

theorem 
  for n being non empty Element of NAT,m,k1,k2 holds 2 to_power(n)
+1 is prime & len m >= 4 & m.1 is_expressible_by n & m.2 is_expressible_by n &
m.3 is_expressible_by n & m.4 is_expressible_by n & k1.1 is_expressible_by n &
k1.2 is_expressible_by n & k1.3 is_expressible_by n & k1.4 is_expressible_by n
  & k2.1=INV_MOD(k1.1,n) & k2.2=NEG_MOD(k1.3,n) & k2.3=NEG_MOD(k1.2,n) & k2.4=
  INV_MOD(k1.4,n) implies IDEAoperationA(IDEAoperationC(IDEAoperationA(
  IDEAoperationC(m),k1,n)),k2,n) = m;

theorem 
  for n being non empty Element of NAT,m,k1,k2 holds len m >= 4 &
m.1 is_expressible_by n & m.2 is_expressible_by n & m.3 is_expressible_by n & m
  .4 is_expressible_by n & k2.5=k1.5 & k2.6=k1.6 implies IDEAoperationB(
  IDEAoperationB(m,k1,n), k2, n) = m;

theorem 
  for m holds len m >= 4 implies IDEAoperationC( IDEAoperationC(m) ) = m;

begin 




definition
  func MESSAGES -> set equals

  NAT*;
end;

registration
  cluster MESSAGES -> non empty;
end;

registration
  cluster MESSAGES -> functional;
end;

registration
  cluster -> FinSequence-like for Element of MESSAGES;
end;

definition
  let n be non empty Element of NAT,k;
  func IDEA_P(k,n) -> Function of MESSAGES, MESSAGES means


  for m holds it.m = IDEAoperationA(IDEAoperationC(IDEAoperationB(m,k,n)),k,n);
end;

definition
  let n be non empty Element of NAT,k;
  func IDEA_Q(k,n) -> Function of MESSAGES, MESSAGES means


  for m holds it.m = IDEAoperationB(IDEAoperationA(IDEAoperationC(m),k,n),k,n);
end;

definition
  let r,lk be Element of NAT,n be non empty Element of NAT, Key be Matrix of
  lk,6,NAT;
  func IDEA_P_F(Key,n,r) -> FinSequence means


  len it = r & for i st i in dom it holds it.i = IDEA_P(Line(Key,i),n);
end;

registration
  let r,lk be Element of NAT,n be non empty Element of NAT, Key be Matrix of
  lk,6,NAT;
  cluster IDEA_P_F(Key,n,r) -> Function-yielding;
end;

definition
  let r,lk be Element of NAT,n be non empty Element of NAT, Key be Matrix of
  lk,6,NAT;
  func IDEA_Q_F(Key,n,r) -> FinSequence means


  len it = r & for i st i in dom it holds it.i = IDEA_Q(Line(Key,r-'i+1),n);
end;

registration
  let r,lk be Element of NAT,n be non empty Element of NAT, Key be Matrix of
  lk,6,NAT;
  cluster IDEA_Q_F(Key,n,r) -> Function-yielding;
end;

definition
  let k,n;
  func IDEA_PS(k,n) -> Function of MESSAGES, MESSAGES means


  for m holds it.m = IDEAoperationA(m,k,n);
end;

definition
  let k,n;
  func IDEA_QS(k,n) -> Function of MESSAGES, MESSAGES means


  for m holds it.m = IDEAoperationA(m,k,n);
end;

definition
  let n be non empty Element of NAT,k;
  func IDEA_PE(k,n) -> Function of MESSAGES, MESSAGES means


  for m holds it.m = IDEAoperationA(IDEAoperationB(m,k,n),k,n);
end;

definition
  let n be non empty Element of NAT,k;
  func IDEA_QE(k,n) -> Function of MESSAGES, MESSAGES means


  for m holds it.m = IDEAoperationB(IDEAoperationA(m,k,n),k,n);
end;

theorem 
  for n being non empty Element of NAT,m,k1,k2 holds 2 to_power(n)
+1 is prime & len m >= 4 & m.1 is_expressible_by n & m.2 is_expressible_by n &
m.3 is_expressible_by n & m.4 is_expressible_by n & k1.1 is_expressible_by n &
k1.2 is_expressible_by n & k1.3 is_expressible_by n & k1.4 is_expressible_by n
& k2.1 = INV_MOD(k1.1,n) & k2.2 = NEG_MOD(k1.3,n) & k2.3 = NEG_MOD(k1.2,n) & k2
.4 = INV_MOD(k1.4,n) & k2.5 = k1.5 & k2.6 = k1.6 implies (IDEA_Q(k2,n)*IDEA_P(
  k1,n)).m = m;

theorem 
  for n being non empty Element of NAT,m,k1,k2 holds 2 to_power(n)
+1 is prime & len m >= 4 & m.1 is_expressible_by n & m.2 is_expressible_by n &
m.3 is_expressible_by n & m.4 is_expressible_by n & k1.1 is_expressible_by n &
k1.2 is_expressible_by n & k1.3 is_expressible_by n & k1.4 is_expressible_by n
& k2.1 = INV_MOD(k1.1,n) & k2.2 = NEG_MOD(k1.2,n) & k2.3 = NEG_MOD(k1.3,n) & k2
  .4 = INV_MOD(k1.4,n) implies (IDEA_QS(k2,n)*IDEA_PS(k1,n)).m = m;

theorem 
  for n being non empty Element of NAT,m,k1,k2 holds 2 to_power(n)
+1 is prime & len m >= 4 & m.1 is_expressible_by n & m.2 is_expressible_by n &
m.3 is_expressible_by n & m.4 is_expressible_by n & k1.1 is_expressible_by n &
k1.2 is_expressible_by n & k1.3 is_expressible_by n & k1.4 is_expressible_by n
& k2.1 = INV_MOD(k1.1,n) & k2.2 = NEG_MOD(k1.2,n) & k2.3 = NEG_MOD(k1.3,n) & k2
.4 = INV_MOD(k1.4,n) & k2.5 = k1.5 & k2.6 = k1.6 implies (IDEA_QE(k2,n)*IDEA_PE
  (k1,n)).m = m;

theorem 
  for n being non empty Element of NAT,lk being Element of NAT,
Key being Matrix of lk,6,NAT, k being Element of NAT holds IDEA_P_F(Key,n,(k+1)
  ) = IDEA_P_F(Key,n,k)^<* IDEA_P(Line(Key,(k+1)),n) *>;

theorem 
  for n being non empty Element of NAT,lk being Element of NAT,
Key being Matrix of lk,6,NAT, k being Element of NAT holds IDEA_Q_F(Key,n,(k+1)
  ) = <* IDEA_Q(Line(Key,k+1),n) *>^IDEA_Q_F(Key,n,k);

theorem 
  for n being non empty Element of NAT,lk being Element of NAT,
Key being Matrix of lk,6,NAT, k being Element of NAT holds IDEA_P_F(Key,n,k) is
  FuncSeq-like FinSequence;

theorem 
  for n being non empty Element of NAT,lk being Element of NAT,
Key being Matrix of lk,6,NAT, k being Element of NAT holds IDEA_Q_F(Key,n,k) is
  FuncSeq-like FinSequence;

theorem 
  for n being non empty Element of NAT,lk being Element of NAT,
  Key being Matrix of lk,6,NAT, k being Element of NAT holds k <> 0 implies
  IDEA_P_F(Key,n,k) is FuncSequence of MESSAGES,MESSAGES;

theorem 
  for n being non empty Element of NAT,lk being Element of NAT,
  Key being Matrix of lk,6,NAT, k being Element of NAT holds k <> 0 implies
  IDEA_Q_F(Key,n,k) is FuncSequence of MESSAGES,MESSAGES;

theorem 
  for n being non empty Element of NAT,M being FinSequence of NAT,
m,k st M = IDEA_P(k,n).m & len m >= 4 holds len M >= 4 & M.1 is_expressible_by
n & M.2 is_expressible_by n & M.3 is_expressible_by n & M.4 is_expressible_by n
;

theorem 
  for n being non empty Element of NAT,lk being Element of NAT,
Key being Matrix of lk,6,NAT, r being Element of NAT holds rng compose(IDEA_P_F
  (Key,n,r),MESSAGES) c=MESSAGES & dom compose(IDEA_P_F(Key,n,r),MESSAGES) =
  MESSAGES;

theorem 
  for n being non empty Element of NAT,lk being Element of NAT, Key
being Matrix of lk,6,NAT, r being Element of NAT holds rng compose(IDEA_Q_F(Key
,n,r),MESSAGES) c=MESSAGES & dom compose(IDEA_Q_F(Key,n,r),MESSAGES) =MESSAGES;

theorem 
  for n being non empty Element of NAT,lk being Element of NAT,
Key being Matrix of lk,6,NAT, r being Element of NAT,M being FinSequence of NAT
  ,m st M = compose(IDEA_P_F(Key,n,r),MESSAGES).m & len m >= 4 & m.1
  is_expressible_by n & m.2 is_expressible_by n & m.3 is_expressible_by n & m.4
  is_expressible_by n holds len M >= 4 & M.1 is_expressible_by n & M.2
  is_expressible_by n & M.3 is_expressible_by n & M.4 is_expressible_by n;

begin 







theorem 
  for n being non empty Element of NAT,lk being Element of NAT,
  Key1,Key2 being Matrix of lk,6,NAT, r being Element of NAT,m st lk >= r & 2
  to_power(n)+1 is prime & len m >= 4 & m.1 is_expressible_by n & m.2
is_expressible_by n & m.3 is_expressible_by n & m.4 is_expressible_by n & (for
  i being Element of NAT holds i <= r implies Key1*(i,1) is_expressible_by n &
  Key1*(i,2) is_expressible_by n & Key1*(i,3) is_expressible_by n & Key1*(i,4)
  is_expressible_by n & Key1*(i,5) is_expressible_by n & Key1*(i,6)
  is_expressible_by n & Key2*(i,1) is_expressible_by n & Key2*(i,2)
  is_expressible_by n & Key2*(i,3) is_expressible_by n & Key2*(i,4)
  is_expressible_by n & Key2*(i,5) is_expressible_by n & Key2*(i,6)
  is_expressible_by n & Key2*(i,1)=INV_MOD(Key1*(i,1),n) & Key2*(i,2)=NEG_MOD(
Key1* (i,3),n) & Key2*(i,3)=NEG_MOD(Key1*(i,2),n) & Key2*(i,4)=INV_MOD(Key1* (i
,4),n) & Key1*(i,5)=Key2*(i,5) & Key1*(i,6)=Key2*(i,6)) holds compose(IDEA_P_F(
  Key1,n,r)^IDEA_Q_F(Key2,n,r),MESSAGES).m = m;

theorem 
  for n being non empty Element of NAT,lk being Element of NAT, Key1,
  Key2 being Matrix of lk,6,NAT, r being Element of NAT,ks1,ks2,ke1,ke2 being
  FinSequence of NAT,m st lk >= r & 2 to_power(n)+1 is prime & len m >= 4 & m.1
  is_expressible_by n & m.2 is_expressible_by n & m.3 is_expressible_by n & m.4
is_expressible_by n & (for i being Element of NAT holds i <= r implies Key1*(i,
  1) is_expressible_by n & Key1*(i,2) is_expressible_by n & Key1*(i,3)
  is_expressible_by n & Key1*(i,4) is_expressible_by n & Key1*(i,5)
  is_expressible_by n & Key1*(i,6) is_expressible_by n & Key2*(i,1)
  is_expressible_by n & Key2*(i,2) is_expressible_by n & Key2*(i,3)
  is_expressible_by n & Key2*(i,4) is_expressible_by n & Key2*(i,5)
is_expressible_by n & Key2*(i,6) is_expressible_by n & Key2*(i,1)=INV_MOD(Key1*
(i,1),n) & Key2*(i,2)=NEG_MOD(Key1* (i,3),n) & Key2*(i,3)=NEG_MOD(Key1*(i,2),n)
& Key2*(i,4)=INV_MOD(Key1* (i,4),n) & Key1*(i,5)=Key2*(i,5) & Key1*(i,6)=Key2*(
  i,6))& ks1.1 is_expressible_by n & ks1.2 is_expressible_by n & ks1.3
  is_expressible_by n & ks1.4 is_expressible_by n & ks2.1 = INV_MOD(ks1.1,n) &
ks2.2 = NEG_MOD(ks1.2,n) & ks2.3 = NEG_MOD(ks1.3,n) & ks2.4 = INV_MOD(ks1.4,n)
  & ke1.1 is_expressible_by n & ke1.2 is_expressible_by n & ke1.3
  is_expressible_by n & ke1.4 is_expressible_by n & ke2.1 = INV_MOD(ke1.1,n) &
ke2.2 = NEG_MOD(ke1.2,n) & ke2.3 = NEG_MOD(ke1.3,n) & ke2.4 = INV_MOD(ke1.4,n)
& ke2.5 = ke1.5 & ke2.6 = ke1.6 holds (IDEA_QS(ks2,n)*(compose(IDEA_Q_F(Key2,n,
  r),MESSAGES)* (IDEA_QE(ke2,n)*(IDEA_PE(ke1,n)*(compose(IDEA_P_F(Key1,n,r),
  MESSAGES)* IDEA_PS(ks1,n)))))).m = m;















begin



reserve a for set,
  i for Nat;

theorem 
  (*-->a).0 = {};

theorem 
  (*-->a).1 = <*a*>;

theorem 
  (*-->a).2 = <*a,a*>;

theorem 
  (*-->a).3 = <*a,a,a*>;

theorem 
  for f being FinSequence of {0} holds f = i |-> 0 iff len f = i;

theorem 
  for f be FinSequence st f = (*-->0).i holds len f = i;

begin

theorem 
  for U1,U2 being Universal_Algebra st U1 is SubAlgebra of U2 holds
  MSSign U1 = MSSign U2;

theorem 
  for U1,U2 being Universal_Algebra st U1 is SubAlgebra of U2 for B
being MSSubset of MSAlg U2 st B = the Sorts of MSAlg U1 for o being OperSymbol
of MSSign U2 for a being OperSymbol of MSSign U1 st a = o holds Den(a,MSAlg U1)
  = Den(o,MSAlg U2)|Args(a,MSAlg U1);

theorem 
  for U1,U2 being Universal_Algebra st U1 is SubAlgebra of U2 holds
  the Sorts of MSAlg U1 is MSSubset of MSAlg U2;

theorem 
  for U1,U2 being Universal_Algebra st U1 is SubAlgebra of U2 for
  B being MSSubset of MSAlg U2 st B = the Sorts of MSAlg U1 holds B is
  opers_closed;

theorem 
  for U1,U2 being Universal_Algebra st U1 is SubAlgebra of U2 for
B being MSSubset of MSAlg U2 st B = the Sorts of MSAlg U1 holds the Charact of
  MSAlg U1 = Opers(MSAlg U2,B);

theorem 
  for U1,U2 being Universal_Algebra st U1 is SubAlgebra of U2
  holds MSAlg U1 is MSSubAlgebra of MSAlg U2;

theorem 
  for U1,U2 being Universal_Algebra st MSAlg U1 is MSSubAlgebra of
  MSAlg U2 holds the carrier of U1 is Subset of U2;

theorem 
  for U1,U2 being Universal_Algebra st MSAlg U1 is MSSubAlgebra of
  MSAlg U2 for B being non empty Subset of U2 st B=the carrier of U1 holds B is
  opers_closed;

theorem 
  for U1,U2 being Universal_Algebra st MSAlg U1 is MSSubAlgebra of
  MSAlg U2 for B being non empty Subset of U2 st B=the carrier of U1 holds the
  charact of U1 = Opers(U2,B);

theorem 
  for U1,U2 being Universal_Algebra st MSAlg U1 is MSSubAlgebra of
  MSAlg U2 holds U1 is SubAlgebra of U2;

reserve MS for segmental non void 1-element ManySortedSign,
  A for non-empty MSAlgebra over MS;

theorem 
  for B being non-empty MSSubAlgebra of A holds the carrier of
  1-Alg B is Subset of 1-Alg A;

theorem 
  for B being non-empty MSSubAlgebra of A holds for S being non
  empty Subset of 1-Alg A st S = the carrier of 1-Alg B holds S is opers_closed
;

theorem 
  for B being non-empty MSSubAlgebra of A holds for S being non
  empty Subset of 1-Alg A st S = the carrier of 1-Alg B holds the charact of(
  1-Alg B) = Opers(1-Alg A,S);

theorem 
  for B being non-empty MSSubAlgebra of A holds 1-Alg B is
  SubAlgebra of 1-Alg A;

theorem 
  for S being non empty non void ManySortedSign, A,B being
  MSAlgebra over S holds A is MSSubAlgebra of B iff A is MSSubAlgebra of the
  MSAlgebra of B;

theorem 
  for A,B being Universal_Algebra holds signature A = signature B iff
  MSSign A = MSSign B;

theorem 
  for A being non-empty MSAlgebra over MS st the carrier of MS = {
  0} holds MSSign 1-Alg A = the ManySortedSign of MS;

theorem 
  for A,B being non-empty MSAlgebra over MS st 1-Alg A = 1-Alg B
  holds the MSAlgebra of A = the MSAlgebra of B;

theorem 
  for A being non-empty MSAlgebra over MS st the carrier of MS = {0}
  holds the Sorts of A = the Sorts of MSAlg (1-Alg A);

theorem 
  for A being non-empty MSAlgebra over MS st the carrier of MS = {
  0} holds MSAlg (1-Alg A) = the MSAlgebra of A;

theorem 
  for A being Universal_Algebra, B being strict non-empty MSSubAlgebra
  of MSAlg A st the carrier of MSSign A = {0} holds 1-Alg B is SubAlgebra of A;

begin




theorem 
  for A being Universal_Algebra, a1,b1 being strict SubAlgebra of
A, a2,b2 being strict non-empty MSSubAlgebra of MSAlg A st a2 = MSAlg a1 & b2 =
MSAlg b1 holds (the Sorts of a2) \/ (the Sorts of b2) = 0 .--> ((the carrier of
  a1) \/ (the carrier of b1));

theorem 
  for A being Universal_Algebra, a1,b1 being strict non-empty
  SubAlgebra of A, a2,b2 being strict non-empty MSSubAlgebra of MSAlg A st a2 =
MSAlg a1 & b2 = MSAlg b1 holds (the Sorts of a2) /\ (the Sorts of b2) = 0 .-->
  ((the carrier of a1) /\ (the carrier of b1));

theorem 
  for A being strict Universal_Algebra, a1,b1 be strict non-empty
  SubAlgebra of A, a2,b2 being strict non-empty MSSubAlgebra of MSAlg A st a2 =
  MSAlg a1 & b2 = MSAlg b1 holds MSAlg (a1 "\/" b1) = a2 "\/" b2;

registration
  let A be with_const_op Universal_Algebra;
  cluster MSSign(A) -> non void strict segmental trivial all-with_const_op;
end;

theorem 
  for A being with_const_op Universal_Algebra, a1,b1 being strict
non-empty SubAlgebra of A, a2,b2 being strict non-empty MSSubAlgebra of MSAlg A
  st a2 = MSAlg a1 & b2 = MSAlg b1 holds MSAlg (a1 /\ b1) = a2 /\ b2;

registration
  let A be quasi_total UAStr;
  cluster the UAStr of A -> quasi_total;
end;

registration
  let A be partial UAStr;
  cluster the UAStr of A -> partial;
end;

registration
  let A be non-empty UAStr;
  cluster the UAStr of A -> non-empty;
end;

registration
  let A be with_const_op Universal_Algebra;
  cluster the UAStr of A -> with_const_op;
end;

theorem 
  for A being with_const_op Universal_Algebra holds UnSubAlLattice the
  UAStr of A, MSSubAlLattice MSAlg the UAStr of A are_isomorphic;














begin

definition
  let C be 2-sorted;

  attr C is quasi-empty means


  the carrier of C is empty or the carrier' of C is empty;
end;

registration
  cluster strict non empty non void for 2-sorted;
  cluster strict non quasi-empty for 2-sorted;
end;

registration
  cluster strict empty void quasi-empty for 2-sorted;
end;

definition
  struct (2-sorted) ContextStr (# carrier, carrier' -> set, Information ->
    Relation of the carrier,the carrier' #);
end;

registration
  cluster strict non empty for ContextStr;
  cluster strict non quasi-empty for ContextStr;
end;

definition
  mode FormalContext is non quasi-empty ContextStr;
end;

definition
  let C be 2-sorted;
  mode Object of C is Element of C;
  mode Attribute of C is Element of the carrier' of C;
end;

registration
  let C be non quasi-empty 2-sorted;
  cluster the carrier' of C -> non empty;
  cluster the carrier of C -> non empty;
end;

registration
  let C be non quasi-empty 2-sorted;
  cluster non empty for Subset of the carrier of C;
  cluster non empty for Subset of the carrier' of C;
end;

definition
  let C be FormalContext;
  let o be Object of C;
  let a be Attribute of C;

  pred o is-connected-with a means


  [o,a] in the Information of C;
end;

notation
  let C be FormalContext;
  let o be Object of C;
  let a be Attribute of C;
  antonym o is-not-connected-with a for o is-connected-with a;
end;



begin

definition
  let C be FormalContext;
  func ObjectDerivation(C) -> Function of bool the carrier of C,bool the
  carrier' of C means


  for O being Subset of the carrier of C holds it.O =
  { a where a is Attribute of C : for o being Object of C st o in O holds o
  is-connected-with a };
end;

definition
  let C be FormalContext;
  func AttributeDerivation(C) -> Function of bool the carrier' of C,bool the
  carrier of C means


  for A being Subset of the carrier' of C holds it.A =
  { o where o is Object of C : for a being Attribute of C st a in A holds o
  is-connected-with a };
end;

theorem 
  for C being FormalContext for o being Object of C holds (
ObjectDerivation(C)).({o}) = {a where a is Attribute of C : o is-connected-with
  a};

theorem 
  for C being FormalContext for a being Attribute of C holds (
AttributeDerivation(C)).({a}) = {o where o is Object of C : o is-connected-with
  a};

theorem 
  for C being FormalContext for O1,O2 being Subset of the carrier
of C holds O1 c= O2 implies (ObjectDerivation(C)).O2 c= (ObjectDerivation(C)).
  O1;

theorem 
  for C being FormalContext for A1,A2 being Subset of the carrier'
of C holds A1 c= A2 implies (AttributeDerivation(C)).A2 c= (AttributeDerivation
  (C)).A1;

theorem 
  for C being FormalContext for O being Subset of the carrier of C
  holds O c= (AttributeDerivation(C)).((ObjectDerivation(C)).O);

theorem 
  for C being FormalContext for A being Subset of the carrier' of C
  holds A c= (ObjectDerivation(C)).((AttributeDerivation(C)).A);

theorem 
  for C being FormalContext for O being Subset of the carrier of C
holds (ObjectDerivation(C)).O = (ObjectDerivation(C)).((AttributeDerivation(C))
  .((ObjectDerivation(C)).O));

theorem 
  for C being FormalContext for A being Subset of the carrier' of C
holds (AttributeDerivation(C)).A = (AttributeDerivation(C)).((ObjectDerivation(
  C)).((AttributeDerivation(C)).A));

theorem 
  for C being FormalContext for O being Subset of the carrier of C
  for A being Subset of the carrier' of C holds O c= (AttributeDerivation(C)).A
  iff [:O,A:] c= the Information of C;

theorem 
  for C being FormalContext for O being Subset of the carrier of C
for A being Subset of the carrier' of C holds A c= (ObjectDerivation(C)).O iff
  [:O,A:] c= the Information of C;

theorem 
  for C being FormalContext for O being Subset of the carrier of C for A
  being Subset of the carrier' of C holds O c= (AttributeDerivation(C)).A iff A
  c= (ObjectDerivation(C)).O;

definition
  let C be FormalContext;
  func phi(C) -> Function of BoolePoset the carrier of C, BoolePoset the
  carrier' of C equals

  ObjectDerivation(C);
end;

definition
  let C be FormalContext;
  func psi(C) -> Function of BoolePoset the carrier' of C, BoolePoset the
  carrier of C equals

  AttributeDerivation(C);
end;

definition
  let P,R be non empty RelStr;
  let Con be Connection of P,R;
  attr Con is co-Galois means


  ex f being Function of P,R, g being
  Function of R,P st (Con = [f,g] & f is antitone & g is antitone & for p1,p2
being Element of P, r1,r2 being Element of R holds p1 <= g.(f.p1) & r1 <= f.(g.
  r1));
end;

theorem 
  for P,R being non empty Poset for Con being Connection of P,R
  for f being Function of P,R, g being Function of R,P st Con = [f,g] holds Con
is co-Galois iff for p being Element of P, r being Element of R holds p <= g.r
  iff r <= f.p;

theorem 
  for P,R being non empty Poset for Con being Connection of P,R st Con
is co-Galois for f being Function of P,R, g being Function of R,P st Con = [f,g
  ] holds f = f * (g * f) & g = g * (f * g);

theorem 
  for C being FormalContext holds [phi(C),psi(C)] is co-Galois;

theorem 
  for C being FormalContext for O1,O2 being Subset of the carrier
of C holds (ObjectDerivation(C)).(O1 \/ O2) = ((ObjectDerivation(C)).O1) /\ ((
  ObjectDerivation(C)).O2);

theorem 
  for C being FormalContext for A1,A2 being Subset of the carrier'
of C holds (AttributeDerivation(C)).(A1 \/ A2) = ((AttributeDerivation(C)).A1)
  /\ ((AttributeDerivation(C)).A2);

theorem 
  for C being FormalContext holds (ObjectDerivation(C)).{} = the carrier' of C;

theorem 
  for C being FormalContext holds (AttributeDerivation(C)).{} =
  the carrier of C;

begin 

definition
  let C be 2-sorted;
  struct ConceptStr over C (# Extent -> Subset of the carrier of C, Intent ->
    Subset of the carrier' of C #);
end;

definition
  let C be 2-sorted;
  let CP be ConceptStr over C;
  attr CP is empty means


  the Extent of CP is empty & the Intent of CP is empty;
  attr CP is quasi-empty means


  the Extent of CP is empty or the Intent of CP is empty;
end;

registration
  let C be non quasi-empty 2-sorted;
  cluster strict non empty for ConceptStr over C;
  cluster strict quasi-empty for ConceptStr over C;
end;

registration
  let C be empty void 2-sorted;
  cluster -> empty for ConceptStr over C;
end;

registration
  let C be quasi-empty 2-sorted;
  cluster -> quasi-empty for ConceptStr over C;
end;

definition
  let C be FormalContext;
  let CP be ConceptStr over C;
  attr CP is concept-like means


  (ObjectDerivation(C)).(the Extent of
  CP) = the Intent of CP & (AttributeDerivation(C)).(the Intent of CP) = the
  Extent of CP;
end;

registration
  let C be FormalContext;
  cluster concept-like non empty for ConceptStr over C;
end;

definition
  let C be FormalContext;
  mode FormalConcept of C is concept-like non empty ConceptStr over C;
end;

registration
  let C be FormalContext;
  cluster strict for FormalConcept of C;
end;

theorem 
  for C being FormalContext for O being Subset of the carrier of C
  holds ConceptStr(#(AttributeDerivation(C)).((ObjectDerivation(C)).O), (
    ObjectDerivation(C)).O#) is FormalConcept of C & for O9 being Subset of the
  carrier of C, A9 being Subset of the carrier' of C st ConceptStr(#O9,A9#) is
FormalConcept of C & O c= O9 holds (AttributeDerivation(C)).((ObjectDerivation(
  C)).O) c= O9;

theorem 
  for C being FormalContext for O being Subset of the carrier of C holds
  (ex A being Subset of the carrier' of C st ConceptStr(#O,A#) is FormalConcept
  of C) iff (AttributeDerivation(C)).((ObjectDerivation(C)).O) = O;

theorem 
  for C being FormalContext for A being Subset of the carrier' of
  C holds ConceptStr(#(AttributeDerivation(C)).A, (ObjectDerivation(C)).((
AttributeDerivation(C)).A)#) is FormalConcept of C & for O9 being Subset of the
  carrier of C, A9 being Subset of the carrier' of C st ConceptStr(#O9,A9#) is
FormalConcept of C & A c= A9 holds (ObjectDerivation(C)).((AttributeDerivation(
  C)).A) c= A9;

theorem 
  for C being FormalContext for A being Subset of the carrier' of C
  holds (ex O being Subset of the carrier of C st ConceptStr(#O,A#) is
FormalConcept of C) iff (ObjectDerivation(C)).((AttributeDerivation(C)).A) = A;

definition
  let C be FormalContext;
  let CP be ConceptStr over C;
  attr CP is universal means


  the Extent of CP = the carrier of C;
end;

definition
  let C be FormalContext;
  let CP be ConceptStr over C;
  attr CP is co-universal means


  the Intent of CP = the carrier' of C;
end;

registration
  let C be FormalContext;
  cluster strict universal for FormalConcept of C;
  cluster strict co-universal for FormalConcept of C;
end;

definition
  let C be FormalContext;
  func Concept-with-all-Objects(C) -> strict universal FormalConcept of C
  means


  ex O being Subset of the carrier of C, A being Subset of the
carrier' of C st it = ConceptStr(#O,A#) & O = (AttributeDerivation(C)).({}) & A
  = (ObjectDerivation(C)).((AttributeDerivation(C)).({}));
end;

definition
  let C be FormalContext;
  func Concept-with-all-Attributes(C) -> strict co-universal FormalConcept of
  C means


  ex O being Subset of the carrier of C, A being Subset of the
  carrier' of C st it = ConceptStr(#O,A#) & O = (AttributeDerivation(C)).((
  ObjectDerivation(C)).({})) & A = (ObjectDerivation(C)).({});
end;

theorem 
  for C being FormalContext holds the Extent of
  Concept-with-all-Objects(C) = the carrier of C & the Intent of
  Concept-with-all-Attributes(C) = the carrier' of C;

theorem 
  for C being FormalContext for CP being FormalConcept of C holds (the
Extent of CP = {} implies CP is co-universal) & (the Intent of CP = {} implies
  CP is universal);

theorem 
  for C being FormalContext for CP being strict FormalConcept of C
  holds (the Extent of CP = {} implies CP = Concept-with-all-Attributes(C)) & (
  the Intent of CP = {} implies CP = Concept-with-all-Objects(C));

theorem 
  for C being FormalContext for CP being quasi-empty ConceptStr over C
  st CP is FormalConcept of C holds CP is universal or CP is co-universal;

theorem 
  for C being FormalContext for CP being quasi-empty ConceptStr over C
st CP is strict FormalConcept of C holds CP = Concept-with-all-Objects(C) or CP
  = Concept-with-all-Attributes(C);

definition
  let C be FormalContext;
  mode Set-of-FormalConcepts of C -> non empty set means


    for X being set st X in it holds X is FormalConcept of C;
end;

definition
  let C be FormalContext;
  let FCS be Set-of-FormalConcepts of C;
  redefine mode Element of FCS -> FormalConcept of C;
end;

definition
  let C be FormalContext;
  let CP1,CP2 be FormalConcept of C;
  pred CP1 is-SubConcept-of CP2 means


  the Extent of CP1 c= the Extent of CP2;
end;

notation
  let C be FormalContext;
  let CP1,CP2 be FormalConcept of C;
  synonym CP2 is-SuperConcept-of CP1 for CP1 is-SubConcept-of CP2;
end;

theorem 
  for C being FormalContext for CP1,CP2 being FormalConcept of C
  holds CP1 is-SubConcept-of CP2 iff the Intent of CP2 c= the Intent of CP1;

theorem 
  for C being FormalContext for CP1,CP2 being FormalConcept of C holds
CP1 is-SuperConcept-of CP2 iff the Intent of CP1 c= the Intent of CP2;

theorem 
  for C being FormalContext for CP being FormalConcept of C holds CP
  is-SubConcept-of Concept-with-all-Objects(C) & Concept-with-all-Attributes(C)
  is-SubConcept-of CP;

begin 

definition
  let C be FormalContext;
  func B-carrier(C) -> non empty set equals

  { ConceptStr(#E,I#) where E is
Subset of the carrier of C, I is Subset of the carrier' of C : ConceptStr(#E,I
#) is non empty & (ObjectDerivation(C)).E = I & (AttributeDerivation(C)).I = E
  };
end;

definition
  let C be FormalContext;
  redefine func B-carrier(C) -> Set-of-FormalConcepts of C;
end;

registration
  let C be FormalContext;
  cluster B-carrier(C) -> non empty;
end;

theorem 
  for C being FormalContext for CP being set holds CP in B-carrier
  (C) iff CP is strict FormalConcept of C;

definition
  let C be FormalContext;
  func B-meet(C) -> BinOp of B-carrier(C) means


  for CP1,CP2 being
strict FormalConcept of C holds ex O being Subset of the carrier of C, A being
  Subset of the carrier' of C st it.(CP1,CP2) = ConceptStr(#O,A#) & O = (the
  Extent of CP1) /\ (the Extent of CP2) & A = (ObjectDerivation(C)).((
  AttributeDerivation(C)). ((the Intent of CP1) \/ (the Intent of CP2)));
end;

definition
  let C be FormalContext;
  func B-join(C) -> BinOp of B-carrier(C) means


  for CP1,CP2 being
strict FormalConcept of C holds ex O being Subset of the carrier of C, A being
  Subset of the carrier' of C st it.(CP1,CP2) = ConceptStr(#O,A#) & O = (
  AttributeDerivation(C)).((ObjectDerivation(C)). ((the Extent of CP1) \/ (the
  Extent of CP2))) & A = (the Intent of CP1) /\ (the Intent of CP2);
end;

theorem 
  for C being FormalContext for CP1,CP2 being strict FormalConcept
  of C holds (B-meet(C)).(CP1,CP2) = (B-meet(C)).(CP2,CP1);

theorem 
  for C being FormalContext for CP1,CP2 being strict FormalConcept
  of C holds (B-join(C)).(CP1,CP2) = (B-join(C)).(CP2,CP1);

theorem 
  for C being FormalContext for CP1,CP2,CP3 being strict
FormalConcept of C holds (B-meet(C)).(CP1,(B-meet(C)).(CP2,CP3)) = (B-meet(C)).
  ((B-meet(C)).(CP1,CP2),CP3);

theorem 
  for C being FormalContext for CP1,CP2,CP3 being strict
FormalConcept of C holds (B-join(C)).(CP1,(B-join(C)).(CP2,CP3)) = (B-join(C)).
  ((B-join(C)).(CP1,CP2),CP3);

theorem 
  for C being FormalContext for CP1,CP2 being strict FormalConcept
  of C holds (B-join(C)).((B-meet(C)).(CP1,CP2),CP2) = CP2;

theorem 
  for C being FormalContext for CP1,CP2 being strict FormalConcept
  of C holds (B-meet(C)).(CP1,(B-join(C)).(CP1,CP2)) = CP1;

theorem 
  for C being FormalContext for CP being strict FormalConcept of C holds
  (B-meet(C)).(CP,Concept-with-all-Objects(C)) = CP;

theorem 
  for C being FormalContext for CP being strict FormalConcept of C
holds (B-join(C)).(CP,Concept-with-all-Objects(C)) = Concept-with-all-Objects(C
  );

theorem 
  for C being FormalContext for CP being strict FormalConcept of C holds
  (B-join(C)).(CP,Concept-with-all-Attributes(C)) = CP;

theorem 
  for C being FormalContext for CP being strict FormalConcept of C holds
(B-meet(C)).(CP,Concept-with-all-Attributes(C)) = Concept-with-all-Attributes(C
  );

definition
  let C be FormalContext;
  func ConceptLattice(C) -> strict non empty LattStr equals

  LattStr(#B-carrier
    (C),B-join(C),B-meet(C)#);
end;

theorem 
  for C being FormalContext holds ConceptLattice(C) is Lattice;

registration
  let C be FormalContext;
  cluster ConceptLattice(C) -> strict non empty Lattice-like;
end;

definition
  let C be FormalContext;
  let S be non empty Subset of ConceptLattice(C);
  redefine mode Element of S -> FormalConcept of C;
end;

definition
  let C be FormalContext;
  let CP be Element of ConceptLattice(C);
  func CP@ -> strict FormalConcept of C equals

  CP;
end;

theorem 
  for C being FormalContext for CP1,CP2 being Element of
  ConceptLattice(C) holds CP1 [= CP2 iff CP1@ is-SubConcept-of CP2@;

theorem 
  for C being FormalContext holds ConceptLattice(C) is complete Lattice;

registration
  let C be FormalContext;
  cluster ConceptLattice(C) -> complete;
end;














begin 

reserve A,X for non empty set;
reserve f for PartFunc of [:X,X:],REAL;
reserve a for real number;

registration
  cluster non negative for real number;
end;

theorem 
  for p being FinSequence, k being Nat st k+1 in dom p & not k in
  dom p holds k = 0;

theorem 
  for p being FinSequence, i,j being Nat st i in dom p & j in dom p
& for k be Nat st k in dom p & k + 1 in dom p holds p.k = p.(k + 1) holds p.i =
  p.j;

theorem 
  for X being set, R being Relation of X st R is_reflexive_in X holds dom R = X
;

theorem 
  for X being set, R being Relation of X st R is_reflexive_in X holds rng R = X
;

theorem 
  for X being set, R being Relation of X st R is_reflexive_in X
  holds R[*] is_reflexive_in X;

theorem 
  for X,x,y be set for R be Relation of X st R is_reflexive_in X
  holds R reduces x,y & x in X implies [x,y] in R[*];

theorem 
  for X being set, R being Relation of X st R is_symmetric_in X
  holds R[*] is_symmetric_in X;

theorem 
  for X being set, R being Relation of X st R is_reflexive_in X
  holds R[*] is_transitive_in X;

theorem 
  for X being non empty set, R being Relation of X st R
is_reflexive_in X & R is_symmetric_in X holds R[*] is Equivalence_Relation of X
;

theorem 
  for R1,R2 being Relation of X holds R1 c= R2 implies R1[*] c= R2 [*];

theorem 
  SmallestPartition A is_finer_than {A};

begin 

definition
  let A be non empty set;
  mode Classification of A -> Subset of PARTITIONS(A) means


    for X,Y
    being a_partition of A st X in it & Y in it holds X is_finer_than Y or Y
    is_finer_than X;
end;

theorem 
  {{A}} is Classification of A;

theorem 
  {SmallestPartition A} is Classification of A;

theorem 
  for S being Subset of PARTITIONS(A) st S = {{A},
  SmallestPartition A} holds S is Classification of A;

definition
  let A be non empty set;
  mode Strong_Classification of A -> Subset of PARTITIONS(A) means


    it is Classification of A & {A} in it & SmallestPartition A in it;
end;

theorem 
  for S being Subset of PARTITIONS(A) st S = {{A},SmallestPartition A}
  holds S is Strong_Classification of A;

begin 

definition
  let X be non empty set, f be PartFunc of [:X,X:], REAL, a be real number;
  func low_toler(f,a) -> Relation of X means


  for x,y being Element of X holds [x,y] in it iff f.(x,y) <= a;
end;

theorem 
  f is Reflexive & a >= 0 implies low_toler(f,a) is_reflexive_in X;

theorem 
  f is symmetric implies low_toler(f,a) is_symmetric_in X;

theorem 
  a >= 0 & f is Reflexive symmetric implies low_toler(f,a) is Tolerance of X;

theorem 
  for X being non empty set, f being PartFunc of [:X,X:], REAL, a1
  ,a2 being real number st a1 <= a2 holds low_toler(f,a1) c= low_toler(f,a2);

definition
  let X be set;
  let f be PartFunc of [:X,X:], REAL;
  attr f is nonnegative means


  for x,y being Element of X holds f.(x,y) >= 0;
end;

theorem 
  for X being non empty set, f being PartFunc of [:X,X:],REAL, x,y
being set st f is nonnegative Reflexive discerning holds [x,y] in low_toler(f,0
  ) implies x = y;

theorem 
  for X being non empty set, f being PartFunc of [:X,X:],REAL, x
  being Element of X st f is Reflexive discerning holds [x,x] in low_toler(f,0)
;

theorem 
  for X being non empty set, f being PartFunc of [:X,X:],REAL, a
  being real number st low_toler(f,a) is_reflexive_in X & f is symmetric holds
  low_toler(f,a)[*] is Equivalence_Relation of X;

begin 

theorem 
  for X being non empty set, f being PartFunc of [:X,X:],REAL st f
  is nonnegative Reflexive discerning holds low_toler(f,0)[*] = low_toler(f,0);

theorem 
  for X being non empty set, f being PartFunc of [:X,X:],REAL, R
  being Equivalence_Relation of X st R = low_toler(f,0)[*] & f is nonnegative
  Reflexive discerning holds R = id X;

theorem 
  for X being non empty set, f being PartFunc of [:X,X:],REAL, R being
Equivalence_Relation of X st R = low_toler(f,0)[*] & f is nonnegative Reflexive
  discerning holds Class R = SmallestPartition X;

theorem 
  for X being finite non empty Subset of REAL, f being Function of
[:X,X:],REAL, z being finite non empty Subset of REAL, A being real number st z
  = rng f & A >= max z holds for x,y being Element of X holds f.(x,y) <= A;

theorem 
  for X being finite non empty Subset of REAL, f being Function of
[:X,X:],REAL, z being finite non empty Subset of REAL, A being real number st z
  = rng f & A >= max z holds for R being Equivalence_Relation of X st R =
  low_toler(f,A)[*] holds Class R = {X};

theorem 
  for X being finite non empty Subset of REAL, f being Function of [:X,X
  :],REAL, z being finite non empty Subset of REAL, A being real number st z =
  rng f & A >= max z holds low_toler(f,A)[*] = low_toler(f,A);

begin 

definition
  let X be non empty set, f being PartFunc of [:X,X:],REAL;
  func fam_class(f) -> Subset of PARTITIONS(X) means


  for x being set holds x in it iff ex a being non negative real number,R be
  Equivalence_Relation of X st R = low_toler(f,a)[*] & Class(R) = x;
end;

theorem 
  for X being non empty set, f being PartFunc of [:X,X:],REAL, a being
non negative real number st low_toler(f,a) is_reflexive_in X & f is symmetric
  holds fam_class(f) is non empty set;

theorem 
  for X being finite non empty Subset of REAL, f being Function of
  [:X,X:],REAL st f is symmetric nonnegative holds {X} in fam_class(f);

theorem 
  for X being non empty set, f being PartFunc of [:X,X:],REAL
  holds fam_class(f) is Classification of X;

theorem 
  for X being finite non empty Subset of REAL, f being Function of [:X,X
  :],REAL st (SmallestPartition X) in fam_class(f) & f is symmetric nonnegative
  holds fam_class(f) is Strong_Classification of X;

begin 

definition
  let M be MetrStruct, a be real number, x,y be Element of M;
  pred x,y are_in_tolerance_wrt a means


  dist(x,y) <= a;
end;

definition
  let M be non empty MetrStruct, a be real number;
  func dist_toler(M,a) -> Relation of M means


  for x,y being Element of M holds [x,y] in it iff x,y are_in_tolerance_wrt a;
end;

theorem 
  for M being non empty MetrStruct, a being real number holds
  dist_toler(M,a) = low_toler(the distance of M,a);

theorem 
  for M being non empty Reflexive symmetric MetrStruct, a being real
number, T being Relation of the carrier of M,the carrier of M st T = dist_toler
  (M,a) & a >= 0 holds T is Tolerance of the carrier of M;

definition
  let M be Reflexive symmetric non empty MetrStruct;
  func fam_class_metr(M) -> Subset of PARTITIONS(the carrier of M) means



  for x being set holds x in it iff ex a being non negative real number,R be
  Equivalence_Relation of M st R = dist_toler(M,a)[*] & Class(R) = x;
end;

theorem 
  for M being Reflexive symmetric non empty MetrStruct holds
  fam_class_metr(M) = fam_class(the distance of M);

theorem 
  for M being non empty MetrSpace for R being Equivalence_Relation
of M st R = dist_toler(M,0)[*] holds Class R = SmallestPartition the carrier of
  M;

theorem 
  for M being Reflexive symmetric bounded non empty MetrStruct
  st a >= diameter [#]M holds dist_toler(M,a) = nabla the carrier of M;

theorem 
  for M being Reflexive symmetric bounded non empty MetrStruct
  st a >= diameter [#]M holds dist_toler(M,a) = dist_toler(M,a)[*];

theorem 
  for M being Reflexive symmetric bounded non empty MetrStruct
  st a >= diameter [#]M holds dist_toler(M,a)[*] = nabla the carrier of M;

theorem 
  for M being Reflexive symmetric bounded non empty MetrStruct,
  R being Equivalence_Relation of M, a being non negative real number st a >=
  diameter [#]M & R = dist_toler(M,a)[*] holds Class R = {the carrier of M};

registration
  let M be Reflexive symmetric triangle non empty MetrStruct, C be non empty
  bounded Subset of M;
  cluster diameter C -> non negative;
end;

theorem 
  for M being bounded non empty MetrSpace holds {the carrier of
  M} in fam_class_metr(M);

theorem 
  for M being Reflexive symmetric non empty MetrStruct holds
  fam_class_metr(M) is Classification of the carrier of M;

theorem 
  for M being bounded non empty MetrSpace holds fam_class_metr(M) is
  Strong_Classification of the carrier of M;














begin

reserve A for RelStr;
reserve X for non empty set;
reserve PX,PY,PZ,Y,a,b,c,x,y for set;
reserve S1,S2 for Subset of Y;

definition
  let A;
  attr A is with_superior means

  ex x be Element of A st x is_superior_of the InternalRel of A;
end;

definition
  let A;
  attr A is with_comparable_down means


  for x,y be Element of A holds (
  ex z be Element of A st z <= x & z <= y) implies (x <= y or y <= x);
end;

theorem 
  for a being set holds InclPoset {{a}} is non empty reflexive
  transitive antisymmetric with_superior with_comparable_down;

registration
  cluster non empty reflexive transitive antisymmetric with_superior
    with_comparable_down strict for RelStr;
end;

definition
  mode Tree is with_superior with_comparable_down Poset;
end;

theorem 
  for EqR being Equivalence_Relation of X, x,y,z be set holds z in
  Class(EqR,x) & z in Class(EqR,y) implies Class(EqR,x) = Class(EqR,y);

canceled;

theorem 
  for C,x be set st C is Classification of X & x in union C holds x c= X;

theorem 
  for C being set st C is Strong_Classification of X holds InclPoset
  union C is Tree;

begin

definition
  let Y;
  attr Y is hierarchic means


  for x,y be set st x in Y & y in Y holds (x c= y or y c= x or x misses y);
end;

registration
  cluster trivial -> hierarchic for set;
end;

registration
  cluster non trivial hierarchic for set;
end;

theorem 
  {} is hierarchic;

theorem 
  {{}} is hierarchic;

definition
  let Y;
  mode Hierarchy of Y -> Subset-Family of Y means


    it is hierarchic;
end;

definition
  let Y;
  attr Y is mutually-disjoint means


  for x,y be set st x in Y & y in Y & x <> y holds x misses y;
end;

registration
  let Y;
  cluster mutually-disjoint for Subset-Family of Y;
end;

theorem 
  {} is mutually-disjoint;

theorem 
  {{}} is mutually-disjoint;

theorem 
  {a} is mutually-disjoint;

definition
  let Y;
  let F be Subset-Family of Y;
  attr F is T_3 means


  for A be Subset of Y st A in F for x be Element
  of Y st not x in A ex B be Subset of Y st x in B & B in F & A misses B;
end;

theorem 
  for F be Subset-Family of Y st F = {} holds F is T_3;

registration
  let Y;
  cluster covering T_3 for Hierarchy of Y;
end;

definition
  let Y;
  let F be Subset-Family of Y;
  attr F is lower-bounded means


  for B being set st B <> {} & B c= F & B
  is c=-linear ex c st c in F & c c= meet B;
end;

theorem 
  for B being mutually-disjoint Subset-Family of Y st for b be set
  st b in B holds S1 misses b & Y <> {} holds B \/ {S1} is mutually-disjoint
  Subset-Family of Y & (S1 <> {} implies union (B \/ {S1}) <> union B);

definition
  let Y;
  let F be Subset-Family of Y;
  attr F is with_max's means


  for S being Subset of Y st S in F ex T
being Subset of Y st S c= T & T in F & for V being Subset of Y st T c= V & V in
  F holds V = Y;
end;

begin

theorem 
  for H being covering Hierarchy of Y st H is with_max's ex P being
  a_partition of Y st P c= H;

theorem 
  for H being covering Hierarchy of Y for B being mutually-disjoint
Subset-Family of Y st B c= H & for C being mutually-disjoint Subset-Family of Y
  st C c= H & union B c= union C holds B = C holds B is a_partition of Y;

theorem 
  for H being covering T_3 Hierarchy of Y st H is lower-bounded & not {}
  in H for A being Subset of Y for B being mutually-disjoint Subset-Family of Y
st A in B & B c= H & for C being mutually-disjoint Subset-Family of Y st A in C
& C c= H & union B c= union C holds union B = union C holds B is a_partition of
  Y;

theorem 
  for H being covering T_3 Hierarchy of Y st H is lower-bounded &
not {} in H for A being Subset of Y for B being mutually-disjoint Subset-Family
of Y st A in B & B c= H & for C being mutually-disjoint Subset-Family of Y st A
  in C & C c= H & B c= C holds B = C holds B is a_partition of Y;

theorem 
  for H being covering T_3 Hierarchy of Y st H is lower-bounded &
not {} in H for A being Subset of Y st A in H ex P being a_partition of Y st A
  in P & P c= H;

theorem 
  for h being non empty set for Pmin being a_partition of X for hw
  being set st hw in Pmin & h c= hw for PS being a_partition of X st h in PS &
  for x st x in PS holds (x c= hw or hw c= x or hw misses x) for PT be set st (
  for a holds a in PT iff a in PS & a c= hw) holds PT \/ (Pmin \ {hw}) is
  a_partition of X & PT \/ (Pmin \ {hw}) is_finer_than Pmin;

theorem 
  for h being non empty set st h c= X for Pmax being a_partition
of X st ( (ex hy be set st hy in Pmax & hy c= h) & for x st x in Pmax holds (x
c= h or h c= x or h misses x)) for Pb be set st (for x holds x in Pb iff (x in
Pmax & x misses h)) holds Pb \/ {h} is a_partition of X & Pmax is_finer_than (
  Pb \/ {h})& for Pmin being a_partition of X st Pmax is_finer_than Pmin for hw
  being set st hw in Pmin & h c= hw holds (Pb \/ {h}) is_finer_than Pmin;

theorem 
  for H being covering T_3 Hierarchy of X st H is lower-bounded & not {}
in H & (for C1 be set st (C1 <> {} & C1 c= PARTITIONS(X) & (for P1,P2 be set st
P1 in C1 & P2 in C1 holds P1 is_finer_than P2 or P2 is_finer_than P1)) holds (
ex PX,PY st (PX in C1 & PY in C1 & for PZ st PZ in C1 holds PZ is_finer_than PY
  & PX is_finer_than PZ))) ex C being Classification of X st union C = H;














begin 

theorem 
  for D being non empty set for f being non empty FinSequence of D, g
  being FinSequence of D holds (g^f)/.len(g^f) = f/.len f;

theorem 
  for a,b,c,d being set holds Indices (a,b)][(c,d) = {[1,1],[1,2], [2,1],[2,2]}
;

begin 

reserve i,j,k,n,m for Element of NAT;

theorem 
  for p,q being Point of TOP-REAL n, r being Real st 0 < r & p = (
  1-r)*p+r*q holds p = q;

theorem 
  for p,q being Point of TOP-REAL n, r being Real st r < 1 & p = (
  1-r)*q+r*p holds p = q;

theorem 
  for p,q being Point of TOP-REAL n st p = 1/2*(p+q) holds p = q;

theorem 
  for p,q,r being Point of TOP-REAL n st q in LSeg(p,r) & r in
  LSeg(p,q) holds q = r;

begin 

theorem 
  for A being non empty Subset of TOP-REAL 2, p being Element of
  Euclid 2, r being Real st A = Ball(p,r) holds A is connected;

theorem 
  for A, B being Subset of TOP-REAL 2 st A is open & B
  is_a_component_of A holds B is open;

theorem 
  for p,q,r,s being Point of TOP-REAL 2 st LSeg(p,q) is horizontal &
  LSeg(r,s) is horizontal & LSeg(p,q) meets LSeg(r,s) holds p`2= r`2;

theorem 
  for p,q,r being Point of TOP-REAL 2 st LSeg(p,q) is vertical & LSeg(q,
  r) is horizontal holds LSeg(p,q) /\ LSeg(q,r) = {q};

theorem 
  for p,q,r,s being Point of TOP-REAL 2 st LSeg(p,q) is horizontal &
  LSeg(s,r) is vertical & r in LSeg(p,q) holds LSeg(p,q) /\ LSeg(s,r) = {r};

begin 

reserve p,q for Point of TOP-REAL 2;
reserve G for Go-board;

theorem 
  1 <= j & j <= k & k <= width G & 1 <= i & i <= len G implies G*(i,j)`2
  <= G*(i,k)`2;

theorem 
  1 <= j & j <= width G & 1 <= i & i <= k & k <= len G implies G*(i,j)`1
  <= G*(k,j)`1;

reserve C for Subset of TOP-REAL 2;

theorem 
  LSeg(NW-corner C,NE-corner C) c= L~SpStSeq C;

theorem 
  for C being non empty compact Subset of TOP-REAL 2 holds N-min C
  in LSeg(NW-corner C,NE-corner C);

registration
  let C;
  cluster LSeg(NW-corner C,NE-corner C) -> horizontal;
end;

theorem 
  for g being FinSequence of TOP-REAL 2, p being Point of TOP-REAL 2 st
g/.1 <> p & ((g/.1)`1 = p`1 or (g/.1)`2 = p`2) & g is being_S-Seq & LSeg(p,g/.1
  ) /\ L~g={ g/.1 } holds <*p*>^g is being_S-Seq;

theorem 
  for f being S-Sequence_in_R2, p being Point of TOP-REAL 2 st 1 <j & j
  <= len f & p in L~mid(f,1,j) holds LE p, f/.j, L~f, f/.1, f/.len f;

theorem 
  for h being FinSequence of TOP-REAL 2 st i in dom h & j in dom h holds
  L~mid(h,i,j) c= L~h;

theorem 
  1 <= i & i < j implies for f being FinSequence of TOP-REAL 2 st j <=
  len f holds L~mid(f,i,j) = LSeg(f,i) \/ L~mid(f,i+1,j);

theorem 
  for f being FinSequence of TOP-REAL 2 st 1 <= i holds i < j & j <= len
  f implies L~mid(f,i,j) = L~mid(f,i,j -' 1) \/ LSeg(f,j -' 1);

theorem 
  for f, g being FinSequence of TOP-REAL 2 st f is being_S-Seq & g is
being_S-Seq & ((f/.len f)`1 = (g/.1)`1 or (f/.len f)`2 = (g/.1)`2) & L~f misses
L~g & LSeg(f/.len f,g/.1) /\ L~f={ f/.len f } & LSeg(f/.len f,g/.1) /\ L~g={ g
  /.1 } holds f^g is being_S-Seq;

theorem 
  for f be FinSequence of TOP-REAL 2 for p be Point of TOP-REAL 2 st p
  in L~f holds R_Cut(f,p)/.1 = f/.1;

theorem 
  for f being S-Sequence_in_R2, p,q being Point of TOP-REAL 2 st 1 <=j &
j < len f & p in LSeg(f,j) & q in LSeg(f/.j,p) holds LE q, p, L~f, f/.1, f/.len
  f;

begin 

theorem 
  for f being non constant standard special_circular_sequence
  holds LeftComp f is open & RightComp f is open;

registration
  let f be non constant standard special_circular_sequence;
  cluster L~f -> non vertical non horizontal;
  cluster LeftComp f -> being_Region;
  cluster RightComp f -> being_Region;
end;

theorem 
  for f being non constant standard special_circular_sequence
  holds RightComp f misses L~f;

theorem 
  for f being non constant standard special_circular_sequence
  holds LeftComp f misses L~f;

theorem 
  for f being non constant standard special_circular_sequence
  holds i_w_n f < i_e_n f;

theorem 
  for f being non constant standard special_circular_sequence ex i
  st 1 <= i & i < len GoB f & N-min L~f = (GoB f)*(i,width GoB f);

theorem 
  for f being clockwise_oriented non constant standard
special_circular_sequence st i in dom GoB f & f/.1 = (GoB f)*(i,width GoB f) &
  f/.1 = N-min L~f holds f/.2 = (GoB f)*(i+1,width GoB f) & f/.(len f -' 1) = (
  GoB f)*(i,width GoB f -' 1);

theorem 
  for f being non constant standard special_circular_sequence st 1 <= i
  & i < j & j <= len f & f/.1 in L~mid(f,i,j) holds i = 1 or j = len f;

theorem 
  for f being clockwise_oriented non constant standard
  special_circular_sequence st f/.1 = N-min L~f holds LSeg(f/.1,f/.2) c= L~
  SpStSeq L~f;

begin 

theorem 
  for f being rectangular FinSequence of TOP-REAL 2, p being Point
of TOP-REAL 2 st p in L~f holds p`1 = W-bound L~f or p`1 = E-bound L~f or p`2 =
  S-bound L~f or p`2 = N-bound L~f;

registration
  cluster rectangular for special_circular_sequence;
end;

theorem 
  for f being rectangular special_circular_sequence, g being
  S-Sequence_in_R2 st g/.1 in LeftComp f & g/.len g in RightComp f holds L~f
  meets L~g;

theorem 
  for f being rectangular special_circular_sequence holds SpStSeq L~f = f;

theorem 
  for f being rectangular special_circular_sequence holds L~f = {
p where p is Point of TOP-REAL 2: p`1 = W-bound L~f & p`2 <= N-bound L~f & p`2
  >= S-bound L~f or p`1 <= E-bound L~f & p`1 >= W-bound L~f & p`2 = N-bound L~f
or p`1 <= E-bound L~f & p`1 >= W-bound L~f & p`2 = S-bound L~f or p`1 = E-bound
  L~f & p`2 <= N-bound L~f & p`2 >= S-bound L~f};

theorem 
  for f being rectangular special_circular_sequence holds GoB f =
  (f/.4,f/.1)][(f/.3,f/.2);

theorem 
  for f being rectangular special_circular_sequence holds LeftComp
f = {p : not(W-bound L~f <= p`1 & p`1 <= E-bound L~f & S-bound L~f <= p`2 & p`2
  <= N-bound L~f)} & RightComp f = {q : W-bound L~f < q`1 & q`1 < E-bound L~f &
  S-bound L~f < q`2 & q`2 < N-bound L~f};

registration
  cluster clockwise_oriented for rectangular special_circular_sequence;
end;

registration
  cluster -> clockwise_oriented for rectangular special_circular_sequence;
end;

theorem 
  for f being rectangular special_circular_sequence, g being
  S-Sequence_in_R2 st g/.1 in LeftComp f & g/.len g in RightComp f holds
  Last_Point(L~g,g/.1,g/.len g,L~f) <> NW-corner L~f;

theorem 
  for f being rectangular special_circular_sequence, g being
  S-Sequence_in_R2 st g/.1 in LeftComp f & g/.len g in RightComp f holds
  Last_Point(L~g,g/.1,g/.len g,L~f) <> SE-corner L~f;

theorem 
  for f being rectangular special_circular_sequence, p being Point
of TOP-REAL 2 st W-bound L~f > p`1 or p`1 > E-bound L~f or S-bound L~f > p`2 or
  p`2 > N-bound L~f holds p in LeftComp f;

theorem 
  for f being clockwise_oriented non constant standard
  special_circular_sequence st f/.1 = N-min L~f holds LeftComp SpStSeq L~f c=
  LeftComp f;

begin 

theorem 
  for f being FinSequence of TOP-REAL 2, p,q being Point of
TOP-REAL 2 holds <*p,q*> is_in_the_area_of f iff <*p*> is_in_the_area_of f & <*
  q*> is_in_the_area_of f;

theorem 
  for f being rectangular FinSequence of TOP-REAL 2, p being Point
  of TOP-REAL 2 st <*p*> is_in_the_area_of f & (p`1 = W-bound L~f or p`1 =
  E-bound L~f or p`2 = S-bound L~f or p`2 = N-bound L~f) holds p in L~f;

theorem 
  for f being FinSequence of TOP-REAL 2, p,q being Point of
  TOP-REAL 2, r being Real st 0<=r & r <= 1 & <*p,q*> is_in_the_area_of f holds
  <*(1-r)*p+r*q*> is_in_the_area_of f;

theorem 
  for f, g being FinSequence of TOP-REAL 2 st g is_in_the_area_of
  f & i in dom g holds <*g/.i*> is_in_the_area_of f;

theorem 
  for f, g being FinSequence of TOP-REAL 2, p being Point of
TOP-REAL 2 st g is_in_the_area_of f & p in L~g holds <*p*> is_in_the_area_of f;

theorem 
  for f being rectangular FinSequence of TOP-REAL 2, p,q being
Point of TOP-REAL 2 st not q in L~f & <*p,q*> is_in_the_area_of f holds LSeg(p,
  q) /\ L~f c= {p};

theorem 
  for f being rectangular FinSequence of TOP-REAL 2, p,q being Point of
TOP-REAL 2 st p in L~f & not q in L~f & <*q*> is_in_the_area_of f holds LSeg(p,
  q) /\ L~f = {p};

theorem 
  for f being non constant standard special_circular_sequence st 1
  <= i & i <= len GoB f & 1 <= j & j <= width GoB f holds <*(GoB f)*(i,j)*>
  is_in_the_area_of f;

theorem 
  for g being FinSequence of TOP-REAL 2, p,q being Point of TOP-REAL 2
  st <*p,q*> is_in_the_area_of g holds <*1/2*(p+q)*> is_in_the_area_of g;

theorem 
  for f, g being FinSequence of TOP-REAL 2 st g is_in_the_area_of f
  holds Rev g is_in_the_area_of f;

theorem 
  for f, g being FinSequence of TOP-REAL 2, p being Point of TOP-REAL 2
st g is_in_the_area_of f & <*p*> is_in_the_area_of f & g is being_S-Seq & p in
  L~g holds R_Cut(g,p) is_in_the_area_of f;

theorem 
  for f being non constant standard special_circular_sequence, g being
  FinSequence of TOP-REAL2 holds g is_in_the_area_of f iff g is_in_the_area_of
  SpStSeq L~f;

theorem 
  for f being rectangular special_circular_sequence, g being
S-Sequence_in_R2 st g/.1 in LeftComp f & g/.len g in RightComp f holds L_Cut(g,
  Last_Point(L~g,g/.1,g/.len g,L~f)) is_in_the_area_of f;

theorem 
  for f being non constant standard special_circular_sequence st 1 <= i
& i < len GoB f & 1 <= j & j < width GoB f holds Int cell(GoB f,i,j) misses L~
  SpStSeq L~f;

theorem 
  for f, g being FinSequence of TOP-REAL 2, p being Point of TOP-REAL 2
st g is_in_the_area_of f & <*p*> is_in_the_area_of f & g is being_S-Seq & p in
  L~g holds L_Cut(g,p) is_in_the_area_of f;














begin  

definition
  let V be non empty MetrStruct;
  attr V is convex means


  for x,y be Element of V for r be Real st 0 <= r & r <= 1
  ex z be Element of V st dist(x,z) = r * dist(x,y) &
     dist(z,y) = (1 - r) * dist(x,y);
end;

definition
  let V be non empty MetrStruct;
  attr V is internal means

  for x,y be Element of V for p,q be Real st p > 0 &
q > 0 ex f be FinSequence of the carrier of V st f/.1 = x & f/.len f = y & (for
i be Element of NAT st 1 <= i & i <= len f - 1 holds dist(f/.i,f/.(i+1)) < p) &
for F be FinSequence of REAL st len F = len f - 1 & for i be Element of NAT st
1 <= i & i <= len F holds F/.i = dist(f/.i,f/.(i+1)) holds abs(dist(x,y) - Sum
  F) < q;
end;

theorem 
  for V be non empty MetrSpace st V is convex for x,y be Element of
V for p be Real st p > 0 ex f be FinSequence of the carrier of V st f/.1 = x &
f/.len f = y & (for i be Element of NAT st 1 <= i & i <= len f - 1 holds dist(f
/.i,f/.(i+1)) < p) & for F be FinSequence of REAL st len F = len f - 1 & for i
be Element of NAT st 1 <= i & i <= len F holds F/.i = dist(f/.i,f/.(i+1)) holds
  dist(x,y) = Sum F;

registration
  cluster convex -> internal for non empty MetrSpace;
end;

registration
  cluster convex for non empty MetrSpace;
end;

begin  

definition
  let V be non empty MetrStruct;
  let f be Function of V,V;
  attr f is isometric means


  for x,y be Element of V holds dist(x,y) = dist(f.x,f.y);
end;

registration
  let V be non empty MetrStruct;
  cluster id(V) -> onto isometric;
end;

theorem 
  for V be non empty MetrStruct holds id(V) is onto isometric;

registration
  let V be non empty MetrStruct;
  cluster onto isometric for Function of V,V;
end;

definition
  let V be non empty MetrStruct;
  func ISOM(V) -> set means


  for x be set holds x in it iff x is onto isometric Function of V,V;
end;

definition
  let V be non empty MetrStruct;
  redefine func ISOM(V) -> Subset of Funcs(the carrier of V,the carrier of V);
end;

registration
  let V be discerning Reflexive non empty MetrStruct;
  cluster isometric -> one-to-one for Function of V,V;
end;

theorem 
  for V be discerning Reflexive non empty MetrStruct
  for f be Function of V,V st f is isometric holds f is one-to-one;

registration
  let V be discerning Reflexive non empty MetrStruct;
  let f be onto isometric Function of V,V;
  cluster f" -> onto isometric;
end;

theorem 
  for V be discerning Reflexive non empty MetrStruct
  for f be onto isometric Function of V,V holds f" is onto isometric;

registration
  let V be non empty MetrStruct;
  let f,g be onto isometric Function of V,V;
  cluster f*g -> onto isometric for Function of V,V;
end;

theorem 
  for V be non empty MetrStruct for f,g be onto isometric Function of V,
  V holds f*g is onto isometric;

registration
  let V be non empty MetrStruct;
  cluster ISOM V -> non empty;
end;

begin  

definition
  struct(RLSStruct,MetrStruct) RLSMetrStruct (# carrier -> set, distance ->
Function of [:the carrier,the carrier:],REAL, ZeroF -> Element of the carrier,
    addF -> BinOp of the carrier, Mult -> Function of [:REAL, the carrier:],the
    carrier #);
end;

registration
  cluster non empty strict for RLSMetrStruct;
end;

registration
  let X be non empty set;
  let F be Function of [:X,X:],REAL;
  let O be Element of X;
  let B be BinOp of X;
  let G be Function of [:REAL,X:],X;
  cluster RLSMetrStruct (# X,F,O,B,G #) -> non empty;
end;

definition
  let V be non empty RLSMetrStruct;
  attr V is homogeneous means


  for r be Real for v,w be Element of V
  holds dist(r*v,r*w) = abs(r) * dist(v,w);
end;

definition
  let V be non empty RLSMetrStruct;
  attr V is translatible means


  for u,w,v be Element of V holds dist(v,w) = dist(v+u,w+u);
end;

definition
  let V be non empty RLSMetrStruct;
  let v be Element of V;
  func Norm(v) -> Real equals

  dist(0.V,v);
end;

registration
  cluster strict Abelian add-associative right_zeroed right_complementable
    vector-distributive scalar-distributive scalar-associative scalar-unital
    Reflexive discerning symmetric triangle homogeneous
    translatible for non empty RLSMetrStruct;
end;

definition
  mode RealLinearMetrSpace is Abelian add-associative right_zeroed
    right_complementable vector-distributive scalar-distributive
    scalar-associative scalar-unital Reflexive discerning symmetric
    triangle homogeneous translatible non empty RLSMetrStruct;
end;

theorem 
  for V be homogeneous Abelian add-associative right_zeroed
  right_complementable vector-distributive scalar-distributive
  scalar-associative scalar-unital non empty RLSMetrStruct for r be
  Real for v be Element of V holds Norm (r * v) = abs(r) * Norm v;

theorem 
  for V be translatible Abelian add-associative right_zeroed
right_complementable triangle non empty RLSMetrStruct for v,w be Element of V
  holds Norm (v + w) <= Norm v + Norm w;

theorem 
  for V be translatible add-associative right_zeroed
  right_complementable non empty RLSMetrStruct for v,w be Element of V holds
  dist(v,w) = Norm (w - v);

definition
  let n be Element of NAT;
  func RLMSpace n -> strict RealLinearMetrSpace means


  the carrier of it = REAL n &
  the distance of it = Pitag_dist n &
  0.it = 0*n &
  (for x,y be Element of REAL n holds (the addF of it).(x,y) = x + y) &
  for x be Element of REAL n,r be Element of REAL holds
    (the Mult of it).(r,x) = r * x;
end;

theorem 
  for n be Element of NAT for f be onto isometric Function of RLMSpace n,
  RLMSpace n holds rng f = REAL n;

begin  

definition
  let n be Element of NAT;
  func IsomGroup n -> strict multMagma means


  the carrier of it = ISOM RLMSpace n &
  for f,g be Function st f in ISOM RLMSpace n & g in ISOM RLMSpace n
   holds (the multF of it).(f,g) = f*g;
end;

registration
  let n be Element of NAT;
  cluster IsomGroup n -> non empty;
end;

registration
  let n be Element of NAT;
  cluster IsomGroup n -> associative Group-like;
end;

theorem 
  for n be Element of NAT holds 1_IsomGroup n = id (RLMSpace n);

theorem 
  for n be Element of NAT for f be Element of IsomGroup n for g be
  Function of RLMSpace n,RLMSpace n st f = g holds f" = g";

definition
  let n be Element of NAT;
  let G be Subgroup of IsomGroup n;
  func SubIsomGroupRel G -> Relation of the carrier of RLMSpace n means


  for A,B be Element of RLMSpace n holds [A,B] in it iff ex f be Function st f
  in the carrier of G & f.A = B;
end;

registration
  let n be Element of NAT;
  let G be Subgroup of IsomGroup n;
  cluster SubIsomGroupRel G -> total symmetric transitive;
end;














begin  

theorem 
  for L be non empty Poset for x be Element of L holds compactbelow
  x = waybelow x /\ the carrier of CompactSublatt L;

definition
  let L be non empty reflexive transitive RelStr;
  let X be Subset of InclPoset Ids L;
  redefine func union X -> Subset of L;
end;

theorem 
  for L be non empty RelStr for X,Y be Subset of L st X c= Y holds
  finsups X c= finsups Y;

theorem 
  for L be non empty transitive RelStr for S be sups-inheriting non
  empty full SubRelStr of L for X be Subset of L for Y be Subset of S st X = Y
  holds finsups X c= finsups Y;

theorem 
  for L be complete transitive antisymmetric non empty RelStr for S be
  sups-inheriting non empty full SubRelStr of L for X be Subset of L for Y be
  Subset of S st X = Y holds finsups X = finsups Y;

theorem 
  for L be complete sup-Semilattice for S be join-inheriting non
empty full SubRelStr of L st Bottom L in the carrier of S for X be Subset of L
  for Y be Subset of S st X = Y holds finsups Y c= finsups X;

theorem 
  for L be lower-bounded sup-Semilattice for X be Subset of
  InclPoset Ids L holds sup X = downarrow finsups union X;

theorem 
  for L be reflexive transitive RelStr for X be Subset of L holds
  downarrow downarrow X = downarrow X;

theorem 
  for L be reflexive transitive RelStr for X be Subset of L holds
  uparrow uparrow X = uparrow X;

theorem 
  for L be non empty reflexive transitive RelStr for x be Element of L
  holds downarrow downarrow x = downarrow x;

theorem 
  for L be non empty reflexive transitive RelStr for x be Element of L
  holds uparrow uparrow x = uparrow x;

theorem 
  for L be non empty RelStr for S be non empty SubRelStr of L for
X be Subset of L for Y be Subset of S st X = Y holds downarrow Y c= downarrow X
;

theorem 
  for L be non empty RelStr for S be non empty SubRelStr of L for
  X be Subset of L for Y be Subset of S st X = Y holds uparrow Y c= uparrow X;

theorem 
  for L be non empty RelStr for S be non empty SubRelStr of L for x be
  Element of L for y be Element of S st x = y holds downarrow y c= downarrow x;

theorem 
  for L be non empty RelStr for S be non empty SubRelStr of L for x be
  Element of L for y be Element of S st x = y holds uparrow y c= uparrow x;

begin  

definition
  let L be non empty RelStr;
  let S be Subset of L;
  attr S is meet-closed means


  subrelstr S is meet-inheriting;
end;

definition
  let L be non empty RelStr;
  let S be Subset of L;
  attr S is join-closed means


  subrelstr S is join-inheriting;
end;

definition
  let L be non empty RelStr;
  let S be Subset of L;
  attr S is infs-closed means


  subrelstr S is infs-inheriting;
end;

definition
  let L be non empty RelStr;
  let S be Subset of L;
  attr S is sups-closed means


  subrelstr S is sups-inheriting;
end;

registration
  let L be non empty RelStr;
  cluster infs-closed -> meet-closed for Subset of L;
  cluster sups-closed -> join-closed for Subset of L;
end;

registration
  let L be non empty RelStr;
  cluster infs-closed sups-closed non empty for Subset of L;
end;

theorem 
  for L be non empty RelStr for S be Subset of L holds S is
meet-closed iff for x,y be Element of L st x in S & y in S & ex_inf_of {x,y},L
  holds inf {x,y} in S;

theorem 
  for L be non empty RelStr for S be Subset of L holds S is
join-closed iff for x,y be Element of L st x in S & y in S & ex_sup_of {x,y},L
  holds sup {x,y} in S;

theorem 
  for L be antisymmetric with_infima RelStr for S be Subset of L holds S
  is meet-closed iff for x,y be Element of L st x in S & y in S holds inf {x,y}
  in S;

theorem 
  for L be antisymmetric with_suprema RelStr for S be Subset of L
holds S is join-closed iff for x,y be Element of L st x in S & y in S holds sup
  {x,y} in S;

theorem 
  for L be non empty RelStr for S be Subset of L holds S is infs-closed
  iff for X be Subset of S st ex_inf_of X,L holds "/\"(X,L) in S;

theorem 
  for L be non empty RelStr for S be Subset of L holds S is sups-closed
  iff for X be Subset of S st ex_sup_of X,L holds "\/"(X,L) in S;

theorem 
  for L be non empty transitive RelStr for S be infs-closed non
  empty Subset of L for X be Subset of S st ex_inf_of X,L holds ex_inf_of X,
  subrelstr S & "/\"(X,subrelstr S) = "/\"(X,L);

theorem 
  for L be non empty transitive RelStr for S be sups-closed non
  empty Subset of L for X be Subset of S st ex_sup_of X,L holds ex_sup_of X,
  subrelstr S & "\/"(X,subrelstr S) = "\/"(X,L);

theorem 
  for L be non empty transitive RelStr for S be meet-closed non empty
Subset of L for x,y be Element of S st ex_inf_of {x,y},L holds ex_inf_of {x,y},
  subrelstr S & "/\"({x,y},subrelstr S) = "/\"({x,y},L);

theorem 
  for L be non empty transitive RelStr for S be join-closed non empty
Subset of L for x,y be Element of S st ex_sup_of {x,y},L holds ex_sup_of {x,y},
  subrelstr S & "\/"({x,y},subrelstr S) = "\/"({x,y},L);

theorem 
  for L be with_infima antisymmetric transitive RelStr for S be
  non empty meet-closed Subset of L holds subrelstr S is with_infima;

theorem 
  for L be with_suprema antisymmetric transitive RelStr for S be
  non empty join-closed Subset of L holds subrelstr S is with_suprema;

registration
  let L be with_infima antisymmetric transitive RelStr;
  let S be non empty meet-closed Subset of L;
  cluster subrelstr S -> with_infima;
end;

registration
  let L be with_suprema antisymmetric transitive RelStr;
  let S be non empty join-closed Subset of L;
  cluster subrelstr S -> with_suprema;
end;

theorem 
  for L be complete transitive antisymmetric non empty RelStr for S be
infs-closed non empty Subset of L for X be Subset of S holds "/\"(X,subrelstr S
  ) = "/\"(X,L);

theorem 
  for L be complete transitive antisymmetric non empty RelStr for S be
sups-closed non empty Subset of L for X be Subset of S holds "\/"(X,subrelstr S
  ) = "\/"(X,L);

theorem 
  for L be Semilattice for S be meet-closed Subset of L holds S is filtered;

theorem 
  for L be sup-Semilattice for S be join-closed Subset of L holds S is directed
;

registration
  let L be Semilattice;
  cluster meet-closed -> filtered for Subset of L;
end;

registration
  let L be sup-Semilattice;
  cluster join-closed -> directed for Subset of L;
end;

theorem 
  for L be Semilattice for S be upper non empty Subset of L holds S is
  Filter of L iff S is meet-closed;

theorem 
  for L be sup-Semilattice for S be lower non empty Subset of L holds S
  is Ideal of L iff S is join-closed;

theorem 
  for L be non empty RelStr for S1,S2 be join-closed Subset of L
  holds S1 /\ S2 is join-closed;

theorem 
  for L be non empty RelStr for S1,S2 be meet-closed Subset of L holds
  S1 /\ S2 is meet-closed;

theorem 
  for L be sup-Semilattice for x be Element of L holds downarrow x
  is join-closed;

theorem 
  for L be Semilattice for x be Element of L holds downarrow x is meet-closed;

theorem 
  for L be sup-Semilattice for x be Element of L holds uparrow x is join-closed
;

theorem 
  for L be Semilattice for x be Element of L holds uparrow x is meet-closed;

registration
  let L be sup-Semilattice;
  let x be Element of L;
  cluster downarrow x -> join-closed;
  cluster uparrow x -> join-closed;
end;

registration
  let L be Semilattice;
  let x be Element of L;
  cluster downarrow x -> meet-closed;
  cluster uparrow x -> meet-closed;
end;

theorem 
  for L be sup-Semilattice for x be Element of L holds waybelow x
  is join-closed;

theorem 
  for L be Semilattice for x be Element of L holds waybelow x is meet-closed;

theorem 
  for L be sup-Semilattice for x be Element of L holds wayabove x
  is join-closed;

registration
  let L be sup-Semilattice;
  let x be Element of L;
  cluster waybelow x -> join-closed;
  cluster wayabove x -> join-closed;
end;

registration
  let L be Semilattice;
  let x be Element of L;
  cluster waybelow x -> meet-closed;
end;

begin  

definition
  let T be TopStruct;
  func weight T -> Cardinal equals

  meet {card B where B is Basis of T : not contradiction};
end;

definition
  let T be TopStruct;
  attr T is second-countable means

  weight T c= omega;
end;

definition 
  let L be continuous sup-Semilattice;
  mode CLbasis of L -> Subset of L means


    it is join-closed & for x be Element of L holds x = sup (waybelow x /\ it);
end;

definition
  let L be non empty RelStr;
  let S be Subset of L;
  attr S is with_bottom means


  Bottom L in S;
end;

definition
  let L be non empty RelStr;
  let S be Subset of L;
  attr S is with_top means


  Top L in S;
end;

registration
  let L be non empty RelStr;
  cluster with_bottom -> non empty for Subset of L;
end;

registration
  let L be non empty RelStr;
  cluster with_top -> non empty for Subset of L;
end;

registration
  let L be non empty RelStr;
  cluster with_bottom for Subset of L;
  cluster with_top for Subset of L;
end;

registration
  let L be continuous sup-Semilattice;
  cluster with_bottom for CLbasis of L;
  cluster with_top for CLbasis of L;
end;

theorem 
  for L be lower-bounded antisymmetric non empty RelStr for S be
  with_bottom Subset of L holds subrelstr S is lower-bounded;

registration
  let L be lower-bounded antisymmetric non empty RelStr;
  let S be with_bottom Subset of L;
  cluster subrelstr S -> lower-bounded;
end;

registration
  let L be continuous sup-Semilattice;
  cluster -> join-closed for CLbasis of L;
end;

registration
  cluster bounded non trivial for continuous LATTICE;
end;

registration
  let L be lower-bounded non trivial continuous sup-Semilattice;
  cluster -> non empty for CLbasis of L;
end;

theorem 
  for L be sup-Semilattice holds the carrier of CompactSublatt L
  is join-closed Subset of L;

theorem 
  for L be algebraic lower-bounded LATTICE holds the carrier of
  CompactSublatt L is with_bottom CLbasis of L;

theorem 
  for L be continuous lower-bounded sup-Semilattice st the carrier of
  CompactSublatt L is CLbasis of L holds L is algebraic;

theorem 
  for L be continuous lower-bounded LATTICE for B be join-closed
  Subset of L holds B is CLbasis of L iff for x,y be Element of L st not y <= x
  ex b be Element of L st b in B & not b <= x & b << y;

theorem 
  for L be continuous lower-bounded LATTICE for B be join-closed
Subset of L st Bottom L in B holds B is CLbasis of L iff for x,y be Element of
  L st x << y ex b be Element of L st b in B & x <= b & b << y;

theorem 
  for L be continuous lower-bounded LATTICE for B be join-closed
  Subset of L st Bottom L in B holds B is CLbasis of L iff (the carrier of
  CompactSublatt L c= B & for x,y be Element of L st not y <= x ex b be Element
  of L st b in B & not b <= x & b <= y);

theorem 
  for L be continuous lower-bounded LATTICE for B be join-closed Subset
  of L st Bottom L in B holds B is CLbasis of L iff for x,y be Element of L st
  not y <= x ex b be Element of L st b in B & not b <= x & b <= y;

theorem 
  for L be lower-bounded sup-Semilattice for S be non empty full
  SubRelStr of L st Bottom L in the carrier of S & the carrier of S is
join-closed Subset of L for x be Element of L holds waybelow x /\ (the carrier
  of S) is Ideal of S;

definition
  let L be non empty reflexive transitive RelStr;
  let S be non empty full SubRelStr of L;
  func supMap S -> Function of InclPoset(Ids S), L means


  for I be Ideal of S holds it.I = "\/"(I,L);
end;

definition
  let L be non empty reflexive transitive RelStr;
  let S be non empty full SubRelStr of L;
  func idsMap S -> Function of InclPoset(Ids S), InclPoset(Ids L) means



  for I be Ideal of S ex J be Subset of L st I = J & it.I = downarrow J;
end;

registration
  let L be reflexive RelStr;
  let B be Subset of L;
  cluster subrelstr B -> reflexive;
end;

registration
  let L be transitive RelStr;
  let B be Subset of L;
  cluster subrelstr B -> transitive;
end;

registration
  let L be antisymmetric RelStr;
  let B be Subset of L;
  cluster subrelstr B -> antisymmetric;
end;

definition
  let L be lower-bounded continuous sup-Semilattice;
  let B be with_bottom CLbasis of L;
  func baseMap B -> Function of L, InclPoset(Ids subrelstr B) means


  for x be Element of L holds it.x = waybelow x /\ B;
end;

theorem 
  for L be non empty reflexive transitive RelStr for S be non
  empty full SubRelStr of L holds dom supMap S = Ids S & rng supMap S is Subset
  of L;

theorem 
  for L be non empty reflexive transitive RelStr for S be non
  empty full SubRelStr of L for x be set holds x in dom supMap S iff x is Ideal
  of S;

theorem 
  for L be non empty reflexive transitive RelStr for S be non
  empty full SubRelStr of L holds dom idsMap S = Ids S & rng idsMap S is Subset
  of Ids L;

theorem 
  for L be non empty reflexive transitive RelStr for S be non
  empty full SubRelStr of L for x be set holds x in dom idsMap S iff x is Ideal
  of S;

theorem 
  for L be non empty reflexive transitive RelStr for S be non
  empty full SubRelStr of L for x be set holds x in rng idsMap S implies x is
  Ideal of L;

theorem 
  for L be lower-bounded continuous sup-Semilattice for B be with_bottom
  CLbasis of L holds dom baseMap B = the carrier of L & rng baseMap B is Subset
  of Ids subrelstr B;

theorem 
  for L be lower-bounded continuous sup-Semilattice for B be with_bottom
  CLbasis of L for x be set holds x in rng baseMap B implies x is Ideal of
  subrelstr B;

theorem 
  for L be up-complete non empty Poset for S be non empty full
  SubRelStr of L holds supMap S is monotone;

theorem 
  for L be non empty reflexive transitive RelStr for S be non
  empty full SubRelStr of L holds idsMap S is monotone;

theorem 
  for L be lower-bounded continuous sup-Semilattice for B be
  with_bottom CLbasis of L holds baseMap B is monotone;

registration
  let L be up-complete non empty Poset;
  let S be non empty full SubRelStr of L;
  cluster supMap S -> monotone;
end;

registration
  let L be non empty reflexive transitive RelStr;
  let S be non empty full SubRelStr of L;
  cluster idsMap S -> monotone;
end;

registration
  let L be lower-bounded continuous sup-Semilattice;
  let B be with_bottom CLbasis of L;
  cluster baseMap B -> monotone;
end;

theorem 
  for L be lower-bounded continuous sup-Semilattice for B be
  with_bottom CLbasis of L holds idsMap (subrelstr B) is sups-preserving;

theorem 
  for L be up-complete non empty Poset for S be non empty full
  SubRelStr of L holds supMap S = (SupMap L)*(idsMap S);

theorem 
  for L be lower-bounded continuous sup-Semilattice for B be
  with_bottom CLbasis of L holds [supMap subrelstr B,baseMap B] is Galois;

theorem 
  for L be lower-bounded continuous sup-Semilattice for B be
with_bottom CLbasis of L holds supMap subrelstr B is upper_adjoint & baseMap B
  is lower_adjoint;

theorem 
  for L be lower-bounded continuous sup-Semilattice for B be
  with_bottom CLbasis of L holds rng supMap subrelstr B = the carrier of L;

theorem 
  for L be lower-bounded continuous sup-Semilattice for B be
  with_bottom CLbasis of L holds supMap (subrelstr B) is infs-preserving
  sups-preserving;

theorem 
  for L be lower-bounded continuous sup-Semilattice for B be with_bottom
  CLbasis of L holds baseMap B is sups-preserving;

registration
  let L be lower-bounded continuous sup-Semilattice;
  let B be with_bottom CLbasis of L;
  cluster supMap subrelstr B -> infs-preserving sups-preserving;
  cluster baseMap B -> sups-preserving;
end;

theorem 
  for L be lower-bounded continuous sup-Semilattice for B be
  with_bottom CLbasis of L holds the carrier of CompactSublatt InclPoset(Ids
  subrelstr B) = { downarrow b where b is Element of subrelstr B : not
  contradiction };

theorem 
  for L be lower-bounded continuous sup-Semilattice for B be
  with_bottom CLbasis of L holds CompactSublatt InclPoset(Ids subrelstr B),
  subrelstr B are_isomorphic;

theorem 
  for L be continuous lower-bounded LATTICE for B be with_bottom
  CLbasis of L st for B1 be with_bottom CLbasis of L holds B c= B1 for J be
  Element of InclPoset Ids subrelstr B holds J = waybelow "\/"(J,L) /\ B;

theorem 
  for L be continuous lower-bounded LATTICE holds L is algebraic iff the
carrier of CompactSublatt L is with_bottom CLbasis of L & for B be with_bottom
  CLbasis of L holds the carrier of CompactSublatt L c= B;

theorem 
  for L be continuous lower-bounded LATTICE holds L is algebraic iff ex
B be with_bottom CLbasis of L st for B1 be with_bottom CLbasis of L holds B c=
  B1;

theorem 
  for T be TopStruct for b be Basis of T holds weight T c= card b;

theorem 
  for T be TopStruct ex b be Basis of T st card b = weight T;














begin 

reserve V, C, x, a, b for set;
reserve A, B for Element of SubstitutionSet (V, C);

theorem 
  for a, b being set st b in SubstitutionSet (V, C) & a in b holds
  a is finite Function;

begin 

theorem 
  for a being finite Element of PFuncs (V, C) holds {a} in
  SubstitutionSet (V, C);

theorem 
  A ^ B = A implies for a be set st a in A ex b be set st b in B & b c= a;

theorem 
  mi (A ^ B) = A implies for a be set st a in A ex b be set st b in B & b c= a;

theorem 
  (for a be set st a in A ex b be set st b in B & b c= a) implies
  mi (A ^ B) = A;

definition
  let V be set, C be finite set;
  let A be Element of Fin PFuncs (V, C);
  func Involved A means


  x in it iff ex f being finite Function st f in A & x in dom f;
end;

reserve C for finite set;

theorem 
  for V being set, C be finite set, A being Element of Fin PFuncs
  (V, C) holds Involved A c= V;

theorem 
  for V being set, C being finite set, A being Element of Fin
  PFuncs (V, C) st A = {} holds Involved A = {};

registration
  let V be set, C being finite set, A being Element of Fin PFuncs (V, C);
  cluster Involved A -> finite;
end;

theorem 
  for C being finite set, A being Element of Fin PFuncs ({}, C) holds
  Involved A = {};

definition
  let V be set, C be finite set;
  let A be Element of Fin PFuncs (V, C);
  func -A -> Element of Fin PFuncs (V, C) equals

  { f where f is Element of
PFuncs (Involved A, C) : for g be Element of PFuncs (V, C) st g in A holds not
  f tolerates g };
end;

theorem 
  A ^ -A = {};

theorem 
  A = {} implies -A = { {} };

theorem 
  A = { {} } implies -A = {};

theorem 
  for V being set, C being finite set for A being Element of
  SubstitutionSet (V, C) holds mi (A ^ -A) = Bottom SubstLatt (V,C);

theorem 
  for V being non empty set, C being finite non empty set for A being
  Element of SubstitutionSet (V, C) st A = {} holds mi -A = Top SubstLatt (V,C)
;

theorem 
  for V being set, C being finite set for A being Element of
  SubstitutionSet (V, C), a being Element of PFuncs (V, C), B being Element of
SubstitutionSet (V, C) st B = { a } holds A ^ B = {} implies ex b being finite
  set st b in -A & b c= a;

definition
  let V be set, C be finite set;
  let A, B be Element of Fin PFuncs (V, C);
  func A =>> B -> Element of Fin PFuncs (V, C) equals

  PFuncs (V, C) /\ { union
  {f.i \ i where i is Element of PFuncs (V, C) : i in A} where f is Element of
  PFuncs (A, B) : dom f = A };
end;

theorem 
  for A, B being Element of Fin PFuncs (V, C), s being set st s in
  A =>> B holds ex f being PartFunc of A, B st s = union {f.i \ i where i is
  Element of PFuncs (V, C) : i in A} & dom f = A;

theorem 
  for V being set, C being finite set, A being Element of Fin PFuncs (V,
  C ) st A = {} holds A =>> A = {{}};

reserve u, v for Element of SubstLatt (V, C);
reserve s, t, a, b for Element of PFuncs (V,C);
reserve K, L for Element of SubstitutionSet (V, C);

theorem 
  for X being set st X c= u holds X is Element of SubstLatt (V, C);

begin 

definition
  let V, C;
  func pseudo_compl (V, C) -> UnOp of the carrier of SubstLatt (V, C) means


   for
 u9 being Element of SubstitutionSet (V, C) st u9 = u holds it.u = mi(
  -u9);
  func StrongImpl(V, C) -> BinOp of the carrier of SubstLatt (V, C) means


   for u9, v9 being Element of SubstitutionSet (V, C) st u9 = u & v9 = v
  holds it.(u,v) = mi (u9 =>> v9);
  let u;
  func SUB u -> Element of Fin the carrier of SubstLatt (V, C) equals

  bool u;
  func diff(u) -> UnOp of the carrier of SubstLatt (V, C) means


  it.v = u \ v;
end;

definition
  let V, C;
  func Atom(V, C) -> Function of PFuncs (V, C), the carrier of SubstLatt (V, C
  ) means


  for a being Element of PFuncs (V,C) holds it.a = mi {.a.};
end;

theorem 
  FinJoin (K, Atom(V, C)) = FinUnion(K, singleton PFuncs (V, C));

theorem 
  for u being Element of SubstitutionSet (V, C) holds u = FinJoin(
  u, Atom (V, C));

theorem 
  (diff u).v [= u;

theorem 
  for a being Element of PFuncs (V, C) st a is finite for c being
  set st c in Atom(V, C).a holds c = a;

theorem 
  for a being Element of PFuncs (V, C) st K = {a} & L = u & L ^ K
  = {} holds Atom(V, C).a [= pseudo_compl(V, C).u;

theorem 
  for a being finite Element of PFuncs (V,C) holds a in Atom(V, C) .a;

theorem 
  for u, v being Element of SubstitutionSet (V, C) holds ((for c
being set st c in u ex b being set st b in v & b c= c \/ a) implies ex b being
  set st b in u =>> v & b c= a );

theorem 
  for a being finite Element of PFuncs (V,C) st (for b being
Element of PFuncs (V, C) st b in u holds b tolerates a ) & u "/\" Atom(V, C).a
  [= v holds Atom(V, C).a [= StrongImpl(V, C).(u, v);

theorem 
  u "/\" pseudo_compl(V, C).u = Bottom SubstLatt (V, C);

theorem 
  u "/\" StrongImpl(V, C).(u, v) [= v;

registration
  let V, C;
  cluster SubstLatt (V, C) -> implicative;
end;

theorem 
  u => v = FinJoin(SUB u, (the L_meet of SubstLatt (V, C)).:(
  pseudo_compl(V, C), StrongImpl(V, C)[:](diff u, v)));














begin

theorem 
  for V being non empty RLSStruct, M,N being convex Subset of V holds M
  /\ N is convex;

theorem 
  for V being RealUnitarySpace-like non empty UNITSTR, M being Subset
of V, F being FinSequence of the carrier of V, B being FinSequence of REAL st M
= {u where u is VECTOR of V : for i being Element of NAT st i in (dom F /\ dom
B) holds ex v being VECTOR of V st v = F.i & u .|. v <= B.i} holds M is convex;

theorem 
  for V being RealUnitarySpace-like non empty UNITSTR, M being Subset
of V, F being FinSequence of the carrier of V, B being FinSequence of REAL st M
= {u where u is VECTOR of V : for i being Element of NAT st i in (dom F /\ dom
  B) holds ex v being VECTOR of V st v = F.i & u .|. v < B.i} holds M is convex
;

theorem 
  for V being RealUnitarySpace-like non empty UNITSTR, M being Subset
of V, F being FinSequence of the carrier of V, B being FinSequence of REAL st M
= {u where u is VECTOR of V : for i being Element of NAT st i in (dom F /\ dom
B) holds ex v being VECTOR of V st v = F.i & u .|. v >= B.i} holds M is convex;

theorem 
  for V being RealUnitarySpace-like non empty UNITSTR, M being Subset
of V, F being FinSequence of the carrier of V, B being FinSequence of REAL st M
= {u where u is VECTOR of V : for i being Element of NAT st i in (dom F /\ dom
  B) holds ex v being VECTOR of V st v = F.i & u .|. v > B.i} holds M is convex
;

theorem 
  for V being RealLinearSpace, M being Subset of V holds (for N being
Subset of V, L being Linear_Combination of N st L is convex & N c= M holds Sum(
  L) in M) iff M is convex;

definition
  let V be RealLinearSpace, M be Subset of V;
  func LinComb(M) -> set means

  for L being set holds L in it iff L is Linear_Combination of M;
end;

registration
  let V be RealLinearSpace;
  cluster convex for Linear_Combination of V;
end;

definition
  let V be RealLinearSpace;
  mode Convex_Combination of V is convex Linear_Combination of V;
end;

registration
  let V be RealLinearSpace, M be non empty Subset of V;
  cluster convex for Linear_Combination of M;
end;

definition
  let V be RealLinearSpace, M be non empty Subset of V;
  mode Convex_Combination of M is convex Linear_Combination of M;
end;

theorem 
  for V being RealLinearSpace, M be Subset of V holds Convex-Family M <> {};

theorem 
  for V being RealLinearSpace, L1,L2 being Convex_Combination of V,
r being Real st 0 < r & r < 1 holds r*L1 + (1-r)*L2 is Convex_Combination of V;

theorem 
  for V being RealLinearSpace, M being non empty Subset of V, L1,L2
being Convex_Combination of M, r being Real st 0 < r & r < 1 holds r*L1 + (1-r)
  *L2 is Convex_Combination of M;

begin  

theorem 
  for V being RealLinearSpace, W1,W2 being Subspace of V holds Up(W1+W2)
  = Up(W1) + Up(W2);

theorem 
  for V being RealLinearSpace, W1,W2 being Subspace of V holds Up(W1 /\
  W2) = Up(W1) /\ Up(W2);

theorem 
  for V being RealLinearSpace, L1, L2 being Convex_Combination of V, a,b
being Real st a * b > 0 holds Carrier(a*L1 + b*L2) = Carrier(a * L1) \/ Carrier
  (b * L2);

theorem 
  for F,G being Function st F,G are_fiberwise_equipotent for x1,x2 being
  set st x1 in dom F & x2 in dom F & x1 <> x2 holds ex z1,z2 being set st z1 in
  dom G & z2 in dom G & z1 <> z2 & F.x1 = G.z1 & F.x2 = G.z2;

theorem 
  for V being RealLinearSpace, L being Linear_Combination of V, A being
  Subset of V st A c= Carrier(L) holds ex L1 being Linear_Combination of V st
  Carrier(L1) = A;














begin  

scheme 

  SeqLambda1C{ i() -> Nat, D() -> non empty set, C[set], F(set)->set, G(set)->
set } : ex p be FinSequence of D() st len p = i() & for i be Nat st i in Seg i(
  ) holds (C[i] implies p.i = F(i)) & (not C[i] implies p.i = G(i))
provided
 for i be Nat st i in Seg i() holds (C[i] implies F(i) in D()) & (not
C[i] implies G(i) in D());






begin  

definition
  let X be set;
  let p be FinSequence of bool X;
  let q be FinSequence of BOOLEAN;
  func MergeSequence(p,q) -> FinSequence of bool X means


  len it = len p
  & for i be Nat st i in dom p holds it.i = IFEQ(q.i,TRUE,p.i,X\p.i);
end;

canceled 3;

theorem 
  for X be set for p be FinSequence of bool X for q be FinSequence
  of BOOLEAN holds dom MergeSequence(p,q) = dom p;

theorem 
  for X be set for p be FinSequence of bool X for q be FinSequence
  of BOOLEAN for i be Nat st q.i = TRUE holds MergeSequence(p,q).i = p.i;

theorem 
  for X be set for p be FinSequence of bool X for q be FinSequence
of BOOLEAN for i be Nat st i in dom p & q.i = FALSE holds MergeSequence(p,q).i
  = X\p.i;

theorem 
  for X be set for q be FinSequence of BOOLEAN holds len MergeSequence(
  <*>(bool X),q) = 0;

theorem 
  for X be set for q be FinSequence of BOOLEAN holds MergeSequence(
  <*>(bool X),q) = <*>(bool X);

theorem 
  for X be set for x be Subset of X for q be FinSequence of BOOLEAN
  holds len MergeSequence(<*x*>,q) = 1;

theorem 
  for X be set for x be Subset of X for q be FinSequence of BOOLEAN
holds (q.1 = TRUE implies MergeSequence(<*x*>,q).1 = x) & (q.1 = FALSE implies
  MergeSequence(<*x*>,q).1 = X\x);

theorem 
  for X be set for x,y be Subset of X for q be FinSequence of BOOLEAN
  holds len MergeSequence(<*x,y*>,q) = 2;

theorem 
  for X be set for x,y be Subset of X for q be FinSequence of BOOLEAN
  holds (q.1 = TRUE implies MergeSequence(<*x,y*>,q).1 = x) & (q.1 = FALSE
implies MergeSequence(<*x,y*>,q).1 = X\x) & (q.2 = TRUE implies MergeSequence(
  <*x,y*>,q).2 = y) & (q.2 = FALSE implies MergeSequence(<*x,y*>,q).2 = X\y);

theorem 
  for X be set for x,y,z be Subset of X for q be FinSequence of BOOLEAN
  holds len MergeSequence(<*x,y,z*>,q) = 3;

theorem 
  for X be set for x,y,z be Subset of X for q be FinSequence of BOOLEAN
  holds (q.1 = TRUE implies MergeSequence(<*x,y,z*>,q).1 = x) & (q.1 = FALSE
implies MergeSequence(<*x,y,z*>,q).1 = X\x) & (q.2 = TRUE implies MergeSequence
(<*x,y,z*>,q).2 = y) & (q.2 = FALSE implies MergeSequence(<*x,y,z*>,q).2 = X\y)
& (q.3 = TRUE implies MergeSequence(<*x,y,z*>,q).3 = z) & (q.3 = FALSE implies
  MergeSequence(<*x,y,z*>,q).3 = X\z);

theorem 
  for X be set for p be FinSequence of bool X holds { Intersect (
rng MergeSequence(p,q)) where q is FinSequence of BOOLEAN : len q = len p } is
  Subset-Family of X;

registration
  cluster -> boolean-valued for FinSequence of BOOLEAN;
end;

definition
  let X be set;
  let Y be finite Subset-Family of X;
  func Components(Y) -> Subset-Family of X means


  ex p be FinSequence of
bool X st len p = card Y & rng p = Y & it = { Intersect (rng MergeSequence(p,q)
  ) where q is FinSequence of BOOLEAN : len q = len p };
end;

registration
  let X be set;
  let Y be finite Subset-Family of X;
  cluster Components(Y) -> finite;
end;

theorem 
  for X be set for Y be empty Subset-Family of X holds Components( Y) = {X};

theorem 
  for X be set for Y,Z be finite Subset-Family of X st Z c= Y holds
  Components(Y) is_finer_than Components(Z);

theorem 
  for X be set for Y be finite Subset-Family of X holds union Components(Y) = X
;

theorem 
  for X be set for Y be finite Subset-Family of X for A,B be set
  st A in Components(Y) & B in Components(Y) & A <> B holds A misses B;

definition
  let X be set;
  let Y be finite Subset-Family of X;
  attr Y is in_general_position means


  not {} in Components(Y);
end;

theorem 
  for X be set for Y,Z be finite Subset-Family of X st Z is
  in_general_position & Y c= Z holds Y is in_general_position;

theorem 
  for X be non empty set for Y be empty Subset-Family of X holds Y is
  in_general_position;

theorem 
  for X be non empty set for Y be finite Subset-Family of X st Y is
  in_general_position holds Components(Y) is a_partition of X;

begin  

theorem 
  for L be non empty RelStr holds [#]L is infs-closed sups-closed;

theorem 
  for L be non empty RelStr holds [#]L is with_bottom with_top;

registration
  let L be non empty RelStr;
  cluster [#]L -> infs-closed sups-closed with_bottom with_top;
end;

theorem 
  for L be continuous sup-Semilattice holds [#]L is CLbasis of L;

theorem 
  for L be up-complete non empty Poset st L is finite holds the
  carrier of L = the carrier of CompactSublatt L;

theorem 
  for L be lower-bounded sup-Semilattice for B be Subset of L st B is
  infinite holds card B = card finsups B;

theorem 
  for T be T_0 non empty TopSpace holds card the carrier of T c= card
  the topology of T;

theorem 
  for T be TopStruct for X be Subset of T st X is open for B be
finite Subset-Family of T st B is Basis of T for Y be set st Y in Components(B)
  holds X misses Y or Y c= X;

theorem 
  for T be T_0 TopSpace st T is infinite for B be Basis of T holds B is
  infinite;

theorem 
  for T be non empty TopSpace st T is finite for B be Basis of T for x
be Element of T holds meet { A where A is Element of the topology of T : x in A
  } in B;














begin 

reserve n,m,i,j,k for Element of NAT,
  x,y,e,X,V,U for set,
  W,f,g for Function;

theorem 
  rng f c= rng g & x in dom f implies ex y st y in dom g & f.x = g. y;

scheme 

  LambdaAB { A, B()->set, F(Element of B())->set } : ex f being Function st
  dom f = A() & for x being Element of B() st x in A() holds f.x = F(x);

theorem 
  for D being finite set, n being Element of NAT, X being set st X
  = {x where x is Element of D* : 1 <= len x & len x <= n } holds X is finite;

theorem 
  for D being finite set, n being Element of NAT, X being set st X
  = {x where x is Element of D* : len x <= n } holds X is finite;

theorem 
  for D being finite set, k being Element of NAT st card D = k+1
holds ex x being Element of D,C being Subset of D st D = C \/ { x } & card C =
  k;

theorem 
  for D being finite set st card D = 1 holds ex x being Element of D st D={x};

scheme 

  MinValue { D() -> non empty finite set, F(Element of D())-> real number}: ex
  x being Element of D() st for y being Element of D() holds F(x) <= F(y);

definition
  let D be set, X be non empty Subset of D*;
  redefine mode Element of X -> FinSequence of D;
end;

begin 

reserve p,q for FinSequence;

theorem 
  (for n,m st 1<=n & n<m & m<=len p holds p.n <> p.m) iff p is one-to-one;

theorem 
  (for n,m st 1<=n & n<m & m<=len p holds p.n <> p.m) iff card rng p = len p;

reserve G for Graph,
  pe,qe for FinSequence of the carrier' of G;

theorem 
  i in dom pe implies (the Source of G).(pe.i) in the carrier of G & (
  the Target of G).(pe.i) in the carrier of G;

theorem 
  q^<*x*> is one-to-one & rng (q^<*x*>) c= rng p implies ex p1,p2
  being FinSequence st p=p1^<*x*>^p2 & rng q c= rng (p1^p2);

begin 

theorem 
  p^q is Chain of G implies p is Chain of G & q is Chain of G;

theorem 
  p^q is oriented Chain of G implies p is oriented Chain of G & q
  is oriented Chain of G;

theorem 
  for p,q being oriented Chain of G st (the Target of G).(p.len p)
  =(the Source of G).(q.1) holds p^q is oriented Chain of G;

begin 

theorem 
  {} is Simple oriented Chain of G;

theorem 
  p^q is Simple oriented Chain of G implies p is Simple
  oriented Chain of G & q is Simple oriented Chain of G;

theorem 
  len pe = 1 implies pe is Simple oriented Chain of G;

theorem 
  for p being Simple oriented Chain of G, q being FinSequence of
the carrier' of G st len p >=1 & len q=1 & (the Source of G).(q.1)=(the Target
of G).(p.(len p)) & (the Source of G).(p.1) <> (the Target of G).(p.(len p)) &
not ex k st 1<=k & k <= len p & (the Target of G).(p.k) =(the Target of G).(q.1
  ) holds p^q is Simple oriented Chain of G;

theorem 
  for p being Simple oriented Chain of G holds p is one-to-one;

begin 

definition
  let G be Graph, e be Element of the carrier' of G;
  func vertices e equals

  {(the Source of G).e, (the Target of G).e};
end;

definition
  let G,pe;
  func vertices pe -> Subset of the carrier of G equals

  {v where v is Vertex
  of G : ex i st i in dom pe & v in vertices(pe/.i)};
end;

theorem 
  for p being Simple oriented Chain of G st p=pe^qe & len pe >=
1 & len qe >= 1 & (the Source of G).(p.1) <> (the Target of G).(p.len p) holds
not (the Source of G).(p.1) in vertices qe & not (the Target of G).(p.len p) in
  vertices pe;

theorem 
  vertices pe c= V iff for i be Nat st i in dom pe holds vertices( pe/.i) c= V;

theorem 
  not vertices pe c= V implies ex i being Element of NAT, q,r
being FinSequence of the carrier' of G st i+1 <= len pe & not vertices(pe/.(i+1
  )) c= V & len q=i & pe=q^r & vertices q c= V;

theorem 
  rng qe c= rng pe implies vertices qe c= vertices pe;

theorem 
  rng qe c= rng pe & vertices(pe) \ X c= V implies vertices(qe) \ X c= V;

theorem 
  vertices(pe^qe) \ X c= V implies vertices(pe) \ X c= V &
  vertices(qe) \ X c= V;

reserve v,v1,v2,v3 for Element of G;

theorem 
  i in dom pe & (v=(the Source of G).(pe.i) or v=(the Target of G)
  .(pe.i)) implies v in vertices pe;

theorem 
  len pe = 1 implies vertices(pe) = vertices(pe/.1);

theorem 
  vertices pe c= vertices(pe^qe) & vertices qe c= vertices(pe^qe);

reserve p,q for oriented Chain of G;

theorem 
  p = q^pe & len q >= 1 & len pe = 1 implies vertices(p) =
  vertices(q) \/ {(the Target of G).(pe.1)};

theorem 
  v <> (the Source of G).(p.1) & v in vertices(p) implies ex i st
  1<=i & i <= len p & v = (the Target of G).(p.i);

begin 

definition
  let G, p, v1,v2;
  pred p is_orientedpath_of v1,v2 means


  p <> {} & (the Source of G).(p. 1) = v1 & (the Target of G).(p.(len p))= v2;
end;

definition
  let G, v1,v2, p,V;
  pred p is_orientedpath_of v1,v2,V means


  p is_orientedpath_of v1,v2 & vertices(p) \ {v2} c= V;
end;

definition
  let G be Graph, v1,v2 be Element of G;
  func OrientedPaths(v1,v2) -> Subset of ((the carrier' of G)*) equals

  {p
  where p is oriented Chain of G : p is_orientedpath_of v1,v2};
end;

theorem 
  p is_orientedpath_of v1,v2 implies v1 in vertices p & v2 in vertices p;

theorem 
  x in OrientedPaths(v1,v2) iff ex p st p=x & p is_orientedpath_of v1,v2;

theorem 
  p is_orientedpath_of v1,v2,V & v1 <> v2 implies v1 in V;

theorem 
  p is_orientedpath_of v1,v2,V & V c= U implies p is_orientedpath_of v1,v2,U;

theorem 
  len p >= 1 & p is_orientedpath_of v1,v2 & pe.1 orientedly_joins
  v2,v3 & len pe=1 implies ex q st q=p^pe & q is_orientedpath_of v1,v3;

theorem 
  q=p^pe & len p >= 1 & len pe=1 & p is_orientedpath_of v1,v2,V &
  pe.1 orientedly_joins v2,v3 implies q is_orientedpath_of v1,v3,V \/{v2};

begin 

definition
  let G be Graph, p be oriented Chain of G, v1,v2 be Element of
  G;
  pred p is_acyclicpath_of v1,v2 means


  p is Simple & p is_orientedpath_of v1,v2;
end;

definition
  let G be Graph, p be oriented Chain of G, v1,v2 be Element of
  G,V be set;
  pred p is_acyclicpath_of v1,v2,V means


  p is Simple & p is_orientedpath_of v1,v2,V;
end;

definition
  let G be Graph, v1,v2 be Element of G;
  func AcyclicPaths(v1,v2) -> Subset of ((the carrier' of G)*) equals

  {p where
  p is Simple oriented Chain of G: p is_acyclicpath_of v1,v2};
end;

definition
  let G be Graph, v1,v2 be Element of G,V be set;
  func AcyclicPaths(v1,v2,V) -> Subset of ((the carrier' of G)*) equals

  {p
  where p is Simple oriented Chain of G : p is_acyclicpath_of v1,v2,V};
end;

definition
  let G be Graph, p be oriented Chain of G;
  func AcyclicPaths(p) -> Subset of ((the carrier' of G)*) equals

  {q where q
  is Simple oriented Chain of G : q <> {} & (the Source of G).(q.1) = (the
Source of G).(p.1) & (the Target of G).(q.(len q)) = (the Target of G).(p.(len
  p)) & rng q c= rng p};
end;

definition
  let G be Graph;
  func AcyclicPaths(G) -> Subset of (the carrier' of G)* equals

  {q where q is
  Simple oriented Chain of G : not contradiction};
end;

theorem 
  p={} implies not p is_acyclicpath_of v1,v2;

theorem 
  p is_acyclicpath_of v1,v2 implies p is_orientedpath_of v1,v2;

theorem 
  AcyclicPaths(v1,v2) c= OrientedPaths(v1,v2);

theorem 
  AcyclicPaths(p) c= AcyclicPaths(G);

theorem 
  AcyclicPaths(v1,v2) c= AcyclicPaths(G);

theorem 
  p is_orientedpath_of v1,v2 implies AcyclicPaths(p) c= AcyclicPaths(v1,v2);

theorem 
  p is_orientedpath_of v1,v2,V implies AcyclicPaths(p) c= AcyclicPaths(v1,v2,V)
;

theorem 
  q in AcyclicPaths(p) implies len q <= len p;

theorem 
  p is_orientedpath_of v1,v2 implies AcyclicPaths(p) <> {} &
  AcyclicPaths(v1,v2) <> {};

theorem 
  p is_orientedpath_of v1,v2,V implies AcyclicPaths(p) <> {} &
  AcyclicPaths(v1,v2,V) <> {};

theorem 
  AcyclicPaths(v1,v2,V) c= AcyclicPaths(G);

begin 

notation
 synonym Real>=0 for REAL+;
end;

definition
 redefine func Real>=0 -> Subset of REAL equals

  { r where r is Real : r >=0 };
end;

registration
  cluster Real>=0 -> non empty;
end;

definition
  let G be Graph, W be Function;
  pred W is_weight>=0of G means


  W is Function of the carrier' of G, Real>=0;
end;

definition
  let G be Graph, W be Function;
  pred W is_weight_of G means


  W is Function of (the carrier' of G), REAL;
end;

definition
  let G be Graph, p be FinSequence of the carrier' of G, W be Function;
  assume
 W is_weight_of G;
  func RealSequence(p,W) -> FinSequence of REAL means


  dom p = dom it & for i be Element of NAT st i in dom p holds it.i=W.(p.i);
end;

definition
  let G be Graph, p be FinSequence of the carrier' of G,W be Function;
  func cost(p,W) -> Real equals

  Sum RealSequence(p,W);
end;

theorem 
  W is_weight>=0of G implies W is_weight_of G;

theorem 
  for f being FinSequence of REAL st W is_weight>=0of G & f =
  RealSequence(pe,W) holds for i st i in dom f holds f.i >= 0;

theorem 
  rng qe c= rng pe & W is_weight_of G & i in dom qe implies ex j
  st j in dom pe & RealSequence(pe,W).j = RealSequence(qe,W).i;

theorem 
  len qe = 1 & rng qe c= rng pe & W is_weight>=0of G implies cost(qe,W)
  <= cost(pe,W);

theorem 
  W is_weight>=0of G implies cost(pe,W) >= 0;

theorem 
  pe = {} & W is_weight_of G implies cost(pe,W) = 0;

theorem 
  for D being non empty finite Subset of (the carrier' of G)* st D
= AcyclicPaths(v1,v2) ex pe st pe in D & for qe st qe in D holds cost(pe,W) <=
  cost(qe,W);

theorem 
  for D being non empty finite Subset of (the carrier' of G)* st D
= AcyclicPaths(v1,v2,V) holds ex pe st pe in D & for qe st qe in D holds cost(
  pe,W) <= cost(qe,W);

theorem 
  W is_weight_of G implies cost(pe^qe,W) = cost(pe,W) + cost(qe,W);

theorem 
  qe is one-to-one & rng qe c= rng pe & W is_weight>=0of G implies
  cost(qe,W) <= cost(pe,W);

theorem 
  pe in AcyclicPaths(p) & W is_weight>=0of G implies cost(pe,W) <= cost(p,W);

begin 

definition
  let G be Graph, v1,v2 be Vertex of G, p be oriented Chain of G, W be
  Function;
  pred p is_shortestpath_of v1,v2,W means


  p is_orientedpath_of v1,v2 &
  for q being oriented Chain of G st q is_orientedpath_of v1,v2 holds cost(p,W)
  <= cost(q,W);
end;

definition
  let G be Graph, v1,v2 be Vertex of G, p be oriented Chain of G, V be set, W
  be Function;
  pred p is_shortestpath_of v1,v2,V,W means


  p is_orientedpath_of v1,v2
,V & for q being oriented Chain of G st q is_orientedpath_of v1,v2,V holds cost
  (p,W) <= cost(q,W);
end;

begin 

reserve G for finite Graph,
  ps for Simple oriented Chain of G,
  P,Q for oriented Chain of G,
  v1,v2,v3 for Element of G,
  pe,qe for FinSequence of the carrier' of G;

theorem 
  len ps <= VerticesCount G;

theorem 
  len ps <= EdgesCount G;

registration
  let G;
  cluster AcyclicPaths G -> finite;
end;

registration
  let G, P;
  cluster AcyclicPaths P -> finite;
end;

registration
  let G, v1, v2;
  cluster AcyclicPaths(v1,v2) -> finite;
end;

registration
  let G, v1, v2, V;
  cluster AcyclicPaths(v1,v2,V) -> finite;
end;

theorem 
  AcyclicPaths(v1,v2) <> {} implies ex pe st pe in AcyclicPaths(v1,v2) &
  for qe st qe in AcyclicPaths(v1,v2) holds cost(pe,W) <= cost(qe,W);

theorem 
  AcyclicPaths(v1,v2,V) <> {} implies ex pe st pe in AcyclicPaths(v1,v2,
  V) & for qe st qe in AcyclicPaths(v1,v2,V) holds cost(pe,W) <= cost(qe,W);

theorem 
  P is_orientedpath_of v1,v2 & W is_weight>=0of G implies ex q being
  Simple oriented Chain of G st q is_shortestpath_of v1,v2,W;

theorem 
  P is_orientedpath_of v1,v2,V & W is_weight>=0of G implies ex q
  being Simple oriented Chain of G st q is_shortestpath_of v1,v2,V,W;

begin 

theorem 
  W is_weight>=0of G & P is_shortestpath_of v1,v2,V,W & v1 <> v2 &
  (for Q, v3 st not v3 in V & Q is_shortestpath_of v1,v3,V,W holds cost(P,W) <=
  cost(Q,W)) implies P is_shortestpath_of v1,v2,W;

theorem 
  W is_weight>=0of G & P is_shortestpath_of v1,v2,V,W & v1 <> v2 & V c=
U & (for Q, v3 st not v3 in V & Q is_shortestpath_of v1,v3,V,W holds cost(P,W)
  <= cost(Q,W)) implies P is_shortestpath_of v1,v2,U,W;

definition
  let G be Graph, pe be FinSequence of the carrier' of G, V be set, v1 be
  Vertex of G, W be Function;
  pred pe islongestInShortestpath V,v1,W means


  for v being Vertex of G
st v in V & v <> v1 ex q being oriented Chain of G st q is_shortestpath_of v1,v
  ,V,W & cost(q,W) <= cost(pe,W);
end;


theorem 
  for G being finite oriented Graph, P,Q,R being oriented Chain of G, v1
  ,v2,v3 being Element of G st e in the carrier' of G & W
is_weight>=0of G & len P >= 1 & P is_shortestpath_of v1,v2,V,W & v1 <> v2 & v1
<> v3 & R=P^<*e*> & Q is_shortestpath_of v1,v3,V,W & e orientedly_joins v2,v3 &
  P islongestInShortestpath V,v1,W holds (cost(Q,W) <= cost(R,W) implies Q
  is_shortestpath_of v1,v3,V \/{v2},W) & (cost(Q,W) >= cost(R,W) implies R
  is_shortestpath_of v1,v3,V \/{v2},W);














begin 

definition
  let V be RealLinearSpace;
  func ConvexComb(V) -> set means


  for L being set holds L in it iff L is Convex_Combination of V;
end;

definition
  let V be RealLinearSpace, M be non empty Subset of V;
  func ConvexComb(M) -> set means

  for L being set holds L in it iff L is Convex_Combination of M;
end;

theorem 
  for V being RealLinearSpace, v being VECTOR of V holds ex L being
Convex_Combination of V st Sum(L) = v & for A being non empty Subset of V st v
  in A holds L is Convex_Combination of A;

theorem 
  for V being RealLinearSpace, v1,v2 being VECTOR of V st v1 <> v2 holds
ex L being Convex_Combination of V st for A being non empty Subset of V st {v1,
  v2} c= A holds L is Convex_Combination of A;

theorem 
  for V being RealLinearSpace, v1,v2,v3 being VECTOR of V st v1 <> v2 &
v1 <> v3 & v2 <> v3 holds ex L being Convex_Combination of V st for A being non
  empty Subset of V st {v1,v2,v3} c= A holds L is Convex_Combination of A;

theorem 
  for V being RealLinearSpace, M being non empty Subset of V holds M is
convex iff {Sum(L) where L is Convex_Combination of M : L in ConvexComb(V)} c=
  M;

theorem 
  for V being RealLinearSpace, M being non empty Subset of V holds conv(
  M) = {Sum(L) where L is Convex_Combination of M : L in ConvexComb(V)};

begin 

definition
  let V be non empty RLSStruct, M be Subset of V;
  attr M is cone means


  for r being Real, v being VECTOR of V st r > 0 & v in M holds r*v in M;
end;

theorem 
  for V being non empty RLSStruct, M being Subset of V st M = {}
  holds M is cone;

registration
  let V be non empty RLSStruct;
  cluster cone for Subset of V;
end;

registration
  let V be non empty RLSStruct;
  cluster empty cone for Subset of V;
end;

registration
  let V be RealLinearSpace;
  cluster non empty cone for Subset of V;
end;

theorem 
  for V being non empty RLSStruct, M being cone Subset of V st V is
vector-distributive scalar-distributive scalar-associative scalar-unital
 holds M is convex iff for u,v being VECTOR of V st u in M
  & v in M holds u + v in M;

theorem 
  for V being RealLinearSpace, M being Subset of V holds M is convex & M
  is cone iff for L being Linear_Combination of M st Carrier L <> {} & for v
  being VECTOR of V st v in Carrier L holds L.v > 0 holds Sum(L) in M;

theorem 
  for V being non empty RLSStruct, M,N being Subset of V st M is cone &
  N is cone holds M /\ N is cone;















begin 

reserve i,j,k,n,m for Nat,
  x,y,z,y1,y2,X,Y,D for set,
  p,q for XFinSequence;


theorem 
  x in i implies x is Element of NAT;

registration
  cluster -> natural-membered for Nat;
end;

begin 

theorem 
  for X0 being finite natural-membered set holds ex n st X0 c= n;

theorem 
x in rng p implies ex
  i being Element of NAT st i in dom p & p.i = x;

theorem 
  for p st for i st i in dom p holds p.i in D
   holds p is XFinSequence of D;

scheme 

  XSeqLambdaD{i()->Nat,D()->non empty set,F(set)->Element of D()}:
  ex p being XFinSequence of D() st len p = i() &
    for j st j in i() holds p.j = F(j);



registration
  cluster empty natural-valued for XFinSequence;
  let p be complex-valued T-Sequence-like Function;
  cluster -p -> T-Sequence-like;
  cluster p" -> T-Sequence-like;
  cluster p^2 -> T-Sequence-like;
cluster abs p -> T-Sequence-like;
  let q be complex-valued T-Sequence-like Function;
  cluster p+q -> T-Sequence-like;
  cluster p-q -> T-Sequence-like;
  cluster p(#)q -> T-Sequence-like;
  cluster p/"q -> T-Sequence-like;
end;

registration
  let p be complex-valued finite Function;
  cluster -p -> finite;
  cluster p" -> finite;
  cluster p^2 -> finite;
  cluster abs p -> finite;
  let q be complex-valued Function;
  cluster p+q -> finite;
  cluster p-q -> finite;
  cluster p(#)q -> finite;
  cluster p/"q -> finite;
  cluster q/"p -> finite;
end;

registration
  let p be complex-valued T-Sequence-like Function;
  let c be complex number;
  cluster c+p -> T-Sequence-like;
  cluster p-c -> T-Sequence-like;
  cluster c(#)p -> T-Sequence-like;
end;

registration
  let p be complex-valued finite Function;
  let c be complex number;
  cluster c+p -> finite;
  cluster p-c -> finite;
  cluster c(#)p -> finite;
end;



definition
  let p;
  func Rev p -> XFinSequence means


  len it = len p & for i st i in dom it holds it.i = p.(len p - (i + 1));
end;

theorem 
  dom p = dom Rev p & rng p = rng Rev p;

registration
  let D be set, f be XFinSequence of D;
  cluster Rev f -> D -valued;
end;



definition
  let p,n;
  func p /^ n -> XFinSequence means


  len it = len p -' n & for m st m in dom it holds it.m = p.(m+n);
end;

theorem 
  n >= len p implies p/^n={};

theorem 
  n < len p implies len (p/^n) = len p -n;

theorem 
  m+n<len p implies (p/^n).m = p.(m+n);

registration
  let f be one-to-one XFinSequence, n;
  cluster f/^n -> one-to-one;
end;

theorem 
  rng (p/^n) c= rng p;

theorem 
 p/^0 = p;

theorem 
  (p^q)/^(len p + i) = q/^i;

theorem 
  (p^q)/^(len p) = q;

theorem 
  (p|n)^(p/^n) = p;

registration
  let D be set, f be XFinSequence of D, n;
  cluster f /^ n -> D -valued;
end;

reserve k1,k2 for Nat;

definition
  let p,k1,k2;
  func mid(p,k1,k2) -> XFinSequence equals

  (p|k2)/^(k1-'1);
end;

theorem 
  k1>k2 implies mid(p,k1,k2) = {};

theorem 
  1<=k1 & k2<=len p implies mid(p,k1,k2) = (p/^(k1-'1))|(k2+1-'k1);

theorem 
  mid(p,1,k)=p|k;

theorem 
  len p<=k implies mid(p,1,k)=p;

theorem 
  mid(p,0,k)=mid(p,1,k);

theorem 
  mid(p^q,len p+1,len p+len q)=q;

registration
  let D be set, f be XFinSequence of D, k1,k2;
  cluster mid(f,k1,k2) -> D-valued;
end;



begin 

definition
  let X be finite natural-membered set;
  func Sgm0 X -> XFinSequence of NAT means


  rng it = X & for l,m,k1,k2
  being Nat st l < m & m < len it & k1=it.l & k2=it.m holds k1 < k2;
end;

registration
  let A be finite natural-membered set;
  cluster Sgm0 A -> one-to-one;
end;

theorem 
  for A being finite natural-membered set holds len(Sgm0 A) = card A;

theorem 
  for X,Y being finite natural-membered set st X c= Y & X <> {}
  holds (Sgm0 Y).0 <= (Sgm0 X).0;

theorem 
  (Sgm0 {n}).0=n;

definition
  let B1,B2 be set;
  pred B1 <N< B2 means


  for n,m being Nat st n in B1 & m in B2 holds n<m;
end;

definition
  let B1,B2 be set;
  pred B1 <N= B2 means


  for n,m st n in B1 & m in B2 holds n <= m;
end;

theorem 
  for B1,B2 being set st B1 <N< B2 holds B1/\B2/\NAT={};

theorem 
  for B1,B2 being finite natural-membered set st B1 <N< B2 holds
  B1 misses B2;

theorem 
  for A,B1,B2 being set st B1 <N< B2 holds A/\ B1 <N< A/\B2;

theorem 
  for X,Y being finite natural-membered set st Y <> {} & (ex x being set
  st x in X & {x} <N= Y) holds (Sgm0 X).0 <= (Sgm0 Y).0;

theorem 
  for X0,Y0 being finite natural-membered set st
    X0 <N< Y0 & i < (card X0) holds
  rng((Sgm0 (X0\/Y0))|(card X0))=X0 &
  ((Sgm0 (X0\/Y0))|(card X0)).i = (Sgm0 (X0 \/ Y0)).i;

theorem 
  for X,Y being finite natural-membered set st
     X <N< Y & i in card (X) holds (Sgm0 (X\/Y)).i in X;

theorem 
  for X,Y being finite natural-membered set st X <N<
  Y & i< len (Sgm0 X) holds (Sgm0 X).i = (Sgm0 (X \/ Y)).i;

theorem 
  for X0,Y0 being finite natural-membered set st X0
<N< Y0 & i < (card Y0) holds rng((Sgm0 (X0\/Y0))/^(card X0))=Y0 & ((Sgm0 (X0\/
  Y0))/^(card X0)).i = (Sgm0 (X0 \/ Y0)).(i+(card X0));

theorem 
  for X,Y being finite natural-membered set st X <N< Y
  & i< len (Sgm0 Y) holds (Sgm0 Y).i = (Sgm0 (X \/ Y)).(i+len (Sgm0 X));

theorem 
  for X,Y being finite natural-membered set st Y <> {} & X <N< Y
  holds (Sgm0 Y).0 = (Sgm0 (X \/ Y)).(len (Sgm0 X));

theorem 
  for l,m,n,k being Nat,X being finite natural-membered set st k <
  l & m < len(Sgm0 X) & (Sgm0(X)).m = k & (Sgm0(X)).n = l holds m < n;

theorem 
  for X,Y being finite natural-membered set st X <> {} & X <N< Y
  holds (Sgm0 X).0 = (Sgm0 (X \/ Y)).0;

theorem 
  for X,Y being finite natural-membered set holds
X <N< Y iff Sgm0(X \/Y) = Sgm0(X) ^ Sgm0(Y);

definition
  let f be XFinSequence;
  let B be set;
  
  func SubXFinS (f,B) -> XFinSequence equals

  f*Sgm0(B /\ len f);
end;

theorem 
  for B being set holds len SubXFinS (p,B)=
   card (B/\ (len p)) &
  for i st i < len SubXFinS (p,B) holds SubXFinS
  (p,B).i=p.((Sgm0 (B/\ (len p))).i);

registration
  let D be set;
  let f be XFinSequence of D, B be set;
  cluster SubXFinS(f,B) -> D-valued;
end;

registration
  let p;
  cluster SubXFinS (p,{}) -> empty;
end;

registration
  let B be set;
  cluster SubXFinS ({},B) -> empty;
end;

 

reserve D for non empty set,
  F,G for XFinSequence of D,
  b for BinOp of D,
  d,d1,d2 for Element of D;

registration
  let n be Nat;
  let x be set;
  cluster n --> x -> T-Sequence-like;
end;

scheme 

  Sch5{D()->set, P[set]}: for F be XFinSequence of D() holds P[F]
provided
 P[<%>D()] and
 for F be XFinSequence of D(),d be Element of D() st P[F] holds P[F^<%d%>];

definition
  let D;
  let F be XFinSequence;
  assume F is D-valued;
  let b;
  assume  b is having_a_unity or len F >= 1;
  func b "**" F -> Element of D means

  it = the_unity_wrt b if b is having_a_unity & len F = 0
    otherwise ex f be Function of NAT,D st f.0 = F.0 &
   (for n st n+1 < len F holds f.(n + 1) = b.(f.n,F.(n + 1))) &
it = f.(len F-1);
end;

theorem 
  b "**" <%d%> = d;

theorem 
  b "**" <%d1,d2%> = b.(d1,d2);

theorem 
  b "**" <%d,d1,d2%> = b.(b.(d,d1),d2);

theorem 
  b is having_a_unity or len F > 0 implies b "**" (F ^ <% d %>) =
  b.(b "**" F,d);

theorem 
  b is associative & (b is having_a_unity or len F >= 1 & len G >= 1)
  implies b "**" (F ^ G) = b.(b "**" F,b "**" G);

theorem 
  b is associative & (b is having_a_unity or len F >= 1 & len G >= 1)
  implies b "**" (F ^ G) = b.(b "**" F,b "**" G);


theorem 
  n in dom F & (b is having_a_unity or n <> 0 ) implies
   b.(b "**" F|n, F.n) = b "**" F|(n+1);

theorem 
b is having_a_unity or len F >= 1 implies b "**" F = b "**" (XFS2FS F);

theorem 
  for P be Permutation of dom F st b is commutative associative &
    (b is having_a_unity or len F >= 1) &
    G = F * P holds b "**" F = b "**" G;

theorem 
  for bFG be XFinSequence of D st b is commutative associative &
         (b is having_a_unity or len F >= 1) &
         len F=len G & len F=len bFG &
         (for n st n in dom bFG holds bFG.n=b.(F.n,G.n))
  holds b "**" F^G = b "**" bFG;

theorem 
  for D1,D2 be non empty set
    for b1 be BinOp of D1,b2 be BinOp of D2 st
        len F >= 1 &
        D c= D1 /\ D2 &
        for x,y st x in D & y in D holds b1.(x,y)=b2.(x,y) & b1.(x,y) in D
    holds b1 "**" F = b2 "**" F;

reserve F for XFinSequence,
        rF,rF1,rF2 for real-valued XFinSequence,
        r for real number,
        cF,cF1,cF2 for complex-valued XFinSequence,
        c,c1,c2 for complex number;

definition
  let F;
  func Sum F ->Element of COMPLEX equals

    addcomplex "**" F;
end;

registration
  let f be empty complex-valued XFinSequence;
  cluster Sum f -> zero;
end;

theorem 
   F is real-valued implies Sum F = addreal "**" F;

theorem 
  F is RAT-valued implies Sum F = addrat "**" F;

theorem 
  F is INT-valued implies Sum F = addint "**" F;

theorem 
  F is natural-valued implies Sum F = addnat "**" F;

registration
  let F be real-valued XFinSequence;
  cluster Sum F -> real;
end;

registration
  let F be RAT-valued XFinSequence;
  cluster Sum F -> rational;
end;

registration
  let F be INT-valued XFinSequence;
  cluster Sum F -> integer;
end;

registration
  let F be natural-valued XFinSequence;
  cluster Sum F -> natural;
end;

registration
  cluster natural-valued -> nonnegative-yielding for Relation;
end;

theorem 
  cF = {} implies Sum cF = 0;

theorem 
   Sum <%c%> = c;

theorem 
   Sum <%c1,c2%> = c1 + c2;

theorem 
  Sum(cF1^cF2)=Sum(cF1)+Sum(cF2);

theorem 
  for S being Real_Sequence st rF=S|(n+1) holds Sum rF = Partial_Sums(S).n;

theorem 
  len rF1 = len rF2 &
  (for i st i in dom rF1 holds rF1.i<=rF2.i) implies
  Sum rF1 <= Sum rF2;

theorem 
  Sum (n-->c) = n*c;

theorem 
  (for n st n in dom rF holds rF.n <= r) implies
   Sum rF <= len rF * r;

theorem 
  (for n st n in dom rF holds rF.n >= r) implies
  Sum rF >= len rF *r;

theorem 
  rF is nonnegative-yielding & len rF > 0 &
  (ex x st x in dom rF & rF.x = r) implies Sum rF >= r;

theorem 
  rF is nonnegative-yielding implies
  (Sum rF=0 iff (len rF=0 or rF = len rF --> 0));

theorem 
  c(#)cF|n = (c(#)cF)|n;

theorem 
  c * Sum cF = Sum (c(#)cF);

theorem 
   n in dom cF implies Sum (cF|n) + cF.n = Sum (cF|(n+1));

theorem 
for f be Function st
  f.y=x & y in dom f holds {y}\/(f|(dom f\{y}))"{x}=f"{x};

theorem 
 for f be Function st f.y<>x holds (f|(dom f\{y}))"{x}=f"{x};

theorem 
  rng cF c= {0,c} implies Sum cF = c * card (cF"{c});

theorem 
  Sum cF = Sum Rev cF;

theorem 
  for f be Function,p,q,fp,fq be XFinSequence st
       rng p c= dom f & rng q c= dom f & fp = f*p & fq = f*q
    holds fp ^ fq = f*(p^q);

theorem 
  for B1,B2 being finite natural-membered set st
     B1 <N< B2 holds
Sum (SubXFinS(cF,B1\/B2))=Sum (SubXFinS(cF,B1))+Sum(SubXFinS(cF,B2));



theorem 
 b is having_a_unity implies b "**" <%>D = the_unity_wrt b;


definition
  let D be set, F be XFinSequence of D^omega;
  func FlattenSeq F -> Element of D^omega means


  ex g being BinOp of D^omega st
  (for p, q being Element of D^omega holds g.(p,q) = p^q) & it = g "**" F;
end;

theorem 
  for D being set, d be Element of D^omega holds FlattenSeq <%d%> = d;

theorem 
  for D being set holds FlattenSeq <%>(D^omega) = <%>D;

theorem 
  for D being set, F,G be XFinSequence of D^omega holds
  FlattenSeq (F ^ G) = FlattenSeq F ^ FlattenSeq G;

theorem 
  for D being set, p,q be Element of D^omega holds FlattenSeq <% p,q %> = p ^ q
;

theorem 
  for D being set, p,q,r be Element of D^omega holds
  FlattenSeq <% p,q,r %> = p ^ q ^ r;

theorem 
 p c= q implies p ^ (q /^ len p) = q;

reserve r,s for XFinSequence;

theorem 
 p c= q implies ex r st p^r = q;

theorem 
 for p,q being XFinSequence of D st p c= q
  ex r being XFinSequence of D st p^r = q;

theorem 
 q c= r implies p^q c= p^r;

theorem 
  for D being set, F,G be XFinSequence of D^omega holds
  F c= G implies FlattenSeq F c= FlattenSeq G;

registration let p; let q be non empty XFinSequence;
 cluster p^q -> non empty;
 cluster q^p -> non empty;
end;

theorem 
 CutLastLoc(p^<%x%>) = p;














begin

reserve k, l, m, n, i, j for Nat,
  K, N for non empty Subset of NAT,
  Ke, Ne, Me for Subset of NAT,
  X,Y for set;

theorem 
  min N = min* N;

theorem 
  min(min K,min N) = min(K\/N);

theorem 
  min(min* Ke,min* Ne) <= min* (Ke\/Ne);

theorem 
  not min* Ne in Ne/\Ke implies min* Ne = min* (Ne\Ke);

theorem 
for n be Element of NAT holds min* {n} = n & min {n} = n;

theorem 
for n,k be Element of NAT holds min* {n,k} = min(n,k) & min {n,k} = min(n,k);

theorem 
for n,k,l be Element of NAT holds min* {n,k,l} = min(n,min(k,l));

theorem 
  n is Subset of NAT;

registration
  let n;
  cluster -> natural for Element of n;
end;

theorem 
  N c= n implies n-1 is Element of NAT;

theorem 
  k in n implies k<=n-1 & n-1 is Element of NAT;

theorem 
  min* n = 0;

theorem 
  N c= n implies min* N <= n-1;

theorem 
  N c= n & N <> {n-1} implies min* N < n-1;

theorem 
  Ne c= n & n>0 implies min* Ne <= n-1;

reserve f for Function of n,k;

definition
  let n,X;
  let f be Function of n,X;
  let x be set;
  redefine func f"x -> Subset of NAT;
end;

definition
  let X,k;
  let f be Function of X,k;
  let x be set;
  redefine func f.x -> Element of k;
end;

definition
  let n,k be Nat;
  let f be Function of n,k;
  attr f is "increasing means


  (n = 0 iff k = 0) & for l,m st l in rng f
  & m in rng f & l < m holds min* f"{l} < min* f"{m};
end;

theorem 
  n=0 & k=0 implies f is onto "increasing;

theorem 
  n>0 implies min* f"{m} <= n-1;

theorem 
  f is onto implies n>=k;

theorem 
  f is onto "increasing implies for m st m < k holds m <= min* f"{ m};

theorem 
  f is onto "increasing implies for m st m < k holds min* f"{m} <= n-k+m;

theorem 
  f is onto "increasing & n = k implies f = id n;

theorem 
  f = id n & n > 0 implies f is "increasing;

theorem 
  (n=0 iff k=0) implies ex f be Function of n,k st f is "increasing;

theorem 
  (n=0 iff k=0) & n>=k implies ex f be Function of n,k st f is onto "increasing
;

scheme 

  Sch1{n,k() -> Nat,P[set]}: {f where f is Function of n(),k():P[f]} is finite;

theorem 
  for n,k holds {f where f is Function of n,k:f is onto "increasing} is finite;

theorem 
  for n,k holds card {f where f is Function of n,k:f is  onto "increasing}
    is Element of NAT;



definition
  let n,k be Nat;
  func n block k -> Element of NAT equals

  card {f where f is Function of n,k:f is onto "increasing};
end;

theorem 
  n block n = 1;

theorem 
  k<>0 implies 0 block k = 0;

theorem 
  0 block k = 1 iff k=0;

theorem 
  n<k implies n block k = 0;

theorem 
  n block 0 = 1 iff n=0;

theorem 
  n<>0 implies n block 0 = 0;

theorem 
  n<>0 implies n block 1 = 1;

theorem 
  1<=k & k <=n or k=n iff n block k > 0;

reserve x,y for set;

scheme 

  Sch2{X,Y,X1,Y1()->set,f()->Function of X(),Y(),F(set)->set}: ex h be
Function of X1(),Y1() st h|X() = f() & for x st x in X1()\X() holds h.x = F(x)
provided
 for x st x in X1()\X() holds F(x) in Y1() and
 X() c= X1() & Y() c= Y1() and
 Y() is empty implies X() is empty;

scheme 

  Sch3{X,Y,X1,Y1()->set,F(set)->set,P[set,set,set]}: card{f where f is
Function of X(),Y(): P[f,X(),Y()]}= card{f where f is Function of X1(),Y1(): P[
  f,X1(),Y1()]& rng (f|X()) c=Y()& (for x st x in X1()\X() holds f.x=F(x))}
provided
 for x st x in X1()\X() holds F(x) in Y1() and
 X() c= X1() & Y() c= Y1() and
 Y() is empty implies X() is empty and
 for f be Function of X1(),Y1() st (for x st x in X1()\X() holds F(x)
=f.x) holds P[f,X1(),Y1()] iff P[f|X(),X(),Y()];

scheme 

  Sch4{X,Y,x,y()->set,P[set,set,set]}: card{f where f is Function of X(),Y():
P[f,X(),Y()]}= card{f where f is Function of (X()\/{x()}),(Y()\/{y()}): P[f,X()
  \/{x()},Y()\/{y()}]& rng (f|X()) c=Y() & f.x()=y()}
provided
 Y() is empty implies X() is empty and
 not x() in X() and
 for f be Function of X()\/{x()},Y()\/{y()} st f.x()=y() holds P[f,X(
)\/{x()},Y()\/{y()}] iff P[f|X(),X(),Y()];

theorem 
  for f be Function of n+1,k+1 st f is onto "increasing & f"{f.n}=
  {n} holds f.n=k;

theorem 
  for f be Function of n+1,k st k<>0 & f"{f.n}<>{n} holds ex m st
  m in f"{f.n} & m<>n;

theorem 
  for f be Function of n,k, g be Function of n+m,k+l st g is
"increasing & f=g|n holds for i,j st i in rng f & j in rng f & i<j holds min* f
  "{i} < min* f"{j};

theorem 
  for f be Function of n+1,k+1 st f is onto "increasing & f"{f.n}=
  {n} holds rng (f|n) c= k & for g be Function of n,k st g=f|n holds g is onto
  "increasing;

theorem 
  for f be Function of n+1,k,g be Function of n,k st f is onto
  "increasing & f"{f.n}<>{n} & f|n =g holds g is onto "increasing;

theorem 
  for f be Function of n,k, g be Function of n+1,k+m st f is onto
"increasing & f=g|n holds for i,j st i in rng g & j in rng g & i<j holds min* g
  "{i} < min* g"{j};

theorem 
  for f be Function of n,k, g be Function of n+1,k+1 st f is onto
  "increasing & f=g|n & g.n = k holds g is onto "increasing & g"{g.n}={n};

theorem 
  for f be Function of n,k, g be Function of n+1,k st f is onto
  "increasing & f=g|n & g.n < k holds g is onto "increasing & g"{g.n}<>{n};

theorem 
  card{f where f is Function of n+1,k+1: f is onto "increasing & f
  "{f.n}={n}}= card{f where f is Function of n,k: f is onto "increasing};

theorem 
  for l st l<k holds card{f where f is Function of n+1,k: f is
onto "increasing & f"{f.n}<>{n} & f.n=l}= card{f where f is Function of n,k: f
  is onto "increasing};

theorem 
  for f be Function, n holds union (rng (f|n)) \/ f.n=union rng (f |(n+1));

scheme 
 Sch6{D()->non empty set,n()->Nat,P[set,set]}:
  ex p be XFinSequence of D() st dom p = n() & for k st k in n() holds P[k,p.k]
provided
 for k st k in n() ex x be Element of D() st P[k,x];

scheme 

  Sch8{X,Y()->finite set,x()->set,P[set],f()->Function of card Y(),Y()}: ex F
be XFinSequence of NAT st dom F = card Y() & card{g where g is Function of X(),
Y():P[g]} = Sum(F) & for i st i in dom F holds F.i = card{g where g is Function
  of X(),Y(): P[g] & g.x()=f().i}
provided
 f() is onto one-to-one and
 Y() is non empty and
 x() in X();

theorem 
k * (n block k)= card{f where f is
  Function of n+1,k: f is onto "increasing & f"{f.n}<>{n}};



theorem 
(n+1) block (k+1) = (k+1)*(n block (k+1) ) + (n block k);

theorem 
n>=1 implies n block 2 = 1/2 * (2 |^ n - 2 );

theorem 
  n >= 2 implies n block 3 = 1/6 * ( 3 |^ n - 3 * 2 |^ n + 3 );

theorem 
  n >= 3 implies n block 4 = 1/24 * ( 4 |^ n - 4 * 3 |^ n + 6* 2|^ n - 4 );

theorem 
  3! = 6 & 4! = 24;

theorem 
  n choose 1=n & n choose 2=n*(n-1)/2 & n choose 3=n*(n-1)*(n-2)/6
  & n choose 4=n*(n-1)*(n-2)*(n-3)/24;

theorem 
  (n + 1) block n = (n + 1) choose 2;

theorem 
  (n + 2) block n = 3*((n + 2) choose 4) + ((n + 2) choose 3);

theorem 
  for F be Function,y holds rng (F|(dom F\F"{y}))=rng F\{y} & for
  x st x<>y holds (F|(dom F\F"{y}))"{x}=F"{x};

theorem 
  card X=k+1 & x in X implies card (X\{x})=k;

scheme 

  Sch9{P[set],Q[set,Function]}: for F be Function st rng F is finite holds P[F
  ]
provided
 P[{}] and
 for F be Function st for x st x in rng F & Q[x,F] holds P[F|(dom F\F
"{x})] holds P[F];

theorem 
  for N be Subset of NAT st N is finite ex k st for n st n in N holds n<=k;

theorem 
  for X,Y,x,y st (Y is empty implies X is empty) & not x in X for
  F be Function of X,Y ex G be Function of X\/{x},Y\/{y} st G|X = F & G.x=y;

theorem 
  for X,Y,x,y st (Y is empty implies X is empty) for F be Function
  of X,Y,G be Function of X\/{x},Y\/{y} st G|X=F & G.x=y holds ( F is onto
  implies G is onto) & ( not y in Y & F is one-to-one implies G is one-to-one);

theorem 
  for N be finite Subset of NAT holds ex Order be Function of N,
card N st Order is bijective & for n,k st n in dom Order & k in dom Order & n<k
  holds Order.n < Order.k;

theorem 
  for X,Y be finite set,F be Function of X,Y st card X=card Y
  holds F is onto iff F is one-to-one;

theorem 
  for F,G be Function,y st y in rng (G*F) & G is one-to-one holds
  ex x st x in dom G & x in rng F & G"{y}={x} & F"{x}=(G*F)"{y};

definition
  let Ne,Ke;
  let f be Function of Ne,Ke;
  attr f is "increasing means


  for l,m st l in rng f & m in rng f & l < m holds min* f"{l} < min* f"{m};
end;

theorem 
  for F be Function of Ne,Ke st F is "increasing holds min* rng F= F.min* dom F
;



theorem 
  for F be Function of Ne,Ke st rng F is finite ex I be Function of Ne,
  Ke,P be Permutation of rng F st F=P*I & rng F=rng I & I is "increasing;



theorem 
  for F be Function of Ne,Ke st rng F is finite for I1,I2 be
  Function of Ne,Me,P1,P2 be Function st P1 is one-to-one & P2 is one-to-one &
  rng I1=rng I2 & rng I1=dom P1 & dom P1=dom P2 & F=P1*I1 & F=P2*I2 & I1 is
  "increasing & I2 is "increasing holds P1=P2 & I1=I2;

theorem 
  for F be Function of Ne,Ke st rng F is finite for I1,I2 be Function of
Ne,Ke, P1,P2 be Permutation of rng F st F=P1*I1 & F=P2*I2 & rng F=rng I1 & rng
  F=rng I2 & I1 is "increasing & I2 is "increasing holds P1=P2 & I1=I2;


theorem 
  for D be non empty set, F be XFinSequence of D st
  (for i st i in dom F holds F.i is finite) &
  (for i,j st i in dom F & j in dom F & i<>j holds F.i misses F.j)
  ex CardF be XFinSequence of NAT st dom CardF = dom F &
  (for i st i in dom CardF holds CardF.i=card (F.i)) &
  card union rng F = Sum(CardF);














begin



scheme 
 AltCatStrLambda { A() -> non empty set, B(set,set) -> set,
  C(set,set,set,set,set) -> set }:
  ex C being strict non empty transitive AltCatStr st the carrier of C = A() &
  (for a,b being object of C holds <^a,b^> = B(a,b)) &
  for a,b,c being object of C st <^a,b^> <> {} & <^b,c^> <> {}
  for f being Morphism of a,b, g being Morphism of b,c
  holds g*f = C(a,b,c,f,g)
provided
 for a,b,c being Element of A(), f,g being set
st f in B(a,b) & g in B(b,c) holds C(a,b,c,f,g) in B(a,c);

scheme 
 CatAssocSch { A() -> non empty transitive AltCatStr,
  C(set,set,set,set,set) -> set }: A() is associative
provided
 for a,b,c being object of A() st <^a,b^> <> {} & <^b,c^> <> {}
for f being Morphism of a,b, g being Morphism of b,c holds g*f = C(a,b,c,f,g)
and
 for a,b,c,d being object of A(), f,g,h being set
st f in <^a,b^> & g in <^b,c^> & h in <^c,d^>
holds C(a,c,d,C(a,b,c,f,g),h) = C(a,b,d,f,C(b,c,d,g,h));

scheme 
 CatUnitsSch { A() -> non empty transitive AltCatStr,
  C(set,set,set,set,set) -> set }: A() is with_units
provided
 for a,b,c being object of A() st <^a,b^> <> {} & <^b,c^> <> {}
for f being Morphism of a,b, g being Morphism of b,c holds g*f = C(a,b,c,f,g)
and
 for a being object of A() ex f being set st f in <^a,a^> &
for b being object of A(), g being set st g in <^a,b^> holds C(a,a,b,f,g) = g
and
 for a being object of A() ex f being set st f in <^a,a^> &
for b being object of A(), g being set st g in <^b,a^> holds C(b,a,a,g,f) = g;

scheme 
 CategoryLambda { A() -> non empty set, B(set,set) -> set,
  C(set,set,set,set,set) -> set }: ex C being strict category st
  the carrier of C = A() &
  (for a,b being object of C holds <^a,b^> = B(a,b)) &
  for a,b,c being object of C st <^a,b^> <> {} & <^b,c^> <> {}
  for f being Morphism of a,b, g being Morphism of b,c
  holds g*f = C(a,b,c,f,g)
provided
 for a,b,c being Element of A(), f,g being set
st f in B(a,b) & g in B(b,c) holds C(a,b,c,f,g) in B(a,c) and
 for a,b,c,d being Element of A(), f,g,h being set
st f in B(a,b) & g in B(b,c) & h in B(c,d)
holds C(a,c,d,C(a,b,c,f,g),h) = C(a,b,d,f,C(b,c,d,g,h)) and
 for a being Element of A() ex f being set st f in B(a,a) &
for b being Element of A(), g being set st g in B(a,b) holds C(a,a,b,f,g) = g
and
 for a being Element of A() ex f being set st f in B(a,a) &
for b being Element of A(), g being set st g in B(b,a) holds C(b,a,a,g,f) = g;

scheme 
 CategoryLambdaUniq { A() -> non empty set, B(set,set) -> set,
  C(set,set,set,set,set) -> set }:
  for C1,C2 being non empty transitive AltCatStr st the carrier of C1 = A() &
  (for a,b being object of C1 holds <^a,b^> = B(a,b)) &
  (for a,b,c being object of C1 st <^a,b^> <> {} & <^b,c^> <> {}
  for f being Morphism of a,b, g being Morphism of b,c
  holds g*f = C(a,b,c,f,g)) & the carrier of C2 = A() &
  (for a,b being object of C2 holds <^a,b^> = B(a,b)) &
  (for a,b,c being object of C2 st <^a,b^> <> {} & <^b,c^> <> {}
  for f being Morphism of a,b, g being Morphism of b,c
  holds g*f = C(a,b,c,f,g)) holds the AltCatStr of C1 = the AltCatStr of C2;

scheme 
 CategoryQuasiLambda { A() -> non empty set, P[set,set,set],
  B(set,set) -> set, C(set,set,set,set,set) -> set }:
  ex C being strict category st the carrier of C = A() &
  (for a,b being object of C
  for f being set holds f in <^a,b^> iff f in B(a,b) & P[a,b,f]) &
  for a,b,c being object of C st <^a,b^> <> {} & <^b,c^> <> {}
  for f being Morphism of a,b, g being Morphism of b,c
  holds g*f = C(a,b,c,f,g)
provided
 for a,b,c being Element of A(), f,g being set
st f in B(a,b) & P[a,b,f] & g in B(b,c) & P[b,c,g]
holds C(a,b,c,f,g) in B(a,c) & P[a,c, C(a,b,c,f,g)] and
 for a,b,c,d being Element of A(), f,g,h being set
st f in B(a,b) & P[a,b,f] & g in B(b,c) & P[b,c,g] & h in B(c,d) & P[c,d,h]
holds C(a,c,d,C(a,b,c,f,g),h) = C(a,b,d,f,C(b,c,d,g,h)) and
 for a being Element of A() ex f being set st f in B(a,a) & P[a,a,f] &
for b being Element of A(), g being set st g in B(a,b) & P[a,b,g]
holds C(a,a,b,f,g) = g and
 for a being Element of A() ex f being set st f in B(a,a) & P[a,a,f] &
for b being Element of A(), g being set st g in B(b,a) & P[b,a,g]
holds C(b,a,a,g,f) = g;

registration
  let f be Function-yielding Function;
  let a,b,c be set;
  cluster f.(a,b,c) -> Relation-like Function-like;
end;

scheme 
 SubcategoryEx { A() -> category, P[set], Q[set,set,set]}:
  ex B being strict non empty subcategory of A() st
  (for a being object of A() holds a is object of B iff P[a]) &
  for a,b being object of A(), a9,b9 being object of B
  st a9 = a & b9 = b & <^a,b^> <> {}
  for f being Morphism of a,b holds f in <^a9,b9^> iff Q[a,b,f]
provided
 ex a being object of A() st P[a] and
 for a,b,c being object of A()
st P[a] & P[b] & P[c] & <^a,b^> <> {} & <^b,c^> <> {}
for f being Morphism of a,b, g being Morphism of b,c st Q[a,b,f] & Q[b,c,g]
holds Q[a,c,g*f] and
 for a being object of A() st P[a] holds Q[a,a, idm a];

scheme 
 CovariantFunctorLambda { A,B() -> category, O(set) -> set,
  F(set,set,set) -> set }: ex F being covariant strict Functor of A(),B() st
  (for a being object of A() holds F.a = O(a)) &
  for a,b being object of A() st <^a,b^> <> {}
  for f being Morphism of a,b holds F.f = F(a,b,f)
provided
 for a being object of A() holds O(a) is object of B() and
 for a,b being object of A() st <^a,b^> <> {} for f being Morphism of a,b
holds F(a,b,f) in (the Arrows of B()).(O(a), O(b)) and
 for a,b,c being object of A() st <^a,b^> <> {} & <^b,c^> <> {}
for f being Morphism of a,b, g being Morphism of b,c
for a9,b9,c9 being object of B() st a9 = O(a) & b9 = O(b) & c9 = O(c)
for f9 being Morphism of a9,b9, g9 being Morphism of b9,c9
st f9 = F(a,b,f) & g9 = F(b,c,g) holds F(a,c,g*f) = g9*f9 and
 for a being object of A(), a9 being object of B() st a9 = O(a)
holds F(a,a,idm a) = idm a9;

theorem 
  for A,B being category, F,G being covariant Functor of A,B
  st (for a being object of A holds F.a = G.a) &
  (for a,b being object of A st <^a,b^> <> {}
  for f being Morphism of a,b holds F.f = G.f)
  holds the FunctorStr of F = the FunctorStr of G;

scheme 
 ContravariantFunctorLambda { A,B() -> category, O(set) -> set,
  F(set,set,set) -> set }:
  ex F being contravariant strict Functor of A(),B() st
  (for a being object of A() holds F.a = O(a)) &
  for a,b being object of A() st <^a,b^> <> {}
  for f being Morphism of a,b holds F.f = F(a,b,f)
provided
 for a being object of A() holds O(a) is object of B() and
 for a,b being object of A() st <^a,b^> <> {} for f being Morphism of a,b
holds F(a,b,f) in (the Arrows of B()).(O(b), O(a)) and
 for a,b,c being object of A() st <^a,b^> <> {} & <^b,c^> <> {}
for f being Morphism of a,b, g being Morphism of b,c
for a9,b9,c9 being object of B() st a9 = O(a) & b9 = O(b) & c9 = O(c)
for f9 being Morphism of b9,a9, g9 being Morphism of c9,b9
st f9 = F(a,b,f) & g9 = F(b,c,g) holds F(a,c,g*f) = f9*g9 and
 for a being object of A(), a9 being object of B() st a9 = O(a)
holds F(a,a,idm a) = idm a9;

theorem 
  for A,B being category, F,G being contravariant Functor of A,B
  st (for a being object of A holds F.a = G.a) &
  (for a,b being object of A st <^a,b^> <> {}
  for f being Morphism of a,b holds F.f = G.f)
  holds the FunctorStr of F = the FunctorStr of G;

begin



definition
  let A,B,C be non empty set;
  let f be Function of [:A,B:], C;
  redefine attr f is one-to-one means

  for a1,a2 being Element of A, b1,b2 being Element of B
  st f.(a1,b1) = f.(a2,b2) holds a1 = a2 & b1 = b2;
end;

scheme 
 CoBijectiveSch
  { A,B() -> category, F() -> covariant Functor of A(), B(), O(set) -> set,
  F(set,set,set) -> set }: F() is bijective
provided
 for a being object of A() holds F().a = O(a) and
 for a,b being object of A() st <^a,b^> <> {}
for f being Morphism of a,b holds F().f = F(a,b,f) and
 for a,b being object of A() st O(a) = O(b) holds a = b and
 for a,b being object of A() st <^a,b^> <> {}
for f,g being Morphism of a,b st F(a,b,f) = F(a,b,g) holds f = g and
 for a,b being object of B() st <^a,b^> <> {} for f being Morphism of a,b
ex c,d being object of A(), g being Morphism of c,d
st a = O(c) & b = O(d) & <^c,d^> <> {} & f = F(c,d,g);

scheme 
 CatIsomorphism { A,B() -> category, O(set) -> set,
  F(set,set,set) -> set }: A(), B() are_isomorphic
provided
 ex F being covariant Functor of A(),B() st
(for a being object of A() holds F.a = O(a)) &
for a,b being object of A() st <^a,b^> <> {}
for f being Morphism of a,b holds F.f = F(a,b,f) and
 for a,b being object of A() st O(a) = O(b) holds a = b and
 for a,b being object of A() st <^a,b^> <> {}
for f,g being Morphism of a,b st F(a,b,f) = F(a,b,g) holds f = g and
 for a,b being object of B() st <^a,b^> <> {} for f being Morphism of a,b
ex c,d being object of A(), g being Morphism of c,d
st a = O(c) & b = O(d) & <^c,d^> <> {} & f = F(c,d,g);

scheme 
 ContraBijectiveSch
  { A,B() -> category, F() -> contravariant Functor of A(), B(),
  O(set) -> set, F(set,set,set) -> set }: F() is bijective
provided
 for a being object of A() holds F().a = O(a) and
 for a,b being object of A() st <^a,b^> <> {}
for f being Morphism of a,b holds F().f = F(a,b,f) and
 for a,b being object of A() st O(a) = O(b) holds a = b and
 for a,b being object of A() st <^a,b^> <> {}
for f,g being Morphism of a,b st F(a,b,f) = F(a,b,g) holds f = g and
 for a,b being object of B() st <^a,b^> <> {} for f being Morphism of a,b
ex c,d being object of A(), g being Morphism of c,d
st b = O(c) & a = O(d) & <^c,d^> <> {} & f = F(c,d,g);

scheme 
 CatAntiIsomorphism { A,B() -> category, O(set) -> set,
  F(set,set,set) -> set }: A(), B() are_anti-isomorphic
provided
 ex F being contravariant Functor of A(),B() st
(for a being object of A() holds F.a = O(a)) &
for a,b being object of A() st <^a,b^> <> {}
for f being Morphism of a,b holds F.f = F(a,b,f) and
 for a,b being object of A() st O(a) = O(b) holds a = b and
 for a,b being object of A() st <^a,b^> <> {}
for f,g being Morphism of a,b st F(a,b,f) = F(a,b,g) holds f = g and
 for a,b being object of B() st <^a,b^> <> {} for f being Morphism of a,b
ex c,d being object of A(), g being Morphism of c,d
st b = O(c) & a = O(d) & <^c,d^> <> {} & f = F(c,d,g);

definition
  let A,B be category;
  pred A,B are_equivalent means

  ex F being covariant Functor of A,B,
  G being covariant Functor of B,A st G*F, id A are_naturally_equivalent &
  F*G, id B are_naturally_equivalent;
  reflexivity;
  symmetry;
end;

theorem 
  for A,B,C being non empty reflexive AltGraph
  for F1,F2 being feasible FunctorStr over A,B
  for G1,G2 being FunctorStr over B,C
  st the FunctorStr of F1 = the FunctorStr of F2 &
  the FunctorStr of G1 = the FunctorStr of G2 holds G1*F1 = G2*F2;

theorem 
  for A,B,C being category st A,B are_equivalent & B,C are_equivalent
  holds A,C are_equivalent;

theorem 
  for A,B being category st A,B are_isomorphic holds A,B are_equivalent;

scheme 
 NatTransLambda { A, B() -> category,
  F, G() -> covariant Functor of A(), B(), T(set) -> set }:
  ex t being natural_transformation of F(), G() st
  F() is_naturally_transformable_to G() &
  for a being object of A() holds t!a = T(a)
provided
 for a being object of A() holds T(a) in <^F().a, G().a^> and
 for a,b being object of A() st <^a,b^> <> {} for f being Morphism of a,b
for g1 being Morphism of F().a, G().a st g1 = T(a)
for g2 being Morphism of F().b, G().b st g2 = T(b) holds g2*F().f = G().f*g1;

scheme 
 NatEquivalenceLambda { A, B() -> category,
  F, G() -> covariant Functor of A(), B(), T(set) -> set }:
  ex t being natural_equivalence of F(), G() st
  F(), G() are_naturally_equivalent &
  for a being object of A() holds t!a = T(a)
provided
 for a being object of A() holds
T(a) in <^F().a, G().a^> & <^G().a, F().a^> <> {} &
for f being Morphism of F().a, G().a st f = T(a) holds f is iso and
 for a,b being object of A() st <^a,b^> <> {} for f being Morphism of a,b
for g1 being Morphism of F().a, G().a st g1 = T(a)
for g2 being Morphism of F().b, G().b st g2 = T(b) holds g2*F().f = G().f*g1;

begin



definition
  let C1,C2 be non empty AltCatStr;
  pred C1, C2 are_opposite means


   the carrier of C2 = the carrier of C1 &
  the Arrows of C2 = ~the Arrows of C1 & for a,b,c being object of C1
  for a9,b9,c9 being object of C2 st a9 = a & b9 = b & c9 = c
  holds (the Comp of C2).(a9,b9,c9) = ~((the Comp of C1).(c,b,a));
  symmetry;
end;

theorem 
  for A,B being non empty AltCatStr st A, B are_opposite
  for a being object of A holds a is object of B;

theorem 
  for A,B being non empty AltCatStr st A, B are_opposite
  for a,b being object of A, a9,b9 being object of B st a9 = a & b9 = b
  holds <^a,b^> = <^b9,a9^>;

theorem 
  for A,B being non empty AltCatStr st A, B are_opposite
  for a,b being object of A, a9,b9 being object of B st a9 = a & b9 = b
  for f being Morphism of a,b holds f is Morphism of b9, a9;

theorem 
  for C1,C2 being non empty transitive AltCatStr holds C1, C2 are_opposite iff
  the carrier of C2 = the carrier of C1 & for a,b,c being object of C1
  for a9,b9,c9 being object of C2 st a9 = a & b9 = b & c9 = c holds
  <^a,b^> = <^b9,a9^> & (<^a,b^> <> {} & <^b,c^> <> {} implies
  for f being Morphism of a,b, g being Morphism of b,c
  for f9 being Morphism of b9,a9, g9 being Morphism of c9,b9
  st f9 = f & g9 = g holds f9*g9 = g*f);

theorem 
  for A,B being category st A, B are_opposite
  for a being object of A, b being object of B st a = b holds idm a = idm b;

theorem 
  for A,B being transitive non empty AltCatStr st A,B are_opposite
  holds A is associative implies B is associative;

theorem 
  for A,B being transitive non empty AltCatStr st A,B are_opposite
  holds A is with_units implies B is with_units;

theorem 
  for C,C1,C2 being non empty AltCatStr st C, C1 are_opposite
  holds C, C2 are_opposite iff the AltCatStr of C1 = the AltCatStr of C2;

definition
  let C be transitive non empty AltCatStr;
  func C opp -> strict transitive non empty AltCatStr means


   C, it are_opposite;
end;

registration
  let C be associative transitive non empty AltCatStr;
  cluster C opp -> associative;
end;

registration
  let C be with_units transitive non empty AltCatStr;
  cluster C opp -> with_units;
end;

definition
  let A,B be category such that
 A, B are_opposite;
  func dualizing-func(A,B) -> contravariant strict Functor of A,B means


   (for a being object of A holds it.a = a) &
  for a,b being object of A st <^a,b^> <> {}
  for f being Morphism of a,b holds it.f = f;
end;

theorem 
  for A,B being category st A,B are_opposite
  holds dualizing-func(A,B)*dualizing-func(B,A) = id B;

theorem 
  for A, B being category st A, B are_opposite
  holds dualizing-func(A,B) is bijective;

registration
  let A be category;
  cluster dualizing-func(A, A opp) -> bijective;
  cluster dualizing-func(A opp, A) -> bijective;
end;

theorem 
  for A, B being category st A, B are_opposite holds A, B are_anti-isomorphic;

theorem 
  for A, B, C being category st A, B are_opposite
  holds A, C are_isomorphic iff B, C are_anti-isomorphic;

theorem 
  for A, B, C, D being category st A, B are_opposite & C, D are_opposite
  holds A, C are_isomorphic implies B, D are_isomorphic;

theorem 
  for A, B, C, D being category st A, B are_opposite & C, D are_opposite
  holds A, C are_anti-isomorphic implies B, D are_anti-isomorphic;

theorem 
  for A, B being category st A, B are_opposite
  for a, b being object of A st <^a,b^> <> {} & <^b,a^> <> {}
  for a9, b9 being object of B st a9 = a & b9 = b
  for f being Morphism of a,b, f9 being Morphism of b9,a9 st f9 = f
  holds f is retraction iff f9 is coretraction;

theorem 
  for A, B being category st A, B are_opposite
  for a, b being object of A st <^a,b^> <> {} & <^b,a^> <> {}
  for a9, b9 being object of B st a9 = a & b9 = b
  for f being Morphism of a,b, f9 being Morphism of b9,a9 st f9 = f
  holds f is coretraction iff f9 is retraction;

theorem 
  for A, B being category st A, B are_opposite
  for a, b being object of A st <^a,b^> <> {} & <^b,a^> <> {}
  for a9, b9 being object of B st a9 = a & b9 = b
  for f being Morphism of a,b, f9 being Morphism of b9,a9
  st f9 = f & f is retraction coretraction holds f9" = f";

theorem 
  for A, B being category st A, B are_opposite
  for a, b being object of A st <^a,b^> <> {} & <^b,a^> <> {}
  for a9, b9 being object of B st a9 = a & b9 = b
  for f being Morphism of a,b, f9 being Morphism of b9,a9 st f9 = f
  holds f is iso iff f9 is iso;

theorem 
  for A, B, C, D being category st A, B are_opposite & C, D are_opposite
  for F, G being covariant Functor of B, C st F, G are_naturally_equivalent
  holds dualizing-func(C,D)*G*dualizing-func(A,B),
  dualizing-func(C,D)*F*dualizing-func(A,B) are_naturally_equivalent;

theorem 
  for A, B, C, D being category st A, B are_opposite & C, D are_opposite
  holds A, C are_equivalent implies B, D are_equivalent;

definition
  let A,B be category;
  pred A,B are_dual means


  A, B opp are_equivalent;
  symmetry;
end;

theorem 
  for A, B being category st A, B are_anti-isomorphic holds A, B are_dual;

theorem 
  for A, B, C being category st A, B are_opposite
  holds A, C are_equivalent iff B, C are_dual;

theorem 
  for A, B, C being category st A, B are_dual & B, C are_equivalent
  holds A, C are_dual;

theorem 
  for A, B, C being category st A, B are_dual & B, C are_dual
  holds A, C are_equivalent;

begin



theorem 
  for X,Y,x being set
  holds x in Funcs(X,Y) iff x is Function & proj1 x = X & proj2 x c= Y;

definition
  let C be category;
  attr C is para-functional means

  ex F being ManySortedSet of C st
  for a1,a2 being object of C holds <^a1,a2^> c= Funcs(F.a1,F.a2);
end;

registration
  cluster quasi-functional -> para-functional for category;
end;

definition
  let C be category;
  let a be set;
  func C-carrier_of a means


   ex b being object of C st b = a & it = proj1 idm b if a is object of C
  otherwise it = {};
end;

notation
  let C be category;
  let a be object of C;
  synonym the_carrier_of a for C-carrier_of a;
end;

definition
  let C be category;
  let a be object of C;
  redefine func the_carrier_of a equals

  proj1 idm a;
end;

theorem 
  for A being non empty set, a being object of EnsCat A holds idm a = id a;

theorem 
  for A being non empty set for a being object of EnsCat A
  holds the_carrier_of a = a;

definition
  let C be category;
  attr C is set-id-inheriting means


   for a being object of C holds idm a = id the_carrier_of a;
end;

registration
  let A be non empty set;
  cluster EnsCat A -> set-id-inheriting;
end;

definition
  let C be category;
  attr C is concrete means


   C is para-functional semi-functional set-id-inheriting;
end;

registration
  cluster concrete -> para-functional semi-functional set-id-inheriting
    for category;
  cluster para-functional semi-functional set-id-inheriting -> concrete
    for category;
end;

registration
  cluster concrete quasi-functional strict for category;
end;

theorem 
  for C being category holds C is para-functional iff
  for a1,a2 being object of C
  holds <^a1,a2^> c= Funcs(the_carrier_of a1, the_carrier_of a2);

theorem 
  for C being para-functional category
  for a,b being object of C st <^a,b^> <> {} for f being Morphism of a,b
  holds f is Function of the_carrier_of a, the_carrier_of b;

registration
  let A be para-functional category;
  let a,b be object of A;
  cluster -> Function-like Relation-like for Morphism of a,b;
end;

theorem 
  for C being para-functional category
  for a,b being object of C st <^a,b^> <> {} for f being Morphism of a,b
  holds dom f = the_carrier_of a & rng f c= the_carrier_of b;

theorem 
  for C being para-functional semi-functional category
  for a,b,c being object of C st <^a,b^> <> {} & <^b,c^> <> {}
  for f being Morphism of a,b, g being Morphism of b,c
  holds g*f = (g qua Function)*(f qua Function);

theorem 
  for C being para-functional semi-functional category
  for a being object of C st id the_carrier_of a in <^a,a^>
  holds idm a = id the_carrier_of a;

scheme 
 ConcreteCategoryLambda { A() -> non empty set, B(set,set) -> set,
  D(set) -> set }: ex C being concrete strict category
  st the carrier of C = A() &
  (for a being object of C holds the_carrier_of a = D(a)) &
  for a,b being object of C holds <^a,b^> = B(a,b)
provided
 for a,b,c being Element of A(), f,g being Function
st f in B(a,b) & g in B(b,c) holds g*f in B(a,c) and
 for a,b being Element of A() holds B(a,b) c= Funcs(D(a), D(b)) and
 for a being Element of A() holds id D(a) in B(a,a);

scheme 
 ConcreteCategoryQuasiLambda { A() -> non empty set, P[set,set,set],
  D(set) -> set }: ex C being concrete strict category
  st the carrier of C = A() &
  (for a being object of C holds the_carrier_of a = D(a)) &
  for a,b being Element of A(), f being Function
  holds f in (the Arrows of C).(a,b) iff f in Funcs(D(a), D(b)) & P[a,b,f]
provided
 for a,b,c being Element of A(), f,g being Function
st P[a,b,f] & P[b,c,g] holds P[a,c,g*f] and
 for a being Element of A() holds P[a,a,id D(a)];

scheme 
 ConcreteCategoryEx { A() -> non empty set, B(set) -> set, D[set, set],
  P[set,set,set] }: ex C being concrete strict category
  st the carrier of C = A() & (for a being object of C
  for x being set holds x in the_carrier_of a iff x in B(a) & D[a,x]) &
  for a,b being Element of A(), f being Function
  holds f in (the Arrows of C).(a,b) iff
  f in Funcs(C-carrier_of a, C-carrier_of b) & P[a,b,f]
provided
 for a,b,c being Element of A(), f,g being Function
st P[a,b,f] & P[b,c,g] holds P[a,c,g*f] and
 for a being Element of A(), X being set
st for x being set holds x in X iff x in B(a) & D[a,x] holds P[a,a,id X];

scheme 
 ConcreteCategoryUniq1 { A() -> non empty set, B(set,set) -> set }:
  for C1, C2 being para-functional semi-functional category
  st the carrier of C1 = A() &
  (for a,b being object of C1 holds <^a,b^> = B(a,b)) &
  the carrier of C2 = A() &
  (for a,b being object of C2 holds <^a,b^> = B(a,b))
  holds the AltCatStr of C1 = the AltCatStr of C2;

scheme 
 ConcreteCategoryUniq2 { A() -> non empty set, P[set,set,set],
  D(set) -> set }: for C1,C2 being para-functional semi-functional category st
  the carrier of C1 = A() & (for a,b being Element of A(), f being Function
  holds f in (the Arrows of C1).(a,b) iff f in Funcs(D(a), D(b)) & P[a,b,f]) &
  the carrier of C2 = A() & (for a,b being Element of A(), f being Function
  holds f in (the Arrows of C2).(a,b) iff f in Funcs(D(a), D(b)) & P[a,b,f])
  holds the AltCatStr of C1 = the AltCatStr of C2;

scheme 
 ConcreteCategoryUniq3 { A() -> non empty set, B(set) -> set,
  D[set, set], P[set,set,set] }:
  for C1,C2 being para-functional semi-functional category st
  the carrier of C1 = A() & (for a being object of C1
  for x being set holds x in the_carrier_of a iff x in B(a) & D[a,x]) &
  (for a,b being Element of A(), f being Function
  holds f in (the Arrows of C1).(a,b) iff
  f in Funcs(C1-carrier_of a, C1-carrier_of b) & P[a,b,f]) &
  the carrier of C2 = A() & (for a being object of C2
  for x being set holds x in the_carrier_of a iff x in B(a) & D[a,x]) &
  (for a,b being Element of A(), f being Function
  holds f in (the Arrows of C2).(a,b) iff
  f in Funcs(C2-carrier_of a, C2-carrier_of b) & P[a,b,f])
  holds the AltCatStr of C1 = the AltCatStr of C2;

begin



theorem 
  for C being concrete category
  for a,b being object of C st <^a,b^> <> {} & <^b,a^> <> {}
  for f being Morphism of a,b st f is retraction
  holds rng f = the_carrier_of b;

theorem 
  for C being concrete category
  for a,b being object of C st <^a,b^> <> {} & <^b,a^> <> {}
  for f being Morphism of a,b st f is coretraction holds f is one-to-one;

theorem 
  for C being concrete category
  for a,b being object of C st <^a,b^> <> {} & <^b,a^> <> {}
  for f being Morphism of a,b st f is iso
  holds f is one-to-one & rng f = the_carrier_of b;

theorem 
  for C being para-functional semi-functional category
  for a,b being object of C st <^a,b^> <> {} for f being Morphism of a,b
  st f is one-to-one & (f qua Function)" in <^b,a^> holds f is iso;

theorem 
  for C being concrete category
  for a,b being object of C st <^a,b^> <> {} & <^b,a^> <> {}
  for f being Morphism of a,b st f is iso holds f" = (f qua Function)";

scheme 
 ConcreteCatEquivalence
  { A,B() -> para-functional semi-functional category, O1, O2(set) -> set,
  F1, F2(set,set,set) -> Function, A, B(set) -> Function }:
  A(), B() are_equivalent
provided
 ex F being covariant Functor of A(),B() st
(for a being object of A() holds F.a = O1(a)) &
for a,b being object of A() st <^a,b^> <> {}
for f being Morphism of a,b holds F.f = F1(a,b,f) and
 ex G being covariant Functor of B(),A() st
(for a being object of B() holds G.a = O2(a)) &
for a,b being object of B() st <^a,b^> <> {}
for f being Morphism of a,b holds G.f = F2(a,b,f) and
 for a, b being object of A() st a = O2(O1(b))
holds A(b) in <^a, b^> & A(b)" in <^b,a^> & A(b) is one-to-one and
 for a, b being object of B() st b = O1(O2(a))
holds B(a) in <^a, b^> & B(a)" in <^b,a^> & B(a) is one-to-one and
 for a,b being object of A() st <^a,b^> <> {} for f being Morphism of a,b
holds A(b)*F2(O1(a),O1(b),F1(a,b,f)) = f*A(a) and
 for a,b being object of B() st <^a,b^> <> {} for f being Morphism of a,b
holds F1(O2(a),O2(b),F2(a,b,f))*B(a) = B(b)*f;

begin



definition
  let C be category;
  func Concretized C -> concrete strict category means


   the carrier of it = the carrier of C & (for a being object of it
  for x being set holds x in the_carrier_of a iff
  x in Union disjoin the Arrows of C & a = x`22) &
  for a,b being Element of C, f being Function
  holds f in (the Arrows of it).(a,b) iff
  f in Funcs(it-carrier_of a, it-carrier_of b) &
  ex fa,fb being object of C, g being Morphism of fa, fb
  st fa = a & fb = b & <^fa, fb^> <> {} &
  for o being object of C st <^o, fa^> <> {}
  for h being Morphism of o,fa holds f.[h,[o,fa]] = [g*h,[o,fb]];
end;

theorem 
  for A being category, a being object of A, x being set
  holds x in (Concretized A)-carrier_of a iff
  ex b being object of A, f being Morphism of b,a
  st <^b,a^> <> {} & x = [f,[b,a]];

registration
  let A be category;
  let a be object of A;
  cluster (Concretized A)-carrier_of a -> non empty;
end;

theorem 
  for A being category, a, b being object of A st <^a,b^> <> {}
  for f being Morphism of a,b ex F being Function of
  (Concretized A)-carrier_of a, (Concretized A)-carrier_of b
  st F in (the Arrows of Concretized A).(a,b) &
  for c being object of A, g being Morphism of c,a st <^c,a^> <> {}
  holds F.[g, [c,a]] = [f*g, [c,b]];

theorem 
  for A being category, a, b being object of A
  for F1,F2 being Function st F1 in (the Arrows of Concretized A).(a,b) &
  F2 in (the Arrows of Concretized A).(a,b) &
  F1.[idm a, [a,a]] = F2.[idm a, [a,a]] holds F1 = F2;

scheme 
 NonUniqMSFunctionEx {I() -> set, A, B() -> ManySortedSet of I(),
  P[set,set,set]}: ex F being ManySortedFunction of A(), B() st
  for i,x being set st i in I() & x in A().i
  holds F.i.x in B().i & P[i,x,F.i.x]
provided
 for i,x being set st i in I() & x in A().i
ex y being set st y in B().i & P[i,x,y];

definition
  let A be category;
  func Concretization A -> covariant strict Functor of A, Concretized A means


  (for a being object of A holds it.a = a) &
  for a, b being object of A st <^a,b^> <> {}
  for f being Morphism of a,b holds it.f.[idm a, [a,a]] = [f, [a,b]];
end;

registration
  let A be category;
  cluster Concretization A -> bijective;
end;


theorem 
  for A being category holds A, Concretized A are_isomorphic;














begin 

reserve x,y for set;

theorem 
  for A,B being transitive with_units non empty AltCatStr for F
being feasible reflexive FunctorStr over A,B st F is coreflexive bijective for
  a being object of A, b being object of B holds F.a = b iff F".b = a;

theorem 
  for A,B being transitive with_units non empty AltCatStr for F
  being Covariant feasible FunctorStr over A,B for G being Covariant feasible
  FunctorStr over B,A st F is bijective & G = F" for a1,a2 being object of A st
  <^a1,a2^> <> {} for f being Morphism of a1,a2, g being Morphism of F.a1, F.a2
  holds F.f = g iff G.g = f;

theorem 
  for A,B being transitive with_units non empty AltCatStr for F
  being Contravariant feasible FunctorStr over A,B for G being Contravariant
feasible FunctorStr over B,A st F is bijective & G = F" for a1,a2 being object
of A st <^a1,a2^> <> {} for f being Morphism of a1,a2, g being Morphism of F.a2
  , F.a1 holds F.f = g iff G.g = f;

theorem 
  for A,B being category, F being Functor of A,B st F is bijective
  for G being Functor of B,A st F*G = id B holds the FunctorStr of G = F";

theorem 
  for A,B being category, F being Functor of A,B st F is bijective
  for G being Functor of B,A st G*F = id A holds the FunctorStr of G = F";

theorem 
  for A,B being category, F being covariant Functor of A,B st F is
  bijective for G being covariant Functor of B,A st (for b being object of B
  holds F.(G.b) = b) & (for a,b being object of B st <^a,b^> <> {} for f being
  Morphism of a,b holds F.(G.f) = f) holds the FunctorStr of G = F";

theorem 
  for A,B being category, F being contravariant Functor of A,B st F is
bijective for G being contravariant Functor of B,A st (for b being object of B
  holds F.(G.b) = b) & (for a,b being object of B st <^a,b^> <> {} for f being
  Morphism of a,b holds F.(G.f) = f) holds the FunctorStr of G = F";

theorem 
  for A,B being category, F being covariant Functor of A,B st F is
  bijective for G being covariant Functor of B,A st (for a being object of A
  holds G.(F.a) = a) & (for a,b being object of A st <^a,b^> <> {} for f being
  Morphism of a,b holds G.(F.f) = f) holds the FunctorStr of G = F";

theorem 
  for A,B being category, F being contravariant Functor of A,B st F is
bijective for G being contravariant Functor of B,A st (for a being object of A
  holds G.(F.a) = a) & (for a,b being object of A st <^a,b^> <> {} for f being
  Morphism of a,b holds G.(F.f) = f) holds the FunctorStr of G = F";

begin 

definition
  let A, B be AltCatStr;
  pred A, B have_the_same_composition means


  for a1, a2, a3 being set
  holds (the Comp of A).[a1,a2,a3] tolerates (the Comp of B).[a1,a2,a3];
  symmetry;
end;

theorem 
  for A, B being AltCatStr holds A,B have_the_same_composition iff
for a1,a2,a3,x being set st x in dom ((the Comp of A).[a1,a2,a3]) & x in dom ((
the Comp of B).[a1,a2,a3]) holds ((the Comp of A).[a1,a2,a3]).x = ((the Comp of
  B).[a1,a2,a3]).x;

theorem 
  for A, B being transitive non empty AltCatStr holds A,B
have_the_same_composition iff for a1,a2,a3 being object of A st <^a1,a2^> <> {}
& <^a2,a3^> <> {} for b1,b2,b3 being object of B st <^b1,b2^> <> {} & <^b2,b3^>
  <> {} & b1 = a1 & b2 = a2 & b3 = a3 for f1 being Morphism of a1,a2, g1 being
Morphism of b1,b2 st g1 = f1 for f2 being Morphism of a2,a3, g2 being Morphism
  of b2,b3 st g2 = f2 holds f2 * f1 = g2 * g1;

theorem 
  for A, B being para-functional semi-functional category holds A, B
  have_the_same_composition;

definition
  let f, g be Function;
  func Intersect(f, g) -> Function means


  dom it = (dom f) /\ (dom g) &
  for x being set st x in (dom f) /\ (dom g) holds it.x = (f.x) /\ (g.x);
  commutativity;
end;

theorem 
  for I being set, A,B being ManySortedSet of I holds Intersect(A, B) = A /\ B;

theorem 
  for I,J being set for A being ManySortedSet of I, B being
  ManySortedSet of J holds Intersect(A, B) is ManySortedSet of I /\ J;

theorem 
  for I,J being set for A being ManySortedSet of I, B being
  Function for C being ManySortedSet of J st C = Intersect(A, B) holds C cc= A;

theorem 
  for I1,I2 being set for A1,B1 being ManySortedSet of I1 for A2,
  B2 being ManySortedSet of I2 for A,B being ManySortedSet of I1 /\ I2 st A =
Intersect(A1, A2) & B = Intersect(B1, B2) for F being ManySortedFunction of A1,
B1 for G being ManySortedFunction of A2,B2 st for x being set st x in dom F & x
in dom G holds F.x tolerates G.x holds Intersect(F, G) is ManySortedFunction of
  A, B;

theorem 
  for I,J being set for F being ManySortedSet of [:I,I:] for G
being ManySortedSet of [:J,J:] ex H being ManySortedSet of [:I/\J,I/\J:] st H =
  Intersect(F, G) & Intersect({|F|}, {|G|}) = {|H|};

theorem 
  for I,J being set for F1,F2 being ManySortedSet of [:I,I:] for
G1,G2 being ManySortedSet of [:J,J:] ex H1,H2 being ManySortedSet of [:I/\J,I/\
  J:] st H1 = Intersect(F1, G1) & H2 = Intersect(F2, G2) & Intersect({|F1,F2|},
  {|G1,G2|}) = {|H1, H2|};

definition
  let A, B be AltCatStr such that
 A, B have_the_same_composition;
  func Intersect(A, B) -> strict AltCatStr means


  the carrier of it = (
  the carrier of A) /\ (the carrier of B) & the Arrows of it = Intersect(the
  Arrows of A, the Arrows of B) & the Comp of it = Intersect(the Comp of A, the
  Comp of B);
end;

theorem 
  for A, B being AltCatStr st A, B have_the_same_composition holds
  Intersect(A, B) = Intersect(B, A);

theorem 
  for A, B being AltCatStr st A, B have_the_same_composition holds
  Intersect(A, B) is SubCatStr of A;

theorem 
  for A, B being AltCatStr st A, B have_the_same_composition for
  a1,a2 being object of A, b1,b2 being object of B for o1, o2 being object of
Intersect(A, B) st o1 = a1 & o1 = b1 & o2 = a2 & o2 = b2 holds <^o1,o2^> = <^a1
  ,a2^> /\ <^b1,b2^>;

theorem 
  for A, B being transitive AltCatStr st A, B
  have_the_same_composition holds Intersect(A, B) is transitive;

theorem 
  for A, B being AltCatStr st A, B have_the_same_composition for
  a1,a2 being object of A, b1,b2 being object of B for o1,o2 being object of
Intersect(A, B) st o1 = a1 & o1 = b1 & o2 = a2 & o2 = b2 & <^a1,a2^> <> {} & <^
b1,b2^> <> {} for f being Morphism of a1,a2, g being Morphism of b1,b2 st f = g
  holds f in <^o1,o2^>;

theorem 
  for A, B being with_units non empty AltCatStr st A, B
  have_the_same_composition for a being object of A, b being object of B for o
being object of Intersect(A, B) st o = a & o = b & idm a = idm b holds idm a in
  <^o,o^>;

theorem 
  for A, B being category st A, B have_the_same_composition & Intersect(
A,B) is non empty & for a being object of A, b being object of B st a = b holds
  idm a = idm b holds Intersect(A, B) is subcategory of A;

begin 

scheme 

  SubcategoryUniq { A() -> category, B1, B2() -> non empty subcategory of A(),
  P[set], Q[set,set,set]}: the AltCatStr of B1() = the AltCatStr of B2()
provided
 for a being object of A() holds a is object of B1() iff P[a] and
 for a,b being object of A(), a9,b9 being object of B1() st a9 = a &
b9 = b & <^a,b^> <> {} for f being Morphism of a,b holds f in <^a9,b9^> iff Q[a
,b,f] and
 for a being object of A() holds a is object of B2() iff P[a] and
 for a,b being object of A(), a9,b9 being object of B2() st a9 = a &
b9 = b & <^a,b^> <> {} for f being Morphism of a,b holds f in <^a9,b9^> iff Q[a
,b,f];

theorem 
  for A being non empty AltCatStr, B being non empty SubCatStr of
  A holds B is full iff for a1,a2 being object of A, b1,b2 being object of B st
  b1 = a1 & b2 = a2 holds <^b1,b2^> = <^a1,a2^>;

scheme 

  FullSubcategoryEx { A() -> category, P[set]}: ex B being strict full non
  empty subcategory of A() st for a being object of A() holds a is object of B
  iff P[a]
provided
 ex a being object of A() st P[a];

scheme 

  FullSubcategoryUniq { A() -> category, B1, B2() -> full non empty
  subcategory of A(), P[set]}: the AltCatStr of B1() = the AltCatStr of B2()
provided
 for a being object of A() holds a is object of B1() iff P[a] and
 for a being object of A() holds a is object of B2() iff P[a];

begin 

registration
  let f be Function-yielding Function;
  let x,y be set;
  cluster f.(x,y) -> Relation-like Function-like;
end;

theorem 
  for A being category, C being non empty subcategory of A for a,b
being object of C st <^a,b^> <> {} for f being Morphism of a,b holds (incl C).f
  = f;

registration
  let A be category;
  let C be non empty subcategory of A;
  cluster incl C -> id-preserving comp-preserving;
end;

registration
  let A be category;
  let C be non empty subcategory of A;
  cluster incl C -> Covariant;
end;

definition
  let A be category;
  let C be non empty subcategory of A;
  redefine func incl C -> strict covariant Functor of C,A;
end;

definition
  let A,B be category;
  let C be non empty subcategory of A;
  let F be covariant Functor of A,B;
  redefine func F|C -> strict covariant Functor of C,B;
end;

definition
  let A,B be category;
  let C be non empty subcategory of A;
  let F be contravariant Functor of A,B;
  redefine func F|C -> strict contravariant Functor of C,B;
end;

theorem 
  for A,B being category, C being non empty subcategory of A for F
being FunctorStr over A,B for a being object of A, c being object of C st c = a
  holds (F|C).c = F.a;

theorem 
  for A,B being category, C being non empty subcategory of A for F
being covariant Functor of A,B for a,b being object of A, c,d being object of C
  st c = a & d = b & <^c,d^> <> {} for f being Morphism of a,b for g being
  Morphism of c,d st g = f holds (F|C).g = F.f;

theorem 
  for A,B being category, C being non empty subcategory of A for F
being contravariant Functor of A,B for a,b being object of A, c,d being object
  of C st c = a & d = b & <^c,d^> <> {} for f being Morphism of a,b for g being
  Morphism of c,d st g = f holds (F|C).g = F.f;

theorem 
  for A,B being non empty AltGraph for F being BimapStr over A,B
st F is Covariant one-to-one for a,b being object of A st F.a = F.b holds a = b
;

theorem 
  for A,B being non empty reflexive AltGraph for F being feasible
Covariant FunctorStr over A,B st F is faithful for a,b being object of A st <^a
  ,b^> <> {} for f,g being Morphism of a,b st F.f = F.g holds f = g;

theorem 
  for A,B being non empty AltGraph for F being Covariant
FunctorStr over A,B st F is surjective for a,b being object of B st <^a,b^> <>
{} for f being Morphism of a,b ex c,d being object of A, g being Morphism of c,
  d st a = F.c & b = F.d & <^c,d^> <> {} & f = F.g;

theorem 
  for A,B being non empty AltGraph for F being BimapStr over A,B
st F is Contravariant one-to-one for a,b being object of A st F.a = F.b holds a
  = b;

theorem 
  for A,B being non empty reflexive AltGraph for F being feasible
Contravariant FunctorStr over A,B st F is faithful for a,b being object of A st
  <^a,b^> <> {} for f,g being Morphism of a,b st F.f = F.g holds f = g;

theorem 
  for A,B being non empty AltGraph for F being Contravariant
FunctorStr over A,B st F is surjective for a,b being object of B st <^a,b^> <>
{} for f being Morphism of a,b ex c,d being object of A, g being Morphism of c,
  d st b = F.c & a = F.d & <^c,d^> <> {} & f = F.g;

begin 

definition
  let A,B be category;
  let F be FunctorStr over A,B;
  let A9, B9 be category;
  pred A9,B9 are_isomorphic_under F means

  A9 is subcategory of A & B9 is
subcategory of B & ex G being covariant Functor of A9,B9 st G is bijective & (
  for a9 being object of A9, a being object of A st a9 = a holds G.a9 = F.a) &
for b9,c9 being object of A9, b,c being object of A st <^b9,c9^> <> {} & b9 = b
  & c9 = c for f9 being Morphism of b9,c9, f being Morphism of b,c st f9 = f
  holds G.f9 = Morph-Map(F,b,c).f;
  pred A9,B9 are_anti-isomorphic_under F means

  A9 is subcategory of A & B9 is
subcategory of B & ex G being contravariant Functor of A9,B9 st G is bijective
& (for a9 being object of A9, a being object of A st a9 = a holds G.a9 = F.a) &
for b9,c9 being object of A9, b,c being object of A st <^b9,c9^> <> {} & b9 = b
  & c9 = c for f9 being Morphism of b9,c9, f being Morphism of b,c st f9 = f
  holds G.f9 = Morph-Map(F,b,c).f;
end;

theorem 
  for A,B, A1, B1 being category, F being FunctorStr over A,B st A1, B1
  are_isomorphic_under F holds A1, B1 are_isomorphic;

theorem 
  for A,B, A1, B1 being category, F being FunctorStr over A,B st A1, B1
  are_anti-isomorphic_under F holds A1, B1 are_anti-isomorphic;

theorem 
  for A,B being category, F being covariant Functor of A,B st A, B
  are_isomorphic_under F holds F is bijective;

theorem 
  for A,B being category, F being contravariant Functor of A,B st A, B
  are_anti-isomorphic_under F holds F is bijective;

theorem 
  for A,B being category, F being covariant Functor of A,B st F is
  bijective holds A, B are_isomorphic_under F;

theorem 
  for A,B being category, F being contravariant Functor of A,B st F is
  bijective holds A, B are_anti-isomorphic_under F;

theorem 
  for A being category, B being non empty subcategory of A holds B,B
  are_isomorphic_under id A;

theorem 
  for f, g being Function st f c= g holds ~f c= ~g;

theorem 
  for f, g being Function st dom f is Relation & ~f c= ~g holds f c= g;

theorem 
  for I, J being set for A being ManySortedSet of [:I,I:], B being
  ManySortedSet of [:J,J:] st A cc= B holds ~A cc= ~B;

theorem 
  for A being transitive non empty AltCatStr for B being
  transitive non empty SubCatStr of A holds B opp is SubCatStr of A opp;

theorem 
  for A being category, B being non empty subcategory of A holds B
  opp is subcategory of A opp;

theorem 
  for A being category, B being non empty subcategory of A holds B,B opp
  are_anti-isomorphic_under dualizing-func(A, A opp);

theorem 
  for A1,A2 being category, F being covariant Functor of A1,A2 st F is
  bijective for B1 being non empty subcategory of A1 for B2 being non empty
  subcategory of A2 st B1,B2 are_isomorphic_under F holds B2,B1
  are_isomorphic_under F";

theorem 
  for A1,A2 being category, F being contravariant Functor of A1,A2 st F
  is bijective for B1 being non empty subcategory of A1 for B2 being non empty
  subcategory of A2 st B1,B2 are_anti-isomorphic_under F holds B2,B1
  are_anti-isomorphic_under F";

theorem 
  for A1,A2,A3 being category for F being covariant Functor of A1,A2 for
G being covariant Functor of A2,A3 for B1 being non empty subcategory of A1 for
  B2 being non empty subcategory of A2 for B3 being non empty subcategory of A3
  st B1,B2 are_isomorphic_under F & B2,B3 are_isomorphic_under G holds B1,B3
  are_isomorphic_under G*F;

theorem 
  for A1,A2,A3 being category for F being contravariant Functor of A1,A2
for G being covariant Functor of A2,A3 for B1 being non empty subcategory of A1
for B2 being non empty subcategory of A2 for B3 being non empty subcategory of
A3 st B1,B2 are_anti-isomorphic_under F & B2,B3 are_isomorphic_under G holds B1
  ,B3 are_anti-isomorphic_under G*F;

theorem 
  for A1,A2,A3 being category for F being covariant Functor of A1,A2 for
G being contravariant Functor of A2,A3 for B1 being non empty subcategory of A1
for B2 being non empty subcategory of A2 for B3 being non empty subcategory of
A3 st B1,B2 are_isomorphic_under F & B2,B3 are_anti-isomorphic_under G holds B1
  ,B3 are_anti-isomorphic_under G*F;

theorem 
  for A1,A2,A3 being category for F being contravariant Functor of A1,A2
  for G being contravariant Functor of A2,A3 for B1 being non empty subcategory
  of A1 for B2 being non empty subcategory of A2 for B3 being non empty
  subcategory of A3 st B1,B2 are_anti-isomorphic_under F & B2,B3
  are_anti-isomorphic_under G holds B1,B3 are_isomorphic_under G*F;

theorem 
  for A1, A2 be non empty category, F be covariant Functor of A1, A2,
  B1 be non empty subcategory of A1, B2 be non empty subcategory of A2 st
   F is bijective &
   (for a being object of A1 holds a is object of B1 iff F.a is object of B2) &
   (for a,b being object of A1 st <^a,b^> <> {} for a1,b1 being object
   of B1 st a1 = a & b1 = b for a2,b2 being object of B2 st a2 = F.a & b2 =
   F.b for f being Morphism of a,b holds f in <^a1,b1^> iff F.f in <^a2,b2^>)
   holds B1, B2 are_isomorphic_under F;

theorem 
  for A1, A2 be non empty category, F be contravariant Functor of A1,A2,
   B1 be non empty subcategory of A1, B2 be non empty subcategory of A2 st
   F is bijective &
   (for a being object of A1 holds a is object of B1 iff
   F.a is object of B2) &
   (for a,b being object of A1 st <^a,b^> <> {} for a1,b1 being object
   of B1 st a1 = a & b1 = b for a2,b2 being object of B2 st a2 = F.a &
   b2 = F.b
   for f being Morphism of a,b holds f in <^a1,b1^> iff F.f in <^b2,a2^>)
   holds B1, B2 are_anti-isomorphic_under F;














begin

registration
 cluster degenerated -> trivial
    for add-associative right_zeroed right_complementable
  right_unital right-distributive non empty doubleLoopStr;
end;

registration
 cluster non trivial -> non degenerated
    for add-associative right_zeroed right_complementable
  right_unital right-distributive non empty doubleLoopStr;
end;

theorem 
  for K being non empty addLoopStr, p1,p2 be FinSequence of the
  carrier of K st dom p1 = dom p2 holds dom(p1+p2) = dom p1;

theorem 
  for L being non empty addLoopStr, F being FinSequence of (the
  carrier of L)* holds dom Sum F = dom F;

theorem 
  for L being non empty addLoopStr, F being FinSequence of (the
  carrier of L)* holds Sum (<*>((the carrier of L)*)) = <*>(the carrier of L);

theorem 
  for L being non empty addLoopStr, p being Element of (the
  carrier of L)* holds <*Sum p*> = Sum<*p*>;

theorem 
  for L being non empty addLoopStr, F,G being FinSequence of (the
  carrier of L)* holds Sum(F^G) = Sum F ^ Sum G;

definition
  let L be non empty multMagma, p be FinSequence of the carrier of L, a be
  Element of L;

  redefine func a*p means


  dom it = dom p & for i being set st i in dom p holds it/.i = a*(p/.i);
end;

definition
  let L be non empty multMagma, p be FinSequence of the carrier of L, a be
  Element of L;
  func p*a -> FinSequence of the carrier of L means


  dom it = dom p & for i being set st i in dom p holds it/.i = (p/.i)*a;
end;

theorem 
  for L being non empty multMagma, a being Element of L holds a*
  <*>(the carrier of L) = <*>(the carrier of L);

theorem 
  for L being non empty multMagma, a being Element of L holds (<*>
  the carrier of L)*a = <*>(the carrier of L);

theorem 
  for L being non empty multMagma, a, b being Element of L holds a
  *<*b*> = <*a*b*>;

theorem 
  for L being non empty multMagma, a, b being Element of L holds
  <*b*>*a = <*b*a*>;

theorem 
  for L being non empty multMagma, a being Element of L, p, q
  being FinSequence of the carrier of L holds a*(p^q) = (a*p)^(a*q);

theorem 
  for L being non empty multMagma, a being Element of L, p, q
  being FinSequence of the carrier of L holds (p^q)*a = (p*a)^(q*a);

registration
  cluster right_unital for non empty strict multLoopStr_0;
end;

registration
  cluster strict Abelian add-associative right_zeroed right_complementable
    associative commutative distributive almost_left_invertible well-unital non
    trivial for non empty doubleLoopStr;
end;

theorem 
  for L being add-associative right_zeroed right_complementable
  right_unital distributive non empty doubleLoopStr, a being Element of L, p
  being FinSequence of the carrier of L holds Sum (a*p) = a*Sum p;

theorem 
  for L being add-associative right_zeroed right_complementable
  right_unital distributive non empty doubleLoopStr, a being Element of L, p
  being FinSequence of the carrier of L holds Sum (p*a) = (Sum p)*a;

begin 

theorem 
  for L being add-associative right_zeroed right_complementable
  non empty addLoopStr, F being FinSequence of (the carrier of L)* holds Sum
  FlattenSeq F = Sum Sum F;

definition

  let X be non empty set, S be ZeroStr, f be Function of X, S;
  func Support f -> Subset of X means


  for x being Element of X holds x in it iff f.x <> 0.S;
end;

definition
  let X be non empty set, S be ZeroStr, p be Function of X, S;
  attr p is finite-Support means


  Support p is finite;
end;

definition
  let n be set, L be non empty 1-sorted, p be Function of Bags n, L, x be bag
  of n;
  redefine func p.x -> Element of L;
end;

begin 

definition
  let X be set, S be 1-sorted;
  mode Series of X, S is Function of Bags X, S;
end;

definition
  let n be set, L be non empty addLoopStr, p,q be Series of n, L;
  func p+q -> Series of n, L equals

  p + q;
end;

theorem 
  for n being set, L being non empty addLoopStr, p,q being Series of n, L
  for x being bag of n holds (p+q).x = p.x + q.x;

theorem 
  for n being set, L being non empty addLoopStr, p,q,r being Series of n, L
  st for x being bag of n holds r.x = p.x + q.x holds
  r = p + q;

theorem 
  for n being set,
      L being add-associative right_zeroed right_complementable
      non empty addLoopStr,
      p being Series of n, L
  for x being bag of n holds (-p).x = -(p.x);

theorem 
  for n being set,
      L being add-associative right_zeroed right_complementable
      non empty addLoopStr,
      p,r being Series of n, L
  st for x being bag of n holds r.x = -(p.x) holds
  r = -p;

theorem 
  for n be set, L be add-associative right_zeroed right_complementable
  non empty addLoopStr, p be Series of n, L holds p = - -p;

theorem 
  for n being set, L being right_zeroed non empty addLoopStr, p,
  q being Series of n, L holds Support (p+q) c= Support p \/ Support q;

definition
  let n be set, L be Abelian right_zeroed non empty addLoopStr, p, q be
  Series of n, L;
  redefine func p+q;
  commutativity;
end;

theorem 
  for n being set, L being add-associative right_zeroed non empty
  doubleLoopStr, p, q, r being Series of n, L holds (p+q)+r = p+(q+r);

definition

  let n be set, L be add-associative right_zeroed right_complementable non
  empty addLoopStr, p, q be Series of n, L;
  func p-q -> Series of n, L equals

  p+-q;
end;

definition
  let n be set, S be non empty ZeroStr;
  func 0_(n, S) -> Series of n, S equals

  (Bags n) --> 0.S;
end;

theorem 
  for n being set, S being non empty ZeroStr, b be bag of n holds
  (0_(n, S)).b = 0.S;

theorem 
  for n being set, L be right_zeroed non empty addLoopStr, p be
  Series of n, L holds p+0_(n,L) = p;

definition
  let n be set, L be right_unital non empty multLoopStr_0;
  func 1_(n,L) -> Series of n, L equals

  0_(n,L)+*(EmptyBag n,1.L);
end;

theorem 
  for n being set, L being add-associative right_zeroed
right_complementable non empty addLoopStr, p being Series of n, L holds p-p =
  0_(n,L);

theorem 
  for n being set, L being right_unital non empty multLoopStr_0
  holds (1_(n,L)).EmptyBag n = 1.L & for b being bag of n st b <> EmptyBag n
  holds (1_(n,L)).b = 0.L;

definition
  let n be Ordinal, L be add-associative right_complementable right_zeroed
  non empty doubleLoopStr, p, q be Series of n, L;
  func p*'q -> Series of n, L means


  for b being bag of n ex s being
FinSequence of the carrier of L st it.b = Sum s & len s = len decomp b & for k
being Element of NAT st k in dom s ex b1, b2 being bag of n st (decomp b)/.k =
  <*b1, b2*> & s/.k = p.b1*q.b2;
end;

theorem 
  for n being Ordinal, L being Abelian add-associative
  right_zeroed right_complementable distributive associative non empty
  doubleLoopStr, p, q, r being Series of n, L holds p*'(q+r) = p*'q+p*'r;

theorem 
  for n being Ordinal, L being Abelian add-associative
  right_zeroed right_complementable right_unital distributive associative non
empty doubleLoopStr, p, q, r being Series of n, L holds (p*'q)*'r = p*'(q*'r);

definition
  let n be Ordinal, L be Abelian add-associative right_zeroed
right_complementable commutative non empty doubleLoopStr, p, q be Series of n
  , L;
  redefine func p*'q;
  commutativity;
end;

theorem 
  for n being Ordinal, L being add-associative right_complementable
  right_zeroed right_unital distributive non empty doubleLoopStr, p being
  Series of n, L holds p*'0_(n,L) = 0_(n,L);

theorem 
  for n being Ordinal, L being add-associative
  right_complementable right_zeroed distributive right_unital non trivial non
  empty doubleLoopStr, p being Series of n, L holds p*'1_(n,L) = p;

theorem 
  for n being Ordinal, L being add-associative
  right_complementable right_zeroed distributive well-unital non trivial non
  empty doubleLoopStr, p being Series of n, L holds 1_(n,L)*'p = p;

begin 

registration
  let n be set, S be non empty ZeroStr;
  cluster finite-Support for Series of n, S;
end;

definition
  let n be Ordinal, S be non empty ZeroStr;
  mode Polynomial of n, S is finite-Support Series of n, S;
end;

registration
  let n be Ordinal, L be right_zeroed non empty addLoopStr, p, q be
  Polynomial of n, L;
  cluster p+q -> finite-Support;
end;

registration
  let n be Ordinal, L be add-associative right_zeroed right_complementable
  non empty addLoopStr, p be Polynomial of n, L;
  cluster -p -> finite-Support;
end;

registration
  let n be Element of NAT, L be add-associative right_zeroed
  right_complementable non empty addLoopStr, p, q be Polynomial of n, L;
  cluster p-q -> finite-Support;
end;

registration
  let n be Ordinal, S be non empty ZeroStr;
  cluster 0_(n, S) -> finite-Support;
end;

registration
  let n be Ordinal, L be add-associative right_zeroed right_complementable
  right_unital right-distributive non trivial doubleLoopStr;
  cluster 1_(n,L) -> finite-Support;
end;

registration
  let n be Ordinal, L be add-associative right_complementable right_zeroed
right_unital distributive non empty doubleLoopStr, p, q be Polynomial of n, L
  ;
  cluster p*'q -> finite-Support;
end;

begin 

definition
  let n be Ordinal, L be right_zeroed add-associative right_complementable
  right_unital distributive non trivial doubleLoopStr;
  func Polynom-Ring (n, L) -> strict non empty doubleLoopStr means


  (
  for x being set holds x in the carrier of it iff x is Polynomial of n, L) & (
  for x, y being Element of it, p, q being Polynomial of n, L st x = p & y = q
holds x+y = p+q) & (for x, y being Element of it, p, q being Polynomial of n, L
  st x = p & y = q holds x*y = p*'q) & 0.it = 0_(n,L) & 1.it = 1_(n,L);
end;

registration
  let n be Ordinal, L be Abelian right_zeroed add-associative
  right_complementable right_unital distributive non trivial
  doubleLoopStr;
  cluster Polynom-Ring (n, L) -> Abelian;
end;

registration
  let n be Ordinal, L be add-associative right_zeroed right_complementable
  right_unital distributive non trivial doubleLoopStr;
  cluster Polynom-Ring (n, L) -> add-associative;
end;

registration
  let n be Ordinal, L be right_zeroed add-associative right_complementable
  right_unital distributive non trivial doubleLoopStr;
  cluster Polynom-Ring (n, L) -> right_zeroed;
end;

registration
  let n be Ordinal, L be right_complementable right_zeroed add-associative
  right_unital distributive non trivial doubleLoopStr;
  cluster Polynom-Ring (n, L) -> right_complementable;
end;

registration
  let n be Ordinal, L be Abelian add-associative right_zeroed
  right_complementable commutative right_unital distributive non trivial non
  empty doubleLoopStr;
  cluster Polynom-Ring (n, L) -> commutative;
end;

registration
  let n be Ordinal, L be Abelian add-associative right_zeroed
  right_complementable right_unital distributive associative non trivial non
  empty doubleLoopStr;
  cluster Polynom-Ring (n, L) -> associative;
end;

registration
  let n be Ordinal, L be right_zeroed Abelian add-associative
  right_complementable well-unital distributive associative non trivial non
  empty doubleLoopStr;
  cluster Polynom-Ring (n, L) -> well-unital right-distributive;
end;

theorem 
  for n being Ordinal, L being right_zeroed Abelian add-associative
  right_complementable right_unital distributive associative non trivial non
  empty doubleLoopStr holds 1.Polynom-Ring(n, L) = 1_(n,L);














begin  

registration
  cluster Abelian right_add-cancelable -> left_add-cancelable for non empty
    addLoopStr;
  cluster Abelian left_add-cancelable -> right_add-cancelable for non empty
    addLoopStr;
end;

registration
  cluster right_zeroed right_complementable add-associative ->
    right_add-cancelable for non empty addLoopStr;
end;

registration
  cluster Abelian add-associative left_zeroed right_zeroed commutative
    associative add-cancelable distributive unital for
non empty doubleLoopStr;
end;

theorem 
  for R being right_zeroed left_add-cancelable left-distributive
  non empty doubleLoopStr, a being Element of R holds 0.R * a = 0.R;

theorem 
  for R being left_zeroed right_add-cancelable right-distributive
  non empty doubleLoopStr, a being Element of R holds a * 0.R = 0.R;

begin  

theorem 
  for L being left_zeroed non empty addLoopStr, a being Element
  of L holds Sum <* a *> = a;

theorem 
  for R being left_zeroed right_add-cancelable right-distributive non
empty doubleLoopStr, a being Element of R, p being FinSequence of the carrier
  of R holds Sum(a * p) = a * Sum p;

theorem 
  for R being right_zeroed left_add-cancelable left-distributive
  non empty doubleLoopStr, a being Element of R, p being FinSequence of the
  carrier of R holds Sum(p * a) = Sum p * a;

theorem 
  for R being commutative non empty multMagma, a being Element of R,
  p being FinSequence of the carrier of R holds p * a = a * p;

definition

  let R be non empty addLoopStr, p,q be FinSequence of the carrier of R;
  func p + q -> FinSequence of the carrier of R means


  dom it = dom p &
  for i being Nat st 1 <= i & i <= len it holds it/.i = p/.i + q/.i;
end;

theorem 
  for R being Abelian right_zeroed add-associative non empty
  addLoopStr, p,q being FinSequence of the carrier of R st dom p = dom q holds
  Sum(p + q) = Sum p + Sum q;

begin  

definition
  let R be unital non empty multMagma, a be Element of R, n be Nat;
  func a|^n -> Element of R equals

  power(R).(a,n);
end;

theorem 
  for R being unital non empty multMagma, a being Element of R
  holds a|^0 = 1_R & a|^1 = a;

theorem 
  for R being unital associative commutative non empty multMagma,
  a,b being Element of R, n being Nat holds
  (a * b)|^n = (a|^n) * (b|^n);

theorem 
  for R being unital associative non empty multMagma,
  a being Element of R, n,m being Nat holds
  a|^(n+m) = (a|^n) * (a|^m);

theorem 
  for R being unital associative non empty multMagma, a being Element
  of R, n,m being Nat holds (a|^n)|^m = a|^(n * m);

begin 

definition
  let R be non empty addLoopStr;
  func Nat-mult-left(R) -> Function of [:NAT,the carrier of R:],the carrier of
  R means


  for a being Element of R holds it.(0,a) = 0.R & for n being
  Element of NAT holds it.(n+1,a) = a + it.(n,a);
  func Nat-mult-right(R) -> Function of [:the carrier of R,NAT:],the carrier
  of R means


  for a being Element of R holds it.(a,0) = 0.R & for n being
  Element of NAT holds it.(a,n+1) = it.(a,n) + a;
end;

definition
  let R be non empty addLoopStr, a be Element of R, n be Element of NAT;
  func n * a -> Element of R equals

  (Nat-mult-left(R)).(n,a);
  func a * n -> Element of R equals

  (Nat-mult-right(R)).(a,n);
end;

theorem 
  for R being non empty addLoopStr, a being Element of R holds 0 * a =
  0.R & a * 0 = 0.R;

theorem 
  for R being right_zeroed non empty addLoopStr, a being Element
  of R holds 1 * a = a;

theorem 
  for R being left_zeroed non empty addLoopStr, a being Element
  of R holds a * 1 = a;

theorem 
  for R being left_zeroed add-associative non empty addLoopStr,
a being Element of R, n,m being Element of NAT holds (n + m) * a = n * a + m *
  a;

theorem 
  for R being right_zeroed add-associative non empty addLoopStr,
a being Element of R, n,m being Element of NAT holds a * (n + m) = a * n + a *
  m;

theorem 
  for R being left_zeroed right_zeroed add-associative non empty
  addLoopStr, a being Element of R, n being Element of NAT holds n * a = a * n;

theorem 
  for R being Abelian non empty addLoopStr, a being Element of R, n
  being Element of NAT holds n * a = a * n;

theorem 
  for R being left_zeroed right_zeroed left_add-cancelable
add-associative left-distributive non empty doubleLoopStr, a,b being Element
  of R, n being Element of NAT holds (n * a) * b = n * (a * b);

theorem 
  for R being left_zeroed right_zeroed right_add-cancelable
add-associative distributive non empty doubleLoopStr, a,b being Element of R,
  n being Element of NAT holds b * (n * a) = (b * a) * n;

theorem 
  for R being left_zeroed right_zeroed add-associative
add-cancelable distributive non empty doubleLoopStr, a,b being Element of R,
  n being Element of NAT holds (a * n) * b = a * (n * b);

begin  

definition
  let k,n be Element of NAT;
  redefine func n choose k -> Element of NAT;
end;

definition
  let R be unital non empty doubleLoopStr, a,b be Element of R, n be Element
  of NAT;
  func (a,b) In_Power n -> FinSequence of the carrier of R means


  len
it = n + 1 & for i,l,m being Element of NAT st i in dom it & m = i - 1 & l = n
  - m holds it/.i = (n choose m) * a|^l * b|^m;
end;

theorem 
  for R being right_zeroed unital non empty doubleLoopStr, a,b
  being Element of R holds (a,b) In_Power 0 = <*1_R*>;

theorem 
  for R being right_zeroed unital non empty doubleLoopStr, a,b
  being Element of R, n being Element of NAT holds ((a,b) In_Power n).1 = a|^n;

theorem 
  for R being right_zeroed unital non empty doubleLoopStr, a,b
being Element of R, n being Element of NAT holds ((a,b) In_Power n).(n+1) = b|^
  n;


theorem 
  for R being Abelian add-associative left_zeroed right_zeroed
  commutative associative add-cancelable distributive unital non empty
doubleLoopStr, a,b being Element of R, n being Element of NAT holds (a+b)|^n =
  Sum((a,b) In_Power n);

theorem 
  for C,D be non empty set, b be Element of D, F be Function of [:C,D:],D
  ex g being Function of [:NAT,C:],D st for a being Element of C holds
  g.(0,a) = b & for n being Element of NAT holds g.(n+1,a) = F.(a,g.(n,a));

theorem 
  for C,D be non empty set, b be Element of D, F be Function of [:D,C:],D
  ex g being Function of [:C,NAT:],D st for a being Element of C holds
  g.(a,0) = b & for n being Element of NAT holds g.(a,n+1) = F.(g.(a,n),a);














begin

reserve x, x1, x2, y, z, X9 for set,
  X, Y for finite set,
  n, k, m for Nat,
  f for Function;

theorem 
  X c= Y & card X=card Y implies X=Y;

theorem 
  for X,Y,x,y st (Y={} implies X={}) & not x in X holds card Funcs(
  X,Y) = card{F where F is Function of X\/{x},Y\/{y}:rng (F|X) c=Y & F.x=y};

theorem 
  for X,Y,x,y st not x in X & y in Y holds card Funcs(X,Y) = card{F
  where F is Function of X\/{x},Y:F.x=y};



theorem 
  (Y={} implies X={}) implies card Funcs(X,Y) = card Y |^ card X;

theorem 
  for X,Y,x,y st (Y is empty implies X is empty) & not x in X & not
y in Y holds card{F where F is Function of X,Y:F is one-to-one}= card{F where F
  is Function of X\/{x},Y\/{y}:F is one-to-one & F.x=y};

theorem 
  n!/((n-'k)!) is Element of NAT;



theorem 
  card X <= card Y implies card {F where F is Function of X,Y:F is
  one-to-one} = card Y!/((card Y-'card X)!);



theorem 
  card{F where F is Function of X,X:F is Permutation of X}=card X!;

definition
  let X,k,x1,x2;
  func Choose(X,k,x1,x2) -> Subset of Funcs(X,{x1,x2}) means


  x in it iff ex f be Function of X,{x1,x2} st f = x & card (f"{x1})=k;
end;

theorem 
  card X<>k implies Choose(X,k,x1,x1) is empty;

theorem 
  card X < k implies Choose(X,k,x1,x2) is empty;

theorem 
  x1<>x2 implies card Choose(X,0,x1,x2)=1;

theorem 
  card Choose(X,card X,x1,x2)=1;

theorem 
  not z in X implies card Choose(X,k,x,y)= card{f where f is
  Function of X\/{z},{x,y}:card (f"{x})=k+1 & f.z=x};

theorem 
  not z in X & x<>y implies card Choose(X,k,x,y)= card{f where f
  is Function of X\/{z},{x,y}:card (f"{x})=k & f.z=y};

theorem 
  x<>y & not z in X implies card Choose(X\/{z},k+1,x,y)= card
  Choose(X,k+1,x,y)+ card Choose(X,k,x,y);




theorem 
  x<>y implies card Choose(X,k,x,y)=card X choose k;

theorem 
  x<>y implies (Y-->y)+*(X-->x) in Choose(X\/Y,card X,x,y);

theorem 
  x<>y & X misses Y implies (X-->x)+*(Y-->y) in Choose(X\/Y,card X ,x,y);

definition
  let F,Ch be Function,y be set;
  func Intersection(F,Ch,y) -> Subset of union rng F means


  z in it iff z in union rng F & for x st x in dom Ch & Ch.x=y holds z in F.x;
end;

reserve F,Ch for Function;

theorem 
  for F,Ch st dom F/\Ch"{x} is non empty holds y in Intersection(F
  ,Ch,x) iff for z st z in dom Ch & Ch.z=x holds y in F.z;

theorem 
  Intersection(F,Ch,y) is non empty implies Ch"{y} c= dom F;

theorem 
  Intersection(F,Ch,y) is non empty implies for x1,x2 st x1 in Ch"{y} &
  x2 in Ch"{y} holds F.x1 meets F.x2;

theorem 
  z in Intersection(F,Ch,y) & y in rng Ch implies ex x st x in dom
  Ch & Ch.x=y & z in F.x;

theorem 
  F is empty or union rng F is empty implies Intersection(F,Ch,y)=union
  rng F;

theorem 
  F|Ch"{y}=(Ch"{y}-->union rng F)
    implies Intersection(F,Ch,y) = union rng F;

theorem 
  union rng F is non empty & Intersection(F,Ch,y)=union rng F implies F|
  Ch"{y}=(Ch"{y}-->union rng F);

theorem 
  Intersection(F,{},y)=union rng F;

theorem 
  Intersection(F,Ch,y) c= Intersection(F,Ch|X9,y);

theorem 
  Ch"{y}=(Ch|X9)"{y} implies Intersection(F,Ch,y)=Intersection(F, Ch|X9,y);

theorem 
  Intersection(F|X9,Ch,y) c= Intersection(F,Ch,y);

theorem 
  y in rng Ch & Ch"{y} c= X9 implies Intersection(F|X9,Ch,y) =
  Intersection(F,Ch,y);

theorem 
  x in Ch"{y} implies Intersection(F,Ch,y) c= F.x;

theorem 
  x in Ch"{y} implies Intersection(F,Ch|(dom Ch\{x}),y)/\F.x=
  Intersection(F,Ch,y);

theorem 
  for Ch1,Ch2 be Function st Ch1"{x1}=Ch2"{x2} holds Intersection(
  F,Ch1,x1)=Intersection(F,Ch2,x2);

theorem 
  Ch"{y}={} implies Intersection(F,Ch,y)=union rng F;

theorem 
  {x}=Ch"{y} implies Intersection(F,Ch,y)=F.x;

theorem 
  {x1,x2}=Ch"{y} implies Intersection(F,Ch,y)=F.x1 /\ F.x2;

theorem 
  for F st F is non empty holds y in Intersection(F,(dom F-->x),x) iff
  for z st z in dom F holds y in F.z;

registration
  let F be finite-yielding Function,X be set;
  cluster F|X -> finite-yielding;
end;

registration
  let F be finite-yielding Function,G be Function;
  cluster F*G -> finite-yielding;
  cluster Intersect(F,G) -> finite-yielding;
end;

reserve Fy for finite-yielding Function;

theorem 
  y in rng Ch implies Intersection(Fy,Ch,y) is finite;

theorem 
  dom Fy is finite implies union rng Fy is finite;

theorem 
  x in Choose(n,k,1,0) iff ex F be XFinSequence of NAT st F = x & dom F
  = n & rng F c= {0,1} & Sum F=k;

definition
 canceled;
  let k;
  let F be finite-yielding Function;
  assume
 dom F is finite;
  func Card_Intersection(F,k) -> Element of NAT means


  for x,y be set,X
be finite set, P be Function of card Choose(X,k,x,y),Choose(X,k,x,y) st dom F=X
& P is one-to-one & x<>y ex XFS be XFinSequence of NAT st dom XFS=dom P & (for
z,f st z in dom XFS & f=P.z holds XFS.z=card(Intersection(F,f,x))) & it=Sum XFS
  ;
end;

theorem 
  for x,y be set,X be finite set, P be Function of card Choose(X,k,x,y),
Choose(X,k,x,y) st dom Fy=X & P is one-to-one & x<>y for XFS be XFinSequence of
  NAT st dom XFS=dom P & (for z,f st z in dom XFS & f=P.z holds XFS.z=card(
  Intersection(Fy,f,x))) holds Card_Intersection(Fy,k)=Sum XFS;

theorem 
  dom Fy is finite & k=0 implies Card_Intersection(Fy,k)=card (union rng Fy);

theorem 
  dom Fy=X & k > card X implies Card_Intersection(Fy,k)=0;

theorem 
  for Fy,X st dom Fy=X for P be Function of card X,X st P is
one-to-one holds ex XFS be XFinSequence of NAT st dom XFS=card X & (for z st z
  in dom XFS holds XFS.z=card ((Fy*P).z))& Card_Intersection(Fy,1)=Sum XFS;

theorem 
  dom Fy=X implies Card_Intersection(Fy,card X)=card Intersection( Fy,X-->x,x);

theorem 
  Fy=x.-->X implies Card_Intersection(Fy,1)=card X;

theorem 
  x<>y & Fy=(x,y)-->(X,Y) implies Card_Intersection(Fy,1)=card X + card
  Y & Card_Intersection(Fy,2)=card (X/\Y);

theorem 
  for Fy,x st dom Fy is finite & x in dom Fy holds
  Card_Intersection(Fy,1)=Card_Intersection(Fy|(dom Fy\{x}),1)+ card (Fy.x);

theorem 
  dom Intersect(F,dom F-->X9)=dom F & for x st x in dom F holds
  Intersect(F,dom F-->X9).x = F.x /\ X9;

theorem 
  (union rng F)/\X9=union rng Intersect(F,dom F-->X9);

theorem 
  Intersection(F,Ch,y)/\X9= Intersection(Intersect(F,dom F-->X9), Ch,y);

theorem 
  for F, G be XFinSequence st F is one-to-one & G is one-to-one &
  rng F misses rng G holds F^G is one-to-one;

theorem 
  for Fy,X,x,n st dom Fy = X & x in dom Fy & k>0 holds
  Card_Intersection(Fy,k+1)= Card_Intersection(Fy|(dom Fy\{x}),k+1)+
  Card_Intersection(Intersect(Fy|(dom Fy\{x}),(dom Fy\{x})-->Fy.x),k);

theorem 
  x in dom F implies union rng F=union rng (F|(dom F\{x}))\/F.x;

theorem 
  for Fy be finite-yielding Function,X ex XFS be XFinSequence of
  INT st dom XFS = card X & for n st n in dom XFS holds XFS.n=((-1)|^n)*
  Card_Intersection(Fy,n+1);




theorem 
  for Fy be finite-yielding Function,X st dom Fy=X for XFS be
XFinSequence of INT st dom XFS= card X & for n st n in dom XFS holds XFS.n=((-1
  )|^n)*Card_Intersection(Fy,n+1) holds card union rng Fy=Sum XFS;

theorem 
  for Fy,X,n,k st dom Fy=X holds (ex x,y st x<>y & for f st f in
Choose(X,k,x,y) holds card(Intersection(Fy,f,x))=n) implies Card_Intersection(
  Fy,k)=n*(card X choose k);

theorem 
  for Fy,X st dom Fy=X for XF be XFinSequence of NAT st dom XF=
card X & for n st n in dom XF holds ex x,y st x<>y & for f st f in Choose(X,n+1
  ,x,y) holds card(Intersection(Fy,f,x))=XF.n holds ex F be XFinSequence of INT
st dom F=card X & card union rng Fy = Sum F & for n st n in dom F holds F.n=((-
  1)|^n)*XF.n*(card X choose (n+1));



theorem 
  for X,Y be finite set st X is non empty & Y is non empty ex F be
  XFinSequence of INT st dom F = card Y+1 & Sum F = card {f where f is Function
of X,Y:f is onto} & for n st n in dom F holds F.n=((-1)|^n)*(card Y choose n)*(
  (card Y-n) |^ card X);



theorem 
  for n,k st k <= n ex F be XFinSequence of INT st n block k = 1/(k!) *
Sum F & dom F = k+1 & for m st m in dom F holds F.m=((-1)|^m)*(k choose m)*((k-
  m) |^ n);

theorem 
  for X1,Y1,X be finite set st (Y1 is empty implies X1 is empty) &
X c= X1 for F be Function of X1,Y1 st F is one-to-one & card X1=card Y1 holds (
card X1-'card X)!= card{f where f is Function of X1,Y1: f is one-to-one & rng(f
  |(X1\X)) c= F.:(X1\X) & for x st x in X holds f.x=F.x};

theorem 
  for F be Function st dom F=X & F is one-to-one ex XF be
  XFinSequence of INT st Sum XF=card {h where h is Function of X,rng F: h is
  one-to-one & for x st x in X holds h.x<>F.x}& dom XF = card X +1 & for n st n
  in dom XF holds XF.n=((-1)|^n)*(card X!)/(n!);



theorem 
  ex XF be XFinSequence of INT st Sum XF=card {h where h is Function of
X,X: h is one-to-one & for x st x in X holds h.x<>x}& dom XF = card X+1 & for n
  st n in dom XF holds XF.n=((-1)|^n)*(card X!)/(n!);














begin

reserve i,j for Nat;

definition
  let K be Field, M1, M2 be Matrix of K;
  func M1-M2 -> Matrix of K equals

  M1+(-M2);
end;

theorem 
  for K being Field, M being Matrix of K holds --M=M;

theorem 
  for K being Field,M being Matrix of K holds M+(-M)=0.(K,len M, width M);

theorem 
  for K being Field,M being Matrix of K holds M - M=0.(K,len M,width M);

theorem 
  for K being Field,M1,M2,M3 being Matrix of K st len M1=len M2 & len M2
  =len M3 & width M1=width M2 & width M2=width M3 & M1+M3=M2+M3 holds M1=M2;

theorem 
  for K being Field,M1,M2 being Matrix of K holds M1--M2=M1+M2;

theorem 
  for K being Field,M1,M2 being Matrix of K st len M1=len M2 & width M1=
  width M2 & M1 = M1 + M2 holds M2 = 0.(K,len M1,width M1);

theorem 
  for K being Field,M1,M2 being Matrix of K st len M1=len M2 &
  width M1=width M2 & M1 - M2 = 0.(K,len M1,width M1) holds M1 = M2;

theorem 
  for K being Field,M1,M2 being Matrix of K st len M1=len M2 &
  width M1=width M2 & M1+M2= 0.(K,len M1,width M1) holds M2=-M1;

theorem 
  for n,m being Element of NAT,K being Field holds -(0.(K,n,m))=0.( K,n,m);

theorem 
  for K being Field,M1,M2 being Matrix of K st len M1=len M2 & width M1=
  width M2 & M2 - M1 = M2 holds M1=0.(K,len M1,width M1);

theorem 
  for K being Field,M1,M2 being Matrix of K st len M1=len M2 &
  width M1=width M2 holds M1 = M1 -(M2 - M2);

theorem 
  for K being Field,M1,M2 being Matrix of K st len M1=len M2 &
  width M1=width M2 holds -(M1 + M2) = -M1+-M2;

theorem 
  for K being Field,M1,M2 being Matrix of K st len M1=len M2 & width M1=
  width M2 holds M1 - (M1 - M2) = M2;

theorem 
  for K being Field,M1,M2,M3 being Matrix of K st len M1=len M2 &
  len M2=len M3 & width M1=width M2 & width M2 = width M3 & M1 - M3 = M2 - M3
  holds M1 = M2;

theorem 
  for K being Field,M1,M2,M3 being Matrix of K st len M1=len M2 &
  len M2=len M3 & width M1=width M2 & width M2 = width M3 & M3 - M1 = M3 - M2
  holds M1 = M2;

theorem 
  for K being Field,M1,M2,M3 being Matrix of K st len M1=len M2 &
len M2=len M3 & width M1=width M2 & width M2 = width M3 holds M1 - M2 - M3 = M1
  - M3 - M2;

theorem 
  for K being Field,M1,M2,M3 being Matrix of K st len M1=len M2 & len M2
=len M3 & width M1=width M2 & width M2 = width M3 holds M1 - M3 = (M1 - M2) - (
  M3 - M2);

theorem 
  for K being Field,M1,M2,M3 being Matrix of K st len M1=len M2 &
len M2=len M3 & width M1=width M2 & width M2 = width M3 holds (M3 - M1) - (M3 -
  M2) = M2 - M1;

theorem 
  for K being Field,M1,M2,M3,M4 being Matrix of K st len M1=len M2 & len
M2=len M3 & len M3=len M4 & width M1=width M2 & width M2 = width M3 & width M3=
  width M4 & M1 - M2 = M3 - M4 holds M1 - M3 = M2 - M4;

theorem 
  for K being Field,M1,M2 being Matrix of K st len M1=len M2 &
  width M1=width M2 holds M1 = M1 + (M2 - M2);

theorem 
  for K being Field,M1,M2 being Matrix of K st len M1=len M2 &
  width M1=width M2 holds M1 = M1 + M2 - M2;

theorem 
  for K being Field,M1,M2 being Matrix of K st len M1=len M2 &
  width M1=width M2 holds M1 = M1 - M2 + M2;

theorem 
  for K being Field,M1,M2,M3 being Matrix of K st len M1=len M2 & len M2
=len M3 & width M1=width M2 & width M2=width M3 holds M1 + M3 = (M1 + M2) + (M3
  - M2);

theorem 
  for K being Field,M1,M2,M3 being Matrix of K st len M1=len M2 & len M2
=len M3 & width M1=width M2 & width M2 = width M3 holds M1 + M2 - M3 = M1 - M3
  + M2;

theorem 
  for K being Field,M1,M2,M3 being Matrix of K st len M1=len M2 & len M2
=len M3 & width M1=width M2 & width M2 = width M3 holds M1 - M2 + M3 = M3 - M2
  + M1;

theorem 
  for K being Field,M1,M2,M3 being Matrix of K st len M1=len M2 &
  len M2=len M3 & width M1=width M2 & width M2 = width M3 holds M1 + M3 = (M1 +
  M2) - (M2 - M3);

theorem 
  for K being Field,M1,M2,M3 being Matrix of K st len M1=len M2 & len M2
=len M3 & width M1=width M2 & width M2 = width M3 holds M1 - M3 = (M1 + M2) - (
  M3 + M2);

theorem 
  for K being Field,M1,M2,M3,M4 being Matrix of K st len M1=len M2
  & len M2=len M3 & len M3=len M4 & width M1=width M2 & width M2 = width M3 &
  width M3=width M4 & M1 + M2 = M3 + M4 holds M1 - M3 = M4 - M2;

theorem 
  for K being Field,M1,M2,M3,M4 being Matrix of K st len M1=len M2 & len
M2=len M3 & len M3=len M4 & width M1=width M2 & width M2 = width M3 & width M3=
  width M4 & M1 - M3 = M4 - M2 holds M1 + M2 = M3 + M4;

theorem 
  for K being Field,M1,M2,M3,M4 being Matrix of K st len M1=len M2 & len
M2=len M3 & len M3=len M4 & width M1=width M2 & width M2 = width M3 & width M3=
  width M4 & M1 + M2 = M3 - M4 holds M1 + M4 = M3 - M2;

theorem 
  for K being Field,M1,M2,M3 being Matrix of K st len M1=len M2 &
len M2=len M3 & width M1=width M2 & width M2 = width M3 holds M1 - (M2 + M3) =
  M1 - M2 - M3;

theorem 
  for K being Field,M1,M2,M3 being Matrix of K st len M1=len M2 & len M2
  =len M3 & width M1=width M2 & width M2 = width M3 holds M1 - (M2 - M3) = M1 -
  M2 + M3;

theorem 
  for K being Field,M1,M2,M3 being Matrix of K st len M1=len M2 & len M2
=len M3 & width M1=width M2 & width M2 = width M3 holds M1 - (M2 - M3) = M1 + (
  M3 - M2);

theorem 
  for K being Field,M1,M2,M3 being Matrix of K st len M1=len M2 & width
  M1=width M2 holds M1 - M3 = (M1-M2)+(M2 - M3);

theorem 
  for K being Field,M1,M2,M3 being Matrix of K st -M1=-M2 holds M1=M2;

theorem 
  for K being Field,M being Matrix of K st -M=0.(K,len M,width M) holds
  M = 0.(K,len M,width M);

theorem 
  for K being Field,M1,M2 being Matrix of K st len M1=len M2 & width M1=
  width M2 & M1 + -M2 = 0.(K,len M1,width M1) holds M1 = M2;

theorem 
  for K being Field,M1,M2 being Matrix of K st len M1=len M2 &
  width M1=width M2 holds M1=M1+M2+(-M2);

theorem 
  for K being Field,M1,M2 being Matrix of K st len M1=len M2 & width M1=
  width M2 holds M1=M1+(M2 + -M2);

theorem 
  for K being Field,M1,M2 being Matrix of K st len M1=len M2 & width M1=
  width M2 holds M1=(-M2+M1)+M2;

theorem 
  for K being Field,M1,M2 being Matrix of K st len M1=len M2 & width M1=
  width M2 holds -(-M1+M2)=M1+-M2;

theorem 
  for K being Field,M1,M2 being Matrix of K st len M1=len M2 & width M1=
  width M2 holds M1+M2=-(-M1+-M2);

theorem 
  for K being Field,M1,M2 being Matrix of K st len M1=len M2 & width M1=
  width M2 holds -(M1 - M2) = M2 - M1;

theorem 
  for K being Field,M1,M2 being Matrix of K st len M1=len M2 &
  width M1=width M2 holds - M1 - M2 = - M2 - M1;

theorem 
  for K being Field,M1,M2 being Matrix of K st len M1=len M2 & width M1=
  width M2 holds M1 = - M2 - (- M1 - M2);

theorem 
  for K being Field,M1,M2,M3 being Matrix of K st len M1=len M2 &
len M2=len M3 & width M1=width M2 & width M2 = width M3 holds - M1 - M2 - M3 =
  - M1 - M3 - M2;

theorem 
  for K being Field, M1, M2, M3 being Matrix of K st len M1 = len
  M2 & len M2 = len M3 & width M1 = width M2 & width M2 = width M3 holds - M1 -
  M2 - M3 = - M2 - M3 - M1;

theorem 
  for K being Field, M1, M2, M3 being Matrix of K st len M1=len M2 & len
M2=len M3 & width M1=width M2 & width M2 = width M3 holds - M1 - M2 - M3 = - M3
  - M2 - M1;

theorem 
  for K being Field, M1, M2, M3 being Matrix of K st len M1 = len M2 &
len M2 = len M3 & width M1 = width M2 & width M2 = width M3 holds (M3 - M1) - (
  M3 - M2) = - (M1 - M2);

theorem 
  for K being Field, M being Matrix of K holds 0.(K, len M, width M) - M = - M;

theorem 
  for K being Field, M1, M2 being Matrix of K st len M1 = len M2 & width
  M1 = width M2 holds M1 + M2 = M1 - - M2;

theorem 
  for K being Field, M1, M2 being Matrix of K st len M1 = len M2 & width
  M1 = width M2 holds M1 = M1 - (M2 + -M2);

theorem 
  for K being Field, M1, M2, M3 being Matrix of K st len M1 = len M2 &
len M2 = len M3 & width M1 = width M2 & width M2 = width M3 & M1 - M3 = M2 + -
  M3 holds M1 = M2;

theorem 
  for K being Field, M1, M2, M3 being Matrix of K st len M1 = len M2 &
len M2 = len M3 & width M1 = width M2 & width M2 = width M3 & M3 - M1 = M3 + -
  M2 holds M1 = M2;

theorem 
  for K being set, A,B being Matrix of K st len A=len B & width A=
  width B holds Indices A=Indices B;

theorem 
  for K being Field,x,y,z being FinSequence of K st len x=len y &
  len y=len z holds mlt(x+y,z) = mlt(x,z)+mlt(y,z);

theorem 
  for K being Field,x,y,z being FinSequence of K st len x=len y &
  len y=len z holds mlt(z,x+y) = mlt(z,x)+mlt(z,y);

theorem 
  for D being non empty set,M being Matrix of D holds len M >0 implies
  for n being Element of NAT holds M is Matrix of n,width M, D iff n = len M;

theorem 
  for K being Field,j being Element of NAT,A,B being Matrix of K
  st width A=width B & (ex j being Element of NAT st [i,j] in Indices A) holds
  Line(A+B,i)=Line(A,i)+Line(B,i);

theorem 
  for K being Field,j being Nat,A,B being Matrix of K st len A=len
  B & (ex i st [i,j] in Indices A) holds Col(A+B,j)=Col(A,j)+Col(B,j);

theorem 
  for V1 being Field,P1,P2 be FinSequence of V1 st len P1 = len P2
  holds Sum(P1+P2) = (Sum P1) + (Sum P2);

theorem 
  for K being Field,A,B,C being Matrix of K st len B=len C & width B=
  width C & width A=len B & len A>0 & len B>0 holds A*(B+C)=A*B + A*C;

theorem 
  for K being Field,A,B,C being Matrix of K st len B=len C & width B=
  width C & len A=width B & len B>0 & len A>0 holds (B+C)*A=B*A + C*A;

theorem 
  for K being Field,n,m,k being Element of NAT, M1 being Matrix of n,m,K
, M2 being Matrix of m,k,K st width M1=len M2 & 0< len M1 & 0<len M2 holds M1*
  M2 is Matrix of n,k,K;














begin

theorem 
  1 = 1_F_Complex;

theorem 
  0.F_Complex = 0;

definition
  let A be Matrix of COMPLEX;
  func COMPLEX2Field A -> Matrix of F_Complex equals

  A;
end;

definition
  let A be Matrix of F_Complex;
  func Field2COMPLEX A -> Matrix of COMPLEX equals

  A;
end;

theorem 
  for A,B being Matrix of COMPLEX st COMPLEX2Field A = COMPLEX2Field B
  holds A=B;

theorem 
  for A,B being Matrix of F_Complex st Field2COMPLEX A = Field2COMPLEX B
  holds A=B;

theorem 
  for A being Matrix of COMPLEX holds A = Field2COMPLEX COMPLEX2Field A;

theorem 
  for A being Matrix of F_Complex holds A = COMPLEX2Field Field2COMPLEX A;

definition
  let A,B be Matrix of COMPLEX;
  func A+B -> Matrix of COMPLEX equals

  Field2COMPLEX ((COMPLEX2Field A)+(
  COMPLEX2Field B));
end;

definition
  let A be Matrix of COMPLEX;
  func -A -> Matrix of COMPLEX equals

  Field2COMPLEX (-COMPLEX2Field A);
end;

definition
  let A,B be Matrix of COMPLEX;
  func A - B -> Matrix of COMPLEX equals

  Field2COMPLEX ((COMPLEX2Field A)-(
  COMPLEX2Field B));
  func A*B -> Matrix of COMPLEX equals

  Field2COMPLEX ((COMPLEX2Field A)*(
  COMPLEX2Field B));
end;

definition
  let x be complex number, A be Matrix of COMPLEX;
  func x * A -> Matrix of COMPLEX means


  for ea being Element of
  F_Complex st ea=x holds it=Field2COMPLEX (ea*(COMPLEX2Field A));
end;

theorem 
  for A being Matrix of COMPLEX holds len A = len COMPLEX2Field A &
  width A=width COMPLEX2Field A;

theorem 
  for A being Matrix of F_Complex holds len A =len Field2COMPLEX A &
  width A=width Field2COMPLEX A;

theorem 
  for K being Field, M being Matrix of K holds (1_K)*M=M;

theorem 
  for M being Matrix of COMPLEX holds 1*M=M;

theorem 
  for K being Field, a,b being Element of K, M being Matrix of K holds a
  *(b*M)=(a*b)*M;

theorem 
  for K being Field, a,b being Element of K, M being Matrix of K
  holds (a+b)*M=a*M + b*M;

theorem 
  for M being Matrix of COMPLEX holds M+M = 2*M;

theorem 
  for M being Matrix of COMPLEX holds M+M+M = 3*M;

definition
  let n,m be Nat;
  func 0_Cx(n,m) -> Matrix of COMPLEX equals

  Field2COMPLEX (0.(F_Complex,n,m));
end;

theorem 
  for n,m being Element of NAT holds COMPLEX2Field 0_Cx(n,m)=0.(
  F_Complex,n,m);

theorem 
  for M1,M2 being Matrix of COMPLEX st len M1=len M2 & width M1=width M2
  & M1 = M1 + M2 holds M2 = 0_Cx(len M1,width M1);

theorem 
  for M1,M2 being Matrix of COMPLEX st len M1=len M2 & width M1=width M2
  & M1+M2= 0_Cx(len M1,width M1) holds M2=-M1;

theorem 
  for M1,M2 being Matrix of COMPLEX st len M1=len M2 & width M1=width M2
  & M2 - M1 = M2 holds M1=0_Cx(len M1,width M1);

theorem 
  for M being Matrix of COMPLEX holds M + 0_Cx(len M,width M) = M;

theorem 
  for K being Field, b being Element of K,M1,M2 being Matrix of K
  st len M1 = len M2 & width M1 = width M2 holds b*(M1+M2)=b*M1 + b*M2;

theorem 
  for M1,M2 being Matrix of COMPLEX for a being complex number st len M1
  =len M2 & width M1=width M2 holds a*(M1 + M2) = a*M1 + a*M2;

theorem 
  for K being Field,M1,M2 being Matrix of K st width M1=len M2 &
  len M1>0& len M2>0 holds 0.(K,len M1,width M1)*M2=0.(K,len M1,width M2);

theorem 
  for M1,M2 being Matrix of COMPLEX st width M1=len M2 &len M1>0&len M2>
  0 holds 0_Cx(len M1,width M1)*M2=0_Cx(len M1,width M2);

theorem 
  for K being Field,M1 being Matrix of K st len M1>0 holds 0.K*M1=
  0.(K,len M1,width M1);

theorem 
  for M1 being Matrix of COMPLEX st len M1>0 holds 0*M1 = 0_Cx(len M1,
  width M1);

definition
  let s be complex-valued Function, k be set;
  redefine func s.k -> Element of COMPLEX;
end;

theorem 
  for i,j being Element of NAT,M1,M2 being Matrix of COMPLEX st len M2>0
holds ex s being FinSequence of COMPLEX st len s = len M2 & s.1=(M1*(i,1))*(M2*
(1,j)) & for k be Element of NAT st 1<=k & k < len M2 holds s.(k+1)=s.k + (M1*(
  i,k+1))*(M2*(k+1,j));














begin 

reserve i,j for Nat;

theorem 
  for r1,r2 being Real, fr1,fr2 being Element of F_Real st r1=fr1 & r2=
  fr2 holds r1+r2=fr1+fr2;

theorem 
  for r1,r2 being Real, fr1,fr2 being Element of F_Real st r1=fr1 & r2=
  fr2 holds r1*r2=fr1*fr2;

theorem 
  for F being FinSequence of REAL holds F + -F = 0*(len F) & F - F = 0*(len F);

theorem 
  for F1,F2 being FinSequence of REAL st len F1=len F2 holds F1 - F2 =
  F1 + - F2;

theorem 
  for F being FinSequence of REAL holds F - 0*(len F) = F;

theorem 
  for F being FinSequence of REAL holds 0*(len F) -F = -F;

theorem 
  for F1,F2 being FinSequence of REAL st len F1=len F2 holds F1 - -F2 =
  F1 + F2;

theorem 
  for F1,F2 being FinSequence of REAL st len F1=len F2 holds -(F1 - F2)
  = F2 - F1;

theorem 
  for F1,F2 being FinSequence of REAL st len F1=len F2 holds -(F1 - F2)
  = -F1 + F2;

theorem 
  for F1,F2 being FinSequence of REAL st len F1=len F2 & F1 - F2 = 0*(
  len F1) holds F1=F2;

theorem 
  for F1,F2,F3 being FinSequence of REAL st len F1=len F2 & len F2=len
  F3 holds F1 - F2 - F3 = F1 - (F2 + F3);

theorem 
  for F1,F2,F3 being FinSequence of REAL st len F1=len F2 & len F2=len
  F3 holds F1 + (F2 - F3) = F1 + F2 - F3;

theorem 
  for F1,F2,F3 being FinSequence of REAL st len F1=len F2 & len F2=len
  F3 holds F1 - (F2 - F3) = F1 - F2 + F3;

theorem 
  for F1,F2 being FinSequence of REAL st len F1=len F2 holds F1 = F1 + F2 - F2;

theorem 
  for F1,F2 being FinSequence of REAL st len F1=len F2 holds F1 = F1 - F2 + F2;

begin 

theorem 
  for K being non empty multMagma, p being FinSequence of K, a
  being Element of K holds len (a*p)=len p;

theorem 
  for r being Real, fr being Element of F_Real, p being
FinSequence of REAL, fp being FinSequence of F_Real st r=fr & p=fp holds r*p=fr
  *fp;

theorem 
  for K being Field, a being Element of K, A being Matrix of K holds
  Indices (a*A) = Indices A;

theorem 
  for K being Field, a being Element of K, M being Matrix of K st
  1<=i & i<=width M holds Col(a*M,i)=a*Col(M,i);

theorem 
  for K being Field, a being Element of K, M being (Matrix of K), i
  being Nat st 1<=i & i<=len M holds Line(a*M,i)=a*Line(M,i);

theorem 
  for K being Field, A,B being Matrix of K st width A=len B holds ex C
  being Matrix of K st len C=len A & width C=width B & for i,j st [i,j] in
  Indices C holds C*(i,j)=Line(A,i) "*" Col(B,j);

theorem 
  for K being Field,a being Element of K,A,B being Matrix of K st
  width A=len B holds A*(a*B)=a*(A*B);

definition
  let A be Matrix of REAL;
  func MXR2MXF A -> Matrix of F_Real equals

  A;
end;

definition
  let A be Matrix of F_Real;
  func MXF2MXR A -> Matrix of REAL equals

  A;
end;

theorem 
  for D1,D2 being set, A being (Matrix of D1), B being Matrix of D2 st A
  =B holds for i,j st [i,j] in Indices A holds A*(i,j)=B*(i,j);

theorem 
  for K being Field, A,B being Matrix of K holds Indices (A+B)=Indices A;

definition
  let A,B be Matrix of REAL;
  func A+B -> Matrix of REAL equals

  MXF2MXR ((MXR2MXF A)+(MXR2MXF B));
end;

theorem 
  for A,B being Matrix of REAL holds len (A+B) = len A & width (A+
B)=width A & for i,j holds [i,j] in Indices A implies (A+B)*(i,j) = A*(i,j) + B
  *(i,j);

theorem 
  for A,B,C being Matrix of REAL st len C = len A & width C =
width A & for i,j st [i,j] in Indices A holds C*(i,j) = A*(i,j) + B*(i,j) holds
  C=A+B;

definition
  let A be Matrix of REAL;
  func -A -> Matrix of REAL equals

  MXF2MXR (-(MXR2MXF A));
end;

definition
  let A,B be Matrix of REAL;
  func A - B -> Matrix of REAL equals

  MXF2MXR ((MXR2MXF A)-(MXR2MXF B));
  func A*B -> Matrix of REAL equals

  MXF2MXR ((MXR2MXF A)*(MXR2MXF B));
end;

definition
  let a be real number, A be Matrix of REAL;
  func a * A -> Matrix of REAL means


  for ea being Element of F_Real st ea=a holds it=MXF2MXR (ea*(MXR2MXF A));
end;

theorem 
  for a being Real, A being Matrix of REAL holds len (a*A)=len A &
  width (a*A)=width A;

theorem 
  for a being Real, A being Matrix of REAL holds Indices (a*A) = Indices A;

theorem 
  for a being Real, A being (Matrix of REAL), i2,j2 being Nat st [
  i2,j2] in Indices A holds (a*A)*(i2,j2)=a*(A*(i2,j2));

theorem 
  for a being Real, A being Matrix of REAL st width A>0 holds (a*A )@=a*(A@);

theorem 
  for a being Real,i being Nat,A being Matrix of REAL st len A>0 & i in
dom A holds (ex p being FinSequence of REAL st p=A.i) & for q being FinSequence
  of REAL st q=A.i holds (a*A).i=a*q;

theorem 
  for A being Matrix of REAL holds 1*A=A;

theorem 
  for A being Matrix of REAL holds A+A=2*A;

theorem 
  for A being Matrix of REAL holds A+A+A=3*A;

definition
  let n,m be Nat;
  func 0_Rmatrix(n,m) -> Matrix of REAL equals

  MXF2MXR (0.(F_Real,n,m));
end;

theorem 
  for A,B being Matrix of REAL holds A--B=A+B;

theorem 
  for n,m being Nat,A being Matrix of REAL st len A=n & width A=m
  & n>0 holds A+ 0_Rmatrix(n,m)=A & 0_Rmatrix(n,m)+A=A;

theorem 
  for A,B being Matrix of REAL st len A=len B & width A=width B & A = A
  + B holds B = 0_Rmatrix(len A,width A);

theorem 
  for A,B being Matrix of REAL st len A=len B & width A=width B & A+B=
  0_Rmatrix(len A,width A) holds B=-A;

theorem 
  for A,B being Matrix of REAL st len A=len B & width A=width B & B - A
  = B holds A=0_Rmatrix(len A,width A);

theorem 
  for a being Real,A,B being Matrix of REAL st width A=len B holds
  A*(a*B)=a*(A*B);

theorem 
  for a being Real,A,B being Matrix of REAL st width A=len B & len A>0 &
  len B>0 & width B>0 holds (a*A)*B=a*(A*B);

theorem 
  for M being Matrix of REAL holds M + 0_Rmatrix(len M,width M) = M;

theorem 
  for a being real number, A,B being Matrix of REAL st len A=len B &
  width A=width B holds a*(A + B) = a*A + a*B;

theorem 
  for A being Matrix of REAL st len A>0 holds 0 * A = 0_Rmatrix (len A,
  width A);

definition
  let x be FinSequence of REAL;
  assume
 len x > 0;
  func ColVec2Mx x -> Matrix of REAL means


  len it=len x & width it=1 & for j st j in dom x holds it.j = <*x.j*>;
end;

theorem 
  for x being FinSequence of REAL,M being Matrix of REAL st len x>0
  holds M=ColVec2Mx x iff Col(M,1)=x & width M=1;

theorem 
  for x1,x2 being FinSequence of REAL st len x1=len x2 & len x1>0
  holds ColVec2Mx (x1+x2)=ColVec2Mx (x1)+ColVec2Mx (x2);

theorem 
  for a being Real,x being FinSequence of REAL st len x>0 holds
  ColVec2Mx (a*x)=a*ColVec2Mx x;

definition
  let x be FinSequence of REAL;
  func LineVec2Mx x -> Matrix of REAL means


  width it=len x & len it=1 & for j st j in dom x holds it*(1,j) =x.j;
end;

theorem 
  for x being FinSequence of REAL, M being Matrix of REAL holds M=
  LineVec2Mx x iff Line(M,1)=x & len M=1;

theorem 
  for x being FinSequence of REAL st len x>0 holds (LineVec2Mx x)@
  = ColVec2Mx x & (ColVec2Mx x)@=LineVec2Mx x;

theorem 
  for x1,x2 being FinSequence of REAL st len x1=len x2 holds
  LineVec2Mx (x1+x2)=LineVec2Mx (x1)+LineVec2Mx (x2);

theorem 
  for a being Real, x being FinSequence of REAL holds LineVec2Mx (a*x)=a
  *LineVec2Mx x;

definition
  let M be Matrix of REAL;
  let x be FinSequence of REAL;
  func M*x -> FinSequence of REAL equals

  Col(M*(ColVec2Mx x),1);
  func x*M -> FinSequence of REAL equals

  Line((LineVec2Mx x)*M,1);
end;

theorem 
  for x being FinSequence of REAL, A being Matrix of REAL st len A
  >0 & width A>0 & (len A=len x or width (A@)=len x) holds (A@)*x = x*A;

theorem 
  for x being FinSequence of REAL,A being Matrix of REAL st len A>
  0 & width A>0 & (width A=len x or len (A@)=len x) holds A*x = x*(A@);

theorem 
  for A,B being Matrix of REAL st len A=len B holds for i being
  Nat st 1<=i & i<=width A holds Col(A+B,i)=Col(A,i)+Col(B,i);

theorem 
  for A,B being Matrix of REAL st width A=width B holds for i
  being Nat st 1<=i & i<=len A holds Line(A+B,i)=Line(A,i)+Line(B,i);

theorem 
  for a being Real, M being (Matrix of REAL), i being Nat st 1<=i
  & i<=width M holds Col(a*M,i)=a*Col(M,i);

theorem 
  for x1,x2 being FinSequence of REAL, A being Matrix of REAL st len x1=
  len x2 & width A=len x1 & len x1>0 & len A>0 holds A*(x1+x2)=A*x1 + A*x2;

theorem 
  for x1,x2 being FinSequence of REAL, A being Matrix of REAL st len x1=
  len x2 & len A=len x1 & len x1>0 holds (x1+x2)*A=x1*A + x2*A;

theorem 
  for a being Real,x being FinSequence of REAL, A being Matrix of
  REAL st width A=len x & len x>0 holds A*(a*x)=a*(A*x);

theorem 
  for a being Real, x being FinSequence of REAL, A being Matrix of REAL
  st len A=len x & len x>0 & width A>0 holds (a*x)*A=a*(x*A);

theorem 
  for x being FinSequence of REAL, A being Matrix of REAL st width
  A=len x & len x>0 holds len (A*x) = len A;

theorem 
  for x being FinSequence of REAL, A being Matrix of REAL st len A
  =len x holds len (x*A) = width A;

theorem 
  for x being FinSequence of REAL, A,B being Matrix of REAL st len
A=len B & width A=width B & width A=len x & len A>0 & len x>0 holds (A+B)*x=A*x
  + B*x;

theorem 
  for x being FinSequence of REAL, A,B being Matrix of REAL st len
  A=len B & width A=width B & len A=len x & len x>0 holds x*(A+B)=x*A + x*B;

theorem 
  for n,m being Element of NAT, x being FinSequence of REAL st len x=m &
  n>0 & m>0 holds (0_Rmatrix(n,m))*x=0*n;

theorem 
  for n,m being Element of NAT, x being FinSequence of REAL st len x=n &
  n>0 holds x*(0_Rmatrix(n,m))=0*m;














begin 

reserve i,j for Element of NAT,
  x,y,z for FinSequence of COMPLEX,
  c for Element of COMPLEX,
  R,R1,R2 for Element of i-tuples_on COMPLEX;

definition let z be FinSequence of COMPLEX;
  func z*' -> FinSequence of COMPLEX means

  len it = len z & for i being Nat st 1<=i & i<=len z holds it.i = (z.i)*';
end;

theorem 
  i in dom (x+y) implies (x+y).i = x.i + y.i;

theorem 
  i in dom (x-y) implies (x-y).i = x.i - y.i;

definition let i,R1,R2;
  redefine func R1 - R2 -> Element of i-tuples_on COMPLEX;
end;

definition let i,R1,R2;
  redefine func R1 + R2 -> Element of i-tuples_on COMPLEX;
end;

definition let i, R;
  let r be complex number;
  redefine func r*R -> Element of i-tuples_on COMPLEX;
end;

theorem 
  for a being complex number, x being FinSequence of COMPLEX holds
  len (a*x)=len x;

theorem 
  for x being complex-yielding FinSequence holds dom x = dom -x;

theorem 
  for x being complex-valued FinSequence holds len (-x)=len x;

theorem 
  for x1,x2 being complex-valued FinSequence st len x1=len x2 holds
  len (x1+x2)=len x1;

theorem 
  for x1,x2 being complex-valued FinSequence st len x1=len x2 holds
  len (x1-x2)=len x1;

theorem 
  for f being complex-valued FinSequence holds f is Element of COMPLEX len f;

theorem 
  R1 - R2 = R1 + - R2;

theorem 
  for x,y being complex-valued FinSequence st len x=len y holds x-y=x+(-y);

theorem 
  (-1)*R = -R;

theorem 
  for x being FinSequence of COMPLEX holds (-1)*x = -x;

theorem 
  for x being FinSequence of COMPLEX holds (-x).i = -x.i;

definition let i,R;
  redefine func -R -> Element of i-tuples_on COMPLEX;
end;

theorem 
  c = R.j implies (-R).j = -c;

theorem 
  for a being complex number holds dom(a*x) = dom x;

theorem 
  for i being Nat, a being complex number holds (a*x).i = a*(x.i);

theorem 
  for a being complex number holds (a*x)*' = a*'*(x*');

theorem 
  (R1+R2).j = R1.j + R2.j;

theorem 
  for x1,x2 being FinSequence of COMPLEX st len x1=len x2 holds
  (x1 + x2)*' = x1*' + x2*';

theorem 
  (R1-R2).j = R1.j - R2.j;

theorem 
  for x1,x2 being FinSequence of COMPLEX st len x1=len x2 holds
  (x1 - x2)*' = x1*' - x2*';

theorem 
  for z being FinSequence of COMPLEX holds (z*')*' = z;

theorem 
  for z being FinSequence of COMPLEX holds (-z)*' = -(z*');

theorem 
  for z being complex number holds z+z*' = 2*(Re z);

theorem 
  for x,y being complex-valued FinSequence st len x=len y holds
  (x-y).i = x.i - y.i;

theorem 
  for x,y being complex-valued FinSequence st len x=len y holds
  (x+y).i = x.i + y.i;

definition let z be FinSequence of COMPLEX;
  func Re z -> FinSequence of REAL equals

  1/2*(z+z*');
end;

theorem 
  for z being complex number holds z-z*' = 2*(Im z) * <i>;

definition
  let z be FinSequence of COMPLEX;
  func Im z -> FinSequence of REAL equals

  (-1/2*<i>)*(z-z*');
end;

definition
  let x,y be FinSequence of COMPLEX;
  func |( x,y )| -> Element of COMPLEX equals

  |(Re x,Re y)| - <i>*(|(Re x,Im y)|) + <i>*(|(Im x,Re y)|) + |(Im x,Im y)|;
end;

theorem 
  for x,y,z being complex-valued FinSequence st len x=len y & len y=len z
  holds x + (y + z) = x + y + z;

theorem 
  for x,y being complex-valued FinSequence st len x=len y holds x + y = y + x;

theorem 
  for c being complex number, x,y being FinSequence of COMPLEX st
  len x=len y holds c*(x+y) = c*x + c*y;

theorem 
  for x,y being complex-valued FinSequence st len x=len y holds
  x - y = x + - y;

theorem 
  for x,y being complex-valued FinSequence st len x=len y & x + y = 0c
  (len x) holds x = -y & y = -x;

theorem 
  for x being complex-valued FinSequence holds x + 0c (len x) = x;

theorem 
  for x being complex-valued FinSequence holds x + -x = 0c (len x);

theorem 
  for x,y being complex-valued FinSequence st len x=len y holds
  -(x + y) = -x + -y;

theorem 
  for x,y,z being complex-valued FinSequence st len x=len y & len y=len z
  holds x - y - z = x - (y + z);

theorem 
  for x,y,z being complex-valued FinSequence st len x=len y & len y=len z
  holds x + (y - z) = x + y - z;

canceled;

theorem 
  for x,y being complex-valued FinSequence st len x=len y holds
  -(x - y) = -x + y;

theorem 
  for x,y,z being complex-valued FinSequence st
  len x=len y & len y=len z holds x - (y - z) = x - y + z;

theorem 
  for c being complex number holds c*(0c (len x)) = 0c (len x);

theorem 
  for c being complex number holds -c*x = c*(-x);

theorem 
  for c being complex number, x,y being FinSequence of COMPLEX st
  len x=len y holds c*(x-y) = c*x - c*y;

theorem 
  for x1,y1 being Element of COMPLEX for x2,y2 being Real st x1 = x2 &
  y1 = y2 holds addcomplex.(x1,y1) = addreal.(x2,y2);

reserve C for Function of [:COMPLEX,COMPLEX:],COMPLEX;
reserve G for Function of [:REAL,REAL:],REAL;

theorem 
  for x1,y1 being FinSequence of COMPLEX for x2,y2 being
  FinSequence of REAL st x1 = x2 & y1 = y2 & len x1=len y2 & (for i st i in dom
  x1 holds C.(x1.i,y1.i)=G.(x2.i,y2.i)) holds C.:(x1,y1)=G.:(x2,y2);

theorem 
  for x1,y1 being FinSequence of COMPLEX for x2,y2 being FinSequence of
REAL st x1 = x2 & y1 = y2 & len x1=len y2 holds addcomplex.:(x1,y1) = addreal.:
  (x2,y2);

theorem 
  for x1,y1 being FinSequence of COMPLEX for x2,y2 being FinSequence of
  REAL st x1 = x2 & y1 = y2 & len x1=len y2 holds x1 + y1 = x2 + y2;

theorem 
  for x being FinSequence of COMPLEX holds len (Re x)=len x & len (Im x)=len x;

theorem 
  for x,y being FinSequence of COMPLEX st len x=len y holds Re (x+
  y) = Re x + Re y & Im(x + y) = Im x + Im y;

theorem 
  for x1,y1 being FinSequence of COMPLEX for x2,y2 being FinSequence of
REAL st x1 = x2 & y1 = y2 & len x1=len y2 holds diffcomplex.:(x1,y1) = diffreal
  .:(x2,y2);

theorem 
  for x1,y1 being FinSequence of COMPLEX for x2,y2 being FinSequence of
  REAL st x1 = x2 & y1 = y2 & len x1=len y2 holds x1 - y1 = x2 - y2;

theorem 
  for x,y being FinSequence of COMPLEX st len x=len y holds
  Re(x - y) = Re x - Re y & Im(x - y) = Im x - Im y;

theorem 
  for a, b being complex number holds a*(b*z) = (a*b)*z;

theorem 
  for c being complex number holds (-c)*x = -(c*x);

reserve h for Function of COMPLEX,COMPLEX,
  g for Function of REAL,REAL;

theorem 
  for y1 being FinSequence of COMPLEX for y2 being FinSequence of
REAL st len y1=len y2 & (for i st i in dom y1 holds h.(y1.i)=g.(y2.i)) holds h*
  y1 = g*y2;

theorem 
  for y1 being FinSequence of COMPLEX for y2 being FinSequence of REAL
  st y1 = y2 & len y1=len y2 holds compcomplex*y1 = compreal*y2;

theorem 
  for y1 being FinSequence of COMPLEX for y2 being FinSequence of REAL
  st y1 = y2 & len y1=len y2 holds - y1 = - y2;

theorem 
  for x being FinSequence of COMPLEX holds Re (<i>*x) = -(Im x) &
  Im (<i>*x) = Re x;

theorem 
  for x,y being FinSequence of COMPLEX st len x=len y holds
  |(<i>*x,y)| = <i>*(|(x,y)|);

theorem 
  for x,y being FinSequence of COMPLEX st len x=len y holds |(x,
  <i>*y)| = -<i>*(|(x,y)|);

theorem 
  for a1 being Element of COMPLEX,y1 being FinSequence of COMPLEX for a2
  being Element of REAL,y2 being FinSequence of REAL st a1 = a2 & y1 = y2 & len
  y1=len y2 holds (a1 multcomplex)*y1 = (a2 multreal)*y2;

theorem 
  for a1 being complex number, y1 being FinSequence of COMPLEX for a2
  being Element of REAL,y2 being FinSequence of REAL st a1 = a2 & y1 = y2 & len
  y1=len y2 holds a1*y1 = a2*y2;

theorem 
  for a, b being complex number holds (a+b)*z = a*z + b*z;

theorem 
  for a, b being complex number holds (a-b)*z = a*z - b*z;

theorem 
  for a being Element of COMPLEX,x being FinSequence of COMPLEX
holds Re (a*x) = Re a * Re x - Im a * Im x & Im (a*x) = Im a * Re x + Re a * Im
  x;

begin 

theorem 
  for x1,x2,y being FinSequence of COMPLEX st len x1=len x2 & len
  x2=len y holds |((x1+x2),y)| = |(x1,y)| + |(x2,y)|;

theorem 
  for x1,x2 being FinSequence of COMPLEX st len x1=len x2 holds
  |(-x1, x2)| = -|(x1, x2)|;

theorem 
  for x1,x2 being FinSequence of COMPLEX st len x1=len x2 holds
  |(x1, -x2)| = -|(x1, x2)|;

theorem 
  for x1,x2 being FinSequence of COMPLEX st len x1=len x2 holds
  |(-x1, -x2)| = |(x1, x2)|;

theorem 
  for x1,x2,x3 being FinSequence of COMPLEX st
  len x1=len x2 & len x2=len x3 holds
  |(x1-x2, x3)| = |(x1, x3)| - |(x2, x3)|;

theorem 
  for x,y1,y2 being FinSequence of COMPLEX st
  len x=len y1 & len y1=len y2 holds |(x, y1+y2)| = |(x, y1)| + |(x, y2)|;

theorem 
  for x,y1,y2 being FinSequence of COMPLEX st len x=len y1 & len y1=len y2
  holds |(x, y1-y2)| = |(x, y1)| - |(x, y2)|;

theorem 
  for x1,x2,y1,y2 being FinSequence of COMPLEX st len x1=len x2 &
  len x2=len y1 & len y1=len y2 holds
  |(x1+x2, y1+y2)| = |(x1, y1)| + |(x1, y2)| + |(x2, y1)| + |(x2, y2)|;

theorem 
  for x1,x2,y1,y2 being FinSequence of COMPLEX st
  len x1=len x2 & len x2=len y1 & len y1=len y2 holds
  |(x1-x2, y1-y2)| = |(x1, y1)| - |(x1, y2)| - |(x2, y1)| + |(x2, y2)|;

theorem 
  for x,y being FinSequence of COMPLEX holds |(x,y)| = (|(y,x)|)*';

theorem 
  for x,y being FinSequence of COMPLEX st len x=len y holds
  |(x+y,x+y)| = |(x,x)| + 2*Re(|(x,y)|) + |(y,y)|;

theorem 
  for x,y being FinSequence of COMPLEX st len x=len y holds
  |(x-y, x-y)| = |(x, x)| - 2*Re(|(x, y)|) + |(y, y)|;

theorem 
  for a being Element of COMPLEX, x,y being FinSequence of COMPLEX
  st len x=len y holds |(a*x,y)| = a*(|(x,y)|);

theorem 
  for a being Element of COMPLEX, x,y being FinSequence of COMPLEX
  st len x=len y holds |(x,a*y)| = (a*')*(|(x,y)|);

theorem 
  for a,b being Element of COMPLEX,x,y,z being FinSequence of COMPLEX st
  len x=len y & len y=len z holds |((a*x+b*y), z)| = a*|(x,z)| + b*|(y,z)|;

theorem 
  for a,b being Element of COMPLEX,x,y,z being FinSequence of COMPLEX st
  len x=len y & len y=len z holds |(x,a*y+b*z)| = (a*')*|(x,y)| + (b*')*|(x,z)|
;














begin

reserve i,j,n,k for Nat,
  a for Element of COMPLEX,
  R1,R2 for Element of i-tuples_on COMPLEX;

definition
  let M be Matrix of COMPLEX;
  func M*' -> Matrix of COMPLEX means


  len it=len M & width it=width M &
  for i,j being Nat st [i,j] in Indices M holds it*(i,j) = (M*(i,j))*';
 involutiveness;
end;

theorem 
  for M be tabular FinSequence holds [i,j] in Indices M iff 1<= i &
  i<=len M & 1<=j & j<=width M;

canceled;

theorem 
  for a being complex number,M being Matrix of COMPLEX holds len (a
  *M)=len M & width (a*M)=width M;

theorem 
  for i,j being Nat,a being complex number,M being Matrix of
  COMPLEX st [i,j] in Indices M holds (a*M)*(i,j) = a*(M*(i,j));

theorem 
  for a being complex number,M being Matrix of COMPLEX holds (a*M)
  *' = a*'*(M*');

theorem 
  for M1,M2 being Matrix of COMPLEX holds len (M1+M2)=len M1 &
  width (M1+M2)=width M1;

theorem 
  for i,j being Nat,M1,M2 being Matrix of COMPLEX st [i,j] in
  Indices M1 holds (M1+M2)*(i,j) = M1*(i,j) + M2*(i,j);

theorem 
  for M1,M2 being Matrix of COMPLEX st len M1=len M2 & width M1=width M2
  holds (M1 + M2)*' = M1*' + M2*';

theorem 
  for M being Matrix of COMPLEX holds len (-M)=len M & width (-M)= width M;

theorem 
  for i,j being Nat,M being Matrix of COMPLEX st [i,j] in Indices
  M holds (-M)*(i,j)= -(M*(i,j));

theorem 
  for M being Matrix of COMPLEX holds (-1)*M = -M;

theorem 
  for M being Matrix of COMPLEX holds (-M)*' = -(M*');

theorem 
  for M1,M2 being Matrix of COMPLEX holds len (M1-M2)=len M1 &
  width (M1-M2)=width M1;

theorem 
  for i,j being Nat,M1,M2 be Matrix of COMPLEX st len M1=len M2 &
width M1=width M2 & [i,j] in Indices M1 holds (M1-M2)*(i,j)=(M1*(i,j)) - (M2*(i
  ,j));

theorem 
  for M1,M2 being Matrix of COMPLEX st len M1=len M2 & width M1=width M2
  holds (M1 - M2)*' = M1*' - M2*';

definition
  let M be Matrix of COMPLEX;
  func M@" -> Matrix of COMPLEX equals

  (M@)*';
end;

definition
  let x be FinSequence of COMPLEX;
  assume
 len x > 0;
  func FinSeq2Matrix x -> Matrix of COMPLEX means

  len it = len x & width it = 1 & for j st j in Seg len x holds it.j =<*x.j*>;
end;

definition
  let M be Matrix of COMPLEX;
  func Matrix2FinSeq M -> FinSequence of COMPLEX equals

  Col(M,1);
end;

definition
  let F1,F2 be FinSequence of COMPLEX;
  func mlt(F1,F2) -> FinSequence of COMPLEX equals

  multcomplex.:(F1,F2);
  commutativity;
end;

definition
  let M be Matrix of COMPLEX;
  let F be FinSequence of COMPLEX;

  func M*F -> FinSequence of COMPLEX means


  len it = len M & for i st i in Seg len M holds it.i=Sum mlt(Line(M,i),F);
end;

theorem 
  a*mlt(R1,R2) = mlt(a*R1,R2);

definition
  let M be Matrix of COMPLEX;
  let a be complex number;
  func M*a -> Matrix of COMPLEX equals

  a*M;
end;

theorem 
  for a being Element of COMPLEX,M being Matrix of COMPLEX holds (M*a)*'
  = a*'*(M*');

theorem 
  for F1,F2 being FinSequence of COMPLEX,i being Nat holds i in
  dom mlt(F1,F2) implies mlt(F1,F2).i = F1.i * F2.i;

definition
  let i be Element of NAT, R1,R2 be Element of i-tuples_on COMPLEX;
  redefine func mlt(R1,R2) -> Element of i-tuples_on COMPLEX;
end;

theorem 
  mlt(R1,R2).j = R1.j * R2.j;

theorem 
  for a,b being Element of COMPLEX holds addcomplex.(a,(b*'))*'=
  addcomplex.((a*'),b);

theorem 
  for F being FinSequence of COMPLEX ex G being Function of NAT,
  COMPLEX st for n being Nat st 1<= n & n<=len F holds G.n=F.n;

theorem 
  for F being FinSequence of COMPLEX st len (F*') >= 1 holds
  addcomplex $$ (F*') = (addcomplex $$ F)*';

theorem 
  for F being FinSequence of COMPLEX st len F >= 1 holds Sum(F*') = (Sum F)*';

theorem 
  for x,y being FinSequence of COMPLEX st len x=len y holds (mlt(x
  ,(y*')))*' = mlt(y,(x*'));

theorem 
  for x,y being FinSequence of COMPLEX,a being Element of COMPLEX
  st len x=len y holds (mlt(x,a*y)) = a*mlt(x,y);

theorem 
  for x,y being FinSequence of COMPLEX,a being Element of COMPLEX
  st len x=len y holds mlt(a*x,y) = a*mlt(x,y);

theorem 
  for x,y being FinSequence of COMPLEX st len x=len y holds (mlt(x
  ,y))*' = mlt(x*',y*');

theorem 
  for F being FinSequence of COMPLEX,a being Element of COMPLEX
  holds Sum(a*F) = a*(Sum F);

definition
  let x be FinSequence of REAL;
  func FR2FC(x) -> FinSequence of COMPLEX equals

  x;
end;

theorem 
  for R being FinSequence of REAL, F being FinSequence of COMPLEX st R =
  F & len R >= 1 holds addreal $$ R = addcomplex $$ F;

theorem 
  for x being FinSequence of REAL, y being FinSequence of COMPLEX st x=y
  & len x >=1 holds Sum x = Sum y;

theorem 
  for F1,F2 being FinSequence of COMPLEX st len F1=len F2 holds
  Sum(F1 - F2) = Sum F1 - Sum F2;

theorem 
  for x,y,z being FinSequence of COMPLEX st len x=len y & len y=len z
  holds mlt((x-y),z) = mlt(x,z)-mlt(y,z);

theorem 
  for x,y,z being FinSequence of COMPLEX st len x=len y & len y=
  len z holds mlt(x,y-z) = mlt(x,y)-mlt(x,z);

theorem 
  for x,y,z being FinSequence of COMPLEX st len x=len y & len y=len z
  holds mlt(x,y+z) = mlt(x,y)+mlt(x,z);

theorem 
  for x,y,z being FinSequence of COMPLEX st len x=len y & len y=
  len z holds mlt((x+y),z) = mlt(x,z)+mlt(y,z);

theorem 
  for F1,F2 being FinSequence of COMPLEX st len F1=len F2 holds
  Sum(F1 + F2) = Sum F1 + Sum F2;

theorem 
  for x1,y1 being FinSequence of COMPLEX for x2,y2 being
FinSequence of REAL st x1 = x2 & y1 = y2 & len x1=len y2 holds multcomplex.:(x1
  ,y1) = multreal.:(x2,y2);

theorem 
  for x,y being FinSequence of REAL st len x=len y holds FR2FC mlt(x,y)=
  mlt(FR2FC x,FR2FC y);

theorem 
  for x,y being FinSequence of COMPLEX st len x=len y holds |( x,y
  )| = Sum mlt(x,(y*'));

theorem 
  for i,j being Nat,M1,M2 being Matrix of COMPLEX st width M1=width M2 &
  j in Seg len M1 holds Line(M1+M2,j)=Line(M1,j)+Line(M2,j);

theorem 
  for M being Matrix of COMPLEX st i in Seg len M holds Line(M,i)=
  (Line(M*',i))*';

theorem 
  for F being FinSequence of COMPLEX,M being Matrix of COMPLEX st
  len F=width M holds mlt(F,(Line((M*'),i))*') = mlt(Line((M*'),i),(F*'))*';

theorem 
  for F being FinSequence of COMPLEX,M being Matrix of COMPLEX st
  len F = width M & len F >= 1 holds (M*F)*'=(M*')*(F*');

theorem 
  for F1,F2,F3 being FinSequence of COMPLEX st len F1 = len F2 & len F2
  = len F3 holds mlt(F1,mlt(F2,F3)) = mlt(mlt(F1,F2),F3);

theorem 
  for F being FinSequence of COMPLEX holds Sum -F = -(Sum F);

theorem 
  for F1,F2 being FinSequence of COMPLEX holds Sum(F1^F2) = Sum F1 + Sum F2;

definition
  let M be Matrix of COMPLEX;
  func LineSum M -> FinSequence of COMPLEX means


  len it=len M & for i being Nat st i in Seg len M holds it.i=Sum Line(M,i);
end;

definition
  let M be Matrix of COMPLEX;
  func ColSum M -> FinSequence of COMPLEX means


  len it=width M & for j
  being Nat st j in Seg width M holds it.j=Sum (Col(M,j));
end;

theorem 
  for F being FinSequence of COMPLEX holds len F = 1 implies Sum F = F.1;

theorem 
  for f,g being FinSequence of COMPLEX,n being Nat st len f = n +
  1 & g = f|n holds Sum f = Sum g + f/.(len f);

theorem 
  for M being Matrix of COMPLEX st len M > 0 holds Sum LineSum M = Sum ColSum M
;

definition
  let M be Matrix of COMPLEX;
  func SumAll M -> Element of COMPLEX equals

  Sum LineSum M;
end;

theorem 
  for M being Matrix of COMPLEX holds ColSum M = LineSum(M@);

theorem 
  for M being Matrix of COMPLEX st len M > 0 holds SumAll M = SumAll (M@);

definition
  let x,y be FinSequence of COMPLEX,M be Matrix of COMPLEX;
  assume that
 len x=len M and
 len y=width M;
  func QuadraticForm(x,M,y) -> Matrix of COMPLEX means


  len it = len x
& width it=len y & for i,j being Nat st [i,j] in Indices M holds it*(i,j)=(x.i)
  *(M*(i,j))*((y.j)*');
end;

theorem 
  for x,y being FinSequence of COMPLEX,M being Matrix of COMPLEX
st len x = len M & len y = width M & len y > 0 holds (QuadraticForm(x,M,y))@ =
  (QuadraticForm(y,M@",x))*';

theorem 
  for x,y being FinSequence of COMPLEX,M being Matrix of COMPLEX
st len x=len M & len y =width M holds (QuadraticForm(x,M,y))*'=QuadraticForm(x
  *',M*',y*');

theorem 
  for x,y being FinSequence of COMPLEX st len x=len y & 0 < len y
  holds |(x,y)|=(|(y,x)|)*';

theorem 
  for x,y being FinSequence of COMPLEX st len x=len y & 0 < len y
  holds (|(x,y)|)*'=|(x*',y*')|;

theorem 
  for M being Matrix of COMPLEX st width M > 0 holds (M@)*' =(M*')@;

theorem 
  for x,y being FinSequence of COMPLEX,M being Matrix of COMPLEX
  st len x=width M & len y = len M & len x>0 & len y>0 holds |(x,(M@")*y)| =
  SumAll QuadraticForm(x,M@,y);

theorem 
  for x,y being FinSequence of COMPLEX,M being Matrix of COMPLEX
  st len y=len M & len x =width M & len x>0 & len y>0 holds |(M*x,y)| = SumAll
  QuadraticForm(x,M@,y);

theorem 
  for x,y being FinSequence of COMPLEX, M being Matrix of COMPLEX
st len x=width M & len y =len M & width M>0 & len M>0 holds |(M*x,y)| = |(x,(M
  @")*y)|;

theorem 
  for x,y being FinSequence of COMPLEX,M being Matrix of COMPLEX st len
x=len M & len y =width M & width M>0 & len M>0 holds |(x,M*y)| = |((M@")*x,y)|;















begin

reserve D for non empty set,
  i,j,k for Element of NAT,
  n,m for Nat,
  r for Real,
  e for FinSequence of REAL;

definition
  let d be set, g be FinSequence of d*, n be Nat;
  redefine func g.n -> FinSequence of d;
end;

definition
  let x be real number;
  redefine func <*x*> -> FinSequence of REAL;
end;

theorem 
  for a being Element of D, m being non empty Nat, g being
  FinSequence of D holds (len g = m & for i be Nat st i in dom g holds g.i = a)
  iff g = m |-> a;

theorem 
  for a,b being Element of D holds ex g be FinSequence of D st len
g = n & for i be Nat st i in Seg n holds (i in Seg k implies g.i = a) & (not i
  in Seg k implies g.i = b);

theorem 
  (for i be Nat st i in dom e holds 0 <= e.i) implies for f being
Real_Sequence st (for n be Nat st 0 <> n & n < len e holds f.(n+1) = f.n+e.(n+1
  )) holds for n,m be Nat st n in dom e & m in dom e & n <= m holds f.n <= f.m;

theorem 
  len e >= 1 & (for i be Nat st i in dom e holds 0 <= e.i) implies
  for f being Real_Sequence st f.1 = e.1 & (for n be Nat st 0 <> n & n < len e
holds f.(n+1) = f.n+e.(n+1)) holds for n be Nat st n in dom e holds e.n <= f.n;

theorem 
  (for i be Nat st i in dom e holds 0 <= e.i) implies for k be Nat
  st k in dom e holds e.k <= Sum e;

theorem 
  for r1,r2 being Real, k being Nat, seq1 being Real_Sequence holds
ex seq being Real_Sequence st seq.0=r1 & for n holds (n<>0 & n <= k implies seq
  .n=seq1.n) & (n > k implies seq.n=r2);

theorem 
  for F being FinSequence of REAL holds ex f being Real_Sequence st
f.0 = 0 & (for i be Nat st i < len F holds f.(i+1) = f.i+(F.(i+1))) & Sum F = f
  .len F;

theorem 
  for D being set, e1 being FinSequence of D holds n |-> e1 is
  FinSequence of D*;

theorem 
  for D being set, e1,e2 being FinSequence of D holds ex e being
  FinSequence of D* st len e = n & for i be Nat st i in Seg n holds (i in Seg k
  implies e.i = e1) & (not i in Seg k implies e.i = e2);

theorem 
  for D being set, s being FinSequence holds (s is Matrix of D iff
ex n st for i st i in dom s holds ex p being FinSequence of D st s.i = p & len
  p = n);

theorem 
  for D being set, e being FinSequence of D* holds (ex n st for i
  st i in dom e holds len(e.i) = n) iff e is Matrix of D;

theorem 
  for M being tabular FinSequence holds [i,j] in Indices M iff i
  in Seg len M & j in Seg width M;

theorem 
  for D being non empty set, M being Matrix of D holds [i,j] in
  Indices M iff i in dom M & j in dom (M.i);

theorem 
  for D being non empty set, M being Matrix of D st [i,j] in
  Indices M holds M*(i,j)=(M.i).j;

theorem 
  for D being non empty set, M being Matrix of D holds [i,j] in
  Indices M iff i in dom Col(M,j) & j in dom Line(M,i);

theorem 
  for D1,D2 being non empty set, M1 being (Matrix of D1),M2 being
Matrix of D2 st M1 = M2 holds for i st i in dom M1 holds Line(M1,i) = Line(M2,i
  );

theorem 
  for D1,D2 being non empty set,M1 being (Matrix of D1),M2 being
Matrix of D2 st M1 = M2 holds for j st j in Seg width M1 holds Col(M1,j) = Col(
  M2,j);

theorem 
  for e1 being FinSequence of D st len e1 = m holds n |-> e1 is Matrix of n,m,D
;

theorem 
  for e1,e2 being FinSequence of D st len e1 = m & len e2 = m
holds ex M being Matrix of n,m,D st for i be Nat st i in Seg n holds (i in Seg
  k implies M.i = e1) & (not i in Seg k implies M.i = e2);

definition
  let e be FinSequence of REAL*;
  func Sum e -> FinSequence of REAL means


  len it = len e & for k st k in dom it holds it.k = Sum(e.k);
end;

notation
  let m be Matrix of REAL;
  synonym LineSum m for Sum m;
end;

theorem 
  for m being Matrix of REAL holds len Sum m = len m & for i st i
  in Seg len m holds (Sum m).i=Sum Line(m,i);

definition
  let m be Matrix of REAL;
  func ColSum m -> FinSequence of REAL means


  len it = width m & for j be Nat st j in Seg width m holds it.j=Sum Col(m,j);
end;

theorem 
  for M be Matrix of REAL st width M > 0 holds LineSum M = ColSum(M@);

theorem 
  for M be Matrix of REAL holds ColSum M = LineSum(M@);

definition
  let M be Matrix of REAL;
  func SumAll M -> Element of REAL equals

  Sum Sum M;
end;

theorem 
  for M be Matrix of REAL st len M = 0 holds SumAll M = 0;

theorem 
  for M be Matrix of m,0,REAL holds SumAll M = 0;

theorem 
  for M1 be Matrix of n,k,REAL for M2 being Matrix of m,k,REAL
  holds Sum (M1^M2) = (Sum M1)^(Sum M2);

theorem 
  for M1,M2 be Matrix of REAL holds Sum M1 + Sum M2 = Sum (M1 ^^ M2);

theorem 
  for M1,M2 be Matrix of REAL st len M1 = len M2 holds SumAll M1 +
  SumAll M2 = SumAll(M1 ^^ M2);

theorem 
  for M be Matrix of REAL holds SumAll M = SumAll(M@);

theorem 
  for M be Matrix of REAL holds SumAll M = Sum ColSum M;

theorem 
  for x,y being FinSequence of REAL st len x = len y holds len mlt
  (x,y)=len x;

theorem 
  for i for R being Element of i-tuples_on REAL holds mlt(i|->1,R) = R;

theorem 
  for x being FinSequence of REAL holds mlt((len x|->1),x) = x;

theorem 
  for x,y being FinSequence of REAL st (for i st i in dom x holds
x.i >= 0) & (for i st i in dom y holds y.i >= 0) holds for k st k in dom mlt(x,
  y) holds (mlt(x,y)).k >= 0;

theorem 
  for i for e1,e2 being Element of i-tuples_on REAL for f1,f2
  being Element of i-tuples_on the carrier of F_Real st e1 = f1 & e2 = f2 holds
  mlt(e1,e2) = mlt(f1,f2);

theorem 
  for e1,e2 being FinSequence of REAL for f1,f2 being FinSequence
of F_Real st len e1 = len e2 & e1 = f1 & e2 = f2 holds mlt(e1,e2) = mlt(f1,f2);

theorem 
  for e being FinSequence of REAL for f being FinSequence of
  F_Real st e = f holds Sum e = Sum f;

notation
  let e1,e2 be FinSequence of REAL;
  synonym e1 "*" e2 for |( e1,e2 )|;
end;

theorem 
  for i for e1,e2 being Element of i-tuples_on REAL for f1,f2 being
Element of i-tuples_on the carrier of F_Real st e1 = f1 & e2 = f2 holds e1 "*"
  e2 = f1 "*" f2;

theorem 
  for e1,e2 being FinSequence of REAL for f1,f2 being FinSequence
  of F_Real st len e1 = len e2 & e1 = f1 & e2 = f2 holds e1 "*" e2 = f1 "*" f2;

theorem 
  for M,M1,M2 being Matrix of REAL st width M1 = len M2 holds M =
  M1*M2 iff len M = len M1 & width M = width M2 & for i,j st [i,j] in Indices M
  holds M*(i,j) = Line(M1,i) "*" Col(M2,j);

theorem 
  for M being Matrix of REAL for p being FinSequence of REAL st
len M = len p holds for i st i in Seg len (p*M) holds (p*M).i = p "*" Col(M,i);

theorem 
  for M being Matrix of REAL for p being FinSequence of REAL st
width M = len p & width M > 0 holds for i st i in Seg len (M*p) holds (M*p).i =
  Line(M,i) "*" p;

theorem 
  for M,M1,M2 being Matrix of REAL st width M1 = len M2 holds M =
  M1*M2 iff len M = len M1 & width M = width M2 & for i st i in Seg len M holds
  Line(M,i) = Line(M1,i) * M2;

definition
  let x,y be FinSequence of REAL,M be Matrix of REAL;
  assume that
 len x = len M and
 len y = width M;
  func QuadraticForm(x,M,y) -> Matrix of REAL means


  len it = len x &
width it = len y & for i,j be Nat st [i,j] in Indices M holds it*(i,j)=(x.i)*(M
  *(i,j))*(y.j);
end;

theorem 
  for x,y being FinSequence of REAL,M being Matrix of REAL st len x =
  len M & len y = width M & len y > 0 holds (QuadraticForm(x,M,y))@ =
  QuadraticForm(y,M@,x);

theorem 
  for x,y being FinSequence of REAL,M being Matrix of REAL st len
x = len M & len y = width M & len y>0 holds |(x,M*y)| = SumAll QuadraticForm(x,
  M,y);

theorem 
  for x being FinSequence of REAL holds |(x,(len x |-> 1))| = Sum x;

theorem 
  for x,y being FinSequence of REAL,M being Matrix of REAL st len
  x = len M & len y = width M holds |(x*M,y)| = SumAll QuadraticForm(x,M,y);

theorem 
  for x,y being FinSequence of REAL,M being Matrix of REAL st len
  x = len M & len y = width M & len y>0 holds |((x*M),y)| = |(x,(M*y))|;

theorem 
  for x,y being FinSequence of REAL,M being Matrix of REAL st len y=len
  M & len x =width M & len x>0 & len y>0 holds |((M*x),y)| = |(x,(M@*y))|;

theorem 
  for x,y being FinSequence of REAL,M being Matrix of REAL st len
  y=len M & len x =width M & len x>0 & len y>0 holds |(x,(y*M))| = |((x*M@),y)|
;

theorem 
  for x being FinSequence of REAL,M being Matrix of REAL st len x
= len M & x = len x |-> 1 holds for k st k in Seg len(x*M) holds (x*M).k = Sum
  Col(M,k);

theorem 
  for x being FinSequence of REAL,M being Matrix of REAL st len x =
  width M & width M > 0 & x = (len x |-> 1) holds for k st k in Seg len(M*x)
  holds (M*x).k = Sum Line(M,k);

theorem 
  for n being non empty Nat ex P being FinSequence of REAL st len
  P = n & (for i st i in dom P holds P.i >= 0) & Sum P = 1;

definition
  let p be FinSequence of REAL;
  attr p is ProbFinS means


  (for i st i in dom p holds p.i >= 0) & Sum p = 1;
end;

registration
  cluster non empty ProbFinS for FinSequence of REAL;
end;

theorem 
  for p being non empty ProbFinS FinSequence of REAL holds for k st k in
  dom p holds p.k <= 1;

theorem 
  for M being non empty-yielding Matrix of D holds 1<=len M & 1<= width M;

definition
  let M be Matrix of REAL;
  attr M is m-nonnegative means


  for i,j st [i,j] in Indices M holds M*( i,j) >= 0;
end;

definition
  let M be Matrix of REAL;
  attr M is with_sum=1 means


  SumAll M = 1;
end;

definition
  let M be Matrix of REAL;
  attr M is Joint_Probability means


  M is m-nonnegative with_sum=1;
end;

registration
  cluster Joint_Probability -> m-nonnegative with_sum=1 for Matrix of REAL;
  cluster m-nonnegative with_sum=1 -> Joint_Probability for Matrix of REAL;
end;

theorem 
  for n,m being non empty Nat holds ex M be Matrix of n,m,REAL st
  M is m-nonnegative & SumAll M = 1;

registration
  cluster non empty-yielding Joint_Probability for Matrix of REAL;
end;

theorem 
  for M being non empty-yielding Joint_Probability Matrix of REAL
  holds M@ is non empty-yielding Joint_Probability Matrix of REAL;

theorem 
  for M being non empty-yielding Joint_Probability Matrix of REAL holds
  for i,j st [i,j] in Indices M holds M*(i,j) <= 1;

definition
  let M be Matrix of REAL;
  attr M is with_line_sum=1 means


  for k st k in dom M holds Sum (M.k) = 1;
end;

theorem 
  for n,m being non empty Nat holds ex M being Matrix of n,m,REAL
  st M is m-nonnegative with_line_sum=1;

definition
  let M be Matrix of REAL;
  attr M is Conditional_Probability means


  M is m-nonnegative with_line_sum=1;
end;

registration
  cluster Conditional_Probability -> m-nonnegative with_line_sum=1 for
Matrix of
    REAL;
  cluster m-nonnegative with_line_sum=1 -> Conditional_Probability for
Matrix of
    REAL;
end;

registration
  cluster non empty-yielding Conditional_Probability for Matrix of REAL;
end;

theorem 
  for M being non empty-yielding Conditional_Probability Matrix of REAL
  holds for i,j st [i,j] in Indices M holds M*(i,j) <= 1;

theorem 
  for M being non empty-yielding Matrix of REAL holds M is non
  empty-yielding Conditional_Probability Matrix of REAL iff for i st i in dom M
  holds Line(M,i) is non empty ProbFinS FinSequence of REAL;

theorem 
  for M being non empty-yielding with_line_sum=1 Matrix of REAL holds
  SumAll M = len M;

notation
  let M be Matrix of REAL;
  synonym Row_Marginal M for LineSum M;
  synonym Column_Marginal M for ColSum M;
end;

registration
  let M be non empty-yielding Joint_Probability Matrix of REAL;
  cluster Row_Marginal M -> non empty ProbFinS;
  cluster Column_Marginal M -> non empty ProbFinS;
end;

registration
  let M be non empty-yielding Matrix of REAL;
  cluster M@ -> non empty-yielding;
end;

registration
  let M be non empty-yielding Joint_Probability Matrix of REAL;
  cluster M@ -> Joint_Probability;
end;

theorem 
  for p being non empty ProbFinS FinSequence of REAL for P being
  non empty-yielding Conditional_Probability Matrix of REAL st len p = len P
  holds p * P is non empty ProbFinS FinSequence of REAL & len (p * P) = width P
;

theorem 
  for P1, P2 being non empty-yielding Conditional_Probability Matrix of
  REAL st width P1 = len P2 holds P1 * P2 is non empty-yielding
  Conditional_Probability Matrix of REAL & len (P1 * P2) = len P1 & width (P1 *
  P2) = width P2;














begin 

reserve x,y for set,
        r,s for Real,
        S for non empty addLoopStr,
        LS,LS1,LS2 for Linear_Combination of S,
        G for Abelian add-associative right_zeroed right_complementable
          non empty addLoopStr,
        LG,LG1,LG2 for Linear_Combination of G,
        g,h for Element of G,
        RLS for non empty RLSStruct,
        R for vector-distributive scalar-distributive scalar-associative
        scalar-unitalnon empty RLSStruct,
        AR for Subset of R,
        LR,LR1,LR2 for Linear_Combination of R,
        V for RealLinearSpace,
        v,v1,v2,w,p for VECTOR of V,
        A,B for Subset of V,
        F1,F2 for Subset-Family of V,
        L,L1,L2 for Linear_Combination of V;

registration
  let RLS;
  let A be empty Subset of RLS;
  cluster conv A -> empty;
end;

registration let RLS;
  let A be non empty Subset of RLS;
  cluster conv A -> non empty;
end;

theorem 
  for v be Element of R holds conv {v} = {v};

theorem 
  for A be Subset of RLS holds A c= conv A;

theorem 
  for A,B be Subset of RLS st A c= B holds conv A c= conv B;

theorem 
  for S,A be Subset of RLS st A c= conv S holds conv S = conv(S\/A);

theorem 
  for V be add-associative non empty addLoopStr
     for A be Subset of V for v,w be Element of V
    holds (v+w)+A = v+(w+A);

theorem 
  for V be Abelian right_zeroed non empty addLoopStr for A be Subset of V
    holds 0.V + A = A;

theorem 
  for A be Subset of G holds card A = card (g+A);

theorem 
  for v be Element of S holds v + {}S = {}S;

theorem 
  for A,B be Subset of RLS st A c= B holds r*A c= r*B;

theorem 
  (r*s)* AR = r * (s*AR);

theorem 
  1 * AR = AR;

theorem 
  0 * A c= {0.V};

theorem 
  for F be FinSequence of S holds (LS1+LS2) * F = (LS1*F) + (LS2*F);

theorem 
  for F be FinSequence of V holds (r*L) * F = r * (L*F);

theorem 
  A is linearly-independent & A c= B & Lin B = V implies
    ex I be linearly-independent Subset of V st A c= I & I c= B & Lin I = V;

begin 

definition
  let G,LG,g;
  func g + LG -> Linear_Combination of G means

    it.h = LG.(h-g);
end;

theorem 
  Carrier (g+LG) = g + Carrier LG;

theorem 
  g + (LG1+LG2) = (g+LG1) + (g+LG2);

theorem 
  v + (r*L) = r * (v+L);

theorem 
  g + (h+LG) = (g+h) + LG;

theorem 
  g + ZeroLC G = ZeroLC G;

theorem 
  0.G + LG = LG;

definition
  let R,LR,r;
  func r (*) LR -> Linear_Combination of R means

    for v be Element of R holds it.v = LR.(r"*v) if r<>0 otherwise
   it = ZeroLC R;
end;

theorem 
  Carrier (r(*)LR) c= r*Carrier LR;

theorem 
  r <> 0 implies Carrier (r(*)LR) = r * Carrier LR;

theorem 
  r (*) (LR1+LR2) = (r(*)LR1) + (r(*)LR2);

theorem 
  r * (s(*)L) = s (*) (r*L);

theorem 
  r (*) ZeroLC(R) = ZeroLC R;

theorem 
  r(*)(s(*)LR)=(r*s)(*)LR;

theorem 
  1 (*) LR = LR;

begin 

definition
 let S,LS;
 func sum LS -> Real means

   ex F be FinSequence of S st
      F is one-to-one & rng F = Carrier LS & it = Sum (LS*F);
end;

theorem 
  for F be FinSequence of S st Carrier LS misses rng F holds Sum (LS*F) = 0;

theorem 
  for F be FinSequence of S st F is one-to-one & Carrier LS c= rng F
    holds sum LS = Sum (LS*F);

theorem 
  sum ZeroLC S = 0;

theorem 
  for v be Element of S st Carrier LS c= {v} holds sum LS = LS.v;

theorem 
  for v1,v2 be Element of S st
      Carrier LS c= {v1,v2} & v1 <> v2 holds sum LS = LS.v1 + LS.v2;

theorem 
  sum (LS1+LS2) = sum LS1 + sum LS2;

theorem 
  sum (r * L) = r * sum L;

theorem 
  sum (L1-L2) =sum L1 - sum L2;

theorem 
  sum LG = sum (g+LG);

theorem 
  r <> 0 implies sum LR = sum (r(*)LR);

theorem 
  Sum (v + L) = (sum L)*v + Sum L;

theorem 
  Sum (r(*)L) = r * Sum L;

begin 

definition
  let V,A;
  attr A is affinely-independent means

    A is empty or ex v st v in A & -v + A\{0.V} is linearly-independent;
end;

registration
  let V;
  cluster empty -> affinely-independent for Subset of V;
  let v;
  cluster {v} -> affinely-independent for Subset of V;
  let w;
  cluster {v,w} -> affinely-independent for Subset of V;
end;

registration
  let V;
  cluster 1-element affinely-independent for Subset of V;
end;

theorem 
  A is affinely-independent iff for v st v in A holds
                                      -v + A\{0.V} is linearly-independent;

theorem 
  A is affinely-independent iff
      for L be Linear_Combination of A st Sum L = 0.V & sum L = 0
        holds Carrier L = {};

theorem 
  A is affinely-independent & B c= A implies B is affinely-independent;

registration
  let V;
  cluster linearly-independent -> affinely-independent for Subset of V;
end;

reserve I for affinely-independent Subset of V;

registration
  let V,I,v;
  cluster v + I -> affinely-independent;
end;

theorem 
  v+A is affinely-independent implies A is affinely-independent;

registration
  let V,I,r;
  cluster r*I -> affinely-independent;
end;

theorem 
  r * A is affinely-independent & r <> 0 implies A is affinely-independent;

theorem 
  0.V in A implies
    (A is affinely-independent iff A \ {0.V} is linearly-independent);

definition
  let V;
  let F be Subset-Family of V;
  attr F is affinely-independent means

   A in F implies A is affinely-independent;
end;

registration
  let V;
  cluster empty -> affinely-independent for Subset-Family of V;
  let I;
  cluster {I} -> affinely-independent for Subset-Family of V;
end;

registration
  let V;
  cluster empty affinely-independent for Subset-Family of V;
  cluster non empty affinely-independent for Subset-Family of V;
end;

theorem 
  F1 is affinely-independent & F2 is affinely-independent implies
     F1 \/ F2 is affinely-independent;

theorem 
  F1 c= F2 & F2 is affinely-independent implies F1 is affinely-independent;

begin 

definition
  let RLS;
  let A be Subset of RLS;
  func Affin A -> Subset of RLS equals

    meet {B where B is Affine Subset of RLS : A c= B};
end;

registration
  let RLS;
  let A be Subset of RLS;
  cluster Affin A -> Affine;
end;

registration
  let RLS;
  let A be empty Subset of RLS;
  cluster Affin A -> empty;
end;

registration
  let RLS;
  let A be non empty Subset of RLS;
  cluster Affin A -> non empty;
end;

theorem 
  for A be Subset of RLS holds A c= Affin A;

theorem 
  for A be Affine Subset of RLS holds A = Affin A;

theorem 
  for A,B be Subset of RLS st A c= B & B is Affine holds Affin A c= B;

theorem 
  for A,B be Subset of RLS st A c= B holds Affin A c= Affin B;

theorem 
  Affin (v+A) = v + Affin A;

theorem 
  AR is Affine implies r * AR is Affine;

theorem 
  r <> 0 implies Affin (r*AR) = r * Affin AR;

theorem 
  Affin (r*A) = r * Affin A;

theorem 
  v in Affin A implies Affin A = v + Up Lin (-v+A);

theorem 
  A is affinely-independent iff for B st B c= A & Affin A = Affin B holds A = B
;

theorem 
  Affin A = {Sum L where L is Linear_Combination of A : sum L=1};

theorem 
  I c=A implies ex Ia be affinely-independent Subset of V st
    I c= Ia & Ia c= A & Affin Ia = Affin A;

theorem 
  for A,B be finite Subset of V st
      A is affinely-independent & Affin A = Affin B & card B <= card A
    holds B is affinely-independent;

theorem 
  L is convex iff sum L = 1 & for v holds 0 <= L.v;

theorem 
  L is convex implies L.x <= 1;

theorem 
  L is convex & L.x = 1 implies Carrier L = {x};

theorem 
  conv A c= Affin A;

theorem 
  x in conv A & (conv A)\{x} is convex implies x in A;

theorem 
  Affin conv A = Affin A;

theorem 
  conv A c= conv B implies Affin A c= Affin B;

theorem 
  for A,B be Subset of RLS st A c= Affin B holds Affin (A\/B) = Affin B;

begin 

definition
  let V;
  let A such that
     A is affinely-independent;
  let x such that
     x in Affin A;
  func x |-- A -> Linear_Combination of A means

    Sum it = x & sum it = 1;
end;

theorem 
  v1 in Affin I & v2 in Affin I implies
  ((1-r)*v1+r*v2) |-- I = (1-r) * (v1|--I) + r * (v2|--I);

theorem 
  x in conv I implies x|--I is convex & 0 <= (x|--I).v & (x|--I).v <= 1;

theorem 
  x in conv I implies ((x|--I).y = 1 iff x = y & x in I);

theorem 
  for I st x in Affin I & for v st v in I holds 0 <= (x|--I).v
    holds x in conv I;

theorem 
  x in I implies (conv I)\{x} is convex;

theorem 
  for B st x in Affin I & for y st y in B holds (x|--I).y = 0
    holds x in Affin(I\B) & x |-- I = x |-- (I\B);

theorem 
  for B st x in conv I & for y st y in B holds (x|--I).y = 0
    holds x in conv (I\B);

theorem 
  B c= I & x in Affin B implies x |-- B = x |-- I;

theorem 
  v1 in Affin A & v2 in Affin A & r+s = 1 implies r*v1 + s*v2 in Affin A;

theorem 
  for A,B be finite Subset of V st
      A is affinely-independent & Affin A c= Affin B
    holds card A <= card B;

theorem 
  for A,B be finite Subset of V st
      A is affinely-independent & Affin A c= Affin B & card A = card B
    holds B is affinely-independent;

theorem 
  L1.v <> L2.v implies ((r*L1+(1-r)*L2).v = s iff r = (L2.v-s)/(L2.v-L1.v));

theorem 
  A\/{v} is affinely-independent iff
    A is affinely-independent & (v in A or not v in Affin A);

theorem 
  not w in Affin A & v1 in A & v2 in A & r<>1 & r*w + (1-r)*v1 = s*w + (1-s)*v2
    implies r = s & v1 = v2;

theorem 
  v in I & w in Affin I & p in Affin(I\{v}) & w = r*v + (1-r)*p
    implies r = (w|--I).v;














begin

theorem 
  for f,g being Function st product f = product g holds f is
  non-empty implies g is non-empty;

theorem 
  for X being set holds 2 c= card X iff ex x,y being set st x in X
  & y in X & x<>y;

theorem 
  for X being set st 2 c= card X for x being set ex y being set st
  y in X & x<>y;

theorem 
  for X being set holds 2 c= card X iff X is non trivial;

theorem 
  for X being set holds 3 c= card X iff ex x,y,z being set st x in
  X & y in X & z in X & x<>y & x<>z & y<>z;

theorem 
  for X being set st 3 c= card X for x,y being set ex z being set
  st z in X & x<>z & y<>z;

begin

definition
  let S be TopStruct;
  mode Block of S is Element of the topology of S;
end;

definition
  let S be TopStruct;
  let x,y be Point of S;
  pred x,y are_collinear means


  x=y or ex l being Block of S st {x,y} c= l;
end;

definition
  let S be TopStruct;
  let T be Subset of S;
  attr T is closed_under_lines means


  for l being Block of S st 2 c= card (l /\ T) holds l c= T;
  attr T is strong means


  for x,y being Point of S st x in T & y in T holds x,y are_collinear;
end;

definition
  let S be TopStruct;
  attr S is void means


  the topology of S is empty;
  attr S is degenerated means


  the carrier of S is Block of S;
  attr S is with_non_trivial_blocks means


  for k being Block of S holds 2 c= card k;
  attr S is identifying_close_blocks means


  for k,l being Block of S st 2 c= card(k /\ l) holds k=l;
  attr S is truly-partial means


  ex x,y being Point of S st not x,y are_collinear;
  attr S is without_isolated_points means


  for x being Point of S ex l being Block of S st x in l;
  attr S is connected means

  for x,y being Point of S ex f being FinSequence of
the carrier of S st x=f.1 & y=f.(len f) & for i being Nat st 1 <= i & i < len f
  for a,b being Point of S st a = f.i & b = f.(i+1) holds a,b are_collinear;
  attr S is strongly_connected means


  for x being Point of S for X
  being Subset of S st X is closed_under_lines strong ex f being FinSequence of
bool the carrier of S st X = f.1 & x in f.(len f) & (for W being Subset of S st
W in rng f holds W is closed_under_lines strong) & for i being Nat st 1 <= i &
  i < len f holds 2 c= card((f.i) /\ (f.(i+1)));
end;

theorem 
  for X being non empty set st 3 c= card X for S being TopStruct st
the carrier of S = X & the topology of S = {L where L is Subset of X : 2 = card
  L} holds S is non empty non void non degenerated non truly-partial
  with_non_trivial_blocks identifying_close_blocks without_isolated_points;

theorem 
  for X being non empty set st 3 c= card X for K being Subset of X
st card K = 2 for S being TopStruct st the carrier of S = X & the topology of S
  = {L where L is Subset of X : 2 = card L} \ {K} holds S is non empty non void
non degenerated truly-partial with_non_trivial_blocks identifying_close_blocks
  without_isolated_points;

registration
  cluster strict non empty non void non degenerated non truly-partial
    with_non_trivial_blocks identifying_close_blocks without_isolated_points
    for TopStruct;
  cluster strict non empty non void non degenerated truly-partial
    with_non_trivial_blocks identifying_close_blocks without_isolated_points
    for TopStruct;
end;

registration
  let S be non void TopStruct;
  cluster the topology of S -> non empty;
end;

definition
  let S be without_isolated_points TopStruct;
  let x,y be Point of S;
  redefine pred x,y are_collinear means

  ex l being Block of S st {x,y} c= l;
end;

definition
  mode PLS is non empty non void non degenerated with_non_trivial_blocks
    identifying_close_blocks TopStruct;
end;

definition
  let F be Relation;
  attr F is TopStruct-yielding means


  for x being set st x in rng F holds x is TopStruct;
end;

registration
  cluster TopStruct-yielding -> 1-sorted-yielding for Function;
end;

registration
  let I be set;
  cluster TopStruct-yielding for ManySortedSet of I;
end;

registration
  cluster TopStruct-yielding for Function;
end;

definition
  let F be Relation;
  attr F is non-void-yielding means


  for S being TopStruct st S in rng F holds S is non void;
end;

definition
  let F be TopStruct-yielding Function;
  redefine attr F is non-void-yielding means

  for i being set st i in rng F holds i is non void TopStruct;
end;

definition
  let F be Relation;
  attr F is trivial-yielding means


  for S being set st S in rng F holds S is trivial;
end;

definition
  let F be Relation;
  attr F is non-Trivial-yielding means


  for S being 1-sorted st S in rng F holds S is non trivial;
end;

registration
  cluster non-Trivial-yielding -> non-Empty for Relation;
end;

definition
  let F be 1-sorted-yielding Function;
  redefine attr F is non-Trivial-yielding means

  for i being set st i in rng F holds i is non trivial 1-sorted;
end;

definition
  let I be non empty set;
  let A be TopStruct-yielding ManySortedSet of I;
  let j be Element of I;
  redefine func A.j -> TopStruct;
end;

definition
  let F be Relation;
  attr F is PLS-yielding means


  for x being set st x in rng F holds x is PLS;
end;

registration
  cluster PLS-yielding -> non-Empty TopStruct-yielding for Function;
  cluster PLS-yielding -> non-void-yielding for TopStruct-yielding Function;
  cluster PLS-yielding -> non-Trivial-yielding for
TopStruct-yielding Function;
end;

registration
  let I be set;
  cluster PLS-yielding for ManySortedSet of I;
end;

definition
  let I be non empty set;
  let A be PLS-yielding ManySortedSet of I;
  let j be Element of I;
  redefine func A.j -> PLS;
end;

definition
  let I be set;
  let A be ManySortedSet of I;
  attr A is Segre-like means


  ex i being Element of I st for j being
  Element of I st i<>j holds A.j is 1-element;
end;

registration
  let I be set;
  let A be ManySortedSet of I;
  cluster {A} -> trivial-yielding;
end;

theorem 
  for I being non empty set for A being ManySortedSet of I for i being
Element of I for S being non trivial set holds A+*(i,S) is non trivial-yielding
;

registration
  let I be non empty set;
  let A be ManySortedSet of I;
  cluster {A} -> Segre-like;
end;

theorem 
  for I being non empty set for A being ManySortedSet of I for i,S be
  set holds {A}+*(i,S) is Segre-like;

theorem 
  for I being non empty set for A being non-Empty
1-sorted-yielding ManySortedSet of I for B being Element of Carrier A holds {B
  } is ManySortedSubset of Carrier A;

registration
  let I be non empty set;
  let A be non-Empty 1-sorted-yielding ManySortedSet of I;
  cluster Segre-like trivial-yielding non-empty for
ManySortedSubset of Carrier A;
end;

registration
  let I be non empty set;
  let A be non-Trivial-yielding 1-sorted-yielding ManySortedSet of I;
  cluster Segre-like non trivial-yielding non-empty for ManySortedSubset of
    Carrier A;
end;

registration
  let I be non empty set;
  cluster Segre-like non trivial-yielding for ManySortedSet of I;
end;

definition
  let I be non empty set;
  let B be Segre-like non trivial-yielding ManySortedSet of I;
  func indx(B) -> Element of I means


  B.it is non trivial;
end;

theorem 
  for I being non empty set for A being Segre-like non
  trivial-yielding ManySortedSet of I for i being Element of I st i <> indx(A)
  holds A.i is 1-element;

registration
  let I be non empty set;
  cluster Segre-like non trivial-yielding -> non-empty for ManySortedSet of I;
end;

theorem 
  for I being non empty set for A being ManySortedSet of I holds 2
  c= card (product A) iff A is non-empty non trivial-yielding;

registration
  let I be non empty set;
  let B be Segre-like non trivial-yielding ManySortedSet of I;
  cluster product B -> non trivial;
end;

begin

definition
  let I be non empty set;
  let A be non-Empty TopStruct-yielding ManySortedSet of I;
  func Segre_Blocks(A) -> Subset-Family of product Carrier A means


  for
x being set holds x in it iff ex B being Segre-like ManySortedSubset of Carrier
  A st x = product B & ex i being Element of I st B.i is Block of A.i;
end;

definition
  let I be non empty set;
  let A be non-Empty TopStruct-yielding ManySortedSet of I;
  func Segre_Product A -> non empty TopStruct equals

  TopStruct(#product Carrier A, Segre_Blocks A#);
end;

theorem 
  for I being non empty set for A be non-Empty TopStruct-yielding
  ManySortedSet of I for x being Point of Segre_Product A holds x is
  ManySortedSet of I;

theorem 
  for I being non empty set for A being non-Empty
TopStruct-yielding ManySortedSet of I st ex i being Element of I st A.i is non
  void holds Segre_Product A is non void;

theorem 
  for I being non empty set for A being non-Empty
TopStruct-yielding ManySortedSet of I st for i being Element of I holds A.i is
  non degenerated & ex i being Element of I st A.i is non void holds
  Segre_Product A is non degenerated;

theorem 
  for I being non empty set for A being non-Empty
TopStruct-yielding ManySortedSet of I st for i being Element of I holds A.i is
  with_non_trivial_blocks & ex i being Element of I st A.i is non void holds
  Segre_Product A is with_non_trivial_blocks;

theorem 
  for I being non empty set for A being non-Empty
TopStruct-yielding ManySortedSet of I st for i being Element of I holds A.i is
identifying_close_blocks with_non_trivial_blocks & ex i being Element of I st A
  .i is non void holds Segre_Product A is identifying_close_blocks;

registration
  let I be non empty set;
  let A be PLS-yielding ManySortedSet of I;
  cluster Segre_Product A -> non void non degenerated
    with_non_trivial_blocks identifying_close_blocks;
end;

theorem 
  for T being TopStruct for S being Subset of T holds S is trivial
  implies S is strong closed_under_lines;

theorem 
  for S being identifying_close_blocks TopStruct, l being Block of
  S for L being Subset of S st L=l holds L is closed_under_lines;

theorem 
  for S being TopStruct, l being Block of S for L being Subset of
  S st L=l holds L is strong;

theorem 
  for S being non void TopStruct holds [#]S is closed_under_lines;

theorem 
  for I being non empty set for A being Segre-like non
  trivial-yielding ManySortedSet of I for x,y being ManySortedSet of I st x in
  product A & y in product A for i being set st i <> indx(A) holds x.i = y.i;

theorem 
  for I being non empty set for A being PLS-yielding ManySortedSet
  of I for x being set holds x is Block of Segre_Product A iff ex L being
Segre-like non trivial-yielding ManySortedSubset of Carrier A st x = product L
  & L.indx(L) is Block of A.indx(L);

theorem 
  for I being non empty set for A being PLS-yielding ManySortedSet
  of I for P being ManySortedSet of I st P is Point of Segre_Product A for i
  being Element of I for p being Point of A.i holds P+*(i,p) is Point of
  Segre_Product A;

theorem 
  for I being non empty set for A,B being Segre-like non
  trivial-yielding ManySortedSet of I st 2 c= card ((product A) /\ (product B))
  holds indx(A) = indx(B) & for i being set st i <> indx(A) holds A.i = B.i;

theorem 
  for I being non empty set for A being Segre-like non
trivial-yielding ManySortedSet of I for N being non trivial set holds A+*(indx(
  A),N) is Segre-like non trivial-yielding;

theorem 
  for S being non empty non void identifying_close_blocks
  without_isolated_points TopStruct holds S is strongly_connected implies S is
  connected;

theorem 
  for I being non empty set for A being PLS-yielding ManySortedSet of I
  for S being Subset of Segre_Product A holds S is non trivial strong
  closed_under_lines iff ex B being Segre-like non trivial-yielding
ManySortedSubset of Carrier A st S = product B & for C being Subset of A.indx(B
  ) st C=B.indx(B) holds C is strong closed_under_lines;














begin 

reserve X,x,y,z for set;
reserve n,m,k,k9,d9 for Element of NAT;

theorem 
  for x,y being real number st x < y ex z being Real st x < z & z < y;

theorem 
  for x,y being real number ex z being Real st x < z & y < z;

scheme 
 FrSet12 { D()->non empty set, A()->non empty set, P[set,set],
  F(set,set)->Element of D() } :
  { F(x,y) where x,y is Element of A() : P[x,y] } c= D();



definition
  let B be set;
  let A be Subset of B;
  redefine func bool A -> Subset-Family of B;
end;



definition
  let d be real Element of NAT;
  redefine attr d is zero means

  not d > 0;
end;

definition
  let d be Element of NAT;
  redefine attr d is zero means


  not d >= 1;
end;

reserve d for non zero Element of NAT;
reserve i,i0,i1 for Element of Seg d;



theorem 
  {x,y} is trivial iff x = y;

registration
  cluster non trivial finite for set;
end;

registration
  let X be non trivial set;
  let Y be set;
  cluster X \/ Y -> non trivial;
  cluster Y \/ X -> non trivial;
end;

registration
  let X be non trivial set;
  cluster non trivial finite for Subset of X;
end;

theorem 
  X is trivial & X \/ {y} is non trivial implies ex x st X = {x};

scheme 
 NonEmptyFinite
  { X()->non empty set, A()->non empty finite Subset of X(), P[set] } : P[A()]
provided
 for x being Element of X() st x in A() holds P[{x}] and
 for x being Element of X(), B being non empty finite Subset of X()
st x in A() & B c= A() & not x in B & P[B] holds P[B \/ {x}];

scheme 
 NonTrivialFinite
  { X()->non trivial set, A()->non trivial finite Subset of X(), P[set] } :
  P[A()]
provided
 for x,y being Element of X() st x in A() & y in A() & x <> y
holds P[{x,y}] and
 for x being Element of X(), B being non trivial finite Subset of X()
st x in A() & B c= A() & not x in B & P[B] holds P[B \/ {x}];



theorem 
  card X = 2 iff
  ex x,y st x in X & y in X & x <> y & for z st z in X holds z = x or z = y;

theorem 
  (m is even iff n is even) iff m + n is even;

theorem 
  for X,Y being finite set st X misses Y holds
  (card X is even iff card Y is even) iff card(X \/ Y) is even;

theorem 
  for X,Y being finite set holds
  (card X is even iff card Y is even) iff card(X \+\ Y) is even;



definition
  let n;
  redefine func REAL n means


  for x holds x in it iff x is Function of Seg n,REAL;
end;

reserve l,r,l9,r9,l99,r99,x,x9,l1,r1,l2,r2 for Element of REAL d;
reserve Gi for non trivial finite Subset of REAL;
reserve li,ri,li9,ri9,xi,xi9 for Real;

begin 


definition
  let d;
  mode Grating of d -> Function of Seg d,bool REAL means


    for i holds it.i is non trivial finite;
end;

reserve G for Grating of d;

registration
  let d;
 cluster -> finite-yielding for Grating of d;
end;

definition
  let d,G,i;
  redefine func G.i -> non trivial finite Subset of REAL;
end;

theorem 
  x in product G iff for i holds x.i in G.i;



canceled;

theorem 
  for X being non empty finite Subset of REAL holds
  ex ri st ri in X & for xi st xi in X holds ri >= xi;

theorem 
  for X being non empty finite Subset of REAL holds
  ex li st li in X & for xi st xi in X holds li <= xi;

theorem 
  ex li,ri st li in Gi & ri in Gi &
  li < ri & for xi st xi in Gi holds not (li < xi & xi < ri);

theorem 
  for X being non empty finite Subset of REAL holds
  ex ri st ri in X & for xi st xi in X holds ri >= xi;

theorem 
  ex li,ri st li in Gi & ri in Gi &
  ri < li & for xi st xi in Gi holds not (xi < ri or li < xi);

definition
  let Gi;
  mode Gap of Gi -> Element of [:REAL,REAL:] means


    ex li,ri st it = [li,ri] & li in Gi & ri in Gi &
    ((li < ri & for xi st xi in Gi holds not (li < xi & xi < ri)) or
    (ri < li & for xi st xi in Gi holds not (li < xi or xi < ri)));
end;

theorem 
  [li,ri] is Gap of Gi iff li in Gi & ri in Gi &
  ((li < ri & for xi st xi in Gi holds not (li < xi & xi < ri)) or
  (ri < li & for xi st xi in Gi holds not (li < xi or xi < ri)));

theorem 
  Gi = {li,ri} implies
  ([li9,ri9] is Gap of Gi iff li9 = li & ri9 = ri or li9 = ri & ri9 = li);

theorem 
  xi in Gi implies ex ri st [xi,ri] is Gap of Gi;

theorem 
  xi in Gi implies ex li st [li,xi] is Gap of Gi;

theorem 
  [li,ri] is Gap of Gi & [li,ri9] is Gap of Gi implies ri = ri9;

theorem 
  [li,ri] is Gap of Gi & [li9,ri] is Gap of Gi implies li = li9;

theorem 
  ri < li & [li,ri] is Gap of Gi & ri9 < li9 & [li9,ri9] is Gap of Gi implies
  li = li9 & ri = ri9;



definition
  let d,l,r;
  func cell(l,r) -> non empty Subset of REAL d equals

  { x : (for i holds l.i <= x.i & x.i <= r.i) or
  (ex i st r.i < l.i & (x.i <= r.i or l.i <= x.i)) };
end;

theorem 
  x in cell(l,r) iff ((for i holds l.i <= x.i & x.i <= r.i) or
  ex i st r.i < l.i & (x.i <= r.i or l.i <= x.i) );

theorem 
  (for i holds l.i <= r.i) implies
  (x in cell(l,r) iff for i holds l.i <= x.i & x.i <= r.i);

theorem 
  (ex i st r.i < l.i) implies
  (x in cell(l,r) iff ex i st r.i < l.i & (x.i <= r.i or l.i <= x.i));

theorem 
  l in cell(l,r) & r in cell(l,r);

theorem 
  cell(x,x) = {x};

theorem 
  (for i holds l9.i <= r9.i) implies (cell(l,r) c= cell(l9,r9) iff
  for i holds l9.i <= l.i & l.i <= r.i & r.i <= r9.i);

theorem 
  (for i holds r.i < l.i) implies (cell(l,r) c= cell(l9,r9) iff
  for i holds r.i <= r9.i & r9.i < l9.i & l9.i <= l.i);

theorem 
  (for i holds l.i <= r.i) & (for i holds r9.i < l9.i) implies
  (cell(l,r) c= cell(l9,r9) iff ex i st r.i <= r9.i or l9.i <= l.i);

theorem 
  (for i holds l.i <= r.i) or (for i holds l.i > r.i) implies
  (cell(l,r) = cell(l9,r9) iff l = l9 & r = r9);

definition
  let d,G,k;
  assume
 k <= d;
  func cells(k,G) -> finite non empty Subset-Family of REAL d equals


  { cell(l,r) : ((ex X being Subset of Seg d st card X = k &
  for i holds (i in X & l.i < r.i & [l.i,r.i] is Gap of G.i) or
  (not i in X & l.i = r.i & l.i in G.i)) or
  (k = d & for i holds r.i < l.i & [l.i,r.i] is Gap of G.i)) };
end;

theorem 
  k <= d implies for A being Subset of REAL d holds A in cells(k,G) iff
  ex l,r st A = cell(l,r) & ((ex X being Subset of Seg d st card X = k &
  for i holds (i in X & l.i < r.i & [l.i,r.i] is Gap of G.i) or
  (not i in X & l.i = r.i & l.i in G.i)) or
  (k = d & for i holds r.i < l.i & [l.i,r.i] is Gap of G.i));

theorem 
  k <= d implies (cell(l,r) in cells(k,G) iff
  ((ex X being Subset of Seg d st card X = k &
  for i holds (i in X & l.i < r.i & [l.i,r.i] is Gap of G.i) or
  (not i in X & l.i = r.i & l.i in G.i)) or
  (k = d & for i holds r.i < l.i & [l.i,r.i] is Gap of G.i)));

theorem 
  k <= d & cell(l,r) in cells(k,G) implies
  (for i holds (l.i < r.i & [l.i,r.i] is Gap of G.i) or
  (l.i = r.i & l.i in G.i)) or
  for i holds r.i < l.i & [l.i,r.i] is Gap of G.i;

theorem 
  k <= d & cell(l,r) in cells(k,G) implies for i holds l.i in G.i & r.i in G.i;

theorem 
  k <= d & cell(l,r) in cells(k,G) implies
  (for i holds l.i <= r.i) or for i holds r.i < l.i;

theorem 
  for A being Subset of REAL d holds
  A in cells(0,G) iff ex x st A = cell(x,x) & for i holds x.i in G.i;

theorem 
  cell(l,r) in cells(0,G) iff l = r & for i holds l.i in G.i;

theorem 
  for A being Subset of REAL d holds A in cells(d,G) iff
  ex l,r st A = cell(l,r) & (for i holds [l.i,r.i] is Gap of G.i) &
  ((for i holds l.i < r.i) or for i holds r.i < l.i );

theorem 
  cell(l,r) in cells(d,G) iff (for i holds [l.i,r.i] is Gap of G.i) &
  ((for i holds l.i < r.i) or for i holds r.i < l.i );

theorem 
  d = d9 + 1 implies for A being Subset of REAL d holds A in cells(d9,G) iff
  ex l,r,i0 st A = cell(l,r) & l.i0 = r.i0 & l.i0 in G.i0 &
  for i st i <> i0 holds l.i < r.i & [l.i,r.i] is Gap of G.i;

theorem 
  d = d9 + 1 implies (cell(l,r) in cells(d9,G) iff
  ex i0 st l.i0 = r.i0 & l.i0 in G.i0 &
  for i st i <> i0 holds l.i < r.i & [l.i,r.i] is Gap of G.i);

theorem 
  for A being Subset of REAL d holds A in cells(1,G) iff
  ex l,r,i0 st A = cell(l,r) &
  (l.i0 < r.i0 or d = 1 & r.i0 < l.i0) & [l.i0,r.i0] is Gap of G.i0 &
  for i st i <> i0 holds l.i = r.i & l.i in G.i;

theorem 
  cell(l,r) in cells(1,G) iff
  ex i0 st (l.i0 < r.i0 or d = 1 & r.i0 < l.i0) & [l.i0,r.i0] is Gap of G.i0 &
  for i st i <> i0 holds l.i = r.i & l.i in G.i;

theorem 
  k <= d & k9 <= d & cell(l,r) in cells(k,G) & cell(l9,r9) in cells(k9,G) &
  cell(l,r) c= cell(l9,r9) implies for i holds l.i = l9.i & r.i = r9.i or
  l.i = l9.i & r.i = l9.i or l.i = r9.i & r.i = r9.i or
  l.i <= r.i & r9.i < l9.i & r9.i <= l.i & r.i <= l9.i;

theorem 
  k < k9 & k9 <= d & cell(l,r) in cells(k,G) & cell(l9,r9) in cells(k9,G) &
  cell(l,r) c= cell(l9,r9) implies
  ex i st l.i = l9.i & r.i = l9.i or l.i = r9.i & r.i = r9.i;

theorem 
  for X,X9 being Subset of Seg d st cell(l,r) c= cell(l9,r9) &
  (for i holds (i in X & l.i < r.i & [l.i,r.i] is Gap of G.i) or
  (not i in X & l.i = r.i & l.i in G.i)) &
  (for i holds (i in X9 & l9.i < r9.i & [l9.i,r9.i] is Gap of G.i) or
  (not i in X9 & l9.i = r9.i & l9.i in G.i)) holds X c= X9 &
  (for i st i in X or not i in X9 holds l.i = l9.i & r.i = r9.i) &
  for i st not i in X & i in X9 holds
  l.i = l9.i & r.i = l9.i or l.i = r9.i & r.i = r9.i;

definition
  let d,G,k;
  mode Cell of k,G is Element of cells(k,G);
end;

definition
  let d,G,k;
  mode Chain of k,G is Subset of cells(k,G);
end;

definition
  let d,G,k;
  func 0_(k,G) -> Chain of k,G equals

  {};
end;

definition
  let d,G;
  func Omega(G) -> Chain of d,G equals

  cells(d,G);
end;

notation
  let d,G,k;
  let C1,C2 be Chain of k,G;
  synonym C1 + C2 for C1 \+\ C2;
end;

definition
  let d,G,k;
  let C1,C2 be Chain of k,G;
  redefine func C1 + C2 -> Chain of k,G;
end;

definition
  let d,G;
  func infinite-cell(G) -> Cell of d,G means


  ex l,r st it = cell(l,r) & for i holds r.i < l.i & [l.i,r.i] is Gap of G.i;
end;

theorem 
  cell(l,r) is Cell of d,G implies
  (cell(l,r) = infinite-cell(G) iff for i holds r.i < l.i);

theorem 
  cell(l,r) = infinite-cell(G) iff
  for i holds r.i < l.i & [l.i,r.i] is Gap of G.i;

scheme 
 ChainInd { d()->non zero Element of NAT, G()->Grating of d(),
  k()->Element of NAT, C()->Chain of k(),G(), P[set] } : P[C()]
provided
 P[0_(k(),G())] and
 for A being Cell of k(),G() st A in C() holds P[{A}] and
 for C1,C2 being Chain of k(),G() st C1 c= C() & C2 c= C() &
P[C1] & P[C2] holds P[C1 + C2];



definition
  let d,G,k;
  let A be Cell of k,G;
  func star A -> Chain of (k + 1),G equals

  { B where B is Cell of (k + 1),G : A c= B };
end;

theorem 
  for A being Cell of k,G, B being Cell of (k + 1),G holds
  B in star A iff A c= B;

definition
  let d,G,k;
  let C be Chain of (k + 1),G;
  func del C -> Chain of k,G equals

  { A where A is Cell of k,G : k + 1 <= d & card(star A /\ C) is odd };
end;

notation
  let d,G,k;
  let C be Chain of (k + 1),G;
  synonym .C for del C;
end;

definition
  let d,G,k;
  let C be Chain of (k + 1),G, C9 be Chain of k,G;
  pred C9 bounds C means

  C9 = del C;
end;

theorem 
  for A being Cell of k,G, C being Chain of (k + 1),G holds
  A in del C iff k + 1 <= d & card(star A /\ C) is odd;

theorem 
  k + 1 > d implies for C being Chain of (k + 1),G holds del C = 0_(k,G);

theorem 
  k + 1 <= d implies for A being Cell of k,G, B being Cell of (k + 1),G holds
  A in del {B} iff A c= B;



theorem 
  d = d9 + 1 implies for A being Cell of d9,G holds card(star A) = 2;

theorem 
  for G being Grating of d, B being Cell of (0 + 1),G holds card(del {B}) = 2;



theorem 
  Omega(G) = 0_(d,G)` & 0_(d,G) = (Omega(G))`;

theorem 
  for C being Chain of k,G holds C + 0_(k,G) = C;

theorem 
  for C being Chain of d,G holds C` = C + Omega(G);

theorem 
  del 0_(k + 1,G) = 0_(k,G);

theorem 
  for G being Grating of d9 + 1 holds del Omega(G) = 0_(d9,G);

theorem 
  for C1,C2 being Chain of (k + 1),G holds del(C1 + C2) = del C1 + del C2;

theorem 
  for G being Grating of d9 + 1, C being Chain of (d9 + 1),G holds
  del C` = del C;

theorem 
  for C being Chain of (k + 1 + 1),G holds del (del C) = 0_(k,G);



definition
  let d,G,k;
  mode Cycle of k,G -> Chain of k,G means


    k = 0 & card it is even or
    ex k9 st k = k9 + 1 & ex C being Chain of (k9 + 1),G st C = it &
    del C = 0_(k9,G);
end;

theorem 
  for C being Chain of (k + 1),G holds
  C is Cycle of (k + 1),G iff del C = 0_(k,G);

theorem 
  k > d implies for C being Chain of k,G holds C is Cycle of k,G;

theorem 
  for C being Chain of 0,G holds C is Cycle of 0,G iff card C is even;

definition
  let d,G,k;
  let C be Cycle of (k + 1),G;
  redefine func del C equals

  0_(k,G);
end;

definition
  let d,G,k;
  redefine func 0_(k,G) -> Cycle of k,G;
end;

definition
  let d,G;
  redefine func Omega(G) -> Cycle of d,G;
end;

definition
  let d,G,k;
  let C1,C2 be Cycle of k,G;
  redefine func C1 + C2 -> Cycle of k,G;
end;

theorem 
  for C being Cycle of d,G holds C` is Cycle of d,G;

definition
  let d,G,k;
  let C be Chain of (k + 1),G;
  redefine func del C -> Cycle of k,G;
end;

begin 

definition
  let d,G,k;
  func Chains(k,G) -> strict AbGroup means


  the carrier of it = bool(cells(k,G)) & 0.it = 0_(k,G) &
  for A,B being Element of it, A9,B9 being Chain of k,G
  st A = A9 & B = B9 holds A + B = A9 + B9;
end;

definition
  let d,G,k;
  mode GrChain of k,G is Element of Chains(k,G);
end;

theorem 
  for x being set holds x is Chain of k,G iff x is GrChain of k,G;

definition
  let d,G,k;
  func del(k,G) -> Homomorphism of Chains(k + 1,G),Chains(k,G) means

  for A being Element of Chains(k + 1,G), A9 being Chain of (k + 1),G
  st A = A9 holds it.A = del A9;
end;














begin 

theorem 
  for X,Y being finite set holds card (X \/ Y) + card (X /\ Y) =
  card X + card Y;

scheme 

  Regr11 { n() -> Element of NAT, P[set] }: for k be Element of NAT st 1 <= k
  & k <= n() holds P[k]
provided
 P[n()] & n() >= 2 and
 for k be Element of NAT st 1 <= k & k < n() & P[k+1] holds P[k];

scheme 

  Regr2 { P[set] } : P[1]
provided
 ex n be Element of NAT st n > 1 & P[n] and
 for k be Element of NAT st k >= 1 & P[k+1] holds P[k];

registration
  let F be non empty set;
  cluster non empty non-empty for FinSequence of bool F;
end;

theorem 
  for F being non empty set, f being non-empty FinSequence of bool
  F, i being Element of NAT st i in dom f holds f.i <> {};

registration
  let F be finite set, A be FinSequence of bool F;
  let i be Element of NAT;
  cluster A.i -> finite;
end;

begin 

definition
  let F be set;
  let A be FinSequence of bool F;
  let J be set;
  func union (A, J) -> set means


  for x being set holds x in it iff ex j
  being set st j in J & j in dom A & x in A.j;
end;

theorem 
  for F being set, A being FinSequence of bool F, J being set holds
  union (A, J) c= F;

theorem 
  for F being finite set, A being FinSequence of bool F, J, K being set
  st J c= K holds union (A, J) c= union (A, K);

registration
  let F be finite set;
  let A be FinSequence of bool F;
  let J be set;
  cluster union (A, J) -> finite;
end;

theorem 
  for F being finite set, A being FinSequence of bool F,
      i being Element of NAT st i in dom A holds union (A, {i}) = A.i;

theorem 
  for F being finite set, A being FinSequence of bool F,
      i,j being Element of NAT st i in dom A & j in dom A holds
    union (A, {i,j}) = A.i \/ A.j;

theorem 
  for J being set, F being finite set, A being FinSequence of bool
  F, i being Element of NAT st i in J & i in dom A holds A.i c= union (A, J);

theorem 
  for J being set, F being finite set, i being Element of NAT,
      A being FinSequence of bool F st
    i in J & i in dom A holds union (A, J) = union (A, J \ {i}) \/ A.i;

theorem 
  for J1, J2 being set, F being finite set, i being Element of NAT,
      A being FinSequence of bool F st
      i in dom A holds union (A,{i} \/ J1 \/ J2) = A.i \/ union (A,J1 \/ J2);

theorem 
  for F being finite set, A being FinSequence of bool F
  for i being Element of NAT
  for x,y being set st x <> y & x in A.i & y in A.i holds
    (A.i \ {x}) \/ (A.i \ {y}) = A.i;

begin 

definition
  let F be finite set;
  let A be FinSequence of bool F;
  let i be Element of NAT;
  let x be set;
  func Cut (A, i, x) -> FinSequence of bool F means


  dom it = dom A & for k being Element of NAT st k in dom it holds
  (i = k implies it.k = A.k \ {x}) &
  (i <> k implies it.k = A.k);
end;

theorem 
  for F being finite set, A being FinSequence of bool F,
     i being Element of NAT, x being set st i in dom A & x in A.i holds
     card (Cut (A,i,x).i) = card (A.i) - 1;

theorem 
  for F being finite set, A being FinSequence of bool F,
      i being Element of NAT, x,
      J being set holds
    union (Cut (A, i, x), J \ {i}) = union (A,J \ {i});

theorem 
  for F being finite set, A being FinSequence of bool F,
      i being Element of NAT,
      x, J being set st not i in J holds
    union (A, J) = union (Cut(A, i, x), J);

theorem 
  for F being finite set, A being FinSequence of bool F,
      i being Element of NAT, x,
      J being set st i in dom Cut (A, i, x) & i in J holds
    union (Cut (A, i, x), J) = union (A, J \ {i}) \/ (A.i \ {x});

begin 

definition
  let F be finite set;
  let X be FinSequence of bool F;
  let A be set;
  pred A is_a_system_of_different_representatives_of X means


  ex f being FinSequence of F st f = A & dom X = dom f &
  (for i being Element of NAT st i in dom f holds f.i in X.i) &
  f is one-to-one;
end;

definition
  let F be finite set;
  let A be FinSequence of bool F;
  attr A is Hall means


  for J being finite set st J c= dom A holds card J <= card union (A, J);
end;

registration let F be finite non empty set;
  cluster Hall non empty for FinSequence of bool F;
end;

registration let F be finite set;
  cluster Hall for FinSequence of bool F;
end;

theorem 
  for F being finite set, A being non empty FinSequence of bool F
  st A is Hall holds A is non-empty;

registration let F be finite set;
  cluster Hall -> non-empty for non empty FinSequence of bool F;
end;

theorem 
  for F being finite set, A being FinSequence of bool F,
      i being Element of NAT st i in dom A & A is Hall holds
    card (A.i) >= 1;

theorem 
  for F being non empty finite set, A being non empty FinSequence of bool F st
    (for i being Element of NAT st i in dom A holds card (A.i) = 1) &
    A is Hall holds
  ex X being set st X is_a_system_of_different_representatives_of A;

theorem 
  for F being finite set, A being FinSequence of bool F holds
  (ex X being set st X is_a_system_of_different_representatives_of A)
  implies A is Hall;

begin 

definition
  let F be set, A be FinSequence of bool F, i be Element of NAT;
  mode Reduction of A, i -> FinSequence of bool F means


    dom it = dom A &
    (for j being Element of NAT st j in dom A & j <> i holds A.j = it.j) &
    it.i c= A.i;
end;

definition
  let F be set, A be FinSequence of bool F;
  mode Reduction of A -> FinSequence of bool F means


    dom it = dom A &
    for i being Element of NAT st i in dom A holds it.i c= A.i;
end;

definition
  let F be set, A be FinSequence of bool F, i be Element of NAT;
  assume that
 i in dom A and
 A.i <> {};
  mode Singlification of A, i -> Reduction of A means

    card (it.i) = 1;
end;

theorem 
  for F being finite set, A being FinSequence of bool F,
      i being Element of NAT,
      C being Reduction of A, i holds C is Reduction of A;

theorem 
  for F being finite set,
      A being FinSequence of bool F, i being Element of NAT,
      x being set st i in dom A holds Cut (A,i,x) is Reduction of A,i;

theorem 
  for F being finite set, A being FinSequence of bool F,
      i being Element of NAT,
      x being set st i in dom A holds Cut (A,i,x) is Reduction of A;

theorem 
  for F being finite set, A being FinSequence of bool F, B being Reduction of A
  for C being Reduction of B holds C is Reduction of A;

theorem 
  for F being non empty finite set, A being non-empty FinSequence of
  bool F, i being Element of NAT, B being Singlification of A, i st i in dom A
  holds B.i <> {};

theorem 
  for F being non empty finite set, A being non-empty FinSequence
  of bool F, i, j being Element of NAT, B being Singlification of A, i, C being
Singlification of B, j st i in dom A & j in dom A & C.i <> {} & B.j <> {} holds
  C is Singlification of A, j & C is Singlification of A, i;

theorem 
  for F being set, A being FinSequence of bool F, i being Element of NAT
  holds A is Reduction of A,i;

theorem 
  for F being set, A being FinSequence of bool F holds A is Reduction of A;

definition
  let F be non empty set, A be FinSequence of bool F;
  assume
 A is non-empty;
  mode Singlification of A -> Reduction of A means


    for i being Element of NAT st i in dom A holds card (it.i) = 1;
end;

theorem 
  for F being non empty finite set,
      A being non empty non-empty FinSequence of bool F,
      f being Function holds f is Singlification of A iff
    (dom f = dom A &
    for i being Element of NAT st i in dom A holds
      f is Singlification of A, i);

registration
  let F be non empty finite set, A be non empty FinSequence of bool F,
      k be Element of NAT;
  cluster -> non empty for Singlification of A, k;
end;

registration
  let F be non empty finite set, A be non empty FinSequence of bool F;
  cluster -> non empty for Singlification of A;
end;

begin 

theorem 
  for F being non empty finite set, A being non empty FinSequence of bool F,
      X being set, B being Reduction of A st
  X is_a_system_of_different_representatives_of B holds
  X is_a_system_of_different_representatives_of A;

theorem 
  for F being finite set, A being FinSequence of bool F st A is Hall
    for i being Element of NAT st card (A.i) >= 2
    ex x being set st x in A.i & Cut (A, i, x) is Hall;

theorem 
  for F being finite set, A being FinSequence of bool F,
      i being Element of NAT st i in dom A & A is Hall holds
    ex G being Singlification of A, i st G is Hall;

theorem 
  for F being non empty finite set,
      A being non empty FinSequence of bool F st A is Hall holds
    ex G being Singlification of A st G is Hall;


theorem 
  for F being non empty finite set,
      A being non empty FinSequence of bool F holds
   (ex X being set st X is_a_system_of_different_representatives_of A) iff
   A is Hall;














begin 

reserve i,j,k,m,n for Element of NAT,
  D for non empty set,
  p for Element of D,
  f for FinSequence of D;

definition
  let D be non empty set;
  let f be FinSequence of D;
  redefine attr f is constant means


  for n,m st n in dom f & m in dom f holds f/.n=f/.m;
end;

theorem 
  for D being non empty set, f being FinSequence of D st f
  just_once_values f/.len f holds f/.len f..f = len f;

theorem 
  for D being non empty set, f being FinSequence of D holds f /^ len f =
  {};

theorem 
  for D being non empty set, f being non empty FinSequence of D
  holds f/.len f in rng f;

definition
  let D be non empty set, f be FinSequence of D, y be set;
  redefine pred f just_once_values y means

  ex x being set st x in dom f & y =
  f/.x & for z being set st z in dom f & z <> x holds f/.z <> y;
end;

theorem 
  for D being non empty set, f being FinSequence of D st f
  just_once_values f/.len f holds f-:f/.len f = f;

theorem 
  for D being non empty set, f being FinSequence of D st f
  just_once_values f/.len f holds f:-f/.len f = <*f/.len f*>;

theorem 
  1 <= len (f:-p);

theorem 
  for D being non empty set, p being Element of D, f being FinSequence
  of D st p in rng f holds len(f:-p) <= len f;

theorem 
  for D being non empty set, f being circular non empty FinSequence of D
  holds Rev f is circular;

begin 

reserve D for non empty set,
  p for Element of D,
  f for FinSequence of D;

theorem 
  p in rng f & 1 <= i & i <= len(f:-p) implies (Rotate(f,p))/.i = f
  /.(i -' 1 + p..f);

theorem 
  p in rng f & p..f <= i & i <= len f implies f/.i = (Rotate(f,p))
  /.(i+1 -' p..f);

theorem 
  p in rng f implies (Rotate(f,p))/.len(f:-p) = f/.len f;

theorem 
  p in rng f & len(f:-p) < i & i <= len f implies (Rotate(f,p))/.i
  = f/.(i + p..f -' len f);

theorem 
  p in rng f & 1 < i & i <= p..f implies f/.i = (Rotate(f,p))/.(i + len
  f -' p..f);

theorem 
  len Rotate(f,p) = len f;

theorem 
  dom Rotate(f,p) = dom f;

theorem 
  for D being non empty set, f being circular FinSequence of D, p
be Element of D st for i st 1 < i & i < len f holds f/.i <> f/.1 holds Rotate(
  Rotate(f,p),f/.1) = f;

begin 

reserve f for circular FinSequence of D;

theorem 
  p in rng f & len(f:-p) <= i & i <= len f implies (Rotate(f,p))/.
  i = f/.(i + p..f -' len f);

theorem 
  p in rng f & 1 <= i & i <= p..f implies f/.i = (Rotate(f,p))/.(i
  + len f -' p..f);

registration
  let D be non trivial set;
  cluster non constant circular for FinSequence of D;
end;

registration
  let D be non trivial set, p be Element of D;
  let f be non constant circular FinSequence of D;
  cluster Rotate(f,p) -> non constant;
end;

begin 

theorem 
  for n being non zero Nat holds 0.REAL n <> 1.REAL n;

registration
  let n be non zero Nat;
  cluster TOP-REAL n -> non trivial;
end;

reserve f,g for FinSequence of TOP-REAL 2;

theorem 
  rng f c= rng g implies rng X_axis f c= rng X_axis g;

theorem 
  rng f = rng g implies rng X_axis f = rng X_axis g;

theorem 
  rng f c= rng g implies rng Y_axis f c= rng Y_axis g;

theorem 
  rng f = rng g implies rng Y_axis f = rng Y_axis g;

begin 

reserve p for Point of TOP-REAL 2,
  f for FinSequence of TOP-REAL 2;

registration
  let p be Point of TOP-REAL 2;
  let f be special circular FinSequence of TOP-REAL 2;
  cluster Rotate(f,p) -> special;
end;

theorem 
  p in rng f & 1 <= i & i < len(f:-p) implies LSeg(Rotate(f,p),i)
  = LSeg(f,i -' 1 + p..f);

theorem 
  p in rng f & p..f <= i & i < len f implies LSeg(f,i) = LSeg(
  Rotate(f,p),i -' p..f+1);

theorem 
  for f being circular FinSequence of TOP-REAL 2 holds Incr X_axis
  f = Incr X_axis Rotate(f,p);

theorem 
  for f being circular FinSequence of TOP-REAL 2 holds Incr Y_axis
  f = Incr Y_axis Rotate(f,p);

theorem 
  for f being non empty circular FinSequence of TOP-REAL 2 holds
  GoB Rotate(f,p) = GoB f;

theorem 
  for f being non constant standard special_circular_sequence
  holds Rev Rotate(f,p) = Rotate(Rev f,p);

begin 

reserve f for circular FinSequence of TOP-REAL 2;

theorem 
  for f being circular s.c.c. FinSequence of TOP-REAL 2 st len f >
  4 holds LSeg(f,len f -' 1) /\ LSeg(f,1) = {f/.1};

theorem 
  p in rng f & len(f:-p) <= i & i < len f implies LSeg(Rotate(f,p)
  ,i) = LSeg(f,i + p..f -' len f);

registration
  let p be Point of TOP-REAL 2;
  let f be circular s.c.c. FinSequence of TOP-REAL 2;
  cluster Rotate(f,p) -> s.c.c.;
end;

registration
  let p be Point of TOP-REAL 2;
  let f be non constant standard special_circular_sequence;
  cluster Rotate(f,p) -> unfolded;
end;

theorem 
  p in rng f & 1 <= i & i < p..f implies LSeg(f,i) = LSeg(Rotate(f
  ,p),i + len f -' p..f);

theorem 
  L~Rotate(f,p) = L~f;

theorem 
  for G being Go-board holds f is_sequence_on G iff Rotate(f,p)
  is_sequence_on G;

registration
  let p be Point of TOP-REAL 2;
  let f be standard non empty circular FinSequence of TOP-REAL 2;
  cluster Rotate(f,p) -> standard;
end;

theorem 
  for f being non constant standard special_circular_sequence, p,k
st p in rng f & 1 <= k & k < p..f holds left_cell(f,k) = left_cell(Rotate(f,p),
  k + len f -' p..f);

theorem 
  for f being non constant standard special_circular_sequence
  holds LeftComp Rotate(f,p) = LeftComp f;

theorem 
  for f being non constant standard special_circular_sequence holds
  RightComp Rotate(f,p) = RightComp f;

begin

registration
  let p be Point of TOP-REAL 2;
  let f be clockwise_oriented non constant standard special_circular_sequence
  ;
  cluster Rotate(f,p) -> clockwise_oriented;
end;

theorem 
  for f being non constant standard special_circular_sequence holds f is
  clockwise_oriented or Rev f is clockwise_oriented;














begin

reserve T,T1,T2,S for non empty TopSpace;

theorem 
  for f being Function of T1,S, g being Function of T2,S,F1,F2
being Subset of T st T1 is SubSpace of T & T2 is SubSpace of T & F1=[#] T1 & F2
  =[#] T2 & ([#] T1) \/ ([#] T2) = [#] T & F1 is closed & F2 is closed & f is
  continuous & g is continuous & ( for p be set st p in ([#] T1) /\ ([#] T2)
  holds f.p = g.p ) ex h being Function of T,S st h = f+*g & h is continuous;

theorem 
  for n being Element of NAT,q2 being Point of Euclid n, q being
  Point of TOP-REAL n, r being real number st q=q2 holds Ball(q2,r) = {q3 where
  q3 is Point of TOP-REAL n: |.q-q3.|<r};

theorem 
  (0.TOP-REAL 2)`1=0 & (0.TOP-REAL 2)`2=0;

theorem 
  1.REAL 2 = <* 1, 1 *>;

theorem 
  (1.REAL 2)`1=1 & (1.REAL 2)`2=1;

theorem 
  dom proj1=the carrier of TOP-REAL 2 & dom proj1=REAL 2;

theorem 
  dom proj2=the carrier of TOP-REAL 2 & dom proj2=REAL 2;

theorem 
  for p being Point of TOP-REAL 2 holds p=|[proj1.p,proj2.p]|;

theorem 
  for B being Subset of TOP-REAL 2 st B={0.TOP-REAL 2} holds B`<>
  {} & (the carrier of TOP-REAL 2)\B<>{};

theorem 
  for X,Y being non empty TopSpace,f being Function of X,Y holds f
is continuous iff for p being Point of X,V being Subset of Y st f.p in V & V is
  open holds ex W being Subset of X st p in W & W is open & f.:W c= V;

theorem 
  for p being Point of TOP-REAL 2, G being Subset of TOP-REAL 2 st
  G is open & p in G ex r being real number st r>0 & {q where q is Point of
  TOP-REAL 2: p`1-r<q`1 & q`1<p`1+r & p`2-r<q`2 & q`2<p`2+r} c= G;

theorem 
  for X,Y,Z being non empty TopSpace, B being Subset of Y, C being
  Subset of Z, f being Function of X,Y, h being Function of Y|B,Z|C st f is
  continuous & h is continuous & rng f c= B & B<>{} & C<>{} holds ex g being
  Function of X,Z st g is continuous & g=h*f;

reserve p,q for Point of TOP-REAL 2;

definition
  func Out_In_Sq -> Function of NonZero TOP-REAL 2, NonZero TOP-REAL 2 means


   for
 p being Point of TOP-REAL 2 st p<>0.TOP-REAL 2 holds ((p`2<=p`1 & -p
`1<=p`2 or p`2>=p`1 & p`2<=-p`1) implies it.p=|[1/p`1,p`2/p`1/p`1]|) & (not(p`2
<=p`1 & -p`1<=p`2 or p`2>=p`1 & p`2<=-p`1) implies it.p=|[p`1/p`2/p`2,1/p`2]|);
end;

theorem 
  for p being Point of TOP-REAL 2 st not(p`2<=p`1 & -p`1<=p`2 or p
  `2>=p`1 & p`2<=-p`1) holds p`1<=p`2 & -p`2<=p`1 or p`1>=p`2 & p`1<=-p`2;

theorem 
  for p being Point of TOP-REAL 2 st p<>0.TOP-REAL 2 holds ((p`1<=
p`2 & -p`2<=p`1 or p`1>=p`2 & p`1<=-p`2)implies Out_In_Sq.p=|[p`1/p`2/p`2,1/p`2
]|) & (not (p`1<=p`2 & -p`2<=p`1 or p`1>=p`2 & p`1<=-p`2) implies Out_In_Sq.p=
  |[1/p`1,p`2/p`1/p`1]|);

theorem 
  for D being Subset of TOP-REAL 2, K0 being Subset of (TOP-REAL 2
)|D st K0={p:(p`2<=p`1 & -p`1<=p`2 or p`2>=p`1 & p`2<=-p`1) & p<>0.TOP-REAL 2}
  holds rng (Out_In_Sq|K0) c= the carrier of ((TOP-REAL 2)|D)|K0;

theorem 
  for D being Subset of TOP-REAL 2, K0 being Subset of (TOP-REAL 2
)|D st K0={p:(p`1<=p`2 & -p`2<=p`1 or p`1>=p`2 & p`1<=-p`2) & p<>0.TOP-REAL 2}
  holds rng (Out_In_Sq|K0) c= the carrier of ((TOP-REAL 2)|D)|K0;

theorem 
  for K0a being set,D being non empty Subset of TOP-REAL 2 st K0a=
{p where p is Point of TOP-REAL 2: (p`2<=p`1 & -p`1<=p`2 or p`2>=p`1 & p`2<=-p
  `1) & p<>0.TOP-REAL 2} & D`={0.TOP-REAL 2} holds K0a is non empty Subset of (
  TOP-REAL 2)|D & K0a is non empty Subset of TOP-REAL 2;

theorem 
  for K0a being set,D being non empty Subset of TOP-REAL 2 st K0a=
{p where p is Point of TOP-REAL 2: (p`1<=p`2 & -p`2<=p`1 or p`1>=p`2 & p`1<=-p
  `2) & p<>0.TOP-REAL 2} & D`={0.TOP-REAL 2} holds K0a is non empty Subset of (
  TOP-REAL 2)|D & K0a is non empty Subset of TOP-REAL 2;

theorem 
  for X being non empty TopSpace, f1,f2 being Function of X,R^1 st
f1 is continuous & f2 is continuous holds ex g being Function of X,R^1 st (for
p being Point of X,r1,r2 being real number st f1.p=r1 & f2.p=r2 holds g.p=r1+r2
  ) & g is continuous;

theorem 
  for X being non empty TopSpace, a being real number holds ex g being
  Function of X,R^1 st (for p being Point of X holds g.p=a) & g is continuous;

theorem 
  for X being non empty TopSpace, f1,f2 being Function of X,R^1 st
f1 is continuous & f2 is continuous holds ex g being Function of X,R^1 st (for
p being Point of X,r1,r2 being real number st f1.p=r1 & f2.p=r2 holds g.p=r1-r2
  ) & g is continuous;

theorem 
  for X being non empty TopSpace, f1 being Function of X,R^1 st f1
is continuous ex g being Function of X,R^1 st (for p being Point of X,r1 being
  real number st f1.p=r1 holds g.p=r1*r1) & g is continuous;

theorem 
  for X being non empty TopSpace, f1 being Function of X,R^1,a
  being real number st f1 is continuous holds ex g being Function of X,R^1 st (
  for p being Point of X,r1 being real number st f1.p=r1 holds g.p=a*r1) & g is
  continuous;

theorem 
  for X being non empty TopSpace, f1 being Function of X,R^1,a
  being real number st f1 is continuous holds ex g being Function of X,R^1 st (
  for p being Point of X,r1 being real number st f1.p=r1 holds g.p=r1+a) & g is
  continuous;

theorem 
  for X being non empty TopSpace, f1,f2 being Function of X,R^1 st
f1 is continuous & f2 is continuous holds ex g being Function of X,R^1 st (for
p being Point of X,r1,r2 being real number st f1.p=r1 & f2.p=r2 holds g.p=r1*r2
  ) & g is continuous;

theorem 
  for X being non empty TopSpace, f1 being Function of X,R^1 st f1
  is continuous & (for q being Point of X holds f1.q<>0) holds ex g being
  Function of X,R^1 st (for p being Point of X,r1 being real number st f1.p=r1
  holds g.p=1/r1) & g is continuous;

theorem 
  for X being non empty TopSpace, f1,f2 being Function of X,R^1 st
  f1 is continuous & f2 is continuous & (for q being Point of X holds f2.q<>0)
holds ex g being Function of X,R^1 st (for p being Point of X,r1,r2 being real
  number st f1.p=r1 & f2.p=r2 holds g.p=r1/r2) & g is continuous;

theorem 
  for X being non empty TopSpace, f1,f2 being Function of X,R^1 st
  f1 is continuous & f2 is continuous & (for q being Point of X holds f2.q<>0)
holds ex g being Function of X,R^1 st (for p being Point of X,r1,r2 being real
  number st f1.p=r1 & f2.p=r2 holds g.p=r1/r2/r2) & g is continuous;

theorem 
  for K0 being Subset of TOP-REAL 2, f being Function of (TOP-REAL
  2)|K0,R^1 st (for p being Point of (TOP-REAL 2)|K0 holds f.p=proj1.p) holds f
  is continuous;

theorem 
  for K0 being Subset of TOP-REAL 2, f being Function of (TOP-REAL
  2)|K0,R^1 st (for p being Point of (TOP-REAL 2)|K0 holds f.p=proj2.p) holds f
  is continuous;

theorem 
  for K1 being non empty Subset of TOP-REAL 2, f being Function of
  (TOP-REAL 2)|K1,R^1 st (for p being Point of (TOP-REAL 2) st p in the carrier
of (TOP-REAL 2)|K1 holds f.p=1/p`1) & (for q being Point of TOP-REAL 2 st q in
  the carrier of (TOP-REAL 2)|K1 holds q`1<>0 ) holds f is continuous;

theorem 
  for K1 being non empty Subset of TOP-REAL 2, f being Function of
  (TOP-REAL 2)|K1,R^1 st (for p being Point of (TOP-REAL 2) st p in the carrier
of (TOP-REAL 2)|K1 holds f.p=1/p`2) & (for q being Point of TOP-REAL 2 st q in
  the carrier of (TOP-REAL 2)|K1 holds q`2<>0 ) holds f is continuous;

theorem 
  for K1 being non empty Subset of TOP-REAL 2, f being Function of
  (TOP-REAL 2)|K1,R^1 st (for p being Point of (TOP-REAL 2) st p in the carrier
of (TOP-REAL 2)|K1 holds f.p=p`2/p`1/p`1) & (for q being Point of TOP-REAL 2 st
  q in the carrier of (TOP-REAL 2)|K1 holds q`1<>0 ) holds f is continuous;

theorem 
  for K1 being non empty Subset of TOP-REAL 2, f being Function of
  (TOP-REAL 2)|K1,R^1 st (for p being Point of (TOP-REAL 2) st p in the carrier
of (TOP-REAL 2)|K1 holds f.p=p`1/p`2/p`2) & (for q being Point of TOP-REAL 2 st
  q in the carrier of (TOP-REAL 2)|K1 holds q`2<>0 ) holds f is continuous;

theorem 
  for K0,B0 being Subset of TOP-REAL 2, f being Function of (
TOP-REAL 2)|K0,(TOP-REAL 2)|B0, f1,f2 being Function of (TOP-REAL 2)|K0,R^1 st
f1 is continuous & f2 is continuous & K0<>{} & B0<>{} & (for x,y,r,s being real
number st |[x,y]| in K0 & r=f1.(|[x,y]|) & s=f2.(|[x,y]|) holds f.(|[x,y]|)=|[r
  ,s]|) holds f is continuous;

theorem 
  for K0,B0 being Subset of TOP-REAL 2,f being Function of (
TOP-REAL 2)|K0,(TOP-REAL 2)|B0 st f=Out_In_Sq|K0 & B0=NonZero TOP-REAL 2 & K0={
p: (p`2<=p`1 & -p`1<=p`2 or p`2>=p`1 & p`2<=-p`1) & p<>0.TOP-REAL 2} holds f is
  continuous;

theorem 
  for K0,B0 being Subset of TOP-REAL 2,f being Function of (
TOP-REAL 2)|K0,(TOP-REAL 2)|B0 st f=Out_In_Sq|K0 & B0=NonZero TOP-REAL 2 & K0={
p: (p`1<=p`2 & -p`2<=p`1 or p`1>=p`2 & p`1<=-p`2) & p<>0.TOP-REAL 2} holds f is
  continuous;

scheme 

  TopSubset { P[set] } : { p where p is Point of TOP-REAL 2 : P[p] } is Subset
  of TOP-REAL 2;

scheme 

  TopCompl { P[set], K() -> Subset of TOP-REAL 2 } : K()` = { p where p is
  Point of TOP-REAL 2 : not P[p] }
provided
 K() = { p where p is Point of TOP-REAL 2 : P[p] };

scheme 

  ClosedSubset { F,G(Point of TOP-REAL 2) -> real number } : {p where p is
  Point of TOP-REAL 2 : F(p) <= G(p) } is closed Subset of TOP-REAL 2
provided
 for p,q being Point of TOP-REAL 2 holds F(p-q) = F(p) - F(q) & G(p-q
) = G(p) - G(q) and
 for p,q being Point of TOP-REAL 2 holds (|. (p-q).|)^2 = (F(p-q))^2+
(G(p-q))^2;

theorem 
  for B0 being Subset of TOP-REAL 2,K0 being Subset of (TOP-REAL 2
)|B0,f being Function of ((TOP-REAL 2)|B0)|K0,((TOP-REAL 2)|B0) st f=Out_In_Sq|
K0 & B0=NonZero TOP-REAL 2 & K0={p:(p`2<=p`1 & -p`1<=p`2 or p`2>=p`1 & p`2<=-p
  `1) & p<>0.TOP-REAL 2} holds f is continuous & K0 is closed;

theorem 
  for B0 being Subset of TOP-REAL 2,K0 being Subset of (TOP-REAL 2
)|B0,f being Function of ((TOP-REAL 2)|B0)|K0,((TOP-REAL 2)|B0) st f=Out_In_Sq|
K0 & B0=NonZero TOP-REAL 2 & K0={p:(p`1<=p`2 & -p`2<=p`1 or p`1>=p`2 & p`1<=-p
  `2) & p<>0.TOP-REAL 2} holds f is continuous & K0 is closed;

theorem 
  for D being non empty Subset of TOP-REAL 2 st D`={0.TOP-REAL 2}
  holds ex h being Function of (TOP-REAL 2)|D,(TOP-REAL 2)|D st h=Out_In_Sq & h
  is continuous;

theorem 
  for B,K0,Kb being Subset of TOP-REAL 2 st B={0.TOP-REAL 2} & K0=
{p: -1<p`1 & p`1<1 & -1<p`2 & p`2<1} & Kb={q: -1=q`1 & -1<=q`2 & q`2<=1 or q`1=
1 & -1<=q`2 & q`2<=1 or -1=q`2 & -1<=q`1 & q`1<=1 or 1=q`2 & -1<=q`1 & q`1<=1}
  ex f being Function of (TOP-REAL 2)|B`,(TOP-REAL 2)|B` st f is continuous & f
  is one-to-one & (for t being Point of TOP-REAL 2 st t in K0 & t<>0.TOP-REAL 2
holds not f.t in K0 \/ Kb) &(for r being Point of TOP-REAL 2 st not r in K0 \/
  Kb holds f.r in K0) & for s being Point of TOP-REAL 2 st s in Kb holds f.s=s;

theorem 
  for f,g being Function of I[01],TOP-REAL 2, K0 being Subset of
TOP-REAL 2, O,I being Point of I[01] st O=0 & I=1 & f is continuous one-to-one
& g is continuous one-to-one & K0={p: -1<p`1 & p`1<1 & -1<p`2 & p`2<1}& (f.O)`1
=-1 & (f.I)`1=1 & -1<=(f.O)`2 & (f.O)`2<=1 & -1<=(f.I)`2 & (f.I)`2<=1 & (g.O)`2
  =-1 & (g.I)`2=1 & -1<=(g.O)`1 & (g.O)`1<=1 & -1<=(g.I)`1 & (g.I)`1<=1 & rng f
  misses K0 & rng g misses K0 holds rng f meets rng g;

theorem 
  for A,B,C,D being real number, f being Function of TOP-REAL 2,
TOP-REAL 2 st (for t being Point of TOP-REAL 2 holds f.t=|[A*(t`1)+B,C*(t`2)+D
  ]|) holds f is continuous;

definition
  let A,B,C,D be real number;
  func AffineMap(A,B,C,D) -> Function of TOP-REAL 2,TOP-REAL 2 means


  for t being Point of TOP-REAL 2 holds it.t=|[A*(t`1)+B,C*(t`2)+D]|;
end;

registration
  let a,b,c,d be real number;
  cluster AffineMap(a,b,c,d) -> continuous;
end;

theorem 
  for A,B,C,D being real number st A>0 & C>0 holds AffineMap(A,B,C
  ,D) is one-to-one;

theorem 
  for f,g being Function of I[01],TOP-REAL 2,a,b,c,d being real number ,
  O,I being Point of I[01] st O=0 & I=1 & f is continuous one-to-one & g is
continuous one-to-one & (f.O)`1=a & (f.I)`1=b & c <=(f.O)`2 & (f.O)`2<=d & c <=
(f.I)`2 & (f.I)`2<=d & (g.O)`2=c & (g.I)`2=d & a<=(g.O)`1 & (g.O)`1<=b & a<=(g.
I)`1 & (g.I)`1<=b & a < b & c < d & not (ex r being Point of I[01] st a<(f.r)`1
& (f.r)`1<b & c <(f.r)`2 & (f.r)`2<d)& not (ex r being Point of I[01] st a<(g.r
  )`1 & (g.r)`1<b & c <(g.r)`2 & (g.r)`2<d) holds rng f meets rng g;

theorem 
  {p7 where p7 is Point of TOP-REAL 2: p7`2<=p7`1 } is closed Subset of
TOP-REAL 2 & {p7 where p7 is Point of TOP-REAL 2: p7`1<=p7`2 } is closed Subset
  of TOP-REAL 2;

theorem 
  {p7 where p7 is Point of TOP-REAL 2: -p7`1<=p7`2 } is closed Subset of
  TOP-REAL 2 & {p7 where p7 is Point of TOP-REAL 2: p7`2<=-p7`1 } is closed
  Subset of TOP-REAL 2;

theorem 
  {p7 where p7 is Point of TOP-REAL 2: -p7`2<=p7`1 } is closed Subset of
  TOP-REAL 2 & {p7 where p7 is Point of TOP-REAL 2: p7`1<=-p7`2 } is closed
  Subset of TOP-REAL 2;














begin 

reserve i,j,k,l for Element of NAT,
  x,x1,x2,y1,y2 for set;

theorem 
  i > 0 implies {[i,x]} is FinSubsequence;

theorem 
  for q being FinSubsequence holds q = {} iff Seq q = {};

theorem 
  for q being FinSubsequence st q = {[i,x]} holds Seq q = <*x*>;

registration
  cluster -> finite for FinSubsequence;
end;

theorem 
  for q being FinSubsequence st Seq q = <*x*> ex i st q = {[i,x]};

theorem 
  {[x1,y1], [x2,y2]} is FinSequence implies x1 = 1 & x2 = 1 & y1 = y2 or
  x1 = 1 & x2 = 2 or x1 = 2 & x2 = 1;

theorem 
  <*x1,x2*> = {[1,x1], [2,x2]};

theorem 
  for p being FinSubsequence holds card p = len Seq p;

theorem 
  for X,Y being set, P,R being Relation st X misses Y holds P|X misses R|Y;

theorem 
  for f,g,h being Function st
  f c= h & g c= h & f misses g holds dom f misses dom g;

theorem 
  for Y being set, R being Relation holds Y|`R c= R|(R"Y);

theorem 
  for Y being set, f being Function holds Y|`f = f|(f"Y);

begin 

definition
  let P be set;
  mode marking of P is Function of P,NAT;
end;

reserve P,p,x,y,x1,x2 for set,
  m1,m2,m3,m4,m for marking of P,
  i,j,j1,j2,k,k1,k2,l,l1 for Element of NAT;

notation
  let P be set;
  let m be marking of P;
  let p be set;
  synonym m multitude_of p for m.p;
end;

scheme 
 MarkingLambda { P() -> set, F(set) -> Element of NAT }:
  ex m being Function of P(),NAT st
    for p st p in P() holds m.p = F(p);

definition
  let P,m1,m2;

  redefine pred m1 = m2 means

  for p st p in P holds m1 multitude_of p = m2 multitude_of p;
end;

definition
  let P;
  func {$} P -> marking of P equals

  P --> 0;
end;

definition
  let P be set;
  let m1, m2 be marking of P;
  pred m1 c= m2 means


  for p being set st p in P holds
  m1 multitude_of p <= m2 multitude_of p;
  reflexivity;
end;

theorem 
  {$}P c= m;

theorem 
  m1 c= m2 & m2 c= m3 implies m1 c= m3;

definition
  let P be set;
  let m1, m2 be marking of P;
  redefine func m1 + m2 -> marking of P means


  for p being set st p in P holds
  it multitude_of p = (m1 multitude_of p)+(m2 multitude_of p);
end;

theorem 
  m + {$}P = m;

definition
  let P be set;
  let m1, m2 be marking of P such that
 m2 c= m1;
  func m1 - m2 -> marking of P means


  for p being set st p in P holds
  it multitude_of p = (m1 multitude_of p)-(m2 multitude_of p);
end;

theorem 
  m1 c= m1 + m2;

theorem 
  m - {$}P = m;

theorem 
  m1 c= m2 & m2 c= m3 implies m3 - m2 c= m3 - m1;

theorem 
  (m1 + m2) - m2 = m1;

theorem 
  m c= m1 & m1 c= m2 implies m1 - m c= m2 - m;

theorem 
  m1 c= m2 implies m2 + m3 -m1 = m2 - m1 + m3;

theorem 
  m1 c= m2 & m2 c= m1 implies m1 = m2;

theorem 
  (m1 + m2) + m3 = m1 + (m2 + m3);

theorem 
  m1 c= m2 & m3 c= m4 implies m1 + m3 c= m2 + m4;

theorem 
  m1 c= m2 implies m2 - m1 c= m2;

theorem 
  m1 c= m2 & m3 c= m4 & m4 c= m1 implies m1 - m4 c= m2 - m3;

theorem 
  m1 c= m2 implies m2 = (m2 - m1) + m1;

theorem 
  (m1 + m2) - m1 = m2;

theorem 
  m2 + m3 c= m1 implies (m1 - m2) - m3 = m1 - (m2 + m3);

theorem 
  m3 c= m2 & m2 c= m1 implies m1 - (m2 - m3) = (m1 - m2) + m3;

begin 

definition
  let P;
  mode transition of P means


    ex m1,m2 st it=[m1,m2];
end;

reserve t,t1,t2 for transition of P;

notation
  let P,t;
  synonym Pre t for t`1;
  synonym Post t for t`2;
end;

definition
  let P,t;
  redefine func Pre t -> marking of P;
  redefine func Post t -> marking of P;
end;

definition
  let P, m, t;
  func fire(t,m) -> marking of P equals


  (m - Pre t) + Post t if Pre t c= m otherwise m;
end;

theorem 
  (Pre t1) + (Pre t2) c= m implies
  fire(t2, fire(t1,m)) = (m - (Pre t1) - Pre t2) + (Post t1) + (Post t2);

definition
  let P, t;
  func fire t -> Function means


  dom it = Funcs(P, NAT) &
  for m being marking of P holds it.m = fire(t,m);
end;

theorem 
  rng fire t c= Funcs(P, NAT);

theorem 
  fire(t2, fire(t1,m)) = ((fire t2)*(fire t1)).m;

definition
  let P;
  mode Petri_net of P -> non empty set means


    for x being set st x in it holds x is transition of P;
end;

reserve N for Petri_net of P;

definition
  let P, N;
  redefine mode Element of N -> transition of P;
end;

reserve e, e1,e2 for Element of N;

begin 

definition
  let P, N;
  mode firing-sequence of N is Element of N*;
end;

reserve C,C1,C2,C3,fs,fs1,fs2 for firing-sequence of N;

definition
  let P, N, C;
  func fire C -> Function means


  ex F being Function-yielding FinSequence st it = compose(F, Funcs(P, NAT)) &
  len F = len C & for i being Element of NAT st i in dom C
  holds F.i = fire (C /. i qua Element of N);
end;



theorem 
  fire(<*>N) = id Funcs(P, NAT);



theorem 
  fire <*e*> = fire e;

theorem 
  (fire e)*id Funcs(P, NAT) = fire e;



theorem 
  fire <*e1,e2*> = (fire e2)*(fire e1);

theorem 
  dom fire C = Funcs(P, NAT) & rng fire C c= Funcs(P, NAT);



theorem 
  fire (C1^C2) = (fire C2)*(fire C1);

theorem 
  fire (C^<*e*>) = (fire e)*(fire C);

definition
  let P, N, C, m;
  func fire(C, m) -> marking of P equals

  (fire C).m;
end;

begin 

definition
  let P, N;
  mode process of N is Subset of N*;
end;

reserve R, R1, R2, R3, P1, P2 for process of N;

definition
  let P, N, R1, R2;
  func R1 before R2 -> process of N equals

  {C1^C2: C1 in R1 & C2 in R2};
end;

registration
  let P, N;
  let R1, R2 be non empty process of N;
  cluster R1 before R2 -> non empty;
end;

theorem 
  (R1 \/ R2) before R = (R1 before R) \/ (R2 before R);

theorem 
  R before (R1 \/ R2) = (R before R1) \/ (R before R2);

theorem 
  {C1} before {C2} = {C1^C2};

theorem 
  {C1,C2} before {C} = {C1^C, C2^C};

theorem 
  {C} before {C1,C2} = {C^C1, C^C2};

begin 

definition
  let P, N, R1, R2;
  func R1 concur R2 -> process of N equals

  {C: ex q1,q2 being FinSubsequence st C = q1 \/ q2 & q1 misses q2 &
  Seq q1 in R1 & Seq q2 in R2};
  commutativity;
end;

theorem 
  (R1 \/ R2) concur R = (R1 concur R) \/ (R2 concur R);

theorem 
  {<*e1*>} concur {<*e2*>} = {<*e1,e2*>, <*e2,e1*>};

theorem 
  {<*e1*>,<*e2*>} concur {<*e*>} = {<*e1,e*>, <*e2,e*>, <*e,e1*>, <*e,e2*>};

theorem 
  (R1 before R2) before R3 = R1 before (R2 before R3);

definition
  let p be FinSubsequence;
  let i be Element of NAT;
  func i Shift p -> FinSubsequence means


  dom it = {i+k where k is Element of NAT: k in dom p} &
  for j being Nat st j in dom p holds it.(i+j) = p.j;
end;

reserve q,q1,q2,q3,q4 for FinSubsequence;

theorem 
  0 Shift q = q;

theorem 
  (i+j) Shift q = i Shift (j Shift q);

theorem 
  for p being FinSequence
  holds
  dom (i Shift p) = {j1: i+1 <= j1 & j1 <= i+(len p)};

theorem 
  for q being FinSubsequence holds q = {} iff i Shift q = {};

theorem 
  for q being FinSubsequence ex ss being FinSubsequence st
  dom ss = dom q & rng ss = dom (i Shift q) &
  (for k st k in dom q holds ss.k = i+k) & ss is one-to-one;

theorem 
  for q being FinSubsequence holds card q = card (i Shift q);

theorem 
  for p being FinSequence holds dom p = dom Seq (i Shift p);

theorem 
  for p being FinSequence st k in dom p holds (Sgm dom (i Shift p)).k = i + k;

theorem 
  for p being FinSequence st k in dom p holds (Seq (i Shift p)).k = p.k;

theorem 
  for p being FinSequence holds Seq (i Shift p) = p;

reserve p1,p2 for FinSequence;

theorem 
  dom (p1 \/ ((len p1) Shift p2)) = Seg (len p1 + len p2);

theorem 
  for p1 being FinSequence, p2 being FinSubsequence st len p1 <= i holds
  dom p1 misses dom (i Shift p2);

theorem 
  for p1,p2 being FinSequence holds p1^p2 = p1 \/ ((len p1) Shift p2);

theorem 
  for p1 being FinSequence, p2 being FinSubsequence st i >= len p1
  holds p1 misses i Shift p2;

theorem 
  (R1 concur R2) concur R3 = R1 concur (R2 concur R3);

theorem 
  R1 before R2 c= R1 concur R2;

theorem 
  R1 c= P1 & R2 c= P2 implies R1 before R2 c= P1 before P2;

theorem 
  R1 c= P1 & R2 c= P2 implies R1 concur R2 c= P1 concur P2;

theorem 
  for p,q being FinSubsequence st q c= p holds i Shift q c= i Shift p;

theorem 
  for p1,p2 being FinSequence holds len p1 Shift p2 c= p1^p2;

theorem 
  dom q1 misses dom q2 implies dom (i Shift q1) misses dom (i Shift q2);

theorem 
  for q,q1,q2 being FinSubsequence st q = q1 \/ q2 & q1 misses q2 holds
  (i Shift q1) \/ (i Shift q2) = i Shift q;

theorem 
  for q being FinSubsequence holds dom Seq q = dom Seq (i Shift q);

theorem 
  for q being FinSubsequence st k in dom Seq q
  ex j st j = (Sgm dom q).k & (Sgm dom (i Shift q)).k = i + j;

theorem 
  for q being FinSubsequence st
  k in dom Seq q holds (Seq (i Shift q)).k = (Seq q).k;

theorem 
  for q being FinSubsequence holds Seq q = Seq (i Shift q);

theorem 
  for q being FinSubsequence st
  dom q c= Seg k holds dom (i Shift q) c= Seg (i+k);

theorem 
  for p being FinSequence, q1,q2 being FinSubsequence st q1 c= p
  ex ss being FinSubsequence st ss = q1 \/ (len p Shift q2);

theorem 
for p1,p2 being FinSequence, q1,q2 being FinSubsequence st q1 c= p1 & q2 c= p2
  ex ss being FinSubsequence st ss = q1 \/ (len p1 Shift q2) &
  dom Seq ss = Seg (len Seq q1 + len Seq q2);

theorem 
for p1,p2 being FinSequence, q1,q2 being FinSubsequence st q1 c= p1 & q2 c= p2
  ex ss being FinSubsequence st ss = q1 \/ (len p1 Shift q2) &
  dom Seq ss = Seg (len Seq q1 + len Seq q2) &
  Seq ss = Seq q1 \/ (len Seq q1 Shift Seq q2);

theorem 
for p1,p2 being FinSequence, q1,q2 being FinSubsequence st q1 c= p1 & q2 c= p2
  ex ss being FinSubsequence st
  ss = q1 \/ (len p1 Shift q2) & (Seq q1)^(Seq q2) = Seq ss;

theorem 
  (R1 concur R2) before (P1 concur P2) c= (R1 before P1) concur (R2 before P2);

registration
  let P, N;
  let R1, R2 be non empty process of N;
  cluster R1 concur R2 -> non empty;
end;

begin  

definition
  let P;
  let N be Petri_net of P;
  func NeutralProcess(N) -> non empty process of N equals

  {<*>N};
end;

definition
  let P;
  let N be Petri_net of P;
  let t be Element of N;
  func ElementaryProcess(t) -> non empty process of N equals

  {<*t*>};
end;

theorem 
  NeutralProcess(N) before R = R;

theorem 
  R before NeutralProcess(N) = R;

theorem 
  NeutralProcess(N) concur R = R;














begin 

reserve n, k, r, m, i, j for Nat;

theorem 
  for n being non empty Element of NAT holds n -' 1 + 2 = n + 1;

theorem 
  for n being odd Integer holds (-1) to_power n = -1;

theorem 
  for n being even Integer holds (-1) to_power n = 1;

theorem 
  for m being non empty real number, n being Integer holds
  ((-1) * m) to_power n = ((-1) to_power n) * (m to_power n);

theorem 
  for a being real number holds a to_power (k+m) = (a to_power k) *
  (a to_power m);

theorem 
  for k being non empty real number, m being odd Integer holds k
  to_power m to_power n = k to_power (m * n);

theorem 
  ((-1) to_power (-n)) ^2 = 1;

theorem 
  for a being non empty real number holds (a to_power (-k)) * (a
  to_power (-m)) = a to_power (-k-m);

theorem 
  (-1) to_power (-2 * n) = 1;

theorem 
  for a being non empty real number holds (a to_power k) * (a
  to_power (-k)) = 1;

registration
  let n be odd Integer;
  cluster -n -> odd;
end;

registration
  let n be even Integer;
  cluster -n -> even;
end;

theorem 
  (-1) to_power (-n) = (-1) to_power n;

theorem 
  for k, m, m1, n1 being Element of NAT st k divides m & k divides
  n holds k divides m * m1 + n * n1;

registration
  cluster finite non empty natural-membered with_non-empty_elements for set;
end;

registration
  let f be Function of NAT, NAT;
  let A be finite natural-membered with_non-empty_elements set;
  cluster f | A -> FinSubsequence-like;
end;

theorem 
  for p being FinSubsequence holds rng Seq p c= rng p;

definition
  let f be Function of NAT, NAT;
  let A be finite with_non-empty_elements natural-membered set;
  func Prefix (f, A) -> FinSequence of NAT equals

  Seq (f | A);
end;

theorem 
  for k being Element of NAT st k <> 0 holds k + m <= n implies m < n;

registration
  cluster NAT -> bounded_below;
end;

theorem 
  for x, y being set st 0 < i & i < j holds {[i,x], [j,y]} is FinSubsequence;

theorem 
  for x, y being set, q being FinSubsequence st i < j & q = {[i,x]
  , [j,y]} holds Seq q = <*x,y*>;

registration
  let n be Element of NAT;
  cluster Seg n -> with_non-empty_elements;
end;

registration
  let A be with_non-empty_elements set;
  cluster -> with_non-empty_elements for Subset of A;
end;

registration
  let A be with_non-empty_elements set;
  let B be set;
  cluster A /\ B -> with_non-empty_elements;
  cluster B /\ A -> with_non-empty_elements;
end;

theorem 
  for k being Element of NAT, a being set st k >= 1 holds {[k, a]}
  is FinSubsequence;

theorem 
  for i being Element of NAT, y being set, f being FinSubsequence
  st f = { [1,y] } holds i Shift f = { [1+i,y] };

theorem 
  for q being FinSubsequence, k, n being Element of NAT st dom q
  c= Seg k & n > k ex p being FinSequence st q c= p & dom p = Seg n;

theorem 
  for q being FinSubsequence holds ex p being FinSequence st q c= p;

begin 

scheme 

  FibInd1 {P[set] } : for k being non empty Nat holds P[k]
provided
 P[1] and
 P[2] and
 for k being non empty Nat st P[k] & P[k+1] holds P[k+2];

scheme 

  FibInd2 {P[set] } : for k be non trivial Nat holds P[k]
provided
 P[2] and
 P[3] and
 for k be non trivial Nat st P[k] & P[k+1] holds P[k+2];

theorem 
  Fib (2) = 1;

theorem 
  Fib (3) = 2;

theorem 
  Fib (4) = 3;

theorem 
  for n being Nat holds Fib (n + 2) = Fib (n) + Fib (n + 1);

theorem 
  for n being Nat holds Fib (n + 3) = Fib (n + 2) + Fib (n + 1);

theorem 
  Fib (n + 4) = Fib (n + 2) + Fib (n + 3);

theorem 
  Fib (n + 5) = Fib (n + 3) + Fib (n + 4);

theorem 
  Fib (n + 2) = Fib (n + 3) - Fib (n + 1);

theorem 
  for n being Nat holds Fib (n + 1) = Fib (n + 2) - Fib (n);

theorem 
  Fib (n) = Fib (n+2) - Fib (n+1);

begin 

theorem 
  Fib (n) * Fib (n+2) - (Fib (n+1)) ^2 = (-1) |^ (n+1);

theorem 
  for n being non empty Element of NAT holds Fib (n-'1) * Fib (n+1) - (
  Fib (n)) ^2 = (-1) |^n;

theorem 
  tau > 0;

theorem 
  tau_bar = (- tau) to_power (-1);

theorem 
  (-tau) to_power ((-1) * n) = (-tau) to_power (-1) to_power n;

theorem 
  - 1 / tau = tau_bar;

theorem 
  (tau to_power r) ^2 - 2 * ((-1) to_power r) + (tau to_power (-r)
  ) ^2 = ((tau to_power r) - (tau_bar to_power r)) ^2;

theorem 
  for n,r being non empty Element of NAT st r <= n holds (Fib (n)) ^2 -
  Fib (n+r) * Fib (n-'r) = ((-1) |^(n-'r)) * (Fib (r)) ^2;

theorem 
  (Fib (n)) ^2 + (Fib (n+1)) ^2 = Fib (2*n + 1);

theorem 
  for k being non empty Element of NAT holds Fib (n+k) = Fib (k) *
  Fib (n+1) + Fib (k-'1) * Fib (n);

theorem 
  for n being non empty Element of NAT holds Fib (n) divides Fib ( n*k);

theorem 
  for k being non empty Element of NAT holds k divides n implies
  Fib (k) divides Fib (n);

theorem 
  Fib (n) <= Fib (n + 1);

theorem 
  for n being Element of NAT st n > 1 holds Fib (n) < Fib (n+1);

theorem 
  for m, n st m >= n holds Fib(m) >= Fib(n);

theorem 
  for k being Nat st k > 1 holds k < n implies Fib (k) < Fib (n);

theorem 
  Fib (k) = 1 iff k = 1 or k = 2;

theorem 
  for k,n being Element of NAT st n > 1 & k <> 0 & k <> 1 holds
  Fib (k) = Fib (n) iff k = n;

theorem 
  for n being Element of NAT st n > 1 & n <> 4 holds n is non
prime implies ex k being non empty Element of NAT st k <> 1 & k <> 2 & k <> n &
  k divides n;

theorem 
  for n being Element of NAT st n > 1 & n <> 4 holds Fib (n) is prime
  implies n is prime;

begin 

definition
  func FIB -> Function of NAT, NAT means


  for k being Element of NAT holds it.k = Fib(k);
end;

definition
  func EvenNAT -> Subset of NAT equals

  { 2 * k where k is Element of NAT : not
  contradiction };
  func OddNAT -> Subset of NAT equals

  { 2 * k + 1 where k is Element of NAT :
  not contradiction };
end;

theorem 
  for k being Element of NAT holds 2 * k in EvenNAT & not 2 * k + 1 in EvenNAT;

theorem 
  for k being Element of NAT holds 2 * k + 1 in OddNAT & not 2 * k in OddNAT;

definition
  let n be Element of NAT;
  func EvenFibs (n) -> FinSequence of NAT equals

  Prefix (FIB, EvenNAT /\ Seg n
  );
  func OddFibs (n) -> FinSequence of NAT equals

  Prefix (FIB, OddNAT /\ Seg n);
end;

theorem 
  EvenFibs (0) = {};

theorem 
  Seq (FIB | {2}) = <*1*>;

theorem 
  EvenFibs (2) = <*1*>;

theorem 
  EvenFibs (4) = <*1,3*>;

theorem 
  for k being Element of NAT holds (EvenNAT /\ Seg (2 * k + 2)) \/
  {2 * k + 4} = EvenNAT /\ Seg (2 * k + 4);

theorem 
  for k being Element of NAT holds FIB | (EvenNAT /\ Seg (2 * k +
  2)) \/ {[2*k+4,FIB.(2 * k + 4)]} = FIB | (EvenNAT /\ Seg (2 * k + 4));

theorem 
  for n being Element of NAT holds EvenFibs (2 * n + 2) = EvenFibs
  (2 * n) ^ <* Fib (2 * n + 2) *>;

theorem 
  OddFibs (1) = <*1*>;

theorem 
  OddFibs (3) = <*1,2*>;

theorem 
  for k being Nat holds OddNAT /\ Seg (2 * k + 3) \/ {2 * k + 5} =
  OddNAT /\ Seg (2 * k + 5);

theorem 
  for k being Nat holds (FIB | (OddNAT /\ Seg (2 * k + 3))) \/ {[2
  *k+5,FIB.(2 * k + 5)]} = (FIB | (OddNAT /\ Seg (2 * k + 5)));

theorem 
  for n being Nat holds OddFibs (2 * n + 3) = OddFibs (2 * n + 1)
  ^ <* Fib (2 * n + 3) *>;

theorem 
  for n being Element of NAT holds Sum EvenFibs (2 * n + 2) = Fib (2 * n
  + 3) - 1;

theorem 
  for n being Nat holds Sum OddFibs (2 * n + 1) = Fib (2 * n + 2);

begin 

theorem 
  for n being Element of NAT holds Fib (n), Fib (n+1) are_relative_prime;

theorem 
  for n being non empty Nat, m being Nat st m <> 1 holds m divides
  Fib (n) implies not m divides Fib (n-'1);


theorem 
  for n being non empty Nat holds m is prime & n is prime & m divides
  Fib (n) implies for r being Nat st r < n & r <> 0 holds not m divides Fib (r)
;

begin 

theorem 
  for n being non empty Element of NAT holds {Fib (n) * Fib (n+3), 2 *
  Fib (n+1) * Fib (n+2), (Fib (n+1)) ^2 + (Fib (n+2)) ^2} is Pythagorean_triple
;














begin 

reserve

  k,n for Element of NAT,
  x,y,X,Y,Z for set;

theorem 
  for a,b being set st a <> b & card a = n & card b = n holds card
  (a /\ b) in n & n + 1 c= card (a \/ b);

theorem 
  for a,b being set st card a = n + k & card b = n + k holds card(a
  /\ b) = n iff card(a \/ b) = n + 2*k;

theorem 
  card X c= card Y iff ex f being Function st f is one-to-one & X
  c= dom f & f.:X c= Y;

theorem 
  for f being Function st f is one-to-one & X c= dom f holds card(f
  .:X) = card X;

theorem 
  X \ Y = X \ Z & Y c= X & Z c= X implies Y = Z;

theorem 
  for Y being non empty set for p being Function of X,Y st p is
  one-to-one for x1,x2 being Subset of X holds x1 <> x2 implies p.:x1 <> p.:x2;

theorem 
  for a,b,c being set st card a = n - 1 & card b = n - 1 & card c =
n - 1 & card(a /\ b) = n - 2 & card(a /\ c) = n - 2 & card(b /\ c) = n - 2 & 2
<= n holds (3 <= n implies card(a /\ b /\ c) = n - 2 & card(a \/ b \/ c) = n +
1 or card(a /\ b /\ c) = n - 3 & card(a \/ b \/ c) = n ) & (n = 2 implies card(
  a /\ b /\ c) = n - 2 & card(a \/ b \/ c) = n + 1 );

theorem 
  for P1,P2 being IncProjStr st the IncProjStr of P1 = the
IncProjStr of P2 for A1 being POINT of P1, A2 being POINT of P2 st A1 = A2 for
  L1 being LINE of P1, L2 being LINE of P2 st L1 = L2 holds A1 on L1 implies A2
  on L2;

theorem 
  for P1,P2 being IncProjStr st the IncProjStr of P1 = the
IncProjStr of P2 for A1 being Subset of the Points of P1 for A2 being Subset of
the Points of P2 st A1 = A2 for L1 being LINE of P1, L2 being LINE of P2 st L1
  = L2 holds A1 on L1 implies A2 on L2;

registration
  cluster with_non-trivial_lines linear up-2-rank strict for IncProjStr;
end;

begin 

definition
  mode PartialLinearSpace is with_non-trivial_lines up-2-rank IncProjStr;
end;

definition
  let k be Element of NAT;
  let X be non empty set such that
 0 < k and
 k + 1 c= card X;
  func G_(k,X) -> strict PartialLinearSpace means


  the Points of it = {A
where A is Subset of X: card A = k} & the Lines of it = {L where L is Subset of
X: card L = k + 1} & the Inc of it = (RelIncl bool X) /\ [:the Points of it,
  the Lines of it:];
end;

theorem 
  for k being Element of NAT for X being non empty set st 0 < k &
k + 1 c= card X for A being POINT of G_(k,X) for L being LINE of G_(k,X) holds
  A on L iff A c= L;

theorem 
  for k being Element of NAT for X being non empty set st 0 < k &
  k + 1 c= card X holds G_(k,X) is Vebleian;

theorem 
  for k being Element of NAT for X being non empty set st 0 < k &
k + 1 c= card X holds for A1,A2,A3,A4,A5,A6 being POINT of G_(k,X) for L1,L2,L3
,L4 being LINE of G_(k,X) st A1 on L1 & A2 on L1 & A3 on L2 & A4 on L2 & A5 on
L1 & A5 on L2 & A1 on L3 & A3 on L3 & A2 on L4 & A4 on L4 & not A5 on L3 & not
A5 on L4 & L1 <> L2 & L3 <> L4 holds ex A6 being POINT of G_(k,X) st A6 on L3 &
  A6 on L4 & A6 = (A1 /\ A2) \/ (A3 /\ A4);

theorem 
  for k being Element of NAT for X being non empty set st 0 < k & k + 1
  c= card X holds G_(k,X) is Desarguesian;

definition
  let S be IncProjStr;
  let K be Subset of the Points of S;
  attr K is clique means


  for A,B being POINT of S st A in K & B in K ex
  L being LINE of S st {A,B} on L;
end;

definition
  let S be IncProjStr;
  let K be Subset of the Points of S;
  attr K is maximal_clique means


  K is clique & for U being Subset of
  the Points of S st U is clique & K c= U holds U = K;
end;

definition
  let k be Element of NAT;
  let X be non empty set;
  let T be Subset of the Points of G_(k,X);
  attr T is STAR means


  ex S being Subset of X st card S = k - 1 & T = {
  A where A is Subset of X: card A = k & S c= A};
  attr T is TOP means


  ex S being Subset of X st card S = k + 1 & T = {A
  where A is Subset of X: card A = k & A c= S};
end;

theorem 
  for k being Element of NAT for X being non empty set st 2 <= k &
k + 2 c= card X for K being Subset of the Points of G_(k,X) holds K is STAR or
  K is TOP implies K is maximal_clique;

theorem 
  for k being Element of NAT for X being non empty set st 2 <= k &
  k + 2 c= card X for K being Subset of the Points of G_(k,X) holds K is
  maximal_clique implies K is STAR or K is TOP;

begin 

definition
  let S1,S2 be IncProjStr;
  struct IncProjMap over S1,S2 (#point-map -> Function of the Points of S1,
the Points of S2, line-map -> Function of the Lines of S1, the Lines of S2#);
end;

definition
  let S1,S2 be IncProjStr;
  let F be IncProjMap over S1,S2;
  let a be POINT of S1;
  func F.a -> POINT of S2 equals

  (the point-map of F).a;
end;

definition
  let S1,S2 be IncProjStr;
  let F be IncProjMap over S1,S2;
  let L be LINE of S1;
  func F.L -> LINE of S2 equals

  (the line-map of F).L;
end;

theorem 
  for S1,S2 being IncProjStr for F1,F2 being IncProjMap over S1,S2
st (for A being POINT of S1 holds F1.A = F2.A) & (for L being LINE of S1 holds
  F1.L = F2.L) holds the IncProjMap of F1 = the IncProjMap of F2;

definition
  let S1,S2 be IncProjStr;
  let F be IncProjMap over S1,S2;
  attr F is incidence_preserving means


  for A1 being POINT of S1 for L1
  being LINE of S1 holds (A1 on L1 iff F.A1 on F.L1);
end;

theorem 
  for S1,S2 being IncProjStr for F1,F2 being IncProjMap over S1,S2 st
  the IncProjMap of F1 = the IncProjMap of F2 holds F1 is incidence_preserving
  implies F2 is incidence_preserving;

definition
  let S be IncProjStr;
  let F be IncProjMap over S,S;
  attr F is automorphism means


  the line-map of F is bijective & the
  point-map of F is bijective & F is incidence_preserving;
end;

definition
  let S1,S2 be IncProjStr;
  let F be IncProjMap over S1,S2;
  let K be Subset of the Points of S1;
  func F.:K -> Subset of the Points of S2 equals

  (the point-map of F).:K;
end;

definition
  let S1,S2 be IncProjStr;
  let F be IncProjMap over S1,S2;
  let K be Subset of the Points of S2;
  func F"K -> Subset of the Points of S1 equals

  (the point-map of F)"K;
end;

definition
  let X be set;
  let A be finite set;
  func ^^(A,X) -> Subset of bool X equals

  {B where B is Subset of X: card B =
  (card A)+1 & A c= B};
end;

definition
  let k be Element of NAT;
  let X be non empty set such that
 0 < k & k + 1 c= card X;
  let A be finite set such that
 card A = k - 1;
  func ^^(A,X,k) -> Subset of the Points of G_(k,X) equals


  ^^(A,X);
end;

theorem 
  for S1,S2 being IncProjStr for F being IncProjMap over S1,S2 for
K being Subset of the Points of S1 holds F.:K = {B where B is POINT of S2:ex A
  being POINT of S1 st (A in K & F.A = B)};

theorem 
  for S1,S2 being IncProjStr for F being IncProjMap over S1,S2 for K
  being Subset of the Points of S2 holds F"K = {A where A is POINT of S1:ex B
  being POINT of S2 st (B in K & F.A = B)};

theorem 
  for S being IncProjStr for F being IncProjMap over S,S for K
  being Subset of the Points of S holds F is incidence_preserving & K is clique
  implies F.:K is clique;

theorem 
  for S being IncProjStr for F being IncProjMap over S,S for K
being Subset of the Points of S holds F is incidence_preserving & the line-map
  of F is onto & K is clique implies F"K is clique;

theorem 
  for S being IncProjStr for F being IncProjMap over S,S for K
  being Subset of the Points of S holds F is automorphism & K is maximal_clique
  implies F.:K is maximal_clique & F"K is maximal_clique;

theorem 
  for k being Element of NAT for X being non empty set st 2 <= k &
  k + 2 c= card X for F being IncProjMap over G_(k,X), G_(k,X) st F is
  automorphism for K being Subset of the Points of G_(k,X) holds K is STAR
  implies F.:K is STAR & F"K is STAR;

definition
  let k be Element of NAT;
  let X be non empty set such that
 0 < k & k + 1 c= card X;
  let s be Permutation of X;
  func incprojmap(k,s) -> strict IncProjMap over G_(k,X), G_(k,X) means



  (for A being POINT of G_(k,X) holds it.A = s.:A) & for L being LINE of G_(k,X
  ) holds it.L = s.:L;
end;

theorem 
  for k being Element of NAT for X being non empty set st k = 1 &
  k + 1 c= card X for F being IncProjMap over G_(k,X), G_(k,X) st F is
  automorphism holds ex s being Permutation of X st the IncProjMap of F =
  incprojmap(k,s);

theorem 
  for k being Element of NAT for X being non empty set st 1 < k &
  card X = k + 1 for F being IncProjMap over G_(k,X), G_(k,X) st F is
  automorphism holds ex s being Permutation of X st the IncProjMap of F =
  incprojmap(k,s);

theorem 
  for k being Element of NAT for X being non empty set st 0 < k &
k + 1 c= card X for T being Subset of the Points of G_(k,X) for S being Subset
of X holds card S = k - 1 & T = {A where A is Subset of X: card A = k & S c= A}
  implies S = meet T;

theorem 
  for k being Element of NAT for X being non empty set st 0 < k & k + 1
c= card X for T being Subset of the Points of G_(k,X) st T is STAR for S being
Subset of X holds S = meet T implies card S = k - 1 & T = {A where A is Subset
  of X: card A = k & S c= A};

theorem 
  for k being Element of NAT for X being non empty set st 0 < k &
k + 1 c= card X for T1,T2 being Subset of the Points of G_(k,X) st T1 is STAR &
  T2 is STAR & meet T1 = meet T2 holds T1 = T2;

theorem 
  for k being Element of NAT for X being non empty set st k + 1 c=
  card X for A being finite Subset of X st card A = k-1 holds ^^(A,X,k) is STAR
;

theorem 
  for k being Element of NAT for X being non empty set st k + 1 c=
card X for A being finite Subset of X st card A = k-1 holds meet ^^(A,X,k) = A;

theorem 
  for k being Element of NAT for X being non empty set st 0 < k &
  k + 3 c= card X for F being IncProjMap over G_(k+1,X), G_(k+1,X) st F is
automorphism ex H being IncProjMap over G_(k,X), G_(k,X) st H is automorphism &
the line-map of H = the point-map of F & for A being POINT of G_(k,X), B being
  finite set st B = A holds H.A = meet(F.:(^^(B,X,k+1)));

theorem 
  for k being Element of NAT for X being non empty set st 0 < k &
  k + 3 c= card X for F being IncProjMap over G_(k+1,X), G_(k+1,X) st F is
automorphism for H being IncProjMap over G_(k,X), G_(k,X) st the line-map of H
  = the point-map of F for f being Permutation of X st the IncProjMap of H =
  incprojmap(k,f) holds the IncProjMap of F = incprojmap(k+1,f);

theorem 
  for k being Element of NAT for X being non empty set st 2 <= k &
  k + 2 c= card X for F being IncProjMap over G_(k,X), G_(k,X) st F is
  automorphism holds ex s being Permutation of X st the IncProjMap of F =
  incprojmap(k,s);

theorem 
  for k being Element of NAT for X being non empty set st 0 < k &
  k + 1 c= card X for s being Permutation of X holds incprojmap(k,s) is
  automorphism;

theorem 
  for X being non empty set st 0 < k & k + 1 c= card X for F being
  IncProjMap over G_(k,X), G_(k,X) holds F is automorphism iff ex s being
  Permutation of X st the IncProjMap of F = incprojmap(k,s);














begin 

registration
  let n be Nat;
  let f be Function of n-tuples_on BOOLEAN, BOOLEAN;
  let p be FinSeqLen of n;
  cluster 1GateCircuit(p,f) -> Boolean;
end;

theorem 
  for X being finite non empty set, n being Nat for p being
FinSeqLen of n for f being Function of n-tuples_on X, X for o being OperSymbol
  of 1GateCircStr(p,f) for s being State of 1GateCircuit(p,f) holds o
  depends_on_in s = s*p;

theorem 
  for X being finite non empty set, n being Nat for p being FinSeqLen of
n for f being Function of n-tuples_on X, X for s being State of 1GateCircuit(p,
  f) holds Following s is stable;

theorem 
  for S being non void Circuit-like non empty ManySortedSign for
  A being non-empty Circuit of S for s being State of A st s is stable for n
  being Nat holds Following(s, n) = s;

theorem 
  for S being non void Circuit-like non empty ManySortedSign for
  A being non-empty Circuit of S for s being State of A, n1, n2 being Nat st
Following(s, n1) is stable & n1 <= n2 holds Following(s, n2) = Following(s, n1)
;

begin 

scheme 

  CIRCCMB29sch1 {S0() -> non empty ManySortedSign, o0()-> set, S(set,set,set)
-> non empty ManySortedSign, o(set,set) -> set}: ex f,h being ManySortedSet of
  NAT st f.0 = S0() & h.0 = o0() & for n being Nat, S being non empty
ManySortedSign, x being set st S = f.n & x = h.n holds f.(n+1) = S(S,x,n) & h.(
  n+1) = o(x,n);

scheme 
 
  CIRCCMB29sch2 {S(set,set,set) -> non empty ManySortedSign, o(set,set) -> set
  , P[set,set,set], f,h() -> ManySortedSet of NAT}: for n being Nat ex S being
  non empty ManySortedSign st S = f().n & P[S,h().n,n]
provided
 ex S being non empty ManySortedSign, x being set st S = f().0 & x =
h().0 & P[S, x, 0] and
 for n being Nat, S being non empty ManySortedSign, x being set st S
= f().n & x = h().n holds f().(n+1) = S(S,x,n) & h().(n+1) = o(x,n) and
 for n being Nat, S being non empty ManySortedSign, x being set st S
= f().n & x = h().n & P[S,x,n] holds P[S(S,x,n), o(x,n), n+1];

scheme 
 
  CIRCCMB29sch3 {S0() -> non empty ManySortedSign, S(set,set,set) -> non empty
ManySortedSign, o(set,set) -> set, f,h() -> ManySortedSet of NAT}: for n being
  Nat, x being set st x = h().n holds h().(n+1) = o(x,n)
provided
 f().0 = S0() and
 for n being Nat, S being non empty ManySortedSign, x being set st S
= f().n & x = h().n holds f().(n+1) = S(S,x,n) & h().(n+1) = o(x,n);

scheme 
 
  CIRCCMB29sch4 {S0() -> non empty ManySortedSign, o0()-> set, S(set,set,set)
  -> non empty ManySortedSign, o(set,set) -> set, n() -> Nat}: ex S being non
empty ManySortedSign, f,h being ManySortedSet of NAT st S = f.n() & f.0 = S0()
  & h.0 = o0() & for n being Nat, S being non empty ManySortedSign, x being set
  st S = f.n & x = h.n holds f.(n+1) = S(S,x,n) & h.(n+1) = o(x,n);

scheme 
 
  CIRCCMB29sch5 {S0() -> non empty ManySortedSign, o0()-> set, S(set,set,set)
  -> non empty ManySortedSign, o(set,set) -> set, n() -> Nat}: for S1,S2 being
non empty ManySortedSign st (ex f,h being ManySortedSet of NAT st S1 = f.n() &
f.0 = S0() & h.0 = o0() & for n being Nat, S being non empty ManySortedSign, x
being set st S = f.n & x = h.n holds f.(n+1) = S(S,x,n) & h.(n+1) = o(x,n)) & (
ex f,h being ManySortedSet of NAT st S2 = f.n() & f.0 = S0() & h.0 = o0() & for
n being Nat, S being non empty ManySortedSign, x being set st S = f.n & x = h.n
  holds f.(n+1) = S(S,x,n) & h.(n+1) = o(x,n)) holds S1 = S2;

scheme 
 
  CIRCCMB29sch6 {S0() -> non empty ManySortedSign, o0()-> set, S(set,set,set)
  -> non empty ManySortedSign, o(set,set) -> set, n() -> Nat}: (ex S being non
empty ManySortedSign, f,h being ManySortedSet of NAT st S = f.n() & f.0 = S0()
  & h.0 = o0() & for n being Nat, S being non empty ManySortedSign, x being set
  st S = f.n & x = h.n holds f.(n+1) = S(S,x,n) & h.(n+1) = o(x,n)) & for S1,S2
being non empty ManySortedSign st (ex f,h being ManySortedSet of NAT st S1 = f.
  n() & f.0 = S0() & h.0 = o0() & for n being Nat, S being non empty
ManySortedSign, x being set st S = f.n & x = h.n holds f.(n+1) = S(S,x,n) & h.(
n+1) = o(x,n)) & (ex f,h being ManySortedSet of NAT st S2 = f.n() & f.0 = S0()
  & h.0 = o0() & for n being Nat, S being non empty ManySortedSign, x being set
st S = f.n & x = h.n holds f.(n+1) = S(S,x,n) & h.(n+1) = o(x,n)) holds S1 = S2
;

scheme 
 
  CIRCCMB29sch7 {S0() -> non empty ManySortedSign, S(set,set,set) -> non empty
ManySortedSign, o0()-> set, o(set,set) -> set, n() -> Nat}: ex S being unsplit
gate`1=arity gate`2isBoolean non void non empty non empty strict ManySortedSign
, f,h being ManySortedSet of NAT st S = f.n() & f.0 = S0() & h.0 = o0() & for n
  being Nat, S being non empty ManySortedSign, x being set st S = f.n & x = h.n
  holds f.(n+1) = S(S,x,n) & h.(n+1) = o(x,n)
provided
 S0() is unsplit gate`1=arity gate`2isBoolean non void non empty strict and
 for S being unsplit gate`1=arity gate`2isBoolean non void strict non
empty ManySortedSign, x being set, n being Nat holds S(S,x,n) is unsplit
gate`1=arity gate`2isBoolean non void non empty strict;

scheme 
 
  CIRCCMB29sch8 {S0() -> non empty ManySortedSign, S(set,set) -> unsplit
gate`1=arity gate`2isBoolean non void non empty ManySortedSign, o0()-> set, o(
  set,set) -> set, n() -> Nat}: ex S being unsplit gate`1=arity gate`2isBoolean
non void non empty non empty strict ManySortedSign, f,h being ManySortedSet of
NAT st S = f.n() & f.0 = S0() & h.0 = o0() & for n being Nat, S being non empty
ManySortedSign, x being set st S = f.n & x = h.n holds f.(n+1) = S +* S(x,n) &
  h.(n+1) = o(x,n)
provided
 S0() is unsplit gate`1=arity gate`2isBoolean non void non empty strict;

scheme 
 
  CIRCCMB29sch9 {S0() -> non empty ManySortedSign, o0()-> set, S(set,set,set)
  -> non empty ManySortedSign, o(set,set) -> set, n() -> Nat}: for S1,S2 being
  unsplit gate`1=arity gate`2isBoolean non void non empty strict non empty
ManySortedSign st (ex f,h being ManySortedSet of NAT st S1 = f.n() & f.0 = S0()
  & h.0 = o0() & for n being Nat, S being non empty ManySortedSign, x being set
  st S = f.n & x = h.n holds f.(n+1) = S(S,x,n) & h.(n+1) = o(x,n)) & (ex f,h
  being ManySortedSet of NAT st S2 = f.n() & f.0 = S0() & h.0 = o0() & for n
  being Nat, S being non empty ManySortedSign, x being set st S = f.n & x = h.n
  holds f.(n+1) = S(S,x,n) & h.(n+1) = o(x,n)) holds S1 = S2;

begin

theorem 
  for S1,S2 being non empty ManySortedSign st S1 tolerates S2 holds
  InputVertices (S1+*S2) = ((InputVertices S1)\(InnerVertices S2)) \/ ((
  InputVertices S2)\(InnerVertices S1));

theorem 
  for X being without_pairs set, Y being Relation holds X \ Y = X;

theorem 
  for X being Relation, Y, Z being set st Z c= Y & Y \ Z is
  without_pairs holds X \ Y = X \ Z;

theorem 
  for X,Z being set, Y being Relation st Z c= Y & X \ Z is
  without_pairs holds X \ Y = X \ Z;

scheme 
 
  CIRCCMB29sch10 {S0() -> unsplit gate`1=arity gate`2isBoolean non void non
empty ManySortedSign, f(set) -> set, h() -> ManySortedSet of NAT, S(set,set) ->
unsplit gate`1=arity gate`2isBoolean non void non empty ManySortedSign, o(set,
  set) -> set}: for n being Nat ex S1,S2 being unsplit gate`1=arity
gate`2isBoolean non void non empty ManySortedSign st S1 = f(n) & S2 = f(n+1) &
InputVertices S2 = (InputVertices S1)\/((InputVertices S(h().n,n)) \ {h().n}) &
  InnerVertices S1 is Relation & InputVertices S1 is without_pairs
provided
 InnerVertices S0() is Relation and
 InputVertices S0() is without_pairs and
 f(0) = S0() & h().0 in InnerVertices S0() and
 for n being Nat, x being set holds InnerVertices S(x,n) is Relation and
 for n being Nat, x being set st x = h().n holds (InputVertices S(x,n
)) \ {x} is without_pairs and
 for n being Nat, S being non empty ManySortedSign, x being set st S
= f(n) & x = h().n holds f(n+1) = S +* S(x,n) & h().(n+1) = o(x,n) & x in
InputVertices S(x,n) & o(x,n) in InnerVertices S(x,n);

scheme 
 
  CIRCCMB29sch11 {Sn(set) -> unsplit gate`1=arity gate`2isBoolean non void non
  empty ManySortedSign, h() -> ManySortedSet of NAT, S(set,set) -> unsplit
  gate`1=arity gate`2isBoolean non void non empty ManySortedSign, o(set,set) ->
  set}: for n being Nat holds InputVertices Sn(n+1) = (InputVertices Sn(n))\/((
  InputVertices S(h().(n),n)) \ {h().(n)}) & InnerVertices Sn(n) is Relation &
  InputVertices Sn(n) is without_pairs
provided
 InnerVertices Sn(0) is Relation and
 InputVertices Sn(0) is without_pairs and
 h().(0) in InnerVertices Sn(0) and
 for n being Nat, x being set holds InnerVertices S(x,n) is Relation and
 for n being Nat, x being set st x = h().(n) holds (InputVertices S(x
,n)) \ {x} is without_pairs and
 for n being Nat, S being non empty ManySortedSign, x being set st S
= Sn(n) & x = h().(n) holds Sn(n+1) = S +* S(x,n) & h().(n+1) = o(x,n) & x in
InputVertices S(x,n) & o(x,n) in InnerVertices S(x,n);

begin 

scheme 

  CIRCCMB29sch12 {S0() -> non empty ManySortedSign, A0() -> non-empty
MSAlgebra over S0(), o0()-> set, S(set,set,set) -> non empty ManySortedSign, A(
  set,set,set,set) -> set, o(set,set) -> set}: ex f,g,h being ManySortedSet of
  NAT st f.0 = S0() & g.0 = A0() & h.0 = o0() & for n being Nat, S being non
empty ManySortedSign, A being non-empty MSAlgebra over S for x being set st S =
f.n & A = g.n & x = h.n holds f.(n+1) = S(S,x,n) & g.(n+1) = A(S,A,x,n) & h.(n+
  1) = o(x,n);

scheme 
 
  CIRCCMB29sch13 {S(set,set,set) -> non empty ManySortedSign, A(set,set,set,
set) -> set, o(set,set) -> set, P[set,set,set,set], f,g,h() -> ManySortedSet of
  NAT}: for n being Nat ex S being non empty ManySortedSign, A being non-empty
  MSAlgebra over S st S = f().n & A = g().n & P[S,A,h().n,n]
provided
 ex S being non empty ManySortedSign, A being non-empty MSAlgebra
over S, x being set st S = f().0 & A = g().0 & x = h().0 & P[S, A, x, 0] and
 for n being Nat, S being non empty ManySortedSign, A being non-empty
MSAlgebra over S for x being set st S = f().n & A = g().n & x = h().n holds f()
.(n+1) = S(S,x,n) & g().(n+1) = A(S,A,x,n) & h().(n+1) = o(x,n) and
 for n being Nat, S being non empty ManySortedSign, A being non-empty
MSAlgebra over S for x being set st S = f().n & A = g().n & x = h().n & P[S,A,x
,n] holds P[S(S,x,n), A(S,A,x,n), o(x,n), n+1] and
 for S being non empty ManySortedSign, A being non-empty MSAlgebra
over S for x being set, n being Nat holds A(S,A,x,n) is non-empty MSAlgebra
over S(S,x,n);

scheme 
 
  CIRCCMB29sch14 {S(set,set,set) -> non empty ManySortedSign, A(set,set,set,
set) -> set, o(set,set) -> set, f1,f2, g1,g2, h1,h2() -> ManySortedSet of NAT}:
  f1() = f2() & g1() = g2() & h1() = h2()
provided
 ex S being non empty ManySortedSign, A being non-empty MSAlgebra
over S st S = f1().0 & A = g1().0 and
 f1().0 = f2().0 & g1().0 = g2().0 & h1().0 = h2().0 and
 for n being Nat, S being non empty ManySortedSign, A being non-empty
MSAlgebra over S for x being set st S = f1().n & A = g1().n & x = h1().n holds
f1().(n+1) = S(S,x,n) & g1().(n+1) = A(S,A,x,n) & h1().(n+1) = o(x,n) and
 for n being Nat, S being non empty ManySortedSign, A being non-empty
MSAlgebra over S for x being set st S = f2().n & A = g2().n & x = h2().n holds
f2().(n+1) = S(S,x,n) & g2().(n+1) = A(S,A,x,n) & h2().(n+1) = o(x,n) and
 for S being non empty ManySortedSign, A being non-empty MSAlgebra
over S for x being set, n being Nat holds A(S,A,x,n) is non-empty MSAlgebra
over S(S,x,n);

scheme 
 
  CIRCCMB29sch15 {S0() -> non empty ManySortedSign, A0() -> non-empty
MSAlgebra over S0(), S(set,set,set) -> non empty ManySortedSign, A(set,set,set,
  set) -> set, o(set,set) -> set, f,g,h() -> ManySortedSet of NAT}: for n being
  Nat, S being non empty ManySortedSign, x being set st S = f().n & x = h().n
  holds f().(n+1) = S(S,x,n) & h().(n+1) = o(x,n)
provided
 f().0 = S0() & g().0 = A0() and
 for n being Nat, S being non empty ManySortedSign, A being non-empty
MSAlgebra over S for x being set st S = f().n & A = g().n & x = h().n holds f()
.(n+1) = S(S,x,n) & g().(n+1) = A(S,A,x,n) & h().(n+1) = o(x,n) and
 for S being non empty ManySortedSign, A being non-empty MSAlgebra
over S for x being set, n being Nat holds A(S,A,x,n) is non-empty MSAlgebra
over S(S,x,n);

scheme 
 
  CIRCCMB29sch16 {S0() -> non empty ManySortedSign, A0() -> non-empty
MSAlgebra over S0(), o0()-> set, S(set,set,set) -> non empty ManySortedSign, A(
  set,set,set,set) -> set, o(set,set) -> set, n() -> Nat}: ex S being non empty
  ManySortedSign, A being non-empty MSAlgebra over S, f,g,h being ManySortedSet
of NAT st S = f.n() & A = g.n() & f.0 = S0() & g.0 = A0() & h.0 = o0() & for n
being Nat, S being non empty ManySortedSign, A being non-empty MSAlgebra over S
for x being set st S = f.n & A = g.n & x = h.n holds f.(n+1) = S(S,x,n) & g.(n+
  1) = A(S,A,x,n) & h.(n+1) = o(x,n)
provided
 for S being non empty ManySortedSign, A being non-empty MSAlgebra
over S for x being set, n being Nat holds A(S,A,x,n) is non-empty MSAlgebra
over S(S,x,n);

scheme 
 
  CIRCCMB29sch17 {S0,Sn() -> non empty ManySortedSign, A0() -> non-empty
MSAlgebra over S0(), o0()-> set, S(set,set,set) -> non empty ManySortedSign, A(
  set,set,set,set) -> set, o(set,set) -> set, n() -> Nat}: ex A being non-empty
MSAlgebra over Sn(), f,g,h being ManySortedSet of NAT st Sn() = f.n() & A = g.n
() & f.0 = S0() & g.0 = A0() & h.0 = o0() & for n being Nat, S being non empty
ManySortedSign, A being non-empty MSAlgebra over S for x being set st S = f.n &
A = g.n & x = h.n holds f.(n+1) = S(S,x,n) & g.(n+1) = A(S,A,x,n) & h.(n+1) = o
  (x,n)
provided
 ex f,h being ManySortedSet of NAT st Sn() = f.n() & f.0 = S0() & h.0
= o0() & for n being Nat, S being non empty ManySortedSign, x being set st S =
f.n & x = h.n holds f.(n+1) = S(S,x,n) & h.(n+1) = o(x,n) and
 for S being non empty ManySortedSign, A being non-empty MSAlgebra
over S for x being set, n being Nat holds A(S,A,x,n) is non-empty MSAlgebra
over S(S,x,n);

scheme 
 
  CIRCCMB29sch18 {S0,Sn() -> non empty ManySortedSign, A0() -> non-empty
MSAlgebra over S0(), o0()-> set, S(set,set,set) -> non empty ManySortedSign, A(
  set,set,set,set) -> set, o(set,set) -> set, n() -> Nat}: for A1,A2 being
non-empty MSAlgebra over Sn() st (ex f,g,h being ManySortedSet of NAT st Sn() =
f.n() & A1 = g.n() & f.0 = S0() & g.0 = A0() & h.0 = o0() & for n being Nat, S
being non empty ManySortedSign, A being non-empty MSAlgebra over S for x being
set st S = f.n & A = g.n & x = h.n holds f.(n+1) = S(S,x,n) & g.(n+1) = A(S,A,x
,n) & h.(n+1) = o(x,n)) & (ex f,g,h being ManySortedSet of NAT st Sn() = f.n()
& A2 = g.n() & f.0 = S0() & g.0 = A0() & h.0 = o0() & for n being Nat, S being
non empty ManySortedSign, A being non-empty MSAlgebra over S for x being set st
S = f.n & A = g.n & x = h.n holds f.(n+1) = S(S,x,n) & g.(n+1) = A(S,A,x,n) & h
  .(n+1) = o(x,n)) holds A1 = A2
provided
 for S being non empty ManySortedSign, A being non-empty MSAlgebra
over S for x being set, n being Nat holds A(S,A,x,n) is non-empty MSAlgebra
over S(S,x,n);

scheme 

  CIRCCMB29sch19 {S0, Sn() -> unsplit gate`1=arity gate`2isBoolean non void
  strict non empty ManySortedSign, A0() -> Boolean gate`2=den strict Circuit of
S0(), S(set,set,set) -> non empty ManySortedSign, A(set,set,set,set) -> set, o0
()-> set, o(set,set) -> set, n() -> Nat}: ex A being Boolean gate`2=den strict
Circuit of Sn(), f,g,h being ManySortedSet of NAT st Sn() = f.n() & A = g.n() &
  f.0 = S0() & g.0 = A0() & h.0 = o0() & for n being Nat, S being non empty
ManySortedSign, A being non-empty MSAlgebra over S for x being set st S = f.n &
A = g.n & x = h.n holds f.(n+1) = S(S,x,n) & g.(n+1) = A(S,A,x,n) & h.(n+1) = o
  (x,n)
provided
 for S being unsplit gate`1=arity gate`2isBoolean non void strict non
empty ManySortedSign, x being set, n being Nat holds S(S,x,n) is unsplit
gate`1=arity gate`2isBoolean non void strict and
 ex f,h being ManySortedSet of NAT st Sn() = f.n() & f.0 = S0() & h.0
= o0() & for n being Nat, S being non empty ManySortedSign, x being set st S =
f.n & x = h.n holds f.(n+1) = S(S,x,n) & h.(n+1) = o(x,n) and
 for S being non empty ManySortedSign, A being non-empty MSAlgebra
over S for x being set, n being Nat holds A(S,A,x,n) is non-empty MSAlgebra
over S(S,x,n) and
 for S,S1 being unsplit gate`1=arity gate`2isBoolean non void strict
non empty ManySortedSign, A being Boolean gate`2=den strict Circuit of S for x
being set, n being Nat st S1 = S(S,x,n) holds A(S,A,x,n) is Boolean gate`2=den
strict Circuit of S1;

definition
  let S be non empty ManySortedSign;
  let A be set such that
 A is non-empty MSAlgebra over S;
  func MSAlg(A,S) -> non-empty MSAlgebra over S means


  it = A;
end;

scheme 
 
  CIRCCMB29sch20 {S0, Sn() -> unsplit gate`1=arity gate`2isBoolean non void
  strict non empty ManySortedSign, A0() -> Boolean gate`2=den strict Circuit of
  S0(), S(set,set) -> unsplit gate`1=arity gate`2isBoolean non void non empty
ManySortedSign, A(set,set) -> set, o0()-> set, o(set,set) -> set, n() -> Nat}:
ex A being Boolean gate`2=den strict Circuit of Sn(), f,g,h being ManySortedSet
of NAT st Sn() = f.n() & A = g.n() & f.0 = S0() & g.0 = A0() & h.0 = o0() & for
  n being Nat, S being non empty ManySortedSign, A1 being non-empty MSAlgebra
  over S for x being set, A2 being non-empty MSAlgebra over S(x,n) st S = f.n &
A1 = g.n & x = h.n & A2 = A(x,n) holds f.(n+1) = S +* S(x,n) & g.(n+1) = A1 +*
  A2 & h.(n+1) = o(x,n)
provided
 ex f,h being ManySortedSet of NAT st Sn() = f.n() & f.0 = S0() & h.0
= o0() & for n being Nat, S being non empty ManySortedSign, x being set st S =
f.n & x = h.n holds f.(n+1) = S +* S(x,n) & h.(n+1) = o(x,n) and
 for x being set, n being Nat holds A(x,n) is Boolean gate`2=den
strict Circuit of S(x,n);

scheme 
 
  CIRCCMB29sch21 {S0() -> non empty ManySortedSign, Sn() -> unsplit
gate`1=arity gate`2isBoolean non void strict non empty ManySortedSign, A0() ->
  non-empty MSAlgebra over S0(), o0()-> set, S(set,set,set) -> non empty
ManySortedSign, A(set,set,set,set) -> set, o(set,set) -> set, n() -> Nat}: for
  A1,A2 being Boolean gate`2=den strict Circuit of Sn() st (ex f,g,h being
ManySortedSet of NAT st Sn() = f.n() & A1 = g.n() & f.0 = S0() & g.0 = A0() & h
  .0 = o0() & for n being Nat, S being non empty ManySortedSign, A being
non-empty MSAlgebra over S for x being set st S = f.n & A = g.n & x = h.n holds
f.(n+1) = S(S,x,n) & g.(n+1) = A(S,A,x,n) & h.(n+1) = o(x,n)) & (ex f,g,h being
ManySortedSet of NAT st Sn() = f.n() & A2 = g.n() & f.0 = S0() & g.0 = A0() & h
  .0 = o0() & for n being Nat, S being non empty ManySortedSign, A being
non-empty MSAlgebra over S for x being set st S = f.n & A = g.n & x = h.n holds
  f.(n+1) = S(S,x,n) & g.(n+1) = A(S,A,x,n) & h.(n+1) = o(x,n)) holds A1 = A2
provided
 for S being non empty ManySortedSign, A being non-empty MSAlgebra
over S for x being set, n being Nat holds A(S,A,x,n) is non-empty MSAlgebra
over S(S,x,n);

begin 

theorem 
  for S1,S2,S being non void Circuit-like non empty ManySortedSign st
  InnerVertices S1 misses InputVertices S2 & S = S1+*S2 for C1 being non-empty
  Circuit of S1, C2 being non-empty Circuit of S2 for C being non-empty Circuit
of S st C1 tolerates C2 & C = C1+*C2 for s2 being State of C2 for s being State
of C st s2 = s|the carrier of S2 holds Following s2 = (Following s)|the carrier
  of S2;

theorem 
  for S1,S2,S being non void Circuit-like non empty
ManySortedSign st InputVertices S1 misses InnerVertices S2 & S = S1+*S2 for C1
  being non-empty Circuit of S1, C2 being non-empty Circuit of S2 for C being
non-empty Circuit of S st C1 tolerates C2 & C = C1+*C2 for s1 being State of C1
  for s being State of C st s1 = s|the carrier of S1 holds Following s1 = (
  Following s)|the carrier of S1;

theorem 
  for S1,S2,S being non void Circuit-like non empty ManySortedSign st
  InnerVertices S1 misses InputVertices S2 & S = S1+*S2 for C1 being non-empty
  Circuit of S1, C2 being non-empty Circuit of S2 for C being non-empty Circuit
  of S st C1 tolerates C2 & C = C1+*C2 for s1 being State of C1 for s2 being
  State of C2 for s being State of C st s1 = s|the carrier of S1 & s2 = s|the
  carrier of S2 & s1 is stable & s2 is stable holds s is stable;

theorem 
  for S1,S2,S being non void Circuit-like non empty ManySortedSign st
  InputVertices S1 misses InnerVertices S2 & S = S1+*S2 for C1 being non-empty
  Circuit of S1, C2 being non-empty Circuit of S2 for C being non-empty Circuit
  of S st C1 tolerates C2 & C = C1+*C2 for s1 being State of C1 for s2 being
  State of C2 for s being State of C st s1 = s|the carrier of S1 & s2 = s|the
  carrier of S2 & s1 is stable & s2 is stable holds s is stable;

theorem 
  for S1,S2,S being non void Circuit-like non empty
ManySortedSign st InputVertices S1 misses InnerVertices S2 & S = S1+*S2 for A1
  being non-empty Circuit of S1, A2 being non-empty Circuit of S2 for A being
non-empty Circuit of S st A1 tolerates A2 & A = A1+*A2 for s being State of A,
s1 be State of A1 st s1 = s|the carrier of S1 for n being Nat holds Following(s
  , n)|the carrier of S1 = Following(s1, n);

theorem 
  for S1,S2,S being non void Circuit-like non empty
ManySortedSign st InputVertices S2 misses InnerVertices S1 & S = S1+*S2 for A1
  being non-empty Circuit of S1, A2 being non-empty Circuit of S2 for A being
non-empty Circuit of S st A1 tolerates A2 & A = A1+*A2 for s being State of A,
s2 be State of A2 st s2 = s|the carrier of S2 for n being Nat holds Following(s
  , n)|the carrier of S2 = Following(s2, n);

theorem 
  for S1,S2,S being non void Circuit-like non empty
ManySortedSign st InputVertices S1 misses InnerVertices S2 & S = S1+*S2 for A1
  being non-empty Circuit of S1, A2 being non-empty Circuit of S2 for A being
  non-empty Circuit of S st A1 tolerates A2 & A = A1+*A2 for s being State of A
  for s1 being State of A1 st s1 = s|the carrier of S1 & s1 is stable for s2
  being State of A2 st s2 = s|the carrier of S2 holds (Following s)|the carrier
  of S2 = Following s2;

theorem 
  for S1,S2,S being non void Circuit-like non empty ManySortedSign st
S = S1+*S2 for A1 being non-empty Circuit of S1, A2 being non-empty Circuit of
  S2 for A being non-empty Circuit of S st A1 tolerates A2 & A = A1+*A2 for s
  being State of A for s1 being State of A1 st s1 = s|the carrier of S1 & s1 is
  stable for s2 being State of A2 st s2 = s|the carrier of S2 & s2 is stable
  holds s is stable;

theorem 
  for S1,S2,S being non void Circuit-like non empty
  ManySortedSign st S = S1+*S2 for A1 being non-empty Circuit of S1, A2 being
non-empty Circuit of S2 for A being non-empty Circuit of S st A1 tolerates A2 &
  A = A1+*A2 for s being State of A st s is stable holds (for s1 being State of
A1 st s1 = s|the carrier of S1 holds s1 is stable) & (for s2 being State of A2
  st s2 = s|the carrier of S2 holds s2 is stable);

theorem 
  for S1,S2,S being non void Circuit-like non empty
ManySortedSign st InputVertices S1 misses InnerVertices S2 & S = S1+*S2 for A1
  being non-empty Circuit of S1, A2 being non-empty Circuit of S2 for A being
non-empty Circuit of S st A1 tolerates A2 & A = A1+*A2 for s1 being State of A1
, s2 being State of A2, s being State of A st s1 = s|the carrier of S1 & s2 = s
  |the carrier of S2 & s1 is stable for n being Nat holds Following(s, n)|the
  carrier of S2 = Following(s2, n);

theorem 
  for S1,S2,S being non void Circuit-like non empty
ManySortedSign st InputVertices S1 misses InnerVertices S2 & S = S1+*S2 for A1
  being non-empty Circuit of S1, A2 being non-empty Circuit of S2 for A being
non-empty Circuit of S st A1 tolerates A2 & A = A1+*A2 for n1,n2 being Nat for
s being State of A for s1 being State of A1, s2 being State of A2 st s1 = s|the
carrier of S1 & Following(s1, n1) is stable & s2 = Following(s, n1)|the carrier
  of S2 & Following(s2, n2) is stable holds Following(s, n1+n2) is stable;

theorem 
  for S1,S2,S being non void Circuit-like non empty
ManySortedSign st InputVertices S1 misses InnerVertices S2 & S = S1+*S2 for A1
  being non-empty Circuit of S1, A2 being non-empty Circuit of S2 for A being
non-empty Circuit of S st A1 tolerates A2 & A = A1+*A2 for n1,n2 being Nat st (
for s being State of A1 holds Following(s, n1) is stable) & (for s being State
of A2 holds Following(s, n2) is stable) for s being State of A holds Following(
  s, n1+n2) is stable;

theorem 
  for S1,S2,S being non void Circuit-like non empty
ManySortedSign st InputVertices S1 misses InnerVertices S2 & InputVertices S2
  misses InnerVertices S1 & S = S1+*S2 for A1 being non-empty Circuit of S1, A2
  being non-empty Circuit of S2 for A being non-empty Circuit of S st A1
tolerates A2 & A = A1+*A2 for s being State of A for s1 being State of A1 st s1
= s|the carrier of S1 for s2 being State of A2 st s2 = s|the carrier of S2 for
  n being Nat holds Following(s, n) = Following(s1, n)+*Following(s2, n);

theorem 
  for S1,S2,S being non void Circuit-like non empty
ManySortedSign st InputVertices S1 misses InnerVertices S2 & InputVertices S2
  misses InnerVertices S1 & S = S1+*S2 for A1 being non-empty Circuit of S1, A2
  being non-empty Circuit of S2 for A being non-empty Circuit of S st A1
tolerates A2 & A = A1+*A2 for n1,n2 being Nat, s being State of A for s1 being
State of A1 st s1 = s|the carrier of S1 for s2 being State of A2 st s2 = s|the
carrier of S2 & Following(s1, n1) is stable & Following(s2, n2) is stable holds
  Following(s, max(n1,n2)) is stable;

theorem 
  for S1,S2,S being non void Circuit-like non empty ManySortedSign st
  InputVertices S1 misses InnerVertices S2 & InputVertices S2 misses
  InnerVertices S1 & S = S1+*S2 for A1 being non-empty Circuit of S1, A2 being
non-empty Circuit of S2 for A being non-empty Circuit of S st A1 tolerates A2 &
A = A1+*A2 for n being Nat, s being State of A for s1 being State of A1 st s1 =
  s|the carrier of S1 for s2 being State of A2 st s2 = s|the carrier of S2 & (
  Following(s1, n) is not stable or Following(s2, n) is not stable) holds
  Following(s, n) is not stable;

theorem 
  for S1,S2,S being non void Circuit-like non empty ManySortedSign st
  InputVertices S1 misses InnerVertices S2 & InputVertices S2 misses
  InnerVertices S1 & S = S1+*S2 for A1 being non-empty Circuit of S1, A2 being
non-empty Circuit of S2 for A being non-empty Circuit of S st A1 tolerates A2 &
  A = A1+*A2 for n1,n2 being Nat st (for s being State of A1 holds Following(s,
n1) is stable) & (for s being State of A2 holds Following(s, n2) is stable) for
  s being State of A holds Following(s, max(n1,n2)) is stable;

scheme 

  CIRCCMB29sch22 {S0, Sn() -> unsplit gate`1=arity gate`2isBoolean non void
  strict non empty ManySortedSign, A0() -> Boolean gate`2=den strict Circuit of
S0(), An() -> Boolean gate`2=den strict Circuit of Sn(), S(set,set) -> unsplit
  gate`1=arity gate`2isBoolean non void strict non empty ManySortedSign, A(set,
set) -> set, h() -> ManySortedSet of NAT, o0()-> set, o(set,set) -> set, n(Nat)
-> Nat}: for s being State of An() holds Following(s, n(0)+n(2)*n(1)) is stable
provided
 for x being set, n being Nat holds A(x,n) is Boolean gate`2=den
strict Circuit of S(x,n) and
 for s being State of A0() holds Following(s, n(0)) is stable and
 for n being Nat, x being set for A being non-empty Circuit of S(x,n)
st x = h().(n) & A = A(x,n) for s being State of A holds Following(s, n(1)) is
stable and
 ex f,g being ManySortedSet of NAT st Sn() = f.n(2) & An() = g.n(2) &
f.0 = S0() & g.0 = A0() & h().0 = o0() & for n being Nat, S being non empty
ManySortedSign, A1 being non-empty MSAlgebra over S for x being set, A2 being
non-empty MSAlgebra over S(x,n) st S = f.n & A1 = g.n & x = h().n & A2 = A(x,n)
holds f.(n+1) = S +* S(x,n) & g.(n+1) = A1 +* A2 & h().(n+1) = o(x,n) and
 InnerVertices S0() is Relation & InputVertices S0() is without_pairs and
 h().0 = o0() & o0() in InnerVertices S0() and
 for n being Nat, x being set holds InnerVertices S(x,n) is Relation and
 for n being Nat, x being set st x = h().(n) holds (InputVertices S(x
,n)) \ {x} is without_pairs and
 for n being Nat, x being set st x = h().(n) holds h().(n+1) = o(x,n)
& x in InputVertices S(x,n) & o(x,n) in InnerVertices S(x,n);














begin 

theorem 
  for S being non void Circuit-like non empty ManySortedSign for
  A being non-empty Circuit of S for s being State of A, x being set st x in
  InputVertices S for n being Element of NAT holds Following(s,n).x = s.x;

definition
  let S be non void Circuit-like non empty ManySortedSign;
  let A be non-empty Circuit of S;
  let s be State of A;
  attr s is stabilizing means


  ex n being Element of NAT st Following(s, n) is stable;
end;

definition
  let S be non void Circuit-like non empty ManySortedSign;
  let A be non-empty Circuit of S;
  attr A is stabilizing means


  for s being State of A holds s is stabilizing;
  attr A is with_stabilization-limit means

  ex n being Element of NAT st for s
  being State of A holds Following(s,n) is stable;
end;

registration
  let S be non void Circuit-like non empty ManySortedSign;
  cluster with_stabilization-limit -> stabilizing for non-empty Circuit of S;
end;

definition
  let S be non void Circuit-like non empty ManySortedSign;
  let A be non-empty Circuit of S;
  let s be State of A such that
 s is stabilizing;
  func Result s -> State of A means


  it is stable & ex n being Element of NAT st it = Following(s,n);
end;

definition
  let S be non void Circuit-like non empty ManySortedSign;
  let A be non-empty Circuit of S;
  let s be State of A such that
 s is stabilizing;
  func stabilization-time s -> Element of NAT means


  Following(s,it) is
  stable & for n being Element of NAT st n < it holds not Following(s,n) is
  stable;
end;

theorem 
  for S being non void Circuit-like non empty ManySortedSign for
A being non-empty Circuit of S for s being State of A st s is stabilizing holds
  Result s = Following(s,stabilization-time s);

theorem 
  for S being non void Circuit-like non empty ManySortedSign for A
being non-empty Circuit of S for s being State of A, n being Element of NAT st
  Following(s,n) is stable holds stabilization-time s <= n;

theorem 
  for S being non void Circuit-like non empty ManySortedSign for
  A being non-empty Circuit of S for s being State of A, n being Element of NAT
  st Following(s,n) is stable holds Result s = Following(s, n);

theorem 
  for S being non void Circuit-like non empty ManySortedSign for
  A being non-empty Circuit of S for s being State of A, n being Element of NAT
st s is stabilizing & n >= stabilization-time s holds Result s = Following(s, n
  );

theorem 
  for S being non void Circuit-like non empty ManySortedSign for A
  being non-empty Circuit of S for s being State of A st s is stabilizing for x
  being set st x in InputVertices S holds (Result s).x = s.x;

theorem 
  for S1,S2 being non void Circuit-like non empty ManySortedSign
  st InputVertices S1 misses InnerVertices S2 & InputVertices S2 misses
  InnerVertices S1 for S being non void Circuit-like non empty ManySortedSign
  st S=S1 +* S2 for A1 being non-empty Circuit of S1 for A2 being non-empty
  Circuit of S2 st A1 tolerates A2 for A being non-empty Circuit of S st A = A1
+* A2 for s being State of A for s1 being State of A1 for s2 being State of A2
st s1=s|the carrier of S1 & s2=s|the carrier of S2 & s1 is stabilizing & s2 is
  stabilizing holds s is stabilizing;

theorem 
  for S1,S2 being non void Circuit-like non empty ManySortedSign st
  InputVertices S1 misses InnerVertices S2 & InputVertices S2 misses
  InnerVertices S1 for S being non void Circuit-like non empty ManySortedSign
  st S=S1 +* S2 for A1 being non-empty Circuit of S1 for A2 being non-empty
  Circuit of S2 st A1 tolerates A2 for A being non-empty Circuit of S st A = A1
+* A2 for s being State of A for s1 being State of A1 st s1=s|the carrier of S1
& s1 is stabilizing for s2 being State of A2 st s2=s|the carrier of S2 & s2 is
  stabilizing holds stabilization-time(s) = max (stabilization-time s1,
  stabilization-time s2);

theorem 
  for S1,S2 being non void Circuit-like non empty ManySortedSign
st InputVertices S1 misses InnerVertices S2 for S being non void Circuit-like
  non empty ManySortedSign st S=S1 +* S2 for A1 being non-empty Circuit of S1
  for A2 being non-empty Circuit of S2 st A1 tolerates A2 for A being non-empty
Circuit of S st A = A1 +* A2 for s being State of A for s1 being State of A1 st
  s1 = s|the carrier of S1 & s1 is stabilizing for s2 being State of A2 st s2 =
Following(s, stabilization-time s1)|the carrier of S2 & s2 is stabilizing holds
  s is stabilizing;

theorem 
  for S1,S2 being non void Circuit-like non empty ManySortedSign
st InputVertices S1 misses InnerVertices S2 for S being non void Circuit-like
  non empty ManySortedSign st S = S1+*S2 for A1 being non-empty Circuit of S1
  for A2 being non-empty Circuit of S2 st A1 tolerates A2 for A being non-empty
Circuit of S st A = A1 +* A2 for s being State of A for s1 being State of A1 st
  s1 = s|the carrier of S1 & s1 is stabilizing for s2 being State of A2 st s2 =
Following(s, stabilization-time s1)|the carrier of S2 & s2 is stabilizing holds
  stabilization-time(s) = (stabilization-time s1)+(stabilization-time s2);

theorem 
  for S1,S2,S being non void Circuit-like non empty ManySortedSign st
  InputVertices S1 misses InnerVertices S2 & S = S1+*S2 for A1 being non-empty
  Circuit of S1, A2 being non-empty Circuit of S2 for A being non-empty Circuit
of S st A1 tolerates A2 & A = A1+*A2 for s being State of A, s1 be State of A1
st s1 = s|the carrier of S1 & s1 is stabilizing for s2 being State of A2 st s2
  = Following(s, stabilization-time s1)|the carrier of S2 & s2 is stabilizing
  holds (Result s)|the carrier of S1 = Result s1;

begin 

theorem 
  for x being set, X being non empty finite set for n being
Element of NAT for p being FinSeqLen of n for g being Function of n-tuples_on X
, X for s being State of 1GateCircuit(p,g) holds s*p is Element of n-tuples_on
  X;

theorem 
  for x1,x2,x3,x4 being set holds rng <*x1,x2,x3,x4*> = {x1,x2,x3, x4};

theorem 
  for x1,x2,x3,x4,x5 being set holds rng <*x1,x2,x3,x4,x5*> = {x1, x2,x3,x4,x5}
;

definition
  let S be ManySortedSign;
  attr S is one-gate means


  ex X being non empty finite set, n being
Element of NAT, p being FinSeqLen of n, f being Function of n-tuples_on X,X st
  S = 1GateCircStr(p,f);
end;

definition
  let S be non empty ManySortedSign;
  let A be MSAlgebra over S;
  attr A is one-gate means


  ex X being non empty finite set, n being
Element of NAT, p being FinSeqLen of n, f being Function of n-tuples_on X,X st
  S = 1GateCircStr(p,f) & A = 1GateCircuit(p,f);
end;

registration
  let p being FinSequence, x be set;
  cluster 1GateCircStr(p,x) -> finite;
end;

registration
  cluster one-gate -> strict non void non empty unsplit gate`1=arity finite
    for ManySortedSign;
end;

registration
  cluster one-gate -> gate`2=den for non empty ManySortedSign;
end;

registration
  let X be non empty finite set, n be Element of NAT, p be FinSeqLen of n, f
  be Function of n-tuples_on X,X;
  cluster 1GateCircStr(p,f) -> one-gate;
end;

registration
  cluster one-gate for ManySortedSign;
end;

registration
  let S be one-gate ManySortedSign;
  cluster one-gate -> strict non-empty for Circuit of S;
end;

registration
  let X be non empty finite set, n be Element of NAT, p be FinSeqLen of n, f
  be Function of n-tuples_on X,X;
  cluster 1GateCircuit(p,f) -> one-gate;
end;

registration
  let S be one-gate ManySortedSign;
  cluster one-gate non-empty for Circuit of S;
end;

definition
  let S be one-gate ManySortedSign;
  func Output S -> Vertex of S equals

  union the carrier' of S;
end;

registration
  let S be one-gate ManySortedSign;
  cluster Output S -> pair;
end;

theorem 
  for S being one-gate ManySortedSign, p being FinSequence, x
  being set st S = 1GateCircStr(p,x) holds Output S = [p,x];

theorem 
  for S being one-gate ManySortedSign holds InnerVertices S = { Output S};

theorem 
  for S being one-gate ManySortedSign for A being one-gate Circuit of S
  for n being Element of NAT for X being finite non empty set for f being
  Function of n-tuples_on X, X, p being FinSeqLen of n st A = 1GateCircuit(p,f)
  holds S = 1GateCircStr(p,f);

theorem 
  for n being Element of NAT for X being finite non empty set for f
being Function of n-tuples_on X, X, p being FinSeqLen of n for s being State of
  1GateCircuit(p,f) holds (Following s).Output 1GateCircStr(p,f) = f.(s*p);

theorem 
  for S being one-gate ManySortedSign for A being one-gate Circuit
  of S for s being State of A holds Following s is stable;

registration
  let S be non void Circuit-like non empty ManySortedSign;
  cluster one-gate -> with_stabilization-limit for non-empty Circuit of S;
end;

theorem 
  for S being one-gate ManySortedSign for A being one-gate Circuit
  of S for s being State of A holds Result s = Following s;

theorem 
  for S being one-gate ManySortedSign for A being one-gate Circuit
  of S for s being State of A holds stabilization-time s <= 1;

scheme 

  OneGate1Ex {x()->set,X()->non empty finite set,f(set)->Element of X()}: ex S
being one-gate ManySortedSign, A being one-gate Circuit of S st InputVertices S
  = {x()} & for s being State of A holds (Result s).(Output S) = f(s.x());

scheme 

  OneGate2Ex {x1,x2()->set,X()->non empty finite set, f(set,set)->Element of X
  ()}: ex S being one-gate ManySortedSign, A being one-gate Circuit of S st
InputVertices S = {x1(),x2()} & for s being State of A holds (Result s).(Output
  S) = f(s.x1(),s.x2());

scheme 

  OneGate3Ex {x1,x2,x3()->set,X()->non empty finite set, f(set,set,set)->
  Element of X()}: ex S being one-gate ManySortedSign, A being one-gate Circuit
  of S st InputVertices S = {x1(),x2(),x3()} & for s being State of A holds (
  Result s).(Output S) = f(s.x1(),s.x2(),s.x3());

scheme 

  OneGate4Ex {x1,x2,x3,x4()->set,X()->non empty finite set, f(set,set,set,set)
->Element of X()}: ex S being one-gate ManySortedSign, A being one-gate Circuit
of S st InputVertices S = {x1(),x2(),x3(),x4()} & for s being State of A holds
  (Result s).(Output S) = f(s.x1(),s.x2(),s.x3(),s.x4());

scheme 

  OneGate5Ex {x1,x2,x3,x4,x5()->set,X()->non empty finite set, f(set,set,set,
set,set)->Element of X()}: ex S being one-gate ManySortedSign, A being one-gate
  Circuit of S st InputVertices S = {x1(),x2(),x3(),x4(),x5()} & for s being
State of A holds (Result s).(Output S) = f(s.x1(),s.x2(),s.x3(),s.x4(),s.x5());

begin 

theorem 
  for X,Y being non empty set, n,m being Element of NAT st n<>0 &
  n-tuples_on X = m-tuples_on Y holds X=Y & n=m;

theorem 
  for S1,S2 being non empty ManySortedSign for v being Vertex of S1
  holds v is Vertex of S1+*S2;

theorem 
  for S1,S2 being non empty ManySortedSign for v being Vertex of S2
  holds v is Vertex of S1+*S2;

definition
  let X be non empty finite set;
  mode Signature of X -> gate`2=den non void non empty unsplit gate`1=arity
    ManySortedSign means


    ex A being Circuit of it st the Sorts of A is
    constant & the_value_of the Sorts of A = X & A is gate`2=den;
end;

theorem 
  for n being Element of NAT, X being non empty finite set for f
  being Function of n-tuples_on X, X for p being FinSeqLen of n holds
  1GateCircStr(p,f) is Signature of X;

registration
  let X be non empty finite set;
  cluster strict one-gate for Signature of X;
end;

definition
  let n be Element of NAT;
  let X be non empty finite set;
  let f be Function of n-tuples_on X, X;
  let p be FinSeqLen of n;
  redefine func 1GateCircStr(p,f) -> strict Signature of X;
end;

definition
  let X be non empty finite set;
  let S be Signature of X;
  mode Circuit of X,S -> Circuit of S means


    it is gate`2=den & the
    Sorts of it is constant & the_value_of the Sorts of it = X;
end;

registration
  let X be non empty finite set;
  let S be Signature of X;
  cluster -> gate`2=den non-empty for Circuit of X,S;
end;

theorem 
  for n being Element of NAT, X being non empty finite set for f
  being Function of n-tuples_on X, X for p being FinSeqLen of n holds
  1GateCircuit(p,f) is Circuit of X, 1GateCircStr(p,f);

registration
  let X be non empty finite set;
  let S be one-gate Signature of X;
  cluster strict one-gate for Circuit of X,S;
end;

registration
  let X be non empty finite set;
  let S be Signature of X;
  cluster strict for Circuit of X,S;
end;

definition
  let n be Element of NAT;
  let X be non empty finite set;
  let f be Function of n-tuples_on X, X;
  let p be FinSeqLen of n;
  redefine func 1GateCircuit(p,f) -> strict Circuit of X,1GateCircStr(p,f);
end;

theorem 
  for X being non empty finite set for S1, S2 being Signature of X
for A1 being Circuit of X,S1 for A2 being Circuit of X,S2 holds A1 tolerates A2
;

theorem 
  for X being non empty finite set for S1, S2 being Signature of X
  for A1 being Circuit of X,S1 for A2 being Circuit of X,S2 holds A1+*A2 is
  Circuit of S1+*S2;

theorem 
  for X being non empty finite set for S1, S2 being Signature of X
  for A1 being Circuit of X,S1 for A2 being Circuit of X,S2 holds A1+*A2 is
  gate`2=den;

theorem 
  for X being non empty finite set for S1, S2 being Signature of X
for A1 being Circuit of X,S1 for A2 being Circuit of X,S2 holds the Sorts of A1
  +*A2 is constant & the_value_of the Sorts of A1+*A2 = X;

registration
  let S1,S2 be finite non empty ManySortedSign;
  cluster S1+*S2 -> finite;
end;

registration
  let X be non empty finite set;
  let S1,S2 be Signature of X;
  cluster S1+*S2 -> gate`2=den;
end;

definition
  let X be non empty finite set;
  let S1,S2 be Signature of X;
  redefine func S1+*S2 -> strict Signature of X;
end;

definition
  let X be non empty finite set;
  let S1,S2 be Signature of X;
  let A1 be Circuit of X,S1;
  let A2 be Circuit of X,S2;
  redefine func A1+*A2 -> strict Circuit of X,S1+*S2;
end;

theorem 
  for x,y being set holds the_rank_of x in the_rank_of [x,y] &
  the_rank_of y in the_rank_of [x,y];

theorem 
  for S being gate`2=den finite non void non empty unsplit
  gate`1=arity ManySortedSign for A being non-empty Circuit of S st A is
  gate`2=den holds A is with_stabilization-limit;

registration
  let X be non empty finite set;
  let S be finite Signature of X;
  cluster -> with_stabilization-limit for Circuit of X,S;
end;

scheme 

  1AryDef {X()-> non empty set,F(set) -> Element of X()}: (ex f being Function
  of 1-tuples_on X(), X() st for x being Element of X() holds f.<*x*> = F(x)) &
for f1,f2 being Function of 1-tuples_on X(), X() st (for x being Element of X()
  holds f1.<*x*> = F(x)) & (for x being Element of X() holds f2.<*x*> = F(x))
  holds f1 = f2;

scheme 

  2AryDef {X()-> non empty set,F(set,set) -> Element of X()}: (ex f being
Function of 2-tuples_on X(), X() st for x,y being Element of X() holds f.<*x,y
  *> = F(x,y)) & for f1,f2 being Function of 2-tuples_on X(), X() st (for x,y
being Element of X() holds f1.<*x,y*> = F(x,y)) & (for x,y being Element of X()
  holds f2.<*x,y*> = F(x,y)) holds f1 = f2;

scheme 

  3AryDef {X()-> non empty set,F(set,set,set) -> Element of X()}: (ex f being
Function of 3-tuples_on X(), X() st for x,y,z being Element of X() holds f.<*x,
y,z*> = F(x,y,z)) & for f1,f2 being Function of 3-tuples_on X(), X() st (for x,
  y,z being Element of X() holds f1.<*x,y,z*> = F(x,y,z)) & (for x,y,z being
  Element of X() holds f2.<*x,y,z*> = F(x,y,z)) holds f1 = f2;

theorem 
  for f being Function for x1,x2,x3,x4 being set st
  x1 in dom f & x2 in dom f & x3 in dom f & x4 in dom f holds
  f*<*x1,x2,x3,x4*> = <*f.x1,f.x2,f.x3,f.x4*>;

theorem 
  for f being Function for x1,x2,x3,x4,x5 being set st x1 in dom f
& x2 in dom f & x3 in dom f & x4 in dom f & x5 in dom f holds f*<*x1,x2,x3,x4,
  x5*> = <*f.x1,f.x2,f.x3,f.x4,f.x5*>;

scheme 

  OneGate1Result {x1()-> set, B()-> non empty finite set, F(set)->Element of B
(), f() -> Function of 1-tuples_on B(), B()}: for s being State of 1GateCircuit
  (<*x1()*>,f()) for a1 being Element of B() st a1 = s.x1() holds (Result s).
  Output(1GateCircStr(<*x1()*>,f())) = F(a1)
provided
 for g being Function of 1-tuples_on B(), B() holds g = f() iff for
a1 being Element of B() holds g.<*a1*> = F(a1);

scheme 

  OneGate2Result {x1,x2()-> set, B()-> non empty finite set, F(set,set)->
Element of B(), f() -> Function of 2-tuples_on B(), B()}: for s being State of
1GateCircuit(<*x1(),x2()*>,f()) for a1, a2 being Element of B() st a1 = s.x1()
& a2 = s.x2() holds (Result s).Output(1GateCircStr(<*x1(),x2()*>,f())) = F(a1,
  a2)
provided
 for g being Function of 2-tuples_on B(), B() holds g = f() iff for
a1,a2 being Element of B() holds g.<*a1,a2*> = F(a1,a2);

scheme 

  OneGate3Result {x1,x2,x3()-> set, B()-> non empty finite set, F(set,set,set)
  ->Element of B(), f() -> Function of 3-tuples_on B(), B()}: for s being State
of 1GateCircuit(<*x1(),x2(),x3()*>,f()) for a1, a2, a3 being Element of B() st
a1 = s.x1() & a2 = s.x2() & a3 = s.x3() holds (Result s).Output(1GateCircStr(<*
  x1(),x2(),x3()*>,f())) = F(a1,a2,a3)
provided
 for g being Function of 3-tuples_on B(), B() holds g = f() iff for
a1,a2,a3 being Element of B() holds g.<*a1,a2,a3*> = F(a1,a2,a3);

scheme 

  OneGate4Result {x1,x2,x3,x4()-> set, B()-> non empty finite set, F(set,set,
set,set)->Element of B(), f() -> Function of 4-tuples_on B(), B()}: for s being
  State of 1GateCircuit(<*x1(),x2(),x3(),x4()*>,f()) for a1, a2, a3, a4 being
Element of B() st a1 = s.x1() & a2 = s.x2() & a3 = s.x3() & a4 = s.x4() holds (
  Result s).Output(1GateCircStr(<*x1(),x2(),x3(),x4()*>,f())) = F(a1,a2,a3,a4)
provided
 for g being Function of 4-tuples_on B(), B() holds g = f() iff for
a1,a2,a3,a4 being Element of B() holds g.<*a1,a2,a3,a4*> = F(a1,a2,a3,a4);

scheme 

  OneGate5Result {x1,x2,x3,x4,x5()-> set, B()-> non empty finite set, F(set,
set,set,set,set)->Element of B(), f() -> Function of 5-tuples_on B(), B()}: for
s being State of 1GateCircuit(<*x1(),x2(),x3(),x4(),x5()*>,f()) for a1, a2, a3,
a4, a5 being Element of B() st a1 = s.x1() & a2 = s.x2() & a3 = s.x3() & a4 = s
.x4() & a5 = s.x5() holds (Result s).Output(1GateCircStr(<*x1(),x2(),x3(),x4(),
  x5()*>,f())) = F(a1,a2,a3,a4,a5)
provided
 for g being Function of 5-tuples_on B(), B() holds g = f() iff for
a1,a2,a3,a4,a5 being Element of B() holds g.<*a1,a2,a3,a4,a5*> = F(a1,a2,a3,a4,
a5);

begin 

theorem 
  for n being Element of NAT, X being non empty finite set for f
  being Function of n-tuples_on X, X for p being FinSeqLen of n for S being
  Signature of X st rng p c= the carrier of S & not Output 1GateCircStr(p,f) in
InputVertices S holds InputVertices (S +* 1GateCircStr(p,f)) = InputVertices S;

theorem 
  for X1,X2 being set, X being non empty finite set, n be Element
of NAT for f being Function of n-tuples_on X, X for p being FinSeqLen of n for
S being Signature of X st rng p = X1 \/ X2 & X1 c= the carrier of S & X2 misses
  InnerVertices S & not Output 1GateCircStr(p,f) in InputVertices S holds
  InputVertices (S +* 1GateCircStr(p,f)) = (InputVertices S) \/ X2;

theorem 
  for x1 being set, X being non empty finite set for f being
Function of 1-tuples_on X, X for S being Signature of X st x1 in the carrier of
S & not Output 1GateCircStr(<*x1*>,f) in InputVertices S holds InputVertices (S
  +* 1GateCircStr(<*x1*>,f)) = InputVertices S;

theorem 
  for x1,x2 being set, X being non empty finite set for f being
Function of 2-tuples_on X, X for S being Signature of X st x1 in the carrier of
  S & not x2 in InnerVertices S & not Output 1GateCircStr(<*x1,x2*>,f) in
  InputVertices S holds InputVertices (S +* 1GateCircStr(<*x1,x2*>,f)) = (
  InputVertices S) \/ {x2};

theorem 
  for x1,x2 being set, X being non empty finite set for f being
Function of 2-tuples_on X, X for S being Signature of X st x2 in the carrier of
  S & not x1 in InnerVertices S & not Output 1GateCircStr(<*x1,x2*>,f) in
  InputVertices S holds InputVertices (S +* 1GateCircStr(<*x1,x2*>,f)) = (
  InputVertices S) \/ {x1};

theorem 
  for x1,x2 being set, X being non empty finite set for f being
Function of 2-tuples_on X, X for S being Signature of X st x1 in the carrier of
  S & x2 in the carrier of S & not Output 1GateCircStr(<*x1,x2*>,f) in
  InputVertices S holds InputVertices (S +* 1GateCircStr(<*x1,x2*>,f)) =
  InputVertices S;

theorem 
  for x1,x2,x3 being set, X being non empty finite set for f being
Function of 3-tuples_on X, X for S being Signature of X st x1 in the carrier of
  S & not x2 in InnerVertices S & not x3 in InnerVertices S & not Output
  1GateCircStr(<*x1,x2,x3*>,f) in InputVertices S holds InputVertices (S +*
  1GateCircStr(<*x1,x2,x3*>,f)) = (InputVertices S) \/ {x2,x3};

theorem 
  for x1,x2,x3 being set, X being non empty finite set for f being
Function of 3-tuples_on X, X for S being Signature of X st x2 in the carrier of
  S & not x1 in InnerVertices S & not x3 in InnerVertices S & not Output
  1GateCircStr(<*x1,x2,x3*>,f) in InputVertices S holds InputVertices (S +*
  1GateCircStr(<*x1,x2,x3*>,f)) = (InputVertices S) \/ {x1,x3};

theorem 
  for x1,x2,x3 being set, X being non empty finite set for f being
Function of 3-tuples_on X, X for S being Signature of X st x3 in the carrier of
  S & not x1 in InnerVertices S & not x2 in InnerVertices S & not Output
  1GateCircStr(<*x1,x2,x3*>,f) in InputVertices S holds InputVertices (S +*
  1GateCircStr(<*x1,x2,x3*>,f)) = (InputVertices S) \/ {x1,x2};

theorem 
  for x1,x2,x3 being set, X being non empty finite set for f being
Function of 3-tuples_on X, X for S being Signature of X st x1 in the carrier of
  S & x2 in the carrier of S & not x3 in InnerVertices S & not Output
  1GateCircStr(<*x1,x2,x3*>,f) in InputVertices S holds InputVertices (S +*
  1GateCircStr(<*x1,x2,x3*>,f)) = (InputVertices S) \/ {x3};

theorem 
  for x1,x2,x3 being set, X being non empty finite set for f being
Function of 3-tuples_on X, X for S being Signature of X st x1 in the carrier of
  S & x3 in the carrier of S & not x2 in InnerVertices S & not Output
  1GateCircStr(<*x1,x2,x3*>,f) in InputVertices S holds InputVertices (S +*
  1GateCircStr(<*x1,x2,x3*>,f)) = (InputVertices S) \/ {x2};

theorem 
  for x1,x2,x3 being set, X being non empty finite set for f being
Function of 3-tuples_on X, X for S being Signature of X st x2 in the carrier of
  S & x3 in the carrier of S & not x1 in InnerVertices S & not Output
  1GateCircStr(<*x1,x2,x3*>,f) in InputVertices S holds InputVertices (S +*
  1GateCircStr(<*x1,x2,x3*>,f)) = (InputVertices S) \/ {x1};

theorem 
  for x1,x2,x3 being set, X being non empty finite set for f being
Function of 3-tuples_on X, X for S being Signature of X st x1 in the carrier of
S & x2 in the carrier of S & x3 in the carrier of S & not Output 1GateCircStr(
<*x1,x2,x3*>,f) in InputVertices S holds InputVertices (S +* 1GateCircStr(<*x1,
  x2,x3*>,f)) = InputVertices S;

begin 

theorem 
  for X being non empty finite set for S being finite Signature of
X for A being Circuit of X,S for n being Element of NAT, f being Function of n
  -tuples_on X, X for p being FinSeqLen of n st not Output 1GateCircStr(p,f) in
InputVertices S for s being State of A +* 1GateCircuit(p,f) for s9 being State
  of A st s9 = s|the carrier of S holds stabilization-time s <= 1+
  stabilization-time s9;

scheme 

  Comb1CircResult {x1()-> set, B()-> non empty finite set, F(set)->Element of
  B(), S() -> finite Signature of B(), C() -> Circuit of B(), S(), f() ->
Function of 1-tuples_on B(), B()}: for s being State of C() +* 1GateCircuit(<*
x1()*>,f()) for s9 being State of C() st s9 = s|the carrier of S() for a1 being
Element of B() st (x1() in InnerVertices S() implies a1 = (Result s9).x1()) & (
  not x1() in InnerVertices S() implies a1 = s.x1()) holds (Result s).Output
  1GateCircStr(<*x1()*>,f()) = F(a1)
provided
 for g being Function of 1-tuples_on B(), B() holds g = f() iff for
a1 being Element of B() holds g.<*a1*> = F(a1) and
 not Output 1GateCircStr(<*x1()*>,f()) in InputVertices S();

scheme 

  Comb2CircResult {x1,x2()-> set, B()-> non empty finite set, F(set,set)->
Element of B(), S() -> finite Signature of B(), C() -> Circuit of B(), S(), f()
-> Function of 2-tuples_on B(), B()}: for s being State of C() +* 1GateCircuit(
  <*x1(),x2()*>,f()) for s9 being State of C() st s9 = s|the carrier of S() for
a1, a2 being Element of B() st (x1() in InnerVertices S() implies a1 = (Result
  s9).x1()) & (not x1() in InnerVertices S() implies a1 = s.x1()) & (x2() in
InnerVertices S() implies a2 = (Result s9).x2()) & (not x2() in InnerVertices S
() implies a2 = s.x2()) holds (Result s).Output(1GateCircStr(<*x1(),x2()*>,f())
  ) = F(a1,a2)
provided
 for g being Function of 2-tuples_on B(), B() holds g = f() iff for
a1,a2 being Element of B() holds g.<*a1,a2*> = F(a1,a2) and
 not Output 1GateCircStr(<*x1(),x2()*>,f()) in InputVertices S();

scheme 

  Comb3CircResult {x1,x2,x3()-> set, B()-> non empty finite set, F(set,set,set
)->Element of B(), S() -> finite Signature of B(), C() -> Circuit of B(), S(),
  f() -> Function of 3-tuples_on B(), B()}: for s being State of C() +*
  1GateCircuit(<*x1(),x2(),x3()*>,f()) for s9 being State of C() st s9 = s|the
carrier of S() for a1, a2, a3 being Element of B() st (x1() in InnerVertices S(
) implies a1 = (Result s9).x1()) & (not x1() in InnerVertices S() implies a1 =
s.x1()) & (x2() in InnerVertices S() implies a2 = (Result s9).x2()) & (not x2()
in InnerVertices S() implies a2 = s.x2()) & (x3() in InnerVertices S() implies
  a3 = (Result s9).x3()) & (not x3() in InnerVertices S() implies a3 = s.x3())
  holds (Result s).Output(1GateCircStr(<*x1(),x2(),x3()*>,f())) = F(a1,a2,a3)
provided
 for g being Function of 3-tuples_on B(), B() holds g = f() iff for
a1,a2,a3 being Element of B() holds g.<*a1,a2,a3*> = F(a1,a2,a3) and
 not Output 1GateCircStr(<*x1(),x2(),x3()*>,f()) in InputVertices S();

scheme 

  Comb4CircResult {x1,x2,x3,x4()-> set, B()-> non empty finite set, F(set,set,
set,set)->Element of B(), S() -> finite Signature of B(), C() -> Circuit of B()
  , S(), f() -> Function of 4-tuples_on B(), B()}: for s being State of C() +*
1GateCircuit(<*x1(),x2(),x3(),x4()*>,f()) for s9 being State of C() st s9 = s|
  the carrier of S() for a1, a2, a3, a4 being Element of B() st (x1() in
InnerVertices S() implies a1 = (Result s9).x1()) & (not x1() in InnerVertices S
() implies a1 = s.x1()) & (x2() in InnerVertices S() implies a2 = (Result s9).
  x2()) & (not x2() in InnerVertices S() implies a2 = s.x2()) & (x3() in
InnerVertices S() implies a3 = (Result s9).x3()) & (not x3() in InnerVertices S
() implies a3 = s.x3()) & (x4() in InnerVertices S() implies a4 = (Result s9).
  x4()) & (not x4() in InnerVertices S() implies a4 = s.x4()) holds (Result s).
  Output(1GateCircStr(<*x1(),x2(),x3(),x4()*>,f())) = F(a1,a2,a3,a4)
provided
 for g being Function of 4-tuples_on B(), B() holds g = f() iff for
a1,a2,a3,a4 being Element of B() holds g.<*a1,a2,a3,a4*> = F(a1,a2,a3,a4) and
 not Output 1GateCircStr(<*x1(),x2(),x3(),x4()*>,f()) in InputVertices S();

scheme 

  Comb5CircResult {x1,x2,x3,x4,x5()-> set, B()-> non empty finite set, F(set,
  set,set,set,set)->Element of B(), S() -> finite Signature of B(), C() ->
  Circuit of B(), S(), f() -> Function of 5-tuples_on B(), B()}: for s being
  State of C() +* 1GateCircuit(<*x1(),x2(),x3(),x4(),x5()*>,f()) for s9 being
State of C() st s9 = s|the carrier of S() for a1, a2, a3, a4, a5 being Element
of B() st (x1() in InnerVertices S() implies a1 = (Result s9).x1()) & (not x1()
in InnerVertices S() implies a1 = s.x1()) & (x2() in InnerVertices S() implies
a2 = (Result s9).x2()) & (not x2() in InnerVertices S() implies a2 = s.x2()) &
  (x3() in InnerVertices S() implies a3 = (Result s9).x3()) & (not x3() in
InnerVertices S() implies a3 = s.x3()) & (x4() in InnerVertices S() implies a4
= (Result s9).x4()) & (not x4() in InnerVertices S() implies a4 = s.x4()) & (x5
  () in InnerVertices S() implies a5 = (Result s9).x5()) & (not x5() in
InnerVertices S() implies a5 = s.x5()) holds (Result s).Output(1GateCircStr(<*
  x1(),x2(),x3(),x4(),x5()*>,f())) = F(a1,a2,a3,a4,a5)
provided
 for g being Function of 5-tuples_on B(), B() holds g = f() iff for
a1,a2,a3,a4,a5 being Element of B() holds g.<*a1,a2,a3,a4,a5*> = F(a1,a2,a3,a4,
a5) and
 not Output 1GateCircStr(<*x1(),x2(),x3(),x4(),x5()*>,f()) in
InputVertices S();

begin 

definition
  let S be non empty ManySortedSign;
  attr S is with_nonpair_inputs means


  InputVertices S is without_pairs;
end;

registration
  cluster NAT -> without_pairs;
  let X be without_pairs set;
  cluster -> without_pairs for Subset of X;
end;

registration
  cluster natural-valued -> nonpair-yielding for Function;
end;

registration
  cluster one-to-one natural-valued for FinSequence;
end;

registration
  let n be Element of NAT;
  cluster one-to-one natural-valued for FinSeqLen of n;
end;

registration
  let p be nonpair-yielding FinSequence;
  let f be set;
  cluster 1GateCircStr(p,f) -> with_nonpair_inputs;
end;

registration
  cluster with_nonpair_inputs for one-gate ManySortedSign;
  let X be non empty finite set;
  cluster with_nonpair_inputs for one-gate Signature of X;
end;

registration
  let S be with_nonpair_inputs non empty ManySortedSign;
  cluster InputVertices S -> without_pairs;
end;

theorem 
  for S being with_nonpair_inputs non empty ManySortedSign for x being
  Vertex of S st x is pair holds x in InnerVertices S;

registration
  let S be unsplit gate`1=arity non empty ManySortedSign;
  cluster InnerVertices S -> Relation-like;
end;

registration
  let S be unsplit gate`2=den non empty non void ManySortedSign;
  cluster InnerVertices S -> Relation-like;
end;

registration
  let S1,S2 be with_nonpair_inputs unsplit gate`1=arity non empty
  ManySortedSign;
  cluster S1+*S2 -> with_nonpair_inputs;
end;

theorem 
  for x being non pair set, R being Relation holds not x in R;

theorem 
  for x1 being set, X being non empty finite set for f being
Function of 1-tuples_on X, X for S being with_nonpair_inputs Signature of X st
x1 in the carrier of S or x1 is non pair holds S +* 1GateCircStr(<*x1*>, f) is
  with_nonpair_inputs;

registration
  let X be non empty finite set;
  let S be with_nonpair_inputs Signature of X;
  let x1 be Vertex of S;
  let f be Function of 1-tuples_on X, X;
  cluster S +* 1GateCircStr(<*x1*>, f) -> with_nonpair_inputs;
end;

registration
  let X be non empty finite set;
  let S be with_nonpair_inputs Signature of X;
  let x1 be non pair set;
  let f be Function of 1-tuples_on X, X;
  cluster S +* 1GateCircStr(<*x1*>, f) -> with_nonpair_inputs;
end;

theorem 
  for x1,x2 being set, X being non empty finite set for f being
Function of 2-tuples_on X, X for S being with_nonpair_inputs Signature of X st
  (x1 in the carrier of S or x1 is non pair) & (x2 in the carrier of S or x2 is
  non pair) holds S +* 1GateCircStr(<*x1,x2*>, f) is with_nonpair_inputs;

registration
  let X be non empty finite set;
  let S be with_nonpair_inputs Signature of X;
  let x1 be Vertex of S, n2 be non pair set;
  let f be Function of 2-tuples_on X, X;
  cluster S +* 1GateCircStr(<*x1,n2*>, f) -> with_nonpair_inputs;
  cluster S +* 1GateCircStr(<*n2,x1*>, f) -> with_nonpair_inputs;
end;

registration
  let X be non empty finite set;
  let S be with_nonpair_inputs Signature of X;
  let x1,x2 be Vertex of S;
  let f be Function of 2-tuples_on X, X;
  cluster S +* 1GateCircStr(<*x1,x2*>, f) -> with_nonpair_inputs;
end;

theorem 
  for x1,x2,x3 being set, X being non empty finite set for f being
Function of 3-tuples_on X, X for S being with_nonpair_inputs Signature of X st
  (x1 in the carrier of S or x1 is non pair) & (x2 in the carrier of S or x2 is
non pair) & (x3 in the carrier of S or x3 is non pair) holds S +* 1GateCircStr(
  <*x1,x2,x3*>, f) is with_nonpair_inputs;

registration
  let X be non empty finite set;
  let S be with_nonpair_inputs Signature of X;
  let x1,x2 be Vertex of S, n be non pair set;
  let f be Function of 3-tuples_on X, X;
  cluster S +* 1GateCircStr(<*x1,x2,n*>, f) -> with_nonpair_inputs;
  cluster S +* 1GateCircStr(<*x1,n,x2*>, f) -> with_nonpair_inputs;
  cluster S +* 1GateCircStr(<*n,x1,x2*>, f) -> with_nonpair_inputs;
end;

registration
  let X be non empty finite set;
  let S be with_nonpair_inputs Signature of X;
  let x be Vertex of S, n1,n2 be non pair set;
  let f be Function of 3-tuples_on X, X;
  cluster S +* 1GateCircStr(<*x,n1,n2*>, f) -> with_nonpair_inputs;
  cluster S +* 1GateCircStr(<*n1,x,n2*>, f) -> with_nonpair_inputs;
  cluster S +* 1GateCircStr(<*n1,n2,x*>, f) -> with_nonpair_inputs;
end;

registration
  let X be non empty finite set;
  let S be with_nonpair_inputs Signature of X;
  let x1,x2,x3 be Vertex of S;
  let f be Function of 3-tuples_on X, X;
  cluster S +* 1GateCircStr(<*x1,x2,x3*>, f) -> with_nonpair_inputs;
end;














begin 

reserve i, j, k, c, m, n for Element of NAT,
  a, x, y, z, X, Y for set,
  D, E for non empty set,
  R for Relation,
  f, g for Function,
  p, q for FinSequence;

theorem 
  <*x,y*>+*(1,z) = <*z,y*> & <*x,y*>+*(2,z) = <*x,z*>;

theorem 
  f+*(a,x) = g+*(a,y) implies f+*(a,z) = g+*(a,z);

theorem 
  Del(p+*(i,x),i) = Del(p,i);

theorem 
  p+*(i,a) = q+*(i,a) implies Del(p,i) = Del(q,i);

theorem 
  0-tuples_on X = {{}};

theorem 
  n <> 0 implies n-tuples_on {} = {};

theorem 
  {} in rng f implies <:f:> = {};

theorem 
  rng f = D implies rng <:<*f*>:> = 1-tuples_on D;

theorem 
  1 <= i & i <= n+1 implies for p being Element of (n+1)-tuples_on
  D holds Del(p,i) in n-tuples_on D;

theorem 
  for X being set, Y being FinSequenceSet of X holds Y c= X*;

begin 

definition
  let X be set;
  attr X is compatible means


  for f,g being Function st f in X & g in X holds f tolerates g;
end;

registration
  cluster non empty functional compatible for set;
end;

registration
  let X be functional compatible set;
  cluster union X -> Function-like Relation-like;
end;

theorem 
  X is functional compatible iff union X is Function;

registration
  let X,Y be set;
  cluster non empty compatible for PFUNC_DOMAIN of X,Y;
end;

theorem 
  for X being non empty functional compatible set holds dom union
  X = union {dom f where f is Element of X: not contradiction};

theorem 
  for X being functional compatible set, f being Function st f in
X holds dom f c= dom union X & for x being set st x in dom f holds (union X).x
  = f.x;

theorem 
  for X being non empty functional compatible set holds rng union
  X = union {rng f where f is Element of X: not contradiction};

registration
  let X,Y;
  cluster -> functional for PFUNC_DOMAIN of X,Y;
end;

theorem 
  for P being compatible PFUNC_DOMAIN of X,Y holds union P is PartFunc of X,Y;

begin 

notation
  let f be Relation;
  synonym f is to-naturals for f is natural-valued;
end;

registration
  cluster NAT*-defined to-naturals for Function;
end;

definition

  let f be NAT*-defined Relation;
  attr f is len-total means


  for x,y being FinSequence of NAT st len x = len y & x in dom f holds
  y in dom f;
end;

theorem 
  dom R c= n-tuples_on D implies R is homogeneous;

registration
  cluster empty -> homogeneous for Relation;
end;

registration
  let p be FinSequence, x be set;
  cluster p .--> x -> non empty homogeneous;
end;

registration
  cluster non empty homogeneous for Function;
end;

registration
  let f be homogeneous Function, g be Function;
  cluster g*f -> homogeneous;
end;

registration
  let X,Y be set;
  cluster homogeneous for PartFunc of X*, Y;
end;

registration
  let X,Y be non empty set;
  cluster non empty homogeneous for PartFunc of X*, Y;
end;

registration
  let X be non empty set;
  cluster non empty homogeneous quasi_total for PartFunc of X*, X;
end;

registration
  cluster non empty homogeneous to-naturals len-total for
NAT*-defined Function;
end;

registration
  cluster -> to-naturals NAT*-defined for PartFunc of NAT*, NAT;
end;

registration
  cluster quasi_total -> len-total for PartFunc of NAT*,NAT;
end;

theorem 
  for g being len-total to-naturals NAT*-defined Function holds
  g is quasi_total PartFunc of NAT*, NAT;

theorem 
  arity {} = 0;

theorem 
  for f being homogeneous Relation st dom f = {{}} holds arity f = 0;

theorem 
  for f being homogeneous PartFunc of X*, Y holds dom f c= (arity
  f)-tuples_on X;

theorem 
  for f being homogeneous NAT*-defined Function holds dom f c= (
  arity f)-tuples_on NAT;

theorem 
  for f being homogeneous PartFunc of X*, X holds f is quasi_total
  non empty iff dom f = (arity f)-tuples_on X;

theorem 
  for f being homogeneous to-naturals NAT*-defined Function holds
  f is len-total non empty iff dom f = (arity f)-tuples_on NAT;

theorem 
  for f being non empty homogeneous PartFunc of D*, D, n st dom f c= n
  -tuples_on D holds arity f = n;

theorem 
  for f being homogeneous PartFunc of D*, D, n st dom f = n
  -tuples_on D holds arity f = n;

definition
  let R be Relation;

  attr R is with_the_same_arity means


  for f,g being Function st f in
  rng R & g in rng R holds (f is empty implies g is empty or dom g = {{}}) & (f
  is non empty & g is non empty implies ex n being Element of NAT, X being non
  empty set st dom f c= n-tuples_on X & dom g c= n-tuples_on X);
end;

registration
  cluster empty -> with_the_same_arity for Relation;
end;

registration
  let X be set;
  cluster with_the_same_arity for FinSequence of X;
  cluster with_the_same_arity for Element of X*;
end;

definition
  let F be with_the_same_arity Relation;
  func arity F -> Element of NAT means


  for f being homogeneous Function st f in rng F holds it = arity f
  if ex f being homogeneous Function st f in rng F
  otherwise it = 0;
end;

theorem 
  for F be with_the_same_arity FinSequence st len F = 0 holds arity F = 0;

definition
  let X be set;
  func HFuncs X -> PFUNC_DOMAIN of X*, X equals

  {f where f is Element of PFuncs(X*, X): f is homogeneous};
end;

theorem 
  {} in HFuncs X;

registration
  let X be non empty set;
  cluster non empty homogeneous quasi_total for Element of HFuncs X;
end;

registration
  let X be set;
  cluster -> homogeneous for Element of HFuncs X;
end;

registration
  let X be non empty set, S be non empty Subset of HFuncs X;
  cluster -> homogeneous for Element of S;
end;

theorem 
  for f being to-naturals homogeneous NAT*-defined Function holds
  f is Element of HFuncs NAT;

theorem 
  for f being len-total to-naturals homogeneous NAT*-defined
  Function holds f is quasi_total Element of HFuncs NAT;

theorem 
  for X being non empty set, F being Relation st rng F c= HFuncs X
& for f,g being homogeneous Function st f in rng F & g in rng F holds arity f =
  arity g holds F is with_the_same_arity;

definition
  let n, m be Element of NAT;
  func n const m -> homogeneous to-naturals NAT*-defined Function equals

  (n-tuples_on NAT) --> m;
end;

theorem 
  n const m in HFuncs NAT;

registration
  let n,m be Element of NAT;
  cluster n const m -> len-total non empty;
end;

theorem 
  arity (n const m) = n;

registration
  cluster -> homogeneous to-naturals NAT*-defined for Element of HFuncs NAT;
end;

definition
  let n,i be Element of NAT;
  func n succ i -> homogeneous to-naturals NAT*-defined Function means


  dom it = n-tuples_on NAT & for p being Element of n-tuples_on NAT holds it.p
  = (p/.i)+1;
end;

theorem 
  n succ i in HFuncs NAT;

registration
  let n,i be Element of NAT;
  cluster n succ i -> len-total non empty;
end;

theorem 
  arity (n succ i) = n;

definition
  let n,i be Element of NAT;
  func n proj i -> homogeneous to-naturals NAT*-defined Function equals

  proj(n|->NAT, i);
end;

theorem 
  n proj i in HFuncs NAT;

theorem 
  dom (n proj i) = n-tuples_on NAT & (1 <= i & i <= n implies rng
  (n proj i) = NAT);

registration
  let n,i be Element of NAT;
  cluster n proj i -> len-total non empty;
end;

theorem 
  arity (n proj i) = n;

theorem 
  for t being Element of n-tuples_on NAT holds (n proj i).t = t.i;

registration
  let X be set;
  cluster HFuncs X -> functional;
end;

theorem 
  for F being Function of D, HFuncs E st rng F is compatible & for
  x being Element of D holds dom (F.x) c= n-tuples_on E ex f being Element of
  HFuncs E st f = Union F & dom f c= n-tuples_on E;

theorem 
  for F being Function of NAT, HFuncs D st for i holds F.i c= F.(i+1)
  holds Union F in HFuncs D;

theorem 
  for F being with_the_same_arity FinSequence of HFuncs D holds
  dom <:F:> c= (arity F)-tuples_on D;

registration
  let X be non empty set;
  let F be with_the_same_arity FinSequence of HFuncs X;
  cluster <:F:> -> homogeneous;
end;

theorem 
  for f being Element of HFuncs D, F being with_the_same_arity
FinSequence of HFuncs D holds dom (f*<:F:>) c= (arity F)-tuples_on D & rng (f*
  <:F:>) c= D & f*<:F:> in HFuncs D;

definition
  let X,Y be non empty set, P be PFUNC_DOMAIN of X,Y;
  let S be non empty Subset of P;
  redefine mode Element of S -> Element of P;
end;

registration
  let f be homogeneous NAT*-defined Function;
  cluster <*f*> -> with_the_same_arity;
end;

theorem 
  for f being homogeneous to-naturals NAT*-defined Function holds arity
  <*f*> = arity f;

theorem 
  for f,g being non empty Element of HFuncs NAT, F being
  with_the_same_arity FinSequence of HFuncs NAT st g = f*<:F:> holds arity g =
  arity F;

theorem 
  for f being non empty quasi_total Element of HFuncs D, F being
with_the_same_arity FinSequence of HFuncs D st arity f = len F & F is non empty
  & (for h being Element of HFuncs D st h in rng F holds h is quasi_total non
empty) holds f*<:F:> is non empty quasi_total Element of HFuncs D & dom (f*<:F
  :>) = (arity F)-tuples_on D;

theorem 
  for f being quasi_total Element of HFuncs D, F being
  with_the_same_arity FinSequence of HFuncs D st arity f = len F & for h being
  Element of HFuncs D st h in rng F holds h is quasi_total holds f*<:F:> is
  quasi_total Element of HFuncs D;

theorem 
  for f,g being non empty quasi_total Element of HFuncs D st arity
  f = 0 & arity g = 0 & f.{} = g.{} holds f = g;

theorem 
  for f,g being non empty len-total homogeneous to-naturals NAT*
  -defined Function st arity f = 0 & arity g = 0 & f.{} = g.{} holds f = g;

begin 

reserve f1, f2 for non empty homogeneous to-naturals NAT*-defined Function,
  e1 , e2 for homogeneous to-naturals NAT*-defined Function,
  p for Element of (arity f1+1)-tuples_on NAT;

definition
  let g, f1, f2 be homogeneous to-naturals NAT*-defined Function, i be Element
  of NAT;
  pred g is_primitive-recursively_expressed_by f1,f2,i means


  ex n
being Element of NAT st dom g c= n-tuples_on NAT & i >= 1 & i <= n & (arity f1)
+1 = n & n+1 = arity f2 & for p being FinSequence of NAT st len p = n holds (p
+*(i,0) in dom g iff Del(p,i) in dom f1) & (p+*(i,0) in dom g implies g.(p+*(i,
0)) = f1.Del(p,i)) & for n being Element of NAT holds (p+*(i,n+1) in dom g iff
p+*(i,n) in dom g & (p+*(i,n))^<*g.(p+*(i,n))*> in dom f2) & (p+*(i,n+1) in dom
  g implies g.(p+*(i,n+1)) = f2.((p+*(i,n))^<*g.(p+*(i,n))*>));
end;

definition
  let f1,f2 be homogeneous to-naturals NAT*-defined Function;
  let i be Element of NAT;
  let p be FinSequence of NAT;
  func primrec(f1,f2,i,p) -> Element of HFuncs NAT means


  ex F being
Function of NAT, HFuncs NAT st it = F.(p/.i) & (i in dom p & Del(p,i) in dom f1
implies F.0 = p+*(i,0) .--> (f1.Del(p,i))) & (not i in dom p or not Del(p,i) in
dom f1 implies F.0 = {}) & for m being Element of NAT holds (i in dom p & p+*(i
,m) in dom (F.m) & (p+*(i,m))^<*(F.m).(p+*(i,m))*> in dom f2 implies F.(m+1) =
(F.m)+*(p+*(i,m+1) .--> f2.((p+*(i,m))^<*(F.m).(p+*(i,m))*>))) & (not i in dom
p or not p+*(i,m) in dom (F.m) or not (p+*(i,m))^<*(F.m).(p+*(i,m))*> in dom f2
  implies F.(m+1) = F.m);
end;

theorem 
  for p, q being FinSequence of NAT st q in dom primrec(e1,e2,i,p)
  ex k st q = p+*(i,k);

theorem 
  for p being FinSequence of NAT st not i in dom p holds primrec(
  e1,e2,i,p) = {};

theorem 
  for p, q being FinSequence of NAT holds primrec(e1,e2,i,p)
  tolerates primrec(e1,e2,i,q);

theorem 
  for p being FinSequence of NAT holds dom primrec(e1,e2,i,p) c= (
  1+arity e1)-tuples_on NAT;

theorem 
  for p being FinSequence of NAT st e1 is empty holds primrec(e1,
  e2,i,p) is empty;

theorem 
  f1 is len-total & f2 is len-total & arity f1 +2 = arity f2 & 1
  <= i & i <= 1+arity f1 implies p in dom primrec(f1,f2,i,p);

definition
  let f1,f2 be homogeneous to-naturals NAT*-defined Function;
  let i be Element of NAT;
  func primrec(f1,f2,i) -> Element of HFuncs NAT means


  ex G being
  Function of (arity f1+1)-tuples_on NAT, HFuncs NAT st it = Union G & for p
  being Element of (arity f1+1)-tuples_on NAT holds G.p = primrec(f1,f2,i,p);
end;

theorem 
  e1 is empty implies primrec(e1,e2,i) is empty;

theorem 
  dom primrec(f1,f2,i) c= (arity f1+1)-tuples_on NAT;

theorem 
  f1 is len-total & f2 is len-total & arity f1 +2 = arity f2 & 1
  <= i & i <= 1+arity f1 implies dom primrec(f1,f2,i) = (arity f1+1)-tuples_on
  NAT & arity primrec(f1,f2,i) = arity f1+1;

definition let n be Nat, p be Element of n-tuples_on NAT;
 let i,k be Element of NAT;
 redefine func p+*(i,k) -> Element of n-tuples_on NAT;
end;

theorem 
  i in dom p implies (p+*(i,0) in dom primrec(f1,f2,i) iff Del(p,i) in
  dom f1 );

theorem 
  i in dom p & p+*(i,0) in dom primrec(f1,f2,i) implies primrec(f1,f2,i)
  .(p+*(i,0)) = f1.Del(p,i);

theorem 
  i in dom p & f1 is len-total implies primrec(f1,f2,i).(p+*(i,0))
  = f1.Del(p,i);

theorem 
  i in dom p implies (p+*(i,m+1) in dom primrec(f1,f2,i) iff p+*(i,m) in
dom primrec(f1,f2,i) & (p+*(i,m))^<*primrec(f1,f2,i).(p+*(i,m))*> in dom f2);

theorem 
  i in dom p & p+*(i,m+1) in dom primrec(f1,f2,i) implies primrec(f1,f2,
  i).(p+*(i,m+1)) = f2.((p+*(i,m))^<*primrec(f1,f2,i).(p+*(i,m))*>);

theorem 
  f1 is len-total & f2 is len-total & arity f1 +2 = arity f2 & 1
<= i & i <= 1+arity f1 implies primrec(f1,f2,i).(p+*(i,m+1)) = f2.((p+*(i,m))^
  <*primrec(f1,f2,i).(p+*(i,m))*>);

theorem 
  arity f1+2 = arity f2 & 1 <= i & i <= arity f1+1 implies primrec
  (f1,f2,i) is_primitive-recursively_expressed_by f1,f2,i;

theorem 
  1 <= i & i <= arity f1+1 implies for g being Element of HFuncs NAT st
  g is_primitive-recursively_expressed_by f1,f2,i holds g = primrec(f1,f2,i);

begin 

definition
  let X be set;
  attr X is composition_closed means


  for f being Element of HFuncs NAT
  , F being with_the_same_arity FinSequence of HFuncs NAT st f in X & arity f =
  len F & rng F c= X holds f*<:F:> in X;
  attr X is primitive-recursion_closed means


  for g,f1,f2 being Element of HFuncs NAT, i being Element of NAT st g
is_primitive-recursively_expressed_by f1,f2,i & f1 in X & f2 in X holds g in X;
end;

definition
  let X be set;
  attr X is primitive-recursively_closed means


  0 const 0 in X & 1 succ 1 in X &
  (for n,i being Element of NAT st 1 <= i & i <= n holds n proj i in X)
  & X is composition_closed & X is primitive-recursion_closed;
end;

theorem 
  HFuncs NAT is primitive-recursively_closed;

registration
  cluster primitive-recursively_closed non empty for Subset of HFuncs NAT;
end;

reserve P for primitive-recursively_closed non empty Subset of HFuncs NAT;

theorem 
  for g being Element of HFuncs NAT st e1 = {} & g
  is_primitive-recursively_expressed_by e1, e2, i holds g = {};

theorem 
  for g being Element of HFuncs(NAT), f1, f2 being quasi_total
  Element of HFuncs(NAT), i being Element of NAT st g
is_primitive-recursively_expressed_by f1, f2, i holds g is quasi_total & (f1 is
  non empty implies g is non empty);

theorem 
  n const c in P;

theorem 
  1 <= i & i <= n implies n succ i in P;

theorem 
  {} in P;

theorem 
  for f being Element of P, F being with_the_same_arity
  FinSequence of P st arity f = len F holds f*<:F:> in P;

theorem 
  for f1,f2 being Element of P st arity f1+2 = arity f2 for i
  being Element of NAT st 1 <= i & i <= arity f1+1 holds primrec(f1,f2,i) in P;

definition
  func PrimRec -> Subset of HFuncs(NAT) equals

  meet { R where R is Subset of
  HFuncs(NAT) : R is primitive-recursively_closed };
end;

theorem 
  for X being Subset of HFuncs(NAT) st X is
  primitive-recursively_closed holds PrimRec c= X;

registration
  cluster PrimRec -> non empty primitive-recursively_closed;
end;

registration
  cluster -> homogeneous for Element of PrimRec;
end;

definition
  let x be set;
  attr x is primitive-recursive means


  x in PrimRec;
end;

registration
  cluster primitive-recursive -> Relation-like Function-like for set;
end;

registration
  cluster primitive-recursive -> homogeneous to-naturals NAT*-defined for
Relation;
end;

registration
  cluster -> primitive-recursive for Element of PrimRec;
end;

registration
  cluster primitive-recursive for Function;
  cluster primitive-recursive for Element of HFuncs NAT;
end;

definition
  func initial-funcs -> Subset of HFuncs NAT equals

  {0 const 0, 1 succ 1} \/ {
  n proj i where n,i is Element of NAT: 1 <= i & i <= n};
  let Q be Subset of HFuncs NAT;
  func PR-closure Q -> Subset of HFuncs NAT equals

  Q \/ {g where g is Element
of HFuncs NAT: ex f1,f2 being Element of HFuncs NAT, i being Element of NAT st
  f1 in Q & f2 in Q & g is_primitive-recursively_expressed_by f1,f2,i};
  func composition-closure Q -> Subset of HFuncs NAT equals

  Q \/ {f*<:F:>
  where f is Element of HFuncs NAT, F is with_the_same_arity Element of (HFuncs
  NAT)*: f in Q & arity f = len F & rng F c= Q};
end;

definition
  func PrimRec-Approximation -> Function of NAT, bool HFuncs NAT means


it.0 = initial-funcs & for m being Nat holds it.(m+1) = (PR-closure (it.m)) \/
  (composition-closure (it.m));
end;

theorem 
  m <= n implies PrimRec-Approximation.m c= PrimRec-Approximation. n;

theorem 
  Union PrimRec-Approximation is primitive-recursively_closed;

theorem 
  PrimRec = Union PrimRec-Approximation;

theorem 
  for f being Element of HFuncs(NAT) st f in PrimRec-Approximation
  .m holds f is quasi_total;

registration
  cluster -> quasi_total homogeneous for Element of PrimRec;
end;

registration
  cluster primitive-recursive -> quasi_total for Element of HFuncs NAT;
end;

registration
  cluster primitive-recursive -> len-total for NAT*-defined Function;
  cluster non empty for Element of PrimRec;
end;

begin 

definition
  let n be set;
  let f be homogeneous Relation;
  attr f is n-ary means


  arity f = n;

end;

registration
  cluster 1-ary -> non empty for homogeneous Function;
  cluster 2-ary -> non empty for homogeneous Function;
  cluster 3-ary -> non empty for homogeneous Function;
end;

registration
  let n be non empty Element of NAT;
  cluster n proj 1 -> primitive-recursive;
end;

registration
  cluster 2 proj 2 -> primitive-recursive;
  cluster 1 succ 1 -> primitive-recursive;
  cluster 3 succ 3 -> primitive-recursive;
  let i be Element of NAT;
  cluster 0 const i -> 0-ary;
  cluster 1 const i -> 1-ary;
  cluster 2 const i -> 2-ary;
  cluster 3 const i -> 3-ary;
  cluster 1 proj i -> 1-ary;
  cluster 2 proj i -> 2-ary;
  cluster 3 proj i -> 3-ary;
  cluster 1 succ i -> 1-ary;
  cluster 2 succ i -> 2-ary;
  cluster 3 succ i -> 3-ary;
  let j be Element of NAT;
  cluster i const j -> primitive-recursive;
end;

registration
  cluster 0-ary primitive-recursive non empty for homogeneous Function;
  cluster 1-ary primitive-recursive for homogeneous Function;
  cluster 2-ary primitive-recursive for homogeneous Function;
  cluster 3-ary primitive-recursive for homogeneous Function;
end;

registration
  cluster non empty 0-ary len-total to-naturals for homogeneous NAT*-defined
    Function;
  cluster non empty 1-ary len-total to-naturals for homogeneous NAT*-defined
    Function;
  cluster non empty 2-ary len-total to-naturals for homogeneous NAT*-defined
    Function;
  cluster non empty 3-ary len-total to-naturals for homogeneous NAT*-defined
    Function;
end;

registration
  let f be 0-ary non empty primitive-recursive Function;
  let g be 2-ary primitive-recursive Function;
  cluster primrec(f,g,1) -> primitive-recursive 1-ary;
end;

registration
  let f be 1-ary primitive-recursive Function;
  let g be 3-ary primitive-recursive Function;
  cluster primrec(f,g,1) -> primitive-recursive 2-ary;
  cluster primrec(f,g,2) -> primitive-recursive 2-ary;
end;

theorem 
  for f1 be 1-ary len-total to-naturals homogeneous NAT*-defined
Function, f2 be non empty to-naturals homogeneous NAT*-defined Function holds
  primrec(f1,f2,2).<*i,0*> = f1.<*i*>;

theorem 
  f1 is len-total & arity f1 = 0 implies primrec(f1,f2,1).<*0*> = f1.{};

theorem 
  for f1 being 1-ary len-total to-naturals homogeneous NAT*
  -defined Function, f2 being 3-ary len-total to-naturals
  homogeneous NAT*
-defined Function holds primrec(f1,f2,2).<*i,j+1*> = f2.<*i,j,primrec(f1,f2,2)
  .<*i,j*>*>;

theorem 
  f1 is len-total & f2 is len-total & arity f1 = 0 & arity f2 = 2
  implies primrec(f1,f2,1).<*i+1*> = f2.<*i,primrec(f1,f2,1).<*i*>*>;

definition
  let g be Function;
  func (1,2)->(1,?,2) g -> Function equals

  g * <:<*3 proj 1, 3 proj 3*>:>;
end;

registration
  let g be to-naturals NAT*-defined Function;
  cluster (1,2)->(1,?,2) g -> to-naturals NAT*-defined;
end;

registration
  let g be homogeneous Function;
  cluster (1,2)->(1,?,2) g -> homogeneous;
end;

registration
  let g be 2-ary len-total to-naturals homogeneous NAT*-defined Function;
  cluster (1,2)->(1,?,2) g -> non empty 3-ary len-total;
end;

theorem 
  for f being 2-ary len-total to-naturals homogeneous NAT*
  -defined Function holds ((1,2)->(1,?,2) f).<*i,j,k*> = f.<*i,k*>;

theorem 
  for g being 2-ary primitive-recursive Function holds
  (1,2)->(1,?,2) g in PrimRec;

registration
  let f be 2-ary primitive-recursive homogeneous Function;
  cluster (1,2)->(1,?,2) f -> primitive-recursive 3-ary;
end;

definition
  func [+] -> 2-ary primitive-recursive Function equals

  primrec(1 proj 1, 3 succ 3, 2);
end;

theorem 
  [+].<*i,j*> = i+j;

definition
  func [*] -> 2-ary primitive-recursive Function equals

  primrec(1 const 0, (1,2)->(1,?,2) [+], 2);
end;

theorem 
  for i, j being Element of NAT holds [*].<*i,j*> = i*j;

registration
  let g,h be 2-ary primitive-recursive homogeneous Function;
  cluster <*g,h*> -> with_the_same_arity;
end;

registration
  let f,g,h be 2-ary primitive-recursive Function;
  cluster f*<:<*g,h*>:> -> primitive-recursive;
end;

registration
  let f,g,h be 2-ary primitive-recursive Function;
  cluster f*<:<*g,h*>:> -> 2-ary;
end;

registration
  let f be 1-ary primitive-recursive Function;
  let g be primitive-recursive Function;
  cluster f*<:<*g*>:> -> primitive-recursive;
end;

registration
  let f be 1-ary primitive-recursive Function;
  let g be 2-ary primitive-recursive Function;
  cluster f*<:<*g*>:> -> 2-ary;
end;

definition
  func [!] -> 1-ary primitive-recursive Function equals

  primrec(0 const 1, [*]*<:<*(1 succ 1)*<:<*2 proj 1*>:>, 2 proj 2*>:>, 1);
end;

scheme 

  Primrec1{F() -> 1-ary len-total to-naturals homogeneous NAT*-defined
  Function, G() -> 2-ary len-total to-naturals homogeneous NAT*-defined
  Function, f(set) -> Element of NAT, g(set,set) -> Element of NAT}: for i, j
  being Element of NAT holds (F()*<:<*G()*>:>).<*i,j*> = f(g(i,j))
provided
 for i being Element of NAT holds F().<*i*> = f(i) and
 for i,j being Element of NAT holds G().<*i,j*> = g(i,j);

scheme 

  Primrec2{F,G,H() -> 2-ary len-total to-naturals homogeneous NAT*-defined
  Function, f,g,h(set,set) -> Element of NAT}: for i, j being Element of NAT
  holds (F()*<:<*G(),H()*>:>).<*i,j*> = f(g(i,j),h(i,j))
provided
 for i,j being Element of NAT holds F().<*i,j*> = f(i,j) and
 for i,j being Element of NAT holds G().<*i,j*> = g(i,j) and
 for i,j being Element of NAT holds H().<*i,j*> = h(i,j);

theorem 
  [!].<*i*> = i!;

definition
  func [^] -> 2-ary primitive-recursive Function equals

  primrec(1 const 1, (1,2)->(1,?,2) [*], 2);
end;

theorem 
  [^].<*i,j*> = i |^ j;

definition
  func [pred] -> 1-ary primitive-recursive Function equals

  primrec(0 const 0, 2 proj 1, 1);
end;

theorem 
  [pred].<*0*> = 0 & [pred].<*i+1*> = i;

definition
  func [-] -> 2-ary primitive-recursive Function equals

  primrec(1 proj 1,(1,2)->(1,?,2) ([pred]*<:<*2 proj 2*>:>), 2);
end;

theorem 
  [-].<*i,j*> = i -' j;














begin 

notation
  let x,y be set;
  antonym x nin y for x in y;
end;

theorem 
  for f,g,h being Function
  for A being set st A c= dom f & A c= dom g & rng h c= A &
  for x being set st x in A holds f.x = g.x holds f*h = g*h;

registration
  let x,y be non empty set;
  cluster <*x,y*> -> non-empty;
end;

registration
  let p,q be non-empty FinSequence;
  cluster p^q -> non-empty;
end;

definition
  let f be homogeneous Function;
  let x be set;
  pred x is_a_unity_wrt f means


   for y,z being set st <*y,z*> in dom f or <*z,y*> in dom f
  holds <*x,y*> in dom f & f.<*x,y*> = y & <*y,x*> in dom f & f.<*y,x*> = y;
end;

definition
  let f be homogeneous Function;
  attr f is associative means


   for x,y,z being set st <*x,y*> in dom f & <*y,z*> in dom f &
  <*f.<*x,y*>,z*> in dom f & <*x,f.<*y,z*>*> in dom f
  holds f.<*f.<*x,y*>,z*> = f.<*x,f.<*y,z*>*>;
  attr f is unital means


  ex x being set st x is_a_unity_wrt f;
end;

definition
  let X be set;
  let Y be non empty set;
  let Z be FinSequenceSet of X;
  let y be Element of Y;
  redefine func Z --> y -> PartFunc of X*,Y;
end;

registration
  let X be non empty set;
  let x be Element of X;
  let n be Nat;
  cluster (n-tuples_on X) --> x ->
    non empty quasi_total homogeneous for PartFunc of X*, X;
end;

theorem 
  for X being non empty set, x being Element of X
  for n being Nat holds arity ((n-tuples_on X) --> x) = n;

registration
  let X be non empty set;
  let x be Element of X;
  let n be Nat;
  cluster (n-tuples_on X) --> x -> n-ary for homogeneous PartFunc of X*, X;
end;

registration
  let X be non empty set;
  cluster 2-ary associative unital
    for non empty quasi_total homogeneous PartFunc of X*, X;
  cluster 0-ary for non empty quasi_total homogeneous PartFunc of X*, X;
  cluster 3-ary for non empty quasi_total homogeneous PartFunc of X*, X;
end;

theorem 
  for X being non empty set for p being FinSequence of FinTrees X
  for x,t being set st t in rng p holds t <> x-tree p;

definition
  let f,g be Function;
  let X be set;
  func (f,X)+*g -> Function equals

  g+*(f|X);
end;

theorem 
  for f,g being Function, x,X being set holds
  x in X & X c= dom f implies ((f,X)+*g).x = f.x;

theorem 
  for f,g being Function, x,X being set holds
  x nin X & x in dom g implies ((f,X)+*g).x = g.x;

definition
  let X,Y be non empty set;
  let f,g be Element of Funcs(X,Y);
  let A be set;
  redefine func (f,A)+*g -> Element of Funcs(X,Y);
end;

definition
  let X,Y,Z be non empty set;
  let f be Element of Funcs(X,Y);
  let g be Element of Funcs(Y,Z);
  redefine func g*f -> Element of Funcs(X,Z);
end;

definition
  let f be Function;
  let x be set;
  func f orbit x equals

  {iter(f,n).x where n is Element of NAT: x in dom iter(f,n)};
end;

theorem 
  for f being Function, x being set st x in dom f holds x in f orbit x;

theorem 
  for f being Function, x,y being set
  st rng f c= dom f & y in f orbit x holds f.y in f orbit x;

theorem 
  for f being Function, x being set st x in dom f holds f.x in f orbit x;

theorem 
  for f being Function, x being set st x in dom f
  holds f orbit (f.x) c= f orbit x;

definition
  let f be Function such that
 rng f c= dom f;
  let A be set;
  let x be set;
  func (A,x) iter f -> Function means

  dom it = dom f &
  for a being set st a in dom f holds (f orbit a c= A implies it.a = x) &
  for n being Nat st iter(f,n).a nin A &
  for i being Nat st i < n holds iter(f,i).a in A holds it.a = iter(f,n).a;
end;

definition
  let f be Function such that
 rng f c= dom f;
  let A be set;
  let g be Function;
  func (A,g) iter f -> Function means


  dom it = dom f &
  for a being set st a in dom f holds (f orbit a c= A implies it.a = g.a) &
  for n being Nat st iter(f,n).a nin A &
  for i being Nat st i < n holds iter(f,i).a in A holds it.a = iter(f,n).a;
end;

theorem 
  for f,g being Function, a,A being set st rng f c= dom f & a in dom f holds
  not f orbit a c= A implies
  ex n being Nat st ((A,g) iter f).a = iter(f,n).a & iter(f,n).a nin A &
  for i being Nat st i < n holds iter(f,i).a in A;

theorem 
  for f,g being Function, a,A being set
  st rng f c= dom f & a in dom f & g*f = g holds
  a in A implies ((A,g) iter f).a = ((A,g) iter f).(f.a);

theorem 
  for f,g being Function, a,A being set st rng f c= dom f & a in dom f holds
  a nin A implies ((A,g) iter f).a = a;

definition
  let X be non empty set;
  let f be Element of Funcs(X,X);
  let A be set;
  let g be Element of Funcs(X,X);
  redefine func (A,g) iter f -> Element of Funcs(X,X);
end;

begin 

theorem 
  for X being non empty set, S being non empty FinSequence of NAT
  ex A being Universal_Algebra st the carrier of A = X & signature A = S;

theorem 
  for S being non empty FinSequence of NAT
  ex A being Universal_Algebra st the carrier of A = NAT & signature A = S &
  for i,j being Nat st i in dom S & j = S.i
  holds (the charact of A).i = (j-tuples_on NAT) --> i;

theorem 
  for S being non empty FinSequence of NAT
  for i,j being Nat st i in dom S & j = S.i
  for X being non empty set, f being Function of j-tuples_on X, X
  ex A being Universal_Algebra st the carrier of A = X & signature A = S &
  (the charact of A).i = f;

registration
  let f be non empty FinSequence of NAT;
  let D be non empty disjoint_with_NAT set;
  cluster -> Relation-like Function-like for Element of FreeUnivAlgNSG(f,D);
end;

registration
  let f be non empty FinSequence of NAT;
  let D be non empty disjoint_with_NAT set;
  cluster -> DecoratedTree-like for Element of FreeUnivAlgNSG(f,D);
  cluster -> DTree-yielding for FinSequence of FreeUnivAlgNSG(f,D);
end;

theorem 
  for G being non empty DTConstrStr for t being set st t in TS G holds
  (ex d being Symbol of G st d in Terminals G & t = root-tree d) or
  ex o being Symbol of G, p being FinSequence of TS G
  st o ==> roots p & t = o-tree p;

theorem 
  for X being disjoint_with_NAT non empty set
  for S being non empty FinSequence of NAT for i being Nat st i in dom S
  for p being FinSequence of FreeUnivAlgNSG(S,X) st len p = S.i holds
  Den(In(i, dom the charact of FreeUnivAlgNSG(S,X)),FreeUnivAlgNSG(S,X)).p
  = i-tree p;

definition
  let A be non-empty UAStr;
  let B be Subset of A;
  let n be Nat;
  func B|^n -> Subset of A means


  ex F being Function of NAT, bool the carrier of A st it = F.n & F.0 = B &
  for n being Nat holds F.(n+1) = F.n \/
  {Den(o,A).p where o is (Element of dom the charact of A),
  p is Element of (the carrier of A)*: p in dom Den(o,A) & rng p c= F.n};
end;

theorem 
  for A being Universal_Algebra, B being Subset of A holds B|^0 = B;

theorem 
  for A being Universal_Algebra, B being Subset of A for n being Nat
  holds B|^(n+1) = (B|^n) \/ {Den(o,A).p
  where o is (Element of dom the charact of A),
  p is Element of (the carrier of A)*: p in dom Den(o,A) & rng p c= B|^n};

theorem 
  for A being Universal_Algebra, B being Subset of A for n being Nat
  for x being set holds x in B|^(n+1) iff x in B|^n or
  ex o being Element of dom the charact of A st
  ex p being Element of (the carrier of A)*
  st x = Den(o,A).p & p in dom Den(o,A) & rng p c= B|^n;

theorem 
  for A being Universal_Algebra, B being Subset of A
  for n,m being Nat st n <= m holds B|^n c= B|^m;

theorem 
  for A being Universal_Algebra for B1,B2 being Subset of A st B1 c= B2
  for n being Nat holds B1|^n c= B2|^n;

theorem 
  for A being Universal_Algebra, B being Subset of A for n being Nat
  for x being set holds x in B|^(n+1) iff x in B or
  ex o being Element of dom the charact of A st
  ex p being Element of (the carrier of A)*
  st x = Den(o,A).p & p in dom Den(o,A) & rng p c= B|^n;

scheme 
 MaxVal{A() -> non empty set, B() -> set, P[set,set]}: ex n being Nat st
  for x being Element of A() st x in B() holds P[x,n]
provided
 B() is finite and
 for x being Element of A() st x in B() ex n being Nat st P[x,n] and
 for x being Element of A()
for n,m being Nat st P[x,n] & n <= m holds P[x,m];

theorem 
  for A being Universal_Algebra, B being Subset of A ex C being Subset of A
  st C = union {B|^n where n is Element of NAT: not contradiction} &
  C is opers_closed;

theorem 
  for A being Universal_Algebra, B,C being Subset of A
  st C is opers_closed & B c= C
  holds union {B|^n where n is Element of NAT: not contradiction} c= C;

definition
  let A be Universal_Algebra;
  func Generators A -> Subset of A equals

  (the carrier of A) \
  union {rng o where o is Element of Operations A: not contradiction};
end;

theorem 
  for A being Universal_Algebra, a being Element of A holds
  a in Generators A iff not ex o being Element of Operations A st a in rng o;

theorem 
  for A being Universal_Algebra for B being Subset of A st B is opers_closed
  holds Constants A c= B;

theorem 
  for A being Universal_Algebra st Constants A = {} holds {} A is opers_closed;

theorem 
  for A being Universal_Algebra st Constants A = {}
  for G being GeneratorSet of A holds G <> {};

theorem 
  for A being Universal_Algebra for G being Subset of A
  holds G is GeneratorSet of A iff
  for I being Element of A ex n being Nat st I in G|^n;

theorem 
  for A being Universal_Algebra for B being Subset of A
  for G being GeneratorSet of A st G c= B holds B is GeneratorSet of A;

theorem 
  for A being Universal_Algebra for G being GeneratorSet of A
  for a being Element of A
  st not ex o being Element of Operations A st a in rng o holds a in G;

theorem 
  for A being Universal_Algebra, G being GeneratorSet of A
  holds Generators A c= G;

theorem 
  for A being free Universal_Algebra for G being free GeneratorSet of A
  holds G = Generators A;

registration
  let A be free Universal_Algebra;
  cluster Generators A -> free for GeneratorSet of A;
end;

definition
  let A be free Universal_Algebra;
  redefine func Generators A -> GeneratorSet of A;
end;

registration
  let A,B be set;
  cluster [:A,B:] -> disjoint_with_NAT;
end;

theorem 
  for A being free Universal_Algebra for G being GeneratorSet of A
  for B being Universal_Algebra for h1,h2 being Function of A,B
  st h1 is_homomorphism A,B & h2 is_homomorphism A,B & h1|G = h2|G
  holds h1 = h2;

theorem 
  for A being free Universal_Algebra for o1,o2 being OperSymbol of A
  for p1,p2 being FinSequence st p1 in dom Den(o1,A) & p2 in dom Den(o2,A)
  holds Den(o1,A).p1 = Den(o2,A).p2 implies o1 = o2 & p1 = p2;

theorem 
  for A being free Universal_Algebra for o1,o2 being Element of Operations A
  for p1,p2 being FinSequence st p1 in dom o1 & p2 in dom o2
  holds o1.p1 = o2.p2 implies o1 = o2 & p1 = p2;

theorem 
  for A being free Universal_Algebra for o being OperSymbol of A
  for p being FinSequence st p in dom Den(o,A) for a being set st a in rng p
  holds a <> Den(o,A).p;

theorem 
  for A being free Universal_Algebra for G being GeneratorSet of A
  for o being OperSymbol of A
  st for o9 being OperSymbol of A, p being FinSequence
  st p in dom Den(o9,A) & Den(o9,A).p in G holds o9 <> o
  for p being FinSequence st p in dom Den(o,A)
  for n being Nat st Den(o,A).p in G|^(n+1) holds rng p c= G|^n;

theorem 
  for A being free Universal_Algebra for o being OperSymbol of A
  for p being FinSequence st p in dom Den(o,A)
  for n being Nat st Den(o,A).p in (Generators A)|^(n+1)
  holds rng p c= (Generators A)|^n;

begin 

definition
  let S be non empty UAStr;
  attr S is with_empty-instruction means


  1 in dom the charact of S &
  (the charact of S).1 is 0-ary non empty homogeneous
  quasi_total PartFunc of (the carrier of S)*, the carrier of S;
  attr S is with_catenation means


  2 in dom the charact of S &
  (the charact of S).2 is 2-ary non empty homogeneous
  quasi_total PartFunc of (the carrier of S)*, the carrier of S;
  attr S is with_if-instruction means


  3 in dom the charact of S &
  (the charact of S).3 is 3-ary non empty homogeneous
  quasi_total PartFunc of (the carrier of S)*, the carrier of S;
  attr S is with_while-instruction means


  4 in dom the charact of S &
  (the charact of S).4 is 2-ary non empty homogeneous
  quasi_total PartFunc of (the carrier of S)*, the carrier of S;
  attr S is associative means


   (the charact of S).2 is 2-ary associative non empty homogeneous
  quasi_total PartFunc of (the carrier of S)*, the carrier of S;
end;

definition
  let S be non-empty UAStr;
  attr S is unital means


  ex f being 2-ary non empty homogeneous
  quasi_total PartFunc of (the carrier of S)*, the carrier of S
  st f = (the charact of S).2 &
  Den(In(1, dom the charact of S), S).({}) is_a_unity_wrt f;
end;

theorem 
  for X being non empty set, x being Element of X
  for c being 2-ary associative unital
  non empty quasi_total homogeneous PartFunc of X*, X st x is_a_unity_wrt c
  for i being 3-ary non empty quasi_total homogeneous PartFunc of X*, X
  for w being 2-ary non empty quasi_total homogeneous PartFunc of X*, X
  ex S being non-empty strict UAStr st the carrier of S = X &
  the charact of S = <*(0-tuples_on X)-->x,c*>^<*i,w*> &
  S is with_empty-instruction with_catenation unital associative
  with_if-instruction with_while-instruction quasi_total partial;

registration
  cluster with_empty-instruction with_catenation with_if-instruction
    with_while-instruction unital associative
    for quasi_total partial non-empty strict UAStr;
end;

definition
  mode preIfWhileAlgebra is with_empty-instruction
    with_catenation with_if-instruction with_while-instruction
    Universal_Algebra;
end;

reserve A for preIfWhileAlgebra,
  C,I,J for Element of A;
reserve S for non empty set,
  T for Subset of S,
  s for Element of S;

definition
  let A be non empty UAStr;
  mode Algorithm of A is Element of A;
end;

theorem 
  for A being with_empty-instruction non-empty UAStr
  holds dom Den(In(1, dom the charact of A), A) = {{}};

definition
  let A be with_empty-instruction non-empty UAStr;
  func EmptyIns A -> Algorithm of A equals

  Den(In(1, dom the charact of A), A).{};
end;

theorem 
  for A being with_empty-instruction Universal_Algebra
  for o being Element of Operations A
  st o = Den(In(1, dom the charact of A), A)
  holds arity o = 0 & EmptyIns A in rng o;

theorem 
  for A being with_catenation non-empty UAStr
  holds dom Den(In(2, dom the charact of A), A) = 2-tuples_on the carrier of A;

definition
  let A be with_catenation non-empty UAStr;
  let I1,I2 be Algorithm of A;
  func I1 \; I2 -> Algorithm of A equals

  Den(In(2, dom the charact of A), A).<*I1,I2*>;
end;

theorem 
  for A being with_empty-instruction with_catenation unital non-empty UAStr
  for I being Element of A holds EmptyIns A\;I = I & I\;EmptyIns A = I;

theorem 
  for A being associative with_catenation non-empty UAStr
  for I1,I2,I3 being Element of A holds (I1\;I2)\;I3 = I1\;(I2\;I3);

theorem 
  for A being with_if-instruction non-empty UAStr
  holds dom Den(In(3, dom the charact of A), A) = 3-tuples_on the carrier of A;

definition
  let A be with_if-instruction non-empty UAStr;
  let C,I1,I2 be Algorithm of A;
  func if-then-else(C,I1,I2) -> Algorithm of A equals

  Den(In(3, dom the charact of A), A).<*C,I1,I2*>;
end;

definition
  let A be with_empty-instruction with_if-instruction non-empty UAStr;
  let C,I be Algorithm of A;
  func if-then(C,I) -> Algorithm of A equals

  if-then-else(C,I,EmptyIns A);
end;

theorem 
  for A being with_while-instruction non-empty UAStr
  holds dom Den(In(4, dom the charact of A), A) = 2-tuples_on the carrier of A;

definition
  let A be with_while-instruction non-empty UAStr;
  let C,I be Algorithm of A;
  func while(C,I) -> Algorithm of A equals

  Den(In(4, dom the charact of A), A).<*C,I*>;
end;

definition
  let A be preIfWhileAlgebra;
  let I0,C,I,J be Element of A;
  func for-do(I0,C,J,I) -> Element of A equals

  I0\;while(C,I\;J);
end;

definition
  let A be preIfWhileAlgebra;
  func ElementaryInstructions A -> Subset of A equals

  (the carrier of A)
  \ {EmptyIns A} \ rng Den(In(3, dom the charact of A), A)
  \ rng Den(In(4, dom the charact of A), A)
  \ {I1 \; I2 where I1,I2 is Algorithm of A: I1 <> I1\;I2 & I2 <> I1\;I2};
end;

theorem 
  for A being preIfWhileAlgebra holds EmptyIns A nin ElementaryInstructions A;

theorem 
  for A being preIfWhileAlgebra
  for I1,I2 being Element of A st I1 <> I1\;I2 & I2 <> I1\;I2
  holds I1\;I2 nin ElementaryInstructions A;

theorem 
  for A being preIfWhileAlgebra for C,I1,I2 being Element of A
  holds if-then-else(C,I1,I2) nin ElementaryInstructions A;

theorem 
  for A being preIfWhileAlgebra for C,I being Element of A
  holds while(C,I) nin ElementaryInstructions A;

theorem 
  for A being preIfWhileAlgebra for I being Element of A
  st I nin ElementaryInstructions A holds I = EmptyIns A or
  (ex I1,I2 being Element of A st I = I1\;I2 & I1 <> I1\;I2 & I2 <> I1\;I2) or
  (ex C,I1,I2 being Element of A st I = if-then-else(C,I1,I2)) or
  ex C,J being Element of A st I = while(C,J);

definition
  let A be preIfWhileAlgebra;
  attr A is infinite means


  ElementaryInstructions A is infinite;
  attr A is degenerated means


  (ex I1,I2 being Element of A st
  I1 <> EmptyIns A & I1\;I2 = I2 or I2 <> EmptyIns A & I1\;I2 = I1 or
  (I1 <> EmptyIns A or I2 <> EmptyIns A) & I1\;I2 = EmptyIns A) or
  (ex C,I1,I2 being Element of A st if-then-else(C,I1,I2) = EmptyIns A) or
  (ex C,I being Element of A st while(C,I) = EmptyIns A) or
  (ex I1,I2,C,J1,J2 being Element of A st I1 <> EmptyIns A & I2 <> EmptyIns A &
  I1\;I2 = if-then-else(C,J1,J2)) or
  (ex I1,I2,C,J being Element of A st I1 <> EmptyIns A & I2 <> EmptyIns A &
  I1\;I2 = while(C,J)) or ex C1,I1,I2,C2,J being Element of A st
  if-then-else(C1,I1,I2) = while(C2,J);
  attr A is well_founded means


   ElementaryInstructions A is GeneratorSet of A;
end;

definition
  func ECIW-signature -> non empty FinSequence of NAT equals

  <*0, 2*>^<*3, 2*>;
end;

theorem 
  len ECIW-signature = 4 & dom ECIW-signature = Seg 4 &
  ECIW-signature.1 = 0 & ECIW-signature.2 = 2 &
  ECIW-signature.3 = 3 & ECIW-signature.4 = 2;

definition
  let A be partial non-empty non empty UAStr;
  attr A is ECIW-strict means


  signature A = ECIW-signature;
end;

theorem 
  for A being partial non-empty non empty UAStr st A is ECIW-strict
  for o being OperSymbol of A holds o = 1 or o = 2 or o = 3 or o = 4;

registration
  let X be disjoint_with_NAT non empty set;
  cluster FreeUnivAlgNSG(ECIW-signature,X) -> with_empty-instruction
    with_catenation with_if-instruction with_while-instruction;
end;

theorem 
  for X being disjoint_with_NAT non empty set
  for I being Element of FreeUnivAlgNSG(ECIW-signature,X) holds
  (ex x being Element of X st I = root-tree x) or
  ex n being Nat, p being FinSequence of FreeUnivAlgNSG(ECIW-signature,X)
  st n in Seg 4 & I = n-tree p & len p = ECIW-signature.n;

theorem 
  for X being disjoint_with_NAT non empty set
  holds EmptyIns FreeUnivAlgNSG(ECIW-signature,X) = 1-tree {};

theorem 
  for X being disjoint_with_NAT non empty set
  for p being FinSequence of FreeUnivAlgNSG(ECIW-signature,X)
  st 1-tree p is Element of FreeUnivAlgNSG(ECIW-signature,X) holds p = {};

theorem 
  for X being disjoint_with_NAT non empty set
  for I1,I2 being Element of FreeUnivAlgNSG(ECIW-signature,X)
  holds I1\;I2 = 2-tree(I1,I2);

theorem 
  for X being disjoint_with_NAT non empty set
  for p being FinSequence of FreeUnivAlgNSG(ECIW-signature,X)
  st 2-tree p is Element of FreeUnivAlgNSG(ECIW-signature,X)
  ex I1,I2 being Element of FreeUnivAlgNSG(ECIW-signature,X) st p = <*I1,I2*>;

theorem 
  for X being disjoint_with_NAT non empty set
  for I1,I2 being Element of FreeUnivAlgNSG(ECIW-signature,X)
  holds I1\;I2 <> I1 & I1\;I2 <> I2;

theorem 
  for X being disjoint_with_NAT non empty set
  for I1,I2,J1,J2 being Element of FreeUnivAlgNSG(ECIW-signature,X)
  holds I1\;I2 = J1\;J2 implies I1 = J1 & I2 = J2;

theorem 
  for X being disjoint_with_NAT non empty set
  for C,I1,I2 being Element of FreeUnivAlgNSG(ECIW-signature,X)
  holds if-then-else(C,I1,I2) = 3-tree<*C,I1,I2*>;

theorem 
  for X being disjoint_with_NAT non empty set
  for p being FinSequence of FreeUnivAlgNSG(ECIW-signature,X)
  st 3-tree p is Element of FreeUnivAlgNSG(ECIW-signature,X)
  ex C,I1,I2 being Element of FreeUnivAlgNSG(ECIW-signature,X)
  st p = <*C,I1,I2*>;

theorem 
  for X being disjoint_with_NAT non empty set
  for C1,C2,I1,I2,J1,J2 being Element of FreeUnivAlgNSG(ECIW-signature,X)
  st if-then-else(C1,I1,I2) = if-then-else(C2,J1,J2)
  holds C1 = C2 & I1 = J1 & I2 = J2;

theorem 
  for X being disjoint_with_NAT non empty set
  for C,I being Element of FreeUnivAlgNSG(ECIW-signature,X)
  holds while(C,I) = 4-tree(C,I);

theorem 
  for X being disjoint_with_NAT non empty set
  for p being FinSequence of FreeUnivAlgNSG(ECIW-signature,X)
  st 4-tree p is Element of FreeUnivAlgNSG(ECIW-signature,X)
  ex C,I being Element of FreeUnivAlgNSG(ECIW-signature,X) st p = <*C,I*>;

theorem 
  for X being disjoint_with_NAT non empty set
  for I being Element of FreeUnivAlgNSG(ECIW-signature,X)
  st I in ElementaryInstructions FreeUnivAlgNSG(ECIW-signature,X)
  ex x being Element of X st I = x-tree {};

theorem 
  for X being disjoint_with_NAT non empty set
  for p being FinSequence of FreeUnivAlgNSG(ECIW-signature,X)
  for x being Element of X
  st x-tree p is Element of FreeUnivAlgNSG(ECIW-signature,X) holds p = {};

theorem 
  for X being disjoint_with_NAT non empty set
  holds ElementaryInstructions FreeUnivAlgNSG(ECIW-signature,X) =
  FreeGenSetNSG(ECIW-signature,X) &
  card X = card FreeGenSetNSG(ECIW-signature,X);

registration
  cluster infinite disjoint_with_NAT for set;
end;

registration
  let X be infinite disjoint_with_NAT set;
  cluster FreeUnivAlgNSG(ECIW-signature,X) -> infinite;
end;

registration
  let X be disjoint_with_NAT non empty set;
  cluster FreeUnivAlgNSG(ECIW-signature,X) -> ECIW-strict;
end;

theorem 
  for A being preIfWhileAlgebra holds Generators A c= ElementaryInstructions A;

theorem 
  for A being preIfWhileAlgebra st A is free for C,I1,I2 being Element of A
  holds EmptyIns A <> I1\;I2 & EmptyIns A <> if-then-else(C,I1,I2) &
  EmptyIns A <> while(C,I1);

theorem 
  for A being preIfWhileAlgebra st A is free
  for I1,I2,C,J1,J2 being Element of A holds I1\;I2 <> I1 & I1\;I2 <> I2 &
  (I1\;I2 = J1\;J2 implies I1 = J1 & I2 = J2) &
  I1\;I2 <> if-then-else(C,J1,J2) & I1\;I2 <> while(C,J1);

theorem 
  for A being preIfWhileAlgebra st A is free
  for C,I1,I2,D,J1,J2 being Element of A
  holds if-then-else(C,I1,I2) <> C & if-then-else(C,I1,I2) <> I1 &
  if-then-else(C,I1,I2) <> I2 & if-then-else(C,I1,I2) <> while(D,J1) &
  (if-then-else(C,I1,I2) = if-then-else(D,J1,J2) implies C=D & I1=J1 & I2=J2);

theorem 
  for A being preIfWhileAlgebra st A is free for C,I,D,J being Element of A
  holds while(C,I) <> C & while(C,I) <> I &
  (while(C,I) = while(D,J) implies C = D & I = J);

registration
  cluster free -> well_founded non degenerated for preIfWhileAlgebra;
end;

registration
  cluster infinite non degenerated well_founded ECIW-strict free
    strict for preIfWhileAlgebra;
end;

definition
  mode IfWhileAlgebra is
    non degenerated well_founded ECIW-strict preIfWhileAlgebra;
end;

registration
  let A be infinite preIfWhileAlgebra;
  cluster ElementaryInstructions A -> infinite;
end;

theorem 
  for A being preIfWhileAlgebra for B being Subset of A for n being Nat holds
  EmptyIns A in B|^(n+1) & for C,I1,I2 being Element of A
  st C in B|^n & I1 in B|^n & I2 in B|^n
  holds I1\;I2 in B|^(n+1) & if-then-else(C,I1,I2) in B|^(n+1) &
  while(C,I1) in B|^(n+1);

theorem 
  for A being ECIW-strict preIfWhileAlgebra
  for x being set, n being Nat st x in (ElementaryInstructions A)|^(n+1)
  holds x in (ElementaryInstructions A)|^n or x = EmptyIns A or
  (ex I1,I2 being Element of A st x = I1\;I2 &
  I1 in (ElementaryInstructions A)|^n & I2 in (ElementaryInstructions A)|^n) or
  (ex C,I1,I2 being Element of A st x = if-then-else(C,I1,I2) &
  C in (ElementaryInstructions A)|^n &
  I1 in (ElementaryInstructions A)|^n & I2 in (ElementaryInstructions A)|^n) or
  ex C,I being Element of A st x = while(C,I) &
  C in (ElementaryInstructions A)|^n & I in (ElementaryInstructions A)|^n;

theorem 
  for A being Universal_Algebra for B being Subset of A
  holds Constants A c= B|^1;

theorem 
  for A being preIfWhileAlgebra holds A is well_founded iff
  for I being Element of A ex n being Nat st I in (ElementaryInstructions A)|^n
;

scheme 
 StructInd{ A() -> well_founded ECIW-strict preIfWhileAlgebra,
  I() -> (Element of A()), P[set] }: P[I()]
provided
 for I being Element of A() st I in ElementaryInstructions A() holds P[I]
and
 P[EmptyIns A()] and
 for I1,I2 being Element of A() st P[I1] & P[I2] holds P[I1\;I2] and
 for C,I1,I2 being Element of A() st P[C] & P[I1] & P[I2]
holds P[if-then-else(C,I1,I2)] and
 for C,I being Element of A() st P[C] & P[I] holds P[while(C,I)];

begin 

definition
  let A be preIfWhileAlgebra;
  let S be non empty set; 
  let f be Function of [:S, the carrier of A:], S;
  attr f is complying_with_empty-instruction means


   for s being Element of S holds f.(s, EmptyIns A) = s;
  attr f is complying_with_catenation means


  for s being Element of S
  for I1,I2 being Element of A holds f.(s,I1 \; I2) = f.(f.(s,I1),I2);
end;

definition
  let A be preIfWhileAlgebra;
  let S be non empty set; 
  let T be Subset of S;   
  let f be Function of [:S, the carrier of A:], S;
  pred f complies_with_if_wrt T means


   for s being Element of S for C, I1,I2 being Element of A holds
  (f.(s,C) in T implies f.(s,if-then-else(C,I1,I2)) = f.(f.(s,C),I1)) &
  (f.(s,C) nin T implies f.(s,if-then-else(C,I1,I2)) = f.(f.(s,C),I2));
  pred f complies_with_while_wrt T means


   for s being Element of S for C, I being Element of A holds
  (f.(s,C) in T implies f.(s,while(C,I)) = f.(f.(f.(s,C),I),while(C,I))) &
  (f.(s,C) nin T implies f.(s,while(C,I)) = f.(s,C));
end;

theorem 
  for f being Function of [:S, the carrier of A:], S
  st f is complying_with_empty-instruction & f complies_with_if_wrt T
  for s being Element of S holds
  f.(s,C) nin T implies f.(s,if-then(C,I)) = f.(s,C);

theorem 
  pr1(S, the carrier of A) is complying_with_empty-instruction &
  pr1(S, the carrier of A) is complying_with_catenation &
  pr1(S, the carrier of A) complies_with_if_wrt T &
  pr1(S, the carrier of A) complies_with_while_wrt T;

definition
  let A be preIfWhileAlgebra;
  let S be non empty set; 
  let T be Subset of S;   
  mode ExecutionFunction of A,S,T -> Function of [:S, the carrier of A:], S
    means


    it is complying_with_empty-instruction &
    it is complying_with_catenation & it complies_with_if_wrt T &
    it complies_with_while_wrt T;
end;

registration
  let A be preIfWhileAlgebra;
  let S be non empty set; 
  let T be Subset of S;   
  cluster -> complying_with_empty-instruction complying_with_catenation
    for ExecutionFunction of A,S,T;
end;

definition
  let A be preIfWhileAlgebra;
  let I be Element of A;
  let S be non empty set; 
  let s be Element of S;
  let T be Subset of S;   
  let f be ExecutionFunction of A, S, T;


  pred f iteration_terminates_for I,s means


   ex r being non empty FinSequence of S st r.1 = s & r.len r nin T &
  for i being Nat st 1 <= i & i < len r holds r.i in T & r.(i+1) = f.(r.i, I);
end;

definition
  let A be preIfWhileAlgebra;
  let I be Element of A;
  let S be non empty set; 
  let s be Element of S;
  let T be Subset of S;   
  let f be ExecutionFunction of A, S, T;
  func iteration-degree(I,s,f) -> R_eal means


   ex r being non empty FinSequence of S st
  it = (len r)-1 & r.1 = s & r.len r nin T &
  for i being Nat st 1 <= i & i < len r holds r.i in T & r.(i+1) = f.(r.i, I)
  if f iteration_terminates_for I,s otherwise it = +infty;
end;

reserve f for ExecutionFunction of A,S,T;

theorem 
  f iteration_terminates_for I,s iff iteration-degree(I,s,f) < +infty;

theorem 
  s nin T implies f iteration_terminates_for I,s & iteration-degree(I,s,f) = 0;

theorem 
  s in T implies
  (f iteration_terminates_for I,s iff f iteration_terminates_for I, f.(s,I)) &
  iteration-degree(I,s,f) = 1.+iteration-degree(I,f.(s,I),f);

theorem 
  iteration-degree(I,s,f) >= 0;

scheme 
 Termination {A() -> preIfWhileAlgebra, I() -> (Element of A()),
  S() -> non empty set, s() -> (Element of S()), T() -> Subset of S(),
  f() -> ExecutionFunction of A(),S(),T(), F(set) -> Nat, P[set] }:
  f() iteration_terminates_for I(),s()
provided
 s() in T() iff P[s()] and
 for s being Element of S() st P[s]
holds (P[f().(s,I())] iff f().(s,I()) in T()) & F(f().(s,I())) < F(s);

scheme 
 Termination2 {A() -> preIfWhileAlgebra, I() -> (Element of A()),
  S() -> non empty set, s() -> (Element of S()), T() -> Subset of S(),
  f() -> ExecutionFunction of A(),S(),T(), F(set) -> Nat, P,R[set] }:
  f() iteration_terminates_for I(),s()
provided
 P[s()] and
 s() in T() iff R[s()] and
 for s being Element of S() st P[s] & s in T() & R[s]
holds P[f().(s, I())] & (R[f().(s,I())] iff f().(s,I()) in T()) &
F(f().(s,I())) < F(s);

theorem 
  for r being non empty FinSequence of S st r.1 = f.(s,C) & r.len r nin T &
  for i being Nat st 1 <= i & i < len r
  holds r.i in T & r.(i+1) = f.(r.i, I \; C) holds f.(s, while(C,I)) = r.len r;

theorem 
  for I being Element of A for s being Element of S holds
  not f iteration_terminates_for I,s iff (curry' f).I orbit s c= T;

scheme 
 InvariantSch {A() -> preIfWhileAlgebra, C,I() -> (Element of A()),
  S() -> non empty set, s() -> (Element of S()), T() -> Subset of S(),
  f() -> ExecutionFunction of A(),S(),T(), P,R[set] }:
  P[f().(s(),while(C(),I()))] & not R[f().(s(),while(C(),I()))]
provided
 P[s()] and
 f() iteration_terminates_for I()\;C(), f().(s(),C()) and
 for s being Element of S() st P[s] & s in T() & R[s] holds P[f().(s,I())]
and
 for s being Element of S() st P[s] holds
P[f().(s,C())] & (f().(s,C()) in T() iff R[f().(s,C())]);

scheme 
 coInvariantSch {A() -> preIfWhileAlgebra, C,I() -> (Element of A()),
  S() -> non empty set, s() -> (Element of S()), T() -> Subset of S(),
  f() -> ExecutionFunction of A(),S(),T(), P[set] }: P[s()]
provided
 P[f().(s(),while(C(),I()))] and
 f() iteration_terminates_for I()\;C(), f().(s(),C()) and
 for s being Element of S() st P[f().(f().(s,C()),I())] & f().(s,C()) in T()
holds P[f().(s,C())] and
 for s being Element of S() st P[f().(s,C())] holds P[s];

theorem 
  for A being free preIfWhileAlgebra for I1,I2 being Element of A
  for n being Nat st I1\;I2 in (ElementaryInstructions A)|^n
  ex i being Nat st n = i+1 &
  I1 in (ElementaryInstructions A)|^i & I2 in (ElementaryInstructions A)|^i;

theorem 
  for A being free preIfWhileAlgebra for C,I1,I2 being Element of A
  for n being Nat st if-then-else(C,I1,I2) in (ElementaryInstructions A)|^n
  ex i being Nat st n = i+1 & C in (ElementaryInstructions A)|^i &
  I1 in (ElementaryInstructions A)|^i & I2 in (ElementaryInstructions A)|^i;

theorem 
  for A being free preIfWhileAlgebra for C,I being Element of A
  for n being Nat st while(C,I) in (ElementaryInstructions A)|^n
  ex i being Nat st n = i+1 &
  C in (ElementaryInstructions A)|^i & I in (ElementaryInstructions A)|^i;

begin 

scheme 
 IndDef {A() -> free ECIW-strict preIfWhileAlgebra,
  S() -> non empty set, Emp() -> (Element of S()), ElemF(set) -> set,
  ConF, WhiF(set,set) -> (Element of S()),
  IfF(set,set,set) -> Element of S()}:
  ex f being Function of the carrier of A(), S() st
  (for I being Element of A() st I in ElementaryInstructions A()
  holds f.I = ElemF(I)) & f.EmptyIns A() = Emp() &
  (for I1,I2 being Element of A() holds f.(I1\;I2) = ConF(f.I1,f.I2)) &
  (for C,I1,I2 being Element of A()
  holds f.if-then-else(C,I1,I2) = IfF(f.C,f.I1,f.I2)) &
  for C,I being Element of A() holds f.while(C,I) = WhiF(f.C,f.I)
provided
 for I being Element of A() st I in ElementaryInstructions A()
holds ElemF(I) in S();

theorem 
  for A being free ECIW-strict preIfWhileAlgebra
  for g being Function of [:S, ElementaryInstructions A:], S
  for s0 being Element of S ex f being ExecutionFunction of A, S, T
  st f|[:S, ElementaryInstructions A:] = g & for s being Element of S
  for C,I being Element of A st not f iteration_terminates_for I\;C, f.(s,C)
  holds f.(s, while(C,I)) = s0;

theorem 
  for A being free ECIW-strict preIfWhileAlgebra
  for g being Function of [:S, ElementaryInstructions A:], S
  for F being Function of Funcs(S,S), Funcs(S,S)
  st for h being Element of Funcs(S,S) holds (F.h)*h = F.h
  ex f being ExecutionFunction of A, S, T
  st f|[:S, ElementaryInstructions A:] = g & for C,I being Element of A
  for s being Element of S st not f iteration_terminates_for I\;C, f.(s, C)
  holds f.(s, while(C, I)) = F.((curry' f).(I\;C)).(f.(s,C));

theorem 
  for A being free ECIW-strict preIfWhileAlgebra
  for f1,f2 being ExecutionFunction of A, S, T
  st f1|[:S, ElementaryInstructions A:] = f2|[:S, ElementaryInstructions A:] &
  for s being Element of S for C,I being Element of A
  st not f1 iteration_terminates_for I\;C, f1.(s,C)
  holds f1.(s, while(C,I)) = f2.(s, while(C,I)) holds f1 = f2;

definition
  let A be preIfWhileAlgebra;
  let S be non empty set;
  let T be Subset of S;
  let f be ExecutionFunction of A, S, T;
  func TerminatingPrograms(A,S,T,f) -> Subset of [:S, the carrier of A:] means


   ([:S, ElementaryInstructions A:] c= it & [:S, {EmptyIns A}:] c= it &
  for s being Element of S for C,I,J being Element of A holds
  ([s,I] in it & [f.(s,I), J] in it implies [s, I\;J] in it) &
  ([s,C] in it & [f.(s,C), I] in it & f.(s, C) in T
  implies [s, if-then-else(C,I,J)] in it) &
  ([s,C] in it & [f.(s,C), J] in it & f.(s, C) nin T
  implies [s, if-then-else(C,I,J)] in it) & ([s,C] in it &
  (ex r being non empty FinSequence of S st r.1 = f.(s,C) & r.len r nin T &
  for i being Nat st 1 <= i & i < len r
  holds r.i in T & [r.i, I\;C] in it & r.(i+1) = f.(r.i, I\;C))
  implies [s, while(C,I)] in it) ) &
  for P being Subset of [:S, the carrier of A:] st
  [:S, ElementaryInstructions A:] c= P & [:S, {EmptyIns A}:] c= P &
  for s being Element of S for C,I,J being Element of A holds
  ([s,I] in P & [f.(s,I), J] in P implies [s, I\;J] in P) &
  ([s,C] in P & [f.(s,C), I] in P & f.(s, C) in T
  implies [s, if-then-else(C,I,J)] in P) &
  ([s,C] in P & [f.(s,C), J] in P & f.(s, C) nin T
  implies [s, if-then-else(C,I,J)] in P) & ([s,C] in P &
  (ex r being non empty FinSequence of S st r.1 = f.(s,C) & r.len r nin T &
  for i being Nat st 1 <= i & i < len r
  holds r.i in T & [r.i, I\;C] in P & r.(i+1) = f.(r.i, I\;C))
  implies [s, while(C,I)] in P) holds it c= P;
end;

definition
  let A be preIfWhileAlgebra;
  let I be Element of A;
  attr I is absolutely-terminating means


   for S being non empty set, s being Element of S
  for T being Subset of S for f being ExecutionFunction of A, S, T
  holds [s,I] in TerminatingPrograms(A,S,T,f);
end;

definition
  let A be preIfWhileAlgebra;
  let S be non empty set;
  let T be Subset of S;
  let I be Element of A;
  let f be ExecutionFunction of A, S, T;
  pred I is_terminating_wrt f means


  for s being Element of S holds [s,I] in TerminatingPrograms(A, S, T, f);
end;

definition
  let A be preIfWhileAlgebra;
  let S be non empty set;
  let T be Subset of S;
  let I be Element of A;
  let f be ExecutionFunction of A, S, T;
  let Z be set;
  pred I is_terminating_wrt f, Z means


   for s being Element of S st s in Z
  holds [s,I] in TerminatingPrograms(A, S, T, f);
  pred Z is_invariant_wrt I, f means


   for s being Element of S st s in Z holds f.(s, I) in Z;
end;

theorem 
  I in ElementaryInstructions A implies [s, I] in TerminatingPrograms(A,S,T,f);

theorem 
  I in ElementaryInstructions A implies I is absolutely-terminating;

theorem 
  [s, EmptyIns A] in TerminatingPrograms(A,S,T,f);

registration
  let A;
  cluster EmptyIns A -> absolutely-terminating;
end;

registration
  let A;
  cluster absolutely-terminating for Element of A;
end;

theorem 
  A is free & [s, I\;J] in TerminatingPrograms(A,S,T,f) implies
  [s,I] in TerminatingPrograms(A,S,T,f) &
  [f.(s,I), J] in TerminatingPrograms(A,S,T,f);

registration
  let A;
  let I,J be absolutely-terminating Element of A;
  cluster I\;J -> absolutely-terminating;
end;

theorem 
  A is free & [s, if-then-else(C,I,J)] in TerminatingPrograms(A,S,T,f)
  implies [s,C] in TerminatingPrograms(A,S,T,f) &
  (f.(s,C) in T implies [f.(s,C), I] in TerminatingPrograms(A,S,T,f)) &
  (f.(s,C) nin T implies [f.(s,C), J] in TerminatingPrograms(A,S,T,f));

registration
  let A;
  let C,I,J be absolutely-terminating Element of A;
  cluster if-then-else(C,I,J) -> absolutely-terminating;
end;

registration
  let A;
  let C,I be absolutely-terminating Element of A;
  cluster if-then(C,I) -> absolutely-terminating;
end;

theorem 
  A is free & [s, while(C,I)] in TerminatingPrograms(A,S,T,f)
  implies [s,C] in TerminatingPrograms(A,S,T,f) &
  ex r being non empty FinSequence of S st r.1 = f.(s,C) & r.len r nin T &
  for i being Nat st 1 <= i & i < len r
  holds r.i in T & [r.i, I\;C] in TerminatingPrograms(A,S,T,f) &
  r.(i+1) = f.(r.i, I\;C);

theorem 
  A is free & [s, while(C,I)] in TerminatingPrograms(A,S,T,f) & f.(s,C) in T
  implies [f.(s,C), I] in TerminatingPrograms(A,S,T,f);

theorem 
  for C,I being absolutely-terminating Element of A
  st f iteration_terminates_for I\;C, f.(s,C)
  holds [s, while(C,I)] in TerminatingPrograms(A,S,T,f);

theorem 
  for A being free ECIW-strict preIfWhileAlgebra
  for f1,f2 being ExecutionFunction of A, S, T
  st f1|[:S, ElementaryInstructions A:] = f2|[:S, ElementaryInstructions A:]
  holds TerminatingPrograms(A,S,T,f1) = TerminatingPrograms(A,S,T,f2);

theorem 
  for A being free ECIW-strict preIfWhileAlgebra
  for f1,f2 being ExecutionFunction of A, S, T
  st f1|[:S, ElementaryInstructions A:] = f2|[:S, ElementaryInstructions A:]
  for s being Element of S
  for I being Element of A st [s,I] in TerminatingPrograms(A,S,T,f1)
  holds f1.(s, I) = f2.(s, I);

theorem 
  for I being absolutely-terminating Element of A holds I is_terminating_wrt f;

theorem 
  for I being Element of A holds
  I is_terminating_wrt f iff I is_terminating_wrt f, S;

theorem 
  for I being Element of A st I is_terminating_wrt f
  for P being set holds I is_terminating_wrt f, P;

theorem 
  for I being absolutely-terminating Element of A
  for P being set holds I is_terminating_wrt f, P;

theorem 
  for I being Element of A holds S is_invariant_wrt I, f;

theorem 
  for P being set for I,J being Element of A
  st P is_invariant_wrt I, f & P is_invariant_wrt J, f
  holds P is_invariant_wrt I\;J, f;

theorem 
  for I,J being Element of A st I is_terminating_wrt f & J is_terminating_wrt f
  holds I\;J is_terminating_wrt f;

theorem 
  for P being set for I,J being Element of A
  st I is_terminating_wrt f,P & J is_terminating_wrt f,P &
  P is_invariant_wrt I,f holds I\;J is_terminating_wrt f,P;

theorem 
  for C,I,J being Element of A
  st C is_terminating_wrt f & I is_terminating_wrt f & J is_terminating_wrt f
  holds if-then-else(C,I,J) is_terminating_wrt f;

theorem 
  for P being set for C,I,J being Element of A
  st C is_terminating_wrt f,P & I is_terminating_wrt f,P &
  J is_terminating_wrt f,P & P is_invariant_wrt C,f
  holds if-then-else(C,I,J) is_terminating_wrt f,P;

theorem 
  for C,I being Element of A
  st C is_terminating_wrt f & I is_terminating_wrt f &
  f iteration_terminates_for I\;C, f.(s,C) holds [s, while(C,I)] in
  TerminatingPrograms(A, S, T, f);

theorem 
  for P being set for C,I being Element of A
  st C is_terminating_wrt f,P & I is_terminating_wrt f,P &
  P is_invariant_wrt C,f & P is_invariant_wrt I,f &
  f iteration_terminates_for I\;C, f.(s,C) & s in P holds [s, while(C,I)] in
  TerminatingPrograms(A, S, T, f);

theorem 
  for P being set for C,I being Element of A
  st C is_terminating_wrt f & I is_terminating_wrt f,P &
  P is_invariant_wrt C,f & (for s st s in P & f.(f.(s,I),C) in T
  holds f.(s,I) in P) & f iteration_terminates_for I\;C, f.(s,C) & s in P
  holds [s, while(C,I)] in TerminatingPrograms(A, S, T, f);

theorem 
  for C,I being Element of A
  st C is_terminating_wrt f & I is_terminating_wrt f &
  for s holds f iteration_terminates_for I\;C, s
  holds while(C,I) is_terminating_wrt f;

theorem 
  for P being set for C,I being Element of A
  st C is_terminating_wrt f & I is_terminating_wrt f,P &
  P is_invariant_wrt C,f & (for s st s in P & f.(f.(s,I),C) in T
  holds f.(s,I) in P) &
  for s st f.(s,C) in P holds f iteration_terminates_for I\;C, f.(s,C)
  holds while(C,I) is_terminating_wrt f,P;














begin 

notation
  let x,y be set;
  antonym x c/= y for x c= y;
end;

definition
  mode SubsetFamilyStr is TopStruct;
end;

notation
  let M be SubsetFamilyStr;
  let A be Subset of M;
  synonym A is independent for A is open;
  antonym A is dependent for A is open;
end;

definition
  let M be SubsetFamilyStr;
  func the_family_of M -> Subset-Family of M equals

  the topology of M;
end;

definition
  let M be SubsetFamilyStr;
  let A be Subset of M;
  redefine attr A is independent means


  A in the_family_of M;
end;

definition
  let M be SubsetFamilyStr;
  attr M is subset-closed means


  the_family_of M is subset-closed;
  attr M is with_exchange_property means

  for A,B being finite Subset of M st A
  in the_family_of M & B in the_family_of M & card B = (card A) + 1 ex e being
  Element of M st e in B \ A & A \/ {e} in the_family_of M;
end;

registration
  cluster strict non empty non void finite subset-closed
    with_exchange_property for SubsetFamilyStr;
end;

registration
  let M be non void SubsetFamilyStr;
  cluster independent for Subset of M;
end;

registration
  let M be subset-closed SubsetFamilyStr;
  cluster the_family_of M -> subset-closed;
end;

theorem 
  for M being non void subset-closed SubsetFamilyStr for A being
independent Subset of M for B being set st B c= A holds B is independent Subset
  of M;

registration
  let M be non void subset-closed SubsetFamilyStr;
  cluster finite independent for Subset of M;
end;

definition
  mode Matroid is non empty non void subset-closed with_exchange_property
    SubsetFamilyStr;
end;

theorem 
  for M being subset-closed SubsetFamilyStr holds M is non void iff
  {} in the_family_of M;

registration
  let M be non void subset-closed SubsetFamilyStr;
  cluster empty -> independent for Subset of M;
end;

theorem 
  for M being non void SubsetFamilyStr holds M is subset-closed iff
  for A,B being Subset of M st A is independent & B c= A holds B is independent
;

registration
  let M be non void subset-closed SubsetFamilyStr;
  let A be independent Subset of M;
  let B be set;
  cluster A/\B -> independent for Subset of M;
  cluster B/\A -> independent for Subset of M;
  cluster A\B -> independent for Subset of M;
end;

theorem 
  for M being non void non empty SubsetFamilyStr holds M is
with_exchange_property iff for A,B being finite Subset of M st A is independent
& B is independent & card B = (card A) + 1 ex e being Element of M st e in B \
  A & A \/ {e} is independent;

definition
 canceled;
  let M be SubsetFamilyStr;
  attr M is finite-membered means


  the_family_of M is finite-membered;
end;

definition
  let M be SubsetFamilyStr;
  attr M is finite-degree means


  M is finite-membered & ex n being Nat
  st for A being finite Subset of M st A is independent holds card A <= n;
end;

registration
  cluster finite-degree -> finite-membered for SubsetFamilyStr;
  cluster finite -> finite-degree for SubsetFamilyStr;
end;

begin 

registration
  cluster mutually-disjoint non empty with_non-empty_elements for set;
end;

theorem 
  for A,B being finite set st card A < card B ex x being set st x in B \ A;

theorem 
  for P being mutually-disjoint with_non-empty_elements non empty set
  for f being Choice_Function of P holds f is one-to-one;

registration
  cluster -> non void subset-closed with_exchange_property for discrete
    SubsetFamilyStr;
end;

theorem 
  for T being non empty discrete TopStruct holds T is Matroid;

definition
  let P be set;
  func ProdMatroid P -> strict SubsetFamilyStr means


  the carrier of it
= union P & the_family_of it = {A where A is Subset of union P: for D being set
  st D in P ex d being set st A /\ D c= {d}};
end;

registration
  let P be non empty with_non-empty_elements set;
  cluster ProdMatroid P -> non empty;
end;

theorem 
  for P being set for A being Subset of ProdMatroid P holds A is
independent iff for D being Element of P ex d being Element of D st A /\ D c= {
  d};

registration
  let P be set;
  cluster ProdMatroid P -> non void subset-closed;
end;

theorem 
  for P being mutually-disjoint set for x being Subset of
  ProdMatroid P ex f being Function of x,P st for a being set st a in x holds a
  in f.a;

theorem 
  for P being mutually-disjoint set for x being Subset of
ProdMatroid P for f being Function of x,P st for a being set st a in x holds a
  in f.a holds x is independent iff f is one-to-one;

registration
  let P be mutually-disjoint set;
  cluster ProdMatroid P -> with_exchange_property;
end;

registration
  let X be finite set;
  let P be Subset of bool X;
  cluster ProdMatroid P -> finite;
end;

registration
  let X be set;
  cluster -> mutually-disjoint for a_partition of X;
end;

registration
  cluster finite strict for Matroid;
end;

registration
  let M be finite-membered non void SubsetFamilyStr;
  cluster -> finite for independent Subset of M;
end;

definition
  let F be Field;
  let V be VectSp of F;
  func LinearlyIndependentSubsets V -> strict SubsetFamilyStr means


  the
carrier of it = the carrier of V & the_family_of it = {A where A is Subset of V
  : A is linearly-independent};
end;

registration
  let F be Field;
  let V be VectSp of F;
  cluster LinearlyIndependentSubsets V -> non empty non void subset-closed;
end;

theorem 
  for F being Field, V being VectSp of F for A being Subset of
  LinearlyIndependentSubsets V holds A is independent iff A is
  linearly-independent Subset of V;

theorem 
  for F being Field for V being VectSp of F for A, B being finite Subset
  of V st B c= A for v being Vector of V st v in Lin(A) & not v in Lin(B) holds
  ex w being Vector of V st w in A\B & w in Lin(A \ {w} \/ {v});

theorem 
  for F being Field, V being VectSp of F for A being Subset of V
  st A is linearly-independent for a being Element of V st a nin the carrier of
  Lin A holds A\/{a} is linearly-independent;

registration
  let F be Field;
  let V be VectSp of F;
  cluster LinearlyIndependentSubsets V -> with_exchange_property;
end;

registration
  let F be Field;
  let V be finite-dimensional VectSp of F;
  cluster LinearlyIndependentSubsets V -> finite-membered;
end;

begin 

definition
  let M be SubsetFamilyStr;
  let A,C be Subset of M;
  pred A is_maximal_independent_in C means


  A is independent & A c= C &
  for B being Subset of M st B is independent & B c= C & A c= B holds A = B;
end;

theorem 
  for M being non void finite-degree SubsetFamilyStr for C,A being
Subset of M st A c= C & A is independent ex B being independent Subset of M st
  A c= B & B is_maximal_independent_in C;

theorem 
  for M being non void finite-degree subset-closed SubsetFamilyStr for C
  being Subset of M ex A being independent Subset of M st A
  is_maximal_independent_in C;

theorem 
  for M being non empty non void subset-closed finite-degree
  SubsetFamilyStr holds M is Matroid iff for C being Subset of M, A,B being
  independent Subset of M st A is_maximal_independent_in C & B
  is_maximal_independent_in C holds card A = card B;

definition
  let M be finite-degree Matroid;
  let C be Subset of M;
  func Rnk C -> Nat equals

  union {card A where A is independent Subset of M: A
  c= C};
end;

theorem 
  for M being finite-degree Matroid for C being Subset of M for A
  being independent Subset of M st A c= C holds card A <= Rnk C;

theorem 
  for M being finite-degree Matroid for C being Subset of M ex A
  being independent Subset of M st A c= C & card A = Rnk C;

theorem 
  for M being finite-degree Matroid for C being Subset of M for A
being independent Subset of M holds A is_maximal_independent_in C iff A c= C &
  card A = Rnk C;

theorem 
  for M being finite-degree Matroid for C being finite Subset of M
  holds Rnk C <= card C;

theorem 
  for M being finite-degree Matroid for C being finite Subset of M
  holds C is independent iff card C = Rnk C;

definition
  let M be finite-degree Matroid;
  func Rnk M -> Nat equals

  Rnk [#]M;
end;

definition
  let M be non void finite-degree SubsetFamilyStr;
  mode Basis of M -> independent Subset of M means


    it is_maximal_independent_in [#]M;
end;

theorem 
  for M being finite-degree Matroid for B1,B2 being Basis of M holds
  card B1 = card B2;

theorem 
  for M being finite-degree Matroid for A being independent Subset of M
  ex B being Basis of M st A c= B;

reserve M for finite-degree Matroid,
  A,B,C for Subset of M,
  e,f for Element of M;

theorem 
  A c= B implies Rnk A <= Rnk B;

theorem 
  Rnk (A\/B) + Rnk (A/\B) <= Rnk A + Rnk B;

theorem 
  Rnk A <= Rnk (A\/B) & Rnk (A \/ {e}) <= Rnk A + 1;

theorem 
  Rnk (A\/{e}) = Rnk (A\/{f}) & Rnk (A\/{f}) = Rnk A implies Rnk (A \/ {
  e,f}) = Rnk A;

begin 

definition
  let M be finite-degree Matroid;
  let e be Element of M;
  let A be Subset of M;
  pred e is_dependent_on A means


  Rnk (A \/ {e}) = Rnk A;
end;

theorem 
  e in A implies e is_dependent_on A;

theorem 
  A c= B & e is_dependent_on A implies e is_dependent_on B;

definition
  let M be finite-degree Matroid;
  let A be Subset of M;
  func Span A -> Subset of M equals

  {e where e is Element of M: e
  is_dependent_on A};
end;

theorem 
  e in Span A iff Rnk (A \/ {e}) = Rnk A;

theorem 
  A c= Span A;

theorem 
  A c= B implies Span A c= Span B;

theorem 
  Rnk Span A = Rnk A;

theorem 
  e is_dependent_on Span A implies e is_dependent_on A;

theorem 
  Span Span A = Span A;

theorem 
  f nin Span A & f in Span (A \/ {e}) implies e in Span (A \/ {f});

definition
  let M be SubsetFamilyStr;
  let A be Subset of M;
  attr A is cycle means


  A is dependent & for e being Element of M st e
  in A holds A \ {e} is independent;
end;

theorem 
  A is cycle implies A is non empty finite;

registration
  let M;
  cluster cycle -> non empty finite for Subset of M;
end;

theorem 
  A is cycle iff A is non empty & for e st e in A holds A\{e}
  is_maximal_independent_in A;

theorem 
  A is cycle implies Rnk A + 1 = card A;

theorem 
  A is cycle & e in A implies e is_dependent_on A\{e};

theorem 
  A is cycle & B is cycle & A c= B implies A = B;

theorem 
  (for B st B c= A holds B is not cycle) implies A is independent;

theorem 
  A is cycle & B is cycle & A <> B & e in A /\ B implies ex C st C
  is cycle & C c= (A \/ B) \ {e};

theorem 
  A is independent & B is cycle & C is cycle & B c= A\/{e} & C c= A\/{e}
  implies B = C;














begin 

theorem 
  for g being Function, x being set st dom g = {x} holds g = x .--> g.x;

theorem 
  for n being Nat holds n c= n+1;

scheme 
 FinSegRng2{m, n() -> Element of NAT, F(set)->set, P[set]}:
  {F(i) where i is Element of NAT : m()<i & i<=n() & P[i]} is finite;

theorem 
  for X being infinite set ex f being Function of NAT, X st f is one-to-one;

definition
  let R be RelStr, f be sequence of R;
  attr f is ascending means

  for n being Element of NAT
  holds f.(n+1) <> f.n & [f.n, f.(n+1)] in the InternalRel of R;
end;

definition
  let R be RelStr, f be sequence of R;
  attr f is weakly-ascending means


  for n being Element of NAT holds [f.n, f.(n+1)] in the InternalRel of R;
end;

theorem 
  for R being non empty transitive RelStr, f being sequence of R
  st f is weakly-ascending
  holds for i,j being Element of NAT st i < j holds f.i <= f.j;

theorem 
  for R being non empty RelStr holds R is connected iff
  the InternalRel of R is_strongly_connected_in the carrier of R;

theorem 
  for L being RelStr, Y being set, a being set
  holds (the InternalRel of L)-Seg(a) misses Y & a in Y iff
  a is_minimal_wrt Y, the InternalRel of L;

theorem 
  for L being non empty transitive antisymmetric RelStr,
  x being Element of L, a, N being set
  st a is_minimal_wrt (the InternalRel of L)-Seg(x) /\ N,(the InternalRel of L)
  holds a is_minimal_wrt N, (the InternalRel of L);

begin 

definition
  let R be RelStr; 
  attr R is quasi_ordered means


  R is reflexive transitive;
end;

definition 
  let R be RelStr such that
 R is quasi_ordered;
  func EqRel R -> Equivalence_Relation of the carrier of R equals


  (the InternalRel of R) /\ (the InternalRel of R)~;
end;

theorem 
  for R being RelStr, x,y being Element of R
  st R is quasi_ordered holds x in Class(EqRel R, y) iff x <= y & y <= x;

definition 
  let R be RelStr;
  func <=E R -> Relation of Class EqRel R means


  for A, B being set holds [A,B] in it iff ex a, b being Element of R
  st A = Class(EqRel R, a) & B = Class(EqRel R, b) & a <= b;
end;

theorem 
  for R being RelStr
  st R is quasi_ordered holds <=E R partially_orders Class(EqRel R);

theorem 
  for R being non empty RelStr st R is quasi_ordered & R is connected
  holds <=E R linearly_orders Class(EqRel R);

definition 
  let R be Relation;
  func R\~ -> Relation equals

  R \ R~;
end;

registration
  let R be Relation;
  cluster R \~ -> asymmetric;
end;

definition
  let X be set, R be Relation of X;
  redefine func R\~ -> Relation of X;
end;

definition
  let R be RelStr;
  func R\~ -> strict RelStr equals

  RelStr(# the carrier of R, (the InternalRel of R)\~ #);
end;

registration
  let R be non empty RelStr;
  cluster R\~ -> non empty;
end;

registration
  let R be transitive RelStr;
  cluster R\~ -> transitive;
end;

registration
  let R be RelStr;
  cluster R\~ -> antisymmetric;
end;

theorem 
  for R being non empty Poset, x being Element of R
  holds Class(EqRel R, x) = {x};

theorem 
  for R being Relation holds R = R\~ iff R is asymmetric;

theorem 
  for R being Relation st R is transitive holds R\~ is transitive;

theorem 
  for R being Relation, a, b being set st R is antisymmetric
  holds [a,b] in R\~ iff [a,b] in R & a <> b;

theorem 
  for R being RelStr st R is well_founded holds R\~ is well_founded;

theorem 
  for R being RelStr
  st R\~ is well_founded & R is antisymmetric holds R is well_founded;

begin 

theorem 
  for L being RelStr, N being set, x being Element of L\~
  holds x is_minimal_wrt N, the InternalRel of (L\~) iff (x in N &
  for y being Element of L st y in N & [y,x] in the InternalRel of L
  holds [x,y] in the InternalRel of L);




theorem 
  for R, S being non empty RelStr, m being Function of R,S
  st R is quasi_ordered & S is antisymmetric & S\~ is well_founded &
  for a,b being Element of R holds
  (a <= b implies m.a <= m.b) & (m.a = m.b implies [a,b] in EqRel R)
  holds R\~ is well_founded;

definition 
  let R be non empty RelStr, N be Subset of R;
  func min-classes N -> Subset-Family of R means


  for x being set holds x in it iff ex y being Element of R\~
  st y is_minimal_wrt N, the InternalRel of (R\~) & x = Class(EqRel R,y) /\ N;
end;

theorem 
  for R being non empty RelStr, N being Subset of R, x being set
  st R is quasi_ordered & x in min-classes N
  holds for y being Element of R\~ st y in x
  holds y is_minimal_wrt N, the InternalRel of R\~;

theorem 
  for R being non empty RelStr holds R\~ is well_founded iff
  for N being Subset of R st N <> {} ex x being set st x in min-classes N;

theorem 
  for R being non empty RelStr, N being Subset of R, y being Element of R\~
  st y is_minimal_wrt N, the InternalRel of (R\~)
  holds min-classes N is non empty;

theorem 
  for R being non empty RelStr, N being Subset of R, x being set st
  x in min-classes N holds x is non empty;

theorem 
  for R being non empty RelStr st R is quasi_ordered
  holds R is connected & R\~ is well_founded iff
  for N being non empty Subset of R holds card min-classes N = 1;

theorem 
  for R being non empty Poset
  holds the InternalRel of R well_orders the carrier of R iff
  for N being non empty Subset of R holds card min-classes N = 1;

definition 
  let R be RelStr, N be Subset of R, B be set;
  pred B is_Dickson-basis_of N,R means


  B c= N & for a being Element of R st a in N
  ex b being Element of R st b in B & b <= a;
end;

theorem 
  for R being RelStr holds {} is_Dickson-basis_of {} the carrier of R, R;

theorem 
  for R being non empty RelStr, N being non empty Subset of R, B being set
  st B is_Dickson-basis_of N,R holds B is non empty;

definition 
  let R be RelStr;
  attr R is Dickson means


  for N being Subset of R
  ex B being set st B is_Dickson-basis_of N,R & B is finite;
end;

theorem 
  for R being non empty RelStr
  st R\~ is well_founded & R is connected holds R is Dickson;

theorem 
  for R, S being RelStr st (the InternalRel of R) c= (the InternalRel of S) &
  R is Dickson & (the carrier of R) = (the carrier of S) holds S is Dickson;

definition
  let f be Function, b be set such that
 dom f = NAT and
 b in rng f;
  func f mindex b -> Element of NAT means


  f.it = b & for i being Element of NAT st f.i = b holds it <= i;
end;

definition
  let R be non empty 1-sorted, f be sequence of R, b be set,
  m be Element of NAT;
  assume
 ex j being Element of NAT st m < j & f.j = b;
  func f mindex (b,m) -> Element of NAT means


  f.it = b & m < it & for i being Element of NAT st m < i & f.i = b
  holds it <= i;
end;

theorem 
  for R being non empty RelStr st R is Dickson
  for f being sequence of R ex i,j being Element of NAT st i < j & f.i <= f.j;

theorem 
  for R being RelStr, N being Subset of R, x being Element of R\~
  st R is quasi_ordered & x in N &
  ((the InternalRel of R)-Seg(x)) /\ N c= Class(EqRel R,x)
  holds x is_minimal_wrt N, the InternalRel of R\~;

theorem 
  for R being non empty RelStr st R is quasi_ordered &
  (for f being sequence of R
  ex i,j being Element of NAT st i < j & f.i <= f.j)
  holds for N being non empty Subset of R
  holds min-classes N is finite & min-classes N is non empty;

theorem 
  for R being non empty RelStr st R is quasi_ordered &
  (for N being non empty Subset of R
  holds min-classes N is finite & min-classes N is non empty)
  holds R is Dickson;

theorem 
  for R being non empty RelStr st R is quasi_ordered & R is Dickson
  holds R\~ is well_founded;

theorem 
  for R being non empty Poset, N being non empty Subset of R st R is Dickson
  holds ex B being set st B is_Dickson-basis_of N, R &
  for C being set st C is_Dickson-basis_of N, R holds B c= C;

definition
  let R be non empty RelStr, N be Subset of R such that
 R is Dickson;
  func Dickson-bases (N,R) -> non empty Subset-Family of R means


  for B being set holds B in it iff B is_Dickson-basis_of N,R;
end;

theorem 
  for R being non empty RelStr, s being sequence of R st R is Dickson
  ex t being sequence of R st t is subsequence of s & t is weakly-ascending;

theorem 
  for R being RelStr st R is empty holds R is Dickson;

theorem 
  for M, N be RelStr
  st M is Dickson & N is Dickson & M is quasi_ordered & N is quasi_ordered
  holds [:M,N:] is quasi_ordered & [:M,N:] is Dickson;

theorem 
for R, S being RelStr st R,S are_isomorphic & R is Dickson & R is quasi_ordered
  holds S is quasi_ordered & S is Dickson;

theorem 
  for p being RelStr-yielding ManySortedSet of 1, z being Element of 1
  holds p.z, product p are_isomorphic;

registration
  let X be set, p be RelStr-yielding ManySortedSet of X, Y be Subset of X;
  cluster p|Y -> RelStr-yielding;
end;

theorem 
  for n being non empty Nat, p being RelStr-yielding ManySortedSet of n
  holds product p is non empty iff p is non-Empty;

theorem 
  for n being non empty Nat, p being RelStr-yielding ManySortedSet of n+1,
  ns being Subset of n+1, ne being Element of n+1
  st ns = n & ne = n holds [:product(p|ns), p.ne:], product p are_isomorphic;

theorem 
  for n being non empty Nat, p being RelStr-yielding ManySortedSet of n
  st for i being Element of n holds p.i is Dickson & p.i is quasi_ordered
  holds product p is quasi_ordered & product p is Dickson;

registration
  let p be RelStr-yielding ManySortedSet of {};
  cluster product p -> non empty;
  cluster product p -> antisymmetric;
  cluster product p -> quasi_ordered;:$N Dickson Lemma
  cluster product p -> Dickson;
end;

definition
  func NATOrd -> Relation of NAT equals

  {[x,y] where x, y is Element of NAT : x <= y};
end;

theorem 
  NATOrd is_reflexive_in NAT;

theorem 
  NATOrd is_antisymmetric_in NAT;

theorem 
  NATOrd is_strongly_connected_in NAT;

theorem 
  NATOrd is_transitive_in NAT;

definition
  func OrderedNAT -> non empty RelStr equals

  RelStr(# NAT, NATOrd #);
end;

registration
  cluster OrderedNAT -> connected;
  cluster OrderedNAT -> Dickson;
  cluster OrderedNAT -> quasi_ordered;
  cluster OrderedNAT -> antisymmetric;
  cluster OrderedNAT -> transitive;
  cluster OrderedNAT -> well_founded;
end;

registration 
  let n be Element of NAT;
  cluster product (n --> OrderedNAT) -> non empty;
  cluster product (n --> OrderedNAT) -> Dickson;
  cluster product (n --> OrderedNAT) -> quasi_ordered;
  cluster product (n --> OrderedNAT) -> antisymmetric;
end;

theorem 
 
  for M be RelStr st M is Dickson & M is quasi_ordered
  holds [:M,OrderedNAT:] is quasi_ordered & [:M,OrderedNAT:] is Dickson;



theorem 
  for R, S being non empty RelStr st R is Dickson & S is quasi_ordered &
  the InternalRel of R c= the InternalRel of S &
  (the carrier of R) = (the carrier of S) holds S\~ is well_founded;

theorem 
  for R being non empty RelStr st R is quasi_ordered holds R is Dickson iff
  for S being non empty RelStr
  st S is quasi_ordered & the InternalRel of R c= the InternalRel of S &
  the carrier of R = the carrier of S holds S\~ is well_founded;














begin

theorem 
  for L being unital associative non empty multMagma, a being Element of L,
    n,m being Element of NAT holds
  power(L).(a,n+m) = power(L).(a,n) * power(L).(a,m);

registration
  cluster Abelian right_zeroed add-associative right_complementable
    well-unital distributive commutative associative for non trivial
    doubleLoopStr;
end;

begin 

theorem 
  for p being FinSequence, k being Element of NAT st k in dom p for
  i being Element of NAT st 1 <= i & i <= k holds i in dom p;

theorem 
  for L being left_zeroed right_zeroed non empty addLoopStr, p
  being FinSequence of the carrier of L, i being Element of NAT st i in dom p &
  for i9 being Element of NAT st i9 in dom p & i9 <> i holds p/.i9 = 0.L holds
  Sum p = p/.i;

theorem 
  for L being add-associative right_zeroed right_complementable
distributive well-unital non empty doubleLoopStr, p being FinSequence of the
  carrier of L st ex i being Element of NAT st i in dom p & p/.i = 0.L holds
  Product p = 0.L;

theorem 
  for L being Abelian add-associative non empty addLoopStr, a
being Element of L, p,q being FinSequence of the carrier of L st len p = len q
  & ex i being Element of NAT st i in dom p & q/.i = a + p/.i & for i9 being
  Element of NAT st i9 in dom p & i9 <> i holds q/.i9 = p/.i9 holds Sum q = a +
  Sum p;

theorem 
  for L being commutative associative non empty doubleLoopStr, a
being Element of L, p,q being FinSequence of the carrier of L st len p = len q
  & ex i being Element of NAT st i in dom p & q/.i = a * p/.i & for i9 being
Element of NAT st i9 in dom p & i9 <> i holds q/.i9 = p/.i9 holds Product q = a
  * Product p;

theorem 
  for X being set, A being empty Subset of X, R being Order of X st
  R linearly_orders A holds SgmX(R,A) = {};

theorem 
  for X being set, A being finite Subset of X, R be Order of X st
R linearly_orders A for i,j being Element of NAT st i in dom(SgmX(R,A)) & j in
  dom(SgmX(R,A)) holds SgmX(R,A)/.i = SgmX(R,A)/.j implies i = j;

theorem 
  for X being set, A being finite Subset of X, a being Element of
  X st not a in A for B being finite Subset of X st B = {a} \/ A for R being
Order of X st R linearly_orders B for k being Element of NAT st k in dom(SgmX(R
,B)) & SgmX(R,B)/.k = a for i being Element of NAT st 1 <= i & i <= k - 1 holds
  SgmX(R,B)/.i = SgmX(R,A)/.i;

theorem 
  for X being set, A being finite Subset of X, a being Element of
  X st not a in A for B being finite Subset of X st B = {a} \/ A for R being
Order of X st R linearly_orders B for k being Element of NAT st k in dom(SgmX(R
,B)) & SgmX(R,B)/.k = a for i being Element of NAT st k <= i & i <= len(SgmX(R,
  A)) holds SgmX(R,B)/.(i+1) = SgmX(R,A)/.i;

theorem 
  for X being non empty set, A being finite Subset of X, a being
Element of X st not a in A for B being finite Subset of X st B = {a} \/ A for R
being Order of X st R linearly_orders B for k being Element of NAT st k + 1 in
  dom(SgmX(R,B)) & SgmX(R,B)/.(k+1) = a holds SgmX(R,B) = Ins(SgmX(R,A),k,a);

begin 

theorem 
  for X being set, b being bag of X st support b = {} holds b = EmptyBag X;

definition
  let X be set, b be bag of X;
  attr b is empty means


  b = EmptyBag X;
end;

registration
  let X be non empty set;
  cluster non empty for bag of X;
end;

definition
  let X be set, b be bag of X;
  redefine func support b -> finite Subset of X;
end;

theorem 
  for n being Ordinal, b being bag of n holds RelIncl n
  linearly_orders support b;

definition
  let X be set;
  let x be FinSequence of X, b be bag of X;
  redefine func b * x -> PartFunc of NAT,NAT;
end;

definition
  let n be Ordinal, b be bag of n, L be well-unital non trivial
  doubleLoopStr, x be Function of n, L;
  func eval(b,x) -> Element of L means


  ex y being FinSequence of the carrier of L st
  len y = len SgmX(RelIncl n, support b) & it = Product y &
  for i being Element of NAT st 1 <= i & i <= len y holds
  y/.i = power(L).((x * SgmX(RelIncl n, support b))/.i,
          (b * SgmX(RelIncl n, support b))/.i);
end;

theorem 
  for n being Ordinal, L being well-unital non trivial
  doubleLoopStr, x being Function of n, L holds eval(EmptyBag n,x) = 1.L;

theorem 
  for n being Ordinal, L being well-unital non trivial
  doubleLoopStr, u being set, b being bag of n st support b = {u} for x being
  Function of n, L holds eval(b,x) = power(L).(x.u,b.u);

theorem 
  for n being Ordinal, L being right_zeroed add-associative
  right_complementable well-unital distributive Abelian non trivial commutative
  associative non empty doubleLoopStr, b1,b2 being bag of n, x being Function
  of n, L holds eval(b1+b2,x) = eval(b1,x) * eval(b2,x);

begin 

registration
  let n be Ordinal, L be add-associative right_zeroed right_complementable
  non empty addLoopStr, p,q be Polynomial of n, L;
  cluster p - q -> finite-Support;
end;

theorem 
  for L being right_zeroed add-associative right_complementable
well-unital distributive non trivial doubleLoopStr, n being Ordinal
  , p being Polynomial of n,L st Support p = {} holds p = 0_(n,L);

registration
  let n be Ordinal, L be right_zeroed add-associative right_complementable
well-unital distributive non trivial doubleLoopStr, p be Polynomial
  of n,L;
  cluster Support p -> finite;
end;

theorem 
  for n being Ordinal, L being right_zeroed add-associative
  right_complementable well-unital distributive non trivial
  doubleLoopStr, p being Polynomial of n,L holds BagOrder n linearly_orders
  Support p;

definition
  let n be Ordinal, b be Element of Bags n;
  func b@ -> bag of n equals

  b;
end;

definition
  let n be Ordinal, L be right_zeroed add-associative right_complementable
well-unital distributive non trivial doubleLoopStr, p be Polynomial
  of n,L, x be Function of n, L;
  func eval(p,x) -> Element of L means


  ex y being FinSequence of the
  carrier of L st len y = len SgmX(BagOrder n, Support p) & it = Sum y & for i
being Element of NAT st 1 <= i & i <= len y holds y/.i = (p * SgmX(BagOrder n,
  Support p))/.i * eval(((SgmX(BagOrder n, Support p))/.i)@,x);
end;

theorem 
  for n being Ordinal, L being right_zeroed add-associative
  right_complementable well-unital distributive non trivial
doubleLoopStr, p being Polynomial of n,L, b being bag of n st Support p = {b}
  for x being Function of n, L holds eval(p,x) = p.b * eval(b,x);

theorem 
  for n being Ordinal, L being right_zeroed add-associative
  right_complementable well-unital distributive non trivial
  doubleLoopStr, x being Function of n, L holds eval(0_(n,L),x) = 0.L;

theorem 
  for n being Ordinal, L being right_zeroed add-associative
  right_complementable well-unital distributive non trivial
  doubleLoopStr, x being Function of n, L holds eval(1_(n,L),x) = 1.L;

theorem 
  for n being Ordinal, L being right_zeroed add-associative
  right_complementable well-unital distributive non trivial
doubleLoopStr, p being Polynomial of n,L, x being Function of n, L holds eval(
  -p,x) = - eval(p,x);

theorem 
  for n being Ordinal, L being right_zeroed add-associative
  right_complementable Abelian well-unital distributive non trivial
  doubleLoopStr, p,q being Polynomial of n,L, x being Function of n, L holds
  eval(p+q,x) = eval(p,x) + eval(q,x);

theorem 
  for n being Ordinal, L being right_zeroed add-associative
  right_complementable Abelian well-unital distributive non trivial
  doubleLoopStr, p,q being Polynomial of n,L, x being Function of n, L holds
  eval(p-q,x) = eval(p,x) - eval(q,x);

theorem 
  for n being Ordinal, L being right_zeroed add-associative
  right_complementable Abelian well-unital distributive non trivial commutative
  associative non empty doubleLoopStr, p,q being Polynomial of n,L, x being
  Function of n, L holds eval(p*'q,x) = eval(p,x) * eval(q,x);

begin 

definition
  let n be Ordinal, L be right_zeroed add-associative right_complementable
  well-unital distributive non trivial doubleLoopStr, x be Function
  of n, L;
  func Polynom-Evaluation(n,L,x) -> Function of Polynom-Ring(n,L),L means


   for p being Polynomial of n,L holds it.p = eval(p,x);
end;

registration
  let n be Ordinal, L be right_zeroed Abelian add-associative
  right_complementable well-unital distributive associative non trivial non
  empty doubleLoopStr;
  cluster Polynom-Ring (n, L) -> well-unital;
end;

registration
  let n be Ordinal, L be Abelian right_zeroed add-associative
  right_complementable well-unital distributive associative non trivial non
  empty doubleLoopStr, x be Function of n, L;
  cluster Polynom-Evaluation(n,L,x) -> unity-preserving;
end;

registration
  let n be Ordinal, L be right_zeroed add-associative right_complementable
  Abelian well-unital distributive non trivial doubleLoopStr, x be
  Function of n, L;
  cluster Polynom-Evaluation(n,L,x) -> additive;
end;

registration
  let n be Ordinal, L be right_zeroed add-associative right_complementable
Abelian well-unital distributive commutative associative non trivial
  doubleLoopStr, x be Function of n, L;
  cluster Polynom-Evaluation(n,L,x) -> multiplicative;
end;

registration
  let n be Ordinal, L be right_zeroed add-associative right_complementable
Abelian well-unital distributive commutative associative non trivial
  doubleLoopStr, x be Function of n, L;
  cluster Polynom-Evaluation(n,L,x) -> RingHomomorphism;
end;














begin  

theorem 
  for L be add-associative right_zeroed right_complementable non
empty addLoopStr for p be FinSequence of the carrier of L st for i be Element
  of NAT st i in dom p holds p.i = 0.L holds Sum p = 0.L;

theorem 
  for V be Abelian add-associative right_zeroed non empty
  addLoopStr for p be FinSequence of the carrier of V holds Sum p = Sum Rev p;

theorem 
  for p be FinSequence of REAL holds Sum p = Sum Rev p;

theorem 
  for p be FinSequence of NAT for i be Element of NAT st i in dom p
  holds Sum p >= p.i;

definition
  let D be non empty set;
  let i be Element of NAT;
  let p be FinSequence of D;
  redefine func Del(p,i) -> FinSequence of D;
end;

definition
  let D be non empty set;
  let a,b be Element of D;
  redefine func <*a,b*> -> Element of 2-tuples_on D;
end;

definition
  let D be non empty set;
  let k,n be Element of NAT;
  let p be Element of k-tuples_on D;
  let q be Element of n-tuples_on D;
  redefine func p^q -> Element of (k+n)-tuples_on D;
end;

definition
  let D be non empty set;
  let k,n be Element of NAT;
  let p be FinSequence of (k-tuples_on D);
  let q be FinSequence of (n-tuples_on D);
  redefine func p ^^ q -> Element of ((k+n)-tuples_on D)*;
end;

scheme 

  SeqOfSeqLambdaD{D()->non empty set,A()->Element of NAT, T(Element of NAT)->
Element of NAT, F(set,set)->Element of D()}:
   ex p be FinSequence of D()* st len
p = A() & for k be Element of NAT st k in Seg A() holds len (p/.k) = T(k) & for
  n be Element of NAT st n in dom (p/.k) holds (p/.k).n = F(k,n);

begin  

definition
  let n be Element of NAT;
  let p,q be Element of n-tuples_on NAT;
  pred p < q means


  ex i be Element of NAT st i in Seg n & p.i < q.i &
  for k be Element of NAT st 1 <= k & k < i holds p.k = q.k;
  asymmetry;
end;

notation
  let n be Element of NAT;
  let p,q be Element of n-tuples_on NAT;
  synonym q > p for p < q;
end;

definition
  let n be Element of NAT;
  let p,q be Element of n-tuples_on NAT;
  pred p <= q means


  p < q or p = q;
  reflexivity;
end;

notation
  let n be Element of NAT;
  let p,q be Element of n-tuples_on NAT;
  synonym q >= p for p <= q;
end;

theorem 
  for n be Element of NAT for p,q,r be Element of n-tuples_on NAT
  holds (p < q & q < r implies p < r) & ( p < q & q <= r or p <= q & q < r or p
  <= q & q <= r implies p <= r);

theorem 
  for n be Element of NAT for p,q be Element of n-tuples_on NAT
holds p <> q implies ex i be Element of NAT st i in Seg n & p.i <> q.i & for k
  be Element of NAT st 1 <= k & k < i holds p.k = q.k;

theorem 
  for n be Element of NAT for p,q be Element of n-tuples_on NAT
  holds p <= q or p > q;

definition
  let n be Element of NAT;
  func TuplesOrder n -> Order of n-tuples_on NAT means


  for p,q be Element of n-tuples_on NAT holds [p,q] in it iff p <= q;
end;

registration
  let n be Element of NAT;
  cluster TuplesOrder n -> being_linear-order;
end;

begin  

definition
  let i be non empty Element of NAT;
  let n be Element of NAT;
  func Decomp(n,i) -> FinSequence of i-tuples_on NAT means


  ex A be
  finite Subset of i-tuples_on NAT st it = SgmX (TuplesOrder i,A) & for p be
  Element of i-tuples_on NAT holds p in A iff Sum p = n;
end;

registration
  let i be non empty Element of NAT;
  let n be Element of NAT;
  cluster Decomp(n,i) -> non empty one-to-one FinSequence-yielding;
end;

theorem 
  for n be Element of NAT holds len Decomp(n,1) = 1;

theorem 
  for n be Element of NAT holds len Decomp(n,2) = n+1;

theorem 
  for n be Element of NAT holds Decomp(n,1) = <*<*n*>*>;

theorem 
  for i,j,n,k1,k2 be Element of NAT st Decomp(n,2).i = <*k1,n-'k1
  *> & Decomp(n,2).j = <*k2,n-'k2*> holds i<j iff k1<k2;

theorem 
  for i,n,k1,k2 be Element of NAT st Decomp(n,2).i = <*k1,n-'k1*>
  & Decomp(n,2).(i+1) = <*k2,n-'k2*> holds k2=k1+1;

theorem 
  for n be Element of NAT holds Decomp(n,2).1 = <*0,n*>;

theorem 
  for n,i be Element of NAT st i in Seg (n+1) holds Decomp(n,2).i
  = <*i-'1,n+1-'i*>;

definition
  let L be non empty multMagma;
  let p,q,r be sequence of L;
  let t be FinSequence of 3-tuples_on NAT;
  func prodTuples(p,q,r,t) -> Element of (the carrier of L)* means


  len
it = len t & for k be Element of NAT st k in dom t holds it.k = (p.((t/.k)/.1))
  *(q.((t/.k)/.2))*(r.((t/.k)/.3));
end;

theorem 
  for L be non empty multMagma for p,q,r be sequence of L for t be
  FinSequence of 3-tuples_on NAT for P be Permutation of dom t for t1 be
  FinSequence of 3-tuples_on NAT st t1 = t*P holds prodTuples(p,q,r,t1) =
  prodTuples(p,q,r,t)*P;

theorem 
  for D be set for f be FinSequence of D* for i be Element of NAT
  holds Card (f|i) = (Card f)|i;

theorem 
  for p be FinSequence of REAL for q be FinSequence of NAT st p=q for i
  be Element of NAT holds p|i = q|i;

theorem 
  for p be FinSequence of NAT for i,j be Element of NAT st i <= j
  holds Sum (p|i) <= Sum (p|j);

theorem 
  for D being set, p be FinSequence of D for i be Element of NAT st i <
  len p holds p|(i+1) = p|i ^ <*p.(i+1)*>;

theorem 
  for p be FinSequence of REAL for i be Element of NAT st i < len
  p holds Sum (p|(i+1)) = Sum (p|i) + p.(i+1);

theorem 
  for p be FinSequence of NAT for i,j,k1,k2 be Element of NAT st i
< len p & j < len p & 1 <= k1 & 1 <= k2 & k1 <= p.(i+1) & k2 <= p.(j+1) & (Sum
  (p|i)) + k1 = (Sum (p|j)) + k2 holds i = j & k1 = k2;

theorem 
  for D1,D2 be set for f1 be FinSequence of D1* for f2 be
  FinSequence of D2* for i1,i2,j1,j2 be Element of NAT st i1 in dom f1 & i2 in
  dom f2 & j1 in dom (f1.i1) & j2 in dom (f2.i2) & Card f1 = Card f2 & (Sum ((
  Card f1)|(i1-'1))) + j1 = (Sum ((Card f2)|(i2-'1))) + j2 holds i1 = i2 & j1 =
  j2;

begin  

definition
  let L be non empty ZeroStr;
  mode Polynomial of L is AlgSequence of L;
end;

theorem 
  for L be non empty ZeroStr for p be Polynomial of L for n be
  Element of NAT holds n >= len p iff n is_at_least_length_of p;

scheme 

  PolynomialLambdaF{R()->non empty addLoopStr, A()->Element of NAT, F(Element
of NAT)->Element of R()}: ex p be Polynomial of R() st len p <= A() & for n be
  Element of NAT st n < A() holds p.n=F(n);

registration
  let L be right_zeroed non empty addLoopStr;
  let p,q be Polynomial of L;
  cluster p+q -> finite-Support;
end;

theorem 
  for L be right_zeroed non empty addLoopStr for p,q be
  Polynomial of L for n be Element of NAT holds (n is_at_least_length_of p & n
  is_at_least_length_of q) implies n is_at_least_length_of p+q;

theorem 
  for L be right_zeroed non empty addLoopStr for p,q be Polynomial of
  L holds support (p+q) c= support p \/ support q;

definition
  let L be Abelian non empty addLoopStr;
  let p,q be sequence of L;
  redefine func p+q;
  commutativity;
end;

theorem 
  for L be add-associative non empty addLoopStr for p,q,r be
  sequence of L holds p+q+r = p+(q+r);

registration
  let L be add-associative right_zeroed right_complementable non empty
  addLoopStr;
  let p be Polynomial of L;
  cluster -p -> finite-Support;
end;

definition
  let L be non empty addLoopStr;

  let p,q be sequence of L;
  redefine func p-q equals

  p+-q;
end;

registration
  let L be add-associative right_zeroed right_complementable non empty
  addLoopStr;
  let p,q be Polynomial of L;
  cluster p-q -> finite-Support;
end;

theorem 
  for L be non empty addLoopStr for p,q be sequence of L for n be
  Element of NAT holds (p-q).n = p.n - q.n;

definition
  let L be non empty ZeroStr;
  func 0_.(L) -> sequence of L equals

  NAT --> 0.L;
end;

registration
  let L be non empty ZeroStr;
  cluster 0_.(L) -> finite-Support;
end;

theorem 
  for L be right_zeroed non empty addLoopStr for p be sequence
  of L holds p+0_.(L) = p;

theorem 
  for L be add-associative right_zeroed right_complementable non
  empty addLoopStr for p be sequence of L holds p-p = 0_.(L);

definition
  let L be non empty multLoopStr_0;
  func 1_.(L) -> sequence of L equals

  0_.(L)+*(0,1.L);
end;

registration
  let L be non empty multLoopStr_0;
  cluster 1_.(L) -> finite-Support;
end;

theorem 
  for L be non empty multLoopStr_0 holds (1_.(L)).0 = 1.L & for n
  be Nat st n <> 0 holds (1_.(L)).n = 0.L;

definition
  let L be non empty doubleLoopStr;
  let p,q be sequence of L;
  func p*'q -> sequence of L means


  for i be Element of NAT ex r be
  FinSequence of the carrier of L st len r = i+1 & it.i = Sum r & for k be
  Element of NAT st k in dom r holds r.k = p.(k-'1) * q.(i+1-'k);
end;

registration
  let L be add-associative right_zeroed right_complementable distributive non
  empty doubleLoopStr;
  let p,q be Polynomial of L;
  cluster p*'q -> finite-Support;
end;

theorem 
  for L be Abelian add-associative right_zeroed
right_complementable right-distributive non empty doubleLoopStr for p,q,r be
  sequence of L holds p*'(q+r) = p*'q+p*'r;

theorem 
  for L be Abelian add-associative right_zeroed
  right_complementable left-distributive non empty doubleLoopStr for p,q,r be
  sequence of L holds (p+q)*'r = p*'r+q*'r;

definition let n be Element of NAT;
 redefine func <*n*> -> Element of 1-tuples_on NAT;
end;

theorem 
  for L be Abelian add-associative right_zeroed
  right_complementable well-unital associative distributive non empty
  doubleLoopStr for p,q,r be sequence of L holds p*'q*'r = p*'(q*'r);

definition
  let L be Abelian add-associative right_zeroed commutative non empty
  doubleLoopStr;
  let p,q be sequence of L;
  redefine func p*'q;
  commutativity;
end;

theorem 
  for L be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr for p be sequence of L holds p*'
  0_.(L) = 0_.(L);

theorem 
  for L be add-associative right_zeroed well-unital
  right_complementable right-distributive non empty doubleLoopStr for p be
  sequence of L holds p*'1_.(L) = p;

begin  

definition
  let L be add-associative right_zeroed right_complementable distributive non
  empty doubleLoopStr;
  func Polynom-Ring L -> strict non empty doubleLoopStr means


  (for x
  be set holds x in the carrier of it iff x is Polynomial of L) & (for x,y be
Element of it, p,q be sequence of L st x = p & y = q holds x+y = p+q) & (for x,
  y be Element of it, p,q be sequence of L st x = p & y = q holds x*y = p*'q) &
  0.it = 0_.(L) & 1.it = 1_.(L);
end;

registration
  let L be Abelian add-associative right_zeroed right_complementable
  distributive non empty doubleLoopStr;
  cluster Polynom-Ring L -> Abelian;
end;

registration
  let L be add-associative right_zeroed right_complementable distributive non
  empty doubleLoopStr;
  cluster Polynom-Ring L -> add-associative;
  cluster Polynom-Ring L -> right_zeroed;
  cluster Polynom-Ring L -> right_complementable;
end;

registration
  let L be Abelian add-associative right_zeroed right_complementable
  commutative distributive non empty doubleLoopStr;
  cluster Polynom-Ring L -> commutative;
end;

registration
  let L be Abelian add-associative right_zeroed right_complementable
  well-unital associative distributive non empty doubleLoopStr;
  cluster Polynom-Ring L -> associative;
end;

registration
  let L be add-associative right_zeroed right_complementable well-unital
  Abelian commutative distributive non empty doubleLoopStr;
  cluster Polynom-Ring L -> well-unital;
end;

registration
  let L be Abelian add-associative right_zeroed right_complementable
  distributive non empty doubleLoopStr;
  cluster Polynom-Ring L -> distributive;
end;

theorem 
  for L being add-associative right_zeroed right_complementable
well-unital Abelian commutative distributive non empty doubleLoopStr holds 1.
  Polynom-Ring L = 1_.L;














begin 

theorem 
  for x,y,z being set st z in x & z in y holds x \ {z} = y \ {z} implies x = y;

theorem 
  for n, k being Element of NAT holds k in Seg n
  iff k-1 is Element of NAT & k-1 < n;

registration
  let f be finite-support Function, X be set;
  cluster f|X -> finite-support;
end;

canceled;

theorem 
  for fs being FinSequence of NAT holds Sum fs = 0 iff fs = (len fs) |-> 0;

definition
  let n,i,j be Nat, b be ManySortedSet of n;
  func (i,j)-cut b -> ManySortedSet of j-'i means


  for k being Element of NAT st k in j-'i holds it.k = b.(i+k);
end;

registration
  let n,i,j be Nat, b be natural-valued ManySortedSet of n;
  cluster (i,j)-cut b -> natural-valued;
end;

registration
  let n,i,j be Element of NAT, b be finite-support ManySortedSet of n;
  cluster (i,j)-cut b -> finite-support;
end;

theorem 
  for n,i being Nat, a,b being ManySortedSet of n holds
  a = b iff (0,i+1)-cut a = (0,i+1)-cut b & (i+1,n)-cut a = (i+1,n)-cut b;

definition
  let x be non empty set, n be non empty Element of NAT;
  func Fin (x,n) equals

  {y where y is Subset of x : y is finite & y is non empty & card y c= n};
end;

registration
  let x be non empty set, n be non empty Element of NAT;
  cluster Fin (x,n) -> non empty;
end;

theorem 
  for R being antisymmetric transitive non empty RelStr,
  X being finite Subset of R st X <> {} holds
  ex x being Element of R st x in X & x is_maximal_wrt X, the InternalRel of R;

theorem 
  for R being antisymmetric transitive non empty RelStr,
  X being finite Subset of R st X <> {} holds
  ex x being Element of R st x in X & x is_minimal_wrt X, the InternalRel of R;

theorem 
  for R being non empty antisymmetric transitive RelStr,
  f being sequence of R st f is descending
  holds for j, i being Nat st i<j
  holds f.i<>f.j & [f.j,f.i] in the InternalRel of R;

definition
  let R be non empty RelStr, s be sequence of R;
  attr s is non-increasing means


  for i being Nat holds [s.(i+1),s.i] in the InternalRel of R;
end;

theorem 
  for R being non empty transitive RelStr, f being sequence of R
  st f is non-increasing holds for j, i being Nat st i<j
  holds [f.j,f.i] in the InternalRel of R;

theorem 
  for R being non empty transitive RelStr, s being sequence of R
  st R is well_founded & s is non-increasing
  holds ex p being Nat st for r being Nat st p <= r
  holds s.p = s.r;

theorem 
  for X being set, a be Element of X, A being finite Subset of X,
  R being Order of X st A = {a} & R linearly_orders A
  holds SgmX (R, A) = <*a*>;

begin 

definition
  let n be Ordinal, b be bag of n;
  func TotDegree b -> Nat means


  ex f being FinSequence of NAT
  st it = Sum f & f = b*SgmX(RelIncl n, support b);
end;

theorem 
  for n being Ordinal, b being bag of n, s being finite Subset of n,
  f, g being FinSequence of NAT
  st f = b*SgmX(RelIncl n, support b) & g = b*SgmX(RelIncl n, support b \/ s)
  holds Sum f = Sum g;

theorem 
  for n being Ordinal, a, b being bag of n
  holds TotDegree (a+b) = TotDegree a + TotDegree b;

theorem 
  for n be Ordinal, a,b being bag of n
  st b divides a holds TotDegree(a-'b) = TotDegree(a) - TotDegree(b);

theorem 
for n being Ordinal, b being bag of n holds TotDegree b = 0 iff b = EmptyBag n;

theorem 
  for i,j,n being Nat holds (i,j)-cut EmptyBag n = EmptyBag (j-'i);

theorem 
  for i,j,n being Nat, a,b being bag of n
  holds (i,j)-cut (a+b) = (i,j)-cut(a) + (i,j)-cut(b);

theorem 
  for X being set holds support EmptyBag X = {};

theorem 
  for X being set, b be bag of X st support b = {} holds b = EmptyBag X;

theorem 
  for n, m being Ordinal, b being bag of n st m in n holds b|m is bag of m;

theorem 
  for n being Ordinal, a, b being bag of n
  st b divides a holds support b c= support a;

begin 

definition
  let n be set;
  mode TermOrder of n is Order of Bags n;
end;

notation
  let n be Ordinal;
  synonym LexOrder n for BagOrder n;
end;

definition 
  let n be Ordinal, T be TermOrder of n;

  attr T is admissible means


  T is_strongly_connected_in Bags n &
  (for a being bag of n holds [EmptyBag n, a] in T) &
  for a, b, c being bag of n st [a, b] in T holds [a+c, b+c] in T;
end;

theorem 
  for n being Ordinal holds LexOrder n is admissible;

registration
  let n be Ordinal;
  cluster admissible for TermOrder of n;
end;

registration
  let n be Ordinal;
  cluster LexOrder n -> admissible;
end;

theorem 
  for o being infinite Ordinal holds LexOrder o is non well-ordering;

definition
  let n be Ordinal;
  func InvLexOrder n -> TermOrder of n means


  for p,q being bag of n holds [p,q] in it iff p = q or
  ex i being Ordinal st i in n & p.i < q.i &
  for k being Ordinal st i in k & k in n holds p.k = q.k;
end;

theorem 
  for n being Ordinal holds InvLexOrder n is admissible;

registration
  let n be Ordinal;
  cluster InvLexOrder n -> admissible;
end;

theorem 
  for o being Ordinal holds InvLexOrder o is well-ordering;

definition
  let n be Ordinal, o be TermOrder of n such that
 for a,b,c being bag of n st [a,b] in o holds [a+c, b+c] in o;
  func Graded o -> TermOrder of n means


  for a, b being bag of n holds [a,b] in it iff
  ( TotDegree a < TotDegree b or TotDegree a = TotDegree b & [a,b] in o );
end;

theorem 
  for n being Ordinal, o being TermOrder of n
  st (for a,b,c being bag of n st [a,b] in o
  holds [a+c, b+c] in o) & o is_strongly_connected_in Bags n
  holds Graded o is admissible;

definition
  let n be Ordinal;
  func GrLexOrder n -> TermOrder of n equals

  Graded LexOrder n;
  func GrInvLexOrder n -> TermOrder of n equals

  Graded InvLexOrder n;
end;

theorem 
                                           
  for n being Ordinal holds GrLexOrder n is admissible;

registration
  let n be Ordinal;
  cluster GrLexOrder n -> admissible;
end;

theorem 
  for o being infinite Ordinal holds GrLexOrder o is non well-ordering;

theorem 
  for n being Ordinal holds GrInvLexOrder n is admissible;

registration
  let n be Ordinal;
  cluster GrInvLexOrder n -> admissible;
end;

theorem 
  for o being Ordinal holds GrInvLexOrder o is well-ordering;

definition
  let i,n be Nat, o1 be TermOrder of (i+1),
  o2 be TermOrder of (n-'(i+1));
  func BlockOrder(i,n,o1,o2) -> TermOrder of n means


  for p,q being bag of n holds [p,q] in it iff
  (0,i+1)-cut p <> (0,i+1)-cut q & [(0,i+1)-cut p,(0,i+1)-cut q] in o1 or
  (0,i+1)-cut p = (0,i+1)-cut q & [(i+1,n)-cut p,(i+1,n)-cut q] in o2;
end;

theorem 
  for i,n being Nat, o1 being TermOrder of (i+1),
  o2 being TermOrder of (n-'(i+1)) st o1 is admissible & o2 is admissible
  holds BlockOrder(i,n,o1,o2) is admissible;

definition
  let n be Nat;
  func NaivelyOrderedBags n -> strict RelStr means


  the carrier of it = Bags n &
  for x,y being bag of n holds [x,y] in the InternalRel of it iff x divides y;
end;

theorem 
  for n being Nat holds the carrier of product(n --> OrderedNAT) = Bags n;

theorem 
  for n being Nat holds NaivelyOrderedBags n = product (n --> OrderedNAT);

theorem 
  for n being Nat, o be TermOrder of n st o is admissible
  holds the InternalRel of NaivelyOrderedBags n c= o & o is well-ordering;

begin 

definition
  let R be connected non empty Poset,
  X be Element of Fin the carrier of R such that
 X is non empty;
  func PosetMin X -> Element of R means

  it in X & it is_minimal_wrt X, the InternalRel of R;
  func PosetMax X -> Element of R means


  it in X & it is_maximal_wrt X, the InternalRel of R;
end;

definition
  let R be connected non empty Poset;
  func FinOrd-Approx R ->
  Function of NAT, bool[: Fin the carrier of R, Fin the carrier of R:] means


  dom it = NAT & it.0 = {[x,y] where x, y is Element of Fin the carrier of R :
  x = {} or (x<>{} & y <> {} & PosetMax x <> PosetMax y &
  [PosetMax x,PosetMax y] in the InternalRel of R)} &
  for n being Nat holds
  it.(n+1) = {[x,y] where x,y is Element of Fin the carrier of R :
  x <> {} & y <> {} &
  PosetMax x = PosetMax y & [x \{PosetMax x}, y \{PosetMax y}] in it.n};
end;

theorem 
  for R being connected non empty Poset,
  x,y being Element of Fin the carrier of R
  holds [x,y] in union rng FinOrd-Approx R iff x = {} or
  x<>{} & y<>{} & PosetMax x <> PosetMax y &
  [PosetMax x,PosetMax y] in the InternalRel of R or
  x<>{} & y<>{} & PosetMax x = PosetMax y &
  [x\{PosetMax x},y\{PosetMax y}] in union rng FinOrd-Approx R;

theorem 
  for R being connected non empty Poset,
  x being Element of Fin the carrier of R
  st x <> {} holds not [x,{}] in union rng FinOrd-Approx R;

theorem 
  for R being connected non empty Poset,
  a being Element of Fin the carrier of R
  holds a\{PosetMax a} is Element of Fin the carrier of R;

theorem 
  for R being connected non empty Poset
  holds union (rng FinOrd-Approx R) is Order of Fin the carrier of R;

definition
  let R be connected non empty Poset;
  func FinOrd R -> Order of Fin (the carrier of R) equals

  union rng FinOrd-Approx R;
end;

definition
  let R be connected non empty Poset;
  func FinPoset R -> Poset equals

  RelStr (# Fin the carrier of R, FinOrd R #);
end;

registration
  let R be connected non empty Poset;
  cluster FinPoset R -> non empty;
end;

theorem 
  for R being connected non empty Poset,a,b being Element of FinPoset R
  holds [a,b] in the InternalRel of FinPoset R iff
  ex x,y being Element of Fin the carrier of R st a = x & b = y & (x = {} or
  x<>{} & y<>{} & PosetMax x <> PosetMax y &
  [PosetMax x,PosetMax y] in the InternalRel of R or
  x<>{} & y<>{} & PosetMax x = PosetMax y &
  [x\{PosetMax x},y\{PosetMax y}] in FinOrd R);

registration
  let R be connected non empty Poset;
  cluster FinPoset R -> connected;
end;

definition
  let R be connected non empty RelStr, C be non empty set such that
 R is well_founded and
 C c= the carrier of R;
  func MinElement (C,R)-> Element of R means


  it in C & it is_minimal_wrt C, the InternalRel of R;
end;

theorem 
  for R being non empty RelStr, s being sequence of R, j being Nat
  st s is descending holds s^\j is descending;

theorem 
  for R being connected non empty Poset
  st R is well_founded holds FinPoset R is well_founded;














begin

theorem 
  for D be non empty set for p be FinSequence of D for n be Element of
NAT st 1 <= n & n <= len p holds p = (p|(n-'1))^<*p.n*>^(p/^n);

registration
  cluster almost_left_invertible -> domRing-like for left_zeroed
right_add-cancelable right-distributive well-unital commutative associative
    non empty doubleLoopStr;
end;

registration
  cluster strict Abelian add-associative right_zeroed right_complementable
associative commutative distributive unital domRing-like almost_left_invertible
    non degenerated for non trivial doubleLoopStr;
end;

begin  

theorem 
  for L be add-associative right_zeroed right_complementable
left-distributive non empty doubleLoopStr for p be sequence of L holds (0_.(L
  ))*'p = 0_.(L);

theorem 
  for L be non empty ZeroStr holds len 0_.(L) = 0;

theorem 
  for L be non degenerated non empty multLoopStr_0 holds len 1_.( L) = 1;

theorem 
  for L be non empty ZeroStr for p be Polynomial of L st len p = 0
  holds p = 0_.(L);

theorem 
  for L be right_zeroed non empty addLoopStr for p,q be
  Polynomial of L for n be Element of NAT st n >= len p & n >= len q holds n >=
  len (p+q);

theorem 
  for L be add-associative right_zeroed right_complementable non
empty addLoopStr for p,q be Polynomial of L st len p <> len q holds len (p+q)
  = max(len p,len q);

theorem 
  for L be add-associative right_zeroed right_complementable non
  empty addLoopStr for p be Polynomial of L holds len (-p) = len p;

theorem 
  for L be add-associative right_zeroed right_complementable non empty
addLoopStr for p,q be Polynomial of L for n be Element of NAT st n >= len p &
  n >= len q holds n >= len (p-q);

theorem 
  for L be add-associative right_zeroed right_complementable
distributive commutative associative left_unital non empty doubleLoopStr, p,q
  be Polynomial of L st p.(len p -'1) * q.(len q -'1) <> 0.L holds len (p*'q) =
  len p + len q - 1;

begin  

definition
  let L be non empty ZeroStr;
  let p be Polynomial of L;
  func Leading-Monomial(p) -> sequence of L means


  it.(len p-'1) = p.(
  len p-'1) & for n be Element of NAT st n <> len p-'1 holds it.n = 0.L;
end;

theorem 
  for L be non empty ZeroStr for p be Polynomial of L holds
  Leading-Monomial(p) = 0_.(L)+*(len p-'1,p.(len p-'1));

registration
  let L be non empty ZeroStr;
  let p be Polynomial of L;
  cluster Leading-Monomial(p) -> finite-Support;
end;

theorem 
  for L be non empty ZeroStr for p be Polynomial of L st len p = 0
  holds Leading-Monomial(p) = 0_.(L);

theorem 
  for L be non empty ZeroStr holds Leading-Monomial(0_.(L)) = 0_.(L);

theorem 
  for L be non degenerated non empty multLoopStr_0 holds
  Leading-Monomial(1_.(L)) = 1_.(L);

theorem 
  for L be non empty ZeroStr for p be Polynomial of L holds len
  Leading-Monomial(p) = len p;

theorem 
  for L be add-associative right_zeroed right_complementable non
empty addLoopStr for p be Polynomial of L st len p <> 0 ex q be Polynomial of
L st len q < len p & p = q+Leading-Monomial(p) & for n be Element of NAT st n <
  len p-1 holds q.n = p.n;

begin  

definition
  let L be unital non empty doubleLoopStr;
  let p be Polynomial of L;
  let x be Element of L;
  func eval(p,x) -> Element of L means


  ex F be FinSequence of the
  carrier of L st it = Sum F & len F = len p & for n be Element of NAT st n in
  dom F holds F.n = p.(n-'1) * (power L).(x,n-'1);
end;

theorem 
  for L be unital non empty doubleLoopStr for x be Element of L
  holds eval(0_.(L),x) = 0.L;

theorem 
  for L be well-unital add-associative right_zeroed
right_complementable associative non degenerated non empty doubleLoopStr for
  x be Element of L holds eval(1_.(L),x) = 1.L;

theorem 
  for L be Abelian add-associative right_zeroed
right_complementable unital left-distributive non empty doubleLoopStr for p,q
be Polynomial of L for x be Element of L holds eval(p+q,x) = eval(p,x) + eval(q
  ,x);

theorem 
  for L be Abelian add-associative right_zeroed
  right_complementable unital distributive non empty doubleLoopStr for p be
  Polynomial of L for x be Element of L holds eval(-p,x) = -eval(p,x);

theorem 
  for L be Abelian add-associative right_zeroed right_complementable
unital distributive non empty doubleLoopStr for p,q be Polynomial of L for x
  be Element of L holds eval(p-q,x) = eval(p,x) - eval(q,x);

theorem 
  for L be add-associative right_zeroed right_complementable
right_zeroed distributive unital non empty doubleLoopStr for p be Polynomial
of L for x be Element of L holds eval(Leading-Monomial(p),x) = p.(len p-'1) * (
  power L).(x,len p-'1);

theorem 
  for L be add-associative right_zeroed right_complementable
Abelian left_unital distributive commutative associative non trivial
  doubleLoopStr for p,q be Polynomial of L for x be Element of L holds eval((
  Leading-Monomial(p))*'q,x) = eval(Leading-Monomial(p),x) * eval(q,x);

theorem 
  for L be add-associative right_zeroed right_complementable
Abelian left_unital distributive commutative associative non trivial
doubleLoopStr for p,q be Polynomial of L for x be Element of L holds eval(p*'q
  ,x) = eval(p,x) * eval(q,x);

begin  

definition
  let L be add-associative right_zeroed right_complementable distributive
  unital non empty doubleLoopStr;
  let x be Element of L;
  func Polynom-Evaluation(L,x) -> Function of Polynom-Ring L,L means


  for p be Polynomial of L holds it.p = eval(p,x);
end;

registration
  let L be add-associative right_zeroed right_complementable distributive
  associative well-unital non degenerated commutative Abelian non empty
  doubleLoopStr;
  let x be Element of L;
  cluster Polynom-Evaluation(L,x) -> unity-preserving;
end;

registration
  let L be Abelian add-associative right_zeroed right_complementable
  distributive unital non empty doubleLoopStr;
  let x be Element of L;
  cluster Polynom-Evaluation(L,x) -> additive;
end;

registration
  let L be add-associative right_zeroed right_complementable Abelian
  left_unital distributive commutative associative non trivial
  doubleLoopStr;
  let x be Element of L;
  cluster Polynom-Evaluation(L,x) -> multiplicative;
end;

registration
  let L be add-associative right_zeroed right_complementable Abelian
  well-unital distributive commutative associative non degenerated non empty
  doubleLoopStr;
  let x be Element of L;
  cluster Polynom-Evaluation(L,x) -> RingHomomorphism;
end;














begin 

theorem 
  for n,m be Element of NAT st n <> 0 & m <> 0 holds n*m - n - m + 1 >= 0;

theorem 
  for x,y be real number st y > 0 holds min(x,y)/max(x,y) <= 1;

theorem 
  for x,y be real number st for c be real number st c > 0 & c < 1
  holds c*x >= y holds y <= 0;

theorem 
  for p be FinSequence of REAL st for n be Element of NAT st n in
  dom p holds p.n >= 0 for i be Element of NAT st i in dom p holds Sum p >= p.i
;

theorem 
  for x,y be Real holds -[**x,y**] = [**-x,-y**];

theorem 
  for x1,y1,x2,y2 be Real holds [**x1,y1**] - [**x2,y2**] = [**x1 -
  x2,y1 - y2**];

theorem 
  for z be Element of F_Complex st z <> 0.F_Complex for n be
  Element of NAT holds |.(power F_Complex).(z,n).| = |.z.| to_power n;

definition
  let p be FinSequence of the carrier of F_Complex;
  func |.p.| -> FinSequence of REAL means


  len it = len p & for n be
  Element of NAT st n in dom p holds it/.n = |.p/.n.|;
end;

theorem 
  |.<*>the carrier of F_Complex.| = <*>REAL;

theorem 
  for x be Element of F_Complex holds |.<*x*>.| = <*|.x.|*>;

theorem 
  for x,y be Element of F_Complex holds |.<*x,y*>.| = <*|.x.|,|.y.|*>;

theorem 
  for x,y,z be Element of F_Complex holds |.<*x,y,z*>.| = <*|.x.|,|.y.|,
  |.z.|*>;

theorem 
  for p,q be FinSequence of the carrier of F_Complex holds |.p^q.|
  = |.p.|^|.q.|;

theorem 
  for p be FinSequence of the carrier of F_Complex for x be Element of
  F_Complex holds |.p^<*x*>.| = |.p.|^<*|.x.|*> & |.<*x*>^p.| = <*|.x.|*>^|.p.|
;

theorem 
  for p be FinSequence of the carrier of F_Complex holds |.Sum p.| <= Sum|.p.|;

begin  

definition
  let L be Abelian add-associative right_zeroed right_complementable
  right_unital commutative distributive non empty doubleLoopStr;
  let p be Polynomial of L;
  let n be Element of NAT;
  func p`^n -> sequence of L equals

  (power Polynom-Ring L).(p,n);
end;

registration
  let L be Abelian add-associative right_zeroed right_complementable
  right_unital commutative distributive non empty doubleLoopStr;
  let p be Polynomial of L;
  let n be Element of NAT;
  cluster p`^n -> finite-Support;
end;

theorem 
  for L be Abelian add-associative right_zeroed
  right_complementable well-unital commutative distributive non empty
  doubleLoopStr for p be Polynomial of L holds p`^0 = 1_.(L);

theorem 
  for L be Abelian add-associative right_zeroed right_complementable
  well-unital commutative distributive non empty doubleLoopStr for p be
  Polynomial of L holds p`^1 = p;

theorem 
  for L be Abelian add-associative right_zeroed right_complementable
  well-unital commutative distributive non empty doubleLoopStr for p be
  Polynomial of L holds p`^2 = p*'p;

theorem 
  for L be Abelian add-associative right_zeroed right_complementable
  well-unital commutative distributive non empty doubleLoopStr for p be
  Polynomial of L holds p`^3 = p*'p*'p;

theorem 
  for L be Abelian add-associative right_zeroed
  right_complementable well-unital commutative distributive non empty
doubleLoopStr for p be Polynomial of L for n be Element of NAT holds p`^(n+1)
  = (p`^n)*'p;

theorem 
  for L be Abelian add-associative right_zeroed
  right_complementable well-unital commutative distributive non empty
  doubleLoopStr for n be Element of NAT holds 0_.(L)`^(n+1) = 0_.(L);

theorem 
  for L be Abelian add-associative right_zeroed right_complementable
well-unital commutative distributive non empty doubleLoopStr for n be Element
  of NAT holds 1_.(L)`^n = 1_.(L);

theorem 
  for L be Field for p be Polynomial of L for x be Element of L
  for n be Element of NAT holds eval(p`^n,x) = (power L).(eval(p,x),n);

theorem 
  for L be domRing for p be Polynomial of L st len p <> 0 for n be
  Element of NAT holds len(p`^n) = n*len p-n+1;

definition
  let L be non empty multMagma;
  let p be sequence of L;
  let v be Element of L;
  func v*p -> sequence of L means


  for n be Element of NAT holds it.n = v*p.n;
end;

registration
  let L be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let p be Polynomial of L;
  let v be Element of L;
  cluster v*p -> finite-Support;
end;

theorem 
  for L be add-associative right_zeroed right_complementable
distributive non empty doubleLoopStr for p be Polynomial of L holds len (0.L*
  p) = 0;

theorem 
  for L be add-associative right_zeroed right_complementable
  well-unital commutative associative distributive almost_left_invertible non
empty doubleLoopStr for p be Polynomial of L for v be Element of L st v <> 0.L
  holds len (v*p) = len p;

theorem 
  for L be add-associative right_zeroed right_complementable
left-distributive non empty doubleLoopStr for p be sequence of L holds 0.L*p
  = 0_.(L);

theorem 
  for L be well-unital non empty multLoopStr for p be sequence
  of L holds 1.L*p = p;

theorem 
  for L be add-associative right_zeroed right_complementable
right-distributive non empty doubleLoopStr for v be Element of L holds v*0_.(
  L) = 0_.(L);

theorem 
  for L be add-associative right_zeroed right_complementable
well-unital right-distributive non empty doubleLoopStr for v be Element of L
  holds v*1_.(L) = <%v%>;

theorem 
  for L be add-associative right_zeroed right_complementable
  well-unital distributive commutative associative almost_left_invertible non
  empty doubleLoopStr for p be Polynomial of L for v,x be Element of L holds
  eval(v*p,x) = v*eval(p,x);

theorem 
  for L be add-associative right_zeroed right_complementable
  right-distributive unital non empty doubleLoopStr for p be Polynomial of L
  holds eval(p,0.L) = p.0;

definition
  let L be non empty ZeroStr;
  let z0,z1 be Element of L;
  func <%z0,z1%> -> sequence of L equals

  0_.(L)+*(0,z0)+*(1,z1);
end;

theorem 
  for L be non empty ZeroStr for z0 be Element of L holds <%z0%>.0
  = z0 & for n be Element of NAT st n >= 1 holds <%z0%>.n = 0.L;

theorem 
  for L be non empty ZeroStr for z0 be Element of L st z0 <> 0.L
  holds len <%z0%> = 1;

theorem 
  for L be non empty ZeroStr holds <%0.L%> = 0_.(L);

theorem 
  for L be add-associative right_zeroed right_complementable
  distributive commutative associative well-unital domRing-like non empty
  doubleLoopStr for x,y be Element of L holds <%x%>*'<%y%> = <%x*y%>;

theorem 
  for L be Abelian add-associative right_zeroed
  right_complementable well-unital associative commutative distributive
almost_left_invertible non empty doubleLoopStr for x be Element of L for n be
  Element of NAT holds <%x%>`^n = <%(power L).(x,n)%>;

theorem 
  for L be add-associative right_zeroed right_complementable unital non
  empty doubleLoopStr for z0,x be Element of L holds eval(<%z0%>,x) = z0;

theorem 
  for L be non empty ZeroStr for z0,z1 be Element of L holds <%z0,
z1%>.0 = z0 & <%z0,z1%>.1 = z1 & for n be Nat st n >= 2 holds <%z0,z1%>.n = 0.L
;

registration
  let L be non empty ZeroStr;
  let z0,z1 be Element of L;
  cluster <%z0,z1%> -> finite-Support;
end;

theorem 
  for L be non empty ZeroStr for z0,z1 be Element of L holds len <%z0,z1%> <= 2
;

theorem 
  for L be non empty ZeroStr for z0,z1 be Element of L st z1 <> 0.
  L holds len <%z0,z1%> = 2;

theorem 
  for L be non empty ZeroStr for z0 be Element of L st z0 <> 0.L
  holds len <%z0,0.L%> = 1;

theorem 
  for L be non empty ZeroStr holds <%0.L,0.L%> = 0_.(L);

theorem 
  for L be non empty ZeroStr for z0 be Element of L holds <%z0,0.L%> = <%z0%>;

theorem 
  for L be add-associative right_zeroed right_complementable
left-distributive unital non empty doubleLoopStr for z0,z1,x be Element of L
  holds eval(<%z0,z1%>,x) = z0+z1*x;

theorem 
  for L be add-associative right_zeroed right_complementable
left-distributive well-unital non empty doubleLoopStr for z0,z1,x be Element
  of L holds eval(<%z0,0.L%>,x) = z0;

theorem 
  for L be add-associative right_zeroed right_complementable
left-distributive unital non empty doubleLoopStr for z0,z1,x be Element of L
  holds eval(<%0.L,z1%>,x) = z1*x;

theorem 
  for L be add-associative right_zeroed right_complementable
left-distributive well-unital non empty doubleLoopStr for z0,z1,x be Element
  of L holds eval(<%z0,1.L%>,x) = z0+x;

theorem 
  for L be add-associative right_zeroed right_complementable
left-distributive well-unital non empty doubleLoopStr for z0,z1,x be Element
  of L holds eval(<%0.L,1.L%>,x) = x;

begin  

definition
  let L be Abelian add-associative right_zeroed right_complementable
  well-unital commutative distributive non empty doubleLoopStr;
  let p,q be Polynomial of L;
  func Subst(p,q) -> Polynomial of L means


  ex F be FinSequence of the
  carrier of Polynom-Ring L st it = Sum F & len F = len p & for n be Element of
  NAT st n in dom F holds F.n = p.(n-'1)*(q`^(n-'1));
end;

theorem 
  for L be Abelian add-associative right_zeroed
  right_complementable well-unital commutative distributive non empty
  doubleLoopStr for p be Polynomial of L holds Subst(0_.(L),p) = 0_.(L);

theorem 
  for L be Abelian add-associative right_zeroed right_complementable
  well-unital commutative distributive non empty doubleLoopStr for p be
  Polynomial of L holds Subst(p,0_.(L)) = <%p.0%>;

theorem 
  for L be Abelian add-associative right_zeroed right_complementable
  well-unital associative commutative distributive almost_left_invertible non
  empty doubleLoopStr for p be Polynomial of L for x be Element of L holds len
  Subst(p,<%x%>) <= 1;

theorem 
  for L be Field for p,q be Polynomial of L st len p <> 0 & len q
  > 1 holds len Subst(p,q) = (len p)*(len q)-len p-len q+2;

theorem 
  for L be Field for p,q be Polynomial of L for x be Element of L
  holds eval(Subst(p,q),x) = eval(p,eval(q,x));

begin  

definition
  let L be unital non empty doubleLoopStr;
  let p be Polynomial of L;
  let x be Element of L;
  pred x is_a_root_of p means


  eval(p,x) = 0.L;
end;

definition
  let L be unital non empty doubleLoopStr;
  let p be Polynomial of L;
  attr p is with_roots means


  ex x be Element of L st x is_a_root_of p;
end;

theorem 
  for L be unital non empty doubleLoopStr holds 0_.(L) is with_roots;

registration
  let L be unital non empty doubleLoopStr;
  cluster 0_.(L) -> with_roots;
end;

theorem 
  for L be unital non empty doubleLoopStr for x be Element of L holds
  x is_a_root_of 0_.(L);

registration
  let L be unital non empty doubleLoopStr;
  cluster with_roots for Polynomial of L;
end;

definition
  let L be unital non empty doubleLoopStr;
  attr L is algebraic-closed means


  for p be Polynomial of L st len p > 1 holds p is with_roots;
end;

definition
  let L be unital non empty doubleLoopStr;
  let p be Polynomial of L;
  func Roots(p) -> Subset of L means


  for x be Element of L holds x in it iff x is_a_root_of p;
end;

definition
  let L be commutative associative well-unital distributive
  almost_left_invertible non empty doubleLoopStr;
  let p be Polynomial of L;
  func NormPolynomial(p) -> sequence of L means


  for n be Element of NAT holds it.n = p.n / p.(len p-'1);
end;

registration
  let L be add-associative right_zeroed right_complementable commutative
  associative well-unital distributive almost_left_invertible non empty
  doubleLoopStr;
  let p be Polynomial of L;
  cluster NormPolynomial(p) -> finite-Support;
end;

theorem 
  for L be commutative associative well-unital distributive
  almost_left_invertible non empty doubleLoopStr for p be Polynomial of L st
  len p <> 0 holds (NormPolynomial p).(len p-'1) = 1.L;

theorem 
  for L be Field for p be Polynomial of L st len p <> 0 holds len
  NormPolynomial(p) = len p;

theorem 
  for L be Field for p be Polynomial of L st len p <> 0 for x be
  Element of L holds eval(NormPolynomial(p),x) = eval(p,x)/p.(len p-'1);

theorem 
  for L be Field for p be Polynomial of L st len p <> 0 for x be
  Element of L holds x is_a_root_of p iff x is_a_root_of NormPolynomial(p);

theorem 
  for L be Field for p be Polynomial of L st len p <> 0 holds p is
  with_roots iff NormPolynomial(p) is with_roots;

theorem 
  for L be Field for p be Polynomial of L st len p <> 0 holds Roots(p) =
  Roots(NormPolynomial p);

theorem 
  id(COMPLEX) is_continuous_on COMPLEX;

theorem 
  for x be Element of COMPLEX holds COMPLEX --> x is_continuous_on COMPLEX;

definition
  let L be unital non empty multMagma;
  let x be Element of L;
  let n be Element of NAT;
  func FPower(x,n) -> Function of L,L means


  for y be Element of L holds it.y = x*(power L).(y,n);
end;

theorem 
  for L be unital non empty multMagma holds FPower(1_L,1) = id(the
  carrier of L);

theorem 
  FPower(1_F_Complex,2) = id(COMPLEX)(#)id(COMPLEX);

theorem 
  for L be unital non empty multMagma for x be Element of L
  holds FPower(x,0) = (the carrier of L) --> x;

theorem 
  for x be Element of F_Complex ex x1 be Element of COMPLEX st x = x1 &
  FPower(x,1) = x1(#)id(COMPLEX);

theorem 
  for x be Element of F_Complex ex x1 be Element of COMPLEX st x = x1 &
  FPower(x,2) = x1(#)(id(COMPLEX)(#)id(COMPLEX));

theorem 
  for x be Element of F_Complex for n be Element of NAT ex f be
Function of COMPLEX,COMPLEX st f = FPower(x,n) & FPower(x,n+1) = f(#)id(COMPLEX
  );

theorem 
  for x be Element of F_Complex for n be Element of NAT ex f be
  Function of COMPLEX,COMPLEX st f = FPower(x,n) & f is_continuous_on COMPLEX;

definition
  let L be well-unital non empty doubleLoopStr;
  let p be Polynomial of L;
  func Polynomial-Function(L,p) -> Function of L,L means


  for x be Element of L holds it.x = eval(p,x);
end;

theorem 
  for p be Polynomial of F_Complex ex f be Function of COMPLEX,
  COMPLEX st f = Polynomial-Function(F_Complex,p) & f is_continuous_on COMPLEX;

theorem 
  for p be Polynomial of F_Complex st len p > 2 & |.p.(len p-'1).|
=1 for F be FinSequence of REAL st len F = len p & for n be Element of NAT st n
in dom F holds F.n = |.p.(n-'1).| for z be Element of F_Complex st |.z.| > Sum
  F holds |.eval(p,z).| > |.p.0 .|+1;

theorem 
  for p be Polynomial of F_Complex st len p > 2 ex z0 be Element
of F_Complex st for z be Element of F_Complex holds |.eval(p,z).| >= |.eval(p,
  z0).|;


theorem 
  for p be Polynomial of F_Complex st len p > 1 holds p is with_roots;

registration
  cluster F_Complex -> algebraic-closed;
end;

registration
  cluster algebraic-closed add-associative right_zeroed right_complementable
    Abelian commutative associative distributive almost_left_invertible non
    degenerated for well-unital non empty doubleLoopStr;
end;














begin 

theorem 
  for f being FinSequence of NAT st for i being Element of NAT st i
  in dom f holds f.i <> 0 holds Sum f = len f iff f = (len f) |-> 1;



scheme 

  IndFinSeq0 { k() -> Nat, P[set]} : for i being Element of NAT st
  1 <= i & i <= k() holds P[i]
provided
 P[1] and
 for i being Element of NAT st 1 <= i & i < k() holds P[i] implies P[ i+1];

theorem 
  for L be add-associative right_zeroed right_complementable non
empty addLoopStr, r be FinSequence of L st len r >= 2 & for k being Element of
  NAT st 2 < k & k in dom r holds r.k = 0.L holds Sum r = r/.1 + r/.2;

begin 

registration
  let A be finite set;
  cluster one-to-one onto for FinSequence of A;
end;

definition
  let A be finite set;
  func canFS(A) -> FinSequence of A equals

  the one-to-one onto FinSequence of A;
end;

registration
  let A be finite set;
  cluster canFS A -> one-to-one onto;
end;

theorem 
  for A being finite set holds len canFS A = card A;

registration
  let A be finite non empty set;
  cluster canFS A -> non empty;
end;

theorem 
  for a being set holds canFS({a}) = <* a *>;

theorem 
  for A being finite set holds (canFS A)" is Function of A, Seg card A;

begin 

definition
  let X be set, S be finite Subset of X, n be Element of NAT;
  func (S, n)-bag -> Element of Bags X equals

  (EmptyBag X) +* (S --> n);
end;

theorem 
  for X being set, S being finite Subset of X, n being Element of
  NAT, i being set st not i in S holds (S, n)-bag.i = 0;

theorem 
  for X being set, S being finite Subset of X, n being Element of
  NAT, i being set st i in S holds (S, n)-bag.i = n;

theorem 
  for X being set, S being finite Subset of X, n being Element of
  NAT st n <> 0 holds support (S, n)-bag = S;

theorem 
  for X being set, S being finite Subset of X, n being Element of NAT st
  S is empty or n = 0 holds (S, n)-bag = EmptyBag X;

theorem 
  for X being set, S, T being finite Subset of X, n being Element
  of NAT st S misses T holds (S \/ T, n)-bag = (S,n)-bag + (T,n)-bag;

definition
  let X be set;
  mode Rbag of X is real-valued finite-support ManySortedSet of X;
end;

definition
  let A be set, b be Rbag of A;
  func Sum b -> real number means


  ex f being FinSequence of REAL st it = Sum f & f = b*canFS(support b);
end;

notation
  let A be set, b be bag of A;
  synonym degree b for Sum b;
end;

definition
  let A be set, b be bag of A;
  redefine func degree b -> Element of NAT means


  ex f being FinSequence of NAT st it = Sum f & f = b*canFS(support b);
end;

theorem 
  for A being set, b being Rbag of A st b = EmptyBag A holds Sum b = 0;

theorem 
  for A being set, b being bag of A st Sum b = 0 holds b = EmptyBag A;

theorem 
  for A being set, S being finite Subset of A, b being bag of A
  holds S = support b & degree b = card S iff b = (S, 1)-bag;

theorem 
  for A being set, S being finite Subset of A, b being Rbag of A
  st support b c= S ex f being FinSequence of REAL st f = b*canFS(S) & Sum b =
  Sum f;

theorem 
  for A being set, b, b1, b2 being Rbag of A st b = b1 + b2 holds
  Sum b = Sum b1 + Sum b2;

theorem 
  for L being associative commutative unital non empty multMagma
, f, g being FinSequence of L, p being Permutation of dom f st g = f * p holds
  Product(g) = Product(f);

begin 

definition
  let L be non empty ZeroStr, p be Polynomial of L;
  attr p is non-zero means


  p <> 0_. L;
end;

theorem 
  for L being non empty ZeroStr, p being Polynomial of L holds p
  is non-zero iff len p > 0;

registration
  let L be non trivial ZeroStr;
  cluster non-zero for Polynomial of L;
end;

registration
  let L be non degenerated non empty multLoopStr_0, x be Element of L;
  cluster <%x, 1.L%> -> non-zero;
end;

theorem 
  for L being non empty ZeroStr, p being Polynomial of L st len p
  > 0 holds p.(len p -'1) <> 0.L;

theorem 
  for L being non empty ZeroStr, p being AlgSequence of L st len p
  = 1 holds p = <%p.0%> & p.0 <> 0.L;

theorem 
  for L be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr, p be Polynomial of L holds p*'(
  0_.(L)) = 0_.(L);

registration
  cluster algebraic-closed add-associative right_zeroed right_complementable
    Abelian commutative associative distributive domRing-like non degenerated
for
    unital non empty doubleLoopStr;
end;

theorem 
  for L being add-associative right_zeroed right_complementable
distributive domRing-like non empty doubleLoopStr, p, q being Polynomial of L
  st p*'q = 0_. L holds p = 0_. L or q = 0_. L;

registration
  let L be add-associative right_zeroed right_complementable distributive
  domRing-like non empty doubleLoopStr;
  cluster Polynom-Ring L -> domRing-like;
end;

registration
  let L be domRing, p, q be non-zero Polynomial of L;
  cluster p*'q -> non-zero;
end;

theorem 
  for L being non degenerated comRing, p, q being Polynomial of L holds
  Roots p \/ Roots q c= Roots (p*'q);

theorem 
  for L being domRing, p, q being Polynomial of L holds Roots (p*'
  q) = Roots p \/ Roots q;

theorem 
  for L being add-associative right_zeroed right_complementable
  distributive non empty doubleLoopStr, p being (Polynomial of L), pc being (
  Element of Polynom-Ring L) st p = pc holds -p = -pc;

theorem 
  for L being add-associative right_zeroed right_complementable
  distributive non empty doubleLoopStr, p, q being (Polynomial of L), pc, qc
  being (Element of Polynom-Ring L) st p= pc & q = qc holds p-q = pc-qc;

theorem 
  for L being Abelian add-associative right_zeroed
  right_complementable distributive non empty doubleLoopStr, p, q, r being (
  Polynomial of L) holds p*'q-p*'r = p*'(q-r);

theorem 
  for L being add-associative right_zeroed right_complementable
  distributive non empty doubleLoopStr, p, q being (Polynomial of L) st p-q =
  0_. L holds p = q;

theorem 
  for L being Abelian add-associative right_zeroed
right_complementable distributive domRing-like non empty doubleLoopStr, p, q,
  r being Polynomial of L st p <> 0_. L & p*'q = p*'r holds q = r;

theorem 
  for L being domRing, n being Element of NAT, p being Polynomial
  of L st p <> 0_. L holds p`^n <> 0_. L;

theorem 
  for L being comRing, i, j being Element of NAT, p being
  Polynomial of L holds (p`^i) *' (p`^j) = p `^(i+j);

theorem 
  for L being non empty multLoopStr_0 holds 1_.(L) = <%1.L%>;

theorem 
  for L being add-associative right_zeroed right_complementable
well-unital right-distributive non empty doubleLoopStr, p being Polynomial of
  L holds p*'<%1.L%> = p;

theorem 
  for L being add-associative right_zeroed right_complementable
distributive non empty doubleLoopStr, p, q being Polynomial of L st len p = 0
  or len q = 0 holds len (p*'q) = 0;

theorem 
  for L being add-associative right_zeroed right_complementable
  distributive non empty doubleLoopStr, p, q being Polynomial of L st p*'q is
  non-zero holds p is non-zero & q is non-zero;

theorem 
  for L being add-associative right_zeroed right_complementable
distributive commutative associative well-unital non empty doubleLoopStr, p,
q being Polynomial of L st p.(len p -'1) * q.(len q -'1) <> 0.L holds 0 < len (
  p*'q);

theorem 
  for L being add-associative right_zeroed right_complementable
  distributive commutative associative well-unital domRing-like non empty
doubleLoopStr, p, q being Polynomial of L st 1 < len p & 1 < len q holds len p
  < len (p*'q);

theorem 
  for L being add-associative right_zeroed right_complementable
  left-distributive non empty doubleLoopStr, a, b being Element of L, p being
Polynomial of L holds (<%a, b%>*'p).0 = a*p.0 & for i being Nat holds (<%a, b%>
  *'p).(i+1) = a*p.(i+1)+b*p.i;

theorem 
  for L being add-associative right_zeroed right_complementable
  distributive well-unital commutative associative non degenerated non empty
  doubleLoopStr, r being Element of L, q being non-zero Polynomial of L holds
  len (<%r, 1.L%>*'q) = len q + 1;

theorem 
  for L being non degenerated comRing, x being Element of L, i
  being Element of NAT holds len (<%x, 1.L%>`^i) = i+1;

registration
  let L be non degenerated comRing, x be Element of L, n be Element of NAT;
  cluster <%x, 1.L%>`^n -> non-zero;
end;

theorem 
  for L being non degenerated comRing, x being Element of L, q
being non-zero (Polynomial of L), i being Element of NAT holds len ((<%x, 1.L%>
  `^i)*'q) = i + len q;

theorem 
  for L being add-associative right_zeroed right_complementable
  distributive well-unital commutative associative non degenerated non empty
doubleLoopStr, r being Element of L, p, q being Polynomial of L st p = <%r, 1.
  L%>*'q & p.(len p -'1) = 1.L holds q.(len q -'1) = 1.L;

begin 

definition
  let L be non empty ZeroStr, p be Polynomial of L;
  let n be Nat;
  func poly_shift(p,n) -> Polynomial of L means


  for i being Nat holds it.i = p.(n + i);
end;

theorem 
  for L being non empty ZeroStr,p being Polynomial of L holds
  poly_shift(p,0) = p;

theorem 
  for L being non empty ZeroStr, n being Element of NAT, p being
  Polynomial of L st n >= len p holds poly_shift(p,n) = 0_. L;

theorem 
  for L being non degenerated non empty multLoopStr_0, n being
Element of NAT, p being Polynomial of L st n <= len p holds len poly_shift(p,n)
  + n = len p;

theorem 
  for L being non degenerated comRing, x being Element of L, n
  being Element of NAT, p being Polynomial of L st n < len p holds eval(
  poly_shift(p,n),x) = x*eval(poly_shift(p,n+1),x) + p.n;

theorem 
  for L being non degenerated comRing, p being Polynomial of L st
  len p = 1 holds Roots p = {};

definition
  let L be non degenerated comRing, r be Element of L, p be Polynomial of L
  such that
 r is_a_root_of p;
  func poly_quotient(p,r) -> Polynomial of L means


  len it + 1 = len p &
for i being Nat holds it.i = eval(poly_shift(p, i+1),r) if len p > 0 otherwise
  it = 0_. L;
end;

theorem 
  for L being non degenerated comRing, r being Element of L, p
being non-zero Polynomial of L st r is_a_root_of p holds len poly_quotient(p,r)
  > 0;

theorem 
  for L being add-associative right_zeroed right_complementable
  left-distributive well-unital non empty doubleLoopStr, x being Element of L
  holds Roots <%-x, 1.L%> = {x};

theorem 
  for L being non trivial comRing, x being Element of L, p, q
  being Polynomial of L st p = <%-x,1.L%>*'q holds x is_a_root_of p;


theorem 
  for L being non degenerated comRing, r being Element of L, p
being Polynomial of L st r is_a_root_of p holds p = <%-r,1.L%>*'poly_quotient(p
  ,r);

theorem 
  for L being non degenerated comRing, r being Element of L, p, q being
  Polynomial of L st p = <%-r,1.L%>*'q holds r is_a_root_of p;

begin 

registration
  let L be domRing, p be non-zero Polynomial of L;
  cluster Roots p -> finite;
end;

definition
  let L be non degenerated comRing, x be Element of L, p be non-zero (
  Polynomial of L);
  func multiplicity(p,x) -> Element of NAT means


  ex F being finite non
empty Subset of NAT st F = {k where k is Element of NAT : ex q being Polynomial
  of L st p = (<%-x, 1.L%>`^k) *' q} & it = max F;
end;

theorem 
  for L being non degenerated comRing, p being non-zero (
Polynomial of L), x being Element of L holds x is_a_root_of p iff multiplicity(
  p,x) >= 1;

theorem 
  for L being non degenerated comRing, x being Element of L holds
  multiplicity(<%-x, 1.L%>,x) = 1;

definition
  let L be domRing, p be non-zero Polynomial of L;
  func BRoots(p) -> bag of the carrier of L means


  support it = Roots p
  & for x being Element of L holds it.x = multiplicity(p,x);
end;

theorem 
  for L being domRing, x being Element of L holds BRoots <%-x, 1.L
  %> = ({x}, 1)-bag;

theorem 
  for L being domRing, x be Element of L, p, q being non-zero
Polynomial of L holds multiplicity(p*'q,x) = multiplicity(p,x) + multiplicity(q
  ,x);

theorem 
  for L being domRing, p, q being non-zero Polynomial of L holds
  BRoots(p*'q) = BRoots(p) + BRoots(q);

theorem 
  for L being domRing, p being non-zero Polynomial of L st len p =
  1 holds degree BRoots p = 0;

theorem 
  for L being domRing, x be Element of L, n being Element of NAT
  holds degree BRoots (<%-x, 1.L%>`^n) = n;

theorem 
  for L being algebraic-closed domRing, p being non-zero Polynomial of L
  holds degree BRoots p = len p -' 1;

definition
  let L be add-associative right_zeroed right_complementable distributive non
  empty doubleLoopStr, c be Element of L, n be Element of NAT;
  func fpoly_mult_root(c,n) -> FinSequence of Polynom-Ring L means


  len
  it = n & for i being Element of NAT st i in dom it holds it.i = <% -c, 1.L%>;
end;

definition
  let L be add-associative right_zeroed right_complementable distributive non
  empty doubleLoopStr, b be bag of the carrier of L;
  func poly_with_roots(b) -> Polynomial of L means


  ex f being
  FinSequence of (the carrier of Polynom-Ring L)*, s being FinSequence of L st
len f = card support b & s = canFS(support b) & (for i being Element of NAT st
  i in dom f holds f.i = fpoly_mult_root(s/.i,b.(s/.i))) & it = Product
  FlattenSeq f;
end;

theorem 
  for L being Abelian add-associative right_zeroed
  right_complementable commutative distributive well-unital non empty
  doubleLoopStr holds poly_with_roots(EmptyBag the carrier of L) = <%1.L%>;

theorem 
  for L being add-associative right_zeroed right_complementable
  distributive non empty doubleLoopStr, c being Element of L holds
  poly_with_roots(({c},1)-bag) = <% -c, 1.L %>;

theorem 
  for L being add-associative right_zeroed right_complementable
  distributive non empty doubleLoopStr, b being bag of the carrier of L, f
being FinSequence of (the carrier of Polynom-Ring L)*, s being FinSequence of L
st len f = card support b & s = canFS(support b) & (for i being Element of NAT
st i in dom f holds f.i = fpoly_mult_root(s/.i,b.(s/.i))) holds len FlattenSeq
  f = degree b;

theorem 
  for L being add-associative right_zeroed right_complementable
  distributive non empty doubleLoopStr, b being bag of the carrier of L, f
being FinSequence of (the carrier of Polynom-Ring L)*, s being FinSequence of L
, c being Element of L st len f = card support b & s = canFS(support b) & (for
i being Element of NAT st i in dom f holds f.i = fpoly_mult_root(s/.i,b.(s/.i))
) holds (c in support b implies card ((FlattenSeq f)"{<% -c, 1.L%>}) = b.c) & (
  not c in support b implies card ((FlattenSeq f)"{<% -c, 1.L%>}) = 0);

theorem 
  for L being comRing for b1,b2 being bag of the carrier of L
  holds poly_with_roots(b1+b2) = (poly_with_roots b1)*'(poly_with_roots b2);

theorem 
  for L being algebraic-closed domRing, p being non-zero (Polynomial of
  L) st p.(len p-'1) = 1.L holds p = poly_with_roots(BRoots(p));

theorem 
  for L being comRing, s being non empty finite Subset of L, f being
FinSequence of Polynom-Ring L st len f = card s & for i being Element of NAT, c
  being Element of L st i in dom f & c = (canFS(s)).i holds f.i = <% -c, 1.L %>
  holds poly_with_roots((s,1)-bag) = Product(f);

theorem 
  for L being non trivial comRing, s being non empty finite Subset of L,
x being Element of L, f being FinSequence of L st len f = card s & for i being
Element of NAT, c being Element of L st i in dom f & c = (canFS(s)).i holds f.i
  = eval(<% -c, 1.L %>,x) holds eval(poly_with_roots((s,1)-bag),x) = Product(f)
;














begin 

reserve a, b, n for Nat,
  r for Real,
  f for FinSequence of REAL;

registration
  cluster natural-valued for FinSequence;
end;

registration
  let a be non empty Nat;
  let b be Nat;
  cluster a |^ b -> non empty;
end;

registration
  cluster -> non empty for Prime;
end;

reserve p for Prime;

theorem 
  for a, b, c, d being Nat st a divides c & b divides d
  holds a*b divides c*d;

theorem 
  1 < a implies b <= a |^ b;

theorem 
  a <> 0 implies n divides n |^ a;

theorem 
  for i, j, m, n being Nat st i < j & m |^ j divides n
  holds m |^ (i+1) divides n;

theorem 
  p divides a |^ b implies p divides a;

theorem 
  for a being Prime st a divides p |^ b holds a = p;

theorem 
  for f being FinSequence of NAT st a in rng f holds a divides Product f;

theorem 
  for f being FinSequence of SetPrimes st p divides Product f holds p in rng f;



definition
  let f be real-valued FinSequence;
  let a be Nat;
  func f |^ a -> FinSequence means


  len it = len f & for i being set st i in dom it holds it.i = f.i |^ a;
end;

registration
  let f be real-valued FinSequence;
  let a be Nat;
  cluster f |^ a -> real-valued;
end;

registration
  let f be natural-valued FinSequence;
  let a be Nat;
  cluster f |^ a -> natural-valued;
end;

definition
  let f be FinSequence of REAL;
  let a be Nat;
  redefine func f |^ a -> FinSequence of REAL;
end;

definition
  let f be FinSequence of NAT;
  let a be Nat;
  redefine func f |^ a -> FinSequence of NAT;
end;

theorem 
  f |^ 0 = (len f) |-> 1;

theorem 
  f |^ 1 = f;

theorem 
  <*>REAL |^ a = <*>REAL;

theorem 
  <*r*>|^a = <*r|^a*>;

theorem 
  (f^<*r*>) |^ a = (f|^a)^(<*r*>|^a);

theorem 
  Product (f|^(b+1)) = Product (f|^b) * Product f;

theorem 
  Product (f|^a) = (Product f) |^ a;

begin 

registration
  let X be set;
  cluster natural-valued finite-support for ManySortedSet of X;
end;

definition
  let X be set, b be real-valued ManySortedSet of X, a be Nat;
  func a * b -> ManySortedSet of X means


  for i being set holds it.i = a * b.i;
end;

registration
  let X be set, b be real-valued ManySortedSet of X, a be Nat;
  cluster a * b -> real-valued;
end;

registration
  let X be set, b be natural-valued ManySortedSet of X, a be Nat;
  cluster a * b -> natural-valued;
end;

registration
  let X be set, b be real-valued ManySortedSet of X;
  cluster support (0*b) -> empty;
end;

theorem 
  for X being set, b being real-valued ManySortedSet of X st a <>
  0 holds support b = support (a*b);

registration
  let X be set, b be real-valued finite-support ManySortedSet of X, a be
  Nat;
  cluster a * b -> finite-support;
end;

definition
  let X be set;
  let b1, b2 be real-valued ManySortedSet of X;
  func min(b1,b2) -> ManySortedSet of X means


  for i being set holds (b1
  .i <= b2.i implies it.i = b1.i) & (b1.i > b2.i implies it.i = b2.i);
end;

registration
  let X be set;
  let b1, b2 be real-valued ManySortedSet of X;
  cluster min(b1,b2) -> real-valued;
end;

registration
  let X be set;
  let b1, b2 be natural-valued ManySortedSet of X;
  cluster min(b1,b2) -> natural-valued;
end;

theorem 
  for X being set, b1, b2 being real-valued finite-support
  ManySortedSet of X holds support min(b1,b2) c= support b1 \/ support b2;

registration
  let X be set;
  let b1, b2 be real-valued finite-support ManySortedSet of X;
  cluster min(b1,b2) -> finite-support;
end;

definition
  let X be set;
  let b1, b2 be real-valued ManySortedSet of X;
  func max(b1,b2) -> ManySortedSet of X means


  for i being set holds (b1
  .i <= b2.i implies it.i = b2.i) & (b1.i > b2.i implies it.i = b1.i);
end;

registration
  let X be set;
  let b1, b2 be real-valued ManySortedSet of X;
  cluster max(b1,b2) -> real-valued;
end;

registration
  let X be set;
  let b1, b2 be natural-valued ManySortedSet of X;
  cluster max(b1,b2) -> natural-valued;
end;

theorem 
  for X being set, b1, b2 being real-valued finite-support
  ManySortedSet of X holds support max(b1,b2) c= support b1 \/ support b2;

registration
  let X be set;
  let b1, b2 be real-valued finite-support ManySortedSet of X;
  cluster max(b1,b2) -> finite-support;
end;

registration
  let A be set;
  cluster finite-support complex-yielding for ManySortedSet of A;
end;

definition
  let A be set, b be finite-support complex-yielding ManySortedSet of A;
  func Product b -> complex number means


  ex f being FinSequence of COMPLEX st it = Product f & f = b*canFS(support b);
end;

definition
  let A be set, b be bag of A;
  redefine func Product b -> Element of NAT;
end;

theorem 
  for X being set, a, b being bag of X st support a misses support
  b holds Product (a+b) = (Product a) * Product b;

definition
  let X be set, b be real-valued ManySortedSet of X, n be non empty Nat;
  func b |^ n -> ManySortedSet of X means


  support it = support b & for i being set holds it.i = b.i |^ n;
end;

registration
  let X be set, b be natural-valued ManySortedSet of X, n be non empty Nat;
  cluster b |^ n -> natural-valued;
end;

registration
  let X be set, b be real-valued finite-support ManySortedSet of X, n be non
  empty Nat;
  cluster b |^ n -> finite-support;
end;

theorem 
  for A being set holds Product EmptyBag A = 1;

begin 

definition
  let n, d be Nat such that
 d <> 1 and
 n <> 0;
  func d |-count n -> Nat means


  d |^ it divides n & not d |^ (it+1) divides n;
end;

definition
  let n, d be Nat;
  redefine func d |-count n -> Element of NAT;
end;

theorem 
  n <> 1 implies n |-count 1 = 0;

theorem 
  1 < n implies n |-count n = 1;

theorem 
  b <> 0 & b < a & a <> 1 implies a |-count b = 0;

theorem 
  a <> 1 & a <> p implies a |-count p = 0;

theorem 
  1 < b implies b |-count (b|^a) = a;

theorem 
  b <> 1 & a <> 0 & b divides b |^ (b |-count a) implies b divides a;

theorem 
  b <> 1 implies (a <> 0 & b |-count a = 0 iff not b divides a);

theorem 
  for a, b being non empty Nat holds p |-count (a*b) =
  (p |-count a) + (p |-count b);

theorem 
  for a, b being non empty Nat holds p |^ (p |-count (a
  *b)) = (p |^ (p |-count a)) * (p |^ (p |-count b));

theorem 
  for a, b being non empty Nat st b divides a holds p
  |-count b <= p |-count a;

theorem 
  for a, b being non empty Nat st b divides a holds p
  |-count (a div b) = (p |-count a) -' (p |-count b);

theorem 
  for a being non empty Nat holds p |-count (a|^b) = b
  * (p |-count a);

begin 

definition
  let n be Nat;
  func prime_exponents n -> ManySortedSet of SetPrimes means


  for p being Prime holds it.p = p |-count n;
end;

notation
  let n be Nat;
  synonym pfexp n for prime_exponents n;
end;

theorem 
  for x being set st x in dom pfexp n holds x is Prime;

theorem 
  for x being set st x in support pfexp n holds x is Prime;

theorem 
  a > n & n <> 0 implies (pfexp n).a = 0;

registration
  let n be Nat;
  cluster pfexp n -> natural-valued;
end;

theorem 
  a in support pfexp b implies a divides b;

theorem 
  b is non empty & a is Prime & a divides b implies a in support pfexp b;

registration
  let n be non empty Nat;
  cluster pfexp n -> finite-support;
end;

theorem 
  for a being non empty Nat st p divides a holds (pfexp a).p <> 0;

theorem 
  pfexp 1 = EmptyBag SetPrimes;

registration
  cluster support pfexp 1 -> empty;
end;

theorem 
  (pfexp (p|^a)).p = a;

theorem 
  (pfexp p).p = 1;

theorem 
  a <> 0 implies support pfexp (p|^a) = {p};

theorem 
  support pfexp p = {p};

registration
  let p be Prime;
  let a be non empty Nat;
  cluster support pfexp (p|^a) -> 1-element;
end;

registration
  let p be Prime;
  cluster support pfexp p -> 1-element;
end;

theorem 
  for a, b being non empty Nat st a,b are_relative_prime holds
  support pfexp a misses support pfexp b;

theorem 
  for a,b being non empty Nat holds support pfexp a c=
  support pfexp (a*b);

theorem 
  for a, b being non empty Nat holds support pfexp (a*b) = support
  pfexp a \/ support pfexp b;

theorem 
  for a, b being non empty Nat st a,b are_relative_prime holds card
  support pfexp (a*b) = card support pfexp a + card support pfexp b;

theorem 
  for a, b being non empty Nat holds support pfexp a =
  support pfexp (a|^b);

reserve n, m for non empty Nat;

theorem 
  pfexp (n*m) = pfexp n + pfexp m;

theorem 
  m divides n implies pfexp (n div m) = pfexp n -' pfexp m;

theorem 
  pfexp (n|^a) = a * pfexp n;

theorem 
  support pfexp n = {} implies n = 1;

theorem 
  for m, n being non empty Nat holds pfexp (n gcd m) = min(pfexp n, pfexp m);

theorem 
  for m, n being non empty Nat holds pfexp (n lcm m) = max(pfexp n, pfexp m);

begin 

definition
  let n be non empty Nat;
  func prime_factorization n -> ManySortedSet of SetPrimes means


support it = support pfexp n & for p being Nat st p in support pfexp
  n holds it.p = p |^ (p |-count n);
end;

notation
  let n be non empty Nat;
  synonym ppf n for prime_factorization n;
end;



registration
  let n be non empty Nat;
  cluster ppf n -> natural-valued finite-support;
end;

theorem 
  p |-count n = 0 implies (ppf n).p = 0;

theorem 
  p |-count n <> 0 implies (ppf n).p = p |^ (p |-count n);

theorem 
  support ppf n = {} implies n = 1;

theorem 
  for a, b being non empty Nat st a, b are_relative_prime holds
  ppf (a*b) = ppf a + ppf b;

theorem 
  (ppf (p |^ n)).p = p |^ n;

theorem 
  ppf (n|^m) = (ppf n) |^ m;


theorem 
  Product ppf n = n;














begin 

theorem 
  for r,s being real number holds 0<=r & s*s<r*r implies s<r;

theorem 
  for r,s being real number holds 1<r & r*r <= s implies r<s;

theorem 
  for a,n being Nat st a>1 holds a|^n > n;

theorem 
  for n,k,m being Nat st k <= n & m = [\ n/2 /] holds n choose m >= n choose k;

theorem 
  for n,m being Nat st m=[\ n/2 /] & n>=2 holds n choose m >= 2|^n / n;

theorem 
  for n being Nat holds 2*n choose n >= 4|^n / (2*n);

theorem 
  for n,p being Nat holds p>0 & n divides p & n <> 1 & n <> p
  implies 1 < n & n < p;

theorem 
  for p being Nat holds (ex n being Element of NAT st n divides p &
  1<n & n<p) implies ex n being Element of NAT st n divides p & 1<n & n*n <= p;

theorem 
  for i,j,k,l being Nat st i=j*k+l & l<j & 0<l holds not j divides i;

theorem 
  for n,q,b being Nat holds q gcd b = 1 & q<>0 & b<>0 implies q|^n gcd b = 1;

theorem 
  for a,b,c being Nat holds a|^(2*b) mod c = (a|^b mod c)*(a|^b mod c) mod c;

theorem 
  for p being Nat holds not p is prime iff p<=1 or ex n being
  Element of NAT st n divides p & 1<n & n<p;

theorem 
  for n,k being Nat st n divides k & 1<n holds ex p being Element
  of NAT st p divides k & p<=n & p is prime;

theorem 
  for p being Nat holds p is prime iff p>1 & for n being Element
  of NAT holds 1<n & n*n<=p & n is prime implies not n divides p;

theorem 
  for a,p,k being Nat holds a|^k mod p = 1 & k>=1 & p is prime
  implies a,p are_relative_prime;

theorem 
  for p being Prime, a being Element of NAT, x being set st a<>0 &
x=p |^ ( p |-count a) holds ex b being Element of NAT st b=x & 1 <= b & b <= a;

theorem 
  for k,q,n,d being Element of NAT holds q is prime & d divides k*
  q|^(n+1) & not d divides k*q|^n implies q|^(n+1) divides d;

theorem 
  for q1,q,n1 being Element of NAT st q1 divides q|^n1 & q is
  prime & q1 is prime holds q=q1;

theorem 
  for p being Prime, n being Element of NAT st n<p holds not p divides n!;

theorem 
  for a,b being non empty Nat holds (for p being Element of NAT st
p is prime holds p |-count a <= p |-count b) implies ex c being Element of NAT
  st b=a*c;

theorem 
  for a,b being non empty Nat holds (for p being Element of NAT st
  p is prime holds p |-count a = p |-count b) implies a=b;

theorem 
  for p1,p2 being Prime, m being non empty Element of NAT st p1|^(
  p1 |-count m) = p2|^(p2 |-count m) & p1 |-count m > 0 holds p1=p2;

begin 

theorem 
  for n,k,q,p,n1,p,a being Element of NAT st n-1=k*q|^n1 & k>0 &
  n1>0 & q is prime & a|^(n-'1) mod n = 1 & p is prime & p divides n holds p
  divides (a|^((n-'1) div q) -' 1) or p mod q|^n1 = 1;

theorem 
  for n,f,c being Element of NAT st n-1=f*c & f>c & c>0 & (for q
  being Element of NAT st q divides f & q is prime holds ex a being Element of
NAT st a|^(n-'1) mod n = 1 & (a|^((n-'1) div q)-'1) gcd n = 1) holds n is prime
;


theorem 
  for n,f,d,n1,a,q being Element of NAT st n-1=q|^n1*d & q|^n1>d &
d>0 & q is prime & a|^(n-'1) mod n = 1 & (a|^((n-'1) div q)-'1) gcd n = 1 holds
  n is prime;

begin 

theorem 
  7 is prime;

theorem 
  11 is prime;

theorem 
  13 is prime;

theorem 
  19 is prime;

theorem 
  23 is prime;

theorem 
  37 is prime;

theorem 
  43 is prime;

theorem 
  83 is prime;

theorem 
  139 is prime;

theorem 
  163 is prime;

theorem 
  317 is prime;

theorem 
  631 is prime;

theorem 
  1259 is prime;

theorem 
  2503 is prime;

theorem 
  4001 is prime;

begin 

theorem 
  for f,f0,f1 being FinSequence of REAL st f=f0+f1 holds dom f =
  dom f0 /\ dom f1;

theorem 
  for F being FinSequence of REAL st (for k being Element of NAT
  st k in dom F holds F.k > 0) holds Product F > 0;

theorem 
  for X1 being set, X2 being finite set st X1 c= X2 & X2 c= NAT &
  not {} in X2 holds Product Sgm X1 <= Product Sgm X2;

theorem 
  for a,k being Element of NAT, X being set, F being FinSequence
  of SetPrimes, p being Prime st X c= SetPrimes & X c= Seg k & F = Sgm X & a =
Product F holds (p in rng F implies p |-count a = 1) & (not p in rng F implies
  p |-count a = 0);

theorem 
  for n being Element of NAT holds Product Sgm{p where p is prime
  Element of NAT:p<=n+1} <= 4 to_power n;

theorem 
  for x being Real st x>=2 holds Product Sgm{p where p is prime
  Element of NAT:p<=x} <= 4 to_power (x-1);

theorem 
  for n being Element of NAT, p being Prime st n<>0 ex f being
  FinSequence of NAT st len f = n & (for k being Element of NAT st k in dom f
holds (f.k=1 iff p|^k divides n) & (f.k=0 iff not p|^k divides n)) & p |-count
  n = Sum f;

theorem 
  for n being Element of NAT, p being Prime ex f being FinSequence
of NAT st len f = n & (for k being Element of NAT st k in dom f holds f.k=[\ n/
  (p|^k) /]) & p |-count (n!) = Sum f;

theorem 
  for n being Element of NAT, p being Prime ex f being FinSequence
of REAL st len f = 2*n & (for k being Element of NAT st k in dom f holds f.k=[\
  (2*n)/(p|^k)/] - 2*[\n/(p|^k)/]) & p |-count (2*n choose n) = Sum f;

definition
  let f be FinSequence of NAT,p be Prime;
  func p |-count f -> FinSequence of NAT means


  len it = len f & for i being set st i in dom it holds it.i = p |-count f.i;
end;

theorem 
  for p being Prime, f being FinSequence of NAT st f={} holds p |-count f = {};

theorem 
  for p being Prime, f1,f2 being FinSequence of NAT holds p
  |-count (f1^f2) = (p |-count f1)^(p |-count f2);

theorem 
  for p being Prime, n being non empty Element of NAT holds p
  |-count <*n*> = <* (p |-count n) *>;

theorem 
  for f being FinSequence of NAT, p being Prime st Product f <> 0
  holds p |-count (Product f) = Sum (p |-count f);

theorem 
  for f1,f2 being FinSequence of REAL st len f1 = len f2 & (for k
being Element of NAT st k in dom f1 holds f1.k<=f2.k & f1.k>0) holds Product f1
  <= Product f2;

theorem 
  for n being Element of NAT, r being Real st r>0 holds Product (n
  |-> r) = r to_power n;

scheme 

  scheme1 { P[set,set,set] } : for p being Prime, n being Element of NAT, m
being non empty Element of NAT, X being set st X = {p9|^(p9 |-count m) where p9
  is prime Element of NAT: P[n,m,p9]} holds Product Sgm X > 0;

scheme 

  scheme2 { P[set,set,set] } : for p being Prime, n being Element of NAT, m
being non empty Element of NAT, X being set st X = {p9|^(p9 |-count m) where p9
is prime Element of NAT: P[n,m,p9]} & not p|^(p |-count m) in X holds p |-count
  (Product Sgm X) = 0;

scheme 

  scheme3 { P[set,set,set] } : for p being Prime, n being Element of NAT, m
being non empty Element of NAT, X being set st X = {p9|^(p9 |-count m) where p9
  is prime Element of NAT: P[n,m,p9]} & p|^(p |-count m) in X holds p |-count (
  Product Sgm X) = p |-count m;

scheme 

  scheme4 { A(set,set) -> set, P[set,set] } : for n,m being Element of NAT, r
being Real, X being finite set st X = {A(p,m) where p is prime Element of NAT:
  p <= r & P[p,m]} & r>=0 holds card X <= [\ r /];

begin 


theorem 
  for n being Element of NAT st n>=1 holds ex p being Prime st n<p & p<= 2*n;














begin

reserve k,n,i,j for Nat;

theorem 
  for f being Permutation of Seg 2 holds f=<*1,2*> or f=<*2,1*>;

theorem 
  for f being FinSequence st f=<*1,2*> or f=<*2,1*> holds f is
  Permutation of Seg 2;

theorem 
  Permutations(2)={<*1,2*>,<*2,1*>};

theorem 
  for p being Permutation of Seg 2 st p is being_transposition
  holds p = <*2,1*>;

theorem 
  for D being non empty set, f being FinSequence of D, k2 being
  Element of NAT st 1<=k2 & k2< len f holds f = mid(f,1,k2)^mid(f,k2+1,len f);

theorem 
  for D being non empty set, f being FinSequence of D st 2<= len f
  holds f = (f|(len f-'2))^mid(f,len f-'1,len f);

theorem 
  for D being non empty set, f being FinSequence of D st 1<= len f
  holds f = (f|(len f-'1))^mid(f,len f,len f);

theorem 
  for a being Element of Group_of_Perm 2 st (ex q being Element of
  Permutations 2 st q=a & q is being_transposition) holds a = <*2,1*>;

theorem 
  for n being Element of NAT,a,b being Element of Group_of_Perm n, pa,pb
being Element of Permutations n st a=pa & b=pb holds a*b=pb*pa;

theorem 
  for a,b being Element of Group_of_Perm 2 st (ex p being Element
  of Permutations 2 st p=a & p is being_transposition)& (ex q being Element of
  Permutations 2 st q=b & q is being_transposition) holds a*b = <*1,2*>;

theorem 
  for l being FinSequence of Group_of_Perm 2 st (len l) mod 2=0 &
  (for i st i in dom l holds (ex q being Element of Permutations 2 st l.i=q & q
  is being_transposition)) holds Product l = <*1,2*>;

theorem 
  for K being Field, M being Matrix of 2,K holds Det M = (M*(1,1))*(M*(2
  ,2))-(M*(1,2))*(M*(2,1));

definition
  let n be Nat,K be Field;
  let M be (Matrix of n,K), a be Element of K;
  redefine func a*M -> Matrix of n,K;
end;

theorem 
  for K being Field, n,m being Element of NAT holds len (0.(K,n,m)
  )=n & dom (0.(K,n,m))=Seg n;

theorem 
  for K being Field, n being Element of NAT, p being Element of
  Permutations n, i being Element of NAT st i in Seg n holds p.i in Seg n;

theorem 
  for K being Field, n being Element of NAT st n>=1 holds Det (0.(K,n,n)
  ) = 0.K;

definition
  let x,y,a,b be set;
  func IFIN(x,y,a,b) equals


  a if x in y otherwise b;
end;

theorem 
  for K being Field, n being Element of NAT st n>=1 holds Det (1.(K,n)) = 1_K;

definition
  let n be Nat, K be Field, M be Matrix of n,K;
  redefine attr M is diagonal means


  for i,j being Element of NAT st i
  in Seg n & j in Seg n & i <> j holds M*(i,j) = 0.K;
end;

theorem 
  for K being Field, n being Element of NAT, A being Matrix of n,K st n
  >=1 & A is diagonal holds Det A = (the multF of K) $$ (diagonal_of_Matrix A);

theorem 
  for p being Element of Permutations(n) holds p" is Element of Permutations(n)
;

definition
  let n;
  let p be Element of Permutations(n);
  redefine func p" -> Element of Permutations(n);
end;

theorem 
  for K being Field,A being Matrix of n,K holds A@ is Matrix of n, K;

theorem 
  for G being Group, f1,f2 being FinSequence of G holds (Product (f1^f2)
  )" = (Product f2)" * (Product f1)";

definition
  let G be Group, f be FinSequence of G;
  canceled;
  func f" -> FinSequence of G means


  len it = len f &
  for i being Element of NAT st i in dom f holds it/.i = (f/.i)";
end;

theorem 
  for G being Group holds (<*>(the carrier of G))"=<*>(the carrier of G);

theorem 
  for G being Group, f,g being FinSequence of G holds (f^g)"=(f")^ (g");

theorem 
  for G being Group,a being Element of G holds (<*a*>)" =<* a" *>;

theorem 
  for G being Group, f being FinSequence of G holds Product (f^( Rev f)")=1_G;

theorem 
  for G being Group,f being FinSequence of G holds Product ((Rev f )" ^f)=1_G;

theorem 
  for G being Group,f being FinSequence of G holds (Product f)" =
  Product ((Rev f)");

theorem 
  for ITP being Element of Permutations(n), ITG being Element of
  Group_of_Perm(n) st ITG=ITP & n>=1 holds ITP"=ITG";

theorem 
  for n being Element of NAT, IT being Element of Permutations(n)
  st n>=1 holds IT is even iff IT" is even;

theorem 
  for n being Element of NAT,K being Field, p being Element of
  Permutations(n), x being Element of K st n>=1 holds -(x,p) = -(x,p");

theorem 
  for K being Field,f1,f2 being FinSequence of K holds (the multF
  of K) $$ (f1^f2) = ((the multF of K)$$f1)*((the multF of K)$$f2);

theorem 
  for K being Field,R1,R2 be FinSequence of K st R1,R2
  are_fiberwise_equipotent holds (the multF of K)$$ R1 = (the multF of K)$$ R2;

theorem 
  for n being Element of NAT, K being Field, p being Element of
  Permutations(n), f,g being FinSequence of K st len f=n & g=f*p holds f,g
  are_fiberwise_equipotent;

theorem 
  for n being Element of NAT, K being Field, p being Element of
  Permutations(n), f,g being FinSequence of K st n>=1 & len f=n & g=f*p holds (
  the multF of K) $$ f = (the multF of K) $$ g;

theorem 
  for n being Element of NAT, K being Field, p being Element of
  Permutations(n), f being FinSequence of K st n>=1 & len f=n holds f*p is
  FinSequence of K;

theorem 
  for n being Element of NAT, K being Field, p being Element of
  Permutations(n), A being Matrix of n,K st n>=1 holds Path_matrix(p",A@) = (
  Path_matrix(p,A))*p";

theorem 
  for n being Element of NAT, K being Field, p being Element of
Permutations(n), A being Matrix of n,K st n>=1 holds (Path_product(A@)).(p") =
  (Path_product(A)).p;

theorem 
  for n being Element of NAT, K being Field, A being Matrix of n,K st n
  >=1 holds Det (A) = Det (A@);














begin 



definition
  let O,E be set;
  let A be Action of O,E;
  let IT be set;
  pred IT is_stable_under_the_action_of A means


  for o being Element of
  O, f being Function of E, E st o in O & f = A.o holds (f .: IT) c= IT;
end;

definition
  let O,E be set;
  let A be Action of O,E;
  let X be Subset of E;
  func the_stable_subset_generated_by(X,A) -> Subset of E means


  X c= it & it is_stable_under_the_action_of A & for Y being Subset of E st Y
  is_stable_under_the_action_of A & X c= Y holds it c= Y;
end;

definition
  let O,E be set;
  let A be Action of O,E;
  let F be FinSequence of O;
  func Product(F,A) -> Function of E,E means


  it = id E if len F = 0
  otherwise ex PF being FinSequence of Funcs(E,E) st it = PF.(len F) & len PF =
  len F & PF.1 = A.(F.1) & for n being Nat st n<>0 & n<len F holds ex f,g being
  Function of E,E st f = PF.n & g = A.(F.(n+1)) & PF.(n+1) = f*g;
end;



definition
  let O be set;
  let G be Group;
  let IT be Action of O, the carrier of G;
  attr IT is distributive means


  for o being Element of O st o in O holds IT.o is Homomorphism of G, G;
end;

definition
  let O be set;
  struct (multMagma) HGrWOpStr over O (# carrier -> set, multF -> BinOp of the
    carrier, action -> Action of O, the carrier #);
end;

registration
  let O be set;
  cluster non empty for HGrWOpStr over O;
end;

definition
  let O be set;
  let IT be non empty HGrWOpStr over O;
  attr IT is distributive means


  for G being Group, a being Action of O,
  the carrier of G st a = the action of IT & the multMagma of G = the multMagma
  of IT holds a is distributive;
end;

registration
  let O be set;
  cluster strict distributive Group-like associative for
non empty HGrWOpStr over
    O;
end;



definition
  let O be set;
  mode GroupWithOperators of O is distributive Group-like associative non
    empty HGrWOpStr over O;
end;

definition
  let O be set;
  let G be GroupWithOperators of O;
  let o be Element of O;
  func G^o -> Homomorphism of G, G equals


  (the action of G).o if o in O
  otherwise id the carrier of G;
end;

definition
  let O be set;
  let G be GroupWithOperators of O;
  mode StableSubgroup of G -> distributive Group-like associative non empty
    HGrWOpStr over O means


    it is Subgroup of G & for o being Element of O
    holds it^o = (G^o)|the carrier of it;
end;

registration
  let O be set;
  let G be GroupWithOperators of O;
  cluster strict for StableSubgroup of G;
end;

definition
  let O be set;
  let G be GroupWithOperators of O;
  func (1).G -> strict StableSubgroup of G means


  the carrier of it = { 1_G};
end;

definition
  let O be set;
  let G be GroupWithOperators of O;
  func (Omega).G -> strict StableSubgroup of G equals

  the HGrWOpStr of G;
end;

definition
  let O be set;
  let G be GroupWithOperators of O;
  let IT be StableSubgroup of G;
  attr IT is normal means


  for H being strict Subgroup of G st H = the
  multMagma of IT holds H is normal;
end;

registration
  let O be set;
  let G be GroupWithOperators of O;
  cluster strict normal for StableSubgroup of G;
end;

registration
  let O be set;
  let G be GroupWithOperators of O;
  let H be StableSubgroup of G;
  cluster normal for StableSubgroup of H;
end;

registration
  let O be set;
  let G be GroupWithOperators of O;
  cluster (1).G -> normal;
  cluster (Omega).G -> normal;
end;

definition
  let O be set;
  let G be GroupWithOperators of O;
  func the_stable_subgroups_of G -> set means


  for x being set holds x in it iff x is strict StableSubgroup of G;
end;

registration
  let O be set;
  let G be GroupWithOperators of O;
  cluster the_stable_subgroups_of G -> non empty;
end;

definition
  let IT be Group;
  attr IT is simple means


  IT is not trivial & not ex H being strict
  normal Subgroup of IT st H <> (Omega).IT & H <> (1).IT;
end;

registration
  cluster strict simple for Group;
end;



definition
  let O be set;
  let IT be GroupWithOperators of O;
  attr IT is simple means


  IT is not trivial & not ex H being strict
  normal StableSubgroup of IT st H <> (Omega).IT & H <> (1).IT;
end;

registration
  let O be set;
  cluster strict simple for GroupWithOperators of O;
end;

definition
  let O be set;
  let G be GroupWithOperators of O;
  let N be normal StableSubgroup of G;
  func Cosets N -> set means


  for H being strict normal Subgroup of G
  st H = the multMagma of N holds it = Cosets H;
end;

definition
  let O be set;
  let G be GroupWithOperators of O;
  let N be normal StableSubgroup of G;
  func CosOp N -> BinOp of Cosets N means


  for H being strict normal
  Subgroup of G st H = the multMagma of N holds it = CosOp H;
end;

definition
  let O be set;
  let G be GroupWithOperators of O;
  let N be normal StableSubgroup of G;
  func CosAc N -> Action of O, Cosets N means


  for o being Element of O
holds it.o = {[A,B] where A,B is Element of Cosets N: ex g,h being Element of G
  st g in A & h in B & h = (G^o).g} if O is not empty otherwise it=[:{},{id
  Cosets N}:];
end;

definition
  let O be set;
  let G be GroupWithOperators of O;
  let N be normal StableSubgroup of G;
  func G./.N -> HGrWOpStr over O equals

  HGrWOpStr (# Cosets N, CosOp N, CosAc
    N #);
end;

registration
  let O be set;
  let G be GroupWithOperators of O;
  let N be normal StableSubgroup of G;
  cluster G./.N -> non empty;
  cluster G./.N -> distributive Group-like associative;
end;



definition
  let O be set;
  let G,H be GroupWithOperators of O;
  let f be Function of G, H;
  attr f is homomorphic means


  for o being Element of O, g being
  Element of G holds f.((G^o).g) = (H^o).(f.g);
end;

registration
  let O be set;
  let G,H be GroupWithOperators of O;
  cluster multiplicative homomorphic for Function of G, H;
end;

definition
  let O be set;
  let G,H be GroupWithOperators of O;
  mode Homomorphism of G, H is multiplicative homomorphic Function of G, H;
end;

definition
  let O be set;
  let G,H,I be GroupWithOperators of O;
  let h be Homomorphism of G, H;
  let h1 be Homomorphism of H, I;
  redefine func h1 * h -> Homomorphism of G,I;
end;

definition

  let O be set;
  let G,H be GroupWithOperators of O;
  pred G,H are_isomorphic means


  ex h being Homomorphism of G,H st h is bijective;
  reflexivity;
end;

definition
  let O be set, G,H be GroupWithOperators of O;
  redefine pred G,H are_isomorphic;
  symmetry;
end;

definition
  let O be set;
  let G be GroupWithOperators of O;
  let N be normal StableSubgroup of G;
  func nat_hom N -> Homomorphism of G, G./.N means


  for H being strict
  normal Subgroup of G st H = the multMagma of N holds it = nat_hom H;
end;

definition
  let O be set;
  let G,H be GroupWithOperators of O;
  let g be Homomorphism of G, H;
  func Ker g -> strict StableSubgroup of G means


  the carrier of it = { a where a is Element of G: g.a = 1_H};
end;

registration
  let O be set;
  let G,H be GroupWithOperators of O;
  let g be Homomorphism of G, H;
  cluster Ker g -> normal;
end;

definition
  let O be set;
  let G,H be GroupWithOperators of O;
  let g be Homomorphism of G, H;
  func Image g -> strict StableSubgroup of H means


  the carrier of it = g.:(the carrier of G);
end;

definition
  let O be set;
  let G be GroupWithOperators of O;
  let H be StableSubgroup of G;
  func carr(H) -> Subset of G equals

  the carrier of H;
end;

definition
  let O be set;
  let G be GroupWithOperators of O;
  let H1,H2 be StableSubgroup of G;
  func H1 * H2 -> Subset of G equals

  carr H1 * carr H2;
end;

definition
  let O be set;
  let G be GroupWithOperators of O;
  let H1,H2 be StableSubgroup of G;
  func H1 /\ H2 -> strict StableSubgroup of G means


  the carrier of it = carr(H1) /\ carr(H2);
  commutativity;
end;



definition
  let O be set;
  let G be GroupWithOperators of O;
  let A be Subset of G;
  func the_stable_subgroup_of A -> strict StableSubgroup of G means


  A c= the carrier of it & for H being strict StableSubgroup of G st A c= the
  carrier of H holds it is StableSubgroup of H;
end;

definition
  let O be set;
  let G be GroupWithOperators of O;
  let H1,H2 be StableSubgroup of G;
  func H1 "\/" H2 -> strict StableSubgroup of G equals

  the_stable_subgroup_of
  (carr H1 \/ carr H2);
end;

begin 

reserve x,O for set,
  o for Element of O,
  G,H,I for GroupWithOperators of O,
  A, B for Subset of G,
  N for normal StableSubgroup of G,
  H1,H2,H3 for StableSubgroup of G,
  g1,g2 for Element of G,
  h1,h2 for Element of H1,
  h for Homomorphism of G,H;



theorem 
  x in H1 implies x in G;



theorem 
  h1 is Element of G;



theorem 
  h1 = g1 & h2 = g2 implies h1 * h2 = g1 * g2;



theorem 
  1_G = 1_H1;



theorem 
  1_G in H1;



theorem 
  h1 = g1 implies h1" = g1";



theorem 
  g1 in H1 & g2 in H1 implies g1 * g2 in H1;



theorem 
  g1 in H1 implies g1" in H1;



theorem 
  A <> {} & (for g1,g2 st g1 in A & g2 in A holds g1 * g2 in A) & (for
  g1 st g1 in A holds g1" in A) & (for o,g1 st g1 in A holds (G^o).g1 in A)
implies ex H being strict StableSubgroup of G st the carrier of H = A;



theorem 
  G is StableSubgroup of G;



theorem 
  for G1,G2,G3 being GroupWithOperators of O holds G1 is
StableSubgroup of G2 & G2 is StableSubgroup of G3 implies G1 is StableSubgroup
  of G3;



theorem 
  the carrier of H1 c= the carrier of H2 implies H1 is StableSubgroup of
  H2;



theorem 
  (for g being Element of G st g in H1 holds g in H2) implies H1
  is StableSubgroup of H2;



theorem 
  for H1,H2 being strict StableSubgroup of G st the carrier of H1 = the
  carrier of H2 holds H1 = H2;



theorem 
  (1).G = (1).H1;



theorem 
  (1).G is StableSubgroup of H1;



theorem 
  carr H1 * carr H2 = carr H2 * carr H1 implies ex H being strict
  StableSubgroup of G st the carrier of H=carr H1 * carr H2;



theorem 
  (for H being StableSubgroup of G st H = H1 /\ H2 holds the
carrier of H = (the carrier of H1) /\ (the carrier of H2)) & for H being strict
  StableSubgroup of G holds the carrier of H = (the carrier of H1) /\ (the
  carrier of H2) implies H = H1 /\ H2;



theorem 
  for H being strict StableSubgroup of G holds H /\ H = H;



theorem 
  H1 /\ H2 /\ H3 = H1 /\ (H2 /\ H3);



theorem 
  (1).G /\ H1 = (1).G & H1 /\ (1).G = (1).G;



theorem 
  union Cosets N = the carrier of G;



theorem 
  for N1,N2 being strict normal StableSubgroup of G ex N being
  strict normal StableSubgroup of G st the carrier of N = carr N1 * carr N2;



theorem 
  g1 in the_stable_subgroup_of A iff ex F being FinSequence of the
  carrier of G, I being FinSequence of INT, C being Subset of G st C =
the_stable_subset_generated_by (A, the action of G) & len F = len I & rng F c=
  C & Product(F |^ I) = g1;



theorem 
  for H being strict StableSubgroup of G holds
  the_stable_subgroup_of carr H = H;



theorem 
  A c= B implies the_stable_subgroup_of A is StableSubgroup of
  the_stable_subgroup_of B;

scheme 

  MeetSbgWOpEx{O() -> set, G() -> GroupWithOperators of O(), P[set]}: ex H
  being strict StableSubgroup of G() st the carrier of H = meet{A where A is
Subset of G() : ex K being strict StableSubgroup of G() st A = the carrier of K
  & P[K]}
provided
 ex H being strict StableSubgroup of G() st P[H];



theorem 
  the carrier of the_stable_subgroup_of A = meet{B where B is
Subset of G: ex H being strict StableSubgroup of G st B = the carrier of H & A
  c= carr H};



theorem 
  for N1,N2 being strict normal StableSubgroup of G holds N1 * N2 = N2 * N1;



theorem 
  H1 "\/" H2 = the_stable_subgroup_of(H1 * H2);



theorem 
  H1 * H2 = H2 * H1 implies the carrier of H1 "\/" H2 = H1 * H2;



theorem 
  for N1,N2 being strict normal StableSubgroup of G holds the
  carrier of N1 "\/" N2 = N1 * N2;



theorem 
  for N1,N2 being strict normal StableSubgroup of G holds N1 "\/"
  N2 is normal StableSubgroup of G;



theorem 
  for H being strict StableSubgroup of G holds (1).G "\/" H = H &
  H "\/" (1).G = H;



theorem 
  (Omega).G "\/" H1 = (Omega).G & H1 "\/" (Omega).G = (Omega).G;



theorem 
  H1 is StableSubgroup of H1 "\/" H2 & H2 is StableSubgroup of H1 "\/" H2;



theorem 
  for H2 being strict StableSubgroup of G holds H1 is
  StableSubgroup of H2 iff H1 "\/" H2 = H2;



theorem 
  for H3 being strict StableSubgroup of G holds H1 is
  StableSubgroup of H3 & H2 is StableSubgroup of H3 implies H1 "\/" H2 is
  StableSubgroup of H3;



theorem 
  for H2,H3 being strict StableSubgroup of G holds H1 is
  StableSubgroup of H2 implies H1 "\/" H3 is StableSubgroup of H2 "\/" H3;



theorem 
  for X,Y being StableSubgroup of H1, X9,Y9 being StableSubgroup
  of G st X = X9 & Y = Y9 holds X9 /\ Y9 = X /\ Y;



theorem 
  N is StableSubgroup of H1 implies N is normal StableSubgroup of H1;



theorem 
  H1 /\ N is normal StableSubgroup of H1 & N /\ H1 is normal
  StableSubgroup of H1;



theorem 
  for G being strict GroupWithOperators of O holds G is trivial
  implies (1).G = G;



theorem 
  1_(G./.N) = carr N;



theorem 
  for M,N being strict normal StableSubgroup of G, MN being normal
  StableSubgroup of N st MN=M & M is StableSubgroup of N holds N./.MN is normal
  StableSubgroup of G./.M;



theorem 
  h.(1_G)=1_H;



theorem 
  h.(g1")=(h.g1)";



theorem 
  g1 in Ker h iff h.g1 = 1_H;



theorem 
  for N being strict normal StableSubgroup of G holds Ker nat_hom N = N;



theorem 
  rng h = the carrier of Image h;



theorem 
  Image nat_hom N = G./.N;



theorem 
  for H being strict GroupWithOperators of O, h being Homomorphism
  of G,H holds h is onto iff Image h = H;



theorem 
  for H being strict GroupWithOperators of O, h being Homomorphism
of G,H st h is onto holds for c being Element of H ex a being Element of G st h
  .a = c;



theorem 
  nat_hom N is onto;



theorem 
  nat_hom (1).G is bijective;



theorem 
  G,H are_isomorphic & H,I are_isomorphic implies G,I are_isomorphic;



theorem 
  for G being strict GroupWithOperators of O holds G,G./.(1).G are_isomorphic;



theorem 
  for G being strict GroupWithOperators of O holds G./.(Omega).G is trivial;



theorem 
  for G,H being strict GroupWithOperators of O holds G,H
  are_isomorphic & G is trivial implies H is trivial;



theorem 
  G./.Ker h, Image h are_isomorphic;



theorem 
  for H,F1,F2 being strict StableSubgroup of G st F1 is normal
  StableSubgroup of F2 holds H /\ F1 is normal StableSubgroup of H /\ F2;

begin 

reserve E for set,
  A for Action of O,E,
  C for Subset of G,
  N1 for normal StableSubgroup of H1;

theorem 
  [#]E is_stable_under_the_action_of A;

theorem 
  [:O,{id E}:] is Action of O, E;

theorem 
  for O being non empty set, E being set, o being Element of O, A being
  Action of O,E holds Product(<*o*>,A) = A.o;

theorem 
  for O being non empty set, E being set, F1,F2 being FinSequence of O,
A being Action of O,E holds Product(F1^F2,A) = Product(F1,A) * Product(F2,A);

theorem 
  for F being FinSequence of O, Y being Subset of E st Y
  is_stable_under_the_action_of A holds Product(F,A) .: Y c= Y;

theorem 
  for E being non empty set, A being Action of O,E holds for X being
  Subset of E, a being Element of E st X is not empty holds a in
  the_stable_subset_generated_by(X,A) iff ex F being FinSequence of O, x being
  Element of X st Product(F,A).x = a;

theorem 
  for G being strict Group holds ex H being strict GroupWithOperators of
  O st G = the multMagma of H;

theorem 
  the multMagma of H1 is strict Subgroup of G;

theorem 
  the multMagma of N is strict normal Subgroup of G;

theorem 
  g1 in H1 implies (G^o).g1 in H1;

theorem 
  for O being set, G,H being GroupWithOperators of O, G9 being strict
  StableSubgroup of G, f being Homomorphism of G,H holds ex H9 being strict
  StableSubgroup of H st the carrier of H9 = f.:(the carrier of G9);

theorem 
  B is empty implies the_stable_subgroup_of B = (1).G;

theorem 
  B = the carrier of gr C implies the_stable_subgroup_of C =
  the_stable_subgroup_of B;

theorem 
  for N9 being normal Subgroup of G st N9 = the multMagma of N holds G
  ./.N9 = the multMagma of G./.N & 1_(G./.N9) = 1_(G./.N);

theorem 
  the carrier of H1 = the carrier of H2 implies the HGrWOpStr of
  H1 = the HGrWOpStr of H2;

theorem 
  H1./.N1 is trivial implies the HGrWOpStr of H1 = the HGrWOpStr of N1;

theorem 
  the carrier of H1 = the carrier of N1 implies H1./.N1 is trivial;



theorem 
  for G,H being GroupWithOperators of O, N being StableSubgroup of
G, H9 being strict StableSubgroup of H, f being Homomorphism of G,H st N = Ker
  f holds ex G9 being strict StableSubgroup of G st the carrier of G9 = f"(the
carrier of H9) & (H9 is normal implies N is normal StableSubgroup of G9 & G9 is
  normal);



theorem 
  for G,H being GroupWithOperators of O, N being StableSubgroup of
G, G9 being strict StableSubgroup of G, f being Homomorphism of G,H st N = Ker
  f holds ex H9 being strict StableSubgroup of H st the carrier of H9 = f.:(the
carrier of G9) & f"(the carrier of H9) = the carrier of G9"\/"N & (f is onto &
  G9 is normal implies H9 is normal);

theorem 
  for G being strict GroupWithOperators of O, N being strict
  normal StableSubgroup of G, H being strict StableSubgroup of G./.N st the
  carrier of G = (nat_hom N)"(the carrier of H) holds H = (Omega).(G./.N);

theorem 
  for G being strict GroupWithOperators of O, N being strict
  normal StableSubgroup of G, H being strict StableSubgroup of G./.N st the
  carrier of N = (nat_hom N)"(the carrier of H) holds H = (1).(G./.N);

theorem 
  for G,H being strict GroupWithOperators of O st G,H
  are_isomorphic & G is simple holds H is simple;

theorem 
  for G being GroupWithOperators of O, H being StableSubgroup of G
, FG being FinSequence of the carrier of G, FH being FinSequence of the carrier
of H, I be FinSequence of INT st FG=FH & len FG = len I holds Product(FG |^ I)
  = Product(FH |^ I);

theorem 
  for O,E1,E2 being set, A1 being Action of O,E1, A2 being Action
  of O,E2, F being FinSequence of O st E1 c= E2 & (for o being Element of O, f1
being Function of E1,E1, f2 being Function of E2,E2 st f1=A1.o & f2=A2.o holds
  f1 = f2|E1) holds Product(F,A1) = Product(F,A2)|E1;

theorem 
  for N1,N2 being strict StableSubgroup of H1, N19,N29 being
  strict StableSubgroup of G st N1 = N19 & N2 = N29 holds N19 * N29 = N1 * N2;

theorem 
  for N1,N2 being strict StableSubgroup of H1, N19,N29 being
strict StableSubgroup of G st N1 = N19 & N2 = N29 holds N19 "\/" N29 = N1 "\/"
  N2;

theorem 
  for N1,N2 being strict StableSubgroup of G st N1 is normal
  StableSubgroup of H1 & N2 is normal StableSubgroup of H1 holds N1 "\/" N2 is
  normal StableSubgroup of H1;

theorem 
  for f being Homomorphism of G,H holds for g being Homomorphism
  of H,I holds the carrier of Ker(g*f) = f"(the carrier of Ker g);

theorem 
  for G9 being StableSubgroup of G, H9 being StableSubgroup of H,
  f being Homomorphism of G,H st the carrier of H9 = f.:(the carrier of G9) or
  the carrier of G9 = f"(the carrier of H9) holds f|(the carrier of G9) is
  Homomorphism of G9,H9;



theorem 
  for G,H being strict GroupWithOperators of O, N,L,G9 being
  strict StableSubgroup of G, f being Homomorphism of G,H st N = Ker f & L is
strict normal StableSubgroup of G9 holds L"\/"(G9/\N) is normal StableSubgroup
of G9 & L"\/"N is normal StableSubgroup of G9"\/"N & for N1 being strict normal
StableSubgroup of G9"\/"N, N2 being strict normal StableSubgroup of G9 st N1=L
  "\/"N & N2=L"\/"(G9/\N) holds (G9"\/"N)./.N1, G9./.N2 are_isomorphic;



begin 

theorem 
  for H,K,H9,K9 being strict StableSubgroup of G, JH being normal
StableSubgroup of H9"\/"(H/\K), HK being normal StableSubgroup of H/\K st H9 is
normal StableSubgroup of H & K9 is normal StableSubgroup of K & JH = H9"\/"(H/\
  K9) & HK=(H9/\K)"\/"(K9/\H) holds (H9"\/"(H/\K))./.JH, (H/\K)./.HK
  are_isomorphic;

theorem 
  for H,K,H9,K9 being strict StableSubgroup of G st H9 is normal
  StableSubgroup of H & K9 is normal StableSubgroup of K holds H9"\/"(H/\K9) is
  normal StableSubgroup of H9"\/"(H/\K);


theorem 
  for H,K,H9,K9 being strict StableSubgroup of G, JH being normal
StableSubgroup of H9"\/"(H/\K), JK being normal StableSubgroup of K9"\/"(K/\H)
st JH = H9"\/"(H/\K9) & JK= K9"\/"(K/\H9) & H9 is normal StableSubgroup of H &
K9 is normal StableSubgroup of K holds (H9"\/"(H/\K))./.JH, (K9"\/"(K/\H))./.JK
  are_isomorphic;

begin 


definition
  let O be set;
  let G be GroupWithOperators of O;
  let IT be FinSequence of the_stable_subgroups_of G;
  attr IT is composition_series means


  IT.1=(Omega).G & IT.(len IT)=
  (1).G & for i being Nat st i in dom IT & i+1 in dom IT for H1,H2 being
StableSubgroup of G st H1=IT.i & H2=IT.(i+1) holds H2 is normal StableSubgroup
  of H1;
end;

registration
  let O be set;
  let G be GroupWithOperators of O;
  cluster composition_series for FinSequence of the_stable_subgroups_of G;
end;

definition
  let O be set;
  let G be GroupWithOperators of O;
  mode CompositionSeries of G is composition_series FinSequence of
    the_stable_subgroups_of G;
end;



definition
  let O be set;
  let G be GroupWithOperators of O;
  let s1,s2 be CompositionSeries of G;
  pred s1 is_finer_than s2 means


  ex x being set st x c= dom s1 & s2 = s1 * Sgm x;
  reflexivity;
end;

definition
  let O be set;
  let G be GroupWithOperators of O;
  let IT be CompositionSeries of G;
  attr IT is strictly_decreasing means


  for i being Nat st i in dom IT
& i+1 in dom IT for H being StableSubgroup of G, N being normal StableSubgroup
  of H st H=IT.i & N=IT.(i+1) holds H./.N is not trivial;
end;



definition
  let O be set;
  let G be GroupWithOperators of O;
  let IT be CompositionSeries of G;
  attr IT is jordan_holder means


  IT is strictly_decreasing & not ex s
  being CompositionSeries of G st s<>IT & s is strictly_decreasing & s
  is_finer_than IT;
end;



definition
  let O be set;
  let G1,G2 be GroupWithOperators of O;
  let s1 be CompositionSeries of G1;
  let s2 be CompositionSeries of G2;
  pred s1 is_equivalent_with s2 means


  len s1 = len s2 & for n being
  Nat st n + 1 = len s1 holds ex p being Permutation of Seg n st for H1 being
  StableSubgroup of G1, H2 being StableSubgroup of G2, N1 being normal
StableSubgroup of H1, N2 being normal StableSubgroup of H2, i,j being Nat st 1
<=i & i<=n & j=p.i & H1=s1.i & H2=s2.j & N1=s1.(i+1) & N2=s2.(j+1) holds H1./.
  N1,H2./.N2 are_isomorphic;
end;



definition
  let O be set;
  let G be GroupWithOperators of O;
  let s be CompositionSeries of G;
  func the_series_of_quotients_of s -> FinSequence means


  len s = len
  it + 1 & for i being Nat st i in dom it for H being StableSubgroup of G, N
being normal StableSubgroup of H st H=s.i & N=s.(i+1) holds it.i = H./.N if len
  s > 1 otherwise it={};
end;

definition
  let O be set;
  let f1,f2 be FinSequence;
  let p be Permutation of dom f1;
  pred f1,f2 are_equivalent_under p,O means


  len f1 = len f2 & for H1,
H2 being GroupWithOperators of O, i,j being Nat st i in dom f1 & j=p".i & H1=f1
  .i & H2=f2.j holds H1,H2 are_isomorphic;
end;

reserve y for set,
  H19,H29 for StableSubgroup of G,
  N19 for normal StableSubgroup of H19,
  s1,s19,s2,s29 for CompositionSeries of G,
  fs for FinSequence of the_stable_subgroups_of G,
  f1,f2 for FinSequence,
  i,j,n for Nat;

theorem 
  i in dom s1 & i+1 in dom s1 & s1.i=s1.(i+1) & fs=Del(s1,i)
  implies fs is composition_series;

theorem 
  s1 is_finer_than s2 implies ex n st len s1 = len s2 + n;

theorem 
  len s2 = len s1 & s2 is_finer_than s1 implies s1 = s2;

theorem 
  s1 is not empty & s2 is_finer_than s1 implies s2 is not empty;

theorem 
  s1 is_finer_than s2 & s1 is jordan_holder & s2 is jordan_holder implies s1=s2
;

theorem 
  i in dom s1 & i+1 in dom s1 & s1.i = s1.(i+1) & s19 = Del(s1,i)
  & s2 is jordan_holder & s1 is_finer_than s2 implies s19 is_finer_than s2;

theorem 
  len s1 > 1 & s2<>s1 & s2 is strictly_decreasing & s2
is_finer_than s1 implies ex i,j st i in dom s1 & i in dom s2 & i+1 in dom s1 &
i+1 in dom s2 & j in dom s2 & i+1<j & s1.i=s2.i & s1.(i+1)<>s2.(i+1) & s1.(i+1)
  =s2.j;

theorem 
  i in dom s1 & j in dom s1 & i<=j & H1 = s1.i & H2 = s1.j
  implies H2 is StableSubgroup of H1;

theorem 
  y in rng the_series_of_quotients_of s1 implies y is strict
  GroupWithOperators of O;

theorem 
  i in dom the_series_of_quotients_of s1 & (for H st H=(
the_series_of_quotients_of s1).i holds H is trivial) implies i in dom s1 & i+1
  in dom s1 & s1.i=s1.(i+1);

theorem 
  i in dom s1 & i+1 in dom s1 & s1.i=s1.(i+1) & s2=Del(s1,i)
  implies the_series_of_quotients_of s2=Del(the_series_of_quotients_of s1,i);

theorem 
  f1=the_series_of_quotients_of s1 & i in dom f1 & (for H st H = f1.i
holds H is trivial) implies Del(s1,i) is CompositionSeries of G & for s2 st s2
  = Del(s1,i) holds the_series_of_quotients_of s2 = Del(f1,i);

theorem 
  i in dom f1 & (ex p being Permutation of dom f1
  st f1,f2 are_equivalent_under p,O & j = p".i) implies ex p9 being Permutation
  of dom Del(f1,i) st Del(f1,i),Del(f2,j) are_equivalent_under p9,O;

theorem 
  for G1,G2 being GroupWithOperators of O, s1 being
  CompositionSeries of G1, s2 being CompositionSeries of G2 st s1 is empty & s2
  is empty holds s1 is_equivalent_with s2;

theorem 
  for G1,G2 being GroupWithOperators of O, s1 be
CompositionSeries of G1, s2 be CompositionSeries of G2 st s1 is not empty & s2
  is not empty holds s1 is_equivalent_with s2 iff ex p being Permutation of dom
  the_series_of_quotients_of s1 st the_series_of_quotients_of s1,
  the_series_of_quotients_of s2 are_equivalent_under p,O;

theorem 
  s1 is_finer_than s2 & s2 is jordan_holder & len s1 > len s2
  implies ex i st i in dom the_series_of_quotients_of s1 & for H st H = (
  the_series_of_quotients_of s1).i holds H is trivial;



theorem 
  len s1 > 1 implies (s1 is jordan_holder iff for i st i in dom
the_series_of_quotients_of s1 holds (the_series_of_quotients_of s1).i is strict
  simple GroupWithOperators of O);

theorem 
  1<=i & i<=len s1-1 implies s1.i is strict StableSubgroup of G &
  s1.(i+1) is strict StableSubgroup of G;

theorem 
  1<=i & i<=len s1-1 & H1=s1.i & H2=s1.(i+1) implies H2 is normal
  StableSubgroup of H1;

theorem 
  s1 is_equivalent_with s1;

theorem 
  (len s1<=1 or len s2<=1) & len s1<=len s2 implies s2 is_finer_than s1;

theorem 
  s1 is_equivalent_with s2 & s1 is jordan_holder implies s2 is jordan_holder;

begin 

definition
  let O,G,s1,s2;
  assume that
 len s1>1 and
 len s2>1;
  func the_schreier_series_of(s1,s2) -> CompositionSeries of G means


for k,i,j being Nat, H1,H2,H3 being StableSubgroup of G holds (k=(i-1)*(len s2-
1)+j & 1<=i & i<=len s1-1 & 1<=j & j<=len s2-1 & H1=s1.(i+1) & H2=s1.i & H3=s2.
j implies it.k = H1"\/"(H2/\H3)) & (k=(len s1-1)*(len s2-1) + 1 implies it.k =
  (1).G) & len it = (len s1-1)*(len s2-1) + 1;
end;

theorem 
  len s1>1 & len s2>1 implies the_schreier_series_of(s1,s2) is_finer_than s1;

theorem 
  len s1>1 & len s2>1 implies the_schreier_series_of(s1,s2)
  is_equivalent_with the_schreier_series_of(s2,s1);




theorem 
  ex s19,s29 st s19 is_finer_than s1 & s29 is_finer_than s2 & s19
  is_equivalent_with s29;

begin 



theorem 
  s1 is jordan_holder & s2 is jordan_holder implies s1 is_equivalent_with s2;

begin 

theorem 
  for P,R being Relation holds P = (rng P)|`R iff P~ = (R~)|(dom (P~));

theorem 
  for X being set, P,R being Relation holds P*(R|X) = (X|`P)*R;

theorem 
  for n being Nat, X being set, f being PartFunc of REAL, REAL st X c=
Seg n & X c= dom f & f|X is increasing & f.:X c= NAT \ {0} holds Sgm(f.:X) = f
  * Sgm X;

theorem 
  for y being set, i,n being Nat st y c= Seg(n+1) & i in Seg(n+1) & not
  i in y holds ex x st Sgm x = Sgm(Seg(n+1)\{i})" * Sgm y & x c= Seg n;

theorem 
  for D being non empty set, f being FinSequence of D, p being Element
  of D, n being Nat st n in dom f holds f = Del(Ins(f,n,p),n+1);

theorem 
  for G,H being Group, F1 being FinSequence of the carrier of G, F2
  being FinSequence of the carrier of H, I being FinSequence of INT, f being
Homomorphism of G,H st (for k being Nat st k in dom F1 holds F2.k = f.(F1.k)) &
  len F1 = len I & len F2 = len I holds f.(Product(F1 |^ I)) = Product(F2 |^ I)
;














begin

reserve G for strict Group,
  a,b,x,y,z for Element of G,
  H,K for strict Subgroup of G,
  p for Element of NAT,
  A for Subset of G;

theorem 
  for G being strict finite Group holds
  p is prime & card G = p implies ex a being Element of G st ord a = p;

theorem 
  for G being Group, H being Subgroup of G, a1,a2 being Element of H
  for b1,b2 being Element of G st a1 = b1 & a2 = b2 holds a1*a2 = b1*b2;

theorem 
  for G being Group, H being Subgroup of G, a being Element of H
  for b being Element of G st a = b for n being Element of NAT
  holds a|^n = b|^n;

theorem 
  for G being Group, H being Subgroup of G, a being Element of H
  for b being Element of G st a = b for i being Integer
  holds a|^i = b|^i;

theorem 
  for G being Group, H being Subgroup of G, a being Element of H
  for b being Element of G st a = b & G is finite holds ord a = ord b;

theorem 
  for G being Group, H being Subgroup of G, h being Element of G st
  h in H holds H * h c= the carrier of H;

theorem 
  for G being Group for a being Element of G st a <> 1_G holds gr {a} <> (1).G;

theorem 
  for G being Group, m being Integer holds (1_G) |^ m = 1_G;

theorem 
  for m being Integer holds a |^ (m * ord a) = 1_G;

theorem 
  for a st a is not being_of_order_0
  for m being Integer holds a |^ m = a |^(m mod ord a);

theorem 
  b is not being_of_order_0 implies gr {b} is finite;

theorem 
  b is being_of_order_0 implies b" is being_of_order_0;

theorem 
  b is being_of_order_0 iff for n being Integer st b |^n = 1_G holds n = 0;

theorem 
  for G st ex a st a <> 1_G holds (for H holds H = G or H = (1).G) iff
  G is cyclic & G is finite & ex p being Element of NAT
  st card G = p & p is prime;

theorem 
  for G being Group, x,y,z being Element of G for A being Subset of G holds
  z in x * A * y iff ex a being Element of G st z = x * a * y & a in A;

theorem 
  for G being Group, A being non empty Subset of G holds
  for x being Element of G holds card A = card (x" * A * x);

definition
  let G, H, K;
  func Double_Cosets (H, K) -> Subset-Family of G means

  A in it iff ex a st A = H * a * K;
end;

theorem 
  z in H * x * K iff ex g,h being Element of G st
  z = g * x * h & g in H & h in K;

theorem 
  for H, K holds H * x * K = H * y * K or
  not ex z st z in H * x * K & z in H * y * K;

reserve G for Group;
reserve H, B, A for Subgroup of G,
  D for Subgroup of A;

registration
  let G,A;
  cluster Left_Cosets A -> non empty;
end;

notation
  let G be Group;
  let H be Subgroup of G;
  synonym index (G,H) for index H;
end;

theorem 
  D = A /\ B & G is finite implies index(G,B) >= index(A,D);

theorem 
  for G being finite Group, H be Subgroup of G holds index (G,H) > 0;

theorem 
  for G being Group st G is finite for C being Subgroup of G
  for A,B being Subgroup of C
  for D being Subgroup of A st D = A /\ B
  for E being Subgroup of B st E = A /\ B
  for F being Subgroup of C st F = A /\ B holds
  index (C,A), index (C,B) are_relative_prime
  implies index (C,B) = index (A,D) & index (C,A) = index (B,E);

theorem 
  for a being Element of G st a in H holds
  for j being Integer holds a |^ j in H;

theorem 
  for G being strict Group st G <> (1).G ex b being Element of G st b <> 1_G;

theorem 
  for G being strict Group for a being Element of G st G = gr{a}
  for H being strict Subgroup of G st H <> (1).G holds
  ex k being Element of NAT st 0 < k & a |^k in H;

theorem 
  for G being strict cyclic Group for H being strict Subgroup of G holds
  H is cyclic Group;














begin

scheme 

  CompIndNE { P[non empty Nat] } : for k being non empty Element of NAT holds
  P[k]
provided
 for k being non empty Element of NAT st for n being non empty
Element of NAT st n < k holds P[n] holds P[k];

theorem 
  for f being FinSequence st 1 <= len f holds f | Seg 1 = <*f.1*>;

theorem 
  for f being FinSequence of F_Complex, g being FinSequence of REAL
st len f = len g & for i being Element of NAT st i in dom f holds |. f/.i .| =
  g.i holds |. Product f .| = Product g;

theorem 
  for s being non empty finite Subset of F_Complex, x being Element
  of F_Complex, r being FinSequence of REAL st len r = card s & for i being
  Element of NAT, c being Element of F_Complex st i in dom r & c = (canFS(s)).i
  holds r.i = |.x-c.| holds |.eval(poly_with_roots((s,1)-bag),x).| = Product(r)
;

theorem 
  for f being FinSequence of F_Complex st for i being Element of
  NAT st i in dom f holds f.i is integer holds Sum f is integer;

theorem 
  for x, y being Element of F_Complex, r1, r2 being Real st r1=x & r2=y
  holds r1*r2 = x*y & r1+r2=x+y;

theorem 
  for q being Real st q > 0 for r being Element of F_Complex st |.r
  .| = 1 & r <> [**1,0**] holds |.[**q, 0**] - r.| > q - 1;

theorem 
  for ps being non empty FinSequence of REAL, x being Real st x >=
1 & for i being Element of NAT st i in dom ps holds ps.i > x holds Product(ps)
  > x;

theorem 
  for n being Element of NAT holds 1_F_Complex = (power F_Complex)
  .(1_F_Complex,n);

theorem 
  for n, i being Element of NAT holds cos((2*PI*i)/n) = cos((2*PI*
  (i mod n))/n) & sin((2*PI*i)/n) = sin((2*PI*(i mod n))/n);

theorem 
  for n, i being Element of NAT holds [** cos((2*PI*i)/n), sin((2*
  PI*i)/n)**] = [** cos((2*PI*(i mod n))/n), sin((2*PI*(i mod n))/n) **];

theorem 
  for n, i, j being Element of NAT holds [** cos((2*PI*i)/n),sin((
  2*PI*i)/n) **]*[** cos((2*PI*j)/n),sin((2*PI*j)/n) **] = [** cos((2*PI*((i+j)
  mod n))/n), sin((2*PI*((i+j)mod n))/n)**];

theorem 
  for L being unital associative non empty multMagma, x being
  Element of L, n,m being Element of NAT holds (power L).(x,n*m) = (power L).((
  power L).(x,n),m);

theorem 
  for n being Element of NAT, x being Element of F_Complex st x is
  Integer holds (power F_Complex).(x,n) is Integer;

theorem 
  for F being FinSequence of F_Complex st for i being Element of
  NAT st i in dom F holds F.i is Integer holds Sum F is Integer;

registration
  cluster finite for Field;
  cluster finite for Skew-Field;
end;

begin 

definition
  let R be Skew-Field;
  func MultGroup R -> strict Group means


  the carrier of it = NonZero R
  & the multF of it = (the multF of R)||the carrier of it;
end;

theorem 
  for R being Skew-Field holds the carrier of R = (the carrier of
  MultGroup R) \/ {0.R};

theorem 
  for R being Skew-Field, a, b being Element of R, c, d being
  Element of MultGroup R st a = c & b = d holds c*d = a*b;

theorem 
  for R being Skew-Field holds 1_R = 1_MultGroup R;

registration
  let R be finite Skew-Field;
  cluster MultGroup R -> finite;
end;

theorem 
  for R being finite Skew-Field holds card MultGroup R = card R - 1;

theorem 
  for R being Skew-Field, s being set st s in the carrier of
  MultGroup R holds s in the carrier of R;

theorem 
  for R being Skew-Field holds the carrier of MultGroup R c= the carrier of R;

begin 

definition
  let n be non empty Element of NAT;
  func n-roots_of_1 -> Subset of F_Complex equals

  { x where x is Element of
  F_Complex : x is CRoot of n,1_F_Complex };
end;

theorem 
  for n being non empty Element of NAT, x being Element of
  F_Complex holds x in n-roots_of_1 iff x is CRoot of n,1_F_Complex;

theorem 
  for n being non empty Element of NAT holds 1_F_Complex in n -roots_of_1;

theorem 
  for n being non empty Element of NAT, x being Element of
  F_Complex st x in n-roots_of_1 holds |.x.| = 1;

theorem 
  for n being non empty Element of NAT for x being Element of
F_Complex holds x in n-roots_of_1 iff ex k being Element of NAT st x = [** cos(
  (2*PI*k)/n), sin((2*PI*k)/n) **];

theorem 
  for n being non empty Element of NAT for x,y being Element of
  COMPLEX st x in n-roots_of_1 & y in n-roots_of_1 holds x*y in n-roots_of_1;

theorem 
  for n being non empty Element of NAT holds n-roots_of_1 = {[**
  cos((2*PI*k)/n),sin((2*PI*k)/n)**] where k is Element of NAT: k < n };

theorem 
  for n being non empty Element of NAT holds card (n-roots_of_1) = n;

registration
  let n be non empty Element of NAT;
  cluster n-roots_of_1 -> non empty;
  cluster n-roots_of_1 -> finite;
end;

theorem 
  for n, ni being non empty Element of NAT st ni divides n holds
  ni-roots_of_1 c= n-roots_of_1;

theorem 
  for R being Skew-Field, x being Element of MultGroup R, y being
Element of R st y = x for k being Element of NAT holds (power (MultGroup R)).(x
  ,k) = (power R).(y,k);

theorem 
  for n being non empty Element of NAT, x being Element of
  MultGroup F_Complex st x in n-roots_of_1 holds x is not being_of_order_0;

theorem 
  for n being non empty Element of NAT, k being Element of NAT, x
being Element of MultGroup F_Complex st x = [** cos((2*PI*k)/n), sin((2*PI*k)/n
  ) **] holds ord x = n div (k gcd n);

theorem 
  for n being non empty Element of NAT holds n-roots_of_1 c= the
  carrier of MultGroup F_Complex;

theorem 
  for n being non empty Element of NAT holds ex x being Element of
  MultGroup F_Complex st ord x = n;

theorem 
  for n being non empty Element of NAT, x being Element of
  MultGroup F_Complex holds ord x divides n iff x in n-roots_of_1;

theorem 
  for n being non empty Element of NAT holds n-roots_of_1 = { x
  where x is Element of MultGroup F_Complex : ord x divides n};

theorem 
  for n being non empty Element of NAT, x being set holds x in n
  -roots_of_1 iff ex y being Element of MultGroup F_Complex st x = y & ord y
  divides n;

definition
  let n be non empty Element of NAT;
  func n-th_roots_of_1 -> strict Group means


  the carrier of it = n
  -roots_of_1 & the multF of it = (the multF of F_Complex)||(n-roots_of_1);
end;

theorem 
  for n being non empty Element of NAT holds n-th_roots_of_1 is Subgroup
  of MultGroup F_Complex;

begin 

definition
  let n be non empty Nat, L be left_unital non empty doubleLoopStr;
  func unital_poly(L,n) -> Polynomial of L equals

  0_.(L)+*(0,-(1_L))+*(n,1_L);
end;

theorem 
  for L being left_unital non empty doubleLoopStr for n being
non empty Element of NAT holds unital_poly(L,n).0 = -1_L & unital_poly(L,n).n =
  1_L;

theorem 
  for L being left_unital non empty doubleLoopStr for n being
  non empty Nat, i being Nat st i <> 0 & i <> n holds unital_poly(L,n).i = 0.L;

theorem 
  for L being non degenerated well-unital non empty doubleLoopStr
  , n being non empty Element of NAT holds len unital_poly(L,n) = n+1;

registration
  let L be non degenerated well-unital non empty doubleLoopStr, n be non
  empty Element of NAT;
  cluster unital_poly(L,n) -> non-zero;
end;

theorem 
  for n being non empty Element of NAT for x being Element of
F_Complex holds eval(unital_poly(F_Complex,n), x) = (power F_Complex).(x,n) - 1
;

theorem 
  for n being non empty Element of NAT holds Roots unital_poly(
  F_Complex, n) = n-roots_of_1;

theorem 
  for n being Element of NAT, z being Element of F_Complex st z is
  Real ex x being Real st x = z & (power F_Complex).(z,n) = x |^ n;

theorem 
  for n being non empty Element of NAT for x being Real ex y being
Element of F_Complex st y = x & eval(unital_poly(F_Complex,n),y) = (x |^ n) - 1
;

theorem 
  for n being non empty Element of NAT holds BRoots unital_poly(
  F_Complex, n) = (n-roots_of_1, 1)-bag;

theorem 
  for n being non empty Element of NAT holds unital_poly(F_Complex
  , n) = poly_with_roots((n-roots_of_1, 1)-bag);

theorem 
  for n being non empty Element of NAT, i being Element of
  F_Complex st i is Integer holds eval(unital_poly(F_Complex, n), i) is Integer
;

begin 

definition
  let d be non empty Nat;
  func cyclotomic_poly d -> Polynomial of F_Complex means


  ex s being
non empty finite Subset of F_Complex st s = { y where y is Element of MultGroup
  F_Complex : ord y = d } & it = poly_with_roots((s,1)-bag);
end;

theorem 
  cyclotomic_poly(1) = <%-1_F_Complex, 1_F_Complex %>;

theorem 
  for n being non empty Element of NAT, f being FinSequence of (
  the carrier of Polynom-Ring F_Complex) st len f = n & for i being non empty
Element of NAT st i in dom f holds (not i divides n implies f.i = <%1_F_Complex
  %>) & (i divides n implies f.i = cyclotomic_poly(i)) holds unital_poly(
  F_Complex,n) = Product(f);

theorem 
  for n being non empty Element of NAT ex f being FinSequence of (
the carrier of Polynom-Ring F_Complex), p being Polynomial of F_Complex st p =
Product(f) & dom f = Seg n & (for i being non empty Element of NAT st i in Seg
n holds (not i divides n or i = n implies f.i = <%1_F_Complex%>) & (i divides n
  & i <> n implies f.i = cyclotomic_poly(i))) & unital_poly(F_Complex,n) = (
  cyclotomic_poly n)*'p;

theorem 
  for d being non empty Element of NAT, i being Element of NAT
  holds ((cyclotomic_poly d).0 = 1 or (cyclotomic_poly d).0 = -1) & (
  cyclotomic_poly d).i is integer;

theorem 
  for d being non empty Element of NAT, z being Element of
  F_Complex st z is Integer holds eval(cyclotomic_poly(d),z) is Integer;

theorem 
  for n, ni being non empty Element of NAT, f being FinSequence of
(the carrier of Polynom-Ring F_Complex), s being finite Subset of F_Complex st
s = {y where y is Element of MultGroup F_Complex : ord y divides n & not ord y
divides ni & ord y <> n} & dom f = Seg n & for i being non empty Element of NAT
st i in dom f holds (not i divides n or i divides ni or i = n implies f.i = <%
  1_F_Complex%>) & (i divides n & not i divides ni & i <> n implies f.i =
  cyclotomic_poly(i)) holds Product(f) = poly_with_roots((s,1)-bag);

theorem 
  for n, ni being non empty Element of NAT st ni < n & ni divides
  n ex f being FinSequence of (the carrier of Polynom-Ring F_Complex), p being
  Polynomial of F_Complex st p = Product(f) & dom f = Seg n & (for i being non
empty Element of NAT st i in Seg n holds (not i divides n or i divides ni or i
  = n implies f.i = <%1_F_Complex%>) & (i divides n & not i divides ni & i <> n
  implies f.i = cyclotomic_poly(i))) & unital_poly(F_Complex,n) = unital_poly(
  F_Complex,ni)*'(cyclotomic_poly n)*'p;

theorem 
  for i being Integer, c being Element of F_Complex, f being
  FinSequence of (the carrier of Polynom-Ring F_Complex), p being Polynomial of
F_Complex st p = Product(f) & c = i & for i being non empty Element of NAT st i
in dom f holds f.i = <%1_F_Complex%> or f.i = cyclotomic_poly(i) holds eval(p,c
  ) is integer;

theorem 
  for n being non empty Element of NAT, j, k, q being Integer, qc
  being Element of F_Complex st qc = q & j = eval(cyclotomic_poly(n),qc) & k =
  eval(unital_poly(F_Complex, n),qc) holds j divides k;

theorem 
  for n,ni being non empty Element of NAT, q being Integer st ni <
  n & ni divides n for qc being Element of F_Complex st qc = q for j,k,l being
Integer st j = eval(cyclotomic_poly(n),qc) & k = eval(unital_poly(F_Complex, n)
  ,qc) & l = eval(unital_poly(F_Complex, ni),qc) holds j divides (k div l);

theorem 
  for n,q being non empty Element of NAT, qc being Element of F_Complex
  st qc = q for j being Integer st j = eval(cyclotomic_poly(n),qc) holds j
  divides (q |^ n - 1);

theorem 
  for n,ni,q being non empty Element of NAT st ni < n & ni divides n for
  qc being Element of F_Complex st qc = q for j being Integer st j = eval(
  cyclotomic_poly(n),qc) holds j divides ((q |^ n - 1) div (q |^ ni - 1));

theorem 
  for n being non empty Element of NAT st 1 < n for q being Element of
NAT st 1 < q for qc being Element of F_Complex st qc = q for i being Integer st
  i = eval(cyclotomic_poly(n),qc) holds abs(i) > q - 1;














begin 

theorem 
  for a being Element of NAT, q being Real st 1 < q & q |^ a = 1 holds a = 0;

theorem 
  for a, k, r being Nat, x being Real
  st 1 < x & 0 < k holds x |^ (a*k + r) = (x |^ a)*(x |^ (a*(k-'1)+r));

theorem 
  for q, a, b being Element of NAT
  st 0 < a & 1 < q & (q |^ a) -' 1 divides (q |^ b)-'1 holds a divides b;

theorem 
  for n, q being Nat st 0 < q holds card Funcs(n,q) = q |^ n;

theorem 
  for f being FinSequence of NAT, i being Element of NAT
  st for j being Element of NAT st j in dom f
  holds i divides f/.j holds i divides Sum f;

theorem 
  for X being finite set, Y being a_partition of X,
  f being FinSequence of Y st f is one-to-one & rng f = Y
  for c being FinSequence of NAT st len c = len f &
  for i being Element of NAT st i in dom c holds c.i = card (f.i)
  holds card X = Sum c;

begin 

registration
  let G be finite Group;
  cluster center G -> finite;
end;

definition
  let G be Group, a be Element of G;
  func Centralizer a -> strict Subgroup of G means


  the carrier of it = { b where b is Element of G : a*b = b*a };
end;

registration
  let G be finite Group;
  let a be Element of G;
  cluster Centralizer a -> finite;
end;

theorem 
  for G being Group, a being Element of G, x being set
  st x in Centralizer a holds x in G;

theorem 
  for G being Group, a, x being Element of G
  holds a*x = x*a iff x is Element of Centralizer a;

registration
  let G be Group, a be Element of G;
  cluster con_class a -> non empty;
end;

definition
  let G be Group, a be Element of G;
  func a-con_map -> Function of the carrier of G, con_class a means


  for x being Element of G holds it.x = a |^ x;
end;

theorem 
for G being finite Group, a being Element of G, x being Element of con_class a
  holds card (a-con_map"{x}) = card Centralizer a;

theorem 
  for G being Group, a being Element of G, x, y being Element of con_class a
  st x<>y holds (a-con_map"{x}) misses (a-con_map"{y});

theorem 
  for G being Group, a being Element of G
  holds { a-con_map"{x} where x is Element of con_class a : not contradiction }
  is a_partition of the carrier of G;

theorem 
  for G being finite Group, a being Element of G
  holds card { a-con_map"{x} where x is Element of con_class a :
  not contradiction} = card con_class a;

theorem 
  for G being finite Group, a being Element of G
  holds card G = card con_class a * card Centralizer a;

definition
  let G be Group;
  func conjugate_Classes G -> a_partition of the carrier of G equals

  {con_class a where a is Element of G: not contradiction};
end;

theorem 
  for G being finite Group, f being FinSequence of conjugate_Classes G
  st f is one-to-one & rng f = conjugate_Classes G
  for c being FinSequence of NAT
  st len c = len f & for i being Element of NAT st i in dom c
  holds c.i = card (f.i) holds card G = Sum c;

begin 

theorem 
  for F being finite Field, V being VectSp of F, n, q being Nat
  st V is finite-dimensional & n = dim V & q = card the carrier of F
  holds card the carrier of V = q |^ n;

definition
  let R be Skew-Field;
  func center R -> strict Field means


  the carrier of it = {x where x is Element of R:
  for s being Element of R holds x*s = s*x} &
  the addF of it = (the addF of R)||the carrier of it &
  the multF of it = (the multF of R)||the carrier of it & 0.it = 0.R &
  1.it = 1.R;
end;

theorem 
  for R being Skew-Field holds the carrier of center R c= the carrier of R;

registration
  let R be finite Skew-Field;
  cluster center R -> finite;
end;

theorem 
  for R being Skew-Field, y being Element of R
  holds y in center R iff for s being Element of R holds y*s = s*y;

theorem 
  for R being Skew-Field holds 0.R in center R;

theorem 
  for R being Skew-Field holds 1_R in center R;

theorem 
  for R being finite Skew-Field holds 1 < card (the carrier of center R);

theorem 
  for R being finite Skew-Field holds
  card the carrier of center R = card the carrier of R iff R is commutative;

theorem 
  for R being Skew-Field
  holds the carrier of center R = (the carrier of center MultGroup R) \/ {0.R};

definition
  let R be Skew-Field, s be Element of R;
  func centralizer s -> strict Skew-Field means


  the carrier of it = {x where x is Element of R: x*s = s*x} &
  the addF of it = (the addF of R)||the carrier of it &
  the multF of it = (the multF of R)||the carrier of it & 0.it = 0.R &
  1.it = 1.R;
end;

theorem 
  for R be Skew-Field, s be Element of R
  holds the carrier of centralizer s c= the carrier of R;

theorem 
  for R be Skew-Field, s, a be Element of R
  holds a in the carrier of centralizer s iff a*s = s*a;

theorem 
  for R be Skew-Field, s be Element of R
  holds the carrier of center R c= the carrier of centralizer s;

theorem 
  for R be Skew-Field, s, a, b be Element of R
  st a in the carrier of center R & b in the carrier of centralizer s
  holds a*b in the carrier of centralizer s;

theorem 
  for R be Skew-Field, s be Element of R
  holds 0.R is Element of centralizer s & 1_R is Element of centralizer s;

registration
  let R be finite Skew-Field;
  let s be Element of R;
  cluster centralizer s -> finite;
end;

theorem 
  for R be finite Skew-Field, s be Element of R
  holds 1 < card (the carrier of centralizer s);

theorem 
  for R being Skew-Field, s being Element of R, t being Element of MultGroup R
  st t = s
  holds the carrier of centralizer s = (the carrier of Centralizer t) \/ {0.R};

theorem 
  for R being finite Skew-Field, s being Element of R,
  t being Element of MultGroup R st t = s
  holds card Centralizer t = card (the carrier of centralizer s) - 1;

begin 

definition
  let R be Skew-Field;
  func VectSp_over_center R -> strict VectSp of center R means


  the addLoopStr of it = the addLoopStr of R &
  the lmult of it = (the multF of R )
  | [:the carrier of center R, the carrier of R:];
end;

theorem 
  for R being finite Skew-Field holds card the carrier of R =
  (card (the carrier of center R)) |^ (dim VectSp_over_center R);

theorem 
  for R being finite Skew-Field holds 0 < dim VectSp_over_center R;

definition
  let R be Skew-Field, s be Element of R;
  func VectSp_over_center s -> strict VectSp of center R means


  the addLoopStr of it = the addLoopStr of centralizer s &
  the lmult of it = (the multF of R)
  | [:the carrier of center R, the carrier of centralizer s:];
end;

theorem 
  for R being finite Skew-Field, s being Element of R
  holds card the carrier of (centralizer s) =
  (card (the carrier of center R)) |^ (dim VectSp_over_center s);

theorem 
  for R being finite Skew-Field, s being Element of R
  holds 0 < dim VectSp_over_center s;

theorem 
  for R being finite Skew-Field, r being Element of R
  st r is Element of MultGroup R holds
  ((card (the carrier of center R)) |^ (dim VectSp_over_center r) - 1) divides
  ((card (the carrier of center R)) |^ (dim VectSp_over_center R) - 1);

theorem 
  for R being finite Skew-Field, s being Element of R
  st s is Element of MultGroup R
  holds (dim VectSp_over_center s) divides (dim VectSp_over_center R);

theorem 
  for R being finite Skew-Field holds
  card the carrier of center MultGroup R = card (the carrier of center R) - 1;

begin 


theorem 
  for R being finite Skew-Field holds R is commutative;

theorem 
  for R being Skew-Field holds 1.center R = 1.R;

theorem 
  for R being Skew-Field, s being Element of R holds 1.centralizer s = 1.R;














begin 

notation
  let S be non empty 1-sorted;
  let E be set;
  let A be Action of (the carrier of S), E;
  let s be Element of S;
  synonym A^s for A.s;
end;

definition
  let S be non empty 1-sorted;
  let E be set;
  let A be Action of (the carrier of S), E;
  let s be Element of S;
  redefine func A^s -> Function of E, E;
end;

definition
  let S be unital non empty multMagma;
  let E be set;
  let A be Action of (the carrier of S), E;
  attr A is being_left_operation means


  A^(1_S) = id E &
  for s1,s2 being Element of S holds A^(s1*s2) = A^s1 * (A^s2);
end;

registration
  let S be unital non empty multMagma;
  let E be set;
  cluster being_left_operation for Action of (the carrier of S), E;
end;



definition
  let S be unital non empty multMagma;
  let E be set;
  mode LeftOperation of S, E is
       being_left_operation Action of (the carrier of S), E;
end;

scheme 

  ExLeftOperation {E()->set, S()->Group-like non empty multMagma, f(Element
  of S())->Function of E(),E()}: ex T being LeftOperation of S(), E() st for s
  being Element of S() holds T.s = f(s)
provided
 f(1_S()) = id E() and
 for s1,s2 being Element of S() holds f(s1*s2) = f(s1) * f(s2);

registration
  let E be non empty set, S be Group-like non empty multMagma,
      s be Element of S, LO be LeftOperation of S, E;
  cluster LO^s -> one-to-one for Function of E,E;
end;




notation
  let S be non empty multMagma;
  let s be Element of S;
  synonym the_left_translation_of s for s*;
end;

definition
  let S be Group-like associative non empty multMagma;
  func the_left_operation_of S -> LeftOperation of S, the carrier of S means


   for s being Element of S holds it.s = the_left_translation_of s;
end;

definition
  let E be set;
  let n be set;
  func the_subsets_of_card(n, E) -> Subset-Family of E equals

  {X where X is Subset of E: card X = n};
end;

registration
  let E be finite set;
  let n be set;
  cluster the_subsets_of_card(n, E) -> finite;
end;

theorem 
  for n being Nat, E being non empty set st card n c=
  card E holds the_subsets_of_card(n, E) is non empty;

theorem 
  for E being non empty finite set, k being Element of NAT, x1,x2
being set st x1<>x2 holds card Choose(E,k,x1,x2) = card the_subsets_of_card(k,E
  );

definition
  let E be non empty set;
  let n be Nat;
  let S be Group-like non empty multMagma;
  let s be Element of S;
  let LO be LeftOperation of S, E;
  assume
 card n c= card E;
  func the_extension_of_left_translation_of(n,s,LO) -> Function of
  the_subsets_of_card(n, E), the_subsets_of_card(n, E) means


  for X being Element of the_subsets_of_card(n, E) holds it.X = (LO^s) .: X;
end;

definition
  let E be non empty set;
  let n be Nat;
  let S be Group-like non empty multMagma;
  let LO be LeftOperation of S, E;
  assume
 card n c= card E;
  func the_extension_of_left_operation_of(n,LO) -> LeftOperation of S,
  the_subsets_of_card(n, E) means


  for s being Element of S holds it.s =
  the_extension_of_left_translation_of(n,s,LO);
end;

definition
  let S be non empty multMagma;
  let s be Element of S;
  let Z be non empty set;
  func the_left_translation_of(s,Z) -> Function of [:the carrier of S,Z:],[:
  the carrier of S,Z:] means


  for z1 being Element of [:the carrier of S,Z
:] holds ex z2 being Element of [:the carrier of S,Z:], s1,s2 being Element of
  S, z being Element of Z st z2 = it.z1 & s2 = s * s1 & z1=[s1,z] & z2=[s2,z];
end;

definition
  let S be Group-like associative non empty multMagma;
  let Z be non empty set;
  func the_left_operation_of(S,Z) -> LeftOperation of S,[:the carrier of S,Z:]
  means


  for s being Element of S holds it.s = the_left_translation_of(s,Z);
end;

definition
  let G be Group;
  let H,P be Subgroup of G;
  let h be Element of H;
  func the_left_translation_of(h,P) -> Function of Left_Cosets P, Left_Cosets
  P means


  for P1 being Element of Left_Cosets P holds ex P2 being Element
of Left_Cosets P, A1,A2 being Subset of G, g being Element of G st P2 = it.P1 &
  A2 = g * A1 & A1=P1 & A2=P2 & g=h;
end;

definition
  let G be Group;
  let H,P be Subgroup of G;
  func the_left_operation_of(H,P) -> LeftOperation of H, Left_Cosets P means


   for h being Element of H holds it.h = the_left_translation_of(h,P);
end;

begin 



definition
  let G be Group;
  let E be non empty set;
  let T be LeftOperation of G,E;
  let A be Subset of E;
  func the_strict_stabilizer_of(A,T) -> strict Subgroup of G means


  the carrier of it = {g where g is Element of G: (T^g) .: A = A};
end;

definition
  let G be Group;
  let E be non empty set;
  let T be LeftOperation of G,E;
  let x be Element of E;
  func the_strict_stabilizer_of(x,T) -> strict Subgroup of G equals

  the_strict_stabilizer_of({x},T);
end;

definition
  let S be unital non empty multMagma;
  let E be set;
  let T be LeftOperation of S, E;
  let x be Element of E;
  pred x is_fixed_under T means


  for s being Element of S holds x = (T^s).x;
end;

definition
  let S be unital non empty multMagma;
  let E be set;
  let T be LeftOperation of S, E;
  func the_fixed_points_of T -> Subset of E equals


  {x where x is
  Element of E: x is_fixed_under T} if E is non empty otherwise {}E;
end;



definition
  let S be unital non empty multMagma;
  let E be set;
  let T be LeftOperation of S, E;
  let x,y be Element of E;
  pred x,y are_conjugated_under T means


  ex s being Element of S st y = (T^s).x;
end;

theorem 
  for S being unital non empty multMagma, E being non empty set,
  x being Element of E, T being LeftOperation of S, E holds x,x
  are_conjugated_under T;

theorem 
  for G being Group, E being non empty set, x,y being Element of E,
  T being LeftOperation of G, E st x,y are_conjugated_under T holds y,x
  are_conjugated_under T;

theorem 
  for S being unital non empty multMagma, E being non empty set,
  x,y,z being Element of E, T being LeftOperation of S, E st x,y
  are_conjugated_under T & y,z are_conjugated_under T holds x,z
  are_conjugated_under T;

definition
  let S be unital non empty multMagma;
  let E be non empty set;
  let T be LeftOperation of S, E;
  let x be Element of E;
  func the_orbit_of(x,T) -> Subset of E equals

  {y where y is Element of E: x,y
  are_conjugated_under T};
end;

registration
  let S be unital non empty multMagma, E be non empty set,
      x be Element of E, T be LeftOperation of S, E;
  cluster the_orbit_of(x,T) -> non empty;
end;

theorem 
  for G being Group, E being non empty set, x,y being Element of E,
T being LeftOperation of G, E holds the_orbit_of(x,T) misses the_orbit_of(y,T)
  or the_orbit_of(x,T)=the_orbit_of(y,T);

theorem 
  for S being unital non empty multMagma, E being non empty
  finite set, x being Element of E, T being LeftOperation of S, E st x
  is_fixed_under T holds the_orbit_of(x,T) = {x};



theorem 
  for G being Group, E being non empty set, a being Element of E,
  T being LeftOperation of G, E holds card the_orbit_of(a,T) = Index
  the_strict_stabilizer_of(a,T);

definition
  let G be Group;
  let E be non empty set;
  let T be LeftOperation of G, E;
  func the_orbits_of T -> a_partition of E equals

  {X where X is Subset of E:
  ex x being Element of E st X = the_orbit_of(x,T)};
end;

begin 


definition
  let p be Nat;
  let G be Group;
  attr G is p-group means


  ex r being Nat st card G = p |^ r;
end;

registration
  let p be non zero Nat;
  cluster INT.Group(p) -> p-group;
end;

registration
  let p be non zero Nat;
  cluster p-group finite cyclic commutative strict for Group;
end;




theorem 
  for E being non empty finite set, G being finite Group,
      p being prime Nat, T being LeftOperation of G, E st
  G is p-group
  holds card the_fixed_points_of T mod p = card E mod p;

begin 


definition

  let p be Nat;
  let G be Group;
  let P be Subgroup of G;
  pred P is_Sylow_p-subgroup_of_prime p means


  P is p-group & not p divides index P;
end;:$N First Sylow Theorem
theorem 
  for G being finite Group, p being prime Nat ex P
  being strict Subgroup of G st P is_Sylow_p-subgroup_of_prime p;




theorem 
  for G being finite Group, p being prime Nat st p divides
  card G ex g being Element of G st ord g = p;





theorem 
  for G being finite Group, p being prime Nat holds (
for H being Subgroup of G st H is p-group holds ex P being Subgroup
  of G st P is_Sylow_p-subgroup_of_prime p & H is Subgroup of P) & (for P1,P2
  being Subgroup of G st P1 is_Sylow_p-subgroup_of_prime p & P2
  is_Sylow_p-subgroup_of_prime p holds P1,P2 are_conjugated);

definition
  let G be Group;
  let p be Nat;
  func the_sylow_p-subgroups_of_prime(p,G) -> Subset of Subgroups G equals

  {H where H is Element of Subgroups G: ex P being strict Subgroup of G st
  P = H & P is_Sylow_p-subgroup_of_prime p};
end;

registration
  let G be finite Group;
  let p be prime Nat;
  cluster the_sylow_p-subgroups_of_prime(p,G) -> non empty finite;
end;

definition
  let G be finite Group;
  let p be prime Nat;
  let H be Subgroup of G;
  let h be Element of H;
  func the_left_translation_of(h,p) -> Function of
the_sylow_p-subgroups_of_prime(p,G), the_sylow_p-subgroups_of_prime(p,G) means


  for P1 being Element of the_sylow_p-subgroups_of_prime(p,G) holds ex P2
  being Element of the_sylow_p-subgroups_of_prime(p,G), H1,H2 being strict
Subgroup of G, g being Element of G st P2 = it.P1 & P1=H1 & P2=H2 & h"=g & H2 =
  H1 |^ g;
end;

definition
  let G be finite Group;
  let p be prime Nat;
  let H be Subgroup of G;
  func the_left_operation_of(H,p) -> LeftOperation of H,
  the_sylow_p-subgroups_of_prime(p,G) means


  for h being Element of H holds it.h = the_left_translation_of(h,p);
end;:$N Third Sylow Theorem
theorem 
  for G being finite Group, p being prime Nat holds card
  the_sylow_p-subgroups_of_prime(p,G) mod p = 1 & card
  the_sylow_p-subgroups_of_prime(p,G) divides card G;

begin 

theorem 
  for X,Y being non empty set holds card {[:X,{y}:] where y is Element
  of Y: not contradiction} = card Y;

theorem 
  for n,m,r being Nat, p being prime Nat st n =
  p |^ r * m & not p divides m holds (n choose p|^r) mod p <> 0;

theorem 
  for n being non zero Nat holds card INT.Group(n) = n;

theorem 
  for G being Group, A being non empty Subset of G, g being Element of G
  holds card A = card (A * g);














begin 

reserve X,x for set;

theorem 
  for Z being set, M being ManySortedSet of Z st for x being set st
  x in Z holds M.x is ManySortedSet of x for f being Function st f = Union M
  holds dom f = union Z;

theorem 
  for x,y being set, f,g being FinSequence st <*x*>^f = <*y*>^g holds f = g;

theorem 
  <*x*> is FinSequence of X implies x in X;

theorem 
  for X for f being FinSequence of X st f <> {} ex g being
  FinSequence of X, d being Element of X st f = g^<*d*>;

reserve k,m,n for Element of NAT,
  p,q,r,s,r9,s9 for Element of HP-WFF,
  T1,T2 for Tree;

theorem 
  <*x*> in tree(T1,T2) iff x=0 or x=1;

scheme 

  InTreeInd{T() -> Tree, P[set] }: for f being Element of T() holds P[f]
provided
 P[<*>NAT] and
 for f being Element of T() st P[f] for n st f^<*n*> in T() holds P[f
^<*n*>];

reserve T1,T2 for DecoratedTree;

theorem 
  for x being set, T1, T2 holds (x-tree (T1,T2)).{} = x;

theorem 
  x-tree(T1,T2).<*0*> = T1.{} & x-tree(T1,T2).<*1*> = T2.{};

theorem 
  x-tree(T1,T2)|<*0*> = T1 & x-tree(T1,T2)|<*1*> = T2;

registration
  let x;
  let p be DTree-yielding non empty FinSequence;
  cluster x-tree p -> non root;
end;

registration
  let x;
  let T1 be DecoratedTree;
  cluster x-tree T1 -> non root;
  let T2 be DecoratedTree;
  cluster x-tree (T1,T2) -> non root;
end;

begin 

definition
  let n;
  func prop n -> Element of HP-WFF equals

  <*3+n*>;
end;

definition
  let D be set;
  redefine attr D is with_VERUM means


  VERUM in D;
  redefine attr D is with_propositional_variables means

  for n holds prop n in D;
end;

definition
  let D be Subset of HP-WFF;
  redefine attr D is with_implication means

  for p, q st p in D & q in D holds p => q in D;
  redefine attr D is with_conjunction means

  for p, q st p in D & q in D holds p '&' q in D;
end;

reserve t,t1 for FinSequence;

definition
  let p;
  attr p is conjunctive means


  ex r,s st p = r '&' s;
  attr p is conditional means


  ex r,s st p = r => s;
  attr p is simple means


  ex n st p = prop n;
end;

scheme 

  HPInd { P[set] }: for r holds P[r]
provided
 P[VERUM] and
 for n holds P[prop n] and
 for r,s st P[r] & P[s] holds P[r '&' s] & P[r => s];

theorem 
  p is conjunctive or p is conditional or p is simple or p = VERUM;

theorem 
  len p >= 1;

theorem 
  p.1 = 1 implies p is conditional;

theorem 
  p.1 = 2 implies p is conjunctive;

theorem 
  p.1 = 3+n implies p is simple;

theorem 
  p.1 = 0 implies p = VERUM;

theorem 
  len p < len(p '&' q) & len q < len(p '&' q);

theorem 
  len p < len(p => q) & len q < len(p => q);

theorem 
  p = q^t implies p = q;

theorem 
  p^q = r^s implies p = r & q = s;

theorem 
  p '&' q = r '&' s implies p = r & s = q;

theorem 
  p => q = r => s implies p = r & s = q;

theorem 
  prop n = prop m implies n = m;

theorem 
  p '&' q <> r => s;

theorem 
  p '&' q <> VERUM;

theorem 
  p '&' q <> prop n;

theorem 
  p => q <> VERUM;

theorem 
  p => q <> prop n;

theorem 
  p '&' q <> p & p '&' q <> q;

theorem 
  p => q <> p & p => q <> q;

theorem 
  VERUM <> prop n;

begin 

scheme 

  HPMSSExL{V()->set,P(Element of NAT)->set, C,I[Element of HP-WFF,Element of
  HP-WFF,set,set,set]}: ex M being ManySortedSet of HP-WFF st M.VERUM = V() & (
for n holds M.prop n = P(n)) & for p,q holds C[p,q,M.p,M.q,M.(p '&' q)] & I[p,q
  ,M.p,M.q,M.(p => q)]
provided
 for p,q for a,b being set ex c being set st C[p,q,a,b,c] and
 for p,q for a,b being set ex d being set st I[p,q,a,b,d] and
 for p,q for a,b,c,d being set st C[p,q,a,b,c] & C[p,q,a,b,d] holds c
= d and
 for p,q for a,b,c,d being set st I[p,q,a,b,c] & I[p,q,a,b,d] holds c = d;

scheme 

  HPMSSLambda{V()->set,P(Element of NAT)->set,C,I(set,set)->set}: ex M being
ManySortedSet of HP-WFF st M.VERUM = V() & (for n holds M.prop n = P(n)) & for
  p,q holds M.(p '&' q) = C(M.p,M.q) & M.(p => q) = I(M.p,M.q);

begin 

definition
  func HP-Subformulae -> ManySortedSet of HP-WFF means


  it.VERUM =
root-tree VERUM & (for n holds it.prop n = root-tree prop n) & for p,q ex p9,q9
being DecoratedTree of HP-WFF st p9 = it.p & q9 = it.q & it.(p '&' q) = (p '&'
  q)-tree(p9,q9) & it.(p => q) = (p => q)-tree(p9,q9);
end;

definition
  let p;
  func Subformulae p -> DecoratedTree of HP-WFF equals

  HP-Subformulae.p;
end;

theorem 
  Subformulae VERUM = root-tree VERUM;

theorem 
  Subformulae prop n = root-tree prop n;

theorem 
  Subformulae(p '&' q) = (p '&' q)-tree(Subformulae p,Subformulae q);

theorem 
  Subformulae(p => q) = (p => q)-tree(Subformulae p,Subformulae q);

theorem 
  (Subformulae p).{} = p;

theorem 
  for f being Element of dom Subformulae p holds (Subformulae p)|f
  = Subformulae((Subformulae p).f);

theorem 
  p in Leaves Subformulae q implies p = VERUM or p is simple;














begin

definition
  redefine func multint means


  for a,b being Element of INT holds it.(a, b) = multreal.(a,b);
end;

definition
  redefine func compint means

  for a being Element of INT holds it.(a) = compreal.(a);
end;

definition
  func INT.Ring -> doubleLoopStr equals

  doubleLoopStr(#INT,addint,multint,In (
    1,INT),In (0,INT)#);
end;

registration
  cluster INT.Ring -> strict non empty;
end;

registration
  cluster the carrier of INT.Ring -> integer-membered;
end;

registration
  let a,b be Element of INT.Ring, c,d be Integer;
  identify a * b with c * d when a = c, b = d;
  identify a + b with c + d when a = c, b = d;
end;

registration
  cluster INT.Ring -> well-unital;
end;

registration
  cluster INT.Ring -> Abelian add-associative right_zeroed
    right_complementable distributive commutative associative domRing-like non
    degenerated;
end;

registration
  let a be Element of INT.Ring, b be Integer;
  identify -a with -b when a = b;
end;

definition

  let a be Element of INT.Ring;
  redefine func abs(a) -> Element of INT.Ring equals

  a if a >= 0.INT.Ring
  otherwise - a;
end;

definition
  func absint -> Function of the carrier of INT.Ring,NAT means


  for a being Element of INT.Ring holds it.a = absreal.(a);
end;

theorem 
  for a being Element of INT.Ring holds absint.a = abs(a);

theorem 
  for a,b,q1,q2,r1,r2 being Element of INT.Ring st b <> 0.INT.Ring
  & a = q1 * b + r1 & 0.INT.Ring <= r1 & r1 < abs(b) & a = q2 * b + r2 & 0.
  INT.Ring <= r2 & r2 < abs(b) holds q1 = q2 & r1 = r2;

definition
  let a,b be Element of INT.Ring;
  assume
 b <> 0.INT.Ring;
  func a div b -> Element of INT.Ring means


  ex r being Element of
  INT.Ring st a = it * b + r & 0.INT.Ring <= r & r < abs(b);
end;

definition
  let a,b be Element of INT.Ring;
  assume
 b <> 0.INT.Ring;
  func a mod b -> Element of INT.Ring means


  ex q being Element of
  INT.Ring st a = q * b + it & 0.INT.Ring <= it & it < abs(b);
end;

theorem 
  for a,b being Element of INT.Ring st b <> 0.INT.Ring holds a = (a div
  b) * b + (a mod b);

begin 

definition
  let I be non empty doubleLoopStr;
  attr I is Euclidian means


  ex f being Function of the carrier of I,NAT
st for a,b being Element of I st b <> 0.I holds ex q,r being Element of I st a
  = q * b + r & (r = 0.I or f.r < f.b);
end;

registration
  cluster INT.Ring -> Euclidian;
end;

registration
  cluster strict Euclidian domRing-like non degenerated distributive
    commutative for Ring;
end;

definition
  mode EuclidianRing is Euclidian domRing-like non degenerated distributive
    commutative Ring;
end;

registration
  cluster strict for EuclidianRing;
end;

definition
  let E be Euclidian non empty doubleLoopStr;
  mode DegreeFunction of E -> Function of the carrier of E,NAT means


for a,b being Element of E st b <> 0.E holds ex q,r being Element of E st a = q
    * b + r & (r = 0.E or it.r < it.b);
end;

theorem 
  for E being EuclidianRing holds E is gcdDomain;

registration
  cluster Euclidian -> gcd-like for domRing-like non degenerated Abelian
    add-associative right_zeroed right_complementable associative commutative
    well-unital right-distributive non empty doubleLoopStr;
end;

definition
  redefine func absint -> DegreeFunction of INT.Ring;
end;

theorem 
  for F being commutative associative well-unital
  almost_left_invertible right_zeroed non empty doubleLoopStr holds F is
  Euclidian;

registration
  cluster commutative associative well-unital almost_left_invertible
    right_zeroed almost_left_invertible -> Euclidian for
non empty doubleLoopStr;
end;

theorem 
  for F being commutative associative well-unital almost_left_invertible
right_zeroed non empty doubleLoopStr for f being Function of the carrier of F
  ,NAT holds f is DegreeFunction of F;

begin 

definition
  let n be Nat such that
 n > 0;
  func multint(n) -> BinOp of Segm(n) means


  for k,l being Element of Segm(n) holds it.(k,l) = (k * l) mod n;
end;

definition
  let n be Nat such that
 n > 0;
  func compint(n) -> UnOp of Segm(n) means


  for k being Element of Segm (n) holds it.k = (n - k) mod n;
end;

theorem 
  for n being Nat st n > 0 for a,b being Element of
  Segm(n) holds (a + b < n iff (addint(n)).(a,b) = a + b) & (a + b >= n iff (
  addint(n)).(a,b) = (a + b) - n);

theorem 
  for n being Nat st n > 0 for a,b being Element of
  Segm(n) for k being Nat holds k * n <= a * b & a * b < (k + 1) * n
  iff (multint(n)).(a,b) = a * b - k * n;

theorem 
  for n being Nat st n > 0 for a being Element of Segm(n)
holds (a = 0 iff (compint(n)).(a) = 0) & (a <> 0 iff (compint(n)).(a) = n - a);

definition
  let n be Nat;
  func INT.Ring(n) -> doubleLoopStr equals

  doubleLoopStr(#Segm(n),addint(n),
    multint(n),In (1,Segm(n)),In (0,Segm(n))#);
end;

registration
  let n be non zero Nat;
  cluster INT.Ring(n) -> strict non empty;
end;

theorem 
  INT.Ring 1 is degenerated & INT.Ring 1 is Ring & INT.Ring 1 is
  almost_left_invertible unital distributive commutative;

registration
  cluster strict degenerated unital distributive almost_left_invertible
    commutative for Ring;
end;

theorem 
  for n being Nat st n > 1 holds INT.Ring(n) is non
  degenerated & INT.Ring(n) is well-unital distributive commutative Ring;

theorem 
  for p being Nat st p > 1 holds INT.Ring(p) is
  add-associative right_zeroed right_complementable Abelian commutative
  associative well-unital distributive almost_left_invertible non degenerated
  non empty doubleLoopStr iff p is Prime;

registration
  cluster -> non zero for Prime;
end;

registration
  let p be Prime;
  cluster INT.Ring(p) -> add-associative right_zeroed right_complementable
Abelian commutative associative well-unital distributive almost_left_invertible
    non degenerated;
end;

theorem 
  1.INT.Ring = 1;

theorem 
  for n being Nat st 1 < n holds 1.INT.Ring(n) = 1;

begin



registration
  cluster INT.Ring -> infinite;
end;

registration
  cluster strict infinite for Ring;
end;















begin

scheme 

  LambdaNATC{A() -> Element of NAT, B() -> set, F(set)->set}: ex f being
Function of NAT, B() st f.0 = A() & for x being non zero Element of NAT holds f
  .x = F(x)
provided
 A() in B() and
 for x being non zero Element of NAT holds F(x) in B();

registration
  cluster non prime non zero for Element of NAT;
end;

theorem 
  for n being non zero Nat holds n <> 1 implies n >= 2;

theorem 
  for k, n, i being Nat st 1 <= k holds i in Seg n iff k * i
  in Seg (k * n);

theorem 
  for m, n being Element of NAT st m, n are_relative_prime holds m > 0 or n > 0
;

theorem 
  for n being non prime Element of NAT st n <> 1 ex p being Prime
  st p divides n & p <> n;

theorem 
  for n being Nat st n <> 1 ex p being Prime st p divides n;

theorem 
  for p being Prime, n being non zero Nat holds p
  divides n iff p |-count n > 0;

theorem 
  support ppf 1 = {};

theorem 
  for p being Prime holds support ppf p = {p};

reserve m, n for Nat;

theorem 
  for p being Prime st n <> 0 & m <= p |-count n holds p |^ m divides n;

theorem 
  for a being Element of NAT, p being Prime holds p |^ 2 divides a
  implies p divides a;

theorem 
  for p being prime Element of NAT, m, n being non zero Element of
NAT st m, n are_relative_prime & p |^ 2 divides (m * n) holds p |^ 2 divides m
  or p |^ 2 divides n;

theorem 
  for N being Rbag of NAT st support N = {n} holds Sum N = N.n;

registration
  cluster canFS {} -> empty;
end;

theorem 
  for p being Prime st p divides n holds { d where d is Element of NAT :
d > 0 & d divides n & p divides d } = { p * d where d is Element of NAT : d > 0
  & d divides (n div p) };

theorem 
  for n being non zero Nat holds ex k being Element of
  NAT st support ppf n c= Seg k;

theorem 
  for n being non zero Element of NAT, p being Prime st not p in
  support ppf n holds p |-count n = 0;

theorem 
  for k being Element of NAT, n being non zero Element of NAT st
  support ppf n c= Seg (k+1) & not support ppf n c= Seg k holds k+1 is Prime;

theorem 
  for m, n being non zero Nat st (for p being Prime
  holds p |-count m <= p |-count n) holds support ppf m c= support ppf n;

theorem 
  for k being Element of NAT, n being non zero Element of NAT st
  support ppf n c= Seg (k+1) holds ex m being non zero Element of NAT, e being
  Element of NAT st support ppf m c= Seg k & n = m * ((k+1) |^ e) & for p being
Prime holds (p in support ppf m implies p |-count m = p |-count n) & (not p in
  support ppf m implies p |-count m <= p |-count n);

theorem 
  for m, n being non zero Nat st (for p being Prime
  holds p |-count m <= p |-count n) holds m divides n;

begin 

definition
  let x be Nat;
  attr x is square-containing means


  ex p being Prime st p |^ 2 divides x;
end;

theorem 
  for n being Nat st ex p being non zero Nat
  st p <> 1 & p |^ 2 divides n holds n is square-containing;

notation
  let x be Nat;
  antonym x is square-free for x is square-containing;
end;

theorem 
  0 is square-containing;

theorem 
  1 is square-free;

theorem 
  for p being Prime holds p is square-free;

registration
  cluster prime -> square-free for Element of NAT;
end;

definition
  func SCNAT -> Subset of NAT means


  for n being Nat holds n in it iff n is square-free;
end;

registration
  cluster square-free for Nat;
  cluster square-containing for Nat;
end;

registration
  cluster square non trivial -> square-containing for Nat;
end;

theorem 
  n is square-free implies for p being Prime holds p |-count n <= 1;

theorem 
  m * n is square-free implies m is square-free;

theorem 
  m is square-free & n divides m implies n is square-free;

theorem 
  for p being Prime, m, d being Nat st m is square-free
  & p divides m & d divides (m div p) holds d divides m & not p divides d;

theorem 
  for p being Prime, m, d being Nat st p divides m & d
  divides m & not p divides d holds d divides (m div p);

theorem 
  for p being Prime, m being Nat st m is square-free & p
  divides m holds { d where d is Element of NAT : 0 < d & d divides m & not p
  divides d } = { d where d is Element of NAT : 0 < d & d divides (m div p) };

begin 

definition
  let n be Nat;

  func Moebius n -> real number means


  it = 0 if n is square-containing
  otherwise ex n9 being non zero Nat st n9 = n & it = (-1) |^ card
  support ppf n9;
end;

theorem 
  Moebius 1 = 1;

theorem 
  Moebius 2 = -1;

theorem 
  Moebius 3 = -1;

theorem 
  for n being Nat st n is square-free holds Moebius n <> 0;

registration
  let n be square-free Nat;
  cluster Moebius n -> non zero;
end;

theorem 
  for p being Prime holds Moebius p = -1;

theorem 
  for m, n being non zero Element of NAT st m, n
  are_relative_prime holds Moebius (m * n) = Moebius m * Moebius n;

theorem 
  for p being Prime, n being Element of NAT st 1 <= n & n * p is
  square-free holds Moebius (n * p) = - Moebius n;

theorem 
  for m, n being non zero Element of NAT st not m, n are_relative_prime
  holds Moebius (m * n) = 0;

theorem 
  for n being Nat holds n in SCNAT iff Moebius n <> 0;

begin 

definition
  let n be Nat;
  func NatDivisors n -> Subset of NAT equals

  { k where k is Element of NAT : k
  <> 0 & k divides n };
end;

theorem 
  for n, k being Nat holds k in NatDivisors n iff 0 < k & k
  divides n;

theorem 
  for n being non zero Nat holds NatDivisors n c= Seg n;

registration
  let n be non zero Nat;
  cluster NatDivisors n -> finite with_non-empty_elements;
end;

theorem 
  NatDivisors 1 = {1};

begin 

definition
  let X be set;
  func SMoebius X -> ManySortedSet of NAT means


  support it = X /\ SCNAT
  & for k being Element of NAT st k in support it holds it.k = Moebius k;
end;

registration
  let X be set;
  cluster SMoebius X -> real-valued;
end;

registration
  let X be finite set;
  cluster SMoebius X -> finite-support;
end;

theorem 
  Sum SMoebius NatDivisors 1 = 1;

theorem 
  for X, Y being finite Subset of NAT st X misses Y holds support
  SMoebius X \/ support SMoebius Y = support (SMoebius X + SMoebius Y);

theorem 
  for X, Y being finite Subset of NAT st X misses Y holds SMoebius (X \/
  Y) = SMoebius X + SMoebius Y;

begin 

definition
  let n be non zero Nat;
  func PFactors n -> ManySortedSet of SetPrimes means


  support it =
support pfexp n & for p being Nat st p in support pfexp n holds it.p
  = p;
end;

registration
  let n be non zero Nat;
  cluster PFactors n -> finite-support natural-valued;
end;

theorem 
  PFactors 1 = EmptyBag SetPrimes;

theorem 
  for p being Prime holds (PFactors p) * <*p*> = <*p*>;

theorem 
  for p being Prime, n being non zero Nat holds (
  PFactors (p|^n)) * <* p *> = <* p *>;

theorem 
  for p being Prime, n being non zero Nat holds p
  |-count n = 0 implies (PFactors n).p = 0;

theorem 
  for n being non zero Nat, p being Prime st p |-count
  n <> 0 holds (PFactors n).p = p;

theorem 
  for m, n being non zero Element of NAT st m, n
  are_relative_prime holds PFactors (m * n) = PFactors m + PFactors n;

theorem 
  for n being non zero Element of NAT, A being finite Subset of NAT st A
= { k where k is Element of NAT : 0 < k & k divides n & k is square-containing
  } holds SMoebius A = EmptyBag NAT;

begin 

definition
  let n be non zero Nat;
  func Radical n -> Element of NAT equals

  Product PFactors n;
end;

theorem 
  for n being non zero Nat holds Radical n > 0;

registration
  let n be non zero Nat;
  cluster Radical n -> non zero;
end;

theorem 
  for p being Prime holds p = Radical p;

theorem 
  for p being Prime, n being non zero Element of NAT holds Radical (p |^ n) = p
;

theorem 
  for n being non zero Nat holds Radical n divides n;

theorem 
  for p being Prime, n being non zero Nat holds p
  divides n iff p divides Radical n;

theorem 
  for k being non zero Nat st k is square-free holds Radical k = k;

theorem 
  for n being non zero Nat holds Radical n <= n;

theorem 
  for p being Prime, n being non zero Nat holds p |-count
  Radical n <= p |-count n;

theorem 
  for n being non zero Nat holds Radical n = 1 iff n = 1;

theorem 
  for p being Prime, n being non zero Nat holds p
  |-count Radical n <= 1;

registration
  let n be non zero Nat;
  cluster Radical n -> square-free;
end;

theorem 
  for n being non zero Nat holds Radical Radical n = Radical
  n;

theorem 
  for n being non zero Element of NAT, p being Prime holds { k where k
  is Element of NAT : 0 < k & k divides Radical n & p divides k } c= Seg n;

theorem 
  for n being non zero Element of NAT, p being Prime holds { k where k
  is Element of NAT : 0 < k & k divides Radical n & not p divides k } c= Seg n;

theorem 
  for k, n being non zero Nat holds k divides n & k is
  square-free iff k divides Radical n;

theorem 
  for n being non zero Nat holds { k where k is Element of
NAT : 0 < k & k divides n & k is square-free } = { k where k is Element of NAT
  : 0 < k & k divides Radical n };














begin

reserve a,b,m,x,y,i1,i2,i3,i for Integer,
  k,p,q,n for Nat,
  c,c1,c2 for Element of NAT,
  z for set;

theorem 
  for X being real-membered set, a being real number holds X, a ++
  X are_equipotent;

registration
  let X be finite real-membered set, a be real number;
  cluster a ++ X -> finite;
end;

theorem 
  for X being real-membered set, a being real number holds card X =
  card (a ++ X);

theorem 
  for X being real-membered set, a being real number st a <> 0
  holds X, a ** X are_equipotent;

theorem 
  for X being real-membered set, a being real number holds (a = 0 &
X is non empty implies a ** X = {0}) & (a ** X = {0} implies a = 0 or X = {0});

registration
  let X be finite real-membered set, a be real number;
  cluster a ** X -> finite;
end;

theorem 
  for X being real-membered set, a being real number st a <> 0
  holds card X = card (a ** X);

begin

theorem 
  i divides i1 & i1<>0 implies abs i<=abs i1;

theorem 
  for i3 st i3 <> 0 holds i1 divides i2 iff i1*i3 divides i2*i3;

theorem 
  for a,b,m being Nat for n being Element of NAT st a mod m = b mod m
  holds (a|^n) mod m = (b|^n) mod m;

theorem 
  i1*i,i2*i are_congruent_mod i3 & i,i3 are_relative_prime implies
  i1,i2 are_congruent_mod i3;

theorem 
  i1,i2 are_congruent_mod i3 implies i1*k,i2*k are_congruent_mod i3*k;

theorem 
  i1,i2 are_congruent_mod i implies i1*i3,i2*i3 are_congruent_mod i;

theorem 
  for i being Integer holds 0 = 0 mod i;

theorem 
  for b st b>0 for a ex q,r being Integer st a=(b*q)+r & r>=0 & r< b;

theorem 
  i1,i2 are_congruent_mod i3 implies i1 gcd i3 = i2 gcd i3;

theorem 
  a,m are_relative_prime implies ex x being Integer st (a*x-b) mod m = 0;

theorem 
  m>0 & a,m are_relative_prime implies ex n being Nat st (a*n-b) mod m = 0;

theorem 
  m<>0 & not (a gcd m) divides b implies not ex x being Integer st (a*x-
  b) mod m = 0;

theorem 
  m<>0 & (a gcd m) divides b implies ex x being Integer st (a*x-b) mod m = 0;

begin

theorem 
  n>0 & p>0 implies p*q mod p|^n = p*(q mod p|^(n-'1));

theorem 
  p*q mod p*n = p*(q mod n);

theorem 
  n>0 & p is prime & p,q are_relative_prime implies not p divides (q mod p|^n);

theorem 
  for p,q,n being Nat st n>0 holds (p - q) mod n = 0 iff p mod n = q mod n;

theorem 
  for a,b,m being Nat st m > 0 holds a mod m = b mod m iff m divides (a- b);

theorem 
  n>0 & p is prime & p,q are_relative_prime implies not ex x being
  Integer st (p*x^2 - q) mod p|^n = 0;

theorem 
  n>0 & p is prime & p,q are_relative_prime implies not ex x being
  Integer st (p*x - q) mod p|^n = 0;

begin

definition
  let m be Integer;
  func Cong(m) -> Relation of INT means


  [x,y] in it iff x,y are_congruent_mod m;
end;

registration
  let m be Integer;
  cluster Cong m -> total;
end;

registration
  let m be Integer;
  cluster Cong m -> reflexive symmetric transitive;
end;

theorem 
  m<>0 & (a*x-b) mod m = 0 implies for y being Integer holds (a,m
  are_relative_prime & (a*y-b) mod m = 0 implies y in Class(Cong m,x)) & (y in
  Class(Cong m,x) implies (a*y-b) mod m = 0);

theorem 
  for a,b,m,x being Integer holds m<>0 & a,m are_relative_prime & (a*x-b
  ) mod m = 0 implies ex s being Integer st [x,b*s] in Cong m;

theorem 
  for a,m being Element of NAT st a<>0 & m>1 & a,m are_relative_prime
for b,x being Integer holds (a*x-b) mod m = 0 implies [x, b*(a|^(Euler m -'1))]
  in Cong m;

theorem 
  m<>0 & (a gcd m) divides b implies ex fp being FinSequence of INT st
len fp = a gcd m & (for c st c in dom fp holds (a*(fp.c)-b) mod m = 0) & for c1
  ,c2 st c1 in dom fp & c2 in dom fp & c1<>c2 holds not fp.c1,fp.c2
  are_congruent_mod m;

begin

reserve fp,fp1 for FinSequence of NAT,

  b,c,d, n for Element of NAT,
  a for Nat;

theorem 
  for b,n st b in dom fp & len fp = n+1 holds Del(fp^<*d*>,b) = Del(fp,b)^<*d*>
;

theorem 
  len fp>=2 & (for b,c st b in dom fp & c in dom fp & b<>c holds (
fp.b gcd fp.c)=1) implies for b st b in dom fp holds (Product Del(fp,b)) gcd (
  fp.b) = 1;

theorem 
  for a st a in dom fp holds fp.a divides Product fp;

theorem 
  a in dom fp & p divides fp.a implies p divides Product fp;

theorem 
  len fp = n+1 & a >= 1 & a <= n implies Del(fp,a).n = fp.(len fp);

theorem 
  for a,b st a in dom fp & b in dom fp & a<>b & len fp >= 1 holds
  fp.b divides Product Del (fp,a);

theorem 
  (for b being Nat st b in dom fp holds a divides fp.b) implies a
  divides Sum fp;

theorem 
  len fp>=2 & (for b,c st b in dom fp & c in dom fp & b<>c holds (fp.b
gcd fp.c)=1) & (for b st b in dom fp holds fp.b <> 0) implies for fp1 holds ex
  x being Integer st for b st b in dom fp holds (x-fp1.b) mod fp.b = 0;

theorem 
  (for b,c st b in dom fp & c in dom fp & b<>c holds (fp.b gcd fp.
c)=1) & (for b st b in dom fp holds fp.b divides a) implies Product fp divides
  a;

theorem 
  (for b,c st b in dom fp & c in dom fp & b<>c holds (fp.b gcd fp.c)=1)
  & (for b st b in dom fp holds fp.b > 0) implies for fp1 st (for b st b in dom
  fp holds (x-fp1.b) mod fp.b = 0 & (y-fp1.b) mod fp.b = 0) holds x,y
  are_congruent_mod Product(fp);

reserve i,m,m1,m2,m3,r,s,a,b,c,c1,c2,x,y for Integer;

theorem 
  m1<>0 & m2<>0 & m1,m2 are_relative_prime implies ex r being
Integer st (for x st (x - c1) mod m1 = 0 & (x - c2) mod m2 = 0 holds x,(c1+m1*r
  ) are_congruent_mod (m1*m2)) & (m1*r - (c2-c1)) mod m2 = 0;

theorem 
  m1 <> 0 & m2 <> 0 & not (m1 gcd m2) divides (c1-c2) implies not
  ex x st (x - c1) mod m1 = 0 & (x - c2) mod m2 = 0;

theorem 
  m1<>0 & m2<>0 & (m1 gcd m2) divides (c2-c1) implies ex r st (for
x st (x-c1) mod m1 = 0 & (x-c2) mod m2 = 0 holds x,(c1+m1*r) are_congruent_mod
(m1 lcm m2)) & ((m1 div (m1 gcd m2))*r - ((c2-c1) div (m1 gcd m2))) mod (m2 div
  (m1 gcd m2)) = 0;

theorem 
  m1<>0 & m2<>0 & (a gcd m1) divides c1 & (b gcd m2) divides c2 & m1,m2
are_relative_prime implies ex w,r,s being Integer st (for x st (a*x-c1) mod m1
= 0 & (b*x-c2) mod m2 = 0 holds x,(r + (m1 div (a gcd m1))*w) are_congruent_mod
  ((m1 div (a gcd m1))*(m2 div (b gcd m2)))) & ((a div (a gcd m1))*r-(c1 div (a
gcd m1))) mod (m1 div (a gcd m1)) =0 & ((b div (b gcd m2))*s-(c2 div (b gcd m2)
)) mod (m2 div (b gcd m2)) = 0 & ((m1 div (a gcd m1))*w - (s-r)) mod ((m2 div (
  b gcd m2))) = 0;

theorem 
  m1 <> 0 & m2 <> 0 & m3 <> 0 & m1,m2 are_relative_prime & m1,m3
are_relative_prime & m2,m3 are_relative_prime implies ex r,s st for x st (x-a)
  mod m1=0 & (x-b) mod m2=0 & (x-c) mod m3=0 holds x,(a+m1*r+m1*m2*s)
  are_congruent_mod (m1*m2*m3) & (m1*r-(b-a)) mod m2 = 0 & (m1*m2*s-(c-a-m1*r))
  mod m3 = 0;

theorem 
  m1 <> 0 & m2 <> 0 & m3 <> 0 & (not (m1 gcd m2) divides (a - b) or not
(m1 gcd m3) divides (a - c) or not (m2 gcd m3) divides (b - c)) implies not ex
  x st (x-a) mod m1 = 0 & (x-b) mod m2 = 0 & (x-c) mod m3 = 0;

theorem 
  for n1,n2,n3 being non zero Nat holds (n1 gcd n3) lcm
  (n2 gcd n3) = (n1 lcm n2) gcd n3;

theorem 
  for n1,n2,n3 being non zero Nat st (n1 gcd n2) divides (a-b
  ) holds ex r,s st for x st (x-a) mod n1=0 & (x-b) mod n2=0 & (x-c) mod n3=0
holds x,((a+n1*r)+(n1 lcm n2)*s) are_congruent_mod ((n1 lcm n2) lcm n3) & ((n1
div (n1 gcd n2))*r-((b-a) div (n1 gcd n2))) mod (n2 div (n1 gcd n2))=0 & (((n1
  lcm n2) div ((n1 lcm n2) gcd n3))*s-((c-(a+n1*r)) div ((n1 lcm n2) gcd n3)))
  mod (n3 div ((n1 lcm n2) gcd n3))=0;

begin 

reserve

  a,b,c,m for Element of NAT;

definition
  let m be Nat, X be set;
  pred X is_CRS_of m means


  ex fp being FinSequence of INT st X = rng fp & len fp = m &
  for b being Nat st b in dom fp holds fp.b in Class(Cong m, b-'1);
end;

theorem 
  { a: a < m } is_CRS_of m;

theorem 
  for X being finite set st X is_CRS_of m holds card X = m & for x
  ,y being Integer st x in X & y in X & x<>y holds not [x,y] in Cong m;

theorem 
  {} is_CRS_of m iff m = 0;

theorem 
  for X being finite set st card X = m holds ex fp being
  FinSequence st len fp = m & (for a st a in dom fp holds fp.a in X) & fp is
  one-to-one;

theorem 
  for X being finite Subset of INT st card X = m & (for x,y being
Integer st x in X & y in X & x<>y holds not [x,y] in Cong m) holds X is_CRS_of
  m;

reserve a for Integer;

theorem 
  for X being finite Subset of INT st X is_CRS_of m holds (a ++ X) is_CRS_of m;

theorem 
  for X being finite Subset of INT st a,m are_relative_prime & X
  is_CRS_of m holds (a ** X) is_CRS_of m;














begin 

reserve x,y,X,Y,Z for set,
        D for non empty set,
        n,k for Nat,
        i,i1,i2 for Integer;

notation let X;
  antonym X is with_empty_element for X is with_non-empty_elements;
end;

registration
  cluster empty -> subset-closed for set;
  cluster with_empty_element -> non empty for set;
  cluster non empty subset-closed -> with_empty_element for set;
end;

registration
  let X;
  cluster Sub_of_Fin X -> finite-membered;
end;

registration
  let X be subset-closed set;
  cluster Sub_of_Fin X -> subset-closed;
end;

theorem 
  Y is subset-closed iff for X st X in Y holds bool X c= Y;

registration
  let A,B be subset-closed set;
  cluster A \/ B -> subset-closed;
  cluster A /\ B -> subset-closed;
end;

definition
  let X;
  func subset-closed_closure_of X -> subset-closed set means

    X c= it & for Y st X c= Y & Y is subset-closed holds it c= Y;
end;

theorem 
  x in subset-closed_closure_of X iff ex y st x c= y & y in X;

definition
  let X;
  let F be Subset-Family of X;
  redefine func subset-closed_closure_of F -> subset-closed Subset-Family of X;
end;

registration
  cluster subset-closed_closure_of {} -> empty;
  let X be non empty set;
  cluster subset-closed_closure_of X -> non empty;
end;

registration
  let X be with_non-empty_element set;
  cluster subset-closed_closure_of X -> with_non-empty_element;
end;

registration
  let X be finite-membered set;
  cluster subset-closed_closure_of X -> finite-membered;
end;

theorem 
  X c=Y & Y is subset-closed implies subset-closed_closure_of X c= Y;

theorem 
  subset-closed_closure_of {X} = bool X;

theorem 
  subset-closed_closure_of (X\/Y) =
    subset-closed_closure_of X \/ subset-closed_closure_of Y;

theorem 
  X is_finer_than Y iff
    subset-closed_closure_of X c= subset-closed_closure_of Y;

theorem 
  X is subset-closed implies subset-closed_closure_of X = X;

theorem 
  subset-closed_closure_of X c= X implies X is subset-closed;

definition
  let Y,X;
  let n be set;
  func the_subsets_with_limited_card(n,X,Y) -> Subset-Family of Y means

    for A be Subset of Y holds A in it iff A in X & card A c= card n;
end;

registration
  let D;
  cluster finite with_non-empty_element subset-closed
          finite-membered for Subset-Family of D;
end;

registration
  let Y,X;
  let n be finite set;
  cluster the_subsets_with_limited_card(n,X,Y) -> finite-membered;
end;

registration
  let Y;
  let X be subset-closed set;
  let n be set;
  cluster the_subsets_with_limited_card(n,X,Y) -> subset-closed;
end;

registration
  let Y;
  let X be with_empty_element set;
  let n be set;
  cluster the_subsets_with_limited_card(n,X,Y) -> with_empty_element;
end;

registration
  let D;
  let X be with_non-empty_element subset-closed Subset-Family of D;
  let n be non empty set;
  cluster the_subsets_with_limited_card(n,X,D) -> with_non-empty_element;
end;

notation let X;
  let Y be Subset-Family of X;
  let n be set;
  synonym the_subsets_with_limited_card(n,Y)
      for the_subsets_with_limited_card(n,Y,X);
end;

theorem 
  X is non empty finite c=-linear implies union X in X;

theorem 
  for X be finite c=-linear set st X is with_non-empty_elements
    holds card X c= card union X;

theorem 
  X is c=-linear implies X\/{union X\/x} is c=-linear;

theorem 
  for X be non empty set ex Y be Subset-Family of X st
      Y is with_non-empty_elements c=-linear & X in Y & card X = card Y &
      for Z st Z in Y & card Z <> 1 ex x st x in Z & Z\{x} in Y;

theorem 
  for Y be Subset-Family of X st
     Y is finite with_non-empty_elements c=-linear & X in Y
  ex Y1 be Subset-Family of X st
    Y c= Y1 & Y1 is with_non-empty_elements c=-linear & card X = card Y1 &
    for Z st Z in Y1 & card Z <> 1 ex x st x in Z & Z\{x} in Y1;

begin  

definition
  mode SimplicialComplexStr is TopStruct;
end;

reserve K for SimplicialComplexStr;

notation let K;
  let A be Subset of K;
  synonym A is simplex-like for A is open;
end;

notation let K;
  let S be Subset-Family of K;
  synonym S is simplex-like for S is open;
end;

registration
  let K;
  cluster empty simplex-like for Subset-Family of K;
end;

theorem 
  for S be Subset-Family of K holds
    S is simplex-like iff S c= the topology of K;

definition
  let K;
  let v be Element of K;
  attr v is vertex-like means

    ex S be Subset of K st S is simplex-like & v in S;
end;

definition
  let K;
  func Vertices K -> Subset of K means

    for v be Element of K holds v in it iff v is vertex-like;
end;

definition
  let K be SimplicialComplexStr;
  mode Vertex of K is Element of Vertices K;
end;

definition
  let K be SimplicialComplexStr;
  attr K is finite-vertices means

    Vertices K is finite;
end;

definition
  let K;
  attr K is locally-finite means

    for v be Vertex of K holds
      {S where S is Subset of K : S is simplex-like & v in S} is finite;
end;

definition
  let K;
  attr K is empty-membered means

    the topology of K is empty-membered;
  attr K is with_non-empty_elements means

    the topology of K is with_non-empty_elements;
end;

notation let K;
  antonym K is with_non-empty_element for K is empty-membered;
  antonym K is with_empty_element for K is with_non-empty_elements;
end;

definition
  let X;
  mode SimplicialComplexStr of X -> SimplicialComplexStr means

    [#]it c= X;
end;

definition
  let X;
  let KX be SimplicialComplexStr of X;
  attr KX is total means

    [#]KX = X;
end;

registration
  cluster with_empty_element -> non void for SimplicialComplexStr;
  cluster with_non-empty_element -> non void for SimplicialComplexStr;
  cluster non void empty-membered -> with_empty_element for
SimplicialComplexStr;
  cluster non void subset-closed -> with_empty_element for
SimplicialComplexStr;
  cluster empty-membered-> subset-closed finite-vertices for
SimplicialComplexStr;
  cluster finite-vertices-> locally-finite finite-degree for
SimplicialComplexStr;
  cluster locally-finite subset-closed -> finite-membered for
SimplicialComplexStr;
end;

registration
  let X;
  cluster empty void empty-membered strict for SimplicialComplexStr of X;
end;

registration
  let D;
  cluster non empty non void total empty-membered
            strict for SimplicialComplexStr of D;
  cluster non empty total with_empty_element with_non-empty_element
            finite-vertices subset-closed strict for SimplicialComplexStr of D;
end;

registration
  cluster non empty with_empty_element with_non-empty_element finite-vertices
            subset-closed strict for SimplicialComplexStr;
end;

registration
  let K be with_non-empty_element SimplicialComplexStr;
  cluster Vertices K -> non empty;
end;

registration
  let K be finite-vertices SimplicialComplexStr;
  cluster simplex-like -> finite for Subset-Family of K;
end;

registration
  let K be finite-membered SimplicialComplexStr;
  cluster simplex-like -> finite-membered for Subset-Family of K;
end;

theorem 
  Vertices K is empty iff K is empty-membered;

theorem 
  Vertices K = union the topology of K;

theorem 
  for S be Subset of K st S is simplex-like holds S c= Vertices K;

theorem 
  K is finite-vertices implies the topology of K is finite;

theorem 
  the topology of K is finite & K is non finite-vertices implies
    K is non finite-membered;

theorem 
  K is subset-closed & the topology of K is finite implies K is finite-vertices
;

begin 

definition
  let X;
  let Y be Subset-Family of X;
  func Complex_of Y -> strict SimplicialComplexStr of X equals

    TopStruct(# X,subset-closed_closure_of Y #);
end;

registration
  let X;
  let Y be Subset-Family of X;
  cluster Complex_of Y -> total subset-closed;
end;

registration
  let X;
  let Y be non empty Subset-Family of X;
  cluster Complex_of Y -> with_empty_element;
end;

registration
  let X;
  let Y be finite-membered Subset-Family of X;
  cluster Complex_of Y -> finite-membered;
end;

registration
  let X;
  let Y be finite finite-membered Subset-Family of X;
  cluster Complex_of Y -> finite-vertices;
end;

theorem 
  K is subset-closed implies the TopStruct of K = Complex_of the topology of K;

definition
  let X;
  mode SimplicialComplex of X is finite-membered subset-closed
         SimplicialComplexStr of X;
end;

definition
  let K be non void SimplicialComplexStr;
  mode Simplex of K is simplex-like Subset of K;
end;

registration
  let K be with_empty_element SimplicialComplexStr;
  cluster empty -> simplex-like for Subset of K;
  cluster empty for Simplex of K;
end;

registration
  let K be non void finite-membered SimplicialComplexStr;
  cluster finite for Simplex of K;
end;

begin 

definition
  let K;
  func degree K -> ext-real number means

    (for S be finite Subset of K st S is simplex-like holds card S <= it+1) &
     ex S be Subset of K st S is simplex-like & card S = it+1
           if K is non void finite-degree,
   it = -1 if K is void
           otherwise
   it = +infty;
end;

registration
  let K be finite-degree SimplicialComplexStr;
  cluster degree K + 1 -> natural;
  cluster degree K -> integer;
end;

theorem 
  degree K = -1 iff K is empty-membered;

theorem 
  -1 <= degree K;

theorem 
  for S be finite Subset of K st S is simplex-like holds card S <= degree K+1;

theorem 
 K is non void or i >= -1 implies (degree K <= i iff K is finite-membered &
   for S be finite Subset of K st S is simplex-like holds card S <= i+1);

theorem 
  for A be finite Subset of X holds degree Complex_of {A} = card A - 1;

begin 

definition
  let X;
  let KX be SimplicialComplexStr of X;
  mode SubSimplicialComplex of KX -> SimplicialComplex of X means

   [#]it c= [#]KX & the topology of it c= the topology of KX;
end;

reserve KX for SimplicialComplexStr of X,
        SX for SubSimplicialComplex of KX;

registration
  let X,KX;
  cluster empty void strict for SubSimplicialComplex of KX;
end;

registration
  let X;
  let KX be void SimplicialComplexStr of X;
  cluster -> void for SubSimplicialComplex of KX;
end;

registration
  let D;
  let KD be non void subset-closed SimplicialComplexStr of D;
  cluster non void for SubSimplicialComplex of KD;
end;

registration
  let X;
  let KX be finite-vertices SimplicialComplexStr of X;
  cluster -> finite-vertices for SubSimplicialComplex of KX;
end;

registration
  let X;
  let KX be finite-degree SimplicialComplexStr of X;
  cluster -> finite-degree for SubSimplicialComplex of KX;
end;

theorem 
  for S1 be SubSimplicialComplex of SX holds S1 is SubSimplicialComplex of KX;

theorem 
  for A be Subset of KX for S be finite-membered Subset-Family of A st
        subset-closed_closure_of S c=the topology of KX
      holds Complex_of S is strict SubSimplicialComplex of KX;

theorem 
  for KX be subset-closed SimplicialComplexStr of X
    for A be Subset of KX for S be finite-membered Subset-Family of A st
        S c= the topology of KX
      holds Complex_of S is strict SubSimplicialComplex of KX;

theorem 
  for Y1,Y2 be Subset-Family of X st
      Y1 is finite-membered & Y1 is_finer_than Y2
    holds Complex_of Y1 is SubSimplicialComplex of Complex_of Y2;

theorem 
  Vertices SX c= Vertices KX;

theorem 
  degree SX <= degree KX;

definition
  let X,KX,SX;
  attr SX is maximal means

    for A be Subset of SX st A in the topology of KX holds A is simplex-like;
end;

theorem 
  SX is maximal iff bool[#]SX /\ the topology of KX c= the topology of SX;

registration
  let X,KX;
  cluster maximal strict for SubSimplicialComplex of KX;
end;

theorem 
  for S1 be SubSimplicialComplex of SX st SX is maximal & S1 is maximal
    holds S1 is maximal SubSimplicialComplex of KX;

theorem 
  for S1 be SubSimplicialComplex of SX st
      S1 is maximal SubSimplicialComplex of KX
    holds S1 is maximal;

theorem 
  for K1,K2 be maximal SubSimplicialComplex of KX st [#]K1 = [#]K2
    holds the TopStruct of K1 = the TopStruct of K2;

definition
  let X;
  let KX be subset-closed SimplicialComplexStr of X;
  let A be Subset of KX such that
     bool A /\ the topology of KX is finite-membered;
  func KX|A -> maximal strict SubSimplicialComplex of KX means

    [#]it = A;
end;

reserve SC for SimplicialComplex of X;

definition
  let X,SC;
  let A be Subset of SC;
  redefine func SC|A means

    [#]it = A;
end;

theorem 
  for A be Subset of SC holds
    the topology of SC|A = bool A /\ the topology of SC;

theorem 
  for A,B be Subset of SC for B1 be Subset of SC|A st B1 = B
   holds SC|A|B1 = SC|B;

theorem 
  SC|[#]SC = the TopStruct of SC;

theorem 
  for A,B be Subset of SC st A c= B holds SC|A is SubSimplicialComplex of SC|B;

registration
  cluster -> finite for Integer;
end;

begin 

definition
  let X,KX;
  let i be real number;
  func Skeleton_of(KX,i) -> SimplicialComplexStr of X equals

    Complex_of the_subsets_with_limited_card(i + 1,the topology of KX);
end;

registration
  let X,KX;
  cluster Skeleton_of(KX,-1) -> empty-membered;
  let i;
  cluster Skeleton_of(KX,i) -> finite-degree;
end;

registration
  let X;
  let KX be empty-membered SimplicialComplexStr of X;
  let i;
  cluster Skeleton_of(KX,i) -> empty-membered;
end;

registration
  let D;
  let KD be non void subset-closed SimplicialComplexStr of D;
  let i;
  cluster Skeleton_of(KD,i) -> non void;
end;

theorem 
  -1 <= i1 & i1 <= i2 implies
    Skeleton_of(KX,i1) is SubSimplicialComplex of Skeleton_of(KX,i2);

definition
  let X;
  let KX be subset-closed SimplicialComplexStr of X;
  let i;
  redefine func Skeleton_of(KX,i) -> SubSimplicialComplex of KX;
end;

theorem 
  KX is subset-closed & Skeleton_of(KX,i) is empty-membered implies
    KX is empty-membered or i = -1;

theorem 
  degree Skeleton_of(KX,i) <= degree KX;

theorem 
  -1 <= i implies degree Skeleton_of(KX,i) <= i;

theorem 
  -1 <= i & Skeleton_of(KX,i) = the TopStruct of KX implies degree KX <= i;

theorem 
  KX is subset-closed & degree KX <= i implies
    Skeleton_of(KX,i) = the TopStruct of KX;

reserve K for non void subset-closed SimplicialComplexStr;

definition
  let K;
  let i be real number such that
   i is integer;
  mode Simplex of i,K -> finite Simplex of K means

    card it = i+1 if -1 <= i & i <= degree K otherwise it is empty;
end;

registration
  let K;
  cluster -> empty for Simplex of-1,K;
end;

theorem 
  for S be Simplex of i,K st S is non empty holds i is natural;

theorem 
  for S be finite Simplex of K holds S is Simplex of card S - 1,K;

theorem 
  for K be non void subset-closed SimplicialComplexStr of D
    for S be non void SubSimplicialComplex of K
      for i be Integer,A be Simplex of i,S st
          A is non empty or i <= degree S or degree S = degree K
        holds A is Simplex of i,K;

definition
  let K;
  let i be real number such that
     i is integer and
     i <= degree K;
  let S be Simplex of i,K;
  mode Face of S -> Simplex of max(i-1,-1),K means

     it c= S;
end;

theorem 
  for S be Simplex of n,K st n<=degree K holds
    X is Face of S iff ex x st x in S & S\{x} = X;

begin 

reserve P for Function;

definition
  let X,KX,P;
  func subdivision(P,KX) -> strict SimplicialComplexStr of X means

    [#]it = [#]KX & for A be Subset of it holds A is simplex-like iff
       ex S be c=-linear finite simplex-like Subset-Family of KX st A = P.:S;
end;

registration
  let X,KX,P;
  cluster subdivision(P,KX)
            -> with_empty_element subset-closed finite-membered;
end;

registration
  let X;
  let KX be void SimplicialComplexStr of X;
  let P;
  cluster subdivision(P,KX) -> empty-membered;
end;

theorem 
  degree subdivision(P,KX) <= degree KX + 1;

theorem 
  dom P is with_non-empty_elements implies
    degree subdivision(P,KX) <= degree KX;

registration
  let X;
  let KX be finite-degree SimplicialComplexStr of X;
  let P;
  cluster subdivision(P,KX) -> finite-degree;
end;

registration
  let X;
  let KX be finite-vertices SimplicialComplexStr of X;
  let P;
  cluster subdivision(P,KX) -> finite-vertices;
end;

theorem 
  for KX be subset-closed SimplicialComplexStr of X
  for P st dom P is with_non-empty_elements &
           for n st n <= degree KX ex S be Subset of KX st
             S is simplex-like & card S = n+1 & BOOL S c=dom P &
             P.:BOOL S is Subset of KX & P|BOOL S is one-to-one
    holds degree subdivision(P,KX) = degree KX;

theorem 
  Y c=Z implies
    subdivision(P|Y,KX) is SubSimplicialComplex of subdivision(P|Z,KX);

theorem 
  dom P/\the topology of KX c= Y implies
    subdivision(P|Y,KX) = subdivision(P,KX);

theorem 
  Y c= Z implies
    subdivision(Y|`P,KX) is SubSimplicialComplex of subdivision(Z|`P,KX);

theorem 
 P.:(the topology of KX) c= Y implies subdivision(Y|`P,KX) = subdivision(P,KX);

theorem 
  subdivision(P,SX) is SubSimplicialComplex of subdivision(P,KX);

theorem 
  for A be Subset of subdivision(P,KX) st
      dom P c=the topology of SX & A = [#]SX
    holds subdivision(P,SX)=subdivision(P,KX)|A;

theorem 
  for K1,K2 be SimplicialComplexStr of X st
      the TopStruct of K1 = the TopStruct of K2
    holds subdivision(P,K1) = subdivision(P,K2);

definition
  let X,KX,P,n;
  func subdivision(n,P,KX) -> SimplicialComplexStr of X means

    ex F be Function st F.0 = KX & F.n = it & dom F = NAT &
         for k for KX1 be SimplicialComplexStr of X st KX1 = F.k
           holds F.(k+1) = subdivision(P,KX1);
end;

theorem 
  subdivision(0,P,KX) = KX;

theorem 
  subdivision(1,P,KX) = subdivision(P,KX);

theorem 
  for n,k be Element of NAT holds
    subdivision(n+k,P,KX) = subdivision(n,P,subdivision(k,P,KX));

theorem 
  [#]subdivision(n,P,KX) = [#]KX;

theorem 
  subdivision(n,P,SX) is SubSimplicialComplex of subdivision(n,P,KX);














begin 

reserve x,y for set,
        r,s for Real,
        n for Nat,
        V for RealLinearSpace,
        v,u,w,p for VECTOR of V,
        A,B for Subset of V,
        Af for finite Subset of V,
        I for affinely-independent Subset of V,
        If for finite affinely-independent Subset of V,
        F for Subset-Family of V,
        L1,L2 for Linear_Combination of V;

theorem 
  for L be Linear_Combination of A st L is convex & v <> Sum L & L.v <> 0
   ex p st p in conv(A\{v}) & Sum L = L.v*v + (1-L.v)*p &
           1/L.v*(Sum L) + (1-1/L.v)*p = v;

theorem 
  for p1,p2,w1,w2 be Element of V st v in conv I & u in conv I &
      not u in conv(I\{p1}) & not u in conv(I\{p2}) &
      w1 in conv(I\{p1}) & w2 in conv(I\{p2}) &
      r*u+(1-r)*w1 = v & s*u + (1-s)*w2 = v & r < 1 & s < 1
    holds w1 = w2 & r = s;

theorem 
  for L be Linear_Combination of Af st Af c=conv If & sum L=1 holds
     Sum L in Affin If
   & for x be Element of V
       ex F be FinSequence of REAL,G be FinSequence of V st
          (Sum L|--If).x = Sum F & len G = len F & G is one-to-one &
          rng G = Carrier L &
          for n st n in dom F holds F.n = L.(G.n)*(G.n|--If).x;

theorem 
  for Aff be Subset of V st Aff is Affine & conv A /\ conv B c= Aff &
                            conv(A\{v}) c= Aff & not v in Aff
    holds conv (A\{v}) /\ conv B = conv A /\ conv B;

begin 

definition
  let V be non empty RLSStruct;
  let A be Subset of V;
  func Int A -> Subset of V means

    x in it iff x in conv A & not ex B be Subset of V st B c< A & x in conv B;
end;

registration
  let V be non empty RLSStruct;
  let A be empty Subset of V;
  cluster Int A -> empty;
end;

theorem 
  for V be non empty RLSStruct for A be Subset of V holds Int A c= conv A;

theorem 
  for V be vector-distributive scalar-distributive scalar-associative
  scalar-unitalnon empty RLSStruct
    for A be Subset of V holds Int A = A iff A is trivial;

theorem 
  A c< B implies conv A misses Int B;

theorem 
  conv A = union {Int B : B c= A};

theorem 
  conv A = Int A \/ union{conv (A\{v}) : v in A};

theorem 
  x in Int A implies ex L be Linear_Combination of A st L is convex & x = Sum L
;

theorem 
  for L be Linear_Combination of A st L is convex & Sum L in Int A
    holds Carrier L = A;

theorem 
  for L be Linear_Combination of I st L is convex & Carrier L = I holds
    Sum L in Int I;

theorem 
  Int A is non empty implies A is finite;

theorem 
  v in I & u in Int I & p in conv(I\{v}) & r*v + (1-r)*p = u implies
    p in Int (I\{v});

begin 

definition let V;
  func center_of_mass V -> Function of BOOL the carrier of V,the carrier of V
    means

   (for A be non empty finite Subset of V holds it.A = 1/card A * Sum(A)) &
    for A st A is infinite holds it.A = 0.V;
end;

theorem 
  ex L be Linear_Combination of Af st Sum L = r*Sum Af & sum L = r * card Af &
                                      L = (ZeroLC V) +* (Af-->r);

theorem 
  Af is non empty implies (center_of_mass V).Af in conv Af;

theorem 
  union F is finite implies (center_of_mass V).:F c= conv union F;

theorem 
  v in If implies ((center_of_mass V).If |-- If).v = 1/card If;

theorem 
  (center_of_mass V).If in If iff card If=1;

theorem 
  If is non empty implies (center_of_mass V).If in Int If;

theorem 
  A c= If & (center_of_mass V).If in Affin A implies If = A;

theorem 
  v in Af & Af\{v} is non empty implies (center_of_mass V).Af =
        (1-1/card Af) * (center_of_mass V)/.(Af\{v}) + 1/card Af*v;

theorem 
  conv A c=conv If & If is non empty & conv A misses Int If implies
    ex B be Subset of V st B c< If & conv A c= conv B;

theorem 
  Sum L1 <> Sum L2 & sum L1 = sum L2 implies ex v st L1.v > L2.v;

theorem 
  for p be Real st (r*L1+(1-r)*L2).v <= p & p <= (s*L1+(1-s)*L2).v
     ex rs be Real st (rs*L1+(1-rs)*L2).v = p &
                      (r <= s implies r <= rs & rs <= s) &
                      (s <= r implies s <= rs & rs <= r);

theorem 
  v in conv A & u in conv A & v <> u implies
   ex p,w,r st p in A & w in conv(A\{p}) & 0<=r & r<1 & r*u+(1-r)*w = v;

theorem 
  A\/{v} is affinely-independent iff
     A is affinely-independent & (v in A or not v in Affin A);

theorem 
  Af c= I & v in Af implies
     I\{v}\/{(center_of_mass V).Af} is affinely-independent Subset of V;

theorem 
  for F be c=-linear Subset-Family of V st
      union F is finite affinely-independent
    holds (center_of_mass V).:F is affinely-independent Subset of V;

theorem 
  for F be c=-linear Subset-Family of V st
      union F is affinely-independent finite
    holds Int ((center_of_mass V).:F) c= Int union F;














begin

reserve i,j,n for Nat,
  K for Field,
  a for Element of K,
  M,M1,M2,M3,M4 for Matrix of n,K;
reserve A for Matrix of K;

definition
  let n be Nat, K be Field, M1,M2 be Matrix of n,K;
  pred M1 commutes_with M2 means


  M1 * M2 = M2 * M1;
  reflexivity;
  symmetry;
end;

definition
  let n be Nat,K be Field,M1,M2 be Matrix of n,K;
  pred M1 is_reverse_of M2 means


  M1*M2 = M2*M1 & M1*M2 = 1.(K,n);
  symmetry;
end;

definition
  let n be Nat, K be Field;
  let M1 be Matrix of n,K;
  attr M1 is invertible means


  ex M2 be Matrix of n,K st M1 is_reverse_of M2;
end;

definition
  let n, K;
  let M1 be Matrix of n,K;
  redefine func -M1 -> Matrix of n,K;
end;

definition
  let n, K;
  let M1,M2 be Matrix of n,K;
  redefine func M1+M2 -> Matrix of n,K;
end;

definition
  let n, K;
  let M1,M2 be Matrix of n,K;
  redefine func M1-M2 -> Matrix of n,K;
  redefine func M1*M2 -> Matrix of n,K;
end;

theorem 
  for K being Field,A being Matrix of K holds (0.(K,len A,len A))*A
  =0.(K,len A,width A);

theorem 
  for K being Field,A being Matrix of K st width A>0 holds A*(0.(K,
  width A,width A))=0.(K,len A,width A);

theorem 
  M1 commutes_with 0.(K,n,n);

theorem 
  M1 commutes_with M2 & M2 commutes_with M3 & M1 commutes_with M3
  implies M1 commutes_with M2*M3;

theorem 
  M1 commutes_with M2 & M1 commutes_with M3 & n>0 implies M1
  commutes_with M2+M3;

theorem 
  M1 commutes_with 1.(K,n);

theorem 
  M2 is_reverse_of M3 & M1 is_reverse_of M3 implies M1=M2;

definition
  let n be Nat, K be Field, M1 be Matrix of n,K;
  assume
 M1 is invertible;
  func M1~ -> Matrix of n,K means


  it is_reverse_of M1;
end;

theorem 
  (1.(K,n))~ = 1.(K,n) & 1.(K,n) is invertible;

theorem 
  ((1.(K,n))~)~ = 1.(K,n);

theorem 
  (1.(K,n))@ = 1.(K,n);

theorem 
  for K being Field, n being Nat holds ((1.(K,n))@)~ = 1.(K,n);

theorem 
  M3 is_reverse_of M1 & n>0 implies M1@ is_reverse_of M3@;

theorem 
  M is invertible & n > 0 implies M@~= M~@;

theorem 
  for K being Field, n being Nat, M1,M2,M3,M4 being Matrix of n,K st M3
  is_reverse_of M1 & M4 is_reverse_of M2 holds M3*M4 is_reverse_of M2*M1;

theorem 
  for K being Field, n being Nat, M1,M2 being Matrix of n,K st M2
  is_reverse_of M1 holds M1 commutes_with M2;

theorem 
  M is invertible implies M~ is invertible & (M~)~= M;

theorem 
  n > 0 & M1*M2=0.(K,n,n) & M1 is invertible implies M1 commutes_with M2;

theorem 
  M1=M1*M2 & M1 is invertible implies M1 commutes_with M2;

theorem 
  M1=M2*M1 & M1 is invertible implies M1 commutes_with M2;

definition
  let n be Nat, K be Field;
  let M1 be Matrix of n,K;
  attr M1 is symmetric means


  M1@=M1;
end;

registration
  let n be Nat, K be Field;
  cluster 1.(K,n) -> symmetric;
end;

theorem 
  ((n,n)-->a)@ = (n,n)-->a;

theorem 
  (n,n)-->a is symmetric;

theorem 
  n > 0 & M1 is symmetric & M2 is symmetric implies (M1 commutes_with M2
  iff M1*M2 is symmetric);

theorem 
  (M1+M2)@=M1@+M2@;

theorem 
  M1 is symmetric & M2 is symmetric implies M1+M2 is symmetric;

theorem 
  M1 is Upper_Triangular_Matrix of n,K & M1 is Lower_Triangular_Matrix
  of n,K implies M1 is symmetric;

theorem 
  for K being Field,n being Nat,M1 being Matrix of n,K holds (-M1) @=-(M1@);

theorem 
  for K being Field, n being Nat, M1 being Matrix of n,K st M1 is
  symmetric holds -M1 is symmetric;

theorem 
  for K being Field,n being Nat,M1,M2 being Matrix of n,K st M1 is
  symmetric & M2 is symmetric holds M1-M2 is symmetric;

definition
  let n be Nat,K be Field;
  let M1 be Matrix of n,K;
  attr M1 is antisymmetric means


  M1@=-M1;
end;

theorem 
  for K being Fanoian Field,n being Nat,M1 being Matrix of n,K st M1 is
  symmetric antisymmetric holds M1=0.(K,n,n);

theorem 
  for K being Fanoian Field,n,i being Nat,M1 being Matrix of n,K st M1
  is antisymmetric & i in Seg n holds M1*(i,i) =0.K;

theorem 
  for K being Field,n being Nat,M1,M2 being Matrix of n,K st M1 is
  antisymmetric & M2 is antisymmetric holds M1+M2 is antisymmetric;

theorem 
  for K being Field,n being Nat,M1 being Matrix of n,K st M1 is
  antisymmetric holds -M1 is antisymmetric;

theorem 
  for K being Field,n being Nat,M1,M2 being Matrix of n,K st M1 is
  antisymmetric & M2 is antisymmetric holds M1-M2 is antisymmetric;

theorem 
  n>0 implies M1-M1@ is antisymmetric;

theorem 
  n>0 implies (M1 commutes_with M2 iff (M1+M2)*(M1+M2)=M1*M1+M1*M2+M1*M2
  +M2*M2);

theorem 
  M1 is invertible & M2 is invertible implies M1*M2 is invertible
  & (M1*M2)~=(M2~)*(M1~);

theorem 
  M1 is invertible & M2 is invertible & M1 commutes_with M2 implies M1*
  M2 is invertible & (M1*M2)~ = (M1~)*(M2~);

theorem 
  M1 is invertible & M1*M2=1.(K,n) implies M1 is_reverse_of M2;

theorem 
  M2 is invertible & M2*M1=1.(K,n) implies M1 is_reverse_of M2;

theorem 
  M1 is invertible & M1 commutes_with M2 implies M1~ commutes_with M2;

definition
  let n be Nat, K be Field;
  let M1 be Matrix of n,K;
  attr M1 is Orthogonal means


  M1 is invertible & M1@ = M1~;
end;

theorem 
  M1*(M1@)=1.(K,n) & M1 is invertible iff M1 is Orthogonal;

theorem 
  M1 is invertible & (M1@)*M1=1.(K,n) iff M1 is Orthogonal;

theorem 
  M1 is Orthogonal implies (M1@)*M1=M1*(M1@);

theorem 
  M1 is Orthogonal & M1 commutes_with M2 implies M1@ commutes_with M2;

theorem 
  M1 is invertible & M2 is invertible implies M1*M2 is invertible
  & (M1*M2)~=M2~*M1~;

theorem 
  n > 0 & M1 is Orthogonal & M2 is Orthogonal implies M1*M2 is Orthogonal;

theorem 
  M1 is Orthogonal & M1 commutes_with M2 implies M1@ commutes_with M2;

theorem 
  n > 0 & M1 commutes_with M2 implies M1+M1 commutes_with M2;

theorem 
  n >0 & M1 commutes_with M2 implies M1+M2 commutes_with M2;

theorem 
  n >0 & M1 commutes_with M2 implies M1+M1 commutes_with M2+M2;

theorem 
  n >0 & M1 commutes_with M2 implies M1+M2 commutes_with M2+M2;

theorem 
  M1 commutes_with M2 implies M1*M2 commutes_with M2;

theorem 
  M1 commutes_with M2 implies M1*M1 commutes_with M2;

theorem 
  M1 commutes_with M2 implies M1*M1 commutes_with M2*M2;

theorem 
  n>0 & M1 commutes_with M2 implies M1@ commutes_with M2@;

theorem 
  M1 is invertible & M2 is invertible & M3 is invertible implies
  M1*M2*M3 is invertible & (M1*M2*M3)~=M3~*M2~*M1~;

theorem 
  n > 0 & M1 is Orthogonal & M2 is Orthogonal & M3 is Orthogonal implies
  M1*M2*M3 is Orthogonal;

theorem 
  1.(K,n) is Orthogonal;

theorem 
  n > 0 & M1 is Orthogonal & M2 is Orthogonal implies M1~*M2 is Orthogonal;














begin 

reserve x for set,
  i,j,k,n for Nat,
  K for Field;

theorem 
  for a, A being set st a in A holds {a} in Fin A;

registration
  let n be Nat;
  cluster non empty for Element of Fin Permutations n;
end;

scheme 

  NonEmptyFiniteX { n() -> Element of NAT, A() -> non empty Element of Fin
  Permutations n(), P[set] } : P[A()]
provided
 for x being Element of Permutations n() st x in A() holds P[{x}] and
 for x being Element of Permutations n(), B being non empty Element
of Fin Permutations n() st x in A() & B c= A() & not x in B & P[B] holds P[B \/
{x}];

registration
  let n;
  cluster one-to-one FinSequence-like for Function of Seg n, Seg n;
end;

registration
  let n;
  cluster id Seg n -> FinSequence-like;
end;

theorem 
  (Rev idseq 2).1 = 2 & (Rev idseq 2).2 = 1;

theorem 
  for f being one-to-one Function st dom f = Seg 2 & rng f = Seg 2
  holds f = id Seg 2 or f = Rev id Seg 2;

begin 

theorem 
  Rev idseq n in Permutations n;

theorem 
  for f being FinSequence st n <> 0 & f in Permutations n holds Rev
  f in Permutations n;

theorem 
  Permutations 2 = { idseq 2, Rev idseq 2 };

begin 

definition
  let n,K;
  let M be Matrix of n,K;
  func PPath_product M -> Function of Permutations n, the carrier of K means


   for p being Element of Permutations(n) holds it.p = (the multF of K) $$
  Path_matrix(p,M);
end;

definition
  let n, K;
  let M be Matrix of n,K;
  func Per M -> Element of K equals

  (the addF of K) $$ (FinOmega Permutations
  n, PPath_product M);
end;

reserve a,b,c,d for Element of K;

theorem 
  Per <*<*a*>*> = a;

theorem 
  for K being Field, n being Element of NAT st n >= 1 holds Per (0.(K,n,
  n)) = 0.K;

theorem 
  for p being Element of Permutations 2 st p = idseq 2 holds
  Path_matrix (p, (a,b)][(c,d)) = <* a,d *>;

theorem 
  for p being Element of Permutations 2 st p = Rev idseq 2 holds
  Path_matrix (p, (a,b)][(c,d)) = <* b,c *>;

theorem 
  (the multF of K) $$ <* a,b *> = a * b;

begin

registration
  cluster odd for Permutation of Seg 2;
end;

registration
  let n be Nat;
  cluster even for Permutation of Seg n;
end;

theorem 
  <*2,1*> is odd Permutation of Seg 2;

theorem 
  Det (a,b)][(c,d) = a * d - b * c;

theorem 
  Per (a,b)][(c,d) = a * d + b * c;

theorem 
  Rev idseq 3 = <*3,2,1*>;

reserve D for non empty set;

theorem 
  for x,y,z being Element of D for f being FinSequence of D st f = <*x,y
  ,z*> holds Rev f = <*z,y,x*>;

theorem 
  for f, g being FinSequence st f ^ g in Permutations n holds f ^
  Rev g in Permutations n;

theorem 
  for f, g being FinSequence st f ^ g in Permutations n holds g ^
  f in Permutations n;

theorem 
  Permutations 3 = {<*1,2,3*>,<*3,2,1*>,<*1,3,2*>,<*2,3,1*>,<*2,1,
  3*>,<*3,1,2*>};

theorem 
  for a,b,c,d,e,f,g,h,i being Element of K for M being Matrix of 3
,K st M = <*<*a,b,c*>,<*d,e,f*>,<*g,h,i*>*> for p being Element of Permutations
  3 st p = <*1,2,3*> holds Path_matrix (p,M) = <* a,e,i *>;

theorem 
  for a,b,c,d,e,f,g,h,i being Element of K for M being Matrix of 3
,K st M = <*<*a,b,c*>,<*d,e,f*>,<*g,h,i*>*> for p being Element of Permutations
  3 st p = <*3,2,1*> holds Path_matrix (p,M) = <* c,e,g *>;

theorem 
  for a,b,c,d,e,f,g,h,i being Element of K for M being Matrix of 3
,K st M = <*<*a,b,c*>,<*d,e,f*>,<*g,h,i*>*> for p being Element of Permutations
  3 st p = <*1,3,2*> holds Path_matrix (p,M) = <* a,f,h *>;

theorem 
  for a,b,c,d,e,f,g,h,i being Element of K for M being Matrix of 3
,K st M = <*<*a,b,c*>,<*d,e,f*>,<*g,h,i*>*> for p being Element of Permutations
  3 st p = <*2,3,1*> holds Path_matrix (p,M) = <* b,f,g *>;

theorem 
  for a,b,c,d,e,f,g,h,i being Element of K for M being Matrix of 3
,K st M = <*<*a,b,c*>,<*d,e,f*>,<*g,h,i*>*> for p being Element of Permutations
  3 st p = <*2,1,3*> holds Path_matrix (p,M) = <* b,d,i *>;

theorem 
  for a,b,c,d,e,f,g,h,i being Element of K for M being Matrix of 3
,K st M = <*<*a,b,c*>,<*d,e,f*>,<*g,h,i*>*> for p being Element of Permutations
  3 st p = <*3,1,2*> holds Path_matrix (p,M) = <* c,d,h *>;

theorem 
  (the multF of K) $$ <* a,b,c *> = a * b * c;

theorem 
  <*1,3,2*> in Permutations 3 & <*2,3,1*> in Permutations 3 & <*2,
  1,3*> in Permutations 3 & <*3,1,2*> in Permutations 3 & <*1,2,3*> in
  Permutations 3 & <*3,2,1*> in Permutations 3;

theorem 
  <*2,3,1*>" = <*3,1,2*>;

theorem 
  for a being Element of Group_of_Perm 3 st a = <*2,3,1*> holds a" = <*3 ,1,2*>
;

begin 

theorem 
  for p being Permutation of Seg 3 st p = <* 1,3,2 *> holds p is
  being_transposition;

theorem 
  for p being Permutation of Seg 3 st p = <* 2,1,3 *> holds p is
  being_transposition;

theorem 
  for p being Permutation of Seg 3 st p = <* 3,2,1 *> holds p is
  being_transposition;

theorem 
  for p being Permutation of Seg n st p = id Seg n holds not p is
  being_transposition;

theorem 
  for p being Permutation of Seg 3 st p = <* 3,1,2 *> holds not p
  is being_transposition;

theorem 
  for p being Permutation of Seg 3 st p = <* 2,3,1 *> holds not p
  is being_transposition;

begin 

theorem 
  for f being Permutation of Seg n holds f is FinSequence of Seg n;

theorem 
  <*2,1,3*> * <*1,3,2*> = <*2,3,1*> & <*1,3,2*> * <*2,1,3*> = <*3,
1,2*> & <*2,1,3*> * <*3,2,1*> = <*3,1,2*> & <*3,2,1*> * <*2,1,3*> = <*2,3,1*> &
<*3,2,1*> * <*3,2,1*> = <*1,2,3*> & <*2,1,3*> * <*2,1,3*> = <*1,2,3*> & <*1,3,2
*> * <*1,3,2*> = <*1,2,3*> & <*1,3,2*> * <*2,3,1*> = <*3,2,1*> & <*2,3,1*> * <*
2,3,1*> = <*3,1,2*> & <*2,3,1*> * <*3,1,2*> = <*1,2,3*> & <*3,1,2*> * <*2,3,1*>
= <*1,2,3*> & <*3,1,2*> * <*3,1,2*> = <*2,3,1*> & <*1,3,2*> * <*3,2,1*> = <*2,3
  ,1*> & <*3,2,1*> * <*1,3,2*> = <*3,1,2*>;

theorem 
  for p being Permutation of Seg 3 st p is being_transposition
  holds p = <*2,1,3*> or p = <*1,3,2*> or p = <*3,2,1*>;

theorem 
  for f, g being Element of Permutations n holds f * g in Permutations n;

theorem 
  for l being FinSequence of Group_of_Perm n st (len l) mod 2 = 0 & (for
i being Element of NAT st i in dom l ex q being Element of Permutations n st l.
i = q & q is being_transposition) holds Product l is even Permutation of Seg n;

theorem 
  for l being FinSequence of Group_of_Perm 3 st (len l) mod 2 = 0
& (for i being Element of NAT st i in dom l ex q being Element of Permutations
3 st l.i = q & q is being_transposition) holds Product l = <*1,2,3*> or Product
  l = <*2,3,1*> or Product l = <*3,1,2*>;

registration
  cluster odd for Permutation of Seg 3;
end;

theorem 
  <*3,2,1*> is odd Permutation of Seg 3;

theorem 
  <*2,1,3*> is odd Permutation of Seg 3;

theorem 
  <*1,3,2*> is odd Permutation of Seg 3;

theorem 
  for p being odd Permutation of Seg 3 holds p = <*3,2,1*> or p = <*1,3,
  2*> or p = <*2,1,3*>;

begin 

theorem 
  for a,b,c,d,e,f,g,h,i being Element of K for M being Matrix of 3,K st
M = <*<*a,b,c*>,<*d,e,f*>,<*g,h,i*>*> holds Det M = a*e*i - c*e*g - a*f*h + b*f
  *g - b*d*i + c*d*h;

theorem 
  for a,b,c,d,e,f,g,h,i being Element of K for M being Matrix of 3,K st
M = <*<*a,b,c*>,<*d,e,f*>,<*g,h,i*>*> holds Per M = a*e*i + c*e*g + a*f*h + b*f
  *g + b*d*i + c*d*h;

theorem 
  for i,n being Element of NAT for p being Element of Permutations
  n st i in Seg n holds ex k being Element of NAT st k in Seg n & i = p.k;

theorem 
  for M being Matrix of n, K st (ex i being Element of NAT st i in
Seg n & for k being Element of NAT st k in Seg n holds Col(M,i).k = 0.K) holds
  for p being Element of Permutations n holds ex l being Element of NAT st l in
  Seg n & Path_matrix (p,M).l = 0.K;

theorem 
  for p being Element of Permutations n for M being Matrix of n, K
  st (ex i being Element of NAT st i in Seg n & for k being Element of NAT st k
  in Seg n holds Col(M,i).k = 0.K) holds (Path_product M).p = 0.K;

theorem 
  for M being Matrix of n, K st (ex i being Element of NAT st i in
Seg n & for k being Element of NAT st k in Seg n holds Col(M,i).k = 0.K) holds
  (the addF of K) $$ (FinOmega Permutations n, Path_product M) = 0.K;

theorem 
  for p being Element of Permutations n for M being Matrix of n, K
st (ex i being Element of NAT st i in Seg n & (for k being Element of NAT st k
  in Seg n holds Col(M,i).k = 0.K)) holds (PPath_product M).p = 0.K;

theorem 
  for M being Matrix of n, K st (ex i being Element of NAT st i in Seg n
& for k being Element of NAT st k in Seg n holds Col(M,i).k = 0.K) holds Det M
  = 0.K;

theorem 
  for M being Matrix of n, K st (ex i being Element of NAT st i in Seg n
& for k being Element of NAT st k in Seg n holds Col(M,i).k = 0.K) holds Per M
  = 0.K;

begin 

theorem 
  for M,N being Matrix of n, K st i in Seg n for p being Element of
Permutations n holds ex k being Element of NAT st k in Seg n & i = p.k & Col(N,
  i)/.k = Path_matrix (p, N)/.k;

theorem 
  for a being Element of K for M,N being Matrix of n, K st (ex i being
Element of NAT st i in Seg n & (for k being Element of NAT st k in Seg n holds
  Col(M,i).k = a * Col(N,i)/.k) & (for l being Element of NAT st l <> i & l in
  Seg n holds Col(M,l) = Col(N,l))) for p being Element of Permutations n holds
  ex l being Element of NAT st l in Seg n & Path_matrix (p,M)/.l = a * (
  Path_matrix (p,N)/.l);














begin 

reserve x, y, X for set,
  i, j, k, l, n, m for Nat,
  D for non empty set,
  K for Field,
  a,b for Element of K,
  perm, p, q for Element of Permutations(n),
  Perm,P for Permutation of Seg n,
  F for Function of Seg n,Seg n,
  perm2, p2, q2, pq2 for Element of Permutations(n+2),
  Perm2 for Permutation of Seg (n+2);

notation
  let X be set;
  synonym 2Set(X) for TWOELEMENTSETS(X);
end;

theorem 
  X in 2Set Seg n iff ex i,j st i in Seg n & j in Seg n & i < j & X = {i,j};

theorem 
  2Set Seg 0 = {} & 2Set Seg 1 = {};

theorem 
  for n st n >= 2 holds {1,2} in 2Set Seg n;

registration
  let n;
  cluster 2Set Seg(n+2) -> non empty finite;
end;

registration
  let n, x;
  let perm be Element of Permutations(n);
  cluster perm.x -> natural;
end;

registration
  let K;
  cluster the multF of K -> having_a_unity;
  cluster the multF of K -> associative;
end;





definition
  let n,K;
  let perm2 be Element of Permutations(n+2);
  func Part_sgn(perm2,K) -> Function of 2Set Seg (n+2),the carrier of K means


  for i,j be Element of NAT st i in Seg (n+2)& j in Seg (n+2) & i < j
holds ( perm2.i < perm2.j implies it.{i,j}= 1_K ) & ( perm2.i > perm2.j implies
  it.{i,j}=-1_K );
end;

theorem 
  for X be Element of Fin 2Set Seg (n+2) st for x st x in X holds
  Part_sgn(p2,K).x = 1_K holds (the multF of K) $$ (X,Part_sgn(p2,K)) = 1_K;

reserve s for Element of 2Set Seg (n+2);

theorem 
  Part_sgn(p2,K).s = 1_K or Part_sgn(p2,K).s = -1_K;

theorem 
  for i,j st i in Seg (n+2) & j in Seg (n+2) & i < j & p2.i = q2.i
  & p2.j = q2.j holds Part_sgn(p2,K).{i,j} = Part_sgn(q2,K).{i,j};

theorem 
  for X be Element of Fin 2Set Seg (n+2),p2,q2 for F be finite set
st F={s:s in X & Part_sgn(p2,K).s <> Part_sgn(q2,K).s} holds (card F mod 2 = 0
  implies (the multF of K) $$ (X,Part_sgn(p2,K)) = (the multF of K) $$ (X,
Part_sgn(q2,K)) ) & (card F mod 2 = 1 implies (the multF of K) $$ (X,Part_sgn(
  p2,K)) = -(the multF of K) $$ (X,Part_sgn(q2,K)) );

theorem 
  for P be Permutation of Seg n st P is being_transposition for i,j
st i < j holds P.i = j iff i in dom P & j in dom P & P.i=j & P.j=i & for k st k
  <> i & k <> j & k in dom P holds P.k = k;

theorem 
  for p2,q2,pq2,i,j st pq2 = p2*q2 & q2 is being_transposition & q2
.i = j & i < j for s st Part_sgn(p2,K).s <> Part_sgn(pq2,K).s holds i in s or j
  in s;

theorem 
  for p2,q2,pq2,i,j,K st pq2 = p2*q2 & q2 is being_transposition &
q2.i = j & i < j & 1_K <> -1_K holds Part_sgn(p2,K).{i,j} <> Part_sgn(pq2,K).{i
  ,j} & for k st k in Seg(n+2) & i <> k & j <> k holds Part_sgn(p2,K).{i,k} <>
  Part_sgn(pq2,K).{i,k} iff Part_sgn(p2,K).{j,k} <> Part_sgn(pq2,K).{j,k};





definition
  let n,K;
  let perm2 be Element of Permutations(n+2);
  func sgn(perm2,K) -> Element of K equals

  (the multF of K) $$ (FinOmega(2Set
  Seg (n+2)),Part_sgn(perm2,K));
end;

theorem 
  sgn(p2,K) = 1_K or sgn(p2,K) = -1_K;

theorem 
  for Id be Element of Permutations(n+2) st Id = idseq (n+2) holds
  sgn(Id,K) = 1_K;

theorem 
  for p2,q2,pq2 st pq2 = p2*q2 & q2 is being_transposition holds
  sgn(pq2,K) = -sgn(p2,K);





theorem 
  for tr be Element of Permutations(n+2) st tr is
  being_transposition holds sgn(tr,K) = -1_K;

theorem 
  for P be FinSequence of Group_of_Perm(n+2), p2 be Element of
Permutations(n+2) st p2 = Product P & (for i st i in dom P ex trans be Element
of Permutations(n+2) st P.i = trans & trans is being_transposition) holds (len
  P mod 2=0 implies sgn(p2,K) = 1_K) & (len P mod 2=1 implies sgn(p2,K) = -1_K)
;

theorem 
  for i,j,n st i < j & i in Seg n & j in Seg n ex tr be Element of
  Permutations(n) st tr is being_transposition & tr.i = j;

theorem 
  for p be Element of Permutations(k+1) st p.(k+1) <> k+1 ex tr be
Element of Permutations(k+1) st tr is being_transposition & tr.(p.(k+1)) = k+1
  & (tr*p).(k+1) = k+1;

theorem 
  for X,x st not x in X for p1 be Permutation of X\/{x} st p1.x =
  x ex p be Permutation of X st p1|X = p;

theorem 
  for p,q be (Permutation of X),p1,q1 be Permutation of X\/{x} st
p1|X = p & q1|X = q & p1.x = x & q1.x = x holds (p1*q1) |X = p*q &
(p1*q1).x = x;

theorem 
  for tr be Element of Permutations(k) st tr is
  being_transposition holds tr*tr = idseq k & tr = tr";







theorem 
  for perm ex P be FinSequence of Group_of_Perm(n) st perm=Product
P & for i st i in dom P ex trans be Element of Permutations(n) st P.i = trans &
  trans is being_transposition;

theorem 
  K is Fanoian iff 1_K <> -1_K;






theorem 
  for K be Fanoian Field holds ( perm2 is even iff sgn(perm2,K) =
  1_K )& ( perm2 is odd iff sgn(perm2,K) = -1_K );






theorem 
  for p2,q2,pq2 st pq2 = p2*q2 holds sgn(pq2,K) = sgn(p2,K)*sgn(q2 ,K);

theorem 
  p is even & q is even or p is odd & q is odd iff p*q is even;

theorem 
  -(a,perm2) = sgn(perm2,K)*a;

theorem 
  for tr be Element of Permutations(n+2) st tr is
  being_transposition holds tr is odd;

registration
  let n;
  cluster odd for Permutation of Seg (n+2);
end;

begin 

reserve pD for FinSequence of D,
  M for Matrix of n,m,D,
  pK,qK for FinSequence of K,
  A for Matrix of n,K;

definition
  let l, n, m, D;
  let M be Matrix of n,m,D;
  let pD be FinSequence of D;
  func ReplaceLine(M,l,pD) -> Matrix of n,m,D means


  len it = len M &
width it = width M & for i,j st [i,j] in Indices M holds (i <> l implies it*(i,
  j) = M*(i,j)) & (i = l implies it*(l,j) = pD.j) if len pD = width M otherwise
  it = M;
end;

notation
  let l, n, m, D;
  let M be Matrix of n,m,D;
  let pD be FinSequence of D;
  synonym RLine(M,l,pD) for ReplaceLine(M,l,pD);
end;

theorem 
  for l,M,pD,i st i in Seg n holds (i = l & len pD = width M
  implies Line(RLine(M,l,pD),i) = pD) & (i <> l implies Line(RLine(M,l,pD),i) =
  Line(M,i));

theorem 
  for M,pD st len pD=width M for p9 be Element of D* st pD = p9 holds
  RLine(M,l,pD) = Replace(M,l,p9);

theorem 
  M = RLine(M,l,Line(M,l));

theorem 
  for l,pK,qK,perm st l in Seg n & len pK = n & len qK = n for M
be Matrix of n,K holds (the multF of K) $$ Path_matrix(perm,RLine(M,l,a * pK +
  b * qK)) = a * ((the multF of K) $$ Path_matrix(perm,RLine(M,l,pK))) + b * ((
  the multF of K) $$ Path_matrix(perm,RLine(M,l,qK)));

theorem 
  for l,pK,qK,perm st l in Seg n & len pK = n & len qK = n for M
  be Matrix of n,K holds (Path_product(RLine(M,l,a*pK+b*qK))).perm = a*(
  Path_product(RLine(M,l,pK))).perm + b*(Path_product(RLine(M,l,qK))).perm;






theorem 
  for l, pK, qK st l in Seg n & len pK = n & len qK = n for M be
  Matrix of n,K holds Det(RLine(M,l,a*pK+b*qK)) = a*Det(RLine(M,l,pK)) + b*Det(
  RLine(M,l,qK));

theorem 
  l in Seg n & len pK = n implies Det(RLine(A,l,a*pK)) = a*Det( RLine(A,l,pK));

theorem 
  l in Seg n implies Det(RLine(A,l,a*Line(A,l))) = a*Det(A);

theorem 
  l in Seg n & len pK = n & len qK = n implies Det(RLine(A,l,pK+qK
  )) = Det(RLine(A,l,pK)) + Det(RLine(A,l,qK));

begin 
      

definition
  let n, m, D;
  let F be Function of Seg n,Seg n;
  let M be Matrix of n,m,D;
  redefine func M*F -> Matrix of n,m,D means


  len it = len M & width it
= width M & for i,j,k st [i,j] in Indices M & F.i = k holds it*(i,j)= M*(k,j);
end;

theorem 
  Indices M = Indices (M*F) & for i,j st [i,j] in Indices M ex k
  st F.i = k & [k,j] in Indices M & (M*F)*(i,j) = M*(k,j);

theorem 
  for M be Matrix of n,m,D,F for k st k in Seg n holds Line(M*F,k) = M.(F.k);

theorem 
  M*(idseq n) = M;

theorem 
  for p,Perm,q st q = p*Perm" holds Path_matrix(p,A*Perm) = (
  Path_matrix(q,A))*Perm;

theorem 
  for p,Perm,q st q=p*Perm" holds (the multF of K) $$ (Path_matrix
  (p,A*Perm)) = (the multF of K) $$ (Path_matrix(q,A));

theorem 
  for p2,q2 st q2 = p2" holds sgn(p2,K) = sgn(q2,K);

theorem 
  for M be (Matrix of n+2,K),perm2,Perm2 st perm2=Perm2 for p2,q2
  st q2 = p2*Perm2" holds (Path_product(M)).q2 = sgn(perm2,K)*(Path_product(M*
  Perm2)).p2;

theorem 
  for perm ex P be Permutation of Permutations(n) st for p be
  Element of Permutations(n) holds P.p = p*perm;

theorem 
  for M be Matrix of n+2,n+2,K, perm2,Perm2 st perm2=Perm2 holds
  Det(M*Perm2) = sgn(perm2,K)*Det(M);






theorem 
  for M be (Matrix of n,K),perm,Perm st perm = Perm holds Det(M*
  Perm) = -(Det(M),perm);

theorem 
  for PERM be Permutation of Permutations(n), perm st perm is odd
  & for p holds PERM.p = p*perm holds PERM.:{p:p is even} = {q:q is odd};

theorem 
  for n st n >= 2 ex ODD,EVEN be finite set st EVEN ={p:p is even} & ODD
= {q:q is odd} & EVEN /\ ODD = {} & EVEN \/ ODD =Permutations(n) & card EVEN =
  card ODD;

theorem 
  for i,j st i in Seg n & j in Seg n & i < j for M be (Matrix of n
,K) st Line(M,i) = Line(M,j) for p,q,tr be Element of Permutations(n) st q = p*
  tr & tr is being_transposition & tr.i=j holds (Path_product M).q = - (
  Path_product M).p;






theorem 
  for i,j st i in Seg n & j in Seg n & i < j for M be (Matrix of n
  ,K) st Line(M,i) = Line(M,j) holds Det(M) = 0.K;

theorem 
  for i, j st i in Seg n & j in Seg n & i <> j holds Det RLine(A,i
  ,Line(A,j)) = 0.K;

theorem 
  for i, j st i in Seg n & j in Seg n & i <> j holds Det RLine(A,i
  ,a*Line(A,j)) = 0.K;

theorem 
  for i, j st i in Seg n & j in Seg n & i <> j holds Det A = Det RLine(A
  ,i,Line(A,i) + a*Line(A,j));

theorem 
  not F in Permutations(n) implies Det(A*F) = 0.K;

begin 

definition
  let K be non empty addLoopStr;
  func addFinS(K) -> BinOp of (the carrier of K)* means


  for p1,p2 be Element of (the carrier of K)* holds it.(p1,p2)=p1+p2;
end;

registration
  let K be Abelian non empty addLoopStr;
  cluster addFinS(K) -> commutative;
end;

registration
  let K be add-associative non empty addLoopStr;
  cluster addFinS(K) -> associative;
end;

theorem 
  for A,B be Matrix of K st width A = len B & len B > 0 for i st i
in Seg len A ex P be FinSequence of (the carrier of K)* st len P = len B & Line
  (A*B,i) = addFinS(K) "**" P & for j st j in Seg len B holds P.j = A*(i,j) *
  Line(B,j);

theorem 
  for A,B,C be (Matrix of n,K), i st i in Seg n ex P be
  FinSequence of K st len P = n & Det RLine(C,i,Line(A*B,i)) = (the addF of K)
  "**" P & for j st j in Seg n holds P.j = A*(i,j) * Det RLine(C,i,Line(B,j));

theorem 
  for X being set,Y being non empty set, x st not x in X ex BIJECT
be Function of [:Funcs(X,Y),Y:],Funcs(X\/{x},Y) st BIJECT is bijective & for f
  be Function of X,Y,F be Function of X\/{x},Y st F|X=f holds BIJECT.(f,F.x)=F;

theorem 
  for X being finite set, Y being non empty finite set, x st not x
  in X for F being BinOp of D st F is having_a_unity & F is commutative & F is
associative for f being Function of Funcs(X,Y),D for g being Function of Funcs(
  X\/{x},Y),D st for H be Function of X,Y, SF be Element of Fin Funcs(X\/{x},Y)
st SF={h where h is Function of X\/{x},Y: h|X = H} holds F $$ (SF,g)=f.H holds
  F $$ (FinOmega(Funcs(X,Y)),f) = F $$ (FinOmega(Funcs(X\/{x},Y)),g);

theorem 
  for A,B be Matrix of n,m,D, i st i <= n & 0 < n for F be
Function of Seg i, Seg n ex M be Matrix of n,m,D st
M = A +* ((B*(idseq n+*F)) | Seg i) &
for j holds (j in Seg i implies M.j = B.(F.j)) & (not j in Seg i
  implies M.j = A.j);

theorem 
  for A,B be Matrix of n,K st 0 < n ex P be Function of Funcs(Seg
  n,Seg n),the carrier of K st ( for F be Function of Seg n,Seg n ex Path be
  FinSequence of K st len Path = n & (for Fj,j be Nat st j in Seg n & Fj = F.j
holds Path.j = A*(j,Fj))& P.F= (the multF of K) $$ Path * Det (B*F) ) & Det(A*B
  ) = (the addF of K) $$ (FinOmega(Funcs(Seg n,Seg n)),P);

theorem 
  for A,B be Matrix of n,K st 0 < n ex P be Function of
  Permutations n,the carrier of K st Det(A*B) = (the addF of K) $$ (FinOmega(
  Permutations n),P) & for perm be Element of Permutations n holds P.perm= (the
  multF of K) $$ Path_matrix(perm,A) * -(Det B,perm);






theorem 
  for A,B be Matrix of n,K st 0 < n holds Det (A * B) = Det A * Det B;














begin

reserve a,b for Element of REAL,
  i,j,n for Nat,
  M,M1,M2,M3,M4 for Matrix of n, REAL;

definition
  let M be Matrix of REAL;
  attr M is Positive means


  for i,j st [i,j] in Indices M holds M*(i,j) > 0;
  attr M is Negative means


  for i,j st [i,j] in Indices M holds M*(i,j) < 0;
  attr M is Nonpositive means


  for i,j st [i,j] in Indices M holds M*(i, j) <= 0;
  attr M is Nonnegative means


  for i,j st [i,j] in Indices M holds M*(i, j) >= 0;
end;

definition
  let M1,M2 be Matrix of REAL;
  pred M1 is_less_than M2 means


  for i,j st [i,j] in Indices M1 holds M1 *(i,j) < M2*(i,j);
  pred M1 is_less_or_equal_with M2 means


  for i,j st [i,j] in Indices M1 holds M1*(i,j) <= M2*(i,j);
end;

definition
  let M be Matrix of REAL;
  func |:M:| -> Matrix of REAL means


  len it = len M & width it = width
  M & for i,j holds [i,j] in Indices M implies it*(i,j) = abs(M*(i,j));
end;

definition
  let n;
  let M;
  redefine func -M -> Matrix of n,REAL;
end;

definition
  let n;
  let M1,M2;
  redefine func M1+M2 -> Matrix of n,REAL;
end;

definition
  let n;
  let M1,M2;
  redefine func M1-M2 -> Matrix of n,REAL;
end;

definition
  let n;
  let a be Element of REAL;
  let M;
  redefine func a*M -> Matrix of n,REAL;
end;

registration
  cluster ((1,1) --> 1) -> Positive for Matrix of REAL;
  cluster ((1,1) --> 1) -> Nonnegative for Matrix of REAL;
  cluster ((1,1) --> -1) -> Negative for Matrix of REAL;
  cluster ((1,1) --> -1) -> Nonpositive for Matrix of REAL;
end;

registration
  cluster Positive Nonnegative for Matrix of REAL;
  cluster Negative Nonpositive for Matrix of REAL;
end;

registration
  let M be Positive Matrix of REAL;
  cluster M@ -> Positive;
end;

registration
  let M be Negative Matrix of REAL;
  cluster M@ -> Negative;
end;

registration
  let M be Nonpositive Matrix of REAL;
  cluster M@ -> Nonpositive;
end;

registration
  let M be Nonnegative Matrix of REAL;
  cluster M@ -> Nonnegative;
end;

registration
  let n;
  cluster ((n,n) --> 1) -> Positive for Matrix of n,REAL;
  cluster ((n,n) --> -1) -> Negative for Matrix of n,REAL;
  cluster ((n,n) --> -1) -> Nonpositive for Matrix of n,REAL;
  cluster ((n,n) --> 1) -> Nonnegative for Matrix of n,REAL;
end;

registration
  let n;
  cluster Positive Nonnegative for Matrix of n,REAL;
  cluster Negative Nonpositive for Matrix of n,REAL;
end;

theorem 
  for x1 be Element of F_Real for x2 be Real st x1 = x2 holds -x1=-x2;

theorem 
  for M being Matrix of REAL st [i,j] in Indices M holds (-M)*(i,j) =-(M*(i,j))
;

theorem 
  for M1,M2 be Matrix of REAL st len M1=len M2 & width M1=width M2
  & [i,j] in Indices M1 holds (M1-M2)*(i,j)=(M1*(i,j)) - (M2*(i,j));

theorem 
  for M being Matrix of REAL st [i,j] in Indices M holds (a*M)*(i,j
  )=a*(M*(i,j));

theorem 
  Indices M = Indices |:M:|;

theorem 
  |:a*M:|=abs(a)*|:M:|;

theorem 
  M is Negative implies -M is Positive;

theorem 
  M1 is Positive & M2 is Positive implies M1+M2 is Positive;

theorem 
  -M2 is_less_than M1 implies M1+M2 is Positive;

theorem 
  M1 is Nonnegative & M2 is Positive implies M1+M2 is Positive;

theorem 
  M1 is Positive & M2 is Negative & |:M2:| is_less_than |:M1:| implies
  M1+M2 is Positive;

theorem 
  M1 is Positive & M2 is Negative implies M1-M2 is Positive;

theorem 
  M2 is_less_than M1 implies M1-M2 is Positive;

theorem 
  a>0 & M is Positive implies a*M is Positive;

theorem 
  a<0 & M is Negative implies a*M is Positive;

theorem 
  M is Positive implies (-M) is Negative;

theorem 
  M1 is Negative & M2 is Negative implies M1+M2 is Negative;

theorem 
  M1 is_less_than -M2 implies M1+M2 is Negative;

theorem 
  M1 is Positive & M2 is Negative & |:M1:| is_less_than |:M2:| implies
  M1+M2 is Negative;

theorem 
  M1 is_less_than M2 implies M1-M2 is Negative;

theorem 
  M1 is Positive & M2 is Negative implies M2-M1 is Negative;

theorem 
  a<0 & M is Positive implies a*M is Negative;

theorem 
  a>0 & M is Negative implies a*M is Negative;

theorem 
  M is Nonnegative implies -M is Nonpositive;

theorem 
  M is Negative implies M is Nonpositive;

theorem 
  M1 is Nonpositive & M2 is Nonpositive implies M1+M2 is Nonpositive;

theorem 
  M1 is_less_or_equal_with -M2 implies M1+M2 is Nonpositive;

theorem 
  M1 is_less_or_equal_with M2 implies M1-M2 is Nonpositive;

theorem 
  a<=0 & M is Positive implies a*M is Nonpositive;

theorem 
  a>=0 & M is Negative implies a*M is Nonpositive;

theorem 
  a>=0 & M is Nonpositive implies a*M is Nonpositive;

theorem 
  a<=0 & M is Nonnegative implies a*M is Nonpositive;

theorem 
  |:M:| is Nonnegative;

theorem 
  M1 is Positive implies M1 is Nonnegative;

theorem 
  M is Nonpositive implies (-M) is Nonnegative;

theorem 
  M1 is Nonnegative & M2 is Nonnegative implies M1+M2 is Nonnegative;

theorem 
  -M1 is_less_or_equal_with M2 implies M1+M2 is Nonnegative;

theorem 
  M2 is_less_or_equal_with M1 implies M1-M2 is Nonnegative;

theorem 
  a>=0 & M is Positive implies a*M is Nonnegative;

theorem 
  a<=0 & M is Negative implies a*M is Nonnegative;

theorem 
  a<=0 & M is Nonpositive implies a*M is Nonnegative;

theorem 
  a>=0 & M is Nonnegative implies a*M is Nonnegative;

theorem 
  a>=0 & b>=0 & M1 is Nonnegative & M2 is Nonnegative implies a*M1+b*M2
  is Nonnegative;

begin

theorem 
  M1 is_less_than M2 implies M1 is_less_or_equal_with M2;

theorem 
  M1 is_less_than M2 & M2 is_less_than M3 implies M1 is_less_than M3;

theorem 
  M1 is_less_than M2 & M3 is_less_than M4 implies (M1+M3) is_less_than ( M2+M4)
;

theorem 
  M1 is_less_than M2 implies M1+M3 is_less_than M2+M3;

theorem 
  M1 is_less_than M2 implies M3-M2 is_less_than M3-M1;

theorem 
  |:M1+M2:| is_less_or_equal_with |:M1:|+|:M2:|;

theorem 
  M1 is_less_or_equal_with M2 implies (M1-M3) is_less_or_equal_with (M2- M3);

theorem 
  (M1-M3) is_less_or_equal_with (M2-M3) implies M1 is_less_or_equal_with M2;

theorem 
  M1 is_less_or_equal_with M2-M3 implies M3 is_less_or_equal_with M2-M1;

theorem 
  M1-M2 is_less_or_equal_with M3 implies M1-M3 is_less_or_equal_with M2;

theorem 
  M1 is_less_than M2 & M3 is_less_or_equal_with M4 implies M1-M4
  is_less_than M2-M3;

theorem 
  M1 is_less_or_equal_with M2 & M3 is_less_than M4 implies M1-M4
  is_less_than M2-M3;

theorem 
  M1-M2 is_less_or_equal_with M3-M4 implies M1-M3 is_less_or_equal_with M2-M4;

theorem 
  M1-M2 is_less_or_equal_with M3-M4 implies M4-M2 is_less_or_equal_with M3-M1;

theorem 
  M1-M2 is_less_or_equal_with M3-M4 implies M4-M3 is_less_or_equal_with M2-M1;

theorem 
  M1+M2 is_less_or_equal_with M3 implies M1 is_less_or_equal_with M3-M2;

theorem 
  M1+M2 is_less_or_equal_with M3+M4 implies M1-M3 is_less_or_equal_with M4-M2;

theorem 
  M1+M2 is_less_or_equal_with M3-M4 implies M1+M4 is_less_or_equal_with M3-M2;

theorem 
  M1-M2 is_less_or_equal_with M3+M4 implies M1-M4 is_less_or_equal_with M3+M2;

theorem 
  M1 is_less_or_equal_with M2 implies -M2 is_less_or_equal_with -M1;

theorem 
  M1 is_less_or_equal_with -M2 implies M2 is_less_or_equal_with -M1;

theorem 
  -M2 is_less_or_equal_with M1 implies -M1 is_less_or_equal_with M2;

theorem 
  M1 is Positive implies M2 is_less_than M2+M1;

theorem 
  M1 is Negative implies M1+M2 is_less_than M2;

theorem 
  M1 is Nonnegative implies M2 is_less_or_equal_with M1+M2;

theorem 
  M1 is Nonpositive implies M1+M2 is_less_or_equal_with M2;

theorem 
  M1 is Nonpositive & M3 is_less_or_equal_with M2 implies M3+M1
  is_less_or_equal_with M2;

theorem 
  M1 is Nonpositive & M3 is_less_than M2 implies M3+M1 is_less_than M2;

theorem 
  M1 is Negative & M3 is_less_or_equal_with M2 implies M3+M1 is_less_than M2;

theorem 
  M1 is Nonnegative & M2 is_less_or_equal_with M3 implies M2
  is_less_or_equal_with M1+M3;

theorem 
  M1 is Positive & M2 is_less_or_equal_with M3 implies M2 is_less_than M1+M3;

theorem 
  M1 is Nonnegative & M2 is_less_than M3 implies M2 is_less_than M1+M3;

theorem 
  M1 is Nonnegative implies M2-M1 is_less_or_equal_with M2;

theorem 
  M1 is Positive implies M2-M1 is_less_than M2;

theorem 
  M1 is Nonpositive implies M2 is_less_or_equal_with M2-M1;

theorem 
  M1 is Negative implies M2 is_less_than M2-M1;

theorem 
  M1 is_less_or_equal_with M2 implies M2-M1 is Nonnegative;

theorem 
  M1 is Nonnegative & M2 is_less_than M3 implies M2-M1 is_less_than M3;

theorem 
  M1 is Nonpositive & M2 is_less_or_equal_with M3 implies M2
  is_less_or_equal_with M3-M1;

theorem 
  M1 is Nonpositive & M2 is_less_than M3 implies M2 is_less_than M3-M1;

theorem 
  M1 is Negative & M2 is_less_or_equal_with M3 implies M2 is_less_than M3-M1;

theorem 
  M1 is_less_than M2 & a>0 implies a*M1 is_less_than a*M2;

theorem 
  M1 is_less_than M2 & a>=0 implies a*M1 is_less_or_equal_with a*M2;

theorem 
  M1 is_less_than M2 & a<0 implies a*M2 is_less_than a*M1;

theorem 
  M1 is_less_than M2 & a<=0 implies a*M2 is_less_or_equal_with a*M1;

theorem 
  M1 is_less_or_equal_with M2 & a>=0 implies a*M1 is_less_or_equal_with a*M2;

theorem 
  M1 is_less_or_equal_with M2 & a<=0 implies a*M2 is_less_or_equal_with a*M1;

theorem 
  a>=0 & a<=b & M1 is Nonnegative & M1 is_less_or_equal_with M2 implies
  a*M1 is_less_or_equal_with b*M2;

theorem 
  a<=0 & b<=a & M1 is Nonpositive & M2 is_less_or_equal_with M1 implies
  a*M1 is_less_or_equal_with b*M2;

theorem 
  a<0 & b<=a & M1 is Negative & M2 is_less_than M1 implies a*M1
  is_less_than b*M2;

theorem 
  a>=0 & a<b & M1 is Nonnegative & M1 is_less_than M2 implies a*M1
  is_less_than b*M2;

theorem 
  a>=0 & a<b & M1 is Positive & M1 is_less_or_equal_with M2 implies a*M1
  is_less_than b*M2;

theorem 
  a>0 & a<=b & M1 is Positive & M1 is_less_than M2 implies a*M1
  is_less_than b*M2;














begin 

reserve x for set,
  D for non empty set,
  k,n,m,i,j,l for Element of NAT ,
  K for Field;

theorem 
  for x,y being FinSequence of REAL st len x=len y & x+y=0*(len x)
  holds x=-y & y=-x;

theorem 
  for A being Matrix of D for p being FinSequence of D st p=A.i & 1
  <=i & i<=len A & 1<=j & j<=width A & len p=width A holds A*(i,j)=p.j;

theorem 
  for a being real number, A being Matrix of REAL st [i,j] in
  Indices A holds (a*A)*(i,j) = a*(A*(i,j));

theorem 
  for A,B being Matrix of n,REAL holds len (A*B)=len A & width (A*B
  )=width B & len (A*B)=n & width (A*B)=n;

theorem 
  for a being real number,A being Matrix of REAL holds len (a*A)=
  len A & width (a*A)=width A;

begin 

theorem 
  for A,B being Matrix of REAL st len A=len B & width A=width B
holds len (A-B) = len A & width (A-B)=width A & for i,j holds [i,j] in Indices
  A implies (A-B)*(i,j) = A*(i,j) - B*(i,j);

definition
  let n;
  let A,B be Matrix of n,REAL;
  redefine func A*B -> Matrix of n,REAL;
end;

theorem 
  for A,B being Matrix of REAL st len A=len B & width A=width B &
  len A>0 holds A + (B - B) = A;

theorem 
  for A,B being Matrix of REAL st len A=len B & width A=width B & len A>
  0 holds A + B - B = A;

theorem 
  for A being Matrix of REAL holds (-1)*A = -A;

theorem 
  for A being (Matrix of REAL), i,j being Element of NAT st [i,j]
  in Indices A holds (-A)*(i,j)=-(A*(i,j));

theorem 
  for a,b being Real,A being Matrix of REAL holds (a*b)*A=a*(b*A);

theorem 
  for a,b being Real,A being Matrix of REAL holds (a+b)*A=a*A + b* A;

theorem 
  for a,b being Real,A being Matrix of REAL holds (a-b)*A=a*A - b*A;

theorem 
  for A being Matrix of K st n>0 & len A >0 holds 0.(K,n,len A)*A=
  0.(K,n,width A);

theorem 
  for A,C being Matrix of K st len A=width C & len C>0 & len A>0
  holds (-C)*A = -(C*A);

theorem 
  for A,B,C being Matrix of K st len B=len C & width B=width C &
  len A=width B & len B>0 & len A>0 holds (B-C)*A = B*A -C*A;

theorem 
  for A,B,C being Matrix of REAL st len A=len B & width A=width B & len
  C=width A & len A>0 & len C>0 holds (A-B)*C=A*C - B*C;

theorem 
  for m being Element of NAT,A,C being Matrix of K st width A>0 &
  len A >0 holds A*(0.(K,width A,m)) = 0.(K,len A,m);

theorem 
  for A,C being Matrix of K st width A=len C & len A>0 & len C>0
  holds A*(-C) = -(A*C);

theorem 
  for A,B,C being Matrix of K st len B=len C & width B=width C &
  len B=width A & len B>0 & len A>0 holds A*(B-C) = A*B -A*C;

theorem 
  for A,B,C being Matrix of REAL st len A=len B & width A=width B &
  width C=len A & len C>0 & len A>0 holds C*(A-B)=C*A -C*B;

theorem 
  for A,B,C being Matrix of REAL st len A=len B & width A=width B
& len C = len A & width C = width A & (for i,j being Element of NAT st [i,j] in
  Indices A holds C*(i,j) = A*(i,j) - B*(i,j)) holds C=A-B;

theorem 
  for x1,x2 being FinSequence of REAL st len x1=len x2 holds
  LineVec2Mx (x1-x2)=LineVec2Mx (x1)-LineVec2Mx (x2);

theorem 
  for x1,x2 being FinSequence of REAL st len x1=len x2 & len x1>0
  holds ColVec2Mx (x1-x2)=ColVec2Mx (x1)-ColVec2Mx (x2);

theorem 
  for A,B being Matrix of REAL st len A=len B & width A=width B
holds for i being Nat st 1<=i & i<=len A holds Line(A-B,i)=Line(A,i)-Line(B,i);

theorem 
  for A,B being Matrix of REAL st len A=len B & width A=width B
  holds for i being Nat st 1<=i & i<=width A holds Col(A-B,i)=Col(A,i)-Col(B,i)
;

theorem 
  for A being Matrix of n,k,REAL, B being Matrix of k,m,REAL,C being
  Matrix of m,l,REAL st n>0 & k>0 & m>0 holds A*B*C=A*(B*C);

theorem 
  for A,B,C being Matrix of n,REAL holds A*B*C=A*(B*C);

theorem 
  for A being Matrix of n,D holds (A@)@=A;

theorem 
  for A,B being Matrix of n,REAL holds (A*B)@ = (B@)*(A@);

theorem 
  for A being Matrix of REAL st len A=n & width A=m holds -A+A= 0_Rmatrix(n,m);

begin 

definition
  let n;
  let A be Matrix of n,REAL;
  redefine func MXR2MXF A -> Matrix of n,F_Real;
end;

definition
  let n;
  let A be Matrix of n,REAL;
  func Det A -> Real equals

  Det MXR2MXF A;
end;

theorem 
  for A being Matrix of 2,REAL holds Det A = (A*(1,1))*(A*(2,2))-(A*(1,2
  ))*(A*(2,1));

theorem 
  for s1,s2,s3 be FinSequence st len s1 = n & len s2 = n & len s3
  = n holds <*s1,s2,s3*> is tabular;

theorem 
  for p1,p2,p3 being FinSequence of D st len p1 = n & len p2 = n &
  len p3 = n holds <*p1,p2,p3*> is Matrix of 3,n,D;

theorem 
  for a1,a2,a3,b1,b2,b3,c1,c2,c3 being Element of D holds <*<*a1,
  a2,a3*>,<*b1,b2,b3*>,<*c1,c2,c3*>*> is Matrix of 3,D;

theorem 
  for A being Matrix of n,D for p being FinSequence of D, i being
  Nat st p=A.i & i in Seg n holds len p=n;

theorem 
  for A being Matrix of 3,D holds A=<* <* A*(1,1), A*(1,2), A*(1,3
  ) *>, <* A*(2,1), A*(2,2), A*(2,3) *>, <* A*(3,1), A*(3,2), A*(3,3) *> *>;

theorem 
  for A being Matrix of 3,REAL holds Det A = (A*(1,1))*(A*(2,2))*(A*(3,3
))-(A*(1,3))*(A*(2,2))*(A*(3,1)) -(A*(1,1))*(A*(2,3))*(A*(3,2))+(A*(1,2))*(A*(2
  ,3))*(A*(3,1)) -(A*(1,2))*(A*(2,1))*(A*(3,3))+(A*(1,3))*(A*(2,1))*(A*(3,2));

theorem 
  for f being Permutation of Seg 0 holds f=<*>NAT;

theorem 
  Permutations 0 = {<*>NAT};

theorem 
  for A being Matrix of 0,K holds Det A = 1.K;

theorem 
  for A being Matrix of 0,REAL holds Det A = 1;



theorem 
  for n being Nat, A being Matrix of n,K holds Det A = Det (A@);

theorem 
  for A being Matrix of n,REAL holds Det A = Det (A@);



theorem 
  for A,B being Matrix of n,K holds Det(A*B) = (Det A)*(Det B);

theorem 
  for A,B being Matrix of n,REAL holds Det (A*B) = (Det A)*(Det B);

begin 

theorem 
  for x,y being FinSequence of REAL, A being Matrix of REAL st len x=len
  A & len y=len x & len x>0 holds (x-y)*A=x*A - y*A;

theorem 
  for x,y being FinSequence of REAL,A being Matrix of REAL st len x=
  width A & len y=len x & len x >0 & len A >0 holds A*(x-y)=A*x - A*y;

theorem 
  for x being FinSequence of REAL, A being Matrix of REAL st len A=len x
  & len x>0 & width A>0 holds (-x)*A=-(x*A);

theorem 
  for x being FinSequence of REAL,A being Matrix of REAL st len x=width
  A & len x > 0 holds A*(-x)=-(A*x);

theorem 
  for x being FinSequence of REAL,A being Matrix of REAL st len x=len A
  & len x>0 holds x*(-A)=-(x*A);

theorem 
  for x being FinSequence of REAL,A being Matrix of REAL st len x=width
  A & len A>0 & len x> 0 holds (-A)*x=-(A*x);

theorem 
  for a being Real,x being FinSequence of REAL,A being Matrix of REAL st
  width A=len x & len x>0 holds A*(a*x)=a*(A*x);

theorem 
  for x being FinSequence of REAL, A,B being Matrix of REAL st len x=len
  A & len A=len B & width A=width B & len A >0 holds x*(A-B)=(x*A) - (x*B);

theorem 
  for x being FinSequence of REAL, A,B being Matrix of REAL st len x=
width A & len A=len B & width A=width B & len x>0 & len A >0 holds (A-B)*x=A*x
  - B*x;

theorem 
  for x being FinSequence of REAL,A being Matrix of REAL st len A=
  len x holds (LineVec2Mx x)*A=LineVec2Mx (x*A);

theorem 
  for x being FinSequence of REAL, A,B being Matrix of REAL st len
  x=len A & width A=len B holds x*(A*B)=(x*A)*B;

theorem 
  for x being FinSequence of REAL,A being Matrix of REAL st width
  A=len x & len x>0 & len A>0 holds A*(ColVec2Mx x)=ColVec2Mx (A*x);

theorem 
  for x being FinSequence of REAL, A,B being Matrix of REAL st len
  x=width B & width A=len B & len x >0 & len B>0 holds (A*B)*x=A*(B*x);

theorem 
  for B being (Matrix of n,m,REAL),A being (Matrix of m,k,REAL) st n>0
  holds (for i,j st [i,j] in Indices (B*A) holds (B*A)*(i,j)=((Line(B,i))*A).j)
;

theorem 
  for A, B being Matrix of n,REAL holds for i,j st [i,j] in
  Indices (B*A) holds (B*A)*(i,j)=((Line(B,i))*A).j;

theorem 
  for A, B being Matrix of n,REAL st n>0 holds for i,j st [i,j] in
  Indices (A*B) holds (A*B)*(i,j)=(A*(Col(B,j))).i;

begin 

definition
  let n be Element of NAT;
  func 1_Rmatrix(n) -> Matrix of n,REAL equals

  MXF2MXR (1.(F_Real,n));
end;

theorem 
  (for i st [i,i] in Indices 1_Rmatrix n holds (1_Rmatrix n)*(i,i)
= 1) & for i,j st [i,j] in Indices (1_Rmatrix n) & i <> j holds (1_Rmatrix n)*(
  i,j) = 0;

theorem 
  (1_Rmatrix(n))@=1_Rmatrix(n);

theorem 
  for n,m being Element of NAT st n>0 holds 0_Rmatrix(n,m)+
  0_Rmatrix(n,m)=0_Rmatrix(n,m);

theorem 
  for a being Real st n>0 holds a*(0_Rmatrix(n,m)) = 0_Rmatrix(n,m);

theorem 
  for K being Field, A being Matrix of K holds A*(1.(K,width A))=A;

theorem 
  for A being Matrix of K holds (1.(K,len A))*A=A;

theorem 
  for A being Matrix of REAL holds (n=width A implies A*(1_Rmatrix n)=A)
  & (m=len A implies (1_Rmatrix m)*A=A);

theorem 
  for A being Matrix of n,REAL holds (1_Rmatrix n)*A=A;

theorem 
  for A be Matrix of n,REAL holds A*(1_Rmatrix(n))=A;

theorem 
  Det 1_Rmatrix n=1;

definition
  let n be Element of NAT;
  func 0_Rmatrix(n) -> Matrix of n,REAL equals

  0_Rmatrix(n,n);
end;

theorem 
  n>0 implies Det 0_Rmatrix n = 0;

definition
  let n,i be Nat;
  func Base_FinSeq(n,i) -> FinSequence of REAL equals

  (n |-> 0)+*(i,1);
end;

reserve n,i,j for Nat;

theorem 
  len Base_FinSeq(n,i) = n;

theorem 
  1<=i & i<=n implies (Base_FinSeq(n,i)).i=1;

theorem 
  1<=j & j<=n & i<>j implies (Base_FinSeq(n,i)).j=0;

reserve n for Element of NAT;

theorem 
  Base_FinSeq(1,1)= <* 1 *> & Base_FinSeq(2,1)= <* 1,0 *> & Base_FinSeq(
2,2)= <* 0,1 *> & Base_FinSeq(3,1)= <* 1,0,0 *> & Base_FinSeq(3,2)= <* 0,1,0 *>
  & Base_FinSeq(3,3)= <* 0,0,1 *>;

theorem 
  1<=i & i<=n implies (1_Rmatrix(n)).i=Base_FinSeq(n,i);

begin 

definition
  let n be Element of NAT,A be Matrix of n,REAL;
  attr A is invertible means


  ex B being Matrix of n,REAL st B*A= 1_Rmatrix(n) & A*B=1_Rmatrix(n);
end;

definition
  let n be Element of NAT,A be Matrix of n,REAL;
  assume
 A is invertible;
  func Inv(A) -> Matrix of n,REAL means


  it*A=1_Rmatrix(n) & A*it= 1_Rmatrix(n);
end;

registration
  let n;
  cluster 1_Rmatrix n -> invertible;
end;

theorem 
  Inv(1_Rmatrix(n))=1_Rmatrix(n);

theorem 
  for A,B1,B2 being Matrix of n,REAL st B1*A=1_Rmatrix(n) & A*B2=
  1_Rmatrix(n) holds B1=B2 & A is invertible;

theorem 
  for A being Matrix of n,REAL st A is invertible holds Det Inv A = (Det A)";

theorem 
  for A being Matrix of n,REAL st A is invertible holds Det A <> 0;

theorem 
  for A,B being Matrix of n,REAL st A is invertible & B is invertible
  holds A*B is invertible & Inv(A*B)=Inv(B)*(Inv A);

theorem 
  for A be Matrix of n,REAL st A is invertible holds Inv Inv A = A;

theorem 
  1_Rmatrix(0)=0_Rmatrix(0) & 1_Rmatrix(0)={};

theorem 
  for x being FinSequence of REAL st len x=n & n>0 holds ( 1_Rmatrix n)*x=x;

theorem 
  for n being Element of NAT,x,y being FinSequence of REAL, A be
Matrix of n,REAL st A is invertible & len x=n & len y=n & n>0 holds A*x=y iff x
  =Inv(A)*y;

theorem 
  for x being FinSequence of REAL st len x=n holds x*(1_Rmatrix n) =x;

theorem 
  for x,y being FinSequence of REAL,A be Matrix of n,REAL st A is
  invertible & len x=n & len y=n holds x*A=y iff x=y*Inv(A);

theorem 
  for A being Matrix of n,REAL st n>0 & A is invertible holds for y
  being FinSequence of REAL st len y=n holds ex x being FinSequence of REAL st
  len x=n & A*x=y;

theorem 
  for A being Matrix of n,REAL st A is invertible holds for y being
FinSequence of REAL st len y=n holds ex x being FinSequence of REAL st len x=n
  & x*A=y;

theorem 
  for A being Matrix of n,REAL for x,y being FinSequence of REAL st len
x=n & len y=n & x*A=y holds for j being Element of NAT st 1<=j & j<=n holds y.j
  =|(x,Col(A,j))|;

theorem 
  for A being Matrix of n,REAL st (for y being FinSequence of REAL
st len y=n holds (ex x being FinSequence of REAL st len x=n & x*A=y)) holds ex
  B being Matrix of n,REAL st B*A=1_Rmatrix(n);

theorem 
  for x being FinSequence of REAL, A being Matrix of n,REAL st n>0 & len
  x=n holds (A@)*x = x*A;

theorem 
  for x being FinSequence of REAL, A being Matrix of n,REAL st n>0
  & len x=n holds x*(A@) = A*x;

theorem 
  for A being Matrix of n,REAL st n>0 & (for y being FinSequence
  of REAL st len y=n holds (ex x being FinSequence of REAL st len x=n & A*x=y))
  holds ex B being Matrix of n,REAL st A*B=1_Rmatrix(n);

theorem 
  for A being Matrix of n,REAL st n>0 & (for y being FinSequence of REAL
st len y=n holds (ex x1,x2 being FinSequence of REAL st len x1=n & len x2=n & A
  *x1=y & x2*A=y)) holds A is invertible;














begin

theorem 
  for L being add-associative right_zeroed right_complementable
  associative commutative well-unital distributive almost_left_invertible non
  empty doubleLoopStr for x being Element of L st x <> 0.L holds -(x") = (-x)";

theorem 
  for L being add-associative right_zeroed right_complementable
  associative commutative well-unital almost_left_invertible distributive non
degenerated non empty doubleLoopStr for k being Element of NAT holds power(L)
  .(-1_L,k) <> 0.L;

theorem 
  for L being associative well-unital non empty multLoopStr for x
being Element of L for k1,k2 being Element of NAT holds power(L).(x,k1) * power
  (L).(x,k2) = power(L).(x,k1+k2);

theorem 
  for L being add-associative right_zeroed right_complementable
  well-unital distributive non empty doubleLoopStr for k being Element of NAT
  holds power(L).(-1_L,2*k) = 1_L & power(L).(-1_L,2*k+1) = -1_L;

theorem 
  for z being Element of F_Complex for k being Element of NAT holds
  (power(F_Complex).(z,k))*' = power(F_Complex).(z*',k);

theorem 
  for F,G being FinSequence of F_Complex st len G = len F & for i
being Element of NAT st i in dom G holds G/.i = (F/.i)*' holds Sum G = (Sum F)
  *';

theorem 
  for L being add-associative right_zeroed right_complementable
Abelian non empty addLoopStr, F1,F2 being FinSequence of L st len F1 = len F2
& for i being Element of NAT st i in dom F1 holds F1/.i = -(F2/.i) holds Sum F1
  = - Sum F2;

theorem 
  for L being add-associative right_zeroed right_complementable
  distributive non empty doubleLoopStr for x being Element of L for F being
  FinSequence of L holds x * Sum(F) = Sum(x*F);

begin

theorem 
  for L being add-associative right_zeroed right_complementable
  non empty addLoopStr holds -0_.(L) = 0_.(L);

theorem 
  for L being add-associative right_zeroed right_complementable non
  empty addLoopStr for p being Polynomial of L holds -(-p) = p;

theorem 
  for L being add-associative right_zeroed right_complementable
Abelian distributive non empty doubleLoopStr for p1,p2 being Polynomial of L
  holds -(p1 + p2) = (-p1) + (-p2);

theorem 
  for L being add-associative right_zeroed right_complementable
distributive Abelian non empty doubleLoopStr for p1,p2 being Polynomial of L
  holds -(p1 *' p2) = (-p1) *' p2 & -(p1 *' p2) = p1 *' (-p2);

definition
  let L be add-associative right_zeroed right_complementable distributive non
  empty doubleLoopStr;
  let F be FinSequence of Polynom-Ring(L);
  let i be Element of NAT;
  func Coeff(F,i) -> FinSequence of L means


  len it = len F & for j
being Element of NAT st j in dom it ex p being Polynomial of L st p = F.j & it.
  j = p.i;
end;

theorem 
  for L being add-associative right_zeroed right_complementable
distributive non empty doubleLoopStr for p being Polynomial of L for F being
FinSequence of Polynom-Ring(L) st p = Sum F for i being Element of NAT holds p.
  i = Sum Coeff(F,i);

theorem 
  for L being associative non empty doubleLoopStr for p being
Polynomial of L for x1, x2 being Element of L holds x1 * (x2 * p) = (x1 * x2) *
  p;

theorem 
  for L being add-associative right_zeroed right_complementable
  left-distributive non empty doubleLoopStr for p being Polynomial of L for x
  being Element of L holds - (x * p) = (-x) * p;

theorem 
  for L being add-associative right_zeroed right_complementable
right-distributive non empty doubleLoopStr for p being Polynomial of L for x
  being Element of L holds - (x * p) = x * (-p);

theorem 
  for L being left-distributive non empty doubleLoopStr for p
being Polynomial of L for x1, x2 being Element of L holds (x1 + x2) * p = x1 *
  p + x2 * p;

theorem 
  for L being right-distributive non empty doubleLoopStr for p1,
p2 being Polynomial of L for x being Element of L holds x * (p1 + p2) = (x * p1
  ) + (x * p2);

theorem 
  for L being add-associative right_zeroed right_complementable
distributive commutative associative non empty doubleLoopStr for p1,p2 being
Polynomial of L for x being Element of L holds p1 *' (x * p2) = x * (p1 *' p2);

definition
  let L be non empty ZeroStr;
  let p be Polynomial of L;
  func degree p -> Integer equals

  len p - 1;
end;

notation
  let L be non empty ZeroStr;
  let p be Polynomial of L;
  synonym deg p for degree p;
end;

theorem 
  for L being non empty ZeroStr for p being Polynomial of L holds
  deg p = -1 iff p = 0_.(L);

theorem 
  for L being add-associative right_zeroed right_complementable non
empty addLoopStr for p1,p2 being Polynomial of L st deg p1 <> deg p2 holds deg
  (p1 + p2) = max(deg(p1),deg(p2));

theorem 
  for L being add-associative right_zeroed right_complementable
  Abelian non empty addLoopStr for p1,p2 being Polynomial of L holds deg(p1 +
  p2) <= max(deg(p1),deg(p2));

theorem 
  for L being add-associative right_zeroed right_complementable
  distributive commutative associative well-unital domRing-like non empty
  doubleLoopStr for p1,p2 being Polynomial of L st p1 <> 0_.(L) & p2 <> 0_.(L)
  holds deg(p1 *' p2) = deg(p1) + deg(p2);

theorem 
  for L being add-associative right_zeroed right_complementable
unital non empty doubleLoopStr for p being Polynomial of L st deg p = 0 holds
  not(p is with_roots);



definition
  let L be unital non empty doubleLoopStr;
  let z be Element of L;
  let k be Element of NAT;
  func rpoly(k,z) -> Polynomial of L equals

  0_.(L) +* (0,k)-->(-power(L).(z,k)
  ,1_L);
end;

theorem 
  for L being unital non empty doubleLoopStr for z being Element of L
  for k being Element of NAT st k <> 0 holds rpoly(k,z).0 = -power(L).(z,k) &
  rpoly(k,z).k = 1_L;

theorem 
  for L being unital non empty doubleLoopStr for z being Element of L
  for i,k being Element of NAT st i <> 0 & i <> k holds rpoly(k,z).i = 0.L;

theorem 
  for L being well-unital non degenerated non empty doubleLoopStr
 for z being Element of L for k being Element of NAT holds deg rpoly(k,z) = k;

theorem 
  for L being add-associative right_zeroed right_complementable
  well-unital commutative associative distributive almost_left_invertible non
degenerated non empty doubleLoopStr for p being Polynomial of L holds deg(p)
  = 1 iff ex x,z being Element of L st x <> 0.L & p = x * rpoly(1,z);

theorem 
  for L being add-associative right_zeroed right_complementable
  Abelian well-unital non degenerated non empty doubleLoopStr for x,z being
  Element of L holds eval(rpoly(1,z),x) = x - z;

theorem 
  for L being add-associative right_zeroed right_complementable
  well-unital Abelian non degenerated non empty doubleLoopStr for z being
  Element of L holds z is_a_root_of rpoly(1,z);



definition
  let L be well-unital non empty doubleLoopStr;
  let z be Element of L;
  let k be Nat;
  func qpoly(k,z) -> Polynomial of L means


  (for i being Nat st i < k
holds it.i = power(L).(z,k-i-1)) & for i being Nat st i >= k holds it.i = 0.L;
end;

theorem 
  for L being well-unital non degenerated non empty doubleLoopStr for
z being Element of L for k being Element of NAT st k >= 1 holds deg qpoly(k,z)
  = k - 1;

theorem 
  for L being add-associative right_zeroed right_complementable
left-distributive well-unital commutative non empty doubleLoopStr for z being
Element of L for k being Element of NAT st k > 1 holds rpoly(1,z) *' qpoly(k,z)
  = rpoly(k,z);

theorem 
  for L being Abelian add-associative right_zeroed
  right_complementable well-unital associative distributive commutative non
empty doubleLoopStr for p being Polynomial of L for z being Element of L st z
  is_a_root_of p ex s being Polynomial of L st p = rpoly(1,z) *' s;

begin 

definition
  let L be Abelian add-associative right_zeroed right_complementable
  well-unital associative commutative distributive almost_left_invertible non
  empty doubleLoopStr;
  let p,s be Polynomial of L such that
 s <> 0_.(L);
  func p div s -> Polynomial of L means


  ex t being Polynomial of L st p = it *' s + t & deg t < deg s;
end;

definition
  let L be Abelian add-associative right_zeroed right_complementable
  well-unital associative commutative distributive almost_left_invertible non
  empty doubleLoopStr;
  let p,s be Polynomial of L;
  func p mod s -> Polynomial of L equals

  p - (p div s) *' s;
end;

definition
  let L be Abelian add-associative right_zeroed right_complementable
  well-unital associative commutative distributive almost_left_invertible non
  empty doubleLoopStr;
  let p,s be Polynomial of L;
  pred s divides p means


  p mod s = 0_.(L);
end;

theorem 
  for L being Abelian add-associative right_zeroed
  right_complementable well-unital associative commutative distributive
almost_left_invertible non empty doubleLoopStr for p,s being Polynomial of L
  st s <> 0_.(L) holds s divides p iff ex t being Polynomial of L st t *' s = p
;

theorem 
  for L being Abelian add-associative right_zeroed right_complementable
  well-unital associative commutative distributive almost_left_invertible non
  degenerated non empty doubleLoopStr for p being Polynomial of L for z being
  Element of L st z is_a_root_of p holds rpoly(1,z) divides p;

theorem 
  for L being Abelian add-associative right_zeroed right_complementable
  well-unital associative commutative distributive almost_left_invertible non
  degenerated non empty doubleLoopStr for p being Polynomial of L for z being
  Element of L st p <> 0_.(L) & z is_a_root_of p holds deg(p div rpoly(1,z)) =
  deg(p) - 1;

begin 

definition
  let f be Polynomial of F_Complex;
  attr f is Hurwitz means


  for z being Element of F_Complex st z is_a_root_of f holds Re(z) < 0;
end;

theorem 
  0_.(F_Complex) is non Hurwitz;

theorem 
  for x being Element of F_Complex st x <> 0.F_Complex holds x * 1_.(
  F_Complex) is Hurwitz;

theorem 
  for x,z being Element of F_Complex st x <> 0.F_Complex holds x *
  rpoly(1,z) is Hurwitz iff Re(z) < 0;

theorem 
  for f being Polynomial of F_Complex for z being Element of
  F_Complex st z <> 0.F_Complex holds f is Hurwitz iff z * f is Hurwitz;

theorem 
  for f,g being Polynomial of F_Complex holds f *' g is Hurwitz
  iff f is Hurwitz & g is Hurwitz;

definition
  let f be Polynomial of F_Complex;
  func f*' -> Polynomial of F_Complex means


  for i being Element of NAT
  holds it.i = power(F_Complex).(-1_F_Complex,i) * (f.i)*';
 involutiveness;
end;

theorem 
  for f being Polynomial of F_Complex holds deg(f*') = deg(f);

canceled;

theorem 
  for f being Polynomial of F_Complex for z being Element of
  F_Complex holds (z * f)*' = (z*') * (f*');

theorem 
  for f being Polynomial of F_Complex holds (-f)*' = -(f*');

theorem 
  for f,g being Polynomial of F_Complex holds (f + g)*' = (f*') + (g*');

theorem 
  for f,g being Polynomial of F_Complex holds (f *' g)*' = (f*') *' (g*');

theorem 
  for x,z being Element of F_Complex holds eval(rpoly(1,z)*',x) = -x - (z*');

theorem 
  for f being Polynomial of F_Complex st f is Hurwitz for x being
  Element of F_Complex st Re(x) >= 0 holds 0 < |.eval(f,x).|;

theorem 
  for f being Polynomial of F_Complex st deg(f) >= 1 & f is
Hurwitz for x being Element of F_Complex holds (Re(x) < 0 implies |.eval(f,x).|
< |.eval(f*',x).|) & (Re(x) > 0 implies |.eval(f,x).| > |.eval(f*',x).|) & (Re(
  x) = 0 implies |.eval(f,x).| = |.eval(f*',x).|);

definition
  let f be Polynomial of F_Complex;
  let z be Element of F_Complex;
  func F*(f,z) -> Polynomial of F_Complex equals

  eval(f*',z) * f - eval(f,z) *
  f*';
end;

theorem 
  for a,b being Element of F_Complex st |.a.| > |.b.| for f being
Polynomial of F_Complex st deg(f) >= 1 holds f is Hurwitz iff a * f - b * (f*')
  is Hurwitz;

theorem 
  for f being Polynomial of F_Complex st deg(f) >= 1 for rho being
  Element of F_Complex st Re(rho) < 0 holds f is Hurwitz implies F*(f,rho) div
  rpoly(1,rho) is Hurwitz;

theorem 
  for f being Polynomial of F_Complex st deg(f) >= 1 holds (ex rho being
  Element of F_Complex st Re(rho) < 0 & |.eval(f,rho).| >= |.eval(f*',rho).|)
  implies f is non Hurwitz;


theorem 
  for f being Polynomial of F_Complex st deg(f) >= 1 for rho being
Element of F_Complex st Re(rho) < 0 & |.eval(f,rho).| < |.eval(f*',rho).| holds
  f is Hurwitz iff F*(f,rho) div rpoly(1,rho) is Hurwitz;














begin 

reserve x,y for set,
  N for Element of NAT,
  c,i,j,k,m,n for Nat,
  D for non empty set,
  s for Element of 2Set Seg (n+2),
  p for Element of Permutations(n) ,
  p1, q1 for Element of Permutations(n+1),
  p2 for Element of Permutations(n +2),
  K for Field,
  a for Element of K,
  f for FinSequence of K,
  A for (Matrix of K),
  AD for Matrix of n,m,D,
  pD for FinSequence of D,
  M for Matrix of n,K;

theorem 
  for f be FinSequence, i be Nat st i in dom f holds len Del(f,i) = len f -' 1;

theorem 
  for i,j,n being Nat, M being Matrix of n,K st i in dom M holds
  len Deleting(M,i,j) = n-'1;

theorem 
  j in Seg width A implies width DelCol(A,j) = width A-'1;

theorem 
  for i be Nat st len A > 1 holds width A = width DelLine(A,i);

theorem 
  for i being Nat st j in Seg width M holds width Deleting(M,i,j) = n-' 1;

definition
  let G be non empty multMagma;
  let B be Function of [:the carrier of G,NAT:], the carrier of G;
  let g be Element of G, i be Nat;
  redefine func B.(g,i) -> Element of G;
end;

theorem 
  card Permutations n = n!;

theorem 
  for i,j st i in Seg (n+1) & j in Seg (n+1) holds card {p1: p1.i = j} = n!;

theorem 
  for K be Fanoian Field for p2 for X,Y be Element of Fin 2Set Seg
  (n+2) st Y={s:s in X & Part_sgn(p2,K).s = -1_K} holds (the multF of K) $$ (X,
  Part_sgn(p2,K)) = power(K).(-1_K,card Y);

theorem 
  for K be Fanoian Field for p2,i,j st i in Seg (n+2) & p2.i=j ex X
  be Element of Fin 2Set Seg (n+2) st X = {{N,i} : {N,i} in 2Set Seg (n+2)} & (
  the multF of K) $$ (X,Part_sgn(p2,K)) = power(K).(-1_K,i+j);

theorem 
  for i,j st i in Seg (n+1) & n >= 2 ex Proj be Function of 2Set
Seg n, 2Set Seg(n+1) st rng Proj = 2Set Seg(n+1)\{{N,i}:{N,i} in 2Set Seg(n+1)}
& Proj is one-to-one & for k,m st k<m & {k,m} in 2Set Seg n holds (m < i & k <
i implies Proj.{k,m} = {k,m} ) & (m >= i & k < i implies Proj.{k,m} = {k,m+1} )
  & (m >= i & k >= i implies Proj.{k,m} = {k+1,m+1});

theorem 
  n < 2 implies for p be Element of Permutations n holds p is even & p=idseq n;

theorem 
  for X,Y,D be non empty set for f be Function of X,Fin Y, g be
  Function of Fin Y,D, F be BinOp of D st (for A,B be Element of Fin Y st A
misses B holds F.(g.A,g.B) = g.(A \/ B)) & F is commutative associative & F is
having_a_unity & g.{} = the_unity_wrt F for I be Element of Fin X st for x,y st
x in I & y in I & f.x meets f.y holds x = y holds F $$ (I,g*f) = F $$ (f.:I,g)
  & F $$ (f.:I,g) = g.union (f.:I) & union (f.:I) is Element of Fin Y;

begin 

definition
  let i,j,n be Nat;
  let K;
  let M be Matrix of n,K;
  assume that
 i in Seg n and
 j in Seg n;
  func Delete(M,i,j) -> Matrix of n-'1,K equals


  Deleting(M,i,j);
end;

theorem 
  for i,j st i in Seg n & j in Seg n for k,m st k in Seg (n-'1) &
m in Seg (n-'1) holds (k < i & m < j implies Delete(M,i,j)*(k,m) = M*(k,m) )& (
  k < i & m >= j implies Delete(M,i,j)*(k,m) = M*(k,m+1) )& (k >= i & m < j
implies Delete(M,i,j)*(k,m) = M*(k+1,m) )& (k >= i & m >= j implies Delete(M,i,
  j)*(k,m) = M*(k+1,m+1));

theorem 
  for i,j st i in Seg n & j in Seg n holds Delete(M,i,j)@ = Delete (M@,j,i);

theorem 
  for f be FinSequence of K, i,j st i in Seg n & j in Seg n holds
  Delete(M,i,j) = Delete(RLine(M,i,f),i,j);

definition
  let c, n, m, D;
  let M be Matrix of n,m,D;
  let pD be FinSequence of D;
  func ReplaceCol(M,c,pD) -> Matrix of n,m,D means


  len it = len M &
width it = width M & for i,j st [i,j] in Indices M holds (j <> c implies it*(i,
j) = M*(i,j)) & (j = c implies it*(i,c) = pD.i) if len pD = len M otherwise it
  = M;
end;

notation
  let c, n, m, D;
  let M be Matrix of n,m,D;
  let pD be FinSequence of D;
  synonym RCol(M,c,pD) for ReplaceCol(M,c,pD);
end;

theorem 
  for i st i in Seg width AD holds (i = c & len pD = len AD implies Col(
  RCol(AD,c,pD),i) = pD) & (i <> c implies Col(RCol(AD,c,pD),i) = Col(AD,i));

theorem 
  not c in Seg width AD implies RCol(AD,c,pD) = AD;

theorem 
  RCol(AD,c,Col(AD,c)) = AD;

theorem 
  for A be Matrix of n,m,D, A9 be Matrix of m,n,D st A9 = A@ & (m=
  0 implies n=0) holds ReplaceCol(A,c,pD) = ReplaceLine(A9,c,pD)@;

begin 

definition
  let i,n;
  let perm be Element of Permutations(n+1);
  assume
 i in Seg (n+1);
  func Rem(perm,i) -> Element of Permutations n means


  for k st k in Seg
n holds (k<i implies (perm.k < perm.i implies it.k = perm.k )& (perm.k >= perm.
i implies it.k = perm.k-1) )& (k>=i implies (perm.(k+1) < perm.i implies it.k =
  perm.(k+1) )& (perm.(k+1) >= perm.i implies it.k = perm.(k+1)-1));
end;

theorem 
  for i,j st i in Seg (n+1) & j in Seg(n+1) for P be set st P = { p1: p1
.i = j} ex Proj be Function of P,Permutations n st Proj is bijective & for
  q1 st q1.i = j holds Proj.q1 = Rem(q1,i);

theorem 
  for i,j st i in Seg (n+1) & p1.i = j holds -(a,p1) = power(K).(-
  1_K,i+j) * -(a,Rem(p1,i));

theorem 
  for i,j st i in Seg (n+1) & p1.i = j for M be Matrix of n+1,K
for DM be Matrix of n,K st DM = Delete(M,i,j) holds (Path_product M).p1 = power
  (K).(-1_K,i+j)*(M*(i,j))*(Path_product(DM)).Rem(p1,i);

begin 

definition
  let i,j,n be Nat;
  let K;
  let M be Matrix of n,K;
  func Minor(M,i,j) -> Element of K equals

  Det Delete(M,i,j);
end;

definition
  let i,j,n be Nat;
  let K;
  let M be Matrix of n,K;
  func Cofactor(M,i,j) -> Element of K equals

  power(K).(-1_K,i+j)*Minor(M,i,j);
end;

theorem 
  for i,j st i in Seg n & j in Seg n for P be Element of Fin
Permutations n st P = {p:p.i = j} for M be Matrix of n,K holds (the addF of K)
  $$ (P,Path_product(M)) = M*(i,j)*Cofactor(M,i,j);

theorem 
  for i,j st i in Seg n & j in Seg n holds Minor(M,i,j) = Minor(M@ ,j,i);

definition
  let n,K;
  let M be Matrix of n,K;
  func Matrix_of_Cofactor(M) -> Matrix of n,K means


  for i,j being Nat st [i,j] in Indices it holds it*(i,j) = Cofactor(M,i,j);
end;

begin 

definition
  let n,i,K;
  let M be Matrix of n,K;

  func LaplaceExpL(M,i) -> FinSequence of K means


  len it = n & for j st j in dom it holds it.j = M*(i,j)*Cofactor(M,i,j);
end;

definition
  let n;
  let j be Nat,K;
  let M be Matrix of n,K;
  func LaplaceExpC(M,j) -> FinSequence of K means


  len it = n & for i st i in dom it holds it.i = M*(i,j)*Cofactor(M,i,j);
end;

theorem 
  for i be Nat, M be Matrix of n,K st i in Seg n holds Det M = Sum
  LaplaceExpL(M,i);

theorem 
  for i st i in Seg n holds LaplaceExpC(M,i) = LaplaceExpL(M@,i);

theorem 
  for j be Nat, M be Matrix of n,K st j in Seg n holds Det M = Sum
  LaplaceExpC(M,j);

theorem 
  for p,i st len f=n & i in Seg n holds mlt(Line(
  Matrix_of_Cofactor M,i),f) = LaplaceExpL(RLine(M,i,f),i);

theorem 
  i in Seg n implies Line(M,j) "*" Col((Matrix_of_Cofactor M)@,i)
  = Det RLine(M,i,Line(M,j));

theorem 
  Det M <> 0.K implies M * ((Det M)" * (Matrix_of_Cofactor M)@) = 1.(K,n);

theorem 
  for f,i st len f=n & i in Seg n holds mlt(Col(Matrix_of_Cofactor
  M,i),f) = LaplaceExpL(RLine(M@,i,f),i);

theorem 
  i in Seg n & j in Seg n implies Line((Matrix_of_Cofactor M)@,i)
  "*" Col(M,j) = Det RLine(M@,i,Line(M@,j));

theorem 
  Det M <> 0.K implies ((Det M)" * (Matrix_of_Cofactor M)@) * M = 1.(K,n);

theorem 
  M is invertible iff Det M <> 0.K;

theorem 
  Det M <> 0.K implies M~ = (Det M)" * (Matrix_of_Cofactor M)@;

theorem 
  for M be Matrix of n,K st M is invertible for i,j st [i,j] in Indices
  (M~) holds M~*(i,j) = (Det M)" * power(K).(-1_K,i+j) * Minor(M,j,i);

theorem 
  for A be Matrix of n,K st Det A <> 0.K for x,b be Matrix of K st
len x = n & A * x = b holds x = A~ * b & for i,j st [i,j] in Indices x holds x*
  (i,j) = (Det A)" * Det ReplaceCol(A,i,Col(b,j));

theorem 
  for A be Matrix of n,K st Det A <> 0.K for x,b be Matrix of K st
width x = n & x * A = b holds x = b * A~ & for i,j st [i,j] in Indices x holds
  x*(i,j) = (Det A)" * Det ReplaceLine(A,j,Line(b,i));

begin 

definition
  let D be non empty set;
  let f be FinSequence of D;
  redefine func <*f*> -> Matrix of 1,len f,D;
end;

definition
  let K;
  let M be Matrix of K;
  let f be FinSequence of K;
  func M * f -> Matrix of K equals

  M * (<*f*>@);
  func f * M -> Matrix of K equals

  <*f*> * M;
end;

theorem 
  for A be Matrix of n,K st Det A <> 0.K for x,b be FinSequence of K st
len x = n & A * x = <*b*>@ holds <*x*>@ = A~ * b & for i st i in Seg n holds x.
  i = (Det A)" * Det ReplaceCol(A,i,b);


theorem 
  for A be Matrix of n,K st Det A <> 0.K for x,b be FinSequence of K st
len x = n & x * A = <*b*> holds <*x*> = b * A~ & for i st i in Seg n holds x.i
  = (Det A)" * Det ReplaceLine(A,i,b);














begin



definition
  let K be doubleLoopStr;
  func StructVectSp(K) -> strict VectSpStr over K equals

  VectSpStr (# the
    carrier of K, the addF of K, 0.K, the multF of K#);
end;

registration
  let K be non empty doubleLoopStr;
  cluster StructVectSp(K) -> non empty;
end;

registration
  let K be Abelian non empty doubleLoopStr;
  cluster StructVectSp(K) -> Abelian;
end;

registration
  let K be add-associative non empty doubleLoopStr;
  cluster StructVectSp(K) -> add-associative;
end;

registration
  let K be right_zeroed non empty doubleLoopStr;
  cluster StructVectSp(K) -> right_zeroed;
end;

registration
  let K be right_complementable non empty doubleLoopStr;
  cluster StructVectSp(K) -> right_complementable;
end;

registration
  let K be associative left_unital distributive non empty doubleLoopStr;
  cluster StructVectSp(K) -> vector-distributive scalar-distributive
  scalar-associative scalar-unital;
end;

registration
  let K be non degenerated non empty doubleLoopStr;
  cluster StructVectSp(K) -> non trivial;
end;

registration
  let K be non degenerated non empty doubleLoopStr;
  cluster non trivial for VectSpStr over K;
end;

registration
  let K be add-associative right_zeroed right_complementable non empty
  doubleLoopStr;
  cluster add-associative right_zeroed right_complementable strict for
non empty
    VectSpStr over K;
end;

registration
  let K be add-associative right_zeroed right_complementable associative
  left_unital distributive non empty doubleLoopStr;
  cluster add-associative right_zeroed right_complementable vector-distributive
  scalar-distributive scalar-associative scalar-unital strict
    for non empty VectSpStr over K;
end;

registration
  let K be Abelian add-associative right_zeroed right_complementable
associative left_unital distributive non degenerated non empty doubleLoopStr;
  cluster Abelian add-associative right_zeroed right_complementable
    vector-distributive scalar-distributive scalar-associative scalar-unital
    strict
    for non trivial VectSpStr over K;
end;

theorem 
  for K be add-associative right_zeroed right_complementable
associative left_unital distributive non empty doubleLoopStr, a be Element of
  K for V be add-associative right_zeroed right_complementable
  vector-distributive
  scalar-distributive scalar-associative scalar-unital non
  empty VectSpStr over K, v be Vector of V holds (0.K)*v = 0.V & a*(0.V) = 0.V;

theorem 
  for K be add-associative right_zeroed right_complementable Abelian
associative well-unital distributive non empty doubleLoopStr for V be VectSp
of K for S, T be Subspace of V, v be Vector of V st S /\ T = (0).V & v in S & v
  in T holds v = 0.V;

theorem 
  for K be Field, V be VectSp of K for x be set, v be Vector of V
  holds x in Lin{v} iff ex a be Element of K st x =a*v;

theorem 
  for K be Field, V be VectSp of K, v be Vector of V, a,b be Scalar
  of V st v <> 0.V & a * v = b * v holds a = b;

theorem 
  for K be add-associative right_zeroed right_complementable
associative Abelian well-unital distributive non empty doubleLoopStr for V be
VectSp of K for W1,W2 be Subspace of V st V is_the_direct_sum_of W1,W2 for v,v1
,v2 be Vector of V st v1 in W1 & v2 in W2 & v = v1 + v2 holds v |-- (W1,W2) = [
  v1,v2];

theorem 
  for K be add-associative right_zeroed right_complementable
associative Abelian well-unital distributive non empty doubleLoopStr for V be
VectSp of K for W1,W2 be Subspace of V st V is_the_direct_sum_of W1,W2 for v,v1
  ,v2 be Vector of V st v |-- (W1,W2) = [v1,v2] holds v = v1 + v2;

theorem 
  for K be add-associative right_zeroed right_complementable
associative Abelian well-unital distributive non empty doubleLoopStr for V be
VectSp of K for W1,W2 be Subspace of V st V is_the_direct_sum_of W1,W2 for v,v1
  ,v2 be Vector of V st v |-- (W1,W2) = [v1,v2] holds v1 in W1 & v2 in W2;

theorem 
  for K be add-associative right_zeroed right_complementable
associative Abelian well-unital distributive non empty doubleLoopStr for V be
VectSp of K for W1,W2 be Subspace of V st V is_the_direct_sum_of W1,W2 for v,v1
  ,v2 be Vector of V st v |-- (W1,W2) = [v1,v2] holds v |-- (W2,W1) = [v2,v1];

theorem 
  for K be add-associative right_zeroed right_complementable
associative Abelian well-unital distributive non empty doubleLoopStr for V be
VectSp of K for W1,W2 be Subspace of V st V is_the_direct_sum_of W1,W2 for v be
  Vector of V st v in W1 holds v |-- (W1,W2) = [v,0.V];

theorem 
  for K be add-associative right_zeroed right_complementable
associative Abelian well-unital distributive non empty doubleLoopStr for V be
VectSp of K for W1,W2 be Subspace of V st V is_the_direct_sum_of W1,W2 for v be
  Vector of V st v in W2 holds v |-- (W1,W2) = [0.V,v];

theorem 
  for K be add-associative right_zeroed right_complementable
associative Abelian well-unital distributive non empty doubleLoopStr for V be
VectSp of K for V1 be Subspace of V, W1 be Subspace of V1, v be Vector of V st
  v in W1 holds v is Vector of V1;

theorem 
  for K be add-associative right_zeroed right_complementable
associative Abelian well-unital distributive non empty doubleLoopStr for V be
  VectSp of K for V1,V2,W be Subspace of V, W1,W2 be Subspace of W st W1 = V1 &
  W2 = V2 holds W1 + W2 = V1 + V2;

theorem 
  for K be Field, V be VectSp of K, W be Subspace of V for v be
  Vector of V, w be Vector of W st v = w holds Lin{w} = Lin{v};

theorem 
  for K be Field, V be VectSp of K for v be Vector of V, X be
Subspace of V st not v in X for y be Vector of X + Lin{v}, W be Subspace of X +
  Lin{v} st v = y & W = X holds X + Lin{v} is_the_direct_sum_of W,Lin{y};

theorem 
  for K be Field, V be VectSp of K, v be Vector of V, X be
Subspace of V, y be Vector of X + Lin{v}, W be Subspace of X + Lin{v} st v = y
  & X = W & not v in X holds y |-- (W,Lin{y}) = [0.W,y];

theorem 
  for K be Field, V be VectSp of K, v be Vector of V, X be
Subspace of V for y be Vector of X + Lin{v}, W be Subspace of X + Lin{v} st v =
y & X = W & not v in X for w be Vector of X + Lin{v} st w in X holds w |-- (W,
  Lin{y}) = [w,0.V];

theorem 
  for K be add-associative right_zeroed right_complementable
  associative Abelian well-unital distributive non empty doubleLoopStr, V be
VectSp of K for v be Vector of V, W1,W2 be Subspace of V ex v1,v2 be Vector of
  V st v |-- (W1,W2) = [v1,v2];

theorem 
  for K be Field, V be VectSp of K for v be Vector of V, X be
Subspace of V, y be Vector of X + Lin{v}, W be Subspace of X + Lin{v} st v = y
  & X = W & not v in X for w be Vector of X + Lin{v} ex x be Vector of X, r be
  Element of K st w |-- (W,Lin{y}) = [x,r*v];

theorem 
  for K be Field, V be VectSp of K for v be Vector of V, X be
Subspace of V, y be Vector of X + Lin{v}, W be Subspace of X + Lin{v} st v = y
  & X = W & not v in X for w1,w2 be Vector of X + Lin{v}, x1,x2 be Vector of X,
r1,r2 be Element of K st w1 |-- (W,Lin{y}) = [x1,r1*v] & w2 |-- (W,Lin{y}) = [
  x2,r2*v] holds w1 + w2 |-- (W,Lin{y}) = [x1 + x2, (r1+r2)*v];

theorem 
  for K be Field, V be VectSp of K for v be Vector of V, X be
Subspace of V, y be Vector of X + Lin{v}, W be Subspace of X + Lin{v} st v = y
  & X = W & not v in X for w be Vector of X + Lin{v}, x be Vector of X, t,r be
Element of K st w |-- (W,Lin{y}) = [x,r*v] holds t*w |-- (W,Lin{y}) = [t*x, t*r
  *v];

begin



definition
  let K be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr;
  let V be VectSp of K;
  let W be Subspace of V;
  func CosetSet(V,W) ->non empty Subset-Family of V equals

  {A where A is Coset
  of W: not contradiction};
end;

definition
  let K be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr;
  let V be VectSp of K;
  let W be Subspace of V;
  func addCoset(V,W) -> BinOp of CosetSet(V,W) means


  for A,B be Element
of CosetSet(V,W) for a,b be Vector of V st A = a + W & B = b + W holds it.(A,B)
  = (a+b)+W;
end;

definition
  let K be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr;
  let V be VectSp of K;
  let W be Subspace of V;
  func zeroCoset(V,W) -> Element of CosetSet(V,W) equals

  the carrier of W;
end;

definition
  let K be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr;
  let V be VectSp of K;
  let W be Subspace of V;
  func lmultCoset(V,W) -> Function of [:the carrier of K, CosetSet(V,W):],
  CosetSet(V,W) means


  for z be Element of K, A be Element of CosetSet(V,W)
  for a be Vector of V st A = a+W holds it.(z,A) = z*a +W;
end;

definition
  let K be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr;
  let V be VectSp of K;
  let W be Subspace of V;
  func VectQuot(V,W) -> strict Abelian add-associative right_zeroed
  right_complementable vector-distributive scalar-distributive
  scalar-associative scalar-unital non empty VectSpStr over K means


  the carrier of it = CosetSet(V,W) & the addF of it = addCoset(V,W) & 0.it =
  zeroCoset(V,W) & the lmult of it = lmultCoset(V,W);
end;

theorem 
  for K be add-associative right_zeroed right_complementable
  Abelian associative well-unital distributive non empty doubleLoopStr, V be
VectSp of K, W be Subspace of V holds zeroCoset(V,W) = 0.V + W & 0.(VectQuot(V,
  W)) = zeroCoset(V,W);

theorem 
  for K be add-associative right_zeroed right_complementable
Abelian associative well-unital distributive non empty doubleLoopStr for V be
VectSp of K, W be Subspace of V, w be Vector of VectQuot(V,W) holds w is Coset
  of W & ex v be Vector of V st w = v + W;

theorem 
  for K be add-associative right_zeroed right_complementable
Abelian associative well-unital distributive non empty doubleLoopStr for V be
VectSp of K, W be Subspace of V, v be Vector of V holds v+W is Coset of W & v+W
  is Vector of VectQuot(V,W);

theorem 
  for K be add-associative right_zeroed right_complementable Abelian
associative well-unital distributive non empty doubleLoopStr for V be VectSp
  of K, W be Subspace of V, A be Coset of W holds A is Vector of VectQuot(V,W);

theorem 
  for K be add-associative right_zeroed right_complementable Abelian
associative well-unital distributive non empty doubleLoopStr, V be VectSp of
K, W be Subspace of V for A be Vector of VectQuot(V,W), v be Vector of V, a be
  Scalar of V st A = v + W holds a*A = a*v + W;

theorem 
  for K be add-associative right_zeroed right_complementable Abelian
associative well-unital distributive non empty doubleLoopStr, V be VectSp of
K, W be Subspace of V for A1,A2 be Vector of VectQuot(V,W), v1,v2 be Vector of
  V st A1 = v1 + W & A2 = v2 + W holds A1 + A2 = v1 + v2 + W;

begin



theorem 
  for K be Field, V be VectSp of K for X be Subspace of V, fi be
linear-Functional of X, v be Vector of V, y be Vector of X + Lin {v} st v = y &
  not v in X for r be Element of K ex psi be linear-Functional of X + Lin{v} st
  psi|the carrier of X=fi & psi.y = r;

registration
  let K be right_zeroed non empty addLoopStr;
  let V be non empty VectSpStr over K;
  cluster additive 0-preserving for Functional of V;
end;

registration
  let K be add-associative right_zeroed right_complementable non empty
  doubleLoopStr;
  let V be right_zeroed non empty VectSpStr over K;
  cluster additive -> 0-preserving for Functional of V;
end;

registration
  let K be add-associative right_zeroed right_complementable associative
  well-unital distributive non empty doubleLoopStr;
  let V be add-associative right_zeroed right_complementable
  vector-distributive scalar-distributive scalar-associative scalar-unital non
  empty VectSpStr over K;
  cluster homogeneous -> 0-preserving for Functional of V;
end;

registration
  let K be non empty ZeroStr;
  let V be non empty VectSpStr over K;
  cluster 0Functional(V) -> constant;
end;

registration
  let K be non empty ZeroStr;
  let V be non empty VectSpStr over K;
  cluster constant for Functional of V;
end;

definition
  let K be add-associative right_zeroed right_complementable non empty
  doubleLoopStr;
  let V be right_zeroed non empty VectSpStr over K;
  let f be 0-preserving Functional of V;
  redefine attr f is constant means


  f = 0Functional(V);
end;

registration
  let K be add-associative right_zeroed right_complementable non empty
  doubleLoopStr;
  let V be right_zeroed non empty VectSpStr over K;
  cluster constant additive 0-preserving for Functional of V;
end;

registration
  let K be Field;
  let V be non trivial VectSp of K;
  cluster additive homogeneous non constant non trivial for Functional of V;
end;

registration
  let K be Field;
  let V be non trivial VectSp of K;
  cluster trivial -> constant for Functional of V;
end;

definition
  let K be Field;
  let V be non trivial VectSp of K;
  let v be Vector of V;
  let W be Linear_Compl of Lin{v};
  assume
 v <> 0.V;
  func coeffFunctional(v,W) -> non constant non trivial linear-Functional of V
  means


  it.v = 1_K & it|the carrier of W = 0Functional(W);
end;

theorem 
  for K be Field, V be non trivial VectSp of K for f be non
constant 0-preserving Functional of V ex v be Vector of V st v <> 0.V & f.v <>
  0.K;

theorem 
  for K be Field, V be non trivial VectSp of K for v be Vector of
  V, a be Scalar of V for W be Linear_Compl of Lin{v} st v <> 0.V holds (
  coeffFunctional(v,W)).(a*v) = a;

theorem 
  for K be Field, V be non trivial VectSp of K for v,w be Vector
  of V for W be Linear_Compl of Lin{v} st v <> 0.V & w in W holds (
  coeffFunctional(v,W)).w = 0.K;

theorem 
  for K be Field, V be non trivial VectSp of K for v,w be Vector of V, a
  be Scalar of V for W be Linear_Compl of Lin{v} st v <> 0.V & w in W holds (
  coeffFunctional(v,W)).(a*v+w) = a;

theorem 
  for K be non empty addLoopStr for V be non empty VectSpStr over K for
  f,g be Functional of V, v be Vector of V holds (f-g).v = f.v - g.v;

registration
  let K be Field;
  let V be non trivial VectSp of K;
  cluster V*' -> non trivial;
end;

begin





definition
  let K be non empty ZeroStr;
  let V be non empty VectSpStr over K;
  let f be Functional of V;
  func ker f -> Subset of V equals

  {v where v is Vector of V : f.v = 0.K};
end;

registration
  let K be right_zeroed non empty addLoopStr;
  let V be non empty VectSpStr over K;
  let f be 0-preserving Functional of V;
  cluster ker f -> non empty;
end;

theorem 
  for K be add-associative right_zeroed right_complementable
  associative well-unital distributive non empty doubleLoopStr for V be
  add-associative right_zeroed right_complementable vector-distributive
  scalar-distributive scalar-associative scalar-unital
   non empty
  VectSpStr over K for f be linear-Functional of V holds ker f is
  linearly-closed;

definition
  let K be non empty ZeroStr;
  let V be non empty VectSpStr over K;
  let f be Functional of V;
  attr f is degenerated means


  ker f <> {0.V};
end;

registration
  let K be non degenerated non empty doubleLoopStr;
  let V be non trivial VectSpStr over K;
  cluster non degenerated 0-preserving -> non constant for Functional of V;
end;

definition
  let K be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr;
  let V be VectSp of K;
  let f be linear-Functional of V;
  func Ker f -> strict non empty Subspace of V means


  the carrier of it = ker f;
end;

definition
  let K be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr;
  let V be VectSp of K;
  let W be Subspace of V;
  let f be additive Functional of V;
  assume
 the carrier of W c= ker f;
  func QFunctional(f,W) -> additive Functional of VectQuot(V,W) means


for A be Vector of VectQuot(V,W), a be Vector of V st A = a+W holds it.A = f.a;
end;

theorem 
  for K be add-associative right_zeroed right_complementable
Abelian associative well-unital distributive non empty doubleLoopStr for V be
VectSp of K, W be Subspace of V for f be linear-Functional of V st the carrier
  of W c= ker f holds QFunctional(f,W) is homogeneous;

definition
  let K be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr;
  let V be VectSp of K;
  let f be linear-Functional of V;
  func CQFunctional(f) -> linear-Functional of VectQuot(V,Ker f) equals

  QFunctional(f,Ker f);
end;

theorem 
  for K be add-associative right_zeroed right_complementable
Abelian associative well-unital distributive non empty doubleLoopStr for V be
VectSp of K, f be linear-Functional of V for A be Vector of VectQuot(V,Ker f),
  v be Vector of V st A = v+Ker f holds (CQFunctional(f)).A = f.v;

registration
  let K be Field;
  let V be non trivial VectSp of K;
  let f be non constant linear-Functional of V;
  cluster CQFunctional(f) -> non constant;
end;

registration
  let K be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr;
  let V be VectSp of K;
  let f be linear-Functional of V;
  cluster CQFunctional(f) -> non degenerated;
end;














begin 

reserve x,y,X,Y for set,
  D for non empty set,
  i,j,k,l,m,n,m9,n9 for Nat,
  i0,j0,n0,m0 for non zero Nat,
  K for Field,
  a,b for Element of K,
  p for FinSequence of K,
  M for Matrix of n,K;

theorem 
  for A be Matrix of n,m,D holds (n=0 implies m=0) iff len A = n & width A = m;

theorem 
  M is Lower_Triangular_Matrix of n,K iff M@ is Upper_Triangular_Matrix of n,K;

theorem 
  diagonal_of_Matrix M = diagonal_of_Matrix M@;

theorem 
  for perm being Element of Permutations n st perm <> idseq n holds
  (ex i st i in Seg n & perm.i > i) & ex j st j in Seg n & perm.j < j;

theorem 
  for M be (Matrix of n,K),perm being Element of Permutations n st
  perm <> idseq n & ( M is Lower_Triangular_Matrix of n,K or M is
  Upper_Triangular_Matrix of n,K ) holds (Path_product(M)).perm = 0.K;

theorem 
  for M be (Matrix of n,K), I be Element of Permutations n st I =
  idseq n holds diagonal_of_Matrix M = Path_matrix(I,M);

theorem 
  for M be Upper_Triangular_Matrix of n,K holds Det M = (the multF
  of K) $$ diagonal_of_Matrix M;

theorem 
  for M be Lower_Triangular_Matrix of n,K holds Det M=(the multF of
  K) $$ diagonal_of_Matrix M;

theorem 
  for X be finite set, n holds card {Y where Y is Subset of X: card
  Y = n} = card X choose n;

theorem 
  card 2Set Seg n = n choose 2;

theorem 
  for R be Element of Permutations(n) st R=Rev idseq n holds R is even
  iff (n choose 2) mod 2 = 0;

theorem 
  for M be (Matrix of n,K),R be Permutation of Seg n st R=Rev
  idseq n & for i,j st i in Seg n & j in Seg n & i+j <= n holds M*(i,j) = 0.K
  holds M*R is Upper_Triangular_Matrix of n,K;

theorem 
  for M be (Matrix of n,K),R be Permutation of Seg n st R=Rev
  idseq n & for i,j st i in Seg n & j in Seg n & i+j > n+1 holds M*(i,j) = 0.K
  holds M*R is Lower_Triangular_Matrix of n,K;

theorem 
  for M be (Matrix of n,K),R be Element of Permutations(n) st R = Rev
idseq n & ((for i,j st i in Seg n & j in Seg n & i+j <= n holds M*(i,j) = 0.K)
or (for i,j st i in Seg n & j in Seg n & i+j > n+1 holds M*(i,j) = 0.K)) holds
  Det M = -((the multF of K) "**" Path_matrix(R,M), R);

theorem 
  for M be Matrix of n,K for M1,M2 be Upper_Triangular_Matrix of n
,K st M = M1*M2 holds M is Upper_Triangular_Matrix of n,K & diagonal_of_Matrix
  M = mlt(diagonal_of_Matrix M1,diagonal_of_Matrix M2);

theorem 
  for M be Matrix of n,K for M1,M2 be Lower_Triangular_Matrix of n,K st
  M = M1*M2 holds M is Lower_Triangular_Matrix of n,K & diagonal_of_Matrix M =
  mlt(diagonal_of_Matrix M1,diagonal_of_Matrix M2);

begin 

definition
  let D be non empty set;
  let M be Matrix of D;
  let n,m;
  let nt be Element of n-tuples_on NAT;
  let mt be Element of m-tuples_on NAT;
  func Segm(M,nt,mt) -> Matrix of n,m,D means


  for i,j being Nat st [i,j ] in Indices it holds it*(i,j)=M*(nt.i,mt.j);
end;

reserve A for (Matrix of D),
  A9 for Matrix of n9,m9,D,
  M9 for Matrix of n9, m9,K,
  nt,nt1,nt2 for Element of n-tuples_on NAT,
  mt,mt1 for Element of m -tuples_on NAT,
  M for Matrix of K;

theorem 
  [:rng nt,rng mt:] c= Indices A implies ( [i,j] in Indices Segm(A
  ,nt,mt) iff [nt.i,mt.j] in Indices A );

theorem 
  [:rng nt,rng mt:] c= Indices A & (n = 0 iff m = 0) implies Segm(
  A,nt,mt)@ = Segm(A@,mt,nt);

theorem 
  [:rng nt,rng mt:] c= Indices A & (m=0 implies n=0) implies Segm(
  A,nt,mt) = Segm(A@,mt,nt)@;

theorem 
  for A be Matrix of 1,D holds A = <*<* A*(1,1) *>*>;

theorem 
  n = 1 & m = 1 implies Segm(A,nt,mt) = <*<* A*(nt.1,mt.1) *>*>;

theorem 
  for A be Matrix of 2,D holds A = ( A*(1,1),A*(1,2) )][( A*(2,1), A*(2,2) );

theorem 
  n = 2 & m = 2 implies Segm(A,nt,mt) = ( A*(nt.1,mt.1),A*(nt.1,mt
  .2) )][( A*(nt.2,mt.1),A*(nt.2,mt.2) );

theorem 
  i in Seg n & rng mt c= Seg width A implies Line(Segm(A,nt,mt),i)
  = Line(A,nt.i) * mt;

theorem 
  i in Seg n & j in Seg n & nt.i = nt.j implies Line(Segm(A,nt,mt)
  ,i) = Line(Segm(A,nt,mt),j);

theorem 
  i in Seg n & j in Seg n & nt.i = nt.j & i<>j implies Det Segm(M,
  nt,nt1) = 0.K;

theorem 
  not nt is one-to-one implies Det Segm(M,nt,nt1) = 0.K;

theorem 
  j in Seg m & rng nt c= Seg len A implies Col(Segm(A,nt,mt),j) =
  Col(A,mt.j) * nt;

theorem 
  i in Seg m & j in Seg m & mt.i = mt.j implies Col(Segm(A,nt,mt),
  i) = Col(Segm(A,nt,mt),j);

theorem 
  i in Seg m & j in Seg m & mt.i = mt.j & i<>j implies Det Segm(M,
  mt1,mt) = 0.K;

theorem 
  not mt is one-to-one implies Det Segm(M,mt1,mt) = 0.K;

theorem 
  for nt,nt1 be Element of n-tuples_on NAT st nt is one-to-one &
  nt1 is one-to-one & rng nt = rng nt1 ex perm be Permutation of Seg n st nt1 =
  nt * perm;

theorem 
  for f be Function of Seg n,Seg n st nt1 = nt * f holds Segm(A,
  nt1,mt) = Segm(A,nt,mt) * f;

theorem 
  for f be Function of Seg m,Seg m st mt1 = mt * f holds Segm(A,nt
  ,mt1)@ = Segm(A,nt,mt)@ * f;

theorem 
  for perm be Element of Permutations n st nt1 = nt2 * perm holds
  Det Segm(M,nt1,nt) = -(Det Segm(M,nt2,nt),perm) & Det Segm(M,nt,nt1) = -(Det
  Segm(M,nt,nt2),perm);

theorem 
  for nt,nt1,nt9,nt19 be Element of n-tuples_on NAT st rng nt =
rng nt9 & rng nt1 = rng nt19 holds Det Segm(M,nt,nt1) = Det Segm(M,nt9,nt19) or
  Det Segm(M,nt,nt1) = -Det Segm(M,nt9,nt19);

theorem 
  for F,Fmt be FinSequence of D,nt,mt st len F = width A9 & Fmt =
  F * mt & [:rng nt,rng mt:] c= Indices A9 for i,j st nt"{j} = {i} holds RLine(
  Segm(A9,nt,mt),i,Fmt) = Segm(RLine(A9,j,F),nt,mt);

theorem 
  for F be FinSequence of D,i,nt st not i in rng nt & [:rng nt,rng
  mt:] c= Indices A9 holds Segm(A9,nt,mt) = Segm(RLine(A9,i,F),nt,mt);

theorem 
  i in rng nt & [:rng nt,rng mt:] c= Indices A9 implies ex nt1 st
rng nt1 = rng nt\{i} \/ {j} & Segm(RLine(A9,i,Line(A9,j)),nt,mt) = Segm(A9,nt1,
  mt);

theorem 
  for F be FinSequence of D holds not i in Seg len A9 implies
  RLine(A9,i,F) = A9;

definition
  let n,m be Nat,K be Field;
  let M be Matrix of n,m,K, a be Element of K;
  redefine func a*M -> Matrix of n,m,K;
end;

theorem 
  [:rng nt,rng mt:] c= Indices M implies a * Segm(M,nt,mt) = Segm( a * M,nt,mt)
;

theorem 
  nt = idseq len A & mt = idseq width A implies Segm(A,nt,mt) = A;

registration
  cluster empty without_zero finite for Subset of NAT;
  cluster non empty without_zero finite for Subset of NAT;
end;

registration
  let n;
  cluster Seg n -> without_zero;
end;

registration
  let X be without_zero set, Y be set;
  cluster X \ Y -> without_zero;
end;

definition
  let i be Nat;
  redefine func {i} -> Subset of NAT;
  let j be Nat;
  redefine func {i,j} -> Subset of NAT;
end;

theorem 
  for N be finite without_zero Subset of NAT ex k st N c= Seg k;

definition
  let N be finite without_zero Subset of NAT;
  redefine func Sgm N -> Element of (card N)-tuples_on NAT;
end;

definition
  let D be non empty set,A be Matrix of D;
  let P,Q be without_zero finite Subset of NAT;
  func Segm(A,P,Q) -> Matrix of card P,card Q,D equals

  Segm(A,Sgm P,Sgm Q);
end;

theorem 
  Segm(A,{i0},{j0}) = <*<* A*(i0,j0) *>*>;

theorem 
  i0 < j0 & n0 < m0 implies Segm(A,{i0,j0},{n0,m0}) = ( A*(i0,n0),
  A*(i0,m0) )][( A*(j0,n0),A*(j0,m0) );

reserve P,P1,P2,Q,Q1,Q2 for without_zero finite Subset of NAT;

theorem 
  Segm(A,Seg len A,Seg width A) = A;

theorem 
  i in Seg card P & Q c= Seg width A implies Line(Segm(A,P,Q),i) =
  Line(A,Sgm P.i) * Sgm Q;

theorem 
  i in Seg card P implies Line(Segm(A,P,Seg width A),i) = Line(A, Sgm P.i);

theorem 
  j in Seg card Q & P c= Seg len A implies Col(Segm(A,P,Q),j) =
  Col(A,Sgm Q.j) * Sgm P;

theorem 
  j in Seg card Q implies Col(Segm(A,Seg len A,Q),j) = Col(A,Sgm Q .j);

theorem 
  Segm(A,Seg len A \ {i},Seg width A) = Del(A,i);

theorem 
  Segm(M,Seg len M,Seg width M\{i}) = DelCol(M,i);

theorem 
  Sgm P " X is without_zero finite Subset of NAT;

theorem 
  X c= P implies Sgm X = Sgm P * Sgm (Sgm P " X);

theorem 
  [:Sgm P " X,Sgm Q " Y:] c= Indices Segm(A,P,Q);

theorem 
  P c= P1 & Q c= Q1 & P2 = Sgm P1 " P & Q2 = Sgm Q1 " Q implies [:
rng Sgm P2,rng Sgm Q2:] c= Indices Segm(A,P1,Q1) & Segm(Segm(A,P1,Q1),P2,Q2) =
  Segm(A,P,Q);

theorem 
  (P = {} iff Q={}) & [:P,Q:] c= Indices Segm(A,P1,Q1) implies ex
P2,Q2 st P2 c= P1 & Q2 c= Q1 & P2 = Sgm P1.:P & Q2=Sgm Q1.:Q & card P2=card P &
  card Q2=card Q & Segm(Segm(A,P1,Q1),P,Q) = Segm(A,P2,Q2);

theorem 
  for M be Matrix of n,K holds Segm(M,Seg n\{i},Seg n\{j}) = Deleting(M,i,j);

theorem 
  for F,FQ be FinSequence of D st len F = width A9 & FQ = F * Sgm
Q & [:P,Q:] c= Indices A9 holds RLine(Segm(A9,P,Q),i,FQ) = Segm(RLine(A9,Sgm P.
  i,F),P,Q);

theorem 
  for F be FinSequence of D,i,P st not i in P & [:P,Q:] c= Indices
  A9 holds Segm(A9,P,Q) = Segm(RLine(A9,i,F),P,Q);

theorem 
  [:P,Q:] c= Indices A & (card P=0 iff card Q=0) implies Segm(A,P,Q)@ =
  Segm(A@,Q,P);

theorem 
  [:P,Q:] c= Indices A & (card Q=0 implies card P = 0) implies
  Segm(A,P,Q) = Segm(A@,Q,P)@;

theorem 
  [:P,Q:] c= Indices M implies a * Segm(M,P,Q) = Segm(a * M,P,Q);

definition
  let D be non empty set,A be Matrix of D;
  let P,Q be without_zero finite Subset of NAT;
  assume
 card P = card Q;
  func EqSegm(A,P,Q) -> Matrix of card P,D equals


  Segm(A,P,Q);
end;

theorem 
  for P,Q,i,j st i in Seg card P & j in Seg card P & card P = card
Q holds Delete(EqSegm(M,P,Q),i,j) = EqSegm(M,P\{Sgm P.i},Q\{Sgm Q.j}) & card (P
  \{Sgm P.i}) = card (Q\{Sgm Q.j});

theorem 
  for M,P,P1,Q1 st card P1 = card Q1 & P c= P1 & Det EqSegm(M,P1,
  Q1) <> 0.K ex Q st Q c= Q1 & card P = card Q & Det EqSegm(M,P,Q) <> 0.K;

theorem 
  for M,P1,Q,Q1 st card P1 = card Q1 & Q c= Q1 & Det EqSegm(M,P1,Q1) <>
  0.K ex P st P c= P1 & card P = card Q & Det EqSegm(M,P,Q) <> 0.K;

theorem 
  card P=card Q implies ([:P,Q:] c= Indices A iff P c= Seg len A &
  Q c= Seg width A);

theorem 
  for P,Q,i,j0 st j0 in Seg n9 & i in P & not j0 in P & card P =
card Q & [:P,Q:] c= Indices M9 holds card P = card (P\{i}\/{j0}) & [:P\{i}\/{j0
},Q:] c= Indices M9 & (Det EqSegm(RLine(M9,i,Line(M9,j0)),P,Q) = Det EqSegm(M9,
P\{i}\/{j0},Q) or Det EqSegm(RLine(M9,i,Line(M9,j0)),P,Q) = -Det EqSegm(M9,P\{i
  }\/{j0},Q));

theorem 
  card P = card Q implies ([:P,Q:] c= Indices A iff [:Q,P:] c= Indices A@);

theorem 
  [:P,Q:] c= Indices M & card P = card Q implies Det EqSegm(M,P,Q)
  = Det EqSegm(M@,Q,P);

theorem 
  for M be Matrix of n,K holds Det (a*M) = power(K).(a,n) * Det M;

theorem 
  [:P,Q:] c= Indices M & card P = card Q implies Det EqSegm(a*M,P,
  Q) = power(K).(a,card P) * Det EqSegm(M,P,Q);

definition
  let K be Field;
  let M be Matrix of K;
  func the_rank_of M -> Element of NAT means


  (ex P,Q st [:P,Q:] c=
Indices M & card P = card Q & card P = it & Det EqSegm(M,P,Q)<>0.K) & for P1,Q1
  st [:P1,Q1:] c= Indices M & card P1 = card Q1 & Det EqSegm(M,P1,Q1) <> 0.K
  holds card P1 <= it;
end;

theorem 
  for P,Q st [:P,Q:] c= Indices M & card P = card Q holds card P
  <= len M & card Q <= width M;

theorem 
  the_rank_of M <= len M & the_rank_of M <= width M;

theorem 
  [:rng nt1,rng nt2:] c= Indices M & Det Segm(M,nt1,nt2)<>0.K
implies ex P1,P2 st P1 = rng nt1 & P2 = rng nt2 & card P1 = card P2 & card P1 =
  n & Det EqSegm(M,P1,P2) <>0.K;

theorem 
  for RANK be Element of NAT holds the_rank_of M = RANK iff (ex
rt1,rt2 be Element of RANK-tuples_on NAT st [:rng rt1,rng rt2:] c= Indices M &
Det Segm(M,rt1,rt2)<>0.K) & for n,nt1,nt2 st [:rng nt1,rng nt2:] c= Indices M &
  Det Segm(M,nt1,nt2)<>0.K holds n <= RANK;

theorem 
  n = 0 or m = 0 implies the_rank_of Segm(M,nt,mt) = 0;

theorem 
  [:rng nt,rng mt:] c= Indices M implies the_rank_of M >=
  the_rank_of Segm(M,nt,mt);

theorem 
  [:P,Q:] c= Indices M implies the_rank_of M >= the_rank_of Segm(M ,P,Q);

theorem 
  P c= P1 & Q c= Q1 implies the_rank_of Segm(M,P,Q) <= the_rank_of
  Segm(M,P1,Q1);

theorem 
  for f,g be Function st rng f c= rng g ex h be Function st dom h
  = dom f & rng h c= dom g & f = g*h;

theorem 
  [:rng nt,rng mt:] = Indices M implies the_rank_of M =
  the_rank_of Segm(M,nt,mt);

theorem 
  for M be Matrix of n,K holds the_rank_of M = n iff Det M <> 0.K;

theorem 
  the_rank_of M = the_rank_of (M@);

theorem 
  for M be Matrix of n,m,K,F be Permutation of Seg n holds the_rank_of M
  = the_rank_of (M*F);

theorem 
  a <> 0.K implies the_rank_of M = the_rank_of (a*M);

theorem 
  for p,pf be FinSequence of K, f be Function st pf = p * f & rng
  f c= dom p holds (a*p) * f = a * pf;

theorem 
  for p,pf,q,qf be FinSequence of K, f be Function st pf = p * f &
  rng f c= dom p & qf = q * f & rng f c= dom q holds (p+q) * f = pf + qf;

theorem 
  a<>0.K implies the_rank_of M9 = the_rank_of RLine(M9,i,a*Line(M9 ,i));

theorem 
  Line(M,i)=(width M) |-> 0.K implies the_rank_of DelLine(M,i) = the_rank_of M;

theorem 
  for p st len p = width M9 holds the_rank_of DelLine(M9,i) =
  the_rank_of RLine(M9,i,0.K*p);

theorem 
  j in Seg len M9 & (i=j implies a <> - 1_K) implies the_rank_of
  M9 = the_rank_of RLine(M9,i,Line(M9,i)+a*Line(M9,j));

theorem 
  j in Seg len M9 & j<>i implies the_rank_of DelLine(M9,i) =
  the_rank_of RLine(M9,i,a*Line(M9,j));

theorem 
  the_rank_of M > 0 iff ex i,j st [i,j] in Indices M & M*(i,j) <> 0.K;

theorem 
  the_rank_of M = 0 iff M = 0.(K,len M,width M);

theorem 
  the_rank_of M = 1 iff (ex i,j st [i,j] in Indices M & M*(i,j) <>
  0.K) & for i0,j0,n0,m0 st i0<>j0 & n0<>m0 & [:{i0,j0},{n0,m0}:] c= Indices M
  holds Det EqSegm(M,{i0,j0},{n0,m0}) = 0.K;

theorem 
  the_rank_of M = 1 iff (ex i,j st [i,j] in Indices M & M*(i,j) <>
0.K) & for i,j,n,m st [:{i,j},{n,m}:] c= Indices M holds M*(i,n) * (M*(j,m)) =
  M*(i,m) * (M*(j,n));

theorem 
  the_rank_of M = 1 iff ex i st i in Seg len M & (ex j st j in Seg width
  M & M*(i,j) <> 0.K) & for k st k in Seg len M ex a st Line(M,k) =a*Line(M,i);

registration
  let K;
  cluster diagonal for Matrix of K;
end;

theorem 
  for M be diagonal Matrix of K for NonZero1 be set st NonZero1 = {i
where i is Element of NAT:[i,i] in Indices M & M*(i,i)<>0.K} for P,Q st [:P,Q:]
c= Indices M & card P = card Q & Det EqSegm(M,P,Q)<>0.K holds P c= NonZero1 & Q
  c= NonZero1;

theorem 
  for M be diagonal Matrix of K for P st [:P,P:] c= Indices M
  holds Segm(M,P,P) is diagonal;

theorem 
  for M be diagonal Matrix of K for NonZero1 be set st NonZero1={i where i
is Element of NAT:[i,i] in Indices M & M*(i,i)<>0.K} holds the_rank_of M = card
  NonZero1;

reserve v,v1,v2,u,w for Vector of n-VectSp_over K,
  t,t1,t2 for Element of n -tuples_on the carrier of K,

  L for Linear_Combination of n-VectSp_over K,
  M,M1 for Matrix of m,n,K;

theorem 
  the carrier of n -VectSp_over K = n-tuples_on the carrier of K
& 0.(n -VectSp_over K) = n |-> 0.K & ( t1 = v1 & t2 = v2 implies t1 + t2 = v1 +
  v2 ) & ( t = v implies a * t = a * v );

registration
  let K,n;
  cluster n -VectSp_over K -> right_complementable Abelian add-associative
     right_zeroed;
end;

registration
  let K,n;
  cluster -> Function-like Relation-like for Vector of n-VectSp_over K;
end;

notation
  let K,m,n;
  let M be Matrix of m,n,K;
  synonym lines M for rng M;
  synonym M is without_repeated_line for M is one-to-one;
end;

definition
  let K be Field,m,n;
  let M be Matrix of m,n,K;
  redefine func lines M -> Subset of n-VectSp_over K;
end;

theorem 
  x in lines M iff ex i st i in Seg m & x = Line(M,i);

theorem 
  for V be finite Subset of n-VectSp_over K ex M be Matrix of card V,n,K
  st M is without_repeated_line & lines M = V;

definition
  let K,n;
  let F be FinSequence of n-VectSp_over K;
  func FinS2MX F -> Matrix of len F,n,K equals

  F;
end;

definition
  let K,m,n;
  let M be Matrix of m,n,K;
  func MX2FinS M -> FinSequence of n-VectSp_over K equals

  M;
end;

theorem 
  the_rank_of M = m implies M is without_repeated_line;

theorem 
  i in Seg len M & a = L.(M.i) implies Line(FinS2MX(L (#) MX2FinS
  M),i) = a * Line(M,i);

theorem 
  M is without_repeated_line & Carrier L c= lines M & i in Seg n
  implies (Sum L).i = Sum Col(FinS2MX(L (#) MX2FinS M),i);

theorem 
  for M,M1 st M is without_repeated_line & for i st i in Seg m
  holds ex a st Line(M1,i) = a * Line(M,i) holds ex L be Linear_Combination of
  lines M st L (#) MX2FinS M = M1;

theorem 
  for M st M is without_repeated_line holds ( for i st i in Seg m
holds Line(M,i) <> n |-> 0.K ) & ( for M1 st (for i st i in Seg m ex a st Line(
M1,i) = a * Line(M,i))& for j st j in Seg n holds Sum Col(M1,j) = 0.K holds M1
  = 0.(K,m,n) ) iff lines M is linearly-independent;

theorem 
  the_rank_of M = m implies lines M is linearly-independent;

theorem 
  for M be Diagonal of n,K st the_rank_of M = n holds lines M is
  Basis of n-VectSp_over K;

registration
  let K,n;
  cluster n -VectSp_over K -> finite-dimensional;
end;

theorem 
  dim (n-VectSp_over K) = n;

theorem 
  for M,i,a st for j st j in Seg m holds M*(j,i) = a holds M is
  without_repeated_line iff Segm(M,Seg len M,Seg width M\{i}) is
  without_repeated_line;

theorem 
  for M,i st M is without_repeated_line & lines M is
linearly-independent & for j st j in Seg m holds M*(j,i) = 0.K holds lines Segm
  (M,Seg len M,Seg width M\{i}) is linearly-independent;

theorem 
  for V be VectSp of K for U be finite Subset of V st U is
linearly-independent for u, v be Vector of V st u in U & v in U & u <> v holds
  U\{u} \/ {u+a*v} is linearly-independent;

theorem 
  for V be VectSp of K for u, v be Vector of V holds x in Lin {u,
  v} iff ex a,b st x = a * u + b * v;

theorem 
  for M st lines M is linearly-independent & M is
without_repeated_line for i,j st j in Seg len M & i <> j holds RLine(M,i,Line(M
  ,i) + a*Line(M,j)) is without_repeated_line & lines RLine(M,i,Line(M,i) + a*
  Line(M,j)) is linearly-independent;

theorem 
  P c= Seg m implies lines Segm(M,P,Seg n) c= lines M;

theorem 
  P c= Seg m & lines M is linearly-independent implies lines Segm
  (M,P,Seg n) is linearly-independent;

theorem 
  P c= Seg m & M is without_repeated_line implies Segm(M,P,Seg n)
  is without_repeated_line;

theorem 
  for M be Matrix of m,n,K holds lines M is linearly-independent
  & M is without_repeated_line iff the_rank_of M = m;

theorem 
  for U be Subset of n-VectSp_over K st U c= lines M ex P st P c=
  Seg m & lines Segm(M,P,Seg n) = U & Segm(M,P,Seg n) is without_repeated_line;

theorem 
  for RANK be Element of NAT holds the_rank_of M = RANK iff (ex U be
finite Subset of n-VectSp_over K st U is linearly-independent & U c= lines M &
  card U = RANK) & for W be finite Subset of n-VectSp_over K st W is
  linearly-independent & W c= lines M holds card W <= RANK;














begin 

reserve x,y for set,
  i,j,k,l,m,n for Nat,
  K for Field,
  N for without_zero finite Subset of NAT,
  a,b for Element of K,
  A,B,B1,B2,X,X1,X2 for (Matrix of K),
  A9 for (Matrix of m,n,K),
  B9 for (Matrix of m,k,K);

theorem 
  width A = len B implies (a*A) * B = a * (A*B);

theorem 
  1_K * A = A & a * (b * A) = (a * b) * A;

theorem 
  for K be non empty addLoopStr, f,g,h,w be FinSequence of K st len
  f=len g & len h = len w holds (f^h) + (g^w)= (f+g) ^ (h+w);

theorem 
  for K be non empty multMagma, f,g be FinSequence of K,a be
  Element of K holds a * (f^g) = (a*f) ^ (a*g);

theorem 
  for f be Function for p1,p2,f1,f2 be FinSequence st rng p1 c= dom
  f & rng p2 c= dom f & f1=f*p1 & f2=f*p2 holds f * (p1 ^ p2) = f1 ^ f2;

theorem 
  for f be FinSequence of NAT,n st f is one-to-one & rng f c= Seg n
& for i,j st i in dom f & j in dom f & i < j holds f.i < f.j holds Sgm rng f =
  f;

theorem 
  for K be Abelian add-associative right_zeroed
  right_complementable non empty addLoopStr for p be FinSequence of K for i,j
st i in dom p & j in dom p & i<>j & for k st k in dom p & k<>i & k<>j holds p.k
  =0.K holds Sum p = p/.i+p/.j;

theorem 
  i in Seg m implies Sgm (Seg (n+m)\Seg n).i=n+i;

theorem 
  for D be non empty set, A be Matrix of D for Bx,By,Cx,Cy be
  without_zero finite Subset of NAT st [:Bx,By:] c= Indices A & [:Cx,Cy:] c=
Indices A for B be Matrix of card Bx,card By,D, C be Matrix of card Cx,card Cy,
D st for i,j,bi,bj,ci,cj be Nat st [i,j] in [:Bx,By:]/\[:Cx,Cy:] & bi = Sgm Bx"
.i & bj = Sgm By".j & ci = Sgm Cx".i & cj = Sgm Cy".j holds B*(bi,bj) = C*(ci,
cj) ex M be Matrix of len A,width A,D st Segm(M,Bx,By) = B & Segm(M,Cx,Cy) = C
& for i,j st [i,j] in Indices M\([:Bx,By:]\/[:Cx,Cy:]) holds M*(i,j) = A*(i,j);

theorem 
  for P,Q,Q9 be without_zero finite Subset of NAT st [:P,Q9:] c=
Indices A for i,j st i in dom A \ P & j in Seg width A \ Q & A*(i,j) <> 0.K & Q
c= Q9 & Line(A,i) * Sgm Q9 = card Q9 |-> 0.K holds the_rank_of A > the_rank_of
  Segm(A,P,Q);

theorem 
  for N st N c= dom A & for i st i in dom A \ N holds Line(A,i) =
  width A |-> 0.K holds the_rank_of A=the_rank_of Segm(A,N,Seg width A);

theorem 
  for N st N c= Seg width A & for i st i in Seg width A \ N holds
Col(A,i) = len A |-> 0.K holds the_rank_of A = the_rank_of Segm(A,Seg len A,N);

theorem 
  for V be VectSp of K for U be finite Subset of V for u, v be
Vector of V,a st u in U & v in U holds Lin (U \ {u} \/ {u+a*v}) is Subspace of
  Lin U;

theorem 
  for V be VectSp of K for U be finite Subset of V for u, v be
Vector of V,a st u in U & v in U & (u = v implies (a <> -1_K or u = 0.V)) holds
  Lin (U \ {u} \/ {u+a*v}) = Lin U;

begin 

definition
  let D be non empty set;
  let n,m,k be Nat;
  let A be Matrix of n,m,D;
  let B be Matrix of n,k,D;
  redefine func A^^B -> Matrix of n,width A+width B,D;
end;

theorem 
  for D be non empty set, A be Matrix of n,m,D, B be Matrix of n,k
  ,D for i st i in Seg n holds Line(A^^B,i)=Line(A,i)^Line(B,i);

theorem 
  for D be non empty set, A be Matrix of n,m,D, B be Matrix of n,k
  ,D for i st i in Seg width A holds Col(A^^B,i) = Col(A,i);

theorem 
  for D be non empty set, A be Matrix of n,m,D, B be Matrix of n,k
  ,D for i st i in Seg width B holds Col(A^^B,width A+i) = Col(B,i);

theorem 
  for D be non empty set, A be Matrix of n,m,D, B be Matrix of n,k
  ,D for pA,pB be FinSequence of D st len pA = width A & len pB = width B holds
  ReplaceLine(A^^B,i,pA^pB) = ReplaceLine(A,i,pA) ^^ ReplaceLine(B,i,pB);

theorem 
  for D be non empty set, A be Matrix of n,m,D, B be Matrix of n,k
,D holds Segm(A^^B,Seg n,Seg width A) = A & Segm(A^^B,Seg n,Seg (width A+width
  B)\Seg width A) = B;

theorem 
  for A,B be Matrix of K st len A = len B holds the_rank_of A <=
  the_rank_of (A^^B) & the_rank_of B <= the_rank_of (A^^B);

theorem 
  for A,B be Matrix of K st len A = len B & len A = the_rank_of A holds
  the_rank_of A = the_rank_of (A^^B);

theorem 
  for A,B be Matrix of K st len A = len B & width A = 0 holds A ^^
  B = B & B ^^ A = B;

theorem 
  for A,B be Matrix of K st B = 0.(K,len A,m) holds the_rank_of A
  = the_rank_of (A^^B);

theorem 
  for A,B be Matrix of K st the_rank_of A = the_rank_of (A^^B) &
len A = len B for N st N c= dom A & for i st i in N holds Line(A,i)=width A|->
  0.K holds for i st i in N holds Line(B,i) = width B|->0.K;

begin  


reserve D for non empty set,
  bD for FinSequence of D,
  b,f,g for FinSequence of K,
  MD for Matrix of D;

definition
  let D be non empty set;
  let b be FinSequence of D;
  func LineVec2Mx b -> Matrix of 1,len b,D equals

  <*b*>;
  func ColVec2Mx b -> Matrix of len b,1,D equals

  <*b*>@;
end;

theorem 
  MD = LineVec2Mx bD iff Line(MD,1) = bD & len MD = 1;

theorem 
  ( len MD <> 0 or len bD <> 0 ) implies ( MD = ColVec2Mx bD iff
  Col(MD,1) = bD & width MD = 1 );

theorem 
  len f = len g implies (LineVec2Mx f) + (LineVec2Mx g) = LineVec2Mx (f + g);

theorem 
  len f = len g implies (ColVec2Mx f) + (ColVec2Mx g) = ColVec2Mx (f + g);

theorem 
  a * LineVec2Mx f =LineVec2Mx (a*f);

theorem 
  a * ColVec2Mx f = ColVec2Mx (a*f);

theorem 
  LineVec2Mx (k|->0.K) = 0.(K,1,k);

theorem 
  ColVec2Mx (k|->0.K) = 0.(K,k,1);

begin 

definition
  let K;
  let A,B;
  func Solutions_of(A,B) equals

  {X : len X = width A & width X = width B & A *
  X = B};
end;

theorem 
  Solutions_of(A,B) is non empty implies len A = len B;

theorem 
  X in Solutions_of(A,B) & i in Seg width X & Col(X,i) = len X |-> 0.K
  implies Col(B,i) = len B |-> 0.K;

theorem 
  X in Solutions_of(A,B) implies a*X in Solutions_of(A,a*B) & X in
  Solutions_of(a*A,a*B);

theorem 
  a <> 0.K implies Solutions_of(A,B) = Solutions_of(a*A,a*B);

theorem 
  X1 in Solutions_of(A,B1) & X2 in Solutions_of(A,B2) & width B1 =
  width B2 implies X1 + X2 in Solutions_of(A,B1 + B2);

theorem 
  X in Solutions_of(A9,B9) implies X in Solutions_of(RLine(A9,i,a*
  Line(A9,i)),RLine(B9,i,a*Line(B9,i)));

theorem 
  X in Solutions_of(A9,B9) & j in Seg m implies X in Solutions_of(
  RLine(A9,i,Line(A9,i) + a*Line(A9,j)), RLine(B9,i,Line(B9,i) + a*Line(B9,j)))
;

theorem 
  j in Seg m & (i = j implies a <> -1_K) implies Solutions_of(A9,
B9) = Solutions_of(RLine(A9,i,Line(A9,i) + a*Line(A9,j)), RLine(B9,i,Line(B9,i)
  + a*Line(B9,j)));

theorem 
  X in Solutions_of(A,B) & i in dom A & Line(A,i) = width A |-> 0.
  K implies Line(B,i) = width B |-> 0.K;

theorem 
  for nt be Element of n-tuples_on NAT st rng nt c= dom A & n>0
holds Solutions_of(A,B) c= Solutions_of(Segm(A,nt,Sgm Seg width A), Segm(B,nt,
  Sgm Seg width B));

theorem 
  for nt be Element of n-tuples_on NAT st rng nt c= dom A & dom A
= dom B & n > 0 & for i st i in (dom A) \ rng nt holds Line(A,i) = width A |->
0.K & Line(B,i) = width B |-> 0.K holds Solutions_of(A,B) = Solutions_of(Segm(A
  ,nt,Sgm Seg width A), Segm(B,nt,Sgm Seg width B));

theorem 
  for N st N c= dom A & N is non empty holds Solutions_of(A,B) c=
  Solutions_of(Segm(A,N,Seg width A), Segm(B,N,Seg width B));

theorem 
  for N st N c= dom A & N is non empty & dom A = dom B & for i st
i in (dom A) \ N holds Line(A,i) = width A |-> 0.K & Line(B,i) = width B |-> 0.
  K holds Solutions_of(A,B) = Solutions_of(Segm(A,N,Seg width A), Segm(B,N,Seg
  width B));

theorem 
  i in dom A & len A > 1 implies Solutions_of(A,B) c= Solutions_of
  (DelLine(A,i),DelLine(B,i));

theorem 
  for A,B,i st i in dom A & len A > 1 & Line(A,i) = width A |-> 0.K & i
in dom B & Line(B,i) = width B |-> 0.K holds Solutions_of(A,B) = Solutions_of(
  DelLine(A,i),DelLine(B,i));

theorem 
  for A be Matrix of n,m,K, B be Matrix of n,k,K for P be Function of
Seg n,Seg n holds Solutions_of(A,B) c= Solutions_of(A*P,B*P) & (P is one-to-one
  implies Solutions_of(A,B) = Solutions_of(A*P,B*P));

theorem 
  for A be Matrix of n,m,K, N st card N = n & N c= Seg m & Segm(A,
Seg n,N) = 1.(K,n) & n > 0 ex MVectors be Matrix of m-'n,m,K st Segm(MVectors,
Seg (m-'n),Seg m \ N) = 1.(K,m-'n) & Segm(MVectors,Seg (m-'n),N) = -Segm(A,Seg
n,Seg m \N)@ & for l for M be Matrix of m,l,K st for i st i in Seg l holds (ex
j st j in Seg (m-'n) & Col(M,i) = Line(MVectors,j)) or Col(M,i) = m|->0.K holds
  M in Solutions_of(A,0.(K,n,l));

theorem 
  for A be Matrix of n,m,K, B be Matrix of n,l,K, N st card N = n
& N c= Seg m & n>0 & Segm(A,Seg n,N) = 1.(K,n) ex X be Matrix of m,l,K st Segm(
X,Seg m \ N,Seg l) = 0.(K,m-'n,l) & Segm(X,N,Seg l) = B & X in Solutions_of(A,B
  );

theorem 
  for A be Matrix of 0,n,K, B be Matrix of 0,m,K holds Solutions_of(A,B) = {{}}
;

theorem 
  for B be Matrix of K st Solutions_of(0.(K,n,k),B) is non empty
  holds B = 0.(K,n,width B);

theorem 
  for A be Matrix of n,k,K, B be Matrix of n,m,K st n > 0 holds x
  in Solutions_of(A,B) implies x is Matrix of k,m,K;

theorem 
  n > 0 & k > 0 implies Solutions_of(0.(K,n,k),0.(K,n,m)) = {X
  where X is Matrix of k,m,K:not contradiction};

theorem 
  n>0 & Solutions_of(0.(K,n,0),0.(K,n,m)) is non empty implies m = 0;

theorem 
  Solutions_of(0.(K,n,0),0.(K,n,0)) = {{}};

begin 

scheme 

  GAUSS1{ K() -> Field, n,m,m9() -> Nat, A() -> Matrix of n(),m(),K(), B() ->
  Matrix of n(),m9(),K(), F(Matrix of n(),m9(),K(),Nat,Nat,Element of K())->
  Matrix of n(),m9(),K(), P[set,set]}: ex A9 be Matrix of n(),m(),K(), B9 be
Matrix of n(),m9(),K(), N be without_zero finite Subset of NAT st N c= Seg m()
& the_rank_of A() = the_rank_of A9 & the_rank_of A() = card N & P[A9,B9] & Segm
(A9,Seg card N,N) is diagonal & ( for i st i in Seg card N holds A9*(i,Sgm N/.i
) <> 0.K() ) & ( for i st i in dom A9 & i > card N holds Line(A9,i)= m() |->
0.K(
) ) & for i,j st i in Seg card N & j in Seg width A9 & j < Sgm N.i holds A9*(i,
  j) = 0.K()
provided
 P[A(),B()] and
 for A9 be Matrix of n(),m(),K(), B9 be Matrix of n(),m9(),K() st P[
A9,B9] for i,j st i <> j & j in dom A9 for a be Element of K() holds P[RLine(A9
,i,Line(A9,i) + a*Line(A9,j)),F(B9,i,j,a)];

scheme 

  GAUSS2{ K() -> Field, n,m,m9() -> Nat, A() -> Matrix of n(),m(),K(), B() ->
  Matrix of n(),m9(),K(), F(Matrix of n(),m9(),K(),Nat,Nat,Element of K()) ->
  Matrix of n(),m9(),K(), P[set,set]}: ex A9 be Matrix of n(),m(),K(), B9 be
Matrix of n(),m9(),K(), N be without_zero finite Subset of NAT st N c= Seg m()
& the_rank_of A() = the_rank_of A9 & the_rank_of A() = card N & P[A9,B9] & Segm
(A9,Seg card N,N) = 1.(K(),card N) & ( for i st i in dom A9 & i > card N holds
Line(A9,i) = m() |->0.K() ) & for i,j st i in Seg card N & j in Seg width A9 &
j < Sgm N.i holds A9*(i,j) = 0.K()
provided
 P[A(),B()] and
 for A9 be Matrix of n(),m(),K(), B9 be Matrix of n(),m9(),K() st P[
A9,B9] for a be Element of K() for i,j st j in dom A9 & (i = j implies a <> -
1_K() ) holds P[RLine(A9,i,Line(A9,i) + a*Line(A9,j)),F(B9,i,j,a)];

begin 


theorem 
  for A,B be Matrix of K st len A = len B & (width A = 0 implies
width B = 0) holds the_rank_of A = the_rank_of (A^^B) iff Solutions_of(A,B) is
  non empty;

begin 

definition
  let K;
  let A be Matrix of K;
  let b be FinSequence of K;
  func Solutions_of(A,b) equals

  {f : ColVec2Mx f in Solutions_of(A,ColVec2Mx b
  )};
end;

theorem 
  for x st x in Solutions_of(A,ColVec2Mx b) ex f st x = ColVec2Mx
  f & len f = width A;

theorem 
  for f st ColVec2Mx f in Solutions_of(A,ColVec2Mx b) holds len f = width A;

definition
  let K;
  let A be Matrix of K;
  let b be FinSequence of K;
  redefine func Solutions_of(A,b) -> Subset of (width A)-VectSp_over K;
end;

registration
  let K;
  let A be Matrix of K;
  let k be Element of NAT;
  cluster Solutions_of(A,k|->0.K) -> linearly-closed for Subset of (width A)
    -VectSp_over K;
end;

theorem 
  Solutions_of(A,b) is non empty & width A = 0 implies len A=0;

theorem 
  width A <> 0 or len A = 0 implies Solutions_of(A,len A|->0.K) is non empty;

definition
  let K;
  let A be Matrix of K;
  assume
 width A = 0 implies len A = 0;
  func Space_of_Solutions_of(A) -> strict Subspace of (width A)-VectSp_over K
  means


  the carrier of it = Solutions_of(A,len A|->0.K);
end;

theorem 
  for A be (Matrix of K), b be FinSequence of K st Solutions_of(A,b) is
  non empty holds Solutions_of(A,b) is Coset of Space_of_Solutions_of A;

theorem 
  for A st ( width A = 0 implies len A = 0 ) & the_rank_of A = 0
  holds Space_of_Solutions_of A = (width A)-VectSp_over K;

theorem 
  for A st Space_of_Solutions_of A = (width A)-VectSp_over K holds
  the_rank_of A = 0;

theorem 
  for i,j st j in Seg m & n>0 & (i = j implies a <> -1_K) holds
Space_of_Solutions_of A9 = Space_of_Solutions_of RLine(A9,i,Line(A9,i) + a*Line
  (A9,j));

theorem 
  for N st N c= dom A & N is non empty & width A > 0 & for i st i
in (dom A) \ N holds Line(A,i) = width A |-> 0.K holds Space_of_Solutions_of A
  = Space_of_Solutions_of Segm(A,N,Seg width A);

theorem 
  for A be Matrix of n,m,K, N st card N = n & N c= Seg m & Segm(A,
Seg n,N) = 1.(K,n) & n > 0 & m-'n>0 ex MVectors be Matrix of m-'n,m,K st Segm(
  MVectors,Seg (m-'n),Seg m \ N) = 1.(K,m-'n) & Segm(MVectors,Seg (m-'n),N) = -
  Segm(A,Seg n,Seg m \N)@ & Lin(lines MVectors) = Space_of_Solutions_of A;



theorem 
  for A st ( width A = 0 implies len A = 0 ) holds dim
  Space_of_Solutions_of A = width A - the_rank_of A;

theorem 
  for M be Matrix of n,m,K, i,j,a st M is without_repeated_line &
  j in dom M & (i = j implies a<>-1_K) holds Lin lines M = Lin lines RLine(M,i,
  Line(M,i)+a*Line(M,j));

theorem 
  for W be Subspace of m-VectSp_over K ex A be Matrix of dim W,m,K
, N be without_zero finite Subset of NAT st N c= Seg m & dim W = card N & Segm(
  A,Seg dim W,N)=1.(K,dim W) & the_rank_of A = dim W & lines A is Basis of W;

theorem 
  for W be strict Subspace of m-VectSp_over K st dim W < m ex A be
Matrix of m-'dim W,m,K, N be without_zero finite Subset of NAT st card N = m-'
  dim W & N c= Seg m & Segm(A,Seg(m-'dim W),N) = 1.(K,m-'dim W) & W =
  Space_of_Solutions_of A;

theorem 
  for A,B be Matrix of K st width A = len B & ( width A = 0
  implies len A = 0 ) & ( width B = 0 implies len B = 0 ) holds
  Space_of_Solutions_of B is Subspace of Space_of_Solutions_of (A*B);

theorem 
  for A,B be Matrix of K st width A = len B holds the_rank_of (A*B) <=
  the_rank_of A & the_rank_of (A*B) <= the_rank_of B;

theorem 
  for A be Matrix of n,n,K, B be Matrix of K st Det A <> 0.K &
width A = len B & ( width B = 0 implies len B = 0 ) holds Space_of_Solutions_of
  B = Space_of_Solutions_of (A*B);

theorem 
  for A be Matrix of n,n,K, B be Matrix of K st width A = len B &
  Det A <> 0.K holds the_rank_of (A*B) = the_rank_of B;

theorem 
  for A be Matrix of n,n,K, B be Matrix of K st len A = width B & Det A
  <> 0.K holds the_rank_of (B*A) = the_rank_of B;














begin

reserve i,n for Nat,
  K for Field,
  M1,M2,M3,M4 for Matrix of n,K;

definition
  let n be Nat, K be Field, M1 be Matrix of n,K;
  attr M1 is Idempotent means


  M1*M1=M1;
  attr M1 is Nilpotent means


  M1*M1=0.(K,n);
  attr M1 is Involutory means


  M1*M1=1.(K,n);
  attr M1 is Self_Reversible means


  M1 is invertible & M1~=M1;
end;

theorem 
  1.(K,n) is Idempotent Involutory;

theorem 
  0.(K,n) is Idempotent Nilpotent;

registration
  let n be Nat, K be Field;
  cluster 1.(K,n) -> Idempotent Involutory;
  cluster 0.(K,n) -> Idempotent Nilpotent;
end;

theorem 
  n>0 implies (M1 is Idempotent iff M1@ is Idempotent);

theorem 
  M1 is Involutory implies M1 is invertible;

theorem 
  M1 is Idempotent & M2 is Idempotent & M1 commutes_with M2 implies M1*
  M1 commutes_with M2*M2;

theorem 
  n>0 & M1 is Idempotent & M2 is Idempotent & M1 commutes_with M2 & M1*
  M2=0.(K,n) implies M1+M2 is Idempotent;

theorem 
  M1 is Idempotent & M2 is Idempotent & M1*M2=-(M2*M1) implies M1+M2 is
  Idempotent;

theorem 
  M1 is Idempotent & M2 is invertible implies (M2~)*M1*M2 is Idempotent;

theorem 
  M1 is invertible Idempotent implies M1~ is Idempotent;

theorem 
  M1 is invertible Idempotent implies M1=1.(K,n);

theorem 
  M1 is Idempotent & M2 is Idempotent & M1 commutes_with M2 implies M1*
  M2 is Idempotent;

theorem 
  M1 is Idempotent & M2 is Idempotent & M1 commutes_with M2 implies M1@*
  M2@ is Idempotent;

theorem 
  M1 is Idempotent & M2 is Idempotent & M1 is invertible implies M1*M2
  is Idempotent;

theorem 
  M1 is Idempotent Orthogonal implies M1 is symmetric;

theorem 
  M2*M1=1.(K,n) implies M1*M2 is Idempotent;

theorem 
  M1 is Idempotent Orthogonal implies M1=1.(K,n);

theorem 
  M1 is symmetric implies M1*M1@ is symmetric;

theorem 
  M1 is symmetric implies M1@*M1 is symmetric;

theorem 
  M1 is invertible & M1*M2=M1*M3 implies M2=M3;

theorem 
  M1 is invertible & M2*M1=M3*M1 implies M2=M3;

theorem 
  M1 is invertible & M2*M1=0.(K,n) implies M2=0.(K,n);

theorem 
  M1 is invertible & M2*M1=0.(K,n) implies M2=0.(K,n);

theorem 
  M1 is Nilpotent & M1 commutes_with M2 & n>0 implies M1*M2 is Nilpotent;

theorem 
  n>0 & M1 is Nilpotent & M2 is Nilpotent & M1 commutes_with M2 & M1*M2=
  0.(K,n) implies M1+M2 is Nilpotent;

theorem 
  M1 is Nilpotent & M2 is Nilpotent & M1*M2=-M2*M1 & n>0 implies M1+M2
  is Nilpotent;

theorem 
  M1 is Nilpotent & n>0 implies M1@ is Nilpotent;

theorem 
  M1 is Nilpotent Idempotent implies M1=0.(K,n);

theorem 
  n>0 implies 0.(K,n)<>1.(K,n);

theorem 
  n>0 & M1 is Nilpotent implies not M1 is invertible;

theorem 
  M1 is Self_Reversible implies M1 is Involutory;

theorem 
  1.(K,n) is Self_Reversible;

theorem 
  M1 is Self_Reversible Idempotent implies M1=1.(K,n);

theorem 
  M1 is Self_Reversible symmetric implies M1 is Orthogonal;

definition
  let n be Nat, K be Field, M1,M2 be Matrix of n,K;
  pred M1 is_similar_to M2 means


  ex M be Matrix of n,K st M is invertible & M1=M~*M2*M;
  reflexivity;
  symmetry;
end;

theorem 
  M1 is_similar_to M2 & M2 is_similar_to M3 implies M1 is_similar_to M3;

theorem 
  M1 is_similar_to M2 & M2 is Idempotent implies M1 is Idempotent;

theorem 
  M1 is_similar_to M2 & M2 is Nilpotent & n>0 implies M1 is Nilpotent;

theorem 
  M1 is_similar_to M2 & M2 is Involutory implies M1 is Involutory;

theorem 
  M1 is_similar_to M2 & n>0 implies M1+1.(K,n) is_similar_to M2+1.(K,n);

theorem 
  M1 is_similar_to M2 & n>0 implies M1+M1 is_similar_to M2+M2;

theorem 
  M1 is_similar_to M2 & n>0 implies M1+M1+M1 is_similar_to M2+M2+M2;

theorem 
  M1 is invertible implies M2*M1 is_similar_to M1*M2;

theorem 
  M2 is invertible & M1 is_similar_to M2 implies M1 is invertible;

theorem 
  M2 is invertible & M1 is_similar_to M2 implies M1~ is_similar_to M2~;

definition
  let n be Nat, K be Field, M1,M2 be Matrix of n,K;
  pred M1 is_congruent_Matrix_of M2 means


  ex M be Matrix of n,K st M is invertible & M1=M@*M2*M;
  reflexivity;
end;

theorem 
  M1 is_congruent_Matrix_of M2 & n>0 implies M2 is_congruent_Matrix_of M1;

theorem 
  M1 is_congruent_Matrix_of M2 & M2 is_congruent_Matrix_of M3 & n>0
  implies M1 is_congruent_Matrix_of M3;

theorem 
  M1 is_congruent_Matrix_of M2 & n>0 implies M1+M1 is_congruent_Matrix_of M2+M2
;

theorem 
  M1 is_congruent_Matrix_of M2 & n>0 implies M1+M1+M1
  is_congruent_Matrix_of M2+M2+M2;

theorem 
  M1 is Orthogonal implies M2*M1 is_congruent_Matrix_of M1*M2;

theorem 
  M2 is invertible & M1 is_congruent_Matrix_of M2 & n>0 implies M1 is
  invertible;

theorem 
  M1 is_congruent_Matrix_of M2 & n>0 implies M1@ is_congruent_Matrix_of M2@;

theorem 
  M4 is Orthogonal implies M4@*M2*M4 is_similar_to M2;

definition
  let n be Nat, K be Field, M be Matrix of n,K;
  func Trace M -> Element of K equals

  Sum diagonal_of_Matrix M;
end;

theorem 
  Trace M1=Trace M1@;

theorem 
  Trace (M1+M2)=Trace M1+Trace M2;

theorem 
  Trace (M1+M2+M3)=Trace M1+Trace M2+Trace M3;

theorem 
  Trace (0.(K,n))=0.K;

theorem 
  Trace (-M1) = -Trace M1;

theorem 
  -(Trace (-M1))=Trace M1;

theorem 
  Trace (M1+-M1)=0.K;

theorem 
  Trace (M1-M2)=Trace M1-Trace M2;

theorem 
  Trace (M1-M2+M3)=Trace M1-Trace M2+Trace M3;

theorem 
  Trace (M1+M2-M3)=Trace M1+Trace M2-Trace M3;

theorem 
  Trace (M1-M2-M3)=Trace M1-Trace M2-Trace M3;














begin 

reserve i,j,m,n,k for Nat,
  x,y for set,
  K for Field,
  a,a1,a2 for Element of K,
  D for non empty set,
  d,d1,d2 for Element of D,
  M,M1,M2 for (Matrix of D),
  A,A1,A2,B1,B2 for (Matrix of K),
  f,g for FinSequence of NAT;

theorem 
  for K be non empty addLoopStr for f1,f2,g1,g2 be FinSequence of K
  st len f1 = len f2 holds (f1+f2)^(g1+g2)=(f1^g1)+(f2^g2);

theorem 
  for f,g be FinSequence of D st i in dom f holds Del(f^g,i) = Del( f,i)^g;

theorem 
  for f,g be FinSequence of D st i in dom g holds Del(f^g,i+len f)= f^Del(g,i);

theorem 
  i in Seg (n+1) implies Del((n+1) |->d,i)=n |-> d;

theorem 
  Product (n|->a) = (power K).(a,n);

definition
  let f;
  let i be Nat such that
 i in Seg (Sum f);
  func min(f,i) -> Element of NAT means


  i <= Sum(f|it) & it in dom f & for j st i<=Sum (f|j) holds it <= j;
end;

theorem 
  i in dom f & f.i <> 0 implies min(f,Sum(f|i)) = i;

theorem 
  i in Seg (Sum f) implies min(f,i)-'1 = min(f,i) - 1 & Sum(f| (min(
  f,i)-'1))<i;

theorem 
  i in Seg (Sum f) implies min(f^g,i)=min(f,i);

theorem 
  i in Seg (Sum f +Sum g)\Seg Sum f implies min(f^g,i)=min(g,i-'Sum
  f)+len f & i-'Sum f = i - Sum f;

theorem 
  i in dom f & j in Seg (f/.i) implies j +Sum (f| (i-'1)) in Seg
  Sum (f|i) & min(f,j+Sum (f| (i-'1)))=i;

theorem 
  for i,j st i <= len f & j <= len f & Sum (f|i) = Sum (f|j) & ( i in
  dom f implies f.i <> 0) & ( j in dom f implies f.j <> 0) holds i = j;

begin 

definition
  let D;
  let F be FinSequence of (D**);
  attr F is Matrix-yielding means


  for i st i in dom F holds F.i is Matrix of D;
end;

registration
  let D;
  cluster Matrix-yielding for FinSequence of D**;
end;

definition
  let D;
  mode FinSequence_of_Matrix of D is Matrix-yielding FinSequence of D**;
end;

definition
  let K;
  mode FinSequence_of_Matrix of K is Matrix-yielding FinSequence of (the
    carrier of K)**;
end;

theorem 
  {} is FinSequence_of_Matrix of D;

reserve F,F1,F2 for FinSequence_of_Matrix of D,
  G,G9,G1,G2 for FinSequence_of_Matrix of K;

definition
  let D,F,x;
  redefine func F.x -> Matrix of D;
end;

definition
  let D,F1,F2;
  redefine func F1^F2 -> FinSequence_of_Matrix of D;
end;

definition
  let D,M1;
  redefine func <* M1 *> -> FinSequence_of_Matrix of D;
  let M2;
  redefine func <* M1,M2 *> -> FinSequence_of_Matrix of D;
end;

definition
  let D,n,F;
  redefine func F|n -> FinSequence_of_Matrix of D;
  redefine func F/^n -> FinSequence_of_Matrix of D;
end;

begin 

definition
  let D,F;
  func Len F -> FinSequence of NAT means


  dom it = dom F & for i st i in dom it holds it.i=len (F.i);
  func Width F -> FinSequence of NAT means


  dom it = dom F & for i st i in dom it holds it.i=width (F.i);
end;

definition
  let D,F;
  redefine func Len F -> Element of (len F)-tuples_on NAT;
  redefine func Width F -> Element of (len F)-tuples_on NAT;
end;

theorem 
  Sum Len F = 0 implies Sum Width F = 0;

theorem 
  Len (F1 ^ F2) = Len F1 ^ Len F2;

theorem 
  Len <*M*> = <*len M*>;

theorem 
  Sum Len <*M1,M2*> = len M1 + len M2;

theorem 
  Len (F1|n) = (Len F1) |n;

theorem 
  Width (F1 ^ F2)= Width F1 ^ Width F2;

theorem 
  Width <*M*> = <*width M*>;

theorem 
  Sum Width <*M1,M2*>=width M1+width M2;

theorem 
  Width (F1|n) =(Width F1) |n;

begin 

definition
  let D;
  let d be Element of D;
  let F be FinSequence_of_Matrix of D;
  func block_diagonal(F,d) -> Matrix of D means


  len it = Sum Len F &
width it = Sum Width F & for i,j st [i,j] in Indices it holds (j<=Sum((Width F)
| (min(Len F,i)-'1)) or j>Sum ((Width F) |min(Len F,i)) implies it*(i,j) = d)
& (
Sum((Width F) | (min(Len F,i)-'1)) < j & j <= Sum((Width F) |min(Len F,i))
implies
it*(i,j) = F.min(Len F,i)*(i-'Sum((Len F) | (min(Len F,i)-'1)),
j-'Sum ((Width F) | (min(Len F,i)-'1))));
end;

definition
  let D;
  let d be Element of D;
  let F be FinSequence_of_Matrix of D;
  redefine func block_diagonal(F,d) -> Matrix of Sum Len F,Sum Width F,D;
end;

theorem 
  for F be FinSequence_of_Matrix of D st F={} holds block_diagonal(F,d)= {};

theorem 
  for M be Matrix of Sum Len (<*M1,M2*>),Sum Width (<*M1,M2*>),D
holds M = block_diagonal(<*M1,M2*>,d) iff for i holds (i in dom M1 implies Line
  (M,i)=Line(M1,i)^(width M2 |-> d)) & (i in dom M2 implies Line(M,i+len M1)=(
  width M1|->d)^Line(M2,i));

theorem 
  for M be Matrix of Sum Len (<*M1,M2*>),Sum Width (<*M1,M2*>),D
  holds M = block_diagonal(<*M1,M2*>,d) iff for i holds (i in Seg width M1
implies Col(M,i) = Col(M1,i)^(len M2 |-> d)) & (i in Seg width M2 implies Col(M
  ,i+width M1)=(len M1|->d)^Col(M2,i));

theorem 
  Indices block_diagonal(F1,d1) is Subset of Indices block_diagonal(F1^F2,d2);

theorem 
  [i,j] in Indices block_diagonal(F1,d) implies block_diagonal(F1,
  d)*(i,j) = block_diagonal(F1^F2,d)*(i,j);

theorem 
  [i,j] in Indices block_diagonal(F2,d1) iff i>0 & j>0 & [i+Sum
  Len F1,j+Sum Width F1] in Indices block_diagonal(F1^F2,d2);

theorem 
  [i,j] in Indices block_diagonal(F2,d) implies block_diagonal(F2,
  d)*(i,j) = block_diagonal(F1^F2,d)*(i+Sum Len F1,j+Sum Width F1);

theorem 
  [i,j] in Indices block_diagonal(F1^F2,d) & (i <= Sum Len F1 & j
> Sum Width F1 or i > Sum Len F1 & j <= Sum Width F1) implies block_diagonal(F1
  ^F2,d)*(i,j) = d;

theorem 
  for i,j,k st i in dom F & [j,k] in Indices F.i holds [j+Sum ((
Len F) | (i-'1)), k+Sum((Width F) | (i-'1))] in Indices block_diagonal(F,d) &
(F.i)*(j,k) = block_diagonal(F,d)*(j+Sum ((Len F) | (i-'1)), k+Sum((Width F) |
(i-'1)));

theorem 
  i in dom F implies F.i = Segm(block_diagonal(F,d),(Seg Sum((Len
F) |i))\Seg Sum((Len F) | (i-'1)), (Seg Sum((Width F) |i))\Seg Sum((Width F)
| (i-'1)
  ));

theorem 
  M = Segm(block_diagonal(<*M*>^F,d),Seg len M,Seg width M);

theorem 
  M = Segm(block_diagonal(F^<*M*>,d),Seg (len M+Sum Len F)\Seg Sum
  Len F, Seg (width M+Sum Width F)\Seg Sum Width F);

theorem 
  block_diagonal(<*M*>,d) = M;

theorem 
  block_diagonal(F1^F2,d) = block_diagonal(<*block_diagonal(F1,d) *>^F2,d);

theorem 
  block_diagonal(F1^F2,d) = block_diagonal(F1^<*block_diagonal(F2, d)*>,d);

theorem 
  i in Seg Sum Len F & m = min(Len F,i) implies Line(block_diagonal(F,d)
,i) = (Sum (Width F| (m-'1)) |->d)^ Line(F.m,i-'Sum (Len F| (m-'1)))^
((Sum Width F-'Sum (Width F|m)) |->d);

theorem 
  i in Seg Sum Width F & m = min(Width F,i) implies Col(block_diagonal(F
,d),i) = (Sum (Len F| (m-'1)) |->d)^ Col(F.m,i-'Sum (Width F| (m-'1)))^
((Sum Len F-'Sum (Len F|m)) |->d);

theorem 
  for M1,M2,N1,N2 be Matrix of D st len M1=len N1 & width M1=width N1 &
  len M2=len N2 & width M2=width N2 & block_diagonal(<*M1,M2*>,d1) =
  block_diagonal(<*N1,N2*>,d2) holds M1 = N1 & M2= N2;

theorem 
  M={} implies block_diagonal(F^<*M*>,d) = block_diagonal(F,d) &
  block_diagonal(<*M*>^F,d) = block_diagonal(F,d);

theorem 
  i in dom A & width A = width DelLine(A,i) implies DelLine(
  block_diagonal(<*A*>^G,a),i) = block_diagonal(<*DelLine(A,i)*>^G,a);

theorem 
  i in dom A & width A = width DelLine(A,i) implies DelLine(
  block_diagonal(G^<*A*>,a),Sum Len G+i) = block_diagonal(G^<*DelLine(A,i)*>,a)
;

theorem 
  i in Seg width A implies DelCol(block_diagonal(<*A*>^G,a),i) =
  block_diagonal(<*DelCol(A,i)*>^G,a);

theorem 
  i in Seg width A implies DelCol(block_diagonal(G^<*A*>,a),i+Sum
  Width G) = block_diagonal(G^<*DelCol(A,i)*>,a);

definition
  let D;
  let F be FinSequence of (D**);
  attr F is Square-Matrix-yielding means


  for i st i in dom F ex n st F. i is Matrix of n,D;
end;

registration
  let D;
  cluster Square-Matrix-yielding for FinSequence of D**;
end;

registration
  let D;
  cluster Square-Matrix-yielding -> Matrix-yielding for FinSequence of D**;
end;

definition
  let D;
  mode FinSequence_of_Square-Matrix of D is Square-Matrix-yielding FinSequence
    of D**;
end;

definition
  let K;
  mode FinSequence_of_Square-Matrix of K is Square-Matrix-yielding FinSequence
    of (the carrier of K)**;
end;

reserve S,S1,S2 for FinSequence_of_Square-Matrix of D,
  R,R1,R2 for FinSequence_of_Square-Matrix of K;

theorem 
  {} is FinSequence_of_Square-Matrix of D;

definition
  let D,S,x;
  redefine func S.x -> Matrix of len (S.x),D;
end;

definition
  let D,S1,S2;
  redefine func S1^S2 -> FinSequence_of_Square-Matrix of D;
end;

definition
  let D,n;
  let M1 be Matrix of n,D;
  redefine func <* M1 *> -> FinSequence_of_Square-Matrix of D;
end;

definition
  let D,n,m;
  let M1 be Matrix of n,D;
  let M2 be Matrix of m,D;
  redefine func <* M1,M2 *> -> FinSequence_of_Square-Matrix of D;
end;

definition
  let D,n,S;
  redefine func S|n -> FinSequence_of_Square-Matrix of D;
  redefine func S/^n -> FinSequence_of_Square-Matrix of D;
end;

theorem 
  Len S = Width S;

definition
  let D;
  let d be Element of D;
  let S be FinSequence_of_Square-Matrix of D;
  redefine func block_diagonal(S,d) -> Matrix of Sum Len S,D;
end;

theorem 
  for A be (Matrix of n,K) st i in dom A & j in Seg n holds
Deleting(block_diagonal(<*A*>^R,a),i,j)= block_diagonal(<*Deleting(A,i,j)*>^R,a
  );

theorem 
  for A be Matrix of n,K st i in dom A & j in Seg n holds Deleting(
block_diagonal(R^<*A*>,a),i+Sum Len R,j+Sum Len R)= block_diagonal(R^<*Deleting
  (A,i,j)*>,a);

definition
  let K,R;
  func Det R -> FinSequence of K means


  dom it = dom R & for i st i in dom it holds it.i = Det R.i;
end;

definition
  let K,R;
  redefine func Det R-> Element of (len R)-tuples_on the carrier of K;
end;

reserve N for (Matrix of n,K),
  N1 for (Matrix of m,K);

theorem 
  Det <*N*> = <*Det N*>;

theorem 
  Det (R1^R2) = Det R1^Det R2;

theorem 
  Det (R|n) = (Det R) |n;

theorem 
  Det block_diagonal(<*N,N1*>,0.K) = Det N * Det N1;

theorem 
  Det block_diagonal(R,0.K) = Product (Det R);

theorem 
  len A1 <> width A1 & N = block_diagonal(<*A1,A2*>,0.K) implies Det N = 0.K;

theorem 
  Len G <> Width G implies for M be Matrix of n,K st M = block_diagonal(
  G,0.K) holds Det M = 0.K;

begin 

definition
  let K;
  let f be FinSequence of NAT;
  func 1.(K,f) -> FinSequence_of_Square-Matrix of K means


  dom it = dom f & for i st i in dom it holds it.i = 1.(K,f.i);
end;

theorem 
  Len 1.(K,f) = f & Width 1.(K,f) = f;

theorem 
  for i be Element of NAT holds 1.(K,<*i*>) = <*1.(K,i)*>;

theorem 
  1.(K,f^g) = 1.(K,f)^1.(K,g);

theorem 
  1.(K,f|n) = 1.(K,f) |n;

theorem 
  block_diagonal(<*1.(K,i),1.(K,j)*>,0.K)=1.(K,i+j);

theorem 
  block_diagonal(1.(K,f),0.K) = 1.(K,Sum f);

reserve p,p1 for FinSequence of K;

begin 

definition
  let K,G,p;
  func mlt(p,G) -> FinSequence_of_Matrix of K means


  dom it = dom G & for i st i in dom it holds it.i = p/.i * G.i;
end;

registration
  let K;
  let R,p;
  cluster mlt(p,R) -> Square-Matrix-yielding;
end;

theorem 
  Len mlt(p,G) = Len G & Width mlt(p,G) = Width G;

theorem 
  mlt(p,<*A*>)=<*p/.1*A*>;

theorem 
  len G = len p & len G1 <=len p1 implies mlt(p^p1,G^G1) = mlt(p,G )^mlt(p1,G1)
;

theorem 
  a*block_diagonal(G,a1) = block_diagonal(mlt(len G|->a,G),a*a1);

definition
  let K;
  let G1,G2 be FinSequence_of_Matrix of K;
  func G1(+)G2 -> FinSequence_of_Matrix of K means


  dom it = dom G1 & for i st i in dom it holds it.i= G1.i + G2.i;
end;

registration
  let K;
  let R,G;
  cluster R(+)G -> Square-Matrix-yielding;
end;

theorem 
  Len (G1(+)G2) = Len G1 & Width (G1(+)G2) = Width G1;

theorem 
  len G = len G9 implies (G^G1)(+)(G9^G2) = (G(+)G9)^(G1(+)G2);

theorem 
  <*A*>(+)G = <*A + G.1*>;

theorem 
  <*A1*>(+)<*A2*> = <* A1+A2 *>;

theorem 
  <*A1,B1*>(+)<*A2,B2*> = <*A1+A2,B1+B2*>;

theorem 
  len A1 = len B1 & len A2 = len B2 & width A1 = width B1 & width
A2 = width B2 implies block_diagonal(<*A1,A2*>,a1) + block_diagonal(<*B1,B2*>,
  a2) = block_diagonal(<*A1,A2*>(+)<*B1,B2*>,a1+a2);

theorem 
  Len R1 = Len R2 & Width R1 = Width R2 implies block_diagonal(R1,a1) +
  block_diagonal(R2,a2) = block_diagonal(R1(+)R2,a1+a2);

definition
  let K;
  let G1,G2 be FinSequence_of_Matrix of K;
  func G1(#)G2 -> FinSequence_of_Matrix of K means


  dom it = dom G1 & for i st i in dom it holds it.i= G1.i * G2.i;
end;

theorem 
  Width G1 = Len G2 implies Len (G1(#)G2) = Len G1 & Width (G1(#)
  G2) = Width G2;

theorem 
  len G = len G9 implies (G^G1)(#)(G9^G2) = (G(#)G9)^(G1(#)G2);

theorem 
  <*A*>(#)G = <*A * G.1*>;

theorem 
  <*A1*>(#)<*A2*> = <* A1*A2 *>;

theorem 
  <*A1,B1*>(#)<*A2,B2*> = <*A1*A2,B1*B2*>;

theorem 
  width A1 = len B1 & width A2 = len B2 implies block_diagonal(<*
A1,A2*>,0.K)*block_diagonal(<*B1,B2*>,0.K) = block_diagonal(<*A1,A2*>(#)(<*B1,
  B2*>),0.K);

theorem 
  Width R1 = Len R2 implies block_diagonal(R1,0.K)*block_diagonal(R2,0.K
  )= block_diagonal(R1(#)R2,0.K);














begin 

reserve i, j, m, n, k for Nat,
  x, y for set,
  K for Field,
  a,a1 for Element of K;

theorem 
  for V be VectSp of K for W1,W2,W12 be Subspace of V for U1,U2 be
Subspace of W12 st U1 = W1 & U2 = W2 holds W1 /\ W2 = U1 /\ U2 & W1 + W2 = U1 +
  U2;

theorem 
  for V be VectSp of K for W1,W2 be Subspace of V st W1/\W2=(0).V
for B1 be linearly-independent Subset of W1, B2 be linearly-independent Subset
  of W2 holds B1\/B2 is linearly-independent Subset of W1+W2;

theorem 
  for V be VectSp of K for W1,W2 be Subspace of V st W1/\W2 = (0).V
  for B1 be Basis of W1,B2 be Basis of W2 holds B1\/B2 is Basis of W1+W2;

theorem 
  for V be finite-dimensional VectSp of K, B be OrdBasis of (Omega).V
  holds B is OrdBasis of V;

theorem 
  for V1 be VectSp of K for A be finite Subset of V1 st dim Lin(A) =
  card A holds A is linearly-independent;

theorem 
  for V be VectSp of K for A be finite Subset of V holds dim Lin A <= card A;

begin 

reserve V1,V2,V3 for finite-dimensional VectSp of K,
  f for Function of V1,V2,

  b1,b19 for OrdBasis of V1,
  B1 for FinSequence of V1,
  b2 for OrdBasis of V2,
  B2 for FinSequence of V2,

  B3 for FinSequence of V3,
  v1,w1 for Element of V1,
  R,R1,R2 for FinSequence of V1,
  p,p1,p2 for FinSequence of K;

theorem 
  lmlt(p1 + p2,R) = lmlt(p1,R) + lmlt(p2,R);

theorem 
  lmlt(p,R1 + R2) = lmlt(p,R1) + lmlt(p,R2);

theorem 
  len p1 = len R1 & len p2 = len R2 implies lmlt(p1^p2,R1^R2) =
  lmlt(p1,R1)^lmlt(p2,R2);

theorem 
  len R1 = len R2 implies Sum (R1+R2)=Sum R1 + Sum R2;

theorem 
  Sum lmlt(len R|->a,R) = a * Sum R;

theorem 
  Sum lmlt(p,len p|->v1) = (Sum p) * v1;

theorem 
  Sum lmlt(a*p,R) = a * Sum lmlt(p,R);

theorem 
  for B1 be FinSequence of V1,W1 be Subspace of V1, B2 be FinSequence of
  W1 st B1 = B2 holds lmlt(p,B1) = lmlt(p,B2);

theorem 
  for B1 be FinSequence of V1,W1 be Subspace of V1, B2 be FinSequence of
  W1 st B1 = B2 holds Sum B1 = Sum B2;

theorem 
  i in dom R implies Sum lmlt(Line(1.(K,len R),i),R) = R/.i;

begin 

theorem 
  v1 + w1 |-- b1 = (v1 |-- b1) + (w1 |-- b1);

theorem 
  a * v1 |-- b1 = a * (v1 |-- b1);

theorem 
  i in dom b1 implies b1/.i|-- b1 = Line(1.(K,len b1),i);

theorem 
  0.V1|-- b1 = len b1 |-> 0.K;

theorem 
  len b1 = dim V1;

theorem 
  rng(b1|m) is linearly-independent Subset of V1 & for A be Subset of V1
  st A = rng(b1|m) holds b1|m is OrdBasis of Lin A;

theorem 
  rng(b1/^m) is linearly-independent Subset of V1 & for A be Subset of
  V1 st A = rng(b1/^m) holds b1/^m is OrdBasis of Lin A;

theorem 
  for W1,W2 be Subspace of V1 st W1/\W2=(0).V1 for b1 be OrdBasis
  of W1,b2 be OrdBasis of W2,b be OrdBasis of W1+W2 st b=b1^b2 for v,v1,v2 be
  Vector of W1+W2, w1 be Vector of W1,w2 be Vector of W2 st v = v1+v2 & v1=w1 &
  v2=w2 holds v|-- b = (w1|--b1)^(w2|-- b2);

theorem 
  for W1 be Subspace of V1 st W1 = (Omega).V1 for w be Vector of
W1, v be Vector of V1,w1 be OrdBasis of W1 st v = w & b1 = w1 holds v|--b1 = w
  |-- w1;

theorem 
  for W1,W2 be Subspace of V1 st W1/\W2=(0).V1 for w1 be OrdBasis
  of W1,w2 be OrdBasis of W2 holds w1^w2 is OrdBasis of W1+W2;

begin 

definition
  let K,V1,V2,f,B1,b2;
  redefine func AutMt(f,B1,b2) -> Matrix of len B1,len b2,K;
end;

definition
  let S be 1-sorted;
  let R be Relation;
  func R|S equals

  R | (the carrier of S);
end;

theorem 
  for f be linear-transformation of V1,V2 for W1,W2 be Subspace of V1,U1
,U2 be Subspace of V2 st ( dim W1 =0 implies dim U1 = 0 )& ( dim W2 =0 implies
dim U2 = 0 )& V2 is_the_direct_sum_of U1,U2 for fW1 be linear-transformation of
W1,U1, fW2 be linear-transformation of W2,U2 st fW1 = f | W1 & fW2 = f | W2 for
  w1 be OrdBasis of W1, w2 be OrdBasis of W2, u1 be OrdBasis of U1, u2 be
OrdBasis of U2 st w1^w2 = b1 & u1^u2 = b2 holds AutMt(f,b1,b2) = block_diagonal
  (<*AutMt(fW1,w1,u1),AutMt(fW2,w2,u2)*>,0.K);

definition
  let K,V1,V2;
  let f be Function of V1,V2;
  let B1 be FinSequence of V1;
  let b2 be OrdBasis of V2;
  assume
 len B1 = len b2;
  func AutEqMt(f,B1,b2) -> Matrix of len B1,len B1,K equals


  AutMt(f,B1,
  b2);
end;

theorem 
  AutMt(id V1,b1,b1) = 1.(K,len b1);

theorem 
  AutEqMt(id V1,b1,b19) is invertible & AutEqMt(id V1,b19,b1) = AutEqMt(
  id V1,b1,b19)~;

theorem 
  len p1 = len p2 & len p1 = len B1 & len p1 > 0 & j in dom b1 & (
for i st i in dom p2 holds p2.i = (B1/.i|--b1).j) implies p1 "*" p2 = (Sum lmlt
  (p1,B1) |-- b1).j;

theorem 
  len b1>0 & f is additive homogeneous implies LineVec2Mx(v1|-- b1)*AutMt(f,b1,
  b2) = LineVec2Mx (f.v1 |-- b2);

begin 

definition
  let K,V1,V2,b1,B2;
  let M be Matrix of len b1,len B2,K;
  func Mx2Tran(M,b1,B2) -> Function of V1, V2 means


  for v be Vector of
  V1 holds it.v = Sum lmlt (Line(LineVec2Mx(v|--b1) * M,1),B2);
end;

theorem 
  for M be Matrix of len b1,len b2,K st len b1 > 0 holds
  LineVec2Mx(Mx2Tran(M,b1,b2).v1|--b2) = LineVec2Mx(v1|--b1) * M;

theorem 
  for M be Matrix of len b1,len B2,K st len b1 = 0 holds Mx2Tran(M
  ,b1,B2).v1 = 0.V2;

registration
  let K,V1,V2,b1,B2;
  let M be Matrix of len b1,len B2,K;
  cluster Mx2Tran(M,b1,B2) -> homogeneous additive;
end;

theorem 
  f is additive homogeneous implies Mx2Tran(AutMt(f,b1,b2),b1,b2) = f;

theorem 
  for A,B be Matrix of K st i in dom A & width A = len B holds
  LineVec2Mx(Line(A,i)) * B = LineVec2Mx(Line(A*B,i));

theorem 
  for M be Matrix of len b1,len b2,K holds AutMt(Mx2Tran(M,b1,b2), b1,b2) = M;

definition
  let n,m,K;
  let A be Matrix of n,m,K;
  let B be Matrix of K;
  redefine func A+B -> Matrix of n,m,K;
end;

theorem 
  for A,B be Matrix of len b1,len B2,K holds Mx2Tran(A+B,b1,B2) =
  Mx2Tran(A,b1,B2) + Mx2Tran(B,b1,B2);

theorem 
  for A be Matrix of len b1,len B2,K holds a * Mx2Tran(A,b1,B2) =
  Mx2Tran(a * A,b1,B2);

theorem 
  for A,B be Matrix of len b1,len b2,K st Mx2Tran(A,b1,b2)=Mx2Tran(B,b1,
  b2) holds A = B;

theorem 
  for A be Matrix of len b1,len b2,K for B be Matrix of len b2,len B3,K
  st width A = len B for AB be Matrix of len b1,len B3,K st AB = A*B holds
  Mx2Tran(AB,b1,B3) = Mx2Tran(B,b2,B3) * Mx2Tran(A,b1,b2);

theorem 
  for A be Matrix of len b1,len b2,K st len b1>0 & len b2>0 holds
  v1 in ker Mx2Tran(A,b1,b2) iff v1|--b1 in Space_of_Solutions_of (A@);

theorem 
  V1 is trivial iff dim V1 = 0;

theorem 
  for V1,V2 be VectSp of K for f be linear-transformation of V1,V2
  holds f is one-to-one iff ker f = (0).V1;

registration
  let K;
  let V1,V2 be VectSp of K;
  let f,g be linear-transformation of V1,V2;
  cluster f+g -> homogeneous additive;
end;

registration
  let K;
  let V1,V2 be VectSp of K;
  let f be linear-transformation of V1,V2,a;
  cluster a*f -> homogeneous additive;
end;

definition
  let K;
  let V1,V2,V3 be VectSp of K;
  let f1 be linear-transformation of V1, V2;
  let f2 be linear-transformation of V2, V3;
  redefine func f2*f1 -> linear-transformation of V1,V3;
end;

theorem 
  for A be Matrix of len b1,len b2,K st the_rank_of A = len b1
  holds Mx2Tran(A,b1,b2) is one-to-one;

theorem 
  MX2FinS 1.(K,n) is OrdBasis of n-VectSp_over K;

theorem 
  for M be OrdBasis of (len b2)-VectSp_over K st M = MX2FinS 1.(K,
  len b2) for v1 be Vector of (len b2)-VectSp_over K holds v1|--M = v1;

theorem 
  for M be OrdBasis of (len b2)-VectSp_over K st M = MX2FinS 1.(K,
  len b2) for A be Matrix of len b1,len M,K st A = AutMt(f,b1,b2) &
  f is additive homogeneous
  holds Mx2Tran(A,b1,M).v1 = f.v1 |-- b2;

definition
  let K be add-associative right_zeroed right_complementable Abelian
associative well-unital distributive non empty doubleLoopStr, V1,V2 be Abelian
  add-associative right_zeroed right_complementable vector-distributive
  scalar-distributive scalar-associative scalar-unital
   non empty
  VectSpStr over K;
  let W be Subspace of V1;
  let f be Function of V1,V2;
  redefine func f|W -> Function of W,V2;
end;

definition
  let K be Field;
  let V1,V2 be VectSp of K;
  let W be Subspace of V1;
  let f be linear-transformation of V1, V2;
  redefine func f|W -> linear-transformation of W,V2;
end;

begin 

theorem 
  for f be linear-transformation of V1,V2 holds rank f =
  the_rank_of AutMt(f,b1,b2);

theorem 
  for M be Matrix of len b1,len b2,K holds rank Mx2Tran(M,b1,b2) =
  the_rank_of M;

theorem 
  for f be linear-transformation of V1,V2 st dim V1=dim V2 holds ker f
  is non trivial iff Det AutEqMt(f,b1,b2) = 0.K;

theorem 
  for f be linear-transformation of V1,V2, g be linear-transformation of
  V2,V3 st g|im f is one-to-one holds rank (g*f) = rank f & nullity (g*f) =
  nullity f;














begin 

reserve a,b,c for set;



theorem 
  for T being non empty TopSpace, B being Basis of T for x being
  Element of T holds {U where U is Subset of T: x in U & U in B} is Basis of x;



theorem 
  for T being non empty TopSpace for B being ManySortedSet of T st
  for x being Element of T holds B.x is Basis of x holds Union B is Basis of T;

definition
  let T be non empty TopStruct;
  let x be Element of T;
  func Chi(x,T) -> cardinal number means


  (ex B being Basis of x st it
  = card B) & for B being Basis of x holds it c= card B;
end;



theorem 
  for X being set st for a being set st a in X holds a is cardinal
  number holds union X is cardinal number;

definition
  let T be non empty TopStruct;
  func Chi(T) -> cardinal number means


  (for x being Point of T holds
  Chi(x,T) c= it) & for M being cardinal number st for x being Point of T holds
  Chi(x,T) c= M holds it c= M;
end;



theorem 
  for T being non empty TopStruct holds Chi(T) = union {Chi(x,T)
  where x is Point of T: not contradiction};

theorem 
  for T being non empty TopStruct for x being Point of T holds Chi(
  x,T) c= Chi(T);



theorem 
  for T being non empty TopSpace holds T is first-countable iff Chi(T) c= omega
;

begin 

definition
  let T be non empty TopSpace;
  mode Neighborhood_System of T -> ManySortedSet of T means


    for x being Element of T holds it.x is Basis of x;
end;



definition
  let T be non empty TopSpace;
  let N be Neighborhood_System of T;
  redefine func Union N -> Basis of T;
  let x be Point of T;
  redefine func N.x -> Basis of x;
end;









theorem 
  for T being non empty TopSpace for x,y being Point of T for B1 being
Basis of x, B2 being Basis of y for U being set st x in U & U in B2 ex V being
  open Subset of T st V in B1 & V c= U;



theorem 
  for T being non empty TopSpace for x being Point of T for B being
Basis of x for U1,U2 being set st U1 in B & U2 in B ex V being open Subset of T
  st V in B & V c= U1 /\ U2;



theorem 
  for T being non empty TopSpace for A being Subset of T for x being
Element of T holds x in Cl A iff for B being Basis of x for U being set st U in
  B holds U meets A;



theorem 
  for T being non empty TopSpace for A being Subset of T for x being
Element of T holds x in Cl A iff ex B being Basis of x st for U being set st U
  in B holds U meets A;

registration
  let T be TopSpace;
  cluster open non empty for Subset-Family of T;
end;

begin 


theorem 
  for T being non empty TopSpace for S being open Subset-Family of
T ex G being open Subset-Family of T st G c= S & union G = union S & card G c=
  weight T;

definition
  let T be TopStruct;
  attr T is finite-weight means


  weight T is finite;
end;

notation
  let T be TopStruct;
  antonym T is infinite-weight for T is finite-weight;
end;

registration
  cluster finite -> finite-weight for TopStruct;
  cluster infinite-weight -> infinite for TopStruct;
end;

theorem 
  for X being set holds card SmallestPartition X = card X;

theorem 
  for T being discrete non empty TopStruct holds SmallestPartition
the carrier of T is Basis of T & for B being Basis of T holds SmallestPartition
  the carrier of T c= B;

theorem 
  for T being discrete non empty TopStruct holds weight T = card
  the carrier of T;

registration
  cluster infinite-weight for TopSpace;
end;

theorem 
  for T being finite-weight non empty TopSpace ex B0 being Basis
of T st ex f being Function of the carrier of T, the topology of T st B0 = rng
  f & for x being Point of T holds x in f.x & for U being open Subset of T st x
  in U holds f.x c= U;

theorem 
  for T being TopSpace for B0,B being Basis of T for f being
  Function of the carrier of T, the topology of T st B0 = rng f & for x being
Point of T holds x in f.x & for U being open Subset of T st x in U holds f.x c=
  U holds B0 c= B;

theorem 
  for T being TopSpace for B0 being Basis of T for f being
  Function of the carrier of T, the topology of T st B0 = rng f & for x being
Point of T holds x in f.x & for U being open Subset of T st x in U holds f.x c=
  U holds weight T = card B0;



theorem 
  for T being non empty TopSpace for B being Basis of T ex B1 being
  Basis of T st B1 c= B & card B1 = weight T;

begin 

definition
  let X, x0 be set;
  func DiscrWithInfin(X,x0) -> strict TopStruct means


  the carrier of
  it = X & the topology of it = {U where U is Subset of X: not x0 in U} \/ {F`
  where F is Subset of X: F is finite};
end;

registration
  let X,x0 be set;
  cluster DiscrWithInfin(X,x0) -> TopSpace-like;
end;

registration
  let X be non empty set, x0 be set;
  cluster DiscrWithInfin(X,x0) -> non empty;
end;

theorem 
  for X,x0 being set, A being Subset of DiscrWithInfin(X,x0) holds
  A is open iff not x0 in A or A` is finite;

theorem 
  for X,x0 being set, A being Subset of DiscrWithInfin(X,x0) holds
  A is closed iff (x0 in X implies x0 in A) or A is finite;

theorem 
  for X,x0,x being set st x in X holds {x} is closed Subset of
  DiscrWithInfin(X,x0);

theorem 
  for X,x0,x being set st x in X & x <> x0 holds {x} is open
  Subset of DiscrWithInfin(X,x0);

theorem 
  for X,x0 being set st X is infinite for U being Subset of
  DiscrWithInfin(X,x0) st U = {x0} holds U is not open;

theorem 
  for X,x0 being set for A being Subset of DiscrWithInfin(X,x0) st
  A is finite holds Cl A = A;

theorem 
  for T being non empty TopSpace for A being Subset of T st A is
  not closed for a being Point of T st A \/ {a} is closed holds Cl A = A \/ {a}
;

theorem 
  for X,x0 being set st x0 in X for A being Subset of
  DiscrWithInfin(X,x0) st A is infinite holds Cl A = A \/ {x0};

theorem 
  for X,x0 being set for A being Subset of DiscrWithInfin(X,x0) st A` is
  finite holds Int A = A;

theorem 
  for X,x0 being set st x0 in X for A being Subset of DiscrWithInfin(X,
  x0) st A` is infinite holds Int A = A \ {x0};

theorem 
  for X, x0 being set holds ex B0 being Basis of DiscrWithInfin(X,
  x0) st B0 = ((SmallestPartition X) \ {{x0}}) \/ {F` where F is Subset of X: F
  is finite};

theorem 
  for X being infinite set holds card Fin X = card X;

theorem 
  for X being infinite set holds card {F` where F is Subset of X:
  F is finite} = card X;

theorem 
  for X being infinite set, x0 being set for B0 being Basis of
DiscrWithInfin(X,x0) st B0 = ((SmallestPartition X) \ {{x0}}) \/ {F` where F is
  Subset of X: F is finite} holds card B0 = card X;

theorem 
  for X being infinite set, x0 being set for B being Basis of
  DiscrWithInfin(X,x0) holds card X c= card B;

theorem 
  for X being infinite set, x0 being set holds weight DiscrWithInfin(X,
  x0) = card X;

theorem 
  for X being non empty set, x0 being set holds ex B0 being prebasis of
DiscrWithInfin(X,x0) st B0 = ((SmallestPartition X) \ {{x0}}) \/ {{x}` where x
  is Element of X: not contradiction};

begin 


theorem 
  for T being TopSpace, F being Subset-Family of T for I being non empty
  Subset-Family of F st for G being set st G in I holds F\G is finite holds Cl
union F = union clf F \/ meet {Cl union G where G is Subset-Family of T: G in I
  };



theorem 
  for T being TopSpace, F being Subset-Family of T holds Cl union F =
union clf F \/ meet {Cl union G where G is Subset-Family of T: G c= F & F\G is
  finite};



theorem 
  for X being set, O being Subset-Family of bool X st for o being
  Subset-Family of X st o in O holds TopStruct(#X,o#) is TopSpace ex B being
  Subset-Family of X st B = Intersect O & TopStruct(#X,B#) is TopSpace & (for o
  being Subset-Family of X st o in O holds TopStruct(#X,o#) is TopExtension of
TopStruct(#X,B#)) & for T being TopSpace st the carrier of T = X & for o being
Subset-Family of X st o in O holds TopStruct(#X,o#) is TopExtension of T holds
  TopStruct(#X,B#) is TopExtension of T;



theorem 
  for X being set, O being Subset-Family of bool X ex B being
  Subset-Family of X st B = UniCl FinMeetCl union O & TopStruct(#X,B#) is
TopSpace & (for o being Subset-Family of X st o in O holds TopStruct(#X,B#) is
TopExtension of TopStruct(#X,o#)) & for T being TopSpace st the carrier of T =
  X & for o being Subset-Family of X st o in O holds T is TopExtension of
  TopStruct(#X,o#) holds T is TopExtension of TopStruct(#X,B#);















begin 

reserve i, n for Nat,
  x, y, a for real number,
  v for Element of n-tuples_on REAL,
  p, p1, p2, p3, q, q1, q2 for Point of TOP-REAL n;

theorem 
  mlt(v, 0*n).i = 0;

theorem 
  mlt(v, 0*n) = 0*n;

begin 

theorem 
  for y1,y2 being real-valued FinSequence, x1,x2 being Element of REAL
  n st x1=y1 & x2=y2 holds |(y1,y2)|=1/4*((|.(x1+x2).|)^2-(|.(x1-x2).|)^2);

theorem 
  for x being real-valued FinSequence holds |.x.|^2 = |(x,x)|;

theorem 
  for x being real-valued FinSequence holds |.x.| = sqrt |(x,x)|;

theorem 
  for x being real-valued FinSequence holds 0 <= |.x.|;

theorem 
  for x being real-valued FinSequence holds |(x,x)|=0 iff x=0*(len x);

theorem 
  for x being real-valued FinSequence holds |(x,x)| = 0 iff |.x.| = 0;

theorem 
  for x being real-valued FinSequence holds |(x, 0*(len x))| = 0;

theorem 
  for x being real-valued FinSequence holds |(0*(len x),x)| = 0;

theorem 
  for x,y being real-valued FinSequence st len x=len y holds |.x+y.|^2
  = |.x.|^2 + 2*|(y, x)| + |.y.|^2;

theorem 
  for x,y being real-valued FinSequence st len x=len y holds |.x-y.|^2
  = |.x.|^2 - 2*|(y, x)| + |.y.|^2;

theorem 
  for x,y being real-valued FinSequence st len x=len y holds |.x+y.|^2 + |.x
  -y.|^2 = 2*(|.x.|^2 + |.y.|^2);

theorem 
  for x,y being real-valued FinSequence st len x=len y holds |.x+y.|^2 - |.x
  -y.|^2 = 4* |(x,y)|;

theorem 
  for x,y being real-valued FinSequence st len x=len y holds
  abs |(x,y)| <= |.x.|*|.y.|;

theorem 
  for x,y being real-valued FinSequence st len x=len y holds
  |.x+y.| <= |.x.| + |.y.|;

begin  

theorem 
  |(p1,p2)| = 1/4*((|. p1+p2 .|)^2-(|. p1-p2 .|)^2);

theorem 
  |(p1 + p2, p3)| = |(p1, p3)| + |(p2, p3)|;

theorem 
  for x being real number holds |(x*p1, p2)| = x*|(p1, p2)|;

theorem 
  for x being real number holds |(p1, x*p2)| = x*|(p1, p2)|;

theorem 
  |(-p1, p2)| = -|(p1, p2)|;

theorem 
  |(p1, -p2)| = -|(p1, p2)|;

theorem 
  |(-p1, -p2)| = |(p1, p2)|;

theorem 
  |(p1-p2, p3)| = |(p1, p3)| - |(p2, p3)|;

theorem 
  |((x*p1+y*p2), p3)| = x*|(p1,p3)| + y*|(p2,p3)|;

theorem 
  |(p, q1+q2)| = |(p, q1)| + |(p, q2)|;

theorem 
  |(p, q1-q2)| = |(p, q1)| - |(p, q2)|;

theorem 
  |(p1+p2, q1+q2)| = |(p1, q1)| + |(p1, q2)| + |(p2, q1)| + |(p2, q2)|;

theorem 
  |(p1-p2, q1-q2)| = |(p1, q1)| - |(p1, q2)| - |(p2, q1)| + |(p2, q2)|;

theorem 
  |(p+q, p+q)| = |(p, p)| + 2*|(p, q)| + |(q, q)|;

theorem 
  |(p-q, p-q)| = |(p, p)| - 2*|(p, q)| + |(q, q)|;

theorem 
  |(p, 0.TOP-REAL n)| = 0;

theorem 
  |(0.TOP-REAL n, p)| = 0;

theorem 
  |(0.TOP-REAL n, 0.TOP-REAL n)| = 0;

theorem 
  |(p,p)| >= 0;

theorem 
  |(p,p)| = |.p.|^2;

theorem 
  |.p.| = sqrt |(p,p)|;

theorem 
  0 <= |.p.|;

theorem 
  |. 0.TOP-REAL n .| = 0;

theorem 
  |(p,p)| = 0 iff |.p.| = 0;

theorem 
  |(p,p)| = 0 iff p = 0.TOP-REAL n;

theorem 
  |.p.|=0 iff p = 0.TOP-REAL n;

theorem 
  p <> 0.TOP-REAL n iff |(p, p)| > 0;

theorem 
  p <> 0.TOP-REAL n iff |.p.| > 0;

theorem 
  |.p+q.|^2 = |.p.|^2 + 2*|(q, p)| + |.q.|^2;

theorem 
  |.p-q.|^2 = |.p.|^2 - 2*|(q, p)| + |.q.|^2;

theorem 
  |.p+q.|^2 + |.p-q.|^2 = 2*(|.p.|^2 + |.q.|^2);

theorem 
  |.p+q.|^2 - |.p-q.|^2 = 4* |(p,q)|;

theorem 
  |(p,q)| = (1/4)*(|.p+q.|^2 - |.p-q.|^2);

theorem 
  |(p,q)| <= |(p,p)| + |(q,q)|;

theorem 
  abs |(p,q)| <= |.p.|*|.q.|;

theorem 
  |.p+q.| <= |.p.| + |.q.|;

theorem 
  p,0.TOP-REAL n are_orthogonal;

theorem 
  0.TOP-REAL n,p are_orthogonal;

theorem 
  p,p are_orthogonal iff p=0.TOP-REAL n;

theorem 
  p, q are_orthogonal implies a*p,q are_orthogonal;

theorem 
  p, q are_orthogonal implies p,a*q are_orthogonal;

theorem 
  (for q holds p,q are_orthogonal) implies p=0.TOP-REAL n;














begin

reserve
   j, k, l, n, m, t,i for Nat,
  K for Field,
  a for Element of K,
  M,M1,M2 for Matrix of n,m,K,

  pK,qK for FinSequence of K,
  A for Matrix of n,K;

definition
  let n,m;
  let K;
  let M be Matrix of n,m,K;
  let l,k be Nat;
  func InterchangeLine(M,l,k) -> Matrix of n,m,K means


  len it = len M &
for i,j st i in dom M & j in Seg width M holds (i = l implies it*(i,j) = M*(k,j
)) & (i = k implies it*(i,j) = M*(l,j)) & (i <> l & i <> k implies it*(i,j) = M
  *(i,j));
end;

theorem 
  for M1,M2 being Matrix of n,m,K holds width M1 = width M2;

theorem 
  for M,M1,i st l in dom M & k in dom M & i in dom M & M1 =
  InterchangeLine(M,l,k) holds (i = l implies Line(M1,i) = Line(M,k)) & (i = k
implies Line(M1,i) = Line(M,l)) & (i <> l & i <> k implies Line(M1,i) = Line(M,
  i));

theorem 
  for a,i,j,M st i in dom M & j in Seg width M holds (a*Line(M,i)).
  j = a*(M*(i,j));

definition
  let n,m;
  let K;
  let M be Matrix of n,m,K;
  let l be Nat;
  let a be Element of K;
  func ScalarXLine(M,l,a) -> Matrix of n,m,K means


  len it = len M & for
i,j st i in dom M & j in Seg width M holds (i = l implies it*(i,j) = a*(M*(l,j)
  )) & (i <> l implies it*(i,j) = M*(i,j));
end;

theorem 
  l in dom M & i in dom M & M1 = ScalarXLine(M,l,a) implies (i = l
  implies Line(M1,i) = a*Line(M,l)) & (i <> l implies Line(M1,i) = Line(M,i));

definition
  let n,m;
  let K;
  let M be Matrix of n,m,K;
  let l,k be Nat;
  let a be Element of K;
  assume
 k in dom M;
  func RlineXScalar(M,l,k,a) -> Matrix of n,m,K means


  len it = len M &
for i,j st i in dom M & j in Seg width M holds (i = l implies it*(i,j) = a*(M*(
  k,j))+(M*(l,j))) & (i <> l implies it*(i,j) = M*(i,j));
end;

theorem 
  l in dom M & k in dom M & i in dom M & M1 = RlineXScalar(M,l,k,a)
implies (i = l implies Line(M1,i) = a*Line(M,k) + Line(M,l)) & (i <> l implies
  Line(M1,i) = Line(M,i));

notation
  let n,m;
  let K;
  let M be Matrix of n,m,K;
  let l,k be Nat;
  synonym ILine(M,l,k) for InterchangeLine(M,l,k);
end;

notation
  let n,m;
  let K;
  let M be Matrix of n,m,K;
  let l be Nat;
  let a be Element of K;
  synonym SXLine(M,l,a) for ScalarXLine(M,l,a);
end;

notation
  let n,m;
  let K;
  let M be Matrix of n,m,K;
  let l,k be Nat;
  let a be Element of K;
  synonym RLineXS(M,l,k,a) for RlineXScalar(M,l,k,a);
end;

theorem 
  l in dom (1.(K,n)) & k in dom (1.(K,n)) implies ILine((1.(K,n)),l
  ,k) * A = ILine(A,l,k);

theorem 
  for l,a,A st l in dom (1.(K,n)) holds SXLine((1.(K,n)),l,a) * A =
  SXLine(A,l,a);

theorem 
  l in dom (1.(K,n)) & k in dom (1.(K,n)) implies RLineXS((1.(K,n))
  ,l,k,a) * A = RLineXS(A,l,k,a);

theorem 
  ILine(M,k,k) = M;

theorem 
  ILine(M,l,k) = ILine(M,k,l);

theorem 
  l in dom M & k in dom M implies ILine(ILine(M,l,k),l,k) = M;

theorem 
  l in dom (1.(K,n)) & k in dom (1.(K,n)) implies ILine((1.(K,n)),
  l,k) is invertible & (ILine((1.(K,n)),l,k))~ = ILine((1.(K,n)),l,k);

theorem 
  l in dom (1.(K,n)) & k in dom (1.(K,n)) & k<>l implies RLineXS((
1.(K,n)),l,k,a) is invertible & (RLineXS((1.(K,n)),l,k,a))~ = RLineXS((1.(K,n))
  ,l,k,-a);

theorem 
  l in dom (1.(K,n)) & a <> 0.K implies SXLine((1.(K,n)),l,a) is
  invertible & (SXLine((1.(K,n)),l,a))~ = SXLine((1.(K,n)),l,a");

definition
  let n,m;
  let K;
  let M be Matrix of n,m,K;
  let l,k be Nat;
  assume that
 l in Seg width M and
 k in Seg width M and
 n>0 and
 m>0;
  func InterchangeCol(M,l,k) -> Matrix of n,m,K means


  len it = len M &
for i,j st i in dom M & j in Seg width M holds (j = l implies it*(i,j) = M*(i,k
)) & (j = k implies it*(i,j) = M*(i,l)) & (j <> l & j <> k implies it*(i,j) = M
  *(i,j));
end;

definition
  let n,m;
  let K;
  let M be Matrix of n,m,K;
  let l be Nat;
  let a be Element of K;
  assume that
 l in Seg width M and
 n>0 and
 m>0;
  func ScalarXCol(M,l,a) -> Matrix of n,m,K means


  len it = len M & for
i,j st i in dom M & j in Seg width M holds (j = l implies it*(i,j) = a*(M*(i,l)
  )) & (j <> l implies it*(i,j) = M*(i,j));
end;

definition
  let n,m;
  let K;
  let M be Matrix of n,m,K;
  let l,k be Nat;
  let a be Element of K;
  assume that
 l in Seg width M and
 k in Seg width M and
 n>0 and
 m>0;
  func RcolXScalar(M,l,k,a) -> Matrix of n,m,K means


  len it = len M &
for i,j st i in dom M & j in Seg width M holds (j = l implies it*(i,j) = a*(M*(
  i,k))+(M*(i,l))) & (j <> l implies it*(i,j) = M*(i,j));
end;

notation
  let n,m;
  let K;
  let M be Matrix of n,m,K;
  let l,k be Nat;
  synonym ICol(M,l,k) for InterchangeCol(M,l,k);
end;

notation
  let n,m;
  let K;
  let M be Matrix of n,m,K;
  let l be Nat;
  let a be Element of K;
  synonym SXCol(M,l,a) for ScalarXCol(M,l,a);
end;

notation
  let n,m;
  let K;
  let M be Matrix of n,m,K;
  let l,k be Nat;
  let a be Element of K;
  synonym RColXS(M,l,k,a) for RcolXScalar(M,l,k,a);
end;

theorem 
  l in Seg width M & k in Seg width M & n>0 & m>0 & M1 = M@
  implies (ILine(M1,l,k))@ = ICol(M,l,k);

theorem 
  l in Seg width M & n>0 & m>0 & M1 = M@ implies (SXLine(M1,l,a))@
  = SXCol(M,l,a);

theorem 
  l in Seg width M & k in Seg width M & n>0 & m>0 & M1 = M@
  implies (RLineXS(M1,l,k,a))@ = RColXS(M,l,k,a);

theorem 
  l in dom (1.(K,n)) & k in dom (1.(K,n)) & n>0 implies A * ICol((1.(K,n
  )),l,k) = ICol(A,l,k);

theorem 
  l in dom (1.(K,n)) & n>0 implies A * SXCol((1.(K,n)),l,a) = SXCol(A,l, a);

theorem 
  l in dom (1.(K,n)) & k in dom (1.(K,n)) & n>0 implies A * RColXS((1.(K
  ,n)),l,k,a) = RColXS(A,l,k,a);

theorem 
  l in dom (1.(K,n)) & k in dom (1.(K,n)) & n>0 implies (ICol((1.(K,n)),
  l,k))~ = ICol((1.(K,n)),l,k);

theorem 
  l in dom (1.(K,n)) & k in dom (1.(K,n)) & k<>l & n>0 implies (RColXS((
  1.(K,n)),l,k,a))~ = RColXS((1.(K,n)),l,k,-a);

theorem 
  l in dom (1.(K,n)) & a <> 0.K & n>0 implies (SXCol((1.(K,n)),l,a))~ =
  SXCol((1.(K,n)),l,a");














begin 

reserve

  k,n,m,i,j for Element of NAT,
  K for Field;

definition
  let K be non empty ZeroStr, n;
  func 0*(K,n) -> FinSequence of K equals

  n |-> (0.K);
end;

definition
  let K be non empty ZeroStr;
  let n;
  redefine func 0*(K,n) -> Element of n-tuples_on (the carrier of K);
end;

reserve L for non empty addLoopStr;

theorem 
  for x being FinSequence of L holds x is Element of (len x)
  -tuples_on the carrier of L;

theorem 
  for x1,x2 being FinSequence of L st len x1=len x2 holds len (x1+ x2)=len x1;

theorem 
  for x1,x2 being FinSequence of L st len x1=len x2 holds len (x1- x2)=len x1;

reserve G for non empty multLoopStr;

theorem 
  for x1,x2 being FinSequence of G,i st i in dom mlt(x1,x2) holds
  mlt(x1,x2).i = (x1/.i)*(x2/.i) & (mlt(x1,x2))/.i=(x1/.i)*(x2/.i);

theorem 
  for x1,x2 being FinSequence of L,i being Nat st len x1=len x2 & 1
  <=i & i<=len x1 holds (x1+x2).i=x1/.i + x2/.i & (x1-x2).i=x1/.i - x2/.i;

theorem 
  for a being Element of K, x being FinSequence of K holds -a*x = (
  -a)*x & -a*x = a*(-x);

theorem 
  for x1,x2,y1,y2 being FinSequence of G st len x1=len x2 & len y1=
  len y2 holds mlt(x1^y1,x2^y2)=(mlt(x1,x2))^(mlt(y1,y2));

notation
  let K;
  let e1,e2 be FinSequence of K;
  synonym |( e1,e2 )| for e1 "*" e2;
end;

theorem 
  for x,y being FinSequence of K,a being Element of K st len x=len
  y holds mlt(a*x,y)=a*(mlt(x,y)) & mlt(x,a*y)=a*(mlt(x,y));

theorem 
  for x,y being FinSequence of K,a being Element of K st len x=len y
  holds |(a*x,y)| = a*|(x,y)|;

theorem 
  for x,y being FinSequence of K,a being Element of K st len x=len
  y holds |(x,a*y)| = a*|(x,y)|;

theorem 
  for x,y1,y2 being FinSequence of K,a being Element of K st len x
  =len y1 & len x=len y2 holds |(x,y1+y2)| = |(x,y1)| + |(x,y2)|;

theorem 
  for x1,x2,y1,y2 being FinSequence of K st len x1=len x2 & len y1
  =len y2 holds |( x1^y1, x2^y2 )| = |(x1,x2)| + |(y1,y2)|;

theorem 
  for p1 being Element of n-tuples_on the carrier of K holds mlt(
  p1,(n |-> (0.K)))=n |-> (0.K);

notation
  let n;
  let K;
  let A be Matrix of n,K;
  synonym Inv A for A~;
end;

begin 

theorem 
  1.(K,0)=0.(K,0) & 1.(K,0)={};

theorem 
  for A being Matrix of 0,K holds A={} & A=1.(K,0) & A=0.(K,0);

theorem 
  for A being Matrix of 0,K holds A is invertible;

theorem 
  for A,B,C being Matrix of n,K holds A*B*C=A*(B*C);

theorem 
  for A,B being Matrix of n,K holds A is invertible & B=A~ iff B*A
  =1.(K,n) & A*B=1.(K,n);

theorem 
  for A being Matrix of n,K holds A is invertible iff ex B being
  Matrix of n,K st B*A=1.(K,n) & A*B=1.(K,n);

theorem 
  for x being FinSequence of K holds |(x, 0*(K,len x))| = 0.K;

theorem 
  for x being FinSequence of K holds |(0*(K,len x),x)| = 0.K;

theorem 
  for a being Element of K holds |( <* 0.K *>, <* a *> )|=0.K;

definition
  let K;
  let n,i be Nat;
  func Base_FinSeq(K,n,i) -> FinSequence of K equals

  Replace((n |-> 0.K),i,1.K);
end;

theorem 
  for n, i being Nat holds len Base_FinSeq(K,n,i)=n;

theorem 
  for i, n being Nat st 1<=i & i<=n holds (Base_FinSeq(K,n,i)).i= 1.K;

theorem 
  for i,j,n be Nat st 1<=j & j<=n & i<>j holds (Base_FinSeq(K,n,i) ).j=0.K;

theorem 
  for i,n being Nat st 1<=i & i<=n holds (1.(K,n)).i=Base_FinSeq(K ,n,i);

theorem 
  for i,j st 1<=i & i<=n & 1<=j & j<=n holds (1.(K,n))*(i,j)=(
  Base_FinSeq(K,n,i)).j;

theorem 
  for A being Matrix of n,K holds A=0.(K,n) iff for i,j being Element of
  NAT st 1<=i & i<=n & 1<=j & j<=n holds A*(i,j)=0.K;

theorem 
  for A being Matrix of n,K holds A=1.(K,n) iff for i,j being
  Element of NAT st 1<=i & i<=n & 1<=j & j<=n holds A*(i,j)=IFEQ(i,j,1.K,0.K);

begin 

theorem 
  for A,B being Matrix of n,K holds (A*B)@=(B@)*(A@);

theorem 
  for A being Matrix of n,K st A is invertible holds A@ is
  invertible & (A@)~ =(A~)@;

theorem 
  for x being FinSequence of K, a being Element of K st (ex i st 1
<=i & i<=len x & x.i=a & (for j st j<>i & 1<=j & j<=len x holds x.j=0.K)) holds
  Sum x=a;

theorem 
  for f1,f2 being FinSequence of K holds dom mlt(f1,f2) = dom f1 /\ dom
  f2 & for i st i in dom (mlt(f1,f2)) holds (mlt(f1,f2)).i = (f1/.i) * (f2/.i);

theorem 
  for x,y being FinSequence of K,i st len x=m & y=mlt (x,
  Base_FinSeq(K,m,i)) & 1<=i & i<=m holds y.i=x.i & for j st j<>i & 1<=j & j<=m
  holds y.j= 0.K;

theorem 
  for x being FinSequence of K st len x=m & 1<=i & i<=m holds |( x
  ,Base_FinSeq(K,m,i) )|=x.i & |( x,Base_FinSeq(K,m,i) )|=x/.i;

theorem 
  for m,i st 1<=i & i<=m holds |( Base_FinSeq(K,m,i),Base_FinSeq(K
  ,m,i) )|= 1.K;

theorem 
  for a being Element of K,P,Q being Matrix of n,K st n>0 & a<>0.K
& P*(1,1)= a" & (for i st 1<i & i<=n holds P.i=Base_FinSeq(K,n,i)) & Q*(1,1)=a
  & (for j st 1<j & j<=n holds Q*(1,j)= -a*(P*(1,j))) & (for i st 1<i & i<=n
  holds Q.i=Base_FinSeq(K,n,i)) holds P is invertible & Q=P~;

theorem 
  for a being Element of K,P being Matrix of n,K st n>0 & a<>0.K &
  P*(1,1)= a" & (for i st 1<i & i<=n holds P.i=Base_FinSeq(K,n,i)) holds P is
  invertible;

theorem 
  for A being Matrix of n,K st n>0 & A*(1,1)<>0.K ex P being
Matrix of n,K st P is invertible & (A*P)*(1,1)=1.K & (for j st 1<j & j<=n holds
  (A*P)*(1,j)= 0.K)& for i st 1<i & i<=n & A*(i,1)= 0.K holds (A*P)*(i,1)= 0.K;

theorem 
  for A being Matrix of n,K st n>0 & A*(1,1)<>0.K ex P being
Matrix of n,K st P is invertible & (P*A)*(1,1)=1.K & (for i st 1<i & i<=n holds
  (P*A)*(i,1)= 0.K)& for j st 1<j & j<=n & A*(1,j)= 0.K holds (P*A)*(1,j)= 0.K;

theorem 
  for A being Matrix of n,K st n>0 & A*(1,1)<>0.K ex P,Q being
Matrix of n,K st P is invertible & Q is invertible & (P*A*Q)*(1,1)=1.K & (for i
st 1<i & i<=n holds (P*A*Q)*(i,1)= 0.K)& for j st 1<j & j<=n holds (P*A*Q)*(1,j
  )= 0.K;

begin 

theorem 
  for D being non empty set,m,n,i,j being Element of NAT, A being
  Matrix of m,n,D holds Swap(A,i,j) is Matrix of m,n,D;

definition
  let K;
  let n be Element of NAT, i0 be Nat;
  func SwapDiagonal(K,n,i0) -> Matrix of n,K equals

  Swap(1.(K,n),1,i0);
end;

theorem 
  for n being Element of NAT,i0 being Nat,A being Matrix of n,K st
1<=i0 & i0<=n & A= SwapDiagonal(K,n,i0) holds for i,j being Nat st 1<=i & i<=n
& 1<=j & j<=n holds (i0<>1 implies (i=1 & j=i0 implies A*(i,j)=1.K)& (i=i0 & j=
1 implies A*(i,j)=1.K)& (i=1 & j=1 implies A*(i,j)=0.K)& (i=i0 & j=i0 implies A
*(i,j)=0.K)& (not ((i=1 or i=i0) &(j=1 or j=i0)) implies (i=j implies A*(i,j)=
  1.K)& (i<>j implies A*(i,j)=0.K)));

theorem 
  for n being Element of NAT, A being Matrix of n,K for i being
  Nat st 1<=i & i<=n holds SwapDiagonal(K,n,1)*(i,i)=1.K;

theorem 
  for n being Element of NAT, A being Matrix of n,K for i,j being
Nat st 1<=i & i<=n & 1<=j & j<=n holds (i<>j implies SwapDiagonal(K,n,1)*(i,j)=
  0.K);

theorem 
  for K for n,i0 being Element of NAT,A being Matrix of n,K st i0
= 1 & for i,j being Nat st 1<=i & i<=n & 1<=j & j<=n holds (i=j implies A*(i,j)
  =1.K)& (i<>j implies A*(i,j)=0.K) holds A= SwapDiagonal(K,n,i0);

theorem 
  for K for n,i0 being Element of NAT,A being Matrix of n,K st 1<=
i0 & i0<=n & i0 <> 1 & for i,j being Nat st 1<=i & i<=n & 1<=j & j<=n holds (i=
  1 & j=i0 implies A*(i,j)=1.K)& (i=i0 & j=1 implies A*(i,j)=1.K)& (i=1 & j=1
implies A*(i,j)=0.K)& (i=i0 & j=i0 implies A*(i,j)=0.K)& (not ((i=1 or i=i0) &(
  j=1 or j=i0)) implies (i=j implies A*(i,j)=1.K)& (i<>j implies A*(i,j)=0.K))
  holds A= SwapDiagonal(K,n,i0);

theorem 
  for A being (Matrix of n,K),i0 being Element of NAT st 1<=i0 &
i0 <=n holds (for j st 1<=j & j<=n holds ((SwapDiagonal(K,n,i0))*A)*(i0,j)=A*(1
,j) & ((SwapDiagonal(K,n,i0))*A)*(1,j)=A*(i0,j))& (for i,j st i<>1 & i<>i0 & 1
  <=i & i<=n & 1<=j & j<=n holds ((SwapDiagonal(K,n,i0))*A)*(i,j)=A*(i,j));

theorem 
  for i0 being Element of NAT st 1<=i0 & i0<=n holds SwapDiagonal(
  K,n,i0) is invertible & (SwapDiagonal(K,n,i0))~ =SwapDiagonal(K,n,i0);

theorem 
  for i0 being Element of NAT st 1<=i0 & i0<=n holds (SwapDiagonal
  (K,n,i0))@=(SwapDiagonal(K,n,i0));

theorem 
  for A being (Matrix of n,K),j0 being Element of NAT st 1<=j0 &
j0 <=n holds (for i st 1<=i & i<=n holds (A*(SwapDiagonal(K,n,j0)))*(i,j0)=A*(i
,1) & (A*(SwapDiagonal(K,n,j0)))*(i,1)=A*(i,j0))& (for i,j st j<>1 & j<>j0 & 1
  <=i & i<=n & 1<=j & j<=n holds (A*(SwapDiagonal(K,n,j0)))*(i,j)=A*(i,j));

theorem 
  for A being Matrix of n,K holds A=0.(K,n) iff for i,j st 1<=i &
  i<=n & 1<=j & j<=n holds A*(i,j)= 0.K;

begin 

theorem 
  for A being Matrix of n,K st A<> 0.(K,n) holds ex B,C being
Matrix of n,K st B is invertible & C is invertible & (B*A*C)*(1,1) =1.K & (for
i st 1<i & i<=n holds (B*A*C)*(i,1)= 0.K)& for j st 1<j & j<=n holds (B*A*C)*(1
  ,j)= 0.K;

theorem 
  for A,B being Matrix of n,K st B*A=1.(K,n) holds ex B2 being
  Matrix of n,K st A*B2=1.(K,n);

theorem 
  for A being Matrix of n,K holds (ex B1 being Matrix of n,K st B1
  *A=1.(K,n)) iff ex B2 being Matrix of n,K st A*B2=1.(K,n);

theorem 
  for A,B being Matrix of n,K st A*B = 1.(K,n) holds A is invertible & B
  is invertible;














begin 

registration
  let n be Nat;
  cluster TOP-REAL n -> add-continuous Mult-continuous;
end;

begin 

reserve m,n,i,i2,j for Element of NAT,
  r,r1,r2,s,t for Real,
  x,y,z for set;

canceled 5;

theorem 
  for f being increasing FinSequence of REAL st rng f={r,s} & len f
  =2 & r<=s holds f.1=r & f.2=s;

reserve p,p1,p2,p3,q,q1,q2,q3,q4 for Point of TOP-REAL n;

canceled;

theorem 
  abs(|.q.|)=|.q.|;

theorem 
  abs(|.q1.|- |.q2.|)<=|.q1-q2.|;

theorem 
  |.|[r]|.|=abs(r);

theorem 
  for n being Nat, A be Subset of TOP-REAL n
   holds A is bounded iff A is bounded Subset of Euclid n;

theorem 
  for A,B being Subset of TOP-REAL n st B is bounded & A c= B
  holds A is bounded;

definition
 canceled;
  let n be Nat;
  let A, B be Subset of TOP-REAL n;
  pred B is_inside_component_of A means


  B is_a_component_of A` & B is bounded;
end;

registration
  let M be non empty MetrStruct;
  cluster bounded for Subset of M;
end;

theorem 
  for A being Subset of TOP-REAL n, B being Subset of TOP-REAL n
  holds B is_inside_component_of A iff ex C being Subset of
  ((TOP-REAL n) | (A`))
  st C=B & C is a_component & C is bounded Subset of Euclid n;

definition
  let n be Nat;
  let A, B be Subset of TOP-REAL n;
  pred B is_outside_component_of A means


  B is_a_component_of A` & B is not bounded;
end;

theorem 
  for A being Subset of TOP-REAL n, B being Subset of TOP-REAL n
  holds B is_outside_component_of A iff
  ex C being Subset of ((TOP-REAL n) | (A`))
  st C=B & C is a_component &
  C is not bounded Subset of Euclid n;

theorem 
  for A,B being Subset of TOP-REAL n st B is_inside_component_of A holds
  B c= A`;

theorem 
  for A,B being Subset of TOP-REAL n st B is_outside_component_of A
  holds B c= A`;

definition
  let n be Nat;
  let A be Subset of TOP-REAL n;
  func BDD A -> Subset of TOP-REAL n equals

  union{B where B is Subset of
  TOP-REAL n: B is_inside_component_of A};
end;

definition
  let n be Nat;
  let A be Subset of TOP-REAL n;
  func UBD A -> Subset of TOP-REAL n equals

  union{B where B is Subset of
  TOP-REAL n: B is_outside_component_of A};
end;

registration
  let n be Nat;
  cluster [#](TOP-REAL n) -> convex;
end;

registration
  let n;
  cluster [#](TOP-REAL n) -> a_component;
end;

canceled 3;

theorem 
  for A being Subset of TOP-REAL n holds BDD A is
  a_union_of_components of (TOP-REAL n) | A`;

theorem 
  for A being Subset of TOP-REAL n holds UBD A is
  a_union_of_components of (TOP-REAL n) | A`;

theorem 
  for A being Subset of TOP-REAL n, B being Subset of TOP-REAL n
  st B is_inside_component_of A holds B c= BDD A;

theorem 
  for A being Subset of TOP-REAL n, B being Subset of TOP-REAL n
  st B is_outside_component_of A holds B c= UBD A;

theorem 
  for A being Subset of TOP-REAL n holds BDD A misses UBD A;

theorem 
  for A being Subset of TOP-REAL n holds BDD A c= A`;

theorem 
  for A being Subset of TOP-REAL n holds UBD A c= A`;

theorem 
  for A being Subset of TOP-REAL n holds (BDD A) \/ (UBD A) = A`;

reserve u for Point of Euclid n;

theorem 
  for P being Subset of TOP-REAL n st P=REAL n holds P is connected;

canceled 4;

theorem 
  for W being Subset of Euclid n st n>=1 & W=REAL n holds W is not bounded;

theorem 
  for A being Subset of TOP-REAL n holds A is bounded iff ex r
  being Real st for q being Point of TOP-REAL n st q in A holds |.q.|<r;

theorem 
  n>=1 implies not [#](TOP-REAL n) is bounded;

theorem 
  n>=1 implies UBD {}(TOP-REAL n)=REAL n;

theorem 
  for w1,w2,w3 being Point of TOP-REAL n, P being non empty Subset
of TOP-REAL n, h1,h2 being Function of I[01],(TOP-REAL n) |P st
h1 is continuous
  & w1=h1.0 & w2=h1.1 & h2 is continuous & w2=h2.0 & w3=h2.1 holds ex h3 being
  Function of I[01],(TOP-REAL n) |P st h3 is continuous & w1=h3.0 & w3=h3.1;

theorem 
  for P being Subset of TOP-REAL n, w1,w2,w3 being Point of
TOP-REAL n st w1 in P & w2 in P & w3 in P & LSeg(w1,w2) c= P & LSeg(w2,w3) c= P
ex h being Function of I[01],(TOP-REAL n) |P st h is continuous & w1=h.0 &
w3=h.1;

theorem 
  for P being Subset of TOP-REAL n, w1,w2,w3,w4 being Point of
TOP-REAL n st w1 in P & w2 in P & w3 in P & w4 in P & LSeg(w1,w2) c= P & LSeg(
w2,w3) c= P & LSeg(w3,w4) c= P ex h being Function of I[01],(TOP-REAL n) |P
st h is continuous & w1=h.0 & w4=h.1;

theorem 
  for P being Subset of TOP-REAL n, w1,w2,w3,w4,w5,w6,w7 being
Point of TOP-REAL n st w1 in P & w2 in P & w3 in P & w4 in P & w5 in P & w6 in
P & w7 in P & LSeg(w1,w2) c= P & LSeg(w2,w3) c= P & LSeg(w3,w4) c= P & LSeg(w4,
  w5) c= P & LSeg(w5,w6) c= P & LSeg(w6,w7) c= P ex h being Function of I[01],(
  TOP-REAL n) |P st h is continuous & w1=h.0 & w7=h.1;

theorem 
  for w1,w2 being Point of TOP-REAL n,P being Subset of
  TopSpaceMetr(Euclid n) st P=LSeg(w1,w2)& not (0.TOP-REAL n) in LSeg(w1,w2)
holds ex w0 being Point of TOP-REAL n st w0 in LSeg(w1,w2) & |.w0.|>0 & |.w0.|=
  (dist_min(P)).(0.TOP-REAL n);

theorem 
  for a being Real, Q being Subset of TOP-REAL n, w1,w4 being
  Point of TOP-REAL n st Q={q : (|.q.|) > a } & w1 in Q & w4 in Q & not (ex r
  being Real st w1=r*w4 or w4=r*w1) holds ex w2,w3 being Point of TOP-REAL n st
  w2 in Q & w3 in Q & LSeg(w1,w2) c=Q & LSeg(w2,w3) c= Q & LSeg(w3,w4) c= Q;

theorem 
  for a being Real, Q being Subset of TOP-REAL n, w1,w4 being
Point of TOP-REAL n st Q=(REAL n)\ {q : (|.q.|) < a } & w1 in Q & w4 in Q & not
(ex r being Real st w1=r*w4 or w4=r*w1) holds ex w2,w3 being Point of TOP-REAL
n st w2 in Q & w3 in Q & LSeg(w1,w2) c=Q & LSeg(w2,w3) c= Q & LSeg(w3,w4) c= Q;

theorem 
  for f being FinSequence of REAL holds f is Element of REAL (len
  f) & f is Point of TOP-REAL (len f);

theorem 
  for x being Element of REAL n,f,g being FinSequence of REAL, r
being Real st f=x & g=r*x holds len f=len g & for i being Element of NAT st 1<=
  i & i<=len f holds g/.i=r*f/.i;

theorem 
  for x being Element of REAL n,f being FinSequence st x<> 0*n & x
  =f holds ex i being Element of NAT st 1<=i & i<=n & f.i<>0;

theorem 
  for x being Element of REAL n st n>=2 & x<> 0*n holds ex y being
  Element of REAL n st not ex r being Real st y=r*x or x=r*y;

theorem 
  for a being Real, Q being Subset of TOP-REAL n, w1,w7 being
Point of TOP-REAL n st n>=2 & Q={q : (|.q.|) > a } & w1 in Q & w7 in Q & (ex r
  being Real st w1=r*w7 or w7=r*w1) holds ex w2,w3,w4,w5,w6 being Point of
TOP-REAL n st w2 in Q & w3 in Q & w4 in Q & w5 in Q & w6 in Q & LSeg(w1,w2) c=Q
  & LSeg(w2,w3) c= Q & LSeg(w3,w4) c= Q & LSeg(w4,w5) c= Q & LSeg(w5,w6) c=Q &
  LSeg(w6,w7) c= Q;

theorem 
  for a being Real, Q being Subset of TOP-REAL n, w1,w7 being
Point of TOP-REAL n st n>=2 & Q=(REAL n)\ {q : (|.q.|) < a } & w1 in Q & w7 in
Q & (ex r being Real st w1=r*w7 or w7=r*w1) holds ex w2,w3,w4,w5,w6 being Point
of TOP-REAL n st w2 in Q & w3 in Q & w4 in Q & w5 in Q & w6 in Q & LSeg(w1,w2)
c=Q & LSeg(w2,w3) c= Q & LSeg(w3,w4) c= Q & LSeg(w4,w5) c= Q & LSeg(w5,w6) c=Q
  & LSeg(w6,w7) c= Q;

theorem 
  for a being Real st n>=1 holds {q: |.q.| >a} <>{};

theorem 
  for a being Real, P being Subset of TOP-REAL n st n>=2 & P={q :
  |.q.| > a } holds P is connected;

theorem 
  for a being Real st n>=1 holds (REAL n) \ {q: |.q.| < a} <> {};

theorem 
  for a being Real,P being Subset of TOP-REAL n st n>=2 & P=(REAL
  n)\ {q : |.q.| < a } holds P is connected;

theorem 
  for a being Real,n being Element of NAT, P being Subset of
TOP-REAL n st n>=1 & P=(REAL n)\ {q where q is Point of TOP-REAL n: |.q.| < a }
  holds not P is bounded;

theorem 
  for a being Real,P being Subset of TOP-REAL 1 st P={q where q is
  Point of TOP-REAL 1: ex r st q=<*r*> & r > a } holds P is convex;

theorem 
  for a being Real,P being Subset of TOP-REAL 1 st P={q where q is
  Point of TOP-REAL 1 : ex r st q=<*r*> & r < -a } holds P is convex;

canceled 2;

theorem 
  for W being Subset of Euclid 1,a being Real
   st W={q where q is Point of TOP-REAL 1 : ex r st q=<*r*> & r > a }
  holds W is not bounded;

theorem 
  for W being Subset of Euclid 1,a being Real
    st W={q where q is Point of TOP-REAL 1 : ex r st q=<*r*> & r < -a }
   holds W is not bounded;

theorem 
  for W being Subset of Euclid n,a being Real
   st n>=2 & W={q : |.q.| > a } holds W is not bounded;

theorem 
  for W being Subset of Euclid n,a being Real
   st n>=2 & W=(REAL n)\ {q : (|.q.|) < a } holds W is not bounded;

theorem 
  for P, P1 being Subset of TOP-REAL n, Q being Subset of TOP-REAL
n, W being Subset of Euclid n st P=W & P is connected & W is not bounded & P1=
  Component_of (Down(P,Q`)) & W misses Q holds P1 is_outside_component_of Q;

theorem 
  for A being Subset of Euclid n, B being non empty Subset of
  Euclid n, C being Subset of (Euclid n) | B st A=C & C is bounded holds A is
  bounded;

theorem 
  for A being Subset of TOP-REAL n st A is compact holds A is bounded;

registration
  let n be Element of NAT;
  cluster compact -> bounded for Subset of TOP-REAL n;
end;

theorem 
  for A being Subset of TOP-REAL n st 1<=n & A is bounded holds A` <> {};

theorem 
  for r being Real holds (ex B being Subset of Euclid n st B={q :
(|.q.|) < r }) & for A being Subset of Euclid n st A={q1 : (|.q1.|) < r } holds
  A is bounded;

theorem 
  for A being Subset of TOP-REAL n st n>=2 & A is bounded holds
  UBD A is_outside_component_of A;

theorem 
  for a being Real, P being Subset of TOP-REAL n st P={q : (|.q.|)
  < a } holds P is convex;

theorem 
  for a being Real,P being Subset of TOP-REAL n st P=Ball(u,a)
  holds P is convex;

reserve R for Subset of TOP-REAL n;
reserve P,Q for Subset of TOP-REAL n;

canceled;

theorem 
  p <> q & p in Ball(u,r) & q in Ball(u,r) implies ex h being
Function of I[01],TOP-REAL n st h is continuous & h.0=p & h.1=q & rng h c= Ball
  (u,r);

theorem 
  for f being Function of I[01],TOP-REAL n st f is continuous & f.
0=p1 & f.1=p2 & p in Ball(u,r) & p2 in Ball(u,r) ex h being Function of I[01],
  TOP-REAL n st h is continuous & h.0=p1 & h.1=p & rng h c= rng f \/ Ball(u,r);

theorem 
  for f being Function of I[01],TOP-REAL n st f is continuous &
rng f c=P & f.0=p1 & f.1=p2 & p in Ball(u,r) & p2 in Ball(u,r) & Ball(u,r) c= P
ex f1 being Function of I[01],TOP-REAL n st f1 is continuous & rng f1 c= P & f1
  .0=p1 & f1.1=p;

theorem 
  for p for P being Subset of TOP-REAL n st R is connected & R is
open & P = {q: q<>p & q in R & not ex f being Function of I[01],TOP-REAL n st f
  is continuous & rng f c= R & f.0=p & f.1=q} holds P is open;

theorem 
  for P being Subset of TOP-REAL n st R is connected & R is open &
  p in R & P = {q: q=p or ex f being Function of I[01],TOP-REAL n st f is
  continuous & rng f c= R & f.0=p & f.1=q} holds P is open;

theorem 
  for R being Subset of TOP-REAL n holds p in R & P={q: q=p or ex
f being Function of I[01],TOP-REAL n st f is continuous & rng f c= R & f.0=p &
  f.1=q} implies P c= R;

theorem 
  for R being Subset of TOP-REAL n, p being Point of TOP-REAL n st
R is connected & R is open & p in R & P={q: q=p or ex f being Function of I[01]
  ,TOP-REAL n st f is continuous & rng f c= R & f.0=p & f.1=q} holds R c= P;

theorem 
  for R being Subset of TOP-REAL n, p,q being Point of TOP-REAL n
  st R is connected & R is open & p in R & q in R & p<>q holds ex f being
  Function of I[01],TOP-REAL n st f is continuous & rng f c= R & f.0=p & f.1=q;

theorem 
  for A being Subset of TOP-REAL n, a being real number st A={q:
  |.q.|=a} holds A` is open & A is closed;

theorem 
  for B being non empty Subset of TOP-REAL n st B is open holds
  (TOP-REAL n) | B is locally_connected;

theorem 
  for B being non empty Subset of TOP-REAL n, A being Subset of
  TOP-REAL n,a being real number st A={q: |.q.|=a} & A`=B holds
  (TOP-REAL n) | B is locally_connected;

theorem 
  for f being Function of TOP-REAL n,R^1 st (for q holds f.q=|.q.|
  ) holds f is continuous;

theorem 
  ex f being Function of TOP-REAL n,R^1 st (for q holds f.q=|.q.|)
  & f is continuous;

theorem 
  for g being Function of I[01],TOP-REAL n st g is continuous
holds ex f being Function of I[01],R^1 st (for t being Point of I[01] holds f.t
  =|.g.t.|) & f is continuous;

theorem 
  for g being Function of I[01],TOP-REAL n,a being Real st g is
continuous & |.g/.0 .|<=a & a<=|.g/.1 .| holds ex s being Point of I[01] st
  |.g/.s.|=a;

theorem 
  q=<*r*> implies |.q.|=abs(r);

theorem 
  for A being Subset of TOP-REAL n,a being Real st n>=1 & a>0 & A={q: |.
  q.|=a} holds BDD A is_inside_component_of A;

begin 

reserve D for non vertical non horizontal non empty compact Subset of TOP-REAL
  2;

theorem 
  len (GoB SpStSeq D)=2 & width (GoB SpStSeq D)=2 & (SpStSeq D)/.1
=(GoB SpStSeq D)*(1,2) & (SpStSeq D)/.2=(GoB SpStSeq D)*(2,2) & (SpStSeq D)/.3=
(GoB SpStSeq D)*(2,1) & (SpStSeq D)/.4=(GoB SpStSeq D)*(1,1) & (SpStSeq D)/.5=(
  GoB SpStSeq D)*(1,2);

theorem 
  LeftComp SpStSeq D is non bounded;

theorem 
  LeftComp SpStSeq D c= UBD (L~SpStSeq D);

theorem 
  for G being TopSpace,A,B,C being Subset of G st
  A is a_component & B is a_component & C is connected & A meets C & B
  meets C holds A=B;

theorem 
  for B being Subset of TOP-REAL 2 st B is_a_component_of (L~
  SpStSeq D)` & not B is bounded holds B=LeftComp SpStSeq D;

theorem 
  RightComp SpStSeq D c= BDD (L~SpStSeq D) & RightComp SpStSeq D is bounded;

theorem 
  LeftComp SpStSeq D = UBD (L~SpStSeq D) & RightComp SpStSeq D =
  BDD (L~SpStSeq D);

theorem 
  UBD (L~SpStSeq D)<>{} & UBD (L~SpStSeq D)
is_outside_component_of (L~SpStSeq D) & BDD (L~SpStSeq D)<>{} & BDD (L~SpStSeq
  D) is_inside_component_of (L~SpStSeq D);

begin 

theorem 
  for G being non empty TopSpace, A being Subset of G st A`<>{}
holds A is boundary iff for x being set,V being Subset of G st x in A & x in V
  & V is open ex B being Subset of G st B is_a_component_of A` & V meets B;

theorem 
  for A being Subset of TOP-REAL 2 st A`<>{} holds A is boundary
  & A is Jordan iff ex A1,A2 being Subset of TOP-REAL 2 st A` = A1 \/ A2 & A1
  misses A2 & (Cl A1) \ A1 = (Cl A2) \ A2 & A=(Cl A1) \ A1 & for C1,C2 being
  Subset of (TOP-REAL 2) | A` st C1 = A1 & C2 = A2 holds C1 is a_component
  & C2 is a_component;

theorem 
  for p being Point of TOP-REAL n, P being Subset of TOP-REAL n
  st n>=1 & P={p} holds P is boundary;

theorem 
  for p,q being Point of TOP-REAL 2,r st p`1=q`2 & -p`2=q`1 & p=r
  *q holds p`1=0 & p`2=0 & p=0.TOP-REAL 2;

theorem 
  for q1,q2 being Point of TOP-REAL 2 holds LSeg(q1,q2) is boundary;

registration
  let q1,q2 be Point of TOP-REAL 2;
  cluster LSeg(q1,q2) -> boundary;
end;

theorem 
  for f being FinSequence of TOP-REAL 2 holds L~f is boundary;

registration
  let f be FinSequence of TOP-REAL 2;
  cluster L~f -> boundary;
end;

theorem 
  for ep being Point of Euclid n,p,q being Point of TOP-REAL n st
  p=ep & q in Ball(ep,r) holds |.p-q.|<r & |.q-p.|<r;

theorem 
  for a being Real,p being Point of TOP-REAL 2 st a>0 & p in L~SpStSeq D
  holds ex q being Point of TOP-REAL 2 st q in UBD (L~SpStSeq D) & |.p-q.|<a;

theorem 
  REAL 0 = {0.TOP-REAL 0};

theorem 
  for A being Subset of TOP-REAL n st A is bounded holds BDD A is bounded;

theorem 
  for G being non empty TopSpace,A,B,C,D being Subset of G st B
  is a_component & C is a_component & A \/ B=the carrier of G & C
  misses A holds C=B;

theorem 
  for A being Subset of TOP-REAL 2 st A is bounded & A is Jordan
  holds BDD A is_inside_component_of A;

theorem 
  for a being Real,p being Point of TOP-REAL 2 st a>0 & p in (L~SpStSeq
  D) holds ex q being Point of TOP-REAL 2 st q in BDD (L~SpStSeq D) & |.p-q.|<a
;

begin 

reserve f for clockwise_oriented non constant standard
  special_circular_sequence;

theorem 
  for p being Point of TOP-REAL 2 st f/.1 = N-min L~f & p`1 < W-bound (
  L~f) holds p in LeftComp f;

theorem 
  for p being Point of TOP-REAL 2 st f/.1 = N-min L~f & p`1 > E-bound (
  L~f) holds p in LeftComp f;

theorem 
  for p being Point of TOP-REAL 2 st f/.1 = N-min L~f & p`2 < S-bound (
  L~f) holds p in LeftComp f;

theorem 
  for p being Point of TOP-REAL 2 st f/.1 = N-min L~f & p`2 > N-bound (
  L~f) holds p in LeftComp f;



theorem 
  for T being TopSpace, A being Subset of T, B being Subset of T st B
  is_a_component_of A holds B is connected;

theorem 
  for A being Subset of TOP-REAL n, B being Subset of TOP-REAL n st B
  is_inside_component_of A holds B is connected;

theorem 
  for A being Subset of TOP-REAL n, B being Subset of TOP-REAL n
  st B is_outside_component_of A holds B is connected;

theorem 
  for A being Subset of TOP-REAL n, B being Subset of TOP-REAL n st B
  is_a_component_of A` holds A misses B;

theorem 
  P is_outside_component_of Q & R is_inside_component_of Q implies P misses R;

theorem 
  2 <= n implies for A, B, P being Subset of TOP-REAL n st P is bounded
  & A is_outside_component_of P & B is_outside_component_of P holds A = B;

registration
  let C be closed Subset of TOP-REAL 2;
  cluster BDD C -> open;
  cluster UBD C -> open;
end;

registration
  let C be compact Subset of TOP-REAL 2;
  cluster UBD C -> connected;
end;



reserve p for Point of TOP-REAL 2;

theorem 
  west_halfline p is non bounded;

theorem 
  east_halfline p is non bounded;

theorem 
  north_halfline p is non bounded;

theorem 
  south_halfline p is non bounded;

registration
  let C be compact Subset of TOP-REAL 2;
  cluster UBD C -> non empty;
end;

theorem 
  for C being compact Subset of TOP-REAL 2 holds UBD C is_a_component_of C`;

theorem 
  for C being compact Subset of TOP-REAL 2 for WH being connected
  Subset of TOP-REAL 2 st WH is non bounded & WH misses C holds WH c= UBD C;

theorem 
  for C being compact Subset of TOP-REAL 2 for p being Point of TOP-REAL
  2 st west_halfline p misses C holds west_halfline p c= UBD C;

theorem 
  for C being compact Subset of TOP-REAL 2 for p being Point of TOP-REAL
  2 st east_halfline p misses C holds east_halfline p c= UBD C;

theorem 
  for C being compact Subset of TOP-REAL 2 for p being Point of TOP-REAL
  2 st south_halfline p misses C holds south_halfline p c= UBD C;

theorem 
  for C being compact Subset of TOP-REAL 2 for p being Point of TOP-REAL
  2 st north_halfline p misses C holds north_halfline p c= UBD C;

theorem 
 for n being Nat, r being Real st r > 0
 for x,y,z being Element of Euclid n st x = 0*n
 for p being Element of TOP-REAL n st p = y & r*p = z
 holds r*dist(x,y) = dist(x,z);

theorem 
 for n being Nat, r,s being Real st r > 0
 for x being Element of Euclid n st x = 0*n
 for A being Subset of TOP-REAL n st A = Ball(x,s)
  holds r*A = Ball(x,r*s);

theorem 
 for n being Nat, r,s,t be Real st 0 < s & s <= t
 for x being Element of Euclid n st x = 0*n
 for BA being Subset of TOP-REAL n st BA = Ball(x,r)
 holds s*BA c= t*BA;














begin

reserve i,j,l for Element of NAT;

theorem 
  for f being S-Sequence_in_R2, Q being closed Subset of TOP-REAL 2
st L~f meets Q & not f/.1 in Q holds L~R_Cut(f,First_Point(L~f,f/.1,f/.len f,Q)
  ) /\ Q = { First_Point(L~f,f/.1,f/.len f,Q) };

theorem 
  for f being non empty FinSequence of TOP-REAL 2, p being Point of
  TOP-REAL 2 st f is being_S-Seq & p = f/.len f holds L~L_Cut (f,p) = {};

theorem 
  for f being S-Sequence_in_R2, p being Point of TOP-REAL 2, j st 1
  <=j & j < len f & p in L~mid(f,j,len f) holds LE f/.j, p, L~f, f/.1, f/.len f
;

theorem 
  for f being S-Sequence_in_R2, p,q being Point of TOP-REAL 2, j st
1 <=j & j < len f & p in LSeg(f,j) & q in LSeg(p,f/.(j+1)) holds LE p, q, L~f,
  f/.1, f/.len f;

theorem 
  for f being S-Sequence_in_R2, Q being closed Subset of TOP-REAL 2
st L~f meets Q & not f/.len f in Q holds L~L_Cut(f,Last_Point(L~f,f/.1,f/.len f
  ,Q)) /\ Q = { Last_Point(L~f,f/.1,f/.len f,Q) };

reserve q for Point of TOP-REAL 2;

theorem 
  for f being non constant standard special_circular_sequence holds
  LeftComp f <> RightComp f;














begin

theorem 
  for T being non empty 1-sorted, S being sequence of T, NS being
  increasing sequence of NAT holds S*NS is sequence of T;

theorem 
  for RS being Real_Sequence st RS=id NAT holds RS is increasing
  sequence of NAT;

theorem 
  for T being non empty 1-sorted, S being sequence of T, A being
Subset of T holds (for S1 being subsequence of S holds not rng S1 c= A) implies
ex n being Element of NAT st for m being Element of NAT st n <= m holds not S.m
  in A;

theorem 
  for T being non empty 1-sorted,S being sequence of T, A,B being
Subset of T st rng S c= A \/ B holds ex S1 being subsequence of S st rng S1 c=
  A or rng S1 c= B;

theorem 
  for T being non empty TopSpace holds (for S being sequence of T holds
  for x1,x2 being Point of T holds (x1 in Lim S & x2 in Lim S implies x1=x2))
  implies T is T_1;

theorem 
  for T being non empty TopSpace st T is T_2 holds for S being
sequence of T, x1,x2 being Point of T holds (x1 in Lim S & x2 in Lim S implies
  x1=x2);

theorem 
  for T being non empty TopSpace st T is first-countable holds T is T_2
iff for S being sequence of T holds for x1,x2 being Point of T holds (x1 in Lim
  S & x2 in Lim S implies x1=x2);

theorem 
  for T being non empty TopStruct, S being sequence of T st S is
  not convergent holds Lim S = {};

theorem 
  for T being non empty TopSpace,A being Subset of T holds A is
  closed implies for S being sequence of T st rng S c= A holds Lim S c= A;

theorem 
  for T being non empty TopStruct,S being sequence of T, x being Point
  of T st not S is_convergent_to x holds ex S1 being subsequence of S st for S2
  being subsequence of S1 holds not S2 is_convergent_to x;

begin 

theorem 
  for T1,T2 being non empty TopSpace, f being Function of T1,T2
holds f is continuous implies for S1 being sequence of T1, S2 being sequence of
  T2 st S2=f*S1 holds f.:(Lim S1) c= Lim S2;

theorem 
  for T1,T2 being non empty TopSpace, f being Function of T1,T2 st T1 is
  sequential holds f is continuous iff for S1 being sequence of T1, S2 being
  sequence of T2 st S2=f*S1 holds f.:(Lim S1) c= Lim S2;

begin 

definition
  let T be non empty TopStruct, A be Subset of T;

  func Cl_Seq A -> Subset of T means


  for x being Point of T holds x in
  it iff ex S being sequence of T st rng S c= A & x in Lim S;
end;

theorem 
  for T being non empty TopStruct, A being Subset of T, S being
  sequence of T, x being Point of T st rng S c= A & x in Lim S holds x in Cl(A)
;

theorem 
  for T being non empty TopStruct, A being Subset of T holds Cl_Seq(A) c= Cl(A)
;

theorem 
  for T being non empty TopStruct, S being sequence of T, S1 being
  subsequence of S, x being Point of T holds S is_convergent_to x implies S1
  is_convergent_to x;

theorem 
  for T being non empty TopStruct, S being sequence of T, S1 being
  subsequence of S holds Lim S c= Lim S1;

theorem 
  for T being non empty TopStruct holds Cl_Seq({}T) = {};

theorem 
  for T being non empty TopStruct, A being Subset of T holds A c= Cl_Seq(A);

theorem 
  for T being non empty TopStruct, A,B being Subset of T holds
  Cl_Seq(A) \/ Cl_Seq(B) = Cl_Seq(A \/ B);

theorem 
  for T being non empty TopStruct holds T is Frechet iff for A
  being Subset of T holds Cl(A)=Cl_Seq(A);

theorem 
  for T being non empty TopSpace st T is Frechet holds for A,B
  being Subset of T holds Cl_Seq({}T) = {} & A c= Cl_Seq(A) & Cl_Seq(A \/ B) =
  Cl_Seq(A) \/ Cl_Seq(B) & Cl_Seq(Cl_Seq(A)) = Cl_Seq(A);

theorem 
  for T being non empty TopSpace st T is sequential holds (for A
  being Subset of T holds Cl_Seq(Cl_Seq(A)) = Cl_Seq(A)) implies T is Frechet;

theorem 
  for T being non empty TopSpace st T is sequential holds T is Frechet
iff for A,B being Subset of T holds Cl_Seq({}T) = {} & A c= Cl_Seq(A) & Cl_Seq(
A \/ B) = Cl_Seq(A) \/ Cl_Seq(B) & Cl_Seq(Cl_Seq(A)) = Cl_Seq(A);

begin 

definition
  let T be non empty TopSpace, S be sequence of T;
  assume
 ex x being Point of T st Lim S = {x};
  func lim S -> Point of T means


  S is_convergent_to it;
end;

theorem 
  for T being non empty TopSpace st T is T_2 for S being sequence
  of T st S is convergent holds ex x being Point of T st Lim S = {x};

theorem 
  for T being non empty TopSpace st T is T_2 for S being sequence
  of T,x being Point of T holds S is_convergent_to x iff S is convergent & x =
  lim S;

theorem 
  for M being MetrStruct,S being sequence of M holds S is sequence of
  TopSpaceMetr(M);

theorem 
  for M being non empty MetrStruct,S being sequence of TopSpaceMetr(M)
  holds S is sequence of M;

theorem 
  for M being non empty MetrSpace,S being sequence of M, x being
  Point of M, S9 being sequence of TopSpaceMetr(M), x9 being Point of
TopSpaceMetr(M) st S = S9 & x = x9 holds S is_convergent_in_metrspace_to x iff
  S9 is_convergent_to x9;

theorem 
  for M being non empty MetrSpace,Sm being sequence of M, St being
  sequence of TopSpaceMetr(M) st Sm=St holds Sm is convergent iff St is
  convergent;

theorem 
  for M being non empty MetrSpace,Sm being sequence of M, St being
  sequence of TopSpaceMetr(M) st Sm=St & Sm is convergent holds lim Sm = lim St
;

begin 

definition
  let T be TopStruct, S be sequence of T, x be Point of T;
  pred x is_a_cluster_point_of S means


  for O being Subset of T, n being
Element of NAT st O is open & x in O ex m being Element of NAT st n <= m & S.m
  in O;
end;

theorem 
  for T being non empty TopStruct, S being sequence of T, x being
  Point of T st ex S1 being subsequence of S st S1 is_convergent_to x holds x
  is_a_cluster_point_of S;

theorem 
  for T being non empty TopStruct, S being sequence of T, x being Point
  of T st S is_convergent_to x holds x is_a_cluster_point_of S;

theorem 
  for T being non empty TopStruct, S being sequence of T, x being
Point of T, Y being Subset of T st Y = {y where y is Point of T : x in Cl({y})
  } & rng S c= Y holds S is_convergent_to x;

theorem 
  for T being non empty TopStruct, S being sequence of T, x,y
  being Point of T st for n being Element of NAT holds S.n = y & S
  is_convergent_to x holds x in Cl({y});

theorem 
  for T being non empty TopStruct, x being Point of T, Y being
Subset of T, S being sequence of T st Y = { y where y is Point of T : x in Cl({
  y}) } & rng S misses Y & S is_convergent_to x ex S1 being subsequence of S st
  S1 is one-to-one;

theorem 
  for T being non empty TopStruct, S1,S2 being sequence of T st
  rng S2 c= rng S1 & S2 is one-to-one ex P being Permutation of NAT st S2*P is
  subsequence of S1;

scheme 

  PermSeq {T()->non empty 1-sorted,S()->sequence of T(),p()->Permutation of
NAT, P[set]} : ex n being Element of NAT st for m being Element of NAT st n<=m
  holds P[(S()*p()).m]
provided
 ex n being Element of NAT st for m being Element of NAT, x being
Point of T() st n<=m & x=S().m holds P[x];

scheme 

  PermSeq2 {T()->non empty TopStruct,S()->sequence of T(),p()->Permutation of
NAT, P[set]} : ex n being Element of NAT st for m being Element of NAT st n<=m
  holds P[(S()*p()).m]
provided
 ex n being Element of NAT st for m being Element of NAT, x being
Point of T() st n<=m & x=S().m holds P[x];

theorem 
  for T being non empty TopStruct, S being sequence of T, P being
  Permutation of NAT, x being Point of T st S is_convergent_to x holds S*P
  is_convergent_to x;

theorem 
  for n0 being Element of NAT ex NS being increasing sequence of NAT st
  for n being Element of NAT holds NS.n=n+n0;

theorem 
  for T being non empty TopStruct, S being sequence of T, x being
  Point of T, n0 being Nat st x is_a_cluster_point_of S holds x
  is_a_cluster_point_of S^\n0;

theorem 
  for T being non empty TopStruct, S being sequence of T, x being
  Point of T st x is_a_cluster_point_of S holds x in Cl(rng S);

theorem 
  for T being non empty TopStruct st T is Frechet for S being sequence
  of T, x being Point of T st x is_a_cluster_point_of S holds ex S1 being
  subsequence of S st S1 is_convergent_to x;

begin 

theorem 
  for T being non empty TopSpace st T is first-countable holds for x
being Point of T holds ex B being Basis of x st ex S being Function st dom S =
  NAT & rng S = B & for n,m being Element of NAT st m >= n holds S.m c= S.n;

theorem 
  for T being non empty TopSpace st for p being Point of T holds Cl({p})
  = {p} holds T is T_1;

theorem 
  for T being non empty TopSpace holds T is T_2 implies T is T_1;

theorem 
  for T being non empty TopSpace st not T is T_1 holds ex x1,x2 being
  Point of T, S being sequence of T st S = (NAT --> x1) & x1 <> x2 & S
  is_convergent_to x2;














begin  

reserve a, b for real number,
  r for Real,
  i, j, n for Element of NAT,
  M for non empty MetrSpace,
  p, q, s for Point of TOP-REAL 2,
  e for Point of Euclid 2,
  w for Point of Euclid n,
  z for Point of M,
  A, B for Subset of TOP-REAL n,
  P for Subset of TOP-REAL 2,
  D for non empty Subset of TOP-REAL 2;

theorem 
  0 <= a & 0 <= b implies sqrt(a+b) <= sqrt a + sqrt b;

theorem 
  0 <= a & a <= b implies abs(a) <= abs(b);

theorem 
  b <= a & a <= 0 implies abs(a) <= abs(b);

theorem 
  Product(0|->r) = 1;

theorem 
  Product(1|->r) = r;

theorem 
  Product(2|->r) = r * r;

theorem 
  Product((n+1) |-> r) = (Product(n|->r))*r;

theorem 
  j <> 0 & r = 0 iff Product(j|->r) = 0;

theorem 
  r <> 0 & j <= i implies Product((i-'j) |-> r) = Product(i|->r) /
  Product(j|->r);

theorem 
  r <> 0 & j <= i implies r|^(i-'j) = r|^i / r|^j;

reserve a, b for Real;

theorem 
  sqr <*a,b*> = <*a^2,b^2*>;

theorem 
  for i be Nat for F being FinSequence of REAL st i in dom abs F &
  a = F.i holds (abs F).i = abs(a);

theorem 
  abs <*a,b*> = <*abs(a),abs(b)*>;

theorem 
  for a, b, c, d being real number st a <= b & c <= d holds abs(b-a) +
  abs(d-c) = (b-a) + (d-c);

theorem 
  for a, r being real number holds r > 0 implies a in ].a-r,a+r.[;

theorem 
  for a, r being real number holds r >= 0 implies a in [.a-r,a+r.];

theorem 
  for a, b being real number holds a < b implies lower_bound ].a,b.[ = a &
  upper_bound ].a,b.[ = b;

begin  

registration
  let T be TopStruct, A be finite Subset of T;
  cluster T|A -> finite;
end;

registration
  let T be TopStruct;
  cluster empty -> connected for Subset of T;
end;

canceled;

theorem 
  for S, T being TopSpace st S, T are_homeomorphic & S is
  connected holds T is connected;

theorem 
  for T being TopSpace, F being finite Subset-Family of T st for X being
  Subset of T st X in F holds X is compact holds union F is compact;

begin

theorem 
  for A, B, C, D, a, b being set st A c= B & C c= D holds product
  ((a,b) --> (A,C)) c= product ((a,b) --> (B,D));

theorem 
  for A, B being Subset of REAL holds product ((1,2) --> (A,B)) is
  Subset of TOP-REAL 2;

theorem 
  |.|[0,a]|.| = abs(a) & |.|[a,0]|.| = abs(a);

theorem 
  for p being Point of Euclid 2, q being Point of TOP-REAL 2 st p
  = 0.TOP-REAL 2 & p = q holds q = <* 0,0 *> & q`1 = 0 & q`2 = 0;

theorem 
  for p, q being Point of Euclid 2, z being Point of TOP-REAL 2 st p =
  0.REAL 2 & q = z holds dist(p,q) = |.z.|;

theorem 
  r*p = |[r*p`1,r*p`2]|;

theorem 
  s = (1-r)*p + r*q & s <> p & 0 <= r implies 0 < r;

theorem 
  s = (1-r)*p + r*q & s <> q & r <= 1 implies r < 1;

theorem 
  s in LSeg(p,q) & s <> p & s <> q & p`1 < q`1 implies p`1 < s`1 & s`1 < q`1;

theorem 
  s in LSeg(p,q) & s <> p & s <> q & p`2 < q`2 implies p`2 < s`2 & s`2 < q`2;

theorem 
  for p being Point of TOP-REAL 2 ex q being Point of TOP-REAL 2 st q`1
  < W-bound D & p <> q;

theorem 
  for p being Point of TOP-REAL 2 ex q being Point of TOP-REAL 2 st q`1
  > E-bound D & p <> q;

theorem 
  for p being Point of TOP-REAL 2 ex q being Point of TOP-REAL 2 st q`2
  > N-bound D & p <> q;

theorem 
  for p being Point of TOP-REAL 2 ex q being Point of TOP-REAL 2 st q`2
  < S-bound D & p <> q;

registration
  cluster non horizontal -> non empty for Subset of TOP-REAL 2;
  cluster non vertical -> non empty for Subset of TOP-REAL 2;
  cluster being_Region -> open connected for Subset of TOP-REAL 2;
  cluster open connected -> being_Region for Subset of TOP-REAL 2;
end;

registration
  cluster empty -> horizontal for Subset of TOP-REAL 2;
  cluster empty -> vertical for Subset of TOP-REAL 2;
end;

registration
  cluster non empty convex for Subset of TOP-REAL 2;
end;

registration
  let a, b be Point of TOP-REAL 2;
  cluster LSeg(a,b) -> connected;
end;

registration
  cluster R^2-unit_square -> connected;
end;

registration
  cluster being_simple_closed_curve -> connected for Subset of TOP-REAL 2;
end;

theorem 
  LSeg(NE-corner P,SE-corner P) c= L~SpStSeq P;

theorem 
  LSeg(SW-corner P,SE-corner P) c= L~SpStSeq P;

theorem 
  LSeg(SW-corner P,NW-corner P) c= L~SpStSeq P;

theorem 
  for C being Subset of TOP-REAL 2 holds {p where p is Point of TOP-REAL
  2: p`1 < W-bound C} is non empty convex connected Subset of TOP-REAL 2;

begin  

reserve r for real number;

theorem 
  e = q & p in Ball(e,r) implies q`1-r < p`1 & p`1 < q`1+r;

theorem 
  e = q & p in Ball(e,r) implies q`2-r < p`2 & p`2 < q`2+r;

theorem 
  p = e implies product ((1,2) --> (].p`1-r/sqrt 2,p`1+r/sqrt 2.[,
  ].p`2-r/sqrt 2,p`2+r/sqrt 2.[)) c= Ball(e,r);

theorem 
  p = e implies Ball(e,r) c= product((1,2)-->(].p`1-r,p`1+r.[,].p
  `2-r,p`2+r.[));

theorem 
  P = Ball(e,r) & p = e implies proj1.:P = ].p`1-r,p`1+r.[;

theorem 
  P = Ball(e,r) & p = e implies proj2.:P = ].p`2-r,p`2+r.[;

theorem 
  D = Ball(e,r) & p = e implies W-bound D = p`1 - r;

theorem 
  D = Ball(e,r) & p = e implies E-bound D = p`1 + r;

theorem 
  D = Ball(e,r) & p = e implies S-bound D = p`2 - r;

theorem 
  D = Ball(e,r) & p = e implies N-bound D = p`2 + r;

theorem 
  D = Ball(e,r) implies D is non horizontal;

theorem 
  D = Ball(e,r) implies D is non vertical;

theorem 
  for f being Point of Euclid 2, x being Point of TOP-REAL 2 st x in
  Ball(f,a) holds not |[x`1-2*a,x`2]| in Ball(f,a);

theorem 
  for X being non empty compact Subset of TOP-REAL 2, p being Point of
  Euclid 2 st p = 0.TOP-REAL 2 & a > 0 holds X c= Ball(p, abs(E-bound X)+abs(
  N-bound X)+abs(W-bound X)+abs(S-bound X)+a);

theorem 
  for M being Reflexive symmetric triangle non empty MetrStruct,
  z being Point of M holds r < 0 implies Sphere(z,r) = {};

theorem 
  for M being Reflexive discerning non empty MetrStruct, z being Point
  of M holds Sphere(z,0) = {z};

theorem 
  for M being Reflexive symmetric triangle non empty MetrStruct, z
  being Point of M holds r < 0 implies cl_Ball(z,r) = {};

theorem 
  cl_Ball(z,0) = {z};

theorem 
  for A being Subset of TopSpaceMetr M st A = cl_Ball(z,r) holds A is closed;

theorem 
  A = cl_Ball(w,r) implies A is closed;

theorem 
  for r being real number for M be Reflexive symmetric triangle
  non empty MetrStruct for x be Element of M holds cl_Ball(x,r) is bounded;

theorem 
  for A being Subset of TopSpaceMetr M st A = Sphere(z,r) holds A is closed;

theorem 
  A = Sphere(w,r) implies A is closed;

theorem 
  Sphere(z,r) is bounded;

theorem 
  A is bounded implies Cl A is bounded;

theorem 
  for M being non empty MetrStruct holds M is bounded iff for X being
  Subset of M holds X is bounded;

theorem 
  for M being Reflexive symmetric triangle non empty MetrStruct,
  X, Y being Subset of M st the carrier of M = X \/ Y & M is non bounded & X is
  bounded holds Y is non bounded;

theorem 
  for X, Y being Subset of TOP-REAL n st n >= 1 & the carrier of
  TOP-REAL n = X \/ Y & X is bounded holds Y is non bounded;

theorem 
  A is bounded & B is bounded implies A \/ B is bounded;

begin  

registration
  let X be non empty Subset of REAL;
  cluster Cl X -> non empty;
end;

registration
  let D be bounded_below Subset of REAL;
  cluster Cl D -> bounded_below;
end;

registration
  let D be bounded_above Subset of REAL;
  cluster Cl D -> bounded_above;
end;

theorem 
  for D being non empty bounded_below Subset of REAL holds lower_bound D =
  lower_bound Cl D;

theorem 
  for D being non empty bounded_above Subset of REAL holds upper_bound D =
  upper_bound Cl D;

registration
  cluster R^1 -> T_2;
end;

canceled 5;

theorem 
  for A, B being Subset of REAL, f being Function of [:R^1,R^1:],
  TOP-REAL 2 st for x, y being Real holds f. [x,y] = <*x,y*> holds f.:[:A,B:] =
  product ((1,2) --> (A,B));

theorem 
  for f being Function of [:R^1,R^1:], TOP-REAL 2 st for x, y
  being Real holds f. [x,y] = <*x,y*> holds f is being_homeomorphism;

theorem 
  [:R^1,R^1:], TOP-REAL 2 are_homeomorphic;

begin  

theorem 
  for A, B being compact Subset of REAL holds product ((1,2) --> (
  A,B)) is compact Subset of TOP-REAL 2;

theorem 
  P is bounded closed implies P is compact;

theorem 
  P is bounded implies for g being continuous RealMap of TOP-REAL
  2 holds Cl(g.:P) c= g.:Cl P;

theorem 
  proj1.:Cl P c= Cl(proj1.:P);

theorem 
  proj2.:Cl P c= Cl(proj2.:P);

theorem 
  P is bounded implies Cl(proj1.:P) = proj1.:Cl P;

theorem 
  P is bounded implies Cl(proj2.:P) = proj2.:Cl P;

theorem 
  D is bounded implies W-bound D = W-bound Cl D;

theorem 
  D is bounded implies E-bound D = E-bound Cl D;

theorem 
  D is bounded implies N-bound D = N-bound Cl D;

theorem 
  D is bounded implies S-bound D = S-bound Cl D;



theorem 
  for A,B being Subset of TOP-REAL n holds A is bounded or B is
  bounded implies A /\ B is bounded;

theorem 
  for A,B being Subset of TOP-REAL n holds A is not bounded & B is
  bounded implies A \ B is not bounded;

begin 


definition
  let n be Element of NAT, a, b be Point of TOP-REAL n;
  func dist(a,b) -> Real means


  ex p, q being Point of Euclid n st p = a & q = b & it = dist(p,q);
  commutativity;
end;

reserve r1,r2,s1,s2 for real number;

theorem 
  for u,v being Point of Euclid 2 st u = |[r1,s1]| & v = |[r2,s2
  ]| holds dist(u,v) =sqrt ((r1 - r2)^2 + (s1 - s2)^2);

theorem 
  dist(p,q) = sqrt ((p`1-q`1)^2 + (p`2-q`2)^2);

theorem 
  for p being Point of TOP-REAL n holds dist(p,p) = 0;

theorem 
  for p, q, r being Point of TOP-REAL n holds dist(p,r) <= dist (p,q) +
  dist(q,r);

theorem 
  for x1, x2, y1, y2 being real number, a, b being Point of TOP-REAL 2
  st x1 <= a`1 & a`1 <= x2 & y1 <= a`2 & a`2 <= y2 & x1 <= b`1 & b`1 <= x2 & y1
  <= b`2 & b`2 <= y2 holds dist(a,b) <= (x2-x1) + (y2-y1);















begin 

reserve x for real number;

theorem 
  for p being Point of TOP-REAL 2 holds |.p.| = sqrt((p`1)^2+(p`2)^2) &
  |.p.|^2 = (p`1)^2+(p`2)^2;

theorem 
  for f being Function,B,C being set holds (f|B).:C = f.:(C /\ B);

theorem 
  for X,Y being non empty TopSpace, p0 being Point of X, D being
  non empty Subset of X, E being non empty Subset of Y, f being Function of X,Y
st D`={p0} & E`={f.p0} & X is T_2 & Y is T_2 & (for p being Point of X|D holds
f.p<>f.p0)& f|D is continuous Function of X|D,Y|E & (for V being Subset of Y st
f.p0 in V & V is open ex W being Subset of X st p0 in W & W is open & f.:W c= V
  ) holds f is continuous;

begin 

reserve p,q for Point of TOP-REAL 2;

definition
  func Sq_Circ -> Function of the carrier of TOP-REAL 2, the carrier of
  TOP-REAL 2 means


  for p being Point of TOP-REAL 2 holds (p=0.TOP-REAL 2
  implies it.p=p) & ((p`2<=p`1 & -p`1<=p`2 or p`2>=p`1 & p`2<=-p`1)& p<>0.
TOP-REAL 2 implies it.p=|[p`1/sqrt(1+(p`2/p`1)^2),p`2/sqrt(1+(p`2/p`1)^2)]|)& (
not(p`2<=p`1 & -p`1<=p`2 or p`2>=p`1 & p`2<=-p`1)& p<>0.TOP-REAL 2 implies it.p
  =|[p`1/sqrt(1+(p`1/p`2)^2),p`2/sqrt(1+(p`1/p`2)^2)]|);
end;

theorem 
  for p being Point of TOP-REAL 2 st p<>0.TOP-REAL 2 holds ((p`1<=
p`2 & -p`2<=p`1 or p`1>=p`2 & p`1<=-p`2)implies Sq_Circ.p=|[p`1/sqrt(1+(p`1/p`2
)^2),p`2/sqrt(1+(p`1/p`2)^2)]|) & (not(p`1<=p`2 & -p`2<=p`1 or p`1>=p`2 & p`1<=
  -p`2) implies Sq_Circ.p=|[p`1/sqrt(1+(p`2/p`1)^2),p`2/sqrt(1+(p`2/p`1)^2)]|);

theorem 
  for X being non empty TopSpace, f1 being Function of X,R^1 st f1
is continuous & (for q being Point of X ex r being real number st f1.q=r & r>=0
  ) holds ex g being Function of X,R^1 st (for p being Point of X,r1 being real
  number st f1.p=r1 holds g.p=sqrt(r1)) & g is continuous;

theorem 
  for X being non empty TopSpace, f1,f2 being Function of X,R^1 st
  f1 is continuous & f2 is continuous & (for q being Point of X holds f2.q<>0)
holds ex g being Function of X,R^1 st (for p being Point of X,r1,r2 being real
  number st f1.p=r1 & f2.p=r2 holds g.p=(r1/r2)^2) & g is continuous;

theorem 
  for X being non empty TopSpace, f1,f2 being Function of X,R^1 st
  f1 is continuous & f2 is continuous & (for q being Point of X holds f2.q<>0)
holds ex g being Function of X,R^1 st (for p being Point of X,r1,r2 being real
  number st f1.p=r1 & f2.p=r2 holds g.p=1+(r1/r2)^2) & g is continuous;

theorem 
  for X being non empty TopSpace, f1,f2 being Function of X,R^1 st
  f1 is continuous & f2 is continuous & (for q being Point of X holds f2.q<>0)
holds ex g being Function of X,R^1 st (for p being Point of X,r1,r2 being real
  number st f1.p=r1 & f2.p=r2 holds g.p=sqrt(1+(r1/r2)^2)) & g is continuous;

theorem 
  for X being non empty TopSpace, f1,f2 being Function of X,R^1 st
  f1 is continuous & f2 is continuous & (for q being Point of X holds f2.q<>0)
holds ex g being Function of X,R^1 st (for p being Point of X,r1,r2 being real
  number st f1.p=r1 & f2.p=r2 holds g.p=r1/sqrt(1+(r1/r2)^2)) & g is continuous
;

theorem 
  for X being non empty TopSpace, f1,f2 being Function of X,R^1 st
  f1 is continuous & f2 is continuous & (for q being Point of X holds f2.q<>0)
holds ex g being Function of X,R^1 st (for p being Point of X,r1,r2 being real
  number st f1.p=r1 & f2.p=r2 holds g.p=r2/sqrt(1+(r1/r2)^2)) & g is continuous
;

theorem 
  for K1 being non empty Subset of TOP-REAL 2, f being Function of
(TOP-REAL 2)|K1,R^1 st (for p being Point of TOP-REAL 2 st p in the carrier of
  (TOP-REAL 2)|K1 holds f.p=p`1/sqrt(1+(p`2/p`1)^2)) & (for q being Point of
  TOP-REAL 2 st q in the carrier of (TOP-REAL 2)|K1 holds q`1<>0 ) holds f is
  continuous;

theorem 
  for K1 being non empty Subset of TOP-REAL 2, f being Function of
(TOP-REAL 2)|K1,R^1 st (for p being Point of TOP-REAL 2 st p in the carrier of
  (TOP-REAL 2)|K1 holds f.p=p`2/sqrt(1+(p`2/p`1)^2)) & (for q being Point of
  TOP-REAL 2 st q in the carrier of (TOP-REAL 2)|K1 holds q`1<>0 ) holds f is
  continuous;

theorem 
  for K1 being non empty Subset of TOP-REAL 2, f being Function of
(TOP-REAL 2)|K1,R^1 st (for p being Point of TOP-REAL 2 st p in the carrier of
  (TOP-REAL 2)|K1 holds f.p=p`2/sqrt(1+(p`1/p`2)^2)) & (for q being Point of
  TOP-REAL 2 st q in the carrier of (TOP-REAL 2)|K1 holds q`2<>0 ) holds f is
  continuous;

theorem 
  for K1 being non empty Subset of TOP-REAL 2, f being Function of
(TOP-REAL 2)|K1,R^1 st (for p being Point of TOP-REAL 2 st p in the carrier of
  (TOP-REAL 2)|K1 holds f.p=p`1/sqrt(1+(p`1/p`2)^2)) & (for q being Point of
  TOP-REAL 2 st q in the carrier of (TOP-REAL 2)|K1 holds q`2<>0 ) holds f is
  continuous;

theorem 
  for K0,B0 being Subset of TOP-REAL 2,f being Function of (
TOP-REAL 2)|K0,(TOP-REAL 2)|B0 st f=Sq_Circ|K0 & B0=NonZero TOP-REAL 2 & K0={p:
  (p`2<=p`1 & -p`1<=p`2 or p`2>=p`1 & p`2<=-p`1) & p<>0.TOP-REAL 2} holds f is
  continuous;

theorem 
  for K0,B0 being Subset of TOP-REAL 2,f being Function of (
TOP-REAL 2)|K0,(TOP-REAL 2)|B0 st f=Sq_Circ|K0 & B0=NonZero TOP-REAL 2 & K0={p:
  (p`1<=p`2 & -p`2<=p`1 or p`1>=p`2 & p`1<=-p`2) & p<>0.TOP-REAL 2} holds f is
  continuous;

scheme 

  TopIncl { P[set] } : { p: P[p] & p<>0.TOP-REAL 2 } c= NonZero TOP-REAL 2;

scheme 

  TopInter { P[set] } : { p: P[p] & p<>0.TOP-REAL 2 } = { p7 where p7 is Point
  of TOP-REAL 2 : P[p7]} /\ (NonZero TOP-REAL 2);

theorem 
  for B0 being Subset of TOP-REAL 2,K0 being Subset of (TOP-REAL 2
)|B0,f being Function of ((TOP-REAL 2)|B0)|K0,((TOP-REAL 2)|B0) st f=Sq_Circ|K0
& B0=NonZero TOP-REAL 2 & K0={p:(p`2<=p`1 & -p`1<=p`2 or p`2>=p`1 & p`2<=-p`1)
  & p<>0.TOP-REAL 2} holds f is continuous & K0 is closed;

theorem 
  for B0 being Subset of TOP-REAL 2,K0 being Subset of (TOP-REAL 2
)|B0,f being Function of ((TOP-REAL 2)|B0)|K0,((TOP-REAL 2)|B0) st f=Sq_Circ|K0
& B0=NonZero TOP-REAL 2 & K0={p:(p`1<=p`2 & -p`2<=p`1 or p`1>=p`2 & p`1<=-p`2)
  & p<>0.TOP-REAL 2} holds f is continuous & K0 is closed;

theorem 
  for D being non empty Subset of TOP-REAL 2 st D`={0.TOP-REAL 2}
  holds ex h being Function of (TOP-REAL 2)|D,(TOP-REAL 2)|D st h=Sq_Circ|D & h
  is continuous;

theorem 
  for D being non empty Subset of TOP-REAL 2 st D=NonZero TOP-REAL
  2 holds D`= {0.TOP-REAL 2};

theorem 
  ex h being Function of TOP-REAL 2, TOP-REAL 2 st h=Sq_Circ & h is continuous;

theorem 
  Sq_Circ is one-to-one;

registration
  cluster Sq_Circ -> one-to-one;
end;

theorem 
  for Kb,Cb being Subset of TOP-REAL 2 st Kb={q: -1=q`1 & -1<=q`2
& q`2<=1 or q`1=1 & -1<=q`2 & q`2<=1 or -1=q`2 & -1<=q`1 & q`1<=1 or 1=q`2 & -1
  <=q`1 & q`1<=1}& Cb={p2 where p2 is Point of TOP-REAL 2: |.p2.|=1} holds
  Sq_Circ.:Kb=Cb;

theorem 
  for P,Kb being Subset of TOP-REAL 2,f being Function of (
TOP-REAL 2)|Kb,(TOP-REAL 2)|P st Kb={q: -1=q`1 & -1<=q`2 & q`2<=1 or q`1=1 & -1
<=q`2 & q`2<=1 or -1=q`2 & -1<=q`1 & q`1<=1 or 1=q`2 & -1<=q`1 & q`1<=1} & f is
  being_homeomorphism holds P is being_simple_closed_curve;

theorem 
  for Kb being Subset of TOP-REAL 2 st Kb={q: -1=q`1 & -1<=q`2 & q
`2<=1 or q`1=1 & -1<=q`2 & q`2<=1 or -1=q`2 & -1<=q`1 & q`1<=1 or 1=q`2 & -1<=q
  `1 & q`1<=1} holds Kb is being_simple_closed_curve & Kb is compact;

theorem 
  for Cb being Subset of TOP-REAL 2 st Cb={p where p is Point of
  TOP-REAL 2: |.p.|=1} holds Cb is being_simple_closed_curve;

begin 

theorem 
  for K0,C0 being Subset of TOP-REAL 2 st K0={p: -1<=p`1 & p`1<=1 & -1<=
  p`2 & p`2<=1} & C0={p1 where p1 is Point of TOP-REAL 2: |.p1.|<=1} holds
  Sq_Circ"(C0) c= K0;

theorem 
  for p holds (p=0.TOP-REAL 2 implies Sq_Circ".p=0.TOP-REAL 2) & (
  (p`2<=p`1 & -p`1<=p`2 or p`2>=p`1 & p`2<=-p`1) & p<>0.TOP-REAL 2 implies
Sq_Circ".p=|[p`1*sqrt(1+(p`2/p`1)^2),p`2*sqrt(1+(p`2/p`1)^2)]|)& (not(p`2<=p`1
& -p`1<=p`2 or p`2>=p`1 & p`2<=-p`1) implies Sq_Circ".p=|[p`1*sqrt(1+(p`1/p`2)
  ^2),p`2*sqrt(1+(p`1/p`2)^2)]|);

theorem 
  Sq_Circ" is Function of TOP-REAL 2,TOP-REAL 2;

theorem 
  for p being Point of TOP-REAL 2 st p<>0.TOP-REAL 2 holds ((p`1<=
p`2 & -p`2<=p`1 or p`1>=p`2 & p`1<=-p`2) implies (Sq_Circ").p=|[p`1*sqrt(1+(p`1
/p`2)^2),p`2*sqrt(1+(p`1/p`2)^2)]|) & (not(p`1<=p`2 & -p`2<=p`1 or p`1>=p`2 & p
`1<=-p`2) implies (Sq_Circ").p=|[p`1*sqrt(1+(p`2/p`1)^2),p`2*sqrt(1+(p`2/p`1)^2
  )]|);

theorem 
  for X being non empty TopSpace, f1,f2 being Function of X,R^1 st
  f1 is continuous & f2 is continuous & (for q being Point of X holds f2.q<>0)
holds ex g being Function of X,R^1 st (for p being Point of X,r1,r2 being real
  number st f1.p=r1 & f2.p=r2 holds g.p=r1*sqrt(1+(r1/r2)^2)) & g is continuous
;

theorem 
  for X being non empty TopSpace, f1,f2 being Function of X,R^1 st
f1 is continuous & f2 is continuous & (for q being Point of X holds f2.q<>0) ex
g being Function of X,R^1 st (for p being Point of X,r1,r2 being real number st
  f1.p=r1 & f2.p=r2 holds g.p=r2*sqrt(1+(r1/r2)^2)) & g is continuous;

theorem 
  for K1 being non empty Subset of TOP-REAL 2, f being Function of
(TOP-REAL 2)|K1,R^1 st (for p being Point of TOP-REAL 2 st p in the carrier of
  (TOP-REAL 2)|K1 holds f.p=p`1*sqrt(1+(p`2/p`1)^2)) & (for q being Point of
  TOP-REAL 2 st q in the carrier of (TOP-REAL 2)|K1 holds q`1<>0 ) holds f is
  continuous;

theorem 
  for K1 being non empty Subset of TOP-REAL 2, f being Function of
(TOP-REAL 2)|K1,R^1 st (for p being Point of TOP-REAL 2 st p in the carrier of
  (TOP-REAL 2)|K1 holds f.p=p`2*sqrt(1+(p`2/p`1)^2)) & (for q being Point of
  TOP-REAL 2 st q in the carrier of (TOP-REAL 2)|K1 holds q`1<>0) holds f is
  continuous;

theorem 
  for K1 being non empty Subset of TOP-REAL 2, f being Function of
(TOP-REAL 2)|K1,R^1 st (for p being Point of TOP-REAL 2 st p in the carrier of
  (TOP-REAL 2)|K1 holds f.p=p`2*sqrt(1+(p`1/p`2)^2)) & (for q being Point of
  TOP-REAL 2 st q in the carrier of (TOP-REAL 2)|K1 holds q`2<>0 ) holds f is
  continuous;

theorem 
  for K1 being non empty Subset of TOP-REAL 2, f being Function of
(TOP-REAL 2)|K1,R^1 st (for p being Point of TOP-REAL 2 st p in the carrier of
  (TOP-REAL 2)|K1 holds f.p=p`1*sqrt(1+(p`1/p`2)^2)) & (for q being Point of
  TOP-REAL 2 st q in the carrier of (TOP-REAL 2)|K1 holds q`2<>0 ) holds f is
  continuous;

theorem 
  for K0,B0 being Subset of TOP-REAL 2,f being Function of (
TOP-REAL 2)|K0,(TOP-REAL 2)|B0 st f=(Sq_Circ")|K0 & B0=NonZero TOP-REAL 2 & K0=
{p:(p`2<=p`1 & -p`1<=p`2 or p`2>=p`1 & p`2<=-p`1) & p<>0.TOP-REAL 2} holds f is
  continuous;

theorem 
  for K0,B0 being Subset of TOP-REAL 2,f being Function of (
TOP-REAL 2)|K0,(TOP-REAL 2)|B0 st f=(Sq_Circ")|K0 & B0=NonZero TOP-REAL 2 & K0=
{p:(p`1<=p`2 & -p`2<=p`1 or p`1>=p`2 & p`1<=-p`2) & p<>0.TOP-REAL 2} holds f is
  continuous;

theorem 
  for B0 being Subset of TOP-REAL 2,K0 being Subset of (TOP-REAL 2
)|B0,f being Function of ((TOP-REAL 2)|B0)|K0,((TOP-REAL 2)|B0) st f=(Sq_Circ")
|K0 & B0=NonZero TOP-REAL 2 & K0={p:(p`2<=p`1 & -p`1<=p`2 or p`2>=p`1 & p`2<=-p
  `1) & p<>0.TOP-REAL 2} holds f is continuous & K0 is closed;

theorem 
  for B0 being Subset of TOP-REAL 2,K0 being Subset of (TOP-REAL 2
)|B0,f being Function of ((TOP-REAL 2)|B0)|K0,((TOP-REAL 2)|B0) st f=(Sq_Circ")
|K0 & B0=NonZero TOP-REAL 2 & K0={p:(p`1<=p`2 & -p`2<=p`1 or p`1>=p`2 & p`1<=-p
  `2) & p<>0.TOP-REAL 2} holds f is continuous & K0 is closed;

theorem 
  for D being non empty Subset of TOP-REAL 2 st D`={0.TOP-REAL 2}
holds ex h being Function of (TOP-REAL 2)|D,(TOP-REAL 2)|D st h=(Sq_Circ")|D &
  h is continuous;

theorem 
  ex h being Function of TOP-REAL 2,TOP-REAL 2 st h=Sq_Circ" & h is continuous;

theorem 
  Sq_Circ is Function of TOP-REAL 2,TOP-REAL 2 & rng Sq_Circ = the
  carrier of TOP-REAL 2 & for f being Function of TOP-REAL 2,TOP-REAL 2 st f=
  Sq_Circ holds f is being_homeomorphism;

theorem 
  for f,g being Function of I[01],TOP-REAL 2, C0,KXP,KXN,KYP,KYN being
  Subset of TOP-REAL 2, O,I being Point of I[01] st O=0 & I=1 & f is continuous
one-to-one & g is continuous one-to-one & C0={p: |.p.|<=1}& KXP={q1 where q1 is
Point of TOP-REAL 2: |.q1.|=1 & q1`2<=q1`1 & q1`2>=-q1`1} & KXN={q2 where q2 is
Point of TOP-REAL 2: |.q2.|=1 & q2`2>=q2`1 & q2`2<=-q2`1} & KYP={q3 where q3 is
Point of TOP-REAL 2: |.q3.|=1 & q3`2>=q3`1 & q3`2>=-q3`1} & KYN={q4 where q4 is
Point of TOP-REAL 2: |.q4.|=1 & q4`2<=q4`1 & q4`2<=-q4`1} & f.O in KXN & f.I in
KXP & g.O in KYN & g.I in KYP & rng f c= C0 & rng g c= C0 holds rng f meets rng
  g;














begin 

reserve a for real number;
reserve p,q for Point of TOP-REAL 2;

theorem 
  for X being non empty TopStruct, g being Function of X,R^1, B
  being Subset of X, a being real number st g is continuous & B = {p where p is
  Point of X: g/.p > a } holds B is open;

theorem 
  for X being non empty TopStruct, g being Function of X,R^1,B
being Subset of X, a being Real st g is continuous & B={p where p is Point of X
  : g/.p < a } holds B is open;

theorem 
  for f being Function of TOP-REAL 2,TOP-REAL 2 st f is continuous
  one-to-one & rng f=[#](TOP-REAL 2) & (for p2 being Point of TOP-REAL 2 ex K
being non empty compact Subset of TOP-REAL 2 st K = f.:K & (ex V2 being Subset
  of TOP-REAL 2 st p2 in V2 & V2 is open & V2 c= K & f.p2 in V2)) holds f is
  being_homeomorphism;

theorem 
  for X being non empty TopSpace, f1,f2 being Function of X,R^1,a,b
being real number st f1 is continuous & f2 is continuous & b<>0 & (for q being
  Point of X holds f2.q<>0) holds ex g being Function of X,R^1 st (for p being
Point of X,r1,r2 being real number st f1.p=r1 & f2.p=r2 holds g.p=(r1/r2-a)/b)
  & g is continuous;

theorem 
  for X being non empty TopSpace, f1,f2 being Function of X,R^1,a,
b being Real st f1 is continuous & f2 is continuous & b<>0 & (for q being Point
of X holds f2.q<>0) holds ex g being Function of X,R^1 st (for p being Point of
  X,r1,r2 being Real st f1.p=r1 & f2.p=r2 holds g.p=r2*((r1/r2-a)/b)) & g is
  continuous;

theorem 
  for X being non empty TopSpace, f1 being Function of X,R^1 st f1
is continuous holds ex g being Function of X,R^1 st (for p being Point of X,r1
  being real number st f1.p=r1 holds g.p=r1^2) & g is continuous;

theorem 
  for X being non empty TopSpace, f1 being Function of X,R^1 st f1
is continuous holds ex g being Function of X,R^1 st (for p being Point of X,r1
  being real number st f1.p=r1 holds g.p=abs(r1)) & g is continuous;

theorem 
  for X being non empty TopSpace, f1 being Function of X,R^1 st f1
is continuous holds ex g being Function of X,R^1 st (for p being Point of X,r1
  being real number st f1.p=r1 holds g.p=-r1) & g is continuous;

theorem 
  for X being non empty TopSpace, f1,f2 being Function of X,R^1,a,
  b being real number st f1 is continuous & f2 is continuous & b<>0 & (for q
  being Point of X holds f2.q<>0) holds ex g being Function of X,R^1 st (for p
being Point of X,r1,r2 being real number st f1.p=r1 & f2.p=r2 holds g.p= r2*(-
  sqrt(abs(1-((r1/r2-a)/b)^2)))) & g is continuous;

theorem 
  for X being non empty TopSpace, f1,f2 being Function of X,R^1,a,
  b being real number st f1 is continuous & f2 is continuous & b<>0 & (for q
  being Point of X holds f2.q<>0) holds ex g being Function of X,R^1 st (for p
  being Point of X,r1,r2 being real number st f1.p=r1 & f2.p=r2 holds g.p= r2*(
  sqrt(abs(1-((r1/r2-a)/b)^2)))) & g is continuous;

definition
  let n be Nat;
  func n NormF -> Function of TOP-REAL n, R^1 means


  for q being Point of TOP-REAL n holds it.q=|.q.|;
end;

theorem 
  for n being Nat holds dom (n NormF)=the carrier of TOP-REAL
  n & dom (n NormF)=REAL n;

theorem 
  for n being Nat holds n NormF is continuous;

registration
  let n be Nat;
  cluster n NormF -> continuous;
end;

theorem 
  for n being Element of NAT,K0 being Subset of TOP-REAL n, f
being Function of (TOP-REAL n)|K0,R^1 st (for p being Point of (TOP-REAL n)|K0
  holds f.p=(n NormF).p) holds f is continuous;

theorem 
  for n being Element of NAT,p being Point of Euclid n,r being
Real, B being Subset of TOP-REAL n st B=cl_Ball(p,r) holds B is bounded closed;

theorem 
  for p being Point of Euclid 2,r being Real, B being Subset of
  TOP-REAL 2 st B=cl_Ball(p,r) holds B is compact;

begin 

definition
  let s be real number, q be Point of TOP-REAL 2;
  func FanW(s,q) -> Point of TOP-REAL 2 equals


  |.q.|*|[-sqrt(1-((q`2/|.
q.|-s)/(1-s))^2), (q`2/|.q.|-s)/(1-s)]| if q`2/|.q.|>=s & q`1<0, |.q.|*|[-sqrt(
  1-((q`2/|.q.|-s)/(1+s))^2), (q`2/|.q.|-s)/(1+s)]| if q`2/|.q.|<s & q`1<0
  otherwise q;
end;

definition
  let s be real number;
  func s-FanMorphW -> Function of TOP-REAL 2, TOP-REAL 2 means


  for q being Point of TOP-REAL 2 holds it.q=FanW(s,q);
end;

theorem 
  for sn being real number holds (q`2/|.q.|>=sn & q`1<0 implies sn
-FanMorphW.q= |[ |.q.|*(-sqrt(1-((q`2/|.q.|-sn)/(1-sn))^2)), |.q.|* ((q`2/|.q.|
  -sn)/(1-sn))]|) & (q`1>=0 implies sn-FanMorphW.q=q);

theorem 
  for sn being Real st q`2/|.q.|<=sn & q`1<0 holds sn-FanMorphW.q=
|[ |.q.|*(-sqrt(1-((q`2/|.q.|-sn)/(1+sn))^2)), |.q.|*((q`2/|.q.|-sn)/(1+sn))]|;

theorem 
  for sn being Real st -1<sn & sn<1 holds (q`2/|.q.|>=sn & q`1<=0
& q<>0.TOP-REAL 2 implies sn-FanMorphW.q= |[ |.q.|*(-sqrt(1-((q`2/|.q.|-sn)/(1-
  sn))^2)), |.q.|* ((q`2/|.q.|-sn)/(1-sn))]|) & (q`2/|.q.|<=sn & q`1<=0 & q<>0.
TOP-REAL 2 implies sn-FanMorphW.q= |[ |.q.|*(-sqrt(1-((q`2/|.q.|-sn)/(1+sn))^2)
  ), |.q.|*((q`2/|.q.|-sn)/(1+sn))]|);

theorem 
  for sn being Real,K1 being non empty Subset of TOP-REAL 2, f
being Function of (TOP-REAL 2)|K1,R^1 st sn<1 & (for p being Point of (TOP-REAL
2) st p in the carrier of (TOP-REAL 2)|K1 holds f.p=|.p.|* ((p`2/|.p.|-sn)/(1-
sn))) & (for q being Point of TOP-REAL 2 st q in the carrier of (TOP-REAL 2)|K1
  holds q`1<=0 & q<>0.TOP-REAL 2) holds f is continuous;

theorem 
  for sn being Real,K1 being non empty Subset of TOP-REAL 2, f
  being Function of (TOP-REAL 2)|K1,R^1 st -1<sn & (for p being Point of (
TOP-REAL 2) st p in the carrier of (TOP-REAL 2)|K1 holds f.p=|.p.|* ((p`2/|.p.|
  -sn)/(1+sn))) & (for q being Point of TOP-REAL 2 st q in the carrier of (
  TOP-REAL 2)|K1 holds q`1<=0 & q<>0.TOP-REAL 2) holds f is continuous;

theorem 
  for sn being Real,K1 being non empty Subset of TOP-REAL 2, f
being Function of (TOP-REAL 2)|K1,R^1 st sn<1 & (for p being Point of (TOP-REAL
2) st p in the carrier of (TOP-REAL 2)|K1 holds f.p=|.p.|*(-sqrt(1-((p`2/|.p.|-
  sn)/(1-sn))^2))) & (for q being Point of TOP-REAL 2 st q in the carrier of (
  TOP-REAL 2)|K1 holds q`1<=0 & q`2/|.q.|>=sn & q<>0.TOP-REAL 2) holds f is
  continuous;

theorem 
  for sn being Real,K1 being non empty Subset of TOP-REAL 2, f
  being Function of (TOP-REAL 2)|K1,R^1 st -1<sn & (for p being Point of (
TOP-REAL 2) st p in the carrier of (TOP-REAL 2)|K1 holds f.p=|.p.|*(-sqrt(1-((p
  `2/|.p.|-sn)/(1+sn))^2))) & (for q being Point of TOP-REAL 2 st q in the
  carrier of (TOP-REAL 2)|K1 holds q`1<=0 & q`2/|.q.|<=sn & q<>0.TOP-REAL 2)
  holds f is continuous;

theorem 
  for sn being Real, K0,B0 being Subset of TOP-REAL 2, f being
Function of (TOP-REAL 2)|K0,(TOP-REAL 2)|B0 st -1<sn & sn<1 & f=(sn-FanMorphW)|
K0 & B0={q where q is Point of TOP-REAL 2: q`1<=0 & q<>0.TOP-REAL 2} & K0={p: p
  `2/|.p.|>=sn & p`1<=0 & p<>0.TOP-REAL 2} holds f is continuous;

theorem 
  for sn being Real, K0,B0 being Subset of TOP-REAL 2, f being
Function of (TOP-REAL 2)|K0,(TOP-REAL 2)|B0 st -1<sn & sn<1 & f=(sn-FanMorphW)|
K0 & B0={q where q is Point of TOP-REAL 2: q`1<=0 & q<>0.TOP-REAL 2} & K0={p: p
  `2/|.p.|<=sn & p`1<=0 & p<>0.TOP-REAL 2} holds f is continuous;

theorem 
  for sn being Real, K03 being Subset of TOP-REAL 2 st K03={p: p`2
  >=sn*(|.p.|) & p`1<=0} holds K03 is closed;

theorem 
  for sn being Real, K03 being Subset of TOP-REAL 2 st K03={p: p`2
  <=(sn)*(|.p.|) & p`1<=0} holds K03 is closed;

theorem 
  for sn being Real, K0,B0 being Subset of TOP-REAL 2, f being
Function of (TOP-REAL 2)|K0,(TOP-REAL 2)|B0 st -1<sn & sn<1 & f=(sn-FanMorphW)|
  K0 & B0=NonZero TOP-REAL 2 & K0={p: p`1<=0 & p<>0.TOP-REAL 2} holds f is
  continuous;

theorem 
  for sn being Real, K0,B0 being Subset of TOP-REAL 2, f being
Function of (TOP-REAL 2)|K0,(TOP-REAL 2)|B0 st -1<sn & sn<1 & f=(sn-FanMorphW)|
  K0 & B0=NonZero TOP-REAL 2 & K0={p: p`1>=0 & p<>0.TOP-REAL 2} holds f is
  continuous;

theorem 
  for B0 being Subset of TOP-REAL 2, K0 being Subset of (TOP-REAL
  2)|B0 st B0=NonZero TOP-REAL 2 & K0={p: p`1<=0 & p<>0.TOP-REAL 2} holds K0 is
  closed;

theorem 
  for sn being Real, B0 being Subset of TOP-REAL 2, K0 being
Subset of (TOP-REAL 2)|B0, f being Function of ((TOP-REAL 2)|B0)|K0,((TOP-REAL
2)|B0) st -1<sn & sn<1 & f=(sn-FanMorphW)|K0 & B0=NonZero TOP-REAL 2 & K0={p: p
  `1<=0 & p<>0.TOP-REAL 2} holds f is continuous;

theorem 
  for B0 being Subset of TOP-REAL 2, K0 being Subset of (TOP-REAL
  2)|B0 st B0=NonZero TOP-REAL 2 & K0={p: p`1>=0 & p<>0.TOP-REAL 2} holds K0 is
  closed;

theorem 
  for sn being Real, B0 being Subset of TOP-REAL 2,K0 being Subset
  of (TOP-REAL 2)|B0,f being Function of ((TOP-REAL 2)|B0)|K0,((TOP-REAL 2)|B0)
st -1<sn & sn<1 & f=(sn-FanMorphW)|K0 & B0=NonZero TOP-REAL 2 & K0={p: p`1>=0 &
  p<>0.TOP-REAL 2} holds f is continuous;

theorem 
  for sn being Real,p being Point of TOP-REAL 2 holds |.(sn
  -FanMorphW).p.|=|.p.|;

theorem 
  for sn being Real,x,K0 being set st -1<sn & sn<1 & x in K0 & K0=
  {p: p`1<=0 & p<>0.TOP-REAL 2} holds (sn-FanMorphW).x in K0;

theorem 
  for sn being Real,x,K0 being set st -1<sn & sn<1 & x in K0 & K0=
  {p: p`1>=0 & p<>0.TOP-REAL 2} holds (sn-FanMorphW).x in K0;

scheme 

  InclSub { D() -> non empty Subset of TOP-REAL 2, P[set] } : { p : P[p] & p<>
  0.TOP-REAL 2 } c= the carrier of (TOP-REAL 2)|D()
provided
 D() = NonZero TOP-REAL 2;

theorem 
  for sn being Real, D being non empty Subset of TOP-REAL 2 st -1<
  sn & sn<1 & D`={0.TOP-REAL 2} holds ex h being Function of (TOP-REAL 2)|D,(
  TOP-REAL 2)|D st h=(sn-FanMorphW)|D & h is continuous;

theorem 
  for sn being Real st -1<sn & sn<1 holds ex h being Function of (
  TOP-REAL 2),(TOP-REAL 2) st h=(sn-FanMorphW) & h is continuous;

theorem 
  for sn being Real st -1<sn & sn<1 holds sn-FanMorphW is one-to-one;

theorem 
  for sn being Real st -1<sn & sn<1 holds sn-FanMorphW is Function
  of TOP-REAL 2,TOP-REAL 2 & rng (sn-FanMorphW) = the carrier of TOP-REAL 2;

theorem 
  for sn being Real,p2 being Point of TOP-REAL 2 st -1<sn & sn<1
ex K being non empty compact Subset of TOP-REAL 2 st K = (sn-FanMorphW).:K & ex
  V2 being Subset of TOP-REAL 2 st p2 in V2 & V2 is open & V2 c= K & (sn
  -FanMorphW).p2 in V2;

theorem 
  for sn being Real st -1<sn & sn<1 ex f being Function of TOP-REAL 2,
  TOP-REAL 2 st f=(sn-FanMorphW) & f is being_homeomorphism;

theorem 
  for sn being Real,q being Point of TOP-REAL 2 st sn<1 & q`1<0 &
q`2/|.q.|>=sn holds for p being Point of TOP-REAL 2 st p=(sn-FanMorphW).q holds
  p`1<0 & p`2>=0;

theorem 
  for sn being Real,q being Point of TOP-REAL 2 st -1<sn & q`1<0 &
q`2/|.q.|<sn holds for p being Point of TOP-REAL 2 st p=(sn-FanMorphW).q holds
  p`1<0 & p`2<0;

theorem 
  for sn being Real,q1,q2 being Point of TOP-REAL 2 st sn<1 & q1`1
<0 & q1`2/|.q1.|>=sn & q2`1<0 & q2`2/|.q2.|>=sn & q1`2/|.q1.|<q2`2/|.q2.| holds
for p1,p2 being Point of TOP-REAL 2 st p1=(sn-FanMorphW).q1 & p2=(sn-FanMorphW)
  .q2 holds p1`2/|.p1.|<p2`2/|.p2.|;

theorem 
  for sn being Real,q1,q2 being Point of TOP-REAL 2 st -1<sn & q1
`1<0 & q1`2/|.q1.|<sn & q2`1<0 & q2`2/|.q2.|<sn & q1`2/|.q1.|<q2`2/|.q2.| holds
for p1,p2 being Point of TOP-REAL 2 st p1=(sn-FanMorphW).q1 & p2=(sn-FanMorphW)
  .q2 holds p1`2/|.p1.|<p2`2/|.p2.|;

theorem 
  for sn being Real,q1,q2 being Point of TOP-REAL 2 st -1<sn & sn<1 & q1
  `1 < 0 & q2`1<0 & q1`2/|.q1.|<q2`2/|.q2.| holds for p1,p2 being Point of
TOP-REAL 2 st p1=(sn-FanMorphW).q1 & p2=(sn-FanMorphW).q2 holds p1`2/|.p1.|<p2
  `2/|.p2.|;

theorem 
  for sn being Real,q being Point of TOP-REAL 2 st q`1<0 & q`2/|.q.|=sn
holds for p being Point of TOP-REAL 2 st p=(sn-FanMorphW).q holds p`1<0 & p`2=0
;

theorem 
  for sn being real number holds 0.TOP-REAL 2=(sn-FanMorphW).(0.TOP-REAL
  2);

begin 

definition
  let s be real number, q be Point of TOP-REAL 2;
  func FanN(s,q) -> Point of TOP-REAL 2 equals


  |.q.|*|[(q`1/|.q.|-s)/(1
-s), sqrt(1-((q`1/|.q.|-s)/(1-s))^2)]| if q`1/|.q.|>=s & q`2>0, |.q.|*|[(q`1/|.
  q.|-s)/(1+s), sqrt(1-((q`1/|.q.|-s)/(1+s))^2)]| if q`1/|.q.|<s & q`2>0
  otherwise q;
end;

definition
  let c be real number;
  func c-FanMorphN -> Function of TOP-REAL 2, TOP-REAL 2 means


  for q being Point of TOP-REAL 2 holds it.q=FanN(c,q);
end;

theorem 
  for cn being real number holds (q`1/|.q.|>=cn & q`2>0 implies cn
-FanMorphN.q= |[ |.q.|* ((q`1/|.q.|-cn)/(1-cn)), |.q.|*(sqrt(1-((q`1/|.q.|-cn)/
  (1-cn))^2))]|)& (q`2<=0 implies cn-FanMorphN.q=q);

theorem 
  for cn being Real holds (q`1/|.q.|<=cn & q`2>0 implies cn
-FanMorphN.q= |[ |.q.|*((q`1/|.q.|-cn)/(1+cn)), |.q.|*( sqrt(1-((q`1/|.q.|-cn)/
  (1+cn))^2))]|);

theorem 
  for cn being Real st -1<cn & cn<1 holds (q`1/|.q.|>=cn & q`2>=0
& q<>0.TOP-REAL 2 implies cn-FanMorphN.q= |[ |.q.|*((q`1/|.q.|-cn)/(1-cn)), |.q
  .|*( sqrt(1-((q`1/|.q.|-cn)/(1-cn))^2))]|) & (q`1/|.q.|<=cn & q`2>=0 & q<>0.
  TOP-REAL 2 implies cn-FanMorphN.q= |[ |.q.|*((q`1/|.q.|-cn)/(1+cn)), |.q.|*(
  sqrt(1-((q`1/|.q.|-cn)/(1+cn))^2))]|);

theorem 
  for cn being Real,K1 being non empty Subset of TOP-REAL 2, f
being Function of (TOP-REAL 2)|K1,R^1 st cn<1 & (for p being Point of (TOP-REAL
2) st p in the carrier of (TOP-REAL 2)|K1 holds f.p=|.p.|* ((p`1/|.p.|-cn)/(1-
cn))) & (for q being Point of TOP-REAL 2 st q in the carrier of (TOP-REAL 2)|K1
  holds q`2>=0 & q<>0.TOP-REAL 2) holds f is continuous;

theorem 
  for cn being Real,K1 being non empty Subset of TOP-REAL 2, f
  being Function of (TOP-REAL 2)|K1,R^1 st -1<cn & (for p being Point of (
TOP-REAL 2) st p in the carrier of (TOP-REAL 2)|K1 holds f.p=|.p.|* ((p`1/|.p.|
  -cn)/(1+cn))) & (for q being Point of TOP-REAL 2 st q in the carrier of (
  TOP-REAL 2)|K1 holds q`2>=0 & q<>0.TOP-REAL 2) holds f is continuous;

theorem 
  for cn being Real,K1 being non empty Subset of TOP-REAL 2, f
being Function of (TOP-REAL 2)|K1,R^1 st cn<1 & (for p being Point of (TOP-REAL
2) st p in the carrier of (TOP-REAL 2)|K1 holds f.p=|.p.|*( sqrt(1-((p`1/|.p.|-
  cn)/(1-cn))^2))) & (for q being Point of TOP-REAL 2 st q in the carrier of (
  TOP-REAL 2)|K1 holds q`2>=0 & q`1/|.q.|>=cn & q<>0.TOP-REAL 2) holds f is
  continuous;

theorem 
  for cn being Real,K1 being non empty Subset of TOP-REAL 2, f
  being Function of (TOP-REAL 2)|K1,R^1 st -1<cn & (for p being Point of (
TOP-REAL 2) st p in the carrier of (TOP-REAL 2)|K1 holds f.p=|.p.|*( sqrt(1-((p
  `1/|.p.|-cn)/(1+cn))^2))) & (for q being Point of TOP-REAL 2 st q in the
  carrier of (TOP-REAL 2)|K1 holds q`2>=0 & q`1/|.q.|<=cn & q<>0.TOP-REAL 2)
  holds f is continuous;

theorem 
  for cn being Real, K0,B0 being Subset of TOP-REAL 2,f being
Function of (TOP-REAL 2)|K0,(TOP-REAL 2)|B0 st -1<cn & cn<1 & f=(cn-FanMorphN)|
K0 & B0={q where q is Point of TOP-REAL 2: q`2>=0 & q<>0.TOP-REAL 2} & K0={p: p
  `1/|.p.|>=cn & p`2>=0 & p<>0.TOP-REAL 2} holds f is continuous;

theorem 
  for cn being Real, K0,B0 being Subset of TOP-REAL 2,f being
Function of (TOP-REAL 2)|K0,(TOP-REAL 2)|B0 st -1<cn & cn<1 & f=(cn-FanMorphN)|
K0 & B0={q where q is Point of TOP-REAL 2: q`2>=0 & q<>0.TOP-REAL 2} & K0={p: p
  `1/|.p.|<=cn & p`2>=0 & p<>0.TOP-REAL 2} holds f is continuous;

theorem 
  for cn being Real, K03 being Subset of TOP-REAL 2 st K03={p: p`1
  >=(cn)*(|.p.|) & p`2>=0} holds K03 is closed;

theorem 
  for cn being Real, K03 being Subset of TOP-REAL 2 st K03={p: p`1
  <=(cn)*(|.p.|) & p`2>=0} holds K03 is closed;

theorem 
  for cn being Real, K0,B0 being Subset of TOP-REAL 2,f being
Function of (TOP-REAL 2)|K0,(TOP-REAL 2)|B0 st -1<cn & cn<1 & f=(cn-FanMorphN)|
  K0 & B0=NonZero TOP-REAL 2 & K0={p: p`2>=0 & p<>0.TOP-REAL 2} holds f is
  continuous;

theorem 
  for cn being Real, K0,B0 being Subset of TOP-REAL 2,f being
Function of (TOP-REAL 2)|K0,(TOP-REAL 2)|B0 st -1<cn & cn<1 & f=(cn-FanMorphN)|
  K0 & B0=NonZero TOP-REAL 2 & K0={p: p`2<=0 & p<>0.TOP-REAL 2} holds f is
  continuous;

theorem 
  for B0 being Subset of TOP-REAL 2, K0 being Subset of (TOP-REAL
  2)|B0 st B0=NonZero TOP-REAL 2 & K0={p: p`2>=0 & p<>0.TOP-REAL 2} holds K0 is
  closed;

theorem 
  for B0 being Subset of TOP-REAL 2, K0 being Subset of (TOP-REAL
  2)|B0 st B0=NonZero TOP-REAL 2 & K0={p: p`2<=0 & p<>0.TOP-REAL 2} holds K0 is
  closed;

theorem 
  for cn being Real, B0 being Subset of TOP-REAL 2,K0 being Subset
  of (TOP-REAL 2)|B0,f being Function of ((TOP-REAL 2)|B0)|K0,((TOP-REAL 2)|B0)
st -1<cn & cn<1 & f=(cn-FanMorphN)|K0 & B0=NonZero TOP-REAL 2 & K0={p: p`2>=0 &
  p<>0.TOP-REAL 2} holds f is continuous;

theorem 
  for cn being Real, B0 being Subset of TOP-REAL 2,K0 being Subset
  of (TOP-REAL 2)|B0,f being Function of ((TOP-REAL 2)|B0)|K0,((TOP-REAL 2)|B0)
st -1<cn & cn<1 & f=(cn-FanMorphN)|K0 & B0=NonZero TOP-REAL 2 & K0={p: p`2<=0 &
  p<>0.TOP-REAL 2} holds f is continuous;

theorem 
  for cn being Real,p being Point of TOP-REAL 2 holds |.(cn
  -FanMorphN).p.|=|.p.|;

theorem 
  for cn being Real,x,K0 being set st -1<cn & cn<1 & x in K0 & K0=
  {p: p`2>=0 & p<>0.TOP-REAL 2} holds (cn-FanMorphN).x in K0;

theorem 
  for cn being Real,x,K0 being set st -1<cn & cn<1 & x in K0 & K0=
  {p: p`2<=0 & p<>0.TOP-REAL 2} holds (cn-FanMorphN).x in K0;

theorem 
  for cn being Real, D being non empty Subset of TOP-REAL 2 st -1<
  cn & cn<1 & D`={0.TOP-REAL 2} holds ex h being Function of (TOP-REAL 2)|D,(
  TOP-REAL 2)|D st h=(cn-FanMorphN)|D & h is continuous;

theorem 
  for cn being Real st -1<cn & cn<1 holds ex h being Function of (
  TOP-REAL 2),(TOP-REAL 2) st h=(cn-FanMorphN) & h is continuous;

theorem 
  for cn being Real st -1<cn & cn<1 holds cn-FanMorphN is one-to-one;

theorem 
  for cn being Real st -1<cn & cn<1 holds (cn-FanMorphN) is
  Function of TOP-REAL 2,TOP-REAL 2 & rng (cn-FanMorphN) = the carrier of
  TOP-REAL 2;

theorem 
  for cn being Real,p2 being Point of TOP-REAL 2 st -1<cn & cn<1
ex K being non empty compact Subset of TOP-REAL 2 st K = (cn-FanMorphN).:K & ex
  V2 being Subset of TOP-REAL 2 st p2 in V2 & V2 is open & V2 c= K & (cn
  -FanMorphN).p2 in V2;

theorem 
  for cn being Real st -1<cn & cn<1 ex f being Function of TOP-REAL 2,
  TOP-REAL 2 st f=cn-FanMorphN & f is being_homeomorphism;

theorem 
  for cn being Real,q being Point of TOP-REAL 2 st cn<1 & q`2>0 &
q`1/|.q.|>=cn holds for p being Point of TOP-REAL 2 st p=(cn-FanMorphN).q holds
  p`2>0 & p`1>=0;

theorem 
  for cn being Real,q being Point of TOP-REAL 2 st -1<cn & q`2>0 &
q`1/|.q.|<cn holds for p being Point of TOP-REAL 2 st p=(cn-FanMorphN).q holds
  p`2>0 & p`1<0;

theorem 
  for cn being Real,q1,q2 being Point of TOP-REAL 2 st cn<1 & q1`2
>0 & q1`1/|.q1.|>=cn & q2`2>0 & q2`1/|.q2.|>=cn & q1`1/|.q1.|<q2`1/|.q2.| holds
for p1,p2 being Point of TOP-REAL 2 st p1=(cn-FanMorphN).q1 & p2=(cn-FanMorphN)
  .q2 holds p1`1/|.p1.|<p2`1/|.p2.|;

theorem 
  for cn being Real,q1,q2 being Point of TOP-REAL 2 st -1<cn & q1
`2>0 & q1`1/|.q1.|<cn & q2`2>0 & q2`1/|.q2.|<cn & q1`1/|.q1.|<q2`1/|.q2.| holds
for p1,p2 being Point of TOP-REAL 2 st p1=(cn-FanMorphN).q1 & p2=(cn-FanMorphN)
  .q2 holds p1`1/|.p1.|<p2`1/|.p2.|;

theorem 
  for cn being Real,q1,q2 being Point of TOP-REAL 2 st -1<cn & cn<1 & q1
  `2 > 0 & q2`2>0 & q1`1/|.q1.|<q2`1/|.q2.| holds for p1,p2 being Point of
TOP-REAL 2 st p1=(cn-FanMorphN).q1 & p2=(cn-FanMorphN).q2 holds p1`1/|.p1.|<p2
  `1/|.p2.|;

theorem 
  for cn being Real,q being Point of TOP-REAL 2 st q`2>0 & q`1/|.q.|=cn
holds for p being Point of TOP-REAL 2 st p=(cn-FanMorphN).q holds p`2>0 & p`1=0
;

theorem 
  for cn being real number holds 0.TOP-REAL 2=(cn-FanMorphN).(0.TOP-REAL
  2);

begin 

definition
  let s be real number, q be Point of TOP-REAL 2;
  func FanE(s,q) -> Point of TOP-REAL 2 equals


  |.q.|*|[sqrt(1-((q`2/|.q
.|-s)/(1-s))^2), (q`2/|.q.|-s)/(1-s)]| if q`2/|.q.|>=s & q`1>0, |.q.|*|[sqrt(1-
  ((q`2/|.q.|-s)/(1+s))^2), (q`2/|.q.|-s)/(1+s)]| if q`2/|.q.|<s & q`1>0
  otherwise q;
end;

definition
  let s be real number;
  func s-FanMorphE -> Function of TOP-REAL 2, TOP-REAL 2 means


  for q being Point of TOP-REAL 2 holds it.q=FanE(s,q);
end;

theorem 
  for sn being real number holds (q`2/|.q.|>=sn & q`1>0 implies sn
-FanMorphE.q= |[ |.q.|*(sqrt(1-((q`2/|.q.|-sn)/(1-sn))^2)), |.q.|* ((q`2/|.q.|-
  sn)/(1-sn))]|)& (q`1<=0 implies sn-FanMorphE.q=q);

theorem 
  for sn being Real holds (q`2/|.q.|<=sn & q`1>0 implies sn
-FanMorphE.q= |[ |.q.|*(sqrt(1-((q`2/|.q.|-sn)/(1+sn))^2)), |.q.|*((q`2/|.q.|-
  sn)/(1+sn))]|);

theorem 
  for sn being Real st -1<sn & sn<1 holds (q`2/|.q.|>=sn & q`1>=0
& q<>0.TOP-REAL 2 implies sn-FanMorphE.q = |[ |.q.|*(sqrt(1-((q`2/|.q.|-sn)/(1-
  sn))^2)), |.q.|* ((q`2/|.q.|-sn)/(1-sn))]|) & (q`2/|.q.|<=sn & q`1>=0 & q<>0.
TOP-REAL 2 implies sn-FanMorphE.q = |[ |.q.|*(sqrt(1-((q`2/|.q.|-sn)/(1+sn))^2)
  ), |.q.|*((q`2/|.q.|-sn)/(1+sn))]|);

theorem 
  for sn being Real,K1 being non empty Subset of TOP-REAL 2, f
being Function of (TOP-REAL 2)|K1,R^1 st sn<1 & (for p being Point of (TOP-REAL
2) st p in the carrier of (TOP-REAL 2)|K1 holds f.p=|.p.|* ((p`2/|.p.|-sn)/(1-
sn))) & (for q being Point of TOP-REAL 2 st q in the carrier of (TOP-REAL 2)|K1
  holds q`1>=0 & q<>0.TOP-REAL 2) holds f is continuous;

theorem 
  for sn being Real,K1 being non empty Subset of TOP-REAL 2, f
  being Function of (TOP-REAL 2)|K1,R^1 st -1<sn & (for p being Point of (
TOP-REAL 2) st p in the carrier of (TOP-REAL 2)|K1 holds f.p=|.p.|* ((p`2/|.p.|
  -sn)/(1+sn))) & (for q being Point of TOP-REAL 2 st q in the carrier of (
  TOP-REAL 2)|K1 holds q`1>=0 & q<>0.TOP-REAL 2) holds f is continuous;

theorem 
  for sn being Real,K1 being non empty Subset of TOP-REAL 2, f
being Function of (TOP-REAL 2)|K1,R^1 st sn<1 & (for p being Point of (TOP-REAL
2) st p in the carrier of (TOP-REAL 2)|K1 holds f.p=|.p.|*(sqrt(1-((p`2/|.p.|-
  sn)/(1-sn))^2))) & (for q being Point of TOP-REAL 2 st q in the carrier of (
  TOP-REAL 2)|K1 holds q`1>=0 & q`2/|.q.|>=sn & q<>0.TOP-REAL 2) holds f is
  continuous;

theorem 
  for sn being Real,K1 being non empty Subset of TOP-REAL 2, f
  being Function of (TOP-REAL 2)|K1,R^1 st -1<sn & (for p being Point of (
TOP-REAL 2) st p in the carrier of (TOP-REAL 2)|K1 holds f.p=|.p.|*(sqrt(1-((p
  `2/|.p.|-sn)/(1+sn))^2))) & (for q being Point of TOP-REAL 2 st q in the
  carrier of (TOP-REAL 2)|K1 holds q`1>=0 & q`2/|.q.|<=sn & q<>0.TOP-REAL 2)
  holds f is continuous;

theorem 
  for sn being Real, K0,B0 being Subset of TOP-REAL 2,f being
Function of (TOP-REAL 2)|K0,(TOP-REAL 2)|B0 st -1<sn & sn<1 & f=(sn-FanMorphE)|
K0 & B0={q where q is Point of TOP-REAL 2: q`1>=0 & q<>0.TOP-REAL 2} & K0={p: p
  `2/|.p.|>=sn & p`1>=0 & p<>0.TOP-REAL 2} holds f is continuous;

theorem 
  for sn being Real, K0,B0 being Subset of TOP-REAL 2,f being
Function of (TOP-REAL 2)|K0,(TOP-REAL 2)|B0 st -1<sn & sn<1 & f=(sn-FanMorphE)|
K0 & B0={q where q is Point of TOP-REAL 2: q`1>=0 & q<>0.TOP-REAL 2} & K0={p: p
  `2/|.p.|<=sn & p`1>=0 & p<>0.TOP-REAL 2} holds f is continuous;

theorem 
  for sn being Real, K03 being Subset of TOP-REAL 2 st K03={p: p`2
  >=(sn)*(|.p.|) & p`1>=0} holds K03 is closed;

theorem 
  for sn being Real, K03 being Subset of TOP-REAL 2 st K03={p: p`2
  <=(sn)*(|.p.|) & p`1>=0} holds K03 is closed;

theorem 
  for sn being Real, K0,B0 being Subset of TOP-REAL 2,f being
Function of (TOP-REAL 2)|K0,(TOP-REAL 2)|B0 st -1<sn & sn<1 & f=(sn-FanMorphE)|
  K0 & B0=NonZero TOP-REAL 2 & K0={p: p`1>=0 & p<>0.TOP-REAL 2} holds f is
  continuous;

theorem 
  for sn being Real, K0,B0 being Subset of TOP-REAL 2,f being
Function of (TOP-REAL 2)|K0,(TOP-REAL 2)|B0 st -1<sn & sn<1 & f=(sn-FanMorphE)|
  K0 & B0=NonZero TOP-REAL 2 & K0={p: p`1<=0 & p<>0.TOP-REAL 2} holds f is
  continuous;

theorem 
  for sn being Real, B0 being Subset of TOP-REAL 2,K0 being
Subset of (TOP-REAL 2)|B0,f being Function of ((TOP-REAL 2)|B0)|K0,((TOP-REAL 2
)|B0) st -1<sn & sn<1 & f=(sn-FanMorphE)|K0 & B0=NonZero TOP-REAL 2 & K0={p: p
  `1>=0 & p<>0.TOP-REAL 2} holds f is continuous;

theorem 
  for sn being Real, B0 being Subset of TOP-REAL 2,K0 being
Subset of (TOP-REAL 2)|B0,f being Function of ((TOP-REAL 2)|B0)|K0,((TOP-REAL 2
)|B0) st -1<sn & sn<1 & f=(sn-FanMorphE)|K0 & B0=NonZero TOP-REAL 2 & K0={p: p
  `1<=0 & p<>0.TOP-REAL 2} holds f is continuous;

theorem 
  for sn being Real,p being Point of TOP-REAL 2 holds |.(sn
  -FanMorphE).p.|=|.p.|;

theorem 
  for sn being Real,x,K0 being set st -1<sn & sn<1 & x in K0 & K0
  ={p: p`1>=0 & p<>0.TOP-REAL 2} holds (sn-FanMorphE).x in K0;

theorem 
  for sn being Real,x,K0 being set st -1<sn & sn<1 & x in K0 & K0
  ={p: p`1<=0 & p<>0.TOP-REAL 2} holds (sn-FanMorphE).x in K0;

theorem 
  for sn being Real, D being non empty Subset of TOP-REAL 2 st -1
  <sn & sn<1 & D`={0.TOP-REAL 2} holds ex h being Function of (TOP-REAL 2)|D,(
  TOP-REAL 2)|D st h=(sn-FanMorphE)|D & h is continuous;

theorem 
  for sn being Real st -1<sn & sn<1 holds ex h being Function of
  (TOP-REAL 2),(TOP-REAL 2) st h=(sn-FanMorphE) & h is continuous;

theorem 
  for sn being Real st -1<sn & sn<1 holds sn-FanMorphE is one-to-one;

theorem 
  for sn being Real st -1<sn & sn<1 holds (sn-FanMorphE) is
  Function of TOP-REAL 2,TOP-REAL 2 & rng (sn-FanMorphE) = the carrier of
  TOP-REAL 2;

theorem 
  for sn being Real,p2 being Point of TOP-REAL 2 st -1<sn & sn<1
ex K being non empty compact Subset of TOP-REAL 2 st K = (sn-FanMorphE).:K & ex
  V2 being Subset of TOP-REAL 2 st p2 in V2 & V2 is open & V2 c= K & (sn
  -FanMorphE).p2 in V2;

theorem 
  for sn being Real st -1<sn & sn<1 ex f being Function of TOP-REAL 2,
  TOP-REAL 2 st f=(sn-FanMorphE) & f is being_homeomorphism;

theorem 
  for sn being Real,q being Point of TOP-REAL 2 st sn<1 & q`1>0 &
q`2/|.q.|>=sn holds for p being Point of TOP-REAL 2 st p=(sn-FanMorphE).q holds
  p`1>0 & p`2>=0;

theorem 
  for sn being Real,q being Point of TOP-REAL 2 st -1<sn & q`1>0
  & q`2/|.q.|<sn holds for p being Point of TOP-REAL 2 st p=(sn-FanMorphE).q
  holds p`1>0 & p`2<0;

theorem 
  for sn being Real,q1,q2 being Point of TOP-REAL 2 st sn<1 & q1
  `1>0 & q1`2/|.q1.|>=sn & q2`1>0 & q2`2/|.q2.|>=sn & q1`2/|.q1.|<q2`2/|.q2.|
  holds for p1,p2 being Point of TOP-REAL 2 st p1=(sn-FanMorphE).q1 & p2=(sn
  -FanMorphE).q2 holds p1`2/|.p1.|<p2`2/|.p2.|;

theorem 
  for sn being Real,q1,q2 being Point of TOP-REAL 2 st -1<sn & q1
`1>0 & q1`2/|.q1.|<sn & q2`1>0 & q2`2/|.q2.|<sn & q1`2/|.q1.|<q2`2/|.q2.| holds
for p1,p2 being Point of TOP-REAL 2 st p1=(sn-FanMorphE).q1 & p2=(sn-FanMorphE)
  .q2 holds p1`2/|.p1.|<p2`2/|.p2.|;

theorem 
  for sn being Real,q1,q2 being Point of TOP-REAL 2 st -1<sn & sn<1 & q1
`1>0 & q2`1>0 & q1`2/|.q1.|<q2`2/|.q2.| holds for p1,p2 being Point of TOP-REAL
2 st p1=(sn-FanMorphE).q1 & p2=(sn-FanMorphE).q2 holds p1`2/|.p1.|<p2`2/|.p2.|;

theorem 
  for sn being Real,q being Point of TOP-REAL 2 st q`1>0 & q`2/|.q.|=sn
holds for p being Point of TOP-REAL 2 st p=(sn-FanMorphE).q holds p`1>0 & p`2=0
;

theorem 
  for sn being real number holds 0.TOP-REAL 2=(sn-FanMorphE).(0.TOP-REAL
  2);

begin 

definition
  let s be real number, q be Point of TOP-REAL 2;
  func FanS(s,q) -> Point of TOP-REAL 2 equals


  |.q.|*|[(q`1/|.q.|-s)/(1
-s), -sqrt(1-((q`1/|.q.|-s)/(1-s))^2)]| if q`1/|.q.|>=s & q`2<0, |.q.|*|[(q`1/
  |.q.|-s)/(1+s), -sqrt(1-((q`1/|.q.|-s)/(1+s))^2)]| if q`1/|.q.|<s & q`2<0
  otherwise q;
end;

definition
  let c be real number;
  func c-FanMorphS -> Function of TOP-REAL 2, TOP-REAL 2 means


  for q being Point of TOP-REAL 2 holds it.q=FanS(c,q);
end;

theorem 
  for cn being real number holds (q`1/|.q.|>=cn & q`2<0 implies
cn-FanMorphS.q= |[ |.q.|* ((q`1/|.q.|-cn)/(1-cn)), |.q.|*(-sqrt(1-((q`1/|.q.|-
  cn)/(1-cn))^2))]|)& (q`2>=0 implies cn-FanMorphS.q=q);

theorem 
  for cn being Real holds (q`1/|.q.|<=cn & q`2<0 implies cn
-FanMorphS.q= |[ |.q.|*((q`1/|.q.|-cn)/(1+cn)), |.q.|*( -sqrt(1-((q`1/|.q.|-cn)
  /(1+cn))^2))]|);

theorem 
  for cn being Real st -1<cn & cn<1 holds (q`1/|.q.|>=cn & q`2<=0
  & q<>0.TOP-REAL 2 implies cn-FanMorphS.q = |[ |.q.|* ((q`1/|.q.|-cn)/(1-cn)),
|.q.|*( -sqrt(1-((q`1/|.q.|-cn)/(1-cn))^2))]|) & (q`1/|.q.|<=cn & q`2<=0 & q<>
0.TOP-REAL 2 implies cn-FanMorphS.q = |[ |.q.|*((q`1/|.q.|-cn)/(1+cn)), |.q.|*(
  -sqrt(1-((q`1/|.q.|-cn)/(1+cn))^2))]|);

theorem 
  for cn being Real,K1 being non empty Subset of TOP-REAL 2, f
being Function of (TOP-REAL 2)|K1,R^1 st cn<1 & (for p being Point of (TOP-REAL
2) st p in the carrier of (TOP-REAL 2)|K1 holds f.p=|.p.|* ((p`1/|.p.|-cn)/(1-
cn))) & (for q being Point of TOP-REAL 2 st q in the carrier of (TOP-REAL 2)|K1
  holds q`2<=0 & q<>0.TOP-REAL 2) holds f is continuous;

theorem 
  for cn being Real,K1 being non empty Subset of TOP-REAL 2, f
  being Function of (TOP-REAL 2)|K1,R^1 st -1<cn & (for p being Point of (
TOP-REAL 2) st p in the carrier of (TOP-REAL 2)|K1 holds f.p=|.p.|* ((p`1/|.p.|
  -cn)/(1+cn))) & (for q being Point of TOP-REAL 2 st q in the carrier of (
  TOP-REAL 2)|K1 holds q`2<=0 & q<>0.TOP-REAL 2) holds f is continuous;

theorem 
  for cn being Real,K1 being non empty Subset of TOP-REAL 2, f
being Function of (TOP-REAL 2)|K1,R^1 st cn<1 & (for p being Point of (TOP-REAL
2) st p in the carrier of (TOP-REAL 2)|K1 holds f.p=|.p.|*( -sqrt(1-((p`1/|.p.|
  -cn)/(1-cn))^2))) & (for q being Point of TOP-REAL 2 st q in the carrier of (
  TOP-REAL 2)|K1 holds q`2<=0 & q`1/|.q.|>=cn & q<>0.TOP-REAL 2) holds f is
  continuous;

theorem 
  for cn being Real,K1 being non empty Subset of TOP-REAL 2, f
  being Function of (TOP-REAL 2)|K1,R^1 st -1<cn & (for p being Point of (
TOP-REAL 2) st p in the carrier of (TOP-REAL 2)|K1 holds f.p=|.p.|*( -sqrt(1-((
  p`1/|.p.|-cn)/(1+cn))^2))) & (for q being Point of TOP-REAL 2 st q in the
  carrier of (TOP-REAL 2)|K1 holds q`2<=0 & q`1/|.q.|<=cn & q<>0.TOP-REAL 2)
  holds f is continuous;

theorem 
  for cn being Real, K0,B0 being Subset of TOP-REAL 2,f being
Function of (TOP-REAL 2)|K0,(TOP-REAL 2)|B0 st -1<cn & cn<1 & f=(cn-FanMorphS)|
K0 & B0={q where q is Point of TOP-REAL 2: q`2<=0 & q<>0.TOP-REAL 2} & K0={p: p
  `1/|.p.|>=cn & p`2<=0 & p<>0.TOP-REAL 2} holds f is continuous;

theorem 
  for cn being Real, K0,B0 being Subset of TOP-REAL 2, f being
Function of (TOP-REAL 2)|K0,(TOP-REAL 2)|B0 st -1<cn & cn<1 & f=(cn-FanMorphS)|
K0 & B0={q where q is Point of TOP-REAL 2: q`2<=0 & q<>0.TOP-REAL 2} & K0={p: p
  `1/|.p.|<=cn & p`2<=0 & p<>0.TOP-REAL 2} holds f is continuous;

theorem 
  for cn being Real, K03 being Subset of TOP-REAL 2 st K03={p: p
  `1>=(cn)*(|.p.|) & p`2<=0} holds K03 is closed;

theorem 
  for cn being Real, K03 being Subset of TOP-REAL 2 st K03={p: p
  `1<=(cn)*(|.p.|) & p`2<=0} holds K03 is closed;

theorem 
  for cn being Real, K0,B0 being Subset of TOP-REAL 2, f being
Function of (TOP-REAL 2)|K0,(TOP-REAL 2)|B0 st -1<cn & cn<1 & f=(cn-FanMorphS)|
  K0 & B0=NonZero TOP-REAL 2 & K0={p: p`2<=0 & p<>0.TOP-REAL 2} holds f is
  continuous;

theorem 
  for cn being Real, K0,B0 being Subset of TOP-REAL 2, f being
Function of (TOP-REAL 2)|K0,(TOP-REAL 2)|B0 st -1<cn & cn<1 & f=(cn-FanMorphS)|
  K0 & B0=NonZero TOP-REAL 2 & K0={p: p`2>=0 & p<>0.TOP-REAL 2} holds f is
  continuous;

theorem 
  for cn being Real, B0 being Subset of TOP-REAL 2,K0 being
Subset of (TOP-REAL 2)|B0,f being Function of ((TOP-REAL 2)|B0)|K0,((TOP-REAL 2
)|B0) st -1<cn & cn<1 & f=(cn-FanMorphS)|K0 & B0=NonZero TOP-REAL 2 & K0={p: p
  `2<=0 & p<>0.TOP-REAL 2} holds f is continuous;

theorem 
  for cn being Real, B0 being Subset of TOP-REAL 2,K0 being
Subset of (TOP-REAL 2)|B0,f being Function of ((TOP-REAL 2)|B0)|K0,((TOP-REAL 2
)|B0) st -1<cn & cn<1 & f=(cn-FanMorphS)|K0 & B0=NonZero TOP-REAL 2 & K0={p: p
  `2>=0 & p<>0.TOP-REAL 2} holds f is continuous;

theorem 
  for cn being Real,p being Point of TOP-REAL 2 holds |.(cn
  -FanMorphS).p.|=|.p.|;

theorem 
  for cn being Real,x,K0 being set st -1<cn & cn<1 & x in K0 & K0
  ={p: p`2<=0 & p<>0.TOP-REAL 2} holds (cn-FanMorphS).x in K0;

theorem 
  for cn being Real,x,K0 being set st -1<cn & cn<1 & x in K0 & K0
  ={p: p`2>=0 & p<>0.TOP-REAL 2} holds (cn-FanMorphS).x in K0;

theorem 
  for cn being Real, D being non empty Subset of TOP-REAL 2 st -1
  <cn & cn<1 & D`={0.TOP-REAL 2} holds ex h being Function of (TOP-REAL 2)|D,(
  TOP-REAL 2)|D st h=(cn-FanMorphS)|D & h is continuous;

theorem 
  for cn being Real st -1<cn & cn<1 holds cn-FanMorphS is continuous;

theorem 
  for cn being Real st -1<cn & cn<1 holds cn-FanMorphS is one-to-one;

theorem 
  for cn being Real st -1<cn & cn<1 holds (cn-FanMorphS) is
  Function of TOP-REAL 2,TOP-REAL 2 & rng (cn-FanMorphS) = the carrier of
  TOP-REAL 2;

theorem 
  for cn being Real,p2 being Point of TOP-REAL 2 st -1<cn & cn<1
ex K being non empty compact Subset of TOP-REAL 2 st K = (cn-FanMorphS).:K & ex
  V2 being Subset of TOP-REAL 2 st p2 in V2 & V2 is open & V2 c= K & (cn
  -FanMorphS).p2 in V2;

theorem 
  for cn being Real st -1<cn & cn<1 ex f being Function of TOP-REAL 2,
  TOP-REAL 2 st f=cn-FanMorphS & f is being_homeomorphism;

theorem 
  for cn being Real,q being Point of TOP-REAL 2 st cn<1 & q`2<0 &
q`1/|.q.|>=cn holds for p being Point of TOP-REAL 2 st p=(cn-FanMorphS).q holds
  p`2<0 & p`1>=0;

theorem 
  for cn being Real,q being Point of TOP-REAL 2 st -1<cn & q`2<0
  & q`1/|.q.|<cn holds for p being Point of TOP-REAL 2 st p=(cn-FanMorphS).q
  holds p`2<0 & p`1<0;

theorem 
  for cn being Real,q1,q2 being Point of TOP-REAL 2 st cn<1 & q1
  `2<0 & q1`1/|.q1.|>=cn & q2`2<0 & q2`1/|.q2.|>=cn & q1`1/|.q1.|<q2`1/|.q2.|
  holds for p1,p2 being Point of TOP-REAL 2 st p1=(cn-FanMorphS).q1 & p2=(cn
  -FanMorphS).q2 holds p1`1/|.p1.|<p2`1/|.p2.|;

theorem 
  for cn being Real,q1,q2 being Point of TOP-REAL 2 st -1<cn & q1
`2<0 & q1`1/|.q1.|<cn & q2`2<0 & q2`1/|.q2.|<cn & q1`1/|.q1.|<q2`1/|.q2.| holds
for p1,p2 being Point of TOP-REAL 2 st p1=(cn-FanMorphS).q1 & p2=(cn-FanMorphS)
  .q2 holds p1`1/|.p1.|<p2`1/|.p2.|;

theorem 
  for cn being Real,q1,q2 being Point of TOP-REAL 2 st -1<cn & cn<1 & q1
`2<0 & q2`2<0 & q1`1/|.q1.|<q2`1/|.q2.| holds for p1,p2 being Point of TOP-REAL
2 st p1=(cn-FanMorphS).q1 & p2=(cn-FanMorphS).q2 holds p1`1/|.p1.|<p2`1/|.p2.|;

theorem 
  for cn being Real,q being Point of TOP-REAL 2 st q`2<0 & q`1/|.q.|=cn
holds for p being Point of TOP-REAL 2 st p=(cn-FanMorphS).q holds p`2<0 & p`1=0
;

theorem 
  0.TOP-REAL 2 = (a-FanMorphS).(0.TOP-REAL 2);














begin 

theorem 
  for p being Point of TOP-REAL 2 st |.p.|<=1 holds -1<=p`1 & p`1<=
  1 & -1<=p`2 & p`2<=1;

theorem 
  for p being Point of TOP-REAL 2 st |.p.|<=1 & p`1<>0 & p`2<>0
  holds -1<p`1 & p`1<1 & -1<p`2 & p`2<1;

theorem 
  for a,b,d,e,r3 being Real,PM,PM2 being non empty MetrStruct, x being
  Element of PM, x2 being Element of PM2 st d<=a & a<=b & b<=e & PM=
Closed-Interval-MSpace(a,b) & PM2=Closed-Interval-MSpace(d,e) & x=x2 holds Ball
  (x,r3) c= Ball(x2,r3);

theorem 
  for a,b being real number, B being Subset of I[01] st 0<=a & a<=b & b
  <=1 & B=[.a,b.] holds Closed-Interval-TSpace(a,b)=I[01]|B;

theorem 
  for X being TopStruct, Y,Z being non empty TopStruct,f being
  Function of X,Y, h being Function of Y,Z st h is being_homeomorphism & f is
  continuous holds h*f is continuous;

theorem 
  for X,Y,Z being TopStruct, f being Function of X,Y, h being
  Function of Y,Z st h is being_homeomorphism & f is one-to-one holds h*f is
  one-to-one;

theorem 
  for X being TopStruct,S,V being non empty TopStruct, B being non
  empty Subset of S,f being Function of X,S|B, g being Function of S,V, h being
  Function of X,V st h=g*f & f is continuous & g is continuous holds h is
  continuous;

theorem 
  for a,b,d,e,s1,s2,t1,t2 being Real,h being Function of
  Closed-Interval-TSpace(a,b),Closed-Interval-TSpace(d,e) st h is
being_homeomorphism & h.s1=t1 & h.s2=t2 & h.b=e & d<=e & t1<=t2 & s1 in [.a,b.]
  & s2 in [.a,b.] holds s1<=s2;

theorem 
  for a,b,d,e,s1,s2,t1,t2 being Real,h being Function of
  Closed-Interval-TSpace(a,b),Closed-Interval-TSpace(d,e) st h is
being_homeomorphism & h.s1=t1 & h.s2=t2 & h.b=d & e>=d & t1>=t2 & s1 in [.a,b.]
  & s2 in [.a,b.] holds s1<=s2;

theorem 
  for n being Element of NAT holds -(0.TOP-REAL n)=0.TOP-REAL n;

begin 

theorem 
  for f,g being Function of I[01],TOP-REAL 2,a,b,c,d being Real, O
  ,I being Point of I[01] st O=0 & I=1 & f is continuous one-to-one & g is
continuous one-to-one & a <> b & c <> d & (f.O)`1=a & c <=(f.O)`2 & (f.O)`2 <=d
& (f.I)`1=b & c <=(f.I)`2 & (f.I)`2 <=d & (g.O)`2=c & a <=(g.O)`1 & (g.O)`1 <=b
& (g.I)`2=d & a <=(g.I)`1 & (g.I)`1 <=b & (for r being Point of I[01] holds (a
>=(f.r)`1 or (f.r)`1>=b or c >=(f.r)`2 or (f.r)`2>=d) & (a >=(g.r)`1 or (g.r)`1
  >=b or c >=(g.r)`2 or (g.r)`2>=d)) holds rng f meets rng g;

theorem 
  for f being Function of I[01],TOP-REAL 2 st f is continuous
  one-to-one ex f2 being Function of I[01],TOP-REAL 2 st f2.0=f.1 & f2.1=f.0 &
  rng f2=rng f & f2 is continuous & f2 is one-to-one;

reserve p,q for Point of TOP-REAL 2;

theorem 
  for f,g being Function of I[01],TOP-REAL 2, C0,KXP,KXN,KYP,KYN
  being Subset of TOP-REAL 2, O,I being Point of I[01] st O=0 & I=1 & f is
continuous one-to-one & g is continuous one-to-one & C0={p: |.p.|<=1}& KXP={q1
where q1 is Point of TOP-REAL 2: |.q1.|=1 & q1`2<=q1`1 & q1`2>=-q1`1} & KXN={q2
where q2 is Point of TOP-REAL 2: |.q2.|=1 & q2`2>=q2`1 & q2`2<=-q2`1} & KYP={q3
where q3 is Point of TOP-REAL 2: |.q3.|=1 & q3`2>=q3`1 & q3`2>=-q3`1} & KYN={q4
where q4 is Point of TOP-REAL 2: |.q4.|=1 & q4`2<=q4`1 & q4`2<=-q4`1} & f.O in
  KXN & f.I in KXP & g.O in KYP & g.I in KYN & rng f c= C0 & rng g c= C0 holds
  rng f meets rng g;

theorem 
  for f,g being Function of I[01],TOP-REAL 2, C0,KXP,KXN,KYP,KYN
  being Subset of TOP-REAL 2, O,I being Point of I[01] st O=0 & I=1 & f is
continuous one-to-one & g is continuous one-to-one & C0={p: |.p.|>=1}& KXP={q1
where q1 is Point of TOP-REAL 2: |.q1.|=1 & q1`2<=q1`1 & q1`2>=-q1`1} & KXN={q2
where q2 is Point of TOP-REAL 2: |.q2.|=1 & q2`2>=q2`1 & q2`2<=-q2`1} & KYP={q3
where q3 is Point of TOP-REAL 2: |.q3.|=1 & q3`2>=q3`1 & q3`2>=-q3`1} & KYN={q4
where q4 is Point of TOP-REAL 2: |.q4.|=1 & q4`2<=q4`1 & q4`2<=-q4`1} & f.O in
  KXN & f.I in KXP & g.O in KYN & g.I in KYP & rng f c= C0 & rng g c= C0 holds
  rng f meets rng g;

theorem 
  for f,g being Function of I[01],TOP-REAL 2, C0,KXP,KXN,KYP,KYN
  being Subset of TOP-REAL 2, O,I being Point of I[01] st O=0 & I=1 & f is
continuous one-to-one & g is continuous one-to-one & C0={p: |.p.|>=1}& KXP={q1
where q1 is Point of TOP-REAL 2: |.q1.|=1 & q1`2<=q1`1 & q1`2>=-q1`1} & KXN={q2
where q2 is Point of TOP-REAL 2: |.q2.|=1 & q2`2>=q2`1 & q2`2<=-q2`1} & KYP={q3
where q3 is Point of TOP-REAL 2: |.q3.|=1 & q3`2>=q3`1 & q3`2>=-q3`1} & KYN={q4
where q4 is Point of TOP-REAL 2: |.q4.|=1 & q4`2<=q4`1 & q4`2<=-q4`1} & f.O in
  KXN & f.I in KXP & g.O in KYP & g.I in KYN & rng f c= C0 & rng g c= C0 holds
  rng f meets rng g;

theorem 
  for f,g being Function of I[01],TOP-REAL 2, C0 being Subset of
  TOP-REAL 2 st C0={q: |.q.|>=1} & f is continuous one-to-one & g is continuous
one-to-one & f.0=|[-1,0]| & f.1=|[1,0]| & g.1=|[0,1]| & g.0=|[0,-1]| & rng f c=
  C0 & rng g c= C0 holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, C0 being Subset of TOP-REAL
2 st C0={p: |.p.|>=1} & |.p1.|=1 & |.p2.|=1 & |.p3.|=1 & |.p4.|=1 & (ex h being
Function of TOP-REAL 2,TOP-REAL 2 st h is being_homeomorphism & h.:C0 c= C0 & h
.p1=|[-1,0]| & h.p2=|[0,1]| & h.p3=|[1,0]| & h.p4=|[0,-1]|) holds for f,g being
  Function of I[01],TOP-REAL 2 st f is continuous one-to-one & g is continuous
  one-to-one & f.0=p1 & f.1=p3 & g.0=p4 & g.1=p2 & rng f c= C0 & rng g c= C0
  holds rng f meets rng g;

begin 

theorem 
  for cn being Real,q being Point of TOP-REAL 2 st -1<cn & cn<1 &
  q`2>0 holds for p being Point of TOP-REAL 2 st p=(cn-FanMorphN).q holds p`2>0
;

theorem 
  for cn being Real,q being Point of TOP-REAL 2 st -1<cn & cn<1 & q`2>=0
  holds for p being Point of TOP-REAL 2 st p=(cn-FanMorphN).q holds p`2>=0;

theorem 
  for cn being Real,q being Point of TOP-REAL 2 st -1<cn & cn<1 &
q`2>=0 & q`1/|.q.|<cn & |.q.|<>0 holds for p being Point of TOP-REAL 2 st p=(cn
  -FanMorphN).q holds p`2>=0 & p`1<0;

theorem 
  for cn being Real,q1,q2 being Point of TOP-REAL 2 st -1<cn & cn<
  1 & q1`2>=0 & q2`2>=0 & |.q1.|<>0 & |.q2.|<>0 & q1`1/|.q1.|<q2`1/|.q2.| holds
for p1,p2 being Point of TOP-REAL 2 st p1=(cn-FanMorphN).q1 & p2=(cn-FanMorphN)
  .q2 holds p1`1/|.p1.|<p2`1/|.p2.|;

theorem 
  for sn being Real,q being Point of TOP-REAL 2 st -1<sn & sn<1 &
  q`1>0 holds for p being Point of TOP-REAL 2 st p=(sn-FanMorphE).q holds p`1>0
;

theorem 
  for sn being Real,q being Point of TOP-REAL 2 st -1<sn & sn<1 & q`1>=0
  & q`2/|.q.|<sn & |.q.|<>0 holds for p being Point of TOP-REAL 2 st p=(sn
  -FanMorphE).q holds p`1>=0 & p`2<0;

theorem 
  for sn being Real,q1,q2 being Point of TOP-REAL 2 st -1<sn & sn<
  1 & q1`1>=0 & q2`1>=0 & |.q1.|<>0 & |.q2.|<>0 & q1`2/|.q1.|<q2`2/|.q2.| holds
for p1,p2 being Point of TOP-REAL 2 st p1=(sn-FanMorphE).q1 & p2=(sn-FanMorphE)
  .q2 holds p1`2/|.p1.|<p2`2/|.p2.|;

theorem 
  for cn being Real,q being Point of TOP-REAL 2 st -1<cn & cn<1 &
  q`2<0 holds for p being Point of TOP-REAL 2 st p=(cn-FanMorphS).q holds p`2<0
;

theorem 
  for cn being Real,q being Point of TOP-REAL 2 st -1<cn & cn<1 &
q`2<0 & q`1/|.q.|>cn holds for p being Point of TOP-REAL 2 st p=(cn-FanMorphS).
  q holds p`2<0 & p`1>0;

theorem 
  for cn being Real,q1,q2 being Point of TOP-REAL 2 st -1<cn & cn<
  1 & q1`2<=0 & q2`2<=0 & |.q1.|<>0 & |.q2.|<>0 & q1`1/|.q1.|<q2`1/|.q2.| holds
for p1,p2 being Point of TOP-REAL 2 st p1=(cn-FanMorphS).q1 & p2=(cn-FanMorphS)
  .q2 holds p1`1/|.p1.|<p2`1/|.p2.|;

begin

theorem 
  for P being compact non empty Subset of TOP-REAL 2 st P={q: |.q
  .|=1} holds W-bound(P)=-1 & E-bound(P)=1 & S-bound(P)=-1 & N-bound(P)=1;

theorem 
  for P being compact non empty Subset of TOP-REAL 2 st P={q: |.q
  .|=1} holds W-min(P)=|[-1,0]|;

theorem 
  for P being compact non empty Subset of TOP-REAL 2 st P={q: |.q
  .|=1} holds E-max(P)=|[1,0]|;

theorem 
  for f being Function of TOP-REAL 2,R^1 st (for p being Point of
  TOP-REAL 2 holds f.p=proj1.p) holds f is continuous;

theorem 
  for f being Function of TOP-REAL 2,R^1 st (for p being Point of
  TOP-REAL 2 holds f.p=proj2.p) holds f is continuous;

theorem 
  for P being compact non empty Subset of TOP-REAL 2 st P={q where
q is Point of TOP-REAL 2: |.q.|=1} holds Upper_Arc(P) c= P & Lower_Arc(P) c= P;

theorem 
  for P being compact non empty Subset of TOP-REAL 2 st P={q where
  q is Point of TOP-REAL 2: |.q.|=1} holds Upper_Arc(P)={p where p is Point of
  TOP-REAL 2:p in P & p`2>=0};

theorem 
  for P being compact non empty Subset of TOP-REAL 2 st P={q where
  q is Point of TOP-REAL 2: |.q.|=1} holds Lower_Arc(P)={p where p is Point of
  TOP-REAL 2:p in P & p`2<=0};

theorem 
  for a,b,d,e being Real st a<=b & e>0 ex f being Function of
  Closed-Interval-TSpace(a,b),Closed-Interval-TSpace(e*a+d,e*b+d) st f is
  being_homeomorphism & for r being Real st r in [.a,b.] holds f.r=e*r+d;

theorem 
  for a,b,d,e being Real st a<=b & e<0 ex f being Function of
  Closed-Interval-TSpace(a,b),Closed-Interval-TSpace(e*b+d,e*a+d) st f is
  being_homeomorphism & for r being Real st r in [.a,b.] holds f.r=e*r+d;

theorem 
  ex f being Function of I[01],Closed-Interval-TSpace(-1,1) st f
is being_homeomorphism & (for r being Real st r in [.0,1.] holds f.r=(-2)*r+1)
  & f.0=1 & f.1=-1;

theorem 
  ex f being Function of I[01],Closed-Interval-TSpace(-1,1) st f
is being_homeomorphism & (for r being Real st r in [.0,1.] holds f.r=2*r-1) & f
  .0=-1 & f.1=1;

theorem 
  for P being compact non empty Subset of TOP-REAL 2 st P={p where
  p is Point of TOP-REAL 2: |.p.|=1} ex f being Function of
  Closed-Interval-TSpace(-1,1),(TOP-REAL 2)|Lower_Arc(P) st f is
  being_homeomorphism & (for q being Point of TOP-REAL 2 st q in Lower_Arc(P)
  holds f.(q`1)=q) & f.(-1)=W-min(P) & f.1=E-max(P);

theorem 
  for P being compact non empty Subset of TOP-REAL 2 st P={p where
  p is Point of TOP-REAL 2: |.p.|=1} ex f being Function of
  Closed-Interval-TSpace(-1,1),(TOP-REAL 2)|Upper_Arc(P) st f is
  being_homeomorphism & (for q being Point of TOP-REAL 2 st q in Upper_Arc(P)
  holds f.(q`1)=q) & f.(-1)=W-min(P) & f.1=E-max(P);

theorem 
  for P being compact non empty Subset of TOP-REAL 2 st P={p where
  p is Point of TOP-REAL 2: |.p.|=1} ex f being Function of I[01],(TOP-REAL 2)|
Lower_Arc(P) st f is being_homeomorphism & (for q1,q2 being Point of TOP-REAL 2
  , r1,r2 being Real st f.r1=q1 & f.r2=q2 & r1 in [.0,1.] & r2 in [.0,1.] holds
  r1<r2 iff q1`1>q2`1)& f.0 = E-max(P) & f.1 = W-min(P);

theorem 
  for P being compact non empty Subset of TOP-REAL 2 st P={p where
  p is Point of TOP-REAL 2: |.p.|=1} ex f being Function of I[01],(TOP-REAL 2)|
Upper_Arc(P) st f is being_homeomorphism & (for q1,q2 being Point of TOP-REAL 2
  , r1,r2 being Real st f.r1=q1 & f.r2=q2 & r1 in [.0,1.] & r2 in [.0,1.] holds
  r1<r2 iff q1`1<q2`1)& f.0 = W-min(P) & f.1 = E-max(P);

theorem 
  for p1,p2 being Point of TOP-REAL 2, P being compact non empty
  Subset of TOP-REAL 2 st P={p where p is Point of TOP-REAL 2: |.p.|=1} & p2 in
  Upper_Arc(P) & LE p1,p2,P holds p1 in Upper_Arc(P);

theorem 
  for p1,p2 being Point of TOP-REAL 2, P being compact non empty
Subset of TOP-REAL 2 st P={p where p is Point of TOP-REAL 2: |.p.|=1} & LE p1,
  p2,P & p1<>p2 & p1`1<0 & p1`2<0 & p2`2<0 holds p1`1>p2`1 & p1`2<p2`2;

theorem 
  for p1,p2 being Point of TOP-REAL 2, P being compact non empty
Subset of TOP-REAL 2 st P={p where p is Point of TOP-REAL 2: |.p.|=1} & LE p1,
  p2,P & p1<>p2 & p2`1<0 & p1`2>=0 & p2`2>=0 holds p1`1<p2`1 & p1`2<p2`2;

theorem 
  for p1,p2 being Point of TOP-REAL 2, P being compact non empty
Subset of TOP-REAL 2 st P={p where p is Point of TOP-REAL 2: |.p.|=1} & LE p1,
  p2,P & p1<>p2 & p2`2>=0 holds p1`1<p2`1;

theorem 
  for p1,p2 being Point of TOP-REAL 2, P being compact non empty
Subset of TOP-REAL 2 st P={p where p is Point of TOP-REAL 2: |.p.|=1} & LE p1,
  p2,P & p1<>p2 & p1`2<=0 & p1<>W-min(P) holds p1`1>p2`1;

theorem 
  for p1,p2 being Point of TOP-REAL 2, P being compact non empty
Subset of TOP-REAL 2 st P={p where p is Point of TOP-REAL 2: |.p.|=1} & (p2`2>=
  0 or p2`1>=0) & LE p1,p2,P holds p1`2>=0 or p1`1>=0;

theorem 
  for p1,p2 being Point of TOP-REAL 2, P being compact non empty
Subset of TOP-REAL 2 st P={p where p is Point of TOP-REAL 2: |.p.|=1} & LE p1,
  p2,P & p1<>p2 & p1`1>=0 & p2`1>=0 holds p1`2>p2`2;

theorem 
  for p1,p2 being Point of TOP-REAL 2, P being compact non empty
Subset of TOP-REAL 2 st P={p where p is Point of TOP-REAL 2: |.p.|=1} & p1 in P
  & p2 in P & p1`1<0 & p2`1<0 & p1`2<0 & p2`2<0 & (p1`1>=p2`1 or p1`2<=p2`2)
  holds LE p1,p2,P;

theorem 
  for p1,p2 being Point of TOP-REAL 2, P being compact non empty Subset
  of TOP-REAL 2 st P={p where p is Point of TOP-REAL 2: |.p.|=1} & p1 in P & p2
in P & p1`1>0 & p2`1>0 & p1`2<0 & p2`2<0 & (p1`1>=p2`1 or p1`2>=p2`2) holds LE
  p1,p2,P;

theorem 
  for p1,p2 being Point of TOP-REAL 2, P being compact non empty
Subset of TOP-REAL 2 st P={p where p is Point of TOP-REAL 2: |.p.|=1} & p1 in P
  & p2 in P & p1`1<0 & p2`1<0 & p1`2>=0 & p2`2>=0 & (p1`1<=p2`1 or p1`2<=p2`2)
  holds LE p1,p2,P;

theorem 
  for p1,p2 being Point of TOP-REAL 2, P being compact non empty
Subset of TOP-REAL 2 st P={p where p is Point of TOP-REAL 2: |.p.|=1} & p1 in P
  & p2 in P & p1`2>=0 & p2`2>=0 & p1`1<=p2`1 holds LE p1,p2,P;

theorem 
  for p1,p2 being Point of TOP-REAL 2, P being compact non empty
Subset of TOP-REAL 2 st P={p where p is Point of TOP-REAL 2: |.p.|=1} & p1 in P
  & p2 in P & p1`1>=0 & p2`1>=0 & p1`2>=p2`2 holds LE p1,p2,P;

theorem 
  for p1,p2 being Point of TOP-REAL 2, P being compact non empty
Subset of TOP-REAL 2 st P={p where p is Point of TOP-REAL 2: |.p.|=1} & p1 in P
  & p2 in P & p1`2<=0 & p2`2<=0 & p2<>W-min(P) & p1`1>=p2`1 holds LE p1,p2,P;

theorem 
  for cn being Real,q being Point of TOP-REAL 2 st -1<cn & cn<1 &
q`2<=0 holds for p being Point of TOP-REAL 2 st p=(cn-FanMorphS).q holds p`2<=0
;

theorem 
  for cn being Real,p1,p2,q1,q2 being Point of TOP-REAL 2, P being
compact non empty Subset of TOP-REAL 2 st -1<cn & cn<1 & P={p where p is Point
of TOP-REAL 2: |.p.|=1} & LE p1,p2,P & q1=(cn-FanMorphS).p1 & q2=(cn-FanMorphS)
  .p2 holds LE q1,q2,P;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, P being compact non
  empty Subset of TOP-REAL 2 st P={p where p is Point of TOP-REAL 2: |.p.|=1} &
LE p1,p2,P & LE p2,p3,P & LE p3,p4,P & p1`1<0 & p1`2>=0 & p2`1<0 & p2`2>=0 & p3
`1<0 & p3`2>=0 & p4`1<0 & p4`2>=0 ex f being Function of TOP-REAL 2,TOP-REAL 2,
  q1,q2,q3,q4 being Point of TOP-REAL 2 st f is being_homeomorphism & (for q
being Point of TOP-REAL 2 holds |.(f.q).|=|.q.|)& q1=f.p1 & q2=f.p2 & q3=f.p3 &
q4=f.p4 & q1`1<0 & q1`2<0 & q2`1<0 & q2`2<0 & q3`1<0 & q3`2<0 & q4`1<0 & q4`2<0
  & LE q1,q2,P & LE q2,q3,P & LE q3,q4,P;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, P being compact non
  empty Subset of TOP-REAL 2 st P={p where p is Point of TOP-REAL 2: |.p.|=1} &
LE p1,p2,P & LE p2,p3,P & LE p3,p4,P & p1`2>=0 & p2`2>=0 & p3`2>=0 & p4`2>0 ex
f being Function of TOP-REAL 2,TOP-REAL 2, q1,q2,q3,q4 being Point of TOP-REAL
2 st f is being_homeomorphism & (for q being Point of TOP-REAL 2 holds |.(f.q)
.|=|.q.|)& q1=f.p1 & q2=f.p2 & q3=f.p3 & q4=f.p4 & q1`1<0 & q1`2>=0 & q2`1<0 &
q2`2>=0 & q3`1<0 & q3`2>=0 & q4`1<0 & q4`2>=0 & LE q1,q2,P & LE q2,q3,P & LE q3
  ,q4,P;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, P being compact non
  empty Subset of TOP-REAL 2 st P={p where p is Point of TOP-REAL 2: |.p.|=1} &
LE p1,p2,P & LE p2,p3,P & LE p3,p4,P & p1`2>=0 & p2`2>=0 & p3`2>=0 & p4`2>0 ex
f being Function of TOP-REAL 2,TOP-REAL 2, q1,q2,q3,q4 being Point of TOP-REAL
2 st f is being_homeomorphism & (for q being Point of TOP-REAL 2 holds |.(f.q)
  .|=|.q.|)& q1=f.p1 & q2=f.p2 & q3=f.p3 & q4=f.p4 & q1`1<0 & q1`2<0 & q2`1<0 &
q2`2<0 & q3`1<0 & q3`2<0 & q4`1<0 & q4`2<0 & LE q1,q2,P & LE q2,q3,P & LE q3,q4
  ,P;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, P being compact non
  empty Subset of TOP-REAL 2 st P={p where p is Point of TOP-REAL 2: |.p.|=1} &
LE p1,p2,P & LE p2,p3,P & LE p3,p4,P & (p1`2>=0 or p1`1>=0)& (p2`2>=0 or p2`1>=
0) & (p3`2>=0 or p3`1>=0)& (p4`2>0 or p4`1>0) ex f being Function of TOP-REAL 2
,TOP-REAL 2, q1,q2,q3,q4 being Point of TOP-REAL 2 st f is being_homeomorphism
& (for q being Point of TOP-REAL 2 holds |.(f.q).|=|.q.|)& q1=f.p1 & q2=f.p2 &
q3=f.p3 & q4=f.p4 & q1`2>=0 & q2`2>=0 & q3`2>=0 & q4`2>0 & LE q1,q2,P & LE q2,
  q3,P & LE q3,q4,P;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, P being compact non
  empty Subset of TOP-REAL 2 st P={p where p is Point of TOP-REAL 2: |.p.|=1} &
LE p1,p2,P & LE p2,p3,P & LE p3,p4,P & (p1`2>=0 or p1`1>=0)& (p2`2>=0 or p2`1>=
0) & (p3`2>=0 or p3`1>=0)& (p4`2>0 or p4`1>0) ex f being Function of TOP-REAL 2
,TOP-REAL 2, q1,q2,q3,q4 being Point of TOP-REAL 2 st f is being_homeomorphism
& (for q being Point of TOP-REAL 2 holds |.(f.q).|=|.q.|)& q1=f.p1 & q2=f.p2 &
q3=f.p3 & q4=f.p4 & q1`1<0 & q1`2<0 & q2`1<0 & q2`2<0 & q3`1<0 & q3`2<0 & q4`1<
  0 & q4`2<0 & LE q1,q2,P & LE q2,q3,P & LE q3,q4,P;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, P being compact non empty
  Subset of TOP-REAL 2 st P={p where p is Point of TOP-REAL 2: |.p.|=1} & p4=
W-min(P) & LE p1,p2,P & LE p2,p3,P & LE p3,p4,P ex f being Function of TOP-REAL
2,TOP-REAL 2, q1,q2,q3,q4 being Point of TOP-REAL 2 st f is being_homeomorphism
& (for q being Point of TOP-REAL 2 holds |.(f.q).|=|.q.|)& q1=f.p1 & q2=f.p2 &
q3=f.p3 & q4=f.p4 & q1`1<0 & q1`2<0 & q2`1<0 & q2`2<0 & q3`1<0 & q3`2<0 & q4`1<
  0 & q4`2<0 & LE q1,q2,P & LE q2,q3,P & LE q3,q4,P;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, P being compact non
  empty Subset of TOP-REAL 2 st P={p where p is Point of TOP-REAL 2: |.p.|=1} &
LE p1,p2,P & LE p2,p3,P & LE p3,p4,P ex f being Function of TOP-REAL 2,TOP-REAL
  2, q1,q2,q3,q4 being Point of TOP-REAL 2 st f is being_homeomorphism & (for q
being Point of TOP-REAL 2 holds |.(f.q).|=|.q.|)& q1=f.p1 & q2=f.p2 & q3=f.p3 &
q4=f.p4 & q1`1<0 & q1`2<0 & q2`1<0 & q2`2<0 & q3`1<0 & q3`2<0 & q4`1<0 & q4`2<0
  & LE q1,q2,P & LE q2,q3,P & LE q3,q4,P;

begin 

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, P being compact non
  empty Subset of TOP-REAL 2 st P={p where p is Point of TOP-REAL 2: |.p.|=1} &
LE p1,p2,P & LE p2,p3,P & LE p3,p4,P & p1<>p2 & p2<>p3 & p3<>p4 & p1`1<0 & p2`1
<0 & p3`1<0 & p4`1<0 & p1`2<0 & p2`2<0 & p3`2<0 ex f being Function of TOP-REAL
  2,TOP-REAL 2 st f is being_homeomorphism & (for q being Point of TOP-REAL 2
holds |.(f.q).|=|.q.|)& |[-1,0]|=f.p1 & |[0,1]|=f.p2 & |[1,0]|=f.p3 & |[0,-1]|=
  f.p4;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, P being compact non
  empty Subset of TOP-REAL 2 st P={p where p is Point of TOP-REAL 2: |.p.|=1} &
  LE p1,p2,P & LE p2,p3,P & LE p3,p4,P & p1<>p2 & p2<>p3 & p3<>p4 ex f being
  Function of TOP-REAL 2,TOP-REAL 2 st f is being_homeomorphism & (for q being
Point of TOP-REAL 2 holds |.(f.q).|=|.q.|)& |[-1,0]|=f.p1 & |[0,1]|=f.p2 & |[1,
  0]|=f.p3 & |[0,-1]|=f.p4;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, P being compact non empty
Subset of TOP-REAL 2,C0 being Subset of TOP-REAL 2 st P={p where p is Point of
TOP-REAL 2: |.p.|=1} & LE p1,p2,P & LE p2,p3,P & LE p3,p4,P holds for f,g being
  Function of I[01],TOP-REAL 2 st f is continuous one-to-one & g is continuous
one-to-one & C0={p: |.p.|<=1}& f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & rng f c= C0
  & rng g c= C0 holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, P being compact non empty
Subset of TOP-REAL 2,C0 being Subset of TOP-REAL 2 st P={p where p is Point of
TOP-REAL 2: |.p.|=1} & LE p1,p2,P & LE p2,p3,P & LE p3,p4,P holds for f,g being
  Function of I[01],TOP-REAL 2 st f is continuous one-to-one & g is continuous
one-to-one & C0={p: |.p.|<=1}& f.0=p1 & f.1=p3 & g.0=p4 & g.1=p2 & rng f c= C0
  & rng g c= C0 holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, P being compact non empty
Subset of TOP-REAL 2,C0 being Subset of TOP-REAL 2 st P={p where p is Point of
TOP-REAL 2: |.p.|=1} & LE p1,p2,P & LE p2,p3,P & LE p3,p4,P holds for f,g being
  Function of I[01],TOP-REAL 2 st f is continuous one-to-one & g is continuous
one-to-one & C0={p: |.p.|>=1}& f.0=p1 & f.1=p3 & g.0=p4 & g.1=p2 & rng f c= C0
  & rng g c= C0 holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, P being compact non empty
Subset of TOP-REAL 2,C0 being Subset of TOP-REAL 2 st P={p where p is Point of
TOP-REAL 2: |.p.|=1} & LE p1,p2,P & LE p2,p3,P & LE p3,p4,P holds for f,g being
  Function of I[01],TOP-REAL 2 st f is continuous one-to-one & g is continuous
one-to-one & C0={p: |.p.|>=1}& f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & rng f c= C0
  & rng g c= C0 holds rng f meets rng g;














begin

theorem 
  for X being non empty MetrSpace, S being sequence of X, F being
  Subset of TopSpaceMetr(X) st S is convergent & (for n being Element of NAT
  holds S.n in F) & F is closed holds lim S in F;

theorem 
  for X,Y being non empty MetrSpace, f being Function of
TopSpaceMetr(X),TopSpaceMetr(Y),S being sequence of X holds f*S is sequence of
  Y;

theorem 
  for X,Y being non empty MetrSpace, f being Function of
TopSpaceMetr(X),TopSpaceMetr(Y),S being sequence of X, T being sequence of Y st
  S is convergent & T= f*S & f is continuous holds T is convergent;

theorem 
  for s being Real_Sequence,S being sequence of RealSpace st s=S
  holds (s is convergent iff S is convergent) & (s is convergent implies lim s=
  lim S);

theorem 
  for a,b being real number,s being Real_Sequence st rng s c= [.a,b
  .] holds s is sequence of Closed-Interval-MSpace(a,b);

theorem 
  for a,b being real number, S being sequence of
  Closed-Interval-MSpace(a,b) st a<=b holds S is sequence of RealSpace;

theorem 
  for a,b being real number, S1 being sequence of
Closed-Interval-MSpace(a,b), S being sequence of RealSpace st S=S1 & a<=b holds
(S is convergent iff S1 is convergent)& (S is convergent implies lim S=lim S1);

theorem 
  for a,b being real number,s being Real_Sequence, S being
sequence of Closed-Interval-MSpace(a,b) st S=s & a<=b & s is convergent holds S
  is convergent & lim s=lim S;

theorem 
  for a,b being real number,s being Real_Sequence, S being sequence of
  Closed-Interval-MSpace(a,b) st S=s & a<=b & s is non-decreasing holds S is
  convergent;

theorem 
  for a,b being real number,s being Real_Sequence, S being sequence of
  Closed-Interval-MSpace(a,b) st S=s & a<=b & s is non-increasing holds S is
  convergent;

theorem 
  for R being non empty Subset of REAL st R is bounded_above holds
ex s being Real_Sequence st s is non-decreasing convergent & rng s c= R & lim s
  =upper_bound R;

theorem 
  for R being non empty Subset of REAL st R is bounded_below holds
ex s being Real_Sequence st s is non-increasing convergent & rng s c= R & lim s
  =lower_bound R;

theorem 
  
  for X being non empty MetrSpace, f being Function of I[01],
TopSpaceMetr(X), F1,F2 being Subset of TopSpaceMetr(X),r1,r2 being Real st 0<=
r1 & r2<=1 & r1<=r2 & f.r1 in F1 & f.r2 in F2 & F1 is closed & F2 is closed & f
is continuous & F1 \/ F2 =the carrier of X ex r being Real st r1<=r & r<=r2 & f
  .r in F1 /\ F2;

theorem 
  for n being Element of NAT,p1,p2 being Point of TOP-REAL n, P,P1
being non empty Subset of TOP-REAL n st P is_an_arc_of p1,p2 & P1 is_an_arc_of
  p2,p1 & P1 c= P holds P1=P;

theorem 
  for P,P1 being compact non empty Subset of TOP-REAL 2 st P is
  being_simple_closed_curve & P1 is_an_arc_of W-min(P),E-max(P) & P1 c= P holds
  P1=Upper_Arc(P) or P1=Lower_Arc(P);














begin

reserve i, j, n for Element of NAT,
  f, g, h, k for FinSequence of REAL,
  M, N for non empty MetrSpace;

theorem 
  for a, b, c, d being Real holds max(a+c,b+d) <= max(a,b) + max(c, d);

theorem 
  for a, b, c, d, e, f being Real st a <= b+c & d <= e+f holds max(
  a,d) <= max(b,e) + max(c,f);

theorem 
  for f, g being FinSequence holds dom g c= dom (f^g);

theorem 
  for i being Nat for f, g being FinSequence st len f < i & i <=
  len f + len g holds i - len f in dom g;

theorem 
  for f, g, h, k being FinSequence st f^g = h^k & len f = len h &
  len g = len k holds f = h & g = k;

theorem 
  len f = len g or dom f = dom g implies len (f+g) = len f & dom (f +g) = dom f
;

theorem 
  len f = len g or dom f = dom g implies len (f-g) = len f & dom (f -g) = dom f
;

theorem 
  len f = len sqr f & dom f = dom sqr f;

theorem 
  len f = len abs f & dom f = dom abs f;

theorem 
  sqr (f^g) = sqr f ^ sqr g;

theorem 
  abs (f^g) = abs f ^ abs g;

theorem 
  len f = len h & len g = len k implies sqr (f^g + h^k) = sqr (f+h) ^
  sqr (g +k);

theorem 
  len f = len h & len g = len k implies abs (f^g + h^k) = abs (f+h) ^
  abs ( g+k);

theorem 
  len f = len h & len g = len k implies sqr (f^g - h^k) = sqr (f-h) ^
  sqr ( g-k);

theorem 
  len f = len h & len g = len k implies abs (f^g - h^k) = abs (f-h
  ) ^ abs (g-k);

theorem 
  len f = n implies f in the carrier of Euclid n;

theorem 
  len f = n implies f in the carrier of TOP-REAL n;

definition
  let M, N be non empty MetrStruct;
  func max-Prod2(M,N) -> strict MetrStruct means


  the carrier of it = [:
  the carrier of M,the carrier of N:] & for x, y being Point of it ex x1, y1
  being Point of M, x2, y2 being Point of N st x = [x1,x2] & y = [y1,y2] & (the
distance of it).(x,y) = max ((the distance of M).(x1,y1),(the distance of N).(
  x2,y2));
end;

registration
  let M, N be non empty MetrStruct;
  cluster max-Prod2(M,N) -> non empty;
end;

definition
  let M, N be non empty MetrStruct, x be Point of M, y be Point of N;
  redefine func [x,y] -> Element of max-Prod2(M,N);
end;

definition
  let M, N be non empty MetrStruct, x be Point of max-Prod2(M,N);
  redefine func x`1 -> Element of M;
  redefine func x`2 -> Element of N;
end;

theorem 
  for M, N being non empty MetrStruct, m1, m2 being Point of M, n1
, n2 being Point of N holds dist([m1,n1],[m2,n2]) = max (dist(m1,m2),dist(n1,n2
  ));

theorem 
  for M, N being non empty MetrStruct, m, n being Point of max-Prod2(M,N
  ) holds dist(m,n) = max (dist(m`1,n`1),dist(m`2,n`2));

theorem 
  for M, N being Reflexive non empty MetrStruct holds max-Prod2(
  M,N) is Reflexive;

registration
  let M, N be Reflexive non empty MetrStruct;
  cluster max-Prod2(M,N) -> Reflexive;
end;

theorem 
  for M, N being symmetric non empty MetrStruct holds max-Prod2(
  M,N) is symmetric;

registration
  let M, N be symmetric non empty MetrStruct;
  cluster max-Prod2(M,N) -> symmetric;
end;

theorem 
  for M, N being triangle non empty MetrStruct holds max-Prod2(M
  ,N) is triangle;

registration
  let M, N be triangle non empty MetrStruct;
  cluster max-Prod2(M,N) -> triangle;
end;

registration
  let M, N be non empty MetrSpace;
  cluster max-Prod2(M,N) -> discerning;
end;

theorem 
  [:TopSpaceMetr M,TopSpaceMetr N:] = TopSpaceMetr max-Prod2(M,N);

theorem 
  the carrier of M = the carrier of N & (for m being Point of M, n being
Point of N, r being Real st r > 0 & m = n ex r1 being Real st r1 > 0 & Ball(n,
  r1) c= Ball(m,r)) & (for m being Point of M, n being Point of N, r being Real
st r > 0 & m = n ex r1 being Real st r1 > 0 & Ball(m,r1) c= Ball(n,r)) implies
  TopSpaceMetr M = TopSpaceMetr N;

theorem 
  [:TopSpaceMetr Euclid i,TopSpaceMetr Euclid j:],
    TopSpaceMetr Euclid (i+j) are_homeomorphic;

theorem 
  ex f be Function of [:TopSpaceMetr Euclid i,TopSpaceMetr Euclid j:],
    TopSpaceMetr Euclid (i+j) st f is being_homeomorphism &
  for fi,fj be FinSequence st [fi,fj] in dom f holds f.(fi,fj) = fi^fj;















begin 

reserve x,y,c for set;

definition
  let x,y,c be set;
  func BitSubtracterOutput(x,y,c) -> Element of InnerVertices 2GatesCircStr(x,
  y,c, 'xor') equals

  2GatesCircOutput(x,y,c, 'xor');
end;

definition
  let x,y,c be set;
  func BitSubtracterCirc(x,y,c) -> strict Boolean gate`2=den Circuit of
  2GatesCircStr(x,y,c, 'xor') equals

  2GatesCircuit(x,y,c, 'xor');
end;

definition
  let x,y,c be set;
  func BorrowIStr(x,y,c) -> unsplit gate`1=arity gate`2isBoolean non void
  strict non empty ManySortedSign equals

  1GateCircStr(<*x,y*>, and2a) +*
  1GateCircStr(<*y,c*>, and2) +* 1GateCircStr(<*x,c*>, and2a);
end;

definition
  let x,y,c be set;
  func BorrowStr(x,y,c) -> unsplit gate`1=arity gate`2isBoolean non void
  strict non empty ManySortedSign equals

  BorrowIStr(x,y,c) +* 1GateCircStr(<*[<*x
  ,y*>, and2a], [<*y,c*>, and2], [<*x,c*>, and2a]*>, or3);
end;

definition
  let x,y,c be set;
  func BorrowICirc(x,y,c) -> strict Boolean gate`2=den Circuit of BorrowIStr(x
  ,y,c) equals

  1GateCircuit(x,y, and2a) +* 1GateCircuit(y,c, and2) +*
  1GateCircuit(x,c, and2a);
end;

theorem 
  InnerVertices BorrowStr(x,y,c) is Relation;

theorem 
  for x,y,c being non pair set holds InputVertices BorrowStr(x,y,c)
  is without_pairs;

theorem 
  for s being State of BorrowICirc(x,y,c), a,b being Element of BOOLEAN
  st a = s.x & b = s.y holds (Following s).[<*x,y*>,and2a] = 'not' a '&' b;

theorem 
  for s being State of BorrowICirc(x,y,c), a,b being Element of BOOLEAN
  st a = s.y & b = s.c holds (Following s).[<*y,c*>, and2] = a '&' b;

theorem 
  for s being State of BorrowICirc(x,y,c), a,b being Element of BOOLEAN
  st a = s.x & b = s.c holds (Following s).[<*x,c*>, and2a] = 'not' a '&' b;

definition
  let x,y,c be set;
  func BorrowOutput(x,y,c) -> Element of InnerVertices BorrowStr(x,y,c) equals

  [<*[<*x,y*>,and2a], [<*y,c*>,and2], [<*x,c*>,and2a]*>, or3];
end;

definition
  let x,y,c be set;
  func BorrowCirc(x,y,c) -> strict Boolean gate`2=den Circuit of BorrowStr(x,y
  ,c) equals

  BorrowICirc(x,y,c) +* 1GateCircuit([<*x,y*>,and2a],[<*y,c*>,and2],[
  <*x,c*>,and2a],or3);
end;

theorem 
  x in the carrier of BorrowStr(x,y,c) & y in the carrier of
  BorrowStr(x,y,c) & c in the carrier of BorrowStr(x,y,c);

theorem 
  [<*x,y*>,and2a] in InnerVertices BorrowStr(x,y,c) & [<*y,c*>,and2
  ] in InnerVertices BorrowStr(x,y,c) & [<*x,c*>,and2a] in InnerVertices
  BorrowStr(x,y,c);

theorem 
  for x,y,c being non pair set holds x in InputVertices BorrowStr(x
,y,c) & y in InputVertices BorrowStr(x,y,c) & c in InputVertices BorrowStr(x,y,
  c);

theorem 
  for x,y,c being non pair set holds InputVertices BorrowStr(x,y,c)
= {x,y,c} & InnerVertices BorrowStr(x,y,c) = {[<*x,y*>,and2a], [<*y,c*>,and2],
  [<*x,c*>,and2a]} \/ {BorrowOutput(x,y,c)};

theorem 
  for x,y,c being non pair set for s being State of BorrowCirc(x,y,c)
for a1,a2 being Element of BOOLEAN st a1 = s.x & a2 = s.y holds (Following s).[
  <*x,y*>,and2a] = 'not' a1 '&' a2;

theorem 
  for x,y,c being non pair set for s being State of BorrowCirc(x,y,c)
for a2,a3 being Element of BOOLEAN st a2 = s.y & a3 = s.c holds (Following s).[
  <*y,c*>,and2] = a2 '&' a3;

theorem 
  for x,y,c being non pair set for s being State of BorrowCirc(x,y,c)
for a1,a3 being Element of BOOLEAN st a1 = s.x & a3 = s.c holds (Following s).[
  <*x,c*>,and2a] = 'not' a1 '&' a3;

theorem 
  for x,y,c being non pair set for s being State of BorrowCirc(x,y
,c) for a1,a2,a3 being Element of BOOLEAN st a1 = s.[<*x,y*>,and2a] & a2 = s.[
<*y,c*>,and2] & a3 = s.[<*x,c*>,and2a] holds (Following s).BorrowOutput(x,y,c)
  = a1 'or' a2 'or' a3;

theorem 
  for x,y,c being non pair set for s being State of BorrowCirc(x,y,c)
for a1,a2 being Element of BOOLEAN st a1 = s.x & a2 = s.y holds Following(s,2).
  [<*x,y*>,and2a] = 'not' a1 '&' a2;

theorem 
  for x,y,c being non pair set for s being State of BorrowCirc(x,y,c)
for a2,a3 being Element of BOOLEAN st a2 = s.y & a3 = s.c holds Following(s,2).
  [<*y,c*>,and2] = a2 '&' a3;

theorem 
  for x,y,c being non pair set for s being State of BorrowCirc(x,y,c)
for a1,a3 being Element of BOOLEAN st a1 = s.x & a3 = s.c holds Following(s,2).
  [<*x,c*>,and2a] = 'not' a1 '&' a3;

theorem 
  for x,y,c being non pair set for s being State of BorrowCirc(x,y,c)
  for a1,a2,a3 being Element of BOOLEAN st a1 = s.x & a2 = s.y & a3 = s.c holds
Following(s,2).BorrowOutput(x,y,c) = 'not' a1 '&' a2 'or' a2 '&' a3 'or' 'not'
  a1 '&' a3;

theorem 
  for x,y,c being non pair set for s being State of BorrowCirc(x,y
  ,c) holds Following(s,2) is stable;

begin 

definition
  let x,y,c be set;
  func BitSubtracterWithBorrowStr(x,y,c) -> unsplit gate`1=arity
  gate`2isBoolean non void strict non empty ManySortedSign equals

  2GatesCircStr(x
  ,y,c, 'xor') +* BorrowStr(x,y,c);
end;

theorem 
  for x,y,c being non pair set holds InputVertices
  BitSubtracterWithBorrowStr(x,y,c) = {x,y,c};

theorem 
  for x,y,c being non pair set holds InnerVertices
BitSubtracterWithBorrowStr(x,y,c) = {[<*x,y*>, 'xor'], 2GatesCircOutput(x,y,c,
'xor')} \/ {[<*x,y*>,and2a], [<*y,c*>,and2], [<*x,c*>,and2a]} \/ {BorrowOutput(
  x,y,c)};

theorem 
  for S being non empty ManySortedSign st S = BitSubtracterWithBorrowStr
  (x, y, c ) holds x in the carrier of S & y in the carrier of S & c in the
  carrier of S;

definition
  let x,y,c be set;
  func BitSubtracterWithBorrowCirc(x,y,c) -> strict Boolean gate`2=den Circuit
  of BitSubtracterWithBorrowStr(x,y,c) equals

  BitSubtracterCirc(x,y,c) +*
  BorrowCirc(x,y,c);
end;

theorem 
  InnerVertices BitSubtracterWithBorrowStr(x,y,c) is Relation;

theorem 
  for x,y,c being non pair set holds InputVertices
  BitSubtracterWithBorrowStr(x,y,c) is without_pairs;

theorem 
  for x,y,c being non pair set for s being State of
BitSubtracterWithBorrowCirc(x,y,c) for a1,a2,a3 being Element of BOOLEAN st a1
  = s.x & a2 = s.y & a3 = s.c holds Following(s,2).BitSubtracterOutput(x,y,c) =
  a1 'xor' a2 'xor' a3 & Following(s,2).BorrowOutput(x,y,c) = 'not' a1 '&' a2
  'or' a2 '&' a3 'or' 'not' a1 '&' a3;

theorem 
  for x,y,c being non pair set for s being State of
  BitSubtracterWithBorrowCirc(x,y,c) holds Following(s,2) is stable;














begin 

theorem 
  for A being Subset of REAL holds for x being Real st x <> 0 holds
  x" ** (x ** A) = A;

theorem 
  for x being Real st x <> 0 holds for A being Subset of REAL holds
  A = REAL implies x ** A = A;

theorem 
  for A being Subset of REAL st A <> {} holds 0 ** A = {0};

theorem 
  for x being Real holds x ** {} = {};

theorem 
  for a,b being R_eal st a <= b holds a = -infty & b = -infty or a
  = -infty & b in REAL or a = -infty & b = +infty or a in REAL & b in REAL or a
  in REAL & b = +infty or a = +infty & b = +infty;

theorem 
  for A being Interval holds 0 ** A is interval;

theorem 
  for A being non empty Interval holds for x being Real st x<>0 holds A is
  open_interval implies x ** A is open_interval;

theorem 
  for A being non empty Interval holds for x being Real st x<>0 holds A is
  closed_interval implies x ** A is closed_interval;

theorem 
  for A being non empty Interval holds for x being Real st 0 < x holds A is
  right_open_interval implies x ** A is right_open_interval;

theorem 
  for A being non empty Interval holds for x being Real st x < 0 holds A is
  right_open_interval implies x ** A is left_open_interval;

theorem 
  for A being non empty Interval holds for x being Real st 0 < x holds A is
  left_open_interval implies x ** A is left_open_interval;

theorem 
  for A being non empty Interval holds for x being Real st x < 0 holds A is
  left_open_interval implies x ** A is right_open_interval;

theorem 
  for A being non empty Interval holds for x being Real st 0 < x for B
  being non empty Interval st B = x ** A holds A = [.inf A,sup A.] implies (B =
[.inf B,sup B.] & for s,t being Real st s = inf A & t = sup A holds inf B = x *
  s & sup B = x * t);

theorem 
  for A being non empty Interval holds for x being Real st 0 < x for B
  being non empty Interval st B = x ** A holds A = ].inf A,sup A.] implies (B =
].inf B,sup B.] & for s,t being Real st s = inf A & t = sup A holds inf B = x *
  s & sup B = x * t);

theorem 
  for A being non empty Interval holds for x being Real st 0 < x for B
  being non empty Interval st B = x ** A holds A = ].inf A,sup A.[ implies (B =
].inf B,sup B.[ & for s,t being Real st s = inf A & t = sup A holds inf B = x *
  s & sup B = x * t);

theorem 
  for A being non empty Interval holds for x being Real st 0 < x for B
  being non empty Interval st B = x ** A holds A = [.inf A,sup A.[ implies (B =
[.inf B,sup B.[ & for s,t being Real st s = inf A & t = sup A holds inf B = x *
  s & sup B = x * t);

theorem 
  for A being non empty Interval holds for x being Real holds x ** A is
  Interval;

registration
  let A be interval Subset of REAL;
  let x be Real;
  cluster x ** A -> interval;
end;

theorem 
  for A being non empty Subset of REAL, x being Real, y being
  R_eal st x = y & 0 <= y holds sup(x ** A) = y * sup A;

theorem 
  for A being non empty Subset of REAL, x being Real, y being
  R_eal st x = y & 0 <= y holds inf(x ** A) = y * inf A;

theorem 
  for A being Interval for x being Real st 0 <= x for y being Real st y
  = diameter(A) holds x * y = diameter(x ** A);

theorem 
  for eps being Real st 0 < eps holds ex n being Element of NAT st
  1 < 2|^n * eps;

theorem 
  for a,b being Real st 0 <= a & 1 < b - a holds ex n being
  Element of NAT st a < n & n < b;

theorem 
  for n being Element of NAT holds dyadic(n) c= DYADIC;

theorem 
  for a,b being Real st a < b & 0 <= a & b <= 1 holds ex c being
  Real st c in DYADIC & a < c & c < b;

theorem 
  for a,b being Real st a < b ex c being Real st c in DOM & a < c & c < b;

theorem 
  for A being non empty Subset of ExtREAL holds for a,b being R_eal st A
  c= [.a,b.] holds a <= inf A & sup A <= b;

theorem 
  0 in DYADIC & 1 in DYADIC;

theorem 
  DYADIC c= [. 0,1 .];

theorem 
  for n,k being Element of NAT st n <= k holds dyadic(n) c= dyadic(k);

theorem 
  for a,b,c,d being Real st a < c & c < b & a < d & d < b holds
  abs(d - c) < b - a;

theorem 
  for eps being Real st 0 < eps holds for d being Real st 0 < d holds ex
r1,r2 being Real st r1 in DYADIC \/ (right_open_halfline 1) & r2 in DYADIC \/ (
  right_open_halfline 1) & 0 < r1 & r1 < d & d < r2 & r2 - r1 < eps;

begin 


theorem 
  for A being non empty Subset of REAL, x being Real st x > 0 & x**A is
  bounded_above holds A is bounded_above;

theorem 
  for A being non empty Subset of REAL, x being Real st x > 0 & x**A is
  bounded_below holds A is bounded_below;














begin 

scheme 

  NonEmpty{ A()-> non empty set, F(set)-> set}: { F(a) where a is Element of A
  (): not contradiction } is non empty;

reserve
  r,s,r0,s0,t for real number;

theorem 
  for a,b being real number st r in [.a,b.] & s in [.a,b.] holds (r
  + s)/2 in [.a,b.];

theorem 
  abs(abs(r0-s0)-abs(r-s)) <= abs(r0-r) + abs(s0-s);

theorem 
  t in ].r,s.[ implies abs(t) < max(abs(r),abs(s));

scheme 

  DoubleChoice{ A,B,C() -> non empty set, P[set,set,set]}: ex a being Function
of A(), B(), b being Function of A(), C() st for i being Element of A() holds P
  [i,a.i,b.i]
provided
 for i being Element of A() ex ai being Element of B(), bi being
Element of C() st P[i,ai,bi];

theorem 
  for S,T being non empty TopSpace, G being Subset of [:S,T:] st
for x being Point of [:S,T:] st x in G ex GS being Subset of S, GT being Subset
  of T st GS is open & GT is open & x in [:GS,GT:] & [:GS,GT:] c= G holds G is
  open;

begin 

theorem 
  for A,B being compact Subset of REAL holds A /\ B is compact;

theorem 
  for T being non empty TopSpace for f being continuous RealMap of T for
  A being Subset of T st A is connected holds f.:A is interval;

definition

  let A,B be Subset of REAL;
  func dist(A,B) -> real number means


  ex X being Subset of REAL st X =
{abs(r - s) where r is Element of REAL, s is Element of REAL : r in A & s in B}
  & it = lower_bound X;
  commutativity;
end;

theorem 
  for A,B being Subset of REAL, r, s st r in A & s in B holds abs(
  r-s) >= dist(A,B);

theorem 
  for A,B being Subset of REAL, C,D being non empty Subset of REAL
  st C c= A & D c= B holds dist(A,B) <= dist(C,D);

theorem 
  for A, B being non empty compact Subset of REAL ex r,s being
  real number st r in A & s in B & dist(A,B) = abs(r - s);

theorem 
  for A, B being non empty compact Subset of REAL holds dist(A,B) >= 0;

theorem 
  for A,B being non empty compact Subset of REAL st A misses B
  holds dist(A,B) > 0;

theorem 
  for e,f being real number, A,B being compact Subset of REAL st A
  misses B & A c= [.e,f.] & B c= [.e,f.] for S being Function of NAT, bool REAL
st for i being Element of NAT holds S.i is interval & S.i meets A & S.i meets
  B ex r being real number st r in [.e,f.] & not r in A \/ B & for i being
  Element of NAT ex k being Element of NAT st i <= k & r in S.k;



theorem 
  for S being closed Subset of TOP-REAL 2 st S is bounded holds
  proj2.:S is closed;

theorem 
  for S being Subset of TOP-REAL 2 st S is bounded holds
  proj2.:S is real-bounded;

theorem 
  for S being compact Subset of TOP-REAL 2 holds proj2.:S is compact;














begin 

registration
  cluster -> non trivial for Simple_closed_curve;
end;

theorem 
  for X being non empty set, A being non empty Subset of X holds A
  is trivial implies ex x being Element of X st A = {x};

theorem 
  for X being non trivial set, p being set ex q being Element of X st q <> p;

theorem 
  for T being non trivial set, X being non trivial Subset of T, p
  being set ex q being Element of T st q in X & q <> p;

theorem 
  for f, g being Function, a being set st f is one-to-one & g is
one-to-one & dom f /\ dom g = { a } & rng f /\ rng g = { f.a } holds f +* g is
  one-to-one;

theorem 
  for f, g being Function, a being set st f is one-to-one & g is
  one-to-one & dom f /\ dom g = { a } & rng f /\ rng g = { f.a } & f.a = g.a
  holds (f +* g)" = f" +* g";

theorem 
  for n being Element of NAT, A being Subset of TOP-REAL n, p, q
  being Point of TOP-REAL n st A is_an_arc_of p, q holds A \ {p} is non empty;

theorem 
  for s1, s3, s4, l being real number st s1 <= s3 & s1 < s4 & 0 <= l & l
  <= 1 holds s1 <= (1-l) * s3+l*s4;

theorem 
  for A being Subset of I[01], a, b being real number st a < b & A
  = ].a,b.[ holds [.a,b.] c= the carrier of I[01];

theorem 
  for A being Subset of I[01], a, b being real number st a < b & A
  = ].a,b.] holds [.a,b.] c= the carrier of I[01];

theorem 
  for A being Subset of I[01], a, b being real number st a < b & A
  = [.a,b.[ holds [.a,b.] c= the carrier of I[01];

theorem 
  for a, b being real number st a <> b holds Cl ].a,b.] = [.a,b.];

theorem 
  for a, b being real number st a <> b holds Cl [.a,b.[ = [.a,b.];

theorem 
  for A being Subset of I[01], a, b being real number st a < b & A = ].a
  ,b.[ holds Cl A = [.a,b.];

theorem 
  for A being Subset of I[01], a, b being real number st a < b & A
  = ].a,b.] holds Cl A = [.a,b.];

theorem 
  for A being Subset of I[01], a, b being real number st a < b & A
  = [.a,b.[ holds Cl A = [.a,b.];

theorem 
  for A being Subset of I[01], a, b being real number st a <= b &
  A = [.a,b.] holds 0 <= a & b <= 1;

theorem 
  for A, B being Subset of I[01], a, b, c being real number st a <
  b & b < c & A = [.a,b.[ & B = ].b,c.] holds A, B are_separated;

theorem 
  for p1, p2 being Point of I[01] holds [. p1, p2 .] is Subset of I[01];

theorem 
  for a, b being Point of I[01] holds ]. a, b .[ is Subset of I[01];

begin 

theorem 
  for p being real number holds {p} is non empty closed_interval Subset of REAL
;

theorem 
  for A being non empty connected Subset of I[01], a, b, c being
  Point of I[01] st a <= b & b <= c & a in A & c in A holds b in A;

theorem 
  for A being non empty connected Subset of I[01], a, b being real
  number st a in A & b in A holds [.a,b.] c= A;

theorem 
  for a, b being real number, A being Subset of I[01] st A = [.a,b
  .] holds A is closed;

theorem 
  for p1, p2 being Point of I[01] st p1 <= p2 holds [. p1, p2 .]
  is non empty compact connected Subset of I[01];

theorem 
  for X being Subset of I[01], X9 being Subset of REAL st X9 = X
  holds X9 is bounded_above bounded_below;

theorem 
  for X being Subset of I[01], X9 being Subset of REAL, x being
  real number st x in X9 & X9 = X holds lower_bound X9 <= x &
   x <= upper_bound X9;

theorem 
  for A being Subset of REAL, B being Subset of I[01] st A = B
  holds A is closed iff B is closed;

theorem 
  for C being non empty closed_interval Subset of REAL
   holds lower_bound C <= upper_bound C;

theorem 
  for C being non empty compact connected Subset of I[01], C9
  being Subset of REAL st C = C9 &
   [. lower_bound C9, upper_bound C9 .] c= C9 holds [. lower_bound C9,
  upper_bound C9 .] = C9;

theorem 
  for C being non empty compact connected Subset of I[01] holds C
  is non empty closed_interval Subset of REAL;

theorem 
  for C being non empty compact connected Subset of I[01] ex p1,
  p2 being Point of I[01] st p1 <= p2 & C = [. p1, p2 .];

begin 

definition
  func I(01) -> strict SubSpace of I[01] means


  the carrier of it = ]. 0,1 .[;
end;

registration
  cluster I(01) -> non empty;
end;

theorem 
  for A being Subset of I[01] st A = the carrier of I(01) holds
  I(01) = I[01] | A;

theorem 
  the carrier of I(01) = (the carrier of I[01]) \ {0,1};

registration
  cluster I(01) -> open;
end;

theorem 
  I(01) is open;

theorem 
  for r being real number holds r in the carrier of I(01) iff 0 < r & r < 1;

theorem 
  for a, b being Point of I[01] st a < b & b <> 1 holds ]. a, b .]
  is non empty Subset of I(01);

theorem 
  for a, b being Point of I[01] st a < b & a <> 0 holds [. a, b .[
  is non empty Subset of I(01);

theorem 
  for D being Simple_closed_curve holds (TOP-REAL 2) | R^2-unit_square,
  (TOP-REAL 2) | D are_homeomorphic;

theorem 
  for n being Element of NAT, D being non empty Subset of TOP-REAL n, p1
, p2 being Point of TOP-REAL n st D is_an_arc_of p1, p2 holds I(01), (TOP-REAL
  n) | (D \ {p1,p2}) are_homeomorphic;

theorem 
  for n being Element of NAT, D being Subset of TOP-REAL n, p1, p2
being Point of TOP-REAL n st D is_an_arc_of p1, p2 holds I[01], (TOP-REAL n) |
  D are_homeomorphic;

theorem 
  for n being Element of NAT, p1, p2 being Point of TOP-REAL n st p1 <>
p2 holds I[01], (TOP-REAL n) | LSeg (p1, p2) are_homeomorphic;

theorem 
  for E being Subset of I(01) st (ex p1, p2 being Point of I[01]
  st p1 < p2 & E = [. p1,p2 .]) holds I[01], I(01)|E are_homeomorphic;

theorem 
  for n being Element of NAT, A being Subset of TOP-REAL n, p, q
being Point of TOP-REAL n, a, b being Point of I[01] st A is_an_arc_of p, q & a
  < b ex E being non empty Subset of I[01], f being Function of I[01]|E, (
TOP-REAL n)|A st E = [. a, b .] & f is being_homeomorphism & f.a = p & f.b = q;

theorem 
  for A being TopSpace, B being non empty TopSpace, f being
Function of A, B, C being TopSpace, X being Subset of A st f is continuous & C
  is SubSpace of B holds for h being Function of A|X, C st h = f|X holds h is
  continuous;

theorem 
  for X being Subset of I[01], a, b being Point of I[01] st X = ].
  a, b .[ holds X is open;

theorem 
  for X being Subset of I(01), a, b being Point of I[01] st X = ].
  a, b .[ holds X is open;

theorem 
  for X being Subset of I(01), a being Point of I[01] st X = ]. 0,
  a .] holds X is closed;

theorem 
  for X being Subset of I(01), a being Point of I[01] st X = [. a,
  1 .[ holds X is closed;

theorem 
  for n being Element of NAT, A being Subset of TOP-REAL n, p, q
being Point of TOP-REAL n, a, b being Point of I[01] st A is_an_arc_of p, q & a
< b & b <> 1 ex E being non empty Subset of I(01), f being Function of I(01)|E,
  (TOP-REAL n)|(A \ {p}) st E = ]. a, b .] & f is being_homeomorphism & f.b = q
;

theorem 
  for n being Element of NAT, A being Subset of TOP-REAL n, p, q
being Point of TOP-REAL n, a, b being Point of I[01] st A is_an_arc_of p, q & a
< b & a <> 0 ex E being non empty Subset of I(01), f being Function of I(01)|E,
  (TOP-REAL n)|(A \ {q}) st E = [. a, b .[ & f is being_homeomorphism & f.a = p
;

theorem 
  for n being Element of NAT, A, B being Subset of TOP-REAL n, p,
q being Point of TOP-REAL n st A is_an_arc_of p, q & B is_an_arc_of q, p & A /\
  B = { p, q } & p <> q holds I(01), (TOP-REAL n) | ((A \ {p}) \/ (B \ {p}))
  are_homeomorphic;

theorem 
  for D being Simple_closed_curve, p being Point of TOP-REAL 2 st
  p in D holds (TOP-REAL 2) | (D \ {p}), I(01) are_homeomorphic;

theorem 
  for D being Simple_closed_curve, p, q being Point of TOP-REAL 2 st p
  in D & q in D holds (TOP-REAL 2) | (D \ {p}), (TOP-REAL 2) | (D \ {q})
  are_homeomorphic;

theorem 
  for n being Element of NAT, C being non empty Subset of TOP-REAL
n, E being Subset of I(01) st (ex p1, p2 being Point of I[01] st p1 < p2 & E =
  [. p1,p2 .]) & I(01)|E, (TOP-REAL n)|C are_homeomorphic holds ex s1, s2 being
  Point of TOP-REAL n st C is_an_arc_of s1,s2;

theorem 
  for Dp being non empty Subset of TOP-REAL 2, f being Function of
  (TOP-REAL 2) | Dp, I(01), C being non empty Subset of TOP-REAL 2 st f is
being_homeomorphism & C c= Dp & (ex p1, p2 being Point of I[01] st p1 < p2 & f
.:C = [. p1,p2 .]) holds ex s1, s2 being Point of TOP-REAL 2 st C is_an_arc_of
  s1,s2;

theorem 
  for D being Simple_closed_curve, C being non empty compact connected
  Subset of TOP-REAL 2 st C c= D holds C = D or (ex p1, p2 being Point of
TOP-REAL 2 st C is_an_arc_of p1,p2) or ex p being Point of TOP-REAL 2 st C = {p
  };

begin 

theorem 
  for C being non empty compact Subset of I[01] st C c= ].0,1.[
holds ex D being non empty closed_interval Subset of REAL
 st C c= D & D c= ].0,1.[ &
 lower_bound C = lower_bound D & upper_bound C = upper_bound D;

theorem 
  for C being non empty compact Subset of I[01] st C c= ].0,1.[
holds ex p1, p2 being Point of I[01] st p1 <= p2 & C c= [. p1, p2 .] & [.p1,p2
  .] c= ]. 0, 1 .[;

theorem 
  for D being Simple_closed_curve, C being closed Subset of TOP-REAL 2
st C c< D ex p1,p2 being Point of TOP-REAL 2, B being Subset of TOP-REAL 2 st B
  is_an_arc_of p1,p2 & C c= B & B c= D;














begin 

canceled;

theorem 
  for x1, x2, x3, x4, x5, x6 being set holds { x1, x2, x3, x4, x5, x6 }
  = { x1, x3, x6 } \/ { x2, x4, x5 };

reserve x1, x2, x3, x4, x5, x6, x7 for set;

theorem 
  for x1, x2, x3, x4, x5, x6 being set st x1, x2, x3, x4, x5, x6
  are_mutually_different holds card {x1, x2, x3, x4, x5, x6} = 6;

theorem 
  for x1, x2, x3, x4, x5, x6, x7 being set st x1, x2, x3, x4, x5, x6, x7
  are_mutually_different holds card {x1, x2, x3, x4, x5, x6, x7} = 7;

theorem 
  { x1, x2, x3 } misses { x4, x5, x6 } implies x1 <> x4 & x1 <> x5
  & x1 <> x6 & x2 <> x4 & x2 <> x5 & x2 <> x6 & x3 <> x4 & x3 <> x5 & x3 <> x6;

theorem 
  x1, x2, x3 are_mutually_different & x4, x5, x6 are_mutually_different
  & { x1, x2, x3 } misses { x4, x5, x6 } implies x1, x2, x3, x4, x5, x6
  are_mutually_different;

theorem 
  x1, x2, x3, x4, x5, x6 are_mutually_different & { x1, x2, x3, x4, x5,
  x6 } misses { x7 } implies x1, x2, x3, x4, x5, x6, x7 are_mutually_different;

theorem 
  x1, x2, x3, x4, x5, x6, x7 are_mutually_different implies x7, x1, x2,
  x3, x4, x5, x6 are_mutually_different;

theorem 
  x1, x2, x3, x4, x5, x6, x7 are_mutually_different implies x1, x2, x5,
  x3, x6, x7, x4 are_mutually_different;

registration
  cluster R^1 -> pathwise_connected;
end;

registration
  cluster connected non empty for TopSpace;
end;

begin 

theorem 
  for A, B being Subset of R^1, a, b, c, d being real number st a < b &
  b <= c & c < d & A = [. a, b .[ & B = ]. c, d .] holds A, B are_separated;

theorem 
  for a, b, c being real number st a <= c & c <= b holds [.a,b.]
  \/ [.c,+infty .[ = [.a,+infty .[;

theorem 
  for a, b, c being real number st a <= c & c <= b holds ]. -infty
  , c .] \/ [. a, b .] = ]. -infty, b .];

registration
  cluster -> real for Element of RAT;
end;

theorem 
  for A being Subset of R^1, p being Point of RealSpace holds p in Cl A
iff for r being real number st r > 0 holds Ball (p, r) meets A;

theorem 
  for p, q being Element of RealSpace st q >= p holds dist (p, q) = q - p;

theorem 
  for A being Subset of R^1 st A = RAT holds Cl A = the carrier of R^1;

theorem 
  for A being Subset of R^1, a, b being real number st A = ]. a, b
  .[ & a <> b holds Cl A = [. a, b .];

begin 

registration
  cluster number_e -> irrational;
end;

definition
  func IRRAT -> Subset of REAL equals

  REAL \ RAT;
end;

definition
  let a, b be real number;
  func RAT (a, b) -> Subset of REAL equals

  RAT /\ ]. a, b .[;
  func IRRAT (a, b) -> Subset of REAL equals

  IRRAT /\ ]. a, b .[;
end;

theorem 
  for x being real number holds x is irrational iff x in IRRAT;

registration
  cluster irrational for real number;
end;

registration
  cluster IRRAT -> non empty;
end;

registration
  let a be rational number, b be irrational real number;
  cluster a + b -> irrational;
  cluster b + a -> irrational;
end;

theorem 
  for a being rational number, b being irrational real number
  holds a + b is irrational;

registration
  let a be irrational real number;
  cluster -a -> irrational;
end;

theorem 
  for a being irrational real number holds -a is irrational;

registration
  let a be rational number, b be irrational real number;
  cluster a - b -> irrational;
  cluster b - a -> irrational;
end;

theorem 
  for a being rational number, b being irrational real number
  holds a - b is irrational;

theorem 
  for a being rational number, b being irrational real number
  holds b - a is irrational;

theorem 
  for a being rational number, b being irrational real number st
  a <> 0 holds a * b is irrational;

theorem 
  for a being rational number, b being irrational real number st
  a <> 0 holds b / a is irrational;

registration
  cluster irrational -> non zero for real number;
end;

theorem 
  for a being rational number, b being irrational real number st
  a <> 0 holds a / b is irrational;

registration
  let r be irrational real number;
  cluster frac r -> irrational;
end;

theorem 
  for r being irrational real number holds frac r is irrational;

registration
  cluster non zero for rational number;
end;

registration
  let a be non zero rational number, b be irrational real number;
  cluster a * b -> irrational;
  cluster b * a -> irrational;
  cluster a / b -> irrational;
  cluster b / a -> irrational;
end;

theorem 
  for a, b being real number st a < b ex p1, p2 being rational
  number st a < p1 & p1 < p2 & p2 < b;

theorem 
  for a, b being real number st a < b ex p being irrational real
  number st a < p & p < b;

theorem 
  for A being Subset of R^1 st A = IRRAT holds Cl A = the carrier of R^1;

theorem 
  for a, b, c being real number holds c in RAT (a,b) iff c is
  rational & a < c & c < b;

theorem 
  for a, b, c being real number holds c in IRRAT (a,b) iff c is
  irrational & a < c & c < b;

theorem 
  for A being Subset of R^1, a, b being real number st a < b & A =
  RAT (a, b) holds Cl A = [. a, b .];

theorem 
  for A being Subset of R^1, a, b being real number st a < b & A =
  IRRAT (a, b) holds Cl A = [. a, b .];

theorem 
  for T being connected TopSpace, A being closed open Subset of T
  holds A = {} or A = [#]T;

theorem 
  for A being Subset of R^1 st A is closed open holds A = {} or A = REAL;

begin 

theorem 
  for A being Subset of R^1, a, b being real number st A = [. a, b
  .[ & a <> b holds Cl A = [. a, b .];

theorem 
  for A being Subset of R^1, a, b being real number st A = ]. a, b
  .] & a <> b holds Cl A = [. a, b .];

theorem 
  for A being Subset of R^1, a, b, c being real number st A = [. a, b .[
  \/ ]. b, c .] & a < b & b < c holds Cl A = [. a, c .];

theorem 
  for A being Subset of R^1, a being real number st A = {a} holds Cl A = {a};

theorem 
  for A being Subset of REAL, B being Subset of R^1 st A = B holds
  A is open iff B is open;

registration
  let A, B be open Subset of REAL;
  cluster A /\ B -> open for Subset of REAL;
  cluster A \/ B -> open for Subset of REAL;
end;

theorem 
  for A being Subset of R^1, a,b being ext-real number st A = ]. a
  ,b .[ holds A is open;

theorem 
  for A being Subset of R^1, a being real number st A = ]. -infty,
  a.] holds A is closed;

theorem 
  for A being Subset of R^1, a being real number st A = [. a,
  +infty .[ holds A is closed;

theorem 
  for a being real number holds [. a,+infty .[ = {a} \/ ]. a, +infty .[;

theorem 
  for a being real number holds ]. -infty,a.] = {a} \/ ]. -infty,a .[;

registration
  let a be real number;
  cluster ]. a,+infty .[ -> non empty;
  cluster ]. -infty,a .] -> non empty;
  cluster ]. -infty,a .[ -> non empty;
  cluster [. a,+infty .[ -> non empty;
end;

theorem 
  for a being real number holds ]. a,+infty .[ <> REAL;

theorem 
  for a being real number holds [. a,+infty .[ <> REAL;

theorem 
  for a being real number holds ]. -infty, a .] <> REAL;

theorem 
  for a being real number holds ]. -infty, a .[ <> REAL;

theorem 
  for A being Subset of R^1, a being real number st A = ]. a,
  +infty .[ holds Cl A = [. a,+infty .[;

theorem 
  for a being real number holds Cl ]. a,+infty .[ = [. a,+infty .[;

theorem 
  for A being Subset of R^1, a being real number st A = ]. -infty,
  a .[ holds Cl A = ]. -infty, a .];

theorem 
  for a being real number holds Cl ]. -infty, a .[ = ]. -infty, a .];

theorem 
  for A, B being Subset of R^1, b being real number st A = ].
  -infty, b .[ & B = ]. b,+infty .[ holds A, B are_separated;

theorem 
  for A being Subset of R^1, a, b being real number st a < b & A = [. a,
  b .[ \/ ]. b,+infty .[ holds Cl A = [. a,+infty .[;

theorem 
  for A being Subset of R^1, a, b being real number st a < b & A =
  ]. a, b .[ \/ ]. b,+infty .[ holds Cl A = [. a,+infty .[;

theorem 
  for A being Subset of R^1, a, b, c being real number st a < b & b < c
  & A = RAT (a,b) \/ ]. b, c .[ \/ ]. c,+infty .[ holds Cl A = [. a,+infty .[;

theorem 
  for a, b being real number holds IRRAT (a, b) misses RAT (a, b);

theorem 
  for a, b being real number holds REAL \ RAT (a, b) = ]. -infty,a
  .] \/ IRRAT (a, b) \/ [.b,+infty .[;

theorem 
  for a, b being real number st a < b holds [.a,+infty .[ \ (]. a,
  b .[ \/ ]. b,+infty .[) = {a} \/ {b};

theorem 
  for A being Subset of R^1 st A = RAT (2,4) \/ ]. 4, 5 .[ \/ ]. 5,
  +infty .[ holds A` = ]. -infty,2 .] \/ IRRAT(2,4) \/ {4} \/ {5};

theorem 
  for A being Subset of R^1, a being real number st A = {a} holds A` =
  ]. -infty, a .[ \/ ]. a,+infty .[;

theorem 
  (]. -infty, 1 .[ \/ ]. 1,+infty .[) /\ (]. -infty, 2 .] \/ IRRAT(2,4)
  \/ {4} \/ {5}) = ]. -infty, 1 .[ \/ ]. 1, 2 .] \/ IRRAT(2,4) \/ {4} \/ {5};

theorem 
  for A being Subset of R^1, a, b being real number st a <= b & A = {a}
  \/ [. b,+infty .[ holds A` = ]. -infty, a .[ \/ ]. a, b .[;

theorem 
  for A being Subset of R^1, a, b being real number st a < b & A = ].
  -infty, a .[ \/ ]. a, b .[ holds Cl A = ]. -infty, b .];

theorem 
  for A being Subset of R^1, a, b being real number st a < b & A =
  ]. -infty, a .[ \/ ]. a, b .] holds Cl A = ]. -infty, b .];

theorem 
  for A being Subset of R^1, a, b, c being real number st a < b &
b < c & A = ]. -infty, a .[ \/ ]. a, b .] \/ IRRAT(b,c) \/ {c} holds Cl A = ].
  -infty, c .];

theorem 
  for A being Subset of R^1, a, b, c, d being real number st a < b & b <
c & A = ]. -infty, a .[ \/ ]. a, b .] \/ IRRAT(b,c) \/ {c} \/ {d} holds Cl A =
  ]. -infty, c .] \/ {d};

theorem 
  for A being Subset of R^1, a, b being real number st a <= b & A = ].
  -infty, a .] \/ {b} holds A` = ]. a, b .[ \/ ]. b,+infty .[;

theorem 
  for a, b being real number holds [. a,+infty .[ \/ {b} <> REAL;

theorem 
  for a, b being real number holds ]. -infty, a .] \/ {b} <> REAL;

theorem 
  for TS being TopStruct, A, B being Subset of TS st A <> B holds A` <> B`;

theorem 
  for A being Subset of R^1 st REAL = A` holds A = {};

begin 

theorem 
  for X being compact Subset of R^1, X9 being Subset of REAL st
  X9 = X holds X9 is bounded_above bounded_below;

theorem 
  for X being compact Subset of R^1, X9 being Subset of REAL, x
  being real number st x in X9 & X9 = X holds lower_bound X9 <= x &
   x <= upper_bound X9;

theorem 
  for C being non empty compact connected Subset of R^1, C9 being
  Subset of REAL st C = C9 & [. lower_bound C9, upper_bound C9 .] c= C9
   holds [. lower_bound C9, upper_bound C9.] = C9;

theorem 
  for A being connected Subset of R^1, a, b, c being real number
  st a <= b & b <= c & a in A & c in A holds b in A;

theorem 
  for A being connected Subset of R^1, a, b being real number st
  a in A & b in A holds [.a,b.] c= A;

theorem 
  for X being non empty compact connected Subset of R^1 holds X
  is non empty non empty closed_interval Subset of REAL;

theorem 
  for A being non empty compact connected Subset of R^1 holds ex a, b
  being real number st a <= b & A = [. a, b .];

registration
  let T be TopSpace;
  cluster open closed non empty for Subset-Family of T;
end;














begin 

registration
  let m,n be non zero Nat;
  cluster (0,n)-->(m,0) -> one-to-one;
  cluster (n,0)-->(0,m) -> one-to-one;
end;

theorem 
  for i being Integer holds i is even iff i-1 is odd;

theorem 
  for i being Integer holds i is odd iff i-1 is even;

theorem 
  for X being trivial set, x being set st x in X for f being
  Function of X,X holds x is_a_fixpoint_of f;

theorem 
  for f being Function-yielding Function holds SubFuncs rng f = rng f;

theorem 
  for A,B,x being set, f being Function st x in A & f in Funcs(A,B)
  holds f.x in B;

theorem 
  for A,B,C being set st C = {} implies B = {} or A = {} for f
  being Function of A, Funcs(B,C) holds doms f = A --> B;

reserve n for Element of NAT,
  p,q,r,s for Element of HP-WFF;

theorem 
  for x being set holds {}.x = {};

theorem 
  for X being set, A being Subset of X holds
  ((0,1) --> (1,0))*chi(A,X) = chi(A`,X);

theorem 
  for X being set, A being Subset of X holds
  ((0,1) --> (1,0))*chi(A`,X) = chi(A,X);

theorem 
  for a,b,x,y,x9,y9 being set st a <> b &
  (a,b) --> (x,y) = (a,b) --> (x9,y9) holds x = x9 & y = y9;

theorem 
  for a,b,x,y,X,Y being set st a<>b & x in X & y in Y holds
  (a,b) --> (x,y) in product((a,b) --> (X,Y));

theorem 
  for D being non empty set for f being Function of 2, D ex d1,d2
  being Element of D st f = (0,1) --> (d1,d2);

theorem 
  for a,b,c,d being set st a <> b holds
  ((a,b) --> (c,d)) * ((a,b)--> (b,a)) = (a,b) --> (d,c);

theorem 
  for a,b,c,d being set, f being Function st a <> b & c in dom f &
  d in dom f holds f*((a,b) --> (c,d)) = (a,b) --> (f.c,f.d);

theorem 
  (0,1) --> (1,0) is Permutation of 2;

begin 

registration
  let f,g be one-to-one Function;
  cluster [:f,g:] -> one-to-one;
end;

theorem 
  for A,B being non empty set, C,D being set, f being Function of
  C,A, g being Function of D,B holds pr1(A,B)*[:f,g:] = f*pr1(C,D);

theorem 
  for A,B being non empty set, C,D being set, f being Function of
  C,A, g being Function of D,B holds pr2(A,B)*[:f,g:] = g*pr2(C,D);

theorem 
  for g being Function holds ({})..g = {};

theorem 
  for f being Function-yielding Function, g,h being Function holds
  (f..g)*h = (f*h)..(g*h);

theorem 
  for C being set, A being non empty set for f being Function of A,
  Funcs({} qua set,C), g being Function of A,{} holds rng(f..g) = {{}};

theorem 
  for A,B,C being set st B = {} implies A = {} for f being
  Function of A, Funcs(B,C), g being Function of A,B holds rng(f..g) c= C;

theorem 
  for A,B,C being set st C = {} implies B = {} or A = {} for f
  being Function of A, Funcs(B,C) holds dom Frege f = Funcs(A,B);

theorem 
  for A,B,C being set st C = {} implies B = {} or A = {} for f
  being Function of A, Funcs(B,C) holds rng Frege f c= Funcs(A,C);

theorem 
  for A,B,C being set st C = {} implies B = {} or A = {} for f
being Function of A, Funcs(B,C) holds Frege f is Function of Funcs(A,B), Funcs(
  A,C);

begin 

registration
  let A,B be set, P be Permutation of A, Q be Permutation of B;
  cluster [:P,Q:] -> bijective for Function of [:A,B:],[:A,B:];
end;

theorem 
  for A,B being set, P being Permutation of A, Q being Permutation of B holds
  [:P,Q:] is bijective;

definition
  let A,B be non empty set;
  let P be Permutation of A, Q be Function of B,B;
  func P => Q -> Function of Funcs(A,B), Funcs(A,B) means


  for f being Function of A,B holds it.f = Q*f*P";
end;

registration
  let A,B be non empty set;
  let P be Permutation of A, Q be Permutation of B;
  cluster P => Q -> bijective;
end;

theorem 
  for A,B being non empty set for P being Permutation of A, Q
  being Permutation of B for f being Function of A,B holds (P => Q)".f = Q"*f*P
;

theorem 
  for A,B being non empty set for P being Permutation of A, Q
  being Permutation of B holds (P => Q)" = P" => (Q");

theorem 
  for A,B,C being non empty set, f being Function of A, Funcs(B,C)
  , g being Function of A,B, P being Permutation of B, Q being Permutation of C
  holds ((P => Q)*f)..(P*g) = Q*(f..g);

begin 

definition
  mode SetValuation is non-empty ManySortedSet of NAT;
end;

reserve V for SetValuation;

definition
  let V;
  func SetVal V -> ManySortedSet of HP-WFF means


  it.VERUM = 1 & (for n holds it.prop n = V.n) &
  for p,q holds it.(p '&' q) = [:it.p, it.q:] & it.(p =>q) = Funcs(it.p,it.q);
end;

definition
  let V,p;
  func SetVal(V,p) equals

  (SetVal V).p;
end;

registration
  let V,p;
  cluster SetVal(V,p) -> non empty;
end;

theorem 
  SetVal(V,VERUM) = 1;

theorem 
  SetVal(V,prop n) = V.n;

theorem 
  SetVal(V,p '&' q) = [:SetVal(V,p), SetVal(V,q):];

theorem 
  SetVal(V,p => q) = Funcs(SetVal(V,p),SetVal(V,q));

registration
  let V,p,q;
  cluster SetVal(V,p => q) -> functional;
end;

registration
  let V,p,q,r;
  cluster -> Function-yielding for Element of SetVal(V,p => (q => r));
end;

registration
  let V,p,q,r;
  cluster Function-yielding for Function of SetVal(V,p => q),SetVal(V,p => r);
  cluster Function-yielding for Element of SetVal(V,p => (q => r));
end;

begin 

definition
  let V;
  mode Permutation of V -> Function means


  dom it = NAT & for n holds it .n is Permutation of V.n;
end;

reserve P for Permutation of V;

definition
  let V,P;
  func Perm P -> ManySortedFunction of SetVal V, SetVal V means


  it.VERUM = id 1 & (for n holds it.prop n = P.n) &
  for p,q ex p9 being Permutation of SetVal(V,p),
      q9 being Permutation of SetVal(V,q) st p9 = it.p & q9 = it.q &
  it.(p '&' q) = [:p9,q9:] & it.(p => q) = p9 => q9;
end;

definition
  let V,P,p;
  func Perm(P,p) -> Function of SetVal(V,p), SetVal(V,p) equals

  (Perm P).p;
end;

theorem 
  Perm(P,VERUM) = id SetVal(V,VERUM);

theorem 
  Perm(P,prop n) = P.n;

theorem 
  Perm(P,p '&' q) = [:Perm(P,p),Perm(P,q):];

theorem 
  for p9 being Permutation of SetVal(V,p), q9 being Permutation of
SetVal(V,q) st p9 = Perm(P,p) & q9 = Perm(P,q) holds Perm(P,p => q) = p9 => q9;

registration
  let V,P,p;
  cluster Perm(P,p) -> bijective;
end;

theorem 
  for g being Function of SetVal(V,p), SetVal(V,q) holds Perm(P,p
  => q).g = Perm(P,q)*g*Perm(P,p)";

theorem 
  for g being Function of SetVal(V,p), SetVal(V,q) holds Perm(P,p
  => q)".g = Perm(P,q)"*g*Perm(P,p);

theorem 
  for f,g being Function of SetVal(V,p), SetVal(V,q) st f = Perm(P
  ,p => q).g holds Perm(P,q)*g = f*Perm(P,p);

theorem 
  for V for P being Permutation of V for x being set st x
is_a_fixpoint_of Perm(P,p) for f being Function st f is_a_fixpoint_of Perm(P,p
  => q) holds f.x is_a_fixpoint_of Perm(P,q);

begin 

definition
  let p;
  attr p is canonical means


  for V ex x being set st for P being Permutation of V holds
  x is_a_fixpoint_of Perm(P,p);
end;

registration
  cluster VERUM -> canonical;
end;

registration
  let p,q;
  cluster p => (q => p) -> canonical;
  cluster (p '&' q) => p -> canonical;
  cluster (p '&' q) => q -> canonical;
  cluster p => (q => (p '&' q)) -> canonical;
end;

registration
  let p,q,r;
  cluster (p => (q => r)) => ((p => q) => (p => r)) -> canonical;
end;

theorem 
  p is canonical & p => q is canonical implies q is canonical;

theorem 
  p in HP_TAUT implies p is canonical;

registration
  cluster canonical for Element of HP-WFF;
end;

begin 

definition
  let p;
  attr p is pseudo-canonical means


  for V for P being Permutation of V
  ex x being set st x is_a_fixpoint_of Perm(P,p);
end;

registration
  cluster canonical -> pseudo-canonical for Element of HP-WFF;
end;

theorem 
  p is pseudo-canonical & p => q is pseudo-canonical implies
  q is pseudo-canonical;

theorem 
  for p,q for V for P being Permutation of V st (ex f being set st
f is_a_fixpoint_of Perm(P,p)) & not (ex f being set st f is_a_fixpoint_of Perm(
  P,q)) holds p => q is not pseudo-canonical;

theorem 
  for a, b being Element of NAT st a <> b holds
  (prop a) => (prop b) => (prop a) => (prop a) is non pseudo-canonical;














begin 

reserve X for set,
  Y for non empty set;

theorem 
  for f being Function of X,Y st f is onto for y being Element of Y
  ex x being set st x in X & y = f.x;

theorem 
  for f being Function of X,Y st f is onto for y being Element of Y ex x
  being Element of X st y = f.x;

theorem 
  for f being Function of X,Y, A being Subset of X st f is onto
  holds (f.:A)` c= f.:A`;

theorem 
  for f being Function of X,Y, A being Subset of X st f is
  one-to-one holds f.:A` c= (f.:A)`;

theorem 
  for f being Function of X,Y, A being Subset of X st f is
  bijective holds (f.:A)` = f.:A`;

begin 

theorem 
  for T being TopSpace for A be Subset of T holds A
  is_a_component_of {}T iff A is empty;

theorem 
  for T being non empty TopSpace for A,B,C being Subset of T st A
  c= B & A is_a_component_of C & B is_a_component_of C holds A = B;

reserve n for Element of NAT;

theorem 
  n >= 1 implies for P being Subset of Euclid n holds P is bounded
  implies P` is not bounded;

reserve r for Real,
  M for non empty MetrSpace;

theorem 
  for C being non empty Subset of TopSpaceMetr M, p being Point of
  TopSpaceMetr M holds (dist_min C).p >= 0;

theorem 
  for C being non empty Subset of TopSpaceMetr M, p being Point of
M st for q being Point of M st q in C holds dist(p,q) >= r holds (dist_min C).p
  >= r;

theorem 
  for A,B being non empty Subset of TopSpaceMetr M holds min_dist_min(A,B) >= 0
;

theorem 
  for A,B being compact Subset of TopSpaceMetr M st A meets B
  holds min_dist_min(A,B) = 0;

theorem 
  for A,B being non empty Subset of TopSpaceMetr M st for p,q
being Point of M st p in A & q in B holds dist(p,q) >= r holds min_dist_min(A,B
  ) >= r;

begin 

theorem 
  for P,Q being Subset of TOP-REAL n st P is_a_component_of Q`
  holds P is_inside_component_of Q or P is_outside_component_of Q;

theorem 
  n>= 1 implies BDD {}TOP-REAL n = {}TOP-REAL n;

theorem 
  BDD [#]TOP-REAL n = {}TOP-REAL n;

theorem 
  n>= 1 implies UBD {}TOP-REAL n = [#]TOP-REAL n;

theorem 
  UBD [#]TOP-REAL n = {}TOP-REAL n;

theorem 
  for P being connected Subset of TOP-REAL n, Q being Subset of TOP-REAL
  n st P misses Q holds P c= UBD Q or P c= BDD Q;

begin 

reserve n for Element of NAT,
  p,q,q1,q2 for Point of TOP-REAL 2,
  r,s1,s2,t1,t2 for Real,
  x,y for Point of Euclid 2;

theorem 
  dist(|[0,0]|,r*q) = abs(r)*dist(|[0,0]|,q);

theorem 
  dist(q1+q,q2+q) = dist(q1,q2);

theorem 
  p <> q implies dist(p,q) > 0;

theorem 
  dist(q1-q,q2-q) = dist(q1,q2);

theorem 
  dist(p,q) = dist(-p,-q);

theorem 
  dist(q-q1,q-q2) = dist(q1,q2);

theorem 
  dist(r*p,r*q) = abs(r)*dist(p,q);

theorem 
  r <= 1 implies dist(p,r*p+(1-r)*q) = (1-r)*dist(p,q);

theorem 
  0 <= r implies dist(q,r*p+(1-r)*q) = r*dist(p,q);

theorem 
  p in LSeg(q1,q2) implies dist(q1,p) + dist(p,q2) = dist(q1,q2);

theorem 
  q1 in LSeg(q2,p) & q1 <> q2 implies dist(q1,p) < dist(q2,p);

theorem 
  y = |[0,0]| implies Ball(y,r) = {q : |.q.| < r };

begin 

theorem 
  AffineMap(r,s1,r,s2).p = r*p+|[s1,s2]|;

theorem 
  AffineMap(r,q`1,r,q`2).p = r*p+q;

theorem 
  s1 > 0 & s2 > 0 implies AffineMap(s1,t1,s2,t2)*AffineMap(1/s1,-
  t1/s1,1/s2,-t2/s2) = id REAL 2;

theorem 
  y = |[0,0]| & x = q & r > 0 implies AffineMap(r,q`1,r,q`2).:Ball
  (y,1) = Ball(x,r);

theorem 
  for A,B,C,D being Real st A>0 & C>0 holds AffineMap(A,B,C,D) is onto;

theorem 
  Ball(x,r)` is connected Subset of TOP-REAL 2;

begin 

definition
  let n;
  let A,B be Subset of TOP-REAL n;
  func dist_min(A,B) -> Real means


  ex A9,B9 being Subset of
  TopSpaceMetr Euclid n st A = A9 & B = B9 & it = min_dist_min(A9,B9);
end;

definition
  let M be non empty MetrSpace;
  let P,Q be non empty compact Subset of TopSpaceMetr M;
  redefine func min_dist_min(P,Q);
  commutativity;
  redefine func max_dist_max(P,Q);
  commutativity;
end;

definition
  let n;
  let A,B be non empty compact Subset of TOP-REAL n;
  redefine func dist_min(A,B);
  commutativity;
end;

theorem 
  for A,B being non empty Subset of TOP-REAL n holds dist_min(A,B) >= 0;

theorem 
  for A,B being compact Subset of TOP-REAL n st A meets B holds
  dist_min(A,B) = 0;

theorem 
  for A,B being non empty Subset of TOP-REAL n st for p,q being
Point of TOP-REAL n st p in A & q in B holds dist(p,q) >= r holds dist_min(A,B)
  >= r;

theorem 
  for D being Subset of TOP-REAL n, A,C being non empty Subset of
  TOP-REAL n st C c= D holds dist_min(A,D) <= dist_min(A,C);

theorem 
  for A,B being non empty compact Subset of TOP-REAL n ex p,q
  being Point of TOP-REAL n st p in A & q in B & dist_min(A,B) = dist(p,q);

theorem 
  for p,q being Point of TOP-REAL n holds dist_min({p},{q}) = dist (p,q);

definition
  let n;
  let p be Point of TOP-REAL n;
  let B be Subset of TOP-REAL n;
  func dist(p,B) -> Real equals

  dist_min({p},B);
end;

theorem 
  for A being non empty Subset of TOP-REAL n, p being Point of TOP-REAL
  n holds dist(p,A) >= 0;

theorem 
  for A being compact Subset of TOP-REAL n, p being Point of TOP-REAL n
  st p in A holds dist(p,A) = 0;

theorem 
  for A being non empty compact Subset of TOP-REAL n, p being
Point of TOP-REAL n ex q being Point of TOP-REAL n st q in A & dist(p,A) = dist
  (p,q);

theorem 
  for C being non empty Subset of TOP-REAL n for D being Subset of
TOP-REAL n st C c= D for q being Point of TOP-REAL n holds dist(q,D) <= dist(q,
  C);

theorem 
  for A being non empty Subset of TOP-REAL n, p being Point of TOP-REAL
n st for q being Point of TOP-REAL n st q in A holds dist(p,q) >= r holds dist(
  p,A) >= r;

theorem 
  for p,q being Point of TOP-REAL n holds dist(p,{q}) = dist(p,q);

theorem 
  for A being non empty Subset of TOP-REAL n, p,q being Point of
  TOP-REAL n st q in A holds dist(p,A) <= dist(p,q);

theorem 
  for A being compact non empty Subset of TOP-REAL 2, B being open
  Subset of TOP-REAL 2 st A c= B for p being Point of TOP-REAL 2 st not p in B
  holds dist(p,B) < dist(p,A);














begin 

registration
  let M be non empty MetrSpace;
  cluster TopSpaceMetr M -> T_2;
end;

theorem 
  for x, y being real number st x >= 0 & max (x,y) = 0 holds x = 0;

theorem 
  for M being non empty MetrSpace, x being Point of M holds (dist x ) . x = 0;

theorem 
  for M being non empty MetrSpace, P being Subset of TopSpaceMetr M
  , x being Point of M st x in P holds 0 in (dist x) .: P;

theorem 
  for M being non empty MetrSpace, P being Subset of TopSpaceMetr M
  , x being Point of M, y being real number st y in (dist x) .: P holds y >= 0;

theorem 
  for M being non empty MetrSpace, P being Subset of TopSpaceMetr M
  , x being set st x in P holds (dist_min P) . x = 0;

theorem 
  for M being non empty MetrSpace, p being Point of M, A being
  Subset of TopSpaceMetr M holds p in Cl A iff for r being real number st r > 0
  ex q being Point of M st q in A & dist (p, q) < r;

theorem 
  for M being non empty MetrSpace, P being non empty Subset of
  TopSpaceMetr M, x being Point of M holds (dist_min P) . x = 0 iff for r being
  real number st r > 0 ex p being Point of M st p in P & dist (x, p) < r;

theorem 
  for M being non empty MetrSpace, P being non empty Subset of
  TopSpaceMetr M, x being Point of M holds x in Cl P iff (dist_min P) . x = 0;

theorem 
  for M being non empty MetrSpace, P being non empty closed Subset
  of TopSpaceMetr M, x being Point of M holds x in P iff (dist_min P) . x = 0;

theorem 
  for A being non empty Subset of R^1 ex X being non empty Subset
  of REAL st A = X & lower_bound A = lower_bound X;

theorem 
  for A being non empty Subset of R^1 ex X being non empty Subset
  of REAL st A = X & upper_bound A = upper_bound X;

theorem 
  for M being non empty MetrSpace, P being non empty Subset of
TopSpaceMetr M, x being Point of M, X being Subset of REAL st X = (dist x) .: P
  holds X is bounded_below;

theorem 
  for M being non empty MetrSpace, P being non empty Subset of
TopSpaceMetr M, x, y being Point of M st y in P holds (dist_min P) . x <= dist
  (x, y);

theorem 
  for M being non empty MetrSpace, P being non empty Subset of
  TopSpaceMetr M, r being real number, x being Point of M holds (for y being
  Point of M st y in P holds dist (x,y) >= r) implies (dist_min P) . x >= r;

theorem 
  for M being non empty MetrSpace, P being non empty Subset of
TopSpaceMetr M, x, y being Point of M holds (dist_min P) . x <= dist (x, y) + (
  dist_min P) . y;

theorem 
  for M being non empty MetrSpace, P being Subset of TopSpaceMetr
  M, Q being non empty Subset of M holds P = Q implies (TopSpaceMetr M)|P =
  TopSpaceMetr(M|Q);

theorem 
  for M being non empty MetrSpace, A being Subset of M, B being
non empty Subset of M, C being Subset of M|B st A = C & C is bounded holds A is
  bounded;

theorem 
  for M being non empty MetrSpace, B being Subset of M, A being Subset
  of TopSpaceMetr M st A = B & A is compact holds B is bounded;

theorem 
  for M being non empty MetrSpace, P being non empty Subset of
  TopSpaceMetr M, z being Point of M holds ex w being Point of M st w in P & (
  dist_min P) . z <= dist (w, z);

registration
  let M be non empty MetrSpace, x be Point of M;
  cluster dist x -> continuous;
end;

registration
  let M be non empty MetrSpace, X be compact non empty Subset of TopSpaceMetr
  M;
  cluster dist_max X -> continuous;
  cluster dist_min X -> continuous;
end;

theorem 
  for M being non empty MetrSpace, P being non empty Subset of
TopSpaceMetr M, x, y being Point of M st y in P & P is compact holds (dist_max
  P) . x >= dist (x, y);

theorem 
  for M being non empty MetrSpace, P being non empty Subset of
TopSpaceMetr M, z being Point of M st P is compact holds ex w being Point of M
  st w in P & (dist_max P) . z >= dist (w, z);

theorem 
  for M being non empty MetrSpace, P, Q being non empty Subset of
  TopSpaceMetr M, z being Point of M st P is compact & Q is compact & z in Q
  holds (dist_min P) . z <= max_dist_max (P, Q);

theorem 
  for M being non empty MetrSpace, P, Q being non empty Subset of
  TopSpaceMetr M, z being Point of M st P is compact & Q is compact & z in Q
  holds (dist_max P) . z <= max_dist_max (P, Q);

theorem 
  for M being non empty MetrSpace, P, Q being non empty Subset of
TopSpaceMetr M, X being Subset of REAL st X = (dist_max P) .: Q & P is compact
  & Q is compact holds X is bounded_above;

theorem 
  for M being non empty MetrSpace, P, Q being non empty Subset of
TopSpaceMetr M, X being Subset of REAL st X = (dist_min P) .: Q & P is compact
  & Q is compact holds X is bounded_above;

theorem 
  for M being non empty MetrSpace, P being non empty Subset of
TopSpaceMetr M, z being Point of M st P is compact holds (dist_min P) . z <= (
  dist_max P) . z;

theorem 
  for M being non empty MetrSpace, P being non empty Subset of
  TopSpaceMetr M holds (dist_min P) .: P = { 0 };

theorem 
  for M being non empty MetrSpace, P, Q being non empty Subset of
  TopSpaceMetr M st P is compact & Q is compact holds max_dist_min (P, Q) >= 0;

theorem 
  for M being non empty MetrSpace, P being non empty Subset of
  TopSpaceMetr M holds max_dist_min (P, P) = 0;

theorem 
  for M being non empty MetrSpace, P, Q being non empty Subset of
  TopSpaceMetr M st P is compact & Q is compact holds min_dist_max (P, Q) >= 0;

theorem 
  for M being non empty MetrSpace, Q, R being non empty Subset of
  TopSpaceMetr M, y being Point of M st Q is compact & R is compact & y in Q
  holds (dist_min R) . y <= max_dist_min (R, Q);

begin 

definition
  let M be non empty MetrSpace, P, Q be Subset of TopSpaceMetr M;
  func HausDist (P, Q) -> Real equals

  max ( max_dist_min (P, Q), max_dist_min
  (Q, P) );
  commutativity;
end;

theorem 
  for M being non empty MetrSpace, Q, R being non empty Subset of
  TopSpaceMetr M, y being Point of M st Q is compact & R is compact & y in Q
  holds (dist_min R).y <= HausDist (Q, R);

theorem 
  for M being non empty MetrSpace, P, Q, R being non empty Subset
  of TopSpaceMetr M st P is compact & Q is compact & R is compact holds
  max_dist_min (P, R) <= HausDist (P, Q) + HausDist (Q, R);

theorem 
  for M being non empty MetrSpace, P, Q, R being non empty Subset
  of TopSpaceMetr M st P is compact & Q is compact & R is compact holds
  max_dist_min (R, P) <= HausDist (P, Q) + HausDist (Q, R);

theorem 
  for M being non empty MetrSpace, P, Q being non empty Subset of
  TopSpaceMetr M st P is compact & Q is compact holds HausDist (P, Q) >= 0;

theorem 
  for M being non empty MetrSpace, P being non empty Subset of
  TopSpaceMetr M holds HausDist (P, P) = 0;

theorem 
  for M being non empty MetrSpace, P, Q being non empty Subset of
TopSpaceMetr M st P is compact & Q is compact & HausDist (P, Q) = 0 holds P = Q
;

theorem 
  for M being non empty MetrSpace, P, Q, R being non empty Subset
of TopSpaceMetr M st P is compact & Q is compact & R is compact holds HausDist
  (P, R) <= HausDist (P, Q) + HausDist (Q, R);

definition
  let n be Element of NAT;
  let P, Q be Subset of TOP-REAL n;
  func max_dist_min (P, Q) -> Real means

  ex P9, Q9 being Subset of
  TopSpaceMetr Euclid n st P = P9 & Q = Q9 & it = max_dist_min (P9, Q9);
end;

definition
  let n be Element of NAT;
  let P, Q be Subset of TOP-REAL n;
  func HausDist (P, Q) -> Real means


  ex P9, Q9 being Subset of
  TopSpaceMetr Euclid n st P = P9 & Q = Q9 & it = HausDist (P9, Q9);
  commutativity;
end;

reserve n for Element of NAT;

theorem 
  for P, Q being non empty Subset of TOP-REAL n st P is compact & Q is
  compact holds HausDist (P, Q) >= 0;

theorem 
  for P being non empty Subset of TOP-REAL n holds HausDist (P, P) = 0;

theorem 
  for P, Q being non empty Subset of TOP-REAL n st P is compact & Q is
  compact & HausDist (P, Q) = 0 holds P = Q;

theorem 
  for P, Q, R being non empty Subset of TOP-REAL n st P is compact & Q
is compact & R is compact holds HausDist (P, R) <= HausDist (P, Q) + HausDist (
  Q, R);














begin

reserve C for Simple_closed_curve,
  A,A1,A2 for Subset of TOP-REAL 2,
  p,p1,p2,q ,q1,q2 for Point of TOP-REAL 2,
  n for Element of NAT;

theorem 
  Lower_Arc C <> Upper_Arc C;

theorem 
  Segment(A,p1,p2,q1,q2) c= A;

theorem 
  q in A implies q in L_Segment(A,p1,p2,q);

theorem 
  q in A implies q in R_Segment(A,p1,p2,q);

theorem 
  LE q1, q2, A, p1, p2 implies q1 in Segment(A,p1,p2,q1,q2) & q2 in
  Segment(A,p1,p2,q1,q2);

theorem 
  Segment(p,q,C) c= C;

theorem 
  p in C & q in C implies LE p,q,C or LE q,p,C;

theorem 
  for X,Y being non empty TopSpace, Y0 being non empty SubSpace of
Y, f being Function of X,Y, g being Function of X,Y0 st f = g & f is continuous
  holds g is continuous;

theorem 
  for S,T being non empty TopSpace, S0 being non empty SubSpace of
  S, T0 being non empty SubSpace of T, f being Function of S,T st f is
being_homeomorphism for g being Function of S0,T0 st g = f|S0 & g is onto holds
  g is being_homeomorphism;

theorem 
  for P1,P2,P3 being Subset of TOP-REAL 2 for p1,p2 being Point of
  TOP-REAL 2 st P1 is_an_arc_of p1,p2 & P2 is_an_arc_of p1,p2 & P3 is_an_arc_of
  p1,p2 & P2 /\ P3={p1,p2} & P1 c= P2 \/ P3 holds P1=P2 or P1=P3;

theorem 
  for C being Simple_closed_curve, A1,A2 being Subset of TOP-REAL
  2, p1,p2 being Point of TOP-REAL 2 st A1 is_an_arc_of p1,p2 & A2 is_an_arc_of
  p1,p2 & A1 c= C & A2 c= C & A1 <> A2 holds A1 \/ A2 = C & A1 /\ A2 = {p1,p2};

theorem 
  for A1,A2 being Subset of TOP-REAL 2, p1,p2,q1,q2 being Point of
  TOP-REAL 2 st A1 is_an_arc_of p1,p2 & A1 /\ A2 = {q1,q2} holds A1 <> A2;

theorem 
  for C being Simple_closed_curve, A1,A2 being Subset of TOP-REAL 2, p1,
p2 being Point of TOP-REAL 2 st A1 is_an_arc_of p1,p2 & A2 is_an_arc_of p1,p2 &
  A1 c= C & A2 c= C & A1 /\ A2 = {p1,p2} holds A1 \/ A2 = C;

theorem 
  A1 c= C & A2 c= C & A1 <> A2 & A1 is_an_arc_of p1,p2 & A2 is_an_arc_of
  p1,p2 implies for A st A is_an_arc_of p1,p2 & A c= C holds A = A1 or A = A2;

theorem 
  for C being Simple_closed_curve, A being non empty Subset of
TOP-REAL 2 st A is_an_arc_of W-min C, E-max C & A c= C holds A = Lower_Arc C or
  A = Upper_Arc C;

theorem 
  A is_an_arc_of p1,p2 & LE q1, q2, A, p1, p2 implies ex g being
  Function of I[01], (TOP-REAL 2)|A, s1, s2 being Real st g is
  being_homeomorphism & g.0 = p1 & g.1 = p2 & g.s1 = q1 & g.s2 = q2 & 0 <= s1 &
  s1 <= s2 & s2 <= 1;

theorem 
  A is_an_arc_of p1,p2 & LE q1, q2, A, p1, p2 & q1 <> q2 implies
  ex g being Function of I[01], (TOP-REAL 2)|A, s1, s2 being Real st g is
  being_homeomorphism & g.0 = p1 & g.1 = p2 & g.s1 = q1 & g.s2 = q2 & 0 <= s1 &
  s1 < s2 & s2 <= 1;

theorem 
  LE q1, q2, A, p1, p2 implies Segment(A,p1,p2,q1,q2) is non empty;

theorem 
  p in C implies p in Segment(p,W-min C,C) & W-min C in Segment(p,W-min C,C);

theorem 
  for f being Function of R^1, R^1 for a,b being Real st a <> 0 &
  f = AffineMap(a,b) holds f is being_homeomorphism;

theorem 
  A is_an_arc_of p1,p2 & LE q1, q2, A, p1, p2 & q1 <> q2 implies
  Segment(A,p1,p2,q1,q2) is_an_arc_of q1,q2;

theorem 
  for p1,p2 being Point of TOP-REAL 2 for P being Subset of TOP-REAL 2
st P c= C & P is_an_arc_of p1,p2 & W-min C in P & E-max C in P holds Upper_Arc
  C c= P or Lower_Arc C c= P;



theorem 
  for P being Subset of TOP-REAL 2, p1,p2,q1,q2 being Point of TOP-REAL
2 st P is_an_arc_of p1,p2 & q1 in P & q2 in P & q1 <> p1 & q1 <> p2 & q2 <> p1
  & q2 <> p2 & q1 <> q2 ex Q being non empty Subset of TOP-REAL 2 st Q
  is_an_arc_of q1,q2 & Q c= P & Q misses {p1,p2};



theorem 
  for P being non empty Subset of TOP-REAL 2, p1,p2,q1 being Point of
TOP-REAL 2 st P is_an_arc_of p1,p2 & q1 in P & p1<>q1 holds Segment(P,p1,p2,p1,
  q1) is_an_arc_of p1,q1;














begin

reserve C, P for Simple_closed_curve,
  a, b, c, d, e for Point of TOP-REAL 2;

theorem 
  for n being Element of NAT, a, p1, p2 being Point of TOP-REAL n,
  P being Subset of TOP-REAL n st a in P & P is_an_arc_of p1,p2 ex f being
Function of I[01], (TOP-REAL n)|P, r being Real st f is being_homeomorphism & f
  .0 = p1 & f.1 = p2 & 0 <= r & r <= 1 & f.r = a;

theorem 
  LE W-min(P),E-max(P),P;

theorem 
  LE a,E-max(P),P implies a in Upper_Arc(P);

theorem 
  LE E-max(P),a,P implies a in Lower_Arc(P);

theorem 
  LE a,W-min(P),P implies a in Lower_Arc(P);

theorem 
  for P being Subset of TOP-REAL 2 st a <> b & P is_an_arc_of c,d &
  LE a,b,P,c,d holds ex e st a <> e & b <> e & LE a,e,P,c,d & LE e,b,P,c,d;

theorem 
  a in P implies ex e st a <> e & LE a,e,P;

theorem 
  a <> b & LE a,b,P implies ex c st c <> a & c <> b & LE a,c,P & LE c,b,P;

definition
  let P be Subset of TOP-REAL 2, a, b, c, d be Point of TOP-REAL 2;
  pred a,b,c,d are_in_this_order_on P means


  LE a,b,P & LE b,c,P & LE c,
d,P or LE b,c,P & LE c,d,P & LE d,a,P or LE c,d,P & LE d,a,P & LE a,b,P or LE d
  ,a,P & LE a,b,P & LE b,c,P;
end;

theorem 
  a in P implies a,a,a,a are_in_this_order_on P;

theorem 
  a,b,c,d are_in_this_order_on P implies b,c,d,a are_in_this_order_on P;

theorem 
  a,b,c,d are_in_this_order_on P implies c,d,a,b are_in_this_order_on P;

theorem 
  a,b,c,d are_in_this_order_on P implies d,a,b,c are_in_this_order_on P;

theorem 
  a <> b & a,b,c,d are_in_this_order_on P implies ex e st e <> a & e <>
  b & a,e,b,c are_in_this_order_on P;

theorem 
  a <> b & a,b,c,d are_in_this_order_on P implies ex e st e <> a & e <>
  b & a,e,b,d are_in_this_order_on P;

theorem 
  b <> c & a,b,c,d are_in_this_order_on P implies ex e st e <> b & e <>
  c & a,b,e,c are_in_this_order_on P;

theorem 
  b <> c & a,b,c,d are_in_this_order_on P implies ex e st e <> b & e <>
  c & b,e,c,d are_in_this_order_on P;

theorem 
  c <> d & a,b,c,d are_in_this_order_on P implies ex e st e <> c & e <>
  d & a,c,e,d are_in_this_order_on P;

theorem 
  c <> d & a,b,c,d are_in_this_order_on P implies ex e st e <> c & e <>
  d & b,c,e,d are_in_this_order_on P;

theorem 
  d <> a & a,b,c,d are_in_this_order_on P implies ex e st e <> d & e <>
  a & a,b,d,e are_in_this_order_on P;

theorem 
  d <> a & a,b,c,d are_in_this_order_on P implies ex e st e <> d & e <>
  a & a,c,d,e are_in_this_order_on P;

theorem 
  a <> c & a <> d & b <> d & a,b,c,d are_in_this_order_on P & b,a,c,d
  are_in_this_order_on P implies a = b;

theorem 
  a <> b & b <> c & c <> d & a,b,c,d are_in_this_order_on P & c,b,a,d
  are_in_this_order_on P implies a = c;

theorem 
  a <> b & a <> c & b <> d & a,b,c,d are_in_this_order_on P & d,b,c,a
  are_in_this_order_on P implies a = d;

theorem 
  a <> c & a <> d & b <> d & a,b,c,d are_in_this_order_on P & a,c,b,d
  are_in_this_order_on P implies b = c;

theorem 
  a <> b & b <> c & c <> d & a,b,c,d are_in_this_order_on P & a,d,c,b
  are_in_this_order_on P implies b = d;

theorem 
  a <> b & a <> c & b <> d & a,b,c,d are_in_this_order_on P & a,b,d,c
  are_in_this_order_on P implies c = d;

theorem 
  a in C & b in C & c in C & d in C implies a,b,c,d are_in_this_order_on
C or a,b,d,c are_in_this_order_on C or a,c,b,d are_in_this_order_on C or a,c,d,
  b are_in_this_order_on C or a,d,b,c are_in_this_order_on C or a,d,c,b
  are_in_this_order_on C;














begin

theorem 
  for P being Subset of TOP-REAL 2, p1,p2,p being Point of TOP-REAL
  2 st P is_an_arc_of p1,p2 & p in P holds Segment(P,p1,p2,p,p)={p};

theorem 
  for p1,p2,p being Point of TOP-REAL 2,a being Real st p in LSeg(
  p1,p2) & p1`1<=a & p2`1<=a holds p`1<=a;

theorem 
  for p1,p2,p being Point of TOP-REAL 2,a being Real st p in LSeg(
  p1,p2) & p1`1>=a & p2`1>=a holds p`1>=a;

theorem 
  for p1,p2,p being Point of TOP-REAL 2,a being Real st p in LSeg(p1,p2)
  & p1`1<a & p2`1<a holds p`1<a;

theorem 
  for p1,p2,p being Point of TOP-REAL 2,a being Real st p in LSeg(p1,p2)
  & p1`1>a & p2`1>a holds p`1>a;

reserve j for Element of NAT;

theorem 
  for f being S-Sequence_in_R2, p,q being Point of TOP-REAL 2 st 1
<=j & j < len f & p in LSeg(f,j) & q in LSeg(f,j) & (f/.j)`2=(f/.(j+1))`2 & (f
  /.j)`1>(f/.(j+1))`1 & LE p,q,L~f,f/.1,f/.(len f) holds p`1>=q`1;

theorem 
  for f being S-Sequence_in_R2, p,q being Point of TOP-REAL 2 st 1
<=j & j < len f & p in LSeg(f,j) & q in LSeg(f,j) & (f/.j)`2=(f/.(j+1))`2 & (f
  /.j)`1<(f/.(j+1))`1 & LE p,q,L~f,f/.1,f/.(len f) holds p`1<=q`1;

definition
  let P be Subset of TOP-REAL 2, p1,p2,p be Point of TOP-REAL 2, e be Real;
  pred p is_Lin P,p1,p2,e means


  P is_an_arc_of p1,p2 & p in P & p`1=e &
  ex p4 being Point of TOP-REAL 2 st p4`1<e & LE p4,p,P,p1,p2 & for p5 being
  Point of TOP-REAL 2 st LE p4,p5,P,p1,p2 & LE p5,p,P,p1,p2 holds p5`1<=e;
  pred p is_Rin P,p1,p2,e means


  P is_an_arc_of p1,p2 & p in P & p`1=e &
  ex p4 being Point of TOP-REAL 2 st p4`1>e & LE p4,p,P,p1,p2 & for p5 being
  Point of TOP-REAL 2 st LE p4,p5,P,p1,p2 & LE p5,p,P,p1,p2 holds p5`1>=e;
  pred p is_Lout P,p1,p2,e means


  P is_an_arc_of p1,p2 & p in P & p`1=e
  & ex p4 being Point of TOP-REAL 2 st p4`1<e & LE p,p4,P,p1,p2 & for p5 being
  Point of TOP-REAL 2 st LE p5,p4,P,p1,p2 & LE p,p5,P,p1,p2 holds p5`1<=e;
  pred p is_Rout P,p1,p2,e means


  P is_an_arc_of p1,p2 & p in P & p`1=e
  & ex p4 being Point of TOP-REAL 2 st p4`1>e & LE p,p4,P,p1,p2 & for p5 being
  Point of TOP-REAL 2 st LE p5,p4,P,p1,p2 & LE p,p5,P,p1,p2 holds p5`1>=e;
  pred p is_OSin P,p1,p2,e means


  P is_an_arc_of p1,p2 & p in P & p`1=e
  & ex p7 being Point of TOP-REAL 2 st LE p7,p,P,p1,p2 & (for p8 being Point of
  TOP-REAL 2 st LE p7,p8,P,p1,p2 & LE p8,p,P,p1,p2 holds p8`1=e) & for p4 being
  Point of TOP-REAL 2 st LE p4,p7,P,p1,p2 & p4<>p7 holds (ex p5 being Point of
TOP-REAL 2 st LE p4,p5,P,p1,p2 & LE p5,p7,P,p1,p2 & p5`1>e) & ex p6 being Point
  of TOP-REAL 2 st LE p4,p6,P,p1,p2 & LE p6,p7,P,p1,p2 & p6`1<e;
  pred p is_OSout P,p1,p2,e means


  P is_an_arc_of p1,p2 & p in P & p`1=e
  & ex p7 being Point of TOP-REAL 2 st LE p,p7,P,p1,p2 & (for p8 being Point of
  TOP-REAL 2 st LE p8,p7,P,p1,p2 & LE p,p8,P,p1,p2 holds p8`1=e) & for p4 being
  Point of TOP-REAL 2 st LE p7,p4,P,p1,p2 & p4<>p7 holds (ex p5 being Point of
TOP-REAL 2 st LE p5,p4,P,p1,p2 & LE p7,p5,P,p1,p2 & p5`1>e)& ex p6 being Point
  of TOP-REAL 2 st LE p6,p4,P,p1,p2 & LE p7,p6,P,p1,p2 & p6`1<e;
end;

theorem 
  for P being Subset of TOP-REAL 2, p1,p2,p being Point of TOP-REAL 2,e
being Real st P is_an_arc_of p1,p2 & p1`1<=e & p2`1>=e holds ex p3 being Point
  of TOP-REAL 2 st p3 in P & p3`1=e;

theorem 
  for P being non empty Subset of TOP-REAL 2, p1,p2,p being Point of
TOP-REAL 2,e being Real st P is_an_arc_of p1,p2 & p1`1<e & p in P & p`1=e holds
  p is_Lin P,p1,p2,e or p is_Rin P,p1,p2,e or p is_OSin P,p1,p2,e;

theorem 
  for P being non empty Subset of TOP-REAL 2, p1,p2,p being Point of
TOP-REAL 2,e being Real st P is_an_arc_of p1,p2 & p2`1>e & p in P & p`1=e holds
  p is_Lout P,p1,p2,e or p is_Rout P,p1,p2,e or p is_OSout P,p1,p2,e;

theorem 
  for P being Subset of I[01],s being Real st P=[.0,s.[ holds P is open;

theorem 
  for P being Subset of I[01],s being Real st P=].s,1.] holds P is open;

theorem 
  for P being non empty Subset of TOP-REAL 2, P1 being Subset of (
TOP-REAL 2)|P,Q being Subset of I[01], f being Function of I[01],(TOP-REAL 2)|P
  ,s being Real st s<=1 & P1= {q0 where q0 is Point of TOP-REAL 2: ex ss being
  Real st 0<=ss & ss<s & q0=f.ss} & Q=[.0,s.[ holds f.:Q=P1;

theorem 
  for P being non empty Subset of TOP-REAL 2, P1 being Subset of (
TOP-REAL 2)|P,Q being Subset of I[01], f being Function of I[01],(TOP-REAL 2)|P
  ,s being Real st s>=0 & P1= {q0 where q0 is Point of TOP-REAL 2: ex ss being
  Real st s<ss & ss<=1 & q0=f.ss} & Q=].s,1.] holds f.:Q=P1;

theorem 
  for P being non empty Subset of TOP-REAL 2, P1 being Subset of (
TOP-REAL 2)|P, f being Function of I[01],(TOP-REAL 2)|P,s being Real st s<=1 &
f is being_homeomorphism & P1= {q0 where q0 is Point of TOP-REAL 2: ex ss being
  Real st 0<=ss & ss<s & q0=f.ss} holds P1 is open;

theorem 
  for P being non empty Subset of TOP-REAL 2, P1 being Subset of (
TOP-REAL 2)|P, f being Function of I[01],(TOP-REAL 2)|P,s being Real st s>=0 &
f is being_homeomorphism & P1= {q0 where q0 is Point of TOP-REAL 2: ex ss being
  Real st s<ss & ss<=1 & q0=f.ss} holds P1 is open;

theorem 
  for T being non empty TopStruct, Q1,Q2 being Subset of T, p1,p2
being Point of T st Q1 /\ Q2={} & Q1 \/ Q2=the carrier of T & p1 in Q1 & p2 in
  Q2 & Q1 is open & Q2 is open holds not ex P being Function of I[01],T st P is
  continuous & P.0=p1 & P.1=p2;

theorem 
  for P being non empty Subset of TOP-REAL 2, Q being Subset of (
TOP-REAL 2)|P, p1,p2,q being Point of TOP-REAL 2 st P is_an_arc_of p1,p2 & q in
P & q<>p1 & q<>p2 & Q=P\{q} holds not Q is connected & not ex R being Function
  of I[01],((TOP-REAL 2)|P)|Q st R is continuous & R.0=p1 & R.1=p2;

theorem 
  for P being non empty Subset of TOP-REAL 2, p1,p2,q1,q2 being
Point of TOP-REAL 2 st P is_an_arc_of p1,p2 & q1 in P & q2 in P holds LE q1,q2,
  P,p1,p2 or LE q2,q1,P,p1,p2;

theorem 
  for n being Element of NAT,p1,p2 being Point of TOP-REAL n, P,P1
being non empty Subset of TOP-REAL n st P is_an_arc_of p1,p2 & P1 is_an_arc_of
  p1,p2 & P1 c= P holds P1=P;

theorem 
  for P being non empty Subset of TOP-REAL 2, p1,p2,q1 being Point
of TOP-REAL 2 st P is_an_arc_of p1,p2 & q1 in P & p2<>q1 holds Segment(P,p1,p2,
  q1,p2) is_an_arc_of q1,p2;

theorem 
  for P being non empty Subset of TOP-REAL 2, p1,p2,q1,q2,q3 being
Point of TOP-REAL 2 st P is_an_arc_of p1,p2 & LE q1,q2,P,p1,p2 & LE q2,q3,P,p1,
p2 holds Segment(P,p1,p2,q1,q2) \/ Segment(P,p1,p2,q2,q3) =Segment(P,p1,p2,q1,
  q3);

theorem 
  for P being non empty Subset of TOP-REAL 2, p1,p2,q1,q2,q3 being Point
  of TOP-REAL 2 st P is_an_arc_of p1,p2 & LE q1,q2,P,p1,p2 & LE q2,q3,P,p1,p2
  holds Segment(P,p1,p2,q1,q2) /\ Segment(P,p1,p2,q2,q3) = {q2};

theorem 
  for P being non empty Subset of TOP-REAL 2, p1,p2 being Point of
  TOP-REAL 2 st P is_an_arc_of p1,p2 holds Segment(P,p1,p2,p1,p2)=P;

theorem 
  for P,Q1 being non empty Subset of TOP-REAL 2, p1,p2,q1,q2 being
Point of TOP-REAL 2 st P is_an_arc_of p1,p2 & Q1 is_an_arc_of q1,q2 & LE q1,q2,
  P,p1,p2 & Q1 c= P holds Q1= Segment(P,p1,p2,q1,q2);

theorem 
  for P being non empty Subset of TOP-REAL 2, p1,p2,q1,q2,p being Point
of TOP-REAL 2,e being Real st q1 is_Lin P,p1,p2,e & q2`1=e & LSeg(q1,q2) c= P &
  p in LSeg(q1,q2) holds p is_Lin P,p1,p2,e;

theorem 
  for P being non empty Subset of TOP-REAL 2, p1,p2,q1,q2,p being Point
of TOP-REAL 2,e being Real st q1 is_Rin P,p1,p2,e & q2`1=e & LSeg(q1,q2) c= P &
  p in LSeg(q1,q2) holds p is_Rin P,p1,p2,e;

theorem 
  for P being non empty Subset of TOP-REAL 2, p1,p2,q1,q2,p being Point
of TOP-REAL 2,e being Real st q1 is_Lout P,p1,p2,e & q2`1=e & LSeg(q1,q2) c= P
  & p in LSeg(q1,q2) holds p is_Lout P,p1,p2,e;

theorem 
  for P being non empty Subset of TOP-REAL 2, p1,p2,q1,q2,p being Point
of TOP-REAL 2,e being Real st q1 is_Rout P,p1,p2,e & q2`1=e & LSeg(q1,q2) c= P
  & p in LSeg(q1,q2) holds p is_Rout P,p1,p2,e;

theorem 
  for P being non empty Subset of TOP-REAL 2, p1,p2,p being Point of
TOP-REAL 2,e being Real st P is_S-P_arc_joining p1,p2 & p1`1<e & p in P & p`1=e
  holds p is_Lin P,p1,p2,e or p is_Rin P,p1,p2,e;

theorem 
  for P being non empty Subset of TOP-REAL 2, p1,p2,p being Point of
TOP-REAL 2,e being Real st P is_S-P_arc_joining p1,p2 & p2`1>e & p in P & p`1=e
  holds p is_Lout P,p1,p2,e or p is_Rout P,p1,p2,e;














begin 

reserve C for Simple_closed_curve,
  P for Subset of TOP-REAL 2,
  p for Point of TOP-REAL 2,
  n for Element of NAT;

theorem 
  for p being Point of TOP-REAL n holds {p} is bounded;

theorem 
  for s1,t being real number, P being Subset of TOP-REAL 2 st P = {
  |[ s,t ]| where s is Real : s1 < s } holds P is convex;

theorem 
  for s2,t being real number, P being Subset of TOP-REAL 2 st P = {
  |[ s,t ]| where s is Real : s < s2 } holds P is convex;

theorem 
  for s,t1 being real number, P being Subset of TOP-REAL 2 st P = {
  |[ s,t ]| where t is Real : t1 < t } holds P is convex;

theorem 
  for s,t2 being real number, P being Subset of TOP-REAL 2 st P = {
  |[ s,t ]| where t is Real : t < t2 } holds P is convex;

theorem 
  north_halfline p \ {p} is convex;

theorem 
  south_halfline p \ {p} is convex;

theorem 
  west_halfline p \ {p} is convex;

theorem 
  east_halfline p \ {p} is convex;

theorem 
  for A being Subset of the carrier of TOP-REAL 2 holds UBD A misses A;

theorem 
  for P being Subset of the carrier of TOP-REAL 2, p1,p2,q1,q2
  being Point of TOP-REAL 2 st P is_an_arc_of p1,p2 & p1 <> q1 & p2 <> q2 holds
  not p1 in Segment(P,p1,p2,q1,q2) & not p2 in Segment(P,p1,p2,q1,q2);

definition
  let D be Subset of TOP-REAL 2;
  attr D is with_the_max_arc means


  D meets Vertical_Line((W-bound D+ E-bound D)/2);
end;

registration
  cluster with_the_max_arc -> non empty for Subset of TOP-REAL 2;
end;

registration
  cluster -> with_the_max_arc for Simple_closed_curve;
end;

registration
  cluster non empty for Simple_closed_curve;
end;

reserve D for compact with_the_max_arc Subset of TOP-REAL 2;

theorem 
  for D being with_the_max_arc Subset of TOP-REAL 2 holds proj2.:(
  D /\ Vertical_Line((W-bound D + E-bound D) / 2)) is not empty;

theorem 
  for C being compact Subset of TOP-REAL 2 holds proj2.:(C /\
  Vertical_Line((W-bound C + E-bound C) / 2)) is closed bounded_below
  bounded_above;

begin 

theorem 
  Lower_Middle_Point C in C;

theorem 
  (Lower_Middle_Point C)`2 <> (Upper_Middle_Point C)`2;

theorem 
  Lower_Middle_Point C <> Upper_Middle_Point C;

begin 

theorem 
  W-bound C = W-bound Upper_Arc C;

theorem 
  E-bound C = E-bound Upper_Arc C;

theorem 
  W-bound C = W-bound Lower_Arc C;

theorem 
  E-bound C = E-bound Lower_Arc C;

theorem 
  Upper_Arc C /\ Vertical_Line((W-bound C + E-bound C) / 2) is not
  empty & proj2.:(Upper_Arc C /\ Vertical_Line((W-bound C + E-bound C) / 2)) is
  not empty;

theorem 
  Lower_Arc C /\ Vertical_Line((W-bound C + E-bound C) / 2) is not
  empty & proj2.:(Lower_Arc C /\ Vertical_Line((W-bound C + E-bound C) / 2)) is
  not empty;

theorem 
  for P being compact connected Subset of TOP-REAL 2 st P c= C & W-min C
  in P & E-max C in P holds Upper_Arc C c= P or Lower_Arc C c= P;

registration
  let C;
  cluster Lower_Arc C -> with_the_max_arc;
  cluster Upper_Arc C -> with_the_max_arc;
end;

begin 

definition
  let P be Subset of the carrier of TOP-REAL 2;
  func UMP P -> Point of TOP-REAL 2 equals

  |[ (E-bound P + W-bound P) / 2 ,
  upper_bound (proj2.:(P /\ Vertical_Line ((E-bound P + W-bound P) / 2))) ]|;
  func LMP P -> Point of TOP-REAL 2 equals

  |[ (E-bound P + W-bound P) / 2 ,
  lower_bound (proj2.:(P /\ Vertical_Line ((E-bound P + W-bound P) / 2))) ]|;
end;

theorem 
  for C being non vertical compact Subset of TOP-REAL 2 holds UMP C <> W-min C;

theorem 
  for C being non vertical compact Subset of TOP-REAL 2 holds UMP C <> E-max C;

theorem 
  for C being non vertical compact Subset of TOP-REAL 2 holds LMP C <> W-min C;

theorem 
  for C being non vertical compact Subset of TOP-REAL 2 holds LMP C <> E-max C;

theorem 
  for C being compact Subset of TOP-REAL 2 st p in C /\ Vertical_Line ((
  W-bound C + E-bound C) / 2) holds p`2 <= (UMP C)`2;

theorem 
  for C being compact Subset of TOP-REAL 2 st p in C /\ Vertical_Line ((
  W-bound C + E-bound C) / 2) holds (LMP C)`2 <= p`2;

theorem 
  UMP D in D;

theorem 
  LMP D in D;

theorem 
  LSeg(UMP P, |[ (W-bound P + E-bound P) / 2, N-bound P]|) is vertical;

theorem 
  LSeg(LMP P, |[ (W-bound P + E-bound P) / 2, S-bound P]|) is vertical;

theorem 
  LSeg(UMP D, |[ (W-bound D + E-bound D) / 2, N-bound D]|) /\ D = { UMP D };

theorem 
  LSeg(LMP D, |[ (W-bound D + E-bound D) / 2, S-bound D]|) /\ D = { LMP D };

theorem 
  (LMP C)`2 < (UMP C)`2;

theorem 
  UMP C <> LMP C;

theorem 
  S-bound C < (UMP C)`2;

theorem 
  (UMP C)`2 <= N-bound C;

theorem 
  S-bound C <= (LMP C)`2;

theorem 
  (LMP C)`2 < N-bound C;

theorem 
  LSeg(UMP C, |[ (W-bound C + E-bound C) / 2, N-bound C]|) misses
  LSeg(LMP C, |[ (W-bound C + E-bound C) / 2, S-bound C]|);

theorem 
  for A, B being Subset of TOP-REAL 2 st A c= B & W-bound A + E-bound A
  = W-bound B + E-bound B & A /\ Vertical_Line ((W-bound A + E-bound A) / 2) is
  non empty & proj2.:(B /\ Vertical_Line ((W-bound A + E-bound A) / 2)) is
  bounded_above holds (UMP A)`2 <= (UMP B)`2;

theorem 
  for A, B being Subset of TOP-REAL 2 st A c= B & W-bound A + E-bound A
  = W-bound B + E-bound B & A /\ Vertical_Line ((W-bound A + E-bound A) / 2) is
  non empty & proj2.:(B /\ Vertical_Line ((W-bound A + E-bound A) / 2)) is
  bounded_below holds (LMP B)`2 <= (LMP A)`2;

theorem 
  for A, B being Subset of TOP-REAL 2 st A c= B & UMP B in A & A /\
  Vertical_Line ((W-bound A + E-bound A) / 2) is non empty & proj2.:(B /\
  Vertical_Line ((W-bound B + E-bound B) / 2)) is bounded_above & W-bound A +
  E-bound A = W-bound B + E-bound B holds UMP A = UMP B;

theorem 
  for A, B being Subset of TOP-REAL 2 st A c= B & LMP B in A & A /\
  Vertical_Line ((W-bound A + E-bound A) / 2) is non empty & proj2.:(B /\
  Vertical_Line ((W-bound B + E-bound B) / 2)) is bounded_below & W-bound A +
  E-bound A = W-bound B + E-bound B holds LMP A = LMP B;

theorem 
  (UMP Upper_Arc C)`2 <= N-bound C;

theorem 
  S-bound C <= (LMP Lower_Arc C)`2;

theorem 
  not (LMP C in Lower_Arc C & UMP C in Lower_Arc C);

theorem 
  not (LMP C in Upper_Arc C & UMP C in Upper_Arc C);














begin

theorem 
  for a,c,d being real number,p being Point of TOP-REAL 2
  st c <=d & p in LSeg(|[a,c]|,|[a,d]|) holds p`1=a & c <=p`2 & p`2<=d;

theorem 
  for a,c,d being real number,p being Point of TOP-REAL 2
  st c <d & p`1=a & c <=p`2 & p`2<=d holds p in LSeg(|[a,c]|,|[a,d]|);

theorem 
  for a,b,d being real number,p being Point of TOP-REAL 2
  st a <=b & p in LSeg(|[a,d]|,|[b,d]|) holds p`2=d & a <=p`1 & p`1<=b;

theorem 
  for a,b being real number,B being Subset of I[01] st
  B=[.a,b.] holds B is closed;

theorem 
  for X being TopStruct,Y,Z being non empty TopStruct,
  f being Function of X,Y, g being Function of X,Z holds dom f=dom g
  & dom f=the carrier of X & dom f=[#]X;

theorem 
  for X being non empty TopSpace,B being non empty Subset of X
  ex f being Function of X|B,X st (for p being Point of X|B holds f.p=p) &
  f is continuous;

theorem 
  for X being non empty TopSpace,
  f1 being Function of X,R^1,a being real number st f1 is continuous
  holds ex g being Function of X,R^1
  st (for p being Point of X,r1 being real number st
  f1.p=r1 holds g.p=r1-a) & g is continuous;

theorem 
  for X being non empty TopSpace,
  f1 being Function of X,R^1,a being real number st f1 is continuous
  holds ex g being Function of X,R^1
  st (for p being Point of X,r1 being real number st
  f1.p=r1 holds g.p=a-r1) & g is continuous;

theorem 
  for X being non empty TopSpace, n being Element of NAT,
  p being Point of TOP-REAL n,
  f being Function of X,R^1 st f is continuous ex g being Function
  of X,TOP-REAL n st (for r being Point of X holds g.r=(f.r)*p) &
  g is continuous;

theorem 
  Sq_Circ.(|[-1,0]|)= |[-1,0]|;

theorem 
  for P being compact non empty Subset of TOP-REAL 2
  st P={p where p is Point of TOP-REAL 2: |.p.|=1}
  holds Sq_Circ.(|[-1,0]|)=W-min(P);

theorem 
  for X being non empty TopSpace, n being Element of NAT,
  g1,g2 being Function of X,TOP-REAL n st g1 is continuous & g2 is continuous
  ex g being Function of X,TOP-REAL n st
  (for r being Point of X holds g.r=g1.r + g2.r) & g is continuous;

theorem 
  for X being non empty TopSpace, n being Element of NAT,
  p1,p2 being Point of TOP-REAL n, f1,f2 being Function of X,R^1 st
  f1 is continuous & f2 is continuous ex g being Function of X,TOP-REAL n st
  (for r being Point of X holds g.r=(f1.r)*p1+(f2.r)*p2) & g is continuous;

begin

reserve p,p1,p2,p3,q,q1,q2 for Point of TOP-REAL 2,
  i for Element of NAT,
  lambda for Real;

theorem 
  for f,g being Function of I[01],TOP-REAL 2,
  C0,KXP,KXN,KYP,KYN being Subset of TOP-REAL 2,
  O,I being Point of I[01] st O=0 & I=1 & f is continuous one-to-one &
  g is continuous one-to-one & C0={p: |.p.|<=1}&
  KXP={q1 where q1 is Point of TOP-REAL 2:
  |.q1.|=1 & q1`2<=q1`1 & q1`2>=-q1`1} &
  KXN={q2 where q2 is Point of TOP-REAL 2:
  |.q2.|=1 & q2`2>=q2`1 & q2`2<=-q2`1} &
  KYP={q3 where q3 is Point of TOP-REAL 2:
  |.q3.|=1 & q3`2>=q3`1 & q3`2>=-q3`1} &
  KYN={q4 where q4 is Point of TOP-REAL 2:
  |.q4.|=1 & q4`2<=q4`1 & q4`2<=-q4`1} & f.O in KXP & f.I in KXN &
  g.O in KYP & g.I in KYN & rng f c= C0 & rng g c= C0 holds rng f meets rng g;

theorem 
  for f,g being Function of I[01],TOP-REAL 2,
  C0,KXP,KXN,KYP,KYN being Subset of TOP-REAL 2,
  O,I being Point of I[01] st O=0 & I=1 & f is continuous & f is one-to-one &
  g is continuous & g is one-to-one & C0={p: |.p.|<=1}&
  KXP={q1 where q1 is Point of TOP-REAL 2:
  |.q1.|=1 & q1`2<=q1`1 & q1`2>=-q1`1} &
  KXN={q2 where q2 is Point of TOP-REAL 2:
  |.q2.|=1 & q2`2>=q2`1 & q2`2<=-q2`1} &
  KYP={q3 where q3 is Point of TOP-REAL 2:
  |.q3.|=1 & q3`2>=q3`1 & q3`2>=-q3`1} &
  KYN={q4 where q4 is Point of TOP-REAL 2:
  |.q4.|=1 & q4`2<=q4`1 & q4`2<=-q4`1} & f.O in KXP & f.I in KXN &
  g.O in KYN & g.I in KYP & rng f c= C0 & rng g c= C0 holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2,
  P being compact non empty Subset of TOP-REAL 2,C0 being Subset of TOP-REAL 2
  st P={p where p is Point of TOP-REAL 2: |.p.|=1}
  & LE p1,p2,P & LE p2,p3,P & LE p3,p4,P holds
  for f,g being Function of I[01],TOP-REAL 2 st
  f is continuous one-to-one & g is continuous one-to-one &
  C0={p8 where p8 is Point of TOP-REAL 2: |.p8.|<=1}&
  f.0=p3 & f.1=p1 & g.0=p2 & g.1=p4 &
  rng f c= C0 & rng g c= C0 holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2,
  P being compact non empty Subset of TOP-REAL 2,C0 being Subset of TOP-REAL 2
  st P={p where p is Point of TOP-REAL 2: |.p.|=1}
  & LE p1,p2,P & LE p2,p3,P & LE p3,p4,P holds
  for f,g being Function of I[01],TOP-REAL 2 st
  f is continuous one-to-one & g is continuous one-to-one &
  C0={p8 where p8 is Point of TOP-REAL 2: |.p8.|<=1}&
  f.0=p3 & f.1=p1 & g.0=p4 & g.1=p2 &
  rng f c= C0 & rng g c= C0 holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2,
  P being compact non empty Subset of TOP-REAL 2,
  C0 being Subset of TOP-REAL 2 st
  P={p where p is Point of TOP-REAL 2: |.p.|=1} &
  p1,p2,p3,p4 are_in_this_order_on P holds
  for f,g being Function of I[01],TOP-REAL 2 st
  f is continuous one-to-one & g is continuous one-to-one &
  C0={p8 where p8 is Point of TOP-REAL 2: |.p8.|<=1}&
  f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 &
  rng f c= C0 & rng g c= C0 holds rng f meets rng g;

begin 

notation
  let a,b,c,d be real number;
  synonym rectangle(a,b,c,d) for [.a,b,c,d.];
end;

theorem 
  for a,b,c,d being real number, p being Point of TOP-REAL 2
  st a<=b & c <=d & p in rectangle(a,b,c,d) holds
  a<=p`1 & p`1<=b & c <=p`2 & p`2<=d;

definition
  let a,b,c,d be real number;
  func inside_of_rectangle(a,b,c,d) -> Subset of TOP-REAL 2 equals

  {p: a <p`1 & p`1< b & c <p`2 & p`2< d};
end;

definition
  let a,b,c,d be real number;
  func closed_inside_of_rectangle(a,b,c,d) -> Subset of TOP-REAL 2 equals

  {p: a <=p`1 & p`1<= b & c <=p`2 & p`2<= d};
end;

definition
  let a,b,c,d be real number;
  func outside_of_rectangle(a,b,c,d) -> Subset of TOP-REAL 2 equals

  {p: not(a <=p`1 & p`1<= b & c <=p`2 & p`2<= d)};
end;

definition
  let a,b,c,d be real number;
  func closed_outside_of_rectangle(a,b,c,d) -> Subset of TOP-REAL 2 equals

  {p: not(a <p`1 & p`1< b & c <p`2 & p`2< d)};
end;

theorem 
  for a,b,r being real number,Kb,Cb being Subset of TOP-REAL 2 st
  r>=0 & Kb={q: |.q.|=1}&
  Cb={p2 where p2 is Point of TOP-REAL 2: |.(p2- |[a,b]|).|=r} holds
  AffineMap(r,a,r,b).:Kb=Cb;

theorem 
  for P,Q being Subset of TOP-REAL 2 st
  (ex f being Function of (TOP-REAL 2)|P,(TOP-REAL 2)|Q st
  f is being_homeomorphism) & P is being_simple_closed_curve holds
  Q is being_simple_closed_curve;

theorem 
  for P being Subset of TOP-REAL 2 st
  P is being_simple_closed_curve holds P is compact;

theorem 
  for a,b,r be real number, Cb being Subset of TOP-REAL 2 st r>0 &
  Cb={p where p is Point of TOP-REAL 2: |.(p- |[a,b]|).|=r}
  holds Cb is being_simple_closed_curve;

definition
  let a,b,r be real number;
  func circle(a,b,r) -> Subset of TOP-REAL 2 equals

  {p where p is Point of TOP-REAL 2: |.p- |[a,b]| .|=r};
end;

registration
  let a,b,r be real number;
  cluster circle(a,b,r) -> compact;
end;

registration
  let a,b be real number;
  let r be non negative real number;
  cluster circle(a,b,r) -> non empty;
end;

definition
  let a,b,r be real number;
  func inside_of_circle(a,b,r) -> Subset of TOP-REAL 2 equals

  {p where p is Point of TOP-REAL 2: |.p- |[a,b]| .|<r};
end;

definition
  let a,b,r be real number;
  func closed_inside_of_circle(a,b,r) -> Subset of TOP-REAL 2 equals

  {p where p is Point of TOP-REAL 2: |.p- |[a,b]| .|<=r};
end;

definition
  let a,b,r be real number;
  func outside_of_circle(a,b,r) -> Subset of TOP-REAL 2 equals

  {p where p is Point of TOP-REAL 2: |.p- |[a,b]| .|>r};
end;

definition
  let a,b,r be real number;
  func closed_outside_of_circle(a,b,r) -> Subset of TOP-REAL 2 equals

  {p where p is Point of TOP-REAL 2: |.p- |[a,b]| .|>=r};
end;

theorem 
  for r being real number holds inside_of_circle(0,0,r)={p : |.p.|<r} &
  (r>0 implies circle(0,0,r)={p2 : |.p2.|=r}) &
  outside_of_circle(0,0,r)={p3 : |.p3.|>r} &
  closed_inside_of_circle(0,0,r)={q : |.q.|<=r} &
  closed_outside_of_circle(0,0,r)={q2 : |.q2.|>=r};

theorem 
  for Kb,Cb being Subset of TOP-REAL 2 st
  Kb={p: -1 <p`1 & p`1< 1 & -1 <p`2 & p`2< 1}&
  Cb={p2 where p2 is Point of TOP-REAL 2: |.p2.|<1} holds Sq_Circ.:Kb=Cb;

theorem 
  for Kb,Cb being Subset of TOP-REAL 2 st
  Kb={p: not(-1 <=p`1 & p`1<= 1 & -1 <=p`2 & p`2<= 1)}&
  Cb={p2 where p2 is Point of TOP-REAL 2: |.p2.|>1} holds Sq_Circ.:Kb=Cb;

theorem 
  for Kb,Cb being Subset of TOP-REAL 2 st
  Kb={p: -1 <=p`1 & p`1<= 1 & -1 <=p`2 & p`2<= 1}&
  Cb={p2 where p2 is Point of TOP-REAL 2: |.p2.|<=1} holds Sq_Circ.:Kb=Cb;

theorem 
  for Kb,Cb being Subset of TOP-REAL 2 st
  Kb={p: not(-1 <p`1 & p`1< 1 & -1 <p`2 & p`2< 1)}&
  Cb={p2 where p2 is Point of TOP-REAL 2: |.p2.|>=1} holds Sq_Circ.:Kb=Cb;

theorem 
  for P0,P1,P01,P11,K0,K1,K01,K11 being Subset of TOP-REAL 2,
  P being non empty compact Subset of TOP-REAL 2,
  f being Function of TOP-REAL 2,TOP-REAL 2 st P= circle(0,0,1) &
  P0= inside_of_circle(0,0,1) & P1= outside_of_circle(0,0,1) &
  P01= closed_inside_of_circle(0,0,1) & P11= closed_outside_of_circle(0,0,1) &
  K0=inside_of_rectangle(-1,1,-1,1) & K1=outside_of_rectangle(-1,1,-1,1) &
  K01=closed_inside_of_rectangle(-1,1,-1,1) &
  K11=closed_outside_of_rectangle(-1,1,-1,1) & f=Sq_Circ
  holds f.:rectangle(-1,1,-1,1)=P & f".:P=rectangle(-1,1,-1,1) &
  f.:K0=P0 & f".:P0=K0 & f.:K1=P1 & f".:P1=K1 &
  f.:K01=P01 & f.:K11=P11 & f".:P01=K01 & f".:P11=K11;

begin 

theorem 
  for a,b,c,d being real number st a <= b & c <= d holds
  LSeg(|[ a,c ]|, |[ a,d ]|) = { p1 : p1`1 = a & p1`2 <= d & p1`2 >= c}
  & LSeg(|[ a,d ]|, |[ b,d ]|) = { p2 : p2`1 <= b & p2`1 >= a & p2`2 = d}
  & LSeg(|[ a,c ]|, |[ b,c ]|) = { q1 : q1`1 <= b & q1`1 >= a & q1`2 = c}
  & LSeg(|[ b,c ]|, |[ b,d ]|) = { q2 : q2`1 = b & q2`2 <= d & q2`2 >= c};

theorem 
  for a,b,c,d being real number st a <= b & c <= d holds
  LSeg(|[a,c]|,|[a,d]|) /\ LSeg(|[a,c]|,|[b,c]|) = {|[a,c]|};

theorem 
  for a,b,c,d being real number st a <= b & c <= d holds
  LSeg(|[a,c]|,|[b,c]|) /\ LSeg(|[b,c]|,|[b,d]|) = {|[b,c]|};

theorem 
  for a,b,c,d being real number st a <= b & c <= d holds
  LSeg(|[a,d]|,|[b,d]|) /\ LSeg(|[b,c]|,|[b,d]|) = {|[b,d]|};

theorem 
  for a,b,c,d being real number st a <= b & c <= d holds
  LSeg(|[a,c]|,|[a,d]|) /\ LSeg(|[a,d]|,|[b,d]|) = {|[a,d]|};

theorem 
  {q: -1=q`1 & -1<=q`2 & q`2<=1 or q`1=1 & -1<=q`2 & q`2<=1
  or -1=q`2 & -1<=q`1 & q`1<=1 or 1=q`2 & -1<=q`1 & q`1<=1}
  = {p: p`1=-1 & -1 <=p`2 & p`2<=1 or p`2=1 & -1<=p`1 & p`1<=1 or
  p`1=1 & -1 <=p`2 & p`2<=1 or p`2=-1 & -1<=p`1 & p`1<=1};

theorem 
  for a,b,c,d being real number st a<=b & c <=d
  holds W-bound rectangle(a,b,c,d) = a;

theorem 
  for a,b,c,d being real number st a<=b & c <=d
  holds N-bound rectangle(a,b,c,d) = d;

theorem 
  for a,b,c,d being real number st a<=b & c <=d
  holds E-bound rectangle(a,b,c,d) = b;

theorem 
  for a,b,c,d being real number st a<=b & c <=d
  holds S-bound rectangle(a,b,c,d) = c;

theorem 
  for a,b,c,d being real number st a<=b & c <=d holds
  NW-corner rectangle(a,b,c,d) = |[a,d]|;

theorem 
  for a,b,c,d being real number st a<=b & c <=d holds
  NE-corner rectangle(a,b,c,d) = |[b,d]|;

theorem 
  for a,b,c,d being real number st a<=b & c <=d
  holds SW-corner rectangle(a,b,c,d) = |[a,c]|;

theorem 
  for a,b,c,d being real number st a<=b & c <=d
  holds SE-corner rectangle(a,b,c,d) = |[b,c]|;

theorem 
  for a,b,c,d being real number st a<=b & c <=d
  holds W-most rectangle(a,b,c,d) = LSeg(|[a,c]|,|[a,d]|);

theorem 
  for a,b,c,d being real number st a<=b & c <=d
  holds E-most rectangle(a,b,c,d) = LSeg(|[b,c]|,|[b,d]|);

theorem 
  for a,b,c,d being real number st a<=b & c <=d
  holds W-min rectangle(a,b,c,d)=|[a,c]| & E-max rectangle(a,b,c,d)=|[b,d]|;

theorem 
  for a,b,c,d being real number st a<b & c <d
  holds LSeg(|[a,c]|,|[a,d]|) \/ LSeg(|[a,d]|,|[b,d]|)
  is_an_arc_of W-min rectangle(a,b,c,d), E-max rectangle(a,b,c,d) &
  LSeg(|[a,c]|,|[b,c]|) \/ LSeg(|[b,c]|,|[b,d]|)
  is_an_arc_of E-max rectangle(a,b,c,d), W-min rectangle(a,b,c,d);

theorem 
  for a,b,c,d being real number, f1,f2 being FinSequence of TOP-REAL 2,
  p0,p1,p01,p10 being Point of TOP-REAL 2 st a < b & c < d &
  p0=|[a,c]| & p1=|[b,d]| & p01=|[a,d]| & p10=|[b,c]| & f1=<*p0,p01,p1*>
  & f2=<*p0,p10,p1*> holds f1 is being_S-Seq &
  L~f1 = LSeg(p0,p01) \/ LSeg(p01,p1) &
  f2 is being_S-Seq & L~f2 = LSeg(p0,p10) \/ LSeg(p10,p1) &
  rectangle(a,b,c,d) = L~f1 \/ L~f2 & L~f1 /\ L~f2 = {p0,p1} & f1/.1 = p0 &
  f1/.len f1=p1 & f2/.1 = p0 & f2/.len f2 = p1;

theorem 
  for P1,P2 being Subset of TOP-REAL 2, a,b,c,d being real number,
  f1,f2 being FinSequence of TOP-REAL 2,p1,p2 being Point of TOP-REAL 2 st
  a < b & c < d & p1=|[a,c]| & p2=|[b,d]| & f1=<*|[a,c]|,|[a,d]|,|[b,d]|*>
  & f2=<*|[a,c]|,|[b,c]|,|[b,d]|*> & P1=L~f1 & P2=L~f2
  holds P1 is_an_arc_of p1,p2 & P2 is_an_arc_of p1,p2
  & P1 is non empty & P2 is non empty &
  rectangle(a,b,c,d) = P1 \/ P2 & P1 /\ P2 = {p1,p2};

theorem 
  for a,b,c,d being real number st a < b & c < d
  holds rectangle(a,b,c,d) is being_simple_closed_curve;

theorem 
  for a,b,c,d being real number st a<b & c <d holds
  Upper_Arc rectangle(a,b,c,d) = LSeg(|[a,c]|,|[a,d]|) \/ LSeg(|[a,d]|,|[b,d]|)
;

theorem 
  for a,b,c,d being real number st a<b & c <d holds
  Lower_Arc rectangle(a,b,c,d)= LSeg(|[a,c]|,|[b,c]|) \/ LSeg(|[b,c]|,|[b,d]|);

theorem 
  for a,b,c,d being real number st a<b & c <d
  ex f being Function of I[01],(TOP-REAL 2)|Upper_Arc rectangle(a,b,c,d)
  st f is being_homeomorphism
  & f.0=W-min rectangle(a,b,c,d) & f.1=E-max rectangle(a,b,c,d) &
  rng f=Upper_Arc rectangle(a,b,c,d) &
  (for r being Real st r in [.0,1/2 .] holds
  f.r=(1-2*r)*|[a,c]|+(2*r)*|[a,d]|)&
  (for r being Real st r in [.1/2,1 .] holds
  f.r=(1-(2*r-1))*|[a,d]|+(2*r-1)*|[b,d]|)&
  (for p being Point of TOP-REAL 2 st p in LSeg(|[a,c]|,|[a,d]|)
  holds 0<=((p`2)-c)/(d-c)/2 & ((p`2)-c)/(d-c)/2<=1
  & f.(((p`2)-c)/(d-c)/2)=p)&
  for p being Point of TOP-REAL 2 st p in LSeg(|[a,d]|,|[b,d]|)
  holds 0<=((p`1)-a)/(b-a)/2 + 1/2 & ((p`1)-a)/(b-a)/2 + 1/2<=1
  & f.(((p`1)-a)/(b-a)/2 + 1/2)=p;

theorem 
  for a,b,c,d being real number st a<b & c <d
  ex f being Function of I[01],(TOP-REAL 2)|(Lower_Arc rectangle(a,b,c,d))
  st f is being_homeomorphism
  & f.0=E-max rectangle(a,b,c,d) & f.1=W-min rectangle(a,b,c,d) &
  rng f=Lower_Arc rectangle(a,b,c,d) &
  (for r being Real st r in [.0,1/2.] holds f.r=(1-2*r)*|[b,d]|+(2*r)*|[b,c]|)&
  (for r being Real st r in [.1/2,1.] holds
  f.r=(1-(2*r-1))*|[b,c]|+(2*r-1)*|[a,c]|)&
  (for p being Point of TOP-REAL 2 st p in LSeg(|[b,d]|,|[b,c]|)
  holds 0<=((p`2)-d)/(c-d)/2 & ((p`2)-d)/(c-d)/2<=1
  & f.(((p`2)-d)/(c-d)/2)=p)&
  for p being Point of TOP-REAL 2 st p in LSeg(|[b,c]|,|[a,c]|)
  holds 0<=((p`1)-b)/(a-b)/2+1/2 & ((p`1)-b)/(a-b)/2+1/2<=1
  & f.(((p`1)-b)/(a-b)/2+1/2)=p;

theorem 
  for a,b,c,d being real number,p1,p2 being Point of TOP-REAL 2 st a<b & c <d
  & p1 in LSeg(|[a,c]|,|[a,d]|) & p2 in LSeg(|[a,c]|,|[a,d]|)
  holds LE p1,p2,rectangle(a,b,c,d) iff p1`2<=p2`2;

theorem 
  for a,b,c,d being real number,p1,p2 being Point of TOP-REAL 2
  st a < b & c < d & p1 in LSeg(|[a,d]|,|[b,d]|) & p2 in LSeg(|[a,d]|,|[b,d]|)
  holds LE p1,p2,rectangle(a,b,c,d) iff p1`1<=p2`1;

theorem 
  for a,b,c,d being real number,p1,p2 being Point of TOP-REAL 2 st a<b & c <d
  & p1 in LSeg(|[b,c]|,|[b,d]|) & p2 in LSeg(|[b,c]|,|[b,d]|)
  holds LE p1,p2,rectangle(a,b,c,d) iff p1`2>=p2`2;

theorem 
  for a,b,c,d being real number,p1,p2 being Point of TOP-REAL 2 st a<b & c <d
  & p1 in LSeg(|[a,c]|,|[b,c]|) & p2 in LSeg(|[a,c]|,|[b,c]|)
  holds LE p1,p2,rectangle(a,b,c,d) &
  p1<>W-min rectangle(a,b,c,d) iff p1`1>=p2`1 & p2<>W-min rectangle(a,b,c,d);

theorem 
  for a,b,c,d being real number,p1,p2 being Point of TOP-REAL 2 st a<b & c <d
  & p1 in LSeg(|[a,c]|,|[a,d]|)
holds LE p1,p2,rectangle(a,b,c,d) iff p2 in LSeg(|[a,c]|,|[a,d]|) & p1`2<=p2`2
  or p2 in LSeg(|[a,d]|,|[b,d]|) or p2 in LSeg(|[b,d]|,|[b,c]|)
  or p2 in LSeg(|[b,c]|,|[a,c]|) & p2<>W-min rectangle(a,b,c,d);

theorem 
  for a,b,c,d being real number,p1,p2 being Point of TOP-REAL 2 st a<b & c <d
  & p1 in LSeg(|[a,d]|,|[b,d]|)
holds LE p1,p2,rectangle(a,b,c,d) iff p2 in LSeg(|[a,d]|,|[b,d]|) & p1`1<=p2`1
  or p2 in LSeg(|[b,d]|,|[b,c]|)
  or p2 in LSeg(|[b,c]|,|[a,c]|) & p2<>W-min rectangle(a,b,c,d);

theorem 
  for a,b,c,d being real number,p1,p2 being Point of TOP-REAL 2
  st a<b & c <d & p1 in LSeg(|[b,d]|,|[b,c]|)
holds LE p1,p2,rectangle(a,b,c,d) iff p2 in LSeg(|[b,d]|,|[b,c]|) & p1`2>=p2`2
  or p2 in LSeg(|[b,c]|,|[a,c]|) & p2<>W-min rectangle(a,b,c,d);

theorem 
  for a,b,c,d being real number,p1,p2 being Point of TOP-REAL 2
  st a<b & c < d & p1 in LSeg(|[b,c]|,|[a,c]|)& p1<>W-min rectangle(a,b,c,d)
  holds LE p1,p2,rectangle(a,b,c,d) iff p2 in LSeg(|[b,c]|,|[a,c]|) &
  p1`1>=p2`1 & p2<>W-min rectangle(a,b,c,d);

theorem 
  for x being set,a,b,c,d being real number
  st x in rectangle(a,b,c,d) & a<b & c <d
  holds x in LSeg(|[a,c]|,|[a,d]|) or x in LSeg(|[a,d]|,|[b,d]|)
  or x in LSeg(|[b,d]|,|[b,c]|) or x in LSeg(|[b,c]|,|[a,c]|);

begin 

theorem 
  for p1,p2 being Point of TOP-REAL 2
  st LE p1,p2,rectangle(-1,1,-1,1) & p1 in LSeg(|[-1,-1]|,|[-1,1]|)
  holds p2 in LSeg(|[-1,-1]|,|[-1,1]|)& p2`2>=p1`2 or
  p2 in LSeg(|[-1,1]|,|[1,1]|) or p2 in LSeg(|[1,1]|,|[1,-1]|)
  or p2 in LSeg(|[1,-1]|,|[-1,-1]|)& p2<>|[-1,-1]|;

theorem 
  for p1,p2 being Point of TOP-REAL 2,
  P being non empty compact Subset of TOP-REAL 2,
  f being Function of TOP-REAL 2,TOP-REAL 2 st P= circle(0,0,1) & f=Sq_Circ
  & p1 in LSeg(|[-1,-1]|,|[-1,1]|)& p1`2>=0 & LE p1,p2,rectangle(-1,1,-1,1)
  holds LE f.p1,f.p2,P;

theorem 
  for p1,p2,p3 being Point of TOP-REAL 2,
  P being non empty compact Subset of TOP-REAL 2,
  f being Function of TOP-REAL 2,TOP-REAL 2 st P= circle(0,0,1) & f=Sq_Circ
  & p1 in LSeg(|[-1,-1]|,|[-1,1]|)& p1`2>=0 &
  LE p1,p2,rectangle(-1,1,-1,1) & LE p2,p3,rectangle(-1,1,-1,1)
  holds LE f.p2,f.p3,P;

theorem 
  for p being Point of TOP-REAL 2, f being Function of TOP-REAL 2,TOP-REAL 2 st
  f=Sq_Circ & p`1=-1 & p`2<0 holds (f.p)`1<0 & (f.p)`2<0;

theorem 
  for p being Point of TOP-REAL 2,
  P being non empty compact Subset of TOP-REAL 2,
  f being Function of TOP-REAL 2,TOP-REAL 2 st
  f=Sq_Circ
  holds (f.p)`1>=0 iff p`1>=0;

theorem 
  for p being Point of TOP-REAL 2,
  P being non empty compact Subset of TOP-REAL 2,
  f being Function of TOP-REAL 2,TOP-REAL 2 st
  f=Sq_Circ
  holds (f.p)`2>=0 iff p`2>=0;

theorem 
  for p,q being Point of TOP-REAL 2,
  f being Function of TOP-REAL 2,TOP-REAL 2 st f=Sq_Circ
  & p in LSeg(|[-1,-1]|,|[-1,1]|)
  & q in LSeg(|[1,-1]|,|[-1,-1]|) holds (f.p)`1<=(f.q)`1;

theorem 
  for p,q being Point of TOP-REAL 2,
  f being Function of TOP-REAL 2,TOP-REAL 2 st
  f=Sq_Circ & p in LSeg(|[-1,-1]|,|[-1,1]|) & q in LSeg(|[-1,-1]|,|[-1,1]|)
  & p`2>=q`2 & p`2<0 holds (f.p)`2>=(f.q)`2;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2,
  P being non empty compact Subset of TOP-REAL 2,
  f being Function of TOP-REAL 2,TOP-REAL 2 st P= circle(0,0,1) & f=Sq_Circ
  holds LE p1,p2,rectangle(-1,1,-1,1) & LE p2,p3,rectangle(-1,1,-1,1) &
  LE p3,p4,rectangle(-1,1,-1,1) implies
  f.p1,f.p2,f.p3,f.p4 are_in_this_order_on P;

theorem 
  for p1,p2 being Point of TOP-REAL 2,
  P being non empty compact Subset of TOP-REAL 2 st
  P is being_simple_closed_curve & p1 in P & p2 in P & not LE p1,p2,P
  holds LE p2,p1,P;

theorem 
  for p1,p2,p3 being Point of TOP-REAL 2,
  P being non empty compact Subset of TOP-REAL 2 st
  P is being_simple_closed_curve & p1 in P & p2 in P & p3 in P holds
  LE p1,p2,P & LE p2,p3,P or LE p1,p3,P & LE p3,p2,P or
  LE p2,p1,P & LE p1,p3,P or LE p2,p3,P & LE p3,p1,P or
  LE p3,p1,P & LE p1,p2,P or LE p3,p2,P & LE p2,p1,P;

theorem 
  for p1,p2,p3 being Point of TOP-REAL 2,
  P being non empty compact Subset of TOP-REAL 2 st
  P is being_simple_closed_curve & p1 in P & p2 in P & p3 in P & LE p2,p3,P
  holds
  LE p1,p2,P or LE p2,p1,P & LE p1,p3,P or LE p3,p1,P;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2,
  P being non empty compact Subset of TOP-REAL 2 st
  P is being_simple_closed_curve & p1 in P & p2 in P & p3 in P & p4 in P &
  LE p2,p3,P & LE p3,p4,P holds
  LE p1,p2,P or LE p2,p1,P & LE p1,p3,P or LE p3,p1,P & LE p1,p4,P or
  LE p4,p1,P;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2,
  P being non empty compact Subset of TOP-REAL 2,
  f being Function of TOP-REAL 2,TOP-REAL 2 st P= circle(0,0,1) & f=Sq_Circ &
  LE f.p1,f.p2,P & LE f.p2,f.p3,P & LE f.p3,f.p4,P
  holds p1,p2,p3,p4 are_in_this_order_on rectangle(-1,1,-1,1);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2,
  P being non empty compact Subset of TOP-REAL 2,
  f being Function of TOP-REAL 2,TOP-REAL 2 st P= circle(0,0,1) & f=Sq_Circ
  holds p1,p2,p3,p4 are_in_this_order_on rectangle(-1,1,-1,1)
  iff f.p1,f.p2,f.p3,f.p4 are_in_this_order_on P;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2
  st p1,p2,p3,p4 are_in_this_order_on rectangle(-1,1,-1,1)
  for f,g being Function of I[01],TOP-REAL 2 st
  f is continuous one-to-one & g is continuous one-to-one &
  f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 &
  rng f c= closed_inside_of_rectangle(-1,1,-1,1) &
  rng g c= closed_inside_of_rectangle(-1,1,-1,1)
  holds rng f meets rng g;














begin

theorem 
  for a,b,d being real number,p being Point of TOP-REAL 2 st a <b &
  p`2=d & a <=p`1 & p`1<=b holds p in LSeg(|[a,d]|,|[b,d]|);

theorem 
  for n being Element of NAT, P being Subset of TOP-REAL n, p1,p2
being Point of TOP-REAL n st P is_an_arc_of p1,p2 holds ex f being Function of
  I[01],TOP-REAL n st f is continuous one-to-one & rng f=P & f.0=p1 & f.1=p2;

theorem 
  for p1,p2 being Point of TOP-REAL 2, b,c,d being real number st
p1`1<b & p1`1=p2`1 & c <=p1`2 & p1`2<p2`2 & p2`2<=d holds LE p1,p2,rectangle(p1
  `1,b,c,d);

theorem 
  for p1,p2 being Point of TOP-REAL 2, b,c being real number st p1
  `1<b & c <p2`2 & c <=p1`2 & p1`2<=p2`2 & p1`1<=p2`1 & p2`1<=b holds LE p1,p2,
  rectangle(p1`1,b,c,p2`2);

theorem 
  for p1,p2 being Point of TOP-REAL 2, c,d being real number st p1
  `1<p2`1 & c <d & c <=p1`2 & p1`2<=d & c <=p2`2 & p2`2<=d holds LE p1,p2,
  rectangle(p1`1,p2`1,c,d);

theorem 
  for p1,p2 being Point of TOP-REAL 2, b,d being real number st p2
`2 <d & p2`2 <=p1`2 & p1`2<=d & p1`1<p2`1 & p2`1<=b holds LE p1,p2,rectangle(p1
  `1,b,p2`2,d);

theorem 
  for p1,p2 being Point of TOP-REAL 2, a,b,c,d being real number st
  a<b & c <d & p1`2=d & p2`2=d & a <=p1`1 & p1`1<p2`1 & p2`1<=b holds LE p1,p2,
  rectangle(a,b,c,d);

theorem 
  for p1,p2 being Point of TOP-REAL 2, a,b,c,d being real number st
a<b & c <d & p1`2=d & p2`1=b & a <=p1`1 & p1`1<=b & c <=p2`2 & p2`2<=d holds LE
  p1,p2,rectangle(a,b,c,d);

theorem 
  for p1,p2 being Point of TOP-REAL 2, a,b,c,d being real number st
a<b & c <d & p1`2=d & p2`2= c & a <=p1`1 & p1`1<=b & a<p2`1 & p2`1<=b holds LE
  p1,p2,rectangle(a,b,c,d);

theorem 
  for p1,p2 being Point of TOP-REAL 2, a,b,c,d being real number
st a<b & c <d & p1`1=b & p2`1=b & c <=p2`2 & p2`2<p1`2 & p1`2<=d holds LE p1,p2
  ,rectangle(a,b,c,d);

theorem 
  for p1,p2 being Point of TOP-REAL 2, a,b,c,d being real number
st a<b & c <d & p1`1=b & p2`2= c & c <=p1`2 & p1`2<=d & a<p2`1 & p2`1<=b holds
  LE p1,p2,rectangle(a,b,c,d);

theorem 
  for p1,p2 being Point of TOP-REAL 2, a,b,c,d being real number
st a<b & c <d & p1`2= c & p2`2= c & a <p2`1 & p2`1<p1`1 & p1`1<=b holds LE p1,
  p2,rectangle(a,b,c,d);

theorem 
  for p1,p2 being Point of TOP-REAL 2, a,b,c,d being real number
  st a<b & c <d & p1`2= d & p2`1= b & a <=p1`1 & p1`1<=b & c <=p2`2 & p2`2<=d
  holds LE p1,p2,rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & p1`1=a & p2`1=a & p3`1=a & p4`1=a & c <=p1`2 & p1`2<p2`2 & p2`2
<p3`2 & p3`2<p4`2 & p4`2<=d holds p1,p2,p3,p4 are_in_this_order_on rectangle(a,
  b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`1=a & p2`1=a & p3`1=a & p4`2=d & c <=p1`2 & p1`2<p2
  `2 & p2`2<p3`2 & p3`2<=d & a<= p4`1 & p4`1<=b holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`1=a & p2`1=a & p3`1=a & p4`1=b & c <=p1`2 & p1`2<p2
  `2 & p2`2<p3`2 & p3`2<=d & c <= p4`2 & p4`2<=d holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`1=a & p2`1=a & p3`1=a & p4`2= c & c <=p1`2 & p1`2<p2
  `2 & p2`2<p3`2 & p3`2<=d & a< p4`1 & p4`1<=b holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`1=a & p2`1=a & p3`2=d & p4`2= d & c <=p1`2 & p1`2<p2
  `2 & p2`2<=d & a<=p3`1 & p3`1< p4`1 & p4`1<=b holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`1=a & p2`1=a & p3`2=d & p4`1= b & c <=p1`2 & p1`2<p2
  `2 & p2`2<=d & a<=p3`1 & p3`1<=b & c <= p4`2 & p4`2<=d holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`1=a & p2`1=a & p3`2=d & p4`2= c & c <=p1`2 & p1`2<p2
  `2 & p2`2<=d & a<=p3`1 & p3`1<=b & a < p4`1 & p4`1<=b holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`1=a & p2`1=a & p3`1=b & p4`1= b & c <=p1`2 & p1`2<p2
  `2 & p2`2<=d & c <=p4`2 & p4`2< p3`2 & p3`2<=d holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`1=a & p2`1=a & p3`1=b & p4`2= c & c <=p1`2 & p1`2<p2
  `2 & p2`2<=d & c <=p3`2 & p3`2<=d & a < p4`1 & p4`1<=b holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`1=a & p2`1=a & p3`2= c & p4`2= c & c <=p1`2 & p1`2<
  p2`2 & p2`2<=d & a<p4`1 & p4`1< p3`1 & p3`1<=b holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`1=a & p2`2=d & p3`2= d & p4`2= d & c <=p1`2 & p1`2<=
  d & a<=p2`1 & p2`1<p3`1 & p3`1<p4`1 & p4`1<=b holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`1=a & p2`2=d & p3`2= d & p4`1= b & c <=p1`2 & p1`2<=
  d & a<=p2`1 & p2`1<p3`1 & p3`1<=b & c <=p4`2 & p4`2<=d holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`1=a & p2`2=d & p3`2= d & p4`2= c & c <=p1`2 & p1`2<=
  d & a<=p2`1 & p2`1<p3`1 & p3`1<=b & a <p4`1 & p4`1<=b holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`1=a & p2`2=d & p3`1= b & p4`1= b & c <=p1`2 & p1`2<=
  d & a<=p2`1 & p2`1<=b & c <=p4`2 & p4`2<p3`2 & p3`2<=d holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2 st p1`1 <> p3`1 & p4`2
<> p2`2 & p4`2 <=p1`2 & p1`2<=p2`2 & p1`1<=p2`1 & p2`1<=p3`1 & p4`2 <=p3`2 & p3
  `2<=p2`2 & p1`1 <p4`1 & p4`1<=p3`1 holds p1,p2,p3,p4 are_in_this_order_on
  rectangle(p1`1,p3`1,p4`2,p2`2);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`1=a & p2`2=d & p3`2= c & p4`2= c & c <=p1`2 & p1`2<=
  d & a<=p2`1 & p2`1<=b & a <p4`1 & p4`1<p3`1 & p3`1<=b holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`1=a & p2`1=b & p3`1= b & p4`1= b & c <=p1`2 & p1`2<=
  d & d >=p2`2 & p2`2>p3`2 & p3`2>p4`2 & p4`2>= c holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`1=a & p2`1=b & p3`1= b & p4`2= c & c <=p1`2 & p1`2<=
  d & d >=p2`2 & p2`2>p3`2 & p3`2>=c & a<p4`1 & p4`1<=b holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`1=a & p2`1=b & p3`2= c & p4`2= c & c <=p1`2 & p1`2<=
  d & c <=p2`2 & p2`2<=d & a<p4`1 & p4`1< p3`1 & p3`1<=b holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`1=a & p2`2= c & p3`2= c & p4`2= c & c <=p1`2 & p1`2
  <=d & a<p4`1 & p4`1< p3`1 & p3`1<p2`1 & p2`1<=b holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`2=d & p2`2=d & p3`2=d & p4`2=d & a <=p1`1 & p1`1<p2
  `1 & p2`1<p3`1 & p3`1<p4`1 & p4`1<=b holds p1,p2,p3,p4 are_in_this_order_on
  rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`2=d & p2`2=d & p3`2=d & p4`1=b & a <=p1`1 & p1`1<p2
  `1 & p2`1<p3`1 & p3`1<=b & c <=p4`2 & p4`2<=d holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`2=d & p2`2=d & p3`2=d & p4`2= c & a <=p1`1 & p1`1<p2
  `1 & p2`1<p3`1 & p3`1<=b & a< p4`1 & p4`1<=b holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`2=d & p2`2=d & p3`1=b & p4`1=b & a <=p1`1 & p1`1<p2
  `1 & p2`1<=b & c <=p4`2 & p4`2<p3`2 & p3`2<=d holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`2=d & p2`2=d & p3`1=b & p4`2= c & a <=p1`1 & p1`1<p2
  `1 & p2`1<=b & c <=p3`2 & p3`2<=d & a <p4`1 & p4`1<=b holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`2=d & p2`2=d & p3`2= c & p4`2= c & a <=p1`1 & p1`1<
  p2`1 & p2`1<=b & a <p4`1 & p4`1< p3`1 & p3`1<=b holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`2=d & p2`1=b & p3`1= b & p4`1= b & a <=p1`1 & p1`1<=
  b & d >=p2`2 & p2`2>p3`2 & p3`2>p4`2 & p4`2>= c holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`2=d & p2`1=b & p3`1=b & p4`2= c & a <=p1`1 & p1`1<=b
  & d>=p2`2 & p2`2>p3`2 & p3`2>= c & a <p4`1 & p4`1<=b holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`2=d & p2`1=b & p3`2= c & p4`2= c & a <=p1`1 & p1`1<=
  b & c <=p2`2 & p2`2<=d & a<p4`1 & p4`1<p3`1 & p3`1<=b holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`2=d & p2`2= c & p3`2= c & p4`2= c & a <=p1`1 & p1`1
  <=b & a<p4`1 & p4`1<p3`1 & p3`1<p2`1 & p2`1<=b holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`1=b & p2`1=b & p3`1=b & p4`1=b & d >=p1`2 & p1`2>p2
  `2 & p2`2>p3`2 & p3`2>p4`2 & p4`2>= c holds p1,p2,p3,p4 are_in_this_order_on
  rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`1=b & p2`1=b & p3`1=b & p4`2= c & d >=p1`2 & p1`2>p2
  `2 & p2`2>p3`2 & p3`2>= c & a<p4`1 & p4`1<=b holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`1=b & p2`1=b & p3`2= c & p4`2= c & d >=p1`2 & p1`2>
  p2`2 & p2`2>= c & b>=p3`1 & p3`1>p4`1 & p4`1>a holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`1=b & p2`2= c & p3`2= c & p4`2= c & c <=p1`2 & p1`2
  <=d & b>=p2`1 & p2`1>p3`1 & p3`1>p4`1 & p4`1> a holds p1,p2,p3,p4
  are_in_this_order_on rectangle(a,b,c,d);

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number st a<b & c < d & p1`2= c & p2`2= c & p3`2= c & p4`2= c & b >=p1`1 & p1`1
>p2`1 & p2`1>p3`1 & p3`1>p4`1 & p4`1> a holds p1,p2,p3,p4 are_in_this_order_on
  rectangle(a,b,c,d);

theorem 
  for A,B,C,D being real number, h,g being Function of TOP-REAL 2,
TOP-REAL 2 st A>0 & C>0 & h=AffineMap(A,B,C,D) & g=AffineMap(1/A,-B/A,1/C,-D/C)
  holds g=h" & h=g";

theorem 
  for A,B,C,D being real number, h being Function of TOP-REAL 2,
TOP-REAL 2 st A>0 & C >0 & h=AffineMap(A,B,C,D) holds h is being_homeomorphism
  & for p1,p2 being Point of TOP-REAL 2 st p1`1<p2`1 holds (h.p1)`1<(h.p2)`1;

theorem 
  for A,B,C,D being real number, h being Function of TOP-REAL 2,
TOP-REAL 2 st A>0 & C >0 & h=AffineMap(A,B,C,D) holds h is being_homeomorphism
  & for p1,p2 being Point of TOP-REAL 2 st p1`2<p2`2 holds (h.p1)`2<(h.p2)`2;

theorem 
  for a,b,c,d being real number, h being Function of TOP-REAL 2,
TOP-REAL 2,f being Function of I[01],TOP-REAL 2 st a<b & c <d & h=AffineMap(2/(
b-a),-(b+a)/(b-a),2/(d-c),-(d+c)/(d-c)) & rng f c= closed_inside_of_rectangle(a
  ,b,c,d) holds rng (h*f) c= closed_inside_of_rectangle(-1,1,-1,1);

theorem 
  for a,b,c,d being real number, h being Function of TOP-REAL 2,
TOP-REAL 2,f being Function of I[01],TOP-REAL 2 st a<b & c <d & h=AffineMap(2/(
b-a),-(b+a)/(b-a),2/(d-c),-(d+c)/(d-c)) & f is continuous one-to-one holds h*f
  is continuous one-to-one;

theorem 
  for a,b,c,d being real number, h being Function of TOP-REAL 2,
TOP-REAL 2,f being Function of I[01],TOP-REAL 2, O being Point of I[01] st a<b
& h=AffineMap(2/(b-a),-(b+a)/(b-a),2/(d-c),-(d+c)/(d-c)) & (f.O)`1=a holds ((h*
  f).O)`1= -1;

theorem 
  for a,b,c,d being real number, h being Function of TOP-REAL 2,
TOP-REAL 2,f being Function of I[01],TOP-REAL 2, I being Point of I[01] st c <d
& h=AffineMap(2/(b-a),-(b+a)/(b-a),2/(d-c),-(d+c)/(d-c)) & (f.I)`2=d holds ((h*
  f).I)`2= 1;

theorem 
  for a,b,c,d being real number, h being Function of TOP-REAL 2,
TOP-REAL 2,f being Function of I[01],TOP-REAL 2, I being Point of I[01] st a<b
& h=AffineMap(2/(b-a),-(b+a)/(b-a),2/(d-c),-(d+c)/(d-c)) & (f.I)`1=b holds ((h*
  f).I)`1= 1;

theorem 
  for a,b,c,d being real number, h being Function of TOP-REAL 2,
TOP-REAL 2,f being Function of I[01],TOP-REAL 2, I being Point of I[01] st c <d
& h=AffineMap(2/(b-a),-(b+a)/(b-a),2/(d-c),-(d+c)/(d-c)) & (f.I)`2= c holds ((h
  *f).I)`2= -1;

theorem 
  for a,b,c,d being real number, h being Function of TOP-REAL 2,
TOP-REAL 2,f being Function of I[01],TOP-REAL 2, O,I being Point of I[01] st c
<d & h=AffineMap(2/(b-a),-(b+a)/(b-a),2/(d-c),-(d+c)/(d-c)) & c <=(f.O)`2 & (f.
O)`2<(f.I)`2 & (f.I)`2<=d holds -1 <=((h*f).O)`2 & ((h*f).O)`2<((h*f).I)`2 & ((
  h*f).I)`2<=1;

theorem 
  for a,b,c,d being real number, h being Function of TOP-REAL 2,
TOP-REAL 2,f being Function of I[01],TOP-REAL 2, O,I being Point of I[01] st a<
b & c <d & h=AffineMap(2/(b-a),-(b+a)/(b-a),2/(d-c),-(d+c)/(d-c)) & c <=(f.O)`2
& (f.O)`2<=d & a<=(f.I)`1 & (f.I)`1<=b holds -1 <=((h*f).O)`2 & ((h*f).O)`2<=1
  & -1<=((h*f).I)`1 & ((h*f).I)`1<=1;

theorem 
  for a,b,c,d being real number, h being Function of TOP-REAL 2,
TOP-REAL 2,f being Function of I[01],TOP-REAL 2, O,I being Point of I[01] st c
<d & h=AffineMap(2/(b-a),-(b+a)/(b-a),2/(d-c),-(d+c)/(d-c)) & c <=(f.O)`2 & (f.
O)`2<=d & c <=(f.I)`2 & (f.I)`2<=d holds -1 <=((h*f).O)`2 & ((h*f).O)`2<=1 & -1
  <=((h*f).I)`2 & ((h*f).I)`2<=1;

theorem 
  for a,b,c,d being real number, h being Function of TOP-REAL 2,
TOP-REAL 2,f being Function of I[01],TOP-REAL 2, O,I being Point of I[01] st a<
b & c <d & h=AffineMap(2/(b-a),-(b+a)/(b-a),2/(d-c),-(d+c)/(d-c)) & c <=(f.O)`2
& (f.O)`2<=d & a<(f.I)`1 & (f.I)`1<=b holds -1 <=((h*f).O)`2 & ((h*f).O)`2<=1 &
  -1<((h*f).I)`1 & ((h*f).I)`1<=1;

theorem 
  for a,b,c,d being real number, h being Function of TOP-REAL 2,
TOP-REAL 2,f being Function of I[01],TOP-REAL 2, O,I being Point of I[01] st a<
b & h=AffineMap(2/(b-a),-(b+a)/(b-a),2/(d-c),-(d+c)/(d-c)) & a <=(f.O)`1 & (f.O
)`1<(f.I)`1 & (f.I)`1<=b holds -1 <=((h*f).O)`1 & ((h*f).O)`1<((h*f).I)`1 & ((h
  *f).I)`1<=1;

theorem 
  for a,b,c,d being real number, h being Function of TOP-REAL 2,
TOP-REAL 2,f being Function of I[01],TOP-REAL 2, O,I being Point of I[01] st a<
b & c <d & h=AffineMap(2/(b-a),-(b+a)/(b-a),2/(d-c),-(d+c)/(d-c)) & a <=(f.O)`1
& (f.O)`1<=b & c <=(f.I)`2 & (f.I)`2<=d holds -1 <=((h*f).O)`1 & ((h*f).O)`1<=1
  & -1<=((h*f).I)`2 & ((h*f).I)`2<=1;

theorem 
  for a,b,c,d being real number, h being Function of TOP-REAL 2,
TOP-REAL 2,f being Function of I[01],TOP-REAL 2, O,I being Point of I[01] st a<
b & h=AffineMap(2/(b-a),-(b+a)/(b-a),2/(d-c),-(d+c)/(d-c)) & a <=(f.O)`1 & (f.O
)`1<=b & a <(f.I)`1 & (f.I)`1<=b holds -1 <=((h*f).O)`1 & ((h*f).O)`1<=1 & -1<(
  (h*f).I)`1 & ((h*f).I)`1<=1;

theorem 
  for a,b,c,d being real number, h being Function of TOP-REAL 2,
TOP-REAL 2,f being Function of I[01],TOP-REAL 2, O,I being Point of I[01] st c
<d & h=AffineMap(2/(b-a),-(b+a)/(b-a),2/(d-c),-(d+c)/(d-c)) & d >=(f.O)`2 & (f.
O)`2>(f.I)`2 & (f.I)`2>= c holds 1 >=((h*f).O)`2 & ((h*f).O)`2>((h*f).I)`2 & ((
  h*f).I)`2>= -1;

theorem 
  for a,b,c,d being real number, h being Function of TOP-REAL 2,
TOP-REAL 2,f being Function of I[01],TOP-REAL 2, O,I being Point of I[01] st a<
b & c <d & h=AffineMap(2/(b-a),-(b+a)/(b-a),2/(d-c),-(d+c)/(d-c)) & c <=(f.O)`2
& (f.O)`2<=d & a <(f.I)`1 & (f.I)`1<=b holds -1 <=((h*f).O)`2 & ((h*f).O)`2<=1
  & -1<((h*f).I)`1 & ((h*f).I)`1<=1;

theorem 
  for a,b,c,d being real number, h being Function of TOP-REAL 2,
TOP-REAL 2,f being Function of I[01],TOP-REAL 2, O,I being Point of I[01] st a<
b & h=AffineMap(2/(b-a),-(b+a)/(b-a),2/(d-c),-(d+c)/(d-c)) & a <(f.I)`1 & (f.I)
`1 <(f.O)`1 & (f.O)`1<=b holds -1<((h*f).I)`1 & ((h*f).I)`1<((h*f).O)`1 & ((h*f
  ).O)`1<=1;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`1=a & p2`1=a
& p3`1=a & p4`1=a & c <=p1`2 & p1`2<p2`2 & p2`2<p3`2 & p3`2<p4`2 & p4`2<=d & f.
0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one & g is continuous
  one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) & rng g c=
  closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`1=a & p2`1=a & p3`1=a & p4`1
=a & c <=p1`2 & p1`2<p2`2 & p2`2<p3`2 & p3`2<p4`2 & p4`2<=d & P is_an_arc_of p1
  ,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a,b,c,d) & Q c=
  closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`1=a & p2`1=a
& p3`1=a & p4`2=d & c <=p1`2 & p1`2<p2`2 & p2`2<p3`2 & p3`2<=d & a<=p4`1 & p4`1
  <=b & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one & g is
continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) & rng g c=
  closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`1=a & p2`1=a & p3`1=a & p4`2
  =d & c <=p1`2 & p1`2<p2`2 & p2`2<p3`2 & p3`2<=d & a<=p4`1 & p4`1<=b & P
is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a,b
  ,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`1=a & p2`1=a
& p3`1=a & p4`1=b & c <=p1`2 & p1`2<p2`2 & p2`2<p3`2 & p3`2<=d & c <=p4`2 & p4
  `2<=d & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one & g is
continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) & rng g c=
  closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`1=a & p2`1=a & p3`1=a & p4`1
  =b & c <=p1`2 & p1`2<p2`2 & p2`2<p3`2 & p3`2<=d & c <=p4`2 & p4`2<=d & P
is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a,b
  ,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`1=a & p2`1=a
& p3`1=a & p4`2= c & c <=p1`2 & p1`2<p2`2 & p2`2<p3`2 & p3`2<=d & a<p4`1 & p4`1
  <=b & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one & g is
continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) & rng g c=
  closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`1=a & p2`1=a & p3`1=a & p4`2
  = c & c <=p1`2 & p1`2<p2`2 & p2`2<p3`2 & p3`2<=d & a<p4`1 & p4`1<=b & P
is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a,b
  ,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`1=a & p2`1=a
& p3`2=d & p4`2=d & c <=p1`2 & p1`2<p2`2 & p2`2<=d & a<=p3`1 & p3`1<p4`1 & p4`1
  <=b & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one & g is
continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) & rng g c=
  closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`1=a & p2`1=a & p3`2=d & p4`2
  =d & c <=p1`2 & p1`2<p2`2 & p2`2<=d & a<=p3`1 & p3`1<p4`1 & p4`1<=b & P
is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a,b
  ,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`1=a & p2`1=a
& p3`2=d & p4`1=b & c <=p1`2 & p1`2<p2`2 & p2`2<=d & a<=p3`1 & p3`1<=b & c <=p4
`2 & p4`2<=d & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one &
g is continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) & rng
  g c= closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`1=a & p2`1=a & p3`2=d & p4`1
=b & c <=p1`2 & p1`2<p2`2 & p2`2<=d & a<=p3`1 & p3`1<=b & c <=p4`2 & p4`2<=d &
P is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a
  ,b,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`1=a & p2`1=a
& p3`2=d & p4`2= c & c <=p1`2 & p1`2<p2`2 & p2`2<=d & a<=p3`1 & p3`1<=b & a <p4
`1 & p4`1<=b & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one &
g is continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) & rng
  g c= closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`1=a & p2`1=a & p3`2=d & p4`2
= c & c <=p1`2 & p1`2<p2`2 & p2`2<=d & a<=p3`1 & p3`1<=b & a <p4`1 & p4`1<=b &
P is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a
  ,b,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`1=a & p2`1=a
& p3`1=b & p4`1=b & c <=p1`2 & p1`2<p2`2 & p2`2<=d & c <=p4`2 & p4`2<p3`2 & p3
  `2<=d & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one & g is
continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) & rng g c=
  closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`1=a & p2`1=a & p3`1=b & p4`1
  =b & c <=p1`2 & p1`2<p2`2 & p2`2<=d & c <=p4`2 & p4`2<p3`2 & p3`2<=d & P
is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a,b
  ,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`1=a & p2`1=a
& p3`1=b & p4`2= c & c <=p1`2 & p1`2<p2`2 & p2`2<=d & c <=p3`2 & p3`2<=d & a <
p4`1 & p4`1<=b & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one
  & g is continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) &
  rng g c= closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`1=a & p2`1=a & p3`1=b & p4`2
= c & c <=p1`2 & p1`2<p2`2 & p2`2<=d & c <=p3`2 & p3`2<=d & a <p4`1 & p4`1<=b &
P is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a
  ,b,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`1=a & p2`1=a
& p3`2= c & p4`2= c & c <=p1`2 & p1`2<p2`2 & p2`2<=d & a<p4`1 & p4`1<p3`1 & p3
  `1<=b & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one & g is
continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) & rng g c=
  closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`1=a & p2`1=a & p3`2= c & p4
  `2= c & c <=p1`2 & p1`2<p2`2 & p2`2<=d & a<p4`1 & p4`1<p3`1 & p3`1<=b & P
is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a,b
  ,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`1=a & p2`2=d
& p3`2=d & p4`2=d & c <=p1`2 & p1`2<=d & a<=p2`1 & p2`1<p3`1 & p3`1<p4`1 & p4`1
  <=b & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one & g is
continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) & rng g c=
  closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`1=a & p2`2=d & p3`2=d & p4`2
  =d & c <=p1`2 & p1`2<=d & a<=p2`1 & p2`1<p3`1 & p3`1<p4`1 & p4`1<=b & P
is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a,b
  ,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`1=a & p2`2=d
& p3`2=d & p4`1=b & c <=p1`2 & p1`2<=d & a<=p2`1 & p2`1<p3`1 & p3`1<=b & c <=p4
`2 & p4`2<=d & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one &
g is continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) & rng
  g c= closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`1=a & p2`2=d & p3`2=d & p4`1
=b & c <=p1`2 & p1`2<=d & a<=p2`1 & p2`1<p3`1 & p3`1<=b & c <=p4`2 & p4`2<=d &
P is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a
  ,b,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`1=a & p2`2=d
& p3`2=d & p4`2= c & c <=p1`2 & p1`2<=d & a<=p2`1 & p2`1<p3`1 & p3`1<=b & a <p4
`1 & p4`1<=b & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one &
g is continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) & rng
  g c= closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`1=a & p2`2=d & p3`2=d & p4`2
= c & c <=p1`2 & p1`2<=d & a<=p2`1 & p2`1<p3`1 & p3`1<=b & a <p4`1 & p4`1<=b &
P is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a
  ,b,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`1=a & p2`2=d
& p3`1=b & p4`1= b & c <=p1`2 & p1`2<=d & a<=p2`1 & p2`1<=b & c <=p4`2 & p4`2<
p3`2 & p3`2<=d & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one
  & g is continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) &
  rng g c= closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`1=a & p2`2=d & p3`1=b & p4`1
= b & c <=p1`2 & p1`2<=d & a<=p2`1 & p2`1<=b & c <=p4`2 & p4`2<p3`2 & p3`2<=d &
P is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a
  ,b,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`1=a & p2`2=d
& p3`1=b & p4`2= c & c <=p1`2 & p1`2<=d & a<=p2`1 & p2`1<=b & c <=p3`2 & p3`2<=
  d & a <p4`1 & p4`1<=b & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous
one-to-one & g is continuous one-to-one & rng f c= closed_inside_of_rectangle(a
,b,c,d) & rng g c= closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`1=a & p2`2=d & p3`1=b & p4`2
  = c & c <=p1`2 & p1`2<=d & a<=p2`1 & p2`1<=b & c <=p3`2 & p3`2<=d & a <p4`1 &
  p4`1<=b & P is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c=
closed_inside_of_rectangle(a,b,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d)
  holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`1=a & p2`2=d
& p3`2= c & p4`2= c & c <=p1`2 & p1`2<=d & a<=p2`1 & p2`1<=b & a <p4`1 & p4`1<
p3`1 & p3`1<=b & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one
  & g is continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) &
  rng g c= closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`1=a & p2`2=d & p3`2= c & p4
`2= c & c <=p1`2 & p1`2<=d & a<=p2`1 & p2`1<=b & a <p4`1 & p4`1<p3`1 & p3`1<=b
& P is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle
  (a,b,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`1=a & p2`1=b
  & p3`1= b & p4`1= b & c <=p1`2 & p1`2<=d & c <=p4`2 & p4`2<p3`2 & p3`2<p2`2 &
p2`2<=d & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one & g is
continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) & rng g c=
  closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`1=a & p2`1=b & p3`1= b & p4
  `1= b & c <=p1`2 & p1`2<=d & c <=p4`2 & p4`2<p3`2 & p3`2<p2`2 & p2`2<=d & P
is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a,b
  ,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`1=a & p2`1=b
& p3`1= b & p4`2= c & c <=p1`2 & p1`2<=d & c <=p3`2 & p3`2<p2`2 & p2`2<=d & a<
p4`1 & p4`1<=b & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one
  & g is continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) &
  rng g c= closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`1=a & p2`1=b & p3`1= b & p4
`2= c & c <=p1`2 & p1`2<=d & c <=p3`2 & p3`2<p2`2 & p2`2<=d & a<p4`1 & p4`1<=b
& P is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle
  (a,b,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`1=a & p2`1=b
& p3`2= c & p4`2= c & c <=p1`2 & p1`2<=d & c <=p2`2 & p2`2<=d & a<p4`1 & p4`1<
p3`1 & p3`1<=b & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one
  & g is continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) &
  rng g c= closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`1=a & p2`1=b & p3`2= c & p4
`2= c & c <=p1`2 & p1`2<=d & c <=p2`2 & p2`2<=d & a<p4`1 & p4`1< p3`1 & p3`1<=b
& P is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle
  (a,b,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`1=a & p2`2=
c & p3`2= c & p4`2= c & c <=p1`2 & p1`2<=d & a<p4`1 & p4`1< p3`1 & p3`1<p2`1 &
p2`1<=b & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one & g is
continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) & rng g c=
  closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`1=a & p2`2= c & p3`2= c & p4
  `2= c & c <=p1`2 & p1`2<=d & a<p4`1 & p4`1< p3`1 & p3`1<p2`1 & p2`1<=b & P
is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a,b
  ,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`2=d & p2`2=d
& p3`2=d & p4`2=d & a <=p1`1 & p1`1<p2`1 & p2`1<p3`1 & p3`1<p4`1 & p4`1<=b & f.
0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one & g is continuous
  one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) & rng g c=
  closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`2=d & p2`2=d & p3`2=d & p4`2
=d & a <=p1`1 & p1`1<p2`1 & p2`1<p3`1 & p3`1<p4`1 & p4`1<=b & P is_an_arc_of p1
  ,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a,b,c,d) & Q c=
  closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`2=d & p2`2=d
& p3`2=d & p4`1=b & a <=p1`1 & p1`1<p2`1 & p2`1<p3`1 & p3`1<=b & c <=p4`2 & p4
  `2<=d & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one & g is
continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) & rng g c=
  closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`2=d & p2`2=d & p3`2=d & p4`1
  =b & a <=p1`1 & p1`1<p2`1 & p2`1<p3`1 & p3`1<=b & c <=p4`2 & p4`2<=d & P
is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a,b
  ,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`2=d & p2`2=d
& p3`2=d & p4`2= c & a <=p1`1 & p1`1<p2`1 & p2`1<p3`1 & p3`1<=b & a <p4`1 & p4
  `1<=b & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one & g is
continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) & rng g c=
  closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`2=d & p2`2=d & p3`2=d & p4`2
  = c & a <=p1`1 & p1`1<p2`1 & p2`1<p3`1 & p3`1<=b & a <p4`1 & p4`1<=b & P
is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a,b
  ,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`2=d & p2`2=d
& p3`1=b & p4`1=b & a <=p1`1 & p1`1<p2`1 & p2`1<=b & c <=p4`2 & p4`2<p3`2 & p3
  `2<=d & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one & g is
continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) & rng g c=
  closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`2=d & p2`2=d & p3`1=b & p4`1
  =b & a <=p1`1 & p1`1<p2`1 & p2`1<=b & c <=p4`2 & p4`2<p3`2 & p3`2<=d & P
is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a,b
  ,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`2=d & p2`2=d
& p3`1=b & p4`2= c & a <=p1`1 & p1`1<p2`1 & p2`1<=b & c <=p3`2 & p3`2<=d & a <
p4`1 & p4`1<=b & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one
  & g is continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) &
  rng g c= closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`2=d & p2`2=d & p3`1=b & p4`2
= c & a <=p1`1 & p1`1<p2`1 & p2`1<=b & c <=p3`2 & p3`2<=d & a <p4`1 & p4`1<=b &
P is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a
  ,b,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`2=d & p2`2=d
& p3`2= c & p4`2= c & a <=p1`1 & p1`1<p2`1 & p2`1<=b & a <p4`1 & p4`1<p3`1 & p3
  `1<=b & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one & g is
continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) & rng g c=
  closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`2=d & p2`2=d & p3`2= c & p4
  `2= c & a <=p1`1 & p1`1<p2`1 & p2`1<=b & a <p4`1 & p4`1<p3`1 & p3`1<=b & P
is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a,b
  ,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`2=d & p2`1=b
& p3`1=b & p4`1=b & a <=p1`1 & p1`1<=b & d >=p2`2 & p2`2>p3`2 & p3`2>p4`2 & p4
`2>= c & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one & g is
continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) & rng g c=
  closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`2=d & p2`1=b & p3`1=b & p4`1
  =b & a <=p1`1 & p1`1<=b & d >=p2`2 & p2`2>p3`2 & p3`2>p4`2 & p4`2>= c & P
is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a,b
  ,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`2=d & p2`1=b
& p3`1=b & p4`2= c & a <=p1`1 & p1`1<=b & d>=p2`2 & p2`2>p3`2 & p3`2>= c & a <
p4`1 & p4`1<=b & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one
  & g is continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) &
  rng g c= closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`2=d & p2`1=b & p3`1=b & p4`2
= c & a <=p1`1 & p1`1<=b & d>=p2`2 & p2`2>p3`2 & p3`2>= c & a <p4`1 & p4`1<=b &
P is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a
  ,b,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`2=d & p2`1=b
& p3`2= c & p4`2= c & a <=p1`1 & p1`1<=b & c <=p2`2 & p2`2<=d & a<p4`1 & p4`1<
p3`1 & p3`1<=b & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one
  & g is continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) &
  rng g c= closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`2=d & p2`1=b & p3`2= c & p4
`2= c & a <=p1`1 & p1`1<=b & c <=p2`2 & p2`2<=d & a<p4`1 & p4`1<p3`1 & p3`1<=b
& P is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle
  (a,b,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`2=d & p2`2=
  c & p3`2= c & p4`2= c & a <=p1`1 & p1`1<=b & a<p4`1 & p4`1<p3`1 & p3`1<p2`1 &
p2`1<=b & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one & g is
continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) & rng g c=
  closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`2=d & p2`2= c & p3`2= c & p4
  `2= c & a <=p1`1 & p1`1<=b & a<p4`1 & p4`1<p3`1 & p3`1<p2`1 & p2`1<=b & P
is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a,b
  ,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`1=b & p2`1=b
& p3`1=b & p4`1=b & d >=p1`2 & p1`2>p2`2 & p2`2>p3`2 & p3`2>p4`2 & p4`2>= c & f
.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one & g is continuous
  one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) & rng g c=
  closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`1=b & p2`1=b & p3`1=b & p4`1
  =b & d >=p1`2 & p1`2>p2`2 & p2`2>p3`2 & p3`2>p4`2 & p4`2>= c & P is_an_arc_of
p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a,b,c,d) & Q c=
  closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`1=b & p2`1=b
& p3`1=b & p4`2= c & d >=p1`2 & p1`2>p2`2 & p2`2>p3`2 & p3`2>= c & a<p4`1 & p4
  `1<=b & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one & g is
continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) & rng g c=
  closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`1=b & p2`1=b & p3`1=b & p4`2
  = c & d >=p1`2 & p1`2>p2`2 & p2`2>p3`2 & p3`2>= c & a<p4`1 & p4`1<=b & P
is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a,b
  ,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`1=b & p2`1=b
  & p3`2= c & p4`2= c & d >=p1`2 & p1`2>p2`2 & p2`2>= c & b>=p3`1 & p3`1>p4`1 &
p4`1>a & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one & g is
continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) & rng g c=
  closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`1=b & p2`1=b & p3`2= c & p4
  `2= c & d >=p1`2 & p1`2>p2`2 & p2`2>= c & b>=p3`1 & p3`1>p4`1 & p4`1>a & P
is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a,b
  ,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`1=b & p2`2=
c & p3`2= c & p4`2= c & c <=p1`2 & p1`2<=d & b>=p2`1 & p2`1>p3`1 & p3`1>p4`1 &
p4`1> a & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one & g is
continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) & rng g c=
  closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`1=b & p2`2= c & p3`2= c & p4
  `2= c & c <=p1`2 & p1`2<=d & b>=p2`1 & p2`1>p3`1 & p3`1>p4`1 & p4`1> a & P
is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a,b
  ,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real
number, f,g being Function of I[01],TOP-REAL 2 st a<b & c < d & p1`2= c & p2`2=
c & p3`2= c & p4`2= c & b >=p1`1 & p1`1>p2`1 & p2`1>p3`1 & p3`1>p4`1 & p4`1> a
  & f.0=p1 & f.1=p3 & g.0=p2 & g.1=p4 & f is continuous one-to-one & g is
continuous one-to-one & rng f c= closed_inside_of_rectangle(a,b,c,d) & rng g c=
  closed_inside_of_rectangle(a,b,c,d) holds rng f meets rng g;

theorem 
  for p1,p2,p3,p4 being Point of TOP-REAL 2, a,b,c,d being real number,
  P,Q being Subset of TOP-REAL 2 st a<b & c < d & p1`2= c & p2`2= c & p3`2= c &
  p4`2= c & b >=p1`1 & p1`1>p2`1 & p2`1>p3`1 & p3`1>p4`1 & p4`1> a & P
is_an_arc_of p1,p3 & Q is_an_arc_of p2,p4 & P c= closed_inside_of_rectangle(a,b
  ,c,d) & Q c= closed_inside_of_rectangle(a,b,c,d) holds P meets Q;














begin 

scheme 

  ExFunc3CondD { C() -> non empty set, P,Q,R[set], F,G,H(set) -> set }: ex f
being Function st dom f = C() & for c being Element of C() holds (P[c] implies
  f.c = F(c)) & (Q[c] implies f.c = G(c)) & (R[c] implies f.c = H(c))
provided
 for c being Element of C() holds (P[c] implies not Q[c]) & (P[c]
implies not R[c]) & (Q[c] implies not R[c]) and
 for c being Element of C() holds P[c] or Q[c] or R[c];

theorem 
  the carrier of [:I[01],I[01]:] = [:[.0,1.], [.0,1.]:];

theorem 
  for a, b, x being real number st a <= x & x <= b holds (x - a) /
  (b - a) in the carrier of Closed-Interval-TSpace (0,1);

theorem 
  for x being Point of I[01] st x <= 1/2 holds 2 * x is Point of I[01];

theorem 
  for x being Point of I[01] st x >= 1/2 holds 2 * x - 1 is Point of I[01];

theorem 
  for p, q being Point of I[01] holds p * q is Point of I[01];

theorem 
  for x being Point of I[01] holds 1/2 * x is Point of I[01];

theorem 
  for x being Point of I[01] st x >= 1/2 holds x - 1/4 is Point of I[01];

theorem 
  id I[01] is Path of 0[01], 1[01];

theorem 
  for a, b, c, d being Point of I[01] st a <= b & c <= d holds [:
  [.a,b.], [.c,d.]:] is compact non empty Subset of [:I[01], I[01]:];

begin 

theorem 
  for S, T being Subset of TOP-REAL 2 st S = {p where p is Point
of TOP-REAL 2 : p`2 <= 2 * p`1 - 1 } & T = {p where p is Point of TOP-REAL 2 :
  p`2 <= p`1 } holds AffineMap (1, 0, 1/2, 1/2) .: S = T;

theorem 
  for S, T being Subset of TOP-REAL 2 st S = {p where p is Point
of TOP-REAL 2 : p`2 >= 2 * p`1 - 1 } & T = {p where p is Point of TOP-REAL 2 :
  p`2 >= p`1 } holds AffineMap (1, 0, 1/2, 1/2) .: S = T;

theorem 
  for S, T being Subset of TOP-REAL 2 st S = {p where p is Point
of TOP-REAL 2 : p`2 >= 1 - 2 * p`1 } & T = {p where p is Point of TOP-REAL 2 :
  p`2 >= - p`1 } holds AffineMap (1, 0, 1/2, -1/2) .: S = T;

theorem 
  for S, T being Subset of TOP-REAL 2 st S = {p where p is Point
of TOP-REAL 2 : p`2 <= 1 - 2 * p`1 } & T = {p where p is Point of TOP-REAL 2 :
  p`2 <= - p`1 } holds AffineMap (1, 0, 1/2, -1/2) .: S = T;

begin 

theorem 
  for T being non empty 1-sorted holds T is real-membered iff for
  x being Element of T holds x is real;

registration
  cluster non empty real-membered for 1-sorted;
  cluster non empty real-membered for TopSpace;
end;

registration
  let T be real-membered 1-sorted;
  cluster -> real for Element of T;
end;

registration
  let T be real-membered TopStruct;
  cluster -> real-membered for SubSpace of T;
end;

registration
  let S, T be real-membered non empty TopSpace, p be Element of [:S, T:];
  cluster p`1 -> real;
  cluster p`2 -> real;
end;

registration
  let T be non empty SubSpace of [:I[01], I[01]:], x be Point of T;
  cluster x`1 -> real;
  cluster x`2 -> real;
end;

begin 

theorem 
  {p where p is Point of TOP-REAL 2 : p`2 <= 2 * p`1 - 1 } is
  closed Subset of TOP-REAL 2;

theorem 
  {p where p is Point of TOP-REAL 2 : p`2 >= 2 * p`1 - 1 } is
  closed Subset of TOP-REAL 2;

theorem 
  {p where p is Point of TOP-REAL 2 : p`2 <= 1 - 2 * p`1 } is
  closed Subset of TOP-REAL 2;

theorem 
  {p where p is Point of TOP-REAL 2 : p`2 >= 1 - 2 * p`1 } is
  closed Subset of TOP-REAL 2;

theorem 
  {p where p is Point of TOP-REAL 2 : p`2 >= 1 - 2 * p`1 & p`2 >=
  2 * p`1 - 1 } is closed Subset of TOP-REAL 2;

theorem 
  ex f being Function of [:R^1,R^1:], TOP-REAL 2 st for x, y being
  Real holds f. [x,y] = <*x,y*>;

theorem 
  { p where p is Point of [:R^1,R^1:] : p`2 <= 1 - 2 * (p`1) } is
  closed Subset of [:R^1,R^1:];

theorem 
  { p where p is Point of [:R^1,R^1:] : p`2 <= 2 * (p`1) - 1 } is
  closed Subset of [:R^1,R^1:];

theorem 
  { p where p is Point of [:R^1,R^1:] : p`2 >= 1 - 2 * (p`1) & p`2
  >= 2 * (p`1) - 1 } is closed Subset of [:R^1,R^1:];

theorem 
  { p where p is Point of [:I[01],I[01]:] : p`2 <= 1 - 2 * (p`1) }
  is closed non empty Subset of [:I[01],I[01]:];

theorem 
  { p where p is Point of [:I[01],I[01]:] : p`2 >= 1 - 2 * (p`1) &
  p`2 >= 2 * (p`1) - 1 } is closed non empty Subset of [:I[01],I[01]:];

theorem 
  { p where p is Point of [:I[01],I[01]:] : p`2 <= 2 * (p`1) - 1 }
  is closed non empty Subset of [:I[01],I[01]:];

theorem 
  for S, T being non empty TopSpace, p being Point of [:S, T:]
  holds p`1 is Point of S & p`2 is Point of T;

theorem 
  for A, B being Subset of [:I[01],I[01]:] st A = [:[.0,1/2.], [.0
,1.]:] & B = [:[.1/2,1.], [.0,1.]:] holds [#] ([:I[01],I[01]:] | A) \/ [#] ([:
  I[01],I[01]:] | B) = [#] [:I[01],I[01]:];

theorem 
  for A, B being Subset of [:I[01],I[01]:] st A = [:[.0,1/2.], [.0
,1.]:] & B = [:[.1/2,1.], [.0,1.]:] holds [#] ([:I[01],I[01]:] | A) /\ [#] ([:
  I[01],I[01]:] | B) = [:{1/2}, [.0,1.] :];

begin 

registration
  let T be TopStruct;
  cluster empty compact for Subset of T;
end;

theorem 
  for T being TopStruct holds {} is empty compact Subset of T;

theorem 
  for T being TopStruct, a, b being real number st a > b holds [.a
  ,b.] is empty compact Subset of T;

theorem 
  for a, b, c, d being Point of I[01] holds [:[.a,b.], [.c,d.]:] is
  compact Subset of [:I[01], I[01]:];

begin 

definition
  let a, b, c, d be real number;

  func L[01](a,b,c,d) -> Function of Closed-Interval-TSpace(a,b),
  Closed-Interval-TSpace(c,d) equals

  L[01]((#)(c,d),(c,d)(#)) * P[01](a,b,(#)(0,1
  ),(0,1)(#));
end;

theorem 
  for a, b, c, d being real number st a < b & c < d holds L[01](a,
  b,c,d).a = c & L[01](a,b,c,d).b = d;

theorem 
  for a, b, c, d being real number st a < b & c <= d holds L[01](a
  ,b,c,d) is continuous Function of Closed-Interval-TSpace(a,b),
  Closed-Interval-TSpace(c,d);

theorem 
  for a, b, c, d being real number st a < b & c <= d for x being
real number st a <= x & x <= b holds L[01](a,b,c,d).x = ((d - c)/(b - a)) * (x
  - a) + c;

theorem 
  for f1,f2 being Function of [:I[01],I[01]:],I[01] st f1 is
continuous & f2 is continuous & (for p being Point of [:I[01],I[01]:] holds f1.
p * f2.p is Point of I[01]) holds ex g being Function of [:I[01],I[01]:],I[01]
  st (for p being Point of [:I[01],I[01]:],r1,r2 being real number st f1.p=r1 &
  f2.p=r2 holds g.p=r1*r2) & g is continuous;

theorem 
  for f1,f2 being Function of [:I[01],I[01]:],I[01] st f1 is
continuous & f2 is continuous & (for p being Point of [:I[01],I[01]:] holds f1.
p + f2.p is Point of I[01]) holds ex g being Function of [:I[01],I[01]:],I[01]
  st (for p being Point of [:I[01],I[01]:],r1,r2 being real number st f1.p=r1 &
  f2.p=r2 holds g.p=r1+r2) & g is continuous;

theorem 
  for f1,f2 being Function of [:I[01],I[01]:],I[01] st f1 is continuous
& f2 is continuous & (for p being Point of [:I[01],I[01]:] holds f1.p - f2.p is
  Point of I[01]) holds ex g being Function of [:I[01],I[01]:],I[01] st (for p
  being Point of [:I[01],I[01]:],r1,r2 being real number st f1.p=r1 & f2.p=r2
  holds g.p=r1-r2) & g is continuous;

begin 

reserve T for non empty TopSpace,
  a, b, c, d for Point of T;

theorem 
  for P being Path of a,b st P is continuous holds P * L[01]((0,1)
  (#),(#)(0,1)) is continuous Function of I[01], T;

theorem 
  for X being non empty TopStruct, a, b being Point of X, P being
Path of a,b st P.0 = a & P.1 = b holds (P * L[01]((0,1)(#),(#)(0,1))).0 = b & (
  P * L[01]((0,1)(#),(#)(0,1))).1 = a;

theorem 
  for P being Path of a,b st P is continuous & P.0 = a & P.1 = b
  holds -P is continuous & (-P).0 = b & (-P).1 = a;

definition
  let T be non empty TopSpace, a,b be Point of T;
  redefine pred a,b are_connected;
  reflexivity;
  symmetry;
end;

theorem 
  a,b are_connected & b,c are_connected implies a,c are_connected;

theorem 
  a,b are_connected implies for A being Path of a,b holds A = --A;

theorem 
  for T being non empty pathwise_connected TopSpace, a, b being Point of
  T for A being Path of a,b holds A = --A;

begin 

definition
  let T be non empty pathwise_connected TopSpace;
  let a, b, c be Point of T;
  let P be Path of a, b, Q be Path of b, c;

  redefine func P + Q means

  for t being Point of I[01] holds ( t <= 1/2 implies it.t =
  P.(2*t) ) & ( 1/2 <= t implies it.t = Q.(2*t-1) );
end;

definition
  let T be non empty pathwise_connected TopSpace;
  let a, b be Point of T;
  let P be Path of a, b;
  redefine func - P means


  for t being Point of I[01] holds it.t = P.(1-t);
end;

begin 

definition
  let T be non empty TopSpace, a, b be Point of T;
  let P be Path of a, b;
  let f be continuous Function of I[01], I[01];
  assume that
 f.0 = 0 and
 f.1 = 1 and
 a, b are_connected;
  func RePar (P, f) -> Path of a, b equals


  P * f;
end;

theorem 
  for P being Path of a, b, f being continuous Function of I[01],
  I[01] st f.0 = 0 & f.1 = 1 & a, b are_connected holds RePar (P, f), P
  are_homotopic;

theorem 
  for T being non empty pathwise_connected TopSpace, a, b be Point of T,
P being Path of a, b, f being continuous Function of I[01], I[01] st f.0 = 0 &
  f.1 = 1 holds RePar (P, f), P are_homotopic;

definition
  func 1RP -> Function of I[01], I[01] means


  for t being Point of I[01]
  holds (t <= 1/2 implies it.t = 2 * t) & (t > 1/2 implies it.t = 1);
end;

registration
  cluster 1RP -> continuous;
end;

theorem 
  1RP.0 = 0 & 1RP.1 = 1;

definition
  func 2RP -> Function of I[01], I[01] means


  for t being Point of I[01]
  holds (t <= 1/2 implies it.t = 0) & (t > 1/2 implies it.t = 2 * t - 1);
end;

registration
  cluster 2RP -> continuous;
end;

theorem 
  2RP.0 = 0 & 2RP.1 = 1;

definition
  func 3RP -> Function of I[01], I[01] means


  for x being Point of I[01]
holds (x <= 1/2 implies it.x = 1/2 * x) & (x > 1/2 & x <= 3/4 implies it.x = x
  - 1/4) & (x > 3/4 implies it.x = 2 * x - 1);
end;

registration
  cluster 3RP -> continuous;
end;

theorem 
  3RP.0 = 0 & 3RP.1 = 1;

theorem 
  for P being Path of a, b, Q being constant Path of b, b st a,b
  are_connected holds RePar (P, 1RP) = P + Q;

theorem 
  for P being Path of a, b, Q being constant Path of a, a st a,b
  are_connected holds RePar (P, 2RP) = Q + P;

theorem 
  for P being Path of a, b, Q being Path of b, c, R being Path of
c, d st a,b are_connected & b,c are_connected & c,d are_connected holds RePar (
  P + Q + R, 3RP) = P + (Q + R);

begin 

definition
  func LowerLeftUnitTriangle -> Subset of [:I[01], I[01]:] means


  for x
being set holds x in it iff ex a, b being Point of I[01] st x = [a,b] & b <= 1
  - 2 * a;
end;

notation
  synonym IAA for LowerLeftUnitTriangle;
end;

definition
  func UpperUnitTriangle -> Subset of [:I[01], I[01]:] means


  for x
being set holds x in it iff ex a, b being Point of I[01] st x = [a,b] & b >= 1
  - 2 * a & b >= 2 * a - 1;
end;

notation
  synonym IBB for UpperUnitTriangle;
end;

definition
  func LowerRightUnitTriangle -> Subset of [:I[01], I[01]:] means


  for
x being set holds x in it iff ex a, b being Point of I[01] st x = [a,b] & b <=
  2 * a - 1;
end;

notation
  synonym ICC for LowerRightUnitTriangle;
end;

theorem 
  IAA = { p where p is Point of [:I[01], I[01]:] : p`2 <= 1 - 2 * (p`1) };

theorem 
  IBB = { p where p is Point of [:I[01], I[01]:] : p`2 >= 1 - 2 *
  (p`1) & p`2 >= 2 * (p`1) - 1 };

theorem 
  ICC = { p where p is Point of [:I[01], I[01]:] : p`2 <= 2 * (p`1 ) - 1 };

registration
  cluster IAA -> closed non empty;
  cluster IBB -> closed non empty;
  cluster ICC -> closed non empty;
end;

theorem 
  IAA \/ IBB \/ ICC = [:[.0,1.], [.0,1.]:];

theorem 
  IAA /\ IBB = { p where p is Point of [:I[01], I[01]:] : p`2 = 1 - 2 * (p`1) }
;

theorem 
  ICC /\ IBB = { p where p is Point of [:I[01], I[01]:] : p`2 = 2 * (p`1) - 1 }
;

theorem 
  for x being Point of [:I[01], I[01]:] st x in IAA holds x`1 <= 1 /2;

theorem 
  for x being Point of [:I[01], I[01]:] st x in ICC holds x`1 >= 1 /2;

theorem 
  for x being Point of I[01] holds [0,x] in IAA;

theorem 
  for s being set holds [0,s] in IBB implies s = 1;

theorem 
  for s being set holds [s,1] in ICC implies s = 1;

theorem 
  [0,1] in IBB;

theorem 
  for x being Point of I[01] holds [x,1] in IBB;

theorem 
  [1/2,0] in ICC & [1,1] in ICC;

theorem 
  [1/2,0] in IBB;

theorem 
  for x being Point of I[01] holds [1,x] in ICC;

theorem 
  for x being Point of I[01] st x >= 1/2 holds [x,0] in ICC;

theorem 
  for x being Point of I[01] st x <= 1/2 holds [x,0] in IAA;

theorem 
  for x being Point of I[01] st x < 1/2 holds not [x,0] in IBB &
  not [x,0] in ICC;

theorem 
  IAA /\ ICC = { [1/2,0] };

begin 

reserve X for non empty pathwise_connected TopSpace,
  a1, b1, c1, d1 for Point of X;

theorem 
  for P be Path of a, b, Q be Path of b, c, R be Path of c, d st a
,b are_connected & b,c are_connected & c,d are_connected holds (P + Q) + R, P +
  (Q + R) are_homotopic;

theorem 
  for P be Path of a1, b1, Q be Path of b1, c1, R be Path of c1, d1
  holds (P + Q) + R, P + (Q + R) are_homotopic;

theorem 
  for P1, P2 being Path of a, b, Q1, Q2 being Path of b, c st a, b
  are_connected & b, c are_connected & P1, P2 are_homotopic & Q1, Q2
  are_homotopic holds P1 + Q1, P2 + Q2 are_homotopic;

theorem 
  for P1, P2 being Path of a1, b1, Q1, Q2 being Path of b1, c1 st P1, P2
  are_homotopic & Q1, Q2 are_homotopic holds P1 + Q1, P2 + Q2 are_homotopic;

theorem 
  for P, Q being Path of a, b st a, b are_connected & P, Q
  are_homotopic holds -P, -Q are_homotopic;

theorem 
  for P, Q being Path of a1, b1 st P, Q are_homotopic holds -P, -Q
  are_homotopic;

theorem 
  for P, Q, R be Path of a, b holds P, Q are_homotopic & Q, R
  are_homotopic implies P, R are_homotopic;

theorem 
  for P be Path of a, b, Q be constant Path of b, b st a, b
  are_connected holds P + Q, P are_homotopic;

theorem 
  for P be Path of a1, b1, Q be constant Path of b1, b1 holds P + Q, P
  are_homotopic;

theorem 
  for P be Path of a, b, Q be constant Path of a, a st a, b
  are_connected holds Q + P, P are_homotopic;

theorem 
  for P be Path of a1, b1, Q be constant Path of a1, a1 holds Q + P, P
  are_homotopic;

theorem 
  for P being Path of a, b, Q being constant Path of a, a st a, b
  are_connected holds P + - P, Q are_homotopic;

theorem 
  for P being Path of a1, b1, Q being constant Path of a1, a1 holds P +
  - P, Q are_homotopic;

theorem 
  for P being Path of b, a, Q being constant Path of a, a st b, a
  are_connected holds - P + P, Q are_homotopic;

theorem 
  for P being Path of b1, a1, Q being constant Path of a1, a1 holds - P
  + P, Q are_homotopic;

theorem 
  for P, Q be constant Path of a, a holds P, Q are_homotopic;

definition
  let T be non empty TopSpace;
  let a, b be Point of T;
  let P, Q be Path of a, b;
  assume
 P, Q are_homotopic;
  mode Homotopy of P, Q -> Function of [:I[01],I[01]:], T means

    it is
continuous & for t being Point of I[01] holds it.(t,0) = P.t & it.(t,1) = Q.t &
    it.(0,t) = a & it.(1,t) = b;
end;














begin

theorem 
  for T being non empty normal TopSpace, A,B being closed Subset of
  T st A <> {} & A misses B holds for n being Element of NAT holds ex G being
Function of dyadic(n),bool the carrier of T st A c= G.0 & B = [#]T \ G.1 & for
r1,r2 being Element of dyadic(n) st r1 < r2 holds G.r1 is open & G.r2 is open &
  Cl(G.r1) c= G.r2;

definition
  let T be non empty TopSpace;
  let A,B be Subset of T;
  let n be Element of NAT;
  assume
 T is normal & A <> {} & A is closed & B is closed & A misses B;
  mode Drizzle of A,B,n -> Function of dyadic(n),bool the carrier of T means


     A
 c= it.0 & B = [#]T \ it.1 & for r1,r2 being Element of dyadic(n) st r1
    < r2 holds it.r1 is open & it.r2 is open & Cl(it.r1) c= it.r2;
end;

theorem 
  for T being non empty normal TopSpace, A,B being closed Subset of
T st A <> {} & A misses B holds for n being Element of NAT, G being Drizzle of
A,B,n holds ex F being Drizzle of A,B,n+1 st for r being Element of dyadic(n+1)
  st r in dyadic(n) holds F.r = G.r;

theorem 
  for T being non empty TopSpace, A,B being Subset of T, n being
  Element of NAT, S being Drizzle of A,B,n holds S is Element of PFuncs(DYADIC,
  bool the carrier of T);

definition
  let A,B be non empty set;
  let F be Function of NAT,PFuncs(A,B);
  let n be Element of NAT;
  redefine func F.n -> Element of PFuncs(A,B);
end;

theorem 
  for T being non empty normal TopSpace, A,B being closed Subset of
  T st A <> {} & A misses B holds ex F being Functional_Sequence of DYADIC,bool
the carrier of T st for n being Element of NAT holds F.n is Drizzle of A,B,n &
  for r being Element of dom (F.n) holds (F.n).r = (F.(n+1)).r;

definition
  let T be non empty TopSpace;
  let A,B be Subset of T;
  assume
 T is normal & A <> {} & A is closed & B is closed & A misses B;
  mode Rain of A,B -> Functional_Sequence of DYADIC,bool the carrier of T
    means


    for n being Element of NAT holds it.n is Drizzle of A,B,n & for r
    being Element of dom (it.n) holds (it.n).r = (it.(n+1)).r;
end;

definition
  let x be Real;
  assume
 x in DYADIC;
  func inf_number_dyadic(x) -> Element of NAT means


  (x in dyadic(0) iff
  it = 0) & for n being Element of NAT st x in dyadic(n+1) & not x in dyadic(n)
  holds it = n+1;
end;

theorem 
  for x being Real st x in DYADIC holds x in dyadic( inf_number_dyadic(x));

theorem 
  for x being Real st x in DYADIC holds for n being Element of NAT
  st inf_number_dyadic(x) <= n holds x in dyadic(n);

theorem 
  for x being Real, n being Element of NAT st x in dyadic(n) holds
  inf_number_dyadic(x) <= n;

theorem 
  for T being non empty normal TopSpace, A,B being closed Subset of
  T st A <> {} & A misses B holds for G being Rain of A,B, x being Real st x in
DYADIC holds for n being Element of NAT holds (G.inf_number_dyadic(x)).x = (G.(
  inf_number_dyadic(x) + n)).x;

theorem 
  for T being non empty normal TopSpace, A,B being closed Subset
  of T st A <> {} & A misses B holds for G being Rain of A,B, x being Real st x
  in DYADIC holds ex y being Subset of T st for n being Element of NAT st x in
  dyadic(n) holds y = (G.n).x;

theorem 
  for T being non empty normal TopSpace, A,B being closed Subset
  of T st A <> {} & A misses B holds for G being Rain of A,B holds ex F being
Function of DOM,bool the carrier of T st for x being Real st x in DOM holds (x
in halfline 0 implies F.x = {}) & (x in right_open_halfline 1 implies F.x = the
carrier of T) & (x in DYADIC implies for n being Element of NAT st x in dyadic(
  n) holds F.x = (G.n).x );

definition
  let T be non empty TopSpace;
  let A,B be Subset of T;
  assume
 T is normal & A <> {} & A is closed & B is closed & A misses B;
  let R be Rain of A,B;
  func Tempest(R) -> Function of DOM,bool the carrier of T means


  for x
  being Real st x in DOM holds (x in halfline 0 implies it.x = {}) & (x in
  right_open_halfline 1 implies it.x = the carrier of T) & (x in DYADIC implies
  for n being Element of NAT st x in dyadic(n) holds it.x = (R.n).x );
end;

definition
  let X be non empty set;
  let T be TopSpace;
  let F be Function of X,bool the carrier of T;
  let x be Element of X;
  redefine func F.x -> Subset of T;
end;

theorem 
  for T being non empty normal TopSpace, A,B being closed Subset
  of T st A <> {} & A misses B holds for G being Rain of A,B, r being Real, C
  being Subset of T st C = (Tempest G).r & r in DOM holds C is open;

theorem 
  for T being non empty normal TopSpace, A,B being closed Subset
  of T st A <> {} & A misses B holds for G being Rain of A,B holds for r1,r2
being Real st r1 in DOM & r2 in DOM & r1 < r2 holds for C being Subset of T st
  C = (Tempest G).r1 holds Cl C c= (Tempest G).r2;

definition
  let T be non empty TopSpace, A,B be Subset of T, G be Rain of A,B, p be
  Point of T;
  func Rainbow(p,G) -> Subset of ExtREAL means


  for x being set holds x
in it iff (x in DYADIC & for s being Real st s = x holds not p in (Tempest G).s
  );
end;

theorem 
  for T being non empty TopSpace, A,B being Subset of T, G being
  Rain of A,B, p being Point of T holds Rainbow(p,G) c= DYADIC;

definition
  let T be non empty TopSpace;
  let A,B be Subset of T;
  let R be Rain of A,B;
  func Thunder(R) -> Function of T,R^1 means


  for p being Point of T
  holds (Rainbow(p,R) = {} implies it.p = 0) & for S being non empty Subset of
  ExtREAL st S = Rainbow(p,R) holds it.p = sup S;
end;

theorem 
  for T being non empty TopSpace, A,B being Subset of T, G being
  Rain of A,B, p being Point of T, S being non empty Subset of ExtREAL st S =
Rainbow(p,G) holds for e1 being R_eal st e1 = 1 holds 0. <= sup S & sup S <= e1
;

theorem 
  for T being non empty normal TopSpace, A,B being closed Subset
of T st A <> {} & A misses B holds for G being Rain of A,B, r being Element of
  DOM, p being Point of T st (Thunder G).p < r holds p in (Tempest G).r;

theorem 
  for T being non empty normal TopSpace, A,B being closed Subset
  of T st A <> {} & A misses B holds for G being Rain of A,B holds for r being
Real st r in DYADIC \/ (right_open_halfline 1) & 0 < r holds for p being Point
  of T holds p in (Tempest G).r implies (Thunder G).p <= r;

theorem 
  for T being non empty normal TopSpace, A,B being closed Subset
of T st A <> {} & A misses B holds for G being Rain of A,B, r1 being Element of
DOM st 0 < r1 holds for p being Point of T st r1 < (Thunder G).p holds not p in
  (Tempest G).r1;

theorem 
  for T being non empty normal TopSpace, A,B being closed Subset
  of T st A <> {} & A misses B holds for G being Rain of A,B holds Thunder G is
continuous & for x being Point of T holds 0 <= (Thunder G).x & (Thunder G).x <=
  1 & (x in A implies (Thunder G).x = 0) & (x in B implies (Thunder G).x = 1);

theorem 
  for T being non empty normal TopSpace, A,B being closed Subset
  of T st A <> {} & A misses B holds ex F being Function of T,R^1 st F is
continuous & for x being Point of T holds 0 <= F.x & F.x <= 1 & (x in A implies
  F.x = 0) & (x in B implies F.x = 1);


theorem 
  for T being non empty normal TopSpace, A,B being closed Subset
of T st A misses B holds ex F being Function of T,R^1 st F is continuous & for
x being Point of T holds 0 <= F.x & F.x <= 1 & (x in A implies F.x = 0) & (x in
  B implies F.x = 1);

theorem 
  for T being non empty T_2 compact TopSpace, A,B being closed Subset of
  T st A misses B ex F being Function of T,R^1 st F is continuous & for x being
  Point of T holds 0 <= F.x & F.x <= 1 & (x in A implies F.x = 0) & (x in B
  implies F.x = 1);




















begin 

reserve p, q, x, y for real number,
  n for Nat;

theorem 
  for G, H being set, g being Function of G,H, h being Function of H,G
   st h * g = id G & g * h = id H holds h is bijective;

theorem 
  for X being Subset of I[01], a being Point of I[01] st X = ]. a, 1 .]
  holds X` = [. 0, a .];

theorem 
  for X being Subset of I[01], a being Point of I[01] st X = [. 0, a .[
  holds X` = [. a, 1 .];

theorem 
  for X being Subset of I[01], a being Point of I[01] st X = ]. a, 1 .]
  holds X is open;

theorem 
  for X being Subset of I[01], a being Point of I[01] st X = [. 0, a .[
  holds X is open;

theorem 
  for f being real-valued FinSequence holds x * (-f) = - (x*f);

theorem 
  for f, g being real-valued FinSequence holds x * (f-g) = x*f - x*g;

theorem 
  for f being real-valued FinSequence holds (x-y) * f = x*f - y*f;

theorem 
  for f, g, h, k being real-valued FinSequence holds (f+g)-(h+k) = (f-h)+(g-k);

theorem 
  for f being Element of REAL n st 0 <= x & x <= 1 holds |.x*f.| <= |.f.|;

theorem 
  for f being Element of REAL n, p being Point of I[01] holds |.p*f.| <= |.f.|;

theorem 
  for e1, e2, e3, e4, e5, e6 being Point of Euclid n, p1, p2, p3, p4
being Point of TOP-REAL n st e1 = p1 & e2 = p2 & e3 = p3 & e4 = p4 & e5 = p1+p3
  & e6 = p2+p4 & dist(e1,e2) < x & dist(e3,e4) < y holds dist(e5,e6) < x+y;

theorem 
  for e1, e2, e5, e6 being Point of Euclid n, p1, p2 being Point
of TOP-REAL n st e1 = p1 & e2 = p2 & e5 = y*p1 & e6 = y*p2 & dist(e1,e2) < x &
  y <> 0 holds dist(e5,e6) < abs(y)*x;

theorem 
  for e1, e2, e3, e4, e5, e6 being Point of Euclid n, p1, p2, p3,
p4 being Point of TOP-REAL n st e1 = p1 & e2 = p2 & e3 = p3 & e4 = p4 & e5 = x*
p1+y*p3 & e6 = x*p2+y*p4 & dist(e1,e2) < p & dist(e3,e4) < q & x <> 0 & y <> 0
  holds dist(e5,e6) < abs(x)*p + abs(y)*q;

theorem 
  for X being non empty TopSpace, f, g being Function of X,
  TOP-REAL n st f is continuous & for p being Point of X holds g.p = y * f.p
  holds g is continuous;

theorem 
  for X being non empty TopSpace, f1, f2, g being Function of X,TOP-REAL
n st f1 is continuous & f2 is continuous & for p being Point of X holds g.p = x
  * f1.p + y * f2.p holds g is continuous;

theorem 
  for F being Function of [:TOP-REAL n,I[01]:], TOP-REAL n st for
  x being Point of TOP-REAL n, i being Point of I[01] holds F.(x,i) = (1-i) * x
  holds F is continuous;

theorem 
  for F being Function of [:TOP-REAL n,I[01]:], TOP-REAL n st for
x being Point of TOP-REAL n, i being Point of I[01] holds F.(x,i) = i * x holds
  F is continuous;

begin 

reserve X for non empty TopSpace,
  a, b, c, d, e, f for Point of X,
  T for non empty pathwise_connected TopSpace,
  a1, b1, c1, d1, e1, f1 for Point of T;

theorem 
  a,b are_connected & b,c are_connected implies for A1,A2 being
Path of a,b, B being Path of b,c holds A1,A2 are_homotopic implies A1, A2+B+-B
  are_homotopic;

theorem 
  for A1,A2 being Path of a1,b1, B being Path of b1,c1 holds A1,A2
  are_homotopic implies A1, A2+B+-B are_homotopic;

theorem 
  a,b are_connected & c,b are_connected implies for A1,A2 being
Path of a,b, B being Path of c,b holds A1,A2 are_homotopic implies A1, A2+-B+B
  are_homotopic;

theorem 
  for A1,A2 being Path of a1,b1, B being Path of c1,b1 holds A1,A2
  are_homotopic implies A1, A2+-B+B are_homotopic;

theorem 
  a,b are_connected & c,a are_connected implies for A1,A2 being
Path of a,b, B being Path of c,a holds A1,A2 are_homotopic implies A1, -B+B+A2
  are_homotopic;

theorem 
  for A1,A2 being Path of a1,b1, B being Path of c1,a1 holds A1,A2
  are_homotopic implies A1, -B+B+A2 are_homotopic;

theorem 
  a,b are_connected & a,c are_connected implies for A1,A2 being
Path of a,b, B being Path of a,c holds A1,A2 are_homotopic implies A1, B+-B+A2
  are_homotopic;

theorem 
  for A1,A2 being Path of a1,b1, B being Path of a1,c1 holds A1,A2
  are_homotopic implies A1, B+-B+A2 are_homotopic;

theorem 
  a,b are_connected & c,b are_connected implies for A, B being
  Path of a,b, C being Path of b,c st A+C, B+C are_homotopic holds A, B
  are_homotopic;

theorem 
  for A, B being Path of a1,b1, C being Path of b1,c1 st A+C, B+C
  are_homotopic holds A, B are_homotopic;

theorem 
  a,b are_connected & a,c are_connected implies for A, B being
  Path of a,b, C being Path of c,a st C+A, C+B are_homotopic holds A, B
  are_homotopic;

theorem 
  for A, B being Path of a1,b1, C being Path of c1,a1 st C+A, C+B
  are_homotopic holds A, B are_homotopic;

theorem 
  a,b are_connected & b,c are_connected & c,d are_connected & d,e
  are_connected implies for A being Path of a,b, B being Path of b,c, C being
  Path of c,d, D being Path of d,e holds A+B+C+D, A+(B+C)+D are_homotopic;

theorem 
  for A being Path of a1,b1, B being Path of b1,c1, C being Path of c1,
  d1, D being Path of d1,e1 holds A+B+C+D, A+(B+C)+D are_homotopic;

theorem 
  a,b are_connected & b,c are_connected & c,d are_connected & d,e
  are_connected implies for A being Path of a,b, B being Path of b,c, C being
  Path of c,d, D being Path of d,e holds A+B+C+D, A+(B+C+D) are_homotopic;

theorem 
  for A being Path of a1,b1, B being Path of b1,c1, C being Path of c1,
  d1, D being Path of d1,e1 holds A+B+C+D, A+(B+C+D) are_homotopic;

theorem 
  a,b are_connected & b,c are_connected & c,d are_connected & d,e
  are_connected implies for A being Path of a,b, B being Path of b,c, C being
  Path of c,d, D being Path of d,e holds A+(B+C)+D, A+B+(C+D) are_homotopic;

theorem 
  for A being Path of a1,b1, B being Path of b1,c1, C being Path of c1,
  d1, D being Path of d1,e1 holds A+(B+C)+D, A+B+(C+D) are_homotopic;

theorem 
  a,b are_connected & b,c are_connected & b,d are_connected
implies for A being Path of a,b, B being Path of d,b, C being Path of b,c holds
  A+-B+B+C, A+C are_homotopic;

theorem 
  for A being Path of a1,b1, B being Path of d1,b1, C being Path of b1,
  c1 holds A+-B+B+C, A+C are_homotopic;

theorem 
  a,b are_connected & a,c are_connected & c,d are_connected
implies for A being Path of a,b, B being Path of c,d, C being Path of a,c holds
  A+-A+C+B+-B, C are_homotopic;

theorem 
  for A being Path of a1,b1, B being Path of c1,d1, C being Path of a1,
  c1 holds A+-A+C+B+-B, C are_homotopic;

theorem 
  a,b are_connected & a,c are_connected & d,c are_connected
implies for A being Path of a,b, B being Path of c,d, C being Path of a,c holds
  A+(-A+C+B)+-B, C are_homotopic;

theorem 
  for A being Path of a1,b1, B being Path of c1,d1, C being Path of a1,
  c1 holds A+(-A+C+B)+-B, C are_homotopic;

theorem 
  a,b are_connected & b,c are_connected & c,d are_connected & d,e
are_connected & a,f are_connected implies for A being Path of a,b, B being Path
of b,c, C being Path of c,d, D being Path of d,e, E being Path of f,c holds A+(
  B+C)+D, A+B+-E+(E+C+D) are_homotopic;

theorem 
  for A being Path of a1,b1, B being Path of b1,c1, C being Path of c1,
d1, D being Path of d1,e1, E being Path of f1,c1 holds A+(B+C)+D, A+B+-E+(E+C+D
  ) are_homotopic;

begin 

definition
  let T be TopStruct, t be Point of T;
  mode Loop of t is Path of t,t;
end;

definition
  let T be non empty TopStruct, t1,t2 be Point of T;
  func Paths(t1,t2) means


  for x being set holds x in it iff x is Path of t1,t2;
end;

registration
  let T be non empty TopStruct, t1,t2 be Point of T;
  cluster Paths(t1,t2) -> non empty;
end;

definition
  let T be non empty TopStruct, t be Point of T;
  func Loops(t) equals

  Paths(t,t);
end;

registration
  let T be non empty TopStruct, t be Point of T;
  cluster Loops(t) -> non empty;
end;

definition
  let X be non empty TopSpace, a,b be Point of X such that
 a,b are_connected;
  func EqRel(X,a,b) -> Relation of Paths(a,b) means


  for P, Q being Path of a,b holds [P,Q] in it iff P,Q are_homotopic;
end;

theorem 
  a,b are_connected implies for P, Q being Path of a,b holds Q in
  Class(EqRel(X,a,b),P) iff P,Q are_homotopic;

theorem 
  a,b are_connected implies for P, Q being Path of a,b holds Class
  (EqRel(X,a,b),P) = Class(EqRel(X,a,b),Q) iff P,Q are_homotopic;

definition
  let X be non empty TopSpace, a be Point of X;
  func EqRel(X,a) -> Relation of Loops(a) equals

  EqRel(X,a,a);
end;

registration
  let X be non empty TopSpace, a be Point of X;
  cluster EqRel(X,a) -> non empty total symmetric transitive;
end;

definition
  let X be non empty TopSpace, a be Point of X;
  func FundamentalGroup(X,a) -> strict multMagma means


  the carrier of
it = Class EqRel (X,a) & for x,y being Element of it ex P,Q being Loop of a st
  x = Class(EqRel(X,a),P) & y = Class(EqRel(X,a),Q) & (the multF of it).(x,y) =
  Class(EqRel(X,a),P+Q);
end;

notation
  let X be non empty TopSpace, a be Point of X;
  synonym pi_1(X,a) for FundamentalGroup(X,a);
end;

registration
  let X be non empty TopSpace;
  let a be Point of X;
  cluster pi_1(X,a) -> non empty;
end;

theorem 
  for x being set holds x in the carrier of pi_1(X,a) iff ex P
  being Loop of a st x = Class(EqRel(X,a),P);

registration
  let X be non empty TopSpace;
  let a be Point of X;
  cluster pi_1(X,a) -> associative Group-like;
end;

definition
  let T be non empty TopSpace, x0, x1 be Point of T, P being Path of x0,x1;
  assume
 x0,x1 are_connected;
  func pi_1-iso(P) -> Function of pi_1(T,x1), pi_1(T,x0) means


  for Q
  being Loop of x1 holds it.Class(EqRel(T,x1),Q) = Class(EqRel(T,x0),P+Q+-P);
end;

reserve x0, x1 for Point of X,
  P, Q for Path of x0,x1,
  y0, y1 for Point of T,
  R, V for Path of y0,y1;

theorem 
  x0,x1 are_connected & P,Q are_homotopic implies pi_1-iso(P) = pi_1-iso(Q);

theorem 
  R,V are_homotopic implies pi_1-iso(R) = pi_1-iso(V);

theorem 
  x0,x1 are_connected implies pi_1-iso(P) is Homomorphism of pi_1(
  X,x1), pi_1(X,x0);

registration
  let T be non empty pathwise_connected TopSpace, x0, x1 be Point of T,
  P be Path of x0,x1;
  cluster pi_1-iso(P) -> multiplicative;
end;

theorem 
  x0,x1 are_connected implies pi_1-iso(P) is one-to-one;

theorem 
  x0,x1 are_connected implies pi_1-iso(P) is onto;

registration
  let T be non empty pathwise_connected TopSpace,
      x0, x1 be Point of T, P be Path of x0,x1;
  cluster pi_1-iso(P) -> one-to-one onto;
end;

theorem 
  x0,x1 are_connected implies (pi_1-iso(P))" = pi_1-iso(-P);

theorem 
  (pi_1-iso(R))" = pi_1-iso(-R);

theorem 
  x0,x1 are_connected implies for h being Homomorphism of pi_1(X,
  x1), pi_1(X,x0) st h = pi_1-iso(P) holds h is bijective;

theorem 
  pi_1-iso(R) is bijective;

theorem 
  x0,x1 are_connected implies pi_1(X,x0), pi_1(X,x1) are_isomorphic;

theorem 
  pi_1(T,y0), pi_1(T,y1) are_isomorphic;

begin 

definition
  let n be Nat, P, Q be Function of I[01], TOP-REAL n;
  func RealHomotopy(P,Q) -> Function of [:I[01],I[01]:], TOP-REAL n means


   for s, t being Element of I[01] holds it.(s,t) = (1-t) * P.s + t * Q.s;
end;

theorem 
  for a, b being Point of TOP-REAL n, P, Q being Path of a,b holds
  P, Q are_homotopic;

registration
  let n be Nat, a, b be Point of TOP-REAL n, P, Q be Path of a,b;
  cluster -> continuous for Homotopy of P,Q;
end;

theorem 
  for a being Point of TOP-REAL n, C being Loop of a holds the
  carrier of pi_1(TOP-REAL n,a) = { Class(EqRel(TOP-REAL n,a),C) };

registration
  let n be Nat;
  let a be Point of TOP-REAL n;
  cluster pi_1(TOP-REAL n,a) -> trivial;
end;

theorem 
  for S being non empty TopSpace, s being Point of S for x, y being
Element of pi_1(S,s) for P, Q being Loop of s st x = Class(EqRel(S,s),P) & y =
  Class(EqRel(S,s),Q) holds x*y = Class(EqRel(S,s),P+Q);



theorem 
  for C being constant Loop of a holds 1_pi_1(X,a) = Class(EqRel(X ,a),C);

theorem 
  for x, y being Element of pi_1(X,a), P being Loop of a st x = Class(
  EqRel(X,a),P) & y = Class(EqRel(X,a),-P) holds x" = y;

registration
  let n;
  let P, Q be continuous Function of I[01],TOP-REAL n;
  cluster RealHomotopy(P,Q) -> continuous;
end;

theorem 
  for a, b be Point of TOP-REAL n, P, Q be Path of a,b holds
  RealHomotopy(P,Q) is Homotopy of P,Q;

theorem 
  a,b are_connected implies EqRel(X,a,b) is non empty total symmetric
  transitive;














begin 

reserve n for Element of NAT,
  a, b for real number;

registration
  let n;
  cluster non empty convex for Subset of TOP-REAL n;
end;

definition
  let n be Element of NAT, T be SubSpace of TOP-REAL n;
  attr T is convex means


  [#]T is convex Subset of TOP-REAL n;
end;

registration
  let n be Element of NAT;
  cluster convex -> pathwise_connected for non empty SubSpace of TOP-REAL n;
end;

registration
  let n be Element of NAT;
  cluster strict non empty convex for SubSpace of TOP-REAL n;
end;

theorem 
  for X being non empty TopSpace, Y being non empty SubSpace of X, x1,
x2 being Point of X, y1, y2 being Point of Y, f being Path of y1,y2 st x1 = y1
  & x2 = y2 & y1,y2 are_connected holds f is Path of x1,x2;

definition
  let n be Element of NAT, T being non empty convex SubSpace of TOP-REAL n, P,
  Q be Function of I[01],T;
  func ConvexHomotopy(P,Q) -> Function of [:I[01],I[01]:], T means


  for
s, t being Element of I[01], a1, b1 being Point of TOP-REAL n st a1 = P.s & b1
  = Q.s holds it.(s,t) = (1-t) * a1 + t * b1;
end;

theorem 
  for T being non empty convex SubSpace of TOP-REAL n, a, b being
  Point of T, P, Q being Path of a,b holds P, Q are_homotopic;

registration
  let n be Element of NAT, T be non empty convex SubSpace of TOP-REAL n, a, b
  be Point of T, P, Q be Path of a,b;
  cluster -> continuous for Homotopy of P,Q;
end;

theorem 
  for T being non empty convex SubSpace of TOP-REAL n, a being
Point of T, C being Loop of a holds the carrier of pi_1(T,a) = { Class(EqRel(T,
  a),C) };

registration
  let n be Element of NAT, T be non empty convex SubSpace of TOP-REAL n, a be
  Point of T;
  cluster pi_1(T,a) -> trivial;
end;

begin 

theorem 
  |[a]|/.1 = a;

theorem 
  a <= b implies [.a,b.] = { (1-l)*a + l*b where l is Real: 0 <= l & l <= 1 };

theorem 
  for F being Function of [:R^1,I[01]:], R^1 st for x being Point
of R^1, i being Point of I[01] holds F.(x,i) = (1-i) * x holds F is continuous;

theorem 
  for F being Function of [:R^1,I[01]:], R^1 st for x being Point
  of R^1, i being Point of I[01] holds F.(x,i) = i * x holds F is continuous;

registration
  cluster non empty interval for Subset of R^1;
end;

registration
  let T be real-membered TopStruct;
  cluster interval for Subset of T;
end;

definition

  let T be real-membered TopStruct;
  attr T is interval means


  [#]T is interval;
end;

registration
  cluster strict non empty interval for SubSpace of R^1;
end;

definition
  redefine func R^1 -> interval SubSpace of R^1;
end;

theorem 
  for T being non empty interval SubSpace of R^1, a, b being Point
  of T holds [. a, b .] c= the carrier of T;

registration
  cluster interval -> pathwise_connected for non empty SubSpace of R^1;
end;

theorem 
  a <= b implies Closed-Interval-TSpace(a,b) is interval;

theorem 
  I[01] is interval;

theorem 
  a <= b implies Closed-Interval-TSpace(a,b) is pathwise_connected;

definition
  let T be non empty interval SubSpace of R^1, P, Q be Function of I[01],T;
  func R1Homotopy(P,Q) -> Function of [:I[01],I[01]:], T means


  for s, t being Element of I[01] holds it.(s,t) = (1-t) * P.s + t * Q.s;
end;

theorem 
  for T being non empty interval SubSpace of R^1, a, b being Point
  of T, P, Q being Path of a,b holds P, Q are_homotopic;

registration
  let T be non empty interval SubSpace of R^1, a, b be Point of T, P, Q be Path
  of a,b;
  cluster -> continuous for Homotopy of P,Q;
end;

theorem 
  for T being non empty interval SubSpace of R^1, a being Point of T
  , C being Loop of a holds the carrier of pi_1(T,a) = { Class(EqRel(T,a),C) };

registration
  let T be non empty interval SubSpace of R^1, a be Point of T;
  cluster pi_1(T,a) -> trivial;
end;

theorem 
  a <= b implies for x, y being Point of Closed-Interval-TSpace(a,b), P,
  Q being Path of x,y holds P, Q are_homotopic;

theorem 
  a <= b implies for x being Point of Closed-Interval-TSpace(a,b), C
  being Loop of x holds the carrier of pi_1(Closed-Interval-TSpace(a,b),x) = {
  Class(EqRel(Closed-Interval-TSpace(a,b),x),C) };

theorem 
  for x, y being Point of I[01], P, Q being Path of x,y holds P, Q
  are_homotopic;

theorem 
  for x being Point of I[01], C being Loop of x holds the carrier of
  pi_1(I[01],x) = { Class(EqRel(I[01],x),C) };

registration
  let x be Point of I[01];
  cluster pi_1(I[01],x) -> trivial;
end;

registration
  let n;
  let T be non empty convex SubSpace of TOP-REAL n, P, Q be continuous
  Function of I[01],T;
  cluster ConvexHomotopy(P,Q) -> continuous;
end;

theorem 
  for n being Element of NAT, T being non empty convex SubSpace of
TOP-REAL n, a, b being Point of T, P, Q being Path of a,b holds ConvexHomotopy(
  P,Q) is Homotopy of P,Q;

registration
  let T be non empty interval SubSpace of R^1, P, Q be continuous Function of
  I[01],T;
  cluster R1Homotopy(P,Q) -> continuous;
end;

theorem 
  for T being non empty interval SubSpace of R^1, a, b be Point of T, P, Q
  be Path of a,b holds R1Homotopy(P,Q) is Homotopy of P,Q;














begin

theorem 
  for A, B, a, b being set, f being Function of A,B st a in A & b in B
  holds f +* (a .--> b) is Function of A,B;

theorem 
  for f being Function, X, x being set st f|X is one-to-one & x in rng (
  f|X) holds (f*(f|X)").x = x;

theorem 
  for X, a, b being set, f being Function of X,{a,b} holds X = f"{a } \/ f"{b};

theorem 
  for S, T being non empty 1-sorted, s being Point of S, t being Point
  of T holds (S --> t).s = t;



theorem 
  for T being non empty TopStruct, t being Point of T, A being Subset of
  T st A = {t} holds Sspace(t) = T | A;

theorem 
  for T being TopSpace, A, B being Subset of T, C, D being Subset
  of the TopStruct of T st A = C & B = D holds A,B are_separated iff C,D
  are_separated;

theorem 
  for T being non empty TopSpace holds T is connected iff not ex f
  being Function of T, 1TopSp{0,1} st f is continuous onto;

registration
  cluster empty -> connected for TopStruct;
end;

theorem 
  for T being TopSpace st the TopStruct of T is connected holds T is connected;

registration
  let T be connected TopSpace;
  cluster the TopStruct of T -> connected;
end;

theorem 
  for S, T be non empty TopSpace st S,T are_homeomorphic &
  S is pathwise_connected holds T is pathwise_connected;

registration
  cluster trivial -> pathwise_connected for non empty TopSpace;
end;

theorem 
  for T being SubSpace of TOP-REAL 2 st the carrier of T is
  Simple_closed_curve holds T is pathwise_connected;

theorem 
  for T being TopSpace ex F being Subset-Family of T st F = {the carrier
  of T} & F is Cover of T & F is open;

registration
  let T be TopSpace;
  cluster non empty mutually-disjoint open closed for Subset-Family of T;
end;

theorem 
  for T being TopSpace, D being mutually-disjoint open Subset-Family of
T, A being Subset of T, X being set st A is connected & X in D & X meets A & D
  is Cover of A holds A c= X;

begin 

theorem 
  for S, T being TopSpace holds the TopStruct of [:S,T:] = [:the
  TopStruct of S,the TopStruct of T:];

theorem 
  for S, T being TopSpace, A being Subset of S, B being Subset of
  T holds Cl [:A,B:] = [:Cl A,Cl B:];

theorem 
  for S, T being TopSpace, A being closed Subset of S, B being
  closed Subset of T holds [:A,B:] is closed;

registration
  let A, B be connected TopSpace;
  cluster [:A,B:] -> connected;
end;

theorem 
  for S, T being TopSpace, A being Subset of S, B being Subset of T st A
  is connected & B is connected holds [:A,B:] is connected;

theorem 
  for S, T be TopSpace, Y being non empty TopSpace, A being Subset of S,
f being Function of [:S,T:],Y, g being Function of [:S|A,T:],Y st g = f | [:A,
  the carrier of T:] & f is continuous holds g is continuous;

theorem 
  for S, T be TopSpace, Y being non empty TopSpace, A being Subset of T,
f being Function of [:S,T:],Y, g being Function of [:S,T|A:],Y st g = f | [:the
  carrier of S,A:] & f is continuous holds g is continuous;

theorem 
  for S, T, T1, T2, Y being non empty TopSpace, f being Function of [:Y,
  T1:],S, g being Function of [:Y,T2:],S, F1, F2 being closed Subset of T st T1
is SubSpace of T & T2 is SubSpace of T & F1 = [#]T1 & F2 = [#]T2 & ([#]T1) \/ (
[#]T2) = [#]T & f is continuous & g is continuous & (for p being set st p in (
[#][:Y,T1:]) /\ ([#][:Y,T2:]) holds f.p = g.p) ex h being Function of [:Y,T:],S
  st h = f+*g & h is continuous;

theorem 
  for S, T, T1, T2, Y being non empty TopSpace, f being Function of [:T1
  ,Y:],S, g being Function of [:T2,Y:],S, F1, F2 being closed Subset of T st T1
is SubSpace of T & T2 is SubSpace of T & F1 = [#]T1 & F2 = [#]T2 & ([#]T1) \/ (
[#]T2) = [#]T & f is continuous & g is continuous & (for p being set st p in (
[#][:T1,Y:]) /\ ([#][:T2,Y:]) holds f.p = g.p) ex h being Function of [:T,Y:],S
  st h = f+*g & h is continuous;

begin 

registration
  let T be non empty TopSpace, t be Point of T;
  cluster -> continuous for Loop of t;
end;

theorem 
  for T being non empty TopSpace, t being Point of T, x being Point of
  I[01], P being constant Loop of t holds P.x = t;

theorem 
  for T being non empty TopSpace, t being Point of T, P being Loop
  of t holds P.0 = t & P.1 = t;

theorem 
  for S, T being non empty TopSpace, f being continuous Function
of S,T, a, b being Point of S st a,b are_connected holds f.a,f.b are_connected;

theorem 
  for S, T being non empty TopSpace, f being continuous Function of S,T,
  a, b being Point of S, P being Path of a,b st a,b are_connected holds f*P is
  Path of f.a,f.b;

theorem 
  for S being non empty pathwise_connected TopSpace, T being non
  empty TopSpace, f being continuous Function of S,T, a, b being Point of S, P
  being Path of a,b holds f*P is Path of f.a,f.b;

definition
  let S be non empty pathwise_connected TopSpace, T be non empty TopSpace, a, b
  be Point of S, P be Path of a,b, f be continuous Function of S,T;
  redefine func f*P -> Path of f.a,f.b;
end;

theorem 
  for S, T being non empty TopSpace, f being continuous Function
  of S,T, a being Point of S, P being Loop of a holds f*P is Loop of f.a;

definition
  let S, T be non empty TopSpace, a be Point of S, P be Loop of a, f be
  continuous Function of S,T;
  redefine func f*P -> Loop of f.a;
end;

theorem 
  for S, T being non empty TopSpace, f being continuous Function
of S,T, a, b being Point of S, P, Q being Path of a,b, P1, Q1 being Path of f.a
  ,f.b st P,Q are_homotopic & P1 = f*P & Q1 = f*Q holds P1,Q1 are_homotopic;

theorem 
  for S, T being non empty TopSpace, f being continuous Function of S,T,
a, b being Point of S, P, Q being Path of a,b, P1, Q1 being Path of f.a,f.b, F
  being Homotopy of P,Q st P,Q are_homotopic & P1 = f*P & Q1 = f*Q holds f*F is
  Homotopy of P1,Q1;

theorem 
  for S, T being non empty TopSpace, f being continuous Function
of S,T, a, b, c being Point of S, P being Path of a,b, Q being Path of b,c, P1
  being Path of f.a,f.b, Q1 being Path of f.b,f.c st a,b are_connected & b,c
  are_connected & P1 = f*P & Q1 = f*Q holds P1+Q1 = f*(P+Q);

definition
  let S, T be non empty TopSpace, s be Point of S, f be Function of S,T such
  that
 f is continuous;
  func FundGrIso(f,s) -> Function of pi_1(S,s),pi_1(T,f.s) means


  for x
being Element of pi_1(S,s) ex ls being Loop of s st x = Class(EqRel(S,s),ls) &
  it.x = Class(EqRel(T,f.s),f*ls);
end;

theorem 
  for S, T being non empty TopSpace, s being Point of S, f being
continuous Function of S,T, ls being Loop of s holds FundGrIso(f,s).Class(EqRel
  (S,s),ls) = Class(EqRel(T,f.s),f*ls);

registration
  let S, T be non empty TopSpace, s be Point of S,
  f be continuous Function of S,T;
  cluster FundGrIso(f,s) -> multiplicative;
end;

theorem 
  for S, T being non empty TopSpace, s being Point of S, f being
continuous Function of S,T st f is being_homeomorphism holds FundGrIso(f,s) is
  bijective;

theorem 
  for S, T being non empty TopSpace, s being Point of S, t being Point
  of T, f being continuous Function of S,T, P being Path of t,f.s, h being
  Homomorphism of pi_1(S,s),pi_1(T,t) st f is being_homeomorphism & f.s,t
  are_connected & h = pi_1-iso(P) * FundGrIso(f,s) holds h is bijective;

theorem 
  for S being non empty TopSpace, T being non empty pathwise_connected
TopSpace, s being Point of S, t being Point of T st S,T are_homeomorphic holds
  pi_1(S,s),pi_1(T,t) are_isomorphic;














begin

theorem 
  for G, H being non empty multMagma, x being Element of product <*
  G,H*> ex g being Element of G, h being Element of H st x = <*g,h*>;

definition
  let G1, G2, H1, H2 be non empty multMagma, f be Function of G1,H1, g be
  Function of G2,H2;
  func Gr2Iso(f,g) -> Function of product <*G1,G2*>, product <*H1,H2*> means


   for x being Element of product <*G1,G2*> ex x1 being Element of G1, x2
  being Element of G2 st x = <*x1,x2*> & it.x = <*f.x1,g.x2*>;
end;

theorem 
  for G1, G2, H1, H2 being non empty multMagma, f being Function of G1,
  H1, g being Function of G2,H2, x1 being Element of G1, x2 being Element of G2
  holds Gr2Iso(f,g).<*x1,x2*> = <*f.x1,g.x2*>;

registration
  let G1, G2, H1, H2 be Group, f be Homomorphism of G1,H1,
  g be Homomorphism of G2,H2;
  cluster Gr2Iso(f,g) -> multiplicative;
end;

theorem 
  for G1, G2, H1, H2 being non empty multMagma, f being Function of
  G1,H1, g being Function of G2,H2 st f is one-to-one & g is one-to-one holds
  Gr2Iso(f,g) is one-to-one;

theorem 
  for G1, G2, H1, H2 being non empty multMagma, f being Function of
G1,H1, g being Function of G2,H2 st f is onto & g is onto holds Gr2Iso(f,g) is
  onto;

theorem 
  for G1, G2, H1, H2 being Group, f being Homomorphism of G1,H1,
  g being Homomorphism of G2,H2 st f is bijective & g is bijective holds
  Gr2Iso(f,g) is bijective;

theorem 
  for G1, G2, H1, H2 being Group st G1,H1 are_isomorphic & G2,H2
  are_isomorphic holds product <*G1,G2*>, product <*H1,H2*> are_isomorphic;

begin

reserve S, T, Y for non empty TopSpace,
  s, s1, s2, s3 for Point of S,
  t, t1, t2, t3 for Point of T,
  l1, l2 for Path of [s1,t1],[s2,t2],
  H for Homotopy of l1 ,l2;

theorem 
  for f, g being Function st dom f = dom g holds pr1 <:f,g:> = f;

theorem 
  for f, g being Function st dom f = dom g holds pr2 <:f,g:> = g;

definition
  let S, T, Y;
  let f be Function of Y, S;
  let g be Function of Y, T;
  redefine func <:f,g:> -> Function of Y,[:S,T:];
end;

definition
  let S, T, Y;
  let f be Function of Y, [:S,T:];
  redefine func pr1 f -> Function of Y,S;
  redefine func pr2 f -> Function of Y,T;
end;

theorem 
  for f being continuous Function of Y,[:S,T:] holds pr1 f is continuous;

theorem 
  for f being continuous Function of Y,[:S,T:] holds pr2 f is continuous;

theorem 
  [s1,t1],[s2,t2] are_connected implies s1,s2 are_connected;

theorem 
  [s1,t1],[s2,t2] are_connected implies t1,t2 are_connected;

theorem 
  [s1,t1],[s2,t2] are_connected implies for L being Path of [s1,t1
  ],[s2,t2] holds pr1 L is Path of s1,s2;

theorem 
  [s1,t1],[s2,t2] are_connected implies for L being Path of [s1,t1
  ],[s2,t2] holds pr2 L is Path of t1,t2;

theorem 
  s1,s2 are_connected & t1,t2 are_connected implies [s1,t1],[s2,t2
  ] are_connected;

theorem 
  s1,s2 are_connected & t1,t2 are_connected implies for L1 being
Path of s1,s2, L2 being Path of t1,t2 holds <:L1,L2:> is Path of [s1,t1],[s2,t2
  ];

definition
  let S, T be non empty pathwise_connected TopSpace, s1, s2 be Point of S, t1,
  t2 be Point of T, L1 be Path of s1,s2, L2 be Path of t1,t2;
  redefine func <:L1,L2:> -> Path of [s1,t1],[s2,t2];
end;

definition
  let S, T be non empty TopSpace, s be Point of S, t be Point of T, L1 be Loop
  of s, L2 be Loop of t;
  redefine func <:L1,L2:> -> Loop of [s,t];
end;

registration
  let S, T be non empty pathwise_connected TopSpace;
  cluster [:S,T:] -> pathwise_connected;
end;

definition
  let S, T be non empty pathwise_connected TopSpace, s1, s2 be Point of S, t1,
  t2 be Point of T, L be Path of [s1,t1],[s2,t2];
  redefine func pr1 L -> Path of s1,s2;
  redefine func pr2 L -> Path of t1,t2;
end;

definition
  let S, T be non empty TopSpace, s be Point of S, t be Point of T, L be Loop
  of [s,t];
  redefine func pr1 L -> Loop of s;
  redefine func pr2 L -> Loop of t;
end;

theorem 
  for p, q being Path of s1,s2 st p = pr1 l1 & q = pr1 l2 & l1,l2
  are_homotopic holds pr1 H is Homotopy of p,q;

theorem 
  for p, q being Path of t1,t2 st p = pr2 l1 & q = pr2 l2 & l1,l2
  are_homotopic holds pr2 H is Homotopy of p,q;

theorem 
  for p, q being Path of s1,s2 st p = pr1 l1 & q = pr1 l2 & l1,l2
  are_homotopic holds p,q are_homotopic;

theorem 
  for p, q being Path of t1,t2 st p = pr2 l1 & q = pr2 l2 & l1,l2
  are_homotopic holds p,q are_homotopic;

theorem 
  for p, q being Path of s1,s2, x, y being Path of t1,t2, f being
  Homotopy of p,q, g being Homotopy of x,y st p = pr1 l1 & q = pr1 l2 & x = pr2
  l1 & y = pr2 l2 & p,q are_homotopic & x,y are_homotopic holds <:f,g:> is
  Homotopy of l1,l2;

theorem 
  for p, q being Path of s1,s2, x, y being Path of t1, t2 st p =
  pr1 l1 & q = pr1 l2 & x = pr2 l1 & y = pr2 l2 & p,q are_homotopic & x,y
  are_homotopic holds l1, l2 are_homotopic;

theorem 
  for l1 being Path of [s1,t1],[s2,t2], l2 being Path of [s2,t2],[
  s3,t3], p1 being Path of s1,s2, p2 being Path of s2,s3 st [s1,t1],[s2,t2]
are_connected & [s2,t2],[s3,t3] are_connected & p1 = pr1 l1 & p2 = pr1 l2 holds
  pr1 (l1+l2) = p1 + p2;

theorem 
  for S, T being non empty pathwise_connected TopSpace, s1, s2, s3 being
  Point of S, t1, t2, t3 being Point of T, l1 being Path of [s1,t1],[s2,t2], l2
  being Path of [s2,t2],[s3,t3] holds pr1 (l1+l2) = (pr1 l1) + (pr1 l2);

theorem 
  for l1 being Path of [s1,t1],[s2,t2], l2 being Path of [s2,t2],[
  s3,t3], p1 being Path of t1,t2, p2 being Path of t2,t3 st [s1,t1],[s2,t2]
are_connected & [s2,t2],[s3,t3] are_connected & p1 = pr2 l1 & p2 = pr2 l2 holds
  pr2 (l1+l2) = p1 + p2;

theorem 
  for S, T being non empty pathwise_connected TopSpace, s1, s2, s3 being
  Point of S, t1, t2, t3 being Point of T, l1 being Path of [s1,t1],[s2,t2], l2
  being Path of [s2,t2],[s3,t3] holds pr2 (l1+l2) = (pr2 l1) + (pr2 l2);

definition
  let S, T be non empty TopSpace, s be Point of S, t be Point of T;
  func FGPrIso(s,t) -> Function of pi_1([:S,T:],[s,t]), product <*pi_1(S,s),
  pi_1(T,t)*> means


  for x being Point of pi_1([:S,T:],[s,t]) ex l being
Loop of [s,t] st x = Class(EqRel([:S,T:],[s,t]),l) & it.x = <*Class(EqRel(S,s),
  pr1 l),Class(EqRel(T,t),pr2 l)*>;
end;

theorem 
  for x being Point of pi_1([:S,T:],[s,t]), l being Loop of [s,t]
st x = Class(EqRel([:S,T:],[s,t]),l) holds FGPrIso(s,t).x = <*Class(EqRel(S,s),
  pr1 l),Class(EqRel(T,t),pr2 l)*>;

theorem 
  for l being Loop of [s,t] holds FGPrIso(s,t).Class(EqRel([:S,T:]
  ,[s,t]),l) = <*Class(EqRel(S,s),pr1 l),Class(EqRel(T,t),pr2 l)*>;

registration
  let S, T be non empty TopSpace, s be Point of S, t be Point of T;
  cluster FGPrIso(s,t) -> one-to-one onto;
end;

registration
  let S, T be non empty TopSpace, s be Point of S, t be Point of T;
  cluster  FGPrIso(s,t) -> multiplicative;
end;

theorem 
  FGPrIso(s,t) is bijective;

theorem 
  pi_1([:S,T:],[s,t]), product <*pi_1(S,s),pi_1(T,t)*> are_isomorphic;

theorem 
  for f being Homomorphism of pi_1(S,s1),pi_1(S,s2), g being
Homomorphism of pi_1(T,t1),pi_1(T,t2) st f is bijective & g is bijective holds
  Gr2Iso(f,g) * FGPrIso(s1,t1) is bijective;

theorem 
  for S, T being non empty pathwise_connected TopSpace, s1, s2 being
Point of S, t1, t2 being Point of T holds pi_1([:S,T:],[s1,t1]), product <*pi_1
  (S,s2),pi_1(T,t2)*> are_isomorphic;














begin 

reserve n for Element of NAT,
  a, b, r, w for real number,
  x, y, z for Point of TOP-REAL n,
  e for Point of Euclid n;

canceled;

theorem 
  x + y = x + z implies y = z;

theorem 
  n is non empty implies x <> x + 1.REAL n;

theorem 
  for x being set holds x = (1-r)*y + r*z implies (x = y iff r = 0
  or y = z) & (x = z iff r = 1 or y = z);

theorem 
  for f being real-valued FinSequence holds |.f.|^2 = Sum sqr f;

theorem 
  for M being non empty MetrSpace, z1, z2, z3 being Point of M st
  z1 <> z2 & z1 in cl_Ball(z3,r) & z2 in cl_Ball(z3,r) holds r > 0;

begin 

definition
  let n be Nat, x be Point of TOP-REAL n, r be real number;
  func Ball(x,r) -> Subset of TOP-REAL n equals

  {p where p is Point of
  TOP-REAL n: |. p-x .| < r};
  func cl_Ball(x,r) -> Subset of TOP-REAL n equals

  {p where p is Point of
  TOP-REAL n: |. p-x .| <= r};
  func Sphere(x,r) -> Subset of TOP-REAL n equals

  {p where p is Point of
  TOP-REAL n: |. p-x .| = r};
end;

theorem 
  y in Ball(x,r) iff |. y-x .| < r;

theorem 
  y in cl_Ball(x,r) iff |. y-x .| <= r;

theorem 
  y in Sphere(x,r) iff |. y-x .| = r;

theorem 
  y in Ball(0.TOP-REAL n,r) implies |.y.| < r;

theorem 
  y in cl_Ball(0.TOP-REAL n,r) implies |.y.| <= r;

theorem 
  y in Sphere(0.TOP-REAL n,r) implies |.y.| = r;

theorem 
  x = e implies Ball(e,r) = Ball(x,r);

theorem 
  x = e implies cl_Ball(e,r) = cl_Ball(x,r);

theorem 
  x = e implies Sphere(e,r) = Sphere(x,r);

theorem 
  Ball(x,r) c= cl_Ball(x,r);

theorem 
  Sphere(x,r) c= cl_Ball(x,r);

theorem 
  Ball(x,r) \/ Sphere(x,r) = cl_Ball(x,r);

theorem 
  Ball(x,r) misses Sphere(x,r);

registration
  let n be Nat, x be Point of TOP-REAL n;
  let r be non positive real number;
  cluster Ball(x,r) -> empty;
end;

registration
  let n be Nat, x be Point of TOP-REAL n;
  let r be positive real number;
  cluster Ball(x,r) -> non empty;
end;

theorem 
  Ball(x,r) is non empty implies r > 0;

theorem 
  Ball(x,r) is empty implies r <= 0;

registration
  let n be Nat, x be Point of TOP-REAL n;
  let r be negative real number;
  cluster cl_Ball(x,r) -> empty;
end;

registration
  let n be Nat, x be Point of TOP-REAL n;
  let r be non negative real number;
  cluster cl_Ball(x,r) -> non empty;
end;

theorem 
  cl_Ball(x,r) is non empty implies r >= 0;

theorem 
  cl_Ball(x,r) is empty implies r < 0;

theorem 
  a + b = 1 & abs(a) + abs(b) = 1 & b <> 0 & x in cl_Ball(z,r) & y
  in Ball(z,r) implies a * x + b * y in Ball(z,r);

registration
  let n be Nat, x be Point of TOP-REAL n;
  let r;
  cluster Ball(x,r) -> open;
  cluster cl_Ball(x,r) -> closed;
  cluster Sphere(x,r) -> closed;
end;

registration
  let n,x,r;
  cluster Ball(x,r) -> bounded;
  cluster cl_Ball(x,r) -> bounded;
  cluster Sphere(x,r) -> bounded;
end;



registration
  let n be Nat, x be Point of TOP-REAL n;
  let r;
  cluster Ball(x,r) -> convex;
  cluster cl_Ball(x,r) -> convex;
end;

definition
  let n be Nat;
  let f be Function of TOP-REAL n, TOP-REAL n;
  attr f is homogeneous means


  for r being real number, x being Point of TOP-REAL n holds f.(r*x) = r * f.x;

end;

registration
  let n;
  cluster TOP-REAL n --> 0.TOP-REAL n -> homogeneous additive;
end;

registration
  let n;
  cluster homogeneous additive continuous for
Function of TOP-REAL n, TOP-REAL n;
end;

registration
  let a, c be real number;
  cluster AffineMap(a,0,c,0) -> homogeneous additive;
end;

theorem 
  for f being homogeneous additive Function of TOP-REAL n, TOP-REAL n, X
  being convex Subset of TOP-REAL n holds f.:X is convex;



reserve p, q for Point of TOP-REAL n;

definition
  let n be Nat;
  let p, q be Point of TOP-REAL n;
  func halfline(p,q) -> Subset of TOP-REAL n equals

  { (1-l)*p + l*q where l is Real: 0 <= l };
end;

theorem 
  for x being set holds x in halfline(p,q) iff ex l being real
  number st x = (1-l)*p + l*q & 0 <= l;

registration
  let n, p, q;
  cluster halfline(p,q) -> non empty;
end;

theorem 
  p in halfline(p,q);

theorem 
  q in halfline(p,q);

theorem 
  halfline(p,p) = {p};

theorem 
  x in halfline(p,q) implies halfline(p,x) c= halfline(p,q);

theorem 
  x in halfline(p,q) & x <> p implies halfline(p,q) = halfline(p,x);

theorem 
  LSeg(p,q) c= halfline(p,q);

registration
  let n, p, q;
  cluster halfline(p,q) -> convex;
end;

theorem 
  y in Sphere(x,r) & z in Ball(x,r) implies LSeg(y,z) /\ Sphere(x, r) = {y};

theorem 
  y in Sphere(x,r) & z in Sphere(x,r) implies LSeg(y,z) \ {y,z} c= Ball(x,r);

theorem 
  y in Sphere(x,r) & z in Sphere(x,r) implies LSeg(y,z) /\ Sphere( x,r) = {y,z}
;

theorem 
  y in Sphere(x,r) & z in Sphere(x,r) implies halfline(y,z) /\
  Sphere(x,r) = {y,z};

theorem 
  for S, T, X being Element of REAL n st S = y & T = z & X = x
holds y <> z & y in Ball(x,r) & a = (-(2*|(z-y,y-x)|) + sqrt delta (Sum sqr (T-
  S), 2 * |(z-y,y-x)|, Sum sqr (S-X) - r^2)) / (2 * Sum sqr (T-S)) implies ex e
being Point of TOP-REAL n st {e} = halfline(y,z) /\ Sphere(x,r) & e = (1-a)*y +
  a*z;

theorem 
  for S, T, Y being Element of REAL n st S = 1/2*y + 1/2*z & T = z
  & Y = x & y <> z & y in Sphere(x,r) & z in cl_Ball(x,r) ex e being Point of
TOP-REAL n st e <> y & {y,e} = halfline(y,z) /\ Sphere(x,r) & (z in Sphere(x,r)
implies e = z) & (not z in Sphere(x,r) & a = (-(2*|(z-(1/2*y + 1/2*z),1/2*y + 1
/2*z-x)|) + sqrt delta (Sum sqr (T-S), 2 * |(z-(1/2*y + 1/2*z),1/2*y + 1/2*z-x
)|, Sum sqr (S-Y) - r^2)) / (2 * Sum sqr (T-S)) implies e = (1-a)*(1/2*y + 1/2*
  z) + a*z);

registration
  let n be Nat, x be Point of TOP-REAL n;
  let r be negative real number;
  cluster Sphere(x,r) -> empty;
end;

registration
  let n be non empty Nat, x be Point of TOP-REAL n;
  let r be non negative real number;
  cluster Sphere(x,r) -> non empty;
end;

theorem 
  Sphere(x,r) is non empty implies r >= 0;

theorem 
  n is non empty & Sphere(x,r) is empty implies r < 0;

begin 

reserve s, t for Point of TOP-REAL 2;

theorem 
  (a*s + b*t)`1 = a * s`1 + b * t`1;

theorem 
  (a*s + b*t)`2 = a * s`2 + b * t`2;

theorem 
  t in circle(a,b,r) iff |. t - |[a,b]| .| = r;

theorem 
  t in closed_inside_of_circle(a,b,r) iff |. t - |[a,b]| .| <= r;

theorem 
  t in inside_of_circle(a,b,r) iff |. t - |[a,b]| .| < r;

registration
  let a, b be real number;
  let r be positive real number;
  cluster inside_of_circle(a,b,r) -> non empty;
end;

registration
  let a, b be real number;
  let r be non negative real number;
  cluster closed_inside_of_circle(a,b,r) -> non empty;
end;

theorem 
  circle(a,b,r) c= closed_inside_of_circle(a,b,r);

theorem 
  for x being Point of Euclid 2 st x = |[a,b]| holds cl_Ball(x,r)
  = closed_inside_of_circle(a,b,r);

theorem 
  for x being Point of Euclid 2 st x = |[a,b]| holds Ball(x,r) =
  inside_of_circle(a,b,r);

theorem 
  for x being Point of Euclid 2 st x = |[a,b]| holds Sphere(x,r) =
  circle(a,b,r);

theorem 
  Ball(|[a,b]|,r) = inside_of_circle(a,b,r);

theorem 
  cl_Ball(|[a,b]|,r) = closed_inside_of_circle(a,b,r);

theorem 
  Sphere(|[a,b]|,r) = circle(a,b,r);

theorem 
  inside_of_circle(a,b,r) c= closed_inside_of_circle(a,b,r);

theorem 
  inside_of_circle(a,b,r) misses circle(a,b,r);

theorem 
  inside_of_circle(a,b,r) \/ circle(a,b,r) = closed_inside_of_circle(a,b ,r);

theorem 
  s in Sphere(0.TOP-REAL 2,r) implies s`1^2 + s`2^2 = r^2;

theorem 
  s <> t & s in closed_inside_of_circle(a,b,r) & t in
  closed_inside_of_circle(a,b,r) implies r > 0;

theorem 
  for S, T, X being Element of REAL 2 st S = s & T = t & X = |[a,b]| & w
  = (-(2*|(t-s,s-|[a,b]|)|) + sqrt delta (Sum sqr (T-S), 2 * |(t-s,s-|[a,b]|)|,
Sum sqr (S-X) - r^2)) / (2 * Sum sqr (T-S)) & s <> t & s in inside_of_circle(a,
b,r) ex e being Point of TOP-REAL 2 st {e} = halfline(s,t) /\ circle(a,b,r) & e
  = (1-w)*s + w*t;

theorem 
  s in circle(a,b,r) & t in inside_of_circle(a,b,r) implies LSeg(s,t) /\
  circle(a,b,r) = {s};

theorem 
  s in circle(a,b,r) & t in circle(a,b,r) implies LSeg(s,t) \ {s,t} c=
  inside_of_circle(a,b,r);

theorem 
  s in circle(a,b,r) & t in circle(a,b,r) implies LSeg(s,t) /\ circle(a,
  b,r) = {s,t};

theorem 
  s in circle(a,b,r) & t in circle(a,b,r) implies halfline(s,t) /\
  circle(a,b,r) = {s,t};

theorem 
  for S, T, Y being Element of REAL 2 st S = 1/2*s + 1/2*t & T = t & Y =
|[a,b]| & s <> t & s in circle(a,b,r) & t in closed_inside_of_circle(a,b,r) ex
e being Point of TOP-REAL 2 st e <> s & {s,e} = halfline(s,t) /\ circle(a,b,r)
& (t in Sphere(|[a,b]|,r) implies e = t) & (not t in Sphere(|[a,b]|,r) & w = (-
(2*|(t-(1/2*s + 1/2*t),1/2*s + 1/2*t-|[a,b]|)|) + sqrt delta (Sum sqr (T-S), 2
* |(t-(1/2*s + 1/2*t),1/2*s + 1/2*t-|[a,b]|)|, Sum sqr (S-Y) - r^2)) / (2 * Sum
  sqr (T-S)) implies e = (1-w)*(1/2*s + 1/2*t) + w*t);

registration
  let a, b, r be real number;
  cluster inside_of_circle(a,b,r) -> convex;
  cluster closed_inside_of_circle(a,b,r) -> convex;
end;














begin

reserve i for Integer,
  a, b, r, s for real number;

registration
  let r be real number, s be positive real number;
  cluster ].r,r+s.[ -> non empty;
  cluster [.r,r+s.[ -> non empty;
  cluster ].r,r+s.] -> non empty;
  cluster [.r,r+s.] -> non empty;
  cluster ].r-s,r.[ -> non empty;
  cluster [.r-s,r.[ -> non empty;
  cluster ].r-s,r.] -> non empty;
  cluster [.r-s,r.] -> non empty;
end;

registration
  let r be non positive real number, s be positive real number;
  cluster ].r,s.[ -> non empty;
  cluster [.r,s.[ -> non empty;
  cluster ].r,s.] -> non empty;
  cluster [.r,s.] -> non empty;
end;

registration
  let r be negative real number, s be non negative real number;
  cluster ].r,s.[ -> non empty;
  cluster [.r,s.[ -> non empty;
  cluster ].r,s.] -> non empty;
  cluster [.r,s.] -> non empty;
end;

begin 

theorem 
  for f being Function, x, X being set st x in dom f & f.x in f.:X & f
  is one-to-one holds x in X;

theorem 
  for f being FinSequence, i being Nat st i+1 in dom f holds
  i in dom f or i = 0;

theorem 
  for x, y, X, Y being set, f being Function st x <> y & f in
  product ((x,y) --> (X,Y)) holds f.x in X & f.y in Y;

theorem 
  for a, b being set holds <*a,b*> = (1,2) --> (a,b);

begin 

registration
  cluster constituted-FinSeqs non empty strict for TopSpace;
end;

registration
  let T be constituted-FinSeqs TopSpace;
  cluster -> constituted-FinSeqs for SubSpace of T;
end;

theorem 
  for T being non empty TopSpace, Z being non empty SubSpace of T,
  t being Point of T, z being Point of Z, N being open a_neighborhood of t, M
being Subset of Z st t = z & M = N /\ [#]Z holds M is open a_neighborhood of z;

registration
  cluster empty -> discrete anti-discrete for TopSpace;
end;

registration
  let X be discrete TopSpace, Y be TopSpace;
  cluster -> continuous for Function of X,Y;
end;

theorem 
  for X being TopSpace, Y being TopStruct, f being Function of X,Y
  st f is empty holds f is continuous;

registration
  let X be TopSpace, Y be TopStruct;
  cluster empty -> continuous for Function of X,Y;
end;

theorem 
  for X being TopStruct, Y being non empty TopStruct, Z being non empty
  SubSpace of Y, f being Function of X,Z holds f is Function of X,Y;

theorem 
  for S, T being non empty TopSpace, X being Subset of S, Y being Subset
of T, f being continuous Function of S,T, g being Function of S|X,T|Y st g = f|
  X holds g is continuous;

theorem 
  for S, T being non empty TopSpace, Z being non empty SubSpace of T, f
being Function of S,T, g being Function of S,Z st f = g & f is open holds g is
  open;

theorem 
  for S, T being non empty TopSpace, S1 being Subset of S, T1 being
Subset of T, f being Function of S,T, g being Function of S|S1,T|T1 st g = f|S1
  & g is onto & f is open one-to-one holds g is open;

theorem 
  for X, Y, Z being non empty TopSpace, f being Function of X,Y, g being
  Function of Y,Z st f is open & g is open holds g*f is open;

theorem 
  for X, Y being TopSpace, Z being open SubSpace of Y, f being Function
  of X, Y, g being Function of X, Z st f = g & g is open holds f is open;

theorem 
  for S, T being non empty TopSpace, f being Function of S,T st f
  is one-to-one onto holds f is continuous iff f" is open;

theorem 
  for S, T being non empty TopSpace, f being Function of S,T st f is
  one-to-one onto holds f is open iff f" is continuous;

theorem 
  for S being TopSpace, T being non empty TopSpace holds S,T
  are_homeomorphic iff the TopStruct of S, the TopStruct of T are_homeomorphic;

theorem 
  for S, T being non empty TopSpace, f being Function of S,T st f is
  one-to-one onto continuous open holds f is being_homeomorphism;

begin 

theorem 
  for f being PartFunc of REAL,REAL st f = REAL --> r holds f|REAL is
  continuous;

theorem 
  for f, f1, f2 being PartFunc of REAL,REAL st dom f = dom f1 \/ dom f2
  & dom f1 is open & dom f2 is open & f1|dom f1 is continuous & f2|dom f2 is
  continuous & (for z being set st z in dom f1 holds f.z = f1.z) & (for z being
  set st z in dom f2 holds f.z = f2.z) holds f|dom f is continuous;

theorem 
  for x being Point of R^1, N being Subset of REAL, M being Subset
of R^1 st M = N holds N is Neighbourhood of x implies M is a_neighborhood of x;

theorem 
  for x being Point of R^1, M being a_neighborhood of x ex N being
  Neighbourhood of x st N c= M;

theorem 
  for f being Function of R^1,R^1, g being PartFunc of REAL,REAL,
x being Point of R^1 st f = g & g is_continuous_in x holds f is_continuous_at x
;

theorem 
  for f being Function of R^1,R^1, g being Function of REAL,REAL st f =
  g & g is continuous holds f is continuous;

theorem 
  a <= r & s <= b implies [.r,s.] is closed Subset of
  Closed-Interval-TSpace(a,b);

theorem 
  a <= r & s <= b implies ].r,s.[ is open Subset of Closed-Interval-TSpace(a,b)
;

theorem 
  a <= b & a <= r implies ].r,b.] is open Subset of Closed-Interval-TSpace(a,b)
;

theorem 
  a <= b & r <= b implies [.a,r.[ is open Subset of Closed-Interval-TSpace(a,b)
;

theorem 
  a <= b & r <= s implies the carrier of [:Closed-Interval-TSpace(
  a,b),Closed-Interval-TSpace(r,s):] = [: [.a,b.], [.r,s.] :];

begin 

theorem 
  |[a,b]| = (1,2) --> (a,b);

theorem 
  |[a,b]|.1 = a & |[a,b]|.2 = b;

theorem 
  closed_inside_of_rectangle(a,b,r,s) = product ((1,2)-->([.a,b.], [.r,s.]));

theorem 
  a <= b & r <= s implies |[a,r]| in closed_inside_of_rectangle(a, b,r,s);

definition
  let a, b, c, d be real number;
  func Trectangle(a,b,c,d) -> SubSpace of TOP-REAL 2 equals

  (TOP-REAL 2) |
  closed_inside_of_rectangle(a,b,c,d);
end;

theorem 
  a <= b & r <= s implies Trectangle(a,b,r,s) is non empty;

registration
  let a, c be non positive real number;
  let b, d be non negative real number;
  cluster Trectangle(a,b,c,d) -> non empty;
end;

definition
  func R2Homeomorphism -> Function of [:R^1,R^1:], TOP-REAL 2 means


  for x, y being real number holds it. [x,y] = <*x,y*>;
end;

theorem 
  for A, B being Subset of REAL holds R2Homeomorphism.:[:A,B:] =
  product ((1,2) --> (A,B));

theorem 
  R2Homeomorphism is being_homeomorphism;

theorem 
  a <= b & r <= s implies R2Homeomorphism | the carrier of [:
  Closed-Interval-TSpace(a,b),Closed-Interval-TSpace(r,s):] is Function of [:
Closed-Interval-TSpace(a,b),Closed-Interval-TSpace(r,s):], Trectangle(a,b,r,s);

theorem 
  a <= b & r <= s implies for h being Function of [:
Closed-Interval-TSpace(a,b),Closed-Interval-TSpace(r,s):], Trectangle(a,b,r,s)
  st h = R2Homeomorphism | the carrier of [:Closed-Interval-TSpace(a,b),
  Closed-Interval-TSpace(r,s):] holds h is being_homeomorphism;

theorem 
  a <= b & r <= s implies [:Closed-Interval-TSpace(a,b),
  Closed-Interval-TSpace(r,s):], Trectangle(a,b,r,s) are_homeomorphic;

theorem 
  a <= b & r <= s implies for A being Subset of
  Closed-Interval-TSpace(a,b), B being Subset of Closed-Interval-TSpace(r,s)
  holds product ((1,2)-->(A,B)) is Subset of Trectangle(a,b,r,s);

theorem 
  a <= b & r <= s implies for A being open Subset of
Closed-Interval-TSpace(a,b), B being open Subset of Closed-Interval-TSpace(r,s)
  holds product ((1,2)-->(A,B)) is open Subset of Trectangle(a,b,r,s);

theorem 
  a <= b & r <= s implies for A being closed Subset of
Closed-Interval-TSpace(a,b), B being closed Subset of Closed-Interval-TSpace(r,
  s) holds product ((1,2)-->(A,B)) is closed Subset of Trectangle(a,b,r,s);














begin

reserve n for Element of NAT,
  i for Integer,
  a, b, r for real number,
  x for Point of TOP-REAL n;

registration
  cluster ].0,1.[ -> non empty;
  cluster [.-1,1.] -> non empty;
  cluster ].1/2,3/2.[ -> non empty;
end;

registration
  cluster sin -> continuous;
  cluster cos -> continuous;
  cluster arcsin -> continuous;
  cluster arccos -> continuous;
end;

theorem 
  sin(a*r+b) = (sin*AffineMap(a,b)).r;

theorem 
  cos(a*r+b) = (cos*AffineMap(a,b)).r;

registration
  let a be non zero real number, b be real number;
  cluster AffineMap(a,b) -> onto one-to-one;
end;

definition
  let a, b be real number;
  func IntIntervals(a,b) equals

  { ]. a+n, b+n .[ where n is Element of INT:
  not contradiction };
end;

theorem 
  for x being set holds x in IntIntervals(a,b) iff ex n being Element of
  INT st x = ]. a+n, b+n .[;

registration
  let a, b be real number;
  cluster IntIntervals(a,b) -> non empty;
end;

theorem 
  b-a <= 1 implies IntIntervals(a,b) is mutually-disjoint;

definition
  let a, b be real number;
  redefine func IntIntervals(a,b) -> Subset-Family of R^1;
end;

definition
  let a, b be real number;
  redefine func IntIntervals(a,b) -> open Subset-Family of R^1;
end;

begin 

definition
  let r be real number;
  func R^1(r) -> Point of R^1 equals

  r;
end;

definition
  let A be Subset of REAL;
  func R^1(A) -> Subset of R^1 equals

  A;
end;

registration
  let A be non empty Subset of REAL;
  cluster R^1(A) -> non empty;
end;

registration
  let A be open Subset of REAL;
  cluster R^1(A) -> open;
end;

registration
  let A be closed Subset of REAL;
  cluster R^1(A) -> closed;
end;

registration
  let A be open Subset of REAL;
  cluster R^1 | R^1(A) -> open;
end;

registration
  let A be closed Subset of REAL;
  cluster R^1 | R^1(A) -> closed;
end;

definition
  let f be PartFunc of REAL,REAL;
  func R^1(f) -> Function of R^1 | R^1(dom f), R^1 | R^1(rng f) equals

  f;
end;

registration
  let f be PartFunc of REAL,REAL;
  cluster R^1(f) -> onto;
end;

registration
  let f be one-to-one PartFunc of REAL,REAL;
  cluster R^1(f) -> one-to-one;
end;

theorem 
  R^1 | (R^1 [#]REAL) = R^1;

theorem 
  for f being PartFunc of REAL,REAL st dom f = REAL holds R^1|(R^1 dom f) = R^1
;

theorem 
  for f being Function of REAL,REAL holds f is Function of R^1, R^1
  | R^1(rng f);

theorem 
  for f being Function of REAL,REAL holds f is Function of R^1, R^1;

registration
  let f be continuous PartFunc of REAL,REAL;
  cluster R^1(f) -> continuous;
end;

registration
  let a be non zero real number, b be real number;
  cluster R^1(AffineMap(a,b)) -> open;
end;

begin 

definition
  let S be SubSpace of TOP-REAL 2;
  attr S is being_simple_closed_curve means


  the carrier of S is Simple_closed_curve;
end;

registration
  cluster being_simple_closed_curve -> non empty pathwise_connected compact
    for SubSpace of TOP-REAL 2;
end;

registration
  let r be positive real number, x be Point of TOP-REAL 2;
  cluster Sphere(x,r) -> being_simple_closed_curve;
end;

definition
  let n be Nat, x be Point of TOP-REAL n, r be real number;
  func Tcircle(x,r) -> SubSpace of TOP-REAL n equals

  (TOP-REAL n) | Sphere(x,r);
end;

registration
  let n be non empty Nat, x be Point of TOP-REAL n,
  r be non negative real number;
  cluster Tcircle(x,r) -> strict non empty;
end;

theorem 
  the carrier of Tcircle(x,r) = Sphere(x,r);

registration
  let n be Nat, x be Point of TOP-REAL n, r be empty real number;
  cluster Tcircle(x,r) -> trivial;
end;

theorem 
  Tcircle(0.TOP-REAL 2,r) is SubSpace of Trectangle(-r,r,-r,r);

registration
  let x be Point of TOP-REAL 2, r be positive real number;
  cluster Tcircle(x,r) -> being_simple_closed_curve;
end;

registration
  cluster being_simple_closed_curve strict for SubSpace of TOP-REAL 2;
end;

theorem 
  for S, T being being_simple_closed_curve SubSpace of TOP-REAL 2 holds
  S,T are_homeomorphic;



definition
  let n be Nat;
  func Tunit_circle(n) -> SubSpace of TOP-REAL n equals

  Tcircle(0.TOP-REAL n,1);
end;

registration
  let n be non empty Nat;
  cluster Tunit_circle(n) -> non empty;
end;

theorem 
  for n being non empty Element of NAT, x being Point of TOP-REAL
  n holds x is Point of Tunit_circle(n) implies |. x .| = 1;

theorem 
  for x being Point of TOP-REAL 2 st x is Point of Tunit_circle(2)
  holds -1 <= x`1 & x`1 <= 1 & -1 <= x`2 & x`2 <= 1;

theorem 
  for x being Point of TOP-REAL 2 st x is Point of Tunit_circle(2)
  & x`1 = 1 holds x`2 = 0;

theorem 
  for x being Point of TOP-REAL 2 st x is Point of Tunit_circle(2)
  & x`1 = -1 holds x`2 = 0;

theorem 
  for x being Point of TOP-REAL 2 st x is Point of Tunit_circle(2) & x`2
  = 1 holds x`1 = 0;

theorem 
  for x being Point of TOP-REAL 2 st x is Point of Tunit_circle(2) & x`2
  = -1 holds x`1 = 0;

theorem 
  Tunit_circle(2) is SubSpace of Trectangle(-1,1,-1,1);

theorem 
  for n being non empty Element of NAT, r being positive real
  number, x being Point of TOP-REAL n, f being Function of Tunit_circle(n),
Tcircle(x,r) st for a being Point of Tunit_circle(n), b being Point of TOP-REAL
  n st a = b holds f.a = r*b+x holds f is being_homeomorphism;

registration
  cluster Tunit_circle(2) -> being_simple_closed_curve;
end;

theorem 
  for n being non empty Element of NAT, r, s being positive real number,
      x, y being Point of TOP-REAL n holds
  Tcircle(x,r), Tcircle(y,s) are_homeomorphic;

registration
  let x be Point of TOP-REAL 2, r be non negative real number;
  cluster Tcircle(x,r) -> pathwise_connected;
end;



definition
  func c[10] -> Point of Tunit_circle(2) equals

  |[1,0]|;
  func c[-10] -> Point of Tunit_circle(2) equals

  |[-1,0]|;
end;

definition
  let p be Point of Tunit_circle(2);
  func Topen_unit_circle(p) -> strict SubSpace of Tunit_circle(2) means



  the carrier of it = (the carrier of Tunit_circle(2)) \ {p};
end;

registration
  let p be Point of Tunit_circle(2);
  cluster Topen_unit_circle(p) -> non empty;
end;

theorem 
  for p being Point of Tunit_circle(2) holds p is not Point of
  Topen_unit_circle(p);

theorem 
  for p being Point of Tunit_circle(2) holds Topen_unit_circle(p)
  = (Tunit_circle(2)) | (([#]Tunit_circle(2)) \ {p});

theorem 
  for p, q being Point of Tunit_circle(2) st p <> q holds q is
  Point of Topen_unit_circle(p);

theorem 
  for p being Point of TOP-REAL 2 st p is Point of
  Topen_unit_circle(c[10]) & p`2 = 0 holds p = c[-10];

theorem 
  for p being Point of TOP-REAL 2 st p is Point of
  Topen_unit_circle(c[-10]) & p`2 = 0 holds p = c[10];

theorem 
  for p being Point of Tunit_circle(2), x being Point of TOP-REAL
2 st x is Point of Topen_unit_circle(p) holds -1 <= x`1 & x`1 <= 1 & -1 <= x`2
  & x`2 <= 1;

theorem 
  for x being Point of TOP-REAL 2 st x is Point of
  Topen_unit_circle(c[10]) holds -1 <= x`1 & x`1 < 1;

theorem 
  for x being Point of TOP-REAL 2 st x is Point of
  Topen_unit_circle(c[-10]) holds -1 < x`1 & x`1 <= 1;

registration
  let p be Point of Tunit_circle(2);
  cluster Topen_unit_circle(p) -> open;
end;

theorem 
  for p being Point of Tunit_circle(2) holds Topen_unit_circle(p), I(01)
  are_homeomorphic;

theorem 
  for p, q being Point of Tunit_circle(2) holds Topen_unit_circle(p),
  Topen_unit_circle(q) are_homeomorphic;

begin 

definition
  func CircleMap -> Function of R^1, Tunit_circle(2) means


  for x being real number holds it.x = |[ cos(2*PI*x), sin(2*PI*x) ]|;
end;

theorem 
  CircleMap.r = CircleMap.(r+i);

theorem 
  CircleMap.i = c[10];

theorem 
  CircleMap"{c[10]} = INT;

theorem 
  frac r = 1/2 implies CircleMap.r = |[-1,0]|;

theorem 
  frac r = 1/4 implies CircleMap.r = |[0,1]|;

theorem 
  frac r = 3/4 implies CircleMap.r = |[0,-1]|;

theorem 
  for i, j being Integer holds CircleMap.r = |[ (cos*AffineMap(2*PI,2*PI
  *i)).r, (sin*AffineMap(2*PI,2*PI*j)).r ]|;

registration
  cluster CircleMap -> continuous;
end;

theorem 
  for A being Subset of R^1, f being Function of R^1|A,
  Tunit_circle(2) st [.0,1.[ c= A & f = CircleMap | A holds f is onto;

registration
  cluster CircleMap -> onto;
end;

registration
  let r be real number;
  cluster CircleMap | [.r,r+1.[ -> one-to-one;
end;

registration
  let r be real number;
  cluster CircleMap | ].r,r+1.[ -> one-to-one;
end;

theorem 
  b-a <= 1 implies for d being set st d in IntIntervals(a,b) holds
  CircleMap|d is one-to-one;

theorem 
  for d being set st d in IntIntervals(a,b) holds CircleMap.:d =
  CircleMap.:union IntIntervals(a,b);

definition
  let r be Point of R^1;
  func CircleMap(r) -> Function of R^1 | R^1(].r,r+1.[), Topen_unit_circle(
  CircleMap.r) equals

  CircleMap | ].r,r+1.[;
end;

theorem 
  CircleMap(R^1(a+i)) = CircleMap(R^1(a)) * (AffineMap(1,-i) | ].a +i,a+i+1.[);

registration
  let r be Point of R^1;
  cluster CircleMap(r) -> one-to-one onto continuous;
end;

definition
  func Circle2IntervalR -> Function of Topen_unit_circle(c[10]), R^1 | R^1(].0
  ,1.[) means


  for p being Point of Topen_unit_circle(c[10]) ex x, y being
real number st p = |[x,y]| & (y >= 0 implies it.p = arccos x/(2*PI)) & (y <= 0
  implies it.p = 1-arccos x/(2*PI));
end;

definition
  func Circle2IntervalL -> Function of Topen_unit_circle(c[-10]), R^1 | R^1(].
  1/2,3/2.[) means


  for p being Point of Topen_unit_circle(c[-10]) ex x, y
being real number st p = |[x,y]| & (y >= 0 implies it.p = 1+arccos x/(2*PI)) &
  (y <= 0 implies it.p = 1-arccos x/(2*PI));
end;

theorem 
  (CircleMap(R^1(0)))" = Circle2IntervalR;

theorem 
  (CircleMap(R^1(1/2)))" = Circle2IntervalL;

registration
  cluster Circle2IntervalR -> one-to-one onto continuous;
  cluster Circle2IntervalL -> one-to-one onto continuous;
end;

registration
  let i be Integer;
  cluster CircleMap(R^1(i)) -> open;
  cluster CircleMap(R^1(1/2+i)) -> open;
end;

registration
  cluster Circle2IntervalR -> open;
  cluster Circle2IntervalL -> open;
end;

theorem 
  CircleMap(R^1(1/2)) is being_homeomorphism;

theorem 
  ex F being Subset-Family of Tunit_circle(2) st F = { CircleMap.:].0,1
.[, CircleMap.:].1/2,3/2.[ } & F is Cover of Tunit_circle(2) & F is open & for
U being Subset of Tunit_circle(2) holds ( U = CircleMap.:].0,1.[ implies union
  IntIntervals(0,1) = (CircleMap)"U & for d being Subset of R^1 st d in
IntIntervals(0,1) for f being Function of R^1 | d, (Tunit_circle(2)) | U st f =
  CircleMap|d holds f is being_homeomorphism ) & ( U = CircleMap.:].1/2,3/2.[
implies union IntIntervals(1/2,3/2) = (CircleMap)"U & for d being Subset of R^1
st d in IntIntervals(1/2,3/2) for f being Function of R^1 | d, (Tunit_circle(2)
  ) | U st f = CircleMap|d holds f is being_homeomorphism );














begin 

registration
  let X be non empty set;
  cluster [#]X -> non empty;
end;

registration
  cluster -> real-membered for SubSpace of RealSpace;
end;

theorem 
  for X being non empty bounded_below real-membered set, Y being
  closed Subset of REAL st X c= Y holds lower_bound X in Y;

theorem 
  for X being non empty bounded_above real-membered set, Y being
  closed Subset of REAL st X c= Y holds upper_bound X in Y;

theorem 
  for X, Y being Subset of REAL holds Cl(X \/ Y) = Cl X \/ Cl Y;

begin 

reserve a, b, r, s for real number;

registration
  let r be real number, s be ext-real number;
  cluster [.r,s.[ -> bounded_below;
  cluster ].s,r.] -> bounded_above;
end;

registration
  let r, s;
  cluster [.r,s.[ -> real-bounded;
  cluster ].r,s.] -> real-bounded;
  cluster ].r,s.[ -> real-bounded;
end;

registration
  cluster open real-bounded interval non empty for Subset of REAL;
end;

theorem 
  r < s implies lower_bound [.r,s.[ = r;

theorem 
  r < s implies upper_bound [.r,s.[ = s;

theorem 
  r < s implies lower_bound ].r,s.] = r;

theorem 
  r < s implies upper_bound ].r,s.] = s;

begin 

theorem 
  a <= b implies [.a,b.] /\ (left_closed_halfline(a) \/
  right_closed_halfline(b)) = {a,b};

registration
  let a;
  cluster left_closed_halfline(a) -> non bounded_below bounded_above interval;
  cluster left_open_halfline(a) -> non bounded_below bounded_above interval;
  cluster right_closed_halfline(a) -> bounded_below non bounded_above interval;
  cluster right_open_halfline(a) -> bounded_below non bounded_above interval;
end;

theorem 
  upper_bound left_closed_halfline(a) = a;

theorem 
  upper_bound left_open_halfline(a) = a;

theorem 
  lower_bound right_closed_halfline(a) = a;

theorem 
  lower_bound right_open_halfline(a) = a;

begin 

registration
  cluster [#]REAL -> interval non bounded_below non bounded_above;
end;

theorem 
  for X being real-bounded interval Subset of REAL st lower_bound X in
  X & upper_bound X in X holds X = [.lower_bound X,upper_bound X.];

theorem 
  for X being real-bounded Subset of REAL st not lower_bound X in X
  holds X c= ].lower_bound X,upper_bound X.];

theorem 
  for X being real-bounded interval Subset of REAL st not lower_bound
  X in X & upper_bound X in X holds X = ].lower_bound X,upper_bound X.];

theorem 
  for X being real-bounded Subset of REAL st not upper_bound X in X
  holds X c= [.lower_bound X,upper_bound X.[;

theorem 
  for X being real-bounded interval Subset of REAL st lower_bound X in
  X & not upper_bound X in X holds X = [.lower_bound X,upper_bound X.[;

theorem 
  for X being real-bounded Subset of REAL st not lower_bound X in X &
  not upper_bound X in X holds X c= ].lower_bound X,upper_bound X.[;

theorem 
  for X being non empty real-bounded interval Subset of REAL st not
  lower_bound X in X & not upper_bound X in X holds X = ].lower_bound X,
  upper_bound X.[;

theorem 
  for X being Subset of REAL st X is bounded_above holds X c=
  left_closed_halfline(upper_bound X);

theorem 
  for X being interval Subset of REAL st X is not bounded_below &
  X is bounded_above & upper_bound X in X holds X = left_closed_halfline(
  upper_bound X);

theorem 
  for X being Subset of REAL st X is bounded_above & not
  upper_bound X in X holds X c= left_open_halfline(upper_bound X);

theorem 
  for X being non empty interval Subset of REAL st X is not
  bounded_below & X is bounded_above & not upper_bound X in X holds X =
  left_open_halfline(upper_bound X);

theorem 
  for X being Subset of REAL st X is bounded_below holds X c=
  right_closed_halfline(lower_bound X);

theorem 
  for X being interval Subset of REAL st X is bounded_below & X
  is not bounded_above & lower_bound X in X holds X = right_closed_halfline(
  lower_bound X);

theorem 
  for X being Subset of REAL st X is bounded_below & not
  lower_bound X in X holds X c= right_open_halfline(lower_bound X);

theorem 
  for X being non empty interval Subset of REAL st X is
  bounded_below & X is not bounded_above & not lower_bound X in X holds X =
  right_open_halfline(lower_bound X);

theorem 
  for X being interval Subset of REAL st X is not bounded_above &
  X is not bounded_below holds X = REAL;

theorem 
  for X being interval Subset of REAL holds X is empty or X =
  REAL or (ex a st X = left_closed_halfline(a)) or (ex a st X =
left_open_halfline(a)) or (ex a st X = right_closed_halfline(a)) or (ex a st X
= right_open_halfline(a)) or (ex a, b st a <= b & X = [.a,b.]) or (ex a, b st a
< b & X = [.a,b.[) or (ex a, b st a < b & X = ].a,b.]) or ex a, b st a < b & X
  = ].a,b.[;

theorem 
  for X being non empty interval Subset of REAL st not r in X
  holds r <= lower_bound X or upper_bound X <= r;

theorem 
  for X, Y being non empty real-bounded interval Subset of REAL st
lower_bound X <= lower_bound Y & upper_bound Y <= upper_bound X & (lower_bound
  X = lower_bound Y & lower_bound Y in Y implies lower_bound X in X) & (
upper_bound X = upper_bound Y & upper_bound Y in Y implies upper_bound X in X)
  holds Y c= X;

registration
  cluster open closed interval non empty non real-bounded for Subset of REAL;
end;

begin 

theorem 
  for X being Subset of R^1 st a <= b & X = [.a,b.] holds Fr X = { a,b};

theorem 
  for X being Subset of R^1 st a < b & X = ].a,b.[ holds Fr X = {a,b};

theorem 
  for X being Subset of R^1 st a < b & X = [.a,b.[ holds Fr X = {a ,b};

theorem 
  for X being Subset of R^1 st a < b & X = ].a,b.] holds Fr X = {a ,b};

theorem 
  for X being Subset of R^1 st X = [.a,b.] holds Int X = ].a,b.[;

theorem 
  for X being Subset of R^1 st X = ].a,b.[ holds Int X = ].a,b.[;

theorem 
  for X being Subset of R^1 st X = [.a,b.[ holds Int X = ].a,b.[;

theorem 
  for X being Subset of R^1 st X = ].a,b.] holds Int X = ].a,b.[;

registration let T be real-membered TopStruct, X be interval Subset of T;
 cluster T|X -> interval;
end;

registration
  let A be interval Subset of REAL;
  cluster R^1(A) -> interval;
end;

registration
 cluster connected -> interval for Subset of R^1;
 cluster interval -> connected for Subset of R^1;
end;

begin 

registration
  let r;
  cluster Closed-Interval-TSpace(r,r) -> 1-element;
end;

theorem 
  r <= s implies for A being Subset of Closed-Interval-TSpace(r,s) holds
  A is real-bounded Subset of REAL;

theorem 
  r <= s implies for X being Subset of Closed-Interval-TSpace(r,s)
  st X = [.a,b.[ & r < a & b <= s holds Int X = ].a,b.[;

theorem 
  r <= s implies for X being Subset of Closed-Interval-TSpace(r,s)
  st X = ].a,b.] & r <= a & b < s holds Int X = ].a,b.[;

theorem 
  for X being Subset of Closed-Interval-TSpace(r,s), Y being
  Subset of REAL st X = Y holds X is connected iff Y is interval;

registration
  let T be TopSpace;
  cluster open closed connected for Subset of T;
end;

registration
  let T be non empty connected TopSpace;
  cluster non empty open closed connected for Subset of T;
end;

theorem 
  r <= s implies for X being open connected Subset of
Closed-Interval-TSpace(r,s) holds X is empty or X = [.r,s.] or (ex a being real
number st r < a & a <= s & X = [.r,a.[) or (ex a being real number st r <= a &
a < s & X = ].a,s.]) or ex a, b being real number st r <= a & a < b & b <= s &
  X = ].a,b.[;

begin

theorem 
  for T being 1-sorted, F being finite Subset-Family of T for F1
being Subset-Family of T st F is Cover of T & F1 = F \ {X where X is Subset of
T: X in F & ex Y being Subset of T st Y in F & X c< Y} holds F1 is Cover of T;

theorem 
  for S being 1-element 1-sorted, s being Point of S, F
  being Subset-Family of S st F is Cover of S holds {s} in F;

definition
  let T be TopStruct, F be Subset-Family of T;
  attr F is connected means


  for X being Subset of T st X in F holds X is connected;
end;

registration
  let T be TopSpace;
  cluster non empty open closed connected for Subset-Family of T;
end;

reserve n, m for Nat,
  F for Subset-Family of Closed-Interval-TSpace (r,s);

theorem 
  for L being TopSpace, G, G1 being Subset-Family of L st G is
Cover of L & G is finite for ALL being set st G1 = G \ {X where X is Subset of
L: X in G & ex Y being Subset of L st Y in G & X c< Y} & ALL = {C where C is
  Subset-Family of L: C is Cover of L & C c= G1} holds ALL
  has_lower_Zorn_property_wrt RelIncl ALL;

theorem 
  for L being TopSpace, G, ALL being set st ALL = {C where C is
  Subset-Family of L: C is Cover of L & C c= G} for M being set st M
is_minimal_in RelIncl ALL & M in field RelIncl ALL for A1 being Subset of L st
  A1 in M holds not ex A2, A3 being Subset of L st A2 in M & A3 in M & A1 c= A2
  \/ A3 & A1 <> A2 & A1 <> A3;

definition
  let r, s be real number;
  let F be Subset-Family of Closed-Interval-TSpace(r,s) such that
 F is Cover of Closed-Interval-TSpace(r,s) and
 F is open and
 F is connected and
 r <= s;
  mode IntervalCover of F -> FinSequence of bool REAL means


    rng it c= F
& union rng it = [.r,s.] & (for n being Nat st 1 <= n holds (n <=
len it implies it/.n is non empty) & (n+1 <= len it implies lower_bound(it/.n)
    <= lower_bound(it/.(n+1)) & upper_bound(it/.n) <= upper_bound(it/.(n+1)) &
    lower_bound(it/.(n+1)) < upper_bound(it/.n)) & (n+2 <= len it implies
upper_bound(it/.n) <= lower_bound(it/.(n+2)))) & ([.r,s.] in F implies it = <*
[.r,s.]*>) & (not [.r,s.] in F implies (ex p being real number st r < p & p <=
s & it.1 = [.r,p.[) & (ex p being real number st r <= p & p < s & it.len it =
].p,s.]) & for n being Nat st 1 < n & n < len it ex p, q being real
    number st r <= p & p < q & q <= s & it.n = ].p,q.[ );
end;

theorem 
  F is Cover of Closed-Interval-TSpace(r,s) & F is open connected & r <=
  s & [.r,s.] in F implies <*[.r,s.]*> is IntervalCover of F;

reserve C for IntervalCover of F;

theorem 
  for F being Subset-Family of Closed-Interval-TSpace(r,r), C
being IntervalCover of F holds F is Cover of Closed-Interval-TSpace(r,r) & F is
  open connected implies C = <*[.r,r.]*>;

theorem 
  F is Cover of Closed-Interval-TSpace(r,s) & F is open connected
  & r <= s implies 1 <= len C;

theorem 
  F is Cover of Closed-Interval-TSpace(r,s) & F is open connected
  & r <= s & len C = 1 implies C = <*[.r,s.]*>;

theorem 
  F is Cover of Closed-Interval-TSpace(r,s) & F is open connected & r <=
s & n in dom C & m in dom C & n < m implies lower_bound(C/.n) <= lower_bound(C
  /.m);

theorem 
  F is Cover of Closed-Interval-TSpace(r,s) & F is open connected & r <=
s & n in dom C & m in dom C & n < m implies upper_bound(C/.n) <= upper_bound(C
  /.m);

theorem 
  F is Cover of Closed-Interval-TSpace(r,s) & F is open connected
& r <= s & 1 <= n & n+1 <= len C implies ].lower_bound(C/.(n+1)),upper_bound(C
  /.n).[ is non empty;

theorem 
  F is Cover of Closed-Interval-TSpace(r,s) & F is open connected & r <=
  s implies lower_bound(C/.1) = r;

theorem 
  F is Cover of Closed-Interval-TSpace(r,s) & F is open connected
  & r <= s implies r in C/.1;

theorem 
  F is Cover of Closed-Interval-TSpace(r,s) & F is open connected & r <=
  s implies upper_bound(C/.len C) = s;

theorem 
  F is Cover of Closed-Interval-TSpace(r,s) & F is open connected
  & r <= s implies s in C/.len C;

definition
  let r, s be real number;
  let F be Subset-Family of Closed-Interval-TSpace(r,s), C be IntervalCover of
  F such that
 F is Cover of Closed-Interval-TSpace(r,s) & F is open & F is
  connected & r <= s;
  mode IntervalCoverPts of C -> FinSequence of REAL means


    len it = len
C + 1 & it.1 = r & it.len it = s & for n being Nat st 1 <= n & n+1 <
    len it holds it.(n+1) in ].lower_bound(C/.(n+1)),upper_bound(C/.n).[;
end;

reserve G for IntervalCoverPts of C;

theorem 
  F is Cover of Closed-Interval-TSpace(r,s) & F is open connected
  & r <= s implies 2 <= len G;

theorem 
  F is Cover of Closed-Interval-TSpace(r,s) & F is open connected
  & r <= s & len C = 1 implies G = <*r,s*>;

theorem 
  F is Cover of Closed-Interval-TSpace(r,s) & F is open connected
  & r <= s & 1 <= n & n+1 < len G implies G.(n+1) < upper_bound(C/.n);

theorem 
  F is Cover of Closed-Interval-TSpace(r,s) & F is open connected
  & r <= s & 1 < n & n <= len C implies lower_bound(C/.n) < G.n;

theorem 
  F is Cover of Closed-Interval-TSpace(r,s) & F is open connected
  & r <= s & 1 <= n & n < len C implies G.n <= lower_bound(C/.(n+1));

theorem 
  F is Cover of Closed-Interval-TSpace(r,s) & F is open connected
  & r < s implies G is increasing;

theorem 
  F is Cover of Closed-Interval-TSpace(r,s) & F is open connected & r <=
  s & 1 <= n & n < len G implies [.G.n,G.(n+1).] c= C.n;














begin

registration
  cluster INT.Group -> infinite;
end;

reserve a, r, s for real number;

theorem 
  r <= s implies for p being Point of Closed-Interval-MSpace(r,s)
holds Ball(p,a) = [.r,s.] or Ball(p,a) = [.r,p+a.[ or Ball(p,a) = ].p-a,s.] or
  Ball(p,a) = ].p-a,p+a.[;

theorem 
  r <= s implies ex B being Basis of Closed-Interval-TSpace(r,s) st
  (ex f being ManySortedSet of Closed-Interval-TSpace(r,s) st for y being Point
  of Closed-Interval-MSpace(r,s) holds f.y = {Ball(y,1/n) where n is Element of
NAT: n <> 0} & B = Union f) & for X being Subset of Closed-Interval-TSpace(r,s)
  st X in B holds X is connected;

theorem 
  for T being TopStruct, A being Subset of T, t be Point of T st t
  in A holds Component_of(t,A) c= A;

registration
  let T be TopSpace, A be open Subset of T;
  cluster T|A -> open;
end;

theorem 
  for T being TopSpace, S being SubSpace of T, A being Subset of T,
  B being Subset of S st A = B holds T|A = S|B;

theorem 
  for S, T being TopSpace, A, B being Subset of T, C, D being
  Subset of S st the TopStruct of S = the TopStruct of T & A = C & B = D & A,B
  are_separated holds C,D are_separated;

theorem 
  for S, T being TopSpace st the TopStruct of S = the TopStruct of T & S
  is connected holds T is connected;

theorem 
  for S, T being TopSpace, A being Subset of S, B being Subset of T
st the TopStruct of S = the TopStruct of T & A = B & A is connected holds B is
  connected;

theorem 
  for S, T being non empty TopSpace, s being Point of S, t being
  Point of T, A being a_neighborhood of s st the TopStruct of S = the TopStruct
  of T & s = t holds A is a_neighborhood of t;

theorem 
  for S, T being non empty TopSpace, A being Subset of S, B being Subset
of T, N being a_neighborhood of A st the TopStruct of S = the TopStruct of T &
  A = B holds N is a_neighborhood of B;

theorem 
  for S, T being non empty TopSpace, A, B being Subset of T, f
being Function of S,T st f is being_homeomorphism & A is_a_component_of B holds
  f"A is_a_component_of f"B;

begin 

theorem 
  for T being non empty TopSpace, S being non empty SubSpace of T,
  A being non empty Subset of T, B being non empty Subset of S st A = B & A is
  locally_connected holds B is locally_connected;

theorem 
  for S, T being non empty TopSpace st the TopStruct of S = the
  TopStruct of T & S is locally_connected holds T is locally_connected;

theorem 
  for T being non empty TopSpace holds T is locally_connected iff
  [#]T is locally_connected;

theorem 
  for T being non empty TopSpace, S being non empty open SubSpace
  of T st T is locally_connected holds S is locally_connected;

theorem 
  for S, T being non empty TopSpace st S,T are_homeomorphic & S is
  locally_connected holds T is locally_connected;

theorem 
  for T being non empty TopSpace st ex B being Basis of T st for X
  being Subset of T st X in B holds X is connected holds T is locally_connected
;

theorem 
  r <= s implies Closed-Interval-TSpace(r,s) is locally_connected;

registration
  cluster I[01] -> locally_connected;
end;

registration
  let A be non empty open Subset of I[01];
  cluster I[01] | A -> locally_connected;
end;

begin 

definition
  let r be real number;
  func ExtendInt(r) -> Function of I[01], R^1 means


  for x being Point of I[01] holds it.x = r*x;
end;

registration
  let r be real number;
  cluster ExtendInt(r) -> continuous;
end;

definition
  let r be real number;
  redefine func ExtendInt(r) -> Path of R^1(0),R^1(r);
end;

definition
  let S, T, Y be non empty TopSpace, H be Function of [:S,T:],Y, t be Point of
  T;
  func Prj1(t,H) -> Function of S,Y means


  for s being Point of S holds it.s = H.(s,t);
end;

definition
  let S, T, Y be non empty TopSpace, H be Function of [:S,T:],Y, s be Point of
  S;
  func Prj2(s,H) -> Function of T,Y means


  for t being Point of T holds it.t = H.(s,t);
end;

registration
  let S, T, Y be non empty TopSpace, H be continuous Function of [:S,T:],Y, t
  be Point of T;
  cluster Prj1(t,H) -> continuous;
end;

registration
  let S, T, Y be non empty TopSpace, H be continuous Function of [:S,T:],Y, s
  be Point of S;
  cluster Prj2(s,H) -> continuous;
end;

theorem 
  for T being non empty TopSpace, a, b being Point of T, P, Q being Path
  of a,b, H being Homotopy of P,Q, t being Point of I[01] st H is continuous
  holds Prj1(t,H) is continuous;

theorem 
  for T being non empty TopSpace, a, b being Point of T, P, Q being Path
  of a,b, H being Homotopy of P,Q, s being Point of I[01] st H is continuous
  holds Prj2(s,H) is continuous;

definition
  let r be real number;
  func cLoop(r) -> Function of I[01], Tunit_circle(2) means


  for x being Point of I[01] holds it.x = |[ cos(2*PI*r*x), sin(2*PI*r*x) ]|;
end;

theorem 
  cLoop(r) = CircleMap * ExtendInt(r);

definition
  let n be Integer;
  redefine func cLoop(n) -> Loop of c[10];
end;

begin

theorem 
  for UL being Subset-Family of Tunit_circle(2) st UL is Cover of
Tunit_circle(2) & UL is open for Y being non empty TopSpace, F being continuous
  Function of [:Y,I[01]:], Tunit_circle(2), y being Point of Y ex T being non
  empty FinSequence of REAL st T.1 = 0 & T.len T = 1 & T is increasing & ex N
being open Subset of Y st y in N & for i being Nat st i in dom T & i
+1 in dom T ex Ui being non empty Subset of Tunit_circle(2) st Ui in UL & F.:[:
  N,[.T.i,T.(i+1).]:] c= Ui;

theorem 
  for Y being non empty TopSpace, F being Function of [:Y,I[01]:],
  Tunit_circle(2), Ft being Function of [:Y,Sspace(0[01]):], R^1 st F is
continuous & Ft is continuous & F | [:the carrier of Y,{0}:] = CircleMap*Ft ex
G being Function of [:Y,I[01]:], R^1 st G is continuous & F = CircleMap*G & G |
  [:the carrier of Y,{0}:] = Ft & for H being Function of [:Y,I[01]:], R^1 st H
is continuous & F = CircleMap*H & H | [:the carrier of Y,{0}:] = Ft holds G = H
;

theorem 
  for x0, y0 being Point of Tunit_circle(2), xt being Point of R^1
, f being Path of x0,y0 st xt in (CircleMap)"{x0} ex ft being Function of I[01]
  , R^1 st ft.0 = xt & f = CircleMap*ft & ft is continuous & for f1 being
Function of I[01], R^1 st f1 is continuous & f = CircleMap*f1 & f1.0 = xt holds
  ft = f1;

theorem 
  for x0, y0 being Point of Tunit_circle(2), P, Q being Path of x0
  ,y0, F being Homotopy of P,Q, xt being Point of R^1 st P,Q are_homotopic & xt
  in (CircleMap)"{x0} ex yt being Point of R^1, Pt, Qt being Path of xt,yt, Ft
  being Homotopy of Pt,Qt st Pt,Qt are_homotopic & F = CircleMap*Ft & yt in (
CircleMap)"{y0} & for F1 being Homotopy of Pt,Qt st F = CircleMap*F1 holds Ft =
  F1;

definition
  func Ciso -> Function of INT.Group, pi_1(Tunit_circle(2),c[10]) means


for n being Integer holds it.n = Class(EqRel(Tunit_circle(2),c[10]),cLoop(n));
end;

theorem 
  for i being Integer, f being Path of R^1(0),R^1(i) holds Ciso.i
  = Class(EqRel(Tunit_circle(2),c[10]),CircleMap*f);

registration
  cluster Ciso -> multiplicative;
  end;

registration
  cluster Ciso -> one-to-one onto;
end;

theorem 
  Ciso is bijective;

theorem 
  for S being being_simple_closed_curve SubSpace of TOP-REAL 2, x
  being Point of S holds INT.Group, pi_1(S,x) are_isomorphic;

registration
  let S be being_simple_closed_curve SubSpace of TOP-REAL 2, x be Point of S;
  cluster pi_1(S,x) -> infinite;
end;














begin

reserve T for non empty TopSpace,
  f, g for continuous RealMap of T,
  r for real number;

registration
  let T, f, g;
  cluster f+g -> continuous for RealMap of T;
  cluster f-g -> continuous for RealMap of T;
  cluster f(#)g -> continuous for RealMap of T;
end;

registration
  let T, f;
  cluster -f -> continuous for RealMap of T;
end;

registration
  let T, f;
  cluster abs f -> continuous for RealMap of T;
end;

registration
  let T;
  cluster positive-yielding continuous for RealMap of T;
  cluster negative-yielding continuous for RealMap of T;
end;

registration
  let T;
  let f be nonnegative-yielding continuous RealMap of T;
  cluster sqrt f -> continuous for RealMap of T;
end;

registration
  let T, f, r;
  cluster r(#)f -> continuous for RealMap of T;
end;

registration
  let T;
  let f be non-empty continuous RealMap of T;
  cluster f^ -> continuous for RealMap of T;
end;

registration
  let T, f;
  let g be non-empty continuous RealMap of T;
  cluster f/g -> continuous for RealMap of T;
end;














begin

reserve n for Element of NAT,
  a, r for real number,
  x for Point of TOP-REAL n;

definition
  let S, T be non empty TopSpace;
  func DiffElems(S,T) -> Subset of [:S,T:] equals

  {[s,t] where s is Point of S, t is Point of T: s <> t};
end;

theorem 
  for S, T being non empty TopSpace, x being set holds x in DiffElems(S,
  T) iff ex s being Point of S, t being Point of T st x = [s,t] & s <> t;

registration
  let S be non trivial TopSpace;
  let T be non empty TopSpace;
  cluster DiffElems(S,T) -> non empty;
end;

registration
  let S be non empty TopSpace;
  let T be non trivial TopSpace;
  cluster DiffElems(S,T) -> non empty;
end;

theorem 
  cl_Ball(x,0) = {x};

definition
  let n be Element of NAT, x be Point of TOP-REAL n, r be real number;
  func Tdisk(x,r) -> SubSpace of TOP-REAL n equals

  (TOP-REAL n) | cl_Ball(x,r);
end;

registration
  let n be Element of NAT, x be Point of TOP-REAL n;
  let r be non negative real number;
  cluster Tdisk(x,r) -> non empty;
end;

theorem 
  the carrier of Tdisk(x,r) = cl_Ball(x,r);

registration
  let n be Element of NAT, x be Point of TOP-REAL n, r be real number;
  cluster Tdisk(x,r) -> convex;
end;

reserve n for Element of NAT,
  r for non negative real number,
  s, t, x for Point of TOP-REAL n;

theorem 
  s <> t & s is Point of Tdisk(x,r) & s is not Point of Tcircle(x,r
) implies ex e being Point of Tcircle(x,r) st {e} = halfline(s,t) /\ Sphere(x,r
  );

theorem 
  s <> t & s in the carrier of Tcircle(x,r) & t is Point of Tdisk(x
,r) implies ex e being Point of Tcircle(x,r) st e <> s & {s,e} = halfline(s,t)
  /\ Sphere(x,r);

definition
  let n be non empty Element of NAT, o be Point of TOP-REAL n, s, t be Point
  of TOP-REAL n, r be non negative real number;
  assume that
 s is Point of Tdisk(o,r) and
 t is Point of Tdisk(o,r) and
 s <> t;
  func HC(s,t,o,r) -> Point of TOP-REAL n means


  it in halfline(s,t) /\ Sphere(o,r) & it <> s;
end;

reserve n for non empty Element of NAT,
  s, t, o for Point of TOP-REAL n;

theorem 
  s is Point of Tdisk(o,r) & t is Point of Tdisk(o,r) & s <> t
  implies HC(s,t,o,r) is Point of Tcircle(o,r);

theorem 
  for S, T, O being Element of REAL n st S = s & T = t & O = o holds s
is Point of Tdisk(o,r) & t is Point of Tdisk(o,r) & s <> t & a = (-|(t-s,s-o)|
  + sqrt(|(t-s,s-o)|^2-(Sum sqr (T-S))*(Sum sqr (S-O)-r^2))) / Sum sqr (T-S)
  implies HC(s,t,o,r) = (1-a)*s+a*t;

theorem 
  for r1, r2, s1, s2 being real number, s, t, o being Point of
TOP-REAL 2 holds s is Point of Tdisk(o,r) & t is Point of Tdisk(o,r) & s <> t &
r1 = t`1-s`1 & r2 = t`2-s`2 & s1 = s`1-o`1 & s2 = s`2-o`2 & a = (-(s1*r1+s2*r2)
+sqrt((s1*r1+s2*r2)^2-(r1^2+r2^2)*(s1^2+s2^2-r^2))) / (r1^2+r2^2) implies HC(s,
  t,o,r) = |[ s`1+a*r1, s`2+a*r2 ]|;

definition
  let n be non empty Element of NAT, o be Point of TOP-REAL n, r be non
  negative real number;
  let x be Point of Tdisk(o,r);
  let f be Function of Tdisk(o,r), Tdisk(o,r) such that
 not x is_a_fixpoint_of f;
  func HC(x,f) -> Point of Tcircle(o,r) means


  ex y, z being Point of TOP-REAL n st y = x & z = f.x & it = HC(z,y,o,r);
end;

theorem 
  for x being Point of Tdisk(o,r), f being Function of Tdisk(o,r),
Tdisk(o,r) st not x is_a_fixpoint_of f & x is Point of Tcircle(o,r) holds HC(x,
  f) = x;

theorem 
  for r being positive real number, o being Point of TOP-REAL 2,
  Y being non empty SubSpace of Tdisk(o,r) st Y = Tcircle(o,r) holds not Y
  is_a_retract_of Tdisk(o,r);

definition
  let n be non empty Element of NAT;
  let r be non negative real number;
  let o be Point of TOP-REAL n;
  let f be Function of Tdisk(o,r), Tdisk(o,r);
  func BR-map(f) -> Function of Tdisk(o,r), Tcircle(o,r) means


  for x being Point of Tdisk(o,r) holds it.x = HC(x,f);
end;

theorem 
  for o being Point of TOP-REAL n, x being Point of Tdisk(o,r), f
  being Function of Tdisk(o,r), Tdisk(o,r) st not x is_a_fixpoint_of f & x is
  Point of Tcircle(o,r) holds (BR-map(f)).x = x;

theorem 
  for f being continuous Function of Tdisk(o,r), Tdisk(o,r) holds f
  is without_fixpoints implies (BR-map(f)) | Sphere(o,r) = id
Tcircle(o,r);

theorem 
  for r being positive real number, o being Point of TOP-REAL 2,
  f being continuous Function of Tdisk(o,r), Tdisk(o,r) holds
  f is without_fixpoints
  implies BR-map(f) is continuous;


theorem 
  for r being non negative real number, o being Point of
  TOP-REAL 2, f being continuous Function of Tdisk(o,r), Tdisk(o,r) holds f
  is with_fixpoint;


theorem 
  for r being non negative real number, o being Point of TOP-REAL 2, f
being continuous Function of Tdisk(o,r), Tdisk(o,r) ex x being Point of Tdisk(o
  ,r) st f.x = x;














begin

reserve r for real number,
  X for set,
  f, g, h for real-valued Function;

theorem 
  for a,b,c being real number st |.a-b.| <= c holds b-c <= a & a <= b+c;

theorem 
  f c= g implies h-f c= h-g;

theorem 
  f c= g implies f-h c= g-h;

definition
  let f be real-valued Function, r be real number, X be set;
  pred f,X is_absolutely_bounded_by r means


  for x being set st x in X /\ dom f holds abs(f.x) <= r;
end;

registration
  cluster summable constant convergent for Real_Sequence;
end;

theorem 
  for T1 being empty TopSpace, T2 being TopSpace for f being Function of
  T1,T2 holds f is continuous;

theorem 
  for f,g being summable Real_Sequence st for n being Element of NAT
  holds f.n <= g.n holds Sum f <= Sum g;

theorem 
  for f being Real_Sequence st f is absolutely_summable holds abs
  Sum f <= Sum abs f;

theorem 
  for f being Real_Sequence for a,r being positive real number st
  r < 1 & for n being Nat holds |.f.n-f.(n+1).| <= a*(r to_power n)
holds f is convergent & for n being Nat holds |.(lim f)-(f.n).| <= a
  *(r to_power n)/(1-r);

theorem 
  for f being Real_Sequence for a,r being positive real number st r <
1 & for n being Nat holds |.f.n-f.(n+1).| <= a*(r to_power n) holds
  lim f >= f.0-a/(1-r) & lim f <= f.0+a/(1-r);

theorem 
  for X,Z being non empty set for F being Functional_Sequence of X
,REAL st Z common_on_dom F for a,r being positive real number st r < 1 & for
  n being Nat holds (F.n)-(F.(n+1)), Z is_absolutely_bounded_by a*(r
to_power n) holds F is_unif_conv_on Z & for n being Nat holds lim(F,
  Z)-(F.n), Z is_absolutely_bounded_by a*(r to_power n)/(1-r);

theorem 
  for X,Z being non empty set for F being Functional_Sequence of X
,REAL st Z common_on_dom F for a,r being positive real number st r < 1 & for
  n being Nat holds (F.n)-(F.(n+1)), Z is_absolutely_bounded_by a*(r
to_power n) for z being Element of Z holds lim(F,Z).z >= F.0 .z-a/(1-r) & lim(F
  ,Z).z <= F.0 .z+a/(1-r);

theorem 
  for X,Z being non empty set for F being Functional_Sequence of X
  ,REAL st Z common_on_dom F for a,r being positive real number for f being
  Function of Z, REAL st r < 1 & for n being Nat holds (F.n)-f, Z
is_absolutely_bounded_by a*(r to_power n) holds F is_point_conv_on Z & lim(F,Z)
  = f;



registration
  let T be TopSpace, A be closed Subset of T;
  cluster T|A -> closed;
end;

theorem 
  for X, Y being non empty TopSpace, X1, X2 being non empty
  SubSpace of X for f1 being Function of X1,Y, f2 being Function of X2,Y st X1
misses X2 or f1|(X1 meet X2) = f2|(X1 meet X2) for x being Point of X holds (x
in the carrier of X1 implies (f1 union f2).x = f1.x) & (x in the carrier of X2
  implies (f1 union f2).x = f2.x);

theorem 
  for X, Y being non empty TopSpace, X1, X2 being non empty
  SubSpace of X for f1 being Function of X1,Y, f2 being Function of X2,Y st X1
  misses X2 or f1|(X1 meet X2) = f2|(X1 meet X2) holds rng (f1 union f2) c= rng
  f1 \/ rng f2;

theorem 
  for X, Y being non empty TopSpace, X1, X2 being non empty
  SubSpace of X for f1 being Function of X1,Y, f2 being Function of X2,Y st X1
misses X2 or f1|(X1 meet X2) = f2|(X1 meet X2) holds (for A being Subset of X1
holds (f1 union f2).:A = f1.:A) & for A being Subset of X2 holds (f1 union f2)
  .:A = f2.:A;

theorem 
  f c= g & g,X is_absolutely_bounded_by r implies f,X
  is_absolutely_bounded_by r;

theorem 
  (X c= dom f or dom g c= dom f) & f|X = g|X & f,X
  is_absolutely_bounded_by r implies g,X is_absolutely_bounded_by r;

reserve T for non empty TopSpace,
  A for closed Subset of T;

theorem 
  r > 0 & T is normal implies for f being continuous Function of T
|A, R^1 st f,A is_absolutely_bounded_by r ex g being continuous Function of T,
R^1 st g,dom g is_absolutely_bounded_by r/3 &
    f-g,A is_absolutely_bounded_by 2*r/3;



theorem 
  (for A, B being non empty closed Subset of T st A misses B ex f
  being continuous Function of T, R^1 st f.:A = {0} & f.:B = {1}) implies T is
  normal;

theorem 
  for f being Function of T,R^1, x being Point of T holds f
is_continuous_at x iff for e being real number st e>0 ex H being Subset of T st
  H is open & x in H & for y being Point of T st y in H holds abs(f.y-f.x)<e;

theorem 
  for F being Functional_Sequence of the carrier of T, REAL st F
  is_unif_conv_on the carrier of T & for i being Element of NAT holds F.i is
  continuous Function of T, R^1 holds lim(F, the carrier of T) is continuous
  Function of T, R^1;

theorem 
  for T being non empty TopSpace for f being Function of T, R^1
  for r being positive real number holds f, the carrier of T
is_absolutely_bounded_by r iff f is Function of T, Closed-Interval-TSpace(-r,r)
;

theorem 
  f-g, X is_absolutely_bounded_by r implies g-f, X is_absolutely_bounded_by r;




theorem 
  T is normal implies for A for f being Function of T|A,
Closed-Interval-TSpace(-1,1) st f is continuous ex g being continuous Function
  of T, Closed-Interval-TSpace(-1,1) st g|A = f;

theorem 
  (for A being non empty closed Subset of T for f being continuous
Function of T|A, Closed-Interval-TSpace(-1,1) ex g being continuous Function of
  T, Closed-Interval-TSpace(-1,1) st g|A = f) implies T is normal;














begin

reserve x, y for set;
reserve i, j, n for Element of NAT;
reserve p1, p2 for Point of TOP-REAL n;
reserve a, b, c, d for real number;

registration
  let a, b, c, d;
  cluster closed_inside_of_rectangle(a,b,c,d) -> convex;
end;

registration
  let a, b, c, d;
  cluster Trectangle(a,b,c,d) -> convex;
end;

theorem 
  for e being positive real number, g being continuous Function
  of I[01],TOP-REAL n ex h being FinSequence of REAL st h.1=0 & h.len h=1 & 5<=
len h & rng h c= the carrier of I[01] & h is increasing & (for i being Element
of NAT,Q being Subset of I[01], W being Subset of Euclid n st 1<=i & i<len h &
  Q=[.h/.i,h/.(i+1).] & W=g.:(Q) holds diameter(W)<e);

theorem 
  for P being Subset of TOP-REAL n st P c= LSeg(p1,p2) & p1 in P &
  p2 in P & P is connected holds P = LSeg(p1,p2);

theorem 
  for g being Path of p1,p2 st rng g c= LSeg(p1,p2) holds rng g = LSeg(p1,p2);



theorem 
  for P, Q being non empty Subset of TOP-REAL 2, p1, p2, q1, q2
being Point of TOP-REAL 2, f being Path of p1,p2, g being Path of q1,q2 st rng
f = P & rng g = Q & (for p being Point of TOP-REAL 2 st p in P holds p1`1<=p`1
& p`1<= p2`1) & (for p being Point of TOP-REAL 2 st p in Q holds p1`1<=p`1 & p
`1<= p2`1) & (for p being Point of TOP-REAL 2 st p in P holds q1`2<=p`2 & p`2<=
q2`2) & (for p being Point of TOP-REAL 2 st p in Q holds q1`2<=p`2 & p`2<= q2`2
  ) holds P meets Q;



theorem 
  for f,g being continuous Function of I[01],TOP-REAL 2, O,I being
Point of I[01] st O=0 & I=1 & (f.O)`1=a & (f.I)`1=b & (g.O)`2=c & (g.I)`2=d & (
for r being Point of I[01] holds a <=(f.r)`1 & (f.r)`1<=b & a <=(g.r)`1 & (g.r)
`1<=b & c <=(f.r)`2 & (f.r)`2<=d & c <=(g.r)`2 & (g.r)`2<=d) holds rng f meets
  rng g;

theorem 
  for ar, br, cr, dr being Point of Trectangle(a,b,c,d) for h being Path
of ar,br, v being Path of dr,cr for Ar, Br, Cr, Dr being Point of TOP-REAL 2 st
Ar`1 = a & Br`1 = b & Cr`2 = c & Dr`2 = d & ar = Ar & br = Br & cr = Cr & dr =
  Dr ex s, t being Point of I[01] st h.s = v.t;














begin

reserve p1, p2 for Point of TOP-REAL 2,
  C for Simple_closed_curve,
  P for Subset of TOP-REAL 2;

definition
  let n be Element of NAT, A be Subset of TOP-REAL n, a, b be Point of
  TOP-REAL n;
  pred a,b realize-max-dist-in A means


  a in A & b in A & for x, y being
  Point of TOP-REAL n st x in A & y in A holds dist(a,b) >= dist(x,y);
end;

theorem 
  for C being non empty compact Subset of TOP-REAL 2 ex p1,p2 st p1
  ,p2 realize-max-dist-in C;

definition
  let M be non empty MetrStruct;
  let f be Function of TopSpaceMetr M, TopSpaceMetr M;
  attr f is isometric means


  ex g being isometric Function of M,M st g=f;
end;

registration
  let M be non empty MetrStruct;
  cluster onto isometric for Function of TopSpaceMetr M, TopSpaceMetr M;
end;

registration
  let M be non empty MetrSpace;
  cluster isometric -> continuous for
Function of TopSpaceMetr M, TopSpaceMetr M;
end;

registration
  let M be non empty MetrSpace;
  cluster onto isometric -> being_homeomorphism for Function of TopSpaceMetr M,
    TopSpaceMetr M;
end;

definition
  let a be Real;
  func Rotate(a) -> Function of TOP-REAL 2,TOP-REAL 2 means


  for p being
Point of TOP-REAL 2 holds it.p = |[Re Rotate(p`1+(p`2)*<i>,a),Im Rotate(p`1+(p
  `2)*<i>,a)]|;
end;

theorem 
  for a being Real for f being Function of TopSpaceMetr Euclid 2,
  TopSpaceMetr Euclid 2 st f = Rotate a holds f is onto isometric;

theorem 
  for A,B,D being real number st p1,p2 realize-max-dist-in P holds
AffineMap(A,B,A,D).p1,AffineMap(A,B,A,D).p2 realize-max-dist-in AffineMap(A,B,A
  ,D).:P;

theorem 
  for A being Real st p1,p2 realize-max-dist-in P holds (Rotate A).
  p1,(Rotate A).p2 realize-max-dist-in (Rotate A).:P;

theorem 
  for z being complex number, r being Real holds Rotate(z,-r) =
  Rotate(z,2*PI-r);

theorem 
  for r being Real holds Rotate(-r) = Rotate(2*PI-r);

theorem 
  ex f being Homeomorphism of TOP-REAL 2 st |[-1,0]|,|[1,0]|
  realize-max-dist-in f.:C;

definition
  let T1,T2 be TopStruct;
  let f be Function of T1,T2;
  attr f is closed means

  for A being Subset of T1 st A is closed holds f.:A is closed;
end;




theorem 
  for X,Y being non empty TopSpace, f being continuous Function of X,Y
  st f is one-to-one onto holds f is being_homeomorphism iff f is closed;

theorem 
  for X being set, A being Subset of X holds A` = {} iff A = X;

theorem 
  for T1,T2 being non empty TopSpace, f being Function of T1,T2 st f is
  being_homeomorphism for A being Subset of T1 st A is connected holds f.:A is
  connected;

theorem 
  for T1,T2 being non empty TopSpace, f being Function of T1,T2 st
  f is being_homeomorphism for A being Subset of T1 st A is a_component
  holds f.:A is a_component;

theorem 
  for T1,T2 being non empty TopSpace, f being Function of T1,T2, A
  being Subset of T1 holds f|A is Function of T1|A, T2|(f.:A);

theorem 
  for T1,T2 being non empty TopSpace, f being Function of T1,T2 st
  f is continuous for A being Subset of T1, g being Function of T1|A, T2|(f.:A)
  st g = f|A holds g is continuous;

theorem 
  for T1,T2 being non empty TopSpace, f being Function of T1,T2 st
f is being_homeomorphism for A being Subset of T1, g being Function of T1|A, T2
  |(f.:A) st g = f|A holds g is being_homeomorphism;

theorem 
  for T1,T2 being non empty TopSpace, f being Function of T1,T2 st
  f is being_homeomorphism for A,B being Subset of T1 st A is_a_component_of B
  holds f.:A is_a_component_of f.:B;

theorem 
  for S being Subset of TOP-REAL 2, f being Homeomorphism of TOP-REAL 2
  st S is Jordan holds f.:S is Jordan;














begin 








reserve a, b, c, d, r, s for real number,
  n for Element of NAT,
  p, p1, p2 for Point of TOP-REAL 2,
  x, y for Point of TOP-REAL n,
  C for Simple_closed_curve,
  A, B, P for Subset of TOP-REAL 2,
  U, V for Subset of (TOP-REAL 2)|C`,
  D for compact with_the_max_arc Subset of TOP-REAL 2;

registration
  let M be symmetric triangle Reflexive MetrStruct, x, y be Point of M;
  cluster dist(x,y) -> non negative;
end;

registration
  let n be Element of NAT, x, y be Point of TOP-REAL n;
  cluster dist(x,y) -> non negative;
end;

theorem 
  for p1, p2 being Point of TOP-REAL n st p1 <> p2 holds 1/2*(p1+p2) <> p1;

theorem 
  p1`2 < p2`2 implies p1`2 < (1/2*(p1+p2))`2;

theorem 
  p1`2 < p2`2 implies (1/2*(p1+p2))`2 < p2`2;

theorem 
  for A being vertical Subset of TOP-REAL 2 holds A /\ B is vertical;

theorem 
  for A being horizontal Subset of TOP-REAL 2 holds A /\ B is horizontal;

theorem 
  p in LSeg(p1,p2) & LSeg(p1,p2) is vertical implies LSeg(p,p2) is vertical;

theorem 
  p in LSeg(p1,p2) & LSeg(p1,p2) is horizontal implies LSeg(p,p2) is horizontal
;

registration


  let P be Subset of TOP-REAL 2;
  cluster LSeg(SW-corner P,SE-corner P) -> horizontal;
  cluster LSeg(NW-corner P,SW-corner P) -> vertical;
  cluster LSeg(NE-corner P,SE-corner P) -> vertical;
end;

registration
  let P be Subset of TOP-REAL 2;
  cluster LSeg(SE-corner P,SW-corner P) -> horizontal;
  cluster LSeg(SW-corner P,NW-corner P) -> vertical;
  cluster LSeg(SE-corner P,NE-corner P) -> vertical;
end;

registration
  cluster vertical non empty compact -> with_the_max_arc for
Subset of TOP-REAL 2;
end;

theorem 
  p1`1 <= r & r <= p2`1 implies LSeg(p1,p2) meets Vertical_Line(r);

theorem 
  p1`2 <= r & r <= p2`2 implies LSeg(p1,p2) meets Horizontal_Line(r);

registration
  let n;
  cluster empty -> bounded for Subset of TOP-REAL n;
  cluster non bounded -> non empty for Subset of TOP-REAL n;
end;

registration
  let n be non empty Nat;
  cluster open closed non bounded convex for Subset of TOP-REAL n;
end;

theorem 
  for C being compact Subset of TOP-REAL 2 holds
  north_halfline UMP C \ {UMP C} misses C;

theorem 
  for C being compact Subset of TOP-REAL 2 holds
  south_halfline LMP C \ {LMP C} misses C;

theorem 
  for C being compact Subset of TOP-REAL 2 holds
  north_halfline UMP C \ {UMP C} c= UBD C;

theorem 
  for C being compact Subset of TOP-REAL 2 holds
  south_halfline LMP C \ {LMP C} c= UBD C;

theorem 
  A is_inside_component_of B implies UBD B misses A;

theorem 
  A is_outside_component_of B implies BDD B misses A;

theorem 
  for r being positive real number
  for a being Point of TOP-REAL n holds a in Ball(a,r);

theorem 
  for r being non negative real number
  for p being Point of TOP-REAL n holds p is Point of Tdisk(p,r);

registration
  let r be positive real number;
  let n be non empty Element of NAT;
  let p, q be Point of TOP-REAL n;
  cluster cl_Ball(p,r) \ {q} -> non empty;
end;

theorem 
  r <= s implies Ball(x,r) c= Ball(x,s);

theorem 
  cl_Ball(x,r) \ Ball(x,r) = Sphere(x,r);

theorem 
  y in Sphere(x,r) implies LSeg(x,y) \ {x,y} c= Ball(x,r);

theorem 
  r < s implies cl_Ball(x,r) c= Ball(x,s);

theorem 
  r < s implies Sphere(x,r) c= Ball(x,s);

theorem 
  for r being non zero real number holds Cl Ball(x,r) = cl_Ball(x,r);

theorem 
  for r being non zero real number holds Fr Ball(x,r) = Sphere(x,r);

registration
  let n be non empty Element of NAT;
  cluster bounded -> proper for Subset of TOP-REAL n;
end;

registration
  let n;
  cluster non empty closed convex bounded for Subset of TOP-REAL n;
  cluster non empty open convex bounded for Subset of TOP-REAL n;
end;

registration
  let n be Element of NAT;
  let A be bounded Subset of TOP-REAL n;
  cluster Cl A -> bounded;
end;

registration
  let n be Element of NAT;
  let A be bounded Subset of TOP-REAL n;
  cluster Fr A -> bounded;
end;

theorem 
  for A being closed Subset of TOP-REAL n, p being Point of TOP-REAL n st
  not p in A ex r being positive real number st Ball(p,r) misses A;

theorem 
  for A being bounded Subset of TOP-REAL n, a being Point of TOP-REAL n
  ex r being positive real number st A c= Ball(a,r);

theorem 
  for S, T being TopStruct, f being Function
  of S, T st f is being_homeomorphism holds f is onto;

registration
  let T be non empty T_2 TopSpace;
  cluster -> T_2 for non empty SubSpace of T;
end;

registration
  let p, r;
  cluster Tdisk(p,r) -> closed;
end;

registration
  let p, r;
  cluster Tdisk(p,r) -> compact;
end;

begin 

theorem 
  for T being non empty TopSpace, a, b being Point of T
  for f being Path of a,b st a,b are_connected holds rng f is connected;

theorem 
  for X being non empty TopSpace, Y being non empty SubSpace of X,
  x1, x2 being Point of X, y1, y2 being Point of Y,
  f being Path of x1,x2 st x1 = y1 & x2 = y2 & x1,x2 are_connected &
  rng f c= the carrier of Y holds y1,y2 are_connected & f is Path of y1,y2;

theorem 
  for X being pathwise_connected non empty TopSpace,
  Y being non empty SubSpace of X,
  x1, x2 being Point of X, y1, y2 being Point of Y,
  f being Path of x1,x2 st x1 = y1 & x2 = y2 & rng f c= the carrier of Y holds
  y1,y2 are_connected & f is Path of y1,y2;

theorem 
  for T being non empty TopSpace, a, b being Point of T
  for f being Path of a,b st a,b are_connected holds rng f = rng -f;

theorem 
  for T being pathwise_connected non empty TopSpace, a, b being Point of T
  for f being Path of a,b holds rng f = rng -f;

theorem 
  for T being non empty TopSpace, a, b, c being Point of T
  for f being Path of a,b, g being Path of b,c st
  a,b are_connected & b,c are_connected holds rng f c= rng(f+g);

theorem 
  for T being pathwise_connected non empty TopSpace, a, b, c being Point of T
  for f being Path of a,b, g being Path of b,c holds rng f c= rng(f+g);

theorem 
  for T being non empty TopSpace, a, b, c being Point of T
  for f being Path of b,c, g being Path of a,b st
  a,b are_connected & b,c are_connected holds rng f c= rng(g+f);

theorem 
  for T being pathwise_connected non empty TopSpace, a, b, c being Point of T
  for f being Path of b,c, g being Path of a,b holds rng f c= rng(g+f);

theorem 
  for T being non empty TopSpace, a, b, c being Point of T
  for f being Path of a,b, g being Path of b,c st
  a,b are_connected & b,c are_connected holds rng(f+g) = rng f \/ rng g;

theorem 
  for T being pathwise_connected non empty TopSpace, a, b, c being Point of T
  for f being Path of a,b, g being Path of b,c holds rng(f+g) = rng f \/ rng g;

theorem 
  for T being non empty TopSpace, a, b, c, d being Point of T
  for f being Path of a,b, g being Path of b,c, h being Path of c,d st
  a,b are_connected & b,c are_connected & c,d are_connected holds
  rng(f+g+h) = rng f \/ rng g \/ rng h;

theorem 
  for T being pathwise_connected non empty TopSpace,
      a, b, c, d being Point of T
  for f being Path of a,b, g being Path of b,c, h being Path of c,d
  holds rng(f+g+h) = rng f \/ rng g \/ rng h;

theorem 
  for T being non empty TopSpace, a being Point of T holds
  I[01] --> a is Path of a,a;

theorem 
  for p1, p2 being Point of TOP-REAL n, P being Subset of TOP-REAL n
  holds P is_an_arc_of p1,p2 implies
  ex F being Path of p1,p2, f being Function of I[01], (TOP-REAL n)|P st
  rng f = P & F = f;

theorem 
  for p1, p2 being Point of TOP-REAL n
  ex F being Path of p1,p2, f being Function
  of I[01], (TOP-REAL n)|LSeg(p1,p2) st rng f = LSeg(p1,p2) & F = f;

theorem 
  for p1,p2,q1,q2 being Point of TOP-REAL 2
  st P is_an_arc_of p1,p2 & q1 in P & q2 in P &
  q1 <> p1 & q1 <> p2 & q2 <> p1 & q2 <> p2
  ex f being Path of q1,q2 st rng f c= P & rng f misses {p1,p2};

begin 

theorem 
  a <= b & c <= d implies
  rectangle(a,b,c,d) c= closed_inside_of_rectangle(a,b,c,d);

theorem 
  inside_of_rectangle(a,b,c,d) c= closed_inside_of_rectangle(a,b,c,d);

theorem 
  closed_inside_of_rectangle(a,b,c,d) = outside_of_rectangle(a,b,c,d)`;

registration
  let a, b, c, d be real number;
  cluster closed_inside_of_rectangle(a,b,c,d) -> closed;
end;

theorem 
  closed_inside_of_rectangle(a,b,c,d) misses outside_of_rectangle(a,b,c,d);

theorem 
  closed_inside_of_rectangle(a,b,c,d) /\ inside_of_rectangle(a,b,c,d)
  = inside_of_rectangle(a,b,c,d);

theorem 
  a < b & c < d implies
  Int closed_inside_of_rectangle(a,b,c,d) = inside_of_rectangle(a,b,c,d);

theorem 
  a <= b & c <= d implies
  closed_inside_of_rectangle(a,b,c,d) \ inside_of_rectangle(a,b,c,d)
  = rectangle(a,b,c,d);

theorem 
  a < b & c < d implies
  Fr closed_inside_of_rectangle(a,b,c,d) = rectangle(a,b,c,d);

theorem 
  a <= b & c <= d implies W-bound closed_inside_of_rectangle(a,b,c,d) = a;

theorem 
  a <= b & c <= d implies S-bound closed_inside_of_rectangle(a,b,c,d) = c;

theorem 
  a <= b & c <= d implies E-bound closed_inside_of_rectangle(a,b,c,d) = b;

theorem 
  a <= b & c <= d implies N-bound closed_inside_of_rectangle(a,b,c,d) = d;

theorem 
  a < b & c < d & p1 in closed_inside_of_rectangle(a,b,c,d) &
  not p2 in closed_inside_of_rectangle(a,b,c,d) & P is_an_arc_of p1,p2 implies
  Segment(P,p1,p2,p1,First_Point(P,p1,p2,rectangle(a,b,c,d))) c=
  closed_inside_of_rectangle(a,b,c,d);

begin 

definition
  let S, T be non empty TopSpace, x be Point of [:S,T:];
  redefine func x`1 -> Element of S;
  redefine func x`2 -> Element of T;
end;

definition
  let o be Point of TOP-REAL 2;
  func diffX2_1(o) -> RealMap of [:TOP-REAL 2,TOP-REAL 2:] means


  for x being Point of [:TOP-REAL 2,TOP-REAL 2:] holds it.x = x`2`1 - o`1;
  func diffX2_2(o) -> RealMap of [:TOP-REAL 2,TOP-REAL 2:] means


  for x being Point of [:TOP-REAL 2,TOP-REAL 2:] holds it.x = x`2`2 - o`2;
end;

definition
  func diffX1_X2_1 -> RealMap of [:TOP-REAL 2, TOP-REAL 2:] means


  for x being Point of [:TOP-REAL 2, TOP-REAL 2:] holds it.x = x`1`1 - x`2`1;
  func diffX1_X2_2 -> RealMap of [:TOP-REAL 2, TOP-REAL 2:] means


  for x being Point of [:TOP-REAL 2, TOP-REAL 2:] holds it.x = x`1`2 - x`2`2;
  func Proj2_1 -> RealMap of [:TOP-REAL 2, TOP-REAL 2:] means


  for x being Point of [:TOP-REAL 2, TOP-REAL 2:] holds it.x = x`2`1;
  func Proj2_2 -> RealMap of [:TOP-REAL 2, TOP-REAL 2:] means


  for x being Point of [:TOP-REAL 2, TOP-REAL 2:] holds it.x = x`2`2;
end;

theorem 
  for o being Point of TOP-REAL 2 holds
  diffX2_1(o) is continuous Function of [:TOP-REAL 2, TOP-REAL 2:], R^1;

theorem 
  for o being Point of TOP-REAL 2 holds
  diffX2_2(o) is continuous Function of [:TOP-REAL 2, TOP-REAL 2:], R^1;

theorem 
  diffX1_X2_1 is continuous Function of [:TOP-REAL 2, TOP-REAL 2:], R^1;

theorem 
  diffX1_X2_2 is continuous Function of [:TOP-REAL 2, TOP-REAL 2:], R^1;

theorem 
  Proj2_1 is continuous Function of [:TOP-REAL 2, TOP-REAL 2:], R^1;

theorem 
  Proj2_2 is continuous Function of [:TOP-REAL 2, TOP-REAL 2:], R^1;

registration
  let o be Point of TOP-REAL 2;
  cluster diffX2_1(o) -> continuous;
  cluster diffX2_2(o) -> continuous;
end;

registration
  cluster diffX1_X2_1 -> continuous;
  cluster diffX1_X2_2 -> continuous;
  cluster Proj2_1 -> continuous;
  cluster Proj2_2 -> continuous;
end;

definition
  let n be non empty Element of NAT, o, p be Point of TOP-REAL n,
  r be positive real number such that
 p is Point of Tdisk(o,r);
  func DiskProj(o,r,p) -> Function
  of (TOP-REAL n)|(cl_Ball(o,r)\{p}), Tcircle(o,r) means


  for x being Point of (TOP-REAL n)|(cl_Ball(o,r)\{p})
  ex y being Point of TOP-REAL n st x = y & it.x = HC(p,y,o,r);
end;

theorem 
  for o, p being Point of TOP-REAL 2,
  r being positive real number st p is Point of Tdisk(o,r) holds
  DiskProj(o,r,p) is continuous;

theorem 
  for n being non empty Element of NAT, o, p being Point of TOP-REAL n,
  r being positive real number st p in Ball(o,r) holds
  DiskProj(o,r,p)|Sphere(o,r) = id Sphere(o,r);

definition
  let n be non empty Element of NAT, o, p be Point of TOP-REAL n,
  r be positive real number such that
 p in Ball(o,r);
  func RotateCircle(o,r,p) -> Function of Tcircle(o,r), Tcircle(o,r) means


  for x being Point of Tcircle(o,r)
  ex y being Point of TOP-REAL n st x = y & it.x = HC(y,p,o,r);
end;

theorem 
  for o, p being Point of TOP-REAL 2,
  r being positive real number st p in Ball(o,r) holds
  RotateCircle(o,r,p) is continuous;

theorem 
  for n being non empty Element of NAT for o, p being Point of TOP-REAL n,
  r being positive real number st p in Ball(o,r)
  holds RotateCircle(o,r,p) is without_fixpoints;

begin 

theorem 
  U = P & U is a_component &
  V is a_component & U <> V implies Cl P misses V;

theorem 
  U is a_component implies
  (TOP-REAL 2)|C`|U is pathwise_connected;

theorem 
  for h being Homeomorphism of TOP-REAL 2 holds
  h.:C is being_simple_closed_curve;

theorem 
  |[-1,0]|,|[1,0]| realize-max-dist-in P implies
  P c= closed_inside_of_rectangle(-1,1,-3,3);

theorem 
  |[-1,0]|,|[1,0]| realize-max-dist-in P implies
  P misses LSeg(|[-1,3]|,|[1,3]|);

theorem 
  |[-1,0]|,|[1,0]| realize-max-dist-in P implies
  P misses LSeg(|[-1,-3]|,|[1,-3]|);

theorem 
  |[-1,0]|,|[1,0]| realize-max-dist-in P implies
  P /\ rectangle(-1,1,-3,3) = {|[-1,0]|,|[1,0]|};

theorem 
  |[-1,0]|,|[1,0]| realize-max-dist-in P implies W-bound P = -1;

theorem 
  |[-1,0]|,|[1,0]| realize-max-dist-in P implies E-bound P = 1;

theorem 
  for P being compact Subset of TOP-REAL 2 holds
  |[-1,0]|,|[1,0]| realize-max-dist-in P implies W-most P = {|[-1,0]|};

theorem 
  for P being compact Subset of TOP-REAL 2 holds
  |[-1,0]|,|[1,0]| realize-max-dist-in P implies E-most P = {|[1,0]|};

theorem 
  for P being compact Subset of TOP-REAL 2 holds
  |[-1,0]|,|[1,0]| realize-max-dist-in P implies
  W-min P = |[-1,0]| & W-max P = |[-1,0]|;

theorem 
  for P being compact Subset of TOP-REAL 2 holds
  |[-1,0]|,|[1,0]| realize-max-dist-in P implies
  E-min P = |[1,0]| & E-max P = |[1,0]|;

theorem 
  |[-1,0]|,|[1,0]| realize-max-dist-in P implies
  LSeg(|[0,3]|,UMP P) is vertical;

theorem 
  |[-1,0]|,|[1,0]| realize-max-dist-in P implies
  LSeg(LMP P,|[0,-3]|) is vertical;

theorem 
  |[-1,0]|,|[1,0]| realize-max-dist-in P & p in P implies p`2 < 3;

theorem 
  |[-1,0]|,|[1,0]| realize-max-dist-in P & p in P implies -3 < p`2;

theorem 
  |[-1,0]|,|[1,0]| realize-max-dist-in D & p in LSeg(|[0,3]|,UMP D) implies
  (UMP D)`2 <= p`2;

theorem 
  |[-1,0]|,|[1,0]| realize-max-dist-in D & p in LSeg(LMP D,|[0,-3]|) implies
  p`2 <= (LMP D)`2;

theorem 
  |[-1,0]|,|[1,0]| realize-max-dist-in D implies
  LSeg(|[0,3]|,UMP D) c= north_halfline UMP D;

theorem 
  |[-1,0]|,|[1,0]| realize-max-dist-in D implies
  LSeg(LMP D,|[0,-3]|) c= south_halfline LMP D;

theorem 
  |[-1,0]|,|[1,0]| realize-max-dist-in C & P is_inside_component_of C implies
  LSeg(|[0,3]|,UMP C) misses P;

theorem 
  |[-1,0]|,|[1,0]| realize-max-dist-in C & P is_inside_component_of C implies
  LSeg(LMP C,|[0,-3]|) misses P;

theorem 
  |[-1,0]|,|[1,0]| realize-max-dist-in D implies
  LSeg(|[0,3]|,UMP D) /\ D = {UMP D};

theorem 
  |[-1,0]|,|[1,0]| realize-max-dist-in D implies
  LSeg(|[0,-3]|,LMP D) /\ D = {LMP D};

theorem 
  P is compact &
  |[-1,0]|,|[1,0]| realize-max-dist-in P & A is_inside_component_of P implies
  A c= closed_inside_of_rectangle(-1,1,-3,3);

theorem 
  |[-1,0]|,|[1,0]| realize-max-dist-in C implies LSeg(|[0,3]|,|[0,-3]|) meets C
;

theorem 
  |[-1,0]|,|[1,0]| realize-max-dist-in C implies
  for Jc, Jd being compact with_the_max_arc Subset of TOP-REAL 2 st
  Jc is_an_arc_of |[-1,0]|,|[1,0]| & Jd is_an_arc_of |[-1,0]|,|[1,0]| &
  C = Jc \/ Jd & Jc /\ Jd = {|[-1,0]|,|[1,0]|} & UMP C in Jc & LMP C in Jd &
  W-bound C = W-bound Jc & E-bound C = E-bound Jc
  for Ux being Subset of TOP-REAL 2 st Ux = Component_of Down ((1/2) *
  ((UMP (LSeg(LMP Jc,|[0,-3]|) /\ Jd)) + LMP Jc), C`)
  holds Ux is_inside_component_of C & for V being Subset of TOP-REAL 2 st
  V is_inside_component_of C holds V = Ux;

theorem 
  |[-1,0]|,|[1,0]| realize-max-dist-in C implies
  for Jc, Jd being compact with_the_max_arc Subset of TOP-REAL 2 st
  Jc is_an_arc_of |[-1,0]|,|[1,0]| & Jd is_an_arc_of |[-1,0]|,|[1,0]| &
  C = Jc \/ Jd & Jc /\ Jd = {|[-1,0]|,|[1,0]|} & UMP C in Jc & LMP C in Jd &
  W-bound C = W-bound Jc & E-bound C = E-bound Jc holds
  BDD C = Component_of Down ((1/2) *
  ((UMP (LSeg(LMP Jc,|[0,-3]|) /\ Jd)) + LMP Jc), C`);

registration 
  let C;
  cluster BDD C -> non empty;
end;

theorem 
  U = P & U is a_component implies C = Fr P;

theorem 
  for C being Simple_closed_curve ex A1, A2 being Subset of TOP-REAL 2 st
  C` = A1 \/ A2 & A1 misses A2 & (Cl A1) \ A1 = (Cl A2) \ A2 &
  for C1, C2 being Subset of (TOP-REAL 2)|C` st C1 = A1 & C2 = A2 holds
  C1 is a_component & C2 is a_component;


theorem 
  for C being Simple_closed_curve holds C is Jordan;














begin

reserve i,i1,i2,i9,i19,j,j1,j2,j9,j19,k,l,m,n for Element of NAT;
reserve r,s,r9,s9 for Real;
reserve D for set,
  f for FinSequence of D,
  G for Matrix of D;

theorem 
  <*>D is_sequence_on G;

theorem 
  for D being non empty set, f being FinSequence of D, G being Matrix of D
  st f is_sequence_on G holds f/^m is_sequence_on G;

theorem 
  1 <= k & k+1 <= len f & f is_sequence_on G
  implies ex i1,j1,i2,j2 being Element of NAT st
  [i1,j1] in Indices G & f/.k = G*(i1,j1) &
  [i2,j2] in Indices G & f/.(k+1) = G*(i2,j2) &
  (i1 = i2 & j1+1 = j2 or i1+1 = i2 & j1 = j2 or
  i1 = i2+1 & j1 = j2 or i1 = i2 & j1 = j2+1);

reserve G for Go-board,
  p for Point of TOP-REAL 2;

theorem 
  for f being non empty FinSequence of TOP-REAL 2 st f is_sequence_on G
  holds f is standard special;

theorem 
  for f being non empty FinSequence of TOP-REAL 2 st
  len f >= 2 & f is_sequence_on G holds f is non constant;

theorem 
  for f being non empty FinSequence of TOP-REAL 2 st f is_sequence_on G &
  (ex i,j being Element of NAT st [i,j] in Indices G & p = G*(i,j)) &
  (for i1,j1,i2,j2 st [i1,j1] in Indices G & [i2,j2] in Indices G &
  f/.len f = G*(i1,j1) & p = G*(i2,j2) holds abs(i2-i1)+abs(j2-j1) = 1)
  holds f^<*p*> is_sequence_on G;

theorem 
  i+k < len G & 1 <= j & j < width G & cell(G,i,j) meets cell(G,i+k,j)
  implies k <= 1;

theorem 
  for C being non empty compact Subset of TOP-REAL 2
  holds C is vertical iff E-bound C <= W-bound C;

theorem 
  for C being non empty compact Subset of TOP-REAL 2
  holds C is horizontal iff N-bound C <= S-bound C;

definition
  let C be Subset of TOP-REAL 2, n be Nat;
  func Gauge (C,n) -> Matrix of TOP-REAL 2 means


  len it = 2|^n + 3 & len it = width it &
  for i,j being Nat st [i,j] in Indices it holds
  it*(i,j) = |[(W-bound C)+(((E-bound C)-(W-bound C))/(2|^n))*(i-2),
  (S-bound C)+(((N-bound C)-(S-bound C))/(2|^n))*(j-2)]|;
end;

registration
  let C be non empty Subset of TOP-REAL 2, n be Nat;
  cluster Gauge (C,n) -> non empty-yielding X_equal-in-line Y_equal-in-column;
end;

registration
  let C be compact non vertical non horizontal non empty Subset of TOP-REAL 2,
  n be Nat;
  cluster Gauge (C,n) -> Y_increasing-in-line X_increasing-in-column;
end;

reserve T for non empty Subset of TOP-REAL 2;

theorem 
  for n being Nat holds len Gauge(T,n) >= 4;

theorem 
  1 <= j & j <= len Gauge(T,n) implies Gauge(T,n)*(2,j)`1 = W-bound T;

theorem 
  1 <= j & j <= len Gauge(T,n) implies
  Gauge(T,n)*(len Gauge(T,n)-'1,j)`1 = E-bound T;

theorem 
  1 <= i & i <= len Gauge(T,n) implies Gauge(T,n)*(i,2)`2 = S-bound T;

theorem 
  1 <= i & i <= len Gauge(T,n) implies
  Gauge(T,n)*(i,len Gauge(T,n)-'1)`2 = N-bound T;

reserve C for
  compact non vertical non horizontal non empty Subset of TOP-REAL 2;
reserve i, j, n for Nat;

theorem 
  i <= len Gauge(C,n) implies cell(Gauge(C,n),i,len Gauge(C,n)) misses C;

theorem 
  j <= len Gauge(C,n) implies cell(Gauge(C,n),len Gauge(C,n),j) misses C;

theorem 
  i <= len Gauge(C,n) implies cell(Gauge(C,n),i,0) misses C;

theorem 
  j <= len Gauge(C,n) implies cell(Gauge(C,n),0,j) misses C;














begin

reserve i,i1,i2,i9,i19,j,j1,j2,j9,j19,k,k1,k2,l,m,n for Element of NAT;
reserve r,s,r9,s9 for Real;
reserve D for non empty set, f for FinSequence of D;

definition
  let E be non empty set;
  let S be non empty FinSequenceSet of the carrier of TOP-REAL 2;
  let F be Function of E,S;
  let e be Element of E;
  redefine func F.e -> FinSequence of TOP-REAL 2;
end;

reserve f for FinSequence of TOP-REAL 2, G for Go-board;

canceled 7;

theorem 
  for G being Matrix of TOP-REAL 2 holds f is_sequence_on G implies rng
  f c= Values G;

theorem 
  for G1,G2 being Go-board st Values G1 c= Values G2 & [i1,j1] in
  Indices G1 & 1 <= j2 & j2 <= width G2 & G1*(i1,j1) = G2*(1,j2) holds i1 = 1;

theorem 
  for G1,G2 being Go-board st Values G1 c= Values G2 & [i1,j1] in
Indices G1 & 1 <= j2 & j2 <= width G2 & G1*(i1,j1) = G2*(len G2,j2) holds i1 =
  len G1;

theorem 
  for G1,G2 being Go-board st Values G1 c= Values G2 & [i1,j1] in
  Indices G1 & 1 <= i2 & i2 <= len G2 & G1*(i1,j1) = G2*(i2,1) holds j1 = 1;

theorem 
  for G1,G2 being Go-board st Values G1 c= Values G2 & [i1,j1] in
Indices G1 & 1 <= i2 & i2 <= len G2 & G1*(i1,j1) = G2*(i2,width G2) holds j1 =
  width G1;

theorem 
  for G1,G2 being Go-board st Values G1 c= Values G2 & 1 <= i1 &
  i1 < len G1 & 1 <= j1 & j1 <= width G1 & 1 <= i2 & i2 < len G2 & 1 <= j2 & j2
  <= width G2 & G1*(i1,j1) = G2*(i2,j2) holds G2*(i2+1,j2)`1 <= G1*(i1+1,j1)`1;

theorem 
  for G1,G2 being Go-board st G1*(i1-'1,j1) in Values G2 & 1 < i1
  & i1 <= len G1 & 1 <= j1 & j1 <= width G1 & 1 < i2 & i2 <= len G2 & 1 <= j2 &
j2 <= width G2 & G1*(i1,j1) = G2*(i2,j2) holds G1*(i1-'1,j1)`1 <= G2*(i2-'1,j2)
  `1;

theorem 
  for G1,G2 being Go-board st G1*(i1,j1+1) in Values G2 & 1 <= i1
  & i1 <= len G1 & 1 <= j1 & j1 < width G1 & 1 <= i2 & i2 <= len G2 & 1 <= j2 &
j2 < width G2 & G1*(i1,j1) = G2*(i2,j2) holds G2*(i2,j2+1)`2 <= G1*(i1,j1+1)`2;

theorem 
  for G1,G2 being Go-board st Values G1 c= Values G2 & 1 <= i1 &
  i1 <= len G1 & 1 < j1 & j1 <= width G1 & 1 <= i2 & i2 <= len G2 & 1 < j2 & j2
<= width G2 & G1*(i1,j1) = G2*(i2,j2) holds G1*(i1,j1-'1)`2 <= G2*(i2,j2-'1)`2;

theorem 
  for G1,G2 being Go-board st Values G1 c= Values G2 & [i1,j1] in
Indices G1 & [i2,j2] in Indices G2 & G1*(i1,j1) = G2*(i2,j2) holds cell(G2,i2,
  j2) c= cell(G1,i1,j1);

theorem 
  for G1,G2 being Go-board st Values G1 c= Values G2 & [i1,j1] in
Indices G1 & [i2,j2] in Indices G2 & G1*(i1,j1) = G2*(i2,j2) holds cell(G2,i2-'
  1,j2) c= cell(G1,i1-'1,j1);

theorem 
  for G1,G2 being Go-board st Values G1 c= Values G2 & [i1,j1] in
Indices G1 & [i2,j2] in Indices G2 & G1*(i1,j1) = G2*(i2,j2) holds cell(G2,i2,
  j2-'1) c= cell(G1,i1,j1-'1);

theorem 
  for f being standard special_circular_sequence st f
  is_sequence_on G holds Values GoB f c= Values G;

definition
 canceled;
  let f, G, k;
  assume 1 <= k & k+1 <= len f & f is_sequence_on G;
  func right_cell(f,k,G) -> Subset of TOP-REAL 2 means


  for i1,j1,i2,j2
being Element of NAT st [i1,j1] in Indices G & [i2,j2] in Indices G & f/.k = G*
  (i1,j1) & f/.(k+1) = G*(i2,j2) holds i1 = i2 & j1+1 = j2 & it = cell(G,i1,j1)
  or i1+1 = i2 & j1 = j2 & it = cell(G,i1,j1-'1) or i1 = i2+1 & j1 = j2 & it =
  cell(G,i2,j2) or i1 = i2 & j1 = j2+1 & it = cell(G,i1-'1,j2);
  func left_cell(f,k,G) -> Subset of TOP-REAL 2 means


  for i1,j1,i2,j2
being Element of NAT st [i1,j1] in Indices G & [i2,j2] in Indices G & f/.k = G*
(i1,j1) & f/.(k+1) = G*(i2,j2) holds i1 = i2 & j1+1 = j2 & it = cell(G,i1-'1,j1
  ) or i1+1 = i2 & j1 = j2 & it = cell(G,i1,j1) or i1 = i2+1 & j1 = j2 & it =
  cell(G,i2,j2-'1) or i1 = i2 & j1 = j2+1 & it = cell(G,i1,j2);
end;

theorem 
  1 <= k & k+1 <= len f & f is_sequence_on G & [i,j] in Indices G
  & [i,j+1] in Indices G & f/.k = G*(i,j) & f/.(k+1) = G*(i,j+1) implies
  left_cell(f,k,G) = cell(G,i-'1,j);

theorem 
  1 <= k & k+1 <= len f & f is_sequence_on G & [i,j] in Indices G
  & [i,j+1] in Indices G & f/.k = G*(i,j) & f/.(k+1) = G*(i,j+1) implies
  right_cell(f,k,G) = cell(G,i,j);

theorem 
  1 <= k & k+1 <= len f & f is_sequence_on G & [i,j] in Indices G
  & [i+1,j] in Indices G & f/.k = G*(i,j) & f/.(k+1) = G*(i+1,j) implies
  left_cell(f,k,G) = cell(G,i,j);

theorem 
  1 <= k & k+1 <= len f & f is_sequence_on G & [i,j] in Indices G
  & [i+1,j] in Indices G & f/.k = G*(i,j) & f/.(k+1) = G*(i+1,j) implies
  right_cell(f,k,G) = cell(G,i,j-'1);

theorem 
  1 <= k & k+1 <= len f & f is_sequence_on G & [i,j] in Indices G
  & [i+1,j] in Indices G & f/.k = G*(i+1,j) & f/.(k+1) = G*(i,j) implies
  left_cell(f,k,G) = cell(G,i,j-'1);

theorem 
  1 <= k & k+1 <= len f & f is_sequence_on G & [i,j] in Indices G
  & [i+1,j] in Indices G & f/.k = G*(i+1,j) & f/.(k+1) = G*(i,j) implies
  right_cell(f,k,G) = cell(G,i,j);

theorem 
  1 <= k & k+1 <= len f & f is_sequence_on G & [i,j+1] in Indices
  G & [i,j] in Indices G & f/.k = G*(i,j+1) & f/.(k+1) = G*(i,j) implies
  left_cell(f,k,G) = cell(G,i,j);

theorem 
  1 <= k & k+1 <= len f & f is_sequence_on G & [i,j+1] in Indices
  G & [i,j] in Indices G & f/.k = G*(i,j+1) & f/.(k+1) = G*(i,j) implies
  right_cell(f,k,G) = cell(G,i-'1,j);

theorem 
  1 <= k & k+1 <= len f & f is_sequence_on G implies left_cell(f,k,G) /\
  right_cell(f,k,G) = LSeg(f,k);

theorem 
  1 <= k & k+1 <= len f & f is_sequence_on G implies right_cell(f,k,G)
  is closed;

theorem 
  1 <= k & k+1 <= len f & f is_sequence_on G & k+1 <= n implies
left_cell(f,k,G) = left_cell(f|n,k,G) & right_cell(f,k,G) = right_cell(f|n,k,G)
;

theorem 
  1 <= k & k+1 <= len(f/^n) & n <= len f & f is_sequence_on G implies
left_cell(f,k+n,G) = left_cell(f/^n,k,G) & right_cell(f,k+n,G) = right_cell(f/^
  n,k,G);

theorem 
  for G being Go-board, f being standard special_circular_sequence st 1
<= n & n+1 <= len f & f is_sequence_on G holds left_cell(f,n,G) c= left_cell(f,
  n) & right_cell(f,n,G) c= right_cell(f,n);

definition
  let f,G,k;
  assume 1 <= k & k+1 <= len f & f is_sequence_on G;
  func front_right_cell(f,k,G) -> Subset of TOP-REAL 2 means


  for i1,j1,
i2,j2 being Element of NAT st [i1,j1] in Indices G & [i2,j2] in Indices G & f/.
k = G*(i1,j1) & f/.(k+1) = G*(i2,j2) holds i1 = i2 & j1+1 = j2 & it = cell(G,i2
,j2) or i1+1 = i2 & j1 = j2 & it = cell(G,i2,j2-'1) or i1 = i2+1 & j1 = j2 & it
  = cell(G,i2-'1,j2) or i1 = i2 & j1 = j2+1 & it = cell(G,i2-'1,j2-'1);
  func front_left_cell(f,k,G) -> Subset of TOP-REAL 2 means


  for i1,j1,
i2,j2 being Element of NAT st [i1,j1] in Indices G & [i2,j2] in Indices G & f/.
k = G*(i1,j1) & f/.(k+1) = G*(i2,j2) holds i1 = i2 & j1+1 = j2 & it = cell(G,i2
-'1,j2) or i1+1 = i2 & j1 = j2 & it = cell(G,i2,j2) or i1 = i2+1 & j1 = j2 & it
  = cell(G,i2-'1,j2-'1) or i1 = i2 & j1 = j2+1 & it = cell(G,i2,j2-'1);
end;

theorem 
  1 <= k & k+1 <= len f & f is_sequence_on G & [i,j] in Indices G & [i,j
  +1] in Indices G & f/.k = G*(i,j) & f/.(k+1) = G*(i,j+1) implies
  front_left_cell(f,k,G) = cell(G,i-'1,j+1);

theorem 
  1 <= k & k+1 <= len f & f is_sequence_on G & [i,j] in Indices G & [i,j
  +1] in Indices G & f/.k = G*(i,j) & f/.(k+1) = G*(i,j+1) implies
  front_right_cell(f,k,G) = cell(G,i,j+1);

theorem 
  1 <= k & k+1 <= len f & f is_sequence_on G & [i,j] in Indices G & [i+1
  ,j] in Indices G & f/.k = G*(i,j) & f/.(k+1) = G*(i+1,j) implies
  front_left_cell(f,k,G) = cell(G,i+1,j);

theorem 
  1 <= k & k+1 <= len f & f is_sequence_on G & [i,j] in Indices G & [i+1
  ,j] in Indices G & f/.k = G*(i,j) & f/.(k+1) = G*(i+1,j) implies
  front_right_cell(f,k,G) = cell(G,i+1,j-'1);

theorem 
  1 <= k & k+1 <= len f & f is_sequence_on G & [i,j] in Indices G & [i+1
  ,j] in Indices G & f/.k = G*(i+1,j) & f/.(k+1) = G*(i,j) implies
  front_left_cell(f,k,G) = cell(G,i-'1,j-'1);

theorem 
  1 <= k & k+1 <= len f & f is_sequence_on G & [i,j] in Indices G & [i+1
  ,j] in Indices G & f/.k = G*(i+1,j) & f/.(k+1) = G*(i,j) implies
  front_right_cell(f,k,G) = cell(G,i-'1,j);

theorem 
  1 <= k & k+1 <= len f & f is_sequence_on G & [i,j+1] in Indices G & [i
  ,j] in Indices G & f/.k = G*(i,j+1) & f/.(k+1) = G*(i,j) implies
  front_left_cell(f,k,G) = cell(G,i,j-'1);

theorem 
  1 <= k & k+1 <= len f & f is_sequence_on G & [i,j+1] in Indices G & [i
  ,j] in Indices G & f/.k = G*(i,j+1) & f/.(k+1) = G*(i,j) implies
  front_right_cell(f,k,G) = cell(G,i-'1,j-'1);

theorem 
  1 <= k & k+1 <= len f & f is_sequence_on G & k+1 <= n implies
  front_left_cell(f,k,G) = front_left_cell(f|n,k,G) & front_right_cell(f,k,G) =
  front_right_cell(f|n,k,G);

definition
  let D be set;
  let f be FinSequence of D, G be (Matrix of D), k;
  pred f turns_right k,G means


  for i1,j1,i2,j2 being Element of NAT st
[i1,j1] in Indices G & [i2,j2] in Indices G & f/.k = G*(i1,j1) & f/.(k+1) = G*(
i2,j2) holds i1 = i2 & j1+1 = j2 & [i2+1,j2] in Indices G & f/.(k+2) = G*(i2+1,
j2) or i1+1 = i2 & j1 = j2 & [i2,j2-'1] in Indices G & f/.(k+2) = G* (i2,j2-'1)
or i1 = i2+1 & j1 = j2 & [i2,j2+1] in Indices G & f/.(k+2) = G*(i2,j2+1) or i1
  = i2 & j1 = j2+1 & [i2-'1,j2] in Indices G & f/.(k+2) = G*(i2-'1,j2);
  pred f turns_left k,G means


  for i1,j1,i2,j2 being Element of NAT st [
i1,j1] in Indices G & [i2,j2] in Indices G & f/.k = G*(i1,j1) & f/.(k+1) = G*(
i2,j2) holds i1 = i2 & j1+1 = j2 & [i2-'1,j2] in Indices G & f/.(k+2) = G* (i2
-'1,j2) or i1+1 = i2 & j1 = j2 & [i2,j2+1] in Indices G & f/.(k+2) = G*(i2,j2+1
  ) or i1 = i2+1 & j1 = j2 & [i2,j2-'1] in Indices G & f/.(k+2) = G* (i2,j2-'1)
  or i1 = i2 & j1 = j2+1 & [i2+1,j2] in Indices G & f/.(k+2) = G*(i2+1,j2);
  pred f goes_straight k,G means


  for i1,j1,i2,j2 being Element of NAT
st [i1,j1] in Indices G & [i2,j2] in Indices G & f/.k = G*(i1,j1) & f/.(k+1) =
G*(i2,j2) holds i1 = i2 & j1+1 = j2 & [i2,j2+1] in Indices G & f/.(k+2) = G*(i2
,j2+1) or i1+1 = i2 & j1 = j2 & [i2+1,j2] in Indices G & f/.(k+2) = G*(i2+1,j2)
or i1 = i2+1 & j1 = j2 & [i2-'1,j2] in Indices G & f/.(k+2) = G* (i2-'1,j2) or
  i1 = i2 & j1 = j2+1 & [i2,j2-'1] in Indices G & f/.(k+2) = G*(i2,j2-'1);
end;

reserve D for set,
  f,f1,f2 for FinSequence of D,
  G for Matrix of D;

theorem 
  1 <= k & k+2 <= n & f|n turns_right k,G implies f turns_right k,G;

theorem 
  1 <= k & k+2 <= n & f|n turns_left k,G implies f turns_left k,G;

theorem 
  1 <= k & k+2 <= n & f|n goes_straight k,G implies f goes_straight k,G;

theorem 
  1 < k & k+1 <= len f1 & k+1 <= len f2 & f1 is_sequence_on G & f1|k =
f2|k & f1 turns_right k-'1,G & f2 turns_right k-'1,G implies f1|(k+1) = f2|(k+1
  );

theorem 
  1 < k & k+1 <= len f1 & k+1 <= len f2 & f1 is_sequence_on G & f1|k =
f2|k & f1 turns_left k-'1,G & f2 turns_left k-'1,G implies f1|(k+1) = f2|(k+1);

theorem 
  1 < k & k+1 <= len f1 & k+1 <= len f2 & f1 is_sequence_on G & f1|k =
f2|k & f1 goes_straight k-'1,G & f2 goes_straight k-'1,G implies f1|(k+1) = f2|
  (k+1);















begin  

reserve i, j, n for Element of NAT,
  f for non constant standard special_circular_sequence,
  g for clockwise_oriented non constant standard special_circular_sequence,
  p, q for Point of TOP-REAL 2,
  P for Subset of TOP-REAL 2,
  C for compact non vertical non horizontal Subset of TOP-REAL 2,
  G for Go-board;

theorem 
  for p being Point of Euclid 2 st p = 0.REAL 2 & P
  is_outside_component_of L~f ex r being Real st r > 0 & Ball(p,r)` c= P;

begin  

theorem 
  for f being FinSequence of TOP-REAL n st L~f <> {} holds 2 <= len f;

theorem 
  1 <= i & i < len G & 1 <= j & j < width G implies cell(G,i,j) =
  product ((1,2) --> ([.G*(i,1)`1,G*(i+1,1)`1.],[.G*(1,j)`2,G*(1,j+1)`2.]));

theorem 
  1 <= i & i < len G & 1 <= j & j < width G implies cell(G,i,j) is compact;

theorem 
  [i,j] in Indices G & [i+n,j] in Indices G implies dist(G*(i,j),G*(i+n,
  j)) = G*(i+n,j)`1 - G*(i,j)`1;

theorem 
  [i,j] in Indices G & [i,j+n] in Indices G implies dist(G*(i,j),G*(i,j+
  n)) = G*(i,j+n)`2 - G*(i,j)`2;

theorem 
  3 <= len Gauge(C,n)-'1;

theorem 
  i <= j implies for a, b being Element of NAT st 2 <= a & a <= len
Gauge(C,i) - 1 & 2 <= b & b <= len Gauge(C,i) - 1 ex c, d being Element of NAT
st 2 <= c & c <= len Gauge(C,j) - 1 & 2 <= d & d <= len Gauge(C,j) - 1 & [c,d]
in Indices Gauge(C,j) & Gauge(C,i)*(a,b) = Gauge(C,j)*(c,d) & c = 2 + 2|^(j-'i)
  *(a-'2) & d = 2 + 2|^(j-'i)*(b-'2);

theorem 
  [i,j] in Indices Gauge(C,n) & [i,j+1] in Indices Gauge(C,n)
implies dist(Gauge(C,n)*(i,j),Gauge(C,n)*(i,j+1)) = (N-bound C - S-bound C)/2|^
  n;

theorem 
  [i,j] in Indices Gauge(C,n) & [i+1,j] in Indices Gauge(C,n)
implies dist(Gauge(C,n)*(i,j),Gauge(C,n)*(i+1,j)) = (E-bound C - W-bound C)/2|^
  n;

theorem 
  for r, t being real number holds r > 0 & t > 0 implies ex n being
  Element of NAT st 1 < n & dist(Gauge(C,n)*(1,1),Gauge(C,n)*(1,2)) < r & dist(
  Gauge(C,n)*(1,1),Gauge(C,n)*(2,1)) < t;

begin  

theorem 
  for P being Subset of (TOP-REAL 2)|(L~f)` st P is a_component
  holds P = RightComp f or P = LeftComp f;

theorem 
  for A1, A2 being Subset of TOP-REAL 2 st (L~f)` = A1 \/ A2 & A1 misses
A2 & for C1, C2 being Subset of (TOP-REAL 2)|(L~f)` st C1 = A1 & C2 = A2 holds
C1 is a_component & C2 is a_component
holds A1 = RightComp f & A2 = LeftComp f or A1 = LeftComp f & A2 =
  RightComp f;

theorem 
  LeftComp f misses RightComp f;

theorem 
  L~f \/ RightComp f \/ LeftComp f = the carrier of TOP-REAL 2;

theorem 
  p in L~f iff not p in LeftComp f & not p in RightComp f;

theorem 
  p in LeftComp f iff not p in L~f & not p in RightComp f;

theorem 
  p in RightComp f iff not p in L~f & not p in LeftComp f;

theorem 
  L~f = (Cl RightComp f) \ RightComp f;

theorem 
  L~f = (Cl LeftComp f) \ LeftComp f;

theorem 
  Cl RightComp f = (RightComp f) \/ L~f;

theorem 
  Cl LeftComp f = (LeftComp f) \/ L~f;

registration
  let f be non constant standard special_circular_sequence;
  cluster L~f -> Jordan;
end;

reserve f for clockwise_oriented non constant standard
  special_circular_sequence;

theorem 
  p in RightComp f implies W-bound L~f < p`1;

theorem 
  p in RightComp f implies E-bound L~f > p`1;

theorem 
  p in RightComp f implies N-bound L~f > p`2;

theorem 
  p in RightComp f implies S-bound L~f < p`2;

theorem 
  p in RightComp f & q in LeftComp f implies LSeg(p,q) meets L~f;

theorem 
  Cl RightComp SpStSeq C = product((1,2)-->([.W-bound L~SpStSeq C,
  E-bound L~SpStSeq C.], [.S-bound L~SpStSeq C,N-bound L~SpStSeq C.]));

theorem 
  proj1.:(Cl RightComp f) = proj1.:(L~f);

theorem 
  proj2.:(Cl RightComp f) = proj2.:(L~f);

theorem 
  RightComp g c= RightComp SpStSeq L~g;

theorem 
  Cl RightComp g is compact;

theorem 
  LeftComp g is non bounded;

theorem 
  LeftComp g is_outside_component_of L~g;

theorem 
  RightComp g is_inside_component_of L~g;

theorem 
  UBD L~g = LeftComp g;

theorem 
  BDD L~g = RightComp g;

theorem 
  P is_outside_component_of L~g implies P = LeftComp g;

theorem 
  P is_inside_component_of L~g implies P meets RightComp g;

theorem 
  P is_inside_component_of L~g implies P = BDD L~g;

theorem 
  W-bound L~g = W-bound RightComp g;

theorem 
  E-bound L~g = E-bound RightComp g;

theorem 
  N-bound L~g = N-bound RightComp g;

theorem 
  S-bound L~g = S-bound RightComp g;














begin

registration
  cluster finite for Lattice;
end;

registration
  cluster finite -> complete for Lattice;
end;

definition
  let L be Lattice;
  let D be Subset of L;
  func D% -> Subset of LattPOSet L equals

  {d% where d is Element of L : d in D
  };
end;

definition
  let L be Lattice;
  let D be Subset of LattPOSet L;
  func %D -> Subset of L equals

  {%d where d is Element of LattPOSet L : d in D
  };
end;

registration
  let L be finite Lattice;
  cluster LattPOSet L -> well_founded;
end;

definition
  let L be Lattice;
  attr L is noetherian means


  LattPOSet L is well_founded;
  attr L is co-noetherian means


  (LattPOSet L)~ is well_founded;
end;

registration
  cluster noetherian upper-bounded lower-bounded complete for Lattice;
end;

registration
  cluster co-noetherian upper-bounded lower-bounded complete for Lattice;
end;

theorem 
  for L being Lattice holds L is noetherian iff L.: is co-noetherian;

registration
  cluster finite -> noetherian for Lattice;
  cluster finite -> co-noetherian for Lattice;
end;

definition
  let L be Lattice;
  let a,b be Element of L;
  pred a is-upper-neighbour-of b means


  a <> b & b [= a & for c being
  Element of L holds b [= c & c [= a implies (c = a or c = b);
end;

notation
  let L be Lattice;
  let a,b be Element of L;
  synonym b is-lower-neighbour-of a for a is-upper-neighbour-of b;
end;

theorem 
  for L being Lattice for a being Element of L for b,c being
  Element of L st b <> c holds ( b is-upper-neighbour-of a & c
is-upper-neighbour-of a implies a = c "/\" b) & ( b is-lower-neighbour-of a & c
  is-lower-neighbour-of a implies a = c "\/" b);

theorem 
  for L being noetherian Lattice for a being Element of L for d
being Element of L st a [= d & a <> d holds ex c being Element of L st c [= d &
  c is-upper-neighbour-of a;

theorem 
  for L being co-noetherian Lattice for a being Element of L for d
being Element of L st d [= a & a <> d holds ex c being Element of L st d [= c &
  c is-lower-neighbour-of a;

theorem 
  for L being upper-bounded Lattice holds not(ex b being Element of
  L st b is-upper-neighbour-of Top L);

theorem 
  for L being noetherian upper-bounded Lattice for a being Element
of L holds a = Top L iff not(ex b being Element of L st b is-upper-neighbour-of
  a);

theorem 
  for L being lower-bounded Lattice holds not(ex b being Element of
  L st b is-lower-neighbour-of Bottom L);

theorem 
  for L being co-noetherian lower-bounded Lattice for a being
  Element of L holds a = Bottom L iff not(ex b being Element of L st b
  is-lower-neighbour-of a);

definition
  let L be complete Lattice;
  let a be Element of L;
  func a*' -> Element of L equals

  "/\"({d where d is Element of L : a [= d & d
  <> a},L);
  func *'a -> Element of L equals

  "\/"({d where d is Element of L : d [= a & d
  <> a},L);
end;

definition
  let L be complete Lattice;
  let a be Element of L;
  attr a is completely-meet-irreducible means


  a*' <> a;
  attr a is completely-join-irreducible means


  *'a <> a;
end;

theorem 
  for L being complete Lattice for a being Element of L holds a [=
  a*' & *'a [= a;

theorem 
  for L being complete Lattice holds Top L*' = Top L & (Top L)% is
  meet-irreducible;

theorem 
  for L being complete Lattice holds *'Bottom L = Bottom L & (Bottom L)%
  is join-irreducible;

theorem 
  for L being complete Lattice for a being Element of L st a is
  completely-meet-irreducible holds a*' is-upper-neighbour-of a & for c being
  Element of L holds c is-upper-neighbour-of a implies c = a*';

theorem 
  for L being complete Lattice for a being Element of L st a is
  completely-join-irreducible holds *'a is-lower-neighbour-of a & for c being
  Element of L holds c is-lower-neighbour-of a implies c = *'a;

theorem 
  for L being noetherian complete Lattice for a being Element of L
  holds a is completely-meet-irreducible iff ex b being Element of L st b
  is-upper-neighbour-of a & for c being Element of L holds c
  is-upper-neighbour-of a implies c = b;

theorem 
  for L being co-noetherian complete Lattice for a being Element
  of L holds a is completely-join-irreducible iff ex b being Element of L st b
  is-lower-neighbour-of a & for c being Element of L holds c
  is-lower-neighbour-of a implies c = b;

theorem 
  for L being complete Lattice for a being Element of L holds a is
  completely-meet-irreducible implies a% is meet-irreducible;

theorem 
  for L being complete noetherian Lattice for a being Element of L
st a <> Top L holds a is completely-meet-irreducible iff a% is meet-irreducible
;

theorem 
  for L being complete Lattice for a being Element of L holds a is
  completely-join-irreducible implies a% is join-irreducible;

theorem 
  for L being complete co-noetherian Lattice for a being Element
  of L st a <> Bottom L holds a is completely-join-irreducible iff a% is
  join-irreducible;

theorem 
  for L being finite Lattice for a being Element of L st a <> Bottom L &
a <> Top L holds (a is completely-meet-irreducible iff a% is meet-irreducible)
  & (a is completely-join-irreducible iff a% is join-irreducible);

definition
  let L be Lattice;
  let a be Element of L;
  attr a is atomic means


  a is-upper-neighbour-of Bottom L;
  attr a is co-atomic means


  a is-lower-neighbour-of Top L;
end;

theorem 
  for L being complete Lattice for a being Element of L st a is atomic
  holds a is completely-join-irreducible;

theorem 
  for L being complete Lattice for a being Element of L st a is
  co-atomic holds a is completely-meet-irreducible;

definition
  let L be Lattice;
  attr L is atomic means


  for a being Element of L holds ex X being
  Subset of L st (for x being Element of L st x in X holds x is atomic) & a =
  "\/"(X,L);
end;

registration
  cluster strict 1-element for Lattice;
end;

registration
  cluster atomic complete for Lattice;
end;

definition
  let L be complete Lattice;
  let D be Subset of L;
  attr D is supremum-dense means


  for a being Element of L holds ex D9 being Subset of D st a = "\/"(D9,L);
  attr D is infimum-dense means


  for a being Element of L holds ex D9 being Subset of D st a = "/\"(D9,L);
end;

theorem 
  for L being complete Lattice for D being Subset of L holds D is
  supremum-dense iff for a being Element of L holds a = "\/"({d where d is
  Element of L: d in D & d [= a},L);

theorem 
  for L being complete Lattice for D being Subset of L holds D is
infimum-dense iff for a being Element of L holds a = "/\"({d where d is Element
  of L : d in D & a [= d},L);

theorem 
  for L being complete Lattice for D being Subset of L holds D is
  infimum-dense iff D% is order-generating;

definition
  let L be complete Lattice;
  func MIRRS(L) -> Subset of L equals

  {a where a is Element of L : a is
  completely-meet-irreducible};
  func JIRRS(L) -> Subset of L equals

  {a where a is Element of L : a is
  completely-join-irreducible };
end;

theorem 
  for L being complete Lattice for D being Subset of L st D is
  supremum-dense holds JIRRS(L) c= D;

theorem 
  for L being complete Lattice for D being Subset of L st D is
  infimum-dense holds MIRRS(L) c= D;

registration
  let L be co-noetherian complete Lattice;
  cluster MIRRS(L) -> infimum-dense;
end;

registration
  let L be noetherian complete Lattice;
  cluster JIRRS(L) -> supremum-dense;
end;














begin 

theorem 
  for S, T being up-complete Scott TopLattice for M being Subset of
  SCMaps (S,T) holds "\/" (M, SCMaps (S,T)) is continuous Function of S, T;

registration
  let S be non empty RelStr, T be non empty reflexive RelStr;
  cluster constant -> monotone for Function of S, T;
end;

registration
  let S be non empty RelStr, T be reflexive non empty RelStr, a be Element of
  T;
  cluster S --> a -> monotone;
end;

theorem 
  for S being non empty RelStr, T being lower-bounded antisymmetric
  reflexive non empty RelStr holds Bottom MonMaps(S, T) = S --> Bottom T;

theorem 
  for S being non empty RelStr, T being upper-bounded antisymmetric
  reflexive non empty RelStr holds Top MonMaps(S, T) = S --> Top T;

scheme 

  FuncFraenkelSL{ B, C() -> non empty RelStr, A(set) -> Element of C(), f() ->
  Function, P[set]}: f().:{A(x) where x is Element of B(): P[x]} = {f().A(x)
  where x is Element of B(): P[x]}
provided
 the carrier of C() c= dom f();

scheme 

  Fraenkel6A{ B() -> LATTICE, F(set) -> set, P[set], Q[set] } : { F(v1) where
  v1 is Element of B() : P[v1] } = { F(v2) where v2 is Element of B() : Q[v2] }
provided
 for v being Element of B() holds P[v] iff Q[v];

theorem 
  for S, T being complete LATTICE, f being monotone Function of S,
  T holds for x being Element of S holds f.x = sup (f.:downarrow x);

theorem 
  for S, T being complete lower-bounded LATTICE, f being monotone
Function of S, T holds for x being Element of S holds f.x = "\/"({ f.w where w
  is Element of S : w <= x },T);

theorem 
  for S being RelStr, T being non empty RelStr, F being Subset of (
  T |^ the carrier of S) holds sup F is Function of S, T;

begin  

definition
  let X1, X2, Y be non empty RelStr;
  let f be Function of [:X1, X2:], Y;
  let x be Element of X1;
  func Proj (f, x) -> Function of X2, Y equals

  (curry f).x;
end;

reserve X1, X2, Y for non empty RelStr,
  f for Function of [:X1, X2:], Y,
  x for Element of X1,
  y for Element of X2;

theorem 
  for y being Element of X2 holds (Proj (f, x)). y = f.(x, y);

definition
  let X1, X2, Y be non empty RelStr;
  let f be Function of [:X1, X2:], Y;
  let y be Element of X2;
  func Proj (f, y) -> Function of X1, Y equals

  (curry' f).y;
end;

theorem 
  for x being Element of X1 holds (Proj (f, y)). x = f.(x, y);

theorem 
  for R, S, T being non empty RelStr, f being Function of [:R,S:],
T, a being Element of R, b being Element of S holds Proj (f, a). b = Proj (f, b
  ). a;

registration
  let S be non empty RelStr, T be non empty reflexive RelStr;
  cluster antitone for Function of S, T;
end;

theorem 
  for R, S, T being non empty reflexive RelStr, f being Function
  of [:R,S:], T, a being Element of R, b being Element of S st f is monotone
  holds Proj (f, a) is monotone & Proj (f, b) is monotone;

theorem 
  for R, S, T being non empty reflexive RelStr, f being Function
  of [:R,S:], T, a being Element of R, b being Element of S st f is antitone
  holds Proj (f, a) is antitone & Proj (f, b) is antitone;

registration
  let R, S, T be non empty reflexive RelStr;
  let f be monotone Function of [:R, S:], T;
  let a be Element of R;
  cluster Proj (f, a) -> monotone;
end;

registration
  let R, S, T be non empty reflexive RelStr;
  let f be monotone Function of [:R, S:], T;
  let b be Element of S;
  cluster Proj (f, b) -> monotone;
end;

registration
  let R, S, T be non empty reflexive RelStr;
  let f be antitone Function of [:R, S:], T;
  let a be Element of R;
  cluster Proj (f, a) -> antitone;
end;

registration
  let R, S, T be non empty reflexive RelStr;
  let f be antitone Function of [:R, S:], T;
  let b be Element of S;
  cluster Proj (f, b) -> antitone;
end;

theorem 
  for R, S, T being LATTICE, f being Function of [:R,S:], T st (
for a being Element of R, b being Element of S holds Proj (f, a) is monotone &
  Proj (f, b) is monotone) holds f is monotone;

theorem 
  for R, S, T being LATTICE, f being Function of [:R,S:], T st ( for a
being Element of R, b being Element of S holds Proj (f, a) is antitone & Proj (
  f, b) is antitone) holds f is antitone;

theorem 
  for R, S, T being LATTICE, f being Function of [:R,S:], T, b
  being Element of S, X being Subset of R holds Proj (f, b).:X = f.:[:X, {b}:];

theorem 
  for R, S, T being LATTICE, f being Function of [:R,S:], T, b
  being Element of R, X being Subset of S holds Proj (f, b).:X = f.:[:{b}, X:];

theorem 
  for R, S, T being LATTICE, f being Function of [:R,S:], T, a being
Element of R, b being Element of S st f is directed-sups-preserving holds Proj
  (f, a) is directed-sups-preserving & Proj (f, b) is directed-sups-preserving;

theorem 
  for R, S, T being LATTICE, f being monotone Function of [:R, S:]
, T, a being Element of R, b being Element of S, X being directed Subset of [:R
, S:] st ex_sup_of f.:X, T & a in proj1 X & b in proj2 X holds f. [a, b] <= sup
  (f.:X);

theorem 
  for R, S, T being complete LATTICE, f being Function of [:R, S:], T st
  ( for a being Element of R, b being Element of S holds Proj (f, a) is
directed-sups-preserving & Proj (f, b) is directed-sups-preserving ) holds f is
  directed-sups-preserving;

theorem 
  for S being set, T being non empty RelStr, f be set holds f is
  Element of T |^ S iff f is Function of S, the carrier of T;

begin  

definition
  let S be TopStruct, T be non empty TopRelStr;
  func ContMaps (S, T) -> strict RelStr means


  it is full SubRelStr of T
  |^ the carrier of S & for x being set holds x in the carrier of it iff ex f
  being Function of S, T st x = f & f is continuous;
end;

registration
  let S be non empty TopSpace, T be non empty TopSpace-like TopRelStr;
  cluster ContMaps (S, T) -> non empty;
end;

registration
  let S be non empty TopSpace, T be non empty TopSpace-like TopRelStr;
  cluster ContMaps (S, T) -> constituted-Functions;
end;

theorem 
  for S being non empty TopSpace, T being non empty reflexive
TopSpace-like TopRelStr, x, y being Element of ContMaps (S, T) holds x <= y iff
  for i being Element of S holds [x.i, y.i] in the InternalRel of T;

theorem 
  for S being non empty TopSpace, T being non empty reflexive
TopSpace-like TopRelStr, x being set holds x is continuous Function of S, T iff
  x is Element of ContMaps (S, T);

registration
  let S be non empty TopSpace, T be non empty reflexive TopSpace-like
  TopRelStr;
  cluster ContMaps (S, T) -> reflexive;
end;

registration
  let S be non empty TopSpace, T be non empty transitive TopSpace-like
  TopRelStr;
  cluster ContMaps (S, T) -> transitive;
end;

registration
  let S be non empty TopSpace, T be non empty antisymmetric TopSpace-like
  TopRelStr;
  cluster ContMaps (S, T) -> antisymmetric;
end;

registration
  let S be set, T be non empty RelStr;
  cluster T |^ S -> constituted-Functions;
end;

theorem 
  for S being non empty 1-sorted, T being complete LATTICE for f, g, h
  being Function of S, T, i being Element of S st h = "\/" ({f, g}, T |^ the
  carrier of S) holds h.i = sup {f.i, g.i};

theorem 
  for I being non empty set for J being RelStr-yielding non-Empty
reflexive-yielding ManySortedSet of I st for i being Element of I holds J.i is
complete LATTICE for X being Subset of product J, i being Element of I holds (
  inf X).i = inf pi(X,i);

theorem 
  for S being non empty 1-sorted, T being complete LATTICE for f, g, h
  being Function of S, T, i being Element of S st h = "/\" ({f, g}, T |^ the
  carrier of S) holds h.i = inf {f.i, g.i};

theorem 
  for S being non empty RelStr, T being complete LATTICE for F
being non empty Subset of (T |^ the carrier of S), i being Element of S holds (
sup F).i = "\/" ({ f.i where f is Element of (T |^ the carrier of S) : f in F }
  , T );

theorem 
  for S, T being complete TopLattice for F being non empty Subset
of ContMaps (S, T), i being Element of S holds "\/" (F, (T |^ the carrier of S)
).i = "\/" ({ f.i where f is Element of (T |^ the carrier of S) : f in F }, T )
;

reserve S for non empty RelStr,
  T for complete LATTICE;

theorem 
  for F being non empty Subset of (T |^ the carrier of S), D being
non empty Subset of S holds (sup F).:D = { "\/" ({ f.i where f is Element of (T
  |^ the carrier of S) : f in F }, T ) where i is Element of S : i in D };

theorem 
  for S, T being complete Scott TopLattice, F being non empty
Subset of ContMaps (S, T), D being non empty Subset of S holds ("\/" (F, (T |^
the carrier of S))).:D = { "\/" ({ f.i where f is Element of (T |^ the carrier
  of S) : f in F }, T ) where i is Element of S : i in D };

scheme 

  FraenkelF9RS{ B() -> non empty TopRelStr, F(set) -> set, G(set) -> set, P[
  set] } : { F(v1) where v1 is Element of B() : P[v1] } = { G(v2) where v2 is
  Element of B() : P[v2] }
provided
 for v being Element of B() st P[v] holds F(v) = G(v);

scheme 

  FraenkelF9RSS{ B() -> non empty RelStr, F(set) -> set, G(set) -> set, P[set]
} : { F(v1) where v1 is Element of B() : P[v1] } = { G(v2) where v2 is Element
  of B() : P[v2] }
provided
 for v being Element of B() st P[v] holds F(v) = G(v);

scheme 

  FuncFraenkelS{ B, C() -> non empty TopRelStr, A(set) -> Element of C(), f()
  -> Function, P[set]}: f().:{A(x) where x is Element of B(): P[x]} = {f().A(x)
  where x is Element of B(): P[x]}
provided
 the carrier of C() c= dom f();

theorem 
  for S, T being complete Scott TopLattice, F being non empty
  Subset of ContMaps (S, T) holds "\/" (F, (T |^ the carrier of S)) is monotone
  Function of S, T;

theorem 
  for S, T being complete Scott TopLattice, F being non empty
Subset of ContMaps (S, T), D being directed non empty Subset of S holds "\/"({
  "\/"({g.i where i is Element of S : i in D }, T ) where g is Element of (T |^
the carrier of S) : g in F }, T ) = "\/"({ "\/" ({g9.i9 where g9 is Element of
(T |^ the carrier of S) : g9 in F }, T ) where i9 is Element of S : i9 in D },
  T);

theorem 
  for S, T being complete Scott TopLattice, F being non empty
Subset of ContMaps (S, T), D being directed non empty Subset of S holds "\/" ((
  "\/"(F, (T |^ the carrier of S))).:D, T) = "\/" (F, (T |^ the carrier of S)).
  sup D;

theorem 
  for S, T being complete Scott TopLattice, F being non empty
Subset of ContMaps (S, T) holds "\/"(F, (T |^ the carrier of S)) in the carrier
  of ContMaps (S, T);

theorem 
  for S being non empty RelStr, T being lower-bounded
  antisymmetric non empty RelStr holds Bottom (T |^ the carrier of S) = S -->
  Bottom T;

theorem 
  for S being non empty RelStr, T being upper-bounded antisymmetric non
  empty RelStr holds Top (T |^ the carrier of S) = S --> Top T;

registration
  let S be non empty reflexive RelStr, T be complete LATTICE, a be Element of
  T;
  cluster S --> a -> directed-sups-preserving;
end;

theorem 
  for S, T being complete Scott TopLattice holds ContMaps (S, T)
  is sups-inheriting SubRelStr of (T |^ the carrier of S);

registration
  let S, T be complete Scott TopLattice;
  cluster ContMaps (S, T) -> complete;
end;

theorem 
  for S, T being non empty Scott complete TopLattice holds Bottom
  ContMaps (S, T) = S --> Bottom T;

theorem 
  for S, T being non empty Scott complete TopLattice holds Top ContMaps
  (S, T) = S --> Top T;

theorem 
  for S, T being Scott complete TopLattice holds SCMaps (S, T) =
  ContMaps (S, T);















begin  

theorem 
  bool 1 = {0,1};

theorem 
  for X being set, Y being Subset of X holds rng ((id X)|Y) = Y;

theorem 
  for S being empty 1-sorted, T being 1-sorted, f being Function of S, T
  st rng f = [#]T holds T is empty;

theorem 
  for S being 1-sorted, T being empty 1-sorted, f being Function of S, T
  st dom f = [#]S holds S is empty;

theorem 
  for S being non empty 1-sorted, T being 1-sorted, f being Function of
  S, T st dom f = [#]S holds T is non empty;

theorem 
  for S being 1-sorted, T being non empty 1-sorted, f being Function of
  S, T st rng f = [#]T holds S is non empty;

definition
  let S be non empty reflexive RelStr, T be non empty RelStr, f be Function of
  S, T;
  redefine attr f is directed-sups-preserving means

  for X being non empty directed Subset of S holds f preserves_sup_of X;
end;

definition
  let R be 1-sorted, N be NetStr over R;
  attr N is Function-yielding means


  the mapping of N is Function-yielding;
end;

registration
  cluster non empty constituted-Functions for 1-sorted;
end;

registration
  cluster strict non empty constituted-Functions for RelStr;
end;

registration
  let R be constituted-Functions 1-sorted;
  cluster -> Function-yielding for NetStr over R;
end;

registration
  let R be constituted-Functions 1-sorted;
  cluster strict Function-yielding for NetStr over R;
end;

registration
  let R be non empty constituted-Functions 1-sorted;
  cluster strict non empty Function-yielding for NetStr over R;
end;

registration
  let R be constituted-Functions 1-sorted, N be Function-yielding NetStr over
  R;
  cluster the mapping of N -> Function-yielding;
end;

registration
  let R be non empty constituted-Functions 1-sorted;
  cluster strict Function-yielding for net of R;
end;

registration
  let S be non empty 1-sorted, N be non empty NetStr over S;
  cluster rng the mapping of N -> non empty;
end;

registration
  let S be non empty 1-sorted, N be non empty NetStr over S;
  cluster rng netmap (N,S) -> non empty;
end;

theorem 
  for A, B, C being non empty RelStr, f being Function of B, C, g, h
  being Function of A, B st g <= h & f is monotone holds f * g <= f * h;

theorem 
  for S being non empty TopSpace, T being non empty TopSpace-like
TopRelStr, f, g being Function of S, T, x, y being Element of ContMaps(S,T) st
  x = f & y = g holds x <= y iff f <= g;

definition
  let I be non empty set, R be non empty RelStr, f be Element of R |^ I, i be
  Element of I;
  redefine func f.i -> Element of R;
end;

begin  

theorem 
  for S, T being RelStr, f being Function of S, T st f is
  isomorphic holds f is onto;

registration
  let S, T be RelStr;
  cluster isomorphic -> onto for Function of S, T;
end;

theorem 
  for S, T being non empty RelStr, f being Function of S, T st f
  is isomorphic holds f/" is isomorphic;

theorem 
  for S, T being non empty RelStr st S, T are_isomorphic & S is
  with_infima holds T is with_infima;

theorem 
  for S, T being non empty RelStr st S, T are_isomorphic & S is
  with_suprema holds T is with_suprema;

theorem 
  for L being RelStr st L is empty holds L is bounded;

registration
  cluster empty -> bounded for RelStr;
end;

theorem 
  for S, T being RelStr st S, T are_isomorphic & S is lower-bounded
  holds T is lower-bounded;

theorem 
  for S, T being RelStr st S, T are_isomorphic & S is upper-bounded
  holds T is upper-bounded;

theorem 
  for S, T being non empty RelStr, A being Subset of S, f being Function
  of S, T st f is isomorphic & ex_sup_of A, S holds ex_sup_of f.:A, T;

theorem 
  for S, T being non empty RelStr, A being Subset of S, f being Function
  of S, T st f is isomorphic & ex_inf_of A, S holds ex_inf_of f.:A, T;

begin  

theorem 
  for S, T being TopStruct st (S,T are_homeomorphic or ex f being
Function of S,T st dom f = [#]S & rng f = [#]T) holds S is empty iff T is empty
;

theorem 
  for T being non empty TopSpace holds T, the TopStruct of T are_homeomorphic;

registration
  let T be Scott reflexive non empty TopRelStr;
  cluster open -> inaccessible upper for Subset of T;
  cluster inaccessible upper -> open for Subset of T;
end;

theorem 
  for T being TopStruct, x, y being Point of T, X, Y being Subset of T
  st X = {x} & Cl X c= Cl Y holds x in Cl Y;

theorem 
  for T being TopStruct, x, y being Point of T, Y, V being Subset of T
  st Y = {y} & x in Cl Y & V is open & x in V holds y in V;

theorem 
  for T being TopStruct, x, y being Point of T, X, Y being Subset of T
st X = {x} & Y = {y} holds (for V being Subset of T st V is open holds (x in V
  implies y in V)) implies Cl X c= Cl Y;

theorem 
  for S, T being non empty TopSpace, A being irreducible Subset of
S, B being Subset of T st A = B & the TopStruct of S = the TopStruct of T holds
  B is irreducible;

theorem 
  for S, T being non empty TopSpace, a being Point of S, b being
  Point of T, A being Subset of S, B being Subset of T st a = b & A = B & the
  TopStruct of S = the TopStruct of T & a is_dense_point_of A holds b
  is_dense_point_of B;

theorem 
  for S, T being TopStruct, A being Subset of S, B being Subset of
T st A = B & the TopStruct of S = the TopStruct of T & A is compact holds B is
  compact;

theorem 
  for S, T being non empty TopSpace st the TopStruct of S = the
  TopStruct of T & S is sober holds T is sober;

theorem 
  for S, T being non empty TopSpace st the TopStruct of S = the
  TopStruct of T & S is locally-compact holds T is locally-compact;

theorem 
  for S, T being TopStruct st the TopStruct of S = the TopStruct of T &
  S is compact holds T is compact;

definition
  let I be non empty set, T be non empty TopSpace, x be Point of product (I
  --> T), i be Element of I;
  redefine func x.i -> Element of T;
end;

theorem 
  for M being non empty set, J being TopStruct-yielding non-Empty
  ManySortedSet of M, x, y being Point of product J holds x in Cl {y} iff for i
  being Element of M holds x.i in Cl {y.i};

theorem 
  for M being non empty set, T being non empty TopSpace, x, y being
Point of product (M --> T) holds x in Cl {y} iff for i being Element of M holds
  x.i in Cl {y.i};

theorem 
  for M being non empty set, i being Element of M, J being
  TopStruct-yielding non-Empty ManySortedSet of M, x being Point of product J
  holds pi(Cl {x}, i) = Cl {x.i};

theorem 
  for M being non empty set, i being Element of M, T being non empty
  TopSpace, x being Point of product (M --> T) holds pi(Cl {x}, i) = Cl {x.i};

theorem 
  for X, Y being non empty TopStruct, f being Function of X, Y, g being
  Function of Y, X st f = id X & g = id X & f is continuous & g is continuous
  holds the TopStruct of X = the TopStruct of Y;

theorem 
  for X, Y being non empty TopSpace, f being Function of X, Y st corestr
  f is continuous holds f is continuous;

registration
  let X be non empty TopSpace, Y be non empty SubSpace of X;
  cluster incl Y -> continuous;
end;

theorem 
  for T being non empty TopSpace, f being Function of T, T st f*f = f
  holds corestr f * incl Image f = id Image f;

theorem 
  for Y being non empty TopSpace, W being non empty SubSpace of Y holds
  corestr incl W is being_homeomorphism;

theorem 
  for M being non empty set, J being TopStruct-yielding non-Empty
ManySortedSet of M st for i being Element of M holds J.i is T_0 TopSpace holds
  product J is T_0;

registration
  let I be non empty set, T be non empty T_0 TopSpace;
  cluster product (I --> T) -> T_0;
end;

theorem 
  for M being non empty set, J being TopStruct-yielding non-Empty
  ManySortedSet of M st for i being Element of M holds J.i is T_1 TopSpace-like
  holds product J is T_1;

registration
  let I be non empty set, T be non empty T_1 TopSpace;
  cluster product (I --> T) -> T_1;
end;














begin

theorem 
  for A,x,y being set st A c= {x,y} & x in A & not y in A holds A = {x};

registration
  cluster trivial for Function;
end;

begin 

reserve G for Go-board,
  i,j,k,m,n for Element of NAT;

registration
  cluster non constant for FinSequence;
end;

theorem 
  for f being non trivial FinSequence holds 1 < len f;

theorem 
  for D being non trivial set for f being non constant circular
  FinSequence of D holds len f > 2;

theorem 
  for f being FinSequence, x being set holds x in rng f or x..f = 0;

theorem 
  for p being set, D being non empty set for f being non empty
FinSequence of D for g being FinSequence of D st p..f = len f holds (f^g)|--p =
  g;

theorem 
  for D being non empty set for f being non empty one-to-one
  FinSequence of D holds f/.len f..f = len f;

theorem 
  for f,g being FinSequence holds len f <= len(f^'g);

theorem 
  for f,g being FinSequence for x being set st x in rng f holds x..
  f = x..(f^'g);

theorem 
  for f being non empty FinSequence for g being FinSequence holds len g
  <= len(f^'g);

theorem 
  for f,g being FinSequence holds rng f c= rng(f^'g);

theorem 
  for D being non empty set for f being non empty FinSequence of D
  for g being non trivial FinSequence of D st g/.len g = f/.1 holds f^'g is
  circular;

theorem 
  for D being non empty set for M being Matrix of D for f being
FinSequence of D for g being non empty FinSequence of D st f/.len f = g/.1 & f
  is_sequence_on M & g is_sequence_on M holds f^'g is_sequence_on M;

theorem 
  for D being set, f being FinSequence of D st 1 <= k holds (k+1,
  len f)-cut f = f/^k;

theorem 
  for D being set, f being FinSequence of D st k <= len f holds (1
  , k)-cut f = f|k;

theorem 
  for p being set, D being non empty set for f being non empty
FinSequence of D for g being FinSequence of D st p..f = len f holds (f^g)-|p =
  (1,len f -' 1)-cut f;

theorem 
  for D being non empty set for f,g being non empty FinSequence of
  D st g/.1..f = len f holds (f^'g:-g/.1) = g;

theorem 
  for D being non empty set for f,g being non empty FinSequence of
  D st g/.1..f = len f holds (f^'g-:g/.1) = f;

theorem 
  for D being non trivial set for f being non empty FinSequence of
D for g being non trivial FinSequence of D st g/.1 = f/.len f & for i st 1 <= i
  & i < len f holds f/.i <> g/.1 holds Rotate(f^'g,g/.1) = g^'f;

begin 

theorem 
  for f being non trivial FinSequence of TOP-REAL 2 holds LSeg(f,1 ) = L~(f|2);

theorem 
  for f being s.c.c. FinSequence of TOP-REAL 2, n st n < len f
  holds f|n is s.n.c.;

theorem 
  for f being s.c.c. FinSequence of TOP-REAL 2, n st 1 <= n holds
  f/^n is s.n.c.;

theorem 
  for f being circular s.c.c. FinSequence of TOP-REAL 2, n st n <
  len f & len f > 4 holds f|n is one-to-one;

theorem 
  for f being circular s.c.c. FinSequence of TOP-REAL 2 st len f >
4 for i,j being Element of NAT st 1 < i & i < j & j <= len f holds f/.i <> f/.j
;

theorem 
  for f being circular s.c.c. FinSequence of TOP-REAL 2, n st 1 <=
  n & len f > 4 holds f/^n is one-to-one;

theorem 
  for f being special non empty FinSequence of TOP-REAL 2 holds (m
  ,n)-cut f is special;

theorem 
  for f being special non empty FinSequence of TOP-REAL 2 for g
being special non trivial FinSequence of TOP-REAL 2 st f/.len f = g/.1 holds f
  ^'g is special;

theorem 
  for f being circular unfolded s.c.c. FinSequence of TOP-REAL 2
  st len f > 4 holds LSeg(f,1) /\ L~(f/^1) = {f/.1,f/.2};

theorem 
  for f,g being FinSequence of TOP-REAL 2 st j < len f holds LSeg(
  f^'g,j) = LSeg(f,j);

theorem 
  for f,g being non empty FinSequence of TOP-REAL 2 st 1 <= j & j+
  1 < len g holds LSeg(f^'g,len f+j) = LSeg(g,j+1);

theorem 
  for f being non empty FinSequence of TOP-REAL 2 for g being non
  trivial FinSequence of TOP-REAL 2 st f/.len f = g/.1 holds LSeg(f^'g,len f) =
  LSeg(g,1);

theorem 
  for f being non empty FinSequence of TOP-REAL 2 for g being non
trivial FinSequence of TOP-REAL 2 st j+1 < len g & f/.len f = g/.1 holds LSeg(f
  ^'g,len f+j) = LSeg(g,j+1);

theorem 
  for f being non empty s.n.c. unfolded FinSequence of TOP-REAL 2,
  i st 1 <= i & i < len f holds LSeg(f,i) /\ rng f = {f/.i,f/.(i+1)};

theorem 
  for f,g being non trivial s.n.c. one-to-one unfolded FinSequence
  of TOP-REAL 2 st L~f /\ L~g = {f/.1,g/.1} & f/.1 = g/.len g & g/.1 = f/.len f
  holds f ^' g is s.c.c.;

reserve f,g,g1,g2 for FinSequence of TOP-REAL 2;

theorem 
  f is unfolded & g is unfolded & f/.len f = g/.1 & LSeg(f,len f
  -' 1) /\ LSeg(g,1) = { f/.len f } implies f^'g is unfolded;

theorem 
  f is non empty & g is non trivial & f/.len f = g/.1 implies L~(f
  ^'g) = L~f \/ L~g;

theorem 
  (for n be Nat st n in dom f ex i,j be Nat st [i,j] in Indices G & f/.n
  =G*(i,j)) & f is non constant circular unfolded s.c.c. special & len f > 4
implies ex g st g is_sequence_on G & g is unfolded s.c.c. special & L~f = L~g &
  f/.1 = g/.1 & f/.len f = g/.len g & len f <= len g;














begin 

reserve i,j,k,n for Element of NAT,
  D for non empty set,
  f, g for FinSequence of D;

theorem 
  for T being non empty TopSpace for B,C1,C2,D being Subset of T st
B is connected & C1 is_a_component_of D & C2 is_a_component_of D & B meets C1 &
  B meets C2 & B c= D holds C1 = C2;

theorem 
  (for n holds f|n = g|n) implies f = g;

theorem 
  n in dom f implies ex k st k in dom Rev f & n+k = len f+1 & f/.n = (Rev f)/.k
;

theorem 
  n in dom Rev f implies ex k st k in dom f & n+k = len f+1 & (Rev f)/.n = f/.k
;

begin 

reserve G for Go-board,
  f, g for FinSequence of TOP-REAL 2,
  p for Point of TOP-REAL 2,
  r, s for Real,
  x for set;

theorem 
  for D being non empty set for G being Matrix of D for f being
  FinSequence of D holds f is_sequence_on G iff Rev f is_sequence_on G;

theorem 
  for G being Matrix of TOP-REAL 2 for f being FinSequence of
  TOP-REAL 2 holds f is_sequence_on G & 1 <= k & k <= len f implies f/.k in
  Values G;

theorem 
  n <= len f & x in L~(f/^n) implies ex i being Element of NAT st n
  +1 <= i & i+1 <= len f & x in LSeg(f,i);

theorem 
  f is_sequence_on G & 1 <= k & k+1 <= len f implies f/.k in
  left_cell(f,k,G) & f/.k in right_cell(f,k,G);

theorem 
  f is_sequence_on G & 1 <= k & k+1 <= len f implies Int left_cell
  (f,k,G) <> {} & Int right_cell(f,k,G) <> {};

theorem 
  f is_sequence_on G & 1 <= k & k+1 <= len f implies Int left_cell
  (f,k,G) is convex & Int right_cell(f,k,G) is convex;

theorem 
  f is_sequence_on G & 1 <= k & k+1 <= len f implies Cl Int
left_cell(f,k,G) = left_cell(f,k,G) & Cl Int right_cell(f,k,G) = right_cell(f,k
  ,G);

theorem 
  f is_sequence_on G & LSeg(f,k) is horizontal implies ex j st 1
  <= j & j <= width G & for p st p in LSeg(f,k) holds p`2 = G*(1,j)`2;

theorem 
  f is_sequence_on G & LSeg(f,k) is vertical implies ex i st 1 <=
  i & i <= len G & for p st p in LSeg(f,k) holds p`1 = G*(i,1)`1;

theorem 
  f is_sequence_on G & f is special & i <= len G & j <= width G
  implies Int cell(G,i,j) misses L~f;

theorem 
  f is_sequence_on G & f is special & 1 <= k & k+1 <= len f
  implies Int left_cell(f,k,G) misses L~f & Int right_cell(f,k,G) misses L~f;

theorem 
  1 <= i & i+1 <= len G & 1 <= j & j+1 <= width G implies G*(i,j)
`1 = G*(i,j+1)`1 & G*(i,j)`2 = G*(i+1,j)`2 & G*(i+1,j+1)`1 = G*(i+1,j)`1 & G*(i
  +1,j+1)`2 = G*(i,j+1)`2;

theorem 
  for i,j being Element of NAT st 1 <= i & i+1 <= len G & 1 <= j &
j+1 <= width G holds p in cell(G,i,j) iff G*(i,j)`1 <= p`1 & p`1 <= G*(i+1,j)`1
  & G*(i,j)`2 <= p`2 & p`2 <= G*(i,j+1)`2;

theorem 
  1 <= i & i+1 <= len G & 1 <= j & j+1 <= width G implies cell(G,i,j) =
{ |[r,s]| : G*(i,j)`1 <= r & r <= G*(i+1,j)`1 & G*(i,j)`2 <= s & s <= G*(i,j+1)
  `2 };

theorem 
  1 <= i & i+1 <= len G & 1 <= j & j+1 <= width G & p in Values G
& p in cell(G,i,j) implies p = G*(i,j) or p = G*(i,j+1) or p = G*(i+1,j+1) or p
  = G*(i+1,j);

theorem 
  1 <= i & i+1 <= len G & 1 <= j & j+1 <= width G implies G*(i,j)
in cell(G,i,j) & G*(i,j+1) in cell(G,i,j) & G*(i+1,j+1) in cell(G,i,j) & G*(i+1
  ,j) in cell(G,i,j);

theorem 
  1 <= i & i+1 <= len G & 1 <= j & j+1 <= width G & p in Values G
  & p in cell(G,i,j) implies p is_extremal_in cell(G,i,j);

theorem 
  2 <= len G & 2 <= width G & f is_sequence_on G & 1 <= k & k+1 <=
len f implies ex i,j st 1 <= i & i+1 <= len G & 1 <= j & j+1 <= width G & LSeg(
  f,k) c= cell(G,i,j);

theorem 
  2 <= len G & 2 <= width G & f is_sequence_on G & 1 <= k & k+1 <=
  len f & p in Values G & p in LSeg(f,k) implies p = f/.k or p = f/.(k+1);

theorem 
  [i,j] in Indices G & 1 <= k & k <= width G implies G*(i,j)`1 <= G* (
  len G,k)`1;

theorem 
  [i,j] in Indices G & 1 <= k & k <= len G implies G*(i,j)`2 <= G* (k,
  width G)`2;

theorem 
  f is_sequence_on G & f is special & L~g c= L~f & 1 <= k & k+1 <=
len f implies for A being Subset of TOP-REAL 2 st A = right_cell(f,k,G)\L~g or
  A = left_cell(f,k,G)\L~g holds A is connected;

theorem 
  for f being non constant standard special_circular_sequence st f
is_sequence_on G for k st 1 <= k & k+1 <= len f holds right_cell(f,k,G)\L~f c=
  RightComp f & left_cell(f,k,G)\L~f c= LeftComp f;

begin 

reserve C for compact non vertical non horizontal non empty Subset of TOP-REAL
  2,
  l, m, i1, i2, j1, j2 for Element of NAT;

theorem 
  for n being Nat ex i st 1 <= i & i+1 <= len Gauge(C,n) & N-min C
  in cell(Gauge(C,n),i,width Gauge(C,n)-'1) & N-min C <> Gauge(C,n)*(i,width
  Gauge(C,n)-'1);

theorem 
  for n, i1, i2 being Nat holds 1 <= i1 & i1+1 <= len Gauge(C,n) &
N-min C in cell(Gauge(C,n),i1,width Gauge(C,n)-'1) & N-min C <> Gauge(C,n)*(i1,
width Gauge(C,n)-'1) & 1 <= i2 & i2+1 <= len Gauge(C,n) & N-min C in cell(Gauge
(C,n),i2,width Gauge(C,n)-'1) & N-min C <> Gauge(C,n)*(i2,width Gauge(C,n)-'1)
  implies i1 = i2;

theorem 
  for n being Nat for f being standard non constant
special_circular_sequence st f is_sequence_on Gauge(C,n) & (for k st 1 <= k & k
+1 <= len f holds left_cell(f,k,Gauge(C,n)) misses C & right_cell(f,k,Gauge(C,n
  )) meets C) & (ex i st 1 <= i & i+1 <= len Gauge(C,n) & f/.1 = Gauge(C,n)*(i,
width Gauge(C,n)) & f/.2 = Gauge(C,n)*(i+1,width Gauge(C,n)) & N-min C in cell(
Gauge(C,n),i,width Gauge(C,n)-'1) & N-min C <> Gauge(C,n)*(i,width Gauge(C,n)-'
  1)) holds N-min L~f = f/.1;

definition
  let C be compact non vertical non horizontal non empty Subset of TOP-REAL 2;
  let n be Nat;
  assume
 C is connected;
  func Cage(C,n) -> clockwise_oriented standard non constant
  special_circular_sequence means


  it is_sequence_on Gauge(C,n) & (ex i st
1 <= i & i+1 <= len Gauge(C,n) & it/.1 = Gauge(C,n)*(i,width Gauge(C,n)) & it/.
  2 = Gauge(C,n)*(i+1,width Gauge(C,n)) & N-min C in cell(Gauge(C,n),i,width
Gauge(C,n)-'1) & N-min C <> Gauge(C,n)*(i,width Gauge(C,n)-'1)) & for k st 1 <=
  k & k+2 <= len it holds (front_left_cell(it,k,Gauge(C,n)) misses C &
front_right_cell(it,k,Gauge(C,n)) misses C implies it turns_right k,Gauge(C,n))
& (front_left_cell(it,k,Gauge(C,n)) misses C & front_right_cell(it,k,Gauge(C,n)
) meets C implies it goes_straight k,Gauge(C,n)) & (front_left_cell(it,k,Gauge(
  C,n)) meets C implies it turns_left k,Gauge(C,n));
end;

theorem 
  C is connected & 1 <= k & k+1 <= len Cage(C,n) implies left_cell
(Cage(C,n),k,Gauge(C,n)) misses C & right_cell(Cage(C,n),k,Gauge(C,n)) meets C;

theorem 
  C is connected implies N-min L~Cage(C,n) = (Cage(C,n))/.1;














begin  

registration
  cluster connected compact non vertical non horizontal for
Subset of TOP-REAL 2;
end;

reserve i, j, k, n for Element of NAT,
  P for Subset of TOP-REAL 2,
  C for connected compact non vertical non horizontal Subset of TOP-REAL 2;

theorem 
  1 <= k & k+1 <= len Cage(C,n) & [i,j] in Indices Gauge(C,n) & [i,
j+1] in Indices Gauge(C,n) & Cage(C,n)/.k = Gauge(C,n)*(i,j) & Cage(C,n)/.(k+1)
  = Gauge(C,n)*(i,j+1) implies i < len Gauge(C,n);

theorem 
  1 <= k & k+1 <= len Cage(C,n) & [i,j] in Indices Gauge(C,n) & [i,
j+1] in Indices Gauge(C,n) & Cage(C,n)/.k = Gauge(C,n)*(i,j+1) & Cage(C,n)/.(k+
  1) = Gauge(C,n)*(i,j) implies i > 1;

theorem 
  1 <= k & k+1 <= len Cage(C,n) & [i,j] in Indices Gauge(C,n) & [i+
1,j] in Indices Gauge(C,n) & Cage(C,n)/.k = Gauge(C,n)*(i,j) & Cage(C,n)/.(k+1)
  = Gauge(C,n)*(i+1,j) implies j > 1;

theorem 
  1 <= k & k+1 <= len Cage(C,n) & [i,j] in Indices Gauge(C,n) & [i+
1,j] in Indices Gauge(C,n) & Cage(C,n)/.k = Gauge(C,n)*(i+1,j) & Cage(C,n)/.(k+
  1) = Gauge(C,n)*(i,j) implies j < width Gauge(C,n);

theorem 
  C misses L~Cage(C,n);

theorem 
  N-bound L~Cage(C,n) = N-bound C + (N-bound C - S-bound C)/(2|^n);

theorem 
  i < j implies N-bound L~Cage(C,j) < N-bound L~Cage(C,i);

registration
  let C be connected compact non vertical non horizontal Subset of TOP-REAL 2,
  n be Element of NAT;
  cluster Cl RightComp Cage(C,n) -> compact;
end;

theorem 
  N-min C in RightComp Cage(C,n);

theorem 
  C meets RightComp Cage (C,n);

theorem 
  C misses LeftComp Cage(C,n);

theorem 
  C c= RightComp Cage(C,n);

theorem 
  C c= BDD L~Cage(C,n);

theorem 
  UBD L~Cage(C,n) c= UBD C;

definition
  let C be compact non vertical non horizontal Subset of TOP-REAL 2;
  func UBD-Family C equals

  { UBD L~Cage(C,n) where n is Element of NAT : not
  contradiction };
  func BDD-Family C equals

  { Cl BDD L~Cage(C,n) where n is Element of NAT :
  not contradiction };
end;

definition
  let C be compact non vertical non horizontal Subset of TOP-REAL 2;
  redefine func UBD-Family C -> Subset-Family of TOP-REAL 2;
  redefine func BDD-Family C -> Subset-Family of TOP-REAL 2;
end;

registration
  let C be compact non vertical non horizontal Subset of TOP-REAL 2;
  cluster UBD-Family C -> non empty;
  cluster BDD-Family C -> non empty;
end;

theorem 
  union UBD-Family C = UBD C;

theorem 
  C c= meet BDD-Family C;

theorem 
  BDD C misses LeftComp Cage(C,n);

theorem 
  BDD C c= RightComp Cage(C,n);

theorem 
  P is_inside_component_of C implies P misses L~Cage(C,n);

theorem 
  BDD C misses L~Cage(C,n);

theorem 
  COMPLEMENT UBD-Family C = BDD-Family C;

theorem 
  meet BDD-Family C = C \/ BDD C;














begin  

theorem 
  for p being Point of Sierpinski_Space st p = 0 holds {p} is closed;

theorem 
  for p being Point of Sierpinski_Space st p = 1 holds {p} is non closed;

registration
  cluster Sierpinski_Space -> non T_1;
end;

registration
  cluster complete Scott -> T_0 for TopLattice;
end;

registration
  cluster injective strict for T_0-TopSpace;
end;

registration
  cluster complete Scott strict for TopLattice;
end;

theorem 
  for I being non empty set, T being Scott TopAugmentation of
  product(I --> BoolePoset 1) holds the carrier of T = the carrier of product(I
  --> Sierpinski_Space);

theorem 
  for L1, L2 being complete LATTICE, T1 being Scott TopAugmentation
  of L1, T2 being Scott TopAugmentation of L2, h being Function of L1, L2, H
  being Function of T1, T2 st h = H & h is isomorphic holds H is
  being_homeomorphism;

theorem 
  for L1, L2 being complete LATTICE, T1 being Scott TopAugmentation
of L1, T2 being Scott TopAugmentation of L2 st L1, L2 are_isomorphic holds T1,
  T2 are_homeomorphic;

theorem 
  for S, T being non empty TopSpace st S is injective & S, T
  are_homeomorphic holds T is injective;

theorem 
  for L1, L2 being complete LATTICE, T1 being Scott TopAugmentation of
  L1, T2 being Scott TopAugmentation of L2 st L1, L2 are_isomorphic & T1 is
  injective holds T2 is injective;

definition
  let X, Y be non empty TopSpace;
  redefine pred X is_Retract_of Y means


  ex c being continuous Function
  of X, Y, r being continuous Function of Y, X st r * c = id X;
end;

theorem 
  for S, T, X, Y being non empty TopSpace st the TopStruct of S = the
  TopStruct of T & the TopStruct of X = the TopStruct of Y & S is_Retract_of X
  holds T is_Retract_of Y;

theorem 
  for T, S1, S2 being non empty TopStruct st S1, S2 are_homeomorphic &
  S1 is_Retract_of T holds S2 is_Retract_of T;

theorem 
  for S, T being non empty TopSpace st T is injective & S is_Retract_of
  T holds S is injective;

theorem 
  for J being injective non empty TopSpace, Y being non empty TopSpace
  st J is SubSpace of Y holds J is_Retract_of Y;





theorem 
  for L being complete continuous LATTICE, T being Scott
  TopAugmentation of L holds T is injective;

registration
  let L be complete continuous LATTICE;
  cluster Scott -> injective for TopAugmentation of L;
end;

registration
  let T be injective non empty TopSpace;
  cluster the TopStruct of T -> injective;
end;

begin  


definition
  let T be TopStruct;
  func Omega T -> strict TopRelStr means


  the TopStruct of it = the
  TopStruct of T & for x, y being Element of it holds x <= y iff ex Y being
  Subset of T st Y = {y} & x in Cl Y;
end;

registration
  let T be empty TopStruct;
  cluster Omega T -> empty;
end;

registration
  let T be non empty TopStruct;
  cluster Omega T -> non empty;
end;

registration
  let T be TopSpace;
  cluster Omega T -> TopSpace-like;
end;

registration
  let T be TopStruct;
  cluster Omega T -> reflexive;
end;

registration
  let T be TopStruct;
  cluster Omega T -> transitive;
end;

registration
  let T be T_0-TopSpace;
  cluster Omega T -> antisymmetric;
end;

theorem 
  for S, T being TopSpace st the TopStruct of S = the TopStruct of
  T holds Omega S = Omega T;

theorem 
  for M being non empty set, T being non empty TopSpace holds the RelStr
  of Omega product(M --> T) = the RelStr of product(M --> Omega T);



theorem 
  for S being Scott complete TopLattice holds Omega S = the TopRelStr of S;



theorem 
  for L being complete LATTICE, S being Scott TopAugmentation of L
  holds the RelStr of Omega S = the RelStr of L;

registration
  let S be Scott complete TopLattice;
  cluster Omega S -> complete;
end;

theorem 
  for T being non empty TopSpace, S being non empty SubSpace of T
  holds Omega S is full SubRelStr of Omega T;

theorem 
  for S, T being TopSpace, h being Function of S, T, g being
  Function of Omega S, Omega T st h = g & h is being_homeomorphism holds g is
  isomorphic;

theorem 
  for S, T being TopSpace st S, T are_homeomorphic holds Omega S,
  Omega T are_isomorphic;




theorem 
  for T being injective T_0-TopSpace holds Omega T is complete
  continuous LATTICE;

registration
  let T be injective T_0-TopSpace;
  cluster Omega T -> complete continuous;
end;

theorem 
  for X, Y being non empty TopSpace, f being continuous Function
  of Omega X, Omega Y holds f is monotone;

registration
  let X, Y be non empty TopSpace;
  cluster continuous -> monotone for Function of Omega X, Omega Y;
end;

theorem 
  for T being non empty TopSpace, x being Element of Omega T holds
  Cl {x} = downarrow x;

registration
  let T be non empty TopSpace, x be Element of Omega T;
  cluster Cl {x} -> non empty lower directed;
  cluster downarrow x -> closed;
end;

theorem 
  for X being TopSpace, A being open Subset of Omega X holds A is upper;

registration
  let T be TopSpace;
  cluster open -> upper for Subset of Omega T;
end;

definition
  let I be non empty set, S, T be non empty RelStr, N be net of T, i be
  Element of I such that
 the carrier of T c= the carrier of S |^ I;
  func commute(N,i,S) -> strict net of S means


  the RelStr of it = the
  RelStr of N & the mapping of it = (commute the mapping of N).i;
end;

theorem 
  for X, Y being non empty TopSpace, N being net of ContMaps(X,
  Omega Y), i being Element of N, x being Point of X holds (the mapping of
  commute(N,x,Omega Y)).i = (the mapping of N).i.x;

theorem 
  for X, Y being non empty TopSpace, N being eventually-directed
  net of ContMaps(X,Omega Y), x being Point of X holds commute(N,x,Omega Y) is
  eventually-directed;

registration
  let X, Y be non empty TopSpace, N be eventually-directed net of ContMaps(X,
  Omega Y), x be Point of X;
  cluster commute(N,x,Omega Y) -> eventually-directed;
end;

registration
  let X, Y be non empty TopSpace;
  cluster -> Function-yielding for net of ContMaps(X,Omega Y);
end;

theorem 
  for X being non empty TopSpace, Y being T_0-TopSpace, N being
net of ContMaps(X,Omega Y) st for x being Point of X holds ex_sup_of commute(N,
x,Omega Y) holds ex_sup_of rng the mapping of N, (Omega Y) |^ the carrier of X;

begin  


definition
  let T be non empty TopSpace;
  attr T is monotone-convergence means


  for D being non empty directed
  Subset of Omega T holds ex_sup_of D,Omega T & for V being open Subset of T st
  sup D in V holds D meets V;
end;

theorem 
  for S, T being non empty TopSpace st the TopStruct of S = the
  TopStruct of T & S is monotone-convergence holds T is monotone-convergence;

registration
  cluster trivial -> monotone-convergence for T_0-TopSpace;
end;

theorem 
  for S being monotone-convergence T_0-TopSpace, T being T_0-TopSpace st
  S, T are_homeomorphic holds T is monotone-convergence;

theorem 
  for S being Scott complete TopLattice holds S is monotone-convergence;

registration
  let L be complete LATTICE;
  cluster -> monotone-convergence for Scott TopAugmentation of L;
end;

registration
  let L be complete LATTICE, S be Scott TopAugmentation of L;
  cluster the TopStruct of S -> monotone-convergence;
end;

theorem 
  for X being monotone-convergence T_0-TopSpace holds Omega X is up-complete;

registration
  let X be monotone-convergence T_0-TopSpace;
  cluster Omega X -> up-complete;
end;

theorem 
  for X being monotone-convergence non empty TopSpace, N being
  eventually-directed prenet of Omega X holds ex_sup_of N;

theorem 
  for X being monotone-convergence non empty TopSpace, N being
  eventually-directed net of Omega X holds sup N in Lim N;

theorem 
  for X being monotone-convergence non empty TopSpace, N being
  eventually-directed net of Omega X holds N is convergent;

registration
  let X be monotone-convergence non empty TopSpace;
  cluster -> convergent for eventually-directed net of Omega X;
end;

theorem 
  for X being non empty TopSpace st for N being eventually-directed net
  of Omega X holds ex_sup_of N & sup N in Lim N holds X is monotone-convergence
;



theorem 
  for X being monotone-convergence non empty TopSpace, Y being
  T_0-TopSpace, f being continuous Function of Omega X, Omega Y holds f is
  directed-sups-preserving;

registration
  let X be monotone-convergence non empty TopSpace, Y be T_0-TopSpace;
  cluster continuous -> directed-sups-preserving for
Function of Omega X, Omega Y;
end;

theorem 
  for T being monotone-convergence T_0-TopSpace, R being
  T_0-TopSpace st R is_Retract_of T holds R is monotone-convergence;



theorem 
  for T being injective T_0-TopSpace, S being Scott
  TopAugmentation of Omega T holds the TopStruct of S = the TopStruct of T;

theorem 
  for T being injective T_0-TopSpace holds T is compact locally-compact sober;

theorem 
  for T being injective T_0-TopSpace holds T is monotone-convergence;

registration
  cluster injective -> monotone-convergence for T_0-TopSpace;
end;

theorem 
  for X being non empty TopSpace, Y being monotone-convergence
  T_0-TopSpace, N being net of ContMaps(X,Omega Y), f, g being Function of X,
  Omega Y st f = "\/"(rng the mapping of N, (Omega Y) |^ the carrier of X) &
  ex_sup_of rng the mapping of N, (Omega Y) |^ the carrier of X & g in rng the
  mapping of N holds g <= f;

theorem 
  for X being non empty TopSpace, Y being monotone-convergence
  T_0-TopSpace, N being net of ContMaps(X,Omega Y), x being Point of X, f being
Function of X, Omega Y st (for a being Point of X holds commute(N,a,Omega Y) is
eventually-directed) & f = "\/"(rng the mapping of N, (Omega Y) |^ the carrier
  of X) holds f.x = sup commute(N,x,Omega Y);



theorem 
  for X being non empty TopSpace, Y being monotone-convergence
  T_0-TopSpace, N being net of ContMaps(X,Omega Y) st for x being Point of X
holds commute(N,x,Omega Y) is eventually-directed holds "\/"(rng the mapping of
  N, (Omega Y) |^ the carrier of X) is continuous Function of X, Y;



theorem 
  for X being non empty TopSpace, Y being monotone-convergence
T_0-TopSpace holds ContMaps(X,Omega Y) is directed-sups-inheriting SubRelStr of
  (Omega Y) |^ the carrier of X;














begin

definition
  let C be FormalContext;
  let CP be strict FormalConcept of C;
  func @CP -> Element of ConceptLattice(C) equals

  CP;
end;

registration
  let C be FormalContext;
  cluster ConceptLattice C -> bounded;
end;

theorem 
  for C being FormalContext holds Bottom (ConceptLattice(C)) =
  Concept-with-all-Attributes(C) & Top (ConceptLattice(C)) =
  Concept-with-all-Objects(C);

theorem 
  for C being FormalContext for D being non empty Subset-Family of
  the carrier of C holds (ObjectDerivation(C)).(union D) = meet({(
  ObjectDerivation(C)).O where O is Subset of the carrier of C : O in D});

theorem 
  for C being FormalContext for D being non empty Subset-Family of(
  the carrier' of C) holds (AttributeDerivation(C)).(union D) = meet({(
  AttributeDerivation(C)).A where A is Subset of the carrier' of C : A in D});

theorem 
  for C being FormalContext for D being Subset of ConceptLattice(C)
holds "/\"(D,ConceptLattice(C)) is FormalConcept of C & "\/"(D,ConceptLattice(C
  )) is FormalConcept of C;

definition
  let C be FormalContext;
  let D be Subset of ConceptLattice(C);
  func "/\"(D,C) -> FormalConcept of C equals

  "/\"(D,ConceptLattice(C));
  func "\/"(D,C) -> FormalConcept of C equals

  "\/"(D,ConceptLattice(C));
end;

theorem 
  for C being FormalContext holds "\/"({} ConceptLattice(C),C) =
  Concept-with-all-Attributes(C) & "/\"({} ConceptLattice(C),C) =
  Concept-with-all-Objects(C);

theorem 
  for C being FormalContext holds "\/"([#] the carrier of ConceptLattice
(C),C) = Concept-with-all-Objects(C) & "/\"([#] the carrier of ConceptLattice(C
  ),C) = Concept-with-all-Attributes(C);

theorem 
  for C being FormalContext for D being non empty Subset of
  ConceptLattice(C) holds the Extent of "\/"(D,C) = (AttributeDerivation(C)).((
ObjectDerivation(C)). union {the Extent of ConceptStr(#E,I#) where E is Subset
of the carrier of C, I is Subset of the carrier' of C : ConceptStr(#E,I#) in D}
) & the Intent of "\/"(D,C) = meet {the Intent of ConceptStr(#E,I#) where E is
Subset of the carrier of C, I is Subset of the carrier' of C : ConceptStr(#E,I
  #) in D};

theorem 
  for C being FormalContext for D being non empty Subset of
  ConceptLattice(C) holds the Extent of "/\"(D,C) = meet {the Extent of
  ConceptStr(#E,I#) where E is Subset of the carrier of C, I is Subset of the
  carrier' of C : ConceptStr(#E,I#) in D} & the Intent of "/\"(D,C) = (
ObjectDerivation(C)).((AttributeDerivation(C)). union {the Intent of ConceptStr
(#E,I#) where E is Subset of the carrier of C, I is Subset of the carrier' of C
  : ConceptStr(#E,I#) in D});

theorem 
  for C being FormalContext for CP being strict FormalConcept of C
  holds "\/"({ConceptStr(#O,A#) where O is Subset of the carrier of C, A is
Subset of the carrier' of C : ex o being Object of C st o in the Extent of CP &
  O = (AttributeDerivation(C)).((ObjectDerivation(C)).{o}) & A = (
  ObjectDerivation(C)).{o}}, ConceptLattice(C)) = CP;

theorem 
  for C being FormalContext for CP being strict FormalConcept of C
  holds "/\"({ConceptStr(#O,A#) where O is Subset of the carrier of C, A is
  Subset of the carrier' of C : ex a being Attribute of C st a in the Intent of
  CP & O = (AttributeDerivation(C)).{a} & A = (ObjectDerivation(C)).((
  AttributeDerivation(C)).{a})}, ConceptLattice(C)) = CP;

definition
  let C be FormalContext;
  func gamma(C) -> Function of the carrier of C, the carrier of ConceptLattice
  (C) means


  for o being Element of C holds ex O being
  Subset of the carrier of C, A being Subset of the carrier' of C st it.o =
ConceptStr(#O,A#) & O = (AttributeDerivation(C)).((ObjectDerivation(C)).{o}) &
  A = (ObjectDerivation(C)).{o};
end;

definition
  let C be FormalContext;
  func delta(C) -> Function of the carrier' of C, the carrier of
  ConceptLattice(C) means


  for a being Element of the carrier' of C holds
  ex O being Subset of the carrier of C, A being Subset of the carrier' of C st
  it.a = ConceptStr(#O,A#) & O = (AttributeDerivation(C)).{a} & A = (
  ObjectDerivation(C)).((AttributeDerivation(C)).{a});
end;

theorem 
  for C being FormalContext for o being Object of C for a being
  Attribute of C holds (gamma(C)).o is FormalConcept of C & (delta(C)).a is
  FormalConcept of C;

theorem 
  for C being FormalContext holds rng(gamma(C)) is supremum-dense
  & rng(delta(C)) is infimum-dense;

theorem 
  for C being FormalContext for o being Object of C for a being
  Attribute of C holds o is-connected-with a iff (gamma(C)).o [= (delta(C)).a;

begin

theorem 
  for L being complete Lattice for C being FormalContext holds
ConceptLattice(C),L are_isomorphic iff ex g being Function of the carrier of C,
  the carrier of L, d being Function of the carrier' of C, the carrier of L st
rng(g) is supremum-dense & rng(d) is infimum-dense & for o being Object of C, a
  being Attribute of C holds o is-connected-with a iff g.o [= d.a;

definition
  let L be Lattice;
  func Context(L) -> strict non quasi-empty ContextStr equals

  ContextStr(#the
    carrier of L, the carrier of L, LattRel L#);
end;

theorem 
  for L being complete Lattice holds ConceptLattice(Context(L)),L
  are_isomorphic;

theorem 
  for L being Lattice holds L is complete iff ex C being FormalContext
  st ConceptLattice(C),L are_isomorphic;

begin 

registration
  let L be complete Lattice;
  cluster L.: -> complete;
end;

definition
  let C be FormalContext;
  func C.: -> strict non quasi-empty ContextStr equals

  ContextStr(#the
    carrier' of C, the carrier of C, (the Information of C)~ #);
end;

theorem 
  for C being strict FormalContext holds (C.:).: = C;

theorem 
  for C being FormalContext for O being Subset of the carrier of C
  holds (ObjectDerivation(C)).O = (AttributeDerivation(C.:)).O;

theorem 
  for C being FormalContext for A being Subset of the carrier' of
  C holds (AttributeDerivation(C)).A = (ObjectDerivation(C.:)).A;

definition
  let C be FormalContext;
  let CP be ConceptStr over C;
  func CP.: -> strict ConceptStr over C.: means


  the Extent of it = the Intent of CP & the Intent of it = the Extent of CP;
end;

registration
  let C be FormalContext;
  let CP be FormalConcept of C;
  cluster CP.: -> non empty concept-like;
end;

theorem 
  for C being strict FormalContext for CP being strict FormalConcept of
  C holds (CP.:).: = CP;

definition
  let C be FormalContext;
  func DualHomomorphism(C) -> Homomorphism of (ConceptLattice(C)).:,
  ConceptLattice(C.:) means


  for CP being strict FormalConcept of C holds it.CP = CP.:;
end;

theorem 
  for C being FormalContext holds DualHomomorphism(C) is bijective;

theorem 
  for C being FormalContext holds ConceptLattice(C.:),(ConceptLattice(C)
  ).: are_isomorphic;














begin 

reserve k,m,n for Nat,
  i1,i2,i3 for Integer,
  e for set;

theorem 
  n mod k = k - 1 implies (n+1) mod k = 0;

theorem 
  n mod k < k - 1 implies (n+1) mod k = (n mod k) + 1;

theorem 
  m <> 0 implies (k mod (m*n)) mod n = k mod n;

theorem 
  k <> 0 implies (n+1) mod k = 0 or (n+1) mod k = (n mod k) + 1;

reserve i,k,m,n,p,x,y for Nat;

theorem 
  i <> 0 & k <> 0 implies (n mod (i |^ k)) div (i |^ (k -'1)) < i;

canceled;

theorem 
  i2 > 0 & i3 >= 0 implies (i1 mod (i2*i3)) mod i3 = i1 mod i3;

begin 

definition
  let n be Nat;
  func Radix(n) -> Element of NAT equals

  2 to_power n;
end;

definition
  let k be Nat;
  func k-SD -> set equals

  {e where e is Element of INT:e <= Radix(k)-1 & e >=
  -Radix(k)+1};
end;

theorem 
  for e holds e in 0-SD iff e = 0;

theorem 
  0-SD = {0};

theorem 
  k-SD c= (k+1)-SD;

theorem 
  e in k-SD implies e is Integer;

theorem 
  k-SD c= INT;

theorem 
  i1 in k-SD implies i1 <= Radix(k)-1 & i1 >= -Radix(k)+1;

theorem 
  0 in k-SD;

registration
  let k be Nat;
  cluster k-SD -> non empty;
end;

definition
  let k be Nat;
  redefine func k-SD -> non empty Subset of INT;
end;

begin 


reserve a for Tuple of n,(k-SD);

theorem 
  i in Seg n implies a.i is Element of k-SD;

definition
  let i,k,n be Nat, x be Tuple of n,(k-SD);
  func DigA(x,i) -> Integer equals


  x.i if i in Seg n, 0 if i = 0;
end;

definition
  let i,k,n be Nat, x be Tuple of n,(k-SD);
  func DigB(x,i) -> Element of INT equals

  DigA(x,i);
end;

theorem 
  i in Seg n implies DigA(a,i) is Element of k-SD;

theorem 
  for x be Tuple of 1,INT st x/.1 = m holds x = <*m*>;

definition
  let i,k,n be Nat, x be Tuple of n,(k-SD);
  func SubDigit(x,i,k) -> Element of INT equals

  (Radix(k) |^ (i -'1))*DigB(x,i
  );
end;

definition
  let n,k be Nat, x be Tuple of n,(k-SD);
  func DigitSD(x) -> Tuple of n,INT means


  for i be Nat st i in Seg n holds it/.i = SubDigit(x,i,k);
end;

definition
  let n,k be Nat, x be Tuple of n,(k-SD);
  func SDDec(x) -> Integer equals

  Sum DigitSD(x);
end;

definition
  let i,k,x be Nat;
  func DigitDC(x,i,k) -> Element of k-SD equals

  (x mod (Radix(k) |^ i)) div (Radix(k) |^ (i -'1));
end;

definition
  let k,n,x be Nat;
  func DecSD(x,n,k) -> Tuple of n,(k-SD) means


  for i be Nat st i in Seg n holds DigA(it,i) = DigitDC(x,i,k);
end;

begin 

definition
  let x be Integer;
  func SD_Add_Carry(x) -> Integer equals


  1 if x > 2, -1 if x < -2
  otherwise 0;
end;

theorem 
  SD_Add_Carry(0) = 0;

definition
  let x be Integer, k be Nat;
  func SD_Add_Data(x,k) -> Integer equals

  x - SD_Add_Carry(x)*Radix(k);
end;

theorem 
  SD_Add_Data(0,k) = 0;

theorem 
  k >= 2 & i1 in k-SD & i2 in k-SD implies -Radix(k)+2 <=
  SD_Add_Data(i1+i2,k) & SD_Add_Data(i1+i2,k) <= Radix(k)-2;

begin 


definition
  let n,x,k be Nat;
  pred x is_represented_by n,k means


  x < (Radix(k) |^ n);
end;

theorem 
  m is_represented_by 1,k implies DigA(DecSD(m,1,k),1) = m;

theorem 
  for n st n >= 1
  for m st m is_represented_by n,k holds m = SDDec(DecSD(m,n,k));

theorem 
  m is_represented_by 1,k & n is_represented_by 1,k implies
  SD_Add_Carry(DigA(DecSD(m,1,k),1)+DigA(DecSD(n,1,k),1)) = SD_Add_Carry(m+n);

theorem 
  m is_represented_by (n+1),k implies DigA(DecSD(m,(n+1),k),n+1) =
  m div (Radix(k) |^ n);

begin 


definition
  let k,i,n be Nat, x,y be Tuple of n,(k-SD);
  assume that
 i in Seg n and
 k >= 2;
  func Add(x,y,i,k) -> Element of k-SD equals


  SD_Add_Data(DigA(x,i)+
  DigA(y,i),k) + SD_Add_Carry(DigA(x,i -'1)+DigA(y,i -'1));
end;

definition
  let n,k be Nat,x,y be Tuple of n,(k-SD);
  func x '+' y -> Tuple of n,(k-SD) means


  for i st i in Seg n holds DigA(it,i) = Add(x,y,i,k);
end;

theorem 
  k >= 2 & m is_represented_by 1,k & n is_represented_by 1,k
  implies SDDec(DecSD(m,1,k)'+'DecSD(n,1,k)) = SD_Add_Data(m+n,k);

theorem 
  for n st n >= 1 holds for k,x,y st k >= 2 & x is_represented_by n,k &
y is_represented_by n,k holds x + y = (SDDec(DecSD(x,n,k) '+' DecSD(y,n,k))) +
  (Radix(k) |^ n)* SD_Add_Carry(DigA(DecSD(x,n,k),n)+DigA(DecSD(y,n,k),n));














begin 

canceled;

theorem 
  for X being set, L being non empty RelStr, S being non empty SubRelStr
of L for f,g being Function of X, the carrier of S for f9,g9 being Function of
  X, the carrier of L st f9 = f & g9 = g & f <= g holds f9 <= g9;

theorem 
  for X being set, L being non empty RelStr for S being full non empty
  SubRelStr of L for f,g being Function of X, the carrier of S for f9,g9 being
  Function of X, the carrier of L st f9 = f & g9 = g & f9 <= g9 holds f <= g;

registration
  let S be non empty RelStr;
  let T be non empty reflexive antisymmetric RelStr;
  cluster directed-sups-preserving monotone for Function of S,T;
end;

theorem 
  for f,g being Function st f is idempotent & rng g c= rng f & rng g c=
  dom f holds f*g = g;

registration
  let S be 1-sorted;
  cluster idempotent for Function of S,S;
end;

theorem 
  for L being up-complete non empty Poset for S being
directed-sups-inheriting full non empty SubRelStr of L holds S is up-complete;

theorem 
  for L being up-complete non empty Poset for f being Function of
  L, L st f is idempotent directed-sups-preserving holds Image f is
  directed-sups-inheriting;

theorem 
  for T being non empty RelStr, S being non empty SubRelStr of T
  for f being Function of T,S holds f*incl(S,T) = id S implies f is idempotent
  Function of T, T;

definition
  let S,T be non empty Poset;
  let f be Function;
  pred f is_a_retraction_of T,S means


  f is directed-sups-preserving
  Function of T,S & f|the carrier of S = id S & S is directed-sups-inheriting
  full SubRelStr of T;
  pred f is_an_UPS_retraction_of T,S means


  f is
directed-sups-preserving Function of T,S & ex g being directed-sups-preserving
  Function of S,T st f*g = id S;
end;

definition
  let S,T be non empty Poset;
  pred S is_a_retract_of T means


  ex f being Function of T,S st f is_a_retraction_of T,S;
  pred S is_an_UPS_retract_of T means


  ex f being Function of T,S st f is_an_UPS_retraction_of T,S;
end;

theorem 
  for S,T being non empty Poset, f being Function st f
  is_a_retraction_of T,S holds f*incl(S,T) = id S;

theorem 
  for S being non empty Poset, T being up-complete non empty
  Poset for f being Function st f is_a_retraction_of T,S holds f
  is_an_UPS_retraction_of T,S;

theorem 
  for S,T being non empty Poset, f being Function st f
  is_a_retraction_of T,S holds rng f = the carrier of S;

theorem 
  for S,T being non empty Poset, f being Function st f
  is_an_UPS_retraction_of T,S holds rng f = the carrier of S;

theorem 
  for S,T being non empty Poset, f being Function st f
  is_a_retraction_of T,S holds f is idempotent Function of T,T;

theorem 
  for T,S being non empty Poset, f being Function of T,T st f
  is_a_retraction_of T,S holds Image f = the RelStr of S;

theorem 
  for T being up-complete non empty Poset for S being non empty
  Poset, f being Function of T,T st f is_a_retraction_of T,S holds f is
  directed-sups-preserving projection;

theorem 
  for S,T being non empty reflexive transitive RelStr for f being
  Function of S,T holds f is isomorphic iff f is monotone & ex g being monotone
  Function of T,S st f*g = id T & g*f = id S;

theorem 
  for S,T being non empty Poset holds S,T are_isomorphic iff ex f
being monotone Function of S,T, g being monotone Function of T,S st f*g = id T
  & g*f = id S;

theorem 
  for S,T being up-complete non empty Poset st S,T are_isomorphic
  holds S is_an_UPS_retract_of T & T is_an_UPS_retract_of S;

theorem 
  for T,S being non empty Poset for f being monotone Function of T
  ,S, g being monotone Function of S,T st f*g = id S ex h being projection
Function of T,T st h = g*f & h|the carrier of Image h = id Image h & S, Image h
  are_isomorphic;

theorem 
  for T being up-complete non empty Poset, S being non empty
  Poset for f being Function st f is_an_UPS_retraction_of T,S ex h being
directed-sups-preserving projection Function of T,T st h is_a_retraction_of T,
  Image h & S, Image h are_isomorphic;

theorem 
  for L being up-complete non empty Poset for S being non empty
  Poset st S is_a_retract_of L holds S is up-complete;

theorem 
  for L being complete non empty Poset for S being non empty
  Poset st S is_a_retract_of L holds S is complete;

theorem 
  for L being continuous complete LATTICE for S being non empty
  Poset st S is_a_retract_of L holds S is continuous;

theorem 
  for L being up-complete non empty Poset for S being non empty Poset
  st S is_an_UPS_retract_of L holds S is up-complete;

theorem 
  for L being complete non empty Poset for S being non empty Poset st
  S is_an_UPS_retract_of L holds S is complete;

theorem 
  for L being continuous complete LATTICE for S being non empty Poset st
  S is_an_UPS_retract_of L holds S is continuous;

theorem 
  for L being RelStr for S being full SubRelStr of L for R being
  SubRelStr of S holds R is full iff R is full SubRelStr of L;

theorem 
  for L being non empty transitive RelStr for S being
  directed-sups-inheriting non empty full SubRelStr of L for R being
  directed-sups-inheriting non empty SubRelStr of S holds R is
  directed-sups-inheriting SubRelStr of L;

theorem 
  for L being up-complete non empty Poset for S1,S2 being
directed-sups-inheriting full non empty SubRelStr of L st S1 is SubRelStr of S2
  holds S1 is directed-sups-inheriting full SubRelStr of S2;

begin 

definition
  let R be Relation;
  attr R is Poset-yielding means


  for x being set st x in rng R holds x is Poset;
end;

registration
  cluster Poset-yielding -> RelStr-yielding reflexive-yielding for Relation;
end;

definition
  let X be non empty set;
  let L be non empty RelStr;
  let i be Element of X;
  let Y be Subset of L|^X;
  redefine func pi(Y,i) -> Subset of L;
end;

registration
  let X be set;
  let S be Poset;
  cluster X --> S -> Poset-yielding;
end;

registration
  let I be set;
  cluster Poset-yielding non-Empty for ManySortedSet of I;
end;

registration
  let I be non empty set;
  let J be Poset-yielding non-Empty ManySortedSet of I;
  cluster product J -> transitive antisymmetric;
end;

definition
  let I be non empty set;
  let J be Poset-yielding non-Empty ManySortedSet of I;
  let i be Element of I;
  redefine func J.i -> non empty Poset;
end;

theorem 
  for I being non empty set for J being Poset-yielding non-Empty
ManySortedSet of I for f being Element of product J, X being Subset of product
J holds f is_>=_than X iff for i being Element of I holds f.i is_>=_than pi(X,i
  );

theorem 
  for I being non empty set for J being Poset-yielding non-Empty
ManySortedSet of I for f being Element of product J, X being Subset of product
J holds f is_<=_than X iff for i being Element of I holds f.i is_<=_than pi(X,i
  );

theorem 
  for I being non empty set for J being Poset-yielding non-Empty
ManySortedSet of I for X being Subset of product J holds ex_sup_of X, product J
  iff for i being Element of I holds ex_sup_of pi(X,i), J.i;

theorem 
  for I being non empty set for J being Poset-yielding non-Empty
ManySortedSet of I for X being Subset of product J holds ex_inf_of X, product J
  iff for i being Element of I holds ex_inf_of pi(X,i), J.i;

theorem 
  for I being non empty set for J being Poset-yielding non-Empty
  ManySortedSet of I for X being Subset of product J st ex_sup_of X, product J
  for i being Element of I holds (sup X).i = sup pi(X,i);

theorem 
  for I being non empty set for J being Poset-yielding non-Empty
  ManySortedSet of I for X being Subset of product J st ex_inf_of X, product J
  for i being Element of I holds (inf X).i = inf pi(X,i);

theorem 
  for I being non empty set for J being RelStr-yielding non-Empty
reflexive-yielding ManySortedSet of I for X being directed Subset of product J
  for i being Element of I holds pi(X,i) is directed;

theorem 
  for I being non empty set for J,K being RelStr-yielding
non-Empty ManySortedSet of I st for i being Element of I holds K.i is SubRelStr
  of J.i holds product K is SubRelStr of product J;

theorem 
  for I being non empty set for J,K being RelStr-yielding
  non-Empty ManySortedSet of I st for i being Element of I holds K.i is full
  SubRelStr of J.i holds product K is full SubRelStr of product J;

theorem 
  for L being non empty RelStr, S being non empty SubRelStr of L, X
  being set holds S|^X is SubRelStr of L|^X;

theorem 
  for L being non empty RelStr, S be full non empty SubRelStr of L
  , X be set holds S|^X is full SubRelStr of L|^X;

begin 

definition
  let S,T be non empty RelStr, X be set;
  pred S inherits_sup_of X,T means


  ex_sup_of X,T implies "\/"(X, T) in the carrier of S;
  pred S inherits_inf_of X,T means


  ex_inf_of X,T implies "/\"(X, T) in the carrier of S;
end;

theorem 
  for T being non empty transitive RelStr for S being full non
empty SubRelStr of T for X being Subset of S holds S inherits_sup_of X,T iff (
  ex_sup_of X,T implies ex_sup_of X, S & sup X = "\/"(X, T));

theorem 
  for T being non empty transitive RelStr for S being full non empty
  SubRelStr of T for X being Subset of S holds S inherits_inf_of X,T iff (
  ex_inf_of X,T implies ex_inf_of X, S & inf X = "/\"(X, T));

scheme 

  ProductSupsInheriting { I() -> non empty set, J,K() -> Poset-yielding
non-Empty ManySortedSet of I(), P[set, set] }: for X being Subset of product K(
  ) st P[X, product K()] holds product K() inherits_sup_of X, product J()
provided
 for X being Subset of product K() st P[X, product K()] for i being
Element of I() holds P[pi(X, i), K().i] and
 for i being Element of I() holds K().i is full SubRelStr of J().i and
 for i being Element of I(), X being Subset of K().i st P[X, K().i]
holds K().i inherits_sup_of X, J().i;

scheme 

  PowerSupsInheriting { I() -> non empty set, L() -> non empty Poset, S() ->
non empty full SubRelStr of L(), P[set, set] }: for X being Subset of S()|^I()
  st P[X, S()|^I()] holds S()|^I() inherits_sup_of X, L()|^I()
provided
 for X being Subset of S()|^I() st P[X, S()|^I()] for i being Element
of I() holds P[pi(X, i), S()] and
 for X being Subset of S() st P[X, S()] holds S() inherits_sup_of X, L();

scheme 

  ProductInfsInheriting { I() -> non empty set, J,K() -> Poset-yielding
non-Empty ManySortedSet of I(), P[set, set] }: for X being Subset of product K(
  ) st P[X, product K()] holds product K() inherits_inf_of X, product J()
provided
 for X being Subset of product K() st P[X, product K()] for i being
Element of I() holds P[pi(X, i), K().i] and
 for i being Element of I() holds K().i is full SubRelStr of J().i and
 for i being Element of I(), X being Subset of K().i st P[X, K().i]
holds K().i inherits_inf_of X, J().i;

scheme 

  PowerInfsInheriting { I() -> non empty set, L() -> non empty Poset, S() ->
non empty full SubRelStr of L(), P[set, set] }: for X being Subset of S()|^I()
  st P[X, S()|^I()] holds S()|^I() inherits_inf_of X, L()|^I()
provided
 for X being Subset of S()|^I() st P[X, S()|^I()] for i being Element
of I() holds P[pi(X, i), S()] and
 for X being Subset of S() st P[X, S()] holds S() inherits_inf_of X, L();

registration
  let I be set;
  let L be non empty RelStr;
  let X be non empty Subset of L|^I;
  let i be set;
  cluster pi(X,i) -> non empty;
end;

theorem 
  for L being non empty Poset for S being directed-sups-inheriting non
  empty full SubRelStr of L for X be non empty set holds S|^X is
  directed-sups-inheriting SubRelStr of L|^X;

registration
  let I be non empty set;
  let J be RelStr-yielding non-Empty ManySortedSet of I;
  let X be non empty Subset of product J;
  let i be set;
  cluster pi(X,i) -> non empty;
end;

theorem 
  for X being non empty set for L being up-complete non empty
  Poset holds L|^X is up-complete;

registration
  let L be up-complete non empty Poset;
  let X be non empty set;
  cluster L|^X -> up-complete;
end;

begin 

theorem 
  for T being non empty TopSpace, S being non empty SubSpace of T
  for f being Function of T,S st f is being_a_retraction holds rng f = the
  carrier of S;

theorem 
  for T being non empty TopSpace, S being non empty SubSpace of T for f
  being continuous Function of T,S st f is being_a_retraction holds f is
  idempotent;

theorem 
  for T being non empty TopSpace, V being open Subset of T holds
  chi(V, the carrier of T) is continuous Function of T, Sierpinski_Space;

theorem 
  for T being non empty TopSpace, x,y being Element of T st for W being
  open Subset of T st y in W holds x in W holds (0,1) --> (y,x) is continuous
  Function of Sierpinski_Space, T;

theorem 
  for T being non empty TopSpace, x,y being Element of T for V being
  open Subset of T st x in V & not y in V holds chi(V, the carrier of T)*((0,1)
  --> (y,x)) = id Sierpinski_Space;

theorem 
  for T being non empty 1-sorted, V,W being Subset of T for S being
  TopAugmentation of BoolePoset 1 for f, g being Function of T, S st f = chi(V,
  the carrier of T) & g = chi(W, the carrier of T) holds V c= W iff f <= g;

theorem 
  for L being non empty RelStr, X being non empty set for R being full
non empty SubRelStr of L|^X st for a being set holds a is Element of R iff ex x
  being Element of L st a = X --> x holds L, R are_isomorphic;

theorem 
  for S,T being non empty TopSpace holds S, T are_homeomorphic iff ex f
  being continuous Function of S,T, g being continuous Function of T,S st f*g =
  id T & g*f = id S;

theorem 
  for T, S, R being non empty TopSpace for f being Function of T,S
  , g being Function of S,T, h being Function of S, R st f*g = id S & h is
  being_homeomorphism holds (h*f)*(g*(h")) = id R;

theorem 
  for T, S, R being non empty TopSpace st S is_Retract_of T & S, R
  are_homeomorphic holds R is_Retract_of T;

theorem 
  for T being non empty TopSpace, S being non empty SubSpace of T
  holds incl(S,T) is continuous;

theorem 
  for T being non empty TopSpace for S being non empty SubSpace of
T, f being continuous Function of T,S st f is being_a_retraction holds f*incl(S
  ,T) = id S;

theorem 
  for T being non empty TopSpace, S being non empty SubSpace of T
  st S is_a_retract_of T holds S is_Retract_of T;

theorem 
  for R,T being non empty TopSpace holds R is_Retract_of T iff ex S
  being non empty SubSpace of T st S is_a_retract_of T & S,R are_homeomorphic;














begin 

theorem 
  for f,g,h being Function st dom f /\ dom g c= dom h holds f+*g+*h = g+*f+*h;

theorem 
  for f,g,h being Function st f c= g & (rng h) /\ dom g c= dom f
  holds g*h = f*h;

theorem 
  for f,g,h being Function st dom f misses rng h & g.:dom h misses
  dom f holds f*(g+*h) = f*g;

theorem 
  for f1,f2,g1,g2 being Function st f1 tolerates f2 & g1 tolerates
  g2 holds f1*g1 tolerates f2*g2;

theorem 
  for X1,Y1, X2,Y2 being non empty set for f being Function of X1,
  X2, g being Function of Y1,Y2 st f c= g holds f* c= g*;

theorem 
  for X1,Y1, X2,Y2 be non empty set for f being Function of X1,X2,
  g being Function of Y1,Y2 st f tolerates g holds f* tolerates g*;

definition
  let X be set, f be Function;
  func X-indexing(f) -> ManySortedSet of X equals

  (id X) +* (f|X);
end;

theorem 
  for X being set, f being Function holds rng (X-indexing f) = (X \
  dom f) \/ f.:X;

theorem 
  for X being non empty set, f being Function, x being Element of X
  holds (X-indexing f).x = ((id X) +* f).x;

theorem 
  for X,x being set, f being Function st x in X holds (x in dom f
implies (X-indexing f).x = f.x) & (not x in dom f implies (X-indexing f).x = x)
;

theorem 
  for X being set, f being Function st dom f = X holds X-indexing f = f;

theorem 
  for X being set, f being Function holds X-indexing (X-indexing f
  ) = X-indexing f;

theorem 
  for X being set, f being Function holds X-indexing ((id X)+*f) = X-indexing f
;

theorem 
  for X being set, f being Function st f c= id X holds X-indexing f = id X;

theorem 
  for X being set holds X-indexing {} = id X;

theorem 
  for X being set, f being Function st X c= dom f holds X-indexing f = f |X;

theorem 
  for f being Function holds {}-indexing f = {};

theorem 
  for X,Y being set, f being Function st X c= Y holds (Y-indexing
  f)|X = X-indexing f;

theorem 
  for X,Y being set, f being Function holds (X \/ Y)-indexing f =
  (X-indexing f) +* (Y-indexing f);

theorem 
  for X,Y being set, f being Function holds X-indexing f tolerates Y-indexing f
;

theorem 
  for X,Y being set, f being Function holds (X \/ Y)-indexing f =
  (X-indexing f) \/ (Y-indexing f);

theorem 
  for X being non empty set, f,g being Function st rng g c= X
  holds (X-indexing f)*g = ((id X) +* f)*g;

theorem 
  for f,g being Function st dom f misses dom g & rng g misses dom f for
  X being set holds f*(X-indexing g) = f|X;

definition
  let f be Function;
  mode rng-retract of f -> Function means


    dom it = rng f & f*it = id rng f;
end;

theorem 
  for f being Function, g being rng-retract of f holds rng g c= dom f;

theorem 
  for f being Function, g being rng-retract of f for x being set
  st x in rng f holds g.x in dom f & f.(g.x) = x;

theorem 
  for f being Function st f is one-to-one holds f" is rng-retract of f;

theorem 
  for f being Function st f is one-to-one for g being rng-retract of f
  holds g = f";

theorem 
  for f1,f2 being Function st f1 tolerates f2 for g1 being
rng-retract of f1, g2 being rng-retract of f2 holds g1+*g2 is rng-retract of f1
  +*f2;

theorem 
  for f1,f2 being Function st f1 c= f2 for g1 being rng-retract of f1 ex
  g2 being rng-retract of f2 st g1 c= g2;

begin 

definition
  let S be non empty non void ManySortedSign;
  let f,g be Function;
  pred f,g form_a_replacement_in S means


  for o1,o2 being OperSymbol of
S st ((id the carrier' of S) +* g).o1 = ((id the carrier' of S) +* g).o2 holds
  ((id the carrier of S) +* f)*the_arity_of o1 = ((id the carrier of S) +* f)*
the_arity_of o2 & ((id the carrier of S) +* f).the_result_sort_of o1 = ((id the
  carrier of S) +* f).the_result_sort_of o2;
end;

theorem 
  for S being non empty non void ManySortedSign, f,g being
Function holds f,g form_a_replacement_in S iff for o1,o2 being OperSymbol of S
  st ((the carrier' of S)-indexing g).o1 = ((the carrier' of S)-indexing g).o2
  holds ((the carrier of S)-indexing f)*the_arity_of o1 = ((the carrier of S)
  -indexing f)*the_arity_of o2 & ((the carrier of S)-indexing f).
  the_result_sort_of o1 = ((the carrier of S)-indexing f).the_result_sort_of o2
;

theorem 
  for S being non empty non void ManySortedSign, f,g being
Function holds f,g form_a_replacement_in S iff (the carrier of S)-indexing f, (
  the carrier' of S)-indexing g form_a_replacement_in S;

reserve S,S9 for non void Signature,
  f,g for Function;

theorem 
  f,g form_morphism_between S,S9 implies f,g form_a_replacement_in S;

theorem 
  f, {} form_a_replacement_in S;

theorem 
  g is one-to-one & (the carrier' of S) /\ rng g c= dom g implies
  f,g form_a_replacement_in S;

theorem 
  g is one-to-one & rng g misses the carrier' of S implies f,g
  form_a_replacement_in S;

registration
  let X be set, Y be non empty set;
  let a be Function of Y, X*;
  let r be Function of Y, X;
  cluster ManySortedSign(#X, Y, a, r#) -> non void;
end;

definition
  let S be non empty non void ManySortedSign;
  let f,g be Function such that
 f,g form_a_replacement_in S;
  func S with-replacement (f,g) -> strict non empty non void ManySortedSign
  means


  (the carrier of S)-indexing f, (the carrier' of S)-indexing g
  form_morphism_between S, it & the carrier of it = rng ((the carrier of S)
  -indexing f) & the carrier' of it = rng ((the carrier' of S)-indexing g);
end;

theorem 
  for S1,S2 being non void Signature for f being Function of the
  carrier of S1, the carrier of S2 for g being Function st f,g
  form_morphism_between S1,S2 holds f**the Arity of S1 = (the Arity of S2)*g;

theorem 
  f,g form_a_replacement_in S implies (the carrier of S)-indexing
  f is Function of the carrier of S, the carrier of S with-replacement (f,g);

theorem 
  f,g form_a_replacement_in S implies for f9 being Function of the
carrier of S, the carrier of S with-replacement (f,g) st f9 = (the carrier of S
  )-indexing f for g9 being rng-retract of (the carrier' of S)-indexing g holds
  the Arity of S with-replacement (f,g) = f9* *(the Arity of S)*g9;

theorem 
  f,g form_a_replacement_in S implies for g9 being rng-retract of
(the carrier' of S)-indexing g holds the ResultSort of S with-replacement (f,g)
  = ((the carrier of S)-indexing f)*(the ResultSort of S)*g9;

theorem 
  f,g form_morphism_between S,S9 implies S with-replacement (f,g)
  is Subsignature of S9;

theorem 
  f,g form_a_replacement_in S iff (the carrier of S)-indexing f, (
the carrier' of S)-indexing g form_morphism_between S, S with-replacement (f,g)
;

theorem 
  dom f c= the carrier of S & dom g c= the carrier' of S & f,g
form_a_replacement_in S implies (id the carrier of S) +* f, (id the carrier' of
  S) +* g form_morphism_between S, S with-replacement (f,g);

theorem 
  dom f = the carrier of S & dom g = the carrier' of S & f,g
form_a_replacement_in S implies f,g form_morphism_between S, S with-replacement
  (f,g);

theorem 
  f,g form_a_replacement_in S implies S with-replacement ((the
  carrier of S)-indexing f, g) = S with-replacement (f,g);

theorem 
  f,g form_a_replacement_in S implies S with-replacement (f, (the
  carrier' of S)-indexing g) = S with-replacement (f,g);

begin 

definition
  let S be Signature;
  mode Extension of S -> Signature means


    S is Subsignature of it;
end;

theorem 
  for S being Signature holds S is Extension of S;

theorem 
  for S1 being Signature, S2 being Extension of S1, S3 being
  Extension of S2 holds S3 is Extension of S1;

theorem 
  for S1,S2 being non empty Signature st S1 tolerates S2 holds S1
  +*S2 is Extension of S1;

theorem 
  for S1, S2 being non empty Signature holds S1+*S2 is Extension of S2;

theorem 
  for S1,S2,S being non empty ManySortedSign for f1,g1, f2,g2
being Function st f1 tolerates f2 & f1, g1 form_morphism_between S1, S & f2, g2
form_morphism_between S2, S holds f1+*f2, g1+*g2 form_morphism_between S1+*S2,
  S;

theorem 
  for S1,S2,E being non empty Signature holds E is Extension of S1 & E
  is Extension of S2 iff S1 tolerates S2 & E is Extension of S1+*S2;

registration
  let S be non empty Signature;
  cluster -> non empty for Extension of S;
end;

registration
  let S be non void Signature;
  cluster -> non void for Extension of S;
end;

theorem 
  for S,T being Signature st S is empty holds T is Extension of S;

registration
  let S be Signature;
  cluster non empty non void strict for Extension of S;
end;

theorem 
  for S being non void Signature, E being Extension of S st f,g
  form_a_replacement_in E holds f,g form_a_replacement_in S;

theorem 
  for S being non void Signature, E being Extension of S st f,g
  form_a_replacement_in E holds E with-replacement(f,g) is Extension of S
  with-replacement(f,g);

theorem 
  for S1,S2 being non void Signature st S1 tolerates S2 for f,g being
Function st f,g form_a_replacement_in S1+*S2 holds (S1+*S2) with-replacement (f
  ,g) = (S1 with-replacement (f,g))+*(S2 with-replacement (f,g));

begin 

definition
  mode Algebra means


    ex S being non void Signature st it is feasible MSAlgebra over S;
end;

definition
  let S be Signature;
  mode Algebra of S -> Algebra means


    ex E being non void Extension of S st it is feasible MSAlgebra over E;
end;

theorem 
  for S being non void Signature, A being feasible MSAlgebra over S
  holds A is Algebra of S;

theorem 
  for S being Signature, E being Extension of S, A being Algebra of E
  holds A is Algebra of S;

theorem 
  for S being Signature, E being non empty Signature, A being
MSAlgebra over E st A is Algebra of S holds the carrier of S c= the carrier of
  E & the carrier' of S c= the carrier' of E;

theorem 
  for S being non void Signature, E being non empty Signature for
A being MSAlgebra over E st A is Algebra of S for o being OperSymbol of S holds
  (the Charact of A).o is Function of (the Sorts of A)#.the_arity_of o, (the
  Sorts of A).the_result_sort_of o;

theorem 
  for S being non empty Signature, A being Algebra of S for E being non
  empty ManySortedSign st A is MSAlgebra over E holds A is MSAlgebra over E+*S;

theorem 
  for S1,S2 being non empty Signature for A being MSAlgebra over
S1 st A is MSAlgebra over S2 holds the carrier of S1 = the carrier of S2 & the
  carrier' of S1 = the carrier' of S2;

registration
  let S be non void Signature, A be non-empty disjoint_valued MSAlgebra over S;
  cluster the Sorts of A -> one-to-one;
end;

theorem 
  for S being non void Signature for A being disjoint_valued
  MSAlgebra over S for C1,C2 being Component of the Sorts of A holds C1 = C2 or
  C1 misses C2;

theorem 
  for S,S9 being non void Signature for A being non-empty
  disjoint_valued MSAlgebra over S st A is MSAlgebra over S9 holds the
  ManySortedSign of S = the ManySortedSign of S9;

theorem 
  for S9 being non void Signature for A being non-empty disjoint_valued
  MSAlgebra over S st A is Algebra of S9 holds S is Extension of S9;














begin

notation
  let I be set;
  let J be RelStr-yielding ManySortedSet of I;
  synonym I-POS_prod J for product J;
end;

notation
  let I be set;
  let J be TopStruct-yielding non-Empty ManySortedSet of I;
  synonym I-TOP_prod J for product J;
end;



definition
  let X,Y be non empty TopSpace;
  func oContMaps(X, Y) -> non empty strict RelStr equals

  ContMaps(X, Omega Y);
end;

registration
  let X,Y be non empty TopSpace;
  cluster oContMaps(X, Y) -> reflexive transitive constituted-Functions;
end;

registration
  let X be non empty TopSpace;
  let Y be non empty T_0 TopSpace;
  cluster oContMaps(X, Y) -> antisymmetric;
end;

theorem 
  for X,Y being non empty TopSpace for a being set holds a is
  Element of oContMaps(X, Y) iff a is continuous Function of X, Omega Y;

theorem 
  for X,Y being non empty TopSpace for a being set holds a is
  Element of oContMaps(X, Y) iff a is continuous Function of X, Y;

theorem 
  for X,Y being non empty TopSpace for a,b being Element of
oContMaps(X,Y) for f,g being Function of X, Omega Y st a = f & b = g holds a <=
  b iff f <= g;

definition
  let X,Y be non empty TopSpace;
  let x be Point of X;
  let A be Subset of oContMaps(X,Y);
  redefine func pi(A,x) -> Subset of Omega Y;
end;

registration
  let X,Y be non empty TopSpace;
  let x be set;
  let A be non empty Subset of oContMaps(X,Y);
  cluster pi(A,x) -> non empty;
end;

theorem 
  Omega Sierpinski_Space is TopAugmentation of BoolePoset 1;

theorem 
  for X being non empty TopSpace ex f being Function of InclPoset
  the topology of X, oContMaps(X, Sierpinski_Space) st f is isomorphic & for V
  being open Subset of X holds f.V = chi(V, the carrier of X);

theorem 
  for X being non empty TopSpace holds InclPoset the topology of X,
  oContMaps(X, Sierpinski_Space) are_isomorphic;



definition
  let X,Y,Z be non empty TopSpace;
  let f be continuous Function of Y,Z;
  func oContMaps(X, f) -> Function of oContMaps(X, Y), oContMaps(X, Z) means


   for g being continuous Function of X,Y holds it.g = f*g;
  func oContMaps(f, X) -> Function of oContMaps(Z, X), oContMaps(Y, X) means


   for g being continuous Function of Z, X holds it.g = g*f;
end;

theorem 
  for X being non empty TopSpace for Y being monotone-convergence
  T_0-TopSpace holds oContMaps(X, Y) is up-complete;

theorem 
  for X,Y,Z being non empty TopSpace for f being continuous
  Function of Y,Z holds oContMaps(X, f) is monotone;

theorem 
  for X,Y being non empty TopSpace for f being continuous Function of Y,
  Y st f is idempotent holds oContMaps(X, f) is idempotent;

theorem 
  for X,Y,Z being non empty TopSpace for f being continuous
  Function of Y,Z holds oContMaps(f, X) is monotone;

theorem 
  for X,Y being non empty TopSpace for f being continuous Function
  of Y,Y st f is idempotent holds oContMaps(f, X) is idempotent;

theorem 
  for X,Y,Z being non empty TopSpace for f being continuous
  Function of Y,Z for x being Element of X, A being Subset of oContMaps(X, Y)
  holds pi(oContMaps(X,f).:A, x) = f.:pi(A, x);



theorem 
  for X being non empty TopSpace for Y,Z being
monotone-convergence T_0-TopSpace for f being continuous Function of Y,Z holds
  oContMaps(X, f) is directed-sups-preserving;

theorem 
  for X,Y,Z being non empty TopSpace for f being continuous
  Function of Y,Z for x being Element of Y, A being Subset of oContMaps(Z, X)
  holds pi(oContMaps(f, X).:A, x) = pi(A, f.x);

theorem 
  for Y,Z being non empty TopSpace for X being
monotone-convergence T_0-TopSpace for f being continuous Function of Y,Z holds
  oContMaps(f, X) is directed-sups-preserving;



theorem 
  for X,Z being non empty TopSpace for Y being non empty SubSpace
  of Z holds oContMaps(X, Y) is full SubRelStr of oContMaps(X, Z);

theorem 
  for Z being monotone-convergence T_0-TopSpace for Y being non
  empty SubSpace of Z for f being continuous Function of Z,Y st f is
being_a_retraction holds Omega Y is directed-sups-inheriting SubRelStr of Omega
  Z;

theorem 
  for X being non empty TopSpace for Z being monotone-convergence
  T_0-TopSpace for Y being non empty SubSpace of Z for f being continuous
  Function of Z,Y st f is being_a_retraction holds oContMaps(X, f)
  is_a_retraction_of oContMaps(X, Z), oContMaps(X, Y);

theorem 
  for X being non empty TopSpace for Z being monotone-convergence
  T_0-TopSpace for Y being non empty SubSpace of Z st Y is_a_retract_of Z holds
  oContMaps(X, Y) is_a_retract_of oContMaps(X, Z);

theorem 
  for X,Y,Z being non empty TopSpace for f being continuous
Function of Y,Z st f is being_homeomorphism holds oContMaps(X, f) is isomorphic
;

theorem 
  for X,Y,Z being non empty TopSpace st Y,Z are_homeomorphic holds
  oContMaps(X, Y), oContMaps(X, Z) are_isomorphic;



theorem 
  for X being non empty TopSpace for Z being monotone-convergence
  T_0-TopSpace for Y being non empty SubSpace of Z st Y is_a_retract_of Z &
  oContMaps(X, Z) is complete continuous holds oContMaps(X, Y) is complete
  continuous;

theorem 
  for X being non empty TopSpace for Y,Z being
  monotone-convergence T_0-TopSpace st Y is_Retract_of Z & oContMaps(X, Z) is
  complete continuous holds oContMaps(X, Y) is complete continuous;

theorem 
  for Y being non trivial T_0-TopSpace st not Y is T_1 holds
  Sierpinski_Space is_Retract_of Y;

theorem 
  for X being non empty TopSpace for Y being non trivial
  T_0-TopSpace st oContMaps(X, Y) is with_suprema holds not Y is T_1;

registration
  cluster Sierpinski_Space -> non trivial monotone-convergence;
end;

registration
  cluster injective monotone-convergence non trivial for T_0-TopSpace;
end;



theorem 
  for X being non empty TopSpace for Y being monotone-convergence
  non trivial T_0-TopSpace st oContMaps(X, Y) is complete continuous holds
  InclPoset the topology of X is continuous;

theorem 
  for X being non empty TopSpace, x being Point of X for Y being
  monotone-convergence T_0-TopSpace ex F being directed-sups-preserving
  projection Function of oContMaps(X,Y), oContMaps(X,Y) st (for f being
  continuous Function of X,Y holds F.f = X --> (f.x)) & ex h being continuous
  Function of X,X st h = X --> x & F = oContMaps(h, Y);



theorem 
  for X being non empty TopSpace, Y being monotone-convergence
  T_0-TopSpace st oContMaps(X, Y) is complete continuous holds Omega Y is
  complete continuous;

theorem 
  for X being non empty 1-sorted, I being non empty set for J
  being TopStruct-yielding non-Empty ManySortedSet of I
  for f being Function of X,
  I-TOP_prod J for i being Element of I holds (commute f).i = proj(J,i)*f;

theorem 
  for S being 1-sorted, M being set holds Carrier (M --> S) = M
  --> the carrier of S;

theorem 
  for X,Y being non empty TopSpace, M being non empty set for f
  being continuous Function of X, M-TOP_prod (M --> Y) holds commute f is
  Function of M, the carrier of oContMaps(X, Y);

theorem 
  for X,Y being non empty TopSpace holds the carrier of oContMaps(
  X, Y) c= Funcs(the carrier of X, the carrier of Y);

theorem 
  for X,Y being non empty TopSpace, M being non empty set for f
  being Function of M, the carrier of oContMaps(X, Y) holds commute f is
  continuous Function of X, M-TOP_prod (M --> Y);

theorem 
  for X being non empty TopSpace, M being non empty set ex F being
  Function of oContMaps(X, M-TOP_prod (M --> Sierpinski_Space)), M-POS_prod (M
--> oContMaps(X, Sierpinski_Space)) st F is isomorphic & for f being continuous
  Function of X, M-TOP_prod (M --> Sierpinski_Space) holds F.f = commute f;

theorem 
  for X being non empty TopSpace, M being non empty set holds
oContMaps(X, M-TOP_prod (M --> Sierpinski_Space)), M-POS_prod (M --> oContMaps(
  X, Sierpinski_Space)) are_isomorphic;



theorem 
  for X being non empty TopSpace st InclPoset the topology of X is
continuous for Y being injective T_0-TopSpace holds oContMaps(X, Y) is complete
  continuous;

registration
  cluster non trivial complete Scott for TopLattice;
end;



theorem 
  for X being non empty TopSpace for L being non trivial complete Scott
  TopLattice holds oContMaps(X, L) is complete continuous iff InclPoset the
  topology of X is continuous & L is continuous;

registration
  let f be Function;
  cluster Union disjoin f -> Relation-like;
end;

definition
  let f be Function;
  func *graph f -> Relation equals

  (Union disjoin f)~;
end;

reserve x,y for set,
  f for Function;

theorem 
  [x,y] in *graph f iff x in dom f & y in f.x;

theorem 
  for X being finite set holds proj1 X is finite & proj2 X is finite;



theorem 
  for X,Y being non empty TopSpace for S being Scott
TopAugmentation of InclPoset the topology of Y for f being Function of X, S st
  *graph f is open Subset of [:X,Y:] holds f is continuous;

definition
  let W be Relation, X be set;
  func (W,X)*graph -> Function means


  dom it = X & for x st x in X holds it.x = Im(W,x);
end;

theorem 
  for W being Relation, X being set st dom W c= X holds *graph((W,
  X)*graph) = W;

registration
  let X, Y be TopSpace;
  cluster -> Relation-like for Subset of [:X,Y:];
  cluster -> Relation-like for Element of the topology of [:X,Y:];
end;

theorem 
  for X,Y being non empty TopSpace for W being open Subset of [:X,
  Y:] for x being Point of X holds Im(W,x) is open Subset of Y;



theorem 
  for X,Y being non empty TopSpace for S being Scott
TopAugmentation of InclPoset the topology of Y for W being open Subset of [:X,Y
  :] holds (W, the carrier of X)*graph is continuous Function of X, S;



theorem 
  for X,Y being non empty TopSpace for S being Scott
TopAugmentation of InclPoset the topology of Y for W1, W2 being open Subset of
  [:X,Y:] st W1 c= W2 for f1, f2 being Element of oContMaps(X, S) st f1 = (W1,
  the carrier of X)*graph & f2 = (W2, the carrier of X)*graph holds f1 <= f2;



theorem 
  for X,Y being non empty TopSpace for S being Scott TopAugmentation of
InclPoset the topology of Y ex F being Function of InclPoset the topology of [:
  X, Y:], oContMaps(X, S) st F is monotone & for W being open Subset of [:X,Y:]
  holds F.W = (W, the carrier of X)*graph;














begin

definition
  let F be Function;
  attr F is uncurrying means


  (for x being set st x in dom F holds x is
  Function-yielding Function) & for f being Function st f in dom F holds F.f =
  uncurry f;
  attr F is currying means


  (for x being set st x in dom F holds x is
Function & proj1 x is Relation) & for f being Function st f in dom F holds F.f
  = curry f;
  attr F is commuting means


  (for x being set st x in dom F holds x is
  Function-yielding Function) & for f being Function st f in dom F holds F.f =
  commute f;
end;

registration
  cluster empty -> uncurrying currying commuting for Function;
end;

registration
  cluster uncurrying currying commuting for Function;
end;

registration
  let F be uncurrying Function, X be set;
  cluster F|X -> uncurrying;
end;

registration
  let F be currying Function, X be set;
  cluster F|X -> currying;
end;

theorem 
  for X,Y,Z,D being set st D c= Funcs(X, Funcs(Y,Z)) ex F being
  ManySortedSet of D st F is uncurrying & rng F c= Funcs([:X,Y:], Z);

theorem 
  for X,Y,Z,D being set st D c= Funcs([:X,Y:], Z) ex F being
ManySortedSet of D st F is currying & ((Y = {} implies X = {}) implies rng F c=
  Funcs(X, Funcs(Y, Z)));

registration
  let X,Y,Z be set;
  cluster uncurrying for ManySortedSet of Funcs(X, Funcs(Y, Z));
  cluster currying for ManySortedSet of Funcs([:X, Y:], Z);
end;

theorem 
  for A,B being non empty set, C being set for f,g being commuting
Function st dom f c= Funcs(A, Funcs(B, C)) & rng f c= dom g holds g*f = id dom
  f;

theorem 
  for B being non empty set, A,C being set for f being uncurrying
Function for g being currying Function st dom f c= Funcs(A, Funcs(B, C)) & rng
  f c= dom g holds g*f = id dom f;

theorem 
  for A,B,C being set for f being currying Function for g being
uncurrying Function st dom f c= Funcs([:A, B:], C) & rng f c= dom g holds g*f =
  id dom f;

theorem 
  for f being Function-yielding Function for i,A being set st i in
  dom commute f holds ((commute f).i).:A c= pi(f.:A, i);

theorem 
  for f being Function-yielding Function for i,A being set st for g
being Function st g in f.:A holds i in dom g holds pi(f.:A, i) c= ((commute f).
  i).:A;

theorem 
  for X,Y being set, f being Function st rng f c= Funcs(X, Y) for i
  ,A being set st i in X holds ((commute f).i).:A = pi(f.:A, i);

theorem 
  for f being Function for i,A being set st [:A,{i}:] c= dom f
  holds pi((curry f).:A, i) = f.:[:A,{i}:];

registration
  let T be constituted-Functions 1-sorted;
  cluster the carrier of T -> functional;
end;

registration
  cluster constituted-Functions complete strict for LATTICE;
  cluster constituted-Functions non empty for 1-sorted;
end;

registration
  let T be constituted-Functions non empty RelStr;
  cluster -> constituted-Functions for non empty SubRelStr of T;
end;

theorem 
  for S,T being complete LATTICE for f being idempotent Function
  of T,T for h being Function of S, Image f holds f*h = h;

theorem 
  for S being non empty RelStr for T,T1 being non empty RelStr st T is
  SubRelStr of T1 for f being Function of S, T for f1 being Function of S, T1
  holds f is monotone & f=f1 implies f1 is monotone;

theorem 
  for S being non empty RelStr for T,T1 being non empty RelStr st
T is full SubRelStr of T1 for f being Function of S, T for f1 being Function of
  S, T1 holds f1 is monotone & f=f1 implies f is monotone;

theorem 
  for X being set, V being Subset of X holds chi(V,X)"{1} = V &
  chi(V,X)"{0} = X\V;

begin

definition
  let X be non empty set;
  let T be non empty RelStr;
  let f be Element of T|^X;
  let x be Element of X;
  redefine func f.x -> Element of T;
end;

theorem 
  for X being non empty set, T being non empty RelStr for f,g
being Element of T|^X holds f <= g iff for x being Element of X holds f.x <= g.
  x;

theorem 
  for X being set for L,S being non empty RelStr st the RelStr of
  L = the RelStr of S holds L|^X = S|^X;

theorem 
  for S1,S2,T1,T2 being non empty TopSpace st the TopStruct of S1 = the
TopStruct of S2 & the TopStruct of T1 = the TopStruct of T2 holds oContMaps(S1,
  T1) = oContMaps(S2, T2);

theorem 
  for X being set ex f being Function of BoolePoset X, (BoolePoset
  1)|^X st f is isomorphic & for Y being Subset of X holds f.Y = chi(Y,X);

theorem 
  for X being set holds BoolePoset X, (BoolePoset 1)|^X are_isomorphic;

theorem 
  for X,Y being non empty set, T being non empty Poset for S1
  being full non empty SubRelStr of (T|^X)|^Y for S2 being full non empty
SubRelStr of (T|^Y)|^X for F being Function of S1, S2 st F is commuting holds F
  is monotone;

theorem 
  for X,Y being non empty set, T being non empty Poset for S1
  being full non empty SubRelStr of (T|^Y)|^X for S2 being full non empty
SubRelStr of T|^[:X,Y:] for F being Function of S1, S2 st F is uncurrying holds
  F is monotone;

theorem 
  for X,Y being non empty set, T being non empty Poset for S1
  being full non empty SubRelStr of (T|^Y)|^X for S2 being full non empty
SubRelStr of T|^[:X,Y:] for F being Function of S2, S1 st F is currying holds F
  is monotone;

begin 

definition
  let S be non empty RelStr;
  let T be non empty reflexive antisymmetric RelStr;
  func UPS(S, T) -> strict RelStr means


  it is full SubRelStr of T |^
  the carrier of S & for x being set holds x in the carrier of it iff x is
  directed-sups-preserving Function of S, T;
end;

registration
  let S be non empty RelStr;
  let T be non empty reflexive antisymmetric RelStr;
  cluster UPS(S, T) -> non empty reflexive antisymmetric constituted-Functions;
end;

registration
  let S be non empty RelStr;
  let T be non empty Poset;
  cluster UPS(S,T) -> transitive;
end;

theorem 
  for S being non empty RelStr for T being non empty reflexive
antisymmetric RelStr holds the carrier of UPS(S, T) c= Funcs(the carrier of S,
  the carrier of T);

definition
  let S be non empty RelStr;
  let T be non empty reflexive antisymmetric RelStr;
  let f be Element of UPS(S, T);
  let s be Element of S;
  redefine func f.s -> Element of T;
end;

theorem 
  for S being non empty RelStr for T being non empty reflexive
antisymmetric RelStr for f,g being Element of UPS(S, T) holds f <= g iff for s
  being Element of S holds f.s <= g.s;

theorem 
  for S,T being complete Scott TopLattice holds UPS(S,T) = SCMaps( S,T);

theorem 
  for S,S9 being non empty RelStr for T,T9 being non empty
  reflexive antisymmetric RelStr st the RelStr of S = the RelStr of S9 & the
  RelStr of T = the RelStr of T9 holds UPS(S,T) = UPS(S9,T9);

registration
  let S, T be complete LATTICE;
  cluster UPS(S, T) -> complete;
end;

theorem 
  for S,T being complete LATTICE holds UPS(S, T) is
  sups-inheriting SubRelStr of T|^the carrier of S;

theorem 
  for S,T being complete LATTICE for A being Subset of UPS(S, T)
  holds sup A = "\/"(A, T|^the carrier of S);

definition
  let S1,S2,T1,T2 be non empty reflexive antisymmetric RelStr;
  let f be Function of S1, S2 such that
 f is directed-sups-preserving;
  let g be Function of T1, T2 such that
 g is directed-sups-preserving;
  func UPS(f,g) -> Function of UPS(S2, T1), UPS(S1, T2) means


  for h being directed-sups-preserving Function of S2, T1 holds it.h = g*h*f;
end;




theorem 
  for S1,S2,S3, T1,T2,T3 being non empty Poset for f1 being
  directed-sups-preserving Function of S2, S3 for f2 being
  directed-sups-preserving Function of S1, S2 for g1 being
  directed-sups-preserving Function of T1, T2 for g2 being
  directed-sups-preserving Function of T2, T3 holds UPS(f2, g2) * UPS(f1, g1) =
  UPS(f1*f2, g2*g1);




theorem 
  for S,T being non empty reflexive antisymmetric RelStr holds UPS
  (id S, id T) = id UPS(S, T);




theorem 
  for S1,S2, T1,T2 being complete LATTICE for f being
  directed-sups-preserving Function of S1, S2 for g being
  directed-sups-preserving Function of T1, T2 holds UPS(f, g) is
  directed-sups-preserving;

theorem 
  Omega Sierpinski_Space is Scott;

theorem 
  for S being complete Scott TopLattice holds oContMaps(S,
  Sierpinski_Space) = UPS(S, BoolePoset 1);



theorem 
  for S being complete LATTICE ex F being Function of UPS(S,
  BoolePoset 1), InclPoset sigma S st F is isomorphic & for f being
  directed-sups-preserving Function of S, BoolePoset 1 holds F.f = f"{1};

theorem 
  for S being complete LATTICE holds UPS(S, BoolePoset 1),
  InclPoset sigma S are_isomorphic;

theorem 
  for S1, S2, T1, T2 being complete LATTICE for f being Function
  of S1, S2, g being Function of T1, T2 st f is isomorphic & g is isomorphic
  holds UPS(f, g) is isomorphic;

theorem 
  for S1, S2, T1, T2 being complete LATTICE st S1, S2
  are_isomorphic & T1, T2 are_isomorphic holds UPS(S2, T1), UPS(S1, T2)
  are_isomorphic;

theorem 
  for S,T being complete LATTICE for f being
directed-sups-preserving projection Function of T,T holds Image UPS(id S, f) =
  UPS(S, Image f);

theorem 
  for X being non empty set, S,T being non empty Poset for f being
  directed-sups-preserving Function of S, T|^X for i being Element of X holds (
  commute f).i is directed-sups-preserving Function of S, T;

theorem 
  for X being non empty set, S,T being non empty Poset for f being
directed-sups-preserving Function of S, T|^X holds commute f is Function of X,
  the carrier of UPS(S, T);

theorem 
  for X being non empty set, S,T being non empty Poset for f being
  Function of X, the carrier of UPS(S, T) holds commute f is
  directed-sups-preserving Function of S, T|^X;

theorem 
  for X being non empty set, S,T being non empty Poset ex F being
  Function of UPS(S, T|^X), UPS(S, T)|^X st F is commuting isomorphic;

theorem 
  for X being non empty set, S,T being non empty Poset holds UPS(S
  , T|^X), UPS(S, T)|^X are_isomorphic;




theorem 
  for S,T being continuous complete LATTICE holds UPS(S,T) is continuous;




theorem 
  for S,T being algebraic complete LATTICE holds UPS(S,T) is algebraic;

theorem 
  for R,S,T being complete LATTICE for f being
  directed-sups-preserving Function of R, UPS(S, T) holds uncurry f is
  directed-sups-preserving Function of [:R,S:], T;

theorem 
  for R,S,T being complete LATTICE for f being
  directed-sups-preserving Function of [:R,S:], T holds curry f is
  directed-sups-preserving Function of R, UPS(S, T);



theorem 
  for R,S,T being complete LATTICE ex f being Function of UPS(R, UPS(S,
  T)), UPS([:R,S:], T) st f is uncurrying isomorphic;














begin

theorem 
  for L being complete LATTICE, N being net of L holds inf N <= lim_inf N;

theorem 
  for L being complete LATTICE, N being net of L, x being Element of L
holds (for M being subnet of N holds x = lim_inf M) implies (x=lim_inf N & for
  M being subnet of N holds x >= inf M);

theorem 
  for L being complete LATTICE, N being net of L, x being Element
of L st N in NetUniv L holds (for M being subnet of N st M in NetUniv L holds x
  = lim_inf M) implies (x=lim_inf N & for M being subnet of N st M in NetUniv L
  holds x >= inf M);

definition
  let N be non empty RelStr;
  let f be Function of N,N;
  attr f is greater_or_equal_to_id means


  for j being Element of N holds j <= f.j;
end;

theorem 
  for N being reflexive non empty RelStr holds id N is greater_or_equal_to_id;

theorem 
  for N being directed non empty RelStr, x,y being Element of N ex
  z being Element of N st x <= z & y <= z;

registration
  let N be directed non empty RelStr;
  cluster greater_or_equal_to_id for Function of N,N;
end;

registration
  let N be reflexive non empty RelStr;
  cluster greater_or_equal_to_id for Function of N,N;
end;

definition
  let L be non empty 1-sorted;
  let N be non empty NetStr over L;
  let f be Function of N,N;
  func N * f -> strict non empty NetStr over L means


  the RelStr of it =
  the RelStr of N & the mapping of it = (the mapping of N) * f;
end;

theorem 
  for L being non empty 1-sorted, N being non empty NetStr over L,
  f being Function of N, N holds the carrier of N * f = the carrier of N;

theorem 
  for L being non empty 1-sorted, N being non empty NetStr over L,
f being Function of N,N holds N * f = NetStr(#the carrier of N,the InternalRel
    of N,(the mapping of N)*f#);

theorem 
  for L being non empty 1-sorted, N being transitive directed non
  empty RelStr, f being Function of the carrier of N,the carrier of L holds
  NetStr (#the carrier of N,the InternalRel of N,f#) is net of L;

registration
  let L be non empty 1-sorted, N be transitive directed non empty RelStr, f be
  Function of the carrier of N,the carrier of L;
  cluster NetStr (#the carrier of N,the InternalRel of N,f#) -> transitive
    directed non empty;
end;

theorem 
  for L being non empty 1-sorted, N being net of L, p being
  Function of N,N holds N * p is net of L;

registration
  let L be non empty 1-sorted, N be net of L;
  let p be Function of N,N;
  cluster N * p -> transitive directed;
end;

theorem 
  for L being non empty 1-sorted, N being net of L, p being
  Function of N,N st N in NetUniv L holds N * p in NetUniv L;

theorem 
  for L being non empty 1-sorted, N,M being net of L st the NetStr of N
  = the NetStr of M holds M is subnet of N;

theorem 
  for L being non empty 1-sorted, N being net of L, p being
  greater_or_equal_to_id Function of N,N holds N * p is subnet of N;

definition
  let L be non empty 1-sorted;
  let N be net of L;
  let p be greater_or_equal_to_id Function of N,N;
  redefine func N * p -> strict subnet of N;
end;

theorem 
  for L being complete LATTICE, N being net of L, x being Element of L
st N in NetUniv L holds (x=lim_inf N & for M being subnet of N st M in NetUniv
  L holds x >= inf M) implies x=lim_inf N & for p being greater_or_equal_to_id
  Function of N,N holds x >= inf (N * p);

theorem 
  for L being complete LATTICE, N being net of L, x being Element
  of L holds (x=lim_inf N & for p being greater_or_equal_to_id Function of N,N
  holds x >= inf (N * p) ) implies for M being subnet of N holds x = lim_inf M;

definition
  let L be non empty RelStr;
  func lim_inf-Convergence L -> Convergence-Class of L means


  for N
being net of L st N in NetUniv L for x being Element of L holds [N,x] in it iff
  for M being subnet of N holds x = lim_inf M;
end;

theorem 
  for L being complete LATTICE, N being net of L, x being Element of L
  st N in NetUniv L holds [N,x] in lim_inf-Convergence L iff for M being subnet
  of N st M in NetUniv L holds x = lim_inf M;

theorem 
  for L being non empty RelStr, N being constant net of L, M being
  subnet of N holds M is constant & the_value_of N = the_value_of M;

definition
  let L be non empty RelStr;
  func xi L -> Subset-Family of L equals

  the topology of ConvergenceSpace
  lim_inf-Convergence L;
end;

theorem 
  for L being complete LATTICE holds lim_inf-Convergence L is (CONSTANTS);

theorem 
  for L being non empty RelStr holds lim_inf-Convergence L is (SUBNETS);

theorem 
  for L being continuous complete LATTICE holds lim_inf-Convergence L is
  (DIVERGENCE);

theorem 
  for L being non empty RelStr, N,x being set holds [N,x] in
  lim_inf-Convergence L implies N in NetUniv L;

theorem 
  for L being non empty 1-sorted, C1,C2 being Convergence-Class of
L holds C1 c= C2 implies the topology of ConvergenceSpace C2 c= the topology of
  ConvergenceSpace C1;

theorem 
  for L being non empty reflexive RelStr holds lim_inf-Convergence
  L c= Scott-Convergence L;

theorem 
  for X,Y being set holds X c= Y implies X in the_universe_of Y;

theorem 
  for L being non empty transitive reflexive RelStr, D being
  directed non empty Subset of L holds Net-Str D in NetUniv L;

theorem 
  for L being complete LATTICE, D being directed non empty Subset
  of L holds for M being subnet of Net-Str D holds lim_inf M = sup D;

theorem 
  for L being non empty complete LATTICE, D being directed non
  empty Subset of L holds [Net-Str D,sup D] in lim_inf-Convergence L;

theorem 
  for L being complete LATTICE, U1 being Subset of L holds U1 in
  xi(L) implies U1 is property(S);

theorem 
  for L being non empty reflexive RelStr, A being Subset of L
  holds A in sigma L implies A in xi L;

theorem 
  for L being complete LATTICE, A being Subset of L st A is upper
  holds A in xi L implies A in sigma L;

theorem 
  for L being complete LATTICE , A being Subset of L st A is lower holds
  A` in xi L iff A is closed_under_directed_sups;














begin

theorem 
  for X,Y being non empty set, Z being non empty RelStr for S being
non empty SubRelStr of Z|^[:X,Y:] for T being non empty SubRelStr of (Z|^Y)|^X
  for f being Function of S, T st f is currying one-to-one onto holds f" is
  uncurrying;

theorem 
  for X,Y being non empty set, Z being non empty RelStr for S being
non empty SubRelStr of Z|^[:X,Y:] for T being non empty SubRelStr of (Z|^Y)|^X
  for f being Function of T, S st f is uncurrying one-to-one onto holds f" is
  currying;

theorem 
  for X,Y being non empty set, Z being non empty Poset for S being non
empty full SubRelStr of Z|^[:X,Y:] for T being non empty full SubRelStr of (Z|^
Y)|^X for f being Function of S, T st f is currying one-to-one onto holds f is
  isomorphic;

theorem 
  for X,Y being non empty set, Z being non empty Poset for T being non
empty full SubRelStr of Z|^[:X,Y:] for S being non empty full SubRelStr of (Z|^
  Y)|^X for f being Function of S, T st f is uncurrying one-to-one onto holds f
  is isomorphic;

theorem 
  for S1, S2, T1, T2 being RelStr st the RelStr of S1 = the RelStr
of S2 & the RelStr of T1 = the RelStr of T2 for f being Function of S1, T1 st f
  is isomorphic for g being Function of S2, T2 st g = f holds g is isomorphic;



theorem 
  for R, S, T being RelStr for f being Function of R, S st f is
isomorphic for g being Function of S, T st g is isomorphic for h being Function
  of R, T st h = g*f holds h is isomorphic;

theorem 
  for X,Y,X1,Y1 being TopSpace st the TopStruct of X = the
TopStruct of X1 & the TopStruct of Y = the TopStruct of Y1 holds [:X,Y:] = [:X1
  ,Y1:];

theorem 
  for X being non empty TopSpace for L being Scott up-complete
  non empty TopPoset for F being non empty directed Subset of ContMaps(X, L)
  holds "\/"(F, L|^the carrier of X) is continuous Function of X, L;

theorem 
  for X being non empty TopSpace for L being Scott up-complete
non empty TopPoset holds ContMaps(X, L) is directed-sups-inheriting SubRelStr
  of L|^the carrier of X;

theorem 
  for S1,S2 being TopStruct st the TopStruct of S1 = the TopStruct
  of S2 for T1,T2 being non empty TopRelStr st the TopRelStr of T1 = the
  TopRelStr of T2 holds ContMaps(S1,T1) = ContMaps(S2,T2);

registration
  cluster Scott -> injective T_0 for complete continuous TopLattice;
end;

registration
  cluster Scott continuous complete for TopLattice;
end;

registration
  let X be non empty TopSpace;
  let L be Scott up-complete non empty TopPoset;
  cluster ContMaps(X, L) -> up-complete;
end;

theorem 
  for I being non empty set for J being Poset-yielding non-Empty
ManySortedSet of I st for i being Element of I holds J.i is up-complete holds I
  -POS_prod J is up-complete;

theorem 
  for I being non empty set for J being Poset-yielding non-Empty
  ManySortedSet of I st for i being Element of I holds J.i is up-complete
lower-bounded for x,y being Element of product J holds x << y iff (for i being
Element of I holds x .i << y.i) & ex K being finite Subset of I st for i being
  Element of I st not i in K holds x .i = Bottom (J.i);

registration
  let X be set;
  let L be lower-bounded non empty reflexive antisymmetric RelStr;
  cluster L|^X -> lower-bounded;
end;

registration
  let X be non empty TopSpace;
  let L be lower-bounded non empty TopPoset;
  cluster ContMaps(X, L) -> lower-bounded;
end;

registration
  let L be up-complete non empty Poset;
  cluster -> up-complete for TopAugmentation of L;
  cluster Scott -> correct for TopAugmentation of L;
end;

registration
  let L be up-complete non empty Poset;
  cluster strict Scott for TopAugmentation of L;
end;

theorem 
  for L being up-complete non empty Poset for S1, S2 being Scott
  TopAugmentation of L holds the topology of S1 = the topology of S2;

theorem 
  for S1, S2 being up-complete antisymmetric non empty reflexive
TopRelStr st the TopRelStr of S1 = the TopRelStr of S2 & S1 is Scott holds S2
  is Scott;

definition
  let L be up-complete non empty Poset;
  func Sigma L -> strict Scott TopAugmentation of L means


  not contradiction;
end;

theorem 
  for S being Scott up-complete non empty TopPoset holds Sigma S
  = the TopRelStr of S;

theorem 
  for L1, L2 being up-complete non empty Poset st the RelStr of
  L1 = the RelStr of L2 holds Sigma L1 = Sigma L2;

definition
  let S,T be up-complete non empty Poset;
  let f be Function of S,T;
  func Sigma f -> Function of Sigma S, Sigma T equals

  f;
end;

registration
  let S,T be up-complete non empty Poset;
  let f be directed-sups-preserving Function of S,T;
  cluster Sigma f -> continuous;
end;

theorem 
  for S, T being up-complete non empty Poset for f being Function of S
  , T holds f is isomorphic iff Sigma f is isomorphic;

theorem 
  for X being non empty TopSpace for S being Scott complete
  TopLattice holds oContMaps(X, S) = ContMaps(X, S);

definition
  let X,Y be non empty TopSpace;
  func Theta(X,Y) -> Function of InclPoset the topology of [:X, Y:], ContMaps(
  X, Sigma InclPoset the topology of Y) means


  for W being open Subset of [:X, Y:] holds it.W = (W, the carrier of X)*graph;
end;

begin 

definition
  let X be non empty TopSpace;
  func alpha X -> Function of oContMaps(X, Sierpinski_Space), InclPoset the
  topology of X means


  for g being continuous Function of X, Sierpinski_Space holds it.g = g"{1};
end;

theorem 
  for X being non empty TopSpace for V being open Subset of X holds (
  alpha X)".V = chi(V, the carrier of X);

registration
  let X be non empty TopSpace;
  cluster alpha X -> isomorphic;
end;

registration
  let X be non empty TopSpace;
  cluster (alpha X)" -> isomorphic;
end;

registration
  let S be injective T_0-TopSpace;
  cluster Omega S -> Scott;
end;

registration
  let X be non empty TopSpace;
  cluster oContMaps(X, Sierpinski_Space) -> complete;
end;

theorem 
  Omega Sierpinski_Space = Sigma BoolePoset 1;

registration
  let M be non empty set;
  let S be injective T_0-TopSpace;
  cluster M-TOP_prod (M => S) -> injective;
end;

theorem 
  for M being non empty set, L being complete continuous LATTICE holds
  Omega (M-TOP_prod (M => Sigma L)) = Sigma (M-POS_prod (M => L));

theorem 
  for M being non empty set, T being injective T_0-TopSpace holds Omega
  (M-TOP_prod (M => T)) = Sigma (M-POS_prod (M => Omega T));

definition
  let M be non empty set;
  let X,Y be non empty TopSpace;
  func commute(X, M, Y) -> Function of oContMaps(X, M-TOP_prod (M => Y)),
  oContMaps(X, Y)|^M means


  for f being continuous Function of X, M
  -TOP_prod (M => Y) holds it.f = commute f;
end;

registration
  let M be non empty set;
  let X,Y be non empty TopSpace;
  cluster commute(X,M,Y) -> one-to-one onto;
end;

registration
  let M be non empty set;
  let X be non empty TopSpace;
  cluster commute(X, M, Sierpinski_Space) -> isomorphic;
end;

theorem 
  for X,Y being non empty TopSpace for S being Scott
  TopAugmentation of InclPoset the topology of Y for f1, f2 being Element of
  ContMaps(X, S) st f1 <= f2 holds *graph f1 c= *graph f2;

begin 


theorem 
  for Y being T_0-TopSpace holds (for X being non empty TopSpace for L
being Scott continuous complete TopLattice for T being Scott TopAugmentation of
ContMaps(Y, L) ex f being Function of ContMaps(X, T), ContMaps([:X, Y:], L), g
  being Function of ContMaps([:X, Y:], L), ContMaps(X, T) st f is uncurrying
  one-to-one onto & g is currying one-to-one onto) iff for X being non empty
  TopSpace for L being Scott continuous complete TopLattice for T being Scott
  TopAugmentation of ContMaps(Y, L) ex f being Function of ContMaps(X, T),
ContMaps([:X, Y:], L), g being Function of ContMaps([:X, Y:], L), ContMaps(X, T
  ) st f is uncurrying isomorphic & g is currying isomorphic;



theorem 
  for Y being T_0-TopSpace holds InclPoset the topology of Y is
  continuous iff for X being non empty TopSpace holds Theta(X, Y) is isomorphic
;



theorem 
  for Y being T_0-TopSpace holds InclPoset the topology of Y is
  continuous iff for X being non empty TopSpace for f being continuous Function
of X, Sigma InclPoset the topology of Y holds *graph f is open Subset of [:X, Y
  :];



theorem 
  for Y being T_0-TopSpace holds InclPoset the topology of Y is
  continuous iff {[W,y] where W is open Subset of Y, y is Element of Y: y in W}
  is open Subset of [:Sigma InclPoset the topology of Y, Y:];



theorem 
  for Y being T_0-TopSpace holds InclPoset the topology of Y is
continuous iff for y being Element of Y, V being open a_neighborhood of y ex H
  being open Subset of Sigma InclPoset the topology of Y st V in H & meet H is
  a_neighborhood of y;

begin 

theorem 
  for R1,R2,R3 being non empty RelStr for f1 being Function of R1,R3 st
  f1 is isomorphic for f2 being Function of R2,R3 st f2=f1 & f2 is isomorphic
  holds the RelStr of R1 = the RelStr of R2;



theorem 
  for L being complete LATTICE holds InclPoset sigma L is
continuous iff for S being complete LATTICE holds sigma [:S, L:] = the topology
  of [:Sigma S, Sigma L:];



theorem 
  for L being complete LATTICE holds (for S being complete LATTICE
  holds sigma [:S, L:] = the topology of [:Sigma S, Sigma L:]) iff for S being
  complete LATTICE holds the TopStruct of Sigma [:S, L:] = [:Sigma S, Sigma L:]
;



theorem 
  for L being complete LATTICE holds (for S being complete LATTICE
  holds sigma [:S, L:] = the topology of [:Sigma S, Sigma L:]) iff for S being
  complete LATTICE holds Sigma [:S, L:] = Omega [:Sigma S, Sigma L:];



theorem 
  for L being complete LATTICE holds InclPoset sigma L is continuous iff
for S being complete LATTICE holds Sigma [:S, L:] = Omega [:Sigma S, Sigma L:];














begin

theorem 
  for x being set, D being non empty set holds x /\ union D = union
  {x /\ d where d is Element of D: not contradiction};

theorem 
  for R being non empty reflexive transitive RelStr, D being non
  empty directed Subset of InclPoset Ids R holds union D is Ideal of R;



registration
  let R be non empty reflexive transitive RelStr;
  cluster InclPoset Ids R -> up-complete;
end;

theorem 
  for R being non empty reflexive transitive RelStr, D being non
  empty directed Subset of InclPoset Ids R holds sup D = union D;

theorem 
  for R being Semilattice, D being non empty directed Subset of
  InclPoset Ids R, x being Element of InclPoset Ids R holds sup ({x} "/\" D) =
  union {x /\ d where d is Element of D: not contradiction};



registration
  let R be Semilattice;
  cluster InclPoset Ids R -> satisfying_MC;
end;

registration
  let R be 1-element RelStr;
  cluster -> trivial for TopAugmentation of R;
end;

theorem 
  for S being Scott complete TopLattice, T being complete LATTICE, A
being Scott TopAugmentation of T st the RelStr of S = the RelStr of T holds the
  TopRelStr of A = the TopRelStr of S;

theorem 
  for N being Lawson complete TopLattice, T being complete LATTICE, A
being Lawson correct TopAugmentation of T st the RelStr of N = the RelStr of T
  holds the TopRelStr of A = the TopRelStr of N;

theorem 
  for N being Lawson complete TopLattice for S being Scott
TopAugmentation of N for A being Subset of N, J being Subset of S st A = J & J
  is closed holds A is closed;

registration
  let A be complete LATTICE;
  cluster lambda A -> non empty;
end;

registration
  let S be Scott complete TopLattice;
  cluster InclPoset sigma S -> complete non trivial;
end;

registration
  let N be Lawson complete TopLattice;
  cluster InclPoset sigma N -> complete non trivial;
  cluster InclPoset lambda N -> complete non trivial;
end;

theorem 
  for T being non empty reflexive RelStr holds sigma T c= {W\
  uparrow F where W, F is Subset of T: W in sigma T & F is finite};

theorem 
  for N being Lawson complete TopLattice holds lambda N = the topology of N;

theorem 
  for N being Lawson complete TopLattice holds sigma N c= lambda N;

theorem 
  for M, N being complete LATTICE st the RelStr of M = the RelStr of N
  holds lambda M = lambda N;

theorem 
  for N being Lawson complete TopLattice, X being Subset of N
  holds X in lambda N iff X is open;

registration
  cluster TopSpace-like -> Scott for reflexive 1-element TopRelStr;
end;

registration
  cluster trivial -> Lawson for complete TopLattice;
end;

registration
  cluster strict continuous lower-bounded meet-continuous Scott for complete
    TopLattice;
end;

registration
  cluster strict continuous compact Hausdorff Lawson for complete TopLattice;
end;

scheme 

  EmptySch { A() -> Scott TopLattice, X() -> set, F(set) -> set }: { F(w)
  where w is Element of A(): w in {} } = {};

theorem 
  for N being meet-continuous LATTICE, A being Subset of N st A is
  property(S) holds uparrow A is property(S);

registration
  let N be meet-continuous LATTICE, A be property(S) Subset of N;
  cluster uparrow A -> property(S);
end;



theorem 
  for N being meet-continuous Lawson complete TopLattice, S
  being Scott TopAugmentation of N, A being Subset of N st A in lambda N holds
  uparrow A in sigma S;

theorem 
  for N being meet-continuous Lawson complete TopLattice for S
  being Scott TopAugmentation of N for A being Subset of N, J being Subset of S
  st A = J holds A is open implies uparrow J is open;

theorem 
  for N being meet-continuous Lawson complete TopLattice for S
being Scott TopAugmentation of N for x being Point of S, y being Point of N for
J being Basis of y st x = y holds {uparrow A where A is Subset of N: A in J} is
  Basis of x;



theorem 
  for N being meet-continuous Lawson complete TopLattice for S
being Scott TopAugmentation of N for X being upper Subset of N, Y being Subset
  of S st X = Y holds Int X = Int Y;



theorem 
  for N being meet-continuous Lawson complete TopLattice for S being
  Scott TopAugmentation of N for X being lower Subset of N, Y being Subset of S
  st X = Y holds Cl X = Cl Y;

theorem 
  for M, N being complete LATTICE, LM being Lawson correct
TopAugmentation of M, LN being Lawson correct TopAugmentation of N st InclPoset
sigma N is continuous holds the topology of [:LM,LN qua TopSpace:] = lambda [:M
  ,N:];



theorem 
  for M, N being complete LATTICE, P being Lawson correct
  TopAugmentation of [:M,N:], Q being Lawson correct TopAugmentation of M, R
  being Lawson correct TopAugmentation of N st InclPoset sigma N is continuous
  holds the TopStruct of P = [:Q,R qua TopSpace:];



theorem 
  for N being meet-continuous Lawson complete TopLattice, x
  being Element of N holds x"/\" is continuous;

registration
  let N be meet-continuous Lawson complete TopLattice, x be Element of N;
  cluster x"/\" -> continuous;
end;



theorem 
  for N being meet-continuous Lawson complete TopLattice st
  InclPoset sigma N is continuous holds N is topological_semilattice;



theorem 
  for N being meet-continuous Lawson complete TopLattice st InclPoset
sigma N is continuous holds N is Hausdorff iff for X being Subset of [:N,N qua
  TopSpace:] st X = the InternalRel of N holds X is closed;



definition
  let N be non empty reflexive RelStr, X be Subset of N;
  func X^0 -> Subset of N equals

  { u where u is Element of N : for D being non
  empty directed Subset of N st u <= sup D holds X meets D };
end;

registration
  let N be non empty reflexive antisymmetric RelStr, X be empty Subset of N;
  cluster X^0 -> empty;
end;

theorem 
  for N being non empty reflexive RelStr, A, J being Subset of N st A c=
  J holds A^0 c= J^0;



theorem 
  for N being non empty reflexive RelStr, x being Element of N
  holds (uparrow x)^0 = wayabove x;



theorem 
  for N being Scott TopLattice, X being upper Subset of N holds Int X c= X^0;



theorem 
  for N being non empty reflexive RelStr, X, Y being Subset of N
  holds (X^0) \/ (Y^0) c= (X \/ Y)^0;



theorem 
  for N being meet-continuous LATTICE, X, Y being upper Subset of
  N holds (X^0) \/ (Y^0) = (X \/ Y)^0;



theorem 
  for S being meet-continuous Scott TopLattice, F being finite
Subset of S holds Int uparrow F c= union { wayabove x where x is Element of S :
  x in F };



theorem 
  for N being Lawson complete TopLattice holds N is continuous
  iff N is meet-continuous Hausdorff;

registration
  cluster continuous Lawson -> Hausdorff for complete TopLattice;
  cluster meet-continuous Lawson Hausdorff -> continuous for
complete TopLattice;
end;



definition
  let N be non empty TopRelStr;
  attr N is with_small_semilattices means

  for x being Point of N ex J being
  basis of x st for A being Subset of N st A in J holds subrelstr A is
  meet-inheriting;
  attr N is with_compact_semilattices means

  for x being Point of N ex J being
  basis of x st for A being Subset of N st A in J holds subrelstr A is
  meet-inheriting & A is compact;
  attr N is with_open_semilattices means


  for x being Point of N ex J
  being Basis of x st for A being Subset of N st A in J holds subrelstr A is
  meet-inheriting;
end;

registration
  cluster with_open_semilattices -> with_small_semilattices for non empty
    TopSpace-like TopRelStr;
  cluster with_compact_semilattices -> with_small_semilattices for non empty
    TopSpace-like TopRelStr;
  cluster anti-discrete -> with_small_semilattices with_open_semilattices for
non
    empty TopRelStr;
  cluster reflexive TopSpace-like -> with_compact_semilattices
       for 1-element TopRelStr;
end;

registration
  cluster strict trivial lower for TopLattice;
end;

theorem 
  for N being topological_semilattice with_infima TopPoset, C
  being Subset of N st subrelstr C is meet-inheriting holds subrelstr Cl C is
  meet-inheriting;



theorem 
  for N being meet-continuous Lawson complete TopLattice for S
being Scott TopAugmentation of N holds (for x being Point of S ex J being Basis
  of x st for W being Subset of S st W in J holds W is Filter of S) iff N is
  with_open_semilattices;



theorem 
  for N being Lawson complete TopLattice for S being Scott
TopAugmentation of N for x being Element of N holds {inf A where A is Subset of
S: x in A & A in sigma S} c= {inf J where J is Subset of N : x in J & J in
  lambda N};



theorem 
  for N being meet-continuous Lawson complete TopLattice for S
being Scott TopAugmentation of N for x being Element of N holds {inf A where A
is Subset of S : x in A & A in sigma S} = {inf J where J is Subset of N : x in
  J & J in lambda N};



theorem 
  for N being meet-continuous Lawson complete TopLattice holds N
is continuous iff N is with_open_semilattices & InclPoset sigma N is continuous
;

registration
  cluster continuous -> with_open_semilattices for
Lawson complete TopLattice;
end;

registration
  let N be continuous Lawson complete TopLattice;
  cluster InclPoset sigma N -> continuous;
end;



theorem 
  for N being continuous Lawson complete TopLattice holds N is compact
  Hausdorff topological_semilattice with_open_semilattices;



theorem 
  for N being Hausdorff topological_semilattice with_open_semilattices
  Lawson complete TopLattice holds N is with_compact_semilattices;



theorem 
  for N being meet-continuous Hausdorff Lawson complete TopLattice, x
being Element of N holds x = "\/"({inf V where V is Subset of N: x in V & V in
  lambda N},N);



theorem 
  for N being meet-continuous Lawson complete TopLattice holds N is
continuous iff for x being Element of N holds x = "\/"({inf V where V is Subset
  of N: x in V & V in lambda N},N);



theorem 
  for N being meet-continuous Lawson complete TopLattice holds N
  is algebraic iff N is with_open_semilattices & InclPoset sigma N is algebraic
;

registration
  let N be meet-continuous algebraic Lawson complete TopLattice;
  cluster InclPoset sigma N -> algebraic;
end;














begin

scheme 

  UparrowUnion{L1()->RelStr,P[set]}: for S be Subset-Family of L1() st S = { X
  where X is Subset of L1() : P[X] } holds uparrow union S = union { uparrow X
  where X is Subset of L1() : P[X] };

scheme 

  DownarrowUnion{L1()->RelStr,P[set]}: for S be Subset-Family of L1() st S = {
  X where X is Subset of L1() : P[X] } holds downarrow union S = union {
  downarrow X where X is Subset of L1() : P[X]};

registration
  let L1 be lower-bounded continuous sup-Semilattice;
  let B1 be with_bottom CLbasis of L1;
  cluster InclPoset Ids subrelstr B1 -> algebraic;
end;

definition 
  let L1 be continuous sup-Semilattice;
  func CLweight L1 -> Cardinal equals

  meet {card B1 where B1 is with_bottom
  CLbasis of L1 : not contradiction};
end;

theorem 
  for L1 be continuous sup-Semilattice for B1 be with_bottom
  CLbasis of L1 holds CLweight L1 c= card B1;

theorem 
  for L1 be continuous sup-Semilattice ex B1 be with_bottom CLbasis
  of L1 st card B1 = CLweight L1;

theorem 
  for L1 be algebraic lower-bounded LATTICE holds CLweight L1 =
  card the carrier of CompactSublatt L1;

theorem 
  for T be non empty TopSpace for L1 be continuous sup-Semilattice
  st InclPoset the topology of T = L1 for B1 be with_bottom CLbasis of L1 holds
  B1 is Basis of T;

theorem 
  for T be non empty TopSpace for L1 be continuous lower-bounded
  LATTICE st InclPoset the topology of T = L1 for B1 be Basis of T for B2 be
  Subset of L1 st B1 = B2 holds finsups B2 is with_bottom CLbasis of L1;

theorem 
  for T be T_0 non empty TopSpace for L1 be continuous
  lower-bounded sup-Semilattice st InclPoset the topology of T = L1 holds T is
  infinite implies weight T = CLweight L1;

theorem 
  for T be T_0 non empty TopSpace for L1 be continuous
sup-Semilattice st InclPoset the topology of T = L1 holds card the carrier of T
  c= card the carrier of L1;

theorem 
  for T be T_0 non empty TopSpace st T is finite holds weight T =
  card the carrier of T;

theorem 
  for T be TopStruct for L1 be continuous lower-bounded LATTICE st
  InclPoset the topology of T = L1 & T is finite holds CLweight L1 = card the
  carrier of L1;

theorem 
  for L1 be continuous lower-bounded sup-Semilattice for T1 be
Scott TopAugmentation of L1 for T2 be Lawson correct TopAugmentation of L1 for
  B2 be Basis of T2 holds { uparrow V where V is Subset of T2 : V in B2 } is
  Basis of T1;

theorem 
  for L1 be up-complete non empty Poset st L1 is finite for x be
  Element of L1 holds x in compactbelow x;

theorem 
  for L1 be finite LATTICE holds L1 is arithmetic;

registration
  cluster finite -> arithmetic for LATTICE;
end;

registration
  cluster reflexive transitive antisymmetric with_suprema with_infima
    lower-bounded 1-element finite strict for RelStr;
end;

theorem 
  for L1 be finite LATTICE for B1 be with_bottom CLbasis of L1
  holds card B1 = CLweight L1 iff B1 = the carrier of CompactSublatt L1;

definition
  let L1 be non empty reflexive RelStr;
  let A be Subset of L1;
  let a be Element of L1;
  func Way_Up(a,A) -> Subset of L1 equals

  wayabove a \ uparrow A;
end;

theorem 
  for L1 be non empty reflexive RelStr for a be Element of L1 holds
  Way_Up(a,{}(L1)) = wayabove a;

theorem 
  for L1 be non empty Poset for A be Subset of L1 for a be Element of L1
  st a in uparrow A holds Way_Up(a,A) = {};

theorem 
  for L1 be non empty finite reflexive transitive RelStr holds Ids L1 is finite
;

theorem 
  for L1 be continuous lower-bounded sup-Semilattice st L1 is
  infinite for B1 be with_bottom CLbasis of L1 holds B1 is infinite;

theorem 
  for L1 be complete non empty Poset for x be Element of L1 holds x is
  compact implies x = inf wayabove x;

theorem 
  for L1 be continuous lower-bounded sup-Semilattice st L1 is
  infinite for B1 be with_bottom CLbasis of L1 holds card { Way_Up(a,A) where a
  is Element of L1, A is finite Subset of L1 : a in B1 & A c= B1 } c= card B1;

theorem 
  for T be Lawson complete TopLattice for X be finite Subset of
  T holds (uparrow X)` is open & (downarrow X)` is open;

theorem 
  for L1 be continuous lower-bounded sup-Semilattice for T be
Lawson correct TopAugmentation of L1 holds for B1 be with_bottom CLbasis of L1
  holds { Way_Up(a,A) where a is Element of L1, A is finite Subset of L1 : a in
  B1 & A c= B1 } is Basis of T;

theorem 
  for L1 be continuous lower-bounded sup-Semilattice for T be
Scott TopAugmentation of L1 for b be Basis of T holds { wayabove inf u where u
  is Subset of T : u in b } is Basis of T;

theorem 
  for L1 be continuous lower-bounded sup-Semilattice for T be
Scott TopAugmentation of L1 for B1 be Basis of T st B1 is infinite holds { inf
  u where u is Subset of T : u in B1 } is infinite;

theorem 
  for L1 be continuous lower-bounded sup-Semilattice for T be
  Scott TopAugmentation of L1 holds CLweight L1 = weight T;

theorem 
  for L1 be continuous lower-bounded sup-Semilattice for T be Lawson
  correct TopAugmentation of L1 holds CLweight L1 = weight T;

theorem 
  for L1,L2 be non empty RelStr st L1,L2 are_isomorphic holds card
  the carrier of L1 = card the carrier of L2;

theorem 
  for L1 be continuous lower-bounded sup-Semilattice for B1 be
with_bottom CLbasis of L1 st card B1 = CLweight L1 holds CLweight L1 = CLweight
  InclPoset Ids subrelstr B1;

registration
  let L1 be continuous lower-bounded sup-Semilattice;
  cluster InclPoset sigma L1 -> with_suprema continuous;
end;

theorem 
  for L1 be continuous lower-bounded sup-Semilattice holds CLweight L1
  c= CLweight InclPoset sigma L1;

theorem 
  for L1 be continuous lower-bounded sup-Semilattice st L1 is infinite
  holds CLweight L1 = CLweight InclPoset sigma L1;














begin 

definition
  let L be 1-sorted;
  let A,B be Subset of L;
  redefine pred A c= B means

  for x be Element of L st x in A holds x in B;
end;

registration
  let L be LATTICE;
  cluster non empty for Chain of L;
end;

definition
  let L be LATTICE;
  let x,y be Element of L such that
 x <= y;
  mode Chain of x,y -> non empty Chain of L means


    x in it & y in it & for z be Element of L st z in it holds x <= z & z <= y;
end;

theorem 
  for L be LATTICE for x,y be Element of L holds x <= y implies {x,
  y} is Chain of x,y;

reserve n,k for Element of NAT;

definition
  let L be finite LATTICE;
  let x be Element of L;
  func height(x) -> Element of NAT means


  (ex A be Chain of Bottom L,x
  st it= card A) & for A be Chain of Bottom L,x holds card A <= it;
end;

theorem 
  for L be finite LATTICE for a,b be Element of L holds a < b
  implies height(a) < height(b);

theorem 
  for L be finite LATTICE for C be Chain of L for x,y be Element of
  L holds x in C & y in C implies ( x < y iff height(x) < height(y) );

theorem 
  for L be finite LATTICE for C be Chain of L for x,y be Element of
  L holds x in C & y in C implies ( x = y iff height(x) = height(y) );

theorem 
  for L be finite LATTICE for C be Chain of L for x,y be Element of
  L holds x in C & y in C implies ( x <= y iff height(x) <= height(y) );

theorem 
  for L be finite LATTICE for x be Element of L holds height (x) = 1 iff
  x = Bottom L;

theorem 
  for L be non empty finite LATTICE for x be Element of L holds height (x) >= 1
;

scheme 

  LattInd { L() -> finite LATTICE, P[set]}: for x be Element of L() holds P[x]
provided
 for x be Element of L() st for b be Element of L() st b < x holds P[
b] holds P[x];

begin 

registration
  cluster distributive finite for LATTICE;
end;

definition
  let L be LATTICE;
  let x,y be Element of L;
  pred x <(1) y means


  x < y & not (ex z be Element of L st x < z & z < y);
end;

theorem 
  for L be finite LATTICE for X be non empty Subset of L holds ex x
  be Element of L st x in X & for y be Element of L st y in X holds not x < y;

definition
  let L be finite LATTICE;
  let A be non empty Chain of L;
  func max(A) -> Element of L means


  (for x be Element of L st x in A holds x <= it) & it in A;
end;

theorem 
  for L be finite LATTICE for y be Element of L st y <> Bottom L
  holds ex x be Element of L st x <(1) y;

definition
  let L be LATTICE;
  func Join-IRR L -> Subset of L equals

  {a where a is Element of L: a<>Bottom
  L & for b,c be Element of L holds a= b"\/"c implies a=b or a=c};
end;

theorem 
  for L be LATTICE for x be Element of L holds x in Join-IRR L iff
  x<>Bottom L & for b,c be Element of L holds x= b"\/"c implies x=b or x=c;

theorem 
  for L be finite distributive LATTICE for x be Element of L holds
  x in Join-IRR L implies ex z be Element of L st z < x & for y be Element of L
  st y < x holds y <= z;

theorem 
  for L be distributive finite LATTICE for x be Element of L holds
  sup (downarrow x /\ Join-IRR L) = x;

begin 

definition
  let P be RelStr;
  func LOWER(P) -> non empty set equals

  {X where X is Subset of P:X is lower};
end;

theorem 
  for L be distributive finite LATTICE ex r be Function of L,
InclPoset LOWER(subrelstr Join-IRR L) st r is isomorphic & for a being Element
  of L holds r.a= downarrow a /\ Join-IRR L;

theorem 
  for L be distributive finite LATTICE holds L, InclPoset LOWER(
  subrelstr Join-IRR L) are_isomorphic;

definition
  mode Ring_of_sets means


    it includes_lattice_of it;
end;

registration
  cluster non empty for Ring_of_sets;
end;

registration
  let X be non empty Ring_of_sets;
  cluster InclPoset X -> with_suprema with_infima distributive;
end;

theorem 
  for L be finite LATTICE holds LOWER(subrelstr Join-IRR L) is Ring_of_sets;

theorem 
  for L be finite LATTICE holds L is distributive iff ex X be non empty
  Ring_of_sets st L, InclPoset X are_isomorphic;














begin 

reserve k for Nat;

theorem 
  for a be Nat holds a mod 1 = 0;

theorem 
  for a,b be Integer, n be Nat st n>0 holds ((a mod n)+(b mod n))
  mod n = (a + (b mod n)) mod n;

theorem 
  for a,b be Integer, n be Nat st n>0 holds (a*b) mod n = (a*(b mod n)) mod n;

theorem 
  for a,b,i be Nat st 1 <= i & 0 < b holds (a mod (b |^ i)) div (b
  |^ (i -'1)) = (a div (b |^ (i -'1))) mod b;

theorem 
  for i,n be Nat st i in Seg n holds i+1 in Seg (n+1);

begin 

theorem 
  for k be Nat holds Radix(k) > 0;

theorem 
  for x be Tuple of 1,k-SD holds SDDec(x) = DigA(x,1);

theorem 
  for x be Integer holds SD_Add_Data(x,k) + SD_Add_Carry(x)*Radix(k ) = x;

theorem 
  for n be Nat for x be Tuple of (n+1),k-SD, xn be Tuple of n,k-SD
  st (for i be Nat st i in Seg n holds x.i = xn.i) holds Sum DigitSD(x) = Sum(
  DigitSD(xn)^<*SubDigit(x,n+1,k)*>);

theorem 
  for n be Nat for x be Tuple of (n+1),k-SD, xn be Tuple of n,k-SD
st (for i be Nat st i in Seg n holds x.i = xn.i) holds SDDec(xn) + (Radix(k) |^
  n)*DigA(x,n+1) = SDDec(x);

theorem 
  for n be Nat st n >= 1 holds for x,y be Tuple of n,k-SD st k >= 2
  holds SDDec(x '+' y) + SD_Add_Carry(DigA(x,n) + DigA(y,n)) *(Radix(k) |^ n) =
  SDDec(x) + SDDec(y);

begin 


definition
  let i,k,n be Nat, x be Tuple of n,NAT;
  func SubDigit2(x,i,k) -> Element of NAT equals

  (Radix(k) |^ (i -'1))*(x.i);
end;

definition
  let n,k be Nat, x be Tuple of n,NAT;
  func DigitSD2(x,k) -> Tuple of n,NAT means


  for i be Nat st i in Seg n holds it/.i = SubDigit2(x,i,k);
end;

definition
  let n,k be Nat, x be Tuple of n,NAT;
  func SDDec2(x,k) -> Element of NAT equals

  Sum DigitSD2(x,k);
end;

definition
  let i,k,x be Nat;
  func DigitDC2(x,i,k) -> Element of NAT equals

  (x mod (Radix(k) |^ i)) div (
  Radix(k) |^ (i -'1));
end;

definition
  let k,n,x be Nat;
  func DecSD2(x,n,k) -> Tuple of n,NAT means


  for i be Nat st i in Seg n holds it.i = DigitDC2(x,i,k);
end;

theorem 
  for n,k be Nat, x be Tuple of n,NAT, y be Tuple of n,k-SD st x =
  y holds DigitSD2(x,k) = DigitSD(y);

theorem 
  for n,k be Nat, x be Tuple of n,NAT, y be Tuple of n,k-SD st x =
  y holds SDDec2(x,k) = SDDec(y);

theorem 
  for x,n,k be Nat holds DecSD2(x,n,k) = DecSD(x,n,k);

theorem 
  for n be Nat st n >= 1 holds for m,k be Nat st m
  is_represented_by n,k holds m = SDDec2(DecSD2(m,n,k),k);

begin 


definition
  let q be Integer, f,j,k,n be Nat, c be Tuple of n,k-SD;
  func Table1(q,c,f,j) -> Integer equals

  (q*DigA(c,j)) mod f;
end;

definition
  let q be Integer, k,f,n be Nat, c be Tuple of n,k-SD;
  assume
 n >= 1;
  func Mul_mod(q,c,f,k) -> Tuple of n,INT means


  it.1 = Table1(q,c,f,n)
& for i be Nat st 1 <= i & i <= n - 1 holds ex I1,I2 be Integer st I1 = it.i &
  I2 = it.(i+1) & I2 = (Radix(k)*I1+Table1(q,c,f,n -'i)) mod f;
end;

theorem 
  for n be Nat st n >= 1 holds for q be Integer, ic,f,k be Nat st ic
is_represented_by n,k & f > 0 holds for c be Tuple of n,k-SD st c = DecSD(ic,n,
  k) holds Mul_mod(q,c,f,k).n = (q * ic) mod f;

begin 


definition
  let n,f,j,m be Nat, e be Tuple of n,NAT;
  func Table2(m,e,f,j) -> Element of NAT equals

  (m |^ (e/.j)) mod f;
end;

definition
  let k,f,m,n be Nat, e be Tuple of n,NAT;
  assume
 n >= 1;
  func Pow_mod(m,e,f,k) -> Tuple of n,NAT means


  it.1 = Table2(m,e,f,n)
& for i be Nat st 1 <= i & i <= n - 1 holds ex i1,i2 be Nat st i1 = it.i & i2 =
  it.(i+1) & i2 = (((i1 |^ Radix(k)) mod f) * Table2(m,e,f,n-'i)) mod f;
end;

theorem 
  for n be Nat st n >= 1 holds for m,k,f,ie be Nat st ie
is_represented_by n,k & f>0 holds for e be Tuple of n,NAT st e = DecSD2(ie,n,k)
  holds Pow_mod(m,e,f,k).n = (m |^ ie) mod f;














begin 

theorem 
  for F being Function, i, xi being set, Ai being Subset of F.i
  holds proj(F,i)"({xi}) meets proj(F,i)"Ai implies xi in Ai;

theorem 
  for F,f being Function, i,xi being set st xi in F.i & f in product F
  holds f+*(i,xi) in product F;

theorem 
  for F being Function, i being set st i in dom F holds rng proj(F,i) c= F.i &
  (product F <> {} implies rng proj(F,i) = F.i);

theorem 
  for F being Function, i being set st i in dom F holds
  proj(F,i)"(F.i) = product F;

theorem 
  for F,f being Function, i,xi being set st xi in F.i & i in dom F
  & f in product F holds f+*(i,xi) in proj(F,i)"({xi});

theorem 
  for F,f being Function, i1,i2,xi1 being set, Ai2 being Subset of
  F.i2 st xi1 in F.i1 & f in product F holds i1 <> i2 implies (f in proj(F,i2)"
  Ai2 iff f+*(i1,xi1) in proj(F,i2)"Ai2);

theorem 
  for F being Function, i1,i2,xi1 being set, Ai2 being Subset of F.
  i2 st product F <> {} & xi1 in F.i1 & i1 in dom F & i2 in dom F & Ai2<>F.i2
  holds proj(F,i1)"({xi1}) c= proj(F,i2)"Ai2 iff i1 = i2 & xi1 in Ai2;

scheme 

  ElProductEx { I()->non empty set, J()->TopStruct-yielding non-Empty
ManySortedSet of I(), P[set,set] }: ex f being Element of product J() st for i
  being Element of I() holds P[f.i,i]
provided
 for i being Element of I() ex x being Element of J().i st P[x,i];

theorem 
  for I being non empty set, J being TopStruct-yielding non-Empty
  ManySortedSet of I, i being Element of I, f being Element of product J holds
  proj(J,i).f=f.i;

theorem 
  for I being non empty set, J being TopStruct-yielding non-Empty
  ManySortedSet of I, i being Element of I, xi being Element of J.i, Ai being
  Subset of J.i holds proj(J,i)"({xi}) meets proj(J,i)"Ai implies xi in Ai;

theorem 
  for I being non empty set, J being TopStruct-yielding non-Empty
  ManySortedSet of I, i being Element of I holds
  proj(J,i)"[#](J.i) = [#] product J;

theorem 
  for I being non empty set, J being TopStruct-yielding non-Empty
  ManySortedSet of I, i being Element of I, xi being Element of J.i, f being
  Element of product J holds f+*(i,xi) in proj(J,i)"({xi});

theorem 
  for I being non empty set, J being TopStruct-yielding non-Empty
  ManySortedSet of I, i1,i2 being Element of I, xi1 being Element of J.i1, Ai2
being Subset of J.i2 st Ai2<>[#](J.i2) holds proj(J,i1)"({xi1}) c= proj(J,i2)"
  Ai2 iff i1 = i2 & xi1 in Ai2;

theorem 
  for I being non empty set, J being TopStruct-yielding non-Empty
  ManySortedSet of I, i1,i2 being Element of I, xi1 being Element of J.i1, Ai2
being Subset of J.i2, f being Element of product J st i1<> i2 holds f in proj(J
  ,i2)"Ai2 iff f+*(i1,xi1) in proj(J,i2)"Ai2;

begin

theorem 
  for T being non empty TopStruct holds T is compact iff for F
  being Subset-Family of T st F is open & [#](T) c= union(F) ex G being
  Subset-Family of T st G c= F & [#]T c= union G & G is finite;

theorem 
  for T being non empty TopSpace, B being prebasis of T holds T is
  compact iff for F being Subset of B st [#](T) c= union(F) ex G being finite
  Subset of F st [#]T c= union G;

begin 

theorem 
  for I being non empty set, J being TopStruct-yielding non-Empty
  ManySortedSet of I, A being set st A in product_prebasis J ex i being Element
  of I, Ai being Subset of J.i st Ai is open & proj(J,i)"Ai = A;

theorem 
  for I being non empty set, J being TopStruct-yielding non-Empty
ManySortedSet of I, i being Element of I, xi being Element of J.i, A being set
st A in product_prebasis J & proj(J,i)"({xi}) c= A holds A = [#](product J) or
ex Ai being Subset of J.i st Ai <> [#](J.i) & xi in Ai & Ai is open & A=proj(J,
  i)"Ai;

theorem 
  for I being non empty set, J being TopStruct-yielding non-Empty
ManySortedSet of I, i being Element of I, Fi being non empty Subset-Family of J
  .i st [#](J.i) c= union(Fi) holds [#](product J) c= union {proj(J,i)"Ai where
  Ai is Element of Fi:not contradiction};

theorem 
  for I being non empty set, J being TopStruct-yielding non-Empty
  ManySortedSet of I, i being Element of I, xi being Element of J.i, G being
Subset of product_prebasis J st proj(J,i)"({xi}) c= union G & (for A being set
st A in product_prebasis J & A in G holds not proj(J,i)"({xi}) c= A) holds [#](
  product J) c= union G;

theorem 
  for I being non empty set, J being TopStruct-yielding non-Empty
ManySortedSet of I, i being Element of I, F being Subset of product_prebasis J
  holds (for G being finite Subset of F holds not [#](product J) c= union G)
implies for xi being Element of J.i, G being finite Subset of F st proj(J,i)"({
xi}) c= union G ex A being set st A in product_prebasis J & A in G & proj(J,i)"
  ({xi}) c= A;

theorem 
  for I being non empty set, J being TopStruct-yielding non-Empty
ManySortedSet of I, i being Element of I, F being Subset of product_prebasis J
  holds (for G being finite Subset of F holds not [#](product J) c= union G)
implies for xi being Element of J.i, G being finite Subset of F st proj(J,i)"({
xi}) c= union G holds ex Ai being Subset of J.i st Ai <> [#](J.i) & xi in Ai &
  proj(J,i)"Ai in G & Ai is open;

theorem 
  for I being non empty set, J being TopStruct-yielding non-Empty
ManySortedSet of I, i being Element of I, F being Subset of product_prebasis J
st (for i being Element of I holds J.i is compact) & (for G being finite Subset
  of F holds not [#](product J) c= union G) ex xi being Element of J.i st for G
  being finite Subset of F holds not proj(J,i)"({xi}) c= union G;


theorem 
  for I being non empty set, J being TopStruct-yielding non-Empty
  ManySortedSet of I st for i being Element of I holds J.i is compact holds
  product J is compact;















begin

definition
  let T be non empty TopRelStr;
  attr T is upper means


  {(downarrow x)` where x is Element of T: not contradiction} is prebasis of T;
end;

registration
  cluster Scott up-complete strict for TopLattice;
end;

definition
  let T be TopSpace-like non empty reflexive TopRelStr;
  attr T is order_consistent means


  for x being Element of T holds downarrow x = Cl {x} &
  for N being eventually-directed net of T st x = sup N
  for V being a_neighborhood of x holds N is_eventually_in V;
end;

registration
  cluster  -> upper for 1-element reflexive TopSpace-like TopRelStr;
end;

registration
  cluster upper trivial up-complete strict for TopLattice;
end;

theorem 
  for T being upper up-complete non empty TopPoset
  for A being Subset of T st A is open holds A is upper;

theorem 
  for T being up-complete non empty TopPoset holds
  T is upper implies T is order_consistent;

theorem 
  for R being up-complete non empty reflexive transitive antisymmetric
  RelStr ex T being TopAugmentation of R st T is Scott;

theorem 
  for R being up-complete non empty Poset
  for T being TopAugmentation of R holds T is Scott implies T is correct;

registration
  let R be up-complete non empty reflexive transitive antisymmetric RelStr;
  cluster Scott -> correct for TopAugmentation of R;
end;

registration
  let R be up-complete non empty reflexive transitive antisymmetric RelStr;
  cluster Scott correct for TopAugmentation of R;
end;

theorem 
  for T being Scott up-complete non empty reflexive transitive antisymmetric
  TopRelStr, x being Element of T holds Cl {x} = downarrow x;

theorem 
  for T being up-complete Scott non empty TopPoset holds
  T is order_consistent;

theorem 
  for R being /\-complete Semilattice, Z be net of R, D be Subset of R st
  D = {"/\"({Z.k where k is Element of Z: k >= j},R)
  where j is Element of Z: not contradiction} holds D is non empty directed;

theorem 
  for R being /\-complete Semilattice, S being Subset of R,
  a being Element of R holds a in S implies "/\"(S,R) <= a;

theorem 
  for R being /\-complete Semilattice, N being monotone reflexive net of R
  holds lim_inf N = sup N;

theorem 
  for R being /\-complete Semilattice for S being Subset of R
  holds S in the topology of ConvergenceSpace Scott-Convergence R
  iff S is inaccessible upper;

theorem 
  for R being /\-complete up-complete Semilattice,
  T being TopAugmentation of R st the topology of T = sigma R holds T is Scott;

registration
  let R be /\-complete up-complete Semilattice;
  cluster strict Scott correct for TopAugmentation of R;
end;

theorem 
  for S being up-complete /\-complete Semilattice,
  T being Scott TopAugmentation of S holds sigma S = the topology of T;

theorem 
  for T being Scott up-complete non empty reflexive transitive antisymmetric
  TopRelStr holds T is T_0-TopSpace;

registration
  let R be up-complete non empty reflexive transitive antisymmetric RelStr;
  cluster -> up-complete for TopAugmentation of R;
end;

theorem 
  for R being up-complete non empty reflexive transitive antisymmetric
  RelStr for T being Scott TopAugmentation of R, x being Element of T,
  A being upper Subset of T st not x in A
  holds (downarrow x)` is a_neighborhood of A;

theorem 
  for R being up-complete non empty reflexive transitive antisymmetric
  TopRelStr for T being Scott TopAugmentation of R, S being upper Subset of T
  ex F being Subset-Family of T st S = meet F &
  for X being Subset of T st X in F holds X is a_neighborhood of S;

theorem 
  for T being Scott up-complete non empty reflexive transitive antisymmetric
  TopRelStr, S being Subset of T holds S is open iff S is upper property(S);

theorem 
  for R being up-complete non empty reflexive transitive antisymmetric
  TopRelStr, S being non empty directed Subset of R,
  a being Element of R holds a in S implies a <= "\/"(S, R);



registration
  let T be up-complete non empty reflexive transitive antisymmetric
  TopRelStr;
  cluster lower -> property(S) for Subset of T;
end;

theorem 
  for T being finite up-complete non empty Poset,
  S being Subset of T holds S is inaccessible;

theorem 
  for R being complete connected LATTICE,
  T being Scott TopAugmentation of R, x being Element of T holds
  (downarrow x)` is open;

theorem 
  for R being complete connected LATTICE,
  T being Scott TopAugmentation of R, S being Subset of T holds
  S is open iff S = the carrier of T or S in {(downarrow x)`
  where x is Element of T: not contradiction};

registration
  let R be up-complete non empty Poset;
  cluster order_consistent for correct TopAugmentation of R;
end;

registration
  cluster order_consistent complete for TopLattice;
end;

theorem 
  for R being non empty TopRelStr for A being Subset of R holds
  (for x being Element of R holds downarrow x = Cl {x}) implies
  (A is open implies A is upper);

theorem 
  for R being non empty TopRelStr for A being Subset of R holds
  (for x being Element of R holds downarrow x = Cl {x}) implies
  for A being Subset of R st A is closed holds A is lower;

definition
  let S be non empty 1-sorted, R be non empty RelStr,
  f be Function of the carrier of R,the carrier of S;
  func R*'f -> strict non empty NetStr over S means


  the RelStr of it = the RelStr of R & the mapping of it = f;
end;

registration
  let S be non empty 1-sorted, R be non empty transitive RelStr,
  f be Function of the carrier of R,the carrier of S;
  cluster R*'f -> transitive;
end;

registration
  let S be non empty 1-sorted, R be non empty directed RelStr,
  f be Function of the carrier of R,the carrier of S;
  cluster R*'f -> directed;
end;

definition
  let R be non empty RelStr, N be prenet of R;
  func inf_net N -> strict prenet of R means


  ex f being Function of N,R st it = N*'f & for i being Element of N holds
  f.i = "/\"({N.k where k is Element of N: k >= i},R);
end;

registration
  let R be non empty RelStr, N be net of R;
  cluster inf_net N -> transitive;
end;

registration
  let R be non empty RelStr, N be net of R;
  cluster inf_net N -> directed;
end;

registration
  let R be /\-complete non empty reflexive antisymmetric RelStr,
  N be net of R;
  cluster inf_net N -> monotone;
end;

registration
  let R be /\-complete non empty reflexive antisymmetric RelStr,
  N be net of R;
  cluster inf_net N -> eventually-directed;
end;

theorem 
  for R being non empty RelStr, N being net of R
  holds rng the mapping of (inf_net N) =
  {"/\"({N.i where i is Element of N: i >= j},R) where
  j is Element of N: not contradiction};

theorem 
  for R being up-complete /\-complete LATTICE, N being net of R holds
  sup inf_net N = lim_inf N;

theorem 
  for R being up-complete /\-complete LATTICE, N being net of R,
  i being Element of N holds sup inf_net N = lim_inf (N|i);

theorem 
  for R being /\-complete Semilattice, N being net of R,
  V being upper Subset of R holds
  inf_net N is_eventually_in V implies N is_eventually_in V;

theorem 
  for R being /\-complete Semilattice, N being net of R,
  V being lower Subset of R holds
  N is_eventually_in V implies inf_net N is_eventually_in V;

theorem 
  for R being order_consistent up-complete /\-complete non empty TopLattice
  for N being net of R, x being Element of R holds
  x <= lim_inf N implies x is_a_cluster_point_of N;

theorem 
  for R being order_consistent up-complete /\-complete non empty TopLattice
  for N being eventually-directed net of R, x being Element of R holds
  x <= lim_inf N iff x is_a_cluster_point_of N;














begin

definition
  mode Chain -> RelStr means


    it is connected non empty Poset or it is empty;
end;

registration
  cluster empty -> reflexive transitive antisymmetric for RelStr;
end;

registration
  cluster -> reflexive transitive antisymmetric for Chain;
end;

registration
  cluster non empty for Chain;
end;

registration
  cluster -> connected for non empty Chain;
end;

definition
  let L be 1-sorted;
  attr L is countable means


  the carrier of L is countable;
end;

registration
  cluster finite non empty for Chain;
end;

registration
  cluster countable for Chain;
end;

registration
  let A be connected non empty RelStr;
  cluster full -> connected for non empty SubRelStr of A;
end;

registration
  let A be finite RelStr;
  cluster -> finite for SubRelStr of A;
end;

theorem 
  for n,m be Nat holds n <= m implies InclPoset(n) is full
  SubRelStr of InclPoset(m);

definition
  let L be RelStr;
  let A,B be set;
  pred A,B form_upper_lower_partition_of L means


  A \/ B = the carrier
  of L & for a,b be Element of L st a in A & b in B holds a < b;
end;

theorem 
  for L be RelStr for A,B be set holds A,B
  form_upper_lower_partition_of L implies A misses B;

theorem 
  for L be upper-bounded antisymmetric non empty RelStr holds ((the
  carrier of L) \ { Top L }), { Top L } form_upper_lower_partition_of L;

theorem 
  for L1,L2 be RelStr for f be Function of L1,L2 st f is isomorphic
  holds (the carrier of L1 <> {} iff the carrier of L2 <> {}) & (the carrier of
  L2 <> {} or the carrier of L1 = {}) & (the carrier of L1 = {} iff the carrier
  of L2 = {});

theorem 
  for L1,L2 be antisymmetric RelStr for A1,B1 be Subset of L1 st A1
  ,B1 form_upper_lower_partition_of L1 for A2,B2 be Subset of L2 st A2,B2
  form_upper_lower_partition_of L2 for f be Function of subrelstr A1, subrelstr
  A2 st f is isomorphic for g be Function of subrelstr B1, subrelstr B2 st g is
  isomorphic ex h be Function of L1,L2 st h = f +* g & h is isomorphic;

theorem 
  for A being finite Chain, n being Nat st card(the carrier of A) = n
  holds A,InclPoset n are_isomorphic;














begin 

definition
  let L be RelStr;

  attr L is finitely_typed means


  ex A being non empty set st (for e
being set st e in the carrier of L holds e is Equivalence_Relation of A) & ex o
  being Element of NAT st for e1,e2 being Equivalence_Relation of A, x,y being
  set st e1 in the carrier of L & e2 in the carrier of L & [x,y] in e1 "\/" e2
holds ex F being non empty FinSequence of A st len F = o & x,y are_joint_by F,
  e1,e2;
end;

definition
  let L be lower-bounded LATTICE;
  let n be Element of NAT;
  pred L has_a_representation_of_type<= n means


  ex A being non trivial
  set, f be Homomorphism of L,EqRelLATT A st f is one-to-one & Image f is
  finitely_typed & (ex e being Equivalence_Relation of A st e in the carrier of
  Image f & e <> id A) & type_of Image f <= n;
end;

registration
  cluster lower-bounded distributive finite for LATTICE;
end;

registration
  let A be non trivial set;
  cluster non trivial finitely_typed full for
non empty Sublattice of EqRelLATT A
    ;
end;

theorem 
  for A be non empty set for L be lower-bounded LATTICE for d be
  distance_function of A,L holds succ {} c= DistEsti(d);

theorem 
  for L being trivial Semilattice holds L is modular;

theorem 
  for A being non empty set for L being non empty Sublattice of
EqRelLATT A holds L is trivial or ex e being Equivalence_Relation of A st e in
  the carrier of L & e <> id A;

theorem 
  for L1,L2 be lower-bounded LATTICE for f being Function of L1,L2
  st f is infs-preserving sups-preserving holds f is meet-preserving
  join-preserving;

theorem 
  for L1,L2 be lower-bounded LATTICE st L1,L2 are_isomorphic & L1
  is modular holds L2 is modular;

theorem 
  for S being lower-bounded non empty Poset for T being non empty
  Poset for f being monotone Function of S,T holds Image f is lower-bounded;

theorem 
  for L being lower-bounded LATTICE for x,y being Element of L for
A being non empty set for f be Homomorphism of L,EqRelLATT A st f is one-to-one
  holds (corestr f).x <= (corestr f).y implies x <= y;

begin 


theorem 
  for A being non trivial set for L being finitely_typed full non
empty Sublattice of EqRelLATT A for e being Equivalence_Relation of A st e in
  the carrier of L & e <> id A holds type_of L <= 2 implies L is modular;

theorem 
  for L be lower-bounded LATTICE holds L
  has_a_representation_of_type<= 2 implies L is modular;



definition
  let A be set;
  func new_set2 A equals

  A \/ {{A}, {{A}}};
end;

registration
  let A be set;
  cluster new_set2 A -> non empty;
end;

definition
  let A be non empty set;
  let L be lower-bounded LATTICE;
  let d be BiFunction of A,L;
  let q be Element of [:A,A,the carrier of L,the carrier of L:];
  func new_bi_fun2(d,q) -> BiFunction of new_set2 A,L means


  (for u,v being Element of A holds it.(u,v) = d.(u,v)) &
   it.({A},{A}) = Bottom L & it.({{A}},{{A}}) = Bottom L &
   it.({A},{{A}}) = (d.(q`1_4,q`2_4)"\/"(q`3_4))"/\"(q`4_4) &
   it.({{A}
   },{A}) = (d.(q`1_4,q`2_4)"\/"(q`3_4))"/\"(q`4_4) &
  for u being Element of A
   holds it.(u,{A}) = d.(u,q`1_4)"\/"(q`3_4) &
    it.({A},u) = d.(u,q`1_4)"\/"(q`3_4) &
    it.(u,{{A}}) = d.(u,q`2_4) "\/"(q`3_4) &
    it.({{A}},u) = d.(u,q`2_4)"\/"(q`3_4);
end;

theorem 
  for A being non empty set for L being lower-bounded LATTICE for
  d being BiFunction of A,L st d is zeroed for q being Element of [:A,A,the
  carrier of L,the carrier of L:] holds new_bi_fun2(d,q) is zeroed;

theorem 
  for A being non empty set for L being lower-bounded LATTICE for
  d being BiFunction of A,L st d is symmetric for q being Element of [:A,A,the
  carrier of L,the carrier of L:] holds new_bi_fun2(d,q) is symmetric;

theorem 
  for A being non empty set for L being lower-bounded LATTICE st L
is modular for d being BiFunction of A,L st d is symmetric & d is u.t.i. for q
being Element of [:A,A,the carrier of L,the carrier of L:]
  st d.(q`1_4,q`2_4) <= (q`3_4)"\/"(q`4_4) holds new_bi_fun2(d,q) is u.t.i.;

theorem 
  for A being non empty set for L being lower-bounded LATTICE for
  d be BiFunction of A,L for q be Element of [:A,A,the carrier of L,the carrier
  of L:] holds d c= new_bi_fun2(d,q);

reserve x for set,
  C for Ordinal,
  L0 for T-Sequence;

definition
  let A be non empty set;
  let O be Ordinal;
  func ConsecutiveSet2(A,O) means


  ex L0 being T-Sequence st it = last
  L0 & dom L0 = succ O & L0.{} = A & (for C being Ordinal st succ C in succ O
  holds L0.succ C = new_set2(L0.C)) & for C being Ordinal st C in succ O & C <>
  {} & C is limit_ordinal holds L0.C = union rng (L0|C);
end;

theorem 
  for A being non empty set holds ConsecutiveSet2(A,{}) = A;

theorem 
  for A being non empty set for O being Ordinal holds
  ConsecutiveSet2(A,succ O) = new_set2 ConsecutiveSet2(A,O);

theorem 
  for A being non empty set for O being Ordinal for T being
  T-Sequence holds O <> {} & O is limit_ordinal & dom T = O & (for O1 being
Ordinal st O1 in O holds T.O1 = ConsecutiveSet2(A,O1)) implies ConsecutiveSet2(
  A,O) = union rng T;

reserve O1,O2 for Ordinal;

registration
  let A be non empty set;
  let O be Ordinal;
  cluster ConsecutiveSet2(A,O) -> non empty;
end;

theorem 
  for A being non empty set for O being Ordinal holds A c= ConsecutiveSet2(A,O)
;

definition
  let A be non empty set;
  let L be lower-bounded LATTICE;
  let d be BiFunction of A,L;
  let q be QuadrSeq of d;
  let O be Ordinal;
  assume
 O in dom q;
  func Quadr2(q,O) -> Element of [:ConsecutiveSet2(A,O),ConsecutiveSet2(A,O),
  the carrier of L,the carrier of L:] equals


  q.O;
end;

definition
  let A be non empty set;
  let L be lower-bounded LATTICE;
  let d be BiFunction of A,L;
  let q be QuadrSeq of d;
  let O be Ordinal;
  func ConsecutiveDelta2(q,O) means


  ex L0 being T-Sequence st it = last
  L0 & dom L0 = succ O & L0.{} = d & (for C being Ordinal st succ C in succ O
holds L0.succ C = new_bi_fun2(BiFun(L0.C,ConsecutiveSet2(A,C),L),Quadr2(q,C)))
& for C being Ordinal st C in succ O & C <> {} & C is limit_ordinal holds L0.C
  = union rng(L0|C);
end;

theorem 
  for A being non empty set for L be lower-bounded LATTICE for d
being BiFunction of A,L for q being QuadrSeq of d holds ConsecutiveDelta2(q,{})
  = d;

theorem 
  for A being non empty set for L be lower-bounded LATTICE for d
  be BiFunction of A,L for q being QuadrSeq of d for O being Ordinal holds
  ConsecutiveDelta2(q,succ O) = new_bi_fun2(BiFun(ConsecutiveDelta2(q,O),
  ConsecutiveSet2(A,O),L),Quadr2(q,O));

theorem 
  for A being non empty set for L be lower-bounded LATTICE for d
  be BiFunction of A,L for q being QuadrSeq of d for T being T-Sequence for O
  being Ordinal holds O <> {} & O is limit_ordinal & dom T = O & (for O1 being
  Ordinal st O1 in O holds T.O1 = ConsecutiveDelta2(q,O1)) implies
  ConsecutiveDelta2(q,O) = union rng T;

theorem 
  for A being non empty set for O,O1,O2 being Ordinal holds O1 c=
  O2 implies ConsecutiveSet2(A,O1) c= ConsecutiveSet2(A,O2);

theorem 
  for A being non empty set for L be lower-bounded LATTICE for d
  be BiFunction of A,L for q being QuadrSeq of d for O being Ordinal holds
  ConsecutiveDelta2(q,O) is BiFunction of ConsecutiveSet2(A,O),L;

definition
  let A be non empty set;
  let L be lower-bounded LATTICE;
  let d be BiFunction of A,L;
  let q be QuadrSeq of d;
  let O be Ordinal;
  redefine func ConsecutiveDelta2(q,O) -> BiFunction of ConsecutiveSet2(A,O),L;
end;

theorem 
  for A being non empty set for L be lower-bounded LATTICE for d
  be BiFunction of A,L for q being QuadrSeq of d for O being Ordinal holds d c=
  ConsecutiveDelta2(q,O);

theorem 
  for A being non empty set for L be lower-bounded LATTICE for d
being BiFunction of A,L for O1,O2 being Ordinal for q being QuadrSeq of d st O1
  c= O2 holds ConsecutiveDelta2(q,O1) c= ConsecutiveDelta2(q,O2);

theorem 
  for A being non empty set for L be lower-bounded LATTICE for d
  be BiFunction of A,L st d is zeroed for q being QuadrSeq of d for O being
  Ordinal holds ConsecutiveDelta2(q,O) is zeroed;

theorem 
  for A being non empty set for L be lower-bounded LATTICE for d
  be BiFunction of A,L st d is symmetric for q being QuadrSeq of d for O being
  Ordinal holds ConsecutiveDelta2(q,O) is symmetric;

theorem 
  for A being non empty set for L being lower-bounded LATTICE st L
  is modular for d be BiFunction of A,L st d is symmetric u.t.i. for O being
Ordinal for q being QuadrSeq of d st O c= DistEsti(d) holds ConsecutiveDelta2(q
  ,O) is u.t.i.;

theorem 
  for A being non empty set for L being lower-bounded modular LATTICE
  for d being distance_function of A,L for O being Ordinal for q being QuadrSeq
  of d st O c= DistEsti(d) holds ConsecutiveDelta2(q,O) is distance_function of
  ConsecutiveSet2(A,O),L;

definition
  let A be non empty set;
  let L be lower-bounded LATTICE;
  let d be BiFunction of A,L;
  func NextSet2(d) equals

  ConsecutiveSet2(A,DistEsti(d));
end;

registration
  let A be non empty set;
  let L be lower-bounded LATTICE;
  let d be BiFunction of A,L;
  cluster NextSet2(d) -> non empty;
end;

definition
  let A be non empty set;
  let L be lower-bounded LATTICE;
  let d be BiFunction of A,L;
  let q be QuadrSeq of d;
  func NextDelta2(q) equals

  ConsecutiveDelta2(q,DistEsti(d));
end;

definition
  let A be non empty set;
  let L be lower-bounded modular LATTICE;
  let d be distance_function of A,L;
  let q be QuadrSeq of d;
  redefine func NextDelta2(q) -> distance_function of NextSet2(d),L;
end;

definition
  let A be non empty set;
  let L be lower-bounded LATTICE;
  let d be distance_function of A,L;
  let Aq be non empty set;
  let dq be distance_function of Aq,L;
  pred Aq, dq is_extension2_of A,d means


  ex q being QuadrSeq of d st Aq = NextSet2(d) & dq = NextDelta2(q);
end;

theorem 
  for A being non empty set for L be lower-bounded LATTICE for d
be distance_function of A,L for Aq be non empty set for dq be distance_function
  of Aq,L st Aq, dq is_extension2_of A,d for x,y being Element of A, a,b being
Element of L st d.(x,y) <= a "\/" b ex z1,z2 being Element of Aq st dq.(x,z1) =
  a & dq.(z1,z2) = (d.(x,y) "\/" a) "/\" b & dq.(z2,y) = a;

definition
  let A be non empty set;
  let L be lower-bounded modular LATTICE;
  let d be distance_function of A,L;
  mode ExtensionSeq2 of A,d -> Function means


    dom it = NAT & it.0 = [A
    ,d] & for n being Element of NAT holds ex A9 being non empty set, d9 being
distance_function of A9,L, Aq being non empty set, dq being distance_function
of Aq,L st Aq, dq is_extension2_of A9,d9 & it.n = [A9,d9] & it.(n+1) = [Aq,dq];
end;

theorem 
  for A being non empty set for L be lower-bounded modular LATTICE
  for d be distance_function of A,L for S being ExtensionSeq2 of A,d for k,l
  being Element of NAT st k <= l holds (S.k)`1 c= (S.l)`1;

theorem 
  for A being non empty set for L be lower-bounded modular LATTICE
  for d be distance_function of A,L for S being ExtensionSeq2 of A,d for k,l
  being Element of NAT st k <= l holds (S.k)`2 c= (S.l)`2;

theorem 
  for L be lower-bounded modular LATTICE for S being ExtensionSeq2
of the carrier of L, BasicDF(L) for FS being non empty set st FS = union { (S.i
)`1 where i is Element of NAT: not contradiction} holds union { (S.i)`2 where i
  is Element of NAT: not contradiction} is distance_function of FS,L;

theorem 
  for L be lower-bounded modular LATTICE for S being ExtensionSeq2
  of the carrier of L, BasicDF(L) for FS being non empty set for FD being
distance_function of FS,L for x,y being Element of FS for a,b being Element of
L st FS = union { (S.i)`1 where i is Element of NAT: not contradiction} & FD =
  union { (S.i)`2 where i is Element of NAT: not contradiction} & FD.(x,y) <= a
  "\/"b ex z1,z2 being Element of FS st FD.(x,z1) = a & FD.(z1,z2) = (FD.(x,y)
  "\/"a)"/\"b & FD.(z2,y) = a;

theorem 
  for L be lower-bounded modular LATTICE for S being ExtensionSeq2
  of the carrier of L, BasicDF(L) for FS being non empty set for FD being
distance_function of FS,L for f being Homomorphism of L,EqRelLATT FS for e1,e2
being Equivalence_Relation of FS for x,y being set st f = alpha FD & FS = union
{ (S.i)`1 where i is Element of NAT: not contradiction} & FD = union { (S.i)`2
where i is Element of NAT: not contradiction} & e1 in the carrier of Image f &
  e2 in the carrier of Image f & [x,y] in e1 "\/" e2 ex F being non empty
  FinSequence of FS st len F = 2+2 & x,y are_joint_by F,e1,e2;

theorem 
  for L be lower-bounded modular LATTICE holds L
  has_a_representation_of_type<= 2;




theorem 
  for L be lower-bounded LATTICE holds L has_a_representation_of_type<=
  2 iff L is modular;














begin 

scheme 

  SSubsetUniq { R() -> 1-sorted, P[set] } : for A1, A2 being Subset of R() st (
for x being set holds x in A1 iff P[x]) & (for x being set holds x in A2 iff P[
  x]) holds A1 = A2;

registration
  let A, x be set;
  cluster [:A, {x}:] -> Function-like;
end;

theorem 
  for X being finite non empty Subset of NAT holds ex n being
  Element of NAT st X c= Seg n \/ {0};

theorem 
  for X being finite Subset of NAT holds ex k being odd Element of NAT
  st not k in X;

theorem 
  for k being Element of NAT, X being finite non empty Subset of [:
NAT,{k}:] holds ex n being non empty Element of NAT st X c= [:Seg n \/ {0},{k}
  :];

theorem 
  for m being Element of NAT, X being finite non empty Subset of [:
  NAT,{m}:] holds ex k being non empty Element of NAT st not [2*k+1,m] in X;

theorem 
  for m being Element of NAT, X being finite Subset of [:NAT,{m}:] ex k
being Element of NAT st for l being Element of NAT st l >= k holds not [l,m] in
  X;

theorem 
  for L being upper-bounded Lattice holds Top L = Top LattPOSet L;

theorem 
  for L being lower-bounded Lattice holds Bottom L = Bottom LattPOSet L;

begin 

theorem 
  for V being set, C being finite set, A, B being Element of Fin PFuncs
  (V, C) st A = {} & B <> {} holds B =>> A = {};

theorem 
  for V, V9, C, C9 being set st V c= V9 & C c= C9 holds
  SubstitutionSet (V, C) c= SubstitutionSet (V9, C9);

theorem 
  for V, V9, C, C9 being set, A being Element of Fin PFuncs (V, C)
, B being Element of Fin PFuncs (V9, C9) st V c= V9 & C c= C9 & A = B holds mi
  A = mi B;

theorem 
  for V, V9, C, C9 being set st V c= V9 & C c= C9 holds the L_join of
SubstLatt (V, C) = (the L_join of SubstLatt (V9, C9))||the carrier of SubstLatt
  (V, C);

definition
  let V, C be set;
  func SubstPoset (V, C) -> RelStr equals

  LattPOSet SubstLatt (V, C);
end;

registration
  let V, C be set;
  cluster SubstPoset (V, C) -> with_suprema with_infima;
end;

registration
  let V, C be set;
  cluster SubstPoset (V, C) -> reflexive antisymmetric transitive;
end;

theorem 
  for V, C being set, a, b being Element of SubstPoset (V, C)
  holds a <= b iff for x being set st x in a ex y being set st y in b & y c= x;

theorem 
  for V, V9, C, C9 being set st V c= V9 & C c= C9 holds SubstPoset (V, C
  ) is full SubRelStr of SubstPoset (V9, C9);

definition
  let n, k be Element of NAT;
  func PFArt (n, k) -> Element of PFuncs (NAT, {k}) means


  for x being
set holds x in it iff ( ex m being odd Element of NAT st m <= 2*n & [m,k] = x )
  or [2*n,k] = x;
end;

registration
  let n, k be Element of NAT;
  cluster PFArt (n, k) -> finite;
end;

definition
  let n, k be Element of NAT;
  func PFCrt (n, k) -> Element of PFuncs (NAT, {k}) means


  for x being
set holds x in it iff ex m being odd Element of NAT st m <= 2*n + 1 & [m,k] = x
  ;
end;

registration
  let n,k be Element of NAT;
  cluster PFCrt (n,k) -> finite;
end;

theorem 
  for n, k being Element of NAT holds [2*n+1,k] in PFCrt (n,k);

theorem 
  for n, k being Element of NAT holds PFCrt (n,k) misses {[2*n+3,k ]};

theorem 
  for n, k being Element of NAT holds PFCrt (n+1,k) = PFCrt (n,k)
  \/ {[2*n+3,k]};

theorem 
  for n, k being Element of NAT holds PFCrt (n,k) c< PFCrt (n+1,k);

registration
  let n, k be Element of NAT;
  cluster PFArt (n, k) -> non empty;
end;

theorem 
  for n, m, k being Element of NAT holds not PFArt (n, m) c= PFCrt (k, m);

theorem 
  for n, m, k being Element of NAT st n <= k holds PFCrt (n,m) c= PFCrt (k,m);

theorem 
  for n being Element of NAT holds PFArt (1,n) = { [1,n], [2,n] };

definition
  let n, k be Element of NAT;
  func PFBrt (n,k) -> Element of Fin PFuncs (NAT, {k}) means


  for x
being set holds x in it iff ( ex m being non empty Element of NAT st m <= n & x
  = PFArt (m,k) ) or x = PFCrt (n,k);
end;

theorem 
  for n, k being Element of NAT, x being set st x in PFBrt (n+1,k) holds
  ex y being set st y in PFBrt (n,k) & y c= x;

theorem 
  for n, k being Element of NAT holds not PFCrt (n,k) in PFBrt (n+1,k);

theorem 
  for n, m, k being Element of NAT st PFArt (n,m) c= PFArt (k,m) holds n = k;

theorem 
  for n, m, k being Element of NAT holds PFCrt (n,m) c= PFArt (k,m ) iff n < k;

begin 

theorem 
  for n, k being Element of NAT holds PFBrt (n,k) is Element of
  SubstPoset (NAT, {k});

definition
  let k be Element of NAT;
  func PFDrt k -> Subset of SubstPoset (NAT, {k}) means


  for x being set
  holds x in it iff ex n being non empty Element of NAT st x = PFBrt (n,k);
end;

theorem 
  for k being Element of NAT holds PFBrt (1,k) = { PFArt (1,k), PFCrt (1 ,k) };

theorem 
  for k being Element of NAT holds PFBrt (1,k) <> {{}};

registration
  let k be Element of NAT;
  cluster PFBrt (1,k) -> non empty;
end;

theorem 
  for n, k being Element of NAT holds { PFArt (n,k) } is Element
  of SubstPoset (NAT, {k});

theorem 
  for k being Element of NAT, V, X being set, a being Element of
  SubstPoset (V, {k}) st X in a holds X is finite Subset of [:V, {k}:];

theorem 
  for m being Element of NAT, a being Element of SubstPoset (NAT,
  {m}) st PFDrt m is_>=_than a holds for X being non empty set st X in a holds
  not ( for n being Element of NAT st [n,m] in X holds n is odd );

theorem 
  for k being Element of NAT, a, b being Element of SubstPoset (
  NAT, {k}), X being Subset of SubstPoset (NAT, {k}) st a is_<=_than X & b
  is_<=_than X holds a "\/" b is_<=_than X;

registration
  let k be Element of NAT;
  cluster non empty for Element of SubstPoset (NAT, {k});
end;

theorem 
  for n being Element of NAT, a being Element of SubstPoset (NAT,
  {n}) st {} in a holds a = {{}};

theorem 
  for k being Element of NAT, a being non empty Element of
SubstPoset (NAT, {k}) st a <> {{}} ex f being finite Function st f in a & f <>
  {};

theorem 
  for k being Element of NAT, a being non empty Element of
SubstPoset (NAT, {k}), a9 being Element of Fin PFuncs (NAT, {k}) st a <> {{}} &
  a = a9 holds Involved a9 is finite non empty Subset of NAT;

theorem 
  for k being Element of NAT, a being Element of SubstPoset (NAT,
  {k}), a9 being Element of Fin PFuncs (NAT, {k}), B being finite non empty
Subset of NAT st B = Involved a9 & a9 = a holds for X being set st X in a for l
  being Element of NAT st l > max B + 1 holds not [l,k] in X;

theorem 
  for k being Element of NAT holds Top SubstPoset (NAT, {k}) = {{} };

theorem 
  for k being Element of NAT holds Bottom SubstPoset (NAT, {k}) = {};

theorem 
  for k being Element of NAT, a, b being Element of SubstPoset (
  NAT, {k}) st a <= b & a = {{}} holds b = {{}};

theorem 
  for k being Element of NAT, a, b being Element of SubstPoset (
  NAT, {k}) st a <= b & b = {} holds a = {};

theorem 
  for m being Element of NAT, a being Element of SubstPoset (NAT,
  {m}) st PFDrt m is_>=_than a holds a <> {{}};

registration
  let m be Element of NAT;
  cluster SubstPoset (NAT, {m}) -> non complete;
end;

registration
  let m be Element of NAT;
  cluster SubstLatt (NAT, {m}) -> non complete;
end;















begin  

reserve i, i1, i2, j, j1, j2, k, m, n, t for Element of NAT,
  D for non empty Subset of TOP-REAL 2,
  E for compact non vertical non horizontal Subset of TOP-REAL 2,
  C for compact connected non vertical non horizontal Subset of TOP-REAL 2,
  G for Go-board,
  p, q, x for Point of TOP-REAL 2,
  r, s for real number;

definition
  let f be FinSequence;
  func Center f -> Element of NAT equals

  len f div 2 + 1;
end;

theorem 
  for f being FinSequence st len f is odd holds len f = 2 * Center f - 1;

theorem 
  for f being FinSequence st len f is even holds len f = 2 * Center f - 2;

begin  

registration
  cluster compact non vertical non horizontal being_simple_closed_curve non
    empty for Subset of TOP-REAL 2;
end;

theorem 
  p in N-most D implies p`2 = N-bound D;

theorem 
  p in E-most D implies p`1 = E-bound D;

theorem 
  p in S-most D implies p`2 = S-bound D;

theorem 
  p in W-most D implies p`1 = W-bound D;

theorem 
  for D being Subset of TOP-REAL 2 holds BDD D misses D;

theorem 
  p in Vertical_Line(p`1);

theorem 
  |[r,s]| in Vertical_Line r;

theorem 
  for A being Subset of TOP-REAL 2 st A c= Vertical_Line s holds A is vertical;

theorem 
  p`1 = q`1 & r in [. proj2.p,proj2.q .] implies |[p`1,r]| in LSeg(p,q);

theorem 
  p`2 = q`2 & r in [. proj1.p,proj1.q .] implies |[r,p`2]| in LSeg(p,q);

theorem 
  p in Vertical_Line s & q in Vertical_Line s implies LSeg(p,q) c=
  Vertical_Line s;

theorem 
  for A,B being Subset of TOP-REAL 2 st A meets B holds proj2.:A meets proj2.:B
;

theorem 
  for A,B being Subset of TOP-REAL 2 st A misses B & A c= Vertical_Line
  s & B c= Vertical_Line s holds proj2.:A misses proj2.:B;

begin  

theorem 
  1 <= i & i <= len G & 1 <= j & j <= width G implies G*(i,j) in LSeg(G*
  (i,1),G*(i,width G));

theorem 
  1 <= i & i <= len G & 1 <= j & j <= width G implies G*(i,j) in LSeg(G*
  (1,j),G*(len G,j));

theorem 
  1 <= j1 & j1 <= width G & 1 <= j2 & j2 <= width G & 1 <= i1 & i1
  <= i2 & i2 <= len G implies G*(i1,j1)`1 <= G*(i2,j2)`1;

theorem 
  1 <= i1 & i1 <= len G & 1 <= i2 & i2 <= len G & 1 <= j1 & j1 <=
  j2 & j2 <= width G implies G*(i1,j1)`2 <= G*(i2,j2)`2;

theorem 
  for f being non constant standard special_circular_sequence st f
  is_sequence_on G & 1 <= t & t <= len G holds G*(t,width G)`2 >= N-bound L~f;

theorem 
  for f being non constant standard special_circular_sequence st f
  is_sequence_on G & 1 <= t & t <= width G holds G*(1,t)`1 <= W-bound L~f;

theorem 
  for f being non constant standard special_circular_sequence st f
  is_sequence_on G & 1 <= t & t <= len G holds G*(t,1)`2 <= S-bound L~f;

theorem 
  for f being non constant standard special_circular_sequence st f
  is_sequence_on G & 1 <= t & t <= width G holds G*(len G,t)`1 >= E-bound L~f;

theorem 
  i<=len G & j<=width G implies cell(G,i,j) is non empty;

theorem 
  i<=len G & j<=width G implies cell(G,i,j) is connected;

theorem 
  i <= len G implies cell(G,i,0) is not bounded;

theorem 
  i <= len G implies cell(G,i,width G) is not bounded;

begin  

theorem 
  width Gauge(D,n) = 2|^n + 3;

theorem 
  i < j implies len Gauge(D,i) < len Gauge(D,j);

theorem 
  i <= j implies len Gauge(D,i) <= len Gauge(D,j);

theorem 
  m <= n & 1 < i & i < len Gauge(D,m) implies 1 < 2|^(n-'m)*(i-2)+
  2 & 2|^(n-'m)*(i-2)+2 < len Gauge(D,n);

theorem 
  m <= n & 1 < i & i < width Gauge(D,m) implies 1 < 2|^(n-'m)*(i-2
  )+2 & 2|^(n-'m)*(i-2)+2 < width Gauge(D,n);

theorem 
  m <= n & 1 < i & i < len Gauge(D,m) & 1 < j & j < width Gauge(D,
m) implies for i1,j1 being Element of NAT st i1 = 2|^(n-'m)*(i-2)+2 & j1 = 2|^(
  n-'m)*(j-2)+2 holds Gauge(D,m)*(i,j) = Gauge(D,n)*(i1,j1);

theorem 
  m <= n & 1 < i & i+1 < len Gauge(D,m) implies 1 < 2|^(n-'m)*(i-1
  )+2 & 2|^(n-'m)*(i-1)+2 <= len Gauge(D,n);

theorem 
  m <= n & 1 < i & i+1 < width Gauge(D,m) implies 1 < 2|^(n-'m)*(i
  -1)+2 & 2|^(n-'m)*(i-1)+2 <= width Gauge(D,n);

theorem 
  1 <= i & i <= len Gauge (D,n) & 1 <= j & j <= len Gauge (D,m) &
(n > 0 & m > 0 or n = 0 & m = 0) implies Gauge(D,n)*(Center Gauge(D,n), i)`1 =
  Gauge(D,m)*(Center Gauge(D,m), j)`1;

theorem 
  1 <= i & i <= len Gauge (D,n) & 1 <= j & j <= len Gauge (D,m) & (n > 0
& m > 0 or n = 0 & m = 0) implies Gauge(D,n)*(i, Center Gauge(D,n))`2 = Gauge(D
  ,m)*(j, Center Gauge(D,m))`2;

theorem 
  1 <= i & i <= len Gauge(C,1) implies Gauge(C,1)*(Center Gauge(C,1),i)
  `1 = (W-bound C + E-bound C) / 2;

theorem 
  1 <= i & i <= len Gauge(C,1) implies Gauge(C,1)*(i,Center Gauge(C,1))
  `2 = (S-bound C + N-bound C) / 2;

theorem 
  1 <= i & i <= len Gauge(E,n) & 1 <= j & j <= len Gauge(E,m) & m
<= n implies Gauge(E,n)*(i,len Gauge(E,n))`2 <= Gauge(E,m)*(j,len Gauge(E,m))`2
;

theorem 
  1 <= i & i <= len Gauge(E,n) & 1 <= j & j <= len Gauge(E,m) & m <= n
  implies Gauge(E,n)*(len Gauge(E,n),i)`1 <= Gauge(E,m)*(len Gauge(E,m),j)`1;

theorem 
  1 <= i & i <= len Gauge(E,n) & 1 <= j & j <= len Gauge(E,m) & m <= n
  implies Gauge(E,m)*(1,j)`1 <= Gauge(E,n)*(1,i)`1;

theorem 
  1 <= i & i <= len Gauge(E,n) & 1 <= j & j <= len Gauge(E,m) & m <= n
  implies Gauge(E,m)*(j,1)`2 <= Gauge(E,n)*(i,1)`2;

theorem 
  1 <= m & m <= n implies LSeg(Gauge(E,n)*(Center Gauge(E,n),1), Gauge(E
,n)*(Center Gauge(E,n),len Gauge(E,n))) c= LSeg(Gauge(E,m)*(Center Gauge(E,m),1
  ), Gauge(E,m)*(Center Gauge(E,m),len Gauge(E,m)));

theorem 
  1 <= m & m <= n & 1 <= j & j <= width Gauge(E,n) implies LSeg(Gauge(E,
n)*(Center Gauge(E,n),1), Gauge(E,n)*(Center Gauge(E,n),j)) c= LSeg(Gauge(E,m)*
  (Center Gauge(E,m),1), Gauge(E,n)*(Center Gauge(E,n),j));

theorem 
  1 <= m & m <= n & 1 <= j & j <= width Gauge(E,n) implies LSeg(Gauge(E,
m)*(Center Gauge(E,m),1), Gauge(E,n)*(Center Gauge(E,n),j)) c= LSeg(Gauge(E,m)*
  (Center Gauge(E,m),1), Gauge(E,m)*(Center Gauge(E,m),len Gauge(E,m)));

theorem 
  m <= n & 1 < i & i+1 < len Gauge(E,m) & 1 < j & j+1 < width
Gauge(E,m) implies for i1,j1 being Element of NAT st 2|^(n-'m)*(i-2)+2 <= i1 &
i1 < 2|^(n-'m)*(i-1)+2 & 2|^(n-'m)*(j-2)+2 <= j1 & j1 < 2|^(n-'m)*(j-1)+2 holds
  cell(Gauge(E,n),i1,j1) c= cell(Gauge(E,m),i,j);

theorem 
  m <= n & 3 <= i & i < len Gauge(E,m) & 1 < j & j+1 < width Gauge(E,m)
implies for i1,j1 being Element of NAT st i1 = 2|^(n-'m)*(i-2)+2 & j1 = 2|^(n-'
  m)*(j-2)+2 holds cell(Gauge(E,n),i1-'1,j1) c= cell(Gauge(E,m),i-'1,j);

theorem 
  for C being compact non vertical non horizontal Subset of TOP-REAL 2
  holds i <= len Gauge(C,n) implies cell(Gauge(C,n),i,0) c= UBD C;

theorem 
  for C being compact non vertical non horizontal Subset of TOP-REAL 2
holds i <= len Gauge(E,n) implies cell(Gauge(E,n),i,width Gauge(E,n)) c= UBD E;

begin  

theorem 
  p in C implies north_halfline p meets L~Cage(C,n);

theorem 
  p in C implies east_halfline p meets L~Cage(C,n);

theorem 
  p in C implies south_halfline p meets L~Cage(C,n);

theorem 
  p in C implies west_halfline p meets L~Cage(C,n);

theorem 
  ex k,t st 1 <= k & k < len Cage(C,n) & 1 <= t & t <= width (
  Gauge(C,n)) & Cage(C,n)/.k = Gauge(C,n)*(1,t);

theorem 
  ex k,t st 1 <= k & k < len Cage(C,n) & 1 <= t & t <= len (Gauge(
  C,n)) & Cage(C,n)/.k = Gauge(C,n)*(t,1);

theorem 
  ex k,t st 1 <= k & k < len Cage(C,n) & 1 <= t & t <= width (
  Gauge(C,n)) & Cage(C,n)/.k = Gauge(C,n)*(len(Gauge(C,n)),t);

theorem 
  1 <= k & k <= len Cage(C,n) & 1 <= t & t <= len (Gauge(C,n)) &
  Cage(C,n)/.k = Gauge(C,n)*(t,width Gauge(C,n)) implies Cage(C,n)/.k in N-most
  L~Cage(C,n);

theorem 
  1 <= k & k <= len Cage(C,n) & 1 <= t & t <= width (Gauge(C,n)) &
  Cage(C,n)/.k = Gauge(C,n)*(1,t) implies Cage(C,n)/.k in W-most L~Cage(C,n);

theorem 
  1 <= k & k <= len Cage(C,n) & 1 <= t & t <= len (Gauge(C,n)) &
  Cage(C,n)/.k = Gauge(C,n)*(t,1) implies Cage(C,n)/.k in S-most L~Cage(C,n);

theorem 
  1 <= k & k <= len Cage(C,n) & 1 <= t & t <= width (Gauge(C,n)) &
Cage(C,n)/.k = Gauge(C,n)*(len Gauge(C,n),t) implies Cage(C,n)/.k in E-most L~
  Cage(C,n);

theorem 
  W-bound L~Cage(C,n) = W-bound C - (E-bound C - W-bound C)/(2|^n);

theorem 
  S-bound L~Cage(C,n) = S-bound C - (N-bound C - S-bound C)/(2|^n);

theorem 
  E-bound L~Cage(C,n) = E-bound C + (E-bound C - W-bound C)/(2|^n);

theorem 
  N-bound L~Cage(C,n) + S-bound L~Cage(C,n) = N-bound L~Cage(C,m) +
  S-bound L~Cage(C,m);

theorem 
  E-bound L~Cage(C,n) + W-bound L~Cage(C,n) = E-bound L~Cage(C,m) +
  W-bound L~Cage(C,m);

theorem 
  i < j implies E-bound L~Cage(C,j) < E-bound L~Cage(C,i);

theorem 
  i < j implies W-bound L~Cage(C,i) < W-bound L~Cage(C,j);

theorem 
  i < j implies S-bound L~Cage(C,i) < S-bound L~Cage(C,j);

theorem 
  1 <= i & i <= len Gauge(C,n) implies N-bound L~Cage(C,n) = Gauge(C,n)*
  (i,len Gauge(C,n))`2;

theorem 
  1 <= i & i <= len Gauge(C,n) implies E-bound L~Cage(C,n) = Gauge(C,n)*
  (len Gauge(C,n),i)`1;

theorem 
  1 <= i & i <= len Gauge(C,n) implies S-bound L~Cage(C,n) = Gauge(C,n)*
  (i,1)`2;

theorem 
  1 <= i & i <= len Gauge(C,n) implies W-bound L~Cage(C,n) = Gauge(C,n)*
  (1,i)`1;

theorem 
  x in C & p in north_halfline x /\ L~Cage(C,n) implies p`2 > x`2;

theorem 
  x in C & p in east_halfline x /\ L~Cage(C,n) implies p`1 > x`1;

theorem 
  x in C & p in south_halfline x /\ L~Cage(C,n) implies p`2 < x`2;

theorem 
  x in C & p in west_halfline x /\ L~Cage(C,n) implies p`1 < x`1;

theorem 
  x in N-most C & p in north_halfline x & 1 <= i & i < len Cage(C,
  n) & p in LSeg(Cage(C,n),i) implies LSeg(Cage(C,n),i) is horizontal;

theorem 
  x in E-most C & p in east_halfline x & 1 <= i & i < len Cage(C,
  n) & p in LSeg(Cage(C,n),i) implies LSeg(Cage(C,n),i) is vertical;

theorem 
  x in S-most C & p in south_halfline x & 1 <= i & i < len Cage(C
  ,n) & p in LSeg(Cage(C,n),i) implies LSeg(Cage(C,n),i) is horizontal;

theorem 
  x in W-most C & p in west_halfline x & 1 <= i & i < len Cage(C,
  n) & p in LSeg(Cage(C,n),i) implies LSeg(Cage(C,n),i) is vertical;

theorem 
  x in N-most C & p in north_halfline x /\ L~Cage(C,n) implies p
  `2 = N-bound L~Cage(C,n);

theorem 
  x in E-most C & p in east_halfline x /\ L~Cage(C,n) implies p`1
  = E-bound L~Cage(C,n);

theorem 
  x in S-most C & p in south_halfline x /\ L~Cage(C,n) implies p
  `2 = S-bound L~Cage(C,n);

theorem 
  x in W-most C & p in west_halfline x /\ L~Cage(C,n) implies p`1
  = W-bound L~Cage(C,n);

theorem 
  x in N-most C implies ex p being Point of TOP-REAL 2 st north_halfline
  x /\ L~Cage(C,n) = {p};

theorem 
  x in E-most C implies ex p being Point of TOP-REAL 2 st east_halfline
  x /\ L~Cage(C,n) = {p};

theorem 
  x in S-most C implies ex p being Point of TOP-REAL 2 st south_halfline
  x /\ L~Cage(C,n) = {p};

theorem 
  x in W-most C implies ex p being Point of TOP-REAL 2 st west_halfline
  x /\ L~Cage(C,n) = {p};















begin

reserve E for compact non vertical non horizontal Subset of TOP-REAL 2,
  C for compact connected non vertical non horizontal Subset of TOP-REAL 2,
  G for Go-board,
  i, j, m, n for Element of NAT,
  p for Point of TOP-REAL 2;

theorem 
  for f being FinSequence holds f is empty iff Rev f is empty;

theorem 
  for D being non empty set, f being FinSequence of D for i,j st 1 <= i
  & i <= len f & 1 <= j & j <= len f holds mid(f,i,j) is non empty;

theorem 
  for f be FinSequence of TOP-REAL 2 for p be Point of TOP-REAL 2
  st 1 <= len f & p in L~f holds R_Cut(f,p).1 = f.1;

theorem 
  for f be FinSequence of TOP-REAL 2 for p be Point of TOP-REAL 2 st f
  is being_S-Seq & p in L~f holds L_Cut(f,p).(len L_Cut(f,p)) = f.(len f);

theorem 
  for P be Simple_closed_curve holds W-max(P) <> E-max(P);

theorem 
  for D be non empty set for f be FinSequence of D st 1 <= i & i < len f
  holds mid(f,i,len f-'1)^<*f/.(len f)*> = mid(f,i,len f);

theorem 
  for p,q be Point of TOP-REAL 2 st p <> q & LSeg(p,q) is vertical holds
  <*p,q*> is being_S-Seq;

theorem 
  for p,q be Point of TOP-REAL 2 st p <> q & LSeg(p,q) is horizontal
  holds <*p,q*> is being_S-Seq;

theorem 
  for p,q be FinSequence of TOP-REAL 2 for v be Point of TOP-REAL
  2 st p is_in_the_area_of q holds Rotate(p,v) is_in_the_area_of q;

theorem 
  for p be non trivial FinSequence of TOP-REAL 2 for v be Point of
  TOP-REAL 2 holds Rotate(p,v) is_in_the_area_of p;

theorem 
  for f be FinSequence holds Center f >= 1;

theorem 
  for f be FinSequence st len f >= 1 holds Center f <= len f;

theorem 
  Center G <= len G;

theorem 
  for f be FinSequence st len f >= 2 holds Center f > 1;

theorem 
  for f be FinSequence st len f >= 3 holds Center f < len f;

theorem 
  Center Gauge(E,n) = 2|^(n-'1) + 2;

theorem 
  E c= cell(Gauge(E,0),2,2);

theorem 
  not cell(Gauge(E,0),2,2) c= BDD E;

theorem 
  Gauge(C,1)*(Center Gauge(C,1),1) = |[(W-bound C + E-bound C)/2,S-bound
  L~Cage(C,1)]|;

theorem 
  Gauge(C,1)*(Center Gauge(C,1),len Gauge(C,1)) = |[(W-bound C + E-bound
  C)/2,N-bound L~Cage(C,1)]|;

theorem 
  1 <= j & j < width G & 1 <= m & m <= len G & 1 <= n & n <= width
  G & p in cell(G,len G,j) & p`1 = G*(m,n)`1 implies len G = m;

theorem 
  1 <= i & i <= len G & 1 <= j & j < width G & 1 <= m & m <= len G & 1
<= n & n <= width G & p in cell(G,i,j) & p`1 = G*(m,n)`1 implies i = m or i = m
  -' 1;

theorem 
  1 <= i & i < len G & 1 <= m & m <= len G & 1 <= n & n <= width G
  & p in cell(G,i,width G) & p`2 = G*(m,n)`2 implies width G = n;

theorem 
  1 <= i & i < len G & 1 <= j & j <= width G & 1 <= m & m <= len G & 1
<= n & n <= width G & p in cell(G,i,j) & p`2 = G*(m,n)`2 implies j = n or j = n
  -' 1;

theorem 
  for C be Simple_closed_curve for i be Element of NAT st 1 < i &
  i < len Gauge(C,n) holds LSeg(Gauge(C,n)*(i,1),Gauge(C,n)*(i,len Gauge(C,n)))
  meets Upper_Arc C;

theorem 
  for C be Simple_closed_curve for i be Element of NAT st 1 < i &
  i < len Gauge(C,n) holds LSeg(Gauge(C,n)*(i,1),Gauge(C,n)*(i,len Gauge(C,n)))
  meets Lower_Arc C;

theorem 
  for C be Simple_closed_curve holds LSeg(Gauge(C,n)*(Center Gauge(C,n),
  1), Gauge(C,n)*(Center Gauge(C,n),len Gauge(C,n))) meets Upper_Arc C;

theorem 
  for C be Simple_closed_curve holds LSeg(Gauge(C,n)*(Center Gauge(C,n),
  1), Gauge(C,n)*(Center Gauge(C,n),len Gauge(C,n))) meets Lower_Arc C;

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for i be Element of NAT st 1 <= i & i <= len Gauge(C,n) holds LSeg(
  Gauge(C,n)*(i,1),Gauge(C,n)*(i,len Gauge(C,n))) meets Upper_Arc L~Cage(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for i be Element of NAT st 1 <= i & i <= len Gauge(C,n) holds LSeg(
  Gauge(C,n)*(i,1),Gauge(C,n)*(i,len Gauge(C,n))) meets Lower_Arc L~Cage(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
  TOP-REAL 2 holds LSeg(Gauge(C,n)*(Center Gauge(C,n),1), Gauge(C,n)*(Center
  Gauge(C,n),len Gauge(C,n))) meets Upper_Arc L~Cage(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
  TOP-REAL 2 holds LSeg(Gauge(C,n)*(Center Gauge(C,n),1), Gauge(C,n)*(Center
  Gauge(C,n),len Gauge(C,n))) meets Lower_Arc L~Cage(C,n);

theorem 
  j <= width G implies cell(G,0,j) is not bounded;

theorem 
  i <= width G implies cell(G,len G,i) is not bounded;

theorem 
  j <= width Gauge(C,n) implies cell(Gauge(C,n),0,j) c= UBD C;

theorem 
  j <= len Gauge(E,n) implies cell(Gauge(E,n),len Gauge(E,n),j) c= UBD E;

theorem 
  i <= len Gauge(C,n) & j <= width Gauge(C,n) & cell(Gauge(C,n),i,
  j) c= BDD C implies j > 1;

theorem 
  i <= len Gauge(C,n) & j <= width Gauge(C,n) & cell(Gauge(C,n),i,
  j) c= BDD C implies i > 1;

theorem 
  i <= len Gauge(C,n) & j <= width Gauge(C,n) & cell(Gauge(C,n),i,
  j) c= BDD C implies j+1 < width Gauge(C,n);

theorem 
  i <= len Gauge(C,n) & j <= width Gauge(C,n) & cell(Gauge(C,n),i,
  j) c= BDD C implies i+1 < len Gauge(C,n);

theorem 
  (ex i,j st i <= len Gauge(C,n) & j <= width Gauge(C,n) & cell(Gauge(C,
  n),i,j) c= BDD C) implies n >= 1;














begin





reserve FT for non empty RelStr;
reserve A for Subset of FT;

theorem 
  for FT being non empty RelStr, A,B being Subset of FT holds A c= B
  implies A^i c= B^i;

theorem 
  A^delta = (A^b) /\ ((A^i)`);

theorem 
  A^delta = A^b \ A^i;

theorem 
  A` is open implies A is closed;

theorem 
  A` is closed implies A is open;

definition
  let FT be non empty RelStr;
  let x be Element of FT;
  let y be Element of FT;
  let A be Subset of FT;
  func P_1(x,y,A) -> Element of BOOLEAN equals


  TRUE if y in U_FT x & y
  in A otherwise FALSE;
end;

definition
  let FT be non empty RelStr;
  let x be Element of FT;
  let y be Element of FT;
  let A be Subset of FT;
  func P_2(x,y,A) -> Element of BOOLEAN equals


  TRUE if y in U_FT x & y
  in A` otherwise FALSE;
end;

theorem 
  for x,y be Element of FT, A be Subset of FT holds P_1(x,y,A) = TRUE
  iff y in U_FT x & y in A;

theorem 
  for x,y be Element of FT, A be Subset of FT holds P_2(x,y,A) = TRUE
  iff y in U_FT x & y in A`;

theorem 
  for x be Element of FT, A be Subset of FT holds x in A^delta iff
  ex y1,y2 being Element of FT st P_1(x,y1,A)=TRUE & P_2(x,y2,A)=TRUE;

definition
  let FT be non empty RelStr;
  let x be Element of FT;
  let y be Element of FT;
  func P_0(x,y) -> Element of BOOLEAN equals


  TRUE if y in U_FT x
  otherwise FALSE;
end;

theorem 
  for x,y be Element of FT holds P_0(x,y)=TRUE iff y in U_FT x;

theorem 
  for x be Element of FT, A be Subset of FT holds x in A^i iff for y be
  Element of FT holds (P_0(x,y)=TRUE implies P_1(x,y,A)=TRUE);

theorem 
  for x be Element of FT, A be Subset of FT holds x in A^b iff ex y1
  being Element of FT st P_1(x,y1,A)=TRUE;

definition
  let FT be non empty RelStr;
  let x be Element of FT;
  let A be Subset of FT;
  func P_A(x,A) -> Element of BOOLEAN equals


  TRUE if x in A otherwise
  FALSE;
end;

theorem 
  for x be Element of FT, A be Subset of FT holds P_A(x,A)=TRUE iff x in
  A;

theorem 
  for x be Element of FT, A be Subset of FT holds x in A^deltai iff (ex
y1,y2 being Element of FT st P_1(x,y1,A)=TRUE & P_2(x,y2,A)=TRUE) & P_A(x,A) =
  TRUE;

theorem 
  for x be Element of FT, A be Subset of FT holds x in A^deltao iff (ex
y1,y2 being Element of FT st P_1(x,y1,A)=TRUE & P_2(x,y2,A)=TRUE) & P_A(x,A) =
  FALSE;

definition
  let FT be non empty RelStr;
  let x be Element of FT;
  let y be Element of FT;
  func P_e(x,y) -> Element of BOOLEAN equals


  TRUE if x = y otherwise
  FALSE;
end;

theorem 
  for x,y be Element of FT holds P_e(x,y)=TRUE iff x = y;

theorem 
  for x be Element of FT, A be Subset of FT holds x in A^s iff P_A(x,A)=
  TRUE & not(ex y being Element of FT st P_1(x,y,A)=TRUE & P_e(x,y)=FALSE );

theorem 
  for x be Element of FT, A be Subset of FT holds x in A^n iff P_A(x,A)=
  TRUE & ex y being Element of FT st P_1(x,y,A)=TRUE & P_e(x,y)=FALSE;

theorem 
  for x be Element of FT, A be Subset of FT holds x in A^f iff ex y
  being Element of FT st P_A(y,A)=TRUE & P_0(y,x)=TRUE;

begin





definition
  struct ( 1-sorted ) FMT_Space_Str (# carrier -> set, BNbd -> Function of the
    carrier, bool bool the carrier #);
end;

registration
  cluster non empty strict for FMT_Space_Str;
end;

reserve T for non empty TopStruct;
reserve FMT for non empty FMT_Space_Str;
reserve x, y for Element of FMT;

definition
  let FMT;
  let x be Element of FMT;
  func U_FMT x -> Subset-Family of FMT equals

  ( the BNbd of FMT ).x;
end;

definition
  let T;
  func NeighSp T -> non empty strict FMT_Space_Str means

  the carrier of it =
the carrier of T & for x being Point of it holds U_FMT x = {V where V is Subset
  of T: V in the topology of T & x in V};
end;

reserve A, B, W, V for Subset of FMT;

definition
  let IT be non empty FMT_Space_Str;
  attr IT is Fo_filled means


  for x being Element of IT for D being
  Subset of IT st D in U_FMT x holds x in D;
end;

definition
  let FMT;
  let A;
  func A^Fodelta -> Subset of FMT equals

  {x:for W st W in U_FMT x holds W
  meets A & W meets A`};
end;

theorem 
  x in A^Fodelta iff for W st W in U_FMT x holds W meets A & W meets A`;

definition
  let FMT,A;
  func A^Fob -> Subset of FMT equals

  {x:for W st W in U_FMT x holds W meets A};
end;

theorem 
  x in A^Fob iff for W st W in U_FMT x holds W meets A;

definition
  let FMT,A;
  func A^Foi -> Subset of FMT equals

  {x:ex V st V in U_FMT x & V c= A};
end;

theorem 
  x in A^Foi iff ex V st V in U_FMT x & V c= A;

definition
  let FMT,A;
  func A^Fos -> Subset of FMT equals

  {x:x in A & (ex V st V in U_FMT x & V \ {
  x} misses A)};
end;

theorem 
  x in A^Fos iff x in A & ex V st V in U_FMT x & V \ {x} misses A;

definition
  let FMT,A;
  func A^Fon -> Subset of FMT equals

  A\(A^Fos);
end;

theorem 
  x in A^Fon iff x in A & for V st V in U_FMT x holds (V \ {x}) meets A;

theorem 
  for FMT being non empty FMT_Space_Str, A, B being Subset of FMT
  holds A c= B implies A^Fob c= B^Fob;

theorem 
  for FMT being non empty FMT_Space_Str, A,B being Subset of FMT
  holds A c= B implies A^Foi c= B^Foi;

theorem 
  ((A^Fob) \/ (B^Fob)) c= (A \/ B)^Fob;

theorem 
  (A /\ B)^Fob c= (A^Fob) /\ (B^Fob);

theorem 
  ((A^Foi) \/ (B^Foi)) c= (A \/ B)^Foi;

theorem 
  (A /\ B)^Foi c= ((A^Foi) /\ (B^Foi));

theorem 
  for FMT being non empty FMT_Space_Str holds (for x being Element of
FMT, V1,V2 being Subset of FMT st ((V1 in U_FMT x) & (V2 in U_FMT x)) holds ex
  W being Subset of FMT st ((W in U_FMT x) & (W c= (V1 /\ V2)))) iff for A,B
  being Subset of FMT holds (A \/ B)^Fob = ((A^Fob) \/ (B^Fob));

theorem 
  for FMT being non empty FMT_Space_Str holds (for x being Element of
  FMT, V1,V2 being Subset of FMT st V1 in U_FMT x & V2 in U_FMT x holds ex W
being Subset of FMT st (W in U_FMT x & W c= V1 /\ V2)) iff for A,B being Subset
  of FMT holds (A^Foi) /\ (B^Foi) = (A /\ B)^Foi;

theorem 
  for FMT being non empty FMT_Space_Str, A,B being Subset of FMT holds (
for x being Element of FMT, V1,V2 being Subset of FMT st ((V1 in U_FMT x) & V2
in U_FMT x) holds ex W being Subset of FMT st ((W in U_FMT x) & (W c= (V1 /\ V2
  )))) implies (A \/ B)^Fodelta c= ((A^Fodelta) \/ (B^Fodelta));

theorem 
  for FMT being non empty FMT_Space_Str st FMT is Fo_filled holds (for A
  ,B being Subset of FMT holds (A \/ B)^Fodelta = ((A^Fodelta) \/ (B^Fodelta)))
implies for x being Element of FMT, V1,V2 being Subset of FMT st V1 in U_FMT x
& V2 in U_FMT x holds ex W being Subset of FMT st W in U_FMT x & W c= (V1 /\ V2
  );

theorem 
  for x be Element of FMT, A being Subset of FMT holds x in A^Fos iff x
  in A & not x in (A\{x})^Fob;

theorem 
  for FMT being non empty FMT_Space_Str holds FMT is Fo_filled iff
  for A being Subset of FMT holds A c= A^Fob;

theorem 
  for FMT being non empty FMT_Space_Str holds FMT is Fo_filled iff
  for A being Subset of FMT holds A^Foi c= A;

theorem 
  ((A`)^Fob)` =A^Foi;

theorem 
  ((A`)^Foi)` = A^Fob;

theorem 
  A^Fodelta = (A^Fob) /\ ((A`)^Fob);

theorem 
  A^Fodelta = (A^Fob) /\ (A^Foi)`;

theorem 
  A^Fodelta = (A`)^Fodelta;

theorem 
  A^Fodelta = A^Fob \ A^Foi;

definition
  let FMT;
  let A;
  func A^Fodel_i -> Subset of FMT equals

  A /\ (A^Fodelta);
  func A^Fodel_o -> Subset of FMT equals

  A` /\ (A^Fodelta);
end;

theorem 
  A^Fodelta = (A^Fodel_i) \/ (A^Fodel_o);

definition
  let FMT;
  let G be Subset of FMT;
  attr G is Fo_open means


  G = G^Foi;
  attr G is Fo_closed means


  G = G^Fob;
end;

theorem 
  A` is Fo_open implies A is Fo_closed;

theorem 
  A` is Fo_closed implies A is Fo_open;

theorem 
  for FMT being non empty FMT_Space_Str, A,B being Subset of FMT st FMT
is Fo_filled holds (for x being Element of FMT holds {x} in U_FMT x ) implies (
  A /\ B)^Fob = ((A^Fob) /\ (B^Fob));

theorem 
  for FMT being non empty FMT_Space_Str, A,B being Subset of FMT st FMT
is Fo_filled holds (for x being Element of FMT holds {x} in U_FMT x ) implies (
  A^Foi) \/ (B^Foi) = (A \/ B)^Foi;














begin

reserve C for Simple_closed_curve,
  i, j, n for Element of NAT,
  p for Point of TOP-REAL 2;

theorem 
  [i,j] in Indices Gauge(C,n) & [i+1,j] in Indices Gauge(C,n)
implies dist(Gauge(C,n)*(1,1),Gauge(C,n)*(2,1)) = Gauge(C,n)*(i+1,j)`1 - Gauge(
  C,n)*(i,j)`1;

theorem 
  [i,j] in Indices Gauge(C,n) & [i,j+1] in Indices Gauge(C,n)
implies dist(Gauge(C,n)*(1,1),Gauge(C,n)*(1,2)) = Gauge(C,n)*(i,j+1)`2 - Gauge(
  C,n)*(i,j)`2;

theorem 
  for S being Subset of TOP-REAL 2 st S is bounded
  holds proj1.:S is real-bounded;

theorem 
  for C1 being non empty compact Subset of TOP-REAL 2, C2, S being non
  empty Subset of TOP-REAL 2 holds S = C1 \/ C2 & proj1.:C2 is non empty
  bounded_below implies W-bound S = min(W-bound C1, W-bound C2);

theorem 
  for X being Subset of TOP-REAL 2 holds p in X & X is bounded
implies W-bound X <= p`1 & p`1 <= E-bound X & S-bound X <= p`2 & p`2 <= N-bound
  X;

theorem 
  for C being compact Subset of TOP-REAL 2 holds BDD C <> {}
  implies W-bound C <= W-bound BDD C;

theorem 
  for C being compact Subset of TOP-REAL 2 holds BDD C <> {}
  implies E-bound C >= E-bound BDD C;

theorem 
  for C being compact Subset of TOP-REAL 2 holds BDD C <> {}
  implies S-bound C <= S-bound BDD C;

theorem 
  for C being compact Subset of TOP-REAL 2 holds BDD C <> {}
  implies N-bound C >= N-bound BDD C;

theorem 
  for C being compact non vertical Subset of TOP-REAL 2 for I
being Integer st p in BDD C & I = [\ ((p`1 - W-bound C) / (E-bound C - W-bound
  C) * 2|^n) + 2 /] holds 1 < I;

theorem 
  for C being compact non vertical Subset of TOP-REAL 2 for I
being Integer st p in BDD C & I = [\ ((p`1 - W-bound C) / (E-bound C - W-bound
  C) * 2|^n) + 2 /] holds I + 1 <= len Gauge (C, n);

theorem 
  for C being compact non horizontal Subset of TOP-REAL 2 for J
being Integer st p in BDD C & J = [\ ((p`2 - S-bound C) / (N-bound C - S-bound
  C) * 2|^n) + 2 /] holds 1 < J & J+1 <= width Gauge (C, n);

theorem 
  for I being Integer st I = [\ ((p`1 - W-bound C) / (E-bound C -
W-bound C) * 2|^n) + 2 /] holds (W-bound C) + (((E-bound C)-(W-bound C))/(2|^n)
  )*(I-2) <= p`1;

theorem 
  for I being Integer st I = [\ ((p`1 - W-bound C) / (E-bound C -
W-bound C) * 2|^n) + 2 /] holds p`1 < (W-bound C) + (((E-bound C)-(W-bound C))/
  (2|^n))*(I-1);

theorem 
  for J being Integer st J = [\ ((p`2 - S-bound C) / (N-bound C -
S-bound C) * 2|^n) + 2 /] holds (S-bound C) + ((N-bound C - S-bound C)/(2|^n))*
  (J-2) <= p`2;

theorem 
  for J being Integer st J = [\ ((p`2 - S-bound C) / (N-bound C -
S-bound C) * 2|^n) + 2 /] holds p`2 < (S-bound C) + ((N-bound C - S-bound C)/(2
  |^n))*(J-1);

theorem 
  for C being closed Subset of TOP-REAL 2, p being Point of Euclid
  2 st p in BDD C ex r being Real st r > 0 & Ball(p,r) c= BDD C;

theorem 
  for p, q being Point of TOP-REAL 2, r being real number st dist(Gauge(
C,n)*(1,1),Gauge(C,n)*(1,2)) < r & dist(Gauge(C,n)*(1,1),Gauge(C,n)*(2,1)) < r
& p in cell (Gauge (C, n), i, j) & q in cell (Gauge (C, n), i, j) & 1 <= i & i+
1 <= len Gauge (C,n) & 1 <= j & j+1 <= width Gauge(C,n) holds dist (p,q) < 2 *
  r;

theorem 
  for C being compact Subset of TOP-REAL 2 holds p in BDD C implies p`2
  <> N-bound BDD C;

theorem 
  for C being compact Subset of TOP-REAL 2 holds p in BDD C implies p`1
  <> E-bound BDD C;

theorem 
  for C being compact Subset of TOP-REAL 2 holds p in BDD C implies p`2
  <> S-bound BDD C;

theorem 
  for C being compact Subset of TOP-REAL 2 holds p in BDD C
  implies p`1 <> W-bound BDD C;

theorem 
  p in BDD C implies ex n,i,j being Element of NAT st 1 < i & i < len
Gauge(C,n) & 1 < j & j < width Gauge(C,n) & p`1 <> (Gauge(C,n)*(i,j))`1 & p in
  cell(Gauge(C,n),i,j) & cell(Gauge(C,n),i,j) c= BDD C;

theorem 
  for C being Subset of TOP-REAL 2 st C is bounded holds UBD C is non
  empty;














begin

reserve D for non empty set,
  f for FinSequence of D,
  g for circular FinSequence of D,
  p,p1,p2,p3,q for Element of D;

theorem 
  q in rng(f|(p..f)) implies q..f <= p..f;

theorem 
  p in rng f & q in rng f & p..f <= q..f implies q..(f:-p) = q..f - p..f + 1;

theorem 
  p in rng f & q in rng f & p..f <= q..f implies p..(f-:q) = p..f;

theorem 
  p in rng f & q in rng f & p..f <= q..f implies q..Rotate(f,p) = q
  ..f - p..f + 1;

theorem 
  p1 in rng f & p2 in rng f & p3 in rng f & p1..f <= p2..f & p2..f
  < p3..f implies p2..Rotate(f,p1) < p3..Rotate(f,p1);

theorem 
  p1 in rng f & p2 in rng f & p3 in rng f & p1..f < p2..f & p2..f <= p3
  ..f implies p2..Rotate(f,p1) <= p3..Rotate(f,p1);

theorem 
  p in rng g & len g > 1 implies p..g < len g;

begin 

reserve f for non constant standard special_circular_sequence,
  p,p1,p2,p3,q for Point of TOP-REAL 2;

registration
  let f;
  cluster f/^1 -> one-to-one;
end;

theorem 
  1 < q..f & q in rng f implies (f/.1)..Rotate(f,q) = len f + 1 - q ..f;

theorem 
  p in rng f & q in rng f & p..f < q..f implies p..Rotate(f,q) =
  len f + p..f - q..f;

theorem 
  p1 in rng f & p2 in rng f & p3 in rng f & p1..f < p2..f & p2..f
  < p3..f implies p3..Rotate(f,p2) < p1..Rotate(f,p2);

theorem 
  p1 in rng f & p2 in rng f & p3 in rng f & p1..f < p2..f & p2..f
  < p3..f implies p1..Rotate(f,p3) < p2..Rotate(f,p3);

theorem 
  p1 in rng f & p2 in rng f & p3 in rng f & p1..f <= p2..f & p2..f < p3
  ..f implies p1..Rotate(f,p3) <= p2..Rotate(f,p3);

theorem 
  (S-min L~f)..f < len f;

theorem 
  (S-max L~f)..f < len f;

theorem 
  (E-min L~f)..f < len f;

theorem 
  (E-max L~f)..f < len f;

theorem 
  (N-min L~f)..f < len f;

theorem 
  (N-max L~f)..f < len f;

theorem 
  (W-max L~f)..f < len f;

theorem 
  (W-min L~f)..f < len f;

begin 

reserve z for clockwise_oriented non constant standard
  special_circular_sequence;

theorem 
  f/.1 = W-min L~f implies (W-min L~f)..f < (W-max L~f)..f;

theorem 
  f/.1 = W-min L~f implies (W-max L~f)..f > 1;

theorem 
  z/.1 = W-min L~z & W-max L~z <> N-min L~z implies (W-max L~z)..z
  < (N-min L~z)..z;

theorem 
  z/.1 = W-min L~z implies (N-min L~z)..z < (N-max L~z)..z;

theorem 
  z/.1 = W-min L~z & N-max L~z <> E-max L~z implies (N-max L~z)..z
  < (E-max L~z)..z;

theorem 
  z/.1 = W-min L~z implies (E-max L~z)..z < (E-min L~z)..z;

theorem 
  z/.1 = W-min L~z & E-min L~z <> S-max L~z implies (E-min L~z)..z
  < (S-max L~z)..z;

theorem 
  z/.1 = W-min L~z & S-min L~z <> W-min L~z implies (S-max L~z)..z < (
  S-min L~z)..z;

theorem 
  f/.1 = S-max L~f implies (S-max L~f)..f < (S-min L~f)..f;

theorem 
  f/.1 = S-max L~f implies (S-min L~f)..f > 1;

theorem 
  z/.1 = S-max L~z & S-min L~z <> W-min L~z implies (S-min L~z)..z
  < (W-min L~z)..z;

theorem 
  z/.1 = S-max L~z implies (W-min L~z)..z < (W-max L~z)..z;

theorem 
  z/.1 = S-max L~z & W-max L~z <> N-min L~z implies (W-max L~z)..z
  < (N-min L~z)..z;

theorem 
  z/.1 = S-max L~z implies (N-min L~z)..z < (N-max L~z)..z;

theorem 
  z/.1 = S-max L~z & N-max L~z <> E-max L~z implies (N-max L~z)..z
  < (E-max L~z)..z;

theorem 
  z/.1 = S-max L~z & E-min L~z <> S-max L~z implies (E-max L~z)..z < (
  E-min L~z)..z;

theorem 
  f/.1 = E-max L~f implies (E-max L~f)..f < (E-min L~f)..f;

theorem 
  f/.1 = E-max L~f implies (E-min L~f)..f > 1;

theorem 
  z/.1 = E-max L~z & S-max L~z <> E-min L~z implies (E-min L~z)..z
  < (S-max L~z)..z;

theorem 
  z/.1 = E-max L~z implies (S-max L~z)..z < (S-min L~z)..z;

theorem 
  z/.1 = E-max L~z & S-min L~z <> W-min L~z implies (S-min L~z)..z
  < (W-min L~z)..z;

theorem 
  z/.1 = E-max L~z implies (W-min L~z)..z < (W-max L~z)..z;

theorem 
  z/.1 = E-max L~z & W-max L~z <> N-min L~z implies (W-max L~z)..z
  < (N-min L~z)..z;

theorem 
  z/.1 = E-max L~z & N-max L~z <> E-max L~z implies (N-min L~z)..z < (
  N-max L~z)..z;

theorem 
  f/.1 = N-max L~f & N-max L~f <> E-max L~f implies (N-max L~f)..f < (
  E-max L~f)..f;

theorem 
  z/.1 = N-max L~z implies (E-max L~z)..z < (E-min L~z)..z;

theorem 
  z/.1 = N-max L~z & E-min L~z <> S-max L~z implies (E-min L~z)..z < (
  S-max L~z)..z;

theorem 
  z/.1 = N-max L~z implies (S-max L~z)..z < (S-min L~z)..z;

theorem 
  z/.1 = N-max L~z & S-min L~z <> W-min L~z implies (S-min L~z)..z < (
  W-min L~z)..z;

theorem 
  z/.1 = N-max L~z implies (W-min L~z)..z < (W-max L~z)..z;

theorem 
  z/.1 = N-max L~z & N-min L~z <> W-max L~z implies (W-max L~z)..z < (
  N-min L~z)..z;

theorem 
  f/.1 = E-min L~f & E-min L~f <> S-max L~f implies (E-min L~f)..f < (
  S-max L~f)..f;

theorem 
  z/.1 = E-min L~z implies (S-max L~z)..z < (S-min L~z)..z;

theorem 
  z/.1 = E-min L~z & S-min L~z <> W-min L~z implies (S-min L~z)..z < (
  W-min L~z)..z;

theorem 
  z/.1 = E-min L~z implies (W-min L~z)..z < (W-max L~z)..z;

theorem 
  z/.1 = E-min L~z & W-max L~z <> N-min L~z implies (W-max L~z)..z < (
  N-min L~z)..z;

theorem 
  z/.1 = E-min L~z implies (N-min L~z)..z < (N-max L~z)..z;

theorem 
  z/.1 = E-min L~z & E-max L~z <> N-max L~z implies (N-max L~z)..z < (
  E-max L~z)..z;

theorem 
  f/.1 = S-min L~f & S-min L~f <> W-min L~f implies (S-min L~f)..f < (
  W-min L~f)..f;

theorem 
  z/.1 = S-min L~z implies (W-min L~z)..z < (W-max L~z)..z;

theorem 
  z/.1 = S-min L~z & W-max L~z <> N-min L~z implies (W-max L~z)..z < (
  N-min L~z)..z;

theorem 
  z/.1 = S-min L~z implies (N-min L~z)..z < (N-max L~z)..z;

theorem 
  z/.1 = S-min L~z & N-max L~z <> E-max L~z implies (N-max L~z)..z < (
  E-max L~z)..z;

theorem 
  z/.1 = S-min L~z implies (E-max L~z)..z < (E-min L~z)..z;

theorem 
  z/.1 = S-min L~z & S-max L~z <> E-min L~z implies (E-min L~z)..z < (
  S-max L~z)..z;

theorem 
  f/.1 = W-max L~f & W-max L~f <> N-min L~f implies (W-max L~f)..f < (
  N-min L~f)..f;

theorem 
  z/.1 = W-max L~z implies (N-min L~z)..z < (N-max L~z)..z;

theorem 
  z/.1 = W-max L~z & N-max L~z <> E-max L~z implies (N-max L~z)..z < (
  E-max L~z)..z;

theorem 
  z/.1 = W-max L~z implies (E-max L~z)..z < (E-min L~z)..z;

theorem 
  z/.1 = W-max L~z & E-min L~z <> S-max L~z implies (E-min L~z)..z < (
  S-max L~z)..z;

theorem 
  z/.1 = W-max L~z implies (S-max L~z)..z < (S-min L~z)..z;

theorem 
  z/.1 = W-max L~z & W-min L~z <> S-min L~z implies (S-min L~z)..z < (
  W-min L~z)..z;














begin  

reserve a, b, i, k, m, n for Element of NAT,
  r for real number,
  D for non empty Subset of TOP-REAL 2,
  C for compact connected non vertical non horizontal Subset of TOP-REAL 2;

theorem 
  for A, B being set st for x being set st x in A ex K being set st
  K c= B & x c= union K holds union A c= union B;

registration
  let m be non empty Element of NAT;
  cluster 2|^m -> even;
end;

registration
  let n be even Element of NAT, m be non empty Element of NAT;
  cluster n|^m -> even;
end;

theorem 
  r <> 0 implies 1/r * r|^(i+1) = r|^i;

begin  

theorem 
  2 <= m & m < len Gauge(D,i) & 1 <= a & a <= len Gauge(D,i) & 1 <=
b & b <= len Gauge(D,i+1) implies Gauge(D,i)*(m,a)`1 = Gauge(D,i+1)*(2*m-'2,b)
  `1;

theorem 
  2 <= n & n < len Gauge(D,i) & 1 <= a & a <= len Gauge(D,i) & 1 <=
b & b <= len Gauge(D,i+1) implies Gauge(D,i)*(a,n)`2 = Gauge(D,i+1)*(b,2*n-'2)
  `2;

theorem 
  for D being compact non vertical non horizontal Subset of
TOP-REAL 2 holds 2 <= m & m+1 < len Gauge(D,i) & 2 <= n & n+1 < len Gauge(D,i)
implies cell(Gauge(D,i),m,n) = cell(Gauge(D,i+1),2*m-'2,2*n-'2) \/ cell(Gauge(D
,i+1),2*m-'1,2*n-'2) \/ cell(Gauge(D,i+1),2*m-'2,2*n-'1) \/ cell(Gauge(D,i+1),2
  *m-'1,2*n-'1);

theorem 
  for D being compact non vertical non horizontal Subset of TOP-REAL 2,
k being Element of NAT holds 2 <= m & m+1 < len Gauge(D,i) & 2 <= n & n+1 < len
Gauge(D,i) implies cell(Gauge(D,i),m,n) = union { cell(Gauge(D,i+k),a,b) where
a, b is Element of NAT: 2|^k*m - 2|^(k+1) + 2 <= a & a <= 2|^k*m - 2|^k + 1 & 2
  |^k*n - 2|^(k+1) + 2 <= b & b <= 2|^k*n - 2|^k + 1 };

theorem 
  ex i being Element of NAT st 1 <= i & i < len Cage(C,n) & N-max
  C in right_cell(Cage(C,n),i,Gauge(C,n));

theorem 
  ex i being Element of NAT st 1 <= i & i < len Cage(C,n) & N-max C in
  right_cell(Cage(C,n),i);

theorem 
  ex i being Element of NAT st 1 <= i & i < len Cage(C,n) & E-min
  C in right_cell(Cage(C,n),i,Gauge(C,n));

theorem 
  ex i being Element of NAT st 1 <= i & i < len Cage(C,n) & E-min C in
  right_cell(Cage(C,n),i);

theorem 
  ex i being Element of NAT st 1 <= i & i < len Cage(C,n) & E-max
  C in right_cell(Cage(C,n),i,Gauge(C,n));

theorem 
  ex i being Element of NAT st 1 <= i & i < len Cage(C,n) & E-max C in
  right_cell(Cage(C,n),i);

theorem 
  ex i being Element of NAT st 1 <= i & i < len Cage(C,n) & S-min
  C in right_cell(Cage(C,n),i,Gauge(C,n));

theorem 
  ex i being Element of NAT st 1 <= i & i < len Cage(C,n) & S-min C in
  right_cell(Cage(C,n),i);

theorem 
  ex i being Element of NAT st 1 <= i & i < len Cage(C,n) & S-max
  C in right_cell(Cage(C,n),i,Gauge(C,n));

theorem 
  ex i being Element of NAT st 1 <= i & i < len Cage(C,n) & S-max C in
  right_cell(Cage(C,n),i);

theorem 
  ex i being Element of NAT st 1 <= i & i < len Cage(C,n) & W-min
  C in right_cell(Cage(C,n),i,Gauge(C,n));

theorem 
  ex i being Element of NAT st 1 <= i & i < len Cage(C,n) & W-min C in
  right_cell(Cage(C,n),i);

theorem 
  ex i being Element of NAT st 1 <= i & i < len Cage(C,n) & W-max
  C in right_cell(Cage(C,n),i,Gauge(C,n));

theorem 
  ex i being Element of NAT st 1 <= i & i < len Cage(C,n) & W-max C in
  right_cell(Cage(C,n),i);

theorem 
  ex i being Element of NAT st 1 <= i & i <= len Gauge(C,n) &
  N-min L~Cage(C,n) = Gauge(C,n)*(i,width Gauge(C,n));

theorem 
  ex i being Element of NAT st 1 <= i & i <= len Gauge(C,n) & N-max L~
  Cage(C,n) = Gauge(C,n)*(i,width Gauge(C,n));

theorem 
  ex i being Element of NAT st 1 <= i & i <= len Gauge(C,n) & Gauge(C,n)
  *(i,width Gauge(C,n)) in rng Cage(C,n);

theorem 
  ex j being Element of NAT st 1 <= j & j <= width Gauge(C,n) &
  E-min L~Cage(C,n) = Gauge(C,n)*(len Gauge(C,n),j);

theorem 
  ex j being Element of NAT st 1 <= j & j <= width Gauge(C,n) & E-max L~
  Cage(C,n) = Gauge(C,n)*(len Gauge(C,n),j);

theorem 
  ex j being Element of NAT st 1 <= j & j <= width Gauge(C,n) & Gauge(C,
  n)*(len Gauge(C,n),j) in rng Cage(C,n);

theorem 
  ex i being Element of NAT st 1 <= i & i <= len Gauge(C,n) &
  S-min L~Cage(C,n) = Gauge(C,n)*(i,1);

theorem 
  ex i being Element of NAT st 1 <= i & i <= len Gauge(C,n) & S-max L~
  Cage(C,n) = Gauge(C,n)*(i,1);

theorem 
  ex i being Element of NAT st 1 <= i & i <= len Gauge(C,n) & Gauge(C,n)
  *(i,1) in rng Cage(C,n);

theorem 
  ex j being Element of NAT st 1 <= j & j <= width Gauge(C,n) &
  W-min L~Cage(C,n) = Gauge(C,n)*(1,j);

theorem 
  ex j being Element of NAT st 1 <= j & j <= width Gauge(C,n) & W-max L~
  Cage(C,n) = Gauge(C,n)*(1,j);

theorem 
  ex j being Element of NAT st 1 <= j & j <= width Gauge(C,n) & Gauge(C,
  n)*(1,j) in rng Cage(C,n);














begin 

registration
  cluster add-associative left_zeroed right_zeroed for non empty addLoopStr;
end;

registration
  cluster Abelian left_zeroed right_zeroed add-cancelable well-unital
    add-associative associative commutative distributive for non trivial
    doubleLoopStr;
end;

theorem 
  for V being add-associative left_zeroed right_zeroed non empty
  addLoopStr, v,u being Element of V holds Sum <* v,u *> = v + u;

begin 

definition
  let L be non empty addLoopStr, F being Subset of L;
  attr F is add-closed means


  for x, y being Element of L st x in F & y in F holds x+y in F;
end;

definition
  let L be non empty multMagma, F be Subset of L;
  attr F is left-ideal means


  for p, x being Element of L st x in F holds p*x in F;
  attr F is right-ideal means


  for p, x being Element of L st x in F holds x*p in F;
end;

registration
  let L be non empty addLoopStr;
  cluster add-closed for non empty Subset of L;
end;

registration
  let L be non empty multMagma;
  cluster left-ideal for non empty Subset of L;
  cluster right-ideal for non empty Subset of L;
end;

registration
  let L be non empty doubleLoopStr;
  cluster add-closed left-ideal right-ideal for non empty Subset of L;
  cluster add-closed right-ideal for non empty Subset of L;
  cluster add-closed left-ideal for non empty Subset of L;
end;

registration
  let R be commutative non empty multMagma;
  cluster left-ideal -> right-ideal for non empty Subset of R;
  cluster right-ideal -> left-ideal for non empty Subset of R;
end;

definition
  let L be non empty doubleLoopStr;
  mode Ideal of L is add-closed left-ideal right-ideal non empty Subset of L;
end;

definition
  let L be non empty doubleLoopStr;
  mode RightIdeal of L is add-closed right-ideal non empty Subset of L;
end;

definition
  let L be non empty doubleLoopStr;
  mode LeftIdeal of L is add-closed left-ideal non empty Subset of L;
end;

theorem 
  for R being right_zeroed left_add-cancelable left-distributive
non empty doubleLoopStr, I being left-ideal non empty Subset of R holds 0.R
  in I;

theorem 
  for R being left_zeroed right_add-cancelable right-distributive
non empty doubleLoopStr, I being right-ideal non empty Subset of R holds 0.R
  in I;

theorem 
  for L being right_zeroed non empty addLoopStr holds {0.L} is add-closed;

theorem 
  for L being left_zeroed right_add-cancelable right-distributive
  non empty doubleLoopStr holds {0.L} is left-ideal;

theorem 
  for L being right_zeroed left_add-cancelable left-distributive
  non empty doubleLoopStr holds {0.L} is right-ideal;

registration
  let L be right_zeroed non empty addLoopStr;
  cluster {0.L} -> add-closed for Subset of L;
end;

registration
  let L be left_zeroed right_add-cancelable right-distributive non empty
  doubleLoopStr;
  cluster {0.L} -> left-ideal for Subset of L;
end;

registration
  let L be right_zeroed left_add-cancelable left-distributive non empty
  doubleLoopStr;
  cluster {0.L} -> right-ideal for Subset of L;
end;

theorem 
  for L being add-associative right_zeroed right_complementable
  distributive non empty doubleLoopStr holds {0.L} is Ideal of L;

theorem 
  for L being add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr holds {0.L} is LeftIdeal of L;

theorem 
  for L being add-associative right_zeroed right_complementable
  left-distributive non empty doubleLoopStr holds {0.L} is RightIdeal of L;

theorem 
  for L being non empty doubleLoopStr holds the carrier of L is Ideal of L;

theorem 
  for L being non empty doubleLoopStr holds the carrier of L is LeftIdeal of L;

theorem 
  for L being non empty doubleLoopStr holds the carrier of L is RightIdeal of L
;

definition
  let R be left_zeroed right_zeroed add-cancelable distributive non empty
  doubleLoopStr, I be Ideal of R;
  redefine attr I is trivial means

  I = {0.R};
end;

registration
  let R be non trivial left_zeroed right_zeroed add-cancelable distributive
  non empty doubleLoopStr;
  cluster proper for Ideal of R;
end;

theorem 
  for L being add-associative right_zeroed right_complementable
  left-distributive left_unital non empty doubleLoopStr, I being left-ideal
  non empty Subset of L, x being Element of L st x in I holds -x in I;

theorem 
  for L being add-associative right_zeroed right_complementable
right-distributive right_unital non empty doubleLoopStr, I being right-ideal
  non empty Subset of L, x being Element of L st x in I holds -x in I;

theorem 
  for L being add-associative right_zeroed right_complementable
left-distributive left_unital non empty doubleLoopStr, I being LeftIdeal of L
  , x,y being Element of L st x in I & y in I holds x-y in I;

theorem 
  for L being add-associative right_zeroed right_complementable
  right-distributive right_unital non empty doubleLoopStr, I being RightIdeal
  of L, x,y being Element of L st x in I & y in I holds x-y in I;

theorem 
  for R being left_zeroed right_zeroed add-cancelable
  add-associative distributive non empty doubleLoopStr, I being add-closed
  right-ideal non empty Subset of R, a being Element of I, n being Element of
  NAT holds n*a in I;

theorem 
  for R being well-unital left_zeroed right_zeroed add-cancelable
  associative distributive non empty doubleLoopStr, I being right-ideal non
  empty Subset of R, a being Element of I, n being Element of NAT st n <> 0
  holds a|^n in I;

definition

  let R be non empty addLoopStr, I be add-closed non empty Subset of R;
  func add|(I,R) -> BinOp of I equals

  (the addF of R)||I;
end;

definition
  let R be non empty multMagma, I be right-ideal non empty Subset of R;
  func mult|(I,R) -> BinOp of I equals

  (the multF of R)||I;
end;

definition
  let R be non empty addLoopStr, I be add-closed non empty Subset of R;
  func Gr(I,R) -> non empty addLoopStr equals

  addLoopStr (#I,add|(I,R),In (0.R
    ,I)#);
end;

registration
  let R be left_zeroed right_zeroed add-cancelable add-associative
distributive non empty doubleLoopStr, I be add-closed non empty Subset of R
  ;
  cluster Gr(I,R) -> add-associative;
end;

registration
  let R be left_zeroed right_zeroed add-cancelable add-associative
distributive non empty doubleLoopStr, I be add-closed right-ideal non empty
  Subset of R;
  cluster Gr(I,R) -> right_zeroed;
end;

registration
  let R be Abelian non empty doubleLoopStr, I be add-closed non empty
  Subset of R;
  cluster Gr(I,R) -> Abelian;
end;

registration
  let R be Abelian right_unital left_zeroed right_zeroed right_complementable
  add-associative distributive non empty doubleLoopStr, I be add-closed
  right-ideal non empty Subset of R;
  cluster Gr(I,R) -> right_complementable;
end;

theorem 
  for R being right_unital non empty doubleLoopStr, I being
  left-ideal non empty Subset of R holds I is proper iff not(1.R in I);

theorem 
  for R being left_unital right_unital non empty doubleLoopStr, I
  being right-ideal non empty Subset of R holds I is proper iff for u being
  Element of R st u is unital holds not(u in I);

theorem 
  for R being right_unital non empty doubleLoopStr, I being left-ideal
  right-ideal non empty Subset of R holds I is proper iff for u being Element
  of R st u is unital holds not(u in I);

theorem 
  for R being non degenerated comRing holds R is Field iff for I being
  Ideal of R holds (I = {0.R} or I = the carrier of R);

begin  

definition
  let R be non empty multLoopStr, A be non empty Subset of R;
  mode LinearCombination of A -> FinSequence of the carrier of R means


for i being set st i in dom it ex u,v being Element of R, a being Element of A
    st it/.i = u*a*v;
  mode LeftLinearCombination of A -> FinSequence of the carrier of R means


     for
 i being set st i in dom it ex u being Element of R, a being Element
    of A st it/.i = u*a;
  mode RightLinearCombination of A -> FinSequence of the carrier of R means


     for
 i being set st i in dom it ex u being Element of R, a being Element
    of A st it/.i = a*u;
end;

registration
  let R be non empty multLoopStr, A be non empty Subset of R;
  cluster non empty for LinearCombination of A;
  cluster non empty for LeftLinearCombination of A;
  cluster non empty for RightLinearCombination of A;
end;

definition
  let R be non empty multLoopStr, A,B be non empty Subset of R, F be
  LinearCombination of A, G be LinearCombination of B;
  redefine func F^G -> LinearCombination of (A \/ B);
end;

theorem 
  for R be associative non empty multLoopStr, A be non empty
  Subset of R, a be Element of R, F be LinearCombination of A holds a*F is
  LinearCombination of A;

theorem 
  for R be associative non empty multLoopStr, A be non empty
  Subset of R, a be Element of R, F be LinearCombination of A holds F*a is
  LinearCombination of A;

theorem 
  for R being right_unital non empty multLoopStr, A being non
  empty Subset of R, f being LeftLinearCombination of A holds f is
  LinearCombination of A;

definition
  let R be non empty multLoopStr, A,B be non empty Subset of R, F be
  LeftLinearCombination of A, G be LeftLinearCombination of B;
  redefine func F^G -> LeftLinearCombination of (A \/ B);
end;

theorem 
  for R be associative non empty multLoopStr, A be non empty
  Subset of R, a be Element of R, F be LeftLinearCombination of A holds a*F is
  LeftLinearCombination of A;

theorem 
  for R be non empty multLoopStr, A be non empty Subset of R, a be
Element of R, F be LeftLinearCombination of A holds F*a is LinearCombination of
  A;

theorem 
  for R being left_unital non empty multLoopStr, A being non
  empty Subset of R, f being RightLinearCombination of A holds f is
  LinearCombination of A;

definition
  let R be non empty multLoopStr, A,B be non empty Subset of R, F be
  RightLinearCombination of A, G be RightLinearCombination of B;
  redefine func F^G -> RightLinearCombination of (A \/ B);
end;

theorem 
  for R be associative non empty multLoopStr, A be non empty
  Subset of R, a be Element of R, F be RightLinearCombination of A holds F*a is
  RightLinearCombination of A;

theorem 
  for R be associative non empty multLoopStr, A be non empty Subset of
  R, a be Element of R, F be RightLinearCombination of A holds a*F is
  LinearCombination of A;

theorem 
  for R being commutative associative non empty multLoopStr, A
  being non empty Subset of R, f being LinearCombination of A holds f is
  LeftLinearCombination of A & f is RightLinearCombination of A;

theorem 
  for S being non empty doubleLoopStr, F being non empty Subset of
S, lc being non empty LinearCombination of F ex p being LinearCombination of F,
  e being Element of S st lc = p^<* e *> & <*e*> is LinearCombination of F;

theorem 
  for S being non empty doubleLoopStr, F being non empty Subset of
  S, lc being non empty LeftLinearCombination of F ex p being
  LeftLinearCombination of F, e being Element of S st lc = p^<* e *> & <*e*> is
  LeftLinearCombination of F;

theorem 
  for S being non empty doubleLoopStr, F being non empty Subset of
  S, lc being non empty RightLinearCombination of F ex p being
RightLinearCombination of F, e being Element of S st lc = p^<* e *> & <*e*> is
  RightLinearCombination of F;

definition
  let R be non empty multLoopStr, A be non empty Subset of R, L be
LinearCombination of A, E be FinSequence of [:the carrier of R, the carrier of
  R, the carrier of R:];
  pred E represents L means


  len E = len L & for i being set st i in
  dom L holds L.i = ((E/.i)`1_3)*((E/.i)`2_3)*((E/.i)`3_3) & ((E/.i)`2_3) in A;
end;

theorem 
  for R being non empty multLoopStr, A being non empty Subset of R, L be
  LinearCombination of A ex E be FinSequence of [:the carrier of R, the carrier
  of R, the carrier of R:] st E represents L;

theorem 
  for R, S being non empty multLoopStr, F being non empty Subset of R,
  lc being LinearCombination of F, G being non empty Subset of S, P being
  Function of the carrier of R, the carrier of S, E being FinSequence of [:the
carrier of R, the carrier of R, the carrier of R:] st P.:F c= G & E represents
  lc holds ex LC being LinearCombination of G st len lc = len LC & for i being
  set st i in dom LC
   holds LC.i = (P.((E/.i)`1_3))*(P.((E/.i)`2_3))*(P.((E/.i)`3_3));

definition
  let R be non empty multLoopStr, A be non empty Subset of R, L be
LeftLinearCombination of A, E be FinSequence of [:the carrier of R, the carrier
  of R:];
  pred E represents L means


  len E = len L & for i being set st i in
  dom L holds L.i = ((E/.i)`1)*((E/.i)`2) & ((E/.i)`2) in A;
end;

theorem 
  for R being non empty multLoopStr, A being non empty Subset of R, L be
  LeftLinearCombination of A ex E be FinSequence of [:the carrier of R, the
  carrier of R:] st E represents L;

theorem 
  for R, S being non empty multLoopStr, F being non empty Subset of R,
  lc being LeftLinearCombination of F, G being non empty Subset of S, P being
  Function of the carrier of R, the carrier of S, E being FinSequence of [:the
  carrier of R, the carrier of R:] st P.:F c= G & E represents lc holds ex LC
  being LeftLinearCombination of G st len lc = len LC & for i being set st i in
  dom LC holds LC.i = (P.(E/.i)`1)*(P.(E/.i)`2);

definition
  let R be non empty multLoopStr, A be non empty Subset of R, L be
  RightLinearCombination of A, E be FinSequence of [:the carrier of R, the
  carrier of R:];
  pred E represents L means


  len E = len L & for i being set st i in
  dom L holds L.i = ((E/.i)`1)*((E/.i)`2) & ((E/.i)`1) in A;
end;

theorem 
  for R being non empty multLoopStr, A being non empty Subset of R, L be
  RightLinearCombination of A ex E be FinSequence of [:the carrier of R, the
  carrier of R:] st E represents L;

theorem 
  for R, S being non empty multLoopStr, F being non empty Subset of R,
  lc being RightLinearCombination of F, G being non empty Subset of S, P being
  Function of the carrier of R, the carrier of S, E being FinSequence of [:the
  carrier of R, the carrier of R:] st P.:F c= G & E represents lc holds ex LC
being RightLinearCombination of G st len lc = len LC & for i being set st i in
  dom LC holds LC.i = (P.(E/.i)`1)*(P.(E/.i)`2);

theorem 
  for R being non empty multLoopStr, A being non empty Subset of R, l
  being LinearCombination of A, n being Element of NAT holds l|Seg n is
  LinearCombination of A;

theorem 
  for R being non empty multLoopStr, A being non empty Subset of R, l
  being LeftLinearCombination of A, n being Element of NAT holds l|Seg n is
  LeftLinearCombination of A;

theorem 
  for R being non empty multLoopStr, A being non empty Subset of R, l
  being RightLinearCombination of A, n being Element of NAT holds l|Seg n is
  RightLinearCombination of A;

begin 

definition
  let L be non empty doubleLoopStr, F be Subset of L;
  assume
 F is non empty;
  func F-Ideal -> Ideal of L means


  F c= it & for I being Ideal of L st F c= I holds it c= I;
  func F-LeftIdeal -> LeftIdeal of L means


  F c= it & for I being LeftIdeal of L st F c= I holds it c= I;
  func F-RightIdeal -> RightIdeal of L means


  F c= it & for I being RightIdeal of L st F c= I holds it c= I;
end;

theorem 
  for L being non empty doubleLoopStr, I being Ideal of L holds I -Ideal = I;

theorem 
  for L being non empty doubleLoopStr, I being LeftIdeal of L
  holds I-LeftIdeal = I;

theorem 
  for L being non empty doubleLoopStr, I being RightIdeal of L
  holds I-RightIdeal = I;

definition
  let L be non empty doubleLoopStr, I be Ideal of L;
  mode Basis of I -> non empty Subset of L means

    it-Ideal = I;
end;

theorem 
  for L being add-associative right_zeroed right_complementable
  distributive non empty doubleLoopStr holds {0.L}-Ideal = {0.L};

theorem 
  for L being left_zeroed right_zeroed add-cancelable distributive non
  empty doubleLoopStr holds {0.L}-Ideal = {0.L};

theorem 
  for L being left_zeroed right_zeroed right_add-cancelable
  right-distributive non empty doubleLoopStr holds {0.L}-LeftIdeal = {0.L};

theorem 
  for L being right_zeroed left_add-cancelable left-distributive non
  empty doubleLoopStr holds {0.L}-RightIdeal = {0.L};

theorem 
  for L being well-unital non empty doubleLoopStr holds {1.L}-Ideal =
  the carrier of L;

theorem 
  for L being right_unital non empty doubleLoopStr holds {1.L}
  -LeftIdeal = the carrier of L;

theorem 
  for L being left_unital non empty doubleLoopStr holds {1.L}
  -RightIdeal = the carrier of L;

theorem 
  for L being non empty doubleLoopStr holds ([#] L)-Ideal = the carrier of L;

theorem 
  for L being non empty doubleLoopStr holds ([#] L)-LeftIdeal = the
  carrier of L;

theorem 
  for L being non empty doubleLoopStr holds ([#] L)-RightIdeal = the
  carrier of L;

theorem 
  for L being non empty doubleLoopStr, A, B being non empty Subset
  of L st A c= B holds A-Ideal c= B-Ideal;

theorem 
  for L being non empty doubleLoopStr, A, B being non empty Subset of L
  st A c= B holds A-LeftIdeal c= B-LeftIdeal;

theorem 
  for L being non empty doubleLoopStr, A, B being non empty Subset of L
  st A c= B holds A-RightIdeal c= B-RightIdeal;

theorem 
  for L being add-associative left_zeroed right_zeroed
add-cancelable associative distributive well-unital non empty doubleLoopStr,
  F being non empty Subset of L, x being set holds x in F-Ideal iff ex f being
  LinearCombination of F st x = Sum f;

theorem 
  for L being add-associative left_zeroed right_zeroed
add-cancelable associative distributive well-unital non empty doubleLoopStr,
  F being non empty Subset of L, x being set holds x in F-LeftIdeal iff ex f
  being LeftLinearCombination of F st x = Sum f;

theorem 
  for L being add-associative left_zeroed right_zeroed
add-cancelable associative distributive well-unital non empty doubleLoopStr,
  F being non empty Subset of L, x being set holds x in F-RightIdeal iff ex f
  being RightLinearCombination of F st x = Sum f;

theorem 
  for R being add-associative left_zeroed right_zeroed
  add-cancelable well-unital associative commutative distributive non empty
  doubleLoopStr, F being non empty Subset of R holds F-Ideal = F-LeftIdeal & F
  -Ideal = F-RightIdeal;

theorem 
  for R being add-associative left_zeroed right_zeroed
  add-cancelable well-unital associative commutative distributive non empty
doubleLoopStr, a being Element of R holds {a}-Ideal = {a*r where r is Element
  of R : not contradiction};

theorem 
  for R being Abelian left_zeroed right_zeroed add-cancelable
  well-unital add-associative associative commutative distributive non empty
doubleLoopStr, a,b being Element of R holds {a,b}-Ideal = {a*r + b*s where r,s
  is Element of R : not contradiction};

theorem 
  for R being non empty doubleLoopStr, a being Element of R holds
  a in {a}-Ideal;

theorem 
  for R being Abelian left_zeroed right_zeroed right_complementable
  add-associative associative commutative distributive well-unital non empty
doubleLoopStr, A being non empty Subset of R, a being Element of R holds a in
  A-Ideal implies {a}-Ideal c= A-Ideal;

theorem 
  for R being non empty doubleLoopStr, a,b being Element of R holds a in
  {a,b}-Ideal & b in {a,b}-Ideal;

theorem 
  for R being non empty doubleLoopStr, a,b being Element of R holds {a}
  -Ideal c= {a,b}-Ideal & {b}-Ideal c= {a,b}-Ideal;

begin 

definition
  let R be non empty multMagma, I be Subset of R, a be Element of R;
  func a*I -> Subset of R equals

  {a*i where i is Element of R : i in I};
end;

registration
  let R be non empty multLoopStr, I be non empty Subset of R, a be Element of
  R;
  cluster a*I -> non empty;
end;

registration
  let R be distributive non empty doubleLoopStr, I be add-closed Subset of R
  , a be Element of R;
  cluster a*I -> add-closed;
end;

registration
  let R be associative non empty doubleLoopStr, I be right-ideal Subset of R
  , a be Element of R;
  cluster a*I -> right-ideal;
end;

theorem 
  for R being right_zeroed left_add-cancelable left-distributive
  non empty doubleLoopStr, I being non empty Subset of R holds 0.R*I = {0.R};

theorem 
  for R being left_unital non empty doubleLoopStr, I being Subset of R
  holds 1.R*I = I;

definition
  let R be non empty addLoopStr, I,J be Subset of R;
  func I + J -> Subset of R equals

  {a + b where a,b is Element of R : a in I &
  b in J};
end;

registration
  let R be non empty addLoopStr, I,J be non empty Subset of R;
  cluster I + J -> non empty;
end;

definition
  let R be Abelian non empty addLoopStr, I,J be Subset of R;
  redefine func I + J;
  commutativity;
end;

registration
  let R be Abelian add-associative non empty addLoopStr, I,J be add-closed
  Subset of R;
  cluster I + J -> add-closed;
end;

registration
  let R be left-distributive non empty doubleLoopStr, I,J be right-ideal
  Subset of R;
  cluster I + J -> right-ideal;
end;

registration
  let R be right-distributive non empty doubleLoopStr, I,J be left-ideal
  Subset of R;
  cluster I + J -> left-ideal;
end;

theorem 
  for R being add-associative non empty addLoopStr, I,J,K being Subset
  of R holds I + (J + K) = (I + J) + K;

theorem 
  for R being left_zeroed right_zeroed right_add-cancelable
right-distributive non empty doubleLoopStr, I,J being right-ideal non empty
  Subset of R holds I c= I + J;

theorem 
  for R being left_zeroed right_add-cancelable right-distributive
non empty doubleLoopStr, I,J being right-ideal non empty Subset of R holds
  J c= I + J;

theorem 
  for R being non empty addLoopStr, I,J being Subset of R, K being
  add-closed Subset of R st I c= K & J c= K holds I + J c= K;

theorem 
  for R being Abelian left_zeroed right_zeroed add-cancelable
  well-unital add-associative associative commutative distributive non empty
  doubleLoopStr, a,b being Element of R holds {a,b}-Ideal = {a}-Ideal + {b}
  -Ideal;

definition
  let R be non empty 1-sorted, I,J be Subset of R;
  redefine func I /\ J -> Subset of R equals

  { x where x is Element of R : x
  in I & x in J };
end;

registration
  let R be right_zeroed left_add-cancelable left-distributive non empty
  doubleLoopStr, I,J be left-ideal non empty Subset of R;
  cluster I /\ J -> non empty;
end;

registration
  let R be non empty addLoopStr, I,J be add-closed Subset of R;
  cluster I /\ J -> add-closed for Subset of R;
end;

registration
  let R be non empty multLoopStr, I,J be left-ideal Subset of R;
  cluster I /\ J -> left-ideal for Subset of R;
end;

registration
  let R be non empty multLoopStr, I,J be right-ideal Subset of R;
  cluster I /\ J -> right-ideal for Subset of R;
end;

theorem 
  for R being Abelian left_zeroed right_zeroed right_complementable
  left_unital add-associative left-distributive non empty doubleLoopStr, I
  being add-closed left-ideal non empty Subset of R, J being Subset of R, K
  being non empty Subset of R st J c= I holds I /\ (J + K) = J + (I /\ K);

definition
  let R be non empty doubleLoopStr, I,J be Subset of R;
  func I *' J -> Subset of R equals

  { Sum s where s is FinSequence of the
  carrier of R : for i being Element of NAT st 1 <= i & i <= len s ex a,b being
  Element of R st s.i = a*b & a in I & b in J};
end;

registration
  let R be non empty doubleLoopStr, I,J be Subset of R;
  cluster I *' J -> non empty;
end;

definition
  let R be commutative non empty doubleLoopStr, I,J be Subset of R;
  redefine func I *' J;
  commutativity;
end;

registration
  let R be right_zeroed add-associative non empty doubleLoopStr, I,J be
  Subset of R;
  cluster I *' J -> add-closed;
end;

registration
  let R be right_zeroed left_add-cancelable associative left-distributive non
  empty doubleLoopStr, I,J be right-ideal Subset of R;
  cluster I *' J -> right-ideal;
end;

registration
  let R be left_zeroed right_add-cancelable associative right-distributive
  non empty doubleLoopStr, I,J be left-ideal Subset of R;
  cluster I *' J -> left-ideal;
end;

theorem 
  for R being left_zeroed right_zeroed left_add-cancelable
  left-distributive non empty doubleLoopStr, I being non empty Subset of R
  holds {0.R} *' I = {0.R};

theorem 
  for R being left_zeroed right_zeroed add-cancelable distributive
non empty doubleLoopStr, I being add-closed right-ideal non empty Subset of
R, J being add-closed left-ideal non empty Subset of R holds I *' J c= I /\
  J;

theorem 
  for R being Abelian left_zeroed right_zeroed add-cancelable
add-associative associative distributive non empty doubleLoopStr, I,J,K being
  right-ideal non empty Subset of R holds I *' (J + K) = (I *' J) + (I *' K);

theorem 
  for R being Abelian left_zeroed right_zeroed add-cancelable
add-associative commutative associative distributive non empty doubleLoopStr,
I,J being right-ideal non empty Subset of R holds (I + J) *' (I /\ J) c= I *'
  J;

theorem 
  for R being right_zeroed left_add-cancelable left-distributive non
  empty doubleLoopStr, I,J being add-closed left-ideal non empty Subset of R
  holds (I + J) *' (I /\ J) c= I /\ J;

definition
  let R be non empty addLoopStr, I,J be Subset of R;
  pred I,J are_co-prime means


  I + J = the carrier of R;
end;

theorem 
  for R being left_zeroed left_unital non empty doubleLoopStr, I
,J being non empty Subset of R st I,J are_co-prime holds I /\ J c= (I + J) *' (
  I /\ J);

theorem 
  for R being Abelian left_zeroed right_zeroed add-cancelable
  add-associative left_unital commutative associative distributive non empty
doubleLoopStr, I being add-closed left-ideal right-ideal non empty Subset of
  R, J being add-closed left-ideal non empty Subset of R st I,J are_co-prime
  holds I *' J = I /\ J;

definition
  let R be non empty multMagma, I,J be Subset of R;
  func I % J -> Subset of R equals

  {a where a is Element of R: a*J c= I};
end;

registration
  let R be right_zeroed left_add-cancelable left-distributive non empty
  doubleLoopStr, I,J be left-ideal non empty Subset of R;
  cluster I % J -> non empty;
end;

registration
  let R be right_zeroed left_add-cancelable left-distributive non empty
  doubleLoopStr, I,J be add-closed left-ideal non empty Subset of R;
  cluster I % J -> add-closed;
end;

registration
  let R be right_zeroed left_add-cancelable left-distributive associative
commutative non empty doubleLoopStr, I,J be left-ideal non empty Subset of R
  ;
  cluster I % J -> left-ideal;
  cluster I % J -> right-ideal;
end;

theorem 
  for R being non empty multLoopStr, I being right-ideal non empty
  Subset of R, J being Subset of R holds I c= I % J;

theorem 
  for R being right_zeroed left_add-cancelable left-distributive non
empty doubleLoopStr, I being add-closed left-ideal non empty Subset of R, J
  being Subset of R holds (I % J) *' J c= I;

theorem 
  for R being left_zeroed right_add-cancelable right-distributive
non empty doubleLoopStr, I being add-closed right-ideal non empty Subset of
  R, J being Subset of R holds (I % J) *' J c= I;

theorem 
  for R being left_zeroed right_add-cancelable right-distributive
  commutative associative non empty doubleLoopStr, I being add-closed
right-ideal non empty Subset of R, J,K being Subset of R holds (I % J) % K =
  I % (J *' K);

theorem 
  for R being non empty multLoopStr, I,J,K being Subset of R holds (J /\
  K) % I = (J % I) /\ (K % I);

theorem 
  for R being left_zeroed right_zeroed right_add-cancelable
right-distributive non empty doubleLoopStr, I being add-closed Subset of R, J
,K being right-ideal non empty Subset of R holds I % (J + K) = (I % J) /\ (I
  % K);

definition
  let R be well-unital non empty doubleLoopStr, I be Subset of R;
  func sqrt I -> Subset of R equals

  {a where a is Element of R: ex n being
  Element of NAT st a|^n in I};
end;

registration
  let R be well-unital non empty doubleLoopStr, I be non empty Subset of R;
  cluster sqrt I -> non empty;
end;

registration
  let R be Abelian add-associative left_zeroed right_zeroed commutative
associative add-cancelable distributive well-unital non empty doubleLoopStr,
  I be add-closed right-ideal non empty Subset of R;
  cluster sqrt I -> add-closed;
end;

registration
  let R be well-unital commutative associative non empty doubleLoopStr, I be
  left-ideal non empty Subset of R;
  cluster sqrt I -> left-ideal;
  cluster sqrt I -> right-ideal;
end;

theorem 
  for R being well-unital associative non empty doubleLoopStr, I being
  non empty Subset of R, a being Element of R holds a in sqrt I iff ex n being
  Element of NAT st a|^n in sqrt I;

theorem 
  for R being left_zeroed right_zeroed add-cancelable distributive
  well-unital associative non empty doubleLoopStr, I being add-closed
  right-ideal non empty Subset of R, J being add-closed left-ideal non empty
  Subset of R holds sqrt (I *' J) = sqrt (I /\ J);

begin 

definition
  let L be non empty doubleLoopStr, I be Ideal of L;
  attr I is finitely_generated means


  ex F being non empty finite Subset of L st I = F-Ideal;
end;

registration
  let L be non empty doubleLoopStr;
  cluster finitely_generated for Ideal of L;
end;

registration
  let L be non empty doubleLoopStr, F be non empty finite Subset of L;
  cluster F-Ideal -> finitely_generated;
end;

definition
  let L be non empty doubleLoopStr;
  attr L is Noetherian means


  for I being Ideal of L holds I is finitely_generated;
end;

registration
  cluster Euclidian Abelian add-associative right_zeroed right_complementable
    well-unital distributive commutative associative non degenerated for
non empty
    doubleLoopStr;
end;

definition
  let L be non empty doubleLoopStr;
  let I be Ideal of L;
  attr I is principal means


  ex e being Element of L st I = {e}-Ideal;
end;

definition
  let L be non empty doubleLoopStr;
  attr L is PID means


  for I being Ideal of L holds I is principal;
end;

theorem 
  for L being non empty doubleLoopStr, F being non empty Subset of
  L st F <> {0.L} ex x being Element of L st x <> 0.L & x in F;

theorem 
  for R being add-associative left_zeroed right_zeroed
  right_complementable distributive well-unital Euclidian non empty
  doubleLoopStr holds R is PID;

theorem 
  for L being non empty doubleLoopStr st L is PID holds L is Noetherian;

registration
  cluster INT.Ring -> Noetherian;
end;

registration
  cluster Noetherian Abelian add-associative right_zeroed right_complementable
    well-unital distributive commutative associative non degenerated for
non empty
    doubleLoopStr;
end;

theorem 
  for R being Noetherian add-associative left_zeroed right_zeroed
  add-cancelable associative distributive well-unital non empty doubleLoopStr
for B being non empty Subset of R ex C being non empty finite Subset of R st C
  c= B & C-Ideal = B-Ideal;

theorem 
  for R being non empty doubleLoopStr st for B being non empty Subset
of R ex C being non empty finite Subset of R st C c= B & C-Ideal = B-Ideal for
  a being sequence of R ex m being Element of NAT st a.(m+1) in (rng (a|(m+1)))
  -Ideal;

registration
  let X, Y be non empty set, f be Function of X, Y, A be non empty Subset of X;
  cluster f|A -> non empty;
end;

theorem 
  for R being non empty doubleLoopStr st for a being sequence of R ex
m being Element of NAT st a.(m+1) in (rng (a|(m+1)))-Ideal holds not ex F being
Function of NAT, bool (the carrier of R) st (for i being Element of NAT holds F
  .i is Ideal of R) & (for j,k being Element of NAT st j < k holds F.j c< F.k);

theorem 
  for R being non empty doubleLoopStr st not ex F being Function of
NAT, bool (the carrier of R) st (for i being Element of NAT holds F.i is Ideal
  of R) & (for j,k being Element of NAT st j < k holds F.j c< F.k) holds R is
  Noetherian;














begin 

theorem 
  for A,B being FinSequence, f being Function st rng A \/ rng B c=
  dom f ex fA, fB being FinSequence st fA = f*A & fB = f*B & f*(A^B) = fA^fB;

theorem 
  for b being bag of 0 holds decomp b = <* <* {}, {} *> *>;

theorem 
  for i,j being Element of NAT, b being bag of j st i <= j holds (b
  |i) is Element of Bags i;

theorem 
  for i, j being set, b1, b2 being bag of j, b19,b29 being bag of i
  st b19 = (b1|i) & b29 = (b2|i) & b1 divides b2 holds b19 divides b29;

theorem 
  for i,j be set, b1, b2 being bag of j, b19, b29 being bag of i st
  b19=(b1|i) & b29=(b2|i) holds (b1-' b2)|i = b19-' b29 & (b1+b2)|i = b19+b29;

definition
  let n,k be Nat, b be bag of n;
  func b bag_extend k -> Element of Bags (n+1) means


  it|n = b & it.n = k;
end;

theorem 
  for n being Element of NAT holds EmptyBag (n+1) = (EmptyBag n) bag_extend 0;

theorem 
  for n be Ordinal, b, b1 be bag of n holds b1 in rng divisors b
  iff b1 divides b;

definition
  let X be set, x be Element of X;
  func UnitBag x -> Element of Bags X equals

  (EmptyBag X)+*(x, 1);
end;

theorem 
  for X being non empty set, x being Element of X holds support UnitBag x = {x}
;

theorem 
  for X being non empty set, x being Element of X holds (UnitBag x)
  .x = 1 & for y being Element of X st x <> y holds (UnitBag x).y = 0;

theorem 
  for X being non empty set, x1, x2 being Element of X st UnitBag
  x1 = UnitBag x2 holds x1 = x2;

theorem 
  for X being non empty Ordinal, x be Element of X, L being
  well-unital non trivial doubleLoopStr, e being Function of X, L
  holds eval(UnitBag x, e) = e.x;

definition
  let X be set, x be Element of X, L be unital non empty multLoopStr_0;
  func 1_1(x,L) -> Series of X, L equals

  0_(X,L)+*(UnitBag x,1_L);
end;

theorem 
  for X being set, L being unital non trivial
doubleLoopStr, x be Element of X holds 1_1(x,L).UnitBag x = 1_L & for b being
  bag of X st b <> UnitBag x holds 1_1(x,L).b = 0.L;

theorem 
  for X being set, x being Element of X, L being add-associative
right_zeroed right_complementable well-unital right-distributive
  non trivial doubleLoopStr holds Support 1_1(x,L) = {UnitBag x};

registration
  let X be Ordinal, x be Element of X, L be add-associative right_zeroed
  right_complementable well-unital right-distributive non trivial
  doubleLoopStr;
  cluster 1_1(x,L) -> finite-Support;
end;

theorem 
  for L being add-associative right_zeroed right_complementable
  well-unital right-distributive non trivial doubleLoopStr, X being
non empty set, x1, x2 being Element of X st 1_1(x1,L) = 1_1(x2,L) holds x1 = x2
;

theorem 
  for L being add-associative right_zeroed right_complementable
distributive non empty doubleLoopStr, x being Element of Polynom-Ring L, p be
  sequence of L st x = p holds -x = -p;

theorem 
  for L being add-associative right_zeroed right_complementable
distributive non empty doubleLoopStr, x, y being Element of Polynom-Ring L, p
  , q be sequence of L st x = p & y = q holds x-y = p-q;

definition
  let L be right_zeroed add-associative right_complementable well-unital
  distributive non empty doubleLoopStr;
  let I be non empty Subset of Polynom-Ring L;
  func minlen(I) -> non empty Subset of I equals

  { x where x is Element of I :
  for x9,y9 being Polynomial of L st x9=x & y9 in I holds len x9 <= len y9 };
end;

theorem 
  for L be right_zeroed add-associative right_complementable
  well-unital distributive non empty doubleLoopStr, I be non empty Subset of
Polynom-Ring L, i1, i2 be Polynomial of L st i1 in minlen(I) & i2 in I holds i1
  in I & len i1 <= len i2;

definition
  let L be right_zeroed add-associative right_complementable well-unital
  distributive non empty doubleLoopStr, n be Nat, a be Element of L;
  func monomial(a,n) -> Polynomial of L means


  for x being Nat holds (x = n implies it.x = a) & (x <> n implies it.x = 0.L);
end;

theorem 
  for L be right_zeroed add-associative right_complementable
  well-unital distributive non empty doubleLoopStr, n be Element of NAT, a be
  Element of L holds (a <> 0.L implies len monomial(a,n) = n+1) & (a = 0.L
  implies len monomial(a,n) = 0) & len monomial (a,n) <= n+1;

theorem 
  for L be right_zeroed add-associative right_complementable
  well-unital distributive non empty doubleLoopStr, n, x be Element of NAT, a
be Element of L, p be Polynomial of L holds (monomial(a,n)*'p).(x+n) = a * (p.x
  );

theorem 
  for L be right_zeroed add-associative right_complementable
  well-unital distributive non empty doubleLoopStr, n, x be Element of NAT, a
be Element of L, p be Polynomial of L holds (p*'monomial(a,n)).(x+n) = (p.x) *
  a;

theorem 
  for L be right_zeroed add-associative right_complementable
  well-unital distributive non empty doubleLoopStr, p, q be Polynomial of L
  holds len (p*'q) <= (len p)+(len q)-'1;

begin 

theorem 
  for R,S being non empty doubleLoopStr, I being Ideal of R, P
  being Function of R,S st P is RingIsomorphism holds P.:I is Ideal of S;

theorem 
  for R,S being add-associative right_zeroed right_complementable
  non empty doubleLoopStr, f being Function of R, S st f is RingHomomorphism
  holds f.(0.R) = 0.S;

theorem 
  for R, S being add-associative right_zeroed right_complementable
  non empty doubleLoopStr, F being non empty Subset of R, G being non empty
  Subset of S, P being Function of R, S, lc being LinearCombination of F, LC
  being LinearCombination of G, E being FinSequence of [:the carrier of R, the
carrier of R, the carrier of R:] st P is RingHomomorphism & len lc = len LC & E
represents lc & (for i being set st i in dom LC
   holds LC.i = (P.((E/.i)`1_3))*(P.((E /.i)`2_3))*(P.((E/.i)`3_3)))
   holds P.(Sum lc) = Sum LC;

theorem 
  for R, S be non empty doubleLoopStr, P be Function of R, S st P
  is RingIsomorphism holds P" is RingIsomorphism;

theorem 
  for R,S being Abelian add-associative right_zeroed
  right_complementable associative distributive well-unital non empty
doubleLoopStr, F being non empty Subset of R, P being Function of R,S st P is
  RingIsomorphism holds P.:(F-Ideal) = (P.:F)-Ideal;

theorem 
  for R,S being Abelian add-associative right_zeroed
  right_complementable associative distributive well-unital non empty
  doubleLoopStr, P being Function of R,S st P is RingIsomorphism & R is
  Noetherian holds S is Noetherian;

theorem 
  for R being add-associative right_zeroed right_complementable
  associative Abelian distributive well-unital non trivial
  doubleLoopStr holds ex P being Function of R, Polynom-Ring (0,R) st P is
  RingIsomorphism;

theorem 
  for R being right_zeroed add-associative right_complementable
well-unital distributive non trivial doubleLoopStr, n being Element
  of NAT, b being bag of n, p1 being Polynomial of n, R, F being FinSequence of
  the carrier of Polynom-Ring (n,R) st p1 = Sum F ex g being Function of the
carrier of Polynom-Ring (n, R), the carrier of R st (for p being Polynomial of
  n, R holds g.p = p.b) & p1.b = Sum (g*F);

definition
  let R be Abelian add-associative right_zeroed right_complementable
  associative distributive well-unital commutative non trivial
  doubleLoopStr, n be Element of NAT;
  func upm (n,R) -> Function of Polynom-Ring (Polynom-Ring(n,R)), Polynom-Ring
  (n+1,R) means


  for p1 being (Polynomial of Polynom-Ring (n,R)), p2 being
(Polynomial of n, R), p3 being (Polynomial of (n+1), R), b being bag of n+1 st
  p3 = it.p1 & p2 = p1.(b.n) holds p3.b = p2.(b|n);
end;

registration
  let R be Abelian add-associative right_zeroed right_complementable
  associative distributive well-unital commutative non trivial
  doubleLoopStr, n be Element of NAT;
  cluster upm (n,R) -> additive;
  cluster upm (n,R) -> multiplicative;
  cluster upm (n,R) -> unity-preserving;
  cluster upm (n,R) -> one-to-one;
end;

definition
  let R be Abelian add-associative right_zeroed right_complementable
  associative distributive well-unital commutative non trivial
  doubleLoopStr, n be Element of NAT;
  func mpu (n,R) -> Function of Polynom-Ring (n+1,R), Polynom-Ring
  Polynom-Ring(n,R) means


  for p1 being (Polynomial of n+1,R), p2 being (
  Polynomial of n, R), p3 being (Polynomial of Polynom-Ring (n, R)), i being
  Element of NAT, b being bag of n st p3 = it.p1 & p2 = p3.i holds p2.b = p1.(b
  bag_extend i);
end;

theorem 
  for R being Abelian add-associative right_zeroed
  right_complementable associative distributive well-unital commutative non
  trivial non empty doubleLoopStr, n being Element of NAT, p being Element of
  Polynom-Ring (n+1,R) holds upm(n,R).(mpu(n,R).p) = p;

theorem 
  for R being Abelian add-associative right_zeroed
  right_complementable associative distributive well-unital commutative non
  trivial non empty doubleLoopStr, n being Element of NAT ex P being Function
of Polynom-Ring (Polynom-Ring(n,R)),Polynom-Ring(n+1,R) st P is RingIsomorphism
;

begin 

registration
  let R be Noetherian Abelian add-associative right_zeroed
  right_complementable associative distributive well-unital commutative non
  empty doubleLoopStr;

  cluster Polynom-Ring R -> Noetherian;
end;

theorem 
  for R being Abelian add-associative right_zeroed
  right_complementable associative distributive well-unital
commutative non trivial doubleLoopStr st R is Noetherian
  for n being Element of
  NAT holds Polynom-Ring (n,R) is Noetherian;

theorem 
  for F being Field holds F is Noetherian;

theorem 
  for F being Field, n being Element of NAT holds Polynom-Ring (n,F) is
  Noetherian;

theorem 
  for R being Abelian right_zeroed add-associative right_complementable
  well-unital distributive associative commutative non trivial
  doubleLoopStr, X be infinite Ordinal holds Polynom-Ring (X,R) is non
  Noetherian;














begin 

definition
  let F be 1-sorted;
  struct (doubleLoopStr,VectSpStr over F) AlgebraStr over F
  (# carrier -> set,
 addF, multF -> BinOp of the carrier,
 ZeroF, OneF -> Element of the carrier,
       lmult -> Function of [:the carrier of F,the carrier:], the carrier #);
end;

registration
  let L be non empty doubleLoopStr;
  cluster strict non empty for AlgebraStr over L;
end;

definition
  let L be non empty doubleLoopStr, A be non empty AlgebraStr over L;
  attr A is mix-associative means

  for a being Element of L, x,y being Element of A holds a*(x*y) = (a*x)*y;
end;

registration
  let L be non empty doubleLoopStr;
  cluster unital distributive vector-distributive scalar-distributive
  scalar-associative scalar-unital mix-associative for non empty
    AlgebraStr over L;
end;

definition
  let L be non empty doubleLoopStr;
  mode Algebra of L is unital distributive vector-distributive
  scalar-distributive scalar-associative scalar-unital mix-associative
    non empty AlgebraStr over L;
end;

theorem 
  for X,Y being set for f being Function of [:X,Y:],X holds dom f = [:X,Y:];

theorem 
  for X,Y being set for f being Function of [:X,Y:],Y holds dom f = [:X,Y:];

begin 

definition
  let L be non empty doubleLoopStr;
  func Formal-Series L -> strict non empty AlgebraStr over L means


  (for x be set holds x in the carrier of it iff x is sequence of L) &
  (for x,y be Element of it, p,q be sequence of L st x = p & y = q holds
    x+y = p+q) &
  (for x,y be Element of it, p,q be sequence of L st x = p & y = q holds
    x*y = p*'q) &
  (for a be Element of L, x be Element of it, p be sequence of L st x = p
    holds a*x = a*p) & 0.it = 0_.L & 1.it = 1_.L;
end;

registration
  let L be Abelian non empty doubleLoopStr;
  cluster Formal-Series L -> Abelian;
end;

registration
  let L be add-associative non empty doubleLoopStr;
  cluster Formal-Series L -> add-associative;
end;

registration
  let L be right_zeroed non empty doubleLoopStr;
  cluster Formal-Series L -> right_zeroed;
end;

registration
  let L be add-associative right_zeroed right_complementable non empty
  doubleLoopStr;
  cluster Formal-Series L -> right_complementable;
end;

registration
  let L be Abelian add-associative right_zeroed commutative non empty
  doubleLoopStr;
  cluster Formal-Series L -> commutative;
end;

registration
  let L be Abelian add-associative right_zeroed right_complementable
  well-unital associative distributive non empty doubleLoopStr;
  cluster Formal-Series L -> associative;
end;

registration
  cluster add-associative associative right_zeroed left_zeroed well-unital
    right_complementable distributive for non empty doubleLoopStr;
end;

theorem 
  for D be non empty set for f being non empty FinSequence of D
  holds f/^1 = Del(f,1);

theorem 
  for D be non empty set for f being non empty FinSequence of D
  holds f = <*f.1*>^Del(f,1);

theorem 
  for L be add-associative right_zeroed well-unital
  right_complementable left-distributive non empty doubleLoopStr for p be
  sequence of L holds (1_.(L))*'p = p;

registration
  let L be right_zeroed add-associative right_complementable distributive
  well-unital non empty doubleLoopStr;
  cluster Formal-Series L -> well-unital;
end;

registration
  let L be Abelian add-associative right_zeroed right_complementable
  distributive non empty doubleLoopStr;
  cluster Formal-Series L -> right-distributive;
  cluster Formal-Series L -> left-distributive;
end;

theorem 
  for L be Abelian add-associative right_zeroed
right_complementable distributive non empty doubleLoopStr for a being Element
  of L, p,q being sequence of L holds a*(p+q)=a*p + a*q;

theorem 
  for L be Abelian add-associative right_zeroed
  right_complementable distributive non empty doubleLoopStr for a,b being
  Element of L, p being sequence of L holds (a+b)*p = a*p + b*p;

theorem 
  for L be associative non empty doubleLoopStr
  for a,b being Element of L, p being sequence of L holds (a*b)*p = a*(b*p);

theorem 
  for L be associative well-unital non empty doubleLoopStr for p
  being sequence of L holds 1.L*p = p;

registration
  let L be Abelian add-associative associative right_zeroed
  right_complementable well-unital distributive non empty doubleLoopStr;
  cluster Formal-Series L -> vector-distributive scalar-distributive
    scalar-associative scalar-unital;
end;

theorem 
  for L be Abelian left_zeroed add-associative associative
right_zeroed right_complementable distributive non empty doubleLoopStr for a
  being Element of L, p,q being sequence of L holds a*(p*'q)=(a*p)*'q;

registration
  let L be Abelian left_zeroed add-associative associative right_zeroed
  right_complementable distributive non empty doubleLoopStr;
  cluster Formal-Series L -> mix-associative;
end;

definition
  let L be 1-sorted;
  let A be AlgebraStr over L;
  mode Subalgebra of A -> AlgebraStr over L means

    the carrier of it c= the carrier of A &
    1.it = 1.A & 0.it = 0.A &
    the addF of it = (the addF of A)||the carrier of it &
    the multF of it = (the multF of A)||the carrier of it &
    the lmult of it =
      (the lmult of A)|[:the carrier of L,the carrier of it:];
end;

theorem 
  for L being 1-sorted for A being AlgebraStr over L holds A is Subalgebra of A
;

theorem 
  for L being 1-sorted for A,B,C being AlgebraStr over L st
  A is Subalgebra of B & B is Subalgebra of C holds A is Subalgebra of C;

theorem 
  for L being 1-sorted for A,B being AlgebraStr over L st
  A is Subalgebra of B & B is Subalgebra of A holds
  the AlgebraStr of A = the AlgebraStr of B;

theorem 
  for L being 1-sorted for A,B being AlgebraStr over L st
  the AlgebraStr of A = the AlgebraStr of B holds A is Subalgebra of B;

registration
  let L be non empty 1-sorted;
  cluster non empty strict for AlgebraStr over L;
end;

registration
  let L be 1-sorted;
  let B be AlgebraStr over L;
  cluster strict for Subalgebra of B;
end;

registration
  let L be non empty 1-sorted;
  let B be non empty AlgebraStr over L;
  cluster strict non empty for Subalgebra of B;
end;

definition
  let L be non empty multMagma;
  let B be non empty AlgebraStr over L;
  let A be Subset of B;
  attr A is opers_closed means


  A is linearly-closed & (for x,y being
  Element of B st x in A & y in A holds x*y in A) & 1.B in A & 0.B in A;
end;

theorem 
  for L being non empty multMagma for B being non empty AlgebraStr
over L for A being non empty Subalgebra of B holds for x,y being Element of B,
  x9,y9 being Element of A st x = x9 & y = y9 holds x+y = x9+ y9;

theorem 
  for L be non empty multMagma for B be non empty AlgebraStr over
  L for A be non empty Subalgebra of B holds for x,y being Element of B, x9,y9
  being Element of A st x = x9 & y = y9 holds x*y = x9* y9;

theorem 
  for L be non empty multMagma for B be non empty AlgebraStr over
L for A be non empty Subalgebra of B holds for a being Element of L for x being
  Element of B, x9 being Element of A st x = x9 holds a * x = a * x9;

theorem 
  for L be non empty multMagma for B be non empty AlgebraStr over L for
A be non empty Subalgebra of B ex C being Subset of B st the carrier of A = C &
  C is opers_closed;

theorem 
  for L be non empty multMagma for B be non empty AlgebraStr over
  L for A be Subset of B st A is opers_closed ex C being strict Subalgebra of B
  st the carrier of C = A;

theorem 
  for L being non empty multMagma for B being non empty AlgebraStr
over L for A being non empty Subset of B for X being Subset-Family of B st (for
Y be set holds Y in X iff Y c= the carrier of B & ex C being Subalgebra of B st
  Y = the carrier of C & A c= Y) holds meet X is opers_closed;

definition
  let L be non empty multMagma;
  let B be non empty AlgebraStr over L;
  let A be non empty Subset of B;
  func GenAlg A -> strict non empty Subalgebra of B means


  A c= the
carrier of it & for C being Subalgebra of B st A c= the carrier of C holds the
  carrier of it c= the carrier of C;
end;

theorem 
  for L be non empty multMagma for B be non empty AlgebraStr over
  L for A be non empty Subset of B st A is opers_closed holds the carrier of
  GenAlg A = A;

begin 

definition
  let L be add-associative right_zeroed right_complementable distributive non
  empty doubleLoopStr;
  func Polynom-Algebra L -> strict non empty AlgebraStr over L means


  ex
A being non empty Subset of Formal-Series L st A = the carrier of Polynom-Ring
  L & it = GenAlg A;
end;

registration
  let L be add-associative right_zeroed right_complementable distributive non
  empty doubleLoopStr;
  cluster Polynom-Ring L -> Loop-like;
end;

theorem 
  for L being add-associative right_zeroed right_complementable
  distributive non empty doubleLoopStr for A being non empty Subset of
  Formal-Series L st A = the carrier of Polynom-Ring L holds A is opers_closed;

theorem 
  for L be add-associative right_zeroed right_complementable
  distributive non empty doubleLoopStr holds the doubleLoopStr of
  Polynom-Algebra L = Polynom-Ring L;

theorem 
  for L being add-associative right_zeroed right_complementable
  well-unital distributive non empty doubleLoopStr holds 1_Formal-Series L =
  1_.L;














begin 

theorem 
  for S being non empty non void ManySortedSign
  for A being non-empty MSAlgebra over S for V being Variables of A
  for t being Term of S,V, T being c-Term of A,V st T = t
  holds the_sort_of T = the_sort_of t;

definition
  let S be non empty non void ManySortedSign;
  let V be non-empty ManySortedSet of the carrier of S;
  let X be non empty Subset of S-Terms V;
  func X-CircuitStr -> non empty strict ManySortedSign equals

  ManySortedSign(#
    Subtrees X, [:the carrier' of S,{the carrier of S}:]-Subtrees X,
    [:the carrier' of S,{the carrier of S}:]-ImmediateSubtrees X,
    incl([:the carrier' of S,{the carrier of S}:]-Subtrees X) #);
end;

registration
  let S be non empty non void ManySortedSign;
  let V be non-empty ManySortedSet of the carrier of S;
  let X be non empty Subset of S-Terms V;
  cluster X-CircuitStr -> unsplit;
end;

reserve S for non empty non void ManySortedSign,
  V for non-empty ManySortedSet of the carrier of S,
  A for non-empty MSAlgebra over S,
  X for non empty Subset of S-Terms V,
  t for Element of X;

theorem 
  X-CircuitStr is void iff for t being Element of X holds t is root &
  not t.{} in [:the carrier' of S, {the carrier of S}:];

theorem 
  X is SetWithCompoundTerm of S,V iff X-CircuitStr is non void;

registration
  let S be non empty non void ManySortedSign;
  let V be non-empty ManySortedSet of the carrier of S;
  let X be SetWithCompoundTerm of S,V;
  cluster X-CircuitStr -> non void;
end;

theorem 
  (for v being Vertex of X-CircuitStr holds v is Term of S,V) &
  for s being set st s in the carrier' of X-CircuitStr holds
  s is CompoundTerm of S,V;

theorem 
  for t being Vertex of X-CircuitStr holds
  t in the carrier' of X-CircuitStr iff t is CompoundTerm of S,V;

registration
  let S,V;
  let X be SetWithCompoundTerm of S,V, g be Gate of X-CircuitStr;
  cluster the_arity_of g -> DTree-yielding;
end;

registration
  let S be non empty non void ManySortedSign;
  let V be non-empty ManySortedSet of the carrier of S;
  let X be non empty Subset of S-Terms V;
  cluster -> finite Function-like Relation-like for Vertex of X-CircuitStr;
end;

registration
  let S be non empty non void ManySortedSign;
  let V be non-empty ManySortedSet of the carrier of S;
  let X be non empty Subset of S-Terms V;
  cluster -> DecoratedTree-like for Vertex of X-CircuitStr;
end;

registration
  let S be non empty non void ManySortedSign;
  let V be non-empty ManySortedSet of the carrier of S;
  let X be SetWithCompoundTerm of S,V;
  cluster -> finite Function-like Relation-like for Gate of X-CircuitStr;
end;

registration
  let S be non empty non void ManySortedSign;
  let V be non-empty ManySortedSet of the carrier of S;
  let X be SetWithCompoundTerm of S,V;
  cluster -> DecoratedTree-like for Gate of X-CircuitStr;
end;






theorem 
  for X1,X2 being non empty Subset of S-Terms V holds
  the Arity of X1-CircuitStr tolerates the Arity of X2-CircuitStr &
  the ResultSort of X1-CircuitStr tolerates the ResultSort of X2-CircuitStr;

registration
  let X,Y be constituted-DTrees set;
  cluster X \/ Y -> constituted-DTrees;
end;

theorem 
  for X1,X2 being constituted-DTrees non empty set holds
  Subtrees (X1 \/ X2) = (Subtrees X1) \/ (Subtrees X2);

theorem 
  for X1,X2 being constituted-DTrees non empty set, C be set holds
  C-Subtrees (X1 \/ X2) = (C-Subtrees X1) \/ (C-Subtrees X2);

theorem 
  for X1,X2 being constituted-DTrees non empty set st
  (for t being Element of X1 holds t is finite) &
  (for t being Element of X2 holds t is finite) for C be set holds
  C-ImmediateSubtrees (X1 \/ X2)
  = (C-ImmediateSubtrees X1)+*(C-ImmediateSubtrees X2);

theorem 
  for X1,X2 being non empty Subset of S-Terms V holds
  (X1 \/ X2)-CircuitStr = (X1-CircuitStr)+*(X2-CircuitStr);

theorem 
  for x being set holds x in InputVertices (X-CircuitStr) iff x in Subtrees X &
  ex s being SortSymbol of S, v being Element of V.s st x = root-tree [v,s];

theorem 
  for X being SetWithCompoundTerm of S,V, g being Gate of X-CircuitStr
  holds g = (g.{})-tree the_arity_of g;

begin  

definition
  let S be non empty non void ManySortedSign;
  let V be non-empty ManySortedSet of the carrier of S;
  let X be non empty Subset of S-Terms V;
  let v be Vertex of X-CircuitStr;
  let A be MSAlgebra over S;
  func the_sort_of (v, A) means


  for u being Term of S,V st u = v holds it = (the Sorts of A).the_sort_of u;
end;

registration
  let S be non empty non void ManySortedSign;
  let V be non-empty ManySortedSet of the carrier of S;
  let X be non empty Subset of S-Terms V;
  let v be Vertex of X-CircuitStr;
  let A be non-empty MSAlgebra over S;
  cluster the_sort_of (v, A) -> non empty;
end;

definition
  let S be non empty non void ManySortedSign;
  let V be non-empty ManySortedSet of the carrier of S;
  let X be non empty Subset of S-Terms V;
  assume
 X is SetWithCompoundTerm of S,V;
  let o be Gate of X-CircuitStr;
  let A be MSAlgebra over S;
  func the_action_of (o, A) -> Function means


   for X9 being SetWithCompoundTerm of S,V st X9 = X
  for o9 being Gate of X9-CircuitStr st o9 = o holds
  it = (the Charact of A).(o9.{})`1;
end;

scheme 
 MSFuncEx {I() -> non empty set, A,B() -> non-empty ManySortedSet of I(),
  P[set,set,set]}: ex f being ManySortedFunction of A(),B() st
  for i being Element of I(), a being Element of A().i holds P[i,a,f.i.a]
provided
 for i being Element of I(), a being Element of A().i
ex b being Element of B().i st P[i,a,b];

definition
  let S be non empty non void ManySortedSign;
  let V be non-empty ManySortedSet of the carrier of S;
  let X be non empty Subset of S-Terms V;
  let A be MSAlgebra over S;
  func X-CircuitSorts A -> ManySortedSet of the carrier of X-CircuitStr means


  for v being Vertex of X-CircuitStr holds it.v = the_sort_of (v, A);
end;

registration
  let S be non empty non void ManySortedSign;
  let V be non-empty ManySortedSet of the carrier of S;
  let X be non empty Subset of S-Terms V;
  let A be non-empty MSAlgebra over S;
  cluster X-CircuitSorts A -> non-empty;
end;

theorem 
  for X being SetWithCompoundTerm of S,V, g being Gate of X-CircuitStr
  for o being OperSymbol of S st g.{} = [o,the carrier of S] holds
  (X-CircuitSorts A)*the_arity_of g = (the Sorts of A)*the_arity_of o;

definition
  let S be non empty non void ManySortedSign;
  let V be non-empty ManySortedSet of the carrier of S;
  let X be non empty Subset of S-Terms V;
  let A be non-empty MSAlgebra over S;
  func X-CircuitCharact A -> ManySortedFunction of
  (X-CircuitSorts A)#*(the Arity of X-CircuitStr),
  (X-CircuitSorts A)*(the ResultSort of X-CircuitStr) means


  for g being Gate of X-CircuitStr st g in the carrier' of X-CircuitStr
  holds it.g = the_action_of (g, A);
end;

definition
  let S be non empty non void ManySortedSign;
  let V be non-empty ManySortedSet of the carrier of S;
  let X be non empty Subset of S-Terms V;
  let A be non-empty MSAlgebra over S;
  func X-Circuit A -> non-empty strict MSAlgebra over X-CircuitStr equals

  MSAlgebra(#X-CircuitSorts A, X-CircuitCharact A#);
end;

theorem 
  for v being Vertex of X-CircuitStr
  holds (the Sorts of X-Circuit A).v = the_sort_of (v, A);

theorem 
  for A being finite-yielding non-empty MSAlgebra over S
  for X being SetWithCompoundTerm of S,V
  for g being OperSymbol of X-CircuitStr
  holds Den(g, X-Circuit A) = the_action_of (g, A);

theorem 
  for A being finite-yielding non-empty MSAlgebra over S
  for X being SetWithCompoundTerm of S,V
  for g being OperSymbol of X-CircuitStr, o being OperSymbol of S
  st g.{} = [o, the carrier of S] holds Den(g, X-Circuit A) = Den(o,A);

theorem 
  for A being finite-yielding non-empty MSAlgebra over S,
  X being non empty Subset of S-Terms V holds X-Circuit A is finite-yielding;

registration
  let S be non empty non void ManySortedSign;
  let V be non-empty ManySortedSet of the carrier of S;
  let X be SetWithCompoundTerm of S,V;
  let A be finite-yielding non-empty MSAlgebra over S;
  cluster X-Circuit A -> finite-yielding;
end;

theorem 
  for S being non empty non void ManySortedSign
  for V being non-empty ManySortedSet of the carrier of S
  for X1,X2 being SetWithCompoundTerm of S,V
  for A being non-empty MSAlgebra over S holds
  X1-Circuit A tolerates X2-Circuit A;

theorem 
  for S being non empty non void ManySortedSign
  for V being non-empty ManySortedSet of the carrier of S
  for X1,X2 being SetWithCompoundTerm of S,V
  for A being non-empty MSAlgebra over S holds
  (X1 \/ X2)-Circuit A = (X1-Circuit A)+*(X2-Circuit A);

begin 

reserve S for non empty non void ManySortedSign,
  A for non-empty finite-yielding MSAlgebra over S,
  V for Variables of A,
  X for SetWithCompoundTerm of S,V;

definition
  let S be non empty non void ManySortedSign;
  let A be non-empty MSAlgebra over S;
  let V be Variables of A;
  let t be DecoratedTree such that
 t is Term of S,V;
  let f be ManySortedFunction of V, the Sorts of A;
  func t@(f,A) means


  ex t9 being c-Term of A,V st t9 = t & it = t9@f;
end;

definition
  let S be non empty non void ManySortedSign;
  let V be non-empty ManySortedSet of the carrier of S;
  let X be SetWithCompoundTerm of S,V;
  let A be non-empty finite-yielding MSAlgebra over S;
  let s be State of X-Circuit A;
  mode CompatibleValuation of s -> ManySortedFunction of V, the Sorts of A
    means


    for x being Vertex of S, v being Element of V.x
    st root-tree [v,x] in Subtrees X holds it.x.v = s.root-tree [v,x];
end;

theorem 
  for s being State of X-Circuit A
  for f being CompatibleValuation of s, n being Element of NAT
  holds f is CompatibleValuation of Following(s,n);

registration
  let x be set;
  let S be non empty non void ManySortedSign;
  let V be non-empty ManySortedSet of the carrier of S;
  let p be FinSequence of S-Terms V;
  cluster x-tree p -> finite;
end;

theorem 
  for s being State of X-Circuit A for f being CompatibleValuation of s
  for t being Term of S,V st t in Subtrees X holds
  Following(s, 1+height dom t) is_stable_at t &
  Following(s, 1+height dom t).t = t@(f,A);

theorem 
  not (ex t being Term of S,V, o being OperSymbol of S st
  t in Subtrees X & t.{} = [o,the carrier of S] & the_arity_of o = {}) implies
  for s being State of X-Circuit A for f being CompatibleValuation of s
  for t being Term of S,V st t in Subtrees X holds
  Following(s, height dom t) is_stable_at t &
  Following(s, height dom t).t = t@(f, A);

begin 

definition
  let S1, S2 be non empty ManySortedSign;
  let f,g be Function;
  pred S1, S2 are_equivalent_wrt f, g means


   f is one-to-one & g is one-to-one &
  f, g form_morphism_between S1, S2 & f", g" form_morphism_between S2, S1;
end;

theorem 
  for S1, S2 being non empty ManySortedSign, f,g being Function
  st S1, S2 are_equivalent_wrt f, g
  holds the carrier of S2 = f.:the carrier of S1 &
  the carrier' of S2 = g.:the carrier' of S1;

theorem 
  for S1, S2 being non empty ManySortedSign, f,g being Function
  st S1, S2 are_equivalent_wrt f, g
  holds rng f = the carrier of S2 & rng g = the carrier' of S2;

theorem 
  for S being non empty ManySortedSign holds
  S, S are_equivalent_wrt id the carrier of S, id the carrier' of S;

theorem 
  for S1, S2 being non empty ManySortedSign, f,g being Function
  st S1, S2 are_equivalent_wrt f, g holds S2, S1 are_equivalent_wrt f", g";

theorem 
  for S1, S2, S3 being non empty ManySortedSign, f1,g1, f2,g2 being Function
  st S1, S2 are_equivalent_wrt f1, g1 & S2, S3 are_equivalent_wrt f2, g2
  holds S1, S3 are_equivalent_wrt f2*f1, g2*g1;

theorem 
  for S1, S2 being non empty ManySortedSign, f,g being Function
  st S1, S2 are_equivalent_wrt f, g holds
  f.:InputVertices S1 = InputVertices S2 &
  f.:InnerVertices S1 = InnerVertices S2;

definition
  let S1, S2 be non empty ManySortedSign;
  pred S1, S2 are_equivalent means

  ex f,g being one-to-one Function st S1, S2 are_equivalent_wrt f, g;
  reflexivity;
  symmetry;
end;

theorem 
  for S1, S2, S3 being non empty ManySortedSign
  st S1, S2 are_equivalent & S2, S3 are_equivalent holds S1, S3 are_equivalent;

definition
  let S1, S2 be non empty ManySortedSign;
  let f be Function;
  pred f preserves_inputs_of S1, S2 means

  f.:InputVertices S1 c= InputVertices S2;
end;

theorem 
  for S1, S2 being non empty ManySortedSign
  for f, g being Function st f, g form_morphism_between S1, S2
  for v being Vertex of S1 holds f.v is Vertex of S2;

theorem 
  for S1, S2 being non empty non void ManySortedSign
  for f, g being Function st f, g form_morphism_between S1, S2
  for v being Gate of S1 holds g.v is Gate of S2;

theorem 
  for S1, S2 being non empty ManySortedSign
  for f, g being Function st f, g form_morphism_between S1, S2
  holds f.:InnerVertices S1 c= InnerVertices S2;

theorem 
  for S1, S2 being Circuit-like non void non empty ManySortedSign
  for f, g being Function st f, g form_morphism_between S1, S2
  for v1 being Vertex of S1 st v1 in InnerVertices S1
  for v2 being Vertex of S2 st v2 = f.v1 holds action_at v2 = g.action_at v1;

definition
  let S1, S2 be non empty ManySortedSign;
  let f,g be Function;
  let C1 be non-empty MSAlgebra over S1;
  let C2 be non-empty MSAlgebra over S2;
  pred f, g form_embedding_of C1, C2 means


  f is one-to-one & g is one-to-one & f, g form_morphism_between S1, S2 &
  the Sorts of C1 = (the Sorts of C2)*f &
  the Charact of C1 = (the Charact of C2)*g;
end;

theorem 
  for S being non empty ManySortedSign for C being non-empty MSAlgebra over S
  holds id the carrier of S, id the carrier' of S form_embedding_of C, C;

theorem 
  for S1,S2,S3 being non empty ManySortedSign for f1,g1, f2,g2 being Function
  for C1 being non-empty MSAlgebra over S1
  for C2 being non-empty MSAlgebra over S2
  for C3 being non-empty MSAlgebra over S3
  st f1,g1 form_embedding_of C1,C2 & f2,g2 form_embedding_of C2,C3
  holds f2*f1, g2*g1 form_embedding_of C1, C3;

definition
  let S1, S2 be non empty ManySortedSign;
  let f,g be Function;
  let C1 be non-empty MSAlgebra over S1;
  let C2 be non-empty MSAlgebra over S2;
  pred C1, C2 are_similar_wrt f, g means


   f, g form_embedding_of C1, C2 & f", g" form_embedding_of C2, C1;
end;

theorem 
  for S1, S2 being non empty ManySortedSign for f, g being Function
  for C1 being non-empty MSAlgebra over S1
  for C2 being non-empty MSAlgebra over S2 st C1, C2 are_similar_wrt f, g
  holds S1, S2 are_equivalent_wrt f, g;

theorem 
  for S1, S2 being non empty ManySortedSign for f, g being Function
  for C1 being non-empty MSAlgebra over S1
  for C2 being non-empty MSAlgebra over S2 holds C1, C2 are_similar_wrt f, g
  iff S1, S2 are_equivalent_wrt f, g & the Sorts of C1 = (the Sorts of C2)*f &
  the Charact of C1 = (the Charact of C2)*g;

theorem 
  for S being non empty ManySortedSign for C being non-empty MSAlgebra over S
  holds C, C are_similar_wrt id the carrier of S, id the carrier' of S;

theorem 
  for S1, S2 being non empty ManySortedSign for f, g being Function
  for C1 being non-empty MSAlgebra over S1
  for C2 being non-empty MSAlgebra over S2 st C1, C2 are_similar_wrt f, g
  holds C2, C1 are_similar_wrt f", g";

theorem 
  for S1, S2, S3 being non empty ManySortedSign
  for f1, g1, f2, g2 being Function for C1 being non-empty MSAlgebra over S1
  for C2 being non-empty MSAlgebra over S2
  for C3 being non-empty MSAlgebra over S3
  st C1, C2 are_similar_wrt f1, g1 & C2, C3 are_similar_wrt f2, g2
  holds C1, C3 are_similar_wrt f2*f1, g2*g1;

definition
  let S1, S2 be non empty ManySortedSign;
  let C1 be non-empty MSAlgebra over S1;
  let C2 be non-empty MSAlgebra over S2;
  pred C1, C2 are_similar means

  ex f, g being Function st C1, C2 are_similar_wrt f, g;
end;

reserve G1, G2 for Circuit-like non void non empty ManySortedSign,
  f, g for Function,
  C1 for non-empty Circuit of G1,
  C2 for non-empty Circuit of G2;

theorem 
  f, g form_embedding_of C1, C2 implies
  dom f = the carrier of G1 & rng f c= the carrier of G2 &
  dom g = the carrier' of G1 & rng g c= the carrier' of G2;

theorem 
  f, g form_embedding_of C1, C2 implies
  for o1 being Gate of G1, o2 being Gate of G2 st o2 = g.o1
  holds Den(o2, C2) = Den(o1, C1);

theorem 
  f, g form_embedding_of C1, C2 implies
  for o1 being Gate of G1, o2 being Gate of G2 st o2 = g.o1
  for s1 being State of C1, s2 being State of C2 st s1 = s2*f
  holds o2 depends_on_in s2 = o1 depends_on_in s1;

theorem 
  f, g form_embedding_of C1, C2 implies
  for s being State of C2 holds s*f is State of C1;

theorem 
  f, g form_embedding_of C1, C2 implies
  for s2 being State of C2, s1 being State of C1 st s1 = s2*f &
  for v being Vertex of G1 st v in InputVertices G1 holds s2 is_stable_at f.v
  holds Following s1 = (Following s2)*f;

theorem 
  f, g form_embedding_of C1, C2 & f preserves_inputs_of G1, G2 implies
  for s2 being State of C2, s1 being State of C1 st s1 = s2*f
  holds Following s1 = (Following s2)*f;

theorem 
  f, g form_embedding_of C1, C2 & f preserves_inputs_of G1, G2 implies
  for s2 being State of C2, s1 being State of C1 st s1 = s2*f
  for n being Element of NAT holds Following(s1,n) = Following(s2,n)*f;

theorem 
  f, g form_embedding_of C1, C2 & f preserves_inputs_of G1, G2 implies
  for s2 being State of C2, s1 being State of C1 st s1 = s2*f
  holds s2 is stable implies s1 is stable;

theorem 
  f, g form_embedding_of C1, C2 & f preserves_inputs_of G1, G2 implies
  for s2 being State of C2, s1 being State of C1 st s1 = s2*f
  for v1 being Vertex of G1 holds s1 is_stable_at v1 iff s2 is_stable_at f.v1;

theorem 
  C1, C2 are_similar_wrt f, g implies
  for s being State of C2 holds s*f is State of C1;

theorem 
  C1, C2 are_similar_wrt f, g implies
  for s1 being State of C1, s2 being State of C2
  holds s1 = s2*f iff s2 = s1*f";

theorem 
  C1, C2 are_similar_wrt f, g implies f.:InputVertices G1 = InputVertices G2 &
  f.:InnerVertices G1 = InnerVertices G2;

theorem 
  C1, C2 are_similar_wrt f, g implies f preserves_inputs_of G1, G2;

theorem 
  C1, C2 are_similar_wrt f, g implies
  for s1 being State of C1, s2 being State of C2 st s1 = s2*f
  holds Following s1 = (Following s2)*f;

theorem 
  C1, C2 are_similar_wrt f, g implies
  for s1 being State of C1, s2 being State of C2 st s1 = s2*f
  for n being Element of NAT holds Following(s1,n) = Following(s2,n)*f;

theorem 
  C1, C2 are_similar_wrt f, g implies
  for s1 being State of C1, s2 being State of C2 st s1 = s2*f
  holds s1 is stable iff s2 is stable;

theorem 
  C1, C2 are_similar_wrt f, g implies
  for s1 being State of C1, s2 being State of C2 st s1 = s2*f
  for v1 being Vertex of G1 holds s1 is_stable_at v1 iff s2 is_stable_at f.v1;

begin 

definition
  let S be non empty non void ManySortedSign;
  let A be non-empty MSAlgebra over S;
  let V be non-empty ManySortedSet of the carrier of S;
  let X be non empty Subset of S-Terms V;
  let G be Circuit-like non void non empty ManySortedSign;
  let C be non-empty Circuit of G;
  pred C calculates X, A means


   ex f, g st f, g form_embedding_of X-Circuit A, C &
  f preserves_inputs_of X-CircuitStr, G;
  pred X, A specifies C means

  C, X-Circuit A are_similar;
end;

definition
  let S be non empty non void ManySortedSign;
  let V be non-empty ManySortedSet of the carrier of S;
  let A be non-empty MSAlgebra over S;
  let X be non empty Subset of S-Terms V;
  let G be Circuit-like non void non empty ManySortedSign;
  let C be non-empty Circuit of G;
  assume C calculates X, A;
  mode SortMap of X, A, C -> one-to-one Function means


     it preserves_inputs_of X-CircuitStr, G &
    ex g st it, g form_embedding_of X-Circuit A, C;
end;

definition
  let S be non empty non void ManySortedSign;
  let V be non-empty ManySortedSet of the carrier of S;
  let A be non-empty MSAlgebra over S;
  let X be non empty Subset of S-Terms V;
  let G be Circuit-like non void non empty ManySortedSign;
  let C be non-empty Circuit of G such that
 C calculates X, A;
  let f be SortMap of X, A, C;
  mode OperMap of X, A, C, f -> one-to-one Function means

    f, it form_embedding_of X-Circuit A, C;
end;

theorem 
  for G being Circuit-like non void non empty ManySortedSign
  for C being non-empty Circuit of G st X, A specifies C
  holds C calculates X, A;

theorem 
  for G being Circuit-like non void non empty ManySortedSign
  for C being non-empty Circuit of G st C calculates X, A
  for f being SortMap of X, A, C for t being Term of S,V st t in Subtrees X
  for s being State of C holds Following(s, 1+height dom t) is_stable_at f.t &
  for s9 being State of X-Circuit A st s9 = s*f
  for h being CompatibleValuation of s9
  holds Following(s, 1+height dom t).(f.t) = t@(h, A);

theorem 
  for G being Circuit-like non void non empty ManySortedSign
  for C being non-empty Circuit of G st C calculates X, A
  for t being Term of S,V st t in Subtrees X ex v being Vertex of G st
  for s being State of C holds Following(s, 1+height dom t) is_stable_at v &
  ex f being SortMap of X, A, C st
  for s9 being State of X-Circuit A st s9 = s*f
  for h being CompatibleValuation of s9
  holds Following(s, 1+height dom t).v = t@(h, A);

theorem 
  for G being Circuit-like non void non empty ManySortedSign
  for C being non-empty Circuit of G st X, A specifies C
  for f being SortMap of X, A, C
  for s being State of C, t being Term of S,V st t in Subtrees X
  holds Following(s, 1+height dom t) is_stable_at f.t &
  for s9 being State of X-Circuit A st s9 = s*f
  for h being CompatibleValuation of s9
  holds Following(s, 1+height dom t).(f.t) = t@(h, A);

theorem 
  for G being Circuit-like non void non empty ManySortedSign
  for C being non-empty Circuit of G st X, A specifies C
  for t being Term of S,V st t in Subtrees X ex v being Vertex of G st
  for s being State of C holds Following(s, 1+height dom t) is_stable_at v &
  ex f being SortMap of X, A, C st
  for s9 being State of X-Circuit A st s9 = s*f
  for h being CompatibleValuation of s9
  holds Following(s, 1+height dom t).v = t@(h, A);














begin 

reserve n,i,j,k for Element of NAT;

definition
  let A,B be non empty set, f be Function of A,B, g be PartFunc of A,B;
  redefine func f +* g -> Function of A,B;
end;

definition
  let X,Y be non empty set, a be Element of X, b be Element of Y;
  redefine func a .--> b -> PartFunc of X,Y;
end;

notation
  let n be Nat;
  synonym SegM n for succ n;
end;

definition
  let n be Nat;
  redefine func SegM n -> Subset of NAT equals

  {k : k <= n};
end;

registration
  let n be Nat;
  cluster SegM n -> finite non empty;
end;

theorem 
  k in SegM n iff k <= n;

theorem 
  for f be Function,x,y,z,u,v be set st u <> x holds (f +* ([x,y]
  .--> z)).[u,v]=f.[u,v];

theorem 
  for f be Function,x,y,z,u,v be set st v <> y holds (f +* ([x,y]
  .--> z)).[u,v]=f.[u,v];

notation
  let i be Nat, f be FinSequence;
  synonym Prefix(f,i) for f|i;
end;

definition
  let i be Element of NAT, f be FinSequence of NAT;
  redefine func Prefix(f,i) -> FinSequence of INT;
end;

theorem 
  for x1,x2 being Element of NAT holds Sum Prefix(<*x1,x2*>,1)=x1 &
  Sum Prefix(<*x1,x2*>,2)=x1+x2;

theorem 
  for x1,x2,x3 being Element of NAT holds Sum Prefix(<*x1,x2,x3*>,1
  )=x1 & Sum Prefix(<*x1,x2,x3*>,2)=x1+x2 & Sum Prefix(<*x1,x2,x3*>,3)=x1+x2+x3
;

begin 

definition
  struct TuringStr (# Symbols, FStates -> finite non empty set,
    Tran -> Function of [: the FStates, the Symbols :],
         [: the FStates,the Symbols,{-1,0,1}
    :], InitS,AcceptS -> Element of the FStates #);
end;

definition
  let T be TuringStr;
  mode State of T is Element of the FStates of T;
  mode Tape of T is Element of Funcs(INT,the Symbols of T);
  mode Symbol of T is Element of the Symbols of T;
end;

definition
  let T be TuringStr,t be Tape of T, h be Integer,s be Symbol of T;
  func Tape-Chg(t,h,s) -> Tape of T equals

  t +* (h .--> s);
end;

definition
  let T be TuringStr;
  mode All-State of T is
  Element of [: the FStates of T, INT,Funcs(INT,the Symbols of T) :];
  mode Tran-Source of T is
   Element of [: the FStates of T,the Symbols of T:];
  mode Tran-Goal of T is
   Element of [: the FStates of T,the Symbols of T,{-1,0,1} :];
end;

definition
  let T be TuringStr, g be Tran-Goal of T;
  func offset(g) -> Integer equals

  g`3_3;
end;

definition
  let T be TuringStr, s be All-State of T;
  func Head(s) -> Integer equals

  s`2_3;
end;

definition
  let T be TuringStr, s be All-State of T;
  func TRAN(s) -> Tran-Goal of T equals

  (the Tran of T).[s`1_3, (s`3_3 qua Tape of T).Head(s)];
end;

definition
  let T be TuringStr, s be All-State of T;
  func Following s -> All-State of T equals


  [(TRAN(s))`1_3, Head(s)+offset TRAN (s),
    Tape-Chg(s`3_3, Head(s),(TRAN(s))`2_3)] if s`1_3 <> the AcceptS of T
  otherwise s;
end;

definition
  let T be TuringStr, s be All-State of T;
  func Computation s -> Function of NAT, [: the FStates of T, INT,
Funcs(INT,
  the Symbols of T) :] means


  it.0 = s & for i being Nat holds it.(i+1) = Following(it.i);
end;

reserve T for TuringStr,
  s for All-State of T;

theorem 
  for T being TuringStr, s be All-State of T st s`1_3 = the AcceptS of T
  holds s = Following s;

theorem 
  (Computation s).0 = s;

theorem 
  (Computation s).(k+1) = Following (Computation s).k;

theorem 
  (Computation s).1 = Following s;

theorem 
  (Computation s).(i+k) = (Computation (Computation s).i).k;

theorem 
  i <= j & Following (Computation s).i = (Computation s).i implies
  (Computation s).j = (Computation s).i;

theorem 
  i <= j & ((Computation s).i)`1_3 = the AcceptS of T implies (
  Computation s).j = (Computation s).i;

definition
  let T be TuringStr, s be All-State of T;
  attr s is Accept-Halt means


  ex k st ((Computation s).k)`1_3 = the AcceptS of T;
end;

definition
  let T be TuringStr, s be All-State of T such that
 s is Accept-Halt;
  func Result s -> All-State of T means


  ex k st it = (Computation s).k & ((Computation s).k)`1_3 = the AcceptS of T;
end;

theorem 
  for T being TuringStr,s be All-State of T st s is Accept-Halt
  holds ex k being Element of NAT st
  ((Computation s).k)`1_3 = the AcceptS of T &
  Result s = (Computation s).k & for i be Element of NAT st i < k holds ((
  Computation s).i)`1_3 <> the AcceptS of T;

definition
  let A, B be non empty set, y be set such that
 y in B;
  func id(A, B, y) -> Function of A, [: A, B :] means

  for x be Element of A holds it.x=[x,y];
end;

definition
  func Sum_Tran -> Function of [: SegM 5,{0,1} :], [: SegM 5,{0,1},{ -1,0,1 }
  :] equals

  id([: SegM 5,{0,1} :],{ -1,0,1 }, 0) +* ([0,0] .--> [0,0,1]) +* ([0,1
] .--> [1,0,1]) +* ([1,1] .--> [1,1,1]) +* ([1,0] .--> [2,1,1]) +* ([2,1] .-->
[2,1,1]) +* ([2,0] .--> [3,0,-1]) +* ([3,1] .--> [4,0,-1]) +* ([4,1] .--> [4,1,
  -1]) +* ([4,0] .--> [5,0,0]);
end;

theorem 
  Sum_Tran.[0,0]=[0,0,1] & Sum_Tran.[0,1]=[1,0,1] & Sum_Tran.[1,1]
=[1,1,1] & Sum_Tran.[1,0]=[2,1,1] & Sum_Tran.[2,1]=[2,1,1] & Sum_Tran.[2,0]=[3,
0,-1] & Sum_Tran.[3,1]=[4,0,-1] & Sum_Tran.[4,1]=[4,1,-1] & Sum_Tran.[4,0]=[5,0
  ,0];

definition
  let T be TuringStr, t be Tape of T, i,j be Integer;
  pred t is_1_between i,j means


  t.i=0 & t.j=0 & for k be Integer st i < k & k < j holds t.k=1;
end;

definition
  let f be FinSequence of NAT, T be TuringStr, t be Tape of T;
  pred t storeData f means


  for i be Element of NAT st 1 <= i & i < len
  f holds t is_1_between Sum Prefix(f,i)+2*(i-1),Sum Prefix(f,i+1)+2*i;
end;

theorem 
  for T being TuringStr,t be Tape of T, s,n be Element of NAT st t
  storeData <*s,n*> holds t is_1_between s,s+n+2;

theorem 
  for T being TuringStr, t be Tape of T, s,n be Element of NAT st
  t is_1_between s,s+n+2 holds t storeData <*s,n*>;

theorem 
  for T being TuringStr, t be Tape of T, s,n be Element of NAT st
t storeData <*s,n *> holds t.s=0 & t.(s+n+2)=0 & for i be Integer st s < i & i
  < s+n+2 holds t.i=1;

theorem 
  for T being TuringStr,t be Tape of T,s,n1,n2 be Element of NAT
st t storeData <*s,n1,n2*> holds t is_1_between s,s+n1+2 & t is_1_between s+n1+
  2,s+n1+n2+4;

theorem 
  for T being TuringStr, t be Tape of T, s,n1,n2 be Element of NAT
st t storeData <*s,n1,n2 *> holds t.s=0 & t.(s+n1+2)=0 & t.(s+n1+n2+4)=0 & (for
i be Integer st s < i & i < s+n1+2 holds t.i=1) & for i be Integer st s+n1+2 <
  i & i < s+n1+n2+4 holds t.i=1;

theorem 
  for f being FinSequence of NAT,s being Element of NAT st len f
  >= 1 holds Sum Prefix(<*s*>^f,1)=s & Sum Prefix(<*s*>^f,2)=s+f/.1;

theorem 
  for f being FinSequence of NAT,s being Element of NAT st len f
>= 3 holds Sum Prefix(<*s*>^f,1)=s & Sum Prefix(<*s*>^f,2)=s+f/.1 & Sum Prefix(
  <*s*>^f,3)=s+f/.1+f/.2 & Sum Prefix(<*s*>^f,4)=s+f/.1+f/.2+f/.3;

theorem 
  for T being TuringStr,t be Tape of T, s be Element of NAT, f be
FinSequence of NAT st len f >=1 & t storeData <*s*>^f holds t is_1_between s,s+
  f/.1+2;

theorem 
  for T being TuringStr,t be Tape of T, s be Element of NAT, f be
FinSequence of NAT st len f >=3 & t storeData <*s*>^f holds t is_1_between s,s+
f/.1+2 & t is_1_between s+f/.1+2, s+f/.1+f/.2+4 & t is_1_between s+f/.1+f/.2+4,
  s+f/.1+f/.2+f/.3+6;

begin 

definition
  func SumTuring -> strict TuringStr means


  the Symbols of it = { 0,1 }
& the FStates of it = SegM 5 & the Tran of it = Sum_Tran & the InitS of it
= 0 &
  the AcceptS of it = 5;
end;

theorem 
  for T be TuringStr,t be Tape of T, h be Integer,s be Symbol of T
  st t.h=s holds Tape-Chg(t,h,s) = t;

theorem 
  for T be TuringStr, s be All-State of T, p,h,t be set st s=[p,h,
  t] & p <> the AcceptS of T
  holds Following s = [(TRAN(s))`1_3, Head(s)+offset
  TRAN(s),Tape-Chg(s`3_3,Head(s),(TRAN(s))`2_3)];

theorem 
  for T being TuringStr,t be Tape of T, h be Integer, s be Symbol
of T,i be set holds Tape-Chg(t,h,s).h=s & ( i <> h implies Tape-Chg(t,h,s).i=t.
  i);

theorem 
  for s being All-State of SumTuring, t be Tape of SumTuring, head
,n1,n2 be Element of NAT st s=[0,head,t] & t storeData <*head,n1,n2 *> holds s
is Accept-Halt & (Result s)`2_3=1+head &
   (Result s)`3_3 storeData <*1+head,n1+n2 *>;

definition
  let T be TuringStr,F be Function;
  pred T computes F means


  for s being All-State of T,t being Tape of T
  , a being Element of NAT, x being FinSequence of NAT st x in dom F & s=[the
  InitS of T,a,t] & t storeData <*a*>^x holds s is Accept-Halt & ex b, y being
Element of NAT st (Result s)`2_3=b & y=F.x &
     (Result s)`3_3 storeData <*b*>^<* y *>
  ;
end;

theorem 
  dom [+] c= 2-tuples_on NAT;

theorem 
  SumTuring computes [+];

begin 

definition
  func Succ_Tran -> Function of [: SegM 4,{0,1} :], [: SegM 4,{0,1},{ -1,0,1 }
  :] equals

  id([: SegM 4,{0,1} :],{ -1,0,1 }, 0) +* ([0,0] .--> [1,0,1]) +* ([1,1
] .--> [1,1,1]) +* ([1,0] .--> [2,1,1]) +* ([2,0] .--> [3,0,-1]) +* ([2,1] .-->
  [3,0,-1]) +* ([3,1] .--> [3,1,-1]) +* ([3,0] .--> [4,0,0]);
end;

theorem 
  Succ_Tran.[0,0]=[1,0,1] & Succ_Tran.[1,1]=[1,1,1] & Succ_Tran.[1
,0]=[2,1,1] & Succ_Tran.[2,0]=[3,0,-1] & Succ_Tran.[2,1]=[3,0,-1] & Succ_Tran.[
  3,1]=[3,1,-1] & Succ_Tran.[3,0]=[4,0,0];

definition
  func SuccTuring -> strict TuringStr means


  the Symbols of it = { 0,1
} & the FStates of it = SegM 4 & the Tran of it = Succ_Tran & the InitS of
it =
  0 & the AcceptS of it = 4;
end;

theorem 
  for s being All-State of SuccTuring, t be Tape of SuccTuring,
  head,n be Element of NAT st s=[0,head,t] & t storeData <*head,n*> holds s is
  Accept-Halt & (Result s)`2_3=head & (Result s)`3_3 storeData <*head,n+1*>;

theorem 
  SuccTuring computes 1 succ 1;

begin 

definition
  func Zero_Tran -> Function of [: SegM 4,{0,1} :], [: SegM 4,{0,1},{ -1,0,1 }
  :] equals

  id([: SegM 4,{0,1} :],{ -1,0,1 }, 1) +* ([0,0] .--> [1,0,1]) +* ([1,1
  ] .--> [2,1,1]) +* ([2,0] .--> [3,0,-1]) +* ([2,1] .--> [3,0,-1]) +* ([3,1]
  .--> [4,1,-1]);
end;

theorem 
  Zero_Tran.[0,0]=[1,0,1] & Zero_Tran.[1,1]=[2,1,1] & Zero_Tran.[2
  ,0]=[3,0,-1] & Zero_Tran.[2,1]=[3,0,-1] & Zero_Tran.[3,1]=[4,1,-1];

definition
  func ZeroTuring -> strict TuringStr means


  the Symbols of it = { 0,1
} & the FStates of it = SegM 4 & the Tran of it = Zero_Tran & the InitS of
it =
  0 & the AcceptS of it = 4;
end;

theorem 
  for s being All-State of ZeroTuring, t be Tape of ZeroTuring,
head be Element of NAT, f be FinSequence of NAT st len f >= 1 & s=[0,head,t] &
t storeData <*head*>^f holds s is Accept-Halt &
 (Result s)`2_3=head & (Result s)
  `3_3 storeData <*head,0*>;

theorem 
  n >=1 implies ZeroTuring computes n const 0;

begin 

definition
  func U3(n)Tran -> Function of [: SegM 3,{0,1} :], [: SegM 3,{0,1},{ -1,0,1 }
  :] equals

  id([: SegM 3,{0,1} :],{ -1,0,1 }, 0) +* ([0,0] .--> [1,0,1]) +* ([1,1
] .--> [1,0,1]) +* ([1,0] .--> [2,0,1]) +* ([2,1] .--> [2,0,1]) +* ([2,0] .-->
  [3,0,0]);
end;

theorem 
  U3(n)Tran.[0,0]=[1,0,1] & U3(n)Tran.[1,1]=[1,0,1] & U3(n)Tran.[1
  ,0]=[2,0,1] & U3(n)Tran.[2,1]=[2,0,1] & U3(n)Tran.[2,0]=[3,0,0];

definition
  func U3(n)Turing -> strict TuringStr means


  the Symbols of it = { 0,1
} & the FStates of it = SegM 3 & the Tran of it = U3(n)Tran & the InitS of
it =
  0 & the AcceptS of it = 3;
end;

theorem 
  for s being All-State of U3(n)Turing, t be Tape of U3(n)Turing,
head be Element of NAT, f be FinSequence of NAT st len f >= 3 & s=[0,head,t] &
t storeData <*head*>^f holds s is Accept-Halt &
   (Result s)`2_3=head+f/.1+f/.2+4 &
  (Result s)`3_3 storeData <*head+f/.1+f/.2+4,f/.3*>;

theorem 
  n >= 3 implies U3(n)Turing computes n proj 3;

begin 

definition
  let t1,t2 be TuringStr;
  func UnionSt(t1,t2) -> finite non empty set equals

  [: the FStates of t1, {the
  InitS of t2} :] \/ [: {the AcceptS of t1}, the FStates of t2 :];
end;

theorem 
  for t1,t2 being TuringStr holds [ the InitS of t1, the InitS of
t2 ] in UnionSt(t1,t2) & [ the AcceptS of t1,the AcceptS of t2 ] in UnionSt(t1,
  t2);

theorem 
  for s,t being TuringStr, x be State of s holds [ x, the InitS of
  t ] in UnionSt(s,t);

theorem 
  for s,t being TuringStr, x be State of t holds [ the AcceptS of
  s, x] in UnionSt(s,t);

theorem 
  for s,t being TuringStr, x be Element of UnionSt(s,t) holds ex
  x1 be State of s, x2 be State of t st x=[x1, x2];

definition
  let s,t be TuringStr, x be Tran-Goal of s;
  func FirstTuringTran(s,t,x) -> Element of [: UnionSt(s,t),(the Symbols of s)
  \/ the Symbols of t,{-1,0,1} :] equals

  [[x`1_3,the InitS of t], x`2_3, x`3_3];
end;

definition
  let s,t be TuringStr, x be Tran-Goal of t;
  func SecondTuringTran(s,t,x) -> Element of [: UnionSt(s,t),(the Symbols of s
  ) \/ the Symbols of t,{-1,0,1} :] equals

  [[the AcceptS of s,x`1_3], x`2_3, x`3_3];
end;

definition
  let s,t be TuringStr;
  let x be Element of UnionSt(s,t);
  redefine func x`1 -> State of s;
  redefine func x`2 -> State of t;
end;

definition
  let s,t be TuringStr, x be Element of [: UnionSt(s,t), (the Symbols of s) \/
  the Symbols of t :];
  func FirstTuringState x -> State of s equals

  x`1`1;
  func SecondTuringState x -> State of t equals

  x`1`2;
end;

definition
  let X,Y,Z be non empty set, x be Element of [: X, Y \/ Z :];
  given u being set,y be Element of Y such that
 x = [u,y];
  func FirstTuringSymbol(x) -> Element of Y equals


  x`2;
end;

definition
  let X,Y,Z be non empty set, x be Element of [: X, Y \/ Z :];
  given u being set,z be Element of Z such that
 x = [u, z];
  func SecondTuringSymbol(x) -> Element of Z equals


  x`2;
end;

definition
  let s,t be TuringStr, x be Element of [: UnionSt(s,t), (the Symbols of s) \/
  the Symbols of t :];
  func Uniontran(s,t,x) -> Element of [: UnionSt(s,t), (the Symbols of s) \/
  the Symbols of t,{-1,0,1} :] equals


  FirstTuringTran(s,t,(the Tran of s)
  .[FirstTuringState x, FirstTuringSymbol(x)]) if ex p being State of s,y be
  Symbol of s st x = [ [p,the InitS of t],y] & p <> the AcceptS of s,
SecondTuringTran(s,t,(the Tran of t). [SecondTuringState x,SecondTuringSymbol(x
)]) if ex q being State of t, y be Symbol of t st x = [ [the AcceptS of s,q],y]
  otherwise [x`1,x`2,-1];
end;

definition
  let s,t be TuringStr;
  func UnionTran(s,t) -> Function of [: UnionSt(s,t), (the Symbols of s) \/
the Symbols of t :], [: UnionSt(s,t), (the Symbols of s) \/ the Symbols of t,{-
  1,0,1} :] means


  for x being Element of [: UnionSt(s,t), (the Symbols of
  s) \/ the Symbols of t :] holds it.x = Uniontran(s,t,x);
end;

definition
  let T1,T2 be TuringStr;
  func T1 ';' T2 -> strict TuringStr means


  the Symbols of it = (the Symbols of T1) \/ the Symbols of T2 &
  the FStates of it = UnionSt(T1,T2) & the
Tran of it = UnionTran(T1,T2) & the InitS of it = [the InitS of T1,the InitS of
  T2] & the AcceptS of it = [the AcceptS of T1,the AcceptS of T2];
end;

theorem 
  for T1,T2 being TuringStr, g be Tran-Goal of T1,p be State of T1
  , y be Symbol of T1 st p <> the AcceptS of T1 & g = (the Tran of T1).[p, y]
holds (the Tran of T1 ';' T2).[ [p,the InitS of T2],y]
     = [[g`1_3,the InitS of T2]
  , g`2_3, g`3_3];

theorem 
  for T1,T2 being TuringStr, g be Tran-Goal of T2, q be State of
T2, y be Symbol of T2 st g = (the Tran of T2).[q, y] holds (the Tran of T1 ';'
  T2).[ [the AcceptS of T1,q],y] = [[the AcceptS of T1,g`1_3], g`2_3, g`3_3];

theorem 
  for T1,T2 being TuringStr,s1 be All-State of T1,h be Element of
  NAT, t be Tape of T1, s2 be All-State of T2,s3 be All-State of (T1 ';' T2) st
  s1 is Accept-Halt & s1=[the InitS of T1,h,t] & s2 is Accept-Halt & s2=[the
  InitS of T2,(Result s1)`2_3,(Result s1)`3_3] &
    s3=[the InitS of (T1 ';' T2),h,t]
  holds s3 is Accept-Halt & (Result s3)`2_3=(Result s2)`2_3 &
    (Result s3)`3_3=(Result
  s2)`3_3;

theorem 
  for tm1,tm2 being TuringStr,t be Tape of tm1 st the Symbols of tm1 =
  the Symbols of tm2 holds t is Tape of tm1 ';' tm2;

theorem 
  for tm1,tm2 being TuringStr,t be Tape of tm1 ';' tm2 st the Symbols of
  tm1 = the Symbols of tm2 holds t is Tape of tm1 & t is Tape of tm2;

theorem 
  for f being FinSequence of NAT,tm1,tm2 be TuringStr,t1 be Tape
  of tm1, t2 be Tape of tm2 st t1=t2 & t1 storeData f holds t2 storeData f;

theorem 
  for s being All-State of ZeroTuring ';' SuccTuring, t be Tape of
ZeroTuring , head,n be Element of NAT st s=[[0,0],head,t] & t storeData <*head,
n*> holds s is Accept-Halt & (Result s)`2_3=head &
  (Result s)`3_3 storeData <*head,
  1*>;














begin

reserve x,y,X for set;

theorem 
  for X being non empty set for F being proper Filter of BoolePoset
  X for A being set st A in F holds A is not empty;

definition
  let T be non empty TopSpace;
  let x be Point of T;
  func NeighborhoodSystem x -> Subset of BoolePoset [#]T equals

  {A where A is
  a_neighborhood of x: not contradiction};
end;

theorem 
  for T being non empty TopSpace, x being Point of T, A being set
  holds A in NeighborhoodSystem x iff A is a_neighborhood of x;

registration
  let T be non empty TopSpace;
  let x be Point of T;
  cluster NeighborhoodSystem x -> non empty proper upper filtered;
end;

theorem 
  for T being non empty TopSpace, x being Point of T for F being
  upper Subset of BoolePoset [#]T holds x is_a_convergence_point_of F, T iff
  NeighborhoodSystem x c= F;

theorem 
  for T being non empty TopSpace, x being Point of T holds x
  is_a_convergence_point_of NeighborhoodSystem x, T;

theorem 
  for T being non empty TopSpace for A being Subset of T holds A is open
iff for x being Point of T st x in A for F being Filter of BoolePoset [#]T st x
  is_a_convergence_point_of F, T holds A in F;

definition
  let S be non empty 1-sorted;
  let N be non empty NetStr over S;
  mode Subset of S,N -> Subset of S means


    ex i being Element of N st it = rng the mapping of N|i;
end;

theorem 
  for S being non empty 1-sorted for N being non empty NetStr over S for
  i being Element of N holds rng the mapping of N|i is Subset of S, N;

registration
  let S be non empty 1-sorted;
  let N be reflexive non empty NetStr over S;
  cluster -> non empty for Subset of S,N;
end;

theorem 
  for S being non empty 1-sorted, N being net of S for i being
  Element of N, x being set holds x in rng the mapping of N|i iff ex j being
  Element of N st i <= j & x = N.j;

theorem 
  for S being non empty 1-sorted, N being net of S for A being
  Subset of S,N holds N is_eventually_in A;

theorem 
  for S being non empty 1-sorted, N being net of S for F being finite
  non empty set st for A being Element of F holds A is Subset of S,N ex B being
  Subset of S,N st B c= meet F;

definition
  let T be non empty 1-sorted;
  let N be non empty NetStr over T;
  func a_filter N -> Subset of BoolePoset [#]T equals

  {A where A is Subset of
T: N is_eventually_in A};
end;

theorem 
  for T being non empty 1-sorted for N being non empty NetStr over
T for A being set holds A in a_filter N iff N is_eventually_in A & A is Subset
  of T;

registration
  let T be non empty 1-sorted;
  let N be non empty NetStr over T;
  cluster a_filter N -> non empty upper;
end;

registration
  let T be non empty 1-sorted;
  let N be net of T;
  cluster a_filter N -> proper filtered;
end;

theorem 
  for T being non empty TopSpace for N being net of T for x being
Point of T holds x is_a_cluster_point_of N iff x is_a_cluster_point_of a_filter
  N, T;

theorem 
  for T being non empty TopSpace for N being net of T for x being
  Point of T holds x in Lim N iff x is_a_convergence_point_of a_filter N, T;

definition
  let L be non empty 1-sorted;
  let O be non empty Subset of L;
  let F be Filter of BoolePoset O;
  func a_net F -> strict non empty NetStr over L means


  the carrier of
  it = {[a, f] where a is Element of L, f is Element of F: a in f} & (for i,j
  being Element of it holds i <= j iff j`2 c= i`2) & for i being Element of it
  holds it.i = i`1;
end;

registration
  let L be non empty 1-sorted;
  let O be non empty Subset of L;
  let F be Filter of BoolePoset O;
  cluster a_net F -> reflexive transitive;
end;

registration
  let L be non empty 1-sorted;
  let O be non empty Subset of L;
  let F be proper Filter of BoolePoset O;
  cluster a_net F -> directed;
end;

theorem 
  for T being non empty 1-sorted for F being Filter of BoolePoset
  [#]T holds F \ {{}} = a_filter a_net F;

theorem 
  for T being non empty 1-sorted for F being proper Filter of
  BoolePoset [#]T holds F = a_filter a_net F;

theorem 
  for T being non empty 1-sorted for F being Filter of BoolePoset
  [#]T for A being non empty Subset of T holds A in F iff a_net F
  is_eventually_in A;

theorem 
  for T being non empty TopSpace for F being proper Filter of
  BoolePoset [#]T for x being Point of T holds x is_a_cluster_point_of a_net F
  iff x is_a_cluster_point_of F, T;

theorem 
  for T being non empty TopSpace for F being proper Filter of
  BoolePoset [#]T for x being Point of T holds x in Lim a_net F iff x
  is_a_convergence_point_of F, T;

theorem 
  for T being non empty TopSpace, x being Point of T, A being
  Subset of T st x in Cl A for F being proper Filter of BoolePoset [#]T st F =
  NeighborhoodSystem x holds a_net F is_often_in A;

theorem 
  for T being non empty 1-sorted, A being set for N being net of T
  st N is_eventually_in A for S being subnet of N holds S is_eventually_in A;

theorem 
  for T being non empty TopSpace, F,G,x being set st F c= G & x
  is_a_convergence_point_of F, T holds x is_a_convergence_point_of G, T;

theorem 
  for T being non empty TopSpace, A being Subset of T for x being
Point of T holds x in Cl A iff ex N being net of T st N is_eventually_in A & x
  is_a_cluster_point_of N;

theorem 
  for T being non empty TopSpace, A being Subset of T for x being
  Point of T holds x in Cl A iff ex N being convergent net of T st N
  is_eventually_in A & x in Lim N;

theorem 
  for T being non empty TopSpace, A being Subset of T holds A is closed
  iff for N being net of T st N is_eventually_in A for x being Point of T st x
  is_a_cluster_point_of N holds x in A;

theorem 
  for T being non empty TopSpace, A being Subset of T holds A is closed
  iff for N being convergent net of T st N is_eventually_in A for x being Point
  of T st x in Lim N holds x in A;

theorem 
  for T being non empty TopSpace, A being Subset of T for x being
Point of T holds x in Cl A iff ex F being proper Filter of BoolePoset [#]T st A
  in F & x is_a_cluster_point_of F, T;

theorem 
  for T being non empty TopSpace, A being Subset of T for x being
Point of T holds x in Cl A iff ex F being ultra Filter of BoolePoset [#]T st A
  in F & x is_a_convergence_point_of F, T;

theorem 
  for T being non empty TopSpace, A being Subset of T holds A is closed
iff for F being proper Filter of BoolePoset [#]T st A in F for x being Point of
  T st x is_a_cluster_point_of F,T holds x in A;

theorem 
  for T being non empty TopSpace, A being Subset of T holds A is closed
iff for F being ultra Filter of BoolePoset [#]T st A in F for x being Point of
  T st x is_a_convergence_point_of F,T holds x in A;

theorem 
  for T being non empty TopSpace, N being net of T for s being
Point of T holds s is_a_cluster_point_of N iff for A being Subset of T,N holds
  s in Cl A;

theorem 
  for T being non empty TopSpace for F being Subset-Family of T st F is
  closed holds FinMeetCl F is closed;

theorem 
  for T being non empty TopSpace holds T is compact iff for F
  being ultra Filter of BoolePoset [#]T ex x being Point of T st x
  is_a_convergence_point_of F, T;

theorem 
  for T being non empty TopSpace holds T is compact iff for F being
  proper Filter of BoolePoset [#]T ex x being Point of T st x
  is_a_cluster_point_of F, T;

theorem 
  for T being non empty TopSpace holds T is compact iff for N
  being net of T ex x being Point of T st x is_a_cluster_point_of N;

theorem 
  for T being non empty TopSpace holds T is compact iff for N being net
  of T st N in NetUniv T ex x being Point of T st x is_a_cluster_point_of N;

registration
  let L be non empty 1-sorted;
  let N be transitive NetStr over L;
  cluster -> transitive for full SubNetStr of N;
end;

registration
  let L be non empty 1-sorted;
  let N be non empty directed NetStr over L;
  cluster strict non empty directed full for SubNetStr of N;
end;

theorem 
  for T being non empty TopSpace holds T is compact iff for N being net
  of T ex S being subnet of N st S is convergent;

definition
  let S be non empty 1-sorted;
  let N be non empty NetStr over S;
  attr N is Cauchy means

  for A being Subset of S holds N is_eventually_in A or N is_eventually_in A `;
end;

registration
  let S be non empty 1-sorted;
  let F be ultra Filter of BoolePoset [#]S;
  cluster a_net F -> Cauchy;
end;

theorem 
  for T being non empty TopSpace holds T is compact iff for N being net
  of T st N is Cauchy holds N is convergent;














begin

reserve x for set;

definition
  let L be non empty Poset;
  let X be non empty Subset of L;
  let F be Filter of BoolePoset X;
  func lim_inf F -> Element of L equals

  "\/"({inf B where B is Subset of L: B
  in F},L);
end;

theorem 
  for L1, L2 being complete LATTICE st the RelStr of L1 = the RelStr of
L2 for X1 being non empty Subset of L1 for X2 being non empty Subset of L2 for
  F1 being Filter of BoolePoset X1, F2 being Filter of BoolePoset X2 st F1 = F2
  holds lim_inf F1 = lim_inf F2;

definition
  let L be non empty TopRelStr;
  attr L is lim-inf means


  the topology of L = xi L;
end;

registration
  cluster lim-inf -> TopSpace-like for non empty TopRelStr;
end;

registration
  cluster trivial -> lim-inf for TopLattice;
end;

registration
  cluster lim-inf continuous complete for TopLattice;
end;

theorem 
  for L1, L2 being non empty 1-sorted st the carrier of L1 = the
carrier of L2 for N1 being NetStr over L1 ex N2 being strict NetStr over L2 st
  the RelStr of N1 = the RelStr of N2 & the mapping of N1 = the mapping of N2;

theorem 
  for L1, L2 being non empty 1-sorted st the carrier of L1 = the
  carrier of L2 for N1 being NetStr over L1 st N1 in NetUniv L1 ex N2 being
  strict net of L2 st N2 in NetUniv L2 & the RelStr of N1 = the RelStr of N2 &
  the mapping of N1 = the mapping of N2;

theorem 
  for L1, L2 being /\-complete up-complete Semilattice st the
  RelStr of L1 = the RelStr of L2 for N1 being net of L1, N2 being net of L2 st
  the RelStr of N1 = the RelStr of N2 & the mapping of N1 = the mapping of N2
  holds lim_inf N1 = lim_inf N2;

theorem 
  for L1, L2 being non empty 1-sorted st the carrier of L1 = the
carrier of L2 for N1 being net of L1, N2 being net of L2 st the RelStr of N1 =
the RelStr of N2 & the mapping of N1 = the mapping of N2 for S1 being subnet of
N1 ex S2 being strict subnet of N2 st the RelStr of S1 = the RelStr of S2 & the
  mapping of S1 = the mapping of S2;

theorem 
  for L1, L2 being /\-complete up-complete Semilattice st the
RelStr of L1 = the RelStr of L2 for N1 being NetStr over L1, a being set st [N1
  ,a] in lim_inf-Convergence L1 ex N2 being strict net of L2 st [N2,a] in
  lim_inf-Convergence L2 & the RelStr of N1 = the RelStr of N2 & the mapping of
  N1 = the mapping of N2;

theorem 
  for L1, L2 being non empty 1-sorted for N1 being non empty NetStr
over L1 for N2 being non empty NetStr over L2 st the RelStr of N1 = the RelStr
  of N2 & the mapping of N1 = the mapping of N2 for X being set st N1
  is_eventually_in X holds N2 is_eventually_in X;

theorem 
  for L1, L2 being /\-complete up-complete Semilattice st the RelStr of
  L1 = the RelStr of L2 holds ConvergenceSpace lim_inf-Convergence L1 =
  ConvergenceSpace lim_inf-Convergence L2;

theorem 
  for L1, L2 being /\-complete up-complete Semilattice st the
  RelStr of L1 = the RelStr of L2 holds xi L1 = xi L2;

registration
  let R be /\-complete non empty reflexive RelStr;
  cluster -> /\-complete for TopAugmentation of R;
end;

registration
  let R be Semilattice;
  cluster -> with_infima for TopAugmentation of R;
end;

registration
  let L be /\-complete up-complete Semilattice;
  cluster strict lim-inf for TopAugmentation of L;
end;

theorem 
  for L being /\-complete up-complete Semilattice for X being
  lim-inf TopAugmentation of L holds xi L = the topology of X;

definition
  let L be /\-complete up-complete Semilattice;
  func Xi L -> strict TopAugmentation of L means


  it is lim-inf;
end;

registration
  let L be /\-complete up-complete Semilattice;
  cluster Xi L -> lim-inf;
end;

theorem 
  for L being complete LATTICE, N being net of L holds lim_inf N =
  "\/"({inf (N|i) where i is Element of N: not contradiction}, L);

theorem 
  for L being complete LATTICE, F being proper Filter of
  BoolePoset [#]L, f being Subset of L st f in F for i being Element of a_net F
  st i`2 = f holds inf f = inf ((a_net F)|i);

theorem 
  for L being complete LATTICE, F being proper Filter of
  BoolePoset [#]L holds lim_inf F = lim_inf a_net F;

theorem 
  for L being complete LATTICE, F being proper Filter of
  BoolePoset [#]L holds a_net F in NetUniv L;

theorem 
  for L being complete LATTICE, F being ultra Filter of BoolePoset
  [#]L for p being greater_or_equal_to_id Function of a_net F, a_net F holds
  lim_inf F >= inf ((a_net F) * p);

theorem 
  for L being complete LATTICE, F being ultra Filter of BoolePoset
  [#]L holds for M being subnet of a_net F holds lim_inf F = lim_inf M;

theorem 
  for L being non empty 1-sorted for N being net of L for A being
set st N is_often_in A ex N9 being strict subnet of N st rng the mapping of N9
  c= A & N9 is SubNetStr of N;

theorem 
  for L being complete lim-inf TopLattice, A being non empty
  Subset of L holds A is closed iff for F being ultra Filter of BoolePoset [#]L
  st A in F holds lim_inf F in A;

theorem 
  for L being non empty reflexive RelStr holds sigma L c= xi L;

theorem 
  for T1, T2 being non empty TopSpace, B being prebasis of T1 st B
  c= the topology of T2 & the carrier of T1 in the topology of T2 holds the
  topology of T1 c= the topology of T2;

theorem 
  for L being complete LATTICE holds omega L c= xi L;

theorem 
  for T1,T2 being TopSpace, T being non empty TopSpace st T is
  TopExtension of T1 & T is TopExtension of T2 for R being Refinement of T1,T2
  holds T is TopExtension of R;

theorem 
  for T1 being TopSpace, T2 being TopExtension of T1 for A being
  Subset of T1 holds (A is open implies A is open Subset of T2) & (A is closed
  implies A is closed Subset of T2);

theorem 
  for L being complete LATTICE holds lambda L c= xi L;

theorem 
  for L being complete LATTICE for T being lim-inf TopAugmentation
of L for S being Lawson correct TopAugmentation of L holds T is TopExtension of
  S;

theorem 
  for L being complete lim-inf TopLattice for F being ultra Filter
  of BoolePoset [#]L holds lim_inf F is_a_convergence_point_of F, L;


theorem 
  for L being complete lim-inf TopLattice holds L is compact T_1;














begin 

reserve x, y for set;

definition
  let a be set;
  func a as_1-sorted -> 1-sorted equals


  a if a is 1-sorted otherwise
  1-sorted(#a#);
end;

definition
  let W be set;
  func POSETS W means


  x in it iff x is strict Poset & the carrier of x as_1-sorted in W;
end;

registration
  let W be non empty set;
  cluster POSETS W -> non empty;
end;

registration
  let W be with_non-empty_elements set;
  cluster POSETS W -> POSet_set-like;
end;

definition
  let C be category;
  attr C is carrier-underlaid means


  for a being object of C ex S being
  1-sorted st a = S & the_carrier_of a = the carrier of S;
end;

definition
  let C be category;
  attr C is lattice-wise means


  C is semi-functional set-id-inheriting
& (for a being object of C holds a is LATTICE) & for a,b being object of C for
  A,B being LATTICE st A = a & B = b holds <^a,b^> c= MonFuncs(A, B);
end;

definition
  let C be category;
  attr C is with_complete_lattices means


  C is lattice-wise & for a being object of C holds a is complete LATTICE;
end;

registration
  cluster with_complete_lattices -> lattice-wise for category;
  cluster lattice-wise -> concrete carrier-underlaid for category;
end;

scheme 

  localCLCatEx { A() -> non empty set, P[set, set, set] }: ex C being strict
category st C is lattice-wise & the carrier of C = A() & for a,b being LATTICE,
f being monotone Function of a,b holds f in (the Arrows of C).(a,b) iff a in A(
  ) & b in A() & P[a,b,f]
provided
 for a being Element of A() holds a is LATTICE and
 for a,b,c being LATTICE st a in A() & b in A() & c in A() for f
being Function of a,b, g being Function of b,c st P[a,b,f] & P[b,c,g] holds P[a
,c,g*f] and
 for a being LATTICE st a in A() holds P[a,a,id a];

registration
  cluster strict with_complete_lattices for category;
end;

theorem 
  for C being carrier-underlaid category, a being object of C holds
  the_carrier_of a = the carrier of a as_1-sorted;

theorem 
  for C being set-id-inheriting carrier-underlaid category for a
  being object of C holds idm a = id (a as_1-sorted);

notation
  let C be lattice-wise category;
  let a be object of C;
  synonym latt a for a as_1-sorted;
end;

definition
  let C be lattice-wise category;
  let a be object of C;
  redefine func latt a -> LATTICE equals

  a;
end;

notation
  let C be with_complete_lattices category;
  let a be object of C;
  synonym latt a for a as_1-sorted;
end;

definition
  let C be with_complete_lattices category;
  let a be object of C;
  redefine func latt a -> complete LATTICE;
end;

definition
  let C be lattice-wise category;
  let a,b be object of C such that
 <^a,b^> <> {};
  let f be Morphism of a,b;
  func @f -> monotone Function of latt a, latt b equals


  f;
end;

theorem 
  for C being lattice-wise category for a,b,c being object of C st
<^a,b^> <> {} & <^b,c^> <> {} for f being Morphism of a,b, g being Morphism of
  b,c holds g*f = @g*@f;

scheme 

  CLCatEx1 { A() -> non empty set, P[set, set, set] }: ex C being lattice-wise
strict category st the carrier of C = A() & for a,b being object of C, f being
monotone Function of latt a, latt b holds f in <^a,b^> iff P[latt a, latt b, f]
provided
 for a being Element of A() holds a is LATTICE and
 for a,b,c being LATTICE st a in A() & b in A() & c in A() for f
being Function of a,b, g being Function of b,c st P[a,b,f] & P[b,c,g] holds P[a
,c,g*f] and
 for a being LATTICE st a in A() holds P[a,a,id a];

scheme 

  CLCatEx2 { A() -> non empty set, L[set], P[set, set, set] }: ex C being
lattice-wise strict category st (for x being LATTICE holds x is object of C iff
  x is strict & L[x] & the carrier of x in A()) & for a,b being object of C, f
being monotone Function of latt a, latt b holds f in <^a,b^> iff P[latt a, latt
  b, f]
provided
 ex x being strict LATTICE st L[x] & the carrier of x in A() and
 for a,b,c being LATTICE st L[a] & L[b] & L[c] for f being Function
of a,b, g being Function of b,c st P[a,b,f] & P[b,c,g] holds P[a,c,g*f] and
 for a being LATTICE st L[a] holds P[a,a,id a];

scheme 

  CLCatUniq1 { A() -> non empty set, P[set, set, set] }: for C1, C2 being
lattice-wise category st the carrier of C1 = A() & (for a,b being object of C1,
f being monotone Function of latt a, latt b holds f in <^a,b^> iff P[a,b,f]) &
  the carrier of C2 = A() & (for a,b being object of C2, f being monotone
Function of latt a, latt b holds f in <^a,b^> iff P[a,b,f]) holds the AltCatStr
  of C1 = the AltCatStr of C2;

scheme 

  CLCatUniq2 { A() -> non empty set, L[set], P[set, set, set] }: for C1, C2
being lattice-wise category st (for x being LATTICE holds x is object of C1 iff
x is strict & L[x] & the carrier of x in A()) & (for a,b being object of C1, f
being monotone Function of latt a, latt b holds f in <^a,b^> iff P[a,b,f]) & (
  for x being LATTICE holds x is object of C2 iff x is strict & L[x] & the
  carrier of x in A()) & (for a,b being object of C2, f being monotone Function
of latt a, latt b holds f in <^a,b^> iff P[a,b,f]) holds the AltCatStr of C1 =
  the AltCatStr of C2;

scheme 

  CLCovariantFunctorEx { P, Q[set, set, set], A,B() -> lattice-wise category,
  O(set) -> LATTICE, F(set,set,set) -> Function }: ex F being covariant strict
Functor of A(),B() st (for a being object of A() holds F.a = O(latt a)) & for a
,b being object of A() st <^a,b^> <> {} for f being Morphism of a,b holds F.f =
  F(latt a, latt b, @f)
provided
 for a,b being LATTICE, f being Function of a,b holds f in (the
Arrows of A()).(a,b) iff a in the carrier of A() & b in the carrier of A() & P[
a,b,f] and
 for a,b being LATTICE, f being Function of a,b holds f in (the
Arrows of B()).(a,b) iff a in the carrier of B() & b in the carrier of B() & Q[
a,b,f] and
 for a being LATTICE st a in the carrier of A() holds O(a) in the
carrier of B() and
 for a,b being LATTICE, f being Function of a,b st P[a,b,f] holds F(a
,b,f) is Function of O(a),O(b) & Q[O(a),O(b),F(a,b,f)] and
 for a being LATTICE st a in the carrier of A() holds F(a,a,id a) =
id O(a) and
 for a,b,c being LATTICE, f being Function of a,b, g being Function
of b,c st P[a,b,f] & P[b,c,g] holds F(a,c,g*f) = F(b,c,g)*F(a,b,f);

scheme 

  CLContravariantFunctorEx { P, Q[set, set, set], A,B() -> lattice-wise
  category, O(set) -> LATTICE, F(set,set,set) -> Function }: ex F being
contravariant strict Functor of A(),B() st (for a being object of A() holds F.a
  = O(latt a)) & for a,b being object of A() st <^a,b^> <> {} for f being
  Morphism of a,b holds F.f = F(latt a, latt b, @f)
provided
 for a,b being LATTICE, f being Function of a,b holds f in (the
Arrows of A()).(a,b) iff a in the carrier of A() & b in the carrier of A() & P[
a,b,f] and
 for a,b being LATTICE, f being Function of a,b holds f in (the
Arrows of B()).(a,b) iff a in the carrier of B() & b in the carrier of B() & Q[
a,b,f] and
 for a being LATTICE st a in the carrier of A() holds O(a) in the
carrier of B() and
 for a,b being LATTICE, f being Function of a,b st P[a,b,f] holds F(a
,b,f) is Function of O(b),O(a) & Q[O(b),O(a),F(a,b,f)] and
 for a being LATTICE st a in the carrier of A() holds F(a,a,id a) =
id O(a) and
 for a,b,c being LATTICE, f being Function of a,b, g being Function
of b,c st P[a,b,f] & P[b,c,g] holds F(a,c,g*f) = F(a,b,f)*F(b,c,g);

scheme 

  CLCatIsomorphism { P, Q[set, set, set], A,B() -> lattice-wise category, O(
  set) -> LATTICE, F(set,set,set) -> Function }: A(), B() are_isomorphic
provided
 for a,b being LATTICE, f being Function of a,b holds f in (the
Arrows of A()).(a,b) iff a in the carrier of A() & b in the carrier of A() & P[
a,b,f] and
 for a,b being LATTICE, f being Function of a,b holds f in (the
Arrows of B()).(a,b) iff a in the carrier of B() & b in the carrier of B() & Q[
a,b,f] and
 ex F being covariant Functor of A(),B() st (for a being object of A(
) holds F.a = O(a)) & for a,b being object of A() st <^a,b^> <> {} for f being
Morphism of a,b holds F.f = F(a,b,f) and
 for a,b being LATTICE st a in the carrier of A() & b in the carrier
of A() holds O(a) = O(b) implies a = b and
 for a,b being LATTICE for f,g being Function of a,b st P[a,b,f] & P[
a,b,g] holds F(a,b,f) = F(a,b,g) implies f = g and
 for a,b being LATTICE, f being Function of a,b st Q[a,b,f] ex c,d
being LATTICE, g being Function of c,d st c in the carrier of A() & d in the
carrier of A() & P[c,d,g] & a = O(c) & b = O(d) & f = F(c,d,g);

scheme 

  CLCatAntiIsomorphism { P, Q[set, set, set], A,B() -> lattice-wise category,
  O(set) -> LATTICE, F(set,set,set) -> Function }: A(), B() are_anti-isomorphic
provided
 for a,b being LATTICE, f being Function of a,b holds f in (the
Arrows of A()).(a,b) iff a in the carrier of A() & b in the carrier of A() & P[
a,b,f] and
 for a,b being LATTICE, f being Function of a,b holds f in (the
Arrows of B()).(a,b) iff a in the carrier of B() & b in the carrier of B() & Q[
a,b,f] and
 ex F being contravariant Functor of A(),B() st (for a being object
of A() holds F.a = O(a)) & for a,b being object of A() st <^a,b^> <> {} for f
being Morphism of a,b holds F.f = F(a,b,f) and
 for a,b being LATTICE st a in the carrier of A() & b in the carrier
of A() holds O(a) = O(b) implies a = b and
 for a,b being LATTICE, f,g being Function of a,b st F(a,b,f) = F(a,b
,g) holds f = g and
 for a,b being LATTICE, f being Function of a,b st Q[a,b,f] ex c,d
being LATTICE, g being Function of c,d st c in the carrier of A() & d in the
carrier of A() & P[c,d,g] & b = O(c) & a = O(d) & f = F(c,d,g);

begin 

definition
  let C be lattice-wise category;
  attr C is with_all_isomorphisms means


  for a,b being object of C, f
  being Function of latt a, latt b st f is isomorphic holds f in <^a,b^>;
end;

registration
  cluster with_all_isomorphisms for strict lattice-wise category;
end;

theorem 
  for C being with_all_isomorphisms lattice-wise category for a,b
  being object of C for f being Morphism of a,b st @f is isomorphic holds f is
  iso;

theorem 
  for C being lattice-wise category for a,b being object of C st <^a,b^>
  <> {} & <^b,a^> <> {} for f being Morphism of a,b st f is iso holds @f is
  isomorphic;

scheme 

  CLCatEquivalence { P, Q[set, set, set], A,B() -> lattice-wise category, O1,
O2(set) -> LATTICE, F1, F2(set,set,set) -> Function, A, B(set) -> Function }: A
  (), B() are_equivalent
provided
 for a,b being object of A(), f being monotone Function of latt a,
latt b holds f in <^a,b^> iff P[latt a, latt b, f] and
 for a,b being object of B(), f being monotone Function of latt a,
latt b holds f in <^a,b^> iff Q[latt a, latt b, f] and
 ex F being covariant Functor of A(),B() st (for a being object of A(
) holds F.a = O1(a)) & for a,b being object of A() st <^a,b^> <> {} for f being
Morphism of a,b holds F.f = F1(a,b,f) and
 ex G being covariant Functor of B(),A() st (for a being object of B(
) holds G.a = O2(a)) & for a,b being object of B() st <^a,b^> <> {} for f being
Morphism of a,b holds G.f = F2(a,b,f) and
 for a being LATTICE st a in the carrier of A() ex f being monotone
Function of O2(O1(a)), a st f = A(a) & f is isomorphic & P[O2(O1(a)), a, f] & P
[a, O2(O1(a)), f"] and
 for a being LATTICE st a in the carrier of B() ex f being monotone
Function of a, O1(O2(a)) st f = B(a) & f is isomorphic & Q[a, O1(O2(a)), f] & Q
[O1(O2(a)), a, f"] and
 for a,b being object of A() st <^a,b^> <> {} for f being Morphism of
a,b holds A(b)*F2(O1(a),O1(b),F1(a,b,f)) = @f*A(a) and
 for a,b being object of B() st <^a,b^> <> {} for f being Morphism of
a,b holds F1(O2(a),O2(b),F2(a,b,f))*B(a) = B(b)*@f;

begin 

definition
  let R be Relation;
  attr R is upper-bounded means


  ex x st for y st y in field R holds [y ,x] in R;
end;

registration
  cluster well-ordering -> reflexive transitive antisymmetric connected
    well_founded for Relation;
end;

registration
  cluster well-ordering for Relation;
end;

theorem 
  for f being one-to-one Function, R being Relation holds [x,y] in
  f*R*(f") iff x in dom f & y in dom f & [f.x, f.y] in R;

registration
  let f be one-to-one Function;
  let R be reflexive Relation;
  cluster f*R*(f") -> reflexive;
end;

registration
  let f be one-to-one Function;
  let R be antisymmetric Relation;
  cluster f*R*(f") -> antisymmetric;
end;

registration
  let f be one-to-one Function;
  let R be transitive Relation;
  cluster f*R*(f") -> transitive;
end;

theorem 
  for X being set, A being Ordinal st X,A are_equipotent ex R being
  Order of X st R well_orders X & order_type_of R = A;

registration
  let X be non empty set;
  cluster upper-bounded well-ordering for Order of X;
end;

theorem 
  for P being reflexive non empty RelStr holds P is upper-bounded
  iff the InternalRel of P is upper-bounded;

theorem 
  for P being upper-bounded non empty Poset st the InternalRel of
  P is well-ordering holds P is connected complete continuous;

theorem 
  for P being upper-bounded non empty Poset st the InternalRel
of P is well-ordering for x,y being Element of P st y < x ex z being Element of
  P st z is compact & y <= z & z <= x;

theorem 
  for P being upper-bounded non empty Poset st the InternalRel
  of P is well-ordering holds P is algebraic;

registration
  let X be non empty set;
  let R be upper-bounded well-ordering Order of X;
  cluster RelStr(#X,R#) -> complete connected continuous algebraic;
end;

definition
  let W be non empty set;
  given w being Element of W such that
 w is non empty;
  func W-UPS_category -> lattice-wise strict category means


  (for x
being LATTICE holds x is object of it iff x is strict complete & the carrier of
x in W) & for a,b being object of it, f being monotone Function of latt a, latt
  b holds f in <^a,b^> iff f is directed-sups-preserving;
end;

registration
  let W be with_non-empty_element set;
  cluster W-UPS_category -> with_complete_lattices with_all_isomorphisms;
end;

theorem 
  for W being with_non-empty_element set holds the carrier of W
  -UPS_category c= POSETS W;

theorem 
  for W being with_non-empty_element set for x holds x is object
  of W-UPS_category iff x is complete LATTICE & x in POSETS W;

theorem 
  for W being with_non-empty_element set for L being LATTICE st
  the carrier of L in W holds L is object of W-UPS_category iff L is strict
  complete;

theorem 
  for W being with_non-empty_element set for a,b being object of W
  -UPS_category for f being set holds f in <^a,b^> iff f is
  directed-sups-preserving Function of latt a, latt b;

registration
  let W be with_non-empty_element set;
  let a,b be object of W-UPS_category;
  cluster <^a,b^> -> non empty;
end;

begin

registration
  let A be set-id-inheriting category;
  cluster -> set-id-inheriting for non empty subcategory of A;
end;

registration
  let A be para-functional category;
  cluster -> para-functional for non empty subcategory of A;
end;

registration
  let A be semi-functional category;
  cluster -> semi-functional for non empty transitive SubCatStr of A;
end;

registration
  let A be carrier-underlaid category;
  cluster -> carrier-underlaid for non empty subcategory of A;
end;

registration
  let A be lattice-wise category;
  cluster -> lattice-wise for non empty subcategory of A;
end;

registration
  let A be with_all_isomorphisms lattice-wise category;
  cluster full -> with_all_isomorphisms for non empty subcategory of A;
end;

registration
  let A be with_complete_lattices category;
  cluster -> with_complete_lattices for non empty subcategory of A;
end;

definition
  let W be with_non-empty_element set;
  func W-CONT_category -> strict full non empty subcategory of W-UPS_category
  means


  for a being object of W-UPS_category holds a is object of it iff
  latt a is continuous;
end;

definition
  let W be with_non-empty_element set;
  func W-ALG_category -> strict full non empty subcategory of W-CONT_category
  means


  for a being object of W-CONT_category holds a is object of it
  iff latt a is algebraic;
end;

theorem 
  for W being with_non-empty_element set for L being LATTICE st
  the carrier of L in W holds L is object of W-CONT_category iff L is strict
  complete continuous;

theorem 
  for W being with_non-empty_element set for L being LATTICE st the
carrier of L in W holds L is object of W-ALG_category iff L is strict complete
  algebraic;

theorem 
  for W being with_non-empty_element set for a,b being object of W
  -CONT_category for f being set holds f in <^a,b^> iff f is
  directed-sups-preserving Function of latt a, latt b;

theorem 
  for W being with_non-empty_element set for a,b being object of W
  -ALG_category for f being set holds f in <^a,b^> iff f is
  directed-sups-preserving Function of latt a, latt b;

registration
  let W be with_non-empty_element set;
  let a,b be object of W-CONT_category;
  cluster <^a,b^> -> non empty;
end;

registration
  let W be with_non-empty_element set;
  let a,b be object of W-ALG_category;
  cluster <^a,b^> -> non empty;
end;














begin



registration
  let S,T be complete LATTICE;
  cluster Galois for Connection of S,T;
end;

theorem 
  for S,T, S9,T9 being non empty RelStr
  st the RelStr of S = the RelStr of S9 & the RelStr of T = the RelStr of T9
  for c being Connection of S,T, c9 being Connection of S9,T9 st c = c9
  holds c is Galois implies c9 is Galois;

definition
  let S,T be LATTICE;
  let g be Function of S,T;
  assume that
 S is complete and
 g is infs-preserving;
  func LowerAdj g -> Function of T,S means


  [g, it] is Galois;
end;

definition
  let S,T be LATTICE;
  let d be Function of T,S;
  assume that
 T is complete and
 d is sups-preserving;
  func UpperAdj d -> Function of S,T means


  [it, d] is Galois;
end;

registration
  let S,T be complete LATTICE;
  let g be infs-preserving Function of S,T;
  cluster LowerAdj g -> lower_adjoint;
end;

registration
  let S,T be complete LATTICE;
  let d be sups-preserving Function of T,S;
  cluster UpperAdj d -> upper_adjoint;
end;

theorem 
  for S,T being complete LATTICE for g being infs-preserving Function of S,T
  for t being Element of T holds (LowerAdj g).t = inf (g"uparrow t);

theorem 
  for S,T being complete LATTICE for d being sups-preserving Function of T,S
  for s being Element of S holds (UpperAdj d).s = sup (d"downarrow s);

definition
  let S,T be RelStr;
  let f be Function of the carrier of S, the carrier of T;
  func f opp -> Function of S opp, T opp equals

  f;
end;

registration
  let S,T be complete LATTICE;
  let g be infs-preserving Function of S,T;
  cluster g opp -> lower_adjoint;
end;

registration
  let S,T be complete LATTICE;
  let d be sups-preserving Function of S,T;
  cluster d opp -> upper_adjoint;
end;

theorem 
  for S,T being complete LATTICE for g being infs-preserving Function of S, T
  holds LowerAdj g = UpperAdj (g opp);

theorem 
  for S,T being complete LATTICE for d being sups-preserving Function of S, T
  holds LowerAdj (d opp) = UpperAdj d;

theorem 
  for L be non empty RelStr holds [id L, id L] is Galois;

theorem 

  for L being complete LATTICE holds
  LowerAdj id L = id L & UpperAdj id L = id L;

theorem 

  for L1,L2,L3 being complete LATTICE
  for g1 being infs-preserving Function of L1,L2
  for g2 being infs-preserving Function of L2,L3 holds
  LowerAdj (g2*g1) = (LowerAdj g1)*(LowerAdj g2);

theorem 

  for L1,L2,L3 being complete LATTICE
  for d1 being sups-preserving Function of L1,L2
  for d2 being sups-preserving Function of L2,L3 holds
  UpperAdj (d2*d1) = (UpperAdj d1)*(UpperAdj d2);

theorem 
  for S,T being complete LATTICE for g being infs-preserving Function of S,T
  holds UpperAdj LowerAdj g = g;

theorem 
  for S,T being complete LATTICE for d being sups-preserving Function of S,T
  holds LowerAdj UpperAdj d = d;

theorem 
  for C being non empty AltCatStr
  for a,b,f being set st f in (the Arrows of C).(a,b)
  ex o1,o2 being object of C
  st o1 = a & o2 = b & f in <^o1,o2^> & f is Morphism of o1,o2;

definition 
  let W be non empty set;
  given w being Element of W such that
 w is non empty;
  func W-INF_category -> lattice-wise strict category means


   (for x being LATTICE holds
  x is object of it iff x is strict complete & the carrier of x in W) &
  for a,b being object of it, f being monotone Function of latt a, latt b
  holds f in <^a,b^> iff f is infs-preserving;
end;

definition 
  let W be non empty set;
  given w being Element of W such that
 w is non empty;
  func W-SUP_category -> lattice-wise strict category means


   (for x being LATTICE holds
  x is object of it iff x is strict complete & the carrier of x in W) &
  for a,b being object of it, f being monotone Function of latt a, latt b
  holds f in <^a,b^> iff f is sups-preserving;
end;

registration
  let W be with_non-empty_element set;
  cluster W-INF_category -> with_complete_lattices;
  cluster W-SUP_category -> with_complete_lattices;
end;

theorem 
  for W being with_non-empty_element set for L being LATTICE holds
  L is object of W-INF_category iff
  L is strict complete & the carrier of L in W;

theorem 
  for W being with_non-empty_element set
  for a, b being object of W-INF_category for f being set
  holds f in <^a,b^> iff f is infs-preserving Function of latt a, latt b;

theorem 
  for W being with_non-empty_element set for L being LATTICE holds
  L is object of W-SUP_category iff
  L is strict complete & the carrier of L in W;

theorem 
  for W being with_non-empty_element set
  for a, b being object of W-SUP_category for f being set
  holds f in <^a,b^> iff f is sups-preserving Function of latt a, latt b;

theorem 
  for W being with_non-empty_element set holds
  the carrier of W-INF_category = the carrier of W-SUP_category;

definition 
  let W be with_non-empty_element set;
  func W LowerAdj ->
  contravariant strict Functor of W-INF_category, W-SUP_category means


   (for a being object of W-INF_category holds it.a = latt a) &
  for a,b being object of W-INF_category st <^a,b^> <> {}
  for f being Morphism of a,b holds it.f = LowerAdj @f;
  func W UpperAdj ->
  contravariant strict Functor of W-SUP_category, W-INF_category means


   (for a being object of W-SUP_category holds it.a = latt a) &
  for a,b being object of W-SUP_category st <^a,b^> <> {}
  for f being Morphism of a,b holds it.f = UpperAdj @f;
end;

registration
  let W be with_non-empty_element set;
  cluster W LowerAdj -> bijective;
  cluster W UpperAdj -> bijective;
end;

theorem 
  for W being with_non-empty_element set
  holds W LowerAdj" = W UpperAdj & W UpperAdj" = W LowerAdj;

theorem 
  for W being with_non-empty_element set holds
  (W LowerAdj)*(W UpperAdj) = id (W-SUP_category) &
  (W UpperAdj)*(W LowerAdj) = id (W-INF_category);

theorem 
  for W being with_non-empty_element set holds
  W-INF_category, W-SUP_category are_anti-isomorphic;

begin



theorem 
  for S,T being complete LATTICE, g being infs-preserving Function of S,T
  holds g is directed-sups-preserving iff
  for X being Scott TopAugmentation of T
  for Y being Scott TopAugmentation of S for V being open Subset of X holds
  uparrow ((LowerAdj g).:V) is open Subset of Y;

definition
  let S,T be non empty reflexive RelStr;
  let f be Function of S,T;
  attr f is waybelow-preserving means


   for x,y being Element of S st x << y holds f.x << f.y;
end;

theorem 
  for S,T being complete LATTICE, g being infs-preserving Function of S,T holds
  g is directed-sups-preserving implies LowerAdj g is waybelow-preserving;

theorem 
  for S being complete LATTICE for T being complete continuous LATTICE
  for g being infs-preserving Function of S,T
  st LowerAdj g is waybelow-preserving holds g is directed-sups-preserving;

definition
  let S,T be TopSpace;
  let f be Function of S,T;
  attr f is relatively_open means


   for V being open Subset of S holds f.:V is open Subset of T|rng f;
end;

theorem 
  for X,Y being non empty TopSpace for d being Function of X, Y holds
  d is relatively_open iff corestr d is open;

theorem 
  for S,T being complete LATTICE, g being infs-preserving Function of S,T
  for X being Scott TopAugmentation of T
  for Y being Scott TopAugmentation of S for V being open Subset of X holds
  (LowerAdj g).:V = (rng LowerAdj g) /\ uparrow ((LowerAdj g).:V);

theorem 
  for S,T being complete LATTICE, g being infs-preserving Function of S,T
  for X being Scott TopAugmentation of T
  for Y being Scott TopAugmentation of S st for V being open Subset of X holds
  uparrow ((LowerAdj g).:V) is open Subset of Y holds
  for d being Function of X, Y st d = LowerAdj g holds d is relatively_open;

registration
  let X,Y be complete LATTICE;
  let f be sups-preserving Function of X,Y;
  cluster Image f -> complete;
end;

theorem 
  for S,T being complete LATTICE, g being infs-preserving Function of S,T
  for X being Scott TopAugmentation of T
  for Y being Scott TopAugmentation of S
  for Z being Scott TopAugmentation of Image LowerAdj g
  for d being Function of X, Y, d9 being Function
  of X, Z st d = LowerAdj g & d9 = d
  holds d is relatively_open implies d9 is open;

theorem 
  for S,T being complete LATTICE, g being infs-preserving Function of S,T
  st g is one-to-one for X being Scott TopAugmentation of T
  for Y being Scott TopAugmentation of S
  for d being Function of X,Y st d = LowerAdj g holds
  g is directed-sups-preserving iff d is open;

registration
  let X be complete LATTICE;
  let f be projection Function of X,X;
  cluster Image f -> complete;
end;

theorem 
  for L being complete LATTICE, k being kernel Function of L,L holds
  corestr k is infs-preserving & inclusion k is sups-preserving &
  LowerAdj corestr k = inclusion k & UpperAdj inclusion k = corestr k;

theorem 
  for L being complete LATTICE, k being kernel Function of L,L holds
  k is directed-sups-preserving iff corestr k is directed-sups-preserving;

theorem 
  for L being complete LATTICE, k being kernel Function of L,L holds
  k is directed-sups-preserving iff
  for X being Scott TopAugmentation of Image k
  for Y being Scott TopAugmentation of L
  for V being Subset of L st V is open Subset of X
  holds uparrow V is open Subset of Y;

theorem 
  for L being complete LATTICE
  for S being sups-inheriting non empty full SubRelStr of L
  for x,y being Element of L, a,b being Element of S st a = x & b = y
  holds x << y implies a << b;

theorem 
  for L being complete LATTICE, k being kernel Function of L,L
  st k is directed-sups-preserving
  for x,y being Element of L, a,b being Element of Image k st a = x & b = y
  holds x << y iff a << b;

theorem 
  for L being complete LATTICE, k being kernel Function of L,L
  st Image k is continuous &
  for x,y being Element of L, a,b being Element of Image k st a = x & b = y
  holds x << y iff a << b holds k is directed-sups-preserving;

theorem 
  for L being complete LATTICE, c being closure Function of L,L holds
  corestr c is sups-preserving & inclusion c is infs-preserving &
  UpperAdj corestr c = inclusion c & LowerAdj inclusion c = corestr c;

theorem 
  for L being complete LATTICE, c being closure Function of L,L holds
  Image c is directed-sups-inheriting iff
  inclusion c is directed-sups-preserving;

theorem 
  for L being complete LATTICE, c being closure Function of L,L holds
  Image c is directed-sups-inheriting iff
  for X being Scott TopAugmentation of Image c
  for Y being Scott TopAugmentation of L
  for f being Function of Y,X st f = c holds f is open;

theorem 
  for L being complete LATTICE, c being closure Function of L,L holds
  Image c is directed-sups-inheriting implies corestr c is waybelow-preserving;

theorem 






  for L being continuous complete LATTICE, c being closure Function of L,L st
  corestr c is waybelow-preserving holds Image c is directed-sups-inheriting;

begin



definition 
  let W be non empty set;
  func W-INF(SC)_category -> strict non empty subcategory of W-INF_category
  means


   (for a being object of W-INF_category holds a is object of it) &
  for a,b being object of W-INF_category
  for a9,b9 being object of it st a9 = a & b9 = b & <^a,b^> <> {}
  for f being Morphism of a,b holds
  f in <^a9,b9^> iff @f is directed-sups-preserving;
end;

definition 
  let W be with_non-empty_element set;
  func W-SUP(SO)_category -> strict non empty subcategory of W-SUP_category
  means


   (for a being object of W-SUP_category holds a is object of it) &
  for a,b being object of W-SUP_category
  for a9,b9 being object of it st a9 = a & b9 = b & <^a,b^> <> {}
  for f being Morphism of a,b holds
  f in <^a9,b9^> iff UpperAdj @f is directed-sups-preserving;
end;

theorem 
for S being non empty RelStr, T being non empty reflexive antisymmetric RelStr
  for t being Element of T for X being non empty Subset of S
  holds S --> t preserves_sup_of X & S --> t preserves_inf_of X;

theorem 
  for S being non empty RelStr
  for T being lower-bounded non empty reflexive antisymmetric RelStr
  holds S --> Bottom T is sups-preserving;

theorem 
  for S being non empty RelStr
  for T being upper-bounded non empty reflexive antisymmetric RelStr
  holds S --> Top T is infs-preserving;

registration 
  let S be non empty RelStr;
  let T be upper-bounded non empty reflexive antisymmetric RelStr;
  cluster S --> Top T -> directed-sups-preserving infs-preserving;
end;

registration
  let S be non empty RelStr;
  let T be lower-bounded non empty reflexive antisymmetric RelStr;
  cluster S --> Bottom T -> filtered-infs-preserving sups-preserving;
end;

registration
  let S be non empty RelStr;
  let T be upper-bounded non empty reflexive antisymmetric RelStr;
  cluster directed-sups-preserving infs-preserving for Function of S, T;
end;

registration
  let S be non empty RelStr;
  let T be lower-bounded non empty reflexive antisymmetric RelStr;
  cluster filtered-infs-preserving sups-preserving for Function of S, T;
end;

theorem 
  for W being with_non-empty_element set for L being LATTICE holds
  L is object of W-INF(SC)_category iff
  L is strict complete & the carrier of L in W;

theorem 
  for W being with_non-empty_element set
  for a, b being object of W-INF(SC)_category for f being set
  holds f in <^a,b^> iff
  f is directed-sups-preserving infs-preserving Function of latt a, latt b;

theorem 
  for W being with_non-empty_element set for L being LATTICE holds
  L is object of W-SUP(SO)_category iff
  L is strict complete & the carrier of L in W;

theorem 
  for W being with_non-empty_element set
  for a, b being object of W-SUP(SO)_category for f being set
  holds f in <^a,b^> iff
  ex g being sups-preserving Function of latt a, latt b st g = f &
  UpperAdj g is directed-sups-preserving;

theorem 
  for W being with_non-empty_element set
  holds W-INF(SC)_category = Intersect(W-INF_category, W-UPS_category);

definition 
  let W be with_non-empty_element set;
  func W-CL_category -> strict full non empty subcategory of W-INF(SC)_category
  means


  for a being object of W-INF(SC)_category holds
  a is object of it iff latt a is continuous;
end;

registration
  let W be with_non-empty_element set;
  cluster W-CL_category -> with_complete_lattices;
end;

theorem 
  for W being with_non-empty_element set
  for L being LATTICE st the carrier of L in W
  holds L is object of W-CL_category iff L is strict complete continuous;

theorem 
  for W being with_non-empty_element set for a,b being object of W-CL_category
  for f being set holds f in <^a,b^> iff
  f is infs-preserving directed-sups-preserving Function of latt a, latt b;

definition 
  let W be with_non-empty_element set;
  func W-CL-opp_category ->
  strict full non empty subcategory of W-SUP(SO)_category means


   for a being object of W-SUP(SO)_category holds
  a is object of it iff latt a is continuous;
end;

theorem 
  for W being with_non-empty_element set
  for L being LATTICE st the carrier of L in W
  holds L is object of W-CL-opp_category iff L is strict complete continuous;

theorem 
  for W being with_non-empty_element set
  for a, b being object of W-CL-opp_category for f being set
  holds f in <^a,b^> iff
  ex g being sups-preserving Function of latt a, latt b st g = f &
  UpperAdj g is directed-sups-preserving;



theorem 
  for W being with_non-empty_element set holds
  W-INF(SC)_category, W-SUP(SO)_category are_anti-isomorphic_under W LowerAdj;

theorem 
  for W being with_non-empty_element set holds
  W-SUP(SO)_category, W-INF(SC)_category are_anti-isomorphic_under W UpperAdj;

theorem 
  for W being with_non-empty_element set holds
  W-CL_category, W-CL-opp_category are_anti-isomorphic_under W LowerAdj;

theorem 
  for W being with_non-empty_element set holds
  W-CL-opp_category, W-CL_category are_anti-isomorphic_under W UpperAdj;

begin



definition
  let S,T be non empty reflexive RelStr;
  let f be Function of S,T;
  attr f is compact-preserving means

  for s being Element of S st s is compact holds f.s is compact;
end;

theorem 
  for S,T being complete LATTICE, d being sups-preserving Function of T,S
  st d is waybelow-preserving holds d is compact-preserving;

theorem 
  for S,T being complete LATTICE, d being sups-preserving Function of T,S
  st T is algebraic & d is compact-preserving holds d is waybelow-preserving;

theorem 
  for R,S,T being non empty RelStr, X being Subset of R
  for f being Function of R,S for g being Function of S,T
  st f preserves_sup_of X & g preserves_sup_of f.:X
  holds g*f preserves_sup_of X;

definition
  let S,T be non empty RelStr;
  let f be Function of S,T;
  attr f is finite-sups-preserving means

  for X being finite Subset of S holds f preserves_sup_of X;
  attr f is bottom-preserving means


  f preserves_sup_of {}S;
end;

theorem 
  for R,S,T being non empty RelStr
  for f being Function of R,S for g being Function of S,T
  st f is finite-sups-preserving & g is finite-sups-preserving
  holds g*f is finite-sups-preserving;

definition
  let S,T be non empty antisymmetric lower-bounded RelStr;
  let f be Function of S,T;
  redefine attr f is bottom-preserving means


  f.Bottom S = Bottom T;
end;

definition
  let L be non empty RelStr;
  let S be SubRelStr of L;
  attr S is finite-sups-inheriting means


   for X being finite Subset of S st ex_sup_of X,L
  holds "\/"(X,L) in the carrier of S;
  attr S is bottom-inheriting means


  Bottom L in the carrier of S;
end;

registration
  let S,T be non empty RelStr;
  cluster sups-preserving -> bottom-preserving for Function of S,T;
end;

registration
  let L be lower-bounded antisymmetric non empty RelStr;
  cluster finite-sups-inheriting ->
    bottom-inheriting join-inheriting for SubRelStr of L;
end;

registration
  let L be non empty RelStr;
  cluster sups-inheriting -> finite-sups-inheriting for SubRelStr of L;
end;

registration
  let S,T be lower-bounded non empty Poset;
  cluster sups-preserving for Function of S,T;
end;

registration
  let L be lower-bounded antisymmetric non empty RelStr;
  cluster bottom-inheriting -> non empty lower-bounded for
full SubRelStr of L;
end;

registration
  let L be lower-bounded antisymmetric non empty RelStr;
  cluster non empty sups-inheriting finite-sups-inheriting bottom-inheriting
    full for SubRelStr of L;
end;

theorem 
  for L being lower-bounded antisymmetric non empty RelStr
  for S being non empty bottom-inheriting full SubRelStr of L
  holds Bottom S = Bottom L;

registration
  let L be with_suprema lower-bounded non empty Poset;
  cluster bottom-inheriting join-inheriting -> finite-sups-inheriting
    for full SubRelStr of L;
end;

theorem 
  for S,T being non empty RelStr, f being Function of S,T
  st f is finite-sups-preserving holds f is join-preserving bottom-preserving;

theorem 
  for S,T being lower-bounded with_suprema Poset, f being Function of S,T
  st f is join-preserving bottom-preserving holds f is finite-sups-preserving;

registration
  let S,T be non empty RelStr;
  cluster sups-preserving -> finite-sups-preserving for Function of S,T;
  cluster finite-sups-preserving ->
    join-preserving bottom-preserving for Function of S,T;
end;

registration
  let S be non empty RelStr;
  let T be lower-bounded non empty reflexive antisymmetric RelStr;
  cluster sups-preserving finite-sups-preserving for Function of S,T;
end;

registration 
  let L be lower-bounded non empty Poset;
  cluster CompactSublatt L -> lower-bounded;
end;

theorem 
  for S being RelStr, T being non empty RelStr, f being Function of S,T
  for S9 being SubRelStr of S for T9 being SubRelStr of T
  st f.:the carrier of S9 c= the carrier of T9
  holds f|the carrier of S9 is Function of S9, T9;

theorem 
  for S,T being LATTICE, f being join-preserving Function of S,T
  for S9 being non empty join-inheriting full SubRelStr of S
  for T9 being non empty join-inheriting full SubRelStr of T
  for g being Function of S9, T9 st g = f|the carrier of S9
  holds g is join-preserving;

theorem 
  for S,T being lower-bounded LATTICE
  for f being finite-sups-preserving Function of S,T
  for S9 being non empty finite-sups-inheriting full SubRelStr of S
  for T9 being non empty finite-sups-inheriting full SubRelStr of T
  for g being Function of S9, T9 st g = f|the carrier of S9
  holds g is finite-sups-preserving;

registration
  let L be complete LATTICE;
  cluster CompactSublatt L -> finite-sups-inheriting;
end;

theorem 
  for S,T being complete LATTICE
  for d being sups-preserving Function of T,S holds d is compact-preserving
  iff d|the carrier of CompactSublatt T is
  finite-sups-preserving Function of CompactSublatt T, CompactSublatt S;

theorem 
  for S,T being complete LATTICE st T is algebraic
  for g being infs-preserving Function of S,T holds
  g is directed-sups-preserving iff
  (LowerAdj g)|the carrier of CompactSublatt T is
  finite-sups-preserving Function of CompactSublatt T, CompactSublatt S;














begin  

reserve n for Element of NAT;

theorem 
  for f,g be FinSequence of TOP-REAL 2 st f is_in_the_area_of g for
  p be Element of TOP-REAL 2 st p in rng f holds f-:p is_in_the_area_of g;

theorem 
  for f,g be FinSequence of TOP-REAL 2 st f is_in_the_area_of g for
  p be Element of TOP-REAL 2 st p in rng f holds f:-p is_in_the_area_of g;

theorem 
  for f be FinSequence of TOP-REAL 2 for p be Point of TOP-REAL 2 st p
  in L~f holds L_Cut (f,p) <> {};

theorem 
  for f be FinSequence of TOP-REAL 2 for p be Point of TOP-REAL 2 st p
  in L~f & len R_Cut(f,p) >= 2 holds f.1 in L~R_Cut(f,p);

theorem 
  for f be FinSequence of TOP-REAL 2 st f is being_S-Seq for p be
  Point of TOP-REAL 2 st p in L~f holds not f.1 in L~mid(f,Index(p,f)+1,len f);

theorem 
  for i,j,m,n be Element of NAT holds i+j = m+n & i <= m & j <= n implies i = m
;

theorem 
  for f be FinSequence of TOP-REAL 2 st f is being_S-Seq for p be Point
  of TOP-REAL 2 st p in L~f & f.1 in L~L_Cut(f,p) holds f.1 = p;

begin  

definition
  let C be compact non vertical non horizontal Subset of TOP-REAL 2;
  let n be Nat;
  func Upper_Seq(C,n) -> FinSequence of TOP-REAL 2 equals

  Rotate(Cage(C,n),
  W-min L~Cage(C,n))-:E-max L~Cage(C,n);
end;

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL
2 for n be Nat holds len Upper_Seq(C,n) = (E-max L~Cage(C,n))..Rotate(Cage(C,n)
  ,W-min L~Cage(C,n));

definition
  let C be compact non vertical non horizontal Subset of TOP-REAL 2;
  let n be Nat;
  func Lower_Seq(C,n) -> FinSequence of TOP-REAL 2 equals

  Rotate(Cage(C,n),
  W-min L~Cage(C,n)):-E-max L~Cage(C,n);
end;

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL
2 for n be Nat holds len Lower_Seq(C,n) = len Rotate(Cage(C,n),W-min L~Cage(C,n
  ))- (E-max L~Cage(C,n))..Rotate(Cage(C,n),W-min L~Cage(C,n))+1;

registration
  let C be compact non vertical non horizontal Subset of TOP-REAL 2;
  let n be Nat;
  cluster Upper_Seq(C,n) -> non empty;
  cluster Lower_Seq(C,n) -> non empty;
end;

registration
  let C be compact non vertical non horizontal Subset of TOP-REAL 2;
  let n be Element of NAT;
  cluster Upper_Seq(C,n) -> one-to-one special unfolded s.n.c.;
  cluster Lower_Seq(C,n) -> one-to-one special unfolded s.n.c.;
end;

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL
  2 for n be Element of NAT holds len Upper_Seq(C,n) + len Lower_Seq(C,n) = len
  Cage(C,n)+1;

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL
2 for n be Element of NAT holds Rotate(Cage(C,n),W-min L~Cage(C,n)) = Upper_Seq
  (C,n) ^' Lower_Seq(C,n);

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL 2 for
  n be Element of NAT holds L~Cage(C,n) = L~(Upper_Seq(C,n) ^' Lower_Seq(C,n));

theorem 
  for C be compact non vertical non horizontal non empty Subset of
  TOP-REAL 2 for n be Element of NAT holds L~Cage(C,n) = L~Upper_Seq(C,n) \/ L~
  Lower_Seq(C,n);

theorem 
  for P be Simple_closed_curve holds W-min(P) <> E-min(P);

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL
2 for n be Element of NAT holds len Upper_Seq(C,n) >= 3 & len Lower_Seq(C,n) >=
  3;

registration
  let C be compact non vertical non horizontal Subset of TOP-REAL 2;
  let n be Element of NAT;
  cluster Upper_Seq(C,n) -> being_S-Seq;
  cluster Lower_Seq(C,n) -> being_S-Seq;
end;

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL 2 for
n be Element of NAT holds L~Upper_Seq(C,n) /\ L~Lower_Seq(C,n) = {W-min L~Cage(
  C,n),E-max L~Cage(C,n)};

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL 2
  holds Upper_Seq(C,n) is_in_the_area_of Cage(C,n);

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL 2
  holds Lower_Seq(C,n) is_in_the_area_of Cage(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
  TOP-REAL 2 holds (Cage(C,n)/.2)`2 = N-bound L~Cage(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for k be Element of NAT st 1 <= k & k+1 <= len Cage(C,n) & Cage(C,n)
  /.k = E-max L~Cage(C,n) holds (Cage(C,n)/.(k+1))`1 = E-bound L~Cage(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for k be Element of NAT st 1 <= k & k+1 <= len Cage(C,n) & Cage(C,n)
  /.k = S-max L~Cage(C,n) holds (Cage(C,n)/.(k+1))`2 = S-bound L~Cage(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for k be Element of NAT st 1 <= k & k+1 <= len Cage(C,n) & Cage(C,n)
  /.k = W-min L~Cage(C,n) holds (Cage(C,n)/.(k+1))`1 = W-bound L~Cage(C,n);














begin 

reserve o1,o2 for Ordinal;

notation
  let L1,L2 be non empty doubleLoopStr;
  synonym L1,L2 are_isomorphic for L1 is_ringisomorph_to L2;
end;

definition
  let L1,L2 be non empty doubleLoopStr;
  redefine pred L1 is_ringisomorph_to L2;
  reflexivity;
end;

theorem 
  for B be set st for x be set holds x in B iff ex o be Ordinal st
  x=o1+^o & o in o2 holds o1+^o2 = o1 \/ B;

registration
  let o1 be Ordinal, o2 be non empty Ordinal;
  cluster o1 +^ o2 -> non empty;
  cluster o2 +^ o1 -> non empty;
end;

theorem 
  for n being Ordinal, a,b being bag of n st a < b ex o being
  Ordinal st o in n & a.o < b.o & for l being Ordinal st l in o holds a.l = b.l
;

begin 

definition
  let o1,o2 be Ordinal;
  let a be Element of Bags o1,b be Element of Bags o2;
  func a +^ b -> Element of Bags (o1+^o2) means


  for o be Ordinal holds
  (o in o1 implies it.o = a.o) & (o in (o1+^o2) \ o1 implies it.o=b.(o-^o1));
end;

theorem 
  for a be Element of Bags o1,b be Element of Bags o2 st o2 = {}
  holds a +^ b = a;

theorem 
  for a be Element of Bags o1,b be Element of Bags o2 st o1 = {} holds a
  +^ b = b;

theorem 
  for b1 be Element of Bags o1,b2 be Element of Bags o2 holds b1+^
  b2 = EmptyBag(o1+^o2) iff b1 = EmptyBag o1 & b2 = EmptyBag o2;

theorem 
  for c be Element of Bags (o1+^o2) ex c1 be Element of Bags o1, c2
  be Element of Bags o2 st c = c1+^c2;

theorem 
  for b1,c1 be Element of Bags o1 for b2,c2 be Element of Bags o2
  st b1+^b2 = c1+^c2 holds b1=c1 & b2=c2;

theorem 
  for n being Ordinal, L being Abelian add-associative right_zeroed
right_complementable distributive associative non empty doubleLoopStr, p, q,
  r being Series of n, L holds (p+q)*'r = p*'r+q*'r;

begin 

registration
  let n be Ordinal, L be right_zeroed Abelian add-associative
  right_complementable well-unital distributive associative non trivial non
  empty doubleLoopStr;
  cluster Polynom-Ring (n, L) -> non trivial distributive;
end;

definition
  let o1,o2 be non empty Ordinal, L be right_zeroed add-associative
  right_complementable well-unital distributive non trivial
  doubleLoopStr;
  let P be Polynomial of o1,Polynom-Ring(o2,L);
  func Compress P -> Polynomial of o1+^o2,L means


  for b be Element of
  Bags (o1+^o2) ex b1 be Element of Bags o1, b2 be Element of Bags o2, Q1 be
  Polynomial of o2,L st Q1 = P.b1 & b = b1+^b2 & it.b = Q1.b2;
end;

theorem 
  for b1,c1 being Element of Bags o1, b2,c2 being Element of Bags
  o2 st b1 divides c1 & b2 divides c2 holds b1 +^ b2 divides c1 +^ c2;

theorem 
  for b being bag of (o1+^o2), b1 being Element of Bags o1, b2
being Element of Bags o2 st b divides b1 +^ b2 ex c1 being Element of Bags o1,
  c2 being Element of Bags o2 st c1 divides b1 & c2 divides b2 & b = c1 +^ c2;

theorem 
  for a1,b1 being Element of Bags o1, a2,b2 being Element of Bags
  o2 holds a1 +^ a2 < b1 +^ b2 iff a1 < b1 or a1 = b1 & a2 < b2;

theorem 
  for b1 being Element of Bags o1, b2 being Element of Bags o2 for
G being FinSequence of (Bags(o1+^o2))* st dom G = dom divisors b1 & for i being
  Nat st i in dom divisors b1 holds ex a19 being Element of Bags o1, Fk being
  FinSequence of Bags(o1+^o2) st Fk = G/.i & (divisors b1)/.i = a19 & len Fk =
len divisors b2 & for m being Nat st m in dom Fk ex a199 being Element of Bags
  o2 st (divisors b2)/.m = a199 & Fk/.m = a19+^a199 holds divisors(b1+^b2) =
  FlattenSeq G;

theorem 
  for a1,b1,c1 being Element of Bags o1, a2,b2,c2 being Element of
Bags o2 st c1 = b1 -' a1 & c2 = b2 -' a2 holds (b1 +^ b2) -' (a1 +^ a2) = c1 +^
  c2;

theorem 
  for b1 being Element of Bags o1, b2 being Element of Bags o2 for
  G being FinSequence of (2-tuples_on Bags(o1+^o2))* st dom G = dom decomp b1 &
  for i being Nat st i in dom decomp b1 holds ex a19, b19 being Element of Bags
o1, Fk being FinSequence of 2-tuples_on Bags(o1+^o2) st Fk = G/.i & (decomp b1)
/.i = <*a19, b19*> & len Fk = len decomp b2 & for m being Nat st m in dom Fk ex
a199,b199 being Element of Bags o2 st (decomp b2)/.m = <*a199, b199*> & Fk/.m =
  <*a19+^a199,b19+^b199*> holds decomp(b1+^b2) = FlattenSeq G;

theorem 
  for o1,o2 be non empty Ordinal, L be Abelian right_zeroed
  add-associative right_complementable well-unital distributive associative
  well-unital non trivial doubleLoopStr holds Polynom-Ring (o1,
  Polynom-Ring(o2,L)),Polynom-Ring (o1+^o2,L) are_isomorphic;














begin 

definition
  let D be set;
  let p be FinSequence of D;
  let i,j be Nat;
  func Del(p,i,j) -> FinSequence of D equals

  (p|(i -' 1))^(p/^j);
end;

theorem 
  for D being set,p being FinSequence of D,i,j being Element of NAT
  holds rng Del(p,i,j) c= rng p;

theorem 
  for D being set,p being FinSequence of D,i,j being Element of NAT
  st i in dom p & j in dom p holds len Del(p,i,j) = len p - j + i - 1;

theorem 
  for D being set,p being FinSequence of D,i,j being Element of NAT
  st i in dom p & j in dom p holds len Del(p,i,j) = 0 implies i=1 & j=len p;

theorem 
  for D being set,p being FinSequence of D,i,j,k being Element of
  NAT st i in dom p & 1 <= k & k <= i-1 holds Del(p,i,j).k = p.k;

theorem 
  for p,q being FinSequence, k being Element of NAT holds len p + 1
  <= k implies (p^q).k=q.(k-len p);

theorem 
  for D being set,p being FinSequence of D,i,j,k being Element of
NAT st i in dom p & j in dom p & i <= j & i <= k & k <= len p - j + i - 1 holds
  Del(p,i,j).k = p.(j -'i + k + 1);

scheme 

  FinSeqOneToOne{X,Y,D()->set,f()-> FinSequence of D(),P[set,set]}: ex g being
  one-to-one FinSequence of D() st X() = g.1 & Y()=g.len g & rng g c= rng f() &
  for j being Element of NAT st 1 <= j & j < len g holds P[g.j,g.(j+1)]
provided
 X() = f().1 & Y()=f().len f() and
 for i being Element of NAT, d1,d2 being set st 1 <= i & i < len f()
& d1 =f().i & d2 = f().(i+1) holds P[d1,d2];

begin 

theorem 
  for I being non empty set for A being 1-sorted-yielding
  ManySortedSet of I for L being ManySortedSubset of Carrier A for i being
  Element of I for S being Subset of A.i holds L+*(i,S) is ManySortedSubset of
  Carrier A;

definition
  let I be non empty set;
  let A be non-Trivial-yielding TopStruct-yielding ManySortedSet of I;
  mode Segre-Coset of A -> Subset of Segre_Product A means


    ex L being
Segre-like non trivial-yielding ManySortedSubset of Carrier A st it = product L
    & L.indx(L) = [#](A.indx(L));
end;

theorem 
  for I being non empty set for A being non-Trivial-yielding
TopStruct-yielding ManySortedSet of I for B1,B2 being Segre-Coset of A st 2 c=
  card(B1 /\ B2) holds B1 = B2;

definition
  let S be TopStruct;
  let X,Y be Subset of S;
  pred X,Y are_joinable means


  ex f being FinSequence of bool the
carrier of S st X = f.1 & Y = f.(len f) & (for W being Subset of S st W in rng
f holds W is closed_under_lines strong) & for i being Element of NAT st 1 <= i
  & i < len f holds 2 c= card((f.i) /\ (f.(i+1)));
end;

theorem 
  for S being TopStruct for X,Y being Subset of S st X,Y are_joinable ex
  f being one-to-one FinSequence of bool the carrier of S st (X = f.1 & Y = f.(
  len f) & (for W being Subset of S st W in rng f holds W is closed_under_lines
strong) & for i being Element of NAT st 1 <= i & i < len f holds 2 c= card((f.i
  ) /\ (f.(i+1))));

theorem 
  for S being TopStruct for X being Subset of S st X is
  closed_under_lines strong holds X,X are_joinable;

theorem 
  for I being non empty set for A being PLS-yielding ManySortedSet
  of I for X,Y being Subset of Segre_Product A st X is non trivial
  closed_under_lines strong & Y is non trivial closed_under_lines strong & X,Y
  are_joinable for X1,Y1 being Segre-like non trivial-yielding ManySortedSubset
of Carrier A st X = product X1 & Y = product Y1 holds indx(X1) = indx(Y1) & for
  i being set st i <> indx(X1) holds X1.i = Y1.i;

begin 

theorem 
  for S being 1-sorted for T being non empty 1-sorted for f being
  Function of S,T st f is bijective holds f" is bijective;

definition
  let S,T be TopStruct;
  let f be Function of S,T;
  attr f is isomorphic means


  f is bijective open & f" is bijective open;
end;

registration
  let S be non empty TopStruct;
  cluster isomorphic for Function of S,S;
end;

definition
  let S be non empty TopStruct;
  mode Collineation of S is isomorphic Function of S,S;
end;

definition
  let S be non empty non void TopStruct;
  let f be Collineation of S;
  let l be Block of S;
  redefine func f.:l -> Block of S;
end;

definition
  let S be non empty non void TopStruct;
  let f be Collineation of S;
  let l be Block of S;
  redefine func f"l -> Block of S;
end;

theorem 
  for S being non empty TopStruct for f being Collineation of S
  holds f" is Collineation of S;

theorem 
  for S being non empty TopStruct for f being Collineation of S
  for X being Subset of S st X is non trivial holds f.:X is non trivial;

theorem 
  for S being non empty TopStruct for f being Collineation of S for X
  being Subset of S st X is non trivial holds f"X is non trivial;

theorem 
  for S being non empty non void TopStruct for f being
  Collineation of S for X being Subset of S st X is strong holds f.:X is strong
;

theorem 
  for S being non empty non void TopStruct for f being Collineation of S
  for X being Subset of S st X is strong holds f"X is strong;

theorem 
  for S being non empty non void TopStruct for f being
Collineation of S for X being Subset of S st X is closed_under_lines holds f.:X
  is closed_under_lines;

theorem 
  for S being non empty non void TopStruct for f being Collineation of S
  for X being Subset of S st X is closed_under_lines holds f"X is
  closed_under_lines;

theorem 
  for S being non empty non void TopStruct for f being
  Collineation of S for X,Y being Subset of S st X is non trivial & Y is non
  trivial & X,Y are_joinable holds f.:X,f.:Y are_joinable;

theorem 
  for S being non empty non void TopStruct for f being Collineation of S
  for X,Y being Subset of S st X is non trivial & Y is non trivial & X,Y
  are_joinable holds f"X,f"Y are_joinable;

theorem 
  for I being non empty set for A being PLS-yielding ManySortedSet
  of I st for i being Element of I holds A.i is strongly_connected for W being
  Subset of Segre_Product A st W is non trivial strong closed_under_lines holds
  union {Y where Y is Subset of Segre_Product A : Y is non trivial strong
  closed_under_lines & W,Y are_joinable} is Segre-Coset of A;

theorem 
  for I being non empty set for A being PLS-yielding ManySortedSet
  of I st for i being Element of I holds A.i is strongly_connected for B being
  set holds B is Segre-Coset of A iff ex W being Subset of Segre_Product A st W
  is non trivial strong closed_under_lines & B = union {Y where Y is Subset of
Segre_Product A : Y is non trivial strong closed_under_lines & W,Y are_joinable
  };

theorem 
  for I being non empty set for A being PLS-yielding ManySortedSet
  of I st for i being Element of I holds A.i is strongly_connected for B being
  Segre-Coset of A for f being Collineation of Segre_Product A holds f.:B is
  Segre-Coset of A;

theorem 
  for I being non empty set for A being PLS-yielding ManySortedSet of I
  st for i being Element of I holds A.i is strongly_connected for B being
  Segre-Coset of A for f being Collineation of Segre_Product A holds f"B is
  Segre-Coset of A;














begin

reserve i,j,k,m,n for Element of NAT,
  f for FinSequence of the carrier of TOP-REAL 2,
  G for Go-board;

theorem 
  f is_sequence_on G & LSeg(G*(i,j),G*(i,k)) meets L~f & [i,j] in
Indices G & [i,k] in Indices G & j <= k implies ex n st j <= n & n <= k & G*(i,
  n)`2 = lower_bound(proj2.:(LSeg(G*(i,j),G*(i,k)) /\ L~f));

theorem 
  f is_sequence_on G & LSeg(G*(i,j),G*(i,k)) meets L~f & [i,j] in
Indices G & [i,k] in Indices G & j <= k implies ex n st j <= n & n <= k & G*(i,
  n)`2 = upper_bound(proj2.:(LSeg(G*(i,j),G*(i,k)) /\ L~f));

theorem 
  f is_sequence_on G & LSeg(G*(j,i),G*(k,i)) meets L~f & [j,i] in
Indices G & [k,i] in Indices G & j <= k implies ex n st j <= n & n <= k & G*(n,
  i)`1 = lower_bound(proj1.:(LSeg(G*(j,i),G*(k,i)) /\ L~f));

theorem 
  f is_sequence_on G & LSeg(G*(j,i),G*(k,i)) meets L~f & [j,i] in
Indices G & [k,i] in Indices G & j <= k implies ex n st j <= n & n <= k & G*(n,
  i)`1 = upper_bound(proj1.:(LSeg(G*(j,i),G*(k,i)) /\ L~f));

theorem 
  for C being compact non vertical non horizontal Subset of
TOP-REAL 2 for n being Element of NAT holds Upper_Seq(C,n)/.1 = W-min(L~Cage(C,
  n));

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL 2
  for n be Element of NAT holds Lower_Seq(C,n)/.1 = E-max L~Cage(C,n);

theorem 
  for C being compact non vertical non horizontal Subset of
TOP-REAL 2 for n being Element of NAT holds Upper_Seq(C,n)/. len Upper_Seq(C,n)
  = E-max(L~Cage(C,n));

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL 2
  for n be Element of NAT holds Lower_Seq(C,n)/.(len Lower_Seq(C,n)) = W-min L~
  Cage(C,n);

theorem 
  for C being compact non vertical non horizontal Subset of
TOP-REAL 2 for n being Element of NAT holds L~Upper_Seq(C,n) = Upper_Arc L~Cage
  (C,n) & L~Lower_Seq(C,n) = Lower_Arc L~Cage(C,n) or L~Upper_Seq(C,n) =
  Lower_Arc L~Cage(C,n) & L~Lower_Seq(C,n) = Upper_Arc L~Cage(C,n);

reserve C for compact non vertical non horizontal non empty
  being_simple_closed_curve Subset of TOP-REAL 2,
  p for Point of TOP-REAL 2,
  i1, j1,i2,j2 for Element of NAT;

theorem 
  for C being connected compact non vertical non horizontal Subset
  of TOP-REAL 2 for n being Element of NAT holds Upper_Seq(C,n) is_sequence_on
  Gauge(C,n);

theorem 
  for f being FinSequence of TOP-REAL 2 st f is_sequence_on G & (
  ex i,j st [i,j] in Indices G & p = G*(i,j)) & (for i1,j1,i2,j2 st [i1,j1] in
Indices G & [i2,j2] in Indices G & p = G*(i1,j1) & f/.1 = G*(i2,j2) holds abs(
  i2-i1)+abs(j2-j1) = 1) holds <*p*>^f is_sequence_on G;

theorem 
  for C being connected compact non vertical non horizontal Subset
  of TOP-REAL 2 for n being Element of NAT holds Lower_Seq(C,n) is_sequence_on
  Gauge(C,n);

theorem 
  p`1 = (W-bound C + E-bound C)/2 & p`2 = lower_bound(proj2.:(LSeg(Gauge(C,1)*(
  Center Gauge(C,1),1), Gauge(C,1)*(Center Gauge(C,1),width Gauge(C,1))) /\
Upper_Arc L~Cage(C,i+1))) implies ex j st 1 <= j & j <= width Gauge(C,i+1) & p
  = Gauge(C,i+1)*(Center Gauge(C,i+1),j);














begin

reserve n for Element of NAT;

registration
  cluster trivial for FinSequence;
end;

theorem 
  for f be trivial FinSequence holds f is empty or ex x be set st f = <*x*>;

registration
  let p be non trivial FinSequence;
  cluster Rev p -> non trivial;
end;

theorem 
  for D be non empty set for f be FinSequence of D for G be Matrix
  of D for p be set holds f is_sequence_on G implies f-:p is_sequence_on G;

theorem 
  for D be non empty set for f be FinSequence of D for G be Matrix
of D for p be Element of D st p in rng f holds f is_sequence_on G implies f:-p
  is_sequence_on G;

theorem 
  for C be compact connected non vertical non horizontal Subset of
  TOP-REAL 2 holds Upper_Seq(C,n) is_sequence_on Gauge(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
  TOP-REAL 2 holds Lower_Seq(C,n) is_sequence_on Gauge(C,n);

registration
  let C be compact connected non vertical non horizontal Subset of TOP-REAL 2;
  let n be Element of NAT;
  cluster Upper_Seq(C,n) -> standard;
  cluster Lower_Seq(C,n) -> standard;
end;

theorem 
  for G be Y_equal-in-column Y_increasing-in-line Matrix of
TOP-REAL 2 for i1,i2,j1,j2 be Element of NAT st [i1,j1] in Indices G & [i2,j2]
  in Indices G holds G*(i1,j1)`2 = G*(i2,j2)`2 implies j1 = j2;

theorem 
  for G be X_equal-in-line X_increasing-in-column Matrix of
TOP-REAL 2 for i1,i2,j1,j2 be Element of NAT st [i1,j1] in Indices G & [i2,j2]
  in Indices G holds G*(i1,j1)`1 = G*(i2,j2)`1 implies i1 = i2;

theorem 
  for f be standard special unfolded non trivial FinSequence of
TOP-REAL 2 st (f/.1 <> N-min L~f & f/.len f <> N-min L~f) or (f/.1 <> N-max L~
  f & f/.len f <> N-max L~f) holds (N-min L~f)`1 < (N-max L~f)`1;

theorem 
  for f be standard special unfolded non trivial FinSequence of
  TOP-REAL 2  st (f/.1 <> N-min L~f & f/.len f <> N-min L~f) or (f/.1 <> N-max
  L~f & f/.len f <> N-max L~f) holds N-min L~f <> N-max L~f;

theorem 
  for f be standard special unfolded non trivial FinSequence of
TOP-REAL 2 st (f/.1 <> S-min L~f & f/.len f <> S-min L~f) or (f/.1 <> S-max L~
  f & f/.len f <> S-max L~f) holds (S-min L~f)`1 < (S-max L~f)`1;

theorem 
  for f be standard special unfolded non trivial FinSequence of
  TOP-REAL 2  st (f/.1 <> S-min L~f & f/.len f <> S-min L~f) or (f/.1 <> S-max
  L~f & f/.len f <> S-max L~f) holds S-min L~f <> S-max L~f;

theorem 
  for f be standard special unfolded non trivial FinSequence of
TOP-REAL 2 st (f/.1 <> W-min L~f & f/.len f <> W-min L~f) or (f/.1 <> W-max L~
  f & f/.len f <> W-max L~f) holds (W-min L~f)`2 < (W-max L~f)`2;

theorem 
  for f be standard special unfolded non trivial FinSequence of
  TOP-REAL 2  st (f/.1 <> W-min L~f & f/.len f <> W-min L~f) or (f/.1 <> W-max
  L~f & f/.len f <> W-max L~f) holds W-min L~f <> W-max L~f;

theorem 
  for f be standard special unfolded non trivial FinSequence of
TOP-REAL 2 st (f/.1 <> E-min L~f & f/.len f <> E-min L~f) or (f/.1 <> E-max L~
  f & f/.len f <> E-max L~f) holds (E-min L~f)`2 < (E-max L~f)`2;

theorem 
  for f be standard special unfolded non trivial FinSequence of
  TOP-REAL 2  st (f/.1 <> E-min L~f & f/.len f <> E-min L~f) or (f/.1 <> E-max
  L~f & f/.len f <> E-max L~f) holds E-min L~f <> E-max L~f;

theorem 
  for D be non empty set for f be FinSequence of D for p,q be
Element of D st p in rng f & q in rng f & q..f <= p..f holds (f-:p):-q = (f:-q)
  -:p;

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for n be Element of NAT holds L~(Cage(C,n)-:W-min L~Cage(C,n)) /\ L~
  (Cage(C,n):-W-min L~Cage(C,n)) = {N-min L~Cage(C,n),W-min L~Cage(C,n)};

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 holds Lower_Seq(C,n) = Rotate(Cage(C,n),E-max L~Cage(C,n))-:W-min L~
  Cage(C,n);

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL
  2 holds (W-min L~Cage(C,n))..Upper_Seq(C,n) = 1;

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL
2 holds (W-min L~Cage(C,n))..Upper_Seq(C,n) < (W-max L~Cage(C,n))..Upper_Seq(C,
  n);

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL
2 holds (W-max L~Cage(C,n))..Upper_Seq(C,n) <= (N-min L~Cage(C,n))..Upper_Seq(C
  ,n);

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL
2 holds (N-min L~Cage(C,n))..Upper_Seq(C,n) < (N-max L~Cage(C,n))..Upper_Seq(C,
  n);

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL
2 holds (N-max L~Cage(C,n))..Upper_Seq(C,n) <= (E-max L~Cage(C,n))..Upper_Seq(C
  ,n);

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL
  2 holds (E-max L~Cage(C,n))..Upper_Seq(C,n) = len Upper_Seq(C,n);

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL
  2 holds (E-max L~Cage(C,n))..Lower_Seq(C,n) = 1;

theorem 
  for C be compact connected non vertical non horizontal Subset of
  TOP-REAL 2 holds (E-max L~Cage(C,n))..Lower_Seq(C,n) < (E-min L~Cage(C,n))..
  Lower_Seq(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
  TOP-REAL 2 holds (E-min L~Cage(C,n))..Lower_Seq(C,n) <= (S-max L~Cage(C,n))..
  Lower_Seq(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
  TOP-REAL 2 holds (S-max L~Cage(C,n))..Lower_Seq(C,n) < (S-min L~Cage(C,n))..
  Lower_Seq(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
  TOP-REAL 2 holds (S-min L~Cage(C,n))..Lower_Seq(C,n) <= (W-min L~Cage(C,n))..
  Lower_Seq(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
  TOP-REAL 2 holds (W-min L~Cage(C,n))..Lower_Seq(C,n) = len Lower_Seq(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
  TOP-REAL 2 holds (Upper_Seq(C,n)/.2)`1 = W-bound L~Cage(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
  TOP-REAL 2 holds (Lower_Seq(C,n)/.2)`1 = E-bound L~Cage(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
  TOP-REAL 2 holds W-bound L~Cage(C,n) + E-bound L~Cage(C,n) = W-bound C +
  E-bound C;

theorem 
  for C be compact connected non vertical non horizontal Subset of
  TOP-REAL 2 holds S-bound L~Cage(C,n) + N-bound L~Cage(C,n) = S-bound C +
  N-bound C;

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for n be Element of NAT, i be Nat st 1 <= i & i <= width Gauge(C,n)
& n > 0 holds Gauge(C,n)*(Center Gauge(C,n),i)`1 = (W-bound C + E-bound C) / 2;

theorem 
  for C be compact connected non vertical non horizontal Subset of
  TOP-REAL 2 for n,i be Element of NAT st 1 <= i & i <= len Gauge(C,n) & n > 0
  holds Gauge(C,n)*(i,Center Gauge(C,n))`2 = (S-bound C + N-bound C) / 2;

theorem 
  for f be S-Sequence_in_R2 for k1,k2 be Element of NAT st 1 <= k1
& k1 <= len f & 1 <= k2 & k2 <= len f & f/.1 in L~mid(f,k1,k2) holds k1 = 1 or
  k2 = 1;

theorem 
  for f be S-Sequence_in_R2 for k1,k2 be Element of NAT st 1 <= k1
& k1 <= len f & 1 <= k2 & k2 <= len f & f/.(len f) in L~mid(f,k1,k2) holds k1 =
  len f or k2 = len f;

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL
  2 for n be Element of NAT holds rng Upper_Seq(C,n) c= rng Cage(C,n) & rng
  Lower_Seq(C,n) c= rng Cage(C,n);

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL
  2 holds Upper_Seq(C,n) is_a_h.c._for Cage(C,n);

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL
  2 holds Rev Lower_Seq(C,n) is_a_h.c._for Cage(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
  TOP-REAL 2 for i be Element of NAT st 1 < i & i <= len Gauge(C,n) holds not
  Gauge(C,n)*(i,1) in rng Upper_Seq(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
  TOP-REAL 2 for i be Element of NAT st 1 <= i & i < len Gauge(C,n) holds not
  Gauge(C,n)*(i,width Gauge(C,n)) in rng Lower_Seq(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
  TOP-REAL 2 for i be Element of NAT st 1 < i & i <= len Gauge(C,n) holds not
  Gauge(C,n)*(i,1) in L~Upper_Seq(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
  TOP-REAL 2 for i be Element of NAT st 1 <= i & i < len Gauge(C,n) holds not
  Gauge(C,n)*(i,width Gauge(C,n)) in L~Lower_Seq(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for i,j be Element of NAT st 1 <= i & i <= len Gauge(C,n) & 1 <= j &
j <= width Gauge(C,n) & Gauge(C,n)*(i,j) in L~Cage(C,n) holds LSeg(Gauge(C,n)*(
  i,1),Gauge(C,n)*(i,j)) meets L~Lower_Seq(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for n be Element of NAT st n > 0 holds First_Point(L~Upper_Seq(C,n),
  W-min L~Cage(C,n),E-max L~Cage(C,n), Vertical_Line ((W-bound L~Cage(C,n)+
  E-bound L~Cage(C,n))/2)) in rng Upper_Seq(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for n be Element of NAT st n > 0 holds Last_Point(L~Lower_Seq(C,n),
  E-max L~Cage(C,n),W-min L~Cage(C,n), Vertical_Line ((W-bound L~Cage(C,n)+
  E-bound L~Cage(C,n))/2)) in rng Lower_Seq(C,n);

theorem 
  for f be S-Sequence_in_R2 for p be Point of TOP-REAL 2 st p in
  rng f holds R_Cut(f,p) = mid(f,1,p..f);

theorem 
  for f be S-Sequence_in_R2 for Q be closed Subset of TOP-REAL 2
  st L~f meets Q & not f/.1 in Q & First_Point(L~f,f/.1,f/.len f,Q) in rng f
holds L~mid(f,1,First_Point(L~f,f/.1,f/.len f,Q)..f) /\ Q = {First_Point(L~f,f
  /.1,f/.len f,Q)};

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for n be Element of NAT st n > 0 for k be Element of NAT st 1 <= k &
  k < First_Point(L~Upper_Seq(C,n),W-min L~Cage(C,n),E-max L~Cage(C,n),
  Vertical_Line ((W-bound L~Cage(C,n)+E-bound L~Cage(C,n))/2)).. Upper_Seq(C,n)
  holds (Upper_Seq(C,n)/.k)`1 < (W-bound L~Cage(C,n)+E-bound L~Cage(C,n))/2;

theorem 
  for C be compact connected non vertical non horizontal Subset of
  TOP-REAL 2 for n be Element of NAT st n > 0 for k be Nat st 1 <= k & k <
  First_Point(L~Rev Lower_Seq(C,n),W-min L~Cage(C,n),E-max L~Cage(C,n),
Vertical_Line ((W-bound L~Cage(C,n)+E-bound L~Cage(C,n))/2)).. Rev Lower_Seq(C,
n) holds (Rev Lower_Seq(C,n)/.k)`1 < (W-bound L~Cage(C,n)+E-bound L~Cage(C,n))/
  2;

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for n be Element of NAT st n > 0 for q be Point of TOP-REAL 2 holds
q in rng mid(Upper_Seq(C,n),2,First_Point(L~Upper_Seq(C,n), W-min L~Cage(C,n),
E-max L~Cage(C,n),Vertical_Line ((W-bound L~Cage(C,n)+E-bound L~Cage(C,n))/2))
  ..Upper_Seq(C,n)) implies q`1 <= (W-bound L~Cage(C,n)+E-bound L~Cage(C,n))/2;

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for n be Element of NAT st n > 0 holds First_Point(L~Upper_Seq(C,n),
W-min L~Cage(C,n),E-max L~Cage(C,n), Vertical_Line((W-bound L~Cage(C,n)+E-bound
L~Cage(C,n))/2))`2 > Last_Point(L~Lower_Seq(C,n),E-max L~Cage(C,n),W-min L~Cage
  (C,n), Vertical_Line((W-bound L~Cage(C,n)+E-bound L~Cage(C,n))/2))`2;

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for n be Element of NAT st n > 0 holds L~Upper_Seq(C,n) = Upper_Arc
  L~Cage(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for n be Element of NAT st n > 0 holds L~Lower_Seq(C,n) = Lower_Arc
  L~Cage(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for n be Element of NAT st n > 0 for i,j be Element of NAT st 1 <= i
& i <= len Gauge(C,n) & 1 <= j & j <= width Gauge(C,n) & Gauge(C,n)*(i,j) in L~
Cage(C,n) holds LSeg(Gauge(C,n)*(i,1),Gauge(C,n)*(i,j)) meets Lower_Arc L~Cage(
  C,n);














begin 

reserve m,k,j,j1,i,i1,i2,n for Element of NAT,
  r,s for Real,
  C for compact non vertical non horizontal Subset of TOP-REAL 2,
  G for Go-board,
  p for Point of TOP-REAL 2;

registration
  let D be non empty with_non-empty_element set;
  cluster non empty non-empty for FinSequence of D*;
end;

registration
  let F be non-empty Function-yielding Function;
  cluster rngs F -> non-empty;
end;

theorem 
  for p,q being Point of TOP-REAL 2 st p <> q holds p in Cl(LSeg(p, q) \ {p,q})
;

theorem 
  for p,q being Point of TOP-REAL 2 st p <> q holds Cl(LSeg(p,q) \
  {p,q}) = LSeg(p,q);

theorem 
  for S being Subset of TOP-REAL 2, p,q be Point of TOP-REAL 2 st p <> q
  & LSeg(p,q) \ {p,q} c= S holds LSeg(p,q) c= Cl S;

begin 

definition
  func RealOrd -> Relation of REAL equals

  {[r,s] : r <= s };
end;

theorem 
  [r,s] in RealOrd implies r <= s;

theorem 
  field RealOrd = REAL;

registration
  cluster RealOrd -> total reflexive antisymmetric transitive
    being_linear-order;
end;

theorem 
  RealOrd linearly_orders REAL;

theorem 
  for A being finite Subset of REAL holds SgmX(RealOrd,A) is increasing;

theorem 
  for f being FinSequence of REAL, A being finite Subset of REAL
  st A = rng f holds SgmX(RealOrd,A) = Incr f;

registration
  let A be finite Subset of REAL;
  cluster SgmX(RealOrd,A) -> increasing;
end;

theorem 
  for X being non empty set, A being finite Subset of X, R be
  being_linear-order Order of X holds len SgmX(R,A) = card A;

begin 

theorem 
  for f being FinSequence of TOP-REAL 2 holds X_axis f = proj1*f;

theorem 
  for f being FinSequence of TOP-REAL 2 holds Y_axis f = proj2*f;

definition
  let D be non empty set;
  let M be FinSequence of D*;
  redefine func Values M -> Subset of D;
end;

registration
  let D be non empty with_non-empty_elements set;
  let M be non empty non-empty FinSequence of D*;
  cluster Values M -> non empty;
end;

theorem 
  for D being non empty set, M being (Matrix of D), i st i in Seg
  width M holds rng Col(M,i) c= Values M;

theorem 
  for D being non empty set, M being (Matrix of D), i st i in dom
  M holds rng Line(M,i) c= Values M;

theorem 
  for G being X_increasing-in-column non empty-yielding Matrix of
  TOP-REAL 2 holds len G <= card(proj1.:Values G);

theorem 
  for G being X_equal-in-line Matrix of TOP-REAL 2 holds card(
  proj1.:Values G) <= len G;

theorem 
  for G being X_equal-in-line X_increasing-in-column non
  empty-yielding Matrix of TOP-REAL 2 holds len G = card(proj1.:Values G);

theorem 
  for G being Y_increasing-in-line non empty-yielding Matrix of
  TOP-REAL 2 holds width G <= card(proj2.:Values G);

theorem 
  for G being Y_equal-in-column non empty-yielding Matrix of
  TOP-REAL 2 holds card(proj2.:Values G) <= width G;

theorem 
  for G being Y_equal-in-column Y_increasing-in-line non
  empty-yielding Matrix of TOP-REAL 2 holds width G = card(proj2.:Values G);

begin 

theorem 
  for G be Go-board for f be FinSequence of TOP-REAL 2 st f
is_sequence_on G for k be Element of NAT st 1 <= k & k+1 <= len f holds LSeg(f,
  k) c= left_cell(f,k,G);

theorem 
  for f being standard special_circular_sequence st 1 <= k & k+1 <= len
  f holds left_cell(f,k,GoB f) = left_cell(f,k);

theorem 
  for G be Go-board for f be FinSequence of TOP-REAL 2 st f
is_sequence_on G for k be Element of NAT st 1 <= k & k+1 <= len f holds LSeg(f,
  k) c= right_cell(f,k,G);

theorem 
  for f being standard special_circular_sequence st 1 <= k & k+1
  <= len f holds right_cell(f,k,GoB f) = right_cell(f,k);

theorem 
  for P being Subset of TOP-REAL 2, f being non constant standard
  special_circular_sequence st P is_a_component_of (L~f)` holds P = RightComp f
  or P = LeftComp f;

theorem 
  for f being non constant standard special_circular_sequence st f
is_sequence_on G for k st 1 <= k & k+1 <= len f holds Int right_cell(f,k,G) c=
  RightComp f & Int left_cell(f,k,G) c= LeftComp f;

theorem 
  for i1,j1,i2,j2 being Element of NAT, G being Go-board st [i1,j1
  ] in Indices G & [i2,j2] in Indices G & G*(i1,j1) = G*(i2,j2) holds i1 = i2 &
  j1 = j2;

theorem 
  for f being FinSequence of TOP-REAL 2, M being Go-board holds f
  is_sequence_on M implies mid(f,i1,i2) is_sequence_on M;

registration
  cluster -> non empty non-empty for Go-board;
end;

theorem 
  for G being Go-board st 1 <= i & i <= len G holds SgmX(RealOrd,
  proj1.:Values G).i = G*(i,1)`1;

theorem 
  for G being Go-board st 1 <= j & j <= width G holds SgmX(RealOrd
  , proj2.:Values G).j = G*(1,j)`2;

theorem 
  for f being non empty FinSequence of TOP-REAL 2, G being
Go-board st f is_sequence_on G & (ex i st [1,i] in Indices G & G*(1,i) in rng f
) & (ex i st [len G,i] in Indices G & G*(len G,i) in rng f) holds proj1.:rng f
  = proj1.:Values G;

theorem 
  for f being non empty FinSequence of TOP-REAL 2, G being
Go-board st f is_sequence_on G & (ex i st [i,1] in Indices G & G*(i,1) in rng f
  ) & (ex i st [i,width G] in Indices G & G*(i,width G) in rng f) holds proj2.:
  rng f = proj2.:Values G;

registration
  let G be Go-board;
  cluster Values G -> non empty;
end;

theorem 
  for G being Go-board holds G = GoB(SgmX(RealOrd, proj1.:Values G
  ), SgmX(RealOrd,proj2.:Values G));

theorem 
  for f being non empty FinSequence of TOP-REAL 2, G being
  Go-board st proj1.:rng f = proj1.:Values G & proj2.:rng f = proj2.:Values G
  holds G = GoB f;

theorem 
  for f being non empty FinSequence of TOP-REAL 2, G being
Go-board st f is_sequence_on G & (ex i st [1,i] in Indices G & G*(1,i) in rng f
  ) & (ex i st [i,1] in Indices G & G*(i,1) in rng f) & (ex i st [len G,i] in
  Indices G & G*(len G,i) in rng f) & (ex i st [i,width G] in Indices G & G*(i,
  width G) in rng f) holds G = GoB f;

begin 

theorem 
  1 <= i implies [\ (i-2)/2|^(n-'m)+2 /] is Element of NAT;

theorem 
  m <= n & 1 <= i & i+1 <= len Gauge(C,n) implies 1 <= [\ (i-2)/2
  |^(n-'m)+2 /] & [\ (i-2)/2|^(n-'m)+2 /]+1 <= len Gauge(C,m);

theorem 
  m <= n & 1 <= i & i+1 <= len Gauge(C,n) & 1 <= j & j+1 <= width
Gauge(C,n) implies ex i1,j1 st i1 = [\ (i-2)/2|^(n-'m)+2 /] & j1 = [\ (j-2)/2|^
  (n-'m)+2 /] & cell(Gauge(C,n),i,j) c= cell(Gauge(C,m),i1,j1);

theorem 
  m <= n & 1 <= i & i+1 <= len Gauge(C,n) & 1 <= j & j+1 <= width
Gauge(C,n) implies ex i1,j1 st 1 <= i1 & i1+1 <= len Gauge(C,m) & 1 <= j1 & j1+
  1 <= width Gauge(C,m) & cell(Gauge(C,n),i,j) c= cell(Gauge(C,m),i1,j1);

theorem 
  for P being Subset of TOP-REAL2 st P is bounded holds UBD P is not bounded;

theorem 
  for f being non constant standard special_circular_sequence st
  Rotate(f,p) is clockwise_oriented holds f is clockwise_oriented;

theorem 
  for f being non constant standard special_circular_sequence st
  LeftComp f = UBD L~f holds f is clockwise_oriented;

begin 

theorem 
  for f being non constant standard special_circular_sequence
  holds (Cl LeftComp(f))` = RightComp f;

theorem 
  for f being non constant standard special_circular_sequence holds (Cl
  RightComp(f))` = LeftComp f;

theorem 
  C is connected implies GoB Cage(C,n) = Gauge(C,n);

theorem 
  C is connected implies N-min C in right_cell(Cage(C,n),1);

theorem 
  C is connected & i <= j implies L~Cage(C,j) c= Cl RightComp(Cage (C,i));

theorem 
  C is connected & i <= j implies LeftComp(Cage(C,i)) c= LeftComp( Cage(C,j));

theorem 
  C is connected & i <= j implies RightComp(Cage(C,j)) c= RightComp(Cage
  (C, i ) );

begin 

definition
  let C,n;
  func X-SpanStart(C,n) -> Element of NAT equals

  2|^(n-'1) + 2;
end;

theorem 
  2 < X-SpanStart(C,n) & X-SpanStart(C,n) < len Gauge(C,n);

theorem 
  1 <= X-SpanStart(C,n)-'1 & X-SpanStart(C,n)-'1 < len Gauge(C,n);

definition
  let C,n;
  pred n is_sufficiently_large_for C means


  ex j st j < width Gauge(C,n)
  & cell(Gauge(C,n),X-SpanStart(C,n)-'1,j) c= BDD C;
end;

theorem 
  n is_sufficiently_large_for C implies n >= 1;

theorem 
  for C being compact non vertical non horizontal non empty Subset of
  TOP-REAL 2 for n for f being FinSequence of TOP-REAL 2 st f is_sequence_on
Gauge(C,n) & len f > 1 for i1,j1 being Element of NAT st left_cell(f,(len f)-'1
,Gauge(C,n)) meets C & [i1,j1] in Indices Gauge(C,n) & f/.((len f) -'1) = Gauge
(C,n)*(i1,j1) & [i1,j1+1] in Indices Gauge(C,n) & f/.len f = Gauge(C,n)*(i1,j1+
  1) holds [i1-'1,j1+1] in Indices Gauge(C,n);

theorem 
  for C being compact non vertical non horizontal non empty Subset of
  TOP-REAL 2 for n for f being FinSequence of TOP-REAL 2 st f is_sequence_on
Gauge(C,n) & len f > 1 for i1,j1 being Element of NAT st left_cell(f,(len f)-'1
,Gauge(C,n)) meets C & [i1,j1] in Indices Gauge(C,n) & f/.((len f) -'1) = Gauge
(C,n)*(i1,j1) & [i1+1,j1] in Indices Gauge(C,n) & f/.len f = Gauge(C,n)*(i1+1,
  j1) holds [i1+1,j1+1] in Indices Gauge(C,n);

theorem 
  for C being compact non vertical non horizontal non empty Subset of
  TOP-REAL 2 for n for f being FinSequence of TOP-REAL 2 st f is_sequence_on
Gauge(C,n) & len f > 1 for j1,i2 being Element of NAT st left_cell(f,(len f)-'1
  ,Gauge(C,n)) meets C & [i2+1,j1] in Indices Gauge(C,n) & f/.((len f) -'1) =
Gauge(C,n)*(i2+1,j1) & [i2,j1] in Indices Gauge(C,n) & f/.len f = Gauge(C,n)*(
  i2,j1) holds [i2,j1-'1] in Indices Gauge(C,n);

theorem 
  for C being compact non vertical non horizontal non empty Subset of
  TOP-REAL 2 for n for f being FinSequence of TOP-REAL 2 st f is_sequence_on
Gauge(C,n) & len f > 1 for i1,j2 being Element of NAT st left_cell(f,(len f)-'1
  ,Gauge(C,n)) meets C & [i1,j2+1] in Indices Gauge(C,n) & f/.((len f) -'1) =
Gauge(C,n)*(i1,j2+1) & [i1,j2] in Indices Gauge(C,n) & f/.len f = Gauge(C,n)*(
  i1,j2) holds [i1+1,j2] in Indices Gauge(C,n);

theorem 
  for C being compact non vertical non horizontal non empty Subset of
  TOP-REAL 2 for n for f being FinSequence of TOP-REAL 2 st f is_sequence_on
Gauge(C,n) & len f > 1 for i1,j1 being Element of NAT st front_left_cell(f,(len
f)-'1,Gauge(C,n)) meets C & [i1,j1] in Indices Gauge(C,n) & f/.((len f) -'1) =
Gauge(C,n)*(i1,j1) & [i1,j1+1] in Indices Gauge(C,n) & f/.len f = Gauge(C,n)*(
  i1,j1+1) holds [i1,j1+2] in Indices Gauge(C,n);

theorem 
  for C being compact non vertical non horizontal non empty Subset of
  TOP-REAL 2 for n for f being FinSequence of TOP-REAL 2 st f is_sequence_on
Gauge(C,n) & len f > 1 for i1,j1 being Element of NAT st front_left_cell(f,(len
f)-'1,Gauge(C,n)) meets C & [i1,j1] in Indices Gauge(C,n) & f/.((len f) -'1) =
Gauge(C,n)*(i1,j1) & [i1+1,j1] in Indices Gauge(C,n) & f/.len f = Gauge(C,n)*(
  i1+1,j1) holds [i1+2,j1] in Indices Gauge(C,n);

theorem 
  for C being compact non vertical non horizontal non empty Subset of
  TOP-REAL 2 for n for f being FinSequence of TOP-REAL 2 st f is_sequence_on
Gauge(C,n) & len f > 1 for j1,i2 being Element of NAT st front_left_cell(f,(len
f)-'1,Gauge(C,n)) meets C & [i2+1,j1] in Indices Gauge(C,n) & f/.((len f) -'1)
= Gauge(C,n)*(i2+1,j1) & [i2,j1] in Indices Gauge(C,n) & f/.len f = Gauge(C,n)*
  (i2,j1) holds [i2-'1,j1] in Indices Gauge(C,n);

theorem 
  for C being compact non vertical non horizontal non empty Subset of
  TOP-REAL 2 for n for f being FinSequence of TOP-REAL 2 st f is_sequence_on
Gauge(C,n) & len f > 1 for i1,j2 being Element of NAT st front_left_cell(f,(len
f)-'1,Gauge(C,n)) meets C & [i1,j2+1] in Indices Gauge(C,n) & f/.((len f) -'1)
= Gauge(C,n)*(i1,j2+1) & [i1,j2] in Indices Gauge(C,n) & f/.len f = Gauge(C,n)*
  (i1,j2) holds [i1,j2-'1] in Indices Gauge(C,n);

theorem 
  for C being compact non vertical non horizontal non empty Subset of
  TOP-REAL 2 for n for f being FinSequence of TOP-REAL 2 st f is_sequence_on
  Gauge(C,n) & len f > 1 for i1,j1 being Element of NAT st front_right_cell(f,(
len f)-'1,Gauge(C,n)) meets C & [i1,j1] in Indices Gauge(C,n) & f/.((len f) -'1
) = Gauge(C,n)*(i1,j1) & [i1,j1+1] in Indices Gauge(C,n) & f/.len f = Gauge(C,n
  )*(i1,j1+1) holds [i1+1,j1+1] in Indices Gauge(C,n);

theorem 
  for C being compact non vertical non horizontal non empty Subset of
  TOP-REAL 2 for n for f being FinSequence of TOP-REAL 2 st f is_sequence_on
  Gauge(C,n) & len f > 1 for i1,j1 being Element of NAT st front_right_cell(f,(
len f)-'1,Gauge(C,n)) meets C & [i1,j1] in Indices Gauge(C,n) & f/.((len f) -'1
) = Gauge(C,n)*(i1,j1) & [i1+1,j1] in Indices Gauge(C,n) & f/.len f = Gauge(C,n
  )*(i1+1,j1) holds [i1+1,j1-'1] in Indices Gauge(C,n);

theorem 
  for C being compact non vertical non horizontal non empty Subset of
  TOP-REAL 2 for n for f being FinSequence of TOP-REAL 2 st f is_sequence_on
  Gauge(C,n) & len f > 1 for j1,i2 being Element of NAT st front_right_cell(f,(
  len f)-'1,Gauge(C,n)) meets C & [i2+1,j1] in Indices Gauge(C,n) & f/.((len f)
-'1) = Gauge(C,n)*(i2+1,j1) & [i2,j1] in Indices Gauge(C,n) & f/.len f = Gauge(
  C,n)*(i2,j1) holds [i2,j1+1] in Indices Gauge(C,n);

theorem 
  for C being compact non vertical non horizontal non empty Subset of
  TOP-REAL 2 for n for f being FinSequence of TOP-REAL 2 st f is_sequence_on
  Gauge(C,n) & len f > 1 for i1,j2 being Element of NAT st front_right_cell(f,(
  len f)-'1,Gauge(C,n)) meets C & [i1,j2+1] in Indices Gauge(C,n) & f/.((len f)
-'1) = Gauge(C,n)*(i1,j2+1) & [i1,j2] in Indices Gauge(C,n) & f/.len f = Gauge(
  C,n)*(i1,j2) holds [i1-'1,j2] in Indices Gauge(C,n);














begin

registration
  cluster Abelian left_zeroed right_zeroed add-associative
    right_complementable well-unital associative commutative distributive
    domRing-like for non trivial doubleLoopStr;
end;

definition
  let X be set, R be non empty ZeroStr, p be Series of X,R;

  attr p is non-zero means


  p <> 0_(X,R);
end;

registration
  let X be set, R be non trivial ZeroStr;
  cluster non-zero for Series of X,R;
end;

registration
  let n be Ordinal, R be non trivial ZeroStr;
  cluster non-zero for Polynomial of n,R;
end;

theorem 
  for X being set, R being non empty ZeroStr, s being Series of X,R
  holds s = 0_(X,R) iff Support s = {};

theorem 
  for X being set, R being non empty ZeroStr holds R is non trivial iff
  ex s being Series of X,R st Support(s) <> {};

definition
  let X be set, b be bag of X;
  attr b is univariate means


  ex u being Element of X st support b = {u};
end;

registration
  let X be non empty set;
  cluster univariate for bag of X;
end;

registration
  let X be non empty set;
  cluster univariate -> non empty for bag of X;
end;

begin 

theorem 
  for b being bag of {} holds b = EmptyBag {};

theorem 
  for L being right_zeroed add-associative right_complementable
well-unital distributive non trivial doubleLoopStr, p being Polynomial of {},
  L, x being Function of {},L holds eval(p,x) = p.(EmptyBag{});

theorem 
  for L being right_zeroed add-associative right_complementable Abelian
  well-unital distributive associative non trivial non trivial doubleLoopStr
  holds Polynom-Ring({},L) is_ringisomorph_to L;

begin 

definition
  let X be set, L be non empty ZeroStr, p be Series of X,L;
  attr p is monomial-like means


  ex b being bag of X st for b9 being bag of X st b9 <> b holds p.b9 = 0.L;
end;

registration
  let X be set, L be non empty ZeroStr;
  cluster monomial-like for Series of X,L;
end;

definition
  let X be set, L be non empty ZeroStr;
  mode Monomial of X,L is monomial-like Series of X,L;
end;

registration
  let X be set, L be non empty ZeroStr;
  cluster monomial-like -> finite-Support for Series of X,L;
end;

theorem 
  for X being set, L being non empty ZeroStr, p being Series of X,L
  holds p is Monomial of X,L iff (Support p = {} or ex b being bag of X st
  Support p = {b});

definition
  let X be set, L be non empty ZeroStr, a be Element of L, b be bag of X;
  func Monom(a,b) -> Monomial of X,L equals

  0_(X,L)+*(b,a);
end;

definition
  let X be set, L be non empty ZeroStr, m be Monomial of X,L;
  func term(m) -> bag of X means


  m.it <> 0.L or Support m = {} & it = EmptyBag X;
end;

definition
  let X be set, L be non empty ZeroStr, m be Monomial of X,L;
  func coefficient(m) -> Element of L equals

  m.(term(m));
end;

theorem 
  for X being set, L being non empty ZeroStr, m being Monomial of X
  ,L holds Support(m) = {} or Support(m) = {term(m)};

theorem 
  for X being set, L being non empty ZeroStr, b being bag of X
  holds coefficient(Monom(0.L,b)) = 0.L & term(Monom(0.L,b)) = EmptyBag X;

theorem 
  for X being set, L being non empty ZeroStr, a being Element of L,
  b being bag of X holds coefficient(Monom(a,b)) = a;

theorem 
  for X being set, L being non trivial ZeroStr, a being non zero
  Element of L, b being bag of X holds term(Monom(a,b)) = b;

theorem 
  for X being set, L being non empty ZeroStr, m being Monomial of X,L
  holds Monom(coefficient(m),term(m)) = m;

theorem 
  for n being Ordinal, L being right_zeroed add-associative
  right_complementable well-unital distributive non trivial doubleLoopStr, m
being Monomial of n,L, x being Function of n,L holds eval(m,x) = coefficient(m)
  * eval(term(m),x);

theorem 
  for n being Ordinal, L being right_zeroed add-associative
  right_complementable well-unital distributive non trivial doubleLoopStr, a
being Element of L, b being bag of n, x being Function of n,L holds eval(Monom(
  a,b),x) = a * eval(b,x);

begin 

definition
  let X be set, L be non empty ZeroStr, p be Series of X,L;
  attr p is Constant means


  for b being bag of X st b <> EmptyBag X holds p.b = 0.L;
end;

registration
  let X be set, L be non empty ZeroStr;
  cluster Constant for Series of X,L;
end;

definition
  let X be set, L be non empty ZeroStr;
  mode ConstPoly of X,L is Constant Series of X,L;
end;

registration
  let X be set, L be non empty ZeroStr;
  cluster Constant -> monomial-like for Series of X,L;
end;

theorem 
  for X being set, L being non empty ZeroStr, p being Series of X,
  L holds p is ConstPoly of X,L iff (p = 0_(X,L) or Support p = {EmptyBag X});

registration
  let X be set, L be non empty ZeroStr;
  cluster 0_(X,L) -> Constant;
end;

registration
  let X be set, L be well-unital non empty doubleLoopStr;
  cluster 1_(X,L) -> Constant;
end;

theorem 
  for X being set, L being non empty ZeroStr, c being ConstPoly of
  X,L holds Support(c) = {} or Support(c) = {EmptyBag X};

theorem 
  for X being set, L being non empty ZeroStr, c being ConstPoly of X,L
  holds term(c) = EmptyBag X & coefficient(c) = c.(EmptyBag X);

definition
  let X be set, L be non empty ZeroStr, a be Element of L;
  func a |(X,L) -> Series of X,L equals

  0_(X,L)+*(EmptyBag X,a);
end;

registration
  let X be set, L be non empty ZeroStr, a be Element of L;
  cluster a |(X,L) -> Constant;
end;

theorem 
  for X being set, L being non empty ZeroStr, p being Series of X,L
  holds p is ConstPoly of X,L iff ex a being Element of L st p = a |(X,L);

theorem 
  for X being set, L being non empty multLoopStr_0, a being
  Element of L holds (a |(X,L)).EmptyBag X = a & for b being bag of X st b <>
  EmptyBag X holds (a |(X,L)).b = 0.L;

theorem 
  for X being set, L being non empty ZeroStr holds 0.L |(X,L) = 0_(X,L);

theorem 
  for X being set, L being well-unital non empty multLoopStr_0 holds (
  1.L) |(X,L) = 1_(X,L);

theorem 
  for X being set, L being non empty ZeroStr, a,b being Element of L
  holds a |(X,L) = b |(X,L) iff a = b;

theorem 
  for X being set, L being non empty ZeroStr, a being Element of L holds
  Support(a |(X,L)) = {} or Support(a |(X,L)) = {EmptyBag X};

theorem 
  for X being set, L being non empty ZeroStr, a being Element of L
  holds term(a |(X,L)) = EmptyBag X & coefficient(a |(X,L)) = a;

theorem 
  for n being Ordinal, L being right_zeroed add-associative
  right_complementable well-unital distributive non trivial doubleLoopStr, c
being ConstPoly of n,L, x being Function of n,L holds eval(c,x) = coefficient(c
  );

theorem 
  for n being Ordinal, L being right_zeroed add-associative
  right_complementable well-unital distributive non trivial doubleLoopStr, a
  being Element of L, x being Function of n,L holds eval(a |(n,L),x) = a;

begin 

definition
  let X be set, L be non empty multLoopStr_0, p be Series of X,L, a be Element
  of L;
  func a * p -> Series of X,L means


  for b being bag of X holds it.b = a * p.b;
  func p * a -> Series of X,L means


  for b being bag of X holds it.b = p.b * a;
end;

registration
  let X be set, L be left_zeroed right_zeroed add-cancelable distributive non
  empty doubleLoopStr, p be finite-Support Series of X,L, a be Element of L;
  cluster a * p -> finite-Support;
  cluster p * a -> finite-Support;
end;

theorem 
  for X being set, L being commutative non empty multLoopStr_0, p
  being Series of X,L, a being Element of L holds a * p = p * a;

theorem 
  for n being Ordinal, L being add-associative
right_complementable right_zeroed left-distributive non empty doubleLoopStr,
  p being Series of n,L, a being Element of L holds a * p = a |(n,L) *' p;

theorem 
  for n being Ordinal, L being add-associative
right_complementable right_zeroed right-distributive non empty doubleLoopStr,
  p being Series of n,L, a being Element of L holds p * a = p *' (a |(n,L));

theorem 
  for n being Ordinal, L being Abelian left_zeroed right_zeroed
  add-associative right_complementable well-unital associative commutative
  distributive non trivial doubleLoopStr, p being Polynomial of n,L, a being
  Element of L, x being Function of n,L holds eval(a*p,x) = a * eval(p,x);

theorem 
  for n being Ordinal, L being left_zeroed right_zeroed
  left_add-cancelable add-associative right_complementable well-unital
  associative domRing-like distributive non trivial doubleLoopStr, p being
Polynomial of n,L, a being Element of L, x being Function of n,L holds eval(a*p
  ,x) = a * eval(p,x);

theorem 
  for n being Ordinal, L being Abelian left_zeroed right_zeroed
  add-associative right_complementable well-unital associative commutative
  distributive non trivial doubleLoopStr, p being Polynomial of n,L, a being
  Element of L, x being Function of n,L holds eval(p*a,x) = eval(p,x) * a;

theorem 
  for n being Ordinal, L being left_zeroed right_zeroed
  left_add-cancelable add-associative right_complementable well-unital
associative commutative distributive domRing-like non trivial doubleLoopStr,
p being Polynomial of n,L, a being Element of L, x being Function of n,L holds
  eval(p*a,x) = eval(p,x) * a;

theorem 
  for n being Ordinal, L being Abelian left_zeroed right_zeroed
  add-associative right_complementable well-unital associative commutative
  distributive non trivial doubleLoopStr, p being Polynomial of n,L, a being
Element of L, x being Function of n,L holds eval((a |(n,L))*'p,x) = a * eval(p,
  x);

theorem 
  for n being Ordinal, L being Abelian left_zeroed right_zeroed
  add-associative right_complementable well-unital associative commutative
  distributive non trivial doubleLoopStr, p being Polynomial of n,L, a being
Element of L, x being Function of n,L holds eval(p*'(a |(n,L)),x) = eval(p,x) *
  a;














begin 

reserve x,y for Real,
  i, j for non empty Element of NAT,
  I, O for non empty set,
  s,s1,s2,s3 for Element of I,
  w, w1, w2 for FinSequence of I,
  t for Element of O,
  S for non empty FSM over I,
  q, q1 for State of S;

notation
  let I, S, q, w;
  synonym GEN(w,q) for (q,w)-admissible;
end;

registration
  let I, S, q, w;
  cluster GEN(w, q) -> non empty;
end;

theorem 
  GEN(<*s*>, q) = <*q, (the Tran of S).[q, s]*>;

theorem 
  GEN(<*s1,s2*>, q) = <*q, (the Tran of S).[q, s1],
  (the Tran of S).[(the Tran of S).[q, s1], s2]*>;

theorem 
  GEN(<*s1,s2,s3*>, q) = <*q, (the Tran of S).[q, s1],
  (the Tran of S).[(the Tran of S).[q, s1], s2],
  (the Tran of S).[(the Tran of S).[(the Tran of S).[q, s1], s2],s3] *>;

definition
  let I, S;
  attr S is calculating_type means


  for j holds for w1, w2 st w1.1 = w2.1 & j <= len(w1)+1 &
  j <= len(w2)+1 holds GEN(w1, the InitS of S).j = GEN(w2, the InitS of S).j;
end;

theorem 
  S is calculating_type implies for w1, w2 st w1.1 = w2.1 holds
  GEN(w1, the InitS of S), GEN(w2, the InitS of S) are_c=-comparable;

theorem 
  (for w1, w2 st w1.1 = w2.1 holds
  GEN(w1, the InitS of S), GEN(w2, the InitS of S) are_c=-comparable)
  implies S is calculating_type;

theorem 
  S is calculating_type implies
  for w1, w2 st w1.1 = w2.1 & len w1 = len w2 holds
  GEN(w1, the InitS of S) = GEN(w2, the InitS of S);

theorem 
  (for w1, w2 st w1.1 = w2.1 & len w1 = len w2 holds
  GEN(w1, the InitS of S) = GEN(w2, the InitS of S))
  implies S is calculating_type;

definition
  let I, S, q, s;
  pred q is_accessible_via s means


  ex w be FinSequence of I st the InitS of S,<*s*>^w-leads_to q;
end;

definition
  let I, S, q;
  attr q is accessible means


  ex w be FinSequence of I st the InitS of S,w-leads_to q;
end;

theorem 
  q is_accessible_via s implies q is accessible;

theorem 
  q is accessible & q <> the InitS of S implies ex s st q is_accessible_via s;

theorem 
  the InitS of S is accessible;

theorem 
  S is calculating_type & q is_accessible_via s implies
  ex m being non empty Element of NAT st
  for w st len w+1 >= m & w.1 = s holds q = GEN(w, the InitS of S).m &
  for i st i < m holds GEN(w, the InitS of S).i <> q;

definition
  let I, S;
  attr S is regular means


  for q being State of S holds q is accessible;
end;

theorem 
  (for s1,s2,q holds (the Tran of S).[q,s1] = (the Tran of S).[ q,s2]) implies
  S is calculating_type;

theorem 
  for S st (for s1,s2,q st q<>the InitS of S holds
  (the Tran of S).[q,s1] = (the Tran of S).[q,s2]) & for s,q1 holds
  (the Tran of S).[q1,s] <> the InitS of S holds S is calculating_type;

theorem 
  S is regular & S is calculating_type implies
  for s1, s2, q st q<>the InitS of S holds GEN(<*s1*>,q).2 = GEN(<*s2*>,q).2;

theorem 
  S is regular & S is calculating_type implies
  for s1, s2, q st q<>the InitS of S holds
  (the Tran of S).[q,s1] = (the Tran of S).[q,s2];

theorem 
  S is regular & S is calculating_type implies for s, s1, s2, q st
  (the Tran of S).[the InitS of S,s1] <>
  (the Tran of S).[the InitS of S,s2] holds
  (the Tran of S).[q,s] <> the InitS of S;

begin 

definition
  let I be set;
  struct (FSM over I) SM_Final over I (# carrier -> set,
    Tran -> Function of [: the carrier, I :], the carrier,
    InitS -> Element of the carrier, FinalS -> Subset of the carrier #);
end;

registration
  let I be set;
  cluster non empty for SM_Final over I;
end;

definition
  let I, s;
  let S be non empty SM_Final over I;
  pred s leads_to_final_state_of S means


  ex q being State of S st q is_accessible_via s & q in the FinalS of S;
end;

definition
  let I;
  let S be non empty SM_Final over I;
  attr S is halting means


  s leads_to_final_state_of S;
end;

definition
  let I be set, O be non empty set;
  struct (SM_Final over I, Moore-FSM over I, O) Moore-SM_Final over I,O (#
    carrier -> set, Tran -> Function of [: the carrier, I :], the carrier,
    OFun -> Function of the carrier, O, InitS -> Element of the carrier,
    FinalS -> Subset of the carrier #);
end;

registration
  let I be set, O be non empty set;
  cluster non empty strict for Moore-SM_Final over I, O;
end;

definition
  let I, O;
  let i,f be set;
  let o be Function of {i,f}, O;
  func I-TwoStatesMooreSM(i,f,o) -> non empty strict Moore-SM_Final over I, O
  means


  the carrier of it = {i,f} &
  the Tran of it = [:{i,f}, I :] --> f & the OFun of it = o &
  the InitS of it = i & the FinalS of it = {f};
end;

theorem 
  for i,f being set, o being Function of {i,f}, O
  for j st 1 < j & j <= len w+1 holds
  GEN(w, the InitS of I-TwoStatesMooreSM(i,f,o)).j = f;

registration
  let I, O;
  let i,f be set;
  let o be Function of {i,f}, O;
  cluster I-TwoStatesMooreSM(i,f,o) -> calculating_type;
end;

registration
  let I, O;
  let i,f be set;
  let o be Function of {i,f}, O;
  cluster I-TwoStatesMooreSM(i,f,o) -> halting;
end;

reserve n, m, o, p for non empty Element of NAT,
  M for non empty Moore-SM_Final over I, O,
  q for State of M;

theorem 
  M is calculating_type & s leads_to_final_state_of M implies
  ex m being non empty Element of NAT st
  (for w st len w+1 >= m & w.1 = s holds
  GEN(w, the InitS of M).m in the FinalS of M) &
  for w,j st j <= len w +1 & w.1 = s & j < m holds
  not GEN(w, the InitS of M).j in the FinalS of M;

begin 

definition
  let I, O, M, s;
  let t be set;
  pred t is_result_of s,M means


  ex m st for w st w.1=s holds
  (m <= len w+1 implies t = (the OFun of M).(GEN(w, the InitS of M).m) &
  GEN(w, the InitS of M).m in the FinalS of M) &
  for n st n < m & n <= len w+1 holds
  not GEN(w, the InitS of M).n in the FinalS of M;
end;

theorem 
  the InitS of M in the FinalS of M implies
  (the OFun of M).the InitS of M is_result_of s, M;

theorem 
  M is calculating_type & s leads_to_final_state_of M
  implies ex t st t is_result_of s, M;

theorem 
  s leads_to_final_state_of M implies
  for t1, t2 being Element of O st t1 is_result_of s, M & t2 is_result_of s, M
  holds t1 = t2;

theorem 
  for X being non empty set for f being BinOp of X
  for M being non empty Moore-SM_Final over [:X, X:], succ X
  st M is calculating_type & the carrier of M = succ X & the FinalS of M = X &
  the InitS of M = X & the OFun of M = id the carrier of M &
  for x,y being Element of X holds
  (the Tran of M).[the InitS of M, [x,y]] = f.(x,y) holds M is halting &
  for x,y being Element of X holds f.(x,y) is_result_of [x,y], M;

theorem 
  for M being non empty Moore-SM_Final over [:REAL, REAL:], succ REAL
  st M is calculating_type & the carrier of M = succ REAL &
  the FinalS of M = REAL & the InitS of M = REAL &
  the OFun of M = id the carrier of M &
  (for x,y st x >= y holds (the Tran of M).[the InitS of M, [x,y]] = x) &
  (for x,y st x < y holds (the Tran of M).[the InitS of M, [x,y]] = y)
  for x,y being Element of REAL holds max(x,y) is_result_of [x,y], M;

theorem 
  for M being non empty Moore-SM_Final over [:REAL, REAL:], succ REAL
  st M is calculating_type & the carrier of M = succ REAL &
  the FinalS of M = REAL & the InitS of M = REAL &
  the OFun of M = id the carrier of M &
  (for x,y st x < y holds (the Tran of M).[the InitS of M, [x,y]] = x) &
  (for x,y st x >= y holds (the Tran of M).[the InitS of M, [x,y]] = y)
  for x,y being Element of REAL holds min(x,y) is_result_of [x,y], M;

theorem 
  for M being non empty Moore-SM_Final over [:REAL, REAL:], succ REAL
  st M is calculating_type & the carrier of M = succ REAL &
  the FinalS of M = REAL & the InitS of M = REAL &
  the OFun of M = id the carrier of M &
  (for x,y holds (the Tran of M).[the InitS of M, [x,y]] = x+y)
  for x,y being Element of REAL holds x+y is_result_of [x,y], M;

theorem 
  for M being non empty Moore-SM_Final over [:REAL, REAL:], succ REAL
  st M is calculating_type & the carrier of M = succ REAL &
  the FinalS of M = REAL & the InitS of M = REAL &
  the OFun of M = id the carrier of M &
  (for x,y st x>0 or y>0 holds (the Tran of M).[the InitS of M, [x,y]] = 1) &
  (for x,y st (x=0 or y=0) & x <= 0 & y <=0
  holds (the Tran of M).[the InitS of M, [x,y]] = 0) &
  (for x,y st x<0 & y<0 holds (the Tran of M).[the InitS of M, [x,y]] = -1)
  for x,y being Element of REAL holds max(sgn x,sgn y) is_result_of [x,y], M;

registration
  let I, O;
  cluster calculating_type halting for non empty Moore-SM_Final over I, O;
end;

registration
  let I;
  cluster calculating_type halting for non empty SM_Final over I;
end;

definition
  let I, O;
  let M be calculating_type halting non empty Moore-SM_Final over I, O;
  let s;
  func Result(s, M) -> Element of O means


  it is_result_of s, M;
end;

theorem 
  for f being Function of {0, 1}, O holds
  Result(s, I-TwoStatesMooreSM(0,1,f)) = f.1;

theorem 
  for M being calculating_type halting
  non empty Moore-SM_Final over [:REAL, REAL:], succ REAL
  st the carrier of M = succ REAL & the FinalS of M = REAL &
  the InitS of M = REAL & the OFun of M = id the carrier of M &
  (for x,y st x >= y holds (the Tran of M).[the InitS of M, [x,y]] = x) &
  (for x,y st x < y holds (the Tran of M).[the InitS of M, [x,y]] = y)
  for x,y being Element of REAL holds Result([x,y], M) = max(x,y);

theorem 
  for M being calculating_type halting
  non empty Moore-SM_Final over [:REAL, REAL:], succ REAL
  st the carrier of M = succ REAL & the FinalS of M = REAL &
  the InitS of M = REAL & the OFun of M = id the carrier of M &
  (for x,y st x < y holds (the Tran of M).[the InitS of M, [x,y]] = x) &
  (for x,y st x >= y holds (the Tran of M).[the InitS of M, [x,y]] = y)
  for x,y being Element of REAL holds Result([x,y], M) = min(x,y);

theorem 
  for M being calculating_type halting
  non empty Moore-SM_Final over [:REAL, REAL:], succ REAL
  st the carrier of M = succ REAL & the FinalS of M = REAL &
  the InitS of M = REAL & the OFun of M = id the carrier of M &
  (for x,y holds (the Tran of M).[the InitS of M, [x,y]] = x+y)
  for x,y being Element of REAL holds Result([x,y], M) = x+y;

theorem 
  for M being calculating_type halting
  non empty Moore-SM_Final over [:REAL, REAL:], succ REAL
  st the carrier of M = succ REAL & the FinalS of M = REAL &
  the InitS of M = REAL & the OFun of M = id the carrier of M &
  (for x,y st x>0 or y>0 holds (the Tran of M).[the InitS of M, [x,y]] = 1) &
  (for x,y st (x=0 or y=0) & x <= 0 & y <=0
  holds (the Tran of M).[the InitS of M, [x,y]] = 0) &
  (for x,y st x<0 & y<0 holds (the Tran of M).[the InitS of M, [x,y]] = -1)
  for x,y being Element of REAL holds Result([x,y], M) = max(sgn x, sgn y);














begin 

reserve i,j,k,n for Element of NAT;

theorem 
  for C being compact connected non vertical non horizontal Subset
  of TOP-REAL 2 holds (W-min L~Cage(C,n))..Cage(C,n) > 1;

theorem 
  for C being compact connected non vertical non horizontal Subset
  of TOP-REAL 2 holds (E-max L~Cage(C,n))..Cage(C,n) > 1;

theorem 
  for C being compact connected non vertical non horizontal Subset
  of TOP-REAL 2 holds (S-max L~Cage(C,n))..Cage(C,n) > 1;

begin 

theorem 
  for f being non constant standard special_circular_sequence, p being
Point of TOP-REAL 2 st p in rng f holds left_cell(f,p..f) = left_cell(Rotate(f,
  p),1);

theorem 
  for f being non constant standard special_circular_sequence, p
being Point of TOP-REAL 2 st p in rng f holds right_cell(f,p..f) = right_cell(
  Rotate(f,p),1);

theorem 
  for C being compact connected non vertical non horizontal non empty
Subset of TOP-REAL 2 holds W-min C in right_cell(Rotate(Cage(C,n),W-min L~Cage(
  C,n)),1);

theorem 
  for C being compact connected non vertical non horizontal non empty
Subset of TOP-REAL 2 holds E-max C in right_cell(Rotate(Cage(C,n),E-max L~Cage(
  C,n)),1);

theorem 
  for C being compact connected non vertical non horizontal non empty
Subset of TOP-REAL 2 holds S-max C in right_cell(Rotate(Cage(C,n),S-max L~Cage(
  C,n)),1);

begin 

theorem 
  for f being clockwise_oriented non constant standard
special_circular_sequence for p being Point of TOP-REAL 2 st p`1 < W-bound (L~f
  ) holds p in LeftComp f;

theorem 
  for f being clockwise_oriented non constant standard
special_circular_sequence for p being Point of TOP-REAL 2 st p`1 > E-bound (L~f
  ) holds p in LeftComp f;

theorem 
  for f being clockwise_oriented non constant standard
special_circular_sequence for p being Point of TOP-REAL 2 st p`2 < S-bound (L~f
  ) holds p in LeftComp f;

theorem 
  for f being clockwise_oriented non constant standard
special_circular_sequence for p being Point of TOP-REAL 2 st p`2 > N-bound (L~f
  ) holds p in LeftComp f;

theorem 
  for f being clockwise_oriented non constant standard
special_circular_sequence for G being Go-board st f is_sequence_on G for i,j,k
being Element of NAT st 1 <= k & k+1 <= len f & [i,j] in Indices G & [i+1,j] in
  Indices G & f/.k = G*(i+1,j) & f/.(k+1) = G*(i,j) holds j < width G;

theorem 
  for f being clockwise_oriented non constant standard
special_circular_sequence for G being Go-board st f is_sequence_on G for i,j,k
being Element of NAT st 1 <= k & k+1 <= len f & [i,j] in Indices G & [i,j+1] in
  Indices G & f/.k = G*(i,j) & f/.(k+1) = G*(i,j+1) holds i < len G;

theorem 
  for f being clockwise_oriented non constant standard
special_circular_sequence for G being Go-board st f is_sequence_on G for i,j,k
being Element of NAT st 1 <= k & k+1 <= len f & [i,j] in Indices G & [i+1,j] in
  Indices G & f/.k = G*(i,j) & f/.(k+1) = G*(i+1,j) holds j > 1;

theorem 
  for f being clockwise_oriented non constant standard
special_circular_sequence for G being Go-board st f is_sequence_on G for i,j,k
being Element of NAT st 1 <= k & k+1 <= len f & [i,j] in Indices G & [i,j+1] in
  Indices G & f/.k = G*(i,j+1) & f/.(k+1) = G*(i,j) holds i > 1;

theorem 
  for f being clockwise_oriented non constant standard
special_circular_sequence for G being Go-board st f is_sequence_on G for i,j,k
being Element of NAT st 1 <= k & k+1 <= len f & [i,j] in Indices G & [i+1,j] in
Indices G & f/.k = G*(i+1,j) & f/.(k+1) = G*(i,j) holds (f/.k)`2 <> N-bound L~f
;

theorem 
  for f being clockwise_oriented non constant standard
special_circular_sequence for G being Go-board st f is_sequence_on G for i,j,k
being Element of NAT st 1 <= k & k+1 <= len f & [i,j] in Indices G & [i,j+1] in
Indices G & f/.k = G*(i,j) & f/.(k+1) = G*(i,j+1) holds (f/.k)`1 <> E-bound L~f
;

theorem 
  for f being clockwise_oriented non constant standard
special_circular_sequence for G being Go-board st f is_sequence_on G for i,j,k
being Element of NAT st 1 <= k & k+1 <= len f & [i,j] in Indices G & [i+1,j] in
Indices G & f/.k = G*(i,j) & f/.(k+1) = G*(i+1,j) holds (f/.k)`2 <> S-bound L~f
;

theorem 
  for f being clockwise_oriented non constant standard
special_circular_sequence for G being Go-board st f is_sequence_on G for i,j,k
being Element of NAT st 1 <= k & k+1 <= len f & [i,j] in Indices G & [i,j+1] in
Indices G & f/.k = G*(i,j+1) & f/.(k+1) = G*(i,j) holds (f/.k)`1 <> W-bound L~f
;

theorem 
  for f being clockwise_oriented non constant standard
special_circular_sequence for G being Go-board for k being Element of NAT st f
  is_sequence_on G & 1 <= k & k+1 <= len f & f/.k = W-min L~f ex i,j be Element
of NAT st [i,j] in Indices G & [i,j+1] in Indices G & f/.k = G*(i,j) & f/.(k+1)
  = G*(i,j+1);

theorem 
  for f being clockwise_oriented non constant standard
special_circular_sequence for G being Go-board for k being Element of NAT st f
  is_sequence_on G & 1 <= k & k+1 <= len f & f/.k = N-min L~f ex i,j be Element
of NAT st [i,j] in Indices G & [i+1,j] in Indices G & f/.k = G*(i,j) & f/.(k+1)
  = G*(i+1,j);

theorem 
  for f being clockwise_oriented non constant standard
special_circular_sequence for G being Go-board for k being Element of NAT st f
  is_sequence_on G & 1 <= k & k+1 <= len f & f/.k = E-max L~f ex i,j be Element
of NAT st [i,j+1] in Indices G & [i,j] in Indices G & f/.k = G*(i,j+1) & f/.(k+
  1) = G*(i,j);

theorem 
  for f being clockwise_oriented non constant standard
special_circular_sequence for G being Go-board for k being Element of NAT st f
  is_sequence_on G & 1 <= k & k+1 <= len f & f/.k = S-max L~f ex i,j be Element
of NAT st [i+1,j] in Indices G & [i,j] in Indices G & f/.k = G*(i+1,j) & f/.(k+
  1) = G*(i,j);

theorem 
  for f being non constant standard special_circular_sequence holds f is
  clockwise_oriented iff Rotate(f,W-min L~f)/.2 in W-most L~f;

theorem 
  for f being non constant standard special_circular_sequence holds f is
  clockwise_oriented iff Rotate(f,E-max L~f)/.2 in E-most L~f;

theorem 
  for f being non constant standard special_circular_sequence holds f is
  clockwise_oriented iff Rotate(f,S-max L~f)/.2 in S-most L~f;

theorem 
  for C being compact non vertical non horizontal non empty
being_simple_closed_curve Subset of TOP-REAL 2 for p being Point of TOP-REAL 2
holds p`1 = (W-bound C + E-bound C)/2 & i > 0 & 1 <= k & k <= width Gauge(C,i)
& Gauge(C,i)*(Center Gauge(C,i),k) in Upper_Arc L~Cage(C,i) & p`2
 = upper_bound(proj2.:
  (LSeg(Gauge(C,1)*(Center Gauge(C,1),1), Gauge(C,i)*(Center Gauge(C,i),k)) /\
  Lower_Arc L~Cage(C,i))) implies ex j st 1 <= j & j <= width Gauge(C,i) & p =
  Gauge(C,i)*(Center Gauge(C,i),j);














begin

theorem 
  for x,y,z being set st x <> z & y <> z holds {x,y} \ {z} = {x,y};

theorem 
  for x,y,z being set holds x <> [<*x,y*>, z] & y <> [<*x,y*>, z];

registration
  cluster void -> unsplit gate`1=arity gate`2isBoolean for ManySortedSign;
end;

registration
  cluster strict void for ManySortedSign;
end;

definition
  let x be set;
  func SingleMSS(x) -> strict void ManySortedSign means


  the carrier of it = {x};
end;

registration
  let x be set;
  cluster SingleMSS(x) -> non empty;
end;

definition
  let x be set;
  func SingleMSA(x) -> Boolean strict MSAlgebra over SingleMSS(x) means

  not contradiction;
end;

theorem 
  for x being set, S being ManySortedSign holds SingleMSS x tolerates S;

theorem 
  for x being set, S being non empty ManySortedSign st x in the carrier of S
  holds (SingleMSS x) +* S = the ManySortedSign of S;

theorem 
  for x being set, S being non empty strict ManySortedSign
  for A being Boolean MSAlgebra over S st x in the carrier of S holds
  (SingleMSA x) +* A = the MSAlgebra of A;

notation
  synonym <*> for {};
end;

definition
  let n be Nat;
  let x,y be FinSequence;
  func n-BitAdderStr(x,y) ->
  unsplit gate`1=arity gate`2isBoolean non void strict
  non empty ManySortedSign means


  ex f,g being ManySortedSet of NAT st
  it = f.n & f.0 = 1GateCircStr(<*>,(0-tuples_on BOOLEAN)-->FALSE) &
  g.0 = [<*>, (0-tuples_on BOOLEAN)-->FALSE] &
  for n being Nat, S being non empty ManySortedSign, z be set
  st S = f.n & z = g.n
  holds f.(n+1) = S +* BitAdderWithOverflowStr(x .(n+1), y.(n+1), z) &
  g.(n+1) = MajorityOutput(x .(n+1), y.(n+1), z);
end;

definition
  let n be Nat;
  let x,y be FinSequence;
  func n-BitAdderCirc(x,y) ->
  Boolean gate`2=den strict Circuit of n-BitAdderStr(x,y) means


  ex f,g,h being ManySortedSet of NAT st n-BitAdderStr(x,y) = f.n & it = g.n &
  f.0 = 1GateCircStr(<*>,(0-tuples_on BOOLEAN)-->FALSE) &
  g.0 = 1GateCircuit(<*>,(0-tuples_on BOOLEAN)-->FALSE) &
  h.0 = [<*>, (0-tuples_on BOOLEAN)-->FALSE] &
  for n being Nat, S being non empty ManySortedSign,
  A being non-empty MSAlgebra over S
  for z being set st S = f.n & A = g.n & z = h.n holds
  f.(n+1) = S +* BitAdderWithOverflowStr(x .(n+1), y.(n+1), z) &
  g.(n+1) = A +* BitAdderWithOverflowCirc(x .(n+1), y.(n+1), z) &
  h.(n+1) = MajorityOutput(x .(n+1), y.(n+1), z);
end;

definition
  let n be Nat;
  let x,y be FinSequence;
  func n-BitMajorityOutput(x,y) ->
  Element of InnerVertices (n-BitAdderStr(x,y)) means


  ex h being ManySortedSet of NAT st
  it = h.n & h.0 = [<*>, (0-tuples_on BOOLEAN)-->FALSE] &
  for n being Nat, z be set st z = h.n holds
  h.(n+1) = MajorityOutput(x .(n+1), y.(n+1), z);
end;

theorem 
  for x,y being FinSequence, f,g,h being ManySortedSet of NAT st
  f.0 = 1GateCircStr(<*>,(0-tuples_on BOOLEAN)-->FALSE) &
  g.0 = 1GateCircuit(<*>,(0-tuples_on BOOLEAN)-->FALSE) &
  h.0 = [<*>, (0-tuples_on BOOLEAN)-->FALSE] &
  for n being Nat, S being non empty ManySortedSign,
  A being non-empty MSAlgebra over S
  for z being set st S = f.n & A = g.n & z = h.n holds
  f.(n+1) = S +* BitAdderWithOverflowStr(x .(n+1), y.(n+1), z) &
  g.(n+1) = A +* BitAdderWithOverflowCirc(x .(n+1), y.(n+1), z) &
  h.(n+1) = MajorityOutput(x .(n+1), y.(n+1), z)
  for n being Nat holds
  n-BitAdderStr(x,y) = f.n & n-BitAdderCirc(x,y) = g.n &
  n-BitMajorityOutput(x,y) = h.n;

theorem 
  for a,b being FinSequence holds
  0-BitAdderStr(a,b) = 1GateCircStr(<*>,(0-tuples_on BOOLEAN)-->FALSE) &
  0-BitAdderCirc(a,b) = 1GateCircuit(<*>,(0-tuples_on BOOLEAN)-->FALSE) &
  0-BitMajorityOutput(a,b) = [<*>, (0-tuples_on BOOLEAN)-->FALSE];

theorem 
  for a,b being FinSequence, c being set st
  c = [<*>, (0-tuples_on BOOLEAN)-->FALSE] holds
  1-BitAdderStr(a,b) = 1GateCircStr(<*>, (0-tuples_on BOOLEAN)-->FALSE)+*
  BitAdderWithOverflowStr(a.1, b.1, c) &
  1-BitAdderCirc(a,b) = 1GateCircuit(<*>, (0-tuples_on BOOLEAN)-->FALSE)+*
  BitAdderWithOverflowCirc(a.1, b.1, c) &
  1-BitMajorityOutput(a,b) = MajorityOutput(a.1, b.1, c);

theorem 
  for a,b,c being set st c = [<*>, (0-tuples_on BOOLEAN)-->FALSE] holds
  1-BitAdderStr(<*a*>,<*b*>) =
  1GateCircStr(<*>, (0-tuples_on BOOLEAN)-->FALSE)+*
  BitAdderWithOverflowStr(a, b, c) & 1-BitAdderCirc(<*a*>,<*b*>) =
  1GateCircuit(<*>, (0-tuples_on BOOLEAN)-->FALSE)+*
  BitAdderWithOverflowCirc(a, b, c) &
  1-BitMajorityOutput(<*a*>,<*b*>) = MajorityOutput(a, b, c);

theorem 
  for n be Element of NAT for p,q being FinSeqLen of n
  for p1,p2, q1,q2 being FinSequence holds
  n-BitAdderStr(p^p1, q^q1) = n-BitAdderStr(p^p2, q^q2) &
  n-BitAdderCirc(p^p1, q^q1) = n-BitAdderCirc(p^p2, q^q2) &
  n-BitMajorityOutput(p^p1, q^q1) = n-BitMajorityOutput(p^p2, q^q2);

theorem 
  for n be Element of NAT for x,y being FinSeqLen of n for a,b being set holds
  (n+1)-BitAdderStr(x^<*a*>, y^<*b*>) = n-BitAdderStr(x, y) +*
  BitAdderWithOverflowStr(a, b, n-BitMajorityOutput(x, y)) &
  (n+1)-BitAdderCirc(x^<*a*>, y^<*b*>) = n-BitAdderCirc(x, y) +*
  BitAdderWithOverflowCirc(a, b, n-BitMajorityOutput(x, y)) &
  (n+1)-BitMajorityOutput(x^<*a*>, y^<*b*>) =
  MajorityOutput(a, b, n-BitMajorityOutput(x, y));

theorem 
  for n be Element of NAT for x,y being FinSequence holds
  (n+1)-BitAdderStr(x, y) = n-BitAdderStr(x, y) +*
  BitAdderWithOverflowStr(x .(n+1), y.(n+1), n-BitMajorityOutput(x, y)) &
  (n+1)-BitAdderCirc(x, y) = n-BitAdderCirc(x, y) +*
  BitAdderWithOverflowCirc(x .(n+1), y.(n+1), n-BitMajorityOutput(x, y)) &
  (n+1)-BitMajorityOutput(x, y) =
  MajorityOutput(x .(n+1), y.(n+1), n-BitMajorityOutput(x, y));

theorem 
  for n,m be Element of NAT st n <= m for x,y being FinSequence holds
  InnerVertices (n-BitAdderStr(x,y)) c= InnerVertices (m-BitAdderStr(x,y));

theorem 
  for n be Element of NAT for x,y being FinSequence holds
  InnerVertices ((n+1)-BitAdderStr(x,y)) =
  InnerVertices (n-BitAdderStr(x,y)) \/
  InnerVertices BitAdderWithOverflowStr(x .(n+1), y.(n+1),
  n-BitMajorityOutput(x,y));

definition
  let k,n be Nat such that
 k >= 1 and
 k <= n;
  let x,y be FinSequence;
  func (k,n)-BitAdderOutput(x,y) ->
  Element of InnerVertices (n-BitAdderStr(x,y)) means


  ex i being Element of NAT st k = i+1 &
  it = BitAdderOutput(x .k, y.k, i-BitMajorityOutput(x,y));
end;

theorem 
  for n,k being Element of NAT st k < n for x,y being FinSequence holds
  (k+1,n)-BitAdderOutput(x,y) =
  BitAdderOutput(x .(k+1), y.(k+1), k-BitMajorityOutput(x,y));

theorem 
  for n being Element of NAT for x,y being FinSequence holds
  InnerVertices (n-BitAdderStr(x,y)) is Relation;

theorem 
  for x,y,c being set holds InnerVertices MajorityIStr(x,y,c) =
  {[<*x,y*>,'&'], [<*y,c*>,'&'], [<*c,x*>,'&']};

theorem 
  for x,y,c being set st
  x <> [<*y,c*>, '&'] & y <> [<*c,x*>, '&'] & c <> [<*x,y*>, '&']
  holds InputVertices MajorityIStr(x,y,c) = {x,y,c};

theorem 
  for x,y,c being set holds InnerVertices MajorityStr(x,y,c) =
  {[<*x,y*>,'&'], [<*y,c*>,'&'], [<*c,x*>,'&']} \/ {MajorityOutput(x,y,c)};

theorem 
  for x,y,c being set st
  x <> [<*y,c*>, '&'] & y <> [<*c,x*>, '&'] & c <> [<*x,y*>, '&']
  holds InputVertices MajorityStr(x,y,c) = {x,y,c};

theorem 
  for S1,S2 being non empty ManySortedSign
  st S1 tolerates S2 & InputVertices S1 = InputVertices S2
  holds InputVertices (S1+*S2) = InputVertices S1;

theorem 
  for x,y,c being set st
  x <> [<*y,c*>, '&'] & y <> [<*c,x*>, '&'] & c <> [<*x,y*>, '&'] &
  c <> [<*x,y*>, 'xor'] holds
  InputVertices BitAdderWithOverflowStr(x,y,c) = {x,y,c};

theorem 
  for x,y,c being set holds InnerVertices BitAdderWithOverflowStr(x,y,c) =
  {[<*x,y*>, 'xor'], 2GatesCircOutput(x,y,c,'xor')} \/
  {[<*x,y*>,'&'], [<*y,c*>,'&'], [<*c,x*>,'&']} \/ {MajorityOutput(x,y,c)};

registration
  cluster empty -> non pair for set;
end;

registration
  cluster empty -> nonpair-yielding for Function;
  let f be nonpair-yielding Function;
  let x be set;
  cluster f.x -> non pair;
end;

registration
  let n be Element of NAT;
  let x,y be FinSequence;
  cluster n-BitMajorityOutput(x,y) -> pair;
end;

theorem 
  for x,y being FinSequence, n being Element of NAT holds
  (n-BitMajorityOutput(x,y))`1 = <*> &
  (n-BitMajorityOutput(x,y))`2 = (0-tuples_on BOOLEAN)-->FALSE &
  proj1 (n-BitMajorityOutput(x,y))`2 = 0-tuples_on BOOLEAN or
  card (n-BitMajorityOutput(x,y))`1 = 3 & (n-BitMajorityOutput(x,y))`2 = or3 &
  proj1 (n-BitMajorityOutput(x,y))`2 = 3-tuples_on BOOLEAN;

theorem 
  for n being Element of NAT, x,y being FinSequence, p being set holds
  n-BitMajorityOutput(x,y) <> [p, '&'] &
  n-BitMajorityOutput(x,y) <> [p, 'xor'];

theorem 
  for f,g being nonpair-yielding FinSequence for n being Element of NAT holds
  InputVertices ((n+1)-BitAdderStr(f,g)) =
  (InputVertices (n-BitAdderStr(f,g)))\/
  ((InputVertices BitAdderWithOverflowStr(f.(n+1),g.(n+1),
  n-BitMajorityOutput(f,g)) \ {n-BitMajorityOutput(f,g)})) &
  InnerVertices (n-BitAdderStr(f,g)) is Relation &
  InputVertices (n-BitAdderStr(f,g)) is without_pairs;

theorem 
  for n being Element of NAT
  for x,y being nonpair-yielding FinSeqLen of n holds
  InputVertices (n-BitAdderStr(x,y)) = rng x \/ rng y;

theorem 
  for x,y,c being set for s being State of MajorityCirc(x,y,c)
  for a1,a2,a3 being Element of BOOLEAN st
  a1 = s.[<*x,y*>,'&'] & a2 = s.[<*y,c*>,'&'] & a3 = s.[<*c,x*>,'&']
  holds (Following s).MajorityOutput(x,y,c) = a1 'or' a2 'or' a3;

theorem 
  for x,y,c being set st
  x <> [<*y,c*>, '&'] & y <> [<*c,x*>, '&'] & c <> [<*x,y*>, '&']
  for s being State of MajorityCirc(x,y,c)
  holds Following(s,2) is stable;

theorem 
  for x,y,c being set st
  x <> [<*y,c*>, '&'] & y <> [<*c,x*>, '&'] & c <> [<*x,y*>, '&'] &
  c <> [<*x,y*>, 'xor'] for s being State of BitAdderWithOverflowCirc(x,y,c)
  for a1,a2,a3 being Element of BOOLEAN st a1 = s.x & a2 = s.y & a3 = s.c holds
  (Following(s,2)).BitAdderOutput(x,y,c) = a1 'xor' a2 'xor' a3 &
  (Following(s,2)).MajorityOutput(x,y,c)
  = a1 '&' a2 'or' a2 '&' a3 'or' a3 '&' a1;

theorem 
  for x,y,c being set st
  x <> [<*y,c*>, '&'] & y <> [<*c,x*>, '&'] & c <> [<*x,y*>, '&'] &
  c <> [<*x,y*>, 'xor'] for s being State of BitAdderWithOverflowCirc(x,y,c)
  holds Following(s,2) is stable;

theorem 
  for n being Element of NAT for x,y being nonpair-yielding FinSeqLen of n
  for s being State of n-BitAdderCirc(x,y) holds Following(s,1+2*n) is stable;

theorem 
  for i being Element of NAT, x being FinSeqLen of i+1
  ex y being FinSeqLen of i, a being set st x = y^<*a*>;

theorem 
  for i being Element of NAT, x being nonpair-yielding FinSeqLen of i+1
  ex y being nonpair-yielding FinSeqLen of i,
  a being non pair set st x = y^<*a*>;

theorem 
  for n being Element of NAT
  ex N being Function of NAT,NAT st N.0 = 1 & N.1 = 2 & N.2 = n;














begin

reserve n for Element of NAT;

theorem 
  for G be Go-board for i1,i2,j1,j2 be Element of NAT st 1 <= j1 &
j1 <= width G & 1 <= j2 & j2 <= width G & 1 <= i1 & i1 < i2 & i2 <= len G holds
  G*(i1,j1)`1 < G*(i2,j2)`1;

theorem 
  for G be Go-board for i1,i2,j1,j2 be Element of NAT st 1 <= i1 &
i1 <= len G & 1 <= i2 & i2 <= len G & 1 <= j1 & j1 < j2 & j2 <= width G holds G
  *(i1,j1)`2 < G*(i2,j2)`2;

registration
  let f be non empty FinSequence;
  let g be FinSequence;
  cluster f^'g -> non empty;
end;

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for n be Element of NAT holds L~(Cage(C,n)-:E-max L~Cage(C,n)) /\ L~
  (Cage(C,n):-E-max L~Cage(C,n)) = {N-min L~Cage(C,n),E-max L~Cage(C,n)};

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 holds Upper_Seq(C,n) = Rotate(Cage(C,n),E-max L~Cage(C,n)):-W-min L~
  Cage(C,n);

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL 2
  holds W-min L~Cage(C,n) in rng Upper_Seq(C,n) & W-min L~Cage(C,n) in L~
  Upper_Seq(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 holds W-max L~Cage(C,n) in rng Upper_Seq(C,n) & W-max L~Cage(C,n) in
  L~Upper_Seq(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 holds N-min L~Cage(C,n) in rng Upper_Seq(C,n) & N-min L~Cage(C,n) in
  L~Upper_Seq(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 holds N-max L~Cage(C,n) in rng Upper_Seq(C,n) & N-max L~Cage(C,n) in
  L~Upper_Seq(C,n);

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL 2
  holds E-max L~Cage(C,n) in rng Upper_Seq(C,n) & E-max L~Cage(C,n) in L~
  Upper_Seq(C,n);

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL 2
  holds E-max L~Cage(C,n) in rng Lower_Seq(C,n) & E-max L~Cage(C,n) in L~
  Lower_Seq(C,n);

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL 2
  holds E-min L~Cage(C,n) in rng Lower_Seq(C,n) & E-min L~Cage(C,n) in L~
  Lower_Seq(C,n);

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL
  2 holds S-max L~Cage(C,n) in rng Lower_Seq(C,n) & S-max L~Cage(C,n) in L~
  Lower_Seq(C,n);

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL 2
  holds S-min L~Cage(C,n) in rng Lower_Seq(C,n) & S-min L~Cage(C,n) in L~
  Lower_Seq(C,n);

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL 2
  holds W-min L~Cage(C,n) in rng Lower_Seq(C,n) & W-min L~Cage(C,n) in L~
  Lower_Seq(C,n);

theorem 
  for X,Y be non empty compact Subset of TOP-REAL 2 st X c= Y &
  N-min Y in X holds N-min X = N-min Y;

theorem 
  for X,Y be non empty compact Subset of TOP-REAL 2 st X c= Y &
  N-max Y in X holds N-max X = N-max Y;

theorem 
  for X,Y be non empty compact Subset of TOP-REAL 2 st X c= Y &
  E-min Y in X holds E-min X = E-min Y;

theorem 
  for X,Y be non empty compact Subset of TOP-REAL 2 st X c= Y &
  E-max Y in X holds E-max X = E-max Y;

theorem 
  for X,Y be non empty compact Subset of TOP-REAL 2 st X c= Y &
  S-min Y in X holds S-min X = S-min Y;

theorem 
  for X,Y be non empty compact Subset of TOP-REAL 2 st X c= Y &
  S-max Y in X holds S-max X = S-max Y;

theorem 
  for X,Y be non empty compact Subset of TOP-REAL 2 st X c= Y &
  W-min Y in X holds W-min X = W-min Y;

theorem 
  for X,Y be non empty compact Subset of TOP-REAL 2 st X c= Y &
  W-max Y in X holds W-max X = W-max Y;

theorem 
  for X,Y be non empty compact Subset of TOP-REAL 2 st N-bound X
  <= N-bound Y holds N-bound (X\/Y) = N-bound Y;

theorem 
  for X,Y be non empty compact Subset of TOP-REAL 2 st E-bound X
  <= E-bound Y holds E-bound (X\/Y) = E-bound Y;

theorem 
  for X,Y be non empty compact Subset of TOP-REAL 2 st S-bound X
  <= S-bound Y holds S-bound (X\/Y) = S-bound X;

theorem 
  for X,Y be non empty compact Subset of TOP-REAL 2 st W-bound X
  <= W-bound Y holds W-bound (X\/Y) = W-bound X;

theorem 
  for X,Y be non empty compact Subset of TOP-REAL 2 st N-bound X <
  N-bound Y holds N-min (X\/Y) = N-min Y;

theorem 
  for X,Y be non empty compact Subset of TOP-REAL 2 st N-bound X <
  N-bound Y holds N-max (X\/Y) = N-max Y;

theorem 
  for X,Y be non empty compact Subset of TOP-REAL 2 st E-bound X <
  E-bound Y holds E-min (X\/Y) = E-min Y;

theorem 
  for X,Y be non empty compact Subset of TOP-REAL 2 st E-bound X <
  E-bound Y holds E-max (X\/Y) = E-max Y;

theorem 
  for X,Y be non empty compact Subset of TOP-REAL 2 st S-bound X <
  S-bound Y holds S-min (X\/Y) = S-min X;

theorem 
  for X,Y be non empty compact Subset of TOP-REAL 2 st S-bound X <
  S-bound Y holds S-max (X\/Y) = S-max X;

theorem 
  for X,Y be non empty compact Subset of TOP-REAL 2 st W-bound X <
  W-bound Y holds W-min (X\/Y) = W-min X;

theorem 
  for X,Y be non empty compact Subset of TOP-REAL 2 st W-bound X <
  W-bound Y holds W-max (X\/Y) = W-max X;

theorem 
  for f be FinSequence of TOP-REAL 2 for p be Point of TOP-REAL 2
  st f is being_S-Seq & p in L~f holds L_Cut(f,p)/.len L_Cut(f,p) = f/.len f;

theorem 
  for f be non constant standard special_circular_sequence for p,q
  be Point of TOP-REAL 2 for g be connected Subset of TOP-REAL 2 st p in
  RightComp f & q in LeftComp f & p in g & q in g holds g meets L~f;

registration
  cluster non constant standard s.c.c. for
being_S-Seq FinSequence of TOP-REAL 2;
end;

theorem 
  for f be S-Sequence_in_R2 for p be Point of TOP-REAL 2 st p in
  rng f holds L_Cut(f,p) = mid(f,p..f,len f);

theorem 
  for M be Go-board for f be S-Sequence_in_R2 st f is_sequence_on
M for p be Point of TOP-REAL 2 st p in rng f holds R_Cut(f,p) is_sequence_on M;

theorem 
  for M be Go-board for f be S-Sequence_in_R2 st f is_sequence_on
M for p be Point of TOP-REAL 2 st p in rng f holds L_Cut(f,p) is_sequence_on M;

theorem 
  for G be Go-board for f be FinSequence of TOP-REAL 2 st f
is_sequence_on G for i,j be Element of NAT st 1 <= i & i <= len G & 1 <= j & j
  <= width G holds G*(i,j) in L~f implies G*(i,j) in rng f;

theorem 
  for f be S-Sequence_in_R2 for g be FinSequence of TOP-REAL 2 holds g
is unfolded s.n.c. one-to-one & L~f /\ L~g = {f/.1} & f/.1 = g/.len g & (for i
be Element of NAT st 1<=i & i+2 <= len f holds LSeg(f,i) /\ LSeg(f/.len f,g/.1)
= {}) & (for i be Element of NAT st 2<=i & i+1 <= len g holds LSeg(g,i) /\ LSeg
  (f/.len f,g/.1) = {}) implies f^g is s.c.c.;

theorem 
  for C be compact non vertical non horizontal non empty Subset of
  TOP-REAL 2 ex i be Element of NAT st 1 <= i & i+1 <= len Gauge(C,n) & W-min C
  in cell(Gauge(C,n),1,i) & W-min C <> Gauge(C,n)*(2,i);

theorem 
  for f be S-Sequence_in_R2 for p be Point of TOP-REAL 2 st p in
  L~f & f.len f in L~R_Cut(f,p) holds f.len f = p;

theorem 
  for f be FinSequence of TOP-REAL 2 for p be Point of TOP-REAL 2
  holds R_Cut (f,p) <> {};

theorem 
  for f be FinSequence of TOP-REAL 2 for p be Point of TOP-REAL 2
  st p in L~f holds R_Cut(f,p)/.(len R_Cut(f,p)) = p;

theorem 
  for C be compact connected non vertical non horizontal Subset of
  TOP-REAL 2 for p be Point of TOP-REAL 2 holds p in L~Upper_Seq(C,n) & p`1 =
  E-bound L~Cage(C,n) implies p = E-max L~Cage(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of
  TOP-REAL 2 for p be Point of TOP-REAL 2 holds p in L~Lower_Seq(C,n) & p`1 =
  W-bound L~Cage(C,n) implies p = W-min L~Cage(C,n);

theorem 
  for G be Go-board for f,g be FinSequence of TOP-REAL 2 for k be
  Element of NAT holds 1 <= k & k < len f & f^g is_sequence_on G implies
left_cell(f^g,k,G) = left_cell(f,k,G) & right_cell(f^g,k,G) = right_cell(f,k,G)
;

theorem 
  for D be set for f,g be FinSequence of D for i be Element of NAT
  st i <= len f holds (f^'g)|i = f|i;

theorem 
  for D be set for f,g be FinSequence of D holds (f^'g)|(len f) = f;

theorem 
  for G be Go-board for f,g be FinSequence of TOP-REAL 2 for k be
  Element of NAT holds 1 <= k & k < len f & f^'g is_sequence_on G implies
left_cell(f^'g,k,G) = left_cell(f,k,G) & right_cell(f^'g,k,G) = right_cell(f,k,
  G);

theorem 
  for G be Go-board for f be S-Sequence_in_R2 for p be Point of
TOP-REAL 2 for k be Element of NAT st 1 <= k & k < p..f & f is_sequence_on G &
  p in rng f holds left_cell(R_Cut(f,p),k,G) = left_cell(f,k,G) & right_cell(
  R_Cut(f,p),k,G) = right_cell(f,k,G);

theorem 
  for G be Go-board for f be FinSequence of TOP-REAL 2 for p be
  Point of TOP-REAL 2 for k be Element of NAT st 1 <= k & k < p..f & f
is_sequence_on G holds left_cell(f-:p,k,G) = left_cell(f,k,G) & right_cell(f-:p
  ,k,G) = right_cell(f,k,G);

theorem 
  for f,g be FinSequence of TOP-REAL 2 st f is unfolded s.n.c.
one-to-one & g is unfolded s.n.c. one-to-one & f/.len f = g/.1 & L~f /\ L~g = {
  g/.1} holds f^'g is s.n.c.;

theorem 
  for f,g be FinSequence of TOP-REAL 2 st f is one-to-one & g is
  one-to-one & rng f /\ rng g c= {g/.1} holds f^'g is one-to-one;

theorem 
  for f be FinSequence of TOP-REAL 2 for p be Point of TOP-REAL 2
  st f is being_S-Seq & p in rng f & p <> f.1 holds Index(p,f)+1 = p..f;

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for i,j,k be Element of NAT st 1 < i & i < len Gauge(C,n) & 1 <= j &
k <= width Gauge(C,n) & Gauge(C,n)*(i,k) in L~Upper_Seq(C,n) & Gauge(C,n)*(i,j)
  in L~Lower_Seq(C,n) holds j <> k;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st 1 <
i & i < len Gauge(C,n) & 1 <= j & j <= k & k <= width Gauge(C,n) & LSeg(Gauge(C
  ,n)*(i,j),Gauge(C,n)*(i,k)) /\ L~Upper_Seq(C,n) = {Gauge(C,n)*(i,k)} & LSeg(
  Gauge(C,n)*(i,j),Gauge(C,n)*(i,k)) /\ L~Lower_Seq(C,n) = {Gauge(C,n)*(i,j)}
  holds LSeg(Gauge(C,n)*(i,j),Gauge(C,n)*(i,k)) meets Lower_Arc C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st 1 <
i & i < len Gauge(C,n) & 1 <= j & j <= k & k <= width Gauge(C,n) & LSeg(Gauge(C
  ,n)*(i,j),Gauge(C,n)*(i,k)) /\ L~Upper_Seq(C,n) = {Gauge(C,n)*(i,k)} & LSeg(
  Gauge(C,n)*(i,j),Gauge(C,n)*(i,k)) /\ L~Lower_Seq(C,n) = {Gauge(C,n)*(i,j)}
  holds LSeg(Gauge(C,n)*(i,j),Gauge(C,n)*(i,k)) meets Upper_Arc C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st 1 <
i & i < len Gauge(C,n) & 1 <= j & j <= k & k <= width Gauge(C,n) & n > 0 & LSeg
(Gauge(C,n)*(i,j),Gauge(C,n)*(i,k)) /\ Upper_Arc L~Cage(C,n) = {Gauge(C,n)*(i,k
)} & LSeg(Gauge(C,n)*(i,j),Gauge(C,n)*(i,k)) /\ Lower_Arc L~Cage(C,n) = {Gauge(
  C,n)*(i,j)} holds LSeg(Gauge(C,n)*(i,j),Gauge(C,n)*(i,k)) meets Lower_Arc C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st 1 <
i & i < len Gauge(C,n) & 1 <= j & j <= k & k <= width Gauge(C,n) & n > 0 & LSeg
(Gauge(C,n)*(i,j),Gauge(C,n)*(i,k)) /\ Upper_Arc L~Cage(C,n) = {Gauge(C,n)*(i,k
)} & LSeg(Gauge(C,n)*(i,j),Gauge(C,n)*(i,k)) /\ Lower_Arc L~Cage(C,n) = {Gauge(
  C,n)*(i,j)} holds LSeg(Gauge(C,n)*(i,j),Gauge(C,n)*(i,k)) meets Upper_Arc C;

theorem 
  for C be compact connected non vertical non horizontal Subset of
  TOP-REAL 2 for j be Element of NAT holds Gauge(C,n+1)*(Center Gauge(C,n+1),j)
  in Upper_Arc L~Cage(C,n+1) & 1 <= j & j <= width Gauge(C,n+1) implies LSeg(
  Gauge(C,1)*(Center Gauge(C,1),1),Gauge(C,n+1)*(Center Gauge(C,n+1),j)) meets
  Lower_Arc L~Cage(C,n+1);

theorem 
  for C be Simple_closed_curve for j,k be Element of NAT holds 1 <= j &
  j <= k & k <= width Gauge(C,n+1) & LSeg(Gauge(C,n+1)*(Center Gauge(C,n+1),j),
Gauge(C,n+1)*(Center Gauge(C,n+1),k)) /\ Upper_Arc L~Cage(C,n+1) = {Gauge(C,n+1
)*(Center Gauge(C,n+1),k)} & LSeg(Gauge(C,n+1)*(Center Gauge(C,n+1),j), Gauge(C
  ,n+1)*(Center Gauge(C,n+1),k)) /\ Lower_Arc L~Cage(C,n+1) = {Gauge(C,n+1)*(
  Center Gauge(C,n+1),j)} implies LSeg(Gauge(C,n+1)*(Center Gauge(C,n+1),j),
  Gauge(C,n+1)*(Center Gauge(C,n+1),k)) meets Lower_Arc C;

theorem 
  for C be Simple_closed_curve for j,k be Element of NAT holds 1 <= j &
  j <= k & k <= width Gauge(C,n+1) & LSeg(Gauge(C,n+1)*(Center Gauge(C,n+1),j),
Gauge(C,n+1)*(Center Gauge(C,n+1),k)) /\ Upper_Arc L~Cage(C,n+1) = {Gauge(C,n+1
)*(Center Gauge(C,n+1),k)} & LSeg(Gauge(C,n+1)*(Center Gauge(C,n+1),j), Gauge(C
  ,n+1)*(Center Gauge(C,n+1),k)) /\ Lower_Arc L~Cage(C,n+1) = {Gauge(C,n+1)*(
  Center Gauge(C,n+1),j)} implies LSeg(Gauge(C,n+1)*(Center Gauge(C,n+1),j),
  Gauge(C,n+1)*(Center Gauge(C,n+1),k)) meets Upper_Arc C;



theorem 
  for X, Y being non empty compact Subset of TOP-REAL 2 st X c= Y & (
  W-min Y in X or W-max Y in X) holds W-bound X = W-bound Y;

theorem 
  for X, Y being non empty compact Subset of TOP-REAL 2 st X c= Y & (
  E-min Y in X or E-max Y in X) holds E-bound X = E-bound Y;

theorem 
  for X, Y being non empty compact Subset of TOP-REAL 2 st X c= Y & (
  N-min Y in X or N-max Y in X) holds N-bound X = N-bound Y;

theorem 
  for X, Y being non empty compact Subset of TOP-REAL 2 st X c= Y & (
  S-min Y in X or S-max Y in X) holds S-bound X = S-bound Y;














begin

reserve i,j,k,n for Element of NAT,
  C for being_simple_closed_curve Subset of TOP-REAL 2;

definition
  let C;
  func ApproxIndex C -> Element of NAT means


  it
is_sufficiently_large_for C & for j st j is_sufficiently_large_for C holds j >=
  it;
end;

theorem 
  ApproxIndex C >= 1;

definition
  let C;
  func Y-InitStart C -> Element of NAT means


  it < width Gauge(C,
ApproxIndex C) & cell(Gauge(C,ApproxIndex C),X-SpanStart(C,ApproxIndex C)-'1,it
  ) c= BDD C & for j st j < width Gauge(C,ApproxIndex C) & cell(Gauge(C,
  ApproxIndex C),X-SpanStart(C,ApproxIndex C)-'1,j) c= BDD C holds j >= it;
end;

theorem 
  Y-InitStart C > 1;

theorem 
  Y-InitStart C + 1 < width Gauge(C,ApproxIndex C);

definition
  let C,n;
  assume n is_sufficiently_large_for C;
  func Y-SpanStart(C,n) -> Element of NAT means


  it <= width Gauge(C,n)
  & (for k st it <= k & k <= 2|^(n-'ApproxIndex C)*(Y-InitStart C-'2)+2 holds
cell(Gauge(C,n),X-SpanStart(C,n)-'1,k) c= BDD C) & for j st j <= width Gauge(C,
  n) & for k st j <= k & k <= 2|^(n-'ApproxIndex C)*(Y-InitStart C-'2)+2 holds
  cell(Gauge(C,n),X-SpanStart(C,n)-'1,k) c= BDD C holds j >= it;
end;

theorem 
  n is_sufficiently_large_for C implies X-SpanStart(C,n) = 2|^(n-'
  ApproxIndex C)*(X-SpanStart(C,ApproxIndex C)-2)+2;

theorem 
  n is_sufficiently_large_for C implies Y-SpanStart(C,n) <= 2|^(n-'
  ApproxIndex C)*(Y-InitStart C-'2)+2;

theorem 
  n is_sufficiently_large_for C implies cell(Gauge(C,n),X-SpanStart
  (C,n)-'1,Y-SpanStart(C,n)) c= BDD C;

theorem 
  n is_sufficiently_large_for C implies 1 < Y-SpanStart(C,n) &
  Y-SpanStart(C,n) <= width Gauge(C,n);

theorem 
  n is_sufficiently_large_for C implies [X-SpanStart(C,n),Y-SpanStart(C,
  n)] in Indices Gauge(C,n);

theorem 
  n is_sufficiently_large_for C implies [X-SpanStart(C,n)-'1,Y-SpanStart
  (C,n)] in Indices Gauge(C,n);

theorem 
  n is_sufficiently_large_for C implies cell(Gauge(C,n),X-SpanStart(C,n)
  -'1,Y-SpanStart(C,n)-'1) meets C;

theorem 
  n is_sufficiently_large_for C implies cell(Gauge(C,n),X-SpanStart(C,n)
  -'1,Y-SpanStart(C,n)) misses C;



begin 

reserve p,q for Point of TOP-REAL 2,
  D for Simple_closed_curve;

theorem 
  UBD C meets UBD D;

theorem 
  q in UBD C & p in BDD C implies dist(q,C) < dist(q,p);

theorem 
  not p in BDD C implies dist(p,C) <= dist(p,BDD C);

theorem 
  not(C c= BDD D & D c= BDD C);

theorem 
  C c= BDD D implies D c= UBD C;

theorem 
  L~Cage(C,n) c= UBD C;














begin

reserve i,j,k,n for Element of NAT,
  X,Y,a,b,c,x for set,
  r,s for Real;

theorem 
  1 < i implies 0 < i-'1;

theorem 
  1 is odd;

theorem 
  for f be FinSequence of TOP-REAL n for i st 1 <= i & i + 1 <= len
  f holds f/.i in rng f & f/.(i+1) in rng f;

registration
  cluster s.n.c. -> s.c.c. for FinSequence of TOP-REAL 2;
end;

theorem 
  for f,g be FinSequence of TOP-REAL 2 st f ^' g is unfolded s.c.c.
  & len g >= 2 holds f is unfolded s.n.c.;

theorem 
  for g1,g2 be FinSequence of TOP-REAL 2 holds L~g1 c= L~(g1^'g2);

begin

definition
  let n;
  let f1,f2 be FinSequence of TOP-REAL n;
  pred f1 is_in_general_position_wrt f2 means


  L~f1 misses rng f2 & for
  i st 1<=i & i < len f2 holds L~f1 /\ LSeg(f2,i) is trivial;
end;

definition
  let n;
  let f1,f2 be FinSequence of TOP-REAL n;
  pred f1,f2 are_in_general_position means


  f1 is_in_general_position_wrt f2 & f2 is_in_general_position_wrt f1;
  symmetry;
end;

theorem 
  for f1,f2 being FinSequence of TOP-REAL 2
   st f1,f2 are_in_general_position
  for f being FinSequence of TOP-REAL 2
   st f = f2|(Seg k) holds f1,f are_in_general_position;

theorem 
  for f1,f2,g1,g2 be FinSequence of TOP-REAL 2 st f1^'f2,g1^'g2
  are_in_general_position holds f1^'f2,g1 are_in_general_position;

reserve f,g for FinSequence of TOP-REAL 2;

theorem 
  for k,f,g st 1<=k & k+1<=len g & f,g are_in_general_position
  holds g.k in (L~f)` & g.(k+1) in (L~f)`;

theorem 
  for f1,f2 be FinSequence of TOP-REAL 2 st f1,f2
are_in_general_position for i,j st 1 <= i & i + 1 <= len f1 & 1 <= j & j + 1 <=
  len f2 holds LSeg(f1,i) /\ LSeg(f2,j) is trivial;

theorem 
  for f,g holds INTERSECTION({ LSeg(f,i) : 1 <= i & i+1 <= len f }
  , { LSeg(g,j) : 1 <= j & j+1 <= len g }) is finite;

theorem 
  for f,g st f,g are_in_general_position holds L~f /\ L~g is finite;

theorem 
  for f,g st f,g are_in_general_position for k holds L~f /\ LSeg(g
  ,k) is finite;

begin

reserve f for non constant standard special_circular_sequence,
  p,p1,p2,q for Point of TOP-REAL 2;

theorem 
  for f,p1,p2 st LSeg(p1,p2) misses L~f holds ex C be Subset of
  TOP-REAL 2 st C is_a_component_of (L~f)` & p1 in C & p2 in C;

theorem 
  (ex C be Subset of TOP-REAL 2 st (C is_a_component_of (L~f)` & a
in C & b in C)) iff ( a in RightComp f & b in RightComp f or a in LeftComp f &
  b in LeftComp f );

theorem 
  a in (L~f)` & b in (L~f)` & (not ex C be Subset of TOP-REAL 2 st
  (C is_a_component_of (L~f)` & a in C & b in C)) iff ( a in LeftComp f & b in
  RightComp f or a in RightComp f & b in LeftComp f );

theorem 
  for f,a,b,c st (ex C be Subset of TOP-REAL 2 st (C
is_a_component_of (L~f)` & a in C & b in C)) & (ex C be Subset of TOP-REAL 2 st
  (C is_a_component_of (L~f)` & b in C & c in C)) holds ex C be Subset of
  TOP-REAL 2 st C is_a_component_of (L~f)` & a in C & c in C;

theorem 
  for f,a,b,c st a in (L~f)` & b in (L~f)` & c in (L~f)` & (not ex
C be Subset of TOP-REAL 2 st (C is_a_component_of (L~f)` & a in C & b in C)) &
  (not ex C be Subset of TOP-REAL 2 st (C is_a_component_of (L~f)` & b in C & c
in C)) holds ex C be Subset of TOP-REAL 2 st C is_a_component_of (L~f)` & a in
  C & c in C;

begin

reserve G for Go-board;

theorem 
  i <= len G implies v_strip(G,i) is convex;

theorem 
  j <= width G implies h_strip(G,j) is convex;

theorem 
  i <= len G & j <= width G implies cell(G,i,j) is convex;

theorem 
  for f,k st 1<=k & k+1<=len f holds left_cell(f,k) is convex;

theorem 
  for f,k st 1<=k & k+1<=len f holds left_cell(f,k,GoB f) is
  convex & right_cell(f,k,GoB f) is convex;

begin

theorem 
  for p1,p2,f for r be Point of TOP-REAL 2 st r in LSeg(p1,p2) & (
ex x st (L~f) /\ LSeg(p1,p2) = {x}) & not r in L~f holds L~f misses LSeg(p1,r)
  or L~f misses LSeg(r,p2);

theorem 
  for p,q,r,s being Point of TOP-REAL 2 st LSeg(p,q) is vertical &
  LSeg(r,s) is vertical & LSeg(p,q) meets LSeg(r,s) holds p`1 = r`1;

theorem 
  for p,p1,p2 st not p in LSeg(p1,p2) & p1`2 = p2`2 & p2`2 = p`2
  holds p1 in LSeg(p,p2) or p2 in LSeg(p,p1);

theorem 
  for p,p1,p2 st not p in LSeg(p1,p2) & p1`1 = p2`1 & p2`1 = p`1
  holds p1 in LSeg(p,p2) or p2 in LSeg(p,p1);

theorem 
  p <> p1 & p <> p2 & p in LSeg(p1,p2) implies not p1 in LSeg(p,p2 );

theorem 
  for p,p1,p2,q st not q in LSeg(p1,p2) & p in LSeg(p1,p2) & p <>
p1 & p <> p2 & (p1`1 = p2`1 & p2`1 = q`1 or p1`2 = p2`2 & p2`2 = q`2) holds p1
  in LSeg(q,p) or p2 in LSeg(q,p);

theorem 
  for p1,p2,p3,p4,p be Point of TOP-REAL 2 st (p1`1 = p2`1 & p3`1
= p4`1 or p1`2 = p2`2 & p3`2 = p4`2) & LSeg(p1,p2) /\ LSeg(p3,p4) = {p} holds p
  =p1 or p=p2 or p=p3;

begin

theorem 
  for p,p1,p2,f st (L~f) /\ LSeg(p1,p2) = {p} for r be Point of
  TOP-REAL 2 st not r in LSeg(p1,p2) & not p1 in L~f & not p2 in L~f & ( p1`1 =
p2`1 & p1`1 = r`1 or p1`2 = p2`2 & p1`2 = r`2 ) & (ex i st (1<=i & i+1<= len f
& (r in right_cell(f,i,GoB f) or r in left_cell(f,i,GoB f)) & p in LSeg(f,i)))
& not r in L~f holds (ex C be Subset of TOP-REAL 2 st (C is_a_component_of (L~f
)` & r in C & p1 in C)) or ex C be Subset of TOP-REAL 2 st C is_a_component_of
  (L~f)` & r in C & p2 in C;

theorem 
  for f,p1,p2,p st (L~f) /\ LSeg(p1,p2) = {p} for rl,rp be Point
of TOP-REAL 2 st not p1 in L~f & not p2 in L~f & ( p1`1 = p2`1 & p1`1 = rl`1 &
rl`1 = rp`1 or p1`2 = p2`2 & p1`2 = rl`2 & rl`2 = rp`2 ) & (ex i st (1<=i & i+1
<= len f & rl in left_cell(f,i,GoB f) & rp in right_cell(f,i,GoB f) & p in LSeg
(f,i))) & not rl in L~f & not rp in L~f holds not ex C be Subset of TOP-REAL 2
  st (C is_a_component_of (L~f)` & p1 in C & p2 in C);

theorem 
  for p,f,p1,p2 st L~f /\ LSeg(p1,p2) = {p} & (p1`1=p2`1 or p1`2=
p2`2) & not p1 in L~f & not p2 in L~f & rng f misses LSeg(p1,p2) holds not ex C
  be Subset of TOP-REAL 2 st (C is_a_component_of (L~f)` & p1 in C & p2 in C);

theorem 
  for f being non constant standard special_circular_sequence, g
being special FinSequence of TOP-REAL 2 st f,g are_in_general_position for k st
1<=k & k+1<= len g holds card (L~f /\ LSeg(g,k)) is even Element of NAT iff ex
C be Subset of TOP-REAL 2 st C is_a_component_of (L~f)` & g.k in C & g.(k+1) in
  C;

theorem 
  for f1,f2,g1 being special FinSequence of TOP-REAL 2 st f1 ^' f2
  is non constant standard special_circular_sequence & f1 ^' f2, g1
are_in_general_position & len g1 >= 2 & g1 is unfolded s.n.c. holds card (L~(f1
  ^' f2) /\ L~g1) is even Element of NAT iff ex C be Subset of TOP-REAL 2 st C
  is_a_component_of (L~(f1 ^' f2))` & g1.1 in C & g1.len g1 in C;

theorem 
  for f1,f2,g1,g2 being special FinSequence of TOP-REAL 2 st f1 ^' f2 is
  non constant standard special_circular_sequence & g1 ^' g2 is non constant
  standard special_circular_sequence & L~f1 misses L~g2 & L~f2 misses L~g1 & f1
^' f2, g1 ^' g2 are_in_general_position for p1,p2,q1,q2 being Point of TOP-REAL
2 st f1.1 = p1 & f1.len f1 = p2 & g1.1 = q1 & g1.len g1 = q2 & f1/.len f1 = f2
  /.1 & g1/.len g1 = g2/.1 & p1 in L~f1 /\ L~f2 & q1 in L~g1 /\ L~g2 & ex C be
Subset of TOP-REAL 2 st C is_a_component_of (L~(f1 ^' f2))` & q1 in C & q2 in C
ex C be Subset of TOP-REAL 2 st C is_a_component_of (L~(g1 ^' g2))` & p1 in C &
  p2 in C;














begin 

reserve i, j, k, l, m, n, i1, i2, j1, j2 for Element of NAT;

definition
  let C be non vertical non horizontal non empty being_simple_closed_curve
  Subset of TOP-REAL 2, n be Element of NAT;
  assume
 n is_sufficiently_large_for C;
  func Span(C,n) -> clockwise_oriented standard non constant
  special_circular_sequence means

  it is_sequence_on Gauge(C,n) & it/.1 = Gauge(C
,n)*(X-SpanStart(C,n),Y-SpanStart(C,n)) & it/.2 = Gauge(C,n)*(X-SpanStart(C,n)
  -'1,Y-SpanStart(C,n)) & for k being Element of NAT st 1 <= k & k+2 <= len it
holds (front_right_cell(it,k,Gauge(C,n)) misses C & front_left_cell(it,k,Gauge(
  C,n)) misses C implies it turns_left k,Gauge(C,n)) & (front_right_cell(it,k,
  Gauge(C,n)) misses C & front_left_cell(it,k,Gauge(C,n)) meets C implies it
  goes_straight k,Gauge(C,n)) & (front_right_cell(it,k,Gauge(C,n)) meets C
  implies it turns_right k,Gauge(C,n));
end;














begin

theorem 
  for f be non constant standard special_circular_sequence holds
  BDD L~f = RightComp f or BDD L~f = LeftComp f;

theorem 
  for f be non constant standard special_circular_sequence holds UBD L~f
  = RightComp f or UBD L~f = LeftComp f;

theorem 
  for G be Go-board for f be FinSequence of TOP-REAL 2 for k be Element
of NAT holds 1 <= k & k+1 <= len f & f is_sequence_on G implies left_cell(f,k,G
  ) is closed;

theorem 
  for G be Go-board for p be Point of TOP-REAL 2 for i,j be Element
of NAT st 1 <= i & i+1 <= len G & 1 <= j & j+1 <= width G holds p in Int cell(G
,i,j) iff G*(i,j)`1 < p`1 & p`1 < G*(i+1,j)`1 & G*(i,j)`2 < p`2 & p`2 < G*(i,j+
  1)`2;

theorem 
  for f be non constant standard special_circular_sequence holds
  BDD L~f is connected;

registration
  let f be non constant standard special_circular_sequence;
  cluster BDD L~f -> connected;
end;

definition
  let C be Simple_closed_curve;
  let n be Element of NAT;
  func SpanStart(C,n) -> Point of TOP-REAL 2 equals

  Gauge(C,n)*(X-SpanStart(C,
  n),Y-SpanStart(C,n));
end;

theorem 
  for C be Simple_closed_curve for n be Element of NAT st n
  is_sufficiently_large_for C holds SpanStart(C,n) in BDD C;

theorem 
  for C be Simple_closed_curve for n,k be Element of NAT st n
  is_sufficiently_large_for C holds 1 <= k & k+1 <= len Span(C,n) implies
right_cell(Span(C,n),k,Gauge(C,n)) misses C & left_cell(Span(C,n),k,Gauge(C,n))
  meets C;

theorem 
  for C be Simple_closed_curve for n be Element of NAT st n
  is_sufficiently_large_for C holds C misses L~Span(C,n);

registration
  let C be Simple_closed_curve;
  let n be Element of NAT;
  cluster Cl RightComp Span(C,n) -> compact;
end;

theorem 
  for C be Simple_closed_curve for n be Element of NAT st n
  is_sufficiently_large_for C holds C meets LeftComp Span(C,n);

theorem 
  for C be Simple_closed_curve for n be Element of NAT st n
  is_sufficiently_large_for C holds C misses RightComp Span(C,n);

theorem 
  for C be Simple_closed_curve for n be Element of NAT st n
  is_sufficiently_large_for C holds C c= LeftComp Span(C,n);

theorem 
  for C be Simple_closed_curve for n be Element of NAT st n
  is_sufficiently_large_for C holds C c= UBD L~Span(C,n);

theorem 
  for C be Simple_closed_curve for n be Element of NAT st n
  is_sufficiently_large_for C holds BDD L~Span(C,n) c= BDD C;

theorem 
  for C be Simple_closed_curve for n be Element of NAT st n
  is_sufficiently_large_for C holds UBD C c= UBD L~Span(C,n);

theorem 
  for C be Simple_closed_curve for n be Element of NAT st n
  is_sufficiently_large_for C holds RightComp Span(C,n) c= BDD C;

theorem 
  for C be Simple_closed_curve for n be Element of NAT st n
  is_sufficiently_large_for C holds UBD C c= LeftComp Span(C,n);

theorem 
  for C be Simple_closed_curve for n be Element of NAT st n
  is_sufficiently_large_for C holds UBD C misses BDD L~Span(C,n);

theorem 
  for C be Simple_closed_curve for n be Element of NAT st n
  is_sufficiently_large_for C holds UBD C misses RightComp Span(C,n);

theorem 
  for C be Simple_closed_curve for P be Subset of TOP-REAL 2 for n
  be Element of NAT st n is_sufficiently_large_for C holds P
  is_outside_component_of C implies P misses L~Span(C,n);

theorem 
  for C be Simple_closed_curve for n be Element of NAT st n
  is_sufficiently_large_for C holds UBD C misses L~Span(C,n);

theorem 
  for C be Simple_closed_curve for n be Element of NAT st n
  is_sufficiently_large_for C holds L~Span(C,n) c= BDD C;

theorem 
  for C be Simple_closed_curve for i,j,k,n be Element of NAT st n
  is_sufficiently_large_for C & 1 <= k & k <= len Span(C,n) & [i,j] in Indices
  Gauge(C,n) & Span(C,n)/.k = Gauge(C,n)*(i,j) holds i > 1;

theorem 
  for C be Simple_closed_curve for i,j,k,n be Element of NAT st n
  is_sufficiently_large_for C & 1 <= k & k <= len Span(C,n) & [i,j] in Indices
  Gauge(C,n) & Span(C,n)/.k = Gauge(C,n)*(i,j) holds i < len Gauge(C,n);

theorem 
  for C be Simple_closed_curve for i,j,k,n be Element of NAT st n
  is_sufficiently_large_for C & 1 <= k & k <= len Span(C,n) & [i,j] in Indices
  Gauge(C,n) & Span(C,n)/.k = Gauge(C,n)*(i,j) holds j > 1;

theorem 
  for C be Simple_closed_curve for i,j,k,n be Element of NAT st n
  is_sufficiently_large_for C & 1 <= k & k <= len Span(C,n) & [i,j] in Indices
  Gauge(C,n) & Span(C,n)/.k = Gauge(C,n)*(i,j) holds j < width Gauge(C,n);

theorem 
  for C be Simple_closed_curve for n be Element of NAT st n
  is_sufficiently_large_for C holds Y-SpanStart(C,n) < width Gauge(C,n);

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL
2 for n,m be Element of NAT st m >= n & n >= 1 holds X-SpanStart(C,m) = 2|^(m-'
  n)*(X-SpanStart(C,n)-2)+2;

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL
  2 for n,m be Element of NAT st n <= m & n is_sufficiently_large_for C holds m
  is_sufficiently_large_for C;

theorem 
  for G be Go-board for f be FinSequence of TOP-REAL 2 for i,j be
  Element of NAT holds f is_sequence_on G & f is special & i <= len G & j <=
  width G implies cell(G,i,j)\L~f is connected;

theorem 
  for C be Simple_closed_curve for n,k be Element of NAT st n
is_sufficiently_large_for C & Y-SpanStart(C,n) <= k & k <= 2|^(n-'ApproxIndex C
)*(Y-InitStart C-'2)+2 holds cell(Gauge(C,n),X-SpanStart(C,n)-'1,k)\L~Span(C,n)
  c= BDD L~Span(C,n);

theorem 
  for C be Subset of TOP-REAL 2 for n,m,i be Element of NAT st m
<= n & 1 < i & i+1 < len Gauge(C,m) holds 2|^(n-'m)*(i-2)+2+1 < len Gauge(C,n);

theorem 
  for C be Simple_closed_curve for n,m be Element of NAT st n
is_sufficiently_large_for C & n <= m holds RightComp Span(C,n) meets RightComp
  Span(C,m);

theorem 
  for G be Go-board for f be FinSequence of TOP-REAL 2 st f
is_sequence_on G & f is special for i,j be Element of NAT st i <= len G & j <=
  width G holds Int cell(G,i,j) c= (L~f)`;

theorem 
  for C be Simple_closed_curve for n,m be Element of NAT st n
is_sufficiently_large_for C & n <= m holds L~Span(C,m) c= Cl LeftComp(Span(C,n)
  );

theorem 
  for C be Simple_closed_curve for n,m be Element of NAT st n
  is_sufficiently_large_for C & n <= m holds RightComp(Span(C,n)) c= RightComp(
  Span(C,m));

theorem 
  for C be Simple_closed_curve for n,m be Element of NAT st n
is_sufficiently_large_for C & n <= m holds LeftComp(Span(C,m)) c= LeftComp(Span
  (C,n));














begin

reserve n for Element of NAT;

theorem 
  for A,B be Subset of TOP-REAL 2 st A meets B holds proj1.:A meets proj1.:B;

theorem 
  for A,B be Subset of TOP-REAL 2 for s be real number st A misses B & A
  c= Horizontal_Line s & B c= Horizontal_Line s holds proj1.:A misses proj1.:B;

theorem 
  for S be closed Subset of TOP-REAL 2 st S is bounded holds proj1
  .:S is closed;

theorem 
  for S be compact Subset of TOP-REAL 2 holds proj1.:S is compact;

theorem 
  for G be Go-board for i,j,k,j1,k1 be Element of NAT st 1 <= i & i
<= len G & 1 <= j & j <= j1 & j1 <= k1 & k1 <= k & k <= width G holds LSeg(G*(i
  ,j1),G*(i,k1)) c= LSeg(G*(i,j),G*(i,k));

theorem 
  for G be Go-board for i,j,k,j1,k1 be Element of NAT st 1 <= i & i
<= width G & 1 <= j & j <= j1 & j1 <= k1 & k1 <= k & k <= len G holds LSeg(G*(
  j1,i),G*(k1,i)) c= LSeg(G*(j,i),G*(k,i));

theorem 
  for G be Go-board for j,k,j1,k1 be Element of NAT st 1 <= j & j <= j1
& j1 <= k1 & k1 <= k & k <= width G holds LSeg(G*(Center G,j1),G*(Center G,k1))
  c= LSeg(G*(Center G,j),G*(Center G,k));

theorem 
  for G be Go-board st len G = width G for j,k,j1,k1 be Element of NAT
st 1 <= j & j <= j1 & j1 <= k1 & k1 <= k & k <= len G holds LSeg(G*(j1,Center G
  ),G*(k1,Center G)) c= LSeg(G*(j,Center G),G*(k,Center G));

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for i,j,k be Element of NAT st 1 <= i & i <= len Gauge(C,n) & 1 <= j
  & j <= k & k <= width Gauge(C,n) & Gauge(C,n)*(i,j) in L~Lower_Seq(C,n) ex j1
be Element of NAT st j <= j1 & j1 <= k & LSeg(Gauge(C,n)*(i,j1),Gauge(C,n)*(i,k
  )) /\ L~Lower_Seq(C,n) = {Gauge(C,n)*(i,j1)};

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for i,j,k be Element of NAT st 1 <= i & i <= len Gauge(C,n) & 1 <= j
  & j <= k & k <= width Gauge(C,n) & Gauge(C,n)*(i,k) in L~Upper_Seq(C,n) ex k1
be Element of NAT st j <= k1 & k1 <= k & LSeg(Gauge(C,n)*(i,j),Gauge(C,n)*(i,k1
  )) /\ L~Upper_Seq(C,n) = {Gauge(C,n)*(i,k1)};

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for i,j,k be Element of NAT st 1 <= i & i <= len Gauge(C,n) & 1 <= j
& j <= k & k <= width Gauge(C,n) & Gauge(C,n)*(i,j) in L~Lower_Seq(C,n) & Gauge
  (C,n)*(i,k) in L~Upper_Seq(C,n) ex j1,k1 be Element of NAT st j <= j1 & j1 <=
k1 & k1 <= k & LSeg(Gauge(C,n)*(i,j1),Gauge(C,n)*(i,k1)) /\ L~Lower_Seq(C,n) =
{Gauge(C,n)*(i,j1)} & LSeg(Gauge(C,n)*(i,j1),Gauge(C,n)*(i,k1)) /\ L~Upper_Seq(
  C,n) = {Gauge(C,n)*(i,k1)};

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for i,j,k be Element of NAT st 1 <= j & j <= k & k <= len Gauge(C,n)
  & 1 <= i & i <= width Gauge(C,n) & Gauge(C,n)*(j,i) in L~Lower_Seq(C,n) ex j1
be Element of NAT st j <= j1 & j1 <= k & LSeg(Gauge(C,n)*(j1,i),Gauge(C,n)*(k,i
  )) /\ L~Lower_Seq(C,n) = {Gauge(C,n)*(j1,i)};

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for i,j,k be Element of NAT st 1 <= j & j <= k & k <= len Gauge(C,n)
  & 1 <= i & i <= width Gauge(C,n) & Gauge(C,n)*(k,i) in L~Upper_Seq(C,n) ex k1
be Element of NAT st j <= k1 & k1 <= k & LSeg(Gauge(C,n)*(j,i),Gauge(C,n)*(k1,i
  )) /\ L~Upper_Seq(C,n) = {Gauge(C,n)*(k1,i)};

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for i,j,k be Element of NAT st 1 <= j & j <= k & k <= len Gauge(C,n)
& 1 <= i & i <= width Gauge(C,n) & Gauge(C,n)*(j,i) in L~Lower_Seq(C,n) & Gauge
  (C,n)*(k,i) in L~Upper_Seq(C,n) ex j1,k1 be Element of NAT st j <= j1 & j1 <=
k1 & k1 <= k & LSeg(Gauge(C,n)*(j1,i),Gauge(C,n)*(k1,i)) /\ L~Lower_Seq(C,n) =
{Gauge(C,n)*(j1,i)} & LSeg(Gauge(C,n)*(j1,i),Gauge(C,n)*(k1,i)) /\ L~Upper_Seq(
  C,n) = {Gauge(C,n)*(k1,i)};

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for i,j,k be Element of NAT st 1 <= i & i <= len Gauge(C,n) & 1 <= j
  & j <= k & k <= width Gauge(C,n) & Gauge(C,n)*(i,j) in L~Upper_Seq(C,n) ex j1
be Element of NAT st j <= j1 & j1 <= k & LSeg(Gauge(C,n)*(i,j1),Gauge(C,n)*(i,k
  )) /\ L~Upper_Seq(C,n) = {Gauge(C,n)*(i,j1)};

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for i,j,k be Element of NAT st 1 <= i & i <= len Gauge(C,n) & 1 <= j
  & j <= k & k <= width Gauge(C,n) & Gauge(C,n)*(i,k) in L~Lower_Seq(C,n) ex k1
be Element of NAT st j <= k1 & k1 <= k & LSeg(Gauge(C,n)*(i,j),Gauge(C,n)*(i,k1
  )) /\ L~Lower_Seq(C,n) = {Gauge(C,n)*(i,k1)};

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for i,j,k be Element of NAT st 1 <= i & i <= len Gauge(C,n) & 1 <= j
& j <= k & k <= width Gauge(C,n) & Gauge(C,n)*(i,j) in L~Upper_Seq(C,n) & Gauge
  (C,n)*(i,k) in L~Lower_Seq(C,n) ex j1,k1 be Element of NAT st j <= j1 & j1 <=
k1 & k1 <= k & LSeg(Gauge(C,n)*(i,j1),Gauge(C,n)*(i,k1)) /\ L~Upper_Seq(C,n) =
{Gauge(C,n)*(i,j1)} & LSeg(Gauge(C,n)*(i,j1),Gauge(C,n)*(i,k1)) /\ L~Lower_Seq(
  C,n) = {Gauge(C,n)*(i,k1)};

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for i,j,k be Element of NAT st 1 <= j & j <= k & k <= len Gauge(C,n)
  & 1 <= i & i <= width Gauge(C,n) & Gauge(C,n)*(j,i) in L~Upper_Seq(C,n) ex j1
be Element of NAT st j <= j1 & j1 <= k & LSeg(Gauge(C,n)*(j1,i),Gauge(C,n)*(k,i
  )) /\ L~Upper_Seq(C,n) = {Gauge(C,n)*(j1,i)};

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for i,j,k be Element of NAT st 1 <= j & j <= k & k <= len Gauge(C,n)
  & 1 <= i & i <= width Gauge(C,n) & Gauge(C,n)*(k,i) in L~Lower_Seq(C,n) ex k1
be Element of NAT st j <= k1 & k1 <= k & LSeg(Gauge(C,n)*(j,i),Gauge(C,n)*(k1,i
  )) /\ L~Lower_Seq(C,n) = {Gauge(C,n)*(k1,i)};

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for i,j,k be Element of NAT st 1 <= j & j <= k & k <= len Gauge(C,n)
& 1 <= i & i <= width Gauge(C,n) & Gauge(C,n)*(j,i) in L~Upper_Seq(C,n) & Gauge
  (C,n)*(k,i) in L~Lower_Seq(C,n) ex j1,k1 be Element of NAT st j <= j1 & j1 <=
k1 & k1 <= k & LSeg(Gauge(C,n)*(j1,i),Gauge(C,n)*(k1,i)) /\ L~Upper_Seq(C,n) =
{Gauge(C,n)*(j1,i)} & LSeg(Gauge(C,n)*(j1,i),Gauge(C,n)*(k1,i)) /\ L~Lower_Seq(
  C,n) = {Gauge(C,n)*(k1,i)};

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st 1 <
i & i < len Gauge(C,n) & 1 <= j & j <= k & k <= width Gauge(C,n) & Gauge(C,n)*(
  i,k) in L~Upper_Seq(C,n) & Gauge(C,n)*(i,j) in L~Lower_Seq(C,n) holds LSeg(
  Gauge(C,n)*(i,j),Gauge(C,n)*(i,k)) meets Lower_Arc C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st 1 <
i & i < len Gauge(C,n) & 1 <= j & j <= k & k <= width Gauge(C,n) & Gauge(C,n)*(
  i,k) in L~Upper_Seq(C,n) & Gauge(C,n)*(i,j) in L~Lower_Seq(C,n) holds LSeg(
  Gauge(C,n)*(i,j),Gauge(C,n)*(i,k)) meets Upper_Arc C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st 1 <
  i & i < len Gauge(C,n) & 1 <= j & j <= k & k <= width Gauge(C,n) & n > 0 &
  Gauge(C,n)*(i,k) in Upper_Arc L~Cage(C,n) & Gauge(C,n)*(i,j) in Lower_Arc L~
  Cage(C,n) holds LSeg(Gauge(C,n)*(i,j),Gauge(C,n)*(i,k)) meets Lower_Arc C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st 1 <
  i & i < len Gauge(C,n) & 1 <= j & j <= k & k <= width Gauge(C,n) & n > 0 &
  Gauge(C,n)*(i,k) in Upper_Arc L~Cage(C,n) & Gauge(C,n)*(i,j) in Lower_Arc L~
  Cage(C,n) holds LSeg(Gauge(C,n)*(i,j),Gauge(C,n)*(i,k)) meets Upper_Arc C;

theorem 
  for C be Simple_closed_curve for j,k be Element of NAT holds 1 <= j &
  j <= k & k <= width Gauge(C,n+1) & Gauge(C,n+1)*(Center Gauge(C,n+1),k) in
Upper_Arc L~Cage(C,n+1) & Gauge(C,n+1)*(Center Gauge(C,n+1),j) in Lower_Arc L~
  Cage(C,n+1) implies LSeg(Gauge(C,n+1)*(Center Gauge(C,n+1),j), Gauge(C,n+1)*(
  Center Gauge(C,n+1),k)) meets Lower_Arc C;

theorem 
  for C be Simple_closed_curve for j,k be Element of NAT holds 1 <= j &
  j <= k & k <= width Gauge(C,n+1) & Gauge(C,n+1)*(Center Gauge(C,n+1),k) in
Upper_Arc L~Cage(C,n+1) & Gauge(C,n+1)*(Center Gauge(C,n+1),j) in Lower_Arc L~
  Cage(C,n+1) implies LSeg(Gauge(C,n+1)*(Center Gauge(C,n+1),j), Gauge(C,n+1)*(
  Center Gauge(C,n+1),k)) meets Upper_Arc C;

theorem 
  for C be compact connected non vertical non horizontal Subset of
TOP-REAL 2 for i,j,k be Element of NAT st 1 < j & k < len Gauge(C,n) & 1 <= i &
i <= width Gauge(C,n) & Gauge(C,n)*(k,i) in L~Upper_Seq(C,n) & Gauge(C,n)*(j,i)
  in L~Lower_Seq(C,n) holds j <> k;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st 1 <
j & j <= k & k < len Gauge(C,n) & 1 <= i & i <= width Gauge(C,n) & LSeg(Gauge(C
  ,n)*(j,i),Gauge(C,n)*(k,i)) /\ L~Upper_Seq(C,n) = {Gauge(C,n)*(k,i)} & LSeg(
  Gauge(C,n)*(j,i),Gauge(C,n)*(k,i)) /\ L~Lower_Seq(C,n) = {Gauge(C,n)*(j,i)}
  holds LSeg(Gauge(C,n)*(j,i),Gauge(C,n)*(k,i)) meets Lower_Arc C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st 1 <
j & j <= k & k < len Gauge(C,n) & 1 <= i & i <= width Gauge(C,n) & LSeg(Gauge(C
  ,n)*(j,i),Gauge(C,n)*(k,i)) /\ L~Upper_Seq(C,n) = {Gauge(C,n)*(k,i)} & LSeg(
  Gauge(C,n)*(j,i),Gauge(C,n)*(k,i)) /\ L~Lower_Seq(C,n) = {Gauge(C,n)*(j,i)}
  holds LSeg(Gauge(C,n)*(j,i),Gauge(C,n)*(k,i)) meets Upper_Arc C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st 1 <
j & j <= k & k < len Gauge(C,n) & 1 <= i & i <= width Gauge(C,n) & Gauge(C,n)*(
  k,i) in L~Upper_Seq(C,n) & Gauge(C,n)*(j,i) in L~Lower_Seq(C,n) holds LSeg(
  Gauge(C,n)*(j,i),Gauge(C,n)*(k,i)) meets Lower_Arc C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st 1 <
j & j <= k & k < len Gauge(C,n) & 1 <= i & i <= width Gauge(C,n) & Gauge(C,n)*(
  k,i) in L~Upper_Seq(C,n) & Gauge(C,n)*(j,i) in L~Lower_Seq(C,n) holds LSeg(
  Gauge(C,n)*(j,i),Gauge(C,n)*(k,i)) meets Upper_Arc C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st 1 <
  j & j <= k & k < len Gauge(C,n) & 1 <= i & i <= width Gauge(C,n) & n > 0 &
  Gauge(C,n)*(k,i) in Upper_Arc L~Cage(C,n) & Gauge(C,n)*(j,i) in Lower_Arc L~
  Cage(C,n) holds LSeg(Gauge(C,n)*(j,i),Gauge(C,n)*(k,i)) meets Lower_Arc C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st 1 <
  j & j <= k & k < len Gauge(C,n) & 1 <= i & i <= width Gauge(C,n) & n > 0 &
  Gauge(C,n)*(k,i) in Upper_Arc L~Cage(C,n) & Gauge(C,n)*(j,i) in Lower_Arc L~
  Cage(C,n) holds LSeg(Gauge(C,n)*(j,i),Gauge(C,n)*(k,i)) meets Upper_Arc C;

theorem 
  for C be Simple_closed_curve for j,k be Element of NAT holds 1 < j & j
<= k & k < len Gauge(C,n+1) & Gauge(C,n+1)*(k,Center Gauge(C,n+1)) in Upper_Arc
L~Cage(C,n+1) & Gauge(C,n+1)*(j,Center Gauge(C,n+1)) in Lower_Arc L~Cage(C,n+1)
implies LSeg(Gauge(C,n+1)*(j,Center Gauge(C,n+1)), Gauge(C,n+1)*(k,Center Gauge
  (C,n+1))) meets Lower_Arc C;

theorem 
  for C be Simple_closed_curve for j,k be Element of NAT holds 1 < j & j
<= k & k < len Gauge(C,n+1) & Gauge(C,n+1)*(k,Center Gauge(C,n+1)) in Upper_Arc
L~Cage(C,n+1) & Gauge(C,n+1)*(j,Center Gauge(C,n+1)) in Lower_Arc L~Cage(C,n+1)
implies LSeg(Gauge(C,n+1)*(j,Center Gauge(C,n+1)), Gauge(C,n+1)*(k,Center Gauge
  (C,n+1))) meets Upper_Arc C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st 1 <
j & j <= k & k < len Gauge(C,n) & 1 <= i & i <= width Gauge(C,n) & LSeg(Gauge(C
  ,n)*(j,i),Gauge(C,n)*(k,i)) /\ L~Upper_Seq(C,n) = {Gauge(C,n)*(j,i)} & LSeg(
  Gauge(C,n)*(j,i),Gauge(C,n)*(k,i)) /\ L~Lower_Seq(C,n) = {Gauge(C,n)*(k,i)}
  holds LSeg(Gauge(C,n)*(j,i),Gauge(C,n)*(k,i)) meets Lower_Arc C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st 1 <
j & j <= k & k < len Gauge(C,n) & 1 <= i & i <= width Gauge(C,n) & LSeg(Gauge(C
  ,n)*(j,i),Gauge(C,n)*(k,i)) /\ L~Upper_Seq(C,n) = {Gauge(C,n)*(j,i)} & LSeg(
  Gauge(C,n)*(j,i),Gauge(C,n)*(k,i)) /\ L~Lower_Seq(C,n) = {Gauge(C,n)*(k,i)}
  holds LSeg(Gauge(C,n)*(j,i),Gauge(C,n)*(k,i)) meets Upper_Arc C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st 1 <
j & j <= k & k < len Gauge(C,n) & 1 <= i & i <= width Gauge(C,n) & Gauge(C,n)*(
  j,i) in L~Upper_Seq(C,n) & Gauge(C,n)*(k,i) in L~Lower_Seq(C,n) holds LSeg(
  Gauge(C,n)*(j,i),Gauge(C,n)*(k,i)) meets Lower_Arc C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st 1 <
j & j <= k & k < len Gauge(C,n) & 1 <= i & i <= width Gauge(C,n) & Gauge(C,n)*(
  j,i) in L~Upper_Seq(C,n) & Gauge(C,n)*(k,i) in L~Lower_Seq(C,n) holds LSeg(
  Gauge(C,n)*(j,i),Gauge(C,n)*(k,i)) meets Upper_Arc C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st 1 <
  j & j <= k & k < len Gauge(C,n) & 1 <= i & i <= width Gauge(C,n) & n > 0 &
  Gauge(C,n)*(j,i) in Upper_Arc L~Cage(C,n) & Gauge(C,n)*(k,i) in Lower_Arc L~
  Cage(C,n) holds LSeg(Gauge(C,n)*(j,i),Gauge(C,n)*(k,i)) meets Lower_Arc C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st 1 <
  j & j <= k & k < len Gauge(C,n) & 1 <= i & i <= width Gauge(C,n) & n > 0 &
  Gauge(C,n)*(j,i) in Upper_Arc L~Cage(C,n) & Gauge(C,n)*(k,i) in Lower_Arc L~
  Cage(C,n) holds LSeg(Gauge(C,n)*(j,i),Gauge(C,n)*(k,i)) meets Upper_Arc C;

theorem 
  for C be Simple_closed_curve for j,k be Element of NAT holds 1 < j & j
<= k & k < len Gauge(C,n+1) & Gauge(C,n+1)*(j,Center Gauge(C,n+1)) in Upper_Arc
L~Cage(C,n+1) & Gauge(C,n+1)*(k,Center Gauge(C,n+1)) in Lower_Arc L~Cage(C,n+1)
implies LSeg(Gauge(C,n+1)*(j,Center Gauge(C,n+1)), Gauge(C,n+1)*(k,Center Gauge
  (C,n+1))) meets Lower_Arc C;

theorem 
  for C be Simple_closed_curve for j,k be Element of NAT holds 1 < j & j
<= k & k < len Gauge(C,n+1) & Gauge(C,n+1)*(j,Center Gauge(C,n+1)) in Upper_Arc
L~Cage(C,n+1) & Gauge(C,n+1)*(k,Center Gauge(C,n+1)) in Lower_Arc L~Cage(C,n+1)
implies LSeg(Gauge(C,n+1)*(j,Center Gauge(C,n+1)), Gauge(C,n+1)*(k,Center Gauge
  (C,n+1))) meets Upper_Arc C;

theorem 
  for C be Simple_closed_curve for i1,i2,j,k be Element of NAT st
1 < i1 & i1 <= i2 & i2 < len Gauge(C,n) & 1 <= j & j <= k & k <= width Gauge(C,
n) & (LSeg(Gauge(C,n)*(i1,j),Gauge(C,n)*(i1,k)) \/ LSeg(Gauge(C,n)*(i1,k),Gauge
(C,n)*(i2,k))) /\ L~Upper_Seq(C,n) = {Gauge(C,n)*(i2,k)} & (LSeg(Gauge(C,n)*(i1
  ,j),Gauge(C,n)*(i1,k)) \/ LSeg(Gauge(C,n)*(i1,k),Gauge(C,n)*(i2,k))) /\ L~
Lower_Seq(C,n) = {Gauge(C,n)*(i1,j)} holds (LSeg(Gauge(C,n)*(i1,j),Gauge(C,n)*(
  i1,k)) \/ LSeg(Gauge(C,n)*(i1,k),Gauge(C,n)*(i2,k))) meets Upper_Arc C;

theorem 
  for C be Simple_closed_curve for i1,i2,j,k be Element of NAT st
1 < i1 & i1 <= i2 & i2 < len Gauge(C,n) & 1 <= j & j <= k & k <= width Gauge(C,
n) & (LSeg(Gauge(C,n)*(i1,j),Gauge(C,n)*(i1,k)) \/ LSeg(Gauge(C,n)*(i1,k),Gauge
(C,n)*(i2,k))) /\ L~Upper_Seq(C,n) = {Gauge(C,n)*(i2,k)} & (LSeg(Gauge(C,n)*(i1
  ,j),Gauge(C,n)*(i1,k)) \/ LSeg(Gauge(C,n)*(i1,k),Gauge(C,n)*(i2,k))) /\ L~
Lower_Seq(C,n) = {Gauge(C,n)*(i1,j)} holds (LSeg(Gauge(C,n)*(i1,j),Gauge(C,n)*(
  i1,k)) \/ LSeg(Gauge(C,n)*(i1,k),Gauge(C,n)*(i2,k))) meets Lower_Arc C;

theorem 
  for C be Simple_closed_curve for i1,i2,j,k be Element of NAT st
1 < i2 & i2 <= i1 & i1 < len Gauge(C,n) & 1 <= j & j <= k & k <= width Gauge(C,
n) & (LSeg(Gauge(C,n)*(i1,j),Gauge(C,n)*(i1,k)) \/ LSeg(Gauge(C,n)*(i1,k),Gauge
(C,n)*(i2,k))) /\ L~Upper_Seq(C,n) = {Gauge(C,n)*(i2,k)} & (LSeg(Gauge(C,n)*(i1
  ,j),Gauge(C,n)*(i1,k)) \/ LSeg(Gauge(C,n)*(i1,k),Gauge(C,n)*(i2,k))) /\ L~
Lower_Seq(C,n) = {Gauge(C,n)*(i1,j)} holds (LSeg(Gauge(C,n)*(i1,j),Gauge(C,n)*(
  i1,k)) \/ LSeg(Gauge(C,n)*(i1,k),Gauge(C,n)*(i2,k))) meets Upper_Arc C;

theorem 
  for C be Simple_closed_curve for i1,i2,j,k be Element of NAT st
1 < i2 & i2 <= i1 & i1 < len Gauge(C,n) & 1 <= j & j <= k & k <= width Gauge(C,
n) & (LSeg(Gauge(C,n)*(i1,j),Gauge(C,n)*(i1,k)) \/ LSeg(Gauge(C,n)*(i1,k),Gauge
(C,n)*(i2,k))) /\ L~Upper_Seq(C,n) = {Gauge(C,n)*(i2,k)} & (LSeg(Gauge(C,n)*(i1
  ,j),Gauge(C,n)*(i1,k)) \/ LSeg(Gauge(C,n)*(i1,k),Gauge(C,n)*(i2,k))) /\ L~
Lower_Seq(C,n) = {Gauge(C,n)*(i1,j)} holds (LSeg(Gauge(C,n)*(i1,j),Gauge(C,n)*(
  i1,k)) \/ LSeg(Gauge(C,n)*(i1,k),Gauge(C,n)*(i2,k))) meets Lower_Arc C;

theorem 
  for C be Simple_closed_curve for i1,i2,j,k be Element of NAT
holds 1 < i1 & i1 < len Gauge(C,n+1) & 1 < i2 & i2 < len Gauge(C,n+1) & 1 <= j
& j <= k & k <= width Gauge(C,n+1) & Gauge(C,n+1)*(i1,k) in Upper_Arc L~Cage(C,
n+1) & Gauge(C,n+1)*(i2,j) in Lower_Arc L~Cage(C,n+1) implies LSeg(Gauge(C,n+1)
  *(i2,j),Gauge(C,n+1)*(i2,k)) \/ LSeg(Gauge(C,n+1)*(i2,k),Gauge(C,n+1)*(i1,k))
  meets Upper_Arc C;

theorem 
  for C be Simple_closed_curve for i1,i2,j,k be Element of NAT
holds 1 < i1 & i1 < len Gauge(C,n+1) & 1 < i2 & i2 < len Gauge(C,n+1) & 1 <= j
& j <= k & k <= width Gauge(C,n+1) & Gauge(C,n+1)*(i1,k) in Upper_Arc L~Cage(C,
n+1) & Gauge(C,n+1)*(i2,j) in Lower_Arc L~Cage(C,n+1) implies LSeg(Gauge(C,n+1)
  *(i2,j),Gauge(C,n+1)*(i2,k)) \/ LSeg(Gauge(C,n+1)*(i2,k),Gauge(C,n+1)*(i1,k))
  meets Lower_Arc C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT holds 1 < i &
i < len Gauge(C,n+1) & 1 <= j & j <= k & k <= width Gauge(C,n+1) & Gauge(C,n+1)
  *(i,k) in Upper_Arc L~Cage(C,n+1) & Gauge(C,n+1)*(Center Gauge(C,n+1),j) in
  Lower_Arc L~Cage(C,n+1) implies LSeg(Gauge(C,n+1)*(Center Gauge(C,n+1),j),
Gauge(C,n+1)*(Center Gauge(C,n+1),k)) \/ LSeg(Gauge(C,n+1)*(Center Gauge(C,n+1)
  ,k),Gauge(C,n+1)*(i,k)) meets Upper_Arc C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT holds 1 < i &
i < len Gauge(C,n+1) & 1 <= j & j <= k & k <= width Gauge(C,n+1) & Gauge(C,n+1)
  *(i,k) in Upper_Arc L~Cage(C,n+1) & Gauge(C,n+1)*(Center Gauge(C,n+1),j) in
  Lower_Arc L~Cage(C,n+1) implies LSeg(Gauge(C,n+1)*(Center Gauge(C,n+1),j),
Gauge(C,n+1)*(Center Gauge(C,n+1),k)) \/ LSeg(Gauge(C,n+1)*(Center Gauge(C,n+1)
  ,k),Gauge(C,n+1)*(i,k)) meets Lower_Arc C;














begin  

reserve n for Element of NAT,
  V for Subset of TOP-REAL n,
  s,s1,s2,t,t1,t2 for Point of TOP-REAL n,
  C for Simple_closed_curve,
  P for Subset of TOP-REAL 2,
  a,p ,p1,p2,q,q1,q2 for Point of TOP-REAL 2;

theorem 
  for a,b being real number holds (a-b)^2 = (b-a)^2;

theorem 
  for S,T being non empty TopStruct, f being Function of S,T, A being
  Subset of T st f is being_homeomorphism & A is compact holds f"A is compact;

theorem 
  proj2.:(north_halfline a) is bounded_below;

theorem 
  proj2.:(south_halfline a) is bounded_above;

theorem 
  proj1.:(west_halfline a) is bounded_above;

theorem 
  proj1.:(east_halfline a) is bounded_below;

registration
  let a;
  cluster proj2.:(north_halfline a) -> non empty;
  cluster proj2.:(south_halfline a) -> non empty;
  cluster proj1.:(west_halfline a) -> non empty;
  cluster proj1.:(east_halfline a) -> non empty;
end;

theorem 
  lower_bound(proj2.:(north_halfline a)) = a`2;

theorem 
  upper_bound(proj2.:(south_halfline a)) = a`2;

theorem 
  upper_bound(proj1.:(west_halfline a)) = a`1;

theorem 
  lower_bound(proj1.:(east_halfline a)) = a`1;

registration
  let a;
  cluster north_halfline a -> closed;
  cluster south_halfline a -> closed;
  cluster east_halfline a -> closed;
  cluster west_halfline a -> closed;
end;

theorem 
  a in BDD P implies not north_halfline a c= UBD P;

theorem 
  a in BDD P implies not south_halfline a c= UBD P;

theorem 
  a in BDD P implies not east_halfline a c= UBD P;

theorem 
  a in BDD P implies not west_halfline a c= UBD P;

theorem 
  for C being Simple_closed_curve, P being Subset of TOP-REAL 2,
p1,p2 being Point of TOP-REAL 2 st P is_an_arc_of p1,p2 & P c= C ex R being non
empty Subset of TOP-REAL 2 st R is_an_arc_of p1,p2 & P \/ R = C & P /\ R = {p1,
  p2};

begin  

definition
  let p,P;
  func North-Bound(p,P) -> Point of TOP-REAL 2 equals

  |[p`1,lower_bound(proj2.:(P /\
  north_halfline p))]|;
  func South-Bound(p,P) -> Point of TOP-REAL 2 equals

  |[p`1,upper_bound(proj2.:(P /\
  south_halfline p))]|;
end;

theorem 
  North-Bound(p,P)`1 = p`1 & South-Bound(p,P)`1 = p`1;

theorem 
  for C being compact Subset of TOP-REAL 2 holds p in BDD C
  implies North-Bound(p,C) in C & North-Bound(p,C) in north_halfline p &
  South-Bound(p,C) in C & South-Bound(p,C) in south_halfline p;

theorem 
  for C being compact Subset of TOP-REAL 2 holds p in BDD C
  implies South-Bound(p,C)`2 < p`2 & p`2 < North-Bound(p,C)`2;

theorem 
  for C being compact Subset of TOP-REAL 2 holds p in BDD C
implies lower_bound(proj2.:(C /\ north_halfline p)) >
 upper_bound(proj2.:(C /\ south_halfline p
  ));

theorem 
  for C being compact Subset of TOP-REAL 2 holds p in BDD C implies
  South-Bound(p,C) <> North-Bound(p,C);

theorem 
  for C being Subset of TOP-REAL 2 holds LSeg(North-Bound(p,C),
  South-Bound(p,C)) is vertical;

theorem 
  for C being compact Subset of TOP-REAL 2 holds p in BDD C implies LSeg
(North-Bound(p,C),South-Bound(p,C)) /\ C = { North-Bound(p,C), South-Bound(p,C)
  };

theorem 
  for C being compact Subset of TOP-REAL 2 holds p in BDD C & q in BDD C
  & p`1 <> q`1 implies North-Bound(p,C), South-Bound(q,C), North-Bound(q,C),
  South-Bound(p,C) are_mutually_different;

begin  

definition
  let n,V,s1,s2,t1,t2;
  pred s1,s2, V-separate t1,t2 means


  for A being Subset of TOP-REAL n
  st A is_an_arc_of s1,s2 & A c= V holds A meets {t1,t2};
end;

notation
  let n,V,s1,s2,t1,t2;
  antonym s1,s2 are_neighbours_wrt t1,t2, V for s1,s2, V-separate t1,t2;
end;

theorem 
  t,t, V-separate s1,s2;

theorem 
  s1,s2, V-separate t1,t2 implies s2,s1, V-separate t1,t2;

theorem 
  s1,s2, V-separate t1,t2 implies s1,s2, V-separate t2,t1;

theorem 
  s,t1, V-separate s,t2;

theorem 
  t1,s, V-separate t2,s;

theorem 
  t1,s, V-separate s,t2;

theorem 
  s,t1, V-separate t2,s;

theorem 
  for p1,p2,q being Point of TOP-REAL 2 st q in C & p1 in C & p2 in C &
  p1 <> p2 & p1 <> q & p2 <> q holds p1,p2 are_neighbours_wrt q,q, C;

theorem 
  p1 <> p2 & p1 in C & p2 in C implies (p1,p2, C-separate q1,q2 implies
  q1,q2, C-separate p1,p2);

theorem 
  p1 in C & p2 in C & q1 in C & p1 <> p2 & q1 <> p1 & q1 <> p2 & q2 <>
  p1 & q2 <> p2 implies p1,p2 are_neighbours_wrt q1,q2, C or p1,q1
  are_neighbours_wrt p2,q2, C;














begin 



registration
  let I be set, f be ManySortedSet of I, p be FinSequence of I;
  cluster f * p -> FinSequence-like;
end;

definition
  let S be non empty ManySortedSign;
  mode SortSymbol of S is Element of S;
end;

definition
  let S be non empty ManySortedSign;
  mode OperSymbol of S is Element of the carrier' of S;
end;






definition
  struct(ManySortedSign) OverloadedMSSign (# carrier -> set, carrier' -> set,
Overloading -> Equivalence_Relation of the carrier', Arity -> Function of the
carrier', the carrier*, ResultSort -> Function of the carrier', the carrier #);
end;



definition
  struct(ManySortedSign,RelStr) RelSortedSign (# carrier -> set, InternalRel
    -> (Relation of the carrier), carrier' -> set, Arity -> Function of the
carrier', the carrier*, ResultSort -> Function of the carrier', the carrier #);
end;

definition
  struct(OverloadedMSSign,RelSortedSign) OverloadedRSSign (# carrier -> set,
    InternalRel -> (Relation of the carrier), carrier' -> set, Overloading ->
Equivalence_Relation of the carrier', Arity -> Function of the carrier', the
    carrier*, ResultSort -> Function of the carrier', the carrier #);
end;




reserve A,O for non empty set,
  R for Order of A,
  Ol for Equivalence_Relation of O,
  f for Function of O,A*,
  g for Function of O,A;






theorem 
  OverloadedRSSign(#A,R,O,Ol,f,g #) is non empty non void reflexive
  transitive antisymmetric;

registration
  let A,R,O,Ol,f,g;
  cluster OverloadedRSSign(#A,R,O,Ol,f,g #) -> strict non empty reflexive
    transitive antisymmetric;
end;

begin



reserve S for OverloadedRSSign;



definition
  let S;

  attr S is order-sorted means


  S is reflexive transitive antisymmetric;
end;

registration
  cluster order-sorted -> reflexive transitive antisymmetric for
OverloadedRSSign;
  cluster strict non empty non void order-sorted for OverloadedRSSign;
end;

registration
  cluster non empty non void for OverloadedMSSign;
end;

definition
  let S be non empty non void OverloadedMSSign;
  let x,y be OperSymbol of S;
  pred x ~= y means


  [x,y] in the Overloading of S;
  symmetry;
  reflexivity;
end;



theorem 
  for S being non empty non void OverloadedMSSign, o,o1,o2 being
  OperSymbol of S holds o ~= o1 & o1 ~= o2 implies o ~= o2;



definition
  let S be non empty non void OverloadedMSSign;
  attr S is discernable means


  for x,y be OperSymbol of S st x ~= y &
  the_arity_of x = the_arity_of y & the_result_sort_of x = the_result_sort_of y
  holds x = y;
  attr S is op-discrete means


  the Overloading of S = id (the carrier' of S);
end;

theorem 
  for S being non empty non void OverloadedMSSign holds S is
  op-discrete iff for x,y be OperSymbol of S st x ~= y holds x = y;

theorem 
  for S being non empty non void OverloadedMSSign holds S is
  op-discrete implies S is discernable;

begin



reserve S0 for non empty non void ManySortedSign;




definition
  let S0;
  func OSSign S0 -> strict non empty non void order-sorted OverloadedRSSign
  means


  the carrier of S0 = the carrier of it & id the carrier of S0 = the
  InternalRel of it & the carrier' of S0 = the carrier' of it & id the carrier'
  of S0 = the Overloading of it & the Arity of S0 = the Arity of it & the
  ResultSort of S0 = the ResultSort of it;
end;

theorem 
  OSSign S0 is discrete op-discrete;

registration
  cluster discrete op-discrete discernable for strict non empty non void
    order-sorted OverloadedRSSign;
end;

registration
  cluster op-discrete -> discernable for non empty non void OverloadedRSSign;
end;



registration
  let S0;
  cluster OSSign S0 -> discrete op-discrete;
end;

definition
  mode OrderSortedSign is discernable non empty non void order-sorted
    OverloadedRSSign;
end;








reserve S for non empty Poset;
reserve s1,s2 for Element of S;
reserve w1,w2 for Element of (the carrier of S)*;




definition
  let S;
  let w1,w2 be Element of (the carrier of S)*;
  pred w1 <= w2 means


  len w1 = len w2 & for i being set st i in dom w1
  for s1,s2 st s1 = w1.i & s2 = w2.i holds s1 <= s2;
  reflexivity;
end;

theorem 
  for w1,w2 being Element of (the carrier of S)* holds w1 <= w2 &
  w2 <= w1 implies w1 = w2;

theorem 
  S is discrete & w1 <= w2 implies w1 = w2;

reserve S for OrderSortedSign;
reserve o,o1,o2 for OperSymbol of S;
reserve w1 for Element of (the carrier of S)*;

theorem 
  S is discrete & o1 ~= o2 & (the_arity_of o1) <= (the_arity_of o2)
  & the_result_sort_of o1 <= the_result_sort_of o2 implies o1 = o2;




definition
  let S;
  let o;
  attr o is monotone means


  for o2 st o ~= o2 & (the_arity_of o) <= (
  the_arity_of o2) holds the_result_sort_of o <= the_result_sort_of o2;
end;

definition
  let S;
  attr S is monotone means


  for o being OperSymbol of S holds o is monotone;
end;

theorem 
  S is op-discrete implies S is monotone;

registration
  cluster monotone for OrderSortedSign;
end;

registration
  let S be monotone OrderSortedSign;
  cluster monotone for OperSymbol of S;
end;

registration
  let S be monotone OrderSortedSign;
  cluster -> monotone for OperSymbol of S;
end;

registration
  cluster op-discrete -> monotone for OrderSortedSign;
end;

theorem 
  S is monotone & the_arity_of o1 = {} & o1 ~= o2 & the_arity_of o2 = {}
  implies o1=o2;





definition
  let S,o,o1,w1;
  pred o1 has_least_args_for o,w1 means


  o ~= o1 & w1 <= the_arity_of
  o1 & for o2 st o ~= o2 & w1 <= the_arity_of o2 holds the_arity_of o1 <=
  the_arity_of o2;
  pred o1 has_least_sort_for o,w1 means


  o ~= o1 & w1 <= the_arity_of
  o1 & for o2 st o ~= o2 & w1 <= the_arity_of o2 holds the_result_sort_of o1 <=
  the_result_sort_of o2;
end;

definition
  let S,o,o1,w1;
  pred o1 has_least_rank_for o,w1 means


  o1 has_least_args_for o,w1 & o1 has_least_sort_for o,w1;
end;

definition
  let S,o;
  attr o is regular means


  o is monotone & for w1 st w1 <= the_arity_of
  o ex o1 st o1 has_least_args_for o,w1;
end;

definition
  let SM be monotone OrderSortedSign;
  attr SM is regular means


  for om being OperSymbol of SM holds om is regular;
end;

reserve SM for monotone OrderSortedSign,
  o,o1,o2 for OperSymbol of SM,
  w1 for Element of (the carrier of SM)*;

theorem 
  SM is regular iff for o,w1 st w1 <= the_arity_of o ex o1 st o1
  has_least_rank_for o,w1;

theorem 
  for SM being monotone OrderSortedSign holds SM is op-discrete
  implies SM is regular;

registration
  cluster regular for monotone OrderSortedSign;
end;

registration
  cluster op-discrete -> regular for monotone OrderSortedSign;
end;

registration
  let SR be regular monotone OrderSortedSign;
  cluster -> regular for OperSymbol of SR;
end;

reserve SR for regular monotone OrderSortedSign,
  o,o1,o3,o4 for OperSymbol of SR,
  w1 for Element of (the carrier of SR)*;

theorem 
  o3 has_least_args_for o,w1 & o4 has_least_args_for o,w1 implies o3 = o4;

definition
  let SR,o,w1;
  assume
 w1 <= the_arity_of o;
  func LBound(o,w1) -> OperSymbol of SR means


  it has_least_args_for o, w1;
end;

theorem 
  for w1 st w1 <= the_arity_of o holds LBound(o,w1) has_least_rank_for o,w1;



reserve R for non empty Poset;
reserve z for non empty set;



definition
  let R,z;
  func ConstOSSet(R,z) -> ManySortedSet of the carrier of R equals

  (the
  carrier of R) --> z;
end;

theorem 
  ConstOSSet(R,z) is non-empty & for s1,s2 being Element of R st
  s1 <= s2 holds ConstOSSet(R,z).s1 c= ConstOSSet(R,z).s2;

definition
  let R;
  let M be ManySortedSet of R;

  attr M is order-sorted means


  for s1,s2 being Element of R st s1 <= s2 holds M.s1 c= M.s2;
end;

theorem 
  ConstOSSet(R,z) is order-sorted;

registration
  let R;
  cluster order-sorted for ManySortedSet of R;
end;

registration
  let R,z;
  cluster ConstOSSet(R,z) -> order-sorted;
end;

definition
  let R be non empty Poset;
  mode OrderSortedSet of R is order-sorted ManySortedSet of R;
end;

registration
  let R be non empty Poset;
  cluster non-empty for OrderSortedSet of R;
end;

reserve s1,s2 for SortSymbol of S,
  o,o1,o2,o3 for OperSymbol of S,
  w1,w2 for Element of (the carrier of S)*;

definition
  let S;
  let M be MSAlgebra over S;
  attr M is order-sorted means


  for s1,s2 st s1 <= s2 holds (the Sorts of M).s1 c= (the Sorts of M).s2;
end;

theorem 
  for M being MSAlgebra over S holds M is order-sorted iff the
  Sorts of M is OrderSortedSet of S;

reserve CH for ManySortedFunction of ConstOSSet(S,z)# * the Arity of S,
  ConstOSSet(S,z) * the ResultSort of S;

definition
  let S,z,CH;
  func ConstOSA(S,z,CH) -> strict non-empty MSAlgebra over S means


  the Sorts of it = ConstOSSet(S,z) & the Charact of it = CH;
end;

theorem 
  ConstOSA(S,z,CH) is order-sorted;

registration
  let S;
  cluster strict non-empty order-sorted for MSAlgebra over S;
end;

registration
  let S,z,CH;
  cluster ConstOSA(S,z,CH) -> order-sorted;
end;

definition
  let S;
  mode OSAlgebra of S is order-sorted MSAlgebra over S;
end;

theorem 
  for S being discrete OrderSortedSign, M being MSAlgebra over S
  holds M is order-sorted;

registration
  let S be discrete OrderSortedSign;
  cluster -> order-sorted for MSAlgebra over S;
end;

reserve A for OSAlgebra of S;

theorem 
  w1 <= w2 implies (the Sorts of A)#.w1 c= (the Sorts of A)#.w2;

reserve M for MSAlgebra over S0;



definition
  let S0,M;
  func OSAlg M -> strict OSAlgebra of OSSign S0 means

  the Sorts of it = the Sorts of M & the Charact of it = the Charact of M;
end;



reserve A for OSAlgebra of S;




theorem 
  for w1,w2,w3 being Element of (the carrier of S)* holds w1 <= w2
  & w2 <= w3 implies w1 <= w3;

definition
  let S,o1,o2;
  pred o1 <= o2 means


  o1 ~= o2 & (the_arity_of o1) <= (the_arity_of o2
  ) & the_result_sort_of o1 <= the_result_sort_of o2;
  reflexivity;
end;

theorem 
  o1 <= o2 & o2 <= o1 implies o1 = o2;

theorem 
  o1 <= o2 & o2 <= o3 implies o1 <= o3;

theorem 
  the_result_sort_of o1 <= the_result_sort_of o2 implies Result(o1
  ,A) c= Result(o2,A);

theorem 
  the_arity_of o1 <= the_arity_of o2 implies Args(o1,A) c= Args(o2 ,A);

theorem 
  o1 <= o2 implies Args(o1,A) c= Args(o2,A) & Result(o1,A) c= Result(o2, A );







definition
  let S,A;
  attr A is monotone means


  for o1,o2 st o1 <= o2 holds Den(o2,A)|Args( o1,A) = Den(o1,A);
end;

theorem 
  for A being non-empty OSAlgebra of S holds A is monotone iff for
  o1,o2 st o1 <= o2 holds Den(o1,A) c= Den(o2,A);

theorem 
  (S is discrete or S is op-discrete) implies A is monotone;



definition
  let S,z;
  let z1 be Element of z;
  func TrivialOSA(S,z,z1) -> strict OSAlgebra of S means


  the Sorts of
  it = ConstOSSet(S,z) & for o holds Den(o,it) = Args(o,it) --> z1;
end;

theorem 
  for z1 being Element of z holds TrivialOSA(S,z,z1) is non-empty
  & TrivialOSA(S,z,z1) is monotone;

registration
  let S;
  cluster monotone strict non-empty for OSAlgebra of S;
end;

registration
  let S,z;
  let z1 be Element of z;
  cluster TrivialOSA(S,z,z1) -> monotone non-empty;
end;



reserve op1,op2 for OperSymbol of S;

definition
  let S;
  func OperNames S -> non empty (Subset-Family of the carrier' of S) equals

  Class the Overloading of S;
end;

registration
  let S;
  cluster -> non empty for Element of OperNames S;
end;

definition
  let S;
  mode OperName of S is Element of OperNames S;
end;

definition
  let S,op1;
  func Name op1 -> OperName of S equals

  Class(the Overloading of S,op1);
end;

theorem 
  op1 ~= op2 iff op2 in Class(the Overloading of S,op1);

theorem 
  op1 ~= op2 iff Name op1 = Name op2;

theorem 
  for X being set holds X is OperName of S iff ex op1 st X = Name op1;

definition
  let S;
  let o be OperName of S;
  redefine mode Element of o -> OperSymbol of S;
end;

theorem 
  for on being OperName of S, op being OperSymbol of S holds op is
  Element of on iff Name op = on;

theorem 
  for SR being regular monotone OrderSortedSign, op1,op2 being
OperSymbol of SR, w being Element of (the carrier of SR)* st op1 ~= op2 & w <=
  the_arity_of op1 & w <= the_arity_of op2 holds LBound(op1,w) = LBound(op2,w);

definition
  let SR be regular monotone OrderSortedSign, on be OperName of SR, w be
  Element of (the carrier of SR)*;
  assume
 ex op being Element of on st w <= the_arity_of op;
  func LBound(on,w) -> Element of on means

  for op being Element of on st w <= the_arity_of op holds it = LBound(op,w);
end;

theorem 
  for S being regular monotone OrderSortedSign, o being OperSymbol of
S, w1 being Element of (the carrier of S)* st w1 <= the_arity_of o holds LBound
  (o,w1) <= o;














begin 

reserve x for set,
  R for non empty Poset;



theorem 
  for X,Y being OrderSortedSet of R holds X /\ Y is OrderSortedSet of R;

theorem 
  for X,Y being OrderSortedSet of R holds X \/ Y is OrderSortedSet of R;



definition
  let R be non empty Poset, M be OrderSortedSet of R;
  
  mode OrderSortedSubset of M -> ManySortedSubset of M means


    it is OrderSortedSet of R;
end;

registration
  let R be non empty Poset, M be non-empty OrderSortedSet of R;
  cluster non-empty for OrderSortedSubset of M;
end;

begin





definition
  let S be OrderSortedSign, U0 be OSAlgebra of S;
  mode OSSubset of U0 -> ManySortedSubset of the Sorts of U0 means


    it is OrderSortedSet of S;
end;



registration
  let S be OrderSortedSign;
  cluster monotone strict non-empty for OSAlgebra of S;
end;

registration
  let S be OrderSortedSign, U0 be non-empty OSAlgebra of S;
  cluster non-empty for OSSubset of U0;
end;

theorem 
  for S0 being non void all-with_const_op strict non empty
  ManySortedSign holds OSSign S0 is all-with_const_op;

registration
  cluster all-with_const_op strict for OrderSortedSign;
end;

begin





theorem 
  for S being OrderSortedSign, U0 being OSAlgebra of S holds
  MSAlgebra (#the Sorts of U0,the Charact of U0#) is order-sorted;

registration
  let S be OrderSortedSign, U0 be OSAlgebra of S;
  cluster order-sorted for MSSubAlgebra of U0;
end;

definition
  let S be OrderSortedSign, U0 be OSAlgebra of S;
  mode OSSubAlgebra of U0 is order-sorted MSSubAlgebra of U0;
end;

registration
  let S be OrderSortedSign, U0 be OSAlgebra of S;
  cluster strict for OSSubAlgebra of U0;
end;

registration
  let S be OrderSortedSign, U0 be non-empty OSAlgebra of S;
  cluster non-empty strict for OSSubAlgebra of U0;
end;



theorem 
  for S being OrderSortedSign for U0 being OSAlgebra of S for U1
  being MSAlgebra over S holds U1 is OSSubAlgebra of U0 iff the Sorts of U1 is
  OSSubset of U0 & for B be OSSubset of U0 st B = the Sorts of U1 holds B is
  opers_closed & the Charact of U1 = Opers(U0,B);

reserve S1 for OrderSortedSign,
  OU0 for OSAlgebra of S1;
reserve s,s1,s2,s3,s4 for SortSymbol of S1;

definition
  let S1,OU0,s;
  func OSConstants(OU0,s) -> Subset of (the Sorts of OU0).s equals

  union {
  Constants(OU0,s2) : s2 <= s};
end;




theorem 
  Constants(OU0,s) c= OSConstants(OU0,s);

definition
  let S1;
  let M be ManySortedSet of the carrier of S1;
  func OSCl M -> OrderSortedSet of S1 means


  for s be SortSymbol of S1 holds it.s = union { M.s1: s1 <= s};
end;

theorem 
  for M being ManySortedSet of the carrier of S1 holds M c= OSCl M;

theorem 
  for M being ManySortedSet of the carrier of S1, A being
  OrderSortedSet of S1 holds M c= A implies OSCl M c= A;

theorem 
  for S being OrderSortedSign, X being OrderSortedSet of S holds OSCl X = X;




definition
  let S1,OU0;
  func OSConstants (OU0) -> OSSubset of OU0 means


  for s be SortSymbol of S1 holds it.s = OSConstants(OU0,s);
end;

theorem 
  Constants(OU0) c= OSConstants(OU0);

theorem 
  for A being OSSubset of OU0 holds Constants(OU0) c= A implies
  OSConstants(OU0) c= A;

theorem 
  for A being OSSubset of OU0 holds OSConstants(OU0) = OSCl Constants( OU0);

theorem 
  for OU1 being OSSubAlgebra of OU0 holds OSConstants(OU0) is OSSubset of OU1;

theorem 
  for S being all-with_const_op OrderSortedSign, OU0 being non-empty
OSAlgebra of S, OU1 being non-empty OSSubAlgebra of OU0 holds OSConstants(OU0)
  is non-empty OSSubset of OU1;

begin






theorem 
  for I being set for M being ManySortedSet of I for x being set
  holds x is ManySortedSubset of M iff x in product bool M;



definition
  let R be non empty Poset, M be OrderSortedSet of R;
  func OSbool(M) -> set means

  for x being set holds x in it iff x is OrderSortedSubset of M;
end;

definition
  let S be OrderSortedSign, U0 be OSAlgebra of S, A be OSSubset of U0;
  func OSSubSort(A) -> set equals

  { x where x is Element of SubSort(A): x is
  OrderSortedSet of S};
end;

theorem 
  for A being OSSubset of OU0 holds OSSubSort(A) c= SubSort(A);

theorem 
  for A being OSSubset of OU0 holds the Sorts of OU0 in OSSubSort( A);

registration
  let S1,OU0;
  let A be OSSubset of OU0;
  cluster OSSubSort(A) -> non empty;
end;

definition
  let S1,OU0;
  func OSSubSort(OU0) -> set equals

  { x where x is Element of SubSort(OU0): x
  is OrderSortedSet of S1};
end;

theorem 
  for A being OSSubset of OU0 holds OSSubSort(A) c= OSSubSort(OU0);

registration
  let S1,OU0;
  cluster OSSubSort(OU0) -> non empty;
end;



definition
  let S1,OU0;
  let e be Element of OSSubSort(OU0);
  func @e -> OSSubset of OU0 equals

  e;
end;




theorem 
  for A,B be OSSubset of OU0 holds B in OSSubSort(A) iff B is
  opers_closed & OSConstants(OU0) c= B & A c= B;

theorem 
  for B be OSSubset of OU0 holds B in OSSubSort(OU0) iff B is opers_closed;



definition
  let S1,OU0;
  let A be OSSubset of OU0, s be Element of S1;
  func OSSubSort(A,s) -> set means


  for x be set holds x in it iff ex B
  be OSSubset of OU0 st B in OSSubSort(A) & x = B.s;
end;

theorem 
  for A being OSSubset of OU0, s1,s2 being SortSymbol of S1 holds
  s1 <= s2 implies OSSubSort(A,s2) is_coarser_than OSSubSort(A,s1);

theorem 
  for A being OSSubset of OU0, s being SortSymbol of S1 holds
  OSSubSort(A,s) c= SubSort(A,s);

theorem 
  for A being OSSubset of OU0, s being SortSymbol of S1 holds (the
  Sorts of OU0).s in OSSubSort(A,s);

registration
  let S1,OU0;
  let A be OSSubset of OU0, s be SortSymbol of S1;
  cluster OSSubSort(A,s) -> non empty;
end;

definition
  let S1,OU0;
  let A be OSSubset of OU0;
  func OSMSubSort(A) -> OSSubset of OU0 means


  for s be SortSymbol of S1 holds it.s = meet (OSSubSort(A,s));
end;

registration
  let S1,OU0;
  cluster opers_closed for OSSubset of OU0;
end;

theorem 
  for A be OSSubset of OU0 holds OSConstants(OU0) \/ A c= OSMSubSort(A);

theorem 
  for A be OSSubset of OU0 st OSConstants(OU0) \/ A is non-empty holds
  OSMSubSort(A) is non-empty;

theorem 
  for o be OperSymbol of S1 for A be OSSubset of OU0 for B be
OSSubset of OU0 st B in OSSubSort(A) holds ((OSMSubSort A)# * (the Arity of S1)
  ).o c= (B# * (the Arity of S1)).o;

theorem 
  for o be OperSymbol of S1 for A be OSSubset of OU0 for B be
OSSubset of OU0 st B in OSSubSort(A) holds rng (Den(o,OU0)|(((OSMSubSort A)# *
  (the Arity of S1)).o)) c= (B * (the ResultSort of S1)).o;

theorem 
  for o be OperSymbol of S1 for A be OSSubset of OU0 holds rng ((
  Den(o,OU0))|(((OSMSubSort A)# * (the Arity of S1)).o)) c= ((OSMSubSort A) * (
  the ResultSort of S1)).o;

theorem 
  for A be OSSubset of OU0 holds OSMSubSort(A) is opers_closed & A
  c= OSMSubSort(A);

registration
  let S1,OU0;
  let A be OSSubset of OU0;
  cluster OSMSubSort(A) -> opers_closed;
end;

begin 

registration
  let S1,OU0;
  let A be opers_closed OSSubset of OU0;
  cluster OU0|A -> order-sorted;
end;

registration
  let S1,OU0;
  let OU1,OU2 be OSSubAlgebra of OU0;
  cluster OU1 /\ OU2 -> order-sorted;
end;



definition
  let S1,OU0;
  let A be OSSubset of OU0;

  func GenOSAlg(A) -> strict OSSubAlgebra of OU0 means


  A is OSSubset
  of it & for OU1 be OSSubAlgebra of OU0 st A is OSSubset of OU1 holds it is
  OSSubAlgebra of OU1;
end;




theorem 
  for A be OSSubset of OU0 holds GenOSAlg(A) = OU0 | OSMSubSort(A)
  & the Sorts of GenOSAlg(A) = OSMSubSort(A);



theorem 
  for S be non void non empty ManySortedSign for U0 be MSAlgebra
  over S for A be MSSubset of U0 holds GenMSAlg(A) = U0 | MSSubSort(A) & the
  Sorts of GenMSAlg(A) = MSSubSort(A);

theorem 
  for A being OSSubset of OU0 holds the Sorts of GenMSAlg(A) c=
  the Sorts of GenOSAlg(A);

theorem 
  for A being OSSubset of OU0 holds GenMSAlg(A) is MSSubAlgebra of
  GenOSAlg(A);

theorem 
  for OU0 being strict OSAlgebra of S1 for B being OSSubset of OU0
  st B = the Sorts of OU0 holds GenOSAlg(B) = OU0;

theorem 
  for OU1 being strict OSSubAlgebra of OU0, B being OSSubset of
  OU0 st B = the Sorts of OU1 holds GenOSAlg(B) = OU1;

theorem 
  for U0 be non-empty OSAlgebra of S1, U1 be OSSubAlgebra of U0
  holds GenOSAlg(OSConstants(U0)) /\ U1 = GenOSAlg(OSConstants(U0));

definition
  let S1;
  let U0 be non-empty OSAlgebra of S1, U1,U2 be OSSubAlgebra of U0;
  func U1 "\/"_os U2 -> strict OSSubAlgebra of U0 means


  for A be
  OSSubset of U0 st A = (the Sorts of U1) \/ (the Sorts of U2) holds it =
  GenOSAlg(A);
end;

theorem 
  for U0 be non-empty OSAlgebra of S1, U1 be OSSubAlgebra of U0, A
,B be OSSubset of U0 st B = A \/ the Sorts of U1 holds GenOSAlg(A) "\/"_os U1 =
  GenOSAlg(B);

theorem 
  for U0 be non-empty OSAlgebra of S1, U1 be OSSubAlgebra of U0, B
  be OSSubset of U0 st B = the Sorts of U0 holds GenOSAlg(B) "\/"_os U1 =
  GenOSAlg(B);

theorem 
  for U0 being non-empty OSAlgebra of S1, U1,U2 be OSSubAlgebra of
  U0 holds U1 "\/"_os U2 = U2 "\/"_os U1;

theorem 
  for U0 be non-empty OSAlgebra of S1, U1,U2 be strict
  OSSubAlgebra of U0 holds U1 /\ (U1"\/"_os U2) = U1;

theorem 
  for U0 be non-empty OSAlgebra of S1, U1,U2 be strict
  OSSubAlgebra of U0 holds (U1 /\ U2) "\/"_os U2 = U2;

begin 


definition
  let S1,OU0;
  func OSSub(OU0) -> set means


  for x holds x in it iff x is strict OSSubAlgebra of OU0;
end;

theorem 
  OSSub(OU0) c= MSSub(OU0);

registration
  let S be OrderSortedSign, U0 be OSAlgebra of S;
  cluster OSSub(U0) -> non empty;
end;

definition
  let S1,OU0;
  redefine func OSSub(OU0) -> Subset of MSSub(OU0);
end;




definition
  let S1;
  let U0 be non-empty OSAlgebra of S1;
  func OSAlg_join(U0) -> BinOp of (OSSub(U0)) means


  for x,y be Element
  of OSSub(U0) holds for U1,U2 be strict OSSubAlgebra of U0 st x = U1 & y = U2
  holds it.(x,y) = U1 "\/"_os U2;
end;

definition
  let S1;
  let U0 be non-empty OSAlgebra of S1;
  func OSAlg_meet(U0) -> BinOp of (OSSub(U0)) means


  for x,y be Element
  of OSSub(U0) holds for U1,U2 be strict OSSubAlgebra of U0 st x = U1 & y = U2
  holds it.(x,y) = U1 /\ U2;
end;

theorem 
  for U0 being non-empty OSAlgebra of S1 for x,y being Element of
  OSSub(U0) holds (OSAlg_meet(U0)).(x,y) = (MSAlg_meet(U0)).(x,y);

reserve U0 for non-empty OSAlgebra of S1;

theorem 
  OSAlg_join(U0) is commutative;

theorem 
  OSAlg_join(U0) is associative;

theorem 
  OSAlg_meet(U0) is commutative;

theorem 
  OSAlg_meet(U0) is associative;

definition
  let S1;
  let U0 be non-empty OSAlgebra of S1;
  func OSSubAlLattice(U0) -> strict Lattice equals

  LattStr (# OSSub(U0),
    OSAlg_join(U0), OSAlg_meet(U0) #);
end;

theorem 
  for U0 be non-empty OSAlgebra of S1 holds OSSubAlLattice(U0) is bounded;

registration
  let S1;
  let U0 be non-empty OSAlgebra of S1;
  cluster OSSubAlLattice(U0) -> bounded;
end;

theorem 
  for U0 be non-empty OSAlgebra of S1 holds Bottom (OSSubAlLattice(U0))
  = GenOSAlg(OSConstants(U0));

theorem 
  for U0 be non-empty OSAlgebra of S1, B be OSSubset of U0 st B =
  the Sorts of U0 holds Top (OSSubAlLattice(U0)) = GenOSAlg(B);

theorem 
  for U0 be strict non-empty OSAlgebra of S1 holds Top (OSSubAlLattice(
  U0)) = U0;














begin

reserve R for non empty Poset,
  S1 for OrderSortedSign;

definition
  let R;
  let F be ManySortedFunction of the carrier of R;
  attr F is order-sorted means


  for s1,s2 being Element of R st s1 <= s2
holds for a1 being set st a1 in dom (F.s1) holds a1 in dom (F.s2) & (F.s1).a1 =
  (F.s2).a1;
end;




theorem 
  for F being ManySortedFunction of the carrier of R st F is
order-sorted for s1,s2 being Element of R st s1 <= s2 holds dom (F.s1) c= dom (
  F.s2) & F.s1 c= F.s2;

theorem 
  for A be OrderSortedSet of R, B be non-empty OrderSortedSet of R,
  F be ManySortedFunction of A,B holds F is order-sorted iff for s1,s2 being
Element of R st s1 <= s2 holds for a1 being set st a1 in A.s1 holds (F.s1).a1 =
  (F.s2).a1;

theorem 
  for F being ManySortedFunction of the carrier of R st F is
order-sorted for w1,w2 being Element of (the carrier of R)* st w1 <= w2 holds F
  #.w1 c= F#.w2;

theorem 
  for A being OrderSortedSet of R holds id A is order-sorted;

registration
  let R;
  let A be OrderSortedSet of R;
  cluster id A -> order-sorted;
end;

theorem 
  for A be OrderSortedSet of R for B,C be non-empty OrderSortedSet
of R, F be ManySortedFunction of A,B, G be ManySortedFunction of B,C holds F is
  order-sorted & G is order-sorted implies G**F is order-sorted;

theorem 
  for A,B being OrderSortedSet of R, F being ManySortedFunction of
  A,B st F is "1-1" & F is "onto" & F is order-sorted holds F"" is order-sorted
;



theorem 
  for A being OrderSortedSet of R, F being ManySortedFunction of
  the carrier of R st F is order-sorted holds F.:.:A is OrderSortedSet of R;

definition
  let S1;
  let U1,U2 be OSAlgebra of S1;
  pred U1,U2 are_os_isomorphic means


  ex F be ManySortedFunction of U1,
  U2 st F is_isomorphism U1,U2 & F is order-sorted;
end;

theorem 
  for U1 being OSAlgebra of S1 holds U1,U1 are_os_isomorphic;

theorem 
  for U1,U2 being non-empty OSAlgebra of S1 holds U1,U2
  are_os_isomorphic implies U2,U1 are_os_isomorphic;

definition
  let S1;
  let U1, U2 be OSAlgebra of S1;
  redefine pred U1, U2 are_os_isomorphic;
  reflexivity;
end;

definition
  let S1;
  let U1, U2 be non-empty OSAlgebra of S1;
  redefine pred U1, U2 are_os_isomorphic;
  symmetry;
end;



theorem 
  for U1,U2,U3 being non-empty OSAlgebra of S1 holds U1,U2
  are_os_isomorphic & U2,U3 are_os_isomorphic implies U1,U3 are_os_isomorphic;



theorem 
  for U1,U2 being non-empty OSAlgebra of S1 for F being
  ManySortedFunction of U1,U2 st F is order-sorted & F is_homomorphism U1,U2
  holds Image F is order-sorted;

theorem 
  for U1,U2 being non-empty OSAlgebra of S1 for F being
ManySortedFunction of U1,U2 st F is order-sorted for o1,o2 being OperSymbol of
S1 st o1 <= o2 for x being Element of Args(o1,U1), x1 be Element of Args(o2,U1)
  st x = x1 holds F # x = F # x1;

theorem 
  for U1 being monotone non-empty OSAlgebra of S1, U2 being
  non-empty OSAlgebra of S1 for F being ManySortedFunction of U1,U2 st F is
order-sorted & F is_homomorphism U1,U2 holds Image F is order-sorted & Image F
  is monotone OSAlgebra of S1;

theorem 
  for U1 being monotone OSAlgebra of S1, U2 being OSSubAlgebra of
  U1 holds U2 is monotone;

registration
  let S1;
  let U1 be monotone OSAlgebra of S1;
  cluster monotone for OSSubAlgebra of U1;
end;

registration
  let S1;
  let U1 be monotone OSAlgebra of S1;
  cluster -> monotone for OSSubAlgebra of U1;
end;

theorem 
  for U1,U2 being non-empty OSAlgebra of S1 for F be
ManySortedFunction of U1,U2 st F is_homomorphism U1,U2 & F is order-sorted ex G
  be ManySortedFunction of U1,Image F st F = G & G is order-sorted & G
  is_epimorphism U1,Image F;

theorem 
  for U1,U2 being non-empty OSAlgebra of S1 for F be ManySortedFunction
  of U1,U2 st F is_homomorphism U1,U2 & F is order-sorted ex F1 be
ManySortedFunction of U1,Image F, F2 be ManySortedFunction of Image F,U2 st F1
is_epimorphism U1,Image F & F2 is_monomorphism Image F,U2 & F = F2**F1 & F1 is
  order-sorted & F2 is order-sorted;

registration
  let S1;
  let U1 be OSAlgebra of S1;
  cluster MSAlgebra(# the Sorts of U1, the Charact of U1 #) -> order-sorted;
end;





theorem 
  for U1 being OSAlgebra of S1 holds (U1 is monotone iff MSAlgebra(# the
    Sorts of U1, the Charact of U1 #) is monotone);




theorem 
  for U1,U2 being strict non-empty OSAlgebra of S1 st U1,U2
  are_os_isomorphic holds U1 is monotone iff U2 is monotone;














begin

registration
  let R be non empty Poset;
  cluster Relation-yielding for OrderSortedSet of R;
end;



definition
  let R be non empty Poset;
  let A,B be ManySortedSet of the carrier of R;
  let IT be ManySortedRelation of A,B;
  attr IT is os-compatible means


  for s1,s2 being Element of R st s1 <=
s2 for x,y being set st x in A.s1 & y in B.s1 holds [x,y] in IT.s1 iff [x,y] in
  IT.s2;
end;

registration
  let R be non empty Poset;
  let A,B be ManySortedSet of the carrier of R;
  cluster os-compatible for ManySortedRelation of A,B;
end;

definition
  let R be non empty Poset;
  let A,B be ManySortedSet of the carrier of R;
  mode OrderSortedRelation of A,B is os-compatible ManySortedRelation of A,B;
end;

theorem 
  for R being non empty Poset, A,B being ManySortedSet of the
  carrier of R, OR being ManySortedRelation of A,B holds OR is os-compatible
  implies OR is OrderSortedSet of R;

registration
  let R be non empty Poset;
  let A,B be ManySortedSet of R;
  cluster os-compatible -> order-sorted for ManySortedRelation of A,B;
end;

definition
  let R be non empty Poset;
  let A be ManySortedSet of the carrier of R;
  mode OrderSortedRelation of A is OrderSortedRelation of A,A;
end;

definition
  let S be OrderSortedSign, U1 be OSAlgebra of S;

  mode OrderSortedRelation of U1 -> ManySortedRelation of U1 means


    it is os-compatible;
end;





registration
  let S be OrderSortedSign, U1 be OSAlgebra of S;
  cluster MSEquivalence-like for OrderSortedRelation of U1;
end;




registration
  let S be OrderSortedSign, U1 be non-empty OSAlgebra of S;
  cluster MSCongruence-like for MSEquivalence-like OrderSortedRelation of U1;
end;

definition
  let S be OrderSortedSign, U1 be non-empty OSAlgebra of S;
  mode OSCongruence of U1 is MSCongruence-like MSEquivalence-like
    OrderSortedRelation of U1;
end;












definition
  let R be non empty Poset;
  func Path_Rel R -> Equivalence_Relation of the carrier of R means


  for
x,y being set holds [x,y] in it iff x in the carrier of R & y in the carrier of
R & ex p being FinSequence of the carrier of R st 1 < len p & p.1 = x & p.(len
  p) = y & for n being Nat st 2 <= n & n <= len p holds [p.n,p.(n-1)] in the
  InternalRel of R or [p.(n-1),p.n] in the InternalRel of R;
end;

theorem 
  for R being non empty Poset, s1,s2 being Element of R st s1 <= s2
  holds [s1,s2] in Path_Rel R;



definition
  let R be non empty Poset;
  let s1,s2 be Element of R;
  pred s1 ~= s2 means


  [s1,s2] in Path_Rel R;
  reflexivity;
  symmetry;
end;

theorem 
  for R being non empty Poset, s1,s2,s3 being Element of R holds s1 ~=
  s2 & s2 ~= s3 implies s1 ~= s3;



definition
  let R be non empty Poset;
  func Components R -> non empty (Subset-Family of R) equals

  Class Path_Rel R;
end;

registration
  let R be non empty Poset;
  cluster -> non empty for Element of Components R;
end;

definition
  let R be non empty Poset;
  mode Component of R is Element of Components R;
end;

definition
  let R be non empty Poset;
  let s1 be Element of R;

  func CComp s1 -> Component of R equals

  Class(Path_Rel R,s1);
end;

theorem 
  for R being non empty Poset, s1,s2 being Element of R st s1 <= s2
  holds CComp(s1) = CComp(s2);

definition
  let R be non empty Poset;
  let A be ManySortedSet of the carrier of R;
  let C be Component of R;
  func A-carrier_of C equals

  union {A.s where s is Element of R: s in C};
end;

theorem 
  for R being non empty Poset, A being ManySortedSet of the carrier
  of R, s being (Element of R), x being set st x in A.s holds x in A-carrier_of
  CComp(s);

definition
  let R be non empty Poset;
  attr R is locally_directed means


  for C being Component of R holds C is directed;
end;

theorem 
  for R being discrete non empty Poset holds for x,y being Element
  of R st [x,y] in Path_Rel R holds x = y;

theorem 
  for R being discrete non empty Poset, C being Component of R ex x
  being Element of R st C = {x};

theorem 
  for R being discrete non empty Poset holds R is locally_directed;



registration
  cluster locally_directed for non empty Poset;
end;

registration
  cluster locally_directed for OrderSortedSign;
end;

registration
  cluster discrete -> locally_directed for non empty Poset;
end;

registration
  let S be locally_directed non empty Poset;
  cluster -> directed for Component of S;
end;

theorem 
  {} is Equivalence_Relation of {};







definition
  let S be locally_directed OrderSortedSign;
  let A be OSAlgebra of S;
  let E be MSEquivalence-like OrderSortedRelation of A;
  let C be Component of S;
  func CompClass(E,C) -> Equivalence_Relation of (the Sorts of A)-carrier_of C
  means


  for x,y being set holds [x,y] in it iff ex s1 being Element of S
  st s1 in C & [x,y] in E.s1;
end;




definition
  let S be locally_directed OrderSortedSign;
  let A be OSAlgebra of S;
  let E be MSEquivalence-like OrderSortedRelation of A;
  let s1 be Element of S;
  func OSClass(E,s1) -> Subset of Class(CompClass(E,CComp(s1))) means


for z being set holds z in it iff ex x being set st x in (the Sorts of A).s1 &
  z = Class( CompClass(E,CComp(s1)), x);
end;

registration
  let S be locally_directed OrderSortedSign;
  let A be non-empty OSAlgebra of S;
  let E be MSEquivalence-like OrderSortedRelation of A;
  let s1 be Element of S;
  cluster OSClass(E,s1) -> non empty;
end;

theorem 
  for S being locally_directed OrderSortedSign, A being OSAlgebra
  of S, E being MSEquivalence-like (OrderSortedRelation of A), s1,s2 being
  Element of S st s1 <= s2 holds OSClass(E,s1) c= OSClass(E,s2);





definition
  let S be locally_directed OrderSortedSign;
  let A be OSAlgebra of S;
  let E be MSEquivalence-like OrderSortedRelation of A;
  func OSClass E -> OrderSortedSet of S means


  for s1 being Element of S holds it.s1 = OSClass(E,s1);
end;

registration
  let S be locally_directed OrderSortedSign;
  let A be non-empty OSAlgebra of S;
  let E be MSEquivalence-like OrderSortedRelation of A;
  cluster OSClass E -> non-empty;
end;



definition
  let S be locally_directed OrderSortedSign;
  let U1 be non-empty OSAlgebra of S;
  let E be MSEquivalence-like OrderSortedRelation of U1;
  let s be Element of S;
  let x be Element of (the Sorts of U1).s;
  func OSClass(E,x) -> Element of OSClass(E,s) equals

  Class( CompClass(E,
  CComp(s)), x);
end;

theorem 
  for R being locally_directed non empty Poset, x,y being Element of R
  st (ex z being Element of R st z <= x & z <= y) holds ex u being Element of R
  st x <= u & y <= u;

theorem 
  for S be locally_directed OrderSortedSign, U1 be non-empty
  OSAlgebra of S, E be MSEquivalence-like (OrderSortedRelation of U1),
  s be Element of S, x,y be Element of (the Sorts of U1).s holds OSClass(E,x) =
  OSClass(E,y) iff [x,y] in E.s;

theorem 
  for S be locally_directed OrderSortedSign, U1 be non-empty OSAlgebra
of S, E be MSEquivalence-like (OrderSortedRelation of U1), s1,s2 be Element of
S, x be Element of (the Sorts of U1).s1 st s1 <= s2 holds for y being Element
  of (the Sorts of U1).s2 st y = x holds OSClass(E,x) = OSClass(E,y);

begin 



reserve S for locally_directed OrderSortedSign;
reserve o for Element of the carrier' of S;



definition
  let S,o;
  let A be non-empty OSAlgebra of S;
  let R be OSCongruence of A;
  let x be Element of Args(o,A);
  func R #_os x -> Element of product ((OSClass R) * (the_arity_of o)) means


   for n be Nat st n in dom (the_arity_of o) ex y being Element of (the
  Sorts of A).((the_arity_of o)/.n) st y = x.n & it.n = OSClass(R, y);
end;




definition
  let S,o;
  let A be non-empty OSAlgebra of S;
  let R be OSCongruence of A;
  func OSQuotRes(R,o) -> Function of ((the Sorts of A) * the ResultSort of S).
  o, ((OSClass R) * the ResultSort of S).o means


  for x being Element of (
  the Sorts of A).(the_result_sort_of o) holds it.x = OSClass(R,x);
  func OSQuotArgs(R,o) -> Function of ((the Sorts of A)# * the Arity of S).o,
  ((OSClass R)# * the Arity of S).o means

  for x be Element of Args(o,A) holds it. x = R #_os x;
end;

definition
  let S;
  let A be non-empty OSAlgebra of S;
  let R be OSCongruence of A;
  func OSQuotRes R -> ManySortedFunction of ((the Sorts of A) * the ResultSort
  of S), ((OSClass R) * the ResultSort of S) means

  for o being OperSymbol of S holds it.o = OSQuotRes(R,o);
  func OSQuotArgs R -> ManySortedFunction of (the Sorts of A)# * the Arity of
  S, (OSClass R)# * the Arity of S means

  for o be OperSymbol of S holds it.o = OSQuotArgs(R,o);
end;

theorem 
  for A be non-empty OSAlgebra of S, R be OSCongruence of A, x be
set st x in ((OSClass R)# * the Arity of S).o ex a be Element of Args(o,A) st x
  = R #_os a;

definition
  let S,o;
  let A be non-empty OSAlgebra of S;
  let R be OSCongruence of A;
  func OSQuotCharact(R,o) -> Function of ((OSClass R)# * the Arity of S).o, ((
  OSClass R) * the ResultSort of S).o means


  for a be Element of Args(o,A)
  st R #_os a in ((OSClass R)# * the Arity of S).o holds it.(R #_os a) = ((
  OSQuotRes(R,o)) * (Den(o,A))).a;
end;

definition
  let S;
  let A be non-empty OSAlgebra of S;
  let R be OSCongruence of A;
  func OSQuotCharact R -> ManySortedFunction of (OSClass R)# * the Arity of S,
  (OSClass R) * the ResultSort of S means


  for o be OperSymbol of S holds it.o = OSQuotCharact(R,o);
end;

definition
  let S;
  let U1 be non-empty OSAlgebra of S;
  let R be OSCongruence of U1;
  func QuotOSAlg(U1,R) -> OSAlgebra of S equals

  MSAlgebra(# OSClass R,
    OSQuotCharact R #);
end;



registration
  let S;
  let U1 be non-empty OSAlgebra of S;
  let R be OSCongruence of U1;
  cluster QuotOSAlg (U1,R) -> strict non-empty;
end;

definition
  let S;
  let U1 be non-empty OSAlgebra of S;
  let R be OSCongruence of U1;
  let s be Element of S;
  func OSNat_Hom(U1,R,s) -> Function of (the Sorts of U1).s,OSClass(R,s) means


  for x being Element of (the Sorts of U1).s holds it.x = OSClass(R,x);
end;

definition
  let S;
  let U1 be non-empty OSAlgebra of S;
  let R be OSCongruence of U1;
  func OSNat_Hom(U1,R) -> ManySortedFunction of U1, QuotOSAlg (U1,R) means


   for s be Element of S holds it.s = OSNat_Hom(U1,R,s);
end;

theorem 
  for U1 be non-empty OSAlgebra of S, R be OSCongruence of U1 holds
  OSNat_Hom(U1,R) is_epimorphism U1, QuotOSAlg (U1,R) & OSNat_Hom(U1,R) is
  order-sorted;

theorem 
  for U1,U2 being non-empty OSAlgebra of S, F being
  ManySortedFunction of U1,U2 st F is_homomorphism U1,U2 & F is order-sorted
  holds MSCng(F) is OSCongruence of U1;



definition
  let S;
  let U1,U2 be non-empty OSAlgebra of S;
  let F be ManySortedFunction of U1,U2;
  assume
 F is_homomorphism U1,U2 & F is order-sorted;
  func OSCng(F) -> OSCongruence of U1 equals


  MSCng(F);
end;

definition
  let S;
  let U1,U2 be non-empty OSAlgebra of S;
  let F be ManySortedFunction of U1,U2;
  let s be Element of S;
  assume that
 F is_homomorphism U1,U2 and
 F is order-sorted;
  func OSHomQuot(F,s) -> Function of (the Sorts of (QuotOSAlg (U1,OSCng F))).s
  ,(the Sorts of U2).s means


  for x be Element of (the Sorts of U1).s
  holds it.(OSClass(OSCng(F),x)) = (F.s).x;
end;




definition
  let S;
  let U1,U2 be non-empty OSAlgebra of S;
  let F be ManySortedFunction of U1,U2;
  func OSHomQuot(F) -> ManySortedFunction of (QuotOSAlg (U1, OSCng F)),U2
  means


  for s be Element of S holds it.s = OSHomQuot(F,s);
end;

theorem 
  for U1,U2 be non-empty OSAlgebra of S, F be ManySortedFunction
  of U1,U2 st F is_homomorphism U1,U2 & F is order-sorted holds OSHomQuot(F)
  is_monomorphism QuotOSAlg (U1,OSCng F),U2 & OSHomQuot(F) is order-sorted;

theorem 
  for U1,U2 be non-empty OSAlgebra of S, F be ManySortedFunction
  of U1,U2 st F is_epimorphism U1,U2 & F is order-sorted holds OSHomQuot(F)
  is_isomorphism QuotOSAlg (U1,OSCng F),U2;

theorem 
  for U1,U2 be non-empty OSAlgebra of S, F be ManySortedFunction of U1,
U2 st F is_epimorphism U1,U2 & F is order-sorted holds QuotOSAlg (U1,OSCng F),
  U2 are_isomorphic;










definition
  let S be OrderSortedSign, U1 be non-empty OSAlgebra of S, R be
  MSEquivalence-like OrderSortedRelation of U1;
  attr R is monotone means


  for o1,o2 being OperSymbol of S st o1 <= o2
  for x1 being Element of Args(o1,U1) for x2 being Element of Args(o2,U1) st (
for y being Nat st y in dom x1 holds [x1.y,x2.y] in R.((the_arity_of o2)/.y) )
  holds [Den(o1,U1).x1,Den(o2,U1).x2] in R.(the_result_sort_of o2);
end;

theorem 
  for S being OrderSortedSign, U1 being non-empty OSAlgebra of S
  holds [| the Sorts of U1, the Sorts of U1 |] is OSCongruence of U1;

theorem 
  for S being OrderSortedSign, U1 being non-empty OSAlgebra of S,
  R being OSCongruence of U1 st R = [| (the Sorts of U1), (the Sorts of U1) |]
  holds R is monotone;

registration
  let S be OrderSortedSign, U1 be non-empty OSAlgebra of S;
  cluster monotone for OSCongruence of U1;
end;

registration
  let S be OrderSortedSign, U1 be non-empty OSAlgebra of S;
  cluster monotone for MSEquivalence-like OrderSortedRelation of U1;
end;

theorem 
  for S being OrderSortedSign, U1 being non-empty OSAlgebra of S,
  R being monotone MSEquivalence-like OrderSortedRelation of U1 holds R is
  MSCongruence-like;

registration
  let S be OrderSortedSign, U1 be non-empty OSAlgebra of S;
  cluster monotone -> MSCongruence-like for MSEquivalence-like
    OrderSortedRelation of U1;
end;

theorem 
  for S being OrderSortedSign, U1 being monotone non-empty
  OSAlgebra of S, R being OSCongruence of U1 holds R is monotone;

registration
  let S be OrderSortedSign, U1 be monotone non-empty OSAlgebra of S;
  cluster -> monotone for OSCongruence of U1;
end;



registration
  let S;
  let U1 be non-empty OSAlgebra of S;
  let R be monotone OSCongruence of U1;
  cluster QuotOSAlg(U1,R) -> monotone;
end;

theorem 
  for U1 being non-empty OSAlgebra of S, U2 being monotone non-empty
OSAlgebra of S, F being ManySortedFunction of U1,U2 st F is_homomorphism U1,U2
  & F is order-sorted holds OSCng(F) is monotone;





definition
  let S;
  let U1,U2 be non-empty OSAlgebra of S;
  let F be ManySortedFunction of U1,U2;
  let R be OSCongruence of U1;
  let s be Element of S;
  assume that
 F is_homomorphism U1,U2 and
 F is order-sorted and
 R c= OSCng F;
  func OSHomQuot(F,R,s) -> Function of (the Sorts of (QuotOSAlg (U1,R))).s,(
  the Sorts of U2).s means


  for x be Element of (the Sorts of U1).s holds it.(OSClass(R,x)) = (F.s).x;
end;




definition
  let S;
  let U1,U2 be non-empty OSAlgebra of S;
  let F be ManySortedFunction of U1,U2;
  let R be OSCongruence of U1;
  func OSHomQuot(F,R) -> ManySortedFunction of (QuotOSAlg (U1, R)),U2 means


   for s be Element of S holds it.s = OSHomQuot(F,R,s);
end;

theorem 
  for U1,U2 be non-empty OSAlgebra of S, F be ManySortedFunction of U1,
U2, R be OSCongruence of U1 st F is_homomorphism U1,U2 & F is order-sorted & R
c= OSCng F holds OSHomQuot(F,R) is_homomorphism QuotOSAlg (U1,R),U2 & OSHomQuot
  (F,R) is order-sorted;














begin

reserve S for OrderSortedSign;





definition
  let S be OrderSortedSign, U0 be OSAlgebra of S;
  mode OSGeneratorSet of U0 -> MSSubset of U0 means


    for O being
OSSubset of U0 st O = OSCl it holds the Sorts of GenOSAlg(O) = the Sorts of U0;
end;

theorem 
  for S be OrderSortedSign, U0 be strict non-empty OSAlgebra of S, A be
  MSSubset of U0 holds A is OSGeneratorSet of U0 iff for O being OSSubset of U0
  st O = OSCl A holds GenOSAlg(O) = U0;





definition
  let S;
  let U0 be monotone OSAlgebra of S;
  let IT be OSGeneratorSet of U0;
  attr IT is osfree means

  for U1 be monotone non-empty OSAlgebra of S for f be
ManySortedFunction of IT,the Sorts of U1 ex h be ManySortedFunction of U0,U1 st
  h is_homomorphism U0,U1 & h is order-sorted & h || IT = f;
end;

definition
  let S be OrderSortedSign;
  let IT be monotone OSAlgebra of S;
  attr IT is osfree means

  ex G being OSGeneratorSet of IT st G is osfree;
end;

begin





definition
  let S be OrderSortedSign, X be ManySortedSet of S;
  func OSREL(X) -> Relation of ([:the carrier' of S,{the carrier of S}:] \/
Union (coprod X)), (([:the carrier' of S,{the carrier of S}:] \/ Union (coprod
  X))*) means


  for a be Element of [:the carrier' of S,{the carrier of S}:]
\/ Union (coprod X), b be Element of ([:the carrier' of S,{the carrier of S}:]
  \/ Union (coprod X))* holds [a,b] in it iff a in [:the carrier' of S,{the
  carrier of S}:] & for o be OperSymbol of S st [o,the carrier of S] = a holds
  len b = len (the_arity_of o) & for x be set st x in dom b holds (b.x in [:the
carrier' of S,{the carrier of S}:] implies for o1 be OperSymbol of S st [o1,the
carrier of S] = b.x holds (the_result_sort_of o1) <= (the_arity_of o)/.x) & (b.
x in Union (coprod X) implies ex i being Element of S st i <= (the_arity_of o)
  /.x & b.x in coprod(i,X));
end;

reserve S for OrderSortedSign,
  X for ManySortedSet of S,
  o for OperSymbol of S ,
  b for Element of ([:the carrier' of S,{the carrier of S}:] \/ Union (coprod X
  ))*;

theorem 
  [[o,the carrier of S],b] in OSREL(X) iff len b = len (
the_arity_of o) & for x be set st x in dom b holds (b.x in [:the carrier' of S,
{the carrier of S}:] implies for o1 be OperSymbol of S st [o1,the carrier of S]
  = b.x holds (the_result_sort_of o1) <= (the_arity_of o)/.x) & (b.x in Union (
coprod X) implies ex i being Element of S st i <= (the_arity_of o)/.x & b.x in
  coprod(i,X));

definition
  let S be OrderSortedSign, X be ManySortedSet of S;
  func DTConOSA(X) -> DTConstrStr equals

  DTConstrStr (# [:the carrier' of S,{
    the carrier of S}:] \/ Union (coprod X), OSREL(X) #);
end;

registration
  let S be OrderSortedSign, X be ManySortedSet of S;
  cluster DTConOSA(X) -> strict non empty;
end;

theorem 
  for S be OrderSortedSign, X be non-empty ManySortedSet of S holds
  NonTerminals(DTConOSA(X)) = [:the carrier' of S,{the carrier of S}:] &
  Terminals (DTConOSA(X)) = Union (coprod X);

reserve x for set;

registration
  let S be OrderSortedSign, X be non-empty ManySortedSet of S;
  cluster DTConOSA(X) -> with_terminals with_nonterminals
    with_useful_nonterminals;
end;

theorem 
  for S be OrderSortedSign, X be non-empty ManySortedSet of S, t be
set holds t in Terminals DTConOSA(X) iff ex s be Element of S, x be set st x in
  X.s & t = [x,s];



definition
  let S be OrderSortedSign, X be non-empty ManySortedSet of S, o be OperSymbol
  of S;
  func OSSym(o,X) ->Symbol of DTConOSA(X) equals

  [o,the carrier of S];
end;



definition
  let S be OrderSortedSign, X be non-empty ManySortedSet of S, s be Element of
  S;
  func ParsedTerms(X,s) -> Subset of TS(DTConOSA(X)) equals

  {a where a is
Element of TS(DTConOSA(X)): (ex s1 being Element of S, x be set st s1 <= s & x
in X.s1 & a = root-tree [x,s1]) or ex o be OperSymbol of S st [o,the carrier of
  S] = a.{} & the_result_sort_of o <= s};
end;

registration
  let S be OrderSortedSign, X be non-empty ManySortedSet of S, s be Element of
  S;
  cluster ParsedTerms(X,s) -> non empty;
end;

definition
  let S be OrderSortedSign, X be non-empty ManySortedSet of S;
  func ParsedTerms(X) -> OrderSortedSet of S means


  for s be Element of S holds it.s = ParsedTerms(X,s);
end;

registration
  let S be OrderSortedSign, X be non-empty ManySortedSet of S;
  cluster ParsedTerms(X) -> non-empty;
end;

theorem 
  for S be OrderSortedSign, X be non-empty ManySortedSet of S, o be
OperSymbol of S, x be set st x in ((ParsedTerms X)# * (the Arity of S)).o holds
  x is FinSequence of TS(DTConOSA(X));

theorem 
  for S be OrderSortedSign, X be non-empty ManySortedSet of S, o be
OperSymbol of S, p be FinSequence of TS(DTConOSA(X)) holds p in ((ParsedTerms X
  )# * (the Arity of S)).o iff dom p = dom (the_arity_of o) & for n be Nat st n
  in dom p holds p.n in ParsedTerms(X,(the_arity_of o)/.n);

theorem 
  for S be OrderSortedSign, X be non-empty ManySortedSet of S, o be
OperSymbol of S, p be FinSequence of TS(DTConOSA(X)) holds OSSym(o,X) ==> roots
  p iff p in ((ParsedTerms X)# * (the Arity of S)).o;

theorem 
  for S be OrderSortedSign, X be non-empty ManySortedSet of S holds
  union rng (ParsedTerms X) = TS (DTConOSA(X));

definition
  let S be OrderSortedSign, X be non-empty ManySortedSet of S, o be OperSymbol
  of S;
  func PTDenOp(o,X) -> Function of ((ParsedTerms X)# * (the Arity of S)).o, ((
  ParsedTerms X) * (the ResultSort of S)).o means


  for p be FinSequence of
  TS(DTConOSA(X)) st OSSym(o,X) ==> roots p holds it.p = (OSSym(o,X))-tree p;
end;

definition
  let S be OrderSortedSign, X be non-empty ManySortedSet of S;
  func PTOper(X) -> ManySortedFunction of (ParsedTerms X)# * (the Arity of S),
  (ParsedTerms X) * (the ResultSort of S) means


  for o be OperSymbol of S holds it.o = PTDenOp(o,X);
end;

definition
  let S be OrderSortedSign, X be non-empty ManySortedSet of S;
  func ParsedTermsOSA(X) -> OSAlgebra of S equals

  MSAlgebra (# ParsedTerms(X),
    PTOper(X) #);
end;

registration
  let S be OrderSortedSign, X be non-empty ManySortedSet of S;
  cluster ParsedTermsOSA(X) -> strict non-empty;
end;

definition
  let S be OrderSortedSign;
  let X be non-empty ManySortedSet of S;
  let o be OperSymbol of S;
  redefine func OSSym(o, X) -> NonTerminal of DTConOSA X;
end;

theorem 
  for S being OrderSortedSign, X being non-empty ManySortedSet of S
, s being Element of S holds (the Sorts of ParsedTermsOSA(X)).s = {a where a is
Element of TS(DTConOSA(X)): (ex s1 being Element of S, x be set st s1 <= s & x
in X.s1 & a = root-tree [x,s1]) or ex o be OperSymbol of S st [o,the carrier of
  S] = a.{} & the_result_sort_of o <= s};

theorem 
  for S being OrderSortedSign, X being non-empty ManySortedSet of
  S, s,s1 being Element of S, x being set st x in X.s holds root-tree [x,s] is
  Element of TS DTConOSA(X) & ( for z being set holds [z,the carrier of S] <> (
root-tree [x,s]).{} ) & ( root-tree [x,s] in (the Sorts of ParsedTermsOSA(X)).
  s1 iff s <= s1 );

theorem 
  for S being OrderSortedSign, X being non-empty ManySortedSet of
S, t being Element of TS (DTConOSA X), o being OperSymbol of S st t.{} = [o,the
carrier of S] holds (ex p being SubtreeSeq of OSSym(o,X) st t = OSSym(o,X)-tree
  p & OSSym(o,X) ==> roots p & p in Args(o,ParsedTermsOSA(X)) & t = Den(o,
  ParsedTermsOSA(X)).p ) & ( for s2 being Element of S, x being set holds t <>
  root-tree [x,s2] ) & for s1 being Element of S holds t in (the Sorts of
  ParsedTermsOSA(X)).s1 iff the_result_sort_of o <= s1;

theorem 
  for S being OrderSortedSign, X being non-empty ManySortedSet of
  S, nt being Symbol of DTConOSA(X), ts being FinSequence of TS(DTConOSA(X)) st
  nt ==> roots ts holds nt in NonTerminals DTConOSA(X) & nt-tree ts in TS
  DTConOSA(X) & ex o being OperSymbol of S st nt = [o,the carrier of S] & ts in
  Args(o,ParsedTermsOSA(X)) & nt-tree ts = Den(o,ParsedTermsOSA(X)).ts & for s1
being Element of S holds nt-tree ts in (the Sorts of ParsedTermsOSA(X)).s1 iff
  the_result_sort_of o <= s1;



theorem 
  for S being OrderSortedSign, X being non-empty ManySortedSet of
S, o be OperSymbol of S, x being FinSequence holds x in Args(o,ParsedTermsOSA(X
  )) iff x is FinSequence of TS(DTConOSA(X)) & OSSym(o,X) ==> roots x;





definition
  let S be OrderSortedSign, X be non-empty ManySortedSet of S, t be Element of
  TS DTConOSA(X);
  func LeastSort t -> SortSymbol of S means


  t in (the Sorts of
  ParsedTermsOSA(X)).it & for s1 being Element of S st t in (the Sorts of
  ParsedTermsOSA(X)).s1 holds it <= s1;
end;





definition
  let S be non empty non void ManySortedSign;
  let A be non-empty MSAlgebra over S;
  mode Element of A is Element of Union the Sorts of A;
end;

theorem 
  for S being OrderSortedSign, X being non-empty ManySortedSet of
  S, x being set holds x is Element of ParsedTermsOSA(X) iff x is Element of TS
  DTConOSA(X);

theorem 
  for S being OrderSortedSign, X being non-empty ManySortedSet of
  S, s be Element of S, x being set st x in (the Sorts of ParsedTermsOSA(X)).s
  holds x is Element of TS DTConOSA(X);

theorem 
  for S being OrderSortedSign, X being non-empty ManySortedSet of S, s
being Element of S, x being set st x in X.s for t being Element of TS DTConOSA(
  X) st t = root-tree [x,s] holds LeastSort t = s;

theorem 
  for S being OrderSortedSign, X being non-empty ManySortedSet of
S, o be OperSymbol of S, x being Element of Args(o,ParsedTermsOSA(X)) holds for
  t being Element of TS DTConOSA(X) st t = Den(o,ParsedTermsOSA(X)).x holds
  LeastSort t = the_result_sort_of o;



registration
  let S be OrderSortedSign, X be non-empty ManySortedSet of S;
  let o2 be OperSymbol of S;
  cluster Args(o2,ParsedTermsOSA(X)) -> non empty;
end;




definition
  let S be locally_directed OrderSortedSign, X be non-empty ManySortedSet of S
  , x be FinSequence of TS DTConOSA(X);

  func LeastSorts x -> Element of (the carrier of S)* means


  dom it =
dom x & for y being Nat st y in dom x holds ex t being Element of TS DTConOSA(X
  ) st t = x.y & it.y = LeastSort t;
end;



theorem 
  for S be locally_directed OrderSortedSign, X be non-empty
  ManySortedSet of S, o be OperSymbol of S, x be FinSequence of TS DTConOSA(X)
  holds LeastSorts x <= the_arity_of o iff x in Args(o,ParsedTermsOSA(X));

registration
  cluster locally_directed regular for monotone OrderSortedSign;
end;



definition
  let S be locally_directed regular monotone OrderSortedSign, X be non-empty
  ManySortedSet of S, o be OperSymbol of S, x be FinSequence of TS DTConOSA(X);
  assume
 OSSym(LBound(o,LeastSorts x),X) ==> roots x;
  func pi(o,x) -> Element of TS DTConOSA(X) equals


  OSSym(LBound(o,
  LeastSorts x),X)-tree x;
end;

definition
  let S be locally_directed OrderSortedSign, X be non-empty ManySortedSet of S
  , t be Symbol of DTConOSA(X);
  assume
 ex p be FinSequence st t ==> p;
  func @(X,t) -> OperSymbol of S means


  [it,the carrier of S] = t;
end;

definition
  let S be OrderSortedSign, X be non-empty ManySortedSet of S;
  let t be Symbol of DTConOSA(X);
  assume
 t in Terminals DTConOSA(X);
  func pi t -> Element of TS(DTConOSA(X)) equals


  root-tree t;
end;



definition
  let S be locally_directed OrderSortedSign, X be non-empty ManySortedSet of S;
  func LCongruence X -> monotone OSCongruence of ParsedTermsOSA(X) means


   for R be monotone OSCongruence of ParsedTermsOSA(X) holds it c= R;
end;

definition
  let S be locally_directed OrderSortedSign, X be non-empty ManySortedSet of S;
  func FreeOSA(X) -> strict non-empty monotone OSAlgebra of S equals

  QuotOSAlg
  (ParsedTermsOSA(X),LCongruence(X));
end;








definition
  let S be OrderSortedSign, X be non-empty ManySortedSet of S;
  let t be Symbol of DTConOSA(X);
  func @ t -> Subset of [:TS(DTConOSA(X)), the carrier of S:] equals

  {[
  root-tree t,s1] where s1 is Element of S: ex s be Element of S, x be set st x
  in X.s & t = [x,s] & s <= s1};
end;

definition
  let S be OrderSortedSign, X be non-empty ManySortedSet of S;
  let nt be Symbol of DTConOSA(X), x be FinSequence of bool [:TS(DTConOSA(X)),
  the carrier of S:];
  func @ (nt,x) -> Subset of [:TS(DTConOSA(X)), the carrier of S:] equals

  {[
Den(o2,ParsedTermsOSA(X)).x2,s3] where o2 is OperSymbol of S, x2 is Element of
Args(o2,ParsedTermsOSA(X)), s3 is Element of S : ( ex o1 being OperSymbol of S
  st nt = [o1,the carrier of S] & o1 ~= o2 & len the_arity_of o1 = len
the_arity_of o2 & the_result_sort_of o1 <= s3 & the_result_sort_of o2 <= s3) &
ex w3 being Element of (the carrier of S)* st dom w3 = dom x & for y being Nat
  st y in dom x holds [x2.y,w3/.y] in x.y };
end;



definition
  let S be locally_directed OrderSortedSign, X be non-empty ManySortedSet of S;
  func PTClasses X -> Function of TS(DTConOSA(X)), bool [:TS(DTConOSA(X)), the
  carrier of S:] means


  (for t being Symbol of DTConOSA(X) st t in
Terminals DTConOSA(X) holds it.(root-tree t) = @(t) ) & for nt being Symbol of
  DTConOSA(X), ts being FinSequence of TS(DTConOSA(X)) st nt ==> roots ts holds
  it.(nt-tree ts) = @(nt,it * ts);
end;

theorem 
  for S be locally_directed OrderSortedSign, X be non-empty
  ManySortedSet of S, t being Element of TS DTConOSA(X) holds ( for s being
  Element of S holds t in (the Sorts of ParsedTermsOSA(X)).s iff [t,s] in (
PTClasses X).t ) & for s being Element of S, y being Element of TS(DTConOSA X)
  holds [y,s] in (PTClasses X).t implies [t,s] in (PTClasses X).y;



theorem 
  for S be locally_directed OrderSortedSign, X be non-empty
  ManySortedSet of S, t being Element of TS DTConOSA(X), s being Element of S
  holds ( ex y being Element of TS(DTConOSA X) st [y,s] in (PTClasses X).t )
  implies [t,s] in (PTClasses X).t;

theorem 
  for S be locally_directed OrderSortedSign, X be non-empty
ManySortedSet of S, x,y being Element of TS DTConOSA(X), s1,s2 being Element of
  S st s1 <= s2 & x in (the Sorts of ParsedTermsOSA(X)).s1 & y in (the Sorts of
ParsedTermsOSA(X)).s1 holds [y,s1] in (PTClasses X).x iff [y,s2] in (PTClasses
  X).x;

theorem 
  for S be locally_directed OrderSortedSign, X be non-empty
ManySortedSet of S, x,y,z being Element of TS DTConOSA(X), s being Element of S
  holds [y,s] in (PTClasses X).x & [z,s] in (PTClasses X).y implies [x,s] in (
  PTClasses X).z;

definition
  let S be locally_directed OrderSortedSign, X be non-empty ManySortedSet of S;
  func PTCongruence(X) -> MSEquivalence-like OrderSortedRelation of
  ParsedTermsOSA(X) means


  for i being set st i in the carrier of S holds
it.i = {[x,y] where x,y is Element of TS(DTConOSA(X)): [x,i] in (PTClasses X).y
  };
end;

theorem 
  for S be locally_directed OrderSortedSign, X be non-empty
  ManySortedSet of S, x,y,s being set st [x,s] in (PTClasses X).y holds x in TS
  DTConOSA(X) & y in TS DTConOSA(X) & s in the carrier of S;

theorem 
  for S be locally_directed OrderSortedSign, X be non-empty
ManySortedSet of S, C be Component of S, x,y being set holds [x,y] in CompClass
  (PTCongruence X,C) iff ex s1 being Element of S st s1 in C & [x,s1] in (
  PTClasses X).y;

theorem 
  for S be locally_directed OrderSortedSign, X be non-empty
  ManySortedSet of S, s be Element of S, x be Element of (the Sorts of
  ParsedTermsOSA(X)).s holds OSClass(PTCongruence X,x) = proj1((PTClasses X).x)
;



theorem 
  for S being locally_directed OrderSortedSign, X being non-empty
  ManySortedSet of S, R being ManySortedRelation of ParsedTermsOSA(X) holds R =
  PTCongruence(X) iff ( for s1,s2 being Element of S, x being set st x in X.s1
  holds ( s1 <= s2 implies [root-tree [x,s1],root-tree[x,s1]] in R.s2 ) & for y
being set holds ( [root-tree [x,s1],y] in R.s2 or [y,root-tree [x,s1]] in R.s2)
implies s1 <= s2 & y = root-tree [x,s1] ) & for o1,o2 being OperSymbol of S, x1
  being Element of Args(o1,ParsedTermsOSA(X)), x2 being Element of Args(o2,
ParsedTermsOSA(X)), s3 being Element of S holds [Den(o1,ParsedTermsOSA(X)).x1,
Den(o2,ParsedTermsOSA(X)).x2] in R.s3 iff o1 ~= o2 & len the_arity_of o1 = len
  the_arity_of o2 & the_result_sort_of o1 <= s3 & the_result_sort_of o2 <= s3 &
ex w3 being Element of (the carrier of S)* st dom w3 = dom x1 & for y being Nat
  st y in dom w3 holds [x1.y,x2.y] in R.(w3/.y);



theorem 
  for S be locally_directed OrderSortedSign, X be non-empty
  ManySortedSet of S holds PTCongruence(X) is monotone;



registration
  let S be locally_directed OrderSortedSign, X be non-empty ManySortedSet of S;
  cluster PTCongruence(X) -> monotone;
end;

definition
  let S be locally_directed OrderSortedSign, X be non-empty ManySortedSet of S
  , s be Element of S;
  func PTVars(s,X) -> Subset of (the Sorts of ParsedTermsOSA(X)).s means


   for
 x be set holds x in it iff ex a be set st a in X.s & x = root-tree [
  a,s];
end;

registration
  let S be locally_directed OrderSortedSign, X be non-empty ManySortedSet of S
  , s be Element of S;
  cluster PTVars(s,X) -> non empty;
end;

theorem 
  for S be locally_directed OrderSortedSign, X be non-empty
ManySortedSet of S, s be Element of S holds PTVars(s,X) = { root-tree t where t
  is Symbol of DTConOSA(X): t in Terminals DTConOSA(X) & t`2 = s};

definition
  let S be locally_directed OrderSortedSign, X be non-empty ManySortedSet of S;
  func PTVars(X) -> MSSubset of ParsedTermsOSA(X) means


  for s be Element of S holds it.s = PTVars(s,X);
end;

theorem 
  for S be locally_directed OrderSortedSign, X be non-empty
  ManySortedSet of S holds PTVars(X) is non-empty;

definition
  let S be locally_directed OrderSortedSign, X be non-empty ManySortedSet of S
  , s be Element of S;
  func OSFreeGen(s,X) -> Subset of (the Sorts of FreeOSA(X)).s means


  for x be set holds x in it iff ex a be set st a in X.s & x = (OSNat_Hom(
  ParsedTermsOSA(X),LCongruence(X)).s).(root-tree [a,s]);
end;

registration
  let S be locally_directed OrderSortedSign, X be non-empty ManySortedSet of S
  , s be Element of S;
  cluster OSFreeGen(s,X) -> non empty;
end;

theorem 
  for S be locally_directed OrderSortedSign, X be non-empty
  ManySortedSet of S, s be Element of S holds OSFreeGen(s,X) = { (OSNat_Hom(
ParsedTermsOSA(X),LCongruence(X)).s).root-tree t where t is Symbol of DTConOSA(
  X): t in Terminals DTConOSA(X) & t`2 = s};

definition
  let S be locally_directed OrderSortedSign, X be non-empty ManySortedSet of S;
  func OSFreeGen(X) -> OSGeneratorSet of FreeOSA(X) means


  for s be Element of S holds it.s = OSFreeGen(s,X);
end;

theorem 
  for S be locally_directed OrderSortedSign, X be non-empty
  ManySortedSet of S holds OSFreeGen(X) is non-empty;

registration
  let S be locally_directed OrderSortedSign, X be non-empty ManySortedSet of S;
  cluster OSFreeGen(X) -> non-empty;
end;

definition
  let S be locally_directed OrderSortedSign, X be non-empty ManySortedSet of S
  , R be OSCongruence of ParsedTermsOSA(X), t be Element of TS DTConOSA(X);
  func OSClass(R,t) -> Element of OSClass(R,LeastSort t) means


  for s
being Element of S, x being Element of (the Sorts of ParsedTermsOSA(X)).s st t
  = x holds it = OSClass(R,x);
end;

theorem 
  for S be locally_directed OrderSortedSign, X be non-empty
ManySortedSet of S, R be OSCongruence of ParsedTermsOSA(X), t be Element of TS
  DTConOSA(X) holds t in OSClass(R,t);

theorem 
  for S be locally_directed OrderSortedSign, X be non-empty
ManySortedSet of S, s be Element of S, t being Element of TS DTConOSA(X), x,x1
being set st x in X.s & t = root-tree [x,s] holds x1 in OSClass(PTCongruence(X)
  ,t) iff x1 = t;

theorem 
  for S be locally_directed OrderSortedSign, X be non-empty
ManySortedSet of S, R be OSCongruence of ParsedTermsOSA(X), t1,t2 be Element of
  TS DTConOSA(X) holds t2 in OSClass(R,t1) iff OSClass(R,t1) = OSClass(R,t2);

theorem 
  for S be locally_directed OrderSortedSign, X be non-empty
ManySortedSet of S, R1,R2 be OSCongruence of ParsedTermsOSA(X), t be Element of
  TS DTConOSA(X) holds R1 c= R2 implies OSClass(R1,t) c= OSClass(R2,t);

theorem 
  for S be locally_directed OrderSortedSign, X be non-empty
ManySortedSet of S, s be Element of S, t being Element of TS DTConOSA(X), x,x1
being set st x in X.s & t = root-tree [x,s] holds x1 in OSClass(LCongruence(X),
  t) iff x1 = t;

definition
  let S be locally_directed OrderSortedSign, X be non-empty ManySortedSet of S
, A be non-empty ManySortedSet of the carrier of S, F be ManySortedFunction of
  PTVars(X), A, t be Symbol of DTConOSA(X);
  assume
 t in Terminals (DTConOSA(X));
  func pi(F,A,t) -> Element of Union A means


  for f be Function st f = F.(t`2) holds it = f.(root-tree t);
end;

theorem 
  for S be locally_directed OrderSortedSign, X be non-empty
  ManySortedSet of S, U1 be monotone non-empty OSAlgebra of S, f be
  ManySortedFunction of PTVars(X),the Sorts of U1 ex h be ManySortedFunction of
  ParsedTermsOSA(X),U1 st h is_homomorphism ParsedTermsOSA(X),U1 & h is
  order-sorted & h || PTVars(X) = f;



definition
  let S be locally_directed OrderSortedSign, X be non-empty ManySortedSet of S
  , s be Element of S;
  func NHReverse(s,X) -> Function of OSFreeGen(s,X),PTVars(s,X) means

  for t be
  Symbol of DTConOSA(X) st (OSNat_Hom(ParsedTermsOSA(X),LCongruence(X)).s).(
  root-tree t) in OSFreeGen(s,X) holds it.((OSNat_Hom(ParsedTermsOSA(X),
  LCongruence(X)).s).(root-tree t)) = root-tree t;
end;

definition
  let S be locally_directed OrderSortedSign, X be non-empty ManySortedSet of S;
  func NHReverse(X) -> ManySortedFunction of OSFreeGen(X),PTVars(X) means

  for s be Element of S holds it.s = NHReverse(s,X);
end;

theorem 
  for S be locally_directed OrderSortedSign, X be non-empty
  ManySortedSet of S holds OSFreeGen(X) is osfree;

theorem 
  for S be locally_directed OrderSortedSign, X be non-empty
  ManySortedSet of S holds FreeOSA(X) is osfree;

registration
  let S be locally_directed OrderSortedSign;
  cluster osfree strict for non-empty monotone OSAlgebra of S;
end;

begin




definition
  let S be locally_directed regular monotone OrderSortedSign, X be non-empty
  ManySortedSet of S;
  func PTMin X -> Function of TS(DTConOSA(X)), TS(DTConOSA(X)) means


  ( for t being Symbol of DTConOSA(X) st t in Terminals DTConOSA(X) holds it.(
  root-tree t) = pi t ) & for nt being Symbol of DTConOSA(X), ts being
FinSequence of TS(DTConOSA(X)) st nt ==> roots ts holds it.(nt-tree ts) = pi(@(
  X,nt),it * ts);
end;

theorem 
  for S be locally_directed regular monotone OrderSortedSign, X
be non-empty ManySortedSet of S, t being Element of TS DTConOSA(X) holds (PTMin
X).t in OSClass(PTCongruence(X),t) & LeastSort ((PTMin X).t) <= LeastSort t & (
for s being Element of S, x being set st x in X.s & t = root-tree [x,s] holds (
  PTMin X).t = t ) & (for o being OperSymbol of S, ts being FinSequence of TS(
  DTConOSA(X)) st OSSym(o,X) ==> roots ts & t = OSSym(o,X)-tree ts holds
LeastSorts ((PTMin X)*ts) <= the_arity_of o & OSSym(o,X) ==> roots ((PTMin X)*
ts) & OSSym(LBound(o,LeastSorts ((PTMin X)*ts)),X) ==> roots ((PTMin X)*ts) & (
PTMin X).t = OSSym(LBound(o,LeastSorts ((PTMin X)*ts)),X)-tree ((PTMin X)*ts));

theorem 
  for S be locally_directed regular monotone OrderSortedSign, X
be non-empty ManySortedSet of S, t,t1 being Element of TS DTConOSA(X) st t1 in
  OSClass(PTCongruence(X),t) holds (PTMin X).t1 = (PTMin X).t;

theorem 
  for S be locally_directed regular monotone OrderSortedSign, X
be non-empty ManySortedSet of S, t1,t2 be Element of TS DTConOSA(X) holds t2 in
  OSClass(PTCongruence(X),t1) iff (PTMin X).t2 = (PTMin X).t1;

theorem 
  for S be locally_directed regular monotone OrderSortedSign, X
be non-empty ManySortedSet of S, t1 be Element of TS DTConOSA(X) holds (PTMin X
  ).((PTMin X).t1) = (PTMin X).t1;

theorem 
  for S be locally_directed regular monotone OrderSortedSign,
  X be non-empty ManySortedSet of S,
  R be monotone MSEquivalence-like (OrderSortedRelation of ParsedTermsOSA(X)),
  t be Element of TS DTConOSA(X) holds
  [t,(PTMin X).t] in R.(LeastSort t);

theorem 
  for S be locally_directed regular monotone OrderSortedSign, X
  be non-empty ManySortedSet of S, R be monotone MSEquivalence-like
  OrderSortedRelation of ParsedTermsOSA(X) holds PTCongruence(X) c= R;



theorem 
  for S be locally_directed regular monotone OrderSortedSign, X be
  non-empty ManySortedSet of S holds LCongruence(X) = PTCongruence(X);



definition
  let S be locally_directed regular monotone OrderSortedSign, X be non-empty
  ManySortedSet of S;
  mode MinTerm of S,X -> Element of TS DTConOSA(X) means


    (PTMin X).it = it;
end;

definition
  let S be locally_directed regular monotone OrderSortedSign, X be non-empty
  ManySortedSet of S;
  func MinTerms X -> Subset of TS DTConOSA(X) equals

  rng (PTMin X);
end;

theorem 
  for S be locally_directed regular monotone OrderSortedSign, X be
  non-empty ManySortedSet of S, x being set holds x is MinTerm of S,X iff x in
  MinTerms X;














begin

theorem 
  for B being set st B is cap-closed for X being set, S being
  finite Subset-Family of X st X in B & S c= B holds Intersect S in B;

registration
  cluster reflexive antisymmetric transitive non empty for Relation;
end;

theorem 
  for R being antisymmetric transitive non empty Relation, X being
finite Subset of field R st X <> {} ex x being Element of X st x is_maximal_wrt
  X, R;

scheme 

  SubsetSEq { X() -> set, P[set] }: for X1,X2 being Subset of X() st (for y
  being set holds y in X1 iff P[y]) & (for y being set holds y in X2 iff P[y])
  holds X1 = X2;

definition
  let X be set, R be Relation;
  func R Maximal_in X -> Subset of X means


  for x being set holds x in it iff x is_maximal_wrt X, R;
end;

definition
  let x, X be set;
  pred x is_/\-irreducible_in X means


  x in X & for z, y being set st z
  in X & y in X & x = z /\ y holds x = z or x = y;
end;

notation
  let x, X be set;
  antonym x is_/\-reducible_in X for x is_/\-irreducible_in X;
end;

definition
  let X be non empty set;
  func /\-IRR X -> Subset of X means


  for x being set holds x in it iff x is_/\-irreducible_in X;
end;

scheme 

  FinIntersect {X() -> non empty finite set, P[set]} : for x being set st x in
  X() holds P[x]
provided
 for x being set st x is_/\-irreducible_in X() holds P[x] and
 for x, y being set st x in X() & y in X() & P[x] & P[y] holds P[x /\ y];

theorem 
  for X being non empty finite set, x being Element of X ex A being
  non empty Subset of X st x = meet A & for s being set st s in A holds s
  is_/\-irreducible_in X;

definition
  let X be set, B be Subset-Family of X;
  attr B is (B1) means


  X in B;
end;

notation
  let B be set;
  synonym B is (B2) for B is cap-closed;
end;

registration
  let X be set;
  cluster (B1) (B2) for Subset-Family of X;
end;

theorem 
  for X being set, B being non empty Subset-Family of X st B is
cap-closed for x being Element of B st x is_/\-irreducible_in B & x <> X for S
  being finite Subset-Family of X st S c= B & x = Intersect S holds x in S;

registration
  let X, D be non empty set, n be Element of NAT;
  cluster -> FinSequence-yielding for Function of X, n-tuples_on D;
end;

registration
  let f be FinSequence-yielding Function, x be set;
  cluster f.x -> FinSequence-like;
end;

definition
  let n be Element of NAT, p, q be Tuple of n, BOOLEAN;
  func p '&' q -> Tuple of n, BOOLEAN means


  for i being set st i in Seg n holds it.i = (p/.i) '&' (q/.i);
  commutativity;
end;

theorem 
  for n being Element of NAT, p being Element of n-tuples_on BOOLEAN holds (n
  -BinarySequence 0) '&' p = n-BinarySequence 0;

theorem 
  for n being Element of NAT, p being Tuple of n, BOOLEAN holds 'not' (n
  -BinarySequence 0) '&' p = p;

theorem 
  for n, i being Element of NAT st i < n holds (n-BinarySequence 2
to_power i).(i+1) = 1 & for j being Element of NAT st j in Seg n & j<>i+1 holds
  (n-BinarySequence 2 to_power i).j = 0;

begin 

definition
  struct DB-Rel (# Attributes -> finite non empty set, Domains -> non-empty
ManySortedSet of the Attributes, Relationship -> Subset of product the Domains
  #);
end;

begin 

definition
  let X be set;
  mode Subset-Relation of X is Relation of bool X;
  mode Dependency-set of X is Relation of bool X;
end;

registration
  let X be set;
  cluster non empty finite for Dependency-set of X;
end;

definition
  let X be set;
  func Dependencies(X) -> Dependency-set of X equals

  [: bool X, bool X :];
end;

definition
  let X be set;
  mode Dependency of X is Element of Dependencies X;
end;

registration
  let X be set;
  cluster Dependencies X -> non empty;
end;

definition
  let X be set, F be non empty Dependency-set of X;
  redefine mode Element of F -> Dependency of X;
end;

theorem 
  for X, x being set holds x in Dependencies X iff ex a, b being
  Subset of X st x = [a,b];

theorem 
  for X, x being set, F being Dependency-set of X holds x in F
  implies ex a, b being Subset of X st x = [a,b];

definition
  let R be DB-Rel, A, B be Subset of the Attributes of R;
  pred A >|> B, R means


  for f, g being Element of the Relationship of R st f|A = g|A holds f|B = g|B;
end;

notation
  let R be DB-Rel, A, B be Subset of the Attributes of R;
  synonym A, B holds_in R for A >|> B, R;
end;

definition
  let R be DB-Rel;
  func Dependency-str R -> Dependency-set of the Attributes of R equals

  { [A,
  B] where A, B is Subset of the Attributes of R: A >|> B, R };
end;

theorem 
  for R being DB-Rel, A, B being Subset of the Attributes of R
  holds [A, B] in Dependency-str R iff A >|> B, R;

begin 

definition
  let X be set, P, Q be Dependency of X;
  pred P >= Q means


  P`1 c= Q`1 & Q`2 c= P`2;
  reflexivity;
end;

notation
  let X be set, P, Q be Dependency of X;
  synonym Q <= P for P >= Q;
  synonym P is_at_least_as_informative_as Q for P >= Q;
end;

theorem 
  for X being set, P, Q being Dependency of X st P <= Q & Q <= P holds P = Q;

theorem 
  for X being set, P, Q, S being Dependency of X st P <= Q & Q <=
  S holds P <= S;

definition
  let X be set, A, B be Subset of X;
  redefine func [A, B] -> Dependency of X;
end;

theorem 
  for X being set, A, B, A9, B9 being Subset of X holds [A,B] >= [
  A9,B9] iff A c= A9 & B9 c= B;

definition
  let X be set;
  func Dependencies-Order X -> Relation of Dependencies X equals

  { [P, Q]
  where P, Q is Dependency of X : P <= Q };
end;

theorem 
  for X, x being set holds x in Dependencies-Order X iff ex P, Q being
  Dependency of X st x = [P, Q] & P <= Q;

theorem 
  for X being set holds dom Dependencies-Order X = [: bool X, bool X :];

theorem 
  for X being set holds rng Dependencies-Order X = [: bool X, bool X :];

theorem 
  for X being set holds field Dependencies-Order X = [: bool X, bool X :];

registration
  let X be set;
  cluster Dependencies-Order X -> non empty;
  cluster Dependencies-Order X -> total reflexive antisymmetric transitive;
end;

notation
  let X be set, F be Dependency-set of X;
  synonym F is (F2) for F is transitive;
  synonym F is (DC1) for F is transitive;
end;

definition
  let X be set, F be Dependency-set of X;
  attr F is (F1) means


  for A being Subset of X holds [A, A] in F;
end;

notation
  let X be set, F be Dependency-set of X;
  synonym F is (DC2) for F is (F1);
end;

theorem 
  for X being set, F being Dependency-set of X holds F is (F2) iff
  for A, B, C being Subset of X st [A, B] in F & [B, C] in F holds [A, C] in F;

definition
  let X be set, F be Dependency-set of X;
  attr F is (F3) means


  for A, B, A9, B9 being Subset of X st [A, B]
  in F & [A, B] >= [A9, B9] holds [A9, B9] in F;
  attr F is (F4) means


  for A, B, A9, B9 being Subset of X st [A, B]
  in F & [A9, B9] in F holds [A\/A9, B\/B9] in F;
end;

theorem 
  for X being set holds Dependencies X is (F1) (F2) (F3) (F4);

registration
  let X be set;
  cluster (F1) (F2) (F3) (F4) non empty for Dependency-set of X;
end;

definition
  let X be set, F be Dependency-set of X;
  attr F is full_family means


  F is (F1) (F2) (F3) (F4);
end;

registration
  let X be set;
  cluster full_family for Dependency-set of X;
end;

definition
  let X be set;
  mode Full-family of X is full_family Dependency-set of X;
end;

theorem 
  for X being finite set, F being Dependency-set of X holds F is finite;

registration
  let X be finite set;
  cluster finite for Full-family of X;
  cluster -> finite for Dependency-set of X;
end;

registration
  let X be set;
  cluster full_family -> (F1) (F2) (F3) (F4) for Dependency-set of X;
  cluster (F1) (F2) (F3) (F4) -> full_family for Dependency-set of X;
end;

definition
  let X be set, F be Dependency-set of X;
  attr F is (DC3) means


  for A, B being Subset of X st B c= A holds [A, B] in F;
end;

registration
  let X be set;
  cluster (F1) (F3) -> (DC3) for Dependency-set of X;
  cluster (DC3) (F2) -> (F1) (F3) for Dependency-set of X;
end;

registration
  let X be set;
  cluster (DC3) (F2) (F4) non empty for Dependency-set of X;
end;

theorem 
  for X being set, F being Dependency-set of X st F is (DC3) (F2) holds
  F is (F1) (F3);

theorem 
  for X being set, F being Dependency-set of X st F is (F1) (F3) holds F
  is (DC3);

registration
  let X be set;
  cluster (F1) -> non empty for Dependency-set of X;
end;

theorem 
  for R being DB-Rel holds Dependency-str R is full_family;

theorem 
  for X being set, K being Subset of X holds { [A, B] where A, B is
  Subset of X : K c= A or B c= A } is Full-family of X;

begin 

definition
  let X be set, F be Dependency-set of X;
  func Maximal_wrt F -> Dependency-set of X equals

  Dependencies-Order X
  Maximal_in F;
end;

theorem 
  for X being set, F being Dependency-set of X holds Maximal_wrt F c= F;

definition
  let X be set, F be Dependency-set of X, x, y be set;
  pred x ^|^ y, F means


  [x, y] in Maximal_wrt F;
end;

theorem 
  for X being finite set, P being Dependency of X, F being
  Dependency-set of X st P in F ex A, B being Subset of X st [A, B] in
  Maximal_wrt F & [A, B] >= P;

theorem 
  for X being set, F being Dependency-set of X, A, B being Subset
of X holds A ^|^ B, F iff [A, B] in F & not ex A9, B9 being Subset of X st [A9,
  B9] in F & (A <> A9 or B <> B9) & [A, B] <= [A9, B9];

definition
  let X be set, M be Dependency-set of X;
  attr M is (M1) means


  for A being Subset of X ex A9, B9 being Subset
  of X st [A9, B9] >= [A, A] & [A9, B9] in M;
  attr M is (M2) means


  for A, B, A9, B9 being Subset of X st [A, B]
  in M & [A9, B9] in M & [A, B] >= [A9, B9] holds A = A9 & B = B9;
  attr M is (M3) means


  for A, B, A9, B9 being Subset of X st [A, B]
  in M & [A9, B9] in M & A9 c= B holds B9 c= B;
end;

theorem 
  for X being finite non empty set, F being Full-family of X holds
  Maximal_wrt F is (M1) (M2) (M3);

theorem 
  for X being finite set, M, F being Dependency-set of X st M is
(M1) (M2) (M3) & F = {[A, B] where A, B is Subset of X : ex A9, B9 being Subset
  of X st [A9, B9] >= [A, B] & [A9, B9] in M} holds M = Maximal_wrt F & F is
  full_family & for G being Full-family of X st M = Maximal_wrt G holds G = F;

registration
  let X be non empty finite set, F be Full-family of X;
  cluster Maximal_wrt F -> non empty;
end;

theorem 
  for X being finite set, F being Dependency-set of X, K being
  Subset of X st F = { [A, B] where A, B is Subset of X : K c= A or B c= A }
  holds {[K, X]}\/{[A, A] where A is Subset of X : not K c= A} = Maximal_wrt F;

begin 

definition
  let X be set, F be Dependency-set of X;
  func saturated-subsets F -> Subset-Family of X equals

  { B where B is Subset
  of X: ex A being Subset of X st A ^|^ B, F };
end;

notation
  let X be set, F be Dependency-set of X;
  synonym closed_attribute_subset F for saturated-subsets F;
end;

registration
  let X be set, F be finite Dependency-set of X;
  cluster saturated-subsets F -> finite;
end;

theorem 
  for X, x being set, F being Dependency-set of X holds x in
  saturated-subsets F iff ex B, A being Subset of X st x = B & A ^|^ B, F;

theorem 
  for X being finite non empty set, F being Full-family of X holds
  saturated-subsets F is (B1) (B2);

definition
  let X be set, B be set;
  func X deps_encl_by B -> Dependency-set of X equals

  { [a, b] where a, b is
  Subset of X : for c being set st c in B & a c= c holds b c= c};
end;

theorem 
  for X being set, B being Subset-Family of X, F being
  Dependency-set of X holds X deps_encl_by B is full_family;

theorem 
  for X being finite non empty set, B being Subset-Family of X
  holds B c= saturated-subsets (X deps_encl_by B);

theorem 
  for X being finite non empty set, B being Subset-Family of X st
  B is (B1) (B2) holds B = saturated-subsets (X deps_encl_by B) & for G being
  Full-family of X st B = saturated-subsets G holds G = X deps_encl_by B;

definition
  let X be set, F be Dependency-set of X;
  func enclosure_of F -> Subset-Family of X equals

  { b where b is Subset of X
  : for A, B being Subset of X st [A, B] in F & A c= b holds B c= b };
end;

theorem 
  for X being finite non empty set, F being Dependency-set of X
  holds enclosure_of F is (B1) (B2);

theorem 



  for X being finite non empty set, F being Dependency-set of X
holds F c= X deps_encl_by enclosure_of F & for G being Dependency-set of X st F
  c= G & G is full_family holds X deps_encl_by enclosure_of F c= G;

definition
  let X be finite non empty set, F be Dependency-set of X;
  func Dependency-closure F -> Full-family of X means


  F c= it & for G
  being Dependency-set of X st F c= G & G is full_family holds it c= G;
end;

theorem 
  for X being finite non empty set, F being Dependency-set of X
  holds Dependency-closure F = X deps_encl_by enclosure_of F;

theorem 
  for X being set, K being Subset of X, B being Subset-Family of X
  st B = {X}\/{A where A is Subset of X : not K c= A} holds B is (B1) (B2);

theorem 
  for X being finite non empty set, F being Dependency-set of X, K being
  Subset of X st F = { [A, B] where A, B is Subset of X : K c= A or B c= A }
  holds {X}\/{B where B is Subset of X : not K c= B} = saturated-subsets F;

theorem 
  for X being finite set, F being Dependency-set of X, K being Subset of
X st F = { [A, B] where A, B is Subset of X : K c= A or B c= A } holds {X}\/{B
  where B is Subset of X : not K c= B} = saturated-subsets F;

definition
  let X, G be set, B be Subset-Family of X;
  pred G is_generator-set_of B means


  G c= B & B = { Intersect S where S is Subset-Family of X: S c= G };
end;

theorem 
  for X be finite non empty set, G being Subset-Family of X holds G
  is_generator-set_of saturated-subsets (X deps_encl_by G);

theorem 
  for X being finite non empty set, F being Full-family of X ex G
  being Subset-Family of X st G is_generator-set_of saturated-subsets F & F = X
  deps_encl_by G;




theorem 
  for X being set, B being non empty finite Subset-Family of X st B is
  (B1) (B2) holds /\-IRR B is_generator-set_of B;

theorem 
  for X, G being set, B being non empty finite Subset-Family of X st B
  is (B1) (B2) & G is_generator-set_of B holds /\-IRR B c= G\/{X};

begin 

definition let n be Element of NAT, D be non empty set;
 mode Tuple of n, D is Element of n-tuples_on D;
end;

theorem 
  for X being non empty finite set, F being Full-family of X ex R being
  DB-Rel st the Attributes of R = X & (for a being Element of X holds (the
  Domains of R).a = INT) & F = Dependency-str R;

begin

definition
  let X be set, F be Dependency-set of X;
  func candidate-keys F -> Subset-Family of X equals

  { A where A is Subset of
X: [A, X] in Maximal_wrt F };
end;

theorem 
  for X being finite set, F being Dependency-set of X, K being Subset of
  X st F = { [A, B] where A, B is Subset of X : K c= A or B c= A } holds
  candidate-keys F = {K};

notation
  let X be set;
  antonym X is (C1) for X is empty;
end;

definition
  let X be set;
  attr X is without_proper_subsets means


  for x, y being set st x in X & y in X & x c= y holds x = y;
end;

notation
  let X be set;
  synonym X is (C2) for X is without_proper_subsets;
end;

theorem 
  for R being DB-Rel holds candidate-keys Dependency-str R is (C1) (C2);

theorem 
  for X being finite set, C being Subset-Family of X st C is (C1) (C2)
  ex F being Full-family of X st C = candidate-keys F;

theorem 
  for X being finite set, C being Subset-Family of X, B being set st C
is (C1) (C2) & B = {b where b is Subset of X : for K being Subset of X st K in
  C holds not K c= b} holds C = candidate-keys (X deps_encl_by B);

theorem 
  for X being non empty finite set, C being Subset-Family of X st C is
  (C1) (C2) ex R being DB-Rel st the Attributes of R = X & C = candidate-keys
  Dependency-str R;

begin 

definition
  let X be set, F be Dependency-set of X;
  attr F is (DC4) means


  for A, B, C being Subset of X st [A, B] in F &
  [A, C] in F holds [A, B\/C] in F;
  attr F is (DC5) means


  for A, B, C, D being Subset of X st [A, B] in
  F & [B\/C, D] in F holds [A\/C, D] in F;
  attr F is (DC6) means


  for A, B, C being Subset of X st [A, B] in F holds [A\/C, B] in F;
end;

theorem 
  for X being set, F being Dependency-set of X holds F is (F1) (F2) (F3)
  (F4) iff F is (F2) (DC3) (F4);

theorem 
  for X being set, F being Dependency-set of X holds F is (F1) (F2) (F3)
  (F4) iff F is (DC1) (DC3) (DC4);

theorem 
  for X being set, F being Dependency-set of X holds F is (F1) (F2) (F3)
  (F4) iff F is (DC2) (DC5) (DC6);

definition
  let X be set, F be Dependency-set of X;
  func charact_set F equals

  { A where A is Subset of X : ex a, b being Subset
  of X st [a, b] in F & a c= A & not b c= A };
end;

theorem 
  for X, A being set, F being Dependency-set of X st A in
charact_set F holds A is Subset of X & ex a, b being Subset of X st [a, b] in F
  & a c= A & not b c= A;

theorem 
  for X being set, A being Subset of X, F being Dependency-set of X st
  ex a, b being Subset of X st [a, b] in F & a c= A & not b c= A holds A in
  charact_set F;

theorem 
  for X being finite non empty set, F being Dependency-set of X
holds (for A, B being Subset of X holds [A, B] in Dependency-closure F iff for
  a being Subset of X st A c= a & not B c= a holds a in charact_set F) &
  saturated-subsets Dependency-closure F = (bool X) \ charact_set F;

theorem 
  for X being finite non empty set, F, G being Dependency-set of X st
charact_set F = charact_set G holds Dependency-closure F = Dependency-closure G
;

theorem 
  for X being non empty finite set, F being Dependency-set of X
  holds charact_set F = charact_set (Dependency-closure F);

definition
  let A be set, K be set, F be Dependency-set of A;
  pred K is_p_i_w_ncv_of F means


  ( for a being Subset of A st K c= a
  & a <> A holds a in charact_set F) & for k being set st k c< K ex a being
  Subset of A st k c= a & a <> A & not a in charact_set F;
end;

theorem 
  for X being finite non empty set, F being Dependency-set of X, K being
  Subset of X holds K in candidate-keys Dependency-closure F iff K
  is_p_i_w_ncv_of F;














begin



definition
  let K be 1-sorted;
  let V,W be VectSpStr over K;
  mode Form of V,W is Function of [:the carrier of V,the carrier of W:], the
    carrier of K;
end;

definition
  let K be non empty ZeroStr;
  let V,W be VectSpStr over K;

  func NulForm(V,W) -> Form of V,W equals

  [:the carrier of V,the carrier of W
  :] --> 0.K;
end;

definition
  let K be non empty addLoopStr;
  let V,W be non empty VectSpStr over K;
  let f,g be Form of V,W;
  func f+g -> Form of V,W means


  for v be Vector of V, w be Vector of W holds it.(v,w) = f.(v,w)+g.(v,w);
end;

definition
  let K be non empty multMagma;
  let V,W be non empty VectSpStr over K;
  let f be Form of V,W;
  let a be Element of K;
  func a*f -> Form of V,W means


  for v be Vector of V, w be Vector of W holds it.(v,w) = a*f.(v,w);
end;

definition
  let K be non empty addLoopStr;
  let V,W be non empty VectSpStr over K;
  let f be Form of V,W;
  func -f -> Form of V,W means


  for v be Vector of V, w be Vector of W holds it.(v,w) = -f.(v,w);
end;

definition
  let K be add-associative right_zeroed right_complementable left-distributive
  left_unital non empty doubleLoopStr;
  let V,W be non empty VectSpStr over K;
  let f be Form of V,W;
  redefine func -f equals

  (- 1.K) *f;
end;

definition
  let K be non empty addLoopStr;
  let V,W be non empty VectSpStr over K;
  let f,g be Form of V,W;
  func f-g -> Form of V,W equals

  f + -g;
end;

definition
  let K be non empty addLoopStr;
  let V,W be non empty VectSpStr over K;
  let f,g be Form of V,W;
  redefine func f - g means


  for v be Vector of V, w be Vector of W holds it.(v,w) = f.(v,w) - g.(v,w);
end;

definition
  let K be Abelian non empty addLoopStr;
  let V,W be non empty VectSpStr over K;
  let f,g be Form of V,W;
  redefine func f+g;
  commutativity;
end;

theorem 
  for K be right_zeroed non empty addLoopStr for V,W be non empty
  VectSpStr over K for f be Form of V,W holds f + NulForm(V,W) = f;

theorem 
  for K be add-associative non empty addLoopStr for V,W be non empty
  VectSpStr over K for f,g,h be Form of V,W holds f+g+h = f+(g+h);

theorem 
  for K be add-associative right_zeroed right_complementable non empty
addLoopStr  for V,W be non empty VectSpStr over K for f be Form of V,W holds f
  - f = NulForm(V,W);

theorem 
  for K be right-distributive non empty doubleLoopStr for V,W be non
empty VectSpStr over K, a be Element of K for f,g be Form of V,W holds a*(f+g)
  = a*f+a*g;

theorem 
  for K be left-distributive non empty doubleLoopStr for V,W be non
empty VectSpStr over K for a,b be Element of K for f be Form of V,W holds (a+b)
  *f = a*f+b*f;

theorem 
  for K be associative non empty doubleLoopStr for V,W be non empty
VectSpStr over K for a,b be Element of K for f be Form of V,W holds (a*b)*f = a
  *(b*f);

theorem 
  for K be left_unital non empty doubleLoopStr for V,W be non empty
  VectSpStr over K for f be Form of V,W holds (1.K)*f = f;

begin



definition
  let K be non empty 1-sorted;
  let V,W be non empty VectSpStr over K;
  let f be Form of V,W, v be Vector of V;
  func FunctionalFAF(f,v) -> Functional of W equals

  (curry f).v;
end;

definition
  let K be non empty 1-sorted;
  let V,W be non empty VectSpStr over K;
  let f be Form of V,W, w be Vector of W;
  func FunctionalSAF(f,w) -> Functional of V equals

  (curry' f).w;
end;

theorem 
  for K be non empty 1-sorted for V,W be non empty VectSpStr over K
  for f be Form of V,W, v be Vector of V holds dom (FunctionalFAF(f,v)) = the
  carrier of W & rng (FunctionalFAF(f,v)) c= the carrier of K & for w be Vector
  of W holds (FunctionalFAF(f,v)).w = f.(v,w);

theorem 
  for K be non empty 1-sorted for V,W be non empty VectSpStr over
  K for f be Form of V,W, w be Vector of W holds dom (FunctionalSAF(f,w)) = the
  carrier of V & rng (FunctionalSAF(f,w)) c= the carrier of K & for v be Vector
  of V holds (FunctionalSAF(f,w)).v = f.(v,w);

theorem 
  for K be non empty ZeroStr, V,W be non empty VectSpStr over K, v
  be Vector of V holds FunctionalFAF(NulForm(V,W),v) = 0Functional(W);

theorem 
  for K be non empty ZeroStr, V,W be non empty VectSpStr over K, w
  be Vector of W holds FunctionalSAF(NulForm(V,W),w) = 0Functional(V);

theorem 
  for K be non empty addLoopStr for V,W be non empty VectSpStr
  over K for f,g be Form of V,W, w be Vector of W holds FunctionalSAF(f+g,w) =
  FunctionalSAF(f,w) + FunctionalSAF(g,w);

theorem 
  for K be non empty addLoopStr for V,W be non empty VectSpStr
  over K for f,g be Form of V,W, v be Vector of V holds FunctionalFAF(f+g,v) =
  FunctionalFAF(f,v) + FunctionalFAF(g,v);

theorem 
  for K be non empty doubleLoopStr for V,W be non empty VectSpStr
  over K for f be Form of V,W, a be Element of K, w be Vector of W holds
  FunctionalSAF(a*f,w) = a*FunctionalSAF(f,w);

theorem 
  for K be non empty doubleLoopStr for V,W be non empty VectSpStr
  over K for f be Form of V,W, a be Element of K, v be Vector of V holds
  FunctionalFAF(a*f,v) = a*FunctionalFAF(f,v);

theorem 
  for K be non empty addLoopStr for V,W be non empty VectSpStr
  over K for f be Form of V,W, w be Vector of W holds FunctionalSAF(-f,w) = -
  FunctionalSAF(f,w);

theorem 
  for K be non empty addLoopStr for V,W be non empty VectSpStr
  over K for f be Form of V,W, v be Vector of V holds FunctionalFAF(-f,v) = -
  FunctionalFAF(f,v);

theorem 
  for K be non empty addLoopStr for V,W be non empty VectSpStr over K
  for f,g be Form of V,W, w be Vector of W holds FunctionalSAF(f-g,w) =
  FunctionalSAF(f,w) - FunctionalSAF(g,w);

theorem 
  for K be non empty addLoopStr for V,W be non empty VectSpStr over K
  for f,g be Form of V,W, v be Vector of V holds FunctionalFAF(f-g,v) =
  FunctionalFAF(f,v) - FunctionalFAF(g,v);

begin



definition
  let K be non empty multMagma;
  let V,W be non empty VectSpStr over K;
  let f be Functional of V;
  let g be Functional of W;
  func FormFunctional(f,g) -> Form of V,W means


  for v be Vector of V, w be Vector of W holds it.(v,w)= f.v * g.w;
end;

theorem 
  for K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr for V,W be non empty VectSpStr
  over K for f be Functional of V,v be Vector of V, w be Vector of W holds
  FormFunctional(f,0Functional(W)).(v,w) = 0.K;

theorem 
  for K be add-associative right_zeroed right_complementable
left-distributive non empty doubleLoopStr for V,W be non empty VectSpStr over
  K for g be Functional of W, v be Vector of V, w be Vector of W holds
  FormFunctional(0Functional(V),g).(v,w) = 0.K;

theorem 
  for K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr for V,W be non empty VectSpStr
  over K for f be Functional of V holds FormFunctional(f,0Functional(W)) =
  NulForm(V,W);

theorem 
  for K be add-associative right_zeroed right_complementable
left-distributive non empty doubleLoopStr for V,W be non empty VectSpStr over
K for g be Functional of W holds FormFunctional(0Functional(V),g) = NulForm(V,W
  );

theorem 
  for K be non empty multMagma for V,W be non empty VectSpStr over
  K for f be Functional of V, g be Functional of W, v be Vector of V holds
  FunctionalFAF(FormFunctional(f,g),v) = f.v * g;

theorem 
  for K be commutative non empty multMagma for V,W be non empty
VectSpStr over K for f be Functional of V, g be Functional of W, w be Vector of
  W holds FunctionalSAF(FormFunctional(f,g),w) = g.w * f;

begin



definition
  let K be non empty addLoopStr;
  let V,W be non empty VectSpStr over K;
  let f be Form of V,W;
  attr f is additiveFAF means


  for v be Vector of V holds FunctionalFAF (f,v) is additive;
  attr f is additiveSAF means


  for w be Vector of W holds FunctionalSAF (f,w) is additive;
end;

definition
  let K be non empty multMagma;
  let V,W be non empty VectSpStr over K;
  let f be Form of V,W;
  attr f is homogeneousFAF means


  for v be Vector of V holds FunctionalFAF(f,v) is homogeneous;
  attr f is homogeneousSAF means


  for w be Vector of W holds FunctionalSAF(f,w) is homogeneous;
end;

registration
  let K be right_zeroed non empty addLoopStr;
  let V,W be non empty VectSpStr over K;
  cluster NulForm(V,W) -> additiveFAF;
  cluster NulForm(V,W) -> additiveSAF;
end;

registration
  let K be right_zeroed non empty addLoopStr;
  let V,W be non empty VectSpStr over K;
  cluster additiveFAF additiveSAF for Form of V,W;
end;

registration
  let K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let V,W be non empty VectSpStr over K;
  cluster NulForm(V,W) -> homogeneousFAF;
  cluster NulForm(V,W) -> homogeneousSAF;
end;

registration
  let K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let V,W be non empty VectSpStr over K;
  cluster additiveFAF homogeneousFAF additiveSAF homogeneousSAF for
Form of V,W;
end;

definition
  let K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let V,W be non empty VectSpStr over K;
  mode bilinear-Form of V,W is additiveSAF homogeneousSAF additiveFAF
    homogeneousFAF Form of V,W;
end;

registration
  let K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let V,W be non empty VectSpStr over K;
  let f be additiveFAF Form of V,W, v be Vector of V;
  cluster FunctionalFAF(f,v) -> additive;
end;

registration
  let K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let V,W be non empty VectSpStr over K;
  let f be additiveSAF Form of V,W, w be Vector of W;
  cluster FunctionalSAF(f,w) -> additive;
end;

registration
  let K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let V,W be non empty VectSpStr over K;
  let f be homogeneousFAF Form of V,W, v be Vector of V;
  cluster FunctionalFAF(f,v) -> homogeneous;
end;

registration
  let K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let V,W be non empty VectSpStr over K;
  let f be homogeneousSAF Form of V,W, w be Vector of W;
  cluster FunctionalSAF(f,w) -> homogeneous;
end;

registration
  let K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let V,W be non empty VectSpStr over K;
  let f be Functional of V, g be additive Functional of W;
  cluster FormFunctional(f,g) -> additiveFAF;
end;

registration
  let K be add-associative right_zeroed right_complementable commutative
  right-distributive non empty doubleLoopStr;
  let V,W be non empty VectSpStr over K;
  let f be additive Functional of V, g be Functional of W;
  cluster FormFunctional(f,g) -> additiveSAF;
end;

registration
  let K be add-associative right_zeroed right_complementable commutative
  associative right-distributive non empty doubleLoopStr;
  let V,W be non empty VectSpStr over K;
  let f be Functional of V, g be homogeneous Functional of W;
  cluster FormFunctional(f,g) -> homogeneousFAF;
end;

registration
  let K be add-associative right_zeroed right_complementable commutative
  associative right-distributive non empty doubleLoopStr;
  let V,W be non empty VectSpStr over K;
  let f be homogeneous Functional of V, g be Functional of W;
  cluster FormFunctional(f,g) -> homogeneousSAF;
end;

registration
  let K be non degenerated non empty doubleLoopStr;
  let V be non trivial VectSpStr over K, W be non empty VectSpStr
  over K;
  let f be Functional of V, g be Functional of W;
  cluster FormFunctional(f,g) -> non trivial;
end;

registration
  let K be non degenerated non empty doubleLoopStr;
  let V be non empty VectSpStr over K, W be non trivial VectSpStr over K;
  let f be Functional of V, g be Functional of W;
  cluster FormFunctional(f,g) -> non trivial;
end;

registration
  let K be Field;
  let V,W be non trivial VectSp of K;
  let f be non constant 0-preserving Functional of V, g be non constant
  0-preserving Functional of W;
  cluster FormFunctional(f,g) -> non constant;
end;

registration
  let K be Field;
  let V,W be non trivial VectSp of K;
  cluster non trivial non constant additiveFAF homogeneousFAF additiveSAF
    homogeneousSAF for Form of V,W;
end;

registration
  let K be Abelian add-associative right_zeroed non empty addLoopStr;
  let V,W be non empty VectSpStr over K;
  let f,g be additiveSAF Form of V,W;
  cluster f+g -> additiveSAF;
end;

registration
  let K be Abelian add-associative right_zeroed non empty addLoopStr;
  let V,W be non empty VectSpStr over K;
  let f,g be additiveFAF Form of V,W;
  cluster f+g -> additiveFAF;
end;

registration
  let K be right-distributive right_zeroed non empty doubleLoopStr;
  let V,W be non empty VectSpStr over K;
  let f be additiveSAF Form of V,W;
  let a be Element of K;
  cluster a*f -> additiveSAF;
end;

registration
  let K be right-distributive right_zeroed non empty doubleLoopStr;
  let V,W be non empty VectSpStr over K;
  let f be additiveFAF Form of V,W;
  let a be Element of K;
  cluster a*f -> additiveFAF;
end;

registration
  let K be Abelian add-associative right_zeroed right_complementable non
  empty addLoopStr;
  let V,W be non empty VectSpStr over K;
  let f be additiveSAF Form of V,W;
  cluster -f -> additiveSAF;
end;

registration
  let K be Abelian add-associative right_zeroed right_complementable non
  empty addLoopStr;
  let V,W be non empty VectSpStr over K;
  let f be additiveFAF Form of V,W;
  cluster -f -> additiveFAF;
end;

registration
  let K be Abelian add-associative right_zeroed right_complementable non
  empty addLoopStr;
  let V,W be non empty VectSpStr over K;
  let f,g be additiveSAF Form of V,W;
  cluster f-g -> additiveSAF;
end;

registration
  let K be Abelian add-associative right_zeroed right_complementable non
  empty addLoopStr;
  let V,W be non empty VectSpStr over K;
  let f,g be additiveFAF Form of V,W;
  cluster f-g -> additiveFAF;
end;

registration
  let K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let V,W be non empty VectSpStr over K;
  let f,g be homogeneousSAF Form of V,W;
  cluster f+g -> homogeneousSAF;
end;

registration
  let K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let V,W be non empty VectSpStr over K;
  let f,g be homogeneousFAF Form of V,W;
  cluster f+g -> homogeneousFAF;
end;

registration
  let K be add-associative right_zeroed right_complementable associative
  commutative right-distributive non empty doubleLoopStr;
  let V,W be non empty VectSpStr over K;
  let f be homogeneousSAF Form of V,W;
  let a be Element of K;
  cluster a*f -> homogeneousSAF;
end;

registration
  let K be add-associative right_zeroed right_complementable associative
  commutative right-distributive non empty doubleLoopStr;
  let V,W be non empty VectSpStr over K;
  let f be homogeneousFAF Form of V,W;
  let a be Element of K;
  cluster a*f -> homogeneousFAF;
end;

registration
  let K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let V,W be non empty VectSpStr over K;
  let f be homogeneousSAF Form of V,W;
  cluster -f -> homogeneousSAF;
end;

registration
  let K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let V,W be non empty VectSpStr over K;
  let f be homogeneousFAF Form of V,W;
  cluster -f -> homogeneousFAF;
end;

registration
  let K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let V,W be non empty VectSpStr over K;
  let f,g be homogeneousSAF Form of V,W;
  cluster f-g -> homogeneousSAF;
end;

registration
  let K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let V,W be non empty VectSpStr over K;
  let f,g be homogeneousFAF Form of V,W;
  cluster f-g -> homogeneousFAF;
end;

theorem 
  for K be non empty addLoopStr for V,W be non empty VectSpStr
  over K for v,u be Vector of V, w be Vector of W, f be Form of V,W st f is
  additiveSAF holds f.(v+u,w) = f.(v,w) + f.(u,w);

theorem 
  for K be non empty addLoopStr for V,W be non empty VectSpStr
  over K for v be Vector of V, u,w be Vector of W, f be Form of V,W st f is
  additiveFAF holds f.(v,u+w) = f.(v,u) + f.(v,w);

theorem 
  for K be right_zeroed non empty addLoopStr for V,W be non
  empty VectSpStr over K for v,u be Vector of V, w,t be Vector of W, f be
additiveSAF additiveFAF Form of V,W holds f.(v+u,w+t) = f.(v,w) + f.(v,t) + (f.
  (u,w) + f.(u,t));

theorem 
  for K be add-associative right_zeroed right_complementable non
empty doubleLoopStr for V,W be right_zeroed non empty VectSpStr over K for f
  be additiveFAF Form of V,W, v be Vector of V holds f.(v,0.W) = 0.K;

theorem 
  for K be add-associative right_zeroed right_complementable non
empty doubleLoopStr for V,W be right_zeroed non empty VectSpStr over K for f
  be additiveSAF Form of V,W, w be Vector of W holds f.(0.V,w) = 0.K;

theorem 
  for K be non empty multMagma for V,W be non empty VectSpStr over
K for v be Vector of V, w be Vector of W, a be Element of K for f be Form of V,
  W st f is homogeneousSAF holds f.(a*v,w) = a*f.(v,w);

theorem 
  for K be non empty multMagma for V,W be non empty VectSpStr over
K for v be Vector of V, w be Vector of W, a be Element of K for f be Form of V,
  W st f is homogeneousFAF holds f.(v,a*w) = a*f.(v,w);

theorem 
  for K be add-associative right_zeroed right_complementable
  associative left_unital distributive non empty doubleLoopStr for V,W be
  add-associative right_zeroed right_complementable vector-distributive
  scalar-distributive scalar-associative scalar-unital non empty
VectSpStr over K for f be homogeneousSAF Form of V,W, w be Vector of W holds f
  .(0.V,w) = 0.K;

theorem 
  for K be add-associative right_zeroed right_complementable
  associative left_unital distributive non empty doubleLoopStr for V,W be
  add-associative right_zeroed right_complementable vector-distributive
  scalar-distributive scalar-associative scalar-unital non empty
VectSpStr over K for f be homogeneousFAF Form of V,W, v be Vector of V holds f
  .(v,0.W) = 0.K;

theorem 
  for K be add-associative right_zeroed right_complementable
Abelian associative well-unital distributive non empty doubleLoopStr for V,W
  be VectSp of K for v,u be Vector of V, w be Vector of W, f be additiveSAF
  homogeneousSAF Form of V,W holds f.(v-u,w) = f.(v,w) - f.(u,w);

theorem 
  for K be add-associative right_zeroed right_complementable
Abelian associative well-unital distributive non empty doubleLoopStr for V,W
  be VectSp of K for v be Vector of V, w,t be Vector of W, f be additiveFAF
  homogeneousFAF Form of V,W holds f.(v,w-t) = f.(v,w) - f.(v,t);

theorem 
  for K be add-associative right_zeroed right_complementable
Abelian associative well-unital distributive non empty doubleLoopStr for V,W
  be VectSp of K for v,u be Vector of V, w,t be Vector of W, f be bilinear-Form
  of V,W holds f.(v-u,w-t) = f.(v,w) - f.(v,t) -(f.(u,w) - f.(u,t));

theorem 
  for K be add-associative right_zeroed right_complementable associative
  well-unital distributive non empty doubleLoopStr for V,W be add-associative
right_zeroed right_complementable vector-distributive scalar-distributive
scalar-associative scalar-unital non empty VectSpStr over K for
  v,u be Vector of V, w,t be Vector of W, a,b be Element of K for f be
bilinear-Form of V,W holds f.(v+a*u,w+b*t) = f.(v,w) + b*f.(v,t) + (a*f.(u,w) +
  a*(b*f.(u,t)));

theorem 
  for K be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr for V,W be
VectSp of K for v,u be Vector of V, w,t be Vector of W, a,b be Element of K for
f be bilinear-Form of V,W holds f.(v-a*u,w-b*t) = f.(v,w) - b*f.(v,t) - (a*f.(u
  ,w) - a*(b*f.(u,t)));

theorem 
  for K be add-associative right_zeroed right_complementable non
  empty doubleLoopStr, V,W be right_zeroed non empty VectSpStr over K, f be
Form of V,W st f is additiveFAF or f is additiveSAF holds f is constant iff for
  v be Vector of V, w be Vector of W holds f.(v,w)=0.K;

begin



definition
  let K be ZeroStr;
  let V,W be non empty VectSpStr over K;
  let f be Form of V,W;
  func leftker f -> Subset of V equals

  {v where v is Vector of V : for w be
  Vector of W holds f.(v,w) = 0.K};
end;

definition
  let K be ZeroStr;
  let V,W be non empty VectSpStr over K;
  let f be Form of V,W;
  func rightker f -> Subset of W equals

  {w where w is Vector of W : for v be
  Vector of V holds f.(v,w) = 0.K};
end;

definition
  let K be ZeroStr;
  let V be non empty VectSpStr over K;
  let f be Form of V,V;
  func diagker f -> Subset of V equals

  {v where v is Vector of V : f.(v,v) =
  0.K};
end;

registration
  let K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let V be right_zeroed non empty VectSpStr over K;
  let W be non empty VectSpStr over K;
  let f be additiveSAF Form of V,W;
  cluster leftker f -> non empty;
end;

registration
  let K be add-associative right_zeroed right_complementable associative
  well-unital distributive non empty doubleLoopStr;
  let V be add-associative right_zeroed right_complementable
  vector-distributive scalar-distributive scalar-associative scalar-unital non
  empty VectSpStr over K;
  let W be non empty VectSpStr over K;
  let f be homogeneousSAF Form of V,W;
  cluster leftker f -> non empty;
end;

registration
  let K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let V be non empty VectSpStr over K;
  let W be right_zeroed non empty VectSpStr over K;
  let f be additiveFAF Form of V,W;
  cluster rightker f -> non empty;
end;

registration
  let K be add-associative right_zeroed right_complementable associative
  well-unital distributive non empty doubleLoopStr;
  let V be non empty VectSpStr over K;
  let W be add-associative right_zeroed right_complementable
  vector-distributive scalar-distributive scalar-associative scalar-unital non
  empty VectSpStr over K;
  let f be homogeneousFAF Form of V,W;
  cluster rightker f -> non empty;
end;

registration
  let K be add-associative right_zeroed right_complementable non empty
  doubleLoopStr;
  let V be right_zeroed non empty VectSpStr over K;
  let f be additiveFAF Form of V,V;
  cluster diagker f -> non empty;
end;

registration
  let K be add-associative right_zeroed right_complementable non empty
  doubleLoopStr;
  let V be right_zeroed non empty VectSpStr over K;
  let f be additiveSAF Form of V,V;
  cluster diagker f -> non empty;
end;

registration
  let K be add-associative right_zeroed right_complementable associative
  well-unital distributive non empty doubleLoopStr;
  let V be add-associative right_zeroed right_complementable
  vector-distributive scalar-distributive scalar-associative scalar-unital non
  empty VectSpStr over K;
  let f be homogeneousFAF Form of V,V;
  cluster diagker f -> non empty;
end;

registration
  let K be add-associative right_zeroed right_complementable associative
  well-unital distributive non empty doubleLoopStr;
  let V be add-associative right_zeroed right_complementable
  vector-distributive scalar-distributive scalar-associative
  scalar-unital non
  empty VectSpStr over K;
  let f be homogeneousSAF Form of V,V;
  cluster diagker f -> non empty;
end;

theorem 
  for K be ZeroStr, V be non empty VectSpStr over K for f be Form of V,V
  holds leftker f c= diagker f & rightker f c= diagker f;

theorem 
  for K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr for V,W be non empty VectSpStr
  over K for f be additiveSAF homogeneousSAF Form of V,W holds leftker f is
  linearly-closed;

theorem 
  for K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr for V,W be non empty VectSpStr
  over K for f be additiveFAF homogeneousFAF Form of V,W holds rightker f is
  linearly-closed;

definition
  let K be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr;
  let V be VectSp of K, W be non empty VectSpStr over K;
  let f be additiveSAF homogeneousSAF Form of V,W;
  func LKer f -> strict non empty Subspace of V means


  the carrier of it = leftker f;
end;

definition
  let K be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr;
  let V be non empty VectSpStr over K, W be VectSp of K;
  let f be additiveFAF homogeneousFAF Form of V,W;
  func RKer f -> strict non empty Subspace of W means


  the carrier of it = rightker f;
end;

definition
  let K be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr;
  let V be VectSp of K, W be non empty VectSpStr over K;
  let f be additiveSAF homogeneousSAF Form of V,W;
  func LQForm(f) -> additiveSAF homogeneousSAF Form of VectQuot(V,LKer f),W
  means


  for A be Vector of VectQuot(V,LKer(f)), w be Vector of W, v be
  Vector of V st A = v + LKer(f) holds it.(A,w) = f.(v,w);
end;

definition
  let K be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr;
  let V be non empty VectSpStr over K, W be VectSp of K;
  let f be additiveFAF homogeneousFAF Form of V,W;
  func RQForm(f) -> additiveFAF homogeneousFAF Form of V,VectQuot(W,RKer f)
  means


  for A be Vector of VectQuot(W,RKer(f)), v be Vector of V, w be
  Vector of W st A = w + RKer(f) holds it.(v,A) = f.(v,w);
end;

registration
  let K be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr;
  let V,W be VectSp of K;
  let f be bilinear-Form of V,W;
  cluster LQForm(f) -> additiveFAF homogeneousFAF;
  cluster RQForm(f) -> additiveSAF homogeneousSAF;
end;

definition
  let K be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr;
  let V,W be VectSp of K;
  let f be bilinear-Form of V,W;
  func QForm(f) -> bilinear-Form of VectQuot(V,LKer(f)),VectQuot(W,RKer(f))
  means


  for A be Vector of VectQuot(V,LKer f), B be Vector of VectQuot(W,
  RKer(f)) for v be Vector of V, w be Vector of W st A = v + LKer f & B = w +
  RKer f holds it.(A,B)= f.(v,w);
end;

theorem 
  for K be add-associative right_zeroed right_complementable
Abelian associative well-unital distributive non empty doubleLoopStr for V be
  VectSp of K, W be non empty VectSpStr over K for f be additiveSAF
  homogeneousSAF Form of V,W holds rightker f = rightker (LQForm f);

theorem 
  for K be add-associative right_zeroed right_complementable
Abelian associative well-unital distributive non empty doubleLoopStr for V be
  non empty VectSpStr over K, W be VectSp of K for f be additiveFAF
  homogeneousFAF Form of V,W holds leftker f = leftker (RQForm f);

theorem 
  for K be add-associative right_zeroed right_complementable
Abelian associative well-unital distributive non empty doubleLoopStr for V,W
  be VectSp of K, f be bilinear-Form of V,W holds RKer f = RKer (LQForm f);

theorem 
  for K be add-associative right_zeroed right_complementable
Abelian associative well-unital distributive non empty doubleLoopStr for V,W
  be VectSp of K, f be bilinear-Form of V,W holds LKer f = LKer (RQForm f);

theorem 
  for K be add-associative right_zeroed right_complementable
Abelian associative well-unital distributive non empty doubleLoopStr for V,W
be VectSp of K, f be bilinear-Form of V,W holds QForm(f) = RQForm(LQForm(f)) &
  QForm(f) = LQForm(RQForm(f));

theorem 
  for K be add-associative right_zeroed right_complementable
Abelian associative well-unital distributive non empty doubleLoopStr for V,W
  be VectSp of K, f be bilinear-Form of V,W holds leftker QForm(f) = leftker (
RQForm(LQForm(f))) & rightker QForm(f) = rightker (RQForm(LQForm(f))) & leftker
QForm(f) = leftker (LQForm(RQForm(f))) & rightker QForm(f) = rightker (LQForm(
  RQForm(f)));

theorem 
  for K be add-associative right_zeroed right_complementable
  distributive non empty doubleLoopStr for V,W be non empty VectSpStr over K
  for f be Functional of V, g be Functional of W holds ker f c= leftker
  FormFunctional(f,g);

theorem 
  for K be add-associative right_zeroed right_complementable
  associative commutative well-unital almost_left_invertible distributive non
empty doubleLoopStr for V, W be non empty VectSpStr over K for f be Functional
of V, g be Functional of W st g <> 0Functional(W) holds leftker FormFunctional(
  f,g) = ker f;

theorem 
  for K be add-associative right_zeroed right_complementable
  distributive non empty doubleLoopStr for V,W be non empty VectSpStr over K
  for f be Functional of V, g be Functional of W holds ker g c= rightker
  FormFunctional(f,g);

theorem 
  for K be add-associative right_zeroed right_complementable
  associative commutative well-unital almost_left_invertible distributive non
empty doubleLoopStr for V, W be non empty VectSpStr over K for f be Functional
of V, g be Functional of W st f <> 0Functional(V) holds rightker FormFunctional
  (f,g) = ker g;

theorem 
  for K be add-associative right_zeroed right_complementable
commutative Abelian associative well-unital distributive almost_left_invertible
non empty doubleLoopStr for V be VectSp of K, W be non empty VectSpStr over K
  for f be linear-Functional of V, g be Functional of W st g <> 0Functional(W)
  holds LKer FormFunctional(f,g) = Ker f & LQForm(FormFunctional(f,g)) =
  FormFunctional(CQFunctional(f),g);

theorem 
  for K be add-associative right_zeroed right_complementable
commutative Abelian associative well-unital distributive almost_left_invertible
non empty doubleLoopStr for V be non empty VectSpStr over K, W be VectSp of K
  for f be Functional of V, g be linear-Functional of W st f <> 0Functional(V)
  holds RKer FormFunctional(f,g) = Ker g & RQForm(FormFunctional(f,g)) =
  FormFunctional(f,CQFunctional(g));

theorem 
  for K be Field, V,W be non trivial VectSp of K for f be non constant
  linear-Functional of V, g be non constant linear-Functional of W holds QForm(
  FormFunctional(f,g)) = FormFunctional(CQFunctional(f),CQFunctional(g));

definition
  let K be ZeroStr;
  let V,W be non empty VectSpStr over K;
  let f be Form of V,W;
  attr f is degenerated-on-left means


  leftker f <> {0.V};
  attr f is degenerated-on-right means


  rightker f <> {0.W};
end;

registration
  let K be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr;
  let V be VectSp of K, W be right_zeroed non empty VectSpStr over K;
  let f be additiveSAF homogeneousSAF Form of V,W;
  cluster LQForm(f) -> non degenerated-on-left;
end;

registration
  let K be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr;
  let V be right_zeroed non empty VectSpStr over K, W be VectSp of K;
  let f be additiveFAF homogeneousFAF Form of V,W;
  cluster RQForm(f) -> non degenerated-on-right;
end;

registration
  let K be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr;
  let V,W be VectSp of K;
  let f be bilinear-Form of V,W;
  cluster QForm(f) -> non degenerated-on-left non degenerated-on-right;
end;

registration
  let K be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr;
  let V,W be VectSp of K;
  let f be bilinear-Form of V,W;
  cluster RQForm(LQForm(f)) -> non degenerated-on-left non
    degenerated-on-right;
  cluster LQForm(RQForm(f)) -> non degenerated-on-left non
    degenerated-on-right;
end;

registration
  let K be Field;
  let V,W be non trivial VectSp of K;
  let f be non constant bilinear-Form of V,W;
  cluster QForm(f) -> non constant;
end;

begin



definition
  let K be 1-sorted;
  let V be VectSpStr over K;
  let f be Form of V,V;
  attr f is symmetric means


  for v,w be Vector of V holds f.(v,w) = f.( w,v);
end;

definition
  let K be ZeroStr;
  let V be VectSpStr over K;
  let f be Form of V,V;
  attr f is alternating means


  for v be Vector of V holds f.(v,v) = 0.K;
end;

registration
  let K be non empty ZeroStr;
  let V be non empty VectSpStr over K;
  cluster NulForm(V,V) -> symmetric;
  cluster NulForm(V,V) -> alternating;
end;

registration
  let K be non empty ZeroStr;
  let V be non empty VectSpStr over K;
  cluster symmetric for Form of V,V;
  cluster alternating for Form of V,V;
end;

registration
  let K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let V be non empty VectSpStr over K;
  cluster symmetric additiveFAF homogeneousFAF additiveSAF homogeneousSAF for
Form
    of V,V;
  cluster alternating additiveFAF homogeneousFAF additiveSAF homogeneousSAF
    for Form of V,V;
end;

registration
  let K be Field;
  let V be non trivial VectSp of K;
  cluster symmetric non trivial non constant additiveFAF homogeneousFAF
    additiveSAF homogeneousSAF for Form of V,V;
end;

registration
  let K be add-associative right_zeroed right_complementable non empty
  addLoopStr;
  let V be non empty VectSpStr over K;
  cluster alternating additiveFAF additiveSAF for Form of V,V;
end;

registration
  let K be non empty addLoopStr;
  let V be non empty VectSpStr over K;
  let f,g be symmetric Form of V,V;
  cluster f+g -> symmetric;
end;

registration
  let K be non empty doubleLoopStr;
  let V be non empty VectSpStr over K;
  let f be symmetric Form of V,V;
  let a be Element of K;
  cluster a*f -> symmetric;
end;

registration
  let K be non empty addLoopStr;
  let V be non empty VectSpStr over K;
  let f be symmetric Form of V,V;
  cluster -f -> symmetric;
end;

registration
  let K be non empty addLoopStr;
  let V be non empty VectSpStr over K;
  let f,g be symmetric Form of V,V;
  cluster f-g -> symmetric;
end;

registration
  let K be right_zeroed non empty addLoopStr;
  let V be non empty VectSpStr over K;
  let f,g be alternating Form of V,V;
  cluster f+g -> alternating;
end;

registration
  let K be add-associative right_zeroed right_complementable
  right-distributive non empty doubleLoopStr;
  let V be non empty VectSpStr over K;
  let f be alternating Form of V,V;
  let a be Scalar of K;
  cluster a*f -> alternating;
end;

registration
  let K be add-associative right_zeroed right_complementable non empty
  addLoopStr;
  let V be non empty VectSpStr over K;
  let f be alternating Form of V,V;
  cluster -f -> alternating;
end;

registration
  let K be add-associative right_zeroed right_complementable non empty
  addLoopStr;
  let V be non empty VectSpStr over K;
  let f,g be alternating Form of V,V;
  cluster f-g -> alternating;
end;

theorem 
  for K be add-associative right_zeroed right_complementable
right-distributive non empty doubleLoopStr for V be non empty VectSpStr over
  K for f be symmetric bilinear-Form of V,V holds leftker f = rightker f;

theorem 
  for K be add-associative right_zeroed right_complementable non
  empty addLoopStr for V be non empty VectSpStr over K for f be alternating
additiveSAF additiveFAF Form of V,V for v,w be Vector of V holds f.(v,w)=-f.(w,
  v);

definition
  let K be Fanoian Field;
  let V be non empty VectSpStr over K;
  let f be additiveSAF additiveFAF Form of V,V;
  redefine attr f is alternating means

  for v,w be Vector of V holds f.(v,w) = -f.(w,v);
end;

theorem 
  for K be add-associative right_zeroed right_complementable
right-distributive non empty doubleLoopStr for V be non empty VectSpStr over
  K for f be alternating bilinear-Form of V,V holds leftker f = rightker f;















begin

theorem 
  for a be complex number st a = a*' holds Im a = 0;

theorem 
  for a be Element of COMPLEX st a <> 0c holds |.(Re a)/|.a.|+ (-Im
a)/|.a.|*<i>.| = 1 & Re (((Re a)/|.a.|+ (-Im a)/|.a.|*<i>) * a) = |.a.| & Im ((
  (Re a)/|.a.|+ (-Im a)/|.a.|*<i>) * a)= 0;

theorem 
  for a be Element of COMPLEX ex b be Element of COMPLEX st |.b.| = 1 &
  Re (b * a) = |.a.| & Im (b * a)= 0;

theorem 
  for a be Element of COMPLEX holds a*a*' = |.a.|^2+0*<i>;

theorem 
  for a be Element of F_Complex st a = a*' holds Im a = 0;

theorem 
  i_FC * i_FC*' = 1_F_Complex;

theorem 
  for a be Element of F_Complex st a <> 0.F_Complex holds |.[**(Re
a)/|.a.|, (-Im a)/|.a.|**].| = 1 & Re ([**(Re a)/|.a.|, (-Im a)/|.a.|**] * a) =
  |.a.| & Im ([**(Re a)/|.a.|, (-Im a)/|.a.|**] * a) = 0;

theorem 
  for a be Element of F_Complex ex b be Element of F_Complex st |.b
  .| = 1 & Re (b * a) = |.a.| & Im (b * a)= 0;

theorem 
  for a,b be Element of F_Complex holds Re (a - b) = Re a - Re b &
  Im (a - b) = Im a - Im b;

theorem 
  for a,b be Element of F_Complex st Im a = 0 holds Re (a*b) = Re
  a * Re b & Im (a*b) = Re a * Im b;

theorem 
  for a,b be Element of F_Complex st Im a = 0 & Im b = 0 holds Im (a*b) = 0;

theorem 
  for a be Element of F_Complex st Im a = 0 holds a = a*';

theorem 
  for a be Element of F_Complex holds a*a*' = |.a.|^2;

theorem 
  for a be Element of F_Complex st 0 <= Re a & Im a = 0 holds |.a .| = Re a;

theorem 
  for a be Element of F_Complex holds Re a + Re (a*') = 2 * Re a;

begin 

definition
  let V be non empty VectSpStr over F_Complex;
  let f be Functional of V;
  attr f is cmplxhomogeneous means


  for v be Vector of V, a be Scalar of V holds f.(a*v) = (a*')*f.v;
end;

registration
  let V be non empty VectSpStr over F_Complex;
  cluster 0Functional(V) -> cmplxhomogeneous;
end;

registration
  let V be add-associative right_zeroed right_complementable
  vector-distributive scalar-distributive scalar-associative scalar-unital non
  empty VectSpStr over F_Complex;
  cluster cmplxhomogeneous -> 0-preserving for Functional of V;
end;

registration
  let V be non empty VectSpStr over F_Complex;
  cluster additive cmplxhomogeneous 0-preserving for Functional of V;
end;

definition
  let V be non empty VectSpStr over F_Complex;
  mode antilinear-Functional of V is additive cmplxhomogeneous Functional of V;
end;

registration
  let V be non empty VectSpStr over F_Complex;
  let f,g be cmplxhomogeneous Functional of V;
  cluster f+g -> cmplxhomogeneous;
end;

registration
  let V be non empty VectSpStr over F_Complex;
  let f be cmplxhomogeneous Functional of V;
  cluster -f -> cmplxhomogeneous;
end;

registration
  let V be non empty VectSpStr over F_Complex;
  let a be Scalar of V;
  let f be cmplxhomogeneous Functional of V;
  cluster a*f -> cmplxhomogeneous;
end;

registration
  let V be non empty VectSpStr over F_Complex;
  let f,g be cmplxhomogeneous Functional of V;
  cluster f-g -> cmplxhomogeneous;
end;

definition
  let V be non empty VectSpStr over F_Complex;
  let f be Functional of V;
  func f*' -> Functional of V means


  for v be Vector of V holds it.v = ( f.v)*';
end;

registration
  let V be non empty VectSpStr over F_Complex;
  let f be additive Functional of V;
  cluster f*' -> additive;
end;

registration
  let V be non empty VectSpStr over F_Complex;
  let f be homogeneous Functional of V;
  cluster f*' -> cmplxhomogeneous;
end;

registration
  let V be non empty VectSpStr over F_Complex;
  let f be cmplxhomogeneous Functional of V;
  cluster f*' -> homogeneous;
end;

registration
  let V be non trivial VectSp of F_Complex;
  let f be non constant Functional of V;
  cluster f*' -> non constant;
end;

registration
  let V be non trivial VectSp of F_Complex;
  cluster additive cmplxhomogeneous non constant non trivial for
Functional of V;
end;

theorem 
  for V be non empty VectSpStr over F_Complex, f be Functional of V
  holds (f*')*'=f;

theorem 
  for V be non empty VectSpStr over F_Complex holds (0Functional(V))*' =
  0Functional(V);

theorem 
  for V be non empty VectSpStr over F_Complex, f,g be Functional
  of V holds (f+g)*'=f*'+ g*';

theorem 
  for V be non empty VectSpStr over F_Complex, f be Functional of
  V holds (-f)*'=-(f*');

theorem 
  for V be non empty VectSpStr over F_Complex for f be Functional of V,
  a be Scalar of V holds (a*f)*' = a*' * (f*');

theorem 
  for V be non empty VectSpStr over F_Complex, f,g be Functional of V
  holds (f-g)*'=f*'- g*';

theorem 
  for V be non empty VectSpStr over F_Complex, f be Functional of
  V for v be Vector of V holds f.v = 0.F_Complex iff f*'.v = 0.F_Complex;

theorem 
  for V be non empty VectSpStr over F_Complex, f be Functional of
  V holds ker f = ker f*';

theorem 
  for V be add-associative right_zeroed right_complementable
  vector-distributive scalar-distributive scalar-associative scalar-unital
non empty VectSpStr over F_Complex for f be antilinear-Functional of V holds
  ker f is linearly-closed;

theorem 
  for V be VectSp of F_Complex, W be Subspace of V for f be
antilinear-Functional of V st the carrier of W c= ker f*' holds QFunctional(f,W
  ) is cmplxhomogeneous;

definition
  let V be VectSp of F_Complex;
  let f be antilinear-Functional of V;
  func QcFunctional(f) -> antilinear-Functional of VectQuot(V,Ker(f*')) equals

  QFunctional(f,Ker(f*'));
end;

theorem 
  for V be VectSp of F_Complex, f be antilinear-Functional of V
  for A be Vector of VectQuot(V,Ker (f*')), v be Vector of V st A = v+Ker (f*')
  holds (QcFunctional(f)).A = f.v;

registration
  let V be non trivial VectSp of F_Complex;
  let f be non constant antilinear-Functional of V;
  cluster QcFunctional(f) -> non constant;
end;

registration
  let V be VectSp of F_Complex;
  let f be antilinear-Functional of V;
  cluster QcFunctional(f) -> non degenerated;
end;

begin



definition
  let V,W be non empty VectSpStr over F_Complex;
  let f be Form of V,W;
  attr f is cmplxhomogeneousFAF means


  for v be Vector of V holds FunctionalFAF(f,v) is cmplxhomogeneous;
end;

theorem 
  for V,W be non empty VectSpStr over F_Complex for v be Vector of
  V,w be Vector of W, a be Element of F_Complex for f be Form of V,W st f is
  cmplxhomogeneousFAF holds f.(v,a*w) = (a*')*f.(v,w);

definition
  let V be non empty VectSpStr over F_Complex;
  let f be Form of V,V;
  attr f is hermitan means


  for v,u be Vector of V holds f.(v,u) = (f.(u ,v))*';
  attr f is diagRvalued means


  for v be Vector of V holds Im (f.(v,v)) = 0;
  attr f is diagReR+0valued means


  for v be Vector of V holds 0 <= Re (f .(v,v));
end;

registration
  let V,W be non empty VectSpStr over F_Complex;
  cluster NulForm(V,W) -> cmplxhomogeneousFAF;
end;

registration
  let V be non empty VectSpStr over F_Complex;
  cluster NulForm(V,V) -> hermitan;
  cluster NulForm(V,V) -> diagReR+0valued;
end;

registration
  let V be non empty VectSpStr over F_Complex;
  cluster hermitan -> diagRvalued for Form of V,V;
end;

registration
  let V be non empty VectSpStr over F_Complex;
  cluster diagReR+0valued hermitan diagRvalued additiveSAF homogeneousSAF
    additiveFAF cmplxhomogeneousFAF for Form of V,V;
end;

registration
  let V,W be non empty VectSpStr over F_Complex;
  cluster additiveSAF homogeneousSAF additiveFAF cmplxhomogeneousFAF for
Form of V
    ,W;
end;

definition
  let V,W be non empty VectSpStr over F_Complex;
  mode sesquilinear-Form of V,W is additiveSAF homogeneousSAF additiveFAF
    cmplxhomogeneousFAF Form of V,W;
end;

registration
  let V be non empty VectSpStr over F_Complex;
  cluster hermitan additiveFAF -> additiveSAF for Form of V,V;
end;

registration
  let V be non empty VectSpStr over F_Complex;
  cluster hermitan additiveSAF -> additiveFAF for Form of V,V;
end;

registration
  let V be non empty VectSpStr over F_Complex;
  cluster hermitan homogeneousSAF -> cmplxhomogeneousFAF for Form of V,V;
end;

registration
  let V be non empty VectSpStr over F_Complex;
  cluster hermitan cmplxhomogeneousFAF -> homogeneousSAF for Form of V,V;
end;

definition
  let V be non empty VectSpStr over F_Complex;
  mode hermitan-Form of V is hermitan additiveSAF homogeneousSAF Form of V,V;
end;

registration
  let V,W be non empty VectSpStr over F_Complex;
  let f be Functional of V, g be cmplxhomogeneous Functional of W;
  cluster FormFunctional(f,g) -> cmplxhomogeneousFAF;
end;

registration
  let V,W be non empty VectSpStr over F_Complex;
  let f be cmplxhomogeneousFAF Form of V,W;
  let v be Vector of V;
  cluster FunctionalFAF(f,v) -> cmplxhomogeneous;
end;

registration
  let V,W be non empty VectSpStr over F_Complex;
  let f,g be cmplxhomogeneousFAF Form of V,W;
  cluster f+g -> cmplxhomogeneousFAF;
end;

registration
  let V,W be non empty VectSpStr over F_Complex;
  let f be cmplxhomogeneousFAF Form of V,W;
  let a be Scalar of V;
  cluster a*f -> cmplxhomogeneousFAF;
end;

registration
  let V,W be non empty VectSpStr over F_Complex;
  let f be cmplxhomogeneousFAF Form of V,W;
  cluster -f -> cmplxhomogeneousFAF;
end;

registration
  let V,W be non empty VectSpStr over F_Complex;
  let f,g be cmplxhomogeneousFAF Form of V,W;
  cluster f-g -> cmplxhomogeneousFAF;
end;

registration
  let V,W be non trivial VectSp of F_Complex;
  cluster additiveSAF homogeneousSAF additiveFAF cmplxhomogeneousFAF non
    constant non trivial for Form of V,W;
end;

definition
  let V,W be non empty VectSpStr over F_Complex;
  let f be Form of V,W;
  func f*' -> Form of V,W means


  for v be Vector of V, w be Vector of W holds it.(v,w) = (f.(v,w))*';
end;

registration
  let V,W be non empty VectSpStr over F_Complex;
  let f be additiveFAF Form of V,W;
  cluster f*' -> additiveFAF;
end;

registration
  let V,W be non empty VectSpStr over F_Complex;
  let f be additiveSAF Form of V,W;
  cluster f*' -> additiveSAF;
end;

registration
  let V,W be non empty VectSpStr over F_Complex;
  let f be homogeneousFAF Form of V,W;
  cluster f*' -> cmplxhomogeneousFAF;
end;

registration
  let V,W be non empty VectSpStr over F_Complex;
  let f be cmplxhomogeneousFAF Form of V,W;
  cluster f*' -> homogeneousFAF;
end;

registration
  let V,W be non trivial VectSp of F_Complex;
  let f be non constant Form of V,W;
  cluster f*' -> non constant;
end;

theorem 
  for V be non empty VectSpStr over F_Complex, f be Functional of
  V, v be Vector of V holds (FormFunctional(f,f*')).(v,v) = |. f.v .|^2;

registration
  let V be non empty VectSpStr over F_Complex;
  let f be Functional of V;
  cluster FormFunctional(f,f*') -> diagReR+0valued hermitan diagRvalued;
end;

registration
  let V be non trivial VectSp of F_Complex;
  cluster diagReR+0valued hermitan diagRvalued additiveSAF homogeneousSAF
    additiveFAF cmplxhomogeneousFAF non constant non trivial for Form of V,V;
end;

theorem 
  for V,W be non empty VectSpStr over F_Complex, f be Form of V,W holds
  (f*')*' = f;

theorem 
  for V,W be non empty VectSpStr over F_Complex holds (NulForm(V,W))*' =
  NulForm(V,W);

theorem 
  for V,W be non empty VectSpStr over F_Complex, f,g be Form of V,
  W holds (f+g)*'=f*'+ g*';

theorem 
  for V,W be non empty VectSpStr over F_Complex, f be Form of V,W
  holds (-f)*'=-(f*');

theorem 
  for V,W be non empty VectSpStr over F_Complex for f be Form of V,W, a
  be Element of F_Complex holds (a*f)*' = a*' * (f*');

theorem 
  for V,W be non empty VectSpStr over F_Complex, f,g be Form of V,W
  holds (f-g)*'=f*'- g*';

theorem 
  for V,W be VectSp of F_Complex, v be Vector of V, w,t be Vector
of W for f be additiveFAF cmplxhomogeneousFAF Form of V,W holds f.(v,w-t) = f.(
  v,w) - f.(v,t);

theorem 
  for V,W be VectSp of F_Complex, v,u be Vector of V, w,t be
Vector of W for f be sesquilinear-Form of V,W holds f.(v-u,w-t) = f.(v,w) - f.(
  v,t) -(f.(u,w) - f.(u,t));

theorem 
  for V,W be add-associative right_zeroed right_complementable
vector-distributive scalar-distributive scalar-associative scalar-unital
 non empty VectSpStr over F_Complex for v,u be Vector of V, w,t be
  Vector of W for a,b be Element of F_Complex for f be sesquilinear-Form of V,W
holds f.(v+a*u,w+b*t) = f.(v,w) + b*' * f.(v,t) + (a*f.(u,w) + a*(b*' *f.(u,t))
  );

theorem 
  for V,W be VectSp of F_Complex, v,u be Vector of V, w,t be
  Vector of W for a,b be Element of F_Complex for f be sesquilinear-Form of V,W
  holds f.(v-a*u,w-b*t) = f.(v,w) - b*'*f.(v,t) - (a*f.(u,w) - a*(b*'*f.(u,t)))
;

theorem 
  for V be add-associative right_zeroed right_complementable
  vector-distributive scalar-distributive scalar-associative scalar-unital
   non empty VectSpStr over F_Complex for f be cmplxhomogeneousFAF
  Form of V,V for v be Vector of V holds f.(v,0.V) = 0.F_Complex;

theorem 


  for V be VectSp of F_Complex, v,w be Vector of V, f be hermitan-Form
of V holds f.(v,w) + f.(v,w) + f.(v,w) + f.(v,w) = f.(v+w,v+w) - f.(v-w,v-w) +
  i_FC *f.(v+i_FC*w,v+i_FC*w) -i_FC *f.(v-i_FC*w,v-i_FC*w);

definition
  let V be non empty VectSpStr over F_Complex;
  let f be Form of V,V;
  let v be Vector of V;
  func signnorm(f,v) -> real number equals

  Re (f.(v,v));
end;

theorem 
  for V be add-associative right_zeroed right_complementable
  vector-distributive scalar-distributive scalar-associative scalar-unital
   non empty VectSpStr over F_Complex for f be diagReR+0valued
diagRvalued Form of V,V for v be Vector of V holds |. f.(v,v) .| = Re (f.(v,v))
  & signnorm (f,v) = |. f.(v,v) .|;





theorem 
  for V be VectSp of F_Complex, v,w be Vector of V for f be
sesquilinear-Form of V,V, r be real number, a be Element of F_Complex st |.a.|
=1 holds f.(v-[**r,0**]*a*w, v-[**r,0**]*a*w) = f.(v,v) - [**r,0**]*(a* f.(w,v)
  ) - [**r,0**]*(a*'*f.(v,w)) + [**r^2,0**]*f.(w,w);

theorem 
  for V be VectSp of F_Complex, v,w be Vector of V for f be
diagReR+0valued hermitan-Form of V, r be real number, a be Element of F_Complex
  st |.a.| =1 & Re (a * f.(w,v)) = |.f.(w,v).| holds Re( f.(v-[**r,0**]*a*w, v-
[**r,0**]*a*w)) = signnorm(f,v) - 2*|.f.(w,v).|*r + signnorm(f,w) * r^2 & 0 <=
  signnorm(f,v) - 2*|.f.(w,v).|*r + signnorm(f,w) * r^2;

theorem 
  for V be VectSp of F_Complex, v,w be Vector of V for f be
  diagReR+0valued hermitan-Form of V st signnorm(f,w)= 0 holds |.f.(w,v).| = 0;



theorem 
  for V be VectSp of F_Complex, v,w be Vector of V for f be
  diagReR+0valued hermitan-Form of V holds |. f.(v,w) .|^2 <= signnorm(f,v) *
  signnorm(f,w);

theorem 

  for V be VectSp of F_Complex for f be diagReR+0valued
hermitan-Form of V for v,w be Vector of V holds |. f.(v,w) .|^2 <= |. f.(v,v).|
  * |. f.(w,w) .|;



theorem 
  for V be VectSp of F_Complex for f be diagReR+0valued
  hermitan-Form of V for v,w be Vector of V holds signnorm(f,v+w) <= (sqrt(
  signnorm(f,v)) + sqrt(signnorm(f,w)))^2;

theorem 


  for V be VectSp of F_Complex for f be diagReR+0valued hermitan-Form of
V for v,w be Vector of V holds |. f.(v+w,v+w) .| <= (sqrt(|. f.(v,v) .|) + sqrt
  (|. f.(w,w) .|))^2;

theorem 


  for V be VectSp of F_Complex for f be hermitan-Form of V for v,w
  be Element of V holds signnorm(f,v+w) + signnorm(f,v-w) =2* signnorm(f,v)+ 2*
  signnorm(f,w);

theorem 


  for V be VectSp of F_Complex for f be diagReR+0valued hermitan-Form of
V for v,w be Element of V holds |. f.(v+w,v+w) .| + |. f.(v-w,v-w) .| = 2*|. f.
  (v,v) .| + 2*|. f.(w,w) .|;

definition
  let V be non empty VectSpStr over F_Complex;
  let f be Form of V,V;
  func quasinorm(f) -> RFunctional of V means


  for v be Element of V holds it.v = sqrt (signnorm(f,v));
end;

registration
  let V be VectSp of F_Complex;
  let f be diagReR+0valued hermitan-Form of V;
  cluster quasinorm(f) -> subadditive homogeneous;
end;

begin



registration
  let V be add-associative right_zeroed right_complementable
  vector-distributive scalar-distributive scalar-associative scalar-unital non
  empty VectSpStr over F_Complex;
  let f be cmplxhomogeneousFAF Form of V,V;
  cluster diagker f -> non empty;
end;

theorem 
  for V be VectSp of F_Complex, f be diagReR+0valued hermitan-Form of V
  holds diagker f is linearly-closed;

theorem 
  for V be VectSp of F_Complex, f be diagReR+0valued hermitan-Form
  of V holds diagker f = leftker f;

theorem 
  for V be VectSp of F_Complex, f be diagReR+0valued hermitan-Form
  of V holds diagker f = rightker f;

theorem 
  for V be non empty VectSpStr over F_Complex, f be Form of V,V holds
  diagker f = diagker f*';

theorem 
  for V,W be non empty VectSpStr over F_Complex, f be Form of V,W
  holds leftker f = leftker f*' & rightker f = rightker f*';

theorem 
  for V be VectSp of F_Complex, f be diagReR+0valued hermitan-Form
  of V holds LKer f = RKer (f*');

theorem 
  for V be VectSp of F_Complex, f be diagReR+0valued diagRvalued
Form of V,V for v be Vector of V st Re (f.(v,v))= 0 holds f.(v,v)= 0.F_Complex;

theorem 
  for V be VectSp of F_Complex, f be diagReR+0valued hermitan-Form
of V, v be Vector of V st Re (f.(v,v))= 0 & (f is non degenerated-on-left or f
  is non degenerated-on-right) holds v=0.V;

definition
  let V be non empty VectSpStr over F_Complex, W be VectSp of F_Complex;
  let f be additiveFAF cmplxhomogeneousFAF Form of V,W;
  func RQ*Form(f) -> additiveFAF cmplxhomogeneousFAF Form of V,VectQuot(W,RKer
  (f*')) equals

  (RQForm(f*'))*';
end;

theorem 
  for V be non empty VectSpStr over F_Complex, W be VectSp of
F_Complex for f be additiveFAF cmplxhomogeneousFAF Form of V,W for v be Vector
  of V, w be Vector of W holds (RQ*Form(f)).(v,w+RKer (f*')) = f.(v,w);

registration
  let V,W be VectSp of F_Complex;
  let f be sesquilinear-Form of V,W;
  cluster LQForm(f) -> additiveFAF cmplxhomogeneousFAF;
  cluster RQ*Form(f) -> additiveSAF homogeneousSAF;
end;

definition
  let V,W be VectSp of F_Complex;
  let f be sesquilinear-Form of V,W;
  func Q*Form(f) -> sesquilinear-Form of VectQuot(V,LKer(f)),VectQuot(W,RKer(f
  *')) means


  for A be Vector of VectQuot(V,LKer f), B be Vector of
VectQuot(W, RKer(f*')) for v be Vector of V, w be Vector of W st A = v + LKer f
  & B = w + RKer (f*') holds it.(A,B)= f.(v,w);
end;

registration
  let V,W be non trivial VectSp of F_Complex;
  let f be non constant sesquilinear-Form of V,W;
  cluster Q*Form(f) -> non constant;
end;

registration
  let V be right_zeroed non empty VectSpStr over F_Complex, W be VectSp of
  F_Complex;
  let f be additiveFAF cmplxhomogeneousFAF Form of V,W;
  cluster RQ*Form(f) -> non degenerated-on-right;
end;

theorem 
  for V be non empty VectSpStr over F_Complex, W be VectSp of
F_Complex for f be additiveFAF cmplxhomogeneousFAF Form of V,W holds leftker f
  = leftker (RQ*Form f);

theorem 
  for V,W be VectSp of F_Complex, f be sesquilinear-Form of V,W
  holds RKer f*' = RKer (LQForm f)*';

theorem 
  for V,W be VectSp of F_Complex, f be sesquilinear-Form of V,W
  holds LKer f = LKer (RQ*Form f);

theorem 
  for V,W be VectSp of F_Complex, f be sesquilinear-Form of V,W
  holds Q*Form(f) = RQ*Form(LQForm(f)) & Q*Form(f) = LQForm(RQ*Form(f));

theorem 
  for V,W be VectSp of F_Complex, f be sesquilinear-Form of V,W
  holds leftker Q*Form(f) = leftker (RQ*Form(LQForm(f))) & rightker Q*Form(f) =
rightker (RQ*Form(LQForm(f))) & leftker Q*Form(f) = leftker (LQForm(RQ*Form(f))
  ) & rightker Q*Form(f) = rightker (LQForm(RQ*Form(f)));

registration
  let V,W be VectSp of F_Complex;
  let f be sesquilinear-Form of V,W;
  cluster RQ*Form(LQForm(f)) -> non degenerated-on-left non
    degenerated-on-right;
  cluster LQForm(RQ*Form(f)) -> non degenerated-on-left non
    degenerated-on-right;
end;

registration
  let V,W be VectSp of F_Complex;
  let f be sesquilinear-Form of V,W;
  cluster Q*Form(f) -> non degenerated-on-left non degenerated-on-right;
end;

begin



definition
  let V be non empty VectSpStr over F_Complex;
  let f be Form of V,V;
  attr f is positivediagvalued means


  for v be Vector of V st v <> 0.V holds 0 < Re (f.(v,v));
end;

registration
  let V be right_zeroed non empty VectSpStr over F_Complex;
  cluster positivediagvalued additiveSAF -> diagReR+0valued for Form of V,V;
end;

registration
  let V be right_zeroed non empty VectSpStr over F_Complex;
  cluster positivediagvalued additiveFAF -> diagReR+0valued for Form of V,V;
end;

definition
  let V be VectSp of F_Complex;
  let f be diagReR+0valued hermitan-Form of V;
  func ScalarForm(f) -> diagReR+0valued hermitan-Form of VectQuot(V,LKer(f))
  equals

  Q*Form(f);
end;

theorem 
  for V be VectSp of F_Complex, f be diagReR+0valued hermitan-Form of V
for A,B be Vector of VectQuot(V,LKer(f)), v,w be Vector of V st A = v + LKer f
  & B = w + LKer f holds (ScalarForm(f)).(A,B) = f.(v,w);

theorem 
  for V be VectSp of F_Complex, f be diagReR+0valued hermitan-Form
  of V holds leftker ScalarForm(f) = leftker Q*Form(f);

theorem 
  for V be VectSp of F_Complex, f be diagReR+0valued hermitan-Form of V
  holds rightker ScalarForm(f) = rightker Q*Form(f);





registration
  let V be VectSp of F_Complex;
  let f be diagReR+0valued hermitan-Form of V;
  cluster ScalarForm(f) -> non degenerated-on-left non degenerated-on-right
    positivediagvalued;
end;

registration
  let V be non trivial VectSp of F_Complex;
  let f be diagReR+0valued non constant hermitan-Form of V;
  cluster ScalarForm(f) -> non constant;
end;














begin 

reserve i,j,k,n for Nat;
reserve x,x1,x2,x3,y1,y2,y3 for set;

theorem 
  4 = {0,1,2,3};

theorem 
  [:{x1,x2,x3},{y1,y2,y3}:] = {[x1,y1],[x1,y2],[x1,y3],[x2,y1],[x2,y2],[
  x2,y3],[x3,y1],[x3,y2],[x3,y3]};

theorem 
  for x being set, n be Nat holds x in n implies x is Nat;

theorem 
  for x be non empty Nat holds 0 in x;

registration
  let X be set;
  cluster delta X -> one-to-one;
end;

theorem 
  for X being set holds card id X = card X;

registration
  cluster trivial -> one-to-one for Function;
end;

theorem 
  for f,g be Function st dom f misses dom g holds rng(f +* g) = rng f \/
  rng g;

theorem 
  for f,g be one-to-one Function st dom f misses dom g & rng f
  misses rng g holds (f+*g)" = f" +* g";

theorem 
  for A,a,b being set holds (A --> a) +* (A --> b) = A --> b;

theorem 
  for a,b being set holds (a .--> b)" = b .--> a;

theorem 
  for a,b,c,d being set st a = b iff c = d holds (a,b) --> (c,d)"
  = (c,d) --> (a,b);

scheme 

  Convers{X()-> non empty set, R() -> Relation, F,G(set)-> set, P[set]}: R()~
  ={[F(x),G(x)] where x is Element of X(): P[x]}
provided
 R() = {[G(x),F(x)] where x is Element of X(): P[x]};

theorem 
  for i,j,n be Nat holds i < j & j in n implies i in n;

begin   

definition
  let R,S be RelStr;

  pred S embeds R means


  ex f being Function of R,S st f is one-to-one &
for x,y being Element of R holds [x,y] in the InternalRel of R iff [f.x,f.y] in
  the InternalRel of S;
end;

definition
  let R,S be non empty RelStr;
  redefine pred S embeds R;
  reflexivity;
end;

theorem 
  for R,S,T be non empty RelStr holds R embeds S & S embeds T
  implies R embeds T;

definition
  let R,S be non empty RelStr;
  pred R is_equimorphic_to S means


  R embeds S & S embeds R;
  reflexivity;
  symmetry;
end;

theorem 
  for R,S,T be non empty RelStr holds R is_equimorphic_to S & S
  is_equimorphic_to T implies R is_equimorphic_to T;

notation
  let R be non empty RelStr;
  antonym R is parallel for R is connected;
end;

definition
  let R be RelStr;
  attr R is symmetric means


  the InternalRel of R is_symmetric_in the carrier of R;
end;

definition
  let R be RelStr;
  attr R is asymmetric means


  the InternalRel of R is asymmetric;
end;

theorem 
  for R be RelStr st R is asymmetric holds the InternalRel of R misses (
  the InternalRel of R)~;

definition
  let R be RelStr;
  attr R is irreflexive means

  for x being set st x in the carrier of R holds
  not [x,x] in the InternalRel of R;
end;

definition
  let n be Nat;
  func n-SuccRelStr -> strict RelStr means


  the carrier of it = n & the
  InternalRel of it = {[i,i+1] where i is Element of NAT:i+1 < n};
end;

theorem 
  for n be Nat holds n-SuccRelStr is asymmetric;

theorem 
  n > 0 implies card the InternalRel of n-SuccRelStr = n-1;

definition
  let R be RelStr;
  func SymRelStr R -> strict RelStr means


  the carrier of it = the
  carrier of R & the InternalRel of it = (the InternalRel of R) \/ (the
  InternalRel of R)~;
end;

registration
  let R be RelStr;
  cluster SymRelStr R -> symmetric;
end;

registration
  cluster non empty symmetric for RelStr;
end;

registration
  let R be symmetric RelStr;
  cluster the InternalRel of R -> symmetric;
end;

definition
  let R be RelStr;
  func ComplRelStr R -> strict RelStr means


  the carrier of it = the
  carrier of R & the InternalRel of it = (the InternalRel of R)` \ id (the
  carrier of R);
end;

registration
  let R be non empty RelStr;
  cluster ComplRelStr R -> non empty;
end;

theorem 
  for S,R being RelStr holds S,R are_isomorphic implies card the
  InternalRel of S = card the InternalRel of R;

begin   

definition
  let n be Nat;
  func Necklace n -> strict RelStr equals

  SymRelStr(n-SuccRelStr);
end;

registration
  let n be Nat;
  cluster Necklace n -> symmetric;
end;

theorem 
  the InternalRel of Necklace n = {[i,i+1] where i is Element of
  NAT:i+1 < n} \/ {[i+1,i] where i is Element of NAT:i+1 < n};

theorem 
  for x be set holds x in the InternalRel of Necklace n iff ex i
  being Element of NAT st i+1 < n & (x = [i,i+1] or x = [i+1,i]);

registration
  let n be Nat;
  cluster Necklace n -> irreflexive;
end;

theorem 
  for n be Nat holds the carrier of Necklace n = n;

registration
  let n be non empty Nat;
  cluster Necklace n -> non empty;
end;

registration
  let n be Nat;
  cluster the carrier of Necklace n -> finite;
end;

theorem 
  for n,i be Nat st i+1 < n holds [i,i+1] in the InternalRel of Necklace n;

theorem 
  for n be Nat, i being Nat st i in the carrier of Necklace n holds i < n;

theorem 
  for n be non empty Nat holds Necklace n is connected;

theorem 
  for i,j being Nat st [i,j] in the InternalRel of Necklace n
  holds i = j + 1 or j = i + 1;

theorem 
  for i,j being Nat st (i = j + 1 or j = i + 1) & i in the carrier
  of Necklace n & j in the carrier of Necklace n holds [i,j] in the InternalRel
  of Necklace n;

theorem 
  n > 0 implies card ({[i+1,i] where i is Element of NAT:i+1 < n}) = n-1;

theorem 
  n > 0 implies card the InternalRel of Necklace n = 2*(n-1);

theorem 
  Necklace 1, ComplRelStr Necklace 1 are_isomorphic;

theorem 
  Necklace 4, ComplRelStr Necklace 4 are_isomorphic;

theorem 
  Necklace n, ComplRelStr Necklace n are_isomorphic implies n = 0 or n =
  1 or n = 4;














begin 

registration
  cluster non trivial for addLoopStr;
end;

registration
  cluster add-associative right_complementable right_zeroed for non trivial
    addLoopStr;
end;

definition
  let X be set, b be bag of X;
  attr b is zero means

  b = EmptyBag X;
end;

theorem 
  for X being set, b1,b2 being bag of X holds b1 divides b2 iff ex
  b being bag of X st b2 = b1 + b;

theorem 
  for n being Ordinal, L being add-associative right_complementable
right_zeroed well-unital distributive non empty doubleLoopStr, p being Series
  of n, L holds 0_(n,L) *' p = 0_(n,L);

registration
  let n be Ordinal, L be add-associative right_complementable right_zeroed
  well-unital distributive non empty doubleLoopStr, m1,m2 be Monomial of n,L;
  cluster m1 *' m2 -> monomial-like;
end;

registration
  let n be Ordinal, L be add-associative right_complementable right_zeroed
  distributive non empty doubleLoopStr, c1,c2 be ConstPoly of n,L;
  cluster c1 *' c2 -> Constant;
end;

theorem 
  for n being Ordinal, L being add-associative right_complementable
right_zeroed well-unital distributive domRing-like non trivial doubleLoopStr,
b,b9 being bag of n, a,a9 being non zero Element of L holds Monom(a * a9,b + b9
  ) = Monom(a,b) *' Monom(a9,b9);

theorem 
  for n being Ordinal, L being add-associative right_complementable
right_zeroed well-unital distributive domRing-like non trivial doubleLoopStr,
  a,a9 being Element of L holds (a * a9) |(n,L) = (a |(n,L)) *' (a9 |(n,L));

begin

registration
  let n be Ordinal;
  cluster admissible connected for TermOrder of n;
end;



registration
  let n be Nat;
  cluster -> well_founded for admissible TermOrder of n;
end;

definition
  let n be Ordinal, T be TermOrder of n, b,b9 be bag of n;
  pred b <= b9,T means


  [b,b9] in T;
end;

definition
  let n be Ordinal, T be TermOrder of n, b,b9 be bag of n;
  pred b < b9,T means


  b <= b9,T & b <> b9;
end;

definition
  let n be Ordinal, T be TermOrder of n, b1,b2 be bag of n;
  func min(b1,b2,T) -> bag of n equals


  b1 if b1 <= b2,T otherwise b2;
  func max(b1,b2,T) -> bag of n equals


  b1 if b2 <= b1,T otherwise b2;
end;

theorem 
  for n being Ordinal, T being connected TermOrder of n, b1,b2
  being bag of n holds b1 <= b2,T iff not b2 < b1,T;

theorem 
  for n being Ordinal, T being TermOrder of n, b being bag of n holds b
  <= b,T;

theorem 
  for n being Ordinal, T being TermOrder of n, b1,b2 being bag of n st
  b1 <= b2,T & b2 <= b1,T holds b1 = b2;

theorem 
  for n being Ordinal, T being TermOrder of n, b1,b2,b3 being bag
  of n st b1 <= b2,T & b2 <= b3,T holds b1 <= b3,T;

theorem 
  for n being Ordinal, T being admissible TermOrder of n, b being
  bag of n holds EmptyBag n <= b,T;

theorem 
  for n being Ordinal, T being admissible TermOrder of n, b1,b2 being
  bag of n holds b1 divides b2 implies b1 <= b2,T;

theorem 
  for n being Ordinal, T being TermOrder of n, b1,b2 being bag of
  n holds min(b1,b2,T) = b1 or min(b1,b2,T) = b2;

theorem 
  for n being Ordinal, T being TermOrder of n, b1,b2 being bag of
  n holds max(b1,b2,T) = b1 or max(b1,b2,T) = b2;

theorem 
  for n being Ordinal, T being connected TermOrder of n, b1,b2 being bag
  of n holds min(b1,b2,T) <= b1,T & min(b1,b2,T) <= b2,T;

theorem 
  for n being Ordinal, T being connected TermOrder of n, b1,b2
  being bag of n holds b1 <= max(b1,b2,T),T & b2 <= max(b1,b2,T),T;

theorem 
  for n being Ordinal, T being connected TermOrder of n, b1,b2
being bag of n holds min(b1,b2,T) = min(b2,b1,T) & max(b1,b2,T) = max(b2,b1,T);

theorem 
  for n being Ordinal, T being connected TermOrder of n, b1,b2 being bag
  of n holds min(b1,b2,T) = b1 iff max(b1,b2,T) = b2;

begin 

definition
  let n be Ordinal, T be connected TermOrder of n, L be non empty ZeroStr, p
  be Polynomial of n,L;
  func HT(p,T) -> Element of Bags n means


  Support p = {} & it =
EmptyBag n or (it in Support p & for b being bag of n st b in Support p holds b
  <= it,T);
end;

definition 
  let n be Ordinal, T be connected TermOrder of n, L be non empty ZeroStr, p
  be Polynomial of n,L;
  func HC(p,T) -> Element of L equals

  p.(HT(p,T));
end;

definition 
  let n be Ordinal, T be connected TermOrder of n, L be non empty ZeroStr, p
  be Polynomial of n,L;
  func HM(p,T) -> Monomial of n,L equals

  Monom(HC(p,T),HT(p,T));
end;

registration
  let n be Ordinal, T be connected TermOrder of n, L be non trivial ZeroStr, p
  be non-zero Polynomial of n,L;
  cluster HM(p,T) -> non-zero;
  cluster HC(p,T) -> non zero;
end;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being non
empty ZeroStr, p being Polynomial of n,L holds HC(p,T) = 0.L iff p = 0_(n,L);

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being non
trivial ZeroStr, p being Polynomial of n,L holds (HM(p,T)).(HT(p,T)) = p.(HT(p,
  T));

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
non trivial ZeroStr, p being Polynomial of n,L, b being bag of n st b <> HT(p,T
  ) holds HM(p,T).b = 0.L;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being non
trivial ZeroStr, p being Polynomial of n,L holds Support(HM(p,T)) c= Support(p)
;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being non
  trivial ZeroStr, p being Polynomial of n,L holds Support(HM(p,T)) = {} or
  Support(HM(p,T)) = {HT(p,T)};

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being non
  trivial ZeroStr, p being Polynomial of n,L holds term(HM(p,T)) = HT(p,T) &
  coefficient(HM(p,T)) = HC(p,T);

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being non
  empty ZeroStr, m being Monomial of n,L holds HT(m,T) = term(m) & HC(m,T) =
  coefficient(m) & HM(m,T) = m;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being non
empty ZeroStr, c being ConstPoly of n,L holds HT(c,T) = EmptyBag n & HC(c,T) =
  c.(EmptyBag n);

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being non
empty ZeroStr, a being Element of L holds HT(a |(n,L),T) = EmptyBag n & HC(a |(
  n,L),T) = a;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  non trivial ZeroStr, p being Polynomial of n,L holds HT(HM(p,T),T) = HT(p,T);

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being non
  trivial ZeroStr, p being Polynomial of n,L holds HC(HM(p,T),T) = HC(p,T);

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being non
empty ZeroStr, p being Polynomial of n,L holds HM(HM(p,T),T) = HM(p,T);

theorem 
  for n being Ordinal, T being admissible connected TermOrder of n
  , L being add-associative right_complementable left_zeroed right_zeroed
  well-unital distributive domRing-like non trivial doubleLoopStr, p,q being
  non-zero Polynomial of n,L holds HT(p,T) + HT(q,T) in Support(p*'q);

theorem 
  for n being Ordinal, L being add-associative
  right_complementable right_zeroed well-unital distributive non empty
doubleLoopStr, p,q being Polynomial of n,L holds Support(p*'q) c= {s + t where
  s,t is Element of Bags n : s in Support p & t in Support q};

theorem 
  for n being Ordinal, T being admissible connected TermOrder of n
  , L being add-associative right_complementable right_zeroed well-unital
  distributive domRing-like non trivial doubleLoopStr, p,q being non-zero
  Polynomial of n,L holds HT(p*'q,T) = HT(p,T) + HT(q,T);

theorem 
  for n being Ordinal, T being admissible connected TermOrder of n
  , L being add-associative right_complementable right_zeroed well-unital
  distributive domRing-like non trivial doubleLoopStr, p,q being non-zero
  Polynomial of n,L holds HC(p*'q,T) = HC(p,T) * HC(q,T);

theorem 
  for n being Ordinal, T being admissible connected TermOrder of n, L
  being add-associative right_complementable right_zeroed well-unital
  distributive domRing-like non trivial doubleLoopStr, p,q being non-zero
  Polynomial of n,L holds HM(p*'q,T) = HM(p,T) *' HM(q,T);

theorem 
  for n being Ordinal, T being admissible connected TermOrder of n, L
being right_zeroed non empty addLoopStr, p,q being Polynomial of n,L holds HT
  (p+q,T) <= max(HT(p,T),HT(q,T),T), T;

begin 

definition
  let n be Ordinal, T be connected TermOrder of n, L be add-associative
right_complementable right_zeroed non empty addLoopStr, p be Polynomial of n,
  L;
  func Red(p,T) -> Polynomial of n,L equals

  p - HM(p,T);
end;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed non trivial addLoopStr, p
  being Polynomial of n,L holds Support(Red(p,T)) c= Support(p);

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed non trivial addLoopStr, p
  being Polynomial of n,L holds Support(Red(p,T)) = Support(p) \ {HT(p,T)};

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed non trivial addLoopStr, p
  being Polynomial of n,L holds Support(HM(p,T) + Red(p,T)) = Support p;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed non trivial addLoopStr, p
  being Polynomial of n,L holds HM(p,T) + Red(p,T) = p;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed non trivial addLoopStr, p
  being Polynomial of n,L holds (Red(p,T)).(HT(p,T)) = 0.L;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed non trivial addLoopStr, p
  being Polynomial of n,L, b being bag of n st b in Support p & b <> HT(p,T)
  holds (Red(p,T)).b = p.b;














begin 

registration
  let n be Ordinal, R be non trivial ZeroStr;
  cluster non-zero for Monomial of n,R;
end;

registration
  cluster non trivial for Field;
end;

registration
  let n be Ordinal, L be add-associative right_complementable left_zeroed
right_zeroed well-unital distributive domRing-like non trivial doubleLoopStr,
  p,q be non-zero finite-Support Series of n,L;
  cluster p *' q -> non-zero;
end;

begin 

theorem 
  for X being set, L being Abelian add-associative right_zeroed
right_complementable non empty addLoopStr, p,q being Series of X, L holds -(p
  + q) = (-p) + (-q);

theorem 
  for X being set, L being left_zeroed non empty addLoopStr, p
  being Series of X, L holds 0_(X,L) + p = p;

theorem 
  for X being set, L being add-associative right_zeroed
right_complementable non empty addLoopStr, p being Series of X, L holds -p +
  p = 0_(X,L) & p + -p = 0_(X,L);

theorem 
  for n being set, L being add-associative right_zeroed
right_complementable non empty addLoopStr, p be Series of n, L holds p - 0_(n
  ,L) = p;

theorem 
  for n being Ordinal, L being add-associative right_complementable
right_zeroed left_add-cancelable left-distributive non empty doubleLoopStr, p
  being Series of n,L holds 0_(n,L) *' p = 0_(n,L);

theorem 
  for n being Ordinal, L being Abelian right_zeroed add-associative
  right_complementable well-unital distributive associative commutative non
trivial doubleLoopStr, p,q being Polynomial of n,L holds -(p *' q) = (-p) *' q
  & -(p *' q) = p *' (-q);

theorem 
  for n being Ordinal, L being add-associative right_complementable
right_zeroed distributive non empty doubleLoopStr, p being Polynomial of n,L,
m being Monomial of n,L, b being bag of n holds (m*'p).(term(m)+b) = m.term(m)
  * p.b;

theorem 
  for X being set, L being right_zeroed left_add-cancelable
left-distributive non empty doubleLoopStr, p being Series of X,L holds 0.L *
  p = 0_(X,L);

theorem 
  for X being set, L being add-associative right_zeroed
right_complementable distributive non empty doubleLoopStr, p being Series of
  X,L, a being Element of L holds -(a * p) = (-a) * p & -(a * p) = a * (-p);

theorem 
  for X being set, L being left-distributive non empty
  doubleLoopStr, p being Series of X,L, a,a9 being Element of L holds
  a * p + a9 * p = (a + a9) * p;

theorem 
  for X being set, L being associative non empty multLoopStr_0,
p being Series of X,L, a,a9 being Element of L holds (a * a9) * p = a * (a9 * p
  );

theorem 
  for n being Ordinal, L being add-associative right_zeroed
  right_complementable well-unital associative commutative distributive non
empty doubleLoopStr, p,p9 being Series of n,L, a being Element of L holds a *
  (p *' p9) = p *' (a * p9);

begin 

definition
  let n be Ordinal, b be bag of n, L be non empty ZeroStr, p be Series of n,L;
  func b *' p -> Series of n,L means


  for b9 being bag of n st b divides
b9 holds it.b9 = p.(b9 -' b) & for b9 being bag of n st not b divides b9 holds
  it.b9 = 0.L;
end;

registration
  let n be Ordinal, b be bag of n, L be non empty ZeroStr, p be finite-Support
  Series of n,L;
  cluster b *' p -> finite-Support;
end;

theorem 
  for n being Ordinal, b,b9 being bag of n, L being non empty ZeroStr, p
  being Series of n,L holds (b*'p).(b9+b) = p.b9;

theorem 
  for n being Ordinal, L being non empty ZeroStr, p being Polynomial of
  n,L, b being bag of n holds Support(b*'p) c= {b + b9 where b9 is Element of
  Bags n : b9 in Support p};

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n
, L being non trivial ZeroStr, p being non-zero Polynomial of n,L, b being bag
  of n holds HT(b*'p,T) = b + HT(p,T);

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n
  , L being non empty ZeroStr, p being Polynomial of n,L, b,b9 being bag of n
  holds b9 in Support(b*'p) implies b9 <= b+HT(p,T),T;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being non
  empty ZeroStr, p being Series of n,L holds (EmptyBag n) *' p = p;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
non empty ZeroStr, p being Series of n,L, b1,b2 being bag of n holds (b1 + b2)
  *' p = b1 *' (b2 *' p);

theorem 
  for n being Ordinal, L being add-associative right_zeroed
  right_complementable distributive non trivial doubleLoopStr, p being
  Polynomial of n,L, a being Element of L holds Support(a*p) c= Support(p);

theorem 
  for n being Ordinal, L being domRing-like non trivial doubleLoopStr,
  p being Polynomial of n,L, a being non zero Element of L holds Support(p) c=
  Support(a*p);

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_zeroed right_complementable distributive domRing-like
non trivial doubleLoopStr, p being Polynomial of n,L, a being non zero Element
  of L holds HT(a*p,T) = HT(p,T);

theorem 
  for n being Ordinal, L being add-associative
  right_complementable right_zeroed distributive non trivial doubleLoopStr, p
being Series of n,L, b being bag of n, a being Element of L holds a * (b *' p)
  = Monom(a,b) *' p;

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n, L
  being add-associative right_complementable right_zeroed well-unital
  distributive domRing-like non trivial doubleLoopStr, p being non-zero
Polynomial of n,L, q being Polynomial of n,L, m being non-zero Monomial of n,L
  holds HT(p,T) in Support q implies HT(m*'p,T) in Support(m*'q);

begin 

registration
  let n be Ordinal, T be connected TermOrder of n;
  cluster RelStr(#Bags n, T#) -> connected;
end;

registration
  let n be Nat, T be admissible TermOrder of n;
  cluster RelStr (#Bags n, T#) -> well_founded;
end;

definition 
  let n be Ordinal, T be connected TermOrder of n, L be non empty ZeroStr, p,q
  be Polynomial of n,L;
  pred p <= q,T means


  [Support p, Support q] in FinOrd RelStr(# Bags n, T#);
end;

definition
  let n be Ordinal, T be connected TermOrder of n, L be non empty ZeroStr, p,q
  be Polynomial of n,L;
  pred p < q,T means


  p <= q,T & Support p <> Support q;
end;

definition
  let n being Ordinal, T being connected TermOrder of n, L being non empty
  ZeroStr, p being Polynomial of n,L;
  func Support(p,T) -> Element of Fin the carrier of RelStr(#Bags n,T#) equals

  Support(p);
end;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
non trivial ZeroStr, p being non-zero Polynomial of n,L holds PosetMax(Support(
  p,T)) = HT(p,T);

theorem 


  for n being Ordinal, T being connected TermOrder of n, L being
  non empty addLoopStr, p being Polynomial of n,L holds p <= p,T;

theorem 


  for n being Ordinal, T being connected TermOrder of n, L being
non empty addLoopStr, p,q being Polynomial of n,L holds p <= q,T & q <= p,T iff
  Support p = Support q;

theorem 


  for n being Ordinal, T being connected TermOrder of n, L being
  non empty addLoopStr, p,q,r being Polynomial of n,L holds p <= q,T & q <= r,T
  implies p <= r,T;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  non empty addLoopStr, p,q being Polynomial of n,L holds p <= q,T or q <= p,T;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
non empty addLoopStr, p,q being Polynomial of n,L holds p <= q,T iff not q < p,
  T;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being non
  empty ZeroStr, p being Polynomial of n,L holds 0_(n,L) <= p,T;

theorem 


  for n being Nat, T being admissible connected TermOrder of n, L
  being add-associative right_complementable right_zeroed well-unital
  distributive non trivial doubleLoopStr, P being non empty Subset of
  Polynom-Ring(n,L) holds ex p being Polynomial of n,L st p in P & for q being
  Polynomial of n,L st q in P holds p <= q,T;

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n, L
being add-associative right_complementable right_zeroed non trivial addLoopStr
, p,q being Polynomial of n,L holds p < q,T iff (p = 0_(n,L) & q <> 0_(n,L) or
  HT(p,T) < HT(q,T),T or HT(p,T) = HT(q,T) & Red(p,T) < Red(q,T),T);

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n
  , L being add-associative right_complementable right_zeroed non trivial
  addLoopStr, p being non-zero Polynomial of n,L holds Red(p,T) < HM(p,T),T;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed non trivial addLoopStr, p
  being Polynomial of n,L holds HM(p,T) <= p,T;

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n
  , L being add-associative right_complementable right_zeroed non trivial
  addLoopStr, p being non-zero Polynomial of n,L holds Red(p,T) < p,T;

begin 

definition 
  let n be Ordinal, T be connected TermOrder of n, L be add-associative
  right_complementable right_zeroed commutative associative well-unital
  distributive almost_left_invertible non trivial doubleLoopStr, f,p,g be
  Polynomial of n,L, b be bag of n;
  pred f reduces_to g,p,b,T means


  f <> 0_(n,L) & p <> 0_(n,L) & b in
Support f & ex s being bag of n st s + HT(p,T) = b & g = f - (f.b/HC(p,T)) * (s
  *' p);
end;

definition 
  let n be Ordinal, T be connected TermOrder of n, L be add-associative
  right_complementable right_zeroed commutative associative well-unital
  distributive almost_left_invertible non trivial doubleLoopStr, f,p,g be
  Polynomial of n,L;
  pred f reduces_to g,p,T means


  ex b being bag of n st f reduces_to g,p ,b,T;
end;

definition 
  let n be Ordinal, T be connected TermOrder of n, L be add-associative
  right_complementable right_zeroed commutative associative well-unital
  distributive almost_left_invertible non trivial doubleLoopStr, f,g be
  Polynomial of n,L, P be Subset of Polynom-Ring(n,L);
  pred f reduces_to g,P,T means


  ex p being Polynomial of n,L st p in P & f reduces_to g,p,T;
end;

definition 
  let n be Ordinal, T be connected TermOrder of n, L be add-associative
  right_complementable right_zeroed commutative associative well-unital
  distributive almost_left_invertible non trivial doubleLoopStr, f,p be
  Polynomial of n,L;
  pred f is_reducible_wrt p,T means


  ex g being Polynomial of n,L st f reduces_to g,p,T;
end;

notation 
  let n be Ordinal, T be connected TermOrder of n, L be add-associative
  right_complementable right_zeroed commutative associative well-unital
  distributive almost_left_invertible non trivial doubleLoopStr, f,p be
  Polynomial of n,L;
  antonym f is_irreducible_wrt p,T for f is_reducible_wrt p,T;
  antonym f is_in_normalform_wrt p,T for f is_reducible_wrt p,T;
end;

definition 
  let n be Ordinal, T be connected TermOrder of n, L be add-associative
  right_complementable right_zeroed commutative associative well-unital
  distributive almost_left_invertible non trivial doubleLoopStr, f be
  Polynomial of n,L, P be Subset of Polynom-Ring(n,L);
  pred f is_reducible_wrt P,T means

  ex g being Polynomial of n,L st f reduces_to g,P,T;
end;

notation 
  let n be Ordinal, T be connected TermOrder of n, L be add-associative
  right_complementable right_zeroed commutative associative well-unital
  distributive almost_left_invertible non trivial doubleLoopStr, f be
  Polynomial of n,L, P be Subset of Polynom-Ring(n,L);
  antonym f is_irreducible_wrt P,T for f is_reducible_wrt P,T;
  antonym f is_in_normalform_wrt P,T for f is_reducible_wrt P,T;
end;

definition 
  let n be Ordinal, T be connected TermOrder of n, L be add-associative
  right_complementable right_zeroed commutative associative well-unital
  distributive almost_left_invertible non trivial doubleLoopStr, f,p,g be
  Polynomial of n,L;
  pred f top_reduces_to g,p,T means

  f reduces_to g,p,HT(f,T),T;
end;

definition 
  let n be Ordinal, T be connected TermOrder of n, L be add-associative
  right_complementable right_zeroed commutative associative well-unital
  distributive almost_left_invertible non trivial doubleLoopStr, f,p be
  Polynomial of n,L;
  pred f is_top_reducible_wrt p,T means

  ex g being Polynomial of n,L st f top_reduces_to g,p,T;
end;

definition 
  let n be Ordinal, T be connected TermOrder of n, L be add-associative
  right_complementable right_zeroed commutative associative well-unital
  distributive almost_left_invertible non trivial doubleLoopStr, f be
  Polynomial of n,L, P be Subset of Polynom-Ring(n,L);
  pred f is_top_reducible_wrt P,T means

  ex p being Polynomial of n,L st p in P & f is_top_reducible_wrt p,T;
end;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed commutative associative
well-unital distributive almost_left_invertible non trivial doubleLoopStr, f
  being Polynomial of n,L, p being non-zero Polynomial of n,L holds f
  is_reducible_wrt p,T iff ex b being bag of n st b in Support f & HT(p,T)
  divides b;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed commutative associative
well-unital distributive almost_left_invertible non trivial doubleLoopStr, p
  being Polynomial of n,L holds 0_(n,L) is_irreducible_wrt p,T;

theorem 
  for n being Ordinal, T being admissible connected TermOrder of n, L
being add-associative right_complementable right_zeroed commutative associative
  well-unital distributive Abelian almost_left_invertible non degenerated non
empty doubleLoopStr, f,p being Polynomial of n,L, m being non-zero Monomial of
  n,L holds f reduces_to f-m*'p,p,T implies HT(m*'p,T) in Support f;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed commutative associative
  well-unital distributive almost_left_invertible non degenerated non empty
  doubleLoopStr, f,p,g being Polynomial of n,L, b being bag of n holds f
  reduces_to g,p,b,T implies not(b in Support g);

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n
  , L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive almost_left_invertible non trivial
doubleLoopStr, f,p,g being Polynomial of n,L, b,b9 being bag of n st b < b9,T
  holds f reduces_to g,p,b,T implies (b9 in Support g iff b9 in Support f);

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n
  , L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive almost_left_invertible non trivial
doubleLoopStr, f,p,g being Polynomial of n,L, b,b9 being bag of n st b < b9,T
  holds f reduces_to g,p,b,T implies f.b9 = g.b9;

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n
  , L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive almost_left_invertible non degenerated
non empty doubleLoopStr, f,p,g being Polynomial of n,L holds f reduces_to g,p,
  T implies for b being bag of n st b in Support g holds b <= HT(f,T),T;

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n
, L being Abelian add-associative right_complementable right_zeroed commutative
  associative well-unital distributive almost_left_invertible non degenerated
non empty doubleLoopStr, f,p,g being Polynomial of n,L holds f reduces_to g,p,
  T implies g < f,T;

begin 

definition
  let n be Ordinal, T be connected TermOrder of n, L be add-associative
  right_complementable right_zeroed commutative associative well-unital
distributive almost_left_invertible non trivial doubleLoopStr, P be Subset of
  Polynom-Ring(n,L);
  func PolyRedRel(P,T) -> Relation of NonZero Polynom-Ring(n,L), the carrier
  of Polynom-Ring(n,L) means


  for p,q being Polynomial of n,L holds [p,q] in it iff p reduces_to q,P,T;
end;

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n, L
  being Abelian add-associative right_complementable right_zeroed commutative
  associative well-unital distributive almost_left_invertible non degenerated
  non empty doubleLoopStr, f,g being Polynomial of n,L, P being Subset of
Polynom-Ring(n,L) holds PolyRedRel(P,T) reduces f,g implies g <= f,T & (g = 0_(
  n,L) or HT(g,T) <= HT(f,T),T);

registration 
  let n be Nat, T be connected admissible TermOrder of n, L be Abelian
  add-associative right_complementable right_zeroed commutative associative
  well-unital distributive almost_left_invertible non degenerated non empty
  doubleLoopStr, P be Subset of Polynom-Ring(n,L);
  cluster PolyRedRel(P,T) -> strongly-normalizing;
end;

theorem 
  for n being Nat, T being admissible connected TermOrder of n, L
being add-associative right_complementable left_zeroed right_zeroed commutative
  associative well-unital distributive Abelian almost_left_invertible non
  trivial doubleLoopStr, P being Subset of Polynom-Ring(n,L), f,h being
  Polynomial of n,L holds f in P implies PolyRedRel(P,T) reduces h*'f,0_(n,L);

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n
, L being Abelian add-associative right_complementable right_zeroed commutative
  associative well-unital distributive almost_left_invertible non degenerated
  non empty doubleLoopStr, P being Subset of Polynom-Ring(n,L), f,g being
  Polynomial of n,L, m being non-zero Monomial of n,L holds f reduces_to g,P,T
  implies m*'f reduces_to m*'g,P,T;

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n
, L being Abelian add-associative right_complementable right_zeroed commutative
  associative well-unital distributive almost_left_invertible non degenerated
  non empty doubleLoopStr, P being Subset of Polynom-Ring(n,L), f,g being
  Polynomial of n,L, m being Monomial of n,L holds PolyRedRel(P,T) reduces f,g
  implies PolyRedRel(P,T) reduces m*'f,m*'g;

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n, L
  being Abelian add-associative right_complementable right_zeroed commutative
  associative well-unital distributive almost_left_invertible non degenerated
  non empty doubleLoopStr, P being Subset of Polynom-Ring(n,L), f being
Polynomial of n,L, m being Monomial of n,L holds PolyRedRel(P,T) reduces f,0_(n
  ,L) implies PolyRedRel(P,T) reduces m*'f,0_(n,L);

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed commutative associative
  well-unital distributive Abelian almost_left_invertible non trivial
doubleLoopStr, P being Subset of Polynom-Ring(n,L), f,g,h,h1 being Polynomial
of n,L holds (f - g = h & PolyRedRel(P,T) reduces h,h1) implies ex f1,g1 being
Polynomial of n,L st f1 - g1 = h1 & PolyRedRel(P,T) reduces f,f1 & PolyRedRel(P
  ,T) reduces g,g1;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed commutative associative
  well-unital distributive Abelian almost_left_invertible non trivial
doubleLoopStr, P being Subset of Polynom-Ring(n,L), f,g being Polynomial of n,
  L holds PolyRedRel(P,T) reduces f-g,0_(n,L) implies f,g are_convergent_wrt
  PolyRedRel(P,T);

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed commutative associative
  well-unital distributive Abelian almost_left_invertible non trivial
doubleLoopStr, P being Subset of Polynom-Ring(n,L), f,g being Polynomial of n,
  L holds PolyRedRel(P,T) reduces f-g,0_(n,L) implies f,g are_convertible_wrt
  PolyRedRel(P,T);

definition
  let R be non empty addLoopStr, I be Subset of R, a,b be Element of R;
  pred a,b are_congruent_mod I means


  a - b in I;
end;

theorem 
  for R being add-associative left_zeroed right_zeroed
  right_complementable right-distributive non empty doubleLoopStr, I being
  right-ideal non empty Subset of R, a being Element of R holds a,a
  are_congruent_mod I;

theorem 
  for R being add-associative right_zeroed right_complementable
well-unital right-distributive non empty doubleLoopStr, I being right-ideal
  non empty Subset of R, a,b being Element of R holds a,b are_congruent_mod I
  implies b,a are_congruent_mod I;

theorem 
  for R being add-associative right_zeroed right_complementable
non empty addLoopStr, I being add-closed non empty Subset of R, a,b,c being
Element of R holds a,b are_congruent_mod I & b,c are_congruent_mod I implies a,
  c are_congruent_mod I;

theorem 
  for R being Abelian add-associative right_zeroed right_complementable
  well-unital distributive associative non trivial doubleLoopStr, I being
  add-closed non empty Subset of R, a,b,c,d being Element of R holds a,b
are_congruent_mod I & c,d are_congruent_mod I implies a+c,b+d are_congruent_mod
  I;

theorem 
  for R being add-associative right_zeroed right_complementable
  commutative distributive non empty doubleLoopStr, I being add-closed
  right-ideal non empty Subset of R, a,b,c,d being Element of R holds a,b
are_congruent_mod I & c,d are_congruent_mod I implies a*c,b*d are_congruent_mod
  I;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  Abelian add-associative right_complementable right_zeroed commutative
  associative well-unital distributive almost_left_invertible non trivial
  doubleLoopStr, P being Subset of Polynom-Ring(n,L), f,g being Element of
  Polynom-Ring(n,L) holds f,g are_convertible_wrt PolyRedRel(P,T) implies f,g
  are_congruent_mod P-Ideal;

theorem 
  for n being Nat, T being admissible connected TermOrder of n, L being
  Abelian add-associative right_complementable right_zeroed commutative
  associative well-unital distributive almost_left_invertible non degenerated
  non empty doubleLoopStr, P being non empty Subset of Polynom-Ring(n,L), f,g
being Element of Polynom-Ring(n,L) holds f,g are_congruent_mod P-Ideal implies
  f,g are_convertible_wrt PolyRedRel(P,T);

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  Abelian add-associative right_complementable right_zeroed commutative
  associative well-unital distributive almost_left_invertible non trivial
doubleLoopStr, P being Subset of Polynom-Ring(n,L), f,g being Polynomial of n,
  L holds PolyRedRel(P,T) reduces f,g implies f-g in P-Ideal;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being Abelian
  add-associative right_complementable right_zeroed commutative associative
well-unital distributive almost_left_invertible non trivial doubleLoopStr, P
being Subset of Polynom-Ring(n,L), f being Polynomial of n,L holds PolyRedRel(P
  ,T) reduces f,0_(n,L) implies f in P-Ideal;














begin 

reserve i,n,m,k,x for Nat,
  i1,i2 for Integer;

definition
  let k;
  func k-SD_Sub_S equals

  {e where e is Element of INT: e >= -Radix(k -' 1) & e
  <= Radix(k -' 1) - 1 };
  func k-SD_Sub equals

  {e where e is Element of INT: e >= -Radix(k -' 1) - 1 &
  e <= Radix(k -' 1) };
end;

theorem 
  i1 in k-SD_Sub implies -Radix(k-'1) - 1 <= i1 & i1 <= Radix(k-'1);

theorem 
  k-SD_Sub_S c= k-SD_Sub;

theorem 
  k-SD_Sub_S c= (k+1)-SD_Sub_S;

theorem 
  2 <= k implies k-SD_Sub c= k-SD;

theorem 
  0 in 0-SD_Sub_S;

theorem 
  0 in k-SD_Sub_S;

theorem 
  0 in k-SD_Sub;

theorem 
  for e being set st e in k-SD_Sub holds e is Integer;

theorem 
  k-SD_Sub c= INT;

theorem 
  k-SD_Sub_S c= INT;

registration
  let k;
  cluster k-SD_Sub_S -> non empty;
  cluster k-SD_Sub -> non empty;
end;

definition
  let k;
  redefine func k-SD_Sub_S -> non empty Subset of INT;
end;

definition
  let k;
  redefine func k-SD_Sub -> non empty Subset of INT;
end;

reserve a for Tuple of n,k-SD;
reserve aSub for Tuple of n,k-SD_Sub;

theorem 
  i in Seg n implies aSub.i is Element of k-SD_Sub;

begin 

definition
  let x be Integer, k be Nat;
  func SDSub_Add_Carry(x,k) -> Integer equals


  1 if Radix(k -' 1) <= x,
  -1 if x < -Radix(k -' 1) otherwise 0;
end;

definition
  let x be Integer, k be Nat;
  func SDSub_Add_Data(x,k) -> Integer equals

  x - Radix(k) * SDSub_Add_Carry(x,
  k);
end;

theorem 
  for x be Integer, k be Nat holds -1 <= SDSub_Add_Carry(x,k) &
  SDSub_Add_Carry(x,k) <= 1;

theorem 
  2 <= k & i1 in k-SD implies SDSub_Add_Data(i1,k) >= -Radix(k-'1)
  & SDSub_Add_Data(i1,k) <= Radix(k-'1) - 1;

theorem 
  for x be Integer, k be Nat st 2 <= k holds SDSub_Add_Carry(x,k) in k-SD_Sub_S
;

theorem 
  2 <= k & i1 in k-SD implies SDSub_Add_Data(i1,k) +
  SDSub_Add_Carry(i2,k) in k-SD_Sub;

theorem 
  SDSub_Add_Carry(0,k) = 0;

begin 

definition
  let i,k,n be Nat, x be Tuple of n,(k-SD_Sub);
  func DigA_SDSub(x,i) -> Integer equals


  x.i if i in Seg n, 0 if i = 0;
end;

definition
  let i,k,n be Nat, x be Tuple of n,(k-SD);
  func SD2SDSubDigit(x,i,k) -> Integer equals


  SDSub_Add_Data(DigA(x,i),
k)+SDSub_Add_Carry(DigA(x,i-'1),k) if i in Seg n, SDSub_Add_Carry(DigA(x,i-'1),
  k) if i = n + 1 otherwise 0;
end;

theorem 
  2 <= k & i in Seg (n+1) implies SD2SDSubDigit(a,i,k) is Element of k-SD_Sub;

definition
  let i,k,n be Nat, x be Tuple of n,(k-SD);
  assume
 2 <= k & i in Seg (n+1);
  func SD2SDSubDigitS(x,i,k) -> Element of k-SD_Sub equals


  SD2SDSubDigit(x,i,k);
end;

definition
  let n,k be Nat, x be Tuple of n,(k-SD);
  func SD2SDSub(x) -> Tuple of (n+1),(k-SD_Sub) means


  for i be Nat st i
  in Seg (n+1) holds DigA_SDSub(it,i) = SD2SDSubDigitS(x,i,k);
end;

theorem 
  i in Seg n implies DigA_SDSub(aSub,i) is Element of k-SD_Sub;

theorem 
  2 <= k & i1 in k-SD & i2 in k-SD_Sub implies SDSub_Add_Data(i1+i2,k)
  in k-SD_Sub_S;

begin 

definition
  let i,k,n be Nat, x be Tuple of n,(k-SD_Sub);
  func DigB_SDSub(x,i) -> Element of INT equals

  DigA_SDSub(x,i);
end;

definition
  let i,k,n be Nat, x be Tuple of n, k-SD_Sub;
  func SDSub2INTDigit(x,i,k) -> Element of INT equals

  (Radix(k) |^ (i -'1)) *
  DigB_SDSub(x,i);
end;

definition
  let n,k be Nat, x be Tuple of n, k-SD_Sub;
  func SDSub2INT(x) -> Tuple of n,INT means


  for i be Nat st i in Seg n holds it/.i = SDSub2INTDigit(x,i,k);
end;

definition
  let n,k be Nat, x be Tuple of n,(k-SD_Sub);
  func SDSub2IntOut(x) -> Integer equals

  Sum SDSub2INT(x);
end;

theorem 
  for i st i in Seg n holds 2 <= k implies DigA_SDSub(SD2SDSub(
DecSD(m,n+1,k)),i) = DigA_SDSub(SD2SDSub(DecSD((m mod (Radix(k) |^ n)),n,k)),i)
;

theorem 
  for n st n >= 1 holds for k,x st k >= 2 & x is_represented_by n,k
  holds x = SDSub2IntOut( SD2SDSub(DecSD(x,n,k)) );














begin 

reserve i,n,m,k,x,y for Nat,
  i1 for Integer;

theorem 
  2 <= k implies 2 < Radix(k);

begin 

theorem 
  for x,y be Integer, k be Nat st 3 <= k holds SDSub_Add_Carry(
  SDSub_Add_Carry(x,k) + SDSub_Add_Carry(y,k), k ) = 0;

theorem 
  2 <= k implies DigA_SDSub(SD2SDSub(DecSD(m,n,k)),n+1) =
  SDSub_Add_Carry( DigA(DecSD(m,n,k),n), k);

theorem 
  2 <= k & m is_represented_by 1,k implies DigA_SDSub(SD2SDSub(
  DecSD(m,1,k)),1+1) = SDSub_Add_Carry(m, k);

theorem 
  for k,x,n be Nat st n >= 1 & k >= 3 & x is_represented_by (n+1),k
  holds DigA_SDSub(SD2SDSub(DecSD(x mod (Radix(k) |^ n),n,k)),n+1) =
  SDSub_Add_Carry(DigA(DecSD(x,n,k),n),k);

theorem 
  2 <= k & m is_represented_by 1,k implies DigA_SDSub(SD2SDSub(
  DecSD(m,1,k)),1) = m - SDSub_Add_Carry(m,k)*Radix(k);

theorem 
  for k,x,n be Nat st k >= 2 holds (Radix(k) |^ n) * DigA_SDSub(
SD2SDSub(DecSD(x,n+1,k)),n+1) = (Radix(k) |^ n) * DigA(DecSD(x,n+1,k),n+1) - (
Radix(k) |^ (n+1)) * SDSub_Add_Carry(DigA(DecSD(x,n+1,k),n+1),k) + (Radix(k) |^
  n) * SDSub_Add_Carry(DigA(DecSD(x,n+1,k),n),k);

begin 

definition
  let i,n,k be Nat, x be Tuple of n,(k-SD_Sub), y be Tuple of n,(k-SD_Sub);
  assume that
 i in Seg n and
 k >= 2;
  func SDSubAddDigit(x,y,i,k) -> Element of k-SD_Sub equals


  SDSub_Add_Data( DigA_SDSub(x,i) + DigA_SDSub(y,i), k ) + SDSub_Add_Carry(
  DigA_SDSub(x,i -'1) + DigA_SDSub(y,i -'1), k);
end;

definition
  let n,k be Nat,x,y be Tuple of n,(k-SD_Sub);
  func x '+' y -> Tuple of n,(k-SD_Sub) means


  for i st i in Seg n holds DigA_SDSub(it,i) = SDSubAddDigit(x,y,i,k);
end;

theorem 
  for i st i in Seg n holds 2 <= k implies SDSubAddDigit(SD2SDSub(
DecSD(x,n+1,k)),SD2SDSub(DecSD(y,n+1,k)),i,k)= SDSubAddDigit( SD2SDSub(DecSD((x
  mod (Radix(k) |^ n)),n,k)), SD2SDSub(DecSD((y mod (Radix(k) |^ n)),n,k)),i,k)
;

theorem 
  for n st n >= 1 holds for k,x,y st k >= 3 & x is_represented_by n,k &
y is_represented_by n,k holds x + y = SDSub2IntOut( SD2SDSub(DecSD(x,n,k)) '+'
  SD2SDSub(DecSD(y,n,k)) );














begin 

reserve X for RealUnitarySpace;
reserve x, y, y1, y2 for Point of X;
reserve xd for set;
reserve i, j, n for Element of NAT;

theorem 
  for D being set, p1, p2 being FinSequence of D holds
  p1 is one-to-one & p2 is one-to-one & rng p1 = rng p2 implies
  dom p1 = dom p2 & ex P being Permutation of dom p1 st
  p2 = p1*P & dom P = dom p1 & rng P = dom p1;

definition
  let DX be non empty set;
  let f be BinOp of DX such that
 f is commutative associative and
 f is having_a_unity;
  let Y be finite Subset of DX;
  func f ++ Y -> Element of DX means

  ex p being FinSequence of DX st p is one-to-one & rng p = Y & it = f "**" p;
end;

definition
  let X;
  let Y be finite Subset of X;
  func setop_SUM(Y,X) equals

  (the addF of X) ++ Y if Y <> {} otherwise 0.X;
end;

definition
  let X, x;
  let p be FinSequence;
  let i be Nat;
  func PO(i,p,x) equals

  (the scalar of X).[x,p.i];
end;

definition
  let DK, DX be non empty set;
  let F be Function of DX, DK;
  let p be FinSequence of DX;
  func Func_Seq(F,p) -> FinSequence of DK equals

  F*p;
end;

definition
  let DK, DX be non empty set;
  let f be BinOp of DK such that
 f is commutative associative and
 f is having_a_unity;
  let Y be finite Subset of DX;
  let F be Function of DX,DK such that
 Y c= dom F;
  func setopfunc(Y,DX,DK,F,f) -> Element of DK means


  ex p being FinSequence of DX st p is one-to-one &
  rng p = Y & it = f "**" Func_Seq(F,p);
end;

definition
  let X, x;
  let Y be finite Subset of X;
  func setop_xPre_PROD(x,Y,X) -> Real means

  ex p being FinSequence of the carrier of X st p is one-to-one & rng p = Y
  & ex q being FinSequence of REAL st dom(q) = dom(p) &
  (for i st i in dom q holds q.i = PO(i,p,x)) & it = addreal "**" q;
end;

definition
  let X, x;
  let Y be finite Subset of X;
  func setop_xPROD(x,Y,X) -> Real equals

  setop_xPre_PROD(x,Y,X) if Y <> {}
  otherwise 0;
end;

begin 

definition
  let X;
  mode OrthogonalFamily of X -> Subset of X means


    for x, y st x in it & y in it & x <> y holds x.|.y = 0;
end;

theorem 
  {} is OrthogonalFamily of X;

registration
  let X;
  cluster finite for OrthogonalFamily of X;
end;

definition
  let X;
  mode OrthonormalFamily of X -> Subset of X means


    it is OrthogonalFamily of X & for x st x in it holds x.|.x = 1;
end;

theorem 
  {} is OrthonormalFamily of X;

registration
  let X;
  cluster finite for OrthonormalFamily of X;
end;

theorem 
  x = 0.X iff for y holds x.|.y = 0;

begin 


theorem 
  ||.x+y.||^2 + ||.x-y.||^2 = 2*||.x.||^2 + 2*||.y.||^2;



theorem 
  x, y are_orthogonal implies ||.x+y.||^2 = ||.x.||^2 + ||.y.||^2;

theorem 
  for p be FinSequence of the carrier of X st (len p >=1 &
  for i,j st i in dom p & j in dom p & i <> j
  holds (the scalar of X).[p.i,p.j]=0) for q be FinSequence of REAL
  st dom p = dom q &
  (for i st i in dom q holds q.i = (the scalar of X).[(p.i),(p.i)])
  holds ((the addF of X) "**" p).|. ((the addF of X) "**" p) = addreal "**" q;

theorem 
  for p be FinSequence of the carrier of X st len p >= 1
  for q be FinSequence of REAL st dom p = dom q &
  (for i st i in dom q holds q.i = (the scalar of X).[x,p.i])
  holds x.|.((the addF of X) "**" p) = addreal "**" q;

theorem 
  for S be finite non empty Subset of X
  for F be Function of the carrier of X, the carrier of X
  st S c= dom F & (for y1,y2 st y1 in S & y2 in S & y1 <> y2
  holds (the scalar of X).[F.y1,F.y2] = 0)
  for H be Function of the carrier of X, REAL
  st S c= dom H & (for y st y in S holds H.y= (the scalar of X).[F.y,F.y])
  for p be FinSequence of the carrier of X
  st p is one-to-one & rng p = S holds
  (the scalar of X).[(the addF of X) "**" Func_Seq(F,p),
  (the addF of X) "**" Func_Seq(F,p)] = addreal "**" Func_Seq(H,p);

theorem 
  for S be finite non empty Subset of X
  for F be Function of the carrier of X, the carrier of X st S c= dom F
  for H be Function of the carrier of X, REAL
  st S c= dom H & (for y st y in S holds H.y = (the scalar of X).[x,F.y])
  for p be FinSequence of the carrier of X st p is one-to-one & rng p = S
  holds (the scalar of X).[x,(the addF of X) "**" Func_Seq(F,p) ]
  = addreal "**" Func_Seq(H,p);

theorem 
  for X st the addF of X is commutative associative &
  the addF of X is having_a_unity for x
  for S be finite OrthonormalFamily of X st S is non empty
  for H be Function of the carrier of X, REAL st
  S c= dom H & (for y st y in S holds H.y= (x.|.y)^2)
  for F be Function of the carrier of X, the carrier of X st
  S c= dom F & (for y st y in S holds F.y = (x.|.y)*y) holds
  x.|.setopfunc(S, the carrier of X, the carrier of X, F, the addF of X)
  = setopfunc(S, the carrier of X, REAL, H, addreal);

theorem 
  for X st the addF of X is commutative associative &
  the addF of X is having_a_unity
  for x for S be finite OrthonormalFamily of X st S is non empty
  for F be Function of the carrier of X, the carrier of X
  st S c= dom F & (for y st y in S holds F.y = (x.|.y)*y)
  for H be Function of the carrier of X, REAL
  st S c= dom H & (for y st y in S holds H.y= (x.|.y)^2) holds
  setopfunc(S, the carrier of X, the carrier of X, F, the addF of X)
  .|. setopfunc(S, the carrier of X, the carrier of X, F, the addF of X)
  = setopfunc(S, the carrier of X, REAL, H, addreal);

theorem 
  for X st the addF of X is commutative associative &
  the addF of X is having_a_unity for x
  for S be finite OrthonormalFamily of X st S is non empty
  for H be Function of the carrier of X, REAL
  st S c= dom H & (for y st y in S holds H.y = (x.|.y)^2) holds
  setopfunc(S, the carrier of X, REAL, H, addreal) <= ||.x.||^2;

theorem 
  for DK, DX be non empty set
  for f be BinOp of DK st f is commutative associative & f is having_a_unity
  for Y1, Y2 be finite Subset of DX st Y1 misses Y2
  for F be Function of DX, DK st Y1 c= dom F & Y2 c= dom F
  for Z be finite Subset of DX st Z = Y1 \/ Y2 holds setopfunc(Z,DX,DK,F,f)
  = f.(setopfunc(Y1,DX,DK,F,f), setopfunc(Y2,DX,DK,F,f));















begin 

reserve n for non empty Nat,
  j,k,l,m for Nat,
  g,h,i for Integer;

theorem 
  for m being Nat st m > 0 holds m * 2 >= m + 1;

theorem 
  for m being Nat holds 2 to_power m >= m;

theorem 
  for m be Nat holds 0*m + 0*m = 0*m;

theorem 
  for k,m,l be Nat holds k <= l & l <= m implies k = l or k + 1 <= l & l <= m;

theorem 
  for n be non empty Nat holds for x,y be Tuple of n,BOOLEAN st x =
  0*n & y = 0*n holds carry(x,y) = 0*n;

theorem 
  for n be non empty Nat holds for x,y be Tuple of n,BOOLEAN st x = 0*n
  & y = 0*n holds x + y = 0*n;

theorem 
  for n be non empty Nat for F be Tuple of n,BOOLEAN st F = 0*n holds
  Intval F = 0;

theorem 
  l + m <= k - 1 implies l < k & m < k;

theorem 
  g <= h + i & h < 0 & i < 0 implies g < h & g < i;

theorem 
  l + m <= 2 to_power n - 1 implies add_ovfl(n-BinarySequence(l),n
  -BinarySequence(m)) = FALSE;

theorem 
  for n be non empty Nat, l,m be Nat st l + m <= 2 to_power n - 1
  holds Absval(n-BinarySequence(l) + n-BinarySequence(m)) = l + m;

theorem 
  for n be non empty Nat holds for z be Tuple of n,BOOLEAN st z/.n
  = TRUE holds Absval(z) >= 2 to_power (n-'1);

theorem 
  l + m <= 2 to_power (n-'1) - 1 implies carry(n-BinarySequence(l)
  ,n-BinarySequence(m))/.n = FALSE;

theorem 
  for n be non empty Nat st l + m <= 2 to_power (n-'1) - 1 holds
  Intval(n-BinarySequence(l) + n-BinarySequence(m)) = l + m;

theorem 
  for z be Tuple of 1,BOOLEAN st z=<*TRUE*> holds Intval(z) = -1;

theorem 
  for z be Tuple of 1,BOOLEAN st z=<*FALSE*> holds Intval(z) = 0;

theorem 
  for x be boolean set holds TRUE 'or' x = TRUE;

theorem 
  for n be non empty Nat holds 0 <= 2 to_power (n-'1) - 1 & -(2 to_power
  (n-'1)) <= 0;

theorem 
  for x,y be Tuple of n,BOOLEAN st x = 0*n & y = 0*n holds x,y are_summable;

theorem 
  (i*n) mod n = 0;

begin 

definition
  let m, j be Nat;
  func MajP(m, j) -> Nat means


  2 to_power it >= j & it >= m & for k be
  Nat st 2 to_power k >= j & k >= m holds k >= it;
end;

theorem 
  j >= k implies MajP(m, j) >= MajP(m, k);

theorem 
  l >= m implies MajP(l,j) >= MajP(m,j);

theorem 
  m >= 1 implies MajP(m, 1) = m;

theorem 
  j <= 2 to_power m implies MajP(m, j) = m;

theorem 
  j > 2 to_power m implies MajP(m, j) > m;

begin 

definition
  let m be Nat;
  let i be Integer;
  func 2sComplement( m, i ) -> Tuple of m, BOOLEAN equals


  m
-BinarySequence( abs( (2 to_power MajP(m,abs(i))) + i ) ) if i < 0 otherwise m
  -BinarySequence( abs(i) );
end;

theorem 
  for m be Nat holds 2sComplement(m,0) = 0*m;

theorem 
  for i be Integer st i <= 2 to_power (n-'1) - 1 & -(2 to_power (n-'1))
  <= i holds Intval( 2sComplement( n, i ) ) = i;

theorem 
  for h,i be Integer st ( h >= 0 & i >= 0 or h < 0 & i < 0 ) & h mod 2
to_power n = i mod 2 to_power n holds 2sComplement(n,h) = 2sComplement(n,i);

theorem 
  for h,i be Integer st ( h >= 0 & i >= 0 or h < 0 & i < 0 ) & h,i
  are_congruent_mod 2 to_power n holds 2sComplement(n,h) = 2sComplement(n,i);

theorem 
  for l,m be Nat st l mod 2 to_power n = m mod 2 to_power n holds
  n-BinarySequence(l) = n-BinarySequence(m);

theorem 
  for l,m be Nat st l,m are_congruent_mod 2 to_power n holds n
  -BinarySequence(l) = n-BinarySequence(m);

theorem 
  for j be Nat st 1 <= j & j <= n holds 2sComplement(n+1,i)/.j =
  2sComplement(n,i)/.j;

theorem 
  ex x be Element of BOOLEAN st 2sComplement(m+1,i) = 2sComplement (m,i)^<*x*>;

theorem 
  ex x be Element of BOOLEAN st (m+1)-BinarySequence(l) = (m
  -BinarySequence(l))^<*x*>;

theorem 
  for n be non empty Nat holds -2 to_power n <= h+i & h < 0 & i <
  0 & -2 to_power (n-'1) <= h & -2 to_power (n-'1) <= i implies carry(
  2sComplement(n+1,h),2sComplement(n+1,i))/.(n+1) = TRUE;

theorem 
  for n be non empty Nat st h + i <= 2 to_power (n-'1) - 1 & h >= 0 & i
  >= 0 holds Intval(2sComplement(n,h) + 2sComplement(n,i)) = h+i;

theorem 
  for n be non empty Nat st -2 to_power ((n+1)-'1) <= h + i & h < 0 & i
  < 0 & -2 to_power (n-'1) <= h & -2 to_power (n-'1) <= i holds Intval(
  2sComplement(n+1,h) + 2sComplement(n+1,i)) = h+i;

theorem 
  for n be non empty Nat holds -(2 to_power (n-'1)) <= h & h <= 2
to_power (n-'1) - 1 & -(2 to_power (n-'1)) <= i & i <= 2 to_power (n-'1) - 1 &
  -(2 to_power (n-'1)) <= h+i & h+i <= 2 to_power (n-'1) - 1 & ( h >= 0 & i < 0
or h < 0 & i >= 0 ) implies Intval(2sComplement(n,h) + 2sComplement(n,i)) = h+i
;














begin

begin 

registration
  let L be RelStr;
  cluster auxiliary(i) for Relation of L;
end;

registration
  let L be transitive RelStr;
  cluster auxiliary(i) auxiliary(ii) for Relation of L;
end;

registration
  let L be with_suprema antisymmetric RelStr;
  cluster auxiliary(iii) for Relation of L;
end;

registration
  let L be non empty lower-bounded antisymmetric RelStr;
  cluster auxiliary(iv) for Relation of L;
end;



definition
  let L be non empty RelStr, R be Relation of L;
  attr R is extra-order means


  R is auxiliary(i) auxiliary(ii) auxiliary(iv);
end;

registration
  let L be non empty RelStr;
  cluster extra-order -> auxiliary(i) auxiliary(ii) auxiliary(iv) for
Relation of
    L;
  cluster auxiliary(i) auxiliary(ii) auxiliary(iv) -> extra-order for
Relation of
    L;
end;

registration
  let L be non empty RelStr;
  cluster extra-order auxiliary(iii) -> auxiliary for Relation of L;
  cluster auxiliary -> extra-order for Relation of L;
end;

registration
  let L be lower-bounded antisymmetric transitive non empty RelStr;
  cluster extra-order for Relation of L;
end;

definition
  let L be lower-bounded with_suprema Poset, R be auxiliary(ii) Relation of L;
  func R-LowerMap -> Function of L, InclPoset LOWER L means


  for x being Element of L holds it.x = R-below x;
end;

registration
  let L be lower-bounded with_suprema Poset, R be auxiliary(ii) Relation of L;
  cluster R-LowerMap -> monotone;
end;

definition
  let L be 1-sorted, R be Relation of the carrier of L;
  mode strict_chain of R -> Subset of L means


    for x, y being set st x
    in it & y in it holds [x,y] in R or x = y or [y,x] in R;
end;

theorem 
  for L being 1-sorted, C being trivial Subset of L, R being
  Relation of the carrier of L holds C is strict_chain of R;

registration
  let L be non empty 1-sorted, R be Relation of the carrier of L;
  cluster 1-element for strict_chain of R;
end;

theorem 
  for L being antisymmetric RelStr, R being auxiliary(i) (Relation
of L), C being strict_chain of R, x, y being Element of L st x in C & y in C &
  x < y holds [x,y] in R;

theorem 
  for L being antisymmetric RelStr, R being auxiliary(i) (Relation of L)
  , x, y being Element of L st [x,y] in R & [y,x] in R holds x = y;

theorem 
  for L being non empty lower-bounded antisymmetric RelStr, x being
  Element of L, R being auxiliary(iv) Relation of L holds {Bottom L, x} is
  strict_chain of R;

theorem 
  for L being non empty lower-bounded antisymmetric RelStr, R being
auxiliary(iv) (Relation of L), C being strict_chain of R holds C \/ {Bottom L}
  is strict_chain of R;

definition
  let L be 1-sorted, R be (Relation of the carrier of L), C be strict_chain of
  R;
  attr C is maximal means


  for D being strict_chain of R st C c= D holds C = D;
end;

definition
  let L be 1-sorted, R be (Relation of the carrier of L), C be set;
  func Strict_Chains (R,C) means


  for x being set holds x in it iff x is strict_chain of R & C c= x;
end;

registration
  let L be 1-sorted, R be (Relation of the carrier of L), C be strict_chain of
  R;
  cluster Strict_Chains (R,C) -> non empty;
end;

notation
  let R be Relation, X be set;
  synonym X is_inductive_wrt R for X has_upper_Zorn_property_wrt R;
end;



theorem 
  for L being 1-sorted, R being (Relation of the carrier of L), C being
  strict_chain of R holds Strict_Chains (R,C) is_inductive_wrt RelIncl
Strict_Chains (R,C) & ex D being set st D is_maximal_in RelIncl Strict_Chains (
  R,C) & C c= D;





theorem 
  for L being non empty transitive RelStr, C being non empty
  Subset of L, X being Subset of C st ex_sup_of X,L & "\/"(X,L) in C holds
  ex_sup_of X,subrelstr C & "\/"(X,L) = "\/"(X,subrelstr C);



theorem 
  for L being non empty Poset, R being auxiliary(i) auxiliary(ii)
  (Relation of L), C being non empty strict_chain of R, X being Subset of C st
  ex_sup_of X,L & C is maximal holds ex_sup_of X,subrelstr C;



theorem 
  for L being non empty Poset, R being auxiliary(i) auxiliary(ii) (
  Relation of L), C being non empty strict_chain of R, X being Subset of C st
ex_inf_of (uparrow "\/"(X,L)) /\ C,L & ex_sup_of X,L & C is maximal holds "\/"(
X,subrelstr C) = "/\"((uparrow "\/"(X,L)) /\ C,L) & (not "\/"(X,L) in C implies
  "\/"(X,L) < "/\"((uparrow "\/"(X,L)) /\ C,L));



theorem 
  for L being complete non empty Poset, R being auxiliary(i)
  auxiliary(ii) (Relation of L), C being non empty strict_chain of R st C is
  maximal holds subrelstr C is complete;



theorem 
  for L being non empty lower-bounded antisymmetric RelStr, R being
auxiliary(iv) (Relation of L), C being strict_chain of R st C is maximal holds
  Bottom L in C;



theorem 
  for L being non empty upper-bounded Poset, R being auxiliary(ii) (
Relation of L), C being strict_chain of R, m being Element of L st C is maximal
  & m is_maximum_of C & [m,Top L] in R holds [Top L,Top L] in R & m = Top L;



definition
  let L be RelStr, C be set, R be Relation of the carrier of L;
  pred R satisfies_SIC_on C means


  for x, z being Element of L holds x
in C & z in C & [x,z] in R & x <> z implies ex y being Element of L st y in C &
  [x,y] in R & [y,z] in R & x <> y;
end;

definition
  let L be RelStr, R be (Relation of the carrier of L), C be strict_chain of R;
  attr C is satisfying_SIC means


  R satisfies_SIC_on C;
end;

theorem 
  for L being RelStr, C being set, R being auxiliary(i) (Relation
of L) st R satisfies_SIC_on C holds for x, z being Element of L holds x in C &
z in C & [x,z] in R & x <> z implies ex y being Element of L st y in C & [x,y]
  in R & [y,z] in R & x < y;

registration
  let L be RelStr, R be Relation of the carrier of L;
  cluster trivial -> satisfying_SIC for strict_chain of R;
end;

registration
  let L be non empty RelStr, R be Relation of the carrier of L;
  cluster 1-element for strict_chain of R;
end;



theorem 
  for L being lower-bounded with_suprema Poset, R being auxiliary(i)
auxiliary(ii) (Relation of L), C being strict_chain of R st C is maximal & R is
  satisfying_SI holds R satisfies_SIC_on C;

definition
  let R be Relation, C, y be set;
  func SetBelow (R,C,y) equals

  ( R"{y} ) /\ C;
end;

theorem 
  for R being Relation, C, x, y being set holds x in SetBelow (R,C
  ,y) iff [x,y] in R & x in C;

definition
  let L be 1-sorted, R be (Relation of the carrier of L), C, y be set;
  redefine func SetBelow (R,C,y) -> Subset of L;
end;

theorem 
  for L being RelStr, R being auxiliary(i) (Relation of L), C
  being set, y being Element of L holds SetBelow (R,C,y) is_<=_than y;

theorem 
  for L being reflexive transitive RelStr, R being auxiliary(ii) (
  Relation of L), C being Subset of L, x, y being Element of L st x <= y holds
  SetBelow (R,C,x) c= SetBelow (R,C,y);

theorem 
  for L being RelStr, R being auxiliary(i) (Relation of L), C
being set, x being Element of L st x in C & [x,x] in R & ex_sup_of SetBelow (R,
  C,x),L holds x = sup SetBelow (R,C,x);

definition
  let L be RelStr, C be Subset of L;
  attr C is sup-closed means


  for X being Subset of C st ex_sup_of X,L
  holds "\/"(X,L) = "\/"(X,subrelstr C);
end;



theorem 
  for L being complete non empty Poset, R being extra-order (
Relation of L), C being satisfying_SIC strict_chain of R, p, q being Element of
L st p in C & q in C & p < q ex y being Element of L st p < y & [y,q] in R & y
  = sup SetBelow (R,C,y);



theorem 
  for L being lower-bounded non empty Poset, R being extra-order (
Relation of L), C being non empty strict_chain of R st C is sup-closed & (for c
  being Element of L st c in C holds ex_sup_of SetBelow (R,C,c),L) & R
  satisfies_SIC_on C holds for c being Element of L st c in C holds c = sup
  SetBelow (R,C,c);



theorem 
  for L being non empty reflexive antisymmetric RelStr, R being
auxiliary(i) (Relation of L), C being strict_chain of R st (for c being Element
  of L st c in C holds ex_sup_of SetBelow (R,C,c),L & c = sup SetBelow (R,C,c))
  holds R satisfies_SIC_on C;

definition
  let L be non empty RelStr, R be (Relation of the carrier of L), C be set;
  func SupBelow (R,C) means


  for y being set holds y in it iff y = sup SetBelow (R,C,y);
end;

definition
  let L be non empty RelStr, R be (Relation of the carrier of L), C be set;
  redefine func SupBelow (R,C) -> Subset of L;
end;



theorem 
  for L being non empty reflexive transitive RelStr, R being
auxiliary(i) auxiliary(ii) (Relation of L), C being strict_chain of R st (for c
being Element of L holds ex_sup_of SetBelow (R,C,c),L) holds SupBelow (R,C) is
  strict_chain of R;



theorem 
  for L being non empty Poset, R being auxiliary(i) auxiliary(ii) (
  Relation of L), C being Subset of L st (for c being Element of L holds
  ex_sup_of SetBelow (R,C,c),L) holds SupBelow (R,C) is sup-closed;

theorem 
  for L being complete non empty Poset, R being extra-order (
Relation of L), C being satisfying_SIC strict_chain of R, d being Element of L
st d in SupBelow (R,C) holds d = "\/"({b where b is Element of L: b in SupBelow
  (R,C) & [b,d] in R},L);



theorem 
  for L being complete non empty Poset, R being extra-order (Relation of
L), C being satisfying_SIC strict_chain of R holds R satisfies_SIC_on SupBelow
  (R,C);



theorem 
  for L being complete non empty Poset, R being extra-order (Relation of
L), C being satisfying_SIC strict_chain of R, a, b being Element of L st a in C
& b in C & a < b ex d being Element of L st d in SupBelow (R,C) & a < d & [d,b]
  in R;














begin

reserve  X for non empty set,
  R for Relation of X;



theorem 
  for L being non empty reflexive antisymmetric RelStr for x,y being
  Element of L holds x <= y implies sup {x,y} = y & inf {x,y} = x;





registration
  let X be set;
  cluster irreflexive asymmetric transitive for Relation of X;
end;

registration
  let X, R;
  let C be UnOp of X;
  cluster OrthoRelStr(#X,R,C#) -> non empty;
end;

registration
  cluster non empty strict for OrthoRelStr;
end;



registration
  let O be set;
  cluster involutive for Function of O,O;
end;



definition
  func TrivOrthoRelStr -> strict OrthoRelStr equals


  OrthoRelStr (# 1, id 1, op1 #);
end;

notation
  synonym TrivPoset for TrivOrthoRelStr;
end;

registration
  cluster TrivOrthoRelStr -> 1-element;
end;

definition
  func TrivAsymOrthoRelStr -> strict OrthoRelStr equals

  OrthoRelStr (# 1, {}(1 ,1), op1 #);
end;

registration
  cluster TrivAsymOrthoRelStr -> non empty;
end;

definition
  let O be non empty OrthoRelStr;
  attr O is Dneg means


  ex f being Function of O,O st f = the Compl of O & f is involutive;
end;

registration
  cluster TrivOrthoRelStr -> Dneg;
end;

registration
  cluster Dneg for non empty OrthoRelStr;
end;



definition
  let O be non empty RelStr;
  attr O is SubReFlexive means


  the InternalRel of O is reflexive;
end;

reserve O for non empty RelStr;

theorem 
  O is reflexive implies O is SubReFlexive;

theorem 
  TrivOrthoRelStr is reflexive;

registration
  cluster TrivOrthoRelStr -> reflexive;
end;

registration
  cluster reflexive strict for non empty OrthoRelStr;
end;

definition
  let O;

  redefine attr O is irreflexive means


  the InternalRel of O is irreflexive;
  redefine attr O is irreflexive means


  the InternalRel of O is_irreflexive_in the carrier of O;
end;

theorem 
  TrivAsymOrthoRelStr is irreflexive;

registration
  cluster TrivAsymOrthoRelStr -> irreflexive;
end;

registration
  cluster irreflexive strict for non empty OrthoRelStr;
end;



definition
  let O be non empty RelStr;
  redefine attr O is symmetric means


  the InternalRel of O is symmetric Relation of the carrier of O;
end;

theorem 
  TrivOrthoRelStr is symmetric;

registration
  cluster symmetric strict for non empty OrthoRelStr;
end;



definition
  let O;

  redefine attr O is antisymmetric means

  the InternalRel of O is antisymmetric Relation of the carrier of O;
end;

registration
  cluster TrivOrthoRelStr -> symmetric;
end;

registration
  cluster symmetric antisymmetric strict for non empty OrthoRelStr;
end;



definition
  let O;

  redefine attr O is asymmetric means


  the InternalRel of O is_asymmetric_in the carrier of O;
end;

theorem 
  TrivAsymOrthoRelStr is asymmetric;

registration
  cluster TrivAsymOrthoRelStr -> asymmetric;
end;

registration
  cluster asymmetric strict for non empty OrthoRelStr;
end;



definition
  let O;
  redefine attr O is transitive means


  the InternalRel of O is transitive Relation of the carrier of O;
end;

registration
  cluster reflexive symmetric antisymmetric transitive strict for non empty
    OrthoRelStr;
end;

theorem 
  TrivAsymOrthoRelStr is transitive;

registration
  cluster TrivAsymOrthoRelStr -> irreflexive asymmetric transitive;
end;

registration
  cluster irreflexive asymmetric transitive strict for non empty OrthoRelStr;
end;

theorem 
  O is symmetric transitive implies O is SubReFlexive;

theorem 
  O is irreflexive transitive implies O is asymmetric;

theorem 
  O is asymmetric implies O is irreflexive;

begin



definition
  let O;

  attr O is SubQuasiOrdered means


  O is SubReFlexive transitive;
end;

notation
  let O;
  synonym O is SubPreOrdered for O is SubQuasiOrdered;
end;

definition
  let O;
  attr O is QuasiOrdered means


  O is reflexive transitive;
end;

notation
  let O;
  synonym O is PreOrdered for O is QuasiOrdered;
end;

theorem 
  O is QuasiOrdered implies O is SubQuasiOrdered;

registration
  cluster QuasiOrdered -> SubQuasiOrdered for non empty OrthoRelStr;
end;

registration
  cluster TrivOrthoRelStr -> QuasiOrdered;
end;

reserve O for non empty OrthoRelStr;



definition
  let O;
  attr O is QuasiPure means


  O is Dneg QuasiOrdered;
end;

registration
  cluster QuasiPure Dneg QuasiOrdered strict for non empty OrthoRelStr;
end;

registration
  cluster TrivOrthoRelStr -> QuasiPure;
end;

definition
  mode QuasiPureOrthoRelStr is QuasiPure non empty OrthoRelStr;
end;



definition

  let O;
  attr O is PartialOrdered means


  O is reflexive antisymmetric transitive;
end;

registration
  cluster PartialOrdered -> reflexive antisymmetric transitive for non empty
    OrthoRelStr;
  cluster reflexive antisymmetric transitive -> PartialOrdered for non empty
    OrthoRelStr;
end;



definition
  let O;
  attr O is Pure means


  O is Dneg PartialOrdered;
end;

registration
  cluster Pure Dneg PartialOrdered strict for non empty OrthoRelStr;
end;

registration
  cluster TrivOrthoRelStr -> Pure;
end;

definition
  mode PureOrthoRelStr is Pure non empty OrthoRelStr;
end;



definition

  let O;
  attr O is StrictPartialOrdered means


  O is asymmetric transitive;
end;

notation
  let O;
  synonym O is StrictOrdered for O is StrictPartialOrdered;
end;

theorem 
  O is StrictPartialOrdered implies O is irreflexive;

registration
  cluster StrictPartialOrdered -> irreflexive for non empty OrthoRelStr;
end;

registration
  cluster StrictPartialOrdered -> irreflexive for non empty OrthoRelStr;
end;

registration
  cluster TrivAsymOrthoRelStr -> irreflexive StrictPartialOrdered;
end;

registration
  cluster irreflexive StrictPartialOrdered for non empty strict OrthoRelStr;
end;



reserve QO for QuasiOrdered non empty OrthoRelStr;

theorem 
  QO is antisymmetric implies QO is PartialOrdered;

registration
  cluster PartialOrdered -> reflexive transitive antisymmetric for non empty
    OrthoRelStr;
end;

definition
  let PO be non empty RelStr;
  let f be UnOp of the carrier of PO;

  attr f is Orderinvolutive means


   f is involutive antitone;
end;

definition
  let PO be non empty OrthoRelStr;
  attr PO is OrderInvolutive means


   the Compl of PO is Orderinvolutive;
end;

theorem 
  the Compl of TrivOrthoRelStr is Orderinvolutive;

registration
  cluster TrivOrthoRelStr -> OrderInvolutive;
end;

registration
  cluster OrderInvolutive Pure PartialOrdered for non empty OrthoRelStr;
end;

definition
  mode PreOrthoPoset is OrderInvolutive Pure PartialOrdered non empty
    OrthoRelStr;
end;

definition
  let PO be non empty RelStr;
  let f be UnOp of the carrier of PO;
  pred f QuasiOrthoComplement_on PO means


  f is Orderinvolutive & for y
  being Element of PO holds ex_sup_of {y,f.y},PO & ex_inf_of {y,f.y},PO;
end;

definition
  let PO be non empty OrthoRelStr;
  attr PO is QuasiOrthocomplemented means


  ex f being Function of PO,PO
  st f = the Compl of PO & f QuasiOrthoComplement_on PO;
end;

theorem 
  TrivOrthoRelStr is QuasiOrthocomplemented;

definition
  let PO be non empty RelStr;
  let f be UnOp of the carrier of PO;
  pred f OrthoComplement_on PO means


  f is Orderinvolutive & for y
being Element of PO holds ex_sup_of {y,f.y},PO & ex_inf_of {y,f.y},PO & "\/"({y
,f.y},PO) is_maximum_of the carrier of PO & "/\"({y,f.y},PO) is_minimum_of the
  carrier of PO;
end;

definition
  let PO be non empty OrthoRelStr;
  attr PO is Orthocomplemented means


  ex f being Function of PO,PO st f
  = the Compl of PO & f OrthoComplement_on PO;
end;

theorem 
  for PO being non empty OrthoRelStr, f being UnOp of the carrier of PO
  st f OrthoComplement_on PO holds f QuasiOrthoComplement_on PO;



theorem 
  TrivOrthoRelStr is Orthocomplemented;

registration
  cluster TrivOrthoRelStr -> QuasiOrthocomplemented Orthocomplemented;
end;

registration
  cluster Orthocomplemented QuasiOrthocomplemented PartialOrdered for
non empty
    OrthoRelStr;
end;

definition
  mode QuasiOrthoPoset is QuasiOrthocomplemented PartialOrdered non empty
    OrthoRelStr;
  mode OrthoPoset is Orthocomplemented PartialOrdered non empty OrthoRelStr;
end;














begin 

reserve X for RealUnitarySpace;
reserve x for Point of X;
reserve i, n for Element of NAT;

definition
  let X such that
 the addF of X is commutative associative & the addF of X is having_a_unity;
  let Y be finite Subset of X;
  func setsum Y -> Element of X means


  ex p being FinSequence of the
  carrier of X st p is one-to-one & rng p = Y & it = (the addF of X) "**" p;
end;

theorem 
  for X st the addF of X is commutative associative & the addF of X
is having_a_unity for Y be finite Subset of X for I be Function of the carrier
of X,the carrier of X st Y c= dom I & for x be set st x in dom I holds I.x = x
holds setsum(Y) = setopfunc(Y, the carrier of X, the carrier of X, I, the addF
  of X);

theorem 
  for X st the addF of X is commutative associative & the addF of X
  is having_a_unity for Y1, Y2 be finite Subset of X st Y1 misses Y2 for Z be
  finite Subset of X st Z = Y1 \/ Y2 holds setsum(Z) = setsum(Y1) + setsum(Y2);

begin 

definition
  let X;
  let Y be Subset of X;
  attr Y is summable_set means


  ex x st for e be Real st e > 0 ex Y0 be
finite Subset of X st Y0 is non empty & Y0 c= Y & for Y1 be finite Subset of X
  st Y0 c= Y1 & Y1 c= Y holds ||.x-setsum(Y1).|| < e;
end;

definition
  let X;
  let Y be Subset of X;
  assume
 Y is summable_set;
  func sum Y -> Point of X means

  for e be Real st e > 0 ex Y0 be finite Subset
of X st Y0 is non empty & Y0 c= Y & for Y1 be finite Subset of X st Y0 c= Y1 &
  Y1 c= Y holds ||.it-setsum(Y1).|| < e;
end;

definition
  let X;
  let L be linear-Functional of X;
  attr L is Lipschitzian means


  ex K be Real st K > 0 & for x holds abs(L.x) <= K * ||.x.||;
end;

definition
  let X;
  let Y be Subset of X;
  attr Y is weakly_summable_set means


  ex x st for L be
  linear-Functional of X st L is Lipschitzian for e be Real st e > 0
  ex Y0 be finite
  Subset of X st Y0 is non empty & Y0 c= Y & for Y1 be finite Subset of X st Y0
  c= Y1 & Y1 c= Y holds abs(L.(x-setsum(Y1))) < e;
end;

definition
  let X;
  let Y be Subset of X;
  let L be Functional of X;
  pred Y is_summable_set_by L means


  ex r be Real st for e be Real st e
> 0 ex Y0 be finite Subset of X st Y0 is non empty & Y0 c= Y & for Y1 be finite
  Subset of X st Y0 c= Y1 & Y1 c= Y holds abs(r-setopfunc(Y1,the carrier of X,
  REAL, L, addreal)) < e;
end;

definition
  let X;
  let Y be Subset of X;
  let L be Functional of X;
  assume
 Y is_summable_set_by L;
  func sum_byfunc(Y,L) -> Real means

  for e be Real st e > 0 ex Y0 be finite
  Subset of X st Y0 is non empty & Y0 c= Y & for Y1 be finite Subset of X st Y0
c= Y1 & Y1 c= Y holds abs(it-setopfunc(Y1,the carrier of X,REAL, L, addreal)) <
  e;
end;

theorem 
  for Y be Subset of X st Y is summable_set holds Y is weakly_summable_set;

theorem 
  for L be linear-Functional of X for p be FinSequence of the
carrier of X st len p >=1 for q be FinSequence of REAL st dom p = dom q & (for
  i st i in dom q holds q.i = L.(p.i) ) holds L.((the addF of X) "**" p) =
  addreal "**" q;

theorem 
  for X st the addF of X is commutative associative & the addF of X
  is having_a_unity for S be finite Subset of X st S is non empty for L be
linear-Functional of X holds L.(setsum(S)) = setopfunc(S,the carrier of X,REAL,
  L, addreal);

theorem 
  for X st the addF of X is commutative associative & the addF of X
  is having_a_unity for Y be Subset of X holds Y is weakly_summable_set implies
ex x st for L be linear-Functional of X st L is Lipschitzian for e be Real st
e > 0
  ex Y0 be finite Subset of X st Y0 is non empty & Y0 c= Y & for Y1 be finite
Subset of X st Y0 c= Y1 & Y1 c= Y holds abs((L.x)-(setopfunc(Y1,the carrier of
  X,REAL, L, addreal))) < e;

theorem 
  for X st the addF of X is commutative associative & the addF of X
  is having_a_unity for Y be Subset of X st Y is weakly_summable_set for L be
  linear-Functional of X st L is Lipschitzian holds Y is_summable_set_by L;

theorem 
  for X st the addF of X is commutative associative & the addF of X is
  having_a_unity for Y be Subset of X st Y is summable_set for L be
linear-Functional of X st L is Lipschitzian holds Y is_summable_set_by L;

theorem 
  for Y be finite Subset of X st Y is non empty holds Y is summable_set;

begin 

theorem 
  for X being RealHilbertSpace
   st the addF of X is commutative associative & the addF of X is
having_a_unity for Y be Subset of X holds Y is summable_set iff
  for e be Real st e > 0 holds ex Y0 be finite Subset of X st Y0 is non empty &
Y0 c= Y & for Y1 be finite Subset of X st Y1 is non empty & Y1 c= Y & Y0 misses
  Y1 holds ||.setsum(Y1).|| < e;














begin





definition
  let n be Nat;
  let x,y be FinSequence;
  func n-BitSubtracterStr(x,y) ->
  unsplit gate`1=arity gate`2isBoolean non void strict
  non empty ManySortedSign means


  ex f,g being ManySortedSet of NAT st
  it = f.n & f.0 = 1GateCircStr(<*>,(0-tuples_on BOOLEAN)-->TRUE) &
  g.0 = [<*>, (0-tuples_on BOOLEAN)-->TRUE] &
  for n being Nat, S being non empty ManySortedSign, z be set
  st S = f.n & z = g.n
  holds f.(n+1) = S +* BitSubtracterWithBorrowStr(x .(n+1), y.(n+1), z) &
  g.(n+1) = BorrowOutput(x .(n+1), y.(n+1), z);
end;

definition
  let n be Nat;
  let x,y be FinSequence;
  func n-BitSubtracterCirc(x,y) ->
  Boolean gate`2=den strict Circuit of n-BitSubtracterStr(x,y) means


  ex f,g,h being ManySortedSet of NAT st
  n-BitSubtracterStr(x,y) = f.n & it = g.n &
  f.0 = 1GateCircStr(<*>,(0-tuples_on BOOLEAN)-->TRUE) &
  g.0 = 1GateCircuit(<*>,(0-tuples_on BOOLEAN)-->TRUE) &
  h.0 = [<*>, (0-tuples_on BOOLEAN)-->TRUE] &
  for n being Nat, S being non empty ManySortedSign,
  A being non-empty MSAlgebra over S
  for z being set st S = f.n & A = g.n & z = h.n holds
  f.(n+1) = S +* BitSubtracterWithBorrowStr(x .(n+1), y.(n+1), z) &
  g.(n+1) = A +* BitSubtracterWithBorrowCirc(x .(n+1), y.(n+1), z) &
  h.(n+1) = BorrowOutput(x .(n+1), y.(n+1), z);
end;

definition
  let n be Nat;
  let x,y be FinSequence;
  func n-BitBorrowOutput(x,y) ->
  Element of InnerVertices (n-BitSubtracterStr(x,y)) means


  ex h being ManySortedSet of NAT st
  it = h.n & h.0 = [<*>, (0-tuples_on BOOLEAN)-->TRUE] &
  for n being Nat holds h.(n+1)
  = BorrowOutput(x .(n+1), y.(n+1), h.n);
end;





theorem 
  for x,y being FinSequence, f,g,h being ManySortedSet of NAT st
  f.0 = 1GateCircStr(<*>,(0-tuples_on BOOLEAN)-->TRUE) &
  g.0 = 1GateCircuit(<*>,(0-tuples_on BOOLEAN)-->TRUE) &
  h.0 = [<*>, (0-tuples_on BOOLEAN)-->TRUE] &
  for n being Nat, S being non empty ManySortedSign,
  A being non-empty MSAlgebra over S
  for z being set st S = f.n & A = g.n & z = h.n holds
  f.(n+1) = S +* BitSubtracterWithBorrowStr(x .(n+1), y.(n+1), z) &
  g.(n+1) = A +* BitSubtracterWithBorrowCirc(x .(n+1), y.(n+1), z) &
  h.(n+1) = BorrowOutput(x .(n+1), y.(n+1), z)
  for n being Nat holds
  n-BitSubtracterStr(x,y) = f.n & n-BitSubtracterCirc(x,y) = g.n &
  n-BitBorrowOutput(x,y) = h.n;

theorem 
  for a,b being FinSequence holds
  0-BitSubtracterStr(a,b) = 1GateCircStr(<*>,(0-tuples_on BOOLEAN)-->TRUE) &
  0-BitSubtracterCirc(a,b) = 1GateCircuit(<*>,(0-tuples_on BOOLEAN)-->TRUE) &
  0-BitBorrowOutput(a,b) = [<*>, (0-tuples_on BOOLEAN)-->TRUE];

theorem 
  for a,b being FinSequence, c being set st
  c = [<*>, (0-tuples_on BOOLEAN)-->TRUE] holds
  1-BitSubtracterStr(a,b) = 1GateCircStr(<*>, (0-tuples_on BOOLEAN)-->TRUE)+*
  BitSubtracterWithBorrowStr(a.1, b.1, c) &
  1-BitSubtracterCirc(a,b) = 1GateCircuit(<*>, (0-tuples_on BOOLEAN)-->TRUE)+*
  BitSubtracterWithBorrowCirc(a.1, b.1, c) &
  1-BitBorrowOutput(a,b) = BorrowOutput(a.1, b.1, c);

theorem 
  for a,b,c being set st c = [<*>, (0-tuples_on BOOLEAN)-->TRUE] holds
  1-BitSubtracterStr(<*a*>,<*b*>)
  = 1GateCircStr(<*>, (0-tuples_on BOOLEAN)-->TRUE)
  +* BitSubtracterWithBorrowStr(a, b, c) & 1-BitSubtracterCirc(<*a*>,<*b*>)
  = 1GateCircuit(<*>, (0-tuples_on BOOLEAN)-->TRUE)
  +* BitSubtracterWithBorrowCirc(a, b, c) & 1-BitBorrowOutput(<*a*>,<*b*>)
  = BorrowOutput(a, b, c);

theorem 
  for n be Element of NAT for p,q being FinSeqLen of n
  for p1,p2, q1,q2 being FinSequence holds
  n-BitSubtracterStr(p^p1, q^q1) = n-BitSubtracterStr(p^p2, q^q2) &
  n-BitSubtracterCirc(p^p1, q^q1) = n-BitSubtracterCirc(p^p2, q^q2) &
  n-BitBorrowOutput(p^p1, q^q1) = n-BitBorrowOutput(p^p2, q^q2);

theorem 
  for n be Element of NAT for x,y being FinSeqLen of n for a,b being set holds
  (n+1)-BitSubtracterStr(x^<*a*>, y^<*b*>) = n-BitSubtracterStr(x, y) +*
  BitSubtracterWithBorrowStr(a, b, n-BitBorrowOutput(x, y)) &
  (n+1)-BitSubtracterCirc(x^<*a*>, y^<*b*>) = n-BitSubtracterCirc(x, y) +*
  BitSubtracterWithBorrowCirc(a, b, n-BitBorrowOutput(x, y)) &
  (n+1)-BitBorrowOutput(x^<*a*>, y^<*b*>) =
  BorrowOutput(a, b, n-BitBorrowOutput(x, y));

theorem 
  for n be Element of NAT for x,y being FinSequence holds
  (n+1)-BitSubtracterStr(x, y) = n-BitSubtracterStr(x, y) +*
  BitSubtracterWithBorrowStr(x .(n+1), y.(n+1), n-BitBorrowOutput(x, y)) &
  (n+1)-BitSubtracterCirc(x, y) = n-BitSubtracterCirc(x, y) +*
  BitSubtracterWithBorrowCirc(x .(n+1), y.(n+1), n-BitBorrowOutput(x, y)) &
  (n+1)-BitBorrowOutput(x, y) =
  BorrowOutput(x .(n+1), y.(n+1), n-BitBorrowOutput(x, y));





theorem 
  for n,m be Element of NAT st n <= m for x,y being FinSequence holds
  InnerVertices (n-BitSubtracterStr(x,y)) c=
  InnerVertices (m-BitSubtracterStr(x,y));

theorem 
  for n be Element of NAT for x,y being FinSequence holds
  InnerVertices ((n+1)-BitSubtracterStr(x,y)) =
  InnerVertices (n-BitSubtracterStr(x,y)) \/
  InnerVertices BitSubtracterWithBorrowStr(x .(n+1), y.(n+1),
  n-BitBorrowOutput(x,y));

definition
  let k,n be Element of NAT such that
 k >= 1 and
 k <= n;
  let x,y be FinSequence;
  func (k,n)-BitSubtracterOutput(x,y) ->
  Element of InnerVertices (n-BitSubtracterStr(x,y)) means


  ex i being Element of NAT st k = i+1 &
  it = BitSubtracterOutput(x .k, y.k, i-BitBorrowOutput(x,y));
end;

theorem 
  for n,k being Element of NAT st k < n for x,y being FinSequence holds
  (k+1,n)-BitSubtracterOutput(x,y) =
  BitSubtracterOutput(x .(k+1), y.(k+1), k-BitBorrowOutput(x,y));

theorem 
  for n being Element of NAT for x,y being FinSequence holds
  InnerVertices (n-BitSubtracterStr(x,y)) is Relation;

theorem 
  for x,y,c being set holds InnerVertices BorrowIStr(x,y,c) =
  {[<*x,y*>,and2a], [<*y,c*>,and2], [<*x,c*>,and2a]};

theorem 
  for x,y,c being set st
  x <> [<*y,c*>, and2] & y <> [<*x,c*>, and2a] & c <> [<*x,y*>, and2a]
  holds InputVertices BorrowIStr(x,y,c) = {x,y,c};

theorem 
  for x,y,c being set holds InnerVertices BorrowStr(x,y,c) =
  {[<*x,y*>,and2a], [<*y,c*>,and2], [<*x,c*>,and2a]} \/ {BorrowOutput(x,y,c)};

theorem 
  for x,y,c being set st
  x <> [<*y,c*>, and2] & y <> [<*x,c*>, and2a] & c <> [<*x,y*>, and2a]
  holds InputVertices BorrowStr(x,y,c) = {x,y,c};

theorem 
  for x,y,c being set st
  x <> [<*y,c*>, and2] & y <> [<*x,c*>, and2a] & c <> [<*x,y*>, and2a] &
  c <> [<*x,y*>, 'xor'] holds
  InputVertices BitSubtracterWithBorrowStr(x,y,c) = {x,y,c};

theorem 
  for x,y,c being set holds InnerVertices BitSubtracterWithBorrowStr(x,y,c) =
  {[<*x,y*>, 'xor'], 2GatesCircOutput(x,y,c,'xor')} \/
  {[<*x,y*>,and2a],[<*y,c*>,and2],[<*x,c*>,and2a]} \/ {BorrowOutput(x,y,c)};

registration
  let n be Element of NAT;
  let x,y be FinSequence;
  cluster n-BitBorrowOutput(x,y) -> pair;
end;

theorem 
  for x,y being FinSequence, n being Element of NAT holds
  (n-BitBorrowOutput(x,y))`1 = <*> &
  (n-BitBorrowOutput(x,y))`2 = (0-tuples_on BOOLEAN)-->TRUE &
  proj1 (n-BitBorrowOutput(x,y))`2 = 0-tuples_on BOOLEAN or
  card (n-BitBorrowOutput(x,y))`1 = 3 & (n-BitBorrowOutput(x,y))`2 = or3 &
  proj1 (n-BitBorrowOutput(x,y))`2 = 3-tuples_on BOOLEAN;

theorem 
  for n being Element of NAT, x,y being FinSequence, p being set holds
  n-BitBorrowOutput(x,y) <> [p, and2] & n-BitBorrowOutput(x,y) <> [p, and2a] &
  n-BitBorrowOutput(x,y) <> [p, 'xor'];





theorem 
  for f,g being nonpair-yielding FinSequence for n being Element of NAT holds
  InputVertices ((n+1)-BitSubtracterStr(f,g)) =
  (InputVertices (n-BitSubtracterStr(f,g)))\/
  ((InputVertices BitSubtracterWithBorrowStr(f.(n+1),g.(n+1),
  n-BitBorrowOutput(f,g)) \ {n-BitBorrowOutput(f,g)})) &
  InnerVertices (n-BitSubtracterStr(f,g)) is Relation &
  InputVertices (n-BitSubtracterStr(f,g)) is without_pairs;

theorem 
  for n being Element of NAT
  for x,y being nonpair-yielding FinSeqLen of n holds
  InputVertices (n-BitSubtracterStr(x,y)) = rng x \/ rng y;

theorem 
  for x,y,c being set for s being State of BorrowCirc(x,y,c)
  for a1,a2,a3 being Element of BOOLEAN st
  a1 = s.[<*x,y*>,and2a] & a2 = s.[<*y,c*>,and2] & a3 = s.[<*x,c*>,and2a]
  holds (Following s).BorrowOutput(x,y,c) = a1 'or' a2 'or' a3;

theorem 
  for x,y,c being set st
  x <> [<*y,c*>, and2] & y <> [<*x,c*>, and2a] & c <> [<*x,y*>, and2a]
  for s being State of BorrowCirc(x,y,c)
  holds Following(s,2) is stable;

theorem 
  for x,y,c being set st
  x <> [<*y,c*>, and2] & y <> [<*x,c*>, and2a] & c <> [<*x,y*>, and2a] &
  c <> [<*x,y*>, 'xor']
  for s being State of BitSubtracterWithBorrowCirc(x,y,c)
  for a1,a2,a3 being Element of BOOLEAN st a1 = s.x & a2 = s.y & a3 = s.c holds
  (Following(s,2)).BitSubtracterOutput(x,y,c) = a1 'xor' a2 'xor' a3 &
  (Following(s,2)).BorrowOutput(x,y,c)
  = 'not' a1 '&' a2 'or' a2 '&' a3 'or' 'not' a1 '&' a3;

theorem 
  for x,y,c being set st
  x <> [<*y,c*>, and2] & y <> [<*x,c*>, and2a] & c <> [<*x,y*>, and2a] &
  c <> [<*x,y*>, 'xor']
  for s being State of BitSubtracterWithBorrowCirc(x,y,c)
  holds Following(s,2) is stable;

theorem 
  for n being Element of NAT for x,y being nonpair-yielding FinSeqLen of n
  for s being State of n-BitSubtracterCirc(x,y)
  holds Following(s,1+2*n) is stable;














begin  

reserve x,y,X for set,
  i,j,k,m,n for Element of NAT,
  p for FinSequence of X,
  ii for Integer;

theorem 
  for p being FinSequence,x being set holds not x in rng p & p is
  one-to-one iff p^<*x*> is one-to-one;

theorem 
  1 <= ii & ii <= len p implies p.ii in X;

theorem 
  1 <= ii & ii <= len p implies p/.ii = p.ii;

reserve G for Graph,
  pe,qe for FinSequence of the carrier' of G,
  p,q for oriented Chain of G,
  W for Function,
  U,V,e,ee for set,
  v1,v2,v3,v4 for Vertex of G;

theorem 
  W is_weight_of G & len pe = 1 implies cost(pe,W) = W.(pe.1);

theorem 
  e in the carrier' of G implies <*e*> is Simple oriented Chain of G;

theorem 
  for p being Simple oriented Chain of G st p=pe^qe & len pe >= 1
& len qe >= 1 holds (the Target of G).(p.len p) <> (the Target of G).(pe.len pe
  ) & (the Source of G).(p.1) <> (the Source of G).(qe.1);

begin 

theorem 
  p is_orientedpath_of v1,v2,V iff p is_orientedpath_of v1,v2,V \/ {v2};

theorem 
  p is_shortestpath_of v1,v2,V,W iff p is_shortestpath_of v1,v2,V \/{v2},W;

theorem 
  p is_shortestpath_of v1,v2,V,W & q is_shortestpath_of v1,v2,V,W
  implies cost(p,W)=cost(q,W);

theorem 
  for G being oriented Graph,v1,v2 be Vertex of G,e1,e2 be set st
e1 in the carrier' of G & e2 in the carrier' of G & e1 orientedly_joins v1,v2 &
  e2 orientedly_joins v1,v2 holds e1=e2;

theorem 
  the carrier of G= U \/ V & v1 in U & v2 in V & (for v3,v4 st v3
  in U & v4 in V holds not (ex e st e in the carrier' of G & e orientedly_joins
  v3,v4)) implies not ex p st p is_orientedpath_of v1,v2;

theorem 
  the carrier of G= U \/ V & v1 in U & (for v3,v4 st v3 in U & v4
in V holds not (ex e st e in the carrier' of G & e orientedly_joins v3,v4)) & p
  is_orientedpath_of v1,v2 implies p is_orientedpath_of v1,v2,U;

begin 

reserve G for finite Graph,
  P,Q for oriented Chain of G,
  v1,v2,v3 for Vertex of G;

theorem 
  W is_weight>=0of G & P is_shortestpath_of v1,v2,V,W & v1 <> v2 &
v1 <> v3 & Q is_shortestpath_of v1,v3,V,W & not (ex e st e in the carrier' of G
  & e orientedly_joins v2,v3) & P islongestInShortestpath V,v1,W implies Q
  is_shortestpath_of v1,v3,V \/{v2},W;

reserve G for finite oriented Graph,
  P,Q for oriented Chain of G,
  W for Function of (the carrier' of G), Real>=0,
  v1,v2,v3,v4 for Vertex of G;

theorem 
  e in the carrier' of G & P=<*e*> & e orientedly_joins v1,v2
  implies P is_shortestpath_of v1,v2,{v1},W;

theorem 
  e in the carrier' of G & P is_shortestpath_of v1,v2,V,W & v1 <>
v3 & Q=P^<*e*> & e orientedly_joins v2,v3 & v1 in V & (for v4 st v4 in V holds
  not (ex ee st ee in the carrier' of G & ee orientedly_joins v4,v3)) implies Q
  is_shortestpath_of v1,v3,V \/{v2},W;

theorem 
  the carrier of G= U \/ V & v1 in U & (for v3,v4 st v3 in U & v4
  in V holds not (ex e st e in the carrier' of G & e orientedly_joins v3,v4))
  implies (P is_shortestpath_of v1,v2,U,W iff P is_shortestpath_of v1,v2,W);

begin  

notation
  let f be Function, i, x be set;
  synonym (f,i):=x for f+*(i,x);
end;

definition
  let f be FinSequence of REAL, x be set, r be Real;
  redefine func (f, x):=r -> FinSequence of REAL;
end;

definition
  let i,k be Element of NAT,f be FinSequence of REAL,r be Real;
  func (f,i):=(k,r) -> FinSequence of REAL equals

  ((f,i):=k,k):=r;
end;

reserve f,g,h for Element of REAL*,
  r for Real;

theorem 
  i <> k & i in dom f implies ((f,i):=(k,r)).i = k;

theorem 
  m <> i & m <> k implies ((f,i):=(k,r)).m = f.m;

theorem 
  k in dom f implies ((f,i):=(k,r)).k = r;

theorem 
  dom ((f,i):=(k,r)) = dom f;

begin  

definition
  let X be set,f,g be Element of Funcs(X,X);
  redefine func g*f -> Element of Funcs(X,X);
end;

definition
  let X be set,f be Element of Funcs(X,X),g be Element of X;
  redefine func f.g -> Element of X;
end;

definition
  let X be set, f be Element of Funcs(X,X);
  func repeat(f) -> Function of NAT,Funcs(X,X) means


  it.0 = id X & for i being Nat holds it.(i+1)=f*(it.i);
end;

theorem 
  for F being Element of Funcs(REAL*,REAL*), f being Element of
  REAL*,n,i be Element of NAT holds (repeat F).0 .f = f;

theorem 
  for F,G being Element of Funcs(REAL*,REAL*),f being Element of
REAL*, i be Element of NAT holds (repeat (F*G)).(i+1).f = F.(G.((repeat (F*G)).
  i.f));

definition
  let g be Element of Funcs(REAL*,REAL*),f be Element of REAL*;
  redefine func g.f -> Element of REAL*;
end;

definition
  let f be Element of REAL*, n be Nat;
  func OuterVx(f,n) -> Subset of NAT equals

  {i: i in dom f & 1 <= i & i <= n &
  f.i <> -1 & f.(n+i) <> -1};
end;

definition
  let f be Element of Funcs(REAL*,REAL*),g be Element of REAL*, n be Nat;
  assume
 ex i st OuterVx((repeat f).i.g,n) = {};
  func LifeSpan(f,g,n) -> Element of NAT means


  OuterVx((repeat f).it.g,
  n) = {} & for k being Nat st OuterVx((repeat f).k.g,n) = {} holds it <= k;
end;

definition
  let f be Element of Funcs(REAL*,REAL*), n be Element of NAT;
  func while_do(f,n) -> Element of Funcs(REAL*,REAL*) means


  dom it=REAL
  * & for h being Element of REAL* holds it.h=(repeat f).LifeSpan(f,h,n).h;
end;

begin 

definition
  let G be oriented Graph,v1,v2 be Vertex of G;
  assume
 ex e be set st e in the carrier' of G & e orientedly_joins v1,v2;
  func XEdge(v1,v2) means


  ex e be set st it = e & e in the carrier' of G & e orientedly_joins v1,v2;
end;

definition
  let G be oriented Graph,v1,v2 be Vertex of G, W be Function;
  func Weight(v1,v2,W) equals


  W.XEdge(v1,v2) if ex e be set st e in the
  carrier' of G & e orientedly_joins v1,v2 otherwise -1;
end;

definition
  let G be oriented Graph,v1,v2 be Vertex of G, W be Function of (the carrier'
  of G), Real>=0;
  redefine func Weight(v1,v2,W) -> Real;
end;

reserve G for oriented Graph,
  v1,v2 for Vertex of G,
  W for Function of (the carrier' of G), Real>=0;

theorem 
  Weight(v1,v2,W) >= 0 iff ex e be set st e in the carrier' of G &
  e orientedly_joins v1,v2;

theorem 
  Weight(v1,v2,W) = -1 iff not ex e be set st e in the carrier' of G & e
  orientedly_joins v1,v2;

theorem 
  e in the carrier' of G & e orientedly_joins v1,v2 implies Weight
  (v1,v2,W)=W.e;

begin 

definition
  let f be Element of REAL*, n be Element of NAT;
  func UnusedVx(f,n) -> Subset of NAT equals

  {i: i in dom f & 1 <= i & i <= n
  & f.i <> -1};
end;

definition
  let f be Element of REAL*, n be Element of NAT;
  func UsedVx(f,n) -> Subset of NAT equals

  {i: i in dom f & 1 <= i & i <= n &
  f.i = -1};
end;

theorem 
  UnusedVx(f,n) c= Seg n;

registration
  let f be Element of REAL*, n be Element of NAT;
  cluster UnusedVx(f,n) -> finite;
end;

theorem 
  OuterVx(f,n) c= UnusedVx(f,n);

theorem 
  OuterVx(f,n) c= Seg n;

registration
  let f be Element of REAL*, n be Element of NAT;
  cluster OuterVx(f,n) -> finite;
end;

definition
  let X be finite Subset of NAT,f be Element of REAL*,n;
  func Argmin(X,f,n) -> Element of NAT means


  (X<>{} implies ex i st i=
it & i in X & (for k st k in X holds f/.(2*n+i) <= f/.(2*n+k)) & for k st k in
  X & f/.(2*n+i) = f/.(2*n+k) holds i <= k ) & (X={} implies it=0);
end;

theorem 
  OuterVx(f,n) <> {} & j=Argmin(OuterVx(f,n),f,n) implies j in dom
  f & 1<=j & j<=n & f.j <> -1 & f.(n+j) <> -1;

theorem 
  Argmin(OuterVx(f,n),f,n) <= n;

definition
  let n be Element of NAT;
  func findmin(n) -> Element of Funcs(REAL*,REAL*) means


  dom it = REAL
* & for f be Element of REAL* holds it.f= (f,n*n+3*n+1) := (Argmin(OuterVx(f,n)
  ,f,n),-1);
end;

theorem 
  i > n & i <> n*n+3*n+1 implies (findmin n).f.i=f.i;

theorem 
  i in dom f & f.i=-1 & i <> n*n+3*n+1 implies (findmin n).f.i=-1;

theorem 
  dom ((findmin n).f) = dom f;

theorem 
  OuterVx(f,n) <> {} implies ex j st j in OuterVx(f,n) & 1 <= j &
  j <= n & (findmin n).f.j=-1;

definition
  let f be Element of REAL*,n,k be Element of NAT;
  func newpathcost(f,n,k) -> Real equals

  f/.(2*n+f/.(n*n+3*n+1))+ f/.(2*n+n*(f
  /.(n*n+3*n+1))+k);
end;

definition
  let n,k be Element of NAT,f be Element of REAL*;
  pred f hasBetterPathAt n,k means


  (f.(n+k)=-1 or f/.(2*n+k) >
  newpathcost(f,n,k)) & f/.(2*n+n*(f/.(n*n+3*n+1))+k) >= 0 & f.k <> -1;
end;

definition
  let f be Element of REAL*,n be Element of NAT;
  func Relax(f,n) -> Element of REAL* means


  dom it = dom f & for k be
Element of NAT st k in dom f holds (n<k & k <= 2*n implies (f hasBetterPathAt n
,(k-'n) implies it.k=f/.(n*n+3*n+1)) & (not f hasBetterPathAt n,(k-'n) implies
it.k=f.k)) & (2*n <k & k <=3*n implies (f hasBetterPathAt n,(k-'2*n) implies it
.k=newpathcost(f,n,k-'2*n)) & (not f hasBetterPathAt n,(k-'2*n) implies it.k=f.
  k)) & (k<=n or k > 3*n implies it.k=f.k);
end;

definition
  let n be Element of NAT;
  func Relax(n) -> Element of Funcs(REAL*,REAL*) means


  dom it = REAL* & for f be Element of REAL* holds it.f=Relax(f,n);
end;

theorem 
  dom ((Relax n).f) = dom f;

theorem 
  (i <= n or i > 3*n) & i in dom f implies (Relax n).f.i=f.i;

theorem 
  dom ((repeat(Relax(n)*findmin(n))).i.f) = dom ((repeat(Relax(n)*
  findmin(n))).(i+1).f);

theorem 
  OuterVx((repeat(Relax(n)*findmin(n))).i.f,n) <> {} implies
UnusedVx((repeat(Relax(n)*findmin(n))).(i+1).f,n) c< UnusedVx((repeat(Relax(n)*
  findmin(n))).i.f,n);

theorem 
  g=(repeat(Relax(n)*findmin(n))).i.f & h=(repeat(Relax(n)*findmin
(n))).(i+1).f & k=Argmin(OuterVx(g,n),g,n) & OuterVx(g,n) <> {} implies UsedVx(
  h,n)=UsedVx(g,n) \/ {k} & not k in UsedVx(g,n);

theorem 
  ex i st i<=n & OuterVx((repeat(Relax(n)*findmin(n))).i.f,n) = {};

theorem 
  dom f = dom ((repeat(Relax(n)*findmin(n))).i.f);

definition
  let f,g be Element of REAL*,m,n;
  pred f,g equal_at m,n means


  dom f = dom g & for k st k in dom f & m <=k & k <= n holds f.k=g.k;
end;

theorem 
  f,f equal_at m,n;

theorem 
  f,g equal_at m,n & g,h equal_at m,n implies f,h equal_at m,n;

theorem 
  (repeat(Relax(n)*findmin(n))).i.f, (repeat(Relax(n)*findmin(n)))
  .(i+1).f equal_at 3*n+1,n*n+3*n;

theorem 
  for F being Element of Funcs(REAL*,REAL*),f being Element of REAL*, n,
  i be Element of NAT st i < LifeSpan(F,f,n) holds OuterVx((repeat F).i.f,n) <>
  {};

theorem 
  f, (repeat(Relax(n)*findmin(n))).i.f equal_at 3*n+1,n*n+3*n;

theorem 
  1<=n & 1 in dom f & f.(n+1) <> -1 & (for i st 1<=i & i<=n holds
f.i=1) & (for i st 2<=i & i<=n holds f.(n+i)=-1) implies 1 = Argmin(OuterVx(f,n
  ),f,n) & UsedVx(f,n)={} & {1} = UsedVx((repeat(Relax(n)*findmin(n))).1.f,n);

theorem 
  g=(repeat(Relax(n)*findmin(n))).1.f & h=(repeat(Relax(n)*findmin
  (n))).i.f & 1<=i & i <= LifeSpan(Relax(n)*findmin(n),f,n) & m in UsedVx(g,n)
  implies m in UsedVx(h,n);

definition
  let p be FinSequence of NAT,f be Element of REAL*,i,n be Element of NAT;
  pred p is_vertex_seq_at f,i,n means


  p.(len p)=i & for k st 1<=k & k
  < len p holds p.(len p-k)=f.(n+p/.(len p-k+1));
end;

definition
  let p be FinSequence of NAT,f be Element of REAL*,i,n be Element of NAT;
  pred p is_simple_vertex_seq_at f,i,n means


  p.1=1 & len p > 1 & p is_vertex_seq_at f,i,n & p is one-to-one;
end;

theorem 
  for p,q being FinSequence of NAT,f be Element of REAL*,i,n be Element
  of NAT st p is_simple_vertex_seq_at f,i,n & q is_simple_vertex_seq_at f,i,n
  holds p = q;

definition
  let G be Graph,p be FinSequence of the carrier' of G,vs be FinSequence;
  pred p is_oriented_edge_seq_of vs means


  len vs = len p + 1 & for n
be Nat st 1<=n & n<=len p holds (the Source of G).(p.n) = vs.n & (the Target of
  G).(p.n) = vs.(n+1);
end;

theorem 
  for G being oriented Graph,vs be FinSequence,p,q being oriented Chain
  of G st p is_oriented_edge_seq_of vs & q is_oriented_edge_seq_of vs holds p=q
;

theorem 
  for G being Graph,vs1,vs2 be FinSequence,p being oriented Chain of G
  st p is_oriented_edge_seq_of vs1 & p is_oriented_edge_seq_of vs2 & len p >= 1
  holds vs1=vs2;

begin 





















definition
  let f be Element of REAL*,G be oriented Graph,n be Element of NAT, W be
  Function of (the carrier' of G), Real>=0;
  pred f is_Input_of_Dijkstra_Alg G,n,W means


  len f=n*n+3*n+1 & Seg n=
the carrier of G & (for i st 1 <= i & i <= n holds f.i=1 & f.(2*n+i)=0) & f.(n+
1)=0 & (for i st 2 <= i & i <= n holds f.(n+i)=-1) & for i,j being Vertex of G,
  k,m st k=i & m=j holds f.(2*n+n*k+m)=Weight(i,j,W);
end;

begin 

definition
  let n be Element of NAT;
  func DijkstraAlgorithm n -> Element of Funcs(REAL*,REAL*) equals

  while_do(
  Relax(n)*findmin(n),n);
end;

begin 

reserve p,q for FinSequence of NAT,
  G for finite oriented Graph,
  P,Q,R for oriented Chain of G,
  W for Function of (the carrier' of G), Real>=0,
  v1,v2,v3, v4 for Vertex of G;

theorem 
  f is_Input_of_Dijkstra_Alg G,n,W & v1=1 & 1 <> v2 & v2=i & n >= 1 & g=
(DijkstraAlgorithm(n)).f implies the carrier of G = UsedVx(g,n) \/ UnusedVx(g,n
  ) & (v2 in UsedVx(g,n) implies ex p,P st p is_simple_vertex_seq_at g,i,n & P
is_oriented_edge_seq_of p & P is_shortestpath_of v1,v2,W & cost(P,W)=g.(2*n+i))
  & (v2 in UnusedVx(g,n) implies not ex Q st Q is_orientedpath_of v1,v2);














begin 

reserve X for RealUnitarySpace;
reserve x, y, y1, y2 for Point of X;

theorem 
  for Y be Subset of X for L be Functional of X holds Y
is_summable_set_by L iff for e be Real st 0 < e holds ex Y0 be finite Subset of
  X st Y0 is non empty & Y0 c= Y & for Y1 be finite Subset of X st Y1 is non
empty & Y1 c= Y & Y0 misses Y1 holds abs(setopfunc(Y1, the carrier of X, REAL,
  L, addreal)) <e;

theorem 
  for X st the addF of X is commutative associative & the addF of X
is having_a_unity for S be finite OrthogonalFamily of X st S is non empty for I
  be Function of the carrier of X, the carrier of X st S c= dom I & (for y st y
in S holds I.y = y) for H be Function of the carrier of X, REAL st S c= dom H &
  (for y st y in S holds H.y= (y.|.y)) holds setopfunc(S, the carrier of X, the
carrier of X, I, the addF of X) .|. setopfunc(S, the carrier of X, the carrier
  of X, I, the addF of X) = setopfunc(S, the carrier of X, REAL, H, addreal);

theorem 
  for X st the addF of X is commutative associative & the addF of X
is having_a_unity for S be finite OrthogonalFamily of X st S is non empty for H
be Functional of X st S c= dom H & (for x st x in S holds H.x = (x.|.x)) holds
  (setsum(S)).|.(setsum(S)) = setopfunc(S, the carrier of X, REAL, H, addreal);

theorem 
  for Y be OrthogonalFamily of X for Z be Subset of X holds Z is
  Subset of Y implies Z is OrthogonalFamily of X;

theorem 
  for Y be OrthonormalFamily of X for Z be Subset of X holds Z is
  Subset of Y implies Z is OrthonormalFamily of X;

begin 

theorem 
  for X being RealHilbertSpace
   st the addF of X is commutative associative & the addF of X
  is having_a_unity for S be OrthonormalFamily of X for H be
  Functional of X st S c= dom H &
   (for x being Point of X st x in S holds H.x = (x.|.x)) holds S
  is summable_set iff S is_summable_set_by H;

theorem 
  for S be Subset of X st S is summable_set holds for e be Real st
  0 < e ex Y0 be finite Subset of X st Y0 is non empty & Y0 c= S & for Y1 be
  finite Subset of X st Y0 c= Y1 & Y1 c= S holds abs(((sum(S)).|.(sum(S))) - ((
  setsum(Y1)).|.(setsum(Y1)))) < e;

theorem 
  for X being RealHilbertSpace
   st the addF of X is commutative associative & the addF of X is
  having_a_unity for S be OrthonormalFamily of X for H be
  Functional of X st S c= dom H &
   (for x being Point of X st x in S holds H.x = (x.|.x)) holds S
  is summable_set implies (sum(S)).|.(sum(S)) = sum_byfunc(S, H);














begin

reserve z,z1,z2 for complex number;
reserve r,x1,x2 for Real;
reserve p0,p,p1,p2,p3,q for Point of TOP-REAL 2;

definition
  let z be complex number;
  func cpx2euc(z) -> Point of TOP-REAL 2 equals

  |[Re z,Im z]|;
end;

definition
  let p be Point of TOP-REAL 2;
  func euc2cpx(p) -> Element of COMPLEX equals

  p`1 +p`2 *<i>;
end;

theorem 
  euc2cpx(cpx2euc(z))=z;

theorem 
  cpx2euc(euc2cpx(p))=p;

theorem 
  for z1,z2 st cpx2euc(z1)=cpx2euc(z2) holds z1=z2;

theorem 
  for p1,p2 st euc2cpx(p1)=euc2cpx(p2) holds p1=p2;

theorem 
  cpx2euc(x1+x2*<i>)= |[x1,x2]|;

theorem 
  |[Re (z1+z2),Im (z1+z2)]|=|[Re z1 + Re z2, Im z1 + Im z2]|;

theorem 
  cpx2euc(z1+z2)=cpx2euc(z1)+cpx2euc(z2);

theorem 
  (p1+p2)`1+(p1+p2)`2*<i> = p1`1+p2`1+(p1`2+p2`2)*<i>;

theorem 
  euc2cpx(p1+p2)=euc2cpx(p1)+euc2cpx(p2);

theorem 
  |[Re (-z),Im (-z)]|=|[-(Re z), -(Im z)]|;

theorem 
  cpx2euc(-z)= -cpx2euc(z);

theorem 
  (-p)`1+(-p)`2*<i>= -(p`1)+(-(p`2))*<i>;

theorem 
  euc2cpx(-p)= -euc2cpx(p);

theorem 
  cpx2euc(z1-z2)=cpx2euc(z1)-cpx2euc(z2);

theorem 
  euc2cpx(p1-p2)=euc2cpx(p1)-euc2cpx(p2);

theorem 
  cpx2euc(0c)= 0.TOP-REAL 2;

theorem 
  euc2cpx(0.TOP-REAL 2)=0c;

theorem 
  euc2cpx(p)=0c implies p=0.TOP-REAL 2;

theorem 
  cpx2euc(r*z)=r*(cpx2euc(z));

theorem 
  euc2cpx(r*p)= r*euc2cpx(p);

theorem 
  |.euc2cpx(p).|=sqrt ((p`1)^2+(p`2)^2);

theorem 
  for f being FinSequence of REAL st len f=2 holds |.f.| = sqrt ((f.1)^2
  +(f.2)^2);

theorem 
  for f being FinSequence of REAL, p being Point of TOP-REAL 2 st len f
  = 2 & p = f holds |.p.|=|.f.|;

theorem 
  |.cpx2euc(z).|=sqrt ((Re z)^2 + (Im z)^2);

theorem 
  |.euc2cpx(p).|=|.p.|;

definition
  let p;
  func Arg(p) -> Real equals

  Arg(euc2cpx(p));
end;

theorem 
  for z being Element of COMPLEX, p st z=euc2cpx(p) or p=cpx2euc(z)
  holds Arg(z)=Arg(p);

theorem 
  for x1,x2 being Real,p st x1= |.p.|*cos (Arg p) & x2=|.p.|*sin (Arg p)
  holds p = |[ x1,x2 ]|;

theorem 
  Arg(0.TOP-REAL 2)=0;

theorem 
  for p st p<>0.TOP-REAL 2 holds (Arg(p)<PI implies Arg(-p)=Arg(p)+PI)&
  (Arg(p)>=PI implies Arg(-p)=Arg(p)-PI);

theorem 
  for p st Arg p=0 holds p=|[ |.p.|,0 ]| & p`2=0;

theorem 
  for p st p<>0.TOP-REAL 2 holds (Arg(p)<PI iff Arg(-p)>=PI);

theorem 
  for p1,p2 st p1<>p2 or p1-p2<>0.TOP-REAL 2 holds (Arg(p1-p2)<PI iff
  Arg(p2-p1)>=PI);

theorem 
  for p holds Arg p in ].0,PI.[ iff p`2 > 0;

theorem 
  for p1,p2 st Arg(p1)<PI & Arg(p2)<PI holds Arg(p1+p2)<PI;

definition
  let p1,p2,p3;
  func angle(p1,p2,p3) -> Real equals

  angle(euc2cpx(p1),euc2cpx(p2),euc2cpx(p3
  ));
end;

theorem 
  for p1,p2,p3 holds angle(p1,p2,p3)=angle(p1-p2,0.TOP-REAL 2,p3-p2);

theorem 
  for p1,p2,p3 st angle(p1,p2,p3) =0 holds Arg(p1-p2)=Arg(p3-p2) & angle
  (p3,p2,p1)=0;

theorem 
  for p1,p2,p3 st angle(p1,p2,p3) <>0 holds angle(p3,p2,p1)=2*PI-angle(
  p1,p2,p3);

theorem 
  for p1,p2,p3 st angle(p3,p2,p1) <>0 holds angle(p3,p2,p1)=2*PI-angle(
  p1,p2,p3);

theorem 
  for x,y being Element of COMPLEX holds Re (x .|. y) = (Re x)*(Re
  y)+(Im x)*(Im y);

theorem 
  for x,y being Element of COMPLEX holds Im (x .|. y) = -((Re x)*(
  Im y))+(Im x)*(Re y);

theorem 
  for p,q holds |(p,q)| = p`1*q`1+p`2*q`2;

theorem 
  for p1,p2 holds |(p1,p2)| = Re ((euc2cpx(p1)) .|. (euc2cpx(p2)));

theorem 
  for p1,p2,p3 st p1<>0.TOP-REAL 2 & p2<>0.TOP-REAL 2 holds ( |(p1,p2)|=
  0 iff angle(p1,0.TOP-REAL 2,p2)=PI/2 or angle(p1,0.TOP-REAL 2,p2)=3/2*PI);

theorem 
  for p1,p2 st p1<>0.TOP-REAL 2 & p2<>0.TOP-REAL 2 holds ( -(p1`1*p2`2)+
p1`2*p2`1= |.p1.|*|.p2.| or -(p1`1*p2`2)+p1`2*p2`1= -(|.p1.|*|.p2.|) iff angle(
  p1,0.TOP-REAL 2,p2)=PI/2 or angle(p1,0.TOP-REAL 2,p2)=3/2*PI);

theorem 
  for p1,p2,p3 st p1<>p2 & p3<>p2 holds ( |( p1-p2,p3-p2 )| = 0 iff
  angle(p1,p2,p3)=PI/2 or angle(p1,p2,p3)=3/2*PI);


theorem 
  for p1,p2,p3 st p1<>p2 & p3<>p2 & (angle(p1,p2,p3)=PI/2 or angle(p1,p2
  ,p3)=3/2*PI) holds |.p1-p2.|^2+|.p3-p2.|^2=|.p1-p3.|^2;

theorem 
  for p1,p2,p3 st p2<>p1 & p1<>p3 & p3<>p2 & angle(p2,p1,p3)<PI holds
  angle(p2,p1,p3)+angle(p1,p3,p2)+angle(p3,p2,p1)=PI;

definition
  let n be Element of NAT,p1,p2,p3 be Point of TOP-REAL n;
  func Triangle(p1,p2,p3) -> Subset of TOP-REAL n equals

  LSeg(p1,p2) \/ LSeg(
  p2,p3) \/ LSeg(p3,p1);
end;

definition
  let n be Element of NAT,p1,p2,p3 be Point of TOP-REAL n;
  func closed_inside_of_triangle(p1,p2,p3) -> Subset of TOP-REAL n equals

  {p
where p is Point of TOP-REAL n: ex a1,a2,a3 being Real st 0<=a1 & 0<=a2 & 0<=a3
  & a1+a2+a3=1 & p=a1*p1+a2*p2+a3*p3};
end;

definition
  let n be Element of NAT,p1,p2,p3 be Point of TOP-REAL n;
  func inside_of_triangle(p1,p2,p3) -> Subset of TOP-REAL n equals

  closed_inside_of_triangle(p1,p2,p3) \ Triangle(p1,p2,p3);
end;

definition
  let n be Element of NAT,p1,p2,p3 be Point of TOP-REAL n;
  func outside_of_triangle(p1,p2,p3) -> Subset of TOP-REAL n equals

  {p where p
is Point of TOP-REAL n: ex a1,a2,a3 being Real st (0>a1 or 0>a2 or 0>a3) & a1+
  a2+a3=1 & p=a1*p1+a2*p2+a3*p3};
end;

definition
  let n be Element of NAT,p1,p2,p3 be Point of TOP-REAL n;
  func plane(p1,p2,p3) -> Subset of TOP-REAL n equals

  outside_of_triangle(p1,
  p2,p3) \/ closed_inside_of_triangle(p1,p2,p3);
end;

theorem 
  for n being Element of NAT,p1,p2,p3,p being Point of TOP-REAL n
st p in plane(p1,p2,p3) holds ex a1,a2,a3 being Real st a1+a2+a3=1 & p=a1*p1+a2
  *p2+a3*p3;

theorem 
  for n being Element of NAT,p1,p2,p3 being Point of TOP-REAL n holds
  Triangle(p1,p2,p3) c= closed_inside_of_triangle(p1,p2,p3);

definition
  let n be Element of NAT,q1,q2 be Point of TOP-REAL n;
  pred q1,q2 are_lindependent2 means


  for a1,a2 being Real st a1*q1+a2* q2=0.TOP-REAL n holds a1=0 & a2=0;
end;

notation
  let n be Element of NAT,q1,q2 be Point of TOP-REAL n;
  antonym q1,q2 are_ldependent2 for q1,q2 are_lindependent2;
end;

theorem 
  for n being Element of NAT,q1,q2 being Point of TOP-REAL n st q1
  ,q2 are_lindependent2 holds q1<>q2 & q1<>0.TOP-REAL n & q2<>0.TOP-REAL n;

theorem 
  for n being Element of NAT, p1,p2,p3,p0 being Point of TOP-REAL
  n st p2-p1,p3-p1 are_lindependent2 & p0 in plane(p1,p2,p3) holds ex a1,a2,a3
being Real st p0=a1*p1+a2*p2+a3*p3 & a1+a2+a3=1 & for b1,b2,b3 being Real st p0
  =b1*p1+b2*p2+b3*p3 & b1+b2+b3=1 holds b1=a1 & b2=a2 & b3=a3;

theorem 
  for n being Element of NAT, p1,p2,p3,p0 being Point of TOP-REAL
n st (ex a1,a2,a3 being Real st p0=a1*p1+a2*p2+a3*p3 & a1+a2+a3=1) holds p0 in
  plane(p1,p2,p3);

theorem 
  for n being Element of NAT,p1,p2,p3 being Point of TOP-REAL n holds
plane(p1,p2,p3)={p where p is Point of TOP-REAL n: ex a1,a2,a3 being Real st a1
  +a2+a3=1 & p=a1*p1+a2*p2+a3*p3};

theorem 
  for p1,p2,p3 st p2-p1,p3-p1 are_lindependent2 holds plane(p1,p2, p3)=REAL 2;

definition
  let n be Element of NAT,p1,p2,p3,p be Point of TOP-REAL n;
  assume
 p2-p1,p3-p1 are_lindependent2 & p in plane(p1,p2,p3);
  func tricord1(p1,p2,p3,p) -> Real means


  ex a2,a3 being Real st it+a2 +a3=1 & p=it*p1+a2*p2+a3*p3;
end;

definition
  let n be Element of NAT,p1,p2,p3,p be Point of TOP-REAL n;
  assume
 p2-p1,p3-p1 are_lindependent2 & p in plane(p1,p2,p3);
  func tricord2(p1,p2,p3,p) -> Real means


  ex a1,a3 being Real st a1+it +a3=1 & p=a1*p1+it*p2+a3*p3;
end;

definition
  let n be Element of NAT,p1,p2,p3,p be Point of TOP-REAL n;
  assume
 p2-p1,p3-p1 are_lindependent2 & p in plane(p1,p2,p3);
  func tricord3(p1,p2,p3,p) -> Real means


  ex a1,a2 being Real st a1+a2 +it=1 & p=a1*p1+a2*p2+it*p3;
end;

definition
  let p1,p2,p3;
  func trcmap1(p1,p2,p3) -> Function of TOP-REAL 2,R^1 means

  for p holds it.p= tricord1(p1,p2,p3,p);
end;

definition
  let p1,p2,p3;
  func trcmap2(p1,p2,p3) -> Function of TOP-REAL 2,R^1 means

  for p holds it.p= tricord2(p1,p2,p3,p);
end;

definition
  let p1,p2,p3;
  func trcmap3(p1,p2,p3) -> Function of TOP-REAL 2,R^1 means

  for p holds it.p= tricord3(p1,p2,p3,p);
end;

theorem 
  for p1,p2,p3,p st p2-p1,p3-p1 are_lindependent2 holds p in
outside_of_triangle(p1,p2,p3) iff tricord1(p1,p2,p3,p)<0 or tricord2(p1,p2,p3,p
  )<0 or tricord3(p1,p2,p3,p)<0;

theorem 
  for p1,p2,p3,p st p2-p1,p3-p1 are_lindependent2 holds p in
  Triangle(p1,p2,p3) iff tricord1(p1,p2,p3,p)>=0 & tricord2(p1,p2,p3,p)>=0 &
tricord3(p1,p2,p3,p)>=0 & (tricord1(p1,p2,p3,p)=0 or tricord2(p1,p2,p3,p)=0 or
  tricord3(p1,p2,p3,p)=0);

theorem 
  for p1,p2,p3,p st p2-p1,p3-p1 are_lindependent2 holds p in Triangle(p1
,p2,p3) iff tricord1(p1,p2,p3,p)=0 & tricord2(p1,p2,p3,p)>=0 & tricord3(p1,p2,
p3,p)>=0 or tricord1(p1,p2,p3,p)>=0 & tricord2(p1,p2,p3,p)=0 & tricord3(p1,p2,
p3,p)>=0 or tricord1(p1,p2,p3,p)>=0 & tricord2(p1,p2,p3,p)>=0 & tricord3(p1,p2,
  p3,p)=0;

theorem 
  for p1,p2,p3,p st p2-p1,p3-p1 are_lindependent2 holds p in
inside_of_triangle(p1,p2,p3) iff tricord1(p1,p2,p3,p)>0 & tricord2(p1,p2,p3,p)>
  0 & tricord3(p1,p2,p3,p)>0;

theorem 
  for p1,p2,p3 st p2-p1,p3-p1 are_lindependent2 holds inside_of_triangle
  (p1,p2,p3) is non empty;














begin

reserve U for Universe;

theorem 
  for X,Y being set st X in U & Y in U for R being Relation of X,Y holds R in U
;

theorem 
  the InternalRel of Necklace 4 = {[0,1],[1,0],[1,2],[2,1],[2,3],[3 ,2]};

registration
  let n be Nat;
  cluster -> finite for Element of Rank n;
end;

theorem 
  for x be set st x in FinSETS holds x is finite;

registration
  cluster -> finite for Element of FinSETS;
end;

definition
  let G be non empty RelStr;
  attr G is N-free means


  not G embeds Necklace 4;
end;

registration
  cluster strict finite N-free for non empty RelStr;
end;

definition
  let R,S be RelStr;
  func union_of(R,S) -> strict RelStr means


  the carrier of it = (the
carrier of R) \/ (the carrier of S) & the InternalRel of it = (the InternalRel
  of R) \/ (the InternalRel of S);
end;

definition
  let R, S be RelStr;
  func sum_of(R,S) -> strict RelStr means


  the carrier of it = (the
carrier of R) \/ (the carrier of S) & the InternalRel of it = (the InternalRel
of R) \/ (the InternalRel of S) \/ [:the carrier of R, the carrier of S:] \/ [:
  the carrier of S, the carrier of R:];
end;

definition
  func fin_RelStr means


  for X being set holds X in it iff ex R being
  strict RelStr st X = R & the carrier of R in FinSETS;
end;

registration
  cluster fin_RelStr -> non empty;
end;

definition
  func fin_RelStr_sp -> Subset of fin_RelStr means


  (for R be strict
  RelStr st the carrier of R is 1-element & the carrier of R in FinSETS
holds R in it) & (for H1,H2 be strict RelStr st (the carrier of H1) misses (the
carrier of H2) & H1 in it & H2 in it holds union_of(H1,H2) in it & sum_of(H1,H2
  ) in it) & for M be Subset of fin_RelStr st ( (for R be strict RelStr st the
carrier of R is 1-element & the carrier of R in FinSETS holds R in M) &
for H1,H2 be strict RelStr st (the carrier of H1) misses (the carrier of H2) &
H1 in M & H2 in M holds union_of(H1,H2) in M & sum_of(H1,H2) in M ) holds it c=
  M;
end;

registration
  cluster fin_RelStr_sp -> non empty;
end;

theorem 
  for X being set st X in fin_RelStr_sp holds X is finite strict
  non empty RelStr;

theorem 
  for R being RelStr st R in fin_RelStr_sp holds (the carrier of R) in FinSETS;

theorem 
  for X being set st X in fin_RelStr_sp
   holds X is strict 1-element RelStr or
  ex H1,H2 being strict RelStr st the carrier of H1 misses
the carrier of H2 & H1 in fin_RelStr_sp & H2 in fin_RelStr_sp & (X = union_of(
  H1,H2) or X = sum_of(H1,H2) );

theorem 
  for R being strict non empty RelStr st R in fin_RelStr_sp holds R is N-free;














begin 

definition
  let n be Ordinal, L be right_zeroed add-associative right_complementable
  well-unital distributive non trivial doubleLoopStr, p be Polynomial of n,L;
  redefine func {p} -> Subset of Polynom-Ring(n,L);
end;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed commutative associative
well-unital distributive almost_left_invertible non trivial doubleLoopStr, f,
  p,g being Polynomial of n,L holds f reduces_to g,p,T implies ex m being
  Monomial of n,L st g = f - m *' p;

theorem 
  for n being Ordinal, T being admissible connected TermOrder of n, L
being add-associative right_complementable right_zeroed commutative associative
  well-unital distributive Abelian almost_left_invertible non degenerated non
  empty doubleLoopStr, f,p,g being Polynomial of n,L holds f reduces_to g,p,T
  implies ex m being Monomial of n,L st g = f - m *' p & not(HT(m*'p,T) in
  Support g) & HT(m*'p,T) <= HT(f,T),T;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed commutative associative
well-unital distributive almost_left_invertible non trivial doubleLoopStr, f,
  g being Polynomial of n,L, P,Q being Subset of Polynom-Ring(n,L) st P c= Q
  holds f reduces_to g,P,T implies f reduces_to g,Q,T;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed commutative associative
well-unital distributive almost_left_invertible non trivial doubleLoopStr, P,
  Q being Subset of Polynom-Ring(n,L) holds P c= Q implies PolyRedRel(P,T) c=
  PolyRedRel(Q,T);

theorem 
  for n being Ordinal, L being right_zeroed add-associative
right_complementable non empty doubleLoopStr, p being Polynomial of n,L holds
  Support(-p) = Support(p);

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
right_zeroed add-associative right_complementable well-unital distributive non
  trivial non empty doubleLoopStr, p being Polynomial of n,L holds HT(-p,T) =
  HT(p,T);

theorem 
  for n being Ordinal, T being admissible connected TermOrder of n,
  L being right_zeroed add-associative right_complementable well-unital
distributive non trivial doubleLoopStr, p,q being Polynomial of n,L
  holds HT(p-q,T) <= max(HT(p,T),HT(q,T),T), T;

theorem 
  for n being Ordinal, T being admissible connected TermOrder of n,
  L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive almost_left_invertible non trivial
  doubleLoopStr, p,q being Polynomial of n,L holds Support(q) c= Support(p)
  implies q <= p,T;

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n,
  L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive almost_left_invertible non degenerated
  non empty doubleLoopStr, f,p being non-zero Polynomial of n,L holds f
  is_reducible_wrt p,T implies HT(p,T) <= HT(f,T),T;

begin 

theorem 
  for n being Element of NAT, T being connected admissible
  TermOrder of n, L being add-associative right_complementable right_zeroed
commutative associative well-unital distributive Abelian almost_left_invertible
non trivial doubleLoopStr, p being Polynomial of n,L holds PolyRedRel({p},T)
  is locally-confluent;

theorem 
  for n being Element of NAT, T being connected admissible TermOrder of
  n, L being Abelian add-associative right_complementable right_zeroed
  commutative associative well-unital distributive almost_left_invertible non
  degenerated non empty doubleLoopStr, P being Subset of Polynom-Ring(n,L) st
ex p being Polynomial of n,L st p in P & P-Ideal = {p}-Ideal holds PolyRedRel(P
  ,T) is locally-confluent;

definition
  let n be Ordinal, T be connected TermOrder of n, L be right_zeroed
add-associative right_complementable well-unital distributive non trivial non
  empty doubleLoopStr, P be Subset of Polynom-Ring(n,L);
  func HT(P,T) -> Subset of Bags n equals

  { HT(p,T) where p is Polynomial of n
  ,L : p in P & p <> 0_(n,L) };
end;

definition
  let n be Ordinal, S be Subset of Bags n;
  func multiples(S) -> Subset of Bags n equals

  { b where b is Element of Bags
n: ex b9 being bag of n st b9 in S & b9 divides b };
end;

theorem 
  for n being Element of NAT, T being connected admissible TermOrder of
  n, L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive Abelian almost_left_invertible non
  degenerated non empty doubleLoopStr, P being Subset of Polynom-Ring(n,L)
holds PolyRedRel(P,T) is locally-confluent implies PolyRedRel(P,T) is confluent
;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed commutative associative
well-unital distributive almost_left_invertible non trivial doubleLoopStr, P
  being Subset of Polynom-Ring(n,L) holds PolyRedRel(P,T) is confluent implies
  PolyRedRel(P,T) is with_UN_property;

theorem 
  for n being Element of NAT, T being connected admissible TermOrder of
  n, L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive Abelian almost_left_invertible non
  degenerated non empty doubleLoopStr, P being Subset of Polynom-Ring(n,L)
  holds PolyRedRel(P,T) is with_UN_property implies PolyRedRel(P,T) is
  with_Church-Rosser_property;

theorem 
  for n being Element of NAT, T being connected admissible
  TermOrder of n, L being add-associative right_complementable right_zeroed
commutative associative well-unital distributive Abelian almost_left_invertible
  non degenerated non empty doubleLoopStr, P being non empty Subset of
Polynom-Ring(n,L) holds PolyRedRel(P,T) is with_Church-Rosser_property implies
(for f being Polynomial of n,L st f in P-Ideal holds PolyRedRel(P,T) reduces f,
  0_(n,L));

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed commutative associative
well-unital distributive almost_left_invertible non trivial doubleLoopStr, P
being Subset of Polynom-Ring(n,L) holds (for f being Polynomial of n,L st f in
P-Ideal holds PolyRedRel(P,T) reduces f,0_(n,L)) implies (for f being non-zero
  Polynomial of n,L st f in P-Ideal holds f is_reducible_wrt P,T);

theorem 
  for n being Element of NAT, T being admissible connected
  TermOrder of n, L being add-associative right_complementable right_zeroed
commutative associative well-unital distributive Abelian almost_left_invertible
non degenerated non empty doubleLoopStr, P being Subset of Polynom-Ring(n,L)
  holds (for f being non-zero Polynomial of n,L st f in P-Ideal holds f
is_reducible_wrt P,T) implies (for f being non-zero Polynomial of n,L st f in P
  -Ideal holds f is_top_reducible_wrt P,T);

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed commutative associative
well-unital distributive almost_left_invertible non trivial doubleLoopStr, P
being Subset of Polynom-Ring(n,L) holds (for f being non-zero Polynomial of n,L
st f in P-Ideal holds f is_top_reducible_wrt P,T) implies (for b being bag of n
  st b in HT(P-Ideal,T) ex b9 being bag of n st b9 in HT(P,T) & b9 divides b);

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed commutative associative
well-unital distributive almost_left_invertible non trivial doubleLoopStr, P
  being Subset of Polynom-Ring(n,L) holds (for b being bag of n st b in HT(P
  -Ideal,T) ex b9 being bag of n st b9 in HT(P,T) & b9 divides b) implies HT(P
  -Ideal,T) c= multiples(HT(P,T));

theorem 
  for n being Element of NAT, T being connected admissible TermOrder of
  n, L being Abelian add-associative right_complementable right_zeroed
  commutative associative well-unital distributive almost_left_invertible non
  degenerated non empty doubleLoopStr, P being Subset of Polynom-Ring(n,L)
  holds HT(P-Ideal,T) c= multiples(HT(P,T)) implies PolyRedRel(P,T) is
  locally-confluent;

definition 
  let n be Ordinal, T be connected TermOrder of n, L be add-associative
  right_complementable right_zeroed commutative associative well-unital
distributive almost_left_invertible non trivial doubleLoopStr, G be Subset of
  Polynom-Ring(n,L);
  pred G is_Groebner_basis_wrt T means


  PolyRedRel(G,T) is locally-confluent;
end;

definition 
  let n be Ordinal, T be connected TermOrder of n, L be add-associative
  right_complementable right_zeroed commutative associative well-unital
distributive almost_left_invertible non trivial doubleLoopStr, G,I be Subset
  of Polynom-Ring(n,L);
  pred G is_Groebner_basis_of I,T means


  G-Ideal = I & PolyRedRel(G,T) is locally-confluent;
end;

theorem 
  for n being Element of NAT, T being connected admissible TermOrder of
  n, L being Abelian add-associative right_complementable right_zeroed
  commutative associative well-unital distributive almost_left_invertible non
  degenerated non empty doubleLoopStr, G,P being non empty Subset of
  Polynom-Ring(n,L) st G is_Groebner_basis_of P,T holds PolyRedRel(G,T) is
  Completion of PolyRedRel(P,T);

theorem 
  for n being Element of NAT, T being connected admissible TermOrder of
  n, L being Abelian add-associative right_complementable right_zeroed
  commutative associative well-unital distributive almost_left_invertible non
degenerated non empty doubleLoopStr, p,q being Element of Polynom-Ring(n,L),
  G being non empty Subset of Polynom-Ring(n,L) st G is_Groebner_basis_wrt T
holds p,q are_congruent_mod G-Ideal iff nf(p,PolyRedRel(G,T)) = nf(q,PolyRedRel
  (G,T));

theorem 
  for n being Element of NAT, T being connected admissible TermOrder of
  n, L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive Abelian almost_left_invertible non
  degenerated non empty doubleLoopStr, f being Polynomial of n,L, P being non
  empty Subset of Polynom-Ring(n,L) st P is_Groebner_basis_wrt T holds f in P
  -Ideal iff PolyRedRel(P,T) reduces f,0_(n,L);

theorem 
  for n being Element of NAT, T being connected admissible
  TermOrder of n, L being add-associative right_complementable right_zeroed
commutative associative well-unital distributive Abelian almost_left_invertible
non degenerated non empty doubleLoopStr, I being Subset of Polynom-Ring(n,L),
G being non empty Subset of Polynom-Ring(n,L) holds G is_Groebner_basis_of I,T
implies (for f being Polynomial of n,L st f in I holds PolyRedRel(G,T) reduces
  f,0_(n,L));

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed commutative associative
well-unital distributive almost_left_invertible non trivial doubleLoopStr, G,
  I being Subset of Polynom-Ring(n,L) holds (for f being Polynomial of n,L st f
  in I holds PolyRedRel(G,T) reduces f,0_(n,L)) implies (for f being non-zero
  Polynomial of n,L st f in I holds f is_reducible_wrt G,T);

theorem 
  for n being Element of NAT, T being admissible connected
  TermOrder of n, L being add-associative right_complementable right_zeroed
commutative associative well-unital distributive Abelian almost_left_invertible
non degenerated non empty doubleLoopStr, I being add-closed left-ideal Subset
of Polynom-Ring(n,L), G being Subset of Polynom-Ring(n,L) st G c= I holds (for
  f being non-zero Polynomial of n,L st f in I holds f is_reducible_wrt G,T)
  implies (for f being non-zero Polynomial of n,L st f in I holds f
  is_top_reducible_wrt G,T);

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed commutative associative
well-unital distributive almost_left_invertible non trivial doubleLoopStr, G,
I being Subset of Polynom-Ring(n,L) holds (for f being non-zero Polynomial of n
,L st f in I holds f is_top_reducible_wrt G,T) implies (for b being bag of n st
  b in HT(I,T) ex b9 being bag of n st b9 in HT(G,T) & b9 divides b);

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed commutative associative
well-unital distributive almost_left_invertible non trivial doubleLoopStr, G,
I being Subset of Polynom-Ring(n,L) holds (for b being bag of n st b in HT(I,T)
  ex b9 being bag of n st b9 in HT(G,T) & b9 divides b) implies HT(I,T) c=
  multiples(HT(G,T));

theorem 
  for n being Element of NAT, T being connected admissible
  TermOrder of n, L being Abelian add-associative right_complementable
  right_zeroed commutative associative well-unital distributive
  almost_left_invertible non degenerated non empty doubleLoopStr, I being
add-closed left-ideal non empty Subset of Polynom-Ring(n,L), G being non empty
  Subset of Polynom-Ring(n,L) st G c= I holds HT(I,T) c= multiples(HT(G,T))
  implies G is_Groebner_basis_of I,T;

begin 

theorem 
  for n being Element of NAT, T being connected admissible
  TermOrder of n, L being add-associative right_complementable right_zeroed
commutative associative well-unital distributive Abelian almost_left_invertible
  non trivial doubleLoopStr holds {0_(n,L)} is_Groebner_basis_of {0_(n,L)},T;

theorem 
  for n being Element of NAT, T being connected admissible TermOrder of
  n, L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive Abelian almost_left_invertible non
  trivial doubleLoopStr, p being Polynomial of n,L holds {p}
  is_Groebner_basis_of {p}-Ideal,T;

theorem 
  for T being admissible connected TermOrder of {}, L being
  add-associative right_complementable right_zeroed commutative associative
  well-unital distributive Abelian almost_left_invertible non degenerated non
  empty doubleLoopStr, I being add-closed left-ideal non empty Subset of
Polynom-Ring({},L), P being non empty Subset of Polynom-Ring({},L) st P c= I &
  P <> {0_({},L)} holds P is_Groebner_basis_of I,T;

theorem 
  for n being non empty Ordinal, T being admissible connected TermOrder
  of n, L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive almost_left_invertible non degenerated
  non empty doubleLoopStr ex P be Subset of Polynom-Ring(n,L) st not(P
  is_Groebner_basis_wrt T);

definition 
  let n be Ordinal;
  func DivOrder(n) -> Order of Bags n means


  for b1,b2 being bag of n holds [b1,b2] in it iff b1 divides b2;
end;

registration 
  let n be Element of NAT;
  cluster RelStr(#Bags n, DivOrder n#) -> Dickson;
end;

theorem 
  for n being Element of NAT, N being Subset of RelStr(#Bags n,
    DivOrder n#) ex B being finite Subset of Bags n st B is_Dickson-basis_of N,
  RelStr(#Bags n, DivOrder n#);

theorem 
  for n being Element of NAT, T being connected admissible
  TermOrder of n, L being Abelian add-associative right_complementable
  right_zeroed commutative associative well-unital distributive
  almost_left_invertible non degenerated non empty doubleLoopStr, I being
  add-closed left-ideal non empty Subset of Polynom-Ring(n,L) ex G being finite
  Subset of Polynom-Ring(n,L) st G is_Groebner_basis_of I,T;

theorem 
  for n being Element of NAT, T being connected admissible TermOrder of
  n, L being Abelian add-associative right_complementable right_zeroed
  commutative associative well-unital distributive almost_left_invertible non
degenerated non empty doubleLoopStr, I being add-closed left-ideal non empty
  Subset of Polynom-Ring(n,L) st I <> {0_(n,L)} ex G being finite Subset of
  Polynom-Ring(n,L) st G is_Groebner_basis_of I,T & not(0_(n,L) in G);

definition
  let n be Ordinal, T be connected TermOrder of n, L be non empty
  multLoopStr_0, p be Polynomial of n,L;
  pred p is_monic_wrt T means


  HC(p,T) = 1.L;
end;

definition 
  let n be Ordinal, T be connected TermOrder of n, L be right_zeroed
  add-associative right_complementable commutative associative well-unital
distributive almost_left_invertible non trivial doubleLoopStr, P be
  Subset of Polynom-Ring(n,L);
  pred P is_reduced_wrt T means


  for p being Polynomial of n,L st p in P
  holds p is_monic_wrt T & p is_irreducible_wrt P\{p},T;
end;

notation 
  let n be Ordinal, T be connected TermOrder of n, L be right_zeroed
  add-associative right_complementable commutative associative well-unital
distributive almost_left_invertible non trivial doubleLoopStr, P be
  Subset of Polynom-Ring(n,L);
  synonym P is_autoreduced_wrt T for P is_reduced_wrt T;
end;

theorem 
  for n being Ordinal, T being admissible connected TermOrder of n
  , L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive Abelian almost_left_invertible non
degenerated non empty doubleLoopStr, I being add-closed left-ideal Subset of
Polynom-Ring(n,L), m being Monomial of n,L, f,g being Polynomial of n,L st f in
  I & g in I & HM(f,T) = m & HM(g,T) = m holds not(ex p being Polynomial of n,L
st p in I & p < f,T & HM(p,T) = m) & not(ex p being Polynomial of n,L st p in I
  & p < g,T & HM(p,T) = m) implies f = g;

theorem 
  for n being Element of NAT, T being connected admissible TermOrder of
  n, L being Abelian add-associative right_complementable right_zeroed
  commutative associative well-unital distributive almost_left_invertible non
degenerated non empty doubleLoopStr, I being add-closed left-ideal non empty
  Subset of Polynom-Ring(n,L), G being Subset of Polynom-Ring(n,L), p being
Polynomial of n,L, q being non-zero Polynomial of n,L st p in G & q in G & p <>
  q & HT(q,T) divides HT(p,T) holds G is_Groebner_basis_of I,T implies G\{p}
  is_Groebner_basis_of I,T;

theorem 
  for n being Element of NAT, T being connected admissible TermOrder of
  n, L being Abelian add-associative right_complementable right_zeroed
  commutative associative well-unital distributive almost_left_invertible non
degenerated non empty doubleLoopStr, I being add-closed left-ideal non empty
  Subset of Polynom-Ring(n,L) st I <> {0_ (n,L)} ex G being finite Subset of
  Polynom-Ring(n,L) st G is_Groebner_basis_of I,T & G is_reduced_wrt T;

theorem 
  for n being Element of NAT, T being connected admissible TermOrder of
  n, L being Abelian add-associative right_complementable right_zeroed
  commutative associative well-unital distributive almost_left_invertible non
degenerated non empty doubleLoopStr, I being add-closed left-ideal non empty
  Subset of Polynom-Ring(n,L), G1,G2 being non empty finite Subset of
  Polynom-Ring(n,L) st G1 is_Groebner_basis_of I,T & G1 is_reduced_wrt T & G2
  is_Groebner_basis_of I,T & G2 is_reduced_wrt T holds G1 = G2;















begin 

theorem 
  for L being add-associative right_zeroed right_complementable non
  empty addLoopStr, p being FinSequence of L, n being Element of NAT st for k
being Element of NAT st k in dom p & k > n holds p.k = 0.L holds Sum p = Sum(p|
  n);

theorem 
  for L being add-associative right_zeroed Abelian non empty addLoopStr
  , f being FinSequence of L, i,j being Element of NAT holds Sum Swap(f,i,j) =
  Sum f;

definition
  let X be set, b1,b2 be bag of X;
  assume
 b2 divides b1;
  func b1 / b2 -> bag of X means


  b2 + it = b1;
end;

definition
  let X be set, b1,b2 be bag of X;
  func lcm(b1,b2) -> bag of X means


  for k being set holds it.k = max(b1 .k,b2.k);
  commutativity;
  idempotence;
end;

notation
  let X be set, b1,b2 be bag of X;
  synonym b1 lcm b2 for lcm(b1,b2);
end;



definition
  let X be set, b1,b2 be bag of X;
  pred b1,b2 are_disjoint means


  for i being set holds b1.i = 0 or b2.i = 0;
end;

notation
  let X be set, b1,b2 be bag of X;
  antonym b1,b2 are_non_disjoint for b1,b2 are_disjoint;
end;

theorem 
  for X being set, b1,b2 being bag of X holds b1 divides lcm(b1,b2)
  & b2 divides lcm(b1,b2);



theorem 
  for X being set, b1,b2,b3 be bag of X holds b1 divides b3 & b2
  divides b3 implies lcm(b1,b2) divides b3;



theorem 
  for X being set, b1,b2 being bag of X holds b1,b2 are_disjoint iff lcm
  (b1,b2) = b1 + b2;

theorem 
  for X being set, b being bag of X holds b/b = EmptyBag X;

theorem 
  for X being set, b1,b2 be bag of X holds b2 divides b1 iff lcm( b1,b2) = b1;

theorem 
  for X being set, b1,b2,b3 being bag of X holds b1 divides lcm(b2,b3)
  implies lcm(b2,b1) divides lcm(b2,b3);



theorem 
  for X being set, b1,b2,b3 being bag of X holds lcm(b2,b1) divides lcm(
  b2,b3) implies lcm(b1,b3) divides lcm(b2,b3);



theorem 
  for n being set, b1,b2,b3 being bag of n holds lcm(b1,b3) divides lcm(
  b2,b3) implies b1 divides lcm(b2,b3);



theorem 
  for n being Element of NAT, T being connected admissible TermOrder of
  n, P being non empty Subset of Bags n ex b being bag of n st b in P & for b9
  being bag of n st b9 in P holds b <= b9,T;

registration
  let L be add-associative right_zeroed right_complementable non trivial
  addLoopStr, a be non zero Element of L;
  cluster -a -> non zero;
end;

registration
  let X be set, L be left_zeroed right_zeroed add-cancelable distributive non
  empty doubleLoopStr, m be Monomial of X,L, a be Element of L;
  cluster a * m -> monomial-like;
end;

registration
  let n be Ordinal, L be left_zeroed right_zeroed add-cancelable distributive
domRing-like non trivial doubleLoopStr, p be non-zero Polynomial of n,L, a be
  non zero Element of L;
  cluster a * p -> non-zero;
end;

theorem 
  for n being Ordinal, L being right_zeroed right-distributive
non empty doubleLoopStr, p,q being Series of n,L, b being bag of n holds b *'
  (p + q) = b *' p + b *' q;

theorem 
  for n being Ordinal, L being add-associative right_zeroed
right_complementable non empty addLoopStr, p being Series of n,L, b being bag
  of n holds b *' (-p) = -(b *' p);

theorem 
  for n being Ordinal, L being left_zeroed right_add-cancelable
  right-distributive non empty doubleLoopStr, p being Series of n,L, b being
  bag of n, a being Element of L holds b *' (a * p) = a * (b *' p);

theorem 
  for n being Ordinal, L being right-distributive non empty
doubleLoopStr, p,q being Series of n,L, a being Element of L holds a * (p + q)
  = a * p + a * q;

theorem 
  for X being set, L being add-associative right_zeroed
right_complementable non empty doubleLoopStr, a being Element of L holds -(a
  |(X,L)) = (-a) |(X,L);

begin 

theorem 
  for n being Element of NAT, T being connected admissible
  TermOrder of n, L being add-associative right_complementable right_zeroed
commutative associative well-unital distributive Abelian almost_left_invertible
non degenerated non empty doubleLoopStr, P being Subset of Polynom-Ring(n,L)
holds (for p1,p2 being Polynomial of n,L st p1 <> p2 & p1 in P & p2 in P for m1
,m2 being Monomial of n,L st HM(m1 *'p1,T) = HM(m2 *'p2,T) holds PolyRedRel(P,T
  ) reduces m1 *' p1 - m2 *' p2, 0_(n,L)) implies P is_Groebner_basis_wrt T;

definition
  let n be Ordinal, T be connected TermOrder of n, L be add-associative
  right_complementable right_zeroed commutative associative well-unital
  distributive almost_left_invertible non trivial doubleLoopStr, p1,p2 be
  Polynomial of n,L;
  func S-Poly(p1,p2,T) -> Polynomial of n,L equals

  HC(p2,T) * (lcm(HT(p1,T),HT
  (p2,T))/HT(p1,T)) *' p1 - HC(p1,T) * (lcm(HT(p1,T),HT(p2,T))/HT(p2,T)) *' p2;
end;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed commutative associative
  well-unital distributive almost_left_invertible Abelian non trivial
doubleLoopStr, P being Subset of Polynom-Ring(n,L), p1,p2 being Polynomial of
  n,L st p1 in P & p2 in P holds S-Poly(p1,p2,T) in P-Ideal;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed commutative associative
well-unital distributive almost_left_invertible non trivial doubleLoopStr, m1
  ,m2 being Monomial of n,L holds S-Poly(m1,m2,T) = 0_(n,L);



theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed commutative associative
well-unital distributive almost_left_invertible non trivial doubleLoopStr, p
being Polynomial of n,L holds S-Poly(p,0_(n,L),T) = 0_(n,L) & S-Poly(0_(n,L),p,
  T) = 0_(n,L);

theorem 
  for n being Ordinal, T being admissible connected TermOrder of n, L
being add-associative right_complementable right_zeroed commutative associative
well-unital distributive almost_left_invertible non trivial doubleLoopStr, p1
,p2 being Polynomial of n,L holds S-Poly(p1,p2,T) = 0_(n,L) or HT(S-Poly(p1,p2,
  T),T) < lcm(HT(p1,T),HT(p2,T)),T;



theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed commutative associative
well-unital distributive almost_left_invertible non trivial doubleLoopStr, p1
,p2 being non-zero Polynomial of n,L holds HT(p2,T) divides HT(p1,T) implies HC
  (p2,T) * p1 top_reduces_to S-Poly(p1,p2,T),p2,T;



theorem 
  for n being Element of NAT, T being connected admissible TermOrder of
  n, L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive Abelian almost_left_invertible non
  degenerated non empty doubleLoopStr, G being Subset of Polynom-Ring(n,L)
holds G is_Groebner_basis_wrt T implies (for g1,g2,h being Polynomial of n,L st
g1 in G & g2 in G & h is_a_normal_form_of S-Poly(g1,g2,T),PolyRedRel(G,T) holds
  h = 0_(n,L));



theorem 
  for n being Element of NAT, T being connected admissible TermOrder of
  n, L being Abelian add-associative right_complementable right_zeroed
  commutative associative well-unital distributive almost_left_invertible non
  degenerated non empty doubleLoopStr, G being Subset of Polynom-Ring(n,L)
  holds (for g1,g2,h being Polynomial of n,L st g1 in G & g2 in G & h
is_a_normal_form_of S-Poly(g1,g2,T),PolyRedRel(G,T) holds h = 0_(n,L)) implies
  (for g1,g2 being Polynomial of n,L st g1 in G & g2 in G holds PolyRedRel(G,T)
  reduces S-Poly(g1,g2,T),0_(n,L));



theorem 
  for n being Element of NAT, T being admissible connected
  TermOrder of n, L being add-associative right_complementable right_zeroed
commutative associative well-unital distributive Abelian almost_left_invertible
non degenerated non empty doubleLoopStr, G being Subset of Polynom-Ring(n,L)
  st not(0_(n,L) in G) holds (for g1,g2 being Polynomial of n,L st g1 in G & g2
  in G holds PolyRedRel(G,T) reduces S-Poly(g1,g2,T),0_(n,L)) implies G
  is_Groebner_basis_wrt T;



definition
  let n be Ordinal, T be connected TermOrder of n, L be add-associative
  right_complementable right_zeroed commutative associative well-unital
distributive almost_left_invertible non trivial doubleLoopStr, P be Subset of
  Polynom-Ring(n,L);
  func S-Poly(P,T) -> Subset of Polynom-Ring(n,L) equals

  { S-Poly(p1,p2,T)
  where p1,p2 is Polynomial of n,L : p1 in P & p2 in P };
end;

registration
  let n be Ordinal, T be connected TermOrder of n, L be add-associative
  right_complementable right_zeroed commutative associative well-unital
  distributive almost_left_invertible non trivial doubleLoopStr, P be finite
  Subset of Polynom-Ring(n,L);
  cluster S-Poly(P,T) -> finite;
end;

theorem 
  for n being Element of NAT, T being admissible connected TermOrder of
  n, L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive Abelian almost_left_invertible non
  degenerated non empty doubleLoopStr, G being Subset of Polynom-Ring(n,L) st
not(0_(n,L) in G) & for g being Polynomial of n,L st g in G holds g is Monomial
  of n,L holds G is_Groebner_basis_wrt T;



begin 

theorem 
  for L being non empty multLoopStr, P being non empty Subset of L, A
  being LeftLinearCombination of P, i being Element of NAT holds A|i is
  LeftLinearCombination of P;

theorem 
  for L being non empty multLoopStr, P being non empty Subset of L, A
  being LeftLinearCombination of P, i being Element of NAT holds A/^i is
  LeftLinearCombination of P;

theorem 
  for L being non empty multLoopStr, P,Q being non empty Subset of L, A
  being LeftLinearCombination of P holds P c= Q implies A is
  LeftLinearCombination of Q;

definition
  let n be Ordinal, L be right_zeroed add-associative right_complementable
well-unital distributive non trivial doubleLoopStr, P be non empty
  Subset of Polynom-Ring(n,L), A,B be LeftLinearCombination of P;
  redefine func A^B -> LeftLinearCombination of P;
end;

definition
  let n be Ordinal, L be right_zeroed add-associative right_complementable
well-unital distributive non trivial doubleLoopStr, f be Polynomial
of n,L, P be non empty Subset of Polynom-Ring(n,L), A be LeftLinearCombination
  of P;
  pred A is_MonomialRepresentation_of f means


  Sum A = f & for i being
Element of NAT st i in dom A ex m being Monomial of n,L, p being Polynomial of
  n,L st p in P & A/.i = m *' p;
end;

theorem 
  for n being Ordinal, L being right_zeroed add-associative
  right_complementable well-unital distributive non trivial
  doubleLoopStr, f being Polynomial of n,L, P being non empty Subset of
  Polynom-Ring(n,L), A being LeftLinearCombination of P st A
is_MonomialRepresentation_of f holds Support f c= union { Support(m*'p) where m
is Monomial of n,L, p is Polynomial of n,L : ex i being Element of NAT st i in
  dom A & A/.i = m*'p };

theorem 
  for n being Ordinal, L being right_zeroed add-associative
  right_complementable well-unital distributive non trivial
  doubleLoopStr, f,g being Polynomial of n,L, P being non empty Subset of
  Polynom-Ring(n,L), A,B being LeftLinearCombination of P st A
  is_MonomialRepresentation_of f & B is_MonomialRepresentation_of g holds (A^B)
  is_MonomialRepresentation_of f+g;

definition
  let n be Ordinal, T be connected TermOrder of n, L be right_zeroed
add-associative right_complementable well-unital distributive non trivial non
  empty doubleLoopStr, f be Polynomial of n,L, P be non empty Subset of
  Polynom-Ring(n,L), A be LeftLinearCombination of P, b be bag of n;
  pred A is_Standard_Representation_of f,P,b,T means


  Sum A = f & for i
being Element of NAT st i in dom A ex m being non-zero Monomial of n,L, p being
  non-zero Polynomial of n,L st p in P & A/.i = m *' p & HT(m*'p,T) <= b,T;
end;

definition
  let n be Ordinal, T be connected TermOrder of n, L be right_zeroed
add-associative right_complementable well-unital distributive non trivial non
  empty doubleLoopStr, f be Polynomial of n,L, P be non empty Subset of
  Polynom-Ring(n,L), A be LeftLinearCombination of P;
  pred A is_Standard_Representation_of f,P,T means


  A is_Standard_Representation_of f,P,HT(f,T),T;
end;

definition
  let n be Ordinal, T be connected TermOrder of n, L be right_zeroed
add-associative right_complementable well-unital distributive non trivial non
  empty doubleLoopStr, f be Polynomial of n,L, P be non empty Subset of
  Polynom-Ring(n,L), b be bag of n;
  pred f has_a_Standard_Representation_of P,b,T means

  ex A being
  LeftLinearCombination of P st A is_Standard_Representation_of f,P,b,T;
end;

definition
  let n be Ordinal, T be connected TermOrder of n, L be right_zeroed
add-associative right_complementable well-unital distributive non trivial non
  empty doubleLoopStr, f be Polynomial of n,L, P be non empty Subset of
  Polynom-Ring(n,L);
  pred f has_a_Standard_Representation_of P,T means


  ex A being
  LeftLinearCombination of P st A is_Standard_Representation_of f,P,T;
end;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
right_zeroed add-associative right_complementable well-unital distributive non
trivial non empty doubleLoopStr, f being Polynomial of n,L, P being non empty
Subset of Polynom-Ring(n,L), A being LeftLinearCombination of P, b being bag of
  n holds A is_Standard_Representation_of f,P,b,T implies A
  is_MonomialRepresentation_of f;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
right_zeroed add-associative right_complementable well-unital distributive non
  trivial non empty doubleLoopStr, f,g being Polynomial of n,L, P being non
  empty Subset of Polynom-Ring(n,L), A,B being LeftLinearCombination of P, b
  being bag of n st A is_Standard_Representation_of f,P,b,T & B
is_Standard_Representation_of g,P,b,T holds A^B is_Standard_Representation_of f
  +g,P,b,T;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
right_zeroed add-associative right_complementable well-unital distributive non
  trivial non empty doubleLoopStr, f,g being Polynomial of n,L, P being non
  empty Subset of Polynom-Ring(n,L), A,B being LeftLinearCombination of P, b
being bag of n, i being Element of NAT st A is_Standard_Representation_of f,P,b
  ,T & B = A|i & g = Sum(A/^i) holds B is_Standard_Representation_of f-g,P,b,T;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being Abelian
right_zeroed add-associative right_complementable well-unital distributive non
  trivial non empty doubleLoopStr, f,g being Polynomial of n,L, P being non
  empty Subset of Polynom-Ring(n,L), A,B being LeftLinearCombination of P, b
being bag of n, i being Element of NAT st A is_Standard_Representation_of f,P,b
,T & B = A/^i & g = Sum(A|i) & i <= len A holds B is_Standard_Representation_of
  f-g,P,b,T;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
right_zeroed add-associative right_complementable well-unital distributive non
trivial non empty doubleLoopStr, f being non-zero Polynomial of n,L, P being
non empty Subset of Polynom-Ring(n,L), A being LeftLinearCombination of P st A
  is_MonomialRepresentation_of f ex i being Element of NAT, m being non-zero
Monomial of n,L, p being non-zero Polynomial of n,L st i in dom A & p in P & A.
  i = m *' p & HT(f,T) <= HT(m*'p,T),T;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
right_zeroed add-associative right_complementable well-unital distributive non
trivial non empty doubleLoopStr, f being non-zero Polynomial of n,L, P being
non empty Subset of Polynom-Ring(n,L), A being LeftLinearCombination of P st A
is_Standard_Representation_of f,P,T ex i being Element of NAT, m being non-zero
Monomial of n,L, p being non-zero Polynomial of n,L st p in P & i in dom A & A
  /.i = m *' p & HT(f,T) = HT(m*'p,T);

theorem 
  for n being Ordinal, T being admissible connected TermOrder of n
  , L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive Abelian almost_left_invertible non
  degenerated non empty doubleLoopStr, f being Polynomial of n,L, P being non
  empty Subset of Polynom-Ring(n,L) holds PolyRedRel(P,T) reduces f,0_(n,L)
  implies f has_a_Standard_Representation_of P,T;



theorem 
  for n being Ordinal, T being admissible connected TermOrder of n
  , L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive almost_left_invertible non trivial
doubleLoopStr, f being non-zero Polynomial of n,L, P being non empty Subset of
  Polynom-Ring(n,L) holds f has_a_Standard_Representation_of P,T implies f
  is_top_reducible_wrt P,T;



theorem 
  for n being Element of NAT, T being connected admissible TermOrder of
  n, L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive Abelian almost_left_invertible non
degenerated non empty doubleLoopStr, G being non empty Subset of Polynom-Ring
(n,L) holds G is_Groebner_basis_wrt T iff for f being non-zero Polynomial of n,
  L st f in G-Ideal holds f has_a_Standard_Representation_of G,T;
 















begin 

reserve T for non empty TopSpace;
reserve A for Subset of T;

notation
  let T be non empty TopSpace, A be Subset of T;
  synonym A- for Cl A;
end;

theorem 
  A-`-`-`- = A-`-;

definition
  let T, A;
  func Kurat14Part A equals

  { A, A-, A-`, A-`-, A-`-`, A-`-`-, A-`-`-` };
end;

registration
  let T, A;
  cluster Kurat14Part A -> finite;
end;

definition
  let T, A;
  func Kurat14Set A -> Subset-Family of T equals

  { A, A-, A-`, A-`-, A-`-`, A-
  `-`-, A-`-`-` } \/ { A`, A`-, A`-`, A`-`-, A`-`-`, A`-`-`-, A`-`-`-` };
end;

theorem 
  Kurat14Set A = Kurat14Part A \/ Kurat14Part A`;

theorem 
  A in Kurat14Set A & A- in Kurat14Set A & A-` in Kurat14Set A & A-
  `- in Kurat14Set A & A-`-` in Kurat14Set A & A-`-`- in Kurat14Set A & A-`-`-`
  in Kurat14Set A;

theorem 
  A` in Kurat14Set A & A`- in Kurat14Set A & A`-` in Kurat14Set A &
A`-`- in Kurat14Set A & A`-`-` in Kurat14Set A & A`-`-`- in Kurat14Set A & A`-`
  -`-` in Kurat14Set A;

definition
  let T, A;
  func Kurat14ClPart A -> Subset-Family of T equals

  { A-, A-`-, A-`-`-, A`-, A
  `-`-, A`-`-`- };
  func Kurat14OpPart A -> Subset-Family of T equals

  { A-`, A-`-`, A-`-`-`, A`-
  `, A`-`-`, A`-`-`-` };
end;

theorem 
  Kurat14Set A = { A, A` } \/ Kurat14ClPart A \/ Kurat14OpPart A;

registration
  let T, A;
  cluster Kurat14Set A -> finite;
end;

theorem 
  for Q being Subset of T holds Q in Kurat14Set A implies Q` in
  Kurat14Set A & Q- in Kurat14Set A;

theorem 
  card Kurat14Set A <= 14;

begin 

definition
  let T, A;
  func Kurat7Set A -> Subset-Family of T equals

  { A, Int A, Cl A, Int Cl A, Cl
  Int A, Cl Int Cl A, Int Cl Int A };
end;

theorem 
  Kurat7Set A = { A } \/ { Int A, Int Cl A, Int Cl Int A } \/ { Cl A, Cl
  Int A, Cl Int Cl A };

registration
  let T, A;
  cluster Kurat7Set A -> finite;
end;

theorem 
  for Q being Subset of T holds Q in Kurat7Set A implies Int Q in
  Kurat7Set A & Cl Q in Kurat7Set A;

begin 

definition
  func KurExSet -> Subset of R^1 equals

  {1} \/ RAT (2,4) \/ ]. 4, 5 .[ \/ ]. 5
  ,+infty .[;
end;

theorem 
  Cl KurExSet = {1} \/ [. 2,+infty .[;

theorem 
  (Cl KurExSet)` = ]. -infty, 1 .[ \/ ]. 1, 2 .[;

theorem 
  Cl (Cl KurExSet)` = ]. -infty, 2 .];

theorem 
  (Cl (Cl KurExSet)`)` = ]. 2,+infty .[;

theorem 
  Cl (Cl (Cl KurExSet)`)` = [. 2,+infty .[;

theorem 
  (Cl (Cl (Cl KurExSet)`)`)` = ]. -infty, 2 .[;

theorem 
  KurExSet` = ]. -infty, 1 .[ \/ ]. 1, 2 .] \/ IRRAT(2,4) \/ {4} \/ {5};

theorem 
  Cl KurExSet` = ]. -infty, 4 .] \/ {5};

theorem 
  (Cl KurExSet`)` = ]. 4, 5 .[ \/ ]. 5,+infty .[;

theorem 
  Cl (Cl KurExSet`)` = [. 4,+infty .[;

theorem 
  (Cl (Cl KurExSet`)`)` = ]. -infty, 4 .[;

theorem 
  Cl (Cl (Cl KurExSet`)`)` = ]. -infty, 4 .];

theorem 
  (Cl (Cl (Cl KurExSet`)`)`)` = ]. 4,+infty .[;

begin 

theorem 
  Int KurExSet = ]. 4, 5 .[ \/ ]. 5,+infty .[;

theorem 
  Cl Int KurExSet = [. 4,+infty .[;

theorem 
  Int Cl Int KurExSet = ]. 4,+infty .[;

theorem 
  Int Cl KurExSet = ]. 2,+infty .[;

theorem 
  Cl Int Cl KurExSet = [. 2,+infty .[;

begin 

theorem 
  Cl Int Cl KurExSet <> Int Cl KurExSet;

theorem 
  Cl Int Cl KurExSet <> Cl KurExSet;

theorem 
  Cl Int Cl KurExSet <> Int Cl Int KurExSet;

theorem 
  Cl Int Cl KurExSet <> Cl Int KurExSet;

theorem 
  Cl Int Cl KurExSet <> Int KurExSet;

theorem 
  Int Cl KurExSet <> Cl KurExSet;

theorem 
  Int Cl KurExSet <> Int Cl Int KurExSet;

theorem 
  Int Cl KurExSet <> Cl Int KurExSet;

theorem 
  Int Cl KurExSet <> Int KurExSet;

theorem 
  Int Cl Int KurExSet <> Cl KurExSet;

theorem 
  Cl Int KurExSet <> Cl KurExSet;

theorem 
  Int KurExSet <> Cl KurExSet;

theorem 
  Cl KurExSet <> KurExSet;

theorem 
  KurExSet <> Int KurExSet;

theorem 
  Cl Int KurExSet <> Int Cl Int KurExSet;

theorem 
  Int Cl Int KurExSet <> Int KurExSet;

theorem 
  Cl Int KurExSet <> Int KurExSet;

begin 

theorem 
  Int Cl Int KurExSet <> Int Cl KurExSet;

theorem 
  Int KurExSet, Int Cl KurExSet, Int Cl Int KurExSet are_mutually_different;

theorem 
  Cl KurExSet, Cl Int KurExSet, Cl Int Cl KurExSet are_mutually_different;

theorem 
  for X being set st X in { Int KurExSet, Int Cl KurExSet, Int Cl
  Int KurExSet } holds X is open non empty Subset of R^1;

theorem 
  for X being set st X in { Int KurExSet, Int Cl KurExSet, Int Cl
  Int KurExSet } holds X <> REAL;

theorem 
  for X being set st X in { Cl KurExSet, Cl Int KurExSet, Cl Int Cl
  KurExSet } holds X <> REAL;

theorem 
  { Int KurExSet, Int Cl KurExSet, Int Cl Int KurExSet } misses {
  Cl KurExSet, Cl Int KurExSet, Cl Int Cl KurExSet };

theorem 
  Int KurExSet, Int Cl KurExSet, Int Cl Int KurExSet, Cl KurExSet,
  Cl Int KurExSet, Cl Int Cl KurExSet are_mutually_different;

registration
  cluster KurExSet -> non closed non open;
end;

theorem 
  { Int KurExSet, Int Cl KurExSet, Int Cl Int KurExSet, Cl
  KurExSet, Cl Int KurExSet, Cl Int Cl KurExSet } misses { KurExSet };

theorem 
  KurExSet, Int KurExSet, Int Cl KurExSet, Int Cl Int KurExSet, Cl
  KurExSet, Cl Int KurExSet, Cl Int Cl KurExSet are_mutually_different;

theorem 
  card Kurat7Set KurExSet = 7;

begin 

registration
  cluster Kurat14ClPart KurExSet -> with_proper_subsets;
  cluster Kurat14OpPart KurExSet -> with_proper_subsets;
end;

registration
  cluster Kurat14Set KurExSet -> with_proper_subsets;
end;

registration
  cluster Kurat14Set KurExSet -> with_non-empty_elements;
end;

theorem 
  for A being with_non-empty_elements set, B being set st B c= A
  holds B is with_non-empty_elements;

registration
  cluster Kurat14ClPart KurExSet -> with_non-empty_elements;
  cluster Kurat14OpPart KurExSet -> with_non-empty_elements;
end;

registration
  cluster with_proper_subsets with_non-empty_elements for Subset-Family of R^1;
end;

theorem 
  for F, G being with_proper_subsets with_non-empty_elements
  Subset-Family of R^1 st F is open & G is closed holds F misses G;

registration
  cluster Kurat14ClPart KurExSet -> closed;
  cluster Kurat14OpPart KurExSet -> open;
end;

theorem 
  Kurat14ClPart KurExSet misses Kurat14OpPart KurExSet;

registration
  let T, A;
  cluster Kurat14ClPart A -> finite;
  cluster Kurat14OpPart A -> finite;
end;

theorem 
  card (Kurat14ClPart KurExSet) = 6;

theorem 
  card (Kurat14OpPart KurExSet) = 6;

theorem 
  { KurExSet, KurExSet` } misses Kurat14ClPart KurExSet;

registration
  cluster KurExSet -> non empty;
end;

theorem 
  KurExSet <> KurExSet`;

theorem 
  { KurExSet, KurExSet` } misses Kurat14OpPart KurExSet;


theorem 
  card Kurat14Set KurExSet = 14;

begin 

definition
  let T be TopStruct, A be Subset-Family of T;
  attr A is Cl-closed means

  for P being Subset of T st P in A holds Cl P in A;
  attr A is Int-closed means

  for P being Subset of T st P in A holds Int P in A;
end;

registration
  let T, A;
  cluster Kurat14Set A -> non empty;
  cluster Kurat14Set A -> Cl-closed;
  cluster Kurat14Set A -> compl-closed;
end;

registration
  let T, A;
  cluster Kurat7Set A -> non empty;
  cluster Kurat7Set A -> Int-closed;
  cluster Kurat7Set A -> Cl-closed;
end;

registration
  let T;
  cluster Int-closed Cl-closed non empty for Subset-Family of T;
  cluster compl-closed Cl-closed non empty for Subset-Family of T;
end;














begin 

definition
  let L be non empty ComplLLattStr;
  attr L is satisfying_DN_1 means


  for x, y, z, u being Element of L
  holds (((x + y)` + z)` + (x + (z` + (z + u)`)`)`)` = z;
end;

registration
  cluster TrivComplLat -> satisfying_DN_1;
  cluster TrivOrtLat -> satisfying_DN_1;
end;

registration
  cluster join-commutative join-associative satisfying_DN_1 for non empty
    ComplLLattStr;
end;

reserve L for satisfying_DN_1 non empty ComplLLattStr;
reserve x, y, z for Element of L;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z, u,
v being Element of L holds ((x + y)` + (((z + u)` + x)` + (y` + (y + v)`)`)`)`
  = y;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z, u
  being Element of L holds ((x + y)` + ((z + x)` + (y` + (y + u)`)`)`)` = y;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x being
  Element of L holds ((x + x`)` + x)` = x`;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z, u
being Element of L holds ((x + y)` + ((z + x)` + (((y + y`)` + y)` + (y + u)`)`
  )`)` = y;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z
  being Element of L holds ((x + y)` + ((z + x)` + y)`)` = y;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y being
  Element of L holds ((x + y)` + (x` + y)`)` = y;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y being
  Element of L holds (((x + y)` + x)` + (x + y)`)` = x;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y being
  Element of L holds (x + ((x + y)` + x)`)` = (x + y)`;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z
  being Element of L holds (((x + y)` + z)` + (x + z)`)` = z;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z
  being Element of L holds (x + ((y + z)` + (y + x)`)`)` = (y + x)`;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z
  being Element of L holds ((((x + y)` + z)` + (x` + y)`)` + y)` = (x` + y)`;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z
  being Element of L holds (x + ((y + z)` + (z + x)`)`)` = (z + x)`;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z, u
  being Element of L holds ((x + y)` + ((z + x)` + (y` + (u + y)`)`)`)` = y;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y being
  Element of L holds (x + y)` = (y + x)`;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z
  being Element of L holds (((x + y)` + (y + z)`)` + z)` = (y + z)`;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z
  being Element of L holds ((x + ((x + y)` + z)`)` + z)` = ((x + y)` + z)`;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y being
  Element of L holds (((x + y)` + x)` + y)` = (y + y)`;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y being
  Element of L holds (x` + (y + x)`)` = x;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y being
  Element of L holds ((x + y)` + y`)` = y;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y being
  Element of L holds (x + (y + x`)`)` = x`;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x being
  Element of L holds (x + x)` = x`;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y being
  Element of L holds (((x + y)` + x)` + y)` = y`;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x being
  Element of L holds x`` = x;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y being
  Element of L holds ((x + y)` + x)`+ y = y``;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y being
  Element of L holds (x + y)`` = y + x;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z
  being Element of L holds x + ((y + z)` + (y + x)`)` = (y + x )``;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y being
  Element of L holds x + y = y + x;

registration
  cluster satisfying_DN_1 -> join-commutative for non empty ComplLLattStr;
end;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y being
  Element of L holds ((x + y)` + x)` + y = y;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y being
  Element of L holds ((x + y)` + y)`+ x = x;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y being
  Element of L holds x + ((y + x)` + y)` = x;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y being
  Element of L holds (x + y`)` + (y` + y)` = (x + y`)`;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y being
  Element of L holds (x + y)` + (y + y`)` = (x + y)`;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y being
  Element of L holds (x + y)` + (y` + y)` = (x + y)`;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y being
  Element of L holds ((x + y`)`` + y)` = (y` + y)`;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y being
  Element of L holds ((x + y`) + y)` = (y` + y)`;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z
  being Element of L holds ((((x + y`) + z)` + y)` + (y` + y)`)` = y;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z
  being Element of L holds x + ((y + z)` + (y + x)`)` = y + x;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z
  being Element of L holds x + (y + ((z + y)` + x)`)` = (z + y)` + x;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z being
  Element of L holds x + ((y + x)` + (y + z)`)` = y + x;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z
  being Element of L holds ((x + y)` + ((x + y)` + (x + z)`)`)` + y = y;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z
  being Element of L holds (((x + y`) + z)` + y)`` = y;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z
  being Element of L holds x + ((y + x`) + z)` = x;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z
  being Element of L holds x` + ((y + x) + z)` = x`;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y being
  Element of L holds (x + y)` + x = x + y`;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y being
  Element of L holds (x + (x + y`)`)` = (x + y)`;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z
  being Element of L holds ((x + y)` + (x + z))` + y = y;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z
  being Element of L holds (((x + y)` + z)` + (x` + y)`)` + y = (x` + y)``;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z
  being Element of L holds (((x + y)` + z)` + (x` + y)`)` + y = x` + y;

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z
being Element of L holds (x` + ((y + x)`` + (y + z))`)` + (y + z) = (y + x)``+
  (y + z);

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z
being Element of L holds (x` + ((y + x) + (y + z))`)` + (y + z) = (y + x)`` + (
  y + z);

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z
being Element of L holds (x` + ((y + x) + (y + z))`)` + (y + z) = (y + x) + (y
  + z);

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z
  being Element of L holds x`` + (y + z) = (y + x) + (y + z);

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z
  being Element of L holds (x + y) + (x + z) = y + (x + z);

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z being
  Element of L holds (x + y) + (x + z) = z + (x + y);

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z
  being Element of L holds x + (y + z) = z + (y + x);

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z being
  Element of L holds x + (y + z) = y + (z + x);

theorem 
  for L being satisfying_DN_1 non empty ComplLLattStr, x, y, z being
  Element of L holds (x + y) + z = x + (y + z);

registration
  cluster satisfying_DN_1 -> join-associative for non empty ComplLLattStr;
  cluster satisfying_DN_1 -> Robbins for non empty ComplLLattStr;
end;

theorem 
  for L being non empty ComplLLattStr, x, z being Element of L st L
  is join-commutative join-associative Huntington holds (z + x) *' (z + x`) = z
;

theorem 
  for L being join-commutative join-associative non empty ComplLLattStr
   st L is Robbins holds L is satisfying_DN_1;

registration
  cluster join-commutative join-associative Robbins -> satisfying_DN_1 for non
    empty ComplLLattStr;
end;

registration
  cluster satisfying_DN_1 de_Morgan for preOrthoLattice;
end;

registration
  cluster satisfying_DN_1 de_Morgan -> Boolean for preOrthoLattice;
  cluster Boolean -> satisfying_DN_1 for well-complemented preOrthoLattice;
end;

begin 

definition
  let L be non empty ComplLLattStr;
  attr L is satisfying_MD_1 means


  for x, y being Element of L holds (x` + y)` + x = x;
  attr L is satisfying_MD_2 means


  for x, y, z being Element of L holds (x` + y)` + (z + y) = y + (z + x);
end;

registration
  cluster satisfying_MD_1 satisfying_MD_2 -> join-commutative join-associative
    Huntington for non empty ComplLLattStr;
  cluster join-commutative join-associative Huntington -> satisfying_MD_1
    satisfying_MD_2 for non empty ComplLLattStr;
end;

registration
  cluster satisfying_MD_1 satisfying_MD_2 satisfying_DN_1 de_Morgan
    for preOrthoLattice;
end;

registration
  cluster satisfying_MD_1 satisfying_MD_2 de_Morgan -> Boolean for
preOrthoLattice;
  cluster Boolean -> satisfying_MD_1 satisfying_MD_2 for well-complemented
    preOrthoLattice;
end;














begin 

definition
  let X,Y be non empty RLSStruct;
  func Add_in_Prod_of_RLS(X,Y) -> BinOp of [:the carrier of X, the carrier of
  Y:] means


  for z1, z2 being Element of [:the carrier of X, the carrier of
Y:], x1, x2 being VECTOR of X, y1, y2 being VECTOR of Y st z1 = [x1,y1] & z2 =
  [x2,y2] holds it.(z1,z2) = [(the addF of X).[x1,x2],(the addF of Y).[y1,y2]];
end;

definition
  let X,Y be non empty RLSStruct;
  func Mult_in_Prod_of_RLS(X,Y) -> Function of [:REAL, [:the carrier of X, the
  carrier of Y:]:], [:the carrier of X, the carrier of Y:] means


  for a
being Real, z being Element of [:the carrier of X, the carrier of Y:], x being
VECTOR of X, y being VECTOR of Y st z = [x,y] holds it.(a,z) = [(the Mult of X)
  .[a,x],(the Mult of Y).[a,y]];
end;

definition
  let X,Y be non empty RLSStruct;
  func Prod_of_RLS(X,Y) -> RLSStruct equals

  RLSStruct(# [:the carrier of X,
the carrier of Y:], [0.X,0.Y], Add_in_Prod_of_RLS(X,Y), Mult_in_Prod_of_RLS(X,Y
    ) #);
end;

registration
  let X,Y be non empty RLSStruct;
  cluster Prod_of_RLS(X,Y) -> non empty;
end;

theorem 
  for X,Y being non empty RLSStruct, x being VECTOR of X, y being VECTOR
of Y, u being VECTOR of Prod_of_RLS(X,Y), p being Real st u = [x,y] holds p*u =
  [p*x,p*y];

theorem 
  for X,Y being non empty RLSStruct, x1, x2 being VECTOR of X, y1,
y2 being VECTOR of Y, u1, u2 being VECTOR of Prod_of_RLS(X,Y) st u1 = [x1,y1] &
  u2 = [x2,y2] holds u1+u2 = [x1+x2,y1+y2];

registration
  let X,Y be Abelian non empty RLSStruct;
  cluster Prod_of_RLS(X,Y) -> Abelian;
end;

registration
  let X,Y be add-associative non empty RLSStruct;
  cluster Prod_of_RLS(X,Y) -> add-associative;
end;

registration
  let X,Y be right_zeroed non empty RLSStruct;
  cluster Prod_of_RLS(X,Y) -> right_zeroed;
end;

registration
  let X,Y be right_complementable non empty RLSStruct;
  cluster Prod_of_RLS(X,Y) -> right_complementable;
end;

registration
  let X,Y be vector-distributive scalar-distributive scalar-associative
  scalar-unital
  non empty RLSStruct;
  cluster Prod_of_RLS(X,Y) -> vector-distributive scalar-distributive
  scalar-associative scalar-unital;
end;

theorem 
  for X,Y being RealLinearSpace, n being Element of NAT, x being
  FinSequence of the carrier of X, y being FinSequence of the carrier of Y, z
being FinSequence of the carrier of Prod_of_RLS(X,Y) st len x = n & len y = n &
  len z = n & (for i being Element of NAT st i in Seg n holds z.i = [x.i,y.i])
  holds Sum z = [Sum x, Sum y];

begin 

definition
  func RLS_Real -> non empty RLSStruct equals

  RLSStruct(# REAL,0,addreal,
    multreal #);
end;

registration
  cluster RLS_Real -> Abelian add-associative right_zeroed
    right_complementable vector-distributive
    scalar-distributive scalar-associative scalar-unital;
end;

begin

begin 

definition
  let X be non empty RLSStruct, f be Function of the carrier of X,ExtREAL;
  func epigraph f -> Subset of Prod_of_RLS(X,RLS_Real) equals

  {[x,y] where x
  is Element of X, y is Element of REAL: f.x <= R_EAL(y)};
end;

definition
  let X be non empty RLSStruct, f be Function of the carrier of X,ExtREAL;
  attr f is convex means


  epigraph f is convex;
end;

theorem 
  for X being non empty RLSStruct, f being Function of the carrier
of X,ExtREAL st (for x being VECTOR of X holds f.x <> -infty) holds f is convex
iff for x1, x2 being VECTOR of X, p being Real st 0<p & p<1 holds f.(p*x1+(1-p)
  *x2) <= R_EAL(p)*f.x1+R_EAL(1-p)*f.x2;

theorem 
  for X being RealLinearSpace, f being Function of the carrier of X,
ExtREAL st (for x being VECTOR of X holds f.x <> -infty) holds f is convex iff
for x1, x2 being VECTOR of X, p being Real st 0<=p & p<=1 holds f.(p*x1+(1-p)*
  x2) <= R_EAL(p)*f.x1+R_EAL(1-p)*f.x2;

begin 

theorem 
  for f being PartFunc of REAL,REAL, g being Function of the carrier of
  RLS_Real,ExtREAL, X being Subset of RLS_Real st X c= dom f & for x being Real
  holds (x in X implies g.x=f.x) & (not x in X implies g.x=+infty) holds g is
  convex iff f is_convex_on X & X is convex;

begin 

theorem 
  for X being RealLinearSpace, M being Subset of X holds M is
  convex iff for n being non empty Nat, p being FinSequence of REAL, y,z being
FinSequence of the carrier of X st len p = n & len y = n & len z = n & Sum p =
  1 & (for i being Nat st i in Seg n holds p.i>0 & z.i=p.i*y/.i & y/.i in M)
  holds Sum(z) in M;

begin

theorem 
  for X being RealLinearSpace, f being Function of the carrier of
  X,ExtREAL st (for x being VECTOR of X holds f.x <> -infty) holds f is convex
iff for n being non empty Element of NAT, p being FinSequence of REAL, F being
FinSequence of ExtREAL, y,z being FinSequence of the carrier of X st len p = n
  & len F = n & len y = n & len z = n & Sum p = 1 & (for i being Element of NAT
st i in Seg n holds p.i>0 & z.i=p.i*y/.i & F.i = R_EAL(p.i)*f.(y/.i)) holds f.
  Sum(z) <= Sum F;

theorem 
  for X being RealLinearSpace, f being Function of the carrier of X,
ExtREAL st (for x being VECTOR of X holds f.x <> -infty) holds f is convex iff
  for n being non empty Element of NAT, p being FinSequence of REAL, F being
FinSequence of ExtREAL, y,z being FinSequence of the carrier of X st len p = n
  & len F = n & len y = n & len z = n & Sum p = 1 & (for i being Element of NAT
st i in Seg n holds p.i>=0 & z.i=p.i*y/.i & F.i = R_EAL(p.i)*f.(y/.i)) holds f.
  Sum(z) <= Sum F;














begin 

registration
  cluster reflexive -> complete for 1-element RelStr;
end;

definition
  let T be RelStr;
  mode type of T is Element of T;
end;

definition
  let T be RelStr;
  attr T is Noetherian means


  the InternalRel of T is co-well_founded;
end;

registration
  cluster -> Noetherian for 1-element RelStr;
end;

definition
  let T be non empty RelStr;
  redefine attr T is Noetherian means


  for A being non empty Subset of T
  ex a being Element of T st a in A & for b being Element of T st b in A holds
  not a < b;
end;

definition
  let T be Poset;
  attr T is Mizar-widening-like means

  T is sup-Semilattice & T is Noetherian;
end;

registration
  cluster Mizar-widening-like -> Noetherian with_suprema upper-bounded for
Poset;
end;

registration
  cluster Noetherian -> Mizar-widening-like for sup-Semilattice;
end;

registration
  cluster Mizar-widening-like for complete sup-Semilattice;
end;

registration
  let T be Noetherian RelStr;
  cluster the InternalRel of T -> co-well_founded;
end;

theorem 
  for T being Noetherian sup-Semilattice for I being Ideal of T
  holds ex_sup_of I, T & sup I in I;

begin 

definition
  struct AdjectiveStr (# adjectives -> set, non-op -> UnOp of the adjectives
  #);
end;

definition
  let A be AdjectiveStr;
  attr A is void means


  the adjectives of A is empty;
  mode adjective of A is Element of the adjectives of A;
end;

theorem 
  for A1,A2 being AdjectiveStr st the adjectives of A1 = the adjectives
  of A2 holds A1 is void implies A2 is void;

definition
  let A be AdjectiveStr;
  let a be Element of the adjectives of A;
  func non-a -> adjective of A equals

  (the non-op of A).a;
end;

theorem 
  for A1,A2 being AdjectiveStr st the AdjectiveStr of A1 = the
AdjectiveStr of A2 for a1 being adjective of A1, a2 being adjective of A2 st a1
  = a2 holds non-a1 = non-a2;

definition
  let A be AdjectiveStr;
  attr A is involutive means


  for a being adjective of A holds non-non-a = a;
  attr A is without_fixpoints means

  not ex a being adjective of A st non-a = a;
end;

theorem 
  for a1,a2 being set st a1 <> a2 for A being AdjectiveStr st the
adjectives of A = {a1,a2} & (the non-op of A).a1 = a2 & (the non-op of A).a2 =
  a1 holds A is non void involutive without_fixpoints;

theorem 
  for A1,A2 being AdjectiveStr st the AdjectiveStr of A1 = the
  AdjectiveStr of A2 holds A1 is involutive implies A2 is involutive;

theorem 
  for A1,A2 being AdjectiveStr st the AdjectiveStr of A1 = the
  AdjectiveStr of A2 holds A1 is without_fixpoints implies A2 is
  without_fixpoints;

registration
  cluster non void involutive without_fixpoints for strict AdjectiveStr;
end;

registration
  let A be non void AdjectiveStr;
  cluster the adjectives of A -> non empty;
end;

definition
  struct(RelStr,AdjectiveStr) TA-structure(# carrier, adjectives -> set,
    InternalRel -> (Relation of the carrier), non-op -> UnOp of the adjectives,
    adj-map -> Function of the carrier, Fin the adjectives #);
end;

registration
  let X be non empty set;
  let A be set;
  let r be Relation of X;
  let n be UnOp of A;
  let a be Function of X, Fin A;
  cluster TA-structure(#X,A,r,n,a#) -> non empty;
end;

registration
  let X be set;
  let A be non empty set;
  let r be Relation of X;
  let n be UnOp of A;
  let a be Function of X, Fin A;
  cluster TA-structure(#X,A,r,n,a#) -> non void;
end;

registration
  cluster 1-element reflexive non void involutive without_fixpoints
    strict for TA-structure;
end;

definition
  let T be TA-structure;
  let t be Element of T;
  func adjs t -> Subset of the adjectives of T equals

  (the adj-map of T).t;
end;

theorem 
  for T1,T2 being TA-structure st the TA-structure of T1 = the
  TA-structure of T2 for t1 being type of T1, t2 being type of T2 st t1 = t2
  holds adjs t1 = adjs t2;

definition
  let T be TA-structure;
  attr T is consistent means


  for t being type of T for a being
  adjective of T st a in adjs t holds not non-a in adjs t;
end;

theorem 
  for T1,T2 being TA-structure st the TA-structure of T1 = the
  TA-structure of T2 holds T1 is consistent implies T2 is consistent;

definition
  let T be non empty TA-structure;
  attr T is adj-structured means

  the adj-map of T is join-preserving Function
  of T, (BoolePoset the adjectives of T) opp;
end;

theorem 
  for T1,T2 being non empty TA-structure st the TA-structure of T1
  = the TA-structure of T2 holds T1 is adj-structured implies T2 is
  adj-structured;

definition
  let T be reflexive transitive antisymmetric with_suprema TA-structure;
  redefine attr T is adj-structured means


  for t1,t2 being type of T holds adjs(t1"\/"t2) = (adjs t1) /\ (adjs t2);
end;

theorem 
  for T being reflexive transitive antisymmetric with_suprema
TA-structure st T is adj-structured for t1,t2 being type of T st t1 <= t2 holds
  adjs t2 c= adjs t1;

definition
  let T be TA-structure;
  let a be Element of the adjectives of T;
  func types a -> Subset of T means


  for x being set holds x in it iff
  ex t being type of T st x = t & a in adjs t;
end;

definition
  let T be non empty TA-structure;
  let A be Subset of the adjectives of T;
  func types A -> Subset of T means


  for t being type of T holds t in
  it iff for a being adjective of T st a in A holds t in types a;
end;

theorem 
  for T1,T2 being TA-structure st the TA-structure of T1 = the
TA-structure of T2 for a1 being adjective of T1, a2 being adjective of T2 st a1
  = a2 holds types a1 = types a2;

theorem 
  for T being non empty TA-structure for a being adjective of T holds
  types a = {t where t is type of T: a in adjs t};

theorem 
  for T being TA-structure for t being type of T, a being
  adjective of T holds a in adjs t iff t in types a;

theorem 
  for T being non empty TA-structure for t being type of T, A
  being Subset of the adjectives of T holds A c= adjs t iff t in types A;

theorem 
  for T being non void TA-structure for t being type of T holds adjs t =
  {a where a is adjective of T: t in types a};

theorem 
  for T being non empty TA-structure holds types ({} the
  adjectives of T) = the carrier of T;

definition
  let T be TA-structure;
  attr T is adjs-typed means

  for a being adjective of T holds types a \/ types non-a is non empty;
end;

theorem 
  for T1,T2 being TA-structure st the TA-structure of T1 = the
  TA-structure of T2 holds T1 is adjs-typed implies T2 is adjs-typed;

registration
  cluster non void Mizar-widening-like involutive without_fixpoints consistent
adj-structured adjs-typed for complete upper-bounded 1-element reflexive
    transitive antisymmetric strict TA-structure;
end;

theorem 
  for T being consistent TA-structure for a being adjective of T holds
  types a misses types non-a;

registration
  let T be adj-structured reflexive transitive antisymmetric with_suprema
  TA-structure;
  let a be adjective of T;
  cluster types a -> lower directed;
end;

registration
  let T be adj-structured reflexive transitive antisymmetric with_suprema
  TA-structure;
  let A be Subset of the adjectives of T;
  cluster types A -> lower directed;
end;

begin 

definition
  let T be TA-structure;
  let t be Element of T;
  let a be adjective of T;
  pred a is_applicable_to t means


  ex t9 being type of T st t9 in types a & t9 <= t;
end;

definition
  let T be TA-structure;
  let t be type of T;
  let A be Subset of the adjectives of T;
  pred A is_applicable_to t means


  ex t9 being type of T st A c= adjs t9 & t9 <= t;
end;

theorem 
  for T being adj-structured reflexive transitive antisymmetric
with_suprema TA-structure for a being adjective of T for t being type of T st
  a is_applicable_to t holds types a /\ downarrow t is Ideal of T;

definition
  let T be non empty reflexive transitive TA-structure;
  let t be Element of T;
  let a be adjective of T;
  func a ast t -> type of T equals

  sup(types a /\ downarrow t);
end;

theorem 
  for T being Noetherian adj-structured reflexive transitive
  antisymmetric with_suprema TA-structure for t being type of T for a being
  adjective of T st a is_applicable_to t holds a ast t <= t;

theorem 
  for T being Noetherian adj-structured reflexive transitive
  antisymmetric with_suprema TA-structure for t being type of T for a being
  adjective of T st a is_applicable_to t holds a in adjs(a ast t);

theorem 
  for T being Noetherian adj-structured reflexive transitive
  antisymmetric with_suprema TA-structure for t being type of T for a being
  adjective of T st a is_applicable_to t holds a ast t in types a;

theorem 
  for T being Noetherian adj-structured reflexive transitive
  antisymmetric with_suprema TA-structure for t being type of T for a being
  adjective of T for t9 being type of T st t9 <= t & a in adjs t9 holds a
  is_applicable_to t & t9 <= a ast t;

theorem 
  for T being Noetherian adj-structured reflexive transitive
  antisymmetric with_suprema TA-structure for t being type of T for a being
  adjective of T st a in adjs t holds a is_applicable_to t & a ast t = t;

theorem 
  for T being Noetherian adj-structured reflexive transitive
  antisymmetric with_suprema TA-structure for t being type of T for a,b being
  adjective of T st a is_applicable_to t & b is_applicable_to a ast t holds b
  is_applicable_to t & a is_applicable_to b ast t & a ast (b ast t) = b ast (a
  ast t);

theorem 
  for T being adj-structured reflexive transitive antisymmetric
  with_suprema TA-structure for A being Subset of the adjectives of T for t
  being type of T st A is_applicable_to t holds types A /\ downarrow t is Ideal
  of T;

definition
  let T be non empty reflexive transitive TA-structure;
  let t be type of T;
  let A be Subset of the adjectives of T;
  func A ast t -> type of T equals

  sup(types A /\ downarrow t);
end;

theorem 
  for T being non empty reflexive transitive antisymmetric
  TA-structure for t being type of T holds ({} the adjectives of T) ast t = t;

definition
  let T be non empty non void reflexive transitive TA-structure;
  let t be type of T;
  let p be FinSequence of the adjectives of T;
  func apply(p,t) -> FinSequence of the carrier of T means


  len it =
  len p+1 & it.1 = t & for i being Element of NAT, a being adjective of T, t
  being type of T st i in dom p & a = p.i & t = it.i holds it.(i+1) = a ast t;
end;

registration
  let T be non empty non void reflexive transitive TA-structure;
  let t be type of T;
  let p be FinSequence of the adjectives of T;
  cluster apply(p,t) -> non empty;
end;

theorem 
  for T being non empty non void reflexive transitive TA-structure for t
  being type of T holds apply(<*> the adjectives of T, t) = <*t*>;

theorem 
  for T being non empty non void reflexive transitive TA-structure
for t being type of T, a be adjective of T holds apply(<*a*>, t) = <*t, a ast t
  *>;

definition
  let T be non empty non void reflexive transitive TA-structure;
  let t be type of T;
  let v be FinSequence of the adjectives of T;
  func v ast t -> type of T equals

  apply(v,t).(len v+1);
end;

theorem 
  for T being non empty non void reflexive transitive TA-structure for t
  being type of T holds (<*> the adjectives of T) ast t = t;

theorem 
  for T being non empty non void reflexive transitive TA-structure
  for t being type of T for a being adjective of T holds <*a*> ast t = a ast t;

theorem 
  for p,q being FinSequence for i being Nat st i >= 1 & i <
  len p holds (p$^q).i = p.i;

theorem 
  for p being non empty FinSequence, q being FinSequence for i
  being Nat st i < len q holds (p$^q).(len p+i) = q.(i+1);

theorem 
  for T being non empty non void reflexive transitive TA-structure
for t being type of T for v1,v2 being FinSequence of the adjectives of T holds
  apply(v1^v2, t) = apply(v1, t) $^ apply(v2, v1 ast t);

theorem 
  for T being non empty non void reflexive transitive TA-structure
for t being type of T for v1,v2 being FinSequence of the adjectives of T for i
  being Nat st i in dom v1 holds apply(v1^v2, t).i = apply(v1, t).i;

theorem 
  for T being non empty non void reflexive transitive TA-structure
for t being type of T for v1,v2 being FinSequence of the adjectives of T holds
  apply(v1^v2, t).(len v1+1) = v1 ast t;

theorem 
  for T being non empty non void reflexive transitive TA-structure
for t being type of T for v1,v2 being FinSequence of the adjectives of T holds
  v2 ast (v1 ast t) = v1^v2 ast t;

definition
  let T be non empty non void reflexive transitive TA-structure;
  let t be type of T;
  let v be FinSequence of the adjectives of T;
  pred v is_applicable_to t means


  for i being Nat, a being
  adjective of T, s being type of T st i in dom v & a = v.i & s = apply(v,t).i
  holds a is_applicable_to s;
end;

theorem 
  for T being non empty non void reflexive transitive TA-structure for t
  being type of T holds <*> the adjectives of T is_applicable_to t;

theorem 
  for T being non empty non void reflexive transitive TA-structure for t
  being type of T, a being adjective of T holds a is_applicable_to t iff <*a*>
  is_applicable_to t;

theorem 
  for T being non empty non void reflexive transitive TA-structure
for t being type of T for v1,v2 being FinSequence of the adjectives of T st v1^
v2 is_applicable_to t holds v1 is_applicable_to t & v2 is_applicable_to v1 ast
  t;

theorem 
  for T being Noetherian adj-structured reflexive transitive
  antisymmetric with_suprema non void TA-structure for t being type of T for v
  being FinSequence of the adjectives of T st v is_applicable_to t for i1,i2
being Nat st 1 <= i1 & i1 <= i2 & i2 <= len v+1 for t1,t2 being type
  of T st t1 = apply(v,t).i1 & t2 = apply(v,t).i2 holds t2 <= t1;

theorem 
  for T being Noetherian adj-structured reflexive transitive
  antisymmetric with_suprema non void TA-structure for t being type of T for v
  being FinSequence of the adjectives of T st v is_applicable_to t for s being
  type of T st s in rng apply(v, t) holds v ast t <= s & s <= t;

theorem 
  for T being Noetherian adj-structured reflexive transitive
  antisymmetric with_suprema non void TA-structure for t being type of T for v
being FinSequence of the adjectives of T st v is_applicable_to t holds v ast t
  <= t;

theorem 
  for T being Noetherian adj-structured reflexive transitive
  antisymmetric with_suprema non void TA-structure for t being type of T for v
being FinSequence of the adjectives of T st v is_applicable_to t holds rng v c=
  adjs (v ast t);

theorem 
  for T being Noetherian adj-structured reflexive transitive
  antisymmetric with_suprema non void TA-structure for t being type of T for v
  being FinSequence of the adjectives of T st v is_applicable_to t for A being
  Subset of the adjectives of T st A = rng v holds A is_applicable_to t;

theorem 
  for T being Noetherian adj-structured reflexive transitive
antisymmetric with_suprema non void TA-structure for t being type of T for v1,
  v2 being FinSequence of the adjectives of T st v1 is_applicable_to t & rng v2
  c= rng v1 for s being type of T st s in rng apply(v2,t) holds v1 ast t <= s;

theorem 
  for T being Noetherian adj-structured reflexive transitive
antisymmetric with_suprema non void TA-structure for t being type of T for v1,
  v2 being FinSequence of the adjectives of T st v1^v2 is_applicable_to t holds
  v2^v1 is_applicable_to t;

theorem 
  for T being Noetherian adj-structured reflexive transitive
antisymmetric with_suprema non void TA-structure for t being type of T for v1,
  v2 being FinSequence of the adjectives of T st v1^v2 is_applicable_to t holds
  v1^v2 ast t = v2^v1 ast t;

theorem 
  for T being Noetherian adj-structured reflexive transitive
  antisymmetric with_suprema TA-structure for t being type of T for A being
  Subset of the adjectives of T st A is_applicable_to t holds A ast t <= t;

theorem 
  for T being Noetherian adj-structured reflexive transitive
  antisymmetric with_suprema TA-structure for t being type of T for A being
Subset of the adjectives of T st A is_applicable_to t holds A c= adjs(A ast t);

theorem 
  for T being Noetherian adj-structured reflexive transitive
  antisymmetric with_suprema TA-structure for t being type of T for A being
Subset of the adjectives of T st A is_applicable_to t holds A ast t in types A;

theorem 
  for T being Noetherian adj-structured reflexive transitive
  antisymmetric with_suprema TA-structure for t being type of T for A being
Subset of the adjectives of T for t9 being type of T st t9 <= t & A c= adjs t9
  holds A is_applicable_to t & t9 <= A ast t;

theorem 
  for T being Noetherian adj-structured reflexive transitive
  antisymmetric with_suprema TA-structure for t being type of T for A being
Subset of the adjectives of T st A c= adjs t holds A is_applicable_to t & A ast
  t = t;

theorem 
  for T being TA-structure, t being type of T for A,B being Subset
  of the adjectives of T st A is_applicable_to t & B c= A holds B
  is_applicable_to t;

theorem 
  for T being Noetherian adj-structured reflexive transitive
  antisymmetric with_suprema non void TA-structure for t being type of T, a
being adjective of T for A,B being Subset of the adjectives of T st B = A \/ {a
  } & B is_applicable_to t holds a ast (A ast t) = B ast t;

theorem 
  for T being Noetherian adj-structured reflexive transitive
  antisymmetric with_suprema non void TA-structure for t being type of T for v
  being FinSequence of the adjectives of T st v is_applicable_to t for A being
  Subset of the adjectives of T st A = rng v holds v ast t = A ast t;

begin 

definition
  let T be non empty non void TA-structure;
  func sub T -> Function of the adjectives of T, the carrier of T means



  for a being adjective of T holds it.a = sup(types a \/ types non-a);
end;

definition
  struct(TA-structure) TAS-structure(# carrier, adjectives -> set, InternalRel
    -> (Relation of the carrier), non-op -> UnOp of the adjectives, adj-map ->
    Function of the carrier, Fin the adjectives, sub-map -> Function of the
    adjectives, the carrier #);
end;

registration
  cluster non void reflexive 1-element strict for TAS-structure;
end;

definition
  let T be non empty non void TAS-structure;
  let a be adjective of T;
  func sub a -> type of T equals

  (the sub-map of T).a;
end;

definition
  let T be non empty non void TAS-structure;
  attr T is non-absorbing means

  (the sub-map of T)*(the non-op of T) = the sub-map of T;
  attr T is subjected means

  for a being adjective of T holds types a \/ types
non-a is_<=_than sub a & (types a <> {} & types non-a <> {} implies sub a = sup
  (types a \/ types non-a));
end;

definition
  let T be non empty non void TAS-structure;
  redefine attr T is non-absorbing means

  for a being adjective of T holds sub non-a = sub a;
end;

definition
  let T be non empty non void TAS-structure;
  let t be Element of T;
  let a be adjective of T;
  pred a is_properly_applicable_to t means


  t <= sub a & a is_applicable_to t;
end;

definition
  let T be non empty non void reflexive transitive TAS-structure;
  let t be type of T;
  let v be FinSequence of the adjectives of T;
  pred v is_properly_applicable_to t means


  for i being Nat,
a being adjective of T, s being type of T st i in dom v & a = v.i & s = apply(v
  ,t).i holds a is_properly_applicable_to s;
end;

theorem 
  for T being non empty non void reflexive transitive
TAS-structure for t being type of T, v being FinSequence of the adjectives of T
  st v is_properly_applicable_to t holds v is_applicable_to t;

theorem 
  for T being non empty non void reflexive transitive TAS-structure for
  t being type of T holds <*> the adjectives of T is_properly_applicable_to t;

theorem 
  for T being non empty non void reflexive transitive TAS-structure for
  t being type of T, a being adjective of T holds a is_properly_applicable_to t
  iff <*a*> is_properly_applicable_to t;

theorem 
  for T being non empty non void reflexive transitive
TAS-structure for t being type of T, v1,v2 being FinSequence of the adjectives
of T st v1^v2 is_properly_applicable_to t holds v1 is_properly_applicable_to t
  & v2 is_properly_applicable_to v1 ast t;

theorem 
  for T being non empty non void reflexive transitive
TAS-structure for t being type of T, v1,v2 being FinSequence of the adjectives
of T st v1 is_properly_applicable_to t & v2 is_properly_applicable_to v1 ast t
  holds v1^v2 is_properly_applicable_to t;

definition
  let T be non empty non void reflexive transitive TAS-structure;
  let t be type of T;
  let A be Subset of the adjectives of T;
  pred A is_properly_applicable_to t means


  ex s being FinSequence of
  the adjectives of T st rng s = A & s is_properly_applicable_to t;
end;

theorem 
  for T being non empty non void reflexive transitive
TAS-structure for t being type of T, A being Subset of the adjectives of T st A
  is_properly_applicable_to t holds A is finite;

theorem 
  for T being non empty non void reflexive transitive
  TAS-structure for t being type of T holds {} the adjectives of T
  is_properly_applicable_to t;

scheme 

  MinimalFiniteSet{P[set]}: ex A being finite set st P[A] & for B being set st
  B c= A & P[B] holds B = A
provided
 ex A being finite set st P[A];

theorem 
  for T being non empty non void reflexive transitive
TAS-structure for t being type of T, A being Subset of the adjectives of T st A
is_properly_applicable_to t ex B being Subset of the adjectives of T st B c= A
& B is_properly_applicable_to t & A ast t = B ast t & for C being Subset of the
  adjectives of T st C c= B & C is_properly_applicable_to t & A ast t = C ast t
  holds C = B;

definition
  let T be non empty non void reflexive transitive TAS-structure;
  attr T is commutative means


  for t1,t2 being type of T, a being
  adjective of T st a is_properly_applicable_to t1 & a ast t1 <= t2 ex A being
finite Subset of the adjectives of T st A is_properly_applicable_to t1 "\/" t2
  & A ast (t1 "\/" t2) = t2;
end;

registration
  cluster Mizar-widening-like involutive without_fixpoints consistent
    adj-structured adjs-typed non-absorbing subjected commutative for complete
    upper-bounded non void 1-element reflexive transitive antisymmetric
    strict TAS-structure;
end;

theorem 
  for T being Noetherian adj-structured reflexive transitive
  antisymmetric with_suprema non void TAS-structure for t being type of T, A
being Subset of the adjectives of T st A is_properly_applicable_to t ex s being
  one-to-one FinSequence of the adjectives of T st rng s = A & s
  is_properly_applicable_to t;

begin 

definition
  let T be non empty non void reflexive transitive TAS-structure;
  func T @--> -> Relation of T means


  for t1,t2 being type of T holds [
  t1,t2] in it iff ex a being adjective of T st not a in adjs t2 & a
  is_properly_applicable_to t2 & a ast t2 = t1;
end;

theorem 
  for T being adj-structured antisymmetric non void reflexive
  transitive with_suprema Noetherian TAS-structure holds T@--> c= the
  InternalRel of T;

scheme 

  RedInd{X() -> non empty set, P[set,set], R() -> Relation of X()}: for x,y
  being Element of X() st R() reduces x,y holds P[x,y]
provided
 for x,y being Element of X() st [x,y] in R() holds P[x,y] and
 for x being Element of X() holds P[x,x] and
 for x,y,z being Element of X() st P[x,y] & P[y,z] holds P[x,z];

theorem 
  for T being adj-structured antisymmetric non void reflexive
transitive with_suprema Noetherian TAS-structure for t1,t2 being type of T st
  T@--> reduces t1,t2 holds t1 <= t2;

theorem 
  for T being Noetherian adj-structured reflexive transitive
  antisymmetric non void with_suprema TAS-structure holds T@--> is irreflexive;

theorem 
  for T being adj-structured antisymmetric non void reflexive
  transitive with_suprema Noetherian TAS-structure holds T@--> is
  strongly-normalizing;

theorem 
  for T being Noetherian adj-structured reflexive transitive
  antisymmetric with_suprema non void TAS-structure for t being type of T, A
  being finite Subset of the adjectives of T st for C being Subset of the
  adjectives of T st C c= A & C is_properly_applicable_to t & A ast t = C ast t
holds C = A for s being one-to-one FinSequence of the adjectives of T st rng s
= A & s is_properly_applicable_to t for i being Nat st 1 <= i & i <=
  len s holds [apply(s, t).(i+1), apply(s, t).i] in T@-->;

theorem 
  for T being Noetherian adj-structured reflexive transitive
  antisymmetric with_suprema non void TAS-structure for t being type of T, A
  being finite Subset of the adjectives of T st for C being Subset of the
  adjectives of T st C c= A & C is_properly_applicable_to t & A ast t = C ast t
holds C = A for s being one-to-one FinSequence of the adjectives of T st rng s
  = A & s is_properly_applicable_to t holds Rev apply(s, t) is RedSequence of T
  @-->;

theorem 
  for T being Noetherian adj-structured reflexive transitive
  antisymmetric with_suprema non void TAS-structure for t being type of T, A
  being finite Subset of the adjectives of T st A is_properly_applicable_to t
  holds T@--> reduces A ast t, t;

theorem 
  for X being non empty set for R being Relation of X for r being
  RedSequence of R st r.1 in X holds r is FinSequence of X;

theorem 
  for X being non empty set for R being Relation of X for x be
  Element of X, y being set st R reduces x,y holds y in X;

theorem 
  for X being non empty set for R being Relation of X st R is
  with_UN_property weakly-normalizing for x be Element of X holds nf(x, R) in X
;

theorem 
  for T being Noetherian adj-structured reflexive transitive
  antisymmetric with_suprema non void TAS-structure for t1, t2 being type of T
  st T@--> reduces t1, t2 ex A being finite Subset of the adjectives of T st A
  is_properly_applicable_to t2 & t1 = A ast t2;

theorem 
  for T being adj-structured antisymmetric commutative non void
  reflexive transitive with_suprema Noetherian TAS-structure holds T@--> is
  with_Church-Rosser_property with_UN_property;

begin 

definition
  let T be adj-structured with_suprema antisymmetric commutative non empty
  non void reflexive transitive Noetherian TAS-structure;
  let t be type of T;
  func radix t -> type of T equals

  nf(t, T@-->);
end;

theorem 
  for T being adj-structured with_suprema antisymmetric
commutative non empty non void reflexive transitive Noetherian TAS-structure
  for t being type of T holds T@--> reduces t, radix t;

theorem 
  for T being adj-structured with_suprema antisymmetric commutative non
empty non void reflexive transitive Noetherian TAS-structure for t being type
  of T holds t <= radix t;

theorem 
  for T being adj-structured with_suprema antisymmetric
commutative non empty non void reflexive transitive Noetherian TAS-structure
  for t being type of T for X being set st X = {t9 where t9 is type of T: ex A
being finite Subset of the adjectives of T st A is_properly_applicable_to t9 &
  A ast t9 = t} holds ex_sup_of X, T & radix t = "\/"(X, T);

theorem 
  for T being adj-structured with_suprema antisymmetric
commutative non empty non void reflexive transitive Noetherian TAS-structure
  for t1,t2 being type of T, a being adjective of T st a
  is_properly_applicable_to t1 & a ast t1 <= radix t2 holds t1 <= radix t2;

theorem 
  for T being adj-structured with_suprema antisymmetric commutative non
  empty non void reflexive transitive Noetherian TAS-structure for t1,t2 being
  type of T st t1 <= t2 holds radix t1 <= radix t2;

theorem 
  for T being adj-structured with_suprema antisymmetric commutative non
empty non void reflexive transitive Noetherian TAS-structure for t being type
  of T, a being adjective of T st a is_properly_applicable_to t holds radix (a
  ast t) = radix t;














begin

reserve a,b,s,t,u,lambda for Real,
  n for Nat;
reserve x,x1,x2,x3,y1,y2 for Element of REAL n;

theorem 
  0 * x + x = x & x + 0*n = x;

theorem 
  a*(0*n) = 0*n;

theorem 
  1*x = x & 0 * x = 0*n;

theorem 
  (a*b)*x = a*(b*x);

theorem 
  a*x = 0*n implies a = 0 or x = 0*n;

theorem 
  a*(x1 + x2) = a*x1 + a*x2;

theorem 
  (a + b)*x = a*x + b*x;

theorem 
  a*x1 = a*x2 implies a = 0 or x1 = x2;

definition
  let n;
  let x1,x2 be Element of REAL n;
  func Line(x1,x2) -> Subset of REAL n equals

  { (1-lambda)*x1 + lambda*x2 :
  not contradiction };
end;

registration
  let n;
  let x1,x2 be Element of REAL n;
  cluster Line(x1,x2) -> non empty;
end;

definition
  let n;
  let x1,x2 be Element of REAL n;
  redefine func Line(x1,x2);
  commutativity;
end;

theorem 
  x1 in Line(x1,x2) & x2 in Line(x1,x2);

theorem 
  y1 in Line(x1,x2) & y2 in Line(x1,x2) implies Line(y1,y2) c= Line(x1,x2);

theorem 
  y1 in Line(x1,x2) & y2 in Line(x1,x2) & y1<>y2 implies Line(x1,
  x2) c= Line(y1,y2);

definition
  let n;
  let A be Subset of REAL n;
  attr A is being_line means


  ex x1,x2 st x1<>x2 & A=Line(x1,x2);
end;

theorem 
  for A,C be Subset of REAL n,x1,x2 holds A is being_line & C is
  being_line & x1 in A & x2 in A & x1 in C & x2 in C implies x1=x2 or A=C;

theorem 
  for A be Subset of REAL n st A is being_line holds ex x1,x2 st
  x1 in A & x2 in A & x1<>x2;

theorem 
  for A be Subset of REAL n st A is being_line holds ex x2 st x1<>x2 & x2 in A;

theorem 
  for x being Element of REAL n holds |.x.| = sqrt |(x,x)|;

theorem 
  for x being Element of REAL n holds |(x,x)| = 0 iff |.x.| = 0;

theorem 
  for x being Element of REAL n holds |(x,x)|=0 iff x=0*n;

theorem 
  for x being Element of REAL n holds |(x, 0*n)| = 0;

theorem 
  for x being Element of REAL n holds |(0*n,x)| = 0;

theorem 
  for x1,x2,x3 being Element of REAL n holds |((x1+x2),x3)| = |(x1
  ,x3)| + |(x2,x3)|;

theorem 
  for x1,x2 being Element of REAL n,a being real number holds |(a*
  x1,x2)| = a*|(x1,x2)|;

theorem 
  for x1,x2 being Element of REAL n,a being real number holds |(x1,a*x2
  )| = a*|(x1,x2)|;

theorem 
  for x1,x2 being Element of REAL n holds |(-x1, x2)| = - |(x1, x2 )|;

theorem 
  for x1,x2 being Element of REAL n holds |(x1, -x2)| = - |(x1, x2)|;

theorem 
  for x1,x2 being Element of REAL n holds |(-x1, -x2)| = |(x1, x2)|;

theorem 
  for x1,x2,x3 being Element of REAL n holds |(x1-x2, x3)| = |(x1,
  x3)| - |(x2, x3)|;

theorem 
  for a,b being real number,x1,x2,x3 being Element of REAL n holds |( (a
  *x1+b*x2), x3 )| = a*|(x1,x3)| + b*|(x2,x3)|;

theorem 
  for x1,y1,y2 being Element of REAL n holds |(x1, y1+y2)| = |(x1, y1)|
  + |(x1, y2)|;

theorem 
  for x1,y1,y2 being Element of REAL n holds |(x1, y1-y2)| = |(x1, y1)|
  - |(x1, y2)|;

theorem 
  for x1,x2,y1,y2 being Element of REAL n holds |(x1+x2, y1+y2)| =
  |(x1, y1)| + |(x1, y2)| + |(x2, y1)| + |(x2, y2)|;

theorem 
  for x1,x2,y1,y2 being Element of REAL n holds |(x1-x2, y1-y2)| =
  |(x1, y1)| - |(x1, y2)| - |(x2, y1)| + |(x2, y2)|;

theorem 
  for x,y being Element of REAL n holds |(x+y, x+y)| = |(x, x)| +
  2*|(x, y)| + |(y, y)|;

theorem 
  for x,y being Element of REAL n holds |(x-y, x-y)| = |(x, x)| -
  2*|(x, y)| + |(y, y)|;

theorem 
  for x,y being Element of REAL n holds |.x+y.|^2 = |.x.|^2 + 2*|(x, y)|
  + |.y.|^2;

theorem 
  for x,y being Element of REAL n holds |.x-y.|^2 = |.x.|^2 - 2*|(x, y)|
  + |.y.|^2;

theorem 
  for x,y being Element of REAL n holds |.x+y.|^2 + |.x-y.|^2 = 2*(|.x.|
  ^2 + |.y.|^2);

theorem 
  for x,y being Element of REAL n holds |.x+y.|^2 - |.x-y.|^2 = 4* |(x,y )|;

theorem 
  for x,y being Element of REAL n holds abs |(x,y)| <= |.x.|*|.y.|;

theorem 
  for x,y being Element of REAL n holds |.x+y.| <= |.x.| + |.y.|;

theorem 
  for R being Subset of REAL,x1,x2,y1 being Element of REAL n st R={|.y1
-x.| where x is Element of REAL n: x in Line(x1,x2)} holds ex y2 being Element
  of REAL n st y2 in Line(x1,x2) & |.y1-y2.|=lower_bound R & x1-x2,y1-y2
  are_orthogonal;

definition

  let n;
  let p1,p2 be Point of TOP-REAL n;
  func Line(p1,p2) -> Subset of TOP-REAL n equals

  { (1-lambda)*p1 + lambda*p2
  : not contradiction };
end;

registration
  let n;
  let p1,p2 be Point of TOP-REAL n;
  cluster Line(p1,p2) -> non empty;
end;

reserve p1,p2,q1,q2 for Point of TOP-REAL n;

definition
  let n;
  let p1,p2 be Point of TOP-REAL n;
  redefine func Line(p1,p2);
  commutativity;
end;

theorem 
  p1 in Line(p1,p2) & p2 in Line(p1,p2);

theorem 
  q1 in Line(p1,p2) & q2 in Line(p1,p2) implies Line(q1,q2) c= Line(p1,p2);

theorem 
  q1 in Line(p1,p2) & q2 in Line(p1,p2) & q1<>q2 implies Line(p1,
  p2) c= Line(q1,q2);

definition
  let n;
  let A be Subset of TOP-REAL n;
  attr A is being_line means


  ex p1,p2 st p1<>p2 & A=Line(p1,p2);
end;

theorem 
  for A,C being Subset of TOP-REAL n holds A is being_line & C is
  being_line & p1 in A & p2 in A & p1 in C & p2 in C implies p1=p2 or A=C;

theorem 
  for A being Subset of TOP-REAL n st A is being_line holds ex p1,
  p2 st p1 in A & p2 in A & p1<>p2;

theorem 
  for A being Subset of TOP-REAL n st A is being_line holds ex p2 st p1
  <>p2 & p2 in A;

theorem 
  for R being Subset of REAL,p1,p2,q1 being Point of TOP-REAL n st R={|.
  q1-p .| where p is Point of TOP-REAL n: p in Line(p1,p2)} holds ex q2 being
Point of TOP-REAL n st q2 in Line(p1,p2) & |. q1-q2 .| =lower_bound R & p1-p2,
  q1-q2 are_orthogonal;














begin

reserve x,y,z for Real,
  x3,y3 for Element of REAL,
  p for Point of TOP-REAL 3;

theorem 
  ex x, y, z st p= <* x, y, z *>;

definition
  let p;
  func p`1 -> Real equals

  p.1;
  func p`2 -> Real equals

  p.2;
  func p`3 -> Real equals

  p.3;
end;

notation
  let x, y, z be real number;
  synonym |[ x,y,z ]| for <*x,y,z*>;
end;

definition
  let x, y, z be real number;
  redefine func |[ x,y,z ]| -> Point of TOP-REAL 3;
end;

theorem 
  |[ x,y,z ]|`1 = x & |[x,y,z]|`2 = y & |[x,y,z]|`3 = z;

theorem 
  p = |[ p`1, p`2, p`3 ]|;

theorem 
  0.TOP-REAL 3 = |[ 0,0,0 ]|;

reserve p1,p2,p3,p4 for Point of TOP-REAL 3,
  x1,x2,y1,y2,z1,z2 for Real;

theorem 
  p1 + p2 = |[ p1`1 + p2`1, p1`2 + p2`2, p1`3 + p2`3]|;

theorem 
  |[x1,y1,z1]| + |[x2,y2,z2]| = |[x1+x2, y1+y2, z1+z2]|;

theorem 
  x*p = |[ x*p`1, x*p`2, x*p`3]|;

theorem 
  x * |[x1,y1,z1]| = |[ x*x1, x*y1, x*z1]|;

theorem 
  (x*p)`1 = x * p`1 & (x*p)`2 = x * p`2 & (x*p)`3 = x * p`3;

theorem 
  -p = |[ -p`1, -p`2, -p`3]|;

theorem 
  -|[x1,y1,z1]| = |[ -x1, -y1, -z1]|;

theorem 
  p1 - p2 = |[ p1`1 - p2`1, p1`2 - p2`2, p1`3 - p2`3]|;

theorem 
  |[x1, y1, z1]| - |[x2, y2, z2]| = |[ x1-x2, y1-y2, z1-z2]|;

definition
  let p1, p2;

  func p1 <X> p2 -> Point of TOP-REAL 3 equals

  |[ (p1`2 * p2`3) - (p1`3 * p2`2
  ) , (p1`3 * p2`1) - (p1`1 * p2`3) , (p1`1 * p2`2) - (p1`2 * p2`1) ]|;
end;

theorem 
  p = |[x, y, z]| implies p`1 = x & p`2 = y & p`3 = z;

theorem 
  |[x1, y1, z1]| <X> |[x2, y2, z2]| = |[ (y1 * z2) - (z1 * y2) , (
  z1 * x2) - (x1 * z2) , (x1 * y2) - (y1 * x2) ]|;

theorem 
  (x*p1) <X> p2 = x* (p1 <X> p2) & (x*p1) <X> p2 = p1 <X> (x*p2);

theorem 
  p1<X>p2 = - p2<X>p1;

theorem 
  (-p1) <X> p2 = p1 <X> (-p2);

theorem 
  |[0, 0, 0]| <X> |[x, y, z]| = 0.TOP-REAL 3;

theorem 
  |[x1, 0, 0]| <X> |[x2, 0, 0]| = 0.TOP-REAL 3;

theorem 
  |[0, y1, 0]| <X> |[0, y2, 0]| = 0.TOP-REAL 3;

theorem 
  |[0, 0, z1]| <X> |[0, 0, z2]| = 0.TOP-REAL 3;

theorem 
  p1 <X> (p2+p3) = ( p1 <X> p2 ) + ( p1 <X> p3 );

theorem 
  (p1+p2) <X> p3 = ( p1 <X> p3 ) + ( p2 <X> p3 );

theorem 
  p1 <X> p1 = 0.TOP-REAL 3;

theorem 
  (p1+p2) <X> (p3+p4) = p1<X>p3 + p1<X>p4 + p2<X>p3 + p2<X>p4;





theorem 
  p = <* p`1, p`2, p`3 *>;

theorem 
  for f1, f2 be FinSequence of REAL st len f1 = 3 & len f2 = 3
  holds mlt(f1, f2) = <* f1.1*f2.1, f1.2*f2.2, f1.3*f2.3 *>;

theorem 
  |(p1,p2)| = p1`1*p2`1 + p1`2*p2`2 + p1`3*p2`3;

theorem 
  |( |[ x1, x2, x3 ]|, |[ y1, y2, y3 ]| )| = x1*y1 + x2*y2 + x3*y3;





definition
  let p1, p2, p3;
  func |{ p1,p2,p3 }| -> real number equals

  |(p1, p2<X>p3)|;
end;

theorem 
  |{ p1, p1, p2 }| = 0 & |{ p2, p1, p2 }| = 0;

theorem 
  p1 <X> ( p2<X>p3 ) = ( |(p1,p3)| * p2 ) - ( |(p1,p2)| * p3 );

theorem 
  |{ p1, p2, p3 }| = |{ p2, p3, p1 }|;

theorem 
  |{ p1, p2, p3 }| = |{ p3, p1, p2 }|;

theorem 
  |{ p1, p2, p3 }| = |( p1<X>p2, p3 )|;














begin 

definition
  let R be RelStr;
  attr R is real means


  the carrier of R c= REAL & for x,y being real
  number st x in the carrier of R & y in the carrier of R holds [x,y] in the
  InternalRel of R iff x <= y;
end;

definition
  let R be RelStr;
  attr R is interval means


  R is real & ex a,b being real number st a <= b & the carrier of R = [.a,b.];
end;

registration
  cluster interval -> real non empty for RelStr;
end;

registration
  cluster empty -> real for RelStr;
end;

theorem 
  for X being Subset of REAL ex R being strict RelStr st the
  carrier of R = X & R is real;

registration
  cluster interval strict for RelStr;
end;

theorem 
  for R1,R2 being real RelStr st the carrier of R1 = the carrier of
  R2 holds the RelStr of R1 = the RelStr of R2;

registration
  let R be non empty real RelStr;
  cluster -> real for Element of R;
end;

definition
  let X be Subset of REAL;
  func RealPoset X -> real strict RelStr means


  the carrier of it = X;
end;

registration
  let X be non empty Subset of REAL;
  cluster RealPoset X -> non empty;
end;

notation
  let R be RelStr;
  let x,y be Element of R;
  synonym x <<= y for x <= y;
  synonym y >>= x for x <= y;
  antonym x ~<= y for x <= y;
  antonym y ~>= x for x <= y;
end;

theorem 
  for R being non empty real RelStr for x,y being Element of R
  holds x <= y iff x <<= y;

registration
  cluster real -> reflexive antisymmetric transitive for RelStr;
end;

registration
  cluster -> connected for real non empty RelStr;
end;

definition
  let R be non empty real RelStr;
  let x,y be Element of R;
  redefine func max(x,y) -> Element of R;
end;

definition
  let R be non empty real RelStr;
  let x,y be Element of R;
  redefine func min(x,y) -> Element of R;
end;

registration
  cluster -> with_suprema with_infima for real non empty RelStr;
end;

reserve x,y,z for real number,
  R for real non empty RelStr,
  a,b for Element of R;

registration
  let R;
  let a,b be Element of R;
  identify a"\/"b with max(a,b);
  identify a"/\"b with min(a,b);
end;

theorem 
  a"\/"b = max(a,b);

theorem 
  a"/\"b = min(a,b);

theorem 
  (ex x st x in the carrier of R & for y st y in the carrier of R
  holds x <= y) iff R is lower-bounded;

theorem 
  (ex x st x in the carrier of R & for y st y in the carrier of R
  holds x >= y) iff R is upper-bounded;

registration
  cluster interval -> bounded for non empty RelStr;
end;

theorem 
  for R being interval non empty RelStr, X being set holds ex_sup_of X,R;

registration
  cluster -> complete for interval non empty RelStr;
end;

registration
  cluster -> distributive for Chain;
end;

registration
  cluster -> Heyting for interval non empty RelStr;
end;

registration
  cluster [.0,1 .] -> non empty;
end;

registration
  cluster RealPoset [.0,1 .] -> interval;
end;

begin 

theorem 
  for I being non empty set for J being RelStr-yielding non-Empty
reflexive-yielding ManySortedSet of I st for i being Element of I holds J.i is
  sup-Semilattice holds product J is with_suprema;

theorem 
  for I being non empty set for J being RelStr-yielding non-Empty
reflexive-yielding ManySortedSet of I st for i being Element of I holds J.i is
  Semilattice holds product J is with_infima;

theorem 
  for I being non empty set for J being RelStr-yielding non-Empty
reflexive-yielding ManySortedSet of I st for i being Element of I holds J.i is
  Semilattice for f,g being Element of product J, i being Element of I holds (f
  "/\" g).i = (f.i) "/\" (g.i);

theorem 
  for I being non empty set for J being RelStr-yielding non-Empty
reflexive-yielding ManySortedSet of I st for i being Element of I holds J.i is
sup-Semilattice for f,g being Element of product J, i being Element of I holds
  (f "\/" g).i = (f.i) "\/" (g.i);

theorem 
  for I being non empty set for J being RelStr-yielding non-Empty
reflexive-yielding ManySortedSet of I st for i being Element of I holds J.i is
  Heyting complete LATTICE holds product J is complete Heyting;

registration
  let A be non empty set;
  let R be complete Heyting LATTICE;
  cluster R |^ A -> Heyting;
end;

begin 

definition
  let A be non empty set;
  func FuzzyLattice A -> Heyting complete LATTICE equals

  (RealPoset [. 0,1 .])
  |^ A;
end;

theorem 
  for A being non empty set holds the carrier of FuzzyLattice A =
  Funcs(A, [. 0, 1 .]);

registration
  let A be non empty set;
  cluster FuzzyLattice A -> constituted-Functions;
end;

theorem 
  for R being complete Heyting LATTICE, X being Subset of R, y be
Element of R holds "\/"(X,R) "/\" y = "\/"({x "/\" y where x is Element of R: x
  in X},R);

definition
  let X be non empty set;
  let a be Element of FuzzyLattice X;
  func @a -> Membership_Func of X equals

  a;
end;

definition
  let X be non empty set;
  let f be Membership_Func of X;
  func (X,f)@ -> Element of FuzzyLattice X equals

  f;
end;

definition
  let X be non empty set;
  let f be Membership_Func of X;
  let x be Element of X;
  redefine func f.x -> Element of RealPoset [. 0,1 .];
end;

definition
  let X,Y be non empty set;
  let f be RMembership_Func of X,Y;
  let x be Element of X, y be Element of Y;
  redefine func f.(x,y) -> Element of RealPoset [. 0,1 .];
end;

definition
  let X be non empty set;
  let f be Element of FuzzyLattice X;
  let x be Element of X;
  redefine func f.x -> Element of RealPoset [. 0,1 .];
end;

reserve C for non empty set,
  c for Element of C,
  f,g for Membership_Func of C,
  s,t for Element of FuzzyLattice C;

theorem 
  (for c holds f.c <= g.c) iff (C,f)@ <<= (C,g)@;

theorem 
  s <<= t iff for c holds @s.c <= @t.c;

theorem 
  max(f,g) = (C,f)@ "\/" (C,g)@;

theorem 
  s "\/" t = max(@s, @t);

theorem 
  min(f,g) = (C,f)@ "/\" (C,g)@;

theorem 
  s "/\" t = min(@s, @t);

begin 

scheme 

  SupDistributivity { L() -> complete LATTICE, X, Y() -> non empty set, F(set,
set) -> Element of L(), P,Q[set]}: "\/"({ "\/"({F(x,y) where y is Element of Y(
  ): Q[y]}, L()) where x is Element of X(): P[x] }, L()) = "\/"({F(x,y) where x
  is Element of X(), y is Element of Y(): P[x] & Q[y]}, L());

scheme 

  SupDistributivity9 { L() -> complete LATTICE, X, Y() -> non empty set, F(set
,set) -> Element of L(), P,Q[set]}: "\/"({ "\/"({F(x,y) where x is Element of X
  (): P[x]},L()) where y is Element of Y(): Q[y] }, L()) = "\/"({F(x,y) where x
  is Element of X(), y is Element of Y(): P[x] & Q[y]}, L());

scheme 

  FraenkelF9R9{ A() -> non empty set,B() -> non empty set, F1, F2(set,set) ->
set, P[set,set] } : { F1(u1,v1) where u1 is (Element of A()), v1 is Element of
B() : P[u1,v1] } = { F2(u2,v2) where u2 is (Element of A()), v2 is Element of B
  () : P[u2,v2] }
provided
 for u being (Element of A()), v being Element of B() st P[u,v] holds
F1(u,v) = F2(u,v);

scheme 

  FraenkelF699R { A() -> non empty set, B() -> non empty set, F1, F2(set,set)
-> set, P[set,set], Q[set,set] } : { F1(u1,v1) where u1 is (Element of A()), v1
  is Element of B() : P[u1,v1] } = { F2(u2,v2) where u2 is (Element of A()), v2
  is Element of B() : Q[u2,v2] }
provided
 for u being (Element of A()), v being Element of B() holds P[u,v]
iff Q[u,v] and
 for u being (Element of A()), v being Element of B() st P[u,v] holds
F1(u,v) = F2(u,v);

scheme 

  SupCommutativity { L() -> complete LATTICE, X, Y() -> non empty set, F1, F2(
set,set) -> Element of L(), P,Q[set]}: "\/"({ "\/"({F1(x,y) where y is Element
of Y(): Q[y]}, L()) where x is Element of X(): P[x] }, L()) = "\/"({ "\/"({F2(
x9,y9) where x9 is Element of X(): P[x9]}, L()) where y9 is Element of Y(): Q[
  y9] }, L())
provided
 for x being Element of X(), y being Element of Y() st P[x] & Q[y]
holds F1(x,y) = F2(x,y);

theorem 
  for X,Y,Z being non empty set for R being RMembership_Func of X,
Y for S being RMembership_Func of Y,Z for x being Element of X, z being Element
of Z holds (R (#) S).(x,z) = "\/"({R.(x,y) "/\" S.(y,z) where y is Element of Y
  : not contradiction}, RealPoset [. 0,1 .]);

theorem 
  for X,Y,Z,W being non empty set for R being RMembership_Func of X,Y
for S being RMembership_Func of Y,Z for T being RMembership_Func of Z,W holds (
  R (#) S) (#) T = R (#) (S (#) T);














begin

definition
  let T be 1-sorted;
  mode SetSequence of T is SetSequence of the carrier of T;
end;

begin 

reserve n for Element of NAT;

registration
  let f be FinSequence of the carrier of TOP-REAL 2;
  cluster L~f -> closed;
end;

theorem 
  for x being Point of Euclid n, r being real number holds Ball (x
  , r) is open Subset of TOP-REAL n;

theorem 
  for p being Point of Euclid n, x, p9 being Point of TOP-REAL n,
  r being real number st p = p9 & x in Ball (p, r) holds |. x - p9 .| < r;

theorem 
  for p being Point of Euclid n, x, p9 being Point of TOP-REAL n,
  r being real number st p = p9 & |. x - p9 .| < r holds x in Ball (p, r);

theorem 
  for n being Element of NAT, r being Point of TOP-REAL n, X being
Subset of TOP-REAL n st r in Cl X holds ex seq being Real_Sequence of n st rng
  seq c= X & seq is convergent & lim seq = r;

registration
  let M be non empty MetrSpace;
  cluster TopSpaceMetr M -> first-countable;
end;

theorem 
  for T being non empty TopSpace holds T is first-countable iff
  the TopStruct of T is first-countable;

registration
  let n be Element of NAT;
  cluster TOP-REAL n -> first-countable;
end;

theorem 
  for A being Subset of TOP-REAL n, p being Point of TOP-REAL n, p9
  being Point of Euclid n st p = p9 holds p in Cl A iff for r being real number
  st r > 0 holds Ball (p9, r) meets A;

theorem 
  for x, y being Point of TOP-REAL n, x9 being Point of Euclid n st x9 =
  x & x <> y ex r being Real st not y in Ball (x9, r);

theorem 
  for S being Subset of TOP-REAL n holds S is non bounded iff for
r being Real st r > 0 holds ex x, y being Point of Euclid n st x in S & y in S
  & dist (x, y) > r;

theorem 
  for a, b being real number, x, y being Point of Euclid n st Ball
  (x, a) meets Ball (y, b) holds dist (x, y) < a + b;

theorem 
  for a, b, c being real number, x, y, z being Point of Euclid n
st Ball (x, a) meets Ball (z, c) & Ball (z, c) meets Ball (y, b) holds dist (x,
  y) < a + b + 2*c;

theorem 
  for X, Y being non empty TopSpace, x being Point of X, y being
Point of Y, V being Subset of [: X, Y :] holds V is a_neighborhood of [: {x}, {
  y} :] iff V is a_neighborhood of [ x, y ];

begin 

theorem 
  for T being non empty 1-sorted, F, G being SetSequence of the
  carrier of T, A being Subset of T st G is subsequence of F & for i being Nat
  holds F.i = A holds G = F;

theorem 
  for T being non empty 1-sorted, S being SetSequence of the carrier of
T, R being subsequence of S, n being Element of NAT holds ex m being Element of
  NAT st m >= n & R.n = S.m;

begin 

definition

  let T be non empty TopSpace;
  let S be SetSequence of the carrier of T;
  func Lim_inf S -> Subset of T means


  for p being Point of T holds p
  in it iff for G being a_neighborhood of p ex k being Element of NAT st for m
  being Element of NAT st m > k holds S.m meets G;
end;

theorem 
  for S being SetSequence of the carrier of TOP-REAL n, p being
Point of TOP-REAL n, p9 being Point of Euclid n st p = p9 holds p in Lim_inf S
  iff for r being real number st r > 0 ex k being Element of NAT st for m being
  Element of NAT st m > k holds S.m meets Ball (p9, r);

theorem 
  for T being non empty TopSpace, S being SetSequence of the
  carrier of T holds Cl Lim_inf S = Lim_inf S;

registration
  let T be non empty TopSpace, S be SetSequence of the carrier of T;
  cluster Lim_inf S -> closed;
end;

theorem 
  for T being non empty TopSpace, R, S being SetSequence of the carrier
  of T st R is subsequence of S holds Lim_inf S c= Lim_inf R;

theorem 
  for T being non empty TopSpace, A, B being SetSequence of the
carrier of T st for i being Element of NAT holds A.i c= B.i holds Lim_inf A c=
  Lim_inf B;

theorem 
  for T being non empty TopSpace, A, B, C being SetSequence of the
carrier of T st for i being Element of NAT holds C.i = A.i \/ B.i holds Lim_inf
  A \/ Lim_inf B c= Lim_inf C;

theorem 
  for T being non empty TopSpace, A, B, C being SetSequence of the
carrier of T st for i being Element of NAT holds C.i = A.i /\ B.i holds Lim_inf
  C c= Lim_inf A /\ Lim_inf B;

theorem 
  for T being non empty TopSpace, F, G being SetSequence of the
carrier of T st for i being Element of NAT holds G.i = Cl (F.i) holds Lim_inf G
  = Lim_inf F;

theorem 
  for S being SetSequence of the carrier of TOP-REAL n, p being Point of
  TOP-REAL n holds (ex s being Real_Sequence of n st s is convergent & (for x
  being Element of NAT holds s.x in S.x) & p = lim s) implies p in Lim_inf S;

theorem 
  for T being non empty TopSpace, P being Subset of T, s being
  SetSequence of the carrier of T st (for i being Nat holds s.i c= P) holds
  Lim_inf s c= Cl P;

theorem 
  for T being non empty TopSpace, F being SetSequence of the
  carrier of T, A being Subset of T st for i being Nat holds F.i = A holds
  Lim_inf F = Cl A;

theorem 
  for T being non empty TopSpace, F being SetSequence of the carrier of
T, A being closed Subset of T st for i being Nat holds F.i = A holds Lim_inf F
  = A;

theorem 
  for S being SetSequence of the carrier of TOP-REAL n, P being
Subset of TOP-REAL n st P is bounded & (for i being Element of NAT holds S.i c=
  P) holds Lim_inf S is bounded;

theorem 
  for S being SetSequence of the carrier of TOP-REAL 2, P being Subset
  of TOP-REAL 2 st P is bounded & (for i being Element of NAT holds S.i c= P)
  holds Lim_inf S is compact;

theorem 
  for A, B being SetSequence of the carrier of TOP-REAL n, C being
  SetSequence of the carrier of [: TOP-REAL n, TOP-REAL n :] st for i being
  Element of NAT holds C.i = [:A.i, B.i:] holds [: Lim_inf A, Lim_inf B :] =
  Lim_inf C;

theorem 
  for S being SetSequence of TOP-REAL 2 holds lim_inf S c= Lim_inf S;

theorem 
  for C being Simple_closed_curve, i being Element of NAT holds Fr (UBD
  L~Cage (C,i))` = L~Cage (C,i);

begin 

definition
  let T be non empty TopSpace;
  let S be SetSequence of the carrier of T;
  func Lim_sup S -> Subset of T means


  for x being set holds x in it
  iff ex A being subsequence of S st x in Lim_inf A;
end;

theorem 
  for N being Element of NAT, F being sequence of TOP-REAL N, x being
  Point of TOP-REAL N, x9 being Point of Euclid N st x = x9 holds x
is_a_cluster_point_of F iff for r being real number, n being Element of NAT st
  r > 0 holds ex m being Element of NAT st n <= m & F.m in Ball (x9, r);

theorem 
  for T being non empty TopSpace, A being SetSequence of the
  carrier of T holds Lim_inf A c= Lim_sup A;

theorem 
  for A, B, C being SetSequence of the carrier of TOP-REAL 2 st (
for i being Element of NAT holds A.i c= B.i) & C is subsequence of A holds ex D
  being subsequence of B st for i being Element of NAT holds C.i c= D.i;

theorem 
  for A, B, C being SetSequence of the carrier of TOP-REAL 2 st (for i
being Element of NAT holds A.i c= B.i) & C is subsequence of B holds ex D being
  subsequence of A st for i being Element of NAT holds D.i c= C.i;

theorem 
  for A, B being SetSequence of the carrier of TOP-REAL 2 st for i
  being Element of NAT holds A.i c= B.i holds Lim_sup A c= Lim_sup B;

theorem 
  for A, B, C being SetSequence of the carrier of TOP-REAL 2 st for i
  being Element of NAT holds C.i = A.i \/ B.i holds Lim_sup A \/ Lim_sup B c=
  Lim_sup C;

theorem 
  for A, B, C being SetSequence of the carrier of TOP-REAL 2 st for i
  being Element of NAT holds C.i = A.i /\ B.i holds Lim_sup C c= Lim_sup A /\
  Lim_sup B;

theorem 
  for A, B being SetSequence of the carrier of TOP-REAL 2, C, C1
  being SetSequence of the carrier of [: TOP-REAL 2, TOP-REAL 2 :] st (for i
being Element of NAT holds C.i = [: A.i, B.i :]) & C1 is subsequence of C holds
  ex A1, B1 being SetSequence of the carrier of TOP-REAL 2 st A1 is subsequence
of A & B1 is subsequence of B & for i being Element of NAT holds C1.i = [: A1.i
  , B1.i :];

theorem 
  for A, B being SetSequence of the carrier of TOP-REAL 2, C being
  SetSequence of the carrier of [: TOP-REAL 2, TOP-REAL 2 :] st for i being
  Element of NAT holds C.i = [: A.i, B.i :] holds Lim_sup C c= [: Lim_sup A,
  Lim_sup B :];


theorem 
  for T being non empty TopSpace, F being SetSequence of the
  carrier of T, A being Subset of T st for i being Nat holds F.i = A holds
  Lim_inf F = Lim_sup F;

theorem 
  for F being SetSequence of the carrier of TOP-REAL 2, A being Subset
  of TOP-REAL 2 st for i being Nat holds F.i = A holds Lim_sup F = Cl A;

theorem 
  for F, G being SetSequence of the carrier of TOP-REAL 2 st for i being
  Element of NAT holds G.i = Cl (F.i) holds Lim_sup G = Lim_sup F;














begin 

reserve C for Simple_closed_curve,
  p,q,p1 for Point of TOP-REAL 2,
  i,j,k,n for Element of NAT,
  r,s for real number;

theorem 
  for T being non empty TopSpace, f being continuous RealMap of T,
  A being compact Subset of T holds f.:A is compact;

theorem 
for A being compact Subset of REAL, B being non empty Subset of REAL st B c= A
  holds lower_bound B in A;

theorem 
  for A,B being compact non empty Subset of TOP-REAL n,
  f being continuous RealMap of [:TOP-REAL n, TOP-REAL n:],
  g being RealMap of TOP-REAL n st for p being Point of TOP-REAL n
  ex G being Subset of REAL
  st G = { f.(p,q) where q is Point of TOP-REAL n : q in B } &
   g.p = lower_bound G
  holds lower_bound(f.:[:A,B:]) = lower_bound(g.:A);

theorem 
  for A,B being compact non empty Subset of TOP-REAL n,
  f being continuous RealMap of [:TOP-REAL n, TOP-REAL n:],
  g being RealMap of TOP-REAL n st for q being Point of TOP-REAL n
  ex G being Subset of REAL
  st G = { f.(p,q) where p is Point of TOP-REAL n : p in A } &
   g.q = lower_bound G
  holds lower_bound(f.:[:A,B:]) = lower_bound(g.:B );

theorem 
  q in Lower_Arc C & q <> W-min C implies LE E-max C, q, C;

theorem 
  q in Upper_Arc C implies LE q, E-max C, C;

begin 

definition
  let n;
  func Eucl_dist n -> RealMap of [:TOP-REAL n, TOP-REAL n:] means


  for p,q being Point of TOP-REAL n holds it.(p,q) =|.p - q.|;
end;

definition
  let T be non empty TopSpace, f be RealMap of T;
  redefine attr f is continuous means

  for p being Point of T, N being Neighbourhood of f.p
  ex V being a_neighborhood of p st f.:V c= N;
end;

registration
  let n;
  cluster Eucl_dist n -> continuous;
end;

begin 

theorem 


  for A,B being non empty compact Subset of TOP-REAL n st A misses B
  holds dist_min(A,B) > 0;

begin 

theorem 
  LE p,q,C & LE q, E-max C, C & p <> q implies
  Segment(p,q,C) = Segment(Upper_Arc C,W-min C,E-max C,p,q);

theorem 
  LE E-max C, q, C implies
  Segment(E-max C,q,C) = Segment(Lower_Arc C,E-max C,W-min C,E-max C,q);

theorem 
  LE E-max C, q, C implies
  Segment(q,W-min C,C) = Segment(Lower_Arc C,E-max C,W-min C,q,W-min C);

theorem 
  LE p,q,C & LE E-max C, p, C implies
  Segment(p,q,C) = Segment(Lower_Arc C,E-max C,W-min C,p,q);

theorem 
  LE p,E-max C,C & LE E-max C, q, C implies
  Segment(p,q,C) = R_Segment(Upper_Arc C,W-min C,E-max C,p)
  \/ L_Segment(Lower_Arc C,E-max C,W-min C,q);

theorem 
  LE p,E-max C,C implies
  Segment(p,W-min C,C) = R_Segment(Upper_Arc C,W-min C,E-max C,p)
  \/ L_Segment(Lower_Arc C,E-max C,W-min C,W-min C);

theorem 
  R_Segment(Upper_Arc C,W-min C,E-max C,p) =
  Segment(Upper_Arc C,W-min C,E-max C,p,E-max C);

theorem 
  L_Segment(Lower_Arc C,E-max C,W-min C,p) =
  Segment(Lower_Arc C,E-max C,W-min C,E-max C,p);

theorem 
  for p being Point of TOP-REAL 2 st p in C & p <> W-min C
  holds Segment(p,W-min C,C) is_an_arc_of p,W-min C;

theorem 
  for p,q being Point of TOP-REAL 2 st p<> q & LE p,q,C
  holds Segment(p,q,C) is_an_arc_of p,q;

theorem 
  C = Segment(W-min C,W-min C,C);

theorem 
  for q being Point of TOP-REAL 2 st q in C
  holds Segment(q,W-min C,C) is compact;

theorem 
  for q1,q2 being Point of TOP-REAL 2 st LE q1,q2,C
  holds Segment(q1,q2,C) is compact;

begin 

definition
  let C;
  mode Segmentation of C -> FinSequence of TOP-REAL 2 means


    it/.1=W-min C & it is one-to-one & 8<=len it & rng it c= C &
(for i being Element of NAT st 1<=i & i<len it holds LE it/.i,it/.(i+1),C) &
    (for i being Element of NAT st 1<=i & i+1<len it holds
    Segment(it/.i,it/.(i+1),C) /\ Segment(it/.(i+1),it/.(i+2),C)={it/.(i+1)}) &
    Segment(it/.len it,it/.1,C) /\ Segment(it/.1,it/.2,C)={it/.1} &
    Segment(it/.(len it-' 1),it/.len it,C)/\ Segment(it/.len it,it/.1,C)
    ={it/.len it} &
    Segment(it/.(len it-'1),it/.len it,C) misses Segment(it/.1,it/.2,C) &
    (for i,j being Element of NAT st 1<=i & i < j & j < len it &
    not i,j are_adjacent1
    holds Segment(it/.i,it/.(i+1),C) misses Segment(it/.j,it/.(j+1),C)) &
    for i being Element of NAT st 1 < i & i+1 < len it holds
    Segment(it/.len it,it/.1,C) misses Segment(it/.i,it/.(i+1),C);
end;

registration
  let C;
  cluster -> non trivial for Segmentation of C;
end;

theorem 
  for S being Segmentation of C, i st 1<=i & i <= len S holds S/.i in C;

begin 

definition
  let C;
  let i be Nat;
  let S be Segmentation of C;
  func Segm(S,i) -> Subset of TOP-REAL 2 equals


  Segment(S/.i,S/.(i+1),C) if 1<=i & i<len S
  otherwise Segment(S/.len S,S/.1,C);
end;

theorem 
  for S being Segmentation of C st i in dom S holds Segm(S,i) c= C;

registration
  let C;
  let S be Segmentation of C, i;
  cluster Segm(S,i) -> non empty compact;
end;

theorem 
  for S being Segmentation of C, p st p in C
  ex i being Nat st i in dom S & p in Segm(S,i);

theorem 
  for S being Segmentation of C
  for i,j st 1<=i & i< j & j<len S & not i,j are_adjacent1
  holds Segm(S,i) misses Segm(S,j);

theorem 
  for S being Segmentation of C for j st 1<j & j<len S -' 1
  holds Segm(S,len S) misses Segm(S,j);

theorem 
  for S being Segmentation of C
  for i,j st 1<=i & i< j & j<len S & i,j are_adjacent1
  holds Segm(S,i) /\ Segm(S,j)={S/.(i+1)};

theorem 
  for S being Segmentation of C
  for i,j st 1<=i & i< j & j<len S & i,j are_adjacent1
  holds Segm(S,i) meets Segm(S,j);

theorem 
  for S being Segmentation of C holds Segm(S,len S) /\ Segm(S,1) = {S/.1};

theorem 
  for S being Segmentation of C holds Segm(S,len S) meets Segm(S,1);

theorem 
  for S being Segmentation of C
  holds Segm(S,len S) /\ Segm(S,len S -' 1) = {S/.len S};

theorem 
  for S being Segmentation of C holds Segm(S,len S) meets Segm(S,len S -' 1);

begin 

definition
  let n;
  let C be Subset of TOP-REAL n;
  func diameter C -> Real means


  ex W being Subset of Euclid n st W = C & it = diameter W;
end;

definition
  let C;
  let S be Segmentation of C;
  func diameter S -> Real means


  ex S1 being non empty finite Subset of REAL st
  S1 = { diameter Segm(S,i): i in dom S} & it = max S1;
end;

theorem 
  for S being Segmentation of C, i holds diameter Segm(S,i) <= diameter S;

theorem 
  for S being Segmentation of C, e being Real
  st for i holds diameter Segm(S,i) < e holds diameter S < e;

theorem 
  for e being Real st e > 0 ex S being Segmentation of C st diameter S < e;

begin 

definition
  let C;
  let S be Segmentation of C;
  func S-Gap S -> Real means


  ex S1,S2 being non empty finite Subset of REAL st
  S1 = { dist_min(Segm(S,i),Segm(S,j)):
  1<=i & i< j & j<len S & not i,j are_adjacent1} &
  S2 = { dist_min(Segm(S,len S),Segm(S,k)): 1<k & k<len S -' 1 } &
  it = min(min S1,min S2);
end;

theorem 
  for S being Segmentation of C ex F being finite non empty Subset of REAL st
  F = { dist_min(Segm(S,i),Segm(S,j)):
  1<=i & i<j & j<=len S & Segm(S,i) misses Segm(S,j)} & S-Gap S = min F;

theorem 
  for S being Segmentation of C holds S-Gap S > 0;














begin

reserve n for Element of NAT;

definition
  let C be Simple_closed_curve;
  func Upper_Appr C -> SetSequence of the carrier of TOP-REAL 2 means


  for i be Element of NAT holds it.i = Upper_Arc L~Cage (C,i);
  func Lower_Appr C -> SetSequence of the carrier of TOP-REAL 2 means


  for i being Element of NAT holds it.i = Lower_Arc L~Cage (C,i);
end;

definition
  let C be Simple_closed_curve;
  func North_Arc C -> Subset of TOP-REAL 2 equals

  Lim_inf Upper_Appr C;
  func South_Arc C -> Subset of TOP-REAL 2 equals

  Lim_inf Lower_Appr C;
end;

theorem 
  for n,m be Element of NAT holds n <= m & n <> 0 implies (n+1)/n >= (m+1)/m;

theorem 
  for E be compact non vertical non horizontal Subset of TOP-REAL 2
  for m,j be Element of NAT
  st 1 <= m & m <= n & 1 <= j & j <= width Gauge(E,n) holds
  LSeg(Gauge(E,n)*(Center Gauge(E,n),width Gauge(E,n)),
  Gauge(E,n)*(Center Gauge(E,n),j)) c=
  LSeg(Gauge(E,m)*(Center Gauge(E,m),width Gauge(E,m)),
  Gauge(E,n)*(Center Gauge(E,n),j));

theorem 
  for C be compact connected non vertical non horizontal Subset of TOP-REAL 2
  for i,j be Element of NAT st 1 <= i & i <= len Gauge(C,n) &
  1 <= j & j <= width Gauge(C,n) & Gauge(C,n)*(i,j) in L~Cage(C,n) holds
  LSeg(Gauge(C,n)*(i,width Gauge(C,n)),Gauge(C,n)*(i,j)) meets
  L~Upper_Seq(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of TOP-REAL 2
  for n be Element of NAT st n > 0
  for i,j be Element of NAT st 1 <= i & i <= len Gauge(C,n) &
  1 <= j & j <= width Gauge(C,n) & Gauge(C,n)*(i,j) in L~Cage(C,n) holds
  LSeg(Gauge(C,n)*(i,width Gauge(C,n)),Gauge(C,n)*(i,j)) meets
  Upper_Arc L~Cage(C,n);

theorem 
  for C be compact connected non vertical non horizontal Subset of TOP-REAL 2
  for j be Element of NAT holds
  Gauge(C,n+1)*(Center Gauge(C,n+1),j) in Lower_Arc L~Cage(C,n+1) &
  1 <= j & j <= width Gauge(C,n+1) implies
  LSeg(Gauge(C,1)*(Center Gauge(C,1),width Gauge(C,1)),
  Gauge(C,n+1)*(Center Gauge(C,n+1),j)) meets Upper_Arc L~Cage(C,n+1);

theorem 
  for C be compact connected non vertical non horizontal Subset of TOP-REAL 2
  for f be FinSequence of TOP-REAL 2
  for k be Element of NAT st 1 <= k & k+1 <= len f &
  f is_sequence_on Gauge(C,n) holds
  dist(f/.k,f/.(k+1)) = (N-bound C - S-bound C)/2|^n or
  dist(f/.k,f/.(k+1)) = (E-bound C - W-bound C)/2|^n;

theorem 
  for M be symmetric triangle MetrStruct for r be real number
  for p,q,x be Element of M st p in Ball(x,r) & q in Ball(x,r) holds
  dist(p,q) < 2*r;

theorem 
  for C be compact connected non vertical non horizontal
  Subset of TOP-REAL 2 holds N-bound C < N-bound L~Cage(C,n);

theorem 
  for C be compact connected non vertical non horizontal
  Subset of TOP-REAL 2 holds E-bound C < E-bound L~Cage(C,n);

theorem 
  for C be compact connected non vertical non horizontal
  Subset of TOP-REAL 2 holds S-bound L~Cage(C,n) < S-bound C;

theorem 
  for C be compact connected non vertical non horizontal
  Subset of TOP-REAL 2 holds W-bound L~Cage(C,n) < W-bound C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st
  1 < i & i < len Gauge(C,n) & 1 <= k & k <= j & j <= width Gauge(C,n) &
  LSeg(Gauge(C,n)*(i,k),Gauge(C,n)*(i,j)) /\ L~Upper_Seq(C,n) =
  {Gauge(C,n)*(i,k)} &
  LSeg(Gauge(C,n)*(i,k),Gauge(C,n)*(i,j)) /\ L~Lower_Seq(C,n) =
  {Gauge(C,n)*(i,j)} holds
  LSeg(Gauge(C,n)*(i,k),Gauge(C,n)*(i,j)) meets Upper_Arc C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st
  1 < i & i < len Gauge(C,n) & 1 <= k & k <= j & j <= width Gauge(C,n) &
  LSeg(Gauge(C,n)*(i,k),Gauge(C,n)*(i,j)) /\ L~Upper_Seq(C,n) =
  {Gauge(C,n)*(i,k)} &
  LSeg(Gauge(C,n)*(i,k),Gauge(C,n)*(i,j)) /\ L~Lower_Seq(C,n) =
  {Gauge(C,n)*(i,j)} holds
  LSeg(Gauge(C,n)*(i,k),Gauge(C,n)*(i,j)) meets Lower_Arc C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st
  1 < i & i < len Gauge(C,n) &
  1 <= j & j <= k & k <= width Gauge(C,n) & n > 0 &
  LSeg(Gauge(C,n)*(i,j),Gauge(C,n)*(i,k)) /\ Lower_Arc L~Cage(C,n) =
  {Gauge(C,n)*(i,k)} &
  LSeg(Gauge(C,n)*(i,j),Gauge(C,n)*(i,k)) /\ Upper_Arc L~Cage(C,n) =
  {Gauge(C,n)*(i,j)} holds
  LSeg(Gauge(C,n)*(i,j),Gauge(C,n)*(i,k)) meets Upper_Arc C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st
  1 < i & i < len Gauge(C,n) &
  1 <= j & j <= k & k <= width Gauge(C,n) & n > 0 &
  LSeg(Gauge(C,n)*(i,j),Gauge(C,n)*(i,k)) /\ Lower_Arc L~Cage(C,n) =
  {Gauge(C,n)*(i,k)} &
  LSeg(Gauge(C,n)*(i,j),Gauge(C,n)*(i,k)) /\ Upper_Arc L~Cage(C,n) =
  {Gauge(C,n)*(i,j)} holds
  LSeg(Gauge(C,n)*(i,j),Gauge(C,n)*(i,k)) meets Lower_Arc C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st
  1 < i & i < len Gauge(C,n) & 1 <= j & j <= k & k <= width Gauge(C,n) &
  Gauge(C,n)*(i,k) in L~Lower_Seq(C,n) &
  Gauge(C,n)*(i,j) in L~Upper_Seq(C,n) holds
  LSeg(Gauge(C,n)*(i,j),Gauge(C,n)*(i,k)) meets Upper_Arc C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st
  1 < i & i < len Gauge(C,n) & 1 <= j & j <= k & k <= width Gauge(C,n) &
  Gauge(C,n)*(i,k) in L~Lower_Seq(C,n) &
  Gauge(C,n)*(i,j) in L~Upper_Seq(C,n) holds
  LSeg(Gauge(C,n)*(i,j),Gauge(C,n)*(i,k)) meets Lower_Arc C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st
  1 < i & i < len Gauge(C,n) &
  1 <= j & j <= k & k <= width Gauge(C,n) & n > 0 &
  Gauge(C,n)*(i,k) in Lower_Arc L~Cage(C,n) &
  Gauge(C,n)*(i,j) in Upper_Arc L~Cage(C,n) holds
  LSeg(Gauge(C,n)*(i,j),Gauge(C,n)*(i,k)) meets Upper_Arc C;

theorem 
  for C be Simple_closed_curve for i,j,k be Element of NAT st
  1 < i & i < len Gauge(C,n) &
  1 <= j & j <= k & k <= width Gauge(C,n) & n > 0 &
  Gauge(C,n)*(i,k) in Lower_Arc L~Cage(C,n) &
  Gauge(C,n)*(i,j) in Upper_Arc L~Cage(C,n) holds
  LSeg(Gauge(C,n)*(i,j),Gauge(C,n)*(i,k)) meets Lower_Arc C;

theorem 
  for C be Simple_closed_curve for i1,i2,j,k be Element of NAT st
  1 < i1 & i1 <= i2 & i2 < len Gauge(C,n) &
  1 <= j & j <= k & k <= width Gauge(C,n) &
  (LSeg(Gauge(C,n)*(i1,j),Gauge(C,n)*(i1,k)) \/
  LSeg(Gauge(C,n)*(i1,k),Gauge(C,n)*(i2,k))) /\ L~Upper_Seq(C,n) =
  {Gauge(C,n)*(i1,j)} & (LSeg(Gauge(C,n)*(i1,j),Gauge(C,n)*(i1,k)) \/
  LSeg(Gauge(C,n)*(i1,k),Gauge(C,n)*(i2,k))) /\ L~Lower_Seq(C,n) =
  {Gauge(C,n)*(i2,k)} holds (LSeg(Gauge(C,n)*(i1,j),Gauge(C,n)*(i1,k)) \/
  LSeg(Gauge(C,n)*(i1,k),Gauge(C,n)*(i2,k))) meets Upper_Arc C;

theorem 
  for C be Simple_closed_curve for i1,i2,j,k be Element of NAT st
  1 < i1 & i1 <= i2 & i2 < len Gauge(C,n) &
  1 <= j & j <= k & k <= width Gauge(C,n) &
  (LSeg(Gauge(C,n)*(i1,j),Gauge(C,n)*(i1,k)) \/
  LSeg(Gauge(C,n)*(i1,k),Gauge(C,n)*(i2,k))) /\ L~Upper_Seq(C,n) =
  {Gauge(C,n)*(i1,j)} & (LSeg(Gauge(C,n)*(i1,j),Gauge(C,n)*(i1,k)) \/
  LSeg(Gauge(C,n)*(i1,k),Gauge(C,n)*(i2,k))) /\ L~Lower_Seq(C,n) =
  {Gauge(C,n)*(i2,k)} holds (LSeg(Gauge(C,n)*(i1,j),Gauge(C,n)*(i1,k)) \/
  LSeg(Gauge(C,n)*(i1,k),Gauge(C,n)*(i2,k))) meets Lower_Arc C;

theorem 
  for C be Simple_closed_curve for i1,i2,j,k be Element of NAT st
  1 < i2 & i2 <= i1 & i1 < len Gauge(C,n) &
  1 <= j & j <= k & k <= width Gauge(C,n) &
  (LSeg(Gauge(C,n)*(i1,j),Gauge(C,n)*(i1,k)) \/
  LSeg(Gauge(C,n)*(i1,k),Gauge(C,n)*(i2,k))) /\ L~Upper_Seq(C,n) =
  {Gauge(C,n)*(i1,j)} & (LSeg(Gauge(C,n)*(i1,j),Gauge(C,n)*(i1,k)) \/
  LSeg(Gauge(C,n)*(i1,k),Gauge(C,n)*(i2,k))) /\ L~Lower_Seq(C,n) =
  {Gauge(C,n)*(i2,k)} holds (LSeg(Gauge(C,n)*(i1,j),Gauge(C,n)*(i1,k)) \/
  LSeg(Gauge(C,n)*(i1,k),Gauge(C,n)*(i2,k))) meets Upper_Arc C;

theorem 
  for C be Simple_closed_curve for i1,i2,j,k be Element of NAT st
  1 < i2 & i2 <= i1 & i1 < len Gauge(C,n) &
  1 <= j & j <= k & k <= width Gauge(C,n) &
  (LSeg(Gauge(C,n)*(i1,j),Gauge(C,n)*(i1,k)) \/
  LSeg(Gauge(C,n)*(i1,k),Gauge(C,n)*(i2,k))) /\ L~Upper_Seq(C,n) =
  {Gauge(C,n)*(i1,j)} & (LSeg(Gauge(C,n)*(i1,j),Gauge(C,n)*(i1,k)) \/
  LSeg(Gauge(C,n)*(i1,k),Gauge(C,n)*(i2,k))) /\ L~Lower_Seq(C,n) =
  {Gauge(C,n)*(i2,k)} holds (LSeg(Gauge(C,n)*(i1,j),Gauge(C,n)*(i1,k)) \/
  LSeg(Gauge(C,n)*(i1,k),Gauge(C,n)*(i2,k))) meets Lower_Arc C;

theorem 
  for C be Simple_closed_curve for i1,i2,j,k be Element of NAT holds
  1 < i1 & i1 < len Gauge(C,n+1) & 1 < i2 & i2 < len Gauge(C,n+1) &
  1 <= j & j <= k & k <= width Gauge(C,n+1) &
  Gauge(C,n+1)*(i1,k) in Lower_Arc L~Cage(C,n+1) &
  Gauge(C,n+1)*(i2,j) in Upper_Arc L~Cage(C,n+1) implies
  LSeg(Gauge(C,n+1)*(i2,j),Gauge(C,n+1)*(i2,k)) \/
  LSeg(Gauge(C,n+1)*(i2,k),Gauge(C,n+1)*(i1,k)) meets Lower_Arc C;

theorem 
  for C be Simple_closed_curve for i1,i2,j,k be Element of NAT holds
  1 < i1 & i1 < len Gauge(C,n+1) & 1 < i2 & i2 < len Gauge(C,n+1) &
  1 <= j & j <= k & k <= width Gauge(C,n+1) &
  Gauge(C,n+1)*(i1,k) in Lower_Arc L~Cage(C,n+1) &
  Gauge(C,n+1)*(i2,j) in Upper_Arc L~Cage(C,n+1) implies
  LSeg(Gauge(C,n+1)*(i2,j),Gauge(C,n+1)*(i2,k)) \/
  LSeg(Gauge(C,n+1)*(i2,k),Gauge(C,n+1)*(i1,k)) meets Upper_Arc C;

theorem 
  for C be Simple_closed_curve
  for p be Point of TOP-REAL 2 st W-bound C < p`1 & p`1 < E-bound C holds
  not(p in North_Arc C & p in South_Arc C);

theorem 
  for C be Simple_closed_curve
  for p be Point of TOP-REAL 2 st p`1 = (W-bound C + E-bound C)/2 holds
  not (p in North_Arc C & p in South_Arc C);














begin 

theorem 
  for k be Nat st k >= 2 holds Radix(k) - 1 in k-SD;

theorem 
  for i,n be Nat st i > 1 & i in Seg n holds i -' 1 in Seg n;

theorem 
  for k be Nat st 2 <= k holds 4 <= Radix(k);

theorem 
  for k be Nat, tx be Tuple of 1,k-SD holds SDDec(tx) = DigA(tx,1);

begin 

theorem 
  for i,k,n be Nat st i in Seg n holds DigA(DecSD(0,n,k),i) = 0;

theorem 
  for n,k be Nat st n >= 1 holds SDDec(DecSD(0,n,k)) = 0;

theorem 
  for k,n be Nat st 1 in Seg n & k >= 2 holds DigA(DecSD(1,n,k),1) = 1;

theorem 
  for i,k,n be Nat st i in Seg n & i > 1 & k >= 2 holds DigA(DecSD(
  1,n,k),i) = 0;

theorem 
  for n,k be Nat st n >= 1 & k >= 2 holds SDDec(DecSD(1,n,k)) = 1;

theorem 
  for k be Nat st k >= 2 holds SD_Add_Carry(Radix(k)) = 1;

theorem 
  for k be Nat st k >= 2 holds SD_Add_Data(Radix(k),k) = 0;

begin

theorem 
  for n be Nat st n >= 1 holds for k be Nat, tx,ty be Tuple of n,k
-SD st (for i be Nat st i in Seg n holds DigA(tx,i) = DigA(ty,i)) holds SDDec(
  tx) = SDDec(ty);

theorem 
  for n be Nat st n >= 1 holds for k be Nat, tx,ty be Tuple of n,k-SD st
(for i be Nat st i in Seg n holds DigA(tx,i) >= DigA(ty,i)) holds SDDec(tx) >=
  SDDec(ty);

theorem 
  for n be Nat st n >= 1 holds for k be Nat st k >= 2 holds for tx
,ty,tz,tw be Tuple of n,k-SD st (for i be Nat st i in Seg n holds (DigA(tx,i) =
DigA(tz,i) & DigA(ty,i) = DigA(tw,i)) or (DigA(ty,i) = DigA(tz,i) & DigA(tx,i)
  = DigA(tw,i))) holds SDDec(tz) + SDDec(tw) = SDDec(tx) + SDDec(ty);

theorem 
  for n,k be Nat st n >= 1 & k >= 2 holds for tx,ty,tz be Tuple of n,k
-SD st (for i be Nat st i in Seg n holds (DigA(tx,i) = DigA(tz,i) & DigA(ty,i)
  = 0) or (DigA(ty,i) = DigA(tz,i) & DigA(tx,i) = 0)) holds SDDec(tz) + SDDec(
  DecSD(0,n,k)) = SDDec(tx) + SDDec(ty);

begin 

definition
  let i,m,k be Nat;
  assume
 k >= 2;
  func SDMinDigit(m,k,i) -> Element of k-SD equals


  -Radix(k)+1 if 1 <=
  i & i < m otherwise 0;
end;

definition
  let n,m,k be Nat;
  func SDMin(n,m,k) -> Tuple of n,k-SD means


  for i be Nat st i in Seg n holds DigA(it,i) = SDMinDigit(m,k,i);
end;

definition
  let i,m,k be Nat;
  assume
 k >= 2;
  func SDMaxDigit(m,k,i) -> Element of k-SD equals


  Radix(k)-1 if 1 <= i
  & i < m otherwise 0;
end;

definition
  let n,m,k be Nat;
  func SDMax(n,m,k) -> Tuple of n,k-SD means


  for i be Nat st i in Seg n holds DigA(it,i) = SDMaxDigit(m,k,i);
end;

definition
  let i,m,k be Nat;
  assume
 k >= 2;
  func FminDigit(m,k,i) -> Element of k-SD equals


  1 if i = m otherwise
  0;
end;

definition
  let n,m,k be Nat;
  func Fmin(n,m,k) -> Tuple of n,k-SD means


  for i be Nat st i in Seg n holds DigA(it,i) = FminDigit(m,k,i);
end;

definition
  let i,m,k be Nat;
  assume
 k >= 2;
  func FmaxDigit(m,k,i) -> Element of k-SD equals


  Radix(k) - 1 if i = m
  otherwise 0;
end;

definition
  let n,m,k be Nat;
  func Fmax(n,m,k) -> Tuple of n,k-SD means


  for i be Nat st i in Seg n holds DigA(it,i) = FmaxDigit(m,k,i);
end;

begin 

theorem 
  for n,m,k be Nat st k >= 2 holds for i be Nat st i in Seg n
  holds DigA(SDMax(n,m,k),i)+DigA(SDMin(n,m,k),i) = 0;

theorem 
  for n be Nat st n >= 1 holds for m,k be Nat st k >= 2 holds SDDec(
  SDMax(n,m,k)) + SDDec(SDMin(n,m,k)) = SDDec(DecSD(0,n,k));

theorem 
  for n be Nat st n >= 1 holds for m,k be Nat st m in Seg n & k >= 2
  holds SDDec(Fmin(n,m,k)) = SDDec(SDMax(n,m,k)) + SDDec(DecSD(1,n,k));

theorem 
  for n,m,k be Nat st m in Seg n & k >= 2 holds SDDec(Fmin(n+1,m+1,k)) =
  SDDec(Fmin(n+1,m,k)) + SDDec(Fmax(n+1,m,k));














begin

theorem 
  for n be Nat st n >= 1 holds for m,k be Nat st m >= 1 & k >= 2
  holds SDDec(Fmin(m+n,m,k)) = SDDec(Fmin(m,m,k));

theorem 
  for m,k be Nat st m >= 1 & k >= 2 holds SDDec(Fmin(m,m,k)) > 0;

begin 

definition
  let i,m,k be Nat, r be Tuple of (m+2),(k-SD);
  assume
 i in Seg (m+2);
  func M0Digit(r,i) -> Element of k-SD equals


  r.i if i >= m otherwise 0;
end;

definition
  let m,k be Nat, r be Tuple of (m+2),(k-SD);
  func M0(r) -> Tuple of (m+2),k-SD means


  for i be Nat st i in Seg (m+2) holds DigA(it,i) = M0Digit(r,i);
end;

definition
  let i,m,k be Nat, r be Tuple of (m+2),(k-SD);
  assume that
 k >= 2 and
 i in Seg (m+2);
  func MmaxDigit(r,i) -> Element of k-SD equals


  r.i if i >= m otherwise Radix(k)-1;
end;

definition
  let m,k be Nat, r be Tuple of (m+2),(k-SD);
  func Mmax(r) -> Tuple of (m+2),k-SD means


  for i be Nat st i in Seg (m+2) holds DigA(it,i) = MmaxDigit(r,i);
end;

definition
  let i,m,k be Nat, r be Tuple of (m+2),(k-SD);
  assume that
 k >= 2 and
 i in Seg (m+2);
  func MminDigit(r,i) -> Element of k-SD equals


  r.i if i >= m otherwise -Radix(k)+1;
end;

definition
  let m,k be Nat, r be Tuple of (m+2),(k-SD);
  func Mmin(r) -> Tuple of (m+2),k-SD means


  for i be Nat st i in Seg (m+2) holds DigA(it,i) = MminDigit(r,i);
end;

theorem 
  for m,k be Nat st k >= 2 holds for r be Tuple of (m+2),k-SD holds
  SDDec(Mmax(r)) >= SDDec(r);

theorem 
  for m,k be Nat st k >= 2 holds for r be Tuple of (m+2),k-SD holds
  SDDec(r) >= SDDec(Mmin(r));

begin 

definition
  let n,k be Nat, x be Integer;
  pred x needs_digits_of n,k means


  x < Radix(k) |^ n & x >= Radix(k) |^ (n-'1);
end;

theorem 
  for x,n,k,i be Nat st i in Seg n holds DigA(DecSD(x,n,k),i) >= 0;

theorem 
  for n,k,x be Nat st n >= 1 & x needs_digits_of n,k holds DigA(
  DecSD(x,n,k),n) > 0;

theorem 
  for f,m,k be Nat st m >= 1 & k >= 2 & f needs_digits_of m,k holds
  f >= SDDec(Fmin(m+2,m,k));

begin 

theorem 
  for mlow,mhigh,f be Integer st mhigh < mlow + f & f > 0 holds ex
  s be Integer st -f < mlow - s * f & mhigh - s * f < f;

theorem 
  for m,k be Nat st k >= 2 holds for r be Tuple of (m+2),k-SD holds
  SDDec(Mmax(r)) + SDDec(DecSD(0,m+2,k)) = SDDec(M0(r)) + SDDec(SDMax(m+2,m,k))
;

theorem 
  for m,k be Nat st m >= 1 & k >= 2 holds for r be Tuple of (m+2),
  k-SD holds SDDec(Mmax(r)) < SDDec(M0(r)) + SDDec(Fmin(m+2,m,k));

theorem 
  for m,k be Nat st k >= 2 holds for r be Tuple of (m+2),k-SD
holds SDDec(Mmin(r)) + SDDec(DecSD(0,m+2,k)) = SDDec(M0(r)) + SDDec(SDMin(m+2,m
  ,k));

theorem 
  for m,k be Nat, r be Tuple of (m+2),k-SD st m >= 1 & k >= 2
holds SDDec(M0(r)) + SDDec(DecSD(0,m+2,k)) = SDDec(Mmin(r)) + SDDec(SDMax(m+2,m
  ,k));

theorem 
  for m,k be Nat st m >= 1 & k >= 2 holds for r be Tuple of (m+2),
  k-SD holds SDDec(M0(r)) < SDDec(Mmin(r)) + SDDec(Fmin(m+2,m,k));

theorem 
  for m,k,f be Nat, r be Tuple of (m+2),k-SD st m >= 1 & k >= 2 & f
needs_digits_of m,k holds ex s be Integer st - f < (SDDec(M0(r)) - s*f) & SDDec
  (Mmax(r)) - s*f < f;

theorem 
  for m,k,f be Nat, r be Tuple of (m+2),k-SD st m >= 1 & k >= 2 & f
  needs_digits_of m,k holds ex s be Integer st - f < (SDDec(Mmin(r)) - s*f) &
  SDDec(M0(r)) - s*f < f;

theorem 
  for m,k be Nat, r be Tuple of (m+2),k-SD st k >= 2 holds SDDec(M0(r))
<= SDDec(r) & SDDec(r) <= SDDec(Mmax(r)) or SDDec(Mmin(r)) <= SDDec(r) & SDDec(
  r) < SDDec(M0(r));

begin 

definition
  let i,m,k be Nat, r be Tuple of (m+2),(k-SD);
  assume
 i in Seg (m+2);
  func MmaskDigit(r,i) -> Element of k-SD equals


  r.i if i < m otherwise 0;
end;

definition
  let m,k be Nat, r be Tuple of (m+2),(k-SD);
  func Mmask(r) -> Tuple of (m+2),k-SD means


  for i be Nat st i in Seg (m+2) holds DigA(it,i) = MmaskDigit(r,i);
end;

theorem 
  for m,k be Nat, r be Tuple of (m+2),k-SD st k >= 2 holds SDDec(
  M0(r)) + SDDec(Mmask(r)) = SDDec(r) + SDDec(DecSD(0,m+2,k));

theorem 
  for m,k be Nat, r be Tuple of (m+2),k-SD st m >= 1 & k >= 2 holds
  SDDec(Mmask(r)) > 0 implies SDDec(r) > SDDec(M0(r));

definition
  let i,m,k be Nat;
  assume
 k >= 2;
  func FSDMinDigit(m,k,i) -> Element of k-SD equals


  0 if i > m, 1 if i = m otherwise -Radix(k)+1;
end;

definition
  let n,m,k be Nat;
  func FSDMin(n,m,k) -> Tuple of n,k-SD means


  for i be Nat st i in Seg n holds DigA(it,i) = FSDMinDigit(m,k,i);
end;

theorem 
  for n be Nat st n >= 1 holds for m,k be Nat st m in Seg n & k >=
  2 holds SDDec(FSDMin(n,m,k)) = 1;

definition
  let n,m,k be Nat, r be Tuple of m+2,k-SD;
  pred r is_Zero_over n means


  for i be Nat st i > n holds DigA(r,i) = 0;
end;

theorem 
  for m be Nat st m >= 1 holds for n,k be Nat, r be Tuple of m+2,k-SD st
k >= 2 & n in Seg (m+2) & Mmask(r) is_Zero_over n & DigA(Mmask(r),n) > 0 holds
  SDDec(Mmask(r)) > 0;














begin 

reserve X, Y for non empty set;

registration
  let X;
  cluster -> real-valued for Membership_Func of X;
end;

definition
  let X,Y;
  let f,g be RMembership_Func of X,Y;
  redefine pred f is_less_than g means


  for x being Element of X, y being Element of Y holds f.(x,y) <= g.(x,y);
end;

theorem 
  for R,S being Membership_Func of X st for x being Element of X
  holds R.x = S.x holds R = S;

theorem 
  for R,S being RMembership_Func of X,Y st for x being Element of X
  , y being Element of Y holds R.(x,y) = S.(x,y) holds R = S;

theorem 
  for R,S being Membership_Func of X holds R = S iff R c= S & S c= R;

theorem 
  for R being Membership_Func of X holds R c= R;

theorem 
  for R,S,T being Membership_Func of X holds R c= S & S c= T implies R c= T;

theorem 
  for X,Y,Z being non empty set, R,S being RMembership_Func of X,Y,
T,U being RMembership_Func of Y,Z holds R c= S & T c= U implies R(#)T c= S(#)U;

definition
  let X be non empty set;
  let f,g be Membership_Func of X;
  redefine func min(f,g);
  commutativity;
  redefine func max(f,g);
  commutativity;
end;

theorem 
  for f,g being Membership_Func of X holds min(f,g) c= f;

theorem 
  for f,g being Membership_Func of X holds f c= max(f,g);

begin 

definition
  let X be non empty set;
  let R be RMembership_Func of X,X;
  attr R is reflexive means


  Imf(X,X) c= R;
end;

definition
  let X be non empty set;
  let R be RMembership_Func of X,X;
  redefine attr R is reflexive means


  for x being Element of X holds R.( x,x) = 1;
end;

definition
  let X be non empty set;
  let R be RMembership_Func of X,X;
  attr R is symmetric means


  converse R = R;
end;

definition
  let X be non empty set;
  let R be RMembership_Func of X,X;
  redefine attr R is symmetric means


  for x,y being Element of X holds R .(x,y) = R.(y,x);
end;

definition
  let X be non empty set;
  let R be RMembership_Func of X,X;
  attr R is transitive means


  R (#) R c= R;
end;

definition
  let X be non empty set;
  let R be RMembership_Func of X,X;
  redefine attr R is transitive means

  for x,y,z being Element of X holds R. [x ,y] "/\" R. [y,z] <<= R. [x,z];
end;

definition
  let X be non empty set;
  let R be RMembership_Func of X,X;
  attr R is antisymmetric means


  for x,y being Element of X holds R.(x,y ) <> 0 & R.(y,x) <> 0 implies x = y;
end;

registration
  let X;
  cluster Imf(X,X) -> symmetric transitive reflexive antisymmetric;
end;

registration
  let X;
  cluster reflexive transitive symmetric antisymmetric for
RMembership_Func of X,X;
end;

theorem 
  for R,S being RMembership_Func of X,X holds R is symmetric & S is
  symmetric implies converse min(R,S) = min(R,S);

theorem 
  for R,S being RMembership_Func of X,X holds R is symmetric & S
  is symmetric implies converse max(R,S) = max(R,S);

registration
  let X;
  let R,S be symmetric RMembership_Func of X,X;
  cluster min(R,S) -> symmetric;
  cluster max(R,S) -> symmetric;
end;

theorem 
  for R,S being RMembership_Func of X,X holds R is transitive & S
  is transitive implies min(R,S) (#) min(R,S) c= min(R,S);

registration
  let X;
  let R,S be transitive RMembership_Func of X,X;
  cluster min(R,S) -> transitive;
end;

definition
  let A be set, X be non empty set;
  redefine func chi(A,X) -> Membership_Func of X;
end;

theorem 
  for r being Relation of X st r is_reflexive_in X holds chi(r,[:X,X:])
  is reflexive;

theorem 
  for r being Relation of X st r is antisymmetric holds chi(r,[:X,X:])
  is antisymmetric;

theorem 
  for r being Relation of X st r is symmetric holds chi(r,[:X,X:]) is symmetric
;

theorem 
  for r being Relation of X st r is transitive holds chi(r,[:X,X:]) is
  transitive;

theorem 
  Zmf(X,X) is symmetric antisymmetric transitive;

theorem 
  Umf(X,X) is symmetric transitive reflexive;

theorem 
  for R being RMembership_Func of X,X holds max(R,converse R) is symmetric;

theorem 
  for R being RMembership_Func of X,X holds min(R,converse R) is symmetric;

theorem 
  for R being RMembership_Func of X,X for R9 being RMembership_Func of X
  ,X st R9 is symmetric & R c= R9 holds max(R, converse R) c= R9;

theorem 
  for R being RMembership_Func of X,X for R9 being RMembership_Func of X
  ,X st R9 is symmetric & R9 c= R holds R9 c= min(R, converse R);

begin 

definition
  let X be non empty set;
  let R be RMembership_Func of X,X;
  let n be Nat;

  func n iter R -> RMembership_Func of X,X means


  ex F being Function
  of NAT,Funcs([:X,X:],[. 0,1 .]) st it = F.n & F.0 = Imf(X,X) & for k being
  Nat ex Q being RMembership_Func of X,X st F.k = Q & F.(k + 1) = Q
  (#) R;
end;

reserve X for non empty set;
reserve R for RMembership_Func of X,X;

theorem 
  Imf(X,X) (#) R = R;

theorem 
  R (#) Imf(X,X) = R;

theorem 
  0 iter R = Imf(X,X);

theorem 
  1 iter R = R;

theorem 
  for n being Nat holds (n+1) iter R = (n iter R) (#) R;

theorem 
  for m,n being Nat holds (m+n) iter R = (m iter R) (#) (n iter R);

theorem 
  for m,n being Nat holds (m*n) iter R = m iter (n iter R);

definition
  let X be non empty set;
  let R be RMembership_Func of X,X;
  func TrCl R -> RMembership_Func of X,X equals

  "\/"({n iter R where n is
  Element of NAT : n > 0},FuzzyLattice [:X,X:]);
end;

theorem 
  for x,y being Element of X holds (TrCl R). [x,y] = "\/"(pi({n
  iter R where n is Element of NAT : n > 0}, [x,y]), RealPoset [. 0,1 .]);

theorem 
  R c= TrCl R;

theorem 
  for n being Nat st n > 0 holds n iter R c= TrCl R;

theorem 
  for Q being Subset of FuzzyLattice X, x being Element of X holds
  ("\/"(Q,FuzzyLattice X)). x = "\/"(pi(Q, x), RealPoset [. 0,1 .]);

theorem 
  for R being complete Heyting LATTICE, X being Subset of R, y be
Element of R holds y "/\" "\/"(X,R) = "\/"({y "/\" x where x is Element of R: x
  in X},R);

theorem 
  for R being RMembership_Func of X,X, Q being Subset of
FuzzyLattice [:X,X:] holds R (#) @("\/"(Q,FuzzyLattice [:X,X:])) = "\/"({R (#)
  @r where r is Element of FuzzyLattice [:X,X:]:r in Q}, FuzzyLattice [:X,X:]);

theorem 
  for R being RMembership_Func of X,X, Q being Subset of
FuzzyLattice [:X,X:] holds @("\/"(Q,FuzzyLattice [:X,X:])) (#) R = "\/"({@r (#)
  R where r is Element of FuzzyLattice [:X,X:]:r in Q}, FuzzyLattice [:X,X:]);

theorem 
  for R being RMembership_Func of X,X holds (TrCl R)(#)(TrCl R) =
"\/"({(i iter R) (#) (j iter R) where i is Element of NAT, j is Element of NAT:
  i > 0 & j > 0},FuzzyLattice [:X,X:]);

registration
  let X be non empty set;
  let R be RMembership_Func of X,X;
  cluster TrCl R -> transitive;
end;

theorem 
  for R being RMembership_Func of X,X, n being Nat st R
  is transitive & n > 0 holds n iter R c= R;

theorem 
  for R being RMembership_Func of X,X st R is transitive holds R = TrCl R;

theorem 
  for R,S being RMembership_Func of X,X, n being Nat st
  R c= S holds n iter R c= n iter S;

theorem 
  for R,S being RMembership_Func of X,X st S is transitive & R c= S
  holds TrCl R c= S;














begin 

registration
  let A be set;
  cluster RelStr (# A, id A #) -> discrete;
end;

theorem 
  for X being set st Total X c= id X holds X is trivial;

definition
  let A be RelStr;
  attr A is diagonal means


  the InternalRel of A c= id the carrier of A;
end;

registration
  let A be non trivial set;
  cluster RelStr (# A, Total A #) -> non diagonal;
end;

theorem 
  for L being reflexive RelStr holds id the carrier of L c= the
  InternalRel of L;

registration
  cluster non discrete -> non trivial for reflexive RelStr;
  cluster reflexive trivial -> discrete for RelStr;
end;

theorem 
  for X being set, R being total reflexive Relation of X holds id X c= R;

registration
  cluster discrete -> diagonal for RelStr;
  cluster non diagonal -> non discrete for RelStr;
end;

registration
  cluster non diagonal non empty for RelStr;
end;

theorem 
  for A being non diagonal non empty RelStr ex x, y being Element
  of A st x <> y & [x,y] in the InternalRel of A;

theorem 
  for D being set, p, q being FinSequence of D holds Union (p^q) =
  Union p \/ Union q;

theorem 
  for p, q being Function st q is disjoint_valued & p c= q holds p
  is disjoint_valued;

registration
  cluster empty -> disjoint_valued for Function;
end;

registration
  let A be set;
  cluster disjoint_valued for FinSequence of A;
end;

registration
  let A be non empty set;
  cluster non empty disjoint_valued for FinSequence of A;
end;

definition
  let A be set;
  let X be FinSequence of bool A;
  let n be Nat;
  redefine func X.n -> Subset of A;
end;

definition
  let A be set;
  let X be FinSequence of bool A;
  redefine func Union X -> Subset of A;
end;

registration
  let A be finite set;
  let R be Relation of A;
  cluster RelStr (# A, R #) -> finite;
end;

theorem 
  for X, x, y being set, T being Tolerance of X st x in Class (T, y
  ) holds y in Class (T, x);

begin 

definition
  let P be RelStr;
  attr P is with_equivalence means


  the InternalRel of P is Equivalence_Relation of the carrier of P;
  attr P is with_tolerance means


  the InternalRel of P is Tolerance of the carrier of P;
end;

registration
  cluster with_equivalence -> with_tolerance for RelStr;
end;

registration
  let A be set;
  cluster RelStr (# A, id A #) -> with_equivalence;
end;

registration
  cluster discrete finite with_equivalence non empty for RelStr;
  cluster non diagonal finite with_equivalence non empty for RelStr;
end;

definition
  mode Approximation_Space is with_equivalence non empty RelStr;
  mode Tolerance_Space is with_tolerance non empty RelStr;
end;

registration
  let A be Tolerance_Space;
  cluster the InternalRel of A -> total reflexive symmetric;
end;

registration
  let A be Approximation_Space;
  cluster the InternalRel of A -> transitive;
end;

definition
  let A be non empty RelStr;
  let X be Subset of A;
  func LAp X -> Subset of A equals

  { x where x is Element of A : Class (the
  InternalRel of A, x) c= X };
  func UAp X -> Subset of A equals

  { x where x is Element of A : Class (the
  InternalRel of A, x) meets X };
end;

definition
  let A be non empty RelStr;
  let X be Subset of A;
  func BndAp X -> Subset of A equals

  UAp X \ LAp X;
end;

definition
  let A be non empty RelStr;
  let X be Subset of A;
  attr X is rough means


  BndAp X <> {};
end;

notation
  let A be non empty RelStr;
  let X be Subset of A;
  antonym X is exact for X is rough;
end;

reserve A for Tolerance_Space,
  X, Y for Subset of A;

theorem 
  for x being set st x in LAp X holds Class (the InternalRel of A, x) c= X;

theorem 
  for x being Element of A st Class (the InternalRel of A, x) c= X holds
  x in LAp X;

theorem 
  for x being set st x in UAp X holds Class (the InternalRel of A, x) meets X;

theorem 
  for x being Element of A st Class (the InternalRel of A, x) meets X
  holds x in UAp X;

theorem 
  LAp X c= X;

theorem 
  X c= UAp X;

theorem 
  LAp X c= UAp X;

theorem 
  X is exact iff LAp X = X;

theorem 
  X is exact iff UAp X = X;

theorem 
  X = LAp X iff X = UAp X;

theorem 
  LAp {}A = {};

theorem 
  UAp {}A = {};

theorem 
  LAp [#]A = [#]A;

theorem 
  UAp [#]A = [#]A;

theorem 
  LAp (X /\ Y) = LAp X /\ LAp Y;

theorem 
  UAp (X \/ Y) = UAp X \/ UAp Y;

theorem 
  X c= Y implies LAp X c= LAp Y;

theorem 
  X c= Y implies UAp X c= UAp Y;

theorem 
  LAp X \/ LAp Y c= LAp (X \/ Y);

theorem 
  UAp (X /\ Y) c= UAp X /\ UAp Y;

theorem 
  LAp X` = (UAp X)`;

theorem 
  UAp X` = (LAp X)`;

theorem 
  UAp LAp UAp X = UAp X;

theorem 
  LAp UAp LAp X = LAp X;

theorem 
  BndAp X = BndAp X`;

reserve A for Approximation_Space,
  X for Subset of A;

theorem 
  LAp LAp X = LAp X;

theorem 
  LAp LAp X = UAp LAp X;

theorem 
  UAp UAp X = UAp X;

theorem 
  UAp UAp X = LAp UAp X;

registration
  let A be Tolerance_Space;
  cluster exact for Subset of A;
end;

registration
  let A be Approximation_Space;
  let X be Subset of A;
  cluster LAp X -> exact;
  cluster UAp X -> exact;
end;

theorem 
  for A being Approximation_Space, X being Subset of A, x, y being
  set st x in UAp X & [x,y] in the InternalRel of A holds y in UAp X;

registration
  let A be non diagonal Approximation_Space;
  cluster rough for Subset of A;
end;

definition
  let A be Approximation_Space;
  let X be Subset of A;
  mode RoughSet of X means

    it = [LAp X, UAp X];
end;

begin 

registration
  let A be finite Tolerance_Space, x be Element of A;
  cluster card Class (the InternalRel of A, x) -> non empty;
end;

definition
  let A be finite Tolerance_Space;
  let X be Subset of A;
  func MemberFunc (X, A) -> Function of the carrier of A, REAL means


for x being Element of A holds it.x = card (X /\ Class (the InternalRel of A, x
  )) / (card Class (the InternalRel of A, x));
end;

reserve A for finite Tolerance_Space,
  X for Subset of A,
  x for Element of A;

theorem 
  0 <= MemberFunc (X, A).x & MemberFunc (X, A).x <= 1;

theorem 
  MemberFunc (X, A).x in [. 0, 1 .];

reserve A for finite Approximation_Space,
  X, Y for Subset of A,
  x for Element of A;

theorem 
  MemberFunc (X, A).x = 1 iff x in LAp X;

theorem 
  MemberFunc (X, A).x = 0 iff x in (UAp X)`;

theorem 
  0 < MemberFunc (X, A).x & MemberFunc (X, A).x < 1 iff x in BndAp X;

theorem 
  for A being discrete Approximation_Space, X being Subset of A
  holds X is exact;

registration
  let A be discrete Approximation_Space;
  cluster -> exact for Subset of A;
end;

theorem 
  for A being discrete finite Approximation_Space, X being Subset of A
  holds MemberFunc (X, A) = chi (X, the carrier of A);

theorem 
  for A being finite Approximation_Space, X being Subset of A, x, y
  being set st [x,y] in the InternalRel of A holds MemberFunc (X, A).x =
  MemberFunc (X, A).y;

theorem 
  MemberFunc (X`,A).x = 1 - (MemberFunc (X,A).x);

theorem 
  X c= Y implies MemberFunc (X, A).x <= MemberFunc (Y, A).x;

theorem 
  MemberFunc (X \/ Y, A).x >= MemberFunc (X, A).x;

theorem 
  MemberFunc (X /\ Y, A).x <= MemberFunc (X, A).x;

theorem 
  MemberFunc (X \/ Y, A).x >= max (MemberFunc (X, A).x, MemberFunc (Y, A ).x);

theorem 
  X misses Y implies MemberFunc (X \/ Y, A).x = MemberFunc (X, A).
  x + MemberFunc (Y, A).x;

theorem 
  MemberFunc (X /\ Y, A).x <= min (MemberFunc (X, A).x, MemberFunc (Y, A ).x);

definition
  let A be finite Tolerance_Space;
  let X be FinSequence of bool the carrier of A;
  let x be Element of A;
  func FinSeqM (x,X) -> FinSequence of REAL means


  dom it = dom X & for
  n being Nat st n in dom X holds it.n = MemberFunc (X.n, A).x;
end;

theorem 
  for X being FinSequence of bool the carrier of A, x being
Element of A, y being Subset of A holds FinSeqM (x, X^<*y*>) = FinSeqM (x, X) ^
  <* MemberFunc (y, A).x *>;

theorem 
  MemberFunc ({}A, A).x = 0;

theorem 
  for X being disjoint_valued FinSequence of bool the carrier of A holds
  MemberFunc (Union X, A).x = Sum FinSeqM (x, X);

theorem 
  LAp X = { x where x is Element of A : MemberFunc (X, A).x = 1 };

theorem 
  UAp X = { x where x is Element of A : MemberFunc (X, A).x > 0 };

theorem 
  BndAp X = { x where x is Element of A : 0 < MemberFunc (X, A).x &
  MemberFunc (X, A).x < 1 };

begin 

reserve A for Tolerance_Space,
  X, Y, Z for Subset of A;

definition
  let A be Tolerance_Space, X, Y be Subset of A;
  pred X _c= Y means


  LAp X c= LAp Y;
  reflexivity;
  pred X c=^ Y means


  UAp X c= UAp Y;
  reflexivity;
end;

definition
  let A be Tolerance_Space, X, Y be Subset of A;
  pred X _c=^ Y means


  X _c= Y & X c=^ Y;
  reflexivity;
end;

theorem 
  X _c= Y & Y _c= Z implies X _c= Z;

theorem 
  X c=^ Y & Y c=^ Z implies X c=^ Z;

theorem 
  X _c=^ Y & Y _c=^ Z implies X _c=^ Z;

begin 

definition
  let A be Tolerance_Space, X, Y be Subset of A;
  pred X _= Y means


  LAp X = LAp Y;
  reflexivity;
  symmetry;
  pred X =^ Y means


  UAp X = UAp Y;
  reflexivity;
  symmetry;
  pred X _=^ Y means


  LAp X = LAp Y & UAp X = UAp Y;
  reflexivity;
  symmetry;
end;

definition
  let A be Tolerance_Space, X, Y be Subset of A;
  redefine pred X _= Y means

  X _c= Y & Y _c= X;
  redefine pred X =^ Y means

  X c=^ Y & Y c=^ X;
  redefine pred X _=^ Y means

  X _= Y & X =^ Y;
end;














begin

definition
  func the_set_of_BoundedRealSequences -> Subset of
  Linear_Space_of_RealSequences means


  for x being set holds x in it iff x
  in the_set_of_RealSequences & seq_id x is bounded;
end;

registration
  cluster the_set_of_BoundedRealSequences -> non empty;
  cluster the_set_of_BoundedRealSequences -> linearly-closed;
end;

registration
  cluster RLSStruct (# the_set_of_BoundedRealSequences, Zero_(
      the_set_of_BoundedRealSequences,Linear_Space_of_RealSequences), Add_(
      the_set_of_BoundedRealSequences,Linear_Space_of_RealSequences), Mult_(
the_set_of_BoundedRealSequences,Linear_Space_of_RealSequences) #) -> Abelian
    add-associative right_zeroed right_complementable vector-distributive
    scalar-distributive scalar-associative scalar-unital;
end;

definition
  func linfty_norm -> Function of the_set_of_BoundedRealSequences, REAL means


  for x be set st x in the_set_of_BoundedRealSequences holds it.x = upper_bound
  rng abs seq_id x;
end;

theorem 
  for rseq be Real_Sequence holds rseq is bounded &
  upper_bound rng abs rseq = 0
  iff for n be Nat holds rseq.n = 0;

registration
  cluster NORMSTR (# the_set_of_BoundedRealSequences, Zero_(
      the_set_of_BoundedRealSequences,Linear_Space_of_RealSequences), Add_(
      the_set_of_BoundedRealSequences,Linear_Space_of_RealSequences), Mult_(
the_set_of_BoundedRealSequences,Linear_Space_of_RealSequences), linfty_norm #)
    -> Abelian add-associative right_zeroed right_complementable
    vector-distributive scalar-distributive scalar-associative scalar-unital;
end;

definition
  func linfty_Space -> non empty NORMSTR equals

  NORMSTR (#
    the_set_of_BoundedRealSequences, Zero_(the_set_of_BoundedRealSequences,
    Linear_Space_of_RealSequences), Add_(the_set_of_BoundedRealSequences,
    Linear_Space_of_RealSequences), Mult_(the_set_of_BoundedRealSequences,
    Linear_Space_of_RealSequences), linfty_norm #);
end;

theorem 
  the carrier of linfty_Space = the_set_of_BoundedRealSequences & (
for x be set holds x is VECTOR of linfty_Space iff x is Real_Sequence & seq_id
  x is bounded ) & 0.linfty_Space = Zeroseq & ( for u be VECTOR of linfty_Space
holds u = seq_id u ) & ( for u,v be VECTOR of linfty_Space holds u+v =seq_id(u)
+seq_id(v) ) & ( for r be Real for u be VECTOR of linfty_Space holds r*u =r(#)
seq_id(u) ) & ( for u be VECTOR of linfty_Space holds -u = -seq_id u & seq_id(-
  u) = -seq_id u ) & ( for u,v be VECTOR of linfty_Space holds u-v =seq_id(u)-
  seq_id(v) ) & ( for v be VECTOR of linfty_Space holds seq_id v is bounded ) &
  for v be VECTOR of linfty_Space holds ||.v.|| = upper_bound rng abs seq_id v;

theorem 
  for x, y being Point of linfty_Space, a be Real holds ( ||.x.|| =
  0 iff x = 0.linfty_Space ) & 0 <= ||.x.|| & ||.x+y.|| <= ||.x.|| + ||.y.|| &
  ||. a*x .|| = abs(a) * ||.x.||;

registration
  cluster linfty_Space -> reflexive discerning RealNormSpace-like
  vector-distributive scalar-distributive scalar-associative scalar-unital
  Abelian add-associative right_zeroed right_complementable;
end;

theorem 
  for vseq be sequence of linfty_Space st vseq is
  Cauchy_sequence_by_Norm holds vseq is convergent;

begin

definition
  let X be non empty set;
  let Y be RealNormSpace;
  let IT be Function of X, the carrier of Y;
  attr IT is bounded means


  ex K being Real st 0 <= K & for x being Element of X holds ||. IT.x .|| <= K;
end;

theorem 
  for X be non empty set for Y be RealNormSpace holds for f be
Function of X,the carrier of Y st (for x be Element of X holds f.x=0.Y) holds f
  is bounded;

registration
  let X be non empty set;
  let Y be RealNormSpace;
  cluster bounded for Function of X,the carrier of Y;
end;

definition
  let X be non empty set;
  let Y be RealNormSpace;
  func BoundedFunctions(X,Y) -> Subset of RealVectSpace(X,Y) means


  for
  x being set holds x in it iff x is bounded Function of X,the carrier of Y;
end;

registration
  let X be non empty set;
  let Y be RealNormSpace;
  cluster BoundedFunctions(X,Y) -> non empty;
end;

theorem 
  for X be non empty set for Y be RealNormSpace holds
  BoundedFunctions(X,Y) is linearly-closed;

theorem 
  for X be non empty set for Y be RealNormSpace holds RLSStruct (#
BoundedFunctions(X,Y), Zero_(BoundedFunctions(X,Y), RealVectSpace(X,Y)), Add_(
    BoundedFunctions(X,Y), RealVectSpace(X,Y)), Mult_(BoundedFunctions(X,Y),
    RealVectSpace(X,Y)) #) is Subspace of RealVectSpace(X,Y);

registration
  let X be non empty set;
  let Y be RealNormSpace;
  cluster RLSStruct (# BoundedFunctions(X,Y), Zero_(BoundedFunctions(X,Y),
RealVectSpace(X,Y)), Add_(BoundedFunctions(X,Y), RealVectSpace(X,Y)), Mult_(
      BoundedFunctions(X,Y), RealVectSpace(X,Y)) #) -> Abelian add-associative
    right_zeroed right_complementable vector-distributive
    scalar-distributive scalar-associative scalar-unital;
end;

definition
  let X be non empty set;
  let Y be RealNormSpace;
  func R_VectorSpace_of_BoundedFunctions(X,Y) -> RealLinearSpace equals

RLSStruct (# BoundedFunctions(X,Y), Zero_(BoundedFunctions(X,Y), RealVectSpace(
X,Y)), Add_(BoundedFunctions(X,Y), RealVectSpace(X,Y)), Mult_(BoundedFunctions(
    X,Y), RealVectSpace(X,Y)) #);
end;

registration
  let X be non empty set;
  let Y be RealNormSpace;
  cluster R_VectorSpace_of_BoundedFunctions(X,Y) -> strict;
end;

theorem 
  for X be non empty set for Y be RealNormSpace for f,g,h be
  VECTOR of R_VectorSpace_of_BoundedFunctions(X,Y) for f9,g9,h9 be bounded
  Function of X,the carrier of Y st f9=f & g9=g & h9=h holds (h = f+g iff for x
  be Element of X holds h9.x = f9.x + g9.x );

theorem 
  for X be non empty set for Y be RealNormSpace for f,h be VECTOR
  of R_VectorSpace_of_BoundedFunctions(X,Y) for f9,h9 be bounded Function of X,
  the carrier of Y st f9=f & h9=h for a be Real holds h = a*f iff for x be
  Element of X holds h9.x = a*f9.x;

theorem 
  for X be non empty set for Y be RealNormSpace holds 0.
  R_VectorSpace_of_BoundedFunctions(X,Y) =(X -->0.Y);

definition
  let X be non empty set;
  let Y be RealNormSpace;
  let f be set such that
 f in BoundedFunctions(X,Y);
  func modetrans(f,X,Y) -> bounded Function of X,the carrier of Y equals



  f;
end;

definition
  let X be non empty set;
  let Y be RealNormSpace;
  let u be Function of X,the carrier of Y;
  func PreNorms(u) -> non empty Subset of REAL equals

  {||.u.t.|| where t is
  Element of X : not contradiction };
end;

theorem 
  for X be non empty set for Y be RealNormSpace for g be bounded
  Function of X,the carrier of Y holds PreNorms(g) is bounded_above;

theorem 
  for X be non empty set for Y be RealNormSpace for g be Function of X,
  the carrier of Y holds g is bounded iff PreNorms(g) is bounded_above;

definition
  let X be non empty set;
  let Y be RealNormSpace;
  func BoundedFunctionsNorm(X,Y) -> Function of BoundedFunctions(X,Y), REAL
  means


  for x be set st x in BoundedFunctions(X,Y) holds it.x = upper_bound
  PreNorms(modetrans(x,X,Y));
end;

theorem 
  for X be non empty set for Y be RealNormSpace for f be bounded
  Function of X,the carrier of Y holds modetrans(f,X,Y)=f;

theorem 
  for X be non empty set for Y be RealNormSpace for f be bounded
Function of X,the carrier of Y holds BoundedFunctionsNorm(X,Y).f =
 upper_bound PreNorms
  (f);

definition
  let X be non empty set;
  let Y be RealNormSpace;
  func R_NormSpace_of_BoundedFunctions(X,Y) -> non empty NORMSTR equals

NORMSTR (# BoundedFunctions(X,Y), Zero_(BoundedFunctions(X,Y), RealVectSpace(X,
Y)), Add_(BoundedFunctions(X,Y), RealVectSpace(X,Y)), Mult_(BoundedFunctions(X,
    Y), RealVectSpace(X,Y)), BoundedFunctionsNorm(X,Y) #);
end;

theorem 
  for X be non empty set for Y be RealNormSpace holds (X --> 0.Y)
  = 0.R_NormSpace_of_BoundedFunctions(X,Y);

theorem 
  for X be non empty set for Y be RealNormSpace for f being Point
  of R_NormSpace_of_BoundedFunctions(X,Y) for g be bounded Function of X,the
  carrier of Y st g=f holds for t be Element of X holds ||.g.t.|| <= ||.f.||;

theorem 
  for X be non empty set for Y be RealNormSpace for f being Point of
  R_NormSpace_of_BoundedFunctions(X,Y) holds 0 <= ||.f.||;

theorem 
  for X be non empty set for Y be RealNormSpace for f being Point
  of R_NormSpace_of_BoundedFunctions(X,Y) st f = 0.
  R_NormSpace_of_BoundedFunctions(X,Y) holds 0 = ||.f.||;

theorem 
  for X be non empty set for Y be RealNormSpace for f,g,h be Point
of R_NormSpace_of_BoundedFunctions(X,Y) for f9,g9,h9 be bounded Function of X,
the carrier of Y st f9=f & g9=g & h9=h holds (h = f+g iff for x be Element of X
  holds h9.x = f9.x + g9.x );

theorem 
  for X be non empty set for Y be RealNormSpace for f,h be Point
of R_NormSpace_of_BoundedFunctions(X,Y) for f9,h9 be bounded Function of X,the
carrier of Y st f9=f & h9=h for a be Real holds h = a*f iff for x be Element of
  X holds h9.x = a*f9.x;

theorem 
  for X be non empty set for Y be RealNormSpace for f, g being
Point of R_NormSpace_of_BoundedFunctions(X,Y) for a be Real holds ( ||.f.|| = 0
iff f = 0.R_NormSpace_of_BoundedFunctions(X,Y) ) & ||.a*f.|| = abs(a) * ||.f.||
  & ||.f+g.|| <= ||.f.|| + ||.g.||;

theorem 
  for X be non empty set for Y be RealNormSpace holds
  R_NormSpace_of_BoundedFunctions(X,Y) is
   reflexive discerning RealNormSpace-like;

theorem 
  for X be non empty set for Y be RealNormSpace holds
  R_NormSpace_of_BoundedFunctions(X,Y) is RealNormSpace;

registration
  let X be non empty set;
  let Y be RealNormSpace;
  cluster R_NormSpace_of_BoundedFunctions(X,Y) ->
   reflexive discerning RealNormSpace-like
vector-distributive scalar-distributive scalar-associative scalar-unital
 Abelian add-associative right_zeroed right_complementable;
end;

theorem 
  for X be non empty set for Y be RealNormSpace for f,g,h be Point
of R_NormSpace_of_BoundedFunctions(X,Y) for f9,g9,h9 be bounded Function of X,
the carrier of Y st f9=f & g9=g & h9=h holds (h = f-g iff for x be Element of X
  holds h9.x = f9.x - g9.x );

theorem 
  for X be non empty set for Y be RealNormSpace st Y is complete
  for seq be sequence of R_NormSpace_of_BoundedFunctions(X,Y) st seq is
  Cauchy_sequence_by_Norm holds seq is convergent;

theorem 
  for X be non empty set for Y be RealBanachSpace holds
  R_NormSpace_of_BoundedFunctions(X,Y) is RealBanachSpace;

registration
  let X be non empty set;
  let Y be RealBanachSpace;
  cluster R_NormSpace_of_BoundedFunctions (X,Y) -> complete;
end;














begin 

definition
  struct (addLoopStr) CLSStruct (# carrier -> set, ZeroF -> Element of the
    carrier, addF -> BinOp of the carrier, Mult -> Function of [:COMPLEX, the
    carrier:], the carrier #);
end;

registration
  cluster non empty for CLSStruct;
end;

definition
  let V be CLSStruct;
  mode VECTOR of V is Element of V;
end;

definition
  let V be non empty CLSStruct, v be VECTOR of V, z be Complex;
  func z * v -> Element of V equals

  (the Mult of V).[z,v];
end;

registration
  let ZS be non empty set, O be Element of ZS, F be BinOp of ZS, G be Function
  of [:COMPLEX,ZS:],ZS;
  cluster CLSStruct (# ZS,O,F,G #) -> non empty;
end;

reserve a,b for Complex;

definition
  let IT be non empty CLSStruct;
  attr IT is vector-distributive means

 for a for v,w being VECTOR of IT holds a * (v + w) = a * v + a * w;
  attr IT is scalar-distributive means

 for a,b for v being VECTOR of IT holds (a + b) * v = a * v + b * v;
  attr IT is scalar-associative means

 for a,b for v being VECTOR of IT holds (a * b) * v = a * (b * v);
  attr IT is scalar-unital means

 for v being VECTOR of IT holds 1r * v = v;
end;

definition
  func Trivial-CLSStruct -> strict CLSStruct equals

  CLSStruct(#1,op0,op2,pr2(COMPLEX,1)#);
end;

registration
  cluster Trivial-CLSStruct -> 1-element;
end;

registration
  cluster strict Abelian add-associative right_zeroed right_complementable
    vector-distributive scalar-distributive scalar-associative scalar-unital
     for non empty CLSStruct;
end;

definition
  mode ComplexLinearSpace is Abelian add-associative right_zeroed
    right_complementable vector-distributive scalar-distributive
    scalar-associative scalar-unital non empty CLSStruct;
end;





reserve V,X,Y for ComplexLinearSpace;
reserve u,u1,u2,v,v1,v2 for VECTOR of V;
reserve z,z1,z2 for Complex;

theorem 
  z = 0 or v = 0.V implies z * v = 0.V;

theorem 
  z * v = 0.V implies z = 0 or v = 0.V;

theorem 
  - v = (- 1r) * v;

theorem 
  v = - v implies v = 0.V;

theorem 
  v + v = 0.V implies v = 0.V;

theorem 
  z * (- v) = (- z) * v;

theorem 
  z * (- v) = - (z * v);

theorem 
  (- z) * (- v) = z * v;

theorem 
  z * (v - u) = z * v - z * u;

theorem 
  (z1 - z2) * v = z1 * v - z2 * v;

theorem 
  z <> 0 & z * v = z * u implies v = u;

theorem 
  v <> 0.V & z1 * v = z2 * v implies z1 = z2;

theorem 
  for F,G being FinSequence of the carrier of V st len F = len G & (for
k being Element of NAT,v being VECTOR of V st k in dom F & v = G.k holds F.k =
  z * v) holds Sum(F) = z * Sum(G);

theorem 
  z * Sum(<*>(the carrier of V)) = 0.V;

theorem 
  z * Sum<* v,u *> = z * v + z * u;

theorem 
  z * Sum<* u,v1,v2 *> = z * u + z * v1 + z * v2;

theorem 
  Sum<* v,v *> = (1r+1r) * v;

theorem 
  Sum<* - v,- v *> = (-(1r+1r)) * v;

theorem 
  Sum<* v,v,v *> = (1r+1r+1r) * v;

begin 

reserve V1,V2,V3 for Subset of V;

definition
  let V, V1;
  attr V1 is linearly-closed means


  (for v,u being VECTOR of V st v in V1 & u in V1 holds v + u in V1) &
  for z being Complex, v being VECTOR of V st v in V1 holds z * v in V1;
end;

theorem 
  V1 <> {} & V1 is linearly-closed implies 0.V in V1;

theorem 
  V1 is linearly-closed implies for v being VECTOR of V st v in V1
  holds - v in V1;

theorem 
  V1 is linearly-closed implies for v,u being VECTOR of V st v in V1 & u
  in V1 holds v - u in V1;

theorem 
  {0.V} is linearly-closed;

theorem 
  the carrier of V = V1 implies V1 is linearly-closed;

theorem 
  V1 is linearly-closed & V2 is linearly-closed & V3 = {v + u : v in V1
  & u in V2} implies V3 is linearly-closed;

theorem 
  V1 is linearly-closed & V2 is linearly-closed implies V1 /\ V2 is
  linearly-closed;

definition
  let V;
  mode Subspace of V -> ComplexLinearSpace means


  the carrier of it c= the carrier of V & 0.it = 0.V &
  the addF of it = (the addF of V)||the carrier of it &
  the Mult of it = (the Mult of V) | [:COMPLEX, the carrier of it:];
end;



reserve W,W1,W2 for Subspace of V;
reserve x for set;
reserve w,w1,w2 for VECTOR of W;

theorem 
  x in W1 & W1 is Subspace of W2 implies x in W2;

theorem 
  x in W implies x in V;

theorem 
  w is VECTOR of V;

theorem 
  0.W = 0.V;

theorem 
  0.W1 = 0.W2;

theorem 
  w1 = v & w2 = u implies w1 + w2 = v + u;

theorem 
  w = v implies z * w = z * v;

theorem 
  w = v implies - v = - w;

theorem 
  w1 = v & w2 = u implies w1 - w2 = v - u;

theorem 
  0.V in W;

theorem 
  0.W1 in W2;

theorem 
  0.W in V;

theorem 
  u in W & v in W implies u + v in W;

theorem 
  v in W implies z * v in W;

theorem 
  v in W implies - v in W;

theorem 
  u in W & v in W implies u - v in W;

reserve D for non empty set;
reserve d1 for Element of D;
reserve A for BinOp of D;
reserve M for Function of [:COMPLEX,D:],D;

theorem 
  V1 = D & d1 = 0.V & A = (the addF of V)||V1 &
  M = (the Mult of V) | [:COMPLEX,V1:] implies
  CLSStruct (# D,d1,A,M #) is Subspace of V;

theorem 
  V is Subspace of V;

theorem 
  for V,X being strict ComplexLinearSpace holds V is Subspace of X
  & X is Subspace of V implies V = X;

theorem 
  V is Subspace of X & X is Subspace of Y implies V is Subspace of Y;

theorem 
  the carrier of W1 c= the carrier of W2 implies W1 is Subspace of W2;

theorem 
  (for v st v in W1 holds v in W2) implies W1 is Subspace of W2;

registration
  let V;
  cluster strict for Subspace of V;
end;

theorem 
  for W1,W2 being strict Subspace of V holds the carrier of W1 =
  the carrier of W2 implies W1 = W2;

theorem 
  for W1,W2 being strict Subspace of V holds (for v holds v in W1
  iff v in W2) implies W1 = W2;

theorem 
  for V being strict ComplexLinearSpace, W being strict Subspace of V
  holds the carrier of W = the carrier of V implies W = V;

theorem 
  for V being strict ComplexLinearSpace, W being strict Subspace of V
  holds (for v being VECTOR of V holds v in W iff v in V) implies W = V;

theorem 
  the carrier of W = V1 implies V1 is linearly-closed;

theorem 
  V1 <> {} & V1 is linearly-closed implies ex W being strict
  Subspace of V st V1 = the carrier of W;



definition
  let V;
  func (0).V -> strict Subspace of V means


  the carrier of it = {0.V};
end;

definition
  let V;
  func (Omega).V -> strict Subspace of V equals

  the CLSStruct of V;
end;



theorem 
  (0).W = (0).V;

theorem 
  (0).W1 = (0).W2;

theorem 
  (0).W is Subspace of V;

theorem 
  (0).V is Subspace of W;

theorem 
  (0).W1 is Subspace of W2;

theorem 
  for V being strict ComplexLinearSpace holds V is Subspace of (Omega).V;



definition
  let V;
  let v,W;
  func v + W -> Subset of V equals

  {v + u : u in W};
end;

definition
  let V;
  let W;
  mode Coset of W -> Subset of V means


  ex v st it = v + W;
end;

reserve B,C for Coset of W;



theorem 
  0.V in v + W iff v in W;

theorem 
  v in v + W;

theorem 
  0.V + W = the carrier of W;

theorem 
  v + (0).V = {v};

theorem 
  v + (Omega).V = the carrier of V;

theorem 
  0.V in v + W iff v + W = the carrier of W;

theorem 
  v in W iff v + W = the carrier of W;

theorem 
  v in W implies (z * v) + W = the carrier of W;

theorem 
  z <> 0 & (z * v) + W = the carrier of W implies v in W;

theorem 
  v in W iff - v + W = the carrier of W;

theorem 
  u in W iff v + W = (v + u) + W;

theorem 
  u in W iff v + W = (v - u) + W;

theorem 
  v in u + W iff u + W = v + W;

theorem 
  v + W = (- v) + W iff v in W;

theorem 
  u in v1 + W & u in v2 + W implies v1 + W = v2 + W;

theorem 
  u in v + W & u in (- v) + W implies v in W;

theorem 
  z <> 1r & z * v in v + W implies v in W;

theorem 
  v in W implies z * v in v + W;

theorem 
  - v in v + W iff v in W;

theorem 
  u + v in v + W iff u in W;

theorem 
  v - u in v + W iff u in W;

theorem 
  u in v + W iff ex v1 st v1 in W & u = v + v1;

theorem 
  u in v + W iff ex v1 st v1 in W & u = v - v1;

theorem 
  (ex v st v1 in v + W & v2 in v + W) iff v1 - v2 in W;

theorem 
  v + W = u + W implies ex v1 st v1 in W & v + v1 = u;

theorem 
  v + W = u + W implies ex v1 st v1 in W & v - v1 = u;

theorem 
  for W1,W2 being strict Subspace of V holds v + W1 = v + W2 iff W1 = W2;

theorem 
  for W1,W2 being strict Subspace of V holds v + W1 = u + W2 implies W1 = W2;




theorem 
  C is linearly-closed iff C = the carrier of W;

theorem 
  for W1,W2 being strict Subspace of V, C1 being Coset of W1, C2 being
  Coset of W2 holds C1 = C2 implies W1 = W2;

theorem 
  {v} is Coset of (0).V;

theorem 
  V1 is Coset of (0).V implies ex v st V1 = {v};

theorem 
  the carrier of W is Coset of W;

theorem 
  the carrier of V is Coset of (Omega).V;

theorem 
  V1 is Coset of (Omega).V implies V1 = the carrier of V;

theorem 
  0.V in C iff C = the carrier of W;

theorem 
  u in C iff C = u + W;

theorem 
  u in C & v in C implies ex v1 st v1 in W & u + v1 = v;

theorem 
  u in C & v in C implies ex v1 st v1 in W & u - v1 = v;

theorem 
  (ex C st v1 in C & v2 in C) iff v1 - v2 in W;

theorem 
  u in B & u in C implies B = C;

begin 

definition
  struct(CLSStruct,N-ZeroStr) CNORMSTR (# carrier -> set,
    ZeroF -> Element of the carrier,
    addF -> BinOp of the carrier, Mult -> Function of [:COMPLEX, the
    carrier:], the carrier, normF -> Function of the carrier, REAL #);
end;

registration
  cluster non empty for CNORMSTR;
end;

definition

  let IT be non empty CNORMSTR;
  attr IT is ComplexNormSpace-like means


  for x, y being Point of IT, z holds
  ||.z * x.|| = |.z.| * ||.x.|| & ||.x + y .|| <= ||.x.|| + ||.y.||;
end;

registration
  cluster reflexive discerning ComplexNormSpace-like
  vector-distributive scalar-distributive scalar-associative scalar-unital
  Abelian add-associative right_zeroed right_complementable
  strict for non empty CNORMSTR;
end;

definition
  mode ComplexNormSpace is reflexive discerning ComplexNormSpace-like
  vector-distributive scalar-distributive scalar-associative scalar-unital
  Abelian add-associative right_zeroed right_complementable
    non empty CNORMSTR;
end;

reserve CNS for ComplexNormSpace;
reserve x, y, w, g, g1, g2 for Point of CNS;

theorem 
  ||.0.CNS.|| = 0;

theorem 
  ||.-x.|| = ||.x.||;

theorem 
  ||.x - y.|| <= ||.x.|| + ||.y.||;

theorem 
  0 <= ||.x.||;

theorem 
  ||.z1 * x + z2 * y.|| <= |.z1.| * ||.x.|| + |.z2.| * ||.y.||;

theorem 
  ||.x - y.|| = 0 iff x = y;

theorem 
  ||.x - y.|| = ||.y - x.||;

theorem 
  ||.x.|| - ||.y.|| <= ||.x - y.||;

theorem 
  abs(||.x.|| - ||.y.||) <= ||.x - y.||;

theorem 
  ||.x - w.|| <= ||.x - y.|| + ||.y - w.||;

theorem 
  x <> y implies ||.x - y.|| <> 0;

reserve S, S1, S2 for sequence of CNS;
reserve n, m, m1, m2 for Element of NAT;
reserve r for Real;

definition
  let CNS be ComplexLinearSpace;
  let S be sequence of CNS;
  let z;
  func z * S -> sequence of CNS means


  for n holds it.n = z * S.n;
end;

definition
  let CNS;
  let S;
  attr S is convergent means


  ex g st for r st 0 < r ex m st for n st m <= n holds ||.(S.n) - g.|| < r;
end;

theorem 
  S1 is convergent & S2 is convergent implies S1 + S2 is convergent;

theorem 
  S1 is convergent & S2 is convergent implies S1 - S2 is convergent;

theorem 
  S is convergent implies S - x is convergent;

theorem 
  S is convergent implies z * S is convergent;

theorem 
  S is convergent implies ||.S.|| is convergent;

definition
  let CNS;
  let S;
  assume
 S is convergent;
  func lim S -> Point of CNS means


  for r st 0 < r ex m st for n st m <= n holds ||.(S.n) - it.|| < r;
end;

theorem 
  S is convergent & lim S = g implies ||.S - g.|| is convergent & lim
  ||.S - g.|| = 0;

theorem 
  S1 is convergent & S2 is convergent implies lim(S1+S2) = (lim S1) + (
  lim S2 );

theorem 
  S1 is convergent & S2 is convergent implies lim (S1-S2) = (lim S1) - (
  lim S2 );

theorem 
  S is convergent implies lim (S - x) = (lim S) - x;

theorem 
  S is convergent implies lim (z * S) = z * (lim S);

theorem 
  for V,V1,v for w be VECTOR of CLSStruct (# D,d1,A,M #) st
  V1 = D & M = (the Mult of V) | [:COMPLEX,V1:] & w = v holds
  z*w = z*v;















begin 

theorem 
  for X,Y,Z be RealLinearSpace for f be LinearOperator of X,Y for g
  be LinearOperator of Y,Z holds g*f is LinearOperator of X,Z;

theorem 
  for X,Y,Z be RealNormSpace for f be Lipschitzian LinearOperator of X,Y
for g be Lipschitzian LinearOperator of Y,Z holds
g*f is Lipschitzian LinearOperator of X
,Z & for x be VECTOR of X holds ||.((g*f).x).|| <=(BoundedLinearOperatorsNorm(Y
  ,Z).g) *(BoundedLinearOperatorsNorm(X,Y).f )*||.x.|| & (
BoundedLinearOperatorsNorm(X,Z).(g*f)) <=(BoundedLinearOperatorsNorm(Y,Z).g) *(
  BoundedLinearOperatorsNorm(X,Y).f);

definition
  let X be RealNormSpace;
  let f,g be Lipschitzian LinearOperator of X,X;
  redefine func g*f -> Lipschitzian LinearOperator of X,X;
end;

definition
  let X be RealNormSpace;
  let f,g be Element of BoundedLinearOperators(X,X);
  func f + g -> Element of BoundedLinearOperators(X,X) equals

  Add_ (
  BoundedLinearOperators(X,X), R_VectorSpace_of_LinearOperators(X,X) ) .(f,g);
end;

definition
  let X be RealNormSpace;
  let f,g be Element of BoundedLinearOperators(X,X);
  func g*f -> Element of BoundedLinearOperators(X,X) equals

  modetrans(g,X,X)*modetrans(f,X,X);
end;

definition
  let X be RealNormSpace;
  let f be Element of BoundedLinearOperators(X,X);
  let a be Real;
  func a*f -> Element of BoundedLinearOperators(X,X) equals

  Mult_(
  BoundedLinearOperators(X,X), R_VectorSpace_of_LinearOperators(X,X)).(a,f);
end;

definition
  let X be RealNormSpace;
  func FuncMult(X) -> BinOp of BoundedLinearOperators(X,X) means


  for f, g being Element of BoundedLinearOperators(X,X) holds it.(f,g) = f*g;
end;

theorem 
  for X be RealNormSpace holds id (the carrier of X) is Lipschitzian
  LinearOperator of X,X;

definition
  let X be RealNormSpace;
  func FuncUnit(X) -> Element of BoundedLinearOperators(X,X) equals

  id (the carrier of X);
end;

theorem 
  for X be RealNormSpace for f,g,h be Lipschitzian LinearOperator of X,X
  holds h = f*g iff for x be VECTOR of X holds h.x = f.(g.x);

theorem 
  for X be RealNormSpace for f,g,h be Lipschitzian LinearOperator of X,X
  holds f*(g*h) =(f*g)*h;

theorem 
  for X be RealNormSpace for f be Lipschitzian LinearOperator of X,X
  holds f*(id the carrier of X) = f & (id the carrier of X )*f=f;

theorem 
  for X be RealNormSpace for f,g,h be Element of
  BoundedLinearOperators(X,X) holds f*(g*h) =(f*g)*h;

theorem 
  for X be RealNormSpace for f be Element of BoundedLinearOperators
  (X,X) holds f*FuncUnit(X)= f & FuncUnit(X)*f=f;

theorem 
  for X be RealNormSpace for f,g,h be Element of
  BoundedLinearOperators(X,X) holds f *(g+h)=f*g + f*h;

theorem 
  for X be RealNormSpace for f,g,h be Element of
  BoundedLinearOperators(X,X) holds (g+h)*f = g*f + h*f;

theorem 
  for X be RealNormSpace for f,g be Element of
  BoundedLinearOperators(X,X) for a,b be Real holds (a*b)*(f*g)=(a*f)*(b*g);

theorem 
  for X be RealNormSpace for f,g be Element of
  BoundedLinearOperators(X,X) for a be Real holds a*(f*g) =(a*f)*g;

definition
  let X be RealNormSpace;
  func Ring_of_BoundedLinearOperators(X) -> doubleLoopStr equals

  doubleLoopStr
  (# BoundedLinearOperators(X,X), Add_(BoundedLinearOperators(X,X),
    R_VectorSpace_of_LinearOperators(X,X)), FuncMult(X), FuncUnit(X), Zero_(
    BoundedLinearOperators(X,X), R_VectorSpace_of_LinearOperators(X,X)) #);
end;

registration
  let X be RealNormSpace;
  cluster Ring_of_BoundedLinearOperators(X) -> non empty strict;
end;

registration
  let X be RealNormSpace;
  cluster Ring_of_BoundedLinearOperators(X) -> unital;
end;

theorem 
  for X be RealNormSpace for x,y,z being Element of
  Ring_of_BoundedLinearOperators(X) holds x+y = y+x & (x+y)+z = x+(y+z) & x+(0.
  Ring_of_BoundedLinearOperators(X)) = x & (ex t being Element of
Ring_of_BoundedLinearOperators(X) st x+t= 0.Ring_of_BoundedLinearOperators(X))
  & (x*y)*z = x*(y*z) & x*(1.Ring_of_BoundedLinearOperators(X)) = x & (1.
Ring_of_BoundedLinearOperators(X))*x = x & x*(y+z) = x*y + x*z & (y+z)*x = y*x
  + z*x;

theorem 
  for X be RealNormSpace holds Ring_of_BoundedLinearOperators(X) is Ring;

registration
  let X be RealNormSpace;
  cluster Ring_of_BoundedLinearOperators(X) -> Abelian add-associative
    right_zeroed right_complementable associative left_unital right_unital
    distributive;
end;

definition
  let X be RealNormSpace;
  func R_Algebra_of_BoundedLinearOperators(X) -> AlgebraStr equals

  AlgebraStr
(# BoundedLinearOperators(X,X), FuncMult(X), Add_(BoundedLinearOperators(X,X),
    R_VectorSpace_of_LinearOperators(X,X)), Mult_(BoundedLinearOperators(X,X),
    R_VectorSpace_of_LinearOperators(X,X)), FuncUnit(X), Zero_(
    BoundedLinearOperators(X,X), R_VectorSpace_of_LinearOperators(X,X)) #);
end;

registration
  let X be RealNormSpace;
  cluster R_Algebra_of_BoundedLinearOperators(X) -> non empty strict;
end;

registration
  let X be RealNormSpace;
  cluster R_Algebra_of_BoundedLinearOperators(X) -> unital;
end;

theorem 
  for X be RealNormSpace for x,y,z being Element of
R_Algebra_of_BoundedLinearOperators(X) for a,b be Real holds x+y = y+x & (x+y)+
  z = x+(y+z) & x+(0.R_Algebra_of_BoundedLinearOperators(X)) = x & (ex t being
  Element of R_Algebra_of_BoundedLinearOperators(X) st x+t= 0.
  R_Algebra_of_BoundedLinearOperators(X)) & (x*y)*z = x*(y*z) & x*(1.
  R_Algebra_of_BoundedLinearOperators(X)) = x & (1.
R_Algebra_of_BoundedLinearOperators(X))*x = x & x*(y+z) = x*y + x*z & (y+z)*x =
y*x + z*x & a*(x*y) = (a*x)*y & a*(x+y) = a*x + a*y & (a+b)*x = a*x + b*x & (a*
  b)*x = a*(b*x) & (a*b)*(x*y)=(a*x)*(b*y);

definition
  mode BLAlgebra is Abelian add-associative right_zeroed right_complementable
    associative right_unital right-distributive vector-distributive
    scalar-distributive scalar-associative vector-associative
      non empty AlgebraStr;
end;

registration let X be RealNormSpace;
 cluster R_Algebra_of_BoundedLinearOperators X ->
  Abelian add-associative right_zeroed right_complementable
  associative right_unital right-distributive vector-distributive
  scalar-distributive scalar-associative vector-associative strict;
end;

theorem 
  for X be RealNormSpace holds R_Algebra_of_BoundedLinearOperators(X) is
  BLAlgebra;

registration
  cluster l1_Space -> complete;
end;

registration
  cluster l1_Space -> non trivial;
end;

registration
  cluster non trivial for RealBanachSpace;
end;

theorem 
  for X be non trivial RealNormSpace ex w be VECTOR of X st ||. w .|| = 1;

theorem 
  for X be non trivial RealNormSpace holds
  BoundedLinearOperatorsNorm(X,X).(id the carrier of X) = 1;

definition
  struct(AlgebraStr,NORMSTR) Normed_AlgebraStr (# carrier -> set,
    multF,addF -> (BinOp of the carrier),
    Mult -> (Function of [:REAL,the carrier:],the carrier),
    OneF,ZeroF -> Element of the carrier,
    normF -> Function of the carrier, REAL#);
end;

registration
  cluster non empty for Normed_AlgebraStr;
end;

definition
  let X be RealNormSpace;
  func R_Normed_Algebra_of_BoundedLinearOperators(X) -> Normed_AlgebraStr
  equals

  Normed_AlgebraStr (# BoundedLinearOperators(X,X), FuncMult(X), Add_(
    BoundedLinearOperators(X,X), R_VectorSpace_of_LinearOperators(X,X)), Mult_(
BoundedLinearOperators(X,X), R_VectorSpace_of_LinearOperators(X,X)), FuncUnit(X
), Zero_(BoundedLinearOperators(X,X), R_VectorSpace_of_LinearOperators(X,X)),
    BoundedLinearOperatorsNorm(X,X) #);
end;

registration
  let X be RealNormSpace;
  cluster R_Normed_Algebra_of_BoundedLinearOperators(X) -> non empty strict;
end;

registration
  let X be RealNormSpace;
  cluster R_Normed_Algebra_of_BoundedLinearOperators(X) -> unital;
end;

theorem 
  for X be RealNormSpace for x,y,z being Element of
R_Normed_Algebra_of_BoundedLinearOperators(X) for a,b be real number holds x+y
= y+x & (x+y)+z = x+(y+z) & x+(0.R_Normed_Algebra_of_BoundedLinearOperators(X))
= x & (ex t being Element of R_Normed_Algebra_of_BoundedLinearOperators(X) st x
+t= 0.R_Normed_Algebra_of_BoundedLinearOperators(X)) & (x*y)*z = x*(y*z) & x*(
  1.R_Normed_Algebra_of_BoundedLinearOperators(X)) = x & (1.
R_Normed_Algebra_of_BoundedLinearOperators(X))*x = x & x*(y+z) = x*y + x*z & (y
+z)*x = y*x + z*x & a*(x*y) = (a*x)*y & (a*b)*(x*y)=(a*x)*(b*y) & a*(x+y) = a*x
  + a*y & (a+b)*x = a*x + b*x & (a*b)*x = a*(b*x) & 1*x =x;

theorem 
  for X be RealNormSpace holds R_Normed_Algebra_of_BoundedLinearOperators(X) is
  reflexive discerning RealNormSpace-like Abelian
  add-associative right_zeroed right_complementable associative right_unital
  right-distributive vector-distributive scalar-distributive scalar-associative
  vector-associative vector-distributive scalar-distributive scalar-associative
  scalar-unital;

registration
  cluster reflexive discerning RealNormSpace-like Abelian add-associative
  right_zeroed
right_complementable associative right_unital right-distributive
vector-distributive scalar-distributive scalar-associative vector-associative
    vector-distributive scalar-distributive scalar-associative
    scalar-unital strict for non empty Normed_AlgebraStr;
end;

definition
  mode Normed_Algebra is reflexive discerning RealNormSpace-like
  Abelian add-associative right_zeroed right_complementable associative
    right_unital right-distributive
    vector-distributive scalar-distributive scalar-associative
    vector-associative scalar-unital non empty Normed_AlgebraStr;
end;

registration
  let X be RealNormSpace;
  cluster R_Normed_Algebra_of_BoundedLinearOperators(X) ->
    reflexive discerning RealNormSpace-like
    Abelian add-associative right_zeroed right_complementable associative
    right_unital right-distributive vector-distributive scalar-distributive
    scalar-associative vector-associative scalar-unital;
end;

definition
  let X be non empty Normed_AlgebraStr;
  attr X is Banach_Algebra-like_1 means

  for x,y being Element of X holds ||. x *y .|| <= ||.x.|| * ||.y.||;
  attr X is Banach_Algebra-like_2 means

  ||. 1.X .|| = 1;
  attr X is Banach_Algebra-like_3 means

  for a being Real for x,y being Element of X holds a*(x*y)=x*(a*y);
end;

definition
  let X be Normed_Algebra;
  attr X is Banach_Algebra-like means

  X is Banach_Algebra-like_1 Banach_Algebra-like_2 Banach_Algebra-like_3
  left_unital left-distributive complete;
end;

registration
  cluster Banach_Algebra-like -> Banach_Algebra-like_1 Banach_Algebra-like_2
Banach_Algebra-like_3 left-distributive left_unital complete for
Normed_Algebra;
  cluster Banach_Algebra-like_1 Banach_Algebra-like_2 Banach_Algebra-like_3
left-distributive left_unital complete -> Banach_Algebra-like for
Normed_Algebra;
end;

registration
  let X be non trivial RealBanachSpace;
  cluster R_Normed_Algebra_of_BoundedLinearOperators(X) -> Banach_Algebra-like;
end;

registration
  cluster Banach_Algebra-like for Normed_Algebra;
end;

definition
  mode Banach_Algebra is Banach_Algebra-like Normed_Algebra;
end;

theorem 
  for X being RealNormSpace holds 1.Ring_of_BoundedLinearOperators(X) =
  FuncUnit(X);

theorem 
  for X being RealNormSpace holds 1.R_Algebra_of_BoundedLinearOperators(
  X) = FuncUnit(X);

theorem 
  for X being RealNormSpace holds 1.
  R_Normed_Algebra_of_BoundedLinearOperators(X) = FuncUnit(X);














begin

definition
  func the_set_of_ComplexSequences -> non empty set means


  for x being set holds x in it iff x is Complex_Sequence;
end;

definition
  let z be set such that
 z in the_set_of_ComplexSequences;
  func seq_id(z) -> Complex_Sequence equals


  z;
end;

definition
  let z be set such that
 z is Complex;
  func C_id(z) -> Complex equals


  z;
end;

definition
  func l_add -> BinOp of the_set_of_ComplexSequences means


  for a,b
being Element of the_set_of_ComplexSequences holds it.(a,b) = seq_id(a)+seq_id(
  b);
end;

definition
  func l_mult -> Function of [:COMPLEX,the_set_of_ComplexSequences:],
  the_set_of_ComplexSequences means


  for z,x be set st z is Complex & x in the_set_of_ComplexSequences holds
  it.(z,x) = C_id(z)(#)seq_id(x);
end;

definition
  func CZeroseq -> Element of the_set_of_ComplexSequences means


  for n be Element of NAT holds (seq_id it).n=0c;
end;

theorem 
  for x being Complex_Sequence holds seq_id x = x;

theorem 
  for v,w being VECTOR of CLSStruct(#the_set_of_ComplexSequences,
    CZeroseq,l_add,l_mult#) holds v + w = seq_id(v)+seq_id(w);

theorem 
  for z being Complex, v being VECTOR of CLSStruct(#
the_set_of_ComplexSequences,CZeroseq,l_add,l_mult #) holds z * v = z(#)seq_id(v
  );

registration
  cluster CLSStruct(# the_set_of_ComplexSequences,CZeroseq,l_add,l_mult #) ->
    Abelian;
end;

theorem 
  for u,v,w being VECTOR of CLSStruct(# the_set_of_ComplexSequences
    ,CZeroseq,l_add,l_mult #) holds (u + v) + w = u + (v + w);

theorem 
  for v being VECTOR of CLSStruct(# the_set_of_ComplexSequences,
CZeroseq,l_add,l_mult #) holds v + 0.CLSStruct(# the_set_of_ComplexSequences,
    CZeroseq,l_add,l_mult #) = v;

theorem 
  for v being VECTOR of CLSStruct(# the_set_of_ComplexSequences,
    CZeroseq,l_add,l_mult #) ex w being VECTOR of CLSStruct(#
the_set_of_ComplexSequences,CZeroseq,l_add,l_mult #) st v + w = 0.CLSStruct(#
    the_set_of_ComplexSequences,CZeroseq,l_add,l_mult #);

theorem 
  for z being Complex, v,w being VECTOR of CLSStruct(#
the_set_of_ComplexSequences,CZeroseq,l_add,l_mult #) holds z * (v + w) = z * v
  + z * w;

theorem 
  for z1,z2 being Complex, v being VECTOR of CLSStruct(#
the_set_of_ComplexSequences,CZeroseq,l_add,l_mult #) holds (z1 + z2) * v = z1 *
  v + z2 * v;

theorem 
  for z1,z2 be Complex, v being VECTOR of CLSStruct(#
the_set_of_ComplexSequences,CZeroseq,l_add,l_mult #) holds (z1 * z2) * v = z1 *
  (z2 * v);

theorem 
  for v being VECTOR of CLSStruct(# the_set_of_ComplexSequences,
    CZeroseq,l_add,l_mult #) holds 1r * v = v;

definition
  func Linear_Space_of_ComplexSequences -> strict non empty CLSStruct equals

  CLSStruct (# the_set_of_ComplexSequences, CZeroseq, l_add, l_mult #);
end;

registration
  cluster Linear_Space_of_ComplexSequences -> Abelian add-associative
    right_zeroed right_complementable vector-distributive scalar-distributive
    scalar-associative scalar-unital;
end;

definition
  let X be ComplexLinearSpace;
  let X1 be Subset of X such that
 X1 is linearly-closed;
  func Add_(X1,X) -> BinOp of X1 equals


  (the addF of X) || X1;
end;

definition
  let X be ComplexLinearSpace;
  let X1 be Subset of X such that
 X1 is linearly-closed;
  func Mult_(X1,X) -> Function of [:COMPLEX,X1:], X1 equals


  (the Mult
  of X) | [:COMPLEX,X1:];
end;

definition
  let X be ComplexLinearSpace, X1 be Subset of X such that
 X1 is linearly-closed and
 X1 is non empty;
  func Zero_(X1,X) -> Element of X1 equals


  0.X;
end;

theorem 
  for V be ComplexLinearSpace, V1 be Subset of V st V1 is
linearly-closed & V1 is non empty holds CLSStruct (# V1,Zero_(V1,V), Add_(V1,V)
    ,Mult_(V1,V) #) is Subspace of V;

definition
  func the_set_of_l2ComplexSequences -> Subset of
  Linear_Space_of_ComplexSequences means


  it is non empty & for x being
  set holds x in it iff x in the_set_of_ComplexSequences & |.seq_id(x).|(#)|.
  seq_id(x).| is summable;
end;

theorem 
  the_set_of_l2ComplexSequences is linearly-closed &
  the_set_of_l2ComplexSequences is non empty;

theorem 
  CLSStruct(# the_set_of_l2ComplexSequences, Zero_(
    the_set_of_l2ComplexSequences,Linear_Space_of_ComplexSequences), Add_(
    the_set_of_l2ComplexSequences,Linear_Space_of_ComplexSequences), Mult_(
the_set_of_l2ComplexSequences,Linear_Space_of_ComplexSequences) #) is Subspace
  of Linear_Space_of_ComplexSequences;

theorem 
  CLSStruct (# the_set_of_l2ComplexSequences, Zero_(
    the_set_of_l2ComplexSequences,Linear_Space_of_ComplexSequences), Add_(
    the_set_of_l2ComplexSequences,Linear_Space_of_ComplexSequences), Mult_(
    the_set_of_l2ComplexSequences,Linear_Space_of_ComplexSequences) #) is
  ComplexLinearSpace;

theorem 
  the carrier of Linear_Space_of_ComplexSequences =
  the_set_of_ComplexSequences & (for x be set holds x is Element of
  Linear_Space_of_ComplexSequences iff x is Complex_Sequence ) & (for x be set
holds x is VECTOR of Linear_Space_of_ComplexSequences iff x is Complex_Sequence
) & (for u be VECTOR of Linear_Space_of_ComplexSequences holds u =seq_id(u) ) &
  (for u,v be VECTOR of Linear_Space_of_ComplexSequences holds u+v =seq_id(u)+
  seq_id(v) ) & for z be Complex for u be VECTOR of
Linear_Space_of_ComplexSequences holds z*u =z(#)seq_id(u)
;

begin  

definition
  struct(CLSStruct) CUNITSTR (# carrier -> set, ZeroF -> Element of the
    carrier, addF -> BinOp of the carrier, Mult -> Function of [:COMPLEX, the
carrier:], the carrier, scalar -> Function of [: the carrier, the carrier :],
    COMPLEX #);
end;

registration
  cluster non empty strict for CUNITSTR;
end;

registration
  let D be non empty set, Z be Element of D, a be BinOp of D,m be Function of
  [:COMPLEX, D:], D, s be Function of [: D,D:],COMPLEX;
  cluster CUNITSTR (#D,Z,a,m,s#) -> non empty;
end;

reserve X for non empty CUNITSTR;
reserve a, b for Complex;
reserve x, y for Point of X;

definition
  let X;
  let x, y;
  func x .|. y -> Complex equals

  (the scalar of X).(x,y);
end;

definition
  let IT be non empty CUNITSTR;
  attr IT is ComplexUnitarySpace-like means


  for x,y,w being Point of
IT, a holds ( x .|. x = 0 iff x = 0.IT ) & 0 <= Re(x .|. x) & 0 = Im(x .|. x) &
x .|. y = (y .|. x)*' & (x+y) .|. w = x .|. w + y .|. w & (a*x) .|. y = a * ( x
  .|. y );
end;

registration
  cluster ComplexUnitarySpace-like vector-distributive scalar-distributive
  scalar-associative scalar-unital Abelian
add-associative right_zeroed right_complementable strict for
non empty CUNITSTR;
end;

definition
  mode ComplexUnitarySpace is ComplexUnitarySpace-like vector-distributive
  scalar-distributive scalar-associative scalar-unital
Abelian add-associative right_zeroed right_complementable non empty CUNITSTR;
end;

reserve X for ComplexUnitarySpace;
reserve x, y, z, u, v for Point of X;

theorem 
  (0.X).|.(0.X) = 0;

theorem 
  x.|.(y+z) = x.|.y + x.|.z;

theorem 
  x.|.(a*y) = (a*') * x.|.y;

theorem 
  (a*x).|.y = x.|.((a*')*y);

theorem 
  (a*x + b*y).|.z = a * x.|.z + b * y.|.z;

theorem 
  x.|.(a*y + b*z) = (a*') * x.|.y + (b*') * x.|.z;

theorem 
  (-x) .|. y = x .|. (-y);

theorem 
  (-x).|.y = - x.|.y;

theorem 
  x.|.(-y) = - x.|.y;

theorem 
  (-x).|.(-y) = x.|.y;

theorem 
  (x-y).|.z = x.|.z - y.|.z;

theorem 
  x.|.(y-z) = x.|.y - x.|.z;

theorem 
  (x-y).|.(u-v) = x.|.u - x.|.v - y.|.u + y.|.v;

theorem 
  (0.X).|.x = 0;

theorem 
  x.|.0.X = 0;

theorem 
  (x+y).|.(x+y) = x.|.x + x.|.y + y.|.x + y.|.y;

theorem 
  (x+y).|.(x-y) = x.|.x - x.|.y + y.|.x - y.|.y;

theorem 
  (x-y).|.(x-y) = x.|.x - x.|.y - y.|.x + y.|.y;

theorem 
  |.(x.|.x).| = Re(x.|.x);

theorem 
  |.(x.|.y).| <= sqrt|.(x.|.x).| * sqrt|.(y.|.y).|;

definition
  let X;
  let x, y;
  pred x, y are_orthogonal means


  x .|. y = 0;
  symmetry;
end;

theorem 
  x, y are_orthogonal implies x, - y are_orthogonal;

theorem 
  x, y are_orthogonal implies -x, y are_orthogonal;

theorem 
  x, y are_orthogonal implies -x, -y are_orthogonal;

theorem 
  x, 0.X are_orthogonal;

theorem 
  x,y are_orthogonal implies (x+y).|.(x+y) = x.|.x + y.|.y;

theorem 
  x,y are_orthogonal implies (x-y).|.(x-y) = x.|.x + y.|.y;

definition
  let X, x;
  func ||.x.|| -> Real equals

  sqrt |.(x.|.x).|;
end;

theorem 
  ||.x.|| = 0 iff x = 0.X;

theorem 
  ||.a * x.|| = |.a.| * ||.x.||;

theorem 
  0 <= ||.x.||;

theorem 
  |.(x.|.y).| <= ||.x.|| * ||.y.||;

theorem 
  ||.x + y.|| <= ||.x.|| + ||.y.||;

theorem 
  ||.-x.|| = ||.x.||;

theorem 
  ||.x.|| - ||.y.|| <= ||.x - y.||;

theorem 
  abs(||.x.|| - ||.y.||) <= ||.x - y.||;

definition
  let X, x, y;
  func dist(x,y) -> Real equals

  ||.x - y.||;
end;

definition
  let X, x, y;
  redefine func dist(x,y);
  commutativity;
end;

theorem 
  dist(x,x) = 0;

theorem 
  dist(x,z) <= dist(x,y) + dist(y,z);

theorem 
  x <> y iff dist(x,y) <> 0;

theorem 
  dist(x,y) >= 0;

theorem 
  x <> y iff dist(x,y) > 0;

theorem 
  dist(x,y) = sqrt |.((x-y) .|. (x-y)).|;

theorem 
  dist(x + y,u + v) <= dist(x,u) + dist(y,v);

theorem 
  dist(x - y,u - v) <= dist(x,u) + dist(y,v);

theorem 
  dist(x - z, y - z) = dist(x,y);

theorem 
  dist(x - z,y - z) <= dist(z,x) + dist(z,y);

reserve seq, seq1, seq2, seq3 for sequence of X;
reserve  n for Element of NAT;

definition
  let X, seq1, seq2;
  redefine func seq1 + seq2;
  commutativity;
end;

theorem 
  seq1 + (seq2 + seq3) = (seq1 + seq2) + seq3;

theorem 
  seq1 is constant & seq2 is constant & seq = seq1 + seq2 implies seq is
  constant;

theorem 
  seq1 is constant & seq2 is constant & seq = seq1 - seq2 implies seq is
  constant;

theorem 
  seq1 is constant & seq = a * seq1 implies seq is constant;

theorem 
  seq1 - seq2 = seq1 + -seq2;

theorem 
  seq = seq + 0.X;

theorem 
  a * (seq1 + seq2) = a * seq1 + a * seq2;

theorem 
  (a + b) * seq = a * seq + b * seq;

theorem 
  (a * b) * seq = a * (b * seq);

theorem 
  1r * seq = seq;

theorem 
  (-1r) * seq = - seq;

theorem 
  seq - x = seq + -x;

theorem 
  seq1 - seq2 = - (seq2 - seq1);

theorem 
  seq = seq - 0.X;

theorem 
  seq = - ( - seq );

theorem 
  seq1 - (seq2 + seq3) = (seq1 - seq2) - seq3;

theorem 
  (seq1 + seq2) - seq3 = seq1 + (seq2 - seq3);

theorem 
  seq1 - (seq2 - seq3) = (seq1 - seq2) + seq3;

theorem 
  a * (seq1 - seq2) = a * seq1 - a * seq2;

begin 

definition
  func cl_scalar -> Function of [:the_set_of_l2ComplexSequences,
  the_set_of_l2ComplexSequences:], COMPLEX means

  for x,y be set st x in
the_set_of_l2ComplexSequences & y in the_set_of_l2ComplexSequences holds it.(x,
  y) = Sum(seq_id(x)(#)(seq_id(y))*');
end;

registration
  cluster CUNITSTR (# the_set_of_l2ComplexSequences, Zero_(
      the_set_of_l2ComplexSequences,Linear_Space_of_ComplexSequences), Add_(
      the_set_of_l2ComplexSequences,Linear_Space_of_ComplexSequences), Mult_(
the_set_of_l2ComplexSequences,Linear_Space_of_ComplexSequences), cl_scalar #)
    -> non empty;
end;

definition
  func Complex_l2_Space -> non empty CUNITSTR equals

  CUNITSTR (#
    the_set_of_l2ComplexSequences, Zero_(the_set_of_l2ComplexSequences,
    Linear_Space_of_ComplexSequences), Add_(the_set_of_l2ComplexSequences,
    Linear_Space_of_ComplexSequences), Mult_(the_set_of_l2ComplexSequences,
    Linear_Space_of_ComplexSequences), cl_scalar #);
end;

theorem 
  for l be CLSStruct st the CLSStruct of l is ComplexLinearSpace
  holds l is ComplexLinearSpace;

theorem 
  for seq be Complex_Sequence st (for n be Element of NAT holds seq.n=0c
  ) holds seq is summable & Sum seq = 0c;

registration
  cluster Complex_l2_Space -> Abelian add-associative right_zeroed
    right_complementable vector-distributive scalar-distributive
    scalar-associative scalar-unital;
end;















begin

reserve T for non empty RelStr,
  A,B for Subset of T,
  x,x2,y,z for Element of T;




definition
  let T;
  let A be Subset of T;
  func A^d -> Subset of T equals

  {x where x is Element of T : for y being
  Element of T st y in A` holds not x in U_FT y};
end;

theorem 
  T is filled implies A c= A^f;

theorem 
  x in A^d iff for y st y in A` holds not x in U_FT y;

theorem 
  T is filled implies A^d c= A;

theorem 
  A^d = ((A`)^f)`;

theorem 
  A c= B implies A^f c= B^f;

theorem 
  A c= B implies A^d c= B^d;

theorem 
  (A /\ B)^b c= (A^b) /\ (B^b);

theorem 
  (A \/ B)^b = (A^b) \/ (B^b);

theorem 
  (A^i) \/ (B^i) c= (A \/ B)^i;

theorem 
  (A^i) /\ (B^i) = (A /\ B)^i;

theorem 
  (A^f) \/ (B^f) = (A \/ B)^f;

theorem 
  (A^d) /\ (B^d) = (A /\ B)^d;

definition
  let T be non empty RelStr;
  let A be Subset of T;
  func Fcl(A) -> Function of NAT,bool the carrier of T means


  (for n
being Element of NAT,B being Subset of T st B=it.n holds it.(n+1)=B^b) & it.0=A
  ;
end;

definition
  let T be non empty RelStr;
  let A be Subset of T, n be Nat;
  func Fcl(A,n) -> Subset of T equals

  (Fcl A).n;
end;

definition
  let T be non empty RelStr;
  let A be Subset of T;
  func Fint(A) -> Function of NAT,bool the carrier of T means


  (for n
being Element of NAT,B being Subset of T st B=it.n holds it.(n+1)=B^i) & it.0=A
  ;
end;

definition
  let T be non empty RelStr;
  let A be Subset of T, n be Nat;
  func Fint(A,n) -> Subset of T equals

  (Fint A).n;
end;

theorem 
  for n being Element of NAT holds Fcl(A,n+1) = (Fcl(A,n))^b;

theorem 
  Fcl(A,0) = A;

theorem 
  Fcl(A,1) = A^b;

theorem 
  Fcl(A,2) = A^b^b;

theorem 
  for n being Element of NAT holds Fcl(A \/ B,n) = Fcl(A,n) \/ Fcl (B,n);

theorem 
  for n being Element of NAT holds Fint(A,n+1) = (Fint(A,n))^i;

theorem 
  Fint(A,0) = A;

theorem 
  Fint(A,1) = A^i;

theorem 
  Fint(A,2) = A^i^i;

theorem 
  for n being Element of NAT holds Fint(A /\ B,n) = Fint(A,n) /\ Fint(B,n);

theorem 
  T is filled implies for n being Element of NAT holds A c= Fcl(A,n);

theorem 
  T is filled implies for n being Element of NAT holds Fint(A,n) c= A;

theorem 
  T is filled implies for n being Element of NAT holds Fcl(A,n) c= Fcl(A ,n+1);

theorem 
  T is filled implies for n being Element of NAT holds Fint(A,n+1) c= Fint(A,n)
;

theorem 
  for n being Element of NAT holds Fint(A`,n)` = Fcl(A,n);

theorem 
  for n being Element of NAT holds Fcl(A`,n)` = Fint(A,n);

theorem 
  for n being Element of NAT holds Fcl(A,n) \/ Fcl(B,n) = Fint((A \/ B)` ,n)`;

theorem 
  for n being Element of NAT holds Fint(A,n) /\ Fint(B,n) = Fcl((A /\ B) `,n)`;



definition
  let T be non empty RelStr;
  let A be Subset of T;
  func Finf(A) -> Function of NAT,bool(the carrier of T) means


  (for n
being Element of NAT,B being Subset of T st B=it.n holds it.(n+1)=B^f) & it.0=A
  ;
end;

definition
  let T be non empty RelStr;
  let A be Subset of T, n be Nat;
  func Finf(A,n) -> Subset of T equals

  (Finf A).n;
end;



definition
  let T be non empty RelStr;
  let A be Subset of T;
  func Fdfl(A) -> Function of NAT,bool(the carrier of T) means


  (for n
being Element of NAT,B being Subset of T st B=it.n holds it.(n+1)=B^d) & it.0=A
  ;
end;

definition
  let T be non empty RelStr;
  let A be Subset of T, n be Nat;
  func Fdfl(A,n) -> Subset of T equals

  (Fdfl A).n;
end;

theorem 
  for n being Element of NAT holds Finf(A,n+1) = (Finf(A,n))^f;

theorem 
  Finf(A,0) = A;

theorem 
  Finf(A,1) = A^f;

theorem 
  Finf(A,2) = A^f^f;

theorem 
  for n being Element of NAT holds Finf(A \/ B,n) = Finf(A,n) \/ Finf(B, n);

theorem 
  T is filled implies for n being Element of NAT holds A c= Finf(A,n);

theorem 
  T is filled implies for n being Element of NAT holds Finf(A,n) c= Finf
  (A,n+1);

theorem 
  for n being Element of NAT holds Fdfl(A,n+1) = (Fdfl(A,n))^d;

theorem 
  Fdfl(A,0) = A;

theorem 
  Fdfl(A,1) = A^d;

theorem 
  Fdfl(A,2) = A^d^d;

theorem 
  for n being Element of NAT holds Fdfl(A /\ B,n) = Fdfl(A,n) /\ Fdfl(B,n);

theorem 
  T is filled implies for n being Element of NAT holds Fdfl(A,n) c= A;

theorem 
  T is filled implies for n being Element of NAT holds Fdfl(A,n+1) c= Fdfl(A,n)
;

theorem 
  for n being Element of NAT holds Fdfl(A,n) = Finf(A`,n)`;

theorem 
  for n being Element of NAT holds Fdfl(A,n) /\ Fdfl(B,n) = Finf((A /\ B )`,n)`
;

definition 
  let T be non empty RelStr, n be Nat, x be Element of T;
  func U_FT(x,n) -> Subset of T equals

  Finf((U_FT x),n);
end;

theorem 
  U_FT(x,0) = U_FT x;

theorem 
  for n being Element of NAT holds U_FT(x,n+1) = (U_FT(x,n))^f;

definition
  let S, T be non empty RelStr;
  pred S, T are_mutually_symmetric means

  the carrier of S = the carrier of T &
for x being Element of S, y being Element of T holds y in U_FT x iff x in U_FT
  y;
  symmetry;
end;














begin

theorem 
  for X be add-associative right_zeroed right_complementable non
empty NORMSTR for seq be sequence of X st ( for n be Element of NAT holds seq.
  n = 0.X) holds for m be Element of NAT holds (Partial_Sums seq).m = 0.X;

definition
  let X be RealNormSpace;
  let seq be sequence of X;
  attr seq is summable means


  Partial_Sums seq is convergent;
end;

registration
  let X be RealNormSpace;
  cluster summable for sequence of X;
end;

definition
  let X be RealNormSpace;
  let seq be sequence of X;
  func Sum seq -> Element of X equals

  lim Partial_Sums seq;
end;

definition
  let X be RealNormSpace;
  let seq be sequence of X;
  attr seq is norm_summable means


  ||.seq.|| is summable;
end;

theorem 
  for X be RealNormSpace for seq be sequence of X for m be Element
  of NAT holds 0 <= ||.seq.||.m;

theorem 
  for X be RealNormSpace for x,y,z be Element of X holds ||.x-y.||
  = ||.(x-z)+(z-y).||;

theorem 
  for X be RealNormSpace for seq be sequence of X holds seq is
  convergent implies for s be Real st 0<s ex n be Element of NAT st for m be
  Element of NAT st n<=m holds ||.seq.m -seq.n.||<s;

theorem 
  for X be RealNormSpace for seq be sequence of X holds seq is
Cauchy_sequence_by_Norm iff for p be Real st p > 0 holds ex n be Element of NAT
  st for m be Element of NAT st n <= m holds ||.seq.m-seq.n.||< p;

theorem 
  for X be RealNormSpace for seq be sequence of X st (for n be
  Element of NAT holds seq.n = 0.X) holds for m be Element of NAT holds (
  Partial_Sums ||.seq.||).m = 0;

theorem 
  for X be RealNormSpace for seq,seq1 be sequence of X holds seq1
  is subsequence of seq & seq is convergent implies seq1 is convergent;

theorem 
  for X be RealNormSpace for seq,seq1 be sequence of X holds seq1
  is subsequence of seq & seq is convergent implies lim seq1=lim seq;



theorem 
  for X be RealNormSpace for seq,seq1 be sequence of X for k be Element
of NAT holds seq is convergent implies (seq ^\k) is convergent & lim (seq ^\k)=
  lim seq;

theorem 
  for X be RealNormSpace for seq,seq1 be sequence of X holds seq
  is convergent & (ex k be Element of NAT st seq=seq1 ^\k) implies seq1 is
  convergent;

theorem 
  for X be RealNormSpace for seq,seq1 be sequence of X holds seq
is convergent & (ex k be Element of NAT st seq=seq1 ^\k) implies lim seq1 =lim
  seq;

theorem 
  for X be RealNormSpace for seq be sequence of X holds seq is
  constant implies seq is convergent;

theorem 
  for X be RealNormSpace for seq be sequence of X st (for n be
  Element of NAT holds seq.n = 0.X) holds seq is norm_summable;

registration
  let X be RealNormSpace;
  cluster norm_summable for sequence of X;
end;



theorem 
  for X be RealNormSpace for s be sequence of X holds s is
  summable implies s is convergent & lim s = 0.X;

theorem 
  for X be RealNormSpace for s1,s2 be sequence of X holds
  Partial_Sums(s1)+Partial_Sums(s2) = Partial_Sums(s1+s2);

theorem 
  for X be RealNormSpace for s1,s2 be sequence of X holds
  Partial_Sums(s1)-Partial_Sums(s2) = Partial_Sums(s1-s2);

registration
  let X be RealNormSpace;
  let seq be norm_summable sequence of X;
  cluster ||.seq.|| -> summable for Real_Sequence;
end;

registration
  let X be RealNormSpace;
  cluster summable -> convergent for sequence of X;
end;

theorem 
  for X be RealNormSpace for seq1,seq2 be sequence of X st seq1 is
summable & seq2 is summable holds seq1+seq2 is summable & Sum(seq1+seq2) = Sum(
  seq1)+Sum(seq2);

theorem 
  for X be RealNormSpace for seq1,seq2 be sequence of X st seq1 is
summable & seq2 is summable holds seq1-seq2 is summable & Sum(seq1-seq2)= Sum(
  seq1)-Sum(seq2);

registration
  let X be RealNormSpace;
  let seq1, seq2 be summable sequence of X;
  cluster seq1 + seq2 -> summable;
  cluster seq1 - seq2 -> summable;
end;

theorem 
  for X be RealNormSpace for seq be sequence of X for z be Real
  holds Partial_Sums(z * seq) = z * Partial_Sums(seq);

theorem 
  for X be RealNormSpace for seq be summable sequence of X for z
  be Real holds z *seq is summable & Sum(z *seq)= z * Sum(seq);

registration
  let X be RealNormSpace;
  let z be Real, seq be summable sequence of X;
  cluster z *seq -> summable;
end;

theorem 
  for X be RealNormSpace for s,s1 be sequence of X st for n be
Element of NAT holds s1.n=s.0 holds Partial_Sums(s^\1) = (Partial_Sums(s)^\1) -
  s1;

theorem 
  for X be RealNormSpace for s be sequence of X holds s is
  summable implies for n be Element of NAT holds s^\n is summable;

registration
  let X be RealNormSpace;
  let seq be summable sequence of X, n be Element of NAT;
  cluster seq^\n -> summable for sequence of X;
end;

theorem 
  for X be RealNormSpace for seq be sequence of X holds
  Partial_Sums ||.seq.|| is bounded_above iff seq is norm_summable;

registration
  let X be RealNormSpace;
  let seq be norm_summable sequence of X;
  cluster Partial_Sums ||.seq.|| -> bounded_above for Real_Sequence;
end;

theorem 
  for X be RealBanachSpace for seq be sequence of X holds seq is
  summable iff for p be Real st 0 <p holds ex n be Element of NAT st for m be
Element of NAT st n <= m holds ||.Partial_Sums(seq).m-Partial_Sums(seq).n.||<p;

theorem 
  for X be RealNormSpace for s be sequence of X for n,m be Element
  of NAT st n<=m holds ||.Partial_Sums(s).m - Partial_Sums(s).n.|| <= abs(
  Partial_Sums(||.s.||).m - Partial_Sums(||.s.||).n);

theorem 
  for X be RealBanachSpace for seq be sequence of X holds seq is
  norm_summable implies seq is summable;

theorem 
  for X be RealNormSpace for rseq1 be Real_Sequence for seq2 be sequence
  of X holds rseq1 is summable & (ex m be Element of NAT st for n be Element of
  NAT st m<=n holds ||.seq2.n.|| <= rseq1.n ) implies seq2 is norm_summable;

theorem 
  for X be RealNormSpace for seq1,seq2 be sequence of X holds (for n be
  Element of NAT holds 0 <= ||.seq1.||.n & ||.seq1.||.n <= ||.seq2.||.n) & seq2
is norm_summable implies seq1 is norm_summable & Sum ||.seq1.|| <= Sum ||.seq2
  .||;

theorem 
  for X be RealNormSpace for seq be sequence of X holds (for n be
  Element of NAT holds ||.seq.||.n>0) & (ex m be Element of NAT st for n be
Element of NAT st n >=m holds ||.seq.||.(n+1)/||.seq.||.n >= 1) implies not seq
  is norm_summable;

theorem 
  for X be RealNormSpace for seq be sequence of X for rseq1 be
Real_Sequence holds (for n be Element of NAT holds rseq1.n = n-root (||.seq.||.
  n)) & rseq1 is convergent & lim rseq1 < 1 implies seq is norm_summable;

theorem 
  for X be RealNormSpace for seq be sequence of X for rseq1 be
Real_Sequence holds (for n be Element of NAT holds rseq1.n = n-root (||.seq.||.
n)) & (ex m be Element of NAT st for n be Element of NAT st m<=n holds rseq1.n
  >= 1) implies ||.seq.|| is not summable;

theorem 
  for X be RealNormSpace for seq be sequence of X for rseq1 be
Real_Sequence holds (for n be Element of NAT holds rseq1.n = n-root (||.seq.||.
  n)) & rseq1 is convergent & lim rseq1 > 1 implies seq is not norm_summable;

theorem 
  for X be RealNormSpace for seq be sequence of X for rseq1 be
  Real_Sequence st ||.seq.|| is non-increasing & (for n be Element of NAT holds
rseq1.n = 2 to_power n *||.seq.||.(2 to_power n)) holds ( seq is norm_summable
  iff rseq1 is summable);

theorem 
  for X be RealNormSpace for seq be sequence of X for p be Real st p>1 &
(for n be Element of NAT st n >=1 holds ||.seq.||.n = 1/ (n to_power p) ) holds
  seq is norm_summable;

theorem 
  for X be RealNormSpace for seq be sequence of X for p be Real holds p
  <=1 & (for n be Element of NAT st n >=1 holds ||.seq.||.n=1/n to_power p)
  implies not seq is norm_summable;

theorem 
  for X be RealNormSpace for seq be sequence of X for rseq1 be
Real_Sequence holds (for n be Element of NAT holds seq.n<>0.X & rseq1.n=||.seq
  .||.(n+1)/||.seq.||.n) & rseq1 is convergent & lim rseq1 < 1 implies seq is
  norm_summable;

theorem 
  for X be RealNormSpace for seq be sequence of X holds (for n be
Element of NAT holds seq.n<>0.X) & (ex m be Element of NAT st for n be Element
  of NAT st n >=m holds ||.seq.||.(n+1)/||.seq.||.n >= 1) implies seq is not
  norm_summable;

registration
  let X be RealBanachSpace;
  cluster norm_summable -> summable for sequence of X;
end;

begin 

theorem 
  for X be Banach_Algebra holds for x,y,z being Element of X for a
  ,b be Real holds x+y = y+x & (x+y)+z = x+(y+z) & x+(0.X) = x & (ex t being
Element of X st x+t= 0.X) & (x*y)*z = x*(y*z) & 1*x=x & 0*x=0.X & a*0.X =0.X& (
-1)*x=-x & x*(1.X) = x & (1.X)*x = x & x*(y+z) = x*y + x*z & (y+z)*x = y*x + z*
x & a*(x*y) = (a*x)*y & a*(x+y) = a*x + a*y & (a+b)*x = a*x + b*x & (a*b)*x = a
*(b*x) & (a*b)*(x*y)=(a*x)*(b*y) & a*(x*y)=x*(a*y) & 0.X * x = 0.X & x*0.X =0.X
& x*(y-z) = x*y-x*z & (y-z)*x = y*x-z*x & x+y-z = x+(y-z) & x-y+z = x-(y-z) & x
-y-z = x-(y+z) & x+y=(x-z)+(z+y) & x-y=(x-z)+(z-y) & x=(x-y)+y & x=y-(y-x) & (
||.x.|| = 0 iff x = 0.X ) & ||.a * x.|| = abs(a) * ||.x.|| & ||.x + y.|| <= ||.
  x.|| + ||.y.|| & ||. x*y .|| <= ||.x.|| * ||.y.|| & ||. 1.X .|| = 1 & X is
  complete;

registration
  cluster -> well-unital for Banach_Algebra;
end;

definition
  let X be well-unital associative non empty multLoopStr;
  let v be Element of X;

  redefine attr v is invertible means


  ex w be Element of X st v*w = 1.X & w*v=1.X;
end;

definition
  let X be non empty Normed_AlgebraStr;
  let S be sequence of X;
  let a be Element of X;
  func a * S -> sequence of X means

  for n be Element of NAT holds it.n = a * S .n;
end;

definition
  let X be non empty Normed_AlgebraStr;
  let S be sequence of X;
  let a be Element of X;
  func S*a -> sequence of X means

  for n be Element of NAT holds it.n = S.n*a;
end;

definition
  let X be non empty Normed_AlgebraStr;
  let seq1,seq2 be sequence of X;
  func seq1 * seq2 -> sequence of X means

  for n be Element of NAT holds it.n = seq1.n * seq2.n;
end;

notation
  let X be associative well-unital non empty multLoopStr;
  let x be Element of X;
  synonym x" for /x;
end;

definition
  let X be associative well-unital non empty multLoopStr;
  let x be Element of X such that
 x is invertible;
  redefine func x" means


  x*it= 1.X & it*x= 1.X;
end;

definition
  let X be Banach_Algebra;
  let z be Element of X;
  func z GeoSeq -> sequence of X means


  it.0 = 1.X & for n be Element of NAT holds it.(n+1) = it.n * z;
end;

definition
  let X be Banach_Algebra;
  let z be Element of X, n be Element of NAT;
  func z #N n -> Element of X equals

  z GeoSeq.n;
end;

theorem 
  for X be Banach_Algebra for z be Element of X holds z #N 0 = 1.X;

theorem 
  for X be Banach_Algebra for z be Element of X holds ||.z.|| < 1
  implies z GeoSeq is summable norm_summable;

theorem 
  for X be Banach_Algebra for x be Point of X st ||.1.X - x .|| < 1
holds (1.X - x) GeoSeq is summable & (1.X - x) GeoSeq is norm_summable;

theorem 
  for X be Banach_Algebra for x be Point of X st ||.1.X - x .|| < 1
  holds x is invertible & x" = Sum ((1.X - x) GeoSeq );














begin 

reserve A,B,a,b,c,d,e,f,g,h for set;

theorem 
  (id A)|B = id A /\ [:B,B:];

theorem 
  id {a,b,c,d} = {[a,a],[b,b],[c,c],[d,d]};

theorem 
  [:{a,b,c,d},{e,f,g,h}:] = {[a,e],[a,f],[b,e],[b,f],[a,g],[a,h],[b
  ,g],[b,h]} \/ {[c,e],[c,f],[d,e],[d,f],[c,g],[c,h],[d,g],[d,h]};

registration
  let X,Y be trivial set;
  cluster -> trivial for Relation of X,Y;
end;

theorem 
  for X be trivial set, R be Relation of X st R is non empty holds
  ex x be set st R = {[x,x]};

registration
  let X be trivial set;
  cluster -> trivial reflexive symmetric transitive strongly_connected
    for Relation of X;
end;

theorem 
  for X be 1-element set, R be Relation of X holds R is_symmetric_in X;

registration
  cluster non empty strict finite irreflexive symmetric for RelStr;
end;

registration
  let L be irreflexive RelStr;
  cluster -> irreflexive for full SubRelStr of L;
end;

registration
  let L be symmetric RelStr;
  cluster -> symmetric for full SubRelStr of L;
end;

theorem 
  for R be irreflexive symmetric RelStr st card (the carrier of R)
= 2 holds ex a,b be set st the carrier of R = {a,b} & (the InternalRel of R = {
  [a,b],[b,a]} or the InternalRel of R = {});

begin 

registration
  let R be non empty RelStr,S be RelStr;
  cluster union_of(R,S) -> non empty;
  cluster sum_of(R,S) -> non empty;
end;

registration
  let R be RelStr, S be non empty RelStr;
  cluster union_of(R,S) -> non empty;
  cluster sum_of(R,S) -> non empty;
end;

registration
  let R,S be finite RelStr;
  cluster union_of(R,S) -> finite;
  cluster sum_of(R,S) -> finite;
end;

registration
  let R,S be symmetric RelStr;
  cluster union_of(R,S) -> symmetric;
  cluster sum_of(R,S) -> symmetric;
end;

registration
  let R,S be irreflexive RelStr;
  cluster union_of(R,S) -> irreflexive;
end;

theorem 
  for R,S be irreflexive RelStr st the carrier of R misses the carrier
  of S holds sum_of(R,S) is irreflexive;

theorem 
  for R1,R2 being RelStr holds union_of(R1,R2) = union_of(R2,R1) &
  sum_of(R1,R2) = sum_of(R2,R1);

theorem 
  for G being irreflexive RelStr, G1,G2 being RelStr st ( G =
  union_of(G1,G2) or G = sum_of(G1,G2) ) holds G1 is irreflexive & G2 is
  irreflexive;

theorem 
  for G being non empty RelStr, H1,H2 being RelStr st the carrier
  of H1 misses the carrier of H2 & ( the RelStr of G = union_of(H1,H2) or the
  RelStr of G = sum_of(H1,H2) ) holds H1 is full SubRelStr of G & H2 is full
  SubRelStr of G;

begin 

theorem 
  the InternalRel of ComplRelStr Necklace 4 = {[0,2],[2,0],[0,3],[
  3,0],[1,3],[3,1]};

registration
  let R be RelStr;
  cluster ComplRelStr R -> irreflexive;
end;

registration
  let R be symmetric RelStr;
  cluster ComplRelStr R -> symmetric;
end;

theorem 
  for R be RelStr holds the InternalRel of R misses the
  InternalRel of ComplRelStr R;

theorem 
  for R being RelStr holds id the carrier of R misses the
  InternalRel of ComplRelStr R;

theorem 
  for G being RelStr holds [:the carrier of G,the carrier of G:] =
  id (the carrier of G) \/ (the InternalRel of G) \/ (the InternalRel of
  ComplRelStr G);

theorem 
  for G being strict irreflexive RelStr st G is trivial holds ComplRelStr G = G
;

theorem 
  for G being strict irreflexive RelStr holds ComplRelStr ( ComplRelStr G) = G;

theorem 
  for G1,G2 being RelStr st the carrier of G1 misses the carrier
of G2 holds ComplRelStr union_of(G1,G2) = sum_of(ComplRelStr G1, ComplRelStr G2
  );

theorem 
  for G1,G2 being RelStr st the carrier of G1 misses the carrier
of G2 holds ComplRelStr sum_of(G1,G2) = union_of(ComplRelStr G1, ComplRelStr G2
  );

theorem 
  for G being RelStr, H being full SubRelStr of G holds the InternalRel
  of ComplRelStr H = (the InternalRel of ComplRelStr G)|_2 the carrier of
  ComplRelStr H;

theorem 
  for G being non empty irreflexive RelStr, x being Element of G,
x9 being Element of ComplRelStr G st x = x9 holds ComplRelStr (subrelstr ([#]G
  \ {x})) = subrelstr ([#](ComplRelStr G) \ {x9});

begin 

registration
  cluster trivial strict -> N-free for non empty RelStr;
end;

theorem 
  for R being reflexive antisymmetric RelStr, S being RelStr holds (ex f
  being Function of R,S st for x,y being Element of R holds [x,y] in the
  InternalRel of R iff [f.x,f.y] in the InternalRel of S) iff S embeds R;

theorem 
  for G being non empty RelStr, H being non empty full SubRelStr
  of G holds G embeds H;

theorem 
  for G being non empty RelStr, H being non empty full SubRelStr
  of G st G is N-free holds H is N-free;

theorem 
  for G being non empty irreflexive RelStr holds G embeds Necklace
  4 iff ComplRelStr G embeds Necklace 4;

theorem 
  for G being non empty irreflexive RelStr holds G is N-free iff
  ComplRelStr G is N-free;

begin 

definition
  let R be RelStr;
  mode path of R is RedSequence of the InternalRel of R;
end;

definition
  let R be RelStr;
  attr R is path-connected means


  for x,y being set st x in the carrier
of R & y in the carrier of R & x <> y holds the InternalRel of R reduces x,y or
  the InternalRel of R reduces y,x;
end;

registration
  cluster empty -> path-connected for RelStr;
end;

registration
  cluster connected -> path-connected for non empty RelStr;
end;

theorem 
  for R being non empty transitive reflexive RelStr, x,y being
  Element of R holds the InternalRel of R reduces x,y implies [x,y] in the
  InternalRel of R;

registration
  cluster path-connected -> connected for
non empty transitive reflexive RelStr;
end;

theorem 
  for R be symmetric RelStr,x,y being set holds the InternalRel of
  R reduces x,y implies the InternalRel of R reduces y,x;

definition
  let R be symmetric RelStr;
  redefine attr R is path-connected means


  for x,y being set st x in the
  carrier of R & y in the carrier of R & x <> y holds (the InternalRel of R)
  reduces x,y;
end;

definition
  let R be RelStr;
  let x be Element of R;
  func component x -> Subset of R equals

  Class(EqCl the InternalRel of R, x);
end;

registration
  let R be non empty RelStr;
  let x be Element of R;
  cluster component x -> non empty;
end;

theorem 
  for R being RelStr, x being Element of R, y be set st y in
  component x holds [x,y] in EqCl the InternalRel of R;

theorem 
  for R being RelStr, x being Element of R, A being set holds A =
component x iff for y being set holds y in A iff [x,y] in EqCl the InternalRel
  of R;

theorem 
  for R be non empty irreflexive symmetric RelStr holds R is not
  path-connected implies ex G1,G2 being non empty strict irreflexive symmetric
  RelStr st the carrier of G1 misses the carrier of G2 & the RelStr of R =
  union_of(G1,G2);

theorem 
  for R be non empty irreflexive symmetric RelStr holds
  ComplRelStr R is not path-connected implies ex G1,G2 being non empty strict
  irreflexive symmetric RelStr st the carrier of G1 misses the carrier of G2 &
  the RelStr of R = sum_of(G1,G2);

theorem 
  for G being irreflexive RelStr st G in fin_RelStr_sp holds ComplRelStr
  G in fin_RelStr_sp;

theorem 
  for R be irreflexive symmetric RelStr st card (the carrier of R)
  = 2 & the carrier of R in FinSETS holds the RelStr of R in fin_RelStr_sp;

theorem 
  for R be RelStr st R in fin_RelStr_sp holds R is symmetric;

theorem 
  for G being RelStr, H1,H2 being non empty RelStr, x being
Element of H1, y being Element of H2 st G = union_of(H1,H2) & the carrier of H1
  misses the carrier of H2 holds not [x,y] in the InternalRel of G;

theorem 
  for G being RelStr, H1,H2 being non empty RelStr, x being Element of
  H1, y being Element of H2 st G = sum_of(H1,H2) holds not [x,y] in the
  InternalRel of ComplRelStr G;

theorem 
  for G being non empty symmetric RelStr, x being Element of G, R1
  ,R2 being non empty RelStr st the carrier of R1 misses the carrier of R2 &
subrelstr ([#]G \ {x}) = union_of(R1,R2) & G is path-connected holds ex b being
  Element of R1 st [b,x] in the InternalRel of G;

theorem 
  for G being non empty symmetric irreflexive RelStr, a,b,c,d
  being Element of G, Z being Subset of G st Z = {a,b,c,d} & a,b,c,d
  are_mutually_different & [a,b] in the InternalRel of G & [b,c] in the
InternalRel of G & [c,d] in the InternalRel of G & not [a,c] in the InternalRel
  of G & not [a,d] in the InternalRel of G & not [b,d] in the InternalRel of G
  holds subrelstr Z embeds Necklace 4;

theorem 
  for G being non empty irreflexive symmetric RelStr, x being
  Element of G, R1,R2 being non empty RelStr st the carrier of R1 misses the
carrier of R2 & subrelstr ([#]G \ {x}) = union_of(R1,R2) & G is non trivial & G
  is path-connected & ComplRelStr G is path-connected holds G embeds Necklace 4
;

theorem 
  for G being non empty strict finite irreflexive symmetric RelStr st G
is N-free & the carrier of G in FinSETS holds the RelStr of G in fin_RelStr_sp;














begin 

reserve X for ComplexUnitarySpace;
reserve x, y, w, g, g1, g2 for Point of X;
reserve z for Complex;
reserve p, q, r, M, M1, M2 for Real;
reserve seq, seq1, seq2, seq3 for sequence of X;
reserve k,n,m for Element of NAT;
reserve Nseq for increasing sequence of NAT;

definition
  let X, seq;
  attr seq is convergent means


  ex g st for r st r > 0 ex m st for n st n >= m holds dist(seq.n, g) < r;
end;

theorem 
  seq is constant implies seq is convergent;

theorem 
  seq1 is convergent & (ex k st for n st k <= n holds seq2.n = seq1
  .n) implies seq2 is convergent;

theorem 
  seq1 is convergent & seq2 is convergent implies seq1 + seq2 is convergent;

theorem 
  seq1 is convergent & seq2 is convergent implies seq1 - seq2 is convergent;

theorem 
  seq is convergent implies z * seq is convergent;

theorem 
  seq is convergent implies - seq is convergent;

theorem 
  seq is convergent implies seq + x is convergent;

theorem 
  seq is convergent implies seq - x is convergent;

theorem 
  seq is convergent iff ex g st for r st r > 0 ex m st for n st n
  >= m holds ||.(seq.n) - g.|| < r;

definition
  let X, seq;
  assume
 seq is convergent;
  func lim seq -> Point of X means


  for r st r > 0 ex m st for n st n >= m holds dist((seq.n) , it) < r;
end;

theorem 
  seq is constant & x in rng seq implies lim seq = x;

theorem 
  seq is constant & (ex n st seq.n = x) implies lim seq = x;

theorem 
  seq1 is convergent & (ex k st for n st n >= k holds seq2.n = seq1.n)
  implies lim seq1 = lim seq2;

theorem 
  seq1 is convergent & seq2 is convergent implies lim (seq1 + seq2
  ) = (lim seq1) + (lim seq2);

theorem 
  seq1 is convergent & seq2 is convergent implies lim (seq1 - seq2
  ) = (lim seq1) - (lim seq2);

theorem 
  seq is convergent implies lim (z * seq) = z * (lim seq);

theorem 
  seq is convergent implies lim (- seq) = - (lim seq);

theorem 
  seq is convergent implies lim (seq + x) = (lim seq) + x;

theorem 
  seq is convergent implies lim (seq - x) = (lim seq) - x;

theorem 
  seq is convergent implies (lim seq = g iff for r st r > 0 ex m
  st for n st n >= m holds ||.(seq.n) - g.|| < r);

definition
  let X, seq;
  func ||.seq.|| -> Real_Sequence means


  for n holds it.n =||.(seq.n).||;
end;

theorem 
  seq is convergent implies ||.seq.|| is convergent;

theorem 
  seq is convergent & lim seq = g implies ||.seq.|| is convergent
  & lim ||.seq.|| = ||.g.||;

theorem 
  seq is convergent & lim seq = g implies ||.seq - g.|| is
  convergent & lim ||.seq - g.|| = 0;

definition
  let X, seq, x;
  func dist(seq, x) -> Real_Sequence means


  for n holds it.n =dist((seq. n) , x);
end;

theorem 
  seq is convergent & lim seq = g implies dist(seq,g) is convergent;

theorem 
  seq is convergent & lim seq = g implies dist(seq,g) is
  convergent & lim dist(seq,g) = 0;

theorem 
  seq1 is convergent & lim seq1 = g1 & seq2 is convergent & lim seq2 =
g2 implies ||.seq1 + seq2.|| is convergent & lim ||.seq1 + seq2.|| = ||.g1 + g2
  .||;

theorem 
  seq1 is convergent & lim seq1 = g1 & seq2 is convergent & lim seq2 =
g2 implies ||.(seq1 + seq2) - (g1 + g2).|| is convergent & lim ||.(seq1 + seq2)
  - (g1 + g2).|| = 0;

theorem 
  seq1 is convergent & lim seq1 = g1 & seq2 is convergent & lim seq2 =
g2 implies ||.seq1 - seq2.|| is convergent & lim ||.seq1 - seq2.|| = ||.g1 - g2
  .||;

theorem 
  seq1 is convergent & lim seq1 = g1 & seq2 is convergent & lim seq2 =
g2 implies ||.(seq1 - seq2) - (g1 - g2).|| is convergent & lim ||.(seq1 - seq2)
  - (g1 - g2).|| = 0;

theorem 
  seq is convergent & lim seq = g implies ||.z * seq.|| is convergent &
  lim ||.z * seq.|| = ||.z * g.||;

theorem 
  seq is convergent & lim seq = g implies ||.(z * seq) - (z * g).|| is
  convergent & lim ||.(z * seq) - (z * g).|| = 0;

theorem 
  seq is convergent & lim seq = g implies ||.- seq.|| is convergent &
  lim ||.- seq.|| = ||.- g.||;

theorem 
  seq is convergent & lim seq = g implies ||.(- seq) - (- g).|| is
  convergent & lim ||.(- seq) - (- g).|| = 0;

theorem 
  seq is convergent & lim seq = g implies ||.(seq + x) - (g + x)
  .|| is convergent & lim ||.(seq + x) - (g + x).|| = 0;

theorem 
  seq is convergent & lim seq = g implies ||.seq - x.|| is convergent &
  lim ||.seq - x.|| = ||.g - x.||;

theorem 
  seq is convergent & lim seq = g implies ||.(seq - x) - (g - x).|| is
  convergent & lim ||.(seq - x) - (g - x).|| = 0;

theorem 
  seq1 is convergent & lim seq1 = g1 & seq2 is convergent & lim seq2 =
  g2 implies dist((seq1 + seq2) , (g1 + g2)) is convergent & lim dist((seq1 +
  seq2) , (g1 + g2)) = 0;

theorem 
  seq1 is convergent & lim seq1 = g1 & seq2 is convergent & lim seq2 =
  g2 implies dist((seq1 - seq2) , (g1 - g2)) is convergent & lim dist((seq1 -
  seq2) , (g1 - g2)) = 0;

theorem 
  seq is convergent & lim seq = g implies dist((z * seq) , (z * g)) is
  convergent & lim dist((z * seq) , (z * g)) = 0;

theorem 
  seq is convergent & lim seq = g implies dist((seq + x) , (g + x)) is
  convergent & lim dist((seq + x) , (g + x)) = 0;

definition
  let X, x, r;
  func Ball(x,r) -> Subset of X equals

  {y where y is Point of X : ||.x - y.||
  < r};
  func cl_Ball(x,r) -> Subset of X equals

  {y where y is Point of X : ||.x - y
  .|| <= r};
  func Sphere(x,r) -> Subset of X equals

  {y where y is Point of X : ||.x - y
  .|| = r};
end;

theorem 
  w in Ball(x,r) iff ||.x - w.|| < r;

theorem 
  w in Ball(x,r) iff dist(x,w) < r;

theorem 
  r > 0 implies x in Ball(x,r);

theorem 
  y in Ball(x,r) & w in Ball(x,r) implies dist(y,w) < 2 * r;

theorem 
  y in Ball(x,r) implies y - w in Ball(x - w,r);

theorem 
  y in Ball(x,r) implies (y - x) in Ball (0.(X),r);

theorem 
  y in Ball(x,r) & r <= q implies y in Ball(x,q);

theorem 
  w in cl_Ball(x,r) iff ||.x - w.|| <= r;

theorem 
  w in cl_Ball(x,r) iff dist(x,w) <= r;

theorem 
  r >= 0 implies x in cl_Ball(x,r);

theorem 
  y in Ball(x,r) implies y in cl_Ball(x,r);

theorem 
  w in Sphere(x,r) iff ||.x - w.|| = r;

theorem 
  w in Sphere(x,r) iff dist(x,w) = r;

theorem 
  y in Sphere(x,r) implies y in cl_Ball(x,r);

theorem 
  Ball(x,r) c= cl_Ball(x,r);

theorem 
  Sphere(x,r) c= cl_Ball(x,r);

theorem 
  Ball(x,r) \/ Sphere(x,r) = cl_Ball(x,r);

begin

definition
  let X;
  let seq;
  attr seq is Cauchy means


  for r st r > 0 ex k st for n, m st n >= k &
  m >= k holds dist((seq.n), (seq.m)) < r;
end;

theorem 
  seq is constant implies seq is Cauchy;

theorem 
  seq is Cauchy iff for r st r > 0 ex k st for n, m st n >= k & m >= k
  holds ||.(seq.n) - (seq.m).|| < r;

theorem 
  seq1 is Cauchy & seq2 is Cauchy implies seq1 + seq2 is Cauchy;

theorem 
  seq1 is Cauchy & seq2 is Cauchy implies seq1 - seq2 is Cauchy;

theorem 
  seq is Cauchy implies z * seq is Cauchy;

theorem 
  seq is Cauchy implies - seq is Cauchy;

theorem 
  seq is Cauchy implies seq + x is Cauchy;

theorem 
  seq is Cauchy implies seq - x is Cauchy;

theorem 
  seq is convergent implies seq is Cauchy;

definition
  let X;
  let seq1, seq2;
  pred seq1 is_compared_to seq2 means


  for r st r > 0 ex m st for n st n >= m holds dist(seq1.n, seq2.n) < r;
end;

theorem 
  seq is_compared_to seq;

theorem 
  seq1 is_compared_to seq2 implies seq2 is_compared_to seq1;

definition
  let X;
  let seq1, seq2;
  redefine pred seq1 is_compared_to seq2;
  reflexivity;
  symmetry;
end;

theorem 
  seq1 is_compared_to seq2 & seq2 is_compared_to seq3 implies seq1
  is_compared_to seq3;

theorem 
  seq1 is_compared_to seq2 iff for r st r > 0 ex m st for n st n >= m
  holds ||.(seq1.n) - (seq2.n).|| < r;

theorem 
  ( ex k st for n st n >= k holds seq1.n = seq2.n ) implies seq1
  is_compared_to seq2;

theorem 
  seq1 is Cauchy & seq1 is_compared_to seq2 implies seq2 is Cauchy;

theorem 
  seq1 is convergent & seq1 is_compared_to seq2 implies seq2 is convergent;

theorem 
  seq1 is convergent & lim seq1 = g & seq1 is_compared_to seq2 implies
  seq2 is convergent & lim seq2 = g;

definition
  let X;
  let seq;
  attr seq is bounded means


  ex M st M > 0 & for n holds ||.seq.n.|| <= M;
end;

theorem 
  seq1 is bounded & seq2 is bounded implies seq1 + seq2 is bounded;

theorem 
  seq is bounded implies -seq is bounded;

theorem 
  seq1 is bounded & seq2 is bounded implies seq1 - seq2 is bounded;

theorem 
  seq is bounded implies z * seq is bounded;

theorem 
  seq is constant implies seq is bounded;

theorem 
  for m ex M st ( M > 0 & for n st n <= m holds ||.seq.n.|| < M );

theorem 
  seq is convergent implies seq is bounded;

theorem 
  seq1 is bounded & seq1 is_compared_to seq2 implies seq2 is bounded;

theorem 
  seq is bounded & seq1 is subsequence of seq implies seq1 is bounded;

theorem 
  seq is convergent & seq1 is subsequence of seq implies seq1 is convergent;

theorem 
  seq1 is subsequence of seq & seq is convergent implies lim seq1= lim seq;

theorem 
  seq is Cauchy & seq1 is subsequence of seq implies seq1 is Cauchy;

theorem 
  (seq1 + seq2) ^\k = (seq1 ^\k) + (seq2 ^\k);

theorem 
  (-seq) ^\k = -(seq ^\k);

theorem 
  (seq1 - seq2) ^\k = (seq1 ^\k) - (seq2 ^\k);

theorem 
  (z * seq) ^\k = z * (seq ^\k);

theorem 
  seq is convergent implies (seq ^\k) is convergent & lim (seq ^\k)=lim
  seq;

theorem 
  seq is convergent & (ex k st seq = seq1 ^\k) implies seq1 is convergent;

theorem 
  seq is Cauchy & (ex k st seq = seq1 ^\k) implies seq1 is Cauchy;

theorem 
  seq is Cauchy implies (seq ^\k) is Cauchy;

theorem 
  seq1 is_compared_to seq2 implies (seq1 ^\k) is_compared_to (seq2 ^\k);

theorem 
  seq is bounded implies (seq ^\k) is bounded;

theorem 
  seq is constant implies (seq ^\k) is constant;

definition

  let X;
  attr X is complete means


  for seq holds seq is Cauchy implies seq is convergent;
end;

theorem 
  X is complete & seq is Cauchy implies seq is bounded;














begin 

reserve X for Banach_Algebra,
  w,z,z1,z2 for Element of X,
  k,l,m,n,n1,n2 for Element of NAT,
  seq,seq1,seq2,s,s9 for sequence of X,
  rseq for Real_Sequence;

definition
  let X be non empty multMagma;
  let x,y be Element of X;
  pred x,y are_commutative means


  x * y = y * x;
  reflexivity;
  symmetry;
end;

theorem 
  seq1 is convergent & seq2 is convergent & lim(seq1-seq2)=0.X
  implies lim seq1 = lim seq2;

theorem 
  for z st for n being Element of NAT holds s.n = z holds lim s = z;

theorem 
  s is convergent & s9 is convergent implies s * s9 is convergent;

theorem 
  s is convergent implies z * s is convergent;

theorem 
  s is convergent implies s*z is convergent;

theorem 
  s is convergent implies lim (z * s) =z* lim(s);

theorem 
  s is convergent implies lim (s*z) = lim(s)*z;

theorem 
  s is convergent & s9 is convergent implies lim(s*s9)=(lim s)*(lim s9);

theorem 
  Partial_Sums(z * seq) = z * Partial_Sums(seq) & Partial_Sums(seq
  *z ) = Partial_Sums(seq) *z;

theorem 
  ||.Partial_Sums(seq).k.|| <= Partial_Sums(||.seq.||).k;

theorem 
  (for n st n <= m holds seq1.n = seq2.n) implies Partial_Sums(
  seq1).m =Partial_Sums(seq2).m;

theorem 
  (for n holds ||. seq.n .|| <= rseq.n) & rseq is convergent & lim
  (rseq)=0 implies seq is convergent & lim(seq)=0.X;

definition
  let X;
  let z be Element of X;
  func z rExpSeq -> sequence of X means


  for n holds it.n = 1/(n! )*(z #N n);
end;

scheme 

  ExNormSpaceCASE {RNS()->non empty Banach_Algebra, F(Element of NAT,Element
  of NAT)-> Point of RNS() }: for k holds ex seq be sequence of RNS() st for n
  holds (n <= k implies seq.n=F(k,n)) & (n > k implies seq.n=0.RNS());

theorem 
  (for k st 0 < k holds ((k-'1)! ) * k = k!) & for m,k st k <= m
  holds ((m-'k)! ) * (m+1-k) = (m+1-'k)!;

definition
  let n be Element of NAT;
  func Coef(n) -> Real_Sequence means


  for k be Element of NAT holds (k
  <= n implies it.k = n! /( (k! ) * (( n -' k)!) ) ) &(k > n implies it.k=0);
end;

definition
  let n be Element of NAT;
  func Coef_e(n) -> Real_Sequence means


  for k be Element of NAT holds (
  k <= n implies it.k = 1/((k! ) * ((n -' k)! ))) & (k > n implies it.k=0);
end;

definition
  let X be non empty ZeroStr, seq be sequence of X;
  func Shift seq -> sequence of X means


  it.0 = 0.X & for k be Element of NAT holds it.(k+1) = seq.k;
end;

definition
  let n;
  let X;
  let z,w be Element of X;
  func Expan(n,z,w) -> sequence of X means


  for k be Element of NAT
holds ( k <= n implies it.k=((Coef(n)).k) * (z #N k) * (w #N (n-' k)) ) & (n <
  k implies it.k=0.X);
end;

definition
  let n;
  let X;
  let z,w be Element of X;
  func Expan_e(n,z,w) -> sequence of X means


  for k be Element of NAT
holds ( k <= n implies it.k=((Coef_e(n)).k) * (z #N k) * (w #N (n-' k)) ) & (n
  < k implies it.k=0.X );
end;

definition
  let n;
  let X;
  let z,w be Element of X;
  func Alfa(n,z,w) -> sequence of X means


  for k be Element of NAT holds
( k <= n implies it.k= (z rExpSeq).k * Partial_Sums(w rExpSeq).(n-'k) ) & ( n <
  k implies it.k=0.X);
end;

definition
  let X;
  let z, w be Element of X;
  let n be Element of NAT;
  func Conj(n,z,w) -> sequence of X means


  for k be Element of NAT holds
( k <= n implies it.k= (z rExpSeq).k * (Partial_Sums(w rExpSeq).n -Partial_Sums
  (w rExpSeq).(n-'k))) & (n < k implies it.k=0.X);
end;

theorem 
  z rExpSeq.(n+1) = (1/(n+1) * z) * (z rExpSeq.n) & z rExpSeq.0=1.
  X & ||.(z rExpSeq).n.|| <= (||.z.|| rExpSeq ).n;

theorem 
  for X being non empty ZeroStr, seq being sequence of X holds 0 <
  k implies (Shift(seq)).k=seq.(k -' 1);

theorem 
  Partial_Sums(seq).k=Partial_Sums(Shift(seq)).k+seq.k;

theorem 
  for z,w st z,w are_commutative holds (z+w) #N n = Partial_Sums(
  Expan(n,z,w)).n;

theorem 
  Expan_e(n,z,w)=(1/(n!)) * Expan(n,z,w);

theorem 
  for z,w st z,w are_commutative holds 1/ (n! ) *((z+w) #N n) =
  Partial_Sums(Expan_e(n,z,w)).n;

theorem 
  0.X rExpSeq is norm_summable & Sum(0.X rExpSeq)=1.X;

registration
  let X;
  let z be Element of X;
  cluster z rExpSeq -> norm_summable;
end;

theorem 
  (z rExpSeq).0 = 1.X & Expan(0,z,w).0 = 1.X;

theorem 
  l <= k implies (Alfa(k+1,z,w)).l = (Alfa(k,z,w)).l + Expan_e(k+1 ,z,w).l;

theorem 
  Partial_Sums((Alfa(k+1,z,w))).k = (Partial_Sums(( Alfa(k,z,w))))
  .k + (Partial_Sums(( Expan_e(k+1,z,w) ))).k;

theorem 
  (z rExpSeq).k=(Expan_e(k,z,w)).k;

theorem 
  for z,w st z,w are_commutative holds Partial_Sums((z+w) rExpSeq)
  .n = Partial_Sums(Alfa(n,z,w)).n;

theorem 
  for z,w st z,w are_commutative holds Partial_Sums(z rExpSeq).k *
Partial_Sums(w rExpSeq).k -Partial_Sums((z+w) rExpSeq).k = Partial_Sums(Conj(k,
  z,w)).k;

theorem 
  0 <= (||. z .|| rExpSeq).n;

theorem 
  ||. Partial_Sums((z rExpSeq)).k .|| <= Partial_Sums(||.z.||
  rExpSeq).k & Partial_Sums((||.z.|| rExpSeq)).k <= Sum(||.z.|| rExpSeq) & ||.
  Partial_Sums(( z rExpSeq)).k .|| <= Sum(||.z.|| rExpSeq);

theorem 
  1 <= Sum(||.z.|| rExpSeq);

theorem 
  abs((Partial_Sums(||.z.|| rExpSeq)).n) = Partial_Sums(||.z.||
rExpSeq).n & (n <= m implies abs((Partial_Sums(||.z.|| rExpSeq).m-Partial_Sums(
  ||.z.|| rExpSeq).n)) = Partial_Sums(||.z.|| rExpSeq).m-Partial_Sums(||.z.||
  rExpSeq).n);

theorem 
  abs(Partial_Sums(||.Conj(k,z,w).||).n)=Partial_Sums(||.Conj(k,z, w).||).n;

theorem 
  for p being real number st p>0 ex n st for k st n <= k holds abs
  (Partial_Sums(||.Conj(k,z,w).||).k) < p;

theorem 
  for seq st for k holds seq.k=Partial_Sums((Conj(k,z,w))).k holds
  seq is convergent & lim(seq)=0.X;

definition
  let X be Banach_Algebra;
  func exp_ X -> Function of the carrier of X, the carrier of X means


  for z being Element of X holds it.z=Sum(z rExpSeq);
end;

definition
  let X,z;
  func exp z -> Element of X equals

  (exp_ X).z;
end;

theorem 
  for z holds exp(z)=Sum(z rExpSeq);

theorem 
  for z1,z2 st z1,z2 are_commutative holds exp(z1+z2)=exp(z1) *exp
  (z2) &exp(z2+z1)=exp(z2) *exp(z1) &exp(z1+z2)=exp(z2+z1) &exp(z1),exp(z2)
  are_commutative;

theorem 
  for z1,z2 st z1,z2 are_commutative holds z1* exp(z2)=exp(z2)*z1;

theorem 
  exp(0.X) = 1.X;

theorem 
  exp(z)*exp(-z)= 1.X & exp(-z)*exp(z)= 1.X;

theorem 
  exp(z) is invertible & (exp(z))" = exp(-z) & exp(-z) is invertible & (
  exp(-z))" = exp(z);

theorem 
  for z for s,t be Real holds s*z,t*z are_commutative;

theorem 
  for z for s,t be Real holds exp(s*z)*exp(t*z) = exp((s+t)*z) & exp(t*z
  )*exp(s*z) = exp((t+s)*z) & exp((s+t)*z) = exp((t+s)*z) & exp(s*z),exp(t*z)
  are_commutative;














begin

theorem 
  the carrier of Complex_l2_Space = the_set_of_l2ComplexSequences & (for
x be set holds x is Element of Complex_l2_Space iff x is Complex_Sequence & |.
seq_id(x).|(#)|.seq_id(x).| is summable) & (for x be set holds x is Element of
  Complex_l2_Space iff x is Complex_Sequence & seq_id(x)(#)(seq_id(x))*' is
  absolutely_summable ) & 0.Complex_l2_Space = CZeroseq & (for u be VECTOR of
  Complex_l2_Space holds u =seq_id(u)) & (for u,v be VECTOR of Complex_l2_Space
  holds u+v =seq_id(u)+seq_id(v)) & (for r be Complex for u be VECTOR of
  Complex_l2_Space holds r*u =r(#)seq_id(u)) & (for u be VECTOR of
  Complex_l2_Space holds -u =-seq_id(u) & seq_id(-u)=-seq_id(u)) & (for u,v be
VECTOR of Complex_l2_Space holds u-v =seq_id(u)-seq_id(v)) & for v,w be VECTOR
  of Complex_l2_Space holds |.seq_id(v).|(#)|.seq_id(w).| is summable & for v,w
  be VECTOR of Complex_l2_Space holds v.|.w = Sum(seq_id(v)(#)(seq_id(w))*');

theorem 
  for x,y,z being Point of Complex_l2_Space for a be Complex holds
  ( x.|.x = 0 iff x = 0.Complex_l2_Space ) & Re(x.|.x) >= 0 & Im(x.|.x) = 0 & x
  .|.y = (y.|.x)*' & (x+y).|.z = x.|.z + y.|.z & (a*x).|.y = a*(x.|.y);

registration
  cluster Complex_l2_Space -> ComplexUnitarySpace-like;
end;

registration
  cluster Complex_l2_Space -> complete;
end;

registration
 cluster complete for ComplexUnitarySpace;
end;

definition
  mode ComplexHilbertSpace is complete ComplexUnitarySpace;
end;

begin  

theorem 
  for z1, z2 be Complex st (Re z1)*(Im z2) = (Re z2)*(Im z1) & (Re z1)*(
  Re z2)+(Im z1)*(Im z2) >= 0 holds |.z1 + z2.| = |.z1.| + |.z2.|;

theorem 
  for x,y be Complex holds 2*|.x*y.| <= |.x.|^2 + |.y.|^2;

theorem 
  for x,y be Complex holds |.x+y.|*|.x+y.| <= 2*|.x.|*|.x.| + 2*|.y.|*|.
  y.| & |.x.|*|.x.| <= 2*|.x-y.|*|.x-y.| + 2*|.y.|*|.y.|;

canceled;

theorem 
  for seq be Complex_Sequence holds Partial_Sums (seq*') = (Partial_Sums
  seq) *';

theorem 
  for seq be Complex_Sequence, n be Element of NAT st (for i be Element
of NAT holds (Re seq).i >= 0 & (Im seq).i = 0) holds (|.Partial_Sums seq.|).n =
  (Partial_Sums |.seq.|).n;

theorem 
  for seq be Complex_Sequence st seq is summable holds Sum (seq*') = (
  Sum seq)*';

theorem 
  for seq be Complex_Sequence st seq is absolutely_summable holds |. Sum
  seq .| <= Sum |.seq.|;

theorem 
  for seq be Complex_Sequence st seq is summable & (for n be Element of
  NAT holds (Re seq).n >= 0 & (Im seq).n = 0) holds |. Sum seq .| = Sum |.seq.|
;

theorem 
  for seq be Complex_Sequence, n be Element of NAT holds (Re (seq(#)seq
  *')).n >= 0 & (Im (seq(#)seq*')).n = 0;

theorem 
  for seq be Complex_Sequence st seq is absolutely_summable & Sum |.seq
  .|=0 holds for n be Element of NAT holds seq.n =0c;

theorem 
  for seq being Complex_Sequence holds |.seq.| = |.seq*'.|;

theorem 
  for c be Complex, seq be Complex_Sequence st seq is convergent for
rseq be Real_Sequence st (for m be Element of NAT holds rseq .m = |.seq.m-c.|*
|.seq.m-c.|) holds rseq is convergent & lim rseq = |.lim seq-c.|*|.lim seq-c.|;

theorem 
  for c be Complex, seq1 be Real_Sequence, seq be Complex_Sequence st
  seq is convergent & seq1 is convergent for rseq be Real_Sequence st (for i be
  Element of NAT holds rseq.i = |.seq.i-c.|*|.seq.i-c.|+seq1.i) holds rseq is
  convergent & lim rseq = |.lim seq-c.|*|.lim seq-c.|+lim seq1;

theorem 
  for c be Complex, seq be Complex_Sequence st seq is convergent for
rseq be Real_Sequence st (for m be Element of NAT holds rseq .m = |.seq.m-c.|*
|.seq.m-c.|) holds rseq is convergent & lim rseq = |.lim seq-c.|*|.lim seq-c.|;

theorem 
  for c be Complex, seq1 be Real_Sequence, seq be Complex_Sequence st
  seq is convergent & seq1 is convergent for rseq be Real_Sequence st (for i be
  Element of NAT holds rseq.i = |.seq.i-c.|*|.seq.i-c.|+seq1.i) holds rseq is
  convergent & lim rseq = |.lim seq-c.|*|.lim seq-c.|+lim seq1;














begin 

definition
  func the_set_of_l1ComplexSequences -> Subset of
  Linear_Space_of_ComplexSequences means


  for x being set holds x in it iff
  x in the_set_of_ComplexSequences & seq_id(x) is absolutely_summable;
end;

theorem 
  for c be Complex, seq be Complex_Sequence, rseq be Real_Sequence
st seq is convergent & ( for i be Element of NAT holds rseq.i = |.(seq.i-c).| )
  holds rseq is convergent & lim rseq = |.(lim seq-c).|;

registration
  cluster the_set_of_l1ComplexSequences -> non empty;
end;

registration
  cluster the_set_of_l1ComplexSequences -> linearly-closed;
end;

registration
  cluster CLSStruct (# the_set_of_l1ComplexSequences, Zero_(
      the_set_of_l1ComplexSequences,Linear_Space_of_ComplexSequences), Add_(
      the_set_of_l1ComplexSequences,Linear_Space_of_ComplexSequences), Mult_(
the_set_of_l1ComplexSequences,Linear_Space_of_ComplexSequences) #) -> Abelian
    add-associative right_zeroed right_complementable vector-distributive
    scalar-distributive scalar-associative scalar-unital;
end;

definition
  func cl_norm -> Function of the_set_of_l1ComplexSequences, REAL means


for x be set st x in the_set_of_l1ComplexSequences holds it.x = Sum |.seq_id x
  .|;
end;

registration
  let X be non empty set, Z be Element of X, A be BinOp of X, M be Function of
  [:COMPLEX, X:], X, N be Function of X, REAL;
  cluster CNORMSTR (# X, Z, A, M, N #) -> non empty;
end;

theorem 
  for l be CNORMSTR st the CLSStruct of l is ComplexLinearSpace holds l
  is ComplexLinearSpace;

theorem 
  for cseq be Complex_Sequence st (for n be Element of NAT holds
  cseq.n=0c) holds cseq is absolutely_summable & Sum |.cseq.| = 0;

theorem 
  for cseq be Complex_Sequence st cseq is absolutely_summable & Sum
  |.cseq.| = 0 holds for n be Element of NAT holds cseq.n = 0c;

definition
  func Complex_l1_Space -> non empty CNORMSTR equals

  CNORMSTR (#
    the_set_of_l1ComplexSequences, Zero_(the_set_of_l1ComplexSequences,
    Linear_Space_of_ComplexSequences), Add_(the_set_of_l1ComplexSequences,
    Linear_Space_of_ComplexSequences), Mult_(the_set_of_l1ComplexSequences,
    Linear_Space_of_ComplexSequences), cl_norm #);
end;

theorem 
  Complex_l1_Space is ComplexLinearSpace;

begin 

theorem 
  the carrier of Complex_l1_Space = the_set_of_l1ComplexSequences &
( for x be set holds x is VECTOR of Complex_l1_Space iff x is Complex_Sequence
  & seq_id x is absolutely_summable ) & 0.Complex_l1_Space = CZeroseq & ( for u
  be VECTOR of Complex_l1_Space holds u =seq_id u ) & ( for u,v be VECTOR of
Complex_l1_Space holds u+v =seq_id(u)+seq_id(v) ) & ( for p be Complex for u be
  VECTOR of Complex_l1_Space holds p*u =p(#)seq_id(u) ) & ( for u be VECTOR of
  Complex_l1_Space holds -u = -seq_id u & seq_id(-u) = -seq_id(u) ) & ( for u,v
  be VECTOR of Complex_l1_Space holds u-v =seq_id(u)-seq_id v ) & ( for v be
  VECTOR of Complex_l1_Space holds seq_id v is absolutely_summable ) & for v be
  VECTOR of Complex_l1_Space holds ||.v.|| = Sum |.seq_id v.|;

theorem 
  for x, y being Point of Complex_l1_Space, p be Complex holds (
||.x.|| = 0 iff x = 0.Complex_l1_Space ) & 0 <= ||.x.|| & ||.x+y.|| <= ||.x.||
  + ||.y.|| & ||. p*x .|| = |.p.| * ||.x.||;

registration
  cluster Complex_l1_Space -> reflexive discerning ComplexNormSpace-like
  vector-distributive scalar-distributive scalar-associative scalar-unital
    Abelian add-associative right_zeroed right_complementable;
end;

definition
  let X be non empty CNORMSTR, x, y be Point of X;
  func dist(x,y) -> Real equals

  ||.x - y.||;
end;

definition
  let CNRM be non empty CNORMSTR;
  let seqt be sequence of CNRM;
  attr seqt is CCauchy means


  for r1 be Real st r1 > 0 ex k1 be Element
of NAT st for n1, m1 be Element of NAT st n1 >= k1 & m1 >= k1 holds dist(seqt.
  n1, seqt.m1) < r1;
end;

notation
  let CNRM be non empty CNORMSTR;
  let seq be sequence of CNRM;
  synonym seq is Cauchy_sequence_by_Norm for seq is CCauchy;
end;

reserve NRM for non empty ComplexNormSpace;
reserve seq for sequence of NRM;

theorem 
  seq is Cauchy_sequence_by_Norm iff for r be Real st r > 0 ex k
  be Element of NAT st for n, m be Element of NAT st n >= k & m >= k holds ||.(
  seq.n) - (seq.m).|| < r;

theorem 
  for vseq be sequence of Complex_l1_Space st vseq is
  Cauchy_sequence_by_Norm holds vseq is convergent;














begin 

definition
  let X be set;
  let Y be non empty set;
  let F be Function of [:COMPLEX, Y:], Y;
  let c be complex number, f be Function of X, Y;
  redefine func F[;](c,f) -> Element of Funcs(X, Y);
end;

definition
  let X be non empty set;
  let Y be ComplexLinearSpace;
  func FuncExtMult(X,Y) -> Function of [:COMPLEX,Funcs(X,the carrier of Y):],
  Funcs(X,the carrier of Y) means


  for c being Complex, f being Element of
  Funcs(X,the carrier of Y), x being Element of X holds (it.[c,f]).x = c*(f.x);
end;

reserve X for non empty set;
reserve Y for ComplexLinearSpace;
reserve f,g,h for Element of Funcs(X,the carrier of Y);

theorem 
  for x being Element of X holds (FuncZero(X,Y)).x = 0.Y;

reserve a,b for Complex;

theorem 
  h = (FuncExtMult(X,Y)).[a,f] iff for x being Element of X holds h
  .x = a*(f.x);

reserve u,v,w for VECTOR of CLSStruct(#Funcs(X,the carrier of Y), (FuncZero(X,
    Y)),FuncAdd(X,Y),FuncExtMult(X,Y)#);

theorem 
  (FuncAdd(X,Y)).(f,g) = (FuncAdd(X,Y)).(g,f);

theorem 
  (FuncAdd(X,Y)).(f,(FuncAdd(X,Y)).(g,h)) = (FuncAdd(X,Y)).((
  FuncAdd(X,Y)).(f,g),h);

theorem 
  (FuncAdd(X,Y)).(FuncZero(X,Y),f) = f;

theorem 
  (FuncAdd(X,Y)).(f,(FuncExtMult(X,Y)).[-1r,f]) = FuncZero(X,Y);

theorem 
  (FuncExtMult(X,Y)).[1r,f] = f;

theorem 
  (FuncExtMult(X,Y)).[a,(FuncExtMult(X,Y)).[b,f]] = (FuncExtMult(X, Y)).[a*b,f]
;

theorem 
  (FuncAdd(X,Y)).((FuncExtMult(X,Y)).[a,f],(FuncExtMult(X,Y)).[b,f
  ]) = (FuncExtMult(X,Y)).[a+b,f];

theorem 
  CLSStruct(#Funcs(X,the carrier of Y),(FuncZero(X,Y)),FuncAdd(X,Y
    ), FuncExtMult(X,Y)#) is ComplexLinearSpace;

definition
  let X be non empty set;
  let Y be ComplexLinearSpace;
  func ComplexVectSpace(X,Y) -> ComplexLinearSpace equals

  CLSStruct(#Funcs(X,
    the carrier of Y), (FuncZero(X,Y)),FuncAdd(X,Y),FuncExtMult(X,Y)#);
end;

registration
  let X be non empty set;
  let Y be ComplexLinearSpace;
  cluster ComplexVectSpace(X,Y) -> strict;
end;

registration
  let X be non empty set;
  let Y be ComplexLinearSpace;
  cluster ComplexVectSpace(X,Y) -> constituted-Functions;
end;

definition
  let X be non empty set;
  let Y be ComplexLinearSpace;
  let f be VECTOR of ComplexVectSpace(X,Y);
  let x be Element of X;
  redefine func f.x -> VECTOR of Y;
end;

theorem 
  for X be non empty set, Y be ComplexLinearSpace, f,g,h be VECTOR of
ComplexVectSpace(X,Y) holds h = f+g iff for x be Element of X holds h.x = f.x +
  g.x;

theorem 
  for X be non empty set, Y be ComplexLinearSpace, f,h be VECTOR
of ComplexVectSpace(X,Y), c be Complex holds h = c*f iff for x be Element of X
  holds h.x = c * f.x;

begin 

definition
  let X, Y be non empty CLSStruct;
  let IT be Function of X,Y;
  attr IT is homogeneous means


  for x being VECTOR of X, r being Complex holds IT.(r*x) = r*IT.x;
end;

registration
  let X be non empty CLSStruct;
  let Y be ComplexLinearSpace;
  cluster additive homogeneous for Function of X,Y;
end;

definition
  let X, Y be ComplexLinearSpace;
  mode LinearOperator of X,Y is additive homogeneous Function of X,Y;
end;

definition
  let X, Y be ComplexLinearSpace;
  func LinearOperators(X,Y) -> Subset of ComplexVectSpace(the carrier of X, Y)
  means


  for x being set holds x in it iff x is LinearOperator of X,Y;
end;

registration
  let X, Y be ComplexLinearSpace;
  cluster LinearOperators(X,Y) -> non empty functional;
end;

theorem 
  for X,Y be ComplexLinearSpace holds LinearOperators(X,Y) is linearly-closed;

theorem 
  for X,Y be ComplexLinearSpace holds CLSStruct (# LinearOperators(X,Y),
    Zero_(LinearOperators(X,Y),ComplexVectSpace(the carrier of X,Y)), Add_(
    LinearOperators(X,Y), ComplexVectSpace(the carrier of X,Y)), Mult_(
LinearOperators(X,Y), ComplexVectSpace(the carrier of X,Y)) #) is Subspace of
  ComplexVectSpace(the carrier of X,Y);

registration
  let X,Y be ComplexLinearSpace;
  cluster CLSStruct (# LinearOperators(X,Y), Zero_(LinearOperators(X,Y),
      ComplexVectSpace(the carrier of X,Y)), Add_(LinearOperators(X,Y),
      ComplexVectSpace(the carrier of X,Y)), Mult_(LinearOperators(X,Y),
      ComplexVectSpace(the carrier of X,Y)) #) -> Abelian add-associative
    right_zeroed right_complementable vector-distributive scalar-distributive
    scalar-associative scalar-unital;
end;

definition
  let X, Y be ComplexLinearSpace;
  func C_VectorSpace_of_LinearOperators(X,Y) -> ComplexLinearSpace equals

CLSStruct (# LinearOperators(X,Y), Zero_(LinearOperators(X,Y),ComplexVectSpace(
the carrier of X,Y)), Add_(LinearOperators(X,Y), ComplexVectSpace(the carrier
of X,Y)), Mult_(LinearOperators(X,Y), ComplexVectSpace(the carrier of X,Y)) #);
end;

registration
  let X, Y be ComplexLinearSpace;
  cluster C_VectorSpace_of_LinearOperators(X,Y) -> strict;
end;

registration
  let X,Y be ComplexLinearSpace;
  cluster C_VectorSpace_of_LinearOperators(X,Y) -> constituted-Functions;
end;

definition
  let X,Y be ComplexLinearSpace;
  let f be Element of C_VectorSpace_of_LinearOperators(X,Y);
  let v be VECTOR of X;
  redefine func f.v -> VECTOR of Y;
end;

theorem 
  for X,Y be ComplexLinearSpace, f,g,h be VECTOR of
  C_VectorSpace_of_LinearOperators(X,Y) holds h = f+g iff for x be VECTOR of X
  holds h.x = f.x + g.x;

theorem 
  for X,Y be ComplexLinearSpace, f,h be VECTOR of
C_VectorSpace_of_LinearOperators(X,Y), c be Complex holds h = c*f iff for x be
  VECTOR of X holds h.x = c * f.x;

theorem 
  for X,Y be ComplexLinearSpace holds 0.
  C_VectorSpace_of_LinearOperators(X,Y) = (the carrier of X) -->0.Y;

theorem 
  for X,Y be ComplexLinearSpace holds (the carrier of X) --> 0.Y
  is LinearOperator of X,Y;

begin 

theorem 
  for X be ComplexNormSpace, seq be sequence of X, g be Point of X
holds seq is convergent & lim seq = g implies ||.seq.|| is convergent & lim ||.
  seq.|| = ||.g.||;

definition
  let X, Y be ComplexNormSpace;
  let IT be LinearOperator of X,Y;
  attr IT is Lipschitzian means


  ex K being Real st 0 <= K &
  for x being VECTOR of X holds ||. IT.x .|| <= K * ||. x .||;
end;

theorem 
  for X,Y be ComplexNormSpace holds for f be LinearOperator of X,Y
  st (for x be VECTOR of X holds f.x=0.Y) holds f is Lipschitzian;

registration
  let X, Y be ComplexNormSpace;
  cluster Lipschitzian for LinearOperator of X,Y;
end;

definition
  let X,Y be ComplexNormSpace;
  func BoundedLinearOperators(X,Y) -> Subset of
  C_VectorSpace_of_LinearOperators(X,Y) means


  for x being set holds x in it iff x is Lipschitzian LinearOperator of X,Y;
end;

registration
  let X, Y be ComplexNormSpace;
  cluster BoundedLinearOperators(X,Y) -> non empty;
end;

theorem 
  for X,Y be ComplexNormSpace holds BoundedLinearOperators(X,Y) is
  linearly-closed;

theorem 
  for X,Y be ComplexNormSpace holds CLSStruct (# BoundedLinearOperators(
X,Y), Zero_(BoundedLinearOperators(X,Y), C_VectorSpace_of_LinearOperators(X,Y))
    , Add_(BoundedLinearOperators(X,Y), C_VectorSpace_of_LinearOperators(X,Y)),
Mult_(BoundedLinearOperators(X,Y),C_VectorSpace_of_LinearOperators(X,Y)) #) is
  Subspace of C_VectorSpace_of_LinearOperators(X,Y);

registration
  let X, Y be ComplexNormSpace;
  cluster CLSStruct (# BoundedLinearOperators(X,Y), Zero_(
BoundedLinearOperators(X,Y), C_VectorSpace_of_LinearOperators(X,Y)), Add_(
BoundedLinearOperators(X,Y), C_VectorSpace_of_LinearOperators(X,Y)), Mult_(
      BoundedLinearOperators(X,Y),C_VectorSpace_of_LinearOperators(X,Y)) #) ->
    Abelian add-associative right_zeroed right_complementable
    vector-distributive scalar-distributive scalar-associative scalar-unital;
end;

definition
  let X, Y be ComplexNormSpace;
  func C_VectorSpace_of_BoundedLinearOperators(X,Y) -> ComplexLinearSpace
  equals

  CLSStruct (# BoundedLinearOperators(X,Y), Zero_(BoundedLinearOperators(X
,Y), C_VectorSpace_of_LinearOperators(X,Y)), Add_(BoundedLinearOperators(X,Y),
    C_VectorSpace_of_LinearOperators(X,Y)), Mult_(BoundedLinearOperators(X,Y),
    C_VectorSpace_of_LinearOperators(X,Y)) #);
end;

registration
  let X,Y be ComplexNormSpace;
  cluster C_VectorSpace_of_BoundedLinearOperators(X,Y) -> strict;
end;

registration
  let X,Y be ComplexNormSpace;
  cluster -> Function-like Relation-like for Element of
    C_VectorSpace_of_BoundedLinearOperators(X,Y);
end;

definition
  let X,Y be ComplexNormSpace;
  let f be Element of C_VectorSpace_of_BoundedLinearOperators(X,Y);
  let v be VECTOR of X;
  redefine func f.v -> VECTOR of Y;
end;

theorem 
  for X,Y be ComplexNormSpace, f,g,h be VECTOR of
C_VectorSpace_of_BoundedLinearOperators(X,Y) holds h = f+g iff for x be VECTOR
  of X holds h.x = f.x + g.x;

theorem 
  for X,Y be ComplexNormSpace, f,h be VECTOR of
  C_VectorSpace_of_BoundedLinearOperators(X,Y), c be Complex holds h = c*f iff
  for x be VECTOR of X holds h.x = c * f.x;

theorem 
  for X,Y be ComplexNormSpace holds 0.
  C_VectorSpace_of_BoundedLinearOperators(X,Y) = (the carrier of X) --> 0.Y;

definition
  let X, Y be ComplexNormSpace;
  let f be set such that
 f in BoundedLinearOperators(X,Y);
  func modetrans(f,X,Y) -> Lipschitzian LinearOperator of X,Y equals


  f;
end;

definition
  let X, Y be ComplexNormSpace;
  let u be LinearOperator of X,Y;
  func PreNorms(u) -> non empty Subset of REAL equals

  {||.u.t.|| where t is
  VECTOR of X : ||.t.|| <= 1 };
end;

theorem 
  for X,Y be ComplexNormSpace, g be Lipschitzian LinearOperator of X,Y
  holds PreNorms(g) is bounded_above;

theorem 
  for X,Y be ComplexNormSpace, g be LinearOperator of X,Y holds g is
  Lipschitzian iff PreNorms(g) is bounded_above;

definition
  let X, Y be ComplexNormSpace;
  func BoundedLinearOperatorsNorm(X,Y) -> Function of BoundedLinearOperators(X
  ,Y), REAL means


  for x be set st x in BoundedLinearOperators(X,Y) holds
  it.x = upper_bound PreNorms(modetrans(x,X,Y));
end;

theorem 
  for X,Y be ComplexNormSpace, f be Lipschitzian LinearOperator of X,Y
  holds modetrans(f,X,Y)=f;

theorem 
  for X,Y be ComplexNormSpace, f be Lipschitzian LinearOperator of X,Y
  holds BoundedLinearOperatorsNorm(X,Y).f = upper_bound PreNorms(f);

definition
  let X,Y be ComplexNormSpace;
  func C_NormSpace_of_BoundedLinearOperators(X,Y) -> non empty CNORMSTR equals

  CNORMSTR (# BoundedLinearOperators(X,Y), Zero_(BoundedLinearOperators(X,Y),
    C_VectorSpace_of_LinearOperators(X,Y)), Add_(BoundedLinearOperators(X,Y),
    C_VectorSpace_of_LinearOperators(X,Y)), Mult_(BoundedLinearOperators(X,Y),
    C_VectorSpace_of_LinearOperators(X,Y)), BoundedLinearOperatorsNorm(X,Y) #);
end;

theorem 
  for X,Y be ComplexNormSpace holds (the carrier of X) --> 0.Y =
  0.C_NormSpace_of_BoundedLinearOperators(X,Y);

theorem 
  for X,Y be ComplexNormSpace,
  f being Point of C_NormSpace_of_BoundedLinearOperators(X,Y),
  g be Lipschitzian LinearOperator of X,Y
  st g=f holds for t be VECTOR of X holds ||.g.t.|| <= ||.f.|| * ||.t.||;

theorem 
  for X,Y be ComplexNormSpace, f being Point of
  C_NormSpace_of_BoundedLinearOperators(X,Y) holds 0 <= ||.f.||;

theorem 
  for X,Y be ComplexNormSpace, f being Point of
  C_NormSpace_of_BoundedLinearOperators(X,Y) st f = 0.
  C_NormSpace_of_BoundedLinearOperators(X,Y) holds 0 = ||.f.||;

registration
  let X,Y be ComplexNormSpace;
  cluster -> Function-like Relation-like for Element of
    C_NormSpace_of_BoundedLinearOperators(X,Y);
end;

definition
  let X,Y be ComplexNormSpace;
  let f be Element of C_NormSpace_of_BoundedLinearOperators(X,Y);
  let v be VECTOR of X;
  redefine func f.v -> VECTOR of Y;
end;

theorem 
  for X,Y be ComplexNormSpace, f,g,h be Point of
C_NormSpace_of_BoundedLinearOperators(X,Y) holds h = f+g iff for x be VECTOR of
  X holds h.x = f.x + g.x;

theorem 
  for X,Y be ComplexNormSpace, f,h be Point of
C_NormSpace_of_BoundedLinearOperators(X,Y), c be Complex holds h = c*f iff for
  x be VECTOR of X holds h.x = c * f.x;

theorem 
  for X,Y be ComplexNormSpace, f, g being Point of
  C_NormSpace_of_BoundedLinearOperators(X,Y), c be Complex holds ( ||.f.|| = 0
  iff f = 0.C_NormSpace_of_BoundedLinearOperators(X,Y) ) & ||.c*f.|| = |.c.| *
  ||.f.|| & ||.f+g.|| <= ||.f.|| + ||.g.||;

theorem 
  for X,Y be ComplexNormSpace holds
  C_NormSpace_of_BoundedLinearOperators(X,Y) is
   reflexive discerning ComplexNormSpace-like;

theorem 
  for X,Y be ComplexNormSpace holds
  C_NormSpace_of_BoundedLinearOperators(X,Y) is ComplexNormSpace;

registration
  let X,Y be ComplexNormSpace;
  cluster C_NormSpace_of_BoundedLinearOperators(X,Y) ->
    reflexive discerning ComplexNormSpace-like
    vector-distributive scalar-distributive scalar-associative scalar-unital
    Abelian add-associative right_zeroed
    right_complementable;
end;

theorem 
  for X,Y be ComplexNormSpace, f,g,h be Point of
C_NormSpace_of_BoundedLinearOperators(X,Y) holds h = f-g iff for x be VECTOR of
  X holds h.x = f.x - g.x;

begin 

definition
  let X be ComplexNormSpace;
  attr X is complete means


  for seq be sequence of X holds seq is
  Cauchy_sequence_by_Norm implies seq is convergent;
end;

registration
  cluster complete for ComplexNormSpace;
end;

definition
  mode ComplexBanachSpace is complete ComplexNormSpace;
end;

theorem 
  for X be ComplexNormSpace, seq be sequence of X st seq is
  convergent holds ||.seq.|| is convergent & lim ||.seq.|| = ||.lim seq.||;

theorem 
  for X,Y be ComplexNormSpace st Y is complete for seq be sequence
of C_NormSpace_of_BoundedLinearOperators(X,Y) st seq is Cauchy_sequence_by_Norm
  holds seq is convergent;

theorem 
  for X be ComplexNormSpace, Y be ComplexBanachSpace holds
  C_NormSpace_of_BoundedLinearOperators(X,Y) is ComplexBanachSpace;

registration
  let X be ComplexNormSpace;
  let Y be ComplexBanachSpace;
  cluster C_NormSpace_of_BoundedLinearOperators (X,Y) -> complete;
end;














begin

definition
  func the_set_of_BoundedComplexSequences -> Subset of
  Linear_Space_of_ComplexSequences means


  for x being set holds x in it iff
  x in the_set_of_ComplexSequences & seq_id x is bounded;
end;

registration
  cluster the_set_of_BoundedComplexSequences -> non empty;
  cluster the_set_of_BoundedComplexSequences -> linearly-closed;
end;

registration
  cluster CLSStruct (# the_set_of_BoundedComplexSequences, Zero_(
the_set_of_BoundedComplexSequences,Linear_Space_of_ComplexSequences), Add_(
the_set_of_BoundedComplexSequences,Linear_Space_of_ComplexSequences), Mult_(
the_set_of_BoundedComplexSequences,Linear_Space_of_ComplexSequences) #) ->
    Abelian add-associative right_zeroed right_complementable
    vector-distributive scalar-distributive scalar-associative scalar-unital;
end;

definition
  func Complex_linfty_norm -> Function of the_set_of_BoundedComplexSequences,
  REAL means


  for x be set st x in the_set_of_BoundedComplexSequences holds
  it.x = upper_bound rng |.seq_id x.|;
end;

theorem 
  for seq be Complex_Sequence holds seq is bounded &
  upper_bound rng |.seq.| = 0
  iff for n be Element of NAT holds seq.n = 0c;

registration
  cluster CNORMSTR (# the_set_of_BoundedComplexSequences, Zero_(
the_set_of_BoundedComplexSequences,Linear_Space_of_ComplexSequences), Add_(
the_set_of_BoundedComplexSequences,Linear_Space_of_ComplexSequences), Mult_(
      the_set_of_BoundedComplexSequences,Linear_Space_of_ComplexSequences),
      Complex_linfty_norm #) -> Abelian add-associative right_zeroed
    right_complementable vector-distributive scalar-distributive
    scalar-associative scalar-unital;
end;

definition
  func Complex_linfty_Space -> non empty CNORMSTR equals

  CNORMSTR (#
the_set_of_BoundedComplexSequences, Zero_(the_set_of_BoundedComplexSequences,
    Linear_Space_of_ComplexSequences), Add_(the_set_of_BoundedComplexSequences,
Linear_Space_of_ComplexSequences), Mult_(the_set_of_BoundedComplexSequences,
    Linear_Space_of_ComplexSequences), Complex_linfty_norm #);
end;

theorem 
  the carrier of Complex_linfty_Space =
  the_set_of_BoundedComplexSequences & ( for x be set holds x is VECTOR of
  Complex_linfty_Space iff x is Complex_Sequence & seq_id x is bounded ) & 0.
  Complex_linfty_Space = CZeroseq & ( for u be VECTOR of Complex_linfty_Space
holds u = seq_id u ) & ( for u,v be VECTOR of Complex_linfty_Space holds u+v =
seq_id(u)+seq_id(v) ) & ( for c be Complex, u be VECTOR of Complex_linfty_Space
holds c*u =c(#)seq_id(u) ) & ( for u be VECTOR of Complex_linfty_Space holds -u
  = -seq_id u & seq_id(-u) = -seq_id u ) & ( for u,v be VECTOR of
  Complex_linfty_Space holds u-v =seq_id(u)-seq_id(v) ) & ( for v be VECTOR of
  Complex_linfty_Space holds seq_id v is bounded ) & for v be VECTOR of
  Complex_linfty_Space holds ||.v.|| = upper_bound rng |.seq_id v.|;

theorem 
  for x, y being Point of Complex_linfty_Space, c be Complex holds
  ( ||.x.|| = 0 iff x = 0.Complex_linfty_Space ) & 0 <= ||.x.|| & ||.x+y.|| <=
  ||.x.|| + ||.y.|| & ||. c*x .|| = |.c.| * ||.x.||;

registration
  cluster Complex_linfty_Space ->
    reflexive discerning ComplexNormSpace-like
    vector-distributive scalar-distributive scalar-associative scalar-unital
    Abelian add-associative right_zeroed
    right_complementable;
end;

theorem 
  for vseq be sequence of Complex_linfty_Space st vseq is
  Cauchy_sequence_by_Norm holds vseq is convergent;

theorem 
  Complex_linfty_Space is ComplexBanachSpace;

begin  

definition
  let X be non empty set;
  let Y be ComplexNormSpace;
  let IT be Function of X, the carrier of Y;
  attr IT is bounded means


  ex K being Real st 0 <= K & for x being Element of X holds ||. IT.x .|| <= K;
end;

theorem 
  for X be non empty set, Y be ComplexNormSpace, f be Function of X
  ,the carrier of Y st (for x be Element of X holds f.x=0.Y) holds f is bounded
;

registration
  let X be non empty set;
  let Y be ComplexNormSpace;
  cluster bounded for Function of X,the carrier of Y;
end;

definition
  let X be non empty set;
  let Y be ComplexNormSpace;
  func ComplexBoundedFunctions(X,Y) -> Subset of ComplexVectSpace(X,Y) means


   for
 x being set holds x in it iff x is bounded Function of X,the carrier
  of Y;
end;

registration
  let X be non empty set;
  let Y be ComplexNormSpace;
  cluster ComplexBoundedFunctions(X,Y) -> non empty;
end;

theorem 
  for X be non empty set for Y be ComplexNormSpace holds
  ComplexBoundedFunctions(X,Y) is linearly-closed;

theorem 
  for X be non empty set for Y be ComplexNormSpace holds CLSStruct (#
    ComplexBoundedFunctions(X,Y), Zero_(ComplexBoundedFunctions(X,Y),
ComplexVectSpace(X,Y)), Add_(ComplexBoundedFunctions(X,Y),ComplexVectSpace(X,Y)
), Mult_(ComplexBoundedFunctions(X,Y),ComplexVectSpace(X,Y)) #) is Subspace of
  ComplexVectSpace(X,Y);

registration
  let X be non empty set;
  let Y be ComplexNormSpace;
  cluster CLSStruct (# ComplexBoundedFunctions(X,Y), Zero_(
      ComplexBoundedFunctions(X,Y), ComplexVectSpace(X,Y)), Add_(
      ComplexBoundedFunctions(X,Y), ComplexVectSpace(X,Y)), Mult_(
      ComplexBoundedFunctions(X,Y), ComplexVectSpace(X,Y)) #) -> Abelian
    add-associative right_zeroed right_complementable vector-distributive
    scalar-distributive scalar-associative scalar-unital;
end;

definition
  let X be non empty set;
  let Y be ComplexNormSpace;
  func C_VectorSpace_of_BoundedFunctions(X,Y) -> ComplexLinearSpace equals

CLSStruct (# ComplexBoundedFunctions(X,Y), Zero_(ComplexBoundedFunctions(X,Y),
ComplexVectSpace(X,Y)), Add_(ComplexBoundedFunctions(X,Y),ComplexVectSpace(X,Y)
    ), Mult_(ComplexBoundedFunctions(X,Y),ComplexVectSpace(X,Y)) #);
end;

registration
  let X be non empty set;
  let Y be ComplexNormSpace;
  cluster C_VectorSpace_of_BoundedFunctions(X,Y) -> strict;
end;

theorem 
  for X be non empty set for Y be ComplexNormSpace, f,g,h be
VECTOR of C_VectorSpace_of_BoundedFunctions(X,Y), f9,g9,h9 be bounded Function
of X,the carrier of Y st f9=f & g9=g & h9=h holds (h = f+g iff for x be Element
  of X holds h9.x = f9.x + g9.x );

theorem 
  for X be non empty set for Y be ComplexNormSpace, f,h be VECTOR
  of C_VectorSpace_of_BoundedFunctions(X,Y), f9,h9 be bounded Function of X,the
carrier of Y st f9=f & h9=h for c be Complex holds h = c*f iff for x be Element
  of X holds h9.x = c*f9.x;

theorem 
  for X be non empty set, Y be ComplexNormSpace holds 0.
  C_VectorSpace_of_BoundedFunctions(X,Y) = (X -->0.Y);

definition
  let X be non empty set;
  let Y be ComplexNormSpace;
  let f be set such that
 f in ComplexBoundedFunctions(X,Y);
  func modetrans(f,X,Y) -> bounded Function of X,the carrier of Y equals



  f;
end;

definition
  let X be non empty set;
  let Y be ComplexNormSpace;
  let u be Function of X,the carrier of Y;
  func PreNorms(u) -> non empty Subset of REAL equals

  {||.u.t.|| where t is
  Element of X : not contradiction };
end;

theorem 
  for X be non empty set for Y be ComplexNormSpace, g be bounded
  Function of X,the carrier of Y holds PreNorms(g) is bounded_above;

theorem 
  for X be non empty set for Y be ComplexNormSpace, g be Function of X,
  the carrier of Y holds g is bounded iff PreNorms(g) is bounded_above;

definition
  let X be non empty set;
  let Y be ComplexNormSpace;
  func ComplexBoundedFunctionsNorm(X,Y) -> Function of ComplexBoundedFunctions
  (X,Y), REAL means


  for x be set st x in ComplexBoundedFunctions(X,Y)
  holds it.x = upper_bound PreNorms(modetrans(x,X,Y));
end;

theorem 
  for X be non empty set, Y be ComplexNormSpace, f be bounded
  Function of X,the carrier of Y holds modetrans(f,X,Y)=f;

theorem 
  for X be non empty set, Y be ComplexNormSpace, f be bounded
  Function of X,the carrier of Y holds ComplexBoundedFunctionsNorm(X,Y).f
   = upper_bound
  PreNorms(f);

definition
  let X be non empty set;
  let Y be ComplexNormSpace;
  func C_NormSpace_of_BoundedFunctions(X,Y) -> non empty CNORMSTR equals

  CNORMSTR (# ComplexBoundedFunctions(X,Y), Zero_(ComplexBoundedFunctions(X,Y),
ComplexVectSpace(X,Y)), Add_(ComplexBoundedFunctions(X,Y),ComplexVectSpace(X,Y)
    ), Mult_(ComplexBoundedFunctions(X,Y),ComplexVectSpace(X,Y)),
    ComplexBoundedFunctionsNorm(X,Y) #);
end;

theorem 
  for X be non empty set, Y be ComplexNormSpace holds (X --> 0.Y)
  = 0.C_NormSpace_of_BoundedFunctions(X,Y);

theorem 
  for X be non empty set, Y be ComplexNormSpace, f being Point of
C_NormSpace_of_BoundedFunctions(X,Y), g be bounded Function of X,the carrier of
  Y st g=f holds for t be Element of X holds ||.g.t.|| <= ||.f.||;

theorem 
  for X be non empty set, Y be ComplexNormSpace, f being Point of
  C_NormSpace_of_BoundedFunctions(X,Y) holds 0 <= ||.f.||;

theorem 
  for X be non empty set, Y be ComplexNormSpace, f being Point of
C_NormSpace_of_BoundedFunctions(X,Y) st f = 0.C_NormSpace_of_BoundedFunctions(X
  ,Y) holds 0 = ||.f.||;

theorem 
  for X be non empty set, Y be ComplexNormSpace, f,g,h be Point of
  C_NormSpace_of_BoundedFunctions(X,Y), f9,g9,h9 be bounded Function of X,the
  carrier of Y st f9=f & g9=g & h9=h holds ( h = f+g iff for x be Element of X
  holds h9.x = f9.x + g9.x );

theorem 
  for X be non empty set, Y be ComplexNormSpace, f,h be Point of
  C_NormSpace_of_BoundedFunctions(X,Y), f9,h9 be bounded Function of X,the
carrier of Y st f9=f & h9=h for c be Complex holds h = c*f iff for x be Element
  of X holds h9.x = c*f9.x;

theorem 
  for X be non empty set, Y be ComplexNormSpace, f,g being Point
of C_NormSpace_of_BoundedFunctions(X,Y), c be Complex holds ( ||.f.|| = 0 iff f
= 0.C_NormSpace_of_BoundedFunctions(X,Y) ) & ||.c*f.|| = |.c.| * ||.f.|| & ||.f
  +g.|| <= ||.f.|| + ||.g.||;

theorem 
  for X be non empty set, Y be ComplexNormSpace holds
  C_NormSpace_of_BoundedFunctions(X,Y) is
   reflexive discerning ComplexNormSpace-like;

theorem 
  for X be non empty set, Y be ComplexNormSpace holds
  C_NormSpace_of_BoundedFunctions(X,Y) is ComplexNormSpace;

registration
  let X be non empty set;
  let Y be ComplexNormSpace;
  cluster C_NormSpace_of_BoundedFunctions(X,Y) ->
    reflexive discerning ComplexNormSpace-like
    vector-distributive scalar-distributive scalar-associative scalar-unital
    Abelian add-associative right_zeroed
    right_complementable;
end;

theorem 
  for X be non empty set for Y be ComplexNormSpace, f,g,h be Point
of C_NormSpace_of_BoundedFunctions(X,Y), f9,g9,h9 be bounded Function of X,the
  carrier of Y st f9=f & g9=g & h9=h holds (h = f-g iff for x be Element of X
  holds h9.x = f9.x - g9.x );

theorem 
  for X be non empty set, Y be ComplexNormSpace st Y is complete
  for seq be sequence of C_NormSpace_of_BoundedFunctions(X,Y) st seq is
  Cauchy_sequence_by_Norm holds seq is convergent;

theorem 
  for X be non empty set, Y be ComplexBanachSpace holds
  C_NormSpace_of_BoundedFunctions(X,Y) is ComplexBanachSpace;

registration
  let X be non empty set;
  let Y be ComplexBanachSpace;
  cluster C_NormSpace_of_BoundedFunctions (X,Y) -> complete;
end;

begin 

theorem 
  for seq1,seq2 be Complex_Sequence st seq1 is bounded & seq2 is bounded
  holds seq1 + seq2 is bounded;

theorem 
  for c be Complex, seq be Complex_Sequence st seq is bounded holds c(#)
  seq is bounded;

theorem 
  for seq be Complex_Sequence holds seq is bounded iff |.seq.| is
  bounded;

theorem 
  for seq1,seq2,seq3 be Complex_Sequence holds seq1 = seq2 - seq3 iff
  for n be Element of NAT holds seq1.n = seq2.n - seq3.n;














begin 

reserve X for ComplexUnitarySpace;
reserve g for Point of X;
reserve seq, seq1, seq2 for sequence of X;
reserve Rseq for Real_Sequence;
reserve Cseq,Cseq1,Cseq2 for Complex_Sequence;
reserve z,z1,z2 for Complex;
reserve r for Real;
reserve k,n,m for Element of NAT;

theorem 
  Partial_Sums(seq1) + Partial_Sums(seq2) = Partial_Sums(seq1 + seq2);

theorem 
  Partial_Sums(seq1) - Partial_Sums(seq2) = Partial_Sums(seq1 - seq2);

theorem 
  Partial_Sums(z * seq) = z * Partial_Sums(seq);

theorem 
  Partial_Sums(- seq) = - Partial_Sums(seq);

theorem 
  z1 * Partial_Sums(seq1) + z2 * Partial_Sums(seq2) = Partial_Sums(z1*
  seq1 + z2*seq2);

definition
  let X, seq;
  attr seq is summable means


  Partial_Sums(seq) is convergent;
  func Sum(seq) -> Point of X equals

  lim Partial_Sums(seq);
end;

theorem 
  seq1 is summable & seq2 is summable implies seq1 + seq2 is summable &
  Sum(seq1 + seq2) = Sum(seq1) + Sum(seq2);

theorem 
  seq1 is summable & seq2 is summable implies seq1 - seq2 is summable &
  Sum(seq1 - seq2) = Sum(seq1) - Sum(seq2);

theorem 
  seq is summable implies z * seq is summable & Sum(z*seq) = z * Sum(seq );

theorem 
  seq is summable implies seq is convergent & lim seq = 0.X;

theorem 
  for X being ComplexHilbertSpace, seq being sequence of X
  holds seq is summable iff for r st r > 0 ex k
st for n, m st n >= k & m >= k holds ||.(Partial_Sums(seq)).n - (Partial_Sums(
  seq)).m.|| < r;

theorem 
  seq is summable implies Partial_Sums(seq) is bounded;

theorem 
  (for n holds seq1.n = seq.0) implies Partial_Sums(seq^\1) = (
  Partial_Sums(seq)^\1) - seq1;

theorem 
  seq is summable implies for k holds seq^\k is summable;

theorem 
  (ex k st seq^\k is summable) implies seq is summable;

definition
  let X, seq, n;
  func Sum(seq,n) -> Point of X equals

  Partial_Sums(seq).n;
end;

theorem 
  Sum(seq, 0) = seq.0;

theorem 
  Sum(seq,1) = Sum(seq,0) + seq.1;

theorem 
  Sum(seq,1) = seq.0 + seq.1;

theorem 
  Sum(seq,n+1) = Sum(seq,n) + seq.(n+1);

theorem 
  seq.(n+1) = Sum(seq,n+1) - Sum(seq,n);

theorem 
  seq.1 = Sum(seq,1) - Sum(seq,0);

definition
  let X, seq, n, m;
  func Sum(seq, n, m) -> Point of X equals

  Sum(seq,n) - Sum(seq,m);
end;

theorem 
  Sum(seq,1,0) = seq.1;

theorem 
  Sum(seq,n+1,n) = seq.(n+1);

theorem 
  for X being ComplexHilbertSpace, seq being sequence of X
  holds seq is summable iff for r st r > 0 ex k
  st for n, m st n >= k & m >= k holds ||.Sum(seq, n) - Sum(seq, m).|| < r;

theorem 
  for X being ComplexHilbertSpace, seq being sequence of X
  holds seq is summable iff for r st r > 0 ex k st for
  n, m st n>=k & m>=k holds ||.Sum(seq, n, m).|| < r;

definition
  let Cseq, n;
  func Sum(Cseq,n) -> Complex equals

  Partial_Sums(Cseq).n;
end;

definition
  let Cseq, n,m;
  func Sum(Cseq,n,m) -> Complex equals

  Sum(Cseq,n) - Sum(Cseq,m);
end;

definition
  let X, seq;
  attr seq is absolutely_summable means


  ||.seq.|| is summable;
end;

theorem 
  seq1 is absolutely_summable & seq2 is absolutely_summable implies seq1
  + seq2 is absolutely_summable;

theorem 
  seq is absolutely_summable implies z * seq is absolutely_summable;

theorem 
  ( for n holds ||.seq.||.n <= Rseq.n ) & Rseq is summable implies seq
  is absolutely_summable;

theorem 
  ( for n holds seq.n <> 0.X & Rseq.n = ||.seq.(n+1).||/||.seq.n.|| ) &
  Rseq is convergent & lim Rseq < 1 implies seq is absolutely_summable;

theorem 
  r > 0 & ( ex m st for n st n >= m holds ||.seq.n.|| >= r)
  implies not seq is convergent or lim seq <> 0.X;

theorem 
  ( for n holds seq.n <> 0.X ) & ( ex m st for n st n >= m holds
  ||.seq.(n+1).||/||.seq.n.|| >= 1 ) implies not seq is summable;

theorem 
  (for n holds seq.n <> 0.X) & (for n holds Rseq.n = ||.seq.(n+1).||/||.
  seq.n.||) & Rseq is convergent & lim Rseq > 1 implies not seq is summable;

theorem 
  ( for n holds Rseq.n = n-root (||.seq.n.||) ) & Rseq is convergent &
  lim Rseq < 1 implies seq is absolutely_summable;

theorem 
  (for n holds Rseq.n = n-root (||.seq.||.n)) & (ex m st for n st n >= m
  holds Rseq.n >= 1) implies not seq is summable;

theorem 
  (for n holds Rseq.n = n-root (||.seq.||.n)) & Rseq is convergent & lim
  Rseq > 1 implies not seq is summable;

theorem 
  Partial_Sums(||.seq.||) is non-decreasing;

theorem 
  for n holds Partial_Sums(||.seq.||).n >= 0;

theorem 
  for n holds ||.Partial_Sums(seq).n.|| <= Partial_Sums(||.seq.||) .n;

theorem 
  for n holds ||.Sum(seq, n).|| <= Sum(||.seq.||, n);

theorem 
  for n, m holds ||.Partial_Sums(seq).m - Partial_Sums(seq).n.||
  <= abs(Partial_Sums(||.seq.||).m - Partial_Sums(||.seq.||).n);

theorem 
  for n,m holds ||.Sum(seq,m)-Sum(seq,n).|| <= abs( Sum(||.seq.||,
  m)-Sum(||.seq.||,n) );

theorem 
  for n,m holds ||.Sum(seq,m,n).|| <= abs(Sum(||.seq.||,m,n));

theorem 
  for X being ComplexHilbertSpace, seq being sequence of X
  holds seq is absolutely_summable implies seq is
  summable;

definition
  let X, seq, Cseq;
  func Cseq * seq -> sequence of X means


  for n holds it.n = Cseq.n * seq.n;
end;

theorem 
  Cseq * (seq1 + seq2) = Cseq * seq1 + Cseq * seq2;

theorem 
  (Cseq1 + Cseq2) * seq = Cseq1 * seq + Cseq2 * seq;

theorem 
  (Cseq1 (#) Cseq2) * seq = Cseq1 * (Cseq2 * seq);

theorem 
  (z (#) Cseq) * seq = z * (Cseq * seq);

theorem 
  Cseq * (- seq) = (- Cseq) * seq;

theorem 
  Cseq is convergent & seq is convergent implies Cseq * seq is convergent;

theorem 
  Cseq is bounded & seq is bounded implies Cseq * seq is bounded;

theorem 
  Cseq is convergent & seq is convergent implies Cseq * seq is
  convergent & lim (Cseq * seq) = lim Cseq * lim seq;

definition
  let Cseq;
  attr Cseq is Cauchy means


  for r st r > 0 ex k st for n, m st n >= k
  & m >= k holds |.((Cseq.n - Cseq.m)).| < r;
end;

theorem 
  for X being ComplexHilbertSpace, seq being sequence of X
  holds seq is Cauchy & Cseq is Cauchy implies Cseq *
  seq is Cauchy;

theorem 
  for n holds Partial_Sums((Cseq - Cseq^\1) * Partial_Sums(seq)).n
  = Partial_Sums(Cseq * seq).(n+1) - (Cseq * Partial_Sums(seq)).(n+1);

theorem 
  for n holds Partial_Sums(Cseq * seq).(n+1) = (Cseq *
Partial_Sums(seq)).(n+1) - Partial_Sums((Cseq^\1 - Cseq) * Partial_Sums(seq)).n
;

theorem 
  for n holds Sum(Cseq*seq,n+1) = (Cseq*Partial_Sums(seq)).(n+1) - Sum((
  Cseq^\1 - Cseq)*Partial_Sums(seq),n);














begin  

reserve x1,x2,z for set;
reserve A,B for non empty set;
reserve f,g,h for Element of Funcs(A,COMPLEX);

definition
  let A;
  func ComplexFuncAdd(A) -> BinOp of Funcs(A,COMPLEX) means


  for f,g being Element of Funcs(A,COMPLEX) holds it.(f,g) = addcomplex.:(f,g);
end;

definition
  let A;
  func ComplexFuncMult(A) -> BinOp of Funcs(A,COMPLEX) means


  for f,g
  being Element of Funcs(A,COMPLEX) holds it.(f,g) = multcomplex.:(f,g);
end;

definition
  let A;
  func ComplexFuncExtMult(A) -> Function of [:COMPLEX,Funcs(A,COMPLEX):],Funcs
  (A,COMPLEX) means


  for z being Element of COMPLEX, f being (Element of Funcs(A,
  COMPLEX)), x being (Element of A) holds (it.[z,f]).x = z*(f.x);
end;

definition
  let A;
  func ComplexFuncZero(A) -> Element of Funcs(A,COMPLEX) equals

  A --> 0;
end;

definition
  let A;
  func ComplexFuncUnit(A) -> Element of Funcs(A,COMPLEX) equals

  A --> 1r;
end;

theorem 
  h = (ComplexFuncAdd(A)).(f,g) iff for x being Element of A holds
  h.x = f.x + g.x;

theorem 
  h = (ComplexFuncMult(A)).(f,g) iff for x being Element of A holds
  h.x = f.x * g.x;

theorem 
  ComplexFuncZero(A) <> ComplexFuncUnit(A);

reserve a,b for Element of COMPLEX;

theorem 
  h = (ComplexFuncExtMult(A)).[a,f] iff for x being Element of A
  holds h.x = a*(f.x);

theorem 
  (ComplexFuncAdd(A)).(f,g) = (ComplexFuncAdd(A)).(g,f);

theorem 
  (ComplexFuncAdd(A)).(f,(ComplexFuncAdd(A)).(g,h)) = (
  ComplexFuncAdd(A)).((ComplexFuncAdd(A)).(f,g),h);

theorem 
  (ComplexFuncMult(A)).(f,g) = (ComplexFuncMult(A)).(g,f);

theorem 
  (ComplexFuncMult(A)).(f,(ComplexFuncMult(A)).(g,h)) = (
  ComplexFuncMult(A)).((ComplexFuncMult(A)).(f,g),h);

theorem 
  (ComplexFuncMult(A)).(ComplexFuncUnit(A),f) = f;

theorem 
  (ComplexFuncAdd(A)).(ComplexFuncZero(A),f) = f;

theorem 
  (ComplexFuncAdd(A)).(f,(ComplexFuncExtMult(A)).[-1r,f]) = ComplexFuncZero(A);

theorem 
  (ComplexFuncExtMult(A)).[1r,f] = f;

theorem 
  for a, b be Complex holds
  (ComplexFuncExtMult(A)).[a,(ComplexFuncExtMult(A)).[b,f]] = (
  ComplexFuncExtMult(A)).[a*b,f];

theorem 
  for a, b be Complex holds
  (ComplexFuncAdd(A)). ((ComplexFuncExtMult(A)).[a,f],(
  ComplexFuncExtMult(A)).[b,f]) = (ComplexFuncExtMult(A)).[a+b,f];

theorem 
  (ComplexFuncMult(A)).(f,(ComplexFuncAdd(A)).(g,h)) = (
  ComplexFuncAdd(A)).((ComplexFuncMult(A)).(f,g),(ComplexFuncMult(A)).(f,h));

theorem 
  (ComplexFuncMult(A)).((ComplexFuncExtMult(A)).[a,f],g) = (
  ComplexFuncExtMult(A)).[a,(ComplexFuncMult(A)).(f,g)];

begin  

theorem 
  ex f,g st (for z st z in A holds (z = x1 implies f.z = 1r) & (z
<>x1 implies f.z = 0)) & for z st z in A holds (z = x1 implies g.z = 0) & (z<>
  x1 implies g.z = 1r);

theorem 
  x1 in A & x2 in A & x1<>x2 & (for z st z in A holds (z=x1
  implies f.z = 1r) & (z<>x1 implies f.z = 0)) & (for z st z in A holds (z=x1
implies g.z = 0) & (z<>x1 implies g.z = 1r)) implies for a,b st (ComplexFuncAdd
  (A)). ((ComplexFuncExtMult(A)).[a,f],(ComplexFuncExtMult(A)).[b,g]) =
  ComplexFuncZero(A) holds a=0c & b=0c;

theorem 
  x1 in A & x2 in A & x1<>x2 implies ex f,g st for a,b st (
ComplexFuncAdd(A)). ((ComplexFuncExtMult(A)).[a,f],(ComplexFuncExtMult(A)).[b,g
  ]) = ComplexFuncZero(A) holds a=0 & b=0;

theorem 
  A = {x1,x2} & x1<>x2 & ( for z st z in A holds (z=x1 implies f.z
= 1r) & (z<>x1 implies f.z = 0) ) & ( for z st z in A holds (z=x1 implies g.z =
  0) & (z<>x1 implies g.z = 1r) ) implies for h holds ex a,b st h = (
ComplexFuncAdd(A)). ((ComplexFuncExtMult(A)).[a,f],(ComplexFuncExtMult(A)).[b,g
  ]);

theorem 
  A = {x1,x2} & x1<>x2 implies ex f,g st for h holds ex a,b st h = (
ComplexFuncAdd(A)). ((ComplexFuncExtMult(A)).[a,f],(ComplexFuncExtMult(A)).[b,g
  ]);

theorem 
  A = {x1,x2} & x1<>x2 implies ex f,g st (for a,b st (
ComplexFuncAdd(A)).((ComplexFuncExtMult(A)).[a,f], (ComplexFuncExtMult(A)).[b,g
  ]) = ComplexFuncZero(A) holds a=0 & b=0) & for h holds ex a,b st h = (
ComplexFuncAdd(A)). ((ComplexFuncExtMult(A)).[a,f],(ComplexFuncExtMult(A)).[b,g
  ]);

definition
  let A;
  func ComplexVectSpace(A) -> strict non empty CLSStruct equals

  CLSStruct(# Funcs(A,COMPLEX), ComplexFuncZero A,
              ComplexFuncAdd A, ComplexFuncExtMult A #);
end;

reserve C for strict non empty CLSStruct,
        u,v,w for Element of C;

registration
  let A;
  cluster ComplexVectSpace A -> Abelian add-associative right_zeroed
    right_complementable vector-distributive scalar-distributive
    scalar-associative scalar-unital for strict non empty CLSStruct;
end;

theorem 
  ex V being strict ComplexLinearSpace st ex u,v being VECTOR of V st (
  for a,b st a*u + b*v = 0.V holds a=0 & b=0) & for w being VECTOR of V
  ex a,b st w = a*u + b*v;

definition
  let A;
  func CRing(A) -> doubleLoopStr equals

  doubleLoopStr(# Funcs(A,COMPLEX), ComplexFuncAdd A, ComplexFuncMult A,
       ComplexFuncUnit A, ComplexFuncZero A #);
end;

registration
  let A;
  cluster CRing A -> non empty strict;
end;

registration
  let A;
  cluster CRing(A) -> unital;
end;

theorem 
  for x,y,z being Element of CRing(A) holds x+y = y+x & (x+y)+z =
x+(y+z) & x+(0.CRing(A)) = x & x is right_complementable & x*y = y*x & (x*y)*z
= x*(y*z) & x*(1.CRing(A)) = x & (1.CRing(A))*x = x & x*(y+z) = x*y + x*z & (y+
  z)*x = y*x + z*x;

theorem 
  CRing(A) is commutative Ring;

definition
  struct(doubleLoopStr,CLSStruct) ComplexAlgebraStr (# carrier -> set, multF,
addF -> (BinOp of the carrier), Mult -> (Function of [:COMPLEX,the carrier:],
    the carrier), OneF,ZeroF -> Element of the carrier #);
end;

registration
  cluster non empty for ComplexAlgebraStr;
end;

definition
  let A;
  func CAlgebra(A) -> strict ComplexAlgebraStr equals

  ComplexAlgebraStr(#Funcs
    (A,COMPLEX),ComplexFuncMult(A),ComplexFuncAdd(A), ComplexFuncExtMult(A),(
    ComplexFuncUnit(A)),(ComplexFuncZero(A))#);
end;

registration
  let A;
  cluster CAlgebra(A) -> non empty;
end;

registration
  let A;
  cluster CAlgebra(A) -> unital;
end;

theorem 
  for x,y,z being Element of CAlgebra(A), a,b holds x + y = y + x
  & (x + y) + z = x + (y + z) & x + (0.CAlgebra(A)) = x & x is
  right_complementable & x * y = y * x & (x * y) * z = x * (y * z) & x * (1.
CAlgebra(A)) = x & x * (y + z) = x * y + x * z & a * (x * y) = (a * x) * y & a
* (x + y) = a * x + a * y & (a + b) * x = a * x + b * x & (a * b) * x = a * (b
  * x);

definition
  let IT be non empty ComplexAlgebraStr;
  attr IT is vector-associative means

 for x,y being Element of IT, a holds a * (x * y) = (a * x) * y;
end;

registration let A;
 cluster CAlgebra A -> strict Abelian add-associative right_zeroed
      right_complementable commutative associative right_unital
      right-distributive vector-distributive scalar-distributive
      scalar-associative vector-associative;
end;

registration
  cluster strict Abelian add-associative right_zeroed right_complementable
    commutative associative right_unital right-distributive vector-distributive
    scalar-distributive scalar-associative vector-associative
     for non empty ComplexAlgebraStr;
end;

definition
  mode ComplexAlgebra is Abelian add-associative right_zeroed
    right_complementable commutative associative right_unital
    right-distributive vector-distributive scalar-distributive
    scalar-associative vector-associative non empty ComplexAlgebraStr;
end;

theorem 
  CAlgebra(A) is ComplexAlgebra;

theorem 
  1.CRing(A) = ComplexFuncUnit(A);

theorem 
  1.CAlgebra(A) = ComplexFuncUnit(A);














begin 

theorem 
  for X,Y,Z be ComplexLinearSpace, f be LinearOperator of X,Y, g be
  LinearOperator of Y,Z holds g*f is LinearOperator of X,Z;

theorem 
  for X,Y,Z be ComplexNormSpace for f be Lipschitzian LinearOperator of
X,Y for g be Lipschitzian LinearOperator of Y,Z holds
g*f is Lipschitzian LinearOperator
  of X,Z & for x be VECTOR of X holds ||.((g*f).x).|| <=(
  BoundedLinearOperatorsNorm(Y,Z).g) *(BoundedLinearOperatorsNorm(X,Y).f )*||.x
.|| & (BoundedLinearOperatorsNorm(X,Z).(g*f)) <=(BoundedLinearOperatorsNorm(Y,Z
  ).g) *(BoundedLinearOperatorsNorm(X,Y).f);

definition
  let X be ComplexNormSpace;
  let f,g be Lipschitzian LinearOperator of X,X;
  redefine func g*f -> Lipschitzian LinearOperator of X,X;
end;

definition
  let X be ComplexNormSpace;
  let f,g be Element of BoundedLinearOperators(X,X);
  func f + g -> Element of BoundedLinearOperators(X,X) equals

  Add_ (
  BoundedLinearOperators(X,X), C_VectorSpace_of_LinearOperators(X,X) ) .(f,g);
end;

definition
  let X be ComplexNormSpace;
  let f,g be Element of BoundedLinearOperators(X,X);
  func g*f -> Element of BoundedLinearOperators(X,X) equals

  modetrans(g,X,X)*
  modetrans(f,X,X);
end;

definition
  let X be ComplexNormSpace;
  let f be Element of BoundedLinearOperators(X,X);
  let z be Complex;
  func z*f -> Element of BoundedLinearOperators(X,X) equals

  Mult_(
  BoundedLinearOperators(X,X), C_VectorSpace_of_LinearOperators(X,X)).(z,f);
end;

definition
  let X be ComplexNormSpace;
  func FuncMult(X) -> BinOp of BoundedLinearOperators(X,X) means


  for f, g being Element of BoundedLinearOperators(X,X) holds it.(f,g) = f*g;
end;

theorem 
  for X be ComplexNormSpace holds id (the carrier of X) is Lipschitzian
  LinearOperator of X,X;

definition
  let X be ComplexNormSpace;
  func FuncUnit(X) -> Element of BoundedLinearOperators(X,X) equals

  id (the carrier of X);
end;

theorem 
  for X be ComplexNormSpace for f,g,h be Lipschitzian LinearOperator of
  X,X holds h = f*g iff for x be VECTOR of X holds h.x = f.(g.x);

theorem 
  for X be ComplexNormSpace for f,g,h be Lipschitzian LinearOperator of
  X,X holds f*(g*h) =(f*g)*h;

theorem 
  for X be ComplexNormSpace for f be Lipschitzian LinearOperator of X,X
  holds f*(id the carrier of X) = f & (id the carrier of X )*f=f;

theorem 
  for X be ComplexNormSpace for f,g,h be Element of
  BoundedLinearOperators(X,X) holds f*(g*h) =(f*g)*h;

theorem 
  for X be ComplexNormSpace for f be Element of
  BoundedLinearOperators(X,X) holds f*FuncUnit(X)= f & FuncUnit(X)*f=f;

theorem 
  for X be ComplexNormSpace for f,g,h be Element of
  BoundedLinearOperators(X,X) holds f *(g+h)=f*g + f*h;

theorem 
  for X be ComplexNormSpace for f,g,h be Element of
  BoundedLinearOperators(X,X) holds (g+h)*f = g*f + h*f;

theorem 
  for X be ComplexNormSpace for f,g be Element of
  BoundedLinearOperators(X,X) for a,b be Complex holds (a*b)*(f*g)=(a*f)*(b*g);

theorem 
  for X be ComplexNormSpace for f,g be Element of
  BoundedLinearOperators(X,X) for a be Complex holds a*(f*g) =(a*f)*g;

definition
  let X be ComplexNormSpace;
  func Ring_of_BoundedLinearOperators(X) -> doubleLoopStr equals

  doubleLoopStr
  (# BoundedLinearOperators(X,X), Add_(BoundedLinearOperators(X,X),
    C_VectorSpace_of_LinearOperators(X,X)), FuncMult(X), FuncUnit(X), Zero_(
    BoundedLinearOperators(X,X),C_VectorSpace_of_LinearOperators(X,X)) #);
end;

registration
  let X be ComplexNormSpace;
  cluster Ring_of_BoundedLinearOperators(X) -> non empty strict;
end;

registration
  let X be ComplexNormSpace;
  cluster Ring_of_BoundedLinearOperators(X) -> unital;
end;

theorem 
  for X be ComplexNormSpace for x,y,z being Element of
  Ring_of_BoundedLinearOperators(X) holds x+y = y+x & (x+y)+z = x+(y+z) & x+(0.
Ring_of_BoundedLinearOperators(X)) = x & x is right_complementable & (x*y)*z =
  x*(y*z) & x*(1.Ring_of_BoundedLinearOperators(X)) = x & (1.
Ring_of_BoundedLinearOperators(X))*x = x & x*(y+z) = x*y + x*z & (y+z)*x = y*x
  + z*x;

theorem 
  for X be ComplexNormSpace holds Ring_of_BoundedLinearOperators(X) is Ring;

registration
  let X be ComplexNormSpace;
  cluster Ring_of_BoundedLinearOperators(X) -> Abelian add-associative
    right_zeroed right_complementable associative well-unital distributive;
end;

definition
  let X be ComplexNormSpace;
  func C_Algebra_of_BoundedLinearOperators(X) -> ComplexAlgebraStr equals

  ComplexAlgebraStr (# BoundedLinearOperators(X,X), FuncMult(X), Add_(
    BoundedLinearOperators(X,X), C_VectorSpace_of_LinearOperators(X,X)), Mult_(
BoundedLinearOperators(X,X), C_VectorSpace_of_LinearOperators(X,X)), FuncUnit(X
), Zero_(BoundedLinearOperators(X,X), C_VectorSpace_of_LinearOperators(X,X)) #)
  ;
end;

registration
  let X be ComplexNormSpace;
  cluster C_Algebra_of_BoundedLinearOperators(X) -> non empty strict;
end;

registration
  let X be ComplexNormSpace;
  cluster C_Algebra_of_BoundedLinearOperators(X) -> unital;
end;

theorem 
  for X be ComplexNormSpace for x,y,z being Element of
C_Algebra_of_BoundedLinearOperators(X) for a,b be Complex holds x+y = y+x & (x+
  y)+z = x+(y+z) & x+(0.C_Algebra_of_BoundedLinearOperators(X)) = x & x is
  right_complementable & (x*y)*z = x*(y*z) & x*(1.
  C_Algebra_of_BoundedLinearOperators(X)) = x & (1.
C_Algebra_of_BoundedLinearOperators(X))*x = x & x*(y+z) = x*y + x*z & (y+z)*x =
y*x + z*x & a*(x*y) = (a*x)*y & a*(x+y) = a*x + a*y & (a+b)*x = a*x + b*x & (a*
  b)*x = a*(b*x) & (a*b)*(x*y)=(a*x)*(b*y);

definition
  mode ComplexBLAlgebra is Abelian add-associative right_zeroed
    right_complementable associative right_unital right-distributive
    vector-distributive scalar-distributive scalar-associative
    vector-associative non empty ComplexAlgebraStr;
end;

registration let X be ComplexNormSpace;
 cluster C_Algebra_of_BoundedLinearOperators X ->
    Abelian add-associative right_zeroed
    right_complementable associative right_unital right-distributive
    vector-distributive scalar-distributive scalar-associative
    vector-associative;
end;

theorem 
  for X be ComplexNormSpace holds C_Algebra_of_BoundedLinearOperators(X)
  is ComplexBLAlgebra;

registration
  cluster Complex_l1_Space -> complete;
end;

registration
  cluster Complex_l1_Space -> non trivial;
end;

registration
  cluster non trivial for ComplexBanachSpace;
end;

theorem 
  for X be non trivial ComplexNormSpace ex w be VECTOR of X st ||. w .|| = 1;

theorem 
  for X be non trivial ComplexNormSpace holds
  BoundedLinearOperatorsNorm(X,X).(id the carrier of X) = 1;

definition
  struct(ComplexAlgebraStr,CNORMSTR) Normed_Complex_AlgebraStr (# carrier ->
set, multF,addF -> (BinOp of the carrier), Mult -> (Function of [:COMPLEX,the
carrier:],the carrier), OneF,ZeroF -> Element of the carrier, normF -> Function
    of the carrier, REAL#);
end;

registration
  cluster non empty for Normed_Complex_AlgebraStr;
end;

definition
  let X be ComplexNormSpace;
  func C_Normed_Algebra_of_BoundedLinearOperators(X) ->
  Normed_Complex_AlgebraStr equals

  Normed_Complex_AlgebraStr (#
    BoundedLinearOperators(X,X), FuncMult(X), Add_(BoundedLinearOperators(X,X),
    C_VectorSpace_of_LinearOperators(X,X)), Mult_(BoundedLinearOperators(X,X),
    C_VectorSpace_of_LinearOperators(X,X)), FuncUnit(X), Zero_(
    BoundedLinearOperators(X,X), C_VectorSpace_of_LinearOperators(X,X)),
    BoundedLinearOperatorsNorm(X,X) #);
end;

registration
  let X be ComplexNormSpace;
  cluster C_Normed_Algebra_of_BoundedLinearOperators(X) -> non empty strict;
end;

registration
  let X be ComplexNormSpace;
  cluster C_Normed_Algebra_of_BoundedLinearOperators(X) -> unital;
end;

theorem 
  for X be ComplexNormSpace for x,y,z being Element of
C_Normed_Algebra_of_BoundedLinearOperators(X) for a,b be Complex holds x+y = y+
x & (x+y)+z = x+(y+z) & x+(0.C_Normed_Algebra_of_BoundedLinearOperators(X)) = x
  & x is right_complementable & (x*y)*z = x*(y*z) & x*(1.
  C_Normed_Algebra_of_BoundedLinearOperators(X)) = x & (1.
C_Normed_Algebra_of_BoundedLinearOperators(X))*x = x & x*(y+z) = x*y + x*z & (y
+z)*x = y*x + z*x & a*(x*y) = (a*x)*y & (a*b)*(x*y)=(a*x)*(b*y) & a*(x+y) = a*x
  + a*y & (a+b)*x = a*x + b*x & (a*b)*x = a*(b*x) & 1r*x =x;

theorem 
  for X be ComplexNormSpace holds
  C_Normed_Algebra_of_BoundedLinearOperators(X) is
  reflexive discerning ComplexNormSpace-like Abelian
  add-associative right_zeroed right_complementable associative right_unital
  right-distributive vector-distributive scalar-distributive
  scalar-associative vector-associative vector-distributive
  scalar-distributive scalar-associative scalar-unital;

registration
  cluster reflexive discerning ComplexNormSpace-like Abelian add-associative
    right_zeroed right_complementable associative right_unital
    right-distributive vector-distributive scalar-distributive
    scalar-associative vector-associative scalar-unital strict for non empty
    Normed_Complex_AlgebraStr;
end;

definition
  mode Normed_Complex_Algebra is
    reflexive discerning ComplexNormSpace-like Abelian add-associative
    right_zeroed right_complementable associative right_unital
    right-distributive vector-distributive vector-associative
    scalar-distributive scalar-associative scalar-unital non empty
    Normed_Complex_AlgebraStr;
end;

registration
  let X be ComplexNormSpace;
  cluster C_Normed_Algebra_of_BoundedLinearOperators(X) ->
    reflexive discerning ComplexNormSpace-like Abelian add-associative
    right_zeroed right_complementable associative right_unital
    right-distributive vector-distributive scalar-associative
    vector-associative scalar-distributive scalar-unital;
end;

definition
  let X be non empty Normed_Complex_AlgebraStr;
  attr X is Banach_Algebra-like_1 means

  for x,y being Element of X holds ||. x*y .|| <= ||.x.|| * ||.y.||;
  attr X is Banach_Algebra-like_2 means


  ||. 1.X .|| = 1;
  attr X is Banach_Algebra-like_3 means

  for a being Complex for x,y being Element of X holds a*(x*y)=x*(a*y);
end;

definition
  let X be Normed_Complex_Algebra;
  attr X is Banach_Algebra-like means


  X is Banach_Algebra-like_1
  Banach_Algebra-like_2 Banach_Algebra-like_3 left_unital left-distributive
  complete;
end;

registration
  cluster Banach_Algebra-like -> Banach_Algebra-like_1 Banach_Algebra-like_2
    Banach_Algebra-like_3 left-distributive left_unital complete
    for Normed_Complex_Algebra;
  cluster Banach_Algebra-like_1 Banach_Algebra-like_2 Banach_Algebra-like_3
    left-distributive left_unital complete -> Banach_Algebra-like
    for Normed_Complex_Algebra;
end;

registration
  let X be non trivial ComplexBanachSpace;
  cluster C_Normed_Algebra_of_BoundedLinearOperators(X) -> Banach_Algebra-like;
end;

registration
  cluster Banach_Algebra-like for Normed_Complex_Algebra;
end;

definition
  mode Complex_Banach_Algebra is Banach_Algebra-like Normed_Complex_Algebra;
end;

theorem 
  for X being ComplexNormSpace holds 1.Ring_of_BoundedLinearOperators(X)
  = FuncUnit(X);

theorem 
  for X being ComplexNormSpace holds 1.
  C_Algebra_of_BoundedLinearOperators(X) = FuncUnit(X);

theorem 
  for X being ComplexNormSpace holds 1.
  C_Normed_Algebra_of_BoundedLinearOperators(X) = FuncUnit(X);














begin 

reserve n,m for Element of NAT;
reserve x,X,X1 for set;
reserve s,g,r,p for Real;
reserve S,T for RealNormSpace;
reserve f,f1,f2 for PartFunc of S,T;
reserve s1,s2 for sequence of S;
reserve x0,x1,x2 for Point of S;
reserve Y for Subset of S;

theorem 
  for S being non empty addLoopStr for seq1,seq2 be sequence of S holds
  seq1 - seq2 = seq1 +- seq2;

theorem 
  for seq be sequence of S holds -seq=(-1)*seq;

definition
  let S, x0;

  mode Neighbourhood of x0 -> Subset of S means


    ex g be Real st 0<g & { y where y is Point of S: ||.y-x0 .|| < g} c= it;
end;

theorem 
  for g be Real st 0<g holds
  {y where y is Point of S: ||.y-x0 .|| < g} is Neighbourhood of x0;

theorem 
  for N being Neighbourhood of x0 holds x0 in N;

definition
  let S;
  let X be Subset of S;
  attr X is compact means


  for s1 be sequence of S st rng s1 c= X
  ex s2 be sequence of S st s2 is subsequence of s1 & s2 is convergent &
  lim s2 in X;
end;

definition
  let S;
  let X be Subset of S;
  attr X is closed means

  for s1 be sequence of S st rng s1 c= X & s1 is convergent holds lim s1 in X;
end;

definition
  let S;
  let X be Subset of S;
  attr X is open means

  X` is closed;
end;

definition

  let S,T;
  let f,x0;
  pred f is_continuous_in x0 means


  x0 in dom f & for s1 st rng s1 c= dom f & s1 is convergent & lim s1 = x0
  holds f/*s1 is convergent & f/.x0 = lim (f/*s1);
end;

definition
  let S;
  let f be PartFunc of the carrier of S,REAL;
  let x0;
  pred f is_continuous_in x0 means


  x0 in dom f & for s1 st rng s1 c= dom f & s1 is convergent & lim s1 = x0
  holds f/*s1 is convergent & f/.x0 = lim (f/*s1);
end;

theorem 
  for seq be sequence of S, h be PartFunc of S,T st rng seq c= dom h holds
  seq.n in dom h;

theorem 
  for seq be sequence of S, x be set holds x in rng seq iff ex n st x = seq.n;

theorem 
  f is_continuous_in x0 iff x0 in dom f & for r st 0<r ex s st 0<s
  & for x1 st x1 in dom f & ||. x1- x0 .|| <s holds ||. f/.x1-f/.x0 .||<r;

theorem 
  for f be PartFunc of the carrier of S,REAL holds (f
  is_continuous_in x0 iff x0 in dom f & for r st 0<r ex s st 0<s & for x1 st x1
  in dom f & ||. x1- x0 .|| <s holds abs( f/.x1-f/.x0 )<r );

theorem 
  for f,x0 holds f is_continuous_in x0 iff x0 in dom f & for N1
being Neighbourhood of f/.x0 ex N being Neighbourhood of x0 st for x1 st x1 in
  dom f & x1 in N holds f/.x1 in N1;

theorem 
  for f,x0 holds f is_continuous_in x0 iff x0 in dom f & for N1
  being Neighbourhood of f/.x0 ex N being Neighbourhood of x0 st f.:N c= N1;

theorem 
  x0 in dom f & (ex N be Neighbourhood of x0 st dom f /\ N = {x0})
  implies f is_continuous_in x0;

theorem 
  for h1,h2 be PartFunc of S,T for seq be sequence of S st rng seq
c= dom h1 /\ dom h2 holds (h1+h2)/*seq=h1/*seq+h2/*seq & (h1-h2)/*seq=h1/*seq-
  h2/*seq;

theorem 
  for h be PartFunc of S,T for seq be sequence of S for r be Real
  st rng seq c= dom h holds (r(#)h)/*seq = r*(h/*seq);

theorem 
  for h be PartFunc of S,T for seq be sequence of S st rng seq c=
  dom h holds ||.h/*seq .|| = ||.h.||/*seq & -(h/*seq) = (-h)/*seq;

theorem 
  f1 is_continuous_in x0 & f2 is_continuous_in x0 implies f1+f2
  is_continuous_in x0 & f1-f2 is_continuous_in x0;

theorem 
  f is_continuous_in x0 implies r(#)f is_continuous_in x0;

theorem 
  f is_continuous_in x0 implies ||. f .|| is_continuous_in x0 & -f
  is_continuous_in x0;

definition
  let S,T;
  let f,X;
  pred f is_continuous_on X means


  X c= dom f & for x0 st x0 in X holds f|X is_continuous_in x0;
end;

definition
  let S;
  let f be PartFunc of the carrier of S, REAL;
  let X;
  pred f is_continuous_on X means


  X c= dom f & for x0 st x0 in X holds f|X is_continuous_in x0;
end;

theorem 
  for X,f holds f is_continuous_on X iff X c= dom f & for s1 st
  rng s1 c= X & s1 is convergent & lim s1 in X holds f/*s1 is convergent & f/.(
  lim s1) = lim (f/*s1);

theorem 
  f is_continuous_on X iff X c= dom f & for x0,r st x0 in X & 0<r
  ex s st 0<s & for x1 st x1 in X & ||. x1- x0 .|| < s holds ||. f/.x1 - f/.x0
  .|| < r;

theorem 
  for f be PartFunc of the carrier of S, REAL holds ( f is_continuous_on
X iff X c= dom f & for x0,r st x0 in X & 0<r ex s st 0<s & for x1 st x1 in X &
  ||. x1- x0 .|| < s holds abs( f/.x1 - f/.x0 ) < r );

theorem 
  f is_continuous_on X iff f|X is_continuous_on X;

theorem 
  for f be PartFunc of the carrier of S,REAL holds (f
  is_continuous_on X iff f|X is_continuous_on X);

theorem 
  f is_continuous_on X & X1 c= X implies f is_continuous_on X1;

theorem 
  x0 in dom f implies f is_continuous_on {x0};

theorem 
  for X,f1,f2 st f1 is_continuous_on X & f2 is_continuous_on X
  holds f1+f2 is_continuous_on X & f1-f2 is_continuous_on X;

theorem 
  for X,X1,f1,f2 st f1 is_continuous_on X & f2 is_continuous_on X1 holds
  f1+f2 is_continuous_on X /\ X1 & f1-f2 is_continuous_on X /\ X1;

theorem 
  for r,X,f st f is_continuous_on X holds r(#)f is_continuous_on X;

theorem 
  f is_continuous_on X implies ||.f.|| is_continuous_on X & -f
  is_continuous_on X;

theorem 
  f is total & (for x1,x2 holds f/.(x1+x2) = f/.x1 + f/.x2) & (ex x0 st
  f is_continuous_in x0) implies f is_continuous_on the carrier of S;

theorem 
  for f st dom f is compact & f is_continuous_on (dom f) holds (
  rng f) is compact;

theorem 
  for f be PartFunc of the carrier of S, REAL st dom f is compact
  & f is_continuous_on dom f holds rng f is compact;

theorem 
  Y c= dom f & Y is compact & f is_continuous_on Y implies (f.:Y) is compact;

theorem 
  for f be PartFunc of the carrier of S,REAL st dom f<>{} & (dom f
) is compact & f is_continuous_on (dom f) ex x1,x2 st x1 in dom f & x2 in dom f
  & f/.x1 = upper_bound (rng f) & f/.x2 = lower_bound (rng f);

theorem 
  for f st dom f<>{} & (dom f) is compact & f is_continuous_on (
  dom f) ex x1,x2 st x1 in dom f & x2 in dom f & ||.f.||/.x1 = upper_bound (rng
  ||.f.||) & ||.f.||/.x2 = lower_bound (rng ||.f.||);

theorem 
  (||.f.||)|X = ||.(f|X).||;

theorem 
  for f,Y st Y<>{} & Y c= dom f & Y is compact & f is_continuous_on Y ex
x1,x2 st x1 in Y & x2 in Y & ||.f.||/.x1 = upper_bound (||.f.||.:Y) & ||.f.||/.
  x2 = lower_bound (||.f.||.:Y);

theorem 
  for f be PartFunc of the carrier of S,REAL for Y st Y<>{} & Y c= dom f
  & Y is compact & f is_continuous_on Y ex x1,x2 st x1 in Y & x2 in Y & f/.x1 =
  upper_bound (f.:Y) & f/.x2 = lower_bound (f.:Y);

definition
  let S,T;
  let X,f;
  pred f is_Lipschitzian_on X means


  X c= dom f & ex r st 0<r & for x1,
  x2 st x1 in X & x2 in X holds ||.f/.x1-f/.x2.||<=r*||.x1-x2.||;
end;

definition
  let S;
  let X;
  let f be PartFunc of the carrier of S,REAL;
  pred f is_Lipschitzian_on X means


  X c= dom f & ex r st 0<r & for x1,
  x2 st x1 in X & x2 in X holds abs(f/.x1-f/.x2)<=r*||.x1-x2.||;
end;

theorem 
  f is_Lipschitzian_on X & X1 c= X implies f is_Lipschitzian_on X1;

theorem 
  f1 is_Lipschitzian_on X & f2 is_Lipschitzian_on X1 implies f1+f2
  is_Lipschitzian_on X /\ X1;

theorem 
  f1 is_Lipschitzian_on X & f2 is_Lipschitzian_on X1 implies f1-f2
  is_Lipschitzian_on X /\ X1;

theorem 
  f is_Lipschitzian_on X implies p(#)f is_Lipschitzian_on X;

theorem 
  f is_Lipschitzian_on X implies -f is_Lipschitzian_on X & ||.f.||
  is_Lipschitzian_on X;

theorem 
  X c= dom f & f|X is constant implies f is_Lipschitzian_on X;

theorem 
  id Y is_Lipschitzian_on Y;

theorem 
  f is_Lipschitzian_on X implies f is_continuous_on X;

theorem 
  for f be PartFunc of the carrier of S, REAL st f
  is_Lipschitzian_on X holds f is_continuous_on X;

theorem 
  for f st (ex r be Point of T st rng f = {r}) holds f is_continuous_on (dom f)
;

theorem 
  X c= dom f & f|X is constant implies f is_continuous_on X;

theorem 
  for f be PartFunc of S,S st (for x0 st x0 in dom f holds f/.x0 =
  x0) holds f is_continuous_on dom f;

theorem 
  for f be PartFunc of S,S st f = id dom f holds f is_continuous_on dom f;

theorem 
  for f be PartFunc of S,S st Y c= dom f & f|Y = id Y holds f
  is_continuous_on Y;

theorem 
  for f be PartFunc of S,S for r be Real for p be Point of S holds (X c=
dom f & (for x0 st x0 in X holds f/.x0 = r*x0+p) implies f is_continuous_on X )
;

theorem 
  for f be PartFunc of the carrier of S,REAL st (for x0 st x0 in
  dom f holds f/.x0 = ||. x0.|| ) holds f is_continuous_on (dom f);

theorem 
  for f be PartFunc of the carrier of S,REAL st X c= dom f & (for x0 st
  x0 in X holds f/.x0 = ||. x0.||) holds f is_continuous_on X;














begin 

reserve n,m for Element of NAT,
  x,X,X1 for set,
  s,g,r,p for Real,
  S,T for RealNormSpace,
  f,f1,f2 for PartFunc of S, T,
  s1,s2,q1 for sequence of S,
  x0,x1, x2 for Point of S,
  Y for Subset of S;

definition
  let X,S,T;
  let f;
  pred f is_uniformly_continuous_on X means


  X c= dom f & for r st 0<r
ex s st 0<s & for x1,x2 st x1 in X & x2 in X & ||.x1 - x2.|| < s holds ||. f/.
  x1 - f/.x2 .|| < r;
end;

definition
  let X,S;
  let f be PartFunc of the carrier of S,REAL;
  pred f is_uniformly_continuous_on X means


  X c= dom f & for r st 0<r
ex s st 0<s & for x1,x2 st x1 in X & x2 in X & ||.x1 - x2.|| < s holds abs(f/.
  x1 - f/.x2) < r;
end;

theorem 
  f is_uniformly_continuous_on X & X1 c= X implies f
  is_uniformly_continuous_on X1;

theorem 
  f1 is_uniformly_continuous_on X & f2 is_uniformly_continuous_on X1
  implies f1+f2 is_uniformly_continuous_on X/\X1;

theorem 
  f1 is_uniformly_continuous_on X & f2 is_uniformly_continuous_on X1
  implies f1-f2 is_uniformly_continuous_on X/\X1;

theorem 
  f is_uniformly_continuous_on X implies p(#)f is_uniformly_continuous_on X;

theorem 
  f is_uniformly_continuous_on X implies -f is_uniformly_continuous_on X;

theorem 
  f is_uniformly_continuous_on X implies ||.f .|| is_uniformly_continuous_on X;

theorem 
  f is_uniformly_continuous_on X implies f is_continuous_on X;

theorem 
  for f be PartFunc of the carrier of S, REAL st f
  is_uniformly_continuous_on X holds f is_continuous_on X;

theorem 
  f is_Lipschitzian_on X implies f is_uniformly_continuous_on X;

theorem 
  for f, Y st Y is compact & f is_continuous_on Y holds f
  is_uniformly_continuous_on Y;

theorem 
  Y c= dom f & Y is compact & f is_uniformly_continuous_on Y implies f.:
  Y is compact;

theorem 
  for f be PartFunc of the carrier of S, REAL for Y st Y <> {} & Y c=
dom f & Y is compact & f is_uniformly_continuous_on Y ex x1,x2 st x1 in Y & x2
in Y & f/.x1 = upper_bound (f.:Y) & f/.x2 = lower_bound (f.:Y);

theorem 
  X c= dom f & f|X is constant implies f is_uniformly_continuous_on X;

begin 

definition
  let M be non empty NORMSTR;
  let f be Function of M,M;
  attr f is contraction  means


    ex L being Real st 0 < L & L < 1 & for x,y being Point of M holds
    ||.f.x - f.y.|| <=L*||.x - y.||;
end;

registration
 let M be RealNormSpace;
 cluster contraction for Function of M,M;
end;

definition
 let M be RealNormSpace;
  mode Contraction of M is contraction Function of M,M;
end;

theorem 
  for X be RealBanachSpace
  for f be Function of X, X st f is Contraction of X
   ex xp be Point of X st f.xp=xp & for x be Point of X st f.x=x
  holds xp=x;

theorem 
  for X be RealBanachSpace for f be Function of X,X st ex n0 be Element
   of NAT st iter(f,n0) is Contraction of X
   ex xp be Point of X st f.xp=xp &
  for x be Point of X st f.x=x holds xp=x;

theorem 
  for K, L, e be real number st 0 < K & K < 1 & 0 < e ex n be Element of
  NAT st abs (L * (K to_power n)) < e;














begin 

theorem 
  for X be add-associative right_zeroed right_complementable non
empty CNORMSTR for seq be sequence of X st (for n be Element of NAT holds seq.
  n = 0.X) holds for m be Element of NAT holds (Partial_Sums seq).m = 0.X;

definition
  let X be ComplexNormSpace;

  let seq be sequence of X;
  attr seq is summable means


  Partial_Sums seq is convergent;
end;

registration
  let X be ComplexNormSpace;
  cluster summable for sequence of X;
end;

definition
  let X be ComplexNormSpace;
  let seq be sequence of X;
  func Sum seq -> Element of X equals

  lim Partial_Sums seq;
end;

definition
  let X be ComplexNormSpace;
  let seq be sequence of X;
  attr seq is norm_summable means


  ||.seq.|| is summable;
end;

theorem 
  for X be ComplexNormSpace, seq be sequence of X, m be Element of
  NAT holds 0 <= ||.seq.||.m;

theorem 
  for X be ComplexNormSpace, x,y,z be Element of X holds ||.x-y.||
  = ||.(x-z)+(z-y).||;

theorem 
  for X be ComplexNormSpace, seq be sequence of X holds seq is
  convergent implies for s be Real st 0 < s ex n be Element of NAT st for m be
  Element of NAT st n<=m holds ||.seq.m -seq.n.||<s;

theorem 
  for X be ComplexNormSpace, seq be sequence of X holds seq is
Cauchy_sequence_by_Norm iff for p be Real st p > 0 holds ex n be Element of NAT
  st for m be Element of NAT st n <= m holds ||.seq.m-seq.n.||< p;

theorem 
  for X be ComplexNormSpace, seq be sequence of X st (for n be
  Element of NAT holds seq.n = 0.X) holds for m be Element of NAT holds (
  Partial_Sums ||.seq.||).m = 0;

theorem 
  for X be ComplexNormSpace, seq,seq1 be sequence of X holds seq1
  is subsequence of seq & seq is convergent implies seq1 is convergent;

theorem 
  for X be ComplexNormSpace, seq,seq1 be sequence of X holds seq1
  is subsequence of seq & seq is convergent implies lim seq1=lim seq;



theorem 
  for X be ComplexNormSpace, seq,seq1 be sequence of X, k be Element of
NAT holds seq is convergent implies (seq ^\k) is convergent & lim (seq ^\k)=lim
  seq;

theorem 
  for X be ComplexNormSpace, seq,seq1 be sequence of X holds seq
  is convergent & (ex k be Element of NAT st seq=seq1 ^\k) implies seq1 is
  convergent;

theorem 
  for X be ComplexNormSpace, seq,seq1 be sequence of X holds seq
is convergent & (ex k be Element of NAT st seq=seq1 ^\k) implies lim seq1 =lim
  seq;

theorem 
  for X be ComplexNormSpace, seq be sequence of X holds seq is
  constant implies seq is convergent;

theorem 
  for X be ComplexNormSpace, seq be sequence of X st (for n be
  Element of NAT holds seq.n = 0.X) holds seq is norm_summable;

registration
  let X be ComplexNormSpace;
  cluster norm_summable for sequence of X;
end;



theorem 
  for X be ComplexNormSpace, s be sequence of X holds s is
  summable implies s is convergent & lim s = 0.X;

theorem 
  for X be ComplexNormSpace, s1,s2 be sequence of X holds
  Partial_Sums(s1)+Partial_Sums(s2) = Partial_Sums(s1+s2);

theorem 
  for X be ComplexNormSpace, s1,s2 be sequence of X holds
  Partial_Sums(s1)-Partial_Sums(s2) = Partial_Sums(s1-s2);

registration
  let X be ComplexNormSpace;
  let seq be norm_summable sequence of X;
  cluster ||.seq.|| -> summable for Real_Sequence;
end;

registration
  let X be ComplexNormSpace;
  cluster summable -> convergent for sequence of X;
end;

theorem 
  for X be ComplexNormSpace, seq1,seq2 be sequence of X st seq1 is
summable & seq2 is summable holds seq1+seq2 is summable & Sum(seq1+seq2) = Sum(
  seq1)+Sum(seq2);

theorem 
  for X be ComplexNormSpace, seq1,seq2 be sequence of X st seq1 is
summable & seq2 is summable holds seq1-seq2 is summable & Sum(seq1-seq2)= Sum(
  seq1)-Sum(seq2);

registration
  let X be ComplexNormSpace;
  let seq1,seq2 be summable sequence of X;
  cluster seq1 + seq2 -> summable;
  cluster seq1 - seq2 -> summable;
end;

theorem 
  for X be ComplexNormSpace, seq be sequence of X, z be Complex
  holds Partial_Sums(z * seq) = z * Partial_Sums(seq);

theorem 
  for X be ComplexNormSpace, seq be summable sequence of X, z be
  Complex holds z *seq is summable & Sum(z *seq)= z * Sum(seq);

registration
  let X be ComplexNormSpace;
  let z be Complex, seq be summable sequence of X;
  cluster z *seq -> summable;
end;

theorem 
  for X be ComplexNormSpace, s,s1 be sequence of X st for n be
Element of NAT holds s1.n=s.0 holds Partial_Sums(s^\1) = (Partial_Sums(s)^\1) -
  s1;

theorem 
  for X be ComplexNormSpace, s be sequence of X holds s is
  summable implies for n be Element of NAT holds s^\n is summable;

registration
  let X be ComplexNormSpace;
  let seq be summable sequence of X, n be Element of NAT;
  cluster seq^\n -> summable for sequence of X;
end;

theorem 
  for X be ComplexNormSpace, seq be sequence of X holds
  Partial_Sums ||.seq.|| is bounded_above iff seq is norm_summable;

registration
  let X be ComplexNormSpace;
  let seq be norm_summable sequence of X;
  cluster Partial_Sums ||.seq.|| -> bounded_above for Real_Sequence;
end;

theorem 
  for X be ComplexBanachSpace, seq be sequence of X holds seq is
  summable iff for p be Real st 0 <p holds ex n be Element of NAT st for m be
Element of NAT st n <= m holds ||.Partial_Sums(seq).m-Partial_Sums(seq).n.||<p;

theorem 
  for X be ComplexNormSpace, s be sequence of X, n,m be Element of
  NAT st n<=m holds ||.Partial_Sums(s).m - Partial_Sums(s).n.|| <= abs(
  Partial_Sums(||.s.||).m - Partial_Sums(||.s.||).n);

theorem 
  for X be ComplexBanachSpace, seq be sequence of X holds seq is
  norm_summable implies seq is summable;

theorem 
  for X be ComplexNormSpace, rseq1 be Real_Sequence, seq2 be sequence of
X holds rseq1 is summable & (ex m be Element of NAT st for n be Element of NAT
  st m<=n holds ||.seq2.n.|| <= rseq1.n ) implies seq2 is norm_summable;

theorem 
  for X be ComplexNormSpace, seq1,seq2 be sequence of X holds (for n be
  Element of NAT holds 0 <= ||.seq1.||.n & ||.seq1.||.n <= ||.seq2.||.n) & seq2
is norm_summable implies seq1 is norm_summable & Sum ||.seq1.|| <= Sum ||.seq2
  .||;

theorem 
  for X be ComplexNormSpace, seq be sequence of X holds (for n be
  Element of NAT holds ||.seq.||.n>0) & (ex m be Element of NAT st for n be
Element of NAT st n >=m holds ||.seq.||.(n+1)/||.seq.||.n >= 1) implies not seq
  is norm_summable;

theorem 
  for X be ComplexNormSpace, seq be sequence of X, rseq1 be
Real_Sequence holds (for n be Element of NAT holds rseq1.n = n-root (||.seq.||.
  n)) & rseq1 is convergent & lim rseq1 < 1 implies seq is norm_summable;

theorem 
  for X be ComplexNormSpace, seq be sequence of X, rseq1 be
Real_Sequence holds (for n be Element of NAT holds rseq1.n = n-root (||.seq.||.
n)) & (ex m be Element of NAT st for n be Element of NAT st m<=n holds rseq1.n
  >= 1) implies ||.seq.|| is not summable;

theorem 
  for X be ComplexNormSpace, seq be sequence of X, rseq1 be
Real_Sequence holds (for n be Element of NAT holds rseq1.n = n-root (||.seq.||.
  n)) & rseq1 is convergent & lim rseq1 > 1 implies seq is not norm_summable;

theorem 
  for X be ComplexNormSpace, seq be sequence of X, rseq1 be
  Real_Sequence st ||.seq.|| is non-increasing & (for n be Element of NAT holds
  rseq1.n = 2 to_power n *||.seq.||.(2 to_power n)) holds (seq is norm_summable
  iff rseq1 is summable);

theorem 
  for X be ComplexNormSpace, seq be sequence of X, p be Real st p>1 & (
for n be Element of NAT st n >=1 holds ||.seq.||.n = 1/ (n to_power p) ) holds
  seq is norm_summable;

theorem 
  for X be ComplexNormSpace, seq be sequence of X, p be Real holds p<=1
  & (for n be Element of NAT st n >=1 holds ||.seq.||.n=1/n to_power p) implies
  not seq is norm_summable;

theorem 
  for X be ComplexNormSpace, seq be sequence of X, rseq1 be
Real_Sequence holds (for n be Element of NAT holds seq.n<>0.X & rseq1.n=||.seq
  .||.(n+1)/||.seq.||.n) & rseq1 is convergent & lim rseq1 < 1 implies seq is
  norm_summable;

theorem 
  for X be ComplexNormSpace, seq be sequence of X holds (for n be
Element of NAT holds seq.n<>0.X) & (ex m be Element of NAT st for n be Element
  of NAT st n >=m holds ||.seq.||.(n+1)/||.seq.||.n >= 1) implies seq is not
  norm_summable;

registration
  let X be ComplexBanachSpace;
  cluster norm_summable -> summable for sequence of X;
end;

begin 

theorem 
  for X be Complex_Banach_Algebra holds for x,y,z being Element of
  X, a,b be Element of COMPLEX holds
  x+y = y+x & (x+y)+z = x+(y+z) & x+(0.X) = x & (ex t
being Element of X st x+t= 0.X) & (x*y)*z = x*(y*z) & 1r*x=x & 0c*x=0.X & a*0.X
=0.X& (-1r)*x=-x & x*(1.X) = x & (1.X)*x = x & x*(y+z) = x*y + x*z & (y+z)*x =
y*x + z*x & a*(x*y) = (a*x)*y & a*(x+y) = a*x + a*y & (a+b)*x = a*x + b*x & (a*
b)*x = a*(b*x) & (a*b)*(x*y)=(a*x)*(b*y) & a*(x*y)=x*(a*y) & 0.X * x = 0.X & x*
0.X =0.X & x*(y-z) = x*y-x*z & (y-z)*x = y*x-z*x & x+y-z = x+(y-z) & x-y+z = x-
(y-z) & x-y-z = x-(y+z) & x+y=(x-z)+(z+y) & x-y=(x-z)+(z-y) & x=(x-y)+y & x=y-(
  y-x) & ( ||.x.|| = 0 iff x = 0.X ) & ||.a * x.|| = |.a.| * ||.x.|| & ||.x + y
.|| <= ||.x.|| + ||.y.|| & ||. x*y .|| <= ||.x.|| * ||.y.|| & ||. 1.X .|| = 1 &
  X is complete;

registration
  cluster -> well-unital for Complex_Banach_Algebra;
end;

definition
  let X be non empty Normed_Complex_AlgebraStr;
  let S be sequence of X;
  let a be Element of X;

  func a * S -> sequence of X means

  for n be Element of NAT holds it.n = a * S .n;
end;

definition
  let X be non empty Normed_Complex_AlgebraStr;
  let S be sequence of X;
  let a be Element of X;
  func S*a -> sequence of X means

  for n be Element of NAT holds it.n = S.n*a;
end;

definition
  let X be non empty Normed_Complex_AlgebraStr;
  let seq1,seq2 be sequence of X;
  func seq1 * seq2 -> sequence of X means

  for n be Element of NAT holds it.n = seq1.n * seq2.n;
end;

definition
  let X be Complex_Banach_Algebra;
  let z be Element of X;

  func z GeoSeq -> sequence of X means


  it.0 = 1.X & for n be Element of NAT holds it.(n+1) = it.n * z;
end;

definition
  let X be Complex_Banach_Algebra;
  let z be Element of X, n be Element of NAT;
  func z #N n -> Element of X equals

  z GeoSeq.n;
end;

theorem 
  for X be Complex_Banach_Algebra, z be Element of X holds z #N 0 = 1.X;

theorem 
  for X be Complex_Banach_Algebra, z be Element of X holds ||.z.||
  < 1 implies z GeoSeq is summable norm_summable;

theorem 
  for X be Complex_Banach_Algebra, x be Point of X st ||.1.X - x .|| < 1
holds (1.X - x) GeoSeq is summable & (1.X - x) GeoSeq is norm_summable;

theorem 
  for X be Complex_Banach_Algebra, x be Point of X st ||.1.X - x .|| < 1
  holds x is invertible & x" = Sum ((1.X - x) GeoSeq );














begin 

reserve X for Complex_Banach_Algebra,
  w,z,z1,z2 for Element of X,
  k,l,m,n,n1, n2 for Element of NAT,
  seq,seq1,seq2,s,s9 for sequence of X,
  rseq for Real_Sequence;

theorem 
  seq1 is convergent & seq2 is convergent & lim(seq1-seq2)=0.X
  implies lim seq1 = lim seq2;

theorem 
  for z st for n being Element of NAT holds s.n = z holds lim s = z;

theorem 
  s is convergent & s9 is convergent implies s * s9 is convergent;

theorem 
  s is convergent implies z * s is convergent;

theorem 
  s is convergent implies s*z is convergent;

theorem 
  s is convergent implies lim (z * s) =z* lim(s);

theorem 
  s is convergent implies lim (s*z) = lim(s)*z;

theorem 
  s is convergent & s9 is convergent implies lim(s*s9)=(lim s)*(lim s9);

theorem 
  Partial_Sums(z * seq) = z * Partial_Sums(seq) & Partial_Sums(seq
  *z ) = Partial_Sums(seq) *z;

theorem 
  ||.Partial_Sums(seq).k.|| <= Partial_Sums(||.seq.||).k;

theorem 
  (for n st n <= m holds seq1.n = seq2.n) implies Partial_Sums(
  seq1).m =Partial_Sums(seq2).m;

theorem 
  (for n holds ||. seq.n .|| <= rseq.n) & rseq is convergent & lim
  (rseq)=0 implies seq is convergent & lim(seq)=0.X;

definition
  let X,z;
  func z ExpSeq -> sequence of X means


  for n holds it.n = 1r/(n!) * (z #N n);
end;

scheme 

  ExNormSpaceCASE {CNS()->non empty Complex_Banach_Algebra, F(Element of NAT,
Element of NAT)-> Point of CNS() }: for k holds ex seq be sequence of CNS() st
for n holds (n <= k implies seq.n=F(k,n)) & (n > k implies seq.n=0.CNS());

definition
  let n,X,z,w;

  func Expan(n,z,w) -> sequence of X means


  for k be Element of NAT
holds ( k <= n implies it.k=((Coef(n)).k) * (z #N k) * (w #N (n-' k)) ) & (n <
  k implies it.k=0.X);
end;

definition
  let n,X,z,w;
  func Expan_e(n,z,w) -> sequence of X means


  for k be Element of NAT
holds ( k <= n implies it.k=((Coef_e(n)).k) * (z #N k) * (w #N (n-' k)) ) & ( n
  < k implies it.k=0.X );
end;

definition
  let n,X,z,w;
  func Alfa(n,z,w) -> sequence of X means


  for k be Element of NAT holds
( k <= n implies it.k= (z ExpSeq).k * Partial_Sums(w ExpSeq).(n-'k) ) & ( n < k
  implies it.k=0.X);
end;

definition
  let X,z,w,n;
  func Conj(n,z,w) -> sequence of X means


  for k be Element of NAT holds
( k <= n implies it.k= (z ExpSeq).k * (Partial_Sums(w ExpSeq).n -Partial_Sums(w
  ExpSeq).(n-'k))) & ( n < k implies it.k=0.X );
end;

theorem 
  z ExpSeq.(n+1) = (1r/(n+1) * z) * (z ExpSeq.n) & z ExpSeq.0=1.X
  & ||.(z ExpSeq).n.|| <= (||.z.|| rExpSeq ).n;

theorem 
  0 < k implies (Shift seq).k=seq.(k -' 1);

theorem 
  Partial_Sums(seq).k=Partial_Sums(Shift seq).k+seq.k;

theorem 
  for z,w st z,w are_commutative holds (z+w) #N n = Partial_Sums(
  Expan(n,z,w)).n;

theorem 
  Expan_e(n,z,w) = (1r/(n!)) * Expan(n,z,w);

theorem 
  for z,w st z,w are_commutative holds 1r/(n!) *((z+w) #N n) =
  Partial_Sums(Expan_e(n,z,w)).n;

theorem 
  0.X ExpSeq is norm_summable & Sum(0.X ExpSeq)=1.X;

registration
  let X;
  let z be Element of X;
  cluster z ExpSeq -> norm_summable;
end;

theorem 
  (z ExpSeq).0 = 1.X & Expan(0,z,w).0 = 1.X;

theorem 
  l <= k implies (Alfa(k+1,z,w)).l = (Alfa(k,z,w)).l + Expan_e(k+1 ,z,w).l;

theorem 
  Partial_Sums((Alfa(k+1,z,w))).k = (Partial_Sums( Alfa(k,z,w) )).
  k + (Partial_Sums( Expan_e(k+1,z,w) )).k;

theorem 
  (z ExpSeq).k=(Expan_e(k,z,w)).k;

theorem 
  for z,w st z,w are_commutative holds Partial_Sums((z+w) ExpSeq).
  n = Partial_Sums(Alfa(n,z,w)).n;

theorem 
  for z,w st z,w are_commutative holds Partial_Sums(z ExpSeq).k *
Partial_Sums(w ExpSeq).k - Partial_Sums((z+w) ExpSeq).k = Partial_Sums(Conj(k,z
  ,w)).k;

theorem 
  0 <= (||. z .|| rExpSeq).n;

theorem 
  ||. Partial_Sums((z ExpSeq)).k .|| <= Partial_Sums(||.z.||
  rExpSeq).k & Partial_Sums((||.z.|| rExpSeq)).k <= Sum(||.z.|| rExpSeq) & ||.
  Partial_Sums(( z ExpSeq)).k .|| <= Sum(||.z.|| rExpSeq);

theorem 
  1 <= Sum(||.z.|| rExpSeq);

theorem 
  abs((Partial_Sums(||.z.|| rExpSeq)).n) = Partial_Sums(||.z.||
rExpSeq).n & ( n <= m implies abs((Partial_Sums(||.z.|| rExpSeq).m-Partial_Sums
  (||.z.|| rExpSeq).n)) = Partial_Sums(||.z.|| rExpSeq).m-Partial_Sums(||.z.||
  rExpSeq).n );

theorem 
  abs(Partial_Sums(||.Conj(k,z,w).||).n)=Partial_Sums(||.Conj(k,z, w).||).n;

theorem 
  for p being real number st p>0 ex n st for k st n <= k holds abs
  (Partial_Sums(||.Conj(k,z,w).||).k) < p;

theorem 
  for seq st for k holds seq.k=Partial_Sums((Conj(k,z,w))).k holds
  seq is convergent & lim(seq)=0.X;

definition
  let X;
  func exp_ X -> Function of the carrier of X, the carrier of X means


  for z being Element of X holds it.z=Sum(z ExpSeq);
end;

definition
  let X,z;
  func exp z -> Element of X equals

  (exp_ X).z;
end;

theorem 
  for z holds exp(z)=Sum(z ExpSeq);

theorem 
  for z1,z2 st z1,z2 are_commutative holds exp(z1+z2)=exp(z1) *exp
  (z2) & exp(z2+z1)=exp(z2) *exp(z1) & exp(z1+z2)=exp(z2+z1) & exp(z1),exp(z2)
  are_commutative;

theorem 
  for z1,z2 st z1,z2 are_commutative holds z1 * exp(z2)=exp(z2) * z1;

theorem 
  exp(0.X) = 1.X;

theorem 
  exp(z)*exp(-z)= 1.X & exp(-z)*exp(z)= 1.X;

theorem 
  exp(z) is invertible & (exp(z))" = exp(-z) & exp(-z) is invertible & (
  exp(-z))" = exp(z);

theorem 
  for z for s,t be Complex holds s*z,t*z are_commutative;

theorem 
  for z for s,t be Complex holds exp(s*z)*exp(t*z) = exp((s+t)*z) & exp(
t*z)*exp(s*z) = exp((t+s)*z) & exp((s+t)*z) = exp((t+s)*z) & exp(s*z),exp(t*z)
  are_commutative;














begin 

reserve n,k for Element of NAT;
reserve x,y,X for set;
reserve g,r,p for Real;
reserve S for RealNormSpace;
reserve rseq for Real_Sequence;
reserve seq,seq1 for sequence of S;
reserve x0 for Point of S;
reserve Y for Subset of S;




theorem 
  for x0 be Point of S for N1,N2 being Neighbourhood of x0 ex N
  being Neighbourhood of x0 st N c= N1 & N c= N2;

theorem 
  for X being Subset of S st X is open for r be Point of S st r in
  X ex N being Neighbourhood of r st N c= X;

theorem 
  for X being Subset of S st X is open for r be Point of S st r in X
  holds ex g st 0<g & {y where y is Point of S:||.y-r.|| < g} c= X;

theorem 
  for X being Subset of S holds ((for r be Point of S st r in X
  holds ex N be Neighbourhood of r st N c= X) implies X is open );

theorem 
  for X being Subset of S holds ( (for r be Point of S st r in X holds
  ex N be Neighbourhood of r st N c= X) iff X is open);



definition
  let X be set, S be ZeroStr;
  let f be Function of X,S;
  redefine attr f is non-zero means


  rng f c= NonZero S;
end;

theorem 
  seq is non-zero iff for x st x in NAT holds seq.x<>0.S;

theorem 
  seq is non-zero iff for n holds seq.n<>0.S;

definition
  let RNS be RealLinearSpace;
  let S be sequence of RNS;
  let a be Real_Sequence;
  func a (#) S -> sequence of RNS means


  for n holds it.n = a.n * S.n;
end;

definition
  let RNS be RealLinearSpace;
  let z be Point of RNS;
  let a be Real_Sequence;
  func a * z -> sequence of RNS means


  for n holds it.n = a.n * z;
end;

theorem 
  for rseq1,rseq2 be Real_Sequence holds (rseq1+rseq2)(#)seq=rseq1(#)seq
  +rseq2(#)seq;

theorem 
  for rseq be Real_Sequence for seq1, seq2 be sequence of S holds
  rseq(#)(seq1+seq2)=rseq(#)seq1+rseq(#)seq2;

theorem 
  for rseq be Real_Sequence holds r*(rseq(#)seq) =rseq(#)(r*seq);

theorem 
  for rseq1,rseq2 be Real_Sequence holds (rseq1-rseq2)(#)seq=rseq1(#)seq
  -rseq2(#)seq;

theorem 
  for rseq be Real_Sequence for seq1, seq2 be sequence of S holds
  rseq(#)(seq1-seq2)=rseq(#)seq1-rseq(#)seq2;

theorem 
  rseq is convergent & seq is convergent implies rseq (#) seq is convergent;

theorem 
  rseq is convergent & seq is convergent implies lim (rseq (#) seq
  ) = (lim rseq) * (lim seq);

theorem 
  (seq+seq1) ^\k=(seq ^\k) +(seq1 ^\k);

theorem 
  (seq-seq1) ^\k=(seq ^\k) -(seq1 ^\k);

theorem 
  seq is non-zero implies seq ^\k is non-zero;

definition
  let S;
  let x be Point of S;
  let IT be sequence of S;
  attr IT is x-convergent means


  IT is convergent & lim IT = x;
end;

theorem 
  for X be RealNormSpace for seq be sequence of X holds seq is
constant implies ( seq is convergent & for k be Element of NAT holds lim seq =
  seq.k );

theorem 
  for r be Real st 0<r & (for n holds seq.n=(1/(n+r))*x0) holds
  seq is convergent;

theorem 
  for r be Real st 0<r & (for n holds seq.n=(1/(n+r))*x0 ) holds lim seq=0.S;

registration
  let S be non trivial RealNormSpace;
  cluster non-zero (0.S)-convergent for sequence of S;
end;

theorem 
  for a be 0-convergent non-zero Real_Sequence
    for z be Point of S st z <> 0.S
  holds a*z is non-zero (0.S)-convergent;

theorem 
  (for r be Point of S holds r in Y iff r in the carrier of S) iff Y=the
  carrier of S;

reserve S,T for non trivial RealNormSpace;
reserve f,f1,f2 for PartFunc of S,T;
reserve s1 for sequence of S;
reserve x0 for Point of S;

registration
  let S;
  cluster constant for sequence of S;
end;



reserve h for (0.S)-convergent non-zero sequence of S;
reserve c for constant sequence of S;

definition
  let S,T;
  let IT be PartFunc of S,T;
  attr IT is RestFunc-like means


  IT is total & for h holds (||.h.||")(#)(IT
  /*h) is convergent & lim ((||.h.||")(#)(IT/*h)) = 0.T;
end;

registration
  let S,T;
  cluster RestFunc-like for PartFunc of S,T;
end;

definition
  let S,T;
  mode RestFunc of S,T is RestFunc-like PartFunc of S,T;
end;

theorem 
  for R be PartFunc of S,T st R is total holds R is RestFunc-like iff for r
be Real st r > 0 ex d be Real st d > 0 & for z be Point of S st z <> 0.S & ||.z
  .|| < d holds ( ||.z.||"* ||. R/.z .||) < r;

theorem 
  for R be RestFunc of S,T for s be non-zero (0.S)-convergent sequence of S
  holds (R/*s) is convergent & lim (R/*s) = 0.T;

reserve R,R1,R2 for RestFunc of S,T;
reserve L,L1,L2 for Point of R_NormSpace_of_BoundedLinearOperators(S,T);

theorem 
  for h1,h2 be PartFunc of S,T for seq be sequence of S holds h1
is total & h2 is total implies (h1+h2)/*seq = h1/*seq + h2/*seq & (h1-h2)/*seq
  = h1/*seq - h2/*seq;

theorem 
  for h be PartFunc of S,T for seq be sequence of S for r be Real
  holds h is total implies (r(#)h)/*seq = r*(h/*seq);

theorem 
  f is_continuous_in x0 iff x0 in dom f & for s1 be sequence of S
  st rng s1 c= dom f & s1 is convergent & lim s1=x0 & (for n holds s1.n<>x0)
  holds f/*s1 is convergent & f/.x0=lim(f/*s1);

theorem 
  for R1,R2 holds R1+R2 is RestFunc of S,T & R1-R2 is RestFunc of S,T;

theorem 
  for r,R holds r(#)R is RestFunc of S,T;

definition
  let S,T;
  let f be PartFunc of S,T;
  let x0 be Point of S;
  pred f is_differentiable_in x0 means


  ex N being Neighbourhood of x0
st N c= dom f & ex L,R st for x be Point of S st x in N holds f/.x - f/.x0 = L.
  (x-x0) + R/.(x-x0);
end;

definition
  let S,T;
  let f be PartFunc of S,T;
  let x0 be Point of S;
  assume
 f is_differentiable_in x0;
  func diff(f,x0) -> Point of R_NormSpace_of_BoundedLinearOperators(S,T) means


  ex N being Neighbourhood of x0 st N c= dom f & ex R st for x be Point of
  S st x in N holds f/.x-f/.x0 = it.(x-x0) + R/.(x-x0);
end;

definition
  let X;
  let S,T;
  let f be PartFunc of S,T;
  pred f is_differentiable_on X means


  X c=dom f & for x be Point of S st x in X holds f|X is_differentiable_in x;
end;

theorem 
  for f be PartFunc of S,T holds (f is_differentiable_on X implies
  X is Subset of S);

theorem 
  for f be PartFunc of S,T for Z be Subset of S st Z is open holds
( f is_differentiable_on Z iff Z c=dom f & for x be Point of S st x in Z holds
  f is_differentiable_in x );

theorem 
  for f be PartFunc of S,T for Y be Subset of S holds f
  is_differentiable_on Y implies Y is open;

definition
  let S,T;
  let f be PartFunc of S,T;
  let X be set;
  assume
 f is_differentiable_on X;
  func f`|X -> PartFunc of S, R_NormSpace_of_BoundedLinearOperators(S,T) means


  dom it = X & for x be Point of S st x in X holds it/.x = diff(f,x);
end;

theorem 
  for f be PartFunc of S,T for Z be Subset of S st Z is open & Z c= dom
f & ex r be Point of T st rng f = {r} holds f is_differentiable_on Z & for x be
Point of S st x in Z holds (f`|Z)/.x = 0.R_NormSpace_of_BoundedLinearOperators(
  S,T);

registration
  let S;
  let h,n;
  cluster h^\n -> (0.S)-convergent non-zero for sequence of S;
end;

theorem 
  for x0 be Point of S for N being Neighbourhood of x0 st f
is_differentiable_in x0 & N c= dom f holds
for h be (0.S)-convergent non-zero sequence of
S for c st rng c = {x0} & rng (h+c) c= N holds (f/*(h+c) - f/*c) is convergent
  & lim (f/*(h+c) - f/*c) = 0.T;

theorem 
  for f1,f2,x0 st f1 is_differentiable_in x0 & f2
  is_differentiable_in x0 holds f1+f2 is_differentiable_in x0 & diff(f1+f2,x0)=
  diff(f1,x0)+diff(f2,x0);

theorem 
  for f1,f2,x0 st f1 is_differentiable_in x0 & f2
  is_differentiable_in x0 holds f1-f2 is_differentiable_in x0 & diff(f1-f2,x0)=
  diff(f1,x0)-diff(f2,x0);

theorem 
  for r,f,x0 st f is_differentiable_in x0 holds r(#)f
  is_differentiable_in x0 & diff((r(#)f),x0) = r*diff(f,x0);

theorem 
  for f be PartFunc of S,S for Z be Subset of S st Z is open & Z c= dom
  f & f|Z = id Z holds f is_differentiable_on Z & for x be Point of S st x in Z
  holds (f`|Z)/.x = id (the carrier of S);

theorem 
  for Z be Subset of S st Z is open for f1,f2 st Z c= dom (f1+f2) & f1
  is_differentiable_on Z & f2 is_differentiable_on Z holds f1+f2
is_differentiable_on Z & for x be Point of S st x in Z holds ((f1+f2)`|Z)/.x =
  diff(f1,x) + diff(f2,x);

theorem 
  for Z be Subset of S st Z is open for f1,f2 st Z c= dom (f1-f2) & f1
  is_differentiable_on Z & f2 is_differentiable_on Z holds f1-f2
is_differentiable_on Z & for x be Point of S st x in Z holds ((f1-f2)`|Z)/.x =
  diff(f1,x) - diff(f2,x);

theorem 
  for Z be Subset of S st Z is open for r,f st Z c= dom (r(#)f) & f
is_differentiable_on Z holds r(#)f is_differentiable_on Z & for x be Point of S
  st x in Z holds ((r(#)f)`|Z)/.x =r*diff(f,x);

theorem 
  for Z be Subset of S st Z is open holds (Z c= dom f & f|Z is constant
implies f is_differentiable_on Z & for x be Point of S st x in Z holds (f`|Z)/.
  x = 0.R_NormSpace_of_BoundedLinearOperators(S,T));

theorem 
  for f be PartFunc of S,S for r be Real for p be Point of S for Z be
  Subset of S st Z is open holds ( Z c= dom f & (for x be Point of S st x in Z
holds f/.x = r*x + p) implies f is_differentiable_on Z & for x be Point of S st
  x in Z holds (f`|Z)/.x = r * FuncUnit(S) );

theorem 
  for x0 be Point of S holds f is_differentiable_in x0 implies f
  is_continuous_in x0;

theorem 
  f is_differentiable_on X implies f is_continuous_on X;

theorem 
  for Z be Subset of S st Z is open holds ( f is_differentiable_on X & Z
  c= X implies f is_differentiable_on Z );

theorem 
  f is_differentiable_in x0 implies ex N being Neighbourhood of x0 st N
c= dom f & ex R st R/.0.S=0.T & R is_continuous_in 0.S & for x be Point of S st
  x in N holds f/.x-f/.x0 = diff(f,x0).(x-x0) + R/.(x-x0);














begin 

reserve a,b,n for Element of NAT;

theorem 
  for a being real number, n being Element of NAT st a to_power n = 0
  holds a = 0;

theorem 
  for a being non negative real number holds (sqrt a) * (sqrt a) = a;

theorem 
  for a being real number holds a to_power 2 = (-a) to_power 2;

theorem 
  for k being non empty Nat holds k-'1+2 = k+2-'1;

theorem 
  (a+b) |^ 2 = a*a + a*b + a*b + b*b;

theorem 
  for a being non empty real number holds (a to_power n) to_power 2
  = a to_power (2*n);

theorem 
  for a, b being real number holds
  (a + b)*(a - b) = a to_power 2 - b to_power 2;

theorem 
  for a, b be non empty real number holds
  (a*b) to_power n = a to_power n * b to_power n;

registration
  cluster tau -> positive;
  cluster tau_bar -> negative;
end;

theorem 
  for n being Nat holds tau to_power n + tau to_power(n+1) = tau to_power(n+2);

theorem 
  for n being Nat holds tau_bar to_power n + tau_bar to_power(n+1)
  = tau_bar to_power(n+2);

begin 

definition
  let n be Nat;

  func Lucas (n) -> Element of NAT means


  ex L being Function of NAT, [:
NAT, NAT:] st it = (L.n)`1 & L.0 = [2,1] & for n being Nat holds L.(n+1) = [ (L
  .n)`2, (L.n)`1 + (L.n)`2 ];
end;

theorem 
  Lucas(0) = 2 & Lucas(1) = 1 & for n being Nat holds Lucas((n+1)+
  1) = Lucas(n) + Lucas(n+1);

theorem 
  for n being Nat holds Lucas(n + 2) = Lucas (n) + Lucas (n+1);

theorem 
  for n being Nat holds Lucas(n+1) + Lucas(n+2) = Lucas(n+3);

theorem 
  Lucas(2) = 3;

theorem 
  Lucas(3) = 4;

theorem 
  Lucas(4) = 7;

theorem 
  for k being Nat holds Lucas(k) >= k;

theorem 
  for m being non empty Element of NAT holds Lucas(m+1) >= Lucas(m);

registration
  let n be Element of NAT;
  cluster Lucas n -> positive;
end;

theorem 
  for n being Element of NAT holds 2 * Lucas(n+2) = Lucas(n) + Lucas(n+3 );

theorem 
  for n being Nat holds Lucas(n+1) = Fib(n) + Fib(n+2);

theorem 
  for n being Nat holds Lucas(n) = tau to_power n + tau_bar to_power n;

theorem 
  for n being Nat holds 2 * Lucas(n) + Lucas(n + 1) = 5 * Fib(n + 1);

theorem 
  for n being Nat holds Lucas(n + 3) - 2 * Lucas(n) = 5 * Fib(n);

theorem 
  for n being Nat holds Lucas(n) + Fib(n) = 2 * Fib(n+1);

theorem 
  for n being Nat holds 3 * Fib(n) + Lucas(n) = 2 * Fib(n+2);

theorem 
  for n,m being Element of NAT holds 2 * Lucas(n + m) = Lucas(n) * Lucas
  (m) + 5 * Fib(n) * Fib(m);

theorem 
  for n being Element of NAT holds Lucas(n + 3) * Lucas(n) = (Lucas(n +
  2))|^2 - (Lucas(n+1))|^2;

theorem 
  for n being Nat holds Fib(2*n) = Fib(n) * Lucas(n);

theorem 
  for n being Element of NAT holds 2 * Fib(2*n+1) = Lucas(n+1) * Fib(n)
  + Lucas(n) * Fib(n+1);

theorem 
  for n being Element of NAT holds 5 * (Fib(n)) |^ 2 - (Lucas(n)) |^ 2 =
  4 * (-1) to_power (n+1);

theorem 
  for n being Element of NAT holds Fib(2*n+1) = Fib(n+1) * Lucas(n+1) -
  Fib(n) * Lucas(n);

begin 

definition
  let a,b be Nat;
  redefine func [a,b] -> Element of [:NAT,NAT:];
end;

definition
  let a,b,n be Nat;
  func GenFib (a,b,n) -> Element of NAT means


  ex L being Function of
NAT, [:NAT, NAT:] st it = (L.n)`1 & L.0 = [a,b] & for n being Nat holds L.(n+1)
  = [ (L.n)`2, (L.n)`1 + (L.n)`2 ];
end;

theorem 
  for a,b being Nat holds GenFib(a,b,0) = a & GenFib(a,b,1) = b &
  for n being Nat holds GenFib(a,b,(n+1)+1) = GenFib(a,b,n) + GenFib(a,b,n+1);

theorem 
  for k being Nat holds (GenFib(a,b,k+1)+GenFib(a,b,(k+1)+1)) |^ 2
= (GenFib(a,b,k+1)|^2+2*GenFib(a,b,k+1) * GenFib(a,b,(k+1)+1)+GenFib(a,b,(k+1)+
  1)|^2);

theorem 
  for a,b,n being Nat holds GenFib(a,b,n) + GenFib(a,b,n+1) = GenFib(a,b,n+2);

theorem 
  for a,b,n being Nat holds GenFib(a,b,n+1) + GenFib(a,b,n+2) =
  GenFib(a,b,n + 3);

theorem 
  for a,b,n being Element of NAT holds GenFib(a,b,n+2) + GenFib(a,
  b,n+3) = GenFib(a,b,n + 4);

theorem 
  for n being Element of NAT holds GenFib(0,1,n) = Fib(n);

theorem 
  for n being Element of NAT holds GenFib(2,1,n) = Lucas(n);

theorem 
  for a,b,n being Element of NAT holds GenFib(a,b,n) + GenFib(a,b,
  n + 3) = 2*GenFib(a,b,n + 2);

theorem 
  for a,b,n being Element of NAT holds GenFib(a,b,n) + GenFib(a,b,n + 4)
  = 3*GenFib(a,b,n + 2);

theorem 
  for a,b,n being Element of NAT holds GenFib(a,b,n + 3) - GenFib(a,b,n)
  = 2*GenFib(a,b,n +1);

theorem 
  for a,b,n being non empty Element of NAT holds GenFib(a,b,n) = GenFib(
  a,b,0)*Fib(n-'1) + GenFib(a,b,1)*Fib(n);

theorem 
  for n,m being Nat holds Fib(m) * Lucas(n) + Lucas(m) * Fib(n) = GenFib
  (Fib(0),Lucas(0),n+m);

theorem 
  for n being Element of NAT holds Lucas(n) + Lucas(n + 3) = 2*Lucas(n + 2);

theorem 
  for a,n being Element of NAT holds GenFib(a,a,n) = ((GenFib(a,a,0)) /
  2) * (Fib(n) + Lucas(n));

theorem 
  for a,b,n being Element of NAT holds GenFib(b,a+b,n) = GenFib(a,b,n+1);

theorem 
  for a,b,n being Element of NAT holds GenFib(a,b,n+2) * GenFib(a,b,n) -
  GenFib(a,b,n+1)|^2 = ((-1)to_power n) * (GenFib(a,b,2)|^2 - GenFib(a,b,1) *
  GenFib(a,b,3));

theorem 
  for a,b,k,n being Element of NAT holds GenFib(GenFib(a,b,k),GenFib(a,b
  ,k+1),n) = GenFib(a,b,n+k);

theorem 
  for a,b,n being Element of NAT holds GenFib(a,b,n+1) = a*Fib(n) + b*Fib(n+1);

theorem 
  for b,n being Element of NAT holds GenFib(0,b,n) = b * Fib(n);

theorem 
  for a,n being Element of NAT holds GenFib(a,0,n+1) = a * Fib(n);

theorem 
  for a,b,c,d,n being Element of NAT holds GenFib(a,b,n) + GenFib(c,d,n)
  = GenFib(a+c,b+d,n);

theorem 
  for a,b,k,n being Element of NAT holds GenFib(k*a,k*b,n) = k * GenFib(
  a,b,n );

theorem 
  for a,b,n being Element of NAT holds GenFib(a,b,n) = ((a*(-tau_bar)+b)
  * tau to_power n + (a*tau-b) * tau_bar to_power n) / sqrt(5);

theorem 
  for a,n being Element of NAT holds GenFib(2*a+1,2*a+1,n+1) = (2*a+1) *
  Fib(n+2);














begin

theorem 
  for x, y, A, B being set st x in A \/ B & y in A \/ B holds x in A \ B
  & y in A \ B or x in B & y in B or x in A \ B & y in B or x in B & y in A \ B
;

definition
  let R, S be RelStr;
  pred R tolerates S means


  for x, y being set st x in (the carrier of R
) /\ (the carrier of S) & y in (the carrier of R) /\ (the carrier of S) holds [
  x, y] in the InternalRel of R iff [x,y] in the InternalRel of S;
end;

begin

definition
  let R, S be RelStr; 
  func R [*] S -> strict RelStr means


  the carrier of it = (the carrier
of R) \/ (the carrier of S) & the InternalRel of it = (the InternalRel of R) \/
  (the InternalRel of S) \/ ((the InternalRel of R) * the InternalRel of S);
end;

registration
  let R be RelStr, S be non empty RelStr;
  cluster R [*] S -> non empty;
end;

registration
  let R be non empty RelStr, S be RelStr;
  cluster R [*] S -> non empty;
end;

theorem 
  for R, S being RelStr holds the InternalRel of R c= the
  InternalRel of R [*] S & the InternalRel of S c= the InternalRel of R [*] S;

theorem 
  for R, S being RelStr st R is reflexive & S is reflexive holds R
  [*] S is reflexive;

begin

theorem 
  for R, S being RelStr, a, b being set st [a,b] in the InternalRel
of R [*] S & a in the carrier of R & b in the carrier of R & R tolerates S & R
  is transitive holds [a,b] in the InternalRel of R;

theorem 
  for R, S being RelStr, a, b being set st [a,b] in the InternalRel
of R [*] S & a in the carrier of S & b in the carrier of S & R tolerates S & S
  is transitive holds [a,b] in the InternalRel of S;

theorem 
  for R, S being RelStr, a, b being set holds ([a,b] in the
  InternalRel of R implies [a,b] in the InternalRel of R [*] S) & ([a,b] in the
  InternalRel of S implies [a,b] in the InternalRel of R [*] S);

theorem 
  for R, S being non empty RelStr, x being Element of R [*] S holds x in
  the carrier of R or x in (the carrier of S) \ (the carrier of R);

theorem 
  for R, S being non empty RelStr for x, y being Element of R, a, b
  being Element of R [*] S st x = a & y = b & R tolerates S & R is transitive
  holds x <= y iff a <= b;

theorem 
  for R, S being non empty RelStr, a, b being Element of R [*] S, c
, d being Element of S st a = c & b = d & R tolerates S & S is transitive holds
  a <= b iff c <= d;

theorem 
  for R, S being antisymmetric reflexive transitive with_suprema
  non empty RelStr for x being set st x in the carrier of R holds x is Element
  of R [*] S;

theorem 
  for R, S being antisymmetric reflexive transitive with_suprema non
empty RelStr for x being set st x in the carrier of S holds x is Element of R
  [*] S;

theorem 
  for R, S being non empty RelStr for x being set st x in (the
  carrier of R) /\ (the carrier of S) holds x is Element of R;

theorem 
  for R, S being non empty RelStr for x being set st x in (the
  carrier of R) /\ (the carrier of S) holds x is Element of S;

theorem 
  for R, S being antisymmetric reflexive transitive with_suprema non
empty RelStr for x, y being Element of R [*] S st x in the carrier of R & y in
the carrier of S & R tolerates S holds x <= y iff (ex a being Element of R [*]
  S st a in (the carrier of R) /\ (the carrier of S) & x <= a & a <= y);

theorem 
  for R, S being non empty RelStr, a, b being Element of R, c, d
  being Element of S st a = c & b = d & R tolerates S & R is transitive & S is
  transitive holds a <= b iff c <= d;

theorem 
  for R being antisymmetric reflexive transitive with_suprema non
  empty RelStr, D being lower directed Subset of R for x, y being Element of R
  st x in D & y in D holds x "\/" y in D;

theorem 
  for R, S being RelStr, a, b being set st (the carrier of R) /\ (
the carrier of S) is upper Subset of R & [a,b] in the InternalRel of R [*] S &
  a in the carrier of S holds b in the carrier of S;

theorem 
  for R, S being RelStr, a, b being Element of R [*] S st (the
  carrier of R) /\ (the carrier of S) is upper Subset of R & a <= b & a in the
  carrier of S holds b in the carrier of S;

theorem 
  for R, S being antisymmetric reflexive transitive with_suprema non
  empty RelStr for x, y being Element of R, a, b being Element of S st (the
  carrier of R) /\ (the carrier of S) is lower directed Subset of S & (the
carrier of R) /\ (the carrier of S) is upper Subset of R & R tolerates S & x =
  a & y = b holds x "\/" y = a "\/" b;

theorem 
  for R, S being lower-bounded antisymmetric reflexive transitive
with_suprema non empty RelStr st (the carrier of R) /\ (the carrier of S) is
  non empty lower directed Subset of S holds Bottom S in the carrier of R;

theorem 
  for R, S being RelStr, a, b being set st (the carrier of R) /\ (
the carrier of S) is lower Subset of S & [a,b] in the InternalRel of R [*] S &
  b in the carrier of R holds a in the carrier of R;

theorem 
  for x, y being set, R, S being RelStr st [x,y] in the InternalRel of R
  [*] S & (the carrier of R) /\ (the carrier of S) is upper Subset of R holds x
in the carrier of R & y in the carrier of R or x in the carrier of S & y in the
  carrier of S or x in (the carrier of R) \ (the carrier of S) & y in (the
  carrier of S) \ (the carrier of R);

theorem 
  for R, S being RelStr, a, b being Element of R [*] S st (the carrier
of R) /\ (the carrier of S) is lower Subset of S & a <= b & b in the carrier of
  R holds a in the carrier of R;

theorem 
  for R, S being RelStr st R tolerates S & (the carrier of R) /\ (the
  carrier of S) is upper Subset of R & (the carrier of R) /\ (the carrier of S)
  is lower Subset of S & R is transitive antisymmetric & S is transitive
  antisymmetric holds R [*] S is antisymmetric;

theorem 
  for R, S being RelStr st (the carrier of R) /\ (the carrier of S) is
upper Subset of R & (the carrier of R) /\ (the carrier of S) is lower Subset of
  S & R tolerates S & R is transitive & S is transitive holds R [*] S is
  transitive;














begin

reserve T, T1 for non empty TopSpace;

definition
  let T be TopSpace;
  let F be Subset-Family of T;
  attr F is discrete means


  for p being Point of T ex O being open
  Subset of T st p in O & for A,B being Subset of T st A in F & B in F holds O
  meets A & O meets B implies A=B;
end;

registration
  let T be non empty TopSpace;
  cluster discrete for Subset-Family of T;
end;

registration
  let T;
  cluster empty discrete for Subset-Family of T;
end;

reserve F,G,H for Subset-Family of T,
  A,B,C,D for Subset of T,
  O,U for open Subset of T,
  p,q for Point of T,
  x,y,X for set;

theorem 
  for F st (ex A st F={A}) holds F is discrete;

theorem 
  for F,G st F c= G & G is discrete holds F is discrete;

theorem 
  for F,G st F is discrete holds F/\G is discrete;

theorem 
  for F,G st F is discrete holds F\G is discrete;

theorem 
  for F,G,H st F is discrete & G is discrete & INTERSECTION(F,G)=H holds
  H is discrete;

theorem 
  for F,A,B st F is discrete & A in F & B in F holds A=B or A misses B;

theorem 
  F is discrete implies for p ex O st p in O & INTERSECTION({O},F)\
  {{}} is trivial;

theorem 
  F is discrete iff (for p ex O st p in O & INTERSECTION({O},F)\{{}} is
  trivial) & for A,B st A in F & B in F holds A=B or A misses B;

registration
  let T;
  let F be discrete Subset-Family of T;
  cluster clf F -> discrete;
end;

theorem 
  for F st F is discrete holds for A,B st A in F & B in F holds Cl(A/\B)
  =Cl A /\ Cl B;

theorem 
  for F st F is discrete holds Cl union(F) = union (clf F);

theorem 
  for F st F is discrete holds F is locally_finite;

definition
  let T be TopSpace;
  mode FamilySequence of T
   is Function of NAT, bool bool(the carrier of T) qua non empty set;
end;

reserve Un for FamilySequence of T,
  r,r1,r2 for Real,
  n for Element of NAT;

definition
  let T,Un,n;
  redefine func Un.n -> Subset-Family of T;
end;

definition
  let T,Un;
  redefine func Union Un ->Subset-Family of T;
end;

definition
  let T be non empty TopSpace;
  let Un be FamilySequence of T;
  attr Un is sigma_discrete means


  for n being Element of NAT holds Un.n is discrete;
end;

registration
  let T be non empty TopSpace;
  cluster sigma_discrete for FamilySequence of T;
end;

definition
  let T be non empty TopSpace;
  let Un be FamilySequence of T;
  attr Un is sigma_locally_finite means


  for n being Element of NAT holds Un.n is locally_finite;
end;

definition
  let T;
  let F be Subset-Family of T;
  attr F is sigma_discrete means


  ex f being sigma_discrete FamilySequence of T st F = Union f;
end;

notation
  let X be set;
  antonym X is uncountable for X is countable;
end;

registration
  cluster uncountable -> non empty for set;
end;

registration
  let T be non empty TopSpace;
  cluster sigma_locally_finite for FamilySequence of T;
end;

theorem 
  for Un st Un is sigma_discrete holds Un is sigma_locally_finite;

theorem 
  for A being uncountable set ex F being Subset-Family of 1TopSp([:A,A:]
  ) st F is locally_finite & F is not sigma_discrete;

definition
  let T be non empty TopSpace;
  let Un be FamilySequence of T;
  attr Un is Basis_sigma_discrete means

  Un is sigma_discrete & Union Un is Basis of T;
end;

definition
  let T be non empty TopSpace;
  let Un be FamilySequence of T;
  attr Un is Basis_sigma_locally_finite means


  Un is sigma_locally_finite & Union Un is Basis of T;
end;

theorem 
  for r being real number, PM be non empty MetrSpace for x being
  Element of PM holds [#]PM\cl_Ball(x,r) in Family_open_set(PM);

theorem 
  for T st T is metrizable holds T is regular & T is T_1;

theorem 
  for T st T is metrizable ex Un being FamilySequence of T st Un is
  Basis_sigma_locally_finite;

theorem 
  for U being Function of NAT, bool(the carrier of T) st (for n
  holds U.n is open) holds Union U is open;

theorem 
  (for A,U st A is closed & U is open & A c=U ex W being Function
of NAT, bool(the carrier of T) st A c= Union W & Union W c= U & (for n holds Cl
  (W.n) c= U & W.n is open )) implies T is normal;

theorem 
  for T st T is regular for Bn being FamilySequence of T st (Union
Bn) is Basis of T holds for U being Subset of T,p being Point of T st U is open
  & p in U ex O being Subset of T st p in O & Cl O c= U & O in Union Bn;

theorem 
  for T st T is regular & ex Bn being FamilySequence of T st Bn is
  Basis_sigma_locally_finite holds T is normal;

definition
  let T;
  let F,G be RealMap of T;
  redefine func F+G -> RealMap of T means


  for t being Element of T holds it.t=F.t+G.t;
end;

theorem 
  for f being RealMap of T st f is continuous for F being RealMap of [:T
  ,T:] st for x,y being Element of T holds F.(x,y)=abs(f.x-f.y) holds F is
  continuous;

theorem 
  for F,G being RealMap of T st F is continuous & G is continuous
  holds F + G is continuous;

theorem 
  for ADD being BinOp of Funcs(the carrier of T,REAL) st (for f1,
  f2 being RealMap of T holds ADD.(f1,f2)=f1+f2) holds ADD is having_a_unity &
  ADD is commutative associative;

theorem 
  for ADD being BinOp of Funcs(the carrier of T,REAL) st (for f1,
f2 being RealMap of T holds ADD.(f1,f2)=f1+f2) for map9 being Element of Funcs(
  the carrier of T,REAL) st map9 is_a_unity_wrt ADD holds map9 is continuous;

definition
  let A,B be non empty set;
  let F be Function of A,Funcs(A,B);
  func F Toler -> Function of A,B means


  for p be Element of A holds it. p=F.p.p;
end;

theorem 
  for ADD being BinOp of Funcs(the carrier of T,REAL) st (for f1,f2
  being RealMap of T holds ADD.(f1,f2)=f1+f2) for F being FinSequence of Funcs(
the carrier of T,REAL) st for n st 0 <> n & n <= len F holds F.n is continuous
  RealMap of T holds ADD "**" F is continuous RealMap of T;

theorem 
  for F be Function of the carrier of T,Funcs(the carrier of T,the
carrier of T1) st for p be Point of T holds F.p is continuous Function of T,T1
  for S be Function of the carrier of T,bool the carrier of T st for p be Point
of T holds p in S.p & S.p is open & for p,q be Point of T st p in S.q holds F.p
  .p=F.q.p holds F Toler is continuous;

reserve m for Function of [:the carrier of T,the carrier of T:],REAL;

definition
  let X,r;
  let f be Function of X,REAL;
  func min(r,f) -> Function of X,REAL means


  for x st x in X holds it.x = min(r,f.x);
end;

theorem 
  for r be Real,f be RealMap of T st f is continuous holds min(r,f) is
  continuous;

definition
  let X be set, f be Function of [:X,X:],REAL;
  pred f is_a_pseudometric_of X means


  f is Reflexive symmetric triangle;
end;

theorem 
  for f be Function of [:X,X:],REAL holds f is_a_pseudometric_of X
  iff for a,b,c be Element of X holds f.(a,a) = 0 & f.(a,c)<=f.(a,b)+f.(c,b);

theorem 
  for f be Function of [:X,X:],REAL st f is_a_pseudometric_of X
  for x,y be Element of X holds f.(x,y)>=0;

theorem 
  for r,m st r>0 & m is_a_pseudometric_of (the carrier of T) holds
  min(r,m) is_a_pseudometric_of (the carrier of T);

theorem 
  for r,m st r>0 & m is_metric_of (the carrier of T) holds min(r,m)
  is_metric_of (the carrier of T);














begin 

theorem 
  for L being join-commutative join-associative Huntington non
  empty ComplLLattStr, a, b being Element of L holds (a + b)` = a` *' b`;

begin 

definition
  let IT be non empty LattStr;
  attr IT is upper-bounded' means


  ex c being Element of IT st for a
  being Element of IT holds c "/\" a = a & a "/\" c = a;
end;

definition
  let L be non empty LattStr;
  assume
 L is upper-bounded';
  func Top' L -> Element of L means


  for a being Element of L holds it "/\" a = a & a "/\" it = a;
end;

definition
  let IT be non empty LattStr;
  attr IT is lower-bounded' means


  ex c being Element of IT st for a
  being Element of IT holds c "\/" a = a & a "\/" c = a;
end;

definition
  let L be non empty LattStr;
  assume
 L is lower-bounded';
  func Bot' L -> Element of L means


  for a being Element of L holds it "\/" a = a & a "\/" it = a;
end;

definition
  let IT be non empty LattStr;
  attr IT is distributive' means


  for a, b, c being Element of IT holds
  a "\/" (b "/\" c) = (a "\/" b) "/\" (a "\/" c);
end;

definition
  let L be non empty LattStr, a, b be Element of L;
  pred a is_a_complement'_of b means


  b "\/" a = Top' L & a "\/" b =
  Top' L & b "/\" a = Bot' L & a "/\" b = Bot' L;
end;

definition
  let IT be non empty LattStr;
  attr IT is complemented' means


  for b being Element of IT ex a being
  Element of IT st a is_a_complement'_of b;
end;

definition
  let L be non empty LattStr, x be Element of L;
  assume
 L is complemented' distributive upper-bounded' meet-commutative;
  func x `# -> Element of L means


  it is_a_complement'_of x;
end;

registration
  cluster Boolean join-idempotent upper-bounded' complemented' distributive'
    lower-bounded' Lattice-like for 1-element LattStr;
end;

theorem 
  for L being complemented' join-commutative meet-commutative
distributive upper-bounded' distributive' non empty LattStr for x be Element
  of L holds x "\/" x `# = Top' L;

theorem 
  for L being complemented' join-commutative meet-commutative
  distributive upper-bounded' distributive' non empty LattStr for x being
  Element of L holds x "/\" x `# = Bot' L;

theorem 
  for L being complemented' join-commutative meet-commutative
  join-idempotent distributive upper-bounded' distributive' non empty LattStr
  for x being Element of L holds x "\/" Top' L = Top' L;

theorem 
  for L being complemented' join-commutative meet-commutative
  join-idempotent distributive upper-bounded' lower-bounded' distributive' non
  empty LattStr for x being Element of L holds x "/\" Bot' L = Bot' L;

theorem 
  for L being join-commutative meet-absorbing meet-commutative
  join-absorbing join-idempotent distributive non empty LattStr for x, y, z
  being Element of L holds ((x "\/" y) "\/" z) "/\" x = x;

theorem 
  for L being join-commutative meet-absorbing meet-commutative
  join-absorbing join-idempotent distributive' non empty LattStr for x, y, z
  being Element of L holds ((x "/\" y) "/\" z) "\/" x = x;

definition
  let G be non empty /\-SemiLattStr;
  attr G is meet-idempotent means


  for x being Element of G holds x "/\" x = x;
end;

theorem 
  for L being complemented' join-commutative meet-commutative
  distributive upper-bounded' lower-bounded' distributive' non empty LattStr
  holds L is meet-idempotent;

theorem 
  for L being complemented' join-commutative meet-commutative
  distributive upper-bounded' lower-bounded' distributive' non empty LattStr
  holds L is join-idempotent;

theorem 
  for L being complemented' join-commutative meet-commutative
  join-idempotent distributive upper-bounded' distributive' non empty LattStr
  holds L is meet-absorbing;

theorem 
  for L being complemented' join-commutative upper-bounded'
meet-commutative join-idempotent distributive distributive' lower-bounded' non
  empty LattStr holds L is join-absorbing;

theorem 
  for L being complemented' join-commutative meet-commutative
  upper-bounded' lower-bounded' join-idempotent distributive distributive' non
  empty LattStr holds L is upper-bounded;

theorem 
  for L being Boolean Lattice-like non empty LattStr holds L is
  upper-bounded';

theorem 
  for L being complemented' join-commutative meet-commutative
  upper-bounded' lower-bounded' join-idempotent distributive distributive' non
  empty LattStr holds L is lower-bounded;

theorem 
  for L being Boolean Lattice-like non empty LattStr holds L is
  lower-bounded';

theorem 
  for L being join-commutative meet-commutative meet-absorbing
  join-absorbing join-idempotent distributive non empty LattStr holds L is
  join-associative;

theorem 
  for L being join-commutative meet-commutative meet-absorbing
  join-absorbing join-idempotent distributive' non empty LattStr holds L is
  meet-associative;

theorem 
  for L being complemented' join-commutative meet-commutative
  lower-bounded' upper-bounded' join-idempotent distributive distributive' non
  empty LattStr holds Top L = Top' L;

theorem 
  for L being complemented' join-commutative meet-commutative
  lower-bounded' upper-bounded' join-idempotent distributive distributive' non
  empty LattStr holds Bottom L = Bot' L;

theorem 
  for L being Boolean distributive' Lattice-like non empty
  LattStr holds Top L = Top' L;

theorem 
  for L being Boolean complemented lower-bounded upper-bounded
  distributive distributive' Lattice-like non empty LattStr holds Bottom L =
  Bot' L;

theorem 
  for L being complemented' lower-bounded' upper-bounded'
join-commutative meet-commutative join-idempotent distributive distributive'
non empty LattStr, x, y being Element of L holds x is_a_complement'_of y iff x
  is_a_complement_of y;

theorem 
  for L being complemented' join-commutative meet-commutative
  lower-bounded' upper-bounded' join-idempotent distributive distributive' non
  empty LattStr holds L is complemented;

theorem 
  for L being Boolean lower-bounded' upper-bounded' distributive'
  Lattice-like non empty LattStr holds L is complemented';

theorem 
  for L being non empty LattStr holds L is Boolean Lattice iff L
is lower-bounded' upper-bounded' join-commutative meet-commutative distributive
  distributive' complemented';

registration
  cluster Boolean Lattice-like -> lower-bounded' upper-bounded' complemented'
join-commutative meet-commutative distributive distributive' for
non empty LattStr
    ;
  cluster lower-bounded' upper-bounded' complemented' join-commutative
meet-commutative distributive distributive' -> Boolean Lattice-like for
non empty
    LattStr;
end;

begin 

definition
  struct (1-sorted) ShefferStr (# carrier -> set, stroke -> BinOp of the
    carrier #);
end;

definition
  struct (ShefferStr,LattStr) ShefferLattStr (# carrier -> set, L_join ->
BinOp of the carrier, L_meet -> BinOp of the carrier, stroke -> BinOp of the
    carrier #);
end;

definition
  struct (ShefferStr,OrthoLattStr) ShefferOrthoLattStr (# carrier -> set,
L_join -> BinOp of the carrier, L_meet -> BinOp of the carrier, Compl -> UnOp
    of the carrier, stroke -> BinOp of the carrier #);
end;

definition
  func TrivShefferOrthoLattStr -> ShefferOrthoLattStr equals

  ShefferOrthoLattStr (# 1, op2, op2, op1, op2 #);
end;

registration
  cluster 1-element for ShefferStr;
  cluster 1-element for ShefferLattStr;
  cluster 1-element for ShefferOrthoLattStr;
end;

definition
  let L be non empty ShefferStr;
  let x, y be Element of L;
  func x | y -> Element of L equals

  (the stroke of L).(x,y);
end;

definition
  let L be non empty ShefferOrthoLattStr;
  attr L is properly_defined means


  (for x being Element of L holds x |
x = x`) & (for x, y being Element of L holds x "\/" y = (x | x) | (y | y)) & (
  for x, y being Element of L holds x "/\" y = (x | y) | (x | y)) & for x, y
  being Element of L holds x | y = x` + y`;
end;

definition
  let L be non empty ShefferStr;
  attr L is satisfying_Sheffer_1 means


  for x being Element of L holds (x | x) | (x | x) = x;
  attr L is satisfying_Sheffer_2 means


  for x, y being Element of L holds x | (y | (y | y)) = x | x;
  attr L is satisfying_Sheffer_3 means


  for x, y, z being Element of L
  holds (x | (y | z)) | (x | (y | z)) = ((y | y) | x) | ((z | z) | x);
end;

registration
  cluster -> satisfying_Sheffer_1 satisfying_Sheffer_2
    satisfying_Sheffer_3 for 1-element ShefferStr;
end;

registration
  cluster  -> join-commutative join-associative
   for 1-element \/-SemiLattStr;
  cluster  -> meet-commutative meet-associative
        for 1-element /\-SemiLattStr;
end;

registration
  cluster -> join-absorbing meet-absorbing Boolean for 1-element LattStr;
end;

registration
  cluster TrivShefferOrthoLattStr -> 1-element;
  cluster TrivShefferOrthoLattStr -> properly_defined well-complemented;
end;

registration
  cluster properly_defined Boolean well-complemented Lattice-like
    satisfying_Sheffer_1 satisfying_Sheffer_2 satisfying_Sheffer_3 for
non empty
    ShefferOrthoLattStr;
end;

theorem 
  for L being properly_defined Boolean well-complemented Lattice-like
  non empty ShefferOrthoLattStr holds L is satisfying_Sheffer_1;

theorem 
  for L being properly_defined Boolean well-complemented Lattice-like
  non empty ShefferOrthoLattStr holds L is satisfying_Sheffer_2;

theorem 
  for L being properly_defined Boolean well-complemented Lattice-like
  non empty ShefferOrthoLattStr holds L is satisfying_Sheffer_3;

definition
  let L be non empty ShefferStr;
  let a be Element of L;
  func a" -> Element of L equals

  a | a;
end;

theorem 
  for L being satisfying_Sheffer_3 non empty ShefferOrthoLattStr, x, y
  , z being Element of L holds (x | (y | z))" = (y" | x) | (z" | x);

theorem 
  for L being satisfying_Sheffer_1 non empty ShefferOrthoLattStr, x
  being Element of L holds x = (x")";

theorem 
  for L being satisfying_Sheffer_1 satisfying_Sheffer_2
  satisfying_Sheffer_3 properly_defined non empty ShefferOrthoLattStr, x, y
  being Element of L holds x | y = y | x;

theorem 
  for L being satisfying_Sheffer_1 satisfying_Sheffer_2
  satisfying_Sheffer_3 properly_defined non empty ShefferOrthoLattStr, x, y
  being Element of L holds x | (x | x) = y | (y | y);

theorem 
  for L being satisfying_Sheffer_1 satisfying_Sheffer_2
  satisfying_Sheffer_3 properly_defined non empty ShefferOrthoLattStr holds L
  is join-commutative;

theorem 
  for L being satisfying_Sheffer_1 satisfying_Sheffer_2
  satisfying_Sheffer_3 properly_defined non empty ShefferOrthoLattStr holds L
  is meet-commutative;

theorem 
  for L being satisfying_Sheffer_1 satisfying_Sheffer_2
  satisfying_Sheffer_3 properly_defined non empty ShefferOrthoLattStr holds L
  is distributive;

theorem 
  for L being satisfying_Sheffer_1 satisfying_Sheffer_2
  satisfying_Sheffer_3 properly_defined non empty ShefferOrthoLattStr holds L
  is distributive';

theorem 
  for L being satisfying_Sheffer_1 satisfying_Sheffer_2
  satisfying_Sheffer_3 properly_defined non empty ShefferOrthoLattStr holds L
  is Boolean Lattice;














begin 

definition
  let L be non empty ShefferStr;
  attr L is satisfying_Sh_1 means


  for x, y, z being Element of L holds (x | ((y | x) | x)) | (y | (z | x)) = y;
end;

registration
  cluster trivial -> satisfying_Sh_1 for non empty ShefferStr;
end;

registration
  cluster satisfying_Sh_1 satisfying_Sheffer_1 satisfying_Sheffer_2
    satisfying_Sheffer_3 for non empty ShefferStr;
end;

reserve L for satisfying_Sh_1 non empty ShefferStr;

theorem 
  for x, y, z, u being Element of L holds ((x | (y | z)) | (x | (x
| (y | z)))) | ((z | ((x | z) | z)) | (u | (x | (y | z)))) = z | ((x | z) | z);

theorem 
  for x, y, z being Element of L holds ((x | y) | (((y | ((z | y) |
  y)) | (x | y)) | (x | y))) | z = y | ((z | y) | y);

theorem 
  for x, y, z being Element of L holds (x | ((y | x) | x)) | (y | (
  z | ((x | z) | z))) = y;

theorem 
  for x, y being Element of L holds x | ((x | ((x | x) | x)) | (y |
  (x | ((x | x) | x)))) = x | ((x |x) | x);

theorem 
  for x being Element of L holds x | ((x | x) | x) = x | x;

theorem 
  for x being Element of L holds (x | ((x | x) | x )) | (x | x) = x;

theorem 
  for x, y being Element of L holds (x | x) | (x | (y | x)) = x;

theorem 
  for x, y being Element of L holds (x | (((y | y) | x) | x)) | y = y | y;

theorem 
  for x, y being Element of L holds ((x | y) | (((x | y) | (x | y))
  | (x | y))) | ((x | y) | (x | y)) = y | ((((x | y) | (x | y )) | y) | y);

theorem 
  for x, y being Element of L holds x | ((((y | x) | (y | x)) | x
  ) | x) = y | x;

theorem 
  for x, y being Element of L holds (x | x) | (y | x) = x;

theorem 
  for x, y being Element of L holds x | (y | (x | x)) = x | x;

theorem 
  for x, y being Element of L holds ((x | y) | (x | y)) | y = x | y;

theorem 
  for x, y being Element of L holds x | ((y | x) | x) = y | x;

theorem 
  for x, y, z being Element of L holds (x | y) | (x | (z | y)) = x;

theorem 
  for x, y, z being Element of L holds (x | (y | z)) | (x | z) = x;

theorem 
  for x, y, z being Element of L holds x | ((x | y) | (z | y)) = x | y;

theorem 
  for x, y, z being Element of L holds ((x | (y | z)) | z) | x = x | (y | z);

theorem 
  for x, y being Element of L holds x | ((y | x) | x) = x | y;

theorem 
  for x, y being Element of L holds x | y = y | x;

theorem 
  for x, y being Element of L holds (x | y) | (x | x) = x;

theorem 
  for x, y, z being Element of L holds (x | y) | (y | (z | x)) = y;

theorem 
  for x, y, z being Element of L holds (x | (y | z)) | (z | x) = x;

theorem 
  for x, y, z being Element of L holds (x | y) | (y | (x | z)) = y;

theorem 
  for x, y, z being Element of L holds (x | (y | z)) | (y | x) = x;

theorem 
  for x, y, z being Element of L holds ((x | y) | (x | z)) | z = x | z;

theorem 
  for x, y, z being Element of L holds x | (y | (x | (y | z))) = x | (y | z);

theorem 
  for x, y, z being Element of L holds (x | (y | (x | z))) | y = y | (x | z);

theorem 
  for x, y, z, u being Element of L holds (x | (y | z))| (x | (u |
  (y | x))) = (x | (y | z)) | (y | x);

theorem 
  for x, y, z being Element of L holds (x | (y | (x | z))) | y = y | (z | x);

theorem 
  for x, y, z, u being Element of L holds (x | (y | z)) | (x | (u
  | (y | x))) = x;

theorem 
  for x, y being Element of L holds x | (y | (x | y)) = x | x;

theorem 
  for x, y, z being Element of L holds x | (y | z) = x | (z | y);

theorem 
  for x, y, z being Element of L holds x | (y | (x | (z | (y | x)) )) = x | x;

theorem 
  for x, y, z being Element of L holds (x | (y | z)) | ((y |x) | x
  ) = (x | (y | z)) | (x | (y | z));

theorem 
  for x, y being Element of L holds (x | (y | x)) | y = y | y;

theorem 
  for x, y, z being Element of L holds (x | y) | z = z | (y | x);

theorem 
  for x, y, z being Element of L holds x | (y | (z | (x | y))) = x | (y | y);

theorem 
  for x, y, z being Element of L holds ((x | y) | y) | (y | (z | x
  )) = (y | (z | x)) | (y | (z | x));

theorem 
  for x, y, z, u being Element of L holds (x | y) | (z | u) = (u | z) | (y | x)
;

theorem 
  for x, y, z being Element of L holds x | (y | ((y | x) | z)) = x | (y | y);

theorem 
  for x, y being Element of L holds x | (y | x) = x | (y | y);

theorem 
  for x, y being Element of L holds (x | y) | y = y | (x | x);

theorem 
  for x, y being Element of L holds x | (y | y) = x | (x | y);

theorem 
  for x, y, z being Element of L holds (x | (y | y)) | (x | (z | y
  )) = (x | (z | y)) | (x | (z | y));

theorem 
  for x, y, z being Element of L holds (x | (y | z)) | (x | (y | y
  )) = (x | (y | z)) | (x | (y | z));

theorem 
  for x, y, z being Element of L holds x | ((y | y) | (z | (x | (x
  | y)))) = x | ((y | y) | (y | y));

theorem 
  for x, y, z being Element of L holds ((x | (y | z)) | (x | (y |
  z))) | (y | y) = x | (y | y);

theorem 
  for x, y, z being Element of L holds x | ((y | y) | (z | (x | (x
  | y)))) = x | y;

theorem 
  for x, y, z being Element of L holds (((x | y) | (x | y)) | ((z
  | ((x | y) | z)) | (x | y))) | (x | x) = (z | ((x | y) | z)) | (x | x);

theorem 
  for x, y, z being Element of L holds (x | ((y | z) | x)) | (y |
  y) = (y | z) | (y | y);

theorem 
  for x, y, z being Element of L holds (x | ((y | z) | x)) | (y | y) = y;

theorem 
  for x, y, z being Element of L holds x | ((y | ((x | z) | y)) |
  x) = y | ((x | z) | y);

theorem 
  for x, y, z being Element of L holds x | ((y | (y | (z | x))) |
  x) = y | ((x | (y | (x | z))) | y);

theorem 
  for x, y, z being Element of L holds x | ((y | (y | (z | x))) |
  x) = y | (y | (z | x));

theorem 
  for x, y, z, u being Element of L holds x | (y | (z | (z | (u |
  (y | x))))) = x | (y | y);

theorem 
  for x, y, z being Element of L holds x | (y | (y | (z | (x | y))
  )) = x | (y | (x | x));

theorem 
  for x, y, z being Element of L holds x | (y | (y | (z | (x | y)) )) = x | x;

theorem 
  for x, y being Element of L holds x | (y | (y | y)) = x | x;

theorem 
  for x, y, z being Element of L holds x | (((y | (z | x)) | (y |
  (z | x))) | (z | z)) = x | (y | (z | x));

theorem 
  for x, y, z being Element of L holds x | (y | (z | z)) = x | (y | (z | x));

theorem 
  for x, y, z being Element of L holds x | (y | ((z | z) | x)) = x | (y | z);

theorem 
  for x, y, z being Element of L holds (x | (y | y)) | (x | (z | (
  (y | y) | x))) = (x | (z | y)) | (x | (z | y));

theorem 
  for x, y, z being Element of L holds (x | (y | y)) | (x | (z | (
  x | (y | y)))) = (x | (z | y)) | (x | (z |y));

theorem 
  for x, y, z being Element of L holds (x | (y | y)) | (x | (z | z
  )) = (x | (z | y)) | (x | (z | y));

theorem 
  for x, y, z being Element of L holds ((x | x) | y) | ((z | z) |
  y) = (y | (x | z)) | (y | (x | z));

theorem 
  for L being non empty ShefferStr st L is satisfying_Sh_1 holds L
  is satisfying_Sheffer_1;

theorem 
  for L being non empty ShefferStr st L is satisfying_Sh_1 holds L
  is satisfying_Sheffer_2;

theorem 
  for L being non empty ShefferStr st L is satisfying_Sh_1 holds L
  is satisfying_Sheffer_3;

registration
  cluster properly_defined Boolean well-complemented Lattice-like de_Morgan
satisfying_Sheffer_1 satisfying_Sheffer_2 satisfying_Sheffer_3 satisfying_Sh_1
    for non empty ShefferOrthoLattStr;
end;

registration
  cluster satisfying_Sheffer_1 satisfying_Sheffer_2 satisfying_Sheffer_3
    properly_defined -> Boolean Lattice-like for
non empty ShefferOrthoLattStr;
  cluster Boolean Lattice-like well-complemented properly_defined ->
    satisfying_Sheffer_1 satisfying_Sheffer_2 satisfying_Sheffer_3 for
non empty
    ShefferOrthoLattStr;
end;

begin 

reserve L for satisfying_Sheffer_1 satisfying_Sheffer_2 satisfying_Sheffer_3
  non empty ShefferStr;
reserve v,q,p,w,z,y,x for Element of L;

theorem 
  for x,w holds w | ((x | x) | x) = w | w;

theorem 
  for p,x holds x = (x | x) | (p | (p | p));

theorem 
  for y,w holds (w | w) | (w | (y | (y | y))) = w;

theorem 
  for q,p,y,w holds (((w | (y | (y | y))) | p) | ((q | q) | p)) =
  ((p | (w | q)) | (p | (w | q)));

theorem 
  for q,p,x holds (x | p) | ((q | q) | p) = ((p | ((x | x) | q)) |
  (p | ((x | x) | q)));

theorem 
  for w,p,y,q holds (((w | w) | p) | ((q | (y | (y | y))) | p)) =
  ((p | (w | q)) | (p | (w | q)));

theorem 
  for p,x holds x = (x | x) | ((p | p) | p);

theorem 
  for y,w holds (w | w) | (w | ((y | y) | y)) = w;

theorem 
  for y,w holds ((w | ((y | y) | y)) | (w | w)) = w;

theorem 
  for p,y,w holds ((w | ((y | y) | y)) | (p | (p | p))) = w;

theorem 
  for p,x,y holds (((y | (x | x)) | (y | (x | x))) | (p | (p | p))
  ) = ((x | x) | y);

theorem 
  for x,y holds y | (x | x) = (x | x) | y;

theorem 
  for y,w holds w | y = ((y | y) | (y | y)) | w;

theorem 
  for y,w holds w | y = y | w;

theorem 
  for x,p holds (p | x) | (p | ((x | x) | (x | x))) = (((x | x) |
  (x | x)) | p) | (((x | x) | (x | x)) | p);

theorem 
  for x,p holds (p | x) | (p | x) = (((x | x) | (x | x)) | p) | ((
  (x | x) | (x | x)) | p);

theorem 
  for x,p holds (p | x) | (p | x) = (x | p) | (((x | x) | (x | x)) | p);

theorem 
  for x,p holds (p | x) | (p | x) = (x | p) | (x | p);

theorem 
  for y,q,w holds ((w | q) | ((y | y) | y)) | ((w | q) | (w | q))
  = ((w | w) | (w | q)) | ((q | q) | (w | q));

theorem 
  for q,w holds w | q = ((w | w) | (w | q)) | ((q | q) | (w | q));

theorem 
  for q,p holds ((p | p) | (p | ((q | q) | q))) = ((((q | q) | (q
  | q)) | p) | ((q | q) | p));

theorem 
  for p,q holds p = ((((q | q) | (q | q)) | p) | ((q | q) | p));

theorem 
  for p,q holds p = (q | p) | ((q | q) | p);

theorem 
  for z,w,x holds ((((x | x) | w) | ((z | z) | w)) | ((w | (x | z)
) | (w | (x | z)))) = (((w | w) | (w | (x | z))) | (((x | z) | (x | z)) | (w |
  (x | z))));

theorem 
  for z,w,x holds ((((x | x) | w) | ((z | z) | w)) | ((w | (x | z)
  ) | (w | (x | z)))) = (w | (x | z));

theorem 
  for w,p holds ((p | p) | (p | (w | (w | w)))) = (((w | w) | p) |
  (((w | w) | (w | w)) | p));

theorem 
  for p,w holds p = ((w | w) | p) | (((w | w) | (w | w)) | p);

theorem 
  for p,w holds p = (((w | w) | p) | (w | p));

theorem 
  for z,q,x holds ((((x | x) | q) | ((z | z) | q)) | ((q | (x | z)
) | (q | (x | z)))) = ((((z | z) | (z | z)) | ((x | x) | q)) | ((q | q) | ((x |
  x) | q)));

theorem 
  for q,z,x holds (q | (x | z)) = ((((z | z) | (z | z)) | ((x | x)
  | q)) | ((q | q) | ((x | x) | q)));

theorem 
  for q,z,x holds (q | (x | z)) = ((z | ((x | x) | q)) | ((q | q)
  | ((x | x) | q)));

theorem 
  for w,y holds w | w = ((y | y) | y) | w;

theorem 
  for w,p holds ((p | w) | ((w | w) | p)) = p;

theorem 
  for y,w holds ((w | w) | ((w | w) | ((y | y) | y))) = (y | y) | y;

theorem 
  for y,w holds (w | w) | w = (y | y) | y;

theorem 
  for p,w holds (w | p) | (p | (w | w)) = p;

theorem 
  for w,p holds (p | (w | w)) | (w | p) = p;

theorem 
  for p,w holds (w | p) | (w | (p | p)) = w;

theorem 
  for x,y holds (y | (((y | (x | x)) | (y | (x | x))) | (x | y))) = x | y;

theorem 
  for p,w holds (w | (p | p)) | (w | p) = w;

theorem 
  for p,w,q,y holds (((y | y) | y) | q) | ((w | w) | q) = (q | ((
(p | (p | p)) | (p | (p | p))) | w)) | (q | (((p | (p | p)) | (p | (p | p))) |
  w));

theorem 
  for q,w,p holds (q | q) | ((w | w) | q) = (q | (((p | (p | p))
  | (p | (p | p))) | w)) | (q | (((p | (p | p)) | (p | (p | p))) | w));

theorem 
  for w,y,p holds (w | p) | (w | (p | (y | (y | y)))) = w;

theorem 
  for w,y,p holds (w | (p | (y | (y | y)))) | (w | p) = w;

theorem 
  for q,p,y holds (((y | y) | y) | p) | ((q | q) | p) = (p | ((p
  | p) | q)) | (p | ((p | p) | q));

theorem 
  for q,z,x holds (((q | ((x | x) | z)) | (q | ((x | x) | z))) |
((x | q) | ((z | z) | q))) = ((((z | z) | (z | z)) | (x | q)) | ((q | q) | (x |
  q)));

theorem 
  for q,z,x holds (((q | ((x | x) | z)) | (q | ((x | x) | z))) |
  ((x | q) | ((z | z) | q))) = ((z | (x | q)) | ((q | q) | (x | q)));

theorem 
  for w,q,z holds (((w | w) | ((z | z) | q)) | ((q | ((q | q) | z
)) | (q | ((q | q) | z)))) = (((z | z) | q) | (w | q)) | (((z | z) | q) | (w |
  q));

theorem 
  for q,p,x holds (((p | (x | p)) | (p | (x | p))) | (q | (q | q)
  )) = (x | x) | p;

theorem 
  for p,x holds p | (x | p) = (x | x) | p;

theorem 
  for p,y holds (y | p) | ((y | y) | p) = (p | p) | (y | p);

theorem 
  for x,y holds x = (x | x) | (y | x);

theorem 
  for x,y holds (y | x) | x = ((x | (y | y)) | (x | (y | y))) | ( y | x);

theorem 
  for x,z,y holds (((x | ((y | y) | z)) | (x | ((y | y) | z))) |
  ((y | x) | ((z | z) | x))) = (z | (y | x)) | x;

theorem 
  for x,y,z holds ((x | (((z | (z | z)) | (z | (z | z))) | y)) |
  (x | (((z | (z | z)) | (z | (z | z))) | y))) = x;

theorem 
  for x,z,y holds (x | ((y | y) | z)) | z = z | (y | x);

theorem 
  for x,y holds x | ((y | x) | x) = y | x;

theorem 
  for z,y,x holds y = (((x | x) | x) | y) | ((z | z) | y);

theorem 
  for z,y holds (y | ((y | y) | z)) | (y | ((y | y) | z)) = y;

theorem 
  for x,z,y holds (((y | y) | z) | (x | z)) | (((y | y) | z) | (x
  | z)) = ((x | x) | ((y | y) | z)) | z;

theorem 
  for x,z,y holds ((((y | y) | z) | (x | z)) | (((y | y) | z) | (
  x | z))) = z | (y | (x | x));

theorem 
  for y,x holds ((x | y) | (x | y)) | x = x | y;

theorem 
  for p,w holds (w | w) | (w | p) = w;

theorem 
  for w,p holds (p | w) | (w | w) = w;

theorem 
  for p,y,w holds (w | (y | (y | y))) | (w | p) = w;

theorem 
  for p,w holds ((w | p) | (w | w)) = w;

theorem 
  for y,p,w holds (w | p) | (w | (y | (y | y))) = w;

theorem 
  for p,q,w,y,x holds ((((x | (y | (y | y))) | w) | ((q | q) | w)
) | ((w | (x | q)) | (w | (x | q)))) = (((w | (p | (p | p))) | (w | (x | q))) |
  (((x | q) | (x | q)) | (w | (x | q))));

theorem 
  for q,w,y,x holds ((((x | (y | (y | y))) | w) | ((q | q) | w))
| ((w | (x | q)) | (w | (x | q)))) = (w | (((x | q) | (x | q)) | (w | (x | q)))
  );

theorem 
  for q,w,y,x holds (((x | (y | (y | y))) | w) | ((q | q) | w)) |
  ((w | (x | q)) | (w | (x | q))) = w | (x | q);

theorem 
  for z,p,q,y,x holds ((((x | (y | (y | y))) | q) | ((z | z) | q)
) | ((q | (x | z)) | (q | (x | z)))) = ((((z | z) | (p | (p | p))) | ((x | (y |
  (y | y))) | q)) | ((q | q) | ((x | (y | (y | y))) | q)));

theorem 
  for z,p,q,y,x holds q | (x | z) = (((z | z) | (p | (p | p))) |
  ((x | (y | (y | y))) | q)) | ((q | q) | ((x | (y | (y | y))) | q));

theorem 
  for z,q,y,x holds q | (x | z) = (z | ((x | (y | (y | y))) | q))
  | ((q | q) | ((x | (y | (y | y))) | q));

theorem 
  for v,p,y,x holds p | (x | v) = (v | ((x | (y | (y | y))) | p)) | p;

theorem 
  for y,w,z,v,x holds ((w | (z | (x | v))) | (((x | (y | (y | y))
  ) | z) | ((v | v) | z))) = z | (x | v);

theorem 
  for y,z,x holds ((y | ((x | x) | z)) | (y | ((x | x) | z))) | (
  (x | y) | ((z | z) | y)) = y | ((x | x) | z);

theorem 
  for z,y,x holds (z | (x | y)) | y = y | ((x | x) | z);

theorem 
  for x,w,y,z holds ((((x | x) | w) | ((z | (y | (y | y))) | w))
  | w) = w | (x | z);

theorem 
  for z,w,x holds (w | (z | ((x | x) | w))) = w | (x | z);

theorem 
  for p,z,y,x holds (((z | (x | p)) | (z | (x | p))) | (((x | (y
| (y | y))) | z) | ((p | p) | z))) = ((((p | p) | z) | ((x | (y | (y | y))) | z
  )) | (((p | p) | z) | ((x | (y | (y | y))) | z)));

theorem 
  for p,z,y,x holds (z | (x | p)) = ((((p | p) | z) | ((x | (y |
  (y | y))) | z)) | (((p | p) | z) | ((x | (y | (y | y))) | z)));

theorem 
  for z,p,y,x holds z | (x | p) = z | (p | ((x | (y | (y | y))) |
  (x | (y | (y | y)))));

theorem 
  for z,p,x holds z | (x | p) = z | (p | x);

theorem 
  for w,q,p holds (p | q) | w = w | (q | p);

theorem 
  for w,p,q holds ((q | p) | w) | q = q | ((p | p) | w);

theorem 
  for z,w,y,x holds w | x = (w | ((x | z) | (((x | (y | (y | y)))
  | (x | (y | (y | y)))) | w)));

theorem 
  for w,z,x holds w | x = w | ((x | z) | (x | w));

theorem 
  for q,x,z,y holds ((x | y) | (((x | (y | (z | (z | z)))) | q) |
  x)) = ((x | y) | (x | (y | (z | (z | z)))));

theorem 
  for x,q,z,y holds ((x | y) | (x | (((y | (z | (z | z))) | (y |
  (z | (z | z)))) | q))) = ((x | y) | (x | (y | (z | (z | z)))));

theorem 
  for z,x,q,y holds (x | y) | (x | (y | q)) = ((x | y) | (x | (y
  | (z | (z | z)))));

theorem 
  for x,q,y holds (x | y) | (x | (y | q)) = x;

theorem 
  L is satisfying_Sh_1;

registration
  cluster satisfying_Sheffer_1 satisfying_Sheffer_2 satisfying_Sheffer_3 ->
    satisfying_Sh_1 for non empty ShefferStr;
  cluster satisfying_Sh_1 -> satisfying_Sheffer_1 satisfying_Sheffer_2
    satisfying_Sheffer_3 for non empty ShefferStr;
end;

registration
  cluster satisfying_Sh_1 properly_defined -> Boolean Lattice-like for
non empty
    ShefferOrthoLattStr;
  cluster Boolean Lattice-like well-complemented properly_defined ->
    satisfying_Sh_1 for non empty ShefferOrthoLattStr;
end;














begin 

reserve p for Real;
reserve S,T for non trivial RealNormSpace;
reserve x0 for Point of S;
reserve f for PartFunc of S,T;
reserve c for constant sequence of S;
reserve R for RestFunc of S,T;

definition
  let X,Y,Z be RealNormSpace;
  let f be Element of BoundedLinearOperators(X,Y);
  let g be Element of BoundedLinearOperators(Y,Z);
  func g*f -> Element of BoundedLinearOperators(X,Z) equals

  modetrans(g,Y,Z)*
  modetrans(f,X,Y);
end;

definition
  let X,Y,Z be RealNormSpace;
  let f be Point of R_NormSpace_of_BoundedLinearOperators(X,Y);
  let g be Point of R_NormSpace_of_BoundedLinearOperators(Y,Z);
  func g*f -> Point of R_NormSpace_of_BoundedLinearOperators(X,Z) equals

  modetrans(g,Y,Z)*modetrans(f,X,Y);
end;

theorem 
  for x0 be Point of S st f is_differentiable_in x0 ex N being
  Neighbourhood of x0 st ( N c= dom f & for z be Point of S holds for h be
0-convergent non-zero Real_Sequence
for c st rng c = {x0} & rng (h*z+c) c= N holds h"
(#)(f/*(h*z+c) - f/*c) is convergent & diff(f,x0).z = lim (h"(#)(f/*(h*z+c) - f
  /*c)) );

theorem 
  for x0 be Point of S st f is_differentiable_in x0 for z be Point of S
  for h be 0-convergent non-zero Real_Sequence
  for c st rng c = {x0} & rng (h*z+c) c=
dom f holds h"(#)(f/*(h*z+c) - f/*c) is convergent & diff(f,x0).z = lim (h"(#)(
  f/*(h*z+c) - f/*c));

theorem 
  for x0 be Point of S for N be Neighbourhood of x0 st N c= dom f
  for z be Point of S for dv be Point of T holds
  ( (for h be 0-convergent non-zero
Real_Sequence for c st ( rng c = {x0} & rng (h*z+c) c= N ) holds h"(#)(f/*(h*z+
  c) - f/*c) is convergent & dv = lim (h"(#)(f/*(h*z+c) - f/*c))) iff for e be
Real st e > 0 holds ex d be Real st d > 0 & for h be Real st abs(h) < d & h <>
  0 & h*z+x0 in N holds ||. h"*(f/.(h*z+x0) - f/.x0) - dv .|| < e );

definition
  let S,T;
  let f;
  let x0 be Point of S;
  let z be Point of S;
  pred f is_Gateaux_differentiable_in x0,z means


  ex N be Neighbourhood
of x0 st N c= dom f & ex dv be Point of T st for e be Real st e > 0 holds ex d
be Real st d > 0 & for h be Real st abs(h) < d & h <> 0 & h*z+x0 in N holds ||.
  h"*(f/.(h*z+x0) - f/.x0) - dv .|| < e;
end;

theorem 
  (for X be RealNormSpace, x,y be Point of X holds ||.x-y.|| > 0
iff x <> y) & (for X be RealNormSpace, x,y be Point of X holds ||.x-y.|| = ||.y
-x.||) & (for X be RealNormSpace, x,y be Point of X holds ||.x-y.|| = 0 iff x =
y) & (for X be RealNormSpace, x,y be Point of X holds ||.x-y.|| <> 0 iff x <> y
) & (for X be RealNormSpace, x,y,z be Point of X, e be Real st e > 0 holds ( (
  ||.x-z.|| <e/2 & ||.z-y.|| <e/2) implies ||.x-y.|| <e) ) & (for X be
RealNormSpace, x,y,z be Point of X, e be Real st e > 0 holds ( (||.x-z.|| <e/2
& ||.y-z.|| <e/2) implies ||.x-y.|| <e) ) & (for X be RealNormSpace, x be Point
  of X st ( for e be Real st e>0 holds ||.x.|| <e ) holds x=0.X ) & for X be
RealNormSpace, x,y be Point of X st ( for e be Real st e>0 holds ||.x-y.|| <e )
  holds x=y;

definition
  let S,T;
  let f;
  let x0 be Point of S;
  let z be Point of S;
  assume
 f is_Gateaux_differentiable_in x0,z;
  func Gateaux_diff(f,x0,z) -> Point of T means


  ex N be Neighbourhood
of x0 st N c= dom f & for e be Real st e > 0 holds ex d be Real st d > 0 & for
h be Real st abs(h) < d & h <> 0 & h*z+x0 in N holds ||. h"*(f/.(h*z+x0) - f/.
  x0) - it .|| < e;
end;

theorem 
  for x0 be Point of S, z be Point of S holds ( f
is_Gateaux_differentiable_in x0,z iff ex N being Neighbourhood of x0 st ( N c=
dom f & ex dv be Point of T st
for h be 0-convergent non-zero Real_Sequence for c st
rng c = {x0} & rng (h*z+c) c= N holds h"(#)(f/*(h*z+c) - f/*c) is convergent &
  dv= lim (h"(#)(f/*(h*z+c) - f/*c)) ) );

theorem 
  for x0 be Point of S st f is_differentiable_in x0 for z be Point of S
holds ( f is_Gateaux_differentiable_in x0,z & Gateaux_diff(f,x0,z)=diff(f,x0).z
  & ex N being Neighbourhood of x0 st
  ( N c= dom f & for h be 0-convergent non-zero
Real_Sequence, c st rng c = {x0} & rng (h*z+c) c= N holds h"(#)(f/*(h*z+c) - f
  /*c) is convergent & Gateaux_diff(f,x0,z)= lim (h"(#)(f/*(h*z+c) - f/*c))) );

reserve U for non trivial RealNormSpace;

theorem 
  for R be RestFunc of S,T st R/.0.S=0.T for e be Real st e > 0 ex d be
  Real st d > 0 & for h be Point of S st ||.h.|| < d holds ||.R/.h.|| <= e*||.h
  .||;

theorem 
  for R be RestFunc of T,U st R/.0.T=0.U
  for L be Lipschitzian LinearOperator of
  S,T holds R*L is RestFunc of S,U;

theorem 
  for R be RestFunc of S,T for L be Lipschitzian LinearOperator of T,U holds
  L*R is RestFunc of S,U;

theorem 
  for R1 be RestFunc of S,T st R1/.0.S=0.T
  for R2 be RestFunc of T,U st R2/.0.T=0.U holds R2*R1 is RestFunc of S,U;

theorem 
  for R1 be RestFunc of S,T st R1/.0.S=0.T for R2 be RestFunc of T,U st R2
/.0.T=0.U for L be Lipschitzian LinearOperator of S,T holds
R2*(L+R1) is RestFunc of S,U;

theorem 
  for R1 be RestFunc of S,T st R1/.0.S=0.T for R2 be RestFunc of T,U st R2
  /.0.T=0.U for L1 be Lipschitzian LinearOperator of S,T
  for L2 be Lipschitzian
  LinearOperator of T,U holds L2*R1+ R2*(L1+R1) is RestFunc of S,U;

theorem 
  for f1 be PartFunc of S,T st f1 is_differentiable_in x0 for f2 be
  PartFunc of T,U st f2 is_differentiable_in (f1/.x0) holds f2*f1
  is_differentiable_in x0 & diff(f2*f1,x0) = diff(f2,f1/.x0)*diff(f1,x0);















begin

definition
  let FT be non empty RelStr, A,B be Subset of FT;
  pred A,B are_separated means


  A^b misses B & A misses B^b;
  symmetry;
end;

theorem 
  for FT being filled non empty RelStr, A being Subset of FT, n,m
  being Element of NAT st n<=m holds Finf(A,n) c= Finf(A,m);

theorem 
  for FT being filled non empty RelStr, A being Subset of FT, n,m
  being Element of NAT st n<=m holds Fcl(A,n) c= Fcl(A,m);

theorem 
  for FT being filled non empty RelStr, A being Subset of FT, n,m
  being Element of NAT st n<=m holds Fdfl(A,m) c= Fdfl(A,n);

theorem 
  for FT being filled non empty RelStr, A being Subset of FT, n,m
  being Element of NAT st n<=m holds Fint(A,m) c= Fint(A,n);

theorem 
  for FT being non empty RelStr,A,B being Subset of FT st A,B
  are_separated holds B,A are_separated;

theorem 
  for FT being filled non empty RelStr, A,B being Subset of FT st
  A,B are_separated holds A misses B;

theorem 
  for FT being non empty RelStr, A,B being Subset of FT st FT is
  symmetric holds A,B are_separated iff A^f misses B & A misses (B^f);

theorem 
  for FT being filled non empty RelStr, A,B being Subset of FT st
  FT is symmetric & A^b misses B holds A misses (B^b);

theorem 
  for FT being filled non empty RelStr, A,B being Subset of FT st FT
  is symmetric & A misses (B^b) holds A^b misses B;

theorem 
  for FT being filled non empty RelStr, A,B being Subset of FT st FT
  is symmetric holds A,B are_separated iff A^b misses B;

theorem 
  for FT being filled non empty RelStr, A,B being Subset of FT st FT
  is symmetric holds A,B are_separated iff A misses (B^b);

theorem 
  for FT being filled non empty RelStr, IT being Subset of FT st
FT is symmetric holds IT is connected iff (for A, B being Subset of FT st IT =
  A \/ B & A,B are_separated holds A = IT or B = IT);

theorem 
  for FT being filled non empty RelStr, B being Subset of FT st FT is
symmetric holds B is connected iff not (ex C being Subset of FT st C<>{} & B\C
  <>{} & C c= B & (C^b) misses (B\C));

definition
  let FT1,FT2 be non empty RelStr, f be Function of FT1, FT2, n be Element of
  NAT;
  pred f is_continuous n means


  for x being Element of FT1,y being
Element of FT2 st x in the carrier of FT1 & y=f.x holds f.:(U_FT(x,0)) c= U_FT(
  y,n);
end;

theorem 
  for FT1 being non empty RelStr, FT2 being filled non empty RelStr, n
being Element of NAT, f being Function of FT1, FT2 st f is_continuous 0 holds f
  is_continuous n;

theorem 
  for FT1 being non empty RelStr, FT2 being filled non empty RelStr,
n0,n being Element of NAT, f being Function of FT1, FT2 st f is_continuous n0 &
  n0<=n holds f is_continuous n;

theorem 
  for FT1,FT2 being non empty RelStr, A being Subset of FT1,B
being Subset of FT2, f being Function of FT1, FT2 st f is_continuous 0 & B=f.:A
  holds f.:(A^b) c= B^b;

theorem 
  for FT1,FT2 being non empty RelStr,A being Subset of FT1, B being
Subset of FT2, f being Function of FT1, FT2 st A is connected & f is_continuous
  0 & B=f.:A holds B is connected;



definition
  let n be Nat;
  func Nbdl1 n -> Relation of Seg n means


  for i being Element of NAT st
  i in Seg n holds Im(it,i)={i,max(i-'1,1),min(i+1,n)};
end;

definition
  let n be Nat;
  assume
 n>0;
  func FTSL1 n -> non empty RelStr equals


  RelStr(# Seg n,Nbdl1 n #);
end;

theorem 
  for n being Nat st n>0 holds FTSL1 n is filled;

theorem 
  for n being Nat st n>0 holds FTSL1 n is symmetric;



definition
  let n be Nat;
  func Nbdc1 n -> Relation of Seg n means


  for i being Element of NAT st
i in Seg n holds (1<i & i<n implies Im(it,i)={i,i-'1,i+1})& (i=1 & i<n implies
  Im(it,i)={i,n,i+1}) & (1<i & i=n implies Im(it,i)={i,i-'1,1}) & (i=1 & i=n
  implies Im(it,i)={i});
end;

definition
  let n be Nat;
  assume
 n>0;
  func FTSC1 n -> non empty RelStr equals


  RelStr(# Seg n,Nbdc1 n #);
end;

theorem 
  for n being Element of NAT st n>0 holds FTSC1 n is filled;

theorem 
  for n being Element of NAT st n>0 holds FTSC1 n is symmetric;














begin

reserve i, k, m, n for Element of NAT,
  r, s for Real,
  rn for real number,
  x, y , z, X for set,
  T, T1, T2 for non empty TopSpace,
  p, q for Point of T,
  A, B, C for Subset of T,
  A9 for non empty Subset of T,
  pq for Element of [:the carrier of T,the carrier of T:],
  pq9 for Point of [:T,T:],
  pmet,pmet1 for Function of [:the carrier of T,the carrier of T:],REAL,
  pmet9,pmet19 for RealMap of [:T,T:] ,
  f,f1 for RealMap of T,
  FS2 for Functional_Sequence of [:the carrier of T,the carrier of T:],REAL,
  seq for Real_Sequence;

theorem 
  for i st i>0 ex n,m st i=(2|^n)*(2*m+1);

definition
  func PairFunc -> Function of [:NAT,NAT:],NAT means


  for n,m holds it.[ n,m] = (2|^n)*(2*m+1)-1;
end;

theorem 
  PairFunc is bijective;

definition
  let X be set,f be Function of [:X,X:],REAL,x be Element of X;
  func dist(f,x) -> Function of X,REAL means


  for y be Element of X holds it.y = f.(x,y);
end;

theorem 
  for D be Subset of [:T1,T2:] st D is open for x1 be Point of T1,
  x2 be Point of T2 for X1 be Subset of T1,X2 be Subset of T2 holds (X1=pr1(the
carrier of T1,the carrier of T2).:(D/\[:the carrier of T1,{x2}:]) implies X1 is
open) & (X2=pr2(the carrier of T1,the carrier of T2).:(D/\[:{x1},the carrier of
  T2:]) implies X2 is open);

theorem 
  for pmet st for pmet9 st pmet=pmet9 holds pmet9 is continuous for
  x be Point of T holds dist(pmet,x) is continuous;

definition
  let X be non empty set,f be Function of [:X,X:],REAL,A be Subset of X;
  func lower_bound(f,A) -> Function of X,REAL means


  for x be Element of X holds it.x = lower_bound((dist(f,x)).:A);
end;

theorem 
  for X be non empty set,f be Function of [:X,X:],REAL st f
  is_a_pseudometric_of X for A be non empty Subset of X,x be Element of X holds
  lower_bound(f,A).x>=0;

theorem 
  for X be non empty set,f be Function of [:X,X:],REAL st f
  is_a_pseudometric_of X for A be Subset of X,x be Element of X holds x in A
  implies lower_bound(f,A).x=0;

theorem 
  for pmet st pmet is_a_pseudometric_of the carrier of T for x,y be
Point of T,A be non empty Subset of T
 holds abs(lower_bound(pmet,A).x-lower_bound(pmet,A).y)<=
  pmet.(x,y);

theorem 
  for pmet st pmet is_a_pseudometric_of the carrier of T & for p
holds dist(pmet,p) is continuous for A be non empty Subset of T
holds lower_bound(pmet,
  A) is continuous;

theorem 
  for f be Function of [:X,X:],REAL st f is_metric_of X holds f
  is_a_pseudometric_of X;

theorem 
  for pmet st pmet is_metric_of the carrier of T & (for A be non
empty Subset of T holds Cl A={p where p is Point of T:lower_bound(pmet,A).p=0})
 holds T
  is metrizable;

theorem 
  for FS2 st (for n ex pmet st FS2.n=pmet & pmet
  is_a_pseudometric_of the carrier of T) & for pq holds FS2#pq is summable for
  pmet st for pq holds pmet.pq=Sum(FS2#pq) holds pmet is_a_pseudometric_of the
  carrier of T;

theorem 
  for n,seq st for m st m<=n holds seq.m<=r for m st m<=n holds
  Partial_Sums(seq).m <= r * (m+1);

theorem 
  for k holds abs(Partial_Sums(seq).k)<=Partial_Sums(abs(seq)).k;

theorem 
  for FS1 being Functional_Sequence of the carrier of T,REAL st (
for n ex f st FS1.n=f & f is continuous & for p holds f.p>=0) & (ex seq st seq
is summable & for n,p holds (FS1#p).n<=seq.n) for f st for p holds f.p=Sum(FS1#
  p) holds f is continuous;

theorem 
  for s, FS2 st for n ex pmet st FS2.n=pmet & pmet
  is_a_pseudometric_of the carrier of T & (for pq holds pmet.pq<=s) & for pmet9
st pmet=pmet9 holds pmet9 is continuous for pmet st for pq holds pmet.pq=Sum((1
  /2)GeoSeq(#)(FS2#pq)) holds pmet is_a_pseudometric_of the carrier of T & for
  pmet9 st pmet=pmet9 holds pmet9 is continuous;

theorem 
  for pmet st pmet is_a_pseudometric_of the carrier of T & for
pmet9 st pmet=pmet9 holds pmet9 is continuous for A be non empty Subset of T,p
  holds p in Cl A implies lower_bound(pmet,A).p=0;

theorem 
  for T st T is T_1 for s, FS2 st (for n ex pmet st FS2.n=pmet &
  pmet is_a_pseudometric_of the carrier of T & (for pq holds pmet.pq<=s) & for
  pmet9 st pmet=pmet9 holds pmet9 is continuous) & for p,A9 st not p in A9 & A9
is closed ex n st for pmet st FS2.n=pmet holds lower_bound(pmet,A9).p>0
holds (ex pmet
st pmet is_metric_of the carrier of T & for pq holds pmet.pq=Sum((1/2)GeoSeq(#)
  (FS2#pq))) & T is metrizable;

theorem 
  for D being non empty set, p,q be FinSequence of D,B be BinOp of
  D st p is one-to-one & q is one-to-one & rng q c= rng p & B is commutative
  associative & (B is having_a_unity or len q>=1 & len p>len q) holds ex r be
FinSequence of D st r is one-to-one & rng r=rng p \rng q & B "**" p =B.(B "**"
  q,B "**" r);

registration
  let T1,T2 be TopSpace;
  let f be RealMap of [:T1,T2:];
  let t1 be Point of T1, t2 be Point of T2;
  cluster f.(t1,t2) -> real;
end;:$N Nagata-Smirnov Theorem
theorem 
  for T holds (T is regular & T is T_1 & ex Bn being
  FamilySequence of T st Bn is Basis_sigma_locally_finite) iff T is metrizable;

theorem 
  T is metrizable implies for FX be Subset-Family of T st FX is
  Cover of T & FX is open ex Un be FamilySequence of T st Union Un is open &
  Union Un is Cover of T & Union Un is_finer_than FX & Un is sigma_discrete;

theorem 
  for T st T is metrizable ex Un be FamilySequence of T st Un is
  Basis_sigma_discrete;


theorem 
  for T holds (T is regular & T is T_1 & ex Bn being FamilySequence of T
  st Bn is Basis_sigma_discrete) iff T is metrizable;














begin

reserve M for non empty set;
reserve V for ComplexNormSpace;
reserve f,f1,f2,f3 for PartFunc of M,V;
reserve z,z1,z2 for Element of COMPLEX;





definition

  let M be non empty set;
  let V be ComplexNormSpace;
  let f1 be PartFunc of M, COMPLEX;
  let f2 be PartFunc of M, V;
  func f1(#)f2 -> PartFunc of M,V means


  dom it = dom f1 /\ dom f2 &
  for c be Element of M st c in dom it holds it/.c = (f1/.c) * (f2/.c);
end;

definition

  let X be non empty set;
  let V be ComplexNormSpace;
  let f be PartFunc of X,V;
  let z be Complex;
  func z(#)f -> PartFunc of X,V means


  dom it = dom f &
  for x be Element of X st x in dom it holds it/.x = z * (f/.x);
end;

theorem 
  for f1 be PartFunc of M,COMPLEX, f2 be PartFunc of M,V
holds dom (f1(#)f2) \ (f1(#)f2)"{0.V} = (dom f1 \ (f1)"{0}) /\ (dom f2 \ (f2)"{
  0.V});

theorem 
  (||.f.||)"{0} = f"{0.V} & (-f)"{0.V} = f"{0.V};

theorem 
  z<>0c implies (z(#)f)"{0.V} = f"{0.V};





theorem 
  f1 + f2 = f2 + f1;

definition
  let M,V; let f1,f2;
  redefine func f1+f2;
  commutativity;
end;

theorem 
  (f1 + f2) + f3 = f1 + (f2 + f3);

theorem 
  for f1,f2 be PartFunc of M,COMPLEX,f3 be PartFunc of M,V
  holds (f1 (#) f2) (#) f3 = f1 (#) (f2 (#) f3);

theorem 
  for f1,f2 be PartFunc of M,COMPLEX holds
  (f1 + f2) (#) f3 = f1 (#) f3 + f2 (#) f3;

theorem 
  for f3 be PartFunc of M,COMPLEX holds f3(#)(f1 + f2) = f3(#)f1 + f3(#) f2;

theorem 
  for f1 be PartFunc of M,COMPLEX holds z (#) (f1 (#) f2) = z (#) f1 (#) f2;

theorem 
  for f1 be PartFunc of M,COMPLEX holds z (#) (f1 (#) f2) = f1 (#) (z (#) f2);

theorem 
  for f1,f2 be PartFunc of M,COMPLEX holds (f1 - f2) (#) f3 = f1(#)f3 - f2(#)f3
;

theorem 
  for f3 be PartFunc of M,COMPLEX holds f3(#)f1 - f3(#)f2 = f3(#)(f1 - f2);

theorem 
  z(#)(f1 + f2) = z(#)f1 + z(#)f2;

theorem 
  (z1*z2)(#)f = z1(#)(z2(#)f);

theorem 
  z(#)(f1 - f2) = z(#)f1 - z(#)f2;

theorem 
  f1-f2 = (-1r)(#)(f2-f1);

theorem 
  f1 - (f2 + f3) = f1 - f2 - f3;

theorem 
  1r(#)f = f;

theorem 
  f1 - (f2 - f3) = f1 - f2 + f3;

theorem 
  f1 + (f2 - f3) = f1 + f2 - f3;

theorem 
  for f1 be PartFunc of M,COMPLEX holds ||.f1(#)f2.|| = |.f1.|(#)||.f2 .||;

theorem 
  ||.z(#)f.|| = |.z.|(#)||.f.||;

theorem 
  -f = (-1r)(#)f;

theorem 
  -(-f) = f;

theorem 
  f1 - f2 = f1 + -f2;

theorem 
  f1 - (-f2) = f1 + f2;

reserve X,Y for set;

theorem 
  (f1+f2)|X = f1|X + f2|X & (f1+f2)|X = f1|X + f2 & (f1+f2)|X = f1 + f2|X;

theorem 
  for f1 be PartFunc of M,COMPLEX holds (f1(#)f2)|X = f1|X (#) f2|X & (
  f1(#)f2)|X = f1|X (#) f2 & (f1(#)f2)|X = f1 (#) f2|X;

theorem 
  (-f)|X = -(f|X) & (||.f.||)|X = ||.(f|X).||;

theorem 
  (f1-f2)|X = f1|X - f2|X & (f1-f2)|X = f1|X - f2 &(f1-f2)|X = f1 - f2|X;

theorem 
  (z(#)f)|X = z(#)(f|X);





theorem 
  (f1 is total & f2 is total iff f1+f2 is total) & (f1 is total &
  f2 is total iff f1-f2 is total);

theorem 
  for f1 be PartFunc of M,COMPLEX holds (f1 is total & f2 is total
  iff f1(#)f2 is total);

theorem 
  f is total iff z(#)f is total;

theorem 
  f is total iff -f is total;

theorem 
  f is total iff ||.f.|| is total;

theorem 
  for x be Element of M st f1 is total & f2 is total holds (f1+f2)/.x =
  (f1/.x) + (f2/.x) & (f1-f2)/.x = (f1/.x) - (f2/.x);

theorem 
  for f1 be PartFunc of M,COMPLEX, x be Element of M holds f1 is total &
  f2 is total implies (f1(#)f2)/.x = f1/.x * (f2/.x);

theorem 
  for x be Element of M st f is total holds (z(#)f)/.x = z * (f/.x);

theorem 
  for x be Element of M st f is total holds (-f)/.x = - f/.x & (||.f.||)
  .x = ||. f/.x .||;






definition
  let M;
  let V;
  let f,Y;
  pred f is_bounded_on Y means


  ex r be Real st for x be Element of M st
  x in Y /\ dom f holds ||.f/.x.|| <= r;
end;

theorem 
  Y c= X & f is_bounded_on X implies f is_bounded_on Y;

theorem 
  X misses dom f implies f is_bounded_on X;

theorem 
  0c(#)f is_bounded_on Y;

theorem 
  f is_bounded_on Y implies z(#)f is_bounded_on Y;

theorem 
  f is_bounded_on Y implies ||.f.|||Y is bounded & -f is_bounded_on Y;

theorem 
  f1 is_bounded_on X & f2 is_bounded_on Y implies f1+f2 is_bounded_on (X /\ Y);

theorem 
  for f1 be PartFunc of M,COMPLEX holds f1|X is bounded & f2
  is_bounded_on Y implies f1(#)f2 is_bounded_on (X /\ Y);

theorem 
  f1 is_bounded_on X & f2 is_bounded_on Y implies f1-f2 is_bounded_on X /\ Y;

theorem 
  f is_bounded_on X & f is_bounded_on Y implies f is_bounded_on X \/ Y;

theorem 
  f1|X is constant & f2|Y is constant implies (f1+f2)|(X /\ Y) is
  constant & (f1-f2)|(X /\ Y) is constant;

theorem 
  for f1 be PartFunc of M,COMPLEX holds f1|X is constant & f2|Y is
  constant implies (f1(#)f2)|(X /\ Y) is constant;

theorem 
  f|Y is constant implies (z(#)f)|Y is constant;

theorem 
  f|Y is constant implies ||.f.|||Y is constant & (-f)|Y is constant;

theorem 
  f|Y is constant implies f is_bounded_on Y;

theorem 
  f|Y is constant implies (for z holds z(#)f is_bounded_on Y) & -f
  is_bounded_on Y & ||.f.|||Y is bounded;

theorem 
  f1 is_bounded_on X & f2|Y is constant implies f1+f2 is_bounded_on (X /\ Y);

theorem 
  f1 is_bounded_on X & f2|Y is constant implies f1-f2 is_bounded_on X /\
  Y & f2-f1 is_bounded_on X /\ Y;














begin 

reserve n,m for Element of NAT;
reserve r,s for Real;
reserve z for Complex;
reserve CNS,CNS1,CNS2 for ComplexNormSpace;
reserve RNS for RealNormSpace;

theorem 
  for seq be sequence of CNS holds -seq=(-1r)*seq;

definition

  let CNS;
  let x0 be Point of CNS;
  mode Neighbourhood of x0 -> Subset of CNS means


    ex g be Real st 0<g & {y where y is Point of CNS: ||.y-x0 .|| < g} c= it;
end;

theorem 
  for x0 be Point of CNS for g be Real st 0 < g holds {y where y is
  Point of CNS: ||.y-x0 .|| < g} is Neighbourhood of x0;

theorem 
  for x0 be Point of CNS for N being Neighbourhood of x0 holds x0 in N;

definition
  let CNS;
  let X be Subset of CNS;
  attr X is compact means


  for s1 be sequence of CNS st rng s1 c= X ex
s2 be sequence of CNS st s2 is subsequence of s1 & s2 is convergent & lim s2 in
  X;
end;

definition
  let CNS;
  let X be Subset of CNS;
  attr X is closed means

  for s1 be sequence of CNS st rng s1 c= X & s1 is
  convergent holds lim s1 in X;
end;

definition
  let CNS;
  let X be Subset of CNS;
  attr X is open means

  X` is closed;
end;

definition

  let CNS1,CNS2;
  let f be PartFunc of CNS1,CNS2;
  let x0 be Point of CNS1;
  pred f is_continuous_in x0 means


  x0 in dom f & for seq be sequence
of CNS1 st rng seq c= dom f & seq is convergent & lim seq = x0 holds f/*seq is
  convergent & f/.x0 = lim (f/*seq);
end;

definition
  let CNS,RNS;
  let f be PartFunc of CNS,RNS;
  let x0 be Point of CNS;
  pred f is_continuous_in x0 means


  x0 in dom f & for seq be sequence
  of CNS st rng seq c= dom f & seq is convergent & lim seq = x0 holds f/*seq is
  convergent & f/.x0 = lim (f/*seq);
end;

definition
  let RNS;
  let CNS;
  let f be PartFunc of RNS,CNS;
  let x0 be Point of RNS;
  pred f is_continuous_in x0 means


  x0 in dom f & for seq be sequence
  of RNS st rng seq c= dom f & seq is convergent & lim seq = x0 holds f/*seq is
  convergent & f/.x0 = lim (f/*seq);
end;

definition
  let CNS;
  let f be PartFunc of the carrier of CNS,COMPLEX;
  let x0 be Point of CNS;
  pred f is_continuous_in x0 means


  x0 in dom f & for seq be sequence
  of CNS st rng seq c= dom f & seq is convergent & lim seq = x0 holds f/*seq is
  convergent & f/.x0 = lim (f/*seq);
end;

definition
  let CNS;
  let f be PartFunc of the carrier of CNS,REAL;
  let x0 be Point of CNS;
  pred f is_continuous_in x0 means


  x0 in dom f & for seq be sequence
  of CNS st rng seq c= dom f & seq is convergent & lim seq = x0 holds f/*seq is
  convergent & f/.x0 = lim (f/*seq);
end;

definition
  let RNS;
  let f be PartFunc of the carrier of RNS,COMPLEX;
  let x0 be Point of RNS;
  pred f is_continuous_in x0 means


  x0 in dom f & for seq be sequence
  of RNS st rng seq c= dom f & seq is convergent & lim seq = x0 holds f/*seq is
  convergent & f/.x0 = lim (f/*seq);
end;

theorem 
  for seq be sequence of CNS1, h be PartFunc of CNS1,CNS2 st rng
  seq c= dom h holds seq.n in dom h;

theorem 
  for seq be sequence of CNS, h be PartFunc of CNS,RNS st rng seq
  c= dom h holds seq.n in dom h;

theorem 
  for seq be sequence of RNS, h be PartFunc of RNS,CNS st rng seq
  c= dom h holds seq.n in dom h;

theorem 
  for seq be sequence of CNS, x be set holds x in rng seq iff ex n st x = seq.n
;

theorem 
  for f be PartFunc of CNS1,CNS2, x0 be Point of CNS1 holds f
  is_continuous_in x0 iff x0 in dom f & for r st 0<r ex s st 0<s & for x1 be
  Point of CNS1 st x1 in dom f & ||. x1- x0 .|| <s holds ||. f/.x1-f/.x0 .||<r;

theorem 
  for f be PartFunc of CNS,RNS, x0 be Point of CNS holds f
  is_continuous_in x0 iff x0 in dom f & for r st 0<r ex s st 0<s & for x1 be
  Point of CNS st x1 in dom f & ||. x1- x0 .|| <s holds ||. f/.x1-f/.x0 .||<r;

theorem 
  for f be PartFunc of RNS,CNS, x0 be Point of RNS holds f
  is_continuous_in x0 iff x0 in dom f & for r st 0<r ex s st 0<s & for x1 be
  Point of RNS st x1 in dom f & ||. x1- x0 .|| < s holds ||. f/.x1-f/.x0 .||<r;

theorem 
  for f be PartFunc of the carrier of CNS,REAL, x0 be Point of CNS
  holds (f is_continuous_in x0 iff x0 in dom f & for r st 0<r ex s st 0<s & for
x1 be Point of CNS st x1 in dom f & ||. x1- x0 .|| <s holds abs( f/.x1-f/.x0 )<
  r );

theorem 
  for f be PartFunc of the carrier of CNS,COMPLEX, x0 be Point of
CNS holds (f is_continuous_in x0 iff x0 in dom f & for r st 0 < r ex s st 0 < s
& for x1 be Point of CNS st x1 in dom f & ||. x1- x0 .|| <s holds |. f/.x1-f/.
  x0 .|<r );

theorem 
  for f be PartFunc of the carrier of RNS,COMPLEX, x0 be Point of
  RNS holds (f is_continuous_in x0 iff x0 in dom f & for r st 0<r ex s st 0<s &
for x1 be Point of RNS st x1 in dom f & ||. x1- x0 .|| <s holds |. f/.x1-f/.x0
  .|<r );

theorem 
  for f be PartFunc of CNS1,CNS2,x0 be Point of CNS1 holds f
is_continuous_in x0 iff x0 in dom f & for N1 being Neighbourhood of f/.x0 ex N
  being Neighbourhood of x0 st for x1 be Point of CNS1 st x1 in dom f & x1 in N
  holds f/.x1 in N1;

theorem 
  for f be PartFunc of CNS,RNS,x0 be Point of CNS holds f
is_continuous_in x0 iff x0 in dom f & for N1 being Neighbourhood of f/.x0 ex N
  being Neighbourhood of x0 st for x1 be Point of CNS st x1 in dom f & x1 in N
  holds f/.x1 in N1;

theorem 
  for f be PartFunc of RNS,CNS, x0 be Point of RNS holds f
is_continuous_in x0 iff x0 in dom f & for N1 being Neighbourhood of f/.x0 ex N
  being Neighbourhood of x0 st for x1 be Point of RNS st x1 in dom f & x1 in N
  holds f/.x1 in N1;

theorem 
  for f be PartFunc of CNS1,CNS2, x0 be Point of CNS1 holds f
is_continuous_in x0 iff x0 in dom f & for N1 being Neighbourhood of f/.x0 ex N
  being Neighbourhood of x0 st f.:N c= N1;

theorem 
  for f be PartFunc of CNS,RNS, x0 be Point of CNS holds f
is_continuous_in x0 iff x0 in dom f & for N1 being Neighbourhood of f/.x0 ex N
  being Neighbourhood of x0 st f.:N c= N1;

theorem 
  for f be PartFunc of RNS,CNS, x0 be Point of RNS holds f
is_continuous_in x0 iff x0 in dom f & for N1 being Neighbourhood of f/.x0 ex N
  being Neighbourhood of x0 st f.:N c= N1;

theorem 
  for f be PartFunc of CNS1,CNS2, x0 be Point of CNS1 st x0 in dom f & (
  ex N be Neighbourhood of x0 st dom f /\ N = {x0}) holds f is_continuous_in x0
;

theorem 
  for f be PartFunc of CNS,RNS, x0 be Point of CNS st x0 in dom f & (ex
  N be Neighbourhood of x0 st dom f /\ N = {x0}) holds f is_continuous_in x0;

theorem 
  for f be PartFunc of RNS,CNS, x0 be Point of RNS st x0 in dom f & (ex
  N be Neighbourhood of x0 st dom f /\ N = {x0}) holds f is_continuous_in x0;

theorem 
  for h1,h2 be PartFunc of CNS1,CNS2, seq be sequence of CNS1 st
rng seq c= dom h1 /\ dom h2 holds (h1+h2)/*seq=h1/*seq+h2/*seq & (h1-h2)/*seq=
  h1/*seq-h2/*seq;

theorem 
  for h1,h2 be PartFunc of CNS,RNS, seq be sequence of CNS st rng
seq c= dom h1 /\ dom h2 holds (h1+h2)/*seq=h1/*seq+h2/*seq & (h1-h2)/*seq=h1/*
  seq-h2/*seq;

theorem 
  for h1,h2 be PartFunc of RNS,CNS, seq be sequence of RNS st rng
seq c= dom h1 /\ dom h2 holds (h1+h2)/*seq=h1/*seq+h2/*seq & (h1-h2)/*seq=h1/*
  seq-h2/*seq;

theorem 
  for h be PartFunc of CNS1,CNS2, seq be sequence of CNS1, z be
  Complex st rng seq c= dom h holds (z(#)h)/*seq = z*(h/*seq);

theorem 
  for h be PartFunc of CNS,RNS, seq be sequence of CNS, r be Real
  st rng seq c= dom h holds (r(#)h)/*seq = r*(h/*seq);

theorem 
  for h be PartFunc of RNS,CNS, seq be sequence of RNS, z be
  Complex st rng seq c= dom h holds (z(#)h)/*seq = z*(h/*seq);

theorem 
  for h be PartFunc of CNS1,CNS2, seq be sequence of CNS1 st rng
  seq c= dom h holds ||. h/*seq .|| = ||.h.||/*seq & -(h/*seq) = (-h)/*seq;

theorem 
  for h be PartFunc of CNS,RNS, seq be sequence of CNS st rng seq
  c= dom h holds ||. h/*seq .|| = ||.h.||/*seq & -(h/*seq) = (-h)/*seq;

theorem 
  for h be PartFunc of RNS,CNS, seq be sequence of RNS st rng seq
  c= dom h holds ||. h/*seq .|| = ||.h.||/*seq & -(h/*seq) = (-h)/*seq;

theorem 
  for f1,f2 be PartFunc of CNS1,CNS2, x0 be Point of CNS1 st f1
is_continuous_in x0 & f2 is_continuous_in x0 holds f1+f2 is_continuous_in x0 &
  f1-f2 is_continuous_in x0;

theorem 
  for f1,f2 be PartFunc of CNS,RNS, x0 be Point of CNS st f1
is_continuous_in x0 & f2 is_continuous_in x0 holds f1+f2 is_continuous_in x0 &
  f1-f2 is_continuous_in x0;

theorem 
  for f1,f2 be PartFunc of RNS,CNS, x0 be Point of RNS st f1
is_continuous_in x0 & f2 is_continuous_in x0 holds f1+f2 is_continuous_in x0 &
  f1-f2 is_continuous_in x0;

theorem 
  for f be PartFunc of CNS1,CNS2, x0 be Point of CNS1, z be
  Complex st f is_continuous_in x0 holds z(#)f is_continuous_in x0;

theorem 
  for f be PartFunc of CNS,RNS, x0 be Point of CNS, r be Real st f
  is_continuous_in x0 holds r(#)f is_continuous_in x0;

theorem 
  for f be PartFunc of RNS,CNS, x0 be Point of RNS, z be Complex
  st f is_continuous_in x0 holds z(#)f is_continuous_in x0;

theorem 
  for f be PartFunc of CNS1,CNS2, x0 be Point of CNS1 st f
  is_continuous_in x0 holds ||. f .|| is_continuous_in x0 & -f is_continuous_in
  x0;

theorem 
  for f be PartFunc of CNS,RNS, x0 be Point of CNS st f is_continuous_in
  x0 holds ||. f .|| is_continuous_in x0 & -f is_continuous_in x0;

theorem 
  for f be PartFunc of RNS,CNS, x0 be Point of RNS st f is_continuous_in
  x0 holds ||. f .|| is_continuous_in x0 & -f is_continuous_in x0;

definition
  let CNS1,CNS2 be ComplexNormSpace;
  let f be PartFunc of CNS1,CNS2;
  let X be set;
  pred f is_continuous_on X means


  X c= dom f & for x0 be Point of CNS1
  st x0 in X holds f|X is_continuous_in x0;
end;

definition
  let CNS be ComplexNormSpace;
  let RNS be RealNormSpace;
  let f be PartFunc of CNS,RNS;
  let X be set;
  pred f is_continuous_on X means


  X c= dom f & for x0 be Point of CNS st x0 in X holds f|X is_continuous_in x0;
end;

definition
  let RNS be RealNormSpace;
  let CNS be ComplexNormSpace;
  let g be PartFunc of RNS,CNS;
  let X be set;
  pred g is_continuous_on X means


  X c= dom g & for x0 be Point of RNS st x0 in X holds g|X is_continuous_in x0;
end;

definition
  let CNS be ComplexNormSpace;
  let f be PartFunc of the carrier of CNS, COMPLEX;
  let X be set;
  pred f is_continuous_on X means


  X c= dom f & for x0 be Point of CNS st x0 in X holds f|X is_continuous_in x0;
end;

definition
  let CNS be ComplexNormSpace;
  let f be PartFunc of the carrier of CNS, REAL;
  let X be set;
  pred f is_continuous_on X means


  X c= dom f & for x0 be Point of CNS st x0 in X holds f|X is_continuous_in x0;
end;

definition
  let RNS be RealNormSpace;
  let f be PartFunc of the carrier of RNS, COMPLEX;
  let X be set;
  pred f is_continuous_on X means


  X c= dom f & for x0 be Point of RNS st x0 in X holds f|X is_continuous_in x0;
end;

reserve X,X1 for set;

theorem 
  for f be PartFunc of CNS1,CNS2 holds f is_continuous_on X iff X
  c= dom f & for s1 be sequence of CNS1 st rng s1 c= X & s1 is convergent & lim
  s1 in X holds f/*s1 is convergent & f/.(lim s1) = lim (f/*s1);

theorem 
  for f be PartFunc of CNS,RNS holds f is_continuous_on X iff X c=
dom f & for s1 be sequence of CNS st rng s1 c= X & s1 is convergent & lim s1 in
  X holds f/*s1 is convergent & f/.(lim s1) = lim (f/*s1);

theorem 
  for f be PartFunc of RNS,CNS holds f is_continuous_on X iff X c=
dom f & for s1 be sequence of RNS st rng s1 c= X & s1 is convergent & lim s1 in
  X holds f/*s1 is convergent & f/.(lim s1) = lim (f/*s1);

theorem 
  for f be PartFunc of CNS1,CNS2 holds f is_continuous_on X iff X
c= dom f & for x0 be Point of CNS1, r st x0 in X & 0<r ex s st 0<s & for x1 be
  Point of CNS1 st x1 in X & ||. x1- x0 .|| < s holds ||. f/.x1 - f/.x0 .|| < r
;

theorem 
  for f be PartFunc of CNS,RNS holds f is_continuous_on X iff X c=
  dom f & for x0 be Point of CNS, r st x0 in X & 0<r ex s st 0<s & for x1 be
  Point of CNS st x1 in X & ||. x1- x0 .|| < s holds ||. f/.x1 - f/.x0 .|| < r;

theorem 
  for f be PartFunc of RNS,CNS holds f is_continuous_on X iff X c=
  dom f & for x0 be Point of RNS, r st x0 in X & 0<r ex s st 0<s & for x1 be
  Point of RNS st x1 in X & ||. x1- x0 .|| < s holds ||. f/.x1 - f/.x0 .|| < r;

theorem 
  for f be PartFunc of the carrier of CNS, COMPLEX holds ( f
is_continuous_on X iff X c= dom f & for x0 be Point of CNS, r st x0 in X & 0 <
r ex s st 0 < s & for x1 be Point of CNS st x1 in X & ||. x1- x0 .|| < s holds
  |. f/.x1 - f/.x0 .| < r );

theorem 
  for f be PartFunc of the carrier of CNS, REAL holds ( f
is_continuous_on X iff X c= dom f & for x0 be Point of CNS, r st x0 in X & 0 <
r ex s st 0 < s & for x1 be Point of CNS st x1 in X & ||. x1- x0 .|| < s holds
  abs( f/.x1 - f/.x0 ) < r );

theorem 
  for f be PartFunc of the carrier of RNS, COMPLEX holds ( f
is_continuous_on X iff X c= dom f & for x0 be Point of RNS, r st x0 in X & 0 <
r ex s st 0 < s & for x1 be Point of RNS st x1 in X & ||. x1- x0 .|| < s holds
  |. f/.x1 - f/.x0 .| < r );

theorem 
  for f be PartFunc of CNS1,CNS2 holds f is_continuous_on X iff f|X
  is_continuous_on X;

theorem 
  for f be PartFunc of CNS,RNS holds f is_continuous_on X iff f|X
  is_continuous_on X;

theorem 
  for f be PartFunc of RNS,CNS holds f is_continuous_on X iff f|X
  is_continuous_on X;

theorem 
  for f be PartFunc of the carrier of CNS,COMPLEX holds (f
  is_continuous_on X iff f|X is_continuous_on X);

theorem 
  for f be PartFunc of the carrier of CNS,REAL holds (f
  is_continuous_on X iff f|X is_continuous_on X);

theorem 
  for f be PartFunc of the carrier of RNS,COMPLEX holds (f
  is_continuous_on X iff f|X is_continuous_on X);

theorem 
  for f be PartFunc of CNS1,CNS2 st f is_continuous_on X & X1 c= X
  holds f is_continuous_on X1;

theorem 
  for f be PartFunc of CNS,RNS st f is_continuous_on X & X1 c= X
  holds f is_continuous_on X1;

theorem 
  for f be PartFunc of RNS,CNS st f is_continuous_on X & X1 c= X
  holds f is_continuous_on X1;

theorem 
  for f be PartFunc of CNS1,CNS2, x0 be Point of CNS1 st x0 in dom f
  holds f is_continuous_on {x0};

theorem 
  for f be PartFunc of CNS,RNS, x0 be Point of CNS st x0 in dom f holds
  f is_continuous_on {x0};

theorem 
  for f be PartFunc of RNS,CNS, x0 be Point of RNS st x0 in dom f holds
  f is_continuous_on {x0};

theorem 
  for f1,f2 be PartFunc of CNS1,CNS2 st f1 is_continuous_on X & f2
  is_continuous_on X holds f1+f2 is_continuous_on X & f1-f2 is_continuous_on X;

theorem 
  for f1,f2 be PartFunc of CNS,RNS st f1 is_continuous_on X & f2
  is_continuous_on X holds f1+f2 is_continuous_on X & f1-f2 is_continuous_on X;

theorem 
  for f1,f2 be PartFunc of RNS,CNS st f1 is_continuous_on X & f2
  is_continuous_on X holds f1+f2 is_continuous_on X & f1-f2 is_continuous_on X;

theorem 
  for f1,f2 be PartFunc of CNS1,CNS2 st f1 is_continuous_on X & f2
  is_continuous_on X1 holds f1+f2 is_continuous_on X /\ X1 & f1-f2
  is_continuous_on X /\ X1;

theorem 
  for f1,f2 be PartFunc of CNS,RNS st f1 is_continuous_on X & f2
  is_continuous_on X1 holds f1+f2 is_continuous_on X /\ X1 & f1-f2
  is_continuous_on X /\ X1;

theorem 
  for f1,f2 be PartFunc of RNS,CNS st f1 is_continuous_on X & f2
  is_continuous_on X1 holds f1+f2 is_continuous_on X /\ X1 & f1-f2
  is_continuous_on X /\ X1;

theorem 
  for f be PartFunc of CNS1,CNS2 st f is_continuous_on X holds z
  (#)f is_continuous_on X;

theorem 
  for f be PartFunc of CNS,RNS st f is_continuous_on X holds r(#)f
  is_continuous_on X;

theorem 
  for f be PartFunc of RNS,CNS st f is_continuous_on X holds z(#)f
  is_continuous_on X;

theorem 
  for f be PartFunc of CNS1,CNS2 st f is_continuous_on X holds ||.
  f.|| is_continuous_on X & -f is_continuous_on X;

theorem 
  for f be PartFunc of CNS,RNS st f is_continuous_on X holds ||.f
  .|| is_continuous_on X & -f is_continuous_on X;

theorem 
  for f be PartFunc of RNS,CNS st f is_continuous_on X holds ||.f
  .|| is_continuous_on X & -f is_continuous_on X;

theorem 
  for f be PartFunc of CNS1,CNS2 st f is total & (for x1,x2 be Point of
  CNS1 holds f/.(x1+x2) = f/.x1 + f/.x2) & (ex x0 be Point of CNS1 st f
  is_continuous_in x0) holds f is_continuous_on the carrier of CNS1;

theorem 
  for f be PartFunc of CNS,RNS st f is total & (for x1,x2 be Point of
  CNS holds f/.(x1+x2) = f/.x1 + f/.x2) & (ex x0 be Point of CNS st f
  is_continuous_in x0) holds f is_continuous_on the carrier of CNS;

theorem 
  for f be PartFunc of RNS,CNS st f is total & (for x1,x2 be Point of
  RNS holds f/.(x1+x2) = f/.x1 + f/.x2) & (ex x0 be Point of RNS st f
  is_continuous_in x0) holds f is_continuous_on the carrier of RNS;

theorem 
  for f be PartFunc of CNS1,CNS2 st dom f is compact & f
  is_continuous_on (dom f) holds (rng f) is compact;

theorem 
  for f be PartFunc of CNS,RNS st dom f is compact & f
  is_continuous_on (dom f) holds (rng f) is compact;

theorem 
  for f be PartFunc of RNS,CNS st dom f is compact & f
  is_continuous_on (dom f) holds (rng f) is compact;

theorem 
  for f be PartFunc of the carrier of CNS,COMPLEX st dom f is compact &
  f is_continuous_on (dom f) holds (rng f) is compact;

theorem 
  for f be PartFunc of the carrier of CNS,REAL st dom f is
  compact & f is_continuous_on (dom f) holds (rng f) is compact;

theorem 
  for f be PartFunc of the carrier of RNS,COMPLEX st dom f is compact &
  f is_continuous_on (dom f) holds (rng f) is compact;

theorem 
  for Y be Subset of CNS1, f be PartFunc of CNS1,CNS2 st Y c= dom f & Y
  is compact & f is_continuous_on Y holds (f.:Y) is compact;

theorem 
  for Y be Subset of CNS, f be PartFunc of CNS,RNS st Y c= dom f & Y is
  compact & f is_continuous_on Y holds (f.:Y) is compact;

theorem 
  for Y be Subset of RNS, f be PartFunc of RNS,CNS st Y c= dom f & Y is
  compact & f is_continuous_on Y holds (f.:Y) is compact;

theorem 
  for f be PartFunc of the carrier of CNS,REAL st dom f<>{} & (
  dom f) is compact & f is_continuous_on (dom f) holds ex x1,x2 be Point of CNS
  st x1 in dom f & x2 in dom f & f/.x1 = upper_bound (rng f) & f/.x2 =
  lower_bound (rng f);

theorem 
  for f be PartFunc of CNS1,CNS2 st dom f<>{} & (dom f) is
  compact & f is_continuous_on (dom f) holds ex x1,x2 be Point of CNS1 st x1 in
  dom f & x2 in dom f & ||.f.||/.x1 = upper_bound (rng ||.f.||) & ||.f.||/.x2 =
  lower_bound (rng ||.f.||);

theorem 
  for f be PartFunc of CNS,RNS st dom f<>{} & (dom f) is compact
& f is_continuous_on (dom f) holds ex x1,x2 be Point of CNS st x1 in dom f & x2
in dom f & ||.f.||/.x1 = upper_bound (rng ||.f.||) & ||.f.||/.x2 = lower_bound
  (rng ||.f.||);

theorem 
  for f be PartFunc of RNS,CNS st dom f<>{} & (dom f) is compact
& f is_continuous_on (dom f) holds ex x1,x2 be Point of RNS st x1 in dom f & x2
in dom f & ||.f.||/.x1 = upper_bound (rng ||.f.||) & ||.f.||/.x2 = lower_bound
  (rng ||.f.||);

theorem 
  for f be PartFunc of CNS1,CNS2 holds (||.f.||)|X = ||.(f|X).||;

theorem 
  for f be PartFunc of CNS,RNS holds (||.f.||)|X = ||.(f|X).||;

theorem 
  for f be PartFunc of RNS,CNS holds (||.f.||)|X = ||.(f|X).||;

theorem 
  for f be PartFunc of CNS1,CNS2, Y be Subset of CNS1 st Y<>{} & Y c=
dom f & Y is compact & f is_continuous_on Y holds ex x1,x2 be Point of CNS1 st
  x1 in Y & x2 in Y & ||.f.||/.x1 = upper_bound (||.f.||.:Y) & ||.f.||/.x2 =
  lower_bound (||.f.||.:Y);

theorem 
  for f be PartFunc of CNS,RNS,Y be Subset of CNS st Y<>{} & Y c= dom f
& Y is compact & f is_continuous_on Y holds ex x1,x2 be Point of CNS st x1 in Y
& x2 in Y & ||.f.||/.x1 = upper_bound (||.f.||.:Y) & ||.f.||/.x2 = lower_bound
  (||.f.||.:Y);

theorem 
  for f be PartFunc of RNS,CNS,Y be Subset of RNS st Y<>{} & Y c= dom f
& Y is compact & f is_continuous_on Y holds ex x1,x2 be Point of RNS st x1 in Y
& x2 in Y & ||.f.||/.x1 = upper_bound (||.f.||.:Y) & ||.f.||/.x2 = lower_bound
  (||.f.||.:Y);

theorem 
  for f be PartFunc of the carrier of CNS,REAL, Y be Subset of CNS st Y
<>{} & Y c= dom f & Y is compact & f is_continuous_on Y holds ex x1,x2 be Point
of CNS st x1 in Y & x2 in Y & f/.x1 = upper_bound (f.:Y) & f/.x2 = lower_bound
  (f.:Y);

definition
  let CNS1,CNS2 be ComplexNormSpace;
  let X be set;
  let f be PartFunc of CNS1,CNS2;
  pred f is_Lipschitzian_on X means


  X c= dom f & ex r st 0 < r & for
x1,x2 be Point of CNS1 st x1 in X & x2 in X holds ||.f/.x1-f/.x2.||<=r*||.x1-x2
  .||;
end;

definition
  let CNS be ComplexNormSpace;
  let RNS be RealNormSpace;
  let X be set;
  let f be PartFunc of CNS,RNS;
  pred f is_Lipschitzian_on X means


  X c= dom f & ex r st 0 < r & for
x1,x2 be Point of CNS st x1 in X & x2 in X holds ||.f/.x1-f/.x2.||<=r*||.x1-x2
  .||;
end;

definition
  let RNS be RealNormSpace;
  let CNS be ComplexNormSpace;
  let X be set;
  let f be PartFunc of RNS,CNS;
  pred f is_Lipschitzian_on X means


  X c= dom f & ex r st 0 < r & for
x1,x2 be Point of RNS st x1 in X & x2 in X holds ||.f/.x1-f/.x2.||<=r*||.x1-x2
  .||;
end;

definition
  let CNS be ComplexNormSpace;
  let X be set;
  let f be PartFunc of the carrier of CNS,COMPLEX;
  pred f is_Lipschitzian_on X means


  X c= dom f & ex r st 0<r & for x1,
x2 be Point of CNS st x1 in X & x2 in X holds |.(f/.x1-f/.x2).|<=r*||.x1-x2.||;
end;

definition
  let CNS be ComplexNormSpace;
  let X be set;
  let f be PartFunc of the carrier of CNS,REAL;
  pred f is_Lipschitzian_on X means


  X c= dom f & ex r st 0<r & for x1,
x2 be Point of CNS st x1 in X & x2 in X holds abs(f/.x1-f/.x2)<=r*||.x1-x2.||;
end;

definition
  let RNS be RealNormSpace;
  let X be set;
  let f be PartFunc of the carrier of RNS,COMPLEX;
  pred f is_Lipschitzian_on X means


  X c= dom f & ex r st 0<r & for x1,
x2 be Point of RNS st x1 in X & x2 in X holds |.(f/.x1-f/.x2).|<=r*||.x1-x2.||;
end;

theorem 
  for f be PartFunc of CNS1,CNS2 st f is_Lipschitzian_on X & X1
  c= X holds f is_Lipschitzian_on X1;

theorem 
  for f be PartFunc of CNS,RNS st f is_Lipschitzian_on X & X1 c=
  X holds f is_Lipschitzian_on X1;

theorem 
  for f be PartFunc of RNS,CNS st f is_Lipschitzian_on X & X1 c=
  X holds f is_Lipschitzian_on X1;

theorem 
  for f1,f2 be PartFunc of CNS1,CNS2 st f1 is_Lipschitzian_on X & f2
  is_Lipschitzian_on X1 holds f1+f2 is_Lipschitzian_on X /\ X1;

theorem 
  for f1,f2 be PartFunc of CNS,RNS st f1 is_Lipschitzian_on X & f2
  is_Lipschitzian_on X1 holds f1+f2 is_Lipschitzian_on X /\ X1;

theorem 
  for f1,f2 be PartFunc of RNS,CNS st f1 is_Lipschitzian_on X & f2
  is_Lipschitzian_on X1 holds f1+f2 is_Lipschitzian_on X /\ X1;

theorem 
  for f1,f2 be PartFunc of CNS1,CNS2 st f1 is_Lipschitzian_on X & f2
  is_Lipschitzian_on X1 holds f1-f2 is_Lipschitzian_on X /\ X1;

theorem 
  for f1,f2 be PartFunc of CNS,RNS st f1 is_Lipschitzian_on X & f2
  is_Lipschitzian_on X1 holds f1-f2 is_Lipschitzian_on X /\ X1;

theorem 
  for f1,f2 be PartFunc of RNS,CNS st f1 is_Lipschitzian_on X & f2
  is_Lipschitzian_on X1 holds f1-f2 is_Lipschitzian_on X /\ X1;

theorem 
  for f be PartFunc of CNS1,CNS2 st f is_Lipschitzian_on X holds
  z(#)f is_Lipschitzian_on X;

theorem 
  for f be PartFunc of CNS,RNS st f is_Lipschitzian_on X holds r
  (#)f is_Lipschitzian_on X;

theorem 
  for f be PartFunc of RNS,CNS st f is_Lipschitzian_on X holds z
  (#)f is_Lipschitzian_on X;

theorem 
  for f be PartFunc of CNS1,CNS2 st f is_Lipschitzian_on X holds -f
  is_Lipschitzian_on X & ||.f.|| is_Lipschitzian_on X;

theorem 
  for f be PartFunc of CNS,RNS st f is_Lipschitzian_on X holds -f
  is_Lipschitzian_on X & ||.f.|| is_Lipschitzian_on X;

theorem 
  for f be PartFunc of RNS,CNS st f is_Lipschitzian_on X holds -f
  is_Lipschitzian_on X & ||.f.|| is_Lipschitzian_on X;

theorem 
  for X be set, f be PartFunc of CNS1,CNS2 st X c= dom f & f|X is
  constant holds f is_Lipschitzian_on X;

theorem 
  for X be set, f be PartFunc of CNS,RNS st X c= dom f & f|X is
  constant holds f is_Lipschitzian_on X;

theorem 
  for X be set, f be PartFunc of RNS,CNS st X c= dom f & f|X is
  constant holds f is_Lipschitzian_on X;

theorem 
  for Y be Subset of CNS holds id Y is_Lipschitzian_on Y;

theorem 
  for f be PartFunc of CNS1,CNS2 st f is_Lipschitzian_on X holds
  f is_continuous_on X;

theorem 
  for f be PartFunc of CNS,RNS st f is_Lipschitzian_on X holds f
  is_continuous_on X;

theorem 
  for f be PartFunc of RNS,CNS st f is_Lipschitzian_on X holds f
  is_continuous_on X;

theorem 
  for f be PartFunc of the carrier of CNS,COMPLEX st f
  is_Lipschitzian_on X holds f is_continuous_on X;

theorem 
  for f be PartFunc of the carrier of CNS,REAL st f
  is_Lipschitzian_on X holds f is_continuous_on X;

theorem 
  for f be PartFunc of the carrier of RNS,COMPLEX st f
  is_Lipschitzian_on X holds f is_continuous_on X;

theorem 
  for f be PartFunc of CNS1,CNS2 st (ex r be Point of CNS2 st rng f = {r
  }) holds f is_continuous_on (dom f);

theorem 
  for f be PartFunc of CNS,RNS st (ex r be Point of RNS st rng f = {r})
  holds f is_continuous_on (dom f);

theorem 
  for f be PartFunc of RNS,CNS st (ex r be Point of CNS st rng f = {r})
  holds f is_continuous_on (dom f);

theorem 
  for f be PartFunc of CNS1,CNS2 st X c= dom f & f|X is constant holds f
  is_continuous_on X;

theorem 
  for f be PartFunc of CNS,RNS st X c= dom f & f|X is constant holds f
  is_continuous_on X;

theorem 
  for f be PartFunc of RNS,CNS st X c= dom f & f|X is constant holds f
  is_continuous_on X;

theorem 
  for f be PartFunc of CNS,CNS st (for x0 be Point of CNS st x0
  in dom f holds f/.x0 = x0) holds f is_continuous_on dom f;

theorem 
  for f be PartFunc of CNS,CNS st f = id dom f holds f is_continuous_on dom f;

theorem 
  for f be PartFunc of CNS,CNS, Y be Subset of CNS st Y c= dom f & f|Y =
  id Y holds f is_continuous_on Y;

theorem 
  for f be PartFunc of CNS,CNS, z be Complex, p be Point of CNS st X c=
  dom f & (for x0 be Point of CNS st x0 in X holds f/.x0 = z*x0+p) holds f
  is_continuous_on X;

theorem 
  for f be PartFunc of the carrier of CNS,REAL st (for x0 be
Point of CNS st x0 in dom f holds f/.x0 = ||. x0.|| ) holds f is_continuous_on
  dom f;

theorem 
  for f be PartFunc of the carrier of CNS,REAL st X c= dom f & (for x0
be Point of CNS st x0 in X holds f/.x0 = ||. x0.||) holds f is_continuous_on X;














begin 

definition
  let x be Real_Sequence;
  let p be Real;
  func x rto_power p -> Real_Sequence means


  for n be Element of NAT holds it.n = abs(x.n) to_power p;
end;

definition
  let p be Real;
  assume
 p >= 1;
  func the_set_of_RealSequences_l^p -> non empty Subset of
  Linear_Space_of_RealSequences means


  for x being set holds x in it iff x
  in the_set_of_RealSequences & seq_id(x) rto_power p is summable;
end;

reserve x1,x2,y1,a,b,c for Real;

theorem 
  a >= 0 & a < b & c > 0 implies a to_power c < b to_power c;

theorem 
  for p be Real st 1 <= p for a,b be Real_Sequence for n be Element
  of NAT holds (Partial_Sums((a + b) rto_power p).n) to_power (1/p) <= (
Partial_Sums(a rto_power p).n) to_power (1/p) + (Partial_Sums(b rto_power p).n)
  to_power (1/p);

theorem 
  for a,b be Real_Sequence for p be Real st 1 <= p & (a rto_power p
  ) is summable & (b rto_power p) is summable holds ((a+b) rto_power p) is
  summable & (Sum((a + b) rto_power p)) to_power (1/p) <= (Sum(a rto_power p))
  to_power (1/p) + (Sum(b rto_power p)) to_power (1/p);

theorem 
  for p be Real st 1 <= p holds the_set_of_RealSequences_l^p is linearly-closed
;

theorem 
  for p be Real st 1 <= p holds RLSStruct (#
    the_set_of_RealSequences_l^p, Zero_(the_set_of_RealSequences_l^p,
    Linear_Space_of_RealSequences), Add_(the_set_of_RealSequences_l^p,
    Linear_Space_of_RealSequences), Mult_(the_set_of_RealSequences_l^p,
Linear_Space_of_RealSequences) #) is Subspace of Linear_Space_of_RealSequences;

theorem 
  for p be Real st 1 <= p holds RLSStruct (# the_set_of_RealSequences_l^
    p, Zero_(the_set_of_RealSequences_l^p,Linear_Space_of_RealSequences), Add_(
    the_set_of_RealSequences_l^p,Linear_Space_of_RealSequences), Mult_(
    the_set_of_RealSequences_l^p,Linear_Space_of_RealSequences) #) is Abelian
add-associative right_zeroed right_complementable vector-distributive
scalar-distributive scalar-associative scalar-unital;

theorem 
  for p be Real st 1 <= p holds RLSStruct (# the_set_of_RealSequences_l^
    p, Zero_(the_set_of_RealSequences_l^p,Linear_Space_of_RealSequences), Add_(
    the_set_of_RealSequences_l^p,Linear_Space_of_RealSequences), Mult_(
    the_set_of_RealSequences_l^p,Linear_Space_of_RealSequences) #) is
  RealLinearSpace;

definition
  let p be Real;
  func l_norm^p -> Function of the_set_of_RealSequences_l^p, REAL means


for x be set st x in the_set_of_RealSequences_l^p holds it.x = ( Sum(seq_id(x)
  rto_power p) ) to_power (1/p);
end;

theorem 
  for p be Real st 1 <= p holds NORMSTR (#
    the_set_of_RealSequences_l^p, Zero_(the_set_of_RealSequences_l^p,
    Linear_Space_of_RealSequences), Add_(the_set_of_RealSequences_l^p,
    Linear_Space_of_RealSequences), Mult_(the_set_of_RealSequences_l^p,
    Linear_Space_of_RealSequences), l_norm^p #) is RealLinearSpace;

theorem 
  for p be Real st p >= 1 holds NORMSTR (#
    the_set_of_RealSequences_l^p, Zero_(the_set_of_RealSequences_l^p,
    Linear_Space_of_RealSequences), Add_(the_set_of_RealSequences_l^p,
    Linear_Space_of_RealSequences), Mult_(the_set_of_RealSequences_l^p,
    Linear_Space_of_RealSequences), l_norm^p #) is Subspace of
  Linear_Space_of_RealSequences;

begin 

theorem 
  for p be Real st 1 <=p holds for lp be non empty NORMSTR st lp =
  NORMSTR (# the_set_of_RealSequences_l^p, Zero_(the_set_of_RealSequences_l^p,
    Linear_Space_of_RealSequences), Add_(the_set_of_RealSequences_l^p,
    Linear_Space_of_RealSequences), Mult_(the_set_of_RealSequences_l^p,
    Linear_Space_of_RealSequences), l_norm^p #) holds the carrier of lp =
the_set_of_RealSequences_l^p & ( for x be set holds x is VECTOR of lp iff x is
Real_Sequence & seq_id(x) rto_power p is summable ) & 0.lp = Zeroseq & ( for x
  be VECTOR of lp holds x =seq_id(x) ) & ( for x,y be VECTOR of lp holds x+y =
seq_id(x)+seq_id(y) ) & ( for r be Real for x be VECTOR of lp holds r*x = r(#)
  seq_id(x) ) & ( for x be VECTOR of lp holds -x = -seq_id(x) & seq_id(-x) = -
  seq_id(x) ) & ( for x,y be VECTOR of lp holds x-y =seq_id(x)-seq_id(y) ) & (
  for x be VECTOR of lp holds seq_id(x) rto_power p is summable ) & for x be
  VECTOR of lp holds ||.x.|| = ( Sum(seq_id(x) rto_power p) ) to_power (1/p);

theorem 
  for p be Real st p>=1 holds for rseq be Real_Sequence st (for n
  be Element of NAT holds rseq.n=0) holds rseq rto_power p is summable & ( Sum(
  rseq rto_power p) ) to_power (1/p)=0;

theorem 
  for p be Real st 1 <=p for rseq be Real_Sequence st rseq
rto_power p is summable & ( Sum(rseq rto_power p) ) to_power (1/p)=0 holds for
  n be natural number holds rseq.n = 0;

theorem 
  for p be Real st 1 <= p for lp be non empty NORMSTR st lp =
  NORMSTR (# the_set_of_RealSequences_l^p, Zero_(the_set_of_RealSequences_l^p,
    Linear_Space_of_RealSequences), Add_(the_set_of_RealSequences_l^p,
    Linear_Space_of_RealSequences), Mult_(the_set_of_RealSequences_l^p,
Linear_Space_of_RealSequences), l_norm^p #) holds for x, y being Point of lp, a
  be Real holds ( ||.x.|| = 0 iff x = 0.lp ) & 0 <= ||.x.|| & ||.x+y.|| <= ||.x
  .|| + ||.y.|| & ||.(a*x).|| = abs(a) * ||.x.||;

theorem 
  for p be Real st p >= 1 for lp be non empty NORMSTR st lp =
  NORMSTR (# the_set_of_RealSequences_l^p, Zero_(the_set_of_RealSequences_l^p,
    Linear_Space_of_RealSequences), Add_(the_set_of_RealSequences_l^p,
    Linear_Space_of_RealSequences), Mult_(the_set_of_RealSequences_l^p,
    Linear_Space_of_RealSequences), l_norm^p #) holds lp is
  reflexive discerning RealNormSpace-like;

theorem 
  for p be Real st p >= 1 for lp be non empty NORMSTR st lp = NORMSTR (#
    the_set_of_RealSequences_l^p, Zero_(the_set_of_RealSequences_l^p,
    Linear_Space_of_RealSequences), Add_(the_set_of_RealSequences_l^p,
    Linear_Space_of_RealSequences), Mult_(the_set_of_RealSequences_l^p,
Linear_Space_of_RealSequences), l_norm^p #) holds lp is RealNormSpace;

theorem 
  for p be Real st 1 <=p for lp be RealNormSpace st lp = NORMSTR
  (# the_set_of_RealSequences_l^p, Zero_(the_set_of_RealSequences_l^p,
    Linear_Space_of_RealSequences), Add_(the_set_of_RealSequences_l^p,
    Linear_Space_of_RealSequences), Mult_(the_set_of_RealSequences_l^p,
Linear_Space_of_RealSequences), l_norm^p #) holds for vseq be sequence of lp st
  vseq is Cauchy_sequence_by_Norm holds vseq is convergent;

definition
  let p be Real such that
 1 <= p;
  func l_Space^p -> RealBanachSpace equals

  NORMSTR (#
    the_set_of_RealSequences_l^p, Zero_(the_set_of_RealSequences_l^p,
    Linear_Space_of_RealSequences), Add_(the_set_of_RealSequences_l^p,
    Linear_Space_of_RealSequences), Mult_(the_set_of_RealSequences_l^p,
    Linear_Space_of_RealSequences), l_norm^p #);
end;














begin 

reserve C for Simple_closed_curve,
  i for Element of NAT;

theorem 
  (Upper_Appr C).i c= Cl RightComp Cage(C,0);

theorem 
  (Lower_Appr C).i c= Cl RightComp Cage(C,0);

registration
  let C be Simple_closed_curve;
  cluster Upper_Arc C -> connected;
  cluster Lower_Arc C -> connected;
end;

theorem 
  (Upper_Appr C).i is compact connected;

theorem 
  (Lower_Appr C).i is compact connected;

registration
  let C be Simple_closed_curve;
  cluster North_Arc C -> compact;
  cluster South_Arc C -> compact;
end;



reserve R for non empty Subset of TOP-REAL 2,
  j, k, m, n for Element of NAT;

theorem 
  [1,1] in Indices Gauge(R,n);

theorem 
  [1,2] in Indices Gauge(R,n);

theorem 
  [2,1] in Indices Gauge(R,n);

theorem 
  for C being non vertical non horizontal compact Subset of
TOP-REAL 2 holds m > k & [i,j] in Indices Gauge(C,k) & [i,j+1] in Indices Gauge
(C,k) implies dist(Gauge(C,m)*(i,j),Gauge(C,m)*(i,j+1)) < dist(Gauge(C,k)*(i,j)
  ,Gauge(C,k)*(i,j+1));

theorem 
  for C being non vertical non horizontal compact Subset of
TOP-REAL 2 holds m > k implies dist(Gauge(C,m)*(1,1),Gauge(C,m)*(1,2)) < dist(
  Gauge(C,k)*(1,1),Gauge(C,k)*(1,2));

theorem 
  for C being non vertical non horizontal compact Subset of
TOP-REAL 2 holds m > k & [i,j] in Indices Gauge(C,k) & [i+1,j] in Indices Gauge
(C,k) implies dist(Gauge(C,m)*(i,j),Gauge(C,m)*(i+1,j)) < dist(Gauge(C,k)*(i,j)
  ,Gauge(C,k)*(i+1,j));

theorem 
  for C being non vertical non horizontal compact Subset of
TOP-REAL 2 holds m > k implies dist(Gauge(C,m)*(1,1),Gauge(C,m)*(2,1)) < dist(
  Gauge(C,k)*(1,1),Gauge(C,k)*(2,1));

theorem 
  for r, t being real number holds r > 0 & t > 0 implies ex n being
  Element of NAT st i < n & dist(Gauge(C,n)*(1,1),Gauge(C,n)*(1,2)) < r & dist(
  Gauge(C,n)*(1,1),Gauge(C,n)*(2,1)) < t;

theorem 
  0 < n implies upper_bound (proj2.:(L~Cage(C,n) /\ LSeg(Gauge(C,n)*(
Center Gauge(C,n),1), Gauge(C,n)*(Center Gauge(C,n),len Gauge(C,n)))))
 = upper_bound (
proj2.:(L~Cage(C,n) /\ Vertical_Line ((E-bound L~Cage(C,n) + W-bound L~Cage(C,n
  )) / 2)));

theorem 
  0 < n implies lower_bound (proj2.:(L~Cage(C,n) /\ LSeg(Gauge(C,n)*(
Center Gauge(C,n),1), Gauge(C,n)*(Center Gauge(C,n),len Gauge(C,n)))))
 = lower_bound (
proj2.:(L~Cage(C,n) /\ Vertical_Line ((E-bound L~Cage(C,n) + W-bound L~Cage(C,n
  )) / 2)));

theorem 
  0 < n implies UMP L~Cage(C,n) = |[ (E-bound L~Cage(C,n) + W-bound L~
Cage(C,n)) / 2, upper_bound (proj2.:(L~Cage(C,n) /\
 LSeg(Gauge(C,n)*(Center Gauge(C,n),
  1), Gauge(C,n)*(Center Gauge(C,n),len Gauge(C,n))))) ]|;

theorem 
  0 < n implies LMP L~Cage(C,n) = |[ (E-bound L~Cage(C,n) + W-bound L~
Cage(C,n)) / 2, lower_bound (proj2.:(L~Cage(C,n) /\
 LSeg(Gauge(C,n)*(Center Gauge(C,n),
  1), Gauge(C,n)*(Center Gauge(C,n),len Gauge(C,n))))) ]|;

theorem 
  (UMP C)`2 < (UMP L~Cage(C,n))`2;

theorem 
  (LMP C)`2 > (LMP L~Cage(C,n))`2;

theorem 
  0 < n implies ex i being Element of NAT st 1 <= i & i <= len
  Gauge(C,n) & UMP L~Cage(C,n) = Gauge(C,n)*(Center Gauge(C,n),i);

theorem 
  0 < n implies ex i being Element of NAT st 1 <= i & i <= len
  Gauge(C,n) & LMP L~Cage(C,n) = Gauge(C,n)*(Center Gauge(C,n),i);

theorem 
  0 < n implies UMP L~Cage(C,n) = UMP Upper_Arc L~Cage(C,n);

theorem 
  0 < n implies LMP L~Cage(C,n) = LMP Lower_Arc L~Cage(C,n);

theorem 
  0 < n implies (UMP C)`2 < (UMP Upper_Arc L~Cage(C,n))`2;

theorem 
  0 < n implies (LMP Lower_Arc L~Cage(C,n))`2 < (LMP C)`2;

theorem 
  i <= j implies (UMP L~Cage(C,j))`2 <= (UMP L~Cage(C,i))`2;

theorem 
  i <= j implies (LMP L~Cage(C,i))`2 <= (LMP L~Cage(C,j))`2;

theorem 
  0 < i & i <= j implies (UMP Upper_Arc L~Cage(C,j))`2 <= (UMP
  Upper_Arc L~Cage(C,i))`2;

theorem 
  0 < i & i <= j implies (LMP Lower_Arc L~Cage(C,i))`2 <= (LMP
  Lower_Arc L~Cage(C,j))`2;

begin 

theorem 
  W-min C in North_Arc C;

theorem 
  E-max C in North_Arc C;

theorem 
  W-min C in South_Arc C;

theorem 
  E-max C in South_Arc C;

theorem 
  UMP C in North_Arc C;

theorem 
  LMP C in South_Arc C;

theorem 
  North_Arc C c= C;

theorem 
  South_Arc C c= C;

theorem 
  LMP C in Lower_Arc C & UMP C in Upper_Arc C or UMP C in Lower_Arc C &
  LMP C in Upper_Arc C;



theorem 
  W-bound C = W-bound North_Arc C;

theorem 
  E-bound C = E-bound North_Arc C;

theorem 
  W-bound C = W-bound South_Arc C;

theorem 
  E-bound C = E-bound South_Arc C;














begin 

reserve X,X1 for set,
  r,s for Real,
  z for Complex,
  RNS for RealNormSpace,
  CNS, CNS1,CNS2 for ComplexNormSpace;

definition
  let X be set;
  let CNS1,CNS2 be ComplexNormSpace;
  let f be PartFunc of CNS1,CNS2;
  pred f is_uniformly_continuous_on X means


  X c= dom f & for r st 0 < r
ex s st 0 < s & for x1,x2 be Point of CNS1 st x1 in X & x2 in X & ||.x1 - x2.||
  < s holds ||. f/.x1 - f/.x2 .|| < r;
end;

definition
  let X be set;
  let RNS be RealNormSpace;
  let CNS be ComplexNormSpace;
  let f be PartFunc of CNS,RNS;
  pred f is_uniformly_continuous_on X means


  X c= dom f & for r st 0 < r
ex s st 0 < s & for x1,x2 be Point of CNS st x1 in X & x2 in X & ||.x1 - x2.||
  < s holds ||. f/.x1 - f/.x2 .|| < r;
end;

definition
  let X be set;
  let RNS be RealNormSpace;
  let CNS be ComplexNormSpace;
  let f be PartFunc of RNS,CNS;
  pred f is_uniformly_continuous_on X means


  X c= dom f & for r st 0 < r
ex s st 0 < s & for x1,x2 be Point of RNS st x1 in X & x2 in X & ||.x1 - x2.||
  < s holds ||. f/.x1 - f/.x2 .|| < r;
end;

definition
  let X be set;
  let CNS be ComplexNormSpace;
  let f be PartFunc of the carrier of CNS,COMPLEX;
  pred f is_uniformly_continuous_on X means


  X c= dom f & for r st 0 < r
ex s st 0 < s & for x1,x2 be Point of CNS st x1 in X & x2 in X & ||.x1 - x2.||
  < s holds |.(f/.x1 - f/.x2).| < r;
end;

definition
  let X be set;
  let CNS be ComplexNormSpace;
  let f be PartFunc of the carrier of CNS,REAL;
  pred f is_uniformly_continuous_on X means


  X c= dom f & for r st 0 < r
ex s st 0 < s & for x1,x2 be Point of CNS st x1 in X & x2 in X & ||.x1 - x2.||
  < s holds abs(f/.x1 - f/.x2) < r;
end;

definition
  let X be set;
  let RNS be RealNormSpace;
  let f be PartFunc of the carrier of RNS,COMPLEX;
  pred f is_uniformly_continuous_on X means


  X c= dom f & for r st 0 < r
ex s st 0 < s & for x1,x2 be Point of RNS st x1 in X & x2 in X & ||.x1 - x2.||
  < s holds |.(f/.x1 - f/.x2).| < r;
end;

theorem 
  for f be PartFunc of CNS1,CNS2 st f is_uniformly_continuous_on X
  & X1 c= X holds f is_uniformly_continuous_on X1;

theorem 
  for f be PartFunc of CNS,RNS st f is_uniformly_continuous_on X &
  X1 c= X holds f is_uniformly_continuous_on X1;

theorem 
  for f be PartFunc of RNS,CNS st f is_uniformly_continuous_on X &
  X1 c= X holds f is_uniformly_continuous_on X1;

theorem 
  for f1,f2 be PartFunc of CNS1,CNS2 st f1 is_uniformly_continuous_on X
& f2 is_uniformly_continuous_on X1 holds f1+f2 is_uniformly_continuous_on X/\X1
;

theorem 
  for f1,f2 be PartFunc of CNS,RNS st f1 is_uniformly_continuous_on X &
  f2 is_uniformly_continuous_on X1 holds f1+f2 is_uniformly_continuous_on X/\X1
;

theorem 
  for f1,f2 be PartFunc of RNS,CNS st f1 is_uniformly_continuous_on X &
  f2 is_uniformly_continuous_on X1 holds f1+f2 is_uniformly_continuous_on X/\X1
;

theorem 
  for f1,f2 be PartFunc of CNS1,CNS2 st f1 is_uniformly_continuous_on X
& f2 is_uniformly_continuous_on X1 holds f1-f2 is_uniformly_continuous_on X/\X1
;

theorem 
  for f1,f2 be PartFunc of CNS,RNS st f1 is_uniformly_continuous_on X &
  f2 is_uniformly_continuous_on X1 holds f1-f2 is_uniformly_continuous_on X/\X1
;

theorem 
  for f1,f2 be PartFunc of RNS,CNS st f1 is_uniformly_continuous_on X &
  f2 is_uniformly_continuous_on X1 holds f1-f2 is_uniformly_continuous_on X/\X1
;

theorem 
  for f be PartFunc of CNS1,CNS2 st f is_uniformly_continuous_on X
  holds z(#)f is_uniformly_continuous_on X;

theorem 
  for f be PartFunc of CNS,RNS st f is_uniformly_continuous_on X
  holds r(#)f is_uniformly_continuous_on X;

theorem 
  for f be PartFunc of RNS,CNS st f is_uniformly_continuous_on X
  holds z(#)f is_uniformly_continuous_on X;

theorem 
  for f be PartFunc of CNS1,CNS2 st f is_uniformly_continuous_on X holds
  -f is_uniformly_continuous_on X;

theorem 
  for f be PartFunc of CNS,RNS st f is_uniformly_continuous_on X holds -
  f is_uniformly_continuous_on X;

theorem 
  for f be PartFunc of RNS,CNS st f is_uniformly_continuous_on X holds -
  f is_uniformly_continuous_on X;

theorem 
  for f be PartFunc of CNS1,CNS2 st f is_uniformly_continuous_on X holds
  ||.f.|| is_uniformly_continuous_on X;

theorem 
  for f be PartFunc of CNS,RNS st f is_uniformly_continuous_on X holds
  ||.f.|| is_uniformly_continuous_on X;

theorem 
  for f be PartFunc of RNS,CNS st f is_uniformly_continuous_on X holds
  ||.f.|| is_uniformly_continuous_on X;

theorem 
  for f be PartFunc of CNS1,CNS2 st f is_uniformly_continuous_on X
  holds f is_continuous_on X;

theorem 
  for f be PartFunc of CNS,RNS st f is_uniformly_continuous_on X
  holds f is_continuous_on X;

theorem 
  for f be PartFunc of RNS,CNS st f is_uniformly_continuous_on X
  holds f is_continuous_on X;

theorem 
  for f be PartFunc of the carrier of CNS, COMPLEX st f
  is_uniformly_continuous_on X holds f is_continuous_on X;

theorem 
  for f be PartFunc of the carrier of CNS, REAL st f
  is_uniformly_continuous_on X holds f is_continuous_on X;

theorem 
  for f be PartFunc of the carrier of RNS, COMPLEX st f
  is_uniformly_continuous_on X holds f is_continuous_on X;

theorem 
  for f be PartFunc of CNS1,CNS2 st f is_Lipschitzian_on X holds f
  is_uniformly_continuous_on X;

theorem 
  for f be PartFunc of CNS,RNS st f is_Lipschitzian_on X holds f
  is_uniformly_continuous_on X;

theorem 
  for f be PartFunc of RNS,CNS st f is_Lipschitzian_on X holds f
  is_uniformly_continuous_on X;

theorem 
  for f be PartFunc of CNS1,CNS2, Y be Subset of CNS1 st Y is compact &
  f is_continuous_on Y holds f is_uniformly_continuous_on Y;

theorem 
  for f be PartFunc of CNS,RNS, Y be Subset of CNS st Y is compact & f
  is_continuous_on Y holds f is_uniformly_continuous_on Y;

theorem 
  for f be PartFunc of RNS,CNS, Y be Subset of RNS st Y is compact & f
  is_continuous_on Y holds f is_uniformly_continuous_on Y;

theorem 
  for f be PartFunc of CNS1,CNS2, Y be Subset of CNS1 st Y c= dom f & Y
  is compact & f is_uniformly_continuous_on Y holds f.:Y is compact;

theorem 
  for f be PartFunc of CNS,RNS, Y be Subset of CNS st Y c= dom f & Y is
compact & f is_uniformly_continuous_on Y holds f.:Y is compact;

theorem 
  for f be PartFunc of RNS,CNS, Y be Subset of RNS st Y c= dom f & Y is
compact & f is_uniformly_continuous_on Y holds f.:Y is compact;

theorem 
  for f be PartFunc of the carrier of CNS,REAL, Y be Subset of CNS st Y
<> {} & Y c= dom f & Y is compact & f is_uniformly_continuous_on Y ex x1,x2 be
  Point of CNS st x1 in Y & x2 in Y & f/.x1 = upper_bound (f.:Y) & f/.x2 =
  lower_bound (f.:Y);

theorem 
  for f be PartFunc of CNS1,CNS2 st X c= dom f & f|X is constant holds f
  is_uniformly_continuous_on X;

theorem 
  for f be PartFunc of CNS,RNS st X c= dom f & f|X is constant holds f
  is_uniformly_continuous_on X;

theorem 
  for f be PartFunc of RNS,CNS st X c= dom f & f|X is constant holds f
  is_uniformly_continuous_on X;

begin 

definition
  let M be non empty CNORMSTR;
  let f be Function of M,M;
  attr f is contraction means


    ex L being Real st 0 < L & L < 1 & for x,y being Point of M holds
    ||.f.x - f.y.|| <=L*||.x - y.||;
end;

registration
  let M be ComplexBanachSpace;
 cluster contraction for Function of M,M;
end;

definition
  let M be ComplexBanachSpace;
  mode Contraction of M is contraction Function of M,M;
end;

theorem 
  for X be ComplexNormSpace, x,y be Point of X holds ||.x-y.|| > 0 iff x <> y;

theorem 
  for X be ComplexNormSpace, x, y be Point of X holds ||.x-y.|| = ||.y-x .||;

theorem 
  for X be ComplexBanachSpace, f be Function of X,X st f is
Contraction of X ex xp be Point of X st f.xp=xp & for x be Point of X st f.x=x
  holds xp=x;

theorem 
  for X be ComplexBanachSpace for f be Function of X,X st ex n0 be
Element of NAT st iter(f,n0) is Contraction of X holds ex xp be Point of X st f
  .xp=xp & for x be Point of X st f.x=x holds xp=x;















begin 

theorem 
  for S being non empty non void TopStruct for f being Collineation
of S for p,q being Point of S st p,q are_collinear holds f.p,f.q are_collinear;

theorem 
  for I being non empty set for i be Element of I for A being
  non-Trivial-yielding 1-sorted-yielding ManySortedSet of I holds A.i is non
  trivial;

theorem 
  for S being non void identifying_close_blocks TopStruct st S is
  strongly_connected holds S is without_isolated_points;

theorem 
  for S being non empty non void identifying_close_blocks TopStruct
  holds S is strongly_connected implies S is connected;

theorem 
  for S being non void non degenerated TopStruct for L being Block of S
  ex x being Point of S st not x in L;

theorem 
  for I being non empty set for A being non-Empty
  TopStruct-yielding ManySortedSet of I for p being Point of Segre_Product A
  holds p is Element of Carrier A;

theorem 
  for I being non empty set for A be 1-sorted-yielding
  ManySortedSet of I for x being Element of I holds (Carrier A).x = [#](A.x);

theorem 
  for I being non empty set for i being Element of I for A be
  non-Trivial-yielding TopStruct-yielding ManySortedSet of I ex L being
  Segre-like non trivial-yielding ManySortedSubset of Carrier A st indx(L)=i &
  product L is Segre-Coset of A;

theorem 
  for I being non empty set for i being Element of I for A be
non-Trivial-yielding TopStruct-yielding ManySortedSet of I for p being Point
of Segre_Product A ex L being Segre-like non trivial-yielding ManySortedSubset
  of Carrier A st indx(L)=i & product L is Segre-Coset of A & p in product L;

theorem 
  for I being non empty set for A being non-Trivial-yielding
  TopStruct-yielding ManySortedSet of I for b being Segre-like non
trivial-yielding ManySortedSubset of Carrier A st product b is Segre-Coset of A
  holds b.indx(b) = [#](A.indx(b));

theorem 
  for I being non empty set for A be non-Trivial-yielding
  TopStruct-yielding ManySortedSet of I for L1,L2 being Segre-like non
trivial-yielding ManySortedSubset of Carrier A st product L1 is Segre-Coset of
  A & product L2 is Segre-Coset of A & indx(L1) = indx(L2) & product L1 meets
  product L2 holds L1=L2;

theorem 
  for I being non empty set for A be PLS-yielding ManySortedSet of
I for L being Segre-like non trivial-yielding ManySortedSubset of Carrier A for
  B being Block of A.indx(L) holds product(L+*(indx(L),B)) is Block of
  Segre_Product A;

theorem 
  for I being non empty set for A be PLS-yielding ManySortedSet of
I for i being Element of I for p being Point of A.i for L being Segre-like non
  trivial-yielding ManySortedSubset of Carrier A st i<>indx(L) holds L+*(i,{p})
  is Segre-like non trivial-yielding ManySortedSubset of Carrier A;

theorem 
  for I being non empty set for A being PLS-yielding ManySortedSet
of I for i being Element of I for S being Subset of A.i for L being Segre-like
non trivial-yielding ManySortedSubset of Carrier A holds product (L+*(i,S)) is
  Subset of Segre_Product A;

theorem 
  for I being non empty set for P being ManySortedSet of I for i
  being Element of I holds {P}.i is 1-element;

theorem 
  for I being non empty set for i being Element of I for A be
PLS-yielding ManySortedSet of I for B being Block of A.i for P being Element of
  Carrier A holds product({P}+*(i,B)) is Block of Segre_Product A;

theorem 
  for I being non empty set for A being PLS-yielding ManySortedSet
of I for p,q being Point of Segre_Product A st p<>q holds p,q are_collinear iff
for p1,q1 being ManySortedSet of I st p1=p & q1=q ex i being Element of I st (
for a,b being Point of A.i st a=p1.i & b=q1.i holds a<>b & a,b are_collinear) &
  for j being Element of I st j<>i holds p1.j = q1.j;

theorem 
  for I being non empty set for A being PLS-yielding ManySortedSet
of I for b being Segre-like non trivial-yielding ManySortedSubset of Carrier A
for x being Point of A.indx(b) ex p being ManySortedSet of I st p in product b
  & {p+*(indx(b),x) qua set} = product(b+*(indx(b),{x}));

definition
  let I be finite non empty set;
  let b1,b2 be ManySortedSet of I;
  func diff(b1,b2) -> Nat equals

  card {i where i is Element of I: b1.i <> b2.i
  };
end;

theorem 
  for I being finite non empty set for b1,b2 being ManySortedSet
of I for i being Element of I st b1.i<>b2.i holds diff(b1,b2) = diff(b1,b2+*(i,
  b1.i)) + 1;

begin 

definition
  let I be non empty set;
  let A be PLS-yielding ManySortedSet of I;
  let B1,B2 be Segre-Coset of A;
  pred B1 '||' B2 means


  for x being Point of Segre_Product A st x in B1
  ex y being Point of Segre_Product A st y in B2 & x,y are_collinear;
end;

theorem 
  for I being non empty set for A being PLS-yielding ManySortedSet
of I for B1,B2 being Segre-Coset of A st B1 '||' B2 for f being Collineation of
  Segre_Product A for C1,C2 being Segre-Coset of A st C1=f.:B1 & C2=f.:B2 holds
  C1 '||' C2;

theorem 
  for I being non empty set for A being PLS-yielding ManySortedSet
of I for B1,B2 being Segre-Coset of A st B1 misses B2 holds B1 '||' B2 iff for
b1,b2 being Segre-like non trivial-yielding ManySortedSubset of Carrier A st B1
= product b1 & B2 = product b2 holds indx(b1)=indx(b2) & ex r being Element of
I st r<>indx(b1) & (for i being Element of I st i<>r holds b1.i=b2.i) & for c1,
  c2 being Point of A.r st b1.r = {c1} & b2.r = {c2} holds c1,c2 are_collinear;

theorem 
  for I being finite non empty set for A being PLS-yielding
  ManySortedSet of I st for i being Element of I holds A.i is connected for i
  being Element of I for p being Point of A.i for b1,b2 being Segre-like non
trivial-yielding ManySortedSubset of Carrier A st product b2 is Segre-Coset of
  A & b1=b2+*(i,{p}) & not p in b2.i ex D being FinSequence of bool the carrier
of Segre_Product A st D.1=product b1 & D.(len D)=product b2 & (for i being Nat
st i in dom D holds D.i is Segre-Coset of A) & for i being Nat st 1<=i & i<len
D for Di,Di1 being Segre-Coset of A st Di=D.i & Di1=D.(i+1) holds Di misses Di1
  & Di '||' Di1;

theorem 
  for I being finite non empty set for A being PLS-yielding
ManySortedSet of I st for i being Element of I holds A.i is connected for B1,B2
  being Segre-Coset of A st B1 misses B2 for b1,b2 being Segre-like non
  trivial-yielding ManySortedSubset of Carrier A st B1 = product b1 & B2 =
  product b2 holds indx(b1)=indx(b2) iff ex D being FinSequence of bool the
carrier of Segre_Product A st D.1=B1 & D.(len D)=B2 & (for i being Nat st i in
dom D holds D.i is Segre-Coset of A) & for i being Nat st 1<=i & i<len D for Di
  ,Di1 being Segre-Coset of A st Di=D.i & Di1=D.(i+1) holds Di misses Di1 & Di
  '||' Di1;

theorem 
  for I being finite non empty set for A being PLS-yielding
ManySortedSet of I st for i being Element of I holds A.i is strongly_connected
  for f being Collineation of Segre_Product A for B1,B2 being Segre-Coset of A
  for b1,b2,b3,b4 being Segre-like non trivial-yielding ManySortedSubset of
  Carrier A st B1 = product b1 & B2 = product b2 & f.:B1 = product b3 & f.:B2 =
  product b4 holds indx(b1)=indx(b2) implies indx(b3)=indx(b4);

theorem 
  for I being finite non empty set for A being PLS-yielding
ManySortedSet of I st for i being Element of I holds A.i is strongly_connected
for f being Collineation of Segre_Product A ex s being Permutation of I st for
i,j being Element of I holds s.i=j iff for B1 being Segre-Coset of A for b1,b2
  being Segre-like non trivial-yielding ManySortedSubset of Carrier A st B1 =
  product b1 & f.:B1 = product b2 holds indx(b1)=i implies indx(b2)=j;

definition
  let I be finite non empty set;
  let A be PLS-yielding ManySortedSet of I such that
 for i being Element of I holds A.i is strongly_connected;
  let f be Collineation of Segre_Product A;
  func permutation_of_indices(f) -> Permutation of I means


  for i,j
  being Element of I holds it.i=j iff for B1 being Segre-Coset of A for b1,b2
  being Segre-like non trivial-yielding ManySortedSubset of Carrier A st B1 =
  product b1 & f.:B1 = product b2 holds indx(b1)=i implies indx(b2)=j;
end;

begin 

definition
  let I be finite non empty set;
  let A be PLS-yielding ManySortedSet of I such that
 for i being Element of I holds A.i is strongly_connected;
  let f be Collineation of Segre_Product A;
  let b1 be Segre-like non trivial-yielding ManySortedSubset of Carrier A such
  that
 product b1 is Segre-Coset of A;
  func canonical_embedding(f,b1) -> Function of A.indx(b1),A.(
  permutation_of_indices(f).indx(b1)) means


  it is isomorphic & for a being
  ManySortedSet of I st a is Point of Segre_Product A & a in product b1 for b
being ManySortedSet of I st b=f.a holds b.(permutation_of_indices(f).indx(b1))=
  it.(a.indx(b1));
end;

theorem 
  for I being finite non empty set for A being PLS-yielding
ManySortedSet of I st for i being Element of I holds A.i is strongly_connected
for f being Collineation of Segre_Product A for B1,B2 being Segre-Coset of A st
  B1 misses B2 & B1 '||' B2 for b1,b2 being Segre-like non trivial-yielding
  ManySortedSubset of Carrier A st product b1 = B1 & product b2 = B2 holds
  canonical_embedding(f,b1) = canonical_embedding(f,b2);

theorem 
  for I being finite non empty set for A being PLS-yielding
ManySortedSet of I st for i being Element of I holds A.i is strongly_connected
  for f being Collineation of Segre_Product A for b1,b2 being Segre-like non
trivial-yielding ManySortedSubset of Carrier A st product b1 is Segre-Coset of
  A & product b2 is Segre-Coset of A & indx(b1)=indx(b2) holds
  canonical_embedding(f,b1) = canonical_embedding(f,b2);

definition
  let I be finite non empty set;
  let A be PLS-yielding ManySortedSet of I such that
 for i being Element of I holds A.i is strongly_connected;
  let f be Collineation of Segre_Product A;
  let i be Element of I;
  func canonical_embedding(f,i) -> Function of A.i,A.(permutation_of_indices(f
  ).i) means


  for b being Segre-like non trivial-yielding ManySortedSubset
  of Carrier A st product b is Segre-Coset of A & indx(b)=i holds it=
  canonical_embedding(f,b);
end;

theorem 
  for I being finite non empty set for A being PLS-yielding
ManySortedSet of I st for i being Element of I holds A.i is strongly_connected
  for f being Collineation of Segre_Product A ex s being Permutation of I, B
being Function-yielding ManySortedSet of I st for i being Element of I holds (B
  .i is Function of A.i,A.(s.i) & for m being Function of A.i,A.(s.i) st m=B.i
  holds m is isomorphic) & for p being Point of Segre_Product A for a being
  ManySortedSet of I st a=p for b being ManySortedSet of I st b=f.p for m being
  Function of A.i,A.(s.i) st m=B.i holds b.(s.i)=m.(a.i);















begin 

theorem 
  for k,n being Nat st k < n & 3 <= n holds k+1 < n or 2 <= k;

theorem 
  for F being Field for V being VectSp of F for W being Subspace of
  V holds W is Subspace of (Omega).V;

theorem 
  for F being Field for V being VectSp of F for W being Subspace of
  (Omega).V holds W is Subspace of V;

theorem 
  for F being Field for V being VectSp of F for W being Subspace of
  V holds (Omega).W is Subspace of V;

theorem 
  for F being Field for V,W being VectSp of F holds (Omega).W is
  Subspace of V implies W is Subspace of V;

definition
  let F be Field;
  let V be VectSp of F;
  let W1,W2 be Subspace of V;
  func segment(W1,W2) -> Subset of Subspaces(V) means


  for W being
  strict Subspace of V holds W in it iff W1 is Subspace of W & W is Subspace of
  W2 if W1 is Subspace of W2 otherwise it={};
end;

theorem 
  for F being Field for V being VectSp of F for W1,W2,W3,W4 being
  Subspace of V st W1 is Subspace of W2 & W3 is Subspace of W4 & (Omega).W1=
  (Omega).W3 & (Omega).W2=(Omega).W4 holds segment(W1,W2) = segment(W3,W4);

definition
  let F be Field;
  let V be VectSp of F;
  let W1,W2 be Subspace of V;
  func pencil(W1,W2) -> Subset of Subspaces(V) equals

  segment(W1,W2) \ {
  (Omega).W1,(Omega).W2};
end;

theorem 
  for F being Field for V being VectSp of F for W1,W2,W3,W4 being
  Subspace of V st W1 is Subspace of W2 & W3 is Subspace of W4 & (Omega).W1=
(Omega).W3 & (Omega).W2=(Omega).W4 holds pencil(W1,W2) = pencil(W3,W4);

definition
  let F be Field;
  let V be finite-dimensional VectSp of F;
  let W1,W2 be Subspace of V;
  let k be Nat;
  func pencil(W1,W2,k) -> Subset of (k Subspaces_of V) equals

  pencil (W1,W2)
  /\ (k Subspaces_of V);
end;

theorem 
  for F being Field for V being finite-dimensional VectSp of F for
k being Nat for W1,W2,W being Subspace of V st W in pencil(W1,W2,k) holds W1 is
  Subspace of W & W is Subspace of W2;

theorem 
  for F being Field for V being finite-dimensional VectSp of F for k
  being Nat for W1,W2,W3,W4 being Subspace of V st W1 is Subspace of W2 & W3 is
Subspace of W4 & (Omega).W1=(Omega).W3 & (Omega).W2=(Omega).W4 holds pencil(W1,
  W2,k) = pencil(W3,W4,k);

definition
  let F be Field;
  let V be finite-dimensional VectSp of F;
  let k be Nat;
  func k Pencils_of V -> Subset-Family of (k Subspaces_of V) means


  for
X being set holds X in it iff ex W1,W2 being Subspace of V st W1 is Subspace of
  W2 & dim W1+1=k & dim W2=k+1 & X=pencil(W1,W2,k);
end;

theorem 
  for F being Field for V being finite-dimensional VectSp of F for
  k being Nat st 1 <= k & k < dim V holds k Pencils_of V is non empty;

theorem 
  for F being Field for V being finite-dimensional VectSp of F for
W1,W2,P,Q being Subspace of V for k being Nat st dim W1+1=k & dim W2=k+1 & P in
  pencil(W1,W2,k) & Q in pencil(W1,W2,k) & P<>Q holds P/\Q = (Omega).W1 & P+Q =
  (Omega).W2;

theorem 
  for F being Field for V being finite-dimensional VectSp of F for
  v being Vector of V st v <> 0.V holds dim Lin{v} = 1;

theorem 
  for F being Field for V being finite-dimensional VectSp of F for
W being Subspace of V for v being Vector of V st not v in W holds dim(W+Lin{v})
  =dim W + 1;

theorem 
  for F being Field for V being finite-dimensional VectSp of F for
  W being Subspace of V for v,u being Vector of V st v<>u & {v,u} is
  linearly-independent & W/\Lin{v,u}=(0).V holds dim(W+Lin{v,u})=dim W + 2;

theorem 
  for F being Field for V being finite-dimensional VectSp of F for
W1,W2 being Subspace of V st W1 is Subspace of W2 for k being Nat st dim W1+1=k
  & dim W2=k+1 for v being Vector of V st v in W2 & not v in W1 holds W1+Lin{v}
  in pencil(W1,W2,k);

theorem 
  for F being Field for V being finite-dimensional VectSp of F for
W1,W2 being Subspace of V st W1 is Subspace of W2 for k being Nat st dim W1+1=k
  & dim W2=k+1 holds pencil(W1,W2,k) is non trivial;

definition
  let F be Field;
  let V be finite-dimensional VectSp of F;
  let k be Nat;
  func PencilSpace(V,k) -> strict TopStruct equals

  TopStruct(#k Subspaces_of V
    , k Pencils_of V#);
end;

theorem 
  for F being Field for V being finite-dimensional VectSp of F for
  k being Nat st 1 <= k & k < dim V holds PencilSpace(V,k) is non void;

theorem 
  for F being Field for V being finite-dimensional VectSp of F for
  k being Nat st 1 <= k & k < dim V & 3 <= dim V holds PencilSpace(V,k) is non
  degenerated;

theorem 
  for F being Field for V being finite-dimensional VectSp of F for
  k being Nat st 1 <= k & k < dim V holds PencilSpace(V,k) is
  with_non_trivial_blocks;

theorem 
  for F being Field for V being finite-dimensional VectSp of F for
  k being Nat st 1 <= k & k < dim V holds PencilSpace(V,k) is
  identifying_close_blocks;

theorem 
  for F being Field for V being finite-dimensional VectSp of F for k
  being Nat st 1 <= k & k < dim V & 3 <= dim V holds PencilSpace(V,k) is PLS;

begin 

definition
  let F be Field;
  let V be finite-dimensional VectSp of F;
  let m,n be Nat;
  func SubspaceSet(V,m,n) -> Subset-Family of m Subspaces_of V means


for X being set holds X in it iff ex W being Subspace of V st dim W = n & X = m
  Subspaces_of W;
end;

theorem 
  for F being Field for V being finite-dimensional VectSp of F for
  m,n be Nat st n <= dim V holds SubspaceSet(V,m,n) is non empty;

theorem 
  for F being Field for W1,W2 being finite-dimensional VectSp of F
  st (Omega).W1 = (Omega).W2 for m being Nat holds m Subspaces_of W1 = m
  Subspaces_of W2;

theorem 
  for F being Field for V being finite-dimensional VectSp of F for
  W being Subspace of V for m being Nat st 1<=m & m <= dim V & m Subspaces_of V
  c= m Subspaces_of W holds (Omega).V = (Omega).W;

definition
  let F be Field;
  let V be finite-dimensional VectSp of F;
  let m,n be Nat;
  func GrassmannSpace(V,m,n) -> strict TopStruct equals

  TopStruct(#m
    Subspaces_of V, SubspaceSet(V,m,n)#);
end;

theorem 
  for F being Field for V being finite-dimensional VectSp of F for
  m,n being Nat st n <= dim V holds GrassmannSpace(V,m,n) is non void;

theorem 
  for F being Field for V being finite-dimensional VectSp of F for
m,n being Nat st 1 <= m & m < n & n < dim V holds GrassmannSpace(V,m,n) is non
  degenerated;

theorem 
  for F being Field for V being finite-dimensional VectSp of F for
  m,n being Nat st 1 <= m & m < n & n <= dim V holds GrassmannSpace(V,m,n) is
  with_non_trivial_blocks;

theorem 
  for F being Field for V being finite-dimensional VectSp of F for
  m being Nat st m+1 <= dim V holds GrassmannSpace(V,m,m+1) is
  identifying_close_blocks;

theorem 
  for F being Field for V being finite-dimensional VectSp of F for m
  being Nat st 1 <= m & m+1 < dim V holds GrassmannSpace(V,m,m+1) is PLS;

begin 

definition
  let X be set;
  func PairSet(X) means


  for z being set holds z in it iff ex x,y being
  set st x in X & y in X & z={x,y};
end;

registration
  let X be non empty set;
  cluster PairSet(X) -> non empty;
end;

definition
  let t,X be set;
  func PairSet(t,X) means


  for z being set holds z in it iff ex y being set st y in X & z={t,y};
end;

registration
  let t be set;
  let X be non empty set;
  cluster PairSet(t,X) -> non empty;
end;

registration
  let t be set;
  let X be non trivial set;
  cluster PairSet(t,X) -> non trivial;
end;

definition
  let X be set;
  let L be Subset-Family of X;
  func PairSetFamily(L) -> Subset-Family of PairSet(X) means


  for S
  being set holds S in it iff ex t being set, l being Subset of X st t in X & l
  in L & S=PairSet(t,l);
end;

registration
  let X be non empty set;
  let L be non empty Subset-Family of X;
  cluster PairSetFamily(L) -> non empty;
end;

definition
  let S be TopStruct;
  func VeroneseSpace(S) -> strict TopStruct equals

  TopStruct(#PairSet(the
    carrier of S), PairSetFamily(the topology of S)#);
end;

registration
  let S be non empty TopStruct;
  cluster VeroneseSpace(S) -> non empty;
end;

registration
  let S be non empty non void TopStruct;
  cluster VeroneseSpace(S) -> non void;
end;

registration
  let S be non empty non void non degenerated TopStruct;
  cluster VeroneseSpace(S) -> non degenerated;
end;

registration
  let S be non empty non void with_non_trivial_blocks TopStruct;
  cluster VeroneseSpace(S) -> with_non_trivial_blocks;
end;

registration
  let S be identifying_close_blocks TopStruct;
  cluster VeroneseSpace(S) -> identifying_close_blocks;
end;














begin 

theorem 
  for T being 1-sorted, A, B being Subset of T holds A meets B` iff A \ B <> {}
;

theorem 
  for T being 1-sorted holds T is countable iff card [#]T c= omega;

registration
  let T be finite 1-sorted;
  cluster [#]T -> finite;
end;

registration
  cluster finite -> countable for 1-sorted;
end;

registration
  cluster countable non empty for 1-sorted;
  cluster countable non empty for TopSpace;
end;

registration
  let T be countable 1-sorted;
  cluster [#]T -> countable;
end;

registration
  cluster T_1 non empty for TopSpace;
end;

begin

theorem 
  for T being TopSpace, A being Subset of T holds Int A = (Cl A`)`;



definition
  let T be TopSpace, F be Subset-Family of T;
  func Fr F -> Subset-Family of T means


  for A being Subset of T holds A
  in it iff ex B being Subset of T st A = Fr B & B in F;
end;

theorem 
  for T being TopSpace, F being Subset-Family of T st F = {} holds Fr F = {};

theorem 
  for T being TopSpace, F being Subset-Family of T, A being Subset of T
  st F = { A } holds Fr F = { Fr A };

theorem 
  for T being TopSpace, F, G being Subset-Family of T st F c= G
  holds Fr F c= Fr G;

theorem 
  for T being TopSpace, F, G being Subset-Family of T holds Fr (F \/ G)
  = Fr F \/ Fr G;

theorem 
  for T being TopStruct, A being Subset of T holds Fr A = Cl A \ Int A;

theorem 
  for T being non empty TopSpace, A being Subset of T, p being
  Point of T holds p in Fr A iff for U being Subset of T st U is open & p in U
  holds A meets U & U \ A <> {};

theorem 
  for T being non empty TopSpace, A being Subset of T, p being Point of
  T holds p in Fr A iff for B being Basis of p, U being Subset of T st U in B
  holds A meets U & U \ A <> {};

theorem 
  for T being non empty TopSpace, A being Subset of T, p being Point of
T holds p in Fr A iff ex B being Basis of p st for U being Subset of T st U in
  B holds A meets U & U \ A <> {};

theorem 
  for T being TopSpace, A, B being Subset of T holds Fr (A /\ B) c= (Cl
  A /\ Fr B) \/ (Fr A /\ Cl B);

theorem 
  for T being TopSpace, A being Subset of T holds the carrier of T = Int
  A \/ Fr A \/ Int A`;

theorem 
  for T being TopSpace, A being Subset of T holds A is open closed
  iff Fr A = {};

begin 


definition
  let T be TopStruct, A be Subset of T, x be set;
  pred x is_an_accumulation_point_of A means


  x in Cl (A \ {x});
end;

theorem 
  for T being TopSpace, A being Subset of T, x being set st x
  is_an_accumulation_point_of A holds x is Point of T;



definition
  let T be TopStruct, A be Subset of T;
  func Der A -> Subset of T means


  for x being set st x in the carrier
  of T holds x in it iff x is_an_accumulation_point_of A;
end;



theorem 
  for T being non empty TopSpace, A being Subset of T, x being set
  holds x in Der A iff x is_an_accumulation_point_of A;

theorem 
  for T being non empty TopSpace, A being Subset of T, x being
  Point of T holds x in Der A iff for U being open Subset of T st x in U ex y
  being Point of T st y in A /\ U & x <> y;

theorem 
  for T being non empty TopSpace, A being Subset of T, x being Point of
T holds x in Der A iff for B being Basis of x, U being Subset of T st U in B ex
  y being Point of T st y in A /\ U & x <> y;

theorem 
  for T being non empty TopSpace, A being Subset of T, x being Point of
T holds x in Der A iff ex B being Basis of x st for U being Subset of T st U in
  B ex y being Point of T st y in A /\ U & x <> y;

begin 

definition
  let T be TopSpace, A be Subset of T, x be set;
  pred x is_isolated_in A means


  x in A & not x is_an_accumulation_point_of A;
end;

theorem 
  for T being non empty TopSpace, A being Subset of T, p being set holds
  p in A \ Der A iff p is_isolated_in A;

theorem 
  for T being non empty TopSpace, A being Subset of T, p being
Point of T holds p is_an_accumulation_point_of A iff for U being open Subset of
  T st p in U ex q being Point of T st q <> p & q in A & q in U;

theorem 
  for T being non empty TopSpace, A being Subset of T, p being
Point of T holds p is_isolated_in A iff ex G being open Subset of T st G /\ A =
  {p};

definition
  let T be TopSpace, p be Point of T;
  attr p is isolated means


  p is_isolated_in [#]T;
end;

theorem 
  for T being non empty TopSpace, p being Point of T holds p is isolated
  iff {p} is open;

begin 

definition
  let T be TopSpace, F be Subset-Family of T;
  func Der F -> Subset-Family of T means


  for A being Subset of T holds
  A in it iff ex B being Subset of T st A = Der B & B in F;
end;

reserve T for non empty TopSpace,
  A, B for Subset of T,
  F, G for Subset-Family of T,
  x for set;

theorem 
  F = {} implies Der F = {};

theorem 
  F = { A } implies Der F = { Der A };

theorem 
  F c= G implies Der F c= Der G;

theorem 
  Der (F \/ G) = Der F \/ Der G;



theorem 
  for T being non empty TopSpace, A being Subset of T holds Der A c= Cl A;

theorem 
  for T being TopSpace, A being Subset of T holds Cl A = A \/ Der A;

theorem 
  for T being non empty TopSpace, A, B being Subset of T st A c= B
  holds Der A c= Der B;

theorem 
  for T being non empty TopSpace, A, B being Subset of T holds Der
  (A \/ B) = Der A \/ Der B;

theorem 
  for T being non empty TopSpace, A being Subset of T st T is T_1
  holds Der Der A c= Der A;

theorem 
  for T being TopSpace, A being Subset of T st T is T_1 holds Cl Der A = Der A;

registration
  let T be T_1 non empty TopSpace, A be Subset of T;
  cluster Der A -> closed;
end;

theorem 
  for T being non empty TopSpace, F being Subset-Family of T holds
  union Der F c= Der union F;

theorem 
  A c= B & x is_an_accumulation_point_of A implies x
  is_an_accumulation_point_of B;

begin 

definition
  let T be TopSpace, A be Subset of T;
  attr A is dense-in-itself means


  A c= Der A;
end;

definition
  let T be non empty TopSpace;
  attr T is dense-in-itself means

  [#]T is dense-in-itself;
end;

theorem 
  T is T_1 & A is dense-in-itself implies Cl A is dense-in-itself;

definition
  let T be TopSpace, F be Subset-Family of T;
  attr F is dense-in-itself means


  for A being Subset of T st A in F holds A is dense-in-itself;
end;

theorem 
  for F being Subset-Family of T st F is dense-in-itself holds
  union F c= union Der F;

theorem 
  F is dense-in-itself implies union F is dense-in-itself;

theorem 
  Fr {}T = {};

registration
  let T be TopSpace, A be open closed Subset of T;
  cluster Fr A -> empty;
end;

registration
  let T be non empty non discrete TopSpace;
  cluster non open for Subset of T;
  cluster non closed for Subset of T;
end;

registration
  let T be non empty non discrete TopSpace, A be non open Subset of T;
  cluster Fr A -> non empty;
end;

registration
  let T be non empty non discrete TopSpace, A be non closed Subset of T;
  cluster Fr A -> non empty;
end;

begin 

definition
  let T be TopSpace, A be Subset of T;
  attr A is perfect means


  A is closed dense-in-itself;
end;

registration
  let T be TopSpace;
  cluster perfect -> closed dense-in-itself for Subset of T;
  cluster closed dense-in-itself -> perfect for Subset of T;
end;

theorem 
  for T being TopSpace holds Der {}T = {}T;

theorem 
  for T being TopSpace, A being Subset of T holds A is perfect iff Der A = A;

theorem 
  for T being TopSpace holds {}T is perfect;

registration
  let T be TopSpace;
  cluster empty -> perfect for Subset of T;
end;

registration
  let T be TopSpace;
  cluster perfect for Subset of T;
end;

begin 

definition
  let T be TopSpace, A be Subset of T;
  attr A is scattered means


  not ex B being Subset of T st B is non empty & B c= A & B is dense-in-itself;
end;

registration
  let T be non empty TopSpace;
  cluster non empty scattered -> non dense-in-itself for Subset of T;
  cluster dense-in-itself non empty -> non scattered for Subset of T;
end;

theorem 
  for T being TopSpace holds {}T is scattered;

registration
  let T be TopSpace;
  cluster empty -> scattered for Subset of T;
end;

theorem 
  for T being non empty TopSpace st T is T_1 holds ex A, B being Subset
  of T st A \/ B = [#]T & A misses B & A is perfect & B is scattered;

registration
  let T be discrete TopSpace, A be Subset of T;
  cluster Fr A -> empty;
end;

registration
  let T be discrete TopSpace;
  cluster -> closed open for Subset of T;
end;

theorem 
  for T being discrete TopSpace, A being Subset of T holds Der A = {};

registration
  let T be discrete non empty TopSpace, A be Subset of T;
  cluster Der A -> empty;
end;

begin 


definition
  let T be TopSpace;
  func density T -> cardinal number means


  (ex A being Subset of T st A
  is dense & it = card A) & for B being Subset of T st B is dense holds it c=
  card B;
end;



definition
  let T be TopSpace;
  attr T is separable means


  density T c= omega;
end;

theorem 
  for T being countable TopSpace holds T is separable;

registration
  cluster countable -> separable for TopSpace;
end;

begin 

theorem 
  for A being Subset of R^1 st A = RAT holds A` = IRRAT;

theorem 
  for A being Subset of R^1 st A = IRRAT holds A` = RAT;

theorem 
  for A being Subset of R^1 st A = RAT holds Int A = {};

theorem 
  for A being Subset of R^1 st A = IRRAT holds Int A = {};

theorem 
  RAT is dense Subset of R^1;

theorem 
  IRRAT is dense Subset of R^1;

theorem 
  RAT is boundary Subset of R^1;

theorem 
  IRRAT is boundary Subset of R^1;

theorem 
  REAL is non boundary Subset of R^1;

theorem 
  ex A, B being Subset of R^1 st A is boundary & B is boundary &
  A \/ B is non boundary;















begin 

theorem 
  for X being set, b1,b2 being bag of X holds (b1 + b2) / b2 = b1;

theorem 
  for n being Ordinal, T being admissible TermOrder of n, b1,b2,b3
  being bag of n holds b1 <= b2,T implies b1 + b3 <= b2 + b3,T;

theorem 
  for n being Ordinal, T being TermOrder of n, b1,b2,b3 being bag
  of n holds b1 <= b2,T & b2 < b3,T implies b1 < b3,T;

theorem 
  for n being Ordinal, T being admissible TermOrder of n, b1,b2,b3
  being bag of n holds b1 < b2,T implies b1 + b3 < b2 + b3,T;

theorem 
  for n being Ordinal, T being admissible TermOrder of n, b1,b2,b3,
  b4 being bag of n holds b1 < b2,T & b3 <= b4,T implies b1 + b3 < b2 + b4,T;

theorem 
  for n being Ordinal, T being admissible TermOrder of n, b1,b2,b3,
  b4 being bag of n holds b1 <= b2,T & b3 < b4,T implies b1 + b3 < b2 + b4,T;

begin 

theorem 
  for n being Ordinal, L being add-associative right_complementable
right_zeroed well-unital distributive domRing-like non trivial doubleLoopStr,
  m1,m2 being non-zero Monomial of n,L holds term(m1*'m2) = term(m1) + term(m2)
;

theorem 
  for n being Ordinal, L being add-associative right_complementable
right_zeroed well-unital distributive domRing-like non trivial doubleLoopStr,
  p being Polynomial of n,L, m being non-zero Monomial of n,L, b being bag of n
  holds b in Support(p) iff term(m) + b in Support(m*'p);

theorem 
  for n being Ordinal, L being add-associative right_complementable
right_zeroed well-unital distributive domRing-like non trivial doubleLoopStr,
p being Polynomial of n,L, m being non-zero Monomial of n,L holds Support(m*'p)
  = { term(m) + b where b is Element of Bags n : b in Support p };

theorem 
  for n being Ordinal, L being add-associative
  right_complementable left_zeroed right_zeroed well-unital distributive
  domRing-like non trivial doubleLoopStr, p being Polynomial of n,L, m being
  non-zero Monomial of n,L holds card Support(p) = card Support(m*'p);

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed non trivial addLoopStr
  holds Red(0_(n,L),T) = 0_(n,L);

theorem 
  for n being Ordinal, L being Abelian add-associative
  right_zeroed right_complementable commutative well-unital distributive non
  trivial doubleLoopStr, p,q being Polynomial of n,L holds p - q = 0_(n,L)
  implies p = q;

theorem 
  for X being set, L being add-associative right_zeroed
  right_complementable non empty addLoopStr holds -(0_(X,L)) = 0_(X,L);

theorem 
  for X being set, L being add-associative right_zeroed
right_complementable non empty addLoopStr, f being Series of X,L holds 0_(X,L
  ) - f = -f;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
add-associative right_complementable right_zeroed non trivial doubleLoopStr,
  p being Polynomial of n,L holds p - Red(p,T) = HM(p,T);

registration
  let n be Ordinal, L be add-associative right_complementable right_zeroed
  non empty addLoopStr, p be Polynomial of n,L;
  cluster Support p -> finite;
end;

definition
  let n be Ordinal, L be right_zeroed add-associative right_complementable
well-unital distributive non trivial doubleLoopStr, p,q be Polynomial of n,L;
  redefine func {p,q} -> Subset of Polynom-Ring(n,L);
end;

begin 

definition
  let X be set, L be non empty ZeroStr, s be Series of X,L, Y be Subset of
  Bags X;
  func s|Y -> Series of X,L equals

  s +* ((Support s \ Y) --> 0.L);
end;

registration
  let n be Ordinal, L be non empty ZeroStr, p be Polynomial of n,L, Y be
  Subset of Bags n;
  cluster p|Y -> finite-Support;
end;

theorem 
  for X being set, L being non empty ZeroStr, s being Series of X,
L, Y being Subset of Bags X holds Support s|Y = (Support s) /\ Y & for b being
  bag of X st b in Support s|Y holds (s|Y).b = s.b;

theorem 
  for X being set, L being non empty ZeroStr, s being Series of X,L, Y
  being Subset of Bags X holds Support(s|Y) c= Support s;

theorem 
  for X being set, L being non empty ZeroStr, s being Series of X,L
  holds s|(Support s) = s & s|({} Bags X) = 0_(X,L);

definition
  let n be Ordinal, T be connected TermOrder of n, L be add-associative
right_zeroed right_complementable non empty addLoopStr, p be Polynomial of n,
  L, i be Element of NAT such that
 i <= card(Support p);
  func Upper_Support(p,T,i) -> finite Subset of Bags n means


  it c=
Support p & card it = i & for b,b9 being bag of n st b in it & b9 in Support p
  & b <= b9,T holds b9 in it;
end;

definition
  let n be Ordinal, T be connected TermOrder of n, L be add-associative
right_zeroed right_complementable non empty addLoopStr, p be Polynomial of n,
  L, i be Element of NAT;
  func Lower_Support(p,T,i) -> finite Subset of Bags n equals

  Support(p) \
  Upper_Support(p,T,i);
end;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_zeroed right_complementable non empty addLoopStr, p
  being Polynomial of n,L, i being Element of NAT st i <= card(Support p) holds
Upper_Support(p,T,i) \/ Lower_Support(p,T,i) = Support p & Upper_Support(p,T,i)
  /\ Lower_Support(p,T,i) = {};

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_zeroed right_complementable non empty addLoopStr, p
being Polynomial of n,L, i being Element of NAT st i <= card(Support p) for b,
  b9 being bag of n st b in Upper_Support(p,T,i) & b9 in Lower_Support(p,T,i)
  holds b9 < b,T;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_zeroed right_complementable non empty addLoopStr, p
being Polynomial of n,L holds Upper_Support(p,T,0) = {} & Lower_Support(p,T,0)
  = Support p;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_zeroed right_complementable non empty addLoopStr, p
being Polynomial of n,L holds Upper_Support(p,T,card(Support p)) = Support p &
  Lower_Support(p,T,card(Support p)) = {};

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_zeroed right_complementable non trivial addLoopStr, p
being non-zero Polynomial of n,L, i being Element of NAT st 1 <= i & i <= card(
  Support p) holds HT(p,T) in Upper_Support(p,T,i);

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_zeroed right_complementable non empty addLoopStr, p
  being Polynomial of n,L, i being Element of NAT st i <= card(Support p) holds
Lower_Support(p,T,i) c= Support p & card Lower_Support(p,T,i) = card(Support p)
- i & for b,b9 being bag of n st b in Lower_Support(p,T,i) & b9 in Support p &
  b9 <= b,T holds b9 in Lower_Support(p,T,i);

definition
  let n be Ordinal, T be connected TermOrder of n, L be add-associative
right_zeroed right_complementable non empty addLoopStr, p be Polynomial of n,
  L, i be Element of NAT;
  func Up(p,T,i) -> Polynomial of n,L equals

  p|(Upper_Support(p,T,i));
  func Low(p,T,i) -> Polynomial of n,L equals

  p|(Lower_Support(p,T,i));
end;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_zeroed right_complementable non empty addLoopStr, p
  being Polynomial of n,L, i being Element of NAT st i <= card(Support p) holds
Support Up(p,T,i) = Upper_Support(p,T,i) & Support Low(p,T,i) = Lower_Support(p
  ,T,i);

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_zeroed right_complementable non empty addLoopStr, p
  being Polynomial of n,L, i being Element of NAT st i <= card(Support p) holds
  Support(Up(p,T,i)) c= Support(p) & Support(Low(p,T,i)) c= Support(p);

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed non trivial addLoopStr, p
being Polynomial of n,L, i being Element of NAT st 1 <= i & i <= card(Support p
  ) holds Support(Low(p,T,i)) c= Support(Red(p,T));

theorem 
  for n be Ordinal, T be connected TermOrder of n, L be
add-associative right_zeroed right_complementable non empty addLoopStr, p be
Polynomial of n,L, i be Element of NAT st i <= card(Support p) for b being bag
of n st b in Support p holds (b in Support Up(p,T,i) or b in Support Low(p,T,i)
  ) & not(b in Support Up(p,T,i) /\ Support Low(p,T,i));

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_zeroed right_complementable non empty addLoopStr, p
being Polynomial of n,L, i being Element of NAT st i <= card(Support p) for b,
b9 being bag of n st b in Support Low(p,T,i) & b9 in Support Up(p,T,i) holds b
  < b9,T;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_zeroed right_complementable non empty addLoopStr, p
being Polynomial of n,L, i being Element of NAT st 1 <= i & i <= card(Support p
  ) holds HT(p,T) in Support Up(p,T,i);

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_zeroed right_complementable non empty addLoopStr, p
  being Polynomial of n,L, i being Element of NAT st i <= card(Support p) for b
being bag of n st b in Support Low(p,T,i) holds Low(p,T,i).b = p.b & Up(p,T,i).
  b = 0.L;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_zeroed right_complementable non empty addLoopStr, p
  being Polynomial of n,L, i being Element of NAT st i <= card(Support p) for b
being bag of n st b in Support Up(p,T,i) holds Up(p,T,i).b = p.b & Low(p,T,i).b
  = 0.L;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_zeroed right_complementable non empty addLoopStr, p
  being Polynomial of n,L, i being Element of NAT st i <= card(Support p) holds
  Up(p,T,i) + Low(p,T,i) = p;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_zeroed right_complementable non empty addLoopStr, p
  being Polynomial of n,L holds Up(p,T,0) = 0_(n,L) & Low(p,T,0) = p;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_zeroed right_complementable Abelian non empty
  doubleLoopStr, p being Polynomial of n,L holds Up(p,T,card(Support p)) = p &
  Low(p,T,card(Support p)) = 0_(n,L);

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_zeroed right_complementable Abelian non trivial
doubleLoopStr, p being non-zero Polynomial of n,L holds Up(p,T,1) = HM(p,T) &
  Low(p,T,1) = Red(p,T);

registration
  let n be Ordinal, T be connected TermOrder of n, L be add-associative
  right_zeroed right_complementable non trivial addLoopStr, p be non-zero
  Polynomial of n,L;
  cluster Up(p,T,0) -> monomial-like;
end;

registration
  let n be Ordinal, T be connected TermOrder of n, L be add-associative
  right_zeroed right_complementable Abelian non trivial doubleLoopStr, p be
  non-zero Polynomial of n,L;
  cluster Up(p,T,1) -> non-zero monomial-like;
  cluster Low(p,T,card(Support p)) -> monomial-like;
end;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_zeroed right_complementable non trivial addLoopStr, p
  being Polynomial of n,L, j being Element of NAT st j = card(Support p) - 1
  holds Low(p,T,j) is non-zero Monomial of n,L;

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n
  , L being add-associative right_zeroed right_complementable non empty
  addLoopStr, p being Polynomial of n,L, i being Element of NAT st i < card(
  Support p) holds HT(Low(p,T,i+1),T) <= HT(Low(p,T,i),T), T;

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_zeroed right_complementable non empty addLoopStr, p
being Polynomial of n,L, i being Element of NAT st 0 < i & i < card(Support p)
  holds HT(Low(p,T,i),T) < HT(p,T),T;

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n
  , L being add-associative right_complementable right_zeroed well-unital
distributive domRing-like non trivial doubleLoopStr, p being Polynomial of n,
  L, m being non-zero Monomial of n,L, i being Element of NAT st i <= card(
Support p) for b being bag of n holds term(m) + b in Support Low(m*'p,T,i) iff
  b in Support Low(p,T,i);

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n
  , L being add-associative right_zeroed right_complementable non empty
  addLoopStr, p being Polynomial of n,L, i being Element of NAT st i < card(
  Support p) holds Support Low(p,T,i+1) c= Support Low(p,T,i);

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n
  , L being add-associative right_zeroed right_complementable non empty
  addLoopStr, p being Polynomial of n,L, i being Element of NAT st i < card(
Support p) holds Support Low(p,T,i) \ Support Low(p,T,i+1) = {HT(Low(p,T,i),T)}
;

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n
  , L being add-associative right_zeroed right_complementable non trivial
  addLoopStr, p being Polynomial of n,L, i being Element of NAT st i < card(
  Support p) holds Low(p,T,i+1) = Red(Low(p,T,i),T);

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n
  , L being add-associative right_complementable right_zeroed well-unital
distributive domRing-like non trivial doubleLoopStr, p being Polynomial of n,
  L, m being non-zero Monomial of n,L, i being Element of NAT st i <= card(
  Support p) holds Low(m*'p,T,i) = m *' Low(p,T,i);

begin

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n
  , L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive Abelian almost_left_invertible non
  trivial doubleLoopStr, f,g,p being Polynomial of n,L st f reduces_to g,p,T
  holds -f reduces_to -g,p,T;

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n
  , L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive Abelian almost_left_invertible non
trivial doubleLoopStr, f,f1,g,p being Polynomial of n,L st f reduces_to f1,{p}
  ,T & for b1 being bag of n st b1 in Support g holds not(HT(p,T) divides b1)
  holds f + g reduces_to f1 + g,{p},T;

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n
  , L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive Abelian almost_left_invertible non
  trivial doubleLoopStr, f,g being non-zero Polynomial of n,L holds f*'g
  reduces_to Red(f,T)*'g,{g},T;

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n, L
being add-associative right_complementable right_zeroed commutative associative
  well-unital distributive Abelian almost_left_invertible non trivial
doubleLoopStr, f,g being non-zero Polynomial of n,L, p being Polynomial of n,L
  st p.(HT(f*'g,T)) = 0.L holds f*'g+p reduces_to Red(f,T)*'g+p,{g},T;

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n
  , L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive Abelian almost_left_invertible non
trivial doubleLoopStr, P be Subset of Polynom-Ring(n,L), f,g being Polynomial
  of n,L st PolyRedRel(P,T) reduces f,g holds PolyRedRel(P,T) reduces -f,-g;

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n, L
being add-associative right_complementable right_zeroed commutative associative
  well-unital distributive Abelian almost_left_invertible non trivial
doubleLoopStr, f,f1,g,p being Polynomial of n,L st PolyRedRel({p},T) reduces f
  ,f1 & for b1 being bag of n st b1 in Support g holds not(HT(p,T) divides b1)
  holds PolyRedRel({p},T) reduces f+g,f1+g;

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n
  , L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive Abelian almost_left_invertible non
trivial doubleLoopStr, f,g being non-zero Polynomial of n,L holds PolyRedRel({
  g},T) reduces f*'g,0_(n,L);

begin 

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n
  , L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive almost_left_invertible non trivial
doubleLoopStr, p1,p2 being Polynomial of n,L st HT(p1,T),HT(p2,T) are_disjoint
  for b1,b2 being bag of n st b1 in Support Red(p1,T) & b2 in Support Red(p2,T)
  holds not(HT(p1,T) + b2 = HT(p2,T) + b1);

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed commutative associative
  well-unital distributive Abelian almost_left_invertible non trivial
doubleLoopStr, p1,p2 being Polynomial of n,L st HT(p1,T),HT(p2,T) are_disjoint
  holds S-Poly(p1,p2,T) = HM(p2,T) *' Red(p1,T) - HM(p1,T) *' Red(p2,T);

theorem 
  for n being Ordinal, T being connected TermOrder of n, L being
  add-associative right_complementable right_zeroed commutative associative
  well-unital distributive Abelian almost_left_invertible non trivial
doubleLoopStr, p1,p2 being Polynomial of n,L st HT(p1,T),HT(p2,T) are_disjoint
  holds S-Poly(p1,p2,T) = Red(p1,T) *' p2 - Red(p2,T) *' p1;

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n
  , L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive Abelian almost_left_invertible non
trivial doubleLoopStr, p1,p2 being non-zero Polynomial of n,L st HT(p1,T),HT(
  p2,T) are_disjoint & Red(p1,T) is non-zero & Red(p2,T) is non-zero holds
PolyRedRel({p1},T) reduces HM(p2,T)*'Red(p1,T) - HM(p1,T)*'Red(p2,T), p2 *' Red
  (p1,T);

theorem 
  for n being Ordinal, T being connected admissible TermOrder of n
  , L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive Abelian almost_left_invertible non
  trivial doubleLoopStr, p1,p2 being Polynomial of n,L st HT(p1,T),HT(p2,T)
  are_disjoint holds PolyRedRel({p1,p2},T) reduces S-Poly(p1,p2,T),0_(n,L);



theorem 
  for n being Element of NAT, T being connected admissible TermOrder of
  n, L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive Abelian almost_left_invertible non
  degenerated non empty doubleLoopStr, G being Subset of Polynom-Ring(n,L)
  holds G is_Groebner_basis_wrt T implies (for g1,g2 being Polynomial of n,L st
  g1 in G & g2 in G & not(HT(g1,T),HT(g2,T) are_disjoint) holds PolyRedRel(G,T)
  reduces S-Poly(g1,g2,T),0_(n,L));



theorem 
  for n being Element of NAT, T being connected admissible TermOrder of
  n, L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive Abelian almost_left_invertible non
degenerated non trivial doubleLoopStr, G being Subset of Polynom-Ring(n,L) st
not(0_(n,L) in G) holds (for g1,g2 being Polynomial of n,L st g1 in G & g2 in G
& not(HT(g1,T),HT(g2,T) are_disjoint) holds PolyRedRel(G,T) reduces S-Poly(g1,
g2,T),0_(n,L)) implies (for g1,g2,h being Polynomial of n,L st g1 in G & g2 in
G & not(HT(g1,T),HT(g2,T) are_disjoint) & h is_a_normal_form_of S-Poly(g1,g2,T)
  ,PolyRedRel(G,T) holds h = 0_(n,L));



theorem 
  for n being Element of NAT, T being connected admissible TermOrder of
  n, L being add-associative right_complementable right_zeroed commutative
  associative well-unital distributive Abelian almost_left_invertible non
  degenerated non empty doubleLoopStr, G being Subset of Polynom-Ring(n,L) st
not(0_(n,L) in G) holds (for g1,g2,h being Polynomial of n,L st g1 in G & g2 in
G & not(HT(g1,T),HT(g2,T) are_disjoint) & h is_a_normal_form_of S-Poly(g1,g2,T)
  ,PolyRedRel(G,T) holds h = 0_(n,L)) implies G is_Groebner_basis_wrt T;
 















begin 

reserve a,b,c for set;

definition
  let X be set;
  let B be Subset-Family of X;
  attr B is point-filtered means


  for x,U1,U2 being set st U1 in B & U2
in B & x in U1 /\ U2 ex U being Subset of X st U in B & x in U & U c= U1 /\ U2;
end;



theorem 
  for X being set, B being Subset-Family of X holds B is covering
  iff for x being set st x in X ex U being Subset of X st U in B & x in U;



theorem 
  for X being set, B being Subset-Family of X st B is
  point-filtered covering for T being TopStruct st the carrier of T = X & the
  topology of T = UniCl B holds T is TopSpace & B is Basis of T;



theorem 
  for X being set, B being non-empty ManySortedSet of X st rng B c= bool
  bool X & (for x,U being set st x in X & U in B.x holds x in U) & (for x,y,U
being set st x in U & U in B.y & y in X ex V being set st V in B.x & V c= U) &
(for x,U1,U2 being set st x in X & U1 in B.x & U2 in B.x ex U being set st U in
B.x & U c= U1 /\ U2) ex P being Subset-Family of X st P = Union B & for T being
  TopStruct st the carrier of T = X & the topology of T = UniCl P holds T is
  TopSpace & for T9 being non empty TopSpace st T9 = T holds B is
  Neighborhood_System of T9;



theorem 
  for X being set, F being Subset-Family of X st {} in F & (for A,B
being set st A in F & B in F holds A \/ B in F) & (for G being Subset-Family of
X st G c= F holds Intersect G in F) for T being TopStruct st the carrier of T =
  X & the topology of T = COMPLEMENT F holds T is TopSpace & for A being Subset
  of T holds A is closed iff A in F;

scheme 

  TopDefByClosedPred{X() -> set, C[set]}: ex T being strict TopSpace st the
  carrier of T = X() & for A being Subset of T holds A is closed iff C[A]
provided
 C[{}] & C[X()] and
 for A,B being set st C[A] & C[B] holds C[A \/ B] and
 for G being Subset-Family of X() st for A being set st A in G holds
C[A] holds C[Intersect G];

theorem 
  for T1,T2 being TopSpace st for A being set holds A is open Subset of
  T1 iff A is open Subset of T2 holds the TopStruct of T1 = the TopStruct of T2
;

theorem 
  for T1,T2 being TopSpace st for A being set holds A is closed
  Subset of T1 iff A is closed Subset of T2 holds the TopStruct of T1 = the
  TopStruct of T2;

definition
  let X,Y be set;
  let r be Subset of [:X, bool Y:];
  redefine func rng r -> Subset-Family of Y;
end;



theorem 
  for X being set, c being Function of bool X, bool X st c.{} = {}
& (for A being Subset of X holds A c= c.A) & (for A,B being Subset of X holds c
.(A \/ B) = (c.A) \/ (c.B)) & (for A being Subset of X holds c.(c.A) = c.A) for
T being TopStruct st the carrier of T = X & the topology of T = COMPLEMENT rng
  c holds T is TopSpace & for A being Subset of T holds Cl A = c.A;

scheme 

  TopDefByClosureOp{X() -> set, ClOp(set) -> set}: ex T being strict TopSpace
  st the carrier of T = X() & for A being Subset of T holds Cl A = ClOp(A)
provided
 ClOp({}) = {} and
 for A being Subset of X() holds A c= ClOp(A) & ClOp(A) c= X() and
 for A,B being Subset of X() holds ClOp(A \/ B) = ClOp(A) \/ ClOp(B) and
 for A being Subset of X() holds ClOp(ClOp(A)) = ClOp(A);

theorem 
  for T1,T2 being TopSpace st the carrier of T1 = the carrier of T2
& for A1 being Subset of T1, A2 being Subset of T2 st A1 = A2 holds Cl A1 = Cl
  A2 holds the topology of T1 = the topology of T2;



theorem 
  for X being set, i being Function of bool X, bool X st i.X = X &
(for A being Subset of X holds i.A c= A) & (for A,B being Subset of X holds i.(
A /\ B) = (i.A) /\ (i.B)) & (for A being Subset of X holds i.(i.A) = i.A) for T
being TopStruct st the carrier of T = X & the topology of T = rng i holds T is
  TopSpace & for A being Subset of T holds Int A = i.A;

scheme 

  TopDefByInteriorOp{X() -> set, IntOp(set) -> set}: ex T being strict
  TopSpace st the carrier of T = X() & for A being Subset of T holds Int A =
  IntOp(A)
provided
 IntOp(X()) = X() and
 for A being Subset of X() holds IntOp(A) c= A and
 for A,B being Subset of X() holds IntOp(A /\ B) = IntOp(A) /\ IntOp( B) and
 for A being Subset of X() holds IntOp(IntOp(A)) = IntOp(A);

theorem 
  for T1,T2 being TopSpace st the carrier of T1 = the carrier of
T2 & for A1 being Subset of T1, A2 being Subset of T2 st A1 = A2 holds Int A1 =
  Int A2 holds the topology of T1 = the topology of T2;

begin 

definition

  func Sorgenfrey-line -> strict non empty TopSpace means


  the carrier
of it = REAL & ex B being Subset-Family of REAL st the topology of it = UniCl B
  & B = {[.x,q.[ where x is Element of REAL, q is Element of REAL: x < q & q is
  rational};
end;

theorem 
  for x,y being real number holds [.x,y.[ is open Subset of Sorgenfrey-line;

theorem 
  for x,y being real number holds ].x,y.[ is open Subset of Sorgenfrey-line;

theorem 
  for x being real number holds left_open_halfline x is open Subset of
  Sorgenfrey-line;

theorem 
  for x being real number holds right_open_halfline x is open Subset of
  Sorgenfrey-line;

theorem 
  for x being real number holds right_closed_halfline x is open Subset
  of Sorgenfrey-line;

theorem 
  card INT = omega;


theorem 
  card RAT = omega;

theorem 
  for A being set st A is mutually-disjoint & for a st a in A ex x
  ,y being real number st x < y & ].x,y.[ c= a holds A is countable;

definition
  let X be set;
  let x be real number;
  pred x is_local_minimum_of X means


  x in X & ex y being real number st y < x & ].y,x.[ misses X;
end;

theorem 
  for U being Subset of REAL holds {x where x is Element of REAL:
  x is_local_minimum_of U} is countable;

registration
  let M be Aleph;
  cluster exp(2,M) -> infinite;
end;

definition
  func continuum -> infinite cardinal number equals

  card REAL;
end;

theorem 
  card {[.x,q.[ where x is Element of REAL, q is Element of REAL:
  x < q & q is rational} = continuum;

definition
  let X be set, r being real number;
  func X-powers r -> Function of NAT, REAL means


  for i being Nat holds i in X & it.i = r|^i or not i in X & it.i = 0;
end;

theorem 
  for X being set, r being real number st 0 < r & r < 1 holds X
  -powers r is summable;

reserve r for real number,
  X for set,
  n for Element of NAT;

theorem 
  0 < r & r < 1 implies Sum ((r GeoSeq)^\n) = r|^n / (1-r);

theorem 
  Sum (((1/2) GeoSeq)^\(n+1)) = (1/2)|^n;

theorem 
  0 < r & r < 1 implies Sum (X-powers r) <= Sum (r GeoSeq);

theorem 
  Sum ((X-powers (1/2))^\(n+1)) <= (1/2)|^n;

theorem 
  for X being infinite Subset of NAT, i being Nat holds
  (Partial_Sums (X-powers (1/2))).i < Sum (X-powers (1/2));

theorem 
  for X,Y being infinite Subset of NAT st Sum (X-powers (1/2)) =
  Sum (Y-powers (1/2)) holds X = Y;

theorem 
  X is countable implies Fin X is countable;

theorem 
  continuum = exp(2, omega);


theorem 
  omega in continuum;

theorem 
  for A being Subset-Family of REAL st card A in continuum holds
  card {x where x is Element of REAL: ex U being set st U in UniCl A & x
  is_local_minimum_of U} in continuum;

theorem 
  for X being Subset-Family of REAL st card X in continuum ex x
  being real number, q being rational number st x < q & not [.x,q.[ in UniCl X;

theorem 
  weight Sorgenfrey-line = continuum;

begin 

definition
  let X be set;
  func ClFinTop(X) -> strict TopSpace means


  the carrier of it = X &
  for F being Subset of it holds F is closed iff F is finite or F = X;
end;

theorem 
  for X being set, A being Subset of ClFinTop(X) holds A is open
  iff A = {} or A` is finite;

theorem 
  for X being infinite set, A being Subset of X st A is finite
  holds A` is infinite;

registration
  let X be non empty set;
  cluster ClFinTop(X) -> non empty;
end;

theorem 
  for X being infinite set for U,V being non empty open Subset of
  ClFinTop(X) holds U meets V;

begin 

definition
  let X,x0 be set;
  func x0-PointClTop(X) -> strict TopSpace means


  the carrier of it = X
  & for A being Subset of it holds Cl A = IFEQ(A,{},A,A \/ {x0} /\ X);
end;

registration
  let X be non empty set;
  let x0 be set;
  cluster x0-PointClTop X -> non empty;
end;

theorem 
  for X being non empty set, x0 being Element of X for A being non
  empty Subset of x0-PointClTop(X) holds Cl A = A \/ {x0};

theorem 
  for X being non empty set, x0 being Element of X for A being non
  empty Subset of x0-PointClTop(X) holds A is closed iff x0 in A;

theorem 
  for X being non empty set, x0 being Element of X for A being
  proper Subset of x0-PointClTop(X) holds A is open iff not x0 in A;

theorem 
  for X,x0,x being set st x0 in X holds {x} is closed Subset of x0
  -PointClTop(X) iff x = x0;

theorem 
  for X,x0,x being set st {x0} c< X holds {x} is open Subset of x0
  -PointClTop(X) iff x in X & x <> x0;

begin 

definition
  let X,X0 be set;
  func X0-DiscreteTop(X) -> strict TopSpace means


  the carrier of it =
  X & for A being Subset of it holds Int A = IFEQ(A,X,A,A /\ X0);
end;

registration
  let X be non empty set;
  let X0 be set;
  cluster X0-DiscreteTop X -> non empty;
end;

theorem 
  for X being non empty set, X0 being set for A being proper
  Subset of X0-DiscreteTop(X) holds Int A = A /\ X0;

theorem 
  for X being non empty set, X0 being set for A being proper
  Subset of X0-DiscreteTop(X) holds A is open iff A c= X0;

theorem 
  for X be set, X0 being Subset of X holds the topology of X0
  -DiscreteTop X = {X} \/ bool X0;

theorem 
  for X being set holds ADTS X = {}-DiscreteTop(X);

theorem 
  for X being set holds 1TopSp X = X-DiscreteTop(X);














begin 


definition
  let L be non empty \/-SemiLattStr;
  attr L is join-Associative means


  for x, y, z being Element of L holds x "\/" (y "\/" z) = y "\/" (x "\/" z);
end;

definition
  let L be non empty /\-SemiLattStr;
  attr L is meet-Associative means


  for x, y, z being Element of L holds x "/\" (y "/\" z) = y "/\" (x "/\" z);
end;

definition
  let L be non empty LattStr;
  attr L is meet-Absorbing means


  for x, y being Element of L holds x "\/" (x "/\" y) = x;
end;

theorem 
  for L being non empty LattStr holds L is meet-Associative
  join-Associative meet-Absorbing join-absorbing implies L is meet-idempotent
  join-idempotent;

theorem 
  for L being non empty LattStr holds L is meet-Associative
  join-Associative meet-Absorbing join-absorbing implies L is meet-commutative
  join-commutative;

theorem 
  for L being non empty LattStr holds L is meet-Associative
  join-Associative meet-Absorbing join-absorbing implies L is meet-absorbing;

theorem 
  for L being non empty LattStr holds L is meet-Associative
  join-Associative meet-Absorbing join-absorbing implies L is meet-associative
  join-associative;

theorem 
  for L being non empty LattStr holds L is Lattice-like iff L is
  meet-Associative join-Associative meet-Absorbing join-absorbing;

registration
  cluster Lattice-like -> meet-Associative join-Associative meet-Absorbing for

    non empty LattStr;
  cluster meet-Associative join-Associative meet-Absorbing join-absorbing ->
    Lattice-like for non empty LattStr;
end;

begin 

registration
  cluster OrderInvolutive -> Dneg for PartialOrdered non empty OrthoRelStr;
end;

theorem 
  for L being Dneg non empty OrthoRelStr, x being Element of L holds x`` = x;

theorem 
  for O being OrderInvolutive PartialOrdered non empty OrthoRelStr
  , x, y being Element of O holds x <= y implies y` <= x`;

registration
  cluster with_infima with_suprema strict for PreOrthoPoset;
end;

notation
  let L be non empty \/-SemiLattStr, x, y be Element of L;
  synonym x |_| y for x "\/" y;
end;

notation
  let L be non empty /\-SemiLattStr, x, y be Element of L;
  synonym x |^| y for x "/\" y;
end;

notation
  let L be non empty RelStr, x, y be Element of L;
  synonym x "|^|" y for x "/\" y;
  synonym x "|_|" y for x "\/" y;
end;

begin 

definition
  struct (\/-SemiLattStr, RelStr) \/-SemiLattRelStr (# carrier -> set, L_join
    -> (BinOp of the carrier), InternalRel -> Relation of the carrier #);
end;

definition
  struct (/\-SemiLattStr, RelStr) /\-SemiLattRelStr (# carrier -> set, L_meet
    -> (BinOp of the carrier), InternalRel -> Relation of the carrier #);
end;

definition
  struct (/\-SemiLattRelStr, \/-SemiLattRelStr, LattStr) LattRelStr (# carrier
-> set, L_join, L_meet -> (BinOp of the carrier), InternalRel -> Relation of
    the carrier #);
end;

definition
  func TrivLattRelStr -> LattRelStr equals

  LattRelStr (# 1, op2, op2, id 1 #);
end;

registration
  cluster TrivLattRelStr -> 1-element;
end;

registration
  cluster non empty for \/-SemiLattRelStr;
  cluster non empty for /\-SemiLattRelStr;
  cluster non empty for LattRelStr;
end;

theorem 
  for R being non empty RelStr st the InternalRel of R is_reflexive_in
the carrier of R & the InternalRel of R is antisymmetric transitive holds R is
  reflexive antisymmetric transitive;

registration
  cluster TrivLattRelStr -> reflexive;
end;

registration
  cluster antisymmetric reflexive transitive with_suprema with_infima
    for LattRelStr;
end;

registration
  cluster TrivLattRelStr -> meet-Absorbing;
end;

registration
  cluster Lattice-like for non empty LattRelStr;
end;

definition
  let L be Lattice;
  redefine func LattRel L -> Order of the carrier of L;
end;

begin 

definition
  struct (LattRelStr, OrthoLattStr, OrthoRelStr) OrthoLattRelStr (# carrier ->
set, L_join, L_meet -> (BinOp of the carrier), InternalRel -> (Relation of the
    carrier), Compl -> UnOp of the carrier #);
end;

definition
  func TrivCLRelStr -> OrthoLattRelStr equals

  OrthoLattRelStr (# 1, op2, op2,
    id 1, op1 #);
end;







definition
  let L be non empty ComplStr;
  attr L is involutive means


  for x being Element of L holds x`` = x;
end;

definition
  let L be non empty ComplLLattStr;
  attr L is with_Top means


  for x, y being Element of L holds x |_| x` = y |_| y`;
end;

registration
  cluster TrivOrtLat -> involutive with_Top;
end;

registration
  cluster TrivCLRelStr -> 1-element;
end;

registration
  cluster TrivCLRelStr -> reflexive;
end;

registration
  cluster TrivCLRelStr -> involutive with_Top;
end;

registration
  cluster involutive with_Top de_Morgan Lattice-like for
1-element OrthoLattStr;
end;

definition
  mode Ortholattice is involutive with_Top de_Morgan Lattice-like non empty
    OrthoLattStr;
end;

begin 

theorem 
  for K, L being non empty LattStr st the LattStr of K = the
  LattStr of L & K is join-commutative holds L is join-commutative;

theorem 
  for K, L being non empty LattStr st the LattStr of K = the
  LattStr of L & K is meet-commutative holds L is meet-commutative;

theorem 
  for K, L being non empty LattStr st the LattStr of K = the
  LattStr of L & K is join-associative holds L is join-associative;

theorem 
  for K, L being non empty LattStr st the LattStr of K = the
  LattStr of L & K is meet-associative holds L is meet-associative;

theorem 
  for K, L being non empty LattStr st the LattStr of K = the
  LattStr of L & K is join-absorbing holds L is join-absorbing;

theorem 
  for K, L being non empty LattStr st the LattStr of K = the
  LattStr of L & K is meet-absorbing holds L is meet-absorbing;

theorem 
  for K, L being non empty LattStr st the LattStr of K = the LattStr of
  L & K is Lattice-like holds L is Lattice-like;

theorem 
  for L1,L2 being non empty \/-SemiLattStr st the \/-SemiLattStr of L1 =
the \/-SemiLattStr of L2 for a1,b1 being Element of L1, a2,b2 being Element of
  L2 st a1 = a2 & b1 = b2 holds a1 "\/" b1 = a2 "\/" b2;

theorem 
  for L1,L2 being non empty /\-SemiLattStr st the /\-SemiLattStr of L1 =
the /\-SemiLattStr of L2 for a1,b1 being Element of L1, a2,b2 being Element of
  L2 st a1 = a2 & b1 = b2 holds a1 "/\" b1 = a2 "/\" b2;

theorem 
  for K, L being non empty ComplStr, x being Element of K, y being
  Element of L st the Compl of K = the Compl of L & x = y holds x` = y`;

theorem 
  for K, L being non empty ComplLLattStr st the ComplLLattStr of K =
  the ComplLLattStr of L & K is with_Top holds L is with_Top;

theorem 
  for K, L being non empty OrthoLattStr st the OrthoLattStr of K =
  the OrthoLattStr of L & K is de_Morgan holds L is de_Morgan;

theorem 
  for K, L being non empty OrthoLattStr st the OrthoLattStr of K =
  the OrthoLattStr of L & K is involutive holds L is involutive;

begin 

definition
  let R be RelStr;
  mode RelAugmentation of R -> LattRelStr means

    the RelStr of it = the RelStr of R;
end;

definition
  let R be LattStr;
  mode LatAugmentation of R -> LattRelStr means


    the LattStr of it = the LattStr of R;
end;

registration
  let L be non empty LattStr;
  cluster -> non empty for LatAugmentation of L;
end;

registration
  let L be meet-associative non empty LattStr;
  cluster -> meet-associative for LatAugmentation of L;
end;

registration
  let L be join-associative non empty LattStr;
  cluster -> join-associative for LatAugmentation of L;
end;

registration
  let L be meet-commutative non empty LattStr;
  cluster -> meet-commutative for LatAugmentation of L;
end;

registration
  let L be join-commutative non empty LattStr;
  cluster -> join-commutative for LatAugmentation of L;
end;

registration
  let L be join-absorbing non empty LattStr;
  cluster -> join-absorbing for LatAugmentation of L;
end;

registration
  let L be meet-absorbing non empty LattStr;
  cluster -> meet-absorbing for LatAugmentation of L;
end;

definition
  let L be non empty \/-SemiLattRelStr;
  attr L is naturally_sup-generated means


  for x, y being Element of L holds x <= y iff x |_| y = y;
end;

definition
  let L be non empty /\-SemiLattRelStr;
  attr L is naturally_inf-generated means


  for x, y being Element of L holds x <= y iff x |^| y = x;
end;

registration
  let L be Lattice;
  cluster naturally_sup-generated naturally_inf-generated Lattice-like
    for LatAugmentation of L;
end;

registration
  cluster 1-element reflexive for LattRelStr;
end;

registration
  cluster 1-element reflexive for OrthoLattRelStr;
end;

registration
  cluster 1-element reflexive for OrthoRelStr;
end;

registration
  cluster -> involutive with_Top de_Morgan well-complemented
      for 1-element OrthoLattStr;
end;

registration
  cluster -> OrderInvolutive Pure PartialOrdered
   for 1-element reflexive OrthoRelStr;
end;

registration
  cluster  -> naturally_sup-generated naturally_inf-generated
   for 1-element reflexive LattRelStr;
end;

registration
  cluster with_infima with_suprema naturally_sup-generated
    naturally_inf-generated de_Morgan Lattice-like OrderInvolutive Pure
    PartialOrdered for non empty OrthoLattRelStr;
end;

registration
  cluster with_infima with_suprema naturally_sup-generated
    naturally_inf-generated Lattice-like for non empty LattRelStr;
end;

theorem 
  for L being naturally_sup-generated non empty LattRelStr, x, y
  being Element of L holds x <= y iff x [= y;

theorem 
  for L being naturally_sup-generated Lattice-like non empty
  LattRelStr holds the RelStr of L = LattPOSet L;

registration
  cluster naturally_sup-generated Lattice-like -> with_infima with_suprema for

    non empty LattRelStr;
end;

begin 

definition
  let R be OrthoLattStr;
  mode CLatAugmentation of R -> OrthoLattRelStr means


    the OrthoLattStr of it = the OrthoLattStr of R;
end;

registration
  let L be non empty OrthoLattStr;
  cluster -> non empty for CLatAugmentation of L;
end;

registration
  let L be meet-associative non empty OrthoLattStr;
  cluster -> meet-associative for CLatAugmentation of L;
end;

registration
  let L be join-associative non empty OrthoLattStr;
  cluster -> join-associative for CLatAugmentation of L;
end;

registration
  let L be meet-commutative non empty OrthoLattStr;
  cluster -> meet-commutative for CLatAugmentation of L;
end;

registration
  let L be join-commutative non empty OrthoLattStr;
  cluster -> join-commutative for CLatAugmentation of L;
end;

registration
  let L be meet-absorbing non empty OrthoLattStr;
  cluster -> meet-absorbing for CLatAugmentation of L;
end;

registration
  let L be join-absorbing non empty OrthoLattStr;
  cluster -> join-absorbing for CLatAugmentation of L;
end;

registration
  let L be with_Top non empty OrthoLattStr;
  cluster -> with_Top for CLatAugmentation of L;
end;

registration
  let L be non empty Ortholattice;
  cluster naturally_sup-generated naturally_inf-generated Lattice-like
    for CLatAugmentation of L;
end;

registration
  cluster involutive with_Top de_Morgan Lattice-like naturally_sup-generated
    well-complemented for non empty OrthoLattRelStr;
end;

theorem 
  for L being with_infima with_suprema PartialOrdered non empty
OrthoRelStr for x,y being Element of L holds x <= y implies y = x "|_|" y & x
  = x "|^|" y;

definition
  let L be meet-commutative non empty /\-SemiLattStr, a, b be Element of L;
  redefine func a |^| b;
  commutativity;
end;

definition
  let L be join-commutative non empty \/-SemiLattStr, a, b be Element of L;
  redefine func a |_| b;
  commutativity;
end;

registration
  cluster meet-absorbing join-absorbing meet-commutative
    naturally_sup-generated -> reflexive for non empty LattRelStr;
end;

registration
  cluster join-associative naturally_sup-generated -> transitive for non empty
    LattRelStr;
end;

registration
  cluster join-commutative naturally_sup-generated -> antisymmetric for
non empty
    LattRelStr;
end;

theorem 
  for L being with_infima with_suprema naturally_sup-generated
Lattice-like non empty OrthoLattRelStr, x, y being Element of L holds x "|_|"
  y = x |_| y;

theorem 
  for L being with_infima with_suprema naturally_sup-generated
Lattice-like non empty OrthoLattRelStr, x, y being Element of L holds x "|^|"
  y = x |^| y;

theorem 
  for L being with_infima with_suprema naturally_sup-generated
naturally_inf-generated Lattice-like OrderInvolutive PartialOrdered non empty
  OrthoLattRelStr holds L is de_Morgan;

registration
  let L be Ortholattice;
  cluster -> involutive for CLatAugmentation of L;
end;

registration
  let L be Ortholattice;
  cluster -> de_Morgan for CLatAugmentation of L;
end;

theorem 
  for L being non empty OrthoLattRelStr st L is involutive
  with_Top de_Morgan Lattice-like naturally_sup-generated holds L is
  Orthocomplemented PartialOrdered;

theorem 
  for L being Ortholattice, E being naturally_sup-generated
  CLatAugmentation of L holds E is Orthocomplemented;

registration
  let L be Ortholattice;
  cluster -> Orthocomplemented for
naturally_sup-generated CLatAugmentation of L;
end;

theorem 
  for L being non empty OrthoLattStr st L is Boolean
  well-complemented Lattice-like holds L is Ortholattice;

registration
  cluster Boolean well-complemented Lattice-like -> involutive with_Top
    de_Morgan for non empty OrthoLattStr;
end;














begin 



definition
  let T be non empty addMagma, p be Element of T, X be Subset of T;
  func X+p -> Subset of T equals

  {q + p where q is Element of T : q in X};
end;



definition
  let T be non empty addLoopStr, X be Subset of T;
  func X! -> Subset of T equals

  {-q where q is Point of T : q in X};
end;



definition
  let T be non empty addMagma, X,B be Subset of T;
  func X (-) B -> Subset of T equals

  {y where y is Point of T : B+y c= X};

end;



notation
  let T be non empty addLoopStr;
  let A, B be Subset of T;
  synonym A(+)B for A + B;
end;

reserve T for non empty Abelian
  add-associative right_zeroed right_complementable RLSStruct,
  X,Y,Z,B,C,B1,B2 for Subset of T,
  x,y,p for Point of T;

theorem 
  for T being add-associative right_zeroed right_complementable
    non empty RLSStruct,
       B being Subset of T holds
  (B!)! = B;

theorem 
  {0.T} + x = {x};

theorem 
  B1 c= B2 implies B1+p c= B2+p;

theorem 
  for X st X = {} holds X+x = {};

theorem 
  X (-) {0.T} = X;

theorem 
  X (+) {0.T} = X;

theorem 
  X (+) {x} = X+x;

theorem 
  for X,Y st Y = {} holds X (-) Y = the carrier of T;

theorem 
  X c= Y implies X (-) B c= Y (-) B & X (+) B c= Y (+) B;

theorem 
  B1 c= B2 implies X (-) B2 c= X (-) B1 & X (+) B1 c= X (+) B2;

theorem 
  0.T in B implies X (-) B c= X & X c= X (+) B;

theorem 
  X (+) Y = Y (+) X;

theorem 
  Y+y c= X+x iff Y+(y-x) c= X;

theorem 
  (X+p) (-) Y = (X (-) Y)+p;

theorem 
  (X+p) (+) Y = (X (+) Y)+p;

theorem 
  (X+x)+y = X+(x+y);

theorem 
  X (-) (Y+p) = (X (-) Y)+(-p);

theorem 
  X (+) (Y+p) = (X (+) Y)+p;

theorem 
  x in X implies B+x c= B (+) X;

theorem 
  X c= (X (+) B) (-) B;

theorem 
  X+0.T = X;

theorem 
  X (-) {x} = X+(-x);

theorem 
  X (-) (Y (+) Z) = (X (-) Y) (-) Z;

theorem 
  X (-) (Y (+) Z) = (X (-) Z) (-) Y;

theorem 
  X (+) (Y (-) Z) c= (X (+) Y) (-) Z;

theorem 
  X (+) (Y (+) Z) = (X (+) Y) (+) Z;

theorem 
  (B\/C)+y = (B+y) \/ (C+y);

theorem 
  (B/\C)+y = (B+y) /\ (C+y);

theorem 
  X (-) (B\/C) = (X (-) B)/\(X (-) C);

theorem 
  X (+) (B\/C) = (X (+) B)\/(X (+) C);

theorem 
  (X (-) B)\/(Y (-) B) c= (X\/Y) (-) B;

theorem 
  (X\/Y) (+) B = (X (+) B)\/(Y (+) B);

theorem 
  (X/\Y) (-) B = (X (-) B)/\(Y (-) B);

theorem 
  (X/\Y) (+) B c= (X (+) B)/\(Y (+) B);

theorem 
  B (+) (X/\Y) c= (B (+) X)/\(B (+) Y);

theorem 
  (B (-) X)\/(B (-) Y) c= B (-) (X/\Y);

theorem 
  (X` (-) B)` = X (+) B!;

theorem 
  (X (-) B)` = X` (+) B!;

begin




definition
  let T be non empty addLoopStr,X,B be Subset of T;
  func X (O) B -> Subset of T equals

  (X (-) B) (+) B;
end;



definition
  let T be non empty addLoopStr,X,B be Subset of T;
  func X (o) B -> Subset of T equals

  (X (+) B) (-) B;
end;

theorem 
  (X` (O) B!)` = X (o) B;

theorem 
  (X` (o) B!)` = X (O) B;

theorem 
  X (O) B c= X & X c= X (o) B;

theorem 
  X (O) X = X;

theorem 
  (X (O) B) (-) B c= X (-) B & (X (O) B) (+) B c= X (+) B;

theorem 
  X (-) B c= (X (o) B) (-) B & X (+) B c= (X (o) B) (+) B;

theorem 
  X c= Y implies X (O) B c= Y (O) B & X (o) B c= Y (o) B;

theorem 
  (X+p) (O) Y = (X (O) Y)+p;

theorem 
  (X+p) (o) Y = (X (o) Y)+p;

theorem 
  C c= B implies X (O) B c= (X (-) C) (+) B;

theorem 
  B c= C implies X (o) B c= (X (+) C) (-) B;

theorem 
  X (+) Y = (X (o) Y) (+) Y & X (-) Y = (X (O) Y) (-) Y;

theorem 
  X (+) Y = (X (+) Y) (O) Y & X (-) Y = (X (-) Y) (o) Y;

theorem 
  (X (O) B) (O) B = X (O) B;

theorem 
  (X (o) B) (o) B = X (o) B;

theorem 
  X (O) B c= (X \/ Y) (O) B;

theorem 
  B = B (O) B1 implies X (O) B c= X (O) B1;

begin



definition
  let t be real number, T be non empty RLSStruct,A be Subset of T;
  func t(.)A -> Subset of T equals

  {t*a where a is Point of T : a in A};
end;

reserve t,s,r1 for real number;

theorem 
  for X being Subset of T st X = {} holds 0(.)X = {};

reserve n for Element of NAT;
reserve X,Y,B1,B2 for Subset of TOP-REAL n;
reserve x,y for Point of TOP-REAL n;

theorem 
  for X being non empty Subset of TOP-REAL n holds 0(.)X = {0.TOP-REAL n};

theorem 
  1(.)X = X;

theorem 
  2(.)X c= X (+) X;

theorem 
  (t*s)(.)X = t(.)(s(.)X);

theorem 
  X c= Y implies t(.)X c= t(.)Y;

theorem 
  t(.)(X+x) = t(.)X+t*x;

theorem 
  t(.)(X (+) Y) = t(.)X (+) t(.)Y;

theorem 
  t<>0 implies t(.)(X (-) Y) = t(.)X (-) t(.)Y;

theorem 
  t<>0 implies t(.)(X (O) Y) = t(.)X (O) t(.)Y;

theorem 
  t<>0 implies t(.)(X (o) Y) = t(.)X (o) t(.)Y;

begin 



definition
  let T be non empty RLSStruct,X,B1,B2 be Subset of T;
  func X (*) (B1,B2) -> Subset of T equals

  (X (-) B1) /\ (X` (-) B2);
end;



definition
  let T be non empty RLSStruct,X,B1,B2 be Subset of T;
  func X (&) (B1,B2) -> Subset of T equals

  X \/ (X (*) (B1,B2));
end;



definition
  let T be non empty RLSStruct,X,B1,B2 be Subset of T;
  func X (@) (B1,B2) -> Subset of T equals

  X \ (X (*) (B1,B2));
end;

theorem 
  B1 = {} implies X (*) (B1,B2) = X` (-) B2;

theorem 
  B2 = {} implies X (*) (B1,B2) = X (-) B1;

theorem 
  0.TOP-REAL n in B1 implies X (*) (B1,B2) c= X;

theorem 
  0.TOP-REAL n in B2 implies (X (*) (B1,B2)) /\ X = {};

theorem 
  0.TOP-REAL n in B1 implies X (&) (B1,B2) = X;

theorem 
  0.TOP-REAL n in B2 implies X (@) (B1,B2) = X;

theorem 
  X (@) (B2,B1) = (X` (&) (B1,B2))`;

begin 


theorem 
  for V being RealLinearSpace, B being Subset of V holds
  B is convex iff
  for x,y be Point of V,r be real number st 0 <= r & r <= 1 & x in B &
  y in B holds r*x + (1-r)*y in B;

definition
  let V be RealLinearSpace, B be Subset of V;
  redefine attr B is convex means


  for x,y be Point of V,r be real number st
  0 <= r & r <= 1 & x in B & y in B holds r*x + (1-r)*y in B;
end;

reserve n for Element of NAT;
reserve X,B for Subset of TOP-REAL n;

theorem 
  X is convex implies X! is convex;

theorem 
  X is convex & B is convex implies X (+) B is convex & X (-) B is convex;

theorem 
  X is convex & B is convex implies X (O) B is convex & X (o) B is convex;

theorem 
  B is convex & 0 < t & 0 < s implies (s+t)(.)B = s(.)B (+) t(.)B;














begin

reserve n for Element of NAT;

theorem 
  for f be FinSequence of TOP-REAL 2 for p be Point of TOP-REAL 2
  st p in L~f holds len L_Cut(f,p) >= 1;

theorem 
  for f be non empty FinSequence of TOP-REAL 2 for p be Point of
  TOP-REAL 2 holds len R_Cut(f,p) >= 1;

theorem 
  for f be FinSequence of TOP-REAL 2 for p,q be Point of TOP-REAL 2
  holds B_Cut (f,p,q) <> {};

registration
  let x be set;
  cluster <*x*> -> one-to-one;
end;

definition
  let f be FinSequence;
  attr f is almost-one-to-one means


  for i,j be Element of NAT st i in
dom f & j in dom f & (i <> 1 or j <> len f) & (i <> len f or j <> 1) & f.i = f.
  j holds i = j;
end;

definition
  let f be FinSequence;
  attr f is weakly-one-to-one means


  for i be Element of NAT st 1 <= i & i < len f holds f.i <> f.(i+1);
end;

definition
  let f be FinSequence;
  attr f is poorly-one-to-one means


  for i be Element of NAT st 1 <= i &
  i < len f holds f.i <> f.(i+1) if len f <> 2 otherwise not contradiction;
end;

theorem 
  for D be set for f be FinSequence of D holds f is almost-one-to-one
iff for i,j be Element of NAT st i in dom f & j in dom f & (i <> 1 or j <> len
  f) & (i <> len f or j <> 1) & f/.i = f/.j holds i = j;

theorem 
  for D be set for f be FinSequence of D holds f is
weakly-one-to-one iff for i be Element of NAT st 1 <= i & i < len f holds f/.i
  <> f/.(i+1);

theorem 
  for D be set for f be FinSequence of D holds f is poorly-one-to-one
iff (len f <> 2 implies for i be Element of NAT st 1 <= i & i < len f holds f/.
  i <> f/.(i+1));

registration
  cluster one-to-one -> almost-one-to-one for FinSequence;
end;

registration
  cluster almost-one-to-one -> poorly-one-to-one for FinSequence;
end;

theorem 
  for f be FinSequence st len f <> 2 holds f is weakly-one-to-one
  iff f is poorly-one-to-one;

registration
  cluster empty -> weakly-one-to-one for FinSequence;
end;

registration
  let x be set;
  cluster <*x*> -> weakly-one-to-one;
end;

registration
  let x,y be set;
  cluster <*x,y*> -> poorly-one-to-one;
end;

registration
  cluster weakly-one-to-one non empty for FinSequence;
end;

registration
  let D be non empty set;
  cluster weakly-one-to-one circular non empty for FinSequence of D;
end;

theorem 
  for f be FinSequence st f is almost-one-to-one holds Rev f is
  almost-one-to-one;

theorem 
  for f be FinSequence st f is weakly-one-to-one holds Rev f is
  weakly-one-to-one;

theorem 
  for f be FinSequence st f is poorly-one-to-one holds Rev f is
  poorly-one-to-one;

registration
  cluster one-to-one non empty for FinSequence;
end;

registration
  let f be almost-one-to-one FinSequence;
  cluster Rev f -> almost-one-to-one;
end;

registration
  let f be weakly-one-to-one FinSequence;
  cluster Rev f -> weakly-one-to-one;
end;

registration
  let f be poorly-one-to-one FinSequence;
  cluster Rev f -> poorly-one-to-one;
end;

theorem 
  for D be non empty set for f be FinSequence of D st f is
almost-one-to-one for p be Element of D holds Rotate(f,p) is almost-one-to-one;

theorem 
  for D be non empty set for f be FinSequence of D st f is
  weakly-one-to-one circular for p be Element of D holds Rotate(f,p) is
  weakly-one-to-one;

theorem 
  for D be non empty set for f be FinSequence of D st f is
  poorly-one-to-one circular for p be Element of D holds Rotate(f,p) is
  poorly-one-to-one;

registration
  let D be non empty set;
  cluster one-to-one circular non empty for FinSequence of D;
end;

registration
  let D be non empty set;
  let f be almost-one-to-one FinSequence of D;
  let p be Element of D;
  cluster Rotate(f,p) -> almost-one-to-one;
end;

registration
  let D be non empty set;
  let f be circular weakly-one-to-one FinSequence of D;
  let p be Element of D;
  cluster Rotate(f,p) -> weakly-one-to-one;
end;

registration
  let D be non empty set;
  let f be circular poorly-one-to-one FinSequence of D;
  let p be Element of D;
  cluster Rotate(f,p) -> poorly-one-to-one;
end;

theorem 
  for D be non empty set for f be FinSequence of D holds f is
  almost-one-to-one iff f/^1 is one-to-one & f|(len f-'1) is one-to-one;

registration
  let C be compact non vertical non horizontal Subset of TOP-REAL 2;
  let n be Element of NAT;
  cluster Cage(C,n) -> almost-one-to-one;
end;

registration
  let C be compact non vertical non horizontal Subset of TOP-REAL 2;
  let n be Element of NAT;
  cluster Cage(C,n) -> weakly-one-to-one;
end;

theorem 
  for f be FinSequence of TOP-REAL 2 for p be Point of TOP-REAL 2
  st p in L~f & f is weakly-one-to-one holds B_Cut(f,p,p) = <*p*>;

theorem 
  for f being FinSequence st f is one-to-one holds f is weakly-one-to-one;

registration
  cluster one-to-one -> weakly-one-to-one for FinSequence;
end;

theorem 
  for f be FinSequence of TOP-REAL 2 st f is weakly-one-to-one for
  p,q be Point of TOP-REAL 2 st p in L~f & q in L~f holds B_Cut(f,p,q) = Rev
  B_Cut(f,q,p);

theorem 
  for f be FinSequence of TOP-REAL 2 for p be Point of TOP-REAL 2
for i1 be Element of NAT st f is poorly-one-to-one unfolded s.n.c. & 1<i1 & i1
  <=len f & p=f.i1 holds Index(p,f) + 1 = i1;

theorem 
  for f be FinSequence of TOP-REAL 2 st f is weakly-one-to-one for
  p,q be Point of TOP-REAL 2 st p in L~f & q in L~f holds B_Cut(f,p,q)/.1 = p;

theorem 
  for f be FinSequence of TOP-REAL 2 st f is weakly-one-to-one for
p,q be Point of TOP-REAL 2 st p in L~f & q in L~f holds B_Cut(f,p,q)/.len B_Cut
  (f,p,q) = q;

theorem 
  for f be FinSequence of TOP-REAL 2 for p be Point of TOP-REAL 2 st p
  in L~f holds L~L_Cut(f,p) c= L~f;

theorem 
  for f be FinSequence of TOP-REAL 2 for p,q be Point of TOP-REAL 2 st p
  in L~f & q in L~f & f is weakly-one-to-one holds L~B_Cut(f,p,q) c= L~f;

theorem 
  for f,g be FinSequence holds dom f c= dom (f^'g);

theorem 
  for f be non empty FinSequence for g be FinSequence holds dom g c= dom (f^'g)
;

theorem 
  for f,g be FinSequence st f^'g is constant holds f is constant;

theorem 
  for f,g be FinSequence st f^'g is constant & f.len f = g.1 & f <> {}
  holds g is constant;

theorem 
  for f be special FinSequence of TOP-REAL 2 for i,j be Element of
  NAT holds mid(f,i,j) is special;

theorem 
  for f be unfolded FinSequence of TOP-REAL 2 for i,j be Element
  of NAT holds mid(f,i,j) is unfolded;

theorem 
  for f be FinSequence of TOP-REAL 2 st f is special for p be
  Point of TOP-REAL 2 st p in L~f holds L_Cut(f,p) is special;

theorem 
  for f be FinSequence of TOP-REAL 2 st f is special for p be
  Point of TOP-REAL 2 st p in L~f holds R_Cut(f,p) is special;

theorem 
  for f be FinSequence of TOP-REAL 2 st f is special weakly-one-to-one
  for p,q be Point of TOP-REAL 2 st p in L~f & q in L~f holds B_Cut(f,p,q) is
  special;

theorem 
  for f be FinSequence of TOP-REAL 2 st f is unfolded for p be
  Point of TOP-REAL 2 st p in L~f holds L_Cut(f,p) is unfolded;

theorem 
  for f be FinSequence of TOP-REAL 2 st f is unfolded for p be
  Point of TOP-REAL 2 st p in L~f holds R_Cut(f,p) is unfolded;

theorem 
  for f be FinSequence of TOP-REAL 2 st f is unfolded weakly-one-to-one
  for p,q be Point of TOP-REAL 2 st p in L~f & q in L~f holds B_Cut(f,p,q) is
  unfolded;

theorem 
  for f,g be FinSequence of TOP-REAL 2 for p be Point of TOP-REAL
2 st f is almost-one-to-one special unfolded s.n.c. & p in L~f & p<>f.1 & g=mid
  (f,1,Index(p,f))^<*p*> holds g is_S-Seq_joining f/.1,p;

theorem 
  for f be FinSequence of TOP-REAL 2 for p be Point of TOP-REAL 2
st f is poorly-one-to-one unfolded s.n.c. & p in L~f & p = f.(Index(p,f)+1) & p
  <> f.len f holds Index(p,Rev f) + Index(p,f) + 1 = len f;

theorem 
  for f be non empty FinSequence of TOP-REAL 2 for p be Point of
  TOP-REAL 2 st f is weakly-one-to-one & len f >= 2 holds L_Cut (f,f/.1) = f;

theorem 
  for f be non empty FinSequence of TOP-REAL 2 for p be Point of
TOP-REAL 2 st f is poorly-one-to-one unfolded s.n.c. & p in L~f & p <> f.len f
  holds L_Cut(Rev f,p) = Rev R_Cut(f,p);

theorem 
  for f be FinSequence of TOP-REAL 2 for p be Point of TOP-REAL 2
  st f is almost-one-to-one special unfolded s.n.c. & p in L~f & p<>f.1 holds
  R_Cut(f,p) is_S-Seq_joining f/.1,p;

theorem 
  for f be non empty FinSequence of TOP-REAL 2 for p be Point of
TOP-REAL 2 st f is almost-one-to-one special unfolded s.n.c. & p in L~f & p<>f.
  len f & p <> f.1 holds L_Cut(f,p) is_S-Seq_joining p,f/.len f;

theorem 
  for f be FinSequence of TOP-REAL 2 for p be Point of TOP-REAL 2 st f
is almost-one-to-one special unfolded s.n.c. & p in L~f & p<>f.1 holds R_Cut(f,
  p) is being_S-Seq;

theorem 
  for f be non empty FinSequence of TOP-REAL 2 for p be Point of
TOP-REAL 2 st f is almost-one-to-one special unfolded s.n.c. & p in L~f & p <>
  f.len f & p <> f.1 holds L_Cut(f,p) is being_S-Seq;

theorem 
  for f be non empty FinSequence of TOP-REAL 2 for p,q be Point of
  TOP-REAL 2 st f is almost-one-to-one special unfolded s.n.c. & len f <> 2 & p
  in L~f & q in L~f & p<>q & p <> f.1 & q <> f.1 holds B_Cut(f,p,q)
  is_S-Seq_joining p,q;

theorem 
  for f be non empty FinSequence of TOP-REAL 2 for p,q be Point of
  TOP-REAL 2 st f is almost-one-to-one special unfolded s.n.c. & len f <> 2 & p
  in L~f & q in L~f & p<>q & p <> f.1 & q <> f.1 holds B_Cut(f,p,q) is
  being_S-Seq;

theorem 
  for C be compact non vertical non horizontal Subset of TOP-REAL 2 for
p,q be Point of TOP-REAL 2 st p in BDD L~Cage(C,n) ex B be S-Sequence_in_R2 st
B = B_Cut(Rotate(Cage(C,n),Cage(C,n)/.Index(South-Bound(p,L~Cage(C,n)), Cage(C,
n)))|(len Rotate(Cage(C,n),Cage(C,n)/. Index(South-Bound(p,L~Cage(C,n)), Cage(C
  ,n)))-'1),South-Bound(p,L~Cage(C,n)),North-Bound(p,L~Cage(C,n))) & ex P be
  S-Sequence_in_R2 st P is_sequence_on GoB(B^'<*North-Bound(p,L~Cage(C,n)),
South-Bound(p,L~Cage(C,n))*>) & L~<*North-Bound(p,L~Cage(C,n)),South-Bound(p,L~
Cage(C,n))*> = L~P & P/.1 = North-Bound(p,L~Cage(C,n)) & P/.len P = South-Bound
  (p,L~Cage(C,n)) & len P >= 2 & ex B1 be S-Sequence_in_R2 st B1 is_sequence_on
GoB(B^'<*North-Bound(p,L~Cage(C,n)),South-Bound(p,L~Cage(C,n))*>) & L~B = L~B1
& B/.1 = B1/.1 & B/.len B = B1/.len B1 & len B <= len B1 & ex g be non constant
  standard special_circular_sequence st g = B1^'P;














begin 

reserve T for TopSpace,
  A, B for Subset of T;

registration
  let D be non trivial set;
  cluster ADTS D -> non trivial;
end;

registration
  cluster anti-discrete non trivial strict for TopSpace;
end;

theorem 
  Int Cl Int A /\ Int Cl Int B = Int Cl Int (A /\ B);

theorem 
  Cl Int Cl (A \/ B) = Cl Int Cl A \/ Cl Int Cl B;

begin 

definition
  let T be TopStruct, A be Subset of T;
  attr A is supercondensed means


  Int Cl A = Int A;
  attr A is subcondensed means


  Cl Int A = Cl A;
end;

registration
  let T;
  cluster closed -> supercondensed for Subset of T;
end;

theorem 
  A is closed implies A is supercondensed;

theorem 
  A is open implies A is subcondensed;

definition
  let T be TopSpace, A be Subset of T;
  redefine attr A is condensed means


  Cl Int A = Cl A & Int Cl A = Int A;
end;

theorem 
  A is condensed iff A is subcondensed & A is supercondensed;

registration
  let T be TopSpace;
  cluster condensed -> subcondensed supercondensed for Subset of T;
  cluster subcondensed supercondensed -> condensed for Subset of T;
end;

registration
  let T be TopSpace;
  cluster condensed subcondensed supercondensed for Subset of T;
end;

theorem 
  A is supercondensed implies A` is subcondensed;

theorem 
  A is subcondensed implies A` is supercondensed;




theorem 
  A is supercondensed iff Int Cl A c= A;

theorem 
  A is subcondensed iff A c= Cl Int A;

registration
  let T be TopSpace;
  cluster subcondensed -> semi-open for Subset of T;
  cluster semi-open -> subcondensed for Subset of T;
end;

theorem 
  A is condensed iff Int Cl A c= A & A c= Cl Int A;

begin 

notation
  let T be TopStruct, A be Subset of T;
  synonym A is regular_open for A is open_condensed;
end;

notation
  let T be TopStruct, A be Subset of T;
  synonym A is regular_closed for A is closed_condensed;
end;

theorem 
  for T being TopSpace holds [#]T is regular_open & [#]T is regular_closed;

registration
  let T be TopSpace;
  cluster [#]T -> regular_open regular_closed;
end;

registration
  let T be TopSpace;
  cluster empty -> regular_open regular_closed for Subset of T;
end;

theorem 
  Int Cl {}T = {}T;

theorem 
  A is regular_open implies A` is regular_closed;

registration
  let T be TopSpace;
  cluster regular_open regular_closed for Subset of T;
end;

registration
  let T be TopSpace;
  let A be regular_open Subset of T;
  cluster A` -> regular_closed;
end;

theorem 
  A is regular_closed implies A` is regular_open;

registration
  let T be TopSpace;
  let A be regular_closed Subset of T;
  cluster A` -> regular_open;
end;

registration
  let T be TopSpace;
  cluster regular_open -> open for Subset of T;
  cluster regular_closed -> closed for Subset of T;
end;






theorem 
  Int Cl A is regular_open & Cl Int A is regular_closed;

registration
  let T be TopSpace, A be Subset of T;
  cluster Int Cl A -> regular_open;
  cluster Cl Int A -> regular_closed;
end;

theorem 
  A is regular_open iff A is supercondensed & A is open;

theorem 
  A is regular_closed iff A is subcondensed & A is closed;

registration
  let T be TopSpace;
  cluster regular_open -> condensed open for Subset of T;
  cluster condensed open -> regular_open for Subset of T;
  cluster regular_closed -> condensed closed for Subset of T;
  cluster condensed closed -> regular_closed for Subset of T;
end;

theorem 
  A is condensed iff ex B st B is regular_open & B c= A & A c= Cl B;

theorem 
  A is condensed iff ex B st B is regular_closed & Int B c= A & A c= B;

begin 

definition
  let T be TopStruct, A be Subset of T;
  redefine func Fr A equals

  Cl A \ Int A;
end;

theorem 
  A is condensed iff Fr A = Cl Int A \ Int Cl A & Fr A = Cl Int A /\ Cl Int A`;

definition
  let T be TopStruct, A be Subset of T;
  func Border A -> Subset of T equals

  Int Fr A;
end;

theorem 
  Border A is regular_open & Border A = (Int Cl A) \ (Cl Int A) &
  Border A = Int Cl A /\ (Int Cl A`);

registration
  let T be TopSpace, A be Subset of T;
  cluster Border A -> regular_open;
end;

theorem 
  A is supercondensed iff Int A is regular_open & Border A is empty;

theorem 
  A is subcondensed iff Cl A is regular_closed & Border A is empty;

registration
  let T be TopSpace, A be Subset of T;
  cluster Border Border A -> empty;
end;

theorem 
  A is condensed iff Int A is regular_open & Cl A is regular_closed &
  Border A is empty;

begin 

theorem 
  for A being Subset of R^1, a being real number st A = ]. -infty, a.]
  holds Int A = ]. -infty, a.[;

theorem 
  for A being Subset of R^1, a being real number st A = [.a,+infty .[
  holds Int A = ].a,+infty .[;

theorem 
  for A being Subset of R^1, a, b being real number st A = ].
  -infty,a.] \/ IRRAT (a,b) \/ [.b,+infty .[ holds Cl A = the carrier of R^1;

theorem 
  for A being Subset of R^1, a, b being real number st A = RAT (a,b)
  holds Int A = {};

theorem 
  for A being Subset of R^1, a, b being real number st A = IRRAT (a,b)
  holds Int A = {};

theorem 
  for a,b being real number st a >= b holds IRRAT (a,b) = {};

theorem 
  for a,b being real number holds IRRAT (a,b) c= [.a,+infty .[;

theorem 
  for A being Subset of R^1, a, b, c being real number st A = ].
  -infty, a .[ \/ RAT (b,c) & a < b & b < c holds Int A = ]. -infty, a .[;

theorem 
  for a,b being real number st a < b holds REAL = ]. -infty,a.[ \/ [.a,b
  .] \/ ].b,+infty .[;

theorem 
  for A being Subset of R^1, a, b, c being real number st A = ].
-infty, a .] \/ [.b,c.] & a < b & b < c holds Int A = ]. -infty, a .[ \/ ].b,c
  .[;

begin 

notation
  let A, B be set;
  antonym A, B are_c=-incomparable for A, B are_c=-comparable;
end;

theorem 
  for A, B being set holds A, B are_c=-incomparable or A c= B or B c< A;

definition
  let T, A;
  attr A is 1st_class means


  Int Cl A c= Cl Int A;
  attr A is 2nd_class means


  Cl Int A c< Int Cl A;
  attr A is 3rd_class means


  Cl Int A, Int Cl A are_c=-incomparable;
end;

theorem 
  A is 1st_class or A is 2nd_class or A is 3rd_class;

registration
  let T be TopSpace;
  cluster 1st_class -> non 2nd_class non 3rd_class for Subset of T;
  cluster 2nd_class -> non 1st_class non 3rd_class for Subset of T;
  cluster 3rd_class -> non 1st_class non 2nd_class for Subset of T;
end;

theorem 
  A is 1st_class iff Border A is empty;

registration
  let T be TopSpace;
  cluster supercondensed -> 1st_class for Subset of T;
  cluster subcondensed -> 1st_class for Subset of T;
end;

definition
  let T be TopSpace;
  attr T is with_1st_class_subsets means


  ex A being Subset of T st A is 1st_class;
  attr T is with_2nd_class_subsets means


  ex A being Subset of T st A is 2nd_class;
  attr T is with_3rd_class_subsets means


  ex A being Subset of T st A is 3rd_class;
end;

registration
  let T be anti-discrete non empty TopSpace;
  cluster proper non empty -> 2nd_class for Subset of T;
end;

registration
  let T be anti-discrete non trivial strict TopSpace;
  cluster 2nd_class for Subset of T;
end;

registration
  cluster with_1st_class_subsets with_2nd_class_subsets
      strict non trivial for TopSpace;
  cluster with_3rd_class_subsets non empty strict for TopSpace;
end;

registration
  let T;
  cluster 1st_class for Subset of T;
end;

registration
  let T be with_2nd_class_subsets TopSpace;
  cluster 2nd_class for Subset of T;
end;

registration
  let T be with_3rd_class_subsets TopSpace;
  cluster 3rd_class for Subset of T;
end;

theorem 
  A is 1st_class iff A` is 1st_class;

theorem 
  A is 2nd_class iff A` is 2nd_class;

theorem 
  A is 3rd_class iff A` is 3rd_class;

registration
  let T;
  let A be 1st_class Subset of T;
  cluster A` -> 1st_class;
end;

registration
  let T be with_2nd_class_subsets TopSpace;
  let A be 2nd_class Subset of T;
  cluster A` -> 2nd_class;
end;

registration
  let T be with_3rd_class_subsets TopSpace;
  let A be 3rd_class Subset of T;
  cluster A` -> 3rd_class;
end;

theorem 
  A is 1st_class implies Int Cl A = Int Cl Int A & Cl Int A = Cl Int Cl A;

theorem 
  (Int Cl A = Int Cl Int A or Cl Int A = Cl Int Cl A) implies A is 1st_class;

theorem 
  A is 1st_class & B is 1st_class implies Int Cl A /\ Int Cl B =
  Int Cl (A /\ B) & Cl Int A \/ Cl Int B = Cl Int (A \/ B);

theorem 
  A is 1st_class & B is 1st_class implies A \/ B is 1st_class & A /\ B
  is 1st_class;
 


















begin

reserve a,a1,a2,a3,b,b1,b2,b3,r,s,t,u for Real;
reserve n for Element of NAT;
reserve x0,x,x1,x2,x3,y0,y,y1,y2,y3 for Element of REAL n;



theorem 
  (s/t)*(u*x)=(s*u)/t*x & (1/t)*(u*x)= u/t*x;

theorem 
  x - x = 0*n & x + -x = 0*n;

theorem 
  -a*x = (-a)*x & -a*x = a*(-x);

theorem 
  x1 - (x2 - x3) = x1 - x2 + x3;

theorem 
  x1 + (x2 - x3) = x1 + x2 - x3;

theorem 
  x1 = x2 + x3 iff x2 = x1 - x3;

theorem 
  x=x1+x2+x3 iff x-x1=x2+x3;

theorem 
  -(x1 + x2 + x3) = -x1 + -x2 + -x3;

theorem 
  x1=x2 iff x1-x2=0*n;

theorem 
  x1 - x0 = t*x & x1 <> x0 implies t <> 0;

theorem 
  (a - b)*x = a*x + (-b)*x & (a - b)*x = a*x + -b*x & (a - b)*x = a*x - b*x;

theorem 
  a*(x - y) = a*x + -a*y & a*(x - y) = a*x + (-a)*y & a*(x - y) = a*x - a*y;

theorem 
  (s - t - u)*x = s*x - t*x - u*x;

theorem 
  x - (a1*x1+a2*x2+a3*x3) = x + ((-a1)*x1 + (-a2)*x2 + (-a3)*x3);

theorem 
  x - (s+t+u)*y = x + (-s)*y + (-t)*y + (-u)*y;

theorem 
  (x1+x2)+(y1+y2)=(x1+y1)+(x2+y2);

theorem 
  (x1+x2+x3)+(y1+y2+y3)=(x1+y1)+(x2+y2)+(x3+y3);

theorem 
  (x1+x2)-(y1+y2)=(x1-y1)+(x2-y2);

theorem 
  (x1+x2+x3)-(y1+y2+y3)=(x1-y1)+(x2-y2)+(x3-y3);

theorem 
  a*(x1+x2+x3)=a*x1+a*x2+a*x3;

theorem 
  a*(b1*x1+b2*x2) = (a*b1)*x1+(a*b2)*x2;

theorem 
  a*(b1*x1+b2*x2+b3*x3) = (a*b1)*x1+(a*b2)*x2+(a*b3)*x3;

theorem 
  (a1*x1+a2*x2)+(b1*x1+b2*x2)=(a1+b1)*x1+(a2+b2)*x2;

theorem 
  (a1*x1+a2*x2+a3*x3)+(b1*x1+b2*x2+b3*x3)=(a1+b1)*x1+(a2+b2)*x2+( a3+b3)*x3;

theorem 
  (a1*x1+a2*x2)-(b1*x1+b2*x2)=(a1-b1)*x1+(a2-b2)*x2;

theorem 
  (a1*x1+a2*x2+a3*x3)-(b1*x1+b2*x2+b3*x3)=(a1-b1)*x1+(a2-b2)*x2+( a3-b3)*x3;

theorem 
  a1+a2+a3=1 implies a1*x1+a2*x2+a3*x3=x1+a2*(x2-x1)+a3*(x3-x1);

theorem 
  x=x1+a2*(x2-x1)+a3*(x3-x1) implies ex a1 be Real st x=a1*x1+a2*
  x2+a3*x3 & a1+a2+a3=1;

theorem 
  for n being Element of NAT st n >= 1 holds 1*n <> 0*n;



theorem 
  for A be Subset of REAL n,x1,x2 holds A is being_line & x1 in A
  & x2 in A & x1<>x2 implies A=Line(x1,x2);

theorem 
  for x1, x2 being Element of REAL n holds y1 in Line(x1,x2) & y2
  in Line(x1,x2) implies ex a st y2 - y1 =a*(x2 - x1);

definition
  let n;
  let x1,x2 be Element of REAL n;
  pred x1 // x2 means


  x1 <> 0*n & x2 <> 0*n & ex r st x1 = r*x2;
end;

theorem 
  for x1,x2 be Element of REAL n st x1 // x2 holds ex a st a <> 0 & x1 = a*x2;

definition
  let n;
  let x1,x2 be Element of REAL n;
  redefine pred x1 // x2;
  symmetry;
end;

theorem 
  x1 // x2 & x2 // x3 implies x1 // x3;

definition
  let n be Element of NAT,x1,x2 be Element of REAL n;
  pred x1,x2 are_lindependent2 means


  for a1,a2 being Real st a1*x1+a2* x2=0*n holds a1=0 & a2=0;
  symmetry;
end;

notation
  let n;
  let x1,x2 be Element of REAL n;
  antonym x1,x2 are_ldependent2 for x1,x2 are_lindependent2;
end;

theorem 
  x1,x2 are_lindependent2 implies x1<>0*n & x2<>0*n;

theorem 
  for x1,x2 st x1,x2 are_lindependent2 holds a1*x1+a2*x2=b1*x1+b2*
  x2 implies a1=b1 & a2=b2;

theorem 
  for x1,x2,y1,y1 st y1,y2 are_lindependent2 holds y1 = a1*x1+a2*
x2 & y2=b1*x1+b2*x2 implies ex c1,c2,d1,d2 be Real st x1=c1*y1+c2*y2 & x2=d1*y1
  +d2*y2;

theorem 
  x1,x2 are_lindependent2 implies x1 <> x2;

theorem 
  x2 - x1,x3 - x1 are_lindependent2 implies x2 <> x3;

theorem 
  x1,x2 are_lindependent2 implies x1+t*x2,x2 are_lindependent2;

theorem 
  x1 - x0, x3 - x2 are_lindependent2 & y0 in Line(x0,x1) & y1 in
  Line(x0,x1) & y0 <> y1 & y2 in Line(x2,x3) & y3 in Line(x2,x3) & y2 <> y3
  implies y1 - y0, y3 - y2 are_lindependent2;

theorem 
  x1 // x2 implies x1,x2 are_ldependent2 & x1 <> 0*n & x2 <> 0*n;

theorem 
  x1, x2 are_ldependent2 implies x1 = 0*n or x2 = 0*n or x1 // x2;

theorem 
  for x1,x2,y1 being Element of REAL n ex y2 being Element of REAL
  n st y2 in Line(x1,x2) & x1-x2,y1-y2 are_orthogonal;

definition
  let n;
  let x1,x2 be Element of REAL n;
  pred x1 _|_ x2 means


  x1 <> 0*n & x2 <> 0*n & x1, x2 are_orthogonal;
  symmetry;
end;

theorem 
  x _|_ y0 & y0 // y1 implies x _|_ y1;

theorem 
  x _|_ y implies x, y are_lindependent2;

theorem 
  x1 // x2 implies not x1 _|_ x2;

definition
  let n;
  func line_of_REAL n -> Subset-Family of REAL n equals

  {Line(x1,x2) where x1,x2 is Element of REAL n: not contradiction};
end;

registration
  let n;
  cluster line_of_REAL n -> non empty;
end;

theorem 
  Line(x1,x2) in line_of_REAL n;

reserve L,L0,L1,L2 for Element of line_of_REAL n;

theorem 
  x1 in L & x2 in L implies Line(x1,x2) c= L;

theorem 
  L1 meets L2 iff ex x st x in L1 & x in L2;

theorem 
  L0 misses L1 & x in L0 implies not x in L1;

theorem 
  ex x1,x2 st L = Line(x1,x2);

theorem 
  ex x st x in L;

theorem 
  L is being_line implies ex x1 st x1 <> x0 & x1 in L;

theorem 
  (not x in L) & L is being_line implies ex x1,x2 st L = Line(x1,
  x2) & x - x1 _|_ x2 - x1;

theorem 
  (not x in L) & L is being_line implies ex x1,x2 st L = Line(x1,
  x2) & x - x1,x2 - x1 are_lindependent2;

definition
  let n be Element of NAT,x be Element of REAL n, L be Element of line_of_REAL
  n;
  func dist_v(x,L) -> Subset of REAL equals

  {|.x-x0.| where x0 is Element of
  REAL n : x0 in L};
end;

definition
  let n be Element of NAT,x be Element of REAL n, L be Element of line_of_REAL
  n;
  func dist(x,L) -> Real equals

  lower_bound dist_v(x,L);
end;

theorem 
  L = Line(x1,x2) implies {|.x-x0.| where x0 is Element of REAL n : x0
  in Line(x1,x2)} = dist_v(x,L);

theorem 
  ex x0 st x0 in L & |.x-x0.|=dist(x,L);

theorem 
  dist(x,L) >= 0;

theorem 
  x in L iff dist(x,L) = 0;

definition
  let n;
  let L1,L2;
  pred L1 // L2 means


  ex x1, x2, y1, y2 being Element of REAL n st L1 =
  Line(x1,x2) & L2 = Line(y1,y2) & (x2 - x1) // (y2 - y1);
  symmetry;
end;

theorem 
  L0 // L1 & L1 // L2 implies L0 // L2;

definition
  let n;
  let L1,L2;
  pred L1 _|_ L2 means


  ex x1, x2, y1, y2 being Element of REAL n st L1
  = Line(x1,x2) & L2 = Line(y1,y2) & (x2 - x1) _|_ (y2 - y1);
  symmetry;
end;

theorem 
  L0 _|_ L1 & L1 // L2 implies L0 _|_ L2;

theorem 
  (not x in L) & L is being_line implies ex L0 st x in L0 & L0 _|_
  L & L0 meets L;

theorem 
  L1 misses L2 implies ex x st x in L1 & not x in L2;

theorem 
  x1 in L & x2 in L & x1 <> x2 implies Line(x1,x2) = L & L is being_line;

theorem 
  L1 is being_line & L1 = L2 implies L1 // L2;

theorem 
  L1 // L2 implies L1 is being_line & L2 is being_line;

theorem 
  L1 _|_ L2 implies L1 is being_line & L2 is being_line;

theorem 
  x in L & a<>1 & a*x in L implies 0*n in L;

theorem 
  x1 in L & x2 in L implies ex x3 st x3 in L & x3 - x1 = a*(x2 - x1);

theorem 
  x1 in L & x2 in L & x3 in L & x1 <> x2 implies ex a st x3 - x1 = a*(x2 - x1);

theorem 
  L1 // L2 & L1<>L2 implies L1 misses L2;

theorem 
  L is being_line implies ex L0 st x in L0 & L0 // L;

theorem 
  for x,L st (not x in L) & L is being_line holds ex L0 st x in L0 & L0
  // L & L0 <> L;

theorem 
  for x0,x1,y0,y1,L1,L2 st x0 in L1 & x1 in L1 & x0 <> x1 & y0 in
  L2 & y1 in L2 & y0 <> y1 & L1 _|_ L2 holds x1 - x0 _|_ y1 - y0;

theorem 
  for L1,L2 st L1 _|_ L2 holds L1 <> L2;

theorem 
  for x1,x2,L st L is being_line & L = Line(x1,x2) holds x1 <> x2;

theorem 
  x0 in L1 & x1 in L1 & x0 <> x1 & y0 in L2 & y1 in L2 & y0 <> y1
  & L1 // L2 implies x1 - x0 // y1 - y0;

theorem 
  x2 - x1,x3 - x1 are_lindependent2 & y2 in Line(x1,x2) & y3 in Line(x1,
x3) & L1 = Line(x2,x3) & L2 = Line(y2,y3) implies (L1 // L2 iff ex a st a <> 0
  & y2 - x1 = a*(x2 - x1) & y3 - x1 = a*(x3 - x1));

theorem 
  for L1,L2 st L1 is being_line & L2 is being_line & L1 <> L2
  holds ex x st x in L1 & not x in L2;

theorem 
  for x,L1,L2 st L1 _|_ L2 holds ex L0 st x in L0 & L0 _|_ L2 & L0 // L1;

theorem 
  for x,L1,L2 st x in L2 & L1 _|_ L2 holds ex x0 st x <> x0 & x0
  in L1 & not x0 in L2;



definition
  let n be Element of NAT,x1,x2,x3 be Element of REAL n;
  func plane(x1,x2,x3) -> Subset of REAL n equals

  {x where x is Element of
  REAL n: ex a1,a2,a3 being Real st a1+a2+a3=1 & x=a1*x1+a2*x2+a3*x3};
end;

registration
  let n be Element of NAT,x1,x2,x3 be Element of REAL n;
  cluster plane(x1,x2,x3) -> non empty;
end;

definition
  let n;
  let A be Subset of REAL n;
  attr A is being_plane means


  ex x1,x2,x3 st x2 - x1, x3 - x1 are_lindependent2 & A = plane(x1,x2,x3);
end;

theorem 
  x1 in plane(x1,x2,x3) & x2 in plane(x1,x2,x3) & x3 in plane(x1, x2,x3);

theorem 
  x1 in plane(y1,y2,y3) & x2 in plane(y1,y2,y3) & x3 in plane(y1,
  y2,y3) implies plane(x1,x2,x3) c= plane(y1,y2,y3);

theorem 
  for A being Subset of REAL n,x,x1,x2,x3 st x in plane(x1,x2,x3) & ex
  c1,c2,c3 being Real st c1 + c2 + c3 = 0 & x = c1*x1 + c2*x2 + c3*x3 holds 0*n
  in plane(x1,x2,x3);

theorem 
  y1 in plane(x1,x2,x3) & y2 in plane(x1,x2,x3) implies Line(y1,y2
  ) c= plane(x1,x2,x3);

theorem 
  for A being Subset of REAL n,x st A is being_plane & x in A & ex a st
  a<>1 & a*x in A holds 0*n in A;

theorem 
  x in plane(x1,x2,x3) & x = a1*x1+a2*x2+a3* x3 implies a1 + a2 + a3 = 1
  or 0*n in plane(x1,x2,x3);

theorem 
  x in plane(x1,x2,x3) iff ex a1,a2,a3 st a1+a2+a3=1 & x = a1*x1+ a2*x2+a3*x3;

theorem 
  x2-x1,x3-x1 are_lindependent2 & a1 + a2 + a3 = 1 & x = a1*x1+a2*x2+a3*
x3 & b1 + b2 + b3 = 1 & x = b1*x1+b2*x2+b3*x3 implies a1 = b1 & a2 = b2 & a3 =
  b3;

definition
  let n;
  func plane_of_REAL n -> Subset-Family of REAL n equals

  {P where P is Subset
  of REAL n: ex x1,x2,x3 being Element of REAL n st P = plane(x1,x2,x3)};
end;

registration
  let n;
  cluster plane_of_REAL n -> non empty;
end;

theorem 
  plane(x1,x2,x3) in plane_of_REAL n;

reserve P,P0,P1,P2 for Element of plane_of_REAL n;

theorem 
  x1 in P & x2 in P & x3 in P implies plane(x1,x2,x3) c= P;

theorem 
  x1 in P & x2 in P & x3 in P & x2 - x1, x3 - x1 are_lindependent2
  implies P = plane(x1,x2,x3);

theorem 
  P1 is being_plane & P1 c= P2 implies P1 = P2;



theorem 
  Line(x1,x2) c= plane(x1,x2,x3) & Line(x2,x3) c= plane(x1,x2,x3) & Line
  (x3,x1) c= plane(x1,x2,x3);

theorem 
  x1 in P & x2 in P implies Line(x1,x2) c= P;

definition
  let n be Element of NAT,L1,L2 be Element of line_of_REAL n;
  pred L1,L2 are_coplane means


  ex x1,x2,x3 being Element of REAL n st
  L1 c= plane(x1,x2,x3) & L2 c= plane(x1,x2,x3);
end;

theorem 
  L1,L2 are_coplane iff ex P st L1 c= P & L2 c= P;

theorem 
  L1 // L2 implies L1,L2 are_coplane;

theorem 
  L1 is being_line & L2 is being_line & L1,L2 are_coplane & L1
  misses L2 implies ex P st L1 c= P & L2 c= P & P is being_plane;

theorem 
  ex P st x in P & L c= P;

theorem 
  (not x in L) & L is being_line implies ex P st x in P & L c= P
  & P is being_plane;

theorem 
  x in P & L c= P & (not x in L) & L is being_line implies P is being_plane;

theorem 
  (not x in L) & L is being_line & x in P0 & L c= P0 & x in P1 &
  L c= P1 implies P0 = P1;

theorem 
  L1 is being_line & L2 is being_line & L1,L2 are_coplane & L1 <> L2
  implies ex P st L1 c= P & L2 c= P & P is being_plane;

theorem 
  for L1,L2 st L1 is being_line & L2 is being_line & L1 <> L2 & L1 meets
  L2 holds ex P st L1 c= P & L2 c= P & P is being_plane;

theorem 
  L1 is being_line & L2 is being_line & L1 <> L2 & L1 c= P1 & L2 c= P1 &
  L1 c= P2 & L2 c= P2 implies P1 = P2;

theorem 
  L1 // L2 & L1 <> L2 implies ex P st L1 c= P & L2 c= P & P is being_plane;

theorem 
  L1 _|_ L2 & L1 meets L2 implies ex P st P is being_plane & L1 c= P & L2 c= P;

theorem 
  L0 c= P & L1 c= P & L2 c= P & x in L0 & x in L1 & x in L2 & L0
  _|_ L2 & L1 _|_ L2 implies L0 = L1;

theorem 
  L1,L2 are_coplane & L1 _|_ L2 implies L1 meets L2;

theorem 
  L1 c= P & L2 c= P & L1 _|_ L2 & x in P & L0 // L2 & x in L0
  implies L0 c= P & L0 _|_ L1;

theorem 
  L c= P & L1 c= P & L2 c= P & L _|_ L1 & L _|_ L2 implies L1 // L2;

theorem 
  L0 c= P & L1 c= P & L2 c= P & L0 // L1 & L1 // L2 & L0 <> L1 &
  L meets L0 & L meets L1 implies L meets L2;

theorem 
  L1,L2 are_coplane & L1 is being_line & L2 is being_line & L1
  misses L2 implies L1 // L2;

theorem 
  x1 in P & x2 in P & y1 in P & y2 in P & x2 - x1, y2 - y1
  are_lindependent2 implies Line(x1,x2) meets Line(y1,y2);















begin

theorem 
  for X being set, Y being non empty set, f being Function of X,Y,
  A being Subset of X st f is one-to-one holds f".:(f.:A)=A;

theorem 
  for n being Element of NAT holds n>0 iff Seg n<>{};

definition
  let FT1,FT2 be RelStr, h be Function of FT1, FT2;
  attr h is being_homeomorphism means


  h is one-to-one onto & for x
  being Element of FT1 holds h.:U_FT x = Im(the InternalRel of FT2,h.x);
end;

theorem 
  for FT1,FT2 being non empty RelStr, h being Function of FT1, FT2
  st h is being_homeomorphism ex g being Function of FT2, FT1 st g=h" & g is
  being_homeomorphism;

theorem 
  for FT1,FT2 being non empty RelStr, h being Function of FT1, FT2,
n being Element of NAT, x being Element of FT1, y being Element of FT2 st h is
being_homeomorphism & y=h.x holds for z being Element of FT1 holds z in U_FT(x,
  n) iff h.z in U_FT(y,n);

theorem 
  for FT1,FT2 being non empty RelStr, h being Function of FT1, FT2, n
  being Element of NAT,x being Element of FT1,y being Element of FT2 st h is
being_homeomorphism & y=h.x holds for v being Element of FT2 holds h".v in U_FT
  (x,n) iff v in U_FT(y,n);

theorem 
  for n being non zero Element of NAT, f being Function of FTSL1 n,
FTSL1 n st f is_continuous 0 holds ex p being Element of FTSL1 n st f.p in U_FT
  (p,0);

theorem 
  for T being non empty RelStr, p being Element of T, k being
  Element of NAT st T is filled holds U_FT(p,k) c= U_FT(p,k+1);

theorem 
  for T being non empty RelStr, p being Element of T, k being
  Element of NAT st T is filled holds U_FT(p,0) c= U_FT(p,k);

theorem 
  for n being non zero Nat, jn,j,k being Nat, p being Element of
  FTSL1 n st p=jn holds j in U_FT(p,k) iff j in Seg n & abs(jn-j)<= k+1;



theorem 
  for kc,km being Element of NAT, n being non zero Element of NAT, f
  being Function of FTSL1 n, FTSL1 n st f is_continuous kc & km=[/ (kc/2) \]
  holds ex p being Element of FTSL1 n st f.p in U_FT(p,km);

definition
  let A,B be set;
  let R be Relation of A,B, x be set;
  redefine func Im(R,x) -> Subset of B;
end;



definition
  let n,m be Element of NAT;
  func Nbdl2(n,m) -> Relation of [:Seg n, Seg m:] means


  for x being set
st x in [:Seg n, Seg m:] holds for i,j being Element of NAT st x=[i,j] holds Im
  (it,x) = [:Im(Nbdl1 n,i), Im(Nbdl1 m,j):];
end;

definition
  let n,m be Element of NAT;
  func FTSL2(n,m) -> strict RelStr equals

  RelStr(# [:Seg n, Seg m:], Nbdl2(n,m
    ) #);
end;

registration
  let n,m be non zero Element of NAT;
  cluster FTSL2(n,m) -> non empty;
end;

theorem 
  for n,m being non zero Element of NAT holds FTSL2(n,m) is filled;

theorem 
  for n,m being non zero Element of NAT holds FTSL2(n,m) is symmetric;

theorem 
  for n being non zero Element of NAT ex h being Function of FTSL2(n,1),
  FTSL1 n st h is being_homeomorphism;



definition
  let n,m be Element of NAT;
  func Nbds2(n,m) -> Relation of [:Seg n, Seg m:] means


  for x being set
st x in [:Seg n, Seg m:] holds for i,j being Element of NAT st x=[i,j] holds Im
  (it,x) = [:{i}, Im(Nbdl1 m,j):] \/ [:Im(Nbdl1 n,i),{j}:];
end;

definition
  let n,m be Element of NAT;
  func FTSS2(n,m) -> strict RelStr equals

  RelStr(# [:Seg n, Seg m:], Nbds2(n,m
    ) #);
end;

registration
  let n,m be non zero Element of NAT;
  cluster FTSS2(n,m) -> non empty;
end;

theorem 
  for n,m being non zero Element of NAT holds FTSS2(n,m) is filled;

theorem 
  for n,m being non zero Element of NAT holds FTSS2(n,m) is symmetric;

theorem 
  for n being non zero Element of NAT ex h being Function of FTSS2(n,1),
  FTSL1 n st h is being_homeomorphism;














begin

reserve a,b,c for set;

theorem 
  for D be non empty set,p,q,r,s being FinSequence of D holds p^q^r
  ^s=p^(q^r)^s & p^q^r^s=(p^q)^(r^s) & p^(q^r)^s=(p^q)^(r^s);

theorem 
  for D being set, f being FinSequence of D holds f|(len f) = f;

theorem 
  for D being non empty set,p,q being FinSequence of D st len p=0
  holds q = p ^ q;

theorem 
  for D being non empty set,f being FinSequence of D, n,m being
  Element of NAT st n<=m holds len (f/^m)<=len (f/^n);

theorem 
  for D being non empty set,f,g being FinSequence of D st len g>=1
  holds mid(f^g,len f+1,len f+len g)=g;

theorem 
  for D being non empty set,f,g being FinSequence of D, i,j being
  Element of NAT st 1<=i & i<=j & j<=len f holds mid(f^g,i,j)=mid(f,i,j);

theorem 
  for D being non empty set,f being FinSequence of D, i,j,n being
  Element of NAT st 1<=i & i<=j & i<=len (f|n) & j<=len (f|n) holds mid(f,i,j)=
  mid(f|n,i,j);

theorem 
  for D being non empty set,f being FinSequence of D st f=<*a*> holds a in D;

theorem 
  for D being non empty set,f being FinSequence of D st f=<*a,b*> holds
  a in D & b in D;

theorem 
  for D being non empty set,f being FinSequence of D st f=<*a,b,c
  *> holds a in D & b in D & c in D;

theorem 
  for D being non empty set,f being FinSequence of D st f=<*a*> holds f|
  1=<*a*>;

theorem 
  for D being non empty set,f being FinSequence of D st f=<*a,b*> holds
  f/^1=<*b*>;

theorem 
  for D being non empty set,f being FinSequence of D st f=<*a,b,c*>
  holds f|1=<*a*>;

theorem 
  for D being non empty set,f being FinSequence of D st f=<*a,b,c
  *> holds f|2=<*a,b*>;

theorem 
  for D being non empty set,f being FinSequence of D st f=<*a,b,c*>
  holds f/^1=<*b,c*>;

theorem 
  for D being non empty set,f being FinSequence of D st f=<*a,b,c*>
  holds f/^2=<*c*>;

theorem 
  for D being non empty set,f being FinSequence of D st len f=0 holds Rev f=f;

theorem 
  for D being non empty set, r being FinSequence of D,i being
  Element of NAT st i<=len r holds Rev(r/^i)=(Rev r)|(len r-'i);

theorem 
  for D being non empty set,f,CR being FinSequence of D st not CR
  is_substring_of f,1 & CR separates_uniquely holds instr(1,f^CR,CR)=len f +1;

theorem 
  for D being non empty set,f,CR being FinSequence of D st not CR
  is_substring_of f,1 & CR separates_uniquely holds f^CR is_terminated_by CR;





notation
  let D be set;
  synonym File of D for FinSequence of D;
end;

definition
  let D be non empty set, r,f,CR be File of D;
  pred r is_a_record_of f,CR means


  (CR^r is_substring_of addcr(f,CR),1
  or r is_preposition_of addcr(f,CR)) & r is_terminated_by CR;
end;

theorem 
  for D being non empty set,r being FinSequence of D holds ovlpart
  (<*>D,r)=<*>D & ovlpart(r,<*>D)=<*>D;

theorem 
  for D being non empty set,CR being FinSequence of D holds CR
  is_a_record_of <*>D,CR;

theorem 
  for D being non empty set,a,b be set,f,r,CR being File of D st a <> b
  & CR = <*b*> & f = <*b,a,b*> & r = <*a,b*> holds CR is_a_record_of f,CR & r
  is_a_record_of f,CR;

theorem 
  for D being non empty set,f,CR being File of D holds f is_preposition_of f^CR
;

theorem 
  for D being non empty set,f,CR being File of D holds f
  is_preposition_of addcr(f,CR);

theorem 
  for D being non empty set,r,CR being File of D st CR
  is_postposition_of r holds 0<=len r-len CR;

theorem 
  for D being non empty set,CR,r being File of D st CR
  is_postposition_of r holds r=addcr(r,CR);

theorem 
  for D being non empty set,CR,r being File of D st r
  is_terminated_by CR holds r=addcr(r,CR);

theorem 
  for D being non empty set,f,g being File of D st f is_terminated_by g
  holds len g <=len f;

theorem 
  for D being non empty set,f,CR being File of D holds len addcr(f
  ,CR) >= len f & len addcr(f,CR) >= len CR;

theorem 
  for D being non empty set,f,g being FinSequence of D holds g =
  ovlpart(f,g)^ovlrdiff(f,g);

theorem 
  for D being non empty set,f,g being FinSequence of D holds ovlcon(f,g)
  = ovlldiff(f,g) ^ g;

theorem 
  for D being non empty set,CR,r being File of D holds addcr(r,CR)=
  ovlldiff(r,CR)^CR;

theorem 
  for D being non empty set,r1,r2,f being File of D st f = r1 ^ r2
  holds r1 is_substring_of f,1 & r2 is_substring_of f,1;

theorem 
  for D being non empty set,r1,r2,r3,f being File of D st f = r1 ^
  r2 ^ r3 holds r1 is_substring_of f,1 & r2 is_substring_of f,1 & r3
  is_substring_of f,1;

theorem 
  for D being non empty set,CR,r1,r2 being File of D st r1
is_terminated_by CR & r2 is_terminated_by CR holds CR^r2 is_substring_of addcr(
  r1^r2,CR),1;

theorem 
  for D being non empty set,f,g being File of D,n being Element of
  NAT st 0<n & g={} holds instr(n,f,g)=n;

theorem 
  for D being non empty set,f,g being File of D,n being Element of NAT
  st 0<n & n<=len f holds instr(n,f,g)<=len f;

theorem 
  for D being non empty set,f,CR being File of D holds CR
  is_substring_of ovlcon(f,CR),1;

theorem 
  for D being non empty set,f,CR being File of D holds CR
  is_substring_of addcr(f,CR),1;

theorem 
  for D being non empty set,f,g being FinSequence of D, n being
Element of NAT st g is_substring_of f|n,1 & len g>0 holds g is_substring_of f,1
;

theorem 
  for D being non empty set, f,CR being File of D ex r being File of D
  st r is_a_record_of f,CR;

theorem 
  for D being non empty set,f,CR,r being File of D st r is_a_record_of f
  ,CR holds r is_a_record_of r,CR;

theorem 
  for D being non empty set,CR,r1,r2,f being File of D st r1
  is_terminated_by CR & r2 is_terminated_by CR & f = r1 ^ r2 holds r1
  is_a_record_of f,CR & r2 is_a_record_of f,CR;














begin

theorem 
  for V being RealLinearSpace, A,B being circled Subset of V holds
  A-B is circled;

registration
  let V be RealLinearSpace, M,N be circled Subset of V;
  cluster M - N -> circled;
end;

definition
  let V be non empty RLSStruct, M be Subset of V;
  redefine attr M is circled means


  for u being VECTOR of V, r being Real st abs(r) <= 1 & u in M holds r*u in M;
end;

theorem 
  for V be RealLinearSpace, M being Subset of V, r being Real st M
  is circled holds r * M is circled;

theorem 
  for V be RealLinearSpace, M1,M2 being Subset of V, r1,r2 being
  Real st M1 is circled & M2 is circled holds r1*M1 + r2*M2 is circled;

theorem 
  for V be RealLinearSpace, M1,M2,M3 being Subset of V, r1,r2,r3 being
Real st M1 is circled & M2 is circled & M3 is circled holds r1*M1 + r2*M2 + r3*
  M3 is circled;

theorem 
  for V being RealLinearSpace holds Up((0).V) is circled;

theorem 
  for V being RealLinearSpace holds Up((Omega).V) is circled;

theorem 
  for V being RealLinearSpace, M,N being circled Subset of V holds M /\
  N is circled;

theorem 
  for V being RealLinearSpace, M,N being circled Subset of V holds M \/
  N is circled;

begin 

definition
  let V be non empty RLSStruct, M be Subset of V;
  func Circled-Family M -> Subset-Family of V means


  for N being Subset of V holds N in it iff N is circled & M c= N;
end;

definition
  let V be RealLinearSpace, M be Subset of V;
  func Cir M -> circled Subset of V equals

  meet Circled-Family M;
end;

registration
  let V be RealLinearSpace, M be Subset of V;
  cluster Circled-Family M -> non empty;
end;

theorem 
  for V being RealLinearSpace, M1,M2 being Subset of V st M1 c= M2
  holds Circled-Family M2 c= Circled-Family M1;

theorem 
  for V being RealLinearSpace, M1,M2 being Subset of V st M1 c= M2 holds
  Cir M1 c= Cir M2;

theorem 
  for V being RealLinearSpace, M being Subset of V holds M c= Cir( M);

theorem 
  for V being RealLinearSpace, M being Subset of V, N being
  circled Subset of V st M c= N holds Cir M c= N;

theorem 
  for V being RealLinearSpace, M being circled Subset of V holds Cir M = M;

theorem 
  for V being RealLinearSpace holds Cir ({}V) = {};

theorem 
  for V being RealLinearSpace, M being Subset of V, r being Real holds r
  *Cir M = Cir(r*M);

begin 

definition
  let V be RealLinearSpace, L be Linear_Combination of V;
  attr L is circled means


  ex F being FinSequence of the carrier of V st
F is one-to-one & rng F = Carrier L & ex f being FinSequence of REAL st len f =
len F & Sum(f) = 1 & for n being Nat st n in dom f holds f.n = L.(F.n) & f.n >=
  0;
end;

theorem 
  for V being RealLinearSpace, L being Linear_Combination of V st
  L is circled holds Carrier L <> {};

theorem 
  for V being RealLinearSpace, L being Linear_Combination of V, v
  being VECTOR of V st L is circled & L.v <= 0 holds not v in Carrier(L);

theorem 
  for V being RealLinearSpace, L being Linear_Combination of V st L is
  circled holds L <> ZeroLC(V);

registration
  let V be RealLinearSpace;
  cluster circled for Linear_Combination of V;
end;

definition
  let V be RealLinearSpace;
  mode circled_Combination of V is circled Linear_Combination of V;
end;

registration
  let V be RealLinearSpace, M be non empty Subset of V;
  cluster circled for Linear_Combination of M;
end;

definition
  let V be RealLinearSpace, M be non empty Subset of V;
  mode circled_Combination of M is circled Linear_Combination of M;
end;

definition
  let V be RealLinearSpace;
  func circledComb V means

  for L being set holds L in it iff L is circled_Combination of V;
end;

definition
  let V be RealLinearSpace, M be non empty Subset of V;
  func circledComb M means

  for L being set holds L in it iff L is circled_Combination of M;
end;

theorem 
  for V being RealLinearSpace, v being VECTOR of V holds ex L being
circled_Combination of V st Sum L = v & for A being non empty Subset of V st v
  in A holds L is circled_Combination of A;

theorem 
  for V being RealLinearSpace, v1,v2 being VECTOR of V st v1 <> v2 holds
ex L being circled_Combination of V st for A being non empty Subset of V st {v1
  ,v2} c= A holds L is circled_Combination of A;

theorem 
  for V being RealLinearSpace, L1, L2 being circled_Combination of V, a,
  b being Real st a * b > 0 holds Carrier(a*L1 + b*L2) = Carrier(a * L1) \/
  Carrier(b * L2);

theorem 
  for V being RealLinearSpace, v being VECTOR of V, L being
Linear_Combination of V st L is circled & Carrier(L) = {v} holds L.v = 1 & Sum(
  L) = L.v * v;

theorem 
  for V being RealLinearSpace, v1,v2 being VECTOR of V, L being
Linear_Combination of V st L is circled & Carrier(L) = {v1,v2} & v1 <> v2 holds
  L.v1 + L.v2 = 1 & L.v1 >= 0 & L.v2 >= 0 & Sum(L) = L.v1 * v1 + L.v2 * v2;

theorem 
  for V being RealLinearSpace, v being VECTOR of V, L being
  Linear_Combination of {v} st L is circled holds L.v = 1 & Sum(L) = L.v * v;

theorem 
  for V being RealLinearSpace, v1,v2 being VECTOR of V, L being
Linear_Combination of {v1,v2} st v1 <> v2 & L is circled holds L.v1 + L.v2 = 1
  & L.v1 >= 0 & L.v2 >= 0 & Sum(L) = L.v1 * v1 + L.v2 * v2;














begin 

definition
  let T be 1-sorted;
  func TotFam T -> Subset-Family of T equals

  bool the carrier of T;
end;

theorem 
  for T being set, F being Subset-Family of T holds F is countable
  iff COMPLEMENT F is countable;

registration
  cluster RAT -> countable;
end;

scheme 
 FraenCoun11 { P[set] } :
  { {n} where n is Element of RAT : P[n] } is countable;

theorem 
  for T being non empty TopSpace, A being Subset of T holds Der A = { x
  where x is Point of T : x in Cl (A \ {x}) };

registration
  cluster finite -> second-countable for TopStruct;
end;

registration
  cluster REAL -> non countable;
end;

registration
  cluster non countable -> non finite for set;
  cluster non finite -> non trivial for set;
  cluster non countable non empty for set;
end;

reserve T for non empty TopSpace,
  A, B for Subset of T,
  F, G for Subset-Family of T;

theorem 
  A is closed iff Der A c= A;

theorem 
  for T being non empty TopStruct, B being Basis of T, V being
Subset of T st V is open & V <> {} ex W being Subset of T st W in B & W c= V &
  W <> {};

begin 


theorem 
  density T c= weight T;

theorem 
  T is separable iff ex A being Subset of T st A is dense countable;



theorem 
  T is second-countable implies T is separable;

registration
  cluster second-countable -> separable for non empty TopSpace;
end;



theorem 
  for T being non empty TopSpace, A, B being Subset of T st A, B
  are_separated holds Fr (A \/ B) = Fr A \/ Fr B;



theorem 
  F is locally_finite implies Fr union F c= union Fr F;

theorem 
  for T being discrete non empty TopSpace holds T is separable iff
  card [#]T c= omega;

theorem 
  for T being discrete non empty TopSpace holds T is separable iff T is
  countable;

begin 

definition
  let T, F;
  attr F is all-open-containing means


  for A being Subset of T st A is open holds A in F;
end;

definition
  let T, F;
  attr F is all-closed-containing means


  for A being Subset of T st A is closed holds A in F;
end;

definition
  let T be set, F be Subset-Family of T;
  attr F is closed_for_countable_unions means


  for G being countable Subset-Family of T st G c= F holds union G in F;
end;

registration
  let T be set;
  cluster -> closed_for_countable_unions for SigmaField of T;
end;

theorem 
  for T being set, F being Subset-Family of T st F is
  closed_for_countable_unions holds {} in F;

registration
  let T be set;
  cluster closed_for_countable_unions -> non empty for Subset-Family of T;
end;

theorem 
  for T being set, F being Subset-Family of T holds F is
  SigmaField of T iff F is compl-closed closed_for_countable_unions;

definition
  let T be set, F be Subset-Family of T;
  attr F is closed_for_countable_meets means


  for G being countable Subset-Family of T st G c= F holds meet G in F;
end;

theorem 
  for F being Subset-Family of T holds F is all-closed-containing
  compl-closed iff F is all-open-containing compl-closed;

theorem 
  for T being set, F being Subset-Family of T st F is compl-closed holds
  F = COMPLEMENT F;

theorem 
  for T being set, F, G being Subset-Family of T st F c= G & G is
  compl-closed holds COMPLEMENT F c= G;

theorem 
  for T being set, F being Subset-Family of T holds F is
  closed_for_countable_meets compl-closed iff F is closed_for_countable_unions
  compl-closed;

registration
  let T;
  cluster all-open-containing compl-closed closed_for_countable_unions ->
    all-closed-containing closed_for_countable_meets for Subset-Family of T;
  cluster all-closed-containing compl-closed closed_for_countable_meets ->
    all-open-containing closed_for_countable_unions for Subset-Family of T;
end;

begin 

registration
  let T be set;
  let F be countable Subset-Family of T;
  cluster COMPLEMENT F -> countable;
end;

registration
  let T be TopSpace;
  cluster empty -> open closed for Subset-Family of T;
end;

registration
  let T be TopSpace;
  cluster countable open closed for Subset-Family of T;
end;

theorem 
  for T being set holds {} is empty Subset-Family of T;

registration
  cluster empty -> countable for set;
end;

begin 

theorem 
  F = { A } implies (A is open iff F is open);

theorem 
  F = { A } implies (A is closed iff F is closed);

definition
  let T be set, F, G be Subset-Family of T;
  redefine func INTERSECTION (F,G) -> Subset-Family of T;
  redefine func UNION (F,G) -> Subset-Family of T;
end;

theorem 
  F is closed & G is closed implies INTERSECTION (F,G) is closed;

theorem 
  F is closed & G is closed implies UNION (F,G) is closed;

theorem 
  F is open & G is open implies INTERSECTION (F,G) is open;

theorem 
  F is open & G is open implies UNION (F,G) is open;

theorem 
  for T being set, F, G being Subset-Family of T holds card
  INTERSECTION (F,G) c= card [:F,G:];

theorem 
  for T being set, F, G being Subset-Family of T holds card UNION
  (F,G) c= card [:F,G:];

theorem 
  for F, G being set holds union UNION (F,G) c= union F \/ union G;

theorem 
  for F, G being set st F <> {} & G <> {} holds union F \/ union G
  = union UNION (F,G);

theorem 
  for F being set holds UNION ({},F) = {};

theorem 
  for F, G being set holds UNION (F, G) = {} implies F = {} or G = {};

theorem 
  for F, G being set st INTERSECTION (F, G) = {} holds F = {} or G = {};

theorem 
  for F, G being set holds meet UNION (F,G) c= meet F \/ meet G;

theorem 
  for F, G being set st F <> {} & G <> {} holds meet UNION(F,G) = meet F
  \/ meet G;

theorem 
  for F, G being set st F <> {} & G <> {} holds meet F /\ meet G =
  meet INTERSECTION(F,G);

begin 

definition
  let T be TopSpace, A be Subset of T;
  attr A is F_sigma means


  ex F being closed countable Subset-Family of T st A = union F;
end;

definition
  let T be TopSpace, A be Subset of T;
  attr A is G_delta means


  ex F being open countable Subset-Family of T st A = meet F;
end;

registration
  let T;
  cluster empty -> F_sigma G_delta for Subset of T;
end;

theorem 
  [#]T is F_sigma;

theorem 
  [#]T is G_delta;

registration
  let T;
  cluster [#]T -> F_sigma G_delta;
end;

theorem 
  A is F_sigma implies A` is G_delta;

theorem 
  A is G_delta implies A` is F_sigma;

theorem 
  A is F_sigma & B is F_sigma implies A /\ B is F_sigma;

theorem 
  A is F_sigma & B is F_sigma implies A \/ B is F_sigma;

theorem 
  A is G_delta & B is G_delta implies A \/ B is G_delta;

theorem 
  A is G_delta & B is G_delta implies A /\ B is G_delta;

theorem 
  for A being Subset of T st A is closed holds A is F_sigma;

theorem 
  for A being Subset of T st A is open holds A is G_delta;

theorem 
  for A being Subset of R^1 st A = RAT holds A is F_sigma;

begin 

definition
  let T be TopSpace;
  attr T is T_1/2 means


  for A being Subset of T holds Der A is closed;
end;

theorem 
  for T being TopSpace st T is T_1 holds T is T_1/2;

theorem 
  for T being non empty TopSpace st T is T_1/2 holds T is T_0;

registration
  cluster T_1/2 -> T_0 for TopSpace;
  cluster T_1 -> T_1/2 for TopSpace;
end;

begin 


definition
  let T, A;
  let x be Point of T;
  pred x is_a_condensation_point_of A means


  for N being a_neighborhood of x holds N /\ A is not countable;
end;

reserve x for Point of T;

theorem 
  x is_a_condensation_point_of A & A c= B implies x
  is_a_condensation_point_of B;

definition
  let T, A;
  func A^0 -> Subset of T means


  for x being Point of T holds x in it iff x is_a_condensation_point_of A;
end;

theorem 
  for p being Point of T st p is_a_condensation_point_of A holds p
  is_an_accumulation_point_of A;

theorem 
  A^0 c= Der A;

theorem 
  A^0 = Cl (A^0);

theorem 
  A c= B implies A^0 c= B^0;

theorem 
  x is_a_condensation_point_of A \/ B implies x
  is_a_condensation_point_of A or x is_a_condensation_point_of B;

theorem 
  (A \/ B)^0 = (A^0) \/ (B^0);

theorem 
  A is countable implies not ex x being Point of T st x
  is_a_condensation_point_of A;

theorem 
  A is countable implies A^0 = {};

registration
  let T;
  let A be countable Subset of T;
  cluster A^0 -> empty;
end;

theorem 
  T is second-countable implies ex B being Basis of T st B is countable;

registration
  cluster second-countable non empty for TopSpace;
end;

begin 

registration
  let T;
  cluster TotFam T -> non empty all-open-containing compl-closed
    closed_for_countable_unions;
end;

theorem 
  for T being set, A being SetSequence of T holds
  rng A is countable non empty Subset-Family of T;

theorem 
  for F, G being Subset-Family of T st F is all-open-containing &
  F c= G holds G is all-open-containing;

theorem 
  for F, G being Subset-Family of T st F is all-closed-containing & F c=
  G holds G is all-closed-containing;

definition
  let T be 1-sorted;
  mode SigmaField of T is SigmaField of the carrier of T;
end;

registration
  let T be non empty TopSpace;
  cluster compl-closed closed_for_countable_unions closed_for_countable_meets
    all-closed-containing all-open-containing for Subset-Family of T;
end;

theorem 
  sigma TotFam T is all-open-containing compl-closed
  closed_for_countable_unions;

registration
  let T;
  cluster sigma TotFam T -> all-open-containing compl-closed
    closed_for_countable_unions;
end;

registration
  let T be non empty 1-sorted;
  cluster sigma-additive compl-closed closed_for_countable_unions non empty
    for Subset-Family of T;
end;

registration
  let T be non empty TopSpace;
  cluster -> closed_for_countable_unions for SigmaField of T;
end;

theorem 
  for T being non empty TopSpace, F being Subset-Family of T st F is
  compl-closed closed_for_countable_unions holds F is SigmaField of T;

registration
  let T be non empty TopSpace;
  cluster all-open-containing for SigmaField of T;
end;

registration
  let T be non empty TopSpace;
  cluster Topology_of T -> open all-open-containing;
end;

theorem 
  for X being Subset-Family of T ex Y being all-open-containing
  compl-closed closed_for_countable_unions Subset-Family of T st X c= Y & for Z
  be all-open-containing compl-closed closed_for_countable_unions Subset-Family
  of T st X c= Z holds Y c= Z;

definition
  let T;
  func BorelSets T -> all-open-containing compl-closed
  closed_for_countable_unions Subset-Family of T means


  for G being
all-open-containing compl-closed closed_for_countable_unions Subset-Family of T
  holds it c= G;
end;

theorem 
  for F being closed Subset-Family of T holds F c= BorelSets T;

theorem 
  for F being open Subset-Family of T holds F c= BorelSets T;

theorem 
  BorelSets T = sigma Topology_of T;

definition
  let T, A;
  attr A is Borel means


  A in BorelSets T;
end;

registration
  let T;
  cluster F_sigma -> Borel for Subset of T;
end;

registration
  let T;
  cluster G_delta -> Borel for Subset of T;
end;














begin 

reserve x,y for Element of REAL,
  u,v,w for set,
  r for positive real number;

theorem 
  for f,g being Function st f tolerates g for A being set holds (f
  +*g)"A = (f"A)\/(g"A);

theorem 
  for f,g being Function st dom f misses dom g for A being set holds (f
  +*g)"A = (f"A)\/(g"A);

theorem 
  for x,a being set, f being Function st a in dom f holds (commute
  (x .--> f)).a = x .--> f.a;

theorem 
  for b being set, f being Function holds b in dom commute f iff ex a
  being set, g being Function st a in dom f & g = f.a & b in dom g;

theorem 
  for a,b being set, f being Function holds a in dom ((commute f).b
  ) iff ex g being Function st a in dom f & g = f.a & b in dom g;

theorem 
  for a,b being set, f,g being Function st a in dom f & g = f.a & b
  in dom g holds (commute f).b.a = g.b;

theorem 
  for a being set, f,g,h being Function st h = f \/ g holds (
  commute h).a = (commute f).a \/ (commute g).a;

theorem 
  for X,Y being set holds product <*X,Y*>, [:X,Y:] are_equipotent
  & card product <*X,Y*> = (card X)*`(card Y);

scheme 

  SCH1{P[set], A,B,C()-> non empty set, F1,F2(set)-> set}: ex f being Function
of C(), B() st for a being Element of A() st a in C() holds (P[a] implies f.a =
  F1(a)) & (not P[a] implies f.a = F2(a))
provided
 C() c= A() and
 for a being Element of A() st a in C() holds (P[a] implies F1(a) in
B()) & (not P[a] implies F2(a) in B());

scheme 

  SCH2{P,Q[set], A,B,C()-> non empty set, F1,F2,F3(set)-> set}: ex f being
  Function of C(), B() st for a being Element of A() st a in C() holds (P[a]
implies f.a = F1(a)) & (not P[a] & Q[a] implies f.a = F2(a)) & (not P[a] & not
  Q[a] implies f.a = F3(a))
provided
 C() c= A() and
 for a being Element of A() st a in C() holds (P[a] implies F1(a) in
B()) & (not P[a] & Q[a] implies F2(a) in B()) & (not P[a] & not Q[a] implies F3
(a) in B());

theorem 
  for a,b being real number holds |.|[a,b]|.|^2 = a^2+b^2;

theorem 
  for X being TopSpace, Y being non empty TopSpace for A,B being
  closed Subset of X for f being continuous Function of X|A, Y for g being
  continuous Function of X|B, Y st f tolerates g holds f+*g is continuous
  Function of X|(A \/ B), Y;

theorem 
  for X being TopSpace, Y being non empty TopSpace for A,B being
closed Subset of X st A misses B for f being continuous Function of X|A, Y for
g being continuous Function of X|B, Y holds f+*g is continuous Function of X|(A
  \/ B), Y;

theorem 
  for X being TopSpace, Y being non empty TopSpace for A being
  open closed Subset of X for f being continuous Function of X|A, Y for g being
  continuous Function of X|A`, Y holds f+*g is continuous Function of X, Y;

begin 

theorem 
  for n being Element of NAT for a being Point of TOP-REAL n for r
  being positive real number holds a in Ball(a,r);

definition
  func y=0-line -> Subset of TOP-REAL 2 equals

  {|[x,0]|: not contradiction};
  func y>=0-plane -> Subset of TOP-REAL 2 equals

  {|[x,y]|: y >= 0};
end;

theorem 
  for a,b being set holds <*a,b*> in y=0-line iff a in REAL & b = 0;

theorem 
  for a,b being real number holds |[a,b]| in y=0-line iff b = 0;

theorem 
  card y=0-line = continuum;

theorem 
  for a,b being set holds <*a,b*> in y>=0-plane iff a in REAL & ex y st
  b = y & y >= 0;

theorem 
  for a,b being real number holds |[a,b]| in y>=0-plane iff b >= 0;

registration
  cluster y=0-line -> non empty;
  cluster y>=0-plane -> non empty;
end;

theorem 
  y=0-line c= y>=0-plane;

theorem 
  for a,b,r being real number st r > 0 holds Ball(|[a,b]|,r) c=
  y>=0-plane iff r <= b;

theorem 
  for a,b,r being real number st r > 0 & b >= 0 holds Ball(|[a,b]|
  ,r) misses y=0-line iff r <= b;

theorem 
  for n being Element of NAT, a,b being Element of TOP-REAL n, r1,
r2 being positive real number st |.a-b.| <= r1-r2 holds Ball(b,r2) c= Ball(a,
  r1);

theorem 
  for a being real number, r1,r2 being positive real number st
  r1 <= r2 holds Ball(|[a,r1]|,r1) c= Ball(|[a,r2]|,r2);

theorem 
  for T1,T2 being non empty TopSpace for B1 being
  Neighborhood_System of T1 for B2 being Neighborhood_System of T2 st B1 = B2
  holds the TopStruct of T1 = the TopStruct of T2;

definition

  func Niemytzki-plane -> strict non empty TopSpace means


  the carrier
of it = y>=0-plane & ex B being Neighborhood_System of it st (for x holds B.(|[
  x,0]|) = {Ball(|[x,r]|,r) \/ {|[x,0]|} where r is Element of REAL: r > 0}) &
for x,y st y > 0 holds B.(|[x,y]|) = {Ball(|[x,y]|,r) /\ y>=0-plane where r is
  Element of REAL: r > 0};
end;

theorem 
  y>=0-plane \ y=0-line is open Subset of Niemytzki-plane;

theorem 
  y=0-line is closed Subset of Niemytzki-plane;

theorem 
  for x being real number, r being positive real number holds
  Ball(|[x,r]|,r) \/ {|[x,0]|} is open Subset of Niemytzki-plane;

theorem 
  for x being real number for y,r being positive real number
  holds Ball(|[x,y]|,r) /\ y>=0-plane is open Subset of Niemytzki-plane;

theorem 
  for x,y being real number for r being positive real number st
  r <= y holds Ball(|[x,y]|,r) is open Subset of Niemytzki-plane;

theorem 
  for p being Point of Niemytzki-plane for r being positive real
number ex a being Point of TOP-REAL 2, U being open Subset of Niemytzki-plane
st p in U & a in U & for b being Point of TOP-REAL 2 st b in U holds |.b-a.| <
  r;

theorem 
  for x,y being real number for r being positive real number ex
  w,v being rational number st |[w,v]| in Ball(|[x,y]|,r) & |[w,v]| <> |[x,y]|;

theorem 
  for A being Subset of Niemytzki-plane st A = (y>=0-plane \
  y=0-line) /\ product <*RAT,RAT*> for x being set holds Cl (A \ {x}) = [#]
  Niemytzki-plane;

theorem 
  for A being Subset of Niemytzki-plane st A = y>=0-plane \
  y=0-line for x being set holds Cl (A \ {x}) = [#] Niemytzki-plane;

theorem 
  for A being Subset of Niemytzki-plane st A = y>=0-plane \
  y=0-line holds Cl A = [#] Niemytzki-plane;

theorem 
  for A being Subset of Niemytzki-plane st A = y=0-line holds Cl A
  = A & Int A = {};

theorem 
  (y>=0-plane \ y=0-line) /\ product <*RAT,RAT*> is dense Subset
  of Niemytzki-plane;

theorem 
  (y>=0-plane \ y=0-line) /\ product <*RAT,RAT*> is dense-in-itself
  Subset of Niemytzki-plane;

theorem 
  y>=0-plane \ y=0-line is dense Subset of Niemytzki-plane;

theorem 
  y>=0-plane \ y=0-line is dense-in-itself Subset of Niemytzki-plane;

theorem 
  y=0-line is nowhere_dense Subset of Niemytzki-plane;

theorem 
  for A being Subset of Niemytzki-plane st A = y=0-line holds Der A is empty;

theorem 
  for A being Subset of y=0-line holds A is closed Subset of Niemytzki-plane;

theorem 
  RAT is dense Subset of Sorgenfrey-line;

theorem 
  Sorgenfrey-line is separable;

theorem 
  Niemytzki-plane is separable;

theorem 
  Niemytzki-plane is T_1;

theorem 
  Niemytzki-plane is not normal;

begin 

definition
  let T be TopSpace;
  attr T is Tychonoff means


  for A being closed Subset of T, a being
Point of T st a in A` ex f being continuous Function of T, I[01] st f.a = 0 & f
  .:A c= {1};
end;

registration
  cluster Tychonoff -> regular for TopSpace;
  cluster T_4 -> Tychonoff for non empty TopSpace;
end;

theorem 
  for X being T_1 TopSpace st X is Tychonoff for B being prebasis of X
  for x being Point of X for V being Subset of X st x in V & V in B ex f being
  continuous Function of X, I[01] st f.x = 0 & f.:V` c= {1};

theorem 
  for X being TopSpace, R being non empty SubSpace of R^1 for f,g
  being continuous Function of X,R for A being Subset of X st for x being Point
  of X holds x in A iff f.x <= g.x holds A is closed;

theorem 
  for X being TopSpace, R being non empty SubSpace of R^1 for f,g
being continuous Function of X,R ex h being continuous Function of X,R st for x
  being Point of X holds h.x = max(f.x,g.x);

theorem 
  for X being non empty TopSpace, R being non empty SubSpace of
R^1 for A being finite non empty set for F being ManySortedFunction of A st for
  a being set st a in A holds F.a is continuous Function of X,R ex f being
continuous Function of X,R st for x being Point of X, S being finite non empty
  Subset of REAL st S = rng ((commute F).x) holds f.x = max S;

theorem 
  for X being T_1 non empty TopSpace for B being prebasis of X st
  for x being Point of X for V being Subset of X st x in V & V in B ex f being
continuous Function of X, I[01] st f.x = 0 & f.:V` c= {1} holds X is Tychonoff;

theorem 
  Sorgenfrey-line is T_1;

theorem 
  for x being real number holds left_open_halfline x is closed
  Subset of Sorgenfrey-line;

theorem 
  for x being real number holds left_closed_halfline x is closed Subset
  of Sorgenfrey-line;

theorem 
  for x being real number holds right_closed_halfline x is closed
  Subset of Sorgenfrey-line;

theorem 
  for x,y being real number holds [.x,y.[ is closed Subset of Sorgenfrey-line;



theorem 
  for x being real number, w being rational number ex f being
  continuous Function of Sorgenfrey-line, I[01] st for a being Point of
  Sorgenfrey-line holds (a in [.x,w.[ implies f.a = 0) & (not a in [.x,w.[
  implies f.a = 1);

theorem 
  Sorgenfrey-line is Tychonoff;

begin 


definition
  let x be real number, r be positive real number;
  func +(x,r) -> Function of Niemytzki-plane, I[01] means


  it.(|[x,0]|)
= 0 & for a being real number, b being non negative real number holds ((a <>
x or b <> 0) & not |[a,b]| in Ball(|[x,r]|,r) implies it.(|[a,b]|) = 1) & (|[a,
  b]| in Ball(|[x,r]|,r) implies it.(|[a,b]|) = |.|[x,0]|-|[a,b]|.|^2/(2*r*b));
end;

theorem 
  for p being Point of TOP-REAL 2 st p`2 >= 0 for x being real
  number, r being positive real number st +(x,r).p = 0 holds p = |[x,0]|;

theorem 
  for x,y being real number, r being positive real number st x
  <> y holds +(x,r).(|[y,0]|) = 1;

theorem 
  for p being Point of TOP-REAL 2 for x being real number, a,r
being positive real number st a <= 1 & |.p-|[x,r*a]|.| = r*a & p`2 <> 0 holds
  +(x,r).p = a;

theorem 
  for p being Point of TOP-REAL 2 for x,a being real number, r
being positive real number st a <= 1 & |.p-|[x,r*a]|.| < r*a holds +(x,r).p <
  a;

theorem 
  for p being Point of TOP-REAL 2 st p`2 >= 0 for x,a being real
number, r being positive real number st 0 <= a & a < 1 & |.p-|[x,r*a]|.| > r*
  a holds +(x,r).p > a;

theorem 
  for p being Point of TOP-REAL 2 st p`2 >= 0 for x,a,b being real
number, r being positive real number st 0 <= a & b <= 1 & +(x,r).p in ].a,b.[
ex r1 being positive real number st r1 <= p`2 & Ball(p,r1) c= +(x,r)"].a,b.[;

theorem 
  for x being real number, a,r being positive real number holds
  Ball(|[x,r*a]|,r*a) c= +(x,r)"].0,a.[;

theorem 
  for x being real number, a,r being positive real number holds
  Ball(|[x,r*a]|,r*a) \/ {|[x,0]|} c= +(x,r)"[.0,a.[;

theorem 
  for p being Point of TOP-REAL 2 st p`2 >= 0 for x,a being real
number, r being positive real number st 0 < +(x,r).p & +(x,r).p < a & a <= 1
  holds p in Ball(|[x,r*a]|,r*a);

theorem 
  for p being Point of TOP-REAL 2 st p`2 > 0 for x,a being real
  number, r being positive real number st 0 <= a & a < +(x,r).p ex r1 being
  positive real number st r1 <= p`2 & Ball(p,r1) c= +(x,r)"].a,1.];

theorem 
  for p being Point of TOP-REAL 2 st p`2 = 0 for x being real
  number, r being positive real number st +(x,r).p = 1 ex r1 being positive
  real number st Ball(|[p`1,r1]|,r1) \/ {p} c= +(x,r)"{1};

theorem 
  for T being non empty TopSpace, S being SubSpace of T for B
being Basis of T holds {A/\[#]S where A is Subset of T: A in B & A meets [#]S}
  is Basis of S;

theorem 
  {].a,b.[ where a,b is Real: a < b} is Basis of R^1;

theorem 
  for T being TopSpace for U,V being Subset of T for B being set
  st U in B & V in B & B \/ {U \/ V} is Basis of T holds B is Basis of T;

theorem 
  {[.0,a.[ where a is Real: 0 < a & a <= 1} \/ {].a,1.] where a is
  Real: 0 <= a & a < 1} \/ {].a,b.[ where a,b is Real: 0 <= a & a < b & b <= 1}
  is Basis of I[01];

theorem 
  for T being non empty TopSpace for f being Function of T, I[01]
holds f is continuous iff for a,b being real number st 0 <= a & a < 1 & 0 < b &
  b <= 1 holds f"[.0,b.[ is open & f"].a,1.] is open;

registration
  let x be real number, r be positive real number;
  cluster +(x,r) -> continuous;
end;

theorem 
  for U being Subset of Niemytzki-plane for x,r st U = Ball(|[x,r
]|,r) \/ {|[x,0]|} ex f being continuous Function of Niemytzki-plane, I[01] st
f.(|[x,0]|) = 0 & for a,b being real number holds (|[a,b]| in U` implies f.(|[a
,b]|) = 1) & (|[a,b]| in U\{|[x,0]|} implies f.(|[a,b]|) = |.|[x,0]|-|[a,b]|.|
  ^2/(2*r*b));



definition
  let x,y be real number, r be positive real number;
  func +(x,y,r) -> Function of Niemytzki-plane, I[01] means


  for a being
real number, b being non negative real number holds (not |[a,b]| in Ball(|[x,
y]|,r) implies it.(|[a,b]|) = 1) & (|[a,b]| in Ball(|[x,y]|,r) implies it.(|[a,
  b]|) = |.|[x,y]|-|[a,b]|.|/r);
end;

theorem 
  for p being Point of TOP-REAL 2 st p`2 >= 0 for x being real
  number, y being non negative real number for r being positive real number
  holds +(x,y,r).p = 0 iff p = |[x,y]|;

theorem 
  for x being real number, y being non negative real number for
r,a being positive real number st a <= 1 holds +(x,y,r)"[.0,a.[ = Ball(|[x,y
  ]|,r*a) /\ y>=0-plane;

theorem 
  for p being Point of TOP-REAL 2 st p`2 > 0 for x being real
number, a being non negative real number for y,r being positive real number
  st +(x,y,r).p > a holds |.|[x,y]|-p.| > r*a & Ball(p,|.|[x,y]|-p.|-r*a) /\
  y>=0-plane c= +(x,y,r)"].a,1.];

theorem 
  for p being Point of TOP-REAL 2 st p`2 = 0 for x being real
number, a being non negative real number for y,r being positive real number
st +(x,y,r).p > a holds |.|[x,y]|-p.| > r*a & ex r1 being positive real number
 st r1 = (|.|[x,y]|-p.|-r*a)/2 & Ball(|[p`1,r1]|,r1) \/ {p} c= +(x,y,r)"].a,1
  .];

registration
  let x be real number;
  let y,r be positive real number;
  cluster +(x,y,r) -> continuous;
end;

theorem 
  for U being Subset of Niemytzki-plane for x,y,r st y > 0 & U =
Ball(|[x,y]|,r) /\ y>=0-plane ex f being continuous Function of Niemytzki-plane
  , I[01] st f.(|[x,y]|) = 0 & for a,b being real number holds (|[a,b]| in U`
implies f.(|[a,b]|) = 1) & (|[a,b]| in U implies f.(|[a,b]|) = |.|[x,y]|-|[a,b
  ]|.|/r);

theorem 
  Niemytzki-plane is T_1;

theorem 
  Niemytzki-plane is Tychonoff;














begin 




scheme 

  1AryBooleEx {F(set) -> Element of BOOLEAN}: ex f being Function of 1
-tuples_on BOOLEAN, BOOLEAN st for x being Element of BOOLEAN holds f.<*x*> = F
  (x);

scheme 

  1AryBooleUniq {F(set) -> Element of BOOLEAN}: for f1,f2 being Function of 1
-tuples_on BOOLEAN, BOOLEAN st (for x being Element of BOOLEAN holds f1.<*x*> =
  F(x)) & (for x being Element of BOOLEAN holds f2.<*x*> = F(x)) holds f1 = f2;

scheme 

  1AryBooleDef {F(set) -> Element of BOOLEAN}: (ex f being Function of 1
-tuples_on BOOLEAN, BOOLEAN st for x being Element of BOOLEAN holds f.<*x*> = F
(x)) & for f1,f2 being Function of 1-tuples_on BOOLEAN, BOOLEAN st (for x being
  Element of BOOLEAN holds f1.<*x*> = F(x)) & (for x being Element of BOOLEAN
  holds f2.<*x*> = F(x)) holds f1 = f2;




definition
  func inv1 -> Function of 1-tuples_on BOOLEAN, BOOLEAN means


  for x being Element of BOOLEAN holds it.<*x*> = 'not' x;
end;

theorem 
  for x being Element of BOOLEAN holds inv1.<*x*> = 'not' x & inv1.
  <*x*> = nand2.<*x,x*> & inv1.<*0*> = 1 & inv1.<*1*> = 0;

definition
  func buf1 -> Function of 1-tuples_on BOOLEAN, BOOLEAN means


  for x being Element of BOOLEAN holds it.<*x*> = x;
end;

theorem 
  for x being Element of BOOLEAN holds buf1.<*x*> = x & buf1.<*x*> =
  and2.<*x,x*> & buf1.<*0*> = 0 & buf1.<*1*> = 1;




definition
  func and2c -> Function of 2-tuples_on BOOLEAN, BOOLEAN means


  for x,y being Element of BOOLEAN holds it.<*x,y*> = x '&' 'not' y;
end;

theorem 
  for x,y being Element of BOOLEAN holds and2c.<*x,y*> = x '&' 'not' y &
and2c.<*x,y*> = and2a.<*y,x*> & and2c.<*x,y*> = nor2a.<*x,y*> & and2c.<*0,0*>=0
  & and2c.<*0,1*>=0 & and2c.<*1,0*>=1 & and2c.<*1,1*>=0;

definition
  func xor2c -> Function of 2-tuples_on BOOLEAN, BOOLEAN means


  for x,y being Element of BOOLEAN holds it.<*x,y*> = x 'xor' 'not' y;
end;

theorem 
  for x,y being Element of BOOLEAN holds xor2c.<*x,y*> = x 'xor'
'not' y & xor2c.<*x,y*> = xor2a.<*x,y*> & xor2c.<*x,y*> = or2.<*and2b.<*x,y*>,
and2.<*x,y*> *> & xor2c.<*0,0*>=1 & xor2c.<*0,1*>=0 & xor2c.<*1,0*>=0 & xor2c.
  <*1,1*>=1;

theorem 
  for x,y being Element of BOOLEAN holds inv1.<* xor2.<*x,y*> *> = xor2a
.<*x,y*> & inv1.<* xor2.<*x,y*> *> = xor2c.<*x,y*> & xor2.<* inv1.<*x*>, inv1.
  <*y*> *> = xor2.<*x,y*>;

theorem 
  for x,y,z being Element of BOOLEAN holds inv1.<* xor2.<* xor2c.<*x,y*>
  , z*> *> = xor2c.<* xor2c.<*x,y*>, z*>;

theorem 
  for x,y,z being Element of BOOLEAN holds ( 'not' x 'xor' y ) 'xor'
  'not' z = ( x 'xor' 'not' y ) 'xor' 'not' z;

theorem 
  for x,y,z being Element of BOOLEAN holds xor2c.<* xor2a.<*x,y*>, z *>
  = xor2c.<* xor2c.<*x,y*>, z *>;

theorem 
  for x,y,z being Element of BOOLEAN holds inv1.<* xor2c.<* xor2b.<*x,y
  *>, z*> *> = xor2.<* xor2.<*x,y*>, z*>;





begin 





















definition
  let x,y,z be set;
  func GFA0CarryIStr(x,y,z) -> unsplit gate`1=arity gate`2isBoolean non void
  strict non empty ManySortedSign equals

  1GateCircStr(<*x,y*>,and2) +*
  1GateCircStr(<*y,z*>,and2) +* 1GateCircStr(<*z,x*>,and2);
end;

definition
  let x,y,z be set;
  func GFA0CarryICirc(x,y,z) -> strict Boolean gate`2=den Circuit of
  GFA0CarryIStr(x,y,z) equals

  1GateCircuit(x,y,and2) +* 1GateCircuit(y,z,and2) +*
  1GateCircuit(z,x,and2);
end;

definition
  let x,y,z be set;
  func GFA0CarryStr(x,y,z) -> unsplit gate`1=arity gate`2isBoolean non void
  strict non empty ManySortedSign equals

  GFA0CarryIStr(x,y,z) +* 1GateCircStr(<*[
  <*x,y*>,and2], [<*y,z*>,and2], [<*z,x*>,and2]*>,or3);
end;

definition
  let x,y,z be set;
  func GFA0CarryCirc(x,y,z) -> strict Boolean gate`2=den Circuit of
  GFA0CarryStr(x,y,z) equals

  GFA0CarryICirc(x,y,z) +* 1GateCircuit([<*x,y*>,and2]
  ,[<*y,z*>,and2],[<*z,x*>,and2],or3);
end;

definition
  let x,y,z be set;
  func GFA0CarryOutput(x,y,z) -> Element of InnerVertices GFA0CarryStr(x,y,z)
  equals

  [<*[<*x,y*>,and2],[<*y,z*>,and2],[<*z,x*>,and2]*>,or3];
end;







theorem 
  for x,y,z being set holds InnerVertices GFA0CarryIStr(x,y,z) = {
  [<*x,y*>,and2], [<*y,z*>,and2], [<*z,x*>,and2]};

theorem 
  for x,y,z being set holds InnerVertices GFA0CarryStr(x,y,z) = {[
  <*x,y*>,and2], [<*y,z*>,and2], [<*z,x*>,and2]} \/ {GFA0CarryOutput(x,y,z)};

theorem 
  for x,y,z being set holds InnerVertices GFA0CarryStr(x,y,z) is Relation;




theorem 
  for x,y,z being set st x <> [<*y,z*>,and2] & y <> [<*z,x*>,and2]
  & z <> [<*x,y*>,and2] holds InputVertices GFA0CarryIStr(x,y,z) = {x,y,z};

theorem 
  for x,y,z being set st x <> [<*y,z*>,and2] & y <> [<*z,x*>,and2]
  & z <> [<*x,y*>,and2] holds InputVertices GFA0CarryStr(x,y,z) = {x,y,z};

theorem 
  for x,y,z being non pair set holds InputVertices GFA0CarryStr(x,y,z)
  is without_pairs;




theorem 
  for x,y,z being set holds x in the carrier of GFA0CarryStr(x,y,z
) & y in the carrier of GFA0CarryStr(x,y,z) & z in the carrier of GFA0CarryStr(
x,y,z) & [<*x,y*>,and2] in the carrier of GFA0CarryStr(x,y,z) & [<*y,z*>,and2]
  in the carrier of GFA0CarryStr(x,y,z) & [<*z,x*>,and2] in the carrier of
GFA0CarryStr(x,y,z) & [<*[<*x,y*>,and2],[<*y,z*>,and2],[<*z,x*>,and2]*>,or3] in
  the carrier of GFA0CarryStr(x,y,z);

theorem 
  for x,y,z being set holds [<*x,y*>,and2] in InnerVertices
GFA0CarryStr(x,y,z) & [<*y,z*>,and2] in InnerVertices GFA0CarryStr(x,y,z) & [<*
  z,x*>,and2] in InnerVertices GFA0CarryStr(x,y,z) & GFA0CarryOutput(x,y,z) in
  InnerVertices GFA0CarryStr(x,y,z);

theorem 
  for x,y,z being set st x <> [<*y,z*>,and2] & y <> [<*z,x*>,and2]
  & z <> [<*x,y*>,and2] holds x in InputVertices GFA0CarryStr(x,y,z) & y in
  InputVertices GFA0CarryStr(x,y,z) & z in InputVertices GFA0CarryStr(x,y,z);

theorem 
  for x,y,z being non pair set holds InputVertices GFA0CarryStr(x,
  y,z) = {x,y,z};





theorem 
  for x,y,z being set for s being State of GFA0CarryCirc(x,y,z)
for a1,a2,a3 being Element of BOOLEAN st a1 = s.x & a2 = s.y & a3 = s.z holds (
Following s).[<*x,y*>,and2] = a1 '&' a2 & (Following s).[<*y,z*>,and2] = a2 '&'
  a3 & (Following s).[<*z,x*>,and2] = a3 '&' a1;

theorem 
  for x,y,z being set for s being State of GFA0CarryCirc(x,y,z)
for a1,a2,a3 being Element of BOOLEAN st a1 = s.[<*x,y*>,and2] & a2 = s.[<*y,z
  *>,and2] & a3 = s.[<*z,x*>,and2] holds (Following s).GFA0CarryOutput(x,y,z) =
  a1 'or' a2 'or' a3;

theorem 
  for x,y,z being set st x <> [<*y,z*>,and2] & y <> [<*z,x*>,and2]
  & z <> [<*x,y*>,and2] for s being State of GFA0CarryCirc(x,y,z) for a1,a2,a3
being Element of BOOLEAN st a1 = s.x & a2 = s.y & a3 = s.z holds Following(s,2)
  .GFA0CarryOutput(x,y,z) = (a1 '&' a2) 'or' (a2 '&' a3) 'or' (a3 '&' a1) &
Following(s,2).[<*x,y*>,and2] = a1 '&' a2 & Following(s,2).[<*y,z*>,and2] = a2
  '&' a3 & Following(s,2).[<*z,x*>,and2] = a3 '&' a1;

theorem 
  for x,y,z being set st x <> [<*y,z*>,and2] & y <> [<*z,x*>,and2]
& z <> [<*x,y*>,and2] for s being State of GFA0CarryCirc(x,y,z) holds Following
  (s,2) is stable;






definition
  let x,y,z be set;
  func GFA0AdderStr(x,y,z) -> unsplit gate`1=arity gate`2isBoolean non void
  strict non empty ManySortedSign equals

  2GatesCircStr(x,y,z, xor2);
end;

definition
  let x,y,z be set;
  func GFA0AdderCirc(x,y,z) -> strict Boolean gate`2=den Circuit of
  GFA0AdderStr(x,y,z) equals

  2GatesCircuit(x,y,z, xor2);
end;

definition
  let x,y,z be set;
  func GFA0AdderOutput(x,y,z) -> Element of InnerVertices GFA0AdderStr(x,y,z)
  equals

  2GatesCircOutput(x,y,z, xor2);
end;







theorem 
  for x,y,z being set holds InnerVertices GFA0AdderStr(x,y,z) = {[
  <*x,y*>,xor2]} \/ {GFA0AdderOutput(x,y,z)};




theorem 
  for x,y,z being set holds x in the carrier of GFA0AdderStr(x,y,z) & y
in the carrier of GFA0AdderStr(x,y,z) & z in the carrier of GFA0AdderStr(x,y,z)
& [<*x,y*>,xor2] in the carrier of GFA0AdderStr(x,y,z) & [<*[<*x,y*>,xor2], z*>
  , xor2] in the carrier of GFA0AdderStr(x,y,z);

theorem 
  for x,y,z being set holds [<*x,y*>,xor2] in InnerVertices
GFA0AdderStr(x,y,z) & GFA0AdderOutput(x,y,z) in InnerVertices GFA0AdderStr(x,y,
  z);

theorem 
  for x,y,z being set st z <> [<*x,y*>, xor2] holds x in
InputVertices GFA0AdderStr(x,y,z) & y in InputVertices GFA0AdderStr(x,y,z) & z
  in InputVertices GFA0AdderStr(x,y,z);





theorem 
  for x,y,z being set st z <> [<*x,y*>, xor2] for s being State of
GFA0AdderCirc(x,y,z) for a1,a2,a3 being Element of BOOLEAN st a1 = s.x & a2 = s
.y & a3 = s.z holds (Following s).[<*x,y*>,xor2] = a1 'xor' a2 & (Following s).
  x = a1 & (Following s).y = a2 & (Following s).z = a3;

theorem 
  for x,y,z being set st z <> [<*x,y*>, xor2] for s being State of
GFA0AdderCirc(x,y,z) for a1a2,a1,a2,a3 being Element of BOOLEAN st a1a2 = s.[<*
x,y*>,xor2] & a3 = s.z holds (Following s).GFA0AdderOutput(x,y,z) = a1a2 'xor'
  a3;

theorem 
  for x,y,z being set st z <> [<*x,y*>, xor2] for s being State of
GFA0AdderCirc(x,y,z) for a1,a2,a3 being Element of BOOLEAN st a1 = s.x & a2 = s
  .y & a3 = s.z holds Following(s,2).GFA0AdderOutput(x,y,z) = a1 'xor' a2 'xor'
  a3 & Following(s,2).[<*x,y*>,xor2] = a1 'xor' a2 & Following(s,2).x = a1 &
  Following(s,2).y = a2 & Following(s,2).z = a3;






definition
  let x,y,z be set;
  func BitGFA0Str(x,y,z) -> unsplit gate`1=arity gate`2isBoolean non void
  strict non empty ManySortedSign equals

  GFA0AdderStr(x,y,z) +* GFA0CarryStr(x,y,
  z);
end;

definition
  let x,y,z be set;
  func BitGFA0Circ(x,y,z) -> strict Boolean gate`2=den Circuit of BitGFA0Str(x
  ,y,z) equals

  GFA0AdderCirc(x,y,z) +* GFA0CarryCirc(x,y,z);
end;







theorem 
  for x,y,z being set holds InnerVertices BitGFA0Str(x,y,z) = {[<*
x,y*>,xor2]} \/ {GFA0AdderOutput(x,y,z)} \/ {[<*x,y*>,and2], [<*y,z*>,and2], [
  <*z,x*>,and2]} \/ {GFA0CarryOutput(x,y,z)};

theorem 
  for x,y,z being set holds InnerVertices BitGFA0Str(x,y,z) is Relation;




theorem 
  for x,y,z being set st z <> [<*x,y*>,xor2] & x <> [<*y,z*>,and2]
& y <> [<*z,x*>,and2] & z <> [<*x,y*>,and2] holds InputVertices BitGFA0Str(x,y,
  z) = {x,y,z};

theorem 
  for x,y,z being non pair set holds InputVertices BitGFA0Str(x,y, z) = {x,y,z}
;

theorem 
  for x,y,z being non pair set holds InputVertices BitGFA0Str(x,y,z) is
  without_pairs;




theorem 
  for x,y,z being set holds x in the carrier of BitGFA0Str(x,y,z) & y in
the carrier of BitGFA0Str(x,y,z) & z in the carrier of BitGFA0Str(x,y,z) & [<*x
,y*>,xor2] in the carrier of BitGFA0Str(x,y,z) & [<*[<*x,y*>,xor2],z*>,xor2] in
the carrier of BitGFA0Str(x,y,z) & [<*x,y*>,and2] in the carrier of BitGFA0Str(
x,y,z) & [<*y,z*>,and2] in the carrier of BitGFA0Str(x,y,z) & [<*z,x*>,and2] in
  the carrier of BitGFA0Str(x,y,z) & [<*[<*x,y*>,and2],[<*y,z*>,and2],[<*z,x*>,
  and2]*>,or3] in the carrier of BitGFA0Str(x,y,z);

theorem 
  for x,y,z being set holds [<*x,y*>,xor2] in InnerVertices
BitGFA0Str(x,y,z) & GFA0AdderOutput(x,y,z) in InnerVertices BitGFA0Str(x,y,z) &
  [<*x,y*>,and2] in InnerVertices BitGFA0Str(x,y,z) & [<*y,z*>,and2] in
InnerVertices BitGFA0Str(x,y,z) & [<*z,x*>,and2] in InnerVertices BitGFA0Str(x,
  y,z) & GFA0CarryOutput(x,y,z) in InnerVertices BitGFA0Str(x,y,z);

theorem 
  for x,y,z being set st z <> [<*x,y*>,xor2] & x <> [<*y,z*>,and2] & y
<> [<*z,x*>,and2] & z <> [<*x,y*>,and2] holds x in InputVertices BitGFA0Str(x,y
,z) & y in InputVertices BitGFA0Str(x,y,z) & z in InputVertices BitGFA0Str(x,y,
  z);





definition
  let x,y,z be set;
  func BitGFA0CarryOutput(x,y,z) -> Element of InnerVertices BitGFA0Str(x,y,z)
  equals

  [<*[<*x,y*>,and2],[<*y,z*>,and2],[<*z,x*>,and2]*>,or3];
end;

definition
  let x,y,z be set;
  func BitGFA0AdderOutput(x,y,z) -> Element of InnerVertices BitGFA0Str(x,y,z)
  equals

  2GatesCircOutput(x,y,z, xor2);
end;





theorem 
  for x,y,z being set st z <> [<*x,y*>,xor2] & x <> [<*y,z*>,and2] & y
<> [<*z,x*>,and2] & z <> [<*x,y*>,and2] for s being State of BitGFA0Circ(x,y,z)
  for a1,a2,a3 being Element of BOOLEAN st a1 = s.x & a2 = s.y & a3 = s.z holds
Following(s,2).GFA0AdderOutput(x,y,z) = a1 'xor' a2 'xor' a3 & Following(s,2).
  GFA0CarryOutput(x,y,z) = a1 '&' a2 'or' a2 '&' a3 'or' a3 '&' a1;

theorem 
  for x,y,z being set st z <> [<*x,y*>,xor2] & x <> [<*y,z*>,and2] & y
<> [<*z,x*>,and2] & z <> [<*x,y*>,and2] for s being State of BitGFA0Circ(x,y,z)
  holds Following(s,2) is stable;





begin 





















definition
  let x,y,z be set;
  func GFA1CarryIStr(x,y,z) -> unsplit gate`1=arity gate`2isBoolean non void
  strict non empty ManySortedSign equals

  1GateCircStr(<*x,y*>,and2c) +*
  1GateCircStr(<*y,z*>,and2a) +* 1GateCircStr(<*z,x*>,and2);
end;

definition
  let x,y,z be set;
  func GFA1CarryICirc(x,y,z) -> strict Boolean gate`2=den Circuit of
  GFA1CarryIStr(x,y,z) equals

  1GateCircuit(x,y,and2c) +* 1GateCircuit(y,z,and2a)
  +* 1GateCircuit(z,x,and2);
end;

definition
  let x,y,z be set;
  func GFA1CarryStr(x,y,z) -> unsplit gate`1=arity gate`2isBoolean non void
  strict non empty ManySortedSign equals

  GFA1CarryIStr(x,y,z) +* 1GateCircStr(<*[
  <*x,y*>,and2c], [<*y,z*>,and2a], [<*z,x*>,and2]*>,or3);
end;

definition
  let x,y,z be set;
  func GFA1CarryCirc(x,y,z) -> strict Boolean gate`2=den Circuit of
  GFA1CarryStr(x,y,z) equals

  GFA1CarryICirc(x,y,z) +* 1GateCircuit([<*x,y*>,and2c
  ],[<*y,z*>,and2a],[<*z,x*>,and2],or3);
end;

definition
  let x,y,z be set;
  func GFA1CarryOutput(x,y,z) -> Element of InnerVertices GFA1CarryStr(x,y,z)
  equals

  [<*[<*x,y*>,and2c],[<*y,z*>,and2a],[<*z,x*>,and2]*>,or3];
end;







theorem 
  for x,y,z being set holds InnerVertices GFA1CarryIStr(x,y,z) = {
  [<*x,y*>,and2c], [<*y,z*>,and2a], [<*z,x*>,and2]};

theorem 
  for x,y,z being set holds InnerVertices GFA1CarryStr(x,y,z) = {[
  <*x,y*>,and2c], [<*y,z*>,and2a], [<*z,x*>,and2]} \/ {GFA1CarryOutput(x,y,z)};

theorem 
  for x,y,z being set holds InnerVertices GFA1CarryStr(x,y,z) is Relation;




theorem 
  for x,y,z being set st x <> [<*y,z*>,and2a] & y <> [<*z,x*>,and2
  ] & z <> [<*x,y*>,and2c] holds InputVertices GFA1CarryIStr(x,y,z) = {x,y,z};

theorem 
  for x,y,z being set st x <> [<*y,z*>,and2a] & y <> [<*z,x*>,and2
  ] & z <> [<*x,y*>,and2c] holds InputVertices GFA1CarryStr(x,y,z) = {x,y,z};

theorem 
  for x,y,z being non pair set holds InputVertices GFA1CarryStr(x,y,z)
  is without_pairs;




theorem 
  for x,y,z being set holds x in the carrier of GFA1CarryStr(x,y,z
) & y in the carrier of GFA1CarryStr(x,y,z) & z in the carrier of GFA1CarryStr(
x,y,z) & [<*x,y*>,and2c] in the carrier of GFA1CarryStr(x,y,z) & [<*y,z*>,and2a
  ] in the carrier of GFA1CarryStr(x,y,z) & [<*z,x*>,and2] in the carrier of
GFA1CarryStr(x,y,z) & [<*[<*x,y*>,and2c],[<*y,z*>,and2a],[<*z,x*>,and2]*>,or3]
  in the carrier of GFA1CarryStr(x,y,z);

theorem 
  for x,y,z being set holds [<*x,y*>,and2c] in InnerVertices
GFA1CarryStr(x,y,z) & [<*y,z*>,and2a] in InnerVertices GFA1CarryStr(x,y,z) & [
<*z,x*>,and2] in InnerVertices GFA1CarryStr(x,y,z) & GFA1CarryOutput(x,y,z) in
  InnerVertices GFA1CarryStr(x,y,z);

theorem 
  for x,y,z being set st x <> [<*y,z*>,and2a] & y <> [<*z,x*>,and2
  ] & z <> [<*x,y*>,and2c] holds x in InputVertices GFA1CarryStr(x,y,z) & y in
  InputVertices GFA1CarryStr(x,y,z) & z in InputVertices GFA1CarryStr(x,y,z);

theorem 
  for x,y,z being non pair set holds InputVertices GFA1CarryStr(x,
  y,z) = {x,y,z};





theorem 
  for x,y,z being set for s being State of GFA1CarryCirc(x,y,z)
for a1,a2,a3 being Element of BOOLEAN st a1 = s.x & a2 = s.y & a3 = s.z holds (
Following s).[<*x,y*>,and2c] = a1 '&' 'not' a2 & (Following s).[<*y,z*>,and2a]
  = 'not' a2 '&' a3 & (Following s).[<*z,x*>,and2] = a3 '&' a1;

theorem 
  for x,y,z being set for s being State of GFA1CarryCirc(x,y,z)
for a1,a2,a3 being Element of BOOLEAN st a1 = s.[<*x,y*>,and2c] & a2 = s.[<*y,z
*>,and2a] & a3 = s.[<*z,x*>,and2] holds (Following s).GFA1CarryOutput(x,y,z) =
  a1 'or' a2 'or' a3;

theorem 
  for x,y,z being set st x <> [<*y,z*>,and2a] & y <> [<*z,x*>,and2
] & z <> [<*x,y*>,and2c] for s being State of GFA1CarryCirc(x,y,z) for a1,a2,a3
being Element of BOOLEAN st a1 = s.x & a2 = s.y & a3 = s.z holds Following(s,2)
.GFA1CarryOutput(x,y,z) = (a1 '&' 'not' a2) 'or' ('not' a2 '&' a3) 'or' (a3 '&'
a1) & Following(s,2).[<*x,y*>,and2c] = a1 '&' 'not' a2 & Following(s,2).[<*y,z
  *>,and2a] = 'not' a2 '&' a3 & Following(s,2).[<*z,x*>,and2] = a3 '&' a1;

theorem 
  for x,y,z being set st x <> [<*y,z*>,and2a] & y <> [<*z,x*>,and2
  ] & z <> [<*x,y*>,and2c] for s being State of GFA1CarryCirc(x,y,z) holds
  Following(s,2) is stable;






definition
  let x,y,z be set;
  func GFA1AdderStr(x,y,z) -> unsplit gate`1=arity gate`2isBoolean non void
  strict non empty ManySortedSign equals

  2GatesCircStr(x,y,z, xor2c);
end;

definition
  let x,y,z be set;
  func GFA1AdderCirc(x,y,z) -> strict Boolean gate`2=den Circuit of
  GFA1AdderStr(x,y,z) equals

  2GatesCircuit(x,y,z, xor2c);
end;

definition
  let x,y,z be set;
  func GFA1AdderOutput(x,y,z) -> Element of InnerVertices GFA1AdderStr(x,y,z)
  equals

  2GatesCircOutput(x,y,z, xor2c);
end;







theorem 
  for x,y,z being set holds InnerVertices GFA1AdderStr(x,y,z) = {[
  <*x,y*>,xor2c]} \/ {GFA1AdderOutput(x,y,z)};




theorem 
  for x,y,z being set holds x in the carrier of GFA1AdderStr(x,y,z) & y
in the carrier of GFA1AdderStr(x,y,z) & z in the carrier of GFA1AdderStr(x,y,z)
& [<*x,y*>,xor2c] in the carrier of GFA1AdderStr(x,y,z) & [<*[<*x,y*>,xor2c], z
  *>, xor2c] in the carrier of GFA1AdderStr(x,y,z);

theorem 
  for x,y,z being set holds [<*x,y*>,xor2c] in InnerVertices
GFA1AdderStr(x,y,z) & GFA1AdderOutput(x,y,z) in InnerVertices GFA1AdderStr(x,y,
  z);

theorem 
  for x,y,z being set st z <> [<*x,y*>, xor2c] holds x in
InputVertices GFA1AdderStr(x,y,z) & y in InputVertices GFA1AdderStr(x,y,z) & z
  in InputVertices GFA1AdderStr(x,y,z);





theorem 
  for x,y,z being set st z <> [<*x,y*>, xor2c] for s being State
of GFA1AdderCirc(x,y,z) for a1,a2,a3 being Element of BOOLEAN st a1 = s.x & a2
  = s.y & a3 = s.z holds (Following s).[<*x,y*>,xor2c] = a1 'xor' 'not' a2 & (
  Following s).x = a1 & (Following s).y = a2 & (Following s).z = a3;

theorem 
  for x,y,z being set st z <> [<*x,y*>, xor2c] for s being State
of GFA1AdderCirc(x,y,z) for a1a2,a1,a2,a3 being Element of BOOLEAN st a1a2 = s.
  [<*x,y*>,xor2c] & a3 = s.z holds (Following s).GFA1AdderOutput(x,y,z) = a1a2
  'xor' 'not' a3;

theorem 
  for x,y,z being set st z <> [<*x,y*>, xor2c] for s being State
of GFA1AdderCirc(x,y,z) for a1,a2,a3 being Element of BOOLEAN st a1 = s.x & a2
  = s.y & a3 = s.z holds Following(s,2).GFA1AdderOutput(x,y,z) = a1 'xor' 'not'
  a2 'xor' 'not' a3 & Following(s,2).[<*x,y*>,xor2c] = a1 'xor' 'not' a2 &
  Following(s,2).x = a1 & Following(s,2).y = a2 & Following(s,2).z = a3;

theorem 
  for x,y,z being set st z <> [<*x,y*>, xor2c] for s being State
of GFA1AdderCirc(x,y,z) for a1,a2,a3 being Element of BOOLEAN st a1 = s.x & a2
= s.y & a3 = s.z holds Following(s,2).GFA1AdderOutput(x,y,z) = 'not' (a1 'xor'
  'not' a2 'xor' a3);






definition
  let x,y,z be set;
  func BitGFA1Str(x,y,z) -> unsplit gate`1=arity gate`2isBoolean non void
  strict non empty ManySortedSign equals

  GFA1AdderStr(x,y,z) +* GFA1CarryStr(x,y,
  z);
end;

definition
  let x,y,z be set;
  func BitGFA1Circ(x,y,z) -> strict Boolean gate`2=den Circuit of BitGFA1Str(x
  ,y,z) equals

  GFA1AdderCirc(x,y,z) +* GFA1CarryCirc(x,y,z);
end;







theorem 
  for x,y,z being set holds InnerVertices BitGFA1Str(x,y,z) = {[<*
x,y*>,xor2c]} \/ {GFA1AdderOutput(x,y,z)} \/ {[<*x,y*>,and2c], [<*y,z*>,and2a],
  [<*z,x*>,and2]} \/ {GFA1CarryOutput(x,y,z)};

theorem 
  for x,y,z being set holds InnerVertices BitGFA1Str(x,y,z) is Relation;




theorem 
  for x,y,z being set st z <> [<*x,y*>,xor2c] & x <> [<*y,z*>,
  and2a] & y <> [<*z,x*>,and2] & z <> [<*x,y*>,and2c] holds InputVertices
  BitGFA1Str(x,y,z) = {x,y,z};

theorem 
  for x,y,z being non pair set holds InputVertices BitGFA1Str(x,y, z) = {x,y,z}
;

theorem 
  for x,y,z being non pair set holds InputVertices BitGFA1Str(x,y,z) is
  without_pairs;




theorem 
  for x,y,z being set holds x in the carrier of BitGFA1Str(x,y,z) & y in
the carrier of BitGFA1Str(x,y,z) & z in the carrier of BitGFA1Str(x,y,z) & [<*x
,y*>,xor2c] in the carrier of BitGFA1Str(x,y,z) & [<*[<*x,y*>,xor2c],z*>,xor2c]
  in the carrier of BitGFA1Str(x,y,z) & [<*x,y*>,and2c] in the carrier of
BitGFA1Str(x,y,z) & [<*y,z*>,and2a] in the carrier of BitGFA1Str(x,y,z) & [<*z,
  x*>,and2] in the carrier of BitGFA1Str(x,y,z) & [<*[<*x,y*>,and2c],[<*y,z*>,
  and2a],[<*z,x*>,and2]*>,or3] in the carrier of BitGFA1Str(x,y,z);

theorem 
  for x,y,z being set holds [<*x,y*>,xor2c] in InnerVertices
BitGFA1Str(x,y,z) & GFA1AdderOutput(x,y,z) in InnerVertices BitGFA1Str(x,y,z) &
  [<*x,y*>,and2c] in InnerVertices BitGFA1Str(x,y,z) & [<*y,z*>,and2a] in
InnerVertices BitGFA1Str(x,y,z) & [<*z,x*>,and2] in InnerVertices BitGFA1Str(x,
  y,z) & GFA1CarryOutput(x,y,z) in InnerVertices BitGFA1Str(x,y,z);

theorem 
  for x,y,z being set st z <> [<*x,y*>,xor2c] & x <> [<*y,z*>,and2a] & y
<> [<*z,x*>,and2] & z <> [<*x,y*>,and2c] holds x in InputVertices BitGFA1Str(x,
y,z) & y in InputVertices BitGFA1Str(x,y,z) & z in InputVertices BitGFA1Str(x,y
  ,z);





definition
  let x,y,z be set;
  func BitGFA1CarryOutput(x,y,z) -> Element of InnerVertices BitGFA1Str(x,y,z)
  equals

  [<*[<*x,y*>,and2c],[<*y,z*>,and2a],[<*z,x*>,and2]*>,or3];
end;

definition
  let x,y,z be set;
  func BitGFA1AdderOutput(x,y,z) -> Element of InnerVertices BitGFA1Str(x,y,z)
  equals

  2GatesCircOutput(x,y,z, xor2c);
end;





theorem 
  for x,y,z being set st z <> [<*x,y*>,xor2c] & x <> [<*y,z*>,and2a] & y
<> [<*z,x*>,and2] & z <> [<*x,y*>,and2c] for s being State of BitGFA1Circ(x,y,z
) for a1,a2,a3 being Element of BOOLEAN st a1 = s.x & a2 = s.y & a3 = s.z holds
  Following(s,2).GFA1AdderOutput(x,y,z) = 'not' (a1 'xor' 'not' a2 'xor' a3) &
Following(s,2).GFA1CarryOutput(x,y,z) = (a1 '&' 'not' a2) 'or' ('not' a2 '&' a3
  ) 'or' (a3 '&' a1);

theorem 
  for x,y,z being set st z <> [<*x,y*>,xor2c] & x <> [<*y,z*>,and2a] & y
<> [<*z,x*>,and2] & z <> [<*x,y*>,and2c] for s being State of BitGFA1Circ(x,y,z
  ) holds Following(s,2) is stable;





begin 





















definition
  let x,y,z be set;
  func GFA2CarryIStr(x,y,z) -> unsplit gate`1=arity gate`2isBoolean non void
  strict non empty ManySortedSign equals

  1GateCircStr(<*x,y*>,and2a) +*
  1GateCircStr(<*y,z*>,and2c) +* 1GateCircStr(<*z,x*>,and2b);
end;

definition
  let x,y,z be set;
  func GFA2CarryICirc(x,y,z) -> strict Boolean gate`2=den Circuit of
  GFA2CarryIStr(x,y,z) equals

  1GateCircuit(x,y,and2a) +* 1GateCircuit(y,z,and2c)
  +* 1GateCircuit(z,x,and2b);
end;

definition
  let x,y,z be set;
  func GFA2CarryStr(x,y,z) -> unsplit gate`1=arity gate`2isBoolean non void
  strict non empty ManySortedSign equals

  GFA2CarryIStr(x,y,z) +* 1GateCircStr(<*[
  <*x,y*>,and2a], [<*y,z*>,and2c], [<*z,x*>,and2b]*>,nor3);
end;

definition
  let x,y,z be set;
  func GFA2CarryCirc(x,y,z) -> strict Boolean gate`2=den Circuit of
  GFA2CarryStr(x,y,z) equals

  GFA2CarryICirc(x,y,z) +* 1GateCircuit([<*x,y*>,and2a
  ],[<*y,z*>,and2c],[<*z,x*>,and2b],nor3);
end;

definition
  let x,y,z be set;
  func GFA2CarryOutput(x,y,z) -> Element of InnerVertices GFA2CarryStr(x,y,z)
  equals

  [<*[<*x,y*>,and2a],[<*y,z*>,and2c],[<*z,x*>,and2b]*>,nor3];
end;







theorem 
  for x,y,z being set holds InnerVertices GFA2CarryIStr(x,y,z) = {
  [<*x,y*>,and2a], [<*y,z*>,and2c], [<*z,x*>,and2b]};

theorem 
  for x,y,z being set holds InnerVertices GFA2CarryStr(x,y,z) = {[
  <*x,y*>,and2a], [<*y,z*>,and2c], [<*z,x*>,and2b]} \/ {GFA2CarryOutput(x,y,z)}
;

theorem 
  for x,y,z being set holds InnerVertices GFA2CarryStr(x,y,z) is Relation;




theorem 
  for x,y,z being set st x <> [<*y,z*>,and2c] & y <> [<*z,x*>,
and2b] & z <> [<*x,y*>,and2a] holds InputVertices GFA2CarryIStr(x,y,z) = {x,y,z
  };

theorem 
  for x,y,z being set st x <> [<*y,z*>,and2c] & y <> [<*z,x*>,
and2b] & z <> [<*x,y*>,and2a] holds InputVertices GFA2CarryStr(x,y,z) = {x,y,z}
;

theorem 
  for x,y,z being non pair set holds InputVertices GFA2CarryStr(x,y,z)
  is without_pairs;




theorem 
  for x,y,z being set holds x in the carrier of GFA2CarryStr(x,y,z
) & y in the carrier of GFA2CarryStr(x,y,z) & z in the carrier of GFA2CarryStr(
x,y,z) & [<*x,y*>,and2a] in the carrier of GFA2CarryStr(x,y,z) & [<*y,z*>,and2c
  ] in the carrier of GFA2CarryStr(x,y,z) & [<*z,x*>,and2b] in the carrier of
GFA2CarryStr(x,y,z) & [<*[<*x,y*>,and2a],[<*y,z*>,and2c],[<*z,x*>,and2b]*>,nor3
  ] in the carrier of GFA2CarryStr(x,y,z);

theorem 
  for x,y,z being set holds [<*x,y*>,and2a] in InnerVertices
GFA2CarryStr(x,y,z) & [<*y,z*>,and2c] in InnerVertices GFA2CarryStr(x,y,z) & [
<*z,x*>,and2b] in InnerVertices GFA2CarryStr(x,y,z) & GFA2CarryOutput(x,y,z) in
  InnerVertices GFA2CarryStr(x,y,z);

theorem 
  for x,y,z being set st x <> [<*y,z*>,and2c] & y <> [<*z,x*>,
and2b] & z <> [<*x,y*>,and2a] holds x in InputVertices GFA2CarryStr(x,y,z) & y
  in InputVertices GFA2CarryStr(x,y,z) & z in InputVertices GFA2CarryStr(x,y,z)
;

theorem 
  for x,y,z being non pair set holds InputVertices GFA2CarryStr(x,
  y,z) = {x,y,z};





theorem 
  for x,y,z being set for s being State of GFA2CarryCirc(x,y,z)
for a1,a2,a3 being Element of BOOLEAN st a1 = s.x & a2 = s.y & a3 = s.z holds (
Following s).[<*x,y*>,and2a] = 'not' a1 '&' a2 & (Following s).[<*y,z*>,and2c]
  = a2 '&' 'not' a3 & (Following s).[<*z,x*>,and2b] = 'not' a3 '&' 'not' a1;

theorem 
  for x,y,z being set for s being State of GFA2CarryCirc(x,y,z)
for a1,a2,a3 being Element of BOOLEAN st a1 = s.[<*x,y*>,and2a] & a2 = s.[<*y,z
*>,and2c] & a3 = s.[<*z,x*>,and2b] holds (Following s).GFA2CarryOutput(x,y,z) =
  'not' (a1 'or' a2 'or' a3);

theorem 
  for x,y,z being set st x <> [<*y,z*>,and2c] & y <> [<*z,x*>,
and2b] & z <> [<*x,y*>,and2a] for s being State of GFA2CarryCirc(x,y,z) for a1,
  a2,a3 being Element of BOOLEAN st a1 = s.x & a2 = s.y & a3 = s.z holds
  Following(s,2).GFA2CarryOutput(x,y,z) = 'not' (('not' a1 '&' a2) 'or' (a2 '&'
  'not' a3) 'or' ('not' a3 '&' 'not' a1)) & Following(s,2).[<*x,y*>,and2a] =
'not' a1 '&' a2 & Following(s,2).[<*y,z*>,and2c] = a2 '&' 'not' a3 & Following(
  s,2).[<*z,x*>,and2b] = 'not' a3 '&' 'not' a1;

theorem 
  for x,y,z being set st x <> [<*y,z*>,and2c] & y <> [<*z,x*>,
  and2b] & z <> [<*x,y*>,and2a] for s being State of GFA2CarryCirc(x,y,z) holds
  Following(s,2) is stable;






definition
  let x,y,z be set;
  func GFA2AdderStr(x,y,z) -> unsplit gate`1=arity gate`2isBoolean non void
  strict non empty ManySortedSign equals

  2GatesCircStr(x,y,z, xor2c);
end;

definition
  let x,y,z be set;
  func GFA2AdderCirc(x,y,z) -> strict Boolean gate`2=den Circuit of
  GFA2AdderStr(x,y,z) equals

  2GatesCircuit(x,y,z, xor2c);
end;

definition
  let x,y,z be set;
  func GFA2AdderOutput(x,y,z) -> Element of InnerVertices GFA2AdderStr(x,y,z)
  equals

  2GatesCircOutput(x,y,z, xor2c);
end;







theorem 
  for x,y,z being set holds InnerVertices GFA2AdderStr(x,y,z) = {
  [<*x,y*>,xor2c]} \/ {GFA2AdderOutput(x,y,z)};




theorem 
  for x,y,z being set holds x in the carrier of GFA2AdderStr(x,y,z) & y
in the carrier of GFA2AdderStr(x,y,z) & z in the carrier of GFA2AdderStr(x,y,z)
& [<*x,y*>,xor2c] in the carrier of GFA2AdderStr(x,y,z) & [<*[<*x,y*>,xor2c], z
  *>, xor2c] in the carrier of GFA2AdderStr(x,y,z);

theorem 
  for x,y,z being set holds [<*x,y*>,xor2c] in InnerVertices
GFA2AdderStr(x,y,z) & GFA2AdderOutput(x,y,z) in InnerVertices GFA2AdderStr(x,y,
  z);

theorem 
  for x,y,z being set st z <> [<*x,y*>, xor2c] holds x in InputVertices
  GFA2AdderStr(x,y,z) & y in InputVertices GFA2AdderStr(x,y,z) & z in
  InputVertices GFA2AdderStr(x,y,z);





theorem 
  for x,y,z being set st z <> [<*x,y*>, xor2c] for s being State of
GFA2AdderCirc(x,y,z) for a1,a2,a3 being Element of BOOLEAN st a1 = s.x & a2 = s
  .y & a3 = s.z holds (Following s).[<*x,y*>,xor2c] = a1 'xor' 'not' a2 & (
  Following s).x = a1 & (Following s).y = a2 & (Following s).z = a3;

theorem 
  for x,y,z being set st z <> [<*x,y*>, xor2c] for s being State of
GFA2AdderCirc(x,y,z) for a1a2,a1,a2,a3 being Element of BOOLEAN st a1a2 = s.[<*
  x,y*>,xor2c] & a1 = s.x & a2 = s.y & a3 = s.z holds (Following s).
  GFA2AdderOutput(x,y,z) = a1a2 'xor' 'not' a3;

theorem 
  for x,y,z being set st z <> [<*x,y*>, xor2c] for s being State
of GFA2AdderCirc(x,y,z) for a1,a2,a3 being Element of BOOLEAN st a1 = s.x & a2
  = s.y & a3 = s.z holds Following(s,2).GFA2AdderOutput(x,y,z) = a1 'xor' 'not'
  a2 'xor' 'not' a3 & Following(s,2).[<*x,y*>,xor2c] = a1 'xor' 'not' a2 &
  Following(s,2).x = a1 & Following(s,2).y = a2 & Following(s,2).z = a3;

theorem 
  for x,y,z being set st z <> [<*x,y*>, xor2c] for s being State
of GFA2AdderCirc(x,y,z) for a1,a2,a3 being Element of BOOLEAN st a1 = s.x & a2
  = s.y & a3 = s.z holds Following(s,2).GFA2AdderOutput(x,y,z) = 'not' a1 'xor'
  a2 'xor' 'not' a3;






definition
  let x,y,z be set;
  func BitGFA2Str(x,y,z) -> unsplit gate`1=arity gate`2isBoolean non void
  strict non empty ManySortedSign equals

  GFA2AdderStr(x,y,z) +* GFA2CarryStr(x,y,
  z);
end;

definition
  let x,y,z be set;
  func BitGFA2Circ(x,y,z) -> strict Boolean gate`2=den Circuit of BitGFA2Str(x
  ,y,z) equals

  GFA2AdderCirc(x,y,z) +* GFA2CarryCirc(x,y,z);
end;







theorem 
  for x,y,z being set holds InnerVertices BitGFA2Str(x,y,z) = {[
<*x,y*>,xor2c]} \/ {GFA2AdderOutput(x,y,z)} \/ {[<*x,y*>,and2a], [<*y,z*>,and2c
  ], [<*z,x*>,and2b]} \/ {GFA2CarryOutput(x,y,z)};

theorem 
  for x,y,z being set holds InnerVertices BitGFA2Str(x,y,z) is Relation;




theorem 
  for x,y,z being set st z <> [<*x,y*>,xor2c] & x <> [<*y,z*>,
  and2c] & y <> [<*z,x*>,and2b] & z <> [<*x,y*>,and2a] holds InputVertices
  BitGFA2Str(x,y,z) = {x,y,z};

theorem 
  for x,y,z being non pair set holds InputVertices BitGFA2Str(x,y ,z) = {x,y,z}
;

theorem 
  for x,y,z being non pair set holds InputVertices BitGFA2Str(x,y,z) is
  without_pairs;




theorem 
  for x,y,z being set holds x in the carrier of BitGFA2Str(x,y,z) & y in
the carrier of BitGFA2Str(x,y,z) & z in the carrier of BitGFA2Str(x,y,z) & [<*x
,y*>,xor2c] in the carrier of BitGFA2Str(x,y,z) & [<*[<*x,y*>,xor2c],z*>,xor2c]
  in the carrier of BitGFA2Str(x,y,z) & [<*x,y*>,and2a] in the carrier of
BitGFA2Str(x,y,z) & [<*y,z*>,and2c] in the carrier of BitGFA2Str(x,y,z) & [<*z,
  x*>,and2b] in the carrier of BitGFA2Str(x,y,z) & [<*[<*x,y*>,and2a],[<*y,z*>,
  and2c],[<*z,x*>,and2b]*>,nor3] in the carrier of BitGFA2Str(x,y,z);

theorem 
  for x,y,z being set holds [<*x,y*>,xor2c] in InnerVertices
BitGFA2Str(x,y,z) & GFA2AdderOutput(x,y,z) in InnerVertices BitGFA2Str(x,y,z) &
  [<*x,y*>,and2a] in InnerVertices BitGFA2Str(x,y,z) & [<*y,z*>,and2c] in
InnerVertices BitGFA2Str(x,y,z) & [<*z,x*>,and2b] in InnerVertices BitGFA2Str(x
  ,y,z) & GFA2CarryOutput(x,y,z) in InnerVertices BitGFA2Str(x,y,z);

theorem 
  for x,y,z being set st z <> [<*x,y*>,xor2c] & x <> [<*y,z*>,and2c] & y
<> [<*z,x*>,and2b] & z <> [<*x,y*>,and2a] holds x in InputVertices BitGFA2Str(x
,y,z) & y in InputVertices BitGFA2Str(x,y,z) & z in InputVertices BitGFA2Str(x,
  y,z);





definition
  let x,y,z be set;
  func BitGFA2CarryOutput(x,y,z) -> Element of InnerVertices BitGFA2Str(x,y,z)
  equals

  [<*[<*x,y*>,and2a],[<*y,z*>,and2c],[<*z,x*>,and2b]*>,nor3];
end;

definition
  let x,y,z be set;
  func BitGFA2AdderOutput(x,y,z) -> Element of InnerVertices BitGFA2Str(x,y,z)
  equals

  2GatesCircOutput(x,y,z, xor2c);
end;





theorem 
  for x,y,z being set st z <> [<*x,y*>,xor2c] & x <> [<*y,z*>,and2c] & y
<> [<*z,x*>,and2b] & z <> [<*x,y*>,and2a] for s being State of BitGFA2Circ(x,y,
  z) for a1,a2,a3 being Element of BOOLEAN st a1 = s.x & a2 = s.y & a3 = s.z
holds Following(s,2).GFA2AdderOutput(x,y,z) = 'not' a1 'xor' a2 'xor' 'not' a3
& Following(s,2).GFA2CarryOutput(x,y,z) = 'not' (('not' a1 '&' a2) 'or' (a2 '&'
  'not' a3) 'or' ('not' a3 '&' 'not' a1));

theorem 
  for x,y,z being set st z <> [<*x,y*>,xor2c] & x <> [<*y,z*>,and2c] & y
<> [<*z,x*>,and2b] & z <> [<*x,y*>,and2a] for s being State of BitGFA2Circ(x,y,
  z) holds Following(s,2) is stable;





begin 





















definition
  let x,y,z be set;
  func GFA3CarryIStr(x,y,z) -> unsplit gate`1=arity gate`2isBoolean non void
  strict non empty ManySortedSign equals

  1GateCircStr(<*x,y*>,and2b) +*
  1GateCircStr(<*y,z*>,and2b) +* 1GateCircStr(<*z,x*>,and2b);
end;

definition
  let x,y,z be set;
  func GFA3CarryICirc(x,y,z) -> strict Boolean gate`2=den Circuit of
  GFA3CarryIStr(x,y,z) equals

  1GateCircuit(x,y,and2b) +* 1GateCircuit(y,z,and2b)
  +* 1GateCircuit(z,x,and2b);
end;

definition
  let x,y,z be set;
  func GFA3CarryStr(x,y,z) -> unsplit gate`1=arity gate`2isBoolean non void
  strict non empty ManySortedSign equals

  GFA3CarryIStr(x,y,z) +* 1GateCircStr(<*[
  <*x,y*>,and2b], [<*y,z*>,and2b], [<*z,x*>,and2b]*>,nor3);
end;

definition
  let x,y,z be set;
  func GFA3CarryCirc(x,y,z) -> strict Boolean gate`2=den Circuit of
  GFA3CarryStr(x,y,z) equals

  GFA3CarryICirc(x,y,z) +* 1GateCircuit([<*x,y*>,and2b
  ],[<*y,z*>,and2b],[<*z,x*>,and2b],nor3);
end;

definition
  let x,y,z be set;
  func GFA3CarryOutput(x,y,z) -> Element of InnerVertices GFA3CarryStr(x,y,z)
  equals

  [<*[<*x,y*>,and2b],[<*y,z*>,and2b],[<*z,x*>,and2b]*>,nor3];
end;







theorem 
  for x,y,z being set holds InnerVertices GFA3CarryIStr(x,y,z) =
  {[<*x,y*>,and2b], [<*y,z*>,and2b], [<*z,x*>,and2b]};

theorem 
  for x,y,z being set holds InnerVertices GFA3CarryStr(x,y,z) = {
[<*x,y*>,and2b], [<*y,z*>,and2b], [<*z,x*>,and2b]} \/ {GFA3CarryOutput(x,y,z)};

theorem 
  for x,y,z being set holds InnerVertices GFA3CarryStr(x,y,z) is Relation;




theorem 
  for x,y,z being set st x <> [<*y,z*>,and2b] & y <> [<*z,x*>,
and2b] & z <> [<*x,y*>,and2b] holds InputVertices GFA3CarryIStr(x,y,z) = {x,y,z
  };

theorem 
  for x,y,z being set st x <> [<*y,z*>,and2b] & y <> [<*z,x*>,
and2b] & z <> [<*x,y*>,and2b] holds InputVertices GFA3CarryStr(x,y,z) = {x,y,z}
;

theorem 
  for x,y,z being non pair set holds InputVertices GFA3CarryStr(x,y,z)
  is without_pairs;




theorem 
  for x,y,z being set holds x in the carrier of GFA3CarryStr(x,y,
z) & y in the carrier of GFA3CarryStr(x,y,z) & z in the carrier of GFA3CarryStr
  (x,y,z) & [<*x,y*>,and2b] in the carrier of GFA3CarryStr(x,y,z) & [<*y,z*>,
  and2b] in the carrier of GFA3CarryStr(x,y,z) & [<*z,x*>,and2b] in the carrier
of GFA3CarryStr(x,y,z) & [<*[<*x,y*>,and2b],[<*y,z*>,and2b],[<*z,x*>,and2b]*>,
  nor3] in the carrier of GFA3CarryStr(x,y,z);

theorem 
  for x,y,z being set holds [<*x,y*>,and2b] in InnerVertices
GFA3CarryStr(x,y,z) & [<*y,z*>,and2b] in InnerVertices GFA3CarryStr(x,y,z) & [
<*z,x*>,and2b] in InnerVertices GFA3CarryStr(x,y,z) & GFA3CarryOutput(x,y,z) in
  InnerVertices GFA3CarryStr(x,y,z);

theorem 
  for x,y,z being set st x <> [<*y,z*>,and2b] & y <> [<*z,x*>,
and2b] & z <> [<*x,y*>,and2b] holds x in InputVertices GFA3CarryStr(x,y,z) & y
  in InputVertices GFA3CarryStr(x,y,z) & z in InputVertices GFA3CarryStr(x,y,z)
;

theorem 
  for x,y,z being non pair set holds InputVertices GFA3CarryStr(x
  ,y,z) = {x,y,z};





theorem 
  for x,y,z being set for s being State of GFA3CarryCirc(x,y,z)
for a1,a2,a3 being Element of BOOLEAN st a1 = s.x & a2 = s.y & a3 = s.z holds (
Following s).[<*x,y*>,and2b] = 'not' a1 '&' 'not' a2 & (Following s).[<*y,z*>,
  and2b] = 'not' a2 '&' 'not' a3 & (Following s).[<*z,x*>,and2b] = 'not' a3 '&'
  'not' a1;

theorem 
  for x,y,z being set for s being State of GFA3CarryCirc(x,y,z)
for a1,a2,a3 being Element of BOOLEAN st a1 = s.[<*x,y*>,and2b] & a2 = s.[<*y,z
*>,and2b] & a3 = s.[<*z,x*>,and2b] holds (Following s).GFA3CarryOutput(x,y,z) =
  'not' (a1 'or' a2 'or' a3);

theorem 
  for x,y,z being set st x <> [<*y,z*>,and2b] & y <> [<*z,x*>,
and2b] & z <> [<*x,y*>,and2b] for s being State of GFA3CarryCirc(x,y,z) for a1,
  a2,a3 being Element of BOOLEAN st a1 = s.x & a2 = s.y & a3 = s.z holds
  Following(s,2).GFA3CarryOutput(x,y,z) = 'not' (('not' a1 '&' 'not' a2) 'or' (
'not' a2 '&' 'not' a3) 'or' ('not' a3 '&' 'not' a1)) & Following(s,2).[<*x,y*>,
and2b] = 'not' a1 '&' 'not' a2 & Following(s,2).[<*y,z*>,and2b] = 'not' a2 '&'
  'not' a3 & Following(s,2).[<*z,x*>,and2b] = 'not' a3 '&' 'not' a1;

theorem 
  for x,y,z being set st x <> [<*y,z*>,and2b] & y <> [<*z,x*>,
  and2b] & z <> [<*x,y*>,and2b] for s being State of GFA3CarryCirc(x,y,z) holds
  Following(s,2) is stable;






definition
  let x,y,z be set;
  func GFA3AdderStr(x,y,z) -> unsplit gate`1=arity gate`2isBoolean non void
  strict non empty ManySortedSign equals

  2GatesCircStr(x,y,z, xor2);
end;

definition
  let x,y,z be set;
  func GFA3AdderCirc(x,y,z) -> strict Boolean gate`2=den Circuit of
  GFA3AdderStr(x,y,z) equals

  2GatesCircuit(x,y,z, xor2);
end;

definition
  let x,y,z be set;
  func GFA3AdderOutput(x,y,z) -> Element of InnerVertices GFA3AdderStr(x,y,z)
  equals

  2GatesCircOutput(x,y,z, xor2);
end;







theorem 
  for x,y,z being set holds InnerVertices GFA3AdderStr(x,y,z) = {
  [<*x,y*>,xor2]} \/ {GFA3AdderOutput(x,y,z)};




theorem 
  for x,y,z being set holds x in the carrier of GFA3AdderStr(x,y,z) & y
in the carrier of GFA3AdderStr(x,y,z) & z in the carrier of GFA3AdderStr(x,y,z)
& [<*x,y*>,xor2] in the carrier of GFA3AdderStr(x,y,z) & [<*[<*x,y*>,xor2], z*>
  , xor2] in the carrier of GFA3AdderStr(x,y,z);

theorem 
  for x,y,z being set holds [<*x,y*>,xor2] in InnerVertices GFA3AdderStr
  (x,y,z) & GFA3AdderOutput(x,y,z) in InnerVertices GFA3AdderStr(x,y,z);

theorem 
  for x,y,z being set st z <> [<*x,y*>, xor2] holds x in InputVertices
  GFA3AdderStr(x,y,z) & y in InputVertices GFA3AdderStr(x,y,z) & z in
  InputVertices GFA3AdderStr(x,y,z);





theorem 
  for x,y,z being set st z <> [<*x,y*>, xor2] for s being State of
GFA3AdderCirc(x,y,z) for a1,a2,a3 being Element of BOOLEAN st a1 = s.x & a2 = s
.y & a3 = s.z holds (Following s).[<*x,y*>,xor2] = a1 'xor' a2 & (Following s).
  x = a1 & (Following s).y = a2 & (Following s).z = a3;

theorem 
  for x,y,z being set st z <> [<*x,y*>, xor2] for s being State of
GFA3AdderCirc(x,y,z) for a1a2,a1,a2,a3 being Element of BOOLEAN st a1a2 = s.[<*
  x,y*>,xor2] & a1 = s.x & a2 = s.y & a3 = s.z holds (Following s).
  GFA3AdderOutput(x,y,z) = a1a2 'xor' a3;

theorem 
  for x,y,z being set st z <> [<*x,y*>, xor2] for s being State
of GFA3AdderCirc(x,y,z) for a1,a2,a3 being Element of BOOLEAN st a1 = s.x & a2
  = s.y & a3 = s.z holds Following(s,2).GFA3AdderOutput(x,y,z) = a1 'xor' a2
'xor' a3 & Following(s,2).[<*x,y*>,xor2] = a1 'xor' a2 & Following(s,2).x = a1
  & Following(s,2).y = a2 & Following(s,2).z = a3;

theorem 
  for x,y,z being set st z <> [<*x,y*>, xor2] for s being State
of GFA3AdderCirc(x,y,z) for a1,a2,a3 being Element of BOOLEAN st a1 = s.x & a2
= s.y & a3 = s.z holds Following(s,2).GFA3AdderOutput(x,y,z) = 'not' ('not' a1
  'xor' 'not' a2 'xor' 'not' a3);






definition
  let x,y,z be set;
  func BitGFA3Str(x,y,z) -> unsplit gate`1=arity gate`2isBoolean non void
  strict non empty ManySortedSign equals

  GFA3AdderStr(x,y,z) +* GFA3CarryStr(x,y,
  z);
end;

definition
  let x,y,z be set;
  func BitGFA3Circ(x,y,z) -> strict Boolean gate`2=den Circuit of BitGFA3Str(x
  ,y,z) equals

  GFA3AdderCirc(x,y,z) +* GFA3CarryCirc(x,y,z);
end;







theorem 
  for x,y,z being set holds InnerVertices BitGFA3Str(x,y,z) = {[
<*x,y*>,xor2]} \/ {GFA3AdderOutput(x,y,z)} \/ {[<*x,y*>,and2b], [<*y,z*>,and2b]
  , [<*z,x*>,and2b]} \/ {GFA3CarryOutput(x,y,z)};

theorem 
  for x,y,z being set holds InnerVertices BitGFA3Str(x,y,z) is Relation;




theorem 
  for x,y,z being set st z <> [<*x,y*>,xor2] & x <> [<*y,z*>,
  and2b] & y <> [<*z,x*>,and2b] & z <> [<*x,y*>,and2b] holds InputVertices
  BitGFA3Str(x,y,z) = {x,y,z};

theorem 
  for x,y,z being non pair set holds InputVertices BitGFA3Str(x,y ,z) = {x,y,z}
;

theorem 
  for x,y,z being non pair set holds InputVertices BitGFA3Str(x,y,z) is
  without_pairs;




theorem 
  for x,y,z being set holds x in the carrier of BitGFA3Str(x,y,z) & y in
the carrier of BitGFA3Str(x,y,z) & z in the carrier of BitGFA3Str(x,y,z) & [<*x
,y*>,xor2] in the carrier of BitGFA3Str(x,y,z) & [<*[<*x,y*>,xor2],z*>,xor2] in
the carrier of BitGFA3Str(x,y,z) & [<*x,y*>,and2b] in the carrier of BitGFA3Str
(x,y,z) & [<*y,z*>,and2b] in the carrier of BitGFA3Str(x,y,z) & [<*z,x*>,and2b]
in the carrier of BitGFA3Str(x,y,z) & [<*[<*x,y*>,and2b],[<*y,z*>,and2b],[<*z,x
  *>,and2b]*>,nor3] in the carrier of BitGFA3Str(x,y,z);

theorem 
  for x,y,z being set holds [<*x,y*>,xor2] in InnerVertices
BitGFA3Str(x,y,z) & GFA3AdderOutput(x,y,z) in InnerVertices BitGFA3Str(x,y,z) &
  [<*x,y*>,and2b] in InnerVertices BitGFA3Str(x,y,z) & [<*y,z*>,and2b] in
InnerVertices BitGFA3Str(x,y,z) & [<*z,x*>,and2b] in InnerVertices BitGFA3Str(x
  ,y,z) & GFA3CarryOutput(x,y,z) in InnerVertices BitGFA3Str(x,y,z);

theorem 
  for x,y,z being set st z <> [<*x,y*>,xor2] & x <> [<*y,z*>,and2b] & y
<> [<*z,x*>,and2b] & z <> [<*x,y*>,and2b] holds x in InputVertices BitGFA3Str(x
,y,z) & y in InputVertices BitGFA3Str(x,y,z) & z in InputVertices BitGFA3Str(x,
  y,z);





definition
  let x,y,z be set;
  func BitGFA3CarryOutput(x,y,z) -> Element of InnerVertices BitGFA3Str(x,y,z)
  equals

  [<*[<*x,y*>,and2b],[<*y,z*>,and2b],[<*z,x*>,and2b]*>,nor3];
end;

definition
  let x,y,z be set;
  func BitGFA3AdderOutput(x,y,z) -> Element of InnerVertices BitGFA3Str(x,y,z)
  equals

  2GatesCircOutput(x,y,z, xor2);
end;





theorem 
  for x,y,z being set st z <> [<*x,y*>,xor2] & x <> [<*y,z*>,and2b] & y
<> [<*z,x*>,and2b] & z <> [<*x,y*>,and2b] for s being State of BitGFA3Circ(x,y,
  z) for a1,a2,a3 being Element of BOOLEAN st a1 = s.x & a2 = s.y & a3 = s.z
  holds Following(s,2).GFA3AdderOutput(x,y,z) = 'not' ('not' a1 'xor' 'not' a2
'xor' 'not' a3) & Following(s,2).GFA3CarryOutput(x,y,z) = 'not' (('not' a1 '&'
  'not' a2) 'or' ('not' a2 '&' 'not' a3) 'or' ('not' a3 '&' 'not' a1));

theorem 
  for x,y,z being set st z <> [<*x,y*>,xor2] & x <> [<*y,z*>,and2b] & y
<> [<*z,x*>,and2b] & z <> [<*x,y*>,and2b] for s being State of BitGFA3Circ(x,y,
  z) holds Following(s,2) is stable;














begin 

theorem 
  for L being add-associative right_zeroed right_complementable
  non empty addLoopStr, a, b being Element of L holds a - b + b = a;

theorem 
  for L being add-associative right_zeroed right_complementable
  Abelian non empty addLoopStr, b, c being Element of L holds c = b - (b - c);

theorem 
  for L being add-associative right_zeroed right_complementable
Abelian non empty addLoopStr, a, b, c being Element of L holds a - b - (c - b
  ) = a - c;

begin 

definition
  let K be non empty multMagma, S be Subset of K;
  attr S is quasi-prime means


  for a, b being Element of K st a*b in S holds a in S or b in S;
end;

definition
  let K be non empty multLoopStr, S be Subset of K;
  attr S is prime means


  S is proper quasi-prime;
end;

definition
  let R be non empty doubleLoopStr;
  let I be Subset of R;
  attr I is quasi-maximal means


  for J being Ideal of R st I c= J holds J = I or J is non proper;
end;

definition
  let R be non empty doubleLoopStr;
  let I be Subset of R;
  attr I is maximal means


  I is proper quasi-maximal;
end;

registration
  let K be non empty multLoopStr;
  cluster prime -> proper quasi-prime for Subset of K;
  cluster proper quasi-prime -> prime for Subset of K;
end;

registration
  let R be non empty doubleLoopStr;
  cluster maximal -> proper quasi-maximal for Subset of R;
  cluster proper quasi-maximal -> maximal for Subset of R;
end;

registration
  let R be non empty addLoopStr;
  cluster [#]R -> add-closed;
end;

registration
  let R be non empty multMagma;
  cluster [#]R -> left-ideal right-ideal;
end;

theorem 
  for R being domRing holds {0.R} is prime;

begin 

reserve R for Ring,
  I for Ideal of R,
  a, b for Element of R;

definition
  let R be Ring, I be Ideal of R;
  func EqRel(R,I) -> Relation of R means


  for a, b being Element of R holds [a,b] in it iff a-b in I;
end;

registration
  let R be Ring, I be Ideal of R;
  cluster EqRel(R,I) -> non empty total symmetric transitive;
end;

theorem 
  a in Class(EqRel(R,I),b) iff a-b in I;

theorem 
  Class(EqRel(R,I),a) = Class(EqRel(R,I),b) iff a-b in I;

theorem 
  Class(EqRel(R,[#]R),a) = the carrier of R;

theorem 
  Class EqRel(R,[#]R) = {the carrier of R};

theorem 
  Class(EqRel(R,{0.R}),a) = {a};

theorem 
  Class EqRel(R,{0.R}) = rng singleton the carrier of R;

begin 

definition
  let R be Ring, I be Ideal of R;

  func QuotientRing(R,I) -> strict doubleLoopStr means


  the carrier of
it = Class EqRel(R,I) & 1.it = Class(EqRel(R,I),1.R) & 0.it = Class(EqRel(R,I),
  0.R) & (for x, y being Element of it ex a, b being Element of R st x = Class(
EqRel(R,I),a) & y = Class(EqRel(R,I),b) & (the addF of it).(x,y) = Class(EqRel(
  R,I),a+b)) & for x, y being Element of it ex a, b being Element of R st x =
Class(EqRel(R,I),a) & y = Class(EqRel(R,I),b) & (the multF of it).(x,y) = Class
  (EqRel(R,I),a*b);
end;

notation
  let R be Ring, I be Ideal of R;
  synonym R/I for QuotientRing(R,I);
end;

registration
  let R be Ring, I be Ideal of R;
  cluster R/I -> non empty;
end;

reserve x, y for Element of R/I;

theorem 
  ex a being Element of R st x = Class(EqRel(R,I),a);

theorem 
  Class(EqRel(R,I),a) is Element of R/I;

theorem 
  x = Class(EqRel(R,I),a) & y = Class(EqRel(R,I),b) implies x+y =
  Class(EqRel(R,I),a+b);

theorem 
  x = Class(EqRel(R,I),a) & y = Class(EqRel(R,I),b) implies x*y =
  Class(EqRel(R,I),a*b);

theorem 
  Class(EqRel(R,I),1.R) = 1.(R/I);

registration
  let R be Ring, I be Ideal of R;
  cluster R/I -> Abelian add-associative right_zeroed right_complementable
    associative well-unital distributive;
end;

registration
  let R be commutative Ring, I be Ideal of R;
  cluster R/I -> commutative;
end;

theorem 
  I is proper iff R/I is non degenerated;

theorem 
  I is quasi-prime iff R/I is domRing-like;

theorem 
  for R being commutative Ring, I being Ideal of R holds I is prime iff
  R/I is domRing;

theorem 
  R is commutative & I is quasi-maximal implies R/I is almost_left_invertible;

theorem 
  R/I is almost_left_invertible implies I is quasi-maximal;

theorem 
  for R being commutative Ring, I being Ideal of R holds I is maximal
  iff R/I is Skew-Field;

registration
  let R be non degenerated commutative Ring;
  cluster maximal -> prime for Ideal of R;
end;

registration
  let R be non degenerated Ring;
  cluster maximal for Ideal of R;
end;

registration
  let R be non degenerated commutative Ring;
  cluster maximal for Ideal of R;
end;

registration
  let R be non degenerated commutative Ring, I be quasi-prime Ideal of R;
  cluster R/I -> domRing-like;
end;

registration
  let R be non degenerated commutative Ring, I be quasi-maximal Ideal of R;
  cluster R/I -> almost_left_invertible;
end;














begin 

reserve n for Nat;

definition
  let n be Nat;
  func Euclid_add n -> BinOp of REAL n means


  for a,b being Element of REAL n holds it.(a,b) = a+b;
end;

registration
  let n be Nat;
  cluster Euclid_add n -> commutative associative;
end;

definition
  let n be Nat;
  func Euclid_mult n -> Function of [: REAL, REAL n :], REAL n means


  for r be Element of REAL, x be Element of REAL n holds it.(r,x) = r*x;
end;

definition
  let n be Nat;
  func Euclid_norm n -> Function of REAL n,REAL means


  for x being Element of REAL n holds it.x = |.x.|;
end;

definition
  let n be Nat;
  func REAL-NS n -> strict non empty NORMSTR means


  the carrier of it =
  REAL n & 0.it = 0*n & the addF of it = Euclid_add n & the Mult of it =
  Euclid_mult n & the normF of it = Euclid_norm n;
end;

registration
  let n be non empty Nat;
  cluster REAL-NS n -> non trivial;
end;

theorem 
  for x be VECTOR of REAL-NS n, y be Element of REAL n st x=y holds
  ||.x.|| = |.y.|;

theorem 
  for n be Nat for x,y be VECTOR of REAL-NS n, a,b be
  Element of REAL n st x=a & y=b holds x+y = a + b;

theorem 
  for x be VECTOR of REAL-NS n, y be Element of REAL n, a be real
  number st x=y holds a * x = a * y;

registration
  let n be Nat;
  cluster REAL-NS n -> reflexive discerning RealNormSpace-like
  vector-distributive scalar-distributive scalar-associative scalar-unital
  Abelian add-associative right_zeroed right_complementable;
end;

theorem 
  for x be VECTOR of REAL-NS n, a be Element of REAL n st x=a holds -x = -a;

theorem 
  for x,y be VECTOR of REAL-NS n, a,b be Element of REAL n st x=a &
  y=b holds x-y = a - b;

theorem 
  for f be FinSequence of REAL st dom f = Seg n holds f is Element of REAL n;

theorem 
  for n be Nat, x be Element of REAL n st (for i be
  Element of NAT st i in Seg n holds 0 <= x.i) holds 0 <= Sum x & for i be
  Element of NAT st i in Seg n holds x.i <= Sum x;

theorem 
  for x be Element of REAL n, i be Nat st i in Seg n holds abs(x.i) <= |.x.|;

theorem 
  for x be Point of REAL-NS n, y be Element of REAL n st x=y holds
  for i be Nat st i in Seg n holds abs(y.i) <= ||.x.||;

theorem 
  for x be Element of REAL (n+1) holds |.x.|^2 = |.(x|n).|^2 + (x. (n+1))^2;

definition
  let n be Nat;
  let f be Function of NAT, REAL n, k be Nat;
  redefine func f.k -> Element of REAL n;
end;

theorem 
  for n be Nat for x be Point of REAL-NS n, xs be
Element of REAL n, seq be sequence of REAL-NS n, xseq be Function of NAT, REAL
  n st xs = x & xseq = seq holds ( seq is convergent & lim seq = x iff for i be
  Element of NAT st i in Seg n ex rseqi be Real_Sequence st for k be Element of
  NAT holds rseqi.k = (xseq.k).i & rseqi is convergent & xs.i = lim rseqi );

theorem 
  for f be sequence of REAL-NS n st f is Cauchy_sequence_by_Norm
  holds f is convergent;

registration
  let n;
  cluster REAL-NS n -> complete;
end;

begin 

definition
  let n be Nat;
  func Euclid_scalar n -> Function of [:REAL n,REAL n:],REAL means


  for x,y being Element of REAL n holds it.(x,y) = Sum mlt(x,y);
end;

definition
  let n be Nat;
  func REAL-US n -> strict non empty UNITSTR means


  the carrier of it =
  REAL n & 0.it = 0*n & the addF of it = Euclid_add n & the Mult of it =
  Euclid_mult n & the scalar of it = Euclid_scalar n;
end;

registration
  let n be non empty Nat;
  cluster REAL-US n -> non trivial;
end;

registration
  let n be Nat;
  cluster REAL-US n -> RealUnitarySpace-like vector-distributive
  scalar-distributive scalar-associative scalar-unital Abelian
    add-associative right_zeroed right_complementable;
end;

theorem 
  for n be Nat, a be Real, x1,y1 be Point of REAL-NS n,
x2,y2 be Point of REAL-US n st x1 = x2 & y1 = y2 holds x1 + y1 = x2 + y2 & -x1
  = -x2 & a * x1 = a * x2;

theorem 
  for n be Nat, x1 be Point of REAL-NS n, x2 be Point of
  REAL-US n st x1 = x2 holds ||.x1.||^2 = x2 .|. x2;

theorem 
  for n be Nat, f be set holds f is sequence of REAL-NS
  n iff f is sequence of REAL-US n;

theorem 
  for n be Nat, seq1 be sequence of REAL-NS n, seq2 be
sequence of REAL-US n st seq1 = seq2 holds (seq1 is convergent implies seq2 is
  convergent & lim seq1 = lim seq2) & (seq2 is convergent implies seq1 is
  convergent & lim seq1 = lim seq2);

theorem 
  for n be Nat, seq1 be sequence of REAL-NS n, seq2 be
  sequence of REAL-US n st seq1 = seq2 & seq1 is Cauchy_sequence_by_Norm holds
  seq2 is Cauchy;

theorem 
  for n be Nat, seq1 be sequence of REAL-NS n, seq2 be
  sequence of REAL-US n st seq1 = seq2 & seq2 is Cauchy holds seq1 is
  Cauchy_sequence_by_Norm;

registration
  let n;
  cluster REAL-US n -> complete;
end;














begin 

theorem 
  for x,y being odd Element of NAT holds x < y iff x + 2 <= y;

canceled;

theorem 
  for X being set, fs being FinSequence of X, fss being Subset of
  fs holds len (Seq fss) <= len fs;

theorem 
  for X being set, fs being FinSequence of X, fss being Subset of
fs, m being Element of NAT st m in dom Seq fss holds ex n being Element of NAT
  st n in dom fs & m <= n & (Seq fss).m = fs.n;

theorem 
  for X being set, fs being FinSequence of X, fss being Subset of
  fs holds len Seq fss = card fss;

theorem 
  for X being set, fs being FinSequence of X, fss being Subset of
  fs holds dom Seq fss = dom Sgm (dom fss);

begin 

definition
  let G be _Graph;
  mode VertexSeq of G -> FinSequence of the_Vertices_of G means


    for n
being Element of NAT st 1 <= n & n < len it holds ex e being set st e Joins it.
    n, it.(n+1), G;
end;

definition
  let G be _Graph;
  mode EdgeSeq of G -> FinSequence of the_Edges_of G means


    ex vs being
FinSequence of the_Vertices_of G st len vs = len it + 1 & for n being Element
    of NAT st 1 <= n & n <= len it holds it.n Joins vs.n,vs.(n+1),G;
end;

definition
  let G be _Graph;
  mode Walk of G -> FinSequence of the_Vertices_of G \/ the_Edges_of G means

 len
 it is odd & it.1 in the_Vertices_of G & for n being odd Element of
    NAT st n < len it holds it.(n+1) Joins it.n, it.(n+2), G;
end;

registration
  let G be _Graph, W be Walk of G;
  cluster len W -> odd non empty;
end;

definition
  let G be _Graph, v be Vertex of G;
  func G.walkOf(v) -> Walk of G equals

  <*v*>;
end;

definition
  let G be _Graph, x,y,e be set;
  func G.walkOf(x,e,y) -> Walk of G equals


  <*x,e,y*> if e Joins x,y,G
  otherwise G.walkOf(choose the_Vertices_of G);
end;

definition
  let G be _Graph, W be Walk of G;
  func W.first() -> Vertex of G equals

  W.1;
  func W.last() -> Vertex of G equals

  W.(len W);
end;

definition
  let G be _Graph, W be Walk of G, n be Nat;
  func W.vertexAt(n) -> Vertex of G equals


  W.n if n is odd & n <= len W
  otherwise W.first();
end;

definition
  let G be _Graph, W be Walk of G;
  func W.reverse() -> Walk of G equals

  Rev W;
 involutiveness;
end;

definition
  let G be _Graph, W1, W2 be Walk of G;
  func W1.append(W2) -> Walk of G equals


  W1 ^' W2 if W1.last() = W2
  .first() otherwise W1;
end;

definition
  let G be _Graph, W be Walk of G, m, n being Nat;
  func W.cut(m,n) -> Walk of G equals


  (m,n)-cut W if m is odd & n is
  odd & m <= n & n <= len W otherwise W;
end;

definition
  let G be _Graph, W be Walk of G, m, n be Element of NAT;
  func W.remove(m,n) -> Walk of G equals


  W.cut(1,m).append(W.cut(n,len
  W)) if m is odd & n is odd & m <= n & n <= len W & W.m = W.n otherwise W;
end;

definition
  let G be _Graph, W be Walk of G, e be set;
  func W.addEdge(e) -> Walk of G equals

  W.append(G.walkOf(W.last(), e, W
  .last().adj(e)));
end;

definition
  let G be _Graph, W be Walk of G;
  func W.vertexSeq() -> VertexSeq of G means


  len W + 1 = 2 * len it &
  for n being Nat st 1 <= n & n <= len it holds it.n = W.(2*n - 1);
end;

definition
  let G be _Graph, W be Walk of G;
  func W.edgeSeq() -> EdgeSeq of G means


  len W = 2*len it+1 & for n
  being Nat st 1 <= n & n <= len it holds it.n = W.(2*n);
end;

definition
  let G be _Graph, W be Walk of G;
  func W.vertices() -> finite Subset of the_Vertices_of G equals

  rng W
  .vertexSeq();
end;

definition
  let G be _Graph, W be Walk of G;
  func W.edges() -> finite Subset of the_Edges_of G equals

  rng W.edgeSeq();
end;

definition
  let G be _Graph, W be Walk of G;
  func W.length() -> Element of NAT equals

  len W.edgeSeq();
end;

definition
  let G be _Graph, W be Walk of G, v be set;
  func W.find(v) -> odd Element of NAT means


  it <= len W & W.it = v &
for n being odd Nat st n <= len W & W.n = v holds it <= n if v in W.vertices()
  otherwise it = len W;
end;

definition
  let G be _Graph, W be Walk of G, n be Element of NAT;
  func W.find(n) -> odd Element of NAT means


  it <= len W & W.it = W.n
  & for k being odd Nat st k <= len W & W.k = W.n holds it <= k if n is odd & n
  <= len W otherwise it = len W;
end;

definition
  let G be _Graph, W be Walk of G, v be set;
  func W.rfind(v) -> odd Element of NAT means


  it <= len W & W.it = v &
for n being odd Element of NAT st n <= len W & W.n = v holds n <= it if v in W
  .vertices() otherwise it = len W;
end;

definition
  let G be _Graph, W be Walk of G, n be Element of NAT;
  func W.rfind(n) -> odd Element of NAT means


  it <= len W & W.it = W.n
  & for k being odd Element of NAT st k <= len W & W.k = W.n holds k <= it if n
  is odd & n <= len W otherwise it = len W;
end;

definition
  let G be _Graph, u, v be set, W be Walk of G;
  pred W is_Walk_from u,v means


  W.first() = u & W.last() = v;
end;

definition
  let G be _Graph, W be Walk of G;
  attr W is closed means


  W.first() = W.last();
  attr W is directed means


  for n being odd Element of NAT st n < len W
  holds (the_Source_of G).(W.(n+1)) = W.n;
  attr W is trivial means


  W.length() = 0;
  attr W is Trail-like means


  W.edgeSeq() is one-to-one;
end;

notation
  let G be _Graph, W be Walk of G;
  antonym W is open for W is closed;
end;

definition
  let G be _Graph, W be Walk of G;
  attr W is Path-like means


  W is Trail-like & for m, n being odd
Element of NAT st m < n & n <= len W holds W.m = W.n implies m = 1 & n = len W;
end;

definition
  let G be _Graph, W be Walk of G;
  attr W is vertex-distinct means


  for m,n being odd Element of NAT st
  m <= len W & n <= len W & W.m = W.n holds m = n;
end;

definition
  let G be _Graph, W be Walk of G;
  attr W is Circuit-like means


  W is closed & W is Trail-like & W is non trivial;
  attr W is Cycle-like means


  W is closed & W is Path-like & W is non trivial;
end;

registration
  let G be _Graph;
  cluster Path-like -> Trail-like for Walk of G;
  cluster trivial -> Path-like for Walk of G;
  cluster trivial -> vertex-distinct for Walk of G;
  cluster vertex-distinct -> Path-like for Walk of G;
  cluster Circuit-like -> closed Trail-like non trivial for Walk of G;
  cluster Cycle-like -> closed Path-like non trivial for Walk of G;
end;

registration
  let G be _Graph;
  cluster closed directed trivial for Walk of G;
end;

registration
  let G be _Graph;
  cluster vertex-distinct for Walk of G;
end;

definition
  let G be _Graph;
  mode Trail of G is Trail-like Walk of G;
  mode Path of G is Path-like Walk of G;
end;

definition
  let G be _Graph;
  mode DWalk of G is directed Walk of G;
  mode DTrail of G is directed Trail of G;
  mode DPath of G is directed Path of G;
end;

registration
  let G be _Graph, v be Vertex of G;
  cluster G.walkOf(v) -> closed directed trivial;
end;

registration
  let G be _Graph, x,e,y be set;
  cluster G.walkOf(x,e,y) -> Path-like;
end;

registration
  let G be _Graph, x,e be set;
  cluster G.walkOf(x,e,x) -> closed;
end;

registration
  let G be _Graph, W be closed Walk of G;
  cluster W.reverse() -> closed;
end;

registration
  let G be _Graph, W be trivial Walk of G;
  cluster W.reverse() -> trivial;
end;

registration
  let G be _Graph, W be Trail of G;
  cluster W.reverse() -> Trail-like;
end;

registration
  let G be _Graph, W be Path of G;
  cluster W.reverse() -> Path-like;
end;

registration
  let G be _Graph, W1,W2 be closed Walk of G;
  cluster W1.append(W2) -> closed;
end;

registration
  let G be _Graph, W1,W2 be DWalk of G;
  cluster W1.append(W2) -> directed;
end;

registration
  let G be _Graph, W1,W2 be trivial Walk of G;
  cluster W1.append(W2) -> trivial;
end;

registration
  let G be _Graph, W be DWalk of G, m,n be Element of NAT;
  cluster W.cut(m,n) -> directed;
end;

registration
  let G be _Graph, W be trivial Walk of G, m,n be Element of NAT;
  cluster W.cut(m,n) -> trivial;
end;

registration
  let G be _Graph, W be Trail of G, m,n be Element of NAT;
  cluster W.cut(m,n) -> Trail-like;
end;

registration
  let G be _Graph, W be Path of G, m,n be Element of NAT;
  cluster W.cut(m,n) -> Path-like;
end;

registration
  let G be _Graph, W be vertex-distinct Walk of G, m,n be Element of NAT;
  cluster W.cut(m,n) -> vertex-distinct;
end;

registration
  let G be _Graph, W be closed Walk of G, m,n be Element of NAT;
  cluster W.remove(m,n) -> closed;
end;

registration
  let G be _Graph, W be DWalk of G, m,n be Element of NAT;
  cluster W.remove(m,n) -> directed;
end;

registration
  let G be _Graph, W be trivial Walk of G, m,n be Element of NAT;
  cluster W.remove(m,n) -> trivial;
end;

registration
  let G be _Graph, W be Trail of G, m,n be Element of NAT;
  cluster W.remove(m,n) -> Trail-like;
end;

registration
  let G be _Graph, W be Path of G, m,n be Element of NAT;
  cluster W.remove(m,n) -> Path-like;
end;

definition
  let G be _Graph, W be Walk of G;
  mode Subwalk of W -> Walk of G means


    it is_Walk_from W.first(), W
    .last() & ex es being Subset of W.edgeSeq() st it.edgeSeq() = Seq es;
end;

definition
  let G be _Graph, W be Walk of G, m,n being Element of NAT;
  redefine func W.remove(m,n) -> Subwalk of W;
end;

registration
  let G be _Graph, W be Walk of G;
  cluster Trail-like Path-like for Subwalk of W;
end;

definition
  let G be _Graph, W be Walk of G;
  mode Trail of W is Trail-like Subwalk of W;
  mode Path of W is Path-like Subwalk of W;
end;

registration
  let G be _Graph, W be DWalk of G;
  cluster directed for Path of W;
end;

definition
  let G be _Graph, W be DWalk of G;
  mode DWalk of W is directed Subwalk of W;
  mode DTrail of W is directed Trail of W;
  mode DPath of W is directed Path of W;
end;

definition
  let G be _Graph;
  func G.allWalks()-> non empty Subset of ((the_Vertices_of G)\/(the_Edges_of
  G))* equals

  {W where W is Walk of G : not contradiction};
end;

definition
  let G be _Graph;
  func G.allTrails() -> non empty Subset of G.allWalks() equals

  {W where W is
  Trail of G : not contradiction};
end;

definition
  let G be _Graph;
  func G.allPaths() -> non empty Subset of G.allTrails() equals

  {W where W is
  Path of G : not contradiction};
end;

definition
  let G be _Graph;
  func G.allDWalks() -> non empty Subset of G.allWalks() equals

  {W where W is
  DWalk of G : not contradiction};
end;

definition
  let G be _Graph;
  func G.allDTrails() -> non empty Subset of G.allTrails() equals

  {W where W
  is DTrail of G : not contradiction};
end;

definition
  let G be _Graph;
  func G.allDPaths() -> non empty Subset of G.allDTrails() equals

  {W where W
  is directed Path of G : not contradiction};
end;

registration
  let G be finite _Graph;
  cluster G.allTrails() -> finite;
end;

definition
  let G be _Graph, X be non empty Subset of G.allWalks();
  redefine mode Element of X -> Walk of G;
end;

definition
  let G be _Graph, X be non empty Subset of G.allTrails();
  redefine mode Element of X -> Trail of G;
end;

definition
  let G be _Graph, X be non empty Subset of G.allPaths();
  redefine mode Element of X -> Path of G;
end;

definition
  let G be _Graph, X be non empty Subset of G.allDWalks();
  redefine mode Element of X -> DWalk of G;
end;

definition
  let G be _Graph, X be non empty Subset of G.allDTrails();
  redefine mode Element of X -> DTrail of G;
end;

definition
  let G be _Graph, X be non empty Subset of G.allDPaths();
  redefine mode Element of X -> DPath of G;
end;

begin 

reserve G,G1,G2 for _Graph;
reserve W,W1,W2 for Walk of G;
reserve e,x,y,z for set;
reserve v for Vertex of G;
reserve n,m for Element of NAT;

theorem 
  for n being odd Element of NAT st n <= len W holds W.n in
  the_Vertices_of G;

theorem 
  for n being even Element of NAT st n in dom W holds W.n in the_Edges_of G;

theorem 
  for n being even Element of NAT st n in dom W holds ex naa1 being odd
Element of NAT st naa1 = n-1 & n-1 in dom W & n+1 in dom W & W.n Joins W.(naa1)
  , W.(n+1),G;

theorem 
  for n being odd Element of NAT st n < len W holds W.(n+1) in W
  .vertexAt(n).edgesInOut();

theorem 
  for n being odd Element of NAT st 1 < n & n <= len W holds W.(n-
  1) in W.vertexAt(n).edgesInOut();

theorem 
  for n being odd Element of NAT st n < len W holds n in dom W & n+1 in
  dom W & n+2 in dom W;

theorem 
  len G.walkOf(v) = 1 & G.walkOf(v).1 = v & G.walkOf(v).first() =
  v & G.walkOf(v).last() = v & G.walkOf(v) is_Walk_from v,v;

theorem 
  e Joins x,y,G implies len G.walkOf(x,e,y) = 3;

theorem 
  e Joins x,y,G implies G.walkOf(x,e,y).first() = x & G.walkOf(x,e
  ,y).last() = y & G.walkOf(x,e,y) is_Walk_from x,y;

theorem 
  for W1 being Walk of G1, W2 being Walk of G2 st W1 = W2 holds W1
  .first() = W2.first() & W1.last() = W2.last();

theorem 
  W is_Walk_from x,y iff W.1 = x & W.(len W) = y;

theorem 
  W is_Walk_from x,y implies x is Vertex of G & y is Vertex of G;

theorem 
  for W1 being Walk of G1, W2 being Walk of G2 st W1 = W2 holds W1
  is_Walk_from x,y iff W2 is_Walk_from x,y;

theorem 
  for W1 being Walk of G1, W2 being Walk of G2 st W1 = W2 holds for n
  being Element of NAT holds W1.vertexAt(n) = W2.vertexAt(n);

theorem 
  len W = len W.reverse() & dom W = dom W.reverse() & rng W = rng W
  .reverse();

theorem 
  W.first() = W.reverse().last() & W.last() = W.reverse().first();

theorem 
  W is_Walk_from x,y iff W.reverse() is_Walk_from y, x;

theorem 
  n in dom W implies W.n = W.reverse().(len W - n + 1) & (len W -
  n + 1) in dom W.reverse();

theorem 
  n in dom W.reverse() implies W.reverse().n = W.(len W - n + 1) & (len
  W - n + 1) in dom W;

canceled;

theorem 
  for W1 being Walk of G1, W2 being Walk of G2 st W1 = W2 holds W1
  .reverse() = W2.reverse();

theorem 
  W1.last() = W2.first() implies len W1.append(W2) + 1 = len W1 + len W2;

theorem 
  W1.last() = W2.first() implies len W1 <= len W1.append(W2) & len W2 <=
  len W1.append(W2);

theorem 
  W1.last() = W2.first() implies W1.append(W2).first() = W1.first() & W1
  .append(W2).last() = W2.last() & W1.append(W2) is_Walk_from W1.first(), W2
  .last();

theorem 
  W1 is_Walk_from x,y & W2 is_Walk_from y,z implies W1.append(W2)
  is_Walk_from x,z;

theorem 
  n in dom W1 implies W1.append(W2).n = W1.n & n in dom W1.append(W2);

theorem 
  W1.last() = W2.first() implies for n being Element of NAT st n < len
W2 holds W1.append(W2).(len W1 + n) = W2.(n+1) & (len W1 + n) in dom W1.append(
  W2);

theorem 
  n in dom W1.append(W2) implies n in dom W1 or ex k being Element of
  NAT st k < len W2 & n = len W1 + k;

theorem 
  for W1A, W1B being Walk of G1, W2A,W2B being Walk of G2 st W1A =
  W2A & W1B = W2B holds W1A.append(W1B) = W2A.append(W2B);

theorem 
  for m,n being odd Element of NAT st m <= n & n <= len W holds len W
.cut(m,n) + m = n+1 & for i being Element of NAT st i < len W.cut(m,n) holds W
  .cut(m,n).(i+1) = W.(m+i) & m+i in dom W;

theorem 
  for m, n being odd Element of NAT st m <= n & n <= len W holds W.cut(m
,n).first() = W.m & W.cut(m,n).last() = W.n & W.cut(m,n) is_Walk_from W.m, W.n;

theorem 
  for m,n,o being odd Element of NAT st m <= n & n <= o & o <= len W
  holds W.cut(m,n).append(W.cut(n,o)) = W.cut(m,o);

theorem 
  W.cut(1,len W) = W;

theorem 
  for n being odd Element of NAT st n < len W holds G.walkOf(W.n,
  W.(n+1), W.(n+2)) = W.cut(n,n+2);

theorem 
  for m,n being odd Element of NAT st m <= n & n < len W holds W
  .cut(m,n).addEdge(W.(n+1)) = W.cut(m,n+2);

theorem 
  for n being odd Element of NAT st n <= len W holds W.cut(n,n) = <* W
  .vertexAt(n) *>;

theorem 
  m is odd & m <= n implies W.cut(1,n).cut(1,m) = W.cut(1,m);

theorem 
  for m,n being odd Element of NAT st m <= n & n <= len W1 & W1.last() =
  W2.first() holds W1.append(W2).cut(m,n) = W1.cut(m,n);

theorem 
  for m being odd Element of NAT st m <= len W holds len W.cut(1,m) = m;

theorem 
  for m being odd Element of NAT, x being Element of NAT st x in dom W
  .cut(1,m) & m <= len W holds W.cut(1,m).x = W.x;

theorem 
  for m,n being odd Element of NAT, i being Element of NAT st m <= n & n
<= len W & i in dom W.cut(m,n) holds W.cut(m,n).i = W.(m+i-1) & m+i-1 in dom W;

theorem 
  for W1 being Walk of G1, W2 being Walk of G2, m, n being Element
  of NAT st W1 = W2 holds W1.cut(m,n) = W2.cut(m,n);

theorem 
  for m,n being odd Element of NAT st m <= n & n <= len W & W.m = W.n
  holds len W.remove(m,n) + n = len W + m;

theorem 
  W is_Walk_from x,y implies W.remove(m,n) is_Walk_from x,y;

theorem 
  len W.remove(m,n) <= len W;

theorem 
  W.remove(m,m) = W;

theorem 
  for m,n being odd Element of NAT st m <= n & n <= len W & W.m = W.n
  holds W.cut(1,m).last() = W.cut(n,len W).first();

theorem 
  for m,n being odd Element of NAT st m <= n & n <= len W & W.m = W.n
  holds for x being Element of NAT st x in Seg m holds W.remove(m,n).x = W.x;

theorem 
  for m,n being odd Element of NAT st m <= n & n <= len W & W.m = W.n
  holds for x being Element of NAT st m <= x & x <= len W.remove(m,n) holds W
.remove(m,n).x = W.(x - m + n) & x - m + n is Element of NAT & x - m + n <= len
  W;

theorem 
  for m,n being odd Element of NAT st m <= n & n <= len W & W.m = W.n
  holds len W.remove(m,n) = len W + m - n;

theorem 
  for m being Element of NAT st W.m = W.last() holds W.remove(m,
  len W) = W.cut(1,m);

theorem 
  for m being Element of NAT st W.first() = W.m holds W.remove(1,m) = W
  .cut(m, len W);

theorem 
  W.remove(m,n).first() = W.first() & W.remove(m,n).last() = W.last();

theorem 
  for m,n being odd Element of NAT, x being Element of NAT st m <= n & n
<= len W & W.m = W.n & x in dom W.remove(m,n) holds x in Seg m or m <= x & x <=
  len W.remove(m,n);

theorem 
  for W1 being Walk of G1, W2 being Walk of G2, m, n being Element of
  NAT st W1 = W2 holds W1.remove(m,n) = W2.remove(m,n);

theorem 
  e Joins W.last(), x, G implies W.addEdge(e) = W^<*e,x*>;

theorem 
  e Joins W.last(),x,G implies W.addEdge(e).first() = W.first() & W
  .addEdge(e).last() = x & W.addEdge(e) is_Walk_from W.first(), x;

theorem 
  e Joins W.last(),x,G implies len W.addEdge(e) = len W + 2;

theorem 
  e Joins W.last(),x,G implies W.addEdge(e).(len W + 1) = e & W.addEdge(
e).(len W + 2) = x & for n being Element of NAT st n in dom W holds W.addEdge(e
  ).n = W.n;

theorem 
  W is_Walk_from x,y & e Joins y,z,G implies W.addEdge(e) is_Walk_from x
  ,z;

theorem 
  1 <= len W.vertexSeq();

theorem 
  for n being odd Element of NAT st n <= len W holds 2 * ((n+1)
  div 2) - 1 = n & 1 <= (n+1) div 2 & (n+1) div 2 <= len W.vertexSeq();

theorem 
  G.walkOf(v).vertexSeq() = <*v*>;

theorem 
  e Joins x,y,G implies G.walkOf(x,e,y).vertexSeq() = <*x,y*>;

theorem 
  W.first() = W.vertexSeq().1 & W.last() = W.vertexSeq().(len W .vertexSeq());

theorem 
  for n being odd Element of NAT st n <= len W holds W.vertexAt(n) = W
  .vertexSeq().((n+1) div 2);

theorem 
  n in dom W.vertexSeq() iff 2*n-1 in dom W;

theorem 
  W.cut(1,n).vertexSeq() c= W.vertexSeq();

theorem 
  e Joins W.last(),x,G implies W.addEdge(e).vertexSeq() = W
  .vertexSeq() ^ <*x*>;

theorem 
  for W1 being Walk of G1, W2 being Walk of G2 st W1 = W2 holds W1
  .vertexSeq() = W2.vertexSeq();

theorem 
  for n being even Element of NAT st 1 <= n & n <= len W holds n div 2
  in dom W.edgeSeq() & W.n = W.edgeSeq().(n div 2);

theorem 
  n in dom W.edgeSeq() iff 2*n in dom W;

theorem 
  for n being Element of NAT st n in dom W.edgeSeq() holds W.edgeSeq().n
  in the_Edges_of G;

theorem 
  ex lenWaa1 being even Element of NAT st lenWaa1 = len W - 1 & len W
  .edgeSeq() = lenWaa1 div 2;

theorem 
  W.cut(1,n).edgeSeq() c= W.edgeSeq();

theorem 
  e Joins W.last(),x,G implies W.addEdge(e).edgeSeq() = W.edgeSeq() ^ <*
  e*>;

theorem 
  e Joins x,y,G iff G.walkOf(x,e,y).edgeSeq() = <*e*>;

theorem 
  W.reverse().edgeSeq() = Rev (W.edgeSeq());

theorem 
  W1.last() = W2.first() implies W1.append(W2).edgeSeq() = W1.edgeSeq()
  ^ W2.edgeSeq();

theorem 
  for W1 being Walk of G1, W2 being Walk of G2 st W1 = W2 holds W1
  .edgeSeq() = W2.edgeSeq();

theorem 
  x in W.vertices() iff ex n being odd Element of NAT st n <= len W & W.
  n = x;

theorem 
  W.first() in W.vertices() & W.last() in W.vertices();

theorem 
  for n being odd Element of NAT st n <= len W holds W.vertexAt(n)
  in W.vertices();

theorem 
  G.walkOf(v).vertices() = {v};

theorem 
  e Joins x,y,G implies G.walkOf(x,e,y).vertices() = {x,y};

theorem 
  W.vertices() = W.reverse().vertices();

theorem 
  W1.last() = W2.first() implies W1.append(W2).vertices() = W1
  .vertices() \/ W2.vertices();

theorem 
  for m,n being odd Element of NAT st m <= n & n <= len W holds W.cut(m,
  n).vertices() c= W.vertices();

theorem 
  e Joins W.last(),x,G implies W.addEdge(e).vertices() = W .vertices() \/ {x};

theorem 
  for G being finite _Graph, W being Walk of G, e,x being set holds e
Joins W.last(),x,G & not x in W.vertices() implies card W.addEdge(e).vertices()
  = card W.vertices() + 1;

theorem 
  x in W.vertices() & y in W.vertices() implies ex W9 being Walk of G st
  W9 is_Walk_from x,y;

theorem 
  for W1 being Walk of G1, W2 being Walk of G2 st W1 = W2 holds W1
  .vertices() = W2.vertices();

theorem 
  e in W.edges() iff ex n being even Element of NAT st 1 <= n & n <= len
  W & W.n = e;

theorem 
  e in W.edges() iff ex n being odd Element of NAT st n < len W & W.(n+1) = e;

theorem 
  rng W = W.vertices() \/ W.edges();

theorem 
  W1.last() = W2.first() implies W1.append(W2).edges() = W1
  .edges() \/ W2.edges();

theorem 
  e in W.edges() implies ex v1, v2 being Vertex of G, n being odd
  Element of NAT st n+2 <= len W & v1 = W.n & e = W.(n+1) & v2 = W.(n+2) & e
  Joins v1, v2,G;

theorem 
  e in W.edges() iff ex n being Element of NAT st n in dom W
  .edgeSeq() & W.edgeSeq().n = e;

theorem 
  e in W.edges() & e Joins x,y,G implies x in W.vertices() & y in W
  .vertices();

theorem 
  W.cut(m,n).edges() c= W.edges();

theorem 
  W.edges() = W.reverse().edges();

theorem 
  e Joins x,y,G iff G.walkOf(x,e,y).edges() = {e};

theorem 
  W.edges() c= G.edgesBetween(W.vertices());

theorem 
  for W1 being Walk of G1, W2 being Walk of G2 st W1 = W2 holds W1
  .edges() = W2.edges();

theorem 
  e Joins W.last(),x,G implies W.addEdge(e).edges() = W.edges() \/ {e};

theorem 
  len W = 2 * W.length() + 1;

theorem 
  len W1 = len W2 iff W1.length() = W2.length();

theorem 
  for W1 being Walk of G1, W2 being Walk of G2 st W1 = W2 holds W1
  .length() = W2.length();

theorem 
  for n being odd Element of NAT st n <= len W holds W.find(W.n)
  <= n & W.rfind(W.n) >= n;

theorem 
  for W1 being Walk of G1, W2 being Walk of G2, v being set st W1 = W2
  holds W1.find(v) = W2.find(v) & W1.rfind(v) = W2.rfind(v);

theorem 
  for n being odd Element of NAT st n <= len W holds W.find(n) <= n & W
  .rfind(n) >= n;

theorem 
  W is closed iff W.1 = W.(len W);

theorem 
  W is closed iff ex x being set st W is_Walk_from x,x;

theorem 
  W is closed iff W.reverse() is closed;

theorem 
  for W1 being Walk of G1, W2 being Walk of G2 st W1 = W2 & W1 is closed
  holds W2 is closed;

theorem 
  W is directed iff for n being odd Element of NAT st n < len W holds W.
  (n+1) DJoins W.n, W.(n+2), G;

theorem 
  W is directed & W is_Walk_from x,y & e DJoins y,z,G implies W.addEdge(
  e) is directed & W.addEdge(e) is_Walk_from x,z;

theorem 
  for W being DWalk of G, m,n being Element of NAT holds W.cut(m,n) is
  directed;

theorem 
  W is non trivial iff 3 <= len W;

theorem 
  W is non trivial iff len W <> 1;

theorem 
  W.first() <> W.last() implies W is non trivial;

theorem 
  W is trivial iff ex v being Vertex of G st W = G.walkOf(v);

theorem 
  W is trivial iff W.reverse() is trivial;

theorem 
  W2 is trivial implies W1.append(W2) = W1;

theorem 
  for m, n being odd Element of NAT st m <= n & n <= len W holds W.cut(m
  ,n) is trivial iff m = n;

theorem 
  e Joins W.last(),x,G implies W.addEdge(e) is non trivial;

theorem 
  W is non trivial implies ex lenW2 being odd Element of NAT st
  lenW2 = len W - 2 & W.cut(1,lenW2).addEdge(W.(lenW2+1)) = W;

theorem 
  W2 is non trivial & W2.edges() c= W1.edges() implies W2
  .vertices() c= W1.vertices();

theorem 
  W is non trivial implies for v being Vertex of G st v in W.vertices()
  holds not v is isolated;

theorem 
  W is trivial iff W.edges() = {};

theorem 
  for W1 being Walk of G1, W2 being Walk of G2 st W1 = W2 & W1 is
  trivial holds W2 is trivial;

theorem 
  W is Trail-like iff for m,n being even Element of NAT st 1 <= m & m <
  n & n <= len W holds W.m <> W.n;

theorem 
  len W <= 3 implies W is Trail-like;

theorem 
  W is Trail-like iff W.reverse() is Trail-like;

theorem 
  for W being Trail of G, m,n being Element of NAT holds W.cut(m,n) is
  Trail-like;

theorem 
  for W being Trail of G, e being set st e in W.last().edgesInOut() &
  not e in W.edges() holds W.addEdge(e) is Trail-like;

theorem 
  for W being Trail of G, v being Vertex of G st v in W.vertices() & v
  is endvertex holds v = W.first() or v = W.last();

theorem 
  for G being finite _Graph, W being Trail of G holds len W.edgeSeq() <=
  G.size();

theorem 
  len W <= 3 implies W is Path-like;

theorem 
  (for m,n being odd Element of NAT st m <= len W & n <= len W & W.m = W
  .n holds m = n) implies W is Path-like;

theorem 
  for W being Path of G st W is open holds for m, n being odd Element of
  NAT st m < n & n <= len W holds W.m <> W.n;

theorem 
  W is Path-like iff W.reverse() is Path-like;

theorem 
  for W being Path of G, m, n being Element of NAT holds W.cut(m,n) is
  Path-like;

theorem 
  for W being Path of G, e,v being set st e Joins W.last(),v,G &
  not e in W.edges() & (W is trivial or W is open) & for n being odd Element of
  NAT st 1 < n & n <= len W holds W.n <> v holds W.addEdge(e) is Path-like;

theorem 
  for W being Path of G, e, v being set st e Joins W.last(),v,G & not v
  in W.vertices() & (W is trivial or W is open) holds W.addEdge(e) is Path-like
;

theorem 
  (for n being odd Element of NAT st n <= len W holds W.find(W.n) = W
  .rfind(W.n)) implies W is Path-like;

theorem 
  (for n being odd Element of NAT st n <= len W holds W.rfind(n) = n)
  implies W is Path-like;

theorem 
  for G being finite _Graph, W being Path of G holds len W.vertexSeq()
  <= G.order() + 1;

theorem 
  for G being _Graph, W being vertex-distinct Walk of G, e,v being set
  st e Joins W.last(),v,G & not v in W.vertices() holds W.addEdge(e) is
  vertex-distinct;

theorem 
  e Joins x,x,G implies G.walkOf(x,e,x) is Cycle-like;

theorem 
  e Joins x,y,G & e in W1.edges() & W1 is Cycle-like implies ex W2 being
  Walk of G st W2 is_Walk_from x,y & not e in W2.edges();

theorem 
  W is Subwalk of W;

theorem 
  for W1 being Walk of G, W2 being Subwalk of W1, W3 being Subwalk of W2
  holds W3 is Subwalk of W1;

theorem 
  W1 is Subwalk of W2 implies (W1 is_Walk_from x,y iff W2 is_Walk_from x ,y);

theorem 
  W1 is Subwalk of W2 implies W1.first() = W2.first() & W1.last() = W2.last();

theorem 
  W1 is Subwalk of W2 implies len W1 <= len W2;

theorem 
  W1 is Subwalk of W2 implies W1.edges() c= W2.edges() & W1
  .vertices() c= W2.vertices();

theorem 
  W1 is Subwalk of W2 implies for m being odd Element of NAT st m
<= len W1 holds ex n being odd Element of NAT st m <= n & n <= len W2 & W1.m =
  W2.n;

theorem 
  W1 is Subwalk of W2 implies for m being even Element of NAT st 1 <= m
& m <= len W1 holds ex n being even Element of NAT st m <= n & n <= len W2 & W1
  .m = W2.n;

theorem 
  for W1 being Trail of G st W1 is non trivial holds ex W2 being Path of
  W1 st W2 is non trivial;

theorem 
  for G1 being _Graph, G2 being Subgraph of G1, W being Walk of
  G2 holds W is Walk of G1;

theorem 
  for G1 being _Graph, G2 being Subgraph of G1, W being Walk of
  G1 st W is trivial & W.first() in the_Vertices_of G2 holds W is Walk of G2;

theorem 
  for G1 being _Graph, G2 being Subgraph of G1, W being Walk of
  G1 st W is non trivial & W.edges() c= the_Edges_of G2 holds W is Walk of G2;

theorem 
  for G1 being _Graph, G2 being Subgraph of G1, W being Walk of
G1 st W.vertices() c= the_Vertices_of G2 & W.edges() c= the_Edges_of G2 holds W
  is Walk of G2;

theorem 
  for G1 being non trivial _Graph, W being Walk of G1, v being Vertex of
  G1, G2 being removeVertex of G1,v st not v in W.vertices() holds W is Walk of
  G2;

theorem 
  for G1 being _Graph, W being Walk of G1, e being set, G2 being
  removeEdge of G1,e st not e in W.edges() holds W is Walk of G2;

theorem 
  for G1 being _Graph, G2 being Subgraph of G1, x,y,e being set
  st e Joins x,y,G2 holds G1.walkOf(x, e, y) = G2.walkOf(x, e, y);

theorem 
  for G1 being _Graph, G2 being Subgraph of G1, W1 being Walk of G1, W2
being Walk of G2, e being set st W1 = W2 & e in W2.last().edgesInOut() holds W1
  .addEdge(e) = W2.addEdge(e);

theorem 
  for G1 being _Graph, G2 being Subgraph of G1, W being Walk of
G2 holds (W is closed implies W is closed Walk of G1) & (W is directed implies
W is directed Walk of G1) & (W is trivial implies W is trivial Walk of G1) & (W
  is Trail-like implies W is Trail-like Walk of G1) & (W is Path-like implies W
  is Path-like Walk of G1) & (W is vertex-distinct implies W is vertex-distinct
  Walk of G1);

theorem 
  for G1 being _Graph, G2 being Subgraph of G1, W1 being Walk of
G1, W2 being Walk of G2 st W1 = W2 holds (W1 is closed iff W2 is closed) & (W1
  is directed iff W2 is directed) & (W1 is trivial iff W2 is trivial) & (W1 is
Trail-like iff W2 is Trail-like) & (W1 is Path-like iff W2 is Path-like) & (W1
  is vertex-distinct iff W2 is vertex-distinct);

theorem 
  G1 == G2 & x is VertexSeq of G1 implies x is VertexSeq of G2;

theorem 
  G1 == G2 & x is EdgeSeq of G1 implies x is EdgeSeq of G2;

theorem 
  G1 == G2 & x is Walk of G1 implies x is Walk of G2;

theorem 
  G1 == G2 implies G1.walkOf(x,e,y) = G2.walkOf(x,e,y);

theorem 
  for W1 being Walk of G1, W2 being Walk of G2 st G1 == G2 & W1 = W2
holds (W1 is closed iff W2 is closed) & (W1 is directed iff W2 is directed) & (
W1 is trivial iff W2 is trivial) & (W1 is Trail-like iff W2 is Trail-like) & (
  W1 is Path-like iff W2 is Path-like) & (W1 is vertex-distinct iff W2 is
  vertex-distinct);














begin 

definition
  let G be _Graph;
  attr G is connected means


  for u,v being Vertex of G holds ex W being Walk of G st W is_Walk_from u,v;
end;

definition
  let G be _Graph;
  attr G is acyclic means


  not ex W being Walk of G st W is Cycle-like;
end;

definition
  let G be _Graph;
  attr G is Tree-like means


  G is acyclic & G is connected;
end;

registration
  cluster trivial -> connected for _Graph;
end;

registration
  cluster trivial loopless -> Tree-like for _Graph;
end;

registration
  cluster acyclic -> simple for _Graph;
end;

registration
  cluster Tree-like -> acyclic connected for _Graph;
end;

registration
  cluster acyclic connected -> Tree-like for _Graph;
end;

registration
  let G be _Graph, v be Vertex of G;
  cluster -> Tree-like for inducedSubgraph of G,{v},{};
end;

definition
  let G be _Graph, v be set;
  pred G is_DTree_rooted_at v means


  G is Tree-like & for x being Vertex
  of G holds ex W being DWalk of G st W is_Walk_from v,x;
end;

registration
  cluster trivial finite Tree-like for _Graph;
  cluster non trivial finite Tree-like for _Graph;
end;

registration
  let G be _Graph;
  cluster trivial finite Tree-like for Subgraph of G;
end;

registration
  let G be acyclic _Graph;
  cluster -> acyclic for Subgraph of G;
end;

definition
  let G be _Graph, v be Vertex of G;
  func G.reachableFrom(v) -> non empty Subset of the_Vertices_of G means



  for x being set holds x in it iff ex W being Walk of G st W is_Walk_from v,x;
end;

definition
  let G be _Graph, v be Vertex of G;
  func G.reachableDFrom(v) -> non empty Subset of the_Vertices_of G means


   for
 x being set holds x in it iff ex W being DWalk of G st W is_Walk_from
  v,x;
end;

definition
  let G1 be _Graph, G2 be Subgraph of G1;
  attr G2 is Component-like means


  G2 is connected & not ex G3 being connected Subgraph of G1 st G2 c< G3;
end;

registration
  let G be _Graph;
  cluster Component-like -> connected for Subgraph of G;
end;

registration
  let G be _Graph, v be Vertex of G;
  cluster -> Component-like for inducedSubgraph of G,G.reachableFrom(v);
end;

registration
  let G be _Graph;
  cluster Component-like for Subgraph of G;
end;

definition
  let G be _Graph;
  mode Component of G is Component-like Subgraph of G;
end;

definition
  let G be _Graph;
  func G.componentSet() -> non empty Subset-Family of the_Vertices_of G means


  for x being set holds x in it iff ex v being Vertex of G st x = G
  .reachableFrom(v);
end;

registration
  let G be _Graph, X be Element of G.componentSet();
  cluster -> Component-like for inducedSubgraph of G,X;
end;

definition
  let G be _Graph;
  func G.numComponents() -> Cardinal equals

  card G.componentSet();
end;

definition
  let G be finite _Graph;
  redefine func G.numComponents() -> non empty Element of NAT;
end;

definition
  let G be _Graph, v be Vertex of G;
  attr v is cut-vertex means


  for G2 being removeVertex of G,v holds G
  .numComponents() in G2.numComponents();
end;

definition
  let G be finite _Graph, v be Vertex of G;
  redefine attr v is cut-vertex means


  for G2 being removeVertex of G,v
  holds G.numComponents() < G2.numComponents();
end;

registration
  let G be non trivial finite connected _Graph;
  cluster non cut-vertex for Vertex of G;
end;

registration
  let G be non trivial finite Tree-like _Graph;
  cluster endvertex for Vertex of G;
end;

registration
  let G be non trivial finite Tree-like _Graph, v be endvertex Vertex of G;
  cluster -> Tree-like for removeVertex of G,v;
end;

definition
  let GSq be GraphSeq;
  attr GSq is connected means


  for n being Nat holds GSq.n is connected;
  attr GSq is acyclic means


  for n being Nat holds GSq.n is acyclic;
  attr GSq is Tree-like means


  for n being Nat holds GSq.n is Tree-like;
end;

registration
  cluster trivial -> connected for GraphSeq;
  cluster trivial loopless -> Tree-like for GraphSeq;
  cluster acyclic -> simple for GraphSeq;
  cluster Tree-like -> acyclic connected for GraphSeq;
  cluster acyclic connected -> Tree-like for GraphSeq;
end;

registration
  cluster halting finite Tree-like for GraphSeq;
end;

registration
  let GSq be connected GraphSeq, n be Nat;
  cluster GSq.n -> connected for _Graph;
end;

registration
  let GSq be acyclic GraphSeq, n be Nat;
  cluster GSq.n -> acyclic for _Graph;
end;

registration
  let GSq be Tree-like GraphSeq, n be Nat;
  cluster GSq.n -> Tree-likefor _Graph;
end;

begin 

reserve G,G1,G2 for _Graph;
reserve e,x,y for set;
reserve v,v1,v2 for Vertex of G;
reserve W for Walk of G;

canceled;

theorem 
  for G being non trivial connected _Graph, v being Vertex of G
  holds not v is isolated;

theorem 
  for G1 being non trivial _Graph, v being Vertex of G1, G2 being
removeVertex of G1,v st G2 is connected & ex e being set st e in v.edgesInOut()
  & not e Joins v,v,G1 holds G1 is connected;

theorem 
  for G1 being non trivial connected _Graph, v being Vertex of G1, G2
  being removeVertex of G1,v st v is endvertex holds G2 is connected;

theorem 
  for G1 being connected _Graph, W being Walk of G1, e being set,
  G2 being removeEdge of G1,e st W is Cycle-like & e in W.edges() holds G2 is
  connected;

theorem 
  (ex v1 being Vertex of G st for v2 being Vertex of G ex W being Walk
  of G st W is_Walk_from v1,v2) implies G is connected;

theorem 
  for G being trivial _Graph holds G is connected;

theorem 
  G1 == G2 & G1 is connected implies G2 is connected;

theorem 
  v in G.reachableFrom(v);

theorem 
  x in G.reachableFrom(v1) & e Joins x,y,G implies y in G.reachableFrom(
  v1);

theorem 
  G.edgesBetween(G.reachableFrom(v)) = G.edgesInOut(G.reachableFrom(v));

theorem 
  v1 in G.reachableFrom(v2) implies G.reachableFrom(v1) = G
  .reachableFrom(v2);

theorem 
  v in W.vertices() implies W.vertices() c= G.reachableFrom(v);

theorem 
  for G1 being _Graph, G2 being Subgraph of G1, v1 being Vertex of G1,
v2 being Vertex of G2 st v1 = v2 holds G2.reachableFrom(v2) c= G1.reachableFrom
  (v1);

theorem 
  (ex v being Vertex of G st G.reachableFrom(v) = the_Vertices_of G)
  implies G is connected;

theorem 
  G is connected implies for v being Vertex of G holds G.reachableFrom(v
  ) = the_Vertices_of G;

theorem 
  for v1 being Vertex of G1, v2 being Vertex of G2 st G1 == G2 & v1 = v2
  holds G1.reachableFrom(v1) = G2.reachableFrom(v2);

theorem 
  v in G.reachableDFrom(v);

theorem 
  x in G.reachableDFrom(v1) & e DJoins x,y,G implies y in G .reachableDFrom(v1)
;

theorem 
  G.reachableDFrom(v) c= G.reachableFrom(v);

theorem 
  for G1 being _Graph, G2 being Subgraph of G1, v1 being Vertex of G1,
  v2 being Vertex of G2 st v1 = v2 holds G2.reachableDFrom(v2) c= G1
  .reachableDFrom(v1);

theorem 
  for v1 being Vertex of G1, v2 being Vertex of G2 st G1 == G2 & v1 = v2
  holds G1.reachableDFrom(v1) = G2.reachableDFrom(v2);

theorem 
  for G1 being _Graph, G2 being connected Subgraph of G1 holds G2 is
  spanning implies G1 is connected;

theorem 
  union G.componentSet() = the_Vertices_of G;

theorem 
  G is connected iff G.componentSet() = {the_Vertices_of G};

theorem 
  G1 == G2 implies G1.componentSet() = G2.componentSet();

theorem 
  x in G.componentSet() implies x is non empty Subset of the_Vertices_of
  G;

theorem 
  G is connected iff G.numComponents() = 1;

theorem 
  G1 == G2 implies G1.numComponents() = G2.numComponents();

theorem 
  G is Component of G iff G is connected;

theorem 
  for C being Component of G holds the_Edges_of C = G.edgesBetween(
  the_Vertices_of C);

theorem 
  for C1,C2 being Component of G holds the_Vertices_of C1 =
  the_Vertices_of C2 iff C1 == C2;

theorem 
  for C being Component of G, v being Vertex of G holds v in
  the_Vertices_of C iff the_Vertices_of C = G.reachableFrom(v);

theorem 
  for C1,C2 being Component of G, v being set st v in the_Vertices_of C1
  & v in the_Vertices_of C2 holds C1 == C2;

theorem 
  for G being connected _Graph, v being Vertex of G holds v is non
  cut-vertex iff for G2 being removeVertex of G,v holds G2.numComponents() c= G
  .numComponents();

theorem 
  for G being connected _Graph, v being Vertex of G, G2 being
  removeVertex of G,v st not v is cut-vertex holds G2 is connected;

theorem 
  for G being non trivial finite connected _Graph holds ex v1,v2 being
Vertex of G st v1 <> v2 & not v1 is cut-vertex & not v2 is cut-vertex;

theorem 
  v is cut-vertex implies G is non trivial;

theorem 
  for v1 being Vertex of G1, v2 being Vertex of G2 st G1 == G2 & v1 = v2
  holds v1 is cut-vertex implies v2 is cut-vertex;

theorem 
  for G being finite connected _Graph holds G.order() <= G.size() + 1;

theorem 
  for G being acyclic _Graph holds G is simple;

theorem 
  for G being acyclic _Graph, W being Path of G, e being set st not e in
W.edges() & e in W.last().edgesInOut() holds W.addEdge(e) is Path-like;

theorem 
  for G being non trivial finite acyclic _Graph st the_Edges_of G <> {}
  holds ex v1,v2 being Vertex of G st v1 <> v2 & v1 is endvertex & v2 is
  endvertex & v2 in G.reachableFrom(v1);

theorem 
  G1 == G2 & G1 is acyclic implies G2 is acyclic;

theorem 
  for G being non trivial finite Tree-like _Graph holds ex v1,v2 being
  Vertex of G st v1 <> v2 & v1 is endvertex & v2 is endvertex;

theorem 
  for G being finite _Graph holds G is Tree-like iff G is acyclic
  & G.order() = G.size() + 1;

theorem 
  for G being finite _Graph holds G is Tree-like iff G is connected & G
  .order() = G.size() + 1;

theorem 
  G1 == G2 & G1 is Tree-like implies G2 is Tree-like;

theorem 
  G is_DTree_rooted_at x implies x is Vertex of G;

theorem 
  G1 == G2 & G1 is_DTree_rooted_at x implies G2 is_DTree_rooted_at x;














begin 

definition
  let D be set, fs be FinSequence of D, fss be Subset of fs;
  redefine func Seq fss -> FinSequence of D;
end;

theorem 
  for x1,x2,x3,x4,x5,x6,x7,x8,x9,x10 being set, p being FinSequence st p
  =<*x1*>^<*x2*>^<*x3*>^<*x4*>^<*x5*>^<*x6*>^<*x7*>^<*x8*>^<*x9*>^<*x10*> holds
len p = 10 & p.1 = x1 & p.2 = x2 & p.3 = x3 & p.4 = x4 & p.5 = x5 & p.6 = x6 &
  p.7 = x7 & p.8 = x8 & p.9 = x9 & p.10 = x10;

theorem 
  for fs being FinSequence of REAL, fss being Subset of fs holds (
  for i being Element of NAT st i in dom fs holds 0 <= fs.i ) implies Sum (Seq
  fss) <= Sum fs;

begin 

definition
  func WeightSelector -> Element of NAT equals

  5;
  func ELabelSelector -> Element of NAT equals

  6;
  func VLabelSelector -> Element of NAT equals

  7;
end;

definition
  let G be GraphStruct;
  attr G is [Weighted] means


  WeightSelector in dom G & G.WeightSelector
  is ManySortedSet of the_Edges_of G;
  attr G is [ELabeled] means


  ELabelSelector in dom G & ex f being
  Function st G.ELabelSelector = f & dom f c= the_Edges_of G;
  attr G is [VLabeled] means


  VLabelSelector in dom G & ex f being
  Function st G.VLabelSelector = f & dom f c= the_Vertices_of G;
end;

registration
  cluster [Graph-like] [Weighted] [ELabeled] [VLabeled] for GraphStruct;
end;

definition
  mode WGraph is [Weighted] _Graph;
  mode EGraph is [ELabeled] _Graph;
  mode VGraph is [VLabeled] _Graph;
  mode WEGraph is [Weighted] [ELabeled] _Graph;
  mode WVGraph is [Weighted] [VLabeled] _Graph;
  mode EVGraph is [ELabeled] [VLabeled] _Graph;
  mode WEVGraph is [Weighted] [ELabeled] [VLabeled] _Graph;
end;

definition
  let G be WGraph;
  func the_Weight_of G -> ManySortedSet of the_Edges_of G equals

  G.
  WeightSelector;
end;

definition
  let G be EGraph;
  func the_ELabel_of G -> Function equals

  G.ELabelSelector;
end;

definition
  let G be VGraph;
  func the_VLabel_of G -> Function equals

  G.VLabelSelector;
end;

registration
  let G be _Graph, X be set;
  cluster G.set(WeightSelector, X) -> [Graph-like];
  cluster G.set(ELabelSelector, X) -> [Graph-like];
  cluster G.set(VLabelSelector, X) -> [Graph-like];
end;

registration
  let G be finite _Graph, X be set;
  cluster G.set(WeightSelector, X) -> finite;
  cluster G.set(ELabelSelector, X) -> finite;
  cluster G.set(VLabelSelector, X) -> finite;
end;

registration
  let G be loopless _Graph, X be set;
  cluster G.set(WeightSelector, X) -> loopless;
  cluster G.set(ELabelSelector, X) -> loopless;
  cluster G.set(VLabelSelector, X) -> loopless;
end;

registration
  let G be trivial _Graph, X be set;
  cluster G.set(WeightSelector, X) -> trivial;
  cluster G.set(ELabelSelector, X) -> trivial;
  cluster G.set(VLabelSelector, X) -> trivial;
end;

registration
  let G be non trivial _Graph, X be set;
  cluster G.set(WeightSelector, X) -> non trivial;
  cluster G.set(ELabelSelector, X) -> non trivial;
  cluster G.set(VLabelSelector, X) -> non trivial;
end;

registration
  let G be non-multi _Graph, X be set;
  cluster G.set(WeightSelector, X) -> non-multi;
  cluster G.set(ELabelSelector, X) -> non-multi;
  cluster G.set(VLabelSelector, X) -> non-multi;
end;

registration
  let G be non-Dmulti _Graph, X be set;
  cluster G.set(WeightSelector, X) -> non-Dmulti;
  cluster G.set(ELabelSelector, X) -> non-Dmulti;
  cluster G.set(VLabelSelector, X) -> non-Dmulti;
end;

registration
  let G be connected _Graph, X be set;
  cluster G.set(WeightSelector, X) -> connected;
  cluster G.set(ELabelSelector, X) -> connected;
  cluster G.set(VLabelSelector, X) -> connected;
end;

registration
  let G be acyclic _Graph, X be set;
  cluster G.set(WeightSelector, X) -> acyclic;
  cluster G.set(ELabelSelector, X) -> acyclic;
  cluster G.set(VLabelSelector, X) -> acyclic;
end;

registration
  let G be WGraph, X be set;
  cluster G.set(ELabelSelector, X) -> [Weighted];
  cluster G.set(VLabelSelector, X) -> [Weighted];
end;

registration
  let G be _Graph, X be ManySortedSet of the_Edges_of G;
  cluster G.set(WeightSelector, X) -> [Weighted];
end;

registration
  let G be _Graph, WL be non empty set, W be Function of the_Edges_of G, WL;
  cluster G.set(WeightSelector, W) -> [Weighted];
end;

registration
  let G be EGraph, X be set;
  cluster G.set(WeightSelector, X) -> [ELabeled];
  cluster G.set(VLabelSelector, X) -> [ELabeled];
end;

registration
  let G be _Graph, Y be set, X be PartFunc of the_Edges_of G, Y;
  cluster G.set(ELabelSelector, X) -> [ELabeled];
end;

registration
  let G be _Graph, X be ManySortedSet of the_Edges_of G;
  cluster G.set(ELabelSelector, X) -> [ELabeled];
end;

registration
  let G be VGraph, X be set;
  cluster G.set(WeightSelector, X) -> [VLabeled];
  cluster G.set(ELabelSelector, X) -> [VLabeled];
end;

registration
  let G be _Graph, Y be set, X be PartFunc of the_Vertices_of G,Y;
  cluster G.set(VLabelSelector, X) -> [VLabeled];
end;

registration
  let G be _Graph, X be ManySortedSet of the_Vertices_of G;
  cluster G.set(VLabelSelector, X) -> [VLabeled];
end;

registration
  let G be _Graph;
  cluster G.set(ELabelSelector, {}) -> [ELabeled];
  cluster G.set(VLabelSelector, {}) -> [VLabeled];
end;

registration
  let G be _Graph;
  cluster [Weighted] [ELabeled] [VLabeled] for Subgraph of G;
end;

definition
  let G be WGraph, G2 be [Weighted] Subgraph of G;
  attr G2 is weight-inheriting means


  the_Weight_of G2 = (the_Weight_of G) | the_Edges_of G2;
end;

definition
  let G be EGraph, G2 be [ELabeled] Subgraph of G;
  attr G2 is elabel-inheriting means


  the_ELabel_of G2 = (the_ELabel_of G) | the_Edges_of G2;
end;

definition
  let G be VGraph, G2 be [VLabeled] Subgraph of G;
  attr G2 is vlabel-inheriting means


  the_VLabel_of G2 = (the_VLabel_of G) | the_Vertices_of G2;
end;

registration
  let G be WGraph;
  cluster weight-inheriting for [Weighted] Subgraph of G;
end;

registration
  let G be EGraph;
  cluster elabel-inheriting for [ELabeled] Subgraph of G;
end;

registration
  let G be VGraph;
  cluster vlabel-inheriting for [VLabeled] Subgraph of G;
end;

registration
  let G be WEGraph;
  cluster weight-inheriting elabel-inheriting for
[Weighted] [ELabeled] Subgraph
    of G;
end;

registration
  let G be WVGraph;
  cluster weight-inheriting vlabel-inheriting for
[Weighted] [VLabeled] Subgraph
    of G;
end;

registration
  let G be EVGraph;
  cluster elabel-inheriting vlabel-inheriting for
[ELabeled] [VLabeled] Subgraph
    of G;
end;

registration
  let G be WEVGraph;
  cluster weight-inheriting elabel-inheriting vlabel-inheriting for [Weighted]
    [ELabeled] [VLabeled] Subgraph of G;
end;

definition
  let G be WGraph;
  mode WSubgraph of G is weight-inheriting [Weighted] Subgraph of G;
end;

definition
  let G be EGraph;
  mode ESubgraph of G is elabel-inheriting [ELabeled] Subgraph of G;
end;

definition
  let G be VGraph;
  mode VSubgraph of G is vlabel-inheriting [VLabeled] Subgraph of G;
end;

definition
  let G be WEGraph;
  mode WESubgraph of G is weight-inheriting elabel-inheriting [Weighted]
    [ELabeled] Subgraph of G;
end;

definition
  let G be WVGraph;
  mode WVSubgraph of G is weight-inheriting vlabel-inheriting [Weighted]
    [VLabeled] Subgraph of G;
end;

definition
  let G be EVGraph;
  mode EVSubgraph of G is elabel-inheriting vlabel-inheriting [ELabeled]
    [VLabeled] Subgraph of G;
end;

definition
  let G be WEVGraph;
  mode WEVSubgraph of G is weight-inheriting elabel-inheriting
    vlabel-inheriting [Weighted] [ELabeled] [VLabeled] Subgraph of G;
end;

registration
  let G be _Graph, V,E be set;
  cluster [Weighted] [ELabeled] [VLabeled] for inducedSubgraph of G,V,E;
end;

registration
  let G be WGraph, V,E be set;
  cluster weight-inheriting for [Weighted] inducedSubgraph of G,V,E;
end;

registration
  let G be EGraph, V,E be set;
  cluster elabel-inheriting for [ELabeled] inducedSubgraph of G,V,E;
end;

registration
  let G be VGraph, V,E be set;
  cluster vlabel-inheriting for [VLabeled] inducedSubgraph of G,V,E;
end;

registration
  let G be WEGraph, V,E be set;
  cluster weight-inheriting elabel-inheriting for [Weighted] [ELabeled]
    inducedSubgraph of G,V,E;
end;

registration
  let G be WVGraph, V,E be set;
  cluster weight-inheriting vlabel-inheriting for [Weighted] [VLabeled]
    inducedSubgraph of G,V,E;
end;

registration
  let G be EVGraph, V,E be set;
  cluster elabel-inheriting vlabel-inheriting for [ELabeled] [VLabeled]
    inducedSubgraph of G,V,E;
end;

registration
  let G be WEVGraph, V,E be set;
  cluster weight-inheriting elabel-inheriting vlabel-inheriting for [Weighted]
    [ELabeled] [VLabeled] inducedSubgraph of G,V,E;
end;

definition
  let G be WGraph, V,E be set;
  mode inducedWSubgraph of G,V,E is weight-inheriting [Weighted]
    inducedSubgraph of G,V,E;
end;

definition
  let G be EGraph, V,E be set;
  mode inducedESubgraph of G,V,E is elabel-inheriting [ELabeled]
    inducedSubgraph of G,V,E;
end;

definition
  let G be VGraph, V,E be set;
  mode inducedVSubgraph of G,V,E is vlabel-inheriting [VLabeled]
    inducedSubgraph of G,V,E;
end;

definition
  let G be WEGraph, V,E be set;
  mode inducedWESubgraph of G,V,E is weight-inheriting elabel-inheriting
    [Weighted] [ELabeled] inducedSubgraph of G,V,E;
end;

definition
  let G be WVGraph, V,E be set;
  mode inducedWVSubgraph of G,V,E is weight-inheriting vlabel-inheriting
    [Weighted] [VLabeled] inducedSubgraph of G,V,E;
end;

definition
  let G be EVGraph, V,E be set;
  mode inducedEVSubgraph of G,V,E is elabel-inheriting vlabel-inheriting
    [ELabeled] [VLabeled] inducedSubgraph of G,V,E;
end;

definition
  let G be WEVGraph, V,E be set;
  mode inducedWEVSubgraph of G,V,E is weight-inheriting elabel-inheriting
vlabel-inheriting [Weighted] [ELabeled] [VLabeled] inducedSubgraph of G,V,E;
end;

definition
  let G be WGraph, V be set;
  mode inducedWSubgraph of G,V is inducedWSubgraph of G,V,G.edgesBetween(V);
end;

definition
  let G be EGraph, V be set;
  mode inducedESubgraph of G,V is inducedESubgraph of G,V,G.edgesBetween(V);
end;

definition
  let G be VGraph, V be set;
  mode inducedVSubgraph of G,V is inducedVSubgraph of G,V,G.edgesBetween(V);
end;

definition
  let G be WEGraph, V be set;
  mode inducedWESubgraph of G,V is inducedWESubgraph of G,V,G.edgesBetween(V);
end;

definition
  let G be WVGraph, V be set;
  mode inducedWVSubgraph of G,V is inducedWVSubgraph of G,V,G.edgesBetween(V);
end;

definition
  let G be EVGraph, V be set;
  mode inducedEVSubgraph of G,V is inducedEVSubgraph of G,V,G.edgesBetween(V);
end;

definition
  let G be WEVGraph, V be set;
  mode inducedWEVSubgraph of G,V is inducedWEVSubgraph of G,V,G.edgesBetween(V
    );
end;

definition
  let G be WGraph;
  attr G is real-weighted means


  the_Weight_of G is real-valued;
end;

definition
  let G be WGraph;
  attr G is nonnegative-weighted means


  rng the_Weight_of G c= Real>=0;
end;

registration
  cluster nonnegative-weighted -> real-weighted for WGraph;
end;

definition
  let G be EGraph;
  attr G is real-elabeled means


  the_ELabel_of G is real-valued;
end;

definition
  let G be VGraph;
  attr G is real-vlabeled means


  the_VLabel_of G is real-valued;
end;

definition
  let G be WEVGraph;
  attr G is real-WEV means


  G is real-weighted & G is real-elabeled & G is real-vlabeled;
end;

registration
  cluster real-WEV -> real-weighted real-elabeled real-vlabeled for WEVGraph;
  cluster real-weighted real-elabeled real-vlabeled -> real-WEV for WEVGraph;
end;

registration
  let G be _Graph, X be Function of the_Edges_of G, REAL;
  cluster G.set(WeightSelector,X) -> real-weighted;
end;

registration
  let G be _Graph, X be PartFunc of the_Edges_of G, REAL;
  cluster G.set(ELabelSelector, X) -> real-elabeled;
end;

registration
  let G be _Graph, X be real-valued ManySortedSet of the_Edges_of G;
  cluster G.set(ELabelSelector,X) -> real-elabeled;
end;

registration
  let G be _Graph, X be PartFunc of the_Vertices_of G, REAL;
  cluster G.set(VLabelSelector, X) -> real-vlabeled;
end;

registration
  let G be _Graph, X be real-valued ManySortedSet of the_Vertices_of G;
  cluster G.set(VLabelSelector, X) -> real-vlabeled;
end;

registration
  let G be _Graph;
  cluster G.set(ELabelSelector, {}) -> real-elabeled;
  cluster G.set(VLabelSelector, {}) -> real-vlabeled;
end;

registration
  let G be _Graph, v be Vertex of G, val be real number;
  cluster G.set(VLabelSelector, v.-->val) -> [VLabeled];
end;

registration
  let G be _Graph, v be Vertex of G, val be real number;
  cluster G.set(VLabelSelector, v.-->val) -> real-vlabeled;
end;

registration
  cluster finite trivial Tree-like nonnegative-weighted real-WEV for WEVGraph;
  cluster finite non trivial Tree-like nonnegative-weighted real-WEV for
WEVGraph;
end;

registration
  let G be finite WGraph;
  cluster the_Weight_of G -> finite;
end;

registration
  let G be finite EGraph;
  cluster the_ELabel_of G -> finite;
end;

registration
  let G be finite VGraph;
  cluster the_VLabel_of G -> finite;
end;

registration
  let G be real-weighted WGraph;
  cluster the_Weight_of G -> real-valued;
end;

registration
  let G be real-elabeled EGraph;
  cluster the_ELabel_of G -> real-valued;
end;

registration
  let G be real-vlabeled VGraph;
  cluster the_VLabel_of G -> real-valued;
end;

registration
  let G be real-weighted WGraph, X be set;
  cluster G.set(ELabelSelector ,X) -> real-weighted;
  cluster G.set(VLabelSelector ,X) -> real-weighted;
end;

registration
  let G be nonnegative-weighted WGraph, X be set;
  cluster G.set(ELabelSelector ,X) -> nonnegative-weighted;
  cluster G.set(VLabelSelector ,X) -> nonnegative-weighted;
end;

registration
  let G be real-elabeled EGraph, X be set;
  cluster G.set(WeightSelector ,X) -> real-elabeled;
  cluster G.set(VLabelSelector ,X) -> real-elabeled;
end;

registration
  let G be real-vlabeled VGraph, X be set;
  cluster G.set(WeightSelector ,X) -> real-vlabeled;
  cluster G.set(ELabelSelector ,X) -> real-vlabeled;
end;

definition
  let G be WGraph, W be Walk of G;
  func W.weightSeq() -> FinSequence means


  len it = len W.edgeSeq() &
  for n being Nat st 1 <= n & n <= len it holds it.n = (the_Weight_of G).(W
  .edgeSeq().n);
end;

definition
  let G be real-weighted WGraph, W be Walk of G;
  redefine func W.weightSeq() -> FinSequence of REAL;
end;

definition
  let G be real-weighted WGraph, W be Walk of G;
  func W.cost() -> Real equals

  Sum (W.weightSeq());
end;

definition
  let G be EGraph;
  func G.labeledE() -> Subset of the_Edges_of G equals

  dom the_ELabel_of G;
end;

definition
  let G be EGraph, e,x be set;
  func G.labelEdge(e,x) -> EGraph equals


  G.set(ELabelSelector,
  the_ELabel_of G +* (e.-->x)) if e in the_Edges_of G otherwise G;
end;

registration
  let G be finite EGraph, e,x be set;
  cluster G.labelEdge(e,x) -> finite;
end;

registration
  let G be loopless EGraph, e,x be set;
  cluster G.labelEdge(e,x) -> loopless;
end;

registration
  let G be trivial EGraph, e,x be set;
  cluster G.labelEdge(e,x) -> trivial;
end;

registration
  let G be non trivial EGraph, e,x be set;
  cluster G.labelEdge(e,x) -> non trivial;
end;

registration
  let G be non-multi EGraph, e,x be set;
  cluster G.labelEdge(e,x) -> non-multi;
end;

registration
  let G be non-Dmulti EGraph, e,x be set;
  cluster G.labelEdge(e,x) -> non-Dmulti;
end;

registration
  let G be connected EGraph, e,x be set;
  cluster G.labelEdge(e,x) -> connected;
end;

registration
  let G be acyclic EGraph, e,x be set;
  cluster G.labelEdge(e,x) -> acyclic;
end;

registration
  let G be WEGraph, e,x be set;
  cluster G.labelEdge(e,x) -> [Weighted];
end;

registration
  let G be EVGraph, e,x be set;
  cluster G.labelEdge(e,x) -> [VLabeled];
end;

registration
  let G be real-weighted WEGraph, e,x be set;
  cluster G.labelEdge(e,x) -> real-weighted;
end;

registration
  let G be nonnegative-weighted WEGraph, e,x be set;
  cluster G.labelEdge(e,x) -> nonnegative-weighted;
end;

registration
  let G be real-elabeled EGraph, e be set, x be Real;
  cluster G.labelEdge(e,x) -> real-elabeled;
end;

registration
  let G be real-vlabeled EVGraph, e,x be set;
  cluster G.labelEdge(e,x) -> real-vlabeled;
end;

definition
  let G be VGraph, v,x be set;
  func G.labelVertex(v,x) -> VGraph equals


  G.set(VLabelSelector,
  the_VLabel_of G +* (v.-->x)) if v in the_Vertices_of G otherwise G;
end;

definition
  let G be VGraph;
  func G.labeledV() -> Subset of the_Vertices_of G equals

  dom the_VLabel_of G;
end;

registration
  let G be finite VGraph, v,x be set;
  cluster G.labelVertex(v,x) -> finite;
end;

registration
  let G be loopless VGraph, v,x be set;
  cluster G.labelVertex(v,x) -> loopless;
end;

registration
  let G be trivial VGraph, v,x be set;
  cluster G.labelVertex(v,x) -> trivial;
end;

registration
  let G be non trivial VGraph, v,x be set;
  cluster G.labelVertex(v,x) -> non trivial;
end;

registration
  let G be non-multi VGraph, v,x be set;
  cluster G.labelVertex(v,x) -> non-multi;
end;

registration
  let G be non-Dmulti VGraph, v,x be set;
  cluster G.labelVertex(v,x) -> non-Dmulti;
end;

registration
  let G be connected VGraph, v,x be set;
  cluster G.labelVertex(v,x) -> connected;
end;

registration
  let G be acyclic VGraph, v,x be set;
  cluster G.labelVertex(v,x) -> acyclic;
end;

registration
  let G be WVGraph, v,x be set;
  cluster G.labelVertex(v,x) -> [Weighted];
end;

registration
  let G be EVGraph, v,x be set;
  cluster G.labelVertex(v,x) -> [ELabeled];
end;

registration
  let G be real-weighted WVGraph, v,x be set;
  cluster G.labelVertex(v,x) -> real-weighted;
end;

registration
  let G be nonnegative-weighted WVGraph, v,x be set;
  cluster G.labelVertex(v,x) -> nonnegative-weighted;
end;

registration
  let G be real-elabeled EVGraph, v,x be set;
  cluster G.labelVertex(v,x) -> real-elabeled;
end;

registration
  let G be real-vlabeled VGraph, v be set, x be Real;
  cluster G.labelVertex(v,x) -> real-vlabeled;
end;

registration
  let G be real-weighted WGraph;
  cluster -> real-weighted for WSubgraph of G;
end;

registration
  let G be nonnegative-weighted WGraph;
  cluster -> nonnegative-weighted for WSubgraph of G;
end;

registration
  let G be real-elabeled EGraph;
  cluster -> real-elabeled for ESubgraph of G;
end;

registration
  let G be real-vlabeled VGraph;
  cluster -> real-vlabeled for VSubgraph of G;
end;

definition
  let GSq be GraphSeq;
  attr GSq is [Weighted] means


  for x being Nat holds GSq.x is [Weighted];
  attr GSq is [ELabeled] means


  for x being Nat holds GSq.x is [ELabeled];
  attr GSq is [VLabeled] means


  for x being Nat holds GSq.x is [VLabeled];
end;

registration
  cluster [Weighted] [ELabeled] [VLabeled] for GraphSeq;
end;

definition
  mode WGraphSeq is [Weighted] GraphSeq;
  mode EGraphSeq is [ELabeled] GraphSeq;
  mode VGraphSeq is [VLabeled] GraphSeq;
  mode WEGraphSeq is [Weighted] [ELabeled] GraphSeq;
  mode WVGraphSeq is [Weighted] [VLabeled] GraphSeq;
  mode EVGraphSeq is [ELabeled] [VLabeled] GraphSeq;
  mode WEVGraphSeq is [Weighted] [ELabeled] [VLabeled] GraphSeq;
end;

registration
  let GSq be WGraphSeq, x be Nat;
  cluster GSq.x -> [Weighted]for _Graph;
end;

registration
  let GSq be EGraphSeq, x be Nat;
  cluster GSq.x -> [ELabeled]for _Graph;
end;

registration
  let GSq be VGraphSeq, x be Nat;
  cluster GSq.x -> [VLabeled]for _Graph;
end;

definition
  let GSq be WGraphSeq;
  attr GSq is real-weighted means


  for x being Nat holds GSq.x is real-weighted;
  attr GSq is nonnegative-weighted means


  for x being Nat holds GSq.x is nonnegative-weighted;
end;

definition
  let GSq be EGraphSeq;
  attr GSq is real-elabeled means


  for x being Nat holds GSq.x is real-elabeled;
end;

definition
  let GSq be VGraphSeq;
  attr GSq is real-vlabeled means


  for x being Nat holds GSq.x is real-vlabeled;
end;

definition
  let GSq be WEVGraphSeq;
  attr GSq is real-WEV means


  for x being Nat holds GSq.x is real-WEV;
end;

registration
  cluster real-WEV -> real-weighted real-elabeled real-vlabeled for
WEVGraphSeq;
  cluster real-weighted real-elabeled real-vlabeled -> real-WEV for
WEVGraphSeq;
end;

registration
  cluster halting finite loopless trivial non-multi simple real-WEV
    nonnegative-weighted Tree-like for WEVGraphSeq;
end;

registration
  let GSq be real-weighted WGraphSeq, x be Nat;
  cluster GSq.x -> real-weighted for WGraph;
end;

registration
  let GSq be nonnegative-weighted WGraphSeq, x be Nat;
  cluster GSq.x -> nonnegative-weighted for WGraph;
end;

registration
  let GSq be real-elabeled EGraphSeq, x be Nat;
  cluster GSq.x -> real-elabeled for EGraph;
end;

registration
  let GSq be real-vlabeled VGraphSeq, x be Nat;
  cluster GSq.x -> real-vlabeled for VGraph;
end;

begin 

theorem 
  WeightSelector = 5 & ELabelSelector = 6 & VLabelSelector = 7;

theorem 
  (for G being WGraph holds the_Weight_of G = G.WeightSelector) & (for G
  being EGraph holds the_ELabel_of G = G.ELabelSelector) & for G being VGraph
  holds the_VLabel_of G = G.VLabelSelector;

theorem 
  for G being EGraph holds dom the_ELabel_of G c= the_Edges_of G;

theorem 
  for G being VGraph holds dom the_VLabel_of G c= the_Vertices_of G;



theorem 
  for G being _Graph, X being set holds G == G.set(WeightSelector, X) &
  G == G.set(ELabelSelector, X) & G == G.set(VLabelSelector, X);



theorem 
  for G1,G2 being WGraph, G3 being WGraph st G1 == G2 & the_Weight_of G1
  = the_Weight_of G2 & G1 is WSubgraph of G3 holds G2 is WSubgraph of G3;

theorem 
  for G1 being WGraph, G2 being WSubgraph of G1, G3 being WSubgraph of
  G2 holds G3 is WSubgraph of G1;

theorem 
  for G1,G2 being WGraph, G3 being WSubgraph of G1 st G1 == G2 &
  the_Weight_of G1 = the_Weight_of G2 holds G3 is WSubgraph of G2;

theorem 
  for G1 being WGraph, G2 be WSubgraph of G1 holds for x being set st x
  in the_Edges_of G2 holds (the_Weight_of G2).x = (the_Weight_of G1).x;



theorem 
  for G being WGraph, W being Walk of G holds W is trivial implies
  W.weightSeq() = {};

theorem 
  for G being WGraph, W being Walk of G holds len W.weightSeq() = W .length();

theorem 
  for G being WGraph, x,y,e being set st e Joins x,y,G holds G
  .walkOf(x,e,y).weightSeq() = <* (the_Weight_of G).e *>;

theorem 
  for G being WGraph, W being Walk of G holds W.reverse()
  .weightSeq() = Rev (W.weightSeq());

theorem 
  for G being WGraph, W1,W2 being Walk of G st W1.last() = W2
  .first() holds W1.append(W2).weightSeq() = W1.weightSeq() ^ W2.weightSeq();

theorem 
  for G being WGraph, W being Walk of G, e being set st e in W
  .last().edgesInOut() holds W.addEdge(e).weightSeq() = W.weightSeq() ^ <* (
  the_Weight_of G).e *>;

theorem 
  for G being real-weighted WGraph, W1 being Walk of G, W2 being
  Subwalk of W1 holds ex ws being Subset of W1.weightSeq() st W2.weightSeq() =
  Seq ws;

theorem 
  for G1,G2 being WGraph, W1 being Walk of G1, W2 being Walk of G2
  st W1 = W2 & the_Weight_of G1 = the_Weight_of G2 holds W1.weightSeq() = W2
  .weightSeq();

theorem 
  for G1 being WGraph, G2 being WSubgraph of G1, W1 being Walk of
  G1, W2 being Walk of G2 st W1 = W2 holds W1.weightSeq() = W2.weightSeq();



theorem 
  for G being real-weighted WGraph, W being Walk of G holds W is trivial
  implies W.cost() = 0;

theorem 
  for G being real-weighted WGraph, v1,v2 being Vertex of G, e being set
  st e Joins v1,v2,G holds (G.walkOf(v1,e,v2)).cost() = (the_Weight_of G).e;

theorem 
  for G being real-weighted WGraph, W being Walk of G holds W.cost() = W
  .reverse().cost();

theorem 
  for G being real-weighted WGraph, W1, W2 being Walk of G st W1.last()
  = W2.first() holds W1.append(W2).cost() = W1.cost() + W2.cost();

theorem 
  for G being real-weighted WGraph, W be Walk of G, e be set st e in W
.last().edgesInOut() holds W.addEdge(e).cost() = W.cost() + (the_Weight_of G).e
;

theorem 
  for G1,G2 being real-weighted WGraph, W1 being Walk of G1,W2 being
  Walk of G2 st W1 = W2 & the_Weight_of G1 = the_Weight_of G2 holds W1.cost() =
  W2.cost();

theorem 
  for G1 being real-weighted WGraph, G2 being WSubgraph of G1, W1 being
Walk of G1, W2 being Walk of G2 st W1 = W2 holds W1.cost() = W2.cost();



theorem 
  for G being nonnegative-weighted WGraph, W being Walk of G, n
  being Element of NAT st n in dom W.weightSeq() holds 0 <= (W.weightSeq()).n;

theorem 
  for G being nonnegative-weighted WGraph, W being Walk of G holds 0 <=
  W.cost();

theorem 
  for G being nonnegative-weighted WGraph, W1 being Walk of G, W2 being
  Subwalk of W1 holds W2.cost() <= W1.cost();

theorem 
  for G being nonnegative-weighted WGraph, e be set holds e in
  the_Edges_of G implies 0 <= (the_Weight_of G).e;



theorem 
  for G being EGraph, e,x being set st e in the_Edges_of G holds
  the_ELabel_of G.labelEdge(e,x) = the_ELabel_of G +* (e .--> x);

theorem 
  for G being EGraph, e,x being set st e in the_Edges_of G holds (
  the_ELabel_of G.labelEdge(e,x)).e = x;

theorem 
  for G being EGraph, e,x being set holds G == G.labelEdge(e,x);

theorem 
  for G being WEGraph, e,x being set holds the_Weight_of G =
  the_Weight_of G.labelEdge(e,x);

theorem 
  for G being EVGraph, e,x being set holds the_VLabel_of G =
  the_VLabel_of G.labelEdge(e,x);

theorem 
  for G being EGraph, e1,e2,x being set st e1 <> e2 holds (the_ELabel_of
  G.labelEdge(e1,x)).e2 = (the_ELabel_of G).e2;



theorem 
  for G being VGraph, v,x being set st v in the_Vertices_of G
  holds the_VLabel_of G.labelVertex(v,x) = the_VLabel_of G +* (v .--> x);

theorem 
  for G being VGraph, v,x being set st v in the_Vertices_of G holds (
  the_VLabel_of G.labelVertex(v,x)).v = x;

theorem 
  for G being VGraph, v,x being set holds G == G.labelVertex(v,x);

theorem 
  for G being WVGraph, v,x being set holds the_Weight_of G =
  the_Weight_of G.labelVertex(v,x);

theorem 
  for G being EVGraph, v,x being set holds the_ELabel_of G =
  the_ELabel_of G.labelVertex(v,x);

theorem 
  for G being VGraph, v1,v2,x being set st v1 <> v2 holds (the_VLabel_of
  G.labelVertex(v1,x)).v2 = (the_VLabel_of G).v2;



theorem 
  for G1,G2 being EGraph st the_ELabel_of G1 = the_ELabel_of G2 holds G1
  .labeledE() = G2.labeledE();

theorem 
  for G being EGraph, e,x being set st e in the_Edges_of G holds G
  .labelEdge(e,x).labeledE() = G.labeledE() \/ {e};

theorem 
  for G being EGraph, e,x being set st e in the_Edges_of G holds G
  .labeledE() c= G.labelEdge(e,x).labeledE();

theorem 
  for G being finite EGraph, e, x being set st e in the_Edges_of G & not
e in G.labeledE() holds card G.labelEdge(e,x).labeledE() = card G.labeledE() +
  1;

theorem 
  for G being EGraph, e1,e2,x being set st not e2 in G.labeledE() & e2
  in G.labelEdge(e1,x).labeledE() holds e1 = e2 & e1 in the_Edges_of G;

theorem 
  for G being EVGraph, v,x being set holds G.labeledE() = G.labelVertex(
  v,x).labeledE();

theorem 
  for G being EGraph, e,x being set st e in the_Edges_of G holds e in G
  .labelEdge(e,x).labeledE();



theorem 
  for G1,G2 being VGraph st the_VLabel_of G1 = the_VLabel_of G2 holds G1
  .labeledV() = G2.labeledV();

theorem 
  for G being VGraph, v,x being set st v in the_Vertices_of G
  holds G.labelVertex(v,x).labeledV() = G.labeledV() \/ {v};

theorem 
  for G being VGraph, v,x being set st v in the_Vertices_of G holds G
  .labeledV() c= G.labelVertex(v,x).labeledV();

theorem 
  for G being finite VGraph, v, x being set st v in the_Vertices_of G &
  not v in G.labeledV() holds card G.labelVertex(v,x).labeledV() = card G
  .labeledV() + 1;

theorem 
  for G being VGraph, v1,v2,x being set st not v2 in G.labeledV() & v2
  in G.labelVertex(v1,x).labeledV() holds v1 = v2 & v1 in the_Vertices_of G;

theorem 
  for G being EVGraph, e,x being set holds G.labeledV() = G.labelEdge(e,
  x).labeledV();

theorem 
  for G being VGraph, v being Vertex of G, x being set holds v in G
  .labelVertex(v,x).labeledV();















begin

theorem 
  for f, g being Function holds support (f +* g) c= support f \/ support g;

theorem 
  for f being Function, x, y being set holds support (f +* (x.-->y)
  ) c= support f \/ {x};

theorem 
  for A,B being set, b being Rbag of A, b1 being Rbag of B, b2
  being Rbag of A\B st b = b1 +* b2 holds Sum b = Sum b1 + Sum b2;

theorem 
  for X,x being set, b being Rbag of X st dom b = {x} holds Sum b = b.x;

theorem 
  for A being set, b1,b2 being Rbag of A st (for x being set st x
  in A holds b1.x <= b2.x) holds Sum b1 <= Sum b2;

theorem 
  for A being set, b1,b2 being Rbag of A st (for x being set st x in A
  holds b1.x = b2.x) holds Sum b1 = Sum b2;

theorem 
  for A1,A2 being set, b1 being Rbag of A1, b2 being Rbag of A2 st b1 =
  b2 holds Sum b1 = Sum b2;

theorem 
  for X, x being set, b being Rbag of X, y being real number st b =
  (EmptyBag X) +* (x.-->y) holds Sum b = y;

theorem 
  for X, x being set, b1, b2 being Rbag of X, y being real number st b2
  = b1 +* (x.-->y) holds Sum b2 = Sum b1 + y - b1.x;

begin 

definition
  let G1 be real-weighted WGraph, G2 be WSubgraph of G1, v be set;
  pred G2 is_mincost_DTree_rooted_at v means


  G2 is Tree-like & for x
  being Vertex of G2 holds ex W2 being DPath of G2 st W2 is_Walk_from v,x & for
  W1 being DPath of G1 st W1 is_Walk_from v,x holds W2.cost() <= W1.cost();
end;

definition
  let G be real-weighted WGraph, W be DPath of G, x,y be set;
  pred W is_mincost_DPath_from x,y means


  W is_Walk_from x,y & for W2
  being DPath of G st W2 is_Walk_from x,y holds W.cost() <= W2.cost();
end;

definition
  let G be finite real-weighted WGraph, x,y be set;
  func G.min_DPath_cost(x,y) -> Real means


  ex W being DPath of G st W
  is_mincost_DPath_from x,y & it = W.cost() if ex W being DWalk of G st W
  is_Walk_from x,y otherwise it = 0;
end;

definition
  func WGraphSelectors -> non empty finite Subset of NAT equals

  {
VertexSelector, EdgeSelector, SourceSelector, TargetSelector, WeightSelector};
end;

registration
  let G be WGraph;
  cluster G|(WGraphSelectors) -> [Graph-like] [Weighted];
end;

definition
  let G be WGraph;
  func G.allWSubgraphs() -> non empty set means


  for x being set holds x
  in it iff ex G2 being WSubgraph of G st x = G2 & dom G2 = WGraphSelectors;
end;

registration
  let G be finite WGraph;
  cluster G.allWSubgraphs() -> finite;
end;

definition
  let G be WGraph, X be non empty Subset of G.allWSubgraphs();
  redefine mode Element of X -> WSubgraph of G;
end;

definition
  let G be finite real-weighted WGraph;
  func G.cost() -> Real equals

  Sum the_Weight_of G;
end;

theorem 
  for G1 being finite real-weighted WGraph, e being set, G2 being
weight-inheriting [Weighted] removeEdge of G1,e st e in the_Edges_of G1 holds
  G1.cost() = G2.cost() + (the_Weight_of G1).e;

theorem 
  for G being finite real-weighted WGraph, V1 being non empty
  Subset of the_Vertices_of G, E1 being Subset of G.edgesBetween(V1), G1 being
inducedWSubgraph of G,V1,E1, e being set, G2 being inducedWSubgraph of G,V1,E1
  \/ {e} st not e in E1 & e in G.edgesBetween(V1) holds G1.cost() + (
  the_Weight_of G).e = G2.cost();

theorem 
  for G being finite nonnegative-weighted WGraph, W being DPath of
G, x,y being set, m,n being Element of NAT st W is_mincost_DPath_from x,y holds
  W.cut(m,n) is_mincost_DPath_from W.cut(m,n).first(),W.cut(m,n).last();

theorem 
  for G being finite real-weighted WGraph, W1,W2 being DPath of G, x,y
being set st W1 is_mincost_DPath_from x,y & W2 is_mincost_DPath_from x,y holds
  W1.cost() = W2.cost();

theorem 
  for G being finite real-weighted WGraph, W being DPath of G, x,y
being set st W is_mincost_DPath_from x,y holds G.min_DPath_cost(x,y) = W.cost()
;

begin 

definition
  let G be _Graph;
  mode DIJK:Labeling of G is Element of [: PFuncs(the_Vertices_of G, REAL),
    bool the_Edges_of G :];
end;

definition
  let X1,X3 be set, X2 be non empty set;
  let x be Element of [: PFuncs(X1,X3),X2 :];
  redefine func x`1 -> Element of PFuncs(X1,X3);
end;

registration
  let G be finite _Graph, L be DIJK:Labeling of G;
  cluster L`1 -> finite;
  cluster L`2 -> finite;
end;

definition
  let G be real-weighted WGraph, L be DIJK:Labeling of G;
  func DIJK:NextBestEdges(L) -> Subset of the_Edges_of G means


  for e1
being set holds e1 in it iff e1 DSJoins dom (L`1), the_Vertices_of G \ dom (L`1
), G & for e2 being set st e2 DSJoins dom (L`1), the_Vertices_of G \ dom (L`1),
  G holds (L`1).((the_Source_of G).e1) + (the_Weight_of G).e1 <= (L`1).((
  the_Source_of G).e2) + (the_Weight_of G).e2;
end;

definition
  let G be real-weighted WGraph, L be DIJK:Labeling of G;
  func DIJK:Step(L) -> DIJK:Labeling of G equals


  L if
  DIJK:NextBestEdges(L) = {} otherwise [ L`1+*((the_Target_of G).(choose
  DIJK:NextBestEdges(L)) .--> ((L`1).((the_Source_of G).(choose
DIJK:NextBestEdges(L))) + (the_Weight_of G).(choose DIJK:NextBestEdges(L)))), L
  `2 \/ {choose DIJK:NextBestEdges(L)} ];
end;

definition
  let G be real-weighted WGraph, src be Vertex of G;
  func DIJK:Init(src) -> DIJK:Labeling of G equals

  [src .--> 0, {}];
end;

definition
  let G be real-weighted WGraph;
  mode DIJK:LabelingSeq of G -> ManySortedSet of NAT means


    for n being Nat holds it.n is DIJK:Labeling of G;
end;

definition
  let G be real-weighted WGraph, S be DIJK:LabelingSeq of G, n be Nat;
  redefine func S.n -> DIJK:Labeling of G;
end;

definition
  let G be real-weighted WGraph, src be Vertex of G;
  func DIJK:CompSeq(src) -> DIJK:LabelingSeq of G means


  it.0 = DIJK:Init(src) & for n being Nat holds it.(n+1) = DIJK:Step(it.n);
end;

definition
  let G be real-weighted WGraph, src be Vertex of G;
  func DIJK:SSSP(G,src) -> DIJK:Labeling of G equals

  DIJK:CompSeq(src)
  .Result();
end;

begin 

theorem 
  for G being finite real-weighted WGraph, L be DIJK:Labeling of G
holds (card dom (DIJK:Step(L))`1 = card dom L`1 iff DIJK:NextBestEdges(L) = {})
& (card dom (DIJK:Step(L))`1 = card dom L`1 + 1 iff DIJK:NextBestEdges(L)<>{});

theorem 
  for G being real-weighted WGraph, L be DIJK:Labeling of G holds
  dom L`1 c= dom (DIJK:Step(L))`1 & L`2 c= (DIJK:Step(L))`2;

theorem 
  for G being real-weighted WGraph, src be Vertex of G holds dom (
  (DIJK:Init(src))`1) = {src};

theorem 
  for G being real-weighted WGraph, src being Vertex of G, i,j
  being Nat st i <= j holds dom ((DIJK:CompSeq(src).i))`1 c= dom (DIJK:CompSeq(
  src).j)`1 & (DIJK:CompSeq(src).i)`2 c= (DIJK:CompSeq(src).j)`2;

theorem 
  for G being finite real-weighted WGraph, src being Vertex of G,
  n being Nat holds dom (DIJK:CompSeq(src).n)`1 c= G.reachableDFrom(src);

theorem 
  for G being finite real-weighted WGraph, src being Vertex of G,
  n being Nat holds DIJK:NextBestEdges(DIJK:CompSeq(src).n) = {} iff dom (
  DIJK:CompSeq(src).n)`1 = G.reachableDFrom(src);

theorem 
  for G being finite real-weighted WGraph, s being Vertex of G, n
being Nat holds card dom (DIJK:CompSeq(s).n)`1 = min(n+1, card(G.reachableDFrom
  (s)));

theorem 
  for G being finite real-weighted WGraph, src being Vertex of G,
n being Nat holds (DIJK:CompSeq(src).n)`2 c= G.edgesBetween(dom (DIJK:CompSeq(
  src).n)`1);

theorem 
  for G being finite nonnegative-weighted WGraph, s being Vertex
of G, n being Nat, G2 being inducedWSubgraph of G, dom (DIJK:CompSeq(s).n)`1, (
DIJK:CompSeq(s).n)`2 holds G2 is_mincost_DTree_rooted_at s & for v being Vertex
  of G st v in dom (DIJK:CompSeq(s).n)`1 holds G.min_DPath_cost(s,v) = (
  DIJK:CompSeq(s).n)`1.v;

theorem 
  for G being finite real-weighted WGraph, s being Vertex of G
  holds DIJK:CompSeq(s) is halting;

registration
  let G be finite real-weighted WGraph, src be Vertex of G;
  cluster DIJK:CompSeq(src) -> halting;
end;

theorem 
  for G being finite real-weighted WGraph, s being Vertex of G
  holds DIJK:CompSeq(s).Lifespan() + 1 = card G.reachableDFrom(s);

theorem 
  for G being finite real-weighted WGraph, s being Vertex of G
  holds dom (DIJK:SSSP(G,s))`1 = G.reachableDFrom(s);


theorem 
  for G being finite nonnegative-weighted WGraph, s being Vertex of G,
G2 being inducedWSubgraph of G, dom (DIJK:SSSP(G,s))`1, DIJK:SSSP(G,s)`2 holds
  G2 is_mincost_DTree_rooted_at s & for v being Vertex of G st v in G
  .reachableDFrom(s) holds v in the_Vertices_of G2 & G.min_DPath_cost(s,v) = (
  DIJK:SSSP(G,s))`1.v;

begin 

definition
  let G be _Graph;
  mode PRIM:Labeling of G is Element of [: bool the_Vertices_of G, bool
    the_Edges_of G :];
end;

registration
  let G be finite _Graph, L be PRIM:Labeling of G;
  cluster L`1 -> finite;
  cluster L`2 -> finite;
end;

definition
  let G be real-weighted WGraph, L being PRIM:Labeling of G;
  func PRIM:NextBestEdges(L) -> Subset of the_Edges_of G means


  for e1
being set holds e1 in it iff e1 SJoins L`1, the_Vertices_of G \ L`1, G & for e2
being set st e2 SJoins L`1, the_Vertices_of G \ L`1, G holds (the_Weight_of G).
  e1 <= (the_Weight_of G).e2;
end;

definition
  let G be real-weighted WGraph;
  func PRIM:Init(G) -> PRIM:Labeling of G equals

  [ {choose the_Vertices_of G},
  {} ];
end;

definition
  let G be real-weighted WGraph, L being PRIM:Labeling of G;
  func PRIM:Step(L) -> PRIM:Labeling of G equals


  L if
  PRIM:NextBestEdges(L) = {}, [ L`1 \/ {(the_Target_of G).(choose
  PRIM:NextBestEdges(L))}, L`2 \/ {choose PRIM:NextBestEdges(L)} ] if
PRIM:NextBestEdges(L) <> {} & (the_Source_of G).(choose PRIM:NextBestEdges(L))
in L`1 otherwise [ L`1 \/ {(the_Source_of G).(choose PRIM:NextBestEdges(L))}, L
  `2 \/ {choose PRIM:NextBestEdges(L)} ];
end;

definition
  let G be real-weighted WGraph;
  mode PRIM:LabelingSeq of G -> ManySortedSet of NAT means


    for n being Nat holds it.n is PRIM:Labeling of G;
end;

definition
  let G be real-weighted WGraph, S be PRIM:LabelingSeq of G, n be Nat;
  redefine func S.n -> PRIM:Labeling of G;
end;

definition
  let G be real-weighted WGraph;
  func PRIM:CompSeq(G) -> PRIM:LabelingSeq of G means


  it.0 = PRIM:Init (G) & for n being Nat holds it.(n+1) = PRIM:Step(it.n);
end;

definition
  let G be real-weighted WGraph;
  func PRIM:MST(G) -> PRIM:Labeling of G equals

  PRIM:CompSeq(G).Result();
end;

theorem 
  for G being real-weighted WGraph, L be PRIM:Labeling of G st
  PRIM:NextBestEdges(L) <> {} holds ex v being Vertex of G st not v in L`1 &
  PRIM:Step(L) = [ L`1 \/ {v}, L`2 \/ {choose PRIM:NextBestEdges(L)} ];

theorem 
  for G being real-weighted WGraph, L be PRIM:Labeling of G holds
  L`1 c= (PRIM:Step(L))`1 & L`2 c= (PRIM:Step(L))`2;

theorem 
  for G being finite real-weighted WGraph, n being Nat holds (
PRIM:CompSeq(G).n)`1 is non empty Subset of the_Vertices_of G & (PRIM:CompSeq(G
  ).n)`2 c= G.edgesBetween((PRIM:CompSeq(G).n)`1);

theorem 
  for G1 being finite real-weighted WGraph, n being Nat, G2 being
  inducedSubgraph of G1,(PRIM:CompSeq(G1).n)`1, (PRIM:CompSeq(G1).n)`2 holds G2
  is connected;

theorem 
  for G1 being finite real-weighted WGraph, n being Nat, G2 being
  inducedSubgraph of G1, (PRIM:CompSeq(G1).n)`1 holds G2 is connected;

registration
  let G1 be finite real-weighted WGraph, n being Nat;
  cluster -> connected for inducedSubgraph of G1,(PRIM:CompSeq(G1).n)`1;
end;

registration
  let G1 be finite real-weighted WGraph, n being Nat;
  cluster -> connected for inducedSubgraph of G1, (PRIM:CompSeq(G1).n)`1, (
    PRIM:CompSeq(G1).n)`2;
end;

theorem 
  for G being finite real-weighted WGraph, n being Nat holds (
  PRIM:CompSeq(G).n)`1 c= G.reachableFrom(choose the_Vertices_of G);

theorem 
  for G being finite real-weighted WGraph, i,j being Nat st i <= j
holds (PRIM:CompSeq(G).i)`1 c= (PRIM:CompSeq(G).j)`1 & (PRIM:CompSeq(G).i)`2 c=
  (PRIM:CompSeq(G).j)`2;

theorem 
  for G being finite real-weighted WGraph, n being Nat holds
  PRIM:NextBestEdges(PRIM:CompSeq(G).n) = {} iff (PRIM:CompSeq(G).n)`1 = G
  .reachableFrom(choose the_Vertices_of G);

theorem 
  for G being finite real-weighted WGraph, n being Nat holds card
((PRIM:CompSeq(G).n)`1) = min(n+1, card(G.reachableFrom(choose the_Vertices_of
  G)));

theorem 
  for G being finite real-weighted WGraph holds PRIM:CompSeq(G) is
  halting & PRIM:CompSeq(G).Lifespan() + 1 = card G.reachableFrom(choose
  the_Vertices_of G);

theorem 
  for G1 being finite real-weighted WGraph, n being Nat, G2 being
inducedSubgraph of G1, (PRIM:CompSeq(G1).n)`1, (PRIM:CompSeq(G1).n)`2 holds G2
  is Tree-like;

theorem 
  for G being finite connected real-weighted WGraph holds (
  PRIM:MST(G))`1 = the_Vertices_of G;

registration
  let G be finite connected real-weighted WGraph;
  cluster spanning Tree-like for WSubgraph of G;
end;

definition
  let G1 be finite connected real-weighted WGraph, G2 be spanning Tree-like
  WSubgraph of G1;
  attr G2 is min-cost means


  for G3 being spanning Tree-like WSubgraph of G1 holds G2.cost() <= G3.cost();
end;

registration
  let G1 be finite connected real-weighted WGraph;
  cluster min-cost for spanning Tree-like WSubgraph of G1;
end;

definition
  let G be finite connected real-weighted WGraph;
  mode minimumSpanningTree of G is min-cost spanning Tree-like WSubgraph of G
    ;
end;

begin 

theorem 
  for G1,G2 being finite connected real-weighted WGraph, G3 being
  WSubgraph of G1 st G3 is minimumSpanningTree of G1 & G1 == G2 & the_Weight_of
  G1 = the_Weight_of G2 holds G3 is minimumSpanningTree of G2;

theorem 
  for G being finite connected real-weighted WGraph, G1 being
  minimumSpanningTree of G, G2 being WGraph st G1 == G2 & the_Weight_of G1 =
  the_Weight_of G2 holds G2 is minimumSpanningTree of G;

theorem 
  for G being finite connected real-weighted WGraph, n being Nat
  holds (PRIM:CompSeq(G).n)`2 c= (PRIM:MST(G))`2;


theorem 
  for G1 being finite connected real-weighted WGraph, G2 being
  inducedWSubgraph of G1, (PRIM:MST(G1))`1, (PRIM:MST(G1))`2 holds G2 is
  minimumSpanningTree of G1;














begin

begin 

definition
  let G be WGraph;
  attr G is natural-weighted means


  the_Weight_of G is natural-valued;
end;

registration
  cluster natural-weighted -> nonnegative-weighted for WGraph;
end;

registration
  cluster finite trivial Tree-like natural-weighted for WGraph;
end;

registration
  let G be natural-weighted WGraph;
  cluster the_Weight_of G -> natural-valued;
end;

definition
  let G be _Graph;
  mode FF:ELabeling of G is natural-valued ManySortedSet of the_Edges_of G;
end;




definition
  let G be finite real-weighted WGraph, EL be FF:ELabeling of G, source,sink
  be set;
  pred EL has_valid_flow_from source,sink means


  source is Vertex of G &
sink is Vertex of G & (for e being set st e in the_Edges_of G holds 0 <= EL.e &
  EL.e <= (the_Weight_of G).e) & for v being Vertex of G st v <> source & v <>
  sink holds Sum (EL | v.edgesIn()) = Sum (EL | v.edgesOut());
end;

definition
  let G be finite real-weighted WGraph, EL be FF:ELabeling of G, source, sink
  be set;
  func EL.flow(source,sink) -> real number equals

  Sum (EL | G.edgesInto({sink}
  )) - Sum (EL | G.edgesOutOf({sink}));
end;

definition
  let G be finite real-weighted WGraph, EL being FF:ELabeling of G, source,
  sink be set;
  pred EL has_maximum_flow_from source,sink means


  EL has_valid_flow_from source,sink & for E2 being FF:ELabeling of G st E2
  has_valid_flow_from source,sink holds E2.flow(source,sink) <= EL.flow(source,
  sink);
end;

definition
  let G be _Graph, EL be FF:ELabeling of G;
  mode AP:VLabeling of EL -> PartFunc of the_Vertices_of G, {1} \/
    the_Edges_of G means


    not contradiction;
end;



definition
  let G be real-weighted WGraph;
  let EL be FF:ELabeling of G, VL be AP:VLabeling of EL;
  let e be set;
  pred e is_forward_edge_wrt VL means


  e in the_Edges_of G & (
  the_Source_of G).e in dom VL & not (the_Target_of G).e in dom VL & EL.e < (
  the_Weight_of G).e;
end;

definition
  let G be real-weighted WGraph;
  let EL be FF:ELabeling of G, VL be AP:VLabeling of EL;
  let e be set;
  pred e is_backward_edge_wrt VL means


  e in the_Edges_of G & (
  the_Target_of G).e in dom VL & not (the_Source_of G).e in dom VL & 0 < EL.e;
end;



definition
  let G be real-weighted WGraph, EL be FF:ELabeling of G, W be Walk of G;
  pred W is_augmenting_wrt EL means


  for n being odd Nat st n < len W
holds (W.(n+1) DJoins W.n, W.(n+2), G implies EL.(W.(n+1)) < (the_Weight_of G).
  (W.(n+1))) & (not W.(n+1) DJoins W.n,W.(n+2), G implies 0 < EL.(W.(n+1)));
end;

theorem 
  for G being real-weighted WGraph, EL be FF:ELabeling of G, W
  being Walk of G st W is trivial holds W is_augmenting_wrt EL;

theorem 
  for G being real-weighted WGraph, EL be FF:ELabeling of G, W
  being Walk of G, m,n be Nat st W is_augmenting_wrt EL holds W.cut(m,n)
  is_augmenting_wrt EL;

theorem 
  for G being real-weighted WGraph, EL being FF:ELabeling of G, W
  being Walk of G, e,v being set st W is_augmenting_wrt EL & not v in W
.vertices() & ( e DJoins W.last(),v,G & EL.e < (the_Weight_of G).e or e DJoins
  v,W.last(),G & 0 < (EL.e) ) holds W.addEdge(e) is_augmenting_wrt EL;

begin 

definition
  let G be real-weighted WGraph;
  let EL be FF:ELabeling of G, VL be AP:VLabeling of EL;
  func AP:NextBestEdges(VL) -> Subset of the_Edges_of G means


  for e
being set holds e in it iff (e is_forward_edge_wrt VL or e is_backward_edge_wrt
  VL);
end;

definition
  let G be real-weighted WGraph;
  let EL be FF:ELabeling of G, VL be AP:VLabeling of EL;
  func AP:Step(VL) -> AP:VLabeling of EL equals


  VL if AP:NextBestEdges
  (VL) = {}, VL+*((the_Source_of G).(choose AP:NextBestEdges(VL)) .--> choose
  AP:NextBestEdges(VL)) if AP:NextBestEdges(VL) <> {} & not (the_Source_of G).(
choose AP:NextBestEdges(VL)) in dom VL otherwise VL+*((the_Target_of G).(choose
  AP:NextBestEdges(VL)) .--> choose AP:NextBestEdges(VL));
end;

definition
  let G be _Graph, EL be FF:ELabeling of G;
  mode AP:VLabelingSeq of EL -> ManySortedSet of NAT means


    for n being Nat holds it.n is AP:VLabeling of EL;
end;

definition
  let G be _Graph, EL be FF:ELabeling of G;
  let VS be AP:VLabelingSeq of EL, n be Nat;
  redefine func VS.n -> AP:VLabeling of EL;
end;

definition
  let G be real-weighted WGraph, EL be FF:ELabeling of G;
  let source be Vertex of G;
  func AP:CompSeq(EL,source) -> AP:VLabelingSeq of EL means


  it.0 = source .--> 1 & for n being Nat holds it.(n+1) = AP:Step(it.n);
end;

theorem 
  for G being real-weighted WGraph, EL be FF:ELabeling of G, source
  being Vertex of G holds dom (AP:CompSeq(EL,source).0) = {source};

theorem 
  for G being real-weighted WGraph, EL being FF:ELabeling of G,
  source being Vertex of G, i,j being Nat st i <= j holds dom (AP:CompSeq(EL,
  source).i) c= dom (AP:CompSeq(EL,source).j);

definition
  let G be real-weighted WGraph, EL be FF:ELabeling of G, source be Vertex of
  G;
  func AP:FindAugPath(EL,source) -> AP:VLabeling of EL equals

  AP:CompSeq(EL,
  source).Result();
end;

theorem 
  for G being finite real-weighted WGraph, EL be FF:ELabeling of G,
  source being Vertex of G holds AP:CompSeq(EL,source) is halting;

theorem 
  for G being finite real-weighted WGraph, EL being FF:ELabeling of
G, source being Vertex of G, n being Nat, v being set st v in dom (AP:CompSeq(
EL,source).n) holds (AP:CompSeq(EL,source).n).v = (AP:FindAugPath(EL,source)).v
;

definition
  let G be finite real-weighted WGraph, EL be FF:ELabeling of G, source,sink
  be Vertex of G;
  func AP:GetAugPath(EL,source,sink) -> vertex-distinct Path of G means



  it is_Walk_from source,sink & it is_augmenting_wrt EL & for n being even Nat
  st n in dom it holds it.n = (AP:FindAugPath(EL,source)).(it.(n+1)) if sink in
  dom AP:FindAugPath(EL,source) otherwise it = G.walkOf(source);
end;

theorem 
  for G being real-weighted WGraph, EL being FF:ELabeling of G,
source being Vertex of G, n being Nat, v being set st v in dom (AP:CompSeq(EL,
  source).n) holds ex P being Path of G st P is_augmenting_wrt EL & P
  is_Walk_from source,v & P.vertices() c= dom (AP:CompSeq(EL,source).n);

theorem 
  for G being finite real-weighted WGraph, EL being FF:ELabeling of
  G, source being Vertex of G, v being set holds v in dom AP:FindAugPath(EL,
  source) iff ex P being Path of G st P is_Walk_from source,v & P
  is_augmenting_wrt EL;

theorem 
  for G being finite real-weighted WGraph, EL being FF:ELabeling
  of G, source being Vertex of G holds source in dom AP:FindAugPath(EL,source);

begin 

definition
  let G be natural-weighted WGraph, EL be FF:ELabeling of G, W be Walk of G;
  assume
 W is_augmenting_wrt EL;
  func W.flowSeq(EL) -> FinSequence of NAT means


  dom it = dom W
.edgeSeq() & for n being Nat st n in dom it holds (W.(2*n) DJoins W.(2*n-1),W.(
2*n+1),G implies it.n = (the_Weight_of G).(W.(2*n)) - EL.(W.(2*n))) & (not W.(2
  *n) DJoins W.(2*n-1),W.(2*n+1),G implies it.n = EL.(W.(2*n)));
end;

definition
  let G be natural-weighted WGraph, EL being FF:ELabeling of G, W be Walk of G;
  assume
 W is_augmenting_wrt EL;
  func W.tolerance(EL) -> Nat means


  it in rng (W.flowSeq(EL)) & for k
being real number st k in rng (W.flowSeq(EL)) holds it <= k if W is non trivial
  otherwise it = 0;
end;

definition
  let G be natural-weighted WGraph, EL being FF:ELabeling of G, P be Path of G;
  assume
 P is_augmenting_wrt EL;
  func FF:PushFlow(EL,P) -> FF:ELabeling of G means


  (for e being set
  st e in the_Edges_of G & not e in P.edges() holds it.e = EL.e) & for n being
odd Nat st n < len P holds (P.(n+1) DJoins P.n, P.(n+2),G implies it.(P.(n+1))
  = EL.(P.(n+1)) + P.tolerance(EL)) & (not P.(n+1) DJoins P.n,P.(n+2),G implies
  it.(P.(n+1)) = EL.(P.(n+1)) - P.tolerance(EL));
end;

definition
  let G be finite natural-weighted WGraph, EL being FF:ELabeling of G, sink,
  source be Vertex of G;
  func FF:Step(EL, source, sink) -> FF:ELabeling of G equals


FF:PushFlow(EL, AP:GetAugPath(EL,source,sink)) if sink in dom AP:FindAugPath(EL
  ,source) otherwise EL;
end;

definition
  let G be _Graph;
  mode FF:ELabelingSeq of G -> ManySortedSet of NAT means


    for n being Nat holds it.n is FF:ELabeling of G;
end;

registration
  let G be _Graph, ES be FF:ELabelingSeq of G, n be Nat;
  cluster ES.n -> Function-like Relation-like;
end;

registration
  let G be _Graph, ES be FF:ELabelingSeq of G, n be Nat;
  cluster ES.n -> the_Edges_of G -defined;
end;

registration
  let G be _Graph, ES be FF:ELabelingSeq of G, n be Nat;
  cluster ES.n -> natural-valued total;
end;

definition
  let G be finite natural-weighted WGraph, source, sink be Vertex of G;
  func FF:CompSeq(G,source,sink) -> FF:ELabelingSeq of G means


  it.0 =
  the_Edges_of G --> 0 & for n being Nat holds it.(n+1) = FF:Step(it.n,source,
  sink);
end;

definition
  let G be finite natural-weighted WGraph, sink,source be Vertex of G;
  func FF:MaxFlow(G,source, sink) -> FF:ELabeling of G equals

  FF:CompSeq(G,source,sink).Result();
end;

begin 

theorem 
  for G being finite real-weighted WGraph, EL being FF:ELabeling
  of G, source, sink being set, V being Subset of the_Vertices_of G st EL
  has_valid_flow_from source,sink & source in V & not sink in V holds EL.flow(
source,sink) = Sum (EL | G.edgesDBetween(V, the_Vertices_of G \ V)) - Sum (EL |
  G.edgesDBetween(the_Vertices_of G \ V, V));

theorem 
  for G being finite real-weighted WGraph, EL being FF:ELabeling
  of G, source,sink being set, V being Subset of the_Vertices_of G st EL
  has_valid_flow_from source,sink & source in V & not sink in V holds EL.flow(
source,sink) <= Sum ((the_Weight_of G) | G.edgesDBetween(V,the_Vertices_of G \
  V));

theorem 
  for G being finite natural-weighted WGraph, EL being
FF:ELabeling of G, W being Walk of G st W is non trivial & W is_augmenting_wrt
  EL holds 0 < W.tolerance(EL);

theorem 
  for G being finite natural-weighted WGraph, EL being
FF:ELabeling of G, source,sink being set, P being Path of G st source <> sink &
  EL has_valid_flow_from source,sink & P is_Walk_from source,sink & P
  is_augmenting_wrt EL holds FF:PushFlow(EL,P) has_valid_flow_from source,sink;

theorem 
  for G being finite natural-weighted WGraph, EL being
FF:ELabeling of G, source,sink being set, P being Path of G st source <> sink &
P is_Walk_from source,sink & P is_augmenting_wrt EL holds EL.flow(source,sink)
  + P.tolerance(EL) = (FF:PushFlow(EL,P)).flow(source,sink);

theorem 
  for G being finite natural-weighted WGraph, source,sink being
  Vertex of G, n being Nat st source <> sink holds FF:CompSeq(G,source,sink).n
  has_valid_flow_from source,sink;

theorem 
  for G being finite natural-weighted WGraph,source,sink being
  Vertex of G st source <> sink holds FF:CompSeq(G,source,sink) is halting;

theorem 
  for G being finite natural-weighted WGraph, EL being
FF:ELabeling of G, source,sink being set st EL has_valid_flow_from source,sink
& not ex P being Path of G st P is_Walk_from source,sink & P is_augmenting_wrt
  EL holds EL has_maximum_flow_from source,sink;


theorem 
  for G being finite natural-weighted WGraph, source, sink being Vertex
  of G st sink <> source holds FF:MaxFlow(G,source,sink) has_maximum_flow_from
  source,sink;














begin 

theorem 
  for n being non zero Nat holds n-1 is Nat & 1 <= n;

theorem 
  for n being odd Nat holds n-1 is Nat & 1 <= n;

theorem 
  for n,m being odd Integer st n < m holds n <= m-2;

theorem 
  for n,m being odd Integer st m < n holds m+2 <= n;

theorem 
  for n being odd Nat st 1 <> n
  ex m being odd Nat st m+2 = n;

theorem 
  for n being odd Nat st n<=2 holds n=1;

theorem 
  for n being odd Nat st n<=4 holds n=1 or n=3;

theorem 
  for n being odd Nat st n<=6 holds n=1 or n=3 or n=5;

theorem 
  for n being odd Nat st n<=8 holds n=1 or n=3 or n=5 or n=7;

theorem 
  for n being even Nat st n<=1 holds n=0;

theorem 
  for n being even Nat st n<=3 holds n=0 or n=2;

theorem 
  for n being even Nat st n<=5 holds n=0 or n=2 or n=4;

theorem 
  for n being even Nat st n<=7 holds n=0 or n=2 or n=4 or n=6;

theorem 
  for p being FinSequence, n being non zero Nat st p is
  one-to-one & n <= len p holds (p.n)..p = n;

theorem 
  for p being non empty FinSequence, T being non empty Subset of
  rng p ex x being set st x in T & for y being set st y in T holds x..p <= y..p
;

definition
  let p be FinSequence, n be Nat;
  func p.followSet(n) -> finite set equals

  rng (n,len p)-cut p;
end;

theorem 
  for p being FinSequence, x being set, n being Nat st
x in rng p & n in dom p & p is one-to-one holds x in p.followSet(n) iff x..p >=
  n;

theorem 
  for p, q being FinSequence, x being set st p = <*x*>^q for n
  being non zero Nat holds p.followSet(n+1) = q.followSet(n);

theorem 
  for X being set, f being FinSequence of X, g being Subset of f
  st len Seq g = len f holds Seq g = f;

begin 

theorem 
  for G being _Graph, S being Subset of the_Vertices_of G for H
  being inducedSubgraph of G,S for u,v being set st u in S & v in S for e being
  set st e Joins u,v,G holds e Joins u,v,H;

theorem 
  for G being _Graph, W being Walk of G holds W is Trail-like iff len W
  = 2*(card W.edges())+1;

theorem 
  for G being _Graph, S being Subset of the_Vertices_of G for H
  being removeVertices of G,S for W being Walk of G st
  (for n being odd Nat st n <= len W holds not W.n in S)
  holds W is Walk of H;

theorem 
  for G being _Graph, a,b be set st a<>b for W being Walk of G st
  W.vertices() = {a,b} holds ex e being set st e Joins a,b,G;

theorem 
  for G being _Graph, S being non empty Subset of the_Vertices_of
G for H being inducedSubgraph of G,S for W being Walk of G st W.vertices() c= S
  holds W is Walk of H;

theorem 
  for G1,G2 being _Graph st G1 == G2 for W1 be Walk of G1, W2
  being Walk of G2 st W1 = W2 holds W1 is Cycle-like implies W2 is Cycle-like;

theorem 
  for G being _Graph, P being Path of G, m, n being odd Nat
  st m <= len P & n <= len P & P.m = P.n holds m = n or m = 1 & n = len P
  or m = len P & n = 1;

theorem 
  for G being _Graph, P being Path of G st P is open for a,e,b being set
st not a in P.vertices() & b = P.first() & e Joins a,b,G holds G.walkOf(a,e,b)
  .append(P) is Path-like;

theorem 

  for G being _Graph, P,H being Path of G st P.edges() misses H
  .edges() & P is open & H is non trivial & H is open & P.vertices() /\ H
  .vertices() = { P.first(), P.last() } & H.first() = P.last() & H.last() = P
  .first() holds P.append(H) is Cycle-like;

theorem 
  for G being _Graph, W1,W2 being Walk of G st W1.last() = W2
  .first() holds W1.append(W2).length() = W1.length() + W2.length();

theorem 
  for G being _Graph, A,B being non empty Subset of
  the_Vertices_of G st B c= A for H1 being inducedSubgraph of G,A for H2 being
  inducedSubgraph of H1,B holds H2 is inducedSubgraph of G,B;

theorem 
  for G being _Graph, A,B being non empty Subset of
  the_Vertices_of G st B c= A for H1 being inducedSubgraph of G,A for H2 being
  inducedSubgraph of G,B holds H2 is inducedSubgraph of H1,B;

theorem 
  for G being _Graph, S,T being non empty Subset of
  the_Vertices_of G st T c= S for G2 being inducedSubgraph of G,S holds G2
  .edgesBetween(T) = G.edgesBetween(T);



scheme 

  FinGraphOrderCompInd{P[set]}: for G being finite _Graph holds P[G]
provided
 for k being non zero Nat st (for Gk being finite _Graph
st Gk.order() < k holds P[Gk]) holds for Gk1 being finite _Graph st Gk1.order()
= k holds P[Gk1];



theorem 
  for G being _Graph, W being Walk of G st W is open & W is
  Path-like holds W is vertex-distinct;




theorem 
  for G being _Graph, P being Path of G st P is open & len P > 3
  for e being set st e Joins P.last(),P.first(),G holds P.addEdge(e) is
  Cycle-like;

begin 

definition
  let G be _Graph, W be Walk of G;
  attr W is minlength means


  for W2 being Walk of G st W2 is_Walk_from W
  .first(),W.last() holds len W2 >= len W;
end;

theorem 
  for G being _Graph, W being Walk of G, S being Subwalk of W st S
  .first() = W.first() & S.edgeSeq() = W.edgeSeq() holds S = W;

theorem 
  for G being _Graph, W being Walk of G, S being Subwalk of W st
  len S = len W holds S = W;

theorem 
  for G being _Graph, W being Walk of G st W is minlength holds W is Path-like;

theorem 
  for G being _Graph, W being Walk of G st W is minlength holds W is Path-like;

theorem 
  for G being _Graph, W being Walk of G holds (for P being Path of
  G st P is_Walk_from W.first(),W.last() holds len P >= len W) implies W is
  minlength;

theorem 
  for G being _Graph, W being Walk of G ex P being Path of G st P
  is_Walk_from W.first(),W.last() & P is minlength;

theorem 
  for G being _Graph, W being Walk of G st W is minlength holds
  for m,n being odd Nat st m+2 < n & n <= len W holds
  not ex e being set st e Joins W.m,W.n,G;

theorem 
  for G being _Graph, S being non empty Subset of the_Vertices_of
  G for H being inducedSubgraph of G,S for W being Walk of H st W is minlength
  for m,n being odd Nat st m+2 < n & n <= len W holds
  not ex e being set st e Joins W.m,W.n,G;

theorem 
  for G being _Graph for W being Walk of G st W is minlength
  for m,n being odd Nat st m<=n & n<=len W holds
  W.cut(m,n) is minlength;

theorem 
  for G being _Graph st G is connected for A,B being non empty Subset of
the_Vertices_of G st A misses B holds ex P being Path of G st P is minlength &
  P is non trivial & P.first() in A & P.last() in B & for n being odd Nat
  st 1 < n & n < len P holds not P.n in A & not P.n in B;

begin 

definition
  let G be _Graph, a,b be Vertex of G;
  pred a,b are_adjacent means


  ex e being set st e Joins a,b,G;
  symmetry;
end;

theorem 
  for G1,G2 being _Graph st G1 == G2 for u1,v1 being Vertex of G1
st u1,v1 are_adjacent for u2,v2 being Vertex of G2 st u1=u2 & v1=v2 holds u2,v2
  are_adjacent;

theorem 
  for G being _Graph, S being non empty Subset of the_Vertices_of
  G for H being inducedSubgraph of G,S for u, v being Vertex of G, t, w being
  Vertex of H st u = t & v = w holds u,v are_adjacent iff t,w are_adjacent;

theorem 
  for G being _Graph, W being Walk of G st W.first() <> W.last() &
  not W.first(),W.last() are_adjacent holds W.length() >= 2;

theorem 
  
  for G being _Graph, v1,v2,v3 being Vertex of G st v1<>v2 & v1<>
v3 & v2<>v3 & v1,v2 are_adjacent & v2,v3 are_adjacent ex P being Path of G, e1,
e2 being set st P is open & len P = 5 & P.length() = 2 & e1 Joins v1,v2,G & e2
Joins v2,v3,G & P.edges() = {e1,e2} & P.vertices() = {v1,v2,v3} & P.1 = v1 & P.
  3 = v2 & P.5 = v3;

theorem 
  for G being _Graph, v1,v2,v3,v4 being Vertex of G st v1<>v2 & v1
<>v3 & v2<>v3 & v2<>v4 & v3<>v4 & v1,v2 are_adjacent & v2,v3 are_adjacent & v3,
  v4 are_adjacent ex P being Path of G st len P = 7 & P.length() = 3 & P
  .vertices() = {v1,v2,v3,v4} & P.1 = v1 & P.3 = v2 & P.5 = v3 & P.7 = v4;

definition
  let G be _Graph, S be set;
  func G.AdjacentSet(S) -> Subset of the_Vertices_of G equals

  {u where u is
Vertex of G : not u in S & ex v being Vertex of G st (v in S & u,v are_adjacent
  )};
end;

theorem 
  for G being _Graph, S, x being set st x in G.AdjacentSet(S) holds not x in S;

theorem 
  for G being _Graph, S being set for u being Vertex of G holds u
  in G.AdjacentSet(S) iff not u in S & ex v being Vertex of G st v in S & u,v
  are_adjacent;

theorem 
  for G1,G2 being _Graph st G1 == G2 for S being set holds G1
  .AdjacentSet(S) = G2.AdjacentSet(S);

theorem 
  for G being _Graph, u,v being Vertex of G holds u in G
  .AdjacentSet({v}) iff u <> v & v,u are_adjacent;

theorem 
  for G being _Graph, x,y being set holds x in G.AdjacentSet({y}) iff y
  in G.AdjacentSet({x});

theorem 
  for G being _Graph, C being Path of G st C is Cycle-like & C.length()
> 3 for x being Vertex of G st x in C.vertices() ex m,n being odd Nat st m+2 <
n & n <= len C & not (m=1 & n = len C) & not (m=1 & n = len C-2) & not (m=3 & n
  = len C) & C.m <> C.n & C.m in G.AdjacentSet({x}) & C.n in G.AdjacentSet({x})
;

theorem 
  for G being _Graph, C being Path of G st C is Cycle-like & C
  .length() > 3 for x being Vertex of G st x in C.vertices() ex m,n being odd
  Nat st m+2 < n & n <= len C & C.m <> C.n &
  C.m in G.AdjacentSet({x})
  & C.n in G.AdjacentSet({x}) & for e being set st e in C.edges() holds not e
  Joins C.m,C.n,G;










theorem 
  for G being loopless _Graph, u being Vertex of G holds G.AdjacentSet({
  u}) = {} iff u is isolated;

theorem 
  for G being _Graph, G0 being Subgraph of G, S being non empty
Subset of the_Vertices_of G, x being Vertex of G, G1 being (inducedSubgraph of
  G,S), G2 being (inducedSubgraph of G,S\/{x}) st G1 is connected & x in G
  .AdjacentSet(the_Vertices_of G1) holds G2 is connected;

theorem 
  for G being _Graph for S being non empty Subset of
the_Vertices_of G for H being inducedSubgraph of G,S for u being Vertex of G st
  u in S & G.AdjacentSet({u}) c= S for v being Vertex of H st u=v holds G
  .AdjacentSet({u}) = H.AdjacentSet({v});



definition
  let G be _Graph, S be set;
  mode AdjGraph of G,S -> Subgraph of G means


    it is inducedSubgraph of
    G,G.AdjacentSet(S) if S is Subset of the_Vertices_of G;
end;

theorem 
  for G1, G2 be _Graph st G1 == G2 for u1 being Vertex of G1, u2
  being Vertex of G2 st u1 = u2 for H1 being AdjGraph of G1,{u1}, H2 being
  AdjGraph of G2,{u2} holds H1 == H2;

theorem 
  for G being _Graph for S being non empty Subset of
the_Vertices_of G for H being inducedSubgraph of G,S for u being Vertex of G st
u in S & G.AdjacentSet({u}) c= S & G.AdjacentSet({u}) <> {} for v being Vertex
of H st u=v for Ga being AdjGraph of G,{u}, Ha being AdjGraph of H,{v} holds Ga
  == Ha;

definition
  let G be _Graph;
  attr G is complete means


  for u,v being Vertex of G st u <> v holds u, v are_adjacent;
end;

theorem 
  for G being _Graph st G is trivial holds G is complete;

registration
  cluster trivial -> complete for _Graph;
end;

registration
  cluster trivial simple complete for _Graph;
  cluster non trivial finite simple complete for _Graph;
end;

theorem 
  for G1,G2 being _Graph st G1 == G2 holds G1 is complete implies
  G2 is complete;

theorem 
  for G being complete _Graph, S being Subset of the_Vertices_of G
  for H being inducedSubgraph of G,S holds H is complete;

begin 

definition
  let G be _Graph, v be Vertex of G;
  attr v is simplicial means


  G.AdjacentSet({v}) <> {} implies for G2
  being AdjGraph of G,{v} holds G2 is complete;
end;

theorem 
  for G being complete _Graph, v being Vertex of G holds v is simplicial;

theorem 
  for G being trivial _Graph, v being Vertex of G holds v is simplicial;

theorem 
  for G1,G2 being _Graph st G1 == G2 for u1 being Vertex of G1, u2
  being Vertex of G2 st u1=u2 & u1 is simplicial holds u2 is simplicial;

theorem 
  for G being _Graph for S being non empty Subset of
the_Vertices_of G for H being inducedSubgraph of G,S for u being Vertex of G st
  u in S & G.AdjacentSet({u}) c= S for v being Vertex of H st u=v holds u is
  simplicial iff v is simplicial;

theorem 
  for G being _Graph, v being Vertex of G st v is simplicial for a
,b being set st a<>b & a in G.AdjacentSet({v}) & b in G.AdjacentSet({v}) holds
  ex e being set st e Joins a,b,G;

theorem 
  for G being _Graph, v being Vertex of G st not v is simplicial
  ex a,b being Vertex of G st a<>b & v<>a & v<>b & v,a are_adjacent & v,b
  are_adjacent & not a,b are_adjacent;

begin 

definition
  let G be _Graph, a,b be Vertex of G;
  assume that
 a<>b and
 not a,b are_adjacent;
  mode VertexSeparator of a,b -> Subset of the_Vertices_of G means


    not
    a in it & not b in it & for G2 being removeVertices of G,it holds not (ex W
    being Walk of G2 st W is_Walk_from a,b);
end;

theorem 
  for G being _Graph, a,b being Vertex of G st a<>b & not a,b
are_adjacent for S being VertexSeparator of a,b holds S is VertexSeparator of b
  ,a;



theorem 
  for G being _Graph, a,b being Vertex of G st a<>b & not a,b
are_adjacent for S being Subset of the_Vertices_of G holds S is VertexSeparator
of a,b iff (not a in S & not b in S & for W being Walk of G st W is_Walk_from a
  ,b holds ex x being Vertex of G st x in S & x in W.vertices());

theorem 
  for G being _Graph, a,b being Vertex of G st a<>b & not a,b
  are_adjacent for S being VertexSeparator of a,b for W being Walk of G st W
  is_Walk_from a,b ex k being odd Nat st 1 < k & k < len W & W.k in S;

theorem 
  for G being _Graph, a,b being Vertex of G st a<>b & not a,b
are_adjacent for S being VertexSeparator of a,b st S = {} holds not ex W being
  Walk of G st W is_Walk_from a,b;

theorem 
  for G being _Graph, a,b being Vertex of G st a<>b &not a,b
  are_adjacent & not ex W being Walk of G st W is_Walk_from a,b holds {} is
  VertexSeparator of a,b;

theorem 
  for G being _Graph, a,b being Vertex of G st a<>b & not a,b
are_adjacent for S being VertexSeparator of a,b, G2 being removeVertices of G,S
  for a2 being Vertex of G2 holds G2.reachableFrom(a2) /\ S = {};

theorem 
  for G being _Graph, a,b being Vertex of G st a<>b & not a,b
are_adjacent for S being VertexSeparator of a,b, G2 being removeVertices of G,S
  for a2,b2 being Vertex of G2 st a2=a & b2=b holds G2.reachableFrom(a2) /\ G2
  .reachableFrom(b2) = {};

theorem 
  for G being _Graph, a,b being Vertex of G st a<>b & not a,b
are_adjacent for S being VertexSeparator of a,b for G2 being removeVertices of
  G,S holds a is Vertex of G2 & b is Vertex of G2;

definition
  let G be _Graph, a,b be Vertex of G;
  let S be VertexSeparator of a,b;
  attr S is minimal means


  for T being Subset of S st T <> S holds not T is VertexSeparator of a,b;
end;

theorem 
  for G being _Graph, a,b being Vertex of G for S being VertexSeparator
  of a,b st S = {} holds S is minimal;

theorem 
  for G being finite _Graph for a,b being Vertex of G ex S being
  VertexSeparator of a,b st S is minimal;

theorem 



  for G being _Graph, a,b being Vertex of G st a<>b & not a,b
  are_adjacent for S being VertexSeparator of a,b st S is minimal for T being
  VertexSeparator of b,a st S=T holds T is minimal;

theorem 
  for G being _Graph, a,b being Vertex of G st a<>b & not a,b
  are_adjacent for S being VertexSeparator of a,b st S is minimal for x being
  Vertex of G st x in S ex W being Walk of G st W is_Walk_from a,b & x in W
  .vertices();

theorem 
  for G being _Graph for a,b being Vertex of G st a<>b & not a,b
  are_adjacent for S being VertexSeparator of a,b st S is minimal for H being
removeVertices of G,S for aa being Vertex of H st aa=a for x being Vertex of G
st x in S ex y being Vertex of G st y in H.reachableFrom(aa) & x,y are_adjacent
;

theorem 


  for G being _Graph for a,b being Vertex of G st a<>b & not a,b
  are_adjacent for S being VertexSeparator of a,b st S is minimal for H being
removeVertices of G,S for aa being Vertex of H st aa=b for x being Vertex of G
st x in S ex y being Vertex of G st y in H.reachableFrom(aa) & x,y are_adjacent
;

begin 










definition
  let G be _Graph, W be Walk of G;
  attr W is chordal means


  ex m, n being odd Nat st m+2 < n
& n <= len W & W.m <> W.n & (ex e being set st e Joins W.m,W.n,G) & for f being
  set st f in W.edges() holds not f Joins W.m,W.n,G;
end;

notation
  let G be _Graph, W be Walk of G;
  antonym W is chordless for W is chordal;
end;






theorem 
  for G being _Graph, W being Walk of G st W is chordal ex m,n
being odd Nat st m+2 < n & n <= len W & W.m <> W.n &
(ex e being set st e Joins W.m,W.n,G) &
(W is Cycle-like implies not (m=1 & n = len W) & not (m
  =1 & n = len W-2) & not (m=3 & n = len W));

theorem 
  for G being _Graph, P being Path of G st ex m,n being odd Nat
  st m+2 < n & n <= len P & (ex e being set st e Joins P.m,P.n,G)
  & (P is Cycle-like implies not (m=1 & n = len P) & not (m=1 & n = len P-2) &
  not (m=3 & n = len P)) holds P is chordal;

theorem 
  for G1,G2 being _Graph st G1 == G2 for W1 being Walk of G1, W2
  being Walk of G2 st W1=W2 holds W1 is chordal implies W2 is chordal;

theorem 
  for G being _Graph, S being non empty Subset of the_Vertices_of
G, H being (inducedSubgraph of G,S), W1 being Walk of G, W2 being Walk of H st
  W1 = W2 holds W2 is chordal iff W1 is chordal;

theorem 
  for G being _Graph, W being Walk of G st W is Cycle-like & W is
chordal & W.length()=4 holds ex e being set st e Joins W.1,W.5,G or e Joins W.3
  ,W.7,G;

theorem 
  for G being _Graph, W being Walk of G st W is minlength holds W is chordless;

theorem 
  for G being _Graph, W being Walk of G st len W = 5 & not W.first(),W
  .last() are_adjacent holds W is chordless;

theorem 
  for G being _Graph, W being Walk of G holds W is chordal iff W
  .reverse() is chordal;

theorem 
  for G being _Graph, P being Path of G st P is open & P is
  chordless for m,n being odd Nat st m < n & n <= len P holds
  (ex e being set st e Joins P.m,P.n,G) iff m+2 = n;

theorem 
  for G being _Graph, P being Path of G st P is open & P is chordless
  for m,n being odd Nat st m < n & n <= len P holds P.cut(m,n) is
  chordless & P.cut(m,n) is open;

theorem 
  for G being _Graph, S being non empty Subset of the_Vertices_of G, H
  being (inducedSubgraph of G,S), W being Walk of G, V being Walk of H st W = V
  holds W is chordless iff V is chordless;

definition
  let G be _Graph;
  attr G is chordal means


  for P being Walk of G st P.length() > 3 & P is Cycle-like holds P is chordal;
end;

theorem 
  for G1,G2 being _Graph st G1 == G2 holds G1 is chordal implies G2 is chordal;

theorem 
  for G being finite _Graph st card the_Vertices_of G <= 3 holds G is chordal;

registration
  cluster trivial finite chordal for _Graph;
  cluster non trivial finite simple chordal for _Graph;
  cluster complete -> chordal for _Graph;
end;

registration
  let G be chordal _Graph, V be set;
  cluster -> chordal for inducedSubgraph of G,V;
end;

theorem 
  for G being chordal _Graph, P being Path of G st P is open & P is
chordless for x,e being set st (not x in P.vertices() & e Joins P.last(),x,G &
not ex f being set st f Joins P.(len P-2),x,G) holds P.addEdge(e) is Path-like
  & P.addEdge(e) is open & P.addEdge(e) is chordless;



theorem 
  for G being chordal _Graph, a,b being Vertex of G st a<>b & not
a,b are_adjacent for S being VertexSeparator of a,b st S is minimal & S is non
  empty for H being inducedSubgraph of G,S holds H is complete;



theorem 
  for G being finite _Graph st for a,b being Vertex of G st a<>b & not a
  ,b are_adjacent for S being VertexSeparator of a,b st S is minimal & S is non
  empty for G2 being inducedSubgraph of G,S holds G2 is complete holds G is
  chordal;




theorem 
  for G being finite chordal _Graph, a, b being Vertex of G st a
<> b & not a,b are_adjacent for S being VertexSeparator of a,b st S is minimal
  for H being removeVertices of G,S, a1 being Vertex of H st a = a1 ex c being
  Vertex of G st c in H.reachableFrom(a1) & for x being Vertex of G st x in S
  holds c,x are_adjacent;

theorem 
  for G being finite chordal _Graph, a, b being Vertex of G st a <> b &
  not a,b are_adjacent for S being VertexSeparator of a,b st S is minimal for H
  being removeVertices of G,S, a1 being Vertex of H st a = a1 for x, y being
  Vertex of G st x in S & y in S holds ex c being Vertex of G st c in H
  .reachableFrom(a1) & c,x are_adjacent & c,y are_adjacent;



theorem 
  for G being non trivial finite chordal _Graph st not G is
  complete ex a,b being Vertex of G st a<>b & not a,b are_adjacent & a is
  simplicial & b is simplicial;

theorem 
  for G being finite chordal _Graph ex v being Vertex of G st v is simplicial;

begin 

definition
  let G be finite _Graph;
  mode VertexScheme of G -> FinSequence of the_Vertices_of G means


    it is one-to-one & rng it = the_Vertices_of G;
end;

registration
  let G be finite _Graph;
  cluster -> non empty for VertexScheme of G;
end;

theorem 
  for G being finite _Graph, S being VertexScheme of G holds len S =
  card the_Vertices_of G;

theorem 
  for G being finite _Graph, S being VertexScheme of G holds 1 <= len S;

theorem 
  for G, H being finite _Graph, g being VertexScheme of G st G ==
  H holds g is VertexScheme of H;

definition
  let G be finite _Graph, S be VertexScheme of G, x be Vertex of G;
  redefine func x..S -> non zero Element of NAT;
end;

definition
  let G be finite _Graph, S be VertexScheme of G, n be Nat;
  redefine func S.followSet(n) -> Subset of the_Vertices_of G;
end;

theorem 
  for G being finite _Graph, S being VertexScheme of G, n being
  non zero Nat st n <= len S holds S.followSet(n) is non empty;

definition
  let G be finite _Graph, S be VertexScheme of G;
  attr S is perfect means


  for n being non zero Nat st n <=
len S for Gf being inducedSubgraph of G,S.followSet(n) for v being Vertex of Gf
  st v = S.n holds v is simplicial;
end;



theorem 
  for G being finite trivial _Graph, v being Vertex of G ex S
  being VertexScheme of G st S = <*v*> & S is perfect;

theorem 
  for G being finite _Graph, V being VertexScheme of G holds V is
  perfect iff for a,b,c being Vertex of G st b<>c & a,b are_adjacent & a,c
  are_adjacent for va,vb,vc being Nat st va in dom V & vb in dom V &
  vc in dom V & V.va = a & V.vb = b & V.vc = c & va < vb & va < vc holds b,c
  are_adjacent;



registration
  let G be finite chordal _Graph;
  cluster perfect for VertexScheme of G;
end;

theorem 
  for G, H being finite chordal _Graph, g being perfect VertexScheme of
  G st G == H holds g is perfect VertexScheme of H;




theorem 
  for G being finite _Graph st ex S being VertexScheme of G st S is
  perfect holds G is chordal;














begin 

reserve FT for non empty RelStr,
  A,B,C for Subset of FT;

registration
  let FT;
  cluster empty -> connected for Subset of FT;
end;

theorem 
  for A,B being Subset of FT holds (A\/B)^b=(A^b) \/ (B^b);

theorem 
  ({}FT)^b={};

registration
  let FT;
  cluster ({}FT)^b -> empty;
end;

theorem 
  for A being Subset of FT st for B,C being Subset of FT st A = B
  \/ C & B <> {} & C <> {} & B misses C holds B^b meets C & B meets C^b holds A
  is connected;

definition
  let FT be non empty RelStr;
  attr FT is connected means


  [#]FT is connected;
end;

theorem 
  for A being Subset of FT holds A is connected implies for A2, B2
  being Subset of FT st A = A2 \/ B2 & A2 misses B2 & A2,B2 are_separated holds
  A2 = {}FT or B2 = {}FT;

theorem 
  FT is connected implies for A, B being Subset of FT st [#]FT = A
  \/ B & A misses B & A,B are_separated holds A = {}FT or B = {}FT;

theorem 
  for A,B being Subset of FT st FT is symmetric & A^b misses B
  holds A misses B^b;

theorem 
  for A being Subset of FT st FT is symmetric & for A2, B2 being
Subset of FT st A = A2 \/ B2 & A2 misses B2 & A2,B2 are_separated holds A2 = {}
  FT or B2 = {}FT holds A is connected;

definition
  let T be RelStr;
  mode SubSpace of T -> RelStr means


    the carrier of it c= the carrier
of T & for x being Element of it st x in the carrier of it holds U_FT x =Im(the
    InternalRel of T,x) /\ the carrier of it;
end;

registration
  let T be RelStr;
  cluster strict for SubSpace of T;
end;

registration
  let T be non empty RelStr;
  cluster strict non empty for SubSpace of T;
end;

definition
  let T be non empty RelStr, P be non empty Subset of T;
  func T|P -> strict non empty SubSpace of T means


  [#]it = P;
end;

theorem 
  for X being non empty SubSpace of FT st FT is filled holds X is filled;

registration
  let FT be filled non empty RelStr;
  cluster -> filled for non empty SubSpace of FT;
end;

theorem 
  for X being non empty SubSpace of FT st FT is symmetric holds X is symmetric;

theorem 
  for X9 being SubSpace of FT, A being Subset of X9 holds A is Subset of FT;

theorem 
  for P being Subset of FT holds P is closed iff P` is open;

theorem 
  for A being Subset of FT holds A is open iff (for z being Element of
FT st U_FT z c= A holds z in A)& for x being Element of FT st x in A holds U_FT
  x c= A;

theorem 
  for X9 being non empty SubSpace of FT, A being Subset of FT, A1
  being Subset of X9 st A = A1 holds A1^b = (A^b) /\ ([#]X9);

theorem 
  for X9 being non empty SubSpace of FT, P1,Q1 being Subset of FT, P,Q
  being Subset of X9 st P=P1 & Q=Q1 holds P,Q are_separated implies P1,Q1
  are_separated;

theorem 
  for X9 being non empty SubSpace of FT, P,Q being Subset of FT, P1,Q1
  being Subset of X9 st P=P1 & Q=Q1 & P \/ Q c= [#](X9) holds P,Q are_separated
  implies P1,Q1 are_separated;

theorem 
  for A being non empty Subset of FT holds A is connected iff FT|A is connected
;

theorem 
  for FT being filled non empty RelStr, A being non empty Subset of FT
st FT is symmetric holds A is connected iff for P,Q being Subset of FT st A = P
  \/ Q & P misses Q & P,Q are_separated holds P = {}FT or Q = {}FT;

theorem 
  for A being Subset of FT st FT is filled connected & A <> {} & A` <>
  {} holds A^delta <>{};

theorem 
  for A being Subset of FT st FT is filled symmetric & FT is connected &
  A <> {} & A` <> {} holds A^deltai <>{};

theorem 
  for A being Subset of FT st FT is filled symmetric & FT is connected &
  A <> {} & A` <>{} holds A^deltao <>{};

theorem 
  for A being Subset of FT holds A^deltai misses A^deltao;

theorem 
  for FT being filled non empty RelStr, A being Subset of FT holds A
  ^deltao=(A^b) \ A;

theorem 
  for A, B being Subset of FT st A,B are_separated holds A^deltao misses B;

theorem 
  for A, B being Subset of FT st FT is filled & A misses B & A^deltao
  misses B & B^deltao misses A holds A,B are_separated;

theorem 
  for x being Point of FT holds {x} is connected;

registration
  let FT;
  let x be Point of FT;
  cluster {x} -> connected for Subset of FT;
end;

definition
  let FT be non empty RelStr, A be Subset of FT;
  pred A is_a_component_of FT means


  A is connected & for B being Subset
  of FT st B is connected holds A c= B implies A = B;
end;

theorem 
  for A being Subset of FT st A is_a_component_of FT holds A <> {}FT;

theorem 
  A is closed & B is closed & A misses B implies A,B are_separated;

theorem 
  FT is filled & [#]FT = A \/ B & A,B are_separated implies A is open closed;

theorem 
  for A,B,A1,B1 being Subset of FT holds A,B are_separated & A1 c=
  A & B1 c= B implies A1,B1 are_separated;

theorem 
  A,B are_separated & A,C are_separated implies A,B \/ C are_separated;

theorem 
  FT is filled symmetric & ( for A, B being Subset of FT st [#]FT = A \/
B & A <> {}FT & B <> {}FT & A is closed & B is closed holds A meets B) implies
  FT is connected;

theorem 
  FT is connected implies for A, B being Subset of FT st [#]FT = A \/ B
  & A <> {}FT & B <> {}FT & A is closed & B is closed holds A meets B;

theorem 
  FT is filled & A is connected & A c= B \/ C & B,C are_separated
  implies A c= B or A c= C;

theorem 
  for A,B being Subset of FT st FT is symmetric & A is connected &
  B is connected & not A,B are_separated holds A \/ B is connected;

theorem 
  for A,C being Subset of FT st FT is symmetric & C is connected &
  C c= A & A c=C^b holds A is connected;

theorem 
  for C being Subset of FT st FT is filled symmetric & C is
  connected holds C^b is connected;

theorem 
  FT is filled symmetric connected & A is connected & [#]FT \ A =
  B \/ C & B,C are_separated implies A \/ B is connected;

theorem 
  for X9 being non empty SubSpace of FT, A being Subset of FT, B
  being Subset of X9 st A = B holds A is connected iff B is connected;

theorem 
  for A being Subset of FT st FT is filled symmetric & A
  is_a_component_of FT holds A is closed;

theorem 
  for A,B being Subset of FT st FT is symmetric & A
is_a_component_of FT & B is_a_component_of FT holds A = B or A,B are_separated;

theorem 
  for A,B being Subset of FT st FT is filled symmetric & A
is_a_component_of FT & B is_a_component_of FT holds A = B or A misses B;

theorem 
  for C being Subset of FT st FT is filled symmetric & C is connected
holds for S being Subset of FT st S is_a_component_of FT holds C misses S or C
  c= S;

definition
  let FT be non empty RelStr, A be non empty Subset of FT, B be Subset of FT;
  pred B is_a_component_of A means


  ex B1 being Subset of FT|A st B1 = B & B1 is_a_component_of FT|A;
end;

theorem 
  for D being non empty Subset of FT st FT is filled symmetric & D=[#]FT
\ A holds FT is connected & A is connected & C is_a_component_of D implies [#]
  FT \ C is connected;

begin 

definition
  let FT;
  let f be FinSequence of FT;
  attr f is continuous means


  1<=len f & for i being Nat,x1 being
  Element of FT st 1<=i & i<len f & x1=f.i holds f.(i+1) in U_FT x1;
end;

registration
  let FT;
  let x be Element of FT;
  cluster <*x*> -> continuous for FinSequence of FT;
end;

theorem 
  for f being FinSequence of FT,x,y being Element of FT st f is
  continuous & y=f.(len f) & x in U_FT y holds f^(<*x*>) is continuous;

theorem 
  for f,g being FinSequence of FT st f is continuous & g is
  continuous & g.1 in U_FT (f/.(len f)) holds f^g is continuous;

definition
  let FT;
  let A be Subset of FT;
  attr A is arcwise_connected means


  for x1,x2 being Element of FT st x1
in A & x2 in A ex f being FinSequence of FT st f is continuous & rng f c=A & f.
  1=x1 & f.(len f)=x2;
end;

registration
  let FT;
  cluster empty -> arcwise_connected for Subset of FT;
end;

registration
  let FT;
  let x be Element of FT;
  cluster {x} -> arcwise_connected for Subset of FT;
end;

theorem 
  for A being Subset of FT st FT is symmetric holds A is connected iff A
  is arcwise_connected;

theorem 
  for g being FinSequence of FT, k being Nat st g is continuous &
  1<=k holds g|k is continuous;

theorem 
  for g being FinSequence of FT, k being Element of NAT st g is
  continuous & k<len g holds g/^k is continuous;

definition
  let FT;
  let g be FinSequence of FT,A be Subset of FT, x1,x2 be Element of FT;
  pred g is_minimum_path_in A,x1,x2 means


  g is continuous & rng g c=A &
g.1=x1 & g.len g=x2 & for h being FinSequence of FT st h is continuous & rng h
  c=A & h.1=x1 & h.len h=x2 holds len g <= len h;
end;

theorem 
  for A being Subset of FT, x being Element of FT st x in A holds <*x*>
  is_minimum_path_in A,x,x;

theorem 
  for A being Subset of FT holds A is arcwise_connected iff for x1,x2
  being Element of FT st x1 in A & x2 in A ex g being FinSequence of FT st g
  is_minimum_path_in A,x1,x2;

theorem 
  for A being Subset of FT,x1,x2 being Element of FT st ex f being
  FinSequence of FT st f is continuous & rng f c=A & f.1=x1 & f.len f=x2 ex g
  being FinSequence of FT st g is_minimum_path_in A,x1,x2;

theorem 
  for g being FinSequence of FT,A being Subset of FT, x1,x2 being
Element of FT, k being Element of NAT st g is_minimum_path_in A,x1,x2 & 1<=k &
k<=len g holds g|k is continuous & rng (g|k) c=A & (g|k).1=x1 & (g|k).(len (g|k
  ))=g/.k;

theorem 
  for g being FinSequence of FT,A being Subset of FT, x1,x2 being
Element of FT, k being Element of NAT st g is_minimum_path_in A,x1,x2 & k<len g
holds g/^k is continuous & rng (g/^k) c=A & (g/^k).1=g/.(1+k) & (g/^k).(len (g
  /^k))=x2;

theorem 
  for g being FinSequence of FT,A being Subset of FT, x1,x2 being
Element of FT st g is_minimum_path_in A,x1,x2 holds for k being Nat st 1<=k & k
  <=len g holds g|k is_minimum_path_in A,x1,g/.k;

theorem 
  for g being FinSequence of FT,A being Subset of FT, x1,x2 being
  Element of FT st g is_minimum_path_in A,x1,x2 holds g is one-to-one;

definition
  let FT;
  let f be FinSequence of FT;
  attr f is inv_continuous means


  1<=len f & for i,j being Nat,y being
  Element of FT st 1<=i & i<=len f & 1<=j & j<= len f & y=f.i & i<>j & f.j in
  U_FT y holds i=j+1 or j=i+1;
end;

theorem 
  for g being FinSequence of FT,A being Subset of FT, x1,x2 being
  Element of FT st g is_minimum_path_in A,x1,x2 & FT is symmetric holds g is
  inv_continuous;

theorem 
  for g being FinSequence of FT,A being Subset of FT, x1,x2 being
Element of FT st g is_minimum_path_in A,x1,x2 & FT is filled symmetric & x1<>x2
holds (for i being Nat st 1<i & i<len g holds (rng g)/\ U_FT (g/.i)={g.(i-'1),g
.i,g.(i+1)}) & (rng g)/\ U_FT (g/.1)={g.1,g.2} & (rng g)/\ U_FT (g/.len g)={g.(
  len g -'1),g.len g};

theorem 
  for g being FinSequence of FT,A being non empty Subset of FT, x1,x2
  being Element of FT,B0 being Subset of FT|A st g is_minimum_path_in A,x1,x2 &
  FT is filled symmetric & B0={x1} holds for i being Element of NAT st i< len g
  holds g.(i+1) in Finf(B0,i) & (i>=1 implies not g.(i+1) in Finf(B0,i-'1));














begin

theorem 
  for n being Element of NAT, L being well-unital domRing-like non
degenerated non empty doubleLoopStr, x being Element of L st x <> 0.L holds x
  |^ n <> 0.L;

registration
  cluster almost_left_invertible -> domRing-like for associative well-unital
add-associative right_zeroed right_complementable right-distributive non empty
    doubleLoopStr;
end;

theorem 
  for L being add-associative right_zeroed right_complementable
  associative commutative well-unital almost_left_invertible distributive non
empty doubleLoopStr, x,y being Element of L st x <> 0.L & y <> 0.L holds (x *
  y)" = x" * y";

theorem 
  for L being associative commutative well-unital distributive
almost_left_invertible non empty doubleLoopStr, z,z1 being Element of L holds
  z <> 0.L implies z1 = (z1 * z) / z;

theorem 
  for L being left_zeroed right_zeroed add-associative
right_complementable non empty doubleLoopStr, m being Element of NAT, s being
  FinSequence of L st len s = m & for k being Element of NAT st 1 <= k & k <= m
  holds s/.k = 1.L holds Sum s = m * 1.L;

theorem 
  for L being add-associative right_zeroed right_complementable
  associative commutative well-unital distributive almost_left_invertible non
empty doubleLoopStr, s being FinSequence of L, q being Element of L st q <> 1.
L & for i being Nat st 1 <= i & i <= len s holds s.i = q |^ (i-'1) holds Sum s
  = (1.L - q |^ (len s)) / (1.L - q);

definition
  let L be well-unital non empty doubleLoopStr, m be Element of NAT;
  func emb(m,L) -> Element of L equals

  m * 1.L;
end;

theorem 
  for L being Field, m,n,k being Element of NAT st m > 0 & n > 0
for M1 being Matrix of m,n,L, M2 being Matrix of n,k,L holds (emb(m,L) * M1) *
  M2 = emb(m,L) * (M1 * M2);

theorem 
  for L being non empty ZeroStr, p being AlgSequence of L, i being
  Element of NAT holds p.i <> 0.L implies len p >= i + 1;

theorem 
  for L being non empty ZeroStr, s being AlgSequence of L holds len
  s > 0 implies s.(len(s)-1) <> 0.L;

theorem 
  for L being add-associative right_zeroed right_complementable
  distributive commutative associative well-unital domRing-like non empty
doubleLoopStr, p,q being Polynomial of L st len p > 0 & len q > 0 holds len(p
  *'q) <= len p + len q;

theorem 
  for L being associative non empty doubleLoopStr, k,l being
  Element of L, seq being sequence of L holds k * (l * seq) = (k * l) * seq;

begin 

definition
  let L be non empty doubleLoopStr;
  let m1,m2 be sequence of L;
  func m1 * m2 -> sequence of L means


  for i being Nat holds it.i = m1.i * m2.i;
end;

registration
  let L be add-associative right_zeroed right_complementable left-distributive
  non empty doubleLoopStr;
  let m1,m2 be AlgSequence of L;
  cluster m1 * m2 -> finite-Support;
end;

theorem 
  for L being add-associative right_zeroed right_complementable
distributive non empty doubleLoopStr, m1,m2 being AlgSequence of L holds len(
  m1 * m2) <= min(len m1, len m2);

theorem 
  for L being add-associative right_zeroed right_complementable
distributive domRing-like non empty doubleLoopStr, m1,m2 being AlgSequence of
  L st len m1 = len m2 holds len(m1 * m2) = len m1;

begin 

definition
  let L be associative commutative well-unital distributive
  almost_left_invertible non empty doubleLoopStr, a be Element of L, i be
  Integer;
  func pow(a,i) -> Element of L equals


  power(L).(a,i) if 0 <= i
  otherwise (power(L).(a,abs i))";
end;

theorem 
  for L being associative commutative well-unital distributive
  almost_left_invertible non empty doubleLoopStr, x being Element of L holds
  pow(x,0) = 1.L;

theorem 
  for L being associative commutative well-unital distributive
  almost_left_invertible non empty doubleLoopStr, x being Element of L holds
  pow(x,1) = x;

theorem 
  for L being associative commutative well-unital distributive
  almost_left_invertible non empty doubleLoopStr, x being Element of L holds
  pow(x,-1) = x";

theorem 
  for L being associative commutative well-unital distributive
  almost_left_invertible non degenerated non empty doubleLoopStr, i being
  Integer holds pow(1.L,i) = 1.L;

theorem 
  for L being associative commutative well-unital distributive
almost_left_invertible non empty doubleLoopStr, x being Element of L, n being
  Element of NAT holds pow(x,n+1) = pow(x,n) * x & pow(x,n+1) = x * pow(x,n);

theorem 
  for L being add-associative right_zeroed right_complementable
  associative commutative well-unital distributive almost_left_invertible non
degenerated non empty doubleLoopStr, i being Integer, x being Element of L st
  x <> 0.L holds (pow(x, i))" = pow(x, -i);

theorem 
  for L being Field, j being Integer, x being Element of L st x <>
  0.L holds pow(x,j+1) = pow(x,j) * pow(x,1);

theorem 
  for L being Field, j being Integer, x being Element of L st x <>
  0.L holds pow(x,j-1) = pow(x,j) * pow(x,-1);

theorem 
  for L being Field, i,j being Integer, x being Element of L st x
  <> 0.L holds pow(x,i) * pow(x,j) = pow(x,i+j);

theorem 
  for L being almost_left_invertible associative well-unital
add-associative right_zeroed right_complementable left-distributive commutative
  non degenerated non empty doubleLoopStr, k being Element of NAT, x being
  Element of L st x <> 0.L holds pow(x", k) = pow(x, -k);

theorem 
  for L being Field, x being Element of L st x <> 0.L for i,j,k
  being Nat holds pow(x,(i-1)*(k-1)) * pow(x,-(j-1)*(k-1)) = pow(x,(i-j)*(k-1))
;

theorem 
  for L being associative commutative well-unital distributive
  almost_left_invertible non empty doubleLoopStr, x being Element of L, n,m
  being Element of NAT holds pow(x, n * m) = pow(pow(x, n), m);

theorem 
  for L being Field, x being Element of L st x <> 0.L for i being
  Integer holds pow(x", i) = (pow(x, i))";

theorem 
  for L being Field, x being Element of L st x <> 0.L for i,j
  being Integer holds pow(x,i * j) = pow(pow(x,i), j);

theorem 
  for L being associative commutative well-unital distributive
  almost_left_invertible non empty doubleLoopStr, x being Element of L, i,k
  being Element of NAT st 1 <= k holds pow(x, i*(k-1)) = pow(x|^i, k-1);

begin 

definition
  let m be Nat, L be non empty ZeroStr, p be AlgSequence of L;
  func mConv(p,m) -> Matrix of m,1,L means


  for i being Nat st 1 <= i & i <= m holds it*(i,1) = p.(i-1);
end;

theorem 
  for m being Nat st m > 0 for L being non empty ZeroStr, p being
AlgSequence of L holds len mConv(p,m) = m & width mConv(p,m) = 1 & for i being
  Nat st i < m holds mConv(p,m)*(i+1,1) = p.i;

theorem 
  for m being Nat st m > 0 for L being non empty ZeroStr, a being
AlgSequence of L, M being Matrix of m,1,L holds (for i being Nat st i < m holds
  M*(i+1,1) = a.i) implies mConv(a,m) = M;

definition
  let L be non empty ZeroStr, M be Matrix of L;
  func aConv(M) -> AlgSequence of L means


  (for i being Nat st i < len M
  holds it.i = M*(i+1,1)) & for i being Nat st i >= len M holds it.i = 0.L;
end;

begin 

definition
  let L be well-unital non empty doubleLoopStr, x be Element of L, n be
  Element of NAT;
  pred x is_primitive_root_of_degree n means


  n <> 0 & x|^n = 1.L & for
  i being Element of NAT st 0 < i & i < n holds x|^i <> 1.L;
end;

theorem 
  for L being well-unital add-associative right_zeroed
  right_complementable right-distributive non degenerated non empty
  doubleLoopStr, n being Element of NAT holds not(0.L
  is_primitive_root_of_degree n);

theorem 
  for L being add-associative right_zeroed right_complementable
  associative commutative well-unital distributive almost_left_invertible non
degenerated non empty doubleLoopStr, m being Element of NAT, x being Element
of L st x is_primitive_root_of_degree m holds x" is_primitive_root_of_degree m;

theorem 
  for L being add-associative right_zeroed right_complementable
  associative commutative well-unital distributive almost_left_invertible non
degenerated non empty doubleLoopStr, m being Element of NAT, x being Element
of L st x is_primitive_root_of_degree m for i,j being Nat st 1 <= i & i <= m &
  1 <= j & j <= m & i <> j holds pow(x,i-j) <> 1.L;

definition
  let m be Nat, L be well-unital non empty doubleLoopStr, p be Polynomial of
  L, x be Element of L;
  func DFT(p,x,m) -> AlgSequence of L means


  (for i being Nat st i < m
  holds it.i = eval(p,x |^ i)) & for i being Nat st i >= m holds it.i = 0.L;
end;

theorem 
  for m being Nat, L being well-unital non empty doubleLoopStr,
  x being Element of L holds DFT(0_.(L),x,m) = 0_.(L);

theorem 
  for m being Nat, L being Field, p,q being Polynomial of L, x
  being Element of L holds DFT(p, x, m) * DFT(q, x, m) = DFT(p *' q, x, m);

definition
  let L be associative commutative well-unital distributive
almost_left_invertible non empty doubleLoopStr, m be Nat, x be Element of L;
  func Vandermonde(x,m) -> Matrix of m,L means


  for i,j being Nat st 1
  <= i & i <= m & 1 <= j & j <= m holds it*(i,j) = pow(x,(i-1)*(j-1));
end;

notation
  let L be associative commutative well-unital distributive
almost_left_invertible non empty doubleLoopStr, m be Nat, x be Element of L;
  synonym VM(x,m) for Vandermonde(x,m);
end;

theorem 
  for L being Field, m,n being Nat st m > 0 for M being Matrix of
  m,n,L holds 1.(L,m) * M = M;

theorem 
  for L being Field, m being Element of NAT st 0 < m for u,v,u1
being Matrix of m,L holds (for i,j being Nat st 1 <= i & i <= m & 1 <= j & j <=
  m holds (u * v)*(i,j) = emb(m,L) * (u1*(i,j))) implies u * v = emb(m,L) * u1;

theorem 
  for L being Field, x being Element of L, s being FinSequence of
  L, i,j,m being Element of NAT st x is_primitive_root_of_degree m & 1 <= i & i
<= m & 1 <= j & j <= m & len s = m & for k being Nat st 1 <= k & k <= m holds s
  /.k = pow(x,(i-j)*(k-1)) holds (VM(x,m) * VM(x",m))*(i,j) = Sum s;

theorem 
  for L being Field, m,i,j being Element of NAT, x being Element
  of L st i <> j & 1 <= i & i <= m & 1 <= j & j <= m & x
  is_primitive_root_of_degree m holds (VM(x,m) * VM(x",m))*(i,j) = 0.L;

theorem 
  for L being Field, m being Element of NAT st m > 0 for x being
Element of L st x is_primitive_root_of_degree m holds VM(x,m) * VM(x",m) = emb(
  m,L) * 1.(L,m);

theorem 
  for L being Field, m being Element of NAT, x being Element of L
st m > 0 & x is_primitive_root_of_degree m holds VM(x,m) * VM(x",m) = VM(x",m)
  * VM(x,m);

begin 

theorem 
  for L being Field, p being Polynomial of L, m being Element of
NAT st m > 0 & len p <= m for x being Element of L, i being Element of NAT st i
  < m holds DFT(p,x,m).i = VM(x,m) * mConv(p,m)*(i+1,1);

theorem 
  for L being Field, p being Polynomial of L for m being Nat st 0
  < m & len p <= m for x being Element of L holds DFT(p,x,m) = aConv(VM(x,m) *
  mConv(p, m));

theorem 
  for L being Field, p,q being Polynomial of L, m being Element of
  NAT st m > 0 & len p <= m & len q <= m for x being Element of L st x
is_primitive_root_of_degree 2*m holds DFT(DFT(p*'q, x, 2*m), x", 2*m) = emb(2*m
  ,L) * (p*'q);


theorem 
  for L being Field, p,q being Polynomial of L, m being Element of NAT
  st m > 0 & len p <= m & len q <= m for x being Element of L st x
is_primitive_root_of_degree 2*m holds emb(2*m,L) <> 0.L implies (emb(2*m,L))" *
  DFT(DFT(p,x,2*m) * DFT(q,x,2*m), x", 2*m) = p *' q;














begin

reserve x, x1, x2, y, X, D for set,
  i, j, k, l, m, n for Nat,
  N for Element of NAT,
  p, q for XFinSequence of NAT,
  q9 for XFinSequence,
  pd, qd for XFinSequence of D;

definition
  let p,q;
  redefine func p^q -> XFinSequence of NAT;
end;

theorem 
  ex qd st pd = (pd|n)^qd;

definition
  let p;
  attr p is dominated_by_0 means


  rng p c= {0,1} & for k st k <= dom p holds 2*Sum (p|k) <= k;
end;

theorem 
  p is dominated_by_0 implies 2*Sum (p|k) <= k;

theorem 
  p is dominated_by_0 implies p.0 = 0;

registration let x;let k be Nat;
  cluster x-->k -> NAT-valued;
end;

registration
  cluster empty dominated_by_0 for XFinSequence of NAT;
  cluster non empty dominated_by_0 for XFinSequence of NAT;
end;

theorem 
  n-->0 is dominated_by_0;

theorem 
  n >= m implies (n-->0)^(m-->1) is dominated_by_0;

theorem 
  p is dominated_by_0 implies p|n is dominated_by_0;

theorem 
  p is dominated_by_0 & q is dominated_by_0 implies p^q is dominated_by_0;

theorem 
  p is dominated_by_0 implies 2 * Sum (p|(2*n+1)) < 2*n+1;

theorem 
  p is dominated_by_0 & n <= len p-2*Sum p implies p^(n-->1) is dominated_by_0;

theorem 
  p is dominated_by_0 & n <= k+len p-2*Sum p implies (k-->0)^p^(n
  -->1) is dominated_by_0;

theorem 
  p is dominated_by_0 & 2*Sum (p|k)=k implies k <= len p & len (p| k) = k;

theorem 
  p is dominated_by_0 & 2*Sum (p|k) = k & p = (p|k)^q implies q is
  dominated_by_0;

theorem 
  p is dominated_by_0 & 2*Sum (p|k) = k & k = n+1 implies p|k = p| n^(1-->1);

theorem 
  for m,p st m = min*({N:2*Sum(p|N) = N & N > 0}) & m > 0 & p is
  dominated_by_0 ex q st p|m = (1-->0)^q^(1-->1) & q is dominated_by_0;

theorem 
  for p st rng p c= {0,1} & p is not dominated_by_0 ex k st 2*k+1
  = min*{N : 2*Sum(p|N) > N} & 2*k+1 <= dom p & k = Sum (p|(2*k)) & p.(2*k) = 1
;

theorem 
  for p, q, k st p|(2*k+len q) = (k-->0)^q^(k-->1) & q is
dominated_by_0 & 2*Sum q = len q & k > 0 holds min*{N:2*Sum(p|N) = N & N > 0} =
  2*k+len q;

theorem 
  for p st p is dominated_by_0 & {N: 2*Sum(p|N) = N & N > 0} = {}
  & len p > 0 ex q st p = <%0%>^q & q is dominated_by_0;

theorem 
  p is dominated_by_0 implies <%0%>^p is dominated_by_0 &
  {N: 2*Sum((<%0%>^p)|N) = N & N > 0} = {};

theorem 
  rng p c= {0,1} & 2*k+1 = min*{N:2*Sum(p|N) > N} implies p|(2*k) is
  dominated_by_0;

begin

definition
  let n,m be Nat;
  func Domin_0(n,m) -> Subset of {0,1}^omega means


  x in it iff ex p be
  XFinSequence of NAT st p = x & p is dominated_by_0 & dom p = n & Sum p = m;
end;

theorem 
  p in Domin_0(n,m) iff p is dominated_by_0 & dom p = n & Sum p = m;

theorem 
  Domin_0(n,m) c= Choose(n,m,1,0);

registration
  let n,m;
  cluster Domin_0(n,m) -> finite;
end;

theorem 
  Domin_0(n,m) is empty iff 2*m > n;

theorem 
  Domin_0(n,0) = {n-->0};

theorem 
  card Domin_0(n,0) = 1;

theorem 
  for p,n st rng p c= {0,n} ex q st len p = len q & rng q c= {0,n}
  & (for k st k <= len p holds Sum (p|k)+Sum (q|k) = n*k) & for k st k in len p
  holds q.k = n-p.k;

theorem 
  m <= n implies n choose m > 0;

theorem 
  2*(m+1) <= n implies card (Choose(n,m+1,1,0) \ Domin_0(n,m+1)) =
  card Choose(n,m,1,0);

theorem 
  2*(m+1) <= n implies card Domin_0(n,m+1) = (n choose (m+1)) - (n choose m);

theorem 
  2*m <= n implies card Domin_0(n,m) = (n+1-2*m) / (n+1-m) * (n choose m);

theorem 
  card Domin_0(2+k,1) = k+1;

theorem 
  card Domin_0(4+k,2) = (k+1)*(k+4)/2;

theorem 
  card Domin_0(6+k,3) = (k+1)*(k+5)*(k+6)/6;

theorem 
  card Domin_0(2*n,n) = ((2*n) choose n) / (n+1);

theorem 
  card Domin_0(2*n,n) = Catalan(n+1);

definition
  let D;
  mode OMEGA of D -> functional non empty set means


    for x st x in it holds x is XFinSequence of D;
end;

definition
  let D;
  redefine func D^omega -> OMEGA of D;
end;

registration
  let D;
  let F be OMEGA of D;
  cluster -> finite D-valued T-Sequence-like for Element of F;
end;

reserve pN, qN for Element of NAT^omega;

theorem 
  card {pN:dom pN = 2*n & pN is dominated_by_0} = (2*n) choose n;

theorem 
  for n,m,k,j,l st j = n-2*(k+1) & l = m-(k+1) holds card {pN : pN
in Domin_0(n,m) & 2*(k+1) = min*{N:2*Sum(pN|N) = N & N > 0}} = card Domin_0(2*k
  ,k) * card Domin_0(j,l);



theorem 
  for n,m st 2*m <= n ex CardF be XFinSequence of NAT st card {pN:
pN in Domin_0(n,m) & {N:2*Sum(pN|N)=N & N > 0}<>{}} = Sum CardF & dom CardF = m
& for j st j < m holds CardF.j = card Domin_0(2*j,j) * card Domin_0(n-'2*(j+1),
  m -'(j+1));

theorem 
  for n st n > 0 holds Domin_0(2*n,n)={pN:pN in Domin_0(2*n,n) & {
N: 2*Sum(pN|N) = N & N > 0}<>{}};

theorem 
  for n st n > 0 ex Catal be XFinSequence of NAT st Sum Catal =
  Catalan(n+1) & dom Catal = n & for j st j < n holds Catal.j = Catalan(j+1)*
  Catalan(n-'j);

theorem 
  card {pN:pN in Domin_0(n+1,m) & {N: 2*Sum(pN|N) = N & N > 0} =
  {}} = card Domin_0(n,m);

theorem 
  for n,m st 2*m <= n ex CardF be XFinSequence of NAT st card Domin_0(n,
  m) = Sum CardF + card Domin_0(n-'1,m) & dom CardF = m & for j st j < m holds
  CardF.j = card Domin_0(2*j,j) * card Domin_0(n-'2*(j+1),m-'(j+1));

theorem 
  for n,k ex p st Sum p = card Domin_0(2*n+2+k,n+1) & dom p = k+1 & for
  i st i <= k holds p.i = card Domin_0(2*n+1+i,n);

begin

reserve seq1,seq2,seq3,seq4 for Real_Sequence,
  r,s,e for real number,
  Fr,Fr1, Fr2 for XFinSequence of REAL;



definition
  let seq1, seq2 be Real_Sequence;
  func seq1 (##) seq2 -> Real_Sequence means


  for k be Nat ex Fr be
XFinSequence of REAL st dom Fr = k+1 & (for n st n in k+1 holds Fr.n = seq1.n *
  seq2.(k-'n)) & Sum Fr = it.k;
  commutativity;
end;

theorem 
  for Fr1,Fr2 st dom Fr1=dom Fr2 & for n st n in len Fr1 holds Fr1.n=Fr2
  .(len Fr1-'(1+n)) holds Sum Fr1 = Sum Fr2;

theorem 
  for Fr1,Fr2 st dom Fr1=dom Fr2 & for n st n in len Fr1 holds Fr1
  .n=r*Fr2.n holds Sum Fr1 = r*Sum Fr2;

theorem 
  seq1 (##) (r(#)seq2) = r(#)(seq1 (##) seq2);

theorem 
  seq1 (##) (seq2 + seq3) = (seq1 (##) seq2) + (seq1 (##) seq3);

theorem 
  (seq1 (##) seq2).0=seq1.0*seq2.0;

theorem 
  for seq1, seq2, n ex Fr st Partial_Sums(seq1 (##) seq2).n = Sum
Fr & dom Fr=n+1 & for i st i in n+1 holds Fr.i=seq1.i * Partial_Sums(seq2).(n-'
  i);

theorem 
  for seq1, seq2, n st seq2 is summable ex Fr st Partial_Sums(seq1
(##) seq2).n= Sum seq2 * Partial_Sums(seq1).n- Sum Fr & dom Fr=n+1 & for i st i
  in n+1 holds Fr.i=seq1.i * Sum (seq2^\(n-'i+1));

theorem 
  for Fr ex absFr be XFinSequence of REAL st dom absFr=dom Fr &
  abs(Sum Fr) <= Sum absFr & for i st i in dom absFr holds absFr.i=abs(Fr.i);

theorem 
  for seq1 st seq1 is summable ex r st 0 < r & for k holds abs(Sum
  (seq1^\k)) < r;

theorem 
  for seq1, n, m st n <= m & for i holds seq1.i>=0 holds (
  Partial_Sums seq1).n <= (Partial_Sums seq1).m;



theorem 
  for seq1, seq2 st seq1 is absolutely_summable & seq2 is summable
  holds seq1 (##) seq2 is summable & Sum(seq1 (##) seq2) = Sum seq1 * Sum seq2;

begin 

theorem 
  for r ex Catal be Real_Sequence st (for n holds Catal.n = Catalan(n+1)
* r|^n) & (abs r < 1/4 implies Catal is absolutely_summable & Sum Catal = 1 + r
  * (Sum Catal) |^ 2 & Sum Catal = 2 / (1 + sqrt(1-4*r)) & (r<>0 implies Sum
  Catal = (1 - sqrt(1-4*r)) / (2*r)) );














begin

definition
  let x, S be set;
  let a be Element of S;
  func k_id(x,S,a) -> Element of S equals


  x if x in S otherwise a;
end;

definition
  let x be set;
  func k_nat(x) -> Element of NAT equals


  x if x in NAT otherwise 0;
end;

definition
  let f be Function;
  let x,a be set;
  func UnivF(x,f,a) -> set equals


  f.x if x in dom f otherwise a;
end;

definition
  let a be set;
  func Castboolean(a) -> boolean set equals


  a if a is boolean set
  otherwise FALSE;
end;

definition
  let X,a be set;
  func CastBool(a,X) -> Subset of X equals


  a if a c= X otherwise {};
end;

reserve k,n for Element of NAT,
  a,Y for set,
  D,D1,D2 for non empty set,
  p,q for FinSequence of NAT;



definition
  let n;
  func atom.n -> FinSequence of NAT equals

  <* (5 + n) *>;
end;

definition
  let p;
  func 'not' p -> FinSequence of NAT equals

  <*0*>^p;
  let q;
  func p '&' q -> FinSequence of NAT equals

  <*1*>^p^q;
end;

definition
  let p;
  func EX p -> FinSequence of NAT equals

  <*2*>^p;
  func EG p -> FinSequence of NAT equals

  <*3*>^p;
  let q;
  func p EU q -> FinSequence of NAT equals

  <*4*>^p^q;
end;



definition
  func CTL_WFF -> non empty set means


  (for a st a in it holds a is
  FinSequence of NAT ) & (for n holds atom.n in it ) & (for p st p in it holds
'not' p in it ) & (for p,q st p in it & q in it holds p '&' q in it ) & (for p
st p in it holds EX p in it ) & (for p st p in it holds EG p in it ) & (for p,q
  st p in it & q in it holds p EU q in it ) & for D st (for a st a in D holds a
  is FinSequence of NAT ) & (for n holds atom.n in D ) & (for p st p in D holds
'not' p in D ) & (for p,q st p in D & q in D holds p '&' q in D ) & (for p st p
in D holds EX p in D ) & (for p st p in D holds EG p in D ) & (for p,q st p in
  D & q in D holds p EU q in D ) holds it c= D;
end;

definition
  let IT be FinSequence of NAT;
  attr IT is CTL-formula-like means


  IT is Element of CTL_WFF;
end;

registration
  cluster CTL-formula-like for FinSequence of NAT;
end;

definition
  mode CTL-formula is CTL-formula-like FinSequence of NAT;
end;

theorem 
  a is CTL-formula iff a in CTL_WFF;

reserve F,F1,G,G1,H,H1,H2 for CTL-formula;

registration
  let n;
  cluster atom.n -> CTL-formula-like;
end;

registration
  let H;
  cluster 'not' H -> CTL-formula-like;
  cluster EX H -> CTL-formula-like;
  cluster EG H -> CTL-formula-like;
  let G;
  cluster H '&' G -> CTL-formula-like;
  cluster H EU G -> CTL-formula-like;
end;

definition
  let H;
  attr H is atomic means


  ex n st H = atom.n;
  attr H is negative means


  ex H1 st H = 'not' H1;
  attr H is conjunctive means


  ex F,G st H = F '&' G;
  attr H is ExistNext means


  ex H1 st H = EX H1;
  attr H is ExistGlobal means


  ex H1 st H = EG H1;
  attr H is ExistUntill means


  ex F,G st H = F EU G;
end;

definition
  let F,G;
  func F 'or' G -> CTL-formula equals

  'not'('not' F '&' 'not' G);
end;

theorem 
  H is atomic or H is negative or H is conjunctive or H is
  ExistNext or H is ExistGlobal or H is ExistUntill;

reserve sq,sq9 for FinSequence;

definition
  let H;
  assume
 H is negative or H is ExistNext or H is ExistGlobal;
  func the_argument_of H -> CTL-formula means


  'not' it = H if H is
  negative, EX it = H if H is ExistNext otherwise EG it = H;
end;

definition
  let H;
  assume
 H is conjunctive or H is ExistUntill;
  func the_left_argument_of H -> CTL-formula means


  ex H1 st it '&' H1 = H if H is conjunctive otherwise ex H1 st it EU H1 = H;
  func the_right_argument_of H -> CTL-formula means


  ex H1 st H1 '&' it = H if H is conjunctive otherwise ex H1 st H1 EU it = H;
end;

definition
  let x be set;
  func CastCTLformula(x) -> CTL-formula equals


  x if x in CTL_WFF
  otherwise atom.0;
end;







definition
  let Prop be set;
  struct(RelStr) KripkeStr over Prop (# carrier -> set,
    Starts -> Subset of the carrier,
    InternalRel -> Relation of the carrier, the carrier,
    Label -> Function of the carrier, bool Prop #);
end;

definition
  struct(ComplULattStr) CTLModelStr (# carrier -> set, BasicAssign ->
 Subset of the carrier, L_meet -> BinOp of the carrier, Compl -> UnOp
of the carrier, EneXt -> UnOp of the carrier, EGlobal -> UnOp of the
    carrier, EUntill -> BinOp of the carrier #);
end;

definition
  let V be CTLModelStr;
  mode Assign of V is Element of the carrier of V;
end;




definition
  func atomic_WFF -> Subset of CTL_WFF equals

  {x where x is CTL-formula:x is atomic};
end;

definition
  let V be CTLModelStr;
  let Kai be Function of atomic_WFF,the BasicAssign of V;
  let f be Function of CTL_WFF,the carrier of V;
  pred f is-Evaluation-for Kai means


  for H being CTL-formula holds (H is atomic implies f.H = Kai.H) &
  (H is negative implies f.H = (the Compl of V).(f
  .(the_argument_of H))) &
   (H is conjunctive implies f.H = (the L_meet of V).(f.(
  the_left_argument_of H), f.(the_right_argument_of H))) & (H is ExistNext
  implies f.H = (the EneXt of V).(f.(the_argument_of H))) & (H is ExistGlobal
  implies f.H = (the EGlobal of V).(f.(the_argument_of H))) & (H is ExistUntill
  implies f.H = (the EUntill of V).(f.(the_left_argument_of H), f.(
  the_right_argument_of H)));
end;

definition
  let V be CTLModelStr;
  let Kai be Function of atomic_WFF,the BasicAssign of V;
  let f be Function of CTL_WFF,the carrier of V;
  let n be Element of NAT;
  pred f is-PreEvaluation-for n,Kai means


  for H being CTL-formula st
len(H) <= n holds (H is atomic implies f.H = Kai.H) & (H is negative implies f.
H = (the Compl of V).(f.(the_argument_of H))) &
(H is conjunctive implies f.H = (
  the L_meet of V).(f.(the_left_argument_of H), f.(the_right_argument_of H))) &
   (H
  is ExistNext implies f.H = (the EneXt of V).(f.(the_argument_of H))) & (H is
  ExistGlobal implies f.H = (the EGlobal of V).(f.(the_argument_of H))) & (H is
  ExistUntill implies f.H = (the EUntill of V).(f.(the_left_argument_of H), f.(
  the_right_argument_of H)));
end;

definition
  let V be CTLModelStr;
  let Kai be Function of atomic_WFF,the BasicAssign of V;
  let f,h be Function of CTL_WFF,the carrier of V;
  let n be Element of NAT;
  let H be CTL-formula;
  func GraftEval(V,Kai,f,h,n,H) -> set equals


  f.H if len(H) > n+1, Kai
.H if len(H)=n+1 & H is atomic, (the Compl of V).(h.(the_argument_of H))
 if len(H
  )=n+1 & H is negative, (the L_meet of V).(h.(the_left_argument_of H), h.(
the_right_argument_of H)) if len(H)=n+1 & H is conjunctive, (the EneXt of V).(h
.(the_argument_of H)) if len(H)=n+1 & H is ExistNext , (the EGlobal of V).(h.(
  the_argument_of H)) if len(H)=n+1 & H is ExistGlobal, (the EUntill of V).(h.(
  the_left_argument_of H), h.(the_right_argument_of H)) if len(H)=n+1 & H is
  ExistUntill, h.H if len(H)<n+1 otherwise {};
end;

definition let C be CTLModelStr;
 attr C is with_basic means

 the BasicAssign of C is non empty;
end;

definition
 func TrivialCTLModel -> CTLModelStr equals

   CTLModelStr(# 1, [#]1, op2, op1, op1, op1, op2#);
end;

registration
 cluster TrivialCTLModel -> with_basic strict non empty;
end;

registration
 cluster non empty for CTLModelStr;
end;

registration
 cluster with_basic for non empty CTLModelStr;
end;

definition
 mode CTLModel is with_basic non empty CTLModelStr;
end;

registration let C be CTLModel;
 cluster the BasicAssign of C -> non empty;
end;

reserve V for CTLModel;
reserve Kai for Function of atomic_WFF,the BasicAssign of V;
reserve f,f1,f2 for Function of CTL_WFF,the carrier of V;

definition
  let V be CTLModel;
  let Kai be Function of atomic_WFF,the BasicAssign of V;
  let n be Element of NAT;
  func EvalSet(V,Kai,n) ->non empty set equals

  {h where h is Function of
  CTL_WFF,the carrier of V : h is-PreEvaluation-for n,Kai};
end;

definition
  let V be CTLModel;
  let v0 be Element of the carrier of V;
  let x be set;
  func CastEval(V,x,v0) ->Function of CTL_WFF,the carrier of V equals


   x
 if x in Funcs(CTL_WFF,the carrier of V) otherwise CTL_WFF --> v0;
end;

definition
  let V be CTLModel;
  let Kai be Function of atomic_WFF,the BasicAssign of V;
  func EvalFamily(V,Kai) -> non empty set means


  for p being set holds
p in it iff p in bool Funcs(CTL_WFF,the carrier of V) & ex n being Element
  of NAT st p=EvalSet(V,Kai,n);
end;

theorem 
  ex f st f is-Evaluation-for Kai;

theorem 
  f1 is-Evaluation-for Kai & f2 is-Evaluation-for Kai implies f1 = f2;

definition
  let V be CTLModel;
  let Kai be Function of atomic_WFF,the BasicAssign of V;
  let H be CTL-formula;
  func Evaluate(H,Kai) -> Assign of V means


  ex f being Function of
  CTL_WFF,the carrier of V st f is-Evaluation-for Kai & it = f.H;
end;

notation
  let V be CTLModel;
  let f be Assign of V;
  synonym 'not' f for f`;
  let g be Assign of V;
  synonym f '&' g for f "/\" g;
end;

definition

  let V be CTLModel;
  let f be Assign of V;
  func EX(f) -> Assign of V equals

  (the EneXt of V).f;
  func EG(f) -> Assign of V equals

  (the EGlobal of V).f;
end;

definition
  let V be CTLModel;
  let f,g be Assign of V;
  func f EU g -> Assign of V equals

  (the EUntill of V).(f,g);
  func f 'or' g -> Assign of V equals

  'not'('not'(f) '&' 'not'(g));
end;



theorem 
  Evaluate('not' H,Kai) = 'not' Evaluate(H,Kai);

theorem 
  Evaluate(H1 '&' H2,Kai) = Evaluate(H1,Kai) '&' Evaluate(H2,Kai);

theorem 
  Evaluate(EX H,Kai) = EX Evaluate(H,Kai);

theorem 
  Evaluate(EG H,Kai) = EG Evaluate(H,Kai);

theorem 
  Evaluate(H1 EU H2,Kai) = Evaluate(H1,Kai) EU Evaluate(H2,Kai);

theorem 
  Evaluate(H1 'or' H2,Kai) = Evaluate(H1,Kai) 'or' Evaluate(H2,Kai );



notation
  let f be Function;
  let n be Nat;
  synonym f|**n for iter (f,n);
end;

definition
  let S be set;
  let f be Function of S,S;
  let n be Nat;
  redefine func f|**n -> Function of S,S;
end;

reserve S for non empty set;
reserve R for total Relation of S,S;
reserve s,s0,s1 for Element of S;



scheme 

  ExistPath{ S()-> non empty set, R()-> total Relation of S(),S(), s0()->
Element of S(), F(Element of S())-> set}: ex f being Function of NAT,S() st f.0
=s0() & for n being Element of NAT holds [f.n,f.(n+1)] in R() & f.(n+1) in F(f.
  n)
provided
 for s being Element of S() holds Im(R(),s) /\ F(s) is non empty
Subset of S();



definition
  let S be non empty set;
  let R be total Relation of S,S;
  mode inf_path of R -> Function of NAT,S means


    for n being Element of NAT holds [it.n,it.(n+1)] in R;
end;



definition
  let S be non empty set;
  func ModelSP(S) -> set equals

  Funcs(S,BOOLEAN);
end;

registration
  let S be non empty set;
  cluster ModelSP(S) -> non empty;
end;



definition
  let S be non empty set;
  let f be set;
  func Fid(f,S) -> Function of S,BOOLEAN equals


  f if f in ModelSP(S)
  otherwise S --> FALSE;
end;



scheme 

  Func1EX{S()->non empty set, f()->Function of S(),BOOLEAN, F(set,Function of
S(),BOOLEAN) -> boolean set}: ex g being set st g in ModelSP(S()) & for s being
  set st s in S() holds F(s,f()) =TRUE iff (Fid(g,S())).s=TRUE;

scheme 

  Func1Unique{S()->non empty set, f()->Function of S(),BOOLEAN, F(set,Function
of S(),BOOLEAN) -> boolean set}: for g1,g2 being set st g1 in ModelSP(S()) & (
  for s being set st s in S() holds F(s,f()) =TRUE iff (Fid(g1,S())).s=TRUE ) &
g2 in ModelSP(S()) & (for s being set st s in S() holds F(s,f()) =TRUE iff (Fid
  (g2,S())).s=TRUE ) holds g1 = g2;



scheme 

  UnOpEX{M()->non empty set, F(set)->Element of M()}: ex o being UnOp of M()
  st for f being set st f in M() holds o.(f) = F(f);

scheme 

  UnOpUnique{S()->non empty set, M()->non empty set, F(set)->Element of M()}:
for o1,o2 being UnOp of M() st (for f being set st f in M() holds o1.f = F(f))
  & (for f being set st f in M() holds o2.f = F(f)) holds o1=o2;



scheme 

  Func2EX{S()->non empty set, f()->Function of S(),BOOLEAN, g()->Function of S
(),BOOLEAN, F(set,Function of S(),BOOLEAN, Function of S(),BOOLEAN) -> boolean
set}: ex h being set st h in ModelSP(S()) & for s being set st s in S() holds F
  (s,f(),g()) =TRUE iff (Fid(h,S())).s=TRUE;

scheme 

  Func2Unique{S()->non empty set, f()->Function of S(),BOOLEAN, g()->Function
  of S(),BOOLEAN, F(set,Function of S(),BOOLEAN, Function of S(),BOOLEAN) ->
boolean set}: for h1,h2 being set st h1 in ModelSP(S()) & (for s being set st s
in S() holds F(s,f(),g()) =TRUE iff (Fid(h1,S())).s=TRUE) & h2 in ModelSP(S())
  & (for s being set st s in S() holds F(s,f(),g()) =TRUE iff (Fid(h2,S())).s=
  TRUE) holds h1 = h2;



definition
  let S be non empty set;
  let f be set;
  func Not_0(f,S) -> Element of ModelSP(S) means


  for s being set st s
  in S holds 'not' (Castboolean (Fid(f,S)).s) = TRUE iff (Fid(it,S)).s = TRUE;
end;

definition
  let S be non empty set;
  func Not_(S) -> UnOp of ModelSP(S) means


  for f being set st f in ModelSP(S) holds it.f = Not_0(f,S);
end;



definition
  let S be non empty set;
  let R be total Relation of S,S;
  let f be Function of S,BOOLEAN;
  let x be set;
  func EneXt_univ(x,f,R) -> Element of BOOLEAN equals


  TRUE if x in S &
  ex pai being inf_path of R st pai.0 = x & f.(pai.1) =TRUE otherwise FALSE;
end;

definition
  let S be non empty set;
  let R be total Relation of S,S;
  let f be set;
  func EneXt_0(f,R) -> Element of ModelSP(S) means


  for s being set st
  s in S holds EneXt_univ(s,Fid(f,S),R)=TRUE iff (Fid(it,S)).s=TRUE;
end;

definition
  let S be non empty set;
  let R be total Relation of S,S;
  func EneXt_(R) -> UnOp of ModelSP(S) means


  for f being set st f in ModelSP(S) holds it.f = EneXt_0(f,R);
end;



definition
  let S be non empty set;
  let R be total Relation of S,S;
  let f be Function of S,BOOLEAN;
  let x be set;
  func EGlobal_univ(x,f,R) -> Element of BOOLEAN equals


  TRUE if x in S
& ex pai being inf_path of R st (pai.0 = x & for n being Element of NAT holds f
  .(pai.n) =TRUE) otherwise FALSE;
end;

definition
  let S be non empty set;
  let R be total Relation of S,S;
  let f be set;
  func EGlobal_0(f,R) -> Element of ModelSP(S) means


  for s being set
  st s in S holds EGlobal_univ(s,Fid(f,S),R)=TRUE iff (Fid(it,S)).s=TRUE;
end;

definition
  let S be non empty set;
  let R be total Relation of S,S;
  func EGlobal_(R) -> UnOp of ModelSP(S) means


  for f being set st f in ModelSP(S) holds it.f = EGlobal_0(f,R);
end;



definition
  let S be non empty set;
  let f,g be set;
  func And_0(f,g,S) -> Element of ModelSP(S) means


  for s being set st
s in S holds (Castboolean (Fid(f,S)).s ) '&' (Castboolean (Fid(g,S)).s ) =TRUE
  iff (Fid(it,S)).s=TRUE;
end;

definition
  let S be non empty set;
  func And_(S) -> BinOp of ModelSP(S) means


  for f,g being set st f in
  ModelSP(S) & g in ModelSP(S) holds it.(f,g) = And_0(f,g,S);
end;



definition
  let S be non empty set;
  let R be total Relation of S,S;
  let f,g be Function of S,BOOLEAN;
  let x be set;
  func EUntill_univ(x,f,g,R) -> Element of BOOLEAN equals


  TRUE if x in
  S & ex pai being inf_path of R st (pai.0 = x & ex m being Element of NAT st (
for j being Element of NAT st j<m holds f.(pai.j) =TRUE ) & g.(pai.m) = TRUE )
  otherwise FALSE;
end;

definition
  let S be non empty set;
  let R be total Relation of S,S;
  let f,g be set;
  func EUntill_0(f,g,R) -> Element of ModelSP(S) means


  for s being set
st s in S holds EUntill_univ(s,Fid(f,S),Fid(g,S),R)=TRUE iff (Fid(it,S)).s=TRUE
  ;
end;

definition
  let S be non empty set;
  let R be total Relation of S,S;
  func EUntill_(R) -> BinOp of ModelSP(S) means


  for f,g being set st f
  in ModelSP(S) & g in ModelSP(S) holds it.(f,g) = EUntill_0(f,g,R);
end;



definition
  let S be non empty set;
  let X be non empty Subset of ModelSP(S);
  let s be set;
  func F_LABEL(s,X) -> Subset of X means


  for x being set holds x in it
  iff x in X & ex f being Function of S,BOOLEAN st f=x & f.s=TRUE;
end;

definition
  let S be non empty set;
  let X be non empty Subset of ModelSP(S);
  func Label_(X) -> Function of S,bool X means


  for x being set st x in S holds it.x = F_LABEL(x,X);
end;

definition
  let S be non empty set;
  let S0 be Subset of S;
  let R be total Relation of S,S;
  let Prop be non empty Subset of ModelSP(S);
  func KModel(R,S0,Prop) -> KripkeStr over Prop equals

  KripkeStr (# S, S0, R,
    Label_(Prop) #);
end;

registration
  let S be non empty set;
  let S0 be Subset of S;
  let R be total Relation of S,S;
  let Prop be non empty Subset of ModelSP(S);
  cluster the carrier of KModel(R,S0,Prop) -> non empty;
end;

registration
  let S be non empty set;
  let S0 be Subset of S;
  let R be total Relation of S,S;
  let Prop be non empty Subset of ModelSP(S);
  cluster ModelSP(the carrier of KModel(R,S0,Prop)) -> non empty for Subset of
    Funcs(the carrier of KModel(R,S0,Prop),BOOLEAN);
end;

definition
  let S be non empty set;
  let R be total Relation of S,S;
  let BASSIGN be non empty Subset of ModelSP(S);
  func BASSModel(R,BASSIGN) -> CTLModelStr equals

  CTLModelStr(# ModelSP(S),
    BASSIGN, And_(S), Not_(S), EneXt_(R), EGlobal_(R), EUntill_(R) #);
end;

registration
  let S be non empty set;
  let R be total Relation of S,S;
  let BASSIGN be non empty Subset of ModelSP(S);
  cluster BASSModel(R,BASSIGN) -> with_basic non empty;
end;

reserve BASSIGN for non empty Subset of ModelSP(S);
reserve kai for Function of atomic_WFF,the BasicAssign of BASSModel(R,BASSIGN);



definition
  let S be non empty set;
  let R be total Relation of S,S;
  let BASSIGN be non empty Subset of ModelSP(S);
  let s be Element of S;
  let f be Assign of BASSModel(R,BASSIGN);
  pred s |= f means


  (Fid(f,S)).s=TRUE;
end;

notation
  let S be non empty set;
  let R be total Relation of S,S;
  let BASSIGN be non empty Subset of ModelSP(S);
  let s be Element of S;
  let f be Assign of BASSModel(R,BASSIGN);
  antonym s |/= f for s |= f;
end;

theorem 
  for a being Assign of BASSModel(R,BASSIGN) st a in BASSIGN holds
  s |= a iff a in (Label_(BASSIGN)).s;

theorem 
  for f being Assign of BASSModel(R,BASSIGN) holds s |= 'not'(f) iff s |/= f;

theorem 
  for f,g being Assign of BASSModel(R,BASSIGN) holds s |= f '&' g
  iff s|=f & s|=g;

theorem 
  for f being Assign of BASSModel(R,BASSIGN) holds s |= EX(f) iff
  ex pai being inf_path of R st pai.0 = s & (pai.1) |= f;

theorem 
  for f being Assign of BASSModel(R,BASSIGN) holds s |= EG(f) iff
ex pai being inf_path of R st pai.0 = s & for n being Element of NAT holds (pai
  .n) |= f;

theorem 
  for f,g being Assign of BASSModel(R,BASSIGN) holds s |= f EU g
iff ex pai being inf_path of R st pai.0 = s & ex m being Element of NAT st (for
  j being Element of NAT st j<m holds pai.j |= f) & pai.m |= g;

theorem 
  for f,g being Assign of BASSModel(R,BASSIGN) holds s |= f 'or' g
  iff (s|= f or s|= g);



definition
  let S be non empty set;
  let R be total Relation of S,S;
  let BASSIGN be non empty Subset of ModelSP(S);
  let kai being Function of atomic_WFF,the BasicAssign of BASSModel(R,BASSIGN);
  let s be Element of S;
  let H be CTL-formula;
  pred s,kai|= H means


  s|= Evaluate(H,kai);
end;

notation
  let S be non empty set;
  let R be total Relation of S,S;
  let BASSIGN be non empty Subset of ModelSP(S);
  let kai being Function of atomic_WFF,the BasicAssign of BASSModel(R,BASSIGN);
  let s be Element of S;
  let H be CTL-formula;
  antonym s,kai|/= H for s,kai|= H;
end;

theorem 
  H is atomic implies (s,kai |= H iff kai.H in (Label_(BASSIGN)).s);

theorem 
  s,kai|= 'not' H iff s,kai|/= H;

theorem 
  s,kai|= H1 '&' H2 iff s,kai|= H1 & s,kai|= H2;

theorem 
  s,kai|= H1 'or' H2 iff s,kai|= H1 or s,kai|= H2;

theorem 
  s,kai|= EX H iff ex pai being inf_path of R st pai.0 = s & (pai.1),kai |= H;

theorem 
  s,kai|= EG H iff ex pai being inf_path of R st pai.0 = s & for n being
  Element of NAT holds (pai.n),kai|= H;

theorem 
  s,kai|= H1 EU H2 iff ex pai being inf_path of R st pai.0 = s & ex m
being Element of NAT st (for j being Element of NAT st j<m holds pai.j,kai|= H1
  ) & pai.m,kai|= H2;



theorem 
  for s0 holds ex pai being inf_path of R st pai.0 = s0;

theorem 
  for R being Relation of S,S holds R is total iff for x being set st x
  in S holds ex y being set st y in S & [x,y] in R;











definition
  let S be non empty set;
  let R be total Relation of S,S;
  let s0 be Element of S;
  let pai be inf_path of R;
  let n be set;
  func PrePath(n,s0,pai) -> Element of S equals


  s0 if n=0 otherwise
  pai.(k_nat(k_nat(n)-1));
end;

theorem 
  [s0,s1] in R implies ex pai being inf_path of R st pai.0 = s0 & pai.1=s1;

theorem 
  for f being Assign of BASSModel(R,BASSIGN) holds s |= EX(f) iff
  ex s1 being Element of S st [s,s1] in R & s1 |= f;



definition
  let S be non empty set;
  let R be total Relation of S,S;
  let H be Subset of S;
  func Pred(H,R) -> Subset of S equals

  { s where s is Element of S : ex t
  being Element of S st t in H & [s,t] in R };
end;



definition
  let S be non empty set;
  let R be total Relation of S,S;
  let BASSIGN be non empty Subset of ModelSP(S);
  let f be Assign of BASSModel(R,BASSIGN);
  func SIGMA(f) -> Subset of S equals

  { s where s is Element of S : s|= f };
end;



theorem 
  for f, g being Assign of BASSModel(R,BASSIGN) holds SIGMA(f) = SIGMA(g)
  implies f=g;



definition
  let S be non empty set;
  let R be total Relation of S,S;
  let BASSIGN be non empty Subset of ModelSP(S);
  let T be Subset of S;
  func Tau(T,R,BASSIGN) -> Assign of BASSModel(R,BASSIGN) means


  for s being set st s in S holds (Fid(it,S)).s = chi(T,S).s;
end;



theorem 
  for T1,T2 being Subset of S holds Tau(T1,R,BASSIGN) = Tau(T2,R,BASSIGN
  ) implies T1=T2;



theorem 
  for f being Assign of BASSModel(R,BASSIGN) holds Tau(SIGMA(f),R, BASSIGN) = f
;



theorem 
  for T being Subset of S holds SIGMA(Tau(T,R,BASSIGN)) = T;



theorem 
  for f,g being Assign of BASSModel(R,BASSIGN) holds SIGMA('not' f)
  = S \ SIGMA(f) & SIGMA(f '&' g) = SIGMA(f) /\ SIGMA(g) & SIGMA(f 'or' g) =
  SIGMA(f) \/ SIGMA(g);



theorem 
  for G1,G2 being Subset of S holds G1 c= G2 implies for s being
  Element of S holds s|= Tau(G1,R,BASSIGN) implies s|= Tau(G2,R,BASSIGN);



theorem 
  for f1,f2 being Assign of BASSModel(R,BASSIGN) holds (for s being
  Element of S holds s|= f1 implies s|= f2) implies SIGMA(f1) c= SIGMA(f2);








definition
  let S be non empty set;
  let R be total Relation of S,S;
  let BASSIGN be non empty Subset of ModelSP(S);
  let f,g be Assign of BASSModel(R,BASSIGN);
  func Fax(f,g) -> Assign of BASSModel(R,BASSIGN) equals

  f '&' EX(g);
end;



theorem 
  for f,g1,g2 being Assign of BASSModel(R,BASSIGN) holds (for s
being Element of S holds s|= g1 implies s|= g2) implies for s being Element of
  S holds s|= Fax(f,g1) implies s|= Fax(f,g2);











definition
  let S be non empty set;
  let R be total Relation of S,S;
  let BASSIGN be non empty Subset of ModelSP(S);
  let f be Assign of BASSModel(R,BASSIGN);
  let G be Subset of S;
  func SigFaxTau(f,G,R,BASSIGN) -> Subset of S equals

  SIGMA(Fax(f,Tau(G,R,
  BASSIGN)));
end;



theorem 
  for f being Assign of BASSModel(R,BASSIGN), G1,G2 being Subset of
S holds G1 c= G2 implies SigFaxTau(f,G1,R,BASSIGN) c= SigFaxTau(f,G2,R,BASSIGN)
;



definition
  let S be non empty set;
  let R be total Relation of S,S;
  let pai be inf_path of R;
  let k be Element of NAT;
  func PathShift(pai,k) -> inf_path of R means


  for n being Element of NAT holds it.n = pai.(n+k);
end;

definition
  let S be non empty set;
  let R be total Relation of S,S;
  let pai1,pai2 be inf_path of R;
  let n,k be Element of NAT;
  func PathChange(pai1,pai2,k,n) -> set equals


  pai1.n if n<k otherwise
  pai2.(n-k);
end;

definition
  let S be non empty set;
  let R be total Relation of S,S;
  let pai1,pai2 be inf_path of R;
  let k be Element of NAT;
  func PathConc(pai1,pai2,k) -> Function of NAT,S means


  for n being Element of NAT holds it.n = PathChange(pai1,pai2,k,n);
end;

theorem 
  for pai1,pai2 being inf_path of R, k being Element of NAT holds
  pai1.k = pai2.0 implies PathConc(pai1,pai2,k) is inf_path of R;



theorem 
  for f being Assign of BASSModel(R,BASSIGN), s being Element of S
  holds s|= EG(f) iff s|= Fax(f,EG(f));



theorem 
  for g being Assign of BASSModel(R,BASSIGN), s0 being Element of S
  st s0 |= g holds (for s being Element of S holds s|= g implies s|= EX(g))
  implies ex pai being inf_path of R st pai.0= s0 & for n being Element of NAT
  holds pai.n |= g;



theorem 
  for f,g being Assign of BASSModel(R,BASSIGN) holds (for s being
  Element of S holds s|= g iff s|= Fax(f,g)) implies for s being Element of S
  holds s|= g implies s|= EG(f);



definition
  let S be non empty set;
  let R be total Relation of S,S;
  let BASSIGN be non empty Subset of ModelSP(S);
  let f be Assign of BASSModel(R,BASSIGN);
  func TransEG(f) -> c=-monotone Function of bool S, bool S means


  for G being Subset of S holds it.G = SigFaxTau(f,G,R,BASSIGN);
end;



theorem 
  for f,g being Assign of BASSModel(R,BASSIGN) holds (for s being
  Element of S holds s|= g iff s|= Fax(f,g)) iff SIGMA(g) is_a_fixpoint_of
  TransEG(f);

theorem 
  for f being Assign of BASSModel(R,BASSIGN) holds SIGMA(EG(f)) = gfp(S,
  TransEG(f));



definition
  let S be non empty set;
  let R be total Relation of S,S;
  let BASSIGN be non empty Subset of ModelSP(S);
  let f,g,h be Assign of BASSModel(R,BASSIGN);
  func Foax(g,f,h) -> Assign of BASSModel(R,BASSIGN) equals

  g 'or' Fax(f,h);
end;



theorem 
  for f,g,h1,h2 being Assign of BASSModel(R,BASSIGN) holds (for s
being Element of S holds s|= h1 implies s|= h2) implies for s being Element of
  S holds s|= Foax(g,f,h1) implies s|= Foax(g,f,h2);











definition
  let S be non empty set;
  let R be total Relation of S,S;
  let BASSIGN be non empty Subset of ModelSP(S);
  let f,g be Assign of BASSModel(R,BASSIGN);
  let H be Subset of S;
  func SigFoaxTau(g,f,H,R,BASSIGN) -> Subset of S equals

  SIGMA(Foax(g,f,Tau(H,
  R,BASSIGN)));
end;



theorem 
  for f,g being Assign of BASSModel(R,BASSIGN), H1,H2 being Subset
of S holds H1 c= H2 implies SigFoaxTau(g,f,H1,R,BASSIGN) c= SigFoaxTau(g,f,H2,R
  ,BASSIGN);



theorem 
  for f,g being Assign of BASSModel(R,BASSIGN), s being Element of
  S holds s|= f EU g iff s|= Foax(g,f,f EU g);



theorem 
  for f,g,h being Assign of BASSModel(R,BASSIGN) holds (for s being
Element of S holds s|= h iff s|= Foax(g,f,h)) implies for s being Element of S
  holds s|= f EU g implies s|= h;



definition
  let S be non empty set;
  let R be total Relation of S,S;
  let BASSIGN be non empty Subset of ModelSP(S);
  let f,g be Assign of BASSModel(R,BASSIGN);
  func TransEU(f,g) -> c=-monotone Function of bool S, bool S means


  for H being Subset of S holds it.H = SigFoaxTau(g,f,H,R,BASSIGN);
end;



theorem 
  for f,g,h being Assign of BASSModel(R,BASSIGN) holds (for s being
  Element of S holds s|= h iff s|= Foax(g,f,h)) iff SIGMA(h) is_a_fixpoint_of
  TransEU(f,g);

theorem 
  for f,g being Assign of BASSModel(R,BASSIGN) holds SIGMA(f EU g) = lfp(
  S,TransEU(f,g));



theorem 
  for f being Assign of BASSModel(R,BASSIGN) holds SIGMA(EX(f)) =
  Pred(SIGMA(f),R);

theorem 
  for f being Assign of BASSModel(R,BASSIGN), X being Subset of S holds (
  TransEG(f)).X = SIGMA(f) /\ Pred(X,R);

theorem 
  for f,g being Assign of BASSModel(R,BASSIGN), X being Subset of S holds
  (TransEU(f,g)).X = SIGMA(g) \/ (SIGMA(f) /\ Pred(X,R));














begin



theorem 
  for A,B being Element of NAT, X being non empty set for F being
Function of NAT, X st F is one-to-one holds card {F.w where w is Element of NAT
  : A <= w & w <= A + B} = B+1;

theorem 
  for n,m,k being Nat st m <= k & n < m holds k -' m < k -' n;

notation
  let S be set;
  synonym S is with_finite-elements for S is finite-membered;
end;

registration
  cluster non empty finite with_finite-elements for Subset of bool NAT;
end;

definition
 canceled;
  let f,g be Function;
  func f .\/ g -> Function means


  dom it = dom f \/ dom g & for x being
  set st x in dom f \/ dom g holds it.x = f.x \/ g.x;
end;

theorem 
  for m,n,k being Nat holds m in ((Seg k) \ Seg (k -' n)) iff k -'
  n < m & m <= k;

theorem 
  for n,k,m being Nat st n <= m holds ((Seg k) \ Seg (k -' n)) c= (
  (Seg k) \ Seg (k -' m));

theorem 
  for n,k being Nat st n < k holds ((Seg k) \ Seg (k -' n)) \/ {k
  -' n} = (Seg k) \ Seg (k -' (n+1));

definition
  let f be Relation;
  attr f is natsubset-yielding means


  rng f c= bool NAT;
end;

registration
  cluster finite-yielding natsubset-yielding for Function;
end;

definition
  let f be finite-yielding natsubset-yielding Function, x be set;
  redefine func f.x -> finite Subset of NAT;
end;

theorem 
  for X being Ordinal, a, b be finite Subset of X st a <> b holds (
  a,1)-bag <> (b,1)-bag;

definition
  let F be natural-valued Function, S be set, k be Nat;
  func F.incSubset(S,k) -> natural-valued Function means


  dom it = dom F
  & for y being set holds (y in S & y in dom F implies it.y = F.y + k) & (not y
  in S implies it.y = F.y);
end;

definition
  let n be Ordinal, T be connected TermOrder of n, B be non empty finite
  Subset of Bags n;
  func max(B,T) -> bag of n means


  it in B & for x being bag of n st x in B holds x <= it,T;
end;

registration
  let O be Ordinal;
  cluster InvLexOrder O -> connected;
end;

begin 

definition
  let s be ManySortedSet of NAT;
  attr s is iterative means


  for k, n being Nat st s.k = s.n holds s.(k+ 1) = s.(n+1);
end;

definition
  let S be ManySortedSet of NAT;
  attr S is eventually-constant means


  ex n being Nat st for m being Nat st n <= m holds S.n = S.m;
end;

registration
  cluster halting iterative eventually-constant for ManySortedSet of NAT;
end;

theorem 
  for Gs being ManySortedSet of NAT st Gs is halting & Gs is
  iterative holds Gs is eventually-constant;

registration
  cluster halting iterative -> eventually-constant for ManySortedSet of NAT;
end;

theorem 
  for Gs being ManySortedSet of NAT st Gs is eventually-constant
  holds Gs is halting;

registration
  cluster eventually-constant -> halting for ManySortedSet of NAT;
end;

theorem 
  for Gs being iterative eventually-constant ManySortedSet of NAT
  for n being Nat st Gs.Lifespan() <= n holds Gs.(Gs.Lifespan()) = Gs.n;

theorem 
  for Gs being iterative eventually-constant ManySortedSet of NAT
  for n,m being Nat st Gs.Lifespan() <= n & n <= m holds Gs.m = Gs.n;

begin 

definition
  let G be finite _Graph;
  mode preVNumberingSeq of G -> ManySortedSet of NAT means


    for i being Nat holds it.i is PartFunc of the_Vertices_of G, NAT;
end;

definition
  let G be finite _Graph, S be preVNumberingSeq of G, n be Nat;
  redefine func S.n -> PartFunc of the_Vertices_of G, NAT;
end;

definition
  let G be finite _Graph, S be preVNumberingSeq of G;
  attr S is vertex-numbering means


  S.0 = {} & S is iterative & S is
  halting & S.Lifespan() = G.order() & for n being Nat st n < S.Lifespan() ex w
  being Vertex of G st not w in dom (S.n) & (S.(n+1)) = (S.n) +* (w .--> (S
  .Lifespan()-'n));
end;

registration
  let G be finite _Graph;
  cluster vertex-numbering for preVNumberingSeq of G;
end;



registration
  let G be finite _Graph;
  cluster vertex-numbering -> halting iterative for preVNumberingSeq of G;
end;

definition
  let G be finite _Graph;
  mode VNumberingSeq of G is vertex-numbering preVNumberingSeq of G;
end;

definition
  let G be finite _Graph, S be VNumberingSeq of G, n be Nat;
  func S.PickedAt(n) -> set means


  it = choose the_Vertices_of G if n
  >= S.Lifespan() otherwise not it in dom (S.n) & S.(n+1) = S.n +* (it .--> (S
  .Lifespan()-'n));
end;

theorem 
  for G being finite _Graph, S being VNumberingSeq of G, n being
Nat st n < S.Lifespan() holds S.PickedAt(n) in dom (S.(n+1)) & dom (S.(n+1)) =
  dom (S.n) \/ {S.PickedAt(n)};

theorem 
  for G being finite _Graph, S being VNumberingSeq of G, n being
  Nat st n < S.Lifespan() holds (S.(n+1)).(S.PickedAt(n)) = S.Lifespan()-'n;

theorem 
  for G being finite _Graph, S being VNumberingSeq of G, n being Nat st
  n <= S.Lifespan() holds card dom (S.n) = n;

theorem 
  for G being finite _Graph, S being VNumberingSeq of G, n being
  Nat holds rng (S.n) = (Seg S.Lifespan()) \ Seg (S.Lifespan()-'n);

theorem 
  for G being finite _Graph, S being VNumberingSeq of G, n being
Nat, x being set holds (S.n).x <= S.Lifespan() & (x in dom (S.n) implies 1 <= (
  S.n).x);

theorem 
  for G being finite _Graph, S being VNumberingSeq of G, n,m being
Nat st S.Lifespan() -' n < m & m <= S.Lifespan() ex v being Vertex of G st v in
  dom (S.n) & (S.n).v = m;

theorem 
  for G being finite _Graph, S being VNumberingSeq of G, m, n
  being Nat st m <= n holds S.m c= S.n;

theorem 
  for G being finite _Graph, S being VNumberingSeq of G, n being
  Nat holds S.n is one-to-one;

theorem 
  for G being finite _Graph, S being VNumberingSeq of G, m,n being
  Nat, v being set st v in dom (S.m) & v in dom (S.n) holds (S.m).v = (S.n).v;

theorem 
  for G being finite _Graph, S being VNumberingSeq of G, m,n being
Nat, v being set st v in dom (S.m) & (S.m).v = n holds S.PickedAt(S.Lifespan()
  -'n) = v;

theorem 
  for G being finite _Graph, S being VNumberingSeq of G, m, n
being Nat st n < S.Lifespan() & n < m holds S.PickedAt(n) in dom (S.m) & (S.m).
  (S.PickedAt(n)) = S.Lifespan() -' n;



theorem 
  for G being finite _Graph, S being VNumberingSeq of G, m being
  Nat, v being set st v in dom (S.m) holds S.Lifespan() -' (S.m).v < m & S
  .Lifespan() -' m < (S.m).v;




theorem 
  for G being finite _Graph, S being VNumberingSeq of G, i being
Nat, a,b being set st a in dom (S.i) & b in dom (S.i) & (S.i).a < (S.i).b holds
  b in dom (S.(S.Lifespan() -' (S.i).a));

theorem 
  for G being finite _Graph, S being VNumberingSeq of G, i being
Nat, a,b being set st a in dom (S.i) & (S.i).a < (S.i).b holds not a in dom (S.
  (S.Lifespan() -' (S.i).b));

begin 

definition
  let X1,X3 be set, X2 be non empty set;
  let x be Element of [: PFuncs(X1,X3),X2 :];
  redefine func x`1 -> Element of PFuncs(X1,X3);
end;

definition
  let X1, X3 be non empty set, X2 be set;
  let x be Element of [: X1, Funcs(X2,X3) :];
  redefine func x`2 -> Element of Funcs(X2,X3);
end;

definition
  let G be _Graph;
  mode LexBFS:Labeling of G is Element of [: PFuncs(the_Vertices_of G, NAT),
    Funcs(the_Vertices_of G, Fin NAT) :];
end;

registration
  let G be finite _Graph, L be LexBFS:Labeling of G;
  cluster L`1 -> finite;
  cluster L`2 -> finite;
end;

definition
  let G be _Graph;
  func LexBFS:Init(G) -> LexBFS:Labeling of G equals

  [ {}, the_Vertices_of G
  --> {} ];
end;

definition
  let G be finite _Graph, L be LexBFS:Labeling of G;
  func LexBFS:PickUnnumbered(L) -> Vertex of G means


  it = choose
the_Vertices_of G if dom L`1 = the_Vertices_of G otherwise ex S being non empty
finite Subset of bool NAT, B being non empty finite Subset of Bags NAT, F being
Function st S = rng F & F = L`2 | (the_Vertices_of G \ dom L`1) & (for x being
finite Subset of NAT holds x in S implies ((x,1)-bag in B)) & (for x being set
holds x in B implies ex y being finite Subset of NAT st y in S & x = (y,1)-bag)
  & it = choose (F " {support max(B,InvLexOrder NAT)});
end;

definition
  let G be finite _Graph, L be LexBFS:Labeling of G, v be Vertex of G, n be
  Nat;
  func LexBFS:Update(L, v, n) -> LexBFS:Labeling of G equals

  [ L`1 +* (v .-->
(G.order()-'n)), L`2 .\/ ((G.AdjacentSet({v}) \ dom L`1) --> {G.order()-'n}) ];
end;

theorem 
  for G being finite _Graph, L being LexBFS:Labeling of G, v being
Vertex of G, x being set, k being Nat st not x in G.AdjacentSet({v}) holds L`2.
  x = (LexBFS:Update(L,v,k))`2.x;

theorem 
  for G being finite _Graph, L being LexBFS:Labeling of G, v being
Vertex of G, x being set, k being Nat st x in dom L`1 holds LexBFS:Update(L,v,k
  )`2.x = L`2.x;

theorem 
  for G being finite _Graph, L being LexBFS:Labeling of G, v be
Vertex of G, x being set, k being Nat st x in G.AdjacentSet({v}) & not x in dom
  L`1 holds LexBFS:Update(L,v,k)`2.x = L`2.x \/ {G.order() -' k};

definition
  let G be finite _Graph, L be LexBFS:Labeling of G;
  func LexBFS:Step(L) -> LexBFS:Labeling of G equals


  L if G.order() <=
card (dom L`1) otherwise LexBFS:Update(L, LexBFS:PickUnnumbered(L), card dom L
  `1);
end;

definition
  let G be _Graph;
  mode LexBFS:LabelingSeq of G -> ManySortedSet of NAT means


    for n being Nat holds it.n is LexBFS:Labeling of G;
end;

definition
  let G be _Graph, S be LexBFS:LabelingSeq of G, n be Nat;
  redefine func S.n -> LexBFS:Labeling of G;
end;

definition
  let G be _Graph, S be LexBFS:LabelingSeq of G;
  redefine func S.Result() -> LexBFS:Labeling of G;
end;

definition
  let G be finite _Graph, S be LexBFS:LabelingSeq of G;
  func S``1 -> preVNumberingSeq of G means


  for n being Nat holds it.n = (S.n)`1;
end;

definition
  let G be finite _Graph;
  func LexBFS:CSeq(G) -> LexBFS:LabelingSeq of G means


  it.0 = LexBFS:Init(G) & for n being Nat holds it.(n+1) = LexBFS:Step(it.n);
end;

theorem 
  for G being finite _Graph holds LexBFS:CSeq(G) is iterative;

registration
  let G be finite _Graph;
  cluster LexBFS:CSeq(G) -> iterative;
end;

definition
  let X, Y be set, f be Function of X, Fin Y, x be set;
  redefine func f.x -> finite Subset of Y;
end;



theorem 
  for G being finite _Graph, L be LexBFS:Labeling of G, x being
set st not x in dom L`1 & dom L`1 <> the_Vertices_of G holds (L`2.x,1)-bag <= (
  L`2.(LexBFS:PickUnnumbered(L)),1)-bag, InvLexOrder NAT;



theorem 
  for G being finite _Graph, L be LexBFS:Labeling of G st dom L`1
  <> the_Vertices_of G holds not LexBFS:PickUnnumbered(L) in dom L`1;

theorem 
  for G being finite _Graph, n being Nat st card dom ((LexBFS:CSeq
(G)).n)`1 < G.order() holds ((LexBFS:CSeq(G)).(n+1))`1 = ((LexBFS:CSeq(G)).n)`1
  +* (LexBFS:PickUnnumbered((LexBFS:CSeq(G)).n) .--> (G.order()-'(card (dom ((
  LexBFS:CSeq(G)).n)`1))));

theorem 
  for G being finite _Graph, n being Nat st n <= G.order() holds
  card dom ((LexBFS:CSeq(G)).n)`1 = n;

theorem 
  for G being finite _Graph, n being Nat st G.order() <= n holds (
  LexBFS:CSeq(G)).(G.order()) = (LexBFS:CSeq(G)).n;

theorem 
  for G being finite _Graph, m,n being Nat st G.order() <= m & m
  <= n holds (LexBFS:CSeq(G)).m = (LexBFS:CSeq(G)).n;

theorem 
  for G being finite _Graph holds LexBFS:CSeq(G) is eventually-constant;

registration
  let G be finite _Graph;
  cluster LexBFS:CSeq(G) -> eventually-constant;
end;

theorem 
  for G being finite _Graph, n being Nat holds dom ((LexBFS:CSeq(G
  )).n)`1 = the_Vertices_of(G) iff G.order() <= n;

theorem 
  for G being finite _Graph holds (LexBFS:CSeq(G)).Lifespan() = G .order();

theorem 
  for G being finite _Graph holds (LexBFS:CSeq(G))``1 is eventually-constant;

theorem 
  for G being finite _Graph holds (LexBFS:CSeq(G))``1.Lifespan() =
  (LexBFS:CSeq(G)).Lifespan();

registration
  let G be finite _Graph;
  cluster (LexBFS:CSeq(G))``1 -> vertex-numbering;
end;

theorem 
  for G being finite _Graph holds (LexBFS:CSeq(G))``1.Result() = (
  LexBFS:CSeq(G)).Result()`1;

theorem 
  for G being finite _Graph, n being Nat st n < G.order() holds ((
  LexBFS:CSeq(G))``1).PickedAt(n) = LexBFS:PickUnnumbered((LexBFS:CSeq(G)).n);

theorem 
  for G being finite _Graph, n being Nat st n < G.order() ex w
  being Vertex of G st w = LexBFS:PickUnnumbered((LexBFS:CSeq(G)).n) & for v
being set holds (v in G.AdjacentSet({w}) & not v in dom ((LexBFS:CSeq(G)).n)`1
  implies ((LexBFS:CSeq(G)).(n+1)) `2.v = (((LexBFS:CSeq(G)).n))`2.v \/ {G
.order() -' n}) & ((not v in G.AdjacentSet({w}) or v in dom (((LexBFS:CSeq(G)).
  n))`1) implies ((LexBFS:CSeq(G)).(n+1)) `2.v = (((LexBFS:CSeq(G)).n))`2.v);

theorem 
  for G being finite _Graph, i being Nat, v being set holds ((
  LexBFS:CSeq(G)).i)`2.v c= (Seg G.order()) \ Seg (G.order()-'i);

theorem 
  for G being finite _Graph, x being set, i,j being Nat st i <= j
  holds ((LexBFS:CSeq(G)).i)`2.x c= ((LexBFS:CSeq(G)).j)`2.x;

theorem 
  for G being finite _Graph, m,n being Nat, x, y being set st n <
  G.order() & n < m & y = LexBFS:PickUnnumbered((LexBFS:CSeq(G)).n) & not x in
dom ((LexBFS:CSeq(G)).n)`1 & x in G.AdjacentSet({y}) holds (G.order() -' n) in
  ((LexBFS:CSeq(G)).m)`2.x;

theorem 
  for G being finite _Graph, m,n being Nat st m < n for x being
set st not G.order()-'m in ((LexBFS:CSeq(G)).(m+1))`2.x holds not G.order()-'m
  in ((LexBFS:CSeq(G)).n)`2.x;





theorem 
  for G being finite _Graph, m,n,k being Nat st k < n & n <= m for
x being set st not G.order()-'k in ((LexBFS:CSeq(G)).n)`2.x holds not G.order()
  -'k in ((LexBFS:CSeq(G)).m)`2.x;



theorem 
  for G being finite _Graph, m,n being Nat, x being Vertex of G st
n in ((LexBFS:CSeq(G)).m)`2.x ex y being Vertex of G st (LexBFS:PickUnnumbered(
  (LexBFS:CSeq(G)).(G.order()-'n))) = y & not y in dom ((LexBFS:CSeq(G)).(G
  .order()-'n))`1 & x in G.AdjacentSet({y});

theorem 
  for G being finite _Graph holds dom ((LexBFS:CSeq(G)).Result())
  `1 = the_Vertices_of G;


theorem 
  for G being finite _Graph holds ((LexBFS:CSeq(G)).Result()`1)"
  is VertexScheme of G;



theorem 
  for G being finite _Graph, i,j being Nat, a,b being Vertex of G
  st a in dom ((LexBFS:CSeq(G)).i)`1 & b in dom ((LexBFS:CSeq(G)).i)`1 & ((
  LexBFS:CSeq(G)).i)`1.a < ((LexBFS:CSeq(G)).i)`1.b & j = G.order() -' ((
  LexBFS:CSeq(G)).i)`1.b holds (((LexBFS:CSeq(G)).j)`2.a,1)-bag <= ((((
  LexBFS:CSeq(G)).j)`2).b,1)-bag, InvLexOrder NAT;




theorem 
  for G being finite _Graph, i,j being Nat,v being Vertex of G st
j in ((LexBFS:CSeq(G)).i)`2.v ex w being Vertex of G st w in dom ((LexBFS:CSeq(
  G)).i)`1 & (((LexBFS:CSeq(G)).i)`1).w = j & v in G.AdjacentSet{w};

definition
  let G be _Graph, F be PartFunc of the_Vertices_of G, NAT;
  attr F is with_property_L3 means


  for a,b,c being Vertex of G st a in
  dom F & b in dom F & c in dom F & F.a < F.b & F.b < F.c & a,c are_adjacent &
  not b,c are_adjacent ex d being Vertex of G st d in dom F & F.c < F.d & b,d
  are_adjacent & not a,d are_adjacent & for e being Vertex of G st e <> d & e,b
  are_adjacent & not e,a are_adjacent holds F.e < F.d;
end;

theorem 
  for G being finite _Graph, n being Nat holds ((LexBFS:CSeq(G)).n
  )`1 is with_property_L3;

theorem 
  for G being finite chordal _Graph, L be PartFunc of
the_Vertices_of G, NAT st L is with_property_L3 & dom L = the_Vertices_of G for
  V being VertexScheme of G st V" = L holds V is perfect;

theorem 
  for G being finite chordal _Graph holds (((LexBFS:CSeq(G)).Result())`1
  )" is perfect VertexScheme of G;

begin 

definition
  let G be _Graph;
  mode MCS:Labeling of G is Element of [: PFuncs(the_Vertices_of G, NAT),
    Funcs(the_Vertices_of G, NAT) :];
end;

definition
  let G be finite _Graph;
  func MCS:Init(G) -> MCS:Labeling of G equals

  [ {}, the_Vertices_of G --> 0 ];
end;

definition
  let G be finite _Graph, L be MCS:Labeling of G;
  func MCS:PickUnnumbered(L) -> Vertex of G means


  it = choose
  the_Vertices_of G if dom L`1 = the_Vertices_of G otherwise ex S being finite
  non empty natural-membered set, F being Function st S = rng F & F = L`2 | (
  the_Vertices_of G \ dom (L`1)) & it = choose (F " {max S});
end;

definition
  let G be finite _Graph, L be MCS:Labeling of G, v be set;
  func MCS:LabelAdjacent(L, v) -> MCS:Labeling of G equals

  [ L`1, (L`2)
  .incSubset(G.AdjacentSet({v}) \ dom L`1, 1) ];
end;

definition
  let G be finite _Graph, L be MCS:Labeling of G, v be Vertex of G, n be Nat;
  func MCS:Update(L, v, n) -> MCS:Labeling of G means


  ex M being
  MCS:Labeling of G st M = [L`1 +* (v .--> (G.order()-'n)), L`2] & it =
  MCS:LabelAdjacent(M, v);
end;

definition
  let G be finite _Graph, L be MCS:Labeling of G;
  func MCS:Step(L) -> MCS:Labeling of G equals


  L if G.order() <= card
  dom (L`1) otherwise MCS:Update(L, MCS:PickUnnumbered(L), card dom (L`1));
end;

definition
  let G be _Graph;
  mode MCS:LabelingSeq of G -> ManySortedSet of NAT means


    for n being Nat holds it.n is MCS:Labeling of G;
end;

definition
  let G be _Graph, S be MCS:LabelingSeq of G, n be Nat;
  redefine func S.n -> MCS:Labeling of G;
end;

definition
  let G be _Graph, S be MCS:LabelingSeq of G;
  redefine func S.Result() -> MCS:Labeling of G;
end;

definition
  let G be finite _Graph, S be MCS:LabelingSeq of G;
  func S``1 -> preVNumberingSeq of G means


  for n being Nat holds it.n = (S.n)`1;
end;

definition
  let G be finite _Graph;
  func MCS:CSeq(G) -> MCS:LabelingSeq of G means


  it.0 = MCS:Init(G) & for n being Nat holds it.(n+1) = MCS:Step(it.n);
end;

theorem 
  for G being finite _Graph holds MCS:CSeq(G) is iterative;

registration
  let G be finite _Graph;
  cluster MCS:CSeq(G) -> iterative;
end;

theorem 
  for G being finite _Graph, v being set holds ((MCS:Init(G))`2).v = 0;

theorem 
  for G being finite _Graph, L be MCS:Labeling of G, x being set
  st not x in dom L`1 & dom L`1 <> the_Vertices_of G holds (L`2).x <= (L`2).(
  MCS:PickUnnumbered(L));

theorem 
  for G being finite _Graph, L be MCS:Labeling of G st dom L`1 <>
  the_Vertices_of G holds not MCS:PickUnnumbered(L) in dom L`1;

theorem 
  for G being finite _Graph, L be MCS:Labeling of G, v,x being set
  st not x in G.AdjacentSet({v}) holds (L`2).x = (MCS:LabelAdjacent(L,v))`2.x;

theorem 
  for G being finite _Graph, L be MCS:Labeling of G, v,x being set
  st x in dom L`1 holds L`2.x = (MCS:LabelAdjacent(L,v))`2.x;

theorem 
  for G being finite _Graph, L being MCS:Labeling of G, v,x being
  set st x in dom L`2 & x in G.AdjacentSet{v} & not x in dom L`1 holds (
  MCS:LabelAdjacent(L,v))`2.x = (L`2).x + 1;

theorem 
  for G being finite _Graph, L being MCS:Labeling of G, v being set st
  dom L`2 = the_Vertices_of G holds dom (MCS:LabelAdjacent(L,v))`2 =
  the_Vertices_of G;

theorem 
  for G being finite _Graph, n being Nat st card dom (((MCS:CSeq(G
  )).n))`1 < G.order() holds ((MCS:CSeq(G)).(n+1))`1 = ((MCS:CSeq(G)).n)`1 +* (
MCS:PickUnnumbered((MCS:CSeq(G)).n) .--> (G.order()-'(card (dom ((MCS:CSeq(G)).
  n)`1))));

theorem 
  for G being finite _Graph, n being Nat st n <= G.order() holds
  card dom ((MCS:CSeq(G)).n)`1 = n;

theorem 
  for G being finite _Graph, n being Nat st G.order() <= n holds (
  MCS:CSeq(G)).(G.order()) = (MCS:CSeq(G)).n;

theorem 
  for G being finite _Graph, m,n being Nat st G.order() <= m & m
  <= n holds (MCS:CSeq(G)).m = (MCS:CSeq(G)).n;

theorem 
  for G being finite _Graph holds MCS:CSeq(G) is eventually-constant;

registration
  let G be finite _Graph;
  cluster MCS:CSeq(G) -> eventually-constant;
end;

theorem 
  for G being finite _Graph, n being Nat holds dom ((MCS:CSeq(G)).
  n)`1 = the_Vertices_of G iff G.order() <= n;

theorem 
  for G being finite _Graph holds (MCS:CSeq(G)).Lifespan() = G .order();

theorem 
  for G being finite _Graph holds (MCS:CSeq(G))``1 is eventually-constant;

theorem 
  for G being finite _Graph holds (MCS:CSeq(G))``1.Lifespan() = (
  MCS:CSeq(G)).Lifespan();

theorem 
  for G being finite _Graph holds MCS:CSeq(G)``1 is vertex-numbering;

registration
  let G be finite _Graph;
  cluster (MCS:CSeq(G))``1 -> vertex-numbering;
end;

theorem 
  for G being finite _Graph, n being Nat st n < G.order() holds ((
  MCS:CSeq(G))``1).PickedAt(n) = MCS:PickUnnumbered((MCS:CSeq(G)).n);

theorem 
  for G being finite _Graph, n being Nat st n < G.order() ex w
being Vertex of G st w = MCS:PickUnnumbered((MCS:CSeq(G)).n) & for v being set
holds (v in G.AdjacentSet({w}) & not v in dom (((MCS:CSeq(G)).n)`1) implies (((
  MCS:CSeq(G)).(n+1))`2).v = (((MCS:CSeq(G)).n)`2).v + 1) & (not v in G
.AdjacentSet({w}) or v in dom (((MCS:CSeq(G)).n)`1) implies (((MCS:CSeq(G)).(n+
  1))`2).v = (((MCS:CSeq(G)).n)`2).v);

theorem 
  for G being finite _Graph, n being Nat, x being set st not x in
dom ((MCS:CSeq(G)).n)`1 holds (((MCS:CSeq(G)).n)`2).x = card (G.AdjacentSet({x}
  ) /\ (dom ((MCS:CSeq(G)).n)`1));

definition
  let G be _Graph, F be PartFunc of the_Vertices_of G, NAT;
  attr F is with_property_T means


  for a,b,c being Vertex of G st a in
  dom F & b in dom F & c in dom F & F.a < F.b & F.b < F.c & a,c are_adjacent &
  not b,c are_adjacent ex d being Vertex of G st d in dom F & F.b < F.d & b,d
  are_adjacent & not a,d are_adjacent;
end;

theorem 
  for G being finite _Graph, n being Nat holds ((MCS:CSeq(G)).n)`1 is
  with_property_T;

theorem 
  for G being finite _Graph holds ((LexBFS:CSeq(G)).Result())`1 is
  with_property_T;

theorem 
  for G being finite chordal _Graph, L being PartFunc of the_Vertices_of
  G, NAT st L is with_property_T & dom L = the_Vertices_of G for V being
  VertexScheme of G st V" = L holds V is perfect;















begin 

reserve a,b,c,d,e,x for real number,
  A for non empty closed_interval Subset of REAL,
  f,g for PartFunc of REAL,REAL;

theorem 
  a <= b & c <= d & a+c = b+d implies a = b & c = d;

theorem 
  a <= b implies ].x-a,x+a.[ c= ].x-b,x+b.[;

theorem 
  for R be Relation, A,B,C be set st A c= B & A c= C holds (R|B)|A
  = (R|C)|A;

theorem 
  for A,B,C be set st A c= B & A c= C holds chi(B,B)|A = chi(C,C)|A;

theorem 
  a <= b implies vol([' a,b '])=b-a;

theorem 
  vol([' min(a,b),max(a,b) ']) = abs(b-a);

begin

theorem 
  A c= dom f & f is_integrable_on A & f|A is bounded implies abs f
  is_integrable_on A & abs(integral(f,A)) <= integral(abs f,A);

theorem 
  a<=b & [' a,b '] c= dom f & f is_integrable_on [' a,b '] & f|[' a
  ,b '] is bounded implies abs(integral(f,a,b)) <=integral(abs f,a,b);

theorem 
  for r be Real st A c= dom f & f is_integrable_on A & f|A is
  bounded holds r(#)f is_integrable_on A & integral(r(#)f,A)=r*integral(f,A);

theorem 
  a<=b & [' a,b '] c= dom f & f is_integrable_on [' a,b '] & f|['
  a,b '] is bounded implies integral(c(#)f,a,b) =c*integral(f,a,b);

theorem 
  A c= dom f & A c= dom g & f is_integrable_on A & f|A is bounded
  & g is_integrable_on A & g|A is bounded implies f+g is_integrable_on A & f-g
is_integrable_on A & integral(f+g,A) = integral(f,A) + integral(g,A) & integral
  (f-g,A) = integral(f,A) - integral(g,A);

theorem 
  a<=b & [' a,b '] c= dom f & [' a,b '] c= dom g & f
  is_integrable_on [' a,b '] & g is_integrable_on [' a,b '] & f|[' a,b '] is
  bounded & g|[' a,b '] is bounded implies integral(f+g,a,b) =integral(f,a,b) +
  integral(g,a,b) & integral(f-g,a,b) =integral(f,a,b) - integral(g,a,b);

theorem 
  f|A is bounded & g|A is bounded implies (f(#)g)|A is bounded;

theorem 
  A c= dom f & A c= dom g & f is_integrable_on A & f|A is bounded & g
  is_integrable_on A & g|A is bounded implies f(#)g is_integrable_on A;

theorem 
  for n be Element of NAT st n > 0 & vol A > 0 holds ex D being
  Division of A st len D = n & for i be Element of NAT st i in dom D holds D.i=
  lower_bound A + vol(A)/n*i;

begin 

theorem 
  vol A > 0 implies ex T being DivSequence of A st delta T is
  convergent & lim delta T = 0 & for n be Element of NAT holds ex Tn being
  Division of A st Tn divide_into_equal n+1 & T.n =Tn;

theorem 
  a <= b & f is_integrable_on [' a,b '] & f|[' a,b '] is bounded &
  [' a,b '] c= dom f & c in [' a,b '] implies f is_integrable_on ['a,c '] & f
  is_integrable_on ['c,b '] & integral(f,a,b )=integral(f,a,c )+integral(f,c,b)
;

theorem 
  a <= c & c <= d & d <= b & f is_integrable_on [' a,b '] & f|[' a
,b '] is bounded & [' a,b '] c= dom f implies f is_integrable_on ['c,d '] & f|
  [' c,d '] is bounded & ['c,d '] c= dom f;

theorem 
  a <= c & c <= d & d <= b & f is_integrable_on [' a,b '] & g
is_integrable_on [' a,b '] & f|[' a,b '] is bounded & g|[' a,b '] is bounded &
[' a,b '] c= dom f & [' a,b '] c= dom g implies f+g is_integrable_on ['c,d '] &
  (f+g)|[' c,d '] is bounded;

theorem 
  a<=b & f is_integrable_on [' a,b '] & f|[' a,b '] is bounded &
  [' a,b '] c= dom f & c in [' a,b '] & d in [' a,b '] implies integral(f,a,d)=
  integral(f,a,c)+integral(f,c,d);

theorem 
  a <= b & f is_integrable_on [' a,b '] & f|[' a,b '] is bounded &
[' a,b '] c= dom f & c in [' a,b '] & d in [' a,b '] implies [' min(c,d),max(c,
d) '] c= dom (abs f) & abs f is_integrable_on [' min(c,d),max(c,d) '] & abs f|
[' min(c,d),max(c,d) '] is bounded & abs integral(f,c,d) <= integral(abs f,min(
  c,d),max(c,d));

theorem 
  a <= b & c <= d & f is_integrable_on [' a,b '] & f|[' a,b '] is
  bounded & [' a,b '] c= dom f & c in [' a,b '] & d in [' a,b '] implies [' c,d
  '] c= dom (abs f) & abs f is_integrable_on [' c,d '] & abs f|[' c,d '] is
  bounded & abs integral(f,c,d) <= integral(abs f,c,d) & abs integral(f,d,c) <=
  integral(abs f,c,d);

theorem 
  ( a<=b & c <= d & f is_integrable_on [' a,b '] & f|[' a,b '] is
bounded & [' a,b '] c= dom f & c in [' a,b '] & d in [' a,b '] & for x be real
number st x in [' c,d '] holds abs(f.x) <= e ) implies abs integral(f,c,d) <= e
  * (d-c) & abs integral(f,d,c) <= e * (d-c);

theorem 
  a <= b & f is_integrable_on [' a,b '] & g is_integrable_on [' a,
  b '] & f|[' a,b '] is bounded & g|[' a,b '] is bounded & [' a,b '] c= dom f &
[' a,b '] c= dom g & c in ['a,b '] & d in ['a,b '] implies integral(f+g,c,d) =
  integral(f,c,d) + integral(g,c,d) & integral(f-g,c,d) = integral(f,c,d) -
  integral(g,c,d);

theorem 
  a <= b & f is_integrable_on [' a,b '] & f|[' a,b '] is bounded & [' a,
  b '] c= dom f & c in ['a,b '] & d in ['a,b '] implies integral(e(#)f,c,d)=e*
  integral(f,c,d);

theorem 
  ( a <= b & [' a,b '] c= dom f & for x be real number st x in ['
  a,b '] holds f.x=e ) implies f is_integrable_on [' a,b '] & f|[' a,b '] is
  bounded & integral(f,a,b) = e*(b-a);

theorem 
  a <= b & (for x be real number st x in [' a,b '] holds f.x=e) &
[' a,b '] c= dom f & c in ['a,b '] & d in ['a,b '] implies integral(f,c,d) = e*
  (d-c);

begin 

theorem 
  for x0 be real number, F be PartFunc of REAL,REAL st a <= b & f
is_integrable_on [' a,b '] & f|[' a,b '] is bounded & [' a,b '] c= dom f & ].a,
b.[ c= dom F & (for x be real number st x in ].a,b.[ holds F.x = integral(f,a,x
  )) & x0 in ].a,b.[ & f is_continuous_in x0 holds F is_differentiable_in x0 &
  diff(F,x0)=f.x0;

theorem 
  for x0 be real number st a <= b & f is_integrable_on [' a,b '] & f|['
a,b '] is bounded & [' a,b '] c= dom f & x0 in ].a,b.[ & f is_continuous_in x0
holds ex F be PartFunc of REAL,REAL st ].a,b.[ c= dom F & (for x be real number
st x in ].a,b.[ holds F.x = integral(f,a,x)) & F is_differentiable_in x0 & diff
  (F,x0)=f.x0;














begin 

theorem 
  for X be non empty MetrSpace, Y be SetSequence of X st X is complete &
  union rng Y = the carrier of X & for n be Element of NAT holds (Y.n)` in
Family_open_set X holds ex n0 be Element of NAT, r be Real, x0 be Point of X st
  0 < r & Ball(x0,r) c= Y.n0;

begin 

reserve X for RealNormSpace;

definition
  let X be RealNormSpace;
  func distance_by_norm_of X -> Function of [:the carrier of X,the carrier of
  X:],REAL means


  for x, y be Point of X holds it.(x,y) = ||.x-y.||;
end;

definition
  let X be RealNormSpace;
  func MetricSpaceNorm X -> non empty MetrSpace equals

  MetrStruct(# the
    carrier of X,distance_by_norm_of X #);
end;

theorem 
  for X be RealNormSpace, z be Element of MetricSpaceNorm X, r be
real number holds ex x be Point of X st x = z & Ball(z,r) = {y where y is Point
  of X:||.x-y.|| < r};

theorem 
  for X be RealNormSpace, z be Element of MetricSpaceNorm X, r be
  real number holds ex x be Point of X st x = z & cl_Ball(z,r) = {y where y is
  Point of X: ||.x-y.|| <= r};

theorem 
  for X be RealNormSpace, S be sequence of X, St be sequence of
MetricSpaceNorm X, x be Point of X, xt be Point of MetricSpaceNorm X st S = St
  & x = xt holds St is_convergent_in_metrspace_to xt iff for r be Real st 0 < r
  ex m be Element of NAT st for n be Element of NAT st m <= n holds ||. S.n - x
  .|| < r;

theorem 
  for X be RealNormSpace, S be sequence of X, St be sequence of
  MetricSpaceNorm X st S = St holds St is convergent iff S is convergent;

theorem 
  for X be RealNormSpace, S be sequence of X, St be sequence of
  MetricSpaceNorm X st S = St & St is convergent holds lim St = lim S;

begin 

definition
  let X be RealNormSpace;
  func TopSpaceNorm X -> non empty TopSpace equals

  TopSpaceMetr
  MetricSpaceNorm X;
end;

theorem 
  for X be RealNormSpace, V be Subset of TopSpaceNorm X holds V is
  open iff for x be Point of X st x in V holds ex r be Real st r>0 & {y where y
  is Point of X: ||.x-y.|| < r} c= V;

theorem 
  for X be RealNormSpace, x be Point of X, r be Real holds {y where
  y is Point of X:||.x-y.|| < r} is open Subset of TopSpaceNorm X;

theorem 
  for X be RealNormSpace, x be Point of X, r be Real holds {y where y is
  Point of X: ||.x-y.|| <= r} is closed Subset of TopSpaceNorm X;


theorem 
  for X be Hausdorff non empty TopSpace st X is locally-compact holds X
  is Baire;

theorem 
  for X be RealNormSpace holds TopSpaceNorm(X) is sequential;

registration
  let X be RealNormSpace;
  cluster TopSpaceNorm(X) -> sequential;
end;

theorem 
  for X be RealNormSpace, S be sequence of X, St be sequence of
TopSpaceNorm X, x be Point of X, xt be Point of TopSpaceNorm X st S = St & x =
  xt holds St is_convergent_to xt iff for r be Real st 0 < r ex m be Element of
  NAT st for n be Element of NAT st m <= n holds ||. S.n - x.|| < r;

theorem 
  for X be RealNormSpace, S be sequence of X, St be sequence of
  TopSpaceNorm X st S = St holds St is convergent iff S is convergent;

theorem 
  for X be RealNormSpace, S be sequence of X, St be sequence of
TopSpaceNorm X st S = St & St is convergent holds Lim St = {lim S} & lim St=lim
  S;

theorem 
  for X be RealNormSpace, V be Subset of X, Vt be Subset of
  TopSpaceNorm X st V = Vt holds V is closed iff Vt is closed;

theorem 
  for X be RealNormSpace, V be Subset of X, Vt be Subset of
  TopSpaceNorm X st V = Vt holds V is open iff Vt is open;

theorem 
  for X be RealNormSpace, U be Subset of X, Ut be Subset of
TopSpaceNorm X, x be Point of X, xt be Point of TopSpaceNorm X st U = Ut & x =
  xt holds U is Neighbourhood of x iff Ut is a_neighborhood of xt;

theorem 
  for X,Y be RealNormSpace, f be PartFunc of X,Y, ft be Function
of TopSpaceNorm X,TopSpaceNorm Y, x be Point of X, xt be Point of TopSpaceNorm
  X st f = ft & x = xt holds f is_continuous_in x iff ft is_continuous_at xt;

theorem 
  for X,Y be RealNormSpace, f be PartFunc of X,Y, ft be Function of
TopSpaceNorm X,TopSpaceNorm Y st f = ft holds f is_continuous_on the carrier of
  X iff ft is continuous;

begin 

definition
  let X be RealNormSpace;
  func LinearTopSpaceNorm X -> strict non empty RLTopStruct means


  the
carrier of it = the carrier of X & 0.it = 0.X & the addF of it = the addF of X
  & the Mult of it = the Mult of X & the topology of it = the topology of
  TopSpaceNorm X;
end;

registration
  let X be RealNormSpace;
  cluster LinearTopSpaceNorm X -> add-continuous Mult-continuous TopSpace-like
Abelian add-associative right_zeroed right_complementable vector-distributive
scalar-distributive scalar-associative scalar-unital;
end;

theorem 
  for X be RealNormSpace, V be Subset of TopSpaceNorm X, Vt be
  Subset of LinearTopSpaceNorm X st V=Vt holds V is open iff Vt is open;

theorem 
  for X be RealNormSpace, V be Subset of TopSpaceNorm X, Vt be
  Subset of LinearTopSpaceNorm X st V=Vt holds V is closed iff Vt is closed;

theorem 
  for X be RealNormSpace, V be Subset of LinearTopSpaceNorm X holds V is
  open iff for x be Point of X st x in V holds ex r be Real st r>0 & {y where y
  is Point of X:||.x-y.|| < r} c= V;

theorem 
  for X be RealNormSpace, x be Point of X, r be Real, V be Subset of
LinearTopSpaceNorm X st V = {y where y is Point of X:||.x-y.|| < r} holds V is
  open;

theorem 
  for X be RealNormSpace, x be Point of X, r be Real, V be Subset of
  TopSpaceNorm X st V = {y where y is Point of X:||.x-y.|| <= r} holds V is
  closed;

registration
  let X be RealNormSpace;
  cluster LinearTopSpaceNorm X -> T_2;
  cluster LinearTopSpaceNorm X -> sober;
end;

theorem 
  for X be RealNormSpace, S be Subset-Family of TopSpaceNorm X, St
  be Subset-Family of LinearTopSpaceNorm X, x be Point of TopSpaceNorm X, xt be
  Point of LinearTopSpaceNorm X st S=St & x=xt holds St is Basis of xt iff S is
  Basis of x;

registration
  let X be RealNormSpace;
  cluster LinearTopSpaceNorm X -> first-countable;
  cluster LinearTopSpaceNorm X -> Frechet;
  cluster LinearTopSpaceNorm X -> sequential;
end;

theorem 
  for X be RealNormSpace, S be sequence of TopSpaceNorm X, St be
sequence of LinearTopSpaceNorm X, x be Point of TopSpaceNorm X, xt be Point of
  LinearTopSpaceNorm X st S=St & x=xt holds St is_convergent_to xt iff S
  is_convergent_to x;

theorem 
  for X be RealNormSpace, S be sequence of TopSpaceNorm X, St be
  sequence of LinearTopSpaceNorm X st S=St holds St is convergent iff S is
  convergent;

theorem 
  for X be RealNormSpace, S be sequence of TopSpaceNorm X, St be
  sequence of LinearTopSpaceNorm X st S=St & St is convergent holds Lim S = Lim
  St & lim S = lim St;

theorem 
  for X be RealNormSpace, S be sequence of X, St be sequence of
LinearTopSpaceNorm X, x be Point of X, xt be Point of LinearTopSpaceNorm X st S
  =St & x=xt holds St is_convergent_to xt iff for r be Real st 0 < r ex m be
  Element of NAT st for n be Element of NAT st m <= n holds ||.(S.n) - x.|| < r
;

theorem 
  for X be RealNormSpace, S be sequence of X, St be sequence of
  LinearTopSpaceNorm X st S=St holds St is convergent iff S is convergent;

theorem 
  for X be RealNormSpace, S be sequence of X, St be sequence of
LinearTopSpaceNorm X st S=St & St is convergent holds Lim St = {lim S} & lim St
  =lim S;

theorem 
  for X be RealNormSpace, V be Subset of X, Vt be Subset of
  LinearTopSpaceNorm X st V=Vt holds V is closed iff Vt is closed;

theorem 
  for X be RealNormSpace, V be Subset of X, Vt be Subset of
  LinearTopSpaceNorm X st V=Vt holds V is open iff Vt is open;

theorem 
  for X be RealNormSpace, U be Subset of TopSpaceNorm X, Ut be
  Subset of LinearTopSpaceNorm X, x be Point of TopSpaceNorm X, xt be Point of
  LinearTopSpaceNorm X st U=Ut & x=xt holds U is a_neighborhood of x iff Ut is
  a_neighborhood of xt;

theorem 
  for X,Y be RealNormSpace, f be Function of TopSpaceNorm X,
TopSpaceNorm Y, ft be Function of LinearTopSpaceNorm X,LinearTopSpaceNorm Y, x
be Point of TopSpaceNorm X, xt be Point of LinearTopSpaceNorm X st f=ft & x=xt
  holds f is_continuous_at x iff ft is_continuous_at xt;

theorem 
  for X,Y be RealNormSpace, f be Function of TopSpaceNorm X,TopSpaceNorm
Y, ft be Function of LinearTopSpaceNorm X,LinearTopSpaceNorm Y st f=ft holds f
  is continuous iff ft is continuous;














begin 

definition
  struct (1-sorted) BCIStr (# carrier -> set, InternalDiff -> BinOp of the
    carrier #);
end;

registration
  cluster non empty strict for BCIStr;
end;

definition
  let A be BCIStr;
  let x,y be Element of A;
  func x \ y -> Element of A equals

  (the InternalDiff of A).(x,y);
end;

definition
  struct (BCIStr,ZeroStr) BCIStr_0 (# carrier -> set, InternalDiff -> BinOp of
    the carrier, ZeroF -> Element of the carrier #);
end;

registration
  cluster non empty strict for BCIStr_0;
end;

definition
  let IT be non empty BCIStr_0, x be Element of IT;
  func x` -> Element of IT equals

  0.IT\x;
end;

definition
  let IT be non empty BCIStr_0;
  attr IT is being_B means


  for x,y,z being Element of IT holds ((x\y)\( z\y))\(x\z)=0.IT;
  attr IT is being_C means


  for x,y,z being Element of IT holds ((x\y)\z )\((x\z)\y)=0.IT;
  attr IT is being_I means


  for x being Element of IT holds x\x=0.IT;
  attr IT is being_K means


  for x,y being Element of IT holds (x\y)\x=0. IT;
  attr IT is being_BCI-4 means


  for x,y being Element of IT holds (x\y= 0.IT&y\x=0.IT implies x = y);
  attr IT is being_BCK-5 means


  for x being Element of IT holds x`=0.IT;
end;

definition
  func BCI-EXAMPLE -> BCIStr_0 equals

  BCIStr_0 (# 1, op2, op0 #);
end;

registration
  cluster BCI-EXAMPLE -> strict 1-element;
end;

registration
  cluster BCI-EXAMPLE -> being_B being_C being_I being_BCI-4 being_BCK-5;
end;

registration
  cluster strict being_B being_C being_I being_BCI-4 being_BCK-5 for non empty
    BCIStr_0;
end;

definition
  mode BCI-algebra is being_B being_C being_I being_BCI-4 non empty BCIStr_0;
end;

definition
  mode BCK-algebra is being_BCK-5 BCI-algebra;
end;

definition
  let X be BCI-algebra;
  mode SubAlgebra of X -> BCI-algebra means


    0.it = 0.X & the carrier
of it c= the carrier of X & the InternalDiff of it = (the InternalDiff of X)||
    the carrier of it;
end;



theorem 
  for X being non empty BCIStr_0 holds (X is BCI-algebra iff (X is
being_I & X is being_BCI-4 &for x,y,z being Element of X holds ((x\y)\(x\z))\(z
  \y)=0.X & (x\(x\y))\y = 0.X ));

definition
  let IT be non empty BCIStr_0;
  let x,y be Element of IT;
  pred x <= y means


  x \ y = 0.IT;
end;

reserve X for BCI-algebra;
reserve x,y,z,u,a,b for Element of X;
reserve IT for non empty Subset of X;

theorem 
  x \ 0.X = x;

theorem 
  x\y=0.X & y\z=0.X implies x\z=0.X;

theorem 
  x\y=0.X implies (x\z)\(y\z)=0.X & (z\y)\(z\x)=0.X;

theorem 
  x <= y implies x\z <= y\z & z\y <= z\x;

theorem 
  x\y=0.X implies (y\x)` = 0.X;

theorem 
  (x\y)\z = (x\z)\y;

theorem 
  x\(x\(x\y)) = x\y;

theorem 
  (x\y)` = x`\y`;

theorem 
  ((x\(x\y))\(y\x))\(x\(x\(y\(y\x))))=0.X;

theorem 
  for X being non empty BCIStr_0 holds (X is BCI-algebra iff (X is
being_BCI-4 & for x,y,z being Element of X holds ((x\y)\(x\z))\(z\y)=0.X & x\0.
  X = x ));

theorem 
  (for X being BCI-algebra,x,y being Element of X holds x\(x\y)=y\(y\x))
  implies X is BCK-algebra;

theorem 
  (for X being BCI-algebra,x,y being Element of X holds (x\y)\y=x\y)
  implies X is BCK-algebra;

theorem 
  (for X being BCI-algebra,x,y being Element of X holds x\(y\x)=x)
  implies X is BCK-algebra;

theorem 
  (for X being BCI-algebra,x,y,z being Element of X holds (x\y)\y=(x\z)\
  (y\z) ) implies X is BCK-algebra;

theorem 
  (for X being BCI-algebra,x,y being Element of X holds (x\y)\(y\x)=x\y)
  implies X is BCK-algebra;

theorem 
  (for X being BCI-algebra,x,y being Element of X holds (x\y)\((x\y)\(y\
  x))=0.X) implies X is BCK-algebra;

theorem 
  for X being BCI-algebra holds X is being_K iff X is BCK-algebra;

definition
  let X be BCI-algebra; 
  func BCK-part(X) -> non empty Subset of X equals

  {x where x is Element of X:
  0.X<=x};
end;

theorem 
  0.X in BCK-part(X);

theorem 
  for x,y being Element of BCK-part(X) holds x\y in BCK-part(X);

theorem 
  for x being Element of X,y being Element of BCK-part(X) holds x\y <= x;

theorem 
  X is SubAlgebra of X;

definition
  let X be BCI-algebra,IT be SubAlgebra of X;
  attr IT is proper means


  IT <> X;
end;

registration
  let X;
  cluster non proper for SubAlgebra of X;
end;

definition
  let X be BCI-algebra,IT be Element of X;
  attr IT is atom means


  for z being Element of X holds z\IT=0.X implies z=IT;
end;

definition
  let X be BCI-algebra;
  func AtomSet(X) -> non empty Subset of X equals

  {x where x is Element of X:x
  is atom};
end;

theorem 
  0.X in AtomSet(X);

theorem 
  for x being Element of X holds x in AtomSet(X) iff for z being
  Element of X holds z\(z\x)=x;

theorem 
  for x being Element of X holds x in AtomSet(X) iff for u,z being
  Element of X holds (z\u)\(z\x)=x\u;

theorem 
  for x being Element of X holds x in AtomSet(X) iff for y,z being
  Element of X holds x\(z\y)<=y\(z\x);

theorem 
  for x being Element of X holds x in AtomSet(X) iff for y,z,u being
  Element of X holds (x\u)\(z\y)<=(y\u)\(z\x);

theorem 
  for x being Element of X holds x in AtomSet(X) iff for z being
  Element of X holds z`\x`=x\z;

theorem 
  for x being Element of X holds x in AtomSet(X) iff x``=x;

theorem 
  for x being Element of X holds x in AtomSet(X) iff for z being
  Element of X holds (z\x)`=x\z;

theorem 
  for x being Element of X holds x in AtomSet(X) iff for z being
  Element of X holds ((x\z)`)`=x\z;

theorem 
  for x being Element of X holds x in AtomSet(X) iff for z,u being
  Element of X holds z\(z\(x\u))=x\u;

theorem 
  for a being Element of AtomSet(X),x being Element of X holds a\x
  in AtomSet(X);

definition
  let X be BCI-algebra,a,b be Element of AtomSet(X);
  redefine func a\b -> Element of AtomSet(X);
end;

theorem 
  for x being Element of X holds x` in AtomSet(X);

theorem 
  for x being Element of X holds ex a being Element of AtomSet(X) st a<=x;

definition
  let X be BCI-algebra;
  attr X is generated_by_atom means


  for x being Element of X holds ex a being Element of AtomSet(X) st a<=x;
end;

definition
  let X be BCI-algebra,a be Element of AtomSet(X);
  func BranchV(a) -> non empty Subset of X equals

  {x where x is Element of X:a
  <=x};
end;

theorem 
  for X being BCI-algebra holds X is generated_by_atom;

theorem 
  for a,b being Element of AtomSet(X),x being Element of BranchV(b)
  holds a\x =a\b;

theorem 
  for a being Element of AtomSet(X),x being Element of BCK-part(X) holds a\x =a
;

theorem 
  for a,b being Element of AtomSet(X),x being Element of BranchV(a
  ), y being Element of BranchV(b) holds x\y in BranchV(a\b);

theorem 
  for a being Element of AtomSet(X),x,y being Element of BranchV(a)
  holds x\y in BCK-part(X);

theorem 
  for a,b being Element of AtomSet(X),x being Element of BranchV(a), y
  being Element of BranchV(b) st a<>b holds not x\y in BCK-part(X);

theorem 
  for a,b being Element of AtomSet(X) st a<>b holds BranchV(a) /\
  BranchV(b) = {};



definition
  let X be BCI-algebra;
  mode Ideal of X -> non empty Subset of X means


    0.X in it & for x,y
    being Element of X st x\y in it & y in it holds x in it;
end;

definition
  let X be BCI-algebra, IT be Ideal of X;
  attr IT is closed means


  for x being Element of IT holds x` in IT;
end;

registration
  let X;
  cluster closed for Ideal of X;
end;

theorem 
  {0.X} is closed Ideal of X;

theorem 
  the carrier of X is closed Ideal of X;

theorem 
  BCK-part(X) is closed Ideal of X;

theorem 
  IT is Ideal of X implies for x,y being Element of X st x in IT & y<=x
  holds y in IT;

begin 

definition
  let IT be BCI-algebra;
  attr IT is associative means


  for x,y,z being Element of IT holds x\y \z = x\(y\z);
  attr IT is quasi-associative means


  for x being Element of IT holds x ``=x`;
  attr IT is positive-implicative means


  for x,y being Element of IT holds (x\(x\y))\(y\x)=x\(x\(y\(y\x)));
  attr IT is weakly-positive-implicative means


  for x,y,z being Element of IT holds (x\y)\z=((x\z)\z)\(y\z);
  attr IT is implicative means


  for x,y being Element of IT holds (x\(x \y))\(y\x)=y\(y\x);
  attr IT is weakly-implicative means

  for x,y being Element of IT holds (x\(y\ x))\(y\x)`=x;
  attr IT is p-Semisimple means


  for x,y being Element of IT holds x\(x \y) = y;
  attr IT is alternative means


  for x,y being Element of IT holds x\(x\ y) = (x\x)\y & (x\y)\y=x\(y\y);
end;

registration
  cluster BCI-EXAMPLE -> implicative positive-implicative p-Semisimple
    associative weakly-implicative weakly-positive-implicative;
end;

registration
  cluster implicative positive-implicative p-Semisimple associative
    weakly-implicative weakly-positive-implicative for BCI-algebra;
end;

theorem 
  X is associative iff for x being Element of X holds x`=x;

theorem 
  (for x,y being Element of X holds y\x=x\y) iff X is associative;

theorem 
  for X being non empty BCIStr_0 holds (X is associative
BCI-algebra iff for x,y,z being Element of X holds (y\x)\(z\x)=z\y & x\0.X=x );

theorem 
  for X being non empty BCIStr_0 holds (X is associative
  BCI-algebra iff for x,y,z being Element of X holds (x\y)\(x\z)=z\y & x`=x );

theorem 
  for X being non empty BCIStr_0 holds (X is associative BCI-algebra iff
  for x,y,z being Element of X holds (x\y)\(x\z)=y\z & x\0.X=x );

begin 

theorem 
  X is p-Semisimple iff for x being Element of X holds x is atom;

theorem 
  X is p-Semisimple implies BCK-part(X)={0.X};

theorem 
  X is p-Semisimple iff for x being Element of X holds x`` = x;

theorem 
  X is p-Semisimple iff for x,y holds y\(y\x) = x;

theorem 
  X is p-Semisimple iff for x,y,z holds (z\y)\(z\x) = x\y;

theorem 
  X is p-Semisimple iff for x,y,z holds x\(z\y) = y\(z\x);

theorem 
  X is p-Semisimple iff for x,y,z,u holds (x\u)\(z\y) = (y\u)\(z\x);

theorem 
  X is p-Semisimple iff for x,z holds z`\x` = x\z;

theorem 
  X is p-Semisimple iff for x,z holds (x\z)`` = x\z;

theorem 
  X is p-Semisimple iff for x,u,z holds z\(z\(x\u)) = x\u;

theorem 
  X is p-Semisimple iff for x st x`=0.X holds x=0.X;

theorem 
  X is p-Semisimple iff for x,y holds x\y`=y\x`;

theorem 
  X is p-Semisimple iff for x,y,z,u holds (x\y)\(z\u)=(x\z)\(y\u);

theorem 
  X is p-Semisimple iff for x,y,z holds (x\y)\(z\y)=x\z;

theorem 
  X is p-Semisimple iff for x,y,z holds x\(y\z)=(z\y)\x`;

theorem 
  X is p-Semisimple iff for x,y,z st y\x=z\x holds y=z;

theorem 
  X is p-Semisimple iff for x,y,z st x\y=x\z holds y=z;

theorem 
  for X being non empty BCIStr_0 holds (X is p-Semisimple BCI-algebra
  iff for x,y,z being Element of X holds (x\y)\(x\z)=z\y & x\0.X=x );

theorem 
  for X being non empty BCIStr_0 holds (X is p-Semisimple BCI-algebra
iff (X is being_I &for x,y,z being Element of X holds x\(y\z)=z\(y\x) & x\0.X=x
  ));

begin

theorem 
  X is quasi-associative iff for x being Element of X holds x`<=x;

theorem 
  X is quasi-associative iff for x,y being Element of X holds (x\y )`=(y\x)`;

theorem 
  X is quasi-associative iff for x,y being Element of X holds x`\y =(x\y)`;

theorem 
  X is quasi-associative iff for x,y being Element of X holds (x\y)\(y\x
  ) in BCK-part(X);

theorem 
  X is quasi-associative iff for x,y,z being Element of X holds (x\y)\z
  <=x\(y\z);

begin 

theorem 
  X is alternative implies x` = x & x\(x\y) = y & (x\y)\y = x;

theorem 
  X is alternative & x\a=x\b implies a=b;

theorem 
  X is alternative & a\x=b\x implies a=b;

theorem 
  X is alternative & x\y=0.X implies x=y;

theorem 
  X is alternative & (x\a)\b = 0.X implies a=x\b & b=x\a;

registration
  cluster alternative -> associative for BCI-algebra;
  cluster associative -> alternative for BCI-algebra;
  cluster alternative -> implicative for BCI-algebra;
end;

theorem 
  X is alternative implies (x\(x\y))\(y\x) = x;

theorem 
  X is alternative implies y\(y\(x\(x\y))) = y;

begin

registration
  cluster associative -> weakly-positive-implicative for BCI-algebra;
  cluster p-Semisimple -> weakly-positive-implicative for BCI-algebra;
end;

theorem 
  for X being non empty BCIStr_0 holds (X is implicative BCI-algebra iff
for x,y,z being Element of X holds ((x\y)\(x\z))\(z\y)=0.X & x\0.X=x &(x\(x\y))
  \(y\x)=y\(y\x) );

theorem 
  X is weakly-positive-implicative iff for x,y being Element of X
  holds x\y=((x\y)\y)\y`;

registration
  cluster positive-implicative -> weakly-positive-implicative for BCI-algebra;
  cluster alternative -> weakly-positive-implicative for BCI-algebra;
end;

theorem 
  X is weakly-positive-implicative BCI-algebra implies for x,y being
  Element of X holds (x\(x\y))\(y\x)=((y\(y\x))\(y\x))\(x\y);

theorem 
  for X being non empty BCIStr_0 holds (X is positive-implicative
BCI-algebra iff for x,y,z being Element of X holds ((x\y)\(x\z))\(z\y)=0.X & x\
  0.X=x & x\y=((x\y)\y)\y` & (x\(x\y))\(y\x)=((y\(y\x))\(y\x))\(x\y) );














begin

reserve E, x, y, X for set;
reserve A, B, C, D for Subset of E^omega;
reserve a, a1, a2, b, c, c1, c2, d, ab, bc for Element of E^omega;
reserve e for Element of E;
reserve i, j, k, l, n, n1, n2, m for Nat;



definition
  let E, a, b;
  redefine func a ^ b -> Element of E^omega;
end;

definition
  let E;
  redefine func <%>E -> Element of E^omega;
end;

definition
  let E be non empty set;
  let e be Element of E;
  redefine func <%e%> -> Element of E^omega;
end;

definition
  let E, a;
  redefine func {a} -> Subset of E^omega;
end;

definition
  let E;
  let f be Function of NAT, bool E;
  let n;
  redefine func f.n -> Subset of E;
end;



theorem 
  n1 > n or n2 > n implies n1 + n2 > n;

theorem 
  n1 + n <= n2 + 1 & n > 0 implies n1 <= n2;

theorem 
  n1 + n2 = 1 iff n1 = 1 & n2 = 0 or n1 = 0 & n2 = 1;



theorem 
  a ^ b = <%x%> iff a = <%>E & b = <%x%> or b = <%>E & a = <%x%>;

theorem 
  for p, q being XFinSequence holds a = p ^ q implies p is Element
  of E^omega & q is Element of E^omega;

theorem 
  <%x%> is Element of E^omega implies x in E;

theorem 
  len b = n + 1 implies ex c, e st len c = n & b = c ^ <%e%>;

theorem 
  for p being XFinSequence st p <> {} ex q being XFinSequence, x st
  p = <%x%> ^ q;

theorem 
  len b = n + 1 implies ex c, e st len c = n & b = <%e%> ^ c;

theorem 
  len b = n + m implies ex c1, c2 st len c1 = n & len c2 = m & b = c1 ^ c2;

theorem 
  a ^ a = a implies a = {};

begin




definition
  let E, A, B;
  func A ^^ B -> Subset of E^omega means


  x in it iff ex a, b st a in A & b in B & x = a ^ b;
end;




theorem 
  A ^^ B = {} iff A = {} or B = {};

theorem 
  A ^^ {<%>E} = A & {<%>E} ^^ A = A;

theorem 
  A ^^ B = {<%>E} iff A = {<%>E} & B = {<%>E};

theorem 
  <%>E in A ^^ B iff <%>E in A & <%>E in B;

theorem 
  <%>E in B implies A c= A ^^ B & A c= B ^^ A;

theorem 
  A c= C & B c= D implies A ^^ B c= C ^^ D;

theorem 
  (A ^^ B) ^^ C = A ^^ (B ^^ C);

theorem 
  A ^^ (B /\ C) c= (A ^^ B) /\ (A ^^ C) & (B /\ C) ^^ A c= (B ^^ A
  ) /\ (C ^^ A);

theorem 
  A ^^ B \/ A ^^ C = A ^^ (B \/ C) & B ^^ A \/ C ^^ A = (B \/ C) ^^ A;

theorem 
  (A ^^ B) \ (A ^^ C) c= A ^^ (B \ C) & (B ^^ A) \ (C ^^ A) c= (B \ C) ^^ A;

theorem 
  (A ^^ B) \+\ (A ^^ C) c= A ^^ (B \+\ C) & (B ^^ A) \+\ (C ^^ A) c= (B
  \+\ C) ^^ A;

begin




definition
  let E, A, n;
  func A |^ n -> Subset of E^omega means


  ex concat being Function of
NAT, bool (E^omega) st it = concat.n & concat.0 = {<%>E} & for i holds concat.(
  i + 1) = concat.i ^^ A;
end;




theorem 
  A |^ (n + 1) = (A |^ n) ^^ A;

theorem 
  A |^ 0 = {<%>E};

theorem 
  A |^ 1 = A;

theorem 
  A |^ 2 = A ^^ A;

theorem 
  A |^ n = {} iff n > 0 & A = {};

theorem 
  {<%>E} |^ n = {<%>E};

theorem 
  A |^ n = {<%>E} iff n = 0 or A = {<%>E};

theorem 
  <%>E in A implies <%>E in A |^ n;

theorem 
  <%>E in A |^ n & n > 0 implies <%>E in A;

theorem 
  (A |^ n) ^^ A = A ^^ (A |^ n);

theorem 
  A |^ (m + n) = (A |^ m) ^^ (A |^ n);

theorem 
  (A |^ m) |^ n = A |^ (m * n);

theorem 
  <%>E in A & n > 0 implies A c= A |^ n;

theorem 
  <%>E in A & m > n implies A |^ n c= A |^ m;

theorem 
  A c= B implies A |^ n c= B |^ n;

theorem 
  (A |^ n) \/ (B |^ n) c= (A \/ B) |^ n;

theorem 
  (A /\ B) |^ n c= (A |^ n) /\ (B |^ n);

theorem 
  a in C |^ m & b in C |^ n implies a ^ b in C |^ (m + n);

begin




definition
  let E, A;
  func A* -> Subset of E^omega equals

  union { B : ex n st B = A |^ n };
end;




theorem 
  x in A* iff ex n st x in A |^ n;

theorem 
  A |^ n c= A*;

theorem 
  A c= A*;

theorem 
  A ^^ A c= A*;

theorem 
  a in C* & b in C* implies a ^ b in C*;

theorem 
  A c= C* & B c= C* implies A ^^ B c= C*;

theorem 
  A* = {<%>E} iff A = {} or A = {<%>E};

theorem 
  <%>E in A*;

theorem 
  A* = {x} implies x = <%>E;

theorem 
  x in A |^ (m + 1) implies x in (A*) ^^ A & x in A ^^ (A*);

theorem 
  A |^ (m + 1) c= (A*) ^^ A & A |^ (m + 1) c= A ^^ (A*);

theorem 
  x in (A*) ^^ A or x in A ^^ (A*) implies x in A*;

theorem 
  (A*) ^^ A c= A* & A ^^ (A*) c= A*;

theorem 
  <%>E in A implies A* = (A*) ^^ A & A* = A ^^ (A*);

theorem 
  <%>E in A implies A* = (A*) ^^ (A |^ n) & A* = (A |^ n) ^^ (A*);

theorem 
  A* = {<%>E} \/ A ^^ (A*) & A* = {<%>E} \/ (A*) ^^ A;

theorem 
  A ^^ (A*) = (A*) ^^ A;

theorem 
  (A |^ n) ^^ (A*) = (A*) ^^ (A |^ n);

theorem 
  A c= B* implies A |^ n c= B*;

theorem 
  A c= B* implies A* c= B*;

theorem 
  A c= B implies A* c= B*;

theorem 
  (A*)* = A*;

theorem 
  (A*) ^^ (A*) = A*;

theorem 
  (A |^ n)* c= A*;

theorem 
  (A*) |^ n c= A*;

theorem 
  n > 0 implies (A*) |^ n = A*;

theorem 
  A c= B* implies B* = (B \/ A)*;

theorem 
  a in A* implies A* = (A \/ {a})*;

theorem 
  A* = (A \ {<%>E})*;

theorem 
  (A*) \/ (B*) c= (A \/ B)*;

theorem 
  (A /\ B)* c= (A*) /\ (B*);

theorem 
  <%x%> in A* iff <%x%> in A;

begin




definition
  let E;
  func Lex(E) -> Subset of E^omega means


  x in it iff ex e st e in E & x = <%e%>;
end;




theorem 
  a in Lex(E) |^ len a;

theorem 
  Lex(E)* = E^omega;

theorem 
  A* = E^omega implies Lex(E) c= A;














begin

reserve E, x, y, X for set;
reserve A, B, C for Subset of E^omega;
reserve a, b for Element of E^omega;

reserve i, k, l, kl, m, n, mn for Nat;



theorem 
  m + k <= i & i <= n + k implies ex mn st mn + k = i & m <= mn & mn <= n;

theorem 
  m <= n & k <= l & m + k <= i & i <= n + l implies ex mn, kl st mn
  + kl = i & m <= mn & mn <= n & k <= kl & kl <= l;

theorem 
  m < n implies ex k st m + k = n & k > 0;



theorem 
  a ^ b = a or b ^ a = a implies b = {};

begin



theorem 
  (x in A or x in B) & x <> <%>E implies A ^^ B <> {<%>E};

theorem 
  <%x%> in A ^^ B iff <%>E in A & <%x%> in B or <%x%> in A & <%>E in B;

theorem 
  x in A & x <> <%>E & n > 0 implies A |^ n <> {<%>E};

theorem 
  <%>E in A |^ n iff n = 0 or <%>E in A;

theorem 
  <%x%> in A |^ n iff <%x%> in A & ( <%>E in A & n > 1 or n = 1);

theorem 
  m <> n & A |^ m = {x} & A |^ n = {x} implies x = <%>E;

theorem 
  (A |^ m) |^ n = (A |^ n) |^ m;

theorem 
  (A |^ m) ^^ (A |^ n) = (A |^ n) ^^ (A |^ m);

theorem 
  <%>E in B implies A c= A ^^ (B |^ l) & A c= (B |^ l) ^^ A;

theorem 
  A c= C |^ k & B c= C |^ l implies A ^^ B c= C |^ (k + l);

theorem 
  x in A & x <> <%>E implies A* <> {<%>E};

theorem 
  <%>E in A & n > 0 implies (A |^ n)* = A*;

theorem 
  <%>E in A implies (A |^ n)* = (A*) |^ n;

theorem 
  A c= A ^^ (B*) & A c= (B*) ^^ A;

begin




definition
  let E, A;
  let m, n;
  func A |^ (m, n) -> Subset of E^omega equals

  union { B: ex k st m <= k & k
  <= n & B = A |^ k };
end;




theorem 
  x in A |^ (m, n) iff ex k st m <= k & k <= n & x in A |^ k;

theorem 
  m <= k & k <= n implies A |^ k c= A |^ (m, n);

theorem 
  A |^ (m, n) = {} iff m > n or m > 0 & A = {};

theorem 
  A |^ (m, m) = A |^ m;

theorem 
  m <= k & l <= n implies A |^ (k, l) c= A |^ (m, n);

theorem 
  m <= k & k <= n implies A |^ (m, n) = A |^ (m, k) \/ A |^ (k, n);

theorem 
  m <= k & k <= n implies A |^ (m, n) = A |^ (m, k) \/ A |^ (k + 1 , n);

theorem 
  m <= n + 1 implies A |^ (m, n + 1) = A |^ (m, n) \/ (A |^ (n + 1 ));

theorem 
  m <= n implies A |^ (m, n) = A |^ m \/ A |^ (m + 1, n);

theorem 
  A |^ (n, n + 1) = A |^ n \/ A |^ (n + 1);

theorem 
  A c= B implies A |^ (m, n) c= B |^ (m, n);

theorem 
  x in A & x <> <%>E & (m > 0 or n > 0) implies A |^ (m, n) <> { <%>E};

theorem 
  A |^ (m, n) = {<%>E} iff m <= n & A = {<%>E} or m = 0 & n = 0 or
  m = 0 & A = {};

theorem 
  A |^ (m, n) c= A*;

theorem 
  <%>E in A |^ (m, n) iff m = 0 or m <= n & <%>E in A;

theorem 
  <%>E in A & m <= n implies A |^ (m, n) = A |^ n;

theorem 
  A |^ (m, n) ^^ (A |^ k) = (A |^ k) ^^ (A |^ (m, n));

theorem 
  (A |^ (m, n)) ^^ A = A ^^ (A |^ (m, n));

theorem 
  m <= n & k <= l implies (A |^ (m, n)) ^^ (A |^ (k, l)) = A |^ (m + k, n + l);

theorem 
  A |^ (m + 1, n + 1) = (A |^ (m, n)) ^^ A;

theorem 
  (A |^ (m, n)) ^^ (A |^ (k, l)) = (A |^ (k, l)) ^^ (A |^ (m, n));

theorem 
  (A |^ (m, n)) |^ k = A |^ (m * k, n * k);

theorem 
  (A |^ (k + 1)) |^ (m, n) c= ((A |^ k) |^ (m, n)) ^^ (A |^ (m, n) );

theorem 
  (A |^ k) |^ (m, n) c= A |^ (k * m, k * n);

theorem 
  (A |^ k) |^ (m, n) c= (A |^ (m, n)) |^ k;

theorem 
  (A |^ (k + l)) |^ (m, n) c= ((A |^ k) |^ (m, n)) ^^ ((A |^ l) |^ (m, n ));

theorem 
  A |^ (0, 0) = {<%>E};

theorem 
  A |^ (0, 1) = {<%>E} \/ A;

theorem 
  A |^ (1, 1) = A;

theorem 
  A |^ (0, 2) = {<%>E} \/ A \/ (A ^^ A);

theorem 
  A |^ (1, 2) = A \/ (A ^^ A);

theorem 
  A |^ (2, 2) = A ^^ A;

theorem 
  m > 0 & A |^ (m, n) = {x} implies for mn st m <= mn & mn <= n
  holds A |^ mn = {x};

theorem 
  m <> n & A |^ (m, n) = {x} implies x = <%>E;

theorem 
  <%x%> in A |^ (m, n) iff <%x%> in A & m <= n & ( <%>E in A & n >
  0 or m <= 1 & 1 <= n );

theorem 
  (A /\ B) |^ (m, n) c= (A |^ (m, n)) /\ (B |^ (m, n));

theorem 
  (A |^ (m, n)) \/ (B |^ (m, n)) c= (A \/ B) |^ (m, n);

theorem 
  (A |^ (m, n)) |^ (k, l) c= A |^ (m * k, n * l);

theorem 
  m <= n & <%>E in B implies A c= A ^^ (B |^ (m, n)) & A c= (B |^ (m, n) ) ^^ A
;

theorem 
  m <= n & k <= l & A c= C |^ (m, n) & B c= C |^ (k, l) implies A ^^ B
  c= C |^ (m + k, n + l);

theorem 
  (A |^ (m, n))* c= A*;

theorem 
  (A*) |^ (m, n) c= A*;

theorem 
  m <= n & n > 0 implies (A*) |^ (m, n) = A*;

theorem 
  m <= n & n > 0 & <%>E in A implies (A |^ (m, n))* = A*;

theorem 
  m <= n & <%>E in A implies (A |^ (m, n))* = (A*) |^ (m, n);

theorem 
  A c= B* implies A |^ (m, n) c= B*;

theorem 
  A c= B* implies B* = (B \/ (A |^ (m, n)))*;

theorem 
  A |^ (m, n) ^^ (A*) = A* ^^ (A |^ (m, n));

theorem 
  <%>E in A & m <= n implies A* = A* ^^ (A |^ (m, n));

theorem 
  A |^ (m, n) |^ k c= A*;

theorem 
  A |^ k |^ (m, n) c= A*;

theorem 
  m <= n implies (A |^ m)* c= (A |^ (m, n))*;

theorem 
  (A |^ (m, n)) |^ (k, l) c= A*;

theorem 
  <%>E in A & k <= n & l <= n implies A |^ (k, n) = A |^ (l, n);

begin




definition
  let E, A;
  func A? -> Subset of E^omega equals

  union { B: ex k st k <= 1 & B = A |^ k };
end;




theorem 
  x in A? iff ex k st k <= 1 & x in A |^ k;

theorem 
  n <= 1 implies A |^ n c= A?;

theorem 
  A? = (A |^ 0) \/ (A |^ 1);

theorem 
  A? = {<%>E} \/ A;

theorem 
  A c= A?;

theorem 
  x in A? iff x = <%>E or x in A;

theorem 
  A? = A |^ (0, 1);

theorem 
  A? = A iff <%>E in A;

registration
  let E, A;
  cluster A? -> non empty;
end;

theorem 
  A?? = A?;

theorem 
  A c= B implies A? c= B?;

theorem 
  x in A & x <> <%>E implies A? <> {<%>E};

theorem 
  A? = {<%>E} iff A = {} or A = {<%>E};

theorem 
  (A*)? = A* & (A?)* = A*;

theorem 
  A? c= A*;

theorem 
  (A /\ B)? = (A?) /\ (B?);

theorem 
  (A?) \/ (B?) = (A \/ B)?;

theorem 
  A? = {x} implies x = <%>E;

theorem 
  <%x%> in A? iff <%x%> in A;

theorem 
  (A?) ^^ A = A ^^ (A?);

theorem 
  (A?) ^^ A = A |^ (1, 2);

theorem 
  (A?) ^^ (A?) = A |^ (0, 2);

theorem 
  (A?) |^ k = (A?) |^ (0, k);

theorem 
  (A?) |^ k = A |^ (0, k);

theorem 
  m <= n implies A? |^ (m, n) = A? |^ (0, n);

theorem 
  A? |^ (0, n) = A |^ (0, n);

theorem 
  m <= n implies A? |^ (m, n) = A |^ (0, n);

theorem 
  (A |^ (1, n))? = A |^ (0, n);

theorem 
  <%>E in A & <%>E in B implies A? c= A ^^ B & A? c= B ^^ A;

theorem 
  A c= A ^^ (B?) & A c= (B?) ^^ A;

theorem 
  A c= C? & B c= C? implies A ^^ B c= C |^ (0, 2);

theorem 
  <%>E in A & n > 0 implies A? c= A |^ n;

theorem 
  (A?) ^^ (A |^ k) = (A |^ k) ^^ (A?);

theorem 
  A c= B* implies A? c= B*;

theorem 
  A c= B* implies B* = (B \/ (A?))*;

theorem 
  A? ^^ (A*) = A* ^^ (A?);

theorem 
  A? ^^ (A*) = A*;

theorem 
  A? |^ k c= A*;

theorem 
  (A |^ k)? c= A*;

theorem 
  (A?) ^^ (A |^ (m, n)) = (A |^ (m, n)) ^^ (A?);

theorem 
  (A?) ^^ (A |^ k) = A |^ (k, k + 1);

theorem 
  A? |^ (m, n) c= A*;

theorem 
  (A |^ (m, n))? c= A*;

theorem 
  A? = (A \ {<%>E})?;

theorem 
  A c= B? implies A? c= B?;

theorem 
  A c= B? implies B? = (B \/ A)?;














begin 

reserve a,b,r for real number;
reserve A for non empty set;
reserve X,x for set;
reserve f,g,F,G for PartFunc of REAL,REAL;
reserve n for Element of NAT;

theorem 
  for f,g being Function of A,REAL st rng f is bounded_above & rng
  g is bounded_above & (for x be set st x in A holds abs(f.x-g.x)<=a) holds
  upper_bound rng f - upper_bound rng g <= a & upper_bound rng g - upper_bound
  rng f <= a;

theorem 
  for f,g being Function of A,REAL st rng f is bounded_below & rng
  g is bounded_below & (for x be set st x in A holds abs(f.x-g.x)<=a) holds
  lower_bound rng f - lower_bound rng g <= a & lower_bound rng g - lower_bound
  rng f <= a;

theorem 
  f|X|X is bounded implies f|X is bounded;

theorem 
  for x be Real st x in X & f|X is_differentiable_in x holds f
  is_differentiable_in x;

theorem 
  f|X is_differentiable_on X implies f is_differentiable_on X;

theorem 
  f is_differentiable_on X & g is_differentiable_on X implies f+g
  is_differentiable_on X & f-g is_differentiable_on X & f(#)g
  is_differentiable_on X;

theorem 
  f is_differentiable_on X implies r(#)f is_differentiable_on X;

theorem 
  (for x be set st x in X holds g.x <> 0) & f is_differentiable_on
  X & g is_differentiable_on X implies f/g is_differentiable_on X;

theorem 
  (for x be set st x in X holds f.x <> 0) & f is_differentiable_on X
  implies f^ is_differentiable_on X;

theorem 
  a <= b & [' a,b '] c= X & F is_differentiable_on X & F`|X
is_integrable_on [' a,b '] & (F`|X)|[' a,b '] is bounded implies F.b = integral
  (F`|X,a,b) + F.a;

begin 

definition
  let X be set, f be PartFunc of REAL,REAL;
  func IntegralFuncs(f,X) -> set means


  x in it iff ex F be PartFunc of
  REAL,REAL st x = F & F is_differentiable_on X & F`|X = f|X;
end;

definition
  let X be set, F,f be PartFunc of REAL,REAL;
  pred F is_integral_of f,X means


  F in IntegralFuncs(f,X);
end;

theorem 
  F is_integral_of f,X implies X c= dom F;

theorem 
  F is_integral_of f,X & G is_integral_of g,X implies F+G is_integral_of
  f+g,X & F-G is_integral_of f-g,X;

theorem 
  F is_integral_of f,X implies r(#)F is_integral_of r(#)f,X;

theorem 
  F is_integral_of f,X & G is_integral_of g,X implies F(#)G
  is_integral_of f(#)G+F(#)g,X;

theorem 
  (for x be set st x in X holds G.x <> 0) & F is_integral_of f,X & G
  is_integral_of g,X implies F/G is_integral_of (f(#)G-F(#)g)/(G(#)G),X;

theorem 
  a <= b & [' a,b '] c= dom f & f|[' a,b '] is continuous & ]. a,b .[ c=
dom F & (for x be real number st x in ].a,b.[ holds F.x = integral(f,a,x) + F.a
  ) implies F is_integral_of f,]. a,b .[;

theorem 
  for x,x0 be real number st f| [. a,b .] is continuous & [.a,b.] c= dom
  f & x in ].a,b.[ & x0 in ].a,b.[ & F is_integral_of f,].a,b.[ holds F.x =
  integral(f,x0,x) + F.x0;

theorem 
  a <= b & [' a,b '] c= X & F is_integral_of f,X & f
is_integrable_on [' a,b '] & f|[' a,b '] is bounded implies F.b = integral(f,a,
  b) + F.a;

theorem 
  a <= b & [. a,b .] c= X & X c= dom f & f|X is continuous implies
  f|[' a,b '] is continuous & f is_integrable_on [' a,b '] & f|[' a,b '] is
  bounded;

theorem 
  a <= b & [. a,b .] c= X & X c= dom f & f|X is continuous & F
  is_integral_of f,X implies F.b = integral(f,a,b) + F.a;

theorem 
  b <= a & [' b,a '] c= X & f is_integrable_on [' b,a '] & g
is_integrable_on [' b,a '] & f|[' b,a '] is bounded & g|[' b,a '] is bounded &
X c= dom f & X c= dom g & F is_integral_of f,X & G is_integral_of g,X implies (
  F.a)*(G.a) - (F.b)*(G.b) = integral(f(#)G,b,a) + integral(F(#)g,b,a);

theorem 
  b <= a & [. b,a .] c= X & X c= dom f & X c= dom g & f|X is continuous
& g|X is continuous & F is_integral_of f,X & G is_integral_of g,X implies (F.a)
  *(G.a) - (F.b)*(G.b) = integral(f(#)G,b,a)+ integral(F(#)g,b,a);

begin 

theorem 
  sin is_integral_of cos,REAL;

theorem 
  sin.b-sin.a = integral(cos,a,b);

theorem 
  (-1)(#)cos is_integral_of sin,REAL;

theorem 
  cos.a - cos.b = integral(sin,a,b);

theorem 
  exp_R is_integral_of exp_R,REAL;

theorem 
  exp_R.b-exp_R.a = integral(exp_R,a,b);

theorem 
  #Z (n+1) is_integral_of (n+1)(#)( #Z n),REAL;

theorem 
  ( #Z (n+1)).b - ( #Z (n+1)).a = integral((n+1)(#)( #Z n),a,b);

begin 

theorem 
  for H be Functional_Sequence of REAL,REAL, rseq be Real_Sequence st a
< b & (for n be Element of NAT holds H.n is_integrable_on [' a,b '] & (H.n)|['
a,b '] is bounded & rseq.n = integral(H.n,a,b) ) & H is_unif_conv_on [' a,b ']
holds lim(H,[' a,b '])|[' a,b '] is bounded & lim(H,[' a,b ']) is_integrable_on
  [' a,b '] & rseq is convergent & lim rseq = integral(lim(H,[' a,b ']),a,b);














begin 

definition
  let i,n be Nat;
  func proj(i,n) -> Function of REAL n,REAL means


  for x be Element of REAL n holds it.x=x.i;
end;

theorem 
  (for i, n being Element of NAT st i in Seg n holds dom proj(i,n) =
REAL n & rng proj(i,n) = REAL) & for x be Element of REAL holds proj(1,1).<*x*>
  = x & proj(1,1) qua Function".x = <*x*>;

theorem 
  proj(1,1) qua Function" is Function of REAL,REAL 1 & proj(1,1)
qua Function" is one-to-one & dom(proj(1,1) qua Function") = REAL & rng(proj(1,
1) qua Function") = REAL 1 & ex g be Function of REAL,REAL 1 st g is bijective
  & proj(1,1) qua Function" = g;

registration
  cluster proj(1,1) -> bijective;
end;

definition
  let g be PartFunc of REAL,REAL;
  func <>*g -> PartFunc of REAL 1,REAL 1 equals

  proj(1,1) qua Function" * g *
  proj(1,1);
end;

definition
  let n be Nat;
  let g be PartFunc of REAL n,REAL;
  func <>*g -> PartFunc of REAL n,REAL 1 equals

  proj(1,1) qua Function" * g;
end;

definition
  let i,n be Nat;
  func Proj(i,n) -> Function of REAL-NS n,REAL-NS 1 means


  for x be Point of REAL-NS n holds it.x=<* proj(i,n).x *>;
end;

definition
  let i be Element of NAT;
  let x be FinSequence of REAL;
  func reproj(i,x) -> Function means


  dom it = REAL & for r be Element of REAL holds it.r = Replace(x,i,r);
end;

definition
  let n,i be Element of NAT;
  let x be Element of REAL n;
  redefine func reproj(i,x) -> Function of REAL,REAL n;
end;

definition
  let n,i be Element of NAT;
  let x be Point of REAL-NS n;
  func reproj(i,x) -> Function of REAL-NS 1,REAL-NS n means


  for r be
Element of REAL-NS 1 ex q be Element of REAL, y be Element of REAL n st r=<*q*>
  & y=x & it.r = reproj(i,y).q;
end;

definition
  let m,n be non empty Element of NAT;
  let f be PartFunc of REAL m,REAL n;
  let x be Element of REAL m;
  pred f is_differentiable_in x means


  ex g be PartFunc of REAL-NS m,
  REAL-NS n, y be Point of REAL-NS m st f=g & x=y & g is_differentiable_in y;
end;

definition
  let m,n be non empty Element of NAT;
  let f be PartFunc of REAL m,REAL n;
  let x be Element of REAL m;
  assume
 f is_differentiable_in x;
  func diff(f,x) -> Function of REAL m, REAL n means


  ex g be PartFunc
of REAL-NS m,REAL-NS n, y be Point of REAL-NS m st f=g & x=y & it = diff(g,y);
end;

theorem 
  for I be Function of REAL,REAL 1 st I=proj(1,1) qua Function"
  holds (for x be VECTOR of REAL-NS 1, y be Element of REAL st x=I.y holds ||.x
.|| = abs y) & (for x,y be VECTOR of REAL-NS 1, a,b be Element of REAL st x=I.a
  & y=I.b holds x+y = I.(a+b)) & (for x be VECTOR of REAL-NS 1, y be Element of
REAL, a be Real st x=I.y holds a*x = I.(a*y)) & (for x be VECTOR of REAL-NS 1,
a be Element of REAL st x=I.a holds -x = I.(-a)) & for x,y be VECTOR of REAL-NS
  1, a,b be Element of REAL st x=I.a & y=I.b holds x-y =I.(a-b);

theorem 
  for J be Function of REAL 1,REAL st J=proj(1,1) holds (for x be
  VECTOR of REAL-NS 1, y be Element of REAL st J.x=y holds ||.x.|| = abs y) & (
for x,y be VECTOR of REAL-NS 1, a,b be Element of REAL st J.x=a & J.y=b holds J
.(x+y) = a+b) & (for x be VECTOR of REAL-NS 1, y be Element of REAL, a be Real
st J.x=y holds J.(a*x) = a*y) & (for x be VECTOR of REAL-NS 1, a be Element of
  REAL st J.x=a holds J.(-x) = -a) & for x,y be VECTOR of REAL-NS 1, a,b be
  Element of REAL st J.x=a & J.y=b holds J.(x-y) = a-b;

theorem 
  for I be Function of REAL,REAL 1, J be Function of REAL 1,REAL st
  I=proj(1,1) qua Function" & J=proj(1,1) holds
  (for R being RestFunc of REAL-NS 1, REAL-NS 1 holds J*R*I is RestFunc) &
  for L being LinearOperator of REAL-NS 1, REAL-NS 1 holds
  J*L*I is LinearFunc;

theorem 
  for I be Function of REAL,REAL 1, J be Function of REAL 1,REAL st
I=proj(1,1) qua Function" & J=proj(1,1) holds
(for R being RestFunc holds I*R*J is
  RestFunc of REAL-NS 1,REAL-NS 1) &
  for L being LinearFunc holds I*L*J is Lipschitzian
  LinearOperator of REAL-NS 1,REAL-NS 1;

reserve f for PartFunc of REAL-NS 1,REAL-NS 1;
reserve g for PartFunc of REAL,REAL;
reserve x for Point of REAL-NS 1;
reserve y for Element of REAL;

theorem 
  f=<>*g & x=<*y*> & f is_differentiable_in x implies g
  is_differentiable_in y & diff(g,y) = (proj(1,1)*diff(f,x)*(proj(1,1)qua
  Function")).1;

theorem 
  f=<>*g & x=<*y*> & g is_differentiable_in y implies f
  is_differentiable_in x & diff(f,x).<*1*> =<*diff(g,y)*>;

theorem 
  f=<>*g & x=<*y*> implies (f is_differentiable_in x iff g
  is_differentiable_in y);

theorem 
  f=<>*g & x=<*y*> & f is_differentiable_in x implies diff(f,x).<*
  1*>=<*diff(g,y)*>;

begin 

reserve m,n for non empty Element of NAT;
reserve i,j for Element of NAT;
reserve f for PartFunc of REAL-NS n,REAL-NS 1;
reserve g for PartFunc of REAL n,REAL;
reserve x for Point of REAL-NS n;
reserve y for Element of REAL n;

definition
  let n,m be non empty Element of NAT;
  let i be Element of NAT;
  let f be PartFunc of REAL-NS m,REAL-NS n;
  let x be Point of REAL-NS m;
  pred f is_partial_differentiable_in x,i means


  f*reproj(i,x) is_differentiable_in Proj(i,m).x;
end;

definition
  let m,n be non empty Element of NAT;
  let i be Element of NAT;
  let f be PartFunc of REAL-NS m, REAL-NS n;
  let x be Point of REAL-NS m;
  func partdiff(f,x,i) -> Point of R_NormSpace_of_BoundedLinearOperators(
  REAL-NS 1,REAL-NS n) equals

  diff(f*reproj(i,x),Proj(i,m).x);
end;

definition
  let n be non empty Element of NAT;
  let i be Element of NAT;
  let f be PartFunc of REAL n,REAL;
  let x be Element of REAL n;
  pred f is_partial_differentiable_in x,i means


  f*reproj(i,x) is_differentiable_in proj(i,n).x;
end;

definition
  let n be non empty Element of NAT;
  let i be Element of NAT;
  let f be PartFunc of REAL n,REAL;
  let x be Element of REAL n;
  func partdiff(f,x,i) -> real number equals

  diff(f*reproj(i,x),proj(i,n).x);
end;

definition
  let n be non empty Element of NAT;
  let i be Element of NAT;
  let f be PartFunc of REAL n,REAL;
  let x be Element of REAL n;
  redefine func partdiff(f,x,i) -> Real;
end;

theorem 
  Proj(i,n)=proj(1,1)qua Function"*proj(i,n);

theorem 
  x = y implies reproj(i,y)*proj(1,1)=reproj(i,x);

theorem 
  f=<>*g & x=y implies <>*(g*reproj(i,y)) = f*reproj(i,x);

theorem 
  f=<>*g & x=y implies (f is_partial_differentiable_in x,i iff g
  is_partial_differentiable_in y,i);

theorem 
  f = <>*g & x = y & f is_partial_differentiable_in x,i implies
  partdiff(f,x,i).<*1*> = <*partdiff(g,y,i)*>;

definition
  let m,n be non empty Element of NAT;
  let i be Element of NAT;
  let f be PartFunc of REAL m,REAL n;
  let x be Element of REAL m;
  pred f is_partial_differentiable_in x,i means


  ex g be PartFunc of
  REAL-NS m,REAL-NS n, y be Point of REAL-NS m st f=g & x=y & g
  is_partial_differentiable_in y,i;
end;

definition
  let m,n be non empty Element of NAT;
  let i be Element of NAT;
  let f be PartFunc of REAL m,REAL n;
  let x be Element of REAL m;
  assume
 f is_partial_differentiable_in x,i;
  func partdiff(f,x,i) -> Element of REAL n means


  ex g be PartFunc of
REAL-NS m,REAL-NS n, y be Point of REAL-NS m st f=g & x=y & it = partdiff(g,y,i
  ).<*1*>;
end;

theorem 
  for m,n be non empty Element of NAT, F be PartFunc of REAL-NS m,
  REAL-NS n, G be PartFunc of REAL m,REAL n, x be Point of REAL-NS m, y be
Element of REAL m st F = G & x = y holds F is_partial_differentiable_in x,i iff
  G is_partial_differentiable_in y,i;

theorem 
  for m,n be non empty Element of NAT, F be PartFunc of REAL-NS m,
  REAL-NS n, G be PartFunc of REAL m,REAL n, x be Point of REAL-NS m, y be
  Element of REAL m st F=G & x=y & F is_partial_differentiable_in x,i holds
  partdiff(F,x,i).<*1*> = partdiff(G,y,i);

theorem 
  for g1 be PartFunc of REAL n,REAL 1 holds g1 = <>*g implies (g1
  is_partial_differentiable_in y,i iff g is_partial_differentiable_in y,i);

theorem 
  for g1 be PartFunc of REAL n,REAL 1 st g1 = <>*g & g1
  is_partial_differentiable_in y,i holds partdiff(g1,y,i) = <*partdiff(g,y,i)*>
;

begin 

reserve X for set;
reserve r for Real;
reserve f,f1,f2 for PartFunc of REAL-NS m,REAL-NS n;
reserve g,g1,g2 for PartFunc of REAL n,REAL;
reserve h for PartFunc of REAL m,REAL n;
reserve x for Point of REAL-NS m;
reserve y for Element of REAL n;
reserve z for Element of REAL m;

definition
  let m,n be non empty Element of NAT;
  let i,j be Element of NAT;
  let f be PartFunc of REAL-NS m,REAL-NS n;
  let x be Point of REAL-NS m;
  pred f is_partial_differentiable_in x,i,j means


  Proj(j,n)*f*reproj(i ,x) is_differentiable_in Proj(i,m).x;
end;

definition
  let m,n be non empty Element of NAT;
  let i,j be Element of NAT;
  let f be PartFunc of REAL-NS m,REAL-NS n;
  let x be Point of REAL-NS m;
  func partdiff(f,x,i,j) -> Point of R_NormSpace_of_BoundedLinearOperators(
  REAL-NS 1,REAL-NS 1) equals

  diff(Proj(j,n)*f*reproj(i,x),Proj(i,m).x);
end;

definition
  let m,n be non empty Element of NAT;
  let i,j be Element of NAT;
  let h be PartFunc of REAL m,REAL n;
  let z be Element of REAL m;
  pred h is_partial_differentiable_in z,i,j means


  proj(j,n)*h*reproj(i ,z) is_differentiable_in proj(i,m).z;
end;

definition
  let m,n be non empty Element of NAT;
  let i,j be Element of NAT;
  let h be PartFunc of REAL m,REAL n;
  let z be Element of REAL m;
  func partdiff(h,z,i,j) -> real number equals

  diff(proj(j,n)*h*reproj(i,z),
  proj(i,m).z);
end;

theorem 
  for m,n be non empty Element of NAT, F be PartFunc of REAL-NS m,
  REAL-NS n, G be PartFunc of REAL m,REAL n, x be Point of REAL-NS m, y be
  Element of REAL m st F=G & x=y holds F is_differentiable_in x iff G
  is_differentiable_in y;

theorem 
  for m,n be non empty Element of NAT, F be PartFunc of REAL-NS m,
  REAL-NS n, G be PartFunc of REAL m,REAL n, x be Point of REAL-NS m, y be
Element of REAL m st F=G & x=y & F is_differentiable_in x holds diff(F,x)=diff(
  G,y);

theorem 
  f=h & x=z implies Proj(j,n)*f*reproj(i,x) = <>*(proj(j,n)*h* reproj(i,z));

theorem 
  f = h & x = z implies (f is_partial_differentiable_in x,i,j iff h
  is_partial_differentiable_in z,i,j);

theorem 
  f=h & x=z & f is_partial_differentiable_in x,i,j implies partdiff(f,x,
  i,j).<*1*> = <*partdiff(h,z,i,j)*>;

definition
  let m,n be non empty Element of NAT;
  let i be Element of NAT;
  let f be PartFunc of REAL-NS m,REAL-NS n;
  let X be set;
  pred f is_partial_differentiable_on X,i means


  X c=dom f & for x be
  Point of REAL-NS m st x in X holds f|X is_partial_differentiable_in x,i;
end;

theorem 
  f is_partial_differentiable_on X,i implies X is Subset of REAL-NS m;

definition
  let m,n be non empty Element of NAT;
  let i be Element of NAT;
  let f be PartFunc of REAL-NS m,REAL-NS n;
  let X;
  assume
 f is_partial_differentiable_on X,i;
  func f `partial|(X,i) -> PartFunc of REAL-NS m,
  R_NormSpace_of_BoundedLinearOperators(REAL-NS 1,REAL-NS n) means

  dom it = X &
  for x be Point of REAL-NS m st x in X holds it/.x = partdiff(f,x,i);
end;

theorem 
  (f1+f2)*reproj(i,x) = f1*reproj(i,x)+f2*reproj(i,x) & (f1-f2)*
  reproj(i,x) = f1*reproj(i,x)-f2*reproj(i,x);

theorem 
  r(#)(f*reproj(i,x)) = (r(#)f)*reproj(i,x);

theorem 
  f1 is_partial_differentiable_in x,i & f2
is_partial_differentiable_in x,i implies f1+f2 is_partial_differentiable_in x,i
  & partdiff(f1+f2,x,i)=partdiff(f1,x,i)+partdiff(f2,x,i);

theorem 
  g1 is_partial_differentiable_in y,i & g2 is_partial_differentiable_in
  y,i implies g1+g2 is_partial_differentiable_in y,i & partdiff(g1+g2,y,i) =
  partdiff(g1,y,i) + partdiff(g2,y,i);

theorem 
  f1 is_partial_differentiable_in x,i & f2
is_partial_differentiable_in x,i implies f1-f2 is_partial_differentiable_in x,i
  & partdiff(f1-f2,x,i)=partdiff(f1,x,i)-partdiff(f2,x,i);

theorem 
  g1 is_partial_differentiable_in y,i & g2 is_partial_differentiable_in
  y,i implies g1-g2 is_partial_differentiable_in y,i & partdiff(g1-g2,y,i)=
  partdiff(g1,y,i)-partdiff(g2,y,i);

theorem 
  f is_partial_differentiable_in x,i implies r(#)f
  is_partial_differentiable_in x,i & partdiff((r(#)f),x,i) = r*partdiff(f,x,i);

theorem 
  g is_partial_differentiable_in y,i implies r(#)g
  is_partial_differentiable_in y,i & partdiff(r(#)g,y,i) = r*partdiff(g,y,i);














begin 

theorem 
  for s,t be Real_Sequence, g be real number st for n be Element of NAT
holds t.n = abs(s.n-g) holds s is convergent & lim s = g iff t is convergent &
  lim t = 0;

theorem 
  for x,y be FinSequence of REAL st len x = len y & for i be
Element of NAT st i in Seg len x holds 0 <= x.i & x.i <= y.i holds |.x.| <= |.y
  .|;

theorem 
  for F be FinSequence of REAL st for i be Element of NAT st i in
  dom F holds F.i = 0 holds Sum F = 0;

definition
  let f be Function;
  let X be set;
  mode MultOps of X,f -> Function means


    dom it = dom f & for i being
    set st i in dom f holds it.i is Function of [:X,f.i:],f.i;
end;

registration
  let F be Domain-Sequence;
  let X be set;
  cluster -> FinSequence-like for MultOps of X,F;
end;

theorem 
  for X be set, F be Domain-Sequence, p be FinSequence holds (p is
  MultOps of X,F iff len p = len F & for i be set st i in dom F holds p.i is
  Function of [:X,F.i:],F.i);

definition
  let F be Domain-Sequence;
  let X be set;
  let p be MultOps of X,F;
  let i be Element of dom F;
  redefine func p.i -> Function of [:X,F.i:],F.i;
end;

theorem 
  for X be non empty set, F be Domain-Sequence, f,g being Function
  of [:X,product F:],product F st for x be Element of X, d being Element of
product F, i being Element of dom F holds (f.(x,d)).i = (g.(x,d)).i holds f = g
;

definition
  let F be Domain-Sequence;
  let X be non empty set;
  let p be MultOps of X,F;
  func [:p:] -> Function of [:X,product F:],product F means


  for x be
Element of X, d being Element of product F, i being Element of dom F holds (it.
  (x,d)).i = (p.i).(x,d.i);
end;

definition
  let R be Relation;
  attr R is RealLinearSpace-yielding means


  for S be set st S in rng R holds S is RealLinearSpace;
end;

registration
  cluster non empty RealLinearSpace-yielding for FinSequence;
end;

definition
  mode RealLinearSpace-Sequence is non empty RealLinearSpace-yielding
    FinSequence;
end;

definition
  let G be RealLinearSpace-Sequence;
  let j be Element of dom G;
  redefine func G.j -> RealLinearSpace;
end;

definition
  let G be RealLinearSpace-Sequence;
  func carr G -> Domain-Sequence means


  len it = len G & for j be Element of dom G holds it.j = the carrier of G.j;
end;

definition
  let G be RealLinearSpace-Sequence, j be Element of dom carr G;
  redefine func G.j -> RealLinearSpace;
end;

definition
  let G be RealLinearSpace-Sequence;
  func addop G -> BinOps of carr G means


  len it = len carr G & for j be
  Element of dom carr G holds it.j = the addF of G.j;
  func complop G -> UnOps of carr G means


  len it = len carr G & for j be Element of dom carr G holds it.j = comp G.j;
  func zeros G -> Element of product carr G means


  for j be Element of dom carr G holds it.j = the ZeroF of G.j;
  func multop G -> MultOps of REAL,carr G means


  len it = len carr G &
  for j be Element of dom carr G holds it.j = the Mult of G.j;
end;

definition
  let G be RealLinearSpace-Sequence;
  func product G -> strict non empty RLSStruct equals

  RLSStruct(# product carr
    G,zeros G,[:addop G :],[:multop G:] #);
end;

registration
  let G be RealLinearSpace-Sequence;
  cluster product G -> Abelian add-associative right_zeroed
    right_complementable vector-distributive scalar-distributive
    scalar-associative scalar-unital;
end;

begin 

definition
  let R be Relation;
  attr R is RealNormSpace-yielding means


  for x be set st x in rng R holds x is RealNormSpace;
end;

registration
  cluster non empty RealNormSpace-yielding for FinSequence;
end;

definition
  mode RealNormSpace-Sequence is non empty RealNormSpace-yielding FinSequence;
end;

definition
  let G be RealNormSpace-Sequence;
  let j be Element of dom G;
  redefine func G.j -> RealNormSpace;
end;

registration
  cluster RealNormSpace-yielding -> RealLinearSpace-yielding for FinSequence;
end;

definition
  let G be RealNormSpace-Sequence;
  let x be Element of product carr G;
  func normsequence(G,x) -> Element of REAL len G means


  len it = len G
  & for j be Element of dom G holds it.j=(the normF of G.j).(x.j);
end;

definition
  let G be RealNormSpace-Sequence;
  func productnorm G -> Function of product carr (G qua
  RealLinearSpace-Sequence),REAL means


  for x being Element of product carr G holds it.x = |.normsequence(G,x).|;
end;

definition
  let G be RealNormSpace-Sequence;
  func product G -> strict non empty NORMSTR means


  the RLSStruct of it
  = product (G qua RealLinearSpace-Sequence) & the normF of it = productnorm G;
end;

reserve G for RealNormSpace-Sequence;

theorem 
  product G = NORMSTR(# product carr G,zeros G,[:addop G:],[:multop
    G:], productnorm G #);

theorem 
  for x be VECTOR of product G, y be Element of product carr G st x
  = y holds ||.x.|| = |.normsequence(G,y).|;

theorem 
  for x,y,z be Element of product carr G, i be Element of NAT st i
in dom x & z = [:addop G :].(x,y) holds normsequence(G,z).i <= (normsequence(G,
  x) + normsequence(G,y)).i;

theorem 
  for x be Element of product carr G, i be Element of NAT st i in
  dom x holds 0 <= normsequence(G,x).i;

registration
  let G be RealNormSpace-Sequence;
  cluster product G -> reflexive discerning RealNormSpace-like
  vector-distributive scalar-distributive scalar-associative scalar-unital
  Abelian add-associative right_zeroed right_complementable;
end;

theorem 
  for G be RealNormSpace-Sequence, i be Element of dom G, x be
Point of product G, y be Element of product carr G, xi be Point of G.i st y = x
  & xi = y.i holds ||.xi.|| <= ||.x.||;

theorem 
  for G be RealNormSpace-Sequence, i be Element of dom G, x,y be
  Point of product G, xi,yi be Point of G.i, zx,zy be Element of product carr G
  st xi=zx.i & zx=x & yi=zy.i & zy=y holds ||.yi - xi.|| <= ||.y - x.||;

theorem 
  for G be RealNormSpace-Sequence, seq be sequence of product G, x0 be
  Point of product G, y0 be Element of product carr G st x0 = y0 & seq is
convergent & lim seq=x0 holds for i be Element of dom G ex seqi be sequence of
G.i st seqi is convergent & y0.i = lim seqi & for m be Element of NAT holds ex
  seqm be Element of product carr G st seqm= seq.m & seqi.m=seqm.i;

theorem 
  for G be RealNormSpace-Sequence, seq be sequence of (product G),
  x0 be Point of product G, y0 be Element of product carr G st x0=y0 & for i be
Element of dom G ex seqi be sequence of G.i st seqi is convergent & y0.i = lim
  seqi & for m be Element of NAT holds ex seqm be Element of product carr G st
  seqm= seq.m & seqi.m=seqm.i holds seq is convergent & lim seq=x0;

theorem 
  for G be RealNormSpace-Sequence st for i be Element of dom G holds G.i
  is complete holds product G is complete;














begin 

reserve D for non empty set,
  i,j,k,l for Element of NAT,
  n for Nat,
  x for set,
  a,b,c,r,r1,r2 for Real,
  p,q for FinSequence of REAL,
  MR,MR1 for Matrix of REAL;

theorem 
  k <> 0 & i < l & l <= j & k divides l implies i div k < j div k;

theorem 
  r > 0 implies ln.r <= r - 1 & (r = 1 iff ln.r = r - 1) & (r <> 1
  iff ln.r < r - 1);

theorem 
  r > 0 implies log(number_e,r) <= r - 1 & (r = 1 iff log(number_e,
  r) = r - 1) & (r <> 1 iff log(number_e,r) < r - 1);

theorem 
  a>1 & b>1 implies log(a,b) > 0;

theorem 
  a>0 & a<>1 & b>0 implies -log(a,b) = log(a,1/b);

theorem 
  a>0 & a<>1 & b>=0 & c>=0 implies b*c*log(a,b*c) = b*c*log(a,b)+b* c*log(a,c);

theorem 
  for q,q1,q2 being FinSequence of REAL st len q1 = len q & len q1
= len q2 & (for k st k in dom q1 holds q.k = q1.k + q2.k) holds Sum q = Sum q1
  + Sum q2;

theorem 
  for q,q1,q2 being FinSequence of REAL st len q1 = len q & len q1
= len q2 & (for k st k in dom q1 holds q.k = q1.k - q2.k) holds Sum q = Sum q1
  - Sum q2;

theorem 
  len p >= 1 implies ex q st len q = len p & q.1 = p.1 & (for k st
  0 <> k & k < len p holds q.(k+1) = q.k + p.(k+1)) & Sum p = q.(len p);

notation
  let p;
  synonym p is nonnegative for p is nonnegative-yielding;
end;

definition
  let p;
  redefine attr p is nonnegative means


  for i st i in dom p holds p.i >= 0;
end;

registration
  cluster nonnegative for FinSequence of REAL;
end;

theorem 
  p is nonnegative & r>=0 implies r*p is nonnegative;

definition
  let p,k;
  pred p has_onlyone_value_in k means


  k in dom p & for i st i in dom p & i<>k holds p.i=0;
end;

theorem 
  p has_onlyone_value_in k & i<>k implies p.i=0;

theorem 
  len p = len q & p has_onlyone_value_in k implies mlt(p,q)
  has_onlyone_value_in k & mlt(p,q).k = p.k * q.k;

theorem 
  p has_onlyone_value_in k implies Sum p = p.k;

theorem 
  p is nonnegative implies for k st k in dom p & p.k = Sum p holds
  p has_onlyone_value_in k;

registration
  cluster ProbFinS -> non empty nonnegative for FinSequence of REAL;
end;

theorem 
  for p being ProbFinS FinSequence of REAL for k st k in dom p & p
  .k = 1 holds p has_onlyone_value_in k;

theorem 
  for i being non empty Nat holds (i |-> (1/i)) is ProbFinS FinSequence of REAL
;

registration
  cluster with_sum=1 -> non empty-yielding for Matrix of REAL;
  cluster Joint_Probability -> non empty-yielding for Matrix of REAL;
end;

theorem 
  for M being Matrix of REAL st M = {} holds SumAll M = 0;

theorem 
  for M being Matrix of D holds for i st i in dom M holds dom(M.i)
  = Seg width M;

theorem 
  MR is m-nonnegative iff for i st i in dom MR holds Line(MR,i) is nonnegative;

begin 

theorem 
  for j st j in dom p holds Col(LineVec2Mx p,j) = <*p.j*>;

theorem 
  for p being non empty FinSequence of REAL for q being
  FinSequence of REAL for M being Matrix of REAL holds M = (ColVec2Mx p) * (
  LineVec2Mx q) iff (len M = len p & width M = len q & for i,j st [i,j] in
  Indices M holds M*(i,j) = p.i * q.j);

theorem 
  for p being non empty FinSequence of REAL for q being
  FinSequence of REAL for M being Matrix of REAL holds M = (ColVec2Mx p) * (
LineVec2Mx q) iff (len M = len p & width M = len q & for i st i in dom M holds
  Line(M,i) = p.i * q);

theorem 
  for p,q being ProbFinS FinSequence of REAL holds (ColVec2Mx p) *
  (LineVec2Mx q) is Joint_Probability;

definition
  let n;
  let MR be Matrix of n,REAL;
  attr MR is diagonal means


  for i,j st [i,j] in Indices MR & MR*(i,j) <> 0 holds i=j;
end;

registration
  let n;
  cluster diagonal for Matrix of n,REAL;
end;

theorem 
  for MR being Matrix of n,REAL holds MR is diagonal iff for i st
  i in dom MR holds Line(MR,i) has_onlyone_value_in i;

definition
  let p;
  func Vec2DiagMx p -> diagonal Matrix of len p,REAL means


  for j st j in dom p holds it*(j,j) = p.j;
end;

theorem 
  MR=Vec2DiagMx p iff len MR = len p & width MR = len p & for i st
  i in dom MR holds Line(MR,i) has_onlyone_value_in i & Line(MR,i).i=p.i;

theorem 
  len p = len MR implies (MR1 = (Vec2DiagMx p) * MR iff len MR1 =
len p & width MR1 = width MR & for i,j st [i,j] in Indices MR1 holds MR1*(i,j)
  = p.i * (MR*(i,j)));

theorem 
  len p = len MR implies (MR1 = (Vec2DiagMx p) * MR iff len MR1 =
len p & width MR1 = width MR & for i st i in dom MR1 holds Line(MR1,i) = p.i *
  Line(MR,i));

theorem 
  for p being ProbFinS FinSequence of REAL for M being non
empty-yielding Conditional_Probability Matrix of REAL st len p = len M holds (
  Vec2DiagMx p) * M is Joint_Probability;

theorem 
  for M being Matrix of D for p being FinSequence of D* st len p =
len M & p.1 = M.1 & (for k st k >= 1 & k < len M holds p.(k+1) = (p.k) ^ M.(k+1
  )) holds for k st k in dom p holds len (p.k) = k * width M;

theorem 
  for M being Matrix of D for p being FinSequence of D* st len p =
len M & p.1 = M.1 & (for k st k >= 1 & k < len M holds p.(k+1) = (p.k) ^ M.(k+1
)) holds for i,j st i in dom p & j in dom p & i <= j holds dom (p.i) c= dom (p.
  j);

theorem 
  for M being Matrix of D for p being FinSequence of D* st len p =
len M & p.1 = M.1 & (for k st k >= 1 & k < len M holds p.(k+1) = (p.k) ^ M.(k+1
)) holds len (p.1) = width M & for j st [1,j] in Indices M holds j in dom (p.1)
  & (p.1).j = M*(1,j);

theorem 
  for M being Matrix of D for p being FinSequence of D* st len p =
len M & (for k st k >= 1 & k < len M holds p.(k+1) = (p.k) ^ M.(k+1)) holds for
j st j >= 1 & j < len p holds for l st l in dom(p.j) holds (p.j).l = (p.(j+1)).
  l;

theorem 
  for M being Matrix of D for p being FinSequence of D* st len p =
len M & p.1 = M.1 & (for k st k >= 1 & k < len M holds p.(k+1) = (p.k) ^ M.(k+1
)) holds for i,j st i in dom p & j in dom p & i <= j holds for l st l in dom(p.
  i) holds (p.i).l = (p.j).l;

theorem 
  for M being Matrix of D for p being FinSequence of D* st len p =
len M & p.1 = M.1 & (for k st k >= 1 & k < len M holds p.(k+1) = (p.k) ^ M.(k+1
)) holds for j st j >= 1 & j < len p holds for l st l in Seg width M holds (j*
  width M+l) in dom (p.(j+1)) & (p.(j+1)).(j*width M+l)=(M.(j+1)).l;

theorem 
  for M being Matrix of D for p being FinSequence of D* st len p =
len M & p.1 = M.1 & (for k st k >= 1 & k < len M holds p.(k+1) = (p.k) ^ M.(k+1
)) holds for i,j st [i,j] in Indices M holds (i-1)*(width M)+j in dom(p.i) & M*
  (i,j) = (p.i).((i-1)*(width M)+j);

theorem 
  for M being Matrix of D for p being FinSequence of D* st len p =
len M & p.1 = M.1 & (for k st k >= 1 & k < len M holds p.(k+1) = (p.k) ^ M.(k+1
)) holds for i,j st [i,j] in Indices M holds (i-1)*(width M)+j in dom(p.(len M)
  ) & M*(i,j) = (p.(len M)).((i-1)*(width M)+j);

theorem 
  for M being Matrix of REAL for p being FinSequence of REAL* st (
for k st k >= 1 & k < len M holds p.(k+1)=(p.k) ^ M.(k+1)) holds for k st k >=
  1 & k < len M holds Sum(p.(k+1))=Sum(p.k)+Sum(M.(k+1));

theorem 
  for M being Matrix of REAL for p being FinSequence of REAL* st
len p = len M & p.1 = M.1 & (for k st k >= 1 & k < len M holds p.(k+1)=(p.k) ^
  M.(k+1)) holds SumAll M = Sum(p.(len M));

definition
  let D be non empty set;
  let M be Matrix of D;
  func Mx2FinS(M) -> FinSequence of D means


  it = {} if len M = 0
otherwise ex p being FinSequence of D* st it = p.(len M) & len p = len M & p.1
  = M.1 & for k st k >= 1 & k < len M holds p.(k+1) = (p.k) ^ M.(k+1);
end;

theorem 
  for M being Matrix of D holds len Mx2FinS(M) = len M * width M;

theorem 
  for M being Matrix of D for i,j st [i,j] in Indices M holds (i-1
) * (width M) + j in dom Mx2FinS M & M*(i,j) = (Mx2FinS(M)).((i-1) * (width M)
  + j);

theorem 
  for M being Matrix of D for k,l st k in dom(Mx2FinS(M)) & l = k
- 1 holds [((l div width M)+1),((l mod width M)+1)] in Indices M & (Mx2FinS(M))
  .k = M*(((l div width M)+1),((l mod width M)+1));

theorem 
  SumAll MR = Sum Mx2FinS MR;

theorem 
  MR is m-nonnegative iff Mx2FinS(MR) is nonnegative;

theorem 
  MR is Joint_Probability iff Mx2FinS(MR) is ProbFinS;

theorem 
  for p,q being ProbFinS FinSequence of REAL holds Mx2FinS((
  ColVec2Mx p) * (LineVec2Mx q)) is ProbFinS;

theorem 
  for p being ProbFinS FinSequence of REAL for M being non
  empty-yielding Conditional_Probability Matrix of REAL st len p = len M holds
  Mx2FinS((Vec2DiagMx p) * M) is ProbFinS;

begin 

definition
  let a,p;
  assume that
 p is nonnegative;
  func FinSeq_log(a,p) -> FinSequence of REAL means


  len it = len p &
for k be Nat st k in dom it holds (p.k > 0 implies it.k = log(a,p.k)) & (p.k =
  0 implies it.k = 0);
end;

definition
  let p;
  func Infor_FinSeq_of p -> FinSequence of REAL equals

  mlt(p,FinSeq_log(2,p));
end;

theorem 
  for p being nonnegative FinSequence of REAL for q holds q =
Infor_FinSeq_of p iff len q = len p & for k st k in dom q holds q.k = p.k * log
  (2,p.k);

theorem 
  for p being nonnegative FinSequence of REAL for k st k in dom p
  holds (p.k = 0 implies (Infor_FinSeq_of p).k = 0) & (p.k > 0 implies (
  Infor_FinSeq_of p).k = p.k * log(2,p.k));

theorem 
  for p being nonnegative FinSequence of REAL for q holds q = -
  Infor_FinSeq_of p iff (len q = len p & for k st k in dom q holds q.k = p.k *
  log(2,1/(p.k)));

theorem 
  for p being nonnegative FinSequence of REAL st r1>=0 & r2>=0
holds for i st i in dom p & p.i = r1*r2 holds (Infor_FinSeq_of p).i = r1*r2*log
  (2,r1) + r1*r2*log(2,r2);

theorem 
  for p being nonnegative FinSequence of REAL st r>=0 holds
  Infor_FinSeq_of (r*p) = (r*log(2,r)*p) + (r*mlt(p,FinSeq_log(2,p)));

theorem 
  for p being non empty ProbFinS FinSequence of REAL for k st k in
  dom p holds (Infor_FinSeq_of p).k <= 0;

definition
  let MR;
  assume
 MR is m-nonnegative;
  func Infor_FinSeq_of MR -> Matrix of REAL means


  len it = len MR &
width it = width MR & for k st k in dom it holds it.k=mlt(Line(MR,k),FinSeq_log
  (2,Line(MR,k)));
end;

theorem 
  for M being m-nonnegative Matrix of REAL for k st k in dom M
  holds Line(Infor_FinSeq_of M,k) = Infor_FinSeq_of Line(M,k);

theorem 
  for M being m-nonnegative Matrix of REAL for M1 being Matrix of
REAL holds M1 = Infor_FinSeq_of M iff len M1 = len M & width M1 = width M & for
  i,j st [i,j] in Indices M1 holds M1*(i,j)=M*(i,j)*log(2,M*(i,j));

definition
  let p being FinSequence of REAL;
  func Entropy p -> Real equals

  -Sum Infor_FinSeq_of p;
end;

theorem 
  for p being non empty ProbFinS FinSequence of REAL holds Entropy p >= 0;

theorem 
  for p being non empty ProbFinS FinSequence of REAL st ex k st k in dom
  p & p.k = 1 holds Entropy p = 0;

theorem 
  for p,q being non empty ProbFinS FinSequence of REAL, pp,qq
being FinSequence of REAL st len p = len q & len pp = len p & len qq = len q &
(for k st k in dom p holds p.k > 0 & q.k > 0 & pp.k=-p.k*log(2,p.k) & qq.k = -p
  .k*log(2,q.k)) holds Sum pp <= Sum qq & ((for k st k in dom p holds p.k=q.k)
  iff Sum pp = Sum qq) & ((ex k st k in dom p & p.k<>q.k) iff Sum pp < Sum qq);

theorem 
  for p being non empty ProbFinS FinSequence of REAL st (for k st k in
  dom p holds p.k>0) holds Entropy p <= log(2,len p) & ((for k st k in dom p
holds p.k=1/(len p)) iff Entropy p=log(2,len p)) & ((ex k st k in dom p & p.k<>
  1/(len p)) iff Entropy p<log(2,len p));

theorem 
  for M being m-nonnegative Matrix of REAL holds Mx2FinS(
  Infor_FinSeq_of M) = Infor_FinSeq_of Mx2FinS(M);

theorem 
  for p,q being ProbFinS FinSequence of REAL for M being Matrix of
  REAL st M=(ColVec2Mx p)*(LineVec2Mx q) holds SumAll Infor_FinSeq_of M = Sum
  Infor_FinSeq_of p+Sum Infor_FinSeq_of q;

definition
  let MR;
  func Entropy_of_Joint_Prob MR -> Real equals

  Entropy Mx2FinS MR;
end;

theorem 
  for p,q being ProbFinS FinSequence of REAL holds Entropy_of_Joint_Prob
  ((ColVec2Mx p) * (LineVec2Mx q)) = Entropy p + Entropy q;

definition
  let MR;
  func Entropy_of_Cond_Prob MR -> FinSequence of REAL means


  len it = len MR & for k st k in dom it holds it.k = Entropy Line(MR,k);
end;

theorem 
  for M being non empty-yielding Conditional_Probability Matrix of
REAL for p being FinSequence of REAL holds p = Entropy_of_Cond_Prob M iff len p
  = len M & for k st k in dom p holds p.k = -Sum ((Infor_FinSeq_of M).k);

theorem 
  for M being non empty-yielding Conditional_Probability Matrix of
  REAL holds Entropy_of_Cond_Prob M = -LineSum Infor_FinSeq_of M;

theorem 
  for p being ProbFinS FinSequence of REAL for M being non
  empty-yielding Conditional_Probability Matrix of REAL st len p = len M holds
  for M1 being Matrix of REAL st M1=(Vec2DiagMx p) * M holds SumAll
Infor_FinSeq_of M1 = Sum Infor_FinSeq_of p + Sum mlt(p,LineSum(Infor_FinSeq_of
  M));

theorem 
  for p being ProbFinS FinSequence of REAL for M being non
  empty-yielding Conditional_Probability Matrix of REAL st len p = len M holds
  Entropy_of_Joint_Prob ((Vec2DiagMx p) * M) = Entropy p + Sum mlt(p,
  Entropy_of_Cond_Prob M);














begin 

reserve x for set;
reserve k, l for Nat;
reserve p, q for FinSequence;

theorem 
  not k in dom p & k + 1 in dom p implies k = 0;

theorem 
  k > len p & k <= len (p^q) implies ex l st k = len p + l & l >= 1
  & l <= len q;



reserve R for Relation;
reserve p, q for RedSequence of R;

theorem 
  k >= 1 implies p | k is RedSequence of R;

theorem 
  k in dom p implies ex q st len q = k & q.1 = p.1 & q.len q = p.k;

begin





definition
  let f be Function;
  attr f is XFinSequence-yielding means


  x in dom f implies f.x is XFinSequence;
end;

registration
  cluster empty -> XFinSequence-yielding for Function;
end;

registration
  let f be XFinSequence;
  cluster <*f*> -> XFinSequence-yielding;
end;

registration
  let p be XFinSequence-yielding Function;
  let x;
  cluster p.x -> finite Function-like Relation-like;
end;

registration
  let p be XFinSequence-yielding Function;
  let x;
  cluster p.x -> T-Sequence-like;
end;

registration
  cluster XFinSequence-yielding for FinSequence;
end;

registration
  let E be set;
  cluster -> XFinSequence-yielding for FinSequence of E^omega;
end;

registration
  let p, q be XFinSequence-yielding FinSequence;
  cluster p^q -> XFinSequence-yielding;
end;

begin




definition
  let s be XFinSequence;
  let p be XFinSequence-yielding Function;
  func s ^+ p -> XFinSequence-yielding Function means


  dom it = dom p & for x st x in dom p holds it.x = s^(p.x);
  func p +^ s -> XFinSequence-yielding Function means


  dom it = dom p & for x st x in dom p holds it.x = (p.x)^s;
end;

registration
  let s be XFinSequence;
  let p be XFinSequence-yielding FinSequence;
  cluster s ^+ p -> FinSequence-like;
  cluster p +^ s -> FinSequence-like;
end;



reserve E for set;
reserve s, t for XFinSequence;
reserve p, q for XFinSequence-yielding FinSequence;

theorem 
  len (s ^+ p) = len p & len(p +^ s) = len p;

theorem 
  <%>E ^+ p = p & p +^ <%>E = p;

theorem 
  s ^+ (t ^+ p) = (s^t) ^+ p & (p +^ t) +^ s = p +^ (t^s);

theorem 
  s ^+ (p +^ t) = (s ^+ p) +^ t;

theorem 
  s ^+ (p^q) = (s ^+ p)^(s ^+ q) & (p^q) +^ s = (p +^ s)^(q +^ s);

begin



definition
  let E be set;
  let p be FinSequence of E^omega;
  let k be Nat;
  redefine func p.k -> Element of E^omega;
end;

definition
  let E be set;
  let s be Element of E^omega;
  let p be FinSequence of E^omega;
  redefine func s ^+ p -> FinSequence of E^omega;
  redefine func p +^ s -> FinSequence of E^omega;
end;



definition
  let E be set;
  mode semi-Thue-system of E is Relation of E^omega;
end;

reserve E for set;
reserve S, T, U for semi-Thue-system of E;

registration
  let S be Relation;
  cluster S \/ S~-> symmetric;
end;

registration
  let E;
  cluster symmetric for semi-Thue-system of E;
end;

definition
  let E be set;
  mode Thue-system of E is symmetric semi-Thue-system of E;
end;

begin



reserve s, t, s1, t1, u, v, u1, v1, w for Element of E^omega;
reserve p for FinSequence of E^omega;

definition
  let E, S, s, t;
  pred s -->. t, S means


  [s, t] in S;
end;

definition
  let E, S, s, t;
  pred s ==>. t, S means


  ex v, w, s1, t1 st s = v^s1^w & t = v^t1^w & s1 -->. t1, S;
end;

theorem 
  s -->. t, S implies s ==>. t, S;

theorem 
  s ==>. s, S implies ex v, w, s1 st s = v^s1^w & s1 -->. s1, S;

theorem 
  s ==>. t, S implies u^s ==>. u^t, S & s^u ==>. t^u, S;

theorem 
  s ==>. t, S implies u^s^v ==>. u^t^v, S;

theorem 
  s -->. t, S implies u^s ==>. u^t, S & s^u ==>. t^u, S;

theorem 
  s -->. t, S implies u^s^v ==>. u^t^v, S;

theorem 
  S is Thue-system of E & s -->. t, S implies t -->. s, S;

theorem 
  S is Thue-system of E & s ==>. t, S implies t ==>. s, S;

theorem 
  S c= T & s -->. t, S implies s -->.t, T;

theorem 
  S c= T & s ==>. t, S implies s ==>.t, T;

theorem 
  not s ==>. t, {}(E^omega, E^omega);

theorem 
  s ==>. t, S \/ T implies s ==>. t, S or s ==>. t, T;

begin




definition
  let E;
  redefine func id E -> Relation of E;
end;

definition
  let E, S;
  func ==>.-relation(S) -> Relation of E^omega means


  [s, t] in it iff s ==>. t, S;
end;

theorem 
  S c= ==>.-relation(S);

theorem 
  p is RedSequence of ==>.-relation(S) implies p +^ u is
  RedSequence of ==>.-relation(S) & u ^+ p is RedSequence of ==>.-relation(S);

theorem 
  p is RedSequence of ==>.-relation(S) implies t ^+ p +^ u is
  RedSequence of ==>.-relation(S);

theorem 
  S is Thue-system of E implies ==>.-relation(S) = (==>.-relation( S))~;

theorem 
  S c= T implies ==>.-relation(S) c= ==>.-relation(T);

theorem 
  ==>.-relation(id (E^omega)) = id (E^omega);

theorem 
  ==>.-relation(S \/ id (E^omega)) = ==>.-relation(S) \/ id (E ^omega);

theorem 
  ==>.-relation({}(E^omega, E^omega)) = {}(E^omega, E^omega);

theorem 
  s ==>. t, ==>.-relation(S) implies s ==>. t, S;

theorem 
  ==>.-relation(==>.-relation(S)) = ==>.-relation(S);

begin 

definition
  let E, S, s, t;
  pred s ==>* t, S means


  ==>.-relation(S) reduces s, t;
end;

theorem 
  s ==>* s, S;

theorem 
  s ==>. t, S implies s ==>* t, S;

theorem 
  s -->. t, S implies s ==>* t, S;

theorem 
  s ==>* t, S & t ==>* u, S implies s ==>* u, S;

theorem 
  s ==>* t, S implies s^u ==>* t^u, S & u^s ==>* u^t, S;

theorem 
  s ==>* t, S implies u^s^v ==>* u^t^v, S;

theorem 
  s ==>* t, S & u ==>* v, S implies s^u ==>* t^v, S & u^s ==>* v^t, S;

theorem 
  S is Thue-system of E & s ==>* t, S implies t ==>* s, S;

theorem 
  S c= T & s ==>* t, S implies s ==>* t, T;

theorem 
  s ==>* t, S iff s ==>* t, S \/ id (E^omega);

theorem 
  s ==>* t, {}(E^omega, E^omega) implies s = t;

theorem 
  s ==>* t, ==>.-relation(S) implies s ==>* t, S;

theorem 
  s ==>* t, S & u ==>. v, {[s, t]} implies u ==>* v, S;

theorem 
  s ==>* t, S & u ==>* v, S \/ {[s, t]} implies u ==>* v, S;

begin 

definition
  let E, S, w;
  func Lang(w, S) -> Subset of E^omega equals

  { s : w ==>* s, S };
end;

theorem 
  s in Lang(w, S) iff w ==>* s, S;

theorem 
  w in Lang(w, S);

registration
  let E be non empty set;
  let S be semi-Thue-system of E;
  let w be Element of E^omega;
  cluster Lang(w, S) -> non empty;
end;

theorem 
  S c= T implies Lang(w, S) c= Lang(w, T);

theorem 
  Lang(w, S) = Lang(w, S \/ id (E^omega));

theorem 
  Lang(w, {}(E^omega, E^omega)) = {w};

theorem 
  Lang(w, id (E^omega)) = {w};

begin 

definition
  let E, S, T, w;
  pred S, T are_equivalent_wrt w means


  Lang(w, S) = Lang(w, T);
end;

theorem 
  S, S are_equivalent_wrt w;

theorem 
  S, T are_equivalent_wrt w implies T, S are_equivalent_wrt w;

theorem 
  S, T are_equivalent_wrt w & T, U are_equivalent_wrt w implies S, U
  are_equivalent_wrt w;

theorem 
  S, S \/ id (E^omega) are_equivalent_wrt w;

theorem 
  S, T are_equivalent_wrt w & S c= U & U c= T implies S, U
  are_equivalent_wrt w & U, T are_equivalent_wrt w;

theorem 
  S, ==>.-relation(S) are_equivalent_wrt w;

theorem 
  S, T are_equivalent_wrt w & ==>.-relation(S \/ T) reduces w, s
  implies ==>.-relation(S) reduces w, s;

theorem 
  S, T are_equivalent_wrt w & w ==>* s, S \/ T implies w ==>* s, S;

theorem 
  S, T are_equivalent_wrt w implies S, S \/ T are_equivalent_wrt w;

theorem 
  s ==>. t, S implies S, (S \/ {[s, t]}) are_equivalent_wrt w;

theorem 
  s ==>* t, S implies S, (S \/ {[s, t]}) are_equivalent_wrt w;














begin 

definition
  let X be TopSpace, P be Subset-Family of X;
  attr P is compact means


  for U being Subset of X st U in P holds U is compact;
end;

definition
  let X be TopSpace, U be Subset of X;
  attr U is relatively-compact means


  Cl U is compact;
end;

registration
  let X be TopSpace;
  cluster empty -> relatively-compact for Subset of X;
end;

registration
  let T be TopSpace;
  cluster relatively-compact for Subset of T;
end;

registration
  let X be TopSpace, U be relatively-compact Subset of X;
  cluster Cl U -> compact;
end;

notation
  let X be TopSpace, U be Subset of X;
  synonym U is pre-compact for U is relatively-compact;
end;



notation
  let X be non empty TopSpace;
  synonym X is liminally-compact for X is locally-compact;
end;



definition
  let X be non empty TopSpace;
  redefine attr X is liminally-compact means


  for x being Point of X ex B being basis of x st B is compact;
end;

definition
  let X be non empty TopSpace;
  attr X is locally-relatively-compact means


  for x being Point of X ex
  U being a_neighborhood of x st U is relatively-compact;
end;

definition
  let X be non empty TopSpace;
  attr X is locally-closed/compact means


  for x being Point of X ex U being a_neighborhood of x st U is closed compact;
end;

definition
  let X be non empty TopSpace;
  attr X is locally-compact means


  for x being Point of X ex U being a_neighborhood of x st U is compact;
end;

registration
  cluster liminally-compact -> locally-compact for non empty TopSpace;
end;

registration
  cluster locally-compact -> liminally-compact for
non empty regular TopSpace;
end;

registration
  cluster locally-relatively-compact -> locally-closed/compact for non empty
    TopSpace;
end;

registration
  cluster locally-closed/compact -> locally-relatively-compact for non empty
    TopSpace;
end;

registration
  cluster locally-relatively-compact -> locally-compact for
non empty TopSpace;
end;

registration
  cluster locally-compact -> locally-relatively-compact for
non empty Hausdorff
    TopSpace;
end;

registration
  cluster compact -> locally-compact for non empty TopSpace;
end;

registration
  cluster discrete -> locally-compact for non empty TopSpace;
end;

registration
  cluster discrete non empty for TopSpace;
end;

registration
  let X be locally-compact non empty TopSpace, C be closed non empty Subset
  of X;
  cluster X | C -> locally-compact;
end;

registration
  let X be locally-compact non empty regular TopSpace, P be open non empty
  Subset of X;
  cluster X | P -> locally-compact;
end;

theorem 
  for X being Hausdorff non empty TopSpace, E being non empty Subset of
  X st X|E is dense locally-compact holds X|E is open;

theorem 
  for X,Y being TopSpace, A being Subset of X st [#]X c= [#]Y holds
  incl(X,Y).:A = A;

definition
  let X,Y be TopSpace, f be Function of X,Y;
  attr f is embedding means

  ex h being Function of X, Y | (rng f) st h = f & h is being_homeomorphism;
end;

theorem 
  for X,Y being TopSpace st [#]X c= [#]Y & ex Xy being Subset of Y
  st Xy = [#]X & the topology of Y|Xy = the topology of X holds incl(X,Y) is
  embedding;

definition
  let X be TopSpace, Y be TopSpace, h be Function of X,Y;
  attr h is compactification means


  h is embedding & Y is compact & h.:( [#]X) is dense;
end;

registration
  let X be TopSpace, Y be TopSpace;
  cluster compactification -> embedding for Function of X,Y;
end;

definition
  let X be TopStruct;
  func One-Point_Compactification(X) -> strict TopStruct means


  the
carrier of it = succ([#]X) & the topology of it = (the topology of X) \/ {U \/
  {[#]X} where U is Subset of X: U is open & U` is compact};
end;

registration
  let X be TopStruct;
  cluster One-Point_Compactification(X) -> non empty;
end;

theorem 
  for X being TopStruct holds [#]X c= [#]One-Point_Compactification (X);

registration
  let X be TopSpace;
  cluster One-Point_Compactification(X) -> TopSpace-like;
end;

theorem 
  for X being TopStruct holds X is SubSpace of One-Point_Compactification(X);

registration
  let X be TopSpace;
  cluster One-Point_Compactification(X) -> compact;
end;

theorem 
  for X being non empty TopSpace holds X is Hausdorff locally-compact
  iff One-Point_Compactification(X) is Hausdorff;

theorem 
  for X being non empty TopSpace holds X is non compact iff ex X9
  being Subset of One-Point_Compactification(X) st X9 = [#]X & X9 is dense;

theorem 
  for X being non empty TopSpace st X is non compact holds incl(X,
  One-Point_Compactification X) is compactification;














begin 

reserve X for BCI-algebra;
reserve I for Ideal of X;
reserve a,x,y,z,u for Element of X;
reserve f,f9,g for Function of NAT, the carrier of X;
reserve j,i,k,n,m for Element of NAT;




definition
  let X,x,y;
  let n be Element of NAT;
  func (x,y) to_power n -> Element of X means


  ex f st it = f.n & f.0 =
  x & for j being Element of NAT st j<n holds f.(j+1) = f.j\y;
end;

theorem 
  (x,y) to_power 0 = x;

theorem 
  (x,y) to_power 1 = x\y;

theorem 
  (x,y) to_power 2 = x\y\y;

theorem 
  (x,y) to_power (n+1) = (x,y) to_power n \ y;

theorem 
  (x,0.X) to_power (n+1) = x;

theorem 
  (0.X,0.X) to_power n=0.X;

theorem 
  (x,y) to_power n\z = (x\z,y) to_power n;

theorem 
  (x,x\(x\y)) to_power n = (x,y) to_power n;

theorem 
  ((0.X,x) to_power n)` = (0.X,x`) to_power n;

theorem 
  ((x,y) to_power n,y) to_power m =(x,y) to_power (n+m);

theorem 
  ((x,y) to_power n,z) to_power m =((x,z) to_power m,y)to_power n;

theorem 
  ((0.X,x) to_power n)``=(0.X,x) to_power n;

theorem 
  (0.X,x)to_power (n+m)=((0.X,x)to_power n)\((0.X,x)to_power m)`;

theorem 
  ((0.X,x) to_power (m+n))` = ((0.X,x)to_power m)`\(0.X,x)to_power n;

theorem 
  ((0.X,(0.X,x)to_power m)to_power n)`=(0.X,x)to_power (m*n);

theorem 
  (0.X,x)to_power m=0.X implies(0.X,x)to_power (m*n)=0.X;

theorem 
  x\y=x implies (x,y) to_power n = x;

theorem 
  (0.X,x\y) to_power n=((0.X,x) to_power n)\((0.X,y) to_power n);



theorem 
  x<=y implies (x,z) to_power n <= (y,z) to_power n;

theorem 
  x<=y implies (z,y) to_power n <= (z,x) to_power n;

theorem 
  ((x,z) to_power n)\((y,z) to_power n) <= x\y;

theorem 
  (((x,x\y) to_power n),y\x) to_power n <= x;

notation
  let X,a;
  synonym a is minimal for a is atom;
end;



definition
  let X,a;
  attr a is positive means


  0.X <= a;
  attr a is least means

  for x holds a<=x;
  attr a is maximal means


  for x holds a<=x implies x=a;
  attr a is greatest means


  for x holds x<=a;
end;

registration
  let X;
  cluster positive for Element of X;
end;

registration
  let X;
  cluster 0.X -> positive minimal;
end;

theorem 
  a is minimal iff for x holds a\x=x`\a`;

theorem 
  x` is minimal iff for y holds y<=x implies x` = y`;

theorem 
  x` is minimal iff for y,z holds (((x\z)\(y\z))`)` = y`\x`;

theorem 
  0.X is maximal implies for a holds a is minimal;

theorem 
  (ex x st x is greatest) implies for a holds a is positive;

theorem 
  x\(x``) is positive Element of X;

theorem 
  a is minimal iff a`` = a;

theorem 
  a is minimal iff ex x st a=x`;



definition
  let X,x;
  attr x is nilpotent means


  ex k being non empty Element of NAT st (0.X ,x) to_power k = 0.X;
end;

definition
  let X;
  attr X is nilpotent means

  for x being Element of X holds x is nilpotent;
end;

definition
  let X,x;
  assume
 x is nilpotent;
  func ord x -> non empty Element of NAT means


  (0.X,x) to_power it = 0.
X & for m being Element of NAT st (0.X,x) to_power m=0.X & m <> 0 holds it <= m
  ;
end;

registration
  let X;
  cluster 0.X -> nilpotent;
end;

theorem 
  x is positive Element of X iff x is nilpotent & ord x=1;

theorem 
  X is BCK-algebra iff for x holds ord x=1 & x is nilpotent;

theorem 
  (0.X,x`) to_power n is minimal;

theorem 
  x is nilpotent implies ord x = ord (x`);

begin 

definition
  let X be BCI-algebra;
  mode Congruence of X -> Equivalence_Relation of X means


    for x,y,u,v
    being Element of X st [x,y] in it & [u,v] in it holds [x\u,y\v] in it;
end;



definition
  let X be BCI-algebra;
  mode L-congruence of X -> Equivalence_Relation of X means


    for x,y
being Element of X st [x,y] in it holds for u being Element of X holds [u\x,u\y
    ] in it;
end;



definition
  let X be BCI-algebra;
  mode R-congruence of X -> Equivalence_Relation of X means


    for x,y
being Element of X st [x,y] in it holds for u being Element of X holds [x\u,y\u
    ] in it;
end;



definition
  let X be BCI-algebra,A be Ideal of X;
  mode I-congruence of X,A -> Relation of X means


    for x,y being Element of X holds [x,y] in it iff x\y in A & y\x in A;
end;

registration
  let X be BCI-algebra, A be Ideal of X;
  cluster -> total symmetric transitive for I-congruence of X,A;
end;

definition
  let X be BCI-algebra;
  func IConSet(X) means


  for A1 being set holds A1 in it iff ex I being
  Ideal of X st A1 is I-congruence of X,I;
end;

definition
  let X be BCI-algebra;
  func ConSet(X) equals

  {R where R is Congruence of X:not contradiction};
  func LConSet(X) equals

  {R where R is L-congruence of X:not contradiction};
  func RConSet(X) equals

  {R where R is R-congruence of X:not contradiction};
end;

reserve R for Equivalence_Relation of X;
reserve RI for I-congruence of X,I;
reserve E for Congruence of X;
reserve RC for R-congruence of X;
reserve LC for L-congruence of X;



theorem 
  for X,E holds Class(E,0.X) is closed Ideal of X;

theorem 
  R is Congruence of X iff R is R-congruence of X&R is L-congruence of X;

theorem 
  RI is Congruence of X;

definition
  let X be BCI-algebra, I be Ideal of X;
  redefine mode I-congruence of X,I -> Congruence of X;
end;

theorem 
  Class(RI,0.X) c= I;

theorem 
  I is closed iff I = Class(RI,0.X);

theorem 
  [x,y] in E implies x\y in Class(E,0.X) & y\x in Class(E,0.X);

theorem 
  for A,I being Ideal of X,IA being I-congruence of X,A, II being
  I-congruence of X,I st Class(IA,0.X)=Class(II,0.X) holds IA = II;

theorem 
  [x,y] in E & u in Class(E,0.X) implies [x,(y,u)to_power k] in E;

theorem 
  (for X,x,y holds ex i,j,m,n st ((x,x\y) to_power i,y\x) to_power j = (
(y,y\x)to_power m,x\y) to_power n) implies for E,I st I=Class(E,0.X) holds E is
  I-congruence of X,I;

theorem 
  IConSet(X) c= ConSet(X);

theorem 
  ConSet(X) c= LConSet(X);

theorem 
  ConSet(X) c= RConSet(X);

theorem 
  ConSet(X) = LConSet(X)/\RConSet(X);

theorem 
  (for LC holds LC is I-congruence of X,I) implies E = RI;

theorem 
  (for RC holds RC is I-congruence of X,I) implies E = RI;

theorem 
  Class(LC,0.X) is closed Ideal of X;



reserve E for Congruence of X;
reserve RI for I-congruence of X,I;

registration
  let X,E;
  cluster Class E -> non empty;
end;

definition
  let X,E;
  func EqClaOp E -> BinOp of Class E means


  for W1,W2 being Element of
Class(E) for x,y st W1=Class(E,x) & W2=Class(E,y) holds it.(W1,W2)=Class(E,x\y)
  ;
end;

definition
  let X,E;
  func zeroEqC(E) -> Element of Class E equals

  Class(E,0.X);
end;



definition
  let X,E;
  func X./.E -> BCIStr_0 equals

  BCIStr_0(#Class E,EqClaOp E,zeroEqC(E)#);
end;

registration
  let X;
  let E be Congruence of X;
  cluster X./.E -> non empty;
end;

reserve W1,W2 for Element of Class E;

definition
  let X,E,W1,W2;
  func W1\W2 -> Element of Class E equals

  (EqClaOp E).(W1,W2);
end;

theorem 
  X./.RI is BCI-algebra;

registration
  let X,I,RI;
  cluster X./.RI -> strict being_B being_C being_I being_BCI-4;
end;

theorem 
  for X,I st I = BCK-part(X) holds for RI being I-congruence of X,I
  holds X./.RI is p-Semisimple BCI-algebra;














begin

definition
  let R1, R2 be set, R be Relation of R1,R2;
  redefine func field R -> Subset of R1 \/ R2;
end;

definition
  let R1, R2, S1, S2 be set;
  let R be Relation of R1,R2;
  let S be Relation of S1,S2;
  redefine func R \/ S -> Relation of R1 \/ S1, R2 \/ S2;
end;

registration
  let R1, S1 be set;
  let R being total Relation of R1;
  let S being total Relation of S1;
  cluster R \/ S -> total for Relation of R1 \/ S1;
end;

registration
  let R1, S1 be set;
  let R being reflexive Relation of R1;
  let S being reflexive Relation of S1;
  cluster R \/ S -> reflexive for Relation of R1 \/ S1;
end;

registration
  let R1, S1 be set;
  let R being symmetric Relation of R1;
  let S being symmetric Relation of S1;
  cluster R \/ S -> symmetric for Relation of R1 \/ S1;
end;

theorem 
  for R1, S1 being set, R being transitive (Relation of R1),
  S being transitive Relation of S1 st R1 misses S1 holds R \/ S is transitive;

definition
  let I be non empty set, C be 1-sorted-yielding ManySortedSet of I;
  redefine func Carrier C means


  for i being Element of I holds it.i = the carrier of C.i;
end;

definition
  let R1, R2, S1, S2 be set;
  let R be Relation of R1,R2, S be Relation of S1,S2;
  func [^R,S^] -> Relation of [:R1,S1:],[:R2,S2:] means


  for x, y being set holds [x,y] in it iff
  ex r1, s1, r2, s2 being set st x = [r1,s1] & y = [r2,s2] &
  r1 in R1 & s1 in S1 & r2 in R2 & s2 in S2 & ([r1,r2] in R or [s1,s2] in S);
end;

definition
  let R1, R2, S1, S2 be non empty set;
  let R be Relation of R1,R2, S be Relation of S1,S2;
  redefine func [^R,S^] means


  for r1 being Element of R1, r2 being Element of R2
  for s1 being Element of S1, s2 being Element of S2 holds
  [[r1,s1],[r2,s2]] in it iff [r1,r2] in R or [s1,s2] in S;
end;

registration
  let R1, S1 be set;
  let R be total Relation of R1;
  let S be total Relation of S1;
  cluster [^R,S^] -> total;
end;

registration
  let R1, S1 be set;
  let R be reflexive Relation of R1;
  let S be reflexive Relation of S1;
  cluster [^R,S^] -> reflexive;
end;

registration
  let R1, S1 be set;
  let R be Relation of R1;
  let S be total reflexive Relation of S1;
  cluster [^R,S^] -> reflexive;
end;

registration
  let R1, S1 be set;
  let R be total reflexive Relation of R1;
  let S be Relation of S1;
  cluster [^R,S^] -> reflexive;
end;

registration
  let R1, S1 be set;
  let R be symmetric Relation of R1;
  let S be symmetric Relation of S1;
  cluster [^R,S^] -> symmetric;
end;

begin 

registration
  cluster empty -> total for RelStr;
end;

definition
  let R be Relation;
  attr R is transitive-yielding means


  for S being RelStr st S in rng R holds S is transitive;
end;

registration
  cluster Poset-yielding -> transitive-yielding for Relation;
end;

registration
  cluster Poset-yielding for Function;
end;

registration
  let I be set;
  cluster Poset-yielding for ManySortedSet of I;
end;

definition
  let I be set, C be RelStr-yielding ManySortedSet of I;
  func pcs-InternalRels C -> ManySortedSet of I means


  for i being set st i in I
  ex P being RelStr st P = C.i & it.i = the InternalRel of P;
end;

definition
  let I be non empty set, C be RelStr-yielding ManySortedSet of I;
  redefine func pcs-InternalRels C means


  for i being Element of I holds it.i = the InternalRel of C.i;
end;

registration
  let I be set, C be RelStr-yielding ManySortedSet of I;
  cluster pcs-InternalRels C -> Relation-yielding;
end;

registration
  let I be non empty set;
  let C be transitive-yielding RelStr-yielding ManySortedSet of I;
  let i be Element of I;
  cluster C.i -> transitive for RelStr;
end;

begin 

definition
  struct (1-sorted) TolStr (# carrier -> set,
    ToleranceRel -> Relation of the carrier #);
end;

definition
  let P be TolStr;
  let p, q be Element of P;
  pred p (--) q means


  [p,q] in the ToleranceRel of P;
end;

definition
  let P be TolStr;
  attr P is pcs-tol-total means


  the ToleranceRel of P is total;
  attr P is pcs-tol-reflexive means


  the ToleranceRel of P is_reflexive_in the carrier of P;
  attr P is pcs-tol-irreflexive means


  the ToleranceRel of P is_irreflexive_in the carrier of P;
  attr P is pcs-tol-symmetric means


  the ToleranceRel of P is_symmetric_in the carrier of P;
end;

definition
  func emptyTolStr -> TolStr equals

  TolStr (# {}, {}({},{}) #);
end;

registration
  cluster emptyTolStr -> empty strict;
end;

theorem 
  for P being TolStr st P is empty holds the TolStr of P = emptyTolStr;

registration
  cluster pcs-tol-reflexive -> pcs-tol-total for TolStr;
end;

registration
  cluster empty -> pcs-tol-reflexive pcs-tol-irreflexive pcs-tol-symmetric
    for TolStr;
end;

registration
  cluster empty strict for TolStr;
end;

registration
  let P be pcs-tol-total TolStr;
  cluster the ToleranceRel of P -> total;
end;

registration
  let P be pcs-tol-reflexive TolStr;
  cluster the ToleranceRel of P -> reflexive;
end;

registration
  let P be pcs-tol-irreflexive TolStr;
  cluster the ToleranceRel of P -> irreflexive;
end;

registration
  let P be pcs-tol-symmetric TolStr;
  cluster the ToleranceRel of P -> symmetric;
end;

registration
  let L be pcs-tol-total TolStr;
  cluster the TolStr of L -> pcs-tol-total;
end;

definition
  let P be pcs-tol-symmetric TolStr;
  let p, q be Element of P;
  redefine pred p (--) q;
  symmetry;
end;

registration
  let D be set;
  cluster TolStr(#D,nabla D#) -> pcs-tol-reflexive pcs-tol-symmetric;
end;

registration
  let D be set;
  cluster TolStr(#D,{}(D,D)#) -> pcs-tol-irreflexive pcs-tol-symmetric;
end;

registration
  cluster strict non empty pcs-tol-reflexive pcs-tol-symmetric for TolStr;
end;

registration
  cluster strict non empty pcs-tol-irreflexive pcs-tol-symmetric for TolStr;
end;

definition
  let R be Relation;
  attr R is TolStr-yielding means


  for P being set st P in rng R holds P is TolStr;
end;

definition
  let f be Function;
  redefine attr f is TolStr-yielding means


  for x being set st x in dom f holds f.x is TolStr;
end;

definition
  let I be set, f be ManySortedSet of I;
  redefine attr f is TolStr-yielding means

  for x being set st x in I holds f.x is TolStr;
end;

definition
  let R be Relation;
  attr R is pcs-tol-reflexive-yielding means


  for S being TolStr st S in rng R holds S is pcs-tol-reflexive;
  attr R is pcs-tol-irreflexive-yielding means


  for S being TolStr st S in rng R holds S is pcs-tol-irreflexive;
  attr R is pcs-tol-symmetric-yielding means


  for S being TolStr st S in rng R holds S is pcs-tol-symmetric;
end;

registration
  cluster empty -> pcs-tol-reflexive-yielding pcs-tol-irreflexive-yielding
    pcs-tol-symmetric-yielding for Relation;
end;

registration
  let I be set, P be TolStr;
  cluster I --> P -> TolStr-yielding for ManySortedSet of I;
end;

registration
  let I be set, P be pcs-tol-reflexive TolStr;
  cluster I --> P -> pcs-tol-reflexive-yielding for ManySortedSet of I;
end;

registration
  let I be set, P be pcs-tol-irreflexive TolStr;
  cluster I --> P -> pcs-tol-irreflexive-yielding for ManySortedSet of I;
end;

registration
  let I be set, P be pcs-tol-symmetric TolStr;
  cluster I --> P -> pcs-tol-symmetric-yielding for ManySortedSet of I;
end;

registration
  cluster TolStr-yielding -> 1-sorted-yielding for Function;
end;

registration
  let I be set;
  cluster pcs-tol-reflexive-yielding pcs-tol-symmetric-yielding TolStr-yielding
    for ManySortedSet of I;
end;

registration
  let I be set;
  cluster pcs-tol-irreflexive-yielding pcs-tol-symmetric-yielding
    TolStr-yielding for ManySortedSet of I;
end;

registration
  let I be set;
  cluster TolStr-yielding for ManySortedSet of I;
end;

definition
  let I be non empty set, C be TolStr-yielding ManySortedSet of I,
  i be Element of I;
  redefine func C.i -> TolStr;
end;

definition
  let I be set, C be TolStr-yielding ManySortedSet of I;
  func pcs-ToleranceRels C -> ManySortedSet of I means


  for i being set st i in I
  ex P being TolStr st P = C.i & it.i = the ToleranceRel of P;
end;

definition
  let I be non empty set, C be TolStr-yielding ManySortedSet of I;
  redefine func pcs-ToleranceRels C means


  for i being Element of I holds it.i = the ToleranceRel of C.i;
end;

registration
  let I be set, C be TolStr-yielding ManySortedSet of I;
  cluster pcs-ToleranceRels C -> Relation-yielding;
end;

registration
  let I be non empty set;
  let C be pcs-tol-reflexive-yielding TolStr-yielding ManySortedSet of I;
  let i be Element of I;
  cluster C.i -> pcs-tol-reflexive for TolStr;
end;

registration
  let I be non empty set;
  let C be pcs-tol-irreflexive-yielding TolStr-yielding ManySortedSet of I;
  let i be Element of I;
  cluster C.i -> pcs-tol-irreflexive for TolStr;
end;

registration
  let I be non empty set;
  let C be pcs-tol-symmetric-yielding TolStr-yielding ManySortedSet of I;
  let i be Element of I;
  cluster C.i -> pcs-tol-symmetric for TolStr;
end;

theorem 
  for P, Q being TolStr st the TolStr of P = the TolStr of Q &
  P is pcs-tol-reflexive holds Q is pcs-tol-reflexive;

theorem 
  for P, Q being TolStr st the TolStr of P = the TolStr of Q &
  P is pcs-tol-irreflexive holds Q is pcs-tol-irreflexive;

theorem 
  for P, Q being TolStr st the TolStr of P = the TolStr of Q &
  P is pcs-tol-symmetric holds Q is pcs-tol-symmetric;

definition
  let P, Q be TolStr;
  func [^P,Q^] -> TolStr equals

  TolStr (# [: the carrier of P, the carrier of Q :],
    [^ the ToleranceRel of P, the ToleranceRel of Q ^] #);
end;

notation
  let P, Q be TolStr, p be Element of P, q be Element of Q;
  synonym [^p,q^] for [p,q];
end;

definition
  let P, Q be non empty TolStr, p be Element of P, q be Element of Q;
  redefine func [^p,q^] -> Element of [^P,Q^];
end;

notation
  let P, Q be TolStr, p be Element of [^P,Q^];
  synonym p^`1 for p`1;
  synonym p^`2 for p`2;
end;

definition
  let P, Q be non empty TolStr, p be Element of [^P,Q^];
  redefine func p^`1 -> Element of P;
  redefine func p^`2 -> Element of Q;
end;

theorem 
  for S1, S2 being non empty TolStr
  for a, c being Element of S1, b, d being Element of S2 holds
  [^a,b^] (--) [^c,d^] iff a (--) c or b (--) d;

theorem 
  for S1, S2 being non empty TolStr, x, y being Element of [^S1,S2^] holds
  x (--) y iff x^`1 (--) y^`1 or x^`2 (--) y^`2;

registration
  let P be TolStr, Q be pcs-tol-reflexive TolStr;
  cluster [^P,Q^] -> pcs-tol-reflexive;
end;

registration
  let P be pcs-tol-reflexive TolStr, Q be TolStr;
  cluster [^P,Q^] -> pcs-tol-reflexive;
end;

registration
  let P, Q be pcs-tol-symmetric TolStr;
  cluster [^P,Q^] -> pcs-tol-symmetric;
end;

begin 

definition
  struct (RelStr,TolStr) pcs-Str (# carrier -> set,
    InternalRel -> (Relation of the carrier),
    ToleranceRel -> Relation of the carrier #);
end;

definition
  let P be pcs-Str;
  attr P is pcs-compatible means


  for p, p9, q, q9 being Element of P st
  p (--) q & p9 <= p & q9 <= q holds p9 (--) q9;
end;

definition
  let P be pcs-Str;
  attr P is pcs-like means


  P is reflexive transitive pcs-tol-reflexive pcs-tol-symmetric pcs-compatible;
  attr P is anti-pcs-like means


  P is reflexive transitive pcs-tol-irreflexive pcs-tol-symmetric
  pcs-compatible;
end;

registration
  cluster pcs-like -> reflexive transitive pcs-tol-reflexive pcs-tol-symmetric
    pcs-compatible for pcs-Str;
  cluster reflexive transitive pcs-tol-reflexive pcs-tol-symmetric
    pcs-compatible -> pcs-like for pcs-Str;
  cluster anti-pcs-like -> reflexive transitive pcs-tol-irreflexive
    pcs-tol-symmetric pcs-compatible for pcs-Str;
  cluster reflexive transitive pcs-tol-irreflexive pcs-tol-symmetric
    pcs-compatible -> anti-pcs-like for pcs-Str;
end;

definition
  let D be set;
  func pcs-total D -> pcs-Str equals

  pcs-Str (# D,nabla D,nabla D #);
end;

registration
  let D be set;
  cluster pcs-total D -> strict;
end;

registration
  let D be non empty set;
  cluster pcs-total D -> non empty;
end;

registration
  let D be set;
  cluster pcs-total D -> reflexive transitive
    pcs-tol-reflexive pcs-tol-symmetric;
end;

registration
  let D be set;
  cluster pcs-total D -> pcs-like;
end;

registration
  let D be set;
  cluster pcs-Str(#D,nabla D,{}(D,D)#) -> anti-pcs-like;
end;

registration
  cluster strict non empty pcs-like for pcs-Str;
  cluster strict non empty anti-pcs-like for pcs-Str;
end;

definition
  mode pcs is pcs-like pcs-Str;
  mode anti-pcs is anti-pcs-like pcs-Str;
end;

definition
  func pcs-empty -> pcs-Str equals

  pcs-total 0;
end;

registration
  cluster pcs-empty -> strict empty pcs-like;
end;

definition
  let p be set;
  func pcs-singleton p -> pcs-Str equals

  pcs-total {p};
end;

registration
  let p be set;
  cluster pcs-singleton p -> strict non empty pcs-like;
end;

definition
  let R be Relation;
  attr R is pcs-Str-yielding means


  for P being set st P in rng R holds P is pcs-Str;
  attr R is pcs-yielding means


  for P being set st P in rng R holds P is pcs;
end;

definition
  let f be Function;
  redefine attr f is pcs-Str-yielding means


  for x being set st x in dom f holds f.x is pcs-Str;
  redefine attr f is pcs-yielding means


  for x being set st x in dom f holds f.x is pcs;
end;

definition
  let I be set, f be ManySortedSet of I;
  redefine attr f is pcs-Str-yielding means


  for x being set st x in I holds f.x is pcs-Str;
  redefine attr f is pcs-yielding means


  for x being set st x in I holds f.x is pcs;
end;

registration
  cluster pcs-Str-yielding -> TolStr-yielding RelStr-yielding for Relation;
  cluster pcs-yielding -> pcs-Str-yielding for Relation;
  cluster pcs-yielding -> reflexive-yielding transitive-yielding
    pcs-tol-reflexive-yielding pcs-tol-symmetric-yielding for Relation;
end;

registration
  let I be set, P be pcs;
  cluster I --> P -> pcs-yielding for ManySortedSet of I;
end;

registration
  let I be set;
  cluster pcs-yielding for ManySortedSet of I;
end;

definition
  let I be non empty set, C be pcs-Str-yielding ManySortedSet of I,
  i be Element of I;
  redefine func C.i -> pcs-Str;
end;

definition
  let I be non empty set, C be pcs-yielding ManySortedSet of I,
  i be Element of I;
  redefine func C.i -> pcs;
end;



definition
  let P, Q be pcs-Str;
  pred P c= Q means


  the carrier of P c= the carrier of Q &
  the InternalRel of P c= the InternalRel of Q &
  the ToleranceRel of P c= the ToleranceRel of Q;
  reflexivity;
end;

theorem 
  for P, Q being RelStr
  for p, q being Element of P, p1, q1 being Element of Q st
  the InternalRel of P c= the InternalRel of Q & p = p1 & q = q1 & p <= q
  holds p1 <= q1;

theorem 
  for P, Q being TolStr
  for p, q being Element of P, p1, q1 being Element of Q st
  the ToleranceRel of P c= the ToleranceRel of Q & p = p1 & q = q1 & p (--) q
  holds p1 (--) q1;

definition
  let C be Relation;
  attr C is pcs-chain-like means


  for P, Q being pcs-Str st P in rng C & Q in rng C holds P c= Q or Q c= P;
end;

registration
  let I be set, P be pcs-Str;
  cluster I --> P -> pcs-chain-like for ManySortedSet of I;
end;

registration
  cluster pcs-chain-like pcs-yielding for Function;
end;

registration
  let I be set;
  cluster pcs-chain-like pcs-yielding for ManySortedSet of I;
end;

definition
  let I be set;
  mode pcs-Chain of I is pcs-chain-like pcs-yielding ManySortedSet of I;
end;

definition
  let I be set, C be pcs-Str-yielding ManySortedSet of I;
  func pcs-union C -> strict pcs-Str means


  the carrier of it = Union Carrier C &
  the InternalRel of it = Union pcs-InternalRels C &
  the ToleranceRel of it = Union pcs-ToleranceRels C;
end;

theorem 
  for I being set, C being pcs-Str-yielding ManySortedSet of I
  for p, q being Element of pcs-union C holds p <= q iff
  ex i being set, P being pcs-Str, p9, q9 being Element of P st
  i in I & P = C.i & p9 = p & q9 = q & p9 <= q9;

theorem 
  for I being non empty set, C being pcs-Str-yielding ManySortedSet of I
  for p, q being Element of pcs-union C holds p <= q iff
  ex i being Element of I, p9, q9 being Element of C.i st
  p9 = p & q9 = q & p9 <= q9;

theorem 
  for I being set, C being pcs-Str-yielding ManySortedSet of I
  for p, q being Element of pcs-union C holds p (--) q iff
  ex i being set, P being pcs-Str, p9, q9 being Element of P st
  i in I & P = C.i & p9 = p & q9 = q & p9 (--) q9;

theorem 
  for I being non empty set, C being pcs-Str-yielding ManySortedSet of I
  for p, q being Element of pcs-union C holds p (--) q iff
  ex i being Element of I, p9, q9 being Element of C.i st
  p9 = p & q9 = q & p9 (--) q9;

registration
  let I be set, C be reflexive-yielding pcs-Str-yielding ManySortedSet of I;
  cluster pcs-union C -> reflexive;
end;

registration
  let I be set,
  C be pcs-tol-reflexive-yielding pcs-Str-yielding ManySortedSet of I;
  cluster pcs-union C -> pcs-tol-reflexive;
end;

registration
  let I be set,
  C be pcs-tol-symmetric-yielding pcs-Str-yielding ManySortedSet of I;
  cluster pcs-union C -> pcs-tol-symmetric;
end;

registration
  let I be set, C be pcs-Chain of I;
  cluster pcs-union C -> transitive pcs-compatible;
end;



registration
  let p, q be set;
  cluster <%p,q%> -> {0,1}-defined;
  cluster <%p,q%> -> total;
end;

registration
  let P, Q be 1-sorted;
  cluster <%P,Q%> -> 1-sorted-yielding;
end;

registration
  let P, Q be RelStr;
  cluster <%P,Q%> -> RelStr-yielding;
end;

registration
  let P, Q be TolStr;
  cluster <%P,Q%> -> TolStr-yielding;
end;

registration
  let P, Q be pcs-Str;
  cluster <%P,Q%> -> pcs-Str-yielding;
end;

registration
  let P, Q be reflexive pcs-Str;
  cluster <%P,Q%> -> reflexive-yielding;
end;

registration
  let P, Q be transitive pcs-Str;
  cluster <%P,Q%> -> transitive-yielding;
end;

registration
  let P, Q be pcs-tol-reflexive pcs-Str;
  cluster <%P,Q%> -> pcs-tol-reflexive-yielding;
end;

registration
  let P, Q be pcs-tol-symmetric pcs-Str;
  cluster <%P,Q%> -> pcs-tol-symmetric-yielding;
end;

registration
  let P, Q be pcs;
  cluster <%P,Q%> -> pcs-yielding;
end;

definition
  canceled;
  let P, Q be pcs-Str;
  func pcs-sum(P,Q) -> pcs-Str equals

  pcs-union <%P,Q%>;
end;

theorem 
  for P, Q being pcs-Str holds
  the carrier of pcs-sum(P,Q) = (the carrier of P) \/ the carrier of Q &
  the InternalRel of pcs-sum(P,Q) =
  (the InternalRel of P) \/ the InternalRel of Q &
  the ToleranceRel of pcs-sum(P,Q) =
  (the ToleranceRel of P) \/ the ToleranceRel of Q;

theorem 
  for P, Q being pcs-Str holds pcs-sum(P,Q) = pcs-Str (#
    (the carrier of P) \/ the carrier of Q,
    (the InternalRel of P) \/ the InternalRel of Q,
    (the ToleranceRel of P) \/ the ToleranceRel of Q #);

theorem 
  for P, Q being pcs-Str, p, q being Element of pcs-sum(P,Q) holds p <= q iff
  (ex p9, q9 being Element of P st p9 = p & q9 = q & p9 <= q9) or
  ex p9, q9 being Element of Q st p9 = p & q9 = q & p9 <= q9;

theorem 
  for P, Q being pcs-Str, p, q being Element of pcs-sum(P,Q) holds p (--) q iff
  (ex p9, q9 being Element of P st p9 = p & q9 = q & p9 (--) q9) or
  ex p9, q9 being Element of Q st p9 = p & q9 = q & p9 (--) q9;

registration
  let P, Q be reflexive pcs-Str;
  cluster pcs-sum(P,Q) -> reflexive;
end;

registration
  let P, Q be pcs-tol-reflexive pcs-Str;
  cluster pcs-sum(P,Q) -> pcs-tol-reflexive;
end;

registration
  let P, Q be pcs-tol-symmetric pcs-Str;
  cluster pcs-sum(P,Q) -> pcs-tol-symmetric;
end;

theorem 
  for P, Q being pcs holds
  P misses Q implies the InternalRel of pcs-sum(P,Q) is transitive;

theorem 
  for P, Q being pcs holds P misses Q implies pcs-sum(P,Q) is pcs-compatible;

theorem 
  for P, Q being pcs holds P misses Q implies pcs-sum(P,Q) is pcs;



definition
  let P be pcs-Str, a be set;
  func pcs-extension(P,a) -> strict pcs-Str means


  the carrier of it = {a} \/ the carrier of P & the InternalRel of it =
  [:{a},the carrier of it:] \/ the InternalRel of P &
  the ToleranceRel of it = [:{a},the carrier of it:] \/
  [:the carrier of it,{a}:] \/ the ToleranceRel of P;
end;

registration
  let P be pcs-Str, a be set;
  cluster pcs-extension(P,a) -> non empty;
end;

theorem 
  for P being pcs-Str, a being set holds
  the carrier of P c= the carrier of pcs-extension(P,a) &
  the InternalRel of P c= the InternalRel of pcs-extension(P,a) &
  the ToleranceRel of P c= the ToleranceRel of pcs-extension(P,a);

theorem 
  for P being pcs-Str, a being set,
  p, q being Element of pcs-extension(P,a) st p = a holds p <= q;

theorem 
  for P being pcs-Str, a being set, p, q being Element of P,
  p1, q1 being Element of pcs-extension(P,a) st p = p1 & q = q1 &
  p <= q holds p1 <= q1;

theorem 
  for P being pcs-Str, a being set, p being Element of P,
  p1, q1 being Element of pcs-extension(P,a)
  st p = p1 & p <> a & p1 <= q1 & not a in the carrier of P holds
  q1 in the carrier of P & q1 <> a;

theorem 
  for P being pcs-Str, a being set,
  p being Element of pcs-extension(P,a) st p <> a holds p in the carrier of P;

theorem 
  for P being pcs-Str, a being set, p, q being Element of P,
  p1, q1 being Element of pcs-extension(P,a) st p = p1 & q = q1 &
  p <> a & p1 <= q1 holds p <= q;

theorem 
  for P being pcs-Str, a being set,
  p, q being Element of pcs-extension(P,a) st p = a holds p (--) q & q (--) p;

theorem 
  for P being pcs-Str, a being set, p, q being Element of P,
  p1, q1 being Element of pcs-extension(P,a) st p = p1 & q = q1 &
  p (--) q holds p1 (--) q1;

theorem 
  for P being pcs-Str, a being set, p, q being Element of P,
  p1, q1 being Element of pcs-extension(P,a) st p = p1 & q = q1 &
  p <> a & q <> a & p1 (--) q1 holds p (--) q;

registration
  let P be reflexive pcs-Str, a be set;
  cluster pcs-extension(P,a) -> reflexive;
end;

theorem 
  for P being transitive pcs-Str, a being set st not a in the carrier of P
  holds pcs-extension(P,a) is transitive;

registration
  let P be pcs-tol-reflexive pcs-Str, a be set;
  cluster pcs-extension(P,a) -> pcs-tol-reflexive;
end;

registration
  let P be pcs-tol-symmetric pcs-Str, a be set;
  cluster pcs-extension(P,a) -> pcs-tol-symmetric;
end;

theorem 
  for P being pcs-compatible pcs-Str, a being set st not a in the carrier of P
  holds pcs-extension(P,a) is pcs-compatible;

theorem 
  for P being pcs, a being set st not a in the carrier of P
  holds pcs-extension(P,a) is pcs;



definition
  let P be pcs-Str;
  func pcs-reverse(P) -> strict pcs-Str means


  the carrier of it = the carrier of P &
  the InternalRel of it = (the InternalRel of P)~ &
  the ToleranceRel of it = (the ToleranceRel of P)`;
end;

registration
  let P be non empty pcs-Str;
  cluster pcs-reverse(P) -> non empty;
end;

theorem 
  for P being pcs-Str, p, q being Element of P
  for p9, q9 being Element of pcs-reverse(P) st p = p9 & q = q9 holds
  p <= q iff q9 <= p9;

theorem 
  for P being pcs-Str, p, q being Element of P
  for p9, q9 being Element of pcs-reverse(P) st p = p9 & q = q9 holds
  p (--) q implies not p9 (--) q9;

theorem 
  for P being non empty pcs-Str, p, q being Element of P
  for p9, q9 being Element of pcs-reverse(P) st p = p9 & q = q9 holds
  not p9 (--) q9 implies p (--) q;

registration
  let P be reflexive pcs-Str;
  cluster pcs-reverse(P) -> reflexive;
end;

registration
  let P be transitive pcs-Str;
  cluster pcs-reverse(P) -> transitive;
end;

registration
  let P be pcs-tol-reflexive pcs-Str;
  cluster pcs-reverse(P) -> pcs-tol-irreflexive;
end;

registration
  let P be pcs-tol-irreflexive pcs-Str;
  cluster pcs-reverse(P) -> pcs-tol-reflexive;
end;

registration
  let P be pcs-tol-symmetric pcs-Str;
  cluster pcs-reverse(P) -> pcs-tol-symmetric;
end;

registration
  let P be pcs-compatible pcs-Str;
  cluster pcs-reverse(P) -> pcs-compatible;
end;



definition
  let P, Q be pcs-Str;
  func P pcs-times Q -> pcs-Str equals

  pcs-Str (# [: the carrier of P, the carrier of Q :],
    [" the InternalRel of P, the InternalRel of Q "],
    [^ the ToleranceRel of P, the ToleranceRel of Q ^] #);
end;

registration
  let P, Q be pcs-Str;
  cluster P pcs-times Q -> strict;
end;

registration
  let P, Q be non empty pcs-Str;
  cluster P pcs-times Q -> non empty;
end;

theorem 
  for P, Q being pcs-Str, p, q being Element of P pcs-times Q
  for p1, p2 being Element of P, q1, q2 being Element of Q st
  p = [p1,q1] & q = [p2,q2] holds p <= q iff p1 <= p2 & q1 <= q2;

theorem 
  for P, Q being pcs-Str, p, q being Element of P pcs-times Q
  for p1, p2 being Element of P, q1, q2 being Element of Q st
  p = [p1,q1] & q = [p2,q2] holds p (--) q implies p1 (--) p2 or q1 (--) q2;

theorem 
  for P, Q being non empty pcs-Str, p, q being Element of P pcs-times Q
  for p1, p2 being Element of P, q1, q2 being Element of Q st
  p = [p1,q1] & q = [p2,q2] holds p1 (--) p2 or q1 (--) q2 implies p (--) q;

registration
  let P, Q be reflexive pcs-Str;
  cluster P pcs-times Q -> reflexive;
end;

registration
  let P, Q be transitive pcs-Str;
  cluster P pcs-times Q -> transitive;
end;

registration
  let P be pcs-Str;
  let Q be pcs-tol-reflexive pcs-Str;
  cluster P pcs-times Q -> pcs-tol-reflexive;
end;

registration
  let P be pcs-tol-reflexive pcs-Str;
  let Q be pcs-Str;
  cluster P pcs-times Q -> pcs-tol-reflexive;
end;

registration
  let P, Q be pcs-tol-symmetric pcs-Str;
  cluster P pcs-times Q -> pcs-tol-symmetric;
end;

registration
  let P, Q be pcs-compatible pcs-Str;
  cluster P pcs-times Q -> pcs-compatible;
end;

definition
  let P, Q be pcs-Str;
  func P --> Q -> pcs-Str equals

  (pcs-reverse P) pcs-times Q;
end;

registration
  let P, Q be pcs-Str;
  cluster P --> Q -> strict;
end;

registration
  let P, Q be non empty pcs-Str;
  cluster P --> Q -> non empty;
end;

theorem 
  for P, Q being pcs-Str, p, q being Element of P --> Q
  for p1, p2 being Element of P, q1, q2 being Element of Q st
  p = [p1,q1] & q = [p2,q2] holds p <= q iff p2 <= p1 & q1 <= q2;

theorem 
  for P, Q being pcs-Str, p, q being Element of P --> Q
  for p1, p2 being Element of P, q1, q2 being Element of Q st
  p = [p1,q1] & q = [p2,q2] holds p (--) q implies not p1 (--) p2 or q1 (--) q2
;

theorem 
  for P, Q being non empty pcs-Str, p, q being Element of P --> Q
  for p1, p2 being Element of P, q1, q2 being Element of Q st
  p = [p1,q1] & q = [p2,q2] holds not p1 (--) p2 or q1 (--) q2 implies p (--) q
;

registration
  let P, Q be reflexive pcs-Str;
  cluster P --> Q -> reflexive;
end;

registration
  let P, Q be transitive pcs-Str;
  cluster P --> Q -> transitive;
end;

registration
  let P be pcs-Str, Q be pcs-tol-reflexive pcs-Str;
  cluster P --> Q -> pcs-tol-reflexive;
end;

registration
  let P be pcs-tol-irreflexive pcs-Str, Q be pcs-Str;
  cluster P --> Q -> pcs-tol-reflexive;
end;

registration
  let P, Q be pcs-tol-symmetric pcs-Str;
  cluster P --> Q -> pcs-tol-symmetric;
end;

registration
  let P, Q be pcs-compatible pcs-Str;
  cluster P --> Q -> pcs-compatible;
end;

registration
  let P, Q be pcs;
  cluster P --> Q -> pcs-like;
end;



definition
  let P be TolStr, S be Subset of P;
  attr S is pcs-self-coherent means


  for x, y being Element of P st x in S & y in S holds x (--) y;
end;

registration
  let P be TolStr;
  cluster empty -> pcs-self-coherent for Subset of P;
end;

definition
  let P be TolStr, F be Subset-Family of P;
  attr F is pcs-self-coherent-membered means


  for S being Subset of P st S in F holds S is pcs-self-coherent;
end;

registration
  let P be TolStr;
  cluster non empty pcs-self-coherent-membered for Subset-Family of P;
end;

definition
  let P be RelStr, D be set;
  func pcs-general-power-IR(P,D) -> Relation of D means


  for A, B being set holds [A,B] in it iff A in D & B in D &
  for a being set st a in A ex b being set st b in B &
  [a,b] in the InternalRel of P;
end;

definition
  let P be TolStr, D be set;
  func pcs-general-power-TR(P,D) -> Relation of D means


  for A, B being set holds [A,B] in it iff A in D & B in D &
  for a, b being set st a in A & b in B holds [a,b] in the ToleranceRel of P;
end;

theorem 
  for P being RelStr, D being Subset-Family of P
  for A, B being set holds [A,B] in pcs-general-power-IR(P,D) iff
  A in D & B in D &
  for a being Element of P st a in A ex b being Element of P st b in B & a <= b
;

theorem 
  for P being TolStr, D being Subset-Family of P
  for A, B being set holds [A,B] in pcs-general-power-TR(P,D) iff
  A in D & B in D &
  for a, b being Element of P st a in A & b in B holds a (--) b;

definition
  let P be pcs-Str, D be set;
  func pcs-general-power(P,D) -> pcs-Str equals

  pcs-Str (# D, pcs-general-power-IR(P,D), pcs-general-power-TR(P,D) #);
end;

notation
  let P be pcs-Str, D be Subset-Family of P;
  synonym pcs-general-power(D) for pcs-general-power(P,D);
end;

registration
  let P be pcs-Str, D be non empty set;
  cluster pcs-general-power(P,D) -> non empty;
end;

theorem 
  for P being pcs-Str, D be set
  for p, q being Element of pcs-general-power(P,D) holds p <= q
  implies for p9 being Element of P st p9 in p
  ex q9 being Element of P st q9 in q & p9 <= q9;

theorem 
  for P being pcs-Str, D being non empty Subset-Family of P
  for p, q being Element of pcs-general-power(D) st
  for p9 being Element of P st p9 in p
  ex q9 being Element of P st q9 in q & p9 <= q9 holds p <= q;

theorem 
  for P being pcs-Str, D being set
  for p, q being Element of pcs-general-power(P,D) holds p (--) q implies
  for p9, q9 being Element of P st p9 in p & q9 in q holds p9 (--) q9;

theorem 
  for P being pcs-Str, D being non empty Subset-Family of P
  for p, q being Element of pcs-general-power(D) st
  for p9, q9 being Element of P st p9 in p & q9 in q holds p9 (--) q9
  holds p (--) q;

registration
  let P be pcs-Str, D be set;
  cluster pcs-general-power(P,D) -> strict;
end;

registration
  let P be reflexive pcs-Str, D be Subset-Family of P;
  cluster pcs-general-power(D) -> reflexive;
end;

registration
  let P be transitive pcs-Str, D be set;
  cluster pcs-general-power(P,D) -> transitive;
end;

registration
  let P be pcs-tol-reflexive pcs-Str,
  D be pcs-self-coherent-membered Subset-Family of P;
  cluster pcs-general-power(D) -> pcs-tol-reflexive;
end;

registration
  let P be pcs-tol-symmetric pcs-Str, D be Subset-Family of P;
  cluster pcs-general-power(D) -> pcs-tol-symmetric;
end;

registration
  let P be pcs-compatible pcs-Str, D be Subset-Family of P;
  cluster pcs-general-power(D) -> pcs-compatible;
end;

definition
  let P be pcs-Str;
  func pcs-coherent-power(P) -> set equals

  {X where X is Subset of P: X is pcs-self-coherent};
end;

registration
  let P be pcs-Str;
  cluster pcs-self-coherent for Subset of P;
end;

theorem 
  for P being pcs-Str, X being set holds X in pcs-coherent-power(P)
  implies X is pcs-self-coherent Subset of P;

registration
  let P be pcs-Str;
  cluster pcs-coherent-power(P) -> non empty;
end;

definition
  let P be pcs-Str;
  redefine func pcs-coherent-power(P) -> Subset-Family of P;
end;

registration
  let P be pcs-Str;
  cluster pcs-coherent-power(P) -> pcs-self-coherent-membered
    for Subset-Family of P;
end;

definition
  let P be pcs-Str;
  func pcs-power(P) -> pcs-Str equals

  pcs-general-power(pcs-coherent-power(P));
end;

registration
  let P be pcs-Str;
  cluster pcs-power(P) -> strict;
end;

registration
  let P be pcs-Str;
  cluster pcs-power(P) -> non empty;
end;

registration
  let P be reflexive pcs-Str;
  cluster pcs-power(P) -> reflexive;
end;

registration
  let P be transitive pcs-Str;
  cluster pcs-power(P) -> transitive;
end;

registration
  let P be pcs-tol-reflexive pcs-Str;
  cluster pcs-power(P) -> pcs-tol-reflexive;
end;

registration
  let P be pcs-tol-symmetric pcs-Str;
  cluster pcs-power(P) -> pcs-tol-symmetric;
end;

registration
  let P be pcs-compatible pcs-Str;
  cluster pcs-power(P) -> pcs-compatible;
end;

registration
  let P be pcs;
  cluster pcs-power(P) -> pcs-like;
end;














begin 

definition
  let IT be non empty BCIStr_0;
  attr IT is commutative means


  for x,y being Element of IT holds x\(x\y ) = y\(y\x);
end;

registration
  cluster BCI-EXAMPLE -> commutative;
end;

registration
  cluster commutative for BCK-algebra;
end;

reserve X for BCK-algebra;
reserve x,y for Element of X;
reserve IT for non empty Subset of X;

theorem 
  X is commutative BCK-algebra iff for x,y being Element of X holds
  x\(x\y) <= y\(y\x);

theorem 
  for X being BCK-algebra holds for x,y being Element of X holds x\
  (x\y) <= y & x\(x\y) <= x;

theorem 
  X is commutative BCK-algebra iff for x,y being Element of X holds
  x\y = x\(y\(y\x));

theorem 
  X is commutative BCK-algebra iff for x,y being Element of X holds
  x\(x\y) = y\(y\(x\(x\y)));

theorem 
  X is commutative BCK-algebra iff for x,y being Element of X st x
  <= y holds x= y\(y\x);

theorem 
  for X being non empty BCIStr_0 holds (X is commutative
BCK-algebra iff for x,y,z being Element of X holds x\(0.X\y) = x & (x\z)\(x\y)
  = (y\z)\(y\x) );

theorem 
  X is commutative BCK-algebra implies for x,y being Element of X st x\y
  =x holds y\x=y;

theorem 
  X is commutative BCK-algebra implies for x,y,a being Element of X
  st y <= a holds (a\x)\(a\y) = y\x;

theorem 
  X is commutative BCK-algebra implies for x,y being Element of X holds
  (x\y=x iff y\(y\x)=0.X);

theorem 
  X is commutative BCK-algebra implies for x,y being Element of X holds
  x\(y\(y\x))=x\y & (x\y)\((x\y)\x)=x\y;

theorem 
  X is commutative BCK-algebra implies for x,y,a being Element of X st x
  <= a holds (a\y)\((a\y)\(a\x)) = (a\y)\(x\y);

definition
  let X be BCI-algebra;
  let a be Element of X;
  attr a is being_greatest means


  for x being Element of X holds x\a=0.X;
  attr a is being_positive means

  0.X\a=0.X;
end;

begin 

definition
  let IT be BCI-algebra;
  attr IT is BCI-commutative means


  for x,y being Element of IT st x\y= 0.IT holds x = y\(y\x);
  attr IT is BCI-weakly-commutative means


  for x,y being Element of IT holds (x\(x\y))\(0.IT\(x\y)) = y\(y\x);
end;

registration
  cluster BCI-EXAMPLE -> BCI-commutative BCI-weakly-commutative;
end;

registration
  cluster BCI-commutative BCI-weakly-commutative for BCI-algebra;
end;

theorem 
  for X being BCI-algebra holds ((ex a be Element of X st a is
  being_greatest) implies X is BCK-algebra);

theorem 
  for X being BCI-algebra holds (X is p-Semisimple implies X is
  BCI-commutative & X is BCI-weakly-commutative );

theorem 
  for X being commutative BCK-algebra holds X is BCI-commutative
  BCI-algebra & X is BCI-weakly-commutative BCI-algebra;

theorem 
  X is BCI-weakly-commutative BCI-algebra implies X is BCI-commutative;

theorem 
  for X being BCI-algebra holds (X is BCI-commutative iff for x,y
  being Element of X holds x\(x\y) = y\(y\(x\(x\y))) );

theorem 
  for X being BCI-algebra holds (X is BCI-commutative iff for x,y
  being Element of X holds (x\(x\y))\(y\(y\x)) = 0.X\(x\y) );

theorem 
  for X being BCI-algebra holds (X is BCI-commutative iff for a being
Element of AtomSet(X),x,y being Element of BranchV(a) holds x\(x\y) = y\(y\x) )
;

theorem 
  for X being non empty BCIStr_0 holds (X is BCI-commutative BCI-algebra
iff for x,y,z being Element of X holds ((x\y)\(x\z))\(z\y)=0.X & x\0.X = x & x\
  (x\y) = y\(y\(x\(x\y))) );

theorem 
  for X being BCI-algebra holds (X is BCI-commutative iff for x,y,z
  being Element of X st x<=z & z\y<=z\x holds x<=y );

theorem 
  for X being BCI-algebra holds (X is BCI-commutative iff for x,y,z
  being Element of X st x<=y & x<=z holds x<=y\(y\z) );

begin 

definition
  let IT be BCK-algebra;
  attr IT is bounded means

  ex a be Element of IT st a is being_greatest;
end;

registration
  cluster BCI-EXAMPLE -> bounded;
end;

registration
  cluster bounded commutative for BCK-algebra;
end;

definition
  let IT be bounded BCK-algebra;
  attr IT is involutory means


  for a being Element of IT st a is
  being_greatest holds for x being Element of IT holds a\(a\x)=x;
end;

theorem 
  for X being bounded BCK-algebra holds (X is involutory iff for a
  being Element of X st a is being_greatest holds for x,y being Element of X
  holds x\y = (a\y)\(a\x) );

theorem 
  for X being bounded BCK-algebra holds (X is involutory iff for a
  being Element of X st a is being_greatest holds for x,y being Element of X
  holds x\(a\y) = y\(a\x) );

theorem 
  for X being bounded BCK-algebra holds (X is involutory iff for a being
Element of X st a is being_greatest holds for x,y being Element of X holds x <=
  a\y implies y <= a\x );

definition
  let IT be BCK-algebra;
  let a be Element of IT;
  attr a is being_Iseki means


  for x being Element of IT holds x\a=0.IT & a\x=a;
end;

definition
  let IT be BCK-algebra;
  attr IT is Iseki_extension means

  ex a be Element of IT st a is being_Iseki;
end;

registration
  cluster BCI-EXAMPLE -> Iseki_extension;
end;



definition
  let X be BCK-algebra;
  mode Commutative-Ideal of X -> non empty Subset of X means


    0.X in it
& for x,y,z being Element of X st (x\y)\z in it & z in it holds x\(y\(y\x)) in
    it;
end;

theorem 
  IT is Commutative-Ideal of X implies for x,y being Element of X st x\y
  in IT holds x\(y\(y\x)) in IT;

theorem 
  for X being BCK-algebra st IT is Commutative-Ideal of X holds IT
  is Ideal of X;

theorem 
  IT is Commutative-Ideal of X implies for x,y being Element of X st x\(
  x\y) in IT holds (y\(y\x))\(x\y) in IT;

begin 

definition
  let IT be BCK-algebra;
  attr IT is BCK-positive-implicative means


  for x,y,z being Element of IT holds (x\y)\z=(x\z)\(y\z);
  attr IT is BCK-implicative means


  for x,y being Element of IT holds x \(y\x)=x;
end;

registration
  cluster BCI-EXAMPLE -> BCK-positive-implicative BCK-implicative;
end;

registration
  cluster Iseki_extension BCK-positive-implicative BCK-implicative bounded
    commutative for BCK-algebra;
end;

theorem 
  X is BCK-positive-implicative BCK-algebra iff for x,y being
  Element of X holds x\y = (x\y)\y;

theorem 
  X is BCK-positive-implicative BCK-algebra iff for x,y being
  Element of X holds (x\(x\y))\(y\x) = x\(x\(y\(y\x)));

theorem 
  X is BCK-positive-implicative BCK-algebra iff for x,y being Element of
  X holds x\y = (x\y)\(x\(x\y));

theorem 
  X is BCK-positive-implicative BCK-algebra iff for x,y,z being Element
  of X holds (x\z)\(y\z) <= (x\y)\z;

theorem 
  X is BCK-positive-implicative BCK-algebra iff for x,y being Element of
  X holds x\y <= (x\y)\y;

theorem 
  X is BCK-positive-implicative BCK-algebra iff for x,y being Element of
  X holds (x\(x\(y\(y\x)))) <= (x\(x\y))\(y\x);

theorem 
  X is BCK-implicative BCK-algebra iff X is commutative
  BCK-algebra & X is BCK-positive-implicative BCK-algebra;

theorem 
  X is BCK-implicative BCK-algebra iff for x,y being Element of X
  holds (x\(x\y))\(x\y) = (y\(y\x));

theorem 
  for X being non empty BCIStr_0 holds (X is BCK-implicative BCK-algebra
iff for x,y,z being Element of X holds x\(0.X\y) = x & (x\z)\(x\y) = ((y\z)\(y\
  x))\(x\y) );

theorem 
  for X being bounded BCK-algebra,a being Element of X st a is
  being_greatest holds (X is BCK-implicative iff X is involutory & X is
  BCK-positive-implicative );

theorem 
  X is BCK-implicative BCK-algebra iff for x,y being Element of X holds
  x\(x\(y\x)) = 0.X;

theorem 
  X is BCK-implicative BCK-algebra iff for x,y being Element of X holds
  (x\(x\y))\(x\y) = y\(y\(x\(x\y)));

theorem 
  X is BCK-implicative BCK-algebra iff for x,y,z being Element of
  X holds (x\z)\(x\y) = (y\z)\((y\x)\z);

theorem 
  X is BCK-implicative BCK-algebra iff for x,y,z being Element of X
  holds x\(x\(y\z)) = (y\z)\((y\z)\(x\z));

theorem 
  X is BCK-implicative BCK-algebra iff for x,y being Element of X holds
  (x\(x\y)) = (y\(y\x))\(x\y);

theorem 
  for X being bounded commutative BCK-algebra,a being Element of X
st a is being_greatest holds (X is BCK-implicative iff for x being Element of X
  holds (a\x)\((a\x)\x) = 0.X );

theorem 
  for X being bounded commutative BCK-algebra,a being Element of X st a
  is being_greatest holds (X is BCK-implicative iff for x being Element of X
  holds x\(a\x) = x );

theorem 
  for X being bounded commutative BCK-algebra,a being Element of X st a
  is being_greatest holds (X is BCK-implicative iff for x being Element of X
  holds (a\x)\x = (a\x) );

theorem 
  for X being bounded commutative BCK-algebra,a being Element of X
st a is being_greatest holds (X is BCK-implicative iff for x,y being Element of
  X holds (a\y)\((a\y)\x) = x\y );

theorem 
  for X being bounded commutative BCK-algebra,a being Element of X
st a is being_greatest holds (X is BCK-implicative iff for x,y being Element of
  X holds y\(y\x) = x\(a\y) );

theorem 
  for X being bounded commutative BCK-algebra,a being Element of X st a
is being_greatest holds (X is BCK-implicative iff for x,y,z being Element of X
  holds (x\(y\z))\(x\y) <= x\(a\z) );














begin

definition
  let S be 1-sorted;
  func <*>S -> FinSequence of S equals

  <*>([#]S);
end;



reserve S for 1-sorted,
  i for Element of NAT,
  p for FinSequence,
  X for set;



theorem 
  for p being FinSequence of S st i in dom p holds p.i in S;



theorem 
  (for i being Nat st i in dom p holds p.i in S) implies p is FinSequence of S;

scheme 

  IndSeqS{S() -> 1-sorted, P[set]}: for p being FinSequence of S() holds P[p]
provided
 P[<*> S()] and
 for p being FinSequence of S() for x being Element of S() st P[p]
holds P[p^<*x*>];

begin 

definition
  func Z_2 -> Field equals

  INT.Ring(2);
end;

theorem 
  [#]Z_2 = {0,1};

theorem 
  for a being Element of Z_2 holds a = 0 or a = 1;

theorem 
  0.Z_2 = 0;

theorem 
  1.Z_2 = 1;

theorem 
  1.Z_2 + 1.Z_2 = 0.Z_2;

theorem 
  for x being Element of Z_2 holds x = 0.Z_2 iff x <> 1.Z_2;

begin 

definition
  let X,x be set;
  func X@x -> Element of Z_2 equals


  1.Z_2 if x in X otherwise 0.Z_2;
end;

theorem 
  for X,x being set holds X@x = 1.Z_2 iff x in X;

theorem 
  for X,x being set holds X@x = 0.Z_2 iff not x in X;

theorem 
  for X,x being set holds X@x <> 0.Z_2 iff X@x = 1.Z_2;

theorem 
  for X,x,y being set holds X@x = X@y iff (x in X iff y in X);

theorem 
  for X,Y,x being set holds X@x = Y@x iff (x in X iff x in Y);

theorem 
  for x being set holds {}@x = 0.Z_2;

theorem 
  for X being set, u,v being Subset of X, x being Element of X
  holds (u \+\ v)@x = u@x + v@x;

theorem 
  for X,Y being set holds X = Y iff for x being set holds X@x = Y@x;

begin 

definition
  let X be set, a be Element of Z_2, c be Subset of X;
  func a \*\ c -> Subset of X equals


  c if a = 1.Z_2, {}X if a = 0.Z_2;
end;

definition
  let X be set;
  func bspace-sum(X) -> BinOp of bool X means


  for c,d being Subset of X holds it.(c,d) = c \+\ d;
end;

theorem 
  for a being Element of Z_2, c,d being Subset of X holds a \*\ (c
  \+\ d) = (a \*\ c) \+\ (a \*\ d);

theorem 
  for a,b being Element of Z_2, c being Subset of X holds (a+b)
  \*\ c = (a \*\ c) \+\ (b \*\ c);

theorem 
  for c being Subset of X holds (1.Z_2) \*\ c = c;

theorem 
  for a,b being Element of Z_2, c being Subset of X holds a \*\ (b
  \*\ c) = (a*b) \*\ c;

definition
  let X be set;
  func bspace-scalar-mult(X) -> Function of [:the carrier of Z_2,bool X:],bool
  X means


  for a being Element of Z_2, c being Subset of X holds it.(a,c) = a \*\ c;
end;

definition
  let X be set;
  func bspace(X) -> non empty VectSpStr over Z_2 equals

  VectSpStr (# bool X,
    bspace-sum(X), {}X, bspace-scalar-mult(X) #);
end;

theorem 
  bspace(X) is Abelian;

theorem 
  bspace(X) is add-associative;

theorem 
  bspace(X) is right_zeroed;

theorem 
  bspace(X) is right_complementable;

theorem 
  for a being Element of Z_2, x,y being Element of bspace(X) holds
  a*(x+y) = (a*x)+(a*y);

theorem 
  for a,b being Element of Z_2, x being Element of bspace(X) holds
  (a+b)*x = (a*x)+(b*x);

theorem 
  for a,b being Element of Z_2, x being Element of bspace(X) holds
  (a*b)*x = a*(b*x);

theorem 
  for x being Element of bspace(X) holds (1_Z_2)*x = x;

theorem 
  bspace(X) is vector-distributive scalar-distributive
  scalar-associative scalar-unital;

registration
  let X be set;
  cluster bspace(X) -> vector-distributive scalar-distributive
  scalar-associative scalar-unital
   Abelian right_complementable
    add-associative right_zeroed;
end;

begin 

definition

  let X be set;
  func singletons(X) equals

  { f where f is Subset of X : f is 1-element };
end;

definition
  let X be set;
  redefine func singletons(X) -> Subset of bspace(X);
end;

registration
  let X be non empty set;
  cluster singletons(X) -> non empty;
end;

theorem 
  for X being non empty set, f being Subset of X st f is Element
  of singletons(X) holds f is 1-element;

definition
  let F be Field, V be VectSp of F, l be Linear_Combination of V, x be Element
  of V;
  redefine func l.x -> Element of F;
end;

definition
  let X be non empty set, s be FinSequence of bspace(X), x be Element of X;
  func s@x -> FinSequence of Z_2 means


  len it = len s & for j being Nat st 1 <= j & j <= len s holds it.j = (s.j)@x;
end;

theorem 
  for X being non empty set, x being Element of X holds (<*>(
  bspace(X)))@x = <*>Z_2;

theorem 
  for X being set, u,v being Element of bspace(X), x being Element
  of X holds (u + v)@x = u@x + v@x;

theorem 
  for X being non empty set, s being FinSequence of bspace(X), f
being Element of bspace(X), x being Element of X holds (s ^ <*f*>)@x = (s@x) ^
  <*f@x*>;

theorem 
  for X being non empty set, s being FinSequence of bspace(X), x
  being Element of X holds (Sum s)@x = Sum (s@x);

theorem 
  for X being non empty set, l being Linear_Combination of bspace(
  X), x being Element of bspace(X) st x in Carrier l holds l.x = 1_Z_2;

registration let X be empty set;
 cluster singletons X -> empty;

end;

theorem 
  singletons(X) is linearly-independent;

theorem 
  for f being Element of bspace(X) st (ex x being set st x in X & f = {x
  }) holds f in singletons(X);

theorem 
  for X being finite set, A being Subset of X ex l being
  Linear_Combination of singletons(X) st Sum l = A;

theorem 
  for X being finite set holds Lin(singletons(X)) = bspace(X);

theorem 
  for X being finite set holds singletons(X) is Basis of bspace(X);

registration
  let X be finite set;
  cluster singletons(X) -> finite;
end;

registration
  let X be finite set;
  cluster bspace(X) -> finite-dimensional;
end;

theorem 
  card (singletons X) = card X;

theorem 
  card [#](bspace X) = exp(2,card(X));

theorem 
  dim bspace {} = 0;














begin

theorem 
  for X,c,d being set st (ex a,b being set st a <> b & X = {a,b}) &
  c in X & d in X & c <> d holds X = {c,d};

begin 

reserve n for Nat,
  k for Integer;

canceled;

theorem 
  1 <= k implies k is Nat;

definition
  let a be Integer, b be Nat;
  redefine func a*b -> Element of INT;
end;

theorem 
  1 is odd;

theorem 
  2 is even;

theorem 
  3 is odd;

theorem 
  4 is even;

theorem 
  n is even implies (-1)|^n = 1;

theorem 
  n is odd implies (-1)|^n = -1;

theorem 
  (-1) |^ n is Integer;

definition
  let a be Integer, n be Nat;
  redefine func a |^ n -> Element of INT;
end;

theorem 
  for p,q,r being FinSequence holds len (p ^ q) <= len (p ^ (q ^ r ));

theorem 
  1 < n + 2;

theorem 
  (-1)|^2 = 1;

theorem 
  for n being Nat holds (-1)|^n = (-1)|^(n+2);

begin 



theorem 
  for a,b,s being FinSequence of INT st len s > 0 & len a = len s
& len b = len s & (for n being Nat st 1 <= n & n <= len s holds s.n = a.n + b.n
) & (for k being Nat st 1 <= k & k < len s holds b.k = -(a.(k+1))) holds Sum s
  = (a.1) + (b.(len s));

theorem 
  for p,q,r being FinSequence holds len (p ^ q ^ r) = (len p) + (
  len q) + (len r);

theorem 
  for x being set, p,q being FinSequence holds (<*x*> ^ p ^ q).1 = x;

theorem 
  for x being set, p,q being FinSequence holds (p ^ q ^ <*x*>).((
  len p) + (len q) + 1) = x;

theorem 
  for p,q,r being FinSequence, k being Nat st len p < k & k <= len
  (p ^ q) holds (p ^ q ^ r).k = q.(k - (len p));

definition
  let a be Integer;
  redefine func <*a*> -> FinSequence of INT;
end;

definition
  let a,b be Integer;
  redefine func <*a,b*> -> FinSequence of INT;
end;

definition
  let a,b,c be Integer;
  redefine func <*a,b,c*> -> FinSequence of INT;
end;

definition
  let p,q be FinSequence of INT;
  redefine func p ^ q -> FinSequence of INT;
end;

theorem 
  for k being Integer, p being FinSequence of INT holds Sum (<*k*>
  ^ p) = k + (Sum p);

theorem 
  for p,q,r being FinSequence of INT holds Sum (p ^ q ^ r) = (Sum
  p) + (Sum q) + (Sum r);

theorem 
  for a being Element of Z_2 holds Sum <*a*> = a;

begin 



definition
  let X,Y be set;
  mode incidence-matrix of X,Y is Element of Funcs([:X,Y:],{0.Z_2,1.Z_2});
end;

theorem 
  for X,Y being set holds [:X,Y:] --> 1.Z_2 is incidence-matrix of X,Y;







definition
  struct PolyhedronStr(# PolytopsF ->FinSequence-yielding FinSequence,
    IncidenceF ->Function-yielding FinSequence #);
end;








definition
  let p be PolyhedronStr;
  attr p is polyhedron_1 means


  len the IncidenceF of p = len(the PolytopsF of p) - 1;
  attr p is polyhedron_2 means


  for n being Nat st 1 <= n & n < len the
  PolytopsF of p holds (the IncidenceF of p).n is incidence-matrix of rng ((the
  PolytopsF of p).n), rng ((the PolytopsF of p).(n+1));
  attr p is polyhedron_3 means


  for n being Nat st 1 <= n & n <= len the
PolytopsF of p holds (the PolytopsF of p).n is non empty & (the PolytopsF of p)
  .n is one-to-one;
end;

registration
  cluster polyhedron_1 polyhedron_2 polyhedron_3 for PolyhedronStr;
end;

definition
  mode polyhedron is polyhedron_1 polyhedron_2 polyhedron_3 PolyhedronStr;
end;

reserve p for polyhedron,
  k for Integer,
  n for Nat;




definition
  let p be polyhedron;
  func dim(p) -> Element of NAT equals

  len the PolytopsF of p;
end;










definition
  let p be polyhedron, k be Integer;
  func k-polytopes(p) -> finite set means


  (k < -1 implies it = {}) & (k
= -1 implies it = {{}}) & (-1 < k & k < dim(p) implies it = rng ((the PolytopsF
  of p).(k+1))) & (k = dim(p) implies it = {p}) & (k > dim(p) implies it = {});
end;

theorem 
  -1 < k & k < dim(p) implies k + 1 is Nat & 1 <= k + 1 & k + 1 <= dim(p);

theorem 
  k-polytopes(p) is non empty iff -1 <= k & k <= dim(p);

theorem 
  k < dim(p) implies k - 1 < dim(p);











definition
  let p be polyhedron, k be Integer;
  func eta(p,k) -> incidence-matrix of (k-1)-polytopes(p),k-polytopes(p) means


  (k < 0 implies it = {}) & (k = 0 implies it = [:{{}},0-polytopes(p):]
  --> 1.Z_2) & (0 < k & k < dim(p) implies it = (the IncidenceF of p).k) & (k =
dim(p) implies it = [:(dim(p) - 1)-polytopes(p),{p}:] --> 1.Z_2) & (k > dim(p)
  implies it = {});
end;

definition
  let p be polyhedron, k be Integer;
  func k-polytope-seq(p) -> FinSequence means


  (k < -1 implies it = <*>
  {}) & (k = -1 implies it = <*{}*>) & (-1 < k & k < dim(p) implies it = (the
PolytopsF of p).(k+1)) & (k = dim(p) implies it = <*p*>) & (k > dim(p) implies
  it = <*>{});
end;

definition
  let p be polyhedron, k be Integer;
  func num-polytopes(p,k) -> Element of NAT equals

  card(k-polytopes(p));
end;




definition
  let p be polyhedron;
  func num-vertices(p) -> Element of NAT equals

  num-polytopes(p,0);
  func num-edges(p) -> Element of NAT equals

  num-polytopes(p,1);
  func num-faces(p) -> Element of NAT equals

  num-polytopes(p,2);
end;

theorem 
  dom (k-polytope-seq(p)) = Seg (num-polytopes(p,k));

theorem 
  len (k-polytope-seq(p)) = num-polytopes(p,k);

theorem 
  rng (k-polytope-seq(p)) = k-polytopes(p);

theorem 
  num-polytopes(p,-1) = 1;

theorem 
  num-polytopes(p,dim(p)) = 1;








definition
  let p be polyhedron, k be Integer, n be Nat;
  assume
 1 <= n & n <= num-polytopes(p,k);
  func n-th-polytope(p,k) -> Element of k-polytopes(p) equals


  (k
  -polytope-seq(p)).n;
end;

theorem 
  -1 <= k & k <= dim(p) implies for x being Element of k-polytopes
(p) ex n being Nat st x = n-th-polytope(p,k) & 1 <= n & n <= num-polytopes(p,k)
;

theorem 
  k-polytope-seq(p) is one-to-one;

theorem 
  for m,n being Nat st 1 <= n & n <= num-polytopes(p,k) & 1 <= m &
  m <= num-polytopes(p,k) & n-th-polytope(p,k) = m-th-polytope(p,k) holds m = n
;

definition
  let p be polyhedron, k be Integer, x be Element of (k-1)-polytopes(p), y be
  Element of k-polytopes(p);
  assume that
 0 <= k and
 k <= dim(p);
  func incidence-value(x,y) -> Element of Z_2 equals


  eta(p,k).(x,y);
end;

begin 




definition
  let p be polyhedron, k be Integer;
  func k-chain-space(p) -> finite-dimensional VectSp of Z_2 equals

  bspace(k
  -polytopes(p));
end;

theorem 
  for x being Element of k-polytopes(p) holds (0.(k-chain-space(p)))@x =
  0.Z_2;

theorem 
  num-polytopes(p,k) = dim (k-chain-space(p));



definition
  let p be polyhedron, k be Integer;
  func k-chains(p) -> non empty finite set equals

  bool (k-polytopes(p));
end;

definition
  let p be polyhedron, k be Integer, x be Element of (k-1)-polytopes(p), v be
  Element of k-chain-space(p);
  func incidence-sequence(x,v) -> FinSequence of Z_2 means


  ((k-1)
  -polytopes(p) is empty implies it = <*>{}) & ((k-1)-polytopes(p) is non empty
  implies len it = num-polytopes(p,k) & for n being Nat st 1 <= n & n <=
  num-polytopes(p,k) holds it.n = (v@(n-th-polytope(p,k)))*incidence-value(x,n
  -th-polytope(p,k)));
end;

theorem 
  for c,d being Element of k-chain-space(p), x being Element of k
  -polytopes(p) holds (c+d)@x = (c@x) + (d@x);

theorem 
  for c,d being Element of k-chain-space(p), x being Element of (k
  -1)-polytopes(p) holds incidence-sequence(x,c+d) = incidence-sequence(x,c) +
  incidence-sequence(x,d);

theorem 
  for c,d being Element of k-chain-space(p), x being Element of (k
-1)-polytopes(p) holds Sum (incidence-sequence(x,c) + incidence-sequence(x,d))
  = (Sum incidence-sequence(x,c)) + (Sum incidence-sequence(x,d));

theorem 
  for c,d being Element of k-chain-space(p), x being Element of (k
-1)-polytopes(p) holds Sum incidence-sequence(x,c+d) = (Sum incidence-sequence(
  x,c)) + (Sum incidence-sequence(x,d));

theorem 
  for c being Element of k-chain-space(p), a being Element of Z_2,
  x being Element of k-polytopes(p) holds (a*c)@x = a*(c@x);

theorem 
  for c being Element of k-chain-space(p), a being Element of Z_2,
  x being Element of (k-1)-polytopes(p) holds incidence-sequence(x,a*c) = a*
  incidence-sequence(x,c);

theorem 
  for c,d being Element of k-chain-space(p) holds c = d iff for x
  being Element of k-polytopes(p) holds c@x = d@x;

theorem 
  for c,d being Element of k-chain-space(p) holds c = d iff for x
  being Element of k-polytopes(p) holds x in c iff x in d;

scheme 

  ChainEx { p() -> polyhedron, k() -> Integer, P[Element of k()-polytopes(p())
  ] } : ex c being Subset of k()-polytopes(p()) st for x being Element of k()
  -polytopes(p()) holds x in c iff P[x] & x in k()-polytopes(p());






definition
  let p be polyhedron, k be Integer, v be Element of k-chain-space(p);
  func Boundary(v) -> Element of (k-1)-chain-space(p) means


  ((k-1) -polytopes(p) is empty implies it = 0.((k-1)-chain-space(p))) & ((k-1)
  -polytopes(p) is non empty implies for x being Element of (k-1)-polytopes(p)
  holds x in it iff Sum incidence-sequence(x,v) = 1.Z_2);
end;

theorem 
  for c being Element of k-chain-space(p), x being Element of (k-1
  )-polytopes(p) holds (Boundary(c))@x = Sum incidence-sequence(x,c);



definition
  let p be polyhedron, k be Integer;
  func k-boundary(p) -> Function of k-chain-space(p),(k-1)-chain-space(p)
  means


  for c being Element of k-chain-space(p) holds it.c = Boundary(c);
end;

theorem 
  for c,d being Element of k-chain-space(p) holds Boundary(c+d) =
  Boundary(c) + Boundary(d);

theorem 
  for a being Element of Z_2, c being Element of k-chain-space(p)
  holds Boundary(a*c) = a*(Boundary(c));




theorem 
  k-boundary(p) is linear-transformation of k-chain-space(p),(k-1)
  -chain-space(p);

registration
  let p be polyhedron, k be Integer;
  cluster k-boundary(p) -> homogeneous additive;
end;




definition
  let p be polyhedron, k be Integer;
  func k-circuit-space(p) -> Subspace of k-chain-space(p) equals

  ker (k-boundary(p));
end;

definition
  let p be polyhedron, k be Integer;
  func k-circuits(p) -> non empty Subset of k-chains(p) equals

  [#](k
  -circuit-space(p));
end;

definition
  let p be polyhedron, k be Integer;
  func k-bounding-chain-space(p) -> Subspace of k-chain-space(p) equals

  im ((k
  +1)-boundary(p));
end;

definition
  let p be polyhedron, k be Integer;
  func k-bounding-chains(p) -> non empty Subset of k-chains(p) equals

  [#](k
  -bounding-chain-space(p));
end;

definition
  let p be polyhedron, k be Integer;
  func k-bounding-circuit-space(p) -> Subspace of k-chain-space(p) equals

  (k
  -bounding-chain-space(p)) /\ (k-circuit-space(p));
end;

definition
  let p be polyhedron, k be Integer;
  func k-bounding-circuits(p) -> non empty Subset of k-chains(p) equals

  [#](k
  -bounding-circuit-space(p));
end;

theorem 
  dim (k-chain-space(p)) = rank (k-boundary(p)) + nullity (k-boundary(p)
  );

begin 



definition
  let p be polyhedron;
  attr p is simply-connected means


  for k being Integer holds k -circuits(p) = k-bounding-chains(p);
end;

theorem 
  p is simply-connected iff for n being Integer holds n
  -circuit-space(p) = n-bounding-chain-space(p);

definition
  let p be polyhedron;
  func alternating-f-vector(p) -> FinSequence of INT means


  len(it) =
dim(p) + 2 & for k being Nat st 1 <= k & k <= dim(p) + 2 holds it.k = ((-1)|^k)
  *num-polytopes(p,k-2);
end;

definition
  let p be polyhedron;
  func alternating-proper-f-vector(p) -> FinSequence of INT means


  len(
it) = dim(p) & for k being Nat st 1 <= k & k <= dim(p) holds it.k = ((-1)|^(k+1
  ))*num-polytopes(p,k-1);
end;

definition
  let p be polyhedron;
  func alternating-semi-proper-f-vector(p) -> FinSequence of INT means


len(it) = dim(p) + 1 & for k being Nat st 1 <= k & k <= dim(p) + 1 holds it.k =
  ((-1)|^(k+1))*num-polytopes(p,k-1);
end;

theorem 
  1 <= n & n <= len (alternating-proper-f-vector(p)) implies (
  alternating-proper-f-vector(p)).n = ((-1)|^(n+1))*(dim ((n-2)
  -bounding-chain-space(p))) + ((-1)|^(n+1))*(dim ((n-1)-circuit-space(p)));



definition
  let p be polyhedron;
  attr p is eulerian means


  Sum (alternating-proper-f-vector(p)) = 1 + (-1)|^(dim(p)+1);
end;

theorem 
  alternating-semi-proper-f-vector(p) =
  alternating-proper-f-vector(p) ^ <*(-1)|^(dim(p))*>;



definition
  let p be polyhedron;
  redefine attr p is eulerian means


  Sum ( alternating-semi-proper-f-vector(p)) = 1;
end;

theorem 
  alternating-f-vector(p) = <*-1*> ^ alternating-semi-proper-f-vector(p);



definition
  let p be polyhedron;
  redefine attr p is eulerian means


  Sum (alternating-f-vector(p)) = 0;
end;

begin 

theorem 
  0-polytopes(p) is non empty;

theorem 
  card [#]((-1)-chain-space(p)) = 2;

theorem 
  [#]((-1)-chain-space(p)) = { {}, {{}} };

theorem 
  for x being Element of k-polytopes(p), e being Element of (k-1)
  -polytopes(p) st k = 0 & e = {} holds incidence-value(e,x) = 1.Z_2;

theorem 
  for k being Integer, x being Element of k-polytopes(p), v being
Element of k-chain-space(p), e being Element of (k-1)-polytopes(p), n being Nat
  st k = 0 & v = {x} & e = {} & x = n-th-polytope(p,k) & 1 <= n & n <=
  num-polytopes(p,k) holds incidence-sequence(e,v).n = 1.Z_2;

theorem 
  for k being Integer, x being Element of k-polytopes(p), e being
  Element of (k-1)-polytopes(p), v being Element of k-chain-space(p), m,n being
Nat st k = 0 & v = {x} & x = n-th-polytope(p,k) & 1 <= m & m <= num-polytopes(p
,k) & 1 <= n & n <= num-polytopes(p,k) & m <> n holds incidence-sequence(e,v).m
  = 0.Z_2;

theorem 
  for k being Integer, x being Element of k-polytopes(p), v being
Element of k-chain-space(p), e being Element of (k-1)-polytopes(p) st k = 0 & v
  = {x} & e = {} holds Sum incidence-sequence(e,v) = 1.Z_2;

theorem 
  for x being Element of 0-polytopes(p) holds (0-boundary(p)).({x} ) = {{}};

theorem 
  k = -1 implies dim(k-bounding-chain-space(p)) = 1;

theorem 
  card [#](dim(p)-chain-space(p)) = 2;

theorem 
  {p} is Element of dim(p)-chain-space(p);

theorem 
  {p} in [#](dim(p)-chain-space(p));

theorem 
  (dim(p) - 1)-polytopes(p) is non empty;

registration
  let p be polyhedron;
  cluster (dim(p)-1)-polytopes(p) -> non empty;
end;

theorem 
  [#](dim(p)-chain-space(p)) = { 0.(dim(p)-chain-space(p)), {p} };

theorem 
  for x being Element of dim(p)-chain-space(p) holds x = 0.(dim(p)
  -chain-space(p)) or x = {p};

theorem 
  for x,y being Element of dim(p)-chain-space(p) st x <> y holds x
  = 0.(dim(p)-chain-space(p)) or y = 0.(dim(p)-chain-space(p));

theorem 
  dim(p)-polytope-seq(p) = <*p*>;

theorem 
  1-th-polytope(p,dim(p)) = p;

theorem 
  for c being Element of dim(p)-chain-space(p), x being Element of
  dim(p)-polytopes(p) st c = {p} holds c@x = 1.Z_2;

theorem 
  for x being Element of (dim(p)-1)-polytopes(p), c being Element
  of dim(p)-polytopes(p) st c = p holds incidence-value(x,c) = 1.Z_2;

theorem 
  for x being Element of (dim(p)-1)-polytopes(p), c being Element
  of dim(p)-chain-space(p) st c = {p} holds incidence-sequence(x,c) = <*1.Z_2*>
;

theorem 
  for x being Element of (dim(p)-1)-polytopes(p), c being Element
  of dim(p)-chain-space(p) st c = {p} holds Sum incidence-sequence(x,c) = 1.Z_2
;






theorem 
  (dim(p)-boundary(p)).{p} = (dim(p)-1)-polytopes(p);

theorem 
  dim(p)-boundary(p) is one-to-one;

theorem 
  dim ((dim(p)-1)-bounding-chain-space(p)) = 1;

theorem 
  p is simply-connected implies dim ((dim(p)-1)-circuit-space(p)) = 1;

theorem 
  1 < n & n < dim(p) + 2 implies (alternating-f-vector(p)).n = (
  alternating-proper-f-vector(p)).(n-1);

theorem 
  alternating-f-vector(p) = <*-1*> ^ alternating-proper-f-vector(p
  ) ^ <*(-1)|^(dim(p))*>;

begin 

theorem 
  dim(p) is odd implies Sum (alternating-f-vector(p)) = Sum (
  alternating-proper-f-vector(p)) - 2;

theorem 
  dim(p) is even implies Sum (alternating-f-vector(p)) = Sum (
  alternating-proper-f-vector(p));

theorem 
  dim(p) = 1 implies Sum alternating-proper-f-vector(p) = num-polytopes(p,0);

theorem 
  dim(p) = 2 implies Sum alternating-proper-f-vector(p) =
  num-polytopes(p,0) - num-polytopes(p,1);

theorem 
  dim(p) = 3 implies Sum alternating-proper-f-vector(p) =
  num-polytopes(p,0) - num-polytopes(p,1) + num-polytopes(p,2);



theorem 
  dim(p) = 0 implies p is eulerian;

theorem 
  p is simply-connected implies p is eulerian;




theorem 
  p is simply-connected & dim(p) = 1 implies num-vertices(p) = 2;




theorem 
  p is simply-connected & dim(p) = 2 implies num-vertices(p) = num-edges (p);




theorem 
  p is simply-connected & dim(p) = 3 implies num-vertices(p) - num-edges
  (p) + num-faces(p) = 2;














begin 

theorem 
  for seq be Real_Sequence, r be Real st seq is bounded & 0<=r
  holds lim_inf(r(#)seq)=r*(lim_inf seq);

theorem 
  for seq be Real_Sequence, r be Real st seq is bounded & 0<=r holds
  lim_sup(r(#)seq)=r*(lim_sup seq);

registration
  let X be RealBanachSpace;
  cluster MetricSpaceNorm X -> complete;
end;

definition
  let X be RealNormSpace, x0 be Point of X, r be real number;
  func Ball (x0,r) -> Subset of X equals

  { x where x is Point of X : ||.x0-x
  .|| < r };
end;


theorem 

  for X be RealBanachSpace, Y be SetSequence of X st union rng Y =
the carrier of X & (for n be Element of NAT holds Y.n is closed) holds ex n0 be
  Element of NAT, r be Real, x0 be Point of X st 0 < r & Ball (x0,r) c= Y.n0;

theorem 
  for X,Y be RealNormSpace, f be Lipschitzian LinearOperator of X,Y
holds f is_Lipschitzian_on the carrier of X & f is_continuous_on the carrier of
  X & for x be Point of X holds f is_continuous_in x;

theorem 
  for X be RealBanachSpace, Y be RealNormSpace, T be Subset of
R_NormSpace_of_BoundedLinearOperators(X,Y) st for x be Point of X ex K be real
number st 0 <= K & for f be Point of R_NormSpace_of_BoundedLinearOperators(X,Y)
st f in T holds ||. f.x .|| <= K holds ex L be real number st 0 <= L & for f be
Point of R_NormSpace_of_BoundedLinearOperators(X,Y) st f in T holds ||.f.|| <=
  L;

definition
  let X, Y be RealNormSpace, H be Function of NAT, the carrier of
  R_NormSpace_of_BoundedLinearOperators(X,Y), x be Point of X;
  func H # x -> sequence of Y means


  for n be Element of NAT holds it.n = (H.n).x;
end;

theorem 
  for X be RealBanachSpace, Y be RealNormSpace, vseq be sequence of
R_NormSpace_of_BoundedLinearOperators(X,Y), tseq be Function of X,Y st ( for x
be Point of X holds vseq#x is convergent & tseq.x = lim(vseq#x) ) holds tseq is
  Lipschitzian LinearOperator of X,Y & (for x be Point of X holds ||.tseq.x.||
  <=(lim_inf ||.vseq.|| ) * ||.x.|| ) & for ttseq be Point of
R_NormSpace_of_BoundedLinearOperators(X,Y) st ttseq = tseq holds ||.ttseq.|| <=
  lim_inf ||.vseq.||;

begin 


theorem 
  for X be RealBanachSpace, X0 be Subset of LinearTopSpaceNorm(X),
Y be RealBanachSpace, vseq be sequence of R_NormSpace_of_BoundedLinearOperators
  (X,Y) st X0 is dense & (for x be Point of X st x in X0 holds vseq#x is
  convergent) & (for x be Point of X ex K be real number st 0<=K & for n be
Element of NAT holds ||.(vseq#x).n.|| <=K) holds for x be Point of X holds vseq
  #x is convergent;

theorem 
  for X,Y be RealBanachSpace, X0 be Subset of LinearTopSpaceNorm(X),
vseq be sequence of R_NormSpace_of_BoundedLinearOperators(X,Y) st X0 is dense &
  ( for x be Point of X st x in X0 holds vseq#x is convergent ) & ( for x be
Point of X ex K be real number st 0<=K & ( for n be Element of NAT holds ||. (
  vseq#x).n .|| <= K ) ) holds ex tseq be Point of
R_NormSpace_of_BoundedLinearOperators(X,Y) st ( for x be Point of X holds vseq#
  x is convergent & tseq.x=lim (vseq#x) & ||.tseq.x.|| <= lim_inf ||.vseq.|| *
  ||.x.|| ) & ||.tseq.|| <= lim_inf ||.vseq.||;














begin

reserve i,i1,i2,i3,i4,i5,j,r,a,b,x,y for Integer,
  d,e,k,n for Nat,
  fp,fk for FinSequence of INT,
  f,f1,f2 for FinSequence of REAL,
  p for Prime;

theorem 
  i1 divides i2 & i1 divides i3 implies i1 divides i2-i3;

theorem 
  i divides a & i divides (a-b) implies i divides b;

definition
  let fp;
  func Poly-INT fp -> Function of INT,INT means


  for x being Element of
  INT holds ex fr being FinSequence of INT st len fr = len fp & (for d st d in
  dom fr holds fr.d = (fp.d) * x|^(d-'1)) & it.x = Sum fr;
end;

theorem 
  len fp = 1 implies (Poly-INT fp) = INT --> fp.1;

theorem 
  len fp = 1 implies for x being Element of INT holds (Poly-INT fp).x = fp.1;

reserve fr for FinSequence of REAL;

theorem 
  for f,f1,f2 st len f = n+1 & len f1 = len f & len f2 = len f & (
for d st d in dom f holds f.d = f1.d - f2.d) holds ex fr st len fr = len f - 1
& (for d st d in dom fr holds fr.d = f1.d - f2.(d + 1)) & Sum f = Sum fr + f1.(
  n+1) - f2.1;

theorem 
  len fp = n+2 implies for a being Integer holds ex fr being
  FinSequence of INT, r being Integer st len fr = n+1 & (for x being Element of
  INT holds (Poly-INT fp).x = (x-a)*(Poly-INT fr).x + r) & fp.(n+2) = fr.(n+1);

theorem 
  p divides i*j implies p divides i or p divides j;

reserve fr,f for FinSequence of INT;

theorem 
  for fp st len fp = n+1 & p>2 & not p divides fp.(n+1) holds for
fr st (for d st d in dom fr holds (Poly-INT fp).(fr.d) mod p=0) & (for d,e st d
  in dom fr & e in dom fr & d<>e holds not fr.d,fr.e are_congruent_mod p) holds
  len fr <= n;

definition
  let a be Integer, m be Nat;
  pred a is_quadratic_residue_mod m means

  ex x being Integer st (x^2 - a) mod m = 0;
end;

reserve b,m for Nat;

theorem 
  a^2 is_quadratic_residue_mod m;

theorem 
  1 is_quadratic_residue_mod 2;

theorem 
  i is_quadratic_residue_mod m & i,j are_congruent_mod m implies
  j is_quadratic_residue_mod m;

theorem 
  i divides j implies i gcd j = abs(i);

theorem 
  for i,j,m being Integer st i mod m = j mod m holds i|^n mod m = j|^n mod m;

theorem 
  a gcd p = 1 & (x^2 - a) mod p = 0 implies x,p are_relative_prime;

theorem 
  p > 2 & a gcd p = 1 & a is_quadratic_residue_mod p implies ex x,y
  being Integer st (x^2 - a) mod p = 0 & (y^2 - a) mod p = 0 & not x,y
  are_congruent_mod p;

theorem 
  p>2 implies ex fp being FinSequence of NAT st len fp = (p-'1)
  div 2 & (for d st d in dom fp holds fp.d gcd p = 1) & (for d st d in dom fp
holds fp.d is_quadratic_residue_mod p) & for d,e st d in dom fp & e in dom fp &
  d<>e holds not fp.d,fp.e are_congruent_mod p;



theorem 
  p > 2 & a gcd p = 1 & a is_quadratic_residue_mod p implies
  a|^((p-'1) div 2) mod p = 1;

theorem 
  p>2 & b gcd p = 1 & not b is_quadratic_residue_mod p implies
  b|^((p-'1) div 2) mod p = p - 1;

theorem 
  p>2 & a gcd p = 1 & not a is_quadratic_residue_mod p implies
  a|^((p-'1) div 2) mod p = p - 1;

theorem 
  p > 2 & a gcd p = 1 & a is_quadratic_residue_mod p implies (a|^(
  (p-'1) div 2) - 1) mod p = 0;

theorem 
  p > 2 & a gcd p = 1 & not a is_quadratic_residue_mod p implies
  (a|^((p-'1) div 2) + 1) mod p = 0;

reserve b for Integer;

theorem 
  a is_quadratic_residue_mod p & b is_quadratic_residue_mod p implies
  a*b is_quadratic_residue_mod p;

theorem 
  p>2 & a gcd p = 1 & b gcd p = 1 & a is_quadratic_residue_mod p & not b
  is_quadratic_residue_mod p implies not a*b is_quadratic_residue_mod p;

theorem 
  p>2 & a gcd p = 1 & b gcd p = 1 & not a is_quadratic_residue_mod p &
  not b is_quadratic_residue_mod p implies a*b is_quadratic_residue_mod p;

definition
  let a be Integer, p be Prime;
  func Lege (a,p) -> Integer equals

  1 if (a is_quadratic_residue_mod p & a mod p <> 0),
  0 if (a is_quadratic_residue_mod p & a mod p = 0)
  otherwise -1;
end;

theorem 
  Lege (a,p) = 1 or Lege (a,p) = 0 or Lege (a,p) = -1;

theorem 
  a mod p <> 0 implies Lege (a^2,p) = 1;

theorem 
  Lege (1,p) = 1;

theorem 
  p>2 & a gcd p = 1 implies Lege (a,p),a|^((p-'1) div 2) are_congruent_mod p;

theorem 
  p>2 & a gcd p =1 & a,b are_congruent_mod p implies Lege (a,p) = Lege (b,p);

theorem 
  p>2 & a gcd p=1 & b gcd p=1 implies Lege(a*b,p)=Lege(a,p)*Lege(b,p);

theorem 
  (for d st d in dom fr holds fr.d = 1 or fr.d = 0 or fr.d = -1) implies
  Product fr = 1 or Product fr = 0 or Product fr = -1;

reserve m for Integer;

theorem 
  for f,fr st len f = len fr & (for d st d in dom f holds f.d,fr.d
  are_congruent_mod m) holds Product f,Product fr are_congruent_mod m;

theorem 
  for f,fr st len f = len fr & (for d st d in dom f holds f.d,-fr.
  d are_congruent_mod m) holds Product f,((-1)|^(len f))*Product fr
  are_congruent_mod m;

reserve fp for FinSequence of NAT;

theorem 
  p>2 & (for d st d in dom fp holds fp.d gcd p = 1) implies ex fr
being FinSequence of INT st len fr = len fp & (for d st d in dom fr holds fr.d
  = Lege (fp.d,p)) & Lege (Product fp,p) = Product fr;

theorem 
  p > 2 & d gcd p = 1 & e gcd p = 1 implies Lege((d^2)*e,p) = Lege(e,p);

theorem 
  p>2 implies Lege (-1,p) = (-1)|^((p-'1) div 2);

theorem 
  p>2 & p mod 4 = 1 implies (-1) is_quadratic_residue_mod p;

theorem 
  p>2 & p mod 4 = 3 implies not (-1) is_quadratic_residue_mod p;

begin 

theorem 
  for D being non empty set,f being FinSequence of D, i,j being
  Nat holds f is one-to-one iff Swap(f,i,j) is one-to-one;

theorem 
  for f being FinSequence of NAT st len f = n & (for d st d in dom
  f holds f.d>0 & f.d<=n) & f is one-to-one holds rng f = Seg n;

reserve a,m for Nat;

theorem 
  for f be FinSequence of NAT st p>2 & a gcd p = 1 & f = a*(idseq
((p-'1) div 2)) & m=card{k where k is Element of NAT:k in rng (f mod p) & k > p
  /2} holds Lege(a,p) = (-1)|^m;

theorem 
  p>2 implies Lege(2,p) = (-1)|^((p^2 -'1) div 8);

theorem 
  p>2 & (p mod 8 = 1 or p mod 8 = 7) implies 2 is_quadratic_residue_mod p;

theorem 
  p>2 & (p mod 8 = 3 or p mod 8 = 5) implies not 2 is_quadratic_residue_mod p;

theorem 
  for a,b be Nat st a mod 2 = b mod 2 holds (-1)|^a = (-1)|^b;

reserve f,g,h,k for FinSequence of REAL;

theorem 
  len f = len h & len g = len k implies f^g-h^k = (f-h)^(g-k);

theorem 
  for f be FinSequence of REAL,m be Real holds Sum(((len f) |-> m)
  - f) = (len f)*m - Sum f;

reserve X for finite set,
  F for FinSequence of bool X;

definition
  let X, F;
  redefine func Card F -> Cardinal-yielding FinSequence of NAT;
end;

theorem 
  for f be FinSequence of bool X st len f = n & (for d,e st d in
  dom f & e in dom f & d<>e holds f.d misses f.e) holds card union rng f = Sum
  Card f;

reserve q for Prime;


theorem 
  p>2 & q>2 & p<>q implies
  Lege(p,q)*Lege(q,p)=(-1)|^(((p-'1) div 2)*((q-'1) div 2));

theorem 
  p>2 & q>2 & p<>q & p mod 4 = 3 & q mod 4 = 3 implies Lege(p,q) = -Lege (q,p);

theorem 
  p>2 & q>2 & p<>q & (p mod 4 = 1 or q mod 4 = 1) implies Lege(p,q) = Lege(q,p)
;














begin

reserve E, x, y, X for set;
reserve A, B, C for Subset of E^omega;
reserve a, a1, a2, b for Element of E^omega;

reserve i, k, l, m, n for Nat;

theorem 
  B c= A* implies A* ^^ B c= A* & B ^^ (A*) c= A*;

begin




definition
  let E, A, n;
  func A |^.. n -> Subset of E^omega equals

  union { B: ex m st n <= m & B = A
  |^ m };
end;




theorem 
  x in A |^.. n iff ex m st n <= m & x in A |^ m;

theorem 
  n <= m implies A |^ m c= A |^.. n;

theorem 
  A |^.. n = {} iff n > 0 & A = {};

theorem 
  m <= n implies A |^.. n c= A |^.. m;

theorem 
  k <= m implies A |^ (m, n) c= A |^.. k;

theorem 
  m <= n + 1 implies A |^ (m, n) \/ A |^.. (n + 1) = A |^.. m;

theorem 
  A |^ n \/ A |^.. (n + 1) = A |^.. n;

theorem 
  A |^.. n c= A*;

theorem 
  <%>E in A |^.. n iff n = 0 or <%>E in A;

theorem 
  A |^.. n = A* iff <%>E in A or n = 0;

theorem 
  A* = A |^ (0, n) \/ A |^.. (n + 1);

theorem 
  A c= B implies A |^.. n c= B |^.. n;

theorem 
  x in A & x <> <%>E implies A |^.. n <> {<%>E};

theorem 
  A |^.. n = {<%>E} iff A = {<%>E} or n = 0 & A = {};

theorem 
  A |^.. (n + 1) = (A |^.. n) ^^ A;

theorem 
  (A |^.. m) ^^ (A*) = A |^.. m;

theorem 
  (A |^.. m) ^^ (A |^.. n) = A |^.. (m + n);

theorem 
  n > 0 implies (A |^.. m) |^ n = A |^.. (m * n);

theorem 
  (A |^.. n)* = (A |^.. n)?;

theorem 
  A c= C |^.. m & B c= C |^.. n implies A ^^ B c= C |^.. (m + n);

theorem 
  A |^.. (n + k) = (A |^.. n) ^^ (A |^ k);

theorem 
  A ^^ (A |^.. n) = (A |^.. n) ^^ A;

theorem 
  (A |^ k) ^^ (A |^.. n) = (A |^.. n) ^^ (A |^ k);

theorem 
  (A |^ (k, l)) ^^ (A |^.. n) = (A |^.. n) ^^ (A |^ (k, l));

theorem 
  <%>E in B implies A c= A ^^ (B |^.. n) & A c= (B |^.. n) ^^ A;

theorem 
  (A |^.. m) ^^ (A |^.. n) = (A |^.. n) ^^ (A |^.. m);

theorem 
  A c= B |^.. k & n > 0 implies A |^ n c= B |^.. k;

theorem 
  A c= B |^.. k & n > 0 implies A |^.. n c= B |^.. k;

theorem 
  A* ^^ A = A |^.. 1;

theorem 
  A* ^^ (A |^ k) = A |^.. k;

theorem 
  (A |^.. m) ^^ (A*) = A* ^^ (A |^.. m);

theorem 
  k <= l implies (A |^.. n) ^^ (A |^ (k, l)) = A |^.. (n + k);

theorem 
  k <= l implies A* ^^ (A |^ (k, l)) = A |^.. k;

theorem 
  (A |^ m) |^.. n c= A |^.. (m * n);

theorem 
  (A |^ m) |^.. n c= (A |^.. n) |^ m;

theorem 
  a in C |^.. m & b in C |^.. n implies a ^ b in C |^.. (m + n);

theorem 
  A |^.. k = {x} implies x = <%>E;

theorem 
  A c= B* implies A |^.. n c= B*;

theorem 
  A? c= A |^.. k iff k = 0 or <%>E in A;

theorem 
  A |^.. k ^^ (A?) = A |^.. k;

theorem 
  A |^.. k ^^ (A?) = A? ^^ (A |^.. k);

theorem 
  B c= A* implies A |^.. k ^^ B c= A |^.. k & B ^^ (A |^.. k) c= A |^.. k;

theorem 
  (A /\ B) |^.. k c= (A |^.. k) /\ (B |^.. k);

theorem 
  (A |^.. k) \/ (B |^.. k) c= (A \/ B) |^.. k;

theorem 
  <%x%> in A |^.. k iff <%x%> in A & (<%>E in A or k <= 1);

theorem 
  A c= B |^.. k implies B |^.. k = (B \/ A) |^.. k;

begin




definition
  let E, A;
  func A+ -> Subset of E^omega equals

  union { B: ex n st n > 0 & B = A |^ n };
end;




theorem 
  x in A+ iff ex n st n > 0 & x in A |^ n;

theorem 
  n > 0 implies A |^ n c= A+;

theorem 
  A+ = A |^.. 1;

theorem 
  A+ = {} iff A = {};

theorem 
  A+ = (A*) ^^ A;

theorem 
  A* = {<%>E} \/ (A+);

theorem 
  A+ = A |^ (1, n) \/ A |^.. (n + 1);

theorem 
  A+ c= A*;

theorem 
  <%>E in A+ iff <%>E in A;

theorem 
  A+ = A* iff <%>E in A;

theorem 
  A c= B implies A+ c= B+;

theorem 
  A c= A+;

theorem 
  (A*)+ = A* & (A+)* = A*;

theorem 
  A c= B* implies A+ c= B*;

theorem 
  (A+)+ = A+;

theorem 
  x in A & x <> <%>E implies A+ <> {<%>E};

theorem 
  A+ = {<%>E} iff A = {<%>E};

theorem 
  (A+)? = A* & (A?)+ = A*;

theorem 
  a in C+ & b in C+ implies a ^ b in C+;

theorem 
  A c= C+ & B c= C+ implies A ^^ B c= C+;

theorem 
  A ^^ A c= A+;

theorem 
  A+ = {x} implies x = <%>E;

theorem 
  A ^^ (A+) = (A+) ^^ A;

theorem 
  (A |^ k) ^^ (A+) = (A+) ^^ (A |^ k);

theorem 
  (A |^ (m, n)) ^^ (A+) = A+ ^^ (A |^ (m, n));

theorem 
  <%>E in B implies A c= A ^^ (B+) & A c= (B+) ^^ A;

theorem 
  A+ ^^ (A+) = A |^.. 2;

theorem 
  A+ ^^ (A |^ k) = A |^.. (k + 1);

theorem 
  A+ ^^ A = A |^.. 2;

theorem 
  k <= l implies A+ ^^ (A |^ (k, l)) = A |^.. (k + 1);

theorem 
  A c= B+ & n > 0 implies A |^ n c= B+;

theorem 
  A+ ^^ (A?) = A? ^^ (A+);

theorem 
  A+ ^^ (A?) = A+;

theorem 
  A? c= A+ iff <%>E in A;

theorem 
  A c= B+ implies A+ c= B+;

theorem 
  A c= B+ implies B+ = (B \/ A)+;

theorem 
  n > 0 implies A |^.. n c= A+;

theorem 
  m > 0 implies A |^ (m, n) c= A+;

theorem 
  A* ^^ (A+) = A+ ^^ (A*);

theorem 
  A+ |^ k c= A |^.. k;

theorem 
  A+ |^ (m, n) c= A |^.. m;

theorem 
  A c= B+ & n > 0 implies A |^.. n c= B+;

theorem 
  A+ ^^ (A |^.. k) = A |^.. (k + 1);

theorem 
  A+ ^^ (A |^.. k) = A |^.. k ^^ (A+);

theorem 
  A+ ^^ (A*) = A+;

theorem 
  B c= A* implies A+ ^^ B c= A+ & B ^^ (A+) c= A+;

theorem 
  (A /\ B)+ c= (A+) /\ (B+);

theorem 
  (A+) \/ (B+) c= (A \/ B)+;

theorem 
  <%x%> in A+ iff <%x%> in A;














begin 

reserve i,n,m for Nat,
  x,y,X,Y for set,
  r,s for Real;

definition
  let M be non empty MetrStruct;
  let S be SetSequence of M;
  attr S is pointwise_bounded means


  for i holds S.i is bounded;
end;

registration
  let M be non empty Reflexive MetrStruct;
  cluster pointwise_bounded non-empty for SetSequence of M;
end;

definition
  let M be Reflexive non empty MetrStruct;
  let S be SetSequence of M;
  func diameter S -> Real_Sequence means


  for i holds it.i = diameter S. i;
end;

theorem 
  for M be Reflexive non empty MetrStruct for S be pointwise_bounded
  SetSequence of M holds diameter S is bounded_below;

theorem 
  for M be Reflexive non empty MetrStruct for S be pointwise_bounded
  SetSequence of M st S is non-ascending holds diameter S is bounded_above &
  diameter S is non-increasing;

theorem 
  for M be Reflexive non empty MetrStruct
  for S be pointwise_bounded SetSequence of M st
  S is non-descending holds diameter S is non-decreasing;

theorem 
  for M be non empty Reflexive MetrStruct for S be pointwise_bounded
  SetSequence of M st S is non-ascending & lim diameter S = 0 for F be sequence
  of M st for i holds F.i in S.i holds F is Cauchy;

theorem 
  for M be Reflexive symmetric triangle non empty MetrStruct for p
  be Point of M holds 0 <= r implies diameter cl_Ball(p,r) <= 2*r;

definition
  let M be MetrStruct;
  let U be Subset of M;
  attr U is open means


  U in Family_open_set M;
end;

definition
  let M be MetrStruct;
  let A be Subset of M;
  attr A is closed means


  A` is open;
end;

registration
  let M be MetrStruct;
  cluster empty -> open for Subset of M;
  cluster empty -> closed for Subset of M;
end;

registration
  let M be non empty MetrStruct;
  cluster open non empty for Subset of M;
  cluster closed non empty for Subset of M;
end;

theorem 
  for M be MetrStruct for A be Subset of M, A9 be Subset of
TopSpaceMetr M st A9 = A holds ( A is open iff A9 is open ) & ( A is closed iff
  A9 is closed );

definition
  let T be TopStruct;
  let S be SetSequence of T;
  attr S is open means


  for i holds S.i is open;
  attr S is closed means


  for i holds S.i is closed;
end;

registration
  let T be TopSpace;
  cluster open for SetSequence of T;
  cluster closed for SetSequence of T;
end;

registration
  let T be non empty TopSpace;
  cluster open non-empty for SetSequence of T;
  cluster closed non-empty for SetSequence of T;
end;

definition
  let M be MetrStruct;
  let S be SetSequence of M;
  attr S is open means


  for i holds S.i is open;
  attr S is closed means


  for i holds S.i is closed;
end;

registration
  let M be non empty MetrSpace;
  cluster non-empty pointwise_bounded open for SetSequence of M;
  cluster non-empty pointwise_bounded closed for SetSequence of M;
end;

theorem 
  for M be MetrStruct for S be SetSequence of M, S9 be SetSequence
of TopSpaceMetr M st S9 = S holds ( S is open iff S9 is open ) & ( S is closed
  iff S9 is closed );

theorem 
  for M be Reflexive symmetric triangle non empty MetrStruct for S,
CL be Subset of M st S is bounded for S9 be Subset of TopSpaceMetr M st S = S9
  & CL = Cl S9 holds CL is bounded & diameter S = diameter CL;

begin 

theorem 
  for M be non empty MetrSpace for C be sequence of M ex S be
non-empty closed SetSequence of M st S is non-ascending & ( C is Cauchy implies
S is pointwise_bounded & lim diameter S = 0 ) &
for i ex U be Subset of TopSpaceMetr M st
  U = { C.j where j is Element of NAT: j >= i } & S.i = Cl U;

theorem 
  for M be non empty MetrSpace holds M is complete iff for S be
non-empty pointwise_bounded closed SetSequence of M st S is non-ascending &
lim diameter S = 0 holds meet S is non empty;

theorem 
  for T be non empty TopSpace for S be non-empty SetSequence of T
  st S is non-ascending for F be Subset-Family of T st F = rng S holds F is
  centered;

theorem 
  for M be non empty MetrStruct for S be SetSequence of M for F be
  Subset-Family of TopSpaceMetr M st F = rng S holds ( S is open implies F is
  open ) & ( S is closed implies F is closed );

theorem 
  for T be non empty TopSpace for F be Subset-Family of T for S be
SetSequence of T st rng S c= F ex R be SetSequence of T st R is non-ascending &
( F is centered implies R is non-empty ) & ( F is open implies R is open ) & (
  F is closed implies R is closed ) & for i holds R.i = meet {S.j where j is
  Element of NAT: j <= i};

theorem 
  for M be non empty MetrSpace holds M is complete iff for F be
Subset-Family of TopSpaceMetr M st F is closed & F is centered & for r be Real
  st r > 0 ex A be Subset of M st A in F & A is bounded & diameter A < r holds
  meet F is non empty;

theorem 
  for M be non empty MetrSpace,A be non empty Subset of M for B be
Subset of M, B9 be Subset of M|A st B = B9 holds B9 is bounded iff B is bounded
;

theorem 
  for M be non empty MetrSpace,A be non empty Subset of M for B be
Subset of M, B9 be Subset of M|A st B = B9 & B is bounded holds diameter B9 <=
  diameter B;

theorem 
  for M be non empty MetrSpace, A be non empty Subset of M for S
  be sequence of (M|A) holds S is sequence of M;

theorem 
  for M be non empty MetrSpace, A be non empty Subset of M for S
be sequence of (M|A),S9 be sequence of M st S = S9 holds S9 is Cauchy iff S is
  Cauchy;

theorem 
  for M be non empty MetrSpace st M is complete for A be non empty
Subset of M, A9 be Subset of TopSpaceMetr M st A = A9 holds M|A is complete iff
  A9 is closed;

begin 

definition
  let T be TopStruct;
  attr T is countably_compact means


  for F being Subset-Family of T st F
  is Cover of T & F is open & F is countable ex G being Subset-Family of T st G
  c= F & G is Cover of T & G is finite;
end;

theorem 
  for T be TopStruct st T is compact holds T is countably_compact;

theorem 
  for T being non empty TopSpace holds T is countably_compact iff
for F being Subset-Family of T st F is centered & F is closed & F is countable
  holds meet F <> {};

theorem 
  for T being non empty TopSpace holds T is countably_compact iff
  for S be non-empty closed SetSequence of T st S is non-ascending holds meet S
  <> {};

theorem 
  for T being non empty TopSpace for F be Subset-Family of T for S
  be SetSequence of T st rng S c= F & S is non-empty ex R be non-empty closed
  SetSequence of T st R is non-ascending & ( F is locally_finite & S is
  one-to-one implies meet R = {} ) & for i ex Si be Subset-Family of T st R.i =
  Cl union Si & Si = {S.j where j is Element of NAT: j >= i};

canceled;

theorem 
  for X be non empty set, F be SetSequence of X st F is
non-ascending for S be Function of NAT,X st for n holds S.n in F.n holds rng S
  is finite implies meet F is non empty;

theorem 
  for T be non empty TopSpace holds T is countably_compact iff for
  F be Subset-Family of T st F is locally_finite & F is with_non-empty_elements
  holds F is finite;

theorem 
  for T be non empty TopSpace holds T is countably_compact iff for
F be Subset-Family of T st F is locally_finite & for A be Subset of T st A in F
  holds card A = 1 holds F is finite;

theorem 
  for T be T_1 non empty TopSpace holds T is countably_compact iff
  for A be Subset of T st A is infinite holds Der A is non empty;

theorem 
  for T be T_1 non empty TopSpace holds T is countably_compact iff for A
be Subset of T st A is infinite countable holds Der A is non empty;

scheme 

  Th39{X()->non empty set,P[set,set]}: ex A be Subset of X() st ( for x,y be
Element of X() st x in A & y in A & x <> y holds P[x,y] ) & for x be Element of
  X() ex y be Element of X() st y in A & not P[x,y]
provided
 for x,y be Element of X() holds P[x,y] iff P[y,x] and
 for x be Element of X() holds not P[x,x];

theorem 
  for M be Reflexive symmetric non empty MetrStruct for r be Real
  st r > 0 ex A be Subset of M st (for p,q be Point of M st p <> q & p in A & q
in A holds dist(p,q) >= r) & for p be Point of M ex q be Point of M st q in A &
  p in Ball(q,r);

theorem 
  for M be Reflexive symmetric triangle non empty MetrStruct holds
  M is totally_bounded iff for r be Real,A be Subset of M st r>0 & for p,q be
  Point of M st p <> q & p in A & q in A holds dist(p,q) >= r holds A is finite
;

theorem 
  for M be Reflexive symmetric triangle non empty MetrStruct st
  TopSpaceMetr M is countably_compact holds M is totally_bounded;

theorem 
  for M be non empty MetrSpace st M is totally_bounded holds
  TopSpaceMetr M is second-countable;

theorem 
  for T be non empty TopSpace holds T is second-countable implies
  for F being Subset-Family of T st F is Cover of T & F is open ex G being
  Subset-Family of T st G c= F & G is Cover of T & G is countable;

begin 

theorem 
  for M be non empty MetrSpace holds TopSpaceMetr M is compact iff
  TopSpaceMetr M is countably_compact;

theorem 
  for X be set, F be Subset-Family of X st F is finite for A be
  Subset of X st A is infinite & A c= union F ex Y be Subset of X st Y in F & Y
  /\ A is infinite;

theorem 
  for M be non empty MetrSpace holds TopSpaceMetr M is compact iff M is
  totally_bounded & M is complete;

begin 

theorem 
  for M be MetrStruct, a be Point of M,x holds x in [:X,(the
carrier of M)\{a}:]\/{[X,a]} iff ex y be set,b be Point of M st x=[y,b] & (y in
  X & b<>a or y = X & b = a);

definition
  let M be MetrStruct;
  let a be Point of M;
  let X be set;
  func well_dist(a,X) -> Function of [:[:X,(the carrier of M)\{a}:]\/{[X,a]},
  [:X,(the carrier of M)\{a}:]\/{[X,a]}:],REAL means


  for x,y be Element
  of [:X,(the carrier of M)\{a}:]\/{[X,a]} for x1,y1 be set,x2,y2 be Point of M
st x = [x1,x2] & y = [y1,y2] holds (x1 = y1 implies it.(x,y) = dist(x2,y2) ) &
  (x1 <> y1 implies it.(x,y) = dist(x2,a)+dist(a,y2) );
end;

theorem 
  for M be MetrStruct,a be Point of M for X be non empty set holds (
  well_dist(a,X) is Reflexive implies M is Reflexive ) & ( well_dist(a,X) is
  symmetric implies M is symmetric ) & ( well_dist(a,X) is triangle Reflexive
implies M is triangle ) & (well_dist(a,X) is discerning Reflexive implies M is
  discerning );

definition
  let M be MetrStruct;
  let a be Point of M;
  let X be set;
  func WellSpace(a,X) -> strict MetrStruct equals

  MetrStruct (#[:X,(the
    carrier of M)\{a}:]\/{[X,a]},well_dist(a,X)#);
end;

registration
  let M be MetrStruct;
  let a be Point of M;
  let X be set;
  cluster WellSpace(a,X) -> non empty;
end;

registration
  let M be Reflexive MetrStruct;
  let a be Point of M;
  let X be set;
  cluster WellSpace(a,X) -> Reflexive;
end;

registration
  let M be symmetric MetrStruct;
  let a be Point of M;
  let X be set;
  cluster WellSpace(a,X) -> symmetric;
end;

registration
  let M be symmetric triangle Reflexive MetrStruct;
  let a be Point of M;
  let X be set;
  cluster WellSpace(a,X) -> triangle;
end;

registration
  let M be MetrSpace;
  let a be Point of M;
  let X be set;
  cluster WellSpace(a,X) -> discerning;
end;

theorem 
  for M be triangle Reflexive non empty MetrStruct for a be Point of M
  for X be non empty set holds WellSpace(a,X) is complete implies M is complete
;

theorem 
  for M be symmetric triangle Reflexive non empty MetrStruct for a
be Point of M for S be sequence of WellSpace(a,X) st S is Cauchy holds (for Xa
  be Point of WellSpace(a,X) st Xa=[X,a] for r st r > 0 ex n st for m st m >= n
holds dist(S.m,Xa) < r) or ex n,Y st for m st m >= n ex p be Point of M st S.m
  = [Y,p];

theorem 
  for M be symmetric triangle Reflexive non empty MetrStruct for a
  be Point of M holds M is complete implies WellSpace(a,X) is complete;

theorem 
  for M be symmetric triangle Reflexive non empty MetrStruct st M
is complete for a be Point of M st ex b be Point of M st dist(a,b)<>0 for X be
  infinite set holds WellSpace(a,X) is complete &
  ex S be non-empty pointwise_bounded
  SetSequence of WellSpace(a,X) st S is closed & S is non-ascending & meet S is
  empty;

theorem 
  ex M be non empty MetrSpace st M is complete & ex S be non-empty
pointwise_bounded SetSequence of M st S is closed & S is non-ascending &
meet S is empty;














begin 

definition
  struct (BCIStr_0,ZeroStr) BCIStr_1 (# carrier -> set, ExternalDiff,
    InternalDiff -> BinOp of the carrier, ZeroF -> Element of the carrier #);
end;

registration
  cluster non empty strict for BCIStr_1;
end;

definition
  let A be BCIStr_1;
  let x,y be Element of A;
  func x * y -> Element of A equals

  (the ExternalDiff of A).(x,y);
end;

definition
  let IT be non empty BCIStr_1;
  attr IT is with_condition_S means


  for x,y,z being Element of IT holds (x\y)\z = x\(y*z);
end;

definition
  func BCI_S-EXAMPLE -> BCIStr_1 equals

  BCIStr_1 (# 1, op2, op2, op0 #);
end;

registration
  cluster BCI_S-EXAMPLE -> strict 1-element;
end;

registration
  cluster BCI_S-EXAMPLE -> being_B being_C being_I being_BCI-4 being_BCK-5
    with_condition_S;
end;

registration
  cluster strict being_B being_C being_I being_BCI-4 with_condition_S for non
    empty BCIStr_1;
end;

definition
  mode BCI-Algebra_with_Condition(S) is being_B being_C being_I being_BCI-4
    with_condition_S non empty BCIStr_1;
end;

reserve X for non empty BCIStr_1;
reserve d for Element of X;
reserve n,m,k for Element of NAT;
reserve f for Function of NAT, the carrier of X;

definition
  let X be BCI-Algebra_with_Condition(S);
  let x,y be Element of X;
  func Condition_S(x,y) -> non empty Subset of X equals

  {t where t is Element
  of X: t\x <= y};
end;

theorem 
  for X be BCI-Algebra_with_Condition(S),x,y,u,v being Element of X st u
  in Condition_S(x,y) & v <= u holds v in Condition_S(x,y);

theorem 
  for X being BCI-Algebra_with_Condition(S) holds for x,y being Element
  of X holds ex a be Element of Condition_S(x,y) st for z being Element of
  Condition_S(x,y) holds z <= a;

theorem 
  X is BCI-algebra & (for x,y being Element of X holds ((x*y)\x <= y &
  for t being Element of X st t\x <= y holds t <= (x*y))) iff X is
  BCI-Algebra_with_Condition(S);

theorem 
  for X being BCI-Algebra_with_Condition(S) holds for x,y being Element
  of X holds ex a be Element of Condition_S(x,y) st for z being Element of
  Condition_S(x,y) holds z <= a;

definition
  let X be p-Semisimple BCI-algebra;
  func Adjoint_pGroup X -> strict AbGroup means

  the carrier of it = the
carrier of X & (for x,y being Element of X holds (the addF of it).(x,y) = x\(0.
  X\y)) & 0.it = 0.X;
end;

theorem 
  for X being BCI-algebra holds X is p-Semisimple iff for x,y being
  Element of X st x\y = 0.X holds x=y;

theorem 
  for X being BCI-Algebra_with_Condition(S) st X is p-Semisimple holds
  for x,y being Element of X holds x*y = x\(0.X\y);

theorem 
  for X being BCI-Algebra_with_Condition(S) holds for x,y being
  Element of X holds x*y = y*x;

theorem 
  for X being BCI-Algebra_with_Condition(S) holds for x,y,z being
  Element of X holds x <= y implies x*z <= y*z & z*x <= z*y;

theorem 
  for X being BCI-Algebra_with_Condition(S) holds for x being
  Element of X holds 0.X*x = x & x*0.X = x;

theorem 
  for X being BCI-Algebra_with_Condition(S) holds for x,y,z being
  Element of X holds (x*y)*z = x*(y*z);

theorem 
  for X being BCI-Algebra_with_Condition(S) holds for x,y,z being
  Element of X holds (x*y)*z = (x*z)*y;

theorem 
  for X being BCI-Algebra_with_Condition(S) holds for x,y,z being
  Element of X holds (x\y)\z = x\(y*z);

theorem 
  for X being BCI-Algebra_with_Condition(S) holds for x,y being
  Element of X holds y <= x*(y\x);

theorem 
  for X being BCI-Algebra_with_Condition(S) holds for x,y,z being
  Element of X holds (x*z)\(y*z) <= x\y;

theorem 
  for X being BCI-Algebra_with_Condition(S) holds for x,y,z being
  Element of X holds x\y <= z iff x <= y*z;

theorem 
  for X being BCI-Algebra_with_Condition(S) holds for x,y,z being
  Element of X holds x\y <= (x\z)*(z\y);

registration
  let X be BCI-Algebra_with_Condition(S);
  cluster the ExternalDiff of X -> commutative associative;
end;

theorem 
  for X being BCI-Algebra_with_Condition(S) holds 0.X
  is_a_unity_wrt the ExternalDiff of X;

theorem 
  for X being BCI-Algebra_with_Condition(S) holds the_unity_wrt the
  ExternalDiff of X = 0.X;

theorem 
  for X being BCI-Algebra_with_Condition(S) holds the ExternalDiff
  of X is having_a_unity;

definition
  let X be BCI-Algebra_with_Condition(S);
  func power X -> Function of [:the carrier of X,NAT:], the carrier of X means


  for h being Element of X holds it.(h,0) = 0.X & for n holds it.(h,n + 1)
  = it.(h,n) * h;
end;

definition
  let X be BCI-Algebra_with_Condition(S);
  let x be Element of X;
  let n;
  func x |^ n -> Element of X equals

  power(X).(x,n);
end;

theorem 
  for X being BCI-Algebra_with_Condition(S) holds for x being Element of
  X holds x |^ 0 = 0.X;

theorem 
  for X being BCI-Algebra_with_Condition(S) holds for x being Element of
  X holds x |^ (n + 1) = (x|^n) * x;

theorem 
  for X being BCI-Algebra_with_Condition(S) holds for x being
  Element of X holds x |^ 1 = x;

theorem 
  for X being BCI-Algebra_with_Condition(S) holds for x being
  Element of X holds x |^ 2 = x * x;

theorem 
  for X being BCI-Algebra_with_Condition(S) holds for x being Element of
  X holds x |^ 3 = x * x * x;

theorem 
  for X being BCI-Algebra_with_Condition(S) holds (0.X) |^ 2 = 0.X;

theorem 
  for X being BCI-Algebra_with_Condition(S) holds (0.X)|^n = 0.X;

theorem 
  for X being BCI-Algebra_with_Condition(S) holds for x,a being Element
  of X holds ((x\a)\a)\a = x\(a|^3);

theorem 
  for X being BCI-Algebra_with_Condition(S) holds for x,a being Element
  of X holds (x,a) to_power n = x\(a|^n);

definition
  let X be non empty BCIStr_1;
  let F be FinSequence of the carrier of X;
  func Product_S F -> Element of X equals

  (the ExternalDiff of X) "**" F;
end;

theorem 
  (the ExternalDiff of X) "**" <* d *> = d;

theorem 
  for X being BCI-Algebra_with_Condition(S), F1,F2 being FinSequence of
  the carrier of X holds Product_S(F1 ^ F2) = Product_S(F1) * Product_S(F2);

theorem 
  for X being BCI-Algebra_with_Condition(S), F being FinSequence of the
carrier of X, a being Element of X holds Product_S(F ^ <* a *>) = Product_S(F)
  * a;

theorem 
  for X being BCI-Algebra_with_Condition(S), F being FinSequence of the
carrier of X, a being Element of X holds Product_S(<* a *> ^ F) = a * Product_S
  (F);

theorem 
  for X being BCI-Algebra_with_Condition(S) holds for a1,a2 being
  Element of X holds Product_S<*a1,a2*> = a1 * a2;

theorem 
  for X being BCI-Algebra_with_Condition(S) holds for a1,a2,a3
  being Element of X holds Product_S<*a1,a2,a3*> = a1 * a2 * a3;

theorem 
  for X being BCI-Algebra_with_Condition(S) holds for x,a1,a2 being
  Element of X holds (x\a1)\a2 = x\Product_S<*a1,a2*>;

theorem 
  for X being BCI-Algebra_with_Condition(S) holds for x,a1,a2,a3 being
  Element of X holds ((x\a1)\a2)\a3 = x\Product_S<*a1,a2,a3*>;

theorem 
  for X being BCI-Algebra_with_Condition(S), a,b being Element of
AtomSet(X) holds for ma being Element of X st (for x being Element of BranchV(a
  ) holds x <= ma) holds ex mb being Element of X st for y being Element of
  BranchV(b) holds y <= mb;



registration
  cluster strict being_BCK-5 for BCI-Algebra_with_Condition(S);
end;

definition
  mode BCK-Algebra_with_Condition(S) is being_BCK-5
    BCI-Algebra_with_Condition(S);
end;

theorem 
  for X being BCK-Algebra_with_Condition(S) holds for x,y being
  Element of X holds x <= x*y & y <= x*y;

theorem 
  for X being BCK-Algebra_with_Condition(S) holds for x,y,z being
  Element of X holds ((x*y)\(y*z))\(z*x) = 0.X;

theorem 
  for X being BCK-Algebra_with_Condition(S) holds for x,y being Element
  of X holds (x\y)*(y\x) <= x*y;

theorem 
  for X being BCK-Algebra_with_Condition(S) holds for x being Element of
  X holds (x\0.X)*(0.X\x) = x;

definition
  let IT be BCK-Algebra_with_Condition(S);
  attr IT is commutative means


  for x,y being Element of IT holds x\(x\y ) = y\(y\x);
end;

registration
  cluster commutative for BCK-Algebra_with_Condition(S);
end;

theorem 
  for X being non empty BCIStr_1 holds (X is commutative
BCK-Algebra_with_Condition(S) iff for x,y,z being Element of X holds x\(0.X\y)
  = x & (x\z)\(x\y) = (y\z)\(y\x) & (x\y)\z = x\(y*z) );

theorem 
  for X being commutative BCK-Algebra_with_Condition(S), a being Element
of X st a is greatest holds for x,y being Element of X holds x*y = a\((a\x)\y);

definition
  let X be BCI-algebra;
  let a be Element of X;
  func Initial_section(a) -> non empty Subset of X equals

  {t where t is
  Element of X: t <= a};
end;

theorem 
  for X being commutative BCK-Algebra_with_Condition(S), a,b,c being
  Element of X st Condition_S(a,b) c= Initial_section(c) holds for x being
  Element of Condition_S(a,b) holds x <= c\((c\a)\b);



definition
  let IT be BCK-Algebra_with_Condition(S);
  attr IT is positive-implicative means


  for x,y being Element of IT holds (x\y)\y = x\y;
end;

registration
  cluster positive-implicative for BCK-Algebra_with_Condition(S);
end;

theorem 
  for X being BCK-Algebra_with_Condition(S) holds ( X is
  positive-implicative iff for x being Element of X holds x*x = x );

theorem 
  for X being BCK-Algebra_with_Condition(S) holds ( X is
positive-implicative iff for x,y being Element of X holds (x <= y implies x*y =
  y) );

theorem 
  for X being BCK-Algebra_with_Condition(S) holds ( X is
positive-implicative iff for x,y,z being Element of X holds (x*y)\z = (x\z)*(y\
  z) );

theorem 
  for X being BCK-Algebra_with_Condition(S) holds ( X is
  positive-implicative iff for x,y being Element of X holds x*y = x*(y\x) );

theorem 
  for X being positive-implicative BCK-Algebra_with_Condition(S)
  holds for x,y being Element of X holds x = (x\y)*(x\(x\y));

definition
  let IT be non empty BCIStr_1;
  attr IT is being_SB-1 means


  for x being Element of IT holds x * x = x;
  attr IT is being_SB-2 means


  for x,y being Element of IT holds x * y = y * x;
  attr IT is being_SB-4 means


  for x,y being Element of IT holds (x\y) * y = x * y;
end;

registration
  cluster BCI_S-EXAMPLE -> being_SB-1 being_SB-2 being_SB-4 being_I
    with_condition_S;
end;

registration
  cluster strict being_SB-1 being_SB-2 being_SB-4 being_I with_condition_S for

    non empty BCIStr_1;
end;

definition
  mode semi-Brouwerian-algebra is being_SB-1 being_SB-2 being_SB-4 being_I
    with_condition_S non empty BCIStr_1;
end;

theorem 
  for X being non empty BCIStr_1 holds (X is positive-implicative
  BCK-Algebra_with_Condition(S) iff X is semi-Brouwerian-algebra);



definition
  let IT be BCK-Algebra_with_Condition(S);
  attr IT is implicative means


  for x,y being Element of IT holds x\(y\ x) = x;
end;

registration
  cluster implicative for BCK-Algebra_with_Condition(S);
end;

theorem 
  for X being BCK-Algebra_with_Condition(S) holds (X is
  implicative iff X is commutative & X is positive-implicative );

theorem 
  for X being BCK-Algebra_with_Condition(S) holds ( X is implicative iff
  for x,y,z being Element of X holds x\(y\z) = ((x\y)\z)*(z\(z\x)) );














begin 


























definition
  let n be Nat;
  let x,y be FinSequence;
  func n-BitGFA0Str(x,y) ->
  unsplit gate`1=arity gate`2isBoolean non void strict
  non empty ManySortedSign means


  ex f,h being ManySortedSet of NAT st
  it = f.n & f.0 = 1GateCircStr(<*>,(0-tuples_on BOOLEAN)-->FALSE) &
  h.0 = [<*>, (0-tuples_on BOOLEAN)-->FALSE] &
  for n being Nat, S being non empty ManySortedSign, z be set
  st S = f.n & z = h.n holds f.(n+1) = S +* BitGFA0Str(x .(n+1), y.(n+1), z) &
  h.(n+1) = GFA0CarryOutput(x .(n+1), y.(n+1), z);
end;



definition
  let n be Nat;
  let x,y be FinSequence;
  func n-BitGFA0Circ(x,y) ->
  Boolean gate`2=den strict Circuit of n-BitGFA0Str(x,y) means


  ex f,g,h being ManySortedSet of NAT st n-BitGFA0Str(x,y) = f.n & it = g.n &
  f.0 = 1GateCircStr(<*>,(0-tuples_on BOOLEAN)-->FALSE) &
  g.0 = 1GateCircuit(<*>,(0-tuples_on BOOLEAN)-->FALSE) &
  h.0 = [<*>, (0-tuples_on BOOLEAN)-->FALSE] &
  for n being Nat, S being non empty ManySortedSign,
  A being non-empty MSAlgebra over S
  for z being set st S = f.n & A = g.n & z = h.n holds
  f.(n+1) = S +* BitGFA0Str(x .(n+1), y.(n+1), z) &
  g.(n+1) = A +* BitGFA0Circ(x .(n+1), y.(n+1), z) &
  h.(n+1) = GFA0CarryOutput(x .(n+1), y.(n+1), z);
end;



definition
  let n be Nat;
  let x,y be FinSequence;
  func n-BitGFA0CarryOutput(x,y) ->
  Element of InnerVertices (n-BitGFA0Str(x,y)) means


  ex h being ManySortedSet of NAT st
  it = h.n & h.0 = [<*>, (0-tuples_on BOOLEAN)-->FALSE] &
  for n being Nat holds h.(n+1) = GFA0CarryOutput(x .(n+1), y.(n+1), h.n);
end;






theorem 
  for x,y being FinSequence, f,g,h being ManySortedSet of NAT st
  f.0 = 1GateCircStr(<*>,(0-tuples_on BOOLEAN)-->FALSE) &
  g.0 = 1GateCircuit(<*>,(0-tuples_on BOOLEAN)-->FALSE) &
  h.0 = [<*>, (0-tuples_on BOOLEAN)-->FALSE] &
  for n being Nat, S being non empty ManySortedSign,
  A being non-empty MSAlgebra over S
  for z being set st S = f.n & A = g.n & z = h.n holds
  f.(n+1) = S +* BitGFA0Str(x .(n+1), y.(n+1), z) &
  g.(n+1) = A +* BitGFA0Circ(x .(n+1), y.(n+1), z) &
  h.(n+1) = GFA0CarryOutput(x .(n+1), y.(n+1), z)
  for n being Nat holds
  n-BitGFA0Str(x,y) = f.n & n-BitGFA0Circ(x,y) = g.n &
  n-BitGFA0CarryOutput(x,y) = h.n;



theorem 
  for a,b being FinSequence holds
  0-BitGFA0Str(a,b) = 1GateCircStr(<*>,(0-tuples_on BOOLEAN)-->FALSE) &
  0-BitGFA0Circ(a,b) = 1GateCircuit(<*>,(0-tuples_on BOOLEAN)-->FALSE) &
  0-BitGFA0CarryOutput(a,b) = [<*>, (0-tuples_on BOOLEAN)-->FALSE];



theorem 
  for a,b being FinSequence, c being set
  st c = [<*>, (0-tuples_on BOOLEAN)-->FALSE] holds
  1-BitGFA0Str(a,b) = 1GateCircStr(<*>, (0-tuples_on BOOLEAN)-->FALSE) +*
  BitGFA0Str(a.1, b.1, c) &
  1-BitGFA0Circ(a,b) = 1GateCircuit(<*>, (0-tuples_on BOOLEAN)-->FALSE) +*
  BitGFA0Circ(a.1, b.1, c) &
  1-BitGFA0CarryOutput(a,b) = GFA0CarryOutput(a.1, b.1, c);



theorem 
  for a,b,c being set st c = [<*>, (0-tuples_on BOOLEAN)-->FALSE] holds
  1-BitGFA0Str(<*a*>,<*b*>) =
  1GateCircStr(<*>,(0-tuples_on BOOLEAN)-->FALSE) +* BitGFA0Str(a, b, c) &
  1-BitGFA0Circ(<*a*>,<*b*>) =
  1GateCircuit(<*>, (0-tuples_on BOOLEAN)-->FALSE) +* BitGFA0Circ(a, b, c) &
  1-BitGFA0CarryOutput(<*a*>,<*b*>) = GFA0CarryOutput(a, b, c);




theorem 
  for n be Nat for p,q being FinSeqLen of n
  for p1,p2, q1,q2 being FinSequence holds
  n-BitGFA0Str(p^p1, q^q1) = n-BitGFA0Str(p^p2, q^q2) &
  n-BitGFA0Circ(p^p1, q^q1) = n-BitGFA0Circ(p^p2, q^q2) &
  n-BitGFA0CarryOutput(p^p1, q^q1) = n-BitGFA0CarryOutput(p^p2, q^q2);




theorem 
  for n be Nat for x,y being FinSeqLen of n for a,b being set holds
  (n+1)-BitGFA0Str(x^<*a*>, y^<*b*>) = n-BitGFA0Str(x, y) +*
  BitGFA0Str(a, b, n-BitGFA0CarryOutput(x, y)) &
  (n+1)-BitGFA0Circ(x^<*a*>, y^<*b*>) = n-BitGFA0Circ(x, y) +*
  BitGFA0Circ(a, b, n-BitGFA0CarryOutput(x, y)) &
  (n+1)-BitGFA0CarryOutput(x^<*a*>, y^<*b*>) =
  GFA0CarryOutput(a, b, n-BitGFA0CarryOutput(x, y));




theorem 
  for n be Nat for x,y being FinSequence holds
  (n+1)-BitGFA0Str(x, y) = n-BitGFA0Str(x, y) +*
  BitGFA0Str(x .(n+1), y.(n+1), n-BitGFA0CarryOutput(x, y)) &
  (n+1)-BitGFA0Circ(x, y) = n-BitGFA0Circ(x, y) +*
  BitGFA0Circ(x .(n+1), y.(n+1), n-BitGFA0CarryOutput(x, y)) &
  (n+1)-BitGFA0CarryOutput(x, y) =
  GFA0CarryOutput(x .(n+1), y.(n+1), n-BitGFA0CarryOutput(x, y));







theorem 
  for n,m be Nat st n <= m for x,y being FinSequence holds
  InnerVertices (n-BitGFA0Str(x,y)) c= InnerVertices (m-BitGFA0Str(x,y));




theorem 
  for n be Nat for x,y being FinSequence holds
  InnerVertices ((n+1)-BitGFA0Str(x,y)) = InnerVertices (n-BitGFA0Str(x,y)) \/
  InnerVertices BitGFA0Str(x .(n+1), y.(n+1), n-BitGFA0CarryOutput(x,y));



definition
  let k,n be Nat such that
 k >= 1 and
 k <= n;
  let x,y be FinSequence;
  func (k,n)-BitGFA0AdderOutput(x,y) ->
  Element of InnerVertices (n-BitGFA0Str(x,y)) means


  ex i being Nat st k = i+1 &
  it = GFA0AdderOutput(x .k, y.k, i-BitGFA0CarryOutput(x,y));
end;



theorem 
  for n,k being Nat st k < n for x,y being FinSequence holds
  (k+1,n)-BitGFA0AdderOutput(x,y) =
  GFA0AdderOutput(x .(k+1), y.(k+1), k-BitGFA0CarryOutput(x,y));

theorem 
  for n being Nat for x,y being FinSequence holds
  InnerVertices (n-BitGFA0Str(x,y)) is Relation;

registration
  let n be Nat;
  let x,y be FinSequence;
  cluster n-BitGFA0CarryOutput(x,y) -> pair;
end;




theorem 
  for f,g being nonpair-yielding FinSequence for n being Nat holds
  InputVertices ((n+1)-BitGFA0Str(f,g)) =
  (InputVertices (n-BitGFA0Str(f,g)))\/
  ((InputVertices BitGFA0Str(f.(n+1),g.(n+1),
  n-BitGFA0CarryOutput(f,g)) \ {n-BitGFA0CarryOutput(f,g)})) &
  InnerVertices (n-BitGFA0Str(f,g)) is Relation &
  InputVertices (n-BitGFA0Str(f,g)) is without_pairs;



theorem 
  for n being Nat for x,y being nonpair-yielding FinSeqLen of n holds
  InputVertices (n-BitGFA0Str(x,y)) = rng x \/ rng y;





theorem 
  for n being Nat for x,y being nonpair-yielding FinSeqLen of n
  for s being State of n-BitGFA0Circ(x,y) holds Following(s,1+2*n) is stable;



begin 


























definition
  let n be Nat;
  let x,y be FinSequence;
  func n-BitGFA1Str(x,y) ->
  unsplit gate`1=arity gate`2isBoolean non void strict
  non empty ManySortedSign means


  ex f,h being ManySortedSet of NAT st
  it = f.n & f.0 = 1GateCircStr(<*>,(0-tuples_on BOOLEAN)-->TRUE) &
  h.0 = [<*>, (0-tuples_on BOOLEAN)-->TRUE] &
  for n being Nat, S being non empty ManySortedSign, z be set
  st S = f.n & z = h.n holds f.(n+1) = S +* BitGFA1Str(x .(n+1), y.(n+1), z) &
  h.(n+1) = GFA1CarryOutput(x .(n+1), y.(n+1), z);
end;



definition
  let n be Nat;
  let x,y be FinSequence;
  func n-BitGFA1Circ(x,y) ->
  Boolean gate`2=den strict Circuit of n-BitGFA1Str(x,y) means


  ex f,g,h being ManySortedSet of NAT st n-BitGFA1Str(x,y) = f.n & it = g.n &
  f.0 = 1GateCircStr(<*>,(0-tuples_on BOOLEAN)-->TRUE) &
  g.0 = 1GateCircuit(<*>,(0-tuples_on BOOLEAN)-->TRUE) &
  h.0 = [<*>, (0-tuples_on BOOLEAN)-->TRUE] &
  for n being Nat, S being non empty ManySortedSign,
  A being non-empty MSAlgebra over S
  for z being set st S = f.n & A = g.n & z = h.n holds
  f.(n+1) = S +* BitGFA1Str(x .(n+1), y.(n+1), z) &
  g.(n+1) = A +* BitGFA1Circ(x .(n+1), y.(n+1), z) &
  h.(n+1) = GFA1CarryOutput(x .(n+1), y.(n+1), z);
end;



definition
  let n be Nat;
  let x,y be FinSequence;
  func n-BitGFA1CarryOutput(x,y) ->
  Element of InnerVertices (n-BitGFA1Str(x,y)) means


  ex h being ManySortedSet of NAT st
  it = h.n & h.0 = [<*>, (0-tuples_on BOOLEAN)-->TRUE] &
  for n being Nat holds
  h.(n+1) = GFA1CarryOutput(x .(n+1), y.(n+1), h.n);
end;






theorem 
  for x,y being FinSequence, f,g,h being ManySortedSet of NAT st
  f.0 = 1GateCircStr(<*>,(0-tuples_on BOOLEAN)-->TRUE) &
  g.0 = 1GateCircuit(<*>,(0-tuples_on BOOLEAN)-->TRUE) &
  h.0 = [<*>, (0-tuples_on BOOLEAN)-->TRUE] &
  for n being Nat, S being non empty ManySortedSign,
  A being non-empty MSAlgebra over S
  for z being set st S = f.n & A = g.n & z = h.n holds
  f.(n+1) = S +* BitGFA1Str(x .(n+1), y.(n+1), z) &
  g.(n+1) = A +* BitGFA1Circ(x .(n+1), y.(n+1), z) &
  h.(n+1) = GFA1CarryOutput(x .(n+1), y.(n+1), z)
  for n being Nat holds
  n-BitGFA1Str(x,y) = f.n & n-BitGFA1Circ(x,y) = g.n &
  n-BitGFA1CarryOutput(x,y) = h.n;



theorem 
  for a,b being FinSequence holds
  0-BitGFA1Str(a,b) = 1GateCircStr(<*>,(0-tuples_on BOOLEAN)-->TRUE) &
  0-BitGFA1Circ(a,b) = 1GateCircuit(<*>,(0-tuples_on BOOLEAN)-->TRUE) &
  0-BitGFA1CarryOutput(a,b) = [<*>, (0-tuples_on BOOLEAN)-->TRUE];



theorem 
  for a,b being FinSequence, c being set
  st c = [<*>, (0-tuples_on BOOLEAN)-->TRUE] holds
  1-BitGFA1Str(a,b) = 1GateCircStr(<*>, (0-tuples_on BOOLEAN)-->TRUE) +*
  BitGFA1Str(a.1, b.1, c) &
  1-BitGFA1Circ(a,b) = 1GateCircuit(<*>, (0-tuples_on BOOLEAN)-->TRUE) +*
  BitGFA1Circ(a.1, b.1, c) &
  1-BitGFA1CarryOutput(a,b) = GFA1CarryOutput(a.1, b.1, c);



theorem 
  for a,b,c being set st c = [<*>, (0-tuples_on BOOLEAN)-->TRUE] holds
  1-BitGFA1Str(<*a*>,<*b*>) =
  1GateCircStr(<*>,(0-tuples_on BOOLEAN)-->TRUE) +* BitGFA1Str(a, b, c) &
  1-BitGFA1Circ(<*a*>,<*b*>) =
  1GateCircuit(<*>, (0-tuples_on BOOLEAN)-->TRUE) +* BitGFA1Circ(a, b, c) &
  1-BitGFA1CarryOutput(<*a*>,<*b*>) = GFA1CarryOutput(a, b, c);




theorem 
  for n be Nat for p,q being FinSeqLen of n
  for p1,p2, q1,q2 being FinSequence holds
  n-BitGFA1Str(p^p1, q^q1) = n-BitGFA1Str(p^p2, q^q2) &
  n-BitGFA1Circ(p^p1, q^q1) = n-BitGFA1Circ(p^p2, q^q2) &
  n-BitGFA1CarryOutput(p^p1, q^q1) = n-BitGFA1CarryOutput(p^p2, q^q2);




theorem 
  for n be Nat for x,y being FinSeqLen of n for a,b being set holds
  (n+1)-BitGFA1Str(x^<*a*>, y^<*b*>) = n-BitGFA1Str(x, y) +*
  BitGFA1Str(a, b, n-BitGFA1CarryOutput(x, y)) &
  (n+1)-BitGFA1Circ(x^<*a*>, y^<*b*>) = n-BitGFA1Circ(x, y) +*
  BitGFA1Circ(a, b, n-BitGFA1CarryOutput(x, y)) &
  (n+1)-BitGFA1CarryOutput(x^<*a*>, y^<*b*>) =
  GFA1CarryOutput(a, b, n-BitGFA1CarryOutput(x, y));




theorem 
  for n be Nat for x,y being FinSequence holds
  (n+1)-BitGFA1Str(x, y) = n-BitGFA1Str(x, y) +*
  BitGFA1Str(x .(n+1), y.(n+1), n-BitGFA1CarryOutput(x, y)) &
  (n+1)-BitGFA1Circ(x, y) = n-BitGFA1Circ(x, y) +*
  BitGFA1Circ(x .(n+1), y.(n+1), n-BitGFA1CarryOutput(x, y)) &
  (n+1)-BitGFA1CarryOutput(x, y) =
  GFA1CarryOutput(x .(n+1), y.(n+1), n-BitGFA1CarryOutput(x, y));







theorem 
  for n,m be Nat st n <= m for x,y being FinSequence holds
  InnerVertices (n-BitGFA1Str(x,y)) c= InnerVertices (m-BitGFA1Str(x,y));




theorem 
  for n be Nat for x,y being FinSequence holds
  InnerVertices ((n+1)-BitGFA1Str(x,y)) = InnerVertices (n-BitGFA1Str(x,y)) \/
  InnerVertices BitGFA1Str(x .(n+1), y.(n+1), n-BitGFA1CarryOutput(x,y));



definition
  let k,n be Nat such that
 k >= 1 and
 k <= n;
  let x,y be FinSequence;
  func (k,n)-BitGFA1AdderOutput(x,y) ->
  Element of InnerVertices (n-BitGFA1Str(x,y)) means


  ex i being Nat st k = i+1 &
  it = GFA1AdderOutput(x .k, y.k, i-BitGFA1CarryOutput(x,y));
end;



theorem 
  for n,k being Nat st k < n for x,y being FinSequence holds
  (k+1,n)-BitGFA1AdderOutput(x,y) =
  GFA1AdderOutput(x .(k+1), y.(k+1), k-BitGFA1CarryOutput(x,y));

theorem 
  for n being Nat for x,y being FinSequence holds
  InnerVertices (n-BitGFA1Str(x,y)) is Relation;

registration
  let n be Nat;
  let x,y be FinSequence;
  cluster n-BitGFA1CarryOutput(x,y) -> pair;
end;




theorem 
  for f,g being nonpair-yielding FinSequence for n being Nat holds
  InputVertices ((n+1)-BitGFA1Str(f,g)) =
  (InputVertices (n-BitGFA1Str(f,g)))\/
  ((InputVertices BitGFA1Str(f.(n+1),g.(n+1),
  n-BitGFA1CarryOutput(f,g)) \ {n-BitGFA1CarryOutput(f,g)})) &
  InnerVertices (n-BitGFA1Str(f,g)) is Relation &
  InputVertices (n-BitGFA1Str(f,g)) is without_pairs;



theorem 
  for n being Nat for x,y being nonpair-yielding FinSeqLen of n holds
  InputVertices (n-BitGFA1Str(x,y)) = rng x \/ rng y;





theorem 
  for n being Nat for x,y being nonpair-yielding FinSeqLen of n
  for s being State of n-BitGFA1Circ(x,y) holds Following(s,1+2*n) is stable;














begin 

theorem 
  for p being non empty FinSequence holds <*p.1*>^'p = p;

definition
  let p, q be FinSequence;
  func maxPrefix(p,q) -> FinSequence means


  it is_a_prefix_of p & it
  is_a_prefix_of q & for r being FinSequence st r is_a_prefix_of p & r
  is_a_prefix_of q holds r is_a_prefix_of it;
  commutativity;
end;

theorem 
  for p, q being FinSequence holds p is_a_prefix_of q iff maxPrefix(p,q) = p;

theorem 
  for p, q being FinSequence holds len maxPrefix(p,q)<= len p;

theorem 
  for p being non empty FinSequence holds <*p.1*> is_a_prefix_of p;

theorem 
  for p, q being non empty FinSequence st p.1 = q.1 holds 1 <= len
  maxPrefix(p,q);

theorem 
  for p, q being FinSequence for j being Nat st j <= len maxPrefix(
  p,q) holds maxPrefix(p,q).j = p.j;

theorem 
  for p, q being FinSequence for j being Nat st j <= len maxPrefix(
  p,q) holds p.j = q.j;

theorem 
  for p, q being FinSequence holds not p is_a_prefix_of q iff len
  maxPrefix(p,q) < len p;

theorem 
  for p, q being FinSequence st not p is_a_prefix_of q & not q
  is_a_prefix_of p holds p.(len maxPrefix(p,q) +1) <> q.(len maxPrefix(p,q) +1)
;

begin 

theorem 
  for G being _Graph, W be Walk of G, m, n being Nat holds len W
  .cut(m,n) <= len W;

theorem 
  for G being _Graph, W being Walk of G, m, n being Nat st W.cut(m,n) is
  non trivial holds W is non trivial;

theorem 
  for G being _Graph, W being Walk of G for m, n, i being odd Nat
st m <= n & n <= len W & i <= len W.cut(m,n) ex j being odd Nat st W.cut(m,n).i
  = W.j & j = m+i-1 & j <= len W;

registration
  let G be _Graph;
  cluster -> non empty for Walk of G;
end;

theorem 
  for G being _Graph for W1, W2 being Walk of G st W1
  is_a_prefix_of W2 holds W1.vertices() c= W2.vertices();

theorem 
  for G being _Graph for W1, W2 being Walk of G st W1 is_a_prefix_of W2
  holds W1.edges() c= W2.edges();

theorem 
  for G being _Graph for W1, W2 being Walk of G holds W1
  is_a_prefix_of W1.append(W2);

theorem 
  for G being _Graph, W1,W2 being Walk of G st W1 is trivial & W1
  .last() = W2.first() holds W1.append(W2) = W2;

theorem 
  for G being _Graph for W1, W2 being Trail of G st W1.last() = W2
  .first() & W1.edges() misses W2.edges() holds W1.append(W2) is Trail-like;

theorem 
  for G being _Graph for P1, P2 being Path of G st P1.last() = P2
.first() & P1 is open & P2 is open & P1.edges() misses P2.edges() & (P1.first()
  in P2.vertices() implies P1.first() = P2.last()) & P1.vertices() /\ P2
  .vertices() c= {P1.first(), P1.last()} holds P1.append(P2) is Path-like;

theorem 
  for G being _Graph for P1, P2 being Path of G st P1.last() = P2
  .first() & P1 is open & P2 is open & P1.vertices() /\ P2.vertices() = {P1
  .last()} holds P1.append(P2) is open Path-like;

theorem 
  for G being _Graph for P1, P2 being Path of G st P1.last() = P2
.first() & P2.last() = P1.first() & P1 is open & P2 is open & P1.edges() misses
P2.edges() & P1.vertices() /\ P2.vertices() = {P1.last(), P1.first()} holds P1
  .append(P2) is Cycle-like;

theorem 
  for G being simple _Graph for W1, W2 being Walk of G for k being odd
  Nat st k <= len W1 & k <= len W2 & for j being odd Nat st j <= k holds W1.j =
  W2.j holds for j being Nat st 1 <= j & j <= k holds W1.j = W2.j;

theorem 
  for G being _Graph for W1, W2 being Walk of G st W1.first() = W2
  .first() holds len maxPrefix(W1,W2) is odd;

theorem 
  for G being _Graph for W1, W2 being Walk of G st W1.first() = W2
  .first() & not W1 is_a_prefix_of W2 holds len maxPrefix(W1,W2) +2 <= len W1;

theorem 
  for G being non-multi _Graph for W1, W2 being Walk of G st W1
  .first() = W2.first() & not W1 is_a_prefix_of W2 & not W2 is_a_prefix_of W1
  holds W1.(len maxPrefix(W1,W2) +2) <> W2.(len maxPrefix(W1,W2) +2);

begin 

definition
  mode _Tree is Tree-like _Graph;
  let G be _Graph;
  mode _Subtree of G is Tree-like Subgraph of G;
end;

registration
  let T be _Tree;
  cluster Trail-like -> Path-like for Walk of T;
end;

theorem 
  for T being _Tree for P being Path of T st P is non trivial holds P is open;

registration
  let T be _Tree;
  cluster non trivial -> open for Path of T;
end;

theorem 
  for T being _Tree for P being Path of T for i, j being odd Nat
  st i < j & j <= len P holds P.i <> P.j;

theorem 
  for T being _Tree for a, b being Vertex of T for P1, P2 being
  Path of T st P1 is_Walk_from a, b & P2 is_Walk_from a, b holds P1 = P2;

definition
  let T be _Tree;
  let a, b be Vertex of T;
  func T.pathBetween(a,b) -> Path of T means


  it is_Walk_from a, b;
end;

theorem 
  for T being _Tree, a, b being Vertex of T holds T.pathBetween(a,
  b).first() = a & T.pathBetween(a,b).last() = b;



theorem 
  for T being _Tree, a, b being Vertex of T holds a in T
  .pathBetween(a,b).vertices() & b in T.pathBetween(a,b).vertices();

registration
  let T be _Tree, a be Vertex of T;
  cluster T.pathBetween(a, a) -> closed;
end;

registration
  let T be _Tree, a be Vertex of T;
  cluster T.pathBetween(a, a) -> trivial;
end;

theorem 
  for T being _Tree, a being Vertex of T holds T.pathBetween(a,a)
  .vertices() = {a};

theorem 
  for T being _Tree, a, b being Vertex of T holds T.pathBetween(a,
  b).reverse() = T.pathBetween(b,a);

theorem 
  for T being _Tree, a, b being Vertex of T holds T.pathBetween(a,
  b).vertices() = T.pathBetween(b,a).vertices();

theorem 
  for T being _Tree for a, b being Vertex of T for t being
  _Subtree of T for a9, b9 being Vertex of t st a = a9 & b = b9 holds T
  .pathBetween(a,b) = t.pathBetween(a9,b9);

theorem 
  for T being _Tree for a, b being Vertex of T for t being
  _Subtree of T st a in the_Vertices_of t & b in the_Vertices_of t holds T
  .pathBetween(a,b).vertices() c= the_Vertices_of t;

theorem 
  for T being _Tree for P being Path of T for a, b being Vertex of
  T for i, j being odd Nat st i <= j & j <= len P & P.i = a & P.j = b holds T
  .pathBetween(a,b) = P.cut(i, j);

theorem 
  for T being _Tree for a, b, c being Vertex of T holds c in T
.pathBetween(a,b).vertices() iff T.pathBetween(a,b) = T.pathBetween(a,c).append
  (T.pathBetween(c,b));

theorem 
  for T being _Tree for a, b, c being Vertex of T holds c in T
  .pathBetween(a,b).vertices() iff T.pathBetween(a,c) is_a_prefix_of T
  .pathBetween(a,b);

theorem 
  for T being _Tree for P1, P2 being Path of T st P1.last() = P2
.first() & P1.vertices() /\ P2.vertices() = {P1.last()} holds P1.append(P2) is
  Path-like;

theorem 
  for T being _Tree for a, b, c being Vertex of T holds c in T
.pathBetween(a,b).vertices() iff T.pathBetween(a,c).vertices() /\ T.pathBetween
  (c,b).vertices() = {c};

theorem 
  for T being _Tree for a, b, c, d being Vertex of T for P1, P2
  being Path of T st P1 = T.pathBetween(a,b) & P2 = T.pathBetween(a,c) & not P1
  is_a_prefix_of P2 & not P2 is_a_prefix_of P1 & d = P1.len maxPrefix(P1,P2)
holds (T.pathBetween(d,b)).vertices() /\ (T.pathBetween(d,c)).vertices() = {d};

definition
  let T be _Tree, a, b, c be Vertex of T;
  func MiddleVertex(a, b, c) -> Vertex of T means


  T.pathBetween(a,b)
.vertices() /\ T.pathBetween(b,c).vertices() /\ T.pathBetween(c,a).vertices() =
  { it };
end;

theorem 
  for T being _Tree for a, b, c being Vertex of T holds
  MiddleVertex(a,b,c) = MiddleVertex(a,c,b);

theorem 
  for T being _Tree for a, b, c being Vertex of T holds
  MiddleVertex(a,b,c) = MiddleVertex(b,a,c);

theorem 
  for T being _Tree for a, b, c being Vertex of T holds MiddleVertex(a,b
  ,c) = MiddleVertex(b,c,a);

theorem 
  for T being _Tree for a, b, c being Vertex of T holds
  MiddleVertex(a,b,c) = MiddleVertex(c,a,b);

theorem 
  for T being _Tree for a, b, c being Vertex of T holds MiddleVertex(a,b
  ,c) = MiddleVertex(c,b,a);

theorem 
  for T being _Tree for a, b, c being Vertex of T st c in T
  .pathBetween(a,b).vertices() holds MiddleVertex(a,b,c) = c;

theorem 
  for T being _Tree for a being Vertex of T holds MiddleVertex(a,a,a) = a;

theorem 
  for T being _Tree for a, b being Vertex of T holds MiddleVertex( a,a,b) = a;

theorem 
  for T being _Tree for a, b being Vertex of T holds MiddleVertex( a,b,a) = a;

theorem 
  for T being _Tree for a, b being Vertex of T holds MiddleVertex(a,b,b) = b;

theorem 
  for T being _Tree for P1, P2 be Path of T for a, b, c being
Vertex of T st P1 = T.pathBetween(a,b) & P2 = T.pathBetween(a,c) & not b in P2
  .vertices() & not c in P1.vertices() holds MiddleVertex(a, b, c) = P1.len
  maxPrefix(P1,P2);

theorem 
  for T being _Tree for P1, P2, P3, P4 be Path of T for a, b, c being
  Vertex of T st P1 = T.pathBetween(a,b) & P2 = T.pathBetween(a,c) & P3 = T
.pathBetween(b,a) & P4 = T.pathBetween(b,c) & not b in P2.vertices() & not c in
  P1.vertices() & not a in P4.vertices() holds P1.len maxPrefix(P1,P2) = P3.len
  maxPrefix(P3,P4);

theorem 
  for T being _Tree for a, b, c being Vertex of T for S being non
  empty set st for s being set st s in S holds (ex t being _Subtree of T st s =
  the_Vertices_of t) & (a in s & b in s or a in s & c in s or b in s & c in s)
  holds meet S <> {};

begin 

definition
  let F be set;
  attr F is with_Helly_property means

  for H being non empty set st H c= F &
  for x, y being set st x in H & y in H holds x meets y holds meet H <> {};
end;







theorem 
  for T being _Tree, X being finite set st for x being set st x in X ex
  t being _Subtree of T st x = the_Vertices_of t holds X is with_Helly_property
;














begin 

reserve p1,p2,p3,p4,p5,p6,p,pc for Point of TOP-REAL 2;
reserve a,b,c,r,s for real number;

theorem 
  sin angle(p1,p2,p3) = sin angle(p4,p5,p6) & cos angle(p1,p2,p3) =
  cos angle(p4,p5,p6) implies angle(p1,p2,p3) = angle(p4,p5,p6);

theorem 
  sin angle(p1,p2,p3) = - sin angle(p3,p2,p1);

theorem 
  cos angle(p1,p2,p3) = cos angle(p3,p2,p1);

theorem 
  angle(p1,p4,p2)+angle(p2,p4,p3)=angle(p1,p4,p3) or angle(p1,p4,p2
  )+angle(p2,p4,p3)=angle(p1,p4,p3) + 2*PI;



definition
  let p1,p2,p3;

  func the_area_of_polygon3(p1,p2,p3) -> real number equals

  ((p1`1*p2`2-p2`1*
  p1`2)+(p2`1*p3`2-p3`1*p2`2)+(p3`1*p1`2-p1`1*p3`2))/2;
end;

definition
  let p1,p2,p3;
  func the_perimeter_of_polygon3(p1,p2,p3) -> real number equals

  |.p2-p1.| +
  |.p3-p2.| + |.p1-p3.|;
end;



theorem 
  the_area_of_polygon3(p1,p2,p3) = |.p1-p2.|*|.p3-p2.|*sin angle(p3 ,p2,p1) / 2
;

theorem 
  p2<>p1 implies |.p3-p2.| * sin angle(p3,p2,p1) = |.p3-p1.| * sin
  angle(p2,p1,p3);




theorem 
  a = |.p1-p2.| & b = |.p3-p2.| & c = |.p3-p1.| implies c^2 = a^2 +
  b^2 - 2*a*b * cos angle(p1,p2,p3);

begin 

theorem 
  p in LSeg(p1,p2) & p<>p1 & p<>p2 implies angle(p1,p,p2) = PI;

theorem 
  p in LSeg(p2,p3) & p<>p2 implies angle(p3,p2,p1)=angle(p,p2,p1);

theorem 
  p in LSeg(p2,p3) & p<>p2 implies angle(p1,p2,p3) = angle(p1,p2,p );

theorem 
  angle(p1,p,p2) = PI implies p in LSeg(p1,p2);

theorem 
  p in LSeg(p1,p3) & p in LSeg(p1,p4) & p3<>p4 & p<>p1 implies p3
  in LSeg(p1,p4) or p4 in LSeg(p1,p3);

theorem 
  p in LSeg(p1,p3) & p<>p1 & p<>p3 implies angle(p1,p,p2)+angle(p2
  ,p,p3)=PI or angle(p1,p,p2)+angle(p2,p,p3)=3*PI;

theorem 
  p in LSeg(p1,p2) & p<>p1 & p<>p2 & (angle(p3,p,p1)=PI/2 or angle
  (p3,p,p1)=3/2*PI) implies angle(p1,p,p3)=angle(p3,p,p2);



theorem 
  p in LSeg(p1,p3) & p in LSeg(p2,p4) & p<>p1 & p<>p2 & p<>p3 & p
  <>p4 implies angle(p1,p,p2)=angle(p3,p,p4);



theorem 
  |.p3-p1.|=|.p2-p3.| & p1<>p2 implies angle(p3,p1,p2)=angle(p1,p2 ,p3);

theorem 
  for p1,p2,p3,p st p in LSeg(p1,p2) & p<>p2 holds |(p3-p,p2-p1)|
  = 0 iff |(p3-p,p2-p)| = 0;

theorem 
  |.p1-p3.|=|.p2-p3.| & p in LSeg(p1,p2) & p<>p3 & p<>p1 & (angle(
  p3,p,p1)=PI/2 or angle(p3,p,p1)=3/2*PI) implies angle(p1,p3,p)=angle(p,p3,p2)
;




theorem 
  for p1,p2,p3,p st |.p1-p3.|=|.p2-p3.| & p in LSeg(p1,p2) & p<>p3 holds
(angle(p1,p3,p)=angle(p,p3,p2) implies |.p1-p.| = |.p-p2.|) & (|.p1-p.| = |.p-
p2.| implies |(p3-p,p2-p1)| = 0) & (|(p3-p,p2-p1)| = 0 implies angle(p1,p3,p)=
  angle(p,p3,p2));

definition
  let p1,p2,p3;
  pred p1,p2,p3 is_collinear means


  p1 in LSeg(p2,p3) or p2 in LSeg(p3, p1) or p3 in LSeg(p1,p2);
end;

notation
  let p1,p2,p3;
  antonym p1,p2,p3 is_a_triangle for p1,p2,p3 is_collinear;
end;

theorem 
  p1,p2,p3 is_a_triangle iff p1,p2,p3 are_mutually_different &
  angle(p1,p2,p3)<>PI & angle(p2,p3,p1)<>PI & angle(p3,p1,p2)<>PI;

theorem 
  p1,p2,p3 is_a_triangle & p4,p5,p6 is_a_triangle & angle(p1,p2,p3
) = angle(p4,p5,p6) & angle(p3,p1,p2) = angle(p6,p4,p5) implies |.p3-p2.|*|.p4-
p6.| = |.p1-p3.|*|.p6-p5.| & |.p3-p2.|*|.p5-p4.| = |.p2-p1.|*|.p6-p5.| & |.p1-
  p3.|*|.p5-p4.| = |.p2-p1.|*|.p4-p6.|;

theorem 
  p1,p2,p3 is_a_triangle & p4,p5,p6 is_a_triangle & angle(p1,p2,p3
) = angle(p4,p5,p6) & angle(p3,p1,p2) = angle(p5,p6,p4) implies |.p2-p3.| * |.
p4-p6.| = |.p3-p1.| * |.p5-p4.| & |.p2-p3.| * |.p6-p5.| = |.p1-p2.| * |.p5-p4.|
  & |.p3-p1.| * |.p6-p5.| = |.p1-p2.| * |.p4-p6.|;

theorem 
  p1,p2,p3 are_mutually_different & angle(p1,p2,p3)<=PI implies
  angle(p2,p3,p1)<=PI & angle(p3,p1,p2)<=PI;

theorem 
  p1,p2,p3 are_mutually_different & angle(p1,p2,p3)>PI implies
  angle(p2,p3,p1)>PI & angle(p3,p1,p2)>PI;

theorem 
  p in LSeg(p1,p2) & p1,p2,p3 is_a_triangle & angle(p1,p3,p2) =
  angle(p,p3,p2) implies p=p1;

theorem 
  p in LSeg(p1,p2) & not p3 in LSeg(p1,p2) & angle(p1,p3,p2) <= PI
  implies angle(p,p3,p2) <= angle(p1,p3,p2);

theorem 
  p in LSeg(p1,p2) & not p3 in LSeg(p1,p2) & angle(p1,p3,p2) > PI
  & p<>p2 implies angle(p,p3,p2) >= angle(p1,p3,p2);

theorem 
  p in LSeg(p1,p2) & not p3 in LSeg(p1,p2) implies ex p4 st p4 in
  LSeg(p1,p2) & angle(p1,p3,p4) = angle(p,p3,p2);

theorem 
  p1 in inside_of_circle(a,b,r) & p2 in outside_of_circle(a,b,r) implies
  ex p st p in LSeg(p1,p2) /\ circle(a,b,r);

theorem 
  p1 in circle(a,b,r) & p3 in circle(a,b,r) & p4 in circle(a,b,r)
  & p in LSeg(p1,p3) & p in LSeg(p1,p4) & p3<>p4 implies p=p1;

theorem 
  p1 in circle(a,b,r) & p2 in circle(a,b,r) & p in circle(a,b,r) &
pc = |[a,b]| & pc in LSeg(p,p2) & p1<>p implies 2*angle(p1,p,p2) = angle(p1,pc,
  p2) or 2*(angle(p1,p,p2) - PI) = angle(p1,pc,p2);



theorem 
  p1 in circle(a,b,r) & r>0 implies ex p2 st p1<>p2 & p2 in circle
  (a,b,r) & |[a,b]| in LSeg(p1,p2);



theorem 
  p1 in circle(a,b,r) & p2 in circle(a,b,r) & p in circle(a,b,r) &
pc = |[a,b]| & p1<>p & p2<>p implies 2*angle(p1,p,p2) = angle(p1,pc,p2) or 2*(
  angle(p1,p,p2) - PI) = angle(p1,pc,p2);



theorem 
  p1 in circle(a,b,r) & p2 in circle(a,b,r) & p3 in circle(a,b,r)
& p4 in circle(a,b,r) & p1<>p3 & p1<>p4 & p2<>p3 & p2<>p4 implies angle(p1,p3,
p2) = angle(p1,p4,p2) or angle(p1,p3,p2) = angle(p1,p4,p2) - PI or angle(p1,p3,
  p2) = angle(p1,p4,p2) + PI;

theorem 
  p1 in circle(a,b,r) & p2 in circle(a,b,r) & p3 in circle(a,b,r)
  & p1<>p2 & p2<>p3 implies angle(p1,p2,p3)<>PI;

theorem 
  p1 in circle(a,b,r) & p2 in circle(a,b,r) & p3 in circle(a,b,r)
  & p4 in circle(a,b,r) & p in LSeg(p1,p3) & p in LSeg(p2,p4) & p1,p2,p3,p4
  are_mutually_different implies angle(p1,p4,p2) = angle(p1,p3,p2);

theorem 
  p1 in circle(a,b,r) & p2 in circle(a,b,r) & p3 in circle(a,b,r)
  & angle(p1,p2,p3) = 0 & p1<>p2 & p2<>p3 implies p1=p3;





theorem 
  p1 in circle(a,b,r) & p2 in circle(a,b,r) & p3 in circle(a,b,r) & p4
in circle(a,b,r) & p in LSeg(p1,p3) & p in LSeg(p2,p4) implies |.p1-p.|*|.p-p3
  .| = |.p2-p.|*|.p-p4.|;

begin 



theorem 
  a = |.p2-p1.| & b = |.p3-p2.| & c = |.p1-p3.| & s =
the_perimeter_of_polygon3(p1,p2,p3)/2 implies abs(the_area_of_polygon3(p1,p2,p3
  )) = sqrt(s*(s-a)*(s-b)*(s-c));




theorem 
  p1 in circle(a,b,r) & p2 in circle(a,b,r) & p3 in circle(a,b,r) & p4
in circle(a,b,r) & p in LSeg(p1,p3) & p in LSeg(p2,p4) implies |.p3-p1.|*|.p4-
  p2.| = |.p2-p1.|*|.p4-p3.| + |.p3-p2.|*|.p4-p1.|;

begin 

reserve c1,c2,c3 for Element of COMPLEX;

theorem 
  (p1-p2)`1 = p1`1 - p2`1 & (p1-p2)`2 = p1`2 - p2`2;

theorem 
  |.p1-p2.| = 0 iff p1=p2;

theorem 
  |.p1-p2.| = |.p2-p1.|;

theorem 
  not angle(p1,p2,p3) = 2*angle(p4,p5,p6)+2*PI;

theorem 
  not angle(p1,p2,p3) = 2*angle(p4,p5,p6)+4*PI;

theorem 
  not angle(p1,p2,p3) = 2*angle(p4,p5,p6)-4*PI;

theorem 
  not angle(p1,p2,p3) = 2*angle(p4,p5,p6)-6*PI;

theorem 
  c1=euc2cpx(p1-p2) & c2=euc2cpx(p3-p2) implies angle(p1,p2,p3) = angle(
  c1,c2);

theorem 
  angle(c1,c2) + angle(c2,c3) = angle(c1,c3) or angle(c1,c2) + angle(c2,
  c3) = angle(c1,c3) + 2*PI;

theorem 
  c1 = euc2cpx(p1-p2) & c2 = euc2cpx(p3-p2) implies Re (c1.|.c2) = (p1`1
- p2`1)*(p3`1 - p2`1)+(p1`2 - p2`2)*(p3`2 - p2`2) & Im (c1.|.c2) = -(p1`1 - p2
`1)*(p3`2 - p2`2)+(p1`2 - p2`2)*(p3`1 - p2`1) & |.c1.| = sqrt((p1`1 - p2`1)^2 +
  (p1`2 - p2`2)^2) & |.p1-p2.|=|.c1.|;

theorem 
  for n being Element of NAT, q1 being Point of TOP-REAL n for f being
Function of TOP-REAL n,R^1 st (for q being Point of TOP-REAL n holds f.q=|.q-q1
  .|) holds f is continuous;

theorem 
  for n being Element of NAT, q1 being Point of TOP-REAL n ex f being
Function of TOP-REAL n, R^1 st (for q being Point of TOP-REAL n holds f.q=|.q-
  q1.|) & f is continuous;














begin 

reserve x,X,y for set;

theorem 
  for p being ManySortedSet of X st support p = {x} holds p = (X--> 0)+*(x,p.x)
;

theorem 
  for X be set,p,q,r be real-valued ManySortedSet of X st (support
p) /\ (support q) = {} & (support p) \/ (support q) =(support r) &
p|  (support p
  ) = r | (support p) & q| (support q) = r | (support q) holds p+q = r;

theorem 
  for X be set,p,q be ManySortedSet of X st p| (support p) = q| (
  support q) holds p = q;

theorem 
  for X be set,p,q be bag of X st support p = {} & support q={} holds p = q;

definition
  let p be bag of SetPrimes;
  attr p is prime-factorization-like means


  for x being Prime st x in
  support p ex n be Nat st 0 < n & p.x = x |^n;
end;

registration
  let n be non empty Nat;
  cluster ppf n -> prime-factorization-like;
end;

theorem 
  for p,q be Prime,n,m be Nat st p divides m*(q|^n) & p
  <> q holds p divides m;

theorem 
  for f be FinSequence of NAT, b be bag of SetPrimes,a be Prime st
b is prime-factorization-like & Product b <> 1 & a divides Product b & Product
  b = Product f & f = b*canFS(support b) holds a in support b;

theorem 
  for p,q be bag of SetPrimes st (support p) c= (support q) & p | (
  support p) = q | (support p) holds (Product p) divides (Product q);

theorem 
  for p be bag of SetPrimes,x be Prime st p is prime-factorization-like
  holds x divides Product p iff x in support p;

theorem 
  for n,m,k be non empty Nat st k = n lcm m holds
  support ppf k=(support ppf n) \/ (support ppf m);

theorem 
  for X being set,b1,b2 being bag of X holds support min(b1,b2) =
  support b1 /\ support b2;

theorem 
  for n,m,k be non empty Nat st k = n gcd m holds support ppf
  k = (support ppf n) /\ (support ppf m);

theorem 
  for p,q be bag of SetPrimes st p is prime-factorization-like & q
  is prime-factorization-like & (support p) misses (support q) holds Product p,
  Product q are_relative_prime;

theorem 
  for p be bag of SetPrimes st p is prime-factorization-like holds
  Product p <> 0;

theorem 
  for p be bag of SetPrimes st p is prime-factorization-like holds
  Product p = 1 iff support p = {};
:$N Fundamental Theorem of Arithmetic (uniqueness)
theorem 
  for p,q be bag of SetPrimes st p is prime-factorization-like &q
  is prime-factorization-like& Product p = Product q holds p=q;

theorem 
  for p be bag of SetPrimes, n be non empty Nat st p is
  prime-factorization-like & n = Product p holds (ppf n) = p;

theorem 
  for n,m be Element of NAT st 1<=n & 1 <=m holds ex m0,n0 be
Element of NAT st n lcm m =n0*m0 & n0 gcd m0 = 1 & n0 divides n & m0 divides m
  & n0 <> 0 & m0 <> 0;

begin 

definition
  let n be Nat;
  assume
 1 < n;
  func Segm0(n) -> non empty finite Subset of NAT equals


  Segm(n) \ {0};
end;

theorem 
  for n be Nat st 1 < n holds card Segm0(n) = n-1;

definition
  let n be Prime;
  func multint0(n) -> BinOp of Segm0(n) equals

  (multint n) || Segm0 n;
end;

theorem 
  for p be Prime holds multMagma(#Segm0(p),multint0(p)#) is
  associative commutative Group-like;

definition
  let p be Prime;
  func Z/Z*(p) -> commutative Group equals

  multMagma(#Segm0(p),multint0(p)#);
end;

theorem 
  for p be Prime,x,y be Element of Z/Z*(p), x1,y1 be Element of INT.Ring
  (p) st x=x1 & y=y1 holds x*y = x1*y1;

theorem 
  for p be Prime holds 1_Z/Z*(p) =1 & 1_Z/Z*(p) = 1.(INT.Ring(p));

theorem 
  for p be Prime, x be Element of Z/Z*(p), x1 be Element of INT.Ring(p)
  st x=x1 holds x" = x1";

registration
  let p be Prime;
  cluster Z/Z*(p) -> finite;
end;

theorem 
  for p be Prime holds card Z/Z*(p) = p-1;

theorem 
  for G be Group,a be Element of G, i be Integer st a is not
  being_of_order_0 holds ex n,k be Element of NAT st a|^i=a|^n & n=k*ord(a) +i;

theorem 
  for G be commutative Group,a,b be Element of G, n,m be Nat
  st G is finite & ord a=n & ord b= m & n gcd m = 1 holds ord (a*b) = n*m;

theorem 
  for L be non empty ZeroStr, p being Polynomial of L st 0 <= deg
  p holds p is non-zero;

theorem 
  for L be Field,f be Polynomial of L st 0 <= deg f holds Roots(f)
is finite set & ex m,n be Element of NAT st n=deg f & m=card(Roots(f)) & m <= n
;

theorem 
  for p be Prime, z be Element of Z/Z*(p), y be Element of
INT.Ring(p) st z=y holds for n be Element of NAT holds (power Z/Z*(p)).(z,n) =
  (power INT.Ring(p)).(y,n);

theorem 
  for p be Prime, a,b be Element of Z/Z*(p), n be Nat
  st 0< n & ord a=n & b |^n =1 holds b is Element of gr {a};

theorem 
  for G be Group, z be Element of G, d,l be Element of NAT st G is
  finite & ord z=d*l holds ord (z|^d)=l;

theorem 
  for p be Prime holds Z/Z*(p) is cyclic Group;














begin 

reserve X for BCI-algebra;
reserve X1 for non empty Subset of X;
reserve A,I for Ideal of X;
reserve x,y,z for Element of X;
reserve a for Element of A;



theorem 
  for x,y,z,u being Element of X st x<=y holds u\(z\x)<=u\(z\y);

theorem 
  for x,y,z,u being Element of X holds (x\(y\z))\(x\(y\u))<=z\u;

theorem 
  for x,y,z,u,v being Element of X holds (x\(y\(z\u)))\(x\(y\(z\v)))<=v\ u;

theorem 
  for x,y being Element of X holds (0.X\(x\y))\(y\x)=0.X;



definition
  let X;
  let a be Element of X;
  func initial_section(a) equals

  {x where x is Element of X:x<=a};
end;

theorem 
  x<=a implies x in A;



theorem 
  for x,a,b being Element of AtomSet(X) holds x is Element of BranchV(b)
  implies a\x=a\b;

theorem 
  for a being Element of X,x,b being Element of AtomSet(X) holds x is
  Element of BranchV(b) implies a\x=a\b;

theorem 
  initial_section(a) c= A;

theorem 
  AtomSet(X) is Ideal of X implies for x being Element of BCK-part(X),a
  being Element of AtomSet(X) st x\a in AtomSet(X) holds x=0.X;

theorem 
  AtomSet(X) is Ideal of X implies AtomSet(X) is closed Ideal of X;



definition
  let X,I;
  attr I is positive means

  for x being Element of I holds x is positive;
end;



theorem 
  for X being BCK-algebra,A,I being Ideal of X holds (A/\I={0.X} iff for
  x being Element of A,y being Element of I holds x\y =x );



theorem 
  for X being associative BCI-algebra,A being Ideal of X holds A is closed;

theorem 
  for X being BCI-algebra,A being Ideal of X st X is quasi-associative
  holds A is closed;

begin 

definition
  let X be BCI-algebra,IT be Ideal of X;
  attr IT is associative means


  0.X in IT & for x,y,z being Element of X
  st x\(y\z) in IT & y\z in IT holds x in IT;
end;

registration
  let X be BCI-algebra;
  cluster associative for Ideal of X;
end;

definition
  let X be BCI-algebra;
  mode associative-ideal of X -> non empty Subset of X means


    0.X in it
    & for x,y,z being Element of X st (x\y)\z in it & y\z in it holds x in it;
end;

theorem 
  X1 is associative-ideal of X implies X1 is Ideal of X;

theorem 
  I is associative-ideal of X iff for x,y,z st (x\y)\z in I holds x\(y\z) in I;

theorem 
  I is associative-ideal of X implies for x being Element of X holds x\(
  0.X\x) in I;

theorem 
  (for x being Element of X holds x\(0.X\x) in I) implies I is closed
  Ideal of X;

definition
  let X be BCI-algebra;
  mode p-ideal of X -> non empty Subset of X means


    0.X in it & for x,y,
    z being Element of X st (x\z)\(y\z) in it & y in it holds x in it;
end;

theorem 
  X1 is p-ideal of X implies X1 is Ideal of X;

theorem 
  for X,I st I is p-ideal of X holds BCK-part(X) c= I;

theorem 
  BCK-part(X) is p-ideal of X;

theorem 
  I is p-ideal of X iff for x,y st x in I & x<=y holds y in I;

theorem 
  I is p-ideal of X iff for x,y,z st (x\z)\(y\z) in I holds x\y in I;

begin 

definition
  let X be BCK-algebra, IT be Ideal of X;
  attr IT is commutative means


  for x,y,z being Element of X st (x\y)\z
  in IT & z in IT holds x\(y\(y\x)) in IT;
end;

registration
  let X be BCK-algebra;
  cluster commutative for Ideal of X;
end;

theorem 
  for X being BCK-algebra holds BCK-part(X) is commutative Ideal of X;

theorem 
  for X being BCK-algebra st X is p-Semisimple BCI-algebra holds {0.X}
  is commutative Ideal of X;

reserve X for BCK-algebra;

theorem 
  BCK-part(X) = the carrier of X;

reserve X for BCI-algebra;

theorem 
  (for X being BCI-algebra,x,y being Element of X holds (x\y)\y=x\y)
  implies the carrier of X = BCK-part(X);

theorem 
  (for X being BCI-algebra,x,y being Element of X holds x\(y\x)=x)
  implies the carrier of X = BCK-part(X);

theorem 
  (for X being BCI-algebra,x,y being Element of X holds x\(x\y)=y\(y\x))
  implies the carrier of X = BCK-part(X);

theorem 
  (for X being BCI-algebra,x,y,z being Element of X holds (x\y)\y=(x\z)\
  (y\z)) implies the carrier of X = BCK-part(X);

theorem 
  (for X being BCI-algebra,x,y being Element of X holds (x\y)\(y\x)=x\y)
  implies the carrier of X = BCK-part(X);

theorem 
  (for X being BCI-algebra,x,y being Element of X holds (x\y)\((x\y)\(y\
  x))=0.X) implies the carrier of X = BCK-part(X);

theorem 
  for X being BCK-algebra holds the carrier of X is commutative Ideal of X;

reserve X for BCK-algebra;
reserve I for Ideal of X;

theorem 
  I is commutative Ideal of X iff for x,y being Element of X st x\
  y in I holds x\(y\(y\x)) in I;

theorem 
  for I,A being Ideal of X st I c= A & I is commutative Ideal of X
  holds A is commutative Ideal of X;

theorem 
  (for I being Ideal of X holds I is commutative Ideal of X) iff {
  0.X} is commutative Ideal of X;

theorem 
  {0.X} is commutative Ideal of X iff X is commutative BCK-algebra;

theorem 
  X is commutative BCK-algebra iff for I being Ideal of X holds I
  is commutative Ideal of X;

theorem 
  {0.X} is commutative Ideal of X iff for I being Ideal of X holds I is
  commutative Ideal of X;

reserve I for Ideal of X;

theorem 
  for x,y being Element of X holds x\(x\y) in I implies x\((x\y)\((x\y)\
  x)) in I & (y\(y\x))\x in I & y\(y\x)\(x\y) in I;

theorem 
  {0.X} is commutative Ideal of X iff for x,y being Element of X holds x
  \(x\y) <= y\(y\x);

theorem 
  {0.X} is commutative Ideal of X iff for x,y being Element of X holds x
  \y = x\(y\(y\x));

theorem 
  {0.X} is commutative Ideal of X iff for x,y being Element of X holds x
  \(x\y) = y\(y\(x\(x\y)));

theorem 
  {0.X} is commutative Ideal of X iff for x,y being Element of X st x<=
  y holds x= y\(y\x);

theorem 
  {0.X} is commutative Ideal of X implies (for x,y being Element of X
holds (x\y=x iff y\(y\x)=0.X)) & (for x,y being Element of X st x\y=x holds y\x
=y) & (for x,y,a being Element of X st y <= a holds (a\x)\(a\y) = y\x) &(for x,
  y being Element of X holds x\(y\(y\x))=x\y & (x\y)\((x\y)\x)=x\y) & for x,y,a
  being Element of X st x <= a holds (a\y)\((a\y)\(a\x)) = (a\y)\(x\y);

theorem 
  (for I being Ideal of X holds I is commutative Ideal of X) iff for x,y
  being Element of X holds x\(x\y) <= y\(y\x);

theorem 
  (for I being Ideal of X holds I is commutative Ideal of X) iff for x,y
  being Element of X holds x\y = x\(y\(y\x));

theorem 
  (for I being Ideal of X holds I is commutative Ideal of X) iff for x,y
  being Element of X holds x\(x\y) = y\(y\(x\(x\y)));

theorem 
  (for I being Ideal of X holds I is commutative Ideal of X) iff for x,y
  being Element of X st x<= y holds x= y\(y\x);

theorem 
  (for I being Ideal of X holds I is commutative Ideal of X) implies (
  for x,y being Element of X holds (x\y=x iff y\(y\x)=0.X)) & (for x,y being
  Element of X st x\y=x holds y\x=y) & (for x,y,a being Element of X st y <= a
holds (a\x)\(a\y) = y\x) &(for x,y being Element of X holds x\(y\(y\x))=x\y & (
x\y)\((x\y)\x)=x\y) & for x,y,a being Element of X st x <= a holds (a\y)\((a\y)
  \(a\x)) = (a\y)\(x\y);

begin 

definition
  let X be BCK-algebra;
  mode implicative-ideal of X -> non empty Subset of X means


    0.X in it
    & for x,y,z being Element of X st (x\(y\x))\z in it& z in it holds x in it;
end;

reserve X for BCK-algebra;
reserve I for Ideal of X;

theorem 
  I is implicative-ideal of X iff for x,y being Element of X st x\
  (y\x) in I holds x in I;

definition
  let X be BCK-algebra;
  mode positive-implicative-ideal of X -> non empty Subset of X means


0.X in it &for x,y,z being Element of X st (x\y)\z in it & y\z in it holds x\z
    in it;
end;

theorem 
  I is positive-implicative-ideal of X iff for x,y being Element
  of X st (x\y)\y in I holds x\y in I;

theorem 
  (for x,y,z being Element of X st (x\y)\z in I & y\z in I holds x
\z in I) implies for x,y,z being Element of X st (x\y)\z in I holds (x\z)\(y\z)
  in I;

theorem 
  (for x,y,z being Element of X st (x\y)\z in I holds (x\z)\(y\z)
  in I) implies I is positive-implicative-ideal of X;

theorem 
  I is positive-implicative-ideal of X iff for x,y,z being Element of X
  st (x\y)\z in I & y\z in I holds x\z in I;

theorem 
  I is positive-implicative-ideal of X iff for x,y,z being Element of X
  st (x\y)\z in I holds (x\z)\(y\z) in I;

theorem 
  for I,A being Ideal of X st I c= A & I is positive-implicative-ideal
  of X holds A is positive-implicative-ideal of X;

theorem 
  I is implicative-ideal of X implies I is commutative Ideal of X & I is
  positive-implicative-ideal of X;














begin 

definition
  let V be non empty addLoopStr;
  let V1 be Subset of V;
  attr V1 is having-inverse means


  for v be Element of V st v in V1 holds -v in V1;
end;

definition
  let V be non empty addLoopStr;
  let V1 be Subset of V;
  attr V1 is additively-closed means


  V1 is add-closed having-inverse;
end;

registration
  let V be non empty addLoopStr;
  cluster [#]V -> add-closed having-inverse;
end;

registration
  let V be non empty doubleLoopStr;
  cluster additively-closed -> add-closed having-inverse for Subset of V;
  cluster add-closed having-inverse -> additively-closed for Subset of V;
end;

registration
  let V be non empty addLoopStr;
  cluster add-closed having-inverse non empty for Subset of V;
end;

definition
  let V be Ring;
  mode Subring of V -> Ring means


    the carrier of it c= the carrier of V
  & the addF of it = (the addF of V)||the carrier of it
  & the multF of it = (the multF of V)||the carrier of it
  & 1.it=1.V & 0.it = 0.V;
end;

reserve X for non empty set;
reserve x for Element of X;
reserve d1,d2 for Element of X;
reserve A for BinOp of X;
reserve M for Function of [:X,X:],X;
reserve V for Ring;
reserve V1 for Subset of V;

theorem 
  V1 = X & A = (the addF of V)||V1 & M = (the multF of V)||V1 & d1
= 1.V & d2 = 0.V & V1 is having-inverse implies doubleLoopStr (# X,A,M,d1,d2 #)
  is Subring of V;

registration
  let V be Ring;
  cluster strict for Subring of V;
end;

definition
  let V be non empty multLoopStr_0;
  let V1 be Subset of V;
  attr V1 is multiplicatively-closed means


  1.V in V1 & for v,u be Element of V st v in V1 & u in V1 holds v * u in V1;
end;

definition
  let V be non empty addLoopStr, V1 be Subset of V such that
 V1 is add-closed non empty;
  func Add_(V1,V) -> BinOp of V1 equals


  (the addF of V)||V1;
end;

definition
  let V be non empty multLoopStr_0, V1 be Subset of V such that
 V1 is multiplicatively-closed non empty;
  func mult_(V1,V) -> BinOp of V1 equals


  (the multF of V)||V1;
end;

definition
  let V be add-associative right_zeroed right_complementable non empty
  doubleLoopStr, V1 be Subset of V such that
 V1 is add-closed having-inverse non empty;
  func Zero_(V1,V) -> Element of V1 equals


  0.V;
end;

definition
  let V be non empty multLoopStr_0, V1 be Subset of V such that
 V1 is multiplicatively-closed non empty;
  func One_(V1,V) -> Element of V1 equals


  1.V;
end;

theorem 
  V1 is additively-closed multiplicatively-closed non empty implies
  doubleLoopStr(# V1,Add_(V1,V),mult_(V1,V),One_(V1,V),Zero_(V1,V) #) is Ring;

begin 

reserve V for Algebra;
reserve V1 for Subset of V;

reserve MR for Function of [:REAL,X:],X;
reserve a for Real;

definition
  let V be Algebra;
  mode Subalgebra of V -> Algebra means


    the carrier of it c= the
carrier of V & the addF of it = (the addF of V)||the carrier of it & the multF
of it = (the multF of V)||the carrier of it & the Mult of it = (the Mult of V)
    | [:REAL,the carrier of it:] & 1.it = 1.V & 0.it = 0.V;
end;

theorem 
  V1 = X & d1 = 0.V & d2 = 1.V & A = (the addF of V)||V1 & M = (the
  multF of V)||V1 & MR = (the Mult of V) | [:REAL,V1:] & V1 is having-inverse
  implies AlgebraStr(# X,M,A,MR,d2,d1 #) is Subalgebra of V;

registration
  let V be Algebra;
  cluster strict for Subalgebra of V;
end;

definition
  let V be Algebra, V1 be Subset of V;
  attr V1 is additively-linearly-closed means


  V1 is add-closed
having-inverse & for a be Real, v be Element of V st v in V1 holds a * v in V1;
end;

registration
  let V be Algebra;
  cluster additively-linearly-closed -> additively-closed for Subset of V;
end;

definition
  let V be Algebra, V1 be Subset of V such that
 V1 is additively-linearly-closed non empty;
  func Mult_(V1,V) -> Function of [:REAL,V1:], V1 equals


  (the Mult of V) | [:REAL,V1:];
end;

definition
  let V be non empty RLSStruct;
  attr V is scalar-mult-cancelable means


  for a be Real, v be Element of V st a*v=0.V holds a=0 or v=0.V;
end;

theorem 
  for V being add-associative right_zeroed right_complementable
  vector-distributive scalar-distributive scalar-associative
  vector-associative non empty AlgebraStr, a be Real holds a*0.V = 0.V;

theorem 
  for V being Abelian add-associative right_zeroed right_complementable
  vector-distributive scalar-distributive scalar-associative
  vector-associative non empty AlgebraStr st V is scalar-mult-cancelable
  holds V is RealLinearSpace;

theorem 
  V1 is additively-linearly-closed multiplicatively-closed non
empty implies AlgebraStr(# V1,mult_(V1,V), Add_(V1,V), Mult_(V1,V), One_(V1,V),
    Zero_(V1,V) #) is Subalgebra of V;

registration
  let X be non empty set;
  cluster RAlgebra X -> Abelian add-associative right_zeroed
right_complementable commutative associative right_unital right-distributive
    vector-distributive scalar-distributive scalar-associative
    vector-associative;
end;

theorem 
  RAlgebra X is RealLinearSpace;

theorem 
  for V be Algebra, V1 be Subalgebra of V holds ( for v1,w1 be
Element of V1, v,w be Element of V st v1=v & w1=w holds v1+w1=v+w ) & ( for v1,
  w1 be Element of V1, v,w be Element of V st v1=v & w1=w holds v1*w1=v*w ) & (
for v1 be Element of V1, v be Element of V, a be Real st v1=v holds a*v1=a*v )
  & 1_V1 = 1_V & 0.V1=0.V;

begin 

definition
  let X be non empty set;
  func BoundedFunctions X -> non empty Subset of RAlgebra X equals

  { f where f
  is Function of X,REAL : f|X is bounded };
end;

theorem 
  BoundedFunctions X is additively-linearly-closed multiplicatively-closed;

registration
  let X;
  cluster BoundedFunctions X -> additively-linearly-closed
    multiplicatively-closed;
end;

definition
  let X be non empty set;
  func R_Algebra_of_BoundedFunctions X -> Algebra equals

  AlgebraStr (#
BoundedFunctions X, mult_(BoundedFunctions X,RAlgebra X), Add_(BoundedFunctions
X,RAlgebra X), Mult_(BoundedFunctions X,RAlgebra X), One_(BoundedFunctions X,
    RAlgebra X), Zero_(BoundedFunctions X,RAlgebra X) #);
end;

theorem 
  R_Algebra_of_BoundedFunctions X is Subalgebra of RAlgebra X;

theorem 
  R_Algebra_of_BoundedFunctions X is RealLinearSpace;

reserve F,G,H for VECTOR of R_Algebra_of_BoundedFunctions X;
reserve f,g,h for Function of X,REAL;

theorem 
  f=F & g=G & h=H implies ( H = F+G iff for x be Element of X
  holds h.x = f.x + g.x );

theorem 
  f=F & g=G implies ( G = a*F iff for x be Element of X holds g.x = a*f.x );

theorem 
  f=F & g=G & h=H implies ( H = F*G iff for x be Element of X
  holds h.x = f.x * g.x );

theorem 
  0.R_Algebra_of_BoundedFunctions X = X -->0;

theorem 
  1_R_Algebra_of_BoundedFunctions X = X -->1;

definition
  let X be non empty set, F be set such that
 F in BoundedFunctions X;
  func modetrans(F,X) -> Function of X,REAL means


  it=F & it|X is bounded;
end;

definition
  let X be non empty set, f be Function of X,REAL;
  func PreNorms f -> non empty Subset of REAL equals

  { abs(f.x) where x is Element of X : not contradiction };
end;

theorem 
  f|X is bounded implies PreNorms f is bounded_above;

theorem 
  f|X is bounded iff PreNorms f is bounded_above;

definition
  let X be non empty set;
  func BoundedFunctionsNorm X -> Function of BoundedFunctions X,REAL means


   for x be set st x in BoundedFunctions X
  holds it.x = upper_bound PreNorms(
  modetrans(x,X));
end;

theorem 
  f|X is bounded implies modetrans(f,X) = f;

theorem 
  f|X is bounded implies (BoundedFunctionsNorm X).f = upper_bound PreNorms f;

definition
  let X be non empty set;
  func R_Normed_Algebra_of_BoundedFunctions X -> Normed_AlgebraStr equals

Normed_AlgebraStr (# BoundedFunctions X, mult_(BoundedFunctions X,RAlgebra X),
Add_(BoundedFunctions X,RAlgebra X), Mult_(BoundedFunctions X,RAlgebra X), One_
    (BoundedFunctions X,RAlgebra X), Zero_(BoundedFunctions X,RAlgebra X),
    BoundedFunctionsNorm X #);
end;

registration
  let X be non empty set;
  cluster R_Normed_Algebra_of_BoundedFunctions X -> non empty;
end;

registration
  let X be non empty set;
  cluster R_Normed_Algebra_of_BoundedFunctions X -> unital;
end;

theorem 
  for W be Normed_AlgebraStr, V be Algebra st the AlgebraStr of W
  = V holds W is Algebra;

reserve F,G,H for Point of R_Normed_Algebra_of_BoundedFunctions X;

theorem 
  R_Normed_Algebra_of_BoundedFunctions X is Algebra;

theorem 
  (Mult_(BoundedFunctions X,RAlgebra X)).(1,F) = F;

theorem 
  R_Normed_Algebra_of_BoundedFunctions X is RealLinearSpace;

theorem 
  X-->0 = 0.R_Normed_Algebra_of_BoundedFunctions X;

theorem 
  f=F & f|X is bounded implies abs(f.x) <= ||.F.||;

theorem 
  0 <= ||.F.||;

theorem 
  F = 0.R_Normed_Algebra_of_BoundedFunctions X implies 0 = ||.F.||;

theorem 
  f=F & g=G & h=H implies (H = F+G iff for x be Element of X holds
  h.x = f.x + g.x);

theorem 
  f=F & g=G implies ( G = a*F iff for x be Element of X holds g.x = a*f.x );

theorem 
  f=F & g=G & h=H implies (H = F*G iff for x be Element of X holds
  h.x = f.x * g.x);

theorem 
  ( ||.F.|| = 0 iff F = 0.R_Normed_Algebra_of_BoundedFunctions X )
  & ||.a*F.|| = abs a * ||.F.|| & ||.F+G.|| <= ||.F.|| + ||.G.||;

theorem 
  R_Normed_Algebra_of_BoundedFunctions X is
   reflexive discerning RealNormSpace-like;

registration
  let X be non empty set;
  cluster R_Normed_Algebra_of_BoundedFunctions X ->
   reflexive discerning RealNormSpace-like
vector-distributive scalar-distributive scalar-associative scalar-unital
 Abelian add-associative right_zeroed right_complementable;
end;

theorem 
  f=F & g=G & h=H implies (H = F-G iff for x be Element of X holds
  h.x = f.x - g.x );

theorem 
  for X be non empty set for seq be sequence of
R_Normed_Algebra_of_BoundedFunctions X st seq is Cauchy_sequence_by_Norm holds
  seq is convergent;

theorem 
  R_Normed_Algebra_of_BoundedFunctions X is RealBanachSpace;

registration
  let X be non empty set;
  cluster R_Normed_Algebra_of_BoundedFunctions X -> complete;
end;

theorem 
  R_Normed_Algebra_of_BoundedFunctions X is Banach_Algebra;














begin 

definition
  let V be non empty 1-sorted;
  mode C_Linear_Combination of V -> Element of Funcs(the carrier of V, COMPLEX)
  means


    ex T being finite Subset of V st for v being Element of V st not v in T
    holds it.v = 0;
end;

notation
  let V be non empty addLoopStr,
      L be Element of Funcs(the carrier of V,COMPLEX);
  synonym Carrier L for support L;
end;

definition
  let V be non empty addLoopStr,
      L be Element of Funcs(the carrier of V,COMPLEX);
  redefine func Carrier L -> Subset of V equals

  {v where v is Element of V : L.v <> 0c};
end;

registration
  let V be non empty addLoopStr, L be C_Linear_Combination of V;
  cluster Carrier L -> finite;
end;

theorem 
  for V be non empty addLoopStr, L be C_Linear_Combination of V, v
  be Element of V holds L.v = 0c iff not v in Carrier L;

definition
  let V be non empty addLoopStr;
  func ZeroCLC V -> C_Linear_Combination of V means


  Carrier it = {};
end;

registration
  let V be non empty addLoopStr;
  cluster Carrier ZeroCLC V -> empty;
end;

theorem 
  for V be non empty addLoopStr, v be Element of V holds (ZeroCLC V ).v = 0c;

definition
  let V be non empty addLoopStr;
  let A be Subset of V;
  mode C_Linear_Combination of A -> C_Linear_Combination of V means


    Carrier it c= A;
end;

theorem 
  for V be non empty addLoopStr, A,B be Subset of V, l be
  C_Linear_Combination of A st A c= B holds l is C_Linear_Combination of B;

theorem 
  for V be non empty addLoopStr, A be Subset of V holds ZeroCLC V
  is C_Linear_Combination of A;

theorem 
  for V being non empty addLoopStr, l being C_Linear_Combination of
  {}the carrier of V holds l = ZeroCLC V;

reserve x,y for set,
  i for Nat;

definition
  let V be non empty CLSStruct;
  let F be FinSequence of the carrier of V;
  let f be Function of the carrier of V,COMPLEX;
  func f (#) F -> FinSequence of the carrier of V means


  len it = len F & for i st i in dom it holds it.i = f.(F/.i) * F/.i;
end;

reserve V for non empty CLSStruct,
  u,v,v1,v2,v3 for VECTOR of V,
  A for Subset of V,
  l, l1, l2 for C_Linear_Combination of A,
  x,y,y1,y2 for set,
  a,b for Complex,
  F for FinSequence of the carrier of V,
  f for Function of the carrier of V, COMPLEX;

theorem 
  x in dom F & v = F.x implies (f (#) F).x = f.v * v;

theorem 
  f (#) <*>(the carrier of V) = <*>(the carrier of V);

theorem 
  f (#) <* v *> = <* f.v * v *>;

theorem 
  f (#) <* v1,v2 *> = <* f.v1 * v1, f.v2 * v2 *>;

theorem 
  f (#) <* v1,v2,v3 *> = <* f.v1 * v1, f.v2 * v2, f.v3 * v3 *>;

reserve K,L,L1,L2,L3 for C_Linear_Combination of V;

definition
  let V be Abelian add-associative right_zeroed right_complementable non empty
  CLSStruct;
  let L be C_Linear_Combination of V;
  func Sum L -> Element of V means


  ex F being FinSequence of the
  carrier of V st F is one-to-one & rng F = Carrier L & it = Sum(L (#) F);
end;

theorem 
  for V being Abelian add-associative right_zeroed
  right_complementable non empty CLSStruct holds Sum(ZeroCLC V) = 0.V;

theorem 
  for V being ComplexLinearSpace, A being Subset of V holds A <> {}
implies ( A is linearly-closed iff for l being C_Linear_Combination of A holds
  Sum l in A );

theorem 
  for V being Abelian add-associative right_zeroed right_complementable
non empty CLSStruct, l being C_Linear_Combination of {}(the carrier of V) holds
  Sum l = 0.V;

theorem 
  for V being ComplexLinearSpace, v being VECTOR of V, l being
  C_Linear_Combination of {v} holds Sum l = l.v * v;

theorem 
  for V being ComplexLinearSpace, v1, v2 being VECTOR of V holds
v1 <> v2 implies for l being C_Linear_Combination of {v1,v2} holds Sum l = l.v1
  * v1 + l.v2 * v2;

theorem 
  for V being Abelian add-associative right_zeroed right_complementable
  non empty CLSStruct, L being C_Linear_Combination of V holds Carrier L = {}
  implies Sum L = 0.V;

theorem 
  for V being ComplexLinearSpace, L being C_Linear_Combination of V, v
  being VECTOR of V holds Carrier L = {v} implies Sum L = L.v * v;

theorem 
  for V being ComplexLinearSpace, L being C_Linear_Combination of
V, v1, v2 being VECTOR of V holds Carrier L = {v1,v2} & v1 <> v2 implies Sum L
  = L.v1 * v1 + L.v2 * v2;

definition
  let V be non empty addLoopStr;
  let L1,L2 be C_Linear_Combination of V;
  redefine pred L1 = L2 means

  for v being Element of V holds L1.v = L2.v;
end;

definition
  let V be non empty addLoopStr;
  let L1,L2 be C_Linear_Combination of V;
  redefine func L1 + L2 -> C_Linear_Combination of V means


  for v being Element of V holds it.v = L1.v + L2.v;
end;

theorem 
  Carrier(L1 + L2) c= Carrier L1 \/ Carrier L2;

theorem 
  L1 is C_Linear_Combination of A & L2 is C_Linear_Combination of
  A implies L1 + L2 is C_Linear_Combination of A;

definition
  let V,A;
  let L1,L2 be C_Linear_Combination of A;
  redefine func L1 + L2 -> C_Linear_Combination of A;
end;

theorem 
  for V be non empty addLoopStr, L1,L2 be C_Linear_Combination of V
  holds L1 + L2 = L2 + L1;

theorem 
  L1 + (L2 + L3) = L1 + L2 + L3;

theorem 
  L + ZeroCLC V = L;

definition
  let V; let a be Complex;
  let L;
  func a * L -> C_Linear_Combination of V means


  for v holds it.v = a * L.v;
end;

theorem 
  a <> 0c implies Carrier (a * L) = Carrier L;

theorem 
  0c * L = ZeroCLC V;

theorem 
  L is C_Linear_Combination of A implies a * L is C_Linear_Combination of A;

theorem 
  (a + b) * L = a * L + b * L;

theorem 
  a * (L1 + L2) = a * L1 + a * L2;

theorem 
  a * (b * L) = (a * b) * L;

theorem 
  1r * L = L;

definition
  let V,L;
  func - L -> C_Linear_Combination of V equals

  (- 1r) * L;
end;

theorem 
  (- L).v = - L.v;

theorem 
  L1 + L2 = ZeroCLC V implies L2 = - L1;

theorem 
  - (- L) = L;

definition
  let V;
  let L1,L2;
  func L1 - L2 -> C_Linear_Combination of V equals

  L1 + (- L2);
end;

theorem 
  (L1 - L2).v = L1.v - L2.v;

theorem 
  Carrier(L1 - L2) c= Carrier L1 \/ Carrier L2;

theorem 
  L1 is C_Linear_Combination of A & L2 is C_Linear_Combination of A
  implies L1 - L2 is C_Linear_Combination of A;

theorem 
  L - L = ZeroCLC V;

definition
  let V;
  func C_LinComb V -> set means


  x in it iff x is C_Linear_Combination of V;
end;

registration
  let V;
  cluster C_LinComb V -> non empty;
end;

reserve e,e1,e2 for Element of C_LinComb V;

definition
  let V;
  let e;
  func @e -> C_Linear_Combination of V equals

  e;
end;

definition
  let V;
  let L;
  func @L -> Element of C_LinComb V equals

  L;
end;

definition
  let V;
  func C_LCAdd V -> BinOp of C_LinComb V means


  for e1,e2 holds it.(e1, e2) = @e1 + @e2;
end;

definition
  let V;
  func C_LCMult V -> Function of [:COMPLEX,C_LinComb V:], C_LinComb V means

   for a,e holds it.[a,e] = a * @e;
end;

definition
  let V;
  func LC_CLSpace V -> ComplexLinearSpace equals

  CLSStruct (# C_LinComb V, @
    ZeroCLC V, C_LCAdd V, C_LCMult V #);
end;

registration
  let V;
  cluster LC_CLSpace V -> strict non empty;
end;

theorem 
  vector(LC_CLSpace V,L1) + vector(LC_CLSpace V,L2) = L1 + L2;

theorem 
  a * vector(LC_CLSpace V,L) = a * L;

theorem 
  - vector(LC_CLSpace V,L) = - L;

theorem 
  vector(LC_CLSpace V,L1) - vector(LC_CLSpace V,L2) = L1 - L2;

definition
  let V;
  let A;
  func LC_CLSpace A -> strict Subspace of LC_CLSpace V means

  the carrier of it = {l : not contradiction};
end;

begin 

definition
  let V be ComplexLinearSpace, W be Subspace of V;
  func Up W -> Subset of V equals

  the carrier of W;
end;

registration
  let V be ComplexLinearSpace, W be Subspace of V;
  cluster Up W -> non empty;
end;

definition
  let V be non empty CLSStruct, S be Subset of V;
  attr S is Affine means


  for x,y being VECTOR of V, z being Complex st
  z is Real & x in S & y in S holds (1r - z) * x + z * y in S;
end;

definition
  let V be ComplexLinearSpace;
  func (Omega).V -> strict Subspace of V equals

  the CLSStruct of V;
end;

registration
  let V be non empty CLSStruct;
  cluster [#]V -> Affine;
  cluster empty -> Affine for Subset of V;
end;

registration
  let V be non empty CLSStruct;
  cluster non empty Affine for Subset of V;
  cluster empty Affine for Subset of V;
end;

theorem 
  for a being real number, z being complex number holds Re(a*z)=a* Re(z);

theorem 
  for a being real number, z being complex number holds Im(a*z) = a*Im(z);

theorem 
  for a being real number , z being complex number st 0<=a & a<=1
  holds |.a*z.| = a*|.z.| & |.(1r-a)*z.| = (1r-a)*|.z.|;

begin  

definition
  let V be non empty CLSStruct;
  let M be Subset of V;
  let r be Complex;
  func r*M -> Subset of V equals

  {r * v where v is Element of V: v in M};
end;

definition
  let V be non empty CLSStruct;
  let M be Subset of V;
  attr M is convex means


  for u,v being VECTOR of V, z be Complex st
  (ex r be Real st z=r & 0 < r & r < 1 ) & u in M & v in M holds
  z*u + (1r-z)*v in M;
end;

theorem 
  for V being vector-distributive scalar-distributive scalar-associative
  scalar-unital non empty CLSStruct, M being
  Subset of V, z being Complex st M is convex holds z*M is convex;

theorem 
  for V being Abelian add-associative vector-distributive scalar-distributive
  scalar-associative scalar-unital non empty
  CLSStruct, M,N being Subset of V st M is convex & N is convex holds M + N is
  convex;

theorem 
  for V being ComplexLinearSpace, M,N being Subset of V st M is convex &
  N is convex holds M - N is convex;

theorem 
  for V being non empty CLSStruct, M being Subset of V holds M is
  convex iff for z being Complex st (ex r being Real st z=r & 0 < r & r < 1)
  holds z*M + (1r-z)*M c= M;

theorem 
  for V being Abelian non empty CLSStruct, M being Subset of V st M is
  convex holds for z being Complex st (ex r being Real st z=r & 0 < r & r < 1)
  holds (1r-z)*M + z*M c= M;

theorem 
  for V being Abelian add-associative vector-distributive scalar-distributive
  scalar-associative scalar-unital non empty
  CLSStruct, M,N being Subset of V st M is convex & N is convex holds for z
  being Complex holds z*M + (1r-z)*N is convex;

theorem 
  for V being vector-distributive scalar-distributive scalar-associative
  scalar-unital non empty CLSStruct, M be
  Subset of V holds 1r*M = M;

theorem 
  for V being ComplexLinearSpace, M be non empty Subset of V holds
  0c * M = {0.V};

theorem 
  for V be add-associative non empty addLoopStr, M1,M2,M3 be Subset of
  V holds (M1 + M2) + M3 = M1 + (M2 + M3);

theorem 
  for V being vector-distributive scalar-distributive scalar-associative
  scalar-unital non empty CLSStruct, M
  being Subset of V, z1,z2 being Complex holds z1*(z2*M) = (z1*z2)*M;

theorem 
  for V being vector-distributive scalar-distributive scalar-associative
  scalar-unital non empty CLSStruct, M1,M2
  being Subset of V, z being Complex holds z*(M1 + M2) = z*M1 + z*M2;

theorem 
  for V being ComplexLinearSpace, M being Subset of V, v being VECTOR of
  V holds M is convex iff v + M is convex;

theorem 
  for V being ComplexLinearSpace holds Up((0).V) is convex;

theorem 
  for V being ComplexLinearSpace holds Up((Omega).V) is convex;

theorem 
  for V being non empty CLSStruct, M being Subset of V st M = {}
  holds M is convex;

theorem 
  for V being Abelian add-associative vector-distributive scalar-distributive
  scalar-associative scalar-unital non
empty CLSStruct, M1,M2 being Subset of V, z1,z2 being Complex st M1 is convex
  & M2 is convex holds z1*M1 + z2*M2 is convex;

theorem 
  for V being vector-distributive scalar-distributive scalar-associative
  scalar-unital non empty CLSStruct, M
  being Subset of V, z1,z2 being Complex holds (z1 + z2)*M c= z1*M + z2*M;

theorem 
  for V being non empty CLSStruct, M,N being Subset of V, z being
  Complex st M c= N holds z*M c= z*N;

theorem 
  for V being non empty CLSStruct, M being empty Subset of V, z
  being Complex holds z * M = {};

theorem 
  for V being non empty addLoopStr, M being empty Subset of V, N
  being Subset of V holds M + N = {};

theorem 
  for V being right_zeroed non empty addLoopStr, M being Subset
  of V holds M + {0.V} = M;

theorem 
  for V being ComplexLinearSpace, M being Subset of V, z1,z2 being
  Complex st (ex r1,r2 being Real st z1 = r1 & z2 = r2 & r1 >= 0 & r2 >= 0) & M
  is convex holds z1*M + z2*M = (z1 + z2)*M;

theorem 
  for V being Abelian add-associative vector-distributive scalar-distributive
  scalar-associative scalar-unital non empty
CLSStruct, M1,M2,M3 being Subset of V, z1,z2,z3 being Complex st M1 is convex
  & M2 is convex & M3 is convex holds z1*M1 + z2*M2 + z3*M3 is convex;

theorem 
  for V being non empty CLSStruct, F being Subset-Family of V st (
  for M being Subset of V st M in F holds M is convex) holds meet F is convex;

theorem 
  for V being non empty CLSStruct, M being Subset of V st M is
  Affine holds M is convex;

registration
  let V be non empty CLSStruct;
  cluster non empty convex for Subset of V;
end;

registration
  let V be non empty CLSStruct;
  cluster empty convex for Subset of V;
end;

theorem 
  for V being ComplexUnitarySpace-like non empty CUNITSTR, M being
Subset of V, v being VECTOR of V, r being Real st M = {u where u is VECTOR of V
  : Re(u .|. v) >= r } holds M is convex;

theorem 
  for V being ComplexUnitarySpace-like non empty CUNITSTR, M being
Subset of V, v being VECTOR of V, r being Real st M = {u where u is VECTOR of V
  : Re(u .|. v) > r } holds M is convex;

theorem 
  for V being ComplexUnitarySpace-like non empty CUNITSTR, M being
Subset of V, v being VECTOR of V, r being Real st M = {u where u is VECTOR of V
  : Re(u .|. v) <= r } holds M is convex;

theorem 
  for V being ComplexUnitarySpace-like non empty CUNITSTR, M being
Subset of V, v being VECTOR of V, r being Real st M = {u where u is VECTOR of V
  : Re(u .|. v) < r } holds M is convex;

theorem 
  for V being ComplexUnitarySpace-like non empty CUNITSTR, M being
Subset of V, v being VECTOR of V, r being Real st M = {u where u is VECTOR of V
  : Im(u .|. v) >= r } holds M is convex;

theorem 
  for V being ComplexUnitarySpace-like non empty CUNITSTR, M being
Subset of V, v being VECTOR of V, r being Real st M = {u where u is VECTOR of V
  : Im(u .|. v) > r } holds M is convex;

theorem 
  for V being ComplexUnitarySpace-like non empty CUNITSTR, M being
Subset of V, v being VECTOR of V, r being Real st M = {u where u is VECTOR of V
  : Im(u .|. v) <= r } holds M is convex;

theorem 
  for V being ComplexUnitarySpace-like non empty CUNITSTR, M being
Subset of V, v being VECTOR of V, r being Real st M = {u where u is VECTOR of V
  : Im(u .|. v) < r } holds M is convex;

theorem 
  for V being ComplexUnitarySpace-like non empty CUNITSTR, M being
Subset of V, v being VECTOR of V, r being Real st M = {u where u is VECTOR of V
  : |.u .|. v .| <= r } holds M is convex;

theorem 
  for V being ComplexUnitarySpace-like non empty CUNITSTR, M being
Subset of V, v being VECTOR of V, r being Real st M = {u where u is VECTOR of V
  : |.u .|. v .| < r } holds M is convex;

begin  

definition
  let V be ComplexLinearSpace, L be C_Linear_Combination of V;
  attr L is convex means


  ex F being FinSequence of the carrier of V st
F is one-to-one & rng F = Carrier L & ex f being FinSequence of REAL st len f =
len F & Sum f = 1 & for n being Nat st n in dom f holds f.n = L.(F.n) & f.n >=
  0;
end;

theorem 
  for V being ComplexLinearSpace, L being C_Linear_Combination of
  V st L is convex holds Carrier L <> {};

theorem 
  for V being ComplexLinearSpace, L being C_Linear_Combination of V, v
  being VECTOR of V st L is convex & ( ex r being Real st r = L.v & r <= 0 )
  holds not v in Carrier L;

theorem 
  for V being ComplexLinearSpace, L being C_Linear_Combination of V st L
  is convex holds L <> ZeroCLC V;

theorem 
  for V being ComplexLinearSpace, v being VECTOR of V, L being
  C_Linear_Combination of V st L is convex & Carrier L = {v} holds ( ex r being
  Real st r = L.v & r = 1 ) & Sum L = L.v * v;

theorem 
  for V being ComplexLinearSpace, v1,v2 being VECTOR of V, L being
C_Linear_Combination of V st L is convex & Carrier L = {v1,v2} & v1 <> v2 holds
( ex r1, r2 being Real st r1 = L.v1 & r2 = L.v2 & r1 + r2 = 1 & r1 >= 0 & r2 >=
  0 ) & Sum L = L.v1 * v1 + L.v2 * v2;

theorem 
  for V being ComplexLinearSpace, v1,v2,v3 being VECTOR of V, L
being C_Linear_Combination of V st L is convex & Carrier L = {v1,v2,v3} & v1 <>
v2 & v2 <> v3 & v3 <> v1 holds ( ex r1, r2, r3 being real number st r1 = L.v1 &
r2 = L.v2 & r3 = L.v3 & r1 + r2 + r3 = 1 & r1 >= 0 & r2 >= 0 & r3 >= 0 ) & Sum
  L = L.v1 * v1 + L.v2 * v2 + L.v3 * v3;

theorem 
  for V being ComplexLinearSpace, v being VECTOR of V, L being
C_Linear_Combination of {v} st L is convex holds ( ex r being Real st r = L.v &
  r = 1 ) & Sum L = L.v * v;

theorem 
  for V being ComplexLinearSpace, v1,v2 being VECTOR of V, L being
  C_Linear_Combination of {v1,v2} st v1 <> v2 & L is convex holds ( ex r1, r2
being real number st r1 = L.v1 & r2 = L.v2 &r1 >= 0 & r2 >= 0 )& Sum L = L.v1 *
  v1 + L.v2 * v2;

theorem 
  for V being ComplexLinearSpace, v1,v2,v3 being VECTOR of V, L being
  C_Linear_Combination of {v1,v2,v3} st v1 <> v2 & v2 <> v3 & v3 <> v1 & L is
convex holds ( ex r1, r2, r3 being real number st r1 = L.v1 & r2 = L.v2 & r3 =
L.v3 & r1 + r2 + r3 = 1 & r1 >= 0 & r2 >= 0 & r3 >= 0 ) & Sum L = L.v1 * v1 + L
  .v2 * v2 + L.v3 * v3;

begin  

definition
  let V be non empty CLSStruct, M be Subset of V;
  func Convex-Family M -> Subset-Family of V means


  for N being Subset of V holds N in it iff N is convex & M c= N;
end;

definition
  let V be non empty CLSStruct, M be Subset of V;
  func conv M -> convex Subset of V equals

  meet (Convex-Family M);
end;

theorem 
  for V being non empty CLSStruct, M being Subset of V, N being convex
  Subset of V st M c= N holds conv M c= N;














begin

reserve q,r,c,c1,c2,c3 for quaternion number;
reserve x1,x2,x3,x4,y1,y2,y3,y4 for Element of REAL;

definition
  redefine func 0q -> Element of QUATERNION;
end;

definition
  redefine func 1q -> Element of QUATERNION;
end;

theorem 
  for x,y,z,w being Real holds [*x,y,z,w*] = x + y*<i> + z*<j> + w*<k>;

theorem 
  c1 + c2 + c3 = c1 + (c2 + c3);

theorem 
  c + 0q = c;

theorem 
  - [*x1,x2,x3,x4*] = [*-x1,-x2,-x3,-x4*];

theorem 
  [*x1,x2,x3,x4*] - [*y1,y2,y3,y4*] = [*x1-y1,x2-y2,x3-y3,x4-y4*];

theorem 
  c1 - c2 + c3 = c1 + c3 - c2;

theorem 
  c1 = c1 + c2 - c2;

theorem 
  c1 = c1 - c2 + c2;

theorem 
  (-x1)*c = -(x1*c);

definition let q;
  redefine func |.q.| -> Element of REAL;
end;

definition
  redefine func <i> -> Element of QUATERNION;
end;

theorem 
  r <> 0 implies |.r.| > 0;

theorem 
  0q = [*0,0,0,0*];

theorem 
  for r being quaternion number holds 0q*r = 0;

theorem 
  for r being quaternion number holds r*0q = 0;

theorem 
  c * 1q = c;

theorem 
  1q * c = c;

theorem 
  c1 * c2 * c3 = c1 * (c2 * c3);

theorem 
  c1 * (c2 + c3) = c1*c2 + c1*c3;

theorem 
  (c1 + c2) * c3 = c1*c3 + c2*c3;

theorem 
  -c = (-1q) * c;

theorem 
  (-c1) * c2 = -(c1*c2);

theorem 
  c1 * (-c2) = -(c1*c2);

theorem 
  (-c1) * (-c2) = c1*c2;

theorem 
  (c1 - c2) * c3 = c1 * c3 - c2 * c3;

theorem 
  c1 * (c2 - c3) = c1 * c2 - c1 * c3;

theorem 
  [*x1,x2,x3,x4*] *' = [*x1,-x2,-x3,-x4*];

theorem 
  c*'*' = c;

definition
  let q,r;
  func q / r means


  ex q0,q1,q2,q3,r0,r1,r2,r3 being Element of REAL st
  q = [*q0,q1,q2,q3*] & r = [*r0,r1,r2,r3*] &
  it = [* (r0*q0+r1*q1+r2*q2+r3*q3)/(|.r.|^2),
  (r0*q1-r1*q0-r2*q3+r3*q2)/(|.r.|^2),
  (r0*q2+r1*q3-r2*q0-r3*q1)/(|.r.|^2),
  (r0*q3-r1*q2+r2*q1-r3*q0)/(|.r.|^2) *];
end;

registration let q,r;
  cluster q / r -> quaternion;
end;

definition let q,r;
  redefine func q/r -> Element of QUATERNION;
end;

theorem 
  q / r =
  (Rea r * Rea q + Im1 q * Im1 r +Im2 r * Im2 q + Im3 r * Im3 q) / (|.r.|^2)+
(Rea r * Im1 q - Im1 r * Rea q -Im2 r * Im3 q + Im3 r * Im2 q) / (|.r.|^2)*<i>+
(Rea r * Im2 q + Im1 r * Im3 q -Im2 r * Rea q - Im3 r * Im1 q) / (|.r.|^2)*<j>+
(Rea r * Im3 q - Im1 r * Im2 q +Im2 r * Im1 q - Im3 r * Rea q) / (|.r.|^2)*<k>;

definition let c;
  func c" -> quaternion number equals

  1q / c;
end;

definition let r;
  redefine func r" -> Element of QUATERNION;
end;

theorem 
  r" = Rea r / (|.r.|^2) - Im1 r / (|.r.|^2)*<i> -
  Im2 r / (|.r.|^2)*<j> - (Im3 r) / (|.r.|^2)*<k>;

theorem 
  Rea r" = (Rea r) / (|.r.|^2) & Im1 r" = - (Im1 r) / (|.r.|^2) &
  Im2 r" = - (Im2 r) / (|.r.|^2) &
  Im3 r" = - (Im3 r) / (|.r.|^2);

theorem 
  Rea (q/r) =
  (Rea r * Rea q + Im1 q * Im1 r +Im2 r * Im2 q + Im3 r * Im3 q) / (|.r.|^2)&
  Im1 (q/r) =
  (Rea r * Im1 q - Im1 r * Rea q -Im2 r * Im3 q + Im3 r * Im2 q) / (|.r.|^2)&
  Im2 (q/r) =
  (Rea r * Im2 q + Im1 r * Im3 q -Im2 r * Rea q - Im3 r * Im1 q) / (|.r.|^2)&
  Im3 (q/r) =
  (Rea r * Im3 q - Im1 r * Im2 q +Im2 r * Im1 q - Im3 r * Rea q) / (|.r.|^2);

theorem 
  r <> 0 implies r * r" = 1;

theorem 
  r <> 0 implies r" * r = 1;

theorem 
  c <> 0q implies c/c = 1q;

theorem 
  (-c)" = -(c");

definition
  func compquaternion -> UnOp of QUATERNION means

  for c being Element of QUATERNION holds it.c = -c;
  func addquaternion -> BinOp of QUATERNION means


  for c1,c2 being Element of QUATERNION holds it.(c1,c2) = c1 + c2;
  func diffquaternion -> BinOp of QUATERNION means

  for c1,c2 being Element of QUATERNION holds it.(c1,c2) = c1 - c2;
  func multquaternion -> BinOp of QUATERNION means


  for c1,c2 being Element of QUATERNION holds it.(c1,c2) = c1 * c2;
  func divquaternion -> BinOp of QUATERNION means

  for c1,c2 being Element of QUATERNION holds it.(c1,c2) = c1 / c2;
  func invquaternion -> UnOp of QUATERNION means

  for c being Element of QUATERNION holds it.c = c";
end;

definition
  func G_Quaternion -> strict addLoopStr means


  the carrier of it = QUATERNION & the addF of it = addquaternion & 0.it = 0q;
end;

registration
  cluster G_Quaternion -> non empty;
end;

registration
  cluster -> quaternion for Element of G_Quaternion;
end;

registration
  let x,y be Element of G_Quaternion;
  let a,b be quaternion number;
  identify x+y with a+b when x=a, y=b;
end;

theorem 
  0.G_Quaternion = 0q;

registration
  cluster G_Quaternion -> Abelian add-associative right_zeroed
    right_complementable;
end;

registration
  let x be Element of G_Quaternion, a be quaternion number;
  identify -x with -a when x = a;
end;

registration
  let x,y be Element of G_Quaternion;
  let a,b be quaternion number;
  identify x-y with a-b when x=a, y=b;
end;

theorem 
  for x,y,z being Element of G_Quaternion holds x+y = y+x & (x+y)+z = x+(y+z) &
  x+(0.G_Quaternion) = x;

definition
  func R_Quaternion -> strict doubleLoopStr means


  the carrier of it = QUATERNION & the addF of it = addquaternion &
  the multF of it = multquaternion &
  1.it = 1q &
  0.it = 0q;
end;

registration
  cluster R_Quaternion -> non empty;
end;

registration
  cluster -> quaternion for Element of R_Quaternion;
end;

registration
  let a,b be quaternion number;
  let x,y be Element of R_Quaternion;
  identify x+y with a+b when x=a, y=b;
  identify x*y with a*b when x=a, y=b;
end;

registration
  cluster R_Quaternion -> well-unital;
end;

theorem 
  1.R_Quaternion = 1q;

theorem 
  1_R_Quaternion = 1q;

theorem 
  0.R_Quaternion = 0q;

registration
  cluster R_Quaternion -> add-associative right_zeroed right_complementable
    Abelian associative left_unital right_unital distributive
    almost_right_invertible non degenerated;
end;

registration
  let x be Element of R_Quaternion, a be quaternion number;
  identify -x with -a when x = a;
end;

registration
  let x,y be Element of R_Quaternion;
  let a,b be quaternion number;
  identify x-y with a-b when x=a, y=b;
end;

definition
  let z be Element of R_Quaternion;
  redefine func z *' -> Element of R_Quaternion;
end;

reserve z for Element of R_Quaternion;

theorem 
  -z = (-1_R_Quaternion) * z;

theorem 
  (0.R_Quaternion)*' = 0.R_Quaternion;

theorem 
  z*' = 0.R_Quaternion implies z = 0.R_Quaternion;

theorem 
  (1.R_Quaternion)*' = 1.R_Quaternion;

theorem 
  |.0.R_Quaternion.| = 0;

theorem 
  |.z.| = 0 implies z = 0.R_Quaternion;

theorem 
  |.1.R_Quaternion.| = 1;

theorem 
  (1.R_Quaternion)" = 1.R_Quaternion;

definition 
  let x, y be quaternion number;
  func x .|. y -> Element of QUATERNION equals

  x*(y*');
end;

theorem 
  c1 .|. c2 =
  [*(Rea c1)*(Rea c2)+(Im1 c1)*(Im1 c2)+(Im2 c1)*(Im2 c2)+(Im3 c1)*(Im3 c2),
  (Rea c1)*(-(Im1 c2))+(Im1 c1)*(Rea c2)-(Im2 c1)*(Im3 c2)+(Im3 c1)*(Im2 c2),
  (Rea c1)*(-(Im2 c2))+(Rea c2)*(Im2 c1)-(Im1 c2)*(Im3 c1)+(Im3 c2)*(Im1 c1),
  (Rea c1)*(-(Im3 c2))+(Im3 c1)*(Rea c2)-(Im1 c1)*(Im2 c2)+(Im2 c1)*(Im1 c2) *]
;

theorem 
  c .|. c = |.c.|^2;

theorem 
  Rea (c .|. c) = |.c.|^2 & Im1 (c .|. c) = 0 &
  Im2 (c .|. c) = 0 & Im2 (c .|. c) = 0;

theorem 
  |. c1.|.c2 .| = |.c1.|*|.c2.|;

theorem 
  c.|.c = 0 implies c = 0;

theorem 
  (c1+c2).|.c3 = c1.|.c3 + c2.|.c3;

theorem 
  c1.|.(c2+c3) = c1.|.c2 + c1.|.c3;

theorem 
  (-c1).|.c2 = - c1.|.c2;

theorem 
  - c1.|.c2 = c1.|.(-c2);

theorem 
  (-c1).|.(-c2) = c1.|.c2;

theorem 
  (c1 - c2).|.c3 = c1.|.c3 - c2.|.c3;

theorem 
  c1.|.(c2 - c3) = c1.|.c2 - c1.|.c3;

theorem 
  (c1 + c2).|.(c1 + c2) = c1.|.c1 + c1.|.c2 + c2.|.c1 + c2.|.c2;

theorem 
  (c1 - c2).|.(c1 - c2) = c1.|.c1 - c1.|.c2 - c2.|.c1 + c2.|.c2;














begin 

theorem 
  for x,y,z,a,b,c being set st a <> b & b <> c & c <> a ex f being
  Function st f.a = x & f.b = y & f.c = z;

definition
  let F be non empty functional set;
  let x be set;
  let f be set;
  func F\(x,f) -> Subset of F equals

  {g where g is Element of F: g.x <> f};
end;

theorem 
  for F being non empty functional set, x,y be set, g being Element
  of F holds g in F\(x,y) iff g.x <> y;

definition
  let X be set;
  let Y,Z be set;
  let f be Function of [:Funcs(X,INT),Y:],Z;
  mode Variable of f -> Element of X means


    not contradiction;
end;

notation
  let f be real-valued Function;
  let x be real number;
  synonym f*x for x(#)f;
end;

definition
  let t1,t2 be INT-valued Function;
  func t1 div t2 -> INT-valued Function means


  dom it = (dom t1) /\ (dom t2) &
  for s being set st s in dom it holds it.s = (t1.s) div (t2.s);
  func t1 mod t2 -> INT-valued Function means


  dom it = (dom t1) /\ (dom t2) &
  for s being set st s in dom it holds it.s = (t1.s) mod (t2.s);
  func leq(t1,t2) -> INT-valued Function means


  dom it = (dom t1) /\ (dom t2) &
  for s being set st s in dom it holds it.s = IFGT(t1.s,t2.s,0,1);
  func gt(t1,t2) -> INT-valued Function means


  dom it = (dom t1) /\ (dom t2) &
  for s being set st s in dom it holds it.s = IFGT(t1.s,t2.s,1,0);
  func eq(t1,t2) -> INT-valued Function means


  dom it = (dom t1) /\ (dom t2) &
  for s being set st s in dom it holds it.s = IFEQ(t1.s,t2.s,1,0);
end;

definition
  let X be non empty set;
  let f be Function of X, INT;
  let x be integer number;
  redefine func f+x -> Function of X, INT means


  for s being Element of X holds it.s = f.s+x;
  redefine func f-x -> Function of X, INT means

  for s being Element of X holds it.s = f .s-x;
  redefine func f*x -> Function of X, INT means


  for s being Element of X holds it.s = f.s*x;
end;

definition
  let X be set;
  let f,g be Function of X, INT;
  redefine func f div g -> Function of X, INT;
  redefine func f mod g -> Function of X, INT;
  redefine func leq(f,g) -> Function of X, INT;
  redefine func gt(f,g) -> Function of X, INT;
  redefine func eq(f,g) -> Function of X, INT;
end;

definition
  let X be non empty set;
  let t1,t2 be Function of X, INT;
  redefine func t1-t2 -> Function of X, INT means


  for s being Element of X holds it.s = (t1.s)-(t2.s);
  redefine func t1+t2 -> Function of X, INT means

  for s being Element of X holds it.s = (t1.s)+(t2.s);
end;

registration
  let A be non empty set;
  let B be infinite set;
  cluster Funcs(A, B) -> infinite;
end;

definition
  let N be set;
  let v be Function;
  let f be Function;
  func v**(f,N) -> Function means


  (ex Y being set st (for y being set
holds y in Y iff ex h being Function st h in dom v & y in rng h) & for a being
set holds a in dom it iff a in Funcs(N,Y) & ex g being Function st a = g & g*f
  in dom v) & for g being Function st g in dom it holds it.g = v.(g*f);
end;

definition
  let X,Y,Z,N be non empty set;
  let v be Element of Funcs(Funcs(X,Y), Z);
  let f be Function of X,N;
  redefine func v**(f,N) -> Element of Funcs(Funcs(N,Y),Z);
end;

theorem 
  for f1,f2,g being Function st rng g c= dom f2 holds (f1+*f2)*g = f2*g;

theorem 
  for X,N,I being non empty set for s being Function of X,I for c
being Function of X,N st c is one-to-one for n being Element of I holds (N-->n)
  +*(s*c") is Function of N,I;

theorem 
  for N,X,I being non empty set for v1,v2 being Function st dom v1
= dom v2 & dom v1 = Funcs(X,I) for f being Function of X, N st f is one-to-one
  & v1**(f,N) = v2**(f,N) holds v1 = v2;

registration
  let X be set;
  cluster one-to-one onto for Function of X, card X;
  cluster one-to-one onto for Function of card X, X;
end;

definition
  let X be set;
  mode Enumeration of X is one-to-one onto Function of X, card X;
  mode Denumeration of X is one-to-one onto Function of card X, X;
end;

theorem 
  for X being set, f being Function holds f is Enumeration of X iff
  dom f = X & rng f = card X & f is one-to-one;

theorem 
  for X being set, f being Function holds f is Denumeration of X
  iff dom f = card X & rng f = X & f is one-to-one;

theorem 
  for X being non empty set, x,y being Element of X for f being
  Enumeration of X holds f+*(x,f.y)+*(y,f.x) is Enumeration of X;

theorem 
  for X being non empty set, x being Element of X ex f being Enumeration
  of X st f.x = 0;

theorem 
  for X being non empty set, f being Denumeration of X holds f.0 in X;

theorem 
  for X being countable set, f being Enumeration of X holds rng f c= NAT;

definition
  let X be set;
  let f be Enumeration of X;
  redefine func f" -> Denumeration of X;
end;

definition
  let X be set;
  let f be Denumeration of X;
  redefine func f" -> Enumeration of X;
end;

theorem 
  for n,m being Nat holds 0 to_power (n+m) = (0 to_power n)*(0 to_power m);

theorem 
  for x being real number for n,m being Nat holds (x to_power n)
  to_power m = x to_power (n*m);

begin 

definition
  let X be non empty set;
  mode INT-Variable of X is Function of Funcs(X, INT), X;
  mode INT-Expression of X is Function of Funcs(X, INT), INT;
  mode INT-Array of X is Function of INT, X;
end;

reserve A for preIfWhileAlgebra;

definition
  let A;
  let I be Element of A;
  let X be non empty set;
  let T be Subset of Funcs(X, INT);
  let f be ExecutionFunction of A, Funcs(X, INT), T;
  pred I is_assignment_wrt A,X,f means


  I in ElementaryInstructions A &
  ex v being INT-Variable of X, t being INT-Expression of X st for s being
  Element of Funcs(X, INT) holds f.(s, I) = s+*(v.s,t.s);
end;

definition
  let A;
  let X be non empty set;
  let T be Subset of Funcs(X, INT);
  let f be ExecutionFunction of A, Funcs(X, INT), T;
  let v be INT-Variable of X;
  let t be INT-Expression of X;
  pred v,t form_assignment_wrt f means


  ex I being Element of A st I in
ElementaryInstructions A & for s being Element of Funcs(X, INT) holds f.(s, I)
  = s+*(v.s,t.s);
end;

definition
  let A;
  let X be non empty set;
  let T be Subset of Funcs(X, INT);
  let f be ExecutionFunction of A, Funcs(X, INT), T such that
 ex I being Element of A st I is_assignment_wrt A,X,f;
  mode INT-Variable of A,f -> INT-Variable of X means

    ex t being INT-Expression of X st it,t form_assignment_wrt f;
end;

definition
  let A;
  let X be non empty set;
  let T be Subset of Funcs(X, INT);
  let f be ExecutionFunction of A, Funcs(X, INT), T such that
 ex I being Element of A st I is_assignment_wrt A,X,f;
  mode INT-Expression of A,f -> INT-Expression of X means

    ex v being INT-Variable of X st v,it form_assignment_wrt f;
end;

definition
  let X,Y be non empty set;
  let f be Element of Funcs(X,Y);
  let x be Element of X;
  redefine func f.x -> Element of Y;
end;

definition
  let X be non empty set;
  let x be Element of X;
  func .x -> INT-Expression of X means


  for s being Element of Funcs(X, INT) holds it.s = s.x;
end;

definition
  let X be non empty set;
  let v be INT-Variable of X;
  func .v -> INT-Expression of X means


  for s being Element of Funcs(X, INT) holds it.s = s.(v.s);
end;

definition
  let X be non empty set;
  let x be Element of X;
  func ^x -> INT-Variable of X equals

  Funcs(X, INT) --> x;
end;

theorem 
  for X being non empty set for x being Element of X holds .x = .(^x);

definition
  let X be non empty set;
  let i be integer number;
  func .(i,X) -> INT-Expression of X equals

  Funcs(X, INT) --> i;
end;

theorem 
  for X being non empty set, t being INT-Expression of X holds t+ .(0,X)
  = t & t(#).(1,X) = t;





definition
  let A;
  let X be non empty set;
  let T be Subset of Funcs(X, INT);
  let f be ExecutionFunction of A, Funcs(X, INT), T;
  attr f is Euclidean means


  (for v being INT-Variable of A,f, t being
  INT-Expression of A,f holds v,t form_assignment_wrt f) & (for i being integer
number holds .(i,X) is INT-Expression of A,f) & (for v being INT-Variable of A,
  f holds .v is INT-Expression of A,f) & (for x being Element of X holds ^x is
  INT-Variable of A,f) & (ex a being INT-Array of X st a|card X is one-to-one &
  for t being INT-Expression of A,f holds a*t is INT-Variable of A,f) & (for t
  being INT-Expression of A,f holds -t is INT-Expression of A,f) & for t1,t2
  being INT-Expression of A,f holds t1(#)t2 is INT-Expression of A,f & t1+t2 is
  INT-Expression of A,f & t1 div t2 is INT-Expression of A,f & t1 mod t2 is
  INT-Expression of A,f & leq(t1,t2) is INT-Expression of A,f & gt(t1,t2) is
  INT-Expression of A,f;
end;










definition
  let A;
  attr A is Euclidean means


  for X being non empty countable set, T
being Subset of Funcs(X, INT) ex f being ExecutionFunction of A, Funcs(X, INT),
  T st f is Euclidean;
end;

definition
  func INT-ElemIns -> infinite disjoint_with_NAT set equals

  [:Funcs(Funcs(NAT, INT), NAT), Funcs(Funcs(NAT, INT), INT):];
end;

definition
  mode INT-Exec -> ExecutionFunction of FreeUnivAlgNSG(ECIW-signature,
    INT-ElemIns), Funcs(NAT, INT), Funcs(NAT,INT)\(0,0) means


    for s being
Element of Funcs(NAT, INT) for v being Element of Funcs(Funcs(NAT, INT), NAT)
for e being Element of Funcs(Funcs(NAT, INT), INT) holds it.(s, root-tree [v,e]
    ) = s+*(v.s,e.s);
end;

definition
  let X be non empty set;
  func INT-ElemIns X -> infinite disjoint_with_NAT set equals

  [:Funcs(Funcs(X,
  INT), X), Funcs(Funcs(X, INT), INT):];
end;

definition
  let X be non empty set;
  let x be Element of X;
  mode INT-Exec of x -> ExecutionFunction of FreeUnivAlgNSG(ECIW-signature,
    INT-ElemIns X), Funcs(X, INT), Funcs(X,INT)\(x,0) means

    for s being Element of
    Funcs(X, INT) for v being Element of Funcs(Funcs(X, INT), X) for e being
Element of Funcs(Funcs(X, INT), INT) holds it.(s, root-tree [v,e]) = s+*(v.s,e.
    s);
end;

definition
  let X be non empty set;
  let T be Subset of Funcs(X, INT);
  let c be Enumeration of X such that
 rng c c= NAT;
  mode INT-Exec of c,T -> ExecutionFunction of FreeUnivAlgNSG(ECIW-signature,
    INT-ElemIns), Funcs(X, INT), T means


    for s being Element of Funcs(X,
    INT) for v being Element of Funcs(Funcs(X, INT), X) for e being Element of
Funcs(Funcs(X, INT), INT) holds it.(s, root-tree [(c*v)**(c,NAT),e**(c,NAT)]) =
    s+*(v.s,e.s);
end;

theorem 
  for f being INT-Exec for v being INT-Variable of NAT for t being
  INT-Expression of NAT holds v,t form_assignment_wrt f;

theorem 
  for f being INT-Exec for v being INT-Variable of NAT holds v is
  INT-Variable of FreeUnivAlgNSG(ECIW-signature, INT-ElemIns), f;

theorem 
  for f being INT-Exec for t being INT-Expression of NAT holds t
  is INT-Expression of FreeUnivAlgNSG(ECIW-signature, INT-ElemIns), f;

registration
  cluster -> Euclidean for INT-Exec;
end;

theorem 
  for X being non empty countable set for T being Subset of Funcs(
  X, INT) for c being Enumeration of X for f being INT-Exec of c,T for v being
INT-Variable of X for t being INT-Expression of X holds v,t form_assignment_wrt
  f;

theorem 
  for X being non empty countable set for T being Subset of Funcs(
  X, INT) for c being Enumeration of X for f being INT-Exec of c,T for v being
  INT-Variable of X holds v is INT-Variable of FreeUnivAlgNSG(ECIW-signature,
  INT-ElemIns), f;

theorem 
  for X being non empty countable set for T being Subset of Funcs(
  X, INT) for c being Enumeration of X for f being INT-Exec of c,T for t being
INT-Expression of X holds t is INT-Expression of FreeUnivAlgNSG(ECIW-signature,
  INT-ElemIns), f;

registration
  let X be countable non empty set;
  let T be Subset of Funcs(X, INT);
  let c be Enumeration of X;
  cluster -> Euclidean for INT-Exec of c,T;
end;

registration
  cluster FreeUnivAlgNSG(ECIW-signature, INT-ElemIns) -> Euclidean;
end;

registration
  cluster Euclidean non degenerated for preIfWhileAlgebra;
end;

registration
  let A be Euclidean preIfWhileAlgebra;
  let X be non empty countable set;
  let T be Subset of Funcs(X, INT);
  cluster Euclidean for ExecutionFunction of A, Funcs(X, INT), T;
end;



reserve A for Euclidean preIfWhileAlgebra;
reserve X for non empty countable set;
reserve T for Subset of Funcs(X, INT);
reserve f for Euclidean ExecutionFunction of A, Funcs(X, INT), T;

definition
  let A,X,T,f;
  let t be INT-Expression of A,f;
  redefine func -t -> INT-Expression of A,f;
end;

definition
  let A,X,T,f;
  let t be INT-Expression of A,f;
  let i be integer number;
  redefine func t+i -> INT-Expression of A,f;
  redefine func t-i -> INT-Expression of A,f;
  redefine func t*i -> INT-Expression of A,f;
end;

definition
  let A,X,T,f;
  let t1,t2 be INT-Expression of A,f;
  redefine func t1-t2 -> INT-Expression of A,f;
  redefine func t1+t2 -> INT-Expression of A,f;
  redefine func t1(#)t2 -> INT-Expression of A,f;
end;

definition
  let A,X,T,f;
  let t1,t2 be INT-Expression of A,f;
  redefine func t1 div t2 -> INT-Expression of A,f means


  for s being Element of Funcs(X, INT) holds it.s = t1.s div t2.s;
  redefine func t1 mod t2 -> INT-Expression of A,f means


  for s being Element of Funcs(X, INT) holds it.s = t1.s mod t2.s;
  redefine func leq(t1,t2) -> INT-Expression of A,f means


  for s being Element of Funcs(X, INT) holds it.s = IFGT(t1.s,t2.s,0,1);
  redefine func gt(t1,t2) -> INT-Expression of A,f means


  for s being Element of Funcs(X, INT) holds it.s = IFGT(t1.s,t2.s,1,0);
end;

definition
  let A,X,T,f;
  let t1,t2 be INT-Expression of A,f;
  redefine func eq(t1,t2) -> INT-Expression of A,f means

  for s being Element of Funcs(X , INT) holds it.s = IFEQ(t1.s,t2.s,1,0);
end;

definition
  let A,X,T,f;
  let v be INT-Variable of A,f;
  func .v -> INT-Expression of A,f equals

  .v;
end;

definition
  let A,X,T,f;
  let x be Element of X;
  func x^(A,f) -> INT-Variable of A,f equals

  ^x;
end;

notation
  let A,X,T,f;
  let x be Variable of f;
  synonym ^x for x^(A,f);
end;

definition
  let A,X,T,f;
  let x be Variable of f;
  func .x -> INT-Expression of A,f equals

  .(^x);
end;

theorem 
  for x being Variable of f for s being Element of Funcs(X, INT)
  holds (.x).s = s.x;

definition
  let A,X,T,f;
  let i be integer number;
  func .(i,A,f) -> INT-Expression of A,f equals

  .(i,X);
end;

definition 
  let A,X,T,f;
  let v be INT-Variable of A,f;
  let t be INT-Expression of A,f;
  func v:=t -> Element of A equals

  choose {I where I is Element of A: I in
ElementaryInstructions A & for s being Element of Funcs(X, INT) holds f.(s,I) =
  s+*(v.s,t.s)};
end;

theorem 
  for v being INT-Variable of A,f for t being INT-Expression of A,
  f holds v:=t in ElementaryInstructions A;

registration
  let A,X,T,f;
  let v be INT-Variable of A,f;
  let t be INT-Expression of A,f;
  cluster v:=t -> absolutely-terminating;
end;

definition
  let A,X,T,f;
  let v be INT-Variable of A,f;
  let t be INT-Expression of A,f;
  func v+=t -> absolutely-terminating Element of A equals

  v:=(.v+t);
  func v*=t -> absolutely-terminating Element of A equals

  v:=(.v(#)t);
end;

definition
  let A,X,T,f;
  let x be Element of X;
  let t be INT-Expression of A,f;
  func x:=t -> absolutely-terminating Element of A equals

  x^(A,f):=t;
end;

definition
  let A,X,T,f;
  let x be Element of X;
  let y be Variable of f;
  func x:=y -> absolutely-terminating Element of A equals

  x:=.y;
end;

definition
  let A,X,T,f;
  let x be Element of X;
  let v be INT-Variable of A,f;
  func x:=v -> absolutely-terminating Element of A equals

  x:=.v;
end;

definition
  let A,X,T,f;
  let v,w be INT-Variable of A,f;
  func v:=w -> absolutely-terminating Element of A equals

  v:=.w;
end;

definition
  let A,X,T,f;
  let x be Variable of f;
  let i be integer number;
  func x:=i -> absolutely-terminating Element of A equals

  x:=.(i,A,f);
end;

definition
  let A,X,T,f;
  let v1,v2 be INT-Variable of A,f;
  let x be Variable of f;
  func swap(v1,x,v2) -> absolutely-terminating Element of A equals

  x:=v1\;v1:=
  v2\;v2:=.x;
end;

definition
  let A,X,T,f;
  let x be Variable of f;
  let t be INT-Expression of A,f;
  func x+=t -> absolutely-terminating Element of A equals

  x:=(.x+t);
  func x*=t -> absolutely-terminating Element of A equals

  x:=(.x(#)t);
  func x%=t -> absolutely-terminating Element of A equals

  x:=(.x mod t);
  func x/=t -> absolutely-terminating Element of A equals

  x:=(.x div t);
end;

definition
  let A,X,T,f;
  let x be Variable of f;
  let i be integer number;
  func x+=i -> absolutely-terminating Element of A equals

  x:=(.x+i);
  func x*=i -> absolutely-terminating Element of A equals

  x:=(.x*i);
  func x%=i -> absolutely-terminating Element of A equals

  x:=(.x mod .(i,A,f));
  func x/=i -> absolutely-terminating Element of A equals

  x:=(.x div .(i,A,f));
  func x div i -> INT-Expression of A,f equals

  .x div .(i,A,f);
end;

definition
  let A,X,T,f;
  let v be INT-Variable of A,f;
  let i be integer number;
  func v:=i -> absolutely-terminating Element of A equals

  v:=.(i,A,f);
end;

definition
  let A,X,T,f;
  let v be INT-Variable of A,f;
  let i be integer number;
  func v+=i -> absolutely-terminating Element of A equals

  v:=(.v+i);
  func v*=i -> absolutely-terminating Element of A equals

  v:=(.v*i);
end;

definition
  let A,X;
  let b be Element of X;
  let g be Euclidean ExecutionFunction of A, Funcs(X,INT), Funcs(X, INT)\(b,0);
  let t1 be INT-Expression of A,g;
  func t1 is_odd -> absolutely-terminating Element of A equals

  b:=(t1 mod .(2,
  A,g));
  func t1 is_even -> absolutely-terminating Element of A equals

  b:=((t1+1) mod
  .(2,A,g));
  let t2 be INT-Expression of A,g;
  func t1 leq t2 -> absolutely-terminating Element of A equals

  b:=leq(t1,t2);
  func t1 gt t2 -> absolutely-terminating Element of A equals

  b:=gt(t1,t2);
  func t1 eq t2 -> absolutely-terminating Element of A equals

  b:=eq(t1,t2);
end;

notation
  let A,X;
  let b be Element of X;
  let g be Euclidean ExecutionFunction of A, Funcs(X,INT), Funcs(X, INT)\(b,0);
  let t1,t2 be INT-Expression of A,g;
  synonym t2 geq t1 for t1 leq t2;
  synonym t2 lt t1 for t1 gt t2;
end;

definition
  let A,X;
  let b be Element of X;
  let g be Euclidean ExecutionFunction of A, Funcs(X,INT), Funcs(X, INT)\(b,0);
  let v1,v2 be INT-Variable of A,g;
  func v1 leq v2 -> absolutely-terminating Element of A equals

  .v1 leq .v2;
  func v1 gt v2 -> absolutely-terminating Element of A equals

  .v1 gt .v2;
end;

notation
  let A,X;
  let b be Element of X;
  let g be Euclidean ExecutionFunction of A, Funcs(X,INT), Funcs(X, INT)\(b,0);
  let v1,v2 be INT-Variable of A,g;
  synonym v2 geq v1 for v1 leq v2;
  synonym v2 lt v1 for v1 gt v2;
end;

definition
  let A,X;
  let b be Element of X;
  let g be Euclidean ExecutionFunction of A, Funcs(X,INT), Funcs(X, INT)\(b,0);
  let x1 be Variable of g;
  func x1 is_odd -> absolutely-terminating Element of A equals

  .x1 is_odd;
  func x1 is_even -> absolutely-terminating Element of A equals

  .x1 is_even;
  let x2 be Variable of g;
  func x1 leq x2 -> absolutely-terminating Element of A equals

  .x1 leq .x2;
  func x1 gt x2 -> absolutely-terminating Element of A equals

  .x1 gt .x2;
end;

notation
  let A,X;
  let b be Element of X;
  let g be Euclidean ExecutionFunction of A, Funcs(X,INT), Funcs(X, INT)\(b,0);
  let x1,x2 be Variable of g;
  synonym x2 geq x1 for x1 leq x2;
  synonym x2 lt x1 for x1 gt x2;
end;

definition
  let A,X;
  let b be Element of X;
  let g be Euclidean ExecutionFunction of A, Funcs(X,INT), Funcs(X, INT)\(b,0);
  let x be Variable of g;
  let i be integer number;
  func x leq i -> absolutely-terminating Element of A equals

  .x leq .(i,A,g);
  func x geq i -> absolutely-terminating Element of A equals

  .x geq .(i,A,g);
  func x gt i -> absolutely-terminating Element of A equals

  .x gt .(i,A,g);
  func x lt i -> absolutely-terminating Element of A equals

  .x lt .(i,A,g);
  func x / i -> INT-Expression of A,g equals

  (.x) div .(i,A,g);
end;

definition
  let A,X,T,f;
  let x1,x2 be Variable of f;
  func x1+=x2 -> absolutely-terminating Element of A equals

  x1+=.x2;
  func x1*=x2 -> absolutely-terminating Element of A equals

  x1*=.x2;
  func x1%=x2 -> absolutely-terminating Element of A equals

  x1:=(.x1 mod .x2);
  func x1/=x2 -> absolutely-terminating Element of A equals

  x1:=(.x1 div .x2);
  func x1+x2 -> INT-Expression of A,f equals

  (.x1)+(.x2);
  func x1*x2 -> INT-Expression of A,f equals

  (.x1)(#)(.x2);
  func x1 mod x2 -> INT-Expression of A,f equals

  (.x1)mod(.x2);
  func x1 div x2 -> INT-Expression of A,f equals

  (.x1)div(.x2);
end;

reserve A for Euclidean preIfWhileAlgebra,
  X for non empty countable set,
   z for (Element of X),
  s,s9 for (Element of Funcs(X, INT)),
  T for Subset of Funcs(X, INT),
  f for Euclidean ExecutionFunction of A, Funcs(X, INT), T,
  v for INT-Variable of A,f,
  t for INT-Expression of A,f;
reserve i for integer number;

theorem 
  f.(s, v:=t).(v.s) = t.s & for z st z <> v.s holds f.(s, v:=t).z = s.z;

theorem 
  for x being Variable of f for i being integer number holds f.(s,
  x:=i).x = i & for z st z <> x holds f.(s, x:=i).z = s.z;

theorem 
  for x being Variable of f for t being INT-Expression of A,f
  holds f.(s, x:=t).x = t.s & for z st z <> x holds f.(s, x:=t).z = s.z;

theorem 
  for x,y being Variable of f holds f.(s, x:=y).x = s.y & for z st
  z <> x holds f.(s, x:=y).z = s.z;

theorem 
  for x being Variable of f holds f.(s, x+=i).x = s.x+i & for z st
  z <> x holds f.(s, x+=i).z = s.z;

theorem 
  for x being Variable of f for t being INT-Expression of A,f
  holds f.(s, x+=t).x = s.x+t.s & for z st z <> x holds f.(s, x+=t).z = s.z;

theorem 
  for x,y being Variable of f holds f.(s, x+=y).x = s.x+s.y & for
  z st z <> x holds f.(s, x+=y).z = s.z;

theorem 
  for x being Variable of f holds f.(s, x*=i).x = s.x*i & for z st
  z <> x holds f.(s, x*=i).z = s.z;

theorem 
  for x being Variable of f for t being INT-Expression of A,f
  holds f.(s, x*=t).x = s.x*t.s & for z st z <> x holds f.(s, x*=t).z = s.z;

theorem 
  for x,y being Variable of f holds f.(s, x*=y).x = s.x*s.y & for
  z st z <> x holds f.(s, x*=y).z = s.z;

theorem 
  for b being Element of X for g being Euclidean ExecutionFunction
  of A,Funcs(X,INT), Funcs(X,INT)\(b,0) for x being Variable of g holds for i
  being integer number holds (s.x <= i implies g.(s, x leq i).b = 1) & (s.x > i
implies g.(s, x leq i).b = 0) & (s.x >= i implies g.(s, x geq i).b = 1) & (s.x
< i implies g.(s, x geq i).b = 0) & for z st z <> b holds g.(s, x leq i).z = s.
  z & g.(s, x geq i).z = s.z;

theorem 
  for b being Element of X for g being Euclidean ExecutionFunction
of A,Funcs(X,INT), Funcs(X,INT)\(b,0) for x,y being Variable of g holds (s.x <=
s.y implies g.(s, x leq y).b = 1) & (s.x > s.y implies g.(s, x leq y).b = 0) &
  for z st z <> b holds g.(s, x leq y).z = s.z;

theorem 
  for b being Element of X for g being Euclidean ExecutionFunction of A,
Funcs(X,INT), Funcs(X,INT)\(b,0) for x being Variable of g for i being integer
  number holds (s.x <= i iff g.(s, x leq i) in Funcs(X,INT)\(b,0)) & (s.x >= i
  iff g.(s, x geq i) in Funcs(X,INT)\(b,0));

theorem 
  for b being Element of X for g being Euclidean ExecutionFunction of A,
Funcs(X,INT), Funcs(X,INT)\(b,0) for x,y being Variable of g holds (s.x <= s.y
  iff g.(s, x leq y) in Funcs(X,INT)\(b,0)) & (s.x >= s.y iff g.(s, x geq y) in
  Funcs(X,INT)\(b,0));

theorem 
  for b being Element of X for g being Euclidean ExecutionFunction
  of A,Funcs(X,INT), Funcs(X,INT)\(b,0) for x being Variable of g for i being
integer number holds (s.x > i implies g.(s, x gt i).b = 1) & (s.x <= i implies
  g.(s, x gt i).b = 0) & (s.x < i implies g.(s, x lt i).b = 1) & (s.x >= i
implies g.(s, x lt i).b = 0) & for z st z <> b holds g.(s, x gt i).z = s.z & g.
  (s, x lt i).z = s.z;

theorem 
  for b being Element of X for g being Euclidean ExecutionFunction
of A,Funcs(X,INT), Funcs(X,INT)\(b,0) for x,y being Variable of g holds (s.x >
s.y implies g.(s, x gt y).b = 1) & (s.x <= s.y implies g.(s, x gt y).b = 0) & (
s.x < s.y implies g.(s, x lt y).b = 1) & (s.x >= s.y implies g.(s, x lt y).b =
  0) & for z st z <> b holds g.(s, x gt y).z = s.z & g.(s, x lt y).z = s.z;

theorem 
  for b being Element of X for g being Euclidean ExecutionFunction
  of A,Funcs(X,INT), Funcs(X,INT)\(b,0) for x being Variable of g for i being
integer number holds (s.x > i iff g.(s, x gt i) in Funcs(X,INT)\(b,0)) & (s.x <
  i iff g.(s, x lt i) in Funcs(X,INT)\(b,0));

theorem 
  for b being Element of X for g being Euclidean ExecutionFunction of A,
  Funcs(X,INT), Funcs(X,INT)\(b,0) for x,y being Variable of g holds (s.x > s.y
  iff g.(s, x gt y) in Funcs(X,INT)\(b,0)) & (s.x < s.y iff g.(s, x lt y) in
  Funcs(X,INT)\(b,0));

theorem 
  for x being Variable of f holds f.(s, x%=i).x = s.x mod i & for z st z
  <> x holds f.(s, x%=i).z = s.z;

theorem 
  for x being Variable of f for t being INT-Expression of A,f
  holds f.(s, x%=t).x = s.x mod t.s & for z st z <> x holds f.(s, x%=t).z = s.z
;

theorem 
  for x,y being Variable of f holds f.(s, x%=y).x = s.x mod s.y &
  for z st z <> x holds f.(s, x%=y).z = s.z;

theorem 
  for x being Variable of f holds f.(s, x/=i).x = s.x div i & for
  z st z <> x holds f.(s, x/=i).z = s.z;

theorem 
  for x being Variable of f for t being INT-Expression of A,f
  holds f.(s, x/=t).x = s.x div t.s & for z st z <> x holds f.(s, x/=t).z = s.z
;

theorem 
  for x,y being Variable of f holds f.(s, x/=y).x = s.x div s.y & for z
  st z <> x holds f.(s, x/=y).z = s.z;

theorem 
  for b being Element of X for g being Euclidean ExecutionFunction
of A,Funcs(X,INT), Funcs(X,INT)\(b,0) for t being INT-Expression of A,g holds g
.(s, t is_odd).b = (t.s) mod 2 & g.(s, t is_even).b = (t.s+1) mod 2 & for z st
  z <> b holds g.(s, t is_odd).z = s.z & g.(s, t is_even).z = s.z;

theorem 
  for b being Element of X for g being Euclidean ExecutionFunction
  of A,Funcs(X,INT), Funcs(X,INT)\(b,0) for x being Variable of g holds g.(s, x
  is_odd).b = s.x mod 2 & g.(s, x is_even).b = (s.x+1) mod 2 & for z st z <> b
  holds g.(s, x is_odd).z = s.z;

theorem 
  for b being Element of X for g being Euclidean ExecutionFunction
of A,Funcs(X,INT), Funcs(X,INT)\(b,0) for t being INT-Expression of A,g holds (
t.s is odd iff g.(s, t is_odd) in Funcs(X,INT)\(b,0)) & (t.s is even iff g.(s,
  t is_even) in Funcs(X,INT)\(b,0));

theorem 
  for b being Element of X for g being Euclidean ExecutionFunction of A,
  Funcs(X,INT), Funcs(X,INT)\(b,0) for x being Variable of g holds (s.x is odd
iff g.(s, x is_odd) in Funcs(X,INT)\(b,0)) & (s.x is even iff g.(s, x is_even)
  in Funcs(X,INT)\(b,0));

scheme 

  ForToIteration {A() -> Euclidean preIfWhileAlgebra, X() -> countable non
empty set, b() -> (Element of X()), I,F() -> (Element of A()), g() -> Euclidean
  ExecutionFunction of A(), Funcs(X(),INT), Funcs(X(),INT)\(b(),0), i,n() -> (
Variable of g()), s() -> (Element of Funcs(X(),INT)), a() -> INT-Expression of
A(),g(), P[set] }: P[g().(s(),F())] & (a().s() <= s().n() implies g().(s(),F())
.i() = s().n()+1) & (a().s() > s().n() implies g().(s(),F()).i() = a().s()) & g
  ().(s(),F()).n() = s().n()
provided
 F() = for-do(i():=a(), i() leq n(), i()+=1, I()) and
 P[g().(s(),i():=a())] and
 for s being Element of Funcs(X(),INT) st P[s] holds P[g().(s,I()\;i(
)+=1)] & P[g().(s, i() leq n())] and
 for s being Element of Funcs(X(),INT) st P[s] holds g().(s,I()).i()
= s.i() & g().(s,I()).n() = s.n() and
 n() <> i() & n() <> b() & i() <> b();

scheme 

  ForDowntoIteration {A() -> Euclidean preIfWhileAlgebra, X() -> countable non
empty set, b() -> (Element of X()), I,F() -> (Element of A()), f() -> Euclidean
  ExecutionFunction of A(), Funcs(X(),INT), Funcs(X(),INT)\(b(),0), i,n() -> (
Variable of f()), s() -> (Element of Funcs(X(),INT)), a() -> INT-Expression of
A(),f(), P[set] }: P[f().(s(),F())] & (a().s() >= s().n() implies f().(s(),F())
.i() = s().n()-1) & (a().s() < s().n() implies f().(s(),F()).i() = a().s()) & f
  ().(s(),F()).n() = s().n()
provided
 F() = for-do(i():=a(),.n() leq .i(),i()+=-1,I()) and
 P[f().(s(),i():=a())] and
 for s being Element of Funcs(X(),INT) st P[s] holds P[f().(s,I()\;i(
)+=-1)] & P[f().(s, n() leq i())] and
 for s being Element of Funcs(X(),INT) st P[s] holds f().(s,I()).i()
= s.i() & f().(s,I()).n() = s.n() and
 n() <> i() & n() <> b() & i() <> b();

begin 

reserve b for (Element of X),
  g for Euclidean ExecutionFunction of A, Funcs(X, INT), Funcs(X, INT)\(b,0);

theorem 
  for I being Element of A for i,n being Variable of g st (ex d
being Function st d.b = 0 & d.n = 1 & d.i = 2) & for s holds g.(s,I).n = s.n &
  g.(s,I).i = s.i holds g iteration_terminates_for I\; i+=1\; i leq n, g.(s, i
  leq n);

theorem 
  for P being set for I being Element of A for i,n being Variable
of g st (ex d being Function st d.b = 0 & d.n = 1 & d.i = 2) & for s st s in P
holds g.(s,I).n = s.n & g.(s,I).i = s.i & g.(s, I) in P & g.(s, i leq n) in P &
  g.(s, i+=1) in P holds s in P implies g iteration_terminates_for I\; i+=1\; i
  leq n, g.(s, i leq n);

theorem 
  for I being Element of A st I is_terminating_wrt g for i,n being
  Variable of g st (ex d being Function st d.b = 0 & d.n = 1 & d.i = 2) & for s
  holds g.(s,I).n = s.n & g.(s,I).i = s.i holds for-do(i:=t, i leq n, i+=1, I)
  is_terminating_wrt g;

theorem 
  for P being set for I being Element of A st I is_terminating_wrt g, P
for i,n being Variable of g st (ex d being Function st d.b = 0 & d.n = 1 & d.i
  = 2) & (for s st s in P holds g.(s,I).n = s.n & g.(s,I).i = s.i) & P
is_invariant_wrt i:=t, g & P is_invariant_wrt I, g & P is_invariant_wrt i leq n
  , g & P is_invariant_wrt i+=1, g holds for-do(i:=t, i leq n, i+=1, I)
  is_terminating_wrt g, P;

begin 

definition
  let X,A,T,f,s;
  let I be Element of A;
  redefine func f.(s,I) -> Element of Funcs(X, INT);
end;

theorem 
  for n,s,i being Variable of g st ex d being Function st d.n = 1 & d.s
  = 2 & d.i = 3 & d.b = 4 holds s:=1\;for-do(i:=2, i leq n, i+=1, s*=i)
  is_terminating_wrt g;

theorem 
  for n,s,i being Variable of g st ex d being Function st d.n = 1 & d.s
  = 2 & d.i = 3 & d.b = 4 for q being Element of Funcs(X, INT) for N being
Nat st N = q.n holds g.(q, s:=1\;for-do(i:=2, i leq n, i+=1, s*=i)).
  s = N!;

theorem 
  for x,n,s,i being Variable of g st ex d being Function st d.n = 1 & d.
  s = 2 & d.i = 3 & d.b = 4 holds s:=1\;for-do(i:=1, i leq n, i+=1, s*=x)
  is_terminating_wrt g;

theorem 
  for x,n,s,i being Variable of g st ex d being Function st d.x = 0 & d.
n = 1 & d.s = 2 & d.i = 3 & d.b = 4 for q being Element of Funcs(X, INT) for N
being Nat st N = q.n holds g.(q, s:=1\;for-do(i:=1, i leq n, i+=1, s
  *=x)).s = (q.x)|^N;

theorem 
  for n,x,y,z,i being Variable of g st ex d being Function st d.b = 0 &
d.n = 1 & d.x = 2 & d.y = 3 & d.z = 4 & d.i = 5 holds x:=0\;y:=1\;for-do(i:=1,
  i leq n, i+=1, z:=x\;x:=y\;y+=z) is_terminating_wrt g;

theorem 
  for n,x,y,z,i being Variable of g st ex d being Function st d.b = 0 &
d.n = 1 & d.x = 2 & d.y = 3 & d.z = 4 & d.i = 5 for s being Element of Funcs(X,
INT) for N being Element of NAT st N = s.n holds g.(s, x:=0\;y:=1\;for-do(i:=1,
  i leq n, i+=1, z:=x\;x:=y\;y+=z)).x = Fib N;

theorem 
  for x,y,z being Variable of g st ex d being Function st d.b = 0 & d.x
  = 1 & d.y = 2 & d.z = 3 holds while(y gt 0, z:=x\;z%=y\;x:=y\;y:=z)
  is_terminating_wrt g, {s: s.x > s.y & s.y >= 0};

theorem 
  for x,y,z being Variable of g st ex d being Function st d.b = 0 & d.x
  = 1 & d.y = 2 & d.z = 3 for s being Element of Funcs(X, INT) for n,m being
Element of NAT st n = s.x & m = s.y & n > m holds g.(s, while(y gt 0, z:=x\;z%=
  y\;x:=y\;y:=z)).x = n gcd m;

theorem 
  for x,y,z being Variable of g st ex d being Function st d.b = 0 & d.x
= 1 & d.y = 2 & d.z = 3 holds while(y gt 0, z:=(.x-.y)\; if-then(z lt 0, z*=-1)
  \; x:=y\; y:=z) is_terminating_wrt g, {s: s.x >= 0 & s.y >= 0};

theorem 
  for x,y,z being Variable of g st ex d being Function st d.b = 0 & d.x
  = 1 & d.y = 2 & d.z = 3 for s being Element of Funcs(X, INT) for n,m being
Element of NAT st n = s.x & m = s.y & n > 0 holds g.(s, while(y gt 0, z:=(.x-.y
  )\; if-then(z lt 0, z*=-1)\; x:=y\; y:=z ) ).x = n gcd m;

theorem 
  for x,y,m being Variable of g st ex d being Function st d.b = 0 & d.x
= 1 & d.y = 2 & d.m = 3 holds y:=1\; while(m gt 0, if-then(m is_odd, y*=x)\; m
  /=2\; x*=x ) is_terminating_wrt g, {s: s.m >= 0};


theorem 
  for x,y,m being Variable of g st ex d being Function st d.b = 0 & d.x
= 1 & d.y = 2 & d.m = 3 for s being Element of Funcs(X, INT) for n being Nat st
n = s.m holds g.(s, y:=1\; while(m gt 0, if-then(m is_odd, y*=x)\; m/=2\; x*=x
  ) ).y = (s.x)|^n;














begin 

reserve n,m,k for Nat,
  X,Y,Z for set,
  f for Function of X,Y,
  H for Subset of X;

definition
  let X,Y,H;
  let P be a_partition of the_subsets_of_card(Y,X);
  pred H is_homogeneous_for P means


  ex p being Element of P st the_subsets_of_card(Y,H) c= p;
end;

registration
  let n;
  let X be infinite set;
  cluster the_subsets_of_card(n,X) -> non empty;
end;

definition
  let n,X,Y,f;
  assume that
 f is one-to-one and
 card n c= card X & X is non empty and
 Y is non empty;
  func f ||^ n -> Function of the_subsets_of_card(n,X), the_subsets_of_card(n,
  Y) means


  for x being Element of the_subsets_of_card(n,X) holds it.x = f .: x;
end;

theorem 
  f is one-to-one & card n c= card X & X is non empty & Y is non
empty implies the_subsets_of_card(n,f .: H) = (f||^n) .: the_subsets_of_card(n,
  H);

theorem 
  X is infinite & X c= omega implies card X = omega;

theorem 
  X is infinite implies X \/ Y is infinite;

theorem 
  X is infinite & Y is finite implies X \ Y is infinite;

registration
  let X be infinite set;
  let Y be set;
  cluster X \/ Y -> infinite;
end;

registration
  let X be infinite set;
  let Y be finite set;
  cluster X \ Y -> infinite;
end;

theorem 
  the_subsets_of_card(0,X) = {0};

theorem 
  for X being finite set st card X < n holds the_subsets_of_card(n, X) is empty
;

theorem 
  X c= Y implies the_subsets_of_card(Z,X) c= the_subsets_of_card(Z,Y);

theorem 
  X is finite & Y is finite & card Y = X implies the_subsets_of_card(X,Y
  ) = {Y};

theorem 
  X is non empty & Y is non empty implies (f is constant iff ex y being
  Element of Y st rng f = {y});

theorem 
  for X being finite set st k <= card X holds ex Y being Subset of
  X st card Y = k;

theorem 
  m>=1 implies n+1 <= (n+m) choose m;

theorem 
  m>=1 & n>=1 implies m+1 <= (n+m) choose m;

theorem 
  for X being non empty set, p1,p2 being Element of X, P being
  a_partition of X, A being Element of P st p1 in A & (proj P).p1=(proj P).p2
  holds p2 in A;

begin 

theorem 
  for F being Function of the_subsets_of_card(n,X),k st k<>0 & X
  is infinite holds ex H st H is infinite & F|the_subsets_of_card(n,H) is
  constant;




theorem 
  for X being infinite set, P being a_partition of the_subsets_of_card(n
  ,X) st card P = k holds ex H being Subset of X st H is infinite & H
  is_homogeneous_for P;

begin 

scheme 

  BinInd2 { P[Nat,Nat] } : P[m,n]
provided
 P[0,n] & P[n,0] and
 P[m+1,n] & P[m,n+1] implies P[m+1,n+1];



theorem 
  m >= 2 & n >= 2 implies ex r being Nat st r <= (m + n
  -' 2) choose (m -' 1) & r >= 2 & for X being finite set, F being Function of
the_subsets_of_card(2,X), Seg 2 st card X >= r holds ex S being Subset of X st
  card S >= m & rng(F|the_subsets_of_card(2,S)) = {1} or card S >= n & rng(F|
  the_subsets_of_card(2,S)) = {2};


theorem 
  for m being Nat holds ex r being Nat st for X
being finite set, P being a_partition of the_subsets_of_card(2,X) st card X >=
  r & card P = 2 holds ex S being Subset of X st card S >= m & S
  is_homogeneous_for P;














begin 

reserve i for Nat,
  j for Element of NAT,
  X,Y,x,y,z for set;

theorem 
  for f being Function holds f.x c= Union f;

theorem 
  for f being Function st Union f = {} holds f.x = {};

theorem 
  for f being Function for x,y being set st f = [x,y] holds x = y;

theorem 
  (id X).:Y c= Y;

theorem 
  for S being non void Signature
  for X being non-empty ManySortedSet of the carrier of S
  for t being Term of S, X
  holds t is non pair;

registration
  let S be non void Signature;
  let X be non empty-yielding ManySortedSet of the carrier of S;
  cluster -> non pair for Element of Free(S,X);
end;

theorem 
  for x,y,z being set st x in {z}* & y in {z}* & card x = card y holds x = y;

definition
  let S be non void Signature;
  let A be MSAlgebra over S;
  mode Subset of A is Subset of Union the Sorts of A;
  mode FinSequence of A is FinSequence of Union the Sorts of A;
end;

registration
  let S be non void Signature;
  let X be non empty-yielding ManySortedSet of S;
  cluster -> DTree-yielding for FinSequence of Free(S,X);
end;

theorem 
  for S being non void Signature
  for X being non empty-yielding ManySortedSet of the carrier of S
  for t being Element of Free(S,X) holds
  (ex s being SortSymbol of S, v being set st
  t = root-tree [v,s] & v in X.s) or
  ex o being OperSymbol of S,
  p being FinSequence of Free(S,X) st
  t = [o,the carrier of S]-tree p & len p = len the_arity_of o &
  p is DTree-yielding &
  p is ArgumentSeq of Sym(o, X\/((the carrier of S)-->{0}));

definition
  let A be set;
  func varcl A means


   A c= it & (for x,y st [x,y] in it holds x c= it) &
  for B being set st A c= B & for x,y st [x,y] in B holds x c= B
  holds it c= B;
  projectivity;
end;

theorem 
  varcl {} = {};

theorem 
  for A,B being set st A c= B holds varcl A c= varcl B;

theorem 
  for A being set holds
  varcl union A = union {varcl a where a is Element of A: not contradiction};

scheme 
 Sch14{A() -> set, F(set) -> set, P[set]}:
  varcl union {F(z) where z is Element of A(): P[z]}
  = union {varcl F(z) where z is Element of A(): P[z]};

theorem 
  varcl (X \/ Y) = (varcl X) \/ (varcl Y);

theorem 
  for A being non empty set st for a being Element of A holds varcl a = a
  holds varcl meet A = meet A;

theorem 
  varcl ((varcl X) /\ (varcl Y)) = (varcl X) /\ (varcl Y);

registration
  let A be empty set;
  cluster varcl A -> empty;
end;

definition
  func Vars means


   ex V being ManySortedSet of NAT st it = Union V &
  V.0 = {[{}, i] where i is Element of NAT: not contradiction} &
  for n being Nat holds V.(n+1) =
  {[varcl A, j] where A is Subset of V.n, j is Element of NAT: A is finite};
end;

theorem 
  for V being ManySortedSet of NAT st
  V.0 = {[{}, i] where i is Element of NAT: not contradiction} &
  for n being Nat holds
  V.(n+1) = {[varcl A, j] where A is Subset of V.n, j is Element of NAT:
  A is finite}
  for i,j being Element of NAT st i <= j holds V.i c= V.j;

theorem 
  for V being ManySortedSet of NAT st
  V.0 = {[{}, i] where i is Element of NAT: not contradiction} &
  for n being Nat holds
  V.(n+1) = {[varcl A, j] where A is Subset of V.n, j is Element of NAT:
  A is finite}
  for A being finite Subset of Vars
  ex i being Element of NAT st A c= V.i;

theorem 
  {[{}, i] where i is Element of NAT: not contradiction} c= Vars;

theorem 
  for A being finite Subset of Vars, i being Nat holds [varcl A, i] in Vars;

theorem 
  Vars = {[varcl A, j] where A is Subset of Vars, j is Element of NAT:
  A is finite};

theorem 
  varcl Vars = Vars;

theorem 
  for X st the_rank_of X is finite holds X is finite;

theorem 
  the_rank_of varcl X = the_rank_of X;

theorem 
  for X being finite Subset of Rank omega holds X in Rank omega;

theorem 
  Vars c= Rank omega;

theorem 
  for A being finite Subset of Vars holds varcl A is finite Subset of Vars;

registration
  cluster Vars -> non empty;
end;

definition
  mode variable is Element of Vars;
end;

registration
  let x be variable;
  cluster x`1 -> finite;
end;

notation
  let x be variable;
  synonym vars x for x`1;
end;

definition
  let x be variable;
  redefine func vars x -> Subset of Vars;
end;

theorem 
  [{}, i] in Vars;

theorem 
  for A being Subset of Vars holds
  varcl {[varcl A, j]} = (varcl A) \/ {[varcl A, j]};

theorem 
  for x being variable holds varcl {x} = (vars x) \/ {x};

theorem 
  for x being variable holds [(vars x) \/ {x}, i] in Vars;

begin 

notation
  let R be Relation, A be set;
  synonym R dom A for R|A;
end;

definition
  func QuasiLoci -> FinSequenceSet of Vars means

 for p being FinSequence of Vars holds p in it iff p is one-to-one &
  for i st i in dom p holds (p.i)`1 c= rng (p dom i);
end;

theorem 
  <*>Vars in QuasiLoci;

registration
  cluster QuasiLoci -> non empty;
end;

definition
  mode quasi-loci is Element of QuasiLoci;
end;

registration
  cluster -> one-to-one for quasi-loci;
end;

theorem 
  for l being one-to-one FinSequence of Vars holds l is quasi-loci iff
  for i being Nat, x being variable st i in dom l & x = l.i
  for y being variable st y in vars x
  ex j being Nat st j in dom l & j < i & y = l.j;

theorem 
  for l being quasi-loci, x being variable holds
  l^<*x*> is quasi-loci iff not x in rng l & vars x c= rng l;

theorem 
  for p,q being FinSequence st p^q is quasi-loci
  holds p is quasi-loci & q is FinSequence of Vars;

theorem 
  for l being quasi-loci holds varcl rng l = rng l;

theorem 
  for x being variable holds <*x*> is quasi-loci iff vars x = {};

theorem 
  for x,y being variable holds
  <*x,y*> is quasi-loci iff vars x = {} & x <> y & vars y c= {x};

theorem 
  for x,y,z being variable holds
  <*x,y,z*> is quasi-loci iff vars x = {} & x <> y & vars y c= {x} &
  x <> z & y <> z & vars z c= {x,y};

definition
  let l be quasi-loci;
  redefine func l" -> PartFunc of Vars, NAT;
end;

begin 

definition
  func a_Type equals

  0;
  func an_Adj equals

  1;
  func a_Term equals

  2;
  func * equals

  0;
  func non_op equals

  1;




end;

definition
  let C be Signature;
  attr C is constructor means


   the carrier of C = {a_Type, an_Adj, a_Term} &
  {*, non_op} c= the carrier' of C &
  (the Arity of C).* = <*an_Adj, a_Type*> &
  (the Arity of C).non_op = <*an_Adj*> &
  (the ResultSort of C).* = a_Type &
  (the ResultSort of C).non_op = an_Adj &
  for o being Element of the carrier' of C st o <> * & o <> non_op
  holds (the Arity of C).o in {a_Term}*;
end;

registration
  cluster constructor -> non empty non void for Signature;
end;

definition
  func MinConstrSign -> strict Signature means


   it is constructor & the carrier' of it = {*, non_op};
end;

registration
  cluster MinConstrSign -> constructor;
end;

registration
  cluster constructor strict for Signature;
end;

definition
  mode ConstructorSignature is constructor Signature;
end;





definition
  let C be ConstructorSignature;
  let o be OperSymbol of C;
  attr o is constructor means


   o <> * & o <> non_op;
end;

theorem 
  for S being ConstructorSignature
  for o being OperSymbol of S st o is constructor
  holds the_arity_of o = (len the_arity_of o) |-> a_Term;

definition
  let C be non empty non void Signature;
  attr C is initialized means


   ex m, a being OperSymbol of C st
  the_result_sort_of m = a_Type & the_arity_of m = {} &  
  the_result_sort_of a = an_Adj & the_arity_of a = {};   
end;

definition
  let C be ConstructorSignature;
  func a_Type C -> SortSymbol of C equals

  a_Type;
  func an_Adj C -> SortSymbol of C equals

  an_Adj;
  func a_Term C -> SortSymbol of C equals

  a_Term;
  func non_op C -> OperSymbol of C equals

  non_op;
  func ast C -> OperSymbol of C equals

  *;
end;

theorem 
  for C being ConstructorSignature holds the_arity_of non_op C = <*an_Adj C*> &
  the_result_sort_of non_op C = an_Adj C &
  the_arity_of ast C = <*an_Adj C, a_Type C*> &
  the_result_sort_of ast C = a_Type C;

definition
  func Modes equals

  [:{a_Type},[:QuasiLoci,NAT:]:];
  func Attrs equals

  [:{an_Adj},[:QuasiLoci,NAT:]:];
  func Funcs equals

  [:{a_Term},[:QuasiLoci,NAT:]:];
end;

registration
  cluster Modes -> non empty;
  cluster Attrs -> non empty;
  cluster Funcs -> non empty;
end;

definition
  func Constructors -> non empty set equals

  Modes \/ Attrs \/ Funcs;
end;

theorem 
  {*, non_op} misses Constructors;

definition
  let x be Element of [:QuasiLoci, NAT:];
  redefine func x`1 -> quasi-loci;
  redefine func x`2 -> Element of NAT;
end;

notation
  let c be Element of Constructors;
  synonym kind_of c for c`1;
end;

definition
  let c be Element of Constructors;
  redefine func kind_of c -> Element of {a_Type, an_Adj, a_Term};
  redefine func c`2 -> Element of [:QuasiLoci, NAT:];
end;

definition
  let c be Element of Constructors;
  func loci_of c -> quasi-loci equals

  c`2`1;
  func index_of c -> Nat equals

  c`2`2;
end;

theorem 
  for c being Element of Constructors holds
  (kind_of c = a_Type iff c in Modes) &
  (kind_of c = an_Adj iff c in Attrs) &
  (kind_of c = a_Term iff c in Funcs);

definition
  func MaxConstrSign -> strict ConstructorSignature means


   the carrier' of it = {*, non_op} \/ Constructors &
  for o being OperSymbol of it st o is constructor
  holds (the ResultSort of it).o = o`1 &
  card ((the Arity of it).o) = card o`2`1;
end;

registration
  cluster MinConstrSign -> non initialized;
  cluster MaxConstrSign -> initialized;
end;

registration
  cluster initialized strict for ConstructorSignature;
end;

registration
  let C be initialized ConstructorSignature;
  cluster constructor for OperSymbol of C;
end;

begin 

definition
  let C be ConstructorSignature;
  func MSVars C -> ManySortedSet of the carrier of C means


   it.a_Type = {} & it.an_Adj = {} & it.a_Term = Vars;
end;






registration
  let C be ConstructorSignature;
  cluster MSVars C -> non empty-yielding;
end;

registration
  let C be initialized ConstructorSignature;
  cluster Free(C, MSVars C) -> non-empty;
end;

definition
  let S be non void Signature;
  let X be non empty-yielding ManySortedSet of the carrier of S;
  let t be Element of Free(S,X);
  attr t is ground means

  Union (S variables_in t) = {};
  attr t is compound means


   t.{} in [:the carrier' of S, {the carrier of S}:];
end;

reserve C for initialized ConstructorSignature,
  s for SortSymbol of C,
  o for OperSymbol of C,
  c for constructor OperSymbol of C;

definition
  let C;
  mode expression of C is Element of Free(C, MSVars C);
end;

definition
  let C, s;
  mode expression of C, s -> expression of C means


     it in (the Sorts of Free(C, MSVars C)).s;
end;

theorem 
  z is expression of C, s iff z in (the Sorts of Free(C, MSVars C)).s;

definition
  let C;
  let c such that
 len the_arity_of c = 0;
  func c term -> expression of C equals

  [c, the carrier of C]-tree {};
end;

theorem 
  for o st len the_arity_of o = 1 for a being expression of C st
  ex s st s = (the_arity_of o).1 & a is expression of C, s
  holds
  [o, the carrier of C]-tree <*a*> is expression of C, the_result_sort_of o;

definition
  let C,o such that
 len the_arity_of o = 1;
  let e be expression of C such that
 ex s being SortSymbol of C st
  s = (the_arity_of o).1 & e is expression of C, s;
  func o term e -> expression of C equals


   [o, the carrier of C]-tree<*e*>;
end;

reserve a,b for expression of C, an_Adj C;

theorem 
  (non_op C)term a is expression of C, an_Adj C &
  (non_op C)term a = [non_op, the carrier of C]-tree <*a*>;

theorem 
  (non_op C)term a = (non_op C)term b implies a = b;

registration
  let C,a;
  cluster (non_op C)term a -> compound;
end;

registration
  let C;
  cluster compound for expression of C;
end;

theorem 
  for o st len the_arity_of o = 2 for a,b being expression of C st
  ex s1,s2 being SortSymbol of C st
  s1 = (the_arity_of o).1 & s2 = (the_arity_of o).2 &
  a is expression of C, s1 & b is expression of C, s2
  holds
  [o, the carrier of C]-tree <*a,b*> is expression of C, the_result_sort_of o;

definition
  let C,o such that
 len the_arity_of o = 2;
  let e1,e2 be expression of C such that
 ex s1,s2 being SortSymbol of C st
  s1 = (the_arity_of o).1 & s2 = (the_arity_of o).2 &
  e1 is expression of C, s1 & e2 is expression of C, s2;
  func o term(e1,e2) -> expression of C equals


   [o, the carrier of C]-tree<*e1,e2*>;
end;

reserve t, t1,t2 for expression of C, a_Type C;

theorem 
  (ast C)term(a,t) is expression of C, a_Type C &
  (ast C)term(a,t) = [ *, the carrier of C]-tree <*a,t*>;

theorem 
  (ast C)term(a,t1) = (ast C)term(b,t2) implies a = b & t1 = t2;

registration
  let C,a,t;
  cluster (ast C)term(a,t) -> compound;
end;

definition
  let S be non void Signature;
  let s be SortSymbol of S such that
 ex o being OperSymbol of S st the_result_sort_of o = s;
  mode OperSymbol of s -> OperSymbol of S means

    the_result_sort_of it = s;
end;

definition
  let C be ConstructorSignature;
  redefine func non_op C -> OperSymbol of an_Adj C;
  redefine func ast C -> OperSymbol of a_Type C;
end;

theorem 
  for s1,s2 being SortSymbol of C st s1 <> s2 for t1 being expression of C, s1
  for t2 being expression of C, s2
  holds t1 <> t2;

begin 

definition
  let C;
  func QuasiTerms C -> Subset of Free(C, MSVars C) equals

  (the Sorts of Free(C, MSVars C)).a_Term C;
end;

registration
  let C;
  cluster QuasiTerms C -> non empty constituted-DTrees;
end;

definition
  let C;
  mode quasi-term of C is expression of C, a_Term C;
end;

theorem 
  z is quasi-term of C iff z in QuasiTerms C;

definition
  let x be variable;
  let C;
  func x-term C -> quasi-term of C equals

  root-tree [x, a_Term];
end;

theorem 
  for x1,x2 being variable for C1,C2 being initialized ConstructorSignature
  st x1-term C1 = x2-term C2
  holds x1 = x2;

registration
  let x be variable;
  let C;
  cluster x-term C -> non compound;
end;

theorem 
  for p being DTree-yielding FinSequence holds
  [c, the carrier of C]-tree p is expression of C
  iff len p = len the_arity_of c & p in (QuasiTerms C)*;

reserve p for FinSequence of QuasiTerms C;

definition
  let C,c;
  let p such that
 len p = len the_arity_of c;
  func c-trm p -> compound expression of C equals


   [c, the carrier of C]-tree p;
end;

theorem 
  len p = len the_arity_of c implies
  c-trm p is expression of C, the_result_sort_of c;

theorem 
  for e being expression of C holds (ex x being variable st e = x-term C) or
  (ex c being constructor OperSymbol of C st
  ex p being FinSequence of QuasiTerms C st
  len p = len the_arity_of c & e = c-trm p) or
  (ex a being expression of C, an_Adj C st e = (non_op C)term a) or
  ex a being expression of C, an_Adj C st
  ex t being expression of C, a_Type C st e = (ast C)term(a,t);

theorem 
  len p = len the_arity_of c implies c-trm p <> (non_op C)term a;

theorem 
  len p = len the_arity_of c implies c-trm p <> (ast C)term(a,t);

theorem 
  (non_op C)term a <> (ast C)term(b,t);

reserve e for expression of C;

theorem 
  e.{} = [non_op, the carrier of C] implies ex a st e = (non_op C)term a;

theorem 
  e.{} = [ *, the carrier of C] implies ex a, t st e = (ast C)term(a,t);

begin 

reserve a,a9 for expression of C, an_Adj C;

definition
  let C,a;
  func Non a -> expression of C, an_Adj C equals


   a|<* 0 *> if ex a9 st a = (non_op C)term a9
  otherwise (non_op C)term a;
end;

definition
  let C,a;
  attr a is positive means


   not ex a9 st a = (non_op C)term a9;
end;

registration
  let C;
  cluster positive for expression of C, an_Adj C;
end;

theorem 
  for a being positive expression of C, an_Adj C holds Non a = (non_op C)term a
;

definition
  let C,a;
  attr a is negative means


   ex a9 st a9 is positive & a = (non_op C)term a9;
end;

registration
  let C;
  let a be positive expression of C, an_Adj C;
  cluster Non a -> negative non positive;
end;

registration
  let C;
  cluster negative non positive for expression of C, an_Adj C;
end;

theorem 
  for a being non positive expression of C, an_Adj C
  ex a9 being expression of C, an_Adj C
  st a = (non_op C)term a9 & Non a = a9;

theorem 
  for a being negative expression of C, an_Adj C
  ex a9 being positive expression of C, an_Adj C
  st a = (non_op C)term a9 & Non a = a9;

theorem 
  for a being non positive expression of C, an_Adj C
  holds (non_op C)term (Non a) = a;

registration
  let C;
  let a be negative expression of C, an_Adj C;
  cluster Non a -> positive;
end;

definition
  let C,a;
  attr a is regular means


   a is positive or a is negative;
end;

registration
  let C;
  cluster positive -> regular non negative for expression of C, an_Adj C;
  cluster negative -> regular non positive for expression of C, an_Adj C;
end;

registration
  let C;
  cluster regular for expression of C, an_Adj C;
end;

definition
  let C;
  func QuasiAdjs C -> Subset of Free(C, MSVars C) equals

  {a: a is regular};
end;

registration
  let C;
  cluster QuasiAdjs C -> non empty constituted-DTrees;
end;

definition
  let C;
  mode quasi-adjective of C is regular expression of C, an_Adj C;
end;

theorem 
  z is quasi-adjective of C iff z in QuasiAdjs C;

theorem 
  z is quasi-adjective of C iff z is positive expression of C, an_Adj C or
  z is negative expression of C, an_Adj C;

registration
  let C;
  cluster non positive -> negative for quasi-adjective of C;
  cluster non negative -> positive for quasi-adjective of C;
end;

registration
  let C;
  cluster positive for quasi-adjective of C;
  cluster negative for quasi-adjective of C;
end;

theorem 
  for a being positive quasi-adjective of C
  ex v being constructor OperSymbol of C st the_result_sort_of v = an_Adj C &
  ex p st len p = len the_arity_of v & a = v-trm p;

theorem 
  for v being constructor OperSymbol of C
  st the_result_sort_of v = an_Adj C & len p = len the_arity_of v
  holds v-trm p is positive quasi-adjective of C;

registration
  let C;
  let a be quasi-adjective of C;
  cluster Non a -> regular;
end;

theorem 
  for a being quasi-adjective of C holds Non Non a = a;

theorem 
  for a1,a2 being quasi-adjective of C st Non a1 = Non a2 holds a1 = a2;

theorem 
  for a being quasi-adjective of C holds Non a <> a;

begin 

definition
  let C;
  let q be expression of C, a_Type C;
  attr q is pure means


   not ex a, t st q = (ast C)term(a,t);
end;

theorem 
  for m being OperSymbol of C
  st the_result_sort_of m = a_Type & the_arity_of m = {}
  ex t st t = root-tree [m, the carrier of C] & t is pure;

theorem 
  for v being OperSymbol of C
  st the_result_sort_of v = an_Adj & the_arity_of v = {}
  ex a st a = root-tree [v, the carrier of C] & a is positive;

registration
  let C;
  cluster pure for expression of C, a_Type C;
end;

reserve q for pure expression of C, a_Type C,
  A for finite Subset of QuasiAdjs C;

definition
  let C;
  func QuasiTypes C equals

  {[A,t]: t is pure};
end;

registration
  let C;
  cluster QuasiTypes C -> non empty;
end;

definition
  let C;
  mode quasi-type of C means


     it in QuasiTypes C;
end;

theorem 
  z is quasi-type of C iff ex A,q st z = [A,q];

theorem 
  [x,y] is quasi-type of C iff
  x is finite Subset of QuasiAdjs C & y is pure expression of C, a_Type C;

reserve T for quasi-type of C;

registration
  let C;
  cluster -> pair for quasi-type of C;
end;

theorem 
  ex m being constructor OperSymbol of C st the_result_sort_of m = a_Type C &
  ex p st len p = len the_arity_of m & q = m-trm p;

theorem 
  for m being constructor OperSymbol of C
  st the_result_sort_of m = a_Type C & len p = len the_arity_of m
  holds m-trm p is pure expression of C, a_Type C;

theorem 
  QuasiTerms C misses QuasiAdjs C & QuasiTerms C misses QuasiTypes C &
  QuasiTypes C misses QuasiAdjs C;

theorem 
  for e being set holds
  (e is quasi-term of C implies e is not quasi-adjective of C) &
  (e is quasi-term of C implies e is not quasi-type of C) &
  (e is quasi-type of C implies e is not quasi-adjective of C);

notation
  let C,A,q;
  synonym A ast q for [A,q];
end;

definition
  let C,A,q;
  redefine func A ast q -> quasi-type of C;
end;

registration
  let C,T;
  cluster T`1 -> finite;
end;

notation
  let C,T;
  synonym adjs T for T`1;
  synonym the_base_of T for T`2;
end;

definition
  let C,T;
  redefine func adjs T -> Subset of QuasiAdjs C;
  redefine func the_base_of T -> pure expression of C, a_Type C;
end;

theorem 
  adjs (A ast q) = A & the_base_of (A ast q) = q;

theorem 
  for A1,A2 being finite Subset of QuasiAdjs C
  for q1,q2 being pure expression of C, a_Type C
  st A1 ast q1 = A2 ast q2
  holds A1 = A2 & q1 = q2;

theorem 
  T = (adjs T) ast the_base_of T;

theorem 
  for T1,T2 being quasi-type of C
  st adjs T1 = adjs T2 & the_base_of T1 = the_base_of T2
  holds T1 = T2;

definition
  let C,T;
  let a be quasi-adjective of C;
  func a ast T -> quasi-type of C equals

  [{a} \/ adjs T, the_base_of T];
end;

theorem 
  for a being quasi-adjective of C
  holds adjs (a ast T) = {a} \/ adjs T & the_base_of (a ast T) = the_base_of T;

theorem 
  for a being quasi-adjective of C holds a ast (a ast T) = a ast T;

theorem 
  for a,b being quasi-adjective of C holds a ast (b ast T) = b ast (a ast T);

begin 

registration
  let S be non void Signature;
  let s be SortSymbol of S;
  let X be non-empty ManySortedSet of the carrier of S;
  let t be Term of S,X;
  cluster (variables_in t).s -> finite;
end;

registration
  let S be non void Signature;
  let s be SortSymbol of S;
  let X be non empty-yielding ManySortedSet of the carrier of S;
  let t be Element of Free(S,X);
  cluster (S variables_in t).s -> finite;
end;

definition
  let S be non void Signature;
  let X be non empty-yielding ManySortedSet of the carrier of S;
  let s be SortSymbol of S;
  func (X,s) variables_in ->
  Function of Union the Sorts of Free(S,X), bool (X.s) means


   for t being Element of Free(S,X) holds it.t = (S variables_in t).s;
end;

definition
  let C be initialized ConstructorSignature;
  let e be expression of C;
  func variables_in e -> Subset of Vars equals

  (C variables_in e).a_Term C;
end;

registration
  let C,e;
  cluster variables_in e -> finite;
end;

definition
  let C,e;
  func vars e -> finite Subset of Vars equals

  varcl variables_in e;
end;

theorem 
  varcl vars e = vars e;

theorem 
  for x being variable holds variables_in (x-term C) = {x};

theorem 
  for x being variable holds vars (x-term C) = {x} \/ vars x;

theorem 
  for p being DTree-yielding FinSequence st e = [c, the carrier of C]-tree p
  holds variables_in e =
  union {variables_in t where t is quasi-term of C: t in rng p};

theorem 
  for p being DTree-yielding FinSequence st e = [c, the carrier of C]-tree p
  holds vars e = union {vars t where t is quasi-term of C: t in rng p};

theorem 
  len p = len the_arity_of c implies variables_in (c-trm p) =
  union {variables_in t where t is quasi-term of C: t in rng p};

theorem 
  len p = len the_arity_of c implies
  vars (c-trm p) = union {vars t where t is quasi-term of C: t in rng p};

theorem 
  for S being ManySortedSign, o being set holds
  S variables_in ([o, the carrier of S]-tree {}) = [[0]] the carrier of S;

theorem 
  for S being ManySortedSign, o being set, t being DecoratedTree holds
  S variables_in ([o, the carrier of S]-tree <*t*>) = S variables_in t;

theorem 
  variables_in ((non_op C)term a) = variables_in a;

theorem 
  vars ((non_op C)term a) = vars a;

theorem 
  for S being ManySortedSign, o being set, t1,t2 being DecoratedTree holds
  S variables_in ([o, the carrier of S]-tree <*t1,t2*>)
  = (S variables_in t1) \/ (S variables_in t2);

theorem 
  variables_in ((ast C)term(a,t)) = (variables_in a)\/(variables_in t);

theorem 
  vars ((ast C)term(a,t)) = (vars a)\/(vars t);

theorem 
  variables_in Non a = variables_in a;

theorem 
  vars Non a = vars a;

definition
  let C;
  let T be quasi-type of C;
  func variables_in T -> Subset of Vars equals

  (union (((MSVars C, a_Term C) variables_in).:adjs T)) \/
  variables_in the_base_of T;
end;

registration
  let C;
  let T be quasi-type of C;
  cluster variables_in T -> finite;
end;

definition
  let C;
  let T be quasi-type of C;
  func vars T -> finite Subset of Vars equals

  varcl variables_in T;
end;

theorem 
  for T being quasi-type of C holds varcl vars T = vars T;

theorem 
  for T being quasi-type of C for a being quasi-adjective of C holds
  variables_in (a ast T) = (variables_in a) \/ (variables_in T);

theorem 
  for T being quasi-type of C for a being quasi-adjective of C holds
  vars (a ast T) = (vars a) \/ (vars T);

theorem 
  variables_in (A ast q) =
  (union {variables_in a where a is quasi-adjective of C: a in A}) \/
  (variables_in q);

theorem 
  vars (A ast q) =
  (union {vars a where a is quasi-adjective of C: a in A}) \/ (vars q);

theorem 
  variables_in (({}QuasiAdjs C) ast q) = variables_in q;

theorem 
  e is ground iff variables_in e = {};

definition
  let C;
  let T be quasi-type of C;
  attr T is ground means


   variables_in T = {};
end;

registration
  let C;
  cluster ground pure for expression of C, a_Type C;
  cluster ground for quasi-adjective of C;
end;

theorem 
  for t being ground pure expression of C, a_Type C
  holds ({} QuasiAdjs C) ast t is ground;

registration
  let C;
  let t be ground pure expression of C, a_Type C;
  cluster ({} QuasiAdjs C) ast t -> ground for quasi-type of C;
end;

registration
  let C;
  cluster ground for quasi-type of C;
end;

registration
  let C;
  let T be ground quasi-type of C;
  let a be ground quasi-adjective of C;
  cluster a ast T -> ground;
end;

begin 




definition
  func VarPoset -> strict non empty Poset equals

  (InclPoset {varcl A where A is finite Subset of Vars: not contradiction})opp;
end;

theorem 
  for x, y being Element of VarPoset holds x <= y iff y c= x;







theorem 
  for x holds
  x is Element of VarPoset iff x is finite Subset of Vars & varcl x = x;

registration
  cluster VarPoset -> with_infima with_suprema;
end;

theorem 
  for V1, V2 being Element of VarPoset holds
  V1 "\/" V2 = V1 /\ V2 & V1 "/\" V2 = V1 \/ V2;

registration
  let V1,V2 be Element of VarPoset;
  identify V1 "\/" V2 with V1 /\ V2;
  identify V1 "/\" V2 with V1 \/ V2;
end;

theorem 
  for X being non empty Subset of VarPoset holds
  ex_sup_of X, VarPoset & sup X = meet X;

registration
  cluster VarPoset -> up-complete;
end;

theorem 
  Top VarPoset = {};

definition
  let C;
  func vars-function C -> Function of QuasiTypes C, the carrier of VarPoset
  means

  for T being quasi-type of C holds it.T = vars T;
end;

definition
  let L be non empty Poset;
  attr L is smooth means

  ex C being initialized ConstructorSignature,
  f being Function of L, VarPoset st
  the carrier of L c= QuasiTypes C &
  f = (vars-function C)|the carrier of L &
  for x,y being Element of L holds f preserves_sup_of {x,y};
end;

registration
  let C be initialized ConstructorSignature;
  let T be ground quasi-type of C;
  cluster RelStr(#{T}, id {T}#) -> smooth;
end;

begin 

scheme 
 StructInd
  {C() -> initialized ConstructorSignature, P[set], t() -> expression of C()}:
  P[t()]
provided
 for x being variable holds P[x-term C()] and
 for c being constructor OperSymbol of C()
for p being FinSequence of QuasiTerms C()
st len p = len the_arity_of c &
for t being quasi-term of C() st t in rng p holds P[t]
holds P[c-trm p] and
 for a being expression of C(), an_Adj C() st P[a]
holds P[(non_op C())term a] and
 for a being expression of C(), an_Adj C() st P[a]
for t being expression of C(), a_Type C() st P[t]
holds P[(ast C())term(a,t)];

definition
  let S be ManySortedSign;
  attr S is with_an_operation_for_each_sort means


   the carrier of S c= rng the ResultSort of S;
  let X be ManySortedSet of the carrier of S;
  attr X is with_missing_variables means


   X"{{}} c= rng the ResultSort of S;
end;

theorem 
  for S being non void Signature for X being ManySortedSet of the carrier of S
  holds X is with_missing_variables iff
  for s being SortSymbol of S st X.s = {}
  ex o being OperSymbol of S st the_result_sort_of o = s;

registration
  cluster MaxConstrSign -> with_an_operation_for_each_sort;
  let C be ConstructorSignature;
  cluster MSVars C -> with_missing_variables;
end;

registration
  let S be ManySortedSign;
  cluster non-empty -> with_missing_variables
    for ManySortedSet of the carrier of S;
end;

registration
  let S be ManySortedSign;
  cluster with_missing_variables for ManySortedSet of the carrier of S;
end;

registration
  cluster initialized with_an_operation_for_each_sort
    strict for ConstructorSignature;
end;

registration
  let C be with_an_operation_for_each_sort ManySortedSign;
  cluster -> with_missing_variables for ManySortedSet of the carrier of C;
end;

definition
  let G be non empty DTConstrStr;
  redefine func Terminals G -> Subset of G;
  redefine func NonTerminals G -> Subset of G;
end;

theorem 
  for D1,D2 being non empty DTConstrStr st the Rules of D1 c= the Rules of D2
  holds NonTerminals D1 c= NonTerminals D2 &
  (the carrier of D1) /\ Terminals D2 c= Terminals D1 &
  (Terminals D1 c= Terminals D2 implies the carrier of D1 c= the carrier of D2)
;

theorem 
  for D1,D2 being non empty DTConstrStr st Terminals D1 c= Terminals D2 &
  the Rules of D1 c= the Rules of D2
  holds TS D1 c= TS D2;

theorem 
  for S being ManySortedSign
  for X,Y being ManySortedSet of the carrier of S st X c= Y
  holds X is with_missing_variables implies Y is with_missing_variables;

theorem 
  for S being set for X,Y being ManySortedSet of S st X c= Y
  holds Union coprod X c= Union coprod Y;

theorem 
  for S being non void Signature
  for X,Y being ManySortedSet of the carrier of S st X c= Y
  holds the carrier of DTConMSA X c= the carrier of DTConMSA Y;

theorem 
  for S being non void Signature for X being ManySortedSet of the carrier of S
  st X is with_missing_variables
  holds
  NonTerminals DTConMSA X = [:the carrier' of S,{the carrier of S}:] &
  Terminals DTConMSA X = Union coprod X;

theorem 
  for S being non void Signature
  for X,Y being ManySortedSet of the carrier of S
  st X c= Y & X is with_missing_variables
  holds
  Terminals DTConMSA X c= Terminals DTConMSA Y &
  the Rules of DTConMSA X c= the Rules of DTConMSA Y &
  TS DTConMSA X c= TS DTConMSA Y;

theorem 
  for t being set holds t in Terminals DTConMSA MSVars C iff
  ex x being variable st t = [x,a_Term C];

theorem 
  for t being set holds t in NonTerminals DTConMSA MSVars C iff
  t = [ast C, the carrier of C] or
  t = [non_op C, the carrier of C] or
  ex c being constructor OperSymbol of C st t = [c, the carrier of C];

theorem 
  for S being non void Signature
  for X being with_missing_variables ManySortedSet of the carrier of S
  for t being set st t in Union the Sorts of Free(S,X)
  holds t is Term of S, X \/ ((the carrier of S)-->{0});

theorem 
  for S being non void Signature
  for X being with_missing_variables ManySortedSet of the carrier of S
  for t being Term of S, X \/ ((the carrier of S)-->{0})
  st t in Union the Sorts of Free(S,X)
  holds t in (the Sorts of Free(S,X)).the_sort_of t;

theorem 
  for G being non empty DTConstrStr for s being Element of G
  for p being FinSequence st s ==> p
  holds p is FinSequence of the carrier of G;

theorem 
  for S being non void Signature
  for X,Y being ManySortedSet of the carrier of S
  for g1 being Symbol of DTConMSA X
  for g2 being Symbol of DTConMSA Y
  for p1 being FinSequence of the carrier of DTConMSA X
  for p2 being FinSequence of the carrier of DTConMSA Y
  st g1 = g2 & p1 = p2 & g1 ==> p1
  holds g2 ==> p2;

theorem 
  for S being non void Signature
  for X being with_missing_variables ManySortedSet of the carrier of S holds
  Union the Sorts of Free(S, X) = TS DTConMSA X;

definition
  let S be non void Signature;
  let X be ManySortedSet of the carrier of S;
  mode term-transformation of S,X -> UnOp of Union the Sorts of Free(S,X) means


    for s being SortSymbol of S holds
    it.:((the Sorts of Free(S,X)).s) c= (the Sorts of Free(S,X)).s;
end;

theorem 
  for S being non void Signature
  for X being non empty ManySortedSet of the carrier of S
  for f being UnOp of Union the Sorts of Free(S,X)
  holds f is term-transformation of S,X iff
  for s being SortSymbol of S
  for a being set st a in (the Sorts of Free(S,X)).s
  holds f.a in (the Sorts of Free(S,X)).s;

theorem 
  for S being non void Signature
  for X being non empty ManySortedSet of the carrier of S
  for f being term-transformation of S,X
  for s being SortSymbol of S
  for p being FinSequence of (the Sorts of Free(S,X)).s
  holds f*p is FinSequence of (the Sorts of Free(S,X)).s &
  card (f*p) = len p;

definition
  let S be non void Signature;
  let X be ManySortedSet of the carrier of S;
  let t be term-transformation of S,X;
  attr t is substitution means

  for o being OperSymbol of S for p,q being FinSequence of Free(S,X)
  st [o, the carrier of S]-tree p in Union the Sorts of Free(S,X) & q = t*p
  holds t.([o, the carrier of S]-tree p) = [o, the carrier of S]-tree q;
end;

scheme 
 StructDef
  {C() -> initialized ConstructorSignature,
  V,N(set) -> (expression of C()),
  F,A(set,set) -> (expression of C())}:
  ex f being term-transformation of C(), MSVars C() st
  (for x being variable holds f.(x-term C()) = V(x)) &
  (for c being constructor OperSymbol of C()
  for p,q being FinSequence of QuasiTerms C()
  st len p = len the_arity_of c & q = f*p
  holds f.(c-trm p) = F(c, q)) &
  (for a being expression of C(), an_Adj C()
  holds f.((non_op C())term a) = N(f.a)) &
  for a being expression of C(), an_Adj C()
  for t being expression of C(), a_Type C()
  holds f.((ast C())term(a,t)) = A(f.a, f.t)
provided
 for x being variable holds V(x) is quasi-term of C() and
 for c being constructor OperSymbol of C()
for p being FinSequence of QuasiTerms C()
st len p = len the_arity_of c
holds F(c, p) is expression of C(), the_result_sort_of c and
 for a being expression of C(), an_Adj C()
holds N(a) is expression of C(), an_Adj C() and
 for a being expression of C(), an_Adj C()
for t being expression of C(), a_Type C()
holds A(a,t) is expression of C(), a_Type C();

begin 

definition
  let A be set;
  let x,y be set;
  let a,b be Element of A;
  redefine func IFIN(x,y,a,b) -> Element of A;
end;

definition
  let C be initialized ConstructorSignature;
  mode valuation of C is PartFunc of Vars, QuasiTerms C;
end;

definition
  let C be initialized ConstructorSignature;
  let f be valuation of C;
  attr f is irrelevant means


   for x being variable st x in dom f
  ex y being variable st f.x = y-term C;
end;

notation
  let C be initialized ConstructorSignature;
  let f be valuation of C;
  antonym f is relevant for f is irrelevant;
end;

registration
  let C be initialized ConstructorSignature;
  cluster empty -> irrelevant for valuation of C;
end;

registration
  let C be initialized ConstructorSignature;
  cluster empty for valuation of C;
end;

definition
  let C be initialized ConstructorSignature;
  let X be Subset of Vars;
  func C idval X -> valuation of C equals

  {[x, x-term C] where x is variable: x in X};
end;

theorem 
  for X being Subset of Vars holds dom (C idval X) = X &
  for x being variable st x in X holds (C idval X).x = x-term C;

registration
  let C be initialized ConstructorSignature;
  let X be Subset of Vars;
  cluster C idval X -> irrelevant one-to-one;
end;

registration
  let C be initialized ConstructorSignature;
  let X be empty Subset of Vars;
  cluster C idval X -> empty;
end;

definition
  let C;
  let f be valuation of C;
  func f# -> term-transformation of C, MSVars C means


   (for x being variable holds (x in dom f implies it.(x-term C) = f.x) &
  (not x in dom f implies it.(x-term C) = x-term C)) &
  (for c being constructor OperSymbol of C
  for p,q being FinSequence of QuasiTerms C
  st len p = len the_arity_of c & q = it*p
  holds it.(c-trm p) = c-trm q) &
  (for a being expression of C, an_Adj C
  holds it.((non_op C)term a) = (non_op C)term (it.a)) &
  for a being expression of C, an_Adj C
  for t being expression of C, a_Type C
  holds it.((ast C)term(a,t)) = (ast C)term(it.a, it.t);
end;

registration
  let C;
  let f be valuation of C;
  cluster f# -> substitution;
end;

reserve f for valuation of C;

definition
  let C,f,e;
  func e at f -> expression of C equals

  f#.e;
end;

definition
  let C,f;
  let p be FinSequence such that
 rng p c= Union the Sorts of Free(C, MSVars C);
  func p at f -> FinSequence equals


   f# * p;
end;

definition
  let C,f;
  let p be FinSequence of QuasiTerms C;
  redefine func p at f -> FinSequence of QuasiTerms C equals

  f# * p;
end;

reserve x for variable;

theorem 
  not x in dom f implies (x-term C)at f = x-term C;

theorem 
  x in dom f implies (x-term C)at f = f.x;

theorem 
  len p = len the_arity_of c implies (c-trm p)at f = c-trm p at f;

theorem 
  ((non_op C)term a)at f = (non_op C)term(a at f);

theorem 
  ((ast C)term(a,t))at f = (ast C)term(a at f,t at f);

theorem 
  for X being Subset of Vars holds e at (C idval X) = e;

theorem 
  for X being Subset of Vars
  holds (C idval X)# = id Union the Sorts of Free(C, MSVars C);

theorem 
  for f being empty valuation of C holds e at f = e;

theorem 
  for f being empty valuation of C
  holds f# = id Union the Sorts of Free(C, MSVars C);






definition
  let C,f;
  let t be quasi-term of C;
  redefine func t at f -> quasi-term of C;
end;

definition
  let C,f;
  let a be expression of C, an_Adj C;
  redefine func a at f -> expression of C, an_Adj C;
end;

registration
  let C,f;
  let a be positive expression of C, an_Adj C;
  cluster a at f -> positive for expression of C, an_Adj C;
end;

registration
  let C,f;
  let a be negative expression of C, an_Adj C;
  cluster a at f -> negative for expression of C, an_Adj C;
end;

definition
  let C,f;
  let a be quasi-adjective of C;
  redefine func a at f -> quasi-adjective of C;
end;

theorem 
  (Non a) at f = Non (a at f);

definition
  let C,f;
  let t be expression of C, a_Type C;
  redefine func t at f -> expression of C, a_Type C;
end;

registration
  let C,f;
  let t be pure expression of C, a_Type C;
  cluster t at f -> pure for expression of C, a_Type C;
end;

theorem 
  for f being irrelevant one-to-one valuation of C
  ex g being irrelevant one-to-one valuation of C
  st for x,y being variable holds
  x in dom f & f.x = y-term C iff y in dom g & g.y = x-term C;

theorem 
  for f,g being irrelevant one-to-one valuation of C
  st for x,y being variable holds
  x in dom f & f.x = y-term C implies y in dom g & g.y = x-term C
  for e st variables_in e c= dom f
  holds e at f at g = e;

definition
  let C,f;
  let A be Subset of QuasiAdjs C;
  func A at f -> Subset of QuasiAdjs C equals

  {a at f where a is quasi-adjective of C: a in A};
end;

theorem 
  for A being Subset of QuasiAdjs C for a being quasi-adjective of C st A = {a}
  holds A at f = {a at f};

theorem 
  for A,B being Subset of QuasiAdjs C
  holds (A \/ B) at f = (A at f) \/ (B at f);

theorem 
  for A,B being Subset of QuasiAdjs C st A c= B holds A at f c= B at f;

registration
  let C be initialized ConstructorSignature;
  let f be valuation of C;
  let A be finite Subset of QuasiAdjs C;
  cluster A at f -> finite;
end;

definition
  let C be initialized ConstructorSignature;
  let f be valuation of C;
  let T be quasi-type of C;
  func T at f -> quasi-type of C equals

  ((adjs T) at f)ast((the_base_of T) at f);
end;

theorem 
  for T being quasi-type of C holds adjs(T at f) = (adjs T) at f &
  the_base_of (T at f) = (the_base_of T) at f;

theorem 
  for T being quasi-type of C for a being quasi-adjective of C
  holds (a ast T) at f = (a at f) ast (T at f);

definition
  let C be initialized ConstructorSignature;
  let f,g be valuation of C;
  func f at g -> valuation of C means


   dom it = (dom f) \/ dom g & for x being variable st x in dom it
  holds it.x = ((x-term C) at f) at g;
end;

registration
  let C be initialized ConstructorSignature;
  let f,g be irrelevant valuation of C;
  cluster f at g -> irrelevant;
end;

theorem 
  for f1,f2 being valuation of C holds (e at f1) at f2 = e at (f1 at f2);

theorem 
  for A being Subset of QuasiAdjs C for f1,f2 being valuation of C
  holds (A at f1) at f2 = A at (f1 at f2);

theorem 
  for T being quasi-type of C for f1,f2 being valuation of C
  holds (T at f1) at f2 = T at (f1 at f2);














begin

definition
  let x be set;
  func CastNat(x) -> Nat equals


  x if x is Nat otherwise 0;
end;

reserve k,n,m for Nat,
  a,x,X,Y for set,
  D,D1,D2,S for non empty set,
  p,q for FinSequence of NAT;



definition
  let n;
  func atom.n -> FinSequence of NAT equals

  <* (6 + n) *>;
end;

definition
  let p;
  func 'not' p -> FinSequence of NAT equals

  <*0*>^p;
  let q;
  func p '&' q -> FinSequence of NAT equals

  <*1*>^p^q;
  func p 'or' q -> FinSequence of NAT equals

  <*2*>^p^q;
end;

definition
  let p;
  func 'X' p -> FinSequence of NAT equals

  <*3*>^p;
  let q;
  func p 'U' q -> FinSequence of NAT equals

  <*4*>^p^q;
  func p 'R' q -> FinSequence of NAT equals

  <*5*>^p^q;
end;



definition
  func LTL_WFF -> non empty set means


  (for a st a in it holds a is
  FinSequence of NAT ) & (for n holds atom.n in it ) & (for p st p in it holds
'not' p in it ) & (for p,q st p in it & q in it holds p '&' q in it ) & (for p,
  q st p in it & q in it holds p 'or' q in it ) & (for p st p in it holds 'X' p
  in it ) & (for p,q st p in it & q in it holds p 'U' q in it ) & (for p,q st p
  in it & q in it holds p 'R' q in it ) & for D st (for a st a in D holds a is
  FinSequence of NAT ) & (for n holds atom.n in D ) & (for p st p in D holds
'not' p in D ) & (for p,q st p in D & q in D holds p '&' q in D ) & (for p,q st
p in D & q in D holds p 'or' q in D ) & (for p st p in D holds 'X' p in D ) & (
  for p,q st p in D & q in D holds p 'U' q in D ) & (for p,q st p in D & q in D
  holds p 'R' q in D ) holds it c= D;
end;

definition
  let IT be FinSequence of NAT;
  attr IT is LTL-formula-like means


  IT is Element of LTL_WFF;
end;

registration
  cluster LTL-formula-like for FinSequence of NAT;
end;

definition
  mode LTL-formula is LTL-formula-like FinSequence of NAT;
end;

theorem 
  a is LTL-formula iff a in LTL_WFF;

reserve F,F1,G,G1,H,H1,H2 for LTL-formula;

registration
  let n;
  cluster atom.n -> LTL-formula-like;
end;

registration
  let H;
  cluster 'not' H -> LTL-formula-like;
  cluster 'X' H -> LTL-formula-like;
  let G;
  cluster H '&' G -> LTL-formula-like;
  cluster H 'or' G -> LTL-formula-like;
  cluster H 'U' G -> LTL-formula-like;
  cluster H 'R' G -> LTL-formula-like;
end;

definition
  let H;
  attr H is atomic means


  ex n st H = atom.n;
  attr H is negative means


  ex H1 st H = 'not' H1;
  attr H is conjunctive means


  ex F,G st H = F '&' G;
  attr H is disjunctive means


  ex F,G st H = F 'or' G;
  attr H is next means


  ex H1 st H = 'X' H1;
  attr H is Until means


  ex F,G st H = F 'U' G;
  attr H is Release means


  ex F,G st H = F 'R' G;
end;

theorem 
  H is atomic or H is negative or H is conjunctive or H is
  disjunctive or H is next or H is Until or H is Release;

theorem 
  1<= len H;

reserve sq,sq9 for FinSequence;

definition
  let H;
  assume
 H is negative or H is next;
  func the_argument_of H -> LTL-formula means


  'not' it = H if H is negative otherwise 'X' it = H;
end;

definition
  let H;
  assume
 H is conjunctive or H is disjunctive or H is Until or H is Release;
  func the_left_argument_of H -> LTL-formula means


  ex H1 st it '&' H1
= H if H is conjunctive, ex H1 st it 'or' H1 = H if H is disjunctive, ex H1 st
  it 'U' H1 = H if H is Until otherwise ex H1 st it 'R' H1 = H;
  func the_right_argument_of H -> LTL-formula means


  ex H1 st H1 '&' it
= H if H is conjunctive, ex H1 st H1 'or' it = H if H is disjunctive, ex H1 st
  H1 'U' it = H if H is Until otherwise ex H1 st H1 'R' it = H;
end;

theorem 
  H is negative implies H = 'not' the_argument_of H;

theorem 
  H is next implies H = 'X' the_argument_of H;

theorem 
  H is conjunctive implies H =(the_left_argument_of H) '&' (
  the_right_argument_of H);

theorem 
  H is disjunctive implies H =(the_left_argument_of H) 'or' (
  the_right_argument_of H);

theorem 
  H is Until implies H = (the_left_argument_of H) 'U' (
  the_right_argument_of H);

theorem 
  H is Release implies H = (the_left_argument_of H) 'R' (
  the_right_argument_of H);

theorem 
  H is negative or H is next implies len(H) = 1+len(
  the_argument_of H) & len(the_argument_of H) < len(H);

theorem 
  H is conjunctive or H is disjunctive or H is Until or H is
  Release implies len(H) =1+ len(the_left_argument_of H)+len(
  the_right_argument_of H) & len(the_left_argument_of H) < len(H) & len(
  the_right_argument_of H) < len(H);





definition
  let H,F;
  pred H is_immediate_constituent_of F means


  F = 'not' H or F = 'X' H
or ex H1 st F = H '&' H1 or F = H1 '&' H or F = H 'or' H1 or F = H1 'or' H or F
  = H 'U' H1 or F = H1 'U' H or F = H 'R' H1 or F = H1 'R' H;
end;

theorem 
  for F,G holds ('not' F).1 = 0 & (F '&' G).1 = 1 & (F 'or' G).1 =
  2 & ('X' F).1 = 3 & (F 'U' G).1 = 4 & (F 'R' G).1 = 5;

theorem 
  H is_immediate_constituent_of 'not' F iff H = F;

theorem 
  H is_immediate_constituent_of 'X' F iff H = F;

theorem 
  H is_immediate_constituent_of F '&' G iff H = F or H =G;

theorem 
  H is_immediate_constituent_of F 'or' G iff H = F or H =G;

theorem 
  H is_immediate_constituent_of F 'U' G iff H = F or H =G;

theorem 
  H is_immediate_constituent_of F 'R' G iff H = F or H =G;

theorem 
  F is atomic implies not H is_immediate_constituent_of F;

theorem 
  F is negative implies (H is_immediate_constituent_of F iff H =
  the_argument_of F);

theorem 
  F is next implies (H is_immediate_constituent_of F iff H = the_argument_of F)
;

theorem 
  F is conjunctive implies (H is_immediate_constituent_of F iff H
  = the_left_argument_of F or H = the_right_argument_of F);

theorem 
  F is disjunctive implies (H is_immediate_constituent_of F iff H
  = the_left_argument_of F or H = the_right_argument_of F);

theorem 
  F is Until implies (H is_immediate_constituent_of F iff H =
  the_left_argument_of F or H = the_right_argument_of F);

theorem 
  F is Release implies (H is_immediate_constituent_of F iff H =
  the_left_argument_of F or H = the_right_argument_of F);

theorem 
  H is_immediate_constituent_of F implies F is negative or F is next or
F is conjunctive or F is disjunctive or F is Until or F is Release;





reserve L,L9 for FinSequence;

definition
  let H,F;
  pred H is_subformula_of F means


  ex n,L st 1 <= n & len L = n & L.1 = H & L.n = F &
  for k st 1 <= k & k < n ex H1,F1 st L.k = H1 & L.(k + 1) = F1 &
  H1 is_immediate_constituent_of F1;
  reflexivity;
end;

theorem 
  H is_subformula_of H;

definition
  let H,F;
  pred H is_proper_subformula_of F means


  H is_subformula_of F & H <> F;
  irreflexivity;
end;

theorem 
  H is_immediate_constituent_of F implies len H < len F;

theorem 
  H is_immediate_constituent_of F implies H is_proper_subformula_of F;

theorem 
  (G is negative or G is next) implies the_argument_of G is_subformula_of G;

theorem 
  (G is conjunctive or G is disjunctive or G is Until or G is Release )
  implies the_left_argument_of G is_subformula_of G & the_right_argument_of G
  is_subformula_of G;

theorem 
  H is_proper_subformula_of F implies len H < len F;

theorem 
  H is_proper_subformula_of F implies ex G st G is_immediate_constituent_of F;

reserve j for Nat;
reserve j1 for Element of NAT;

theorem 
  F is_proper_subformula_of G & G is_proper_subformula_of H
  implies F is_proper_subformula_of H;

theorem 
  F is_subformula_of G & G is_subformula_of H implies F is_subformula_of H;

theorem 
  G is_subformula_of H & H is_subformula_of G implies G = H;

theorem 
  (G is negative or G is next) & F is_proper_subformula_of G
  implies F is_subformula_of (the_argument_of G);

theorem 
  (G is conjunctive or G is disjunctive or G is Until or G is
  Release ) & F is_proper_subformula_of G implies F is_subformula_of (
  the_left_argument_of G) or F is_subformula_of (the_right_argument_of G);

theorem 
  F is_proper_subformula_of 'not' H implies F is_subformula_of H;

theorem 
  F is_proper_subformula_of 'X' H implies F is_subformula_of H;

theorem 
  F is_proper_subformula_of G '&' H implies F is_subformula_of G or F
  is_subformula_of H;

theorem 
  F is_proper_subformula_of G 'or' H implies F is_subformula_of G or F
  is_subformula_of H;

theorem 
  F is_proper_subformula_of G 'U' H implies F is_subformula_of G or F
  is_subformula_of H;

theorem 
  F is_proper_subformula_of G 'R' H implies F is_subformula_of G or F
  is_subformula_of H;





definition
  let H;
  func Subformulae H -> set means


  a in it iff ex F st F = a & F is_subformula_of H;
end;

theorem 
  G in Subformulae H iff G is_subformula_of H;

registration
  let H;
  cluster Subformulae H -> non empty;
end;

theorem 
  F is_subformula_of H implies Subformulae F c= Subformulae H;

theorem 
  a is Subset of Subformulae H implies a is Subset of LTL_WFF;

scheme 

  LTLInd { P[LTL-formula] } : for H holds P[H]
provided
 for H st H is atomic holds P[H] and
 for H st (H is negative or H is next) & P[the_argument_of H] holds P
[H] and
 for H st (H is conjunctive or H is disjunctive or H is Until or H is
Release )& P[the_left_argument_of H] & P[the_right_argument_of H] holds P[H];

scheme 

  LTLCompInd { P[LTL-formula] } : for H holds P[H]
provided
 for H st for F st F is_proper_subformula_of H holds P[F] holds P[H];







definition
  let x be set;
  func CastLTL(x) -> LTL-formula equals


  x if x in LTL_WFF otherwise
  atom.0;
end;

definition
  struct(OrthoLattStr) LTLModelStr (# carrier -> set, BasicAssign ->
     Subset of the carrier, L_meet -> BinOp of the carrier,
     L_join -> BinOp of the carrier,
     Compl -> UnOp of the carrier, NEXT-> UnOp of the
    carrier, UNTIL -> BinOp of the carrier, RELEASE -> BinOp of the
    carrier #);
end;

definition
  let V be LTLModelStr;
  mode Assign of V is Element of the carrier of V;
end;




definition
  func atomic_LTL -> Subset of LTL_WFF equals

  {x where x is LTL-formula:x is
  atomic};
end;

definition
  let V be LTLModelStr;
  let Kai be Function of atomic_LTL,the BasicAssign of V;
  let f be Function of LTL_WFF,the carrier of V;
  pred f is-Evaluation-for Kai means


  for H being LTL-formula holds (H is atomic implies f.H = Kai.H) &
(H is negative implies f.H = (the Compl of V).(f
  .(the_argument_of H))) &
  (H is conjunctive implies f.H = (the L_meet of V).(f.(
  the_left_argument_of H), f.(the_right_argument_of H))) & (H is disjunctive
  implies f.H = (the L_join of V).(f.(the_left_argument_of H), f.(
  the_right_argument_of H))) & (H is next implies f.H = (the NEXT of V).(f.(
  the_argument_of H))) & (H is Until implies f.H = (the UNTIL of V).(f.(
the_left_argument_of H), f.(the_right_argument_of H))) & (H is Release implies
f.H = (the RELEASE of V).(f.(the_left_argument_of H), f.(the_right_argument_of
  H)));
end;

definition
  let V be LTLModelStr;
  let Kai be Function of atomic_LTL,the BasicAssign of V;
  let f be Function of LTL_WFF,the carrier of V;
  let n be Nat;
  pred f is-PreEvaluation-for n,Kai means


  for H being LTL-formula st
len(H) <= n holds (H is atomic implies f.H = Kai.H) & (H is negative implies f.
H = (the Compl of V).(f.(the_argument_of H))) &
(H is conjunctive implies f.H = (
  the L_meet of V).(f.(the_left_argument_of H), f.(the_right_argument_of H)))
   & (H
  is disjunctive implies f.H = (the L_join of V).(f.(the_left_argument_of H),
   f.(
  the_right_argument_of H))) & (H is next implies f.H = (the NEXT of V).(f.(
  the_argument_of H))) & (H is Until implies f.H = (the UNTIL of V).(f.(
the_left_argument_of H), f.(the_right_argument_of H))) & (H is Release implies
f.H = (the RELEASE of V).(f.(the_left_argument_of H), f.(the_right_argument_of
  H)));
end;

definition
  let V be LTLModelStr;
  let Kai be Function of atomic_LTL,the BasicAssign of V;
  let f,h be Function of LTL_WFF,the carrier of V;
  let n be Nat;
  let H be LTL-formula;
  func GraftEval(V,Kai,f,h,n,H) -> set equals


  f.H if len(H) > n+1, Kai
.H if len(H)=n+1 & H is atomic, (the Compl of V).(h.(the_argument_of H))
 if len(H
  )=n+1 & H is negative, (the L_meet of V).(h.(the_left_argument_of H), h.(
the_right_argument_of H)) if len(H)=n+1 & H is conjunctive,
 (the L_join of V).(h.(
  the_left_argument_of H), h.(the_right_argument_of H)) if len(H)=n+1 & H is
disjunctive, (the NEXT of V).(h.(the_argument_of H)) if len(H)=n+1 & H is next
, (the UNTIL of V).(h.(the_left_argument_of H), h.(the_right_argument_of H)) if
  len(H)=n+1 & H is Until, (the RELEASE of V).(h.(the_left_argument_of H), h.(
  the_right_argument_of H)) if len(H)=n+1 & H is Release, h.H if len(H)<n+1
  otherwise {};
end;

definition let C be LTLModelStr;
 attr C is with_basic means

 the BasicAssign of C is non empty;
end;

definition
 func TrivialLTLModel -> LTLModelStr equals

   LTLModelStr(# 1, [#]1, op2, op2, op1, op1, op2, op2#);
end;

registration
 cluster TrivialLTLModel -> with_basic strict non empty;
end;

registration
 cluster non empty for LTLModelStr;
end;

registration
 cluster with_basic for non empty LTLModelStr;
end;

definition
 mode LTLModel is with_basic non empty LTLModelStr;
end;

registration let C be LTLModel;
 cluster the BasicAssign of C -> non empty;
end;

reserve V for LTLModel;
reserve Kai for Function of atomic_LTL,the BasicAssign of V;
reserve f,f1,f2 for Function of LTL_WFF,the carrier of V;

definition
  let V be LTLModel;
  let Kai be Function of atomic_LTL,the BasicAssign of V;
  let n be Nat;
  func EvalSet(V,Kai,n) ->non empty set equals

  {h where h is Function of
  LTL_WFF,the carrier of V : h is-PreEvaluation-for n,Kai};
end;

definition
  let V be LTLModel;
  let v0 be Element of the carrier of V;
  let x be set;
  func CastEval(V,x,v0) ->Function of LTL_WFF,the carrier of V equals


   x
 if x in Funcs(LTL_WFF,the carrier of V) otherwise LTL_WFF --> v0;
end;

definition
  let V be LTLModel;
  let Kai be Function of atomic_LTL,the BasicAssign of V;
  func EvalFamily(V,Kai) -> non empty set means


  for p being set holds
p in it iff p in bool Funcs(LTL_WFF,the carrier of V) & ex n being Nat st
  p=EvalSet(V,Kai,n);
end;

theorem 
  ex f st f is-Evaluation-for Kai;

theorem 
  f1 is-Evaluation-for Kai & f2 is-Evaluation-for Kai implies f1 = f2;

definition
  let V be LTLModel;
  let Kai be Function of atomic_LTL,the BasicAssign of V;
  let H be LTL-formula;
  func Evaluate(H,Kai) -> Assign of V means


  ex f being Function of
  LTL_WFF,the carrier of V st f is-Evaluation-for Kai & it = f.H;
end;

notation
  let V be LTLModel;
  let f be Assign of V;
  synonym 'not' f for f`;
  let g be Assign of V;
  synonym f '&' g for f "/\" g;
  synonym f 'or' g for f "\/" g;
end;

definition

  let V be LTLModel;
  let f be Assign of V;
  func 'X' f -> Assign of V equals

  (the NEXT of V).f;
end;

definition
  let V be LTLModel;
  let f,g be Assign of V;
  func f 'U' g -> Assign of V equals

  (the UNTIL of V).(f,g);
  func f 'R' g -> Assign of V equals

  (the RELEASE of V).(f,g);
end;



theorem 
  Evaluate('not' H,Kai) = 'not' Evaluate(H,Kai);

theorem 
  Evaluate(H1 '&' H2,Kai) = Evaluate(H1,Kai) '&' Evaluate(H2,Kai);

theorem 
  Evaluate(H1 'or' H2,Kai) = Evaluate(H1,Kai) 'or' Evaluate(H2,Kai );

theorem 
  Evaluate('X' H,Kai) = 'X' Evaluate(H,Kai);

theorem 
  Evaluate(H1 'U' H2,Kai) = Evaluate(H1,Kai) 'U' Evaluate(H2,Kai);

theorem 
  Evaluate(H1 'R' H2,Kai) = Evaluate(H1,Kai) 'R' Evaluate(H2,Kai);



definition
  let S be non empty set;
  func Inf_seq(S) -> non empty set equals

  Funcs(NAT,S);
end;

definition
  let S be non empty set;
  let t be sequence of S;
  func CastSeq(t) -> Element of Inf_seq(S) equals

  t;
end;

definition
  let S be non empty set;
  let t be set;
  assume
 t is Element of Inf_seq(S);
  func CastSeq(t,S) -> sequence of S equals


  t;
end;

definition

  let S be non empty set;
  let t be set;
  let k be Nat;
  func Shift(t,k,S) -> Element of Inf_seq(S) equals

   CastSeq(CastSeq(t,S)^\k);
end;

definition
  let S be non empty set;
  let t be Element of Inf_seq(S);
  let k be Nat;
  func Shift(t,k) -> Element of Inf_seq(S) equals

  Shift(t,k,S);
end;



definition
  let S be non empty set;
  let f be set;
  func Not_0(f,S) -> Element of ModelSP(Inf_seq(S)) means


  for t being
  set st t in Inf_seq(S) holds 'not' (Castboolean (Fid(f,Inf_seq(S))).t) = TRUE
  iff (Fid(it,Inf_seq(S))).t = TRUE;
end;

definition
  let S be non empty set;
  func Not_(S) -> UnOp of ModelSP(Inf_seq(S)) means


  for f being set st f in ModelSP(Inf_seq(S)) holds it.f = Not_0(f,S);
end;



definition
  let S be non empty set;
  let f be Function of Inf_seq(S),BOOLEAN;
  let t be set;
  func Next_univ(t,f) -> Element of BOOLEAN equals


  TRUE if t is
  Element of Inf_seq(S) & f.Shift(t,1,S) =TRUE otherwise FALSE;
end;

definition
  let S be non empty set;
  let f be set;
  func Next_0(f,S) -> Element of ModelSP(Inf_seq(S)) means


  for t being
  set st t in Inf_seq(S) holds Next_univ(t,Fid(f,Inf_seq(S)))=TRUE iff (Fid(it,
  Inf_seq(S))).t=TRUE;
end;

definition
  let S be non empty set;
  func Next_(S) -> UnOp of ModelSP(Inf_seq(S)) means


  for f being set st f in ModelSP(Inf_seq(S)) holds it.f = Next_0(f,S);
end;



definition
  let S be non empty set;
  let f,g be set;
  func And_0(f,g,S) -> Element of ModelSP(Inf_seq(S)) means


  for t
  being set st t in Inf_seq(S) holds (Castboolean (Fid(f,Inf_seq(S))).t ) '&' (
  Castboolean (Fid(g,Inf_seq(S))).t ) =TRUE iff (Fid(it,Inf_seq(S))).t=TRUE;
end;

definition
  let S be non empty set;
  func And_(S) -> BinOp of ModelSP(Inf_seq(S)) means


  for f,g being set
st f in ModelSP(Inf_seq(S)) & g in ModelSP(Inf_seq(S)) holds it.(f,g) = And_0(f
  ,g,S);
end;



definition
  let S be non empty set;
  let f,g be Function of Inf_seq(S),BOOLEAN;
  let t be set;
  func Until_univ(t,f,g,S) -> Element of BOOLEAN equals


  TRUE if t is
Element of Inf_seq(S) & ex m being Nat st (for j being Nat st j<m holds f.Shift
  (t,j,S) =TRUE ) & g.Shift(t,m,S) = TRUE otherwise FALSE;
end;

definition
  let S be non empty set;
  let f,g be set;
  func Until_0(f,g,S) -> Element of ModelSP(Inf_seq(S)) means


  for t
being set st t in Inf_seq(S) holds Until_univ(t,Fid(f,Inf_seq(S)),Fid(g,Inf_seq
  (S)),S)=TRUE iff (Fid(it,Inf_seq(S))).t=TRUE;
end;

definition
  let S be non empty set;
  func Until_(S) -> BinOp of ModelSP(Inf_seq(S)) means


  for f,g being
  set st f in ModelSP(Inf_seq(S)) & g in ModelSP(Inf_seq(S)) holds it.(f,g) =
  Until_0(f,g,S);
end;

definition
  let S be non empty set;
  func Or_(S) -> BinOp of ModelSP(Inf_seq(S)) means


  for f,g being set
st f in ModelSP(Inf_seq(S)) & g in ModelSP(Inf_seq(S)) holds it.(f,g) = (Not_(S
  )).((And_(S)).((Not_(S)).f,(Not_(S)).g));
  func Release_(S) -> BinOp of ModelSP(Inf_seq(S)) means


  for f,g being
  set st f in ModelSP(Inf_seq(S)) & g in ModelSP(Inf_seq(S)) holds it.(f,g) = (
  Not_(S)).((Until_(S)).((Not_(S)).f,(Not_(S)).g));
end;



definition
  let S be non empty set;
  let BASSIGN be non empty Subset of ModelSP(Inf_seq(S));
  func Inf_seqModel(S,BASSIGN) -> LTLModelStr equals

  LTLModelStr(# ModelSP(Inf_seq
(S)), BASSIGN, And_(S), Or_(S), Not_(S), Next_(S), Until_(S), Release_(S) #);
end;

registration
  let S be non empty set;
  let BASSIGN be non empty Subset of ModelSP(Inf_seq(S));
 cluster Inf_seqModel(S,BASSIGN) -> with_basic strict non empty;
end;

reserve BASSIGN for non empty Subset of ModelSP(Inf_seq(S));
reserve t for Element of Inf_seq(S);
reserve f,g for Assign of Inf_seqModel(S,BASSIGN);



definition
  let S be non empty set;
  let BASSIGN be non empty Subset of ModelSP(Inf_seq(S));
  let t be Element of Inf_seq(S);
  let f be Assign of Inf_seqModel(S,BASSIGN);
  pred t |= f means


  (Fid(f,Inf_seq(S))).t=TRUE;
end;

notation
  let S be non empty set;
  let BASSIGN be non empty Subset of ModelSP(Inf_seq(S));
  let t be Element of Inf_seq(S);
  let f be Assign of Inf_seqModel(S,BASSIGN);
  antonym t |/= f for t |= f;
end;

theorem 
  f 'or' g = 'not' (('not' f) '&' ('not' g)) & f 'R' g = 'not' (('not' f
  ) 'U' ('not' g));

theorem 
  t |= 'not' f iff t |/= f;

theorem 
  t |= f '&' g iff t|=f & t|=g;

theorem 
  t |= 'X' f iff Shift(t,1) |=f;

theorem 
  t |= f 'U' g iff ex m being Nat st (for j being Nat st j<m holds
  Shift(t,j) |= f) & Shift(t,m) |= g;

theorem 
  t |= f 'or' g iff (t|= f or t|= g);

theorem 
  t |= f 'R' g iff for m being Nat holds ((for j being Nat st j<m
  holds Shift(t,j) |= 'not'(f)) implies Shift(t,m) |= g);



definition
  func AtomicFamily -> non empty set equals

  bool atomic_LTL;
end;

definition
  let a, t be set;
  func AtomicFunc(a,t) -> Element of BOOLEAN equals


  TRUE if t in
  Inf_seq(AtomicFamily) & a in (CastSeq(t,AtomicFamily)).0 otherwise FALSE;
end;

definition
  let a be set;
  func AtomicAsgn(a) -> Element of ModelSP(Inf_seq(AtomicFamily)) means



  for t being set st t in Inf_seq(AtomicFamily) holds Fid(it,Inf_seq(
  AtomicFamily)).t = AtomicFunc(a,t);
end;

definition
  func AtomicBasicAsgn -> non empty Subset of ModelSP(Inf_seq(AtomicFamily))
  equals

  {x where x is Element of ModelSP(Inf_seq(AtomicFamily)): ex a being set
  st x = AtomicAsgn(a) };
end;

definition
  func AtomicKai -> Function of atomic_LTL,the BasicAssign of Inf_seqModel(
  AtomicFamily,AtomicBasicAsgn) means


  for a being set st a in atomic_LTL holds it.a = AtomicAsgn(a);
end;

definition
  let r be Element of Inf_seq(AtomicFamily);
  let H be LTL-formula;
  pred r|= H means


  r|= Evaluate(H,AtomicKai);
end;

notation
  let r be Element of Inf_seq(AtomicFamily);
  let H be LTL-formula;
  antonym r|/= H for r|= H;
end;

definition
  let r be Element of Inf_seq(AtomicFamily);
  let W be Subset of LTL_WFF;
  pred r|= W means


  for H be LTL-formula st H in W holds r|= H;
end;

notation
  let r be Element of Inf_seq(AtomicFamily);
  let W be Subset of LTL_WFF;
  antonym r|/= W for r|= W;
end;

definition
  let W be Subset of LTL_WFF;
  func 'X' W -> Subset of LTL_WFF equals

  {x where x is LTL-formula:ex u being
  LTL-formula st u in W & x='X' u};
end;

reserve r for Element of Inf_seq(AtomicFamily);

theorem 
  H is atomic implies (r |= H iff H in (CastSeq(r,AtomicFamily)).0);

theorem 
  r|= 'not' H iff r|/= H;

theorem 
  r|= H1 '&' H2 iff r|= H1 & r|= H2;

theorem 
  r|= H1 'or' H2 iff r|= H1 or r|= H2;

theorem 
  r|= 'X' H iff Shift(r,1)|=H;

theorem 
  r|= H1 'U' H2 iff ex m being Nat st (for j being Nat st j<m
  holds Shift(r,j) |= H1) & Shift(r,m) |= H2;

theorem 
  r|= H1 'R' H2 iff for m being Nat holds ((for j being Nat st j<m holds
  Shift(r,j) |= 'not' H1) implies Shift(r,m) |= H2);

theorem 
  r|= 'not' (H1 'or' H2) iff r |= ('not' H1) '&' ('not' H2);

theorem 
  r|= 'not' (H1 '&' H2) iff r |= ('not' H1) 'or' ('not' H2);

theorem 
  r|= H1 'R' H2 iff r |= 'not' ( ('not' H1) 'U' ('not' H2));

theorem 
  r |/= 'not' H iff r |= H;

theorem 
  r |= 'X'('not' H) iff r |='not' ('X' H);

theorem 
  r|= H1 'U' H2 iff r|=H2 'or' (H1 '&' ('X' (H1 'U' H2)));

theorem 
  r|= H1 'R' H2 iff r|=(H1 '&' H2) 'or' (H2 '&' ('X' (H1 'R' H2)));

reserve W for Subset of LTL_WFF;

theorem 
  r |= 'X' W iff Shift(r,1) |=W;



theorem 
  (H is atomic implies (not H is negative) & (not H is conjunctive) & (
not H is disjunctive) & (not H is next) & (not H is Until) & not H is Release )
& (H is negative implies (not H is atomic) & (not H is conjunctive) & (not H is
disjunctive) & (not H is next) & (not H is Until) & not H is Release ) & (H is
  conjunctive implies (not H is atomic) & (not H is negative) & (not H is
disjunctive) & (not H is next) & (not H is Until) & not H is Release ) & (H is
  disjunctive implies (not H is atomic) & (not H is negative) & (not H is
conjunctive) & (not H is next) & (not H is Until) & not H is Release ) & (H is
next implies (not H is atomic) & (not H is negative) & (not H is conjunctive) &
  (not H is disjunctive) & (not H is Until) & not H is Release ) & (H is Until
implies (not H is atomic) & (not H is negative) & (not H is conjunctive) & (not
  H is disjunctive) & (not H is next) & not H is Release ) & (H is Release
implies (not H is atomic) & (not H is negative) & (not H is conjunctive) & (not
H is disjunctive) & (not H is next) & not H is Until );

theorem 
  for t being Element of Inf_seq(S) holds Shift(t,0)=t;

theorem 
  for seq being Element of Inf_seq(S) holds Shift(Shift(seq,k),n) =
  Shift(seq,n+k);

theorem 
  for seq being sequence of S holds CastSeq(CastSeq(seq),S) = seq;

theorem 
  for seq being Element of Inf_seq(S) holds CastSeq(CastSeq(seq,S)) =
  seq;

theorem 
  H in W & 'not' H in W implies r |/=W;














begin 

definition
  let X be BCI-algebra;
  let x,y be Element of X;
  let m,n be Element of NAT;
  func Polynom (m,n,x,y) -> Element of X equals

  (((x,(x\y)) to_power (m+1)),(y
  \x)) to_power n;
end;

reserve X for BCI-algebra;
reserve x,y,z for Element of X;
reserve
  i,j,k,l,m,n for Element of NAT;
reserve f,g for Function of NAT, the carrier of X;

theorem 
  x <= y & y <= z implies x <= z;

theorem 
  x <= y & y <= x implies x = y;

theorem 
  for X being BCK-algebra,x,y being Element of X holds x\y <= x & (
  x,y) to_power (n+1) <= (x,y) to_power n;

theorem 
  for X being BCK-algebra,x being Element of X holds (0.X,x) to_power n = 0.X;

theorem 
  for X being BCK-algebra,x,y being Element of X st m>=n holds (x,y
  ) to_power m <= (x,y) to_power n;

theorem 
  for X being BCK-algebra, x,y being Element of X st m>n & (x,y)
to_power n = (x,y) to_power m holds for k being Element of NAT st k >=n holds (
  x,y) to_power n = (x,y) to_power k;

theorem 
  Polynom (0,0,x,y) = x\(x\y);

theorem 
  Polynom (m,n,x,y) = (((Polynom (0,0,x,y),(x\y)) to_power m),(y\x)) to_power n
;

theorem 
  Polynom (m+1,n,x,y) = Polynom (m,n,x,y) \ (x\y);

theorem 
  Polynom (m,n+1,x,y) = Polynom (m,n,x,y) \ (y\x);

theorem 
  Polynom (n+1,n+1,y,x) <= Polynom (n,n+1,x,y);

theorem 
  Polynom (n,n+1,x,y) <= Polynom (n,n,y,x);

definition
  let X be BCI-algebra;
  attr X is quasi-commutative means


  ex i,j,m,n being Element of NAT st
  for x,y being Element of X holds Polynom (i,j,x,y) = Polynom (m,n,y,x);
end;

registration
  cluster BCI-EXAMPLE -> quasi-commutative;
end;

registration
  cluster quasi-commutative for BCI-algebra;
end;

definition
  let i,j,m,n be Element of NAT;
  mode BCI-algebra of i,j,m,n -> BCI-algebra means


    for x,y being Element of it holds Polynom (i,j,x,y) = Polynom (m,n,y,x);
end;

theorem 
  X is BCI-algebra of i,j,m,n iff X is BCI-algebra of m,n,i,j;

theorem 
  for X being BCI-algebra of i,j,m,n holds for k being Element of
  NAT holds X is BCI-algebra of i+k,j,m,n+k;

theorem 
  for X being BCI-algebra of i,j,m,n holds for k being Element of NAT
  holds X is BCI-algebra of i,j+k,m+k,n;

registration
  cluster quasi-commutative for BCK-algebra;
end;

registration
  let i,j,m,n be Element of NAT;
  cluster being_BCK-5 for BCI-algebra of i,j,m,n;
end;

definition
  let i,j,m,n be Element of NAT;
  mode BCK-algebra of i,j,m,n is being_BCK-5 BCI-algebra of i,j,m,n;
end;

theorem 
  X is BCK-algebra of i,j,m,n iff X is BCK-algebra of m,n,i,j;

theorem 
  for X being BCK-algebra of i,j,m,n holds for k being Element of
  NAT holds X is BCK-algebra of i+k,j,m,n+k;

theorem 
  for X being BCK-algebra of i,j,m,n holds for k being Element of
  NAT holds X is BCK-algebra of i,j+k,m+k,n;

theorem 
  for X being BCK-algebra of i,j,m,n holds for x,y being Element
  of X holds (x,y) to_power (i+1) = (x,y) to_power (n+1);

theorem 
  for X being BCK-algebra of i,j,m,n holds for x,y being Element
  of X holds (x,y) to_power (j+1) = (x,y) to_power (m+1);

theorem 
  for X being BCK-algebra of i,j,m,n holds X is BCK-algebra of i,j ,j,n;

theorem 
  for X being BCK-algebra of i,j,m,n holds X is BCK-algebra of n,j ,m,n;



definition
  let i,j,m,n;
  func min(i,j,m,n) -> ext-real number equals

  min(min(i,j),min(m,n));
  func max(i,j,m,n) -> ext-real number equals

  max(max(i,j),max(m,n));
end;

theorem 
  min(i,j,m,n) = i or min(i,j,m,n) = j or min(i,j,m,n) = m or min(i,j,m, n) = n
;

theorem 
  max(i,j,m,n) = i or max(i,j,m,n) = j or max(i,j,m,n) = m or max(i,j,m, n) = n
;

theorem 
  i = min(i,j,m,n) implies i<=j & i<=m & i<=n;

theorem 
  max(i,j,m,n) >= i & max(i,j,m,n) >= j & max(i,j,m,n) >= m & max(
  i,j,m,n) >= n;

theorem 
  for X being BCK-algebra of i,j,m,n st i = min(i,j,m,n) holds ( i
  = j implies X is BCK-algebra of i,i,i,i );

theorem 
  for X being BCK-algebra of i,j,m,n st i = min(i,j,m,n) holds ( i < j &
  i < n implies X is BCK-algebra of i,i+1,i,i+1 );

theorem 
  for X being BCK-algebra of i,j,m,n st i = min(i,j,m,n) holds ( i = n &
  i = m implies X is BCK-algebra of i,i,i,i );

theorem 
  for X being BCK-algebra of i,j,m,n st i = n & m < j holds X is
  BCK-algebra of i,m+1,m,i;

theorem 
  for X being BCK-algebra of i,j,m,n st i = n holds X is BCK-algebra of i,j,j,i
;

theorem 
  for X being BCK-algebra of i,j,m,n st l >= j & k >= n holds X is
  BCK-algebra of k,l,l,k;

theorem 
  for X being BCK-algebra of i,j,m,n st k >= max(i,j,m,n) holds X is
  BCK-algebra of k,k,k,k;

theorem 
  for X being BCK-algebra of i,j,m,n st i <= m & j <= n holds X is
  BCK-algebra of i,j,i,j;

theorem 
  for X being BCK-algebra of i,j,m,n holds ( i <= m & i < n implies X is
  BCK-algebra of i,j,i,i+1 );

theorem 
  X is BCI-algebra of i,j,j+k,i+k implies X is BCK-algebra;



theorem 
  X is BCI-algebra of 0,0,0,0 iff X is BCK-algebra of 0,0,0,0;

theorem 
  X is commutative BCK-algebra iff X is BCI-algebra of 0,0,0,0;

notation
  let X be BCI-algebra;
  synonym p-Semisimple-part(X) for AtomSet(X);
end;

reserve B,P for non empty Subset of X;

theorem 
  for X being BCI-algebra st B = BCK-part(X) & P = p-Semisimple-part(X)
  holds B /\ P = {0.X};

theorem 
  for X being BCI-algebra st P = p-Semisimple-part(X) holds (X is
  BCK-algebra iff P = {0.X});

theorem 
  for X being BCI-algebra st B = BCK-part(X) holds (X is p-Semisimple
  BCI-algebra iff B = {0.X});

theorem 
  X is p-Semisimple BCI-algebra implies X is BCI-algebra of 0,1,0, 0;

theorem 
  X is p-Semisimple BCI-algebra implies X is BCI-algebra of n+j,n,m,m+j+ 1;

theorem 
  X is associative BCI-algebra implies X is BCI-algebra of 0,1,0,0 & X
  is BCI-algebra of 1,0,0,0;

theorem 
  X is weakly-positive-implicative BCI-algebra implies X is BCI-algebra
  of 0,1,1,1;

theorem 
  X is positive-implicative BCI-algebra implies X is BCI-algebra of 0,1, 1,1;

theorem 
  X is implicative BCI-algebra implies X is BCI-algebra of 0,1,0,0;

theorem 
  X is alternative BCI-algebra implies X is BCI-algebra of 0,1,0,0;

theorem 
  X is BCK-positive-implicative BCK-algebra iff X is BCK-algebra of 0,1,0,1;

theorem 
  X is BCK-implicative BCK-algebra iff X is BCK-algebra of 1,0,0,0;

registration
  cluster BCK-implicative -> commutative for BCK-algebra;
  cluster BCK-implicative -> BCK-positive-implicative for BCK-algebra;
end;

theorem 
  X is BCK-algebra of 1,0,0,0 iff X is BCK-algebra of 0,0,0,0 & X is
  BCK-algebra of 0,1,0,1;

theorem 
  for X being quasi-commutative BCK-algebra holds (X is BCK-algebra of 0
  ,1,0,1 iff for x,y being Element of X holds x\y = (x\y)\y );

theorem 
  for X being quasi-commutative BCK-algebra holds (X is BCK-algebra of n
  ,n+1,n,n+1 iff for x,y being Element of X holds (x,y) to_power (n+1) = (x,y)
  to_power (n+2) );

theorem 
  X is BCI-algebra of 0,1,0,0 implies X is BCI-commutative BCI-algebra;

theorem 
  X is BCI-algebra of n,0,m,m implies X is BCI-commutative BCI-algebra;

theorem 
  for X being BCK-algebra of i,j,m,n holds ( j = 0 & m > 0 implies X is
  BCK-algebra of 0,0,0,0 );

theorem 
  for X being BCK-algebra of i,j,m,n holds ( m = 0 & j > 0 implies X is
  BCK-algebra of 0,1,0,1 );

theorem 
  for X being BCK-algebra of i,j,m,n holds ( n = 0 & i <> 0 implies X is
  BCK-algebra of 0,0,0,0 );

theorem 
  for X being BCK-algebra of i,j,m,n holds ( i = 0 & n <> 0 implies X is
  BCK-algebra of 0,1,0,1 );














begin 

registration
  let L be Lattice;
  cluster the LattStr of L -> Lattice-like;
end;

theorem 
  for K,L being Lattice st the LattStr of K = the LattStr of L
  holds LattPOSet K = LattPOSet L;

registration
  cluster -> meet-Absorbing for 1-element OrthoLattStr;
end;

registration
  cluster -> lower-bounded for Ortholattice;
  cluster -> upper-bounded for Ortholattice;
end;

reserve L for Ortholattice,
  a, b, c for Element of L;

theorem 
  a "\/" a` = Top L & a "/\" a` = Bottom L;

theorem 
  for L being non empty OrthoLattStr holds L is Ortholattice iff (
for a, b, c being Element of L holds (a "\/" b) "\/" c = (c` "/\" b`)` "\/" a)
  & (for a, b being Element of L holds a = a "/\" (a "\/" b)) & for a, b being
  Element of L holds a = a "\/" (b "/\" b`);

theorem 
  for L being involutive Lattice-like non empty OrthoLattStr
  holds L is de_Morgan iff for a,b being Element of L st a [= b holds b` [= a`;

begin 

definition
  let L be non empty OrthoLattStr;
  attr L is orthomodular means


  for x, y being Element of L st x [= y holds y = x "\/" (x` "/\" y);
end;

registration
  cluster trivial orthomodular modular Boolean for Ortholattice;
end;

theorem 
  for L being modular Ortholattice holds L is orthomodular;

definition
  mode Orthomodular_Lattice is orthomodular Ortholattice;
end;

theorem 
  for L being orthomodular meet-absorbing join-absorbing
join-associative meet-commutative non empty OrthoLattStr, x, y being Element
  of L holds x "\/" (x` "/\" (x "\/" y)) = x "\/" y;

definition
  let L be non empty OrthoLattStr;
  attr L is Orthomodular means


  for x, y being Element of L holds x "\/" (x` "/\" (x "\/" y)) = x "\/" y;
end;

registration
  cluster Orthomodular -> orthomodular for meet-absorbing join-absorbing
    join-associative meet-commutative non empty OrthoLattStr;
  cluster orthomodular -> Orthomodular for meet-absorbing join-absorbing
    join-associative meet-commutative non empty OrthoLattStr;
end;

registration
  cluster modular -> orthomodular for Ortholattice;
end;

registration
  cluster join-Associative meet-Absorbing de_Morgan orthomodular for
Ortholattice;
end;

begin 

definition
  func B_6 -> RelStr equals

  InclPoset { 0, 1, 3 \ 1, 2, 3 \ 2, 3 };
end;

registration
  cluster B_6 -> non empty;
  cluster B_6 -> reflexive transitive antisymmetric;
end;

registration
  cluster B_6 -> with_suprema with_infima;
end;

theorem 
  the carrier of latt B_6 = { 0, 1, 3 \ 1, 2, 3 \ 2, 3 };

theorem 
  for a being set st a in the carrier of latt B_6 holds a c= 3;

definition
  func Benzene -> strict OrthoLattStr means


  the LattStr of it = latt
  B_6 & for x being Element of it, y being Subset of 3 st x = y
  holds (the Compl of it).x = y`;
end;

theorem 
  the carrier of Benzene = { 0, 1, 3 \ 1, 2, 3 \ 2, 3 };

theorem 
  the carrier of Benzene c= bool 3;

theorem 
  for a being set st a in the carrier of Benzene holds a c= {0,1,2
  };

registration
  cluster Benzene -> non empty;
  cluster Benzene -> Lattice-like;
end;

theorem 
  LattPOSet the LattStr of Benzene = B_6;

theorem 
  for a, b being Element of B_6, x, y being Element of Benzene st
  a = x & b = y holds a <= b iff x [= y;

theorem 
  for a, b being Element of B_6, x, y being Element of Benzene st
  a = x & b = y holds a "\/" b = x "\/" y & a "/\" b = x "/\" y;

theorem 
  for a, b being Element of B_6 st a = 3 \ 1 & b = 2 holds a "\/"
  b = 3 & a "/\" b = 0;

theorem 
  for a, b being Element of B_6 st a = 3 \ 2 & b = 1 holds a "\/"
  b = 3 & a "/\" b = 0;

theorem 
  for a, b being Element of B_6 st a = 3 \ 1 & b = 1 holds a "\/"
  b = 3 & a "/\" b = 0;

theorem 
  for a, b being Element of B_6 st a = 3 \ 2 & b = 2 holds a "\/"
  b = 3 & a "/\" b = 0;

theorem 
  for a, b being Element of Benzene st a = 3 \ 1 & b = 2 holds a
  "\/" b = 3 & a "/\" b = 0;

theorem 
  for a, b being Element of Benzene st a = 3 \ 2 & b = 1 holds a "\/" b = 3;

theorem 
  for a, b being Element of Benzene st a = 3 \ 1 & b = 1 holds a "\/" b = 3;

theorem 
  for a, b being Element of Benzene st a = 3 \ 2 & b = 2 holds a "\/" b = 3;

theorem 
  for a being Element of Benzene holds (a = 0 implies a` = 3) & (a
= 3 implies a` = 0) & (a = 1 implies a` = 3\1) & (a = 3\1 implies a` = 1) & (a
  = 2 implies a` = 3\2) & (a = 3\2 implies a` = 2);

theorem 
  for a, b being Element of Benzene holds a [= b iff a c= b;

theorem 
  for a, x being Element of Benzene st a = 0 holds a "/\" x = a;

theorem 
  for a, x being Element of Benzene st a = 0 holds a "\/" x = x;

theorem 
  for a, x being Element of Benzene st a = 3 holds a "\/" x = a;

registration
  cluster Benzene -> lower-bounded;
  cluster Benzene -> upper-bounded;
end;

theorem 
  Top Benzene = 3;

theorem 
  Bottom Benzene = 0;

registration
  cluster Benzene -> involutive with_Top de_Morgan;
  cluster Benzene -> non orthomodular;
end;

begin 

definition
  let L be Ortholattice, a,b be Element of L;
  pred a, b are_orthogonal means


  a [= b`;
end;

notation
  let L be Ortholattice, a,b be Element of L;
  synonym a _|_ b for a, b are_orthogonal;
end;

theorem 
  a _|_ a iff a = Bottom L;

definition
  let L be Ortholattice;
  let a, b be Element of L;
  redefine pred a,b are_orthogonal;
  symmetry;
end;

theorem 
  a _|_ b & a _|_ c implies a _|_ (b "/\" c) & a _|_ (b "\/" c);

begin 

theorem 
  L is orthomodular iff for a,b being Element of L st b` [= a & a "/\" b
  = Bottom L holds a = b`;

theorem 
  L is orthomodular iff for a,b being Element of L st a _|_ b & a "\/" b
  = Top L holds a = b`;

theorem 
  L is orthomodular iff for a,b being Element of L st b [= a holds
  a "/\" (a` "\/" b) = b;

theorem 
  L is orthomodular iff for a,b holds a "/\" (a` "\/" (a "/\" b)) = a "/\" b;

theorem 
  L is orthomodular iff for a,b being Element of L holds a "\/" b
  = ((a "\/" b) "/\" a) "\/" ((a "\/" b) "/\" a`);

theorem 
  L is orthomodular iff for a,b st a [= b holds (a "\/" b) "/\" (b "\/"
  a`) = (a "/\" b) "\/" (b "/\" a`);


theorem 
  for L being non empty OrthoLattStr holds L is Orthomodular_Lattice iff
(for a, b, c being Element of L holds (a "\/" b) "\/" c = (c` "/\" b`)` "\/" a)
& (for a, b,c being Element of L holds a "\/" b = ((a "\/" b) "/\" (a "\/" c))
  "\/" ((a "\/" b) "/\" a`)) & for a, b being Element of L holds a = a "\/" (b
  "/\" b`);

reserve L for join-Associative meet-Absorbing de_Morgan orthomodular
  Lattice-like non empty OrthoLattStr;
reserve v0,v1,v2,v64,v65 for Element of L;

registration
  cluster -> with_Top for
join-Associative meet-Absorbing de_Morgan orthomodular
    Lattice-like non empty OrthoLattStr;
end;

theorem 
  for L being non empty OrthoLattStr holds L is Orthomodular_Lattice iff
  L is join-Associative meet-Absorbing de_Morgan Orthomodular;














begin 

theorem 
  for k,l,m being Nat holds (k(#)(l GeoSeq))|m is XFinSequence of NAT;

theorem 
  for d being XFinSequence of NAT, n being Nat st for i being Nat
  st i in dom d holds n divides d.i holds n divides Sum d;

theorem 
  for d,e being XFinSequence of NAT, n being Nat st dom d = dom e &
  for i being Nat st i in dom d holds e.i = d.i mod n holds Sum d mod n = Sum e
  mod n;

begin 

definition
  let d be XFinSequence of NAT;
  let b be Nat;
  func value(d,b) -> Nat means


  ex d9 being XFinSequence of NAT st (dom
  d9 = dom d & for i being Nat st i in dom d9 holds d9.i = (d.i)*(b|^i)) & it =
  Sum d9;
end;

definition
  let n,b be Nat;
  assume
 b>1;

  func digits(n,b) -> XFinSequence of NAT means


  value(it,b)=n & it.(len
  (it)-1) <> 0 & for i being Nat st i in dom it holds 0 <= it.i & it.i < b if n
  <> 0 otherwise it = <%0%>;
end;

theorem 
  for n,b being Nat st b > 1 holds len digits(n,b) >= 1;

theorem 
  for n,b being Nat st b > 1 holds value(digits(n,b),b)=n;

begin 

theorem 
  for n,k being Nat st k=10|^n - 1 holds 9 divides k;

theorem 
  for n,b being Nat st b>1 holds b divides n iff digits(n,b).0 = 0;

theorem 
  for n being Nat holds 2 divides n iff 2 divides digits(n,10).0;


theorem 
  for n being Nat holds 3 divides n iff 3 divides Sum digits(n,10);

theorem 
  for n being Nat holds 5 divides n iff 5 divides digits(n,10).0;














begin 

reserve i,j,m,n,k for Nat,
  x,y for set,
  K for Field,
  a for Element of K;

theorem 
  for A,B be Matrix of K for nt be Element of n-tuples_on NAT, mt
be Element of m-tuples_on NAT st [:rng nt,rng mt:] c= Indices A holds Segm(A+B,
  nt,mt) = Segm(A,nt,mt) + Segm(B,nt,mt);

theorem 
  for P be without_zero finite Subset of NAT st P c= Seg n holds
  Segm(1.(K,n),P,P) = 1.(K,card P);

theorem 
  for A,B be Matrix of K for P, Q be without_zero finite Subset of
  NAT st [:P,Q:] c= Indices A holds Segm(A+B,P,Q) = Segm(A,P,Q) + Segm(B,P,Q);

theorem 
  for A,B be Matrix of n,K st i in Seg n & j in Seg n holds Delete(
  A+B,i,j)=Delete(A,i,j) + Delete(B,i,j);

theorem 
  for A be Matrix of n,K st i in Seg n & j in Seg n holds Delete(a*
  A,i,j)=a*Delete(A,i,j);

theorem 
  i in Seg n implies Delete(1.(K,n),i,i)=1.(K,n-'1);

theorem 
  for A,B be Matrix of n,K ex P be Polynomial of K st len P <= n+1
  & for x be Element of K holds eval(P,x) = Det(A+x*B);



theorem 
  for A be Matrix of n,K ex P be Polynomial of K st len P = n+1 &
  for x be Element of K holds eval(P,x) = Det(A+x*1.(K,n));

registration
  let K;
  cluster non trivial finite-dimensional for VectSp of K;
end;

begin 

definition
  let R be non empty doubleLoopStr;
  let V be non empty VectSpStr over R;
  let IT be Function of V,V;
  attr IT is with_eigenvalues means


  ex v be Vector of V, a be Scalar of R st v <> 0.V & IT.v = a*v;
end;

reserve V for non trivial VectSp of K,
  V1,V2 for VectSp of K,
  f for linear-transformation of V1,V1,
  v,w for Vector of V,
  v1 for Vector of V1,
  L for Scalar of K;

registration
  let K,V;
  cluster with_eigenvalues for linear-transformation of V,V;
end;

definition
  let R be non empty doubleLoopStr;
  let V be non empty VectSpStr over R;
  let f be Function of V,V such that
 f is with_eigenvalues;
  mode eigenvalue of f -> Element of R means


    ex v be Vector of V st v <> 0.V & f.v = it * v;
end;

definition
  let R be non empty doubleLoopStr;
  let V be non empty VectSpStr over R;
  let f be Function of V,V;
  let L be Scalar of R such that
 f is with_eigenvalues & L is eigenvalue of f;
  mode eigenvector of f,L -> Vector of V means


    f.it = L * it;
end;

theorem 
  for a st a <> 0.K for f be with_eigenvalues Function of V,V for L be
eigenvalue of f holds a*f is with_eigenvalues & a*L is eigenvalue of a*f & ( w
  is eigenvector of f,L iff w is eigenvector of a*f,a*L );

theorem 
  for f1,f2 be with_eigenvalues Function of V,V for L1,L2 be Scalar of K
  st L1 is eigenvalue of f1 & L2 is eigenvalue of f2 & ex v st v is eigenvector
of f1,L1 & v is eigenvector of f2,L2 & v<>0.V holds f1+f2 is with_eigenvalues &
  L1+L2 is eigenvalue of f1+f2 & for w st w is eigenvector of f1,L1 & w is
  eigenvector of f2,L2 holds w is eigenvector of f1+f2,L1+L2;

theorem 
  id V is with_eigenvalues & 1_K is eigenvalue of id V & for v
  holds v is eigenvector of id V,1_K;

theorem 
  for L be eigenvalue of id V holds L = 1_K;

theorem 
  ker f is non trivial implies f is with_eigenvalues & 0.K is eigenvalue of f;

theorem 
  f is with_eigenvalues & L is eigenvalue of f iff ker (f+(-L)*id
  V1) is non trivial;

theorem 
  for V1 be finite-dimensional VectSp of K, b1,b19 be OrdBasis of
  V1 for f be linear-transformation of V1,V1 holds f is with_eigenvalues & L is
  eigenvalue of f iff Det AutEqMt(f+(-L)*id V1,b1,b19) =0.K;

theorem 
  for K be algebraic-closed Field, V1 be non trivial finite-dimensional
  VectSp of K, f be linear-transformation of V1,V1 holds f is with_eigenvalues;

theorem 
  for f,L st f is with_eigenvalues & L is eigenvalue of f holds v1
  is eigenvector of f,L iff v1 in ker (f+(-L)*id V1);

definition
  let S be 1-sorted;
  let F be Function of S,S;
  let n be Nat;
  func F |^ n -> Function of S,S means


  for F9 be Element of GFuncs the
  carrier of S st F9=F holds it = Product(n|-> F9);
end;

reserve S for 1-sorted,
  F for Function of S,S;

theorem 
  F |^ 0 = id S;

theorem 
  F |^ 1 = F;

theorem 
  F |^(i+j) = (F |^ j) * (F |^ i);

theorem 
  for s1,s2 be Element of S,n,m st (F|^m).s1 = s2 & (F|^n).s2 = s2 holds
  (F|^(m+i*n)).s1 = s2;

theorem 
  for K be add-associative right_zeroed right_complementable Abelian
  associative well-unital distributive non empty doubleLoopStr, V1 be Abelian
  add-associative right_zeroed right_complementable vector-distributive
  scalar-distributive scalar-associative scalar-unital
   non empty
  VectSpStr over K for W be Subspace of V1, f be Function of V1,V1, fW be
  Function of W,W st fW=f|W holds (f|^n)|W=fW|^n;

registration
  let K,V1;
  let f be linear-transformation of V1,V1;
  let n be Nat;
  cluster f |^ n ->  homogeneous additive;
end;

theorem 
  (f|^i).v1 = 0.V1 implies (f|^(i+j)).v1=0.V1;

begin 

definition
  let K,V1,f;
  func UnionKers f -> strict Subspace of V1 means


  the carrier of it = { v where v is Vector of V1:ex n st (f|^n).v = 0.V1};
end;

theorem 
  v1 in UnionKers f iff ex n st (f|^n).v1 = 0.V1;

theorem 
  ker (f|^i) is Subspace of UnionKers f;

theorem 
  ker (f|^i) is Subspace of ker (f|^(i+j));

theorem 
  for V be finite-dimensional VectSp of K,f be linear-transformation of
  V,V ex n st UnionKers f = ker (f|^n);

theorem 
  f|ker (f|^n) is linear-transformation of ker (f|^n),ker (f|^n);

theorem 
  f|ker ((f+L*id V1)|^n) is linear-transformation of ker ((f+L*id V1)|^n
  ), ker ((f+L*id V1)|^n);

theorem 
  f|(UnionKers f) is linear-transformation of UnionKers f, UnionKers f;

theorem 
  f|(UnionKers (f+L*id V1)) is linear-transformation of UnionKers
  (f+L*id V1), UnionKers (f+L*id V1);

theorem 
  f|im (f|^n) is linear-transformation of im (f|^n),im (f|^n);

theorem 
  f|im ((f+L*id V1)|^n) is linear-transformation of im ((f+L*id V1)|^n),
  im ((f+L*id V1)|^n);

theorem 
  UnionKers f = ker (f|^n) implies ker (f|^n) /\ im (f|^n) = (0). V1;

theorem 
  for V be finite-dimensional VectSp of K, f be linear-transformation of
V,V,n st UnionKers f = ker (f|^n) holds V is_the_direct_sum_of ker (f|^n),im (f
  |^n);

theorem 
  for I be Linear_Compl of UnionKers f holds f|I is one-to-one;

theorem 
  for I be Linear_Compl of UnionKers (f+(-L)*id V1), fI be
  linear-transformation of I,I st fI = f|I for v be Vector of I st fI.v = L * v
  holds v = 0.V1;

theorem 
  n >= 1 implies ex h be linear-transformation of V1,V1 st (f + L*
id V1) |^ n = f * h + ((L*id V1) |^ n) & for i holds (f |^ i) * h = h * (f |^ i
  );

theorem 
  for L1,L2 be Scalar of K st f is with_eigenvalues & L1 <> L2 & L2 is
  eigenvalue of f for I be Linear_Compl of UnionKers (f+(-L1)*id V1), fI be
linear-transformation of I,I st fI = f|I holds fI is with_eigenvalues & not L1
  is eigenvalue of fI & L2 is eigenvalue of fI & UnionKers (f+(-L2)*id V1) is
  Subspace of I;



theorem 
  for U be finite Subset of V1 st U is linearly-independent for u be
Vector of V1 st u in U for L be Linear_Combination of U\{u} holds card U=card (
  U\{u}\/{u+Sum(L)}) & U\{u}\/{u+Sum(L)} is linearly-independent;

theorem 
  for A be Subset of V1 for L be Linear_Combination of V2, f be
linear-transformation of V1,V2 st Carrier L c= f.:A ex M be Linear_Combination
  of A st f.(Sum M)=Sum L;

theorem 
  for f be linear-transformation of V1,V2 for A be Subset of V1,B be
Subset of V2 st f.:A = B holds f.:(the carrier of Lin A) = the carrier of Lin B
;

theorem 
  for L be Linear_Combination of V1, F be FinSequence of V1, f be
linear-transformation of V1,V2 st f|(Carrier L /\ rng F) is one-to-one & rng F
c= Carrier L ex Lf be Linear_Combination of V2 st Carrier Lf = f.:(Carrier L /\
rng F) & f*(L(#)F) = Lf(#)(f*F) & for v1 st v1 in Carrier L /\ rng F holds L.v1
  =Lf.(f.v1);

theorem 
  for A,B be Subset of V1 for L be Linear_Combination of V1 st Carrier L
c= A\/B & Sum L = 0.V1 for f be additive homogeneous Function of V1,V2
st f|B is one-to-one &
f.:B is linearly-independent Subset of V2 & f.:A c= {0.V2} holds Carrier L c= A
;














begin 

reserve i,j,m,n,k for Nat,
  x,y for set,
  K for Field,
  a,L for Element of K;

definition
  let K,L,n;
  func Jordan_block(L,n) -> Matrix of K means


  len it = n & width it = n
& for i,j st [i,j] in Indices it holds ( i = j implies it*(i,j) = L ) & ( i+1 =
  j implies it*(i,j) = 1_K ) & (i<>j & i+1<>j implies it*(i,j) = 0.K );
end;

definition
  let K,L,n;
  redefine func Jordan_block(L,n) -> Upper_Triangular_Matrix of n,K;
end;

theorem 
  diagonal_of_Matrix Jordan_block(L,n) = n |-> L;

theorem 
  Det Jordan_block(L,n) = power(K).(L,n);

theorem 
  Jordan_block(L,n) is invertible iff n = 0 or L <> 0.K;

theorem 
  i in Seg n & i<>n implies Line(Jordan_block(L,n),i) = L*Line(1.(K
  ,n),i)+Line(1.(K,n),i+1);

theorem 
  Line(Jordan_block(L,n),n) = L*Line(1.(K,n),n);

theorem 
  for F be Element of n-tuples_on the carrier of K st i in Seg n
holds ( i <> n implies Line(Jordan_block(L,n),i) "*" F = L * (F/.i)+ F/.(i+1))&
  ( i = n implies Line(Jordan_block(L,n),i) "*" F = L * (F/.i));

theorem 
  for F be Element of n-tuples_on the carrier of K st i in Seg n
holds ( i = 1 implies Col(Jordan_block(L,n),i) "*" F = L * (F/.i) ) & ( i <> 1
  implies Col(Jordan_block(L,n),i) "*" F = L * (F/.i)+F/.(i-1) );

theorem 
  L <> 0.K implies ex M be Matrix of n,K st Jordan_block(L,n)~ = M & for
i,j st [i,j] in Indices M holds (i > j implies M*(i,j) = 0.K) & (i <= j implies
  M*(i,j) = - power(K).(-L",j-'i+1));

theorem 
  Jordan_block(L,n) + a*1.(K,n)=Jordan_block(L+a,n);

begin 

definition
  let K;
  let G be FinSequence of (the carrier of K)**;
  attr G is Jordan-block-yielding means


  for i st i in dom G ex L,n st G .i = Jordan_block(L,n);
end;

registration
  let K;
  cluster Jordan-block-yielding for FinSequence of (the carrier of K)**;
end;

registration
  let K;
  cluster Jordan-block-yielding -> Square-Matrix-yielding for
FinSequence of (the
    carrier of K)**;
end;

definition
  let K;
  mode FinSequence_of_Jordan_block of K is Jordan-block-yielding FinSequence
    of (the carrier of K)**;
end;

definition
  let K,L;
  mode FinSequence_of_Jordan_block of L,K -> FinSequence_of_Jordan_block of K
    means


    for i st i in dom it ex n st it.i = Jordan_block(L,n);
end;

theorem 
  {} is FinSequence_of_Jordan_block of L,K;

theorem 
  <*Jordan_block(L,n)*> is FinSequence_of_Jordan_block of L,K;

registration
  let K,L;
  cluster non-empty for FinSequence_of_Jordan_block of L,K;
end;

registration
  let K;
  cluster non-empty for FinSequence_of_Jordan_block of K;
end;

theorem 
  for J be FinSequence_of_Jordan_block of L,K holds J (+) mlt(len
  J|->a,1.(K,Len J)) is FinSequence_of_Jordan_block of (L+a),K;

definition
  let K;
  let J1,J2 be FinSequence_of_Jordan_block of K;
  redefine func J1^J2 -> FinSequence_of_Jordan_block of K;
end;

definition
  let K;
  let n;
  let J be FinSequence_of_Jordan_block of K;
  redefine func J|n -> FinSequence_of_Jordan_block of K;
  redefine func J/^n -> FinSequence_of_Jordan_block of K;
end;

definition
  let K,L;
  let J1,J2 be FinSequence_of_Jordan_block of L,K;
  redefine func J1^J2 -> FinSequence_of_Jordan_block of L,K;
end;

definition
  let K,L;
  let n;
  let J be FinSequence_of_Jordan_block of L,K;
  redefine func J|n -> FinSequence_of_Jordan_block of L,K;
  redefine func J/^n -> FinSequence_of_Jordan_block of L,K;
end;

begin 

definition
  let K be doubleLoopStr;
  let V be non empty VectSpStr over K;
  let f be Function of V,V;
  attr f is nilpotent means


  ex n st for v be Vector of V holds (f|^n).v =0.V;
end;

theorem 
  for K be doubleLoopStr for V be non empty VectSpStr over K for f
  be Function of V,V holds f is nilpotent iff ex n st f|^n = ZeroMap(V,V);

registration
  let K be doubleLoopStr;
  let V be non empty VectSpStr over K;
  cluster nilpotent for Function of V,V;
end;

registration
  let R be Ring;
  let V be LeftMod of R;
  cluster nilpotent additive homogeneous for Function of V,V;
end;

theorem 
  for V be VectSp of K,f be linear-transformation of V,V holds f|
  ker (f|^n) is nilpotent linear-transformation of ker (f|^n),ker (f|^n);

definition
  let K be doubleLoopStr;
  let V be non empty VectSpStr over K;
  let f be nilpotent Function of V,V;
  func degree_of_nilpotent f -> Nat means


  f|^it = ZeroMap(V,V) & for k st f|^k = ZeroMap(V,V) holds it <= k;
end;

notation
  let K be doubleLoopStr;
  let V be non empty VectSpStr over K;
  let f be nilpotent Function of V,V;
  synonym deg f for degree_of_nilpotent f;
end;

theorem 
  for K be doubleLoopStr for V be non empty VectSpStr over K for f
  be nilpotent Function of V,V holds deg f = 0 iff [#]V = {0.V};

theorem 
  for K be doubleLoopStr for V be non empty VectSpStr over K for f
be nilpotent Function of V,V ex v be Vector of V st for i st i < deg f holds (f
  |^i).v <> 0.V;

theorem 
  for K be Field, V be VectSp of K, W be Subspace of V for f be
  nilpotent Function of V,V st f|W is Function of W,W holds f|W is nilpotent
  Function of W,W;

theorem 
  for K be Field, V be VectSp of K, W be Subspace of V for f be
nilpotent linear-transformation of V,V, fI be nilpotent Function of im (f|^n),
  im (f|^n) st fI = f|im (f|^n) & n <= deg f holds deg fI + n = deg f;

reserve V1,V2 for finite-dimensional VectSp of K,
  W1,W2 for Subspace of V1,
  U1 ,U2 for Subspace of V2,
  b1 for OrdBasis of V1,
  B1 for FinSequence of V1,
  b2 for OrdBasis of V2,
  B2 for FinSequence of V2,
  bw1 for OrdBasis of W1,
  bw2 for OrdBasis of W2,
  Bu1 for FinSequence of U1,
  Bu2 for FinSequence of U2;

theorem 
  for M be Matrix of len b1,len B2,K, M1 be Matrix of len bw1,len
Bu1,K, M2 be Matrix of len bw2,len Bu2,K st b1 = bw1 ^ bw2 & B2 = Bu1 ^ Bu2 & M
= block_diagonal(<*M1,M2*>,0.K) & width M1 = len Bu1 & width M2 = len Bu2 holds
(i in dom bw1 implies Mx2Tran(M,b1,B2).(b1/.i) = Mx2Tran(M1,bw1,Bu1).(bw1/.i))&
(i in dom bw2 implies Mx2Tran(M,b1,B2).(b1/.(i+len bw1)) = Mx2Tran(M2,bw2,Bu2).
  (bw2/.i));

theorem 
  for M be Matrix of len b1,len B2,K, F be FinSequence_of_Matrix
  of K st M = block_diagonal(F,0.K) for i,m st i in dom b1 & m = min(Len F,i)
holds Mx2Tran(M,b1,B2).(b1/.i) = Sum lmlt(Line(F.m,i-'Sum (Len F| (m-'1))),
(B2|Sum(Width F|m))/^Sum (Width F| (m-'1))) & len ((B2|Sum(Width F|m))/^
Sum (Width F| (m-'1))) = width (F.m);

theorem 
  len B1 in dom B1 implies Sum lmlt (Line(Jordan_block(L,len B1),
  len B1),B1)= L*(B1/.(len B1));

theorem 
  i in dom B1 & i <> len B1 implies Sum lmlt (Line(Jordan_block(L,
  len B1),i),B1)= L*(B1/.i)+B1/.(i+1);

theorem 
  for M be Matrix of len b1,len B2,K st M = Jordan_block(L,n) for
i st i in dom b1 holds (i = len b1 implies Mx2Tran(M,b1,B2).(b1/.i) = L*(B2/.i)
  ) & (i <> len b1 implies Mx2Tran(M,b1,B2).(b1/.i) = L*(B2/.i)+ B2/.(i+1));

theorem 
  for J be FinSequence_of_Jordan_block of L,K for M be Matrix of
len b1,len B2,K st M = block_diagonal(J,0.K) for i,m st i in dom b1 & m = min(
Len J,i) holds (i = Sum (Len J|m) implies Mx2Tran(M,b1,B2).(b1/.i) = L*(B2/.i))
& (i <> Sum (Len J|m) implies Mx2Tran(M,b1,B2).(b1/.i) = L*(B2/.i)+ B2/.(i+1));

theorem 
  for J be FinSequence_of_Jordan_block of 0.K,K for M be Matrix of
len b1,len b1,K st M = block_diagonal(J,0.K) for m st for i st i in dom J holds
  len (J.i) <= m holds Mx2Tran(M,b1,b1) |^ m = ZeroMap(V1,V1);

theorem 
  for J be FinSequence_of_Jordan_block of L,K for M be Matrix of len b1,
  len b1,K st M = block_diagonal(J,0.K) holds Mx2Tran(M,b1,b1) is nilpotent iff
  len b1 = 0 or L = 0.K;

theorem 
  for J be FinSequence_of_Jordan_block of 0.K,K for M be Matrix of len
  b1,len b1,K st M = block_diagonal(J,0.K) & len b1 > 0 for F be nilpotent
Function of V1,V1 st F = Mx2Tran(M,b1,b1) holds (ex i st i in dom J & len (J.i)
  = deg F) & for i st i in dom J holds len (J.i) <= deg F;

theorem 
  for V1,V2,b1,b2,L st len b1 = len b2 for F be
linear-transformation of V1,V2 st for i st i in dom b1 holds F.(b1/.i) = L * (
b2/.i) or i+1 in dom b1 & F.(b1/.i) = L * (b2/.i) +b2/.(i+1) ex J be non-empty
  FinSequence_of_Jordan_block of L,K st AutMt(F,b1,b2) = block_diagonal(J,0.K);

theorem 
  for V1 be finite-dimensional VectSp of K for F be nilpotent
linear-transformation of V1,V1 ex J be non-empty FinSequence_of_Jordan_block of
  0.K,K, b1 be OrdBasis of V1 st AutMt(F,b1,b1) = block_diagonal(J,0.K);

theorem 
  for V be VectSp of K for F be linear-transformation of V,V, V1
be finite-dimensional Subspace of V, F1 be linear-transformation of V1,V1 st V1
  = ker ((F+(-L)*id V) |^n) & F|V1=F1 ex J be non-empty
  FinSequence_of_Jordan_block of L,K, b1 be OrdBasis of V1 st AutMt(F1,b1,b1) =
  block_diagonal(J,0.K);

begin 

theorem 
  for K be algebraic-closed Field for V be non trivial
  finite-dimensional VectSp of K, F be linear-transformation of V,V ex J be
non-empty (FinSequence_of_Jordan_block of K), b1 be OrdBasis of V st AutMt(F,b1
,b1) = block_diagonal(J,0.K) & for L be Scalar of K holds L is eigenvalue of F
  iff ex i st i in dom J & J.i = Jordan_block(L,len (J.i));


theorem 
  for K be algebraic-closed Field, M be Matrix of n,K ex J be non-empty
(FinSequence_of_Jordan_block of K), P be Matrix of n,K st Sum Len J = n & P is
  invertible & M = P * block_diagonal(J,0.K) * (P~);















begin 

reserve a,b,r,g for Element of REAL;

theorem 
  for a,b,g1,M be real number st a < b & 0 < g1 & 0 < M holds ex r
  st a < r & r < b & (b - r)*M < g1;

theorem 
  for a,b,g1,M be real number st a < b & 0 < g1 & 0 < M holds ex r
  st a < r & r < b & (r - a)*M < g1;

theorem 
  exp_R.b - exp_R.a = integral(exp_R,a,b);

begin 

definition
  let f be PartFunc of REAL,REAL;
  let a,b be Real;
  pred f is_right_ext_Riemann_integrable_on a,b means


  (for d be Real st
  a <= d & d < b holds f is_integrable_on [' a,d '] & f|[' a,d '] is bounded) &
ex Intf be PartFunc of REAL,REAL st dom Intf = [.a,b.[ & (for x be Real st x in
  dom Intf holds Intf.x = integral(f,a,x)) & Intf is_left_convergent_in b;
end;

definition
  let f be PartFunc of REAL,REAL;
  let a,b be Real;
  pred f is_left_ext_Riemann_integrable_on a,b means


  (for d be Real st
  a < d & d <= b holds f is_integrable_on [' d,b '] & f|[' d,b '] is bounded) &
ex Intf be PartFunc of REAL,REAL st dom Intf = ].a,b.] & (for x be Real st x in
  dom Intf holds Intf.x = integral(f,x,b)) & Intf is_right_convergent_in a;
end;

definition
  let f be PartFunc of REAL,REAL;
  let a,b be Real;
  assume
 f is_right_ext_Riemann_integrable_on a,b;
  func ext_right_integral(f,a,b) -> Real means


  ex Intf be PartFunc of
REAL,REAL st dom Intf = [.a,b.[ & (for x be Real st x in dom Intf holds Intf.x
  = integral(f,a,x)) & Intf is_left_convergent_in b & it = lim_left(Intf,b);
end;

definition
  let f be PartFunc of REAL,REAL;
  let a,b be Real;
  assume
 f is_left_ext_Riemann_integrable_on a,b;
  func ext_left_integral(f,a,b) -> Real means


  ex Intf be PartFunc of
REAL,REAL st dom Intf = ].a,b.] & (for x be Real st x in dom Intf holds Intf.x
  = integral(f,x,b)) & Intf is_right_convergent_in a & it = lim_right(Intf,a);
end;

definition
  let f be PartFunc of REAL,REAL;
  let a be real number;
  pred f is_+infty_ext_Riemann_integrable_on a means


  (for b be Real st
  a <= b holds f is_integrable_on [' a,b '] & f|[' a,b '] is bounded) & ex Intf
  be PartFunc of REAL,REAL st dom Intf = right_closed_halfline(a) & (for x be
  Real st x in dom Intf holds Intf.x = integral(f,a,x)) & Intf is
  convergent_in+infty;
end;

definition
  let f be PartFunc of REAL,REAL;
  let b be real number;
  pred f is_-infty_ext_Riemann_integrable_on b means


  (for a be Real st
  a <= b holds f is_integrable_on [' a,b '] & f|[' a,b '] is bounded) & ex Intf
be PartFunc of REAL,REAL st dom Intf = left_closed_halfline(b) & (for x be Real
st x in dom Intf holds Intf.x = integral(f,x,b)) & Intf is convergent_in-infty;
end;

definition
  let f be PartFunc of REAL,REAL;
  let a be real number;
  assume
 f is_+infty_ext_Riemann_integrable_on a;
  func infty_ext_right_integral(f,a) -> Real means


  ex Intf be PartFunc
  of REAL,REAL st dom Intf = right_closed_halfline(a) & (for x be Real st x in
  dom Intf holds Intf.x = integral(f,a,x)) & Intf is convergent_in+infty & it =
  lim_in+infty Intf;
end;

definition
  let f be PartFunc of REAL,REAL;
  let b be real number;
  assume
 f is_-infty_ext_Riemann_integrable_on b;
  func infty_ext_left_integral(f,b) -> Real means


  ex Intf be PartFunc
of REAL,REAL st dom Intf = left_closed_halfline(b) & (for x be Real st x in dom
  Intf holds Intf.x = integral(f,x,b)) & Intf is convergent_in-infty & it =
  lim_in-infty Intf;
end;

definition
  let f be PartFunc of REAL,REAL;
  attr f is infty_ext_Riemann_integrable means

  f
is_+infty_ext_Riemann_integrable_on 0 & f is_-infty_ext_Riemann_integrable_on 0
  ;
end;

definition
  let f be PartFunc of REAL,REAL;
  func infty_ext_integral(f) -> Real equals

  infty_ext_right_integral(f,0) +
  infty_ext_left_integral(f,0);
end;

begin 

theorem 
  for f,g be PartFunc of REAL,REAL, a,b be Real st a < b & [' a,b '] c=
  dom f & [' a,b '] c= dom g & f is_right_ext_Riemann_integrable_on a,b & g
  is_right_ext_Riemann_integrable_on a,b holds f + g
  is_right_ext_Riemann_integrable_on a,b & ext_right_integral(f + g,a,b) =
  ext_right_integral(f,a,b) + ext_right_integral(g,a,b);

theorem 
  for f be PartFunc of REAL,REAL, a,b be Real st a < b & [' a,b '] c=
dom f & f is_right_ext_Riemann_integrable_on a,b holds for r be Real holds r(#)
  f is_right_ext_Riemann_integrable_on a,b & ext_right_integral(r(#)f,a,b) = r*
  ext_right_integral(f,a,b);

theorem 
  for f,g be PartFunc of REAL,REAL, a,b be Real st a < b & [' a,b '] c=
  dom f & [' a,b '] c= dom g & f is_left_ext_Riemann_integrable_on a,b & g
  is_left_ext_Riemann_integrable_on a,b holds f + g
  is_left_ext_Riemann_integrable_on a,b & ext_left_integral(f + g,a,b) =
  ext_left_integral(f,a,b) + ext_left_integral(g,a,b);

theorem 
  for f be PartFunc of REAL,REAL, a,b be Real st a < b & [' a,b '] c=
dom f & f is_left_ext_Riemann_integrable_on a,b holds for r be Real holds r(#)f
  is_left_ext_Riemann_integrable_on a,b & ext_left_integral(r(#)f,a,b) = r*
  ext_left_integral(f,a,b);

theorem 
  for f,g be PartFunc of REAL,REAL, a be real number st
  right_closed_halfline(a) c= dom f & right_closed_halfline(a) c= dom g & f
is_+infty_ext_Riemann_integrable_on a & g is_+infty_ext_Riemann_integrable_on a
holds f + g is_+infty_ext_Riemann_integrable_on a & infty_ext_right_integral(f
  + g,a) = infty_ext_right_integral(f,a) + infty_ext_right_integral(g,a);

theorem 
  for f be PartFunc of REAL,REAL, a be real number st
  right_closed_halfline(a) c= dom f & f is_+infty_ext_Riemann_integrable_on a
  holds for r be Real holds r(#)f is_+infty_ext_Riemann_integrable_on a &
  infty_ext_right_integral(r(#)f,a) = r*infty_ext_right_integral(f,a);

theorem 
  for f,g be PartFunc of REAL,REAL, b be real number st
  left_closed_halfline(b) c= dom f & left_closed_halfline(b) c= dom g & f
is_-infty_ext_Riemann_integrable_on b & g is_-infty_ext_Riemann_integrable_on b
holds f + g is_-infty_ext_Riemann_integrable_on b & infty_ext_left_integral(f +
  g,b) = infty_ext_left_integral(f,b) + infty_ext_left_integral(g,b);

theorem 
  for f be PartFunc of REAL,REAL, b be real number st
  left_closed_halfline(b) c= dom f & f is_-infty_ext_Riemann_integrable_on b
  holds for r be Real holds r(#)f is_-infty_ext_Riemann_integrable_on b &
  infty_ext_left_integral(r(#)f,b) = r*infty_ext_left_integral(f,b);

theorem 
  for f be PartFunc of REAL,REAL, a,b be Real st a < b & [' a,b '] c=
  dom f & f is_integrable_on [' a,b '] & f|[' a,b '] is bounded holds
  ext_right_integral(f,a,b) = integral(f,a,b);

theorem 
  for f be PartFunc of REAL,REAL, a,b be Real st a < b & [' a,b '] c=
  dom f & f is_integrable_on [' a,b '] & f|[' a,b '] is bounded holds
  ext_left_integral(f,a,b) = integral(f,a,b);

begin 

definition
  let s be real number;
  func exp*- s -> Function of REAL,REAL means

  for t be Real holds it.t = exp_R .(-s*t);
end;

definition
  let f be PartFunc of REAL,REAL;
  func One-sided_Laplace_transform(f) -> PartFunc of REAL,REAL means


  dom it = right_open_halfline(0) & for s be Real st s in dom it holds it.s =
  infty_ext_right_integral(f(#)(exp*-s),0);
end;

begin 

theorem 
  for f, g be PartFunc of REAL,REAL st dom f = right_closed_halfline(0)
& dom g = right_closed_halfline(0) & (for s be Real st s in right_open_halfline
(0) holds f(#)(exp*-s) is_+infty_ext_Riemann_integrable_on 0) & (for s be Real
  st s in right_open_halfline(0) holds g(#)(exp*-s)
  is_+infty_ext_Riemann_integrable_on 0) holds (for s be Real st s in
  right_open_halfline(0) holds (f + g)(#)(exp*-s)
  is_+infty_ext_Riemann_integrable_on 0) & One-sided_Laplace_transform(f + g) =
  One-sided_Laplace_transform(f) + One-sided_Laplace_transform(g);

theorem 
  for f be PartFunc of REAL,REAL, a be Real st dom f =
right_closed_halfline(0) & (for s be Real st s in right_open_halfline(0) holds
  f(#)(exp*-s) is_+infty_ext_Riemann_integrable_on 0) holds (for s be Real st s
  in right_open_halfline(0) holds (a(#)f)(#)(exp*-s)
is_+infty_ext_Riemann_integrable_on 0) & One-sided_Laplace_transform(a(#)f) = a
  (#)One-sided_Laplace_transform(f);














begin 

reserve x,x0,x1,x2,y,y0,y1,y2,r,r1,s,p,p1 for Real;
reserve z,z0 for Element of REAL 2;
reserve n,m,k for Element of NAT;
reserve Z for Subset of REAL 2;
reserve s1 for Real_Sequence;
reserve f,f1,f2 for PartFunc of REAL 2,REAL;
reserve R,R1,R2 for RestFunc;
reserve L,L1,L2 for LinearFunc;

theorem 
  dom proj(1,2) = REAL 2 & rng proj(1,2) = REAL & for x,y be
  Element of REAL holds proj(1,2).<*x,y*> = x;

theorem 
  dom proj(2,2) = REAL 2 & rng proj(2,2) = REAL & for x,y be
  Element of REAL holds proj(2,2).<*x,y*> = y;

begin 

definition
  let n,i be Element of NAT;
  let f be PartFunc of REAL n,REAL;
  let z be Element of REAL n;
  func SVF1(i,f,z) -> PartFunc of REAL,REAL equals

  f*reproj(i,z);
end;

theorem 
  z = <*x,y*> & f is_partial_differentiable_in z,1 implies SVF1(1,f
  ,z) is_differentiable_in x;

theorem 
  z = <*x,y*> & f is_partial_differentiable_in z,2 implies SVF1(2,f
  ,z) is_differentiable_in y;

theorem 
  for f be PartFunc of REAL 2,REAL for z be Element of REAL 2 holds
  (ex x0,y0 being Real st z = <*x0,y0*> & SVF1(1,f,z) is_differentiable_in x0)
  iff f is_partial_differentiable_in z,1;

theorem 
  for f be PartFunc of REAL 2,REAL for z be Element of REAL 2 holds
  (ex x0,y0 being Real st z = <*x0,y0*> & SVF1(2,f,z) is_differentiable_in y0)
  iff f is_partial_differentiable_in z,2;

theorem 
  z = <*x0,y0*> & f is_partial_differentiable_in z,1 implies ex N being
  Neighbourhood of x0 st N c= dom SVF1(1,f,z) & ex L,R st for x st x in N holds
  SVF1(1,f,z).x - SVF1(1,f,z).x0 = L.(x-x0) + R.(x-x0);

theorem 
  z = <*x0,y0*> & f is_partial_differentiable_in z,2 implies ex N being
  Neighbourhood of y0 st N c= dom SVF1(2,f,z) & ex L,R st for y st y in N holds
  SVF1(2,f,z).y - SVF1(2,f,z).y0 = L.(y-y0) + R.(y-y0);

theorem 
  for f be PartFunc of REAL 2,REAL for z be Element of REAL 2 holds
  f is_partial_differentiable_in z,1 iff ex x0,y0 being Real st z = <*x0,y0*> &
  ex N being Neighbourhood of x0 st N c= dom SVF1(1,f,z) & ex L,R st for x st x
  in N holds SVF1(1,f,z).x - SVF1(1,f,z).x0 = L.(x-x0) + R.(x-x0);

theorem 
  for f be PartFunc of REAL 2,REAL for z be Element of REAL 2
holds f is_partial_differentiable_in z,2 iff ex x0,y0 being Real st z = <*x0,y0
  *> & ex N being Neighbourhood of y0 st N c= dom SVF1(2,f,z) & ex L,R st for y
  st y in N holds SVF1(2,f,z).y - SVF1(2,f,z).y0 = L.(y-y0) + R.(y-y0);

theorem 
  z = <*x0,y0*> & f is_partial_differentiable_in z,1 implies (r =
  partdiff(f,z,1) iff ex x0,y0 being Real st z = <*x0,y0*> & ex N being
Neighbourhood of x0 st N c= dom SVF1(1,f,z) & ex L,R st r = L.1 & for x st x in
  N holds SVF1(1,f,z).x - SVF1(1,f,z).x0 = L.(x-x0) + R.(x-x0));

theorem 
  z = <*x0,y0*> & f is_partial_differentiable_in z,2 implies (r =
  partdiff(f,z,2) iff ex x0,y0 being Real st z = <*x0,y0*> & ex N being
Neighbourhood of y0 st N c= dom SVF1(2,f,z) & ex L,R st r = L.1 & for y st y in
  N holds SVF1(2,f,z).y - SVF1(2,f,z).y0 = L.(y-y0) + R.(y-y0));

theorem 
  z = <*x0,y0*> & f is_partial_differentiable_in z,1 implies partdiff(f,
  z,1) = diff(SVF1(1,f,z),x0);

theorem 
  z = <*x0,y0*> & f is_partial_differentiable_in z,2 implies partdiff(f,
  z,2) = diff(SVF1(2,f,z),y0);

definition
  let f be PartFunc of REAL 2,REAL;
  let Z be set;
  pred f is_partial_differentiable`1_on Z means


  Z c= dom f & for z be
  Element of REAL 2 st z in Z holds f|Z is_partial_differentiable_in z,1;
  pred f is_partial_differentiable`2_on Z means


  Z c= dom f & for z be
  Element of REAL 2 st z in Z holds f|Z is_partial_differentiable_in z,2;
end;

theorem 
  f is_partial_differentiable`1_on Z implies Z c= dom f & for z st z in
  Z holds f is_partial_differentiable_in z,1;

theorem 
  f is_partial_differentiable`2_on Z implies Z c= dom f & for z st z in
  Z holds f is_partial_differentiable_in z,2;

definition
  let f be PartFunc of REAL 2,REAL;
  let Z be set;
  assume
 f is_partial_differentiable`1_on Z;
  func f`partial1|Z -> PartFunc of REAL 2,REAL means

  dom it = Z & for z be
  Element of REAL 2 st z in Z holds it.z = partdiff(f,z,1);
end;

definition
  let f be PartFunc of REAL 2,REAL;
  let Z be set;
  assume
 f is_partial_differentiable`2_on Z;
  func f`partial2|Z -> PartFunc of REAL 2,REAL means

  dom it = Z & for z be
  Element of REAL 2 st z in Z holds it.z = partdiff(f,z,2);
end;

begin 

theorem 
  for z0 being Element of REAL 2 for N being Neighbourhood of proj(1,2).
  z0 st f is_partial_differentiable_in z0,1 & N c= dom SVF1(1,f,z0) holds for h
be 0-convergent non-zero Real_Sequence,
c be constant Real_Sequence st rng c = {proj(
1,2).z0} & rng (h+c) c= N holds h"(#)(SVF1(1,f,z0)/*(h+c) - SVF1(1,f,z0)/*c) is
convergent & partdiff(f,z0,1) = lim (h"(#)(SVF1(1,f,z0)/*(h+c) - SVF1(1,f,z0)/*
  c));

theorem 
  for z0 being Element of REAL 2 for N being Neighbourhood of proj(2,2).
  z0 st f is_partial_differentiable_in z0,2 & N c= dom SVF1(2,f,z0) holds for h
be 0-convergent non-zero Real_Sequence,
c be constant Real_Sequence st rng c = {proj(
2,2).z0} & rng (h+c) c= N holds h"(#)(SVF1(2,f,z0)/*(h+c) - SVF1(2,f,z0)/*c) is
convergent & partdiff(f,z0,2) = lim (h"(#)(SVF1(2,f,z0)/*(h+c) - SVF1(2,f,z0)/*
  c));

theorem 
  f1 is_partial_differentiable_in z0,1 & f2 is_partial_differentiable_in
  z0,1 implies f1(#)f2 is_partial_differentiable_in z0,1;

theorem 
  f1 is_partial_differentiable_in z0,2 & f2 is_partial_differentiable_in
  z0,2 implies f1(#)f2 is_partial_differentiable_in z0,2;

theorem 
  for z0 being Element of REAL 2 holds f is_partial_differentiable_in z0
  ,1 implies SVF1(1,f,z0) is_continuous_in proj(1,2).z0;

theorem 
  for z0 being Element of REAL 2 holds f is_partial_differentiable_in z0
  ,2 implies SVF1(2,f,z0) is_continuous_in proj(2,2).z0;














begin

reserve k,n,n1,m,m1,m0,h,i,j for Nat,
  a,x,y,X,X1,X2,X3,X4,Y for set;
reserve L,L1,L2 for FinSequence;
reserve F,F1,G,G1,H for LTL-formula;
reserve W,W1,W2 for Subset of Subformulae H;
reserve v for LTL-formula;

definition
  let F;
  redefine func Subformulae F -> Subset of LTL_WFF;
end;



definition
  let H;
  func LTLNew1 H -> Subset of Subformulae H equals


  {
  the_left_argument_of H,the_right_argument_of H } if H is conjunctive, {
  the_left_argument_of H } if H is disjunctive, {} if H is next, {
  the_left_argument_of H } if H is Until, {the_right_argument_of H } if H is
  Release otherwise {};
  func LTLNew2 H -> Subset of Subformulae H equals


  {} if H is
conjunctive, {the_right_argument_of H } if H is disjunctive, {} if H is next, {
  the_right_argument_of H } if H is Until, {the_left_argument_of H,
  the_right_argument_of H } if H is Release otherwise {};
  func LTLNext H -> Subset of Subformulae H equals


  {} if H is
conjunctive, {} if H is disjunctive, {the_argument_of H} if H is next, {H} if H
  is Until, {H} if H is Release otherwise {};
end;

definition
  let v;
  struct LTLnode over v (#LTLold,LTLnew,LTLnext -> Subset of Subformulae v #);
end;

definition
  let v;
  let N be LTLnode over v;
  let H;
  assume
 H in the LTLnew of N;
  func SuccNode1(H,N) -> strict LTLnode over v means


  the LTLold of it =
  (the LTLold of N) \/ {H} & the LTLnew of it = ((the LTLnew of N) \ {H}) \/ (
  LTLNew1 H \ the LTLold of N) & the LTLnext of it = (the LTLnext of N) \/
  LTLNext H;
end;

definition
  let v;
  let N be LTLnode over v;
  let H;
  assume
 H in the LTLnew of N;
  func SuccNode2(H,N) -> strict LTLnode over v means


  the LTLold of it =
  (the LTLold of N) \/ {H} & the LTLnew of it = ((the LTLnew of N) \ {H}) \/ (
  LTLNew2 H \ the LTLold of N) & the LTLnext of it = the LTLnext of N;
end;

definition
  let v;
  let N1,N2 be LTLnode over v;
  let H;
  pred N2 is_succ_of N1,H means


  H in the LTLnew of N1 & (N2 = SuccNode1(
H,N1) or (H is disjunctive or H is Until or H is Release) & N2=SuccNode2(H,N1))
  ;
end;

definition
  let v;
  let N1,N2 be LTLnode over v;
  pred N2 is_succ1_of N1 means


  ex H st H in the LTLnew of N1 & N2 = SuccNode1(H,N1);
  pred N2 is_succ2_of N1 means


  ex H st H in the LTLnew of N1 & (H is
  disjunctive or H is Until or H is Release) & N2=SuccNode2(H,N1);
end;

definition
  let v;
  let N1,N2 be LTLnode over v;
  pred N2 is_succ_of N1 means


  N2 is_succ1_of N1 or N2 is_succ2_of N1;
end;

definition
  let v;
  let N be LTLnode over v;
  attr N is failure means

  ex H,F st H is atomic & F = 'not' H & H in the
  LTLold of N & F in the LTLold of N;
end;

definition
  let v;
  let N be LTLnode over v;
  attr N is elementary means


  the LTLnew of N = {};
end;

definition
  let v;
  let N be LTLnode over v;
  attr N is final means

  N is elementary & the LTLnext of N = {};
end;

definition
  let v;
  func {}v -> Subset of Subformulae v equals

  {};
end;

definition
  let v;
  func Seed v -> Subset of Subformulae v equals

  {v};
end;

registration
  let v;
  cluster elementary strict for LTLnode over v;
end;

definition
  let v;
  func FinalNode v -> elementary strict LTLnode over v equals

  LTLnode(# {}v,{}
    v,{}v #);
end;

definition
  let x, v;
  func CastNode(x,v) -> strict LTLnode over v equals


  x if x is strict
  LTLnode over v otherwise LTLnode(# {}v,{}v,{}v #);
end;

definition
  let v;
  func init v -> elementary strict LTLnode over v equals

  LTLnode(# {}v,{}v,
    Seed v #);
end;

definition
  let v;
  let N be LTLnode over v;
  func 'X' N -> strict LTLnode over v equals

  LTLnode(# {}v,the LTLnext of N,{}
    v #);
end;



reserve N,N1,N2,N10,N20,M for strict LTLnode over v;
reserve w for Element of Inf_seq(AtomicFamily);

definition
  let v, L;
  pred L is_Finseq_for v means


  for k st 1 <= k & k < len(L) holds ex N
  ,M st N = L.k & M=L.(k+1) & M is_succ_of N;
end;

definition
  let v, N1,N2;
  pred N2 is_next_of N1 means


  N1 is elementary & N2 is elementary & ex
  L st 1<=len(L) & L is_Finseq_for v & L.1 = 'X' N1 & L.(len(L)) = N2;
end;

definition
  let v;
  let W be Subset of Subformulae v;
  func CastLTL(W) -> Subset of LTL_WFF equals

  W;
end;

definition
  let v, N;
  func *N -> Subset of LTL_WFF equals

  ((the LTLold of N) \/ (the LTLnew of N))
  \/ 'X' CastLTL(the LTLnext of N);
end;

theorem 
  H in the LTLnew of N & (H is atomic or H is negative or H is
conjunctive or H is next ) implies (w |= *N iff w |= *SuccNode1(H,N));

theorem 
  H in the LTLnew of N & (H is disjunctive or H is Until or H is Release
) implies (w |= *N iff (w |= *SuccNode1(H,N) or w |= *SuccNode2(H,N)));

theorem 
  ex L st Subformulae H = rng L;

registration
  let H;
  cluster Subformulae H -> finite;
end;

definition
  let H, W, L, x;
  func Length_fun(L,W,x) -> Nat equals


  len CastLTL(L.x) if L.x in W
  otherwise 0;
end;

definition
  let H, W, L;
  func Partial_seq(L,W) -> Real_Sequence means


  for k holds (L.k in W
  implies it.k = len CastLTL(L.k)) & (not L.k in W implies it.k=0 );
end;

reserve R1,R2 for Real_Sequence;

definition
  let H, W, L;
  func len(L,W) -> Real equals

  Sum(Partial_seq(L,W), len L);
end;

theorem 
  len(L,{}H) = 0;

theorem 
  not F in W implies len(L,W \ {F}) = len(L,W);

theorem 
  rng L = Subformulae H & L is one-to-one & F in W implies len(L,W\
  {F}) = len(L,W) - len F;

theorem 
  rng L = Subformulae H & L is one-to-one & (not F in W) & W1 = W
  \/ {F} implies len(L,W1) = len(L,W) + len F;

theorem 
  rng L1 = Subformulae H & L1 is one-to-one & rng L2 = Subformulae
  H & L2 is one-to-one implies len(L1,W) = len(L2,W);

definition
  let H, W;
  func len(W) -> Real means


  ex L st rng L = Subformulae H & L is one-to-one & it = len(L,W);
end;

theorem 
  not F in W implies len(W\{F}) = len(W);

theorem 
  F in W implies len(W\{F}) = len(W) - len F;

theorem 
  (not F in W) & W1 = W \/ {F} implies len(W1) = len(W) + len F;

theorem 
  W1 = W \/ {F} implies len(W1) <= len(W) + len F;

theorem 
  len({}H ) = 0;

theorem 
  W = {F} implies len(W) = len F;

theorem 
  W c= W1 implies len(W) <= len(W1);

theorem 
  len(W)<1 implies W = {}H;

theorem 
  len(W) >= 0;

theorem 
  W = W1 \/ W2 implies len(W) <= len(W1) + len(W2);

definition
  let v, H;
  assume
 H in Subformulae v;
  func LTLNew1(H,v) -> Subset of Subformulae v equals


  LTLNew1 H;
  func LTLNew2(H,v) -> Subset of Subformulae v equals


  LTLNew2 H;
end;

theorem 
  N2 is_succ1_of N1 implies len(the LTLnew of N2) <= len(the LTLnew of N1) - 1;

theorem 
  N2 is_succ2_of N1 implies len(the LTLnew of N2) <= len(the LTLnew of N1) - 1;

definition
  let v, N;
  func len(N) -> Nat equals

  [\ len(the LTLnew of N) /];
end;

theorem 
  N2 is_succ_of N1 implies len(N2) <= len(N1) - 1;

theorem 
  len(N)<=0 implies the LTLnew of N = {}v;

theorem 
  len(N)>0 implies the LTLnew of N <> {}v;

theorem 
  ex n,L,M st 1 <= n & len L = n & L.1 = N & L.n = M & the LTLnew of M =
  {}v & L is_Finseq_for v;

theorem 
  N2 is_succ_of N1 implies the LTLold of N1 c= the LTLold of N2 &
  the LTLnext of N1 c= the LTLnext of N2;

theorem 
  L is_Finseq_for v & m<= len(L) & L1 = L|Seg m implies L1 is_Finseq_for v;

theorem 
  L is_Finseq_for v & not F in the LTLold of CastNode(L.1,v) & 1<
n & n <= len(L) & F in the LTLold of CastNode(L.n,v) implies ex m st 1<= m & m<
n & not F in the LTLold of CastNode(L.m,v) & F in the LTLold of CastNode(L.(m+1
  ),v);

theorem 
  N2 is_succ_of N1 & not F in the LTLold of N1 & F in the LTLold
  of N2 implies N2 is_succ_of N1,F;

theorem 
  L is_Finseq_for v & F in the LTLnew of CastNode(L.1,v) & 1< n &
n <= len(L) & not F in the LTLnew of CastNode(L.n,v) implies ex m st 1<= m & m<
n & F in the LTLnew of CastNode(L.m,v) & not F in the LTLnew of CastNode(L.(m+1
  ),v);

theorem 
  N2 is_succ_of N1 & F in the LTLnew of N1 & not F in the LTLnew
  of N2 implies N2 is_succ_of N1,F;

theorem 
  L is_Finseq_for v & 1<= m & m<=n & n<= len(L) implies the LTLold
of CastNode(L.m,v) c= the LTLold of CastNode(L.n,v) & the LTLnext of CastNode(L
  .m,v) c= the LTLnext of CastNode(L.n,v);

theorem 
  N2 is_succ_of N1,F implies F in the LTLold of N2;

theorem 
  L is_Finseq_for v & 1<= len(L) & the LTLnew of CastNode(L.(len(L
)),v) = {} v implies the LTLnew of CastNode(L.1,v) c= the LTLold of CastNode(L.
  (len(L)),v);

theorem 
  L is_Finseq_for v & 1<= m & m<=len(L) & the LTLnew of CastNode(L
  .(len(L)),v) = {} v implies the LTLnew of CastNode(L.m,v) c= the LTLold of
  CastNode(L.(len(L)),v);

theorem 
  L is_Finseq_for v & 1<= k & k<len(L) implies CastNode(L.(k+1),v)
  is_succ_of CastNode(L.k,v);

theorem 
  L is_Finseq_for v & 1<= k & k<=len(L) implies len(CastNode(L.k,v
  )) <= len(CastNode(L.1,v)) -k+1;

reserve s,s0,s1,s2 for elementary strict LTLnode over v;

theorem 
  s2 is_next_of s1 implies the LTLnext of s1 c= the LTLold of s2;

theorem 
  s2 is_next_of s1 & F in the LTLold of s2 implies ex L,m st 1<=
len(L) & L is_Finseq_for v & L.1 = 'X' s1 & L.(len(L)) = s2 & 1 <= m & m <len(L
  ) & CastNode(L.(m+1),v) is_succ_of CastNode(L.m,v),F;

theorem 
  s2 is_next_of s1 & H is Release & H in the LTLold of s2 & not
  the_left_argument_of H in the LTLold of s2 implies the_right_argument_of H in
  the LTLold of s2 & H in the LTLnext of s2;

theorem 
  s2 is_next_of s1 & H is Release & H in the LTLnext of s1 implies
  the_right_argument_of H in the LTLold of s2 & H in the LTLold of s2;

theorem 
  s1 is_next_of s0 & H in the LTLold of s1 implies (H is
  conjunctive implies the_left_argument_of H in the LTLold of s1 &
the_right_argument_of H in the LTLold of s1) & (H is disjunctive or H is Until
  implies the_left_argument_of H in the LTLold of s1 or the_right_argument_of H
  in the LTLold of s1) & (H is next implies the_argument_of H in the LTLnext of
  s1 ) & (H is Release implies the_right_argument_of H in the LTLold of s1);

theorem 
  s1 is_next_of s0 & s2 is_next_of s1 & H in the LTLold of s1 & H is
  Until implies the_right_argument_of H in the LTLold of s1 or
  the_left_argument_of H in the LTLold of s1 & H in the LTLold of s2;

definition
  let v;
  func LTLNodes(v) -> non empty set means


  x in it iff ex N being strict LTLnode over v st x=N;
end;

registration
  let v;
  cluster LTLNodes(v) -> finite;
end;

definition
  let v;
  func LTLStates(v) -> non empty set equals

  {x where x is Element of LTLNodes(
  v): x is elementary strict LTLnode over v};
end;

registration
  let v;
  cluster LTLStates(v) -> finite;
end;

theorem 
  init v is Element of LTLStates(v);

theorem 
  s is Element of LTLStates(v);

theorem 
  x is Element of LTLStates(v) iff ex s st s=x;

definition
  let v;
  let w;
  let f be Function;
  pred f is_succ_homomorphism v,w means


  for x st x in LTLNodes(v) &
  CastNode(x,v) is non elementary & w |= *CastNode(x,v) holds CastNode(f.x,v)
  is_succ_of CastNode(x,v) & w |= *CastNode(f.x,v);
  pred f is_homomorphism v,w means


  for x st x in LTLNodes(v) & CastNode
  (x,v) is non elementary & w |= *CastNode(x,v) holds w |= *CastNode(f.x,v);
end;

theorem 
  for f being Function of LTLNodes(v),LTLNodes(v) st f
  is_succ_homomorphism v,w holds f is_homomorphism v,w;

theorem 
  for f being Function of LTLNodes(v),LTLNodes(v) st f
  is_homomorphism v,w holds for x st x in LTLNodes(v) & CastNode(x,v) is non
elementary & w |= *CastNode(x,v) holds for k st (for i st i<=k holds CastNode((
  f|**i).x,v) is non elementary) holds w |= *CastNode((f|**k).x,v);

theorem 
  for f being Function of LTLNodes(v),LTLNodes(v) st f
is_succ_homomorphism v,w holds for x st x in LTLNodes(v) & CastNode(x,v) is non
elementary & w |= *CastNode(x,v) holds for k st (for i st i<=k holds CastNode((
  f|**i).x,v) is non elementary) holds CastNode((f|**(k+1)).x,v) is_succ_of
  CastNode((f|**k).x,v) & w |= *CastNode((f|**k).x,v);

theorem 
  for f being Function of LTLNodes(v),LTLNodes(v) st f
is_succ_homomorphism v,w holds for x st x in LTLNodes(v) & CastNode(x,v) is non
elementary & w |= *CastNode(x,v) holds ex n st (for i st i<n holds CastNode((f
  |**i).x,v) is non elementary) & CastNode((f|**n).x,v) is elementary;

theorem 
  for f being Function of LTLNodes(v),LTLNodes(v) st f
  is_homomorphism v,w holds for x st x in LTLNodes(v) & CastNode(x,v) is non
  elementary holds for k st CastNode((f|**k).x,v) is non elementary & w |= *
  CastNode((f|**k).x,v) holds w |= *CastNode((f|**(k+1)).x,v);

theorem 
  for f being Function of LTLNodes(v),LTLNodes(v) st f
is_succ_homomorphism v,w holds for x st x in LTLNodes(v) & CastNode(x,v) is non
elementary & w |= *CastNode(x,v) holds ex n st (for i st i<n holds CastNode((f
|**i).x,v) is non elementary & CastNode((f|**(i+1)).x,v) is_succ_of CastNode((f
|**i).x,v)) & CastNode((f|**n).x,v) is elementary & for i st i<=n holds w |= *
  CastNode((f|**i).x,v);

reserve q for sequence of LTLStates(v);

theorem 
  ex s st s = CastNode(q.n,v);

theorem 
  H is Until & H in the LTLold of CastNode(q.1,v) & (for i holds
  CastNode(q.(i+1),v) is_next_of CastNode(q.i,v)) implies ((for i st 1<=i & i<n
holds not the_right_argument_of H in the LTLold of CastNode(q.i,v)) implies for
i st 1<=i & i<n holds the_left_argument_of H in the LTLold of CastNode(q.i,v) &
  H in the LTLold of CastNode(q.i,v) );

theorem 
  H is Until & H in the LTLold of CastNode(q.1,v) & (for i holds
CastNode(q.(i+1),v) is_next_of CastNode(q.i,v)) implies (for i st i>=1 holds (H
  in the LTLold of CastNode(q.i,v)) & (the_left_argument_of H in the LTLold of
CastNode(q.i,v)) & not (the_right_argument_of H in the LTLold of CastNode(q.i,v
))) or ex j st j>=1 & the_right_argument_of H in the LTLold of CastNode(q.j,v)
  & for i st 1<=i & i<j holds H in the LTLold of CastNode(q.i,v) &
  the_left_argument_of H in the LTLold of CastNode(q.i,v);



theorem 
  union BOOL X = X;

theorem 
  N is non elementary implies the LTLnew of N <> {} & the LTLnew
  of N in BOOL Subformulae v;

registration
  let v;
  cluster union BOOL Subformulae v -> non empty;
  cluster BOOL Subformulae v -> non empty;
end;

theorem 
  ex f being Choice_Function of BOOL Subformulae v st f is Function of
  BOOL Subformulae v,Subformulae v;

reserve U for Choice_Function of BOOL Subformulae v;

definition
  let v;
  let U;
  let N;
  assume
 N is non elementary;
  func chosen_formula(U,N) -> LTL-formula equals


  U.(the LTLnew of N);
end;

theorem 
  N is non elementary implies chosen_formula(U,N) in the LTLnew of N;

definition
  let w;
  let v;
  let U;
  let N;
  func chosen_succ(w,v,U,N) -> strict LTLnode over v equals


  SuccNode1(
  chosen_formula(U,N),N) if not chosen_formula(U,N) is Until & w |= *SuccNode1(
  chosen_formula(U,N),N) or chosen_formula(U,N) is Until & w |/=
the_right_argument_of chosen_formula(U,N) otherwise SuccNode2(chosen_formula(U,
  N),N);
end;

theorem 
  w|=*N & N is non elementary implies w|=*chosen_succ(w,v,U,N) &
  chosen_succ(w,v,U,N) is_succ_of N;

theorem 
  N is non elementary implies ( chosen_formula(U,N) is Until & w |=
  the_right_argument_of chosen_formula(U,N) implies (the_right_argument_of
  chosen_formula(U,N) in the LTLnew of chosen_succ(w,v,U,N) or
the_right_argument_of chosen_formula(U,N) in the LTLold of N ) & chosen_formula
  (U,N) in the LTLold of chosen_succ(w,v,U,N) );

theorem 
  w|=*N & N is non elementary implies the LTLold of N c= the LTLold of
chosen_succ(w,v,U,N) & the LTLnext of N c= the LTLnext of chosen_succ(w,v,U,N);

definition
  let w;
  let v;
  let U;
  func choice_succ_func(w,v,U) -> Function of LTLNodes(v),LTLNodes(v) means


   for
 x st x in LTLNodes(v) holds it.x = chosen_succ(w,v,U,CastNode(x,v));
end;

theorem 
  choice_succ_func(w,v,U) is_succ_homomorphism v,w;

begin 

definition
  let H;
  attr H is neg-inner-most means


  for G being LTL-formula st G
  is_subformula_of H holds G is negative implies the_argument_of G is atomic;
end;

registration
  cluster neg-inner-most for LTL-formula;
end;

definition
  let H;
  attr H is Sub_atomic means


  H is atomic or ex G being LTL-formula st G is atomic & H = 'not' G;
end;

theorem 
  H is neg-inner-most & F is_subformula_of H implies F is neg-inner-most;

theorem 
  H is Sub_atomic iff H is atomic or H is negative &
  the_argument_of H is atomic;

theorem 
  H is neg-inner-most implies (H is Sub_atomic or H is conjunctive
  or H is disjunctive or H is next or H is Until or H is Release);

theorem 
  H is next & H is neg-inner-most implies the_argument_of H is neg-inner-most;

theorem 
  (H is conjunctive or H is disjunctive or H is Until or H is Release) &
  H is neg-inner-most implies the_left_argument_of H is neg-inner-most &
  the_right_argument_of H is neg-inner-most;

begin 

definition
  let W be non empty set;
  struct(1-sorted) BuchiAutomaton over W (# carrier -> set,
    Tran -> Relation of [:the carrier,W :], the carrier,
    InitS -> Element of bool the carrier, FinalS ->
    Subset of bool the carrier #);
end;

definition
  let W be non empty set, B be BuchiAutomaton over W;
  let w be Element of Inf_seq(W);
  pred w is-accepted-by B means


  ex run be sequence of the carrier of B
st run.0 in the InitS of B & for i be Nat holds [[run.i,CastSeq(w,W).i],run.(i+
  1)] in the Tran of B & for FSet be set st FSet in the FinalS of B holds {k
  where k is Element of NAT:run.k in FSet} is infinite set;
end;




reserve v for neg-inner-most LTL-formula;
reserve U for Choice_Function of BOOL Subformulae v;
reserve N,N1,N2,M1 for strict LTLnode over v;
reserve s,s1 for elementary strict LTLnode over v;

definition
  let v;
  let N;
  func atomic_LTL(N) -> Subset of LTL_WFF equals

  {x where x is LTL-formula:x
  is atomic & x in the LTLold of N};
  func Neg_atomic_LTL(N) -> Subset of LTL_WFF equals

  {x where x is LTL-formula
  :x is atomic & ('not' x) in the LTLold of N};
end;

definition
  let v;
  let N;
  func Label_(N) -> set equals

  {x where x is Subset of atomic_LTL:atomic_LTL(N
  ) c= x & Neg_atomic_LTL(N) misses x };
end;

definition
  let v;
  func Tran_LTL(v) -> Relation of [:LTLStates(v),AtomicFamily:], LTLStates(v)
  equals

  {y where y is Element of [:LTLStates(v),AtomicFamily,LTLStates(v):] : ex
  s,s1,x st y=[[s,x],s1] & s1 is_next_of s & x in Label_(s1)};
  func InitS_LTL(v) -> Element of bool LTLStates(v) equals

  {init v};
end;

definition
  let v;
  let F;
  func FinalS_LTL(F,v) -> Element of bool LTLStates(v) equals

  {x where x is
  Element of LTLStates(v): not F in the LTLold of CastNode(x,v) or
  the_right_argument_of F in the LTLold of CastNode(x,v) };
end;

definition
  let v;
  func FinalS_LTL(v) -> Subset of bool LTLStates(v) equals

  {x where x is
  Element of bool LTLStates(v): ex F st F is_subformula_of v & F is Until & x=
  FinalS_LTL(F,v)};
end;

definition
  let v;
  func BAutomaton(v) -> BuchiAutomaton over AtomicFamily equals

  BuchiAutomaton
  (# LTLStates(v), Tran_LTL(v), InitS_LTL(v), FinalS_LTL(v) #);
end;





theorem 
  w is-accepted-by BAutomaton(v) implies w |= v;

definition
  let w,v,U,N;
  assume that
 N is non elementary and
 w |= *N;
  func chosen_succ_end_num(w,v,U,N) -> Nat means


  (for i st i<it holds
  CastNode((choice_succ_func(w,v,U)|**i).N,v) is non elementary & CastNode((
choice_succ_func(w,v,U)|**(i+1)).N,v) is_succ_of CastNode((choice_succ_func(w,v
  ,U)|**i).N,v)) & CastNode((choice_succ_func(w,v,U)|**it).N,v) is elementary &
  for i st i<=it holds w |= *CastNode((choice_succ_func(w,v,U)|**i).N,v);
end;

definition
  let w;
  let v;
  let U;
  let N;
  assume
 w |= * ('X' N);
  func chosen_next(w,v,U,N) -> elementary strict LTLnode over v equals


CastNode ((choice_succ_func(w,v,U) |**chosen_succ_end_num(w,v,U,'X' N)).('X' N)
  ,v) if 'X' N is non elementary otherwise FinalNode v;
end;

theorem 
  w |= * ('X' s) implies chosen_next(w,v,U,s) is_next_of s & w |=
  *chosen_next(w,v,U,s);

definition
  let w;
  let v;
  let U;
  func chosen_run(w,v,U) -> sequence of LTLStates(v) means


  it.0 = init
  v & for n holds it.(n+1) = chosen_next(Shift(w,n),v,U,CastNode(it.n,v));
end;

theorem 
  w |= * N implies Shift(w,1) |= * ('X' N);

theorem 
  w |= 'X' v implies w |= * (init v);

theorem 
  w |= v iff w |= *('X' init v);

theorem 
  w |= v implies for n holds CastNode(chosen_run(w,v,U).(n+1),v)
  is_next_of CastNode(chosen_run(w,v,U).n,v) & Shift(w,n) |= * ('X' CastNode(
  chosen_run(w,v,U).n,v));

theorem 
  w |= v implies for i holds H in the LTLold of CastNode(
  chosen_run(w,v,U).(i+1),v) & H is Until & Shift(w,i)|=the_right_argument_of H
implies the_right_argument_of H in the LTLold of CastNode(chosen_run(w,v,U).(i+
  1),v);

theorem 
  w |= v implies w is-accepted-by BAutomaton(v);

theorem 
  w is-accepted-by BAutomaton(v) iff w |= v;














begin 

reserve i,j,k,n,l for Element of NAT,
  K for Field,
  a,b,c for Element of K,
  p ,q for FinSequence of K,
  M1,M2,M3 for Matrix of n,K;

theorem 
  (1_K)*p=p;

theorem 
  (-1_K)*p=-p;

definition
  let K be set;
  let M be Matrix of K;
  let p be FinSequence;
  pred M is_line_circulant_about p means


  len p = width M & for i,j be
  Nat st [i,j] in Indices M holds M*(i,j) = p.((j-i mod len p)+1);
end;

definition
  let K be set;
  let M be Matrix of K;
  attr M is line_circulant means


  ex p being FinSequence of K st len p= width M & M is_line_circulant_about p;
end;

definition
  let K be non empty set;
  let p be FinSequence of K;
  attr p is first-line-of-circulant means


  ex M being Matrix of len p,K st M is_line_circulant_about p;
end;

definition
  let K be set;
  let M be Matrix of K;
  let p be FinSequence;
  pred M is_col_circulant_about p means


  len p = len M & for i,j be Nat
  st [i,j] in Indices M holds M*(i,j)=p.((i-j mod len p)+1);
end;

definition
  let K be set;
  let M be Matrix of K;
  attr M is col_circulant means


  ex p being FinSequence of K st len p = len M & M is_col_circulant_about p;
end;

definition
  let K be non empty set;
  let p be FinSequence of K;
  attr p is first-col-of-circulant means


  ex M being Matrix of len p,K st M is_col_circulant_about p;
end;

definition
  let K be non empty set, p be FinSequence of K;
  assume
 p is first-line-of-circulant;
  func LCirc(p) -> Matrix of len p,K means


  it is_line_circulant_about p;
end;

definition
  let K be non empty set, p be FinSequence of K;
  assume
 p is first-col-of-circulant;
  func CCirc(p) -> Matrix of len p,K means


  it is_col_circulant_about p;
end;

registration
  let K be Field;
  cluster first-line-of-circulant first-col-of-circulant for FinSequence of K;
end;

registration
  let K,n;
  cluster 0.(K,n) -> line_circulant col_circulant;
end;

registration
  let K;
  let n;
  let a be Element of K;
  cluster (n,n)-->a -> line_circulant for Matrix of n,K;
  cluster (n,n)-->a -> col_circulant for Matrix of n,K;
end;

registration
  let K;
  cluster line_circulant col_circulant for Matrix of K;
end;

reserve D for non empty set,
  t for FinSequence of D,
  A for Matrix of n,D;

theorem 
  A is line_circulant & n>0 implies A@ is col_circulant;

theorem 
  A is_line_circulant_about t & n>0 implies t = Line(A,1);

theorem 
  A is line_circulant & [i,j] in [:Seg n, Seg n:] & k=i+1 & l=j+1 & i<n
  & j<n implies A*(i,j)=A*(k,l);

theorem 
  M1 is line_circulant implies a*M1 is line_circulant;

theorem 
  M1 is line_circulant & M2 is line_circulant implies M1+M2 is line_circulant;

theorem 
  M1 is line_circulant & M2 is line_circulant & M3 is
  line_circulant implies M1+M2+M3 is line_circulant;

theorem 
  M1 is line_circulant & M2 is line_circulant implies a*M1+b*M2 is
  line_circulant;

theorem 
  M1 is line_circulant & M2 is line_circulant & M3 is line_circulant
  implies a*M1+b*M2+c*M3 is line_circulant;

theorem 
  M1 is line_circulant implies -M1 is line_circulant;

theorem 
  M1 is line_circulant & M2 is line_circulant implies M1 - M2 is line_circulant
;

theorem 
  M1 is line_circulant & M2 is line_circulant implies a*M1 - b*M2
  is line_circulant;

theorem 
  M1 is line_circulant & M2 is line_circulant & M3 is line_circulant
  implies a*M1+b*M2-c*M3 is line_circulant;

theorem 
  M1 is line_circulant & M2 is line_circulant & M3 is line_circulant
  implies a*M1-b*M2-c*M3 is line_circulant;

theorem 
  M1 is line_circulant & M2 is line_circulant & M3 is line_circulant
  implies a*M1-b*M2+c*M3 is line_circulant;

theorem 
  A is col_circulant & n>0 implies A@ is line_circulant;

theorem 
  A is_col_circulant_about t & n>0 implies t = Col(A,1);

theorem 
  A is col_circulant & [i,j] in [:Seg n, Seg n:] & k=i+1 & l=j+1 & i<n &
  j<n implies A*(i,j)=A*(k,l);

theorem 
  M1 is col_circulant implies a*M1 is col_circulant;

theorem 
  M1 is col_circulant & M2 is col_circulant implies M1+M2 is col_circulant;

theorem 
  M1 is col_circulant & M2 is col_circulant & M3 is col_circulant
  implies M1+M2+M3 is col_circulant;

theorem 
  M1 is col_circulant &M2 is col_circulant implies a*M1+b*M2 is col_circulant;

theorem 
  M1 is col_circulant & M2 is col_circulant & M3 is col_circulant
  implies a*M1+b*M2+c*M3 is col_circulant;

theorem 
  M1 is col_circulant implies -M1 is col_circulant;

theorem 
  M1 is col_circulant & M2 is col_circulant implies M1 - M2 is col_circulant;

theorem 
  M1 is col_circulant & M2 is col_circulant implies a*M1 - b*M2 is
  col_circulant;

theorem 
  M1 is col_circulant & M2 is col_circulant & M3 is col_circulant
  implies a*M1+b*M2-c*M3 is col_circulant;

theorem 
  M1 is col_circulant & M2 is col_circulant & M3 is col_circulant
  implies a*M1-b*M2-c*M3 is col_circulant;

theorem 
  M1 is col_circulant & M2 is col_circulant & M3 is col_circulant
  implies a*M1-b*M2+c*M3 is col_circulant;

theorem 
  p is first-line-of-circulant implies -p is first-line-of-circulant;

theorem 
  p is first-line-of-circulant implies LCirc(-p) =-(LCirc p);

theorem 
  p is first-line-of-circulant & q is first-line-of-circulant &
  len p=len q implies p+q is first-line-of-circulant;

theorem 
  len p=len q & p is first-line-of-circulant & q is
  first-line-of-circulant implies LCirc(p+q) = LCirc(p)+LCirc(q);

theorem 
  p is first-col-of-circulant implies -p is first-col-of-circulant;

theorem 
  for p being FinSequence of K st p is first-col-of-circulant holds
  CCirc(-p) =-(CCirc p);

theorem 
  p is first-col-of-circulant & q is first-col-of-circulant & len
  p=len q implies p+q is first-col-of-circulant;

theorem 
  len p=len q & p is first-col-of-circulant & q is
  first-col-of-circulant implies CCirc(p+q) = CCirc(p)+CCirc(q);

theorem 
  n>0 implies 1.(K,n) is col_circulant;

theorem 
  n>0 implies 1.(K,n) is line_circulant;

theorem 
  p is first-line-of-circulant implies a*p is first-line-of-circulant;

theorem 
  p is first-line-of-circulant implies LCirc(a*p) =a*(LCirc p);

theorem 
  p is first-line-of-circulant implies a*(LCirc p)+b*(LCirc p)=LCirc((a+ b)*p);

theorem 
  p is first-line-of-circulant & q is first-line-of-circulant & len p =
  len q implies a*(LCirc p)+a*(LCirc q)=LCirc(a*(p+q));

theorem 
  p is first-line-of-circulant & q is first-line-of-circulant & len p =
  len q implies a*(LCirc p)+b*(LCirc q)=LCirc(a*p+b*q);

theorem 
  p is first-col-of-circulant implies a*p is first-col-of-circulant;

theorem 
  p is first-col-of-circulant implies CCirc(a*p)=a*(CCirc p);

theorem 
  p is first-col-of-circulant implies a*(CCirc p)+b*(CCirc p)=CCirc((a+b )*p);

theorem 
  p is first-col-of-circulant & q is first-col-of-circulant & len p =
  len q & len p > 0 implies a*(CCirc p)+a*(CCirc q)=CCirc(a*(p+q));

theorem 
  p is first-col-of-circulant & q is first-col-of-circulant & len p =
  len q implies a*(CCirc p)+b*(CCirc q)=CCirc(a*p+b*q);

notation
  let K be set;
  let M be Matrix of K;
  synonym M is circulant for M is line_circulant;
end;

begin 

definition
  let K be Field;
  let M1 be Matrix of K;
  let p be FinSequence of K;
  pred M1 is_anti-circular_about p means


  len p=width M1 & (for i,j be
Nat st [i,j] in Indices M1 & i<=j holds M1*(i,j)=p.((j-i mod len p)+1)) & for i
,j be Nat st [i,j] in Indices M1 & i>=j holds M1*(i,j)=(-p).((j-i mod len p)+1)
  ;
end;

definition
  let K be Field;
  let M be Matrix of K;
  attr M is anti-circular means


  ex p being FinSequence of K st len p= width M & M is_anti-circular_about p;
end;

definition
  let K be Field;
  let p be FinSequence of K;
  attr p is first-line-of-anti-circular means


  ex M being Matrix of len p,K st M is_anti-circular_about p;
end;

definition
  let K be Field, p be FinSequence of K;
  assume
 p is first-line-of-anti-circular;
  func ACirc(p) -> Matrix of len p,K means


  it is_anti-circular_about p;
end;

theorem 
  M1 is anti-circular implies a*M1 is anti-circular;

theorem 
  M1 is anti-circular & M2 is anti-circular implies M1+M2 is anti-circular;

theorem 
  for K being Fanoian Field, n,i,j being Nat, M1 being Matrix of n,K st
  [i,j] in Indices M1 & i=j & M1 is anti-circular holds M1*(i,j)=0.K;

theorem 
  M1 is anti-circular & [i,j] in [:Seg n, Seg n:] & k=i+1 & l=j+1 & i<n
  & j<n implies M1*(k,l)=M1*(i,j);

theorem 
  M1 is anti-circular implies -M1 is anti-circular;

theorem 
  M1 is anti-circular & M2 is anti-circular implies M1-M2 is anti-circular;

theorem 
  M1 is_anti-circular_about p & n>0 implies p = Line(M1,1);

theorem 
  p is first-line-of-anti-circular implies -p is first-line-of-anti-circular;

theorem 
  p is first-line-of-anti-circular implies ACirc(-p) =-(ACirc(p));

theorem 
  p is first-line-of-anti-circular & q is
  first-line-of-anti-circular & len p = len q implies p+q is
  first-line-of-anti-circular;

theorem 
  p is first-line-of-anti-circular & q is
first-line-of-anti-circular & len p = len q implies ACirc(p+q) = ACirc(p)+ACirc
  (q);

theorem 
  p is first-line-of-anti-circular implies a*p is first-line-of-anti-circular;

theorem 
  p is first-line-of-anti-circular implies ACirc(a*p) =a*(ACirc p);

theorem 
  p is first-line-of-anti-circular implies a*(ACirc p)+b*(ACirc p)=ACirc
  ((a+b)*p);

theorem 
  p is first-line-of-anti-circular & q is first-line-of-anti-circular &
  len p = len q implies a*(ACirc p)+a*(ACirc q)=ACirc(a*(p+q));

theorem 
  p is first-line-of-anti-circular & q is first-line-of-anti-circular &
  len p = len q implies a*(ACirc p)+b*(ACirc q)=ACirc(a*p+b*q);

registration
  let K,n;
  cluster 0.(K,n) -> anti-circular;
end;














begin 

definition
  let V be non empty RLSStruct, V1 be Subset of V;
  attr V1 is multi-closed means


  for a be Real, v be VECTOR of V st v in V1 holds a*v in V1;
end;

theorem 
  for V be RealLinearSpace, V1 be Subset of V holds V1 is
  linearly-closed iff V1 is add-closed multi-closed;

registration
  let V be non empty RLSStruct;
  cluster add-closed multi-closed non empty for Subset of V;
end;

definition
  let X be non empty RLSStruct;
  let X1 be multi-closed non empty Subset of X;
  func Mult_X1 -> Function of [:REAL,X1:], X1 equals

  (the Mult of X) | [:REAL,
  X1:];
end;

reserve a,b,r for Real;

theorem 
  for V be Abelian add-associative right_zeroed
vector-distributive scalar-distributive scalar-associative scalar-unital
 non empty RLSStruct, V1 be non empty Subset of V, d1 be
Element of V1, A be BinOp of V1, M be Function of [:REAL,V1:],V1 st d1 = 0.V &
A = (the addF of V)|| V1 & M = (the Mult of V)|[:REAL,V1:] holds RLSStruct(# V1
    ,d1,A,M #) is Abelian add-associative right_zeroed vector-distributive
    scalar-distributive scalar-associative scalar-unital;

theorem 
  for V be Abelian add-associative right_zeroed
  vector-distributive scalar-distributive scalar-associative scalar-unital
   non empty RLSStruct, V1 be add-closed multi-closed non
empty Subset of V st 0.V in V1 holds RLSStruct (# V1,In (0.V, V1), add|(V1,V),
    Mult_ V1 #) is Abelian add-associative right_zeroed vector-distributive
    scalar-distributive scalar-associative scalar-unital;

theorem 
  for V be non empty RLSStruct, V1 be add-closed multi-closed non
empty Subset of V, v,u be VECTOR of V, w1,w2 be VECTOR of RLSStruct (# V1,In(0.
    V,V1), add|(V1,V), Mult_ V1 #) st w1 = v & w2 = u holds w1 + w2 = v + u;

theorem 
  for V be non empty RLSStruct, V1 be add-closed multi-closed non
empty Subset of V, a be Real, v be VECTOR of V, w be VECTOR of RLSStruct (# V1,
    In (0.V, V1), add|(V1,V), Mult_ V1 #) st w = v holds a*w = a*v;

begin 

reserve A,B for non empty set;
reserve f,g,h for Element of PFuncs(A,REAL);

definition
  let A,B;
  let F be BinOp of PFuncs(A,B), f,g be Element of PFuncs(A,B);
  redefine func F.(f,g) -> Element of PFuncs(A,B);
end;

definition
  let A;
  func multpfunc A -> BinOp of PFuncs(A,REAL) means


  for f,g being Element of PFuncs(A,REAL) holds it.(f,g) = f(#)g;
end;

definition
  let A;
  func multrealpfunc A -> Function of [:REAL,PFuncs(A,REAL):],PFuncs(A,REAL)
  means


  for a being Real, f being Element of PFuncs(A,REAL) holds it.(a,f) = a(#)f;
end;

definition
  let A;
  func RealPFuncZero A -> Element of PFuncs(A,REAL) equals

  A --> 0;
end;

definition
  let A;
  func RealPFuncUnit A -> Element of PFuncs(A,REAL) equals

  A --> 1;
end;

theorem 
  h = (addpfunc A).(f,g) iff (dom h= dom f /\ dom g & for x being
  Element of A st x in dom h holds h.x = f.x + g.x);

theorem 
  h = (multpfunc A).(f,g) iff dom h = dom f /\ dom g & for x being
  Element of A st x in dom h holds h.x = f.x * g.x;

theorem 
  RealPFuncZero A <> RealPFuncUnit A;

theorem 
  h = (multrealpfunc A).(a,f) iff dom h = dom f & for x being
  Element of A st x in dom f holds h.x = a * f.x;

theorem 
  (addpfunc A).(f,g) = (addpfunc A).(g,f);

theorem 
  (addpfunc A).(f,(addpfunc A).(g,h)) = (addpfunc A).((addpfunc A) .(f,g),h);

theorem 
  (multpfunc A).(f,g) = (multpfunc A).(g,f);

theorem 
  (multpfunc A).(f,(multpfunc A).(g,h)) = (multpfunc A).((multpfunc A).(
  f,g),h);

theorem 
  (multpfunc A).(RealPFuncUnit A,f) = f;

theorem 
  (addpfunc A).(RealPFuncZero A,f) = f;

theorem 
  (addpfunc A).(f,(multrealpfunc A).(-1,f)) = (RealPFuncZero A)|( dom f);

theorem 
  (multrealpfunc A).(1,f) = f;

theorem 
  (multrealpfunc A).(a,(multrealpfunc A).(b,f)) = (multrealpfunc A ).(a*b,f);

theorem 
  (addpfunc A).((multrealpfunc A).(a,f),(multrealpfunc A).(b,f)) =
  (multrealpfunc A).(a+b,f);

theorem 
  (multpfunc A).(f,(addpfunc A).(g,h)) = (addpfunc A).((multpfunc A).(f,
  g),(multpfunc A).(f,h));

theorem 
  (multpfunc A).((multrealpfunc A).(a,f),g) = (multrealpfunc A).(a,(
  multpfunc A).(f,g));

definition
  let A;
  func RLSp_PFunctA -> non empty RLSStruct equals

  RLSStruct(#PFuncs(A,REAL),
    RealPFuncZero A, addpfunc A, multrealpfunc A#);
end;

reserve u,v,w for VECTOR of RLSp_PFunctA;

registration
  let A;
  cluster RLSp_PFunctA -> strict Abelian add-associative right_zeroed
    vector-distributive scalar-distributive scalar-associative scalar-unital;
end;

begin 

reserve X for non empty set,
  x for Element of X,
  S for SigmaField of X,
  M for sigma_Measure of S,
  E,E1,E2 for Element of S,
  f,g,h,f1,g1 for PartFunc of X ,REAL;

theorem 
  for X,S,M for f be PartFunc of X,ExtREAL st (ex E st E = dom f)
& for x st x in dom f holds 0= f.x holds f is_integrable_on M & Integral(M,f) =
  0;

definition
  let X be non empty set, r be Real;
  redefine func X --> r -> PartFunc of X,REAL;
end;

definition
  let X be non empty set, S be SigmaField of X, M be sigma_Measure of S;
  func L1_Functions M -> non empty Subset of RLSp_PFunctX equals

  { f where f
  is PartFunc of X,REAL : ex ND be Element of S st M.ND=0 & dom f = ND` & f
  is_integrable_on M };
end;

theorem 
  f in L1_Functions M & g in L1_Functions M implies f + g in L1_Functions M;

theorem 
  f in L1_Functions M implies a(#)f in L1_Functions M;

registration
  let X be non empty set, S be SigmaField of X, M be sigma_Measure of S;
  cluster L1_Functions M -> multi-closed add-closed;
end;

definition
  let X be non empty set, S be SigmaField of X, M be sigma_Measure of S;
  func RLSp_L1Funct M -> non empty RLSStruct equals

  RLSStruct (# L1_Functions
M, In (0.(RLSp_PFunctX), L1_Functions M), add|(L1_Functions M,RLSp_PFunctX),
    Mult_(L1_Functions M) #);
end;

registration
  let X be non empty set, S be SigmaField of X, M be sigma_Measure of S;
  cluster RLSp_L1Funct M -> strict Abelian add-associative right_zeroed
    vector-distributive scalar-distributive scalar-associative scalar-unital;
end;

begin 

reserve v,u for VECTOR of RLSp_L1Funct M;

theorem 
  f=v & g=u implies f+g=v+u;

theorem 
  f=u implies a(#)f=a*u;

definition
  let X be non empty set, S be SigmaField of X, M be sigma_Measure of S, f,g
  be PartFunc of X,REAL;
  pred f a.e.= g,M means


  ex E be Element of S st M.E = 0 & f|E` = g|E`;
end;

theorem 
  f=u implies u+(-1)*u = (X --> 0)|dom f & ex v,g be PartFunc of X
,REAL st v in L1_Functions M & g in L1_Functions M & v = u+(-1)*u & g = X --> 0
  & v a.e.= g,M;

theorem 
  f a.e.= f,M;

theorem 
  f a.e.= g,M implies g a.e.= f,M;

theorem 
  f a.e.= g,M & g a.e.= h,M implies f a.e.= h,M;

theorem 
  f a.e.= f1,M & g a.e.= g1,M implies (f+g) a.e.= (f1+g1),M;

theorem 
  f a.e.= g,M implies a(#)f a.e.= a(#)g,M;

definition
  let X be non empty set, S be SigmaField of X, M be sigma_Measure of S;
  func AlmostZeroFunctions M -> non empty Subset of RLSp_L1Funct M equals

  { f
  where f is PartFunc of X,REAL : f in L1_Functions M & f a.e.= X-->0,M };
end;

theorem 
  (X-->0) + (X-->0) = X-->0 & a(#)(X-->0) = X-->0;

registration
  let X be non empty set, S be SigmaField of X, M be sigma_Measure of S;
  cluster AlmostZeroFunctions M -> add-closed multi-closed;
end;

theorem 
  0.(RLSp_L1Funct M) = X-->0 & 0.(RLSp_L1Funct M) in AlmostZeroFunctions M;

definition
  let X be non empty set, S be SigmaField of X, M be sigma_Measure of S;
  func RLSp_AlmostZeroFunct M -> non empty RLSStruct equals

  RLSStruct (#
    AlmostZeroFunctions M, In(0.(RLSp_L1Funct M),AlmostZeroFunctions M), add|(
    AlmostZeroFunctions M,RLSp_L1Funct M), Mult_(AlmostZeroFunctions M) #);
end;

registration
  let X be non empty set, S be SigmaField of X, M be sigma_Measure of S;
  cluster RLSp_L1Funct M -> strict strict Abelian add-associative right_zeroed
    vector-distributive scalar-distributive scalar-associative scalar-unital;
end;

reserve v,u for VECTOR of RLSp_AlmostZeroFunct M;

theorem 
  f=v & g=u implies f+g=v+u;

theorem 
  f=u implies a(#)f=a*u;

definition
  let X be non empty set, S be SigmaField of X, M be sigma_Measure of S, f be
  PartFunc of X,REAL;
  func a.e-eq-class(f,M) -> Subset of L1_Functions M equals

  {g where g is
PartFunc of X,REAL : g in L1_Functions M & f in L1_Functions M & f a.e.= g,M };
end;

theorem 
  f in L1_Functions M & g in L1_Functions M implies (g a.e.= f,M
  iff g in a.e-eq-class(f,M));

theorem 
  f in L1_Functions M implies f in a.e-eq-class(f,M);

theorem 
  f in L1_Functions M & g in L1_Functions M implies (a.e-eq-class(
  f,M) = a.e-eq-class(g,M) iff f a.e.= g,M);

theorem 
  f in L1_Functions M & g in L1_Functions M implies (a.e-eq-class(f,M) =
  a.e-eq-class(g,M) iff g in a.e-eq-class(f,M));

theorem 
  f in L1_Functions M & f1 in L1_Functions M & g in L1_Functions M
& g1 in L1_Functions M & a.e-eq-class(f,M) = a.e-eq-class(f1,M) & a.e-eq-class(
  g,M) = a.e-eq-class(g1,M) implies a.e-eq-class(f+g,M) = a.e-eq-class(f1+g1,M)
;

theorem 
  f in L1_Functions M & g in L1_Functions M & a.e-eq-class(f,M) =
  a.e-eq-class(g,M) implies a.e-eq-class(a(#)f,M) = a.e-eq-class(a(#)g,M);

definition
  let X be non empty set, S be SigmaField of X, M be sigma_Measure of S;
  func CosetSet M -> non empty Subset-Family of L1_Functions M equals

  {
  a.e-eq-class(f,M) where f is PartFunc of X,REAL : f in L1_Functions M};
end;

definition
  let X be non empty set, S be SigmaField of X, M be sigma_Measure of S;
  func addCoset M -> BinOp of CosetSet M means


  for A,B be Element of
  CosetSet M, a,b be PartFunc of X,REAL st a in A & b in B holds it.(A,B) =
  a.e-eq-class(a+b,M);
end;

definition
  let X be non empty set, S be SigmaField of X, M be sigma_Measure of S;
  func zeroCoset M -> Element of CosetSet M means


  ex f be PartFunc of
  X,REAL st f = X --> 0 & f in L1_Functions M & it = a.e-eq-class(f,M);
end;

definition
  let X be non empty set, S be SigmaField of X, M be sigma_Measure of S;
  func lmultCoset M -> Function of [:REAL, CosetSet M:],CosetSet M means


   for
 z be Element of REAL, A be Element of CosetSet M, f be PartFunc of X
  ,REAL st f in A holds it.(z,A) = a.e-eq-class(z(#)f,M);
end;

definition
  let X be non empty set, S be SigmaField of X, M be sigma_Measure of S;
  func Pre-L-Space M -> strict Abelian add-associative right_zeroed
  right_complementable vector-distributive scalar-distributive
  scalar-associative scalar-unital non empty RLSStruct means


the carrier of it = CosetSet M & the addF of it = addCoset M & 0.it = zeroCoset
  M & the Mult of it = lmultCoset M;
end;

begin 

theorem 
  f in L1_Functions M & g in L1_Functions M & f a.e.= g,M implies
  Integral(M,f) = Integral(M,g);

theorem 
  f is_integrable_on M implies Integral(M,f) in REAL & Integral(M,
  abs f) in REAL & abs f is_integrable_on M;

theorem 
  f in L1_Functions M & g in L1_Functions M & f a.e.= g,M implies
  abs f a.e.= (abs g),M & Integral(M,abs f) = Integral(M,abs g);

theorem 
  (ex x be VECTOR of Pre-L-Space M st f in x & g in x) implies f
  a.e.= g,M & f in L1_Functions M & g in L1_Functions M;

reserve x for Point of Pre-L-Space M;

theorem 
  f in x implies f is_integrable_on M & f in L1_Functions M & abs
  f is_integrable_on M;

theorem 
  f in x & g in x implies f a.e.= g,M & Integral(M,f) = Integral(M
  ,g) & Integral(M,abs f) = Integral(M,abs g);

definition
  let X be non empty set, S be SigmaField of X, M be sigma_Measure of S;
  func L-1-Norm M -> Function of the carrier of Pre-L-Space M,REAL means


   for x be Point of Pre-L-Space M ex f be PartFunc of X,REAL st f in x &
  it.x = Integral(M,abs f);
end;

definition
  let X be non empty set, S be SigmaField of X, M be sigma_Measure of S;
  func L-1-Space M -> non empty NORMSTR equals

  NORMSTR (# the carrier of
Pre-L-Space M, the ZeroF of Pre-L-Space M, the addF of Pre-L-Space M, the Mult
    of Pre-L-Space M, L-1-Norm M #);
end;

reserve x,y for Point of L-1-Space M;

theorem 
  ( ex f be PartFunc of X,REAL st f in L1_Functions M & x=
a.e-eq-class(f,M) & ||.x.|| = Integral(M,abs f) ) & for f be PartFunc of X,REAL
  st f in x holds Integral(M,abs f) = ||.x.||;

theorem 
  f in x implies x= a.e-eq-class(f,M) & ||.x.|| = Integral(M,abs f );

theorem 
  (f in x & g in y implies f+g in x+y) & (f in x implies a(#)f in a*x);

theorem 
  E = dom f & (for x be set st x in dom f holds f.x=r) implies f
  is_measurable_on E;

theorem 
  f in L1_Functions M & Integral(M,abs f) = 0 implies f a.e.= X--> 0,M;

theorem 
  Integral(M,abs(X-->0)) = 0;

theorem 
  f is_integrable_on M & g is_integrable_on M implies Integral(M,
  abs(f+g)) <= Integral(M,abs f) + Integral(M,abs g);

registration
  let X be non empty set, S be SigmaField of X, M be sigma_Measure of S;
  cluster L-1-Space M -> RealNormSpace-like vector-distributive
  scalar-distributive scalar-associative scalar-unital Abelian
    add-associative right_zeroed right_complementable;
end;














begin 

reserve X for BCI-algebra;
reserve n for Element of NAT;

definition
  let D be set, f be Function of NAT,D;
  let n be Nat;
  redefine func f.n -> Element of D;
end;

definition
  let G be non empty BCIStr_0;
  func BCI-power G -> Function of [:the carrier of G,NAT:],the carrier of G
  means


  for x being Element of G holds it.(x,0)=0.G & for n holds it.(x,n
  + 1) = x\(it.(x,n))`;
end;

reserve x,y for Element of X;
reserve a,b for Element of AtomSet(X);
reserve m,n for Nat;
reserve i,j for Integer;

definition
  let X,i,x;
  func x |^ i -> Element of X equals


  BCI-power(X).(x,abs(i)) if 0 <= i
  otherwise (BCI-power(X).(x`,abs(i)));
end;

definition
  let X,n,x;
  redefine func x |^ n equals

  BCI-power(X).(x,n);
end;

theorem 
  a\(x\b) = b\(x\a);

theorem 
  x |^ (n+1) = x\(x |^ n )`;

theorem 
  x |^ 0 = 0.X;

theorem 
  x |^ 1 = x;

theorem 
  x |^ -1 = x`;

theorem 
  x |^ 2 = x\x`;

theorem 
  0.X |^ n = 0.X;



theorem 
  (a |^ (-1))|^ (-1) = a;

theorem 
  x |^(-n) =(x``)|^(-n);

theorem 
  a` |^ n = a |^ -n;

theorem 
  x in BCK-part(X) & n>=1 implies x|^n = x;

theorem 
  x in BCK-part(X) implies x|^ (-n) = 0.X;



theorem 
  a|^i in AtomSet(X);

theorem 
  (a|^(n+1))` = (a|^n)`\a;

theorem 
  (a\b)|^n = a|^n\(b|^n);

theorem 
  (a\b)|^(-n) = a|^(-n)\(b|^(-n));

theorem 
  a`|^n = (a|^n)`;

theorem 
  x`|^n = (x|^n)`;

theorem 
  a`|^(-n) = (a|^(-n))`;

theorem 
  a=(x``)|^n implies x|^n in BranchV(a);

theorem 
  (x|^n)` = ((x``)|^n)`;

theorem 
  a|^i \ a|^j = a|^(i-j);



theorem 
  (a|^i)|^j = a|^(i*j);

theorem 
  a|^(i+j) = a|^i\(a|^j)`;

definition
  let X,x;
  attr x is finite-period means


  ex n being Element of NAT st n<>0 & x|^ n in BCK-part(X);
end;

theorem 
  x is finite-period implies x`` is finite-period;

definition
  let X,x such that
 x is finite-period;
  func ord x -> Element of NAT means


  x|^it in BCK-part(X)& it<>0 & for
  m being Element of NAT st x|^m in BCK-part(X) & m <> 0 holds it <= m;
end;

theorem 
  a is finite-period & ord a = n implies a|^n = 0.X;

theorem 
  X is BCK-algebra iff for x holds x is finite-period & ord x = 1;

theorem 
  x is finite-period & a is finite-period & x in BranchV(a)
  implies ord x = ord a;

theorem 
  x is finite-period & ord x = n implies(x|^m in BCK-part(X) iff n divides m);

theorem 
  x is finite-period & x|^m is finite-period & ord x = n & m>0 implies
  ord(x|^m)=n div (m gcd n);

theorem 
  x is finite-period & x` is finite-period implies ord x = ord(x`);

theorem 
  x\y is finite-period & x in BranchV(a) & y in BranchV(a) implies ord(x \y)=1;

theorem 
  a\b is finite-period & x is finite-period & y is finite-period & a is
finite-period & b is finite-period & x in BranchV(a) & y in BranchV(b) implies
  ord(a\b) divides (ord x lcm ord y);

begin 

reserve X,X9,Y for BCI-algebra,
  H9 for SubAlgebra of X9,
  G for SubAlgebra of X,

  A9 for non empty Subset of X9,
  I for Ideal of X,
  CI,K for closed Ideal of X,
  x,y,a,b for Element of X,
  RI for I-congruence of X,I,
  RK for I-congruence of X,K;

theorem 
  for X being BCI-algebra for Y being SubAlgebra of X holds for x,
y being Element of X,x9,y9 being Element of Y st x = x9 & y = y9 holds x\y = x9
  \y9;

definition
  let X,X9 be non empty BCIStr_0;
  let f be Function of X,X9;
  attr f is multiplicative means


  for a, b being Element of X holds f.(a \b) = f.a\f.b;
end;

registration
  let X,X9 be BCI-algebra;
  cluster multiplicative for Function of X,X9;
end;

definition
  let X,X9 be BCI-algebra;
  mode BCI-homomorphism of X,X9 is multiplicative Function of X,X9;
end;

reserve f for BCI-homomorphism of X,X9;
reserve g for BCI-homomorphism of X9,X;
reserve h for BCI-homomorphism of X9,Y;

definition
  let X,X9,f;
  attr f is isotonic means

  for x,y st x <= y holds f.x <= f.y;
end;

definition
  let X;
  mode Endomorphism of X is BCI-homomorphism of X,X;
end;

definition
  let X,X9,f;
  func Ker f equals

  {x where x is Element of X:f.x=0.X9};
end;

theorem 
  f.(0.X) = 0.X9;

registration
  let X,X9,f;
  cluster Ker f -> non empty;
end;

theorem 
  x <= y implies f.x <= f.y;

theorem 
  f is one-to-one iff Ker(f) = {0.X};

theorem 
  f is bijective & g=f" implies g is bijective;

theorem 
  h*f is BCI-homomorphism of X,Y;

theorem 
  for Z being SubAlgebra of X9 st the carrier of Z = rng f holds f is
  BCI-homomorphism of X,Z;

theorem 
  Ker f is closed Ideal of X;

registration
  let X,X9,f;
  cluster Ker f -> closed for Ideal of X;
end;

theorem 
  f is onto implies for c being Element of X9 ex x st c = f.x;



theorem 
  for a being Element of X st a is minimal holds f.a is minimal;

theorem 
  for a being Element of AtomSet(X),b being Element of AtomSet(X9)st b=f
  .a holds f.:BranchV(a) c= BranchV(b);



theorem 
  A9 is Ideal of X9 implies f"A9 is Ideal of X;

theorem 
  A9 is closed Ideal of X9 implies f"A9 is closed Ideal of X;

theorem 
  f is onto implies f.:I is Ideal of X9;

theorem 
  f is onto implies f.:CI is closed Ideal of X9;

definition
  let X,X9 be BCI-algebra;
  pred X,X9 are_isomorphic means


  ex f being BCI-homomorphism of X,X9 st f is bijective;
end;

registration
  let X;
  let I be Ideal of X,RI be I-congruence of X,I;
  cluster X./.RI -> strict being_B being_C being_I being_BCI-4;
end;

definition
  let X;
  let I be Ideal of X,RI be I-congruence of X,I;
  func nat_hom RI -> BCI-homomorphism of X, X./.RI means


  for x holds it.x = Class(RI,x);
end;

begin 










theorem 
  nat_hom RI is onto;

theorem 
  I=Ker f implies ex h being BCI-homomorphism of X./.RI,X9 st f =
  h*nat_hom(RI) & h is one-to-one;

theorem 
  for X,X9,I,RI,f st I=Ker f holds ex h being BCI-homomorphism of X./.RI
  ,X9 st f=h*nat_hom(RI) & h is one-to-one;

theorem 
  Ker(nat_hom RK) = K;

begin 

theorem 
  I = Ker f & the carrier of H9 = rng f implies X./.RI,H9 are_isomorphic;

theorem 
  I = Ker f & f is onto implies X./.RI,X9 are_isomorphic;

begin 

definition
  let X,G,K,RK;
  func Union(G,RK) -> non empty Subset of X equals

  union{Class(RK,a) where a
  is Element of G:Class(RK,a) in the carrier of X./.RK};
end;

definition
  let X,G,K,RK;
  func HKOp(G,RK) -> BinOp of Union(G,RK) means


  for w1,w2 being Element
  of Union(G,RK) for x,y being Element of X st w1=x&w2=y holds it.(w1,w2)=x\y;
end;

definition
  let X,G,K,RK;
  func zeroHK(G,RK) -> Element of Union(G,RK) equals

  0.X;
end;

definition
  let X,G,K,RK;
  func HK(G,RK) -> BCIStr_0 equals

  BCIStr_0(#Union(G,RK),HKOp(G,RK),zeroHK(G,
    RK) #);
end;

registration
  let X,G,K,RK;
  cluster HK(G,RK) -> non empty;
end;

definition
  let X,G,K,RK;
  let w1,w2 be Element of Union(G,RK);
  func w1\w2 -> Element of Union(G,RK) equals

  HKOp(G,RK).(w1,w2);
end;

theorem 
  HK(G,RK) is BCI-algebra;

registration
  let X,G,K,RK;
  cluster HK(G,RK) -> strict being_B being_C being_I being_BCI-4;
end;

theorem 
  HK(G,RK) is SubAlgebra of X;

theorem 
  (the carrier of G)/\K is closed Ideal of G;

theorem 
  for K1 being Ideal of HK(G,RK),RK1 being I-congruence of HK(G,RK),K1,
I being Ideal of G,RI being I-congruence of G,I st RK1=RK & I=(the carrier of G
  )/\K holds G./.RI,HK(G,RK)./.RK1 are_isomorphic;














begin 













































definition
  let ap,bp,cp,dp,cin be set;
  func BitFTA0Str(ap,bp,cp,dp,cin) -> unsplit gate`1=arity gate`2isBoolean non
  void strict non empty ManySortedSign equals

  BitGFA0Str(ap,bp,cp) +* BitGFA0Str(
  GFA0AdderOutput(ap,bp,cp),cin,dp);
end;

definition
  let ap,bp,cp,dp,cin be set;
  func BitFTA0Circ(ap,bp,cp,dp,cin) -> strict Boolean gate`2=den Circuit of
  BitFTA0Str(ap,bp,cp,dp,cin) equals

  BitGFA0Circ(ap,bp,cp) +* BitGFA0Circ(
  GFA0AdderOutput(ap,bp,cp),cin,dp);
end;






theorem 
  for ap,bp,cp,dp,cin being set holds InnerVertices BitFTA0Str(ap,
  bp,cp,dp,cin) = {[<*ap,bp*>,xor2], GFA0AdderOutput(ap,bp,cp)} \/ {[<*ap,bp*>,
  and2], [<*bp,cp*>,and2], [<*cp,ap*>,and2], GFA0CarryOutput(ap,bp,cp)} \/ {[<*
GFA0AdderOutput(ap,bp,cp),cin*>,xor2], GFA0AdderOutput(GFA0AdderOutput(ap,bp,cp
),cin,dp)} \/ {[<*GFA0AdderOutput(ap,bp,cp),cin*>,and2], [<*cin,dp*>,and2], [<*
dp,GFA0AdderOutput(ap,bp,cp)*>,and2], GFA0CarryOutput(GFA0AdderOutput(ap,bp,cp)
  ,cin,dp)};

theorem 
  for ap,bp,cp,dp,cin being set holds InnerVertices BitFTA0Str(ap,bp,cp,
  dp,cin) is Relation;

theorem 
  for ap,bp,cp,dp being non pair set for cin being set st cin <> [
<*dp,GFA0AdderOutput(ap,bp,cp)*>,and2] & not cin in InnerVertices BitGFA0Str(ap
  ,bp,cp) holds InputVertices BitFTA0Str(ap,bp,cp,dp,cin) = {ap,bp,cp,dp,cin};



theorem 
  for ap,bp,cp,dp,cin being set holds ap in the carrier of
BitFTA0Str(ap,bp,cp,dp,cin) & bp in the carrier of BitFTA0Str(ap,bp,cp,dp,cin)
  & cp in the carrier of BitFTA0Str(ap,bp,cp,dp,cin) & dp in the carrier of
BitFTA0Str(ap,bp,cp,dp,cin) & cin in the carrier of BitFTA0Str(ap,bp,cp,dp,cin)
  & [<*ap,bp*>,xor2] in the carrier of BitFTA0Str(ap,bp,cp,dp,cin) &
GFA0AdderOutput(ap,bp,cp) in the carrier of BitFTA0Str(ap,bp,cp,dp,cin) & [<*ap
,bp*>,and2] in the carrier of BitFTA0Str(ap,bp,cp,dp,cin) & [<*bp,cp*>,and2] in
the carrier of BitFTA0Str(ap,bp,cp,dp,cin) & [<*cp,ap*>,and2] in the carrier of
  BitFTA0Str(ap,bp,cp,dp,cin) & GFA0CarryOutput(ap,bp,cp) in the carrier of
  BitFTA0Str(ap,bp,cp,dp,cin) & [<*GFA0AdderOutput(ap,bp,cp),cin*>,xor2] in the
carrier of BitFTA0Str(ap,bp,cp,dp,cin) & GFA0AdderOutput(GFA0AdderOutput(ap,bp,
cp),cin,dp) in the carrier of BitFTA0Str(ap,bp,cp,dp,cin) & [<*GFA0AdderOutput(
ap,bp,cp),cin*>,and2] in the carrier of BitFTA0Str(ap,bp,cp,dp,cin) & [<*cin,dp
*>,and2] in the carrier of BitFTA0Str(ap,bp,cp,dp,cin) & [<*dp,GFA0AdderOutput(
  ap,bp,cp)*>,and2] in the carrier of BitFTA0Str(ap,bp,cp,dp,cin) &
GFA0CarryOutput(GFA0AdderOutput(ap,bp,cp),cin,dp) in the carrier of BitFTA0Str(
  ap,bp,cp,dp,cin);

theorem 
  for ap,bp,cp,dp,cin being set holds [<*ap,bp*>,xor2] in
  InnerVertices BitFTA0Str(ap,bp,cp,dp,cin) & GFA0AdderOutput(ap,bp,cp) in
  InnerVertices BitFTA0Str(ap,bp,cp,dp,cin) & [<*ap,bp*>,and2] in InnerVertices
BitFTA0Str(ap,bp,cp,dp,cin) & [<*bp,cp*>,and2] in InnerVertices BitFTA0Str(ap,
bp,cp,dp,cin) & [<*cp,ap*>,and2] in InnerVertices BitFTA0Str(ap,bp,cp,dp,cin) &
  GFA0CarryOutput(ap,bp,cp) in InnerVertices BitFTA0Str(ap,bp,cp,dp,cin) & [<*
GFA0AdderOutput(ap,bp,cp),cin*>,xor2] in InnerVertices BitFTA0Str(ap,bp,cp,dp,
  cin) & GFA0AdderOutput(GFA0AdderOutput(ap,bp,cp),cin,dp) in InnerVertices
  BitFTA0Str(ap,bp,cp,dp,cin) & [<*GFA0AdderOutput(ap,bp,cp),cin*>,and2] in
InnerVertices BitFTA0Str(ap,bp,cp,dp,cin) & [<*cin,dp*>,and2] in InnerVertices
  BitFTA0Str(ap,bp,cp,dp,cin) & [<*dp,GFA0AdderOutput(ap,bp,cp)*>,and2] in
InnerVertices BitFTA0Str(ap,bp,cp,dp,cin) & GFA0CarryOutput(GFA0AdderOutput(ap,
  bp,cp),cin,dp) in InnerVertices BitFTA0Str(ap,bp,cp,dp,cin);

theorem 
  for ap,bp,cp,dp being non pair set for cin being set st cin <> [
<*dp,GFA0AdderOutput(ap,bp,cp)*>,and2] & not cin in InnerVertices BitGFA0Str(ap
  ,bp,cp) holds ap in InputVertices BitFTA0Str(ap,bp,cp,dp,cin) & bp in
InputVertices BitFTA0Str(ap,bp,cp,dp,cin) & cp in InputVertices BitFTA0Str(ap,
  bp,cp,dp,cin) & dp in InputVertices BitFTA0Str(ap,bp,cp,dp,cin) & cin in
  InputVertices BitFTA0Str(ap,bp,cp,dp,cin);






definition
  let ap,bp,cp,dp,cin be set;
  func BitFTA0CarryOutput(ap,bp,cp,dp,cin) -> Element of InnerVertices
  BitFTA0Str(ap,bp,cp,dp,cin) equals

  GFA0CarryOutput(ap,bp,cp);
  func BitFTA0AdderOutputI(ap,bp,cp,dp,cin) -> Element of InnerVertices
  BitFTA0Str(ap,bp,cp,dp,cin) equals

  GFA0AdderOutput(ap,bp,cp);
  func BitFTA0AdderOutputP(ap,bp,cp,dp,cin) -> Element of InnerVertices
  BitFTA0Str(ap,bp,cp,dp,cin) equals

  GFA0CarryOutput(GFA0AdderOutput(ap,bp,cp),
  cin,dp);
  func BitFTA0AdderOutputQ(ap,bp,cp,dp,cin) -> Element of InnerVertices
  BitFTA0Str(ap,bp,cp,dp,cin) equals

  GFA0AdderOutput(GFA0AdderOutput(ap,bp,cp),
  cin,dp);
end;






theorem 
  for ap,bp,cp being non pair set for dp,cin being set for s being State
of BitFTA0Circ(ap,bp,cp,dp,cin) for a1,a2,a3 being Element of BOOLEAN st a1 = s
.ap & a2 = s.bp & a3 = s.cp holds Following(s,2).BitFTA0CarryOutput(ap,bp,cp,dp
  ,cin) = (a1 '&' a2) 'or' (a2 '&' a3) 'or' (a3 '&' a1) & Following(s,2).
  BitFTA0AdderOutputI(ap,bp,cp,dp,cin) = a1 'xor' a2 'xor' a3;



theorem 
  for ap,bp,cp,dp being non pair set for cin being set st cin <> [
<*dp,GFA0AdderOutput(ap,bp,cp)*>,and2] & not cin in InnerVertices BitGFA0Str(ap
  ,bp,cp) for s being State of BitFTA0Circ(ap,bp,cp,dp,cin) for a1,a2,a3,a4,a5
being Element of BOOLEAN st a1 = s.ap & a2 = s.bp & a3 = s.cp & a4 = s.dp & a5
= s.cin holds Following(s,2).GFA0AdderOutput(ap,bp,cp) = a1 'xor' a2 'xor' a3 &
  Following(s,2).ap = a1 & Following(s,2).bp = a2 & Following(s,2).cp = a3 &
  Following(s,2).dp = a4 & Following(s,2).cin = a5;



theorem 
  for ap,bp,cp,dp being non pair set for cin being set st cin <> [<*dp,
GFA0AdderOutput(ap,bp,cp)*>,and2] & not cin in InnerVertices BitGFA0Str(ap,bp,
cp) for s being State of BitFTA0Circ(ap,bp,cp,dp,cin) for a1,a2,a3,a4,a5 being
  Element of BOOLEAN st a1 = s.ap & a2 = s.bp & a3 = s.cp & a4 = s.dp & a5 = s.
  cin holds Following(s,4).BitFTA0AdderOutputP(ap,bp,cp,dp,cin) = ((a1 'xor' a2
  'xor' a3) '&' a5) 'or' (a5 '&' a4) 'or' (a4 '&' (a1 'xor' a2 'xor' a3)) &
  Following(s,4).BitFTA0AdderOutputQ(ap,bp,cp,dp,cin) = a1 'xor' a2 'xor' a3
  'xor' a4 'xor' a5;



theorem 
  for ap,bp,cp,dp being non pair set for cin being set st cin <> [<*dp,
GFA0AdderOutput(ap,bp,cp)*>,and2] for s being State of BitFTA0Circ(ap,bp,cp,dp,
  cin) holds Following(s,4) is stable;

begin 













































definition
  let ap,bm,cp,dm,cin be set;
  func BitFTA1Str(ap,bm,cp,dm,cin) -> unsplit gate`1=arity gate`2isBoolean non
  void strict non empty ManySortedSign equals

  BitGFA1Str(ap,bm,cp) +* BitGFA2Str(
  GFA1AdderOutput(ap,bm,cp),cin,dm);
end;

definition
  let ap,bm,cp,dm,cin be set;
  func BitFTA1Circ(ap,bm,cp,dm,cin) -> strict Boolean gate`2=den Circuit of
  BitFTA1Str(ap,bm,cp,dm,cin) equals

  BitGFA1Circ(ap,bm,cp) +* BitGFA2Circ(
  GFA1AdderOutput(ap,bm,cp),cin,dm);
end;






theorem 
  for ap,bm,cp,dm,cin being set holds InnerVertices BitFTA1Str(ap,
bm,cp,dm,cin) = {[<*ap,bm*>,xor2c], GFA1AdderOutput(ap,bm,cp)} \/ {[<*ap,bm*>,
and2c], [<*bm,cp*>,and2a], [<*cp,ap*>,and2], GFA1CarryOutput(ap,bm,cp)} \/ {[<*
GFA1AdderOutput(ap,bm,cp),cin*>,xor2c], GFA2AdderOutput(GFA1AdderOutput(ap,bm,
cp),cin,dm)} \/ {[<*GFA1AdderOutput(ap,bm,cp),cin*>,and2a], [<*cin,dm*>,and2c],
[<*dm,GFA1AdderOutput(ap,bm,cp)*>,and2b], GFA2CarryOutput(GFA1AdderOutput(ap,bm
  ,cp),cin,dm)};

theorem 
  for ap,bm,cp,dm,cin being set holds InnerVertices BitFTA1Str(ap,bm,cp,
  dm,cin) is Relation;

theorem 
  for ap,bm,cp,dm being non pair set for cin being set st cin <> [
<*dm,GFA1AdderOutput(ap,bm,cp)*>,and2b] & not cin in InnerVertices BitGFA1Str(
  ap,bm,cp) holds InputVertices BitFTA1Str(ap,bm,cp,dm,cin) = {ap,bm,cp,dm,cin}
;



theorem 
  for ap,bm,cp,dm,cin being set holds ap in the carrier of
BitFTA1Str(ap,bm,cp,dm,cin) & bm in the carrier of BitFTA1Str(ap,bm,cp,dm,cin)
  & cp in the carrier of BitFTA1Str(ap,bm,cp,dm,cin) & dm in the carrier of
BitFTA1Str(ap,bm,cp,dm,cin) & cin in the carrier of BitFTA1Str(ap,bm,cp,dm,cin)
  & [<*ap,bm*>,xor2c] in the carrier of BitFTA1Str(ap,bm,cp,dm,cin) &
GFA1AdderOutput(ap,bm,cp) in the carrier of BitFTA1Str(ap,bm,cp,dm,cin) & [<*ap
,bm*>,and2c] in the carrier of BitFTA1Str(ap,bm,cp,dm,cin) & [<*bm,cp*>,and2a]
  in the carrier of BitFTA1Str(ap,bm,cp,dm,cin) & [<*cp,ap*>,and2 ] in the
  carrier of BitFTA1Str(ap,bm,cp,dm,cin) & GFA1CarryOutput(ap,bm,cp) in the
  carrier of BitFTA1Str(ap,bm,cp,dm,cin) & [<*GFA1AdderOutput(ap,bm,cp),cin*>,
  xor2c] in the carrier of BitFTA1Str(ap,bm,cp,dm,cin) & GFA2AdderOutput(
GFA1AdderOutput(ap,bm,cp),cin,dm) in the carrier of BitFTA1Str(ap,bm,cp,dm,cin)
& [<*GFA1AdderOutput(ap,bm,cp),cin*>,and2a] in the carrier of BitFTA1Str(ap,bm,
cp,dm,cin) & [<*cin,dm*>,and2c] in the carrier of BitFTA1Str(ap,bm,cp,dm,cin) &
[<*dm,GFA1AdderOutput(ap,bm,cp)*>,and2b] in the carrier of BitFTA1Str(ap,bm,cp,
  dm,cin) & GFA2CarryOutput(GFA1AdderOutput(ap,bm,cp),cin,dm) in the carrier of
  BitFTA1Str(ap,bm,cp,dm,cin);

theorem 
  for ap,bm,cp,dm,cin being set holds [<*ap,bm*>,xor2c] in
  InnerVertices BitFTA1Str(ap,bm,cp,dm,cin) & GFA1AdderOutput(ap,bm,cp) in
InnerVertices BitFTA1Str(ap,bm,cp,dm,cin) & [<*ap,bm*>,and2c] in InnerVertices
BitFTA1Str(ap,bm,cp,dm,cin) & [<*bm,cp*>,and2a] in InnerVertices BitFTA1Str(ap,
bm,cp,dm,cin) & [<*cp,ap*>,and2 ] in InnerVertices BitFTA1Str(ap,bm,cp,dm,cin)
& GFA1CarryOutput(ap,bm,cp) in InnerVertices BitFTA1Str(ap,bm,cp,dm,cin) & [<*
GFA1AdderOutput(ap,bm,cp),cin*>,xor2c] in InnerVertices BitFTA1Str(ap,bm,cp,dm,
  cin) & GFA2AdderOutput(GFA1AdderOutput(ap,bm,cp),cin,dm) in InnerVertices
  BitFTA1Str(ap,bm,cp,dm,cin) & [<*GFA1AdderOutput(ap,bm,cp),cin*>,and2a] in
InnerVertices BitFTA1Str(ap,bm,cp,dm,cin) & [<*cin,dm*>,and2c] in InnerVertices
  BitFTA1Str(ap,bm,cp,dm,cin) & [<*dm,GFA1AdderOutput(ap,bm,cp)*>,and2b] in
InnerVertices BitFTA1Str(ap,bm,cp,dm,cin) & GFA2CarryOutput(GFA1AdderOutput(ap,
  bm,cp),cin,dm) in InnerVertices BitFTA1Str(ap,bm,cp,dm,cin);

theorem 
  for ap,bm,cp,dm being non pair set for cin being set st cin <> [
<*dm,GFA1AdderOutput(ap,bm,cp)*>,and2b] & not cin in InnerVertices BitGFA1Str(
  ap,bm,cp) holds ap in InputVertices BitFTA1Str(ap,bm,cp,dm,cin) & bm in
InputVertices BitFTA1Str(ap,bm,cp,dm,cin) & cp in InputVertices BitFTA1Str(ap,
  bm,cp,dm,cin) & dm in InputVertices BitFTA1Str(ap,bm,cp,dm,cin) & cin in
  InputVertices BitFTA1Str(ap,bm,cp,dm,cin);






definition
  let ap,bm,cp,dm,cin be set;
  func BitFTA1CarryOutput(ap,bm,cp,dm,cin) -> Element of InnerVertices
  BitFTA1Str(ap,bm,cp,dm,cin) equals

  GFA1CarryOutput(ap,bm,cp);
  func BitFTA1AdderOutputI(ap,bm,cp,dm,cin) -> Element of InnerVertices
  BitFTA1Str(ap,bm,cp,dm,cin) equals

  GFA1AdderOutput(ap,bm,cp);
  func BitFTA1AdderOutputP(ap,bm,cp,dm,cin) -> Element of InnerVertices
  BitFTA1Str(ap,bm,cp,dm,cin) equals

  GFA2CarryOutput(GFA1AdderOutput(ap,bm,cp),
  cin,dm);
  func BitFTA1AdderOutputQ(ap,bm,cp,dm,cin) -> Element of InnerVertices
  BitFTA1Str(ap,bm,cp,dm,cin) equals

  GFA2AdderOutput(GFA1AdderOutput(ap,bm,cp),
  cin,dm);
end;






theorem 
  for ap,bm,cp being non pair set for dm,cin being set for s being State
of BitFTA1Circ(ap,bm,cp,dm,cin) for a1,a2,a3 being Element of BOOLEAN st a1 = s
.ap & a2 = s.bm & a3 = s.cp holds Following(s,2).BitFTA1CarryOutput(ap,bm,cp,dm
,cin) = (a1 '&' 'not' a2) 'or' ('not' a2 '&' a3) 'or' (a3 '&' a1) & Following(s
  ,2).BitFTA1AdderOutputI(ap,bm,cp,dm,cin) = 'not' (a1 'xor' 'not' a2 'xor' a3)
;



theorem 
  for ap,bm,cp,dm being non pair set for cin being set st cin <> [
<*dm,GFA1AdderOutput(ap,bm,cp)*>,and2b] & not cin in InnerVertices BitGFA1Str(
ap,bm,cp) for s being State of BitFTA1Circ(ap,bm,cp,dm,cin) for a1,a2,a3,a4,a5
being Element of BOOLEAN st a1 = s.ap & a2 = s.bm & a3 = s.cp & a4 = s.dm & a5
= s.cin holds Following(s,2).GFA1AdderOutput(ap,bm,cp) = 'not' (a1 'xor' 'not'
a2 'xor' a3) & Following(s,2).ap = a1 & Following(s,2).bm = a2 & Following(s,2)
  .cp = a3 & Following(s,2).dm = a4 & Following(s,2).cin = a5;



theorem 
  for ap,bm,cp,dm being non pair set for cin being set st cin <> [<*dm,
GFA1AdderOutput(ap,bm,cp)*>,and2b] & not cin in InnerVertices BitGFA1Str(ap,bm,
cp) for s being State of BitFTA1Circ(ap,bm,cp,dm,cin) for a1,a2,a3,a4,a5 being
  Element of BOOLEAN st a1 = s.ap & a2 = s.bm & a3 = s.cp & a4 = s.dm & a5 = s.
  cin holds Following(s,4).BitFTA1AdderOutputP(ap,bm,cp,dm,cin) = 'not' (((a1
'xor' 'not' a2 'xor' a3) '&' a5) 'or' (a5 '&' 'not' a4) 'or' ('not' a4 '&' (a1
'xor' 'not' a2 'xor' a3))) & Following(s,4).BitFTA1AdderOutputQ(ap,bm,cp,dm,cin
  ) = a1 'xor' 'not' a2 'xor' a3 'xor' 'not' a4 'xor' a5;



theorem 
  for ap,bm,cp,dm being non pair set for cin being set st cin <> [<*dm,
GFA1AdderOutput(ap,bm,cp)*>,and2b] for s being State of BitFTA1Circ(ap,bm,cp,dm
  ,cin) holds Following(s,4) is stable;

begin 













































definition
  let am,bp,cm,dp,cin be set;
  func BitFTA2Str(am,bp,cm,dp,cin) -> unsplit gate`1=arity gate`2isBoolean non
  void strict non empty ManySortedSign equals

  BitGFA2Str(am,bp,cm) +* BitGFA1Str(
  GFA2AdderOutput(am,bp,cm),cin,dp);
end;

definition
  let am,bp,cm,dp,cin be set;
  func BitFTA2Circ(am,bp,cm,dp,cin) -> strict Boolean gate`2=den Circuit of
  BitFTA2Str(am,bp,cm,dp,cin) equals

  BitGFA2Circ(am,bp,cm) +* BitGFA1Circ(
  GFA2AdderOutput(am,bp,cm),cin,dp);
end;






theorem 
  for am,bp,cm,dp,cin being set holds InnerVertices BitFTA2Str(am,
bp,cm,dp,cin) = {[<*am,bp*>,xor2c], GFA2AdderOutput(am,bp,cm)} \/ {[<*am,bp*>,
and2a], [<*bp,cm*>,and2c], [<*cm,am*>,and2b], GFA2CarryOutput(am,bp,cm)} \/ {[
<*GFA2AdderOutput(am,bp,cm),cin*>,xor2c], GFA1AdderOutput(GFA2AdderOutput(am,bp
,cm),cin,dp)} \/ {[<*GFA2AdderOutput(am,bp,cm),cin*>,and2c], [<*cin,dp*>,and2a]
, [<*dp,GFA2AdderOutput(am,bp,cm)*>,and2], GFA1CarryOutput(GFA2AdderOutput(am,
  bp,cm),cin,dp)};

theorem 
  for am,bp,cm,dp,cin being set holds InnerVertices BitFTA2Str(am,bp,cm,
  dp,cin) is Relation;

theorem 
  for am,bp,cm,dp being non pair set for cin being set st cin <> [
<*dp,GFA2AdderOutput(am,bp,cm)*>,and2] & not cin in InnerVertices BitGFA2Str(am
  ,bp,cm) holds InputVertices BitFTA2Str(am,bp,cm,dp,cin) = {am,bp,cm,dp,cin};



theorem 
  for am,bp,cm,dp,cin being set holds am in the carrier of
BitFTA2Str(am,bp,cm,dp,cin) & bp in the carrier of BitFTA2Str(am,bp,cm,dp,cin)
  & cm in the carrier of BitFTA2Str(am,bp,cm,dp,cin) & dp in the carrier of
BitFTA2Str(am,bp,cm,dp,cin) & cin in the carrier of BitFTA2Str(am,bp,cm,dp,cin)
  & [<*am,bp*>,xor2c] in the carrier of BitFTA2Str(am,bp,cm,dp,cin) &
GFA2AdderOutput(am,bp,cm) in the carrier of BitFTA2Str(am,bp,cm,dp,cin) & [<*am
,bp*>,and2a] in the carrier of BitFTA2Str(am,bp,cm,dp,cin) & [<*bp,cm*>,and2c]
  in the carrier of BitFTA2Str(am,bp,cm,dp,cin) & [<*cm,am*>,and2b] in the
  carrier of BitFTA2Str(am,bp,cm,dp,cin) & GFA2CarryOutput(am,bp,cm) in the
  carrier of BitFTA2Str(am,bp,cm,dp,cin) & [<*GFA2AdderOutput(am,bp,cm),cin*>,
  xor2c] in the carrier of BitFTA2Str(am,bp,cm,dp,cin) & GFA1AdderOutput(
GFA2AdderOutput(am,bp,cm),cin,dp) in the carrier of BitFTA2Str(am,bp,cm,dp,cin)
& [<*GFA2AdderOutput(am,bp,cm),cin*>,and2c] in the carrier of BitFTA2Str(am,bp,
cm,dp,cin) & [<*cin,dp*>,and2a] in the carrier of BitFTA2Str(am,bp,cm,dp,cin) &
[<*dp,GFA2AdderOutput(am,bp,cm)*>,and2] in the carrier of BitFTA2Str(am,bp,cm,
  dp,cin) & GFA1CarryOutput(GFA2AdderOutput(am,bp,cm),cin,dp) in the carrier of
  BitFTA2Str(am,bp,cm,dp,cin);

theorem 
  for am,bp,cm,dp,cin being set holds [<*am,bp*>,xor2c] in
  InnerVertices BitFTA2Str(am,bp,cm,dp,cin) & GFA2AdderOutput(am,bp,cm) in
InnerVertices BitFTA2Str(am,bp,cm,dp,cin) & [<*am,bp*>,and2a] in InnerVertices
BitFTA2Str(am,bp,cm,dp,cin) & [<*bp,cm*>,and2c] in InnerVertices BitFTA2Str(am,
bp,cm,dp,cin) & [<*cm,am*>,and2b] in InnerVertices BitFTA2Str(am,bp,cm,dp,cin)
& GFA2CarryOutput(am,bp,cm) in InnerVertices BitFTA2Str(am,bp,cm,dp,cin) & [<*
GFA2AdderOutput(am,bp,cm),cin*>,xor2c] in InnerVertices BitFTA2Str(am,bp,cm,dp,
  cin) & GFA1AdderOutput(GFA2AdderOutput(am,bp,cm),cin,dp) in InnerVertices
  BitFTA2Str(am,bp,cm,dp,cin) & [<*GFA2AdderOutput(am,bp,cm),cin*>,and2c] in
InnerVertices BitFTA2Str(am,bp,cm,dp,cin) & [<*cin,dp*>,and2a] in InnerVertices
  BitFTA2Str(am,bp,cm,dp,cin) & [<*dp,GFA2AdderOutput(am,bp,cm)*>,and2] in
InnerVertices BitFTA2Str(am,bp,cm,dp,cin) & GFA1CarryOutput(GFA2AdderOutput(am,
  bp,cm),cin,dp) in InnerVertices BitFTA2Str(am,bp,cm,dp,cin);

theorem 
  for am,bp,cm,dp being non pair set for cin being set st cin <> [
<*dp,GFA2AdderOutput(am,bp,cm)*>,and2] & not cin in InnerVertices BitGFA2Str(am
  ,bp,cm) holds am in InputVertices BitFTA2Str(am,bp,cm,dp,cin) & bp in
InputVertices BitFTA2Str(am,bp,cm,dp,cin) & cm in InputVertices BitFTA2Str(am,
  bp,cm,dp,cin) & dp in InputVertices BitFTA2Str(am,bp,cm,dp,cin) & cin in
  InputVertices BitFTA2Str(am,bp,cm,dp,cin);






definition
  let am,bp,cm,dp,cin be set;
  func BitFTA2CarryOutput(am,bp,cm,dp,cin) -> Element of InnerVertices
  BitFTA2Str(am,bp,cm,dp,cin) equals

  GFA2CarryOutput(am,bp,cm);
  func BitFTA2AdderOutputI(am,bp,cm,dp,cin) -> Element of InnerVertices
  BitFTA2Str(am,bp,cm,dp,cin) equals

  GFA2AdderOutput(am,bp,cm);
  func BitFTA2AdderOutputP(am,bp,cm,dp,cin) -> Element of InnerVertices
  BitFTA2Str(am,bp,cm,dp,cin) equals

  GFA1CarryOutput(GFA2AdderOutput(am,bp,cm),
  cin,dp);
  func BitFTA2AdderOutputQ(am,bp,cm,dp,cin) -> Element of InnerVertices
  BitFTA2Str(am,bp,cm,dp,cin) equals

  GFA1AdderOutput(GFA2AdderOutput(am,bp,cm),
  cin,dp);
end;






theorem 
  for am,bp,cm being non pair set for dp,cin being set for s being State
of BitFTA2Circ(am,bp,cm,dp,cin) for a1,a2,a3 being Element of BOOLEAN st a1 = s
.am & a2 = s.bp & a3 = s.cm holds Following(s,2).BitFTA2CarryOutput(am,bp,cm,dp
  ,cin) = 'not' (('not' a1 '&' a2) 'or' (a2 '&' 'not' a3) 'or' ('not' a3 '&'
  'not' a1)) & Following(s,2).BitFTA2AdderOutputI(am,bp,cm,dp,cin) = 'not' a1
  'xor' a2 'xor' 'not' a3;



theorem 
  for am,bp,cm,dp being non pair set for cin being set st cin <> [
<*dp,GFA2AdderOutput(am,bp,cm)*>,and2] & not cin in InnerVertices BitGFA2Str(am
  ,bp,cm) for s being State of BitFTA2Circ(am,bp,cm,dp,cin) for a1,a2,a3,a4,a5
being Element of BOOLEAN st a1 = s.am & a2 = s.bp & a3 = s.cm & a4 = s.dp & a5
  = s.cin holds Following(s,2).GFA2AdderOutput(am,bp,cm) = 'not' a1 'xor' a2
'xor' 'not' a3 & Following(s,2).am = a1 & Following(s,2).bp = a2 & Following(s,
  2).cm = a3 & Following(s,2).dp = a4 & Following(s,2).cin = a5;



theorem 
  for am,bp,cm,dp being non pair set for cin being set st cin <> [<*dp,
GFA2AdderOutput(am,bp,cm)*>,and2] & not cin in InnerVertices BitGFA2Str(am,bp,
cm) for s being State of BitFTA2Circ(am,bp,cm,dp,cin) for a1,a2,a3,a4,a5 being
  Element of BOOLEAN st a1 = s.am & a2 = s.bp & a3 = s.cm & a4 = s.dp & a5 = s.
  cin holds Following(s,4).BitFTA2AdderOutputP(am,bp,cm,dp,cin) = (('not' a1
  'xor' a2 'xor' 'not' a3) '&' 'not' a5) 'or' ('not' a5 '&' a4) 'or' (a4 '&' (
'not' a1 'xor' a2 'xor' 'not' a3)) & Following(s,4).BitFTA2AdderOutputQ(am,bp,
  cm,dp,cin) = 'not' ('not' a1 'xor' a2 'xor' 'not' a3 'xor' a4 'xor' 'not' a5)
;



theorem 
  for am,bp,cm,dp being non pair set for cin being set st cin <> [<*dp,
GFA2AdderOutput(am,bp,cm)*>,and2] for s being State of BitFTA2Circ(am,bp,cm,dp,
  cin) holds Following(s,4) is stable;

begin 













































definition
  let am,bm,cm,dm,cin be set;
  func BitFTA3Str(am,bm,cm,dm,cin) -> unsplit gate`1=arity gate`2isBoolean non
  void strict non empty ManySortedSign equals

  BitGFA3Str(am,bm,cm) +* BitGFA3Str(
  GFA3AdderOutput(am,bm,cm),cin,dm);
end;

definition
  let am,bm,cm,dm,cin be set;
  func BitFTA3Circ(am,bm,cm,dm,cin) -> strict Boolean gate`2=den Circuit of
  BitFTA3Str(am,bm,cm,dm,cin) equals

  BitGFA3Circ(am,bm,cm) +* BitGFA3Circ(
  GFA3AdderOutput(am,bm,cm),cin,dm);
end;






theorem 
  for am,bm,cm,dm,cin being set holds InnerVertices BitFTA3Str(am,
  bm,cm,dm,cin) = {[<*am,bm*>,xor2], GFA3AdderOutput(am,bm,cm)} \/ {[<*am,bm*>,
and2b], [<*bm,cm*>,and2b], [<*cm,am*>,and2b], GFA3CarryOutput(am,bm,cm)} \/ {[
<*GFA3AdderOutput(am,bm,cm),cin*>,xor2], GFA3AdderOutput(GFA3AdderOutput(am,bm,
cm),cin,dm)} \/ {[<*GFA3AdderOutput(am,bm,cm),cin*>,and2b], [<*cin,dm*>,and2b],
[<*dm,GFA3AdderOutput(am,bm,cm)*>,and2b], GFA3CarryOutput(GFA3AdderOutput(am,bm
  ,cm),cin,dm)};

theorem 
  for am,bm,cm,dm,cin being set holds InnerVertices BitFTA3Str(am,bm,cm,
  dm,cin) is Relation;

theorem 
  for am,bm,cm,dm being non pair set for cin being set st cin <> [
<*dm,GFA3AdderOutput(am,bm,cm)*>,and2b] & not cin in InnerVertices BitGFA3Str(
  am,bm,cm) holds InputVertices BitFTA3Str(am,bm,cm,dm,cin) = {am,bm,cm,dm,cin}
;



theorem 
  for am,bm,cm,dm,cin being set holds am in the carrier of
BitFTA3Str(am,bm,cm,dm,cin) & bm in the carrier of BitFTA3Str(am,bm,cm,dm,cin)
  & cm in the carrier of BitFTA3Str(am,bm,cm,dm,cin) & dm in the carrier of
BitFTA3Str(am,bm,cm,dm,cin) & cin in the carrier of BitFTA3Str(am,bm,cm,dm,cin)
  & [<*am,bm*>,xor2] in the carrier of BitFTA3Str(am,bm,cm,dm,cin) &
GFA3AdderOutput(am,bm,cm) in the carrier of BitFTA3Str(am,bm,cm,dm,cin) & [<*am
,bm*>,and2b] in the carrier of BitFTA3Str(am,bm,cm,dm,cin) & [<*bm,cm*>,and2b]
  in the carrier of BitFTA3Str(am,bm,cm,dm,cin) & [<*cm,am*>,and2b] in the
  carrier of BitFTA3Str(am,bm,cm,dm,cin) & GFA3CarryOutput(am,bm,cm) in the
  carrier of BitFTA3Str(am,bm,cm,dm,cin) & [<*GFA3AdderOutput(am,bm,cm),cin*>,
  xor2] in the carrier of BitFTA3Str(am,bm,cm,dm,cin) & GFA3AdderOutput(
GFA3AdderOutput(am,bm,cm),cin,dm) in the carrier of BitFTA3Str(am,bm,cm,dm,cin)
& [<*GFA3AdderOutput(am,bm,cm),cin*>,and2b] in the carrier of BitFTA3Str(am,bm,
cm,dm,cin) & [<*cin,dm*>,and2b] in the carrier of BitFTA3Str(am,bm,cm,dm,cin) &
[<*dm,GFA3AdderOutput(am,bm,cm)*>,and2b] in the carrier of BitFTA3Str(am,bm,cm,
  dm,cin) & GFA3CarryOutput(GFA3AdderOutput(am,bm,cm),cin,dm) in the carrier of
  BitFTA3Str(am,bm,cm,dm,cin);

theorem 
  for am,bm,cm,dm,cin being set holds [<*am,bm*>,xor2] in
  InnerVertices BitFTA3Str(am,bm,cm,dm,cin) & GFA3AdderOutput(am,bm,cm) in
InnerVertices BitFTA3Str(am,bm,cm,dm,cin) & [<*am,bm*>,and2b] in InnerVertices
BitFTA3Str(am,bm,cm,dm,cin) & [<*bm,cm*>,and2b] in InnerVertices BitFTA3Str(am,
bm,cm,dm,cin) & [<*cm,am*>,and2b] in InnerVertices BitFTA3Str(am,bm,cm,dm,cin)
& GFA3CarryOutput(am,bm,cm) in InnerVertices BitFTA3Str(am,bm,cm,dm,cin) & [<*
GFA3AdderOutput(am,bm,cm),cin*>,xor2] in InnerVertices BitFTA3Str(am,bm,cm,dm,
  cin) & GFA3AdderOutput(GFA3AdderOutput(am,bm,cm),cin,dm) in InnerVertices
  BitFTA3Str(am,bm,cm,dm,cin) & [<*GFA3AdderOutput(am,bm,cm),cin*>,and2b] in
InnerVertices BitFTA3Str(am,bm,cm,dm,cin) & [<*cin,dm*>,and2b] in InnerVertices
  BitFTA3Str(am,bm,cm,dm,cin) & [<*dm,GFA3AdderOutput(am,bm,cm)*>,and2b] in
InnerVertices BitFTA3Str(am,bm,cm,dm,cin) & GFA3CarryOutput(GFA3AdderOutput(am,
  bm,cm),cin,dm) in InnerVertices BitFTA3Str(am,bm,cm,dm,cin);

theorem 
  for am,bm,cm,dm being non pair set for cin being set st cin <> [
<*dm,GFA3AdderOutput(am,bm,cm)*>,and2b] & not cin in InnerVertices BitGFA3Str(
  am,bm,cm) holds am in InputVertices BitFTA3Str(am,bm,cm,dm,cin) & bm in
InputVertices BitFTA3Str(am,bm,cm,dm,cin) & cm in InputVertices BitFTA3Str(am,
  bm,cm,dm,cin) & dm in InputVertices BitFTA3Str(am,bm,cm,dm,cin) & cin in
  InputVertices BitFTA3Str(am,bm,cm,dm,cin);






definition
  let am,bm,cm,dm,cin be set;
  func BitFTA3CarryOutput(am,bm,cm,dm,cin) -> Element of InnerVertices
  BitFTA3Str(am,bm,cm,dm,cin) equals

  GFA3CarryOutput(am,bm,cm);
  func BitFTA3AdderOutputI(am,bm,cm,dm,cin) -> Element of InnerVertices
  BitFTA3Str(am,bm,cm,dm,cin) equals

  GFA3AdderOutput(am,bm,cm);
  func BitFTA3AdderOutputP(am,bm,cm,dm,cin) -> Element of InnerVertices
  BitFTA3Str(am,bm,cm,dm,cin) equals

  GFA3CarryOutput(GFA3AdderOutput(am,bm,cm),
  cin,dm);
  func BitFTA3AdderOutputQ(am,bm,cm,dm,cin) -> Element of InnerVertices
  BitFTA3Str(am,bm,cm,dm,cin) equals

  GFA3AdderOutput(GFA3AdderOutput(am,bm,cm),
  cin,dm);
end;






theorem 
  for am,bm,cm being non pair set for dm,cin being set for s being State
of BitFTA3Circ(am,bm,cm,dm,cin) for a1,a2,a3 being Element of BOOLEAN st a1 = s
.am & a2 = s.bm & a3 = s.cm holds Following(s,2).BitFTA3CarryOutput(am,bm,cm,dm
,cin) = 'not' (('not' a1 '&' 'not' a2) 'or' ('not' a2 '&' 'not' a3) 'or' ('not'
a3 '&' 'not' a1)) & Following(s,2).BitFTA3AdderOutputI(am,bm,cm,dm,cin) = 'not'
  ('not' a1 'xor' 'not' a2 'xor' 'not' a3);



theorem 
  for am,bm,cm,dm being non pair set for cin being set st cin <> [
<*dm,GFA3AdderOutput(am,bm,cm)*>,and2b] & not cin in InnerVertices BitGFA3Str(
am,bm,cm) for s being State of BitFTA3Circ(am,bm,cm,dm,cin) for a1,a2,a3,a4,a5
being Element of BOOLEAN st a1 = s.am & a2 = s.bm & a3 = s.cm & a4 = s.dm & a5
= s.cin holds Following(s,2).GFA3AdderOutput(am,bm,cm) = 'not' ('not' a1 'xor'
  'not' a2 'xor' 'not' a3) & Following(s,2).am = a1 & Following(s,2).bm = a2 &
  Following(s,2).cm = a3 & Following(s,2).dm = a4 & Following(s,2).cin = a5;



theorem 
  for am,bm,cm,dm being non pair set for cin being set st cin <> [<*dm,
GFA3AdderOutput(am,bm,cm)*>,and2b] & not cin in InnerVertices BitGFA3Str(am,bm,
cm) for s being State of BitFTA3Circ(am,bm,cm,dm,cin) for a1,a2,a3,a4,a5 being
  Element of BOOLEAN st a1 = s.am & a2 = s.bm & a3 = s.cm & a4 = s.dm & a5 = s.
cin holds Following(s,4).BitFTA3AdderOutputP(am,bm,cm,dm,cin) = 'not' ((('not'
  a1 'xor' 'not' a2 'xor' 'not' a3) '&' 'not' a5) 'or' ('not' a5 '&' 'not' a4)
'or' ('not' a4 '&' ('not' a1 'xor' 'not' a2 'xor' 'not' a3))) & Following(s,4).
  BitFTA3AdderOutputQ(am,bm,cm,dm,cin) = 'not' ('not' a1 'xor' 'not' a2 'xor'
  'not' a3 'xor' 'not' a4 'xor' 'not' a5);



theorem 
  for am,bm,cm,dm being non pair set for cin being set st cin <> [<*dm,
GFA3AdderOutput(am,bm,cm)*>,and2b] for s being State of BitFTA3Circ(am,bm,cm,dm
  ,cin) holds Following(s,4) is stable;














begin

reserve x for Real,

  n for Element of NAT,
   y for set,
  Z for open Subset of REAL,

     g for PartFunc of REAL,REAL;



theorem 
  Z c= dom (arctan*sin) & (for x st x in Z holds sin.x > -1 & sin.x < 1)
implies arctan*sin is_differentiable_on Z & for x st x in Z holds ((arctan*sin)
  `|Z).x = cos.x/(1+(sin.x)^2);



theorem 
  Z c= dom (arccot*sin) & (for x st x in Z holds sin.x > -1 & sin.x < 1)
implies arccot*sin is_differentiable_on Z & for x st x in Z holds ((arccot*sin)
  `|Z).x = -cos.x/(1+(sin.x)^2);



theorem 
  Z c= dom (arctan*cos) & (for x st x in Z holds cos.x > -1 & cos.x < 1)
implies arctan*cos is_differentiable_on Z & for x st x in Z holds ((arctan*cos)
  `|Z).x = -sin.x/(1+(cos.x)^2);



theorem 
  Z c= dom (arccot*cos) & (for x st x in Z holds cos.x > -1 & cos.x < 1)
implies arccot*cos is_differentiable_on Z & for x st x in Z holds ((arccot*cos)
  `|Z).x = sin.x/(1+(cos.x)^2);



theorem 
  Z c= dom (arctan*tan) & (for x st x in Z holds tan.x > -1 & tan.x < 1)
implies arctan*tan is_differentiable_on Z & for x st x in Z holds ((arctan*tan)
  `|Z).x = 1;



theorem 
  Z c= dom (arccot*tan) & (for x st x in Z holds tan.x > -1 & tan.x < 1)
implies arccot*tan is_differentiable_on Z & for x st x in Z holds ((arccot*tan)
  `|Z).x = -1;



theorem 
  Z c= dom (arctan*cot) & (for x st x in Z holds cot.x > -1 & cot.x < 1)
implies arctan*cot is_differentiable_on Z & for x st x in Z holds ((arctan*cot)
  `|Z).x = -1;



theorem 
  Z c= dom (arccot*cot) & (for x st x in Z holds cot.x > -1 & cot.x < 1)
implies arccot*cot is_differentiable_on Z & for x st x in Z holds ((arccot*cot)
  `|Z).x = 1;



theorem 
  Z c= dom (arctan*arctan) & Z c= ].-1,1.[ & (for x st x in Z holds
  arctan.x > -1 & arctan.x < 1) implies arctan*arctan is_differentiable_on Z &
  for x st x in Z holds ((arctan*arctan)`|Z).x = 1/((1+x^2)*(1+(arctan.x)^2));



theorem 
  Z c= dom (arccot*arctan) & Z c= ].-1,1.[ & (for x st x in Z holds
  arctan.x > -1 & arctan.x < 1) implies arccot*arctan is_differentiable_on Z &
  for x st x in Z holds ((arccot*arctan)`|Z).x = -1/((1+x^2)*(1+(arctan.x)^2));



theorem 
  Z c= dom (arctan*arccot) & Z c= ].-1,1.[ & (for x st x in Z holds
  arccot.x > -1 & arccot.x < 1) implies arctan*arccot is_differentiable_on Z &
  for x st x in Z holds ((arctan*arccot)`|Z).x = -1/((1+x^2)*(1+(arccot.x)^2));



theorem 
  Z c= dom (arccot*arccot) & Z c= ].-1,1.[ & (for x st x in Z holds
  arccot.x > -1 & arccot.x < 1) implies arccot*arccot is_differentiable_on Z &
  for x st x in Z holds ((arccot*arccot)`|Z).x = 1/((1+x^2)*(1+(arccot.x)^2));



theorem 
  Z c= dom (sin*arctan) & Z c= ].-1,1.[ implies sin*arctan
  is_differentiable_on Z & for x st x in Z holds ((sin*arctan)`|Z).x = cos.(
  arctan.x)/(1+x^2);



theorem 
  Z c= dom (sin*arccot) & Z c= ].-1,1.[ implies sin*arccot
  is_differentiable_on Z & for x st x in Z holds ((sin*arccot)`|Z).x = -cos.(
  arccot.x)/(1+x^2);



theorem 
  Z c= dom (cos*arctan) & Z c= ].-1,1.[ implies cos*arctan
  is_differentiable_on Z & for x st x in Z holds ((cos*arctan)`|Z).x = -sin.(
  arctan.x)/(1+x^2);



theorem 
  Z c= dom (cos*arccot) & Z c= ].-1,1.[ implies cos*arccot
  is_differentiable_on Z & for x st x in Z holds ((cos*arccot)`|Z).x = sin.(
  arccot.x)/(1+x^2);



theorem 
  Z c= dom (tan*arctan) & Z c= ].-1,1.[ implies tan*arctan
is_differentiable_on Z & for x st x in Z holds ((tan*arctan)`|Z).x = 1/((cos.(
  arctan.x))^2*(1+x^2));



theorem 
  Z c= dom (tan*arccot) & Z c= ].-1,1.[ implies tan*arccot
is_differentiable_on Z & for x st x in Z holds ((tan*arccot)`|Z).x = -1/((cos.(
  arccot.x))^2*(1+x^2));



theorem 
  Z c= dom (cot*arctan) & Z c= ].-1,1.[ implies cot*arctan
is_differentiable_on Z & for x st x in Z holds ((cot*arctan)`|Z).x = -1/((sin.(
  arctan.x))^2*(1+x^2));



theorem 
  Z c= dom (cot*arccot) & Z c= ].-1,1.[ implies cot*arccot
is_differentiable_on Z & for x st x in Z holds ((cot*arccot)`|Z).x = 1/((sin.(
  arccot.x))^2*(1+x^2));



theorem 
  Z c= dom (sec*arctan) & Z c= ].-1,1.[ implies sec*arctan
  is_differentiable_on Z & for x st x in Z holds ((sec*arctan)`|Z).x = sin.(
  arctan.x)/((cos.(arctan.x))^2*(1+x^2));



theorem 
  Z c= dom (sec*arccot) & Z c= ].-1,1.[ implies sec*arccot
  is_differentiable_on Z & for x st x in Z holds ((sec*arccot)`|Z).x = -sin.(
  arccot.x)/((cos.(arccot.x))^2*(1+x^2));



theorem 
  Z c= dom (cosec*arctan) & Z c= ].-1,1.[ implies cosec*arctan
  is_differentiable_on Z & for x st x in Z holds ((cosec*arctan)`|Z).x = -cos.(
  arctan.x)/((sin.(arctan.x))^2*(1+x^2));



theorem 
  Z c= dom (cosec*arccot) & Z c= ].-1,1.[ implies cosec*arccot
  is_differentiable_on Z & for x st x in Z holds ((cosec*arccot)`|Z).x = cos.(
  arccot.x)/((sin.(arccot.x))^2*(1+x^2));



theorem 
  Z c= dom (sin(#)arctan) & Z c= ].-1,1.[ implies (sin(#)arctan)
  is_differentiable_on Z & for x st x in Z holds ((sin(#)arctan)`|Z).x = cos.x*
  arctan.x+sin.x/(1+x^2);



theorem 
  Z c= dom (sin(#)arccot) & Z c= ].-1,1.[ implies (sin(#)arccot)
  is_differentiable_on Z & for x st x in Z holds ((sin(#)arccot)`|Z).x = cos.x*
  arccot.x-sin.x/(1+x^2);



theorem 
  Z c= dom (cos(#)arctan) & Z c= ].-1,1.[ implies (cos(#)arctan)
is_differentiable_on Z & for x st x in Z holds ((cos(#)arctan)`|Z).x = -sin.x*
  arctan.x+cos.x/(1+x^2);



theorem 
  Z c= dom (cos(#)arccot) & Z c= ].-1,1.[ implies (cos(#)arccot)
is_differentiable_on Z & for x st x in Z holds ((cos(#)arccot)`|Z).x = -sin.x*
  arccot.x-cos.x/(1+x^2);



theorem 
  Z c= dom (tan(#)arctan) & Z c= ].-1,1.[ implies (tan(#)arctan)
is_differentiable_on Z & for x st x in Z holds ((tan(#)arctan)`|Z).x = arctan.x
  /(cos.x)^2+tan.x/(1+x^2);



theorem 
  Z c= dom (tan(#)arccot) & Z c= ].-1,1.[ implies (tan(#)arccot)
is_differentiable_on Z & for x st x in Z holds ((tan(#)arccot)`|Z).x = arccot.x
  /(cos.x)^2-tan.x/(1+x^2);



theorem 
  Z c= dom (cot(#)arctan) & Z c= ].-1,1.[ implies (cot(#)arctan)
is_differentiable_on Z & for x st x in Z holds ((cot(#)arctan)`|Z).x = -arctan.
  x/(sin.x)^2+cot.x/(1+x^2);



theorem 
  Z c= dom (cot(#)arccot) & Z c= ].-1,1.[ implies (cot(#)arccot)
is_differentiable_on Z & for x st x in Z holds ((cot(#)arccot)`|Z).x = -arccot.
  x/(sin.x)^2-cot.x/(1+x^2);



theorem 
  Z c= dom (sec(#)arctan) & Z c= ].-1,1.[ implies (sec(#)arctan)
is_differentiable_on Z & for x st x in Z holds ((sec(#)arctan)`|Z).x = (sin.x*
  arctan.x)/(cos.x)^2+1/(cos.x*(1+x^2));



theorem 
  Z c= dom (sec(#)arccot) & Z c= ].-1,1.[ implies (sec(#)arccot)
is_differentiable_on Z & for x st x in Z holds ((sec(#)arccot)`|Z).x = (sin.x*
  arccot.x)/(cos.x)^2-1/(cos.x*(1+x^2));



theorem 
  Z c= dom (cosec(#)arctan) & Z c= ].-1,1.[ implies (cosec(#)arctan)
is_differentiable_on Z & for x st x in Z holds ((cosec(#)arctan)`|Z).x = -(cos.
  x*arctan.x)/(sin.x)^2+1/(sin.x*(1+x^2));



theorem 
  Z c= dom (cosec(#)arccot) & Z c= ].-1,1.[ implies (cosec(#)arccot)
is_differentiable_on Z & for x st x in Z holds ((cosec(#)arccot)`|Z).x = -(cos.
  x*arccot.x)/(sin.x)^2-1/(sin.x*(1+x^2));



theorem 
  Z c= ].-1,1.[ implies (arctan+arccot) is_differentiable_on Z &
  for x st x in Z holds ((arctan+arccot)`|Z).x = 0;



theorem 
  Z c= ].-1,1.[ implies (arctan-arccot) is_differentiable_on Z &
  for x st x in Z holds ((arctan-arccot)`|Z).x = 2/(1+x^2);



theorem 
  Z c= ].-1,1.[ implies sin(#)(arctan+arccot) is_differentiable_on Z &
for x st x in Z holds ((sin(#)(arctan+arccot))`|Z).x = cos.x*(arctan.x+arccot.x
  );



theorem 
  Z c= ].-1,1.[ implies sin(#)(arctan-arccot) is_differentiable_on Z &
for x st x in Z holds ((sin(#)(arctan-arccot))`|Z).x = cos.x*(arctan.x-arccot.x
  )+2*sin.x/(1+x^2);



theorem 
  Z c= ].-1,1.[ implies cos(#)(arctan+arccot) is_differentiable_on Z &
for x st x in Z holds ((cos(#)(arctan+arccot))`|Z).x = -sin.x*(arctan.x+arccot.
  x);



theorem 
  Z c= ].-1,1.[ implies cos(#)(arctan-arccot) is_differentiable_on Z &
for x st x in Z holds ((cos(#)(arctan-arccot))`|Z).x = -sin.x*(arctan.x-arccot.
  x)+2*cos.x/(1+x^2);



theorem 
  Z c= dom tan & Z c= ].-1,1.[ implies tan(#)(arctan+arccot)
is_differentiable_on Z & for x st x in Z holds ((tan(#)(arctan+arccot))`|Z).x =
  (arctan.x+arccot.x)/(cos.x)^2;



theorem 
  Z c= dom tan & Z c= ].-1,1.[ implies tan(#)(arctan-arccot)
is_differentiable_on Z & for x st x in Z holds ((tan(#)(arctan-arccot))`|Z).x =
  (arctan.x-arccot.x)/(cos.x)^2+2*tan.x/(1+x^2);



theorem 
  Z c= dom cot & Z c= ].-1,1.[ implies cot(#)(arctan+arccot)
is_differentiable_on Z & for x st x in Z holds ((cot(#)(arctan+arccot))`|Z).x =
  -(arctan.x+arccot.x)/(sin.x)^2;



theorem 
  Z c= dom cot & Z c= ].-1,1.[ implies cot(#)(arctan-arccot)
is_differentiable_on Z & for x st x in Z holds ((cot(#)(arctan-arccot))`|Z).x =
  -(arctan.x-arccot.x)/(sin.x)^2+2*cot.x/(1+x^2);



theorem 
  Z c= dom sec & Z c= ].-1,1.[ implies sec(#)(arctan+arccot)
is_differentiable_on Z & for x st x in Z holds ((sec(#)(arctan+arccot))`|Z).x =
  (arctan.x+arccot.x)*sin.x/(cos.x)^2;



theorem 
  Z c= dom sec & Z c= ].-1,1.[ implies sec(#)(arctan-arccot)
is_differentiable_on Z & for x st x in Z holds ((sec(#)(arctan-arccot))`|Z).x =
  (arctan.x-arccot.x)*sin.x/(cos.x)^2+2*sec.x/(1+x^2);



theorem 
  Z c= dom cosec & Z c= ].-1,1.[ implies cosec(#)(arctan+arccot)
is_differentiable_on Z & for x st x in Z holds ((cosec(#)(arctan+arccot))`|Z).x
  = -(arctan.x+arccot.x)*cos.x/(sin.x)^2;



theorem 
  Z c= dom cosec & Z c= ].-1,1.[ implies cosec(#)(arctan-arccot)
is_differentiable_on Z & for x st x in Z holds ((cosec(#)(arctan-arccot))`|Z).x
  = -(arctan.x-arccot.x)*cos.x/(sin.x)^2+2*cosec.x/(1+x^2);



theorem 
  Z c= ].-1,1.[ implies exp_R(#)(arctan+arccot) is_differentiable_on Z &
  for x st x in Z holds ((exp_R(#)(arctan+arccot))`|Z).x = exp_R.x*(arctan.x+
  arccot.x);



theorem 
  Z c= ].-1,1.[ implies exp_R(#)(arctan-arccot) is_differentiable_on Z &
  for x st x in Z holds ((exp_R(#)(arctan-arccot))`|Z).x = exp_R.x*(arctan.x-
  arccot.x)+2*exp_R.x/(1+x^2);



theorem 
  Z c= ].-1,1.[ implies (arctan+arccot)/exp_R is_differentiable_on Z &
  for x st x in Z holds (((arctan+arccot)/exp_R)`|Z).x = -(arctan.x+arccot.x)/
  exp_R.x;



theorem 
  Z c= ].-1,1.[ implies (arctan-arccot)/exp_R is_differentiable_on Z &
  for x st x in Z holds (((arctan-arccot)/exp_R)`|Z).x = ((2/(1+x^2))-arctan.x+
  arccot.x)/exp_R.x;



theorem 
  Z c= dom (exp_R*(arctan+arccot)) & Z c= ].-1,1.[ implies exp_R*(arctan
+arccot) is_differentiable_on Z & for x st x in Z holds (exp_R*(arctan+arccot)
  `|Z).x = 0;



theorem 
  Z c= dom (exp_R*(arctan-arccot)) & Z c= ].-1,1.[ implies exp_R*(arctan
-arccot) is_differentiable_on Z & for x st x in Z holds (exp_R*(arctan-arccot)
  `|Z).x = 2*exp_R.(arctan.x-arccot.x)/(1+x^2);



theorem 
  Z c= dom (sin*(arctan+arccot)) & Z c= ].-1,1.[ implies sin*(arctan+
arccot) is_differentiable_on Z & for x st x in Z holds (sin*(arctan+arccot)`|Z)
  .x = 0;



theorem 
  Z c= dom (sin*(arctan-arccot)) & Z c= ].-1,1.[ implies sin*(arctan-
arccot) is_differentiable_on Z & for x st x in Z holds (sin*(arctan-arccot)`|Z)
  .x = 2*cos.(arctan.x-arccot.x)/(1+x^2);



theorem 
  Z c= dom (cos*(arctan+arccot)) & Z c= ].-1,1.[ implies cos*(arctan+
arccot) is_differentiable_on Z & for x st x in Z holds (cos*(arctan+arccot)`|Z)
  .x = 0;



theorem 
  Z c= dom (cos*(arctan-arccot)) & Z c= ].-1,1.[ implies cos*(arctan-
arccot) is_differentiable_on Z & for x st x in Z holds (cos*(arctan-arccot)`|Z)
  .x = -2*sin.(arctan.x-arccot.x)/(1+x^2);



theorem 
  Z c= ].-1,1.[ implies arctan(#)arccot is_differentiable_on Z & for x
  st x in Z holds ((arctan(#)arccot)`|Z).x = (arccot.x-arctan.x)/(1+x^2);



theorem 
  not 0 in Z & Z c= dom((arctan*((id Z)^))(#)(arccot*((id Z)^))) & (for
x st x in Z holds ((id Z)^).x > -1 & ((id Z)^).x < 1) implies (arctan*((id Z)^)
)(#)(arccot*((id Z)^)) is_differentiable_on Z & for x st x in Z holds (((arctan
  *((id Z)^))(#)(arccot*((id Z)^)))`|Z).x = (arctan.(1/x)-arccot.(1/x))/(1+x^2)
;



theorem 
  not 0 in Z & Z c= dom ((id Z)(#)(arctan*((id Z)^))) & (for x st x in Z
  holds ((id Z)^).x > -1 & ((id Z)^).x < 1) implies (id Z)(#)(arctan*((id Z)^))
is_differentiable_on Z & for x st x in Z holds (((id Z)(#)(arctan*((id Z)^)))`|
  Z).x = arctan.(1/x)-x/(1+x^2);



theorem 
  not 0 in Z & Z c= dom ((id Z)(#)(arccot*((id Z)^))) & (for x st x in Z
  holds ((id Z)^).x > -1 & ((id Z)^).x < 1) implies (id Z)(#)(arccot*((id Z)^))
is_differentiable_on Z & for x st x in Z holds (((id Z)(#)(arccot*((id Z)^)))`|
  Z).x = arccot.(1/x)+x/(1+x^2);



theorem 
  not 0 in Z & Z c= dom (g(#)(arctan*((id Z)^))) & g=#Z 2 & (for x st x
  in Z holds ((id Z)^).x > -1 & ((id Z)^).x < 1) implies g(#)(arctan*((id Z)^))
is_differentiable_on Z & for x st x in Z holds ((g(#)(arctan*((id Z)^)))`|Z).x
  = 2*x*arctan.(1/x)-x^2/(1+x^2);



theorem 
  not 0 in Z & Z c= dom (g(#)(arccot*((id Z)^))) & g=#Z 2 & (for x st x
  in Z holds ((id Z)^).x > -1 & ((id Z)^).x < 1) implies g(#)(arccot*((id Z)^))
is_differentiable_on Z & for x st x in Z holds ((g(#)(arccot*((id Z)^)))`|Z).x
  = 2*x*arccot.(1/x)+x^2/(1+x^2);



theorem 
  Z c= ].-1,1.[ & (for x st x in Z holds arctan.x<>0) implies
arctan^ is_differentiable_on Z & for x st x in Z holds ((arctan^)`|Z).x = -1/((
  arctan.x)^2*(1+x^2));



theorem 
  Z c= ].-1,1.[ implies arccot^ is_differentiable_on Z & for x st
  x in Z holds ((arccot^)`|Z).x= 1/((arccot.x)^2*(1+x^2));



theorem 
  Z c= dom ((1/n)(#)(( #Z n)*(arctan^))) & Z c= ].-1,1.[ & n>0 & (for x
  st x in Z holds arctan.x<>0) implies (1/n)(#)(( #Z n)*(arctan^))
is_differentiable_on Z & for x st x in Z holds (((1/n)(#)(( #Z n)*(arctan^)))`|
  Z).x = -1/(((arctan.x) #Z (n+1))*(1+x^2));



theorem 
  Z c= dom ((1/n)(#)(( #Z n)*(arccot^))) & Z c= ].-1,1.[ & n>0 implies (
1/n)(#)(( #Z n)*(arccot^)) is_differentiable_on Z & for x st x in Z holds (((1/
  n)(#)(( #Z n)*(arccot^)))`|Z).x = 1/(((arccot.x) #Z (n+1))*(1+x^2));



theorem 
  Z c= dom ((2(#)(( #R (1/2))*arctan))) & Z c= ].-1,1.[ & (for x st x in
Z holds arctan.x > 0) implies 2(#)(( #R (1/2))*arctan) is_differentiable_on Z &
for x st x in Z holds ((2(#)(( #R (1/2))*arctan))`|Z).x = (arctan.x) #R (-1/2)/
  (1+x^2);



theorem 
  Z c= dom ((2(#)(( #R (1/2))*arccot))) & Z c= ].-1,1.[ implies 2(#)((
#R (1/2))*arccot) is_differentiable_on Z & for x st x in Z holds ((2(#)(( #R (1
  /2))*arccot))`|Z).x = -(arccot.x) #R (-1/2)/(1+x^2);



theorem 
  Z c= dom (((2/3)(#)(( #R (3/2))*arctan))) & Z c= ].-1,1.[ & (for x st
  x in Z holds arctan.x > 0) implies (2/3)(#)(( #R (3/2))*arctan)
is_differentiable_on Z & for x st x in Z holds (((2/3)(#)(( #R (3/2))*arctan))
  `|Z).x = (arctan.x) #R (1/2)/(1+x^2);



theorem 
  Z c= dom (((2/3)(#)(( #R (3/2))*arccot))) & Z c= ].-1,1.[ implies (2/3
)(#)(( #R (3/2))*arccot) is_differentiable_on Z & for x st x in Z holds (((2/3)
  (#)(( #R (3/2))*arccot))`|Z).x = -(arccot.x) #R (1/2)/(1+x^2);














begin

theorem 
  for x,y be real number st 0<=x & x<y ex s0 be real number st 0<s0
  & x < y/(1+s0) & y/(1+s0) < y;

scheme 

  RecExD3{D() -> non empty set, A() -> Element of D(), B() -> Element of D(),
P[set,set,set,set]}: ex f being Function of NAT,D() st f.0 = A() & f.1 = B() &
  for n being Element of NAT holds P[n,f.n,f.(n+1),f.(n+2)]
provided
 for n being Element of NAT for x,y being Element of D() ex z being
Element of D() st P[n,x,y,z];

reserve X, Y for RealNormSpace;

theorem 
  for y1 be Point of X, r be real number holds Ball(y1,r) = y1 + Ball(0.X,r);

theorem 
  for r be real number, a be Real st 0 < a holds Ball(0.X,a*r) = a
  * Ball(0.X,r);

theorem 
  for T be LinearOperator of X,Y, B0,B1 be Subset of X holds T.:(B0+B1)
  = T.:B0+T.:B1;

theorem 
  for T be LinearOperator of X,Y, B0 be Subset of X, a be Real
  holds T.:(a*B0) = a*T.:B0;

theorem 
  for T be LinearOperator of X,Y, B0 be Subset of X, x1 be Point of
  X holds T.:(x1+ B0) = T.x1 + T.:B0;

theorem 
  for V,W be Subset of X, V1,W1 be Subset of LinearTopSpaceNorm X st V=
  V1 & W=W1 holds V+W=V1+W1;

theorem 
  for V be Subset of X,x be Point of X, V1 be Subset of
LinearTopSpaceNorm X, x1 be Point of LinearTopSpaceNorm X st V=V1 & x=x1 holds
  x+V=x1+V1;

theorem 
  for V be Subset of X,a be Real, V1 be Subset of
  LinearTopSpaceNorm X st V=V1 holds a*V=a*V1;

theorem 
  for V be Subset of TopSpaceNorm X, V1 be Subset of
  LinearTopSpaceNorm X st V=V1 holds Cl(V)=Cl(V1);

theorem 
  for x be Point of X, r be real number holds Ball(0.X,r)=(-1)* Ball(0.X,r);

theorem 
  for x be Point of X,r be real number, V be Subset of
  LinearTopSpaceNorm X st V = Ball(x,r) holds V is convex;

theorem 
  for x be Point of X,r be real number, T be LinearOperator of X,Y
  , V be Subset of LinearTopSpaceNorm Y st V = T.: Ball(x,r) holds V is convex;

theorem 
  for x be Point of X, r, s be real number st r <= s holds Ball(x,
  r) c= Ball(x,s);



theorem 
  for X be RealBanachSpace, Y be RealNormSpace, T be Lipschitzian
LinearOperator of X,Y, r be real number, BX1 be Subset of LinearTopSpaceNorm X,
TBX1,BYr be Subset of LinearTopSpaceNorm Y st r>0 & BYr=Ball(0.Y,r ) & TBX1=T.:
  Ball(0.X,1) & BYr c= Cl (TBX1) holds BYr c= TBX1;




theorem 
  for X, Y be RealBanachSpace, T be Lipschitzian LinearOperator of X,Y, T1 be
  Function of LinearTopSpaceNorm X,LinearTopSpaceNorm Y st T1=T & T1 is onto
  holds T1 is open;














begin 

reserve i, j, m, n for Nat,
  z, B0 for set,
  f, x0 for real-valued FinSequence;

theorem 
  for f,g being Function holds dom (f*g) = (dom g) /\ g"(dom f);

theorem 
  for R being Relation, Y being set st rng R c= Y holds R"Y = dom R;

theorem 
  <* z *> * <* 1 *> = <* z *>;

theorem 
  for x being Element of REAL 0 holds x = <*>REAL;

theorem 
  for a,b,c being Element of REAL n holds a - b + c + b = a + c;

registration
  let f1,f2 be FinSequence;
  cluster <:f1,f2:> -> FinSequence-like;
end;

definition
  let D be set, f1,f2 be FinSequence of D;
  redefine func <:f1,f2:> -> FinSequence of [:D,D:];
end;

definition
  let h be real-valued FinSequence;
  redefine attr h is increasing means


  for i being Nat st 1<=i & i<len h holds h.i < h.(i+1);
end;

theorem 
  for h being real-valued FinSequence st h is increasing holds for
  i,j being Nat st i<j & 1<=i & j<=len h holds h.i < h.j;

theorem 
  for h being real-valued FinSequence st h is increasing holds for
  i,j being Nat st i<=j & 1<=i & j<=len h holds h.i <= h.j;

theorem 
  for h being natural-valued FinSequence st h is increasing holds
  for i being Nat st i<=len h & 1<=h.1 holds i <= h.i;

theorem 
  for V being RealLinearSpace, X being Subspace of V st V is
  strict & X is strict & the carrier of X = the carrier of V holds X = V;

definition
  let D be set;
  let F be FinSequence of D;
  let h be Permutation of dom F;
  func F(*)h -> FinSequence of D equals

  F*h;
end;

theorem 
  for D being non empty set,f being FinSequence of D st 1<=i & i<=
  len f & 1<=j & j<=len f holds (Swap(f,i,j)).i=f.j & (Swap(f,i,j)).j=f.i;

theorem 
  {} is Permutation of {};

theorem 
  <* 1 *> is Permutation of {1};

theorem 
  for h being FinSequence of REAL holds h is one-to-one iff sort_a
  h is one-to-one;

theorem 
  for h being FinSequence of NAT st h is one-to-one ex h3 being
Permutation of dom h,h2 being FinSequence of NAT st h2=h*h3 & h2 is increasing
  & dom h=dom h2 & rng h=rng h2;

begin 

definition
  let B0 be set;
  attr B0 is R-orthogonal means


  for x, y being real-valued FinSequence
  st x in B0 & y in B0 & x<>y holds |( x,y )| = 0;
end;

registration
  cluster empty -> R-orthogonal for set;
end;

theorem 
  B0 is R-orthogonal iff for x,y being real-valued FinSequence st x in
  B0 & y in B0 & x <> y holds x,y are_orthogonal;

definition
  let B0 be set;
  attr B0 is R-normal means


  for x being real-valued FinSequence st x in B0 holds |.x.| = 1;
end;

registration
  cluster empty -> R-normal for set;
end;

registration
  cluster R-normal for set;
end;

registration
  let B0, B1 be R-normal set;
  cluster B0 \/ B1 -> R-normal;
end;

theorem 
  |.f.| = 1 implies {f} is R-normal;

theorem 
  B0 is R-normal & |.x0.| = 1 implies B0 \/ {x0} is R-normal;

definition
  let B0 be set;
  attr B0 is R-orthonormal means


  B0 is R-orthogonal R-normal;
end;

registration
  cluster R-orthonormal -> R-orthogonal R-normal for set;
  cluster R-orthogonal R-normal -> R-orthonormal for set;
end;

registration
  cluster { <*1*> } -> R-orthonormal;
end;

registration
  cluster R-orthonormal non empty for set;
end;

registration
  let n;
  cluster R-orthonormal for Subset of REAL n;
end;

definition
  let n be Nat;
  let B0 be Subset of REAL n;
  attr B0 is complete means


  for B being R-orthonormal Subset of REAL n st B0 c= B holds B = B0;
end;

definition
  let n be Nat, B0 be Subset of REAL n;
  attr B0 is orthogonal_basis means


  B0 is R-orthonormal complete;
end;

registration
  let n be Nat;
  cluster orthogonal_basis -> R-orthonormal complete for Subset of REAL n;
  cluster R-orthonormal complete -> orthogonal_basis for Subset of REAL n;
end;

theorem 
  for B0 being Subset of REAL 0 st B0 is orthogonal_basis holds B0 = {};

theorem 
  for B0 being Subset of REAL n,y being Element of REAL n st B0 is
  orthogonal_basis & (for x being Element of REAL n st x in B0 holds |(x,y)|=0)
  holds y=0*n;

begin 

definition
  let n;
  let X be Subset of REAL n;
  attr X is linear_manifold means


  for x, y being Element of REAL n, a,b
  being Element of REAL st x in X & y in X holds a*x+b*y in X;
end;

registration
  let n;
  cluster [#](REAL n) -> linear_manifold;
end;

theorem 
  { 0*n } is linear_manifold;

registration
  let n;
  cluster { 0*n } -> linear_manifold for Subset of REAL n;
end;

definition
  let n;
  let X be Subset of REAL n;
  func L_Span X -> Subset of REAL n equals

  meet {Y where Y is Subset of REAL n
  : Y is linear_manifold & X c= Y};
end;

registration
  let n;
  let X be Subset of REAL n;
  cluster L_Span X -> linear_manifold;
end;

definition
  let n be Nat,f be FinSequence of REAL n;
  func accum f -> FinSequence of REAL n means

  len f = len it & f.1 = it.1 &
  for i being Nat st 1<=i & i<len f holds it.(i+1) = (it/.i) + (f/.(i+1));
end;

definition
  let n be Nat;
  let f be FinSequence of REAL n;
  func Sum f -> Element of REAL n equals

    (accum f).len f if len f > 0 otherwise 0*n;
end;

theorem 
  for F, F2 being FinSequence of REAL n, h being Permutation of
  dom F st F2=F(*)h holds Sum F2=Sum F;

theorem 
  for k being Element of NAT holds Sum(k |-> 0*n) = 0*n;

theorem 
  for g being FinSequence of REAL n, h being FinSequence of NAT,F
being FinSequence of REAL n st h is increasing & rng h c= dom g & F=g*h & (for
i being Element of NAT st i in dom g & not i in rng h holds g.i= 0*n) holds Sum
  g=Sum F;

theorem 
  for g being FinSequence of REAL n, h being FinSequence of NAT,F
being FinSequence of REAL n st h is one-to-one & rng h c= dom g & F=g*h & (for
i being Element of NAT st i in dom g & not i in rng h holds g.i= 0*n) holds Sum
  g =Sum F;

begin 

definition
  let n, i be Nat;
  redefine func Base_FinSeq(n,i) -> Element of REAL n;
end;

theorem 
  for i1,i2 being Nat st 1<=i1 & i1<=n & Base_FinSeq(n,i1)=
  Base_FinSeq(n,i2) holds i1=i2;

theorem 
  sqr (Base_FinSeq(n,i)) = Base_FinSeq(n,i);

theorem 
  1<=i & i<=n implies Sum Base_FinSeq(n,i)= 1;

theorem 
  1<=i & i<=n implies |. Base_FinSeq(n,i) .| = 1;

theorem 
  1<=i & i<=n & i<>j implies |( Base_FinSeq(n,i),Base_FinSeq(n,j))| = 0;

theorem 
  for x being Element of REAL n st 1<=i & i<=n holds |( x,
  Base_FinSeq(n,i) )| = x.i;

definition
  let n be Nat;
  let x0 be Element of REAL n;
  func ProjFinSeq x0 -> FinSequence of REAL n means

  len it = n & for i being Nat st 1<=i & i<=n holds
  it.i = |( x0,Base_FinSeq(n,i) )| * Base_FinSeq(n,i);
end;

theorem 
  for x0 being Element of REAL n holds x0 = Sum (ProjFinSeq x0);

definition
  let n be Nat;
  func RN_Base n -> Subset of REAL n equals

  { Base_FinSeq(n,i) where i is
  Element of NAT: 1<=i & i<=n };
end;

theorem 
  for n being non zero Nat holds RN_Base n <> {};

registration
  cluster RN_Base 0 -> empty;
end;

registration
  let n be non zero Nat;
  cluster RN_Base n -> non empty;
end;

registration
  let n;
  cluster RN_Base n -> orthogonal_basis;
end;

registration
  let n;
  cluster orthogonal_basis for Subset of REAL n;
end;

definition
  let n;
  mode Orthogonal_Basis of n is orthogonal_basis Subset of REAL n;
end;

registration
  let n be non zero Nat;
  cluster -> non empty for Orthogonal_Basis of n;
end;

begin 

registration
  let n be Element of NAT;
  cluster REAL-US n -> constituted-FinSeqs;
end;

registration
  let n be Element of NAT;
  cluster -> real-valued for Element of REAL-US n;
end;

registration
  let n be Element of NAT;
  let x, y be VECTOR of REAL-US n, a, b be real-valued Function;
  identify x+y with a+b when x = a, y = b;
end;

registration
  let n be Element of NAT,
      x be VECTOR of REAL-US n, y be real-valued Function,
      a, b be Element of REAL;
  identify a*x with b(#)y when x = y, a = b;
end;

registration
  let n be Element of NAT;
  let x be VECTOR of REAL-US n, a be real-valued Function;
  identify -x with -a when x = a;
end;

registration
  let n be Element of NAT;
  let x, y be VECTOR of REAL-US n, a, b be real-valued Function;
  identify x-y with a-b when x = a, y = b;
end;

theorem 
  for n,j being Element of NAT,
      F being FinSequence of the carrier of REAL-US n,
      Bn being Subset of REAL-US n, v0 being Element of REAL-US n,
      l being Linear_Combination of Bn st
    F is one-to-one & Bn is R-orthogonal &
    rng F = Carrier l & v0 in Bn & j in dom (l (#) F) &
    v0=F.j holds (Euclid_scalar n).(v0,Sum (l(#)F)) =
    (Euclid_scalar n).(v0,(l.(F/.j))*v0);

theorem 
  for n being Element of NAT, f being FinSequence of REAL n, g
  being FinSequence of the carrier of (REAL-US n) st f=g holds Sum f=Sum g;

registration
  let A be set;
  cluster RealVectSpace(A) -> constituted-Functions;
end;

registration
  let n;
  cluster RealVectSpace(Seg n) -> constituted-FinSeqs;
end;

registration
  let A be set;
  cluster -> real-valued for Element of RealVectSpace(A);
end;

registration
  let A be set;
  let x, y be VECTOR of RealVectSpace(A), a, b be real-valued Function;
  identify x+y with a+b when x = a, y = b;
end;

registration
  let A be set;
  let x be VECTOR of RealVectSpace(A), y be real-valued Function, a, b be
  Element of REAL;
  identify a*x with b(#)y when x = y, a = b;
end;

registration
  let A be set;
  let x be VECTOR of RealVectSpace(A), a be real-valued Function;
  identify -x with -a when x = a;
end;

registration
  let A be set;
  let x, y be VECTOR of RealVectSpace(A), a, b be real-valued Function;
  identify x-y with a-b when x = a, y = b;
end;

theorem 
  for X being Subspace of RealVectSpace(Seg n), x being Element of
  REAL n, a being Real st x in the carrier of X holds a*x in the carrier of X;

theorem 
  for X being Subspace of RealVectSpace(Seg n), x,y being Element of REAL n st
      x in the carrier of X & y in the carrier of X holds
      x+y in the carrier of X;

theorem 
  for X being Subspace of RealVectSpace(Seg n), x,y being Element of
REAL n,a,b being Real st x in the carrier of X & y in the carrier of X holds a*
  x+b*y in the carrier of X;

theorem 
  for u,v being Element of REAL n holds (Euclid_scalar n).(u,v) = |(u,v
  )|;

theorem 
  for F being FinSequence of the carrier of RealVectSpace(Seg n),
Bn being Subset of RealVectSpace(Seg n), v0 being Element of RealVectSpace(Seg
  n),l being Linear_Combination of Bn st F is one-to-one & Bn is R-orthogonal &
rng F = Carrier l & v0 in Bn & j in dom (l (#) F) & v0=F.j holds (Euclid_scalar
  n).(v0,Sum (l(#)F)) = (Euclid_scalar n).(v0,(l.(F/.j))*v0);

registration
  let n;
  cluster R-orthonormal -> linearly-independent for
Subset of RealVectSpace(Seg n);
end;

registration
  let n be Element of NAT;
  cluster R-orthonormal -> linearly-independent for Subset of REAL-US n;
end;

theorem 
  for Bn being Subset of RealVectSpace(Seg n), x,y being Element
of REAL n,a being Real st Bn is linearly-independent & x in Bn & y in Bn & y=a*
  x holds x=y;

begin 

registration let n;
  cluster RN_Base n -> finite;
end;

theorem 
  card RN_Base n = n;

theorem 
  for f being FinSequence of REAL n, g being FinSequence of the
  carrier of RealVectSpace(Seg n) st f=g holds Sum f=Sum g;

theorem 
  for x0 being Element of RealVectSpace(Seg n), B being Subset of
RealVectSpace(Seg n) st B=RN_Base n holds ex l being Linear_Combination of B st
  x0=Sum l;

theorem 
  for n being Element of NAT,x0 being Element of REAL-US n, B
being Subset of REAL-US n st B=RN_Base n holds ex l being Linear_Combination of
  B st x0=Sum l;

theorem 
  for B being Subset of RealVectSpace(Seg n) st B=RN_Base n holds
  B is Basis of RealVectSpace(Seg n);

registration
  let n;
  cluster RealVectSpace(Seg n) -> finite-dimensional;
end;

theorem 
  dim (RealVectSpace(Seg n)) = n;

theorem 
  for B being Subset of RealVectSpace(Seg n) st B is Basis of
  RealVectSpace(Seg n) holds card B = n;

theorem 
  {} is Basis of RealVectSpace(Seg 0);

theorem 
  for n being Element of NAT holds RN_Base n is Basis of REAL-US n;

theorem 
  for D being Orthogonal_Basis of n holds D is Basis of RealVectSpace(Seg n);

registration
  let n be Element of NAT;
  cluster REAL-US n -> finite-dimensional;
end;

theorem 
  for n being Element of NAT holds dim (REAL-US n) = n;

theorem 
  for B being Orthogonal_Basis of n holds card B = n;















begin

reserve r,p,x for Real;

reserve n for Element of NAT;
reserve A for non empty closed_interval Subset of REAL;

reserve Z for open Subset of REAL;



theorem 
  -(exp_R*(AffineMap(-1,0))) is_differentiable_on REAL & for x holds ((-
  (exp_R*(AffineMap(-1,0))))`|REAL).x = exp_R(-x);



theorem 
  r<>0 implies (1/r)(#)(exp_R*(AffineMap(r,0)))
  is_differentiable_on REAL & for x holds (((1/r)(#)(exp_R*(AffineMap(r,0))))`|
  REAL).x=(exp_R*(AffineMap(r,0))).x;



theorem 
  r<>0 implies integral(exp_R*(AffineMap(r,0)),A) = ((1/r)(#)(exp_R*(
  AffineMap(r,0)))).(upper_bound A) -((1/r)(#)(exp_R*(AffineMap(r,0)))).(
  lower_bound A);



theorem 
  n<>0 implies (-1/n)(#)(cos*(AffineMap(n,0))) is_differentiable_on
  REAL & for x holds (((-1/n)(#)(cos*(AffineMap(n,0))))`|REAL).x =sin(n*x);



theorem 
  n<>0 implies integral(sin*(AffineMap(n,0)),A) = ((-1/n)(#)(cos*(
  AffineMap(n,0)))).(upper_bound A) -((-1/n)(#)(cos*(AffineMap(n,0)))).(
  lower_bound A);



theorem 
  n<>0 implies (1/n)(#)(sin*(AffineMap(n,0))) is_differentiable_on
  REAL & for x holds (((1/n)(#)(sin*(AffineMap(n,0))))`|REAL).x = cos(n*x);



theorem 
  n<>0 implies integral(cos*(AffineMap(n,0)),A) = ((1/n)(#)(sin*(
  AffineMap(n,0)))).(upper_bound A) -((1/n)(#)(sin*(AffineMap(n,0)))).(
  lower_bound A);



theorem 
  A c= Z implies integral((id Z)(#)sin,A) = ((-id Z)(#)cos+sin).(
  upper_bound A)-((-id Z)(#)cos+sin).(lower_bound A);



theorem 
  A c= Z implies integral((id Z)(#)cos,A) = ((id Z)(#)sin+cos).(
  upper_bound A)-((id Z)(#)sin+cos).(lower_bound A);



theorem 
  (id Z)(#)cos is_differentiable_on Z & for x st x in Z holds (((
  id Z)(#)cos)`|Z).x =cos.x-x*sin.x;



theorem 
  -sin+(id Z)(#)cos is_differentiable_on Z & for x st x in Z holds
  ((-sin+(id Z)(#)cos)`|Z).x =-x*sin.x;



theorem 
  A c= Z implies integral((-id Z)(#)sin,A) = (-sin+(id Z)(#)cos).(
  upper_bound A)-(-sin+(id Z)(#)cos).(lower_bound A);



theorem 
  -cos-(id Z)(#)sin is_differentiable_on Z & for x st x in Z holds
  ((-cos-(id Z)(#)sin)`|Z).x =-x*cos.x;



theorem 
  A c= Z implies integral((-id Z)(#)cos,A) = (-cos-(id Z)(#)sin).(
  upper_bound A)-(-cos-(id Z)(#)sin).(lower_bound A);



theorem 
  A c= Z implies integral(sin+(id Z)(#)cos,A) = ((id Z)(#)sin).(
  upper_bound A)-((id Z)(#)sin).(lower_bound A);



theorem 
  A c= Z implies integral(-cos+(id Z)(#)sin,A) = ((-id Z)(#)cos).(
  upper_bound A)-((-id Z)(#)cos).(lower_bound A);



theorem 
  integral((AffineMap(1,0))(#)exp_R,A) = (exp_R(#)(AffineMap(1,-1))).(
  upper_bound A) -(exp_R(#)(AffineMap(1,-1))).(lower_bound A);



theorem 
  (1/(n+1))(#)( #Z (n+1)) is_differentiable_on REAL & for x holds
  (((1/(n+1))(#)( #Z (n+1)))`|REAL).x = x #Z n;



theorem 
  integral( #Z n,A) = ((1/(n+1))*((upper_bound A) |^ (n+1))) - ((1/(n+1)
  )*((lower_bound A) |^ (n+1)));

begin

theorem 
  for f,g being PartFunc of REAL,REAL, C being non empty Subset of
  REAL holds (f-g)||C = f||C - g||C;

theorem 
  for f1,f2,g being PartFunc of REAL,REAL, C being non empty
  Subset of REAL holds ((f1+f2)||C)(#)(g||C)=(f1(#)g+f2(#)g)||C;

theorem 
  for f1,f2,g being PartFunc of REAL,REAL, C being non empty
  Subset of REAL holds ((f1-f2)||C)(#)(g||C)=(f1(#)g-f2(#)g)||C;

theorem 
  for f1,f2,g being PartFunc of REAL,REAL, C being non empty Subset of
  REAL holds ((f1(#)f2)||C)(#)(g||C)=(f1||C)(#)((f2(#)g)||C);

definition
  let A be non empty closed_interval Subset of REAL;
  let f,g be PartFunc of REAL,REAL;
  func |||(f,g,A)||| -> Real equals

  integral((f(#)g),A);
end;

theorem 
  for f,g being PartFunc of REAL,REAL,
  A being non empty closed_interval Subset of
  REAL holds |||(f,g,A)||| = |||(g,f,A)|||;

theorem 
  for f1,f2,g being PartFunc of REAL,REAL, A being non empty closed_interval
  Subset of REAL st (f1(#)g)||A is total & (f2(#)g)||A is total & (f1(#)g)||A|A
is bounded & (f1(#)g)||A is integrable & (f2(#)g)||A|A is bounded & (f2(#)g)||A
  is integrable holds |||(f1+f2,g,A)||| = |||(f1,g,A)||| + |||(f2,g,A)|||;

theorem 
  for f1,f2,g being PartFunc of REAL,REAL, A being non empty closed_interval
  Subset of REAL st (f1(#)g)||A is total & (f2(#)g)||A is total & (f1(#)g)||A|A
is bounded & (f1(#)g)||A is integrable & (f2(#)g)||A|A is bounded & (f2(#)g)||A
  is integrable holds |||(f1-f2,g,A)||| = |||(f1,g,A)||| - |||(f2,g,A)|||;

theorem 
  for f,g being PartFunc of REAL,REAL,
  A being non empty closed_interval Subset of
REAL st (f(#)g)|A is bounded & f(#)g is_integrable_on A & A c= dom(f(#)g) holds
  |||(-f,g,A)||| = - |||(f,g,A)|||;

theorem 
  for f,g being PartFunc of REAL,REAL,
  A being non empty closed_interval Subset of
REAL st (f(#)g)|A is bounded & f(#)g is_integrable_on A & A c= dom(f(#)g) holds
  |||((r(#)f),g,A)||| = r*|||(f,g,A)|||;

theorem 
  for f,g being PartFunc of REAL,REAL, A being
  non empty closed_interval Subset of
REAL st (f(#)g)|A is bounded & f(#)g is_integrable_on A & A c= dom(f(#)g) holds
  |||((r(#)f),(p(#)g),A)||| = r*p*|||(f,g,A)|||;

theorem 
  for f,g,h being PartFunc of REAL,REAL,
  A being non empty closed_interval Subset
  of REAL holds |||((f(#)g),h,A)||| = |||(f,(g(#)h),A)|||;

theorem 
  for f,g being PartFunc of REAL,REAL, A being non empty closed_interval
  Subset of REAL st (f(#)f)||A is total & (f(#)g)||A is total & (g(#)g)||A is
  total & (f(#)f)||A|A is bounded & (f(#)g)||A|A is bounded & (g(#)g)||A|A is
  bounded & (f(#)f) is_integrable_on A & (f(#)g) is_integrable_on A & (g(#)g)
is_integrable_on A holds |||(f+g,f+g,A)||| = |||(f,f,A)||| + 2*|||(f,g,A)||| +
  |||(g,g,A)|||;

begin 

definition
  let A be non empty closed_interval Subset of REAL;
  let f,g be PartFunc of REAL,REAL;
  pred f is_orthogonal_with g,A means


  |||(f,g,A)||| = 0;
end;

theorem 
  for f,g being PartFunc of REAL,REAL, A being non empty closed_interval
  Subset of REAL st (f(#)f)||A is total & (f(#)g)||A is total & (g(#)g)||A is
  total & (f(#)f)||A|A is bounded & (f(#)g)||A|A is bounded & (g(#)g)||A|A is
  bounded & (f(#)f) is_integrable_on A & (f(#)g) is_integrable_on A & (g(#)g)
is_integrable_on A & f is_orthogonal_with g,A holds |||(f+g,f+g,A)||| = |||(f,f
  ,A)||| + |||(g,g,A)|||;

theorem 
  for f being PartFunc of REAL,REAL,
  A being non empty closed_interval Subset of
  REAL st (f(#)f)||A is total & (f(#)f)||A|A is bounded & (f(#)f)||A is
integrable & (for x st x in A holds (f(#)f)||A.x >= 0) holds |||(f,f,A)||| >= 0
;

theorem 
  A = [.0,PI.] implies sin is_orthogonal_with cos,A;

theorem 
  A = [.0,PI*2.] implies sin is_orthogonal_with cos,A;

theorem 
  A = [.2*n*PI,(2*n+1)*PI.] implies sin is_orthogonal_with cos,A;

theorem 
  A = [.x+2*n*PI,x+(2*n+1)*PI.] implies sin is_orthogonal_with cos,A;

theorem 
  A = [.-PI,PI.] implies sin is_orthogonal_with cos,A;

theorem 
  A = [.-PI/2,PI/2.] implies sin is_orthogonal_with cos,A;

theorem 
  A = [.-2*PI,2*PI.] implies sin is_orthogonal_with cos,A;

theorem 
  A = [.-2*n*PI,2*n*PI.] implies sin is_orthogonal_with cos,A;

theorem 
  A = [.x-2*n*PI,x+2*n*PI.] implies sin is_orthogonal_with cos,A;

begin 

definition
  let A be non empty closed_interval Subset of REAL;
  let f be PartFunc of REAL,REAL;
  func ||..f,A..|| -> Real equals

  sqrt (|||(f,f,A)|||);
end;

theorem 
  for f being PartFunc of REAL,REAL,
  A being non empty closed_interval Subset of
REAL st (f(#)f)||A is total & (f(#)f)||A|A is bounded & (for x st x in A holds
  (f(#)f)||A.x >= 0) holds 0 <= ||..f,A..||;

theorem 
  for f being PartFunc of REAL,REAL,
  A being non empty closed_interval Subset of
  REAL holds ||..(1(#)f),A..|| = ||..f,A..||;

theorem 
  for f,g being PartFunc of REAL,REAL,
  A being non empty closed_interval Subset of
REAL st (f(#)f)||A is total & (f(#)g)||A is total & (g(#)g)||A is total & (f(#)
f)||A|A is bounded & (f(#)g)||A|A is bounded & (g(#)g)||A|A is bounded & (f(#)f
) is_integrable_on A & (f(#)g) is_integrable_on A & (g(#)g) is_integrable_on A
& f is_orthogonal_with g,A & (for x st x in A holds (f(#)f)||A.x >= 0) & (for x
  st x in A holds (g(#)g)||A.x >= 0) holds ||..(f+g),A..||^2 = ||..f,A..||^2 +
  ||..g,A..||^2;

begin 

reserve a,b,x for Real;

reserve n for Element of NAT;
reserve A for non empty closed_interval Subset of REAL;
reserve f,f1,f2 for PartFunc of REAL,REAL;
reserve Z for open Subset of REAL;



theorem 
  not -a in A implies (AffineMap (1,a))^|A is continuous;



theorem 
  A c= Z & (for x st x in Z holds f.x = a+x & f.x<>0) & Z = dom f & dom
  f = dom f2 & (for x st x in Z holds f2.x = -1/(a+x)^2 ) & f2|A is continuous
  implies integral(f2,A) = f^.(upper_bound A)-f^.(lower_bound A);



theorem 
  A c= Z & (for x st x in Z holds f.x = a+x & f.x<>0) & dom((-1)(#)(f^))
=Z & dom((-1)(#)(f^))=dom f2 & (for x st x in Z holds f2.x = 1/(a+x)^2 ) & f2|A
is continuous implies integral(f2,A) = ((-1)(#)(f^)).(upper_bound A)-((-1)(#)(f
  ^)).(lower_bound A);



theorem 
  A c= Z & (for x st x in Z holds f.x = a-x & f.x<>0) & dom f = Z & dom
  f = dom f2 & (for x st x in Z holds f2.x = 1/(a-x)^2 ) & f2|A is continuous
  implies integral(f2,A) = f^.(upper_bound A)-f^.(lower_bound A);



theorem 
  A c= Z & (for x st x in Z holds f.x = a+x & f.x > 0) & dom (ln*f) = Z
  & dom (ln*f) = dom f2 & (for x st x in Z holds f2.x = 1/(a+x) ) & f2|A is
continuous implies integral(f2,A) = (ln*f).(upper_bound A)-(ln*f).(lower_bound
  A);



theorem 
  A c= Z & (for x st x in Z holds f.x = x-a & f.x > 0) & dom (ln*f) = Z
  & dom (ln*f) = dom f2 & (for x st x in Z holds f2.x = 1/(x-a) ) & f2|A is
continuous implies integral(f2,A) = (ln*f).(upper_bound A)-(ln*f).(lower_bound
  A);



theorem 
  A c= Z & (for x st x in Z holds f.x = a-x & f.x > 0) & dom (-(ln*f)) =
Z & dom (-(ln*f)) = dom f2 & (for x st x in Z holds f2.x = 1/(a-x) ) & f2|A is
  continuous implies integral(f2,A) = (-(ln*f)).(upper_bound A)-(-(ln*f)).(
  lower_bound A);



theorem 
  A c= Z & f = ln*f1 & (for x st x in Z holds f1.x=a+x & f1.x>0) & dom (
id Z - a(#)f) = Z & Z = dom f2 & (for x st x in Z holds f2.x = x/(a+x) ) & f2|A
is continuous implies integral(f2,A) = (id Z - a(#)f).(upper_bound A)-(id Z - a
  (#)f).(lower_bound A);



theorem 
  A c= Z & f = ln*f1 & (for x st x in Z holds f1.x=a+x & f1.x>0) & dom (
(2*a)(#)f - id Z) = Z & Z = dom f2 & (for x st x in Z holds f2.x = (a-x)/(a+x))
& f2|A is continuous implies integral(f2,A) = ((2*a)(#)f - id Z).(upper_bound A
  )-((2*a)(#)f - id Z).(lower_bound A);



theorem 
  A c= Z & f = ln*f1 & (for x st x in Z holds f1.x=x+a & f1.x>0) & dom (
id Z -(2*a)(#)f) = Z & Z = dom f2 & (for x st x in Z holds f2.x = (x-a)/(x+a))
& f2|A is continuous implies integral(f2,A) = (id Z -(2*a)(#)f).(upper_bound A)
  -(id Z -(2*a)(#)f).(lower_bound A);



theorem 
  A c= Z & f = ln*f1 & (for x st x in Z holds f1.x=x-a & f1.x>0) & dom (
id Z + (2*a)(#)f) = Z & Z = dom f2 & (for x st x in Z holds f2.x = (x+a)/(x-a))
& f2|A is continuous implies integral(f2,A) = (id Z + (2*a)(#)f).(upper_bound A
  )-(id Z + (2*a)(#)f).(lower_bound A);



theorem 
  A c= Z & f = ln*f1 & (for x st x in Z holds f1.x=x+b & f1.x>0) & dom (
id Z + (a-b)(#)f) = Z & Z = dom f2 & (for x st x in Z holds f2.x = (x+a)/(x+b))
& f2|A is continuous implies integral(f2,A) = (id Z + (a-b)(#)f).(upper_bound A
  )-(id Z + (a-b)(#)f).(lower_bound A);



theorem 
  A c= Z & f = ln*f1 & (for x st x in Z holds f1.x=x-b & f1.x>0) & dom (
id Z + (a+b)(#)f) = Z & Z = dom f2 & (for x st x in Z holds f2.x = (x+a)/(x-b))
& f2|A is continuous implies integral(f2,A) = (id Z + (a+b)(#)f).(upper_bound A
  )-(id Z + (a+b)(#)f).(lower_bound A);



theorem 
  A c= Z & f = ln*f1 & (for x st x in Z holds f1.x=x+b & f1.x>0) & dom (
id Z - (a+b)(#)f) = Z & Z = dom f2 & (for x st x in Z holds f2.x = (x-a)/(x+b))
& f2|A is continuous implies integral(f2,A) = (id Z - (a+b)(#)f).(upper_bound A
  )-(id Z - (a+b)(#)f).(lower_bound A);



theorem 
  A c= Z & f = ln*f1 & (for x st x in Z holds f1.x=x-b & f1.x>0) & dom (
id Z + (b-a)(#)f) = Z & Z = dom f2 & (for x st x in Z holds f2.x = (x-a)/(x-b))
& f2|A is continuous implies integral(f2,A) = (id Z + (b-a)(#)f).(upper_bound A
  )-(id Z + (b-a)(#)f).(lower_bound A);



theorem 
  A c= Z & dom ln = Z & Z = dom ((id Z)^) & (id Z)^|A is continuous
  implies integral((id Z)^,A) = ln.(upper_bound A)-ln.(lower_bound A);



theorem 
  A c= Z & (for x st x in Z holds x > 0) & dom (ln*( #Z n)) = Z & dom (
ln*( #Z n)) = dom f2 & (for x st x in Z holds f2.x = n/x ) & f2|A is continuous
implies integral(f2,A) = (ln*( #Z n)).(upper_bound A)-(ln*( #Z n)).(lower_bound
  A);



theorem 
  not 0 in Z & A c= Z & dom (ln*((id Z)^)) = Z & dom (ln*((id Z)^)) =
  dom f2 & (for x st x in Z holds f2.x = -1/x) & f2|A is continuous implies
integral(f2,A) = (ln*((id Z)^)).(upper_bound A)-(ln*((id Z)^)).(lower_bound A);




theorem 
  A c= Z & (for x st x in Z holds f.x=a+x & f.x>0) & dom ((2/3)(#)(( #R
  (3/2))*f)) = Z & dom ((2/3)(#)(( #R (3/2))*f)) = dom f2 & (for x st x in Z
holds f2.x = (a+x) #R (1/2)) & f2|A is continuous implies integral(f2,A) = ((2/
3)(#)(( #R (3/2))*f)).(upper_bound A) -((2/3)(#)(( #R (3/2))*f)).(lower_bound A
  );



theorem 
  A c= Z & (for x st x in Z holds f.x=a-x & f.x>0) & dom ((-2/3)(#)(( #R
  (3/2))*f)) = Z & dom ((-2/3)(#)(( #R (3/2))*f)) = dom f2 & (for x st x in Z
holds f2.x = (a-x) #R (1/2)) & f2|A is continuous implies integral(f2,A) = ((-2
/3)(#)(( #R (3/2))*f)).(upper_bound A) -((-2/3)(#)(( #R (3/2))*f)).(lower_bound
  A);



theorem 
  A c= Z & (for x st x in Z holds f.x=a+x & f.x>0) & dom (2(#)(( #R (1/2
))*f)) = Z & dom (2(#)(( #R (1/2))*f)) = dom f2 & (for x st x in Z holds f2.x =
(a+x) #R (-1/2)) & f2|A is continuous implies integral(f2,A) = (2(#)(( #R (1/2)
  )*f)).(upper_bound A) -(2(#)(( #R (1/2))*f)).(lower_bound A);



theorem 
  A c= Z & (for x st x in Z holds f.x=a-x & f.x>0) & dom ((-2)(#)(( #R (
1/2))*f)) = Z & dom ((-2)(#)(( #R (1/2))*f)) = dom f2 & (for x st x in Z holds
f2.x = (a-x) #R (-1/2)) & f2|A is continuous implies integral(f2,A) = ((-2)(#)(
  ( #R (1/2))*f)).(upper_bound A) -((-2)(#)(( #R (1/2))*f)).(lower_bound A);



theorem 
  A c= Z & dom ((-id Z)(#)cos+sin) = Z & (for x st x in Z holds f.x =x*
sin.x) & Z = dom f & f|A is continuous implies integral(f,A) = ((-id Z)(#)cos+
  sin).(upper_bound A)-((-id Z)(#)cos+sin).(lower_bound A);



theorem 
  A c= Z & dom sec = Z & (for x st x in Z holds f.x =sin.x/(cos.x)^2) &
Z = dom f & f|A is continuous implies integral(f,A) = sec.(upper_bound A)-sec.(
  lower_bound A);



theorem 
  Z c= dom (-cosec) implies -cosec is_differentiable_on Z & for x
  st x in Z holds ( (-cosec)`|Z).x = cos.x/(sin.x)^2;



theorem 
  A c= Z & dom (-cosec) = Z & (for x st x in Z holds f.x =cos.x/(sin.x)
  ^2) & Z = dom f & f|A is continuous implies integral(f,A) = (-cosec).(
  upper_bound A)-(-cosec).(lower_bound A);














begin 

reserve r,x,x0,a,b for Real;
reserve n,m for Element of NAT;
reserve A for non empty closed_interval Subset of REAL;
reserve Z for open Subset of REAL;



theorem 
  AffineMap(1/2,0)-(1/4)(#)(sin*AffineMap(2,0))
  is_differentiable_on REAL & for x holds ((AffineMap(1/2,0)-(1/4)(#)(sin*
  AffineMap(2,0)))`|REAL).x = (sin.x)^2;



theorem 
  AffineMap(1/2,0)+(1/4)(#)(sin*AffineMap(2,0))
  is_differentiable_on REAL & for x holds ((AffineMap(1/2,0)+(1/4)(#)(sin*
  AffineMap(2,0)))`|REAL).x = (cos.x)^2;



theorem 
  (1/(n+1))(#)( #Z (n+1)*sin) is_differentiable_on REAL & for x
  holds (((1/(n+1))(#)( #Z (n+1)*sin))`|REAL).x = ((sin.x) #Z n)*cos.x;



theorem 
  (-1/(n+1))(#)( #Z (n+1)*cos) is_differentiable_on REAL & for x
  holds (((-1/(n+1))(#)( #Z (n+1)*cos))`|REAL).x = ((cos.x) #Z n)*sin.x;



theorem 
  m+n<>0 & m-n<>0 implies ((1/(2*(m+n)))(#)(sin*AffineMap(m+n,0))+
(1/(2*(m-n)))(#)(sin*AffineMap(m-n,0))) is_differentiable_on REAL & for x holds
(((1/(2*(m+n)))(#)(sin*AffineMap(m+n,0))+ (1/(2*(m-n)))(#)(sin*AffineMap(m-n,0)
  ))`|REAL).x = cos.(m*x) *cos.(n*x);



theorem 
  m+n<>0 & m-n<>0 implies ((1/(2*(m-n)))(#)(sin*AffineMap(m-n,0))-
(1/(2*(m+n)))(#)(sin*AffineMap(m+n,0))) is_differentiable_on REAL & for x holds
(((1/(2*(m-n)))(#)(sin*AffineMap(m-n,0))- (1/(2*(m+n)))(#)(sin*AffineMap(m+n,0)
  ))`|REAL).x = sin.(m*x)*sin.(n*x);



theorem 
  m+n<>0 & m-n<>0 implies ((-(1/(2*(m+n)))(#)(cos*AffineMap(m+n,0))
  ) - (1/(2*(m-n)))(#)(cos*AffineMap(m-n,0))) is_differentiable_on REAL & for x
  holds ((-((1/(2*(m+n)))(#)(cos*AffineMap(m+n,0)))- (1/(2*(m-n)))(#)(cos*
  AffineMap(m-n,0)))`|REAL).x = sin.(m*x) * cos.(n*x);



theorem 
  n<>0 implies ((1/(n^2))(#)(sin*AffineMap(n,0))- (AffineMap(1/n,0)
  )(#)(cos*AffineMap(n,0))) is_differentiable_on REAL & for x holds (((1/(n^2))
(#)(sin*AffineMap(n,0))- (AffineMap(1/n,0))(#)(cos*AffineMap(n,0)))`|REAL).x=x*
  sin.(n*x);



theorem 
  n<>0 implies ((1/(n^2))(#)(cos*AffineMap(n,0))+ (AffineMap(1/n,0)
  )(#)(sin*AffineMap(n,0))) is_differentiable_on REAL & for x holds (((1/(n^2))
(#)(cos*AffineMap(n,0))+ (AffineMap(1/n,0))(#)(sin*AffineMap(n,0)))`|REAL).x=x*
  cos.(n*x);



theorem 
  (AffineMap(1,0))(#)cosh-sinh is_differentiable_on REAL & for x
  holds (((AffineMap(1,0))(#)cosh-sinh)`|REAL).x=x*sinh.x;



theorem 
  (AffineMap(1,0))(#)sinh-cosh is_differentiable_on REAL & for x
  holds (((AffineMap(1,0))(#)sinh-cosh)`|REAL).x=x*cosh.x;



theorem 
  a*(n+1) <> 0 implies (1/(a*(n+1)))(#)( #Z (n+1)*AffineMap(a,b))
is_differentiable_on REAL & for x holds (((1/(a*(n+1)))(#)( #Z (n+1)*AffineMap(
  a,b)))`|REAL).x = (a*x+b) #Z n;

begin 


theorem 
  integral(sin^2,A) = (AffineMap(1/2,0)-(1/4)(#)(sin*AffineMap(2,0
  ))).(upper_bound A) -(AffineMap(1/2,0)-(1/4)(#)(sin*AffineMap(2,0))).
  (lower_bound A);

theorem 
  A = [.0,PI.] implies integral(sin^2,A) = PI/2;

theorem 
  A = [.0,2*PI.] implies integral(sin^2,A) = PI;



theorem 
  integral(cos^2,A) = (AffineMap(1/2,0)+(1/4)(#)(sin*AffineMap(2,0
  ))).(upper_bound A) -(AffineMap(1/2,0)+(1/4)(#)(sin*AffineMap(2,0))).
  (lower_bound A);

theorem 
  A = [.0,PI.] implies integral(cos^2,A) = PI/2;

theorem 
  A = [.0,2*PI.] implies integral(cos^2,A) = PI;



theorem 
  integral(( #Z n*sin)(#)cos,A) = ((1/(n+1))(#)( #Z (n+1)*sin)).(
  upper_bound A) -((1/(n+1))(#)( #Z (n+1)*sin)).(lower_bound A);

theorem 
  A = [.0,PI.] implies integral(( #Z n*sin)(#)cos,A) = 0;

theorem 
  A = [.0,2*PI.] implies integral(( #Z n*sin)(#)cos,A) = 0;



theorem 
  integral(( #Z n*cos)(#)sin,A) = ((-1/(n+1))(#)( #Z (n+1)*cos)).(
  upper_bound A) -((-1/(n+1))(#)( #Z (n+1)*cos)).(lower_bound A);

theorem 
  A = [.0,2*PI.] implies integral(( #Z n*cos)(#)sin,A) = 0;

theorem 
  A = [.-PI/2,PI/2.] implies integral(( #Z n*cos)(#)sin,A) = 0;



theorem 
  m+n<>0 & m-n<>0 implies integral((cos*AffineMap(m,0))(#)(cos*AffineMap
  (n,0)),A) = ((1/(2*(m+n)))(#)(sin*AffineMap(m+n,0))+ (1/(2*(m-n)))(#)(sin*
AffineMap(m-n,0))).(upper_bound A) -((1/(2*(m+n)))(#)(sin*AffineMap(m+n,0))+
 (1/(2*(m-n
  )))(#)(sin*AffineMap(m-n,0))).(lower_bound A);



theorem 
  m+n<>0 & m-n<>0 implies integral((sin*AffineMap(m,0))(#)(sin*AffineMap
  (n,0)),A) = ((1/(2*(m-n)))(#)(sin*AffineMap(m-n,0))- (1/(2*(m+n)))(#)(sin*
AffineMap(m+n,0))).(upper_bound A) -((1/(2*(m-n)))(#)(sin*AffineMap(m-n,0))-
 (1/(2*(m+n
  )))(#)(sin*AffineMap(m+n,0))).(lower_bound A);



theorem 
  m+n<>0 & m-n<>0 implies integral((sin*AffineMap(m,0))(#)(cos*AffineMap
  (n,0)),A) = ((-(1/(2*(m+n)))(#)(cos*AffineMap(m+n,0)))- (1/(2*(m-n)))(#)(cos*
AffineMap(m-n,0))).(upper_bound A) -((-(1/(2*(m+n)))(#)(cos*AffineMap(m+n,0)))
- (1/(2*(
  m-n)))(#)(cos*AffineMap(m-n,0))).(lower_bound A);



theorem 
  n<>0 implies integral((AffineMap(1,0))(#)(sin*AffineMap(n,0)),A) = ((1
/(n^2))(#)(sin*AffineMap(n,0))- (AffineMap(1/n,0))(#)(cos*AffineMap(n,0))).
(upper_bound
A) -((1/(n^2))(#)(sin*AffineMap(n,0))- (AffineMap(1/n,0))(#)(cos*AffineMap(n,0)
  )).(lower_bound A);



theorem 
  n<>0 implies integral((AffineMap(1,0))(#)(cos*AffineMap(n,0)),A) = ((1
/(n^2))(#)(cos*AffineMap(n,0))+ (AffineMap(1/n,0))(#)(sin*AffineMap(n,0))).
(upper_bound
A) -((1/(n^2))(#)(cos*AffineMap(n,0))+ (AffineMap(1/n,0))(#)(sin*AffineMap(n,0)
  )).(lower_bound A);

theorem 
  integral((AffineMap(1,0))(#)sinh,A) = ((AffineMap(1,0))(#)cosh-sinh).(
  upper_bound A) -((AffineMap(1,0))(#)cosh-sinh).(lower_bound A);

theorem 
  integral((AffineMap(1,0))(#)cosh,A) = ((AffineMap(1,0))(#)sinh-cosh).(
  upper_bound A) -((AffineMap(1,0))(#)sinh-cosh).(lower_bound A);



theorem 
  a*(n+1) <> 0 implies integral( #Z n*AffineMap(a,b),A) = ((1/(a*(n+1)))
(#)( #Z (n+1)*AffineMap(a,b))).(upper_bound A) -
((1/(a*(n+1)))(#)( #Z (n+1)*AffineMap(a
  ,b))).(lower_bound A);

begin 

reserve f, f1, f2, f3 for PartFunc of REAL, REAL;



theorem 
  Z c= dom ((1/2)(#)f) & f=#Z 2 implies (1/2)(#)f
  is_differentiable_on Z & for x st x in Z holds (((1/2)(#)f)`|Z).x = x;



theorem 
  A c= Z & f=#Z 2 & Z = dom ((1/2)(#)f) implies integral(id Z,A) = ((1/2
  )(#)f).(upper_bound A)-((1/2)(#)f).(lower_bound A);



theorem 
  not 0 in Z & A c= Z & (for x st x in Z holds x<>0 & f.x = -1/x^2) &
dom f = Z & f|A is continuous implies integral(f,A) =
 ((id Z)^).(upper_bound A)-((id Z)
  ^).(lower_bound A);



theorem 
  A c= Z & f1=#Z 2 & (for x st x in Z holds f2.x=1 & x<>0 & f.x=2*x/(1+x
^2)^2) & dom (f1/(f2+f1))=Z & Z = dom f & f|A is continuous implies integral(f,
  A) = (f1/(f2+f1)).(upper_bound A)-(f1/(f2+f1)).(lower_bound A);

theorem 
  (Z c= dom (tan+sec) & for x st x in Z holds (1+sin.x)<>0 & (1-
sin.x)<>0) implies tan+sec is_differentiable_on Z & for x st x in Z holds ((tan
  +sec)`|Z).x = 1/(1-sin.x);



theorem 
  A c= Z & (for x st x in Z holds (1+sin.x)<>0 & (1-sin.x)<>0 & f.x = 1/
(1-sin.x)) & dom (tan+sec)=Z & Z = dom f & f|A is continuous implies integral(f
  ,A) = (tan+sec).(upper_bound A)-(tan+sec).(lower_bound A);

theorem 
  (Z c= dom (tan-sec) & for x st x in Z holds (1+sin.x)<>0 & (1-
sin.x)<>0) implies tan-sec is_differentiable_on Z & for x st x in Z holds ((tan
  -sec)`|Z).x = 1/(1+sin.x);



theorem 
  A c= Z & (for x st x in Z holds (1+sin.x)<>0 & (1-sin.x)<>0 & f.x = 1/
(1+sin.x)) & dom (tan-sec)=Z & Z = dom f & f|A is continuous implies integral(f
  ,A) = (tan-sec).(upper_bound A)-(tan-sec).(lower_bound A);

theorem 
  (Z c= dom (-cot+cosec) & for x st x in Z holds (1+cos.x)<>0 & (1
-cos.x)<>0) implies -cot+cosec is_differentiable_on Z & for x st x in Z holds (
  (-cot+cosec)`|Z).x = 1/(1+cos.x);



theorem 
  A c= Z & (for x st x in Z holds (1+cos.x)<>0 & (1-cos.x)<>0 & f.x = 1/
  (1+cos.x)) & dom (-cot+cosec)=Z & Z = dom f & f|A is continuous implies
  integral(f,A) = (-cot+cosec).(upper_bound A)-(-cot+cosec).(lower_bound A);

theorem 
  (Z c= dom (-cot-cosec) & for x st x in Z holds (1+cos.x)<>0 & (1
-cos.x)<>0) implies -cot-cosec is_differentiable_on Z & for x st x in Z holds (
  (-cot-cosec)`|Z).x = 1/(1-cos.x);



theorem 
  A c= Z & (for x st x in Z holds (1+cos.x)<>0 & (1-cos.x)<>0 & f.x = 1/
  (1-cos.x)) & dom (-cot-cosec)=Z & Z = dom f & f|A is continuous implies
  integral(f,A) = (-cot-cosec).(upper_bound A)-(-cot-cosec).(lower_bound A);



theorem 
  A c= Z & Z c= ]. -1,1 .[ & (for x st x in Z holds f.x=1/(1+x^2)) & Z =
dom f & f|A is continuous implies integral(f,A)
 = arctan.(upper_bound A) - arctan.(lower_bound
  A);



theorem 
  A c= Z & Z c= ]. -1,1 .[ & (for x st x in Z holds f.x=r/(1+x^2)) & Z =
dom f & f|A is continuous implies integral(f,A) = (r(#)arctan).(upper_bound A)
 - (r(#)
  arctan).(lower_bound A);



theorem 
  A c= Z & Z c= ]. -1,1 .[ & (for x st x in Z holds f.x=-1/(1+x^2)) & Z
  = dom f & f|A is continuous implies integral(f,A) = arccot.(upper_bound A)
   - arccot.(
  lower_bound A);



theorem 
  A c= Z & Z c= ]. -1,1 .[ & (for x st x in Z holds f.x=-r/(1+x^2)) & Z
  = dom f & f|A is continuous implies integral(f,A)
   = (r(#)arccot).(upper_bound A) - (r
  (#)arccot).(lower_bound A);



theorem 
  (Z c= dom ((id Z)+cot-cosec) & for x st x in Z holds (1+cos.x)<>
0 & (1-cos.x)<>0) implies (id Z)+cot-cosec is_differentiable_on Z & for x st x
  in Z holds ((id Z+cot-cosec)`|Z).x = cos.x/(1+cos.x);



theorem 
  A c= Z & (for x st x in Z holds (1+cos.x)<>0 & (1-cos.x)<>0 & f.x =
  cos.x/(1+cos.x)) & dom (id Z+cot-cosec)=Z & Z = dom f & f|A is continuous
  implies integral(f,A) =
   (id Z+cot-cosec).(upper_bound A)-(id Z+cot-cosec).(lower_bound A);



theorem 
  (Z c= dom ((id Z)+cot+cosec) & for x st x in Z holds (1+cos.x)<>
0 & (1-cos.x)<>0) implies (id Z)+cot+cosec is_differentiable_on Z & for x st x
  in Z holds ((id Z+cot+cosec)`|Z).x = cos.x/(cos.x-1);



theorem 
  A c= Z & (for x st x in Z holds (1+cos.x)<>0 & (1-cos.x)<>0 & f.x =
  cos.x/(cos.x-1)) & dom (id Z+cot+cosec)=Z & Z = dom f & f|A is continuous
  implies integral(f,A) =
   (id Z+cot+cosec).(upper_bound A)-(id Z+cot+cosec).(lower_bound A);



theorem 
  (Z c= dom (id Z-tan+sec) & for x st x in Z holds (1+sin.x)<>0 &
  (1-sin.x)<>0) implies (id Z)-tan+sec is_differentiable_on Z & for x st x in Z
  holds ((id Z-tan+sec)`|Z).x = sin.x/(sin.x+1);



theorem 
  A c= Z & (for x st x in Z holds (1+sin.x)<>0 & (1-sin.x)<>0 & f.x =
  sin.x/(1+sin.x)) & Z c= dom (id Z-tan+sec) & Z = dom f & f|A is continuous
  implies integral(f,A) =
   (id Z-tan+sec).(upper_bound A)-(id Z-tan+sec).(lower_bound A);



theorem 
  (Z c= dom (id Z-tan-sec) & for x st x in Z holds (1+sin.x)<>0 &
  (1-sin.x)<>0) implies id Z-tan-sec is_differentiable_on Z & for x st x in Z
  holds ((id Z-tan-sec)`|Z).x = sin.x/(sin.x-1);



theorem 
  A c= Z & (for x st x in Z holds (1+sin.x)<>0 & (1-sin.x)<>0 & f.x =
  sin.x/(sin.x-1)) & Z c= dom (id Z-tan-sec) & Z = dom f & f|A is continuous
  implies integral(f,A) =
   (id Z-tan-sec).(upper_bound A)-(id Z-tan-sec).(lower_bound A);



theorem 
  Z c= dom (tan-id Z) implies tan-id Z is_differentiable_on Z &
  for x st x in Z holds ((tan-id Z)`|Z).x=(tan.x)^2;



theorem 
  A c= Z & (for x st x in Z holds cos.x >0 & f.x = (tan.x)^2) & Z c= dom
(tan-id Z) & Z = dom f & f|A is continuous implies integral(f,A) = (tan-id Z).(
  upper_bound A)-(tan-id Z).(lower_bound A);



theorem 
  Z c= dom (-cot-id Z) implies -cot-id Z is_differentiable_on Z &
  for x st x in Z holds ((-cot-id Z)`|Z).x = (cot.x)^2;



theorem 
  A c= Z & (for x st x in Z holds sin.x >0 & f.x = (cot.x)^2) & Z c= dom
(-cot-id Z) & Z = dom f & f|A is continuous implies integral(f,A) = (-cot-id Z)
  .(upper_bound A)-(-cot-id Z).(lower_bound A);



theorem 
  A c= Z & (for x st x in Z holds f.x = 1/(cos.x)^2 & cos.x <> 0) & dom
tan=Z & Z = dom f & f|A is continuous implies
 integral(f,A) = tan.(upper_bound A)-tan.(
  lower_bound A);



theorem 
  A c= Z & (for x st x in Z holds f.x = -1/(sin.x)^2 & sin.x <> 0) & dom
cot=Z & Z = dom f & f|A is continuous implies
 integral(f,A) = cot.(upper_bound A)-cot.(
  lower_bound A);



theorem 
  A c= Z & (for x st x in Z holds f.x = (sin.x-(cos.x)^2)/(cos.x)^2) & Z
c= dom (sec-id Z) & Z = dom f & f|A is continuous implies integral(f,A) = (sec-
  id Z).(upper_bound A)-(sec-id Z).(lower_bound A);



theorem 
  A c= Z & (for x st x in Z holds f.x = (cos.x-(sin.x)^2)/(sin.x)^2) & Z
c= dom (-cosec-id Z) & Z = dom f & f|A is continuous implies integral(f,A) =(-
  cosec-id Z).(upper_bound A)-(-cosec-id Z).(lower_bound A);



theorem 
  A c= Z & (for x st x in Z holds sin.x >0) & Z c= dom (ln*sin) & Z =
  dom cot & cot|A is continuous implies
   integral(cot,A) = (ln*sin).(upper_bound A)-(ln*
  sin).(lower_bound A);



theorem 
  A c= Z & Z c= ]. -1,1 .[ & (for x st x in Z holds f.x=arcsin.x/sqrt(1-
  x^2)) & Z c= dom ((1/2)(#)(( #Z 2)*(arcsin))) & Z = dom f & f|A is continuous
implies integral(f,A) = ((1/2)(#)(( #Z 2)*(arcsin))).(upper_bound A)
 -((1/2)(#)(( #Z 2)
  *(arcsin))).(lower_bound A);



theorem 
  A c= Z & Z c= ]. -1,1 .[ & (for x st x in Z holds f.x=-arccos.x / sqrt
  (1-x^2)) & Z c= dom ((1/2)(#)(( #Z 2)*(arccos))) & Z = dom f & f|A is
continuous implies integral(f,A) = ((1/2)(#)(( #Z 2)*(arccos))).(upper_bound A)
 -((1/2)
  (#)(( #Z 2)*(arccos))).(lower_bound A);



theorem 
  A c= Z & Z c= ]. -1,1 .[ & f=f1-f2 & f2=#Z 2 & (for x st x in Z holds
f1.x=1 & f.x >0 & x<>0) & dom arcsin=Z & Z c= dom ((id Z)(#)(arcsin)+( #R (1/2)
)*f) implies integral(arcsin,A) =
 ((id Z)(#)(arcsin)+( #R (1/2))*f).(upper_bound A) -((
  id Z)(#)(arcsin) + ( #R (1/2))*f).(lower_bound A);



theorem 
  A c= Z & f=f1-f2 & f2=#Z 2 & (for x st x in Z holds f1.x=a^2 & f.x >0
  & f3.x=x/a & f3.x > -1 & f3.x < 1 & x<>0 & a>0) & dom ((arcsin)*f3)=Z & Z c=
  dom ((id Z)(#)((arcsin)*f3)+( #R (1/2))*f) & ((arcsin)*f3)|A is continuous
implies integral((arcsin)*f3,A) =
 ((id Z)(#)((arcsin)*f3)+( #R (1/2))*f).(upper_bound A
  ) -((id Z)(#)((arcsin)*f3)+( #R (1/2))*f).(lower_bound A);



theorem 
  A c= Z & Z c= ]. -1,1 .[ & f=f1-f2 & f2=#Z 2 & (for x st x in Z holds
f1.x=1 & f.x >0 & x<>0) & dom arccos=Z & Z c= dom ((id Z)(#)(arccos)-( #R (1/2)
)*f) implies integral(arccos,A)
 = ((id Z)(#)(arccos)-( #R (1/2))*f).(upper_bound A) -((
  id Z)(#)(arccos)-( #R (1/2))*f).(lower_bound A);



theorem 
  A c= Z & f=f1-f2 & f2=#Z 2 & (for x st x in Z holds f1.x=a^2 & f.x >0
& f3.x=x/a & f3.x > -1 & f3.x < 1 & x<>0 & a>0) & dom ((arccos)*f3)=Z & Z = dom
((id Z)(#)((arccos)*f3)-( #R (1/2))*f) & ((arccos)*f3)|A is continuous implies
integral((arccos)*f3,A) =
 ((id Z)(#)((arccos)*f3)-( #R (1/2))*f).(upper_bound A) -((id
  Z)(#)((arccos)*f3)-( #R (1/2))*f).(lower_bound A);



theorem 
  A c= Z & Z c= ]. -1,1 .[ & f2=#Z 2 & (for x st x in Z holds f1.x=1 ) &
  Z = dom arctan & Z = dom ((id Z)(#)(arctan)-(1/2)(#)(ln*(f1+f2))) implies
integral(arctan,A) =
 ((id Z)(#)(arctan)-(1/2)(#)(ln*(f1+f2))).(upper_bound A) -((id Z)
  (#)(arctan)-(1/2)(#)(ln*(f1+f2))).(lower_bound A);



theorem 
  A c= Z & Z c= ]. -1,1 .[ & f2=#Z 2 & (for x st x in Z holds f1.x=1) &
  dom arccot=Z & Z = dom ((id Z)(#)(arccot)+(1/2)(#)(ln*(f1+f2))) implies
integral(arccot,A) =
 ((id Z)(#)(arccot)+(1/2)(#)(ln*(f1+f2))).(upper_bound A) -((id Z)
  (#)(arccot)+(1/2)(#)(ln*(f1+f2))).(lower_bound A);














begin

reserve z1,z2,z3,z4,z for quaternion number;

theorem 
  Rea (z1*z2) = Rea (z2*z1);

theorem 
  z is Real implies z+z3 = Rea z + Rea z3+Im1 z3 *<i>+Im2 z3 *<j>+Im3 z3 *<k>;

theorem 
  z is Real implies z-z3 = [* Rea z -Rea z3,-Im1 z3,-Im2 z3,-Im3 z3*];

theorem 
  z is Real implies z*z3 = [* Rea z*Rea z3,Rea z*Im1 z3,Rea z*Im2 z3,Rea
  z*Im3 z3*];

theorem 
  z is Real implies z*<i>=[*0,Rea z,0,0*];

theorem 
  z is Real implies z*<j>=[*0,0,Rea z,0*];

theorem 
  z is Real implies z*<k>=[*0,0,0,Rea z*];

theorem 
  z - 0q = z;

theorem 
  z is Real implies z*z1 = z1*z;

theorem 
  Im1 z = 0 & Im2 z = 0 & Im3 z = 0 implies z = Rea z;

theorem 
  |.z.| ^2 = (Rea z)^2 + (Im1 z)^2 + (Im2 z)^2 + (Im3 z)^2;

theorem 
  |.z.| ^2 = |.z*z*'.|;

theorem 
  |.z.| ^2 = Rea (z * z*');

theorem 
  2 * Rea z = Rea (z+ z*');

theorem 
  z is Real implies (z * z1)*' = z*' * z1*';

theorem 
  (z1*z2)*' = z2*' * z1*';

theorem 
  |.z1*z2.|^2 = |.z1.| ^2 * |.z2.| ^2;

theorem 
  <i>*z1-z1*<i> = [*0,0,-2*Im3 z1,2*Im2 z1*];

theorem 
  <i>*z1+z1*<i> = [*-2*Im1 z1,2*Rea z1,0,0*];

theorem 
  <j>*z1-z1*<j> = [*0,2*Im3 z1,0,-2*Im1 z1*];

theorem 
  <j>*z1+z1*<j> = [*-2*Im2 z1,0,2*Rea z1,0*];

theorem 
  <k>*z1-z1*<k> = [*0,-2*Im2 z1,2*Im1 z1,0*];

theorem 
  <k>*z1+z1*<k> = [*-2*Im3 z1,0,0,2*Rea z1*];

theorem 
  Rea (1/(|.z.| ^2) * z*') = 1/(|.z.| ^2)*Rea z;

theorem 
  Im1 (1/(|.z.| ^2) * z*') = -1/(|.z.| ^2)*Im1 z;

theorem 
  Im2 (1/(|.z.| ^2) * z*') = -1/(|.z.|^2)*Im2 z;

theorem 
  Im3 (1/(|.z.| ^2) * z*') = -1/(|.z.|^2)*Im3 z;

theorem 
  (1/(|.z.| ^2) * z*')=[*1/(|.z.|^2)*Rea z, -1/(|.z.|^2)*Im1 z, -1/(|.z
  .|^2)*Im2 z, -1/(|.z.|^2)*Im3 z*];

theorem 
  z * (1/(|.z.| ^2) * z*') = [* (|.z.| ^2)/(|.z.| ^2),0,0,0*];

theorem 
  |.z1*z2*z3.| ^2 = |.z1.| ^2 * |.z2.| ^2 * |.z3.| ^2;

theorem 
  Rea(z1*z2*z3) = Rea (z3*z1*z2);

theorem 
  |.z*z.| = |.z*'* z*'.|;

theorem 
  |.z*'* z*'.| = |.z.| ^2;

theorem 
  |.z1*z2*z3.| = |.z1.|*|.z2.|*|.z3.|;

theorem 
  |.z1+z2+z3.| <= |.z1.| + |.z2.|+|.z3.|;

theorem 
  |.z1+z2-z3.| <= |.z1.| + |.z2.| + |.z3.|;

theorem 
  |.z1-z2-z3.| <= |.z1.| + |.z2.| + |.z3.|;

theorem 
  |.z1.| - |.z2.| <= (|.z1 + z2.|+|.z1-z2.|)/2;

theorem 
  |.z1.| - |.z2.| <= (|.z1 + z2.|+|.z2-z1.|)/2;

theorem 
  |.|.z1.| - |.z2.|.| <= |.z2 - z1.|;

theorem 
  |.|.z1.| - |.z2.|.| <= |.z1.| + |.z2.|;

theorem 
  |.z1.| - |.z2.| <= |.z1 - z.| + |.z - z2.|;

theorem 
  |.z1.|-|.z2.|<>0 implies |.z1.|^2+|.z2.|^2 -2*|.z1.|*|.z2.| >0;

theorem 
  |.z1.| + |.z2.| >= (|.z1 + z2.|+|.z2 - z1.|)/2;

theorem 
  |.z1.| + |.z2.| >= (|.z1 + z2.|+|.z1 - z2.|)/2;

theorem 
  (z1*z2)" = z2" * z1";

theorem 
  (z*')" = (z")*';

theorem 
  1q" = 1q;

theorem 
  |.z1.|=|.z2.| & |.z1.| <>0 & z1"=z2" implies z1=z2;

theorem 
  (z1-z2)*(z3+z4)=z1*z3-z2*z3+z1*z4-z2*z4;

theorem 
  (z1+z2)*(z3+z4)=z1*z3+z2*z3+z1*z4+z2*z4;

theorem 
  -(z1+z2)=-z1-z2;

theorem 
  -(z1-z2)=-z1+z2;

theorem 
  z-(z1+z2)=z-z1-z2;

theorem 
  z-(z1-z2)=z-z1+z2;

theorem 
  (z1+z2)*(z3-z4)=z1*z3+z2*z3-z1*z4-z2*z4;

theorem 
  (z1-z2)*(z3-z4)=z1*z3-z2*z3-z1*z4+z2*z4;

theorem 
  -(z1+z2+z3)=-z1-z2-z3;

theorem 
  -(z1-z2-z3)=-z1+z2+z3;

theorem 
  -(z1-z2+z3)=-z1+z2-z3;

theorem 
  -(z1+z2-z3)=-z1-z2+z3;

theorem 
  z1+z=z2+z implies z1=z2;

theorem 
  z1-z=z2-z implies z1=z2;

theorem 
  (z1+z2-z3)*z4=z1*z4+z2*z4-z3*z4;

theorem 
  (z1-z2+z3)*z4=z1*z4-z2*z4+z3*z4;

theorem 
  (z1-z2-z3)*z4=z1*z4-z2*z4-z3*z4;

theorem 
  (z1+z2+z3)*z4=z1*z4+z2*z4+z3*z4;

theorem 
  (z1-z2)*z3=(z2-z1)*(-z3);

theorem 
  z3*(z1-z2)=(-z3)*(z2-z1);

theorem 
  z1-z2-z3+z4 = z4-z3-z2+z1;

theorem 
  (z1-z2)*(z3-z4)=(z2-z1)*(z4-z3);

theorem 
  z-z1-z2=z-z2-z1;

theorem 
  z"=[*Rea z/|.z.|^2,-Im1 z/|.z.|^2, -Im2 z/|.z.|^2,-Im3 z/|.z.|^2*];

theorem 
  z1/z2=[*(Rea z2*Rea z1+Im1 z1*Im1 z2+Im2 z2*Im2 z1+Im3 z2*Im3 z1)/(|.
z2.|^2), (Rea z2*Im1 z1-Im1 z2*Rea z1-Im2 z2*Im3 z1+Im3 z2*Im2 z1)/(|.z2.|^2),
(Rea z2*Im2 z1+Im1 z2*Im3 z1-Im2 z2*Rea z1-Im3 z2*Im1 z1)/(|.z2.|^2), (Rea z2*
  Im3 z1-Im1 z2*Im2 z1+Im2 z2*Im1 z1-Im3 z2*Rea z1)/(|.z2.|^2)*];

theorem 
  <i>"=-<i>;

theorem 
  <j>"=-<j>;

theorem 
  <k>"=-<k>;

definition
  let z be quaternion number;
  func z^2 equals

  z * z;
end;

registration
  let z be quaternion number;
  cluster z^2 -> quaternion;
end;

definition
  let z be Element of QUATERNION;
  redefine func z^2 -> Element of QUATERNION;
end;

theorem 
  z^2 = [*(Rea z)^2-(Im1 z)^2-(Im2 z)^2-(Im3 z)^2, 2*(Rea z * Im1 z)
  , 2*(Rea z * Im2 z), 2*(Rea z * Im3 z)*];

theorem 
  0q^2 = 0;

theorem 
  1q^2 = 1;

theorem 
  z^2 = (-z)^2;

definition
  let z be quaternion number;
  func z^3 equals

  z*z*z;
end;

registration
  let z be quaternion number;
  cluster z^3 -> quaternion;
end;

definition
  let z be Element of QUATERNION;
  redefine func z^3 -> Element of QUATERNION;
end;

theorem 
  0q^3 = 0;

theorem 
  1q^3=1;

theorem 
  <i>^3=-<i>;

theorem 
  <j>^3=-<j>;

theorem 
  <k>^3=-<k>;

theorem 
  (-1q)^2=1;

theorem 
  (-1q)^3=-1;

theorem 
  z^3=-(-z)^3;















begin 

definition
  let A be non empty set, B be set;
  let Bo be set, yo be Function of Bo,A;
  assume
 Bo c= B;
  func cylinder0(A,B,Bo,yo) -> non empty Subset of Funcs(B,A) equals


  { y where y is Function of B,A : y|Bo = yo };
end;

definition
  let A be non empty set, B be set;
  mode thin_cylinder of A,B -> non empty Subset of Funcs(B,A) means


    ex
Bo being Subset of B,yo being Function of Bo,A st Bo is finite & it = cylinder0
    (A,B,Bo,yo);
end;

theorem 
  for A be non empty set, B be set, D be thin_cylinder of A,B holds
  ex Bo being Subset of B,yo being Function of Bo,A st Bo is finite & D = { y
  where y is Function of B,A : y|Bo = yo };

theorem 
  for A1,A2 be non empty set, B be set, D1 be thin_cylinder of A1,B st
  A1 c= A2 ex D2 be thin_cylinder of A2,B st D1 c= D2;

definition
  let A be non empty set, B be set;
  func thin_cylinders(A,B) -> non empty Subset-Family of Funcs(B,A) equals

  {D
  where D is Subset of Funcs(B,A) : D is thin_cylinder of A,B};
end;

theorem 
  for A be non trivial set, B be set, Bo1 be set, yo1 being
Function of Bo1,A, Bo2 be set, yo2 being Function of Bo2,A st Bo1 c= B & Bo2 c=
  B & cylinder0(A,B,Bo1,yo1) = cylinder0(A,B,Bo2,yo2) holds Bo1=Bo2 & yo1=yo2;

theorem 
  for A1,A2 be non empty set, B1,B2 be set st A1 c= A2 & B1 c= B2
  ex F be Function of thin_cylinders(A1,B1), thin_cylinders(A2,B2) st for x be
set st x in thin_cylinders(A1,B1) ex Bo being Subset of B1, yo1 being Function
of Bo,A1, yo2 being Function of Bo,A2 st Bo is finite & yo1=yo2 & x=cylinder0(
  A1,B1,Bo,yo1) & F.x=cylinder0(A2,B2,Bo,yo2);

theorem 
  for A1,A2 be non empty set, B1,B2 be set ex G be Function of
  thin_cylinders(A2,B2), thin_cylinders(A1,B1) st for x be set st x in
  thin_cylinders(A2,B2) ex Bo2 being Subset of B2,Bo1 being Subset of B1, yo1
  being Function of Bo1,A1, yo2 being Function of Bo2,A2 st Bo1 is finite & Bo2
is finite & Bo1=B1 /\ Bo2 /\ (yo2"A1) & yo1=yo2 | Bo1 & x= cylinder0(A2,B2,Bo2,
  yo2) & G.x =cylinder0(A1,B1,Bo1,yo1);

definition
  let A1,A2 be non trivial set, B1,B2 be set;
  assume that
 A1 c= A2 and
 B1 c= B2;
  func Extcylinders(A1,B1,A2,B2) -> Function of thin_cylinders(A1,B1),
  thin_cylinders(A2,B2) means

  for x be set st x in thin_cylinders(A1,B1) ex Bo
being Subset of B1, yo1 being Function of Bo,A1, yo2 being Function of Bo,A2 st
  Bo is finite & yo1=yo2 & x=cylinder0(A1,B1,Bo,yo1) & it.x=cylinder0(A2,B2,Bo,
  yo2);
end;

definition
  let A1 be non empty set, A2 be non trivial set, B1,B2 be set;
  func Ristcylinders(A1,B1,A2,B2) -> Function of thin_cylinders(A2,B2),
  thin_cylinders(A1,B1) means

  for x be set st x in thin_cylinders(A2,B2) ex Bo2
  being Subset of B2,Bo1 being Subset of B1, yo1 being Function of Bo1,A1, yo2
being Function of Bo2,A2 st Bo1 is finite & Bo2 is finite & Bo1=B1 /\ Bo2 /\ (
yo2"A1) & yo1=yo2 | Bo1 & x = cylinder0(A2,B2,Bo2,yo2) & it.x =cylinder0(A1,B1,
  Bo1,yo1);
end;

definition
  let A be non trivial set,B be set;
  let D be thin_cylinder of A,B;
  func loc(D) -> finite Subset of B means

  ex Bo being Subset of B,yo being
Function of Bo,A st Bo is finite & D = { y where y is Function of B,A : y|Bo =
  yo } & it = Bo;
end;

begin 

definition
  let A1,A2 be non trivial set, B1,B2 be set;
  let C1,C2 be non trivial set, D1,D2 be set;
  let F be Function of thin_cylinders(A1,B1), thin_cylinders(C1,D1);
  func CylinderFunc(A1,B1,A2,B2,C1,D1,C2,D2,F) -> Function of thin_cylinders(
  A2,B2), thin_cylinders(C2,D2) equals

  Extcylinders(C1,D1,C2,D2)*F*Ristcylinders(
  A1,B1,A2,B2);
end;

definition
  struct (PT_net_Str) Colored_PT_net_Str (# carrier, carrier' ->
set, S-T_Arcs ->  Relation of the carrier,the carrier', T-S_Arcs ->
     Relation of the carrier', the carrier, ColoredSet -> non empty
    finite set, firing-rule -> Function #);
end;

definition
 func TrivialColoredPetriNet -> Colored_PT_net_Str equals

  Colored_PT_net_Str (# {{}}, {{}}, [#]({{}},{{}}), [#]({{}},
       {{}}), {{}}, {} #);
end;

registration
 cluster TrivialColoredPetriNet
  -> with_S-T_arc with_T-S_arc non empty non void;
end;

registration
 cluster non empty non void with_S-T_arc with_T-S_arc for Colored_PT_net_Str;
end;

definition
 mode Colored_Petri_net
  is non empty non void with_S-T_arc with_T-S_arc Colored_PT_net_Str;
end;

definition
  let CPNT be Colored_Petri_net;
  let t0 be transition of CPNT;
  attr t0 is outbound means


  {t0}*' = {};
end;

definition
  let CPNT1 be Colored_Petri_net;
  func Outbds(CPNT1) -> Subset of the carrier' of CPNT1 equals

  {x where x
  is transition of CPNT1 : x is outbound };
end;

definition
  let CPNT be Colored_Petri_net;
  attr CPNT is Colored-PT-net-like means


  dom (the firing-rule of CPNT)
c= (the carrier' of CPNT) \ Outbds(CPNT) & for t being transition of CPNT st
  t in dom (the firing-rule of CPNT) holds ex CS be non empty Subset of the
  ColoredSet of CPNT, I be Subset of *'{t}, O be Subset of {t}*' st (the
firing-rule of CPNT ).t is Function of thin_cylinders(CS,I), thin_cylinders(CS,
  O);
end;

theorem 
  for CPNT be Colored_Petri_net, t being transition of CPNT st CPNT is
  Colored-PT-net-like & t in dom (the firing-rule of CPNT) holds ex CS be non
empty Subset of the ColoredSet of CPNT, I be Subset of *'{t}, O be Subset of {t
  }*' st (the firing-rule of CPNT ).t is Function of thin_cylinders(CS,I),
  thin_cylinders(CS,O);

theorem 
  for CPNT1,CPNT2 be Colored_Petri_net, t1 be transition of CPNT1,
  t2 be transition of CPNT2 st the carrier of CPNT1 c= the carrier of CPNT2
   & the
  S-T_Arcs of CPNT1 c= the S-T_Arcs of CPNT2 & the T-S_Arcs of CPNT1 c= the
  T-S_Arcs of CPNT2 & t1=t2 holds *'{t1} c= *'{t2} & {t1}*' c= {t2}*';

registration
  cluster strict Colored-PT-net-like for Colored_Petri_net;
end;

definition
  mode Colored-PT-net is Colored-PT-net-like Colored_Petri_net;
end;

begin 

definition
  let CPNT1, CPNT2 be Colored_Petri_net;
  pred CPNT1 misses CPNT2 means


  (the carrier of CPNT1) /\ (the carrier
of CPNT2 ) = {} & (the carrier' of CPNT1) /\ (the carrier' of CPNT2) = {}
  ;
  symmetry;
end;

begin 

definition
  let CPNT1 be Colored_Petri_net;
  let CPNT2 be Colored_Petri_net;
  mode connecting-mapping of CPNT1,CPNT2 means


    ex O12 be Function of
    Outbds(CPNT1), the carrier of CPNT2, O21 be Function of Outbds(CPNT2), the
    carrier of CPNT1 st it=[O12,O21];
end;

begin 

definition
  let CPNT1, CPNT2 be Colored-PT-net;
  let O be connecting-mapping of CPNT1,CPNT2;
  mode connecting-firing-rule of CPNT1,CPNT2,O means


    ex q12,q21 be
    Function, O12 be Function of Outbds(CPNT1), the carrier of CPNT2, O21 be
Function of Outbds(CPNT2), the carrier of CPNT1 st O=[O12,O21] &
 dom q12=Outbds(
    CPNT1) & dom q21=Outbds(CPNT2) & ( for t01 be transition of CPNT1 st t01 is
outbound holds q12.t01 is Function of thin_cylinders ( the ColoredSet of CPNT1,
*'{t01}), thin_cylinders ( the ColoredSet of CPNT1, Im(O12,t01) ) ) & ( for t02
    be transition of CPNT2 st t02 is outbound holds q21.t02 is Function of
    thin_cylinders (the ColoredSet of CPNT2, *'{t02}), thin_cylinders (the
    ColoredSet of CPNT2, Im(O21,t02) ) ) & it=[q12,q21];
end;

begin 

definition
  let CPNT1, CPNT2 be Colored-PT-net;
  let O be connecting-mapping of CPNT1,CPNT2;
  let q be connecting-firing-rule of CPNT1,CPNT2,O;
  assume
 CPNT1 misses CPNT2;
  func synthesis(CPNT1, CPNT2,O,q) -> strict Colored-PT-net means

  ex q12,q21
  be Function, O12 be Function of Outbds(CPNT1), the carrier of CPNT2, O21 be
Function of Outbds(CPNT2), the carrier of CPNT1 st O=[O12,O21] &
 dom q12=Outbds(
  CPNT1) & dom q21=Outbds(CPNT2) & ( for t01 be transition of CPNT1 st t01 is
outbound holds q12.t01 is Function of thin_cylinders ( the ColoredSet of CPNT1,
*'{t01}), thin_cylinders ( the ColoredSet of CPNT1, Im(O12,t01) ) ) & ( for t02
  be transition of CPNT2 st t02 is outbound holds q21.t02 is Function of
  thin_cylinders ( the ColoredSet of CPNT2, *'{t02}), thin_cylinders ( the
  ColoredSet of CPNT2, Im(O21,t02) ) ) & q=[q12,q21] & the carrier of it = (the
  carrier of CPNT1) \/ (the carrier of CPNT2) & the carrier' of it = (the
carrier' of CPNT1) \/ (the carrier' of CPNT2) & the S-T_Arcs of it = (the
  S-T_Arcs of CPNT1) \/ (the S-T_Arcs of CPNT2) & the T-S_Arcs of it = (the
T-S_Arcs of CPNT1) \/ (the T-S_Arcs of CPNT2) \/ O12 \/ O21 & the ColoredSet of
  it = (the ColoredSet of CPNT1) \/ (the ColoredSet of CPNT2) & the firing-rule
of it = (the firing-rule of CPNT1) +* (the firing-rule of CPNT2) +* q12 +* q21;
end;














begin 

reserve x,x0,x1,y,y0,y1,r,r1,s,p,p1 for Real;
reserve z,z0 for Element of REAL 2;
reserve n for Element of NAT;
reserve s1 for Real_Sequence;
reserve f,f1,f2 for PartFunc of REAL 2,REAL;
reserve R,R1 for RestFunc;
reserve L,L1 for LinearFunc;

registration
  cluster -> total for RestFunc;
end;

definition
  let i be Element of NAT;
  let n be non empty Element of NAT;
  let f be PartFunc of REAL n,REAL;
  func pdiff1(f,i) -> Function of REAL n, REAL means

  for z being Element of REAL n holds it.z = partdiff(f,z,i);
end;

definition
  let f be PartFunc of REAL 2,REAL;
  let z be Element of REAL 2;
  pred f is_hpartial_differentiable`11_in z means


  ex x0,y0 being Real
st z = <*x0,y0*> & ex N being Neighbourhood of x0 st N c= dom SVF1(1,pdiff1(f,1
),z) & ex L,R st for x st x in N holds SVF1(1,pdiff1(f,1),z).x - SVF1(1,pdiff1(
  f,1),z).x0 = L.(x-x0) + R.(x-x0);
  pred f is_hpartial_differentiable`12_in z means


  ex x0,y0 being Real
st z = <*x0,y0*> & ex N being Neighbourhood of y0 st N c= dom SVF1(2,pdiff1(f,1
),z) & ex L,R st for y st y in N holds SVF1(2,pdiff1(f,1),z).y - SVF1(2,pdiff1(
  f,1),z).y0 = L.(y-y0) + R.(y-y0);
  pred f is_hpartial_differentiable`21_in z means


  ex x0,y0 being Real
st z = <*x0,y0*> & ex N being Neighbourhood of x0 st N c= dom SVF1(1,pdiff1(f,2
),z) & ex L,R st for x st x in N holds SVF1(1,pdiff1(f,2),z).x - SVF1(1,pdiff1(
  f,2),z).x0 = L.(x-x0) + R.(x-x0);
  pred f is_hpartial_differentiable`22_in z means


  ex x0,y0 being Real
st z = <*x0,y0*> & ex N being Neighbourhood of y0 st N c= dom SVF1(2,pdiff1(f,2
),z) & ex L,R st for y st y in N holds SVF1(2,pdiff1(f,2),z).y - SVF1(2,pdiff1(
  f,2),z).y0 = L.(y-y0) + R.(y-y0);
end;

definition
  let f be PartFunc of REAL 2,REAL;
  let z be Element of REAL 2;
  assume
 f is_hpartial_differentiable`11_in z;
  func hpartdiff11(f,z) -> Real means


  ex x0,y0 being Real st z = <*x0,
y0*> & ex N being Neighbourhood of x0 st N c= dom SVF1(1,pdiff1(f,1),z) & ex L,
R st it = L.1 & for x st x in N holds SVF1(1,pdiff1(f,1),z).x - SVF1(1,pdiff1(f
  ,1),z).x0 = L.(x-x0) + R.(x-x0);
end;

definition
  let f be PartFunc of REAL 2,REAL;
  let z be Element of REAL 2;
  assume
 f is_hpartial_differentiable`12_in z;
  func hpartdiff12(f,z) -> Real means


  ex x0,y0 being Real st z = <*x0,
y0*> & ex N being Neighbourhood of y0 st N c= dom SVF1(2,pdiff1(f,1),z) & ex L,
R st it = L.1 & for y st y in N holds SVF1(2,pdiff1(f,1),z).y - SVF1(2,pdiff1(f
  ,1),z).y0 = L.(y-y0) + R.(y-y0);
end;

definition
  let f be PartFunc of REAL 2,REAL;
  let z be Element of REAL 2;
  assume
 f is_hpartial_differentiable`21_in z;
  func hpartdiff21(f,z) -> Real means


  ex x0,y0 being Real st z = <*x0,
y0*> & ex N being Neighbourhood of x0 st N c= dom SVF1(1,pdiff1(f,2),z) & ex L,
R st it = L.1 & for x st x in N holds SVF1(1,pdiff1(f,2),z).x - SVF1(1,pdiff1(f
  ,2),z).x0 = L.(x-x0) + R.(x-x0);
end;

definition
  let f be PartFunc of REAL 2,REAL;
  let z be Element of REAL 2;
  assume
 f is_hpartial_differentiable`22_in z;
  func hpartdiff22(f,z) -> Real means


  ex x0,y0 being Real st z = <*x0,
y0*> & ex N being Neighbourhood of y0 st N c= dom SVF1(2,pdiff1(f,2),z) & ex L,
R st it = L.1 & for y st y in N holds SVF1(2,pdiff1(f,2),z).y - SVF1(2,pdiff1(f
  ,2),z).y0 = L.(y-y0) + R.(y-y0);
end;

theorem 
  z = <*x0,y0*> & f is_hpartial_differentiable`11_in z implies SVF1(1,
  pdiff1(f,1),z) is_differentiable_in x0;

theorem 
  z = <*x0,y0*> & f is_hpartial_differentiable`12_in z implies SVF1(2,
  pdiff1(f,1),z) is_differentiable_in y0;

theorem 
  z = <*x0,y0*> & f is_hpartial_differentiable`21_in z implies SVF1(1,
  pdiff1(f,2),z) is_differentiable_in x0;

theorem 
  z = <*x0,y0*> & f is_hpartial_differentiable`22_in z implies SVF1(2,
  pdiff1(f,2),z) is_differentiable_in y0;

theorem 
  z = <*x0,y0*> & f is_hpartial_differentiable`11_in z implies
  hpartdiff11(f,z) = diff(SVF1(1,pdiff1(f,1),z),x0);

theorem 
  z = <*x0,y0*> & f is_hpartial_differentiable`12_in z implies
  hpartdiff12(f,z) = diff(SVF1(2,pdiff1(f,1),z),y0);

theorem 
  z = <*x0,y0*> & f is_hpartial_differentiable`21_in z implies
  hpartdiff21(f,z) = diff(SVF1(1,pdiff1(f,2),z),x0);

theorem 
  z = <*x0,y0*> & f is_hpartial_differentiable`22_in z implies
  hpartdiff22(f,z) = diff(SVF1(2,pdiff1(f,2),z),y0);

definition
  let f be PartFunc of REAL 2,REAL;
  let Z be set;
  pred f is_hpartial_differentiable`11_on Z means


  Z c= dom f & for z
  be Element of REAL 2 st z in Z holds f|Z is_hpartial_differentiable`11_in z;
  pred f is_hpartial_differentiable`12_on Z means


  Z c= dom f & for z
  be Element of REAL 2 st z in Z holds f|Z is_hpartial_differentiable`12_in z;
  pred f is_hpartial_differentiable`21_on Z means


  Z c= dom f & for z
  be Element of REAL 2 st z in Z holds f|Z is_hpartial_differentiable`21_in z;
  pred f is_hpartial_differentiable`22_on Z means


  Z c= dom f & for z
  be Element of REAL 2 st z in Z holds f|Z is_hpartial_differentiable`22_in z;
end;

definition
  let f be PartFunc of REAL 2,REAL;
  let Z be set;
  assume
 f is_hpartial_differentiable`11_on Z;
  func f`hpartial11|Z -> PartFunc of REAL 2,REAL means

  dom it = Z & for z be
  Element of REAL 2 st z in Z holds it.z = hpartdiff11(f,z);
end;

definition
  let f be PartFunc of REAL 2,REAL;
  let Z be set;
  assume
 f is_hpartial_differentiable`12_on Z;
  func f`hpartial12|Z -> PartFunc of REAL 2,REAL means

  dom it = Z & for z be
  Element of REAL 2 st z in Z holds it.z = hpartdiff12(f,z);
end;

definition
  let f be PartFunc of REAL 2,REAL;
  let Z be set;
  assume
 f is_hpartial_differentiable`21_on Z;
  func f`hpartial21|Z -> PartFunc of REAL 2,REAL means

  dom it = Z & for z be
  Element of REAL 2 st z in Z holds it.z = hpartdiff21(f,z);
end;

definition
  let f be PartFunc of REAL 2,REAL;
  let Z be set;
  assume
 f is_hpartial_differentiable`22_on Z;
  func f`hpartial22|Z -> PartFunc of REAL 2,REAL means

  dom it = Z & for z be
  Element of REAL 2 st z in Z holds it.z = hpartdiff22(f,z);
end;

begin 

theorem 
  f is_hpartial_differentiable`11_in z iff pdiff1(f,1)
  is_partial_differentiable_in z,1;

theorem 
  f is_hpartial_differentiable`12_in z iff pdiff1(f,1)
  is_partial_differentiable_in z,2;

theorem 
  f is_hpartial_differentiable`21_in z iff pdiff1(f,2)
  is_partial_differentiable_in z,1;

theorem 
  f is_hpartial_differentiable`22_in z iff pdiff1(f,2)
  is_partial_differentiable_in z,2;

theorem 
  f is_hpartial_differentiable`11_in z implies hpartdiff11(f,z) =
  partdiff(pdiff1(f,1),z,1);

theorem 
  f is_hpartial_differentiable`12_in z implies hpartdiff12(f,z) =
  partdiff(pdiff1(f,1),z,2);

theorem 
  f is_hpartial_differentiable`21_in z implies hpartdiff21(f,z) =
  partdiff(pdiff1(f,2),z,1);

theorem 
  f is_hpartial_differentiable`22_in z implies hpartdiff22(f,z) =
  partdiff(pdiff1(f,2),z,2);

theorem 
  for z0 being Element of REAL 2 for N being Neighbourhood of proj(1,2).
  z0 st f is_hpartial_differentiable`11_in z0 & N c= dom SVF1(1,pdiff1(f,1),z0)
  holds for h be 0-convergent non-zero Real_Sequence,
  c be constant Real_Sequence st
rng c = {proj(1,2).z0} & rng (h+c) c= N holds h"(#)(SVF1(1,pdiff1(f,1),z0)/*(h+
c) - SVF1(1,pdiff1(f,1),z0)/*c) is convergent & hpartdiff11(f,z0) = lim (h"(#)(
  SVF1(1,pdiff1(f,1),z0)/*(h+c) - SVF1(1,pdiff1(f,1),z0)/*c));

theorem 
  for z0 being Element of REAL 2 for N being Neighbourhood of proj(2,2).
  z0 st f is_hpartial_differentiable`12_in z0 & N c= dom SVF1(2,pdiff1(f,1),z0)
  holds for h be 0-convergent non-zero Real_Sequence,
  c be constant Real_Sequence st
rng c = {proj(2,2).z0} & rng (h+c) c= N holds h"(#)(SVF1(2,pdiff1(f,1),z0)/*(h+
c) - SVF1(2,pdiff1(f,1),z0)/*c) is convergent & hpartdiff12(f,z0) = lim (h"(#)(
  SVF1(2,pdiff1(f,1),z0)/*(h+c) - SVF1(2,pdiff1(f,1),z0)/*c));

theorem 
  for z0 being Element of REAL 2 for N being Neighbourhood of proj(1,2).
  z0 st f is_hpartial_differentiable`21_in z0 & N c= dom SVF1(1,pdiff1(f,2),z0)
  holds for h be 0-convergent non-zero Real_Sequence,
  c be constant Real_Sequence st
rng c = {proj(1,2).z0} & rng (h+c) c= N holds h"(#)(SVF1(1,pdiff1(f,2),z0)/*(h+
c) - SVF1(1,pdiff1(f,2),z0)/*c) is convergent & hpartdiff21(f,z0) = lim (h"(#)(
  SVF1(1,pdiff1(f,2),z0)/*(h+c) - SVF1(1,pdiff1(f,2),z0)/*c));

theorem 
  for z0 being Element of REAL 2 for N being Neighbourhood of proj(2,2).
  z0 st f is_hpartial_differentiable`22_in z0 & N c= dom SVF1(2,pdiff1(f,2),z0)
  holds for h be 0-convergent non-zero Real_Sequence,
  c be constant Real_Sequence st
rng c = {proj(2,2).z0} & rng (h+c) c= N holds h"(#)(SVF1(2,pdiff1(f,2),z0)/*(h+
c) - SVF1(2,pdiff1(f,2),z0)/*c) is convergent & hpartdiff22(f,z0) = lim (h"(#)(
  SVF1(2,pdiff1(f,2),z0)/*(h+c) - SVF1(2,pdiff1(f,2),z0)/*c));

theorem 
  f1 is_hpartial_differentiable`11_in z0 & f2
  is_hpartial_differentiable`11_in z0 implies pdiff1(f1,1)+pdiff1(f2,1)
is_partial_differentiable_in z0,1 & partdiff(pdiff1(f1,1)+pdiff1(f2,1),z0,1) =
  hpartdiff11(f1,z0) + hpartdiff11(f2,z0);

theorem 
  f1 is_hpartial_differentiable`12_in z0 & f2
  is_hpartial_differentiable`12_in z0 implies pdiff1(f1,1)+pdiff1(f2,1)
is_partial_differentiable_in z0,2 & partdiff(pdiff1(f1,1)+pdiff1(f2,1),z0,2) =
  hpartdiff12(f1,z0) + hpartdiff12(f2,z0);

theorem 
  f1 is_hpartial_differentiable`21_in z0 & f2
  is_hpartial_differentiable`21_in z0 implies pdiff1(f1,2)+pdiff1(f2,2)
is_partial_differentiable_in z0,1 & partdiff(pdiff1(f1,2)+pdiff1(f2,2),z0,1) =
  hpartdiff21(f1,z0) + hpartdiff21(f2,z0);

theorem 
  f1 is_hpartial_differentiable`22_in z0 & f2
  is_hpartial_differentiable`22_in z0 implies pdiff1(f1,2)+pdiff1(f2,2)
is_partial_differentiable_in z0,2 & partdiff(pdiff1(f1,2)+pdiff1(f2,2),z0,2) =
  hpartdiff22(f1,z0) + hpartdiff22(f2,z0);

theorem 
  f1 is_hpartial_differentiable`11_in z0 & f2
  is_hpartial_differentiable`11_in z0 implies pdiff1(f1,1)-pdiff1(f2,1)
is_partial_differentiable_in z0,1 & partdiff(pdiff1(f1,1)-pdiff1(f2,1),z0,1) =
  hpartdiff11(f1,z0) - hpartdiff11(f2,z0);

theorem 
  f1 is_hpartial_differentiable`12_in z0 & f2
  is_hpartial_differentiable`12_in z0 implies pdiff1(f1,1)-pdiff1(f2,1)
is_partial_differentiable_in z0,2 & partdiff(pdiff1(f1,1)-pdiff1(f2,1),z0,2) =
  hpartdiff12(f1,z0) - hpartdiff12(f2,z0);

theorem 
  f1 is_hpartial_differentiable`21_in z0 & f2
  is_hpartial_differentiable`21_in z0 implies pdiff1(f1,2)-pdiff1(f2,2)
is_partial_differentiable_in z0,1 & partdiff(pdiff1(f1,2)-pdiff1(f2,2),z0,1) =
  hpartdiff21(f1,z0) - hpartdiff21(f2,z0);

theorem 
  f1 is_hpartial_differentiable`22_in z0 & f2
  is_hpartial_differentiable`22_in z0 implies pdiff1(f1,2)-pdiff1(f2,2)
is_partial_differentiable_in z0,2 & partdiff(pdiff1(f1,2)-pdiff1(f2,2),z0,2) =
  hpartdiff22(f1,z0) - hpartdiff22(f2,z0);

theorem 
  f is_hpartial_differentiable`11_in z0 implies r(#)pdiff1(f,1)
  is_partial_differentiable_in z0,1 & partdiff((r(#)pdiff1(f,1)),z0,1) = r*
  hpartdiff11(f,z0);

theorem 
  f is_hpartial_differentiable`12_in z0 implies r(#)pdiff1(f,1)
  is_partial_differentiable_in z0,2 & partdiff((r(#)pdiff1(f,1)),z0,2) = r*
  hpartdiff12(f,z0);

theorem 
  f is_hpartial_differentiable`21_in z0 implies r(#)pdiff1(f,2)
  is_partial_differentiable_in z0,1 & partdiff((r(#)pdiff1(f,2)),z0,1) = r*
  hpartdiff21(f,z0);

theorem 
  f is_hpartial_differentiable`22_in z0 implies r(#)pdiff1(f,2)
  is_partial_differentiable_in z0,2 & partdiff((r(#)pdiff1(f,2)),z0,2) = r*
  hpartdiff22(f,z0);

theorem 
  f1 is_hpartial_differentiable`11_in z0 & f2
  is_hpartial_differentiable`11_in z0 implies pdiff1(f1,1)(#)pdiff1(f2,1)
  is_partial_differentiable_in z0,1;

theorem 
  f1 is_hpartial_differentiable`12_in z0 & f2
  is_hpartial_differentiable`12_in z0 implies pdiff1(f1,1)(#)pdiff1(f2,1)
  is_partial_differentiable_in z0,2;

theorem 
  f1 is_hpartial_differentiable`21_in z0 & f2
  is_hpartial_differentiable`21_in z0 implies pdiff1(f1,2)(#)pdiff1(f2,2)
  is_partial_differentiable_in z0,1;

theorem 
  f1 is_hpartial_differentiable`22_in z0 & f2
  is_hpartial_differentiable`22_in z0 implies pdiff1(f1,2)(#)pdiff1(f2,2)
  is_partial_differentiable_in z0,2;

theorem 
  for z0 being Element of REAL 2 holds f
  is_hpartial_differentiable`11_in z0 implies SVF1(1,pdiff1(f,1),z0)
  is_continuous_in proj(1,2).z0;

theorem 
  for z0 being Element of REAL 2 holds f
  is_hpartial_differentiable`12_in z0 implies SVF1(2,pdiff1(f,1),z0)
  is_continuous_in proj(2,2).z0;

theorem 
  for z0 being Element of REAL 2 holds f
  is_hpartial_differentiable`21_in z0 implies SVF1(1,pdiff1(f,2),z0)
  is_continuous_in proj(1,2).z0;

theorem 
  for z0 being Element of REAL 2 holds f
  is_hpartial_differentiable`22_in z0 implies SVF1(2,pdiff1(f,2),z0)
  is_continuous_in proj(2,2).z0;














begin 

reserve X for non empty set,
  Y for set,
  S for SigmaField of X,
  M for sigma_Measure of S,
  f,g for PartFunc of X,COMPLEX,
  r for Real,
  k for real number,
  n for Nat,
  E for Element of S;

definition
  let X be non empty set;
  let f be Functional_Sequence of X,REAL;
  func R_EAL f -> Functional_Sequence of X,ExtREAL equals

  f;
end;

theorem 
  for X be non empty set, f be Functional_Sequence of X,REAL, x be
  Element of X holds f#x = (R_EAL f)#x;

registration
  let X be non empty set, f be Function of X,REAL;
  cluster R_EAL f -> total;
end;

definition
  let X be non empty set, f be Functional_Sequence of X,REAL;
  func inf f -> PartFunc of X,ExtREAL equals

  inf R_EAL f;
end;

theorem 
  for X being non empty set, f being Functional_Sequence of X,REAL
holds for x be Element of X st x in dom inf f holds (inf f).x = inf rng R_EAL(f
  #x);

definition
  let X be non empty set, f be Functional_Sequence of X,REAL;
  func sup f -> PartFunc of X,ExtREAL equals

  sup R_EAL f;
end;

theorem 
  for X being non empty set, f being Functional_Sequence of X,REAL
holds for x be Element of X st x in dom sup f holds (sup f).x = sup rng R_EAL(f
  #x);

definition
  let X be non empty set, f be Functional_Sequence of X,REAL;
  func inferior_realsequence f -> with_the_same_dom Functional_Sequence of X,
  ExtREAL equals

  inferior_realsequence R_EAL f;
end;

theorem 
  for X be non empty set, f being Functional_Sequence of X,REAL, n
being Nat holds dom((inferior_realsequence f).n) = dom(f.0) & for x
  be Element of X st x in dom((inferior_realsequence f).n) holds ((
  inferior_realsequence f).n).x=(inferior_realsequence R_EAL(f#x)).n;

definition
  let X be non empty set, f be Functional_Sequence of X,REAL;
  func superior_realsequence f -> with_the_same_dom Functional_Sequence of X,
  ExtREAL equals

  superior_realsequence R_EAL f;
end;

theorem 
  for X be non empty set, f being Functional_Sequence of X,REAL, n
being Nat holds dom((superior_realsequence f).n) = dom(f.0) & for x
  be Element of X st x in dom((superior_realsequence f).n) holds ((
  superior_realsequence f).n).x=(superior_realsequence R_EAL(f#x)).n;

theorem 
  for f be Functional_Sequence of X,REAL, x be Element of X st x in dom(
  f.0) holds (inferior_realsequence f)#x = inferior_realsequence R_EAL(f#x);

registration
  let X be non empty set, f be with_the_same_dom Functional_Sequence of X,REAL;
  cluster R_EAL f -> with_the_same_dom;
end;

theorem 
  for X be non empty set, f be with_the_same_dom
Functional_Sequence of X,REAL for S be SigmaField of X, E be Element of S, n be
  Nat st f.n is_measurable_on E holds (R_EAL f).n is_measurable_on E;

theorem 
  for X be non empty set, f being Functional_Sequence of X,REAL, n
  being Nat holds (R_EAL f)^\n = R_EAL(f^\n);

theorem 
  for f be with_the_same_dom Functional_Sequence of X,REAL, n be Nat
  holds (inferior_realsequence f).n = inf(f^\n);

theorem 
  for f be with_the_same_dom Functional_Sequence of X,REAL, n be Nat
  holds (superior_realsequence f).n = sup(f^\n);

theorem 
  for f be Functional_Sequence of X,REAL, x be Element of X st x
in dom(f.0) holds (superior_realsequence f)#x = superior_realsequence R_EAL(f#x
  );

definition
  let X be non empty set, f be Functional_Sequence of X,REAL;
  func lim_inf f -> PartFunc of X,ExtREAL equals

  lim_inf R_EAL f;
end;

theorem 
  for X be non empty set, f be Functional_Sequence of X,REAL holds
for x be Element of X st x in dom lim_inf f holds (lim_inf f).x = lim_inf R_EAL
  (f#x);

definition
  let X be non empty set, f be Functional_Sequence of X,REAL;
  func lim_sup f -> PartFunc of X,ExtREAL equals

  lim_sup R_EAL f;
end;

theorem 
  for X be non empty set, f be Functional_Sequence of X,REAL holds
for x be Element of X st x in dom lim_sup f holds (lim_sup f).x = lim_sup R_EAL
  (f#x);

definition
  let X be non empty set, f be Functional_Sequence of X,REAL;
  func lim f -> PartFunc of X,ExtREAL equals

  lim R_EAL f;
end;

theorem 
  for X be non empty set, f be Functional_Sequence of X,REAL holds
  for x be Element of X st x in dom lim f holds (lim f).x=lim R_EAL(f#x);

theorem 
  for f be Functional_Sequence of X,REAL, x be Element of X st x
in dom lim f & f#x is convergent holds (lim f).x= (lim_sup f).x & (lim f).x = (
  lim_inf f).x;

theorem 
  for f be with_the_same_dom Functional_Sequence of X,REAL, F be
SetSequence of S, r be real number st (for n be Nat holds F.n = dom(
  f.0) /\ great_dom(f.n,r)) holds union rng F = dom(f.0) /\ great_dom(sup f,r);

theorem 
  for f be with_the_same_dom Functional_Sequence of X,REAL, F be
SetSequence of S, r be real number st (for n be Nat holds F.n = dom(
f.0) /\ great_eq_dom(f.n,r)) holds meet rng F = dom(f.0) /\ great_eq_dom(inf f,
  r);

theorem 
  for f be with_the_same_dom Functional_Sequence of X,REAL, E be
  Element of S st dom (f.0) = E & (for n be Nat holds f.n
  is_measurable_on E) holds lim_sup f is_measurable_on E;

theorem 
  for f be with_the_same_dom Functional_Sequence of X,REAL, E be Element
  of S st dom(f.0) = E & (for n be Nat holds f.n is_measurable_on E)
  holds lim_inf f is_measurable_on E;

theorem 
  for f be Functional_Sequence of X,REAL, x be Element of X st x in dom
  (f.0) & f#x is convergent holds (superior_realsequence f)#x is bounded_below;

theorem 
  for f be with_the_same_dom Functional_Sequence of X,REAL, E be
  Element of S st dom(f.0) = E & (for n be Nat holds f.n
is_measurable_on E) & (for x be Element of X st x in E holds f#x is convergent)
  holds lim f is_measurable_on E;

theorem 
  for f be with_the_same_dom Functional_Sequence of X,REAL, g be
  PartFunc of X,ExtREAL, E be Element of S st dom(f.0) = E & (for n be Nat
  holds f.n is_measurable_on E) & dom g = E & for x be Element of X st x
  in E holds f#x is convergent & g.x = lim(f#x) holds g is_measurable_on E;

begin 

definition
  let X be non empty set, H be Functional_Sequence of X,COMPLEX, x be Element
  of X;
  func H#x -> Complex_Sequence means


  for n be Nat holds it.n = (H.n).x;
end;

definition
  let X be non empty set, f be Functional_Sequence of X,COMPLEX;
  func lim f -> PartFunc of X,COMPLEX means


  dom it = dom (f.0) & for x
  be Element of X st x in dom it holds it.x=lim(f#x);
end;

definition
  let X be non empty set;
  let f be Functional_Sequence of X,COMPLEX;
  func Re f -> Functional_Sequence of X,REAL means


  for n be Nat
  holds dom(it.n) = dom(f.n) & for x be Element of X st x in dom(it.n)
  holds (it.n).x = (Re(f#x)).n;
end;

registration
  let X be non empty set;
  let f be with_the_same_dom Functional_Sequence of X,COMPLEX;
  cluster Re f -> with_the_same_dom;
end;

definition
  let X be non empty set;
  let f be Functional_Sequence of X,COMPLEX;
  func Im f -> Functional_Sequence of X,REAL means


  for n be Nat holds
  dom(it.n) = dom(f.n) & for x be Element of X st x in dom(it.n)
  holds (it.n).x = (Im(f#x)).n;
end;

registration
  let X be non empty set;
  let f be with_the_same_dom Functional_Sequence of X,COMPLEX;
  cluster Im f -> with_the_same_dom;
end;

theorem 
  for f be with_the_same_dom Functional_Sequence of X,COMPLEX, x
be Element of X st x in dom (f.0) holds (Re f)#x = Re(f#x) & (Im f)#x = Im(f#x)
;

theorem 
  for f be Functional_Sequence of X,COMPLEX, n be Nat
  holds (Re f).n = Re(f.n) & (Im f).n = Im(f.n);

theorem 
  for f be with_the_same_dom Functional_Sequence of X,COMPLEX st (
for x be Element of X st x in dom(f.0) holds f#x is convergent) holds lim Re f
  = Re lim f & lim Im f = Im lim f;

theorem 
  for f be with_the_same_dom Functional_Sequence of X,COMPLEX, E be
  Element of S st dom(f.0) = E & (for n be Nat holds f.n
is_measurable_on E) & (for x be Element of X st x in E holds f#x is convergent)
  holds lim f is_measurable_on E;

theorem 
  for f be with_the_same_dom Functional_Sequence of X,COMPLEX, g be
  PartFunc of X,COMPLEX, E be Element of S st dom(f.0) = E & (for n be Nat
  holds f.n is_measurable_on E) & dom g = E & for x be Element of X st x
  in E holds f#x is convergent & g.x = lim(f#x) holds g is_measurable_on E;

begin 

theorem 
  (r(#)f)|Y = r(#)(f|Y);

theorem 
  0 <= k & E c= dom f & f is_measurable_on E implies |.f.| to_power k
  is_measurable_on E;

theorem 
  for f,g be PartFunc of X,REAL holds (R_EAL f)(#)(R_EAL g) = R_EAL(f(#)g);

theorem 
  for f,g be PartFunc of X,REAL st dom f /\ dom g = E & f
  is_measurable_on E & g is_measurable_on E holds f(#)g is_measurable_on E;

theorem 
  Re(f(#)g) = Re(f)(#)Re(g) - Im(f)(#)Im(g) & Im(f(#)g) = Im(f)(#)
  Re(g) + Re(f)(#)Im(g);

theorem 
  dom f /\ dom g = E & f is_measurable_on E & g is_measurable_on E
  implies f(#)g is_measurable_on E;

theorem 
  for f,g be PartFunc of X,REAL st (ex E be Element of S st E =
  dom f & E= dom g & f is_measurable_on E & g is_measurable_on E) & f is
nonnegative & g is nonnegative & (for x be Element of X st x in dom g holds g.x
  <= f.x) holds Integral(M,g) <= Integral(M,f);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
of S, f be PartFunc of X,COMPLEX st f is_integrable_on M holds (ex A be Element
  of S st A = dom f & f is_measurable_on A) & |.f.| is_integrable_on M;

theorem 
  f is_integrable_on M implies ex F be Function of NAT,S st (for n be
Nat holds F.n = dom f /\ great_eq_dom(|.f.|, R_EAL(1/(n+1)))) & dom f \ eq_dom(
  |.f.|,0) = union rng F & for n be Nat holds F.n in S & M.(F.n) <+infty;

reserve x,A for set;

theorem 
  (|.f.|)|A = |. f|A .|;

theorem 
  dom(|.f.|+|.g.|) = dom f /\ dom g & dom |.f+g.| c= dom |.f.|;

theorem 
  (|.f.|)|(dom |.f+g.|) + (|.g.|)|(dom |.f+g.|) = (|.f.|+|.g.|)|( dom |.f+g.|);

theorem 
  x in dom |.f+g.| implies (|.f+g.|).x <= (|.f.|+|.g.|).x;

theorem 
  for f,g be PartFunc of X,REAL st (for x be set st x in dom f
  holds f.x <= g.x) holds g-f is nonnegative;

theorem 
  f is_integrable_on M & g is_integrable_on M implies ex E be Element of
S st E = dom(f+g) & Integral(M,(|.f+g.|)|E) <= Integral(M,(|.f.|)|E) + Integral
  (M,(|.g.|)|E);

begin 

definition
  let X be non empty set;
  let S be SigmaField of X;
  let f be PartFunc of X,COMPLEX;
  pred f is_simple_func_in S means


  ex F being Finite_Sep_Sequence of S
st dom f = union rng F & for n being Nat,x,y being Element of X st n in dom F &
  x in F.n & y in F.n holds f.x = f.y;
end;

definition
  let X be non empty set;
  let S be SigmaField of X;
  let f be PartFunc of X,REAL;
  let F be Finite_Sep_Sequence of S;
  let a be FinSequence of REAL;
  pred F,a are_Re-presentation_of f means


  dom f = union rng F & dom F
  = dom a & for n be Nat st n in dom F for x be set st x in F.n holds f.x=a.n;
end;

definition
  let X,S,f;
  let F be Finite_Sep_Sequence of S;
  let a be FinSequence of COMPLEX;
  pred F,a are_Re-presentation_of f means


  dom f = union rng F & dom F
  = dom a & for n be Nat st n in dom F for x be set st x in F.n holds f.x=a.n;
end;

theorem 
  f is_simple_func_in S iff Re f is_simple_func_in S & Im f is_simple_func_in S
;

theorem 
  f is_simple_func_in S implies ex F be Finite_Sep_Sequence of S,
  a be FinSequence of COMPLEX st dom f = union rng F & dom F= dom a & for n be
  Nat st n in dom F for x be set st x in F.n holds f.x = a.n;

theorem 
  f is_simple_func_in S iff ex F be Finite_Sep_Sequence of S, a be
  FinSequence of COMPLEX st F,a are_Re-presentation_of f;

reserve c for FinSequence of COMPLEX;

theorem 
  for n be Nat st n in dom Re c holds (Re c).n = Re(c.n);

theorem 
  for n be Nat st n in dom Im c holds (Im c).n = Im(c.n);

theorem 
  for F be Finite_Sep_Sequence of S, a be FinSequence of COMPLEX
holds F,a are_Re-presentation_of f iff F,Re a are_Re-presentation_of Re f & F,
  Im a are_Re-presentation_of Im f;

theorem 
  f is_simple_func_in S iff ex F be Finite_Sep_Sequence of S, c be
  FinSequence of COMPLEX st dom f = union rng F & dom F = dom c & (for n be Nat
st n in dom F for x be set st x in F.n holds (Re f).x = Re c.n) & for n be Nat
  st n in dom F for x be set st x in F.n holds (Im f).x = Im c.n;














begin 

reserve k,n,m,l,p for Nat;
reserve n0,m0 for non zero Nat;

theorem 
  2|^(n+1) < 2|^(n+2) - 1;

theorem 
  n0 is even implies ex k,m st m is odd & k > 0 & n0 = 2|^k * m;

theorem 
  n=2|^k & m is odd implies n,m are_relative_prime;

theorem 
  {n} is finite Subset of NAT;

theorem 
  {n,m} is finite Subset of NAT;



reserve f for FinSequence;
reserve x,X,Y for set;

theorem 
  f is one-to-one implies Del(f,n) is one-to-one;

theorem 
  f is one-to-one & n in dom f implies not f.n in rng Del(f,n);

theorem 
  x in rng f & not x in rng Del(f,n) implies x = f.n;

theorem 
  for f1 being FinSequence of NAT, f2 being FinSequence of X st rng
  f1 c= dom f2 holds f2*f1 is FinSequence of X;

reserve f1,f2,f3 for FinSequence of REAL;

theorem 
  X \/ Y = dom f1 & X misses Y & f2 = f1*Sgm(X) & f3 = f1*Sgm(Y)
  implies Sum f1 = Sum f2 + Sum f3;

theorem 
  f2 = f1*Sgm(X) & dom f1 \ f1"{0} c= X & X c= dom f1 implies Sum f1 = Sum f2;

theorem 
  f2 = f1 - {0} implies Sum f1 = Sum f2;



theorem 
  for f being FinSequence of NAT holds f is FinSequence of REAL;



reserve n1,n2,m1,m2 for Nat;

theorem 
  n1 in NatDivisors n & m1 in NatDivisors m & n,m
  are_relative_prime implies n1,m1 are_relative_prime;

theorem 
  n1 in NatDivisors n & m1 in NatDivisors m & n2 in NatDivisors n
& m2 in NatDivisors m & n,m are_relative_prime & n1*m1=n2*m2 implies n1=n2 & m1
  =m2;

theorem 
  n1 in NatDivisors n0 & m1 in NatDivisors m0 implies n1*m1 in
  NatDivisors(n0*m0);

theorem 
  n0,m0 are_relative_prime implies k gcd n0*m0 = (k gcd n0)*(k gcd m0);

theorem 
  n0,m0 are_relative_prime & k in NatDivisors(n0*m0) implies ex n1
  ,m1 st n1 in NatDivisors n0 & m1 in NatDivisors m0 & k=n1*m1;

theorem 
  p is prime implies NatDivisors(p|^n) = {p|^k where k is Element
  of NAT : k <= n};

theorem 
  0 <> l & p > l & p > n1 & p > n2 & l*n1 mod p = l*n2 mod p & p
  is prime implies n1=n2;

theorem 
  p is prime implies p |-count(n0 gcd m0) = min(p |-count n0,p |-count
  m0);

begin 



theorem 
  n is prime iff (n-'1)! + 1 mod n = 0 & n>1;

begin 



theorem 
  p is prime & p mod 4 = 1 implies ex n,m st p = n^2 + m^2;

begin 

definition
  let I be set;
  let f be Function of I, NAT;
  let J be finite Subset of I;
  redefine func f|J -> bag of J;
end;

registration
  let I be set;
  let f be Function of I, NAT;
  let J be finite Subset of I;
  cluster Sum(f|J) -> natural for number;
end;

theorem 
  for f being Function of NAT, NAT, F being Function of NAT, REAL,
  J being finite Subset of NAT st f = F & (ex k st J c= Seg k) holds Sum(f|J) =
  Sum Func_Seq(F,Sgm J);

theorem 
  for I being non empty set, F being PartFunc of I, REAL, f being
Function of I, NAT, J being finite Subset of I st f = F holds Sum(f|J) = Sum(F,
  J);

reserve I,j for set;
reserve f,g for Function of I, NAT;
reserve J,K for finite Subset of I;

theorem 
  J misses K implies Sum(f|(J \/ K)) = Sum(f|J) + Sum(f|K);

theorem 
  J = {j} implies Sum(f|J) = f.j;

theorem 
  Sum((multnat*[:f,g:])|[:J,K:]) = Sum(f|J) * Sum(g|K);

definition
  let k be Nat;
  func EXP(k) -> Function of NAT, NAT means


  for n being Nat holds it.n = n|^k;
end;

definition
  let k,n be Nat;
  func sigma(k,n) -> Element of NAT means


  for m being non zero Nat
  st n = m holds it = Sum((EXP k)|NatDivisors m) if n<>0 otherwise it = 0;
end;

definition
  let k be Nat;
  func Sigma(k) -> Function of NAT, NAT means


  for n being Nat holds it.n = sigma(k,n);
end;

definition
  let n be Nat;
  func sigma n -> Element of NAT equals

  sigma(1,n);
end;

theorem 
  sigma(k,1) = 1;

theorem 
  p is prime implies sigma(p|^n) = (p|^(n+1) - 1)/(p - 1);

theorem 
  m divides n0 & n0<>m & m<>1 implies 1+m+n0 <= sigma n0;

theorem 
  m divides n0 & k divides n0 & n0<>m & n0<>k & m<>1 & k<>1 & m<>k
  implies 1+m+k+n0 <= sigma n0;

theorem 
  sigma n0 = n0 + m & m divides n0 & n0<>m implies m = 1 & n0 is prime;

definition
  let f be Function of NAT, NAT;
  attr f is multiplicative means


  for n0,m0 being non zero Nat
  st n0,m0 are_relative_prime holds f.(n0*m0) = f.n0 * f.m0;
end;

theorem 
  for f,F being Function of NAT, NAT st f is multiplicative & (for
  n0 holds F.n0 = Sum(f|NatDivisors n0)) holds F is multiplicative;

theorem 
  EXP(k) is multiplicative;

theorem 
  Sigma(k) is multiplicative;

theorem 
  n0,m0 are_relative_prime implies sigma(n0*m0) = sigma(n0) * sigma m0;

begin 

definition
  let n0 be non zero Nat;
  attr n0 is perfect means


  sigma n0 = 2 * n0;
end;




theorem 
  2|^p -' 1 is prime & n0 = 2|^(p -' 1)*(2|^p -' 1) implies n0 is perfect;




theorem 
  n0 is even & n0 is perfect implies ex p being Nat st 2|^p
  -' 1 is prime & n0 = 2|^(p -' 1)*(2|^p -' 1);

begin 

definition
  func Euler_phi -> Function of NAT, NAT means


  for k being Element of NAT holds it.k = Euler(k);
end;



theorem 
  Sum(Euler_phi|NatDivisors n0) = n0;














begin

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, f be PartFunc of X,ExtREAL, E be Element of S, a be Real st f
is_integrable_on M & E c= dom f & M.E < +infty & (for x be Element of X st x in
  E holds a <= f.x) holds (R_EAL a)*(M.E) <= Integral(M,f|E);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, f be PartFunc of X,REAL, E be Element of S, a be Real st f
is_integrable_on M & E c= dom f & M.E < +infty & (for x be Element of X st x in
  E holds a <= f.x) holds (R_EAL a)*M.E <= Integral(M,f|E);

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure
  of S, f be PartFunc of X,ExtREAL, E be Element of S, a be Real st f
is_integrable_on M & E c= dom f & M.E < +infty & (for x be Element of X st x in
  E holds f.x <= a) holds Integral(M,f|E) <= (R_EAL a)*M.E;

theorem 
  for X be non empty set, S be SigmaField of X, M be sigma_Measure of S,
f be PartFunc of X,REAL, E be Element of S, a be Real st f is_integrable_on M &
  E c= dom f & M.E < +infty & (for x be Element of X st x in E holds f.x <= a)
  holds Integral(M,f|E) <=(R_EAL a)*M.E;

begin 

reserve Omega for non empty set;

reserve r for Real;

reserve Sigma for SigmaField of Omega;

reserve P for Probability of Sigma;

reserve E for finite non empty set;

notation
  let E be non empty set;
  synonym Trivial-SigmaField (E) for bool E;
end;

definition
  let E be non empty set;
  redefine func Trivial-SigmaField (E) -> SigmaField of E;
end;

theorem 
  for Omega be non empty finite set, f be PartFunc of Omega,REAL holds
ex F be Finite_Sep_Sequence of Trivial-SigmaField (Omega), s being FinSequence
of (dom f) st dom f = union (rng F) & dom F = dom (s) & s is one-to-one & rng s
= dom f & len s = card (dom f) & (for k be Nat st k in dom F holds F.k={s.k} )
  & for n being Nat for x,y being Element of Omega st n in dom F & x in F.n & y
  in F.n holds f.x = f.y;

theorem 
  for Omega be non empty finite set, f be PartFunc of Omega,REAL
  holds f is_simple_func_in Trivial-SigmaField (Omega) & dom f is Element of
  Trivial-SigmaField (Omega);

theorem 
  for Omega be non empty finite set, M being sigma_Measure of
Trivial-SigmaField (Omega), f be PartFunc of Omega,REAL st dom f <> {} & M.(dom
  f) < +infty holds f is_integrable_on M;

theorem 
  for Omega be non empty finite set, f be PartFunc of Omega,REAL ex
X be Element of Trivial-SigmaField (Omega) st dom f = X & f is_measurable_on X;

theorem 
  for Omega be non empty finite set, M being sigma_Measure of
Trivial-SigmaField (Omega), f be Function of Omega,REAL, x being FinSequence of
ExtREAL, s being FinSequence of (Omega) st s is one-to-one & rng s = Omega ex F
  be Finite_Sep_Sequence of Trivial-SigmaField (Omega), a being FinSequence of
  REAL st dom f = union (rng F) & dom a = dom s & dom F = dom s & (for k be Nat
  st k in dom F holds F.k={s.k} ) & for n being Nat for x,y being Element of
  Omega st n in dom F & x in F.n & y in F.n holds f.x = f.y;

theorem 
  for Omega be non empty finite set, M being sigma_Measure of
Trivial-SigmaField (Omega), f be Function of Omega,REAL, x being FinSequence of
  ExtREAL, s being FinSequence of (Omega) st M.Omega < +infty & len x = card (
Omega) & s is one-to-one & rng s = Omega & len s = card (Omega) & (for n being
Nat st n in dom x holds x.n = R_EAL (f.(s.n)) * M.{s.n}) holds Integral(M,f) =
  Sum x;

theorem 
  for Omega be non empty finite set, M being sigma_Measure of
  Trivial-SigmaField (Omega), f be Function of Omega,REAL st M.Omega < +infty
holds ex x being FinSequence of ExtREAL, s being FinSequence of (Omega) st len
  x = card (Omega) & s is one-to-one & rng s = Omega & len s = card (Omega) & (
for n being Nat st n in dom x holds x.n = R_EAL (f.(s.n)) * M.{s.n}) & Integral
  (M,f) = Sum x;

theorem 
  for Omega be non empty finite set, P be Probability of
  Trivial-SigmaField (Omega), f be Function of Omega,REAL, x be FinSequence of
REAL, s be FinSequence of Omega st len x = card (Omega) & s is one-to-one & rng
s = Omega & len s = card (Omega) & (for n being Nat st n in dom x holds x.n = f
  .(s.n) * P.{s.n}) holds Integral(P2M(P),f) =Sum x;

theorem 
  for Omega be non empty finite set, P be Probability of
  Trivial-SigmaField (Omega), f be Function of Omega,REAL holds ex F being
  FinSequence of REAL, s being FinSequence of Omega st len F = card (Omega) & s
is one-to-one & rng s = Omega & len s = card (Omega) & (for n being Nat st n in
  dom F holds F.n = f.(s.n) * P.{s.n}) & Integral(P2M(P),f) = Sum F;

theorem 
  for E be finite non empty set, ASeq being SetSequence of E st
  ASeq is non-ascending holds ex N be Element of NAT st for m be Element of NAT
  st N<=m holds ASeq.N = ASeq.m;

theorem 
  for E be finite non empty set, ASeq being SetSequence of E st
  ASeq is non-ascending holds ex N be Element of NAT st for m be Element of NAT
  st N<=m holds Intersection ASeq = ASeq.m;

theorem 
  for E be finite non empty set, ASeq being SetSequence of E st
ASeq is non-descending holds ex N be Element of NAT st for m be Element of NAT
  st N <= m holds ASeq.N = ASeq.m;

theorem 
  for E be finite non empty set, ASeq being SetSequence of E st ASeq is
  non-descending holds ex N be Nat st for m be Nat st N<=m holds Union ASeq =
  ASeq.m;

definition
  let E;
  func Trivial-Probability (E) -> Probability of Trivial-SigmaField (E) means


  for A be Event of E holds it.A = prob(A);
end;



definition
  let Omega,Sigma;
  mode Real-Valued-Random-Variable of Sigma -> Function of Omega,REAL means


     ex X be Element of Sigma st X = Omega & it is_measurable_on X;
end;

reserve f,g for Real-Valued-Random-Variable of Sigma;

theorem 
  f+g is Real-Valued-Random-Variable of Sigma;

definition
  let Omega,Sigma,f,g;
  redefine func f+ g -> Real-Valued-Random-Variable of Sigma;
end;

theorem 
  f-g is Real-Valued-Random-Variable of Sigma;

definition
  let Omega,Sigma,f,g;
  redefine func f-g -> Real-Valued-Random-Variable of Sigma;
end;

theorem 
  for r be Real holds r(#)f is Real-Valued-Random-Variable of Sigma;

definition
  let Omega,Sigma,f;
  let r be Real;
  redefine func r(#)f -> Real-Valued-Random-Variable of Sigma;
end;

theorem 
  for f,g be PartFunc of Omega,REAL holds (R_EAL f)(#)(R_EAL g) = R_EAL (f(#)g)
;

theorem 
  f(#)g is Real-Valued-Random-Variable of Sigma;

definition
  let Omega,Sigma,f,g;
  redefine func f(#)g -> Real-Valued-Random-Variable of Sigma;
end;

theorem 
  for r be real number st 0 <= r & f is nonnegative holds (f
  to_power r) is Real-Valued-Random-Variable of Sigma;

theorem 
  abs f is Real-Valued-Random-Variable of Sigma;

definition
  let Omega,Sigma,f;
  redefine func abs f -> Real-Valued-Random-Variable of Sigma;
end;

theorem 
  for r be real number st 0 <= r holds (abs(f) to_power r) is
  Real-Valued-Random-Variable of Sigma;



definition
  let Omega,Sigma,f,P;
  pred f is_integrable_on P means


  f is_integrable_on P2M(P);
end;

definition
  let Omega,Sigma,P;
  let f be Real-Valued-Random-Variable of Sigma;
  assume
 f is_integrable_on P;
  func expect (f,P) -> Element of REAL equals


  Integral(P2M(P),f);
end;

theorem 
  f is_integrable_on P & g is_integrable_on P implies expect (f+g,
  P) = expect (f,P) + expect (g,P);

theorem 
  f is_integrable_on P implies expect (r(#)f,P) = r* expect (f,P);

theorem 
  f is_integrable_on P & g is_integrable_on P implies expect (f-g,P) =
  expect (f,P) - expect (g,P);

theorem 
  for Omega be non empty finite set, f be Function of Omega,REAL holds f
  is Real-Valued-Random-Variable of Trivial-SigmaField (Omega);

theorem 
  for Omega be non empty finite set, P be Probability of
  Trivial-SigmaField (Omega), X be Real-Valued-Random-Variable of
  Trivial-SigmaField (Omega) holds X is_integrable_on P;

theorem 
  for Omega be non empty finite set, P be Probability of
  Trivial-SigmaField (Omega), X be Real-Valued-Random-Variable of
Trivial-SigmaField (Omega), F being FinSequence of REAL, s being FinSequence of
Omega st len F = card (Omega) & s is one-to-one & rng s = Omega & len s = card
  (Omega) & (for n being Nat st n in dom F holds F.n = X.(s.n) * P.{s.n}) holds
  expect(X,P) = Sum F;

theorem 
  for Omega be non empty finite set, P be Probability of
  Trivial-SigmaField (Omega), X be Real-Valued-Random-Variable of
Trivial-SigmaField (Omega) ex F being FinSequence of REAL, s being FinSequence
  of Omega st len F = card (Omega) & s is one-to-one & rng s = Omega & len s =
card (Omega) & (for n being Nat st n in dom F holds F.n = X.(s.n) * P.{s.n}) &
  expect(X,P) = Sum F;

theorem 
  for Omega be non empty finite set, P be Probability of
  Trivial-SigmaField (Omega), X be Real-Valued-Random-Variable of
Trivial-SigmaField (Omega) ex F being FinSequence of REAL, s being FinSequence
  of Omega st len F = card (Omega) & s is one-to-one & rng s = Omega & len s =
card (Omega) & (for n being Nat st n in dom F holds F.n = X.(s.n) * P.{s.n}) &
  expect(X,P) = Sum F;

theorem 
  for Omega be non empty finite set, X be Real-Valued-Random-Variable of
Trivial-SigmaField (Omega), G being FinSequence of REAL, s being FinSequence of
Omega st len G = card (Omega) & s is one-to-one & rng s = Omega & len s = card
(Omega) & (for n being Nat st n in dom G holds G.n = X.(s.n) ) holds expect(X,
  Trivial-Probability (Omega)) = (Sum G) / card (Omega);

theorem 
  for Omega be non empty finite set, X be Real-Valued-Random-Variable of
  Trivial-SigmaField (Omega) holds ex G being FinSequence of REAL, s being
FinSequence of Omega st len G = card (Omega) & s is one-to-one & rng s = Omega
& len s = card (Omega) & (for n being Nat st n in dom G holds G.n = X.(s.n) ) &
  expect(X,Trivial-Probability (Omega)) = (Sum G) / card (Omega);



theorem 
  for X be Real-Valued-Random-Variable of Sigma st 0 < r & X is
nonnegative & X is_integrable_on P holds P.({t where t is Element of Omega : r
  <= X.t }) <= expect (X,P)/r;














begin 

reserve X for non empty set,
  S for SigmaField of X,
  M for sigma_Measure of S,
  E for Element of S,
  F for Functional_Sequence of X,REAL,

  f for PartFunc of X,REAL,
  seq for Real_Sequence,
  n,m for Nat,
  x for Element of X,
  z,D for set;

definition
  let X,Y be set, F be Functional_Sequence of X,Y;
  let D be set;
  func F||D -> Functional_Sequence of X,Y means


  for n being Nat holds it.n = (F.n)|D;
end;

theorem 
  x in D & F#x is convergent implies (F||D)#x is convergent;

theorem 
  for X,Y,D be set, F be Functional_Sequence of X,Y st F is
  with_the_same_dom holds F||D is with_the_same_dom;

theorem 
  D c= dom(F.0) & (for x be Element of X st x in D holds F#x is
  convergent) implies (lim F)|D = lim (F||D);

theorem 
  F is with_the_same_dom & E c= dom(F.0) & (for m be Nat holds F.m
  is_measurable_on E) implies (F||E).n is_measurable_on E;

reserve i for Element of NAT;

theorem 
  Partial_Sums R_EAL seq = R_EAL(Partial_Sums seq);

theorem 
  (for x be Element of X st x in E holds F#x is summable) implies
  for x be Element of X st x in E holds (F||E)#x is summable;

definition
  let X be non empty set, F be Functional_Sequence of X,REAL;
  func Partial_Sums F -> Functional_Sequence of X,REAL means


  it.0 = F.0 & for n be Nat holds it.(n+1) = it.n + F.(n+1);
end;

theorem 
  Partial_Sums R_EAL F = R_EAL(Partial_Sums F);

theorem 
  z in dom((Partial_Sums F).n) & m <= n implies z in dom((
  Partial_Sums F).m) & z in dom(F.m);

theorem 
  R_EAL F is additive;

theorem 
  dom((Partial_Sums F).n) = meet{dom(F.k) where k is Element of NAT : k <= n};

theorem 
  F is with_the_same_dom implies dom((Partial_Sums F).n) = dom(F.0 );

theorem 
  F is with_the_same_dom & D c= dom(F.0) & x in D implies (
  Partial_Sums(F#x)).n = ((Partial_Sums F)#x).n;

theorem 
  F is with_the_same_dom & D c= dom(F.0) & x in D implies (
  Partial_Sums(F#x) is convergent iff (Partial_Sums F)#x is convergent );

theorem 
  F is with_the_same_dom & dom f c= dom(F.0) & x in dom f & f.x =
  Sum(F#x) implies f.x = lim((Partial_Sums F)#x);

theorem 
  (for m be Nat holds F.m is_simple_func_in S) implies (
  Partial_Sums F).n is_simple_func_in S;

theorem 
  (for n be Nat holds F.n is_measurable_on E) implies (
  Partial_Sums F).m is_measurable_on E;

theorem 
  for X be non empty set, F be Functional_Sequence of X,REAL st F
  is with_the_same_dom holds Partial_Sums F is with_the_same_dom;

theorem 
  dom(F.0) = E & F is with_the_same_dom & (for n be Nat holds (
Partial_Sums F).n is_measurable_on E) & (for x be Element of X st x in E holds
  F#x is summable) implies lim(Partial_Sums F) is_measurable_on E;

theorem 
  (for n be Nat holds F.n is_integrable_on M) implies for m be Nat
  holds (Partial_Sums F).m is_integrable_on M;

begin 

reserve F for Functional_Sequence of X,COMPLEX,
  f for PartFunc of X,COMPLEX,
  A for set;

theorem 
  (Re f)|A = Re(f|A) & (Im f)|A = Im(f|A);

theorem 
  Re (F||D) = (Re F)||D;

theorem 
  Im (F||D) = (Im F)||D;

theorem 
  F is with_the_same_dom & D c= dom(F.0) & x in D implies (F#x is
  convergent implies (F||D)#x is convergent);

theorem 
  F is with_the_same_dom iff Re F is with_the_same_dom;

theorem 
  Re F is with_the_same_dom iff Im F is with_the_same_dom;

theorem 
  F is with_the_same_dom & D = dom(F.0) & (for x be Element of X st x in
  D holds F#x is convergent) implies (lim F)|D = lim (F||D);

theorem 
  F is with_the_same_dom & E c= dom(F.0) & (for m be Nat holds F.m
  is_measurable_on E) implies (F||E).n is_measurable_on E;

theorem 
  E c= dom(F.0) & F is with_the_same_dom & (for x be Element of X st x
in E holds F#x is summable) implies for x be Element of X st x in E holds (F||E
  )#x is summable;

definition
  let X be non empty set, F be Functional_Sequence of X,COMPLEX;
  func Partial_Sums F -> Functional_Sequence of X,COMPLEX means


  it.0 = F.0 & for n be Nat holds it.(n+1) = it.n + F.(n+1);
end;

theorem 
  Partial_Sums Re F = Re Partial_Sums F & Partial_Sums Im F = Im Partial_Sums F
;

theorem 
  z in dom((Partial_Sums F).n) & m <= n implies z in dom((Partial_Sums F
  ).m) & z in dom(F.m);

theorem 
  dom((Partial_Sums F).n) = meet{dom(F.k) where k is Element of NAT : k <= n};

theorem 
  F is with_the_same_dom implies dom((Partial_Sums F).n) = dom(F.0 );

theorem 
  F is with_the_same_dom & D c= dom(F.0) & x in D implies (Partial_Sums(
  F#x)).n = ((Partial_Sums F)#x).n;

theorem 
  F is with_the_same_dom implies Partial_Sums F is with_the_same_dom;

theorem 
  F is with_the_same_dom & D c= dom(F.0) & x in D implies (
  Partial_Sums(F#x) is convergent iff (Partial_Sums F)#x is convergent );

theorem 
  F is with_the_same_dom & dom f c= dom(F.0) & x in dom f & F#x is
  summable & f.x = Sum(F#x) implies f.x = lim((Partial_Sums F)#x);

theorem 
  (for m be Nat holds F.m is_simple_func_in S) implies (Partial_Sums F).
  n is_simple_func_in S;

theorem 
  (for n be Nat holds F.n is_measurable_on E) implies (Partial_Sums F).m
  is_measurable_on E;

theorem 
  dom(F.0) = E & F is with_the_same_dom & (for n be Nat holds (
Partial_Sums F).n is_measurable_on E) & (for x be Element of X st x in E holds
  F#x is summable) implies lim(Partial_Sums F) is_measurable_on E;

theorem 
  (for n be Nat holds F.n is_integrable_on M) implies for m be Nat holds
  (Partial_Sums F).m is_integrable_on M;

begin 

reserve f,g for PartFunc of X,COMPLEX,
  A for Element of S;

theorem 
  f is_simple_func_in S implies f is_measurable_on A;

theorem 
  f is_simple_func_in S implies f|A is_simple_func_in S;

theorem 
  f is_simple_func_in S implies dom f is Element of S;

theorem 
  f is_simple_func_in S & g is_simple_func_in S implies f+g is_simple_func_in S
;

theorem 
  for c be complex number st f is_simple_func_in S holds c(#)f
  is_simple_func_in S;

begin 

reserve F for with_the_same_dom Functional_Sequence of X,ExtREAL,
  P for PartFunc of X,ExtREAL;

theorem 
  E = dom(F.0) & E = dom P & (for n be Nat holds F.n
  is_measurable_on E) & P is_integrable_on M & (for x be Element of X, n be Nat
st x in E holds (|. F.n .|).x <= P.x) & (for x be Element of X st x in E holds
  F#x is convergent) implies lim F is_integrable_on M;

reserve F for with_the_same_dom Functional_Sequence of X,REAL,
  f,P for PartFunc of X,REAL;

theorem 
  E = dom(F.0) & E = dom P & (for n be Nat holds F.n
  is_measurable_on E) & P is_integrable_on M & (for x be Element of X, n be Nat
st x in E holds (|. F.n .|).x <= P.x) & (for x be Element of X st x in E holds
  F#x is convergent) implies lim F is_integrable_on M;



theorem 
  E = dom(F.0) & E = dom P & (for n be Nat holds F.n
  is_measurable_on E) & P is_integrable_on M & (for x be Element of X, n be Nat
  st x in E holds (|. F.n .|).x <= P.x) implies ex I be Real_Sequence st (for n
be Nat holds I.n = Integral(M,F.n)) & ( (for x be Element of X st x in E holds
  F#x is convergent) implies I is convergent & lim I = Integral(M,lim F) );

definition
  let X be set, F be Functional_Sequence of X,REAL;
  attr F is uniformly_bounded means


  ex K be real number st for n be Nat
  , x be Element of X st x in dom(F.0) holds |. (F.n).x .| <= K;
end;



theorem 
  M.E < +infty & E = dom(F.0) & (for n be Nat holds F.n
is_measurable_on E) & F is uniformly_bounded & (for x be Element of X st x in E
holds F#x is convergent) implies (for n be Nat holds F.n is_integrable_on M) &
lim F is_integrable_on M & ex I be ExtREAL_sequence st (for n be Nat holds I.n
  = Integral(M,F.n)) & I is convergent & lim I = Integral(M,lim F);

definition
  let X be set, F be Functional_Sequence of X,REAL, f be PartFunc of X,REAL;
  pred F is_uniformly_convergent_to f means


  F is with_the_same_dom &
  dom(F.0) = dom f & for e be real number st e>0 ex N be Nat st for n be Nat, x
  be Element of X st n >= N & x in dom(F.0) holds |. (F.n).x - f.x .| < e;
end;

theorem 
  M.E < +infty & E = dom(F.0) & (for n be Nat holds F.n
is_integrable_on M) & F is_uniformly_convergent_to f implies f is_integrable_on
M & ex I be ExtREAL_sequence st (for n be Nat holds I.n = Integral(M,F.n)) & I
  is convergent & lim I = Integral(M,f);

reserve F for with_the_same_dom Functional_Sequence of X,COMPLEX,
  f for PartFunc of X,COMPLEX;

theorem 
  E = dom(F.0) & E = dom P & (for n be Nat holds F.n
  is_measurable_on E) & P is_integrable_on M & (for x be Element of X, n be Nat
st x in E holds (|. F.n .|).x <= P.x) & (for x be Element of X st x in E holds
  F#x is convergent) implies lim F is_integrable_on M;



theorem 
  E = dom(F.0) & E = dom P & (for n be Nat holds F.n is_measurable_on E)
& P is_integrable_on M & (for x be Element of X, n be Nat st x in E holds (|. F
.n .|).x <= P.x) implies ex I be Complex_Sequence st (for n be Nat holds I.n =
Integral(M,F.n)) & ( (for x be Element of X st x in E holds F#x is convergent)
  implies I is convergent & lim I = Integral(M,lim F) );

definition
  let X be set, F be Functional_Sequence of X,COMPLEX;
  attr F is uniformly_bounded means


  ex K be real number st for n be Nat
  , x be Element of X st x in dom(F.0) holds |. (F.n).x .| <= K;
end;



theorem 
  M.E < +infty & E = dom(F.0) & (for n be Nat holds F.n is_measurable_on
  E) & F is uniformly_bounded & (for x be Element of X st x in E holds F#x is
  convergent) implies (for n be Nat holds F.n is_integrable_on M) & lim F
  is_integrable_on M & ex I be Complex_Sequence st (for n be Nat holds I.n =
  Integral(M,F.n)) & I is convergent & lim I = Integral(M,lim F);

definition
  let X be set, F be Functional_Sequence of X,COMPLEX, f be PartFunc of X,
  COMPLEX;
  pred F is_uniformly_convergent_to f means


  F is with_the_same_dom &
  dom(F.0) = dom f & for e be real number st e>0 ex N be Nat st for n be Nat, x
  be Element of X st n >= N & x in dom(F.0) holds |. (F.n).x - f.x .| < e;
end;

theorem 
  M.E < +infty & E = dom(F.0) & (for n be Nat holds F.n is_integrable_on
  M) & F is_uniformly_convergent_to f implies f is_integrable_on M & ex I be
  Complex_Sequence st (for n be Nat holds I.n = Integral(M,F.n)) & I is
  convergent & lim I = Integral(M,f);














begin 

reserve T, T1, T2 for TopSpace,
  A, B for Subset of T,
  F, G for Subset-Family of T,
  A1 for Subset of T1,
  A2 for Subset of T2,
  TM, TM1, TM2 for metrizable TopSpace,
  Am, Bm for Subset of TM,
  Fm, Gm for Subset-Family of TM,
  C for Cardinal,
  iC for infinite Cardinal;

definition
  let T1,T2,A1,A2;
  pred A1,A2 are_homeomorphic means


  T1|A1,T2|A2 are_homeomorphic;
end;

theorem 
  T1,T2 are_homeomorphic iff [#]T1,[#]T2 are_homeomorphic;

theorem 
  for f be Function of T1,T2 st f is being_homeomorphism for g be
  Function of T1|A1,T2|(f.:A1) st g = f|A1 holds g is being_homeomorphism;

theorem 
  for f be Function of T1,T2 st f is being_homeomorphism holds A1,f.:A1
  are_homeomorphic;

theorem 
  T1,T2 are_homeomorphic implies weight T1 = weight T2;

registration
  cluster empty -> metrizable for TopSpace;
  cluster metrizable -> T_4 for TopSpace;
  let M be MetrSpace;
  cluster TopSpaceMetr M -> metrizable;
end;

registration
  let TM,Am;
  cluster TM|Am -> metrizable;
end;

registration
  let TM1,TM2;
  cluster [:TM1,TM2:] -> metrizable;
end;

registration
  let T be empty TopSpace;
  cluster weight T -> empty;
end;

theorem 
  weight [:T1,T2:] c= weight T1 *` weight T2;

theorem 
  T1 is non empty & T2 is non empty implies weight T1 c= weight [:
  T1,T2:] & weight T2 c= weight[:T1,T2:];

registration
  let T1,T2 be second-countable TopSpace;
  cluster [:T1,T2:] -> second-countable;
end;

theorem 
  card (F|A) c= card F;

theorem 
  for Bas be Basis of T holds Bas|A is Basis of T|A;

registration
  let T be second-countable TopSpace;
  let A be Subset of T;
  cluster T|A -> second-countable;
end;

registration
  let M be non empty MetrSpace;
  let A be non empty Subset of TopSpaceMetr M;
  cluster dist_min A -> continuous;
end;

theorem 
  for B be Subset of T,F be Subset of T|A st F = B holds T|A|F = T|B;



registration
  let TM;
  cluster open -> F_sigma for Subset of TM;
  cluster closed -> G_delta for Subset of TM;
end;

theorem 
  for F be Subset of T|B st A is F_sigma & F = A/\B holds F is F_sigma;

theorem 
  for F be Subset of T|B st A is G_delta & F = A/\B holds F is G_delta;

theorem 
  T is T_1 & A is discrete implies A is open Subset of T|(Cl A);

theorem 
  for T st for F st F is open & F is Cover of T ex G st G c= F & G
  is Cover of T & card G c= C holds for A st A is closed & A is discrete holds
  card A c= C;

theorem 
  for TM st for Am st Am is closed & Am is discrete holds card Am
  c= iC holds for Am st Am is discrete holds card Am c= iC;

theorem 
  for T st for A st A is discrete holds card A c= C for F st F is
open & not {} in F & for A,B st A in F & B in F & A <> B holds A misses B holds
  card F c= C;

theorem 
  for F st F is Cover of T ex G st G c= F & G is Cover of T & card
  G c= card [#]T;

theorem 
  Am is dense implies weight TM c= omega *` card Am;

begin 


theorem 
  weight TM c= iC iff for Fm st Fm is open & Fm is Cover of TM ex
  Gm st Gm c=Fm & Gm is Cover of TM & card Gm c= iC;



theorem 
  weight TM c=iC iff for Am st Am is closed & Am is discrete holds
  card Am c= iC;



theorem 
  weight TM c= iC iff for Am st Am is discrete holds card Am c= iC;



theorem 
  weight TM c= iC iff for Fm st Fm is open & not{} in Fm & for Am,
  Bm st Am in Fm & Bm in Fm & Am <> Bm holds Am misses Bm holds card Fm c= iC;



theorem 
  weight TM c= iC iff density TM c= iC;

theorem 
  for B be Basis of TM st for Fm st Fm is open & Fm is Cover of TM
  ex Gm st Gm c=Fm & Gm is Cover of TM & card Gm c= iC ex underB be Basis of TM
  st underB c= B & card underB c= iC;

begin 

definition
  let T;
  attr T is Lindelof means


  for F st F is open & F is Cover of T ex G st
  G c=F & G is Cover of T & G is countable;
end;

theorem 
  for B be Basis of TM st TM is Lindelof ex B9 be Basis of TM st B9 c= B
  & B9 is countable;

registration
  cluster Lindelof -> second-countable for metrizable TopSpace;
end;

registration
  cluster Lindelof -> separable for metrizable TopSpace;
  cluster separable -> Lindelof for metrizable TopSpace;
end;

registration
  
  cluster Lindelof metrizable for non empty TopSpace;
  
  cluster second-countable -> Lindelof for TopSpace;
  cluster regular Lindelof -> normal for TopSpace;
  cluster countable -> Lindelof for TopSpace;
end;

registration
  let n be Nat;
  cluster the TopStruct of TOP-REAL n -> second-countable;
end;

registration
  let T be Lindelof TopSpace;
  let A be closed Subset of T;
  cluster T|A -> Lindelof;
end;

registration
  let TM be Lindelof metrizable TopSpace;
  let A be Subset of TM;
  
  cluster TM|A -> Lindelof;
end;

definition
  let T;
  let A,B,L be Subset of T;
  pred L separates A,B means


  ex U,W be open Subset of T st A c=U & B c= W & U misses W & L=(U\/W)`;
end;



theorem 
  Am,Bm are_separated implies ex L be Subset of TM st L separates Am,Bm;



theorem 
  for M be Subset of TM, A1,A2 be closed Subset of TM, V1,V2 be open
Subset of TM st A1 c=V1 & A2 c=V2 & Cl V1 misses Cl V2 for mV1,mV2,mL be Subset
  of TM|M st mV1 = M/\Cl V1 & mV2 = M/\Cl V2 & mL separates mV1,mV2 ex L be
  Subset of TM st L separates A1,A2 & M/\L c= mL;














begin 


theorem 
  for p,q be Prime, k be Nat st k divides p*q holds k = 1 or k = p
  or k = q or k = p*q;

definition
  let p be Nat;
  attr p is Safe means


  ex sgp be Prime st 2*sgp+1 = p;
end;

registration
  cluster Safe for Prime;
end;

theorem 
  for p be Safe Prime holds p >= 5;

theorem 
  for p be Safe Prime holds p mod 2 = 1;

theorem 
  for p be Safe Prime st p <> 7 holds p mod 3 = 2;

theorem 
  for p be Safe Prime st p <> 5 holds p mod 4 = 3;

theorem 
  for p be Safe Prime st p <> 7 holds p mod 6 = 5;

theorem 
  for p be Safe Prime st p > 7 holds p mod 12 = 11;

theorem 
  for p be Safe Prime st p > 5 holds p mod 8 = 3 or p mod 8 = 7;

definition
  let p be Nat;
  attr p is Sophie_Germain means


  2*p+1 is Prime;
end;

registration
  cluster Sophie_Germain for Prime;
end;

theorem 
  for p be Sophie_Germain Prime st p > 2 holds p mod 4 = 1 or p mod 4 = 3;

theorem 
  for p be Safe Prime ex q be Sophie_Germain Prime st p = 2*q+1;

theorem 
  for p be Safe Prime ex q be Sophie_Germain Prime st Euler p = 2* q;

theorem 
  for p1,p2 be Safe Prime, N be Nat st p1 <> p2 & N = p1*p2 holds ex q1,
  q2 be Sophie_Germain Prime st Euler (N) = 4*q1*q2;

theorem 
  for p be Safe Prime ex q be Sophie_Germain Prime st card (Z/Z*(p )) = 2*q;

theorem 
  for G being cyclic finite Group, n,m being Nat st card G = n*m
  ex a being Element of G st ord a = n & gr {a} is strict Subgroup of G;

theorem 
  for p be Safe Prime ex q be Sophie_Germain Prime, H1,H2,Hq,H2q be
strict Subgroup of (Z/Z*(p)) st card H1 = 1 & card H2 = 2 & card Hq = q & card
H2q = 2*q & for H be strict Subgroup of (Z/Z*(p)) holds H = H1 or H = H2 or H =
  Hq or H = H2q;

definition
  let n be Nat;
  func Mersenne(n) -> Nat equals

  2|^n-1;
end;

theorem 
  Mersenne(0) = 0;

theorem 
  Mersenne(1) = 1;

theorem 
  Mersenne(2) = 3;

theorem 
  Mersenne(3) = 7;

theorem 
  Mersenne(5) = 31;

theorem 
  Mersenne(7) = 127;

theorem 
  Mersenne(11) = 23*89;

theorem 
  for p be Prime st p <> 2 holds Mersenne(p) mod 2*p = 1;

theorem 
  for p be Prime st p <> 2 holds Mersenne(p) mod 8 = 7;

theorem 
  for p be Sophie_Germain Prime st p > 2 & p mod 4 = 3 holds ex q be
  Safe Prime st q divides Mersenne(p);

theorem 
  for p be Sophie_Germain Prime st p > 2 & p mod 4 = 1 holds ex q be
  Safe Prime st Mersenne(p) mod q = q-2;

theorem 
  for a,n be Nat st a > 1 holds a-1 divides a|^n-1;

theorem 
  for a,p be Nat st p > 1 & a|^p-1 is Prime holds a = 2 & p is Prime;

theorem 
  for p be Nat st p > 1 & Mersenne(p) is Prime holds p is Prime;



theorem 
  for a be Integer,x,n be Nat holds a|^x mod n = (a mod n)|^x mod n;

theorem 
  for x,y,n be Integer st x,n are_relative_prime & x,y
  are_congruent_mod n holds y,n are_relative_prime;

theorem 
  for a,x be Nat, p be Prime st a,p are_relative_prime & a,x*x
  are_congruent_mod p holds x,p are_relative_prime;

theorem 
  for a,x be Integer, p be Prime st a,p are_relative_prime & a,x*x
  are_congruent_mod p holds x,p are_relative_prime;

theorem 
  for a,b be Integer,n,x be Nat st a,b are_congruent_mod n & n <> 0
  holds a|^x,b|^x are_congruent_mod n;

theorem 
  for a be Integer, n be Prime st a*a mod n = 1 holds a,1
  are_congruent_mod n or a,(-1) are_congruent_mod n;

begin 

theorem 
  for p be Prime holds Z/Z*(p) = MultGroup (INT.Ring(p));

registration
  let F be commutative Skew-Field;
  cluster MultGroup (F) -> commutative;
end;

theorem 
  for F be commutative Skew-Field, x be Element of MultGroup (F), x1 be
  Element of F st x = x1 holds x" = x1";

theorem 
  for F be commutative Skew-Field, G be finite Subgroup of MultGroup(F)
  holds G is cyclic Group;














begin

reserve n, m for Element of NAT;
reserve z for Complex;

theorem 
  for f be PartFunc of COMPLEX,COMPLEX st f is total holds dom (Re
  f) = COMPLEX & dom (Im f) = COMPLEX;



theorem 
  for f be PartFunc of COMPLEX, COMPLEX, u,v be PartFunc of REAL 2,
  REAL, z0 be Complex, x0, y0 be Real, xy0 be Element of REAL 2 st (for x, y be
Real st x+y*<i> in dom f holds <*x,y*> in dom u & u.<*x,y*> = (Re f).(x+y*<i>))
& (for x,y be Real st x+y*<i> in dom f holds <*x,y*> in dom v & v.<*x,y*> = (Im
  f).(x+y*<i>)) & z0 = x0+y0*<i> & xy0 = <*x0,y0*> & f is_differentiable_in z0
holds u is_partial_differentiable_in xy0,1 & u is_partial_differentiable_in xy0
,2 & v is_partial_differentiable_in xy0,1 & v is_partial_differentiable_in xy0,
2 & Re diff(f,z0) = partdiff(u,xy0,1) & Re diff(f,z0) = partdiff(v,xy0,2) & Im
  diff(f,z0) =-partdiff(u,xy0,2) & Im diff(f,z0) = partdiff(v,xy0,1);

theorem 
  for seq be Real_Sequence holds seq is convergent & lim seq = 0
  iff abs seq is convergent & lim abs seq = 0;

theorem 
  for X be RealNormSpace, seq be sequence of X holds seq is
convergent & lim seq = 0.X iff ||. seq .|| is convergent & lim ||. seq .|| = 0;

theorem 
  for u be PartFunc of REAL 2, REAL, x0, y0 be Real, xy0 be Element
  of REAL 2 st xy0 = <*x0,y0*> & <>*u is_differentiable_in xy0 holds u
is_partial_differentiable_in xy0,1 & u is_partial_differentiable_in xy0,2 & <*
  partdiff(u,xy0,1) *> = diff(<>*u,xy0).(<* 1,0 *>) & <* partdiff(u,xy0,2) *> =
  diff(<>*u,xy0).(<* 0,1 *>);

theorem 
  for f be PartFunc of COMPLEX, COMPLEX, u,v be PartFunc of REAL 2, REAL
  , z0 be Complex, x0, y0 be Real, xy0 be Element of REAL 2 st (for x,y be Real
  st <*x,y*> in dom v holds x+y*<i> in dom f) & (for x,y be Real st x+y*<i> in
dom f holds <*x,y*> in dom u & u.<*x,y*> = (Re f).(x+y*<i>)) & (for x,y be Real
st x+y*<i> in dom f holds <*x,y*> in dom v & v.<*x,y*> = (Im f).(x+y*<i>)) & z0
  = x0+y0*<i> & xy0 = <*x0,y0*> & <>*u is_differentiable_in xy0 & <>*v
is_differentiable_in xy0 & partdiff(u,xy0,1) = partdiff(v,xy0,2) & partdiff(u,
  xy0,2) = -partdiff(v,xy0,1) holds f is_differentiable_in z0 & u
  is_partial_differentiable_in xy0,1 & u is_partial_differentiable_in xy0,2 & v
is_partial_differentiable_in xy0,1 & v is_partial_differentiable_in xy0,2 & Re
diff(f,z0) = partdiff(u,xy0,1) & Re diff(f,z0) = partdiff(v,xy0,2) & Im diff(f,
  z0) =-partdiff(u,xy0,2) & Im diff(f,z0) = partdiff(v,xy0,1);














begin  

reserve X for set,
  F for Field_Subset of X,
  M for Measure of F,
  A,B for Subset of X,
  Sets for SetSequence of X,
  seq,seq1,seq2 for ExtREAL_sequence,
  n,k for Nat;

theorem 
  Ser seq = Partial_Sums seq;



theorem 
  seq is nonnegative implies seq is summable & SUM seq = Sum seq;

theorem 
  seq1 is nonnegative & seq2 is nonnegative & (for n being Nat
holds seq.n = seq1.n + seq2.n) implies seq is nonnegative & SUM seq = SUM seq1
  + SUM seq2 & Sum seq = Sum seq1 + Sum seq2;

registration
  let X,F;
  cluster disjoint_valued for Function of NAT,F;
end;

definition
  let X,F;
  mode FinSequence of F -> FinSequence of bool X means


    for k being Nat st k in dom it holds it.k in F;
end;

registration
  let X,F;
  cluster disjoint_valued for FinSequence of F;
end;

definition
  let X,F;
  mode Sep_FinSequence of F is disjoint_valued FinSequence of F;
end;

definition
  let X,F;
  mode Sep_Sequence of F is disjoint_valued Function of NAT,F;
end;

definition
  let X,F;
  mode Set_Sequence of F -> SetSequence of X means


    for n be Nat holds it.n in F;
end;

definition
  let X,A,F;
  mode Covering of A,F -> Set_Sequence of F means


    A c= union rng it;
end;

reserve FSets for Set_Sequence of F,
  CA for Covering of A,F;

definition
  let X,F,FSets,n;
  redefine func FSets.n -> Element of F;
end;

definition
  let X,F,Sets;
  mode Covering of Sets,F -> Function of NAT,Funcs(NAT,bool X) means


    for n being Nat holds it.n is Covering of Sets.n,F;
end;

reserve Cvr for Covering of Sets,F;

definition
  let X,F,M,FSets;
  func vol(M,FSets) -> ExtREAL_sequence means


  for n holds it.n = M.( FSets.n);
end;

theorem 
  vol(M,FSets) is nonnegative;

definition
  let X,F,Sets,Cvr,n;
  redefine func Cvr.n -> Covering of Sets.n,F;
end;

definition
  let X,F,Sets,M,Cvr;
  func Volume(M,Cvr) -> ExtREAL_sequence means


  for n being Nat holds it .n = SUM(vol(M,Cvr.n));
end;

theorem 
  0 <= (Volume(M,Cvr)).n;

definition
  let X,F,M,A;
  func Svc(M,A) -> Subset of ExtREAL means


  for x being R_eal holds x in
  it iff ex CA being Covering of A,F st x = SUM vol(M,CA);
end;

registration
  let X,A,F,M;
  cluster Svc(M,A) -> non empty;
end;

definition
  let X,F,M;
  func C_Meas M -> Function of bool X,ExtREAL means


  for A being Subset of X holds it.A = inf(Svc(M,A));
end;

definition
  func InvPairFunc -> Function of NAT,[:NAT,NAT:] equals

  PairFunc";
end;

definition
  let X,F,Sets,Cvr;
  func On Cvr -> Covering of union rng Sets,F means


  for n being Nat holds it.n = (Cvr.(pr1 InvPairFunc.n)).(pr2 InvPairFunc.n);
end;

theorem 
  for k being Element of NAT holds ex m be Nat st for Sets being
SetSequence of X holds for Cvr being Covering of Sets,F holds (Partial_Sums(vol
  (M,On Cvr))).k <= (Partial_Sums Volume(M,Cvr)).m;

theorem 
  inf Svc(M,union rng Sets) <= SUM Volume(M,Cvr);

theorem 
  A in F implies (A,{}X) followed_by {}X is Covering of A,F;

theorem 
  for X being set, F being Field_Subset of X, M being Measure of F,
  A be set st A in F holds (C_Meas M).A <= M.A;

theorem 
  C_Meas M is nonnegative;

theorem 
  (C_Meas M).{} = 0;

theorem 
  A c= B implies (C_Meas M).A <= (C_Meas M).B;

theorem 
  (C_Meas M).(union rng Sets) <= SUM((C_Meas M)*Sets);

theorem 
  C_Meas M is C_Measure of X;

definition
  let X be set;
  let F be Field_Subset of X;
  let M be Measure of F;
  redefine func C_Meas M -> C_Measure of X;
end;

begin 

definition
  let X be set;
  let F be Field_Subset of X;
  let M be Measure of F;
  attr M is completely-additive means


  for FSets being Sep_Sequence of
  F st union rng FSets in F holds SUM(M*FSets) = M.(union rng FSets);
end;

theorem 
  Partial_Union FSets is Set_Sequence of F;

theorem 
  Partial_Diff_Union FSets is Set_Sequence of F;

theorem 
  A in F implies ex FSets being Sep_Sequence of F st A = union rng
  FSets & for n be Nat holds FSets.n c= CA.n;

theorem 
  M is completely-additive implies for A be set st A in F holds M.
  A = (C_Meas M).A;

reserve C for C_Measure of X;

theorem 
  (for B being Subset of X holds C.(B /\ A) + C.(B /\ (X \ A)) <=
  C.B) implies A in sigma_Field C;

theorem 
  F c= sigma_Field C_Meas M;

theorem 
  for X be set, F be Field_Subset of X, FSets be Set_Sequence of F
  , M be Function of F,ExtREAL holds M * FSets is ExtREAL_sequence;

definition
  let X be set;
  let F be Field_Subset of X;
  let FSets be Set_Sequence of F;
  let g be Function of F,ExtREAL;
  redefine func g*FSets -> ExtREAL_sequence;
end;

theorem 
  for X be set, S be SigmaField of X, SSets be SetSequence of S, M
  be Function of S,ExtREAL holds M * SSets is ExtREAL_sequence;

definition
  let X be set;
  let S be SigmaField of X;
  let SSets be SetSequence of S;
  let g be Function of S,ExtREAL;
  redefine func g*SSets -> ExtREAL_sequence;
end;

theorem 
  for F,G being Function of NAT,ExtREAL, n being Nat st (for m
  being Nat st m <= n holds F.m <= G.m) holds (Ser F).n <= (Ser G).n;

theorem 
  for X,C for seq being Sep_Sequence of sigma_Field C holds union
  rng seq in sigma_Field C & C.(union rng seq) = Sum(C*seq);

theorem 
  for X,C for seq being SetSequence of sigma_Field C holds Union seq in
  sigma_Field C;

theorem 
  for X being non empty set, S be SigmaField of X, M be
  sigma_Measure of S, SSets being SetSequence of S st SSets is non-descending
  holds lim(M*SSets) = M.(lim SSets);

theorem 
  FSets is non-descending implies M*FSets is non-decreasing;

theorem 
  FSets is non-ascending implies M*FSets is non-increasing;

theorem 
  for X being set, S be SigmaField of X, M be sigma_Measure of S,
  SSets being SetSequence of S st SSets is non-descending holds M*SSets is
  non-decreasing;

theorem 
  for X being set, S being SigmaField of X, M be sigma_Measure of
  S, SSets being SetSequence of S st SSets is non-ascending holds M*SSets is
  non-increasing;

theorem 
  for X being non empty set, S be SigmaField of X, M be sigma_Measure of
  S, SSets being SetSequence of S st SSets is non-ascending & M.(SSets.0) <
  +infty holds lim (M*SSets) = M.(lim SSets);

definition
  let X be set;
  let F be Field_Subset of X;
  let S be SigmaField of X;
  let m be Measure of F;
  let M be sigma_Measure of S;
  pred M is_extension_of m means


  for A be set st A in F holds M.A = m. A;
end;

theorem 
  for X being non empty set, F being Field_Subset of X, m being Measure
  of F st (ex M be sigma_Measure of sigma F st M is_extension_of m) holds m is
  completely-additive;

theorem 
  for X being non empty set, F being Field_Subset of X, m being
Measure of F st m is completely-additive ex M be sigma_Measure of sigma F st M
  is_extension_of m & M = (sigma_Meas(C_Meas m))|(sigma F);

theorem 
  (for n holds M.(FSets.n) < +infty) implies M.((Partial_Union
  FSets).k) < +infty;

theorem 
  for X being non empty set, F being Field_Subset of X, m being Measure
  of F st m is completely-additive & (ex Aseq be Set_Sequence of F st (for n be
  Nat holds m.(Aseq.n) < +infty) & X = union rng Aseq) holds for M being
sigma_Measure of sigma F st M is_extension_of m holds M = (sigma_Meas(C_Meas m)
  )|(sigma F);














begin 

reserve x, x1, x2, y, y1, y2, z, z1, z2, X, X1, X2 for set;
reserve E for non empty set;
reserve e for Element of E;
reserve u, u9, u1, u2, v, v1, v2, w, w1, w2 for Element of E^omega;
reserve F, F1, F2 for Subset of E^omega;
reserve i, k, l, n for Nat;

theorem 
  for p being FinSequence st k in dom p holds (<*x*>^p).(k + 1) = p.k;

theorem 
  for p being FinSequence holds p <> {} implies ex q being
  FinSequence, x st p = q^<*x*> & len p = len q + 1;

theorem 
  for p being FinSequence st k in dom p & not k + 1 in dom p holds len p = k;

begin 

theorem 
  for R being Relation, P being RedSequence of R, q1, q2 being
FinSequence st P = q1^q2 & len q1 > 0 & len q2 > 0 holds q1 is RedSequence of R
  & q2 is RedSequence of R;

theorem 
  for R being Relation, P being RedSequence of R st len P > 1 holds
  ex Q being RedSequence of R st <*P.1*>^Q = P & len Q + 1 = len P;

theorem 
  for R being Relation, P being RedSequence of R st len P > 1 holds ex Q
  being RedSequence of R st Q^<*P.len P*> = P & len Q + 1 = len P;

theorem 
  for R being Relation, P being RedSequence of R st len P > 1 holds ex Q
being RedSequence of R st len Q + 1 = len P & for k st k in dom Q holds Q.k = P
  .(k + 1);

theorem 
  for R being Relation holds <*x, y*> is RedSequence of R implies [ x, y] in R;

begin 

theorem 
  w = u^v implies len u <= len w & len v <= len w;

theorem 
  w = u^v & u <> <%>E & v <> <%>E implies len u < len w & len v < len w;

theorem 
  w1^v1 = w2^v2 & ( len w1 = len w2 or len v1 = len v2 ) implies w1 = w2
  & v1 = v2;

theorem 
  w1^v1 = w2^v2 & ( len w1 <= len w2 or len v1 >= len v2 ) implies
  ex u st w1^u = w2 & v1 = u^v2;

theorem 
  w1^v1 = w2^v2 implies (ex u st w1^u = w2 & v1 = u^v2) or ex u st
  w2^u = w1 & v2 = u^v1;

begin 

definition
  let X;
  struct (1-sorted) transition-system over X (# carrier -> set, Tran ->
    Relation of [: the carrier, X :], the carrier #);
end;




definition
  let E, F;
  let TS be transition-system over F;
  attr TS is deterministic means


  (the Tran of TS) is Function & not <%>
E in rng dom (the Tran of TS) & for s being Element of TS, u, v st u <> v & [s,
u] in dom (the Tran of TS) & [s, v] in dom (the Tran of TS) holds not ex w st u
  ^w = v or v^w = u;
end;

theorem 
  for TS being transition-system over F holds dom (the Tran of TS)
  = {} implies TS is deterministic;

registration
  let E, F;
  cluster strict non empty finite deterministic for transition-system over F;
end;

begin 

definition
  let X;
  let TS be transition-system over X;
  let x, y, z;
  pred x, y -->. z, TS means


  [[x, y], z] in the Tran of TS;
end;

theorem 
  for TS being transition-system over X holds x, y -->. z, TS
  implies x in TS & y in X & z in TS & x in dom dom (the Tran of TS) & y in rng
  dom (the Tran of TS) & z in rng (the Tran of TS);

theorem 
  for TS1 being transition-system over X1, TS2 being
transition-system over X2 st the Tran of TS1 = the Tran of TS2 holds x, y -->.
  z, TS1 implies x, y -->. z, TS2;

theorem 
  for TS being transition-system over F st the Tran of TS is
  Function holds x, y -->. z1, TS & x, y -->. z2, TS implies z1 = z2;

theorem 
  for TS being transition-system over F st not <%>E in rng dom (the Tran
  of TS) holds not x, <%>E -->. y, TS;

theorem 
  for TS being deterministic transition-system over F holds u <> v
  & x, u -->. z1, TS & x, v -->. z2, TS implies not ex w st u^w = v or v^w = u;

begin 

definition
  let E, F;
  let TS be transition-system over F;
  let x1, x2, y1, y2;
  pred x1, x2 ==>. y1, y2, TS means


  ex v, w st v = y2 & x1, w -->. y1, TS & x2 = w^v;
end;

theorem 
  for TS being transition-system over F holds x1, x2 ==>. y1, y2,
TS implies x1 in TS & y1 in TS & x2 in E^omega & y2 in E^omega & x1 in dom dom
  (the Tran of TS) & y1 in rng (the Tran of TS);

theorem 
  for TS1 being transition-system over F1, TS2 being
transition-system over F2 st the Tran of TS1 = the Tran of TS2 & x1, x2 ==>. y1
  , y2, TS1 holds x1, x2 ==>. y1, y2, TS2;

theorem 
  for TS being transition-system over F holds x, u ==>. y, v, TS
  implies ex w st x, w -->. y, TS & u = w^v;

theorem 
  for TS being transition-system over F holds x, y -->. z, TS iff
  x, y ==>. z, <%>E, TS;

theorem 
  for TS being transition-system over F holds x, v -->. y, TS iff
  x, v^w ==>. y, w, TS;

theorem 
  for TS being transition-system over F holds x, u ==>. y, v, TS
  implies x, u^w ==>. y, v^w, TS;

theorem 
  for TS being transition-system over F holds x, u ==>. y, v, TS
  implies len u >= len v;

theorem 
  for TS being transition-system over F st the Tran of TS is
  Function holds x1, x2 ==>. y1, z, TS & x1, x2 ==>. y2, z, TS implies y1 = y2;

theorem 
  for TS being transition-system over F st not <%>E in rng dom (
  the Tran of TS) holds not x, z ==>. y, z, TS;

theorem 
  for TS being transition-system over F st not <%>E in rng dom (
  the Tran of TS) holds x, u ==>. y, v, TS implies len u > len v;

theorem 
  for TS being deterministic transition-system over F holds x1, x2
  ==>. y1, z1, TS & x1, x2 ==>. y2, z2, TS implies y1 = y2 & z1 = z2;

begin 


reserve TS for non empty transition-system over F;
reserve s, s9, s1, s2, t, t1, t2 for Element of TS;
reserve S for Subset of TS;

definition
  let E, F, TS;
  func ==>.-relation(TS) -> Relation of [: the carrier of TS, E^omega :] means


  [[x1, x2], [y1, y2]] in it iff x1, x2 ==>. y1, y2, TS;
end;

theorem 
  [x, y] in ==>.-relation(TS) implies ex s, v, t, w st x = [s, v] & y = [t, w];

theorem 
  [[x1, x2], [y1, y2]] in ==>.-relation(TS) implies x1 in TS & y1
in TS & x2 in E^omega & y2 in E^omega & x1 in dom dom (the Tran of TS) & y1 in
  rng (the Tran of TS);

theorem 
  x in ==>.-relation(TS) implies ex s, t, v, w st x = [[s, v], [t, w]];

theorem 
  for TS1 being non empty transition-system over F1, TS2 being non
  empty transition-system over F2 st
the Tran of TS1 = the Tran of TS2 holds ==>.-relation(TS1) = ==>.-relation(TS2)
;

theorem 
  [[x1, x2], [y1, y2]] in ==>.-relation(TS) implies ex v, w st v =
  y2 & x1, w -->. y1, TS & x2 = w^v;

theorem 
  [[x, u], [y, v]] in ==>.-relation(TS) implies ex w st x, w -->.
  y, TS & u = w^v;

theorem 
  x, y -->. z, TS iff [[x, y], [z, <%>E]] in ==>.-relation(TS);

theorem 
  x, v -->. y, TS iff [[x, v^w], [y, w]] in ==>.-relation(TS);

theorem 
  [[x, u], [y, v]] in ==>.-relation(TS) implies [[x, u^w], [y, v^w]] in
  ==>.-relation(TS);

theorem 
  [[x, u], [y, v]] in ==>.-relation(TS) implies len u >= len v;

theorem 
  the Tran of TS is Function implies ([x, [y1, z]] in ==>.-relation(TS)
  & [x, [y2, z]] in ==>.-relation(TS) implies y1 = y2);

theorem 
  not <%>E in rng dom (the Tran of TS) implies ([[x, u], [y, v]] in
  ==>.-relation(TS) implies len u > len v);

theorem 
  not <%>E in rng dom (the Tran of TS) implies not [[x, z], [y, z]
  ] in ==>.-relation(TS);

theorem 
  TS is deterministic implies ([x, y1] in ==>.-relation(TS) & [x,
  y2] in ==>.-relation(TS) implies y1 = y2);

theorem 
  TS is deterministic implies ([x, [y1, z1]] in ==>.-relation(TS) & [x,
  [y2, z2]] in ==>.-relation(TS) implies y1 = y2 & z1 = z2);

theorem 
  TS is deterministic implies ==>.-relation(TS) is Function-like;

begin 

definition
  let x, E;
  func dim2(x, E) -> Element of E^omega equals


  x`2 if ex y, u st x = [y
  , u] otherwise {};
end;

theorem 
  for P being RedSequence of ==>.-relation(TS), k st k in dom P &
  k + 1 in dom P holds ex s, v, t, w st P.k = [s, v] & P.(k + 1) = [t, w];

theorem 
  for P being RedSequence of ==>.-relation(TS), k st k in dom P &
k + 1 in dom P holds P.k = [(P.k)`1, (P.k)`2] & P.(k + 1) = [(P.(k + 1))`1, (P.
  (k + 1))`2];

theorem 
  for P being RedSequence of ==>.-relation(TS), k st k in dom P &
k + 1 in dom P holds (P.k)`1 in TS & (P.k)`2 in E^omega & (P.(k + 1))`1 in TS &
(P.(k + 1))`2 in E^omega & (P.k)`1 in dom dom (the Tran of TS) & (P.(k + 1))`1
  in rng (the Tran of TS);

theorem 
  for TS1 being non empty transition-system over F1, TS2 being non empty
transition-system over F2 st the carrier of TS1 = the carrier of TS2 & the Tran
  of TS1 = the Tran of TS2 holds for P being RedSequence of ==>.-relation(TS1)
  holds P is RedSequence of ==>.-relation(TS2);

theorem 
  for P being RedSequence of ==>.-relation(TS) st ex x, u st P.1 =
  [x, u] holds for k st k in dom P holds dim2(P.k, E) = (P.k)`2;

theorem 
  for P being RedSequence of ==>.-relation(TS) st P.len P = [y, w]
  holds for k st k in dom P ex u st (P.k)`2 = u^w;

theorem 
  for P being RedSequence of ==>.-relation(TS) st P.1 = [x, v] & P
  .len P = [y, w] holds ex u st v = u^w;

theorem 
  for P being RedSequence of ==>.-relation(TS) st P.1 = [x, u] & P
  .len P = [y, u] holds for k st k in dom P holds (P.k)`2 = u;

theorem 
  for P being RedSequence of ==>.-relation(TS), k st k in dom P & k + 1
in dom P holds ex v, w st v = (P.(k + 1))`2 & (P.k)`1, w -->. (P.(k + 1))`1, TS
  & (P.k)`2 = w^v;

theorem 
  for P being RedSequence of ==>.-relation(TS), k st k in dom P & k + 1
in dom P & P.k = [x, u] & P.(k + 1) = [y, v] holds ex w st x, w -->. y, TS & u
  = w^v;

theorem 
  x, y -->. z, TS iff <*[x, y], [z, <%>E]*> is RedSequence of ==>.-relation(TS)
;

theorem 
  x, v -->. y, TS iff <*[x, v^w], [y, w]*> is RedSequence of ==>.-relation(TS);

theorem 
  for P being RedSequence of ==>.-relation(TS) st P.1 = [x, v] & P
  .len P = [y, w] holds len v >= len w;

theorem 
  not <%>E in rng dom (the Tran of TS) implies for P being
RedSequence of ==>.-relation(TS) st P.1 = [x, u] & P.len P = [y, u] holds len P
  = 1 & x = y;

theorem 
  not <%>E in rng dom (the Tran of TS) implies for P being
  RedSequence of ==>.-relation(TS) st (P.1)`2 = (P.len P)`2 holds len P = 1;

theorem 
  not <%>E in rng dom (the Tran of TS) implies for P being
  RedSequence of ==>.-relation(TS) st P.1 = [x, u] & P.len P = [y, <%>E] holds
  len P <= len u + 1;

theorem 
  not <%>E in rng dom (the Tran of TS) implies for P being
  RedSequence of ==>.-relation(TS) st P.1 = [x, <%e%>] & P.len P = [y, <%>E]
  holds len P = 2;

theorem 
  not <%>E in rng dom (the Tran of TS) implies for P being
RedSequence of ==>.-relation(TS) st P.1 = [x, v] & P.len P = [y, w] holds len v
  > len w or len P = 1 & x = y & v = w;

theorem 
  not <%>E in rng dom (the Tran of TS) implies for P being RedSequence
of ==>.-relation(TS), k st k in dom P & k + 1 in dom P holds (P.k)`2 <> (P.(k +
  1))`2;

theorem 
  not <%>E in rng dom (the Tran of TS) implies for P being
RedSequence of ==>.-relation(TS), k, l st k in dom P & l in dom P & k < l holds
  (P.k)`2 <> (P.l)`2;

theorem 
  TS is deterministic implies for P, Q being RedSequence of
==>.-relation(TS) st P.1 = Q.1 holds for k st k in dom P & k in dom Q holds P.k
  = Q.k;

theorem 
  TS is deterministic implies for P, Q being RedSequence of
  ==>.-relation(TS) st P.1 = Q.1 & len P = len Q holds P = Q;

theorem 
  TS is deterministic implies for P, Q being RedSequence of
  ==>.-relation(TS) st P.1 = Q.1 & (P.len P)`2 = (Q.len Q)`2 holds P = Q;

begin 

theorem 
  ==>.-relation(TS) reduces [x, v], [y, w] implies ex u st v = u^w;

theorem 
  ==>.-relation(TS) reduces [x, u], [y, v] implies ==>.-relation(
  TS) reduces [x, u^w], [y, v^w];

theorem 
  x, y -->. z, TS implies ==>.-relation(TS) reduces [x, y], [z, <%>E];

theorem 
  x, v -->. y, TS implies ==>.-relation(TS) reduces [x, v^w], [y, w];

theorem 
  x1, x2 ==>. y1, y2, TS implies ==>.-relation(TS) reduces [x1, x2 ], [y1, y2];

theorem 
  ==>.-relation(TS) reduces [x, v], [y, w] implies len v >= len w;

theorem 
  ==>.-relation(TS) reduces [x, w], [y, v^w] implies v = <%>E;

theorem 
  not <%>E in rng dom (the Tran of TS) implies (==>.-relation(TS)
  reduces [x, v], [y, w] implies len v > len w or x = y & v = w );

theorem 
  not <%>E in rng dom (the Tran of TS) implies (==>.-relation(TS)
  reduces [x, u], [y, u] implies x = y);

theorem 
  not <%>E in rng dom (the Tran of TS) implies (==>.-relation(TS)
reduces [x, <%e%>], [y, <%>E] implies [[x, <%e%>], [y, <%>E]] in ==>.-relation(
  TS));

theorem 
  TS is deterministic implies (==>.-relation(TS) reduces x, [y1, z
  ] & ==>.-relation(TS) reduces x, [y2, z] implies y1 = y2);

begin 

definition
  let E, F, TS, x1, x2, y1, y2;
  pred x1, x2 ==>* y1, y2, TS means


  ==>.-relation(TS) reduces [x1, x2], [y1, y2];
end;

theorem 
  for TS1 being non empty transition-system over F1, TS2 being non
  empty transition-system over F2 st the carrier of TS1 = the carrier of TS2 &
the Tran of TS1 = the Tran of TS2 holds x1, x2 ==>* y1, y2, TS1 implies x1, x2
  ==>* y1, y2, TS2;

theorem 
  x, y ==>* x, y, TS;

theorem 
  x1, x2 ==>* y1, y2, TS & y1, y2 ==>* z1, z2, TS implies x1, x2
  ==>* z1, z2, TS;

theorem 
  x, y -->. z, TS implies x, y ==>* z, <%>E, TS;

theorem 
  x, v -->. y, TS implies x, v^w ==>* y, w, TS;

theorem 
  x, u ==>* y, v, TS implies x, u^w ==>* y, v^w, TS;

theorem 
  x1, x2 ==>. y1, y2, TS implies x1, x2 ==>* y1, y2, TS;

theorem 
  x, v ==>* y, w, TS implies ex u st v = u^w;

theorem 
  x, v ==>* y, w, TS implies len w <= len v;

theorem 
  x, w ==>* y, v^w, TS implies v = <%>E;

theorem 
  not <%>E in rng dom (the Tran of TS) implies (x, u ==>* y, u, TS iff x = y);

theorem 
  not <%>E in rng dom (the Tran of TS) implies (x, <%e%> ==>* y,
  <%>E, TS implies x, <%e%> ==>. y, <%>E, TS);

theorem 
  TS is deterministic implies ( x1, x2 ==>* y1, z, TS & x1, x2
  ==>* y2, z, TS implies y1 = y2);

begin 

definition
  let E, F, TS, x1, x2, y;
  pred x1, x2 ==>* y, TS means


  x1, x2 ==>* y, <%>E, TS;
end;

theorem 
  for TS1 being non empty transition-system over F1, TS2 being non
  empty transition-system over F2 st the carrier of TS1 = the carrier of TS2 &
  the Tran of TS1 = the Tran of TS2 holds x, y ==>* z, TS1 implies x, y ==>* z,
  TS2;

theorem 
  x, <%>E ==>* x, TS;

theorem 
  x, u ==>* y, TS implies x, u^v ==>* y, v, TS;

theorem 
  x, y -->. z, TS implies x, y ==>* z, TS;

theorem 
  x1, x2 ==>. y, <%>E, TS implies x1, x2 ==>* y, TS;

theorem 
  x, u ==>* y, TS & y, v ==>* z, TS implies x, u^v ==>* z, TS;

theorem 
  not <%>E in rng dom (the Tran of TS) implies (x, <%>E ==>* y, TS iff x = y);

theorem 
  not <%>E in rng dom (the Tran of TS) implies (x, <%e%> ==>* y, TS
  implies x, <%e%> ==>. y, <%>E, TS);

theorem 
  TS is deterministic implies ( x1, x2 ==>* y1, TS & x1, x2 ==>* y2, TS
  implies y1 = y2);

begin 

definition
  let E, F, TS, x, X;
  func x-succ_of (X, TS) -> Subset of TS equals

  { s : ex t st t in X & t, x
  ==>* s, TS };
end;

theorem 
  s in x-succ_of (X, TS) iff ex t st t in X & t, x ==>* s, TS;

theorem 
  not <%>E in rng dom (the Tran of TS) implies <%>E-succ_of (S, TS) = S;

theorem 
  for TS1 being non empty transition-system over F1, TS2 being non empty
transition-system over F2 st the carrier of TS1 = the carrier of TS2 & the Tran
  of TS1 = the Tran of TS2 holds x-succ_of (X, TS1) = x-succ_of (X, TS2);














begin 

notation
  let S be set, s be FinSequence of S;
  synonym whole_event (s) for dom s;
end;

theorem 
  for S be set, s be FinSequence of S holds whole_event (s) = s"S;

notation
  let S be set, s be FinSequence of S, x be set;
  synonym event_pick (x,s) for Coim(s,x);
end;

definition
  let S be set, s be FinSequence of S, x be set;
  redefine func event_pick (x,s) -> Event of whole_event(s);
end;

definition
  let S be finite set, s be FinSequence of S, x be set;
  func frequency(x,s) -> Nat equals

  card (event_pick(x,s));
end;

theorem 
  for S be set, s be FinSequence of S, e be set st e in whole_event(s)
  ex x be Element of S st e in event_pick(x,s);

theorem 
  for S be set, s be FinSequence of S holds card whole_event(s) = len s;

definition
  let S be finite set, s be FinSequence of S, x be set;
  func FDprobability (x,s) -> Real equals

  frequency(x,s) / (len s);
end;

theorem 
  for S be finite set, s be FinSequence of S, x be set holds
  frequency(x,s)=(len s)* FDprobability (x,s);

definition
  let S be finite set, s be FinSequence of S;
  func FDprobSEQ (s) -> FinSequence of REAL means


  dom it = Seg card S &
  for n be Nat st n in dom it holds it.n=FDprobability((canFS(S)).n,s);
end;

theorem 
  for S be finite set, s be FinSequence of S, x be set
  holds FDprobability(x,s)=prob(event_pick(x,s));

definition
  let S be finite set, s,t be FinSequence of S;
  pred s,t -are_prob_equivalent means


  for x be set holds FDprobability (x,s)=FDprobability (x,t);
  reflexivity;
  symmetry;
end;

theorem 
  for S be finite set, s,t,u be FinSequence of S st
  s,t -are_prob_equivalent & t,u -are_prob_equivalent holds
  s,u -are_prob_equivalent;

definition
  let S be finite set, s be FinSequence of S;
  func Finseq-EQclass(s) -> Subset of S* equals

  {t where t is FinSequence of S: s,t -are_prob_equivalent};
end;

registration
  let S be finite set, s be FinSequence of S;
  cluster Finseq-EQclass(s) -> non empty;
end;

theorem 
  for S be finite set, s,t be FinSequence of S holds
  s,t -are_prob_equivalent iff t in Finseq-EQclass(s);

theorem 
  for S be finite set, s be FinSequence of S holds s in Finseq-EQclass(s);

theorem 
  for S be finite set, s,t be FinSequence of S holds
  s,t -are_prob_equivalent iff Finseq-EQclass(s) = Finseq-EQclass(t);

definition
  let S be finite set;
  func distribution_family(S) -> Subset-Family of S* means


  for A being Subset of S* holds A in it iff ex s being FinSequence of S st
  A = Finseq-EQclass(s);
end;

registration
  let S be finite set;
  cluster distribution_family(S) -> non empty;
end;

theorem 
  for S be finite set, s,t be FinSequence of S holds
  s,t -are_prob_equivalent iff FDprobSEQ(s) = FDprobSEQ(t);

theorem 
  for S be finite set, s,t be FinSequence of S st
  t in Finseq-EQclass(s) holds FDprobSEQ(s)=FDprobSEQ(t);

definition
  let S be finite set;
  func GenProbSEQ (S) -> Function of distribution_family(S),REAL* means


  for x be Element of distribution_family(S) holds ex s be FinSequence of S st
  s in x & it.x=FDprobSEQ (s);
end;

theorem 
  for S be finite set, s be FinSequence of S holds
  (GenProbSEQ (S)).(Finseq-EQclass(s)) = FDprobSEQ (s);

registration
  let S be finite set;
  cluster GenProbSEQ S -> one-to-one;
end;

definition
  let S be finite set, p be ProbFinS FinSequence of REAL;
  assume
 ex s be FinSequence of S st FDprobSEQ (s)=p;
  func distribution (p,S) -> Element of distribution_family(S) means


  (GenProbSEQ S).it = p;
end;

definition
  let S be finite set, s be FinSequence of S;
  func freqSEQ (s) -> FinSequence of NAT means


  dom it = Seg card S &
  for n be Nat st n in dom it holds it.n=(len s) * (FDprobSEQ(s)).n;
end;

theorem 
  for S be non empty finite set, s be non empty FinSequence of S, n be Nat
  st n in Seg (card S)
  ex x be Element of S st (freqSEQ(s)).n=frequency(x,s)& x=(canFS(S)).n;

theorem 
  for S be finite set, s be FinSequence of S holds
  freqSEQ (s) =(len s)* ((FDprobSEQ(s)));

theorem 
  for S be finite set, s be FinSequence of S holds
  Sum (freqSEQ (s))=(len s)* Sum(FDprobSEQ(s));

theorem 
  for S be non empty finite set, s be non empty FinSequence of S, n be Nat st
  n in dom s
  ex m be Nat st (freqSEQ(s)).m = frequency(s.n,s) & s.n=(canFS(S)).m;

theorem 
  for S be Function,L be FinSequence of NAT st S is disjoint_valued &
  dom S = dom L & for i be Nat st i in dom S holds S.i is finite &
  L.i = card (S.i) holds Union S is finite & card Union S = Sum L;

theorem 
  for S be non empty finite set, s be non empty FinSequence of S
  holds Sum freqSEQ (s) = len s;

theorem 
  for S be non empty finite set, s be non empty FinSequence of S
  holds Sum FDprobSEQ (s) = 1;

registration
  let S be non empty finite set, s be non empty FinSequence of S;
  cluster FDprobSEQ s -> ProbFinS;
end;

definition
  let S be non empty finite set;
  mode distProbFinS of S -> ProbFinS FinSequence of REAL means


  len it = card S & ex s be FinSequence of S st FDprobSEQ (s) = it;
end;

theorem 
  for S be non empty finite set, p be distProbFinS of S holds
  distribution(p,S) is Element of distribution_family(S) &
  (GenProbSEQ S).distribution(p,S) = p;

begin 

definition
  let S be finite set, s be FinSequence of S;
  attr s is uniformly_distributed means


  for n be Nat st n in dom FDprobSEQ (s) holds (FDprobSEQ (s)).n=1/(card S);
end;

theorem 
  for S be finite set, s be FinSequence of S st
  s is uniformly_distributed holds FDprobSEQ (s) is constant;

theorem 
  for S be finite set, s,t be FinSequence of S st
  s is uniformly_distributed & s,t -are_prob_equivalent holds
  t is uniformly_distributed;

theorem 
  for S be finite set, s,t be FinSequence of S st
  s is uniformly_distributed & t is uniformly_distributed holds
  s,t -are_prob_equivalent;

registration
  let S be finite set;
  cluster canFS(S) -> uniformly_distributed;
end;

definition
  let S be finite set;
  func uniform_distribution(S) -> Element of distribution_family(S) means


  for s be FinSequence of S holds s in it iff s is uniformly_distributed;
end;

registration
  let S be non empty finite set;
  cluster constant for distProbFinS of S;
end;

definition
  let S be non empty finite set;
  func Uniform_FDprobSEQ(S) -> distProbFinS of S equals

  FDprobSEQ canFS S;
end;

registration
  let S be non empty finite set;
  cluster Uniform_FDprobSEQ(S) -> constant;
end;

theorem 
  for S be non empty finite set holds
  uniform_distribution(S) = distribution(Uniform_FDprobSEQ(S),S);














begin 

reserve Z for set;

definition
  let A be non empty closed_interval Subset of REAL;
  let f be Function of A,REAL;
  let D be Division of A;
  mode middle_volume of f,D -> FinSequence of REAL means


    len it = len D
    & for i be Nat st i in dom D holds ex r be Element of REAL st r in rng (f|
    divset(D,i)) & it.i=r*vol divset(D,i);
end;

definition
  let A be non empty closed_interval Subset of REAL;
  let f be Function of A,REAL;
  let D be Division of A;
  let F be middle_volume of f,D;
  func middle_sum(f,F) -> Real equals

  Sum(F);
end;

theorem 
  for A be non empty closed_interval Subset of REAL, f be Function of A,REAL,
  D be Division of A, F be middle_volume of f,D st f|A is bounded_below holds
  lower_sum (f,D) <= middle_sum(f,F);

theorem 
  for A be non empty closed_interval Subset of REAL, f be Function of A,REAL,
  D be Division of A, F be middle_volume of f,D st f|A is bounded_above holds
  middle_sum(f,F) <= upper_sum (f,D);

theorem 
  for A be non empty closed_interval Subset of REAL, f be Function of A,REAL,
  D be Division of A, e be Real st f|A is bounded_below & 0 < e holds ex F be
  middle_volume of f,D st middle_sum(f,F) <= lower_sum (f,D) + e;

theorem 
  for A be non empty closed_interval Subset of REAL, f be Function of A,REAL,
  D be Division of A, e be Real st f|A is bounded_above & 0 < e holds ex F be
  middle_volume of f,D st upper_sum (f,D) - e <= middle_sum(f,F);

definition
  let A be non empty closed_interval Subset of REAL,
  f be Function of A,REAL, T be
  DivSequence of A;
  mode middle_volume_Sequence of f,T -> Function of NAT, (REAL)* means


    for k be Element of NAT holds it.k is middle_volume of f,T.k;
end;

definition
  let A be non empty closed_interval Subset of REAL,
  f be Function of A,REAL, T be
  DivSequence of A, S be middle_volume_Sequence of f,T, k be Element of NAT;
  redefine func S.k -> middle_volume of f,T.k;
end;

definition
  let A be non empty closed_interval Subset of REAL,
  f be Function of A,REAL, T be
  DivSequence of A, S be middle_volume_Sequence of f,T;
  func middle_sum(f,S) -> Real_Sequence means


  for i be Element of NAT holds it.i = middle_sum(f,S.i);
end;

theorem 
  for A be non empty closed_interval Subset of REAL, f being Function of A,
  REAL, T being DivSequence of A, S be middle_volume_Sequence of f,T, i be
Element of NAT st f|A is bounded_below holds (lower_sum(f,T)).i <= (middle_sum(
  f,S)).i;

theorem 
  for A be non empty closed_interval Subset of REAL, f being Function of A,
  REAL, T being DivSequence of A, S be middle_volume_Sequence of f,T, i be
Element of NAT st f|A is bounded_above holds (middle_sum(f,S)).i <= (upper_sum(
  f,T)).i;

theorem 
  for A be non empty closed_interval Subset of REAL, f being Function of A,
  REAL, T being DivSequence of A, e be Element of REAL st 0 < e & f|A is
  bounded_below holds ex S be middle_volume_Sequence of f,T st for i be Element
  of NAT holds (middle_sum(f,S)).i <= (lower_sum(f,T)).i + e;

theorem 
  for A be non empty closed_interval Subset of REAL, f being Function of A,
  REAL, T being DivSequence of A, e be Element of REAL st 0 < e & f|A is
  bounded_above holds ex S be middle_volume_Sequence of f,T st for i be Element
  of NAT holds (upper_sum(f,T)).i - e <= (middle_sum(f,S)).i;

theorem 
  for A be non empty closed_interval Subset of REAL, f being Function of A,
  REAL, T being DivSequence of A, S be middle_volume_Sequence of f,T st f is
  bounded & f is integrable & delta(T) is convergent & lim delta(T)=0 holds
  middle_sum(f,S) is convergent & lim (middle_sum(f,S))=integral(f);

theorem 
  for A be non empty closed_interval Subset of REAL, f being Function of A,
  REAL st f is bounded holds f is integrable iff ex I be Real st for T being
DivSequence of A, S be middle_volume_Sequence of f,T st delta(T) is convergent
& lim delta(T)=0 holds middle_sum(f,S) is convergent & lim (middle_sum(f,S))=I;

definition
  let n be Element of NAT;
  let A be non empty closed_interval Subset of REAL;
  let f be Function of A,REAL n;
  let D be Division of A;
  mode middle_volume of f,D -> FinSequence of (REAL n) means


    len it =
len D & for i be Nat st i in dom D holds ex r be Element of (REAL n) st r in
    rng (f|divset(D,i)) & it.i=vol divset(D,i)*r;
end;

definition
  let n be Element of NAT;
  let A be non empty closed_interval Subset of REAL;
  let f be Function of A,REAL n;
  let D be Division of A;
  let F be middle_volume of f,D;
  func middle_sum(f,F) -> Element of (REAL n) means


  for i be Element of
NAT st i in Seg n holds ex Fi be FinSequence of REAL st Fi=proj(i,n)*F & it.i =
  Sum(Fi);
end;

definition
  let n be Element of NAT;
  let A be non empty closed_interval Subset of REAL;
  let f be Function of A,REAL n;
  let T be DivSequence of A;
  mode middle_volume_Sequence of f,T -> Function of NAT, (REAL n)* means



    for k be Element of NAT holds it.k is middle_volume of f,T.k;
end;

definition
  let n be Element of NAT;
  let A be non empty closed_interval Subset of REAL;
  let f be Function of A,REAL n;
  let T be DivSequence of A;
  let S be middle_volume_Sequence of f,T;
  let k be Element of NAT;
  redefine func S.k -> middle_volume of f,T.k;
end;

definition
  let n be Element of NAT;
  let A be non empty closed_interval Subset of REAL;
  let f be Function of A,REAL n;
  let T be DivSequence of A;
  let S be middle_volume_Sequence of f,T;
  func middle_sum(f,S) -> sequence of (REAL-NS n) means


  for i be Element of NAT holds it.i = middle_sum(f,S.i);
end;

definition
  let n be Nat;
  let Z be set;
  let f,g be PartFunc of Z,REAL n;
  func f+g -> PartFunc of Z, REAL n equals

  f <++> g;
  func f-g -> PartFunc of Z, REAL n equals

  f <--> g;
end;

definition
  let n be Nat;
  let r be real number;
  let Z be set;
  let f be PartFunc of Z,REAL n;
  func r(#)f -> PartFunc of Z, REAL n equals

  f [#] r;
end;

begin 

definition
  let n be Element of NAT;
  let A be non empty closed_interval Subset of REAL;
  let f be Function of A,REAL n;
  attr f is bounded means


  for i be Element of NAT st i in Seg n holds (proj(i,n)*f) is bounded;
end;

definition
  let n be Element of NAT;
  let A be non empty closed_interval Subset of REAL;
  let f be Function of A,REAL n;
  attr f is integrable means


  for i be Element of NAT st i in Seg n holds (proj(i,n)*f) is integrable;
end;

definition
  let n be Element of NAT;
  let A be non empty closed_interval Subset of REAL;
  let f be Function of A,REAL n;
  func integral(f) -> Element of REAL n means


  dom it = Seg n & for i
  be Element of NAT st i in Seg n holds it.i = integral((proj(i,n)*f));
end;

theorem 
  for n be Element of NAT, A be non empty closed_interval Subset of REAL, f
  being Function of A,REAL n, T being DivSequence of A, S be
  middle_volume_Sequence of f,T st f is bounded & f is integrable & delta(T) is
  convergent & lim delta(T)=0 holds middle_sum(f,S) is convergent & lim (
  middle_sum(f,S))=integral(f);

theorem 
  for n be Element of NAT, A be non empty closed_interval Subset of REAL,
  f being
Function of A,REAL n st f is bounded holds f is integrable iff ex I be Element
  of REAL n st for T being DivSequence of A, S be middle_volume_Sequence of f,T
st delta(T) is convergent & lim delta(T)=0 holds middle_sum(f,S) is convergent
  & lim (middle_sum(f,S))=I;

definition
  let n be Element of NAT;
  let f be PartFunc of REAL,REAL n;
  attr f is bounded means


  for i be Element of NAT st i in Seg n holds (proj(i,n)*f) is bounded;
end;

definition
  let n be Element of NAT;
  let A be non empty closed_interval Subset of REAL;
  let f be PartFunc of REAL,REAL n;
  pred f is_integrable_on A means


  for i be Element of NAT st i in Seg n holds (proj(i,n)*f) is_integrable_on A;
end;

definition
  let n be Element of NAT;
  let A be non empty closed_interval Subset of REAL;
  let f be PartFunc of REAL,REAL n;
  func integral(f,A) -> Element of REAL n means


  dom it = Seg n & for i
  be Element of NAT st i in Seg n holds it.i = integral( (proj(i,n)*f), A);
end;

theorem 
  for n be Element of NAT, A be non empty closed_interval Subset of REAL, f be
  PartFunc of REAL,REAL n, g be Function of A,REAL n st f|A = g holds f
  is_integrable_on A iff g is integrable;

theorem 
  for n be Element of NAT, A be non empty closed_interval Subset of REAL, f be
  PartFunc of REAL,REAL n, g be Function of A,REAL n st f|A = g holds
  integral(f,A) = integral(g);

definition
  let a,b be real number;
  let n be Element of NAT;
  let f be PartFunc of REAL, REAL n;
  func integral(f,a,b) -> Element of REAL n means


  dom it = Seg n & for
  i be Element of NAT st i in Seg n holds it.i = integral( (proj(i,n)*f) ,a,b);
end;

begin 

theorem 
  for n, i be Element of NAT, f1,f2 be PartFunc of Z, REAL n holds
  proj(i,n)*(f1+f2) = proj(i,n)*f1 + proj(i,n)*f2 &
  proj(i,n)*(f1-f2) = proj(i,n)*f1 - proj(i,n)*f2;

theorem 
  for n,i be Element of NAT, r be Real, f be PartFunc of Z, REAL n
  holds proj(i,n)*(r(#)f) = r(#)(proj(i,n)*f);

theorem 
  for n be Element of NAT for A be non empty closed_interval Subset of REAL
  for f1
,f2 be PartFunc of REAL, REAL n st f1 is_integrable_on A & f2 is_integrable_on
A & A c= dom f1 & A c= dom f2 & (f1|A) is bounded & (f2|A) is bounded holds f1+
f2 is_integrable_on A & f1-f2 is_integrable_on A & integral(f1+f2,A)=integral(
  f1,A)+integral(f2,A) & integral(f1-f2,A)=integral(f1,A)-integral(f2,A);

theorem 
  for n be Element of NAT for r be Real
  for A be non empty closed_interval Subset
of REAL for f be PartFunc of REAL, REAL n st A c= dom f & f is_integrable_on A
  & f|A is bounded holds r(#)f is_integrable_on A & integral( (r(#)f) ,A) = r*
  integral(f,A);

theorem 
  for n be Element of NAT for f being PartFunc of REAL,REAL n, A being
  non empty closed_interval Subset of REAL, a,b be Real st A=[.a,b.]
   holds integral(f,A) = integral(f,a,b);

theorem 
  for n be Element of NAT for f being PartFunc of REAL,REAL n, A being
non empty closed_interval Subset of REAL, a,b be Real st A=[.b,a.]
 holds -integral(f,A) = integral(f,a,b);

theorem 
  for n being Nat, Z,x being set, f,g being PartFunc of Z,REAL n
  st x in dom (f+g) holds (f+g)/.x = (f/.x) + (g/.x);

theorem 
  for n being Nat, Z,x being set, f,g being PartFunc of Z,REAL n
  st x in dom (f-g) holds (f-g)/.x = (f/.x) - (g/.x);

theorem 
  for n being Nat, Z,x being set, f being PartFunc of Z,REAL n
  for r being real number
  st x in dom (r(#)f) holds (r(#)f)/.x = r* (f/.x);














begin 

reserve x, r for Real;

definition
  let A be set;
  attr A is symmetrical means


  for x being complex number st x in A holds -x in A;
end;

registration
  cluster symmetrical for Subset of COMPLEX;
end;

registration
  cluster symmetrical for Subset of REAL;
end;

reserve A for symmetrical Subset of COMPLEX;

definition
  let R be Relation;
  attr R is with_symmetrical_domain means


  dom R is symmetrical;
end;

registration
  cluster empty -> with_symmetrical_domain for Relation;
end;

registration
  let R be with_symmetrical_domain Relation;
  cluster dom R -> symmetrical;
end;

definition
  let X,Y be complex-membered set;
  let F be PartFunc of X, Y;
  attr F is quasi_even means


  for x st x in dom F & -x in dom F holds F. (-x)=F.x;
end;

definition
  let X,Y be complex-membered set;
  let F be PartFunc of X, Y;
  attr F is even means


  F is with_symmetrical_domain quasi_even;
end;

registration
  let X,Y be complex-membered set;
  cluster with_symmetrical_domain quasi_even -> even for PartFunc of X, Y;
  cluster even -> with_symmetrical_domain quasi_even for PartFunc of X, Y;
end;

definition
  let A be set;
  let X,Y be complex-membered set;
  let F be PartFunc of X, Y;
  pred F is_even_on A means


  A c= dom F & F|A is even;
end;

definition
  let X,Y be complex-membered set;
  let F be PartFunc of X, Y;
  attr F is quasi_odd means


  for x st x in dom F & -x in dom F holds F.( -x)=-F.x;
end;

definition
  let X,Y be complex-membered set;
  let F be PartFunc of X, Y;
  attr F is odd means


  F is with_symmetrical_domain quasi_odd;
end;

registration
  let X,Y be complex-membered set;
  cluster with_symmetrical_domain quasi_odd -> odd for PartFunc of X, Y;
  cluster odd -> with_symmetrical_domain quasi_odd for PartFunc of X, Y;
end;

definition
  let A be set;
  let X,Y be complex-membered set;
  let F be PartFunc of X, Y;
  pred F is_odd_on A means


  A c= dom F & F|A is odd;
end;

reserve F,G for PartFunc of REAL, REAL;

theorem 
  F is_odd_on A iff (A c= dom F & for x st x in A holds F.x+F.(-x)=0);

theorem 
  F is_even_on A iff (A c= dom F & for x st x in A holds F.x-F.(-x)=0);

theorem 
  (F is_odd_on A & for x st x in A holds F.x<>0) implies (A c= dom F &
  for x st x in A holds F.x / F.(-x)=-1);

theorem 
  (A c= dom F & for x st x in A holds F.x / F.(-x)=-1) implies F is_odd_on A;

theorem 
  (F is_even_on A & for x st x in A holds F.x<>0 ) implies (A c= dom F &
  for x st x in A holds F.x / F.(-x)=1);

theorem 
  (A c= dom F & for x st x in A holds F.x / F.(-x)=1) implies F is_even_on A;

theorem 
  F is_even_on A & F is_odd_on A implies for x st x in A holds F.x=0;

theorem 
  F is_even_on A implies for x st x in A holds F.x = F.(abs x);

theorem 
  (A c= dom F & for x st x in A holds F.x = F.(abs x)) implies F is_even_on A;

theorem 
  F is_odd_on A & G is_odd_on A implies F + G is_odd_on A;

theorem 
  F is_even_on A & G is_even_on A implies F + G is_even_on A;

theorem 
  F is_odd_on A & G is_odd_on A implies F - G is_odd_on A;

theorem 
  F is_even_on A & G is_even_on A implies F - G is_even_on A;

theorem 
  F is_odd_on A implies r (#) F is_odd_on A;

theorem 
  F is_even_on A implies r (#) F is_even_on A;

theorem 
  F is_odd_on A implies -F is_odd_on A;

theorem 
  F is_even_on A implies -F is_even_on A;

theorem 
  F is_odd_on A implies F" is_odd_on A;

theorem 
  F is_even_on A implies F" is_even_on A;

theorem 
  F is_odd_on A implies |. F .| is_even_on A;

theorem 
  F is_even_on A implies |. F .| is_even_on A;

theorem 
  F is_odd_on A & G is_odd_on A implies F (#) G is_even_on A;

theorem 
  F is_even_on A & G is_even_on A implies F (#) G is_even_on A;

theorem 
  F is_even_on A & G is_odd_on A implies F (#) G is_odd_on A;

theorem 
  F is_even_on A implies r+F is_even_on A;

theorem 
  F is_even_on A implies F-r is_even_on A;

theorem 
  F is_even_on A implies F^2 is_even_on A;

theorem 
  F is_odd_on A implies F^2 is_even_on A;

theorem 
  F is_odd_on A & G is_odd_on A implies F /" G is_even_on A;

theorem 
  F is_even_on A & G is_even_on A implies F /" G is_even_on A;

theorem 
  F is_odd_on A & G is_even_on A implies F /" G is_odd_on A;

theorem 
  F is_even_on A & G is_odd_on A implies F /" G is_odd_on A;

theorem 
  F is odd implies -F is odd;

theorem 
  F is even implies -F is even;

theorem 
  F is odd implies F" is odd;

theorem 
  F is even implies F" is even;

theorem 
  F is odd implies |. F .| is even;

theorem 
  F is even implies |. F .| is even;

theorem 
  F is odd implies F^2 is even;

theorem 
  F is even implies F^2 is even;

theorem 
  F is even implies r+F is even;

theorem 
  F is even implies F-r is even;

theorem 
  F is odd implies r (#) F is odd;

theorem 
  F is even implies r (#) F is even;

theorem 
  F is odd & G is odd & dom F /\ dom G is symmetrical implies F + G is odd;

theorem 
  F is even & G is even & dom F /\ dom G is symmetrical implies F + G is even;

theorem 
  F is odd & G is odd & dom F /\ dom G is symmetrical implies F - G is odd;

theorem 
  F is even & G is even & dom F /\ dom G is symmetrical implies F - G is even;

theorem 
  F is odd & G is odd & dom F /\ dom G is symmetrical implies F (#) G is even;

theorem 
  F is even & G is even & dom F /\ dom G is symmetrical implies F (#) G is even
;

theorem 
  F is even & G is odd & dom F /\ dom G is symmetrical implies F (#) G is odd;

theorem 
  F is odd & G is odd & dom F /\ dom G is symmetrical implies F /" G is even;

theorem 
  F is even & G is even & dom F /\ dom G is symmetrical implies F /" G is even;

theorem 
  F is odd & G is even & dom F /\ dom G is symmetrical implies F /" G is odd;

theorem 
  F is even & G is odd & dom F /\ dom G is symmetrical implies F /" G is odd;

begin 

definition
  func signum -> Function of REAL, REAL means


  for x being Real holds it .x = sgn x;
end;

theorem 
  for x being real number st x > 0 holds signum.x = 1;

theorem 
  for x being real number st x < 0 holds signum.x = -1;

theorem 
  signum.0 = 0;

theorem 
  for x being real number holds signum.(-x) = -signum.x;

theorem 
  for A being symmetrical Subset of REAL holds signum is_odd_on A;

theorem 
  for x being real number st x >= 0 holds absreal.x = x;

theorem 
  for x being real number st x < 0 holds absreal.x = -x;

theorem 
  for x being real number holds absreal.(-x) = absreal.x;

theorem 
  for A being symmetrical Subset of REAL holds absreal is_even_on A;

theorem 
  for A being symmetrical Subset of REAL holds sin is_odd_on A;

theorem 
  for A being symmetrical Subset of REAL holds cos is_even_on A;

registration
  cluster sin -> odd;
end;

registration
  cluster cos -> even;
end;

theorem 
  for A being symmetrical Subset of REAL holds sinh is_odd_on A;

theorem 
  for A being symmetrical Subset of REAL holds cosh is_even_on A;

registration
  cluster sinh -> odd;
end;

registration
  cluster cosh -> even;
end;

theorem 
  A c= ].-PI/2,PI/2.[ implies tan is_odd_on A;

theorem 
  A c= dom tan implies tan is_odd_on A;

theorem 
  A c= dom cot implies cot is_odd_on A;

theorem 
  A c= [.-1,1.] implies arctan is_odd_on A;

theorem 
  for A being symmetrical Subset of REAL holds |. sin .| is_even_on A;

theorem 
  for A being symmetrical Subset of REAL holds |. cos .| is_even_on A;

theorem 
  for A being symmetrical Subset of REAL holds sin" is_odd_on A;

theorem 
  for A being symmetrical Subset of REAL holds cos" is_even_on A;

theorem 
  for A being symmetrical Subset of REAL holds -sin is_odd_on A;

theorem 
  for A being symmetrical Subset of REAL holds -cos is_even_on A;

theorem 
  for A being symmetrical Subset of REAL holds sin^2 is_even_on A;

theorem 
  for A being symmetrical Subset of REAL holds cos^2 is_even_on A;

reserve B for symmetrical Subset of REAL;

theorem 
  B c= dom (sec) implies sec is_even_on B;

theorem 
  (for x being real number st x in B holds cos.x<>0) implies sec is_even_on B;

theorem 
  B c= dom (cosec) implies cosec is_odd_on B;

theorem 
  (for x being real number st x in B holds sin.x<>0) implies cosec is_odd_on B;















begin

reserve x, y, X for set;
reserve E for non empty set;
reserve e for Element of E;
reserve u, u1, v, v1, v2, w, w9, w1, w2 for Element of E^omega;
reserve F for Subset of E^omega;
reserve i, k, l for Nat;
reserve TS for non empty transition-system over F;

reserve S, T for Subset of TS;



theorem 
  i >= k + l implies i >= k;



theorem 
  for a, b being FinSequence holds a ^ b = a or b ^ a = a implies b = {};

theorem 
  for p, q being FinSequence st k in dom p & len p + 1 = len q
  holds k + 1 in dom q;



theorem 
  len u = 1 implies ex e st <%e%> = u & e = u.0;

theorem 
  k <> 0 & len u <= k + 1 implies ex v1, v2 st len v1 <= k & len v2
  <= k & u = v1^v2;

theorem 
  for p, q being XFinSequence st <%x%>^p = <%y%>^q holds x = y & p = q;

theorem 
  len u > 0 implies ex e, u1 st u = <%e%>^u1;



registration
  let E;
  cluster Lex(E) -> non empty;
end;

theorem 
  not <%>E in Lex(E);

theorem 
  u in Lex(E) iff len u = 1;

theorem 
  u <> v & u in Lex(E) & v in Lex(E) implies not ex w st u^w = v or w^u = v;



theorem 
  for TS being transition-system over Lex E
   holds the Tran of TS is Function implies TS is deterministic;




definition
  let E, F, TS;
  func _bool TS -> strict transition-system over Lex(E) means


  the
carrier of it = bool (the carrier of TS) & for S, w, T holds [[S, w], T] in the
  Tran of it iff len w = 1 & T = w-succ_of (S, TS);
end;

registration
  let E, F, TS;
  cluster _bool TS -> non empty deterministic;
end;

registration
  let E, F;
  let TS be finite non empty transition-system over F;
  cluster _bool TS -> finite;
end;

theorem 
  x, <%e%> ==>* y, <%>E, _bool TS implies x, <%e%> ==>. y, <%>E, _bool TS;

theorem 
  len w = 1 implies (X = w-succ_of (S, TS) iff S, w ==>* X, _bool TS);



definition
  let E, F;
  struct (transition-system over F) semiautomaton over F (# carrier -> set,
Tran -> Relation of [: the carrier, F :], the carrier, InitS -> Subset of the
    carrier #);
end;

definition
  let E, F;
  let SA be semiautomaton over F;
  attr SA is deterministic means


  (the transition-system of SA) is deterministic & card (the InitS of SA) = 1;
end;

registration
  let E, F;
  cluster strict non empty finite deterministic for semiautomaton over F;
end;

reserve SA for non empty semiautomaton over F;

registration
  let E, F, SA;
  cluster the transition-system of SA -> non empty;
end;

definition
  let E, F, SA;
  func _bool SA -> strict semiautomaton over Lex(E) means


  the
transition-system of it = _bool the transition-system of SA & the InitS of it =
  { <%>E-succ_of (the InitS of SA, SA) };
end;

registration
  let E, F, SA;
  cluster _bool SA -> non empty deterministic;
end;

theorem 
  the carrier of _bool SA = bool the carrier of SA;

registration
  let E, F;
  let SA be finite non empty semiautomaton over F;
  cluster _bool SA -> finite;
end;



definition
  let E, F, SA;
  let Q be Subset of SA;
  func left-Lang(Q) -> Subset of E^omega equals

  { w : Q meets w-succ_of (the
  InitS of SA, SA) };
end;

theorem 
  for Q being Subset of SA holds w in left-Lang(Q) iff Q meets w
  -succ_of (the InitS of SA, SA);



definition
  let E, F;
  struct (semiautomaton over F) automaton over F (# carrier -> set, Tran ->
Relation of [: the carrier, F :], the carrier, InitS -> Subset of the carrier,
    FinalS -> Subset of the carrier #);
end;

definition
  let E, F;
  let A be automaton over F;
  attr A is deterministic means


  (the semiautomaton of A) is deterministic;
end;

registration
  let E, F;
  cluster strict non empty finite deterministic for automaton over F;
end;

reserve A for non empty automaton over F;
reserve p, q for Element of A;

registration
  let E, F, A;
  cluster the transition-system of A -> non empty;
  cluster the semiautomaton of A -> non empty;
end;

definition
  let E, F, A;
  func _bool A -> strict automaton over Lex(E) means


  the semiautomaton
  of it = _bool the semiautomaton of A & the FinalS of it = { Q where Q is
  Element of it : Q meets (the FinalS of A) };
end;

registration
  let E, F, A;
  cluster _bool A -> non empty deterministic;
end;

theorem 
  the carrier of _bool A = bool the carrier of A;

registration
  let E, F;
  let A be finite non empty automaton over F;
  cluster _bool A -> finite;
end;



definition
  let E, F, A;
  let Q be Subset of A;
  func right-Lang(Q) -> Subset of E^omega equals

  { w : w-succ_of (Q, A) meets
  (the FinalS of A) };
end;

theorem 
  for Q being Subset of A holds w in right-Lang(Q) iff w-succ_of (
  Q, A) meets (the FinalS of A);

definition
  let E, F, A;
  func Lang(A) -> Subset of E^omega equals

  { u : ex p, q st p in the InitS of
  A & q in the FinalS of A & p, u ==>* q, A };
end;

theorem 
  w in Lang(A) iff ex p, q st p in the InitS of A & q in the
  FinalS of A & p, w ==>* q, A;

theorem 
  w in Lang(A) iff w-succ_of (the InitS of A, A) meets (the FinalS of A);

theorem 
  Lang(A) = left-Lang(the FinalS of A);

theorem 
  Lang(A) = right-Lang(the InitS of A);




reserve TS for non empty transition-system over Lex(E) \/ {<%>E};

theorem 
  for R being RedSequence of ==>.-relation(TS) st (R.1)`2 = <%e%>^
  u & (R.len R)`2 = <%>E holds (R.2)`2 = <%e%>^u or (R.2)`2 = u;

theorem 
  for R being RedSequence of ==>.-relation(TS) st (R.1)`2 = u & (R
  .len R)`2 = <%>E holds len R > len u;

theorem 
  for R being RedSequence of ==>.-relation(TS) st (R.1)`2 = u^v &
  (R.len R)`2 = <%>E ex l st l in dom R & (R.l)`2 = v;

definition
  let E, u, v;
  func chop(u, v) -> Element of E^omega means


  for w st w^v = u holds it = w if ex w st w^v = u otherwise it = u;
end;

theorem 
  for p being RedSequence of ==>.-relation(TS) st p.1 = [x, u^w] &
p.len p = [y, v^w] ex q being RedSequence of ==>.-relation(TS) st q.1 = [x, u]
  & q.len q = [y, v];

theorem 
  ==>.-relation(TS) reduces [x, u^w], [y, v^w] implies
  ==>.-relation(TS) reduces [x, u], [y, v];

theorem 
  x, u^w ==>* y, v^w, TS implies x, u ==>* y, v, TS;

theorem 
  for p, q being Element of TS st p, u^v ==>* q, TS holds ex r
  being Element of TS st p, u ==>* r, TS & r, v ==>* q, TS;

theorem 
  w^v-succ_of (X, TS) = v-succ_of (w-succ_of (X, TS), TS);

theorem 
  _bool TS is non empty transition-system over Lex(E) \/ {<%>E};

theorem 
  w-succ_of ({ v-succ_of (X, TS) }, _bool TS) = { v^w-succ_of (X, TS) };

reserve SA for non empty semiautomaton over Lex(E) \/ {<%>E};

theorem 
  w-succ_of ({ <%>E-succ_of (X, SA) }, _bool SA) = { w-succ_of (X, SA) };

reserve A for non empty automaton over Lex(E) \/ {<%>E};
reserve P for Subset of A;

theorem 
  x in the FinalS of A & x in P implies P in the FinalS of _bool A;

theorem 
  X in the FinalS of _bool A implies X meets the FinalS of A;

theorem 
  the InitS of _bool A = { <%>E-succ_of (the InitS of A, A) };

theorem 
  w-succ_of ({ <%>E-succ_of (X, A) }, _bool A) = { w-succ_of (X, A ) };

theorem 
  w-succ_of (the InitS of _bool A, _bool A) = { w-succ_of (the InitS of A, A) }
;

theorem 
  Lang(A) = Lang(_bool A);

theorem 
  for A being non empty automaton over Lex(E) \/ {<%>E} ex DA being non
  empty deterministic automaton over Lex(E) st Lang(A) = Lang(DA);

theorem 
  for FA being non empty finite automaton over Lex(E) \/ {<%>E} ex DFA
being non empty deterministic finite automaton over Lex(E) st Lang(FA) = Lang(
  DFA);














begin 

reserve T,T1,T2 for TopSpace,
  A,B for Subset of T,
  F for Subset of T|A,
  G,G1, G2 for Subset-Family of T,
  U,W for open Subset of T|A,
  p for Point of T|A,
  n for Nat,
  I for Integer;

theorem 
  F = B/\A implies Fr F c= Fr B/\A;

theorem 
  T is normal iff for A,B be closed Subset of T st A misses B ex U,
  W be open Subset of T st A c=U & B c=W & Cl U misses Cl W;




definition
  let T;
  func Seq_of_ind T -> SetSequence of ((bool the carrier of T) qua set)
       means


  it.0
= { {}T } & ( A in it.(n+1) iff A in it.n or for p,U st p in U ex W st p in W &
  W c=U & Fr W in it.n);
end;

registration
  let T;
  cluster Seq_of_ind T -> non-descending;
end;

theorem 
  for F st F = B holds F in (Seq_of_ind T|A).n iff B in (Seq_of_ind T).n;

definition
  let T,A;
  attr A is with_finite_small_inductive_dimension means


  ex n st A in ( Seq_of_ind T).n;
end;

notation
  let T,A;
  synonym A is finite-ind for A is with_finite_small_inductive_dimension;
end;

definition
  let T,G;
  attr G is with_finite_small_inductive_dimension means


  ex n st G c=( Seq_of_ind T).n;
end;

notation
  let T,G;
  synonym G is finite-ind for G is with_finite_small_inductive_dimension;
end;

theorem 
  A in G & G is finite-ind implies A is finite-ind;

registration
  let T;
  cluster finite -> finite-ind for Subset of T;
  cluster empty -> finite-ind for Subset-Family of T;
  cluster non empty finite-ind for Subset-Family of T;
end;

registration
  let T be non empty TopSpace;
  cluster non empty finite-ind for Subset of T;
end;

definition
  let T;
  attr T is with_finite_small_inductive_dimension means


  [#]T is with_finite_small_inductive_dimension;
end;

notation
  let T;
  synonym T is finite-ind for T is with_finite_small_inductive_dimension;
end;

registration
  cluster empty -> finite-ind for TopSpace;
end;

registration
  let X be set;
  cluster 1TopSp X -> finite-ind;
end;

registration
  cluster non empty finite-ind for TopSpace;
end;

reserve Af for finite-ind Subset of T,
  Tf for finite-ind TopSpace;

begin 

definition
  let T;
  let A such that
 A is finite-ind;
  func ind A -> Integer means


  A in (Seq_of_ind T).(it+1) & not A in ( Seq_of_ind T).it;
end;

theorem 
  -1 <= ind Af;

theorem 
  ind Af = -1 iff Af is empty;

registration
  let T be non empty TopSpace;
  let A be non empty finite-ind Subset of T;
  cluster ind A -> natural;
end;

theorem 
  ind Af <= n-1 iff Af in (Seq_of_ind T).n;

theorem 
  for A be finite Subset of T holds ind A < card A;

theorem 
  ind Af <= n iff for p be Point of T|Af,U be open Subset of T|Af
st p in U ex W be open Subset of T|Af st p in W & W c= U & Fr W is finite-ind &
  ind Fr W <= n-1;

definition
  let T;
  let G such that
 G is finite-ind;
  func ind G -> Integer means


  G c= (Seq_of_ind T).(it+1) & -1<=it & for
  i be Integer st-1<=i & G c= (Seq_of_ind T).(i+1) holds it<=i;
end;

theorem 
  ind G = -1 & G is finite-ind iff G c= {{}T};

theorem 
  G is finite-ind & ind G <= I iff -1 <= I & for A st A in G holds
  A is finite-ind & ind A <= I;

theorem 
  G1 is finite-ind & G2 c= G1 implies G2 is finite-ind & ind G2 <= ind G1;

registration
  let T;
  let G1,G2 be finite-ind Subset-Family of T;
  cluster G1 \/ G2 -> finite-ind for Subset-Family of T;
end;

theorem 
  G is finite-ind & G1 is finite-ind & ind G <= I & ind G1 <= I implies
  ind (G\/G1) <= I;

definition
  let T;
  func ind T -> Integer equals

  ind [#]T;
end;

registration
  let T be non empty finite-ind TopSpace;
  cluster ind T -> natural;
end;

theorem 
  for X be non empty set holds ind 1TopSp X = 0;

theorem 
  (ex n st for p be Point of T,U be open Subset of T st p in U ex
W be open Subset of T st p in W & W c= U & Fr W is finite-ind & ind Fr W <= n-1
  ) implies T is finite-ind;

theorem 
  ind Tf <= n iff for p be Point of Tf,U be open Subset of Tf st p
in U ex W be open Subset of Tf st p in W & W c= U & Fr W is finite-ind & ind Fr
  W <= n-1;

begin 

registration
  let Tf;
  cluster -> finite-ind for Subset of Tf;
end;

registration
  let T,Af;
  cluster T|Af -> finite-ind;
end;



theorem 
  ind T|Af = ind Af;

theorem 
  T|A is finite-ind implies A is finite-ind;

theorem 
  A c= Af implies A is finite-ind & ind A <= ind Af;

theorem 
  for A be Subset of Tf holds ind A <= ind Tf;

theorem 
  F = B & B is finite-ind implies F is finite-ind & ind F = ind B;

theorem 
  F = B & F is finite-ind implies B is finite-ind & ind F = ind B;



theorem 
  for T be non empty TopSpace st T is regular holds T is finite-ind &
  ind T <= n iff for A be closed Subset of T,p be Point of T st not p in A ex L
  be Subset of T st L separates{p},A & L is finite-ind & ind L <= n-1;

theorem 
  T1,T2 are_homeomorphic implies (T1 is finite-ind iff T2 is finite-ind);

theorem 
  T1,T2 are_homeomorphic & T1 is finite-ind implies ind T1 = ind T2;

theorem 
  for A1 be Subset of T1,A2 be Subset of T2 st A1,A2
  are_homeomorphic holds A1 is finite-ind iff A2 is finite-ind;

theorem 
  for A1 be Subset of T1,A2 be Subset of T2 st A1,A2 are_homeomorphic &
  A1 is finite-ind holds ind A1 = ind A2;

theorem 
  [:T1,T2:] is finite-ind implies [:T2,T1:] is finite-ind & ind [:T1,T2
  :] = ind [:T2,T1:];

theorem 
  for Ga be Subset-Family of T|A st Ga is finite-ind & Ga = G holds G is
  finite-ind & ind G = ind Ga;

theorem 
  for Ga be Subset-Family of T|A st G is finite-ind & Ga = G holds Ga is
  finite-ind & ind G = ind Ga;

begin 


theorem 
  T is finite-ind & ind T <= n iff ex Bas be Basis of T st for A
  st A in Bas holds Fr A is finite-ind & ind Fr A <= n-1;



theorem 
  for T st T is T_1 & for A,B be closed Subset of T st A misses B
ex A9,B9 be closed Subset of T st A9 misses B9 & A9\/B9 = [#]T & A c= A9 & B c=
  B9 holds T is finite-ind & ind T <= 0;

theorem 
  for X be set,f be SetSequence of X ex g be SetSequence of X st
union rng f = union rng g & (for i,j be Nat st i<>j holds g.i misses g.j) & for
n ex fn be finite Subset-Family of X st fn={f.i where i is Element of NAT:i<n}
  & g.n=f.n \ union fn;



theorem 
  for T st T is finite-ind & ind T<=0 & T is Lindelof for A,B be
closed Subset of T st A misses B ex A9,B9 be closed Subset of T st A9 misses B9
  & A9\/B9 = [#]T & A c= A9 & B c= B9;



theorem 
  for T st T is T_1 & T is Lindelof holds T is finite-ind & ind T
  <= 0 iff for A,B be closed Subset of T st A misses B holds {}T separates A,B;

theorem 
  for T st T is T_4 & T is Lindelof & ex F be Subset-Family of T st F is
closed & F is Cover of T & F is countable & F is finite-ind & ind F <= 0 holds
  T is finite-ind & ind T<=0;

reserve TM for metrizable TopSpace;



theorem 
  for A,B be closed Subset of TM st A misses B for Null be
  finite-ind Subset of TM st ind Null<=0 & TM|Null is second-countable ex L be
  Subset of TM st L separates A,B & L misses Null;



theorem 
  for Null be Subset of TM st TM|Null is second-countable holds
  Null is finite-ind & ind Null<=0 iff for p be Point of TM,U be open Subset of
  TM st p in U ex W be open Subset of TM st p in W & W c=U & Null misses Fr W;



theorem 
  for Null be Subset of TM st TM|Null is second-countable holds
Null is finite-ind & ind Null<=0 iff ex B be Basis of TM st for A be Subset of
  TM st A in B holds Null misses Fr A;



theorem 
  for Null,A be Subset of TM st TM|Null is second-countable & Null is
finite-ind & A is finite-ind & ind Null<=0 holds A\/Null is finite-ind & ind(A
  \/Null)<=ind A+1;














begin 

reserve G for Group;
reserve A,B for non empty Subset of G;
reserve N,H,H1,H2 for Subgroup of G;
reserve x,a,b for Element of G;

theorem 
  for N be normal Subgroup of G,x1,x2 be Element of G holds
  (x1 * N) * (x2 * N) = (x1 * x2) * N;

theorem 
  for G being Group,N being Subgroup of G, x, y being Element of G
   st y in x * N holds x * N = y * N;

theorem 
  for N being Subgroup of G,H being Subgroup of G,
      x being Element of G st x * N meets carr(H)
   ex y being Element of G st y in x * N & y in H;

theorem 
  for x,y being Element of G, N be normal Subgroup of G
  st y in N holds x * y * x" in N;

theorem 
  for N be Subgroup of G
   st for x,y being Element of G st y in N holds x * y * x" in N
   holds N is normal;

theorem 
  x in H1 * H2 iff ex a,b st x = a * b & a in H1 & b in H2;

theorem 
  for G being Group, N1,N2 being strict normal Subgroup of G
   ex M being strict Subgroup of G st the carrier of M = N1 * N2;

theorem 
  for G being Group, N1,N2 being strict normal Subgroup of G
  ex M being strict normal Subgroup of G st the carrier of M = N1 * N2;

theorem 
  for G being Group, N,N1,N2 being Subgroup of G st
  the carrier of N = N1 * N2 holds N1 is Subgroup of N & N2 is Subgroup of N;

theorem 
  for N,N1,N2 be normal Subgroup of G,a,b be Element of G st
  the carrier of N = N1 * N2 holds (a * N1) * (b * N2) = (a * b) * N;

theorem 
  for N being normal Subgroup of G for x holds x * N * x" c= carr(N);

definition
  let G be Group, A be Subset of G;
  let N be Subgroup of G;
  func N ` A -> Subset of G equals

  {x where x is Element of G: x * N c= A};
  func N ~ A -> Subset of G equals

  {x where x is Element of G : x * N meets A};
end;

theorem 
  for x being Element of G st x in N ` A holds x * N c= A;

theorem 
  for x being Element of G st  x * N c= A holds x in N ` A;

theorem 
  for x being Element of G st x in N ~ A holds x * N meets A;

theorem 
  for x being Element of G st x * N meets A holds x in N ~ A;

theorem 
  N ` A c= A;

theorem 
  A c= N ~ A;

theorem 
  N ` A c= N ~ A;

theorem 
  N ~ (A \/ B) = N ~ A \/ N ~ B;

theorem 
  N ` (A /\ B) = N ` A /\ N ` B;

theorem 
  A c= B implies N ` A c= N ` B;

theorem 
  A c= B implies N ~ A c= N ~ B;

theorem 
  N ` A \/ N ` B c= N ` (A \/ B);

theorem 
  N ~ (A \/ B)= N ~ A \/ N ~ B;

theorem 
  N is Subgroup of H implies H ` A c= N ` A;

theorem 
   N is Subgroup of H implies N ~ A c= H ~ A;

theorem 
  for G be Group, A,B be non empty Subset of G, N be normal Subgroup of G
   holds N ` A * N ` B c= N ` (A * B);

theorem 
  for x being Element of G st x in N ~ (A * B) holds x * N meets A * B;

theorem 
  for G be Group, A,B be non empty Subset of G, N be normal Subgroup of G
  holds N ~ A * N ~ B = N ~ (A * B);

theorem 
  for x being Element of G st x in N ~ (N ` (N ~ A))
  holds x * N meets N ` (N ~ A);

theorem 
  for x being Element of G st x in N ` (N ~ A) holds x * N c= N ~ A;

theorem 
  for x being Element of G st x in N ~ (N ~ A) holds x * N meets N ~ A;

theorem 
  for x being Element of G st x in N ~ (N ` A) holds x * N meets N ` A;

theorem 
  N ` (N ` A) = N ` A;

theorem 
  N ~ A = N ~ (N ~ A);

theorem 
  N ` (N ` A) c= N ~ (N ~ A);

theorem 
  N ~ (N ` A) c= A;

theorem 
  N ` (N ~ (N ` A)) = N ` A;

theorem 
  A c= N ` (N ~ A) implies N ~ A c= N ~ (N `(N ~ A));

theorem 
  N ~ (N `(N ~ A)) = N ~ A;

theorem 
  for x being Element of G st x in N ` (N ` A) holds x * N c= N ` A;

theorem 
  N `(N ` A) = N ~ (N ` A);

theorem 
  N ~ (N ~ A) = N `(N ~ A);

theorem 
  for N,N1,N2 be Subgroup of G st N = N1 /\ N2 holds N ~ A c= N1 ~ A /\ N2 ~ A;

theorem 
  for N,N1,N2 be Subgroup of G st N = N1 /\ N2 holds N1 ` A /\ N2 ` A c= N ` A;

theorem 
  for N1,N2 be strict normal Subgroup of G
  ex N being strict normal Subgroup of G
   st the carrier of N = N1 * N2 & N ` A c= N1 ` A /\ N2 ` A;

theorem 
  for N1,N2 be strict normal Subgroup of G ex N being strict normal
  Subgroup of G st the carrier of N = N1 * N2 & N1 ~ A \/ N2 ~ A c= N ~ A;

theorem 
  for N1,N2 be strict normal Subgroup of G
  ex N being strict normal Subgroup of G st the carrier of N = N1 * N2 &
  N ~ A c= ((N1 ~ A) * N2) /\ ((N2 ~ A) * N1);

reserve N1,N2 for Subgroup of G;

definition
  let G be Group, H, N be Subgroup of G;
  func N ` H -> Subset of G equals

  {x where x is Element of G: x * N c= carr(H)};
  func N ~ H -> Subset of G equals

  {x where x is Element of G : x * N meets carr(H)};
end;

theorem 
  for x being Element of G st x in N ` H holds x * N c= carr(H);

theorem 
  for x being Element of G st x * N c= carr(H) holds x in N ` H;

theorem 
  for x being Element of G st x in N ~ H holds x * N meets carr(H);

theorem 
  for x being Element of G st x * N meets carr(H) holds x in N ~ H;

theorem 
  N ` H c= carr(H);

theorem 
  carr(H) c= N ~ H;

theorem 
  N ` H c= N ~ H;

theorem 
   H1 is Subgroup of H2 implies N ~ H1 c= N ~ H2;

theorem 
  N1 is Subgroup of N2 implies N1 ~ H c= N2 ~ H;

theorem 
  N1 is Subgroup of N2 implies N1 ~ N1 c= N2 ~ N2;

theorem 
  H1 is Subgroup of H2 implies N ` H1 c= N ` H2;

theorem 
  N1 is Subgroup of N2 implies N2 ` H c= N1 ` H;

theorem 
  N1 is Subgroup of N2 implies N2 ` N1 c= N1 ` N2;

theorem 
  for N be normal Subgroup of G holds N ` H1 * N ` H2 c= N ` (H1 * H2);

theorem 
  for N be normal Subgroup of G holds N ~ H1 * N ~ H2 = N ~ (H1 * H2);

theorem 
  for N,N1,N2 be Subgroup of G st N = N1 /\ N2 holds N ~ H c= N1 ~ H /\ N2 ~ H;

theorem 
  for N,N1,N2 be Subgroup of G st N = N1 /\ N2 holds N1 ` H /\ N2 ` H c= N ` H;

theorem 
  for N1,N2 be strict normal Subgroup of G holds ex N being strict normal
  Subgroup of G st the carrier of N = N1 * N2 & N ` H c= N1 ` H /\ N2 ` H;

theorem 
  for N1,N2 be strict normal Subgroup of G ex N being strict normal
  Subgroup of G st the carrier of N = N1 * N2 & N1 ~ H \/ N2 ~ H c= N ~ H;

theorem 
  for N1,N2 be strict normal Subgroup of G
  ex N being strict normal Subgroup of G st
    the carrier of N = N1 * N2 & N1 ` H * N2 ` H c= N ` H;

theorem 
  for N1,N2 be strict normal Subgroup of G
  ex N being strict normal Subgroup of G st
  the carrier of N = N1 * N2 & N1 ~ H * N2 ~ H c= N ~ H;

theorem 
  for N1,N2 be strict normal Subgroup of G
  ex N being strict normal Subgroup of G st the carrier of N = N1 * N2 &
  N ~ H c= ((N1 ~ H) * N2) /\ ((N2 ~ H) * N1);

theorem 
  for H being Subgroup of G, N being normal Subgroup of G
  ex M being strict Subgroup of G st the carrier of M = N ~ H;

theorem 
  for H being Subgroup of G, N being normal Subgroup of G st N is Subgroup of H
  ex M being strict Subgroup of G st the carrier of M = N ` H;

theorem 
  for H,N be normal Subgroup of G
   ex M being strict normal Subgroup of G st the carrier of M = N ~ H;

theorem 
  for H,N being normal Subgroup of G st N is Subgroup of H
  ex M being strict normal Subgroup of G st the carrier of M = N ` H;

theorem 
  for N,N1 be normal Subgroup of G st N1 is Subgroup of N
  ex N2,N3 being strict normal Subgroup of G st
  the carrier of N2 = N1 ~ N & the carrier of N3 = N1 ` N &
  N2 ` N c= N3 ` N;

theorem 
  for N,N1 be normal Subgroup of G st N1 is Subgroup of N
  ex N2,N3 being strict normal Subgroup of G st
  the carrier of N2 = N1 ~ N & the carrier of N3 = N1 ` N &
  N3 ~ N c= N2 ~ N;

theorem 
  for N,N1 be normal Subgroup of G st N1 is Subgroup of N
  ex N2,N3 being strict normal Subgroup of G
  st the carrier of N2 = N1 ~ N & the carrier of N3 = N1 ` N &
  N2 ` N c= N3 ~ N;

theorem 
  for N,N1 be normal Subgroup of G st N1 is Subgroup of N
  ex N2,N3 being strict normal Subgroup of G st
  the carrier of N2 = N1 ~ N & the carrier of N3 = N1 ` N &
  N3 ` N c= N2 ~ N;

theorem 
  for N,N1,N2 be normal Subgroup of G st N1 is Subgroup of N2
  ex N3,N4 being strict normal Subgroup of G st
  the carrier of N3 = N ~ N1 & the carrier of N4 = N ~ N2 &
  N3 ~ N1 c= N4 ~ N1;

theorem 
  for N,N1 be normal Subgroup of G ex N2 being strict normal Subgroup of G st
  the carrier of N2 = N ` N & N ` N1 c= N2 ` N1;

theorem 
  for N,N1 be normal Subgroup of G ex N2 being strict normal Subgroup of G st
  the carrier of N2 = N ~ N & N ~ N1 c= N2 ~ N1;














begin 

reserve n for Nat,
        X for set,
        Fx,Gx for Subset-Family of X;

definition
  let X,Fx;
  attr Fx is finite-order means

  ex n st for Gx st Gx c=Fx & n in card Gx holds meet Gx is empty;
end;

registration
  let X;
  cluster finite-order for Subset-Family of X;
  cluster finite -> finite-order for Subset-Family of X;
end;

definition
  let X,Fx;
  func order Fx -> ext-real number means

  (for Gx st it+1 in card Gx & Gx c= Fx holds meet Gx is empty)
    & ex Gx st Gx c= Fx & card Gx = it+1 &
  (meet Gx is non empty or Gx is empty) if Fx is finite-order
  otherwise it = +infty;
end;

registration
  let X;
  let F be finite-order Subset-Family of X;
  cluster order F + 1 -> natural;
  cluster order F -> integer;
end;

theorem 
  order Fx <= n implies Fx is finite-order;

theorem 
  order Fx <= n implies
    for Gx st Gx c= Fx & n+1 in card Gx holds meet Gx is empty;

theorem 
  (for G be finite Subset-Family of X st G c=Fx & n+1<card G holds
     meet G is empty) implies order Fx <= n;

begin 

reserve TM for metrizable TopSpace,
        TM1,TM2 for finite-ind second-countable metrizable TopSpace,
        A,B,L,H for Subset of TM,
        U,W for open Subset of TM,
        p for Point of TM,

        F,G for finite Subset-Family of TM,
        I for Integer;



theorem 
  for TM st TM is second-countable &
    ex F st F is closed & F is Cover of TM & F is countable &
       F is finite-ind & ind F <= n
  holds TM is finite-ind & ind TM <= n;



theorem 
  for A,B be finite-ind Subset of TM st A is closed &
  TM| (A\/B) is second-countable & ind A<=I & ind B<=I holds
  ind(A\/B)<=I & A\/B is finite-ind;



theorem 
  for TM st TM is second-countable & TM is finite-ind & ind TM<=n
    ex A,B st [#]TM = A\/B & A misses B & ind A <= n-1 & ind B <= 0;



theorem 
  for TM st TM is second-countable finite-ind & ind TM <= I
  ex F st F is Cover of TM & F is finite-ind & ind F <= 0 & card F <= I+1
         & for A,B st A in F & B in F & A meets B holds A = B;



theorem 
  for TM st TM is second-countable &
    ex F st F is Cover of TM & F is finite-ind & ind F<=0 & card F <= I+1
  holds TM is finite-ind & ind TM <= I;

registration
  let TM be second-countable metrizable TopSpace;
  let A,B be finite-ind Subset of TM;
  cluster A\/B -> finite-ind for Subset of TM;
end;



theorem 
  A is finite-ind & B is finite-ind & TM| (A\/B) is second-countable
    implies A\/B is finite-ind & ind(A\/B) <= ind A+ind B+1;

theorem 
  for T1,T2 be TopSpace,A1 be Subset of T1,A2 be Subset of T2 holds
  Fr [:A1,A2:] = [:Fr A1,Cl A2:] \/ [:Cl A1,Fr A2:];

registration
  let TM1,TM2;
  cluster [:TM1,TM2:] -> finite-ind;
end;



theorem 
  for A,B st A is closed & B is closed & A misses B
  for H st ind H<=n & TM|H is second-countable finite-ind
    ex L st L separates A,B & ind(L/\H) <= n-1;



theorem 
  for TM st TM is finite-ind second-countable & ind TM<=n
  for A,B st A is closed & B is closed & A misses B
  ex L st L separates A,B & ind L<=n-1;



theorem 
  for H st TM|H is second-countable holds H is
  finite-ind & ind H<=n iff for p,U st p in U
  ex W st p in W & W c=U & H/\Fr W is finite-ind & ind(H/\Fr W)<=n-1;



theorem 
  for H st TM|H is second-countable holds H is
  finite-ind & ind H<=n iff ex Bas be Basis of TM st
  for A st A in Bas holds H/\Fr A is finite-ind & ind(H/\Fr A)<=n-1;



theorem 
  TM1 is non empty or TM2 is non empty implies
    ind [:TM1,TM2:] <= ind TM1+ind TM2;



theorem 
  ind TM2 = 0 implies ind [:TM1,TM2:] = ind TM1;

begin 

reserve u for Point of Euclid 1,
  U for Point of TOP-REAL 1,
  r,u1 for real number,
  s for Real;

theorem 
  <*u1*> = u implies cl_Ball(u,r)={<*s*>:u1-r <= s & s <= u1+r};

theorem 
  <*u1*> = U & r > 0 implies Fr Ball(U,r) = {<*u1-r*>,<*u1+r*>};

theorem 
  for T be TopSpace,A be countable Subset of T st T|A is T_4
    holds A is finite-ind & ind A<=0;

registration
  let TM be metrizable TopSpace;
  cluster countable -> finite-ind for Subset of TM;
end;

registration
  let n be Nat;
  cluster TOP-REAL n -> finite-ind;
end;

theorem 
  n <= 1 implies ind TOP-REAL n = n;

theorem 
  ind TOP-REAL n <= n;



theorem 
  for A st TM|A is second-countable finite-ind & ind A<=0
     for F st F is open & F is Cover of A
     ex g be Function of F,bool the carrier of TM st
       rng g is open & rng g is Cover of A &
       (for a be set st a in F holds g.a c= a) &
       for a,b be set st a in F & b in F & a<>b holds g.a misses g.b;



theorem 
  for TM st TM is second-countable finite-ind & ind TM <= n
  for F st F is open & F is Cover of TM
  ex G st G is open & G is Cover of TM & G is_finer_than F &
  card G <= card F*(n+1) & order G <= n;



theorem 
  for TM st TM is finite-ind for A st ind A`<=n & TM|A` is second-countable
  for A1,A2 be closed Subset of TM st A=A1\/A2
  ex X1,X2 be closed Subset of TM st[#]TM=X1\/X2 & A1 c=X1 & A2 c=X2 &
  A1/\X2=A1/\A2 & A1/\A2=X1/\A2 & ind((X1/\X2)\(A1/\A2))<=n-1;














begin  
       

scheme 
 FraenkelFinCard1 { A() -> finite non empty set, P[set],
  Y() -> finite set, F(set) -> set }:
  card Y() <= card A()
provided
 Y() = { F(w) where w is Element of A(): P[w] };

theorem 
for X, Y, x being set st not x in X holds X \ (Y \/ {x}) = X \ Y;

theorem 
for X, Y being set, F being Subset-Family of X, G being Subset-Family of Y
 holds F \/ G is Subset-Family of X \/ Y;

theorem 
for X, Y being set, F being a_partition of X, G being a_partition of Y
  st X misses Y holds F \/ G is a_partition of X \/ Y;

theorem 
for X, Y being set, F being a_partition of Y
 st Y c< X holds F \/ { X \ Y } is a_partition of X;

theorem 
for X being infinite set, n being Nat
 ex Y being finite Subset of X st card Y > n;

begin 

definition
  let R be RelStr, S be Subset of R;
  attr S is connected means

  the InternalRel of R is_connected_in S;
end;

notation
  let R be RelStr, S be Subset of R;
  synonym S is clique for S is connected;
end;

registration
  let R be RelStr;
  cluster trivial -> clique for Subset of R;
end;

registration
  let R be RelStr;
  cluster clique for Subset of R;
end;

definition
  let R be RelStr;
  mode Clique of R is clique Subset of R;
end;

theorem 
for R being RelStr, S being Subset of R holds S is Clique of R iff
for a, b being Element of R st a in S & b in S & a <> b holds a <= b or b <= a;

registration
 let R be RelStr;
 cluster finite for Clique of R;
end;

registration
  let R be reflexive RelStr;
  cluster connected -> strongly_connected for Subset of R;
end;

registration
  let R be non empty RelStr;
  cluster finite non empty for Clique of R;
end;

theorem 
for R being non empty RelStr, a1,a2 being Element of R
 st a1 <> a2 & {a1,a2} is Clique of R holds a1 <= a2 or a2 <= a1;

theorem 
for R being non empty RelStr, a1,a2 being Element of R
 st a1 <= a2 or a2 <= a1 holds {a1,a2} is Clique of R;

theorem 
for R being RelStr, C being Clique of R, S being Subset of C
  holds S is Clique of R;

theorem 
for R being RelStr, C being finite Clique of R, n being Nat
  st n <= card C ex B being finite Clique of R st B c= C & card B = n;

theorem 
for R being transitive RelStr, C being Clique of R, x, y being Element of R
 st x is_maximal_in C & x <= y holds C \/ {y} is Clique of R;

theorem 
for R being transitive RelStr, C being Clique of R, x, y being Element of R
 st x is_minimal_in C & y <= x holds C \/ {y} is Clique of R;

definition
  let R be RelStr, S be Subset of R;
  attr S is stable means

    for x, y being Element of R st x in S & y in S & x <> y
     holds not x <= y & not y <= x;
end;

registration
  let R be RelStr;
  cluster trivial -> stable for Subset of R;
end;

registration
  let R be RelStr;
  cluster stable for Subset of R;
end;

definition
  let R be RelStr;
  mode StableSet of R is stable Subset of R;
    
end;

registration
  let R be RelStr;
  cluster finite for StableSet of R;
end;

registration
  let R be non empty RelStr;
  cluster finite non empty for StableSet of R;
end;

theorem 
for R being non empty RelStr, a1, a2 being Element of R
  st a1 <> a2 & {a1,a2} is StableSet of R holds not (a1 <= a2 or a2 <= a1);

theorem 
for R being non empty RelStr, a1, a2 being Element of R
 st not (a1 <= a2 or a2 <= a1) holds {a1,a2} is StableSet of R;

theorem 
for R being RelStr, C being Clique of R, A being StableSet of R, a, b being set
 st a in A & b in A & a in C & b in C holds a = b;

theorem 
for R being RelStr, A being StableSet of R, B being Subset of A
 holds B is StableSet of R;

theorem 
for R being RelStr, A being finite StableSet of R, n being Nat
  st n <= card A ex B being finite StableSet of R st card B = n;

begin 

definition
  let R be RelStr;
  attr R is with_finite_clique# means

   ex C being finite Clique of R
    st for D being finite Clique of R holds card D <= card C;
end;

registration
  cluster finite -> with_finite_clique# for RelStr;
end;

registration
  let R be with_finite_clique# RelStr;
  cluster -> finite for Clique of R;
end;

definition
  let R be with_finite_clique# RelStr;
  func clique# R -> Nat  means

   (ex C being finite Clique of R st card C = it)
     & for T being finite Clique of R holds card T <= it;
end;

registration
  let R be empty RelStr;
  cluster clique# R -> empty;
end;

registration
  let R be with_finite_clique# non empty RelStr;
  cluster clique# R -> positive;
end;

theorem 
for R being with_finite_clique# non empty RelStr
 st [#]R is StableSet of R holds clique# R = 1;

theorem 
for R being with_finite_clique# RelStr st clique# R = 1
  holds [#]R is StableSet of R;

definition
  let R be RelStr;
  attr R is with_finite_stability# means

   ex A being finite StableSet of R
    st for B being finite StableSet of R holds card B <= card A;
end;

registration
  cluster finite -> with_finite_stability# for RelStr;
end;

registration
  let R be with_finite_stability# RelStr;
  cluster -> finite for StableSet of R;
end;

definition
  let R be with_finite_stability# RelStr;
  func stability# R -> Nat means

   (ex A being finite StableSet of R st card(A) = it)
     & for T being finite StableSet of R holds card T <= it;
end;

registration
  let R be empty RelStr;
  cluster stability# R -> empty;
end;

registration
  let R be with_finite_stability# non empty RelStr;
  cluster stability# R -> positive;
end;

theorem 
for R being with_finite_stability# non empty RelStr
 st [#]R is Clique of R holds stability# R = 1;

theorem 
for R being with_finite_stability# RelStr st stability# R = 1
 holds [#]R is Clique of R;

registration
 
 
 
 
  cluster with_finite_clique# with_finite_stability# -> finite for RelStr;
end;

begin 

definition
  let R be RelStr, X be Subset of R;
  func Lower X -> Subset of R equals

   X \/ downarrow X;
  func Upper X -> Subset of R equals

   X \/ uparrow X;
end;

theorem 
for R being antisymmetric transitive RelStr, A being StableSet of R,
    z being set
 st z in Upper A & z in Lower A holds z in A;

theorem 
for R being with_finite_stability# RelStr, A being StableSet of R
 st card A = stability# R holds Upper A \/ Lower A = [#]R;

theorem 
for R being transitive RelStr, x being Element of R, S being Subset of R
 st x is_minimal_in Lower S holds x is_minimal_in [#]R;

theorem 
for R being transitive RelStr, x being Element of R, S being Subset of R
 st x is_maximal_in Upper S holds x is_maximal_in [#]R;

definition
  let R be RelStr;
  func minimals R -> Subset of R means

   for x being Element of R holds x in it iff x is_minimal_in [#]R
     if R is non empty
   otherwise it  = {};
  func maximals R -> Subset of R means

   for x being Element of R holds x in it iff x is_maximal_in [#]R
     if R is non empty
   otherwise it  = {};
end;

registration
  let R be with_finite_clique# non empty antisymmetric transitive RelStr;
  cluster maximals R -> non empty;
  cluster minimals R -> non empty;
end;

registration let R be RelStr;
 cluster minimals R -> stable;
 cluster maximals R -> stable;
end;

theorem 
for R being RelStr, A being StableSet of R
 st not minimals R c= A holds not minimals R c= Upper A;

theorem 
for R being RelStr, A being StableSet of R
 st not maximals R c= A holds not maximals R c= Lower A;

begin 

registration
  let R be RelStr, X be finite Subset of R;
  cluster subrelstr X -> finite;
end;

theorem 
for R being RelStr, S being Subset of R, C being Clique of subrelstr S
 holds C is Clique of R;

theorem 
for R being RelStr, S being Subset of R, C being Clique of R
 holds C /\ S is Clique of subrelstr S;

theorem 
for R being RelStr, S being Subset of R, A being StableSet of subrelstr S
 holds A is StableSet of R;

theorem 
for R being RelStr, S being Subset of R, A being StableSet of R
 holds A /\ S is StableSet of subrelstr S;

theorem 
for R being RelStr, S being Subset of R, B being Subset of subrelstr S,
    x being Element of subrelstr S, y being Element of R
 st x = y & x is_maximal_in B holds y is_maximal_in B;

theorem 
for R being RelStr, S being Subset of R, B being Subset of subrelstr S,
    x being Element of subrelstr S, y being Element of R
 st x = y & x is_minimal_in B holds y is_minimal_in B;

theorem 
for R being transitive RelStr, A being StableSet of R,
    C being Clique of subrelstr Lower A, a, b being Element of R
 st a in A & a in C & b in C holds a = b or b <= a;

theorem 
for R being transitive RelStr, A being StableSet of R,
    C being Clique of subrelstr Upper A, a, b being Element of R
 st a in A & a in C & b in C holds a = b or a <= b;

registration
  let R be with_finite_clique# RelStr, S be Subset of R;
  cluster subrelstr S -> with_finite_clique#;
end;

registration
  let R be with_finite_stability# RelStr, S be Subset of R;
  cluster subrelstr S -> with_finite_stability#;
end;

theorem 
for R being with_finite_clique# non empty antisymmetric transitive RelStr,
    x being Element of R
 holds ex y being Element of R st y is_minimal_in [#]R & (y = x or y < x);

theorem 
for R being with_finite_clique# antisymmetric transitive RelStr
 holds Upper minimals R = [#]R;

theorem 
for R being with_finite_clique# non empty antisymmetric transitive RelStr,
    x being Element of R
  ex y being Element of R st y is_maximal_in [#]R & (y = x or x < y);

theorem 
for R being with_finite_clique# antisymmetric transitive RelStr
 holds Lower maximals R = [#]R;

theorem 
for R being with_finite_clique# antisymmetric transitive RelStr,
    A being StableSet of R
 st minimals R c= A holds A = minimals R;

theorem 
for R being with_finite_clique# antisymmetric transitive RelStr,
    A being StableSet of R
 st maximals R c= A holds A = maximals R;

theorem 
for R being with_finite_clique# RelStr, S being Subset of R
 holds clique# subrelstr S <= clique# R;

theorem 
for R being with_finite_clique# RelStr, C being Clique of R,
    S being Subset of R st card C = clique# R & C c= S
 holds clique# subrelstr S = clique# R;

theorem 
for R being with_finite_stability# RelStr, S being Subset of R
 holds stability# subrelstr S <= stability# R;

theorem 
for R being with_finite_stability# RelStr, A being StableSet of R,
    S being Subset of R st card A = stability# R & A c= S
 holds stability# subrelstr S = stability# R;

begin 

definition
  let R be RelStr, P be a_partition of the carrier of R;
  attr P is Clique-wise means

    for x being set st x in P holds x is Clique of R;
end;

registration let R be RelStr;
 cluster Clique-wise for a_partition of the carrier of R;
end;

definition
  let R be RelStr;
  mode Clique-partition of R is Clique-wise a_partition of the carrier of R;
end;

registration let R be empty RelStr;
 cluster empty -> Clique-wise for a_partition of the carrier of R;
end;

theorem 
for R being finite RelStr, C being Clique-partition of R
 holds card C >= stability# R;

theorem 
for R being with_finite_stability# RelStr, A being StableSet of R,
    C being Clique-partition of R st card C = card A
  ex f being Function of A, C st f is bijective &
   for x being set st x in A holds x in f.x;

theorem 
for R being finite RelStr, A being StableSet of R,
    C being Clique-partition of R st card C = card A
  for c being set st c in C ex a being Element of A st c /\ A = {a};

theorem 
for R being with_finite_stability# antisymmetric transitive non empty RelStr,
    A being StableSet of R,
    U being Clique-partition of subrelstr Upper A,
    L being Clique-partition of subrelstr Lower A
 st card A = stability# R & card U = stability# R & card L = stability# R
  ex C being Clique-partition of R st card C = stability# R;

definition
  let R be RelStr, P be a_partition of the carrier of R;
  attr P is StableSet-wise means


    for x being set st x in P holds x is StableSet of R;
end;

registration
  let R be RelStr;
  cluster StableSet-wise for a_partition of the carrier of R;
end;

definition
  let R be RelStr;
  mode Coloring of R is StableSet-wise a_partition of the carrier of R;
end;

registration let R be empty RelStr;
 cluster -> StableSet-wise for a_partition of the carrier of R;
end;

theorem 
for R being finite RelStr, C being Coloring of R holds card C >= clique# R;

begin 
    
    
    
    
    
    


theorem 
for R being finite antisymmetric transitive RelStr
 ex C being Clique-partition of R st card(C) = stability# R;

definition
  let R be with_finite_stability# non empty RelStr, C be Subset of R;
  attr C is strong-chain means

  for S being finite non empty Subset of R
   ex P being Clique-partition of subrelstr S
    st card P <= stability# R &
       ex c being set st c in P & S /\ C c= c &
            for d being set st d in P & d <> c holds C /\ d = {};
end;

registration let R be with_finite_stability# non empty RelStr;
 cluster strong-chain -> clique for Subset of R;
end;

registration
 let R be with_finite_stability# antisymmetric transitive non empty RelStr;
 cluster 1-element -> strong-chain for Subset of R;
end;

theorem 
for R being with_finite_stability# non empty antisymmetric transitive RelStr
 ex S being non empty Subset of R
  st S is strong-chain &
          not ex D being Subset of R st D is strong-chain & S c< D;

theorem 
for R being with_finite_stability# antisymmetric transitive RelStr
 ex C being Clique-partition of R st card C = stability# R;

theorem 
for R being with_finite_clique# antisymmetric transitive RelStr
 ex A being Coloring of R st card A = clique# R;

begin 


theorem 
for R being finite antisymmetric transitive RelStr, r, s  being Nat
 st card R = r*s+1
  holds (ex C being Clique of R st card C >= r+1) or
        (ex A being StableSet of R st card A >= s+1);











theorem 
for f being real-valued FinSequence, n being Nat
 st card f = n^2+1 & f is one-to-one
  ex g being real-valued FinSubsequence
   st g c= f & card g >= n+1 & (g is increasing or g is decreasing);














begin 

reserve n,n1,m for Element of NAT;
reserve r,t,x1 for Element of REAL;
reserve h for 0-convergent non-zero Real_Sequence;
reserve c1 for constant Real_Sequence;
reserve p1 for real number;

definition
  func R2-to-C -> Function of [:REAL,REAL:],COMPLEX means

  for p be Element of [:REAL,REAL:], a,b be Element of REAL st
  a = p`1 & b = p`2 holds
  it.([a,b]) = a+b*<i>;
end;

definition
  let a,b be Real;
  let x,y be PartFunc of REAL,REAL, Z be Subset of REAL;
  let f be PartFunc of COMPLEX, COMPLEX;
  func integral(f,x,y,a,b,Z) -> Complex means

  ex u0, v0 be PartFunc of REAL,REAL st
  u0 = (Re f)* (R2-to-C) *<:x,y:> & v0 = (Im f)* (R2-to-C) *<:x,y:> &
  it = integral( u0(#)(x`|Z) - v0(#)(y`|Z) ,a,b )
  + integral( v0(#)(x`|Z) + u0(#)(y`|Z) ,a,b )*<i>;
end;

definition
  let C be PartFunc of REAL,COMPLEX;
  attr C is C1-curve-like means

  ex a,b be Real, x,y be PartFunc of REAL,REAL, Z be Subset of REAL st
  a <= b & [.a,b.]=dom C & [.a,b.] c= dom x & [.a,b.] c= dom y &
  Z is open & [.a,b.] c= Z & x is_differentiable_on Z &
  y is_differentiable_on Z & x`|Z is continuous & y`|Z is continuous &
  C = (x+<i>(#)y) | [.a,b.];
end;

registration
  cluster C1-curve-like for PartFunc of REAL,COMPLEX;
end;

definition
  mode C1-curve is C1-curve-like PartFunc of REAL,COMPLEX;
end;

definition
  let f be PartFunc of COMPLEX,COMPLEX;
  let C be C1-curve;
  assume
 rng C c= dom f;
  func integral(f,C) -> Complex means

  ex a,b be Real,x,y be PartFunc of REAL,REAL, Z be Subset of REAL st
  a <= b & [.a,b.]=dom C & [.a,b.] c= dom x & [.a,b.] c= dom y &
  Z is open & [.a,b.] c= Z & x is_differentiable_on Z &
  y is_differentiable_on Z & x`|Z  is continuous &
  y`|Z is continuous & C = (x+<i>(#)y) | [.a,b.]
  & it = integral(f,x,y,a,b,Z);
end;

definition
  let f be PartFunc of COMPLEX,COMPLEX;
  let C be C1-curve;
  pred f is_integrable_on C means

  for a,b be Real, x,y be PartFunc of REAL,REAL, Z be Subset of REAL,
  u0,v0 be PartFunc of REAL,REAL st
  (a <= b & [.a,b.]=dom C & [.a,b.] c= dom x & [.a,b.] c= dom y &
  Z is open & [.a,b.] c= Z & x is_differentiable_on Z &
  y is_differentiable_on Z & x`|Z is continuous & y`|Z is continuous &
  C = (x+<i>(#)y) | [.a,b.] ) holds
  (u0(#)(x`|Z) - v0(#)(y`|Z)) is_integrable_on [' a,b '] &
  (v0(#)(x`|Z) + u0(#)(y`|Z)) is_integrable_on [' a,b '];
end;

definition
  let f be PartFunc of COMPLEX, COMPLEX;
  let C be C1-curve;
  pred f is_bounded_on C means

  for a,b be Real, x,y be PartFunc of REAL,REAL, Z be Subset of REAL,
  u0, v0 be PartFunc of REAL,REAL st
  (a <= b & [.a,b.]=dom C & [.a,b.] c= dom x & [.a,b.] c= dom y &
  Z is open & [.a,b.] c= Z & x is_differentiable_on Z &
  y is_differentiable_on Z & x`|Z is continuous & y`|Z is continuous &
  C = (x+<i>(#)y) | [.a,b.] ) holds
  (u0(#)(x`|Z) - v0(#)(y`|Z))|[' a,b '] is bounded &
  (v0(#)(x`|Z) + u0(#)(y`|Z))|[' a,b '] is bounded;
end;

begin 

theorem 
  for f,g be PartFunc of COMPLEX,COMPLEX, C be C1-curve
  st rng C c= dom f & rng C c= dom g &
  f is_integrable_on C & g is_integrable_on C &
  f is_bounded_on C & g is_bounded_on C
  holds
  integral(f+g,C) = integral(f,C) + integral(g,C);

theorem 
  for f be PartFunc of COMPLEX,COMPLEX,
  C be C1-curve st rng C c= dom f & f is_integrable_on C &
  f is_bounded_on C holds
  for r be Real holds
  integral(r(#)f,C) = r*integral(f,C);

begin 

theorem 
  for f be PartFunc of COMPLEX,COMPLEX, C,C1,C2 be C1-curve, a,b,d be Real
  st rng C c= dom f & f is_integrable_on C & f is_bounded_on C &
  a <= b & dom C = [.a,b.] & d in [.a,b.] &
  dom C1 = [.a,d.] & dom C2 = [.d,b.] &
  (for t st t in dom C1 holds C.t = C1.t) &
  (for t st t in dom C2 holds C.t = C2.t) holds
  integral(f,C) = integral(f,C1) + integral(f,C2);














begin 

definition let U be set;
           let X, Y be Subset of U;
  func Inter (X,Y) -> Subset-Family of U equals

    { A where A is Subset of U : X c= A & A c= Y };
end;

 reserve U for set,
         X, Y for Subset of U;

theorem 
  for x being set holds x in Inter (X,Y) iff X c= x & x c= Y;

theorem 
  Inter (X,Y) <> {} implies X in Inter (X,Y) & Y in Inter (X,Y);

theorem 
  for U being set, A, B being Subset of U st not A c= B holds Inter (A, B) = {}
;

theorem 
   for U being set, A, B being Subset of U st Inter (A,B) = {} holds
   not A c= B;

theorem 
  for A, B being Subset of U st Inter (A, B) <> {} holds A c= B;

theorem 
  for A, B, C, D being Subset of U st
    Inter (A, B) <> {} & Inter (A, B) = Inter (C, D) holds
      A = C & B = D;

theorem 
  for U being non empty set, A being non empty Subset of U holds
    Inter (A, {}U) = {};

theorem 
  for A being Subset of U holds Inter (A, A) = { A };

definition let U;
  mode IntervalSet of U -> Subset-Family of U means

    ex A, B be Subset of U st it = Inter (A, B);
end;

theorem 
  for U being non empty set holds {} is IntervalSet of U;

theorem 
  for U being non empty set, A being Subset of U holds
    { A } is IntervalSet of U;

definition let U; let A, B be Subset of U;
  redefine func Inter (A, B) -> IntervalSet of U;
end;

registration let U be non empty set;
  cluster non empty for IntervalSet of U;
end;

theorem 
  for U being non empty set, A being set holds
    A is non empty IntervalSet of U iff
      ex A1, A2 being Subset of U st A1 c= A2 & A = Inter (A1, A2);

theorem 
  for U being non empty set, A1, A2, B1, B2 being Subset of U st
        A1 c= A2 & B1 c= B2 holds
    INTERSECTION (Inter (A1,A2), Inter (B1,B2)) =
      { C where C is Subset of U : A1 /\ B1 c= C & C c= A2 /\ B2 };

theorem 
  for U being non empty set, A1, A2, B1, B2 being Subset of U st
        A1 c= A2 & B1 c= B2 holds
    UNION (Inter (A1,A2), Inter (B1,B2)) =
      { C where C is Subset of U : A1 \/ B1 c= C & C c= A2 \/ B2 };

definition let U be non empty set,
               A, B be non empty IntervalSet of U;
  func A _/\_ B -> IntervalSet of U equals

    INTERSECTION (A, B);
  func A _\/_ B -> IntervalSet of U equals

    UNION (A, B);
end;

registration let U be non empty set,
                 A, B be non empty IntervalSet of U;
  cluster A _/\_ B -> non empty;
  cluster A _\/_ B -> non empty;
end;

 reserve U for non empty set,
         A, B, C for non empty IntervalSet of U;

definition let U, A;
  func A``1 -> Subset of U means

    ex B being Subset of U st A = Inter (it, B);
  func A``2 -> Subset of U means

    ex B being Subset of U st A = Inter (B, it);
end;

theorem 
  for X being set holds X in A iff A``1 c= X & X c= A``2;

theorem 
  A = Inter (A``1,A``2);

theorem 
  A``1 c= A``2;

theorem 
  A _\/_ B = Inter (A``1 \/ B``1, A``2 \/ B``2);

theorem 
  A _/\_ B = Inter (A``1 /\ (B``1), A``2 /\ B``2);

definition let U; let A, B;
  redefine pred A = B means

    A``1 = B``1 & A``2 = B``2;
end;

theorem 
  A _\/_ A = A;

theorem 
  A _/\_ A = A;

theorem 
  A _\/_ B = B _\/_ A;

theorem 
  A _/\_ B = B _/\_ A;

theorem 
  A _\/_ B _\/_ C = A _\/_ (B _\/_ C);

theorem 
  A _/\_ B _/\_ C = A _/\_ (B _/\_ C);

definition let X be set; let F be Subset-Family of X;
  attr F is ordered means

    ex A, B being set st A in F & B in F & for Y being set holds
        Y in F iff A c= Y & Y c= B;
end;

registration let X be set;
  cluster non empty ordered for Subset-Family of X;
end;

theorem 
  for A,B being Subset of U st A c= B holds
    Inter (A,B) is non empty ordered Subset-Family of U;

theorem 
  for A being non empty IntervalSet of U holds
    A is non empty ordered Subset-Family of U;

notation let X be set;
  synonym min X for meet X;
  synonym max X for union X;
end;

definition let X be set;
           let F be non empty ordered Subset-Family of X;
  redefine func min F -> Element of F;
  redefine func max F -> Element of F;
end;

theorem 
  for A,B being Subset of U, F being ordered non empty Subset-Family of U st
      F = Inter (A,B) holds
      min F = A & max F = B;

theorem 
  for X,Y being set, A being non empty ordered Subset-Family of X holds
    Y in A iff min A c= Y & Y c= max A;

theorem 
  for X being set, A, B, C being non empty ordered Subset-Family of X holds
    UNION (A, INTERSECTION (B,C)) =
      INTERSECTION (UNION (A,B), UNION (A,C));

theorem 
  for X being set, A, B, C being non empty ordered Subset-Family of X holds
    INTERSECTION (A, UNION (B,C)) =
       UNION (INTERSECTION (A,B), INTERSECTION (A,C));

theorem 
  A _\/_ (B _/\_ C) = (A _\/_ B) _/\_ (A _\/_ C);

theorem 
  A _/\_ (B _\/_ C) = (A _/\_ B) _\/_ (A _/\_ C);

theorem 
   for X being set, A, B being non empty ordered Subset-Family of X holds
     INTERSECTION (A, (UNION (A,B))) = A;

theorem 
   for X being set, A, B being non empty ordered Subset-Family of X holds
     UNION (INTERSECTION(A,B),B) = B;

theorem 
  A _/\_ (A _\/_ B) = A;

theorem 
  (A _/\_ B) _\/_ B = B;

begin 

theorem 
  for U being non empty set, A, B being Subset-Family of U holds
    DIFFERENCE (A,B) is Subset-Family of U;

theorem 
  for U being non empty set,
      A,B being non empty ordered Subset-Family of U holds
    DIFFERENCE (A,B) = {C where C is Subset of U :
      min A \ max B c= C & C c= max A \ min B};

theorem 
  for U being non empty set, A1, A2, B1, B2 being Subset of U st
        A1 c= A2 & B1 c= B2 holds
      DIFFERENCE (Inter (A1,A2), Inter (B1,B2)) =
      { C where C is Subset of U : A1 \ B2 c= C & C c= A2 \ B1 };

definition let U be non empty set,
               A, B be non empty IntervalSet of U;
  func A _\_ B -> IntervalSet of U equals

    DIFFERENCE (A, B);
end;

registration let U be non empty set,
                 A, B be non empty IntervalSet of U;
  cluster A _\_ B -> non empty;
end;

theorem 
  A _\_ B = Inter (A``1 \ B``2, A``2 \ B``1);

theorem 
  for X,Y being Subset of U st A = Inter (X,Y) holds
    A _\_ C = Inter (X \ C``2, Y \ C``1);

theorem 
  for X,Y,W,Z being Subset of U st A = Inter (X,Y) & C = Inter (W,Z) holds
    A _\_ C = Inter (X \ Z, Y \ W);

theorem 
  for U being non empty set holds
    Inter ([#]U,[#]U) is non empty IntervalSet of U;

theorem 
  for U being non empty set holds Inter ({}U,{}U) is non empty IntervalSet of U
;

registration let U be non empty set;
  cluster Inter ([#]U,[#]U) -> non empty;
  cluster Inter ({}U,{}U) -> non empty;
end;

definition let U be non empty set, A be non empty IntervalSet of U;
  func A ^ -> non empty IntervalSet of U equals

    Inter ([#]U,[#]U) _\_ A;
end;

theorem 
  for U being non empty set, A being non empty IntervalSet of U holds
    A^ = Inter ((A``2)`,(A``1)`);

theorem 
  for X,Y being Subset of U st A = Inter (X,Y) & X c= Y holds
    A^ = Inter (Y`,X`);

theorem 
  (Inter ({}U,{}U))^ = Inter ([#]U,[#]U);

theorem 
  (Inter ([#]U,[#]U))^ = Inter ({}U,{}U);

begin 

theorem 
  ex A being non empty IntervalSet of U st A _/\_ A^ <> Inter ({}U,{}U);

theorem 
  ex A being non empty IntervalSet of U st A _\/_ A^ <> Inter ([#]U,[#]U);

theorem 
  ex A being non empty IntervalSet of U st A _\_ A <> Inter ({}U,{}U);

theorem 
  for A being non empty IntervalSet of U holds U in A _\/_ (A^);

theorem 
  for A being non empty IntervalSet of U holds {} in A _/\_ (A^);

theorem 
  for A being non empty IntervalSet of U holds {} in A _\_ A;

begin 

definition let U be non empty set;
  func IntervalSets U -> non empty set means

    for x being set holds x in it iff x is non empty IntervalSet of U;
end;

definition let U be non empty set;
  func InterLatt U -> strict non empty LattStr means

    the carrier of it = IntervalSets U &
    for a, b being Element of the carrier of it,
        a9, b9 being non empty IntervalSet of U st a9 = a & b9 = b holds
      (the L_join of it).(a,b) = a9 _\/_ b9 &
      (the L_meet of it).(a,b) = a9 _/\_ b9;
end;

registration let U be non empty set;
  cluster InterLatt U -> Lattice-like;
end;

definition let X be Tolerance_Space;
  mode RoughSet of X ->
    Element of [:bool the carrier of X, bool the carrier of X:] means

    not contradiction;
end;

theorem 
  for X being Tolerance_Space, A being RoughSet of X holds
    ex B, C being Subset of X st A = [B,C];

definition let X be Tolerance_Space, A be Subset of X;
  func RS A -> RoughSet of X equals

    [LAp A, UAp A];
end;

definition let X be Tolerance_Space, A be RoughSet of X;
  func LAp A -> Subset of X equals

    A`1;
  func UAp A -> Subset of X equals

    A`2;
end;

definition let X be Tolerance_Space; let A, B be RoughSet of X;
  redefine pred A = B means

    LAp A = LAp B & UAp A = UAp B;
end;

definition let X be Tolerance_Space; let A, B be RoughSet of X;
  func A _\/_ B -> RoughSet of X equals

    [LAp A \/ LAp B, UAp A \/ UAp B];
  func A _/\_ B -> RoughSet of X equals

    [LAp A /\ LAp B, UAp A /\ UAp B];
end;

 reserve X for Tolerance_Space,
         A, B, C for RoughSet of X;

theorem 
  LAp (A _\/_ B) = LAp A \/ LAp B;

theorem 
  UAp (A _\/_ B) = UAp A \/ UAp B;

theorem 
  LAp (A _/\_ B) = LAp A /\ LAp B;

theorem 
  UAp (A _/\_ B) = UAp A /\ UAp B;



theorem 
  A _\/_ A = A;

theorem 
  A _/\_ A = A;

theorem 
  A _\/_ B = B _\/_ A;

theorem 
  A _/\_ B = B _/\_ A;

theorem 
  A _\/_ B _\/_ C = A _\/_ (B _\/_ C);

theorem 
  A _/\_ B _/\_ C = A _/\_ (B _/\_ C);

theorem 
  A _/\_ (B _\/_ C) = (A _/\_ B) _\/_ (A _/\_ C);

theorem 
  A _\/_ (A _/\_ B) = A;

theorem 
  A _/\_ (A _\/_ B) = A;

begin 

definition let X;
  func RoughSets X means

    for x being set holds x in it iff x is RoughSet of X;
end;

registration let X;
  cluster RoughSets X -> non empty;
end;

definition let X; let R be Element of RoughSets X;
  func @R -> RoughSet of X equals

    R;
end;

definition let X; let R be RoughSet of X;
  func R@ -> Element of RoughSets X equals

    R;
end;

definition let X;
  func RSLattice X -> strict LattStr means

    the carrier of it = RoughSets X & for A, B being Element of RoughSets X,
        A9, B9 being RoughSet of X st A = A9 & B = B9 holds
     (the L_join of it).(A,B) = A9 _\/_ B9 &
     (the L_meet of it).(A,B) = A9 _/\_ B9;
end;

registration let X;
  cluster RSLattice X -> non empty;
end;

 reserve K,L,M for Element of RoughSets X;

registration let X;
  cluster RSLattice X -> Lattice-like;
end;

registration let X;
  cluster RSLattice X -> distributive;
end;

definition let X;
  func ERS X -> RoughSet of X equals

    [{},{}];
end;

theorem 
  for A being RoughSet of X holds ERS X _\/_ A = A;

definition let X;
  func TRS X -> RoughSet of X equals

    [[#]X,[#]X];
end;

theorem 
  for A being RoughSet of X holds TRS X _/\_ A = A;

registration let X;
  cluster RSLattice X -> bounded;
end;

theorem 
  for X being Tolerance_Space, A, B being Element of RSLattice X,
      A9, B9 being RoughSet of X st A = A9 & B = B9 holds
    A [= B iff
      LAp A9 c= LAp B9 & UAp A9 c= UAp B9;

registration let X;
  cluster RSLattice X -> complete;
end;














begin 

reserve x,t,t1,t2,r,a,b for real number;
reserve F,G for real-valued Function;
reserve k for Nat;
reserve i for non zero Integer;

definition
  let t be real number;
  let F be Function;
  attr F is t-periodic means

  t <> 0 & for x holds (x in dom F iff x+t in dom F) &
              (x in dom F implies F.x = F.(x+t));
end;

definition
  let F be Function;
  attr F is periodic means

  ex t st F is t-periodic;
end;

theorem 
  F is t-periodic iff t<>0 &
  for x st x in dom F holds x+t in dom F & x-t in dom F & F.x=F.(x+t);

theorem 
  F is t-periodic & G is t-periodic implies F+G is t-periodic;

theorem 
  F is t-periodic & G is t-periodic implies F-G is t-periodic;

theorem 
  F is t-periodic & G is t-periodic implies F(#)G is t-periodic;

theorem 
  F is t-periodic & G is t-periodic implies F /" G is t-periodic;

theorem 
  F is t-periodic implies -F is t-periodic;

theorem 
  F is t-periodic implies r (#) F is t-periodic;

theorem 
  F is t-periodic implies r+F is t-periodic;

theorem 
  F is t-periodic implies F-r is t-periodic;

theorem 
  F is t-periodic implies |. F .| is t-periodic;

theorem 
  F is t-periodic implies F" is t-periodic;

theorem 
  F is t-periodic implies F^2 is t-periodic;

theorem 
  F is t-periodic implies for x st x in dom F holds F.x=F.(x-t);

theorem 
  F is t-periodic implies F is -t -periodic;

theorem 
  F is t1-periodic & F is t2-periodic & t1+t2<>0 implies F is (t1+t2)-periodic;

theorem 
  F is t1-periodic & F is t2-periodic & t1-t2<>0 implies F is (t1-t2)-periodic;

theorem 
  (t<>0 & for x st x in dom F holds (x+t in dom F & x-t in dom F &
  F.(x+t)=F.(x-t))) implies F is (2*t)-periodic & F is periodic;

theorem 
  (t1+t2<>0 & for x st x in dom F holds (x+t1 in dom F & x-t1 in dom F &
  x+t2 in dom F & x-t2 in dom F &
  F.(x+t1)=F.(x-t2))) implies F is (t1+t2)-periodic & F is periodic;

theorem 
  (t1-t2<>0 & for x st x in dom F holds (x+t1 in dom F & x-t1 in dom F &
  x+t2 in dom F & x-t2 in dom F &
  F.(x+t1)=F.(x+t2))) implies F is (t1-t2)-periodic & F is periodic;

theorem 
  (t<>0 & for x st x in dom F holds (x+t in dom F & x-t in dom F &
  F.(x+t)=(F.x)")) implies F is (2*t)-periodic & F is periodic;

registration
  cluster periodic real-valued for Function;
  cluster periodic for PartFunc of REAL, REAL;
end;

registration
  let t be non zero real number;
  cluster REAL --> t -> t-periodic;
  cluster t-periodic real-valued for Function;
end;

registration
  let t be non zero real number;
  let F,G be t-periodic real-valued Function;
  cluster F + G -> t-periodic;
  cluster F - G -> t-periodic;
  cluster F (#) G -> t-periodic;
  cluster F /" G -> t-periodic;
end;

registration let F be periodic real-valued Function;
  cluster -F -> periodic;
end;

registration let F be periodic real-valued Function;
             let r be real number;
  cluster r (#) F -> periodic;
  cluster r+F -> periodic;
  cluster F-r -> periodic;
end;

registration let F be periodic real-valued Function;
  cluster |. F .| -> periodic;
  cluster F" -> periodic;
  cluster F^2 -> periodic;
end;

begin

registration
  cluster sin -> periodic;
  cluster cos -> periodic;
end;

theorem 
  sin is (2*PI*i)-periodic;

theorem 
  cos is (2*PI*i)-periodic;

registration
  cluster cosec -> periodic;
  cluster sec -> periodic;
end;

theorem 
  sec is (2*PI*i)-periodic;

theorem 
  cosec is (2*PI*i)-periodic;

registration
  cluster tan -> periodic;
  cluster cot -> periodic;
end;

theorem 
  tan is (PI*i)-periodic;

theorem 
  cot is (PI*i)-periodic;

theorem 
  |. sin .| is (PI*i)-periodic;

theorem 
  |. cos .| is (PI*i)-periodic;

theorem 
  |. sin .| + |. cos .| is (PI/2*i)-periodic;

theorem 
  sin^2 is (PI*i)-periodic;

theorem 
  cos^2 is (PI*i)-periodic;

theorem 
  sin (#) cos is (PI*i)-periodic;

theorem 
  b + a (#) sin is (2*PI*i)-periodic;

theorem 
  a (#) sin - b is (2*PI*i)-periodic;

theorem 
  b + a (#) cos is (2*PI*i)-periodic;

theorem 
  a (#) cos - b is (2*PI*i)-periodic;

theorem 
  t <> 0 implies REAL --> a is t -periodic;

registration
  let a;
  cluster REAL --> a -> periodic;
end;

registration
  let t be non zero real number;
  cluster t-periodic for Function of REAL,REAL;
end;















begin 

reserve r, r1, r2, x, y, z,
        x1, x2, x3, y1, y2, y3 for Element of REAL;
reserve R, R1, R2, R3 for Element of 3-tuples_on REAL;
reserve p, q, p1, p2, p3, q1, q2 for Element of REAL 3;
reserve f1, f2, f3, g1, g2, g3, h1, h2, h3 for PartFunc of REAL,REAL;
reserve t, t0, t1, t2 for Real;

definition let x, y, z be real number;
  redefine func |[ x,y,z ]| -> Element of REAL 3;
end;

theorem 
  p = |[ p.1, p.2, p.3 ]|;

theorem 
  for f being FinSequence of REAL st len f = 3 holds f is Element of REAL 3;

definition
  func <e1> -> Element of REAL 3 equals

    |[ 1,0,0 ]|;
  func <e2> -> Element of REAL 3 equals

    |[ 0,1,0 ]|;
  func <e3> -> Element of REAL 3 equals

    |[ 0,0,1 ]|;
end;

definition let p1, p2;
  func p1 <X> p2 -> Element of REAL 3 equals

  |[ (p1.2*p2.3)-(p1.3*p2.2),(p1.3*p2.1)-(p1.1*p2.3),
  (p1.1*p2.2)-(p1.2*p2.1) ]|;
end;

theorem 
  p1,p2 are_ldependent2 implies p1<X>p2 = 0.REAL 3;

begin 

theorem 
  |. <e1> .| = 1;

theorem 
  |. <e2> .| = 1;

theorem 
  |. <e3> .| = 1;

theorem 
  <e1>,<e2> are_orthogonal;

theorem 
  <e1>,<e3> are_orthogonal;

theorem 
  <e2>,<e3> are_orthogonal;

theorem 
  |(<e1>,<e1>)| = 1;

theorem 
  |(<e2>,<e2>)| = 1;

theorem 
  |(<e3>,<e3>)| = 1;

theorem 
  |( p , |[ 0,0,0 ]| )| = 0;

canceled 2;

theorem 
  <e1><X><e2> = <e3>;

theorem 
  <e2><X><e3> = <e1>;

theorem 
  <e3><X><e1> = <e2>;

theorem 
  <e3><X><e2> = -<e1>;

theorem 
  <e1><X><e3> = -<e2>;

theorem 
  <e2><X><e1> = -<e3>;

theorem 
  p <X> |[ 0,0,0 ]| = |[ 0,0,0 ]|;

canceled 2;

theorem 
  r*<e1> = |[ r,0,0 ]|;

theorem 
  r*<e2> = |[ 0,r,0 ]|;

theorem 
  r*<e3> = |[ 0,0,r ]|;

theorem 
  1*p = p;

canceled 2;

theorem 
  -<e1> = |[ -1,0,0 ]|;

theorem 
  -<e2> = |[ 0,-1,0 ]|;

theorem 
  -<e3> = |[ 0,0,-1 ]|;

theorem 
  0 * p = |[ 0,0,0 ]|;

canceled 2;

theorem 
  p = p.1*<e1> + p.2*<e2> + p.3*<e3>;

theorem 
  r*p = r*p.1*<e1> + r*p.2*<e2> + r*p.3*<e3>;

theorem 
  |[ x,y,z ]| = x*<e1> + y*<e2> + z*<e3>;

theorem 
  r*|[ x,y,z ]| = r*x*<e1> + r*y*<e2> + r*z*<e3>;

theorem 
  -p = - p.1*<e1> - p.2*<e2> - p.3*<e3>;

theorem 
  -|[ x,y,z ]| = -x*<e1> - y*<e2> - z*<e3>;

theorem 
  p1+p2 = (p1.1+p2.1)*<e1>+(p1.2+p2.2)*<e2>+(p1.3+p2.3)*<e3>;

theorem 
  p1-p2 = (p1.1-p2.1)*<e1>+(p1.2-p2.2)*<e2>+(p1.3-p2.3)*<e3>;

theorem 
  |[ x1,x2,x3 ]| + |[ y1,y2,y3 ]| = (x1+y1)*<e1> + (x2+y2)*<e2> + (x3+y3)*<e3>;

theorem 
  |[ x1,x2,x3 ]| - |[ y1,y2,y3 ]| = (x1-y1)*<e1> + (x2-y2)*<e2> + (x3-y3)*<e3>;

theorem 
  p1.1*<e1> + p1.2*<e2> + p1.3*<e3>
 = (p2.1 + p3.1)*<e1> + (p2.2 + p3.2)*<e2> + (p2.3 + p3.3)*<e3> iff
  p2.1*<e1> + p2.2*<e2> + p2.3*<e3>
 = (p1.1 - p3.1)*<e1> + (p1.2 - p3.2)*<e2> + (p1.3 - p3.3)*<e3>;

definition
  let f1,f2,f3 be PartFunc of REAL,REAL;
  func VFunc(f1,f2,f3) -> Function of REAL,REAL 3 means

  for t holds it.t = |[ f1.t,f2.t,f3.t ]|;
end;

theorem 
  VFunc(f1,f2,f3).t = f1.t*<e1> + f2.t*<e2> + f3.t*<e3>;

theorem 
  p = VFunc(f1,f2,f3).t iff p.1 = f1.t & p.2 = f2.t & p.3 = f3.t;

theorem 
  len p = 3 & dom p = Seg 3;

theorem 
  mlt(p,q) = <* p.1*q.1, p.2*q.2, p.3*q.3 *>;

theorem 
  r*p = |[ r*p.1, r*p.2, r*p.3 ]|;

theorem 
  -p = |[ -p.1,-p.2,-p.3 ]|;

theorem 
  len(-p) = len p;

theorem 
  p+q = |[ p.1+q.1, p.2+q.2, p.3+q.3 ]|;

theorem 
  (p = VFunc(f1,f2,f3).t1 & q = VFunc(g1,g2,g3).t2 & p = q) implies
  (f1.t1 = g1.t2 & f2.t1 = g2.t2 & f3.t1 = g3.t2);

theorem 
  (f1.t1 = g1.t2 & f2.t1 = g2.t2 & f3.t1 = g3.t2) implies
  VFunc(f1,f2,f3).t1 = VFunc(g1,g2,g3).t2;

theorem 
  for r being real number holds r*p = |[ r*p.1, r*p.2, r*p.3 ]|;

theorem 
  for r being real number holds r*|[ x,y,z ]| = |[ r*x, r*y, r*z ]|;

theorem 
  -p = |[ -p.1,-p.2,-p.3 ]|;

theorem 
  (-p).1 = -p.1 & (-p).2 = -p.2 & (-p).3 = -p.3;

theorem 
  p1-p2 = |[ p1.1-p2.1, p1.2-p2.2, p1.3-p2.3 ]|;

theorem 
  |(p,q)| = p.1*q.1+p.2*q.2+p.3*q.3;

theorem 
  |(p,p)| = (p.1)^2 + (p.2)^2 + (p.3)^2;

theorem 
  |.p.| = sqrt ((p.1)^2+(p.2)^2+(p.3)^2);

theorem 
  |.r*p.| = abs(r)*(sqrt ((p.1)^2+(p.2)^2+(p.3)^2));

theorem 
  r1*p+r2*p = (r1+r2)*|[ p.1, p.2, p.3 ]|;

theorem 
  |(r*p1,p2)| = r*|(p1,p2)|;

theorem 
  r1*p-r2*p = (r1-r2)*|[ p.1, p.2, p.3 ]|;

theorem 
  |(r*p,q)| = r*(p.1*q.1+p.2*q.2+p.3*q.3);

theorem 
  |(p,0.REAL 3)| = 0;

theorem 
  |(-p1,p2)| = -|(p1,p2)|;

theorem 
  |(-p1,-p2)| = |(p1,p2)|;

theorem 
  |(p1-p2,q)| = |(p1,q)| - |(p2,q)|;

theorem 
  |(p1+p2,q)| = |(p1,q)|+|(p2,q)|;

theorem 
  |(r1*p1+r2*p2,q)| = r1*|(p1,q)| + r2*|(p2,q)|;

theorem 
  |(p1+p2,q1+q2)| = |(p1,q1)|+|(p1,q2)|+|(p2,q1)|+|(p2,q2)|;

theorem 
  |(p1-p2,q1-q2)| = |(p1,q1)|-|(p1,q2)|-|(p2,q1)|+|(p2,q2)|;

theorem 
  |(p,p)| = 0 iff p = 0.REAL 3;

theorem 
  |.p.| = 0 iff p = 0.REAL 3;

theorem 
  |(p-q,p-q)| = |(p,p)|-2*|(p,q)|+|(q,q)|;

theorem 
  |(p+q,p+q)| = |(p,p)|+2*|(p,q)|+|(q,q)|;

theorem 
  p1<X>p2 = -p2<X>p1;

theorem 
  |[ x1,x2,x3 ]| <X> |[ y1,y2,y3 ]|
  = |[ (x2*y3)-(x3*y2),(x3*y1)-(x1*y3),(x1*y2)-(x2*y1) ]|;

theorem 
  (r*p1)<X>p2 = r*(p1<X>p2) & (r*p1)<X>p2 = p1<X>(r*p2);

theorem 
  p1<X>(p2+p3) = (p1<X>p2)+(p1<X>p3);

theorem 
  (p1+p2)<X>p3 = (p1<X>p3)+(p2<X>p3);

theorem 
  (p1+p2)<X>(q1+q2) = p1<X>q1+p1<X>q2+p2<X>q1+p2<X>q2;

theorem 
  p1<X>(p2<X>p3) = (|(p1,p3)|*p2)-(|(p1,p2)|*p3);

definition let p1,p2,p3;
  func |{ p1,p2,p3 }| -> real number equals

  |(p1,p2<X>p3)|;
end;

theorem 
  |{ p1,p1,p2 }| = 0;

theorem 
  |{ p2,p1,p2 }| = 0;

theorem 
  |{ p1,p2,p2 }| = 0;

theorem 
  |{ p1,p2,p3 }| = |{ p2,p3,p1 }|;

theorem 
  |{ p1,p2,p3 }| = |(p1<X>p2,p3)|;

theorem 
  |{ p1,p2,q }| = |(q<X>p1,p2)|;

begin 

definition
  let f1,f2,f3 be PartFunc of REAL,REAL;
  let t0 be Real;
  func VFuncdiff(f1,f2,f3,t0) -> Element of REAL 3 equals

  |[ diff(f1,t0),diff(f2,t0),diff(f3,t0) ]|;
end;

theorem 
  f1 is_differentiable_in t0 & f2 is_differentiable_in t0 &
  f3 is_differentiable_in t0 implies VFuncdiff(f1,f2,f3,t0) =
  diff(f1,t0)*<e1>+diff(f2,t0)*<e2>+diff(f3,t0)*<e3>;

theorem 
  (f1 is_differentiable_in t0 & f2 is_differentiable_in t0 &
  f3 is_differentiable_in t0) & (g1 is_differentiable_in t0 &
  g2 is_differentiable_in t0 & g3 is_differentiable_in t0)
  implies VFuncdiff(f1+g1,f2+g2,f3+g3,t0) =
  VFuncdiff(f1,f2,f3,t0)+VFuncdiff(g1,g2,g3,t0);

theorem 
  (f1 is_differentiable_in t0 & f2 is_differentiable_in t0 &
  f3 is_differentiable_in t0) & (g1 is_differentiable_in t0 &
  g2 is_differentiable_in t0 & g3 is_differentiable_in t0)
  implies VFuncdiff(f1-g1,f2-g2,f3-g3,t0) =
  VFuncdiff(f1,f2,f3,t0)-VFuncdiff(g1,g2,g3,t0);

theorem 
  (f1 is_differentiable_in t0 & f2 is_differentiable_in t0 &
  f3 is_differentiable_in t0) implies
  VFuncdiff(r(#)f1,r(#)f2,r(#)f3,t0) = r*VFuncdiff(f1,f2,f3,t0);

theorem 
  (f1 is_differentiable_in t0 & f2 is_differentiable_in t0 &
  f3 is_differentiable_in t0) & (g1 is_differentiable_in t0 &
  g2 is_differentiable_in t0 & g3 is_differentiable_in t0)
  implies VFuncdiff(f1(#)g1,f2(#)g2,f3(#)g3,t0) =
  |[ (g1.t0)*diff(f1,t0),(g2.t0)*diff(f2,t0),(g3.t0)*diff(f3,t0) ]|+
  |[ (f1.t0)*diff(g1,t0),(f2.t0)*diff(g2,t0),(f3.t0)*diff(g3,t0) ]|;

theorem 
  (f1 is_differentiable_in t0 & f2 is_differentiable_in t0 &
  f3 is_differentiable_in t0) & (g1 is_differentiable_in f1.t0 &
  g2 is_differentiable_in f2.t0 & g3 is_differentiable_in f3.t0)
  implies VFuncdiff(g1*f1,g2*f2,g3*f3,t0) =
  |[ diff(g1,f1.t0)*diff(f1,t0),diff(g2,f2.t0)*diff(f2,t0),
  diff(g3,f3.t0)*diff(f3,t0) ]|;

theorem 
  (f1 is_differentiable_in t0 & f2 is_differentiable_in t0 &
  f3 is_differentiable_in t0) & (g1 is_differentiable_in t0 &
  g2 is_differentiable_in t0 & g3 is_differentiable_in t0) &
  (g1.t0 <> 0 & g2.t0 <> 0 & g3.t0 <> 0) implies
  VFuncdiff(f1/g1,f2/g2,f3/g3,t0) =
  |[ (diff(f1,t0)*(g1.t0)-diff(g1,t0)*(f1.t0))/(g1.t0)^2,
  (diff(f2,t0)*(g2.t0)-diff(g2,t0)*(f2.t0))/(g2.t0)^2,
  (diff(f3,t0)*(g3.t0)-diff(g3,t0)*(f3.t0))/(g3.t0)^2  ]|;

theorem 
  (f1 is_differentiable_in t0 & f2 is_differentiable_in t0 &
  f3 is_differentiable_in t0) & (f1.t0 <> 0 & f2.t0 <> 0 & f3.t0 <> 0)
  implies VFuncdiff(f1^,f2^,f3^,t0) =
  - |[ diff(f1,t0)/(f1.t0)^2,diff(f2,t0)/(f2.t0)^2,
  diff(f3,t0)/(f3.t0)^2 ]|;

theorem 
  f1 is_differentiable_in t0 & f2 is_differentiable_in t0 &
  f3 is_differentiable_in t0 implies
  VFuncdiff(r(#)f1,r(#)f2,r(#)f3,t0) = r*diff(f1,t0)*<e1>
  +r*diff(f2,t0)*<e2>+r*diff(f3,t0)*<e3>;

theorem 
  (f1 is_differentiable_in t0 & f2 is_differentiable_in t0 &
  f3 is_differentiable_in t0) & (g1 is_differentiable_in t0 &
  g2 is_differentiable_in t0 & g3 is_differentiable_in t0)
  implies VFuncdiff(r(#)(f1+g1),r(#)(f2+g2),r(#)(f3+g3),t0) =
  r*VFuncdiff(f1,f2,f3,t0)+r*VFuncdiff(g1,g2,g3,t0);

theorem 
  (f1 is_differentiable_in t0 & f2 is_differentiable_in t0 &
  f3 is_differentiable_in t0) & (g1 is_differentiable_in t0 &
  g2 is_differentiable_in t0 & g3 is_differentiable_in t0)
  implies VFuncdiff(r(#)(f1-g1),r(#)(f2-g2),r(#)(f3-g3),t0) =
  r*VFuncdiff(f1,f2,f3,t0)-r*VFuncdiff(g1,g2,g3,t0);

theorem 
  (f1 is_differentiable_in t0 & f2 is_differentiable_in t0 &
  f3 is_differentiable_in t0) & (g1 is_differentiable_in t0 &
  g2 is_differentiable_in t0 & g3 is_differentiable_in t0)
  implies VFuncdiff(r(#)f1(#)g1,r(#)f2(#)g2,r(#)f3(#)g3,t0) =
  r*|[ (g1.t0)*diff(f1,t0),(g2.t0)*diff(f2,t0),(g3.t0)*diff(f3,t0) ]|+
  r*|[ (f1.t0)*diff(g1,t0),(f2.t0)*diff(g2,t0),(f3.t0)*diff(g3,t0) ]|;

theorem 
  (f1 is_differentiable_in t0 & f2 is_differentiable_in t0 &
  f3 is_differentiable_in t0) & (g1 is_differentiable_in f1.t0 &
  g2 is_differentiable_in f2.t0 & g3 is_differentiable_in f3.t0)
  implies VFuncdiff(r(#)g1*f1,r(#)g2*f2,r(#)g3*f3,t0) =
  r*|[ diff(g1,f1.t0)*diff(f1,t0),diff(g2,f2.t0)*diff(f2,t0),
  diff(g3,f3.t0)*diff(f3,t0) ]|;

theorem 
   (f1 is_differentiable_in t0 & f2 is_differentiable_in t0 &
  f3 is_differentiable_in t0) & (g1 is_differentiable_in t0 &
  g2 is_differentiable_in t0 & g3 is_differentiable_in t0) &
  (g1.t0 <> 0 & g2.t0 <> 0 & g3.t0 <> 0) implies
  VFuncdiff(r(#)f1/g1,r(#)f2/g2,r(#)f3/g3,t0) =
  r*|[ (diff(f1,t0)*(g1.t0)-diff(g1,t0)*(f1.t0))/(g1.t0)^2,
  (diff(f2,t0)*(g2.t0)-diff(g2,t0)*(f2.t0))/(g2.t0)^2,
  (diff(f3,t0)*(g3.t0)-diff(g3,t0)*(f3.t0))/(g3.t0)^2  ]|;

theorem 
  (f1 is_differentiable_in t0 & f2 is_differentiable_in t0 &
  f3 is_differentiable_in t0) & (f1.t0 <> 0 & f2.t0 <> 0 & f3.t0 <> 0) &
  r <> 0 implies VFuncdiff(r(#)f1^,r(#)f2^,r(#)f3^,t0) =
  - 1/r*|[ diff(f1,t0)/(f1.t0)^2,diff(f2,t0)/(f2.t0)^2,
  diff(f3,t0)/(f3.t0)^2 ]|;

theorem 
  (f1 is_differentiable_in t0 & f2 is_differentiable_in t0 &
  f3 is_differentiable_in t0) & (g1 is_differentiable_in t0 &
  g2 is_differentiable_in t0 & g3 is_differentiable_in t0)
  implies VFuncdiff( f2(#)g3-f3(#)g2,f3(#)g1-f1(#)g3,
                     f1(#)g2-f2(#)g1,t0 )
  = |[ (f2.t0)*diff(g3,t0)-(f3.t0)*diff(g2,t0),
       (f3.t0)*diff(g1,t0)-(f1.t0)*diff(g3,t0),
       (f1.t0)*diff(g2,t0)-(f2.t0)*diff(g1,t0) ]|
  + |[ diff(f2,t0)*(g3.t0)-diff(f3,t0)*(g2.t0),
       diff(f3,t0)*(g1.t0)-diff(f1,t0)*(g3.t0),
       diff(f1,t0)*(g2.t0)-diff(f2,t0)*(g1.t0) ]|;



theorem 
  (f1 is_differentiable_in t0 & f2 is_differentiable_in t0 &
  f3 is_differentiable_in t0) & (g1 is_differentiable_in t0 &
  g2 is_differentiable_in t0 & g3 is_differentiable_in t0) &
  (h1 is_differentiable_in t0 & h2 is_differentiable_in t0 &
   h3 is_differentiable_in t0) implies
  VFuncdiff( h1(#)(f2(#)g3-f3(#)g2),
             h2(#)(f3(#)g1-f1(#)g3),
             h3(#)(f1(#)g2-f2(#)g1),t0 )
  = |[ diff(h1,t0)*(f2.t0*g3.t0-f3.t0*g2.t0),
       diff(h2,t0)*(f3.t0*g1.t0-f1.t0*g3.t0),
       diff(h3,t0)*(f1.t0*g2.t0-f2.t0*g1.t0) ]|+
    |[ (h1.t0)*(diff(f2,t0)*(g3.t0)-diff(f3,t0)*(g2.t0)),
       (h2.t0)*(diff(f3,t0)*(g1.t0)-diff(f1,t0)*(g3.t0)),
       (h3.t0)*(diff(f1,t0)*(g2.t0)-diff(f2,t0)*(g1.t0)) ]|+
    |[ (h1.t0)*((f2.t0)*diff(g3,t0)-(f3.t0)*diff(g2,t0)),
       (h2.t0)*((f3.t0)*diff(g1,t0)-(f1.t0)*diff(g3,t0)),
       (h3.t0)*((f1.t0)*diff(g2,t0)-(f2.t0)*diff(g1,t0)) ]|;



theorem 
  (f1 is_differentiable_in t0 & f2 is_differentiable_in t0 &
  f3 is_differentiable_in t0) & (g1 is_differentiable_in t0 &
  g2 is_differentiable_in t0 & g3 is_differentiable_in t0) &
  (h1 is_differentiable_in t0 & h2 is_differentiable_in t0 &
   h3 is_differentiable_in t0) implies
  VFuncdiff( h2(#)f2(#)g3-h3(#)f3(#)g2,
             h3(#)f3(#)g1-h1(#)f1(#)g3,
             h1(#)f1(#)g2-h2(#)f2(#)g1,t0 )
  = |[ (h2.t0)*(f2.t0)*diff(g3,t0)-(h3.t0)*(f3.t0)*diff(g2,t0),
       (h3.t0)*(f3.t0)*diff(g1,t0)-(h1.t0)*(f1.t0)*diff(g3,t0),
       (h1.t0)*(f1.t0)*diff(g2,t0)-(h2.t0)*(f2.t0)*diff(g1,t0) ]|+
    |[ (h2.t0)*diff(f2,t0)*(g3.t0)-(h3.t0)*diff(f3,t0)*(g2.t0),
       (h3.t0)*diff(f3,t0)*(g1.t0)-(h1.t0)*diff(f1,t0)*(g3.t0),
       (h1.t0)*diff(f1,t0)*(g2.t0)-(h2.t0)*diff(f2,t0)*(g1.t0) ]|+
    |[ diff(h2,t0)*(f2.t0)*(g3.t0)-diff(h3,t0)*(f3.t0)*(g2.t0),
       diff(h3,t0)*(f3.t0)*(g1.t0)-diff(h1,t0)*(f1.t0)*(g3.t0),
       diff(h1,t0)*(f1.t0)*(g2.t0)-diff(h2,t0)*(f2.t0)*(g1.t0) ]|;



theorem 
  (f1 is_differentiable_in t0 & f2 is_differentiable_in t0 &
  f3 is_differentiable_in t0) & (g1 is_differentiable_in t0 &
  g2 is_differentiable_in t0 & g3 is_differentiable_in t0) &
  (h1 is_differentiable_in t0 & h2 is_differentiable_in t0 &
   h3 is_differentiable_in t0) implies
   VFuncdiff( h2(#)(f1(#)g2-f2(#)g1)-h3(#)(f3(#)g1-f1(#)g3),
              h3(#)(f2(#)g3-f3(#)g2)-h1(#)(f1(#)g2-f2(#)g1),
              h1(#)(f3(#)g1-f1(#)g3)-h2(#)(f2(#)g3-f3(#)g2),t0 )
 = |[ (h2.t0)*((f1.t0)*diff(g2,t0)-(f2.t0)*diff(g1,t0))-
      (h3.t0)*((f3.t0)*diff(g1,t0)-(f1.t0)*diff(g3,t0)),
      (h3.t0)*((f2.t0)*diff(g3,t0)-(f3.t0)*diff(g2,t0))-
      (h1.t0)*((f1.t0)*diff(g2,t0)-(f2.t0)*diff(g1,t0)),
      (h1.t0)*((f3.t0)*diff(g1,t0)-(f1.t0)*diff(g3,t0))-
      (h2.t0)*((f2.t0)*diff(g3,t0)-(f3.t0)*diff(g2,t0)) ]|+
   |[ (h2.t0)*(diff(f1,t0)*(g2.t0)-diff(f2,t0)*(g1.t0))-
      (h3.t0)*(diff(f3,t0)*(g1.t0)-diff(f1,t0)*(g3.t0)),
      (h3.t0)*(diff(f2,t0)*(g3.t0)-diff(f3,t0)*(g2.t0))-
      (h1.t0)*(diff(f1,t0)*(g2.t0)-diff(f2,t0)*(g1.t0)),
      (h1.t0)*(diff(f3,t0)*(g1.t0)-diff(f1,t0)*(g3.t0))-
      (h2.t0)*(diff(f2,t0)*(g3.t0)-diff(f3,t0)*(g2.t0)) ]|+
   |[ diff(h2,t0)*((f1.t0)*(g2.t0)-(f2.t0)*(g1.t0))-
      diff(h3,t0)*((f3.t0)*(g1.t0)-(f1.t0)*(g3.t0)),
      diff(h3,t0)*((f2.t0)*(g3.t0)-(f3.t0)*(g2.t0))-
      diff(h1,t0)*((f1.t0)*(g2.t0)-(f2.t0)*(g1.t0)),
      diff(h1,t0)*((f3.t0)*(g1.t0)-(f1.t0)*(g3.t0))-
      diff(h2,t0)*((f2.t0)*(g3.t0)-(f3.t0)*(g2.t0)) ]|;














begin 

reserve a,b,c,d,e for ordinal number, m,n for Nat,
  f for Ordinal-Sequence,
  x for set;

theorem 
  a c= succ b implies a c= b or a = succ b;

registration
  cluster omega -> limit_ordinal;
  cluster -> Ordinal-yielding for empty set;
end;

registration
  cluster non empty finite for T-Sequence;
end;

registration
  let f be T-Sequence;
  let g be non empty T-Sequence;
  cluster f^g -> non empty;
  cluster g^f -> non empty;
end;

reserve S,S1,S2 for T-Sequence;

theorem 
  dom S = a+^b implies ex S1,S2 st S = S1^S2 & dom S1 = a & dom S2 = b;

theorem 
  rng S1 c= rng(S1^S2) & rng S2 c= rng(S1^S2);

theorem 
  S1^S2 is Ordinal-yielding implies
  S1 is Ordinal-yielding & S2 is Ordinal-yielding;

definition
  let f be T-Sequence;
  attr f is decreasing means

  for a,b st a in b & b in dom f holds f.b in f.a;
  attr f is non-decreasing means


  for a,b st a in b & b in dom f holds f.a c= f.b;
  attr f is non-increasing means

  for a,b st a in b & b in dom f holds f.b c= f.a;
end;

registration
  cluster increasing -> non-decreasing for Ordinal-Sequence;
  cluster decreasing -> non-increasing for Ordinal-Sequence;
end;

theorem 
  for f being T-Sequence holds f is infinite iff omega c= dom f;

registration
  cluster decreasing -> finite for T-Sequence;
  cluster -> decreasing increasing for empty set;
end;

registration
  let a;
  cluster <%a%> -> Ordinal-yielding;
end;

registration
  let a;
  cluster <%a%> -> decreasing increasing;
end;

registration
  cluster decreasing increasing non-decreasing non-increasing finite
  non empty for Ordinal-Sequence;
end;

theorem 
  for f being non-decreasing Ordinal-Sequence
  st dom f is non empty holds Union f is_limes_of f;

theorem 
  a in b implies n*^exp(omega, a) in exp(omega, b);

theorem 
  0 in a & (for b st b in dom f holds f.b = exp(a,b)) implies
  f is non-decreasing;

theorem 
  a is limit_ordinal & 0 in b implies exp(a,b) is limit_ordinal;

theorem 
  1 in a & (for b st b in dom f holds f.b = exp(a,b)) implies f is increasing;

theorem 
  0 in a & b is non empty limit_ordinal implies
  (x in exp(a,b) iff ex c st c in b & x in exp(a,c));

theorem 
  0 in a & exp(a,b) in exp(a,c) implies b in c;

begin 

definition
  let a,b be Ordinal;
  func a|^|^b -> Ordinal means


  ex phi being Ordinal-Sequence st it = last phi & dom phi = succ b &
  phi.{} = 1 &
  (for c being Ordinal st succ c in succ b holds phi.succ c = exp(a,phi.c))&
  for c being Ordinal st c in succ b & c <> {} & c is limit_ordinal
    holds phi.c = lim(phi|c);
end;

theorem 
  a |^|^ 0 = 1;

theorem 
  a |^|^ succ b = exp(a, a|^|^b);

theorem 
  b <> {} & b is limit_ordinal implies
  for phi being Ordinal-Sequence st dom phi = b &
     for c st c in b holds phi.c = a |^|^ c
  holds a |^|^ b = lim phi;

theorem 
  a |^|^ 1 = a;

theorem 
  1 |^|^ a = 1;

theorem 
  a |^|^ 2 = exp(a, a);

theorem 
  a |^|^ 3 = exp(a,exp(a, a));

theorem 
  for n being Nat holds 0 |^|^ (2*n) = 1 & 0 |^|^ (2*n+1) = 0;

theorem 
  a c= b & 0 in c implies c |^|^ a c= c |^|^ b;

theorem 
  0 in a & (for b st b in dom f holds f.b = a|^|^b) implies f is non-decreasing
;

theorem 
  0 in a & 0 in b implies a c= a |^|^ b;

theorem 
  1 in a & m < n implies a |^|^ m in a |^|^ n;




theorem 
  1 in a & dom f c= omega & (for b st b in dom f holds f.b = a|^|^b)
  implies f is increasing;

theorem 
  1 in a & 1 in b implies a in a |^|^ b;

theorem 
  for n,k being Nat holds exp(n,k) = n|^k;

registration
  let n,k be Nat;
  cluster exp(n,k) -> natural;
end;

registration
  let n,k be Nat;
  cluster n |^|^ k -> natural;
end;

theorem 
  for n,k being Nat st n > 1 holds n |^|^ k > k;

theorem 
  for n being Nat st n > 1 holds n |^|^ omega = omega;

theorem 
  1 in a implies a |^|^ omega is limit_ordinal;

theorem 
  0 in a implies exp(a, a |^|^ omega) = a |^|^ omega;

theorem 
  0 in a & omega c= b implies a |^|^ b = a |^|^ omega;

begin

scheme 
 CriticalNumber2
  {a() -> Ordinal, f() -> Ordinal-Sequence, phi(Ordinal) -> Ordinal}:
   a() c= Union f() & phi(Union f()) = Union f() &
   for b st a() c= b & phi(b) = b holds Union f() c= b
  provided
 for a,b st a in b holds phi(a) in phi(b) and
 for a st a is non empty limit_ordinal for phi being Ordinal-Sequence
      st dom phi = a & for b st b in a holds phi.b = phi(b)
    holds phi(a) is_limes_of phi
    and
 dom f() = omega & f().0 = a() and
 for a st a in omega holds f().(succ a) = phi(f().a);

scheme 
 CriticalNumber3{a() -> Ordinal, phi(Ordinal) -> Ordinal}:
  ex a st a() in a & phi(a) = a
  provided
 for a,b st a in b holds phi(a) in phi(b) and
 for a st a is non empty limit_ordinal for phi being Ordinal-Sequence
      st dom phi = a & for b st b in a holds phi.b = phi(b)
    holds phi(a) is_limes_of phi;

begin 

definition
  let a be ordinal number;
  attr a is epsilon means


  exp(omega,a) = a;
end;

theorem 
  ex b st a in b & b is epsilon;

registration
  cluster epsilon for ordinal number;
end;

definition
  let a be Ordinal;
  func first_epsilon_greater_than a -> epsilon Ordinal means


  a in it & for b being epsilon Ordinal st a in b holds it c= b;
end;

theorem 
  a c= b implies first_epsilon_greater_than a c= first_epsilon_greater_than b;

theorem 
  a in b & b in first_epsilon_greater_than a implies
  first_epsilon_greater_than b = first_epsilon_greater_than a;

theorem 
  first_epsilon_greater_than 0 = omega |^|^ omega;

theorem 
  for e being epsilon Ordinal holds omega in e;

registration
  cluster epsilon -> non empty limit_ordinal for Ordinal;
end;

theorem 
  for e being epsilon Ordinal holds
  exp(omega, exp(e, omega)) = exp(e, exp(e, omega));

theorem 
  for e being epsilon Ordinal st 0 in n holds
  e |^|^ (n+2) = exp(omega, e |^|^ (n+1));

theorem 
  for e being epsilon Ordinal holds first_epsilon_greater_than e = e |^|^ omega
;

definition
  let a be Ordinal;
  func epsilon_a -> Ordinal means




  ex phi being Ordinal-Sequence st it = last phi & dom phi = succ a &
  phi.{} = omega|^|^omega &
  (for b being Ordinal st succ b in succ a
    holds phi.succ b = (phi.b)|^|^omega) &
  for c being Ordinal st c in succ a & c <> {} & c is limit_ordinal
    holds phi.c = lim(phi|c);
end;

theorem 
  epsilon_0 = omega |^|^ omega;

theorem 
  epsilon_(succ a) = epsilon_a |^|^ omega;

theorem 
  b <> {} & b is limit_ordinal implies
  for phi being Ordinal-Sequence st dom phi = b &
     for c st c in b holds phi.c = epsilon_c
  holds epsilon_b = lim phi;

theorem 
  a in b implies epsilon_a in epsilon_b;

theorem 
  for phi being Ordinal-Sequence st
     for c st c in dom phi holds phi.c = epsilon_c
  holds phi is increasing;

theorem 
  b <> {} & b is limit_ordinal implies
  for phi being Ordinal-Sequence st dom phi = b &
     for c st c in b holds phi.c = epsilon_c
  holds epsilon_b = Union phi;

theorem 
  b is non empty limit_ordinal implies
  (x in epsilon_b iff ex c st c in b & x in epsilon_c);

theorem 
  a c= epsilon_a;

theorem 
  for X being non empty set st for x st x in X holds x is epsilon Ordinal &
    ex e being epsilon Ordinal st x in e & e in X
  holds union X is epsilon Ordinal;

theorem 
  for X being non empty set st (for x st x in X holds x is epsilon Ordinal) &
    for a st a in X holds first_epsilon_greater_than a in X
  holds union X is epsilon Ordinal;

registration
  let a;
  cluster epsilon_a -> epsilon;
end;


theorem 
  a is epsilon implies ex b st a = epsilon_b;

begin 

definition
  let A be finite Ordinal-Sequence; 
  func Sum^ A -> Ordinal means


  ex f being Ordinal-Sequence st it = last f & dom f = succ dom A &
  f.0 = 0 & for n being Nat st n in dom A holds f.(n+1) = f.n +^ A.n;
end;

theorem 
  Sum^ {} = 0;

theorem 
  Sum^ <%a%> = a;

theorem 
  for A being finite Ordinal-Sequence holds Sum^ (A^<%a%>) = (Sum^ A) +^ a;

theorem 
  for A being finite Ordinal-Sequence holds Sum^ (<%a%>^A) = a +^ Sum^ A;

theorem 
  for A being finite Ordinal-Sequence holds A.0 c= Sum^ A;

definition
  let a;
  attr a is Cantor-component means


  ex b,n st 0 in n & a = n*^exp(omega,b);
end;

registration
  cluster Cantor-component -> non empty for Ordinal;
end;

registration
  cluster Cantor-component for Ordinal;
end;

definition
  let a,b;
  func b-exponent(a) -> Ordinal means


  exp(b,it) c= a & for c st exp(b,c) c= a holds c c= it if 1 in b & 0 in a
  otherwise it = 0;
end;

theorem 
  1 in b implies a in exp(b, succ(b-exponent(a)));

theorem 
  0 in n & n in b implies b-exponent(n*^exp(b,a)) = a;

theorem 
  0 in a & 1 in b & c = b-exponent a implies a div^ exp(b, c) in b;

theorem 
  0 in a & 1 in b & c = b-exponent a implies 0 in a div^ exp(b, c);

theorem 
  b <> 0 implies a mod^ exp(b, c) in exp(b, c);

theorem 
  0 in a implies ex n,c st a = n*^exp(omega, omega-exponent(a))+^c & 0 in n &
  c in exp(omega, omega-exponent(a));

theorem 
  1 in c & c-exponent b in c-exponent a implies b in a;

definition
  let A be Ordinal-Sequence;
  attr A is Cantor-normal-form means


  (for a st a in dom A holds A.a is Cantor-component) &
  for a,b st a in b & b in dom A holds
  omega-exponent(A.b) in omega-exponent(A.a);
end;

registration
  cluster empty -> Cantor-normal-form for Ordinal-Sequence;


  cluster Cantor-normal-form -> decreasing for Ordinal-Sequence;
end;

reserve A,B for Cantor-normal-form Ordinal-Sequence;

theorem 
  Sum^ A = 0 implies A = {};

theorem 
  0 in n implies <%n*^exp(omega,b)%> is Cantor-normal-form;

registration
  cluster non empty Cantor-normal-form for Ordinal-Sequence;
end;

theorem 
  for A,B being Ordinal-Sequence st A^B is Cantor-normal-form
  holds A is Cantor-normal-form & B is Cantor-normal-form;

theorem 
  A <> {} implies ex c being Cantor-component Ordinal, B st A = <%c%>^B;

theorem 
  for A being non empty Cantor-normal-form Ordinal-Sequence
  for c being Cantor-component Ordinal
  st omega-exponent(A.0) in omega-exponent(c)
  holds <%c%>^A is Cantor-normal-form;


theorem 
  ex A being Cantor-normal-form Ordinal-Sequence st a = Sum^ A;















begin 

definition
  let X be 1-sorted, y be real number;
  func X --> y -> RealMap of X equals

  (the carrier of X) --> y;
end;

registration
  let X be TopSpace, y be real number;
  cluster X --> y -> continuous;
end;

theorem 
  for X being non empty TopSpace, f be RealMap of X holds f is continuous iff
  for x being Point of X,V being Subset of REAL st
  f.x in V & V is open holds
  ex W being Subset of X st x in W & W is open & f.:W c= V;

definition let X be non empty TopSpace;
  func ContinuousFunctions(X) -> Subset of RAlgebra the carrier of X equals

  { f where f is continuous RealMap of X : not contradiction };
end;

registration
  let X be non empty TopSpace;
  cluster ContinuousFunctions(X) -> non empty;
end;

registration
  let X be non empty TopSpace;
  cluster ContinuousFunctions(X) -> additively-linearly-closed
                                   multiplicatively-closed;
end;

definition
  let X be non empty TopSpace;
  func R_Algebra_of_ContinuousFunctions(X) -> AlgebraStr equals

  AlgebraStr (# ContinuousFunctions(X),
    mult_(ContinuousFunctions(X),RAlgebra the carrier of X),
    Add_(ContinuousFunctions(X),RAlgebra the carrier of X),
    Mult_(ContinuousFunctions(X),RAlgebra the carrier of X),
    One_(ContinuousFunctions(X),RAlgebra the carrier of X),
    Zero_(ContinuousFunctions(X),RAlgebra the carrier of X) #);
end;

theorem 
  for X being non empty TopSpace holds
  R_Algebra_of_ContinuousFunctions(X)
    is Subalgebra of RAlgebra the carrier of X;

registration
  let X be non empty TopSpace;
  cluster R_Algebra_of_ContinuousFunctions(X) -> strict non empty;
end;

registration
  let X be non empty TopSpace;
  cluster R_Algebra_of_ContinuousFunctions(X) -> Abelian add-associative
    right_zeroed right_complementable vector-distributive scalar-distributive
    scalar-associative scalar-unital
    commutative associative right_unital right-distributive
    vector-distributive scalar-distributive scalar-associative
    vector-associative;
end;

theorem 
  for X being non empty TopSpace
  for F,G,H being VECTOR of R_Algebra_of_ContinuousFunctions(X)
  for f,g,h being RealMap of X holds
  (f=F & g=G & h=H implies ( H = F+G iff (for x be Element of the carrier of X
  holds h.x = f.x + g.x)));

theorem 
  for X being non empty TopSpace
  for F,G,H being VECTOR of R_Algebra_of_ContinuousFunctions(X)
  for f,g,h being RealMap of X
  for a being Real
    holds
  (f=F & g=G implies ( G = a*F iff for x be Element of X holds g.x = a*f.x ));

theorem 
  for X being non empty TopSpace
  for F,G,H being VECTOR of R_Algebra_of_ContinuousFunctions(X)
  for f,g,h being RealMap of X holds
  (f=F & g=G & h=H implies ( H = F*G iff (for x be Element of the carrier of X
  holds h.x = f.x * g.x)));

theorem 
  for X being non empty TopSpace holds
  0.R_Algebra_of_ContinuousFunctions(X) = X --> 0;

theorem 
  for X being non empty TopSpace holds
  1_R_Algebra_of_ContinuousFunctions(X) = X --> 1;

theorem 
  for A being Algebra, A1,A2 being Subalgebra of A holds
  the carrier of A1 c= the carrier of A2 implies A1 is Subalgebra of A2;

theorem 
  for X being compact non empty TopSpace holds
  (R_Algebra_of_ContinuousFunctions(X) is
    Subalgebra of R_Algebra_of_BoundedFunctions the carrier of X);

definition
  let X be compact non empty TopSpace;
  func ContinuousFunctionsNorm(X) -> Function of (ContinuousFunctions(X)),REAL
    equals

  (BoundedFunctionsNorm the carrier of X)|(ContinuousFunctions(X));
end;

definition
  let X be compact non empty TopSpace;
  func R_Normed_Algebra_of_ContinuousFunctions(X) -> Normed_AlgebraStr equals

    Normed_AlgebraStr (# ContinuousFunctions(X),
      mult_(ContinuousFunctions(X),RAlgebra the carrier of X),
      Add_(ContinuousFunctions(X),RAlgebra the carrier of X),
      Mult_(ContinuousFunctions(X),RAlgebra the carrier of X),
      One_(ContinuousFunctions(X),RAlgebra the carrier of X),
      Zero_(ContinuousFunctions(X),RAlgebra the carrier of X),
      ContinuousFunctionsNorm(X) #);
end;

registration
  let X be compact non empty TopSpace;
  cluster R_Normed_Algebra_of_ContinuousFunctions(X) -> strict non empty;
end;

registration
  let X be compact non empty TopSpace;
  cluster R_Normed_Algebra_of_ContinuousFunctions(X) -> unital;
end;

theorem 
  for W be Normed_AlgebraStr, V be Algebra st
    the AlgebraStr of W = V holds W is Algebra;

registration
  let X be compact non empty TopSpace;
  cluster R_Normed_Algebra_of_ContinuousFunctions(X) ->
          Abelian add-associative right_zeroed right_complementable
          commutative associative right_unital right-distributive
          vector-distributive scalar-distributive scalar-associative
          vector-associative;
end;

theorem 
  for X being compact non empty TopSpace
  for F being Point of R_Normed_Algebra_of_ContinuousFunctions(X) holds
  (Mult_(ContinuousFunctions(X), RAlgebra the carrier of X)).(1,F) = F;

registration
  let X be compact non empty TopSpace;
  cluster R_Normed_Algebra_of_ContinuousFunctions(X) -> vector-distributive
  scalar-distributive scalar-associative scalar-unital;
end;

theorem 
  for X being compact non empty TopSpace holds
  X --> 0 = 0.R_Normed_Algebra_of_ContinuousFunctions(X);

theorem 
  for X be compact non empty TopSpace
  for F be Point of R_Normed_Algebra_of_ContinuousFunctions(X)
    holds 0 <= ||.F.||;

theorem 
  for X being compact non empty TopSpace
  for F be Point of R_Normed_Algebra_of_ContinuousFunctions(X) holds
  F = 0.R_Normed_Algebra_of_ContinuousFunctions(X) implies 0 = ||.F.||;

theorem 
  for X being compact non empty TopSpace
  for F,G,H being Point of R_Normed_Algebra_of_ContinuousFunctions(X)
  for f,g,h be RealMap of X
    holds
  (f=F & g=G & h=H implies
  (H = F+G iff for x be Element of X holds h.x = f.x + g.x));

theorem 
  for a be Real
  for X being compact non empty TopSpace
  for F,G being Point of R_Normed_Algebra_of_ContinuousFunctions(X)
  for f,g being RealMap of X holds
  (f=F & g=G implies ( G = a*F iff for x be Element of X holds g.x = a*f.x ));

theorem 
  for X being compact non empty TopSpace
  for F,G,H being Point of R_Normed_Algebra_of_ContinuousFunctions(X)
  for f,g,h being RealMap of X holds
  (f=F & g=G & h=H implies
  (H = F*G iff for x be Element of X holds h.x = f.x * g.x));

theorem 
  for a being Real
  for X being compact non empty TopSpace
  for F,G being Point of R_Normed_Algebra_of_ContinuousFunctions(X) holds
( ||.F.|| = 0 iff F = 0.R_Normed_Algebra_of_ContinuousFunctions(X)) &
(||.a*F.|| = abs a * ||.F.|| & ||.F+G.|| <= ||.F.|| + ||.G.||);

registration
  let X be compact non empty TopSpace;
  cluster R_Normed_Algebra_of_ContinuousFunctions(X) ->
    reflexive discerning RealNormSpace-like;
end;

theorem 
  for X be compact non empty TopSpace
  for F,G,H be Point of R_Normed_Algebra_of_ContinuousFunctions(X)
  for f,g,h be RealMap of X holds
  f=F & g=G & h=H implies
  (H = F-G iff (for x be Element of X holds h.x = f.x - g.x));

theorem 
  for X be RealBanachSpace, Y be Subset of X, seq be sequence of X st
    Y is closed & rng seq c= Y & seq is Cauchy_sequence_by_Norm holds
  seq is convergent & lim seq in Y;

theorem 
  for X be compact non empty TopSpace
  for Y be Subset of R_Normed_Algebra_of_BoundedFunctions the carrier of X st
  Y = ContinuousFunctions(X) holds Y is closed;

theorem 
  for X be compact non empty TopSpace
  for seq be sequence of R_Normed_Algebra_of_ContinuousFunctions(X) st
    seq is Cauchy_sequence_by_Norm holds seq is convergent;

registration
  let X be compact non empty TopSpace;
  cluster R_Normed_Algebra_of_ContinuousFunctions(X) -> complete;
end;

registration
  let X be compact non empty TopSpace;
  cluster R_Normed_Algebra_of_ContinuousFunctions(X) -> Banach_Algebra-like;
end;

begin 

theorem 
  for X be non empty TopSpace
  for f,g be RealMap of X holds
    support(f+g) c= support(f) \/ support(g);

theorem 
  for X be non empty TopSpace
  for a be Real,f be RealMap of X holds
    support(a(#)f) c= support(f);

theorem 
  for X be non empty TopSpace
  for f,g be RealMap of X holds support(f(#)g) c= support(f) \/ support(g);

begin 

definition
  let X be non empty TopSpace;
  func C_0_Functions(X) -> non empty Subset of RealVectSpace the carrier of X
    equals

  { f where f is RealMap of X : f is continuous &
    ex Y be non empty Subset of X st (Y is compact &
    (for A being Subset of X st A=support(f) holds Cl(A) is Subset of Y))};
end;

theorem 
  for X be non empty TopSpace holds
  C_0_Functions(X) is non empty Subset of RAlgebra the carrier of X;

theorem 
  for X be non empty TopSpace
  for W be non empty Subset of RAlgebra the carrier of X
      st W = C_0_Functions(X) holds W is additively-linearly-closed;

theorem 
  for X be non empty TopSpace holds
  C_0_Functions(X) is linearly-closed;

registration
  let X be non empty TopSpace;
  cluster C_0_Functions(X) -> non empty linearly-closed;
end;

definition
  let X be non empty TopSpace;
  func R_VectorSpace_of_C_0_Functions(X) -> RealLinearSpace equals

  RLSStruct (# C_0_Functions(X),
  Zero_(C_0_Functions(X), RealVectSpace(the carrier of X)),
  Add_(C_0_Functions(X), RealVectSpace(the carrier of X)),
  Mult_(C_0_Functions(X), RealVectSpace(the carrier of X)) #);
end;

theorem 
  for X be non empty TopSpace holds
  R_VectorSpace_of_C_0_Functions(X)
  is Subspace of RealVectSpace(the carrier of X);

theorem 
  for X be non empty TopSpace
  for x being set st x in C_0_Functions(X) holds
  x in BoundedFunctions the carrier of X;

definition
  let X be non empty TopSpace;
  func C_0_FunctionsNorm X -> Function of (C_0_Functions(X)),REAL equals

  (BoundedFunctionsNorm the carrier of X)|(C_0_Functions(X));
end;

definition
  let X be non empty TopSpace;
  func R_Normed_Space_of_C_0_Functions(X) -> non empty NORMSTR equals

  NORMSTR (# C_0_Functions(X),
  Zero_(C_0_Functions(X), RealVectSpace(the carrier of X)),
  Add_(C_0_Functions(X), RealVectSpace(the carrier of X)),
  Mult_(C_0_Functions(X), RealVectSpace(the carrier of X)),
        C_0_FunctionsNorm X #);
end;

registration
  let X be non empty TopSpace;
  cluster R_Normed_Space_of_C_0_Functions(X) -> strict non empty;
end;

theorem 
  for X be non empty TopSpace
  for x being set st x in C_0_Functions(X) holds
  x in ContinuousFunctions(X);

theorem 
  for X be non empty TopSpace holds
  0.R_VectorSpace_of_C_0_Functions(X) = X -->0;

theorem 
  for X be non empty TopSpace holds
  0.R_Normed_Space_of_C_0_Functions(X) = X --> 0;

theorem 
  for a be Real
  for X be non empty TopSpace
  for F,G be Point of R_Normed_Space_of_C_0_Functions(X) holds
  (||.F.|| = 0 iff F = 0.R_Normed_Space_of_C_0_Functions(X) ) &
  ||.a*F.|| = abs a * ||.F.|| & ||.F+G.|| <= ||.F.|| + ||.G.||;

theorem 
  for X be non empty TopSpace holds
  R_Normed_Space_of_C_0_Functions(X) is RealNormSpace-like;

registration
  let X be non empty TopSpace;
  cluster R_Normed_Space_of_C_0_Functions(X) ->
  reflexive discerning RealNormSpace-like
  vector-distributive scalar-distributive scalar-associative scalar-unital
  Abelian add-associative right_zeroed right_complementable;
end;

theorem 
  for X be non empty TopSpace holds
    R_Normed_Space_of_C_0_Functions(X) is RealNormSpace;















begin 

registration
  let X be set;
  let f be Function of NAT, X;
  let n be Nat;
  cluster f|n -> T-Sequence-like;
end;

definition
  let X,x be set;
  func IFXFinSequence(x,X) -> XFinSequence of X equals

  x if x is XFinSequence of X
  otherwise <%>X;
end;

definition
  let X be non empty set;
  let f be Function of X^omega, X;
  let c be XFinSequence of X;
  redefine func f.c -> Element of X;
end;

theorem 
  for X,Y,Z being set st Y c= the_universe_of X & Z c= the_universe_of X
  holds [:Y,Z:] c= the_universe_of X;

scheme 
 FuncRecursiveUniq { F(set) -> set, F1,F2() -> Function }:
  F1() = F2()
  provided
 dom F1() = NAT & for n being Nat holds F1().n = F(F1()|n) and
 dom F2() = NAT & for n being Nat holds F2().n = F(F2()|n);

scheme 
 FuncRecursiveExist { F(set) -> set }:
  ex f being Function st dom f = NAT &
  for n being Nat holds f.n = F(f|n);

scheme 
 FuncRecursiveUniqu2
  { X() -> non empty set, F(XFinSequence of X()) -> Element of X(),
    F1,F2() -> Function of NAT, X()}:
  F1() = F2()
  provided
 for n being Nat holds F1().n = F(F1()|n) and
 for n being Nat holds F2().n = F(F2()|n);

scheme 
 FuncRecursiveExist2
  { X() -> non empty set, F(XFinSequence of X()) -> Element of X() }:
  ex f being Function of NAT, X() st
  for n being Nat holds f.n = F(f|n);

definition
  let f,g be Function;
  pred f extends g means

  dom g c= dom f & f tolerates g;
end;

registration
  cluster empty for multMagma;
end;

begin 


definition
  let M be multMagma;
  let R be Equivalence_Relation of M;
  attr R is compatible means

  for v,v9,w,w9 being Element of M st v in Class(R,v9) & w in Class(R,w9)
  holds v*w in Class(R,v9*w9);
end;

registration
  let M be multMagma;
  cluster nabla the carrier of M -> compatible;
end;

registration
  let M be multMagma;
  cluster compatible for Equivalence_Relation of M;
end;

theorem 
  for M being multMagma, R being Equivalence_Relation of M holds
  R is compatible iff for v,v9,w,w9 being Element of M
    st Class(R,v) = Class(R,v9) & Class(R,w) = Class(R,w9)
    holds Class(R,v*w) = Class(R,v9*w9);

definition
  let M be multMagma;
  let R be compatible Equivalence_Relation of M;
  func ClassOp R -> BinOp of Class R means

  for x,y being Element of Class R, v,w being Element of M
    st x = Class(R,v) & y = Class(R,w) holds it.(x,y) = Class(R,v*w)
    if M is non empty otherwise it = {};
end;



definition
  let M be multMagma;
  let R be compatible Equivalence_Relation of M;
  func M ./. R -> multMagma equals

  multMagma(# Class R, ClassOp R #);
end;

registration
  let M be multMagma;
  let R be compatible Equivalence_Relation of M;
  cluster M ./. R -> strict;
end;

registration
  let M be non empty multMagma;
  let R be compatible Equivalence_Relation of M;
  cluster M ./. R -> non empty;
end;

definition
  let M be non empty multMagma;
  let R be compatible Equivalence_Relation of M;
  func nat_hom R -> Function of M, M ./. R means

  for v being Element of M holds it.v = Class(R,v);
end;

registration
  let M be non empty multMagma;
  let R be compatible Equivalence_Relation of M;
  cluster nat_hom R -> multiplicative;
end;

registration
  let M be non empty multMagma;
  let R be compatible Equivalence_Relation of M;
  cluster nat_hom R -> onto;
end;

definition
  let M be multMagma;
  mode Relators of M is [:the carrier of M,the carrier of M:]-valued Function;
end;



definition
  let M be multMagma;
  let r be Relators of M;
  func equ_rel r -> Equivalence_Relation of M equals

  meet {R where R is compatible Equivalence_Relation of M:
     for i being set, v,w being Element of M st i in dom r & r.i = [v,w]
       holds v in Class(R,w)};
end;

theorem 
  for M being multMagma, r being Relators of M,
      R being compatible Equivalence_Relation of M
  st (for i being set, v,w being Element of M st i in dom r & r.i = [v,w]
       holds v in Class(R,w))
  holds equ_rel r c= R;

registration
  let M be multMagma;
  let r be Relators of M;
  cluster equ_rel r -> compatible;
end;

definition
  let X,Y be set;
  let f be Function of X,Y;
  func equ_kernel f -> Equivalence_Relation of X means

  for x,y being set holds [x,y] in it iff x in X & y in X & f.x = f.y;
end;

reserve M,N for non empty multMagma,
  f for Function of M, N;

theorem 
  f is multiplicative implies equ_kernel f is compatible;

theorem 
  f is multiplicative implies
  ex r being Relators of M st equ_kernel f = equ_rel r;

begin 

definition
  let M be multMagma;
  mode multSubmagma of M -> multMagma means

    the carrier of it c= the carrier of M &
    the multF of it = (the multF of M)||the carrier of it;
end;

registration
  let M be multMagma;
  cluster strict for multSubmagma of M;
end;

registration
  let M be non empty multMagma;
  cluster non empty for multSubmagma of M;
end;

reserve M for multMagma;
reserve N,K for multSubmagma of M;



theorem 
  N is multSubmagma of K & K is multSubmagma of N
  implies the multMagma of N = the multMagma of K;

theorem 
  the carrier of N = the carrier of M
  implies the multMagma of N = the multMagma of M;



definition
  let M be multMagma;
  let A be Subset of M;
  attr A is stable means

  for v,w being Element of M st v in A & w in A holds v*w in A;
end;

registration
  let M be multMagma;
  cluster stable for Subset of M;
end;

theorem 
  the carrier of N is stable Subset of M;

registration
  let M be multMagma;
  let N be multSubmagma of M;
  cluster the carrier of N -> stable for Subset of M;
end;

theorem 
  for F being Function st
  (for i being set st i in dom F holds F.i is stable Subset of M) holds
  meet F is stable Subset of M;

reserve M,N for non empty multMagma,
  A for Subset of M,
  f,g for Function of M,N,
  X for stable Subset of M,
  Y for stable Subset of N;

theorem 
  A is stable iff A * A c= A;



theorem 
  f is multiplicative implies f.:X is stable Subset of N;



theorem 
  f is multiplicative implies f"Y is stable Subset of M;



theorem 
  f is multiplicative & g is multiplicative
  implies {v where v is Element of M: f.v=g.v} is stable Subset of M;



definition
  let M be multMagma;
  let A be stable Subset of M;
  func the_mult_induced_by A -> BinOp of A equals

  (the multF of M) || A;
end;



definition
  let M be multMagma;
  let A be Subset of M;
  func the_submagma_generated_by A -> strict multSubmagma of M means

  A c= the carrier of it & for N being strict multSubmagma of M
  st A c= the carrier of N holds it is multSubmagma of N;
end;

theorem 
  for M being multMagma, A being Subset of M
  holds A is empty iff the_submagma_generated_by A is empty;

registration
  let M be multMagma;
  let A be empty Subset of M;
  cluster the_submagma_generated_by A -> empty;
end;



theorem 
  for M,N being non empty multMagma, f being Function of M,N,
      X being Subset of M st f is multiplicative holds
  f.:the carrier of the_submagma_generated_by X =
  the carrier of the_submagma_generated_by f.:X;

begin 


definition
  let X be set;
  func free_magma_seq X ->
    Function of NAT, bool the_universe_of(X \/ NAT) means

    it.0 = {} & it.1 = X & for n being Nat st n>=2 holds
      ex fs being FinSequence st len fs = n-1 &
      (for p being Nat st p>=1 & p<=n-1 holds
      fs.p = [: it.p, it.(n-p) :] ) & it.n = Union disjoin fs;
end;

definition
  let X be set;
  let n be Nat;
  func free_magma(X,n) equals

(free_magma_seq X).n;
end;

registration
  let X be non empty set;
  let n be non zero Nat;
  cluster free_magma(X,n) -> non empty;
end;

reserve X for set;

theorem 
  free_magma(X,0) = {};

theorem 
  free_magma(X,1) = X;

theorem 
  free_magma(X,2) = [:[:X,X:],{1}:];

theorem 
  free_magma(X,3) = [:[:X,[:[:X,X:],{1}:]:],{1}:] \/
    [:[:[:[:X,X:],{1}:],X:],{2}:];

reserve x,y,Y for set;
reserve n,m,p for Nat;

theorem 
  n >= 2 implies ex fs being FinSequence st len fs = n-1 &
    (for p st p>=1 & p<=n-1 holds
       fs.p = [: free_magma(X,p), free_magma(X,n-'p) :] ) &
    free_magma(X,n) = Union disjoin fs;

theorem 
  n >= 2 & x in free_magma(X,n) implies ex p,m st x`2 = p & 1<=p & p<=n-1 &
    x`1`1 in free_magma(X,p) & x`1`2 in free_magma(X,m) & n = p + m &
    x in [:[:free_magma(X,p),free_magma(X,m):],{p}:];

theorem 
  x in free_magma(X,n) & y in free_magma(X,m) implies
  [[x,y],n] in free_magma(X,n+m);

theorem 
  X c= Y implies free_magma(X,n) c= free_magma(Y,n);

definition
  let X be set;
  func free_magma_carrier X equals

Union disjoin((free_magma_seq X)|NATPLUS);
end;

theorem 
  X = {} iff free_magma_carrier X = {};

registration
  let X be empty set;
  cluster free_magma_carrier X -> empty;
end;

registration
  let X be non empty set;
  cluster free_magma_carrier X -> non empty;
  let w be Element of free_magma_carrier X;
  cluster w`2 -> non zero natural for number;
end;

theorem 
  for X being non empty set, w being Element of free_magma_carrier X
  holds w in [:free_magma(X,w`2),{w`2}:];

theorem 
  for X being non empty set, v,w being Element of free_magma_carrier X
  holds [[[v`1,w`1],v`2],v`2+w`2] is Element of free_magma_carrier X;

theorem 
  X c= Y implies free_magma_carrier X c= free_magma_carrier Y;

theorem 
  n>0 implies [:free_magma(X,n),{n}:] c= free_magma_carrier X;

definition
  let X be set;
  func free_magma_mult X -> BinOp of free_magma_carrier X means

  for v,w being Element of free_magma_carrier X, n,m st n = v`2 & m = w`2
    holds it.(v,w) = [[[v`1,w`1],v`2],n+m]
    if X is non empty otherwise it = {};
end;



definition
  let X be set;
  func free_magma X -> multMagma equals

  multMagma(# free_magma_carrier X, free_magma_mult X #);
end;

registration
  let X be set;
  cluster free_magma X -> strict;
end;

registration
  let X be empty set;
  cluster free_magma X -> empty;
end;

registration
  let X be non empty set;
  cluster free_magma X -> non empty;
  let w be Element of free_magma X;
  cluster w`2 -> non zero natural for number;
end;

theorem 
  for X being set, S being Subset of X
  holds free_magma S is multSubmagma of free_magma X;

definition
  let X be set;
  let w be Element of free_magma X;
  func length w -> Nat equals

  w`2 if X is non empty otherwise 0;
end;

theorem 
  X = {w`1 where w is Element of free_magma X: length w = 1};

reserve v,v1,v2,w,w1,w2 for Element of free_magma X;

theorem 
  X is non empty implies v*w = [[[v`1,w`1],v`2],length v + length w];

theorem 
  X is non empty implies v = [v`1,v`2] & length v >= 1;

theorem 
  length(v*w) = length v + length w;

theorem 
  length w >= 2 implies
  ex w1,w2 st w = w1*w2 & length w1 < length w & length w2 < length w;

theorem 
  v1*v2 = w1*w2 implies v1 = w1 & v2 = w2;

definition
  let X be set;
  let n be Nat;
  func canon_image(X,n) -> Function of free_magma(X,n),free_magma X means


  for x st x in dom it holds it.x = [x,n] if n > 0 otherwise it = {};
end;

registration
  let X be set;
  let n be Nat;
  cluster canon_image(X,n) -> one-to-one;
end;

reserve X,Y,Z for non empty set;

theorem 
  for A being Subset of free_magma X st A = canon_image(X,1) .: X
    holds free_magma X = the_submagma_generated_by A;

theorem 
  for R being compatible Equivalence_Relation of free_magma(X) holds
  (free_magma X)./.R =
  the_submagma_generated_by (nat_hom R).: (canon_image(X,1) .: X);

theorem 
  for f being Function of X,Y
  holds canon_image(Y,1)*f is Function of X, free_magma Y;

definition
  let X be non empty set;
  let M be non empty multMagma;
  let n,m be non zero Nat;
  let f be Function of free_magma(X,n),M;
  let g be Function of free_magma(X,m),M;
  func [:f,g:] ->
  Function of [:[:free_magma(X,n),free_magma(X,m):],{n}:], M means

  for x being Element of [:[:free_magma(X,n),free_magma(X,m):],{n}:],
      y being Element of free_magma(X,n), z being Element of free_magma(X,m)
  st y = x`1`1 & z = x`1`2 holds it.x = f.y * g.z;
end;

reserve M for non empty multMagma;



theorem 
  for f being Function of X,M holds
  ex h being Function of free_magma X, M st h is multiplicative &
     h extends f*(canon_image(X,1)");

theorem 
  for f being Function of X,M, h,g being Function of free_magma X, M
  st h is multiplicative & h extends f*(canon_image(X,1)") &
     g is multiplicative & g extends f*(canon_image(X,1)") holds h = g;

reserve M,N for non empty multMagma,
      f for Function of M, N,
      H for non empty multSubmagma of N,
      R for compatible Equivalence_Relation of M;

theorem 
  f is multiplicative & the carrier of H = rng f & R = equ_kernel f implies
  ex g being Function of M./.R, H st f = g * nat_hom R &
  g is bijective & g is multiplicative;

theorem 
  for g1,g2 being Function of M./.R, N st g1 * nat_hom R = g2 * nat_hom R
  holds g1 = g2;

theorem 
  for M being non empty multMagma holds ex X being non empty set,
       r being Relators of free_magma X,
       g being Function of (free_magma X) ./. equ_rel r, M
    st g is bijective & g is multiplicative;

definition
  let X,Y be non empty set;
  let f be Function of X,Y;
  func free_magmaF f -> Function of free_magma X, free_magma Y means

  it is multiplicative & it extends (canon_image(Y,1)*f)*(canon_image(X,1)");
end;

registration
  let X,Y be non empty set;
  let f be Function of X,Y;
  cluster free_magmaF f -> multiplicative;
end;

reserve f for Function of X,Y;
reserve g for Function of Y,Z;

theorem 
  free_magmaF(g*f) = free_magmaF(g)*free_magmaF(f);

theorem 
  for g being Function of X,Z st Y c= Z & f=g
  holds free_magmaF f = free_magmaF g;

theorem 
  free_magmaF id X = id dom free_magmaF f;



theorem 
  f is one-to-one implies free_magmaF f is one-to-one;



theorem 
  f is onto implies free_magmaF f is onto;














begin 

reserve D for set;
reserve x,x0,x1,x2,y,y0,y1,y2,z,z0,z1,z2,r,s,t for Real;
reserve p,a,u,u0 for Element of REAL 3;
reserve n,m,k for Element of NAT;
reserve f,f1,f2,f3,g for PartFunc of REAL 3,REAL;
reserve R,R1,R2 for RestFunc;
reserve L,L1,L2 for LinearFunc;

theorem 
  dom proj(1,3) = REAL 3 & rng proj(1,3) = REAL &
  for x,y,z be Element of REAL holds proj(1,3).<*x,y,z*> = x;

theorem 
  dom proj(2,3) = REAL 3 & rng proj(2,3) = REAL &
  for x,y,z be Element of REAL holds proj(2,3).<*x,y,z*> = y;

theorem 
  dom proj(3,3) = REAL 3 & rng proj(3,3) = REAL &
  for x,y,z be Element of REAL holds proj(3,3).<*x,y,z*> = z;

begin 

theorem 
  u = <*x,y,z*> & f is_partial_differentiable_in u,1 implies
  SVF1(1,f,u) is_differentiable_in x;

theorem 
  u = <*x,y,z*> & f is_partial_differentiable_in u,2 implies
  SVF1(2,f,u) is_differentiable_in y;

theorem 
  u = <*x,y,z*> & f is_partial_differentiable_in u,3 implies
  SVF1(3,f,u) is_differentiable_in z;

theorem 
  for f be PartFunc of REAL 3,REAL for u be Element of REAL 3 holds
  (ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  SVF1(1,f,u) is_differentiable_in x0) iff
  f is_partial_differentiable_in u,1;

theorem 
  for f be PartFunc of REAL 3,REAL for u be Element of REAL 3 holds
  (ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  SVF1(2,f,u) is_differentiable_in y0) iff
  f is_partial_differentiable_in u,2;

theorem 
  for f be PartFunc of REAL 3,REAL for u be Element of REAL 3 holds
  (ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  SVF1(3,f,u) is_differentiable_in z0) iff
  f is_partial_differentiable_in u,3;

theorem 
  u = <*x0,y0,z0*> & f is_partial_differentiable_in u,1 implies
  ex N being Neighbourhood of x0 st N c= dom SVF1(1,f,u) &
  ex L,R st for x st x in N holds
  SVF1(1,f,u).x - SVF1(1,f,u).x0 = L.(x-x0) + R.(x-x0);

theorem 
  u = <*x0,y0,z0*> & f is_partial_differentiable_in u,2 implies
  ex N being Neighbourhood of y0 st N c= dom SVF1(2,f,u) &
  ex L,R st for y st y in N holds
  SVF1(2,f,u).y - SVF1(2,f,u).y0 = L.(y-y0) + R.(y-y0);

theorem 
  u = <*x0,y0,z0*> & f is_partial_differentiable_in u,3 implies
  ex N being Neighbourhood of z0 st N c= dom SVF1(3,f,u) &
  ex L,R st for z st z in N holds
  SVF1(3,f,u).z - SVF1(3,f,u).z0 = L.(z-z0) + R.(z-z0);

theorem 
  for f be PartFunc of REAL 3,REAL for u be Element of REAL 3 holds
  f is_partial_differentiable_in u,1 iff
  ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  ex N being Neighbourhood of x0 st N c= dom SVF1(1,f,u) &
  ex L,R st for x st x in N holds
  SVF1(1,f,u).x - SVF1(1,f,u).x0 = L.(x-x0) + R.(x-x0);

theorem 
  for f be PartFunc of REAL 3,REAL for u be Element of REAL 3 holds
  f is_partial_differentiable_in u,2 iff
  ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  ex N being Neighbourhood of y0 st N c= dom SVF1(2,f,u) &
  ex L,R st for y st y in N holds
  SVF1(2,f,u).y - SVF1(2,f,u).y0 = L.(y-y0) + R.(y-y0);

theorem 
  for f be PartFunc of REAL 3,REAL for u be Element of REAL 3 holds
  f is_partial_differentiable_in u,3 iff
  ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  ex N being Neighbourhood of z0 st N c= dom SVF1(3,f,u) &
  ex L,R st for z st z in N holds
  SVF1(3,f,u).z - SVF1(3,f,u).z0 = L.(z-z0) + R.(z-z0);

theorem 
  u = <*x0,y0,z0*> & f is_partial_differentiable_in u,1 implies
  (r = partdiff(f,u,1) iff
  ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  ex N being Neighbourhood of x0 st N c= dom SVF1(1,f,u) &
  ex L,R st r = L.1 & for x st x in N holds
  SVF1(1,f,u).x - SVF1(1,f,u).x0 = L.(x-x0) + R.(x-x0));

theorem 
  u = <*x0,y0,z0*> & f is_partial_differentiable_in u,2 implies
  (r = partdiff(f,u,2) iff
  ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  ex N being Neighbourhood of y0 st N c= dom SVF1(2,f,u) &
  ex L,R st r = L.1 & for y st y in N holds
  SVF1(2,f,u).y - SVF1(2,f,u).y0 = L.(y-y0) + R.(y-y0));

theorem 
  u = <*x0,y0,z0*> & f is_partial_differentiable_in u,3 implies
  (r = partdiff(f,u,3) iff
  ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  ex N being Neighbourhood of z0 st N c= dom SVF1(3,f,u) &
  ex L,R st r = L.1 & for z st z in N holds
  SVF1(3,f,u).z - SVF1(3,f,u).z0 = L.(z-z0) + R.(z-z0));

theorem 
  u = <*x0,y0,z0*> implies partdiff(f,u,1) = diff(SVF1(1,f,u),x0);

theorem 
  u = <*x0,y0,z0*> implies partdiff(f,u,2) = diff(SVF1(2,f,u),y0);

theorem 
  u = <*x0,y0,z0*> implies partdiff(f,u,3) = diff(SVF1(3,f,u),z0);

definition
  let f be PartFunc of REAL 3,REAL;
  let D be set;
  pred f is_partial_differentiable`1_on D means

  D c= dom f & for u be Element of REAL 3 st u in D holds
  f|D is_partial_differentiable_in u,1;
  pred f is_partial_differentiable`2_on D means

  D c= dom f & for u be Element of REAL 3 st u in D holds
  f|D is_partial_differentiable_in u,2;
  pred f is_partial_differentiable`3_on D means

  D c= dom f & for u be Element of REAL 3 st u in D holds
  f|D is_partial_differentiable_in u,3;
end;

theorem 
  f is_partial_differentiable`1_on D implies
  D c= dom f & for u st u in D holds f is_partial_differentiable_in u,1;

theorem 
  f is_partial_differentiable`2_on D implies
  D c= dom f & for u st u in D holds f is_partial_differentiable_in u,2;

theorem 
  f is_partial_differentiable`3_on D implies
  D c= dom f & for u st u in D holds f is_partial_differentiable_in u,3;

definition
  let f be PartFunc of REAL 3,REAL;
  let D be set;
  assume  f is_partial_differentiable`1_on D;
  func f`partial1|D -> PartFunc of REAL 3,REAL means

  dom it = D & for u be Element of REAL 3 st u in D holds
  it.u = partdiff(f,u,1);
end;

definition
  let f be PartFunc of REAL 3,REAL;
  let D be set;
  assume  f is_partial_differentiable`2_on D;
  func f`partial2|D -> PartFunc of REAL 3,REAL means

  dom it = D & for u be Element of REAL 3 st u in D holds
  it.u = partdiff(f,u,2);
end;

definition
  let f be PartFunc of REAL 3,REAL;
  let D be set;
  assume  f is_partial_differentiable`3_on D;
  func f`partial3|D -> PartFunc of REAL 3,REAL means

  dom it = D & for u be Element of REAL 3 st u in D holds
  it.u = partdiff(f,u,3);
end;

begin 

theorem 
  for u0 being Element of REAL 3 for N being Neighbourhood of proj(1,3).u0 st
  f is_partial_differentiable_in u0,1 & N c= dom SVF1(1,f,u0) holds
  for h be 0-convergent non-zero Real_Sequence,
  c be constant Real_Sequence st rng c = {proj(1,3).u0} & rng (h+c) c= N
  holds h"(#)(SVF1(1,f,u0)/*(h+c) - SVF1(1,f,u0)/*c) is convergent &
  partdiff(f,u0,1) = lim (h"(#)(SVF1(1,f,u0)/*(h+c) - SVF1(1,f,u0)/*c));

theorem 
  for u0 being Element of REAL 3 for N being Neighbourhood of proj(2,3).u0 st
  f is_partial_differentiable_in u0,2 & N c= dom SVF1(2,f,u0) holds
  for h be 0-convergent non-zero Real_Sequence,
  c be constant Real_Sequence st rng c = {proj(2,3).u0} & rng (h+c) c= N
  holds h"(#)(SVF1(2,f,u0)/*(h+c) - SVF1(2,f,u0)/*c) is convergent &
  partdiff(f,u0,2) = lim (h"(#)(SVF1(2,f,u0)/*(h+c) - SVF1(2,f,u0)/*c));

theorem 
  for u0 being Element of REAL 3 for N being Neighbourhood of proj(3,3).u0 st
  f is_partial_differentiable_in u0,3 & N c= dom SVF1(3,f,u0) holds
  for h be 0-convergent non-zero Real_Sequence,
  c be constant Real_Sequence st rng c = {proj(3,3).u0} & rng (h+c) c= N
  holds h"(#)(SVF1(3,f,u0)/*(h+c) - SVF1(3,f,u0)/*c) is convergent &
  partdiff(f,u0,3) = lim (h"(#)(SVF1(3,f,u0)/*(h+c) - SVF1(3,f,u0)/*c));

theorem 
  f1 is_partial_differentiable_in u0,1 &
  f2 is_partial_differentiable_in u0,1 implies
  f1(#)f2 is_partial_differentiable_in u0,1;

theorem 
  f1 is_partial_differentiable_in u0,2 &
  f2 is_partial_differentiable_in u0,2 implies
  f1(#)f2 is_partial_differentiable_in u0,2;

theorem 
  f1 is_partial_differentiable_in u0,3 &
  f2 is_partial_differentiable_in u0,3 implies
  f1(#)f2 is_partial_differentiable_in u0,3;

theorem 
  for u0 being Element of REAL 3 holds f is_partial_differentiable_in u0,1
  implies SVF1(1,f,u0) is_continuous_in proj(1,3).u0;

theorem 
  for u0 being Element of REAL 3 holds f is_partial_differentiable_in u0,2
  implies SVF1(2,f,u0) is_continuous_in proj(2,3).u0;

theorem 
  for u0 being Element of REAL 3 holds f is_partial_differentiable_in u0,3
  implies SVF1(3,f,u0) is_continuous_in proj(3,3).u0;

begin

definition
  let f be PartFunc of REAL 3,REAL;
  let p be Element of REAL 3;
  func grad(f,p) -> Element of REAL 3 equals

  partdiff(f,p,1)*<e1>+partdiff(f,p,2)*<e2>+partdiff(f,p,3)*<e3>;
end;

theorem 
  grad(f,p) = |[ partdiff(f,p,1),partdiff(f,p,2),partdiff(f,p,3) ]|;

theorem 
  (f is_partial_differentiable_in p,1 & f is_partial_differentiable_in p,2 &
  f is_partial_differentiable_in p,3 & g is_partial_differentiable_in p,1 &
  g is_partial_differentiable_in p,2 & g is_partial_differentiable_in p,3)
  implies grad(f+g,p) = grad(f,p)+grad(g,p);

theorem 
  (f is_partial_differentiable_in p,1 & f is_partial_differentiable_in p,2 &
  f is_partial_differentiable_in p,3 & g is_partial_differentiable_in p,1 &
  g is_partial_differentiable_in p,2 & g is_partial_differentiable_in p,3)
  implies grad(f-g,p) = grad(f,p)-grad(g,p);

theorem 
  (f is_partial_differentiable_in p,1 & f is_partial_differentiable_in p,2 &
  f is_partial_differentiable_in p,3) implies grad(r(#)f,p) = r*grad(f,p);

theorem 
  (f is_partial_differentiable_in p,1 & f is_partial_differentiable_in p,2 &
  f is_partial_differentiable_in p,3) & (g is_partial_differentiable_in p,1 &
  g is_partial_differentiable_in p,2 & g is_partial_differentiable_in p,3)
  implies grad(s(#)f+t(#)g,p) = s*grad(f,p)+t*grad(g,p);

theorem 
  (f is_partial_differentiable_in p,1 & f is_partial_differentiable_in p,2 &
  f is_partial_differentiable_in p,3) & (g is_partial_differentiable_in p,1 &
  g is_partial_differentiable_in p,2 & g is_partial_differentiable_in p,3)
  implies grad(s(#)f-t(#)g,p) = s*grad(f,p)-t*grad(g,p);

theorem 
  f is total & f is constant implies grad(f,p) = 0.REAL 3;

definition
  let a be Element of REAL 3;
  func unitvector(a) -> Element of REAL 3 equals

  |[ a.1/sqrt((a.1)^2+(a.2)^2+(a.3)^2),a.2/sqrt((a.1)^2+(a.2)^2+(a.3)^2),
  a.3/sqrt((a.1)^2+(a.2)^2+(a.3)^2) ]|;
end;

definition
  let f be PartFunc of REAL 3,REAL;
  let p, a be Element of REAL 3;
  func Directiondiff(f,p,a) -> Real equals

  partdiff(f,p,1)*(unitvector(a)).1+
  partdiff(f,p,2)*(unitvector(a)).2+
  partdiff(f,p,3)*(unitvector(a)).3;
end;

theorem 
  a = <*x0,y0,z0*> implies Directiondiff(f,p,a) =
    partdiff(f,p,1)*x0/sqrt(x0^2+y0^2+z0^2)+
    partdiff(f,p,2)*y0/sqrt(x0^2+y0^2+z0^2)+
    partdiff(f,p,3)*z0/sqrt(x0^2+y0^2+z0^2);

theorem 
  Directiondiff(f,p,a) = |( grad(f,p),unitvector(a) )|;

definition
  let f1,f2,f3 be PartFunc of REAL 3,REAL;
  let p be Element of REAL 3;
  func curl(f1,f2,f3,p) -> Element of REAL 3 equals

  (partdiff(f3,p,2)-partdiff(f2,p,3))*<e1>+
  (partdiff(f1,p,3)-partdiff(f3,p,1))*<e2>+
  (partdiff(f2,p,1)-partdiff(f1,p,2))*<e3>;
end;

theorem 
  curl(f1,f2,f3,p) = |[ partdiff(f3,p,2)-partdiff(f2,p,3),
  partdiff(f1,p,3)-partdiff(f3,p,1),partdiff(f2,p,1)-partdiff(f1,p,2) ]|;














begin

registration let P be non empty Poset; 
  cluster non empty for Chain of P;
end;

definition let IT be RelStr;
  attr IT is chain-complete means

  IT is lower-bounded &
  for L being Chain of IT st L is non empty holds ex_sup_of L,IT;
end;

theorem 
  for P1, P2 being non empty Poset, K being non empty Chain of P1,
      h being monotone Function of P1, P2 holds
    h.:K is non empty Chain of P2;

registration
  cluster strict chain-complete non empty for Poset;
end;

registration
  cluster chain-complete -> lower-bounded for RelStr;
end;

reserve n,m,k for Nat;
reserve x,y,z,X for set;
reserve P,Q for strict chain-complete non empty Poset;
reserve L for non empty Chain of P;
reserve M for non empty Chain of Q;
reserve p,p1,p2,p3,p4 for Element of P;
reserve q,q1,q2 for Element of Q;
reserve f for monotone Function of P,Q;
reserve g,g1,g2 for monotone Function of P,P;



theorem 
  sup (f.:L) <= f.(sup L);

begin

definition let P be non empty Poset,
               g be monotone Function of P, P,
               p be Element of P;
  func iterSet(g,p) -> non empty set equals

    {x where x is Element of P : ex n being Nat st x = iter(g,n).p};
end;

theorem 
  iterSet(g,Bottom P) is non empty Chain of P;

definition let P; let g be monotone Function of P,P;
  func iter_min(g) -> non empty Chain of P equals

    iterSet(g,Bottom P);
end;

theorem 
  sup iter_min(g) = sup (g.:iter_min(g));

theorem 
  g1 <= g2 implies sup iter_min(g1) <= sup iter_min(g2);



definition let P,Q be non empty Poset;
  let f be Function of P,Q;
  attr f is continuous means

  f is monotone & for L be non empty Chain of P holds f preserves_sup_of L;
end;

theorem 
  for f being Function of P,Q holds f is continuous iff
          (f is monotone & for L holds f.(sup L) = sup (f.:L));

theorem 
  for z being Element of Q holds (P-->z) is continuous;

registration let P,Q;
  cluster continuous for Function of P, Q;
end;

registration let P,Q;
  cluster continuous -> monotone for Function of P, Q;
end;

theorem 
  for f being monotone Function of P,Q holds
    (for L holds f.(sup L) <= sup (f.:L)) implies f is continuous;

definition let P; let g be monotone Function of P,P;
  assume g is continuous;
  func least_fix_point(g) -> Element of P means

    it is_a_fixpoint_of g & for p st p is_a_fixpoint_of g holds it <= p;
end;

theorem 
  for g being continuous Function of P,P holds
    least_fix_point(g) = sup iter_min(g);

theorem 
  for g1,g2 being continuous Function of P,P st g1 <= g2 holds
    least_fix_point(g1) <= least_fix_point(g2);

begin



definition let P,Q;
  func ConFuncs (P,Q) -> non empty set equals

   {x where x is Element of Funcs(the carrier of P,the carrier of Q)
               :ex f be continuous Function of P,Q st f=x };
  end;

definition let P,Q;
  func ConRelat(P,Q) -> Relation of ConFuncs(P,Q) means

   for x,y holds [x,y] in it iff (x in ConFuncs(P,Q) & y in ConFuncs(P,Q)
        & ex f,g being Function of P,Q st x=f & y=g & f <= g);
  end;

registration let P,Q;
  cluster ConRelat(P,Q) -> reflexive;
  cluster ConRelat(P,Q) -> transitive;
  cluster ConRelat(P,Q) -> antisymmetric;
end;

definition let P,Q;
  func ConPoset(P,Q) -> strict non empty Poset equals

     RelStr(#ConFuncs(P,Q),ConRelat(P,Q)#);
end;

reserve F for non empty Chain of ConPoset(P,Q);

definition let P,Q,F,p;
  func F-image p -> non empty Chain of Q equals

    {x where x is Element of Q
        :ex f being continuous Function of P,Q st f in F & x=f.p};
  end;

definition let P,Q,F;
  func sup_func(F) -> Function of P,Q means

    for p,M holds M=F-image p implies it.p=sup M;
end;

registration let P,Q,F;
  cluster sup_func(F) -> continuous;
end;

theorem 
  ex_sup_of F, ConPoset(P,Q) & sup_func(F) = "\/"(F,ConPoset(P,Q));

definition let P,Q;
  func min_func(P,Q) -> Function of P,Q equals

    P --> Bottom Q;
end;

registration let P,Q;
  cluster min_func(P,Q) -> continuous;
end;

theorem 
  for f being Element of ConPoset(P,Q) st f = min_func(P,Q)
    holds f is_<=_than the carrier of ConPoset(P,Q);

registration let P,Q;
  cluster ConPoset(P,Q) -> chain-complete;
end;

begin

definition let P;
  func fix_func(P) -> Function of ConPoset(P,P), P means

    for g being Element of ConPoset(P,P),
        h being continuous Function of P, P st g = h holds
    it.g = least_fix_point h;
end;

registration let P;
  cluster fix_func(P) -> continuous;
end;














begin

reserve x,y for set,
  G for Group,
  A,B,H,H1,H2 for Subgroup of G,
  a,b,c for Element of G,
  F,F1 for FinSequence of the carrier of G,
  I,I1 for FinSequence of INT,
  i,j for Element of NAT;

theorem 
  a |^ b = a * [.a,b.];

theorem 
  [.a,b.]" = [.a,b".]|^b;

theorem 
  [.a,b.]" = [.a",b.]|^a;

theorem 
  ([.a,b".]|^ b)" = [.b",a.]|^ b;

theorem 
  [.a,b",c.] |^ b = [.[.a,b".]|^ b,c|^ b.];

theorem 
  [.a,b".]|^ b = [.b,a.];

theorem 
  [.a,b",c.] |^ b  = [.b,a,c|^ b.];

theorem 
   [.a,b,c|^ a.]  * [.c,a,b|^ c.]  * [.b,c,a|^ b.] = 1_G;

theorem 
  [.A,B.] is Subgroup of [.B,A.];

definition let G,A,B;
  redefine func [.A,B.];
  commutativity;
end;

theorem 
  B is Subgroup of A implies commutators(A,B) c= carr A;

theorem 
  B is Subgroup of A implies [.A,B.] is Subgroup of A;

theorem 
  B is Subgroup of A implies [.B,A.] is Subgroup of A;

theorem 
  [.H1, (Omega).G.] is Subgroup of H2
  implies [.H1 /\ H,H.] is Subgroup of H2 /\ H;

theorem 
  [.H1,H2.] is Subgroup of [.H1,(Omega).G.];

theorem 
  A is normal Subgroup of G iff [.A,(Omega).G.] is Subgroup of A;

definition let G;
  func the_normal_subgroups_of G -> set means

  x in it iff x is strict normal Subgroup of G;
end;

registration let G;
  cluster the_normal_subgroups_of G -> non empty;
end;

theorem 
  for F being FinSequence of the_normal_subgroups_of G
  for j st j in dom F holds F.j is strict normal Subgroup of G;

theorem 
  the_normal_subgroups_of G c= Subgroups G;

theorem 
  for F being FinSequence of the_normal_subgroups_of G
  holds F is FinSequence of Subgroups G;

definition let IT be Group;
  attr IT is nilpotent means

  ex F being FinSequence of the_normal_subgroups_of IT st
  len F > 0 & F.1 = (Omega).IT & F.(len F) = (1).IT &
  for i st i in dom F & i+1 in dom F
  for G1,G2 being strict normal Subgroup of IT st G1 = F.i & G2 = F.(i+1) holds
  G2 is Subgroup of G1 &
  G1./.(G1,G2)`*` is Subgroup of center (IT./.G2);
end;

registration
  cluster nilpotent strict for Group;
end;

theorem 
  for G1 being Subgroup of G,N being strict normal Subgroup of G st
  N is Subgroup of G1 & G1./.(G1,N)`*` is Subgroup of center (G./.N) holds
   [.G1,(Omega).G.] is Subgroup of N;

theorem 
  for G1 being Subgroup of G, N being normal Subgroup of G st
  N is strict Subgroup of G1 & [.G1,(Omega).G.] is strict Subgroup of N holds
  G1./.(G1,N)`*` is Subgroup of center (G./.N);

theorem 
  for G being Group holds G is nilpotent iff
  ex F being FinSequence of the_normal_subgroups_of G st len F > 0 &
  F.1 = (Omega).G & F.(len F) = (1).G &
  for i st i in dom F & i+1 in dom F for G1,G2 being
  strict normal Subgroup of G st G1 = F.i & G2 = F.(i+1) holds
  G2 is Subgroup of G1 & [.G1, (Omega).G.] is Subgroup of G2;

theorem 
  for G being Group for H,G1 being Subgroup of G
  for G2 being strict normal Subgroup of G
  for H1 being Subgroup of H
  for H2 being normal Subgroup of H
   st G2 is Subgroup of G1
   & G1./.(G1,G2)`*` is Subgroup of center (G./.G2)
   & H1=G1 /\ H & H2=G2 /\ H holds
  H1./.(H1,H2)`*` is Subgroup of center (H./.H2);

registration let G be nilpotent Group;
  cluster -> nilpotent for Subgroup of G;
end;

registration
  cluster commutative -> nilpotent for Group;
  cluster cyclic -> nilpotent for Group;
end;

theorem 
  for G,H being strict Group, h being Homomorphism of G,H for A
  being strict Subgroup of G for a,b being Element of G
  holds h.a * h.b * h.:A = h.:(a * b * A) & h.:A * h.a * h.b = h.:(A * a * b);

theorem 
  for G,H being strict Group, h being Homomorphism of G,H
  for A being strict Subgroup of G for a,b being Element of G
  for H1 being Subgroup of Image h for a1,b1 being Element of Image h
  st a1 = h.a & b1 = h.b & H1 = h.:A holds a1 * b1 * H1 = h.a * h.b * h.:A;

theorem 
  for G,H being strict Group,h being Homomorphism of G,H
  for G1 being strict Subgroup of G
  for G2 being strict normal Subgroup of G
  for H1 being strict Subgroup of Image h
  for H2 being strict normal Subgroup of Image h
   st G2 is strict Subgroup of G1 &
   G1./.(G1,G2)`*` is Subgroup of center (G./.G2)
   & H1=h.:G1 & H2=h.:G2 holds
  H1./.(H1,H2)`*` is Subgroup of center (Image h./.H2);

theorem 
  for G,H being strict Group, h being Homomorphism of G,H holds
  for A being strict normal Subgroup of G holds
  h.:A is strict normal Subgroup of Image h;

registration
  let G be strict nilpotent Group, H be strict Group,
      h be Homomorphism of G,H;
  cluster Image h -> nilpotent;
end;

registration
  let G be strict nilpotent Group, N be strict normal Subgroup of G;
  cluster G./.N -> nilpotent;
end;

theorem 
  for G being Group st ex F being FinSequence of the_normal_subgroups_of G st
  len F > 0 & F.1 = (Omega).G & F.(len F) = (1).G & for i st i in dom F
  & i+1 in dom F for G1 being strict normal Subgroup of G st G1 = F.i
  holds [.G1, (Omega).G.] = F.(i+1) holds G is nilpotent;

theorem 
  for G being Group st ex F being FinSequence of the_normal_subgroups_of G
  st len F > 0 & F.1 = (Omega).G & F.(len F) = (1).G & for i st i in dom F
  & i+1 in dom F for G1,G2 being strict normal Subgroup of G
  st G1 = F.i & G2 = F.(i+1) holds G2 is Subgroup of G1 &
  G./.G2 is commutative Group holds G is nilpotent;

theorem 
  for G being Group st ex F being FinSequence of the_normal_subgroups_of
  G st len F > 0 & F.1 = (Omega).G & F.(len F) = (1).G & for i st i in dom F
  & i+1 in dom F for G1,G2 being strict normal Subgroup of G
  st G1 = F.i & G2 = F.(i+1) holds G2 is Subgroup of G1 &
  G./.G2 is cyclic Group holds G is nilpotent;

registration
  cluster nilpotent -> solvable for Group;
end;














begin 

reserve i,j for Nat;

theorem 
 for x being pair set holds x = [x`1, x`2];

scheme 
 MinimalElement{X() -> finite non empty set, R[set,set]}:
  ex x being set st x in X() &
  for y being set st y in X() holds not R[y,x]
  provided
 for x,y being set st x in X() & y in X() & R[x,y] holds not R[y,x] and
 for x,y,z being set st x in X() & y in X() & z in X() & R[x,y] & R[y,z]
    holds R[x,z];

scheme 
 FiniteC{X() -> finite set, P[set]}:
  P[X()]
  provided

 for A being Subset of X() st for B being set st B c< A holds P[B] holds P[A];

scheme 
 Numeration{X() -> finite set, R[set, set]}:
  ex s being one-to-one FinSequence st rng s = X() &
  for i,j st i in dom s & j in dom s & R[s.i, s.j] holds i < j
  provided
 for x,y being set st x in X() & y in X() & R[x,y] holds not R[y,x] and
 for x,y,z being set st x in X() & y in X() & z in X() & R[x,y] & R[y,z]
    holds R[x,z];

theorem 
  for x being variable holds varcl vars x = vars x;

theorem 
 for C being initialized ConstructorSignature for e being expression of C holds
  e is compound iff not ex x being Element of Vars st e = x-term C;

begin 

registration
  cluster empty for quasi-loci;
end;

definition
 let C be ConstructorSignature;
 attr C is standardized means


  for o being OperSymbol of C st o is constructor holds o in Constructors &
    o`1 = the_result_sort_of o &
    card o`2`1 = len the_arity_of o;
end;

theorem 
  for C being ConstructorSignature st C is standardized
  for o being OperSymbol of C
  holds o is constructor iff o in Constructors;

registration
 cluster MaxConstrSign -> standardized;
end;

registration
 cluster initialized standardized strict for ConstructorSignature;
end;

definition
  let C be initialized standardized ConstructorSignature;
  let c be constructor OperSymbol of C;
  func loci_of c -> quasi-loci equals

c`2`1;
end;

registration
 let C be ConstructorSignature;
 cluster constructor for Subsignature of C;
end;

registration
 let C be initialized ConstructorSignature;
 cluster initialized for constructor Subsignature of C;
end;

registration
 let C be standardized ConstructorSignature;
 cluster -> standardized for constructor Subsignature of C;
end;

theorem 
 for S1,S2 being standardized ConstructorSignature
  st the carrier' of S1 = the carrier' of S2
  holds the ManySortedSign of S1 = the ManySortedSign of S2;

theorem 
 for C being ConstructorSignature holds
   C is standardized iff C is Subsignature of MaxConstrSign;

registration
 let C be initialized ConstructorSignature;
 cluster non compound for quasi-term of C;
end;

registration
 cluster -> pair for Element of Vars;
end;

theorem 
 for x being Element of Vars st vars x is natural holds vars x = 0;

theorem 
 Vars misses Constructors;

theorem 
 for x being Element of Vars holds x <> * & x <> non_op;

theorem 
 for C being standardized ConstructorSignature holds
   Vars misses the carrier' of C;

theorem 
 for C being initialized standardized ConstructorSignature
 for e being expression of C
  holds
   (ex x being Element of Vars st e = x-term C & e.{} = [x, a_Term]) or
   (ex o being OperSymbol of C st e.{} = [o, the carrier of C] &
    ( o in Constructors or o = * or o = non_op ));

registration
 let C be initialized standardized ConstructorSignature;
 let e be expression of C;
 cluster e.{} -> pair;
end;

theorem 
 for C being initialized ConstructorSignature for e being expression of C
 for o being OperSymbol of C st e.{} = [o, the carrier of C]
  holds
    e is expression of C, the_result_sort_of o;

theorem 
 for C being initialized standardized ConstructorSignature
 for e being expression of C
  holds
    ( (e.{})`1 = * implies e is expression of C, a_Type C ) &
    ( (e.{})`1 = non_op implies e is expression of C, an_Adj C );

theorem 
 for C being initialized standardized ConstructorSignature
 for e being expression of C
  holds
   (e.{})`1 in Vars & (e.{})`2 = a_Term & e is quasi-term of C or
   (e.{})`2 = the carrier of C &
    ( (e.{})`1 in Constructors & (e.{})`1 in the carrier' of C or
      (e.{})`1 = * or (e.{})`1 = non_op );

theorem 
 for C being initialized standardized ConstructorSignature
 for e being expression of C
  st (e.{})`1 in Constructors
  holds e in (the Sorts of Free(C, MSVars C)).(e.{})`1`1;

theorem 
 for C being initialized standardized ConstructorSignature
 for e being expression of C
  holds not (e.{})`1 in Vars iff (e.{})`1 is OperSymbol of C;

theorem 
 for C being initialized standardized ConstructorSignature
 for e being expression of C
  st (e.{})`1 in Vars
 ex x being Element of Vars st x = (e.{})`1 & e = x-term C;

theorem 
 for C being initialized standardized ConstructorSignature
 for e being expression of C
  st (e.{})`1 = *
 ex a being expression of C, an_Adj C, q being expression of C, a_Type C st
  e = [*,3]-tree(a,q);

theorem 
 for C being initialized standardized ConstructorSignature
 for e being expression of C
  st (e.{})`1 = non_op
 ex a being expression of C, an_Adj C st e = [non_op,3]-tree a;

theorem 
 for C being initialized standardized ConstructorSignature
 for e being expression of C
  st (e.{})`1 in Constructors
 ex o being OperSymbol of C st o = (e.{})`1 & the_result_sort_of o = o`1 &
   e is expression of C, the_result_sort_of o;

theorem 
 for C being initialized standardized ConstructorSignature
 for t being quasi-term of C holds
   t is compound iff (t.{})`1 in Constructors & (t.{})`1`1 = a_Term;

theorem 
 for C being initialized standardized ConstructorSignature
 for t being expression of C holds
   t is non compound quasi-term of C iff (t.{})`1 in Vars;

theorem 
 for C being initialized standardized ConstructorSignature
 for t being expression of C holds
   t is quasi-term of C iff
      (t.{})`1 in Constructors & (t.{})`1`1 = a_Term or (t.{})`1 in Vars;

theorem 
 for C being initialized standardized ConstructorSignature
 for a being expression of C holds
   a is positive quasi-adjective of C iff
    (a .{})`1 in Constructors & (a .{})`1`1 = an_Adj;

theorem 
 for C being initialized standardized ConstructorSignature
 for a being quasi-adjective of C holds
   a is negative iff (a .{})`1 = non_op;

theorem 
 for C being initialized standardized ConstructorSignature
 for t being expression of C holds
   t is pure expression of C, a_Type C iff
    (t.{})`1 in Constructors & (t.{})`1`1 = a_Type;

begin 

reserve i,j for Nat,
  x for variable,
  l for quasi-loci;

definition
  mode expression is expression of MaxConstrSign;
  mode valuation is valuation of MaxConstrSign;
  mode quasi-adjective is quasi-adjective of MaxConstrSign;
  func QuasiAdjs -> Subset of Free(MaxConstrSign, MSVars MaxConstrSign) equals

  QuasiAdjs MaxConstrSign;

  mode quasi-term is quasi-term of MaxConstrSign;
  func QuasiTerms -> Subset of Free(MaxConstrSign, MSVars MaxConstrSign) equals

  QuasiTerms MaxConstrSign;

  mode quasi-type is quasi-type of MaxConstrSign;
  func QuasiTypes equals

QuasiTypes MaxConstrSign;

end;

registration
  cluster QuasiAdjs -> non empty;

  cluster QuasiTerms -> non empty;

  cluster QuasiTypes -> non empty;

end;

definition
  redefine func Modes -> non empty Subset of Constructors;
  redefine func Attrs -> non empty Subset of Constructors;
  redefine func Funcs -> non empty Subset of Constructors;
end;

reserve C for initialized ConstructorSignature,
  c for constructor OperSymbol of C;

definition
  func set-constr -> Element of Modes equals

[a_Type,[{},0]];
end;

theorem 
  kind_of set-constr = a_Type & loci_of set-constr = {} &
  index_of set-constr = 0;

theorem 
 Constructors = [:{a_Type, an_Adj, a_Term}, [:QuasiLoci, NAT:]:];

theorem 
  [rng l, i] in Vars & l^<*[rng l,i]*> is quasi-loci;

theorem 
  ex l st len l = i;

theorem 
  for X being finite Subset of Vars ex l st rng l = varcl X;

theorem 
               
  for X,o being set, p being DTree-yielding FinSequence
  st ex C st X = Union the Sorts of Free(C, MSVars C)
  holds o-tree p in X implies p is FinSequence of X;

definition
  let C;
  let e be expression of C;
  mode subexpression of e -> expression of C means

  it in Subtrees e;
  func constrs e equals

  (proj1 rng e)/\{o where o is constructor OperSymbol of C: not contradiction};
  func main-constr e equals


  (e.{})`1 if e is compound otherwise {};
  func args e -> FinSequence of Free(C, MSVars C) means

  e = (e.{})-tree it;
end;

theorem 
  for C for e being expression of C holds e is subexpression of e;

theorem 
  main-constr (x -term C) = {};

theorem 
  for c being constructor OperSymbol of C
  for p being FinSequence of QuasiTerms C st len p = len the_arity_of c
  holds main-constr (c-trm p) = c;

definition
  let C;
  let e be expression of C;
  attr e is constructor means


  e is compound & main-constr e is constructor OperSymbol of C;
end;

registration
  let C;
  cluster constructor -> compound for expression of C;
end;

registration
  let C;
  cluster constructor for expression of C;
end;

registration
  let C;
  let e be constructor expression of C;
  cluster constructor for subexpression of e;
end;

registration
  let S be non void Signature;
  let X be non empty-yielding ManySortedSet of S;
  let t be Element of Free(S,X);
  cluster rng t -> Relation-like;
end;

theorem 
  for e being constructor expression of C holds main-constr e in constrs e;

begin 

reserve a,a9 for quasi-adjective,
  t,t1,t2 for quasi-term,
  T for quasi-type,

  c for Element of Constructors;

definition
  let C be non void Signature;
  attr C is arity-rich means

  for n being Nat, s being SortSymbol of C holds
  {o where o is OperSymbol of C: the_result_sort_of o = s &
        len the_arity_of o = n} is infinite;
  let o be OperSymbol of C;
  attr o is nullary means

the_arity_of o = {};
  attr o is unary means

len the_arity_of o = 1;
  attr o is binary means

len the_arity_of o = 2;
end;

theorem 
  for C being non void Signature for o being OperSymbol of C holds
  (o is nullary implies o is not unary) &
  (o is nullary implies o is not binary) &
  (o is unary implies o is not binary);

registration
  let C be ConstructorSignature;
  cluster non_op C -> unary;
  cluster ast C -> binary;
end;

registration
  let C be ConstructorSignature;
  cluster nullary -> constructor for OperSymbol of C;
end;

theorem 
  for C being ConstructorSignature holds C is initialized iff
  ex m being OperSymbol of a_Type C, a being OperSymbol of an_Adj C st
  m is nullary & a is nullary;

registration
  let C be initialized ConstructorSignature;
  cluster nullary constructor for OperSymbol of a_Type C;
  cluster nullary constructor for OperSymbol of an_Adj C;
end;

registration
  let C be initialized ConstructorSignature;
  cluster nullary constructor for OperSymbol of C;
end;

registration
  cluster arity-rich -> with_an_operation_for_each_sort for
non void Signature;
  cluster arity-rich -> initialized for ConstructorSignature;
end;

registration
  cluster MaxConstrSign -> arity-rich;
end;

registration
  cluster arity-rich initialized for ConstructorSignature;
end;

registration
  let C be arity-rich ConstructorSignature;
  let s be SortSymbol of C;
  cluster nullary constructor for OperSymbol of s;
  cluster unary constructor for OperSymbol of s;
  cluster binary constructor for OperSymbol of s;
end;

registration
  let C be arity-rich ConstructorSignature;
  cluster unary constructor for OperSymbol of C;
  cluster binary constructor for OperSymbol of C;
end;

theorem 
 for o being nullary OperSymbol of C holds
   [o, the carrier of C]-tree {} is expression of C, the_result_sort_of o;

definition
  let C be initialized ConstructorSignature;
  let m be nullary constructor OperSymbol of a_Type C;
  redefine func m term -> pure expression of C, a_Type C;
end;

definition
  let c be Element of Constructors;
  func @c -> constructor OperSymbol of MaxConstrSign equals

c;
end;

definition
  let m be Element of Modes;
  redefine func @m -> constructor OperSymbol of a_Type MaxConstrSign;
end;

registration
  cluster @set-constr -> nullary;
end;

theorem 
  the_arity_of @set-constr = {};

definition
  func set-type -> quasi-type equals

  ({}QuasiAdjs MaxConstrSign) ast ((@set-constr) term);
end;

theorem 
  adjs set-type = {} & the_base_of set-type = (@set-constr) term;

definition
  let l be FinSequence of Vars;
  func args l -> FinSequence of QuasiTerms MaxConstrSign means


  len it = len l & for i st i in dom l holds it.i = (l/.i)-term MaxConstrSign;
end;

definition
  let c;
  func base_exp_of c -> expression equals

(@c)-trm args loci_of c;
end;

theorem 
  for o being OperSymbol of MaxConstrSign holds
  o is constructor iff o in Constructors;

theorem 
  for m being nullary OperSymbol of MaxConstrSign holds
  main-constr (m term) = m;

theorem 
  for m being unary constructor OperSymbol of MaxConstrSign
  for t holds main-constr (m term t) = m;

theorem 
  for a holds main-constr ((non_op MaxConstrSign)term a) = non_op;

theorem 
  for m being binary constructor OperSymbol of MaxConstrSign
  for t1,t2 holds main-constr (m term(t1,t2)) = m;

theorem 
  for q being expression of MaxConstrSign, a_Type MaxConstrSign
  for a holds main-constr ((ast MaxConstrSign)term(a,q)) = *;

definition
  let T be quasi-type;
  func constrs T equals

  (constrs the_base_of T) \/ union {constrs a: a in adjs T};
end;

theorem 
  for q being pure expression of MaxConstrSign, a_Type MaxConstrSign
  for A being finite Subset of QuasiAdjs MaxConstrSign holds
  constrs(A ast q) = (constrs q) \/ union {constrs a: a in A};

theorem 
  constrs(a ast T) = (constrs a) \/ (constrs T);

begin 

definition
  let C be initialized ConstructorSignature;
  let t,p be expression of C;
  pred t matches_with p means

  ex f being valuation of C st t = p at f;
  reflexivity;
end;

theorem 
 for t1,t2,t3 being expression of C st t1 matches_with t2 & t2 matches_with t3
  holds t1 matches_with t3;

definition
  let C be initialized ConstructorSignature;
  let A,B be Subset of QuasiAdjs C;
  pred A matches_with B means

  ex f being valuation of C st B at f c= A;
  reflexivity;
end;

theorem 
 for A1,A2,A3 being Subset of QuasiAdjs C
  st A1 matches_with A2 & A2 matches_with A3
  holds A1 matches_with A3;

definition
  let C be initialized ConstructorSignature;
  let T,P be quasi-type of C;
  pred T matches_with P means

  ex f being valuation of C st
   (adjs P) at f c= adjs T & (the_base_of P) at f = the_base_of T;
  reflexivity;
end;

theorem 
 for T1,T2,T3 being quasi-type of C st T1 matches_with T2 & T2 matches_with T3
  holds T1 matches_with T3;

definition
  let C be initialized ConstructorSignature;
  let t1,t2 be expression of C;
  let f be valuation of C;

  pred f unifies t1,t2 means

  t1 at f = t2 at f;
end;

theorem 
 for t1,t2 being expression of C for f being valuation of C st f unifies t1,t2
  holds f unifies t2,t1;

definition
  let C be initialized ConstructorSignature;
  let t1,t2 be expression of C;
  pred t1,t2 are_unifiable means

  ex f being valuation of C st f unifies t1,t2;
  reflexivity;
  symmetry;
end;

definition
  let C be initialized ConstructorSignature;
  let t1,t2 be expression of C;
  pred t1,t2 are_weakly-unifiable means

  ex g being irrelevant one-to-one valuation of C
  st variables_in t2 c= dom g & t1,t2 at g are_unifiable;
  reflexivity;


end;





theorem 
 for t1,t2 being expression of C st t1,t2 are_unifiable
  holds t1,t2 are_weakly-unifiable;

definition
  let C be initialized ConstructorSignature;
  let t,t1,t2 be expression of C;
  pred t is_a_unification_of t1,t2 means

  ex f being valuation of C st f unifies t1,t2 & t = t1 at f;
end;

theorem 
 for t1,t2,t being expression of C st t is_a_unification_of t1,t2
  holds t is_a_unification_of t2,t1;

theorem 
 for t1,t2,t being expression of C st t is_a_unification_of t1,t2
  holds t matches_with t1 & t matches_with t2;

definition
  let C be initialized ConstructorSignature;
  let t,t1,t2 be expression of C;
  pred t is_a_general-unification_of t1,t2 means

  t is_a_unification_of t1,t2 &
  for u being expression of C st u is_a_unification_of t1,t2
  holds u matches_with t;
end;





begin 

theorem 
  for n being Nat for s being SortSymbol of MaxConstrSign
  ex m being constructor OperSymbol of s
  st len the_arity_of m = n;

theorem 
  for l for s being SortSymbol of MaxConstrSign
  for m being constructor OperSymbol of s st len the_arity_of m = len l
  holds variables_in (m-trm args l) = rng l;

theorem 
  for X being finite Subset of Vars st varcl X = X
  for s being SortSymbol of MaxConstrSign
  ex m being constructor OperSymbol of s st 
  ex p being FinSequence of QuasiTerms MaxConstrSign
  st len p = len the_arity_of m & vars (m-trm p) = X;

definition
  let d be PartFunc of Vars, QuasiTypes;
  attr d is even means


  for x,T st x in dom d & T = d.x holds vars T = vars x;
end;

definition
  let l be quasi-loci;
  mode type-distribution of l -> PartFunc of Vars, QuasiTypes means


  dom it = rng l & it is even;
end;

theorem 
  for l being empty quasi-loci holds {} is type-distribution of l;















begin

theorem 
  for a,b being real number, c being Nat holds
    (a / b) to_power c = (a to_power c) / (b to_power c);

theorem 
  for a being real number, b,c being integer number st a <> 0 holds
    a to_power (b+c) = a to_power b * a to_power c;

theorem 
  for n being Nat, a being real number st n is even & a <> 0 holds
    (-a) to_power n = a to_power n;

theorem 
  for n being Nat, a being real number st n is odd & a <> 0 holds
    (-a) to_power n = -(a to_power n);

theorem 
  abs tau_bar < 1;

theorem 
  for n being Nat, r being non empty real number st n is even holds
    r to_power n > 0;

theorem 
  for n being Nat, r being real number st n is odd & r < 0 holds
    r to_power n < 0;

theorem 
  for n being Nat st n <> 0 holds tau_bar to_power n < 1/2;

theorem 
  for n,m being Nat, r being real number st
    m is odd & n >= m & r < 0 & r > -1 holds
  r to_power n >= r to_power m;

theorem 
  for n,m being Nat st m is odd & n >= m holds
  tau_bar to_power n >= tau_bar to_power m;

theorem 
  for n,m being Nat st n is even & m is even & n >= m holds
  tau_bar to_power n <= tau_bar to_power m;

theorem 
  for m,n being non empty Nat st m >= n holds Lucas m >= Lucas n;

theorem 
  for n being non empty Nat holds
    tau to_power n > tau_bar to_power n;

theorem 
  for n being Nat st n > 1 holds -1/2 < tau_bar to_power n;

theorem 
  for n being Nat st n > 2 holds tau_bar to_power n >= - 1/sqrt 5;

theorem 
  for n being Nat st n >= 2 holds tau_bar to_power n <= 1/sqrt 5;

theorem 
  for n being Nat holds (tau_bar to_power n)/sqrt 5 + 1/2 > 0 &
  (tau_bar to_power n)/sqrt 5 + 1/2 < 1;

begin 

theorem 
  for n being Nat holds [\ (tau to_power n )/sqrt 5 + 1/2 /] = Fib n;

theorem 
  for n being Nat st n <> 0 holds
    [/ (tau to_power n)/sqrt 5 - 1/2 \] = Fib n;

theorem 
  for n being Nat st n <> 0 holds
    [\ (tau to_power (2*n)) / sqrt 5 /] = Fib (2*n);

theorem 
  for n being Nat holds
    [/ (tau to_power (2*n+1)) / sqrt 5 \] = Fib (2*n+1);

theorem 
  for n being Nat st n >= 2 & n is even holds
    Fib (n+1) = [\ tau * Fib n + 1 /];

theorem 
  for n being Nat st n >= 2 & n is odd holds
    Fib (n+1) = [/ tau * Fib n - 1 \];

theorem 
  for n being Nat st n >= 2 holds
    Fib (n+1) = [\ (Fib n + sqrt 5 * Fib n + 1) / 2 /];

theorem 
  for n being Nat st n >= 2 holds
    Fib (n+1) = [/ (Fib n + sqrt 5 * Fib n - 1)/2 \];

theorem 
  for n being Nat holds
    Fib (n+1) = (Fib n + sqrt(5*(Fib n)^2 + 4*(-1) to_power n))/2;

theorem 
  for n being Nat st n >= 2 holds
    Fib (n+1) = [\ (Fib(n) + 1 + sqrt(5*(Fib(n))^2 - 2 * Fib(n) + 1) )/2 /];

theorem 
  for n being Nat st n >= 2 holds
  Fib n = [\ (1/tau) * (Fib (n+1) + 1/2)/];

theorem 
  for n,k being Nat st (n >= k & k > 1) or (k = 1 & n > k) holds
  [\ tau to_power k * Fib n + 1/2 /] = Fib (n + k);

begin 

theorem 
  for n being Nat st n >= 2 holds
  Lucas(n) = [\ tau to_power n + 1/2 /];

theorem 
  for n being Nat st n >= 2 holds
  Lucas (n) = [/ tau to_power n - 1/2 \];

theorem 
  for n being Nat st n >= 2 holds
  Lucas (2*n) = [/ tau to_power (2*n) \];

theorem 
  for n being Nat st n >= 2 holds
  Lucas (2*n+1) = [\ tau to_power (2*n+1) /];

theorem 
  for n being Nat st n >= 2 & n is odd holds
  Lucas (n+1) = [\ tau * Lucas (n) + 1 /];

theorem 
  for n being Nat st n >= 2 & n is even holds
  Lucas (n+1) = [/ tau * Lucas n - 1 \];

theorem 
  for n being Nat st n <> 1 holds
  Lucas (n+1) = (Lucas n + sqrt(5*((Lucas n)^2 - 4*(-1) to_power n)))/2;

theorem 
  for n being Nat st n >= 4 holds
  Lucas (n+1) = [\ (Lucas n + 1 + sqrt(5*(Lucas n)^2 - 2*Lucas n + 1))/2 /];

theorem 
  for n being Nat st n > 2 holds
    Lucas n = [\ (1/tau) * (Lucas (n+1) + 1/2) /];

theorem 
  for n,k being Nat st n >= 4 & k >= 1 & n > k & n is odd holds
  Lucas (n+k) = [\ tau to_power k * Lucas n + 1 /];















begin

reserve
  x, y for set,
  i, n for Nat,
  r, s for real number,
  f1, f2 for n-element real-valued FinSequence;

registration
  let s be real number; let r be non positive real number;
  cluster ]. s-r , s+r .[ -> empty;
  cluster [. s-r , s+r .[ -> empty;
  cluster ]. s-r , s+r .] -> empty;
end;

registration
  let s be real number; let r be negative real number;
  cluster [. s-r , s+r .] -> empty;
end;

registration
  let n; let f be n-element complex-valued FinSequence;
  cluster -f -> n-element;
  cluster f" -> n-element;
  cluster f^2 -> n-element;
  cluster abs f -> n-element;
  let g be n-element complex-valued FinSequence;
  cluster f + g -> n-element;
  cluster f - g -> n-element;
  cluster f (#) g -> n-element;
  cluster f /" g -> n-element;
end;

registration
  let c be complex number, n be Nat, f be n-element complex-valued FinSequence;
  cluster c + f -> n-element;
  cluster f - c -> n-element;
  cluster c (#) f -> n-element;
end;

registration
  let f be real-valued Function;
  cluster {f} -> real-functions-membered;
  let g be real-valued Function;
  cluster {f,g} -> real-functions-membered;
end;

registration
  let n, x, y; let f be n-element FinSequence;
  cluster f+*(x,y) -> n-element;
end;

theorem 
  for f being n-element FinSequence st f is empty holds n = 0;

theorem 
  for f being n-element real-valued FinSequence holds f in REAL n;

theorem 
  for f, g being complex-valued Function holds abs(f-g) = abs(g-f);

definition
  let n, f1, f2;
  func max_diff_index(f1,f2) -> Nat equals

  the Element of abs(f1-f2) " { sup rng abs(f1-f2) };
  commutativity;
end;

theorem 
  n <> 0 implies max_diff_index(f1,f2) in dom f1;

theorem 
  abs(f1-f2).x <= abs(f1-f2).max_diff_index(f1,f2);

registration
  cluster TopSpaceMetr Euclid 0 -> trivial;
end;

registration
  let n;
  cluster Euclid n -> constituted-FinSeqs;
end;

registration
  let n;
  cluster -> REAL-valued for Point of Euclid n;
end;

registration
  let n;
  cluster -> n-element for Point of Euclid n;
end;

theorem 
  Family_open_set(Euclid 0) = {{},{{}}};

theorem 
  for B being Subset of Euclid 0 holds B = {} or B = {{}};

reserve e, e1 for Point of Euclid n;

definition
  let n, e;
  func @e -> Point of TopSpaceMetr Euclid n equals

  e;
end;

registration
  let n, e;
  let r be non positive real number;
  cluster Ball(e,r) -> empty;
end;

registration
  let n, e;
  let r be positive real number;
  cluster Ball(e,r) -> non empty;
end;

theorem 
  for p1, p2 being Point of TOP-REAL n st i in dom p1 holds
  (p1/.i - p2/.i)^2 <= Sum sqr (p1-p2);

theorem 
  for a, o, p being Element of TOP-REAL n st a in Ball(o,r) holds
  for x being set holds abs((a-o).x) < r & abs(a.x-o.x) < r;

theorem 
  for a, o being Point of Euclid n st a in Ball(o,r) holds
  for x being set holds abs((a-o).x) < r & abs(a.x-o.x) < r;

definition
  let f be real-valued Function, r be real number;
  func Intervals(f,r) -> Function means


  dom it = dom f & for x being set st x in dom f holds it.x = ].f.x-r,f.x+r.[;
end;

registration
  let r;
  cluster Intervals({},r) -> empty;
end;

registration
  let f be real-valued FinSequence; let r;
  cluster Intervals(f,r) -> FinSequence-like;
end;

definition
  let n, e, r;
  func OpenHypercube(e,r) -> Subset of TopSpaceMetr Euclid n equals

  product Intervals(e,r);
end;

theorem 
  0 < r implies e in OpenHypercube(e,r);

registration
  let n be non zero Nat; let e be Point of Euclid n;
  let r be non positive real number;
  cluster OpenHypercube(e,r) -> empty;
end;

theorem 
  for e being Point of Euclid 0 holds OpenHypercube(e,r) = {{}};

registration
  let e be Point of Euclid 0;
  let r;
  cluster OpenHypercube(e,r) -> non empty;
end;

registration
  let n, e; let r be positive real number;
  cluster OpenHypercube(e,r) -> non empty;
end;

theorem 
  r <= s implies OpenHypercube(e,r) c= OpenHypercube(e,s);

theorem 
  (n <> 0 or 0 < r) & e1 in OpenHypercube(e,r) implies
  for x being set holds abs((e1-e).x) < r & abs(e1.x-e.x) < r;

theorem 
  n <> 0 & e1 in OpenHypercube(e,r) implies Sum sqr (e1-e) < n*r^2;

theorem 
  n <> 0 & e1 in OpenHypercube(e,r) implies dist(e1,e) < r * sqrt(n);

theorem 
  n <> 0 implies OpenHypercube(e,r/sqrt(n)) c= Ball(e,r);

theorem 
  n <> 0 implies OpenHypercube(e,r) c= Ball(e,r*sqrt(n));

theorem 
  e1 in Ball(e,r) implies
  ex m being non zero Element of NAT st OpenHypercube(e1,1/m) c= Ball(e,r);

theorem 
  n <> 0 & e1 in OpenHypercube(e,r) implies r > abs(e1-e).max_diff_index(e1,e);

theorem 
  OpenHypercube(e1,r-abs(e1-e).max_diff_index(e1,e)) c= OpenHypercube(e,r);

theorem 
  Ball(e,r) c= OpenHypercube(e,r);

registration
  let n, e, r;
  cluster OpenHypercube(e,r) -> open;
end;

theorem 
  for V being Subset of TopSpaceMetr Euclid n holds V is open implies
  for e being Point of Euclid n st e in V
  ex m being non zero Element of NAT st OpenHypercube(e,1/m) c= V;

theorem 
  for V being Subset of TopSpaceMetr Euclid n st
  for e being Point of Euclid n st e in V
  ex r being real number st r > 0 & OpenHypercube(e,r) c= V
  holds V is open;

definition
  let n, e;
  func OpenHypercubes(e) -> Subset-Family of TopSpaceMetr Euclid n equals

  {OpenHypercube(e,1/m) where m is non zero Element of NAT: not contradiction};
end;

registration
  let n, e;
  cluster OpenHypercubes(e) -> non empty open @e-quasi_basis;
end;

theorem 
  Funcs(Seg n,REAL) = product Carrier (Seg n --> R^1);

theorem 
  n <> 0 implies for PP being Subset-Family of TopSpaceMetr Euclid n st
  PP = product_prebasis (Seg n --> R^1) holds PP is quasi_prebasis;

theorem 
  for PP being Subset-Family of TopSpaceMetr Euclid n st
  PP = product_prebasis (Seg n --> R^1) holds PP is open;

theorem 
  TopSpaceMetr Euclid n = product(Seg n --> R^1);














begin 

reserve x,x0,x1,y,y0,y1,z,z0,z1,r,r1,s,p,p1 for Real;
reserve u,u0 for Element of REAL 3;
reserve n for Element of NAT;
reserve s1 for Real_Sequence;
reserve f,f1,f2 for PartFunc of REAL 3,REAL;
reserve R,R1 for RestFunc;
reserve L,L1 for LinearFunc;

definition
  let f be PartFunc of REAL 3,REAL;
  let u be Element of REAL 3;
  pred f is_hpartial_differentiable`11_in u means

  ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  ex N being Neighbourhood of x0 st N c= dom SVF1(1,pdiff1(f,1),u) &
  ex L,R st for x st x in N holds
  SVF1(1,pdiff1(f,1),u).x - SVF1(1,pdiff1(f,1),u).x0 = L.(x-x0) + R.(x-x0);
  pred f is_hpartial_differentiable`12_in u means

  ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  ex N being Neighbourhood of y0 st N c= dom SVF1(2,pdiff1(f,1),u) &
  ex L,R st for y st y in N holds
  SVF1(2,pdiff1(f,1),u).y - SVF1(2,pdiff1(f,1),u).y0 = L.(y-y0) + R.(y-y0);
  pred f is_hpartial_differentiable`13_in u means

  ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  ex N being Neighbourhood of z0 st N c= dom SVF1(3,pdiff1(f,1),u) &
  ex L,R st for z st z in N holds
  SVF1(3,pdiff1(f,1),u).z - SVF1(3,pdiff1(f,1),u).z0 = L.(z-z0) + R.(z-z0);
  pred f is_hpartial_differentiable`21_in u means

  ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  ex N being Neighbourhood of x0 st N c= dom SVF1(1,pdiff1(f,2),u) &
  ex L,R st for x st x in N holds
  SVF1(1,pdiff1(f,2),u).x - SVF1(1,pdiff1(f,2),u).x0 = L.(x-x0) + R.(x-x0);
  pred f is_hpartial_differentiable`22_in u means

  ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  ex N being Neighbourhood of y0 st N c= dom SVF1(2,pdiff1(f,2),u) &
  ex L,R st for y st y in N holds
  SVF1(2,pdiff1(f,2),u).y - SVF1(2,pdiff1(f,2),u).y0 = L.(y-y0) + R.(y-y0);
  pred f is_hpartial_differentiable`23_in u means

  ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  ex N being Neighbourhood of z0 st N c= dom SVF1(3,pdiff1(f,2),u) &
  ex L,R st for z st z in N holds
  SVF1(3,pdiff1(f,2),u).z - SVF1(3,pdiff1(f,2),u).z0 = L.(z-z0) + R.(z-z0);
  pred f is_hpartial_differentiable`31_in u means

  ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  ex N being Neighbourhood of x0 st N c= dom SVF1(1,pdiff1(f,3),u) &
  ex L,R st for x st x in N holds
  SVF1(1,pdiff1(f,3),u).x - SVF1(1,pdiff1(f,3),u).x0 = L.(x-x0) + R.(x-x0);
  pred f is_hpartial_differentiable`32_in u means

  ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  ex N being Neighbourhood of y0 st N c= dom SVF1(2,pdiff1(f,3),u) &
  ex L,R st for y st y in N holds
  SVF1(2,pdiff1(f,3),u).y - SVF1(2,pdiff1(f,3),u).y0 = L.(y-y0) + R.(y-y0);
  pred f is_hpartial_differentiable`33_in u means

  ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  ex N being Neighbourhood of z0 st N c= dom SVF1(3,pdiff1(f,3),u) &
  ex L,R st for z st z in N holds
  SVF1(3,pdiff1(f,3),u).z - SVF1(3,pdiff1(f,3),u).z0 = L.(z-z0) + R.(z-z0);
end;

definition
  let f be PartFunc of REAL 3,REAL;
  let u be Element of REAL 3;
  assume  f is_hpartial_differentiable`11_in u;
  func hpartdiff11(f,u) -> Real means

  ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  ex N being Neighbourhood of x0 st N c= dom SVF1(1,pdiff1(f,1),u) &
  ex L,R st it = L.1 & for x st x in N holds
  SVF1(1,pdiff1(f,1),u).x - SVF1(1,pdiff1(f,1),u).x0 = L.(x-x0) + R.(x-x0);
end;

definition
  let f be PartFunc of REAL 3,REAL;
  let u be Element of REAL 3;
  assume  f is_hpartial_differentiable`12_in u;
  func hpartdiff12(f,u) -> Real means

  ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  ex N being Neighbourhood of y0 st N c= dom SVF1(2,pdiff1(f,1),u) &
  ex L,R st it = L.1 & for y st y in N holds
  SVF1(2,pdiff1(f,1),u).y - SVF1(2,pdiff1(f,1),u).y0 = L.(y-y0) + R.(y-y0);
end;

definition
  let f be PartFunc of REAL 3,REAL;
  let u be Element of REAL 3;
  assume  f is_hpartial_differentiable`13_in u;
  func hpartdiff13(f,u) -> Real means

  ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  ex N being Neighbourhood of z0 st N c= dom SVF1(3,pdiff1(f,1),u) &
  ex L,R st it = L.1 & for z st z in N holds
  SVF1(3,pdiff1(f,1),u).z - SVF1(3,pdiff1(f,1),u).z0 = L.(z-z0) + R.(z-z0);
end;

definition
  let f be PartFunc of REAL 3,REAL;
  let u be Element of REAL 3;
  assume  f is_hpartial_differentiable`21_in u;
  func hpartdiff21(f,u) -> Real means

  ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  ex N being Neighbourhood of x0 st N c= dom SVF1(1,pdiff1(f,2),u) &
  ex L,R st it = L.1 & for x st x in N holds
  SVF1(1,pdiff1(f,2),u).x - SVF1(1,pdiff1(f,2),u).x0 = L.(x-x0) + R.(x-x0);
end;

definition
  let f be PartFunc of REAL 3,REAL;
  let u be Element of REAL 3;
  assume  f is_hpartial_differentiable`22_in u;
  func hpartdiff22(f,u) -> Real means

  ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  ex N being Neighbourhood of y0 st N c= dom SVF1(2,pdiff1(f,2),u) &
  ex L,R st it = L.1 & for y st y in N holds
  SVF1(2,pdiff1(f,2),u).y - SVF1(2,pdiff1(f,2),u).y0 = L.(y-y0) + R.(y-y0);
end;

definition
  let f be PartFunc of REAL 3,REAL;
  let u be Element of REAL 3;
  assume  f is_hpartial_differentiable`23_in u;
  func hpartdiff23(f,u) -> Real means

  ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  ex N being Neighbourhood of z0 st N c= dom SVF1(3,pdiff1(f,2),u) &
  ex L,R st it = L.1 & for z st z in N holds
  SVF1(3,pdiff1(f,2),u).z - SVF1(3,pdiff1(f,2),u).z0 = L.(z-z0) + R.(z-z0);
end;

definition
  let f be PartFunc of REAL 3,REAL;
  let u be Element of REAL 3;
  assume  f is_hpartial_differentiable`31_in u;
  func hpartdiff31(f,u) -> Real means

  ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  ex N being Neighbourhood of x0 st N c= dom SVF1(1,pdiff1(f,3),u) &
  ex L,R st it = L.1 & for x st x in N holds
  SVF1(1,pdiff1(f,3),u).x - SVF1(1,pdiff1(f,3),u).x0 = L.(x-x0) + R.(x-x0);
end;

definition
  let f be PartFunc of REAL 3,REAL;
  let u be Element of REAL 3;
  assume  f is_hpartial_differentiable`32_in u;
  func hpartdiff32(f,u) -> Real means

  ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  ex N being Neighbourhood of y0 st N c= dom SVF1(2,pdiff1(f,3),u) &
  ex L,R st it = L.1 & for y st y in N holds
  SVF1(2,pdiff1(f,3),u).y - SVF1(2,pdiff1(f,3),u).y0 = L.(y-y0) + R.(y-y0);
end;

definition
  let f be PartFunc of REAL 3,REAL;
  let u be Element of REAL 3;
  assume  f is_hpartial_differentiable`33_in u;
  func hpartdiff33(f,u) -> Real means

  ex x0,y0,z0 being Real st u = <*x0,y0,z0*> &
  ex N being Neighbourhood of z0 st N c= dom SVF1(3,pdiff1(f,3),u) &
  ex L,R st it = L.1 & for z st z in N holds
  SVF1(3,pdiff1(f,3),u).z - SVF1(3,pdiff1(f,3),u).z0 = L.(z-z0) + R.(z-z0);
end;

theorem 
  u = <*x0,y0,z0*> & f is_hpartial_differentiable`11_in u implies
  SVF1(1,pdiff1(f,1),u) is_differentiable_in x0;

theorem 
  u = <*x0,y0,z0*> & f is_hpartial_differentiable`12_in u implies
  SVF1(2,pdiff1(f,1),u) is_differentiable_in y0;

theorem 
  u = <*x0,y0,z0*> & f is_hpartial_differentiable`13_in u implies
  SVF1(3,pdiff1(f,1),u) is_differentiable_in z0;

theorem 
  u = <*x0,y0,z0*> & f is_hpartial_differentiable`21_in u implies
  SVF1(1,pdiff1(f,2),u) is_differentiable_in x0;

theorem 
  u = <*x0,y0,z0*> & f is_hpartial_differentiable`22_in u implies
  SVF1(2,pdiff1(f,2),u) is_differentiable_in y0;

theorem 
  u = <*x0,y0,z0*> & f is_hpartial_differentiable`23_in u implies
  SVF1(3,pdiff1(f,2),u) is_differentiable_in z0;

theorem 
  u = <*x0,y0,z0*> & f is_hpartial_differentiable`31_in u implies
  SVF1(1,pdiff1(f,3),u) is_differentiable_in x0;

theorem 
  u = <*x0,y0,z0*> & f is_hpartial_differentiable`32_in u implies
  SVF1(2,pdiff1(f,3),u) is_differentiable_in y0;

theorem 
  u = <*x0,y0,z0*> & f is_hpartial_differentiable`33_in u implies
  SVF1(3,pdiff1(f,3),u) is_differentiable_in z0;

theorem 
  u = <*x0,y0,z0*> & f is_hpartial_differentiable`11_in u implies
  hpartdiff11(f,u) = diff(SVF1(1,pdiff1(f,1),u),x0);

theorem 
  u = <*x0,y0,z0*> & f is_hpartial_differentiable`12_in u implies
  hpartdiff12(f,u) = diff(SVF1(2,pdiff1(f,1),u),y0);

theorem 
  u = <*x0,y0,z0*> & f is_hpartial_differentiable`13_in u implies
  hpartdiff13(f,u) = diff(SVF1(3,pdiff1(f,1),u),z0);

theorem 
  u = <*x0,y0,z0*> & f is_hpartial_differentiable`21_in u implies
  hpartdiff21(f,u) = diff(SVF1(1,pdiff1(f,2),u),x0);

theorem 
  u = <*x0,y0,z0*> & f is_hpartial_differentiable`22_in u implies
  hpartdiff22(f,u) = diff(SVF1(2,pdiff1(f,2),u),y0);

theorem 
  u = <*x0,y0,z0*> & f is_hpartial_differentiable`23_in u implies
  hpartdiff23(f,u) = diff(SVF1(3,pdiff1(f,2),u),z0);

theorem 
  u = <*x0,y0,z0*> & f is_hpartial_differentiable`31_in u implies
  hpartdiff31(f,u) = diff(SVF1(1,pdiff1(f,3),u),x0);

theorem 
  u = <*x0,y0,z0*> & f is_hpartial_differentiable`32_in u implies
  hpartdiff32(f,u) = diff(SVF1(2,pdiff1(f,3),u),y0);

theorem 
  u = <*x0,y0,z0*> & f is_hpartial_differentiable`33_in u implies
  hpartdiff33(f,u) = diff(SVF1(3,pdiff1(f,3),u),z0);

definition
  let f be PartFunc of REAL 3,REAL;
  let D be set;
  pred f is_hpartial_differentiable`11_on D means

  D c= dom f & for u be Element of REAL 3 st u in D holds
  f|D is_hpartial_differentiable`11_in u;
  pred f is_hpartial_differentiable`12_on D means

  D c= dom f & for u be Element of REAL 3 st u in D holds
  f|D is_hpartial_differentiable`12_in u;
  pred f is_hpartial_differentiable`13_on D means

  D c= dom f & for u be Element of REAL 3 st u in D holds
  f|D is_hpartial_differentiable`13_in u;
  pred f is_hpartial_differentiable`21_on D means

  D c= dom f & for u be Element of REAL 3 st u in D holds
  f|D is_hpartial_differentiable`21_in u;
  pred f is_hpartial_differentiable`22_on D means

  D c= dom f & for u be Element of REAL 3 st u in D holds
  f|D is_hpartial_differentiable`22_in u;
  pred f is_hpartial_differentiable`23_on D means

  D c= dom f & for u be Element of REAL 3 st u in D holds
  f|D is_hpartial_differentiable`23_in u;
  pred f is_hpartial_differentiable`31_on D means

  D c= dom f & for u be Element of REAL 3 st u in D holds
  f|D is_hpartial_differentiable`31_in u;
  pred f is_hpartial_differentiable`32_on D means

  D c= dom f & for u be Element of REAL 3 st u in D holds
  f|D is_hpartial_differentiable`32_in u;
  pred f is_hpartial_differentiable`33_on D means

  D c= dom f & for u be Element of REAL 3 st u in D holds
  f|D is_hpartial_differentiable`33_in u;
end;

definition
  let f be PartFunc of REAL 3,REAL;
  let D be set;
  assume  f is_hpartial_differentiable`11_on D;
  func f`hpartial11|D -> PartFunc of REAL 3,REAL means

  dom it = D & for u be Element of REAL 3 st u in D holds
  it.u = hpartdiff11(f,u);
end;

definition
  let f be PartFunc of REAL 3,REAL;
  let D be set;
  assume  f is_hpartial_differentiable`12_on D;
  func f`hpartial12|D -> PartFunc of REAL 3,REAL means

  dom it = D & for u be Element of REAL 3 st u in D holds
  it.u = hpartdiff12(f,u);
end;

definition
  let f be PartFunc of REAL 3,REAL;
  let D be set;
  assume  f is_hpartial_differentiable`13_on D;
  func f`hpartial13|D -> PartFunc of REAL 3,REAL means

  dom it = D & for u be Element of REAL 3 st u in D holds
  it.u = hpartdiff13(f,u);
end;

definition
  let f be PartFunc of REAL 3,REAL;
  let D be set;
  assume  f is_hpartial_differentiable`21_on D;
  func f`hpartial21|D -> PartFunc of REAL 3,REAL means

  dom it = D & for u be Element of REAL 3 st u in D holds
  it.u = hpartdiff21(f,u);
end;

definition
  let f be PartFunc of REAL 3,REAL;
  let D be set;
  assume  f is_hpartial_differentiable`22_on D;
  func f`hpartial22|D -> PartFunc of REAL 3,REAL means

  dom it = D & for u be Element of REAL 3 st u in D holds
  it.u = hpartdiff22(f,u);
end;

definition
  let f be PartFunc of REAL 3,REAL;
  let D be set;
  assume  f is_hpartial_differentiable`23_on D;
  func f`hpartial23|D -> PartFunc of REAL 3,REAL means

  dom it = D & for u be Element of REAL 3 st u in D holds
  it.u = hpartdiff23(f,u);
end;

definition
  let f be PartFunc of REAL 3,REAL;
  let D be set;
  assume  f is_hpartial_differentiable`31_on D;
  func f`hpartial31|D -> PartFunc of REAL 3,REAL means

  dom it = D & for u be Element of REAL 3 st u in D holds
  it.u = hpartdiff31(f,u);
end;

definition
  let f be PartFunc of REAL 3,REAL;
  let D be set;
  assume  f is_hpartial_differentiable`32_on D;
  func f`hpartial32|D -> PartFunc of REAL 3,REAL means

  dom it = D & for u be Element of REAL 3 st u in D holds
  it.u = hpartdiff32(f,u);
end;

definition
  let f be PartFunc of REAL 3,REAL;
  let D be set;
  assume  f is_hpartial_differentiable`33_on D;
  func f`hpartial33|D -> PartFunc of REAL 3,REAL means

  dom it = D & for u be Element of REAL 3 st u in D holds
  it.u = hpartdiff33(f,u);
end;

begin 

theorem 
  f is_hpartial_differentiable`11_in u iff
  pdiff1(f,1) is_partial_differentiable_in u,1;

theorem 
  f is_hpartial_differentiable`12_in u iff
  pdiff1(f,1) is_partial_differentiable_in u,2;

theorem 
  f is_hpartial_differentiable`13_in u iff
  pdiff1(f,1) is_partial_differentiable_in u,3;

theorem 
  f is_hpartial_differentiable`21_in u iff
  pdiff1(f,2) is_partial_differentiable_in u,1;

theorem 
  f is_hpartial_differentiable`22_in u iff
  pdiff1(f,2) is_partial_differentiable_in u,2;

theorem 
  f is_hpartial_differentiable`23_in u iff
  pdiff1(f,2) is_partial_differentiable_in u,3;

theorem 
  f is_hpartial_differentiable`31_in u iff
  pdiff1(f,3) is_partial_differentiable_in u,1;

theorem 
  f is_hpartial_differentiable`32_in u iff
  pdiff1(f,3) is_partial_differentiable_in u,2;

theorem 
  f is_hpartial_differentiable`33_in u iff
  pdiff1(f,3) is_partial_differentiable_in u,3;

theorem 
  f is_hpartial_differentiable`11_in u implies
  hpartdiff11(f,u) = partdiff(pdiff1(f,1),u,1);

theorem 
  f is_hpartial_differentiable`12_in u implies
  hpartdiff12(f,u) = partdiff(pdiff1(f,1),u,2);

theorem 
  f is_hpartial_differentiable`13_in u implies
  hpartdiff13(f,u) = partdiff(pdiff1(f,1),u,3);

theorem 
  f is_hpartial_differentiable`21_in u implies
  hpartdiff21(f,u) = partdiff(pdiff1(f,2),u,1);

theorem 
  f is_hpartial_differentiable`22_in u implies
  hpartdiff22(f,u) = partdiff(pdiff1(f,2),u,2);

theorem 
  f is_hpartial_differentiable`23_in u implies
  hpartdiff23(f,u) = partdiff(pdiff1(f,2),u,3);

theorem 
  f is_hpartial_differentiable`31_in u implies
  hpartdiff31(f,u) = partdiff(pdiff1(f,3),u,1);

theorem 
  f is_hpartial_differentiable`32_in u implies
  hpartdiff32(f,u) = partdiff(pdiff1(f,3),u,2);

theorem 
  f is_hpartial_differentiable`33_in u implies
  hpartdiff33(f,u) = partdiff(pdiff1(f,3),u,3);

theorem 
  for u0 being Element of REAL 3 for N being Neighbourhood of proj(1,3).u0 st
  f is_hpartial_differentiable`11_in u0 &
  N c= dom SVF1(1,pdiff1(f,1),u0) holds
  for h be 0-convergent non-zero Real_Sequence, c be constant Real_Sequence
  st rng c = {proj(1,3).u0} & rng (h+c) c= N holds
  h"(#)(SVF1(1,pdiff1(f,1),u0)/*(h+c) - SVF1(1,pdiff1(f,1),u0)/*c)
    is convergent &
  hpartdiff11(f,u0)
  = lim (h"(#)(SVF1(1,pdiff1(f,1),u0)/*(h+c) - SVF1(1,pdiff1(f,1),u0)/*c));

theorem 
  for u0 being Element of REAL 3 for N being Neighbourhood of proj(2,3).u0 st
  f is_hpartial_differentiable`12_in u0 &
  N c= dom SVF1(2,pdiff1(f,1),u0) holds
  for h be 0-convergent non-zero Real_Sequence, c be constant Real_Sequence
  st rng c = {proj(2,3).u0} & rng (h+c) c= N holds
  h"(#)(SVF1(2,pdiff1(f,1),u0)/*(h+c) - SVF1(2,pdiff1(f,1),u0)/*c)
    is convergent &
  hpartdiff12(f,u0)
  = lim (h"(#)(SVF1(2,pdiff1(f,1),u0)/*(h+c) - SVF1(2,pdiff1(f,1),u0)/*c));

theorem 
  for u0 being Element of REAL 3 for N being Neighbourhood of proj(3,3).u0 st
  f is_hpartial_differentiable`13_in u0 &
  N c= dom SVF1(3,pdiff1(f,1),u0) holds
  for h be 0-convergent non-zero Real_Sequence, c be constant Real_Sequence
  st rng c = {proj(3,3).u0} & rng (h+c) c= N holds
  h"(#)(SVF1(3,pdiff1(f,1),u0)/*(h+c) - SVF1(3,pdiff1(f,1),u0)/*c)
    is convergent &
  hpartdiff13(f,u0)
  = lim (h"(#)(SVF1(3,pdiff1(f,1),u0)/*(h+c) - SVF1(3,pdiff1(f,1),u0)/*c));

theorem 
  for u0 being Element of REAL 3 for N being Neighbourhood of proj(1,3).u0 st
  f is_hpartial_differentiable`21_in u0 &
  N c= dom SVF1(1,pdiff1(f,2),u0) holds
  for h be 0-convergent non-zero Real_Sequence, c be constant Real_Sequence
  st rng c = {proj(1,3).u0} & rng (h+c) c= N holds
  h"(#)(SVF1(1,pdiff1(f,2),u0)/*(h+c) - SVF1(1,pdiff1(f,2),u0)/*c)
    is convergent &
  hpartdiff21(f,u0)
  = lim (h"(#)(SVF1(1,pdiff1(f,2),u0)/*(h+c) - SVF1(1,pdiff1(f,2),u0)/*c));

theorem 
  for u0 being Element of REAL 3 for N being Neighbourhood of proj(2,3).u0 st
  f is_hpartial_differentiable`22_in u0 &
  N c= dom SVF1(2,pdiff1(f,2),u0) holds
  for h be 0-convergent non-zero Real_Sequence, c be constant Real_Sequence
  st rng c = {proj(2,3).u0} & rng (h+c) c= N holds
  h"(#)(SVF1(2,pdiff1(f,2),u0)/*(h+c) - SVF1(2,pdiff1(f,2),u0)/*c)
    is convergent &
  hpartdiff22(f,u0)
  = lim (h"(#)(SVF1(2,pdiff1(f,2),u0)/*(h+c) - SVF1(2,pdiff1(f,2),u0)/*c));

theorem 
  for u0 being Element of REAL 3 for N being Neighbourhood of proj(3,3).u0 st
  f is_hpartial_differentiable`23_in u0 &
  N c= dom SVF1(3,pdiff1(f,2),u0) holds
  for h be 0-convergent non-zero Real_Sequence, c be constant Real_Sequence
  st rng c = {proj(3,3).u0} & rng (h+c) c= N holds
  h"(#)(SVF1(3,pdiff1(f,2),u0)/*(h+c) - SVF1(3,pdiff1(f,2),u0)/*c)
    is convergent &
  hpartdiff23(f,u0)
  = lim (h"(#)(SVF1(3,pdiff1(f,2),u0)/*(h+c) - SVF1(3,pdiff1(f,2),u0)/*c));

theorem 
  for u0 being Element of REAL 3 for N being Neighbourhood of proj(1,3).u0 st
  f is_hpartial_differentiable`31_in u0 &
  N c= dom SVF1(1,pdiff1(f,3),u0) holds
  for h be 0-convergent non-zero Real_Sequence, c be constant Real_Sequence
  st rng c = {proj(1,3).u0} & rng (h+c) c= N holds
  h"(#)(SVF1(1,pdiff1(f,3),u0)/*(h+c) - SVF1(1,pdiff1(f,3),u0)/*c)
    is convergent &
  hpartdiff31(f,u0)
  = lim (h"(#)(SVF1(1,pdiff1(f,3),u0)/*(h+c) - SVF1(1,pdiff1(f,3),u0)/*c));

theorem 
  for u0 being Element of REAL 3 for N being Neighbourhood of proj(2,3).u0 st
  f is_hpartial_differentiable`32_in u0 &
  N c= dom SVF1(2,pdiff1(f,3),u0) holds
  for h be 0-convergent non-zero Real_Sequence, c be constant Real_Sequence
  st rng c = {proj(2,3).u0} & rng (h+c) c= N holds
  h"(#)(SVF1(2,pdiff1(f,3),u0)/*(h+c) - SVF1(2,pdiff1(f,3),u0)/*c)
    is convergent &
  hpartdiff32(f,u0)
  = lim (h"(#)(SVF1(2,pdiff1(f,3),u0)/*(h+c) - SVF1(2,pdiff1(f,3),u0)/*c));

theorem 
  for u0 being Element of REAL 3 for N being Neighbourhood of proj(3,3).u0 st
  f is_hpartial_differentiable`33_in u0 &
  N c= dom SVF1(3,pdiff1(f,3),u0) holds
  for h be 0-convergent non-zero Real_Sequence, c be constant Real_Sequence
  st rng c = {proj(3,3).u0} & rng (h+c) c= N holds
  h"(#)(SVF1(3,pdiff1(f,3),u0)/*(h+c) - SVF1(3,pdiff1(f,3),u0)/*c)
    is convergent &
  hpartdiff33(f,u0)
  = lim (h"(#)(SVF1(3,pdiff1(f,3),u0)/*(h+c) - SVF1(3,pdiff1(f,3),u0)/*c));

theorem 
  f1 is_hpartial_differentiable`11_in u0 &
  f2 is_hpartial_differentiable`11_in u0 implies
  pdiff1(f1,1)+pdiff1(f2,1) is_partial_differentiable_in u0,1 &
  partdiff(pdiff1(f1,1)+pdiff1(f2,1),u0,1)
  = hpartdiff11(f1,u0) + hpartdiff11(f2,u0);

theorem 
  f1 is_hpartial_differentiable`12_in u0 &
  f2 is_hpartial_differentiable`12_in u0 implies
  pdiff1(f1,1)+pdiff1(f2,1) is_partial_differentiable_in u0,2 &
  partdiff(pdiff1(f1,1)+pdiff1(f2,1),u0,2)
  = hpartdiff12(f1,u0) + hpartdiff12(f2,u0);

theorem 
  f1 is_hpartial_differentiable`13_in u0 &
  f2 is_hpartial_differentiable`13_in u0 implies
  pdiff1(f1,1)+pdiff1(f2,1) is_partial_differentiable_in u0,3 &
  partdiff(pdiff1(f1,1)+pdiff1(f2,1),u0,3)
  = hpartdiff13(f1,u0) + hpartdiff13(f2,u0);

theorem 
  f1 is_hpartial_differentiable`21_in u0 &
  f2 is_hpartial_differentiable`21_in u0 implies
  pdiff1(f1,2)+pdiff1(f2,2) is_partial_differentiable_in u0,1 &
  partdiff(pdiff1(f1,2)+pdiff1(f2,2),u0,1)
  = hpartdiff21(f1,u0) + hpartdiff21(f2,u0);

theorem 
  f1 is_hpartial_differentiable`22_in u0 &
  f2 is_hpartial_differentiable`22_in u0 implies
  pdiff1(f1,2)+pdiff1(f2,2) is_partial_differentiable_in u0,2 &
  partdiff(pdiff1(f1,2)+pdiff1(f2,2),u0,2)
  = hpartdiff22(f1,u0) + hpartdiff22(f2,u0);

theorem 
  f1 is_hpartial_differentiable`23_in u0 &
  f2 is_hpartial_differentiable`23_in u0 implies
  pdiff1(f1,2)+pdiff1(f2,2) is_partial_differentiable_in u0,3 &
  partdiff(pdiff1(f1,2)+pdiff1(f2,2),u0,3)
  = hpartdiff23(f1,u0) + hpartdiff23(f2,u0);

theorem 
  f1 is_hpartial_differentiable`11_in u0 &
  f2 is_hpartial_differentiable`11_in u0 implies
  pdiff1(f1,1)-pdiff1(f2,1) is_partial_differentiable_in u0,1 &
  partdiff(pdiff1(f1,1)-pdiff1(f2,1),u0,1)
  = hpartdiff11(f1,u0) - hpartdiff11(f2,u0);

theorem 
  f1 is_hpartial_differentiable`12_in u0 &
  f2 is_hpartial_differentiable`12_in u0 implies
  pdiff1(f1,1)-pdiff1(f2,1) is_partial_differentiable_in u0,2 &
  partdiff(pdiff1(f1,1)-pdiff1(f2,1),u0,2)
  = hpartdiff12(f1,u0) - hpartdiff12(f2,u0);

theorem 
  f1 is_hpartial_differentiable`13_in u0 &
  f2 is_hpartial_differentiable`13_in u0 implies
  pdiff1(f1,1)-pdiff1(f2,1) is_partial_differentiable_in u0,3 &
  partdiff(pdiff1(f1,1)-pdiff1(f2,1),u0,3)
  = hpartdiff13(f1,u0) - hpartdiff13(f2,u0);

theorem 
  f1 is_hpartial_differentiable`21_in u0 &
  f2 is_hpartial_differentiable`21_in u0 implies
  pdiff1(f1,2)-pdiff1(f2,2) is_partial_differentiable_in u0,1 &
  partdiff(pdiff1(f1,2)-pdiff1(f2,2),u0,1)
  = hpartdiff21(f1,u0) - hpartdiff21(f2,u0);

theorem 
  f1 is_hpartial_differentiable`22_in u0 &
  f2 is_hpartial_differentiable`22_in u0 implies
  pdiff1(f1,2)-pdiff1(f2,2) is_partial_differentiable_in u0,2 &
  partdiff(pdiff1(f1,2)-pdiff1(f2,2),u0,2)
  = hpartdiff22(f1,u0) - hpartdiff22(f2,u0);

theorem 
  f1 is_hpartial_differentiable`23_in u0 &
  f2 is_hpartial_differentiable`23_in u0 implies
  pdiff1(f1,2)-pdiff1(f2,2) is_partial_differentiable_in u0,3 &
  partdiff(pdiff1(f1,2)-pdiff1(f2,2),u0,3)
  = hpartdiff23(f1,u0) - hpartdiff23(f2,u0);

theorem 
  f is_hpartial_differentiable`11_in u0 implies
  r(#)pdiff1(f,1) is_partial_differentiable_in u0,1 &
  partdiff((r(#)pdiff1(f,1)),u0,1) = r*hpartdiff11(f,u0);

theorem 
  f is_hpartial_differentiable`12_in u0 implies
  r(#)pdiff1(f,1) is_partial_differentiable_in u0,2 &
  partdiff((r(#)pdiff1(f,1)),u0,2) = r*hpartdiff12(f,u0);

theorem 
  f is_hpartial_differentiable`13_in u0 implies
  r(#)pdiff1(f,1) is_partial_differentiable_in u0,3 &
  partdiff((r(#)pdiff1(f,1)),u0,3) = r*hpartdiff13(f,u0);

theorem 
  f is_hpartial_differentiable`21_in u0 implies
  r(#)pdiff1(f,2) is_partial_differentiable_in u0,1 &
  partdiff((r(#)pdiff1(f,2)),u0,1) = r*hpartdiff21(f,u0);

theorem 
  f is_hpartial_differentiable`22_in u0 implies
  r(#)pdiff1(f,2) is_partial_differentiable_in u0,2 &
  partdiff((r(#)pdiff1(f,2)),u0,2) = r*hpartdiff22(f,u0);

theorem 
  f is_hpartial_differentiable`23_in u0 implies
  r(#)pdiff1(f,2) is_partial_differentiable_in u0,3 &
  partdiff((r(#)pdiff1(f,2)),u0,3) = r*hpartdiff23(f,u0);

theorem 
  f is_hpartial_differentiable`31_in u0 implies
  r(#)pdiff1(f,3) is_partial_differentiable_in u0,1 &
  partdiff((r(#)pdiff1(f,3)),u0,1) = r*hpartdiff31(f,u0);

theorem 
  f is_hpartial_differentiable`32_in u0 implies
  r(#)pdiff1(f,3) is_partial_differentiable_in u0,2 &
  partdiff((r(#)pdiff1(f,3)),u0,2) = r*hpartdiff32(f,u0);

theorem 
  f is_hpartial_differentiable`33_in u0 implies
  r(#)pdiff1(f,3) is_partial_differentiable_in u0,3 &
  partdiff((r(#)pdiff1(f,3)),u0,3) = r*hpartdiff33(f,u0);

theorem 
  f1 is_hpartial_differentiable`11_in u0 &
  f2 is_hpartial_differentiable`11_in u0 implies
  pdiff1(f1,1)(#)pdiff1(f2,1) is_partial_differentiable_in u0,1;

theorem 
  f1 is_hpartial_differentiable`12_in u0 &
  f2 is_hpartial_differentiable`12_in u0 implies
  pdiff1(f1,1)(#)pdiff1(f2,1) is_partial_differentiable_in u0,2;

theorem 
  f1 is_hpartial_differentiable`13_in u0 &
  f2 is_hpartial_differentiable`13_in u0 implies
  pdiff1(f1,1)(#)pdiff1(f2,1) is_partial_differentiable_in u0,3;

theorem 
  f1 is_hpartial_differentiable`21_in u0 &
  f2 is_hpartial_differentiable`21_in u0 implies
  pdiff1(f1,2)(#)pdiff1(f2,2) is_partial_differentiable_in u0,1;

theorem 
  f1 is_hpartial_differentiable`22_in u0 &
  f2 is_hpartial_differentiable`22_in u0 implies
  pdiff1(f1,2)(#)pdiff1(f2,2) is_partial_differentiable_in u0,2;

theorem 
  f1 is_hpartial_differentiable`23_in u0 &
  f2 is_hpartial_differentiable`23_in u0 implies
  pdiff1(f1,2)(#)pdiff1(f2,2) is_partial_differentiable_in u0,3;

theorem 
  f1 is_hpartial_differentiable`31_in u0 &
  f2 is_hpartial_differentiable`31_in u0 implies
  pdiff1(f1,3)(#)pdiff1(f2,3) is_partial_differentiable_in u0,1;

theorem 
  f1 is_hpartial_differentiable`32_in u0 &
  f2 is_hpartial_differentiable`32_in u0 implies
  pdiff1(f1,3)(#)pdiff1(f2,3) is_partial_differentiable_in u0,2;

theorem 
  f1 is_hpartial_differentiable`33_in u0 &
  f2 is_hpartial_differentiable`33_in u0 implies
  pdiff1(f1,3)(#)pdiff1(f2,3) is_partial_differentiable_in u0,3;

theorem 
  for u0 being Element of REAL 3 holds f is_hpartial_differentiable`11_in u0
  implies SVF1(1,pdiff1(f,1),u0) is_continuous_in proj(1,3).u0;

theorem 
  for u0 being Element of REAL 3 holds f is_hpartial_differentiable`12_in u0
  implies SVF1(2,pdiff1(f,1),u0) is_continuous_in proj(2,3).u0;

theorem 
  for u0 being Element of REAL 3 holds f is_hpartial_differentiable`13_in u0
  implies SVF1(3,pdiff1(f,1),u0) is_continuous_in proj(3,3).u0;

theorem 
  for u0 being Element of REAL 3 holds f is_hpartial_differentiable`21_in u0
  implies SVF1(1,pdiff1(f,2),u0) is_continuous_in proj(1,3).u0;

theorem 
  for u0 being Element of REAL 3 holds f is_hpartial_differentiable`22_in u0
  implies SVF1(2,pdiff1(f,2),u0) is_continuous_in proj(2,3).u0;

theorem 
  for u0 being Element of REAL 3 holds f is_hpartial_differentiable`23_in u0
  implies SVF1(3,pdiff1(f,2),u0) is_continuous_in proj(3,3).u0;

theorem 
  for u0 being Element of REAL 3 holds f is_hpartial_differentiable`31_in u0
  implies SVF1(1,pdiff1(f,3),u0) is_continuous_in proj(1,3).u0;

theorem 
  for u0 being Element of REAL 3 holds f is_hpartial_differentiable`32_in u0
  implies SVF1(2,pdiff1(f,3),u0) is_continuous_in proj(2,3).u0;

theorem 
  for u0 being Element of REAL 3 holds f is_hpartial_differentiable`33_in u0
  implies SVF1(3,pdiff1(f,3),u0) is_continuous_in proj(3,3).u0;














begin

 reserve a,x for Real;
 reserve n for Element of NAT;
 reserve A for non empty closed_interval Subset of REAL;
 reserve f,h,f1,f2 for PartFunc of REAL,REAL;
 reserve Z for open Subset of REAL;



theorem 
 A c= Z & f=(sin(#)cos)^ & Z c= dom (ln*tan) & Z = dom f & f|A is continuous
 implies integral(f,A)=(ln*tan).(upper_bound A)-(ln*tan).(lower_bound A);



theorem 
 A c= Z & f=-(sin(#)cos)^ & Z c= dom (ln*cot) & Z = dom f & f|A is continuous
 implies integral(f,A)=(ln*cot).(upper_bound A)-(ln*cot).(lower_bound A);



theorem 
 A c= Z & f=2(#)(exp_R(#)sin)
 & Z c= dom (exp_R(#)(sin-cos)) & Z = dom f & f|A is continuous implies
 integral(f,A)=(exp_R(#)(sin-cos)).(upper_bound A)-
 (exp_R(#)(sin-cos)).(lower_bound A);



theorem 
 A c= Z & f=2(#)(exp_R(#)cos)
 & Z c= dom (exp_R(#)(sin+cos)) & Z = dom f & f|A is continuous implies
 integral(f,A)=(exp_R(#)(sin+cos)).(upper_bound A)-
 (exp_R(#)(sin+cos)).(lower_bound A);



theorem 
 A c= Z & Z = dom (cos-sin) & (cos-sin)|A is continuous implies
 integral(cos-sin,A)=(sin+cos).(upper_bound A)-(sin+cos).(lower_bound A);



theorem 
 A c= Z & Z = dom (cos+sin) & (cos+sin)|A is continuous implies
 integral(cos+sin,A)=(sin-cos).(upper_bound A)-(sin-cos).(lower_bound A);

theorem 
  Z c= dom ((-1/2)(#)((sin+cos)/exp_R)) implies
  (-1/2)(#)((sin+cos)/exp_R) is_differentiable_on Z &
  for x st x in Z holds (((-1/2)(#)((sin+cos)/exp_R))`|Z).x = sin.x/exp_R.x;



theorem 
 A c= Z & f=sin/exp_R
 & Z c= dom ((-1/2)(#)((sin+cos)/exp_R)) & Z = dom f & f|A is continuous
 implies integral(f,A)=((-1/2)(#)((sin+cos)/exp_R)).(upper_bound A)
                      -((-1/2)(#)((sin+cos)/exp_R)).(lower_bound A);

theorem 
  Z c= dom ((1/2)(#)((sin-cos)/exp_R)) implies
(1/2)(#)((sin-cos)/exp_R) is_differentiable_on Z &
  for x st x in Z holds (((1/2)(#)((sin-cos)/exp_R))`|Z).x =cos.x/exp_R.x;



theorem 
 A c= Z & f=cos/exp_R
 & Z c= dom ((1/2)(#)((sin-cos)/exp_R)) & Z = dom f & f|A is continuous
 implies integral(f,A)=((1/2)(#)((sin-cos)/exp_R)).(upper_bound A)
                     -((1/2)(#)((sin-cos)/exp_R)).(lower_bound A);



theorem 
 A c= Z & f=exp_R(#)(sin+cos)
 & Z c= dom (exp_R(#)sin) & Z = dom f & f|A is continuous implies
 integral(f,A)=(exp_R(#)sin).(upper_bound A)-(exp_R(#)sin).(lower_bound A);



theorem 
A c= Z & f=exp_R(#)(cos-sin)
& Z c= dom (exp_R(#)cos) & Z = dom f & f|A is continuous implies
integral(f,A)=(exp_R(#)cos).(upper_bound A)-(exp_R(#)cos).(lower_bound A);



theorem 
 A c= Z & f1=#Z 2 & f=-sin/cos/f1 + (id Z)^/cos^2
 & Z c= dom ((id Z)^(#)tan) & Z = dom f & f|A is continuous implies
 integral(f,A)=((id Z)^(#)tan).(upper_bound A)-((id Z)^(#)tan).(lower_bound A);



theorem 
 A c= Z & f=-cos/sin/f1-(id Z)^/sin^2 & f1=#Z 2
 & Z c= dom ((id Z)^(#)cot) & Z = dom f & f|A is continuous
 implies
 integral(f,A)=((id Z)^(#)cot).(upper_bound A)-((id Z)^(#)cot).(lower_bound A);



theorem 
 A c= Z & f=sin/cos/(id Z)+ln/cos^2
 & Z c= dom (ln(#)tan) & Z = dom f & f|A is continuous implies
 integral(f,A)=(ln(#)tan).(upper_bound A)-(ln(#)tan).(lower_bound A);



theorem 
 A c= Z & f=cos/sin/(id Z)-ln/sin^2
 & Z c= dom (ln(#)cot) & Z = dom f & f|A is continuous implies
 integral(f,A)=(ln(#)cot).(upper_bound A)-(ln(#)cot).(lower_bound A);



theorem 
 A c= Z & f=tan/(id Z)+ln/cos^2
 & Z c= dom (ln(#)tan) & Z c= dom tan & Z = dom f & f|A is continuous implies
 integral(f,A)=(ln(#)tan).(upper_bound A)-(ln(#)tan).(lower_bound A);



theorem 
 A c= Z & f=cot/(id Z)-ln/sin^2
 & Z c= dom (ln(#)cot) & Z c= dom cot & Z = dom f & f|A is continuous implies
 integral(f,A)=(ln(#)cot).(upper_bound A)-(ln(#)cot).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds f1.x=1) & f=arctan/(id Z)+ln/(f1+( #Z 2))
 & Z c= ]. -1,1 .[ & Z = dom f & f|A is continuous implies
 integral(f,A)=(ln(#)arctan).(upper_bound A)-(ln(#)arctan).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds f1.x=1) & f=arccot/(id Z)-ln/(f1+( #Z 2))
 & Z c= ]. -1,1 .[ & Z = dom f & f|A is continuous implies
 integral(f,A)=(ln(#)arccot).(upper_bound A)-(ln(#)arccot).(lower_bound A);



theorem 
 A c= Z & f=exp_R*tan/cos^2 & Z = dom f & f|A is continuous
 implies integral(f,A)=(exp_R*tan).(upper_bound A)-(exp_R*tan).(lower_bound A);



theorem 
 A c= Z & f=-exp_R*cot/sin^2 & Z = dom f & f|A is continuous
 implies integral(f,A)=(exp_R*cot).(upper_bound A)-(exp_R*cot).(lower_bound A);

theorem 
  Z c= dom (exp_R*cot) implies -exp_R*cot is_differentiable_on Z &
  for x st x in Z holds ((-exp_R*cot)`|Z).x = exp_R.(cot.x)/(sin.x)^2;



theorem 
 A c= Z & f=exp_R*cot/sin^2 & Z = dom f & f|A is continuous
 implies integral(f,A)=(-exp_R*cot).(upper_bound A)-
 (-exp_R*cot).(lower_bound A);



theorem 
 A c= Z & f=((id Z)(#)(cos*ln)^2)^
 & Z c= dom (tan*ln) & Z = dom f & f|A is continuous
 implies integral(f,A)=(tan*ln).(upper_bound A)-(tan*ln).(lower_bound A);



theorem 
 A c= Z & f=-((id Z)(#)(sin*ln)^2)^
 & Z c= dom (cot*ln) & Z = dom f & f|A is continuous
 implies integral(f,A)=(cot*ln).(upper_bound A)-(cot*ln).(lower_bound A);

theorem 
Z c= dom (cot*ln) implies -cot*ln is_differentiable_on Z &
for x st x in Z holds ((-cot*ln)`|Z).x = 1/(x*(sin.(ln.x))^2);



theorem 
 A c= Z & f=((id Z)(#)(sin*ln)^2)^
 & Z c= dom (cot*ln) & Z = dom f & f|A is continuous
 implies integral(f,A)=(-cot*ln).(upper_bound A)-(-cot*ln).(lower_bound A);



theorem 
 A c= Z & f=exp_R/(cos*exp_R)^2
 & Z c= dom (tan*exp_R) & Z = dom f & f|A is continuous
 implies integral(f,A)=(tan*exp_R).(upper_bound A)-(tan*exp_R).(lower_bound A);



theorem 
 A c= Z & f=-exp_R/(sin*exp_R)^2
 & Z c= dom (cot*exp_R) & Z = dom f & f|A is continuous
 implies integral(f,A)=(cot*exp_R).(upper_bound A)-(cot*exp_R).(lower_bound A);

theorem 
 Z c= dom (cot*exp_R) implies -cot*exp_R is_differentiable_on Z &
 for x st x in Z holds ((-cot*exp_R)`|Z).x = exp_R.x/(sin.(exp_R.x))^2;



theorem 
 A c= Z & f=exp_R/(sin*exp_R)^2
 & Z c= dom (cot*exp_R) & Z = dom f & f|A is continuous
 implies integral(f,A)=(-cot*exp_R).(upper_bound A)-
 (-cot*exp_R).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds f.x=-1/(x^2*(cos.(1/x))^2))
 & Z c= dom (tan*((id Z)^)) & Z = dom f & f|A is continuous
 implies integral(f,A)=(tan*((id Z)^)).(upper_bound A)-
 (tan*((id Z)^)).(lower_bound A);

theorem 
  Z c= dom (tan*((id Z)^)) implies (-tan*((id Z)^)) is_differentiable_on Z &
  for x st x in Z holds ((-tan*((id Z)^))`|Z).x = 1/(x^2*(cos.(1/x))^2);



theorem 
 A c= Z & (for x st x in Z holds f.x=1/(x^2*(cos.(1/x))^2))
 & Z c= dom (tan*((id Z)^)) & Z = dom f & f|A is continuous
 implies integral(f,A)=(-tan*((id Z)^)).(upper_bound A) -
 (-tan*((id Z)^)).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds f.x=1/(x^2*(sin.(1/x))^2))
 & Z c= dom (cot*((id Z)^)) & Z = dom f & f|A is continuous
 implies integral(f,A)=(cot*((id Z)^)).(upper_bound A) -
 (cot*((id Z)^)).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds f1.x=1 & arctan.x>0) & f=((f1+#Z 2)(#)arctan)^
 & Z c= ]. -1,1 .[ & Z c= dom (ln*(arctan)) & Z = dom f
 & f|A is continuous implies
 integral(f,A)=(ln*(arctan)).(upper_bound A)-(ln* (arctan)).(lower_bound A);



theorem 
 A c= Z & f=n(#)((( #Z (n-1))*arctan)/(f1+#Z 2))
 & (for x st x in Z holds f1.x=1)
 & Z c= ]. -1,1 .[ & Z c= dom (( #Z n)*(arctan)) & Z = dom f
 & f|A is continuous implies
 integral(f,A)=(( #Z n)*arctan).(upper_bound A)-
 (( #Z n)*arctan).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds f1.x=1)
 & f=-(n(#)((( #Z (n-1))*arccot)/(f1+#Z 2)))
 & Z c= ]. -1,1 .[ & Z c= dom (( #Z n)*arccot) & Z = dom f
 & f|A is continuous implies
 integral(f,A)=(( #Z n)*arccot).(upper_bound A)-
 (( #Z n)*arccot).(lower_bound A);

theorem 
  Z c= dom (( #Z n)*arccot) & Z c= ]. -1,1 .[ implies
  -( #Z n)*arccot is_differentiable_on Z & for x st x in Z holds
  ((-( #Z n)*arccot)`|Z).x = n*(arccot.x) #Z (n-1) / (1+x^2);



theorem 
 A c= Z & (for x st x in Z holds f1.x=1)
 & f=n(#)((( #Z (n-1))*arccot)/(f1+#Z 2))
 & Z c= ]. -1,1 .[ & Z c= dom (( #Z n)*arccot) & Z = dom f
 & f|A is continuous implies
 integral(f,A)=(-( #Z n)*arccot).(upper_bound A)-
 (-( #Z n)*arccot).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds f1.x=1) & f=arctan/(f1+#Z 2)
 & Z c= ]. -1,1 .[ & Z c= dom (( #Z 2)*(arctan))
 & Z = dom f & f|A is continuous implies
 integral(f,A)=((1/2)(#)(( #Z 2)*(arctan))).(upper_bound A)
              -((1/2)(#)(( #Z 2)*(arctan))).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds f1.x=1) & f=-arccot/(f1+#Z 2)
 & Z c= ]. -1,1 .[ & Z c= dom (( #Z 2)*(arccot))
 & Z = dom f & f|A is continuous implies
 integral(f,A)=((1/2)(#)(( #Z 2)*(arccot))).(upper_bound A)
              -((1/2)(#)(( #Z 2)*(arccot))).(lower_bound A);

theorem 
  Z c= dom (( #Z 2)*(arccot)) & Z c= ]. -1,1 .[ implies
  -(1/2)(#)(( #Z 2)*(arccot)) is_differentiable_on Z & for x st x in Z holds
  ((-(1/2)(#)(( #Z 2)*(arccot)))`|Z).x = arccot.x / (1+x^2);



theorem 
 A c= Z & (for x st x in Z holds f1.x=1) & f=arccot/(f1+#Z 2)
 & Z c= ]. -1,1 .[ & Z c= dom (( #Z 2)*(arccot))
 & Z = dom f & f|A is continuous implies
 integral(f,A)=(-(1/2)(#)(( #Z 2)*(arccot))).(upper_bound A)
              -(-(1/2)(#)(( #Z 2)*(arccot))).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds f1.x=1) & f=arctan+(id Z)/(f1+#Z 2)
 & Z c= ]. -1,1 .[ & Z = dom f & f|A is continuous implies
 integral(f,A)=((id Z)(#)(arctan)).(upper_bound A)-
 ((id Z)(#)(arctan)).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds f1.x=1) & f=arccot-(id Z)/(f1+#Z 2)
 & Z c= ]. -1,1 .[ & Z = dom f & f|A is continuous implies
 integral(f,A)=((id Z)(#)(arccot)).(upper_bound A)-
 ((id Z)(#)(arccot)).(lower_bound A);



theorem 
 A c= Z & Z c= ]. -1,1 .[ & f=exp_R*arctan/(f1+#Z 2)
 & (for x st x in Z holds f1.x=1) & Z = dom f & f|A is continuous
 implies integral(f,A)=(exp_R*arctan).(upper_bound A) -
 (exp_R*arctan).(lower_bound A);



theorem 
 A c= Z & Z c= ]. -1,1 .[ & f=-exp_R*arccot/(f1+#Z 2)
 & (for x st x in Z holds f1.x=1) & Z = dom f & f|A is continuous
 implies integral(f,A)=(exp_R*arccot).(upper_bound A) -
 (exp_R*arccot).(lower_bound A);

theorem 
 Z c= dom (exp_R*arccot) & Z c= ]. -1,1 .[ implies
 -exp_R*arccot is_differentiable_on Z & for x st x in Z holds
 ((-exp_R*arccot)`|Z).x = exp_R.(arccot.x)/(1+x^2);



theorem 
 A c= Z & Z c= ]. -1,1 .[ & f=exp_R*arccot/(f1+#Z 2)
 & (for x st x in Z holds f1.x=1) & Z = dom f & f|A is continuous
 implies integral(f,A)=(-exp_R*arccot).(upper_bound A)
                      -(-exp_R*arccot).(lower_bound A);



theorem 
 A c= Z & Z c= dom (ln*(f1+f2)) & f=(id Z)/(f1+f2)
 & f2=#Z 2 & (for x st x in Z holds f1.x=1) & Z = dom f
 & f|A is continuous implies
 integral(f,A)=((1/2)(#)(ln*(f1+f2))).(upper_bound A)
              -((1/2)(#)(ln*(f1+f2))).(lower_bound A);



theorem 
 A c= Z & Z c= dom (ln*(f1+f2)) & f=(id Z)/(a(#)(f1+f2))
 & (for x st x in Z holds h.x=x/a & f1.x=1)
 & a <> 0 & f2=( #Z 2)*h & Z = dom f & f|A is continuous
 implies integral(f,A)=((a/2)(#)(ln*(f1+f2))).(upper_bound A)
                      -((a/2)(#)(ln*(f1+f2))).(lower_bound A);

theorem 
  Z c= dom ((id Z)^(#)arctan) & Z c= ]. -1,1 .[
  implies (-(id Z)^(#)arctan) is_differentiable_on Z &
  for x st x in Z holds
  ((-(id Z)^(#)arctan)`|Z).x = arctan.x/(x^2)-1/(x*(1+x^2));

theorem 
  Z c= dom ((id Z)^(#)arccot) & Z c= ]. -1,1 .[
  implies (-(id Z)^(#)arccot) is_differentiable_on Z &
  for x st x in Z holds
  ((-(id Z)^(#)arccot)`|Z).x = arccot.x/(x^2)+1/(x*(1+x^2));



theorem 
 A c= Z & (for x st x in Z holds f1.x=1)
 & f=arctan/( #Z 2)-((id Z)(#)(f1+#Z 2))^
 & Z c= dom ((id Z)^(#)arctan) & Z c= ]. -1,1 .[
 & Z = dom f & f|A is continuous implies
 integral(f,A)=(-(id Z)^(#)arctan).(upper_bound A)-
 (-(id Z)^(#)arctan).(lower_bound A);



theorem 
 A c= Z & (for x st x in Z holds f1.x=1)
 & f=arccot/( #Z 2)+((id Z)(#)(f1+#Z 2))^
 & Z c= dom ((id Z)^(#)arccot) & Z c= ]. -1,1 .[
 & Z = dom f & f|A is continuous implies
 integral(f,A)=(-(id Z)^(#)arccot).(upper_bound A)-
 (-(id Z)^(#)arccot).(lower_bound A);














begin 

 reserve a,x for Real;
 reserve n for Nat;
 reserve A for non empty closed_interval Subset of REAL;
 reserve f,f1 for PartFunc of REAL,REAL;
 reserve Z for open Subset of REAL;

theorem 
  Z c= dom (sec*((id Z)^)) implies (-sec*((id Z)^)) is_differentiable_on Z &
  for x st x in Z holds
  ((-sec*((id Z)^))`|Z).x = sin.(1/x)/(x^2*(cos.(1/x))^2);



theorem 
  Z c= dom (cosec*exp_R) implies -cosec*exp_R is_differentiable_on Z &
  for x st x in Z holds ((-cosec*exp_R)`|Z).x
  = exp_R.x*cos.(exp_R.x)/(sin.(exp_R.x))^2;



theorem 
  Z c= dom (cosec*ln) implies -cosec*ln is_differentiable_on Z &
  for x st x in Z holds ((-cosec*ln)`|Z).x = cos.(ln.x)/(x*(sin.(ln.x))^2);



theorem 
  Z c= dom (exp_R*cosec) implies -exp_R*cosec is_differentiable_on Z
  & for x st x in Z holds
  ((-exp_R*cosec)`|Z).x = exp_R.(cosec.x)*cos.x/(sin.x)^2;



theorem 
  Z c= dom (ln*cosec) implies -ln*cosec is_differentiable_on Z
  & for x st x in Z holds ((-ln*cosec)`|Z).x = cot.x;



theorem 
  Z c= dom (( #Z n)*cosec) & 1<=n
  implies -( #Z n)*cosec is_differentiable_on Z & for x st x in Z holds
  ((-( #Z n)*cosec)`|Z).x = n*cos.x/(sin.x) #Z (n+1);



theorem 
  Z c= dom ((id Z)^(#)sec)
  implies (-(id Z)^(#)sec) is_differentiable_on Z & for x st x in Z holds
  ((-(id Z)^(#)sec)`|Z).x = 1/cos.x/x^2-sin.x/x/(cos.x)^2;



theorem 
 Z c= dom ((id Z)^(#)cosec)
 implies (-(id Z)^(#)cosec) is_differentiable_on Z & for x st x in Z holds
 ((-(id Z)^(#)cosec)`|Z).x = 1/sin.x/x^2+cos.x/x/(sin.x)^2;



theorem 
  Z c= dom (cosec*sin) implies -cosec*sin is_differentiable_on Z &
  for x st x in Z holds ((-cosec*sin)`|Z).x
  = cos.x*cos.(sin.x)/(sin.(sin.x))^2;



theorem 
  Z c= dom (sec*cot) implies -sec*cot is_differentiable_on Z &
  for x st x in Z holds ((-sec*cot)`|Z).x
  = sin.(cot.x)/(sin.x)^2/(cos.(cot.x))^2;



theorem 
  Z c= dom (cosec*tan) implies -cosec*tan is_differentiable_on Z &
  for x st x in Z holds ((-cosec*tan)`|Z).x
  = cos.(tan.x)/(cos.x)^2/(sin.(tan.x))^2;



theorem 
  Z c= dom (cot(#)sec) implies (-cot(#)sec) is_differentiable_on Z &
  for x st x in Z holds
  ((-cot(#)sec)`|Z).x = 1/(sin.x)^2/cos.x-cot.x*sin.x/(cos.x)^2;



theorem 
  Z c= dom (cot(#)cosec) implies (-cot(#)cosec) is_differentiable_on Z &
  for x st x in Z holds
  ((-cot(#)cosec)`|Z).x = 1/(sin.x)^2/sin.x+cot.x*cos.x/(sin.x)^2;



theorem 
  Z c= dom (cos (#) cot) implies (-cos (#) cot) is_differentiable_on Z &
  for x st x in Z holds((-cos (#) cot)`|Z).x = cos.x+cos.x/(sin.x)^2;

begin 


theorem 
A c= Z & (for x st x in Z holds f.x=sin.(1/x)/(x^2*(cos.(1/x))^2))
& Z c= dom (sec*((id Z)^)) & Z = dom f & f|A is continuous
implies integral(f,A)=(-sec*((id Z)^)).(upper_bound A)-
(-sec*((id Z)^)).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=cos.(1/x)/(x^2*(sin.(1/x))^2))
& Z c= dom (cosec*((id Z)^)) & Z = dom f & f|A is continuous
implies integral(f,A)=(cosec*((id Z)^)).(upper_bound A)-
(cosec*((id Z)^)).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=exp_R.x*sin.(exp_R.x)/(cos.(exp_R.x))^2)
& Z c= dom (sec*exp_R) & Z = dom f & f|A is continuous
implies integral(f,A)=(sec*exp_R).(upper_bound A)-(sec*exp_R).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=exp_R.x*cos.(exp_R.x)/(sin.(exp_R.x))^2)
& Z c= dom (cosec*exp_R) & Z = dom f & f|A is continuous implies
integral(f,A)=(-cosec*exp_R).(upper_bound A)-(-cosec*exp_R).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=sin.(ln.x)/(x*(cos.(ln.x))^2))
& Z c= dom (sec*ln) & Z = dom f & f|A is continuous
implies integral(f,A)=(sec*ln).(upper_bound A)-(sec*ln).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=cos.(ln.x)/(x*(sin.(ln.x))^2))
& Z c= dom (cosec*ln) & Z = dom f & f|A is continuous
implies integral(f,A)=(-cosec*ln).(upper_bound A)-(-cosec*ln).(lower_bound A);



theorem 
A c= Z & f=(exp_R*sec)(#)(sin/cos^2) & Z = dom f & f|A is continuous
implies integral(f,A)=(exp_R*sec).(upper_bound A)-(exp_R*sec).(lower_bound A);



theorem 
A c= Z & f=(exp_R*cosec)(#)(cos/sin^2) & Z = dom f & f|A is continuous
implies integral(f,A)=(-exp_R*cosec).(upper_bound A)-
(-exp_R*cosec).(lower_bound A);



theorem 
A c= Z & Z c= dom (ln*sec) & Z = dom tan & tan|A is continuous
implies integral(tan,A)=(ln*sec).(upper_bound A)-(ln*sec).(lower_bound A);



theorem 
A c= Z & Z c= dom (ln*cosec) & Z = dom cot & (-cot)|A is continuous
implies integral((-cot),A)=(ln*cosec).(upper_bound A)-
(ln*cosec).(lower_bound A);



theorem 
A c= Z & Z c= dom (ln*cosec) & Z = dom cot & cot|A is continuous
implies integral(cot,A)=(-ln*cosec).(upper_bound A)-(-ln*cosec).(lower_bound A)
;



theorem 
A c= Z & (for x st x in Z holds f.x=n*sin.x/(cos.x) #Z (n+1))
& Z c= dom (( #Z n)*sec) & 1<=n & Z = dom f & f|A is continuous
implies integral(f,A)=(( #Z n)*sec).(upper_bound A)-
(( #Z n)*sec).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=n*cos.x/(sin.x) #Z (n+1))
& Z c= dom (( #Z n)*cosec) & 1<=n & Z = dom f & f|A is continuous
implies integral(f,A)=(-( #Z n)*cosec).(upper_bound A)-
(-( #Z n)*cosec).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=exp_R.x/cos.x+exp_R.x*sin.x/(cos.x)^2)
& Z c= dom (exp_R(#)sec) & Z = dom f & f|A is continuous
implies integral(f,A)=(exp_R(#)sec).(upper_bound A)-
(exp_R(#)sec).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=exp_R.x/sin.x-exp_R.x*cos.x/(sin.x)^2)
& Z c= dom (exp_R(#)cosec) & Z = dom f & f|A is continuous
implies integral(f,A)=(exp_R(#)cosec).(upper_bound A)-
(exp_R(#)cosec).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=(sin.(a*x)-(cos.(a*x))^2)/(cos.(a*x))^2)
& (Z c= dom ((1/a)(#)(sec*f1)-id Z) & for x st x in Z holds f1.x=a*x & a<>0)
& Z = dom f & f|A is continuous implies
integral(f,A)=((1/a)(#)(sec*f1)-id Z).(upper_bound A)-
((1/a)(#)(sec*f1)-id Z).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=(cos.(a*x)-(sin.(a*x))^2)/(sin.(a*x))^2)
& (Z c= dom ((-1/a)(#)(cosec*f1)-id Z) & for x st x in Z holds f1.x=a*x & a<>0)
& Z = dom f & f|A is continuous implies
integral(f,A)=((-1/a)(#)(cosec*f1)-id Z).(upper_bound A)
             -((-1/a)(#)(cosec*f1)-id Z).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=1/cos.x/x+ln.x*sin.x/(cos.x)^2)
& Z c= dom (ln(#)sec) & Z = dom f & f|A is continuous implies
integral(f,A)=(ln(#)sec).(upper_bound A)-(ln(#)sec).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=1/sin.x/x-ln.x*cos.x/(sin.x)^2)
& Z c= dom (ln(#)cosec) & Z = dom f & f|A is continuous implies
integral(f,A)=(ln(#)cosec).(upper_bound A)-(ln(#)cosec).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=1/cos.x/x^2-sin.x/x/(cos.x)^2)
& Z c= dom ((id Z)^(#)sec) & Z = dom f & f|A is continuous implies
integral(f,A)=(-(id Z)^(#)sec).(upper_bound A)-(-(id Z)^(#)sec).(lower_bound A)
;



theorem 
A c= Z & (for x st x in Z holds f.x=1/sin.x/x^2+cos.x/x/(sin.x)^2)
& Z c= dom ((id Z)^(#)cosec) & Z = dom f & f|A is continuous implies
integral(f,A)=(-(id Z)^(#)cosec).(upper_bound A)-
(-(id Z)^(#)cosec).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=cos.x*sin.(sin.x)/(cos.(sin.x))^2)
& Z c= dom (sec*sin) & Z = dom f & f|A is continuous
implies integral(f,A)=(sec*sin).(upper_bound A)-(sec*sin).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=sin.x*sin.(cos.x)/(cos.(cos.x))^2)
& Z c= dom (sec*cos) & Z = dom f & f|A is continuous
implies integral(f,A)=(-sec*cos).(upper_bound A)-(-sec*cos).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=cos.x*cos.(sin.x)/(sin.(sin.x))^2)
& Z c= dom (cosec*sin) & Z = dom f & f|A is continuous
implies integral(f,A)=(-cosec*sin).(upper_bound A)-(-cosec*sin).(lower_bound A)
;



theorem 
A c= Z & (for x st x in Z holds f.x=sin.x*cos.(cos.x)/(sin.(cos.x))^2)
& Z c= dom (cosec*cos) & Z = dom f & f|A is continuous
implies integral(f,A)=(cosec*cos).(upper_bound A)-(cosec*cos).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=sin.(tan.x)/(cos.x)^2/(cos.(tan.x))^2)
& Z c= dom (sec*tan) & Z = dom f & f|A is continuous
implies integral(f,A)=(sec*tan).(upper_bound A)-(sec*tan).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=sin.(cot.x)/(sin.x)^2/(cos.(cot.x))^2)
& Z c= dom (sec*cot) & Z = dom f & f|A is continuous
implies integral(f,A)=(-sec*cot).(upper_bound A)-(-sec*cot).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=cos.(tan.x)/(cos.x)^2/(sin.(tan.x))^2)
& Z c= dom (cosec*tan) & Z = dom f & f|A is continuous
implies integral(f,A)=(-cosec*tan).(upper_bound A)-(-cosec*tan).(lower_bound A)
;



theorem 
A c= Z & (for x st x in Z holds f.x=cos.(cot.x)/(sin.x)^2/(sin.(cot.x))^2)
& Z c= dom (cosec*cot) & Z = dom f & f|A is continuous
implies integral(f,A)=(cosec*cot).(upper_bound A)-(cosec*cot).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=1/(cos.x)^2/cos.x+tan.x*sin.x/(cos.x)^2)
& Z c= dom (tan(#)sec) & Z = dom f & f|A is continuous
implies integral(f,A)=(tan(#)sec).(upper_bound A)-(tan(#)sec).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=1/(sin.x)^2/cos.x-cot.x*sin.x/(cos.x)^2)
& Z c= dom (cot(#)sec) & Z = dom f & f|A is continuous
implies integral(f,A)=(-cot(#)sec).(upper_bound A)-(-cot(#)sec).(lower_bound A)
;



theorem 
A c= Z & (for x st x in Z holds f.x=1/(cos.x)^2/sin.x-tan.x*cos.x/(sin.x)^2)
& Z c= dom (tan(#)cosec) & Z = dom f & f|A is continuous
implies integral(f,A)=(tan(#)cosec).(upper_bound A)-
(tan(#)cosec).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=1/(sin.x)^2/sin.x+cot.x*cos.x/(sin.x)^2)
& Z c= dom (cot(#)cosec) & Z = dom f & f|A is continuous
implies integral(f,A)=(-cot(#)cosec).(upper_bound A)-
(-cot(#)cosec).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=1/(cos.(cot.x))^2*(1/(sin.x)^2))
& Z c= dom (tan*cot) & Z = dom f & f|A is continuous
implies integral(f,A)=(-tan*cot).(upper_bound A)-(-tan*cot).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=1/(cos.(tan.x))^2 *(1/(cos.x)^2))
& Z c= dom (tan*tan) & Z = dom f & f|A is continuous
implies integral(f,A)=(tan*tan).(upper_bound A)-(tan*tan).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=(1/(sin.(cot.x))^2) *(1/(sin.x)^2))
& Z c= dom (cot*cot) & Z = dom f & f|A is continuous
implies integral(f,A)=(cot*cot).(upper_bound A)-(cot*cot).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=(1/(sin.(tan.x))^2)*(1/(cos.x)^2))
& Z c= dom (cot*tan) & Z = dom f & f|A is continuous
implies integral(f,A)=(-cot*tan).(upper_bound A)-(-cot*tan).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=1/(cos.x)^2+1/(sin.x)^2)
& Z c= dom (tan-cot) & Z = dom f & f|A is continuous
implies integral(f,A)=(tan-cot).(upper_bound A)-(tan-cot).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=1/(cos.x)^2-1/(sin.x)^2)
& Z c= dom (tan+cot) & Z = dom f & f|A is continuous
implies integral(f,A)=(tan+cot).(upper_bound A)-(tan+cot).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=cos.(sin.x)*cos.x)
 & Z = dom f & f|A is continuous
implies integral(f,A)=(sin*sin).(upper_bound A)-(sin*sin).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=cos.(cos.x)*sin.x)
 & Z = dom f & f|A is continuous
implies integral(f,A)=(-sin*cos).(upper_bound A)-(-sin*cos).(lower_bound A);



theorem 
  A c= Z & (for x st x in Z holds f.x=sin.(sin.x)*cos.x) &
  Z = dom f & f|A is continuous
  implies integral(f,A)=(-cos*sin).(upper_bound A)-(-cos*sin).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=sin.(cos.x)*sin.x)
 & Z = dom f & f|A is continuous
implies integral(f,A)=(cos*cos).(upper_bound A)-(cos*cos).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=cos.x+cos.x/(sin.x)^2)
& Z c= dom (cos (#) cot) & Z = dom f & f|A is continuous
implies integral(f,A)=(-cos (#) cot).(upper_bound A)-
(-cos (#) cot).(lower_bound A);



theorem 
A c= Z & (for x st x in Z holds f.x=sin.x + sin.x/(cos.x)^2)
& Z c= dom (sin (#) tan) & Z = dom f & f|A is continuous
implies integral(f,A)=(sin (#) tan).(upper_bound A)-
(sin (#) tan).(lower_bound A);














begin 

reserve X for non empty set,
        x for Element of X,
        S for SigmaField of X,
        M for sigma_Measure of S,

        f,g,f1,g1 for PartFunc of X,REAL,
        l,m,n,n1,n2 for Element of NAT,
        a,b,c for Real;

theorem 
for m,n be positive real number st 1/m + 1/n = 1 holds m > 1;

theorem 
for X be non empty set, S be SigmaField of X, M be sigma_Measure of S,
A be Element of S, f be PartFunc of X,ExtREAL st
  A = dom f & f is_measurable_on A & f is nonnegative holds
   Integral(M,f) in REAL iff f is_integrable_on M;

definition
  let r be real number;
  attr r is geq_than_1 means

  1 <= r;
end;

registration
  cluster geq_than_1 -> positive for real number;
end;

registration
  cluster geq_than_1 for Real;
end;

reserve k for positive Real;

theorem 
for a,b,p be Real st 0 < p & 0 <= a & a < b holds a to_power p < b to_power p;

theorem 
a >= 0 & b > 0 implies a to_power b >= 0;

theorem 
a >= 0 & b >= 0 & c > 0 implies (a*b) to_power c = a to_power c * b to_power c;

theorem 
for a,b be Real, f st f is nonnegative & a > 0 & b > 0 holds
  (f to_power a) to_power b = f to_power (a*b);

theorem 
for a,b be Real, f st f is nonnegative & a > 0 & b > 0 holds
  (f to_power a)(#)(f to_power b) = f to_power (a+b);

theorem 
f to_power 1 = f;

theorem 
for seq1,seq2 be Real_Sequence, k be positive Real st
  for n be Element of NAT holds seq1.n = (seq2.n) to_power k & seq2.n >= 0
holds (seq1 is convergent iff seq2 is convergent);

theorem 
for seq be Real_Sequence, n,m be Element of NAT st m <= n holds
  abs( (Partial_Sums seq).n - (Partial_Sums seq).m )
   <= (Partial_Sums abs seq).n - (Partial_Sums abs seq).m &
  abs( (Partial_Sums seq).n - (Partial_Sums seq).m )
   <= (Partial_Sums abs seq).n;

theorem 
for seq,seq2 be Real_Sequence, k be positive Real st seq is convergent &
  for n be Element of NAT holds
    seq2.n = ( |. lim seq -seq.n .|) to_power k
holds seq2 is convergent & lim seq2 = 0;

begin 

theorem 
for k be positive Real, X be non empty set holds (X -->0) to_power k = X --> 0;

theorem 
for f be PartFunc of X,REAL, D be set holds abs(f|D) = (abs f)|D;

registration
  let X; let f be PartFunc of X,REAL;
  cluster abs f -> nonnegative;
end;

theorem 
for f be PartFunc of X,REAL st f is nonnegative holds abs f = f;

theorem 
(X = dom f & for x st x in dom f holds 0 = f.x) implies
  f is_integrable_on M & Integral(M,f) =0;

definition
  let X be non empty set, S be SigmaField of X, M be sigma_Measure of S,
  k be positive Real;
func Lp_Functions(M,k) -> non empty Subset of RLSp_PFunct X equals

  {f where f is PartFunc of X,REAL :
     ex Ef be Element of S st M.(Ef`)=0 & dom f = Ef &
       f is_measurable_on Ef & (abs f) to_power k is_integrable_on M};
end;

theorem 
for a,b,k be Real st k > 0 holds
 abs(a+b) to_power k <= (abs a + abs b) to_power k &
 (abs a + abs b) to_power k <= (2 * max(abs a,abs b)) to_power k &
 abs(a+b) to_power k <= (2*max(abs a,abs b)) to_power k;

theorem 
for a, b, k be Real st a >= 0 & b >= 0 & k > 0 holds
  max(a,b) to_power k <= a to_power k + b to_power k;

theorem 
for f be PartFunc of X,REAL, a,b be Real st b > 0 holds
((abs a) to_power b)(#)((abs f) to_power b) = (abs(a(#)f)) to_power b;

theorem 
for f be PartFunc of X,REAL, a,b be Real st a > 0 & b > 0 holds
(a to_power b)(#)((abs f) to_power b) = (a(#)(abs f)) to_power b;

theorem 
for f be PartFunc of X,REAL, k be real number, E be set holds
  (f|E) to_power k = (f to_power k)|E;

theorem 
for a,b,k be Real st k > 0 holds (abs(a+b)) to_power k
    <= (2 to_power k)*((abs a) to_power k + (abs b) to_power k);

theorem 
for k be positive Real, f,g be PartFunc of X,REAL st
  f in Lp_Functions(M,k) & g in Lp_Functions (M,k) holds
    (abs f) to_power k is_integrable_on M &
    (abs g) to_power k is_integrable_on M &
    (abs f) to_power k + (abs g) to_power k is_integrable_on M;

theorem 
X --> 0 is PartFunc of X,REAL & X --> 0 in Lp_Functions(M,k);

theorem 
for k be Real st k > 0 for f,g be PartFunc of X,REAL holds
  for x be Element of X st x in dom f /\ dom g holds
   (abs(f + g) to_power k).x <=
    ((2 to_power k)(#)((abs f) to_power k + (abs g) to_power k)).x;

theorem 
f in Lp_Functions(M,k) & g in Lp_Functions(M,k) implies
  f + g in Lp_Functions(M,k);

theorem 
f in Lp_Functions(M,k) implies a(#)f in Lp_Functions(M,k);

theorem 
f in Lp_Functions(M,k) & g in Lp_Functions(M,k) implies
  f - g in Lp_Functions(M,k);

theorem 
f in Lp_Functions(M,k) implies abs f in Lp_Functions(M,k);

registration
  let X be non empty set, S be SigmaField of X,
      M be sigma_Measure of S, k be positive Real;
  cluster Lp_Functions(M,k) -> multi-closed add-closed;
end;

registration
  let X be non empty set, S be SigmaField of X,
      M be sigma_Measure of S, k be positive Real;
  cluster RLSStruct (# Lp_Functions(M,k),
                     In(0.(RLSp_PFunct X),Lp_Functions(M,k)),
                     add|(Lp_Functions(M,k),RLSp_PFunct X),
                     Mult_(Lp_Functions(M,k)) #)
   -> Abelian add-associative right_zeroed vector-distributive
   scalar-distributive scalar-associative scalar-unital;
end;

definition
  let X be non empty set, S be SigmaField of X,
      M be sigma_Measure of S, k be positive Real;
  func RLSp_LpFunct(M,k) -> strict Abelian add-associative right_zeroed
        vector-distributive scalar-distributive scalar-associative
        scalar-unital non empty RLSStruct equals

  RLSStruct (# Lp_Functions(M,k),
               In(0.(RLSp_PFunct X),Lp_Functions(M,k)),
               add|(Lp_Functions(M,k),RLSp_PFunct X),
               Mult_(Lp_Functions(M,k)) #);
end;

begin 

reserve v,u for VECTOR of RLSp_LpFunct(M,k);

theorem 
f = v & g = u implies f+g = v+u;

theorem 
f = u implies a(#)f = a*u;

theorem 
f=u implies u + (-1)*u = (X --> 0)|dom f & ex v,g be PartFunc of X,REAL st
    v in Lp_Functions(M,k) & g in Lp_Functions(M,k) &
    v = u + (-1)*u & g = X --> 0 & v a.e.= g,M;

definition
  let X be non empty set, S be SigmaField of X,
      M be sigma_Measure of S, k be positive Real;
  func AlmostZeroLpFunctions(M,k) ->
      non empty Subset of RLSp_LpFunct(M,k) equals

        { f where f is PartFunc of X,REAL :
            f in Lp_Functions(M,k) & f a.e.= X-->0,M };
end;

registration
  let X be non empty set, S be SigmaField of X,
      M be sigma_Measure of S, k be positive Real;
  cluster AlmostZeroLpFunctions(M,k) -> add-closed multi-closed;
end;

theorem 
0.(RLSp_LpFunct(M,k)) = X-->0 &
0.(RLSp_LpFunct(M,k)) in AlmostZeroLpFunctions(M,k);

definition
  let X be non empty set, S be SigmaField of X,
      M be sigma_Measure of S, k be positive Real;
  func RLSp_AlmostZeroLpFunct(M,k) -> non empty RLSStruct equals

   RLSStruct (# AlmostZeroLpFunctions(M,k),
                In(0.(RLSp_LpFunct(M,k)),AlmostZeroLpFunctions(M,k)),
                add|(AlmostZeroLpFunctions(M,k),RLSp_LpFunct(M,k)),
                Mult_(AlmostZeroLpFunctions(M,k)) #);
end;

registration
  let X be non empty set, S be SigmaField of X,
      M be sigma_Measure of S, k be positive Real;
  cluster RLSp_LpFunct(M,k) ->
    strict Abelian add-associative right_zeroed vector-distributive
    scalar-distributive scalar-associative scalar-unital;
end;

reserve v,u for VECTOR of RLSp_AlmostZeroLpFunct(M,k);

theorem 
f=v & g=u implies f+g=v+u;

theorem 
f=u implies a(#)f=a*u;

definition
  let X be non empty set, S be SigmaField of X, M be sigma_Measure of S,
      f be PartFunc of X,REAL, k be positive Real;
  func a.e-eq-class_Lp(f,M,k) -> Subset of Lp_Functions(M,k) equals

  {h where h is PartFunc of X,REAL : h in Lp_Functions(M,k) & f a.e.= h,M};
end;

theorem 
f in Lp_Functions(M,k) implies
 ex E be Element of S st M.(E`) = 0 & dom f = E & f is_measurable_on E;

theorem 
g in Lp_Functions(M,k) & g a.e.= f,M implies g in a.e-eq-class_Lp(f,M,k);

theorem 
(ex E be Element of S st M.(E`)=0 & E = dom f & f is_measurable_on E) &
g in a.e-eq-class_Lp(f,M,k) implies
  g a.e.= f,M & f in Lp_Functions(M,k);

theorem 
f in Lp_Functions(M,k) implies f in a.e-eq-class_Lp(f,M,k);

theorem 
(ex E be Element of S st M.(E`)=0 & E = dom g & g is_measurable_on E) &
a.e-eq-class_Lp(f,M,k) <> {} &
a.e-eq-class_Lp(f,M,k) = a.e-eq-class_Lp(g,M,k) implies
  f a.e.= g,M;

theorem 
f in Lp_Functions(M,k) &
(ex E be Element of S st M.(E`)=0 & E = dom g & g is_measurable_on E) &
a.e-eq-class_Lp(f,M,k) = a.e-eq-class_Lp(g,M,k)
  implies f a.e.= g,M;

theorem 
f a.e.= g,M implies a.e-eq-class_Lp(f,M,k) = a.e-eq-class_Lp(g,M,k);

theorem 
f a.e.= g,M implies a.e-eq-class_Lp(f,M,k) = a.e-eq-class_Lp(g,M,k);

theorem 
f in Lp_Functions (M,k) & g in a.e-eq-class_Lp(f,M,k) implies
  a.e-eq-class_Lp(f,M,k) = a.e-eq-class_Lp(g,M,k);

theorem 
(ex E be Element of S st M.(E`)=0 & E = dom f & f is_measurable_on E) &
(ex E be Element of S st M.(E`)=0 & E = dom f1 & f1 is_measurable_on E) &
(ex E be Element of S st M.(E`)=0 & E = dom g & g is_measurable_on E) &
(ex E be Element of S st M.(E`)=0 & E = dom g1 & g1 is_measurable_on E) &
a.e-eq-class_Lp(f,M,k) is non empty &
a.e-eq-class_Lp(g,M,k) is non empty &
a.e-eq-class_Lp(f,M,k) = a.e-eq-class_Lp(f1,M,k) &
a.e-eq-class_Lp(g,M,k) = a.e-eq-class_Lp(g1,M,k)
implies a.e-eq-class_Lp(f+g,M,k) = a.e-eq-class_Lp(f1+g1,M,k);

theorem 
f in Lp_Functions(M,k) & f1 in Lp_Functions(M,k) &
g in Lp_Functions(M,k) & g1 in Lp_Functions(M,k) &
a.e-eq-class_Lp(f,M,k) = a.e-eq-class_Lp(f1,M,k) &
a.e-eq-class_Lp(g,M,k) = a.e-eq-class_Lp(g1,M,k)
  implies a.e-eq-class_Lp(f+g,M,k) = a.e-eq-class_Lp(f1+g1,M,k);

theorem 
(ex E be Element of S st M.(E`) = 0 & dom f = E & f is_measurable_on E) &
(ex E be Element of S st M.(E`) = 0 & dom g = E & g is_measurable_on E) &
a.e-eq-class_Lp(f,M,k) is non empty &
a.e-eq-class_Lp(f,M,k) = a.e-eq-class_Lp(g,M,k) implies
  a.e-eq-class_Lp(a(#)f,M,k) = a.e-eq-class_Lp(a(#)g,M,k);

theorem 
f in Lp_Functions(M,k) & g in Lp_Functions(M,k) &
a.e-eq-class_Lp(f,M,k) = a.e-eq-class_Lp(g,M,k) implies
  a.e-eq-class_Lp(a(#)f,M,k) = a.e-eq-class_Lp(a(#)g,M,k);

definition let X be non empty set, S be SigmaField of X,
               M be sigma_Measure of S, k be positive Real;
func CosetSet(M,k) -> non empty Subset-Family of Lp_Functions(M,k) equals

    {a.e-eq-class_Lp(f,M,k) where f is PartFunc of X,REAL :
      f in Lp_Functions(M,k)};
end;

definition
  let X be non empty set, S be SigmaField of X, M be sigma_Measure of S,
  k be positive Real;
  func addCoset(M,k) -> BinOp of CosetSet(M,k) means

    for A,B be Element of CosetSet(M,k), a,b be PartFunc of X,REAL st
      a in A & b in B holds it.(A,B) = a.e-eq-class_Lp(a+b,M,k);
end;

definition let X be non empty set, S be SigmaField of X,
               M be sigma_Measure of S, k be positive Real;
func zeroCoset(M,k) -> Element of CosetSet(M,k) equals

      a.e-eq-class_Lp(X-->0,M,k);
end;

definition let X be non empty set, S be SigmaField of X,
               M be sigma_Measure of S, k be positive Real;
func lmultCoset(M,k) -> Function of [:REAL,CosetSet(M,k):],CosetSet(M,k) means


  for z be Element of REAL, A be Element of CosetSet(M,k),
      f be PartFunc of X,REAL st
   f in A holds it.(z,A) = a.e-eq-class_Lp(z(#)f,M,k);
end;

definition let X be non empty set, S be SigmaField of X,
               M be sigma_Measure of S, k be positive Real;
 func Pre-Lp-Space(M,k) -> strict RLSStruct means

  the carrier of it = CosetSet(M,k) & the addF of it = addCoset(M,k) &
  0.it = zeroCoset(M,k) &
  the Mult of it = lmultCoset(M,k);
end;

registration let X be non empty set, S be SigmaField of X,
               M be sigma_Measure of S, k be positive Real;
  cluster Pre-Lp-Space(M,k) -> non empty;
end;

registration let X be non empty set, S be SigmaField of X,
               M be sigma_Measure of S, k be positive Real;
  cluster Pre-Lp-Space(M,k) -> Abelian add-associative right_zeroed
   right_complementable vector-distributive scalar-distributive
   scalar-associative scalar-unital;
end;

begin 

theorem 
f in Lp_Functions(M,k) & g in Lp_Functions(M,k) & f a.e.= g,M implies
  Integral(M,(abs f) to_power k) = Integral(M,(abs g) to_power k);

theorem 
f in Lp_Functions(M,k) implies
  Integral(M,(abs f) to_power k) in REAL & 0 <= Integral(M,(abs f) to_power k);

theorem 
(ex x be VECTOR of Pre-Lp-Space(M,k) st f in x & g in x) implies
  f a.e.= g,M & f in Lp_Functions(M,k) & g in Lp_Functions(M,k);

reserve x for Point of Pre-Lp-Space(M,k);

theorem 
f in x implies (abs f) to_power k is_integrable_on M & f in Lp_Functions(M,k);

theorem 
f in x & g in x implies f a.e.= g,M &
  Integral(M,(abs f) to_power k) = Integral(M,(abs g) to_power k);

definition let X be non empty set, S be SigmaField of X,
               M be sigma_Measure of S, k be positive Real;
 func Lp-Norm(M,k) -> Function of the carrier of Pre-Lp-Space (M,k),REAL means


  for x be Point of Pre-Lp-Space(M,k) ex f be PartFunc of X,REAL st f in x &
      ex r be Real st
        r = Integral(M,(abs f) to_power k) & it.x = r to_power (1/k);
end;

definition let X be non empty set, S be SigmaField of X,
               M be sigma_Measure of S, k be positive Real;
 func Lp-Space(M,k) -> non empty NORMSTR equals

    NORMSTR (# the carrier of Pre-Lp-Space(M,k),
               the ZeroF of Pre-Lp-Space(M,k),
               the addF of Pre-Lp-Space(M,k),
               the Mult of Pre-Lp-Space(M,k),
               Lp-Norm(M,k) #);
end;

reserve x,y for Point of Lp-Space(M,k);

theorem 
(ex f be PartFunc of X,REAL st
   f in Lp_Functions(M,k) & x= a.e-eq-class_Lp(f,M,k)) &
for f be PartFunc of X,REAL st f in x holds
  ex r be Real st
    0<=r & r = Integral(M,(abs f) to_power k) & ||.x.|| =r to_power (1/k);

theorem 
(f in x & g in y implies f+g in x+y) & (f in x implies a(#)f in a*x);

theorem 
f in x implies x= a.e-eq-class_Lp(f,M,k) & ( ex r be Real st
     0 <=r & r = Integral(M,(abs f) to_power k) & ||.x.|| = r to_power (1/k) );

theorem 
X --> 0 in L1_Functions M;

theorem 
f in Lp_Functions(M,k) & Integral(M,(abs f) to_power k) = 0 implies
   f a.e.= X-->0,M;

theorem 
Integral(M,(abs(X-->0)) to_power k) = 0;



theorem 
for m,n be positive Real st
  1/m +1/n =1 & f in Lp_Functions(M,m) & g in Lp_Functions(M,n) holds
    f(#)g in L1_Functions M & f(#)g is_integrable_on M;



theorem 
for m,n be positive Real st 1/m +1/n =1 &
f in Lp_Functions(M,m) & g in Lp_Functions(M,n) holds
ex r1 be Real st r1 = Integral(M,(abs f) to_power m) &
ex r2 be Real st r2 = Integral(M,(abs g) to_power n) &
Integral(M,abs(f(#)g)) <= r1 to_power (1/m) * r2 to_power (1/n);



theorem 
for m be positive Real for r1,r2,r3 be Element of REAL st 1 <= m &
 f in Lp_Functions(M,m) & g in Lp_Functions(M,m) &
 r1 = Integral(M,(abs f) to_power m) &
 r2 = Integral(M,(abs g) to_power m) &
 r3 = Integral(M,(abs (f+g)) to_power m) holds
 r3 to_power (1/m) <= r1 to_power (1/m) + r2 to_power (1/m);

registration
  let k be geq_than_1 Real;
  let X be non empty set, S be SigmaField of X, M be sigma_Measure of S;
  cluster Lp-Space (M,k) -> reflexive discerning RealNormSpace-like
  vector-distributive scalar-distributive scalar-associative scalar-unital
      Abelian add-associative right_zeroed right_complementable;
end;

begin 

theorem 
for Sq be sequence of Lp-Space(M,k) holds
 ex Fsq be Functional_Sequence of X,REAL st
  for n be Element of NAT holds
    Fsq.n in Lp_Functions(M,k) & Fsq.n in Sq.n &
    Sq.n= a.e-eq-class_Lp(Fsq.n,M,k) &
    ex r be Real st
     r = Integral(M,(abs (Fsq.n)) to_power k) &
     ||. Sq.n .|| = r to_power (1/k);

theorem 
for Sq be sequence of Lp-Space(M,k) holds
 ex Fsq be with_the_same_dom Functional_Sequence of X,REAL st
  for n be Element of NAT holds
    Fsq.n in Lp_Functions(M,k) & Fsq.n in Sq.n &
    Sq.n= a.e-eq-class_Lp(Fsq.n,M,k) &
    ex r be Real st 0 <= r &
      r = Integral(M,(abs (Fsq.n)) to_power k) &
      ||. Sq.n .|| =r to_power (1/k);

theorem 
for X be RealNormSpace, Sq be sequence of X, Sq0 be Point of X st
 ||.Sq -Sq0.|| is convergent & lim ||.Sq -Sq0.|| =0
holds Sq is convergent & lim Sq = Sq0;

theorem 
for X be RealNormSpace, Sq be sequence of X st
 Sq is Cauchy_sequence_by_Norm holds
  ex N be increasing sequence of NAT st
   for i,j be Element of NAT st j >= N.i holds
    ||. Sq.j - Sq.(N.i) .|| < 2 to_power (-i);

theorem 
for F be Functional_Sequence of X,REAL st
 (for m be Nat holds F.m in Lp_Functions(M,k))
 holds
  for m be Nat holds (Partial_Sums F).m in Lp_Functions(M,k);

theorem 
for F be Functional_Sequence of X,REAL st
 (for m be Nat holds F.m is nonnegative)
holds
 for m be Nat holds (Partial_Sums F).m is nonnegative;

theorem 
for F be Functional_Sequence of X,REAL, x be Element of X, n,m be Nat st
 F is with_the_same_dom & x in dom(F.0) &
(for k be Nat holds F.k is nonnegative) & n <= m holds
   ((Partial_Sums F).n).x <= ((Partial_Sums F).m).x;

theorem 
for F be Functional_Sequence of X,REAL st
  F is with_the_same_dom holds (abs F) is with_the_same_dom;

theorem 
for k be geq_than_1 Real, Sq be sequence of Lp-Space(M,k) st
  Sq is Cauchy_sequence_by_Norm holds Sq is convergent;

registration let X,S,M;
  let k be geq_than_1 Real;
  cluster Lp-Space (M,k) -> complete;
end;

begin

theorem 
for X be non empty set, S be SigmaField of X,
 M be sigma_Measure of S holds CosetSet M = CosetSet(M,1);

theorem 
for X be non empty set, S be SigmaField of X,
 M be sigma_Measure of S holds addCoset M = addCoset(M,1);

theorem 
for X be non empty set, S be SigmaField of X,
 M be sigma_Measure of S holds zeroCoset M = zeroCoset(M,1);

theorem 
for X be non empty set, S be SigmaField of X,
 M be sigma_Measure of S holds lmultCoset M = lmultCoset(M,1);

theorem 
for X be non empty set, S be SigmaField of X, M be sigma_Measure of S holds
  Pre-L-Space M = Pre-Lp-Space(M,1);

theorem 
for X be non empty set, S be SigmaField of X, M be sigma_Measure of S holds
 L-1-Norm M = Lp-Norm(M,1);

theorem 
for X be non empty set, S be SigmaField of X, M be sigma_Measure of S holds
  L-1-Space M = Lp-Space(M,1);














begin 

reserve
  n, m for Nat,
  T for non empty TopSpace,
  M, M1, M2 for non empty MetrSpace;

theorem 
  for A, B, S, T being TopSpace,
      f being Function of A,S, g being Function of B,T st
  the TopStruct of A = the TopStruct of B &
  the TopStruct of S = the TopStruct of T &
  f = g & f is open holds g is open;

theorem 
  for P being Subset of TOP-REAL m holds P is open iff
  for p being Point of TOP-REAL m st p in P
  ex r being positive real number st Ball(p,r) c= P;

theorem 
  for X, Y being non empty TopSpace, f being Function of X,Y
  holds f is open iff for p being Point of X, V being open Subset of X
  st p in V
  ex W being open Subset of Y st f.p in W & W c= f.:V;

theorem 
  for f being Function of T,TopSpaceMetr(M) holds f is open iff
  for p being Point of T, V being open Subset of T,
      q being Point of M st q = f.p & p in V
  ex r being positive real number st Ball(q,r) c= f.:V;

theorem 
  for f being Function of TopSpaceMetr(M),T holds f is open iff
  for p being Point of M, r being positive real number
  ex W being open Subset of T st f.p in W & W c= f.:Ball(p,r);

theorem 
  for f being Function of TopSpaceMetr(M1),TopSpaceMetr(M2) holds f is open iff
  for p being Point of M1, q being Point of M2, r being positive real number
  st q = f.p
  ex s being positive real number st Ball(q,s) c= f.:Ball(p,r);

theorem 
  for f being Function of T,TOP-REAL m holds f is open iff
  for p being Point of T, V being open Subset of T st p in V
  ex r being positive real number st Ball(f.p,r) c= f.:V;

theorem 
  for f being Function of TOP-REAL m,T holds f is open iff
  for p being Point of TOP-REAL m, r being positive real number
  ex W being open Subset of T st f.p in W & W c= f.:Ball(p,r);

theorem 
  for f being Function of TOP-REAL m,TOP-REAL n holds f is open iff
  for p being Point of TOP-REAL m, r being positive real number
  ex s being positive real number st Ball(f.p,s) c= f.:Ball(p,r);

theorem 
  for f being Function of T,R^1 holds f is open iff
  for p being Point of T, V being open Subset of T st p in V
  ex r being positive real number st ].f.p-r,f.p+r.[ c= f.:V;

theorem 
  for f being Function of R^1,T holds f is open iff
  for p being Point of R^1, r being positive real number
  ex V being open Subset of T st f.p in V & V c= f.:].p-r,p+r.[;

theorem 
  for f being Function of R^1,R^1 holds f is open iff
  for p being Point of R^1, r being positive real number
  ex s being positive real number st ].f.p-s,f.p+s.[ c= f.:].p-r,p+r.[;

theorem 
  for f being Function of TOP-REAL m,R^1 holds f is open iff
  for p being Point of TOP-REAL m, r being positive real number
  ex s being positive real number st ].f.p-s,f.p+s.[ c= f.:Ball(p,r);

theorem 
  for f being Function of R^1,TOP-REAL m holds f is open iff
  for p being Point of R^1, r being positive real number
  ex s being positive real number st Ball(f.p,s) c= f.:].p-r,p+r.[;

begin 

theorem 
  for f being Function of T,TopSpaceMetr(M) holds f is continuous iff
  for p being Point of T, q being Point of M, r being positive real number
      st q = f.p
  ex W being open Subset of T st p in W & f.:W c= Ball(q,r);

theorem 
  for f being Function of TopSpaceMetr(M),T holds f is continuous iff
  for p being Point of M, V being open Subset of T st f.p in V
  ex s being positive real number st f.:Ball(p,s) c= V;

theorem 
  for f being Function of TopSpaceMetr(M1),TopSpaceMetr(M2) holds
  f is continuous iff
  for p being Point of M1, q being Point of M2, r being positive real number
      st q = f.p
  ex s being positive real number st f.:Ball(p,s) c= Ball(q,r);

theorem 
  for f being Function of T,TOP-REAL m holds f is continuous iff
  for p being Point of T, r being positive real number
  ex W being open Subset of T st p in W & f.:W c= Ball(f.p,r);

theorem 
  for f being Function of TOP-REAL m,T holds f is continuous iff
  for p being Point of TOP-REAL m, V being open Subset of T st f.p in V
  ex s being positive real number st f.:Ball(p,s) c= V;

theorem 
  for f being Function of TOP-REAL m, TOP-REAL n holds f is continuous iff
  for p being Point of TOP-REAL m, r being positive real number
  ex s being positive real number st f.:Ball(p,s) c= Ball(f.p,r);

theorem 
  for f being Function of T,R^1 holds f is continuous iff
  for p being Point of T, r being positive real number
  ex W being open Subset of T st p in W & f.:W c= ].f.p-r,f.p+r.[;

theorem 
  for f being Function of R^1,T holds f is continuous iff
  for p being Point of R^1, V being open Subset of T st f.p in V
  ex s being positive real number st f.:].p-s,p+s.[ c= V;

theorem 
  for f being Function of R^1,R^1 holds f is continuous iff
  for p being Point of R^1, r being positive real number
  ex s being positive real number st f.:].p-s,p+s.[ c= ].f.p-r,f.p+r.[;

theorem 
  for f being Function of TOP-REAL m,R^1 holds f is continuous iff
  for p being Point of TOP-REAL m, r being positive real number
  ex s being positive real number st f.:Ball(p,s) c= ].f.p-r,f.p+r.[;

theorem 
  for f being Function of R^1,TOP-REAL m holds f is continuous iff
  for p being Point of R^1, r being positive real number
  ex s being positive real number st f.:].p-s,p+s.[ c= Ball(f.p,r);














begin 

reserve
  x, X for set,
  i, n, m for Nat,
  r, s for real number,
  c, c1, c2, d for complex number,
  f, g for complex-valued Function,
  g1 for n-element complex-valued FinSequence,
  f1 for n-element real-valued FinSequence,
  T for non empty TopSpace,
  p for Element of TOP-REAL n;

theorem 
  for X being trivial set, Y being set st X,Y are_equipotent holds Y is trivial
;

registration
  let r be real number;
  cluster r^2 -> non negative;
end;

registration
  let r be positive real number;
  cluster r^2 -> positive;
end;

registration
  cluster sqrt(0) -> zero;
end;

registration
  let f be empty set;
  cluster sqr(f) -> empty;
  cluster |.f.| -> zero;
end;

theorem 
  f(#)(c1+c2) = f(#)c1 + f(#)c2;

theorem 
  f(#)(c1-c2) = f(#)c1 - f(#)c2;

theorem 
  f(/)c + g(/)c = (f+g)(/)c;

theorem 
  f(/)c - g(/)c = (f-g)(/)c;

theorem 
  c1 <> 0 & c2 <> 0 implies f(/)c1 - g(/)c2 = (f(#)c2-g(#)c1) (/) (c1*c2);

theorem 
  c <> 0 implies f(/)c - g = (f-c(#)g) (/) c;

theorem 
  (c-d)(#)f = c(#)f - d(#)f;

theorem 
  (f-g)^2 = (g-f)^2;

theorem 
  (f(/)c)^2 = f^2 (/) c^2;

theorem 
  |. (n|->r) - (n|->s) .| = sqrt(n) * abs(r-s);

registration
  let f,x,c;
  cluster f+*(x,c) -> complex-valued;
end;

theorem 
  ((0*n)+*(x,c))^2 = (0*n)+*(x,c^2);

theorem 
  x in Seg n implies |.(0*n)+*(x,r).| = abs(r);

theorem 
  (0.REAL n)+*(x,0) = 0.REAL n;

theorem 
  mlt(f1,(0.REAL n)+*(x,r)) = (0.REAL n)+*(x,f1.x*r);

theorem 
  |(f1,(0.REAL n)+*(x,r))| = f1.x * r;

theorem 
  (g1+*(i,c)) - g1 = (0*n)+*(i,c-(g1.i));

theorem 
  |.<*r*>.| = abs(r);

theorem 
  for f being real-valued FinSequence holds f is FinSequence of REAL;

theorem 
  for f being real-valued FinSequence st |.f.| <> 0
  ex i being Nat st i in dom f & f.i <> 0;

theorem 
  for f being real-valued FinSequence holds abs Sum f <= Sum abs f;

theorem 
  for A being non empty 1-sorted, B being 1-element 1-sorted
  for t being Point of B
  for f being Function of A,B holds f = A --> t;

registration
  let n be non zero Nat, i be Element of Seg n;
  let T be real-membered non empty TopSpace;
  cluster proj(Seg n --> T,i) -> real-valued;
end;

definition
  let n; let p be Element of REAL n; let r;
  redefine func p(/)r -> Element of REAL n;
end;

theorem 
  for p, q being Point of TOP-REAL m holds p in Ball(q,r) iff -p in Ball(-q,r);

definition
  let S be 1-sorted;
  attr S is complex-functions-membered means


  the carrier of S is complex-functions-membered;
  attr S is real-functions-membered means


  the carrier of S is real-functions-membered;
end;

registration
  let n;
  cluster TOP-REAL n -> real-functions-membered;
end;

registration
  cluster TOP-REAL 0 -> real-membered;
end;

registration
  cluster TOP-REAL 0 -> trivial;
end;

registration
  cluster real-functions-membered -> complex-functions-membered for 1-sorted;
end;

registration
  cluster strict non empty real-functions-membered for 1-sorted;
end;

registration
  let S be complex-functions-membered 1-sorted;
  cluster the carrier of S -> complex-functions-membered;
end;

registration
  let S be real-functions-membered 1-sorted;
  cluster the carrier of S -> real-functions-membered;
end;

registration
  cluster strict non empty real-functions-membered for TopSpace;
end;

registration
  let S be complex-functions-membered TopSpace;
  cluster -> complex-functions-membered for SubSpace of S;
end;

registration
  let S be real-functions-membered TopSpace;
  cluster -> real-functions-membered for SubSpace of S;
end;

definition
  let X be complex-functions-membered set;
  func (-)X -> complex-functions-membered set means


  for f being complex-valued Function holds -f in it iff f in X;
  involutiveness;
end;

registration
  let X be empty set;
  cluster (-)X -> empty;
end;

registration
  let X be non empty complex-functions-membered set;
  cluster (-)X -> non empty;
end;

theorem 
  for X being complex-functions-membered set,
      f being complex-valued Function holds
  -f in X iff f in (-)X;

registration
  let X be real-functions-membered set;
  cluster (-)X -> real-functions-membered;
end;

theorem 
  for X being Subset of TOP-REAL n holds -X = (-)X;

definition
  let n;
  let X be Subset of TOP-REAL n;
  redefine func (-)X -> Subset of TOP-REAL n;
end;

registration
  let n;
  let X be open Subset of TOP-REAL n;
  cluster (-)X -> open for Subset of TOP-REAL n;
end;

definition
  let n, p, x;
  redefine func p.x -> Element of REAL;
end;

definition
  let R,S,T be non empty TopSpace, f be Function of [:R,S:],T;
  let x be Point of [:R,S:];
  redefine func f.x -> Point of T;
end;

definition
  let R,S,T be non empty TopSpace, f be Function of [:R,S:],T;
  let r be Point of R, s be Point of S;
  redefine func f.(r,s) -> Point of T;
end;

definition
  let n, p, r;
  redefine func p + r -> Point of TOP-REAL n;
end;

definition
  let n, p, r;
  redefine func p - r -> Point of TOP-REAL n;
end;

definition
  let n, p, r;
  redefine func p (#) r -> Point of TOP-REAL n;
end;

definition
  let n, p, r;
  redefine func p (/) r -> Point of TOP-REAL n;
end;

definition
  let n; let p1, p2 be Point of TOP-REAL n;
  redefine func p1 (#) p2 -> Point of TOP-REAL n;
  commutativity;
end;

definition
  let n; let p be Point of TOP-REAL n;
  redefine func sqr p -> Point of TOP-REAL n;
end;

definition
  let n; let p1, p2 be Point of TOP-REAL n;
  redefine func p1 /" p2 -> Point of TOP-REAL n;
end;

definition
  let n, p, x, r;
  redefine func p+*(x,r) -> Point of TOP-REAL n;
end;

theorem 
  for a, o being Point of TOP-REAL n holds
  n <> 0 & a in Ball(o,r) implies abs Sum(a-o) < n*r;

registration
  let n;
  cluster Euclid n -> real-functions-membered;
end;

theorem 
  for V being add-associative right_zeroed
  right_complementable non empty addLoopStr, v,u being Element of V
  holds v + u - u = v;

theorem 
  for V being Abelian add-associative right_zeroed
  right_complementable non empty addLoopStr, v,u being Element of V
  holds v - u + u = v;

theorem 
  for Y being complex-functions-membered set, f being PartFunc of X,Y holds
  f[+]c = f<+>(dom f-->c);

theorem 
  for Y being complex-functions-membered set, f being PartFunc of X,Y holds
  f[-]c = f<->(dom f-->c);

theorem 
  for Y being complex-functions-membered set, f being PartFunc of X,Y holds
  f[#]c = f<#>(dom f-->c);

theorem 
  for Y being complex-functions-membered set, f being PartFunc of X,Y holds
  f[/]c = f</>(dom f-->c);

registration
  let D be complex-functions-membered set;
  let f, g be FinSequence of D;
  cluster f<++>g -> FinSequence-like;
  cluster f<-->g -> FinSequence-like;
  cluster f<##>g -> FinSequence-like;
  cluster f<//>g -> FinSequence-like;
end;

theorem 
  for f being Function of X,TOP-REAL n holds <->f is Function of X,TOP-REAL n;

theorem 
  for f being Function of TOP-REAL i,TOP-REAL n holds
  f(-) is Function of TOP-REAL i,TOP-REAL n;

theorem 
  for f being Function of X,TOP-REAL n holds f[+]r is Function of X,TOP-REAL n;

theorem 
  for f being Function of X,TOP-REAL n holds
  f[-]r is Function of X,TOP-REAL n;

theorem 
  for f being Function of X,TOP-REAL n holds f[#]r is Function of X,TOP-REAL n;

theorem 
  for f being Function of X,TOP-REAL n holds
  f[/]r is Function of X,TOP-REAL n;

theorem 
  for f, g being Function of X,TOP-REAL n holds
  f<++>g is Function of X,TOP-REAL n;

theorem 
  for f, g being Function of X,TOP-REAL n holds
  f<-->g is Function of X,TOP-REAL n;

theorem 
  for f, g being Function of X,TOP-REAL n holds
  f<##>g is Function of X,TOP-REAL n;

theorem 
  for f, g being Function of X,TOP-REAL n holds
  f<//>g is Function of X,TOP-REAL n;

theorem 
  for f being Function of X,TOP-REAL n, g being Function of X,R^1 holds
  f<+>g is Function of X,TOP-REAL n;

theorem 
  for f being Function of X,TOP-REAL n, g being Function of X,R^1 holds
  f<->g is Function of X,TOP-REAL n;

theorem 
  for f being Function of X,TOP-REAL n, g being Function of X,R^1 holds
  f<#>g is Function of X,TOP-REAL n;

theorem 
  for f being Function of X,TOP-REAL n, g being Function of X,R^1 holds
  f</>g is Function of X,TOP-REAL n;

definition
  let n be Nat;
  let T be non empty set;
  let R be real-membered set;
  let f be Function of T,R;
  func incl(f,n) -> Function of T,TOP-REAL n means


  for t being Element of T holds it.t = n |-> f.t;
end;

theorem 
  for R being real-membered set for f being Function of T,R, t being Point of T
  st x in Seg n holds incl(f,n).t.x = f.t;

theorem 
  for T being non empty set, R being real-membered set, f being Function of T,R
  holds incl(f,0) = T --> 0;

theorem 
  for f being Function of T,TOP-REAL n, g being Function of T,R^1 holds
  f<+>g = f<++>incl(g,n);

theorem 
  for f being Function of T,TOP-REAL n, g being Function of T,R^1 holds
  f<->g = f<-->incl(g,n);

theorem 
  for f being Function of T,TOP-REAL n, g being Function of T,R^1 holds
  f<#>g = f<##>incl(g,n);

theorem 
  for f being Function of T,TOP-REAL n, g being Function of T,R^1 holds
  f</>g = f<//>incl(g,n);

definition
  let n;
  func TIMES(n) -> Function of [:TOP-REAL n,TOP-REAL n:],TOP-REAL n means


  for x,y being Point of TOP-REAL n holds it.(x,y) = x(#)y;
end;

theorem 
  TIMES(0) = [:TOP-REAL 0,TOP-REAL 0:] --> 0.TOP-REAL 0;

theorem 
  for f, g being Function of T,TOP-REAL n holds f <##> g = TIMES(n).:(f,g);

definition
  let m, n;
  func PROJ(m,n) -> Function of TOP-REAL m,R^1 means


  for p being Element of TOP-REAL m holds it.p = p/.n;
end;

theorem 
  for p being Point of TOP-REAL m st n in dom p holds
  PROJ(m,n).:Ball(p,r) = ]. p/.n-r , p/.n+r .[;

theorem 
  for m being non zero Nat for f being Function of T,R^1 holds
  f = PROJ(m,m) * incl(f,m);

begin 

registration
  let T;
  cluster non-empty continuous for Function of T,R^1;
end;

theorem 
  n in Seg m implies PROJ(m,n) is continuous;

theorem 
  n in Seg m implies PROJ(m,n) is open;

registration
  let n,T;
  let f be continuous Function of T,R^1;
  cluster incl(f,n) -> continuous;
end;

registration
  let n;
  cluster TIMES(n) -> continuous;
end;

theorem 
  for f being Function of TOP-REAL m,TOP-REAL n st f is continuous holds
  f(-) is continuous Function of TOP-REAL m,TOP-REAL n;

registration
  let T; let f be continuous Function of T,R^1;
  cluster -f -> continuous for Function of T,R^1;
end;

registration
  let T; let f be non-empty continuous Function of T,R^1;
  cluster f" -> continuous for Function of T,R^1;
end;

registration
  let T; let f be continuous Function of T,R^1; let r;
  cluster f+r -> continuous for Function of T,R^1;
  cluster f-r -> continuous for Function of T,R^1;
  cluster f(#)r -> continuous for Function of T,R^1;
  cluster f(/)r -> continuous for Function of T,R^1;
end;

registration
  let T; let f, g be continuous Function of T,R^1;
  cluster f+g -> continuous for Function of T,R^1;
  cluster f-g -> continuous for Function of T,R^1;
  cluster f(#)g -> continuous for Function of T,R^1;
end;

registration
  let T; let f be continuous Function of T,R^1;
  let g be non-empty continuous Function of T,R^1;
  cluster f /" g -> continuous for Function of T,R^1;
end;

registration
  let n,T;
  let f, g be continuous Function of T,TOP-REAL n;
  cluster f<++>g -> continuous for Function of T,TOP-REAL n;
  cluster f<-->g -> continuous for Function of T,TOP-REAL n;
  cluster f<##>g -> continuous for Function of T,TOP-REAL n;
end;

registration
  let n,T;
  let f be continuous Function of T,TOP-REAL n;
  let g be continuous Function of T,R^1;
  cluster f<+>g -> continuous for Function of T,TOP-REAL n;
  cluster f<->g -> continuous for Function of T,TOP-REAL n;
  cluster f<#>g -> continuous for Function of T,TOP-REAL n;
end;

registration
  let n,T;
  let f be continuous Function of T,TOP-REAL n;
  let g be non-empty continuous Function of T,R^1;
  cluster f</>g -> continuous for Function of T,TOP-REAL n;
end;

registration
  let n,T,r;
  let f be continuous Function of T,TOP-REAL n;
  cluster f[+]r -> continuous for Function of T,TOP-REAL n;
  cluster f[-]r -> continuous for Function of T,TOP-REAL n;
  cluster f[#]r -> continuous for Function of T,TOP-REAL n;
  cluster f[/]r -> continuous for Function of T,TOP-REAL n;
end;

theorem 
  for r being non negative real number
  for n being non zero Nat, p being Point of Tcircle(0.TOP-REAL n,r)
  holds -p is Point of Tcircle(0.TOP-REAL n,r);

theorem 
  for r being non negative real number
  for f being Function of Tcircle(0.TOP-REAL(n+1),r),TOP-REAL n holds
  f(-) is Function of Tcircle(0.TOP-REAL(n+1),r),TOP-REAL n;

definition
  let n be Nat, r be non negative real number;
  let X be Subset of Tcircle(0.TOP-REAL(n+1),r);
  redefine func (-)X -> Subset of Tcircle(0.TOP-REAL(n+1),r);
end;

registration
  let m;
  let r be non negative real number;
  let X be open Subset of Tcircle(0.TOP-REAL(m+1),r);
  cluster (-)X -> open for Subset of Tcircle(0.TOP-REAL(m+1),r);
end;

theorem 
  for r being non negative real number
  for f being continuous Function of Tcircle(0.TOP-REAL(m+1),r),TOP-REAL m
  holds f(-) is continuous Function of Tcircle(0.TOP-REAL(m+1),r),TOP-REAL m;














begin 

reserve x,y,X for set,
        r for Real,
        n,k for Nat;

theorem 
  for R be Relation, C be Cardinal st for x st x in X holds card Im(R,x) = C
    holds card R = card(R|(dom R\X)) +` C*`card X;

theorem 
  for Y be non empty finite set st card X = card Y+1
    for f be Function of X,Y st f is onto
      ex y st y in Y & card(f"{y}) = 2 &
              for x st x in Y & x <> y holds card (f"{x})=1;

definition
  let X be 1-sorted;
  mode SimplicialComplexStr of X is SimplicialComplexStr of the carrier of X;
  mode SimplicialComplex of X is SimplicialComplex of the carrier of X;
end;

definition
  let X be 1-sorted;
  let K be SimplicialComplexStr of X;
  let A be Subset of K;
  func @A -> Subset of X equals

    A;
end;

definition
  let X be 1-sorted;
  let K be SimplicialComplexStr of X;
  let A be Subset-Family of K;
  func @A -> Subset-Family of X equals

    A;
end;

theorem 
  for X be 1-sorted
  for K be subset-closed SimplicialComplexStr of X st K is total
  for S be finite Subset of K st S is simplex-like
    holds Complex_of {@S} is SubSimplicialComplex of K;

begin 

reserve RLS for non empty RLSStruct,
        Kr,K1r,K2r for SimplicialComplexStr of RLS,
        V for RealLinearSpace,
        Kv for non void SimplicialComplex of V;

definition let RLS,Kr;
  func |.Kr.| -> Subset of RLS means

    x in it iff ex A be Subset of Kr st A is simplex-like & x in conv @A;
end;

theorem 
  the topology of K1r c= the topology of K2r implies |.K1r.| c= |.K2r.|;

theorem 
  for A be Subset of Kr st A is simplex-like holds conv @A c= |.Kr.|;

theorem 
  for K be subset-closed SimplicialComplexStr of V holds
    x in |.K.| iff ex A be Subset of K st A is simplex-like & x in Int @A;

theorem 
  |.Kr.| is empty iff Kr is empty-membered;

theorem 
  for A be Subset of RLS holds |.Complex_of{A}.| = conv A;

theorem 
  for A,B be Subset-Family of RLS holds
    |.Complex_of (A\/B).| = |.Complex_of A.| \/ |.Complex_of B.|;

begin 

definition let RLS,Kr;
  mode SubdivisionStr of Kr -> SimplicialComplexStr of RLS means

    |.Kr.| c= |.it.| & for A be Subset of it st A is simplex-like
      ex B be Subset of Kr st B is simplex-like & conv @A c= conv @B;
end;

theorem 
  for P be SubdivisionStr of Kr holds |.Kr.| = |.P.|;

registration let RLS;
  let Kr be with_non-empty_element SimplicialComplexStr of RLS;
  cluster -> with_non-empty_element for SubdivisionStr of Kr;
end;

theorem 
  Kr is SubdivisionStr of Kr;

theorem 
  Complex_of the topology of Kr is SubdivisionStr of Kr;

theorem 
  for K be subset-closed SimplicialComplexStr of V
    for SF be Subset-Family of K st SF = Sub_of_Fin the topology of K
  holds Complex_of SF is SubdivisionStr of K;

theorem 
  for P1 be SubdivisionStr of Kr for P2 be SubdivisionStr of P1
    holds P2 is SubdivisionStr of Kr;

registration
  let V;
  let K be SimplicialComplexStr of V;
  cluster finite-membered subset-closed for SubdivisionStr of K;
end;

definition
  let V;
  let K be SimplicialComplexStr of V;
  mode Subdivision of K is finite-membered subset-closed SubdivisionStr of K;
end;

theorem 
  for K be with_empty_element SimplicialComplex of V st |.K.| c= [#]K
    for B be Function of BOOL the carrier of V,the carrier of V st
      for S be Simplex of K st S is non empty holds B.S in conv @S
    holds subdivision(B,K) is SubdivisionStr of K;

registration let V,Kv;
  cluster non void for Subdivision of Kv;
end;

begin 

definition
  let V,Kv such that
     |.Kv.| c= [#]Kv;
  func BCS Kv -> non void Subdivision of Kv equals

    subdivision(center_of_mass V,Kv);
end;

definition let n;
  let V,Kv such that
     |.Kv.| c= [#]Kv;
  func BCS(n,Kv) -> non void Subdivision of Kv equals

    subdivision(n,center_of_mass V,Kv);
end;

theorem 
  |.Kv.| c= [#]Kv implies BCS(0,Kv) = Kv;

theorem 
  |.Kv.| c= [#]Kv implies BCS(1,Kv) = BCS Kv;

theorem 
  |.Kv.| c= [#]Kv implies [#]BCS(n,Kv) = [#]Kv;

theorem 
 |.Kv.| c= [#]Kv implies |.BCS(n,Kv).| = |.Kv.|;

theorem 
  |.Kv.| c= [#]Kv implies BCS(n+1,Kv) = BCS BCS(n,Kv);

theorem 
  |.Kv.| c= [#]Kv & degree Kv <= 0 implies the TopStruct of Kv = BCS Kv;

theorem 
  n > 0 & |.Kv.| c= [#]Kv & degree Kv <= 0 implies
   the TopStruct of Kv = BCS(n,Kv);

theorem 
  for Sv be non void SubSimplicialComplex of Kv st
      |.Kv.| c= [#]Kv & |.Sv.| c= [#]Sv
    holds BCS(n,Sv) is SubSimplicialComplex of BCS(n,Kv);

theorem 
  |.Kv.| c= [#]Kv implies Vertices Kv c= Vertices BCS(n,Kv);

registration
  let n,V;
  let K be non void total SimplicialComplex of V;
  cluster BCS(n,K) -> total;
end;

registration
  let n,V;
  let K be non void finite-vertices total SimplicialComplex of V;
  cluster BCS(n,K) -> finite-vertices;
end;

begin 

definition
  let V;
  let K be SimplicialComplexStr of V;
  attr K is affinely-independent means

   for A be Subset of K st A is simplex-like holds @A is affinely-independent;
end;

definition
  let RLS,Kr;
  attr Kr is simplex-join-closed means

   for A,B be Subset of Kr st A is simplex-like & B is simplex-like
     holds conv @A /\ conv @B = conv @(A/\B);
end;

registration
  let V;
  cluster empty-membered -> affinely-independent for SimplicialComplexStr of V;
  let F be affinely-independent Subset-Family of V;
  cluster Complex_of F -> affinely-independent;
end;

registration
  let RLS;
  cluster empty-membered -> simplex-join-closed for
SimplicialComplexStr of RLS;
end;

registration
  let V;
  let I be affinely-independent Subset of V;
  cluster Complex_of{I} -> simplex-join-closed;
end;

registration let V;
  cluster 1-element affinely-independent for Subset of V;
end;

registration
  let V;
  cluster with_non-empty_element finite-vertices affinely-independent
          simplex-join-closed total for SimplicialComplex of V;
end;

registration
  let V;
  let K be affinely-independent SimplicialComplexStr of V;
  cluster -> affinely-independent for SubSimplicialComplex of K;
end;

registration
  let V;
  let K be simplex-join-closed SimplicialComplexStr of V;
  cluster -> simplex-join-closed for SubSimplicialComplex of K;
end;

theorem 
  for K be subset-closed SimplicialComplexStr of V holds
    K is simplex-join-closed
  iff
    for A,B be Subset of K st A is simplex-like & B is simplex-like &
                              Int @A meets Int @B
      holds A=B;

reserve Ks for simplex-join-closed SimplicialComplex of V,
        As,Bs for Subset of Ks,
        Ka for non void affinely-independent SimplicialComplex of V,
        Kas for non void affinely-independent simplex-join-closed
                 SimplicialComplex of V,
        K for non void affinely-independent simplex-join-closed total
                 SimplicialComplex of V;

registration
  let V,Ka;
  let S be Simplex of Ka;
  cluster @S -> affinely-independent;
end;

theorem 
  As is simplex-like & Bs is simplex-like & Int@As meets conv@Bs
    implies As c= Bs;

theorem 
  As is simplex-like & @As is affinely-independent & Bs is simplex-like
    implies (Int@As c= conv @Bs iff As c= Bs);

theorem 
  |.Ka.| c= [#]Ka implies BCS Ka is affinely-independent;

registration
  let V;
  let Ka be non void affinely-independent total SimplicialComplex of V;
  cluster BCS Ka -> affinely-independent;
  let n;
  cluster BCS(n,Ka) -> affinely-independent;
end;

registration
  let V,Kas;
  cluster (center_of_mass V)|the topology of Kas -> one-to-one;
end;

theorem 
  |.Kas.| c= [#]Kas implies BCS Kas is simplex-join-closed;

registration
  let V,K;
  cluster BCS K -> simplex-join-closed;
  let n;
  cluster BCS(n,K) -> simplex-join-closed;
end;

theorem 
  |.Kv.| c= [#]Kv & (for n st n <= degree Kv ex S be Simplex of Kv st
     card S = n+1 & @S is affinely-independent)
  implies degree Kv = degree BCS Kv;

theorem 
  |.Ka.| c= [#]Ka implies degree Ka = degree BCS Ka;

theorem 
  |.Ka.| c= [#]Ka implies degree Ka = degree BCS(n,Ka);

theorem 
  for S be simplex-like Subset-Family of Kas st S is with_non-empty_elements
    holds card S = card ((center_of_mass V).:S);

reserve Aff for finite affinely-independent Subset of V,
        Af,Bf for finite Subset of V,
        B for Subset of V,
        S,T for finite Subset-Family of V,
        Sf for c=-linear finite finite-membered Subset-Family of V,
        Sk,Tk for finite simplex-like Subset-Family of K,
        Ak for Simplex of K;

theorem 
  for S1,S2 be simplex-like Subset-Family of Kas st
      |.Kas.|c=[#]Kas & S1 is with_non-empty_elements &
      (center_of_mass V).:S2 is Simplex of BCS Kas &
      (center_of_mass V).:S1 c= (center_of_mass V).:S2
   holds S1 c= S2 & S2 is c=-linear;

theorem 
  S is with_non-empty_elements & union S c= Aff & card S+n+1 <= card Aff
implies (
    Bf is Simplex of n+card S,BCS Complex_of{Aff} & (center_of_mass V).:S c=Bf
iff
    ex T st T misses S & T\/S is c=-linear with_non-empty_elements &
            card T=n+1 & union T c= Aff &
            Bf = (center_of_mass V).:S\/(center_of_mass V).:T);

theorem 
  Sf is with_non-empty_elements & union Sf c=Aff implies
   ((center_of_mass V).:Sf is Simplex of card union Sf-1,BCS Complex_of {Aff}
iff
   for n st 0 < n & n <= card union Sf ex x st x in Sf & card x = n);

theorem 
  for S st S is c=-linear & S is with_non-empty_elements &
           card S = card union S
  for Af,Bf st Af is non empty & Af misses union S &
               union S\/Af is affinely-independent & union S\/Af c=Bf
   holds (center_of_mass V).:S \/ (center_of_mass V).:{union S\/Af}
           is Simplex of card S,BCS Complex_of{Bf};

theorem 
  for Sf st Sf is with_non-empty_elements & card Sf = card union Sf
  for v be Element of V st not v in union Sf &
                           union Sf\/{v} is affinely-independent
  holds
   {S1 where S1 is Simplex of card Sf,BCS Complex_of{union Sf\/{v}}:
       (center_of_mass V).:Sf c= S1} =
   {(center_of_mass V).:Sf\/(center_of_mass V).:{union Sf\/{v}}};

theorem 
  for Sf st Sf is with_non-empty_elements & card Sf+1 = card union Sf &
            union Sf is affinely-independent
  holds card {S1 where S1 is Simplex of card Sf,BCS Complex_of{union Sf}:
              (center_of_mass V).:Sf c= S1} = 2;

theorem 
  Aff is Simplex of K implies (B is Simplex of BCS Complex_of{Aff} iff
     B is Simplex of BCS K & conv B c= conv Aff);

theorem 
  Sk is with_non-empty_elements & card Sk+n <= degree K implies
   (Af is Simplex of n+card Sk,BCS K & (center_of_mass V).:Sk c=Af
iff
   ex Tk st Tk misses Sk & Tk\/Sk is c=-linear with_non-empty_elements &
            card Tk=n+1 & Af = (center_of_mass V).:Sk\/(center_of_mass V).:Tk);

theorem 
  Sk is c=-linear with_non-empty_elements & card Sk = card union Sk &
        union Sk c= Ak & card Ak = card Sk+1
implies
   {S1 where S1 is Simplex of card Sk,BCS K:
        (center_of_mass V).:Sk c= S1 & conv @S1 c= conv @Ak}
   = {(center_of_mass V).:Sk \/(center_of_mass V).:{Ak}};

theorem 
  Sk is c=-linear with_non-empty_elements & card Sk+1 = card union Sk
  implies card {S1 where S1 is Simplex of card Sk,BCS K:
       (center_of_mass V).:Sk c= S1 & conv @S1 c= conv @union Sk} = 2;

theorem 
  for Af st K is Subdivision of Complex_of{Af} & card Af = n+1 & degree K = n &
  for S be Simplex of n-1,K,X st X = {S1 where S1 is Simplex of n,K: S c= S1}
      holds (conv @S meets  Int Af implies card X = 2) &
            (conv @S misses Int Af implies card X = 1)
  holds
    for S be Simplex of n-1,BCS K,X st
        X = {S1 where S1 is Simplex of n,BCS K:S c= S1}
    holds (conv @S meets  Int Af implies card X = 2) &
          (conv @S misses Int Af implies card X = 1);

theorem 
  for S be Simplex of n-1,BCS(k,Complex_of{Aff}) st card Aff = n+1 &
      X = {S1 where S1 is Simplex of n,BCS(k,Complex_of{Aff}): S c= S1}
    holds (conv @S meets  Int Aff implies card X = 2) &
          (conv @S misses Int Aff implies card X = 1);

begin 

reserve v for Vertex of BCS(k,Complex_of{Aff}),
        F for Function of Vertices BCS(k,Complex_of{Aff}),Aff;

theorem 
  for F st for v,B st B c= Aff & v in conv B holds F.v in B
    ex n st card {S where S is Simplex of card Aff-1,BCS(k,Complex_of{Aff}):
                  F.:S = Aff} = 2*n+1;



theorem 
  for F st for v,B st B c= Aff & v in conv B holds F.v in B
    ex S be Simplex of card Aff-1,BCS(k,Complex_of{Aff}) st F.:S = Aff;















begin 

reserve x, y for set;

registration 
  let c be real number;
  cluster exp_R(c) -> positive;
end;

registration 
  cluster number_e -> positive;
end;

theorem 
  id {} is without_fixpoints;

theorem 
  for c be real number st c < 0 holds exp_R c < 1;

begin 

definition
  let n be real number;
  func round n -> Integer equals

    [\ n + 1 / 2 /];
end;

theorem 
  for a being Integer holds round a = a;

theorem 
  for a being Integer for b being real number st |. a - b .| < 1/2 holds
  a = round b;

begin 

theorem 
  for n be Nat for a, b be real number st a < b holds
  ex c be real number st c in ].a, b.[
  & exp_R a = Partial_Sums(Taylor(exp_R, [#]REAL, b, a)).n
            + exp_R c * (a-b) |^ (n+1) / ((n+1)!);

theorem 
  for n be positive Nat for c be real number st c < 0 holds
  |. -n! * (exp_R c * (-1) |^ (n+1) / ((n+1)!)) .| < 1/2;

definition
  let s be set;
  func derangements (s) equals

    { f where f is Permutation of s : f is without_fixpoints };
end;

registration
  let s be finite set;
  cluster derangements(s) -> finite;
end;

theorem 
  for s being finite set holds derangements s = {h where h is Function of
    s, s: h is one-to-one & for x st x in s holds h.x<>x};

theorem 
  for s being non empty finite set ex c being real number st c in ]. -1, 0 .[ &
  card(derangements s) - (((card s)!) / number_e) =
     -(card s)! * (exp_R c * (-1) |^ ((card s)+1) / (((card s)+1)!));

theorem 
  for s being non empty finite set
  holds |. card(derangements s) - (((card s)!) / number_e) .| < 1/2;

theorem 
  for s being non empty finite set
  holds card(derangements s) = round ((card s)! / number_e);

theorem 
  derangements {} = {{}};

theorem 
  derangements { x } = {};

definition
  func der_seq -> sequence of INT means

 it.0 = 1 & it.1 = 0 & for n being Nat
    holds it.(n + 2) = (n + 1) * (it.n + it.(n + 1));
end;

registration
  let c be Integer;
  let F be XFinSequence of INT;
  cluster c (#) F -> finite INT-valued T-Sequence-like;
end;

registration
  let c be complex number;
  let F be empty Function;
  cluster c (#) F -> empty;
end;

theorem 
  for F be XFinSequence of INT for c be Integer holds
  c * Sum F = Sum ((c (#) F) | (len F -' 1)) + c * F.(len F -' 1);




theorem 
  for X, N be XFinSequence of INT st len N = len X + 1
  for c be Integer st (N | len X) = c (#) X
  holds Sum N = c * Sum X + N.(len X);

theorem 
  for s being finite set holds der_seq.(card s) = card (derangements s);

begin 

definition let s, t be set;
  func not-one-to-one (s, t) -> Subset of Funcs(s, t) equals

    {f where f is Function of s, t : f is not one-to-one};
end;

registration let s, t be finite set;
  cluster not-one-to-one (s, t) -> finite;
end;

scheme 
 FraenkelDiff {s, t() -> set, P[set]} :
    {f where f is Function of s(), t() : not P[f]} =
      Funcs(s(), t()) \ {f where f is Function of s(), t() : P[f]}
  provided
 t() = {} implies s() = {};

theorem 
  for s, t being finite set st card s <= card t
  holds card (not-one-to-one (s, t)) =
       (card t |^ card s) - ((card t)! / ((card t -' card s)!));

theorem 
  for s being finite set, t being non empty finite set
  st card s = 23 & card t = 365
  holds 2 * card (not-one-to-one (s, t)) > card Funcs (s, t);

theorem 
  for s, t being non empty finite set st card s = 23 & card t = 365
  holds prob (not-one-to-one (s, t)) > 1/2;














begin 

theorem 
for z being complex number, r be real number holds Re(r * z) = r* Re (z)
      & Im(r * z) = r* Im (z);

registration
  let S be FinSequence of COMPLEX;
  cluster Re S -> FinSequence-like;
  cluster Im S -> FinSequence-like;
end;

definition
  let S be FinSequence of COMPLEX;
  redefine func Re S -> FinSequence of REAL;
  redefine func Im S -> FinSequence of REAL;
end;

definition

  let A be non empty closed_interval Subset of REAL;
  let f be Function of A,COMPLEX;
  let D be Division of A;
  mode middle_volume of f,D -> FinSequence of COMPLEX means

    len it = len D & for i be Nat st i in dom D holds
      ex c be Element of COMPLEX st c in rng (f|divset(D,i))
      & it.i = c * vol divset(D,i);
end;

definition
  let A be non empty closed_interval Subset of REAL;
  let f be Function of A,COMPLEX;
  let D be Division of A;
  let F be middle_volume of f,D;
  func middle_sum(f,F) -> Element of COMPLEX equals

    Sum(F);
end;

definition
  let A be non empty closed_interval Subset of REAL,
      f be Function of A,COMPLEX,
      T be DivSequence of A;
  mode middle_volume_Sequence of f,T -> Function of NAT, (COMPLEX)* means


    for k be Element of NAT holds it.k is middle_volume of f,T.k;
end;

definition
  let A be non empty closed_interval Subset of REAL,
      f be Function of A,COMPLEX,
      T be DivSequence of A,
      S be middle_volume_Sequence of f,T,
      k be Element of NAT;
  redefine func S.k -> middle_volume of f,T.k;
end;

definition
  let A be non empty closed_interval Subset of REAL,
      f be Function of A,COMPLEX,
      T be DivSequence of A,
      S be middle_volume_Sequence of f,T;
  func middle_sum(f,S) -> Complex_Sequence means

    for i be Element of NAT holds it.i = middle_sum(f,S.i);
end;

begin 

theorem 
for f be PartFunc of REAL,COMPLEX,
    A be Subset of REAL holds Re (f|A) = (Re f)|A;

theorem 
for f be PartFunc of REAL,COMPLEX,
    A be Subset of REAL holds Im (f|A) = (Im f)|A;

registration
  let A be non empty closed_interval Subset of REAL;
  let f be Function of A,COMPLEX;
  cluster Re f -> quasi_total for PartFunc of A,REAL;
  cluster Im f -> quasi_total for PartFunc of A,REAL;
end;

theorem 
for A be non empty closed_interval Subset of REAL, f be Function of A,COMPLEX,
    D be Division of A,
    S be middle_volume of f,D
  holds
    Re S is middle_volume of (Re f),D
  & Im S is middle_volume of (Im f),D;

theorem 
for F be FinSequence of COMPLEX, x be Element of COMPLEX holds
    Re (F^<* x *>) = (Re F)^<* Re x *>;

theorem 
for F be FinSequence of COMPLEX, x be Element of COMPLEX holds
    Im (F^<* x *>) = (Im F)^<* Im x *>;

theorem 
for F be FinSequence of COMPLEX, Fr be FinSequence of REAL st Fr=Re F
  holds Sum(Fr) = Re Sum(F);

theorem 
for F be FinSequence of COMPLEX, Fi be FinSequence of REAL st Fi=Im F
  holds Sum(Fi) = Im Sum(F);

theorem 
for A be non empty closed_interval Subset of REAL, f be Function of A,COMPLEX,
    D be Division of A,
    F be middle_volume of f,D,
   Fr be middle_volume of (Re f),D
      st Fr=Re F
  holds Re middle_sum(f,F) = middle_sum((Re f),Fr);

theorem 
for A be non empty closed_interval Subset of REAL, f be Function of A,COMPLEX,
    D be Division of A,
    F be middle_volume of f,D,
   Fi be middle_volume of (Im f),D
      st Fi=Im F
  holds Im middle_sum(f,F) = middle_sum((Im f),Fi);

definition
  let A be non empty closed_interval Subset of REAL;
  let f be Function of A,COMPLEX;
  attr f is integrable means

  (Re f) is integrable & (Im f) is integrable;
end;

theorem 
for f be PartFunc of REAL,COMPLEX holds
    f is bounded iff (Re f is bounded & Im f is bounded);

theorem 
for A be non empty Subset of REAL, f be PartFunc of REAL,COMPLEX,
    g be Function of A,COMPLEX
      st f = g
  holds Re f = Re g & Im f = Im g;

theorem 
for A be non empty closed_interval Subset of REAL,
f be Function of A,COMPLEX holds
    f is bounded iff (Re f is bounded & Im f is bounded);

definition
  let A be non empty closed_interval Subset of REAL;
  let f be Function of A,COMPLEX;
  func integral(f) -> Element of COMPLEX equals

    integral(Re f) + integral(Im f) *<i>;
end;

theorem 
for A be non empty closed_interval Subset of REAL,
f being Function of A,COMPLEX,
    T being DivSequence of A,
    S be middle_volume_Sequence of f,T
      st f is bounded & f is integrable
       & delta(T) is convergent & lim delta(T)=0
  holds
    middle_sum(f,S) is convergent & lim (middle_sum(f,S))=integral(f);

theorem 
for A be non empty closed_interval Subset of REAL,
f being Function of A,COMPLEX
      st f is bounded
  holds
    f is integrable iff
    ex I be Element of COMPLEX
      st for T being DivSequence of A,
             S be middle_volume_Sequence of f,T
          st delta(T) is convergent & lim delta(T)=0
           holds middle_sum(f,S) is convergent & lim (middle_sum(f,S))=I;

definition
  let A be non empty closed_interval Subset of REAL;
  let f be PartFunc of REAL,COMPLEX;
  pred f is_integrable_on A means

  (Re f) is_integrable_on A & (Im f) is_integrable_on A;
end;

definition
  let A be non empty closed_interval Subset of REAL;
  let f be PartFunc of REAL,COMPLEX;
  func integral(f,A) -> Element of COMPLEX equals

  integral((Re f),A) + integral((Im f),A)*<i>;
end;

theorem 
for A be non empty closed_interval Subset of REAL,
f be PartFunc of REAL,COMPLEX,
    g be Function of A,COMPLEX st f|A = g
  holds f is_integrable_on A iff g is integrable;

theorem 
for A be non empty closed_interval Subset of REAL,
f be PartFunc of REAL,COMPLEX,
    g be Function of A,COMPLEX st f|A = g holds
  integral(f,A) = integral(g);

definition
  let a,b be real number;
  let f be PartFunc of REAL, COMPLEX;
  func integral(f,a,b) -> Element of COMPLEX equals

  integral((Re f),a,b) + integral((Im f),a,b) *<i>;
end;

begin 

theorem 
for c be complex number, f be PartFunc of REAL, COMPLEX holds
  Re (c(#)f) = (Re c)(#)(Re f) - (Im c)(#)(Im f)
& Im (c(#)f) = (Re c)(#)(Im f) + (Im c)(#)(Re f);

theorem 
for A be non empty closed_interval Subset of REAL,
f1,f2 be PartFunc of REAL, COMPLEX
  st f1 is_integrable_on A & f2 is_integrable_on A
   & A c= dom f1 & A c= dom f2 & (f1|A) is bounded & (f2|A) is bounded
   holds f1+f2 is_integrable_on A
       & f1-f2 is_integrable_on A
       & integral(f1+f2,A)=integral(f1,A)+integral(f2,A)
       & integral(f1-f2,A)=integral(f1,A)-integral(f2,A);

theorem 
for r be Real for A be non empty closed_interval Subset of REAL
for f be PartFunc of REAL, COMPLEX
  st A c= dom f & f is_integrable_on A
  & f|A is bounded holds
    r(#)f is_integrable_on A
  & integral((r(#)f),A) = r * integral(f,A);

theorem 
for c be complex number, A be non empty closed_interval Subset of REAL,
    f be PartFunc of REAL, COMPLEX
 st A c= dom f & f is_integrable_on A & f|A is bounded holds
  c(#)f is_integrable_on A & integral((c(#)f),A) = c * integral(f,A);

theorem 
for f being PartFunc of REAL,COMPLEX,
A being non empty closed_interval Subset of REAL,
  a,b be Real st A=[.a,b.]
  holds integral(f,A) = integral(f,a,b);

theorem 
for f being PartFunc of REAL,COMPLEX,
A being non empty closed_interval Subset of REAL,
  a,b be Real st A=[.b,a.]
  holds -integral(f,A) = integral(f,a,b);















begin




reserve i,n,m for Element of NAT;

theorem 
for f be set holds
 f is PartFunc of REAL m,REAL n iff f is PartFunc of REAL-NS m,REAL-NS n;

theorem 
for n,m be non empty Element of NAT, f be PartFunc of REAL m,REAL n,
    g be PartFunc of REAL-NS m,REAL-NS n,
    x be Element of REAL m, y be Point of REAL-NS m st
  f=g & x=y holds f is_differentiable_in x iff g is_differentiable_in y;

theorem 
for n,m be non empty Element of NAT, f be PartFunc of REAL m,REAL n,
    g be PartFunc of REAL-NS m,REAL-NS n,
    x be Element of REAL m, y be Point of REAL-NS m st
 f=g & x=y & f is_differentiable_in x holds diff(f,x) = diff(g,y);

theorem 
for f1,f2 be PartFunc of REAL m,REAL n,
    g1,g2 be PartFunc of REAL-NS m,REAL-NS n st
 f1 = g1 & f2 = g2 holds f1 + f2 = g1 + g2;

theorem 
for f1,f2 be PartFunc of REAL m,REAL n,
    g1,g2 be PartFunc of REAL-NS m,REAL-NS n st
 f1 = g1 & f2 = g2 holds f1 - f2 = g1 - g2;

theorem 
for f be PartFunc of REAL m,REAL n,
    g be PartFunc of REAL-NS m,REAL-NS n, a be Real st
 f = g holds a(#)f = a(#)g;

theorem 
for f1,f2 be Function of REAL m,REAL n, g1,g2 be Point of
      R_NormSpace_of_BoundedLinearOperators(REAL-NS m,REAL-NS n) st
 f1 = g1 & f2 = g2 holds f1 + f2 = g1 + g2;

theorem 
for f1,f2 be Function of REAL m,REAL n, g1,g2 be Point of
       R_NormSpace_of_BoundedLinearOperators(REAL-NS m,REAL-NS n) st
f1 = g1 & f2 = g2 holds f1 - f2 = g1 - g2;

theorem 
for f be Function of REAL m,REAL n,
    g be Point of R_NormSpace_of_BoundedLinearOperators(REAL-NS m,REAL-NS n),
    r be Real st
 f = g holds r(#)f = r*g;

theorem 
for m,n be non empty Element of NAT
for f be PartFunc of REAL m,REAL n, x be Element of REAL m st
 f is_differentiable_in x holds
  diff(f,x) is
    Point of R_NormSpace_of_BoundedLinearOperators(REAL-NS m,REAL-NS n);

definition
  let n,m be Nat;
  let IT be Function of REAL m,REAL n;
  attr IT is additive means

  for x,y being Element of REAL m holds IT.(x+y) = IT.x+IT.y;
  attr IT is homogeneous means

  for x being Element of REAL m, r being Real holds IT.(r*x) = r*IT.x;
end;

theorem 
for IT be Function of REAL m,REAL n st IT is additive holds IT.(0*m) = 0*n;

theorem 
for f be Function of REAL m,REAL n, g be Function of REAL-NS m,REAL-NS n st
 f=g holds f is additive iff g is additive;

theorem 
for f be Function of REAL m,REAL n, g be Function of REAL-NS m,REAL-NS n st
 f=g holds f is homogeneous iff g is homogeneous;

registration
  let n,m be Nat;
  cluster (REAL m) --> 0*n -> additive homogeneous for
Function of REAL m,REAL n;
end;

registration
  let n,m be Nat;
  cluster additive homogeneous for Function of REAL m,REAL n;
end;

definition let m,n be Nat;
  mode LinearOperator of m,n
    is additive homogeneous Function of REAL m,REAL n;
end;

theorem 
for f be set holds f is LinearOperator of m,n
  iff f is LinearOperator of REAL-NS m,REAL-NS n;

definition let m,n be Nat, IT be Function of REAL m,REAL n,
               x be Element of REAL m;
  redefine func IT.x -> Element of REAL n;
end;

definition let m,n be Nat, IT be Function of REAL m,REAL n;
  attr IT is Lipschitzian means

    ex K being Real st 0 <= K &
      for x being Element of REAL m holds |. IT.x .| <= K * |. x .|;
end;

theorem 
for xseq,yseq be FinSequence of REAL m st
 len xseq = len yseq + 1 & xseq| (len yseq) = yseq holds
   ex v be Element of REAL m st v=xseq.(len xseq) & Sum xseq = Sum yseq + v;

theorem 
for f be LinearOperator of m,n, xseq be FinSequence of REAL m,
    yseq be FinSequence of REAL n st
 len xseq = len yseq &
 ( for i be Element of NAT st i in dom xseq holds yseq.i=f.(xseq.i) )
holds Sum yseq=f.(Sum xseq);

theorem 
for xseq be FinSequence of REAL m, yseq be FinSequence of REAL st
 len xseq = len yseq &
 ( for i be Element of NAT st i in dom xseq holds
    ex v be Element of REAL m st v = xseq.i & yseq.i = |.v .| )
  holds |.Sum xseq.| <= Sum yseq;

registration
  let m,n be Nat;
  cluster -> Lipschitzian for LinearOperator of m,n;
end;

registration
  let m,n;
  cluster -> Lipschitzian for LinearOperator of REAL-NS m,REAL-NS n;
end;

theorem 
for m,n be non empty Element of NAT,
    f be PartFunc of REAL m,REAL n, x be Element of REAL m st
  f is_differentiable_in x holds
    diff(f,x) is LinearOperator of REAL-NS m,REAL-NS n;

theorem 
for m,n be non empty Element of NAT,
    f be PartFunc of REAL m,REAL n, x be Element of REAL m st
  f is_differentiable_in x holds
    diff(f,x) is LinearOperator of m, n;

theorem 
for n,m be non empty Element of NAT, g1,g2 be PartFunc of REAL m,REAL n,
    y0 be Element of REAL m st
  g1 is_differentiable_in y0 & g2 is_differentiable_in y0 holds
    g1+g2 is_differentiable_in y0 &
    diff(g1+g2,y0) = diff(g1,y0) + diff(g2,y0);

theorem 
for n,m be non empty Element of NAT, g1,g2 be PartFunc of REAL m,REAL n,
    y0 be Element of REAL m st
  g1 is_differentiable_in y0 & g2 is_differentiable_in y0 holds
    g1-g2 is_differentiable_in y0 &
    diff(g1-g2,y0) = diff(g1,y0) - diff(g2,y0);

theorem 
for n,m be non empty Element of NAT, g be PartFunc of REAL m,REAL n,
    y0 be Element of REAL m, r be Real st
  g is_differentiable_in y0 holds
   r(#)g is_differentiable_in y0 & diff((r(#)g),y0) = r(#)diff(g,y0);

theorem 
for x0 be Element of REAL m, y0 be Point of REAL-NS m, r be Real st x0=y0 holds
  {y where y is Element of REAL m: |.y-x0.| < r}
    = {z where z is Point of REAL-NS m: ||.z-y0.|| < r};

theorem 
for m,n be non empty Element of NAT,
    f be PartFunc of REAL m,REAL n, x0 be Element of REAL m,
    L,R be Function of REAL m,REAL n st
  L is LinearOperator of m,n &
  ex r0 be Real st
    0 < r0 & {y where y is Element of REAL m: |.y-x0.| < r0} c= dom f &
    (for r be Real st r > 0
       ex d be Real st d > 0 &
         (for z be Element of REAL m,w be Element of REAL n st
            z <> 0*m & |.z.| < d & w = R.z holds (|.z.|"* |. w .|) < r) ) &
    for x be Element of REAL m st|.x-x0.| < r0 holds
      f/.x - f/.x0 = L.(x-x0) + R.(x-x0)
holds
  f is_differentiable_in x0 & diff(f,x0) = L;

theorem 
for m,n be non empty Element of NAT,
    f be PartFunc of REAL m,REAL n, x0 be Element of REAL m holds
  f is_differentiable_in x0
iff
  ex r0 be Real st 0 < r0 &
    {y where y is Element of REAL m: |.y-x0.| < r0} c= dom f &
    ex L,R be Function of REAL m,REAL n st
      L is LinearOperator of m,n &
      (for r be Real st r > 0
         ex d be Real st d > 0 &
           (for z be Element of REAL m,w be Element of REAL n st
              z <> 0*m & |.z.| < d & w=R.z holds (|.z.|"* |. w .|) < r)) &
      for x be Element of REAL m st |.x-x0.| < r0 holds
        f/.x - f/.x0 = L.(x-x0) + R.(x-x0);

begin




theorem 
for y1,y2 be Point of REAL-NS n holds
 Proj(i,n).(y1 + y2) = Proj(i,n).y1 + Proj(i,n).y2;

theorem 
for y1 be Point of REAL-NS n, r being Real holds
 Proj(i,n).(r*y1) = r*(Proj(i,n).y1);

theorem 
for m,n be non empty Element of NAT,
    g be PartFunc of REAL-NS m,REAL-NS n, x0 be Point of REAL-NS m,
    i be Element of NAT st
 1 <= i & i <= n & g is_differentiable_in x0 holds
   (Proj(i,n)*g) is_differentiable_in x0 &
   Proj(i,n)*(diff(g,x0)) = diff((Proj(i,n)*g),x0);

theorem 
for m,n be non empty Element of NAT, g be PartFunc of REAL-NS m,REAL-NS n,
    x0 be Point of REAL-NS m holds
g is_differentiable_in x0 iff
(for i be Element of NAT st 1<=i & i <=n holds
      Proj(i,n)*g is_differentiable_in x0);

definition
  let X be set;
  let n,m be non empty Element of NAT;
  let f be PartFunc of REAL m,REAL n;
  pred f is_differentiable_on X means

  X c= dom f &
  for x be Element of REAL m st x in X holds f|X is_differentiable_in x;
end;

theorem 
for X be set, m,n be non empty Element of NAT, f be PartFunc of REAL m,REAL n,
    g be PartFunc of REAL-NS m,REAL-NS n st f=g holds
  f is_differentiable_on X iff g is_differentiable_on X;

theorem 
for X be set, m,n be non empty Element of NAT,
    f be PartFunc of REAL m,REAL n holds
  f is_differentiable_on X implies X is Subset of REAL m;

theorem 
for m,n be non empty Element of NAT, f be PartFunc of REAL m,REAL n,
    Z be Subset of REAL m st
 ex Z0 be Subset of REAL-NS m st Z=Z0 & Z0 is open
holds
  ( f is_differentiable_on Z
 iff
    Z c=dom f &
    for x be Element of REAL m st x in Z holds f is_differentiable_in x );

theorem 
for m,n be non empty Element of NAT, f be PartFunc of REAL m,REAL n,
    Z be Subset of REAL m st
 f is_differentiable_on Z
  ex Z0 be Subset of REAL-NS m st Z=Z0 & Z0 is open;















begin

 reserve Omega for non empty set;
 reserve r for Real;
 reserve Sigma for SigmaField of Omega;
 reserve P for Probability of Sigma;

theorem 
  for f be one-to-one Function, A,B be Subset of dom f st A misses B holds
  rng (f|A) misses rng (f|B);

theorem 
  for f,g be Function holds rng (f*g) c= rng (f|(rng g));

registration let Omega,Sigma;
  cluster nonnegative for Real-Valued-Random-Variable of Sigma;
end;

registration let Omega,Sigma;
  let X be Real-Valued-Random-Variable of Sigma;
  cluster abs X -> nonnegative;
end;

theorem 
  (Omega --> 1) = chi(Omega, Omega);

theorem 
  (Omega --> r) is Real-Valued-Random-Variable of Sigma;

theorem 
  for X be non empty set, f be PartFunc of X,REAL holds
  f to_power 2 = (-f) to_power 2 &
  f to_power 2 = (abs(f)) to_power 2;

theorem 
  for X be non empty set, f,g be PartFunc of X,REAL holds
  (f+g) to_power 2 = (f to_power 2) + 2(#)(f(#)g) + (g to_power 2) &
  (f-g) to_power 2 = (f to_power 2) - 2(#)(f(#)g) + (g to_power 2);

definition let Omega,Sigma,P;
  let X be Real-Valued-Random-Variable of Sigma;
  assume  X is_integrable_on P
  & (abs(X) to_power 2) is_integrable_on P2M(P);
  func variance (X,P) -> Element of REAL means

  ex Y be Real-Valued-Random-Variable of Sigma,
  E be Real-Valued-Random-Variable of Sigma
  st E=(Omega --> expect(X,P)) & Y = X-E &
  Y is_integrable_on P & abs(Y) to_power 2 is_integrable_on P2M(P) &
  it=Integral(P2M(P),abs(Y) to_power 2);
end;

begin 

theorem 
  for Omega,Sigma,P,r for X be Real-Valued-Random-Variable of Sigma st
  0 < r & X is nonnegative & X is_integrable_on P &
  (abs(X) to_power 2) is_integrable_on P2M(P) holds
  P.({t where t is Element of Omega : r <= |. X.t - expect(X,P) .| })
  <= variance(X,P)/( r to_power 2);

begin 

theorem 
  for Omega be non empty finite set, f be Function of Omega,REAL,
  P be Function of bool Omega, REAL st
  (for x be set st x c= Omega holds 0 <= P.x & P.x <= 1) &
  P.Omega = 1 & for z be finite Subset of Omega
  holds P.z = setopfunc(z,Omega,REAL,f,addreal)
  holds P is Probability of Trivial-SigmaField Omega;

theorem 
  for DX be non empty set, F be Function of DX,REAL,
  Y be finite Subset of DX holds
  ex p being FinSequence of DX st p is one-to-one &
  rng p = Y & setopfunc(Y,DX,REAL,F,addreal)=Sum(Func_Seq(F,p));

theorem 
  for DX be non empty set, F be Function of DX,REAL, Y be finite Subset of DX,
  p being FinSequence of DX
  st p is one-to-one & rng p = Y holds
  setopfunc(Y,DX,REAL,F,addreal)=Sum(Func_Seq(F,p));

theorem 
  for DX1,DX2 be non empty set, F1 be Function of DX1,REAL,
  F2 be Function of DX2,REAL,
  G be Function of [:DX1,DX2:], REAL,
  Y1 be non empty finite Subset of DX1 holds
  for p1 being FinSequence of DX1 st
  p1 is one-to-one & rng p1 = Y1 holds
  for p2 being FinSequence of DX2,
  p3 being FinSequence of [:DX1,DX2:],
  Y2 be non empty finite Subset of DX2,
  Y3 be finite Subset of [:DX1,DX2:] st
  p2 is one-to-one & rng p2 = Y2 &
  p3 is one-to-one & rng p3 = Y3 & Y3= [:Y1,Y2:] &
  for x,y be set st x in Y1 & y in Y2
  holds G.(x,y)= (F1.x)*(F2.y) holds
  Sum(Func_Seq(G,p3))= Sum(Func_Seq(F1,p1))*Sum(Func_Seq(F2,p2));

theorem 
  for DX1,DX2 be non empty set, F1 be Function of DX1,REAL,
  F2 be Function of DX2,REAL,
  G be Function of [:DX1,DX2:], REAL,
  Y1 be non empty finite Subset of DX1,
  Y2 be non empty finite Subset of DX2,
  Y3 be finite Subset of [:DX1,DX2:] st Y3= [:Y1,Y2:] &
  for x,y be set st x in Y1 & y in Y2 holds G.(x,y)= (F1.x)*(F2.y)
  holds
  setopfunc(Y3,[:DX1,DX2:],REAL,G,addreal)
  =setopfunc(Y1,DX1,REAL,F1,addreal) * setopfunc(Y2,DX2,REAL,F2,addreal);

theorem 
  for DX be non empty set, F be Function of DX,REAL,
  Y be finite Subset of DX st
  for x be set st x in Y holds 0<= F.x holds
  0 <= setopfunc(Y,DX,REAL,F,addreal);

theorem 
  for DX be non empty set, F be Function of DX,REAL,
  Y1,Y2 be finite Subset of DX st
  Y1 c= Y2 & for x be set st x in Y2 holds 0<= F.x holds
  setopfunc(Y1,DX,REAL,F,addreal)
  <= setopfunc(Y2,DX,REAL,F,addreal);

theorem 
  for Omega be non empty finite set,
  P be Probability of Trivial-SigmaField (Omega),
  Y be non empty finite Subset of Omega,
  f be Function of Omega,REAL
  ex G being FinSequence of REAL, s being FinSequence of Y
  st
  len G = card (Y) & s is one-to-one
  & rng s = Y & len s = card (Y)
  & (for n being Nat st n in dom G holds G.n
  = (f.(s.n)) * P.{s.n})
  & Integral(P2M(P),f|Y) = Sum G;

definition
  let Omega1, Omega2 be non empty finite set,
      P1 be Probability of Trivial-SigmaField Omega1,
      P2 be Probability of Trivial-SigmaField Omega2;
  func Product-Probability (Omega1,Omega2,P1,P2)
  -> Probability of Trivial-SigmaField ([:Omega1,Omega2:]) means

  ex Q be Function of [:Omega1,Omega2:],REAL st
  (for x,y be set st x in Omega1 & y in Omega2
  holds Q.(x,y) = (P1.{x})*(P2.{y}) ) &
  (for z be finite Subset of [:Omega1,Omega2:]
  holds it.z = setopfunc(z,[:Omega1,Omega2:],REAL,Q,addreal));
end;

theorem 
  for Omega1, Omega2 be non empty finite set,
  P1 be Probability of Trivial-SigmaField Omega1,
  P2 be Probability of Trivial-SigmaField Omega2,
  Y1 be non empty finite Subset of Omega1,
  Y2 be non empty finite Subset of Omega2 holds
  Product-Probability (Omega1,Omega2,P1,P2).([:Y1,Y2:]) = (P1.Y1)*(P2.Y2);

theorem 
  for Omega1, Omega2 be non empty finite set,
  P1 be Probability of Trivial-SigmaField (Omega1),
  P2 be Probability of Trivial-SigmaField (Omega2),
  y1, y2 be set st y1 in Omega1 & y2 in Omega2 holds
  Product-Probability (Omega1,Omega2,P1,P2).({[y1,y2]})
  = (P1.{y1})*(P2.{y2});

begin 

definition
  let Omega be non empty set;
  let Sigma be SigmaField of Omega;
  func Real-Valued-Random-Variables-Set Sigma
    -> non empty Subset of RAlgebra Omega equals

  { f where f is Real-Valued-Random-Variable of Sigma : not contradiction };
end;

registration let Omega,Sigma;
  cluster Real-Valued-Random-Variables-Set Sigma
    -> additively-linearly-closed multiplicatively-closed;
end;

definition
  let Omega,Sigma;
  func R_Algebra_of_Real-Valued-Random-Variables Sigma -> Algebra equals

  AlgebraStr (# Real-Valued-Random-Variables-Set Sigma,
     mult_(Real-Valued-Random-Variables-Set Sigma,RAlgebra Omega),
     Add_(Real-Valued-Random-Variables-Set Sigma,RAlgebra Omega),
     Mult_(Real-Valued-Random-Variables-Set Sigma,RAlgebra Omega),
     One_(Real-Valued-Random-Variables-Set Sigma,RAlgebra Omega),
     Zero_(Real-Valued-Random-Variables-Set Sigma,RAlgebra Omega) #);
end;

registration let Omega, Sigma;
  cluster R_Algebra_of_Real-Valued-Random-Variables Sigma -> scalar-unital;
end;















begin

reserve n for Nat,
        p,p1,p2 for Point of TOP-REAL n,
        x for real number;

registration
  let n be Nat;
  let p,q be Element of TOP-REAL n;
  let f,g be real-valued FinSequence;
  identify p+q with f+g when p=f, q=g;
end;

registration
  let r,s be real number;
  let n be Nat;
  let p be Element of TOP-REAL n;
  let f be real-valued FinSequence;
  identify r*p with s*f when r=s, p=f;
end;

registration
  let n be Nat;
  let p be Element of TOP-REAL n;
  let f be real-valued FinSequence;
  identify -p with -f when p=f;
end;

registration
  let n be Nat;
  let p,q be Element of TOP-REAL n;
  let f,g be real-valued FinSequence;
  identify p-q with f-g when p=f, q=g;
end;




reserve n,m for non empty Element of NAT;
reserve i,j for Element of NAT;
reserve f for PartFunc of REAL-NS m,REAL-NS n;
reserve g for PartFunc of REAL m,REAL n;
reserve h for PartFunc of REAL m,REAL;
reserve x for Point of REAL-NS m;
reserve y for Element of REAL m;
reserve X for set;

theorem 
i <= j implies (0*j) | i = 0*i;

theorem 
i <= j implies ((0*j) | (i-'1)) = 0*((i-'1));

theorem 
((0*j) /^ i) = 0*((j-'i));

theorem 
 (i <= j implies ((0*j) | (i-'1)) = 0*((i-'1))) & ((0*j) /^ i) = 0*((j-'i));

theorem 
for xi be Element of REAL-NS 1 st 1 <= i & i <= j holds
  ||. reproj(i,0.(REAL-NS j)).xi .|| = ||. xi .||;

theorem 
for m,i be Element of NAT, x be Element of REAL m, r be Real holds
  reproj(i,x).r - x = reproj(i,0*m).(r - proj(i,m).x) &
  x - reproj(i,x).r = reproj(i,0*m).(proj(i,m).x - r);

theorem 
for m,i be Element of NAT, x be Point of REAL-NS m,
  p be Point of REAL-NS 1 holds
  (reproj(i,x)).p - x = reproj(i,0.(REAL-NS m)).(p - Proj(i,m).x) &
  x - (reproj(i,x)).p = reproj(i,0.(REAL-NS m)).(Proj(i,m).x - p);

theorem 
for m,n be non empty Element of NAT, i be Element of NAT,
    f be PartFunc of REAL-NS m,REAL-NS n,
    Z be Subset of REAL-NS m st Z is open & 1 <= i & i <= m holds
  f is_partial_differentiable_on Z,i
iff
  Z c=dom f &
  for x be Point of REAL-NS m st x in Z holds
    f is_partial_differentiable_in x,i;

theorem 
for x,y be Element of REAL,i be Element of NAT st 1 <= i & i <= m
  holds Replace(0*m,i,x+y) = Replace(0*m,i,x) + Replace(0*m,i,y);

theorem 
for x,a be Element of REAL,i be Element of NAT st
 1 <= i & i <= m holds Replace(0*m,i,a*x) = a*(Replace(0*m,i,x));

theorem 
for x be Element of REAL,i be Element of NAT st
 1 <= i & i <= m & x <> 0 holds Replace(0*m,i,x) <> 0*m;

theorem 
for x,y be Element of REAL, z be Element of REAL m, i be Element of NAT st
 1 <= i & i <= m & y = proj(i,m).z holds
  Replace(z,i,x) - z = Replace(0*m,i,x-y) &
  z - Replace(z,i,x) = Replace(0*m,i,y-x);

theorem 
for x,y be Element of REAL,i be Element of NAT st 1 <=i & i <= m holds
  reproj(i,0*m).(x+y) = reproj(i,0*m).x+reproj(i,0*m).y;

theorem 
for x,y be Point of REAL-NS 1,i be Element of NAT st 1 <=i & i <= m holds
  reproj(i,0.(REAL-NS m)).(x+y)
    = reproj(i,0.(REAL-NS m)).x+reproj(i,0.(REAL-NS m)).y;

theorem 
for x,a be Element of REAL,i be Element of NAT st 1 <=i & i <= m holds
  reproj(i,0*m).(a*x) = a*(reproj(i,0*m).x);

theorem 
for x be Point of REAL-NS 1, a be Element of REAL, i be Element of NAT st
 1 <=i & i <= m holds
   reproj(i,0.(REAL-NS m)).(a*x) = a*(reproj(i,0.(REAL-NS m)).x);

theorem 
for x be Element of REAL,i be Element of NAT st
  1 <=i & i <= m & x <> 0 holds reproj(i,0*m).x <> 0*m;

theorem 
for x be Point of REAL-NS 1, i be Element of NAT st
  1 <=i & i <= m & x <> 0.(REAL-NS 1) holds
    reproj(i,0.(REAL-NS m)).x <> 0.(REAL-NS m);

theorem 
for x,y be Element of REAL, z be Element of REAL m, i be Element of NAT st
 1 <= i & i <= m & y = proj(i,m).z holds
   reproj(i,z).x - z = reproj(i,0*m).(x-y) &
   z - reproj(i,z).x = reproj(i,0*m).(y-x);

theorem 
for x,y  be Point of REAL-NS 1,i be Element of NAT, z be Point of REAL-NS m st
 1 <=i & i <= m & y=Proj(i,m).z holds
   reproj(i,z).x - z = reproj(i,0.(REAL-NS m)).(x-y)
   & z - reproj(i,z).x = reproj(i,0.(REAL-NS m)).(y-x);

theorem 
f is_differentiable_in x & 1 <= i & i <= m implies
  f is_partial_differentiable_in x,i &
  partdiff(f,x,i) = diff(f,x) * reproj(i,0.(REAL-NS m));

theorem 
g is_differentiable_in y & 1 <=i & i <= m implies
g is_partial_differentiable_in y,i
& partdiff(g,y,i) = (diff(g,y)*reproj(i,0.(REAL-NS m))).<*1*>;

definition
   let n be non empty Element of NAT;
   let f be PartFunc of REAL n,REAL;
   let x be Element of REAL n;
 pred f is_differentiable_in x means

    <>*f is_differentiable_in x;
end;

definition
  let n be non empty Element of NAT;
  let f be PartFunc of REAL n,REAL;
  let x be Element of REAL n;
func diff(f,x) -> Function of REAL n,REAL equals

       proj(1,1)*diff(<>*f,x);
end;

theorem 
 h is_differentiable_in y & 1 <=i & i <= m implies
   h is_partial_differentiable_in y,i
   & partdiff(h,y,i) = diff(h*reproj(i,y),proj(i,m).y)
   & partdiff(h,y,i) = diff(h,y).(reproj(i,0*m).1);

theorem 
for m be non empty Element of NAT, v,w,u be FinSequence of REAL m st
 dom v = dom w & u = v + w holds Sum u = Sum v + Sum w;

theorem 
for m be non empty Element of NAT, r be Real, w,u be FinSequence of REAL m st
  u = r(#)w holds Sum u = r * Sum w;

theorem 
for n be non empty Element of NAT, h,g be FinSequence of REAL n st
 len h = len g + 1 &
 (for i be Nat st i in dom g holds g/.i = h /.i - h/.(i+1)) holds
   h /.1 - h/.(len h) = Sum g;

theorem 
for n be non empty Element of NAT, h,g,j be FinSequence of REAL n st
 len h= len j & len g= len j
 & (for i be Nat st i in dom j holds j/.i = h /.i - g/.i )
holds Sum j = Sum h - Sum g;

theorem 
for m,n be non empty Element of NAT, f be PartFunc of REAL m,REAL n,
   x,y be Element of REAL m holds
 ex h be FinSequence of REAL m, g be FinSequence of REAL n st
  len h = m+1 & len g = m &
  (for i be Nat st i in dom h holds h/.i = (y| (m+1-'i))^(0*(i-'1))) &
  (for i be Nat st i in dom g holds g/.i = f/.(x+h/.i) - f/.(x+h/.(i+1))) &
  (for i be Nat, hi be Element of REAL m st
    i in dom h & h/.i= hi holds |. hi .| <=|. y .|) &
  f /.(x+y) - f/.x = Sum g;

theorem 
for m be non empty Element of NAT, f be PartFunc of REAL m,REAL 1
 ex f0 be PartFunc of REAL m,REAL st f = <>*f0;

theorem 
for m,n be non empty Element of NAT, f be PartFunc of REAL m,REAL n,
    f0 be PartFunc of REAL-NS m,REAL-NS n,
    x be Element of REAL m,
    x0 be Element of REAL-NS m st
 x in dom f & x=x0 & f=f0 holds f/.x = f0/.x0;

definition
  let m be non empty Element of NAT;
  let X be Subset of REAL m;
  attr X is open means

   ex X0 be Subset of REAL-NS m st X0=X & X0 is open;
end;

theorem 
for m be non empty Element of NAT, X be Subset of REAL m holds X is open iff
 for x be Element of REAL m st x in X holds
   ex r be Real st r>0 & {y where y is Element of REAL m: |. y-x .| < r} c= X;

definition
  let m,n be non empty Element of NAT;
  let i be Element of NAT;
  let f be PartFunc of REAL m,REAL n;
  let X be set;
  pred f is_partial_differentiable_on X,i means

  X c=dom f & for x be
  Element of REAL m st x in X holds f|X is_partial_differentiable_in x,i;
end;

theorem 
for m,n be non empty Element of NAT, f be PartFunc of REAL m,REAL n st
  f is_partial_differentiable_on X,i holds X is Subset of REAL m;

theorem 
for m,n be non empty Element of NAT, i be Element of NAT,
    f be PartFunc of REAL m,REAL n,
    g be PartFunc of REAL-NS m,REAL-NS n,
    Z be set st
 f=g holds
  f is_partial_differentiable_on Z,i
     iff
  g is_partial_differentiable_on Z,i;

theorem 
for m,n be non empty Element of NAT, i be Element of NAT,
     f be PartFunc of REAL m,REAL n,
     Z be Subset of REAL m
     st Z is open & 1 <= i & i <= m holds
   f is_partial_differentiable_on Z,i
iff
   Z c=dom f &
   for x be Element of REAL m st x in Z holds
     f is_partial_differentiable_in x,i;

definition
  let m,n be non empty Element of NAT;
  let i be Element of NAT;
  let f be PartFunc of REAL m,REAL n;
  let X;
  assume  f is_partial_differentiable_on X,i;
func f `partial|(X,i) -> PartFunc of REAL m,REAL n means

  dom it = X &
  for x be Element of REAL m st x in X holds it/.x = partdiff(f,x,i);
end;

definition
  let m,n be non empty Element of NAT;
  let f be PartFunc of REAL m,REAL n;
  let x0 be Element of REAL m;
pred f is_continuous_in x0 means

  ex y0 be Point of REAL-NS m, g be PartFunc of REAL-NS m,REAL-NS n st
    x0=y0 & f=g & g is_continuous_in y0;
end;

theorem 
for m,n be non empty Element of NAT, f be PartFunc of REAL m,REAL n,
    g be PartFunc of REAL-NS m,REAL-NS n,
    x be Element of REAL m,
    y be Point of REAL-NS m
 st f=g & x=y holds
f is_continuous_in x iff g is_continuous_in y;

theorem 
 for m,n be non empty Element of NAT, f be PartFunc of REAL m,REAL n,
    x0 be Element of REAL m holds
 f is_continuous_in x0
      iff
 (x0 in dom f &
  for r be Real st 0<r
   ex s be Real st
    0<s &
    for x1 be Element of REAL m st x1 in dom f & |. x1- x0 .| < s
      holds |. f/.x1 - f/.x0 .| < r);

definition
   let m,n be non empty Element of NAT;
   let f be PartFunc of REAL m,REAL n;
   let X;
  pred f is_continuous_on X means

  X c= dom f &
  for x0 be Element of REAL m st x0 in X holds f|X is_continuous_in x0;
end;

theorem 
for m,n be non empty Element of NAT, f be PartFunc of REAL m,REAL n,
    g be PartFunc of REAL-NS m,REAL-NS n,
    X be set st f=g holds
 f is_continuous_on X iff g is_continuous_on X;

theorem 
for m,n be non empty Element of NAT, f be PartFunc of REAL m,REAL n,
    X be set holds
f is_continuous_on X iff
X c= dom f &
for x0 be Element of REAL m, r be Real st
 x0 in X & 0<r
 ex s be Real st 0<s & for x1 be Element of REAL m
    st x1 in X & |. x1- x0 .| <s holds |. f/.x1 - f/.x0 .| < r;

theorem 
for m be non empty Element of NAT, x,y be Element of REAL m,
    i be Element of NAT,
    xi be Real st
 1 <=i & i <= m & y=reproj(i,x).xi holds proj(i,m).y = xi;

theorem 
for m be non empty Element of NAT, f be PartFunc of REAL m,REAL,
    x,y be Element of REAL m,
    i be Element of NAT,
    xi be Real st 1 <= i & i <= m & y = reproj(i,x).xi
    holds reproj(i,x)=reproj(i,y);

theorem 
for m be non empty Element of NAT, f be PartFunc of REAL m,REAL,
    g be PartFunc of REAL ,REAL,
    x,y be Element of REAL m,
    i be Element of NAT,
    xi be Real st
1 <=i & i <= m & y=reproj(i,x).xi & g=f*reproj(i,x)
    holds diff(g,xi) = partdiff(f,y,i);

theorem 
for m be non empty Element of NAT, f be PartFunc of REAL m,REAL, p,q be Real,
    x be Element of REAL m,
    i be Element of NAT
 st 1 <= i & i <= m
    & p < q
    & (for h be Real st h in [. p,q .] holds reproj(i,x).h in dom f)
    & (for h be Real st h in [. p,q .] holds
         f is_partial_differentiable_in (reproj(i,x).h),i)
 holds
ex r be Real, y be Element of REAL m st
 r in ]. p,q .[ & y = reproj(i,x).r
& f/.(reproj(i,x).q) - f/.(reproj(i,x).p) = (q-p) * partdiff(f,y,i);

theorem 
for m be non empty Element of NAT, f be PartFunc of REAL m,REAL, p,q be Real,
    x be Element of REAL m,
    i be Element of NAT
 st 1 <=i & i <= m
    & p <= q
    & (for h be Real st h in [. p,q .] holds reproj(i,x).h in dom f)
    & (for h be Real st h in [. p,q .] holds
          f is_partial_differentiable_in (reproj(i,x).h),i) holds
ex r be Real, y be Element of REAL m st
  r in [. p,q .] & y = reproj(i,x).r
  & f/.(reproj(i,x).q) - f/.(reproj(i,x).p) = (q-p) * partdiff(f,y,i);

theorem 
for m be non empty Element of NAT, x,y,z,w be Element of REAL m,
    i be Element of NAT,
    d,p,q,r be Real
 st 1 <= i & i <= m & |. y-x .| < d & |. z-x .| < d
  & p= proj(i,m).y & z=reproj(i,y).q
  & r in [. p,q .] & w= reproj(i,y).r
holds |. w-x .| < d;

theorem 
for m be non empty Element of NAT, f be PartFunc of REAL m,REAL,
    X be Subset of REAL m,
    x,y,z be Element of REAL m,
    i be Element of NAT,
    d,p,q be Real st 1 <= i & i <= m &
    X is open & x in X &
    |. y-x .| < d & |. z-x .| < d &
    X c= dom f &
    (for x be Element of REAL m st x in X holds
      f is_partial_differentiable_in x,i) &
    0 < d &
    (for z be Element of REAL m st |. z-x .| < d holds z in X) &
    z = reproj(i,y).p & q = proj(i,m).y
 holds
  ex w be Element of REAL m st
   |. w-x .| < d &
   f is_partial_differentiable_in w,i &
   f/.z - f/.y = (p-q)*partdiff(f,w,i);

theorem 
  for m be non empty Element of NAT, h be FinSequence of REAL m,
  y,x be Element of REAL m,
  j be Element of NAT
  st len h = m+1 & 1 <= j & j <= m &
  (for i be Nat st i in dom h holds h/.i=(y| (m+1-'i))^(0*(i-'1)))
  holds x + h/.j = reproj(m+1-'j,(x+h/.(j+1))).(proj(m+1-'j,m).(x+y));

theorem 
for m be non empty Element of NAT, f be PartFunc of REAL m,REAL 1,
  X be Subset of REAL m,
  x be Element of REAL m
 st X is open & x in X &
   (for i be Element of NAT st 1 <=i & i <= m holds
      f is_partial_differentiable_on X,i &
      f`partial|(X,i) is_continuous_on X) holds
  f is_differentiable_in x &
  for h be Element of REAL m
   ex w be FinSequence of REAL 1 st
    dom w = Seg m &
    (for i be Element of NAT st i in Seg m holds
          w.i = (proj(i,m).h)*(partdiff(f,x,i)) )
   & diff(f,x).h = Sum w;

theorem 
for m be non empty Element of NAT, f be PartFunc of REAL-NS m,REAL-NS 1,
  X be Subset of REAL-NS m,
  x be Point of REAL-NS m st X is open & x in X &
   (for i be Element of NAT st 1 <=i & i <= m holds
           f is_partial_differentiable_on X,i &
           f`partial|(X,i) is_continuous_on X ) holds
f is_differentiable_in x &
 for h be Point of REAL-NS m
   ex w be FinSequence of REAL 1 st dom w = Seg m &
    (for i be Element of NAT st i in Seg m holds
          w.i = partdiff(f,x,i).<*(proj(i,m).h)*>)
   & diff(f,x).h=Sum(w);

theorem 
   for m be non empty Element of NAT, f be PartFunc of REAL-NS m,REAL-NS 1,
  X be Subset of REAL-NS m
  st X is open holds
  (for i be Element of NAT st 1 <=i & i <= m holds
  f is_partial_differentiable_on X,i &
  f`partial|(X,i) is_continuous_on X)
  iff
  f is_differentiable_on X & f`|X is_continuous_on X;














begin 

reserve G for Group,
  a,b for Element of G,
  m, n for Nat,
  p for prime Nat;

theorem 
  (for r being Nat holds n <> p |^ r) implies
  ex s being Element of NAT st s is prime & s divides n & s <> p;

theorem 
  for n,m being Nat holds n divides p |^ m implies
  ex r be Nat st n = p |^ r & r <= m;

theorem 
  a |^ n = 1_G implies a" |^ n = 1_G;

theorem 
  a" |^ n = 1_G implies a |^ n = 1_G;

theorem 
  ord (a") = ord a;

theorem 
  ord (a |^ b) = ord a;

theorem 
  for G being Group, N being Subgroup of G
  for a,b being Element of G holds
  N is normal & b in N implies
  for n ex g being Element of G st g in N & (a * b)|^ n = a |^ n * g;

theorem 
  for G being Group, N being normal Subgroup of G,
      a being Element of G, S being Element of G./.N holds
      S = a * N implies
  for n holds S |^ n = (a |^ n) * N;

theorem 
  for G being Group, H being Subgroup of G, a,b being Element of G
  holds a * H = b * H implies ex h being Element of G st a = b * h & h in H;

theorem 
  for G being finite Group, N being normal Subgroup of G holds
  N is Subgroup of center G & G./.N is cyclic
  implies G is commutative;

theorem 
  for G being finite Group, N being normal Subgroup of G holds
  N = center G & G./.N is cyclic implies G is commutative;

theorem 
  for G being finite Group, H being Subgroup of G holds
  card H <> card G implies ex a being Element of G st not a in H;

definition
  let p be Nat;
  let G be Group;
  let a be Element of G;
  attr a is p-power means

  ex r being Nat st ord a = p |^ r;
end;

theorem 
  1_G is m-power;

registration
  let G,m;
  cluster m-power for Element of G;
end;

registration
  let p,G;
  let a be p-power Element of G;
  cluster a" -> p-power;
end;

theorem 
  a |^ b is p-power implies a is p-power;

registration
  let p,G,b;
  let a be p-power Element of G;
  cluster a |^ b -> p-power;
end;

registration
  let p;
  let G be commutative Group, a,b be p-power Element of G;
  cluster a * b -> p-power;
end;

registration
  let p;
  let G be finite p-group Group;
  cluster -> p-power for Element of G;
end;

theorem 
  for G being finite Group,H being Subgroup of G
  for a being Element of G st H is p-group & a in H
  holds a is p-power;

registration
  let p;
  let G be finite p-group Group;
  cluster -> p-group for Subgroup of G;
end;

theorem 
  (1).G is p-group;

registration
  let p;
  let G be Group;
  cluster p-group for Subgroup of G;
end;

registration
  let p;
  let G be finite Group, G1 be p-group Subgroup of G, G2 be Subgroup of G;
  cluster G1 /\ G2 -> p-group;
  cluster G2 /\ G1 -> p-group;
end;

theorem 
  for G being finite Group st for a being Element of G holds a is p-power
  holds G is p-group;

registration
  let p;
  let G be finite p-group Group, N being normal Subgroup of G;
  cluster G./.N -> p-group;
end;

theorem 
  for G being finite Group, N being normal Subgroup of G
  st N is p-group & G./.N is p-group holds
  G is p-group;

theorem 
  for G being finite commutative Group,H,H1,H2 being Subgroup of G st
  H1 is p-group & H2 is p-group &
  the carrier of H = H1 * H2 holds H is p-group;

theorem 
  for G being finite Group, H,N being Subgroup of G holds
  N is normal Subgroup of G &
  H is p-group & N is p-group
  implies ex P being strict Subgroup of G st the carrier of P = H * N &
  P is p-group;

theorem 
  for G being finite Group,N1,N2 being normal Subgroup of G
  holds N1 is p-group &
  N2 is p-group implies ex N being strict normal Subgroup of G
  st the carrier of N = N1 * N2 & N is p-group;

registration
  let p;
  let G be p-group finite Group, H be finite Group, g be Homomorphism of G,H;
  cluster Image g -> p-group;
end;

theorem 
  for G,H being strict Group holds G,H are_isomorphic &
  G is p-group implies H is p-group;

definition
  let p be prime Nat;
  let G be Group such that
 G is p-group;
  func expon (G,p) -> Nat means


  card G = p |^ it;
end;

definition
  let p be prime Nat;
  let G be Group;
  redefine func expon (G,p) -> Element of NAT;
end;

theorem 
  for G being finite Group, H being Subgroup of G st
  G is p-group holds expon (H,p) <= expon (G,p);

theorem 
  for G being strict finite Group st G is p-group & expon (G,p) = 0 holds
  G = (1).G;

theorem 
  for G being strict finite Group holds G is p-group &
  expon (G,p) = 1 implies G is cyclic;

theorem 
  for G being finite Group,p being prime Nat
  for a being Element of G holds G is p-group & expon (G,p) = 2 &
  ord a = p |^2 implies G is commutative;

begin 

definition
  let p be Nat;
  let G be Group;
  attr G is p-commutative-group-like means


  for a,b be Element of G holds (a * b) |^ p = a |^ p * (b |^ p);
end;

definition
  let p be Nat;
  let G be Group;
  attr G is p-commutative-group means


  G is p-group p-commutative-group-like;
end;

registration
  let p be Nat;
  cluster p-commutative-group -> p-group p-commutative-group-like for Group;
  cluster p-group p-commutative-group-like -> p-commutative-group for Group;
end;

theorem 
  (1).G is p-commutative-group-like;

registration
  let p;
  cluster p-commutative-group finite cyclic commutative for Group;
end;

registration
  let p;
  let G be p-commutative-group-like finite Group;
  cluster -> p-commutative-group-like for Subgroup of G;
end;

registration
  let p;
  cluster p-group finite commutative -> p-commutative-group for Group;
end;

theorem 
  for G being strict finite Group st card G = p holds
  G is p-commutative-group;

registration
  let p,G;
  cluster p-commutative-group finite for Subgroup of G;
end;

registration
  let p;
  let G be finite Group, H1 be p-commutative-group-like Subgroup of G,
  H2 be Subgroup of G;
  cluster H1 /\ H2 -> p-commutative-group-like;
  cluster H2 /\ H1 -> p-commutative-group-like;
end;

registration
  let p;
  let G be finite p-commutative-group-like Group,
      N be normal Subgroup of G;
  cluster G./.N -> p-commutative-group-like;
end;

theorem 
  for G being finite Group,a,b being Element of G st
  G is p-commutative-group-like
  holds for n holds (a * b) |^ (p |^n) = a |^ (p |^n) * (b |^ (p |^n));

theorem 
  for G being finite commutative Group,H,H1,H2 being Subgroup of G st
  H1 is p-commutative-group & H2 is p-commutative-group &
  the carrier of H = H1 * H2 holds H is p-commutative-group;

theorem 
  for G being finite Group, H being Subgroup of G,
    N being strict normal Subgroup of G holds
    N is Subgroup of center G &
    H is p-commutative-group &
    N is p-commutative-group implies
  ex P being strict Subgroup of G st the carrier of P = H * N &
  P is p-commutative-group;

theorem 
  for G being finite Group,N1,N2 being normal Subgroup of G holds
  N2 is Subgroup of center G & N1 is p-commutative-group &
  N2 is p-commutative-group implies
  ex N being strict normal Subgroup of G
  st the carrier of N = N1 * N2 & N is p-commutative-group;

theorem 
  for G,H being Group holds G,H are_isomorphic &
  G is p-commutative-group-like implies H is p-commutative-group-like;

theorem 
  for G,H being strict Group holds G,H are_isomorphic &
  G is p-commutative-group implies H is p-commutative-group;

registration
  let p;
  let G be p-commutative-group-like finite Group, H be finite Group;
  let g be Homomorphism of G,H;
  cluster Image g -> p-commutative-group-like;
end;

theorem 
  for G being strict finite Group st G is p-group &
  expon (G,p) = 0 holds G is p-commutative-group;

theorem 
  for G being strict finite Group st G is p-group &
  expon (G,p) = 1 holds G is p-commutative-group;














begin 

reserve X for RealNormSpace;

definition
  let X be RealNormSpace;
  let A be non empty closed_interval Subset of REAL;
  let f be Function of A,the carrier of X;
  let D be Division of A;
  mode middle_volume of f,D -> FinSequence of X means

  len it = len D & for i be Nat st i in dom D holds
    ex c be Point of X st c in rng (f|divset(D,i)) &
      it.i= (vol divset(D,i)) * c;
end;

definition
  let X be RealNormSpace;
  let A be non empty closed_interval Subset of REAL;
  let f be Function of A,the carrier of X;
  let D be Division of A;
  let F be middle_volume of f,D;
  func middle_sum(f,F) -> Point of X equals

    Sum(F);
end;

definition
 let X be RealNormSpace;
 let A be non empty closed_interval Subset of REAL,
     f be Function of A,the carrier of X,
     T be DivSequence of A;
 mode middle_volume_Sequence of f,T -> Function of NAT,(the carrier of X)*
   means

 for k be Element of NAT holds it.k is middle_volume of f,T.k;
end;

definition
  let X be RealNormSpace;
  let A be non empty closed_interval Subset of REAL,
      f be Function of A,the carrier of X,
      T be DivSequence of A,
      S be middle_volume_Sequence of f,T,
      k be Element of NAT;
  redefine func S.k -> middle_volume of f,T.k;
end;

definition
 let X be RealNormSpace;
 let A be non empty closed_interval Subset of REAL,
     f be Function of A,the carrier of X,
     T be DivSequence of A,
     S be middle_volume_Sequence of f,T;
 func middle_sum(f,S) -> sequence of X means

 for i be Element of NAT holds it.i = middle_sum(f,S.i);
end;

begin 

definition
  let X be RealNormSpace;
  let A be non empty closed_interval Subset of REAL;
  let f be Function of A,the carrier of X;
  attr f is integrable means

  ex I be Point of X st for T being DivSequence of A,
     S be middle_volume_Sequence of f,T st
     delta(T) is convergent & lim delta(T) = 0 holds
     middle_sum(f,S) is convergent & lim (middle_sum(f,S)) = I;
end;

theorem 
  for X be RealNormSpace,
      R1, R2, R3 be FinSequence of X
        st len R1 = len R2 & R3 = R1 + R2 holds Sum(R3) = Sum(R1) + Sum(R2);

theorem 
  for X be RealNormSpace,
      R1, R2, R3 be FinSequence of X
        st len R1 = len R2 & R3 = R1 - R2 holds Sum(R3) = Sum(R1) - Sum(R2);

theorem 
  for X be RealNormSpace,
      R1, R2 be FinSequence of X,
      a be Element of REAL st R2 = a(#)R1 holds Sum(R2) = a * Sum(R1);

definition
  let X be RealNormSpace;
  let A be non empty closed_interval Subset of REAL;
  let f be Function of A,the carrier of X;
  assume  f is integrable;
  func integral(f) -> Point of X means

  for T being DivSequence of A,
      S be middle_volume_Sequence of f,T
        st delta(T) is convergent & lim delta(T)=0 holds
        middle_sum(f,S) is convergent & lim (middle_sum(f,S)) = it;
end;

theorem 
  for X be RealNormSpace,
      A be non empty closed_interval Subset of REAL,
      r be Real,
      f, h be Function of A,the carrier of X
        st h = r(#)f & f is integrable holds
        h is integrable & integral(h) = r * integral(f);

theorem 
  for X be RealNormSpace,
      A be non empty closed_interval Subset of REAL,
      f, h be Function of A,the carrier of X
        st h = -f & f is integrable holds
        h is integrable & integral(h) = -integral(f);

theorem 
  for X be RealNormSpace,
      A be non empty closed_interval Subset of REAL,
      f, g, h be Function of A,the carrier of X st
      h = f + g & f is integrable & g is integrable holds
        h is integrable & integral(h) = integral(f) + integral(g);

theorem 
  for X be RealNormSpace,
      A be non empty closed_interval Subset of REAL,
      f, g, h be Function of A,the carrier of X
        st h = f - g & f is integrable & g is integrable holds
        h is integrable & integral(h) = integral(f) - integral(g);

definition
  let X be RealNormSpace;
  let A be non empty closed_interval Subset of REAL;
  let f be PartFunc of REAL,the carrier of X;
  pred f is_integrable_on A means

  ex g be Function of A,the carrier of X st g = f|A & g is integrable;
end;

definition
  let X be RealNormSpace;
  let A be non empty closed_interval Subset of REAL;
  let f be PartFunc of REAL,the carrier of X;
  assume  A c= dom f;
  func integral(f,A) -> Element of X means

  ex g be Function of A,the carrier of X st g = f|A & it = integral(g);
end;

theorem 
  for A be non empty closed_interval Subset of REAL,
      f be PartFunc of REAL,the carrier of X,
      g be Function of A,the carrier of X
        st f|A = g holds f is_integrable_on A iff g is integrable;

theorem 
  for A be non empty closed_interval Subset of REAL,
      f be PartFunc of REAL,the carrier of X,
      g be Function of A,the carrier of X
        st A c= dom f & f|A = g holds integral(f,A) = integral(g);

theorem 
  for X, Y be non empty set,
      V be RealNormSpace,
      g, f be PartFunc of X,the carrier of V,
      g1, f1 be PartFunc of Y,the carrier of V
        st g = g1 & f = f1 holds g1 + f1 = g + f;

theorem 
  for X, Y be non empty set,
      V be RealNormSpace,
      g, f be PartFunc of X,the carrier of V,
      g1, f1 be PartFunc of Y,the carrier of V
        st g = g1 & f = f1 holds g1 - f1 = g - f;

theorem 
  for r be Real,
      X, Y be non empty set,
      V be RealNormSpace,
      g be PartFunc of X,the carrier of V,
      g1 be PartFunc of Y,the carrier of V
        st g = g1 holds r(#)g1 = r(#)g;

begin 

theorem 
  for r be Real
  for A be non empty closed_interval Subset of REAL
  for f be PartFunc of REAL,the carrier of X
    st A c= dom f & f is_integrable_on A holds
    r(#)f is_integrable_on A & integral((r(#)f),A) = r * integral(f,A);

theorem 
  for A be non empty closed_interval Subset of REAL,
      f1, f2 be PartFunc of REAL,the carrier of X
        st f1 is_integrable_on A & f2 is_integrable_on A &
        A c= dom f1 & A c= dom f2 holds
        f1 + f2 is_integrable_on A &
        integral(f1 + f2,A) = integral(f1,A) + integral(f2,A);

theorem 
  for A be non empty closed_interval Subset of REAL,
      f1, f2 be PartFunc of REAL,the carrier of X
        st f1 is_integrable_on A & f2 is_integrable_on A &
        A c= dom f1 & A c= dom f2 holds
        f1 - f2 is_integrable_on A &
        integral(f1 - f2,A) = integral(f1,A) - integral(f2,A);

definition
  let X be RealNormSpace;
  let f be PartFunc of REAL,the carrier of X;
  let a, b be real number;
  func integral(f,a,b) -> Element of X equals

  integral(f,[' a,b ']) if a <= b otherwise -integral(f,[' b,a ']);
end;

theorem 
  for f being PartFunc of REAL,the carrier of X,
      A being non empty closed_interval Subset of REAL,
      a, b be Real
        st A = [.a,b.] holds integral(f,A) = integral(f,a,b);

theorem 
  for f being PartFunc of REAL,the carrier of X,
      A being non empty closed_interval Subset of REAL
        st vol(A) = 0 & A c= dom f holds
        f is_integrable_on A & integral(f,A) = 0.X;

theorem 
  for f being PartFunc of REAL,the carrier of X,
      A being non empty closed_interval Subset of REAL,
      a, b be Real
        st A = [.b,a.] & A c= dom f holds -integral(f,A) = integral(f,a,b);














begin

registration
  let I be non empty set, F be Group-like multMagma-Family of I;
  let i be Element of I;
  cluster F.i -> Group-like for multMagma;
end;

registration
  let I be non empty set, F be associative multMagma-Family of I;
  let i be Element of I;
  cluster F.i -> associative for multMagma;
end;

registration
  let I be non empty set, F be commutative multMagma-Family of I;
  let i be Element of I;
  cluster F.i -> commutative for multMagma;
end;

reserve
  I for non empty set,
  F for associative Group-like multMagma-Family of I,
  i, j for Element of I;

theorem 
  for x be Function, g be Element of F.i holds
  ( dom x = I & x.i = g & for j be Element of I st j <> i holds x.j = 1_F.j )
  iff
  x = (1_product F)+*(i,g);

definition
  let I be non empty set,
  F be associative Group-like multMagma-Family of I,
  i be Element of I;
  func ProjSet(F,i) -> Subset of product F means

  for x be set holds x in it iff
  ex g be Element of F.i st x = 1_product F +* (i,g);
end;

registration
  let I be non empty set,
  F be associative Group-like multMagma-Family of I,
  i be Element of I;
  cluster ProjSet(F,i) -> non empty;
end;

theorem 
  for x0 be set holds x0 in ProjSet(F,i) iff
  ex x be Function,g be Element of F.i st x = x0 & dom x = I & x.i = g
  & for j be Element of I st j <> i holds x.j = 1_F.j;

theorem 
  for g1,g2 be Element of product F,
  z1,z2 be Element of F.i st
  g1 = (1_(product F))+* (i,z1) &
  g2 = (1_(product F))+* (i,z2) holds
  g1 * g2 = (1_product F)+* (i,z1*z2);

theorem 
  for g1 be Element of product F,
  z1 be Element of F.i st
  g1 = (1_product F)+* (i,z1) holds
  g1" = (1_product F)+* (i,z1");

theorem 
  for g1,g2 be Element of product F
  st g1 in ProjSet(F,i) & g2 in ProjSet(F,i)
  holds g1 * g2 in ProjSet(F,i);

theorem 
  for g be Element of product F st g in ProjSet(F,i)
  holds g" in ProjSet(F,i);

definition
  let I be non empty set,
  F be associative Group-like multMagma-Family of I,
  i be Element of I;
  func ProjGroup(F,i) -> strict Subgroup of product F means

  the carrier of it = ProjSet(F,i);
end;

definition let I, F, i;
  func 1ProdHom (F,i) -> Homomorphism of F.i, ProjGroup(F,i) means

  for x be Element of F.i holds it.x = 1_product F +* (i,x);
end;

registration let I, F, i;
  cluster 1ProdHom (F,i) -> bijective;
end;

registration
  let I,F,i;
  cluster ProjGroup(F,i) -> normal;
end;

theorem 
  for x,y be Element of product F st i <> j &
  x in ProjGroup(F,i) & y in ProjGroup(F,j) holds x*y = y*x;

reserve n for non empty Nat;

theorem 
  for F being associative Group-like multMagma-Family of Seg n,
  J be Nat,
  GJ be Group
  st 1 <= J & J <= n & GJ = F.J holds
  for x be Element of product F,
  s be FinSequence of product F st len s < J
  & (for k be Element of Seg n st k in dom s holds s.k in ProjGroup(F,k))
  & x = Product s holds x.J = 1_GJ;

theorem 
  for F be associative Group-like multMagma-Family of Seg n,
  x be Element of product F,
  s be FinSequence of product F st len s = n
  & (for k be Element of Seg n holds s.k in ProjGroup(F,k))
  & x = Product s holds
  for i be Nat st
  1<= i & i<= n holds
  ex si be Element of product F st si=s.i & x.i = si.i;

theorem 
  for F be associative Group-like multMagma-Family of Seg n,
  x be Element of product F,
  s,t be FinSequence of product F st len s = n
  & (for k be Element of Seg n holds s.k in ProjGroup(F,k)) &
  x=Product s & len t = n
  & (for k be Element of Seg n holds t.k in ProjGroup(F,k))
  & x=Product t holds s=t;

theorem 
  for F be associative Group-like multMagma-Family of Seg n,
  x be Element of product F
  ex s be FinSequence of product F st len s = n &
  (for k be Element of Seg n holds s.k in ProjGroup(F,k)) & x=Product s;

theorem 
  for G being commutative Group,
  F being associative Group-like multMagma-Family of Seg n
  st (for i be Element of Seg n holds F.i is Subgroup of G)
  & (for x be Element of G
  ex s be FinSequence of G st len s = n
  & (for k be Element of Seg n holds s.k in F.k) & x=Product s )
  & ( for s,t be FinSequence of G st
  len s = n & (for k be Element of Seg n holds s.k in F.k) & len t = n
  & (for k be Element of Seg n holds t.k in F.k)
  & Product s=Product t holds s=t ) holds
  ex f being Homomorphism of product F,G
  st f is bijective &
  for x be Element of product F
  ex s be FinSequence of G st len s= n &
  (for k be Element of Seg n holds s.k in F.k) & s=x & f.x = Product s;

theorem 
  for G,F being associative commutative Group-like multMagma-Family of Seg n
  st
  for k be Element of Seg n holds F.k = ProjGroup(G,k)
  holds
  ex f being Homomorphism of product F,product G
  st f is bijective &
  for x be Element of product F
  ex s be FinSequence of product G st len s= n &
  (for k be Element of Seg n holds s.k in F.k) & s=x & f.x = Product s;














begin 

  
  

begin  
       

theorem 
for x, y, z being real number st 0 <= x holds x*(y-'z) = x*y -' x*z;

theorem 
for x, y, z being Nat holds x in y \ z iff z <= x & x < y;

theorem 
for A, B, C, D, E, X being set
 st X c= A or X c= B or X c= C or X c= D or X c= E
  holds X c= A \/ B \/ C \/ D \/ E;

theorem 
for A, B, C, D, E, x being set holds
 x in A \/ B \/ C \/ D \/ E iff x in A or x in B or x in C or x in D or x in E;

theorem 
for R being symmetric RelStr, x, y being set
 st x in the carrier of R & y in the carrier of R &
    [x,y] in the InternalRel of R
  holds [y,x] in the InternalRel of R;

theorem 
for R being symmetric RelStr, x, y being Element of R st x <= y holds y <= x;

begin  

theorem 
for X being set, P being a_partition of X holds card P c= card X;

definition
  let X be set, P be a_partition of X, S be Subset of X;
  func P | S -> a_partition of S equals

    {x /\ S where x is Element of P: x meets S};
end;

registration
  let X be set;
  cluster finite for a_partition of X;
end;

registration
  let X be set, P be finite a_partition of X, S be Subset of X;
  cluster P | S -> finite;
end;

theorem 
for X being set, P being finite a_partition of X, S being Subset of X
 holds card (P | S) <= card P;

theorem 
for X being set, P being finite a_partition of X, S being Subset of X
 holds (for p being set st p in P holds p meets S)
   iff card (P | S) = card P;

theorem 
for R being RelStr, C being Coloring of R, S being Subset of R
 holds C | S is Coloring of subrelstr S;

begin 

      
      
      
      
      
      

definition
  let R be RelStr;  
  attr R is with_finite_chromatic# means

  ex C being Coloring of R st C is finite;
end;

registration
  cluster with_finite_chromatic# for RelStr;
end;

registration
  cluster finite -> with_finite_chromatic# for RelStr;
end;

registration
  let R be with_finite_chromatic# RelStr;
  cluster finite for Coloring of R;
end;

registration
  let R be with_finite_chromatic# RelStr, S be Subset of R;
  cluster subrelstr S -> with_finite_chromatic#;
end;

definition
  let R be with_finite_chromatic# RelStr;
  func chromatic# R -> Nat means

  (ex C being finite Coloring of R st card C = it)
   & for C being finite Coloring of R holds it <= card C;
end;

registration
  let R be empty RelStr;
  cluster chromatic# R -> empty;
end;

registration
  let R be non empty with_finite_chromatic#  RelStr;
  cluster chromatic# R -> positive;
end;

definition
  let R be RelStr;
  attr R is with_finite_cliquecover# means

  ex C being Clique-partition of R st C is finite;
end;

registration
  cluster with_finite_cliquecover# for RelStr;
end;

registration
  cluster finite -> with_finite_cliquecover# for RelStr;
end;

registration
  let R be with_finite_cliquecover# RelStr;
  cluster finite for Clique-partition of R;
end;

registration
  let R be with_finite_cliquecover# RelStr, S be Subset of R;
  cluster subrelstr S -> with_finite_cliquecover#;
end;

definition
  let R be with_finite_cliquecover# RelStr;
  func cliquecover# R -> Nat means

  (ex C being finite Clique-partition of R st card C = it)
   & for C being finite Clique-partition of R holds it <= card C;
end;

registration
  let R be empty RelStr;
  cluster cliquecover# R -> empty;
end;

registration
  let R be non empty with_finite_cliquecover# RelStr;
  cluster cliquecover# R -> positive;
end;

  
  

theorem 
for R being finite RelStr holds clique# R <= card the carrier of R;

theorem 
for R being finite RelStr holds stability# R <= card the carrier of R;

theorem 
for R being finite RelStr holds chromatic# R <= card the carrier of R;

theorem 
for R being finite RelStr holds cliquecover# R <= card the carrier of R;

theorem 
          
for R being with_finite_clique# with_finite_chromatic# RelStr
 holds clique# R <= chromatic# R;

theorem 
                
for R being with_finite_stability# with_finite_cliquecover# RelStr
 holds stability# R <= cliquecover# R;

begin 

theorem 
for R being RelStr, x, y being Element of R,
    a, b being Element of ComplRelStr R
 st x = a & y = b & x <= y holds not a <= b;

theorem 
for R being RelStr, x, y being Element of R,
    a, b being Element of ComplRelStr R
 st x = a & y = b & x <> y & x in the carrier of R & not a <= b holds x <= y;

registration
  let R be finite RelStr;
  cluster ComplRelStr R -> finite;
end;

theorem 
for R being symmetric RelStr, C being Clique of R
  holds C is StableSet of ComplRelStr R;

theorem 
for R being symmetric RelStr, C being Clique of ComplRelStr R
  holds C is StableSet of R;

theorem 
for R being RelStr, C being StableSet of R holds C is Clique of ComplRelStr R;

theorem 
for R being RelStr, C being StableSet of ComplRelStr R holds C is Clique of R;

registration
  let R be with_finite_clique# RelStr;
  cluster ComplRelStr R -> with_finite_stability#;
end;

registration
  let R be with_finite_stability# symmetric RelStr;
  cluster ComplRelStr R -> with_finite_clique#;
end;

theorem 
for R being with_finite_clique# symmetric RelStr
  holds clique# R = stability# ComplRelStr R;

theorem 
for R being with_finite_stability# symmetric RelStr
  holds stability# R = clique# ComplRelStr R;

theorem 
for R being RelStr, C being Coloring of R
  holds C is Clique-partition of ComplRelStr R;

theorem 
for R being symmetric RelStr, C being Clique-partition of ComplRelStr R
  holds C is Coloring of R;

theorem 
for R being symmetric RelStr, C being Clique-partition of R
  holds C is Coloring of ComplRelStr R;

theorem 
for R being RelStr, C being Coloring of ComplRelStr R
  holds C is Clique-partition of R;

registration
  let R be with_finite_chromatic# RelStr;
  cluster ComplRelStr R -> with_finite_cliquecover#;
end;

registration
  let R be with_finite_cliquecover# symmetric RelStr;
  cluster ComplRelStr R -> with_finite_chromatic#;
end;

theorem 
for R being with_finite_chromatic# symmetric RelStr
  holds chromatic# R = cliquecover# ComplRelStr R;

theorem 
for R being with_finite_cliquecover# symmetric RelStr
  holds cliquecover# R = chromatic# ComplRelStr R;

begin 

definition
 let R be RelStr, v be Element of R;
 func Adjacent v -> Subset of R  means

  for x being Element of R holds x in it iff x < v or v < x;
end;

theorem 
for R being with_finite_chromatic# RelStr,
    C being finite Coloring of R, c being set
 st c in C & card C = chromatic# R
  ex v being Element of R st v in c &
   for d being Element of C st d <> c
    ex w being Element of R st w in Adjacent(v) & w in d;

begin  

definition
  let n be Nat;
  mode NatRelStr of n -> strict RelStr means

   the carrier of it = n;
end;

registration
  cluster -> empty for NatRelStr of 0;
end;

registration
  let n be non empty Nat;
  cluster -> non empty for NatRelStr of n;
end;

registration
  let n be Nat;
  cluster -> finite for NatRelStr of n;
  cluster irreflexive for NatRelStr of n;
end;

definition
  let n be Nat;
  func CompleteRelStr n -> NatRelStr of n means

    the InternalRel of it = [: n, n :] \ id n;
end;

theorem 
for n being Nat, x,y being set
 st x in n & y in n
  holds [x,y] in the InternalRel of CompleteRelStr n iff x <> y;

registration
  let n be Nat;
  cluster CompleteRelStr n -> irreflexive symmetric;
end;

registration
  let n be Nat;
  cluster [#]CompleteRelStr n -> clique;
end;

theorem 
for n being Nat holds clique# CompleteRelStr n = n;

theorem 
for n being non empty Nat holds stability# CompleteRelStr n = 1;

theorem 
for n being Nat holds chromatic# CompleteRelStr n = n;

theorem 
for n being non empty Nat holds cliquecover# CompleteRelStr n = 1;

begin 

definition
  let n be Nat, R be NatRelStr of n;
                                              
  func Mycielskian R -> NatRelStr of 2*n+1 means

  the InternalRel of it =
      (the InternalRel of R)
   \/ { [x,y+n] where x, y is Element of NAT : [x,y] in the InternalRel of R }
   \/ { [x+n,y] where x, y is Element of NAT : [x,y] in the InternalRel of R }
   \/ [: {2*n}, 2*n \ n :]
   \/ [: 2*n \ n, {2*n} :];
end;

theorem 
for n being Nat, R being NatRelStr of n
 holds the carrier of R c= the carrier of Mycielskian R;

theorem 
for n being Nat, R being NatRelStr of n, x, y being Nat
 st [x,y] in the InternalRel of Mycielskian R
  holds x < n & y < n or x < n & n <= y & y < 2*n or n <= x & x < 2*n & y < n
     or x = 2*n & n <= y & y < 2*n or n <= x & x < 2*n & y = 2*n;

theorem 
for n being Nat, R being NatRelStr of n
 holds the InternalRel of R c= the InternalRel of Mycielskian R;

theorem 
for n being Nat, R being NatRelStr of n, x, y being set
 st x in n & y in n & [x,y] in the InternalRel of Mycielskian R
  holds [x,y] in the InternalRel of R;

theorem 
for n being Nat, R being NatRelStr of n, x, y being Nat
 st [x,y] in the InternalRel of R holds
         [x,y+n] in the InternalRel of Mycielskian R
       & [x+n,y] in the InternalRel of Mycielskian R;

theorem 
for n being Nat, R being NatRelStr of n, x, y being Nat
 st x in n & [x,y+n] in the InternalRel of Mycielskian R
  holds [x,y] in the InternalRel of R;

theorem 
for n being Nat, R being NatRelStr of n, x, y being Nat
 st y in n & [x+n,y] in the InternalRel of Mycielskian R
  holds [x,y] in the InternalRel of R;

theorem 
for n being Nat, R being NatRelStr of n, m being Nat
 st n <= m & m < 2*n
  holds [m,2*n] in the InternalRel of Mycielskian R
      & [2*n,m] in the InternalRel of Mycielskian R;

theorem 
for n being Nat, R being NatRelStr of n, S being Subset of Mycielskian R
 st S = n holds R = subrelstr S;

theorem 
for n being Nat, R being irreflexive NatRelStr of n
 st 2 <= clique# R holds clique# R = clique# Mycielskian R;

theorem 
for R being with_finite_chromatic# RelStr, S being Subset of R
 holds chromatic# R >= chromatic# subrelstr S;

theorem 
    
                       
                       
for n being Nat, R being irreflexive NatRelStr of n
 holds chromatic# Mycielskian R = 1 + chromatic# R;

definition
  let n be Nat;
  func Mycielskian n -> NatRelStr of 3*2|^n-'1 means

  ex myc being Function
   st it = myc.n & dom myc = NAT & myc.0 = CompleteRelStr 2 &
                    
                    
      for k being Nat, R being NatRelStr of 3*2|^k-'1
       st R = myc.k holds myc.(k+1) = Mycielskian R;
end;

theorem 
 Mycielskian 0 = CompleteRelStr 2 &
 for k being Nat holds Mycielskian (k+1) = Mycielskian Mycielskian k;

registration
  let n be Nat;
  cluster Mycielskian n -> irreflexive;
end;

registration
  let n be Nat;
  cluster Mycielskian n -> symmetric;
end;

theorem 
for n being Nat
 holds clique# Mycielskian n = 2 & chromatic# Mycielskian n = n+2;

theorem 
for n being Nat
 ex R being finite RelStr st clique# R = 2 & chromatic# R > n;

theorem 
for n being Nat
 ex R being finite RelStr st stability# R = 2 & cliquecover# R > n;














begin 

registration
  let x, y be set;
  cluster {[x,y]} -> one-to-one;
end;

reserve n for Nat;

theorem 
  for T being non empty TopSpace holds T , T | [#]T are_homeomorphic;

theorem 
  for X being non empty SubSpace of TOP-REAL n, f being Function of X,R^1
  st f is continuous
  ex g being Function of X,TOP-REAL n st
  (for a being Point of X, b being Point of TOP-REAL n, r being real number
  st a = b & f.a = r holds g.b = r*b) & g is continuous;

definition
  let n;
  let S be Subset of TOP-REAL n;
  attr S is ball means

  ex p being Point of TOP-REAL n, r being real number st S = Ball(p,r);
end;

registration
  let n;
  cluster ball for Subset of TOP-REAL n;
  cluster ball -> open for Subset of TOP-REAL n;
end;

registration
  let n;
  cluster non empty ball for Subset of TOP-REAL n;
end;

reserve p for Point of TOP-REAL n, r for real number;

theorem 
  for S being open Subset of TOP-REAL n st p in S holds
  ex B being ball Subset of TOP-REAL n st B c= S & p in B;

definition
  let n,p,r;
  func Tball(p,r) -> SubSpace of TOP-REAL n equals

  (TOP-REAL n) | Ball(p,r);
end;

definition
  let n;
  func Tunit_ball(n) -> SubSpace of TOP-REAL n equals

  Tball(0.(TOP-REAL n),1);
end;

registration
  let n;
  cluster Tunit_ball(n) -> non empty;
  let p;
  let s be positive real number;
  cluster Tball(p,s) -> non empty;
end;

theorem 
  the carrier of Tball(p,r) = Ball(p,r);

theorem 
  n <> 0 & p is Point of Tunit_ball(n) implies |. p .| < 1;

theorem 
  for f being Function of Tunit_ball n, TOP-REAL n st n <> 0 &
  for a being Point of Tunit_ball n, b being Point of TOP-REAL n
      st a = b holds f.a = 1/(1-|.b.|*|.b.|)*b
  holds f is being_homeomorphism;


theorem 
  for r being positive real number,
      f being Function of Tunit_ball(n), Tball(p,r) st n <> 0
  & for a being Point of Tunit_ball(n), b being Point of TOP-REAL n
      st a = b holds f.a = r*b+p
  holds f is being_homeomorphism;

theorem 
  Tunit_ball n, TOP-REAL n are_homeomorphic;

reserve q for Point of TOP-REAL n;

theorem 
  for r,s being positive real number holds
  Tball(p,r), Tball(q,s) are_homeomorphic;

theorem 
  for B being non empty ball Subset of TOP-REAL n
  holds B, [#]TOP-REAL n are_homeomorphic;

theorem 
  for M, N being non empty TopSpace
  for p being Point of M, U being a_neighborhood of p, B being open Subset of N
  st U,B are_homeomorphic
  ex V being open Subset of M, S being open Subset of N
     st V c= U & p in V & V,S are_homeomorphic;

begin 

reserve M for non empty TopSpace;

definition
  let n, M;
  attr M is n-locally_euclidean means

  for p being Point of M holds
  ex U being a_neighborhood of p, S being open Subset of TOP-REAL n
    st U,S are_homeomorphic;
end;

registration
  let n;
  cluster TOP-REAL n -> n-locally_euclidean;
end;

registration
  let n;
  cluster n-locally_euclidean for non empty TopSpace;
end;


theorem 
  M is n-locally_euclidean iff
  for p being Point of M holds
  ex U being a_neighborhood of p, B being ball Subset of TOP-REAL n
    st U,B are_homeomorphic;


theorem 
  M is n-locally_euclidean iff
  for p being Point of M holds
  ex U being a_neighborhood of p st U,[#]TOP-REAL n are_homeomorphic;

registration
  let n;
  cluster n-locally_euclidean -> first-countable for non empty TopSpace;
end;

registration
  cluster 0-locally_euclidean -> discrete for non empty TopSpace;
  cluster discrete -> 0-locally_euclidean for non empty TopSpace;
end;

registration
  let n;
  cluster TOP-REAL n -> second-countable;
end;

registration
  let n;
  cluster second-countable Hausdorff n-locally_euclidean for
non empty TopSpace;
end;

definition
  let n, M;
  attr M is n-manifold means

  M is second-countable Hausdorff n-locally_euclidean;
end;

definition
  let M;
  attr M is manifold-like means

  ex n st M is n-manifold;
end;

registration
  let n;
  cluster n-manifold for non empty TopSpace;
end;

registration
  let n;
  cluster n-manifold ->
          second-countable Hausdorff n-locally_euclidean for
non empty TopSpace;
  cluster second-countable Hausdorff n-locally_euclidean ->
          n-manifold for non empty TopSpace;
  cluster n-manifold -> manifold-like for non empty TopSpace;
end;

registration
  cluster second-countable discrete -> 0-manifold for non empty TopSpace;
end;


registration
  let n;
  let M be n-manifold non empty TopSpace;
  cluster open -> n-manifold for non empty SubSpace of M;
end;

registration
  cluster manifold-like for non empty TopSpace;
end;

definition
  mode manifold is manifold-like non empty TopSpace;
end;














begin 

reserve n,m,k for Element of NAT;
reserve x,X,X1 for set;
reserve r,p for Real;
reserve s,g,x0,x1,x2 for real number;
reserve S,T for RealNormSpace;
reserve f,f1,f2 for PartFunc of REAL,the carrier of S;
reserve s1,s2 for Real_Sequence;
reserve Y for Subset of REAL;

theorem 
for seq be Real_Sequence, h be PartFunc of REAL, the carrier of S
 st rng seq c= dom h holds seq.n in dom h;

theorem 
for h1,h2 be PartFunc of REAL,the carrier of S
for seq be Real_Sequence
  st rng seq c= dom h1 /\ dom h2
    holds (h1+h2)/*seq = h1/*seq + h2/*seq & (h1-h2)/*seq = h1/*seq - h2/*seq;

theorem 
for h be sequence of S,r be Real holds r(#)h = r*h;

theorem 
for h be PartFunc of REAL,the carrier of S,
    seq be Real_Sequence, r be Real
 st rng seq c= dom h holds (r(#)h)/*seq = r*(h/*seq);

theorem 
for h be PartFunc of REAL,the carrier of S,
    seq be Real_Sequence
 st rng seq c= dom h
  holds ||.h/*seq .|| = ||.h.||/*seq
      & -(h/*seq) = (-h)/*seq;

begin 

definition
  let S,f,x0;
  pred f is_continuous_in x0 means

    x0 in dom f
  & for s1 st rng s1 c= dom f & s1 is convergent & lim s1 = x0
     holds f/*s1 is convergent & f/.x0 = lim (f/*s1);
end;

theorem 
x0 in X & f is_continuous_in x0 implies f|X is_continuous_in x0;

theorem 
f is_continuous_in x0 iff
x0 in dom f
& for s1 st rng s1 c= dom f & s1 is convergent
        & lim s1 = x0 & (for n holds s1.n<>x0)
  holds f/*s1 is convergent & f/.x0 = lim(f/*s1);

theorem 
f is_continuous_in x0 iff
x0 in dom f &
for r st 0 < r ex s
  st 0 < s & for x1 st x1 in dom f & abs(x1-x0) < s
               holds ||. f/.x1 - f/.x0 .|| < r;

theorem 
for S,f,x0 holds f is_continuous_in x0 iff
  x0 in dom f
& for N1 being Neighbourhood of f/.x0
    ex N being Neighbourhood of x0
      st for x1 st x1 in dom f & x1 in N holds f/.x1 in N1;

theorem 
for S,f,x0 holds
 f is_continuous_in x0
iff x0 in dom f
  & for N1 being Neighbourhood of f/.x0
      ex N being Neighbourhood of x0 st f.:N c= N1;

theorem 
(ex N be Neighbourhood of x0 st dom f /\ N = {x0})
  implies f is_continuous_in x0;

theorem 
x0 in dom f1 /\ dom f2 & f1 is_continuous_in x0 & f2 is_continuous_in x0
  implies f1+f2 is_continuous_in x0 & f1-f2 is_continuous_in x0;

theorem 
f is_continuous_in x0 implies r(#)f is_continuous_in x0;

theorem 
x0 in dom f & f is_continuous_in x0
 implies ||.f.|| is_continuous_in x0 & -f is_continuous_in x0;

theorem 
for f1 be PartFunc of REAL,the carrier of S,
    f2 be PartFunc of the carrier of S,the carrier of T
     st x0 in dom (f2*f1) & f1 is_continuous_in x0
      & f2 is_continuous_in f1/.x0
  holds f2*f1 is_continuous_in x0;

definition let S,f;
  attr f is continuous means

    for x0 st x0 in dom f holds f is_continuous_in x0;
end;

theorem 
for X,f st X c= dom f holds f|X is continuous
 iff for s1 st rng s1 c= X & s1 is convergent & lim s1 in X
       holds f/*s1 is convergent & f/.(lim s1) = lim (f/*s1);

theorem 
X c= dom f implies
 (f|X is continuous
   iff for x0,r st x0 in X & 0 < r ex s
         st 0 < s & for x1 st x1 in X & abs(x1-x0) < s
                      holds ||. f/.x1 - f/.x0 .|| < r);

registration let S;
 cluster constant -> continuous for PartFunc of REAL,the carrier of S;
end;

registration let S;
  cluster continuous for PartFunc of REAL,the carrier of S;
end;

registration let S;
  let f be continuous PartFunc of REAL,the carrier of S, X be set;
  cluster f|X -> continuous for PartFunc of REAL,the carrier of S;
end;

theorem 
f|X is continuous & X1 c= X implies f|X1 is continuous;

registration let S;
  cluster empty -> continuous for PartFunc of REAL,the carrier of S;
end;

registration let S,f;
  let X be trivial set;
 cluster f|X -> continuous for PartFunc of REAL,the carrier of S;
end;

registration
  let S;
  let f1,f2 be continuous PartFunc of REAL,the carrier of S;
 cluster f1+f2 -> continuous for PartFunc of REAL,the carrier of S;
cluster f1-f2 -> continuous for PartFunc of REAL,the carrier of S;
end;

theorem 
for X,f1,f2 st X c= dom f1 /\ dom f2 & f1|X is continuous & f2|X is continuous
 holds (f1+f2)|X is continuous & (f1-f2)|X is continuous;

theorem 
for X,X1,f1,f2 st X c= dom f1 & X1 c= dom f2
 & f1|X is continuous & f2|X1 is continuous
   holds (f1+f2)|(X /\ X1) is continuous & (f1-f2)|(X /\ X1) is continuous;

registration
  let S;
  let f be continuous PartFunc of REAL,the carrier of S;
  let r;
  cluster r(#)f -> continuous for PartFunc of REAL,the carrier of S;
end;

theorem 
X c= dom f & f|X is continuous implies (r(#)f)|X is continuous;

theorem 
X c= dom f & f|X is continuous
  implies (||.f.||)|X is continuous & (-f)|X is continuous;

theorem 
f is total & (for x1,x2 holds f/.(x1+x2) = f/.x1 + f/.x2)
  & (ex x0 st f is_continuous_in x0)
implies f|REAL is continuous;

theorem 
dom f is compact & f|(dom f) is continuous implies rng f is compact;

theorem 
Y c= dom f & Y is compact & f|Y is continuous implies (f.:Y) is compact;

begin 

definition let S,f;
  attr f is Lipschitzian means

    ex r be real number st 0<r & for x1,x2 st x1 in dom f &
    x2 in dom f holds ||.f/.x1-f/.x2.||<=r*abs(x1-x2);
end;

theorem 
f|X is Lipschitzian
iff ex r be real number st 0<r & for x1,x2 st x1 in dom(f|X) & x2 in dom(f|X)
     holds ||. f/.x1-f/.x2 .|| <= r*abs(x1-x2);

registration let S;
  cluster empty -> Lipschitzian for PartFunc of REAL,the carrier of S;
end;

registration let S;
  cluster empty for PartFunc of REAL,the carrier of S;
end;

registration
  let S;
  let f be Lipschitzian PartFunc of REAL,the carrier of S, X be set;
  cluster f|X -> Lipschitzian for PartFunc of REAL,the carrier of S;
end;

theorem 
f|X is Lipschitzian & X1 c= X implies f|X1 is Lipschitzian;

registration
  let S;
  let f1,f2 be Lipschitzian PartFunc of REAL,the carrier of S;
  cluster f1+f2 -> Lipschitzian for PartFunc of REAL,the carrier of S;
  cluster f1-f2 -> Lipschitzian for PartFunc of REAL,the carrier of S;
end;

theorem 
f1|X is Lipschitzian & f2|X1 is Lipschitzian
 implies (f1+f2)|(X /\ X1) is Lipschitzian;

theorem 
f1|X is Lipschitzian & f2|X1 is Lipschitzian
 implies (f1-f2)|(X /\ X1) is Lipschitzian;

registration
  let S;
  let f be Lipschitzian PartFunc of REAL, the carrier of S;
  let p;
  cluster p(#)f -> Lipschitzian for PartFunc of REAL, the carrier of S;
end;

theorem 
f|X is Lipschitzian & X c= dom f implies (p(#)f) | X is Lipschitzian;

registration let S;
             let f be Lipschitzian PartFunc of REAL, the carrier of S;
  cluster ||. f .|| -> Lipschitzian for PartFunc of REAL,REAL;
end;

theorem 
f|X is Lipschitzian
 implies -(f|X) is Lipschitzian & (-f)|X is Lipschitzian
   & (||.f.||)|X is Lipschitzian;

registration let S;
  cluster constant -> Lipschitzian for PartFunc of REAL, the carrier of S;
end;

registration let S;
  cluster Lipschitzian -> continuous for PartFunc of REAL, the carrier of S;
end;

theorem 
(ex r be Point of S st rng f = {r}) implies f is continuous;

theorem 
for r, p be Point of S st (for x0 st x0 in X holds f/.x0 = x0*r+p)
 holds f|X is continuous;














begin 

reserve G,F for RealLinearSpace;

theorem 
  for D,E,F,G be non empty set
  ex I be Function of [: [:D,E:],[:F,G:] :], [:[:D,F:],[:E,G:]:]
  st I is one-to-one & I is onto
  & for d,e,f,g be set st d in D & e in E & f in F & g in G
  holds I.([d,e],[f,g]) = [[d,f],[e,g]];

theorem 
  for X be non empty set, D be Function st dom D = {1} & D.1 = X
  ex I be Function of X,product D
  st I is one-to-one & I is onto
  & for x be set st x in X holds I.x = <*x*>;

theorem 
  for X,Y be non empty set, D be Function
  st dom D = {1,2} & D.1 = X & D.2 = Y
  ex I be Function of [:X,Y:],product D
  st I is one-to-one & I is onto
  & for x,y be set st x in X & y in Y holds I.(x,y) = <*x,y*>;

theorem 
  for X be non empty set
  ex I be Function of X,product <*X*>
  st I is one-to-one & I is onto
  & for x be set st x in X holds I.x = <*x*>;

registration
  let X,Y be non-empty non empty FinSequence;
  cluster X^Y -> non-empty;
end;

theorem 
  for X,Y be non empty set
  ex I be Function of [:X,Y:],product <*X,Y*>
  st I is one-to-one & I is onto
  & for x,y be set st x in X & y in Y holds I.(x,y) = <*x,y*>;

theorem 
  for X,Y be non-empty non empty FinSequence
  ex I be Function of [: product X,product Y :],product(X^Y)
  st I is one-to-one & I is onto
  & for x,y be FinSequence st x in product X & y in product Y
  holds I.(x,y) = x^y;

definition
  let G,F be non empty addLoopStr;
  func prod_ADD(G,F) -> BinOp of [:the carrier of G,the carrier of F:] means


  for g1,g2 be Point of G, f1,f2 be Point of F
  holds it.([g1,f1],[g2,f2]) = [g1+g2,f1+f2];
end;

definition let G,F be non empty RLSStruct;
  func prod_MLT(G,F) -> Function of
  [:REAL, [:the carrier of G,the carrier of F:] :],
  [:the carrier of G,the carrier of F:] means

  for r be Element of REAL, g be Point of G, f be Point of F
  holds it.(r,[g,f]) = [r*g,r*f];
end;

definition let G,F be non empty addLoopStr;
  func prod_ZERO(G,F) -> Element of [:the carrier of G,the carrier of F:]
  equals

[0.G,0.F];
end;

definition let G,F be non empty addLoopStr;
  func [:G,F:] -> strict non empty addLoopStr equals

  addLoopStr (# [:the carrier of G,the carrier of F:],
  prod_ADD(G,F), prod_ZERO(G,F) #);
end;

registration
  let G,F be Abelian non empty addLoopStr;
  cluster [:G,F:] -> Abelian;
end;

registration
  let G,F be add-associative non empty addLoopStr;
  cluster [:G,F:] -> add-associative;
end;

registration
  let G,F be right_zeroed non empty addLoopStr;
  cluster [:G,F:] -> right_zeroed;
end;

registration
  let G,F be right_complementable non empty addLoopStr;
  cluster [:G,F:] -> right_complementable;
end;

theorem 
  for G,F be non empty addLoopStr holds
  ( for x be set holds
  (x is Point of [:G,F:]
  iff ex x1 be Point of G, x2 be Point of F st x=[x1,x2]) )
  & ( for x,y be Point of [:G,F:],
  x1,y1 be Point of G ,x2,y2 be Point of F
  st x=[x1,x2] & y=[y1,y2] holds x+y = [x1+y1,x2+y2] )
  & 0.[:G,F:] = [0.G,0.F];

theorem 
  for G,F be add-associative right_zeroed
  right_complementable non empty addLoopStr,
  x be Point of [:G,F:], x1 be Point of G, x2 be Point of F
  st x=[x1,x2] holds -x = [-x1,-x2];

registration
  let G,F be Abelian add-associative
  right_zeroed right_complementable strict non empty addLoopStr;
  cluster [:G,F:] -> strict Abelian add-associative
    right_zeroed right_complementable;
end;

definition let G,F be non empty RLSStruct;
  func [:G,F:] -> strict non empty RLSStruct equals

  RLSStruct (# [:the carrier of G,the carrier of F:],
  prod_ZERO(G,F), prod_ADD(G,F), prod_MLT(G,F) #);
end;

registration
  let G,F be Abelian non empty RLSStruct;
  cluster [:G,F:] -> Abelian;
end;

registration
  let G,F be add-associative non empty RLSStruct;
  cluster [:G,F:] -> add-associative;
end;

registration
  let G,F be right_zeroed non empty RLSStruct;
  cluster [:G,F:] -> right_zeroed;
end;

registration
  let G,F be right_complementable non empty RLSStruct;
  cluster [:G,F:] -> right_complementable;
end;

theorem 
  for G,F be non empty RLSStruct holds
  ( for x be set holds
  (x is Point of [:G,F:]
  iff ex x1 be Point of G, x2 be Point of F st x=[x1,x2]) )
  & ( for x,y be Point of [:G,F:], x1,y1 be Point of G, x2,y2 be Point of F
  st x=[x1,x2] & y=[y1,y2] holds x+y = [x1+y1,x2+y2] )
  & 0.[:G,F:] = [0.G,0.F]
  & ( for x be Point of [:G,F:], x1 be Point of G, x2 be Point of F,
  a be real number
  st x=[x1,x2] holds a*x = [a*x1,a*x2] );

theorem 
  for G,F be add-associative right_zeroed
  right_complementable non empty RLSStruct,
  x be Point of [:G,F:], x1 be Point of G, x2 be Point of F
  st x=[x1,x2] holds -x = [-x1,-x2];

registration
  let G,F be vector-distributive non empty RLSStruct;
  cluster [:G,F:] -> vector-distributive;
end;

registration
  let G,F be scalar-distributive non empty RLSStruct;
  cluster [:G,F:] -> scalar-distributive;
end;

registration
  let G,F be scalar-associative non empty RLSStruct;
  cluster [:G,F:] -> scalar-associative;
end;

registration
  let G,F be scalar-unital non empty RLSStruct;
  cluster [:G,F:] -> scalar-unital;
end;

registration
  let G be Abelian add-associative right_zeroed right_complementable
  scalar-distributive vector-distributive scalar-associative
  scalar-unital non empty RLSStruct;
  cluster <* G *> -> RealLinearSpace-yielding;
end;

registration
  let G,F be Abelian add-associative right_zeroed right_complementable
  scalar-distributive vector-distributive scalar-associative
  scalar-unital non empty RLSStruct;
  cluster <* G,F *> -> RealLinearSpace-yielding;
end;

begin 

theorem 
  for X be RealLinearSpace holds
  ex I be Function of X, product <*X*>
  st I is one-to-one & I is onto
  & ( for x be Point of X holds I.x = <*x*> )
  & ( for v,w be Point of X holds I.(v+w) = I.v + I.w )
  & ( for v be Point of X, r be Element of REAL
  holds I.(r*v)=r*(I.v) )
  & I.(0.X)=0.product <*X*>;

registration
  let G,F be non empty RealLinearSpace-yielding FinSequence;
  cluster G^F -> RealLinearSpace-yielding;
end;

theorem 
  for X,Y be RealLinearSpace holds
  ex I be Function of [:X,Y:],product <*X,Y*>
  st I is one-to-one & I is onto
  & ( for x be Point of X, y be Point of Y holds I.(x,y) = <*x,y*> )
  & ( for v,w be Point of [:X,Y:] holds I.(v+w)=(I.v) + (I.w) )
  & ( for v be Point of [:X,Y:], r be Element of REAL
  holds I.(r*v)=r*(I.v) )
  & I.(0.[:X,Y:])=0.product <*X,Y*>;

theorem 
  for X,Y be non empty RealLinearSpace-Sequence
  holds ex I be Function of [:product X,product Y:],product (X^Y)
  st I is one-to-one & I is onto
  & ( for x be Point of product X, y be Point of product Y
  holds ex x1,y1 be FinSequence st x=x1 & y=y1 & I.(x,y) = x1^y1 )
  & ( for v,w be Point of [:product X,product Y:]
  holds I.(v+w) = I.v + I.w )
  & ( for v be Point of [:product X,product Y:], r be Element of REAL
  holds I.(r*v)=r*(I.v) )
  & I.(0.[:product X,product Y:]) = 0.product (X^Y);

theorem 
  for G,F be RealLinearSpace holds
  ( for x be set holds
  ( x is Point of product <*G,F*>
  iff ex x1 be Point of G, x2 be Point of F st x=<* x1,x2 *> ) )
  & ( for x,y be Point of product <*G,F*>,
  x1,y1 be Point of G ,x2,y2 be Point of F
  st x = <*x1,x2*> & y = <*y1,y2*>
  holds x+y = <*x1+y1,x2+y2*> )
  & 0.(product <*G,F*>) = <* 0.G,0.F *>
  & ( for x be Point of product <*G,F*>, x1 be Point of G, x2 be Point of F
  st x=<* x1,x2 *> holds -x = <* -x1,-x2 *> )
  & ( for x be Point of product <*G,F*>, x1 be Point of G, x2 be Point of F,
  a be real number
  st x = <*x1,x2*> holds a*x = <* a*x1,a*x2 *> );

begin 

definition let G,F be non empty NORMSTR;
  func prod_NORM(G,F) -> Function of
  [:the carrier of G,the carrier of F:], REAL means

  for g be Point of G, f be Point of F
  holds ex v be Element of REAL 2
  st v= <* ||.g.||,||.f.|| *> & it.(g,f) = |.v.|;
end;

definition let G,F be non empty NORMSTR;
  func [:G,F:] -> strict non empty NORMSTR equals

  NORMSTR (# [:the carrier of G,the carrier of F:],
  prod_ZERO(G,F), prod_ADD(G,F), prod_MLT(G,F), prod_NORM(G,F) #);
end;

registration
  let G,F be RealNormSpace;
  cluster [:G,F:] -> reflexive discerning RealNormSpace-like;
end;

registration
  let G,F be reflexive discerning RealNormSpace-like
  scalar-distributive vector-distributive scalar-associative
  scalar-unital Abelian add-associative
  right_zeroed right_complementable non empty NORMSTR;
  cluster [:G,F:] -> strict reflexive discerning RealNormSpace-like
  scalar-distributive vector-distributive scalar-associative
  scalar-unital Abelian add-associative right_zeroed right_complementable;
end;

registration
  let G be reflexive discerning RealNormSpace-like scalar-distributive
  vector-distributive scalar-associative scalar-unital Abelian
  add-associative right_zeroed right_complementable non empty NORMSTR;
  cluster <*G*> -> RealNormSpace-yielding;
end;

registration
  let G,F be reflexive discerning RealNormSpace-like scalar-distributive
  vector-distributive scalar-associative scalar-unital Abelian
  add-associative right_zeroed right_complementable non empty NORMSTR;
  cluster <*G,F*> -> RealNormSpace-yielding;
end;

theorem 
  for X,Y be RealNormSpace
  holds ex I be Function of [:X,Y:],product <*X,Y*>
  st I is one-to-one & I is onto
  & ( for x be Point of X, y be Point of Y holds I.(x,y) = <*x,y*> )
  & ( for v,w be Point of [:X,Y:] holds I.(v+w) = I.v + I.w )
  & ( for v be Point of [:X,Y:], r be Element of REAL
  holds I.(r*v)=r*(I.v) )
  & 0. product <*X,Y*> = I.(0.[:X,Y:])
  & ( for v be Point of [:X,Y:] holds ||. I.v .|| = ||.v.|| );

theorem 
  for X be RealNormSpace
  holds ex I be Function of X ,product <*X*>
  st I is one-to-one & I is onto
  & ( for x be Point of X holds I.x = <*x*> )
  & ( for v,w be Point of X holds I.(v+w) = I.v + I.w )
  & ( for v be Point of X, r be Element of REAL holds I.(r*v)=r*(I.v) )
  & 0. product <*X*> = I.(0.X)
  & ( for v be Point of X holds ||. I.v .|| = ||.v.|| );

registration
  let G,F be non empty RealNormSpace-yielding FinSequence;
  cluster G^F -> non empty RealNormSpace-yielding;
end;

theorem 
  for X,Y be non empty RealNormSpace-Sequence
  holds ex I be Function of [:product X,product Y:],product (X^Y)
  st I is one-to-one & I is onto
  & ( for x be Point of product X, y be Point of product Y
  holds ex x1,y1 be FinSequence st x=x1 & y=y1 & I.(x,y) = x1^y1 )
  & ( for v,w be Point of [:product X,product Y:] holds I.(v+w) = I.v + I.w )
  & ( for v be Point of [:product X,product Y:], r be Element of REAL
  holds I.(r*v)=r*(I.v) )
  & I.(0.[:product X,product Y:]) = 0.product (X^Y)
  & ( for v be Point of [:product X,product Y:] holds ||. I.v .|| = ||.v.|| );

theorem 
  for G,F be RealNormSpace holds
  ( for x be set holds
  ( x is Point of [:G,F:]
  iff ex x1 be Point of G ,x2 be Point of F st x=[x1,x2]) )
  & ( for x,y be Point of [:G,F:], x1,y1 be Point of G, x2,y2 be Point of F
  st x=[x1,x2] & y=[y1,y2] holds x+y = [x1+y1,x2+y2] )
  & 0.[:G,F:] = [0.G,0.F]
  & ( for x be Point of [:G,F:], x1 be Point of G, x2 be Point of F
  st x=[x1,x2] holds -x = [-x1,-x2] )
  & ( for x be Point of [:G,F:], x1 be Point of G, x2 be Point of F,
  a be real number
  st x=[x1,x2] holds a*x = [a*x1,a*x2] )
  & ( for x be Point of [:G,F:], x1 be Point of G, x2 be Point of F
  st x=[x1,x2] holds
  ex w be Element of REAL 2 st
  w=<* ||.x1.||,||.x2.|| *> & ||.x.|| = |.w.| );

theorem 
  for G,F be RealNormSpace holds
  ( for x be set holds
  ( x is Point of product <*G,F*>
  iff ex x1 be Point of G, x2 be Point of F st x=<* x1,x2 *> ) )
  & ( for x,y be Point of product <*G,F*>,
  x1,y1 be Point of G, x2,y2 be Point of F
  st x=<*x1,x2*> & y=<*y1,y2*> holds x+y = <* x1+y1,x2+y2 *> )
  & 0.(product <*G,F*>) = <* 0.G,0.F *>
  & ( for x be Point of product <*G,F*>, x1 be Point of G, x2 be Point of F
  st x=<*x1,x2*> holds -x = <* -x1,-x2 *> )
  & ( for x be Point of product <*G,F*>,
  x1 be Point of G, x2 be Point of F, a be real number
  st x=<*x1,x2*> holds a*x = <* a*x1,a*x2 *> )
  & ( for x be Point of product <*G,F*>, x1 be Point of G, x2 be Point of F
  st x=<*x1,x2*> holds
  ex w be Element of REAL 2 st
  w=<* ||.x1.||,||.x2.|| *> & ||.x.||  = |.w.| );

registration
  let X,Y be complete RealNormSpace;
  cluster [:X,Y:] -> complete;
end;

theorem 
  for X,Y be non empty RealNormSpace-Sequence
  holds ex I be Function of product <* product X,product Y *>,product (X^Y)
  st I is one-to-one & I is onto
  & ( for x be Point of product X, y be Point of product Y
  holds ex x1,y1 be FinSequence
  st x=x1 & y=y1 & I.<*x,y*> = x1^y1 )
  & ( for v,w be Point of product <* product X,product Y *>
  holds I.(v+w) = I.v + I.w )
  & ( for v be Point of product <* product X,product Y *>,
  r be Element of REAL
  holds I.(r*v)=r*(I.v) )
  & I.(0.(product <* product X,product Y *>)) = 0.product (X^Y)
  & ( for v be Point of product <* product X,product Y *>
  holds ||. I.v .|| = ||.v.|| );

theorem 
  for X,Y be non empty RealLinearSpace
  holds ex I be Function of [:X,Y:],[:X,product <*Y*>:]
  st I is one-to-one & I is onto
  & ( for x be Point of X, y be Point of Y holds I.(x,y) = [x,<*y*>] )
  & ( for v,w be Point of [:X,Y:] holds I.(v+w) = I.v + I.w )
  & ( for v be Point of [:X,Y:], r be Element of REAL
  holds I.(r*v)=r*(I.v) )
  & I.(0.[:X,Y:]) = 0.([:X,product<*Y*>:]);

theorem 
  for X be non empty RealLinearSpace-Sequence, Y be RealLinearSpace
  holds ex I be Function of [:product X,Y:],product(X^<*Y*>)
  st I is one-to-one & I is onto
  & ( for x be Point of product X, y be Point of Y
  ex x1,y1 be FinSequence st x=x1 & <*y*> =y1 & I.(x,y) = x1^y1 )
  & ( for v,w be Point of [:product X,Y:] holds I.(v+w) = I.v + I.w )
  & ( for v be Point of [:product X,Y:], r be Element of REAL
  holds I.(r*v)=r*(I.v) )
  & I.(0.[:product X,Y:]) = 0.product (X^<*Y*>);

theorem 
  for X ,Y be non empty RealNormSpace
  ex I be Function of [:X,Y:],[:X,product<*Y*>:]
  st I is one-to-one & I is onto
  & ( for x be Point of X, y be Point of Y holds I.(x,y) = [x,<*y*>]  )
  & ( for v,w be Point of [:X,Y:] holds I.(v+w) = I.v + I.w )
  & ( for v be Point of [:X,Y:], r be Element of REAL holds I.(r*v)=r*(I.v) )
  & I.(0.[:X,Y:]) = 0.([:X,product <*Y*>:])
  & ( for v be Point of [:X,Y:] holds ||. I.v .|| = ||.v.|| );

theorem 
  for X be non empty RealNormSpace-Sequence, Y be RealNormSpace
  ex I be Function of [:product X,Y:],product(X^<*Y*>)
  st I is one-to-one & I is onto
  & ( for x be Point of product X, y be Point of Y
  ex x1,y1 be FinSequence st x=x1 & <*y*>=y1 & I.(x,y) = x1^y1 )
  & ( for v,w be Point of [:product X,Y:] holds I.(v+w) = I.v + I.w )
  & ( for v be Point of [:product X,Y:], r be Element of REAL
  holds I.(r*v)=r*(I.v) )
  & I.(0.[:product X,Y:]) = 0.product(X^<*Y*>)
  & ( for v be Point of [:product X,Y:] holds ||. I.v .|| = ||.v.|| );















begin

theorem 
  for X be RealLinearSpace,
      R1, R2 be FinSequence of X
    st len R1 = len R2 holds Sum(R1+R2) = Sum(R1) + Sum(R2);

theorem 
  for X be RealLinearSpace,
      R1, R2, R3 be FinSequence of X
    st len R1 = len R2 & R3 = R1-R2 holds Sum(R3) = Sum(R1) - Sum(R2);

theorem 
  for X be RealLinearSpace,
      R1, R2 be FinSequence of X,
      a be Element of REAL st R2 = a(#)R1 holds Sum(R2) = a * Sum(R1);

begin 

reserve x,y for set;
reserve a,b for Real;
reserve i,j for Integer;
reserve V for RealLinearSpace;
reserve W1,W2,W3 for Subspace of V;
reserve v,v1,v2,v3,u,w,w1,w2,w3 for VECTOR of V;
reserve A,B,C for Subset of V;
reserve L,L1,L2 for Linear_Combination of V;
reserve l,l1,l2 for Linear_Combination of A;

definition let V,i,L;
  func i * L -> Linear_Combination of V means

  for v holds it.v = i * L.v;
end;

definition let V,A;
  func Z_Lin(A) -> Subset of V equals

  {Sum(l) : rng l c= INT};
end;

theorem 
  a = i implies a*l = i*l;

theorem 
  rng l1 c= INT & rng l2 c= INT implies rng (l1+l2) c= INT;

theorem 
  rng l c= INT implies rng (i*l) c= INT;

theorem 
  rng (ZeroLC(V)) c= INT;

theorem 
  Z_Lin(A) c= the carrier of Lin(A);

theorem 
  v in Z_Lin(A) & u in Z_Lin(A) implies v + u in Z_Lin(A);

theorem 
  v in Z_Lin(A) implies i*v in Z_Lin(A);

theorem 
  0.V in Z_Lin(A);

theorem 
  x in A implies x in Z_Lin(A);

theorem 
  A c= B implies Z_Lin(A) c= Z_Lin(B);

theorem 
  Z_Lin(A \/ B) = Z_Lin(A) + Z_Lin(B);

theorem 
  Z_Lin(A /\ B) c= Z_Lin(A) /\ Z_Lin(B);

theorem 
  x in Z_Lin{v} iff ex a be Integer st x = a * v;

theorem 
  v in Z_Lin{v};

theorem 
  x in v + Z_Lin{w} iff ex a be Integer st x = v + a * w;

theorem 
  x in Z_Lin{w1,w2} iff ex a,b be Integer st x = a * w1 + b * w2;

theorem 
  w1 in Z_Lin{w1,w2};

theorem 
  x in v + Z_Lin{w1,w2} iff ex a,b be Integer
    st x = v + a * w1 + b * w2;

theorem 
  x in Z_Lin{v1,v2,v3} iff ex a,b,c be Integer
   st x = a * v1 + b * v2 + c * v3;

theorem 
  w1 in Z_Lin{w1,w2,w3} & w2 in Z_Lin{w1,w2,w3} & w3 in Z_Lin{w1,w2,w3};

theorem 
  x in v + Z_Lin{w1,w2,w3}
   iff ex a,b,c be Integer st x = v + a * w1 + b * w2 + c * w3;

theorem 
  for x be set holds x in Z_Lin(A) iff
    ex g1,h1 be FinSequence of V,
        a1 be INT-valued FinSequence
   st x=Sum(h1) &
       rng g1 c= A & len g1 =len h1 & len g1 = len a1 &
       for i be Nat
        st i in Seg (len g1) holds
           h1/.i=(a1.i)*(g1/.i);

registration
  let D be non empty set, n be Nat;
  cluster n-element D-valued for FinSequence;
end;

definition
  let RS be RealLinearSpace;
  let f be FinSequence of RS;
  func Z_Lin(f) -> Subset of RS equals

    {Sum(g) where g is (len f)-element FinSequence of RS :
    ex a be (len f)-element INT-valued FinSequence
     st for i be Nat st i in Seg (len f) holds g/.i=(a.i)*(f/.i)};
end;

theorem 
for RS be RealLinearSpace,
      f be FinSequence of RS,
      x be set holds
   x in Z_Lin(f) iff
     ex g be (len f)-element FinSequence of RS,
          a be (len f)-element INT-valued FinSequence st
          x=Sum(g) & for i be Nat st i in Seg (len f) holds
          g/.i=(a.i)*(f/.i);

theorem 
for RS be RealLinearSpace,
      f be FinSequence of RS,
      x, y being Element of RS,
      a, b being Element of INT
    st x in Z_Lin(f) & y in Z_Lin(f) holds
(a * x) + (b * y) in Z_Lin(f);

theorem 
  for RS be RealLinearSpace,
      f be FinSequence of RS st f = (Seg len f) --> 0.RS
    holds Sum(f)=0.RS;

theorem 
for RS be RealLinearSpace,
      f be FinSequence of RS,
      v be Element of RS ,i be Nat st i in Seg (len f)
    & f = ( (Seg (len f)) --> 0.RS) +* ( {i} --> v)
holds Sum(f)=v;

theorem 
for RS be RealLinearSpace,
      f be FinSequence of RS,
       i be Nat st i in Seg (len f) holds f/.i in Z_Lin(f);

theorem 
  for RS be RealLinearSpace,
      f be FinSequence of RS holds
    rng f c= Z_Lin(f);

theorem 
for RS be RealLinearSpace,
      f be non empty FinSequence of RS,
     g,h be FinSequence of RS,
     s be INT-valued FinSequence
        st rng g c= Z_Lin(f) &
            len g = len s & len g = len h &
            for i be Nat st i in Seg (len g) holds
              h/.i=(s.i)*(g/.i) holds
  Sum(h) in Z_Lin(f);

theorem 
  for RS be RealLinearSpace,
      f be non empty FinSequence of RS holds
    Z_Lin (rng f) = Z_Lin f;

theorem 
  Lin Z_Lin A = Lin A;

theorem 
  for x be set, g1,h1 be FinSequence of V,
      a1 be INT-valued FinSequence st x=Sum(h1) &
    rng g1 c= Z_Lin(A) & len g1 =len h1 & len g1 = len a1 &
    for i be Nat st i in Seg (len g1) holds
        h1/.i=(a1.i)*(g1/.i) holds x in Z_Lin(A);

theorem 
  Z_Lin Z_Lin A = Z_Lin A;

theorem 
  Z_Lin(A) = Z_Lin(B) implies Lin(A) = Lin(B);
















begin



theorem 
  for n,i be Element of NAT,
      q be Element of REAL n,
      p be Point of TOP-REAL n
  st i in Seg n & q = p holds abs(p/.i) <= |.q.|;

theorem 
  for x be Real, vx be Element of REAL-NS 1
  st vx = <* x *> holds ||.vx.|| = abs x;

theorem 
  for n be non empty Element of NAT,
      x be Point of REAL-NS n,
      i be Element of NAT st 1 <= i & i <= n holds
    ||. Proj(i,n).x .|| <= ||. x .||;

theorem 
  for n be non empty Element of NAT,
      x be Element of REAL-NS n,
      i be Element of NAT holds
   ||. Proj(i,n).x .|| = |. proj(i,n).x .|;

theorem 
  for n be non empty Element of NAT,
      x be Element of REAL n,
      i be Element of NAT st 1 <= i & i <= n holds
   |. proj(i,n).x .| <= |. x .|;

theorem 
  for m,n be non empty Element of NAT,
      s be Point of
      R_NormSpace_of_BoundedLinearOperators(REAL-NS m,REAL-NS n),
      i be Element of NAT st 1 <= i & i <= n holds
  Proj(i,n) is Lipschitzian LinearOperator of REAL-NS n,REAL-NS 1 &
  BoundedLinearOperatorsNorm(REAL-NS n,REAL-NS 1).(Proj(i,n)) <= 1;

theorem 
  for m,n be non empty Element of NAT,
      s be Point of
      R_NormSpace_of_BoundedLinearOperators(REAL-NS m,REAL-NS n),
      i be Element of NAT st 1 <= i & i <= n holds
  Proj(i,n)*s is Point of
    R_NormSpace_of_BoundedLinearOperators(REAL-NS m,REAL-NS 1)
  & BoundedLinearOperatorsNorm(REAL-NS m,REAL-NS 1).(Proj(i,n)*s)
    <= ( BoundedLinearOperatorsNorm(REAL-NS n,REAL-NS 1).(Proj(i,n)))
         *(BoundedLinearOperatorsNorm(REAL-NS m,REAL-NS n).s);

theorem 
  for n be non empty Element of NAT, i be Element of NAT holds
    Proj(i,n) is homogeneous;

theorem 
  for n be non empty Element of NAT,
      x be Element of REAL n, r be Real, i be Element of NAT holds
    proj(i,n).(r*x) = r*(proj(i,n).x);

theorem 
  for n be non empty Element of NAT,
      x,y be Element of REAL n,
      i be Element of NAT
  holds proj(i,n).(x + y) = proj(i,n).x + proj(i,n).y;

theorem 
  for n be non empty Element of NAT,
      x,y be Point of REAL-NS n,
      i be Element of NAT
  holds Proj(i,n).(x - y) = Proj(i,n).x - Proj(i,n).y;

theorem 
  for n be non empty Element of NAT,
      x,y be Element of REAL n,
      i be Element of NAT
  holds proj(i,n).(x - y) = proj(i,n).x - proj(i,n).y;

theorem 
  for m,n be non empty Element of NAT,
      s be Point of R_NormSpace_of_BoundedLinearOperators(REAL-NS m,REAL-NS n),
      i be Element of NAT,
      si be Point of R_NormSpace_of_BoundedLinearOperators(REAL-NS m,REAL-NS 1)
      st si = Proj(i,n)*s & 1 <=i & i <= n
  holds ||. si .|| <= ||. s .||;

theorem 
  for m,n be non empty Element of NAT,
      s,t be Point of
      R_NormSpace_of_BoundedLinearOperators(REAL-NS m,REAL-NS n),
      si,ti be Point of
      R_NormSpace_of_BoundedLinearOperators(REAL-NS m,REAL-NS 1),
      i be Element of NAT st
      si = Proj(i,n)*s & ti = Proj(i,n)*t & 1 <= i & i <= n
  holds ||. si - ti .|| <= ||. s - t .||;

theorem 
  for K be Real, n be Element of NAT,
      s be Element of REAL n st
      for i be Element of NAT st 1 <= i & i <= n holds abs( s.i ) <= K
  holds |.s.| <= n*K;

theorem 
  for K be Real,
      n be non empty Element of NAT,
      s be Element of REAL-NS n st
      for i be Element of NAT st 1 <=i & i <= n holds ||. Proj(i,n).s .|| <= K
  holds ||. s .|| <= n*K;

theorem 
  for K be Real,
      n be non empty Element of NAT,
      s be Element of REAL n st
  for i be Element of NAT st 1 <= i & i <= n holds |. proj(i,n).s .| <= K
    holds |. s .| <= n*K;

theorem 
  for m,n be non empty Element of NAT,
      s be Point of
      R_NormSpace_of_BoundedLinearOperators(REAL-NS m,REAL-NS n),
      K be Real st
      for i be Element of NAT, si be Point of
      R_NormSpace_of_BoundedLinearOperators(REAL-NS m,REAL-NS 1)
      st si=Proj(i,n)*s & 1 <=i & i <= n holds ||. si .|| <= K
  holds ||. s .|| <= n*K;

theorem 
  for m,n be non empty Element of NAT,
      s,t be Point of
      R_NormSpace_of_BoundedLinearOperators(REAL-NS m,REAL-NS n),
      K be Real st
      for i be Element of NAT, si,ti be Point of
      R_NormSpace_of_BoundedLinearOperators(REAL-NS m,REAL-NS 1)
      st si = Proj(i,n)*s & ti = Proj(i,n)*t &  1 <=i & i <= n
      holds ||. si - ti .|| <= K
  holds ||. s-t .|| <= n*K;

theorem 
  for m,n be non empty Element of NAT,
      f be PartFunc of REAL-NS m,REAL-NS n,
      X be Subset of REAL-NS m,
      i be Element of NAT st 1 <=i & i <= m & X is open holds
  (f is_partial_differentiable_on X,i &
  f`partial|(X,i) is_continuous_on X)
  iff
  for j be Element of NAT st 1 <=j & j <= n holds
  (Proj(j,n)*f) is_partial_differentiable_on X,i &
   (Proj(j,n)*f)`partial|(X,i) is_continuous_on X;

theorem 
  for m,n be non empty Element of NAT,
      f be PartFunc of REAL-NS m,REAL-NS n,
      X be Subset of REAL-NS m st X is open holds
  (f is_differentiable_on X & f`|X is_continuous_on X)
  iff
  for j be Element of NAT st 1 <=j & j <= n holds
  Proj(j,n)*f is_differentiable_on X &
  (Proj(j,n)*f)`|X is_continuous_on X;

theorem 
  for m,n be non empty Element of NAT,
  f be PartFunc of REAL-NS m,REAL-NS n,
  X be Subset of REAL-NS m st X is open holds
  (for i be Element of NAT st 1 <= i & i <= m holds
  f is_partial_differentiable_on X,i &
  f`partial|(X,i) is_continuous_on X)
  iff
  f is_differentiable_on X & f`|X is_continuous_on X;














begin 

reserve F for non trivial RealNormSpace;
reserve G for RealNormSpace;
reserve X for set;
reserve x,x0,g,r,s,p for Real;
reserve n,m,k for Element of NAT;
reserve Y for Subset of REAL;
reserve Z for open Subset of REAL;
reserve s1,s3 for Real_Sequence;
reserve seq for sequence of G;
reserve f,f1,f2 for PartFunc of REAL,the carrier of F;
reserve h for 0-convergent non-zero Real_Sequence;
reserve c for constant Real_Sequence;

theorem 
  (for n holds ||. seq.n .|| <= s1.n) & s1 is convergent & lim s1=0 implies
    seq is convergent & lim(seq)=0.G;

theorem 
  (s1^\k)(#)(seq^\k)= (s1(#)seq) ^\k;

definition let F;
  let IT be PartFunc of REAL,the carrier of F;
  attr IT is RestFunc-like means

  IT is total & for h holds (h")(#)(IT/*h) is convergent &
  lim ((h")(#)(IT/*h)) = 0.F;
end;

registration let F;
  cluster RestFunc-like for PartFunc of REAL,the carrier of F;
end;

definition let F;
  mode RestFunc of F is RestFunc-like PartFunc of REAL,the carrier of F;
end;

definition let F;
  let IT be Function of REAL,the carrier of F;
  attr IT is linear means

  ex r be Point of F st for p be Real holds IT.p = p*r;
end;

registration let F;
  cluster linear for Function of REAL,the carrier of F;
end;

definition let F;
  mode LinearFunc of F is linear Function of REAL,the carrier of F;
end;

reserve R,R1,R2 for RestFunc of F;
reserve L,L1,L2 for LinearFunc of F;

theorem 
  L1+L2 is LinearFunc of F & L1-L2 is LinearFunc of F;

theorem 
  r(#)L is LinearFunc of F;

theorem 
  for h1,h2 be PartFunc of REAL, the carrier of F
  for seq be Real_Sequence st rng seq c= dom h1 /\ dom h2 holds
  (h1+h2)/*seq = h1/*seq+h2/*seq & (h1-h2)/*seq=h1/*seq - h2/*seq;

theorem 
  for h1,h2 be PartFunc of REAL,the carrier of F
  for seq be Real_Sequence st h1 is total & h2 is total holds
  (h1+h2)/*seq = h1/*seq + h2/*seq & (h1-h2)/*seq = h1/*seq - h2/*seq;

theorem 
  R1+R2 is RestFunc of F & R1-R2 is RestFunc of F;

theorem 
  r(#)R is RestFunc of F;

definition let F,f;
  let x0 be real number;
  pred f is_differentiable_in x0 means

  ex N being Neighbourhood of x0
  st N c= dom f & ex L,R st for x st x in N
  holds f/.x - f/.x0 = L.(x-x0) + R/.(x-x0);
end;

definition
  let F,f;
  let x0 be real number;
  assume
   f is_differentiable_in x0;
  func diff(f,x0) -> Point of F means

  ex N being Neighbourhood of x0 st N c= dom f & ex L,R st it=L.1
  & for x st x in N holds f/.x-f/.x0 = L.(x-x0) + R/.(x-x0);
end;

definition let F,f,X;
  pred f is_differentiable_on X means

  X c= dom f & for x st x in X holds f|X is_differentiable_in x;
end;

theorem 
  f is_differentiable_on X implies X is Subset of REAL;

theorem 
  f is_differentiable_on Z iff Z c= dom f & for x st x in Z holds
  f is_differentiable_in x;

theorem 
  f is_differentiable_on Y implies Y is open;

definition let F,f,X;
  assume
   f is_differentiable_on X;
  func f`|X -> PartFunc of REAL,the carrier of F means

  dom it = X & for x st x in X holds it.x = diff(f,x);
end;

theorem 
  (Z c= dom f & ex r be Point of F st rng f = {r})
  implies f is_differentiable_on Z &
  for x st x in Z holds (f`|Z)/.x = 0.F;

theorem 
  for x0 being real number for N being Neighbourhood of x0 st
  f is_differentiable_in x0 & N c= dom f holds for h,c st rng c = {x0}
  & rng (h+c)c= N
  holds h"(#)((f/*(h+c)) - f/*c) is convergent
  & diff(f,x0) = lim (h"(#)((f/*(h+c)) - f/*c));

theorem 
  f1 is_differentiable_in x0 & f2 is_differentiable_in x0 implies
  f1+f2 is_differentiable_in x0 & diff(f1+f2,x0)=diff(f1,x0)+diff(f2,x0);

theorem 
  f1 is_differentiable_in x0 & f2 is_differentiable_in x0 implies
  f1-f2 is_differentiable_in x0 & diff(f1-f2,x0)=diff(f1,x0)-diff(f2,x0);

theorem 
  for r be Real st
  f is_differentiable_in x0 holds r(#)f is_differentiable_in x0
  & diff((r(#)f),x0) = r*diff(f,x0);

theorem 
  Z c= dom (f1+f2) & f1 is_differentiable_on Z &
  f2 is_differentiable_on Z implies
  f1+f2 is_differentiable_on Z &
  for x st x in Z holds
  ((f1+f2)`|Z).x = diff(f1,x) + diff(f2,x);

theorem 
  Z c= dom (f1-f2) &
  f1 is_differentiable_on Z &
  f2 is_differentiable_on Z implies
  f1-f2 is_differentiable_on Z &
  for x st x in Z holds ((f1-f2)`|Z).x = diff(f1,x) - diff(f2,x);

theorem 
  Z c= dom (r(#)f) & f is_differentiable_on Z implies
  r(#)f is_differentiable_on Z &
  for x st x in Z holds ((r(#) f)`|Z).x =r*diff(f,x);

theorem 
  Z c= dom f & f|Z is constant implies f is_differentiable_on Z & for x
  st x in Z holds (f`|Z).x = 0.F;

theorem 
  for r,p be Point of F,Z,f
  st Z c= dom f & (for x st x in Z holds f/.x = x*r + p)
  holds f is_differentiable_on Z
  & for x st x in Z holds (f`|Z).x = r;

theorem 
  for x0 being Real st f is_differentiable_in x0 holds
  f is_continuous_in x0;

theorem 
  f is_differentiable_on X implies (f|X) is continuous;

theorem 
  f is_differentiable_on X & Z c= X implies f is_differentiable_on Z;

theorem 
  ex R be RestFunc of F st R/.0=0.F & R is_continuous_in 0;

definition let F;
  let f be PartFunc of REAL, the carrier of F;
  attr f is differentiable means

  f is_differentiable_on dom f;
end;

registration let F;
  cluster differentiable for Function of REAL, the carrier of F;
end;

theorem 
  for f being differentiable PartFunc of REAL, the carrier of F
  st Z c= dom f holds f is_differentiable_on Z;














begin 

reserve x,y,y1,y2,z,e,s for set;
reserve alpha,beta,gamma for Ordinal;
reserve n,m,k for Nat;

definition
  struct left-right(# LeftOptions,RightOptions -> set #);
end;

definition
  func ConwayZero equals

left-right(#{},{}#);
end;

registration
  cluster strict for left-right;
end;

definition
  let alpha;
  func ConwayDay(alpha) -> set means


    ex f being T-Sequence st alpha in dom f & f.alpha = it
      & for beta st beta in dom f holds f.beta = { left-right(#x,y#)
          where x,y is Subset of union(rng (f|beta)) : not contradiction };
end;

theorem 
  z in ConwayDay(alpha) iff ex w being strict left-right st z = w &
    for x st x in (the LeftOptions of w) \/ (the RightOptions of w)
      ex beta st beta in alpha & x in ConwayDay(beta);

theorem 
  ConwayDay(0) = { ConwayZero };

theorem 
  alpha c= beta implies ConwayDay(alpha) c= ConwayDay(beta);

registration
  let alpha;
  cluster ConwayDay(alpha) -> non empty;
end;

begin 

definition
  let x;
  attr x is ConwayGame-like means


    ex alpha st x in ConwayDay(alpha);
end;

registration
  let alpha;
  cluster -> ConwayGame-like for Element of ConwayDay(alpha);
end;

registration
  cluster ConwayZero -> ConwayGame-like;
end;

registration
  cluster ConwayGame-like strict for left-right;
  cluster ConwayGame-like for set;
end;

definition
  mode ConwayGame is ConwayGame-like set;
end;

definition
  redefine func ConwayZero -> Element of ConwayDay(0);
end;

definition
  func ConwayOne -> Element of ConwayDay(1) equals

    left-right(#{ConwayZero},{}#);

  func ConwayStar -> Element of ConwayDay(1) equals

    left-right(#{ConwayZero},{ConwayZero}#);
end;

reserve g,g0,g1,g2,gO,gL,gR,gLL,gLR,gRL,gRR for ConwayGame;

theorem 
  g is strict left-right;

registration
  cluster ConwayGame-like -> strict for left-right;
end;

definition
  let g;
  func the_LeftOptions_of g means


    ex w being left-right st g = w & it = the LeftOptions of w;

  func the_RightOptions_of g means


    ex w being left-right st g = w & it = the RightOptions of w;
end;

definition
  let g;
  func the_Options_of g equals

    (the_LeftOptions_of g) \/ (the_RightOptions_of g);
end;

theorem 
  g1 = g2 iff
    (the_LeftOptions_of g1 = the_LeftOptions_of g2
      & the_RightOptions_of g1 = the_RightOptions_of g2);

registration
  cluster the_LeftOptions_of ConwayZero -> empty;

  cluster the_RightOptions_of ConwayZero -> empty;

  cluster the_RightOptions_of ConwayOne -> empty;
end;

theorem 
  g = ConwayZero iff the_Options_of g = {};

theorem 
  x in the_LeftOptions_of ConwayOne iff x = ConwayZero;

theorem 
  (x in the_Options_of ConwayStar iff x = ConwayZero)
    & (x in the_LeftOptions_of ConwayStar iff x = ConwayZero)
    & (x in the_RightOptions_of ConwayStar iff x = ConwayZero);

theorem 
  g in ConwayDay(alpha) iff
    for x st x in the_Options_of g
      ex beta st beta in alpha & x in ConwayDay(beta);

definition
  let g be set;
  assume
 g is ConwayGame;
  func ConwayRank(g) -> Ordinal means


    g in ConwayDay(it) & for beta st beta in it holds not g in ConwayDay(beta);
end;

theorem 
  g in ConwayDay(alpha) & x in the_Options_of g implies x in ConwayDay(alpha);

theorem 
  g in ConwayDay(alpha) &
    (x in the_LeftOptions_of g or x in the_RightOptions_of g)
    implies x in ConwayDay(alpha);

theorem 
  g in ConwayDay(alpha) iff ConwayRank(g) c= alpha;

theorem 
  ConwayRank(g) in alpha iff ex beta st beta in alpha & g in ConwayDay(beta);

theorem 
  gO in the_Options_of g implies ConwayRank(gO) in ConwayRank(g);

theorem 
  (gO in the_LeftOptions_of g or gO in the_RightOptions_of g)
    implies ConwayRank(gO) in ConwayRank(g);

theorem 
  not g in the_Options_of g;

theorem 
  x in the_Options_of g implies x is ConwayGame-like left-right;

theorem 
  (x in the_LeftOptions_of g or x in the_RightOptions_of g)
    implies x is ConwayGame-like left-right;

theorem 
  for w being strict left-right holds w is ConwayGame iff
    for z st z in (the LeftOptions of w) \/ (the RightOptions of w)
      holds z is ConwayGame;

begin 

scheme 
 ConwayGameMinTot { P[ConwayGame] } :
    ex g st P[g] & for g1 st ConwayRank(g1) in ConwayRank(g) holds not P[g1]
provided
 ex g st P[g];

scheme 
 ConwayGameMin { P[ConwayGame] } :
    ex g st P[g] & for gO st gO in the_Options_of g holds not P[gO]
provided
 ex g st P[g];

scheme 
 ConwayGameInd { P[ConwayGame] } : for g holds P[g]
provided
 for g st (for gO st gO in the_Options_of g holds P[gO]) holds P[g];

begin 

definition
  let f be Function;
  attr f is ConwayGame-valued means


    for x st x in dom f holds f.x is ConwayGame;
end;

registration
  let g;
  cluster <*g*> -> ConwayGame-valued;
end;

registration
  cluster ConwayGame-valued non empty for FinSequence;
end;

registration
  let f be non empty FinSequence;
  cluster -> natural non empty for Element of dom f;
end;

registration
  let f be ConwayGame-valued non empty Function;
  let x be Element of dom f;
  cluster f.x -> ConwayGame-like;
end;

definition
  let f be ConwayGame-valued non empty FinSequence;
  attr f is ConwayGameChain-like means


    for n being Element of dom f st n > 1 holds
      f.(n-1) in the_Options_of f.n;
end;

theorem 
  for f being FinSequence for n st n in dom f & n > 1
    holds n-1 in dom f;

registration
  let g;
  cluster <*g*> -> ConwayGameChain-like;
end;

registration
  cluster ConwayGameChain-like for ConwayGame-valued non empty FinSequence;
end;

definition
  mode ConwayGameChain is
    ConwayGameChain-like ConwayGame-valued non empty FinSequence;
end;

theorem 
  for f being ConwayGameChain
    for n,m being Element of dom f st n < m holds
      ConwayRank(f.n) in ConwayRank(f.m);

theorem 
  for f being ConwayGameChain
    for n,m being Element of dom f st n <= m holds
      ConwayRank(f.n) c= ConwayRank(f.m);

theorem 
  for f being ConwayGameChain st f.(len f) in ConwayDay(alpha)
    holds f.1 in ConwayDay(alpha);

definition
  let g;
  func the_Tree_of g -> set means


    z in it iff ex f being ConwayGameChain st f.1 = z & f.(len f) = g;
end;

registration
  let g;
  cluster the_Tree_of g -> non empty;
end;

definition
  let g;
  func the_proper_Tree_of g -> Subset of the_Tree_of g equals

    the_Tree_of g \ {g};
end;

theorem 
  g in the_Tree_of g;

definition
  let alpha;
  let g be Element of ConwayDay(alpha);
  redefine func the_Tree_of g -> Subset of ConwayDay(alpha);
end;

registration
  let g;
  cluster -> ConwayGame-like for Element of the_Tree_of g;
end;

theorem 
  for f being ConwayGameChain for n being non empty Nat holds
    f|n is ConwayGameChain;

theorem 
  for f1,f2 being ConwayGameChain st
    ex g st g = f2.1 & f1.(len f1) in the_Options_of g
    holds f1^f2 is ConwayGameChain;

theorem 
  x in the_Tree_of g iff
    (x = g or ex gO st gO in the_Options_of g & x in the_Tree_of gO);

theorem 
  gO in the_Tree_of g implies (gO = g or ConwayRank(gO) in ConwayRank(g));

theorem 
  gO in the_Tree_of g implies ConwayRank(gO) c= ConwayRank(g);

theorem 
  for s being set st g in s & for g1 st g1 in s holds the_Options_of g1 c= s
    holds the_Tree_of g c= s;

theorem 
  g1 in the_Tree_of g2 implies the_Tree_of g1 c= the_Tree_of g2;

theorem 
  g1 in the_Tree_of g2 implies the_proper_Tree_of g1 c= the_proper_Tree_of g2;

theorem 
  the_Options_of g c= the_proper_Tree_of g;

theorem 
  the_Options_of g c= the_Tree_of g;

theorem 
  g1 in the_proper_Tree_of g2 implies the_Tree_of g1 c= the_proper_Tree_of g2;

theorem 
  gO in the_Options_of g implies the_Tree_of gO c= the_proper_Tree_of g;

theorem 
  the_Tree_of ConwayZero = { ConwayZero };

theorem 
  ConwayZero in the_Tree_of g;

scheme 
 ConwayGameMin2 { P[ConwayGame] } :
  ex g st P[g] & for gO st gO in the_proper_Tree_of g holds not P[gO]
provided
 ex g st P[g];

begin 

scheme 
 Func1RecUniq { F(ConwayGame,Function) -> set } :
  for g for f1,f2 being Function st
    dom f1 = the_Tree_of g & dom f2 = the_Tree_of g
    & (for g1 st g1 in dom f1 holds f1.g1 = F(g1,f1|the_proper_Tree_of g1))
    & (for g1 st g1 in dom f2 holds f2.g1 = F(g1,f2|the_proper_Tree_of g1))
  holds f1 = f2;

scheme 
 Func1RecEx { F(ConwayGame,Function) -> set } :
  ex f being Function st dom f = the_Tree_of g &
    for g1 st g1 in dom f holds f.g1 = F(g1,f|the_proper_Tree_of g1);

begin

definition
  let g;
  func -g means


    ex f being Function st dom f = the_Tree_of g & it = f.g
      & for g1 st g1 in dom f holds f.g1 = left-right(#
        { f.gR where gR is Element of the_RightOptions_of g1 :
            the_RightOptions_of g1 <> {} },
        { f.gL where gL is Element of the_LeftOptions_of g1 :
            the_LeftOptions_of g1 <> {} } #);
end;

registration
  let g;
  cluster -g -> ConwayGame-like;
end;

theorem 
  (for x holds x in the_LeftOptions_of -g iff
    ex gR st gR in the_RightOptions_of g & x = -gR)
  & (for x holds x in the_RightOptions_of -g iff
    ex gL st gL in the_LeftOptions_of g & x = -gL);

theorem 
  -(-g) = g;

theorem 
  (gO in the_LeftOptions_of -g iff -gO in the_RightOptions_of g)
    & (gO in the_LeftOptions_of g iff -gO in the_RightOptions_of -g)
    & (gO in the_RightOptions_of -g iff -gO in the_LeftOptions_of g)
    & (gO in the_RightOptions_of g iff -gO in the_LeftOptions_of -g);

definition
  let g;
  attr g is nonnegative means


    ex s st g in s & for g1 st g1 in s for gR st gR in the_RightOptions_of g1
      ex gRL st gRL in the_LeftOptions_of gR & gRL in s;
end;

definition
  let g;
  attr g is nonpositive means


    -g is nonnegative;
end;

definition
  let g;
  attr g is zero means


    g is nonnegative & g is nonpositive;
  attr g is fuzzy means


    not g is nonnegative & not g is nonpositive;
end;

definition
  let g;
  attr g is positive means


    g is nonnegative & not g is zero;
  attr g is negative means


    g is nonpositive & not g is zero;
end;

registration
  cluster zero -> nonnegative nonpositive for ConwayGame;
  cluster nonpositive nonnegative -> zero for ConwayGame;
  cluster negative -> nonpositive non zero for ConwayGame;
  cluster nonpositive non zero -> negative for ConwayGame;
  cluster positive -> nonnegative non zero for ConwayGame;
  cluster nonnegative non zero -> positive for ConwayGame;
  cluster fuzzy -> non nonnegative non nonpositive for ConwayGame;
  cluster non nonnegative non nonpositive -> fuzzy for ConwayGame;
end;

theorem 
  g is zero or g is positive or g is negative or g is fuzzy;

theorem 
  g is nonnegative iff
    for gR st gR in the_RightOptions_of g
      ex gRL st gRL in the_LeftOptions_of gR & gRL is nonnegative;

theorem 
  g is nonpositive iff
    for gL st gL in the_LeftOptions_of g
      ex gLR st gLR in the_RightOptions_of gL & gLR is nonpositive;

theorem 
  (g is nonnegative iff
    for gR st gR in the_RightOptions_of g holds gR is fuzzy or gR is positive)
  & (g is nonpositive iff
    for gL st gL in the_LeftOptions_of g holds gL is fuzzy or gL is negative);

theorem 
  g is fuzzy iff
    (ex gL st gL in the_LeftOptions_of g & gL is nonnegative) &
    (ex gR st gR in the_RightOptions_of g & gR is nonpositive);

theorem 
  g is zero iff
   (for gL st gL in the_LeftOptions_of g holds gL is fuzzy or gL is negative) &
   (for gR st gR in the_RightOptions_of g holds gR is fuzzy or gR is positive);

theorem 
  g is positive iff
    (for gR st gR in the_RightOptions_of g holds gR is fuzzy or gR is positive)
    & (ex gL st gL in the_LeftOptions_of g & gL is nonnegative);

theorem 
  g is negative iff
    (for gL st gL in the_LeftOptions_of g holds gL is fuzzy or gL is negative)
    & (ex gR st gR in the_RightOptions_of g & gR is nonpositive);

registration
  cluster ConwayZero -> zero;
end;

registration
  cluster ConwayOne -> positive;

  cluster ConwayStar -> fuzzy;
end;

registration
  cluster zero for ConwayGame;
  cluster positive for ConwayGame;
  cluster fuzzy for ConwayGame;
end;

registration
  let g be nonpositive ConwayGame;
  cluster -g -> nonnegative;
end;

registration
  let g be nonnegative ConwayGame;
  cluster -g -> nonpositive;
end;

registration
  let g be positive ConwayGame;
  cluster -g -> negative;
end;

registration
  cluster negative for ConwayGame;
end;

registration
  let g be negative ConwayGame;
  cluster -g -> positive;
end;

registration
  let g be fuzzy ConwayGame;
  cluster -g -> fuzzy;
end;














begin 

reserve a,b,c,d for ordinal number;
reserve l for non empty limit_ordinal Ordinal;
reserve u for Element of l;
reserve A for non empty ordinal number;
reserve e for Element of A;
reserve X,Y,x,y,z for set;
reserve n,m for Nat;

definition
  let X be set;
  attr X is ordinal-membered means

  ex a st X c= a;
end;

registration
  cluster ordinal -> ordinal-membered for set;
  let X;
  cluster On X -> ordinal-membered;
end;

theorem 
  X is ordinal-membered iff for x st x in X holds x is ordinal;

registration
  cluster ordinal-membered for set;
end;

registration
  let X be ordinal-membered set;
  cluster -> ordinal for Element of X;
end;

theorem 
  X is ordinal-membered iff On X = X;

theorem 
  for X being ordinal-membered set holds X c= sup X;

theorem 
  a c= b iff b nin a;

theorem 
  x in a\b iff b c= x & x in a;

registration let a,b;
  cluster a\b -> ordinal-membered;
end;

theorem 
  for f being Function st f is_isomorphism_of RelIncl X, RelIncl Y
  for x,y st x in X & y in X holds x c= y iff f.x c= f.y;

theorem 
  for X,Y being ordinal-membered set
  for f being Function st f is_isomorphism_of RelIncl X, RelIncl Y
  for x,y st x in X & y in X holds x in y iff f.x in f.y;

theorem 
  [x,y] in RelIncl X implies x c= y;

theorem 
  for f1,f2 being T-Sequence holds f1 c= f1^f2;

theorem 
  for f1,f2 being T-Sequence holds rng(f1^f2) = rng f1 \/ rng f2;

theorem 
  a c= b iff epsilon_a c= epsilon_b;

theorem 
  a in b iff epsilon_a in epsilon_b;

registration
  let X be ordinal-membered set;
  cluster union X -> ordinal;
end;

registration
  let f be Ordinal-yielding Function;
  cluster rng f -> ordinal-membered;
end;

registration
  let a;
  cluster id a -> T-Sequence-like Ordinal-yielding;
end;

registration
  let a;
  cluster id a -> increasing for Ordinal-Sequence;
end;

registration
  let a;
  cluster id a -> continuous for Ordinal-Sequence;
end;

registration
  cluster non empty increasing continuous for Ordinal-Sequence;
end;

definition
  let f be T-Sequence;
  attr f is normal means

  f is increasing continuous Ordinal-Sequence;
end;

definition
  let f be Ordinal-Sequence;
  redefine attr f is normal means

  f is increasing continuous;
end;

registration
  cluster normal -> Ordinal-yielding for T-Sequence;
  cluster normal -> increasing continuous for Ordinal-Sequence;
  cluster increasing continuous -> normal for Ordinal-Sequence;
end;

registration
  cluster non empty normal for T-Sequence;
end;

theorem 
  for f being Ordinal-Sequence holds
  f is non-decreasing implies f|a is non-decreasing;

definition
  let X;
  func ord-type X -> ordinal number equals

  order_type_of RelIncl On X;
end;

definition
  let X be ordinal-membered set;
  redefine func ord-type X equals

order_type_of RelIncl X;
end;

registration
  let X be ordinal-membered set;
  cluster RelIncl X -> well-ordering;
end;

registration
  let E be empty set;
  cluster On E -> empty;
end;

registration
  let E be empty set;
  cluster order_type_of E -> empty;
end;

theorem 
  ord-type {} = 0;

theorem 
  ord-type {a} = 1;

theorem 
  a <> b implies ord-type {a,b} = 2;

theorem 
  ord-type a = a;

definition
  let X;
  func numbering X -> Ordinal-Sequence equals

  canonical_isomorphism_of(RelIncl ord-type X, RelIncl On X);
end;

theorem 
  dom numbering X = ord-type X & rng numbering X = On X;

theorem 
  for X being ordinal-membered set holds rng numbering X = X;

theorem 
  card dom numbering X = card On X;

theorem 
  numbering X is_isomorphism_of RelIncl ord-type X, RelIncl On X;

reserve f for Ordinal-Sequence;

theorem 
  f = numbering X & x in dom f & y in dom f implies (x c= y iff f.x c= f.y);

theorem 
  f = numbering X & x in dom f & y in dom f implies (x in y iff f.x in f.y);

registration
  let X;
  cluster numbering X -> increasing;
end;

registration
  let X,Y be ordinal-membered set;
  cluster X \/ Y -> ordinal-membered;
end;

registration
  let X be ordinal-membered set, Y be set;
  cluster X \ Y -> ordinal-membered;
end;

theorem 
  for X,Y being ordinal-membered set
  st for x,y st x in X & y in Y holds x in y
  holds (numbering X)^(numbering Y) is_isomorphism_of
  RelIncl ((ord-type X)+^(ord-type Y)), RelIncl (X \/ Y);

theorem 
  for X,Y being ordinal-membered set
  st for x,y st x in X & y in Y holds x in y
  holds numbering(X \/ Y) = (numbering X)^(numbering Y);

theorem 
  for X,Y being ordinal-membered set
  st for x,y st x in X & y in Y holds x in y
  holds ord-type(X \/ Y) = (ord-type X)+^(ord-type Y);

begin 

theorem 
  for f being Function st x is_a_fixpoint_of f holds x in rng f;

definition
  let f be Ordinal-Sequence;
  func criticals f -> Ordinal-Sequence equals

  numbering {a where a is Element of dom f: a is_a_fixpoint_of f};
end;

theorem 
  On {a where a is Element of dom f: a is_a_fixpoint_of f}
  = {a where a is Element of dom f: a is_a_fixpoint_of f};

theorem 
  x in dom criticals f implies (criticals f).x is_a_fixpoint_of f;

theorem 
  rng criticals f = {a where a is Element of dom f: a is_a_fixpoint_of f} &
  rng criticals f c= rng f;

registration let f;
  cluster criticals f -> increasing;
end;

theorem 
  x in dom criticals f implies x c= (criticals f).x;

theorem 
  dom criticals f c= dom f;

theorem 
  b is_a_fixpoint_of f implies
  ex a st a in dom criticals f & b = (criticals f).a;

theorem 
  a in dom criticals f & b is_a_fixpoint_of f & (criticals f).a in b
  implies succ a in dom criticals f;

theorem 
  succ a in dom criticals f & b is_a_fixpoint_of f & (criticals f).a in b
  implies (criticals f).succ a c= b;

theorem 
  f is normal & union X in dom f & X is non empty &
  (for x st x in X ex y st x c= y & y in X & y is_a_fixpoint_of f)
  implies union X = f.union X;

theorem 
  f is normal & union X in dom f & X is non empty &
  (for x st x in X holds x is_a_fixpoint_of f)
  implies union X = f.union X;

theorem 
  l c= dom criticals f & a is_a_fixpoint_of f &
  (for x st x in l holds (criticals f).x in a)
  implies l in dom criticals f;

theorem 
  f is normal & l in dom criticals f implies
  (criticals f).l = Union ((criticals f)|l);

registration
  let f be normal Ordinal-Sequence;
  cluster criticals f -> continuous;
end;

theorem 
  for f1,f2 being Ordinal-Sequence st f1 c= f2
  holds criticals f1 c= criticals f2;

begin 

reserve U,W for Universe;

registration
  let U;
  cluster normal for Ordinal-Sequence of U;
end;

definition
  let U,a;
  mode Ordinal-Sequence of a,U is Function of a, On U;
end;

registration
  let U,a;
  cluster -> T-Sequence-like Ordinal-yielding for Ordinal-Sequence of a,U;
end;

definition
  let U,a;
  let f be Ordinal-Sequence of a,U;
  let x;
  redefine func f.x -> Ordinal of U;
end;

theorem 
  a in U implies for f being Ordinal-Sequence of a,U holds Union f in U;

theorem 
  a in U implies for f being Ordinal-Sequence of a,U holds sup f in U;

scheme 
 CriticalNumber2
  {U() -> Universe, a() -> Ordinal of U(),
  f() -> Ordinal-Sequence of omega, U(),
  phi(Ordinal) -> Ordinal}:
   a() c= Union f() & phi(Union f()) = Union f() &
   for b st a() c= b & b in U() & phi(b) = b holds Union f() c= b
  provided
  omega in U()
  and
 for a st a in U() holds phi(a) in U()
  and
  for a,b st a in b & b in U() holds phi(a) in phi(b)
  and
 for a being Ordinal of U() st a is non empty limit_ordinal
    for phi being Ordinal-Sequence
      st dom phi = a & for b st b in a holds phi.b = phi(b)
    holds phi(a) is_limes_of phi
  and
  f().0 = a()
  and
  for a st a in omega holds f().(succ a) = phi(f().a);

scheme 
 CriticalNumber3
  {U() -> Universe, a() -> Ordinal of U(), phi(Ordinal) -> Ordinal}:
  ex a being Ordinal of U() st a() in a & phi(a) = a
  provided
 omega in U()
    and
 for a st a in U() holds phi(a) in U()
    and
 for a,b st a in b & b in U() holds phi(a) in phi(b)
    and
 for a being Ordinal of U() st a is non empty limit_ordinal
    for phi being Ordinal-Sequence
      st dom phi = a & for b st b in a holds phi.b = phi(b)
    holds phi(a) is_limes_of phi;

reserve F,phi for normal Ordinal-Sequence of W;

theorem 
  omega in W & b in W implies ex a st b in a & a is_a_fixpoint_of phi;

theorem 
  omega in W implies criticals F is Ordinal-Sequence of W;

theorem 
  f is normal implies
  for a st a in dom criticals f holds f.a c= (criticals f).a;

begin 

definition
  let U;
  let a,b be Ordinal of U;
  redefine func exp(a,b) -> Ordinal of U;
end;

definition
  let U,a such that
 a in U;
  func U exp a -> Ordinal-Sequence of U means

  for b being Ordinal of U holds it.b = exp(a,b);
end;

registration
  cluster omega -> non trivial;
end;

registration
  let U;
  cluster non trivial finite for Ordinal of U;
end;

registration
  cluster non trivial finite for Ordinal;
end;

registration
  let U;
  let a be non trivial Ordinal of U;
  cluster U exp a -> normal;
end;

definition
  let g be Function;
  attr g is Ordinal-Sequence-valued means

  x in rng g implies x is Ordinal-Sequence;
end;

registration
  let f be Ordinal-Sequence;
  cluster <%f%> -> Ordinal-Sequence-valued;
end;

definition 
  let f be Function;
  attr f is with_the_same_dom means

  rng f is with_common_domain;
end;

registration
  let f be Function;
  cluster {f} -> with_common_domain;
end;

registration
  let f be Function;
  cluster <%f%> -> with_the_same_dom;
end;

registration
  cluster non empty Ordinal-Sequence-valued with_the_same_dom for T-Sequence;
end;

registration
  let g be Ordinal-Sequence-valued Function;
  let x;
  cluster g.x -> Relation-like Function-like;
end;

registration
  let g be Ordinal-Sequence-valued Function;
  let x;
  cluster g.x -> T-Sequence-like Ordinal-yielding;
end;

registration
  let g be T-Sequence;
  let a;
  cluster g|a -> T-Sequence-like;
end;

registration
  let g be Ordinal-Sequence-valued Function;
  let X;
  cluster g|X -> Ordinal-Sequence-valued;
end;

registration
  let a,b;
  cluster -> Ordinal-yielding T-Sequence-like for Function of a,b;
end;

definition
  let g be Ordinal-Sequence-valued T-Sequence;
  func criticals g -> Ordinal-Sequence equals

  numbering {a where a is Element of dom(g.0): a in dom(g.0) &
  for f st f in rng g holds a is_a_fixpoint_of f};
end;

reserve g for Ordinal-Sequence-valued T-Sequence;

theorem 
  for g holds
  {a where a is Element of dom(g.0): a in dom(g.0) &
  for f st f in rng g holds a is_a_fixpoint_of f} is ordinal-membered;

theorem 
  a in dom g & b in dom criticals g
  implies (criticals g).b is_a_fixpoint_of g.a;

theorem 
  x in dom criticals g implies x c= (criticals g).x;

theorem 
  f in rng g implies dom criticals g c= dom f;

theorem 
  dom g <> {} & (for c st c in dom g holds b is_a_fixpoint_of g.c) implies
  ex a st a in dom criticals g & b = (criticals g).a;

theorem 
  dom g <> {} & l c= dom criticals g &
  (for f st f in rng g holds a is_a_fixpoint_of f) &
  (for x st x in l holds (criticals g).x in a)
  implies l in dom criticals g;

theorem 
  for g st dom g <> {} & for a st a in dom g holds g.a is normal
  holds l in dom criticals g implies
  (criticals g).l = Union ((criticals g)|l);

theorem 
  for g st dom g <> {} & for a st a in dom g holds g.a is normal
  holds criticals g is continuous;

theorem 
  for g st dom g <> {} & for a st a in dom g holds g.a is normal
  for a,f st a in dom criticals g & f in rng g holds f.a c= (criticals g).a;

theorem 
  for g1,g2 being Ordinal-Sequence-valued T-Sequence
  st dom g1 = dom g2 & dom g1 <> {} & for a st a in dom g1 holds g1.a c= g2.a
  holds criticals g1 c= criticals g2;

definition
  let g be Ordinal-Sequence-valued T-Sequence;
  func lims g -> Ordinal-Sequence means


  dom it = dom (g.0) & for a st a in dom it holds
  it.a = union {g.b.a where b is Element of dom g: b in dom g};
end;

theorem 
  for g being Ordinal-Sequence-valued T-Sequence
  st dom g <> {} & dom g in U &
  for a st a in dom g holds g.a is Ordinal-Sequence of U
  holds lims g is Ordinal-Sequence of U;

begin 

definition
  let x;
  func OS@ x -> Ordinal-Sequence equals

  x if x is Ordinal-Sequence otherwise the Ordinal-Sequence;
  func OSV@ x -> Ordinal-Sequence-valued T-Sequence equals

  x if x is Ordinal-Sequence-valued T-Sequence
  otherwise the Ordinal-Sequence-valued T-Sequence;
end;

definition
  let U;
  func U-Veblen -> Ordinal-Sequence-valued T-Sequence means

  dom it = On U & it.0 = U exp omega &
  (for b st succ b in On U holds it.succ b = criticals (it.b)) &
  (for l st l in On U holds it.l = criticals (it|l));
end;

registration
  cluster uncountable for Universe;
end;

theorem 
  for U being Universe holds U is uncountable iff omega in U;

theorem 
  a in b & b in U & omega in U & c in dom(U-Veblen.b)
  implies U-Veblen.b.c is_a_fixpoint_of U-Veblen.a;

theorem 
  l in U & (for c st c in l holds a is_a_fixpoint_of U-Veblen.c)
  implies a is_a_fixpoint_of lims(U-Veblen|l);

theorem 
  a c= b & b in U & omega in U & c in dom(U-Veblen.b) &
  (for c st c in b holds U-Veblen.c is normal)
  implies U-Veblen.a.c c= U-Veblen.b.c;

theorem 
  l in U & a in U & b in l &
  (for c st c in l holds U-Veblen.c is normal Ordinal-Sequence of U)
  implies (lims(U-Veblen|l)).a is_a_fixpoint_of U-Veblen.b;

theorem 
  omega in U & a in U implies U-Veblen.a is normal Ordinal-Sequence of U;

theorem 
  omega in U & U c= W & a in U implies U-Veblen.a c= W-Veblen.a;

theorem 
  omega in U & a in U & b in U & omega in W & a in W & b in W implies
  U-Veblen.b.a = W-Veblen.b.a;

theorem 
  l in U & (for a st a in l holds
  U-Veblen.a is normal Ordinal-Sequence of U)
  implies lims(U-Veblen|l) is non-decreasing continuous Ordinal-Sequence of U;

registration
  let a;
  cluster Tarski-Class(a \/ omega) -> uncountable;
end;

definition
  let a,b;
  func a-Veblen(b) -> Ordinal equals

  (Tarski-Class(a \/ b \/ omega))-Veblen.a.b;
end;

definition
  let n,b;
  redefine func n-Veblen(b) -> Ordinal equals

  (Tarski-Class(b \/ omega))-Veblen.n.b;
end;

theorem 
  a in Tarski-Class(a\/b\/c);

theorem 
  omega in U & a in U & b in U implies b-Veblen a = U-Veblen.b.a;

theorem 
  0-Veblen(a) = exp(omega,a);

theorem 
  b-Veblen((succ b)-Veblen a) = (succ b)-Veblen a;

theorem 
  b in c implies b-Veblen(c-Veblen a) = c-Veblen a;

theorem 
  a c= b iff c-Veblen a c= c-Veblen b;

theorem 
  a in b iff c-Veblen a in c-Veblen b;

theorem 
  a-Veblen b in c-Veblen d iff
    a = c & b in d or
    a in c & b in c-Veblen d or
    c in a & a-Veblen b in d;

begin 

reserve U for uncountable Universe;

theorem 
  U-Veblen.1 = criticals(U exp omega);

theorem 
  1-Veblen(a) is epsilon;

theorem 
  for e being epsilon Ordinal ex a st e = 1-Veblen a;

theorem 
  1-Veblen(a) = epsilon_a;














begin 

reserve a,a1,a2,b,c,d for ordinal number,
  n,m,k for Nat,
  x,y,z,t,X,Y,Z for set;

theorem 
  x in (a+^b)\a iff ex c st x = a+^c & c in b;

theorem 
  a in b & c in d implies
  c <> a & c <> b & d <> a & d <> b     or
  c in a & d = a   or   c in a & d = b  or
  c = a & d in b   or   c = a & d = b   or   c = a & b in d  or
  a in c & d = b   or   c = b & b in d;

theorem 
  x nin y implies (y\/{x})\y = {x};

theorem 
  (succ x)\x = {x};

theorem 
  for f being Function, r being Relation
  for x holds x in f.:r iff ex y,z st [y,z] in r & [y,z] in dom f & f.(y,z) = x
;

theorem 
  a\b <> {} implies inf(a\b) = b & sup(a\b) = a & union(a\b) = union a;

theorem 
  a\b is non empty finite implies
  ex n being Nat st a = b+^n;

begin 

definition let f be set;
  attr f is segmental means

  ex a,b st proj1 f = a\b;
end;

reserve f,g for Function;

theorem 
  dom f = dom g & f is segmental implies g is segmental;

theorem 
  f is segmental implies
  for a,b,c st a c= b & b c= c & a in dom f & c in dom f holds b in dom f;

registration
  cluster T-Sequence-like -> segmental for Function;
  cluster FinSequence-like -> segmental for Function;
end;

definition
  let a;
  let s be set;
  attr s is a-based means

 b in proj1 s implies a in proj1 s & a c= b;
  attr s is a-limited means

 a = sup proj1 s;
end;

theorem 
  f is a-based segmental iff ex b st dom f = b\a & a c= b;

theorem 
  f is b-limited non empty segmental iff ex a st dom f = b\a & a in b;

registration
  cluster T-Sequence-like -> 0-based for Function;
  cluster FinSequence-like -> 1-based for Function;
end;

theorem 
  f is (inf dom f)-based;

theorem 
  f is (sup dom f)-limited;

theorem 
  f is b-limited & a in dom f implies a in b;

definition let f;
  func base-f -> ordinal number means


  f is it-based if ex a st a in dom f
  otherwise it = 0;
  func limit-f -> ordinal number means


  f is it-limited if ex a st a in dom f
  otherwise it = 0;
end;

definition
  let f;
  func len-f -> ordinal number equals

(limit-f)-^(base-f);
end;

theorem 
  base-{} = 0 & limit-{} = 0 & len-{} = 0;

theorem 
  limit-f = sup dom f;

theorem 
  f is (limit-f)-limited;

theorem 
  for A being empty set holds A is a-based;

registration let a,X,Y;
  cluster Y-defined X-valued a-based segmental finite empty for T-Sequence;
end;

definition
  mode array is segmental Function;
end;

registration
  let A be array;
  cluster dom A -> ordinal-membered;
end;

theorem 
  for f being array holds f is 0-limited iff f is empty;

registration
  cluster 0-based -> T-Sequence-like for array;
end;

definition
  let X;
  mode array of X is X-valued array;
end;

definition
  let X be 1-sorted;
  mode array of X is array of the carrier of X;
end;

definition
  let a,X;
  mode array of a,X is a-defined array of X;
end;

reserve A,B,C for array;

theorem 
  base-f = inf dom f;

theorem 
  f is (base-f)-based;

theorem 
  dom A = (limit-A) \ (base-A);

theorem 
  dom A = a\b & A is non empty implies base-A = b & limit-A = a;

theorem 
  for f be T-Sequence holds
  base-f = 0 & limit-f = dom f & len-f = dom f;

registration
  let a,b,X;
  cluster b-based natural-valued INT-valued real-valued complex-valued
  finite for array of a,X;
end;

registration
  let a,x;
  cluster {[a,x]} -> segmental;
end;

registration
  let a; let x be Nat;
  cluster {[a,x]} -> natural-valued for array;
end;

registration
  let a; let x be real number;
  cluster {[a,x]} -> real-valued for array;
end;

registration
  let a; let X be non empty set;
  let x be Element of X;
  cluster {[a,x]} -> X-valued for array;
end;

registration
  let a,x;
  cluster {[a,x]} -> a-based succ a-limited for array;
end;

registration
  let b;
  cluster non empty b-based natural-valued INT-valued real-valued
  complex-valued finite for array;
  let X be non empty set;
  cluster non empty b-based finite X-valued for array;
end;

notation
  let s be T-Sequence;
  synonym s last for last s;
end;

definition
  let A be array;
  func last A equals

A.union dom A;
end;

registration
  let A be T-Sequence;
  identify A last with last A;
end;

begin 

definition
  let f be Function;
  attr f is descending means


  for a,b st a in dom f & b in dom f & a in b holds f.b c< f.a;
end;

theorem 
  for f being finite array
  st for a st a in dom f & succ a in dom f holds f.succ a c< f.a
  holds f is descending;

theorem 
  for f being array st len-f = omega &
     for a st a in dom f & succ a in dom f holds f.succ a c< f.a
  holds f is descending;

theorem 
  for f being T-Sequence st f is descending & f.0 is finite
  holds f is finite;

theorem 
  for f being T-Sequence st f is descending & f.0 is finite &
  for a st f.a <> {} holds succ a in dom f
  holds last f = {};

scheme 
 A{A() -> T-Sequence, F(set)->set}:
  A() is finite
  provided
 F(A().0) is finite and
 for a st succ a in dom A() & F(A().a) is finite
    holds F(A().succ a) c< F(A().a);

begin 

registration
  let X;
  let f be X-defined Function;
  let a,b be set;
  cluster Swap(f,a,b) -> X-defined;
end;

registration
  let X be set;
  let f be X-valued Function;
  let x,y be set;
  cluster Swap(f,x,y) -> X-valued;
end;

theorem 
  x in dom f & y in dom f implies Swap(f,x,y).x = f.y;

theorem 
  for f being array of X st x in dom f & y in dom f
  holds Swap(f,x,y)/.x = f/.y;

theorem 
  x in dom f & y in dom f implies Swap(f,x,y).y = f.x;

theorem 
  for f being array of X st x in dom f & y in dom f
  holds Swap(f,x,y)/.y = f/.x;

theorem 
  z <> x & z <> y implies Swap(f,x,y).z = f.z;

theorem 
  for f being array of X st z in dom f & z <> x & z <> y
  holds Swap(f,x,y)/.z = f/.z;

theorem 
  x in dom f & y in dom f implies Swap(f,x,y) = Swap(f,y,x);

registration
  let X be non empty set;
  cluster onto for X-valued non empty Function;
end;

registration
  let X be non empty set;
  let f be onto X-valued non empty Function;
  let x,y be Element of dom f;
  cluster Swap(f,x,y) -> onto;
end;

registration
  let A;
  let x,y;
  cluster Swap(A,x,y) -> segmental;
end;

theorem 
  x in dom A & y in dom A implies Swap(Swap(A,x,y),x,y) = A;

registration
  let A be real-valued array;
  let x,y;
  cluster Swap(A,x,y) -> real-valued for array;
end;

begin 

definition
  let A be array;
  mode permutation of A -> array means


  ex f being Permutation of dom A st it = A*f;
end;

theorem 
  for B being permutation of A holds dom B = dom A & rng B = rng A;

theorem 
  A is permutation of A;

theorem 
  A is permutation of B implies B is permutation of A;

theorem 
  A is permutation of B & B is permutation of C implies A is permutation of C;

theorem 
  Swap(id X,x,y) is one-to-one;

registration
  let X be non empty set;
  let x,y be Element of X;
  cluster Swap(id X,x,y) -> one-to-one X-valued X-defined;
end;

registration
  let X be non empty set;
  let x,y be Element of X;
  cluster Swap(id X,x,y) -> onto total;
end;

definition
  let X,Y be non empty set;
  let f be Function of X,Y;
  let x,y be Element of X;
  redefine func Swap(f,x,y) -> Function of X,Y;
end;

theorem 
  x in X & y in X & f = Swap(id X,x,y) & X = dom A implies
  Swap(A,x,y) = A*f;

theorem 
  x in dom A & y in dom A implies
  Swap(A,x,y) is permutation of A & A is permutation of Swap(A,x,y);

theorem 
  x in dom A & y in dom A & A is permutation of B implies
  Swap(A,x,y) is permutation of B & A is permutation of Swap(B,x,y);

begin 

definition
  let O be RelStr;
  let A be array of O;
  attr A is ascending means

  for a,b st a in dom A & b in dom A & a in b holds A/.a <= A/.b;
  func inversions A equals

  {[a,b] where a,b is Element of dom A: a in b & not A/.a <= A/.b};
end;

registration
  let O be RelStr;
  cluster -> ascending for empty array of O;
  let A be empty array of O;
  cluster inversions A -> empty;
end;

reserve O for connected non empty Poset;
reserve R,Q for array of O;

theorem 
  for O for x,y being Element of O holds x > y iff not x <= y;

definition
  let O,R;
  redefine func inversions R equals

  {[a,b] where a,b is Element of dom R: a in b & R/.a > R/.b};
end;

theorem 
  [x,y] in inversions R iff x in dom R & y in dom R & x in y & R/.x > R/.y;

theorem 
  inversions R c= [:dom R, dom R:];

registration
  let O;
  let R be finite array of O;
  cluster inversions R -> finite;
end;

theorem 
  R is ascending iff inversions R = {};

theorem 
  [x,y] in inversions R implies [y,x] nin inversions R;

theorem 
  [x,y] in inversions R & [y,z] in inversions R implies [x,z] in inversions R;

registration
  let O,R;
  cluster inversions R -> Relation-like;
end;

registration
  let O,R;
  cluster inversions R -> asymmetric transitive for Relation;
end;

definition
  let O;
  let a,b be Element of O;
  redefine pred a < b;
  asymmetry;
end;

theorem 
  [x,y] in inversions R implies [x,y] nin inversions Swap(R,x,y);

theorem 
  x in dom R & y in dom R & z <> x & z <> y & t <> x & t <> y
  implies
  ([z,t] in inversions R iff [z,t] in inversions Swap(R,x,y));

theorem 
  [x,y] in inversions R implies
  ([z,y] in inversions R & z in x iff [z,x] in inversions Swap(R,x,y));

theorem 
  [x,y] in inversions R implies
  ([z,x] in inversions R iff z in x & [z,y] in inversions Swap(R,x,y));

theorem 
  [x,y] in inversions R & z in y & [x,z] in inversions Swap(R,x,y) implies
  [x,z] in inversions R;

theorem 
  [x,y] in inversions R & x in z & [z,y] in inversions Swap(R,x,y) implies
  [z,y] in inversions R;

theorem 
  [x,y] in inversions R & y in z & [x,z] in inversions Swap(R,x,y) implies
  [y,z] in inversions R;

theorem 
  [x,y] in inversions R implies
  (y in z & [x,z] in inversions R iff [y,z] in inversions Swap(R,x,y));

definition
  let O,R,x,y;
  func (R,x,y)incl -> Function equals

  [:Swap(id dom R,x,y), Swap(id dom R,x,y):] +*
  id([:{x},(succ y)\x:]\/[:(succ y)\x,{y}:]);
end;

theorem 
  c in (succ b)\a iff a c= c & c c= b;

reserve T for non empty array of O;
reserve p,q,r,s for Element of dom T;

theorem 
  (succ q)\p c= dom T;

theorem 
  dom (T,p,q)incl = [:dom T, dom T:] & rng (T,p,q)incl c= [:dom T, dom T:];

theorem 
  p c= r & r c= q implies
  (T,p,q)incl.(p,r) = [p, r] & (T,p,q)incl.(r,q) = [r,q];

theorem 
  r <> p & s <> q & f = Swap(id dom T,p,q)
  implies (T,p,q)incl.(r,s) = [f.r,f.s];

theorem 
  r in p & f = Swap(id dom T,p,q) implies
  (T,p,q)incl.(r,q) = [f.r,f.q] & (T,p,q)incl.(r,p) = [f.r,f.p];

theorem 
  q in r & f = Swap(id dom T,p,q) implies
  (T,p,q)incl.(p,r) = [f.p,f.r] & (T,p,q)incl.(q,r) = [f.q,f.r];

theorem 
  p in q implies (T,p,q)incl.(p,q) = [p,q];

theorem 
  p in q & r <> p & r <> q & s <> p & s <> q implies (T,p,q)incl.(r,s) = [r,s];

theorem 
  r in p & p in q implies (T,p,q)incl.(r,p) = [r,q] & (T,p,q)incl.(r,q) = [r,p]
;

theorem 
  p in s & s in q implies (T,p,q)incl.(p,s) = [p,s] & (T,p,q)incl.(s,q) = [s,q]
;

theorem 
  p in q & q in s implies (T,p,q)incl.(p,s) = [q,s] & (T,p,q)incl.(q,s) = [p,s]
;

theorem 
  p in q implies (T,p,q)incl|(inversions Swap(T,p,q) qua set) is one-to-one;

registration
  let O,R,x,y,z;
  cluster (R,x,y)incl.:z -> Relation-like;
end;

begin 

theorem 
  [x,y] in inversions R implies
  (R,x,y)incl.:inversions Swap(R,x,y) c< inversions R;

registration
  let R be finite Function;
  let x,y;
  cluster Swap(R,x,y) -> finite;
end;

theorem 
  for R being array of O
  st [x,y] in inversions R & inversions R is finite
  holds card inversions Swap(R,x,y) in card inversions R;

theorem 
  for R being finite array of O st [x,y] in inversions R
  holds card inversions Swap(R,x,y) < card inversions R;

definition
  let O,R;
  mode arr_computation of R -> non empty array means


  it.(base-it) = R & (for a st a in dom it holds it.a is array of O) &
  for a st a in dom it & succ a in dom it
  ex R,x,y st [x,y] in inversions R & it.a = R & it.succ a = Swap(R,x,y);
end;

theorem 
  {[a,R]} is arr_computation of R;

registration
  let O,R,a;
  cluster a-based finite for arr_computation of R;
end;

registration
  let O,R;
  let C be arr_computation of R;
  let x;
  cluster C.x -> segmental Function-like Relation-like;
end;

registration
  let O,R;
  let C be arr_computation of R;
  let x;
  cluster C.x -> the carrier of O-valued;
end;

registration
  let O,R;
  let C be arr_computation of R;
  cluster last C -> segmental Relation-like Function-like;
end;

registration
  let O,R;
  let C be arr_computation of R;
  cluster last C -> the carrier of O-valued;
end;

definition
  let O,R;
  let C be arr_computation of R;
  attr C is complete means

last C is ascending;
end;

theorem 
  for C being 0-based arr_computation of R st R is finite array of O
  holds C is finite;

theorem 
  for C being 0-based arr_computation of R st R is finite array of O &
  for a st inversions (C.a) <> {} holds succ a in dom C
  holds C is complete;

theorem 
  for C being finite arr_computation of R
  holds last C is permutation of R &
  for a st a in dom C holds C.a is permutation of R;

begin 

theorem 
  for A being 0-based finite array of X st A <> {} holds last A in X;

theorem 
  last <%x%> = x;

theorem 
  for A being 0-based finite array holds last (A^<%x%>) = x;

registration
  let X be set;
  cluster -> X-valued for Element of X^omega;
end;

scheme 
 A{F(set)->set, X()->non empty set, P[set,set], s()->set}:
  ex f being finite 0-based non empty array, k being Element of X() st
  k = last f & F(k) = {} & f.0 = s() &
  for a st succ a in dom f
  ex x,y being Element of X() st x = f.a & y = f.succ a & P[x,y]
 provided
 s() in X() and
 F(s()) is finite and
 for x being Element of X() st F(x) <> {}
    ex y being Element of X() st P[x,y] & F(y) c< F(x);

reserve A for array, B for permutation of A;

theorem 
  B in Funcs(dom A, rng A);

registration
  let A be real-valued array;
  cluster -> real-valued for permutation of A;
end;

registration
  let a;
  let X be non empty set;
  cluster -> T-Sequence-like for Element of Funcs(a,X);
end;

registration
  let X;
  let Y be real-membered non empty set;
  cluster -> real-valued for Element of Funcs(X,Y);
end;

registration
  let X;
  let A be array of X;
  cluster -> X-valued for permutation of A;
end;

registration
  let X be set;
  let Z be set;
  let Y be Subset of Z;
  cluster -> Z-valued for Element of Funcs(X,Y);
end;

theorem 
  for r being X-defined Y-valued Relation holds r is Relation of X,Y;

theorem 
 for a being finite Ordinal, x st x in a
      holds x = 0 or ex b st x = succ b;

theorem 
  for A being 0-based finite non empty array of O
  ex C being 0-based arr_computation of A st C is complete;

theorem 
  for A being 0-based finite non empty array of O
  ex B being permutation of A st B is ascending;

registration
  let O;
  let A be 0-based finite array of O;
  cluster ascending for permutation of A;
end;















begin 

 reserve X,Y for set,
         n,m,k,i for Nat,
         r for real number,
         R for Element of F_Real,
         K for Field,
         f,f1,f2,g1,g2 for FinSequence,
         rf,rf1,rf2 for real-valued FinSequence,
         cf,cf1,cf2 for complex-valued FinSequence,
         F for Function;

registration
  let X,Y;
  let F be positive-yielding PartFunc of X,REAL;
  cluster F|Y -> positive-yielding;
end;

registration
  let X,Y;
  let F be negative-yielding PartFunc of X,REAL;
  cluster F|Y -> negative-yielding;
end;

registration
  let X,Y;
  let F be nonpositive-yielding PartFunc of X,REAL;
  cluster F|Y -> nonpositive-yielding;
end;

registration
  let X,Y;
  let F be nonnegative-yielding PartFunc of X,REAL;
  cluster F|Y -> nonnegative-yielding;
end;

registration
  let rf;
  cluster sqrt rf -> FinSequence-like;
end;

definition
  let rf;
  func @rf -> FinSequence of F_Real equals

    rf;
end;

definition
  let p be FinSequence of F_Real;
  func @p -> FinSequence of REAL equals

    p;
end;

theorem 
  @rf1 + @rf2 = rf1 + rf2;

theorem 
  sqrt (rf1^rf2) = (sqrt rf1) ^ (sqrt rf2);

theorem 
  sqrt <*r*> = <*sqrt r*>;

theorem 
  sqrt(rf^2)=abs rf;

theorem 
  rf is nonnegative-yielding implies sqrt Sum rf <= Sum sqrt rf;

theorem 
  ex X st X c= dom F & rng F = rng(F|X) & (F|X) is one-to-one;

registration
  let cf,X;
  cluster cf-X -> complex-valued;
end;

registration
  let rf,X;
  cluster rf-X -> real-valued;
end;

registration
  let cf be complex-valued FinSubsequence;
  cluster Seq cf -> complex-valued;
end;

registration
  let rf be real-valued FinSubsequence;
  cluster Seq rf -> real-valued;
end;

theorem 
  for P be Permutation of dom f st f1 = f*P
    ex Q be Permutation of dom(f-X) st f1-X = (f-X)*Q;

theorem 
  for P be Permutation of dom cf st cf1 = cf*P holds Sum (cf1-X) = Sum(cf-X);

theorem 
  for f,f1 be FinSubsequence for P be Permutation of dom f st f1 = f*P
   ex Q be Permutation of dom Seq(f1|P"X) st Seq(f|X) = Seq(f1|P"X) * Q;

theorem 
  for cf,cf1 be complex-valued FinSubsequence
    for P be Permutation of dom cf st cf1 = cf * P
  holds Sum Seq(cf|X) = Sum Seq(cf1|P"X);

theorem 
  for f be FinSubsequence for n be Element of NAT st
     for i holds i+n in X iff i in Y
  holds (n Shift f) |X = n Shift(f|Y);

theorem 
  ex Y be Subset of NAT st
    Seq((f1^f2) |X) = Seq(f1|X)^Seq(f2|Y) &
    for n st n>0 holds n in Y iff n+len f1 in X/\dom(f1^f2);

theorem 
  len g1 = len f1 & len g2 <= len f2 implies
     Seq((f1^f2) | (g1^g2)"X) = Seq(f1|g1"X) ^ Seq(f2|g2"X);

theorem 
  for D be non empty set for M be Matrix of n,m,D holds
    M-X is Matrix of n-'card(M"X),m,D;

theorem 
  for F be Function of Seg n,Seg n,D be non empty set
    for M be Matrix of n,m,D for i st i in Seg width M
  holds Col(M*F,i) = Col(M,i)*F;

theorem 
  for A be Matrix of n,m,K st the_rank_of A = n
    ex B be Matrix of m-' n,m,K st the_rank_of(A^B) = m;

theorem 
  for A be Matrix of n,m,K st the_rank_of A = m
    ex B be Matrix of n,n-' m,K st the_rank_of(A^^B) = n;

reserve f,f1,f2 for n-element real-valued FinSequence,
        p,p1,p2 for Point of TOP-REAL n,
        M,M1,M2 for Matrix of n,m,F_Real,
        A,B for Matrix of n,F_Real;

begin 
      

definition
  let n,m,M;
  func Mx2Tran M -> Function of TOP-REAL n,TOP-REAL m means

   it.f = Line(LineVec2Mx(@f)*M,1) if n <> 0 otherwise it.f = 0.TOP-REAL m;
end;

registration
  let n,m,M;
  let x be set;
  cluster (Mx2Tran M).x -> Function-like Relation-like;
  cluster (Mx2Tran M).x -> real-valued FinSequence-like;
end;

registration
  let n,m,M,f;
  cluster (Mx2Tran M).f -> m-element;
end;

theorem 
  1 <= i & i <= m & n <> 0 implies (Mx2Tran M).f.i = @f"*"Col(M,i);

theorem 
  len MX2FinS 1.(K,n) = n;

theorem 
  for Bn be OrdBasis of n-VectSp_over F_Real,
      Bm be OrdBasis of m-VectSp_over F_Real st
    Bn = MX2FinS 1.(F_Real,n) & Bm = MX2FinS 1.(F_Real,m)
  for M1 be Matrix of len Bn,len Bm,F_Real st M1 = M
    holds Mx2Tran M = Mx2Tran(M1,Bn,Bm);

theorem 
  for P be Permutation of Seg n holds
   (Mx2Tran M).f = (Mx2Tran(M*P)).(f*P) & f*P is n-element FinSequence of REAL;

theorem 
  (Mx2Tran M).(f1+f2) = (Mx2Tran M).f1 + (Mx2Tran M).f2;

theorem 
  (Mx2Tran M).(r*f) = r * ((Mx2Tran M).f);

theorem 
  (Mx2Tran M).(f1-f2) = (Mx2Tran M).f1 - (Mx2Tran M).f2;

theorem 
  (Mx2Tran(M1+M2)).f = (Mx2Tran M1).f + (Mx2Tran M2).f;

theorem 
  r = R implies r * (Mx2Tran M).f = (Mx2Tran(R*M)).f;

theorem 
  (Mx2Tran M).(p1+p2) = (Mx2Tran M).p1 + (Mx2Tran M).p2;

theorem 
  (Mx2Tran M).(p1-p2) = (Mx2Tran M).p1-(Mx2Tran M).p2;

theorem 
  (Mx2Tran M).0.TOP-REAL n = 0.TOP-REAL m;

theorem 
  for A be Subset of TOP-REAL n holds
   (Mx2Tran M).:(p+A) = (Mx2Tran M).p + (Mx2Tran M).:A;

theorem 
  for A be Subset of TOP-REAL m holds
   (Mx2Tran M)"(((Mx2Tran M).p)+A) = p + (Mx2Tran M)"A;

theorem 
  for A be Matrix of n,m,F_Real,
      B be Matrix of width A,k,F_Real st
      (n = 0 implies m = 0) & (m = 0 implies k = 0)
    holds (Mx2Tran B) * (Mx2Tran A) = Mx2Tran(A*B);

theorem 
  Mx2Tran 1.(F_Real,n) = id TOP-REAL n;

theorem 
  Mx2Tran M1 = Mx2Tran M2 implies M1 = M2;

theorem 
  for A be Matrix of n,m,F_Real,
      B be Matrix of k,m,F_Real
  holds
  (Mx2Tran(A^B)).(f^(k|->0)) = (Mx2Tran A).f &
  (Mx2Tran(B^A)).((k|->0)^f) = (Mx2Tran A).f;

theorem 
  for A be Matrix of n,m,F_Real,
      B be Matrix of k,m,F_Real
  for g be k-element real-valued FinSequence holds
    (Mx2Tran(A^B)).(f^g) = (Mx2Tran A).f+(Mx2Tran B).g;

theorem 
  for A be Matrix of n,k,F_Real,
      B be Matrix of n,m,F_Real
   st n = 0 implies k+m = 0
   holds (Mx2Tran(A^^B)).f = (Mx2Tran A).f^(Mx2Tran B).f;

theorem 
  M = 1.(F_Real,m) |n implies ((Mx2Tran M).f) |n = f;

begin 

theorem 
  Mx2Tran M is one-to-one iff the_rank_of M = n;

theorem 
  Mx2Tran A is one-to-one iff Det A <> 0.F_Real;

theorem 
  Mx2Tran M is onto iff the_rank_of M = m;

theorem 
  Mx2Tran A is onto iff Det A <> 0.F_Real;

theorem 
  for A,B st Det A <> 0.F_Real holds (Mx2Tran A)" = Mx2Tran B iff A~ = B;

theorem 
  ex L be m-element FinSequence of REAL st
     (for i st i in dom L holds L.i=|.@Col(M,i).|) &
      for f holds|.(Mx2Tran M).f.|<=Sum L*|.f.|;

theorem 
  ex L be Real st L>0 & for f holds |.(Mx2Tran M).f.| <= L*|.f.|;

theorem 
  the_rank_of M = n implies
    ex L be Real st L > 0 & for f holds |.f.| <= L*|.(Mx2Tran M).f.|;

theorem 
  Mx2Tran M is continuous;

registration
  let n,K;
  cluster invertible for Matrix of n,K;
end;

registration
  let n;
  let A be invertible Matrix of n,F_Real;
  cluster Mx2Tran A -> being_homeomorphism;
end;














begin 
      

reserve X for set,
        n,m,k for Nat,
        K for Field,
        f for n-element real-valued FinSequence,
        M for Matrix of n,m,F_Real;

theorem 
  X is Linear_Combination of n-VectSp_over F_Real
iff
  X is Linear_Combination of TOP-REAL n;

theorem 
  for Lv be Linear_Combination of n-VectSp_over F_Real,
      Lr be Linear_Combination of TOP-REAL n st Lr = Lv
  holds Carrier Lr = Carrier Lv;

theorem 
  for F be FinSequence of TOP-REAL n,
      fr be Function of TOP-REAL n,REAL,
      Fv be FinSequence of n-VectSp_over F_Real,
      fv be Function of n-VectSp_over F_Real,F_Real st fr = fv & F = Fv
  holds fr(#)F = fv(#)Fv;

theorem 
  for F be FinSequence of TOP-REAL n,
      Fv be FinSequence of n-VectSp_over F_Real st Fv = F
  holds Sum F = Sum Fv;

theorem 
  for Lv be Linear_Combination of n-VectSp_over F_Real,
      Lr be Linear_Combination of TOP-REAL n st Lr = Lv
  holds Sum Lr = Sum Lv;

theorem 
  for Af be Subset of n-VectSp_over F_Real,
      Ar be Subset of TOP-REAL n st Af = Ar
  holds [#]Lin Ar = [#]Lin Af;

theorem 
  for Af be Subset of n-VectSp_over F_Real,
      Ar be Subset of TOP-REAL n st Af = Ar
  holds
    Af is linearly-independent
  iff
    Ar is linearly-independent;

theorem 
  for V be VectSp of K, W be Subspace of V, L be Linear_Combination of V
  holds L|the carrier of W is Linear_Combination of W;

theorem 
  for V be VectSp of K, A be linearly-independent Subset of V
  for L1,L2 be Linear_Combination of V st
     Carrier L1 c= A & Carrier L2 c= A & Sum L1 = Sum L2
  holds L1 = L2;

theorem 
  for V be RealLinearSpace, W be Subspace of V
  for L be Linear_Combination of V
  holds L|the carrier of W is Linear_Combination of W;

theorem 
  for U be Subspace of n-VectSp_over F_Real,
      W be Subspace of TOP-REAL n st [#]U = [#]W
  holds
    X is Linear_Combination of U
  iff
    X is Linear_Combination of W;

theorem 
  for U be Subspace of n-VectSp_over F_Real, W be Subspace of TOP-REAL n
  for LU be Linear_Combination of U, LW be Linear_Combination of W st LU = LW
  holds Carrier LU = Carrier LW & Sum LU = Sum LW;

registration
  let m,K;
  let A be Subset of m-VectSp_over K;
  cluster Lin A -> finite-dimensional;
end;

begin 
      

theorem 
  the_rank_of M = n implies M is OrdBasis of Lin lines M;

theorem 
  for V,W be VectSp of K
  for T be linear-transformation of V,W
  for A be Subset of V for L be Linear_Combination of A st T|A is one-to-one
  holds T.(Sum L) = Sum (T@L);

theorem 
  for S be Subset of Seg n st M|S is one-to-one & rng(M|S) = lines M
  ex L be Linear_Combination of lines M st
    Sum L = (Mx2Tran M).f &
    for k st k in S holds L.Line(M,k) = Sum Seq(f|M"{Line(M,k)});

theorem 
  M is without_repeated_line implies
  ex L be Linear_Combination of lines M st
    Sum L=(Mx2Tran M).f &
    for k st k in dom f holds L.Line(M,k)=f.k;

theorem 
  for B be OrdBasis of Lin lines M st B = M
  for Mf be Element of Lin lines M st Mf = (Mx2Tran M).f holds Mf|--B = f;

theorem 
  rng(Mx2Tran M) = [#]Lin lines M;

theorem 
  for F be one-to-one FinSequence of TOP-REAL n st
    rng F is linearly-independent
  ex M be Matrix of n,F_Real st M is invertible & M|len F = F;

theorem 
  for B be OrdBasis of n-VectSp_over F_Real st B = MX2FinS 1.(F_Real,n) holds
    f in Lin rng(B|k)
  iff
    f = (f|k)^((n-' k) |->0);

theorem 
  for F be one-to-one FinSequence of TOP-REAL n st
    rng F is linearly-independent
  for B be OrdBasis of n-VectSp_over F_Real st B = MX2FinS 1.(F_Real,n)
  for M be Matrix of n,F_Real st M is invertible & M|len F = F
  holds (Mx2Tran M).:[#]Lin rng(B|len F) = [#]Lin rng F;

theorem 
  for A,B be linearly-independent Subset of TOP-REAL n st card A = card B
  ex M be Matrix of n,F_Real st
   M is invertible & (Mx2Tran M).:[#]Lin A = [#]Lin B;

begin 
      

theorem 
  for A be linearly-independent Subset of TOP-REAL n st the_rank_of M = n
  holds (Mx2Tran M).:A is linearly-independent;

theorem 
  for A be affinely-independent Subset of TOP-REAL n st the_rank_of M = n
  holds (Mx2Tran M).:A is affinely-independent;

theorem 
  for A be affinely-independent Subset of TOP-REAL n st the_rank_of M = n
  for v be Element of TOP-REAL n st v in Affin A holds
   (Mx2Tran M).v in Affin(Mx2Tran M).:A &
   for f holds (v|--A).f = ((Mx2Tran M).v|--(Mx2Tran M).:A).((Mx2Tran M).f);

theorem 
  for A be linearly-independent Subset of TOP-REAL m st the_rank_of M = n
  holds (Mx2Tran M)"A is linearly-independent;

theorem 
  for A be affinely-independent Subset of TOP-REAL m st the_rank_of M = n
  holds (Mx2Tran M)"A is affinely-independent;














begin

reserve a,b,c for boolean number;

theorem 
  (a=>(b '&' c))=>(a=>b)=1;

theorem 
  (a=>(b=>c))=>((a '&' b)=>c)=1;

theorem 
  ((a '&' b)=>c)=>(a=>(b=>c))=1;

begin 

notation
  synonym LTLB_WFF for HP-WFF;
end;

reserve p,q,r,s,A,B,C for Element of LTLB_WFF,
        F,G,X,Y for Subset of LTLB_WFF,
        i,j,k,n for Element of NAT,
        f,f1,f2,g for FinSequence of LTLB_WFF;

notation
  synonym TFALSUM for VERUM;
end;

notation let p,q;
  synonym p 'Us' q for p '&' q;
end;

theorem 
  for A holds A=TFALSUM or
  ex n st A=prop n or ex p,q st A=p=>q or ex p,q st A=p 'Us' q;

definition let p;
  func 'not' p -> Element of LTLB_WFF equals

  p => TFALSUM;
  func 'X' p -> Element of LTLB_WFF equals

  TFALSUM 'Us' p;
end;

definition
  func TVERUM -> Element of LTLB_WFF equals

  'not' TFALSUM;
end;

definition let p,q;
  func p '&&' q -> Element of LTLB_WFF equals

  (p=>(q=>TFALSUM))=>TFALSUM;
end;

definition let p,q;
  func p 'or' q -> Element of LTLB_WFF equals

  'not'(('not' p)'&&'('not' q));
end;

definition let p;
  func 'G' p -> Element of LTLB_WFF equals

  'not'(('not' p)'or'(TVERUM '&&'(TVERUM 'Us'('not' p))));
end;

definition let p;
  func 'F' p -> Element of LTLB_WFF equals

  'not'('G'('not' p));
end;

definition let p,q;
  func p 'U' q -> Element of LTLB_WFF equals

  q 'or'(p '&&'(p 'Us' q));
end;

definition let p,q;
  func p 'R' q -> Element of LTLB_WFF equals

  'not'(('not' p)'U'('not' q));
end;

begin 

definition
  func props -> Subset of LTLB_WFF means

  for x be set holds x in it iff ex n be Element of NAT st x=prop n;
end;

definition
  mode LTLModel is sequence of bool props;
end;

reserve M for LTLModel;

definition let M be LTLModel;
  func SAT M -> Function of[:NAT,LTLB_WFF:],BOOLEAN means

  for n holds it.[n,TFALSUM]=0 &
  (for k holds it.[n,prop k]=1 iff prop k in M.n) &
  for p,q holds it.[n,p=>q]=it.[n,p]=>it.[n,q] &
  (it.[n,p 'Us' q]=1 iff ex i st 0<i & it.[n+i,q]=1 &
  for j st 1<=j & j<i holds it.[n+j,p]=1);
end;

theorem 
  (SAT M).[n,'not' A]=1 iff (SAT M).[n,A]=0;

theorem 
  (SAT M).[n,TVERUM]=1;

theorem 
  (SAT M).[n,A '&&' B]=1 iff (SAT M).[n,A]=1 & (SAT M).[n,B]=1;

theorem 
  (SAT M).[n,A 'or' B]=1 iff ((SAT M).[n,A]=1 or(SAT M).[n,B]=1);

theorem 
  (SAT M).[n,'X' A]=(SAT M).[n+1,A];

theorem 
  (SAT M).[n,'G' A]=1 iff for i holds(SAT M).[n+i,A]=1;

theorem 
  (SAT M).[n,'F' A]=1 iff ex i st(SAT M).[n+i,A]=1;

theorem 
  (SAT M).[n,p 'U' q]=1 iff
  ex i st (SAT M).[n+i,q]=1 & for j st j<i holds (SAT M).[n+j,p]=1;

theorem 
  (SAT M).[n,p 'R' q]=1 iff
  ((ex i st(SAT M).[n+i,p]=1 &
  for j st j<=i holds (SAT M).[n+j,q]=1) or
  for i holds (SAT M).[n+i,q]=1);

theorem 
  (SAT M).[n,'not'('X' B)]=(SAT M).[n,'X'('not' B)];

theorem 
  (SAT M).[n,('not'('X' B))=>('X'('not' B))]=1;

theorem 
  (SAT M).[n,('X'('not' B))=>('not'('X' B))]=1;

theorem 
  (SAT M).[n,('X'(B=>C))=>(('X' B)=>('X' C))]=1;

theorem 
  (SAT M).[n,('G' B)=>(B '&&'('X'('G' B)))]=1;

theorem 
  (SAT M).[n,(B 'Us' C)=>(('X' C)'or'('X'(B '&&'(B 'Us' C))))]=1;

theorem 
  (SAT M).[n,(('X' C)'or'('X'(B '&&'(B 'Us' C))))=>(B 'Us' C)]=1;

theorem 
  (SAT M).[n,(B 'Us' C)=>('X'('F' C))]=1;

begin 

definition let M,p;
  pred M|=p means

  for n be Element of NAT holds(SAT M).[n,p]=1;
end;

definition let M,F;
  pred M|=F means

  for p st p in F holds M|=p;
end;

definition let F,p;
  pred F|=p means

  for M holds(M|=F implies M|=p);
end;

theorem 
  M|=F & M|=G iff M|=F\/G;

theorem 
  M|=A iff M |= {A};

theorem 
 F|=A & F|=A=>B implies F|=B;

theorem 
  F|=A implies F|='X' A;

theorem 
  F|=A implies F|='G' A;

theorem 
  F|=A=>B & F|=A=>('X' A) implies F|=A=>('G' B);

theorem 
 (SAT(M^\i)).[j,A]=(SAT M).[i+j,A];

theorem 
  M|=F implies M^\i|=F;

theorem 
  F\/{A}|=B iff F|=('G' A)=>B;

definition let f be Function of LTLB_WFF,BOOLEAN;
  func VAL f -> Function of LTLB_WFF,BOOLEAN means

  it.TFALSUM=0 & it.(prop n)=f.(prop n) &
  it.(A=>B)=it.A=>it.B & it.(A 'Us' B)=f.(A 'Us' B);
end;

theorem 
  for f be Function of LTLB_WFF,BOOLEAN,p,q holds
  (VAL f).(p '&&' q)=(VAL f).p'&'(VAL f).q;

theorem 
  for f be Function of LTLB_WFF,BOOLEAN st
  (for B be set st B in LTLB_WFF holds f.B=(SAT M).[n,B]) holds
  (VAL f).A=(SAT M).[n,A];

definition let p;
  attr p is LTL_TAUT_OF_PL means

  for f be Function of LTLB_WFF,BOOLEAN holds(VAL f).p=1;
end;

theorem 
  A is LTL_TAUT_OF_PL implies F|=A;

begin 

definition let D be set;
  attr D is with_LTL_axioms means

  for p,q holds (p is LTL_TAUT_OF_PL implies p in D) &
  ('not'('X' p))=>('X'('not' p)) in D &
  ('X'('not' p))=>('not'('X' p)) in D &
  ('X'(p=>q))=>(('X' p)=>('X' q)) in D &
  ('G' p)=>(p '&&'('X'('G' p))) in D &
  (p 'Us' q)=>(('X' q)'or'('X'(p '&&'(p 'Us' q)))) in D &
  (('X' q)'or'('X'(p '&&'(p 'Us' q))))=>(p 'Us' q) in D &
  (p 'Us' q)=>('X'('F' q)) in D;
end;

definition
  func LTL_axioms -> Subset of LTLB_WFF means

  it is with_LTL_axioms &
  for D be Subset of LTLB_WFF st D is with_LTL_axioms holds it c=D;
end;

registration
  cluster LTL_axioms -> with_LTL_axioms;
end;

theorem 
  p=>(q=>p) in LTL_axioms;

theorem 
 (p=>(q=>r))=>((p=>q)=>(p=>r)) in LTL_axioms;

definition let p,q;
  pred p NEX_rule q means

  q='X' p;
  let r;
  pred p,q MP_rule r means

  q=p=>r;
  pred p,q IND_rule r means

  ex A,B st p=A=>B & q=A=>('X' A) & r=A=>('G' B);
end;

registration
  cluster LTL_axioms -> non empty;
end;

definition let A;
  attr A is axltl1 means

  ex B st A=('not'('X' B))=>('X'('not' B));
  attr A is axltl1a means

  ex B st A=('X'('not' B))=>('not'('X' B));
  attr A is axltl2 means

  ex B,C st A=('X'(B=>C))=>(('X' B)=>('X' C));
  attr A is axltl3 means

  ex B st A=('G' B)=>(B '&&'('X'('G' B)));
  attr A is axltl4 means

  ex B,C st A=(B 'Us' C)=>(('X' C)'or'('X'(B '&&'(B 'Us' C))));
  attr A is axltl5 means

  ex B,C st A=(('X' C)'or'('X'(B '&&'(B 'Us' C))))=>(B 'Us' C);
  attr A is axltl6 means

  ex B,C st A=(B 'Us' C)=>('X'('F' C));
end;

theorem 
  for A be Element of LTL_axioms holds
  (A is LTL_TAUT_OF_PL or A is axltl1 or A is axltl1a or
  A is axltl2 or A is axltl3 or A is axltl4 or A is axltl5 or A is axltl6);

theorem 
  A is axltl1 or A is axltl1a or A is axltl2 or A is axltl3 or
  A is axltl4 or A is axltl5 or A is axltl6 implies F|=A;

definition let i be Nat,f,X;
  pred prc f,X,i means

  f.i in LTL_axioms or f.i in X or
  (ex j,k be Nat st 1<=j & j<i & 1<=k & k<i & (
  f/.j,f/.k MP_rule f/.i or f/.j,f/.k IND_rule f/.i)) or
  ex j be Nat st 1<=j & j<i & f/.j NEX_rule f/.i;
end;

definition let X,p;
  pred X|-p means

  ex f st f.len f=p & 1<=len f &
  for i be Nat st 1<=i & i<=len f holds prc f,X,i;
end;

theorem 
  for i,n be Nat st
  n+len f<=len f2 & (for k be Nat st 1<=k & k<=len f holds f.k=f2.(k+n)) &
  1 <=i & i<=len f holds prc f,X,i implies prc f2,X,(i+n);

theorem 
  f2=f^f1 & 1<=len f & 1<=len f1 &
  (for i be Nat st 1<=i & i<=len f holds prc f,X,i) &
  (for i be Nat st 1<=i & i<=len f1 holds prc f1,X,i) implies
  for i be Nat st 1<=i & i<=len f2 holds prc f2,X,i;

theorem 
  (f=f1^<*p*> & 1<=len f1 &
  for i be Nat st 1<=i & i<=len f1 holds prc f1,X,i) &
  prc f,X,len f implies (for i be Nat st 1<=i & i<=len f holds prc f,X,i) &
  X|-p;

theorem 
  F|-A implies F|=A;

begin 

theorem 
  p in LTL_axioms or p in X implies X|-p;

theorem 
  X|-p & X|-p=>q implies X|-q;

theorem 
  X|-p implies X|-'X' p;

theorem 
  X|-p=>q & X|-p=>('X' p) implies X|-p=>('G' q);

theorem 
  X|-r=>(p '&&' q) implies X|-r=>p & X|-r=>q;

theorem 
  X|-p=>q & X|-q=>r implies X|-p=>r;

theorem 
  X|-p=>(q=>r) implies X|-(p '&&' q)=>r;

theorem 
  X|-(p '&&' q)=>r implies X|-p=>(q=>r);

theorem 
  X|-(p '&&' q)=>r & X|-p=>s implies X|-(p '&&' q)=>(s '&&' r);

theorem 
  X|-p=>(q=>r) & X|-r=>s implies X|-p=>(q=>s);

theorem 
  X|-p=>q implies X|-('not' q)=>('not' p);

theorem 
  X|-(('X' p)'&&'('X' q))=>('X'(p '&&' q));

theorem 
  F|-p implies F|-'G' p;

theorem 
  p=>q in F implies F\/{p}|-'G' q;

theorem 
  F|-q implies F\/{p}|-q;

theorem 
  F\/{p}|-q implies F|-('G' p)=>q;

theorem 
  F|-p=>q implies F\/{p}|-q;

theorem 
  F|-('G' p)=>q implies F\/{p}|-q;

theorem 
  F|-('G'(p=>q))=>(('G' p)=>('G' q));














begin 

definition
  let V be ComplexAlgebra;
  mode ComplexSubAlgebra of V -> ComplexAlgebra means

    the carrier of it c= the carrier of V
    & the addF of it = (the addF of V)||the carrier of it
    & the multF of it = (the multF of V)||the carrier of it
    & the Mult of it = (the Mult of V) | [:COMPLEX,the carrier of it:]
    & 1.it = 1.V & 0.it = 0.V;
end;

theorem 
  for X being non empty set,
      V being ComplexAlgebra,
      V1 being non empty Subset of V,
      d1,d2 being Element of X,
      A being BinOp of X,
      M being Function of [:X,X:],X,
      MR being Function of [:COMPLEX,X:],X st
  (V1 = X & d1 = 0.V & d2 = 1.V
  & A = (the addF of V)||V1 & M = (the multF of V)||V1
  & MR = (the Mult of V) | [:COMPLEX,V1:]
  & V1 is having-inverse)
  holds ComplexAlgebraStr(#X,M,A,MR,d2,d1#) is ComplexSubAlgebra of V;

registration let V be ComplexAlgebra;
  cluster strict for ComplexSubAlgebra of V;
end;

definition let V be ComplexAlgebra, V1 be Subset of V;
  attr V1 is Cadditively-linearly-closed means

  V1 is add-closed having-inverse &
  for a be Complex, v be Element of V st v in V1 holds a * v in V1;
end;

definition let V be ComplexAlgebra, V1 be Subset of V such that
 V1 is Cadditively-linearly-closed non empty;
  func Mult_(V1,V) -> Function of [:COMPLEX,V1:], V1 equals

  (the Mult of V) | [:COMPLEX,V1:];
end;

definition let X be non empty set;
  func ComplexBoundedFunctions(X) -> non empty Subset of CAlgebra X equals

  { f where f is Function of X,COMPLEX : f|X is bounded };
end;

registration let X be non empty set;
  cluster CAlgebra X -> scalar-unital;
end;

registration let X be non empty set;
  cluster ComplexBoundedFunctions(X) -> Cadditively-linearly-closed
      multiplicatively-closed;
end;

registration let V be ComplexAlgebra;
  cluster Cadditively-linearly-closed multiplicatively-closed
    for non empty Subset of V;
end;

definition let V be non empty CLSStruct;
  attr V is scalar-mult-cancelable means

  for a be Complex, v be Element of V st a*v=0.V holds a=0 or v=0.V;
end;

theorem 
  for V being ComplexAlgebra,
      V1 being Cadditively-linearly-closed multiplicatively-closed
    non empty Subset of V holds
  ComplexAlgebraStr(# V1,mult_(V1,V), Add_(V1,V), Mult_(V1,V), One_(V1,V),
    Zero_(V1,V) #) is ComplexSubAlgebra of V;

theorem 
  for V be ComplexAlgebra, V1 be ComplexSubAlgebra of V holds
  ( for v1,w1 be Element of V1, v,w be Element of V st
     v1=v & w1=w holds v1+w1=v+w ) &
  ( for v1,w1 be Element of V1, v,w be Element of V st
     v1=v & w1=w holds v1*w1=v*w ) &
  ( for v1 be Element of V1, v be Element of V, a be Complex st
     v1=v holds a*v1=a*v ) &
  1_V1 = 1_V & 0.V1=0.V;

definition let X be non empty set;
  func C_Algebra_of_BoundedFunctions X -> ComplexAlgebra equals

  ComplexAlgebraStr (#
    ComplexBoundedFunctions(X),
    mult_(ComplexBoundedFunctions(X),CAlgebra(X)),
    Add_(ComplexBoundedFunctions(X),CAlgebra(X)),
    Mult_(ComplexBoundedFunctions(X),CAlgebra(X)),
    One_(ComplexBoundedFunctions(X),CAlgebra(X)),
    Zero_(ComplexBoundedFunctions(X),CAlgebra(X)) #);
end;

theorem 
  for X being non empty set holds C_Algebra_of_BoundedFunctions(X) is
    ComplexSubAlgebra of CAlgebra(X);

registration let X be non empty set;
  cluster C_Algebra_of_BoundedFunctions(X) ->
    vector-distributive scalar-unital;
end;

theorem 
  for X being non empty set,
      F, G, H being VECTOR of C_Algebra_of_BoundedFunctions(X),
      f, g, h being Function of X,COMPLEX st f=F & g=G & h=H holds
  ( H = F+G iff (for x be Element of X holds h.x = (f.x) + (g.x)) );

theorem 
  for X being non empty set, a being Complex,
      F, G being VECTOR of C_Algebra_of_BoundedFunctions(X),
      f, g being Function of X,COMPLEX st f=F & g=G holds
  ( G = a*F iff for x be Element of X holds g.x = a*(f.x) );

theorem 
  for X being non empty set,
      F, G, H being VECTOR of C_Algebra_of_BoundedFunctions(X),
      f, g, h being Function of X,COMPLEX st f=F & g=G & h=H holds
  ( H = F*G iff for x be Element of X holds h.x = (f.x)*(g.x));

theorem 
  for X being non empty set holds
    0.C_Algebra_of_BoundedFunctions X = X -->0;

theorem 
  for X being non empty set holds
    1_C_Algebra_of_BoundedFunctions X = X --> 1r;

definition let X be non empty set, F be set;
  assume
 F in ComplexBoundedFunctions(X);
  func modetrans(F,X) -> Function of X,COMPLEX means

  it = F & it|X is bounded;
end;

definition let X be non empty set, f be Function of X,COMPLEX;
  func PreNorms f -> non empty Subset of REAL equals

  { |.f.x.| where x is Element of X : not contradiction };
end;

theorem 
  for X being non empty set,
      f being Function of X,COMPLEX st f | X is bounded holds
                    PreNorms f is bounded_above;

theorem 
  for X being non empty set,
      f being Function of X,COMPLEX holds
  f|X is bounded iff PreNorms f is bounded_above;

definition let X be non empty set;
  func ComplexBoundedFunctionsNorm(X) ->
              Function of ComplexBoundedFunctions(X),REAL means

  for x be set st x in ComplexBoundedFunctions(X) holds
  it.x = upper_bound PreNorms(modetrans(x,X));
end;

theorem 
  for X being non empty set,
      f being Function of X,COMPLEX st f|X is bounded holds
                             modetrans(f,X) = f;

theorem 
  for X being non empty set,
      f being Function of X,COMPLEX st f|X is bounded holds
  (ComplexBoundedFunctionsNorm(X)).f = upper_bound PreNorms f;

definition let X be non empty set;
  func C_Normed_Algebra_of_BoundedFunctions(X) -> Normed_Complex_AlgebraStr
  equals

  Normed_Complex_AlgebraStr(# ComplexBoundedFunctions(X),
    mult_(ComplexBoundedFunctions(X),CAlgebra(X)),
    Add_(ComplexBoundedFunctions(X),CAlgebra(X)),
    Mult_(ComplexBoundedFunctions(X),CAlgebra(X)),
    One_(ComplexBoundedFunctions(X),CAlgebra(X)),
    Zero_(ComplexBoundedFunctions(X),CAlgebra(X)),
    ComplexBoundedFunctionsNorm(X) #);
end;

registration let X be non empty set;
  cluster C_Normed_Algebra_of_BoundedFunctions(X) -> non empty;
end;

registration let X be non empty set;
  cluster C_Normed_Algebra_of_BoundedFunctions(X) -> unital;
end;

theorem 
  for W being Normed_Complex_AlgebraStr,
      V being ComplexAlgebra st
      ComplexAlgebraStr(# the carrier of W,the multF of W,
                  the addF of W,the Mult of W,
                  the OneF of W,the ZeroF of W #) = V holds
     W is ComplexAlgebra;

theorem 
  for X being non empty set holds
    C_Normed_Algebra_of_BoundedFunctions(X) is ComplexAlgebra;

theorem 
  for X being non empty set,
      F being Point of C_Normed_Algebra_of_BoundedFunctions(X) holds
          Mult_(ComplexBoundedFunctions(X),CAlgebra(X)).(1r,F) = F;

theorem 
  for X being non empty set holds
    C_Normed_Algebra_of_BoundedFunctions(X) is ComplexLinearSpace;

theorem 
  for X being non empty set holds
    X --> 0 = 0.(C_Normed_Algebra_of_BoundedFunctions(X));

theorem 
  for X being non empty set,
      x being Element of X,
      f being Function of X,COMPLEX,
      F being Point of C_Normed_Algebra_of_BoundedFunctions(X) st
        f = F & f | X is bounded holds |.f.x.| <= ||.F.||;

theorem 
  for X being non empty set,
      F being Point of C_Normed_Algebra_of_BoundedFunctions(X) holds
            0 <= ||.F.||;

theorem 
  for X being non empty set,
      F being Point of C_Normed_Algebra_of_BoundedFunctions(X) st
        F = 0.(C_Normed_Algebra_of_BoundedFunctions X) holds
                           0 = ||.F.||;

theorem 
  for X being non empty set,
      f, g, h being Function of X,COMPLEX,
      F, G, H being Point of C_Normed_Algebra_of_BoundedFunctions(X)
                                   st f = F & g = G & h = H holds
  (H = F+G iff for x being Element of X holds h.x = (f.x) + (g.x));

theorem 
  for X being non empty set,
      a being Complex,
      f, g being Function of X,COMPLEX,
      F, G being Point of C_Normed_Algebra_of_BoundedFunctions(X)
                               st f = F & g = G holds
  ( G = a*F iff for x being Element of X holds g.x = a*(f.x));

theorem 
  for X being non empty set,
      f, g, h being Function of X,COMPLEX,
      F, G, H being Point of C_Normed_Algebra_of_BoundedFunctions(X)
                            st f = F & g = G & h = H holds
  (H = F*G iff for x being Element of X holds h.x = (f.x)*(g.x));

theorem 
  for X being non empty set,
      a being Complex,
      F, G being Point of C_Normed_Algebra_of_BoundedFunctions(X) holds
  ((||.F.|| = 0 implies F = 0.C_Normed_Algebra_of_BoundedFunctions(X))
  & (F = 0.C_Normed_Algebra_of_BoundedFunctions(X) implies ||.F.|| = 0)
  & ||.(a*F).|| = (|.a.|)*||.F.|| & ||.(F + G).|| <= ||.F.|| + ||.G.||);

registration let X be non empty set;
  cluster C_Normed_Algebra_of_BoundedFunctions(X) -> right_complementable
      Abelian add-associative right_zeroed vector-distributive
      scalar-distributive scalar-associative scalar-unital discerning
      reflexive ComplexNormSpace-like;
end;

theorem 
  for X being non empty set,
      f, g, h being Function of X,COMPLEX,
      F, G, H being Point of C_Normed_Algebra_of_BoundedFunctions(X)
                              st f = F & g = G & h = H holds
  ( H = F-G iff for x being Element of X holds h.x = (f.x)-(g.x));

theorem 
  for X being non empty set,
      seq being sequence of C_Normed_Algebra_of_BoundedFunctions(X)
                    st seq is CCauchy holds seq is convergent;

registration let X be non empty set;
  cluster C_Normed_Algebra_of_BoundedFunctions(X) -> complete;
end;

theorem 
  for X being non empty set holds
    C_Normed_Algebra_of_BoundedFunctions(X) is Complex_Banach_Algebra;















begin







reserve E,F,G for RealNormSpace;
reserve f for Function of E,F;
reserve g for Function of F,G;
reserve a,b,c for Point of E;
reserve t for real number;

registration
  cluster I[01] -> closed for SubSpace of R^1;
end;

theorem 
  DYADIC is dense Subset of I[01];

theorem 
  Cl DYADIC = [. 0,1 .];

theorem 
  a + a = 2*a;

theorem 
  a + b - b = a;

registration
  let A be bounded_above real-membered set;
  let r be non negative real number;
  cluster r**A -> bounded_above;
end;

registration
  let A be bounded_above real-membered set;
  let r be non positive real number;
  cluster r**A -> bounded_below;
end;

registration
  let A be bounded_below real-membered set;
  let r be non negative real number;
  cluster r**A -> bounded_below;
end;

registration
  let A be bounded_below non empty real-membered set;
  let r be non positive real number;
  cluster r**A -> bounded_above;
end;

theorem 
  for f being Real_Sequence holds f + (NAT --> t) = t + f;

theorem 
  for r being Real holds lim (NAT --> r) = r;

theorem 
  for f being convergent Real_Sequence holds
  lim (t + f) = t + lim f;

registration
  let f be convergent Real_Sequence;
  let t;
  cluster t + f -> convergent for Real_Sequence;
end;

theorem 
  for f be Real_Sequence holds f (#) (NAT --> a) = f * a;

theorem 
  lim (NAT --> a) = a;

theorem 
  for f being convergent Real_Sequence holds
  lim (f * a) = (lim f) * a;

registration
  let f be convergent Real_Sequence;
  let E,a;
  cluster f * a -> convergent;
end;

definition
  let E,F be non empty NORMSTR, f be Function of E,F;
  attr f is isometric means

  for a,b being Point of E holds ||. f.a - f.b .|| = ||. a - b .||;
end;

definition
  let E,F be non empty RLSStruct, f be Function of E,F;

  attr f is Affine means

  for a,b being Point of E, t being real number st 0 <= t & t <= 1 holds
  f.((1-t)*a+t*b) = (1-t)*(f.a) + t*(f.b);

  attr f is midpoints-preserving means

  for a,b being Point of E holds f.(1/2*(a+b)) = 1/2*(f.a+f.b);
end;

registration
  let E be non empty NORMSTR;
  cluster id E -> isometric;
end;

registration
  let E be non empty RLSStruct;
  cluster id E -> midpoints-preserving Affine;
end;

registration
  let E be non empty NORMSTR;
  cluster bijective isometric midpoints-preserving Affine for UnOp of E;
end;

theorem 
  f is isometric & g is isometric implies g*f is isometric;

registration
  let E; let f,g be isometric UnOp of E;
  cluster g*f -> isometric for UnOp of E;
end;

theorem 
  f is bijective isometric implies f/" is isometric;

registration
  let E; let f be bijective isometric UnOp of E;
  cluster f/" -> isometric;
end;

theorem 
  f is midpoints-preserving & g is midpoints-preserving implies
  g*f is midpoints-preserving;

registration
  let E; let f,g be midpoints-preserving UnOp of E;
  cluster g*f -> midpoints-preserving for UnOp of E;
end;

theorem 
  f is bijective midpoints-preserving implies f/" is midpoints-preserving;

registration
  let E; let f be bijective midpoints-preserving UnOp of E;
  cluster f/" -> midpoints-preserving;
end;

theorem 
  f is Affine & g is Affine implies g*f is Affine;

registration
  let E; let f,g be Affine UnOp of E;
  cluster g*f -> Affine for UnOp of E;
end;

theorem 
  f is bijective Affine implies f/" is Affine;

registration
  let E; let f be bijective Affine UnOp of E;
  cluster f/" -> Affine;
end;

definition
  let E be non empty RLSStruct, a be Point of E;
  func a-reflection -> UnOp of E means

  for b being Point of E holds it.b = 2*a - b;
end;

theorem 
  (a-reflection) * (a-reflection) = id E;

registration
  let E,a;
  cluster a-reflection -> bijective;
end;

theorem 
  (a-reflection).a = a & for b st (a-reflection).b = b holds a = b;

theorem 
  (a-reflection).b - a = a - b;

theorem 
  ||. (a-reflection).b - a .|| = ||. b - a .||;

theorem 
  (a-reflection).b - b = 2 * (a - b);

theorem 
  ||. (a-reflection).b - b .|| = 2 * ||. b - a .||;

theorem 
  (a-reflection)/" = a-reflection;

registration
  let E,a;
  cluster a-reflection -> isometric;
end;

theorem 
  f is isometric implies f is_continuous_on dom f;

registration
  let E,F;
  cluster bijective isometric -> midpoints-preserving for Function of E,F;
 end;

registration
  let E,F;
  cluster isometric midpoints-preserving -> Affine for Function of E,F;
end;















begin 

reserve x for set;
reserve i,j for Integer;
reserve n,n1,n2,n3 for Nat;
reserve K,K1,K2,K3 for Field;

definition
  let K be Field;
  mode Subfield of K -> Field means

  the carrier of it c= the carrier of K
  & the addF of it = (the addF of K) || the carrier of it
  & the multF of it = (the multF of K) || the carrier of it
  & 1.it = 1.K & 0.it = 0.K;
end;

theorem 
  K is Subfield of K;

theorem 
  for ST be non empty doubleLoopStr
  st the carrier of ST is Subset of the carrier of K
  & the addF of ST = (the addF of K) || (the carrier of ST)
  & the multF of ST = (the multF of K) || (the carrier of ST)
  & 1.ST = 1.K & 0.ST = 0.K
  & ST is right_complementable commutative almost_left_invertible
  non degenerated holds ST is Subfield of K;

registration let K be Field;
  cluster strict for Subfield of K;
end;

reserve SK1,SK2 for Subfield of K;
reserve ek,ek1,ek2 for Element of K;

theorem 
  K1 is Subfield of K2 implies for x st x in K1 holds x in K2;

theorem 
  for K1,K2 be strict Field st
  K1 is Subfield of K2 & K2 is Subfield of K1 holds K1 = K2;

theorem 
  for K1, K2, K3 be strict Field st
  K1 is Subfield of K2 & K2 is Subfield of K3 holds K1 is Subfield of K3;

theorem 
  SK1 is Subfield of SK2 iff the carrier of SK1 c= the carrier of SK2;

theorem 
  SK1 is Subfield of SK2 iff for x st x in SK1 holds x in SK2;

theorem 
  for SK1,SK2 be strict Subfield of K holds
  SK1 = SK2 iff the carrier of SK1 = the carrier of SK2;

theorem 
  for SK1, SK2 be strict Subfield of K holds
  (SK1 = SK2 iff for x holds x in SK1 iff x in SK2);

registration
  let K be finite Field;
  cluster finite for Subfield of K;
end;

definition
  let K be finite Field;
  redefine func card K -> Element of NAT;
end;

registration
  cluster strict finite for Field;
end;

theorem 
  for K be strict finite Field,
  SK1 be strict Subfield of K st
  card K = card SK1 holds SK1 = K;

definition let IT be Field;
  attr IT is prime means

  K1 is strict Subfield of IT implies K1 = IT;
end;

notation let p be Prime;
  synonym GF(p) for INT.Ring(p);
end;

registration let p be Prime;
  cluster GF(p) -> finite;
end;

registration let p be Prime;
  cluster GF(p) -> prime;
end;

registration
  cluster prime for Field;
end;

begin 

reserve p for Prime;
reserve a,b,c for Element of GF(p);
reserve F for FinSequence of GF(p);

theorem 
  0 = 0.(GF p);

theorem 
  1 = 1.(GF p);

theorem 
  ex n1 st a = n1 mod p;

theorem 
  i mod p is Element of GF(p);

theorem 
  a = i mod p & b = j mod p implies a+b = (i+j) mod p;

theorem 
  a = i mod p implies -a = (p-i) mod p;

theorem 
  a = i mod p & b = j mod p implies a-b = (i-j) mod p;

theorem 
  a = i mod p & b = j mod p implies a*b = (i*j) mod p;

theorem 
  a = i mod p & i*j mod p = 1 implies a" = j mod p;

theorem 
  a = 0 or b = 0 iff a*b = 0;

theorem 
  a |^ 0 = 1_GF(p) & a |^ 0 = 1;

theorem 
  a |^ 2 = a*a;

theorem 
  a = n1 mod p implies a|^n = n1|^n mod p;

theorem 
  for K being unital associative non empty multMagma, a being
  Element of K, n being Nat holds a|^(n+1) = (a|^n) * a;

theorem 
  a <> 0 implies a |^ n <> 0;

theorem 
  for F being Abelian add-associative right_zeroed right_complementable
  associative commutative well-unital almost_left_invertible distributive
  non empty doubleLoopStr, x,y being Element of F holds x*x=y*y
    iff x=y or x=-y;

theorem 
  for p be Prime, x be Element of GF(p) st 2 < p & x+x = 0.(GF p)
  holds x = 0.(GF(p));

theorem 
  a <> 0 implies (a") |^n = (a|^n)";

registration let p;
  cluster MultGroup GF(p) -> cyclic;
end;

theorem 
  for x be Element of MultGroup GF(p), x1 be Element of GF(p),
  n be Nat st x = x1 holds x|^n = x1 |^n;

theorem 
  ex g be Element of GF(p) st
  for a be Element of GF(p) st a <> 0.GF(p) holds
  ex n be Nat st a = g|^n;

begin 

definition let p, a;
  attr a is quadratic_residue means

  a <> 0 & ex x being Element of GF(p) st x|^2 = a;
  attr a is not_quadratic_residue means

  a <> 0 & not ex x being Element of GF(p) st x|^2 = a;
end;

theorem 
  a <> 0 implies a|^2 is quadratic_residue;

registration let p be Prime;
  cluster 1.(GF p) -> quadratic_residue;
end;

definition let p, a;
  func Lege_p(a) -> Integer equals

  0 if a = 0,
  1 if a is quadratic_residue
  otherwise -1;
end;

theorem 
  a is not_quadratic_residue iff Lege_p(a) = -1;

theorem 
  a is quadratic_residue iff Lege_p(a) = 1;

theorem 
  a = 0 iff Lege_p(a) = 0;

theorem 
  a <> 0 implies Lege_p(a|^2) = 1;

theorem 
  Lege_p(a*b) = Lege_p(a) * Lege_p(b);

theorem 
  a <> 0 & n mod 2 = 0 implies Lege_p(a|^n) = 1;

theorem 
  n mod 2 = 1 implies Lege_p(a|^n) = Lege_p(a);

theorem 
  2 < p implies card({b : b|^2 = a}) = 1 + Lege_p(a);

begin 

definition let K be Field;
  func ProjCo(K) -> non empty Subset of
  [:the carrier of K, the carrier of K, the carrier of K:] equals

  [:the carrier of K, the carrier of K, the carrier of K:] \ {[0.K,0.K,0.K]};
end;

theorem 
  ProjCo(GF(p)) = [:the carrier of GF(p),
  the carrier of GF(p), the carrier of GF(p):] \ {[0,0,0]};

reserve Px,Py,Pz for Element of GF(p);

definition
  let p be Prime;
  let a, b be Element of GF(p);
  func Disc(a,b,p) -> Element of GF(p) means

  for g4, g27 be Element of GF(p) st g4 = 4 mod p & g27 = 27 mod p
  holds it = g4*a|^3 + g27*b|^2;
end;

definition
  let p be Prime;
  let a, b be Element of GF(p);
  func EC_WEqProjCo(a,b,p) -> Function of
  [:the carrier of GF(p), the carrier of GF(p), the carrier of GF(p):],
    GF(p) means

  for P be Element of [:the carrier of GF(p),
  the carrier of GF(p), the carrier of GF(p):] holds
  it. P = ((P`2_3) |^2)*(P`3_3)-((P`1_3) |^3
    +a*(P`1_3)*(P`3_3) |^2+b*(P`3_3) |^3);
  end;

theorem 
  for X,Y,Z be Element of GF(p) holds
  EC_WEqProjCo(a,b,p).([X,Y,Z]) = Y |^2*Z-(X|^3 +a*X*Z |^2+b*Z |^3);

definition
  let p be Prime;
  let a, b be Element of GF(p);
  func EC_SetProjCo(a,b,p) -> non empty Subset of ProjCo(GF(p)) equals

  {P where P is Element of ProjCo(GF(p)) : EC_WEqProjCo(a,b,p).P = 0.GF(p) };
end;

theorem 
  [0,1,0] is Element of EC_SetProjCo(a,b,p);

theorem 
  for p be Prime, a, b, X, Y be Element of GF(p) holds
  Y|^2 = X|^3 + a*X + b iff [X,Y,1] is Element of EC_SetProjCo(a,b,p);

definition
  let p be Prime;
  let P,Q be Element of ProjCo(GF(p));
  pred P _EQ_ Q means

    ex a be Element of GF(p) st a <> 0.GF(p)
    & P`1_3 = a*(Q`1_3) & P`2_3 = a*(Q`2_3) & P`3_3 = a*(Q`3_3);
  reflexivity;
  symmetry;
end;

theorem 
  for p be Prime, P,Q,R be Element of ProjCo(GF(p)) holds
  ( P _EQ_ Q & Q _EQ_ R implies P _EQ_ R);

theorem 
  for p be Prime, a, b be Element of GF(p),
  P,Q be Element of [:the carrier of GF(p), the carrier of GF(p),
  the carrier of GF(p):], d be Element of GF(p)
  st p > 3 & Disc(a,b,p) <> 0.GF(p) &
  P in EC_SetProjCo(a,b,p) & d <> 0.GF(p)
  & Q`1_3 = d*(P`1_3) & Q`2_3 = d*(P`2_3) & Q`3_3 = d*(P`3_3) holds
  Q in EC_SetProjCo(a,b,p);

definition
  let p be Prime;
  func R_ProjCo p -> Relation of ProjCo(GF(p)) equals

  {[P,Q] where P,Q is Element of ProjCo(GF(p)) : P _EQ_ Q};
end;

theorem 
  for p be Prime, P,Q be Element of ProjCo(GF(p)) holds
  P _EQ_ Q iff [P,Q] in R_ProjCo p;

registration let p be Prime;
  cluster R_ProjCo p -> total symmetric transitive;
end;

definition
  let p be Prime;
  let a, b be Element of GF(p);
  func R_EllCur (a,b,p) -> Equivalence_Relation of EC_SetProjCo(a,b,p)
  equals

  (R_ProjCo p) /\ nabla EC_SetProjCo(a,b,p);
end;

theorem 
  for p be Prime, a, b be Element of GF(p),
  P,Q be Element of ProjCo(GF(p))
  st Disc(a,b,p) <> 0.GF(p) &
  P in EC_SetProjCo(a,b,p) & Q in EC_SetProjCo(a,b,p) holds
  ( P _EQ_ Q iff [P,Q] in R_EllCur (a,b,p));

theorem 
  for p be Prime, a, b be Element of GF(p),
  P be Element of ProjCo(GF(p))
  st p > 3 & Disc(a,b,p) <> 0.GF(p) &
  P in EC_SetProjCo(a,b,p) & P`3_3 <> 0 holds
  ex Q be Element of ProjCo(GF(p)) st Q in EC_SetProjCo(a,b,p)
  & Q _EQ_ P & Q`3_3 = 1;

theorem 
  for p be Prime, a, b be Element of GF(p),
  P be Element of ProjCo(GF(p))
  st p > 3 & Disc(a,b,p) <> 0.GF(p) &
  P in EC_SetProjCo(a,b,p) & P`3_3 = 0 holds
  ex Q be Element of ProjCo(GF(p))
  st Q in EC_SetProjCo(a,b,p) & Q _EQ_ P & Q`1_3 = 0 & Q`2_3= 1 & Q`3_3= 0;

theorem 
  for p be Prime, a, b be Element of GF(p), x be set st
  p > 3 & Disc(a,b,p) <> 0.GF(p)
  & x in Class (R_EllCur(a,b,p)) holds
  ( ex P be Element of ProjCo(GF(p)) st P in EC_SetProjCo(a,b,p) & P=[0,1,0]
  & x = Class(R_EllCur(a,b,p),P) ) or
  ex P be Element of ProjCo(GF(p)), X,Y be Element of GF(p)
  st P in EC_SetProjCo(a,b,p) & P=[X,Y,1]
  & x = Class(R_EllCur(a,b,p),P);

theorem 
  for p be Prime, a, b be Element of GF(p) st
  p > 3 & Disc(a,b,p) <> 0.GF(p) holds
  Class (R_EllCur(a,b,p)) = {Class(R_EllCur(a,b,p),[0,1,0])}
  \/ {Class(R_EllCur(a,b,p),P)
  where P is Element of ProjCo(GF(p)):
  P in EC_SetProjCo(a,b,p) & ex X,Y be Element of GF(p) st P=[X,Y,1]};

theorem 
  for p be Prime,
  a, b,d1,Y1,d2,Y2 be Element of GF(p)
  st p > 3 & Disc(a,b,p) <> 0.GF(p)
  & [d1,Y1,1] in EC_SetProjCo(a,b,p)
  & [d2,Y2,1] in EC_SetProjCo(a,b,p) holds
  Class(R_EllCur(a,b,p),[d1,Y1,1]) = Class(R_EllCur(a,b,p),[d2,Y2,1])
  iff d1=d2 & Y1=Y2;

theorem 
  for p be Prime, a, b be Element of GF(p),
  F1,F2 be set st p > 3 & Disc(a,b,p) <> 0.GF(p)
  & F1 = {Class(R_EllCur(a,b,p),[0,1,0])} & F2 = {Class(R_EllCur(a,b,p),P)
  where P is Element of ProjCo(GF(p)):
  P in EC_SetProjCo(a,b,p) &
  ex X,Y be Element of GF(p) st P=[X,Y,1]} holds F1 misses F2;

theorem 
  for X be non empty finite set,
  R be Equivalence_Relation of X,
  S be Class(R)-valued Function, i be set st i in dom S holds
  S.i is finite Subset of X;

theorem 
  for X be non empty set,
  R be Equivalence_Relation of X,
  S be Class(R)-valued Function st S is one-to-one
  holds S is disjoint_valued;

theorem 
  for X be non empty set,
  R be Equivalence_Relation of X,
  S be Class(R)-valued Function st S is onto
  holds Union S = X;

theorem 
  for X be non empty finite set,
  R be Equivalence_Relation of X,
  S be Class(R)-valued Function,
  L be FinSequence of NAT
  st S is one-to-one onto & dom S = dom L
  & (for i be Nat st i in dom S holds L.i = card (S.i))
  holds card (X) = Sum L;

theorem 
  for p be Prime, a, b,d be Element of GF(p), F,G be set st
  p > 3 & Disc(a,b,p) <> 0.GF(p)
  & F = {Y where Y is Element of GF(p) : Y|^2= d|^3 + a*d + b} & F <> {}
  & G = {Class(R_EllCur(a,b,p),[d,Y,1])
  where Y is Element of GF(p) : [d,Y,1] in EC_SetProjCo(a,b,p) } holds
  ex I be Function of F,G st I is onto & I is one-to-one;

theorem 
  for p be Prime, a, b, d be Element of GF(p) st
  p > 3 & Disc(a,b,p) <> 0.GF(p) holds
  card ({Class(R_EllCur(a,b,p),[d,Y,1]) where Y is Element of GF(p)
  : [d,Y,1] in EC_SetProjCo(a,b,p) }) = 1 + Lege_p(d|^3 + a*d + b);

theorem 
  for p be Prime, a, b be Element of GF(p)
  st p > 3 & Disc(a,b,p) <> 0.GF(p) holds
  ex F be FinSequence of NAT st len F = p
  & (for n be Nat st n in Seg p
  ex d be Element of GF(p) st d=n-1 & F.n = 1 + Lege_p(d|^3 + a*d + b))
  & card {Class(R_EllCur(a,b,p),P)
  where P is Element of ProjCo(GF(p)): P in EC_SetProjCo(a,b,p) &
  ex X,Y be Element of GF(p) st P=[X,Y,1]} = Sum(F);

theorem 
  for p be Prime, a, b be Element of GF(p)
  st p > 3 & Disc(a,b,p) <> 0.GF(p)
  ex F be FinSequence of INT st len F = p &
  (for n be Nat st n in Seg p ex d be Element of GF(p)
  st d=n-1 & F.n = Lege_p(d|^3 + a*d + b)) &
  card(Class(R_EllCur(a,b,p))) = 1 + p + Sum(F);















begin 

 reserve x for set,
         n,m,k for Nat,
         r for Real,
         V for RealLinearSpace,
         v,u,w,t for VECTOR of V,
         Av for finite Subset of V,
         Affv for finite affinely-independent Subset of V;

theorem 
  for f1,f2 be real-valued FinSequence, r be real number
    holds Intervals(f1,r)^Intervals(f2,r) = Intervals(f1^f2,r);

theorem 
  for f1,f2 be FinSequence holds
    x in product(f1^f2)
  iff
    ex p1,p2 be FinSequence st x = p1^p2 & p1 in product f1 & p2 in product f2;

theorem 
  V is finite-dimensional iff (Omega).V is finite-dimensional;

registration
  let V be finite-dimensional RealLinearSpace;
  cluster -> finite for affinely-independent Subset of V;
end;

registration
  let n;
  cluster TOP-REAL n -> add-continuous Mult-continuous;
 cluster TOP-REAL n -> finite-dimensional;
end;

reserve pn for Point of TOP-REAL n,
        An for Subset of TOP-REAL n,
        Affn for affinely-independent Subset of TOP-REAL n,
        Ak for Subset of TOP-REAL k;

theorem 
  dim TOP-REAL n = n;

theorem 
  for V be finite-dimensional RealLinearSpace
  for A be affinely-independent Subset of V holds card A <= 1+dim V;

theorem 
  for V be finite-dimensional RealLinearSpace,
      A be affinely-independent Subset of V
  holds
    card A = dim V + 1
  iff
    Affin A = [#]V;

begin 
      

theorem 
  k <= n & An = {v where v is Element of TOP-REAL n : v|k in Ak}
    implies
  (An is open iff Ak is open);

theorem 
  for A be Subset of TOP-REAL(k+n) st
    A = {v^(n|->0) where v is Element of TOP-REAL k: not contradiction}
  for B be Subset of (TOP-REAL(k+n))|A st
    B = {v where v is Point of TOP-REAL(k+n): v|k in Ak & v in A}
  holds Ak is open iff B is open;

theorem 
  for A be affinely-independent Subset of V, B be Subset of V st B c= A
  holds conv A/\Affin B = conv B;

theorem 
  for V be non empty RLSStruct, A be non empty set
  for f be PartFunc of A,the carrier of V
  for X be set holds (r(#)f).:X = r*(f.:X);

theorem 
  0*n in An implies Affin An = [#]Lin An;

registration
  let V be non empty addLoopStr;
  let A be finite Subset of V;
  let v be Element of V;
  cluster v+A -> finite;
end;

registration
  let V be non empty RLSStruct;
  let A be finite Subset of V;
  let r;
  cluster r*A -> finite;
end;

theorem 
  for A be Subset of V holds
    card A = card(r*A)
  iff
    r<>0 or A is trivial;

registration
  let V be non empty RLSStruct;
  let f be FinSequence of V;
  let r;
  cluster r(#)f -> FinSequence-like;
end;

begin 

definition
  let X be finite set;
  mode Enumeration of X -> one-to-one FinSequence means

    rng it = X;
end;

definition
  let X be 1-sorted;
  let A be finite Subset of X;
  redefine mode Enumeration of A -> one-to-one FinSequence of X;
end;

reserve EV for Enumeration of Affv,
        EN for Enumeration of Affn;

theorem 
  for V be Abelian add-associative right_zeroed right_complementable
    non empty addLoopStr
  for A be finite Subset of V, E be Enumeration of A, v be Element of V
  holds E+(card A|->v) is Enumeration of (v+A);

theorem 
  for E be Enumeration of Av holds
    r(#)E is Enumeration of r*Av
  iff
    r<>0 or Av is trivial;

theorem 
  for M be Matrix of n,m,F_Real st the_rank_of M = n
  for A be finite Subset of TOP-REAL n, E be Enumeration of A
    holds (Mx2Tran M)*E is Enumeration of(Mx2Tran M).:A;

definition
  let V,Av;
  let E be Enumeration of Av;
  let x;
  func x|--E -> FinSequence of REAL equals

    (x|--Av)*E;
end;

theorem 
  for E be Enumeration of Av holds len (x|--E) = card Av;

theorem 
  for E be Enumeration of v+Affv st w in Affin Affv & E = EV+(card Affv|->v)
    holds w|--EV=(v+w)|--E;

theorem 
  for rE be Enumeration of r*Affv st v in Affin Affv & rE = r(#)EV & r<>0
    holds v|--EV = (r*v)|--rE;

theorem 
  for M be Matrix of n,m,F_Real st the_rank_of M = n
  for ME be Enumeration of (Mx2Tran M).:Affn st ME = (Mx2Tran M)*EN
  for pn st pn in Affin Affn holds pn |-- EN = ((Mx2Tran M).pn) |-- ME;

theorem 
  for A be Subset of V st A c= Affv & x in Affin Affv holds
    x in Affin A
  iff
    for y be set st y in dom(x|--EV) & not EV.y in A holds (x|--EV).y = 0;

theorem 
  for EV st x in Affin Affv holds
    x in Affin(EV.:Seg k)
  iff
    x|--EV = ((x|--EV)|k)^((card Affv-' k)|->0);

theorem 
  for EV st k <= card Affv & x in Affin Affv holds
    x in Affin(Affv\(EV.:Seg k))
  iff
    x|--EV = (k|->0)^((x|--EV)/^k);

theorem 
  0*n in Affn & EN.len EN=0*n implies
    rng(EN|(card Affn-' 1)) = Affn\{0*n} &
    for A be Subset of n-VectSp_over F_Real st Affn = A holds
      EN|(card Affn-' 1) is OrdBasis of Lin A;

theorem 
  for A be Subset of n-VectSp_over F_Real st
    Affn = A & 0*n in Affn & EN.len EN = 0*n
  for B be OrdBasis of Lin A st B = EN|(card Affn-' 1)
  for v be Element of Lin A holds v|--B = (v|--EN)|(card Affn-' 1);

theorem 
  for EN,An st k <= n & card Affn = n+1 & An = {pn:(pn|--EN)|k in Ak}
    holds Ak is open iff An is open;

theorem 
  for EN st k <=n & card Affn = n+1 & An = {pn:(pn|--EN)|k in Ak}
    holds Ak is closed iff An is closed;

registration
  let n;
  cluster Affine -> closed for Subset of TOP-REAL n;
end;

reserve pnA for Element of(TOP-REAL n)|Affin Affn;

theorem 
  for EN for B be Subset of (TOP-REAL n)|Affin Affn st
    k < card Affn & B = {pnA: (pnA|--EN) |k in Ak}
  holds Ak is open iff B is open;

theorem 
  for EN for B be Subset of (TOP-REAL n)|Affin Affn st
    k < card Affn & B = {pnA: (pnA|--EN)|k in Ak}
  holds Ak is closed iff B is closed;

registration
  let n;
  let p,q be Point of TOP-REAL n;
  cluster halfline(p,q) -> closed;
end;

begin 

definition
  let V;
  let A be Subset of V,x;
  func |--(A,x) -> Function of V,R^1 means

    it.v = (v|--A).x;
end;

theorem 
  for A be Subset of V st not x in A holds |--(A,x) = [#]V-->0;

theorem 
  for A be affinely-independent Subset of V st |--(A,x) = [#]V-->0
    holds not x in A;

theorem 
  |--(Affn,x)|Affin Affn is continuous Function of (TOP-REAL n)|Affin Affn,R^1;

theorem 
  card Affn = n+1 implies |--(Affn,x) is continuous;

registration
  let n,Affn;
  cluster conv Affn -> closed;
end;

theorem 
  card Affn = n+1 implies Int Affn is open;














begin 

reserve M for non empty MetrSpace,
        F,G for open Subset-Family of TopSpaceMetr M;

definition
  let M such that
     TopSpaceMetr M is compact;
  let F be Subset-Family of TopSpaceMetr M such that
     F is open and
     F is Cover of TopSpaceMetr M;
   mode Lebesgue_number of F -> positive Real means

     for p be Point of M
     ex A be Subset of TopSpaceMetr M st A in F & Ball(p,it) c= A;
end;

reserve L for Lebesgue_number of F;

theorem 
  TopSpaceMetr M is compact & F is Cover of TopSpaceMetr M & F c= G
    implies L is Lebesgue_number of G;

theorem 
  TopSpaceMetr M is compact & F is Cover of TopSpaceMetr M & F is_finer_than G
    implies L is Lebesgue_number of G;

theorem 
  for L1 be positive Real st TopSpaceMetr M is compact &
                             F is Cover of TopSpaceMetr M & L1 <= L
    holds L1 is Lebesgue_number of F;

begin 

reserve n,k for Nat,
        r for real number,
        X for set,
        M for Reflexive non empty MetrStruct,
        A for Subset of M,
        K for SimplicialComplexStr;

registration let M;
  cluster finite -> bounded for Subset of M;
end;

theorem 
  for S be finite non empty Subset of M
    ex p,q be Point of M st p in S & q in S & dist(p,q) = diameter S;

definition let M,K;
  attr K is M bounded means

    ex r st for A st A in the topology of K holds
       A is bounded & diameter A <= r;
end;

theorem 
  for K be non void SimplicialComplexStr st
      K is M bounded & A is Simplex of K
    holds A is bounded;

registration let M,X;
  cluster M bounded non void for SimplicialComplex of X;
end;

registration let M;
  cluster M bounded non void subset-closed finite-membered
    for SimplicialComplexStr;
end;

registration let M,X;
  let K be M bounded SimplicialComplexStr of X;
  cluster -> M bounded for (SubSimplicialComplex of K);
end;

registration
  let M,X;
  let K be M bounded subset-closed SimplicialComplexStr of X;
  let i be Integer;
  cluster Skeleton_of(K,i) -> M bounded;
end;

theorem 
  K is finite-vertices implies K is M bounded;

begin

definition let M;
  let K be SimplicialComplexStr such that
     K is M bounded;
  func diameter(M,K) -> Real means

    (for A st A in the topology of K holds diameter A <= it)
  &  for r st (for A st A in the topology of K holds diameter A <= r)
     holds r >= it if the topology of K meets bool [#]M
                   otherwise it = 0;
end;

theorem 
  K is M bounded implies 0 <= diameter(M,K);

theorem 
  for K be M bounded SimplicialComplexStr of X,
      KX be SubSimplicialComplex of K
    holds diameter(M,KX) <= diameter(M,K);

theorem 
  for K be M bounded subset-closed SimplicialComplexStr of X,i be Integer
    holds
  diameter(M,Skeleton_of(K,i)) <= diameter(M,K);

definition let M;
 let K be M bounded non void subset-closed SimplicialComplexStr;
 redefine func diameter(M,K) -> Real means

  (for A st A is Simplex of K holds diameter A <= it) &
  for r st (for A st A is Simplex of K holds diameter A <= r)
    holds r >= it;
end;

theorem 
  for S be finite Subset of M holds diameter(M,Complex_of{S}) = diameter S;

definition
 let n;
 let K be SimplicialComplexStr of TOP-REAL n;
 attr K is bounded means

   K is (Euclid n) bounded;
 func diameter K -> Real equals

   diameter(Euclid n,K);
end;

registration
  let n;
  cluster bounded -> Euclid n bounded for (SimplicialComplexStr of TOP-REAL n);
  cluster bounded affinely-independent simplex-join-closed non void
    finite-degree total for SimplicialComplex of TOP-REAL n;
  cluster finite-vertices -> bounded for SimplicialComplexStr of TOP-REAL n;
end;

begin 

reserve V for RealLinearSpace,
        Kv for non void SimplicialComplex of V;

theorem 
  for S be Simplex of BCS Kv
  for F be c=-linear finite finite-membered Subset-Family of V st
    S = (center_of_mass V).:F
  for a1,a2 be VECTOR of V st a1 in S & a2 in S
  ex b1,b2 be VECTOR of V,r be Real st
     b1 in Vertices BCS Complex_of{union F} &
     b2 in Vertices BCS Complex_of{union F} &
     a1-a2 = r*(b1-b2) & 0 <= r & r <= (card union F-1)/card union F;

theorem 
  for A be affinely-independent Subset of TOP-REAL n
  for E be Enumeration of A st dom E\X is non empty
    holds
  conv(E.:X) = meet{conv(A\{E.k}) where k is Element of NAT: k in dom E\X};

reserve A for Subset of TOP-REAL n;

theorem 
  for a be bounded Subset of Euclid n st a=A
  for p be Point of Euclid n st p in conv A holds
    conv A c= cl_Ball(p,diameter a);

theorem 
  A is bounded iff conv A is bounded;

theorem 
  for a,ca be bounded Subset of Euclid n st ca = conv A & a = A holds
    diameter a = diameter ca;

registration
  let n;
  let K be bounded SimplicialComplexStr of TOP-REAL n;
  cluster -> bounded for SubdivisionStr of K;
end;

theorem 
  for K be bounded finite-degree non void SimplicialComplex of TOP-REAL n st
       |.K.| c= [#]K
    holds diameter BCS K <= degree K/(degree K+1) * diameter K;

theorem 
  for K be bounded finite-degree non void SimplicialComplex of TOP-REAL n st
      |.K.| c= [#]K
    holds diameter BCS(k,K) <= (degree K/(degree K+1))|^k * diameter K;

theorem 
  for K be bounded finite-degree non void SimplicialComplex of TOP-REAL n st
      |.K.| c= [#]K for r st r>0 ex k st diameter BCS(k,K) < r;

theorem 
  for i,j be Element of NAT
  ex f be Function of[:TOP-REAL i,TOP-REAL j:],TOP-REAL(i+j) st
    f is being_homeomorphism &
    for fi be Element of TOP-REAL i,fj be Element of TOP-REAL j
    holds f.(fi,fj) = fi^fj;

theorem 
  for i,j be Element of NAT
  for f be Function of [:TOP-REAL i,TOP-REAL j:],TOP-REAL(i+j) st
       for fi be Element of TOP-REAL i,fj be Element of TOP-REAL j
         holds f.(fi,fj) = fi^fj
  for r for fi be Point of Euclid i,fj be Point of Euclid j,
            fij be Point of Euclid(i+j) st fij = fi^fj
    holds f.:[:OpenHypercube(fi,r),OpenHypercube(fj,r):] = OpenHypercube(fij,r)
;

theorem 
  A is bounded iff ex p be Point of Euclid n,r st A c= OpenHypercube(p,r);

registration
 let n;
 cluster closed bounded -> compact for Subset of TOP-REAL n;
end;

registration
 let n;
 let A be affinely-independent Subset of TOP-REAL n;
 cluster conv A -> compact;
end;

begin 

theorem 
  for A be non empty affinely-independent Subset of TOP-REAL n
  for E be Enumeration of A
  for F be FinSequence of bool the carrier of ((TOP-REAL n)|(conv A)) st
    len F = card A & rng F is closed &
    for S be Subset of dom F holds conv(E.:S) c= union(F.:S)
      holds meet rng F is non empty;

reserve A for affinely-independent Subset of TOP-REAL n;

theorem 
  for A st card A = n+1
  for f be continuous Function of(TOP-REAL n)|conv A,(TOP-REAL n)|conv A
  ex p be Point of TOP-REAL n st p in dom f & f.p=p;

theorem 
  for A st card A = n+1
  for f be continuous Function of (TOP-REAL n)|conv A,(TOP-REAL n)|conv A
    holds f is with_fixpoint;

theorem 
  card A = n+1 implies ind conv A = n;

theorem 
  ind TOP-REAL n = n;














begin 

reserve n for Nat,
        p,q,u,w for Point of TOP-REAL n,
        S for Subset of TOP-REAL n,
        A, B for convex Subset of TOP-REAL n,
        r for real number;

theorem 
  (1-r)*p + r*q = p + r*(q-p);

theorem 
  u in halfline(p,q) & w in halfline(p,q) & |.u-p.| = |.w-p.| implies u = w;

theorem 
  for S st p in S & p <> q & S/\halfline(p,q) is bounded
  ex w st w in (Fr S)/\halfline(p,q) &
          (for u st u in S/\halfline(p,q) holds |.p-u.| <= |.p-w.|) &
          for r st r > 0 ex u st u in S/\halfline(p,q) & |.w-u.| < r;

theorem 
  for A st A is closed & p in Int A & p <> q & A/\halfline(p,q) is bounded
  ex u st(Fr A)/\halfline(p,q)={u};

theorem 
  r > 0 implies Fr cl_Ball(p,r) = Sphere(p,r);

registration
  let n be Element of NAT;
  let A be bounded Subset of TOP-REAL n;
  let p be Point of TOP-REAL n;
  cluster p+A -> bounded;
end;

begin 

theorem 
  for n be Element of NAT
  for A be convex Subset of TOP-REAL n st A is compact non boundary
  ex h be Function of(TOP-REAL n) |A,Tdisk(0.TOP-REAL n,1) st
    h is being_homeomorphism & h.:Fr A = Sphere(0.TOP-REAL n,1);

theorem 
  for A,B st A is compact non boundary & B is compact non boundary
  ex h be Function of(TOP-REAL n) |A,(TOP-REAL n) |B st
    h is being_homeomorphism & h.:Fr A = Fr B;

theorem 
  for A st A is compact non boundary
  for h be continuous Function of(TOP-REAL n) |A,(TOP-REAL n) |A
    holds h is with_fixpoint;

theorem 
 for A be non empty convex Subset of TOP-REAL n st
   A is compact non boundary
 for FR be non empty SubSpace of (TOP-REAL n) |A st [#]FR = Fr A
  holds not FR is_a_retract_of (TOP-REAL n) |A;















begin

reserve U, D for non empty set,
        X for non empty Subset of D,
        d,d1,d2 for Element of D,
        A,B,C,Y,x,y,z for set,
        f for BinOp of D, i,m,n for Nat;
reserve g for Function;




definition let X be set; let f be Function;
  attr f is X-one-to-one means

f|X is one-to-one;
end;

definition let D,f; let X be set;
  attr X is f-unambiguous means

f is [:X,D:]-one-to-one;
end;

definition 
let D;
let X be set;
attr X is D-prefix means

X is (D-concatenation)-unambiguous;
end;

definition
let D be set;
func D-pr1 -> BinOp of D equals

pr1(D,D);
end;

theorem 
m-tuples_on A /\ (B*) = m-tuples_on A /\ (m-tuples_on B);

theorem 
m-tuples_on A /\ (B*) = m-tuples_on (A/\B);

theorem 
m-tuples_on (A/\B)=m-tuples_on A /\ (m-tuples_on B);

theorem 
for x,y being FinSequence st x is U-valued & y is U-valued
holds (U-concatenation).(x,y)=x^y;

theorem 
for x being set holds 
(x is non empty FinSequence of D iff x in D*\{{}});







registration let D be non empty set;
cluster D-pr1 -> associative for BinOp of D;
end;

registration let D be set;
cluster associative for BinOp of D;
end;

definition let X be set, Y be Subset of X;
redefine func Y* -> non empty Subset of X*;
end;

registration let D be non empty set;
cluster D-concatenation -> associative for (BinOp of D*);
end;

registration let D be non empty set;
cluster D* \ {{}} -> non empty;
end;

registration 
let D be non empty set, m be Nat;
cluster m-element for Element of D*;
end;

definition
let X be set;
let f be Function;
redefine attr f is X-one-to-one means

(for x,y being set st x in X /\ dom f & y in X /\ dom f & f.x=f.y holds x=y);
end;

registration let D,f;
cluster f-unambiguous for set;
end;

registration


let f be Function, x be set;
cluster f|{x} -> one-to-one;
end;

registration let e be empty set;
identify e* with {e};
identify {e} with e*;
end;

registration
cluster empty -> empty-membered for set;

let e be empty set;
cluster {e} -> empty-membered;
end;

registration let U; let m1 be non zero Nat;
cluster m1-tuples_on U -> with_non-empty_elements;
end;

registration let X be empty-membered set;
cluster -> empty-membered for Subset of X;
end;

registration let A; let m0 be zero number;
cluster m0-tuples_on A -> empty-membered for set;
end;

registration let e be empty set; let m1 be non zero Nat;
cluster m1-tuples_on e -> empty;
end;

registration let D,f; let e be empty set;
cluster e /\ f -> f-unambiguous;
end;

registration let U; let e be empty set;
cluster e/\U -> U-prefix;
end;

registration let U;
cluster U-prefix for set;
end;







definition let D,f;
let x be FinSequence of D;
func MultPlace(f,x) -> Function means

dom it=NAT & it.0=x.1 & for n being Nat holds it.(n+1)=f.(it.n,x.(n+2));
end;

definition let D,f;
let x be Element of D*\{{}};
func MultPlace(f,x) -> Function equals

MultPlace(f, x qua Element of D*);
end;

definition let D,f;






func MultPlace(f) -> Function of D*\{{}}, D means

for x being Element of D*\{{}} holds
it.x=MultPlace(f,x).(len x - 1);
end;

definition 
let D,f; let X be set;
redefine attr X is f-unambiguous means

for x,y,d1,d2 being set st x in X/\D & y in X/\D & d1 in D & d2 in D &
f.(x,d1)=f.(y,d2) holds (x=y & d1=d2);
end;







definition
let D;

func D-firstChar -> Function of D*\{{}}, D equals

MultPlace(D-pr1);
end;

theorem 
for p being FinSequence st p is U-valued & p is non empty 
holds U-firstChar.p=p.1;










definition let D;
func D-multiCat -> Function equals

({} .--> {}) +* MultPlace(D-concatenation);
end;

definition let D;
redefine func D-multiCat -> Function of D**,D*;
end;

registration let D; let e be empty set;
cluster (D-multiCat).e -> empty for set;
end;

registration let D;
cluster -> D-prefix for (Subset of 1-tuples_on D);
end;

theorem 
A is D-prefix implies (D-multiCat).:(m-tuples_on A) is D-prefix;

theorem 
A is D-prefix implies D-multiCat is (m-tuples_on A)-one-to-one;

theorem 
(m+1)-tuples_on Y c= Y*\{{}};

theorem 
m is zero implies m-tuples_on Y={{}}; 

theorem 
i-tuples_on Y = Funcs(Seg i,Y);


theorem 
x in m-tuples_on A implies x is FinSequence of A;

definition let A,X be set;
redefine func chi (A,X) -> Function of X, BOOLEAN;
end;

theorem 
(MultPlace(f)).(<*d*>) = d & for x being non empty FinSequence of D holds
(MultPlace(f)).(x^<*d*>) = f.((MultPlace(f)).x, d);

theorem 
for d being non empty Element of D** holds
D-multiCat.d=(MultPlace(D-concatenation)).d;

theorem 
for d1,d2 be Element of (D*) holds D-multiCat.(<*d1,d2*>)=d1^d2;

registration let f,g be FinSequence;
cluster <:f,g:> -> FinSequence-like;
end;

registration let m; let f,g be m-element FinSequence;
cluster <:f,g:> -> m-element;
end;

registration
let X,Y be set; let f be X-defined Function, g be Y-defined Function;
cluster <:f,g:> -> (X/\Y)-defined for Function;
end;

registration let X be set; let f,g be X-defined Function;
cluster <:f,g:> -> X-defined for Function;
end;

registration let X,Y be set;
let f be total X-defined Function, g be total Y-defined Function;
cluster <:f,g:> -> total for (X/\Y)-defined Function;
end;

registration
let X be set; let f,g be total X-defined Function;
cluster <:f,g:> -> total for X-defined Function;
end;

registration
let X,Y be set; let f be X-valued Function, g be Y-valued Function;
cluster <:f,g:> -> [:X,Y:]-valued for Function;
end;

registration 
let D; cluster D-valued for FinSequence;
end;

registration let D, m;
cluster m-element for D-valued FinSequence;
end;

registration
let X,Y be non empty set;
let f be Function of X,Y; let p be X-valued FinSequence;
cluster f*p -> FinSequence-like;
end;

registration
let X,Y be non empty set; let m;
let f be Function of X,Y; let p be m-element X-valued FinSequence;
cluster f*p -> m-element;
end;

definition
let D,f; let p,q be Element of D*;
func f AppliedPairwiseTo (p,q) -> FinSequence of D equals

f*<:p,q:>;
end;

registration
let D,f,m; let p,q be m-element Element of D*;
cluster f AppliedPairwiseTo (p,q) -> m-element;
end;

notation
let D,f; let p,q be Element of D*;
synonym f _\ (p,q) for f AppliedPairwiseTo (p,q);
end;

definition 
redefine func INT equals

NAT \/ ([:{0},NAT:] \ {[0,0]});
end;

theorem 
for p being FinSequence st p is Y-valued & p is m-element holds
p in m-tuples_on Y;





definition let A,B;
func A typed/\ B -> Subset of A equals

A/\B;
func A /\typed B -> Subset of B equals

A/\B;
end;

registration let A,B;
identify A/\B with A typed/\ B;
identify A typed/\ B with A/\B;
identify A/\B with A /\typed B;
identify A /\typed B with A/\B;
end;

definition let B,A;
func A null B equals

A;
end;

registration 
let A; let B be Subset of A;
identify A/\B with B null A;
identify B null A with A/\B;
end;

registration
let A,B,C;
cluster (B\A) /\ (A/\C) -> empty for set;
end;

definition 
let A,B;
func A typed\ B -> Subset of A equals

A\B;
end;

registration let A,B;
identify A\B with A typed\ B;
identify A typed\ B with A\B;
end;

definition



let A,B;
func A \typed/ B -> Subset of A\/B equals

A;
end;

registration
let A,B;
identify A \typed/ B with A null B;
identify A null B with A \typed/ B ;
end;

registration 
let A; let B be Subset of A;
identify A\/B with A null B;
identify A null B with A\/B;
end;

reserve X for set, P,Q,R for Relation, f for Function, p,q for FinSequence;
reserve U1,U2 for non empty set;

registration
let R be Relation;
cluster R[*] -> transitive for Relation;
cluster R[*] -> reflexive for Relation;
end;

definition
func plus -> Function of COMPLEX, COMPLEX means

 for z being complex number holds it.z=z+1;
end;

theorem 
rng f c= dom f implies f[*] = 
union {iter(f,mm) where mm is Element of NAT: not contradiction};

theorem 
f c= g implies iter(f,m) c= iter(g,m); 

registration let X be functional set;
cluster union X -> Relation-like;
end;

theorem 
Y c= Funcs(A,B) implies union Y c= [:A,B:]; 

registration
let Y;
cluster Y\Y -> empty for set;
end;

registration
let D,d;
cluster {(id D).d} \ {d} -> empty for set;
end;

registration
let p be FinSequence, q be empty FinSequence;
identify p^q with p null q;
identify p null q with p^q;
identify q^p with p null q;
identify p null q with q^p;
end;

registration
let Y; let R be Y-defined Relation;
identify R|Y with R null Y;
identify R null Y with R|Y;
end;

theorem 
f={[x,f.x] where x is Element of dom f: x in dom f};

theorem 
for R being total Y-defined Relation holds id Y c= R*(R~);

theorem 
(m+n)-tuples_on D=D-concatenation.: [:m-tuples_on D,n-tuples_on D:];

theorem 
for P,Q being Relation holds (P\/Q)"Y = P"Y \/ (Q"Y);

theorem 
(chi(A,B))"{0}=B\A & (chi(A,B))"{1}=A/\B;

theorem 
for y being non empty set holds (y=f.x iff x in f"{y});

theorem 
f is Y-valued & f is FinSequence-like implies f is FinSequence of Y;

registration
let Y; let X be Subset of Y;
cluster X-valued -> Y-valued for Relation;
end;

theorem 
for Q being quasi_total Relation of B, U1, 
R being quasi_total Relation of B, U2, P being Relation of
A, B st P*Q*(Q~)*R is Function-like holds P*Q*(Q~)*R=P*R;

theorem 
for p,q being FinSequence st p is non empty holds (p^q).1=p.1;

registration 
let U; let p,q be U-valued FinSequence;
cluster p^q -> U-valued for FinSequence;
end;

definition 
let U,X;
redefine attr X is U-prefix means

for p1, q1, p2, q2
being U-valued FinSequence st p1 in X & p2 in X & p1^q1=p2^q2 holds
(p1=p2 & q1=q2);
end;

registration
let X be set;
cluster -> X-valued for Element of X*;
end;

registration
let U, m; let X be U-prefix set;
cluster (U-multiCat).:(m-tuples_on X) -> U-prefix for set;
end;

theorem 
X \+\ Y={} iff X=Y;

registration let x;
cluster (id {x}) \+\ {[x,x]} -> empty for set;
end;

registration
let x,y;
cluster (x.-->y) \+\ {[x,y]} -> empty for set;
end;

registration
let x;
cluster (id {x}) \+\ (x.-->x) -> empty for set;
end;

theorem 
x in D*\{{}} iff (x is D-valued FinSequence & x is non empty);

reserve f for BinOp of D;

theorem 
(MultPlace(f)).(<*d*>) = d & for x being D-valued FinSequence st
x is non empty holds (MultPlace(f)).(x^<*d*>) = f.((MultPlace(f)).x, d);

reserve
A,B,C,X,Y,Z,x,x1,x2,y,y1,y2,z for set, U,U1,U2,U3 for non empty set,
u,u1,u2 for Element of U, P,Q,R for Relation, f,g for Function,
k,m,n for Nat, kk,mm,nn for Element of NAT, m1, n1 for non zero Nat,
p, p1, p2 for FinSequence, q, q1, q2 for U-valued FinSequence;

registration
let p,x,y;
cluster p +~ (x,y) -> FinSequence-like;
end;

definition
let x,y,p;
func (x,y)-SymbolSubstIn p -> FinSequence equals

p +~ (x,y);
end;

registration
let x,y,m; let p be m-element FinSequence;
cluster (x,y)-SymbolSubstIn p -> m-element for FinSequence;
end;

registration
let x, U, u; let p be U-valued FinSequence;
cluster (x,u)-SymbolSubstIn p -> U-valued for FinSequence;
end;

definition
let X,x,y; let p be X-valued FinSequence;
redefine func (x,y)-SymbolSubstIn p equals

(id X +* (x,y))*p;
end;

definition
let U, x, u, q;
redefine func (x,u)-SymbolSubstIn q -> FinSequence of U;
end;

definition 
let U, x, u;
func x SubstWith u -> Function of U*, U* means

for q holds it.q = (x, u)-SymbolSubstIn q;
end;

registration
let U, x, u;
cluster x SubstWith u -> FinSequence-yielding for Function;
end;

registration
let F be FinSequence-yielding Function, x be set;
cluster F.x -> FinSequence-like;
end;

registration
let U,x,u,m; let p be U-valued m-element FinSequence;
cluster (x SubstWith u).p -> m-element for FinSequence;
end;

registration
let U,x,u; let e be empty set;
cluster (x SubstWith u).e -> empty for set;
end;

registration
let U;
cluster U-multiCat -> FinSequence-yielding for Function;
end;

registration
let U;
cluster non empty for U-valued FinSequence;
end;

registration
let U,m1,n; let p be (m1+n)-element U-valued FinSequence;
cluster {p.m1} \ U -> empty for set;
end;

registration
let U,m,n; let p be (m+1+n)-element Element of U*;
cluster {p.(m+1)} \ U -> empty for set;
end;

registration
let x;
cluster <*x*> \+\ {[1,x]} -> empty for set;
end;

registration 
let m; let p be (m+1)-element FinSequence;
cluster p|Seg m ^ <*p.(m+1)*> \+\ p -> empty for set;
end;

registration
let m,n; let p be (m+n)-element FinSequence;
cluster p|Seg m -> m-element for FinSequence;
end;

registration
cluster {{}}-valued -> empty-yielding for Relation;
cluster empty-yielding -> {{}}-valued for Relation;
end;

theorem 
U-multiCat.x=(MultPlace(U-concatenation)).x;

theorem 
p is U*-valued implies
(U-multiCat).(p^<*q*>) = (U-multiCat.p)^q;

registration
let Y; let X be Subset of Y; let R be total Y-defined Relation;
cluster R|X -> total for X-defined Relation;
end;

theorem 
(u=u1 implies (u1,x2)-SymbolSubstIn <*u*>=<*x2*>) &
(u<>u1 implies (u1,x2)-SymbolSubstIn <*u*>=<*u*>);

theorem 
(u=u1 implies (u1 SubstWith u2).<*u*>=<*u2*>) &
(u<>u1 implies (u1 SubstWith u2).<*u*>=<*u*>);

theorem 
(x SubstWith u).(q1^q2)=((x SubstWith u).q1)^((x SubstWith u).q2);

theorem 
p is U*-valued implies 
(x SubstWith u).(U-multiCat.p)=U-multiCat.((x SubstWith u)*p);

theorem 
(U-concatenation).:(id (1-tuples_on U)) =
{<*u,u*> where u is Element of U: not contradiction};

registration
let f,U,u;
cluster ((f|U).u) \+\ f.u -> empty for set;
end;

registration 
let f,U1,U2; let u be Element of U1, g be Function of U1,U2;
cluster (f*g).u \+\ f.(g.u) -> empty for set;
end;

registration
cluster non negative -> natural for integer number;
end;

registration
let x,y be real number;
cluster max(x,y)-x -> non negative for ext-real number;
end;

theorem 
x is boolean implies (x=1 iff x<>0);

registration
let Y; let X be Subset of Y;
cluster X\Y -> empty for set;
end;

registration
let x,y;
cluster {x}\{x,y} -> empty for set;
cluster ([x,y]`1) \+\ x -> empty for set;
end;
registration
let x,y;
cluster ([x,y]`2) \+\ y -> empty for set;
end;

registration
let n be positive Nat;
let X be non empty set;
cluster n-element for Element of X*\{{}};
end;

registration
let m1;
cluster (m1+0)-element -> non empty for FinSequence;
end;

registration
let R,x;
cluster R null x -> Relation-like for set;
end;

registration
let f be Function-like set; let x;
cluster f null x -> Function-like for set;
end;

registration
let p be FinSequence-like Relation; let x;
cluster p null x -> FinSequence-like for Relation;
end;

registration
let p,x;
cluster p null x -> (len p)-element for FinSequence;
end;

registration

let p be non empty FinSequence;
cluster len p -> non zero for number;
end;

registration
let R be Relation, X be set;
cluster R|X -> X-defined for Relation;
end;

registration
let x; let e be empty set;
cluster e null x -> empty for set;
end;

registration
let X; let e be empty set;
cluster e null X -> X-valued for Relation;
end;

registration
let Y be non empty FinSequence-membered set;
cluster Y-valued -> FinSequence-yielding for Function;
end;

registration
let X,Y;
cluster -> FinSequence-yielding for Element of Funcs (X,Y*);
end;

theorem 
f is X*-valued implies f.x in X*;

registration
let m,n; let p be m-element FinSequence;
cluster p null n -> (Seg (m+n))-defined for Relation;
end;

registration
let m,n; let p be m-element FinSequence; let q be n-element FinSequence;
cluster p^q -> (m+n)-element for FinSequence;
end;

theorem 
for p1,p2,q1,q2 being FinSequence st p1 is m-element & 
q1 is m-element & (p1^p2=q1^q2 or p2^p1=q2^q1) holds (p1=q1 & p2=q2);

theorem 
(U-multiCat.x is U1-valued & x in U**) implies
x is FinSequence of (U1*);

registration
let m;
cluster (m+1)-element -> non empty for FinSequence;
end;

registration
let U,u;
cluster (id U).u \+\ u -> empty for set;
end;

registration
let U; let p be U-valued non empty FinSequence;
cluster {p.1}\U -> empty for set;
end;

theorem 
(x1=x2 implies f+*(x1.-->y1)+*(x2.-->y2)=f+*(x2.-->y2)) &
(x1<>x2 implies f+*(x1.-->y1)+*(x2.-->y2)=f+*(x2.-->y2)+*(x1.-->y1));

registration
let X,U;
cluster U-valued total for X-defined Function;
end;

registration
let X, U; let P be U-valued total X-defined Relation;
let Q be total U-defined Relation;
cluster P*Q -> total for X-defined Relation;
end;

theorem 
p^p1^p2 is X-valued implies (p2 is X-valued & p1 is X-valued & p is X-valued);

registration
let X; let R be Relation;
cluster R null X -> (X \/ rng R)-valued for Relation;
end;

registration
let X,Y be functional set;
cluster X\/Y -> functional;
end;

registration
cluster FinSequence-membered -> finite-membered for set;
end;

definition
let X be functional set;
func SymbolsOf X equals

union {rng x where x is Element of X\/{{}}: x in X};
end;

registration
cluster trivial FinSequence-membered non empty for set;
end;

registration let X be functional finite finite-membered set;
cluster SymbolsOf X -> finite;
end;

registration let X be finite FinSequence-membered set;
cluster SymbolsOf X -> finite;
end;

theorem 
SymbolsOf {f} = rng f;

registration let z be non zero complex number;
cluster abs(z) -> positive for ext-real number;
end;

scheme 
 Sc1 {A() -> set, B() -> set, F(set) -> set}:
{F(x) where x is Element of A(): x in A()} =
{F(x) where x is Element of B(): x in A()}
provided
 A() c= B();

definition let X be functional set;
redefine func SymbolsOf X equals

union {rng x where x is Element of X: x in X};
end;

theorem 
for B being functional set, A being Subset of B holds
SymbolsOf A c= SymbolsOf B; 

theorem 
for A,B being functional set holds
SymbolsOf (A\/B) = SymbolsOf A \/ (SymbolsOf B);

registration let X; let F be Subset of bool X;
cluster union F \ X -> empty for set;
end;

theorem 
X=X\Y\/(X/\Y);

theorem 
m-tuples_on A meets n-tuples_on B implies m=n;

theorem 
B is D-prefix & A c= B implies A is D-prefix;

theorem 
f c= g iff for x st x in dom f holds (x in dom g & f.x = g.x);

registration let U;
cluster non empty -> non empty-yielding for Element of (U*\{{}})*;
end;

registration let e be empty set;
cluster -> empty for Element of e*;
end;

theorem 
(U1-multiCat.x <> {} & U2-multiCat.x <> {} implies
U1-multiCat.x = U2-multiCat.x) &
(p is {}*-valued implies U1-multiCat.p={}) &
(U1-multiCat.p={} & p is U1*-valued implies p is {}*-valued);

registration let U, x;
cluster U-multiCat.x -> U-valued;
end;

definition let x;
func x null equals

x;
end;

registration let Y be with_non-empty_elements set;
cluster non empty -> non empty-yielding for Y-valued Relation;
end;

registration let X;
cluster X\{{}} -> with_non-empty_elements;
end;

registration let X be with_non-empty_elements set;
cluster -> with_non-empty_elements for (Subset of X);
end;

registration let U;
cluster U* -> infinite for set;
end;

registration let U;
cluster U* -> with_non-empty_element;
end;

registration let X be with_non-empty_element set;
cluster with_non-empty_elements non empty for Subset of X;
end;

theorem 
U1 c= U2 & Y c= U1* & p is Y-valued & p<>{} &
Y is with_non-empty_elements implies U1-multiCat.p=U2-multiCat.p;

theorem 
(ex p st x=p & p is X*-valued) implies U-multiCat.x is X-valued;

registration let X,m;
cluster (m-tuples_on X) \ (X*) -> empty for set;
end;

theorem 
(A/\B)* = A* /\ (B*);

theorem 
(P\/Q)|X = P|X \/ (Q|X);

registration let X;
cluster (bool X) \ X -> non empty for set;
end;

registration let X; let R be Relation;
cluster R null X -> (X\/dom R)-defined for Relation;
end;

theorem 
f|X +* g = f|(X\dom g) \/ g;

registration
let X; let f be X-defined Function, g be total X-defined Function;
identify f+*g with g null f;
identify g null f with f+*g;
end;

theorem 
not y in proj2 X implies [:A,{y}:] misses X;

definition let X;
func X-freeCountableSet equals

[:NAT, {the Element of (bool proj2 X\proj2 X)}:];
end;

theorem 
X-freeCountableSet /\X={} & X-freeCountableSet is infinite;

registration let X;
cluster X-freeCountableSet -> infinite for set;
end;

registration let X;
cluster X-freeCountableSet /\ X -> empty;
end;

registration
let X;
cluster X-freeCountableSet -> countable for set;
end;

registration
cluster NAT\INT -> empty;
end;

registration
let x,p;
cluster (<*x*>^p).1 \+\ x -> empty for set;
end;

registration
let m; let m0 be zero number; let p be m-element FinSequence;
cluster p null m0 -> total for (Seg (m+m0))-defined Relation;
end;

registration
let U, q1, q2;
cluster U-multiCat.<*q1, q2*> \+\ q1^q2 -> empty for set;
end;















begin

reserve k,m,n for Nat, kk,mm,nn for Element of NAT, X,Y,x,y,z for set;

registration
let z be zero integer number;
cluster abs(z) -> zero for integer number;
end;

registration
cluster negative integer for real number;
cluster positive -> natural for integer number;
end;

registration
let S be non degenerated ZeroOneStr;
cluster (the carrier of S) \ {the OneF of S} -> non empty;
end;






definition
struct (ZeroOneStr) Language-like
(#carrier -> set, ZeroF, OneF -> Element of the carrier,
adicity->Function of the carrier\{the OneF}, INT#);
end;

definition
let S be Language-like;
func AllSymbolsOf S equals

the carrier of S;
func LettersOf S equals

(the adicity of S) " {0};
func OpSymbolsOf S equals

(the adicity of S) " (NAT \ {0});
func RelSymbolsOf S equals

(the adicity of S) " (INT \ NAT);
func TermSymbolsOf S equals

(the adicity of S) " NAT;
func LowerCompoundersOf S equals

(the adicity of S) " (INT \ {0});
func TheEqSymbOf S equals

the ZeroF of S;
func TheNorSymbOf S equals

the OneF of S;
func OwnSymbolsOf S equals

(the carrier of S)\{the ZeroF of S,the OneF of S};
end;

definition
let S be Language-like;
mode Element of S is Element of (AllSymbolsOf S);
func AtomicFormulaSymbolsOf S equals

(AllSymbolsOf S) \ {TheNorSymbOf S};
func AtomicTermsOf S equals

1-tuples_on (LettersOf S);
attr S is operational means

(OpSymbolsOf S) is non empty;
attr S is relational means

(RelSymbolsOf S) \ {TheEqSymbOf S} is non empty;
end;

definition
let S be Language-like;
let s be Element of S;
attr s is literal means

s in LettersOf S;
attr s is low-compounding means

s in LowerCompoundersOf S;
attr s is operational means

s in OpSymbolsOf S;
attr s is relational means

s in RelSymbolsOf S;
attr s is termal means

s in TermSymbolsOf S;
attr s is own means

s in OwnSymbolsOf S; 
attr s is ofAtomicFormula means

s in AtomicFormulaSymbolsOf S;
end;

definition
let S be ZeroOneStr;
let s be Element of (the carrier of S)\{the OneF of S};
func TrivialArity(s) -> integer number equals

-2 if s=the ZeroF of S otherwise 0;
end;

definition
let S be ZeroOneStr;
let s be Element of (the carrier of S)\{the OneF of S};
redefine func TrivialArity(s) -> Element of INT;
end;

definition
let S be non degenerated ZeroOneStr;
func S TrivialArity->Function of (the carrier of S)\{the OneF of S},INT means

 for s being Element of (the carrier of S)\{the OneF of S}
holds it.s=TrivialArity(s);
end;

registration
cluster infinite for non degenerated ZeroOneStr;
end;

registration
let S be infinite non degenerated ZeroOneStr;
cluster (S TrivialArity)"{0} -> infinite;
end;

definition
let S be Language-like;
attr S is eligible means

LettersOf S is infinite & 
(the adicity of S).(TheEqSymbOf S)=-2;
end;

registration
cluster non degenerated for Language-like;
end;

registration
cluster eligible for non degenerated Language-like;
end;

definition
mode Language is eligible non degenerated Language-like;
end;

reserve S,S1,S2 for Language, s,s1,s2 for Element of S;

definition
let S be non empty Language-like;
redefine func AllSymbolsOf S -> non empty set;
end;

registration
let S be eligible Language-like;
cluster LettersOf S -> infinite;
end;

definition
let S be Language;
redefine func LettersOf S -> non empty Subset of (AllSymbolsOf S);
end;

registration
let S be Language;
cluster TheEqSymbOf S -> relational for Element of S;
end;

definition
let S be non degenerated Language-like;
redefine func AtomicFormulaSymbolsOf S
-> non empty Subset of (AllSymbolsOf S);
end;

definition
let S be non degenerated Language-like;
redefine func TheEqSymbOf S -> Element of AtomicFormulaSymbolsOf S;
end;

theorem 
for S being Language holds 
LettersOf S /\ OpSymbolsOf S ={} &
TermSymbolsOf S /\ LowerCompoundersOf S = OpSymbolsOf S &
RelSymbolsOf S \ OwnSymbolsOf S = {TheEqSymbOf S} &
OwnSymbolsOf S c= AtomicFormulaSymbolsOf S &
RelSymbolsOf S c= LowerCompoundersOf S &
OpSymbolsOf S c= TermSymbolsOf S &
LettersOf S c= TermSymbolsOf S &
TermSymbolsOf S c= OwnSymbolsOf S &
OpSymbolsOf S c= LowerCompoundersOf S &
LowerCompoundersOf S c= AtomicFormulaSymbolsOf S;

registration
let S be Language;
cluster TermSymbolsOf S -> non empty for set;
cluster own -> ofAtomicFormula for Element of S;
cluster relational -> low-compounding for Element of S;
cluster operational -> termal for Element of S;
cluster literal -> termal for Element of S;
cluster termal -> own for Element of S;
cluster operational -> low-compounding for Element of S;
cluster low-compounding -> ofAtomicFormula for Element of S;
cluster termal -> non relational for Element of S;
cluster literal -> non relational for Element of S;
cluster literal -> non operational for Element of S;
end;

registration
let S be Language;
cluster relational for Element of S;
cluster literal for Element of S;
end;

registration
let S be Language;
cluster termal -> operational for low-compounding Element of S;
end;

registration
let S be Language;
cluster ofAtomicFormula for Element of S;
end;

definition
let S be Language;
let s be ofAtomicFormula Element of S;
func ar(s) -> Element of INT equals

(the adicity of S).s;
end;

registration
let S be Language; let s be literal Element of S;
cluster ar(s) -> zero for number;
end;

definition
let S be Language;
func S-cons -> BinOp of (AllSymbolsOf S)* 
equals

(AllSymbolsOf S)-concatenation;
end;

definition
let S be Language;
func S-multiCat -> Function of (AllSymbolsOf S)**, (AllSymbolsOf S)*
equals

(AllSymbolsOf S)-multiCat;
end;

definition
let S be Language;
func S-firstChar -> Function of (AllSymbolsOf S)*\{{}}, AllSymbolsOf S equals

(AllSymbolsOf S)-firstChar;
end;

definition 
let S be Language;
let X be set;
attr X is S-prefix means

X is (AllSymbolsOf S)-prefix;
end;

registration
let S be Language;
cluster S-prefix -> (AllSymbolsOf S)-prefix for set;
cluster (AllSymbolsOf S)-prefix -> S-prefix for set;
end;

definition
let S be Language;
mode string of S is Element of ((AllSymbolsOf S)*\{{}});
end;

registration
let S;
cluster (AllSymbolsOf S)*\{{}} -> non empty for set;
end;

registration
let S;
cluster -> non empty for string of S;
end;

registration
cluster -> infinite for Language;
end;

registration
let S be Language; cluster AllSymbolsOf S -> infinite;

end;

definition
let S be Language;
let s be ofAtomicFormula Element of S;
let Strings be set;
func Compound(s,Strings) equals

{<*s*> ^ ((S-multiCat).StringTuple) where
StringTuple is Element of (AllSymbolsOf S)**:
rng StringTuple c= Strings & StringTuple is (abs(ar(s)))-element};
end;

definition
let S be Language;
let s be ofAtomicFormula Element of S;
let Strings be set;
redefine func Compound(s,Strings) -> Element of bool ((AllSymbolsOf S)*\{{}});
end;

definition
let S be Language;
func S-termsOfMaxDepth -> Function means

dom it=NAT & 
it.0 = (AtomicTermsOf S) & for n being Nat holds it.(n+1) =
(union {Compound(s,it.n) where s is ofAtomicFormula Element of S:
s is operational})
\/ it.n;
end;

definition
let S;
redefine func AtomicTermsOf S -> Subset of (AllSymbolsOf S)*;
end;

definition
let S be Language;
func AllTermsOf S equals

union rng (S-termsOfMaxDepth);
end;

theorem 
S-termsOfMaxDepth.mm c= AllTermsOf S;

definition
let S be Language;
let w be string of S;
attr w is termal means

w in AllTermsOf S; 
end;

definition
let m be Nat;
let S be Language;
let w be string of S;
attr w is m-termal means

w in S-termsOfMaxDepth.m; 
end;

registration
let m be Nat;
let S be Language;
cluster m-termal -> termal for string of S;
end;

definition let S;
redefine func S-termsOfMaxDepth -> Function of NAT,bool((AllSymbolsOf S)*);
end;

definition
let S;
redefine func AllTermsOf S -> non empty Subset of (AllSymbolsOf S)*;
end;

registration
let S;
cluster AllTermsOf S -> non empty;
end;

registration
let S,m;
cluster S-termsOfMaxDepth.m -> non empty;
end;

registration
let S,m;
cluster -> non empty for (Element of S-termsOfMaxDepth.m);
end;

registration
let S;
cluster -> non empty for (Element of AllTermsOf S);
end;

registration
let m be Nat, S be Language;
cluster m-termal for string of S;
end;

registration
let S;
cluster 0-termal -> 1-element for (string of S);
end;

registration
let S be Language; let w be 0-termal string of S;
cluster S-firstChar.w -> literal for Element of S;
end;

registration
let S;
let w be termal (string of S);
cluster S-firstChar.w -> termal for Element of S;
end;

definition
let S; let t be termal string of S;
func ar(t) -> Element of INT equals

ar(S-firstChar.t);
end;

theorem 
for w being (mm+1)-termal string of S ex T being Element of
((S-termsOfMaxDepth).mm)* st T is (abs(ar(S-firstChar.w)))-element
& w=<*S-firstChar.w*>^((S-multiCat).T);

registration
let S,m;
cluster S-termsOfMaxDepth.m -> S-prefix;
end;

registration
let S; let V be Element of (AllTermsOf S)*;
cluster S-multiCat.V -> Relation-like;
end;

registration
let S; let V be Element of (AllTermsOf S)*;
cluster S-multiCat.V -> Function-like for Relation;
end;

definition
let S;
let phi be string of S;
attr phi is 0wff means

ex s being relational 
Element of S, V being abs(ar(s))-element Element of (AllTermsOf S)* st
phi=<*s*>^(S-multiCat.V);
end;

registration
let S;
cluster 0wff for string of S;
end;

registration
let S; let phi be 0wff string of S;
cluster S-firstChar.phi -> relational for Element of S;
end;

definition
let S; func AtomicFormulasOf S equals

{phi where phi is string of S: phi is 0wff};
end;

definition
let S;
redefine func AtomicFormulasOf S -> Subset of (AllSymbolsOf S)*\{{}};
end;

registration
let S;
cluster AtomicFormulasOf S -> non empty;
end;

registration
let S;
cluster -> 0wff for (Element of AtomicFormulasOf S);
end;

registration
let S;
cluster AllTermsOf S -> S-prefix;
end;

definition
let S; let t be termal string of S;
func SubTerms(t) -> Element of (AllTermsOf S)* means

it is (abs(ar(S-firstChar.t)))-element &
t=<*S-firstChar.t*>^(S-multiCat.it);
end;

registration
let S; let t be termal string of S;
cluster SubTerms(t) -> (abs(ar(t)))-element for Element of (AllTermsOf S)*;
end;

registration
let S; let t0 be 0-termal string of S;
cluster SubTerms(t0) -> empty for Element of (AllTermsOf S)*;
end;

registration
let mm,S; let t be (mm+1)-termal string of S;
cluster SubTerms(t) ->
(S-termsOfMaxDepth.mm)-valued for (Element of (AllTermsOf S)*);
end;

definition 
let S; let phi be 0wff string of S;
func SubTerms(phi) -> abs(ar(S-firstChar.phi))-element
Element of (AllTermsOf S)* means

phi=<*S-firstChar.phi*>^(S-multiCat.it);
end;

registration
let S; let phi be 0wff string of S;
cluster SubTerms phi -> abs(ar(S-firstChar.phi))-element for FinSequence;
end;

definition
let S;
redefine func AllTermsOf S -> Element of
bool ((AllSymbolsOf S)*\{{}});
end;

registration
let S;
cluster -> termal for Element of AllTermsOf S;
end;

definition
let S;
func S-subTerms -> Function of (AllTermsOf S), (AllTermsOf S)* means

for t being Element of AllTermsOf S holds it.t=SubTerms(t);
end;

theorem 
S-termsOfMaxDepth.m c= S-termsOfMaxDepth.(m+n); 

theorem 
x in AllTermsOf S implies ex nn st x in S-termsOfMaxDepth.nn;

theorem 
AllTermsOf S c= (AllSymbolsOf S)*\{{}};

theorem 
AllTermsOf S is S-prefix;

theorem 
x in AllTermsOf S implies x is string of S;

theorem 
(AtomicFormulaSymbolsOf S) \ OwnSymbolsOf S={TheEqSymbOf S};

theorem 
TermSymbolsOf S\(LettersOf S) = OpSymbolsOf S;

theorem 
(AtomicFormulaSymbolsOf S) \ (RelSymbolsOf S)=TermSymbolsOf S;

registration let S;
cluster non relational -> termal for ofAtomicFormula Element of S;
end;

definition let S;
redefine func OwnSymbolsOf S -> Subset of AllSymbolsOf S;
end;

registration let S;
cluster non literal -> operational for termal Element of S;
end;

theorem 
x is string of S iff x is non empty Element of ((AllSymbolsOf S)*);

theorem 
x is string of S iff x is non empty FinSequence of (AllSymbolsOf S);

theorem 
S-termsOfMaxDepth is Function of NAT,bool((AllSymbolsOf S)*);

registration let S;
cluster -> literal for Element of (LettersOf S);
end;

registration
let S;
cluster TheNorSymbOf S -> non low-compounding for Element of S;
end;

registration let S;
cluster TheNorSymbOf S -> non own for Element of S;
end;

theorem 
s<>TheNorSymbOf S & s<>TheEqSymbOf S implies s in OwnSymbolsOf S;

reserve l,l1,l2 for literal Element of S, a for ofAtomicFormula Element of S,
r for relational Element of S, w,w1,w2 for string of S,
t,t1,t2 for termal string of S, tt,tt1, tt2 for Element of AllTermsOf S;

definition 
let S, t;
func Depth t -> Nat means

t is it-termal & for n st t is n-termal holds it <= n;
end;

registration
let S; let m0 be zero number; let t be m0-termal string of S;
cluster Depth t -> zero for number;
end;

registration
let S; let s be low-compounding Element of S;
cluster ar(s) -> non zero for number;
end;

registration
let S; let s be termal Element of S;
cluster ar s -> non negative ext-real;
end;

registration
let S; let s be relational Element of S;
cluster ar s -> negative ext-real;
end;

theorem 
t is non 0-termal implies S-firstChar.t is operational &
SubTerms t <> {};

registration let S;
cluster S-multiCat -> FinSequence-yielding for Function;
end;

registration
let S; let W be non empty ((AllSymbolsOf S)*\{{}})-valued FinSequence;
cluster S-multiCat.W -> non empty for set;
end;

registration let S, l;
cluster <*l*> -> 0-termal for string of S;
end;

registration let S, m, n;
cluster (m+0*n)-termal -> (m+n)-termal for string of S;
end;

registration let S;
cluster non low-compounding -> literal for own Element of S;
end;

registration let S, t;
cluster SubTerms t -> (rng t)*-valued for Relation;
end;

registration
let S; let phi0 be 0wff string of S;
cluster SubTerms phi0 -> (rng phi0)*-valued for Relation;
end;

definition let S;
redefine func S-termsOfMaxDepth ->
Function of NAT,bool((AllSymbolsOf S)*\{{}});
end;

registration let S,mm;
cluster S-termsOfMaxDepth.mm -> with_non-empty_elements;
end;

registration
let S,m; let t be termal string of S;
cluster t null m -> (Depth t+m)-termal for string of S;
end;

registration
let S;
cluster termal -> (TermSymbolsOf S)-valued for string of S;
end;

registration
let S;
cluster AllTermsOf S\((TermSymbolsOf S)*) -> empty for set;
end;

registration
let S; let phi0 be 0wff string of S;
cluster SubTerms phi0 -> (TermSymbolsOf S)*-valued;
end;

registration
let S;
cluster 0wff -> (AtomicFormulaSymbolsOf S)-valued for string of S;
end;

registration
let S;
cluster OwnSymbolsOf S -> non empty for set;
end;

reserve phi0 for 0wff string of S;

theorem 
S-firstChar.phi0<>TheEqSymbOf S implies
phi0 is (OwnSymbolsOf S)-valued;

registration
cluster strict non empty for Language-like;
end;

definition 
let S1, S2 be Language-like;
attr S2 is S1-extending means

the adicity of S1 c= the adicity of S2 & TheEqSymbOf S1=TheEqSymbOf S2 &
TheNorSymbOf S1 = TheNorSymbOf S2;
end;

registration
let S;
cluster S null -> S-extending for Language-like;
end;

registration
let S;
cluster S-extending for Language;
end;

registration
let S1; let S2 be S1-extending Language;
cluster OwnSymbolsOf S1 \ OwnSymbolsOf S2 -> empty;
end;

definition
let f be (INT)-valued Function; let L be non empty Language-like;
func L extendWith f -> strict non empty Language-like means

the adicity of it = f|(dom f \ {the OneF of L}) +* (the adicity of L) &
the ZeroF of it = the ZeroF of L &
the OneF of it = the OneF of L;
end;

registration
let S be non empty Language-like; let f be (INT)-valued Function;
cluster S extendWith f -> S-extending;
end;

registration
let S be non degenerated Language-like;
cluster S-extending -> non degenerated for (Language-like);
end;

registration
let S be eligible Language-like;
cluster S-extending -> eligible for (Language-like);
end;

registration
let E be empty Relation; let X;
cluster X|`E -> empty;
end;

registration
let X; let m be integer number;
cluster X --> m -> (INT)-valued;
end;

definition
let S; let X be functional set;
func S addLettersNotIn X -> S-extending Language equals

S extendWith (
(((AllSymbolsOf S)\/(SymbolsOf X))-freeCountableSet --> 0)
 qua (INT)-valued Function);
end;

registration
let S1; let X be functional set;
cluster (LettersOf (S1 addLettersNotIn X)) \ SymbolsOf X -> infinite;
end;

registration
cluster countable for Language;
end;

registration
let S be countable Language;
cluster AllSymbolsOf S -> countable;
end;

registration
let S be countable Language;
cluster (AllSymbolsOf S)*\{{}} -> countable;
end;

registration
let L be non empty Language-like; let f be (INT)-valued Function;
cluster AllSymbolsOf (L extendWith f) \+\ (dom f \/ AllSymbolsOf L)
-> empty for set;
end;

registration
let S be countable Language; let X be functional set;
cluster S addLettersNotIn X -> countable for 1-sorted;
end;















begin

reserve k,m,n for Nat, kk,mm,nn for Element of NAT, A,B,X,Y,Z,x,y,z for set,
S, S1, S2 for Language, s for (Element of S), w,w1,w2 for (string of S),
U,U1,U2 for non empty set, f,g for Function, p,p1,p2 for FinSequence;

definition let S;
redefine func TheNorSymbOf S -> Element of S;
end;

definition let U be non empty set;
func U-deltaInterpreter -> Function of (2-tuples_on U), BOOLEAN equals

chi((U-concatenation) .: (id (1-tuples_on U)), 2-tuples_on U);
end;

definition let X be set;
redefine func id X -> Equivalence_Relation of X;
end;

definition
let S be Language; let U be non empty set;
let s be ofAtomicFormula Element of S;
mode Interpreter of s, U means

it is Function of (abs(ar(s)))-tuples_on U, BOOLEAN if s is relational
otherwise it is Function of (abs(ar(s)))-tuples_on U, U;
end;

definition
let S,U; let s be ofAtomicFormula Element of S;
redefine mode Interpreter of s,U ->
Function of (abs(ar(s)))-tuples_on U, U\/BOOLEAN;
end;

registration
let S,U; let s be termal Element of S;
cluster -> U-valued for (Interpreter of s,U);
end;

registration
let S be Language;
cluster literal -> own for Element of S;
end;






definition
let S, U; 
mode Interpreter of S, U -> Function means

for s being own Element of S holds it.s is Interpreter of s, U;
end;

definition
let S, U, f;
attr f is (S,U)-interpreter-like means

f is Interpreter of S,U & f is Function-yielding;
end;

registration
let S; let U be non empty set;
cluster (S,U)-interpreter-like -> Function-yielding for Function;
end;

registration
let S,U; let s be own Element of S;
cluster -> non empty for Interpreter of s,U;
end;

registration
let S be Language;
let U be non empty set;
cluster (S,U)-interpreter-like for Function;
end;

definition
let S,U;
let I be (S,U)-interpreter-like Function;
let s be own Element of S;
redefine func I.s -> Interpreter of s,U;
end;

registration
let S be Language, U be non empty set;
let I be (S,U)-interpreter-like Function;
let x be own Element of S, f be Interpreter of x, U;
cluster I +* (x .--> f) -> (S,U)-interpreter-like;
end;

definition
let f,x,y;
func (x,y) ReassignIn f -> Function equals

f +* (x .--> ({} .--> y));
end;

registration
let S be Language,U be non empty set,I be (S,U)-interpreter-like Function;
let x be literal Element of S, u be Element of U;
cluster (x,u) ReassignIn I -> (S,U)-interpreter-like;
end;





registration
let S be Language;
cluster (AllSymbolsOf S) -> non empty;
end;

registration
let Y be set;
let X,Z be non empty set;
cluster -> Function-yielding for (Function of X, Funcs(Y,Z));
end;

registration
let X,Y,Z be non empty set;
cluster Function-yielding for Function of X, Funcs(Y,Z);
end;

definition
let f be Function-yielding Function, g be Function;
func ^^^ g, f __ -> Function means

dom it=dom f & for x st x in dom f holds it.x=g*(f.x);
end;

registration
let f be empty Function, g be Function;
cluster ^^^ g, f __ -> empty;
end;

definition
let f be Function-yielding Function, g be Function;
func ^^^ f,g __ -> Function means

dom it = dom f /\ dom g &
for x being set st x in dom it holds it.x=(f.x).(g.x);
end;

registration
let f be Function-yielding Function, g be empty Function;
cluster ^^^ f, g __ -> empty;
end;

registration
let X be FinSequence-membered set;
cluster X-valued -> Function-yielding for Function;
end;

registration
let E, D be non empty set, p be D-valued FinSequence, h be Function of D,E;
cluster h*p -> (len p)-element for FinSequence;
end;

registration
let X,Y be non empty set;
let f be Function of X,Y; let p be X-valued FinSequence;
cluster f*p -> FinSequence-like;
end;

registration
let E, D be non empty set, n be Nat,
p be n-element D-valued FinSequence, h be Function of D,E;
cluster h*p -> n-element for FinSequence of E;
end;

theorem 
for t0 being 0-termal string of S holds t0=<*S-firstChar.t0*>;

definition 
let S; let U be non empty set, u be Element of U;
let I be (S,U)-interpreter-like Function;
func (I,u)-TermEval -> Function of NAT, Funcs(AllTermsOf S, U)
means

it.0=(AllTermsOf S) --> u & for mm holds
it.(mm+1)=^^^ I*(S-firstChar), ^^^ it.mm qua Function, S-subTerms __ __;
end;

definition
let S, U; let I be (S,U)-interpreter-like Function;
let t be Element of (AllTermsOf S);
func I-TermEval(t) -> Element of U means

for u1 being Element of U, mm st t in S-termsOfMaxDepth.mm holds
it=((I,u1)-TermEval.(mm+1)).t;
end;

definition 
let S,U; let I be (S,U)-interpreter-like Function;
func I-TermEval -> Function of AllTermsOf S,U means

for t being Element of AllTermsOf S holds it.t=I-TermEval(t);
end;




definition
let S,U; let I be (S,U)-interpreter-like Function;
func I=== -> Function equals

I +* ((TheEqSymbOf S) .--> (U-deltaInterpreter));
end;

definition
let S,U; let I be (S,U)-interpreter-like Function; let x be set;
attr x is I-extension means

x = I===; 
end;

registration
let S,U; let I be (S,U)-interpreter-like Function;
cluster I=== -> I-extension for Function;
cluster I-extension -> Function-like for set;
end;

registration
let S,U; let I be (S,U)-interpreter-like Function;
cluster I-extension for Function;
end;

registration
let S,U; let I be (S,U)-interpreter-like Function;
cluster I=== -> (S,U)-interpreter-like;
end;

definition
let S,U; let I be (S,U)-interpreter-like Function;
let f be I-extension Function, s be ofAtomicFormula Element of S;
redefine func f.s -> Interpreter of s,U;
end;

definition
let S,U; let I be (S,U)-interpreter-like Function;
let phi be 0wff string of S;
func I-AtomicEval(phi) equals

((I===).(S-firstChar.phi)).((I-TermEval)*(SubTerms(phi)));
end;

definition
let S,U; let I be (S,U)-interpreter-like Function;
let phi be 0wff string of S;
redefine func I-AtomicEval(phi) -> Element of BOOLEAN;
end;




registration
let S,U; let I be (S,U)-interpreter-like Function;
cluster I|(OwnSymbolsOf S) -> PFuncs(U*, U\/BOOLEAN)-valued for Function;
cluster I|(OwnSymbolsOf S) -> (S,U)-interpreter-like for Function;
end;

registration
let S,U; let I be (S,U)-interpreter-like Function;
cluster I|(OwnSymbolsOf S) -> total for (OwnSymbolsOf S)-defined Relation;
end;

definition
let S,U;
func U-InterpretersOf S equals

{f where f is Element of Funcs(OwnSymbolsOf S, PFuncs(U*,U\/BOOLEAN)):
f is (S,U)-interpreter-like};
end;

definition
let S,U;
redefine func U-InterpretersOf S -> Subset of
Funcs(OwnSymbolsOf S, PFuncs(U*,U\/BOOLEAN));
end;

registration
let S,U;
cluster U-InterpretersOf S -> non empty;
end;

registration
let S,U;
cluster -> (S,U)-interpreter-like for Element of U-InterpretersOf S;
end;

definition
let S,U;
func S-TruthEval(U) ->
Function of [: U-InterpretersOf S, AtomicFormulasOf S :],BOOLEAN
means

for I being Element of U-InterpretersOf S,
phi being Element of AtomicFormulasOf S holds it.(I,phi)=I-AtomicEval(phi);
end;

definition
let S,U; let I be Element of U-InterpretersOf S;
let f be PartFunc of [:U-InterpretersOf S, (AllSymbolsOf S)*\{{}}:], BOOLEAN;
let phi be Element of(AllSymbolsOf S)*\{{}};
func f-ExFunctor(I,phi) -> Element of BOOLEAN equals

TRUE if
ex u being Element of U, v being literal Element of S st
(phi.1=v & f.((v,u) ReassignIn I, phi/^1)=TRUE) otherwise FALSE;
end;

definition 
let S,U;
let g be
Element of PFuncs([:U-InterpretersOf S, (AllSymbolsOf S)*\{{}}:], BOOLEAN);
func ExIterator(g) ->
PartFunc of [:U-InterpretersOf S, (AllSymbolsOf S)*\{{}}:],BOOLEAN means

 (for x being Element of U-InterpretersOf S,
y being Element of (AllSymbolsOf S)*\{{}} holds
([x,y] in dom it iff (
ex v being literal Element of S, w being string of S st
[x,w] in dom g & y=<*v*>^w))) &
(for x being Element of U-InterpretersOf S,
y being Element of (AllSymbolsOf S)*\{{}} st [x,y] in dom it holds
it.(x,y)=g-ExFunctor(x,y));
end;

definition
let S,U;
let f be PartFunc of [:U-InterpretersOf S, (AllSymbolsOf S)*\{{}}:], BOOLEAN;
let I be Element of U-InterpretersOf S;
let phi be Element of(AllSymbolsOf S)*\{{}};
func f-NorFunctor(I,phi) -> Element of BOOLEAN equals

TRUE if ex w1, w2 being Element of (AllSymbolsOf S)*\{{}} st
([I,w1] in dom f & f.(I,w1)=FALSE & f.(I,w2)=FALSE &
phi=<*TheNorSymbOf S*>^w1^w2)
otherwise FALSE;
end;

















definition
let S,U;
let g be
Element of PFuncs([:U-InterpretersOf S, (AllSymbolsOf S)*\{{}}:], BOOLEAN);
func NorIterator(g) ->
PartFunc of [:U-InterpretersOf S, (AllSymbolsOf S)*\{{}}:],BOOLEAN
means

(for x being Element of U-InterpretersOf S,
y being Element of (AllSymbolsOf S)*\{{}} holds
([x,y] in dom it iff (
ex phi1, phi2 being Element of (AllSymbolsOf S)*\{{}} st
(y=<*TheNorSymbOf S*>^phi1^phi2 & [x,phi1] in dom g & [x,phi2] in dom g)
))) &
(for x being Element of U-InterpretersOf S,
y being Element of (AllSymbolsOf S)*\{{}} st [x,y] in dom it holds
it.(x,y)=g-NorFunctor(x,y));
end;

definition
let S,U; 
func (S,U)-TruthEval -> Function of NAT,
PFuncs([:U-InterpretersOf S, (AllSymbolsOf S)*\{{}}:], BOOLEAN) means

 it.0=S-TruthEval(U) & for mm holds
it.(mm+1)=ExIterator(it.mm) +* NorIterator(it.mm) +* it.mm;
end;

theorem 
for I being (S,U)-interpreter-like Function holds
I|(OwnSymbolsOf S) in U-InterpretersOf S;

definition 
let S be Language, m be Nat, U be non empty set;
func (S,U)-TruthEval m -> Element of
PFuncs([:U-InterpretersOf S, (AllSymbolsOf S)*\{{}}:], BOOLEAN)
means

for mm st m=mm holds it=(S,U)-TruthEval.mm;
end;

definition 
let S,U,m; let I be Element of U-InterpretersOf S;
func (I,m)-TruthEval -> Element of PFuncs((AllSymbolsOf S)*\{{}},BOOLEAN)
equals

(curry ((S,U)-TruthEval m)).I;
end;

definition
let S,m;
func S-formulasOfMaxDepth m -> Subset of ((AllSymbolsOf S)*\{{}}) means


for U being non empty set, I being Element of U-InterpretersOf S,
mm being Element of NAT st m=mm holds it=dom (I,mm)-TruthEval;
end;

definition
let S,m,w; 
attr w is m-wff means

w in S-formulasOfMaxDepth m;
end;

definition
let S,w; 
attr w is wff means

ex m st w is m-wff;
end;

registration
let S;
cluster 0-wff -> 0wff for string of S;
cluster 0wff -> 0-wff for string of S;
let m;
cluster m-wff -> wff for string of S;
let n;
cluster (m+0*n)-wff -> (m+n)-wff for (string of S);
end;

registration
let S,m;
cluster m-wff for string of S;
end;

registration
let S,m;
cluster S-formulasOfMaxDepth m -> non empty;
end;

registration
let S;
cluster wff for string of S;
end;

definition 
let S,U; let I be Element of U-InterpretersOf S, w be wff string of S;
func I-TruthEval w -> Element of BOOLEAN means

for m being Nat st w is m-wff holds it=((I,m)-TruthEval).w;
end;

definition
let S;
func AllFormulasOf S equals

{w where w is string of S: ex m st w is m-wff};
end;

registration
let S;
cluster AllFormulasOf S -> non empty;
end;

reserve u,u1,u2 for Element of U, t for termal string of S,
I for (S,U)-interpreter-like Function,
l, l1, l2 for literal (Element of S), m1, n1 for non zero Nat,
phi0 for 0wff string of S, psi,phi,phi1,phi2 for wff string of S;

theorem 
((I,u)-TermEval.(m+1)).t =
(I.(S-firstChar.t)).(((I,u)-TermEval.m)*(SubTerms(t))) &
(t is 0-termal implies ((I,u)-TermEval.(m+1)).t = (I.(S-firstChar.t)).{});

theorem 
for t being m-termal string of S holds
((I,u1)-TermEval.(m+1)).t = ((I,u2)-TermEval.(m+1+n)).t;

theorem 
curry ((S,U)-TruthEval m) is Function of
U-InterpretersOf S, PFuncs((AllSymbolsOf S)*\{{}},BOOLEAN);

theorem 
x in X\/Y\/Z iff x in X or x in Y or x in Z; 

theorem 
S-formulasOfMaxDepth 0 = AtomicFormulasOf S;

definition 
let S,m;
redefine func S-formulasOfMaxDepth m means

for U being non empty set, I being Element of U-InterpretersOf S
holds it=dom (I,m)-TruthEval;
end;

theorem 
(S,U)-TruthEval m in 
Funcs([:U-InterpretersOf S, S-formulasOfMaxDepth m:], BOOLEAN) &
(S,U)-TruthEval.m in
Funcs([:U-InterpretersOf S, S-formulasOfMaxDepth m:], BOOLEAN);

definition
let S,m;
func m-ExFormulasOf S equals

{<*v*>^phi where v is Element of LettersOf S,
phi is Element of S-formulasOfMaxDepth m: not contradiction};
func m-NorFormulasOf S equals

{<*TheNorSymbOf S*>^phi1^phi2 where
phi1 is Element of S-formulasOfMaxDepth m,
phi2 is Element of S-formulasOfMaxDepth m: not contradiction};
end;

definition
let S; let w1,w2 be string of S;
redefine func w1^w2 -> string of S;
end;

definition
let S,s;
redefine func <*s*> -> string of S;
end;

theorem 
S-formulasOfMaxDepth(m+1) = 
m-ExFormulasOf S \/ m-NorFormulasOf S \/ S-formulasOfMaxDepth m;

theorem 
AtomicFormulasOf S is S-prefix;

registration
let S;
cluster AtomicFormulasOf S -> S-prefix for set;
end;

registration
let S;
cluster S-formulasOfMaxDepth 0 -> S-prefix for set;
end;

definition 
let S, phi;
func Depth phi -> Nat means

phi is it-wff & for n st phi is n-wff holds it <= n;
end;

registration
let S, m; let phi1, phi2 be m-wff string of S;
cluster <*TheNorSymbOf S*>^phi1^phi2 -> (m+1)-wff for string of S;
end;

registration
let S, phi1, phi2;
cluster <*TheNorSymbOf S*>^phi1^phi2 -> wff for string of S;
end;

registration
let S, m; let phi be m-wff string of S, v be literal Element of S;
cluster <*v*>^phi -> (m+1)-wff for string of S;
end;

registration
let S,l,phi;
cluster <*l*>^phi -> wff for string of S;
end;

registration
let S, w; let s be non relational Element of S;
cluster <*s*>^w -> non 0wff for string of S;
end;

registration
let S, w1, w2; let s be non relational Element of S;
cluster <*s*>^w1^w2 -> non 0wff for string of S;
end;

registration
let S;
cluster TheNorSymbOf S -> non relational for (Element of S);
end;

registration
let S, w;
cluster <*TheNorSymbOf S*>^w -> non 0wff for string of S;
end;

registration
let S,l,w;
cluster <*l*>^w -> non 0wff for string of S;
end;

definition 
let S, w;
attr w is exal means

S-firstChar.w is literal;
end;

registration
let S,w,l;
cluster <*l*>^w -> exal for string of S;
end;

registration
let S,m1;
cluster exal for m1-wff string of S;
end;

registration
let S;
cluster exal -> non 0wff for string of S;
end;

registration
let S,m1;
cluster non 0wff for exal m1-wff string of S;
end;

registration
let S;
cluster non 0wff for exal wff string of S;
end;

registration
let S; let phi be non 0wff wff string of S;
cluster Depth phi -> non zero for Nat;
end;

registration
let S; let w be non 0wff wff string of S;
cluster S-firstChar.w -> non relational for Element of S;
end;

registration
let S, m;
cluster S-formulasOfMaxDepth m -> S-prefix for set;
end;

definition
let S;
redefine func AllFormulasOf S -> Subset of (AllSymbolsOf S)*\{{}};
end;

registration
let S;
cluster -> wff for Element of AllFormulasOf S;
end;

registration
let S;
cluster AllFormulasOf S -> S-prefix for set;
end;

theorem 
dom NorIterator((S,U)-TruthEval m) =
[:U-InterpretersOf S, m-NorFormulasOf S:];

theorem 
dom ExIterator((S,U)-TruthEval m)= 
[:U-InterpretersOf S, m-ExFormulasOf S:];

theorem 
U-deltaInterpreter"{1} =
{<*u,u*> where u is Element of U: not contradiction};

definition
let S;
redefine func TheEqSymbOf S -> Element of S;
end;

registration
let S;
cluster ar(TheEqSymbOf S) + 2 -> zero for number;
cluster abs(ar(TheEqSymbOf S)) - 2 -> zero for number;
end;

theorem 
for phi being 0wff string of S, I being (S,U)-interpreter-like Function
holds (S-firstChar.phi <> TheEqSymbOf S implies
I-AtomicEval phi=(I.(S-firstChar.phi)).((I-TermEval)*(SubTerms phi)))
& (S-firstChar.phi=TheEqSymbOf S implies
I-AtomicEval phi = (U-deltaInterpreter).((I-TermEval)*(SubTerms phi)));

theorem 
for I being (S,U)-interpreter-like Function,
phi being 0wff string of S st (S-firstChar.phi)=TheEqSymbOf S holds
(I-AtomicEval phi = 1 iff
(I-TermEval.((SubTerms phi).1) = I-TermEval.((SubTerms phi).2)));

registration
let S,m;
cluster m-ExFormulasOf S -> non empty for set;
end;

registration
let S,m;
cluster m-NorFormulasOf S -> non empty for set;
end;

definition
let S,m;
redefine func m-NorFormulasOf S -> Subset of (AllSymbolsOf S)*\{{}};
end;

registration
let S; let w be exal string of S;
cluster S-firstChar.w -> literal for Element of S;
end;

registration
let S,m;
cluster -> non exal for (Element of m-NorFormulasOf S);
end;

definition
let S,m;
redefine func m-ExFormulasOf S -> Subset of (AllSymbolsOf S)*\{{}};
end;

registration
let S,m;
cluster -> exal for Element of m-ExFormulasOf S;
end;

registration
let S;
cluster non literal for Element of S;
end;

registration
let S, w; let s be non literal Element of S;
cluster <*s*>^w -> non exal for string of S;
end;

registration
let S,w1,w2; let s be non literal Element of S;
cluster <*s*>^w1^w2 -> non exal for string of S;
end;

registration
let S;
cluster TheNorSymbOf S -> non literal for Element of S;
end;

theorem 
phi in AllFormulasOf S;

notation let S,m,w;
antonym w is m-nonwff for w is m-wff;
end;

registration let m, S;




cluster non m-wff -> m-nonwff for string of S;
end;

registration let S, phi1, phi2;
cluster <*TheNorSymbOf S*>^phi1^phi2 ->
(max(Depth phi1, Depth phi2))-nonwff for string of S;
end;

registration
let S,phi,l;
cluster <*l*>^phi -> (Depth phi)-nonwff for string of S;
end;

registration
let S,phi,l;
cluster <*l*>^phi -> (1+Depth phi)-wff for string of S;
end;

registration
let S,U;
cluster -> (OwnSymbolsOf S)-defined for (Element of U-InterpretersOf S);
end;

registration
let S,U;
cluster (OwnSymbolsOf S)-defined for (Element of U-InterpretersOf S);
end;

registration
let S,U;
cluster -> total for
(OwnSymbolsOf S)-defined (Element of U-InterpretersOf S);
end;

definition
let S, U; let I be Element of U-InterpretersOf S;
let x be literal Element of S, u be Element of U;
redefine func (x,u) ReassignIn I -> Element of U-InterpretersOf S;
end;

reserve I for Element of U-InterpretersOf S;

definition
let S, w;
func xnot w -> string of S equals

<*TheNorSymbOf S*>^w^w;
end;

registration
let S, m; let phi be m-wff string of S;
cluster xnot phi -> (m+1)-wff for string of S;
end;

registration
let S, phi;
cluster xnot phi -> wff for string of S;
end;

registration
let S;
cluster TheEqSymbOf S -> non own for Element of S;
end;

definition 
let S,X;
attr X is S-mincover means

for phi holds (phi in X iff not xnot phi in X);
end;

theorem 
Depth(<*TheNorSymbOf S*>^phi1^phi2)=1+max(Depth phi1, Depth phi2) &
Depth (<*l*>^phi1) = Depth phi1 + 1;

theorem 
(Depth phi=m+1) implies ((phi is exal iff phi in m-ExFormulasOf S)
& (phi is non exal iff phi in m-NorFormulasOf S)); 

theorem 
(I-TruthEval (<*l*>^phi) = TRUE iff       
(ex u st ((l,u) ReassignIn I)-TruthEval phi=1) ) &
(I-TruthEval (<*TheNorSymbOf S*>^phi1^phi2) = TRUE iff
(I-TruthEval phi1 = FALSE & I-TruthEval phi2 = FALSE));

reserve I for (S,U)-interpreter-like Function;

theorem 
(I,u)-TermEval.(m+1)|(S-termsOfMaxDepth.m) =I-TermEval|(S-termsOfMaxDepth.m);

theorem 
I-TermEval.t = (I.(S-firstChar.t)).((I-TermEval)*(SubTerms t));

definition 
let S,phi;
func SubWffsOf phi means

ex phi1, p st p is (AllSymbolsOf S)-valued
& it=[phi1,p] & phi=<*S-firstChar.phi*>^phi1^p if phi is non 0wff
otherwise it=[phi,{}];
end;

definition
let S,phi;

func head phi -> wff string of S equals

(SubWffsOf phi)`1;
func tail phi -> Element of (AllSymbolsOf S)* equals

(SubWffsOf phi)`2;
end;

registration
let S,m;
cluster (S-formulasOfMaxDepth m) \ (AllFormulasOf S) -> empty for set;
end;

registration
let S;
cluster (AtomicFormulasOf S) \ (AllFormulasOf S) -> empty for set;
end;

theorem 
Depth (<*l*>^phi1) > Depth phi1 &
Depth (<*TheNorSymbOf S*>^phi1^phi2) > Depth phi1 &
Depth (<*TheNorSymbOf S*>^phi1^phi2) > Depth phi2;

theorem 
(not phi is 0wff) implies
(phi=<*x*>^phi2^p2 iff (x=S-firstChar.phi & phi2=head phi & p2=tail phi));

registration
let S, m1;
cluster non exal for non 0wff m1-wff string of S;
end;

registration
let S; let phi be exal wff string of S;
cluster tail phi -> empty for set;
end;

definition
let S; let phi be non exal non 0wff wff string of S;
redefine func tail phi -> wff string of S;
end;

registration
let S; let phi be non exal non 0wff wff string of S;
cluster tail phi -> wff for (string of S);
end;

registration
let S, phi0;
identify head phi0 with phi0 null;
end;

registration
let S; let phi be non 0wff non exal wff string of S;
cluster S-firstChar.phi \+\ TheNorSymbOf S -> empty for set;
end;

registration
let m,S; let phi be (m+1)-wff string of S;
cluster head phi -> m-wff for string of S;
end;

registration
let m, S; let phi be (m+1)-wff non exal non 0wff string of S;
cluster tail phi -> m-wff for string of S;
end;

theorem 
for I being Element of U-InterpretersOf S holds
(I,m)-TruthEval in Funcs(S-formulasOfMaxDepth m, BOOLEAN);

registration
let S, U; let I be Element of U-InterpretersOf S; let phi0;
identify I-TruthEval phi0 with I-AtomicEval phi0;
identify I-AtomicEval phi0 with I-TruthEval phi0;
end;

registration
let S;
cluster non literal for ofAtomicFormula Element of S;
end;

theorem 
not l2 in rng p implies (l2,u) ReassignIn I-TermEval.p= I-TermEval.p;

definition 
let X,S,s;
attr s is X-occurring means

s in SymbolsOf (((AllSymbolsOf S*)\{{}}) /\ X);
end;

definition let S,s; let X;
attr X is s-containing means

s in SymbolsOf ((AllSymbolsOf S*)\{{}} /\ X);
end;

notation let X,S,s;
antonym s is X-absent for s is X-occurring;
end;

notation let S,s,X;
antonym X is s-free for X is s-containing;
end;

registration let X be finite set; let S;
cluster X-absent for literal Element of S;
end;

registration
let S,t;
cluster rng t /\ LettersOf S -> non empty for set;
end;

registration
let S, phi;
cluster rng phi /\ LettersOf S -> non empty for set;
end;

registration
let B,S; let A be Subset of B;
cluster A-occurring -> B-occurring for (Element of S);
end;

registration
let A,B,S;
cluster (A null B)-absent -> (A/\B)-absent for (Element of S);
end;

registration
let F be finite set; let A,S;
cluster A-absent -> (A\/F)-absent for F-absent Element of S;
end;

registration
let S,U; let I be (S,U)-interpreter-like Function;
cluster (OwnSymbolsOf S)\(dom I) -> empty for set;
end;

theorem 
ex u st u=I.l.{} & (l,u) ReassignIn I = I;

definition
let S,X;
attr X is S-covering means

for phi holds (phi in X or xnot phi in X);
end;

registration
let S;
cluster S-mincover -> S-covering for set;
end;

registration
let U, S; let phi be non 0wff non exal wff string of S;
let I be Element of U-InterpretersOf S;
cluster (I-TruthEval phi) \+\ I-TruthEval head phi
'nor' (I-TruthEval (tail phi)) -> empty for set;
end;

definition
let S;
func ExFormulasOf S -> Subset of (AllSymbolsOf S)*\{{}} equals

{phi where phi is string of S: phi is wff & phi is exal};
end;

registration
let S;
cluster ExFormulasOf S -> non empty for set;
end;

registration
let S;
cluster -> exal wff for Element of ExFormulasOf S;
end;

registration
let S;
cluster -> wff for Element of ExFormulasOf S;
end;

registration
let S;
cluster -> exal for Element of ExFormulasOf S;
end;

registration
let S;
cluster ExFormulasOf S \ (AllFormulasOf S) -> empty for set;
end;

registration
let U,S1; let S2 be S1-extending Language;
cluster (S2,U)-interpreter-like -> (S1,U)-interpreter-like for Function;
end;

registration
let U, S1; let S2 be S1-extending Language;
let I be (S2,U)-interpreter-like Function;
cluster I|OwnSymbolsOf S1 -> (S1,U)-interpreter-like for Function;
end;

registration
let U, S1; let S2 be S1-extending Language, I1 be Element of
U-InterpretersOf S1, I2 be (S2,U)-interpreter-like Function;
cluster I2 +* I1 -> (S2,U)-interpreter-like;
end;

definition 
let U,S; let I be Element of U-InterpretersOf S; let X;
attr X is I-satisfied means

for phi st phi in X holds I-TruthEval phi=1;
end;

definition 
let S, U, X; let I be Element of U-InterpretersOf S;
attr I is X-satisfying means

X is I-satisfied;
end;

registration
let U,S; let e be empty set; let I be Element of U-InterpretersOf S;
cluster e null I -> I-satisfied;
end;

registration
let X,U,S; let I be Element of U-InterpretersOf S;
cluster I-satisfied for Subset of X;
end;

registration
let U,S; let I be Element of U-InterpretersOf S;
cluster I-satisfied for set;
end;

registration
let U,S; let I be Element of U-InterpretersOf S;
let X be I-satisfied set;
cluster -> I-satisfied for (Subset of X);
end;

registration
let U,S; let I be Element of U-InterpretersOf S; let X,Y be I-satisfied set;
cluster X\/Y -> I-satisfied;
end;

registration
let U,S; let I be Element of U-InterpretersOf S; let X be I-satisfied set;
cluster I null X -> X-satisfying for (Element of U-InterpretersOf S);
end;

definition 
let S, X;
attr X is S-correct means

for U being non empty set, I being
(Element of U-InterpretersOf S), x being I-satisfied set, phi st
[x,phi] in X holds I-TruthEval phi=1;
end;

registration
let S;
cluster {} null S -> S-correct;
end;

registration
let S,X;
cluster S-correct for Subset of X;
end;

theorem 
for I being Element of U-InterpretersOf S holds
I-TruthEval phi=1 iff {phi} is I-satisfied;

theorem 
s is {w}-occurring iff s in rng w;

registration
let U, S; let phi1, phi2; let I be Element of U-InterpretersOf S;
cluster (I-TruthEval (<*TheNorSymbOf S*>^phi1^phi2)) \+\
I-TruthEval phi1 'nor' (I-TruthEval phi2) -> empty for set;
end;

registration
let S, phi, U; let I be Element of U-InterpretersOf S;
cluster I-TruthEval xnot phi \+\ ('not' (I-TruthEval phi)) -> empty for set;
end;

definition
let X, S, phi;
attr phi is X-implied means

for U being non empty set, I being
Element of U-InterpretersOf S st X is I-satisfied holds I-TruthEval phi=1;
end;
















begin

reserve A,B,C,X,Y,Z,x,x1,x2,y,z for set, U,U1,U2,U3 for non empty set,
u,u1,u2 for (Element of U), P,Q,R for Relation, f,g for Function,
k,m,n for Nat, m1, n1 for non zero Nat, kk,mm,nn for Element of NAT,
p, p1, p2 for FinSequence, q, q1, q2 for U-valued FinSequence;
reserve S, S1, S2 for Language, s,s1,s2 for Element of S,
l,l1,l2 for literal Element of S, a for ofAtomicFormula Element of S,
r for relational Element of S, w,w1,w2 for string of S,
t,t1,t2 for termal string of S;
reserve phi0 for 0wff string of S,
psi, psi1, psi2, phi,phi1,phi2 for wff string of S,
I for (S,U)-interpreter-like Function;
reserve tt,tt0,tt1,tt2 for Element of AllTermsOf S;

definition
let S,s;
let V be Element of ((AllSymbolsOf S)*\{{}})*;
func s-compound(V) -> string of S equals

 <*s*>^(S-multiCat.V);
end;

registration
let S,mm; let s be termal Element of S;
let V be (abs(ar(s)))-element Element of (S-termsOfMaxDepth.mm)*;
cluster s-compound(V) -> (mm+1)-termal for string of S;
end;

registration
let S; let s be termal Element of S;
let V be (abs(ar(s)))-element Element of (AllTermsOf S)*;
cluster s-compound(V) -> termal for string of S;
end;

registration
let S; let s be relational Element of S;
let V be (abs(ar(s)))-element Element of (AllTermsOf S)*;
cluster s-compound(V) -> 0wff for string of S;
end;

definition
let S,s;
func s-compound -> Function of ((AllSymbolsOf S)*\{{}})*,
(AllSymbolsOf S)*\{{}} means

for V being Element of ((AllSymbolsOf S)*\{{}})* holds it.V = s-compound(V);
end;

registration
let S; let s be termal Element of S;
cluster s-compound | ((abs(ar(s)))-tuples_on (AllTermsOf S)) ->
(AllTermsOf S)-valued;
end;

registration
let S; let s be relational Element of S;
cluster s-compound | ((abs(ar(s)))-tuples_on (AllTermsOf S)) ->
(AtomicFormulasOf S)-valued;
end;

definition
let S; let s be ofAtomicFormula Element of S; let X be set;
func X-freeInterpreter(s) equals

s-compound | ((abs(ar(s)))-tuples_on (AllTermsOf S)) if not s is relational
otherwise
(s-compound | ((abs(ar(s)))-tuples_on (AllTermsOf S))) *
(chi(X,AtomicFormulasOf S) qua Relation);
end;

definition
let S; let s be ofAtomicFormula Element of S; let X be set;
redefine func X-freeInterpreter(s) -> Interpreter of s,(AllTermsOf S);
end;

definition
let S,X;
func (S,X)-freeInterpreter -> Function means

dom it=OwnSymbolsOf S & 
for s being own Element of S holds it.s=X-freeInterpreter(s);
end;

registration
let S,X;
cluster (S,X)-freeInterpreter -> Function-yielding for Function;
end;

definition
let S,X;
redefine func (S,X)-freeInterpreter -> Interpreter of S,AllTermsOf S;
end;

registration
let S,X;
cluster (S,X)-freeInterpreter -> (S,AllTermsOf S)-interpreter-like for
Function;
end;

definition
let S,X;
redefine func (S,X)-freeInterpreter ->
Element of (AllTermsOf S)-InterpretersOf S;
end;

definition
let X,Y be non empty set; let R be Relation of X,Y; let n be Nat;
func n-placesOf R -> Relation of n-tuples_on X,n-tuples_on Y
equals

{[p,q] where p is Element of n-tuples_on X, q is Element of n-tuples_on Y
: for j being set st j in Seg n holds [p.j,q.j] in R};
end;

registration
let X,Y be non empty set;
let R be total Relation of X,Y;
let n be non zero Nat;
cluster n-placesOf R -> total for Relation of n-tuples_on X,n-tuples_on Y;
end;

registration
let X,Y be non empty set;
let R be total Relation of X,Y;
let n be Nat;
cluster n-placesOf R -> total for Relation of n-tuples_on X,n-tuples_on Y;
end;

registration
let X,Y be non empty set; let R be Relation of X,Y; let n be zero Nat;
cluster n-placesOf R -> Function-like
for Relation of n-tuples_on X, n-tuples_on Y;
end;

definition
let X be non empty set; let R be Relation of X; let n be Nat;
func n-placesOf R -> Relation of n-tuples_on X equals

n-placesOf (R qua
Relation of X,X);
end;

definition
let X be non empty set; let R be Relation of X; let n be zero Nat;
redefine func n-placesOf R -> Relation of n-tuples_on X equals

  {[{},{}]};
end;

registration
let X be non empty set; let R be symmetric total Relation of X; let n;
cluster n-placesOf R -> total for Relation of n-tuples_on X;
end;

registration
let X be non empty set; let R be symmetric total Relation of X; let n;
cluster n-placesOf R -> symmetric for Relation of n-tuples_on X;
end;

registration
let X be non empty set; let R be symmetric total Relation of X; let n;
cluster n-placesOf R -> symmetric total for Relation of n-tuples_on X;
end;

registration
let X be non empty set; let R be transitive total Relation of X; let n;
cluster n-placesOf R -> transitive total for Relation of n-tuples_on X;
end;

registration
let X be non empty set; let R be Equivalence_Relation of X; let n;
cluster n-placesOf R -> total symmetric transitive for
Relation of n-tuples_on X;
end;

definition
let X,Y be non empty set; let E be Equivalence_Relation of X;
let F be Equivalence_Relation of Y; let R be Relation;
func R quotient (E,F) equals

{[e,f] where e is Element of Class E, f is Element of Class F:
ex x, y being set st x in e & y in f & [x,y] in R};
end;

definition
let X,Y be non empty set; let E be Equivalence_Relation of X;
let F be Equivalence_Relation of Y; let R be Relation;
redefine func R quotient (E,F) -> Relation of Class E, Class F;
end;

definition 
let E be Relation; let F be Relation; let f be Function;
attr f is (E,F)-respecting means

for x1,x2 being set holds
([x1,x2] in E) implies [f.x1, f.x2] in F; 
end;

definition
let S,U; let s be ofAtomicFormula Element of S;
let E be Relation of U; let f be Interpreter of s,U;
attr f is E-respecting means

f is ((abs(ar(s)))-placesOf E, E)-respecting if s is not relational
otherwise f is ((abs(ar(s)))-placesOf E, id BOOLEAN)-respecting;
end;

registration
let X,Y be non empty set; let E be Equivalence_Relation of X;
let F be Equivalence_Relation of Y;
cluster (E,F)-respecting for Function of X,Y;
end;

registration
let S,U; let s be ofAtomicFormula Element of S;
let E be Equivalence_Relation of U;
cluster E-respecting for Interpreter of s,U;
end;

registration
let X,Y be non empty set; let E be Equivalence_Relation of X;
let F be Equivalence_Relation of Y;
cluster (E,F)-respecting for Function;
end;

definition
let X be non empty set; let E be Equivalence_Relation of X; let n;
redefine func n-placesOf E -> Equivalence_Relation of n-tuples_on X;
end;

definition
let X be non empty set, x be Element of SmallestPartition X;
func DeTrivial(x) -> Element of X means

x={it};
end;

definition
let X be non empty set;
func peeler(X) -> Function of {_{X}_},X means

for x being Element of {_{X}_} holds it.x=DeTrivial(x);
end;

registration
let X be non empty set, EqR be Equivalence_Relation of X;
cluster -> non empty for Element of Class EqR;
end;

registration
let X,Y be non empty set; let E be Equivalence_Relation of X;
let F be Equivalence_Relation of Y; let f be (E,F)-respecting Function;
cluster f quotient (E,F) -> Function-like for Relation;
end;

registration
let X,Y be non empty set; let E be Equivalence_Relation of X;
let F be Equivalence_Relation of Y; let R be total Relation of X,Y;
cluster R quotient (E,F) -> total for Relation of Class E, Class F;
end;

definition
let X,Y be non empty set; let E be Equivalence_Relation of X;
let F be Equivalence_Relation of Y;
let f be (E,F)-respecting Function of X,Y;
redefine func f quotient (E,F) -> Function of Class E, Class F;
end;

definition
let X be non empty set, E be Equivalence_Relation of X;
func E-class -> Function of X,Class E means

for x being Element of X holds it.x=EqClass(E,x);
end;

registration
let X be non empty set, E be Equivalence_Relation of X;
cluster E-class -> onto for Function of X, Class E;
end;

registration
let X,Y be non empty set;
cluster onto for Relation of X,Y;
end;

registration
let Y be non empty set;
cluster onto for Y-valued Relation;
end;

registration
let Y be non empty set, R be Y-valued Relation;
cluster R~ -> Y-defined for Relation;
end;

registration
let Y be non empty set, R be onto Y-valued Relation;
cluster R~ -> total for Y-defined Relation;
end;

registration
let X,Y be non empty set, R be onto Relation of X,Y;
cluster R~ -> total for Relation of Y,X;
end;

registration
let Y be non empty set; let R be onto Y-valued Relation;
cluster R~ -> total for Y-defined Relation;
end;

definition
let U,n; let E be Equivalence_Relation of U;
func n-tuple2Class E
-> Relation of n-tuples_on (Class E), Class (n-placesOf E) equals

n-placesOf ((E-class qua Relation of U, Class E)~)*((n-placesOf E)-class);
end;

registration
let U,n; let E be Equivalence_Relation of U;
cluster n-tuple2Class E -> Function-like
for Relation of n-tuples_on (Class E), Class (n-placesOf E);
end;

registration
let U,n; let E be Equivalence_Relation of U;
cluster n-tuple2Class E -> total for Relation of n-tuples_on (Class E),
Class (n-placesOf E);
end;

definition
let U,n; let E be Equivalence_Relation of U;
redefine func n-tuple2Class E ->
Function of n-tuples_on (Class E), Class (n-placesOf E);
end;

definition
let S,U; let s be ofAtomicFormula Element of S;
let E be Equivalence_Relation of U; let f be Interpreter of s,U;
func f quotient E equals

 ((abs(ar(s)))-tuple2Class E) *
(f quotient ((abs(ar(s)))-placesOf E,E))
if not s is relational otherwise
((abs(ar(s)))-tuple2Class E) *
(f quotient ((abs(ar(s)))-placesOf E, id BOOLEAN))*(peeler(BOOLEAN));
end;

definition
let S,U; let s be ofAtomicFormula Element of S; let E be
Equivalence_Relation of U; let f be E-respecting Interpreter of s,U;
redefine func f quotient E -> Interpreter of s,Class E;
end;

theorem 
for X being non empty set, E being Equivalence_Relation of X,
C1, C2 being Element of Class E st C1 meets C2 holds C1=C2;

registration let S;
cluster -> own for Element of (OwnSymbolsOf S);
cluster -> ofAtomicFormula for Element of (OwnSymbolsOf S);
end;

registration
let S, U; let o be non relational ofAtomicFormula Element of S;
let E be Relation of U;
cluster E-respecting ->
((abs(ar(o)))-placesOf E, E)-respecting for Interpreter of o, U;
end;

registration
let S, U; let r be relational Element of S; let E be Relation of U;
cluster E-respecting ->
((abs(ar(r)))-placesOf E, id BOOLEAN)-respecting for Interpreter of r, U;
end;

registration
let n; let U1, U2 be non empty set;
let f be Function-like (Relation of U1, U2);
cluster n-placesOf f -> Function-like for Relation;
end;

registration
let U1, U2; let n be zero Nat, R be Relation of U1, U2;
cluster (n-placesOf R) \+\ (id {{}}) -> empty;
end;

registration


let X; let Y be functional set;
cluster X/\Y -> functional;
end;

theorem 
for V being Element of (AllTermsOf S)* ex mm being 
Element of NAT st V is Element of (S-termsOfMaxDepth.mm)*;

definition
let S,U; let E be Equivalence_Relation of U;
let I be (S,U)-interpreter-like Function;
attr I is E-respecting means

for s being
own Element of S holds (I.s) qua Interpreter of s,U is E-respecting;
end;

definition
let S,U; let E be Equivalence_Relation of U;
let I be (S,U)-interpreter-like Function;
func I quotient E -> Function means

dom it=OwnSymbolsOf S & for o being Element of OwnSymbolsOf S holds
it.o = (I.o) quotient E;
end;

definition
let S,U; let E be Equivalence_Relation of U;
let I be (S,U)-interpreter-like Function;
redefine func I quotient E means

dom it=OwnSymbolsOf S & for o being own Element of S holds
it.o = (I.o) quotient E;
end;

registration
let S,U; let I be (S,U)-interpreter-like Function;
let E be Equivalence_Relation of U;
cluster I quotient E -> (OwnSymbolsOf S)-defined;
end;

registration
let S,U; let E be Equivalence_Relation of U;
cluster E-respecting for (Element of U-InterpretersOf S);
end;

registration
let S,U; let E be Equivalence_Relation of U;
cluster E-respecting for (S,U)-interpreter-like Function;
end;

registration
let S,U; let E be Equivalence_Relation of U; let o be own Element of S;
let I be E-respecting (S,U)-interpreter-like Function;
cluster I.o -> E-respecting for Interpreter of o,U;
end;

registration
let S,U; let E be Equivalence_Relation of U;
let I be E-respecting (S,U)-interpreter-like Function;
cluster I quotient E -> (S,Class E)-interpreter-like for Function;
end;

definition
let S,U;let E be Equivalence_Relation of U;
let I be E-respecting (S,U)-interpreter-like Function;
redefine func I quotient E ->
Element of (Class E)-InterpretersOf S;
end;

theorem 
for E being Equivalence_Relation of U,
I being E-respecting (S,U)-interpreter-like Function holds
(I quotient E)-TermEval=(E-class)*(I-TermEval);

theorem 
(S,X)-freeInterpreter-TermEval=id(AllTermsOf S); 

theorem 
for R being Equivalence_Relation of U1, phi being 0wff
string of S, i being R-respecting (S,U1)-interpreter-like Function st
S-firstChar.phi <> TheEqSymbOf S holds
(i quotient R)-AtomicEval phi = i-AtomicEval phi;

definition let S, x, s, w;
redefine func (x,s)-SymbolSubstIn w -> string of S;
end;

registration
let S,l1,l2,m; let t be m-termal string of S;
cluster (l1, l2)-SymbolSubstIn t -> m-termal for string of S;
end;

registration let S, t, l1, l2;
cluster (l1,l2)-SymbolSubstIn t -> termal for string of S;
end;

registration let S, l1, l2; let phi be 0wff string of S;
cluster (l1,l2)-SymbolSubstIn phi -> 0wff for string of S;
end;

registration
let S; let m0 be zero number; let phi be m0-wff string of S;
cluster Depth phi -> zero for number;
end;

definition let S,m,w;
redefine func w null m -> string of S;
end;

registration let S, phi, m;
cluster phi null m -> ((Depth phi) + m)-wff for string of S;
end;

registration
let S,m; let phi be m-wff string of S;
cluster m - (Depth phi) -> non negative for ext-real number;
end;

registration
let S,l1,l2,m; let phi be m-wff string of S;
cluster (l1,l2)-SymbolSubstIn phi -> m-wff for string of S;
end;

registration
let S,l1,l2,phi;
cluster (l1, l2)-SymbolSubstIn phi -> wff for string of S;
end;

registration
let S, l1, l2, phi;
cluster Depth (l1,l2)-SymbolSubstIn phi \+\ Depth phi -> empty for set;
end;

theorem 
for T being abs(ar(a))-element Element of (AllTermsOf S)* holds
(a is not relational implies (X-freeInterpreter(a)).T = a-compound T) &
(a is relational implies
(X-freeInterpreter(a)).T = (chi(X,AtomicFormulasOf S)).(a-compound T));

registration
let S be Language;
cluster termal for string of S;
cluster 0wff for string of S;
end;

theorem 
((I-TermEval)*
((((l,tt0) ReassignIn ((S,X)-freeInterpreter),tt0)-TermEval).n))|
(S-termsOfMaxDepth.n)=
((((l,I-TermEval.tt0) ReassignIn I,I-TermEval.tt0)-TermEval).n)|
(S-termsOfMaxDepth.n);

definition
let S,l,tt,phi0;
func (l,tt) AtomicSubst phi0 -> FinSequence equals

<*S-firstChar.phi0*>^(S-multiCat.
(((l,tt) ReassignIn (S,{})-freeInterpreter)-TermEval*(SubTerms phi0)));
end;

definition
let S,l,tt,phi0;
redefine func (l,tt) AtomicSubst phi0 -> string of S;
end;

registration
let S,l,tt,phi0;
cluster (l,tt) AtomicSubst phi0 -> 0wff for (string of S);
end;

theorem 
I-AtomicEval ((l,tt) AtomicSubst phi0) =
((l,I-TermEval.tt) ReassignIn I)-AtomicEval phi0;

registration
let S, l1, l2, m;
cluster (l1 SubstWith l2)|(S-termsOfMaxDepth.m) ->
(S-termsOfMaxDepth.m)-valued for Relation;
end;

registration
let S, l1, l2;
cluster (l1 SubstWith l2)|(AllTermsOf S) -> (AllTermsOf S)-valued for Relation;
end;

theorem 
(not l2 in rng psi) implies for I being Element of
U-InterpretersOf S holds (l1,u1) ReassignIn I-TruthEval psi=
(l2,u1) ReassignIn I-TruthEval (l1,l2)-SymbolSubstIn psi;

definition
let S; let l, t, n; let f be FinSequence-yielding Function; let phi;
func (l,t,n,f) Subst2 phi -> FinSequence equals

<*TheNorSymbOf S*>^(f.(head phi))^(f.(tail phi))
if Depth phi=n+1 & not phi is exal,
<* the Element of (LettersOf S\(rng t \/ (rng head phi)\/{l}))*>^(f.(
((S-firstChar.phi, the Element of
(LettersOf S\(rng t\/(rng head phi)\/{l})))-SymbolSubstIn (head phi))))
if Depth phi=n+1 & phi is exal & S-firstChar.phi<>l
otherwise f.phi;
end;

registration let S;
cluster -> FinSequence-yielding
for (Element of Funcs(AllFormulasOf S, AllFormulasOf S));
end;

definition
let S; let l, t, n;
let f be Element of Funcs(AllFormulasOf S, AllFormulasOf S); let phi;
redefine func (l,t,n,f) Subst2 phi -> wff string of S;
end;

registration
let S; let l, t, n;
let f be Element of Funcs(AllFormulasOf S, AllFormulasOf S); let phi;
cluster (l,t,n,f) Subst2 phi -> wff for string of S;
end;

definition
let S; let l, t, nn;
let f be Element of Funcs(AllFormulasOf S, AllFormulasOf S); let phi;
redefine func (l,t,nn,f) Subst2 phi -> Element of (AllFormulasOf S);
end;

definition
let S,l,t,n; let f be Element of Funcs(AllFormulasOf S, AllFormulasOf S);
func (l,t,n,f) Subst3 -> Element of Funcs (AllFormulasOf S, AllFormulasOf S)
means

for phi holds it.phi=(l,t,n,f) Subst2 phi;
end;

definition
let S,l,t; let f be Element of Funcs(AllFormulasOf S, AllFormulasOf S);
func (l,t) Subst4 f ->
Function of NAT, Funcs(AllFormulasOf S, AllFormulasOf S) means

it.0=f & for m holds it.(m+1)=(l,t,m,it.m) Subst3;
end;

definition 
let S,l,t;

func l AtomicSubst t -> Function of AtomicFormulasOf S, AtomicFormulasOf S
means

for phi0, tt st tt=t holds it.phi0=(l,tt) AtomicSubst phi0;
end;

definition let S,l,t;
func l Subst1 t -> Function equals

id (AllFormulasOf S) +* (l AtomicSubst t);
end;

definition
let S,l,t;
redefine func l Subst1 t -> Element of
Funcs(AllFormulasOf S, (AllSymbolsOf S)*);
end;

definition let S,l,t;
redefine func l Subst1 t ->
  Element of Funcs(AllFormulasOf S, AllFormulasOf S);
end;

definition
let S,l,t,phi;
func (l,t) SubstIn phi -> wff string of S equals

((l,t) Subst4 (l Subst1 t)).(Depth phi).phi;
end;

registration let S,l,t, phi;
cluster (l,t) SubstIn phi -> wff for string of S;
end;

registration
let S,l,tt,phi0;
identify (l,tt) SubstIn phi0 with (l,tt) AtomicSubst phi0;
identify (l,tt) AtomicSubst phi0 with (l,tt) SubstIn phi0;
end;

theorem 
Depth (l,tt) SubstIn psi=Depth psi &
for I being Element of U-InterpretersOf S holds
I-TruthEval (l,tt) SubstIn psi=(l,I-TermEval.tt) ReassignIn I-TruthEval psi;

registration
let m,S,l,t; let phi be m-wff string of S;
cluster (l,t) SubstIn phi -> m-wff for string of S;
end;

theorem 
for I1 being Element of U-InterpretersOf S1,
I2 being Element of U-InterpretersOf S2 st
I1|X = I2|X & (the adicity of S1)|X = (the adicity of S2)|X holds
I1-TermEval|(X*) = I2-TermEval|(X*);

theorem 
TheNorSymbOf S1 = TheNorSymbOf S2 & 
TheEqSymbOf S1 = TheEqSymbOf S2 &
(the adicity of S1)|(OwnSymbolsOf S1) =
(the adicity of S2)|(OwnSymbolsOf S1) implies
for I1 being Element of U-InterpretersOf S1,
I2 being Element of U-InterpretersOf S2, phi1 being wff string of S1
st I1|(OwnSymbolsOf S1) = I2|(OwnSymbolsOf S1) ex
phi2 being wff string of S2 st
((phi2=phi1 & I2-TruthEval phi2=I1-TruthEval phi1));

theorem 
for I1, I2 being Element of U-InterpretersOf S st
I1|(rng phi/\OwnSymbolsOf S)=I2|(rng phi/\OwnSymbolsOf S) holds
I1-TruthEval phi=I2-TruthEval phi;

theorem 
for I being Element of U-InterpretersOf S st l is X-absent &
X is I-satisfied holds X is (l,u) ReassignIn I-satisfied;

theorem 
for E being Equivalence_Relation of U,
i being E-respecting Element of U-InterpretersOf S holds
(l,E-class.u) ReassignIn (i quotient E) = ((l,u) ReassignIn i) quotient E;














begin

reserve k,m,n for Nat,
        kk,mm,nn for Element of NAT, U for non empty set,
        A,B,X,Y,Z,x,x1,x2,y,z for set, S for Language,
        s, s1, s2 for Element of S, f,g for Function,
        w for string of S, tt,tt1,tt2 for Element of AllTermsOf S,
        psi,psi1,psi2,phi,phi1,phi2 for wff string of S,
        u,u1,u2 for Element of U,
        Phi,Phi1,Phi2 for Subset of AllFormulasOf S,
        t,t1,t2 for termal string of S,
r for relational Element of S, a for ofAtomicFormula Element of S,
l, l1, l2 for literal Element of S, p for FinSequence,
m1, n1 for non zero Nat, S1, S2 for Language;



definition let S be Language;
func S-sequents equals

{[premises,conclusion] where premises is Subset of (AllFormulasOf S),
conclusion is wff string of S: premises is finite};
end;

registration let S be Language;
cluster S-sequents -> non empty;
end;

registration let S;
cluster S-sequents -> Relation-like;
end;

definition
let S be Language;
let x be set;
attr x is S-sequent-like means

x in S-sequents;
end;

definition 
let S,X;
attr X is S-sequents-like means

X c= S-sequents;
end;

registration let S;
cluster -> S-sequents-like for Subset of S-sequents;
cluster -> S-sequent-like for Element of S-sequents;
end;

registration
let S be Language;
cluster S-sequent-like for Element of S-sequents;
cluster S-sequents-like for Subset of S-sequents;
end;

registration let S;
cluster S-sequent-like for set;
cluster S-sequents-like for set;
end;

definition let S be Language;
mode Rule of S is Element of Funcs (bool (S-sequents), bool (S-sequents));
end;

definition let S be Language;
mode RuleSet of S is Subset of Funcs (bool (S-sequents), bool (S-sequents));
end;

reserve D,D1,D2,D3 for RuleSet of S, R for Rule of S,
Seqts,Seqts1,Seqts2 for Subset of S-sequents,
seqt,seqt1,seqt2 for Element of S-sequents,
SQ,SQ1,SQ2 for S-sequents-like set, Sq,Sq1,Sq2 for S-sequent-like set;

registration
let A,B;
let X be Subset of Funcs(A,B);
cluster union X -> Relation-like;
end;

registration
let S be Language; let D be RuleSet of S;
cluster union D -> Relation-like;
end;

definition
let S,D;
func OneStep(D) -> Rule of S means

for Seqs being Element of bool (S-sequents) holds
it.Seqs = union ((union D) .: {Seqs});
end;

definition let S,D,m;
func (m,D)-derivables -> Rule of S equals

iter(OneStep D,m);
end;

definition
let S be Language;
let D be RuleSet of S;
let Seqs1,Seqs2 be set;
attr Seqs2 is (Seqs1,D)-derivable means

Seqs2 c= union (((OneStep D) [*]) .: {Seqs1});
end;

definition 
let m,S,D; let Seqts,seqt be set;
attr seqt is (m,Seqts,D)-derivable means

seqt in (m,D)-derivables.Seqts;
end;

definition let S,D;
func D-iterators -> Subset-Family of [:bool (S-sequents), bool (S-sequents):]
equals

{iter(OneStep D,mm):not contradiction};
end;

definition let S,R;
attr R is isotone means

Seqts1 c= Seqts2 implies R.Seqts1 c= R.Seqts2;
end;

registration let S;
cluster isotone for Rule of S;
end;

definition let S,D;
attr D is isotone means

for Seqts1,Seqts2,f st
Seqts1 c= Seqts2 & f in D ex g st (g in D & f.Seqts1 c= g.Seqts2);
end;

registration let S; let M be isotone Rule of S;
cluster {M} -> isotone for RuleSet of S;
end;

registration let S;
cluster isotone for RuleSet of S;
end;

reserve M,K,K1,K2 for isotone RuleSet of S;

definition
let S be Language;
let D be RuleSet of S;
let Seqts be set;
attr Seqts is D-derivable means

Seqts is ({},D)-derivable;
end;

registration
let S,D;
cluster D-derivable -> ({},D)-derivable for set;
cluster ({},D)-derivable -> D-derivable for set;
end;

registration
let S,D; let Seqts be empty set;
cluster (Seqts,D)-derivable -> D-derivable for set;
end;

definition let S,D,X; let phi be set;
attr phi is (X,D)-provable means

{[X,phi]} is D-derivable or ex seqt being set
st (seqt`1 c= X & seqt`2 = phi & {seqt} is D-derivable);
end;

definition let S,D,X,x;
redefine attr x is (X,D)-provable means

ex seqt being set st (seqt`1 c= X & seqt`2 = x & {seqt} is D-derivable);
end;

definition let S,D,R;
attr R is D-macro means

for Seqs being Subset of S-sequents
holds R.Seqs is (Seqs,D)-derivable;
end;

definition let S,D; let Phi be set;
func (Phi,D)-termEq equals

{ [t1, t2] where t1,t2 is termal string of S:
<* TheEqSymbOf S *> ^ t1 ^ t2 is (Phi,D)-provable};
end;

definition
let S,D; let Phi be set; 
attr Phi is D-expanded means


x is (Phi,D)-provable implies {x} c= Phi;
end;

definition
let S,x; 
attr x is S-null means

not contradiction;
end;






definition
let S,D; let Phi be set;
redefine func (Phi,D)-termEq -> Relation of (AllTermsOf S);
end;

registration
let S,phi;
let Phi1,Phi2 be finite Subset of (AllFormulasOf S);
cluster [Phi1 \/ Phi2, phi] -> S-sequent-like;
end;

definition
let S;
let x be empty set;
let phi be wff string of S;
redefine func [ x, phi ] -> Element of S-sequents;
end;

registration let S;
cluster {} /\ S -> S-sequents-like for set;
end;

registration let S;
cluster S-null for set;
end;

registration let S;
cluster S-sequent-like -> S-null for set;
end;

registration
let S;
cluster -> S-null for Element of S-sequents;

end;

registration
let m,S,D,X;
cluster (m,D)-derivables.X -> S-sequents-like;
end;

registration let S,Y; let X be S-sequents-like set;
cluster X/\Y -> S-sequents-like for set;
end;

registration
let S,D,m,X;
cluster (m,X,D)-derivable -> S-sequent-like for set;
end;

registration
let S,D;
let Phi1, Phi2 be set;
cluster (Phi1\Phi2,D)-provable -> (Phi1,D)-provable for set;
end;

registration
let S,D;
let Phi1, Phi2 be set;
cluster (Phi1\Phi2,D)-provable -> (Phi1\/Phi2,D)-provable for set;
end;

registration
let S,D; let Phi1,Phi2 be set;
cluster (Phi1/\Phi2,D)-provable -> (Phi1,D)-provable for set;
end;

registration
let S,D; let X be set, x be Subset of X;
cluster (x,D)-provable -> (X,D)-provable for set;
end;

registration
let S; let premises be finite Subset of (AllFormulasOf S);
let phi be wff string of S;
cluster [premises,phi] -> S-sequent-like for set;
end;

registration
let S; let phi1,phi2 be wff string of S;
cluster [{phi1},phi2] -> S-sequent-like for set;
let phi3 be wff string of S;
cluster [{phi1,phi2},phi3] -> S-sequent-like for set;
end;

registration
let S, phi1, phi2; let Phi be finite Subset of AllFormulasOf S;
cluster [Phi\/{phi1}, phi2] -> S-sequent-like for set;
end;

registration
let S,D;
cluster D-expanded for (Subset of AllFormulasOf S);
end;

registration
let S,D;
cluster D-expanded for set;
end;



definition
let Seqts be set; let S be Language; let seqt be S-null set;

pred seqt Rule0 Seqts means

seqt`2 in seqt`1; 

pred seqt Rule1 Seqts means

ex y being set st y in Seqts &
y`1 c= seqt`1 & seqt`2 = y`2;

pred seqt Rule2 Seqts means

seqt`1 is empty &
ex t being termal string of S st seqt`2 = <* TheEqSymbOf S *> ^ t ^ t;

pred seqt Rule3a Seqts means

ex t,t1,t2 being termal string of S, x being set st
(x in Seqts & seqt`1 = x`1 \/ { <* TheEqSymbOf S *> ^ t1 ^ t2 } &
x`2 = <* TheEqSymbOf S *> ^ t ^ t1 & seqt`2 = <* TheEqSymbOf S *> ^ t ^ t2);

pred seqt Rule3b Seqts means

ex t1,t2 being termal string of S st seqt`1 = {<*TheEqSymbOf S*>^t1^t2} &
seqt`2 = <*TheEqSymbOf S*>^t2^t1;

pred seqt Rule3d Seqts means

ex s being low-compounding Element of S,
T,U being (abs(ar(s)))-element Element of (AllTermsOf S)* st
(s is operational & seqt`1=
{<*TheEqSymbOf S*>^(TT.j)^(UU.j) where j is Element of Seg abs(ar(s)),
TT,UU is Function of Seg abs(ar(s)), (AllSymbolsOf S)*\{{}} : TT=T & UU=U}
& seqt`2=<*TheEqSymbOf S*>^(s-compound(T))^(s-compound(U)));

pred seqt Rule3e Seqts means

ex s being relational Element of S,
T,U being (abs(ar(s)))-element Element of (AllTermsOf S)* st
(seqt`1={s-compound(T)} \/
{<*TheEqSymbOf S*>^(TT.j)^(UU.j) where j is Element of Seg abs(ar(s)),
TT,UU is Function of Seg abs(ar(s)), (AllSymbolsOf S)*\{{}} : TT=T & UU=U}
& seqt`2=s-compound(U));

pred seqt Rule4 Seqts means

ex l being literal Element of S, phi being wff string of S, t being
termal string of S st seqt`1={(l,t) SubstIn phi} & seqt`2=<*l*>^phi;

pred seqt Rule5 Seqts means

ex v1,v2 being
literal Element of S, x,p st
seqt`1=x \/ {<*v1*>^p} & v2 is (x\/{p}\/{seqt`2})-absent &
[x\/{(v1 SubstWith v2).p},seqt`2] in Seqts;

pred seqt Rule6 Seqts means

ex y1,y2 being set,phi1, phi2 being wff string of S st y1 in Seqts &
y2 in Seqts & y1`1 = y2`1 & y2`1=seqt`1 &
y1`2= <*TheNorSymbOf S*> ^ phi1 ^ phi1 &
y2`2=  <*TheNorSymbOf S*> ^ phi2 ^ phi2 &
seqt`2 = <*TheNorSymbOf S*> ^ phi1 ^ phi2;

pred seqt Rule7 Seqts means

ex y being set, phi1, phi2 being wff string of S st y in Seqts &
y`1 = seqt`1 & y`2 =<* TheNorSymbOf S*> ^ phi1 ^ phi2 &
seqt`2 = <* TheNorSymbOf S*> ^ phi2 ^ phi1;

pred seqt Rule8 Seqts means

ex y1,y2 being set, phi,phi1,phi2 being wff string of S st y1 in Seqts &
y2 in Seqts & y1`1=y2`1 & y1`2=phi1 &
y2`2 = <* TheNorSymbOf S *> ^ phi1 ^ phi2 &
{phi}\/seqt`1=y1`1 & seqt`2= <* TheNorSymbOf S *> ^ phi ^ phi;

pred seqt Rule9 Seqts means

ex y being set, phi being wff string of S st
y in Seqts & seqt`2=phi & y`1=seqt`1 & y`2=xnot (xnot phi);
end;

definition
let S be Language;
func P#0(S) -> Relation of bool (S-sequents), S-sequents means

for Seqts being Element of bool (S-sequents), seqt being
Element of (S-sequents) holds [ Seqts, seqt ] in it iff seqt Rule0 Seqts;

func P#1(S) -> Relation of bool (S-sequents), S-sequents means

for Seqts being Element of bool (S-sequents), seqt being
Element of (S-sequents) holds [ Seqts, seqt ] in it iff seqt Rule1 Seqts;

func P#2(S) -> Relation of bool (S-sequents), S-sequents means

for Seqts being Element of bool (S-sequents), seqt being
Element of (S-sequents) holds [ Seqts, seqt ] in it iff seqt Rule2 Seqts;

func P#3a(S) -> Relation of bool (S-sequents), S-sequents means

for Seqts being Element of bool (S-sequents), seqt being
Element of (S-sequents) holds [ Seqts, seqt ] in it iff seqt Rule3a Seqts;

func P#3b(S) -> Relation of bool (S-sequents), S-sequents means

for Seqts being Element of bool (S-sequents), seqt being
Element of (S-sequents) holds [ Seqts, seqt ] in it iff seqt Rule3b Seqts;

func P#3d(S) -> Relation of bool (S-sequents), S-sequents means

for Seqts being Element of bool (S-sequents), seqt being 
Element of (S-sequents) holds [ Seqts, seqt ] in it iff seqt Rule3d Seqts;

func P#3e(S) -> Relation of bool (S-sequents), S-sequents means

for Seqts being Element of bool (S-sequents), seqt being
Element of (S-sequents) holds [ Seqts, seqt ] in it iff seqt Rule3e Seqts;

func P#4(S) -> Relation of bool (S-sequents), S-sequents means

for Seqts being Element of bool (S-sequents), seqt being
Element of (S-sequents) holds [ Seqts, seqt ] in it iff seqt Rule4 Seqts;

func P#5(S) -> Relation of bool (S-sequents), S-sequents means

for Seqts being Element of bool (S-sequents), seqt being
Element of (S-sequents) holds [ Seqts, seqt ] in it iff seqt Rule5 Seqts;

func P#6(S) -> Relation of bool (S-sequents), S-sequents means

for Seqts being Element of bool (S-sequents), seqt being 
Element of (S-sequents) holds [ Seqts, seqt ] in it iff seqt Rule6 Seqts;

func P#7(S) -> Relation of bool (S-sequents), S-sequents means

for Seqts being Element of bool (S-sequents), seqt being
Element of (S-sequents) holds [ Seqts, seqt ] in it iff seqt Rule7 Seqts;

func P#8(S) -> Relation of bool (S-sequents), S-sequents means

for Seqts being Element of bool (S-sequents), seqt being
Element of (S-sequents) holds [ Seqts, seqt ] in it iff seqt Rule8 Seqts;

func P#9(S) -> Relation of bool (S-sequents), S-sequents means

for Seqts being Element of bool (S-sequents), seqt being
Element of (S-sequents) holds [ Seqts, seqt ] in it iff seqt Rule9 Seqts;
end;

definition
let S;
let R be Relation of bool (S-sequents), S-sequents;
func FuncRule(R) -> Rule of S means

for inseqs being set st inseqs in bool (S-sequents) holds it.inseqs =
{ x where x is Element of S-sequents : [inseqs, x] in R};
end;

definition let S;
func R#0(S) -> Rule of S equals

FuncRule(P#0(S));
func R#1(S) -> Rule of S equals

FuncRule(P#1(S));
func R#2(S) -> Rule of S equals

FuncRule(P#2(S));
func R#3a(S) -> Rule of S equals

FuncRule(P#3a(S));
func R#3b(S) -> Rule of S equals

FuncRule(P#3b(S));
func R#3d(S) -> Rule of S equals

FuncRule(P#3d(S));
func R#3e(S) -> Rule of S equals

FuncRule(P#3e(S));
func R#4(S) -> Rule of S equals

FuncRule(P#4(S));
func R#5(S) -> Rule of S equals

FuncRule(P#5(S));
func R#6(S) -> Rule of S equals

FuncRule(P#6(S));
func R#7(S) -> Rule of S equals

FuncRule(P#7(S));
func R#8(S) -> Rule of S equals

FuncRule(P#8(S));
func R#9(S) -> Rule of S equals

FuncRule(P#9(S));
end;

registration
let S; let t be termal string of S;
cluster {[{},<*TheEqSymbOf S*>^t^t]} -> {R#2(S)}-derivable for set;
end;

registration
let S;
cluster R#2(S) -> isotone for Rule of S;
end;

registration
let S;
cluster R#3b(S) -> isotone for Rule of S;
end;

registration
let S; let t,t1,t2 be termal string of S;
let premises be finite (Subset of AllFormulasOf S);
cluster [premises\/{<*TheEqSymbOf S*>^t1^t2},<*TheEqSymbOf S*>^t^t2]
-> (1,{[premises,<*TheEqSymbOf S*>^t^t1]},{R#3a(S)})-derivable for set;
end;

registration
let S; let t,t1,t2 be termal string of S, phi be wff string of S;
cluster [{phi,<*TheEqSymbOf S*>^t1^t2},<*TheEqSymbOf S*>^t^t2]
-> (1,{[{phi},<*TheEqSymbOf S*>^t^t1]},{R#3a(S)})-derivable for set;
end;

registration
let S; let phi be wff string of S, Phi be finite Subset of AllFormulasOf S;
cluster [Phi \/ {phi}, phi] -> (1,{},{R#0(S)})-derivable for set;
end;

registration
let S; let phi1,phi2 be wff string of S;
cluster [{phi1,phi2},phi1] -> (1,{},{R#0(S)})-derivable for set;
end;

registration
let S,phi;
cluster [{phi},phi] -> (1,{},{R#0(S)})-derivable for set;
end;

registration
let S; let phi be wff string of S;
cluster {[{phi}, phi]} -> ({},{R#0(S)})-derivable for set;
end;

registration
let S;
cluster R#0(S) -> isotone for Rule of S;
cluster R#3a(S) -> isotone for Rule of S;
cluster R#3d(S) -> isotone for Rule of S;
cluster R#3e(S) -> isotone for Rule of S;
let K1,K2;
cluster K1\/K2 -> isotone for RuleSet of S;
end;

registration
let S; let t1,t2 be termal string of S;
cluster <*TheEqSymbOf S*>^t1^t2 -> 0-wff for string of S;
end;

definition
let S; let m be non zero Nat;
let T,U be m-element (Element of ((AllTermsOf S)*));
func PairWiseEq (T,U) equals

{<*TheEqSymbOf S*>^(TT.j)^(UU.j) where j is Element of Seg m,
TT,UU is Function of Seg m, (AllSymbolsOf S)*\{{}} : TT=T & UU=U};
end;

definition
let S; let m be non zero Nat, T1,T2 be m-element Element of ((AllTermsOf S)*);
redefine func PairWiseEq (T1,T2) -> Subset of AllFormulasOf S;
end;

registration
let S; let m be non zero Nat;
let T,U be m-element (Element of ((AllTermsOf S)*));
cluster PairWiseEq(T,U) -> finite;
end;

registration
let S; let s be relational Element of S;
let T1,T2 be abs(ar(s))-element Element of (AllTermsOf S)*;
cluster {[PairWiseEq(T1,T2)\/{s-compound(T1)},s-compound(T2)]} ->
({},{R#3e(S)})-derivable;
end;

definition
let m,S,D;
attr D is m-ranked means

R#0(S) in D & R#2(S) in D & R#3a(S) in D & R#3b(S) in D if m=0,
R#0(S) in D & R#2(S) in D & R#3a(S) in D & R#3b(S) in D
& R#3d(S) in D & R#3e(S) in D if m=1,
R#0(S) in D & R#1(S) in D & R#2(S) in D & R#3a(S) in D & R#3b(S) in D
& R#3d(S) in D & R#3e(S) in D & R#4(S) in D & R#5(S) in D & R#6(S) in D &
R#7(S) in D & R#8(S) in D if m=2 otherwise D={};
end;

registration
let S;
cluster 1-ranked -> 0-ranked for RuleSet of S;
cluster 2-ranked -> 1-ranked for RuleSet of S;
end;

definition
let S;
func S-rules -> RuleSet of S equals

{R#0(S), R#1(S), R#2(S), R#3a(S), R#3b(S), R#3d(S), R#3e(S), R#4(S)} \/
{R#5(S), R#6(S), R#7(S), R#8(S)};
end;

registration let S;
cluster S-rules -> 2-ranked for RuleSet of S;
end;

registration let S;
cluster 2-ranked for RuleSet of S;
end;

registration let S;
cluster 1-ranked for RuleSet of S;
end;

registration let S;
cluster 0-ranked for RuleSet of S;
end;

registration
let S; let D be 1-ranked RuleSet of S; let X be D-expanded set; let a;
cluster X-freeInterpreter(a) -> ((X,D)-termEq)-respecting for Interpreter of a
,AllTermsOf S;
end;

registration
let S; let D be 0-ranked RuleSet of S; let X be D-expanded set;
cluster ((X,D)-termEq) ->
total symmetric transitive for Relation of (AllTermsOf S);
end;

registration let S;
cluster 1-ranked for 0-ranked RuleSet of S;
end;

theorem 
D1 c= D2 & (D2 is isotone or D1 is isotone) &
Y is (X,D1)-derivable implies Y is (X,D2)-derivable;

registration let S, Sq;
cluster {Sq} -> S-sequents-like;
end;

registration
let S,SQ1,SQ2;
cluster SQ1\/SQ2 -> S-sequents-like for set;
end;

registration
let S; let x,y be S-sequent-like set;
cluster {x,y} -> S-sequents-like for set;
end;

registration
let S, phi1, phi2;
cluster [{xnot phi1, xnot phi2},<*TheNorSymbOf S*>^phi1^phi2]
-> (1,
{[{xnot phi1,xnot phi2}, xnot phi1], [{xnot phi1, xnot phi2}, xnot phi2]},
{R#6(S)})-derivable for set;
end;

registration
let S,phi1,phi2;
cluster [{phi1,phi2},phi2] -> (1,{},{R#0(S)})-derivable for set;
end;

theorem 
for R being Relation of bool (S-sequents), S-sequents
st [SQ, Sq] in R holds Sq in (FuncRule(R)).SQ;

theorem 
x in R.X implies x is (1,X,{R})-derivable;

definition
let S,D,X;
redefine attr X is D-expanded means

x is (X,D)-provable implies x in X;
end;

theorem 
phi in X implies phi is (X,{R#0(S)})-provable;

theorem 
(D1\/D2 is isotone & D1\/D2\/D3 is isotone &
x is (m,SQ1,D1)-derivable & y is (m,SQ2,D2)-derivable &
z is (n,{x,y},D3)-derivable) implies
z is (m+n,SQ1\/SQ2,D1\/D2\/D3)-derivable; 

theorem 
(D1 is isotone & D1\/D2 is isotone &
y is (m,X,D1)-derivable & z is (n,{y},D2)-derivable) implies
z is (m+n,X,D1\/D2)-derivable;

theorem 
x is (m,X,D)-derivable implies {x} is (X,D)-derivable;

registration let S;
cluster R#6(S) -> isotone for Rule of S;
end;

theorem 
(D1 c= D2 & (D1 is isotone or D2 is isotone) &
x is (X,D1)-provable) implies x is (X,D2)-provable;

theorem 
X c= Y & x is (X,D)-provable implies x is (Y,D)-provable;

registration let S;
cluster R#8(S) -> isotone for Rule of S;
end;

registration
let S;
cluster R#1(S) -> isotone for Rule of S;
end;

theorem 
{y} is (SQ,D)-derivable implies ex mm st y is (mm,SQ,D)-derivable;

registration
let S,D,X;
cluster (X,D)-derivable -> S-sequents-like for set;
end;

definition 
let S,D,X,x;
redefine attr x is (X,D)-provable means

ex H being set, m st H c= X & [H,x] is (m,{},D)-derivable;
end;

theorem 
D1 c= D2 & (D2 is isotone or D1 is isotone) & x is
(m,X,D1)-derivable implies x is (m,X,D2)-derivable;

registration
let S;
cluster R#7(S) -> isotone for Rule of S;
end;

theorem 
x is (X,D)-provable implies x is wff string of S;

reserve D,E,F for (RuleSet of S), D1 for 1-ranked 0-ranked RuleSet of S,
D2 for 2-ranked RuleSet of S;

registration
let S, D1; let X be D1-expanded set;
cluster (S,X)-freeInterpreter -> ((X,D1)-termEq)-respecting
for (S,AllTermsOf S)-interpreter-like Function;
end;

definition
let S; let D be 0-ranked RuleSet of S; let X be D-expanded set;
func D Henkin X -> Function equals

(S,X)-freeInterpreter quotient ((X,D)-termEq);
end;

registration
let S; let D be 0-ranked RuleSet of S; let X be D-expanded set;
cluster D Henkin X -> (OwnSymbolsOf S)-defined;
end;

registration
let S, D1; let X be D1-expanded set;
cluster D1 Henkin X -> (S,Class (X,D1)-termEq)-interpreter-like for Function;
end;

definition
let S, D1; let X be D1-expanded set;
redefine func D1 Henkin X ->
Element of (Class (X,D1)-termEq)-InterpretersOf S;
end;

registration
let S, phi1, phi2;
cluster <*TheNorSymbOf S*>^phi1^phi2 ->
({xnot phi1, xnot phi2},{R#0(S)}\/{R#6(S)})-provable for set;
end;

registration
let S;
cluster -> non empty for 0-ranked RuleSet of S;
end;

definition 
let S,x;
attr x is S-premises-like means

x c= AllFormulasOf S & x is finite;
end;

registration
let S;
cluster S-premises-like -> finite for set;
end;

registration
let S,phi;
cluster {phi} -> S-premises-like for set;
end;

registration
let S; let e be empty set;
cluster e null S -> S-premises-like for set;
end;

registration
let X,S;
cluster S-premises-like for Subset of X;
end;

registration
let S;
cluster S-premises-like for set;
end;

registration
let S; let X be S-premises-like set;
cluster -> S-premises-like for Subset of X;
end;

reserve H,H1,H2,H3 for S-premises-like set;

definition
let S, H2, H1;
redefine func H1 null H2 -> Subset of (AllFormulasOf S);
end;

registration
let S,H,x;
cluster H null x -> S-premises-like;
end;

registration
let S, H1, H2;
cluster H1\/H2 -> S-premises-like for set;
end;

registration
let S,H,phi;
cluster [H,phi] -> S-sequent-like;
end;

registration
let S, H1, H2, phi;
cluster [H1\/H2, phi] -> (1,{[H1,phi]},{R#1(S)})-derivable for set;
end;

registration
let S,H, phi, phi1, phi2;
cluster [H null (phi1^phi2),xnot phi] -> (1,
{[H\/{phi},phi1],[H\/{phi},<*TheNorSymbOf S*>^phi1^phi2]},
{R#8(S)})-derivable for set;
end;

registration
let S;
cluster {} null S -> S-sequents-like for set;
end;

registration
let S,H,phi;
cluster [H\/{phi}, phi] -> (1,{},{R#0(S)})-derivable for set;
end;

registration
let S, H, phi1, phi2;
cluster [H null phi2,xnot phi1] -> (2,
{[H,<*TheNorSymbOf S*>^phi1^phi2]},{R#0(S)}\/{R#1(S)}\/{R#8(S)})-derivable for
set;
end;

registration
let S, H, phi1, phi2;
cluster [H, <*TheNorSymbOf S*>^phi2^phi1] -> (1,
{[H,<*TheNorSymbOf S*>^phi1^phi2]},{R#7(S)})-derivable for set;
end;

registration
let S, H, phi1, phi2;
cluster [H null phi1, xnot phi2] ->
(3,{[H,<*TheNorSymbOf S*>^phi1^phi2]},{R#0(S)}\/{R#1(S)}\/{R#8(S)}\/{R#7(S)})
-derivable for set;
end;

registration
let S,Sq;
cluster Sq`1 -> S-premises-like for set;
end;

definition
let S,X,D;
redefine func D null X -> RuleSet of S;
end;

registration
let S,phi1,phi2,l1,H;
let l2 be (H\/{phi1}\/{phi2})-absent literal Element of S;
cluster [(H\/{<*l1*>^phi1}) null l2, phi2] ->
(1,{[H\/{(l1,l2)-SymbolSubstIn phi1}, phi2]},{R#5(S)})-derivable for set;
end;

definition 
let S,D,X;
attr X is D-inconsistent means

ex phi1,phi2 st
(phi1 is (X,D)-provable & <*TheNorSymbOf S*>^phi1^phi2 is (X,D)-provable);
end;

registration
let m1, S, H1, H2, phi;
cluster [(H1\/H2) null m1, phi] -> (m1,{[H1,phi]},{R#1(S)})-derivable for set;
end;

registration
let S;
cluster non empty for isotone RuleSet of S;
end;

theorem 
(X is D-inconsistent & D is isotone & R#1(S) in D & R#8(S) in D)
implies xnot phi is (X,D)-provable;

registration
let S;
cluster R#5(S) -> isotone for Rule of S;
end;

registration
let S,l,t,phi;
cluster [{(l,t) SubstIn phi}, <*l*>^phi] -> (1,{},{R#4(S)})-derivable for set;
end;

registration
let S;
cluster R#4(S) -> isotone for Rule of S;
end;

definition
let S,X;
attr X is S-witnessed means

for l1, phi1 st <*l1*>^phi1 in X ex l2 st (
(l1,l2)-SymbolSubstIn phi1 in X & not l2 in rng phi1);
end;

theorem 
for X being D1-expanded set st
R#1(S) in D1 & R#4(S) in D1 & R#6(S) in D1 & R#7(S) in D1 &
R#8(S) in D1 & X is S-mincover & X is S-witnessed
holds (D1 Henkin X)-TruthEval psi = 1 iff psi in X;

notation
let S,D,X;
antonym X is D-consistent for X is D-inconsistent;
end;

theorem 
for X being Subset of Y st X is D-inconsistent
holds Y is D-inconsistent;

definition
let S,D; let X be functional set; let phi be Element of ExFormulasOf S;
func (D,phi) AddAsWitnessTo X equals

X\/{
(S-firstChar.phi, the Element of (
LettersOf S \ SymbolsOf (((AllSymbolsOf S)*\{{}})/\(X\/{head phi}))
))-SymbolSubstIn (head phi)
} if X\/{phi} is D-consistent &
LettersOf S \ SymbolsOf (((AllSymbolsOf S)*\{{}})/\(X\/{head phi}))<>{}
otherwise X;
end;

registration
let S,D; let X be functional set; let phi be Element of ExFormulasOf S;
cluster X \ ((D,phi) AddAsWitnessTo X) -> empty for set;
end;

registration
let S,D; let X be functional set; let phi be Element of ExFormulasOf S;
cluster ((D,phi) AddAsWitnessTo X)\X -> trivial for set;
end;

definition
let S,D; let X be functional set; let phi be Element of ExFormulasOf S;
redefine func (D,phi) AddAsWitnessTo X -> Subset of (X\/AllFormulasOf S);
end;

definition 
let S,D;
attr D is Correct means

for phi, X st
phi is (X,D)-provable holds for U for I being Element of U-InterpretersOf S
st X is I-satisfied holds I-TruthEval phi=1;
end;

registration
let S, t1, t2;
cluster SubTerms (<*TheEqSymbOf S*>^t1^t2) \+\ <*t1, t2*> -> empty for set;
end;

definition
let S; let R be Rule of S;
attr R is Correct means

X is S-correct implies R.X is S-correct;
end;

registration
let S;
cluster S-sequent-like -> S-null for set;
end;

registration
let S;
cluster R#0(S) -> Correct for Rule of S;
end;

registration
let S;
cluster Correct for Rule of S;
end;

registration
let S;
cluster R#1(S) -> Correct for Rule of S;
end;

registration let S;
cluster R#2(S) -> Correct for Rule of S;
end;

registration let S;
cluster R#3a(S) -> Correct for Rule of S;
end;

registration let S;
cluster R#3b(S) -> Correct for Rule of S;
end;

registration
let S;
cluster R#3d(S) -> Correct for Rule of S;
end;

registration
let S;
cluster R#3e(S) -> Correct for Rule of S;
end;

registration
let S;
cluster R#4(S) -> Correct for Rule of S;
end;

registration
let S;
cluster R#5(S) -> Correct for Rule of S;
end;

registration let S;
cluster R#6(S) -> Correct for Rule of S;
end;

registration let S;
cluster R#7(S) -> Correct for Rule of S;
end;

registration let S;
cluster R#8(S) -> Correct for Rule of S;
end;

theorem 
(for R being Rule of S st R in D holds R is Correct) implies D is Correct;

registration let S; let R be Correct Rule of S;
cluster {R} -> Correct for RuleSet of S;
end;

registration
let S;
cluster S-rules -> Correct for RuleSet of S;
end;

registration let S;
cluster R#9(S) -> isotone for Rule of S;
end;

registration let S,H,phi;
cluster [H, phi] null 1 -> (1,{[H, xnot (xnot phi)]},{R#9(S)})-derivable for
set;
end;

registration
let X, S;
cluster X-implied for 0-wff string of S;
end;

registration let X, S;
cluster X-implied for wff string of S;
end;

registration let S, X; let phi be X-implied wff string of S;
cluster xnot xnot phi -> X-implied for wff string of S;
end;

definition
let X, S, phi;
attr phi is X-provable means

phi is (X,{R#9(S)}\/S-rules)-provable;
end;

begin


definition
let X be functional set; let S,D;
let num be Function of NAT, ExFormulasOf S;
func (D,num) AddWitnessesTo X -> Function of NAT, bool (X\/AllFormulasOf S)
means

it.0=X & for mm holds it.(mm+1)=(D, num.mm) AddAsWitnessTo (it.mm);
end;

notation
let X be functional set; let S,D;
let num be Function of NAT, ExFormulasOf S;
synonym (D,num) addw X for (D,num) AddWitnessesTo X;
end;

theorem 
for X being functional set,
num being Function of NAT, ExFormulasOf S st
D is isotone & R#1(S) in D & R#8(S) in D & R#2(S) in D & R#5(S) in D &
LettersOf S\SymbolsOf (X/\((AllSymbolsOf S)*\{{}})) is infinite &
X is D-consistent
holds
((D,num) addw X).k c= ((D,num) addw X).(k+m) &
LettersOf S\SymbolsOf (((D,num) addw X).m/\((AllSymbolsOf S)*\{{}}))
is infinite & ((D,num) addw X).m is D-consistent;

definition
let X be functional set; let S,D;
let num be Function of NAT, ExFormulasOf S;
func X WithWitnessesFrom (D,num) -> Subset of (X\/AllFormulasOf S)
equals

union rng (D,num) AddWitnessesTo X;
end;

notation
let X be functional set; let S,D;
let num be Function of NAT, ExFormulasOf S;
synonym X addw (D,num) for X WithWitnessesFrom (D,num);
end;

registration
let X be functional set; let S,D;
let num be Function of NAT, ExFormulasOf S;
cluster X\ (X addw (D,num)) -> empty for set;
end;

theorem 
for X being functional set,
num being Function of NAT, ExFormulasOf S st D is isotone &
R#1(S) in D & R#8(S) in D & R#2(S) in D & R#5(S) in D &
LettersOf S\SymbolsOf (X/\((AllSymbolsOf S)*\{{}})) is infinite &
X addw (D,num) c= Z & Z is D-consistent & rng num = ExFormulasOf S
holds Z is S-witnessed;

begin



definition
let X,S,D; let phi be Element of AllFormulasOf S;
func (D,phi) AddFormulaTo X equals

X\/{phi}
if not xnot phi is (X,D)-provable otherwise X \/ {xnot phi};
end;

definition
let X,S,D; let phi be Element of AllFormulasOf S;
redefine func (D,phi) AddFormulaTo X -> Subset of (X\/AllFormulasOf S);
end;

registration
let X,S,D; let phi be Element of AllFormulasOf S;
cluster X \ ((D,phi) AddFormulaTo X) -> empty;
end;

definition
let X,S,D; let num be Function of NAT, AllFormulasOf S;
func (D,num) AddFormulasTo X -> Function of NAT, bool (X\/AllFormulasOf S)
means

it.0=X & for m holds it.(m+1)=(D,num.m) AddFormulaTo (it.m);
end;

definition
let X,S,D; let num be Function of NAT, AllFormulasOf S;
func (D,num) CompletionOf X -> Subset of (X\/AllFormulasOf S) equals

union rng ((D,num) AddFormulasTo X);
end;

registration
let X,S,D; let num be Function of NAT, AllFormulasOf S;
cluster X\((D,num) CompletionOf X) -> empty for set;
end;

theorem 
for R being Relation of bool (S-sequents), S-sequents holds 
(y in (FuncRule R).X iff (y in S-sequents & [X,y] in R));

reserve D2 for 2-ranked RuleSet of S;

registration
let S; let r1, r2 be isotone Rule of S;
cluster {r1,r2} -> isotone for RuleSet of S;
end;

registration
let S; let r1, r2, r3, r4 be isotone Rule of S;
cluster {r1,r2,r3,r4} -> isotone for RuleSet of S;
end;

registration let S;
cluster S-rules -> isotone for RuleSet of S;
end;

registration let S;
cluster Correct for isotone RuleSet of S;
end;

registration let S;
cluster 2-ranked for Correct isotone RuleSet of S;
end;

registration
let S be countable Language;
cluster AllFormulasOf S -> countable;
end;

theorem 
for S being countable Language, D being RuleSet of S st
D is 2-ranked & D is isotone & D is Correct & Z is D-consistent &
Z c= AllFormulasOf S ex U being non empty set,
I being Element of U-InterpretersOf S st Z is I-satisfied;

reserve C for countable Language, phi for wff string of C;

theorem 
(X c= AllFormulasOf C & phi is X-implied) implies phi is X-provable;















begin

reserve X,Y for set;
reserve G for Group;
reserve n for Nat;

registration
  let X;
  cluster {}(X,{}) -> onto;
end;

registration
  cluster permutational -> functional for set;
end;

definition
  let X;
  func permutations(X) equals

  {f where f is Permutation of X: not contradiction};
end;

theorem 
  for f being set st f in permutations(X) holds f is Permutation of X;

theorem 
  permutations(X) c= Funcs(X,X);

theorem 
  permutations(Seg n) = Permutations(n);

registration
  let X;
  cluster permutations(X) -> non empty functional;
end;

registration
  let X be finite set;
  cluster permutations(X) -> finite;
end;

theorem 
  permutations {} = 1;

definition
  let X;
  func SymGroup(X) -> strict constituted-Functions multMagma means


  the carrier of it = permutations(X) &
  for x,y being Element of it holds x * y = y qua Function * x;
end;

theorem 
  for f being Element of SymGroup(X) holds f is Permutation of X;

registration
  let X;
  cluster SymGroup(X) -> non empty associative Group-like;
end;

theorem 
  1_SymGroup(X) = id X;

theorem 
  for x being Element of SymGroup(X) holds x" = x qua Function";

registration
  let n;
  cluster Group_of_Perm(n) -> constituted-Functions;
end;

theorem 
  SymGroup(Seg n) = Group_of_Perm(n);

registration
  let X be finite set;
  cluster SymGroup(X) -> finite;
end;

theorem 
  SymGroup({}) = Trivial-multMagma;

registration
  cluster SymGroup {} -> trivial;
end;

definition
  let X,Y;
  let p be Function of X,Y such that
 X <> {} & Y <> {} and
 p is bijective;
  func SymGroupsIso(p) -> Function of SymGroup(X),SymGroup(Y) means


  for x being Element of SymGroup(X) holds it.x = p*x*(p");
end;

theorem 
  for X,Y being non empty set
  for p being Function of X,Y st p is bijective holds
  SymGroupsIso(p) is multiplicative;

theorem 
  for X,Y being non empty set
  for p being Function of X,Y st p is bijective holds
  SymGroupsIso(p) is one-to-one;

theorem 
  for X,Y being non empty set
  for p being Function of X,Y st p is bijective holds
  SymGroupsIso(p) is onto;

theorem 
  X,Y are_equipotent implies SymGroup(X),SymGroup(Y) are_isomorphic;

definition
  let G;
  func CayleyIso(G) -> Function of G,SymGroup(the carrier of G) means


  for g being Element of G holds it.g = *g;
end;

registration
  let G;
  cluster CayleyIso(G) -> multiplicative;
end;

registration
  let G;
  cluster CayleyIso(G) -> one-to-one;
end;


theorem 
  G, Image CayleyIso(G) are_isomorphic;














begin 

reserve n,m,i,k for Element of NAT;
reserve x,X,X1 for set;
reserve r,p for Real;
reserve s,x0,x1,x2 for real number;
reserve f,f1,f2 for PartFunc of REAL,REAL n;
reserve h for PartFunc of REAL,REAL-NS n;
reserve W for non empty set;

definition let n,f,x0;
  pred f is_continuous_in x0 means

  ex g be PartFunc of REAL,REAL-NS n st f=g & g is_continuous_in x0;
end;

theorem 
  h = f implies (f is_continuous_in x0 iff h is_continuous_in x0);

theorem 
  x0 in X & f is_continuous_in x0 implies f|X is_continuous_in x0;

theorem 
  f is_continuous_in x0 iff x0 in dom f &
  for r st 0<r ex s st 0<s & for x1 st x1 in dom f & abs(x1-x0)<s
  holds |. f/.x1 - f/.x0 .|<r;

theorem 
 for r be Real, z be Element of REAL n,w be Point of REAL-NS n
  st z=w holds
 {y where y is Element of REAL n: |.y-z.| < r} =
 {y where y is Point of REAL-NS n: ||.y-w.|| < r};

definition
  let n be Element of NAT;
  let Z be set;
  let f be PartFunc of Z,REAL n;
  func |.f.| -> PartFunc of Z,REAL means

  dom it = dom f & for x be set st x in dom it holds it/.x = |. f/.x .|;
end;

definition
  let n be Element of NAT;
  let Z be non empty set;
  let f be PartFunc of Z,REAL n;
  func -f -> PartFunc of Z, REAL n means

  dom it = dom f & for c be set st c in dom it holds it/.c = - (f/.c);
end;

theorem 
  for f1,f2 be PartFunc of W,REAL-NS n,
      g1,g2 be PartFunc of W,REAL n st f1=g1 & f2=g2 holds
    f1+f2 = g1+g2;

theorem 
  for f1 be PartFunc of W,REAL-NS n,
      g1 be PartFunc of W,REAL n,
      a be Real st f1=g1 holds
    a(#)f1 = a(#)g1;

theorem 
  for f1 be PartFunc of W,REAL n holds (-1)(#)f1 = -f1;

theorem 
  for f1 be PartFunc of W,REAL-NS n,
      g1 be PartFunc of W,REAL n st f1=g1 holds
    -f1 = -g1;

theorem 
 for f1 be PartFunc of W,REAL-NS n,
     g1 be PartFunc of W,REAL n st f1=g1 holds
  ||. f1 .|| = |. g1 .|;

theorem 
 for f1,f2 be PartFunc of W,REAL-NS n,
     g1,g2 be PartFunc of W,REAL n st f1=g1 & f2=g2 holds
  f1-f2 = g1-g2;

theorem 
  f is_continuous_in x0 iff
  x0 in dom f & for N1 be Subset of REAL n st ex r be Real st 0 < r &
  {y where y is Element of REAL  n: |.y-f/.x0.| < r} = N1
  ex N being Neighbourhood of x0 st
  for x1 st x1 in dom f & x1 in N holds f/.x1 in N1;

theorem 
  f is_continuous_in x0 iff x0 in dom f &
  for N1 be Subset of REAL n
  st ex r be Real st 0 < r &
  {y where y is Element of REAL n: |.y-f/.x0.| < r} = N1
  ex N being Neighbourhood of x0 st f.:N c= N1;

theorem 
  (ex N be Neighbourhood of x0 st dom f /\ N = {x0}) implies
  f is_continuous_in x0;

theorem 
  x0 in dom f1 /\ dom f2 & f1 is_continuous_in x0 & f2 is_continuous_in x0
    implies f1+f2 is_continuous_in x0;

theorem 
  x0 in dom f1 /\ dom f2 & f1 is_continuous_in x0 & f2 is_continuous_in x0
  implies f1-f2 is_continuous_in x0;

theorem 
  f is_continuous_in x0 implies r(#)f is_continuous_in x0;

theorem 
  x0 in dom f & f is_continuous_in x0 implies
    |. f .| is_continuous_in x0;

theorem 
  x0 in dom f & f is_continuous_in x0 implies
    -f is_continuous_in x0;

theorem 
  for S be RealNormSpace,
      z be Point of REAL-NS n,
      f1 be PartFunc of REAL,REAL n,
      f2 be PartFunc of REAL-NS n,S
     st x0 in dom (f2*f1) & f1 is_continuous_in x0
        & z=f1/.x0 & f2 is_continuous_in z
    holds f2*f1 is_continuous_in x0;

theorem 
  for S be RealNormSpace,
      f1 be PartFunc of REAL,S,
      f2 be PartFunc of S,REAL
     st x0 in dom (f2*f1) & f1 is_continuous_in x0
      & f2 is_continuous_in f1/.x0
    holds f2*f1 is_continuous_in x0;

definition let n;
  let f be PartFunc of REAL n,REAL;
  let x0 be Element of REAL n;
  pred f is_continuous_in x0 means

  ex y0 be Point of REAL-NS n, g be PartFunc of REAL-NS n,REAL st
    x0=y0 & f=g & g is_continuous_in y0;
end;

theorem 
 for f be PartFunc of REAL n,REAL,
     h be PartFunc of REAL-NS n,REAL,
     x0 be Element of REAL n,
     y0 be Point of REAL-NS n
  st f=h & x0=y0 holds
  f is_continuous_in x0 iff h is_continuous_in y0;

theorem 
for f1 be PartFunc of REAL,REAL n,
    f2 be PartFunc of REAL n,REAL st x0 in dom (f2*f1) &
 f1 is_continuous_in x0 & f2 is_continuous_in f1/.x0
 holds f2*f1 is_continuous_in x0;

definition let n,f;
  attr f is continuous means

  for x0 st x0 in dom f holds f is_continuous_in x0;
end;

theorem 
 for g be PartFunc of REAL,REAL-NS n,
     f be PartFunc of REAL,REAL n st g=f holds
  g is continuous iff f is continuous;

theorem 
  X c= dom f implies
  (f|X is continuous iff for x0,r st x0 in X & 0<r
    ex s st 0<s & for x1 st x1 in X & abs(x1-x0) < s
    holds |. f/.x1 - f/.x0 .| < r);

registration let n;
  cluster constant -> continuous for PartFunc of REAL,REAL n;
end;

registration let n;
  cluster continuous for PartFunc of REAL,REAL n;
end;

registration let n;
  let f be continuous PartFunc of REAL,REAL n, X be set;
  cluster f|X -> continuous for PartFunc of REAL,REAL n;
end;

theorem 
  f|X is continuous & X1 c= X implies f|X1 is continuous;

registration let n;
  cluster empty -> continuous for PartFunc of REAL,REAL n;
end;

registration let n,f;
  let X be trivial set;
  cluster f|X -> continuous for PartFunc of REAL,REAL n;
end;

registration let n;
  let f1,f2 be continuous PartFunc of REAL,REAL n;
  cluster f1+f2 -> continuous for PartFunc of REAL,REAL n;
end;

theorem 
  X c= dom f1 /\ dom f2 & f1|X is continuous & f2|X is continuous
  implies (f1+f2) |X is continuous & (f1-f2) |X is continuous;

theorem 
  X c= dom f1 & X1 c= dom f2 & f1|X is continuous & f2|X1 is continuous
  implies (f1+f2) | (X /\ X1) is continuous & (f1-f2) | (X /\ X1) is continuous
;

registration let n;
  let f be continuous PartFunc of REAL,REAL n;
  let r;
  cluster r(#)f -> continuous for PartFunc of REAL,REAL n;
end;

theorem 
  X c= dom f & f|X is continuous implies (r(#)f) | X is continuous;

theorem 
  X c= dom f & f|X is continuous
  implies |. f .| |X is continuous & (-f) | X is continuous;

theorem 
  f is total & (for x1,x2 holds f/.(x1+x2) = f/.x1 + f/.x2) &
  (ex x0 st f is_continuous_in x0) implies f|REAL is continuous;

theorem 
  for Y be Subset of REAL-NS n st
  dom f is compact & f| (dom f) is continuous & Y = rng f
  holds Y is compact;

theorem 
  for Y be Subset of REAL, Z be Subset of REAL-NS n st
  Y c= dom f & Z = f.:Y & Y is compact & f|Y is continuous
  holds Z is compact;

definition let n,f;
  attr f is Lipschitzian means

  ex g be PartFunc of REAL,REAL-NS n st g=f & g is Lipschitzian;
end;

theorem 
  f is Lipschitzian iff
  ex r be real number st 0<r & for x1,x2 st x1 in dom f &
  x2 in dom f holds |.f/.x1-f/.x2.| <= r*abs(x1-x2);

theorem 
  f=h implies (f is Lipschitzian iff h is Lipschitzian);

theorem 
  f|X is Lipschitzian iff ex r be real number
     st 0<r & for x1,x2 st x1 in dom(f|X) &
   x2 in dom(f|X) holds |. f/.x1-f/.x2 .| <= r*abs(x1-x2);

registration let n;
  cluster empty -> Lipschitzian for PartFunc of REAL,REAL n;
end;

registration let n;
  cluster empty for PartFunc of REAL,REAL n;
end;

registration let n;
  let f be Lipschitzian PartFunc of REAL,REAL n, X be set;
  cluster f|X -> Lipschitzian for PartFunc of REAL,REAL n;
end;

theorem 
  f|X is Lipschitzian & X1 c= X implies f|X1 is Lipschitzian;

registration let n;
  let f1,f2 be Lipschitzian PartFunc of REAL,REAL n;
  cluster f1+f2 -> Lipschitzian for PartFunc of REAL,REAL n;
  cluster f1-f2 -> Lipschitzian for PartFunc of REAL,REAL n;
end;

theorem 
  f1|X is Lipschitzian & f2|X1 is Lipschitzian implies
    (f1+f2) | (X /\ X1) is Lipschitzian;

theorem 
  f1|X is Lipschitzian & f2|X1 is Lipschitzian implies
  (f1-f2) | (X /\ X1) is Lipschitzian;

registration let n;
  let f be Lipschitzian PartFunc of REAL, REAL n;
  let p;
  cluster p(#)f -> Lipschitzian for PartFunc of REAL, REAL n;
end;

theorem 
  f|X is Lipschitzian & X c= dom f implies (p(#)f) | X is Lipschitzian;

registration let n;
  let f be Lipschitzian PartFunc of REAL, REAL n;
  cluster |. f .| -> Lipschitzian for PartFunc of REAL,REAL;
end;

theorem 
  f|X is Lipschitzian implies -(f|X) is Lipschitzian
    & |. f .| |X is Lipschitzian & (-f) |X is Lipschitzian;

registration let n;
  cluster constant -> Lipschitzian for PartFunc of REAL, REAL n;
end;

registration let n;
  cluster Lipschitzian -> continuous for PartFunc of REAL, REAL n;
end;

theorem 
  for r,p be Element of REAL n
    st (for x0 st x0 in X holds f/.x0 = x0*r+p)
  holds f|X is continuous;

theorem 
  for x0 be Element of REAL n st 1 <= i & i <= n
  holds proj(i,n) is_continuous_in x0;

theorem 
for n be non empty Element of NAT, h be PartFunc of REAL, REAL n holds
h is_continuous_in x0 iff
    (x0 in dom h & for i be Element of NAT st i in Seg n
    holds proj(i,n)*h is_continuous_in x0);

theorem 
for n be non empty Element of NAT, h be PartFunc of REAL, REAL n holds
 h is continuous iff
  for i be Element of NAT st i in Seg n
    holds proj(i,n)*h is continuous;

theorem 
  for x0 be Point of REAL-NS n st 1 <= i & i <= n holds
  Proj(i,n) is_continuous_in x0;

theorem 
for n be non empty Element of NAT,
    h be PartFunc of REAL,REAL-NS n holds
 h is_continuous_in x0 iff
  for i be Element of NAT st i in Seg n
    holds Proj(i,n)*h is_continuous_in x0;

theorem 
for n be non empty Element of NAT,
    h be PartFunc of REAL, REAL-NS n holds
 h is continuous iff
  for i be Element of NAT st i in Seg n
    holds Proj(i,n)*h is continuous;














begin 

reserve i,j for Nat;
reserve x,y for set;

definition
  let A be set;
  let s1,s2 be FinSequence of A;
  redefine func s1^s2 -> Element of A*;
end;

definition
  let A be set;
  let i be Nat;
  let s be FinSequence of A;
  redefine func Del(s,i) -> Element of A*;
end;

theorem 
  Del({},i) = {};

scheme 
 IndSeqD{D()->non empty set, P[set]}:
  for p being FinSequence of D() holds P[p]
  provided
 P[<*> D()] and
 for p being FinSequence of D() for x being Element of D() st P[p]
    holds P[<*x*>^p];

definition
  let C,D be non empty set;
  let R be Relation;
  mode BinOp of C,D,R -> Function of [:C,D:],D means


    for x being Element of C,y1,y2 being Element of D
    st [y1,y2] in R holds [it.(x,y1),it.(x,y2)] in R;
end;

scheme 
 LambdaD2{ A,B,C() -> non empty set, F(set,set) -> Element of C() }:
  ex M being Function of [:A(),B():],C() st
  for i being Element of A(), j being Element of B() holds M.(i,j) = F(i,j);

definition
  let C,D be non empty set;
  let R be Equivalence_Relation of D;
  let b be Function of [:C,D:],D;
  assume
 b is BinOp of C,D,R;
  func b /\/ R -> Function of [:C, Class R:], Class R means


  for x,y,y1 be set st x in C & y in Class R & y1 in y
  holds it.(x,y) = Class(R,b.(x,y1));
end;

definition
  let A,B be non empty set;
  let C be Subset of A;
  let D be Subset of B;
  let f be Function of A,B;
  let g be Function of C,D;
  redefine func f+*g -> Function of A,B;
end;

begin 

definition
  struct(2-sorted) StackSystem(#
    carrier -> set,  
    carrier' -> set, 
    s_empty -> Subset of the carrier',
    s_push -> Function of [:the carrier, the carrier':], the carrier',
    s_pop -> Function of the carrier', the carrier',
    s_top -> Function of the carrier', the carrier
  #);
end;

registration
  let a1 be non empty set, a2 be set, a3 be Subset of a2,
      a4 be Function of [:a1, a2:], a2,
      a5 be Function of a2, a2,
      a6 be Function of a2, a1;
  cluster StackSystem(#a1,a2,a3,a4,a5,a6#) -> non empty;
end;

registration
  let a1 be set, a2 be non empty set, a3 be Subset of a2,
      a4 be Function of [:a1, a2:], a2,
      a5 be Function of a2, a2,
      a6 be Function of a2, a1;
  cluster StackSystem(#a1,a2,a3,a4,a5,a6#) -> non void;
end;

registration
  cluster non empty non void strict for StackSystem;
end;

definition
  let X be StackSystem;
  mode stack of X is Element of the carrier' of X;
end;

definition
  let X be StackSystem;
  let s be stack of X;
  pred emp s means

 s in the s_empty of X;
end;

definition
  let X be non void StackSystem;
  let s be stack of X;
  func pop s -> stack of X equals

(the s_pop of X).s;
  func top s -> Element of X equals

(the s_top of X).s;
end;

definition
  let X be non empty non void StackSystem;
  let s be stack of X;
  let e be Element of X;
  func push(e,s) -> stack of X equals

(the s_push of X).(e,s);
end;

definition
  let A be non empty set;
  func StandardStackSystem A -> non empty non void strict StackSystem means


  the carrier of it = A &
  the carrier' of it = A* &
  for s being stack of it holds
    (emp s iff s is empty) &
  for g being FinSequence st g = s holds
    (not emp s implies top s = g.1 & pop s = Del(g,1)) &
    (emp s implies top s = the Element of it & pop s = {}) &
  for e being Element of it holds
    push(e,s) = <*e*>^g;
end;

reserve A for non empty set;
reserve c for Element of StandardStackSystem A;
reserve m for stack of StandardStackSystem A;

registration
  let A;
  cluster the carrier' of StandardStackSystem A -> functional;
end;

registration
  let A;
  cluster -> FinSequence-like for stack of StandardStackSystem A;
end;


reserve X for non empty non void StackSystem;
reserve s,s1,s2 for stack of X;
reserve e,e1,e2 for Element of X;

definition
  let X;
  attr X is pop-finite means


  for f being Function of NAT, the carrier' of X
  ex i being Nat, s st f.i = s &
  (not emp s implies f.(i+1) <> pop s);

  attr X is push-pop means


  not emp s implies s = push(top s, pop s);

  attr X is top-push means


  e = top push(e,s);

  attr X is pop-push means


  s = pop push(e,s);

  attr X is push-non-empty means


  not emp push(e,s);
end;

registration
  let A be non empty set;
  cluster StandardStackSystem A -> pop-finite;
  cluster StandardStackSystem A -> push-pop;
  cluster StandardStackSystem A -> top-push;
  cluster StandardStackSystem A -> pop-push;
  cluster StandardStackSystem A -> push-non-empty;
end;

registration
  cluster pop-finite push-pop top-push pop-push push-non-empty
  strict for non empty non void StackSystem;
end;

definition
  mode StackAlgebra is pop-finite push-pop top-push pop-push push-non-empty
  non empty non void StackSystem;
end;

theorem 
  for X being non empty non void StackSystem st X is pop-finite
  ex s being stack of X st emp s;

registration
  let X be pop-finite non empty non void StackSystem;
  cluster the s_empty of X -> non empty;
end;

theorem 
  X is top-push pop-push & push(e1,s1) = push(e2,s2) implies e1 = e2 & s1 = s2;

theorem 
  X is push-pop & not emp s1 & not emp s2 &
  pop s1 = pop s2 & top s1 = top s2 implies s1 = s2;

begin 

scheme 

  INDsch{X() -> StackAlgebra, s() -> stack of X(), P[set]}:
  P[s()]
  provided
 for s being stack of X() st emp s holds P[s] and
 for s being stack of X(), e being Element of X() st P[s]
    holds P[push(e,s)];

scheme 

  EXsch{X() -> StackAlgebra,
        s() -> stack of X(),
        A() -> non empty set,
        e() -> Element of A(),
        d(set,set) -> Element of A()}:
  ex a being Element of A() st
  ex F being Function of the carrier' of X(), A() st
  a = F.s() & (for s1 being stack of X() st emp s1 holds F.s1 = e()) &
  for s1 being stack of X(), e being Element of X()
  holds F.push(e,s1) = d(e,F.s1);

scheme 

  UNIQsch{X() -> StackAlgebra,
        s() -> stack of X(),
        A() -> non empty set,
        e() -> Element of A(),
        d(set,set) -> Element of A()}:
  for a1,a2 being Element of A() st
   (ex F being Function of the carrier' of X(), A() st
    a1 = F.s() & (for s1 being stack of X() st emp s1 holds F.s1 = e()) &
    for s1 being stack of X(), e being Element of X()
    holds F.push(e,s1) = d(e,F.s1)) &
   (ex F being Function of the carrier' of X(), A() st
    a2 = F.s() & (for s1 being stack of X() st emp s1 holds F.s1 = e()) &
    for s1 being stack of X(), e being Element of X()
    holds F.push(e,s1) = d(e,F.s1))
  holds a1 = a2;

begin 

reserve X for StackAlgebra;
reserve s,s1,s2,s3 for stack of X;
reserve e,e1,e2,e3 for Element of X;

definition
  let X,s;
  func |.s.| -> Element of (the carrier of X)* means


  ex F being Function of the carrier' of X, (the carrier of X)* st
  it = F.s & (for s1 st emp s1 holds F.s1 = {}) &
  for s1, e holds F.push(e,s1) = <*e*>^(F.s1);
end;

theorem 
  emp s implies |.s.| = {};

theorem 
  not emp s implies |.s.| = <*top s*>^|.pop s.|;

theorem 
  not emp s implies |.pop s.| = Del(|.s.|,1);

theorem 
  |.push(e,s).| = <*e*>^|.s.|;

theorem 
  not emp s implies top s = |.s.|.1;

theorem 
  |.s.| = {} implies emp s;

theorem 
  for s being stack of StandardStackSystem A holds |.s.| = s;

theorem 
  for x being Element of (the carrier of X)*
  ex s st |.s.| = x;

definition
  let X,s1,s2;
  pred s1 == s2 means

 |.s1.| = |.s2.|;
  reflexivity;
  symmetry;
end;

theorem 
  s1 == s2 & s2 == s3 implies s1 == s3;

theorem 
  s1 == s2 & emp s1 implies emp s2;

theorem 
  emp s1 & emp s2 implies s1 == s2;

theorem 
  s1 == s2 implies push(e,s1) == push(e,s2);

theorem 
  s1 == s2 & not emp s1 implies pop s1 == pop s2;

theorem 
  s1 == s2 & not emp s1 implies top s1 = top s2;

definition
  let X;
  attr X is proper-for-identity means


  for s1,s2 st s1 == s2 holds s1 = s2;
end;

registration
  let A;
  cluster StandardStackSystem A -> proper-for-identity;
end;

definition
  let X;
  func ==_X -> Relation of the carrier' of X means


  [s1,s2] in it iff s1 == s2;
end;

registration
  let X;
  cluster ==_X -> total symmetric transitive;
end;

theorem 
  emp s implies Class(==_X, s) = the s_empty of X;

definition
  let X,s;
  func coset s -> Subset of the carrier' of X means


  s in it &
  (for e,s1 st s1 in it holds
  push(e,s1) in it & (not emp s1 implies pop s1 in it)) &
  for A being Subset of the carrier' of X st
    s in A &
    (for e,s1 st s1 in A holds
    push(e,s1) in A & (not emp s1 implies pop s1 in A))
  holds it c= A;
end;

theorem 
  (push(e,s) in coset s1 implies s in coset s1) &
  (not emp s & pop s in coset s1 implies s in coset s1);

theorem 
  s in coset push(e,s) & (not emp s implies s in coset pop s);

theorem 
  ex s1 st emp s1 & s1 in coset s;

registration
  let A;
  let R be Relation of A;
  cluster A-valued for RedSequence of R;
end;

definition
  let X;
  func ConstructionRed X -> Relation of the carrier' of X means


  [s1,s2] in it iff (not emp s1 & s2 = pop s1) or ex e st s2 = push(e,s1);
end;

theorem 
  for R being Relation of A
  for t being RedSequence of R holds t.1 in A iff t is A-valued;

scheme 
 PathIND{X() -> non empty set, x1,x2() -> Element of X(),
  R() -> (Relation of X()), P[set]}:
  P[x2()]
  provided
 P[x1()] and
 R() reduces x1(),x2() and
 for x,y being Element of X() st R() reduces x1(),x & [x,y] in R() &
    P[x] holds P[y];

theorem 
  for t being RedSequence of ConstructionRed X
  st s = t.1 holds rng t c= coset s;

theorem 
  coset s = {s1: ConstructionRed X reduces s,s1};

definition
  let X,s;
  func core s -> stack of X means


  emp it &
  ex t being the carrier' of X-valued RedSequence of ConstructionRed X st
  t.1 = s & t.len t = it &
  for i st 1 <= i & i < len t holds not emp t/.i & t/.(i+1) = pop(t/.i);
end;

theorem 
  emp s implies core s = s;

theorem 
  core push(e,s) = core s;

theorem 
  not emp s implies core pop s = core s;

theorem 
  core s in coset s;

theorem 
  for x being Element of (the carrier of X)*
  ex s1 st |.s1.| = x & s1 in coset s;

theorem 
  s1 in coset s implies core s1 = core s;

theorem 
  s1 in coset s & s2 in coset s & |.s1.| = |.s2.| implies s1 = s2;

theorem 
  ex s st (coset s1)/\Class(==_X, s2) = {s};

begin 

definition
  let X;
  func X/== -> strict StackSystem means


  the carrier of it = the carrier of X &
  the carrier' of it = Class(==_X) &
  the s_empty of it = {the s_empty of X} &
  the s_push of it = (the s_push of X)/\/==_X &
  the s_pop of it = ((the s_pop of X)+*(id the s_empty of X))/\/==_X &
  for f being Choice_Function of Class(==_X) holds the s_top of it
  = ((the s_top of X)*f)+*(the s_empty of X,the Element of the carrier of X);
end;

registration
  let X;
  cluster X/== -> non empty non void;
end;

theorem 
  for S being stack of X/== ex s st S = Class(==_X, s);

theorem 
  Class(==_X, s) is stack of X/==;

theorem 
  for S being stack of X/== st S = Class(==_X, s) holds emp s iff emp S;

theorem 
  for S being stack of X/== holds emp S iff S = the s_empty of X;

theorem 
  for S being stack of X/==, E being Element of X/==
  st S = Class(==_X, s) & E = e holds
  push(e, s) in push(E, S) & Class(==_X, push(e, s)) = push(E, S);

theorem 
  for S being stack of X/== st S = Class(==_X, s) & not emp s holds
  pop s in pop S & Class(==_X, pop s) = pop S;

theorem 
  for S being stack of X/== st S = Class(==_X, s) & not emp s holds
  top S = top s;

registration
  let X;
  cluster X/== -> pop-finite;
  cluster X/== -> push-pop;
  cluster X/== -> top-push;
  cluster X/== -> pop-push;
  cluster X/== -> push-non-empty;
end;

theorem 
  for S being stack of X/== st S = Class(==_X, s) holds |.S.| = |.s.|;

registration
  let X;
  cluster X/== -> proper-for-identity;
end;

registration
  cluster proper-for-identity for StackAlgebra;
end;

begin 

definition
  let X1,X2 be StackAlgebra;
  let F,G be Function;
  pred F,G form_isomorphism_between X1,X2 means


  dom F = the carrier of X1 & rng F = the carrier of X2 & F is one-to-one &
  dom G = the carrier' of X1 & rng G = the carrier' of X2 & G is one-to-one &
  for s1 being stack of X1, s2 being stack of X2 st s2 = G.s1
  holds (emp s1 iff emp s2) &
  (not emp s1 implies pop s2 = G.pop s1 & top s2 = F.top s1) &
  for e1 being Element of X1, e2 being Element of X2 st e2 = F.e1
  holds push(e2,s2) = G.push(e1,s1);
end;

reserve X1,X2,X3 for StackAlgebra;
reserve F,F1,F2,G,G1,G2 for Function;

theorem 
  id the carrier of X, id the carrier' of X form_isomorphism_between X,X;

theorem 
  F,G form_isomorphism_between X1,X2 implies
  F",G" form_isomorphism_between X2,X1;

theorem 
  F1,G1 form_isomorphism_between X1,X2 &
  F2,G2 form_isomorphism_between X2,X3 implies
  F2*F1,G2*G1 form_isomorphism_between X1,X3;

theorem 
  F,G form_isomorphism_between X1,X2 implies
  for s1 being stack of X1, s2 being stack of X2 st s2 = G.s1
  holds |.s2.| = F*|.s1.|;

definition
  let X1,X2 be StackAlgebra;
  pred X1,X2 are_isomorphic means

  ex F,G being Function st F,G form_isomorphism_between X1,X2;
  reflexivity;
  symmetry;
end;

theorem 
  X1,X2 are_isomorphic & X2,X3 are_isomorphic implies X1,X3 are_isomorphic;

theorem 
  X1,X2 are_isomorphic & X1 is proper-for-identity implies
  X2 is proper-for-identity;

theorem 
  for X being proper-for-identity StackAlgebra holds
  ex G st (for s being stack of X holds G.s = |.s.|) &
  id the carrier of X, G form_isomorphism_between
  X, StandardStackSystem the carrier of X;

theorem 
  for X being proper-for-identity StackAlgebra holds
  X, StandardStackSystem the carrier of X are_isomorphic;














begin

 reserve Omega, Omega2 for non empty set;
 reserve Sigma, F for SigmaField of Omega;
 reserve Sigma2, F2 for SigmaField of Omega2;

notation
  let a,r be real number;
  synonym halfline_fin(a,r) for [.a,r.[;
end;

definition
  let a,r be real number;
  redefine func halfline_fin(a,r) -> Subset of REAL;
end;

theorem 
  for k being real number holds REAL \ [.k,+infty.[ = ].-infty,k.[;

theorem 
  for k being real number holds REAL \ ].-infty,k.[ = [.k,+infty.[;

definition
  let a,b be real number;
  func half_open_sets(a,b) -> SetSequence of REAL means

  it.0 = halfline_fin(a,b+1) &
  for n being Element of NAT holds it.(n+1) = halfline_fin(a,b+1/(n+1));
end;

definition
  mode pricefunction -> Real_Sequence means

  it.0 = 1 & for n being Element of NAT holds it.n >= 0;
end;

notation
  let phi,jpi be Real_Sequence;
  synonym ElementsOfBuyPortfolio(phi,jpi) for phi (#) jpi;
end;

definition
  let phi,jpi be Real_Sequence;
  redefine func ElementsOfBuyPortfolio(phi,jpi) -> Real_Sequence;
end;

definition
  let d be Nat;
  let phi,jpi be Real_Sequence;
  func BuyPortfolioExt(phi,jpi,d) -> Element of REAL equals

  Partial_Sums(ElementsOfBuyPortfolio(phi,jpi)).d;

  func BuyPortfolio(phi,jpi,d) -> Element of REAL equals

  Partial_Sums(ElementsOfBuyPortfolio(phi,jpi)^\1).(d-1);
end;

definition
  let Omega, Omega2 be set;
  let Sigma be SigmaField of Omega;
  let Sigma2 be SigmaField of Omega2;
  let X be Function;
  pred X is_random_variable_on Sigma,Sigma2 means

  for x being Element of Sigma2 holds
  {y where y is Element of Omega: X.y is Element of x} is Element of Sigma;
end;

definition
  let Omega, Omega2 be set;
  let F be SigmaField of Omega;
  let F2 be SigmaField of Omega2;
  func set_of_random_variables_on (F,F2) equals

  {f where f is Function of Omega,Omega2: f is_random_variable_on F,F2};
end;

registration
  let Omega,Omega2,F,F2;
  cluster set_of_random_variables_on(F,F2) -> non empty;
end;

definition
  let Omega, Omega2 be non empty set;
  let F be SigmaField of Omega;
  let F2 be SigmaField of Omega2;
  let X be set such that
X = set_of_random_variables_on(F,F2);
  let k be Element of X;
  func Change_Element_to_Func(F,F2,k) -> Function of Omega,Omega2 equals


  k;
end;

definition
  let Omega be non empty set;
  let F be SigmaField of Omega;
  let X be non empty set;
  let k be Element of X;
  func ElementsOfPortfolioValueProb_fut(F,k) -> Function of Omega,REAL means


  for w being Element of Omega holds
  it.w = Change_Element_to_Func(F,Borel_Sets,k).w;
end;

definition
  let p be Nat;
  let Omega, Omega2 be non empty set;
  let F be SigmaField of Omega;
  let F2 be SigmaField of Omega2;
  let X be set such that
 X = set_of_random_variables_on(F,F2);
  let G be Function of NAT,X;
  func Element_Of(F,F2,G,p) -> Function of Omega,Omega2 equals

  G.p;
end;

definition
  let Omega be non empty set;
  let F be SigmaField of Omega;
  let X be non empty set;
  let w be Element of Omega;
  let G be Function of NAT,X;
  let phi be Real_Sequence;
  func ElementsOfPortfolioValue_fut(phi,F,w,G) -> Real_Sequence means


  for n being Element of NAT holds
   it.n = ElementsOfPortfolioValueProb_fut(F,G.n).w * phi.n;
end;

definition
  let d be Nat;
  let phi be Real_Sequence;
  let Omega be non empty set;
  let F be SigmaField of Omega;
  let X be non empty set;
  let G be Function of NAT,X;
  let w be Element of Omega;
  func PortfolioValueFutExt(d,phi,F,G,w) -> Element of REAL equals

  Partial_Sums(ElementsOfPortfolioValue_fut(phi,F,w,G)).d;

  func PortfolioValueFut(d,phi,F,G,w) -> Element of REAL equals

  Partial_Sums(ElementsOfPortfolioValue_fut(phi,F,w,G)^\1).(d-1);
end;

registration
  cluster non empty for Element of Borel_Sets;
end;

theorem 
  for k being real number holds
  [.k,+infty.[ is Element of Borel_Sets &
  ].-infty,k.[ is Element of Borel_Sets;

theorem 
  for k1,k2 being real number holds
  [.k2,k1.[ is Element of Borel_Sets;

theorem 
  for a,b being real number holds
   Intersection half_open_sets(a,b) is Element of Borel_Sets;

theorem 
  for a,b being real number holds
  Intersection half_open_sets(a,b) = [.a,b.];

theorem 
  for a,b being real number, n being Nat holds
  (Partial_Intersection half_open_sets(a,b)).n is Element of Borel_Sets;

theorem 
for k1,k2 being real number holds [.k2,k1.] is Element of Borel_Sets;

theorem 
for X being Function of Omega,REAL st
   X is_random_variable_on Sigma,Borel_Sets holds
(for k being real number holds
{w where w is Element of Omega: X.w >=k} is Element of Sigma &
{w where w is Element of Omega: X.w <k} is Element of Sigma) &
(for k1,k2 being real number st k1<k2 holds
{w where w is Element of Omega: k1 <= X.w & X.w < k2} is Element of Sigma)
             &
(for k1,k2 being real number st k1<=k2 holds
{w where w is Element of Omega: k1 <= X.w & X.w <= k2} is Element of Sigma)
             &
(for r being real number holds
       less_dom(X,r) = {w where w is Element of Omega: X.w <r}) &
(for r being real number holds
       great_eq_dom(X,r) = {w where w is Element of Omega: X.w >=r}) &
(for r being real number holds
       eq_dom(X,r) = {w where w is Element of Omega: X.w =r}) &
(for r being real number holds eq_dom(X,r) is Element of Sigma);

theorem 
  for s being real number holds
    Omega --> s is_random_variable_on Sigma,Borel_Sets;

theorem 
  for phi being Real_Sequence, jpi being pricefunction,
      d being Nat st d>0 holds
  BuyPortfolioExt(phi,jpi,d) = phi.0 + BuyPortfolio(phi,jpi,d);

theorem 
for d being Nat st d>0 holds
for r being real number
for phi being Real_Sequence
for G being Function of NAT,set_of_random_variables_on(F,Borel_Sets) st
 Element_Of(F,Borel_Sets,G,0) = Omega-->1+r holds
 for w being Element of Omega holds
PortfolioValueFutExt(d,phi,F,G,w)
       = ((1+r) * phi.0) + PortfolioValueFut(d,phi,F,G,w);

theorem 
for d being Nat st d>0 holds
for r being real number st r>-1 holds
for phi being Real_Sequence,
    jpi being pricefunction holds
for G being Function of NAT,set_of_random_variables_on(F,Borel_Sets) st
 Element_Of(F,Borel_Sets,G,0) = Omega-->1+r holds
for w being Element of Omega holds
 BuyPortfolioExt(phi,jpi,d)<=0 implies
(PortfolioValueFutExt(d,phi,F,G,w) <=
 PortfolioValueFut(d,phi,F,G,w) - (1+r)*BuyPortfolio(phi,jpi,d));

theorem 
for d being Nat st d>0 holds
for r being real number st r>-1 holds
for phi being Real_Sequence,
    jpi being pricefunction holds
for G being Function of NAT,set_of_random_variables_on (F,Borel_Sets) st
 Element_Of(F,Borel_Sets,G,0) = Omega-->1+r holds
(BuyPortfolioExt(phi,jpi,d)<=0 implies
({w where w is Element of Omega:
      PortfolioValueFutExt(d,phi,F,G,w) >= 0} c=
     {w where w is Element of Omega:
      PortfolioValueFut(d,phi,F,G,w)
                    >= (1+r)*BuyPortfolio(phi,jpi,d)} &
{w where w is Element of Omega: PortfolioValueFutExt(d,phi,F,G,w) > 0} c=
{w where w is Element of Omega: PortfolioValueFut(d,phi,F,G,w)
                    > (1+r)*BuyPortfolio(phi,jpi,d)}));

theorem 
for f being Function of Omega,REAL st
    f is_random_variable_on Sigma,Borel_Sets holds
          f is_measurable_on [#]Sigma &
          f is Real-Valued-Random-Variable of Sigma;

theorem 
  set_of_random_variables_on (Sigma,Borel_Sets) c=
    Real-Valued-Random-Variables-Set Sigma;














begin 

reserve x, y, z, s for ext-real number;
reserve i, j for Integer;
reserve n, m for Nat;

theorem 
  x = -x implies x = 0;

theorem 
  x + x = 0 implies x = 0;

theorem 
  0 <= x & x <= y & 0 <= s & s <= z implies x*s <= y*z;

theorem 
  y <> +infty & 0 < x & 0 < y implies 0 < x / y;

theorem 
  y <> +infty & x < 0 & 0 < y implies x / y < 0;

theorem 
  y <> -infty & 0 < x & y < 0 implies x / y < 0;

theorem 
  x in REAL & y in REAL or z in REAL implies
  (x + y) / z = x/z + y/z;

theorem 
  y <> +infty & y <> -infty & y <> 0 implies x / y * y = x;

theorem 
  y <> -infty & y <> +infty & x <> 0 & y <> 0 implies x / y <> 0;

definition let x be number;
  attr x is ext-integer means

    x is integer or x = +infty;
end;

registration
  cluster ext-integer -> ext-real for number;
end;

registration
  cluster +infty -> ext-integer;
  cluster -infty -> non ext-integer;
  cluster 1. -> ext-integer positive real;
  cluster integer -> ext-integer for number;
  cluster real ext-integer -> integer for number;
end;

registration
  cluster real ext-integer positive for Element of ExtREAL;
  cluster positive for ext-integer number;
end;

definition
  mode ExtInt is ext-integer number;
end;

reserve x, y, v, u for ExtInt;

theorem 
  x < y implies x + 1 <= y;

theorem 
  -infty < x;

definition
  let X be ext-real-membered set;
  given i0 being positive ExtInt such that
 i0 in X;
  func least-positive(X) -> positive ExtInt means


  it in X &
  for i being positive ExtInt st i in X holds it <= i;
end;

definition let f be Relation;
  attr f is e.i.-valued means


  for x being set st x in rng f holds x is ext-integer;
end;

registration
  cluster e.i.-valued for Function;
end;

registration
  let A be set;
  cluster e.i.-valued for Function of A, ExtREAL;
end;

registration
  let f be e.i.-valued Function, x be set;
  cluster f.x -> ext-integer;
end;

begin 

theorem 
  for K being distributive left_unital add-associative right_zeroed
  right_complementable non empty doubleLoopStr holds
  (-1.K) * (-1.K) = 1.K;

definition
  let K be non empty doubleLoopStr;
  let S be Subset of K;
  let n be Nat;
  func S |^ n -> Subset of K means


  it = the carrier of K if n = 0 otherwise
  ex f being FinSequence of bool the carrier of K st
  it = f.len f & len f = n & f.1 = S &
  for i being Nat st i in dom f & i+1 in dom f holds
  f.(i+1) = S *' (f/.i);
 end;

reserve
  D for non empty doubleLoopStr,
  A for Subset of D;

theorem 
  A |^ 1 = A;

theorem 
  A |^ 2 = A *' A;

registration
  let R be Ring;
  let S be Ideal of R;
  let n be Nat;
  cluster S|^n -> non empty add-closed left-ideal right-ideal;
end;

definition
  let G be non empty doubleLoopStr,
  g be Element of G,
  i be Integer;
  func g |^ i -> Element of G equals

  power(G).(g,abs(i)) if 0 <= i
  otherwise (power(G).(g,abs(i)))";
end;

definition
  let G be non empty doubleLoopStr,
  g be Element of G,
  n be Nat;
  redefine func g |^ n equals

  power(G).(g,n);
end;

reserve K for Field-like non degenerated
  associative add-associative right_zeroed right_complementable
  distributive Abelian non empty doubleLoopStr,
  a, b, c for Element of K;

theorem 
  a |^ (n + m) = (a |^ n) * (a |^ m);

theorem 
  a <> 0.K implies a|^i <> 0.K;

begin 

definition let K be doubleLoopStr;
  attr K is having_valuation means


  ex f being e.i.-valued Function of K, ExtREAL st
  f.0.K = +infty &
  (for a being Element of K st a <> 0.K holds f.a in INT) &
  (for a,b being Element of K holds f.(a*b) = f.a + f.b) &
  (for a being Element of K st 0 <= f.a holds 0 <= f.(1.K+a)) &
  ex a being Element of K st f.a <> 0 & f.a <> +infty;
end;

definition let K be doubleLoopStr such that
 K is having_valuation;
  mode Valuation of K -> e.i.-valued Function of K, ExtREAL means

  it.0.K = +infty &
  (for a being Element of K st a <> 0.K holds it.a in INT) &
  (for a,b being Element of K holds it.(a*b) = it.a + it.b) &
  (for a being Element of K st 0 <= it.a holds 0 <= it.(1.K+a)) &
  ex a being Element of K st it.a <> 0 & it.a <> +infty;
end;

reserve v for Valuation of K;

theorem 
  K is having_valuation implies v.1.K = 0;

theorem 
  K is having_valuation & a <> 0.K implies v.a <> +infty;

theorem 
  K is having_valuation implies v.-1.K = 0;

theorem 
  K is having_valuation implies v.-a = v.a;

theorem 
  K is having_valuation & a <> 0.K implies v.(a") = -v.a;

theorem 
  K is having_valuation & b <> 0.K implies v.(a/b) = v.a - v.b;

theorem 
  K is having_valuation & a <> 0.K & b <> 0.K implies v.(a/b) = -v.(b/a);

theorem 
  K is having_valuation & b <> 0.K & 0 <= v.(a/b) implies v.b <= v.a;

theorem 
  K is having_valuation & a <> 0.K & b <> 0.K & v.(a/b) <= 0 implies
  0 <= v.(b/a);

theorem 
  K is having_valuation & b <> 0.K & v.(a/b) <= 0 implies v.a <= v.b;

theorem 
  K is having_valuation implies min(v.a,v.b) <= v.(a+b);

theorem 
  K is having_valuation & v.a < v.b implies v.a = v.(a+b);

theorem 
  K is having_valuation & a <> 0.K implies v.(a|^i) = i * v.a;

theorem 
  K is having_valuation & 0 <= v.(1.K+a) implies 0 <= v.a;

theorem 
  K is having_valuation & 0 <= v.(1.K-a) implies 0 <= v.a;

theorem 
  K is having_valuation & a <> 0.K & v.a <= v.b implies 0 <= v.(b/a);

theorem 
  K is having_valuation implies +infty in rng v;

theorem 
  v.a = 1 implies least-positive(rng v) = 1;

theorem 
  K is having_valuation implies least-positive(rng v) is integer;

theorem 
  K is having_valuation implies
  for x being Element of K st x <> 0.K
  ex i being Integer st v.x = i * least-positive(rng v);

definition
  let K, v;
  assume
 K is having_valuation;
  func Pgenerator(v) -> Element of K equals


  the Element of v"{least-positive(rng v)};
end;

definition
  let K, v;
  assume
 K is having_valuation;
  func normal-valuation(v) -> Valuation of K means


  v.a = (it.a) * least-positive(rng v);
 end;

theorem 
  K is having_valuation implies
  (v.a = 0 iff normal-valuation(v).a = 0);

theorem 
  K is having_valuation implies
  (v.a = +infty iff normal-valuation(v).a = +infty);

theorem 
  K is having_valuation implies
  (v.a = v.b iff normal-valuation(v).a = normal-valuation(v).b);

theorem 
  K is having_valuation implies
  (v.a is positive iff normal-valuation(v).a is positive);

theorem 
  K is having_valuation implies
  (0 <= v.a iff 0 <= normal-valuation(v).a);

theorem 
  K is having_valuation implies
  (v.a is non negative iff normal-valuation(v).a is non negative);

theorem 
  K is having_valuation implies normal-valuation(v).Pgenerator(v) = 1;

theorem 
  K is having_valuation & 0 <= v.a implies normal-valuation(v).a <= v.a;

theorem 
  K is having_valuation & v.a = 1 implies normal-valuation(v) = v;

theorem 
  K is having_valuation implies
  normal-valuation(normal-valuation(v)) = normal-valuation(v);

begin 

definition
  let K be non empty doubleLoopStr;
  let v be Valuation of K;
  func NonNegElements v equals

  {x where x is Element of K: 0 <= v.x};
end;

theorem 
  for K being non empty doubleLoopStr,
      v being Valuation of K,
      a being Element of K holds
  a in NonNegElements v iff 0 <= v.a;

theorem 
  for K being non empty doubleLoopStr,
      v being Valuation of K holds
  NonNegElements v c= the carrier of K;

theorem 
  for K being non empty doubleLoopStr,
      v being Valuation of K holds
  K is having_valuation implies 0.K in NonNegElements v;

theorem 
  K is having_valuation implies 1.K in NonNegElements v;

definition
  let K, v such that
 K is having_valuation;
  func ValuatRing v -> strict commutative non degenerated Ring means


  the carrier of it = NonNegElements v &
  the addF of it = (the addF of K) | [:NonNegElements v,NonNegElements v:] &
  the multF of it = (the multF of K) | [:NonNegElements v,NonNegElements v:] &
  the ZeroF of it = 0.K &
  the OneF of it = 1.K;
 end;

theorem 
  K is having_valuation implies
  for x being Element of ValuatRing v holds x is Element of K;

theorem 
  K is having_valuation implies
  (0 <= v.a iff a is Element of ValuatRing v);

theorem 
  K is having_valuation implies
  for S being Subset of ValuatRing v holds 0 is LowerBound of v.:S;

theorem 
  K is having_valuation implies
  for x, y being Element of K,
  x1, y1 being Element of ValuatRing v st x = x1 & y = y1 holds
  x + y = x1 + y1;

theorem 
  K is having_valuation implies
  for x, y being Element of K,
  x1, y1 being Element of ValuatRing v st x = x1 & y = y1 holds
  x * y = x1 * y1;

theorem 
  K is having_valuation implies 0.ValuatRing v = 0.K;

theorem 
  K is having_valuation implies 1.ValuatRing v = 1.K;

theorem 
  K is having_valuation implies
  for x being Element of K, y being Element of ValuatRing v
  st x = y holds -x = -y;

theorem 
  K is having_valuation implies ValuatRing v is domRing-like;

theorem 
  K is having_valuation implies
  for y being Element of ValuatRing v holds
  power(K).(y,n) = power(ValuatRing v).(y,n);

definition
  let K, v; assume
 K is having_valuation;
  func PosElements v -> Ideal of ValuatRing v equals


  {x where x is Element of K: 0 < v.x};
end;

notation let K, v;
  synonym vp v for PosElements v;
end;

theorem 
  K is having_valuation implies
  (a in vp v iff 0 < v.a);

theorem 
  K is having_valuation implies 0.K in vp v;

theorem 
  K is having_valuation implies not 1.K in vp v;

definition
  let K, v;
  let S be non empty Subset of K;
  assume that
 K is having_valuation and
 S is Subset of ValuatRing v;
  func min(S,v) -> Subset of ValuatRing v equals


  v"{inf(v.:S)} /\ S;
end;

theorem 
  for S being non empty Subset of K st
  K is having_valuation & S is Subset of ValuatRing v
  holds min(S,v) c= S;

theorem 
  for S being non empty Subset of K st
  K is having_valuation & S is Subset of ValuatRing v
  for x being Element of K holds x in min(S,v) iff x in S &
  for y being Element of K st y in S holds v.x <= v.y;

theorem 
  K is having_valuation implies
  for I being non empty Subset of K, x being Element of ValuatRing v st
  I is Ideal of ValuatRing v & x in min(I,v) holds
  I = {x}-Ideal;

theorem 
  for R being non empty doubleLoopStr,
  I being add-closed non empty Subset of R holds
  I is Preserv of the addF of R;

definition
  let R be Ring;
  let P be RightIdeal of R;
  mode Submodule of P -> Submodule of RightModule R means


  the carrier of it = P;
end;

registration
  let R be Ring;
  let P be RightIdeal of R;
  cluster strict for Submodule of P;
end;

theorem 
  for R being Ring, P being Ideal of R, M being Submodule of P
  for a being BinOp of P, z be Element of P
  for m being Function of [:P,the carrier of R:], P
  st a = (the addF of R)|[:P,P:] &
  m = (the multF of R)|[:P,the carrier of R:] & z = the ZeroF of R
  holds the RightModStr of M = RightModStr(#P,a,z,m#);

definition
  let R be Ring;
  let M1,M2 be RightMod of R;
  let h be Function of M1,M2;
  attr h is scalar-linear means

  for x being Element of M1, r being Element of R holds h.(x*r) = (h.x)*r;
end;

registration
  let R be Ring, M1 be RightMod of R, M2 be Submodule of M1;
  cluster incl(M2,M1) -> additive scalar-linear;
end;

theorem 
  K is having_valuation & b is Element of ValuatRing v
  implies v.a <= v.a + v.b;

theorem 
  K is having_valuation & a is Element of ValuatRing v implies
  power(K).(a,n) is Element of ValuatRing v;

theorem 
  K is having_valuation implies
  for x being Element of ValuatRing v st x <> 0.K
  holds power(K).(x,n) <> 0.K;

theorem 
  K is having_valuation & v.a = 0 implies
  a is Element of ValuatRing v & a" is Element of ValuatRing v;

theorem 
  K is having_valuation & a <> 0.K &
  a is Element of ValuatRing v & a" is Element of ValuatRing v implies
  v.a = 0;

theorem 
  K is having_valuation & v.a = 0 implies
  for I being Ideal of ValuatRing v holds
  a in I iff I = the carrier of ValuatRing v;

theorem 
  K is having_valuation implies Pgenerator(v) is Element of ValuatRing v;

theorem 
  K is having_valuation implies vp(v) is proper;

theorem 
  K is having_valuation implies
  for x being Element of ValuatRing v st not x in vp(v)
  holds v.x = 0;

theorem 
  K is having_valuation implies vp(v) is prime;

theorem 
  K is having_valuation implies
  for I being proper Ideal of ValuatRing v holds I c= vp(v);

theorem 
  K is having_valuation implies vp(v) is maximal;

theorem 
  K is having_valuation implies
  for I being maximal Ideal of ValuatRing v holds I = vp(v);

theorem 
  K is having_valuation implies
  NonNegElements(normal-valuation v) = NonNegElements(v);

theorem 
  K is having_valuation implies
  ValuatRing(normal-valuation v) = ValuatRing v;
















begin 

definition
  let X be TopStruct;
  let f be Function of the carrier of X,COMPLEX;
  attr f is continuous means

  for Y being Subset of COMPLEX st Y is closed holds
  f " Y is closed;
end;

definition
  let X be 1-sorted, y be complex number;
  func X --> y -> Function of the carrier of X,COMPLEX equals

  (the carrier of X) --> y;
end;

theorem 
  for X being non empty TopSpace
  for y being complex number
  for f being Function of the carrier of X,COMPLEX st f=X --> y
      holds f is continuous;

registration
  let X be non empty TopSpace, y be complex number;
  cluster X --> y -> continuous;
end;

registration
  let X be non empty TopSpace;
  cluster continuous for Function of the carrier of X,COMPLEX;
end;

theorem 
  for X being non empty TopSpace,
      f being Function of the carrier of X,COMPLEX holds
  ( f is continuous iff for Y being Subset of COMPLEX st Y is open holds
    f " Y is open );

theorem 
  for X being non empty TopSpace
  for f be Function of the carrier of X,COMPLEX holds
  (f is continuous iff for x being Point of X
  for V being Subset of COMPLEX st f.x in V & V is open holds
    ex W being Subset of X st (x in W & W is open & f.:W c= V));

theorem 
  for X being non empty TopSpace
  for f,g being continuous Function of the carrier of X,COMPLEX
   holds f+g is continuous Function of the carrier of X,COMPLEX;

theorem 
  for X being non empty TopSpace
  for a being complex number
  for f being continuous Function of the carrier of X,COMPLEX
   holds a(#)f is continuous Function of the carrier of X,COMPLEX;

theorem 
  for X being non empty TopSpace,
  f,g be continuous Function of the carrier of X,COMPLEX
   holds f-g is continuous Function of the carrier of X,COMPLEX;

theorem 
  for X being non empty TopSpace,
  f,g be continuous Function of the carrier of X,COMPLEX
   holds f(#)g is continuous Function of the carrier of X,COMPLEX;

theorem 
  for X being non empty TopSpace
  for f being continuous Function of the carrier of X,COMPLEX
      holds ( |.f.| is Function of the carrier of X,REAL &
         |.f.| is continuous);

definition
  let X be non empty TopSpace;
  func CContinuousFunctions(X) -> Subset of CAlgebra the carrier of X equals

  { f where f is continuous Function of the carrier of X,COMPLEX
                                    : not contradiction };
end;

registration
  let X be non empty TopSpace;
  cluster CContinuousFunctions(X) -> non empty;
end;

registration
  let X be non empty TopSpace;
  cluster CContinuousFunctions X -> Cadditively-linearly-closed
                                multiplicatively-closed;
end;

definition
  let X be non empty TopSpace;
  func C_Algebra_of_ContinuousFunctions X -> ComplexAlgebra equals

  ComplexAlgebraStr (# CContinuousFunctions X,
    mult_(CContinuousFunctions X,CAlgebra the carrier of X),
    Add_(CContinuousFunctions X,CAlgebra the carrier of X),
    Mult_(CContinuousFunctions X,CAlgebra the carrier of X),
    One_(CContinuousFunctions X,CAlgebra the carrier of X),
    Zero_(CContinuousFunctions X,CAlgebra the carrier of X) #);
end;

theorem 
  for X be non empty TopSpace holds C_Algebra_of_ContinuousFunctions X
   is ComplexSubAlgebra of CAlgebra the carrier of X;

registration
  let X be non empty TopSpace;
  cluster C_Algebra_of_ContinuousFunctions X -> strict non empty;
end;

registration
  let X be non empty TopSpace;
  cluster C_Algebra_of_ContinuousFunctions X -> Abelian add-associative
    right_zeroed right_complementable vector-distributive scalar-distributive
    scalar-associative scalar-unital
    commutative associative right_unital right-distributive
    vector-distributive scalar-distributive scalar-associative
    vector-associative;
end;

theorem 
  for X being non empty TopSpace
  for F, G, H being VECTOR of (C_Algebra_of_ContinuousFunctions X)
  for f, g, h being Function of the carrier of X,COMPLEX
                                    st f = F & g = G & h = H holds
    ( H = F + G iff for x being Element of the carrier of X holds
                                           h . x = (f . x) + (g . x) );

theorem 
  for X being non empty TopSpace
  for F, G being VECTOR of (C_Algebra_of_ContinuousFunctions X)
  for f, g being Function of the carrier of X,COMPLEX
  for a being Complex st f = F & g = G holds
  ( G = a * F iff for x being Element of X holds g . x = a * (f . x) );

theorem 
  for X being non empty TopSpace
  for F, G, H being VECTOR of (C_Algebra_of_ContinuousFunctions X)
  for f, g, h being Function of the carrier of X,COMPLEX
                    st f = F & g = G & h = H holds
  ( H = F * G iff for x being Element of the carrier of X holds
                          h . x = (f . x) * (g . x) );

theorem 
  for X being non empty TopSpace holds
    0.(C_Algebra_of_ContinuousFunctions X) = X --> 0c;

theorem 
  for X being non empty TopSpace holds
   1_(C_Algebra_of_ContinuousFunctions X) = X --> 1r;

theorem 
  for A being ComplexAlgebra
  for A1, A2 being ComplexSubAlgebra of A st
                    the carrier of A1 c= the carrier of A2 holds
  A1 is ComplexSubAlgebra of A2;

theorem 
for X being non empty compact TopSpace holds
  C_Algebra_of_ContinuousFunctions X is
    ComplexSubAlgebra of C_Algebra_of_BoundedFunctions the carrier of X;

definition
  let X be non empty compact TopSpace;
  func CContinuousFunctionsNorm X -> Function of (CContinuousFunctions X),REAL
    equals

  (ComplexBoundedFunctionsNorm the carrier of X) | (CContinuousFunctions X);
end;

definition
  let X be non empty compact TopSpace;
  func C_Normed_Algebra_of_ContinuousFunctions X -> Normed_Complex_AlgebraStr
    equals

  Normed_Complex_AlgebraStr(# (CContinuousFunctions X),
    (mult_ ((CContinuousFunctions X),(CAlgebra the carrier of X))),
    (Add_ ((CContinuousFunctions X),(CAlgebra the carrier of X))),
    (Mult_ ((CContinuousFunctions X),(CAlgebra the carrier of X))),
    (One_ ((CContinuousFunctions X),(CAlgebra the carrier of X))),
    (Zero_ ((CContinuousFunctions X),(CAlgebra the carrier of X))),
    (CContinuousFunctionsNorm X) #);
end;

registration
  let X be non empty compact TopSpace;
  cluster C_Normed_Algebra_of_ContinuousFunctions X -> non empty strict;
end;

registration
  let X be non empty compact TopSpace;
  cluster C_Normed_Algebra_of_ContinuousFunctions X -> unital;
end;

theorem 
  for X being non empty compact TopSpace holds
  C_Normed_Algebra_of_ContinuousFunctions X is ComplexAlgebra;

registration
  let X be non empty compact TopSpace;
  cluster C_Normed_Algebra_of_ContinuousFunctions X -> right_complementable
  Abelian add-associative right_zeroed vector-distributive scalar-distributive
  scalar-associative associative commutative right-distributive right_unital
  vector-associative;
end;

theorem 
  for X being non empty compact TopSpace
  for F being Point of C_Normed_Algebra_of_ContinuousFunctions X holds
    (Mult_(CContinuousFunctions X,CAlgebra the carrier of X)).(1r,F) = F;

registration
  let X be non empty compact TopSpace;
  cluster C_Normed_Algebra_of_ContinuousFunctions X -> vector-distributive
    scalar-distributive scalar-associative scalar-unital;
end;

theorem 
  for X being non empty compact TopSpace holds
  C_Normed_Algebra_of_ContinuousFunctions X is ComplexLinearSpace;

theorem 
  for X being non empty compact TopSpace holds
  X --> 0 = 0.(C_Normed_Algebra_of_ContinuousFunctions X);

theorem 
  for X being non empty compact TopSpace
  for F being Point of C_Normed_Algebra_of_ContinuousFunctions X holds
               0 <= ||.F.||;

theorem 
  for X being non empty compact TopSpace
  for f, g, h being Function of the carrier of X,COMPLEX
  for F, G, H being Point of C_Normed_Algebra_of_ContinuousFunctions X st
    f = F & g = G & h = H holds
     (H = F+G iff for x being Element of X holds h.x=(f.x)+(g.x));

theorem 
  for a being Complex
  for X being non empty compact TopSpace
  for f, g being Function of the carrier of X,COMPLEX
  for F, G being Point of C_Normed_Algebra_of_ContinuousFunctions X st
              f = F & g = G holds
  (G = a*F iff for x being Element of X holds g.x = a*(f.x));

theorem 
  for X being non empty compact TopSpace
  for f, g, h being Function of the carrier of X,COMPLEX
  for F, G, H being Point of C_Normed_Algebra_of_ContinuousFunctions X st
              f = F & g = G & h = H holds
  ( H= F*G iff for x being Element of X holds h.x = (f.x)*(g.x));

theorem 
  for X being non empty compact TopSpace holds
  ||.0.C_Normed_Algebra_of_ContinuousFunctions X.|| = 0;

theorem 
  for X being non empty compact TopSpace
  for F being Point of C_Normed_Algebra_of_ContinuousFunctions X holds
  ||.F.|| = 0 implies F = 0.C_Normed_Algebra_of_ContinuousFunctions X;

theorem 
  for a being Complex
  for X being non empty compact TopSpace
  for F being Point of C_Normed_Algebra_of_ContinuousFunctions X holds
  ||.(a*F).|| = (abs a)*||.F.||;

theorem 
  for X being non empty compact TopSpace
  for F, G being Point of C_Normed_Algebra_of_ContinuousFunctions X holds
  ||.(F + G).|| <= ||.F.|| + ||.G.||;

registration
  let X be non empty compact TopSpace;
  cluster C_Normed_Algebra_of_ContinuousFunctions X ->
    discerning reflexive ComplexNormSpace-like;
end;

theorem 
  for X being non empty compact TopSpace
  for f, g, h being Function of the carrier of X,COMPLEX
  for F, G, H being Point of C_Normed_Algebra_of_ContinuousFunctions X st
    f = F & g = G & h = H holds
      ( H = F - G iff for x being Element of X holds h.x = (f.x)-(g.x));

theorem 
  for X being ComplexBanachSpace
  for Y being Subset of X
  for seq being sequence of X st Y is closed & rng seq c= Y
                                      & seq is CCauchy
   holds seq is convergent & lim seq in Y;

theorem 
  for X being non empty compact TopSpace
  for Y being Subset of (C_Normed_Algebra_of_BoundedFunctions the carrier of X)
          st Y = CContinuousFunctions X holds Y is closed;

theorem 
  for X being non empty compact TopSpace
  for seq being sequence of (C_Normed_Algebra_of_ContinuousFunctions X)
    st seq is CCauchy holds seq is convergent;

registration
  let X be non empty compact TopSpace;
  cluster C_Normed_Algebra_of_ContinuousFunctions X -> complete;
end;

registration
  let X be non empty compact TopSpace;
  cluster C_Normed_Algebra_of_ContinuousFunctions X -> Banach_Algebra-like;
end;



theorem 
  for X being non empty TopSpace
  for f,g being Function of the carrier of X,COMPLEX
                  holds support(f+g) c= support(f) \/ support(g);

theorem 
  for X being non empty TopSpace
  for a be Complex,f be Function of the carrier of X,COMPLEX
                      holds support(a(#)f) c= support(f);

theorem 
  for X being non empty TopSpace
  for f,g be Function of the carrier of X,COMPLEX
     holds support(f(#)g) c= support(f) \/ support(g);



definition
  let X be non empty TopSpace;
  func CC_0_Functions(X) -> non empty Subset of
                           ComplexVectSpace the carrier of X equals

  { f where f is Function of the carrier of X,COMPLEX : f is continuous &
    ex Y be non empty Subset of X st( Y is compact &
    (for A being Subset of X st A=support(f) holds Cl(A) is Subset of Y))};
end;

theorem 
  for X being non empty TopSpace
 holds CC_0_Functions(X) is non empty Subset of CAlgebra the carrier of X;

theorem 
  for X being non empty TopSpace
  for W be non empty Subset of CAlgebra the carrier of X
                                                 st W= CC_0_Functions X
         holds W is Cadditively-linearly-closed;

theorem 
  for X being non empty TopSpace holds
  CC_0_Functions X is add-closed;

theorem 
  for X being non empty TopSpace holds
  CC_0_Functions X is linearly-closed;

registration
  let X being non empty TopSpace;
  cluster CC_0_Functions X -> non empty linearly-closed;
end;

theorem 
  for V being ComplexLinearSpace
  for V1 being Subset of V st V1 is linearly-closed & not V1 is empty holds
  CLSStruct(# V1,(Zero_(V1,V)),(Add_ (V1,V)),(Mult_ (V1,V)) #) is Subspace of V
;

theorem 
  for X being non empty TopSpace holds
  CLSStruct (# CC_0_Functions X,
    Zero_(CC_0_Functions X, ComplexVectSpace(the carrier of X)),
    Add_(CC_0_Functions X, ComplexVectSpace(the carrier of X)),
    Mult_(CC_0_Functions X, ComplexVectSpace(the carrier of X)) #)
      is Subspace of ComplexVectSpace(the carrier of X);

definition
  let X be non empty TopSpace;
  func C_VectorSpace_of_C_0_Functions X -> ComplexLinearSpace equals

  CLSStruct (# CC_0_Functions X,
  Zero_(CC_0_Functions X, ComplexVectSpace(the carrier of X)),
  Add_(CC_0_Functions X, ComplexVectSpace(the carrier of X)),
  Mult_(CC_0_Functions X, ComplexVectSpace(the carrier of X)) #);
end;

theorem 
  for X be non empty TopSpace
  for x being set st x in CC_0_Functions(X) holds
  x in ComplexBoundedFunctions the carrier of X;

definition
  let X be non empty TopSpace;
  func CC_0_FunctionsNorm X -> Function of CC_0_Functions(X),REAL equals

  (ComplexBoundedFunctionsNorm the carrier of X)|(CC_0_Functions(X));
end;

definition
  let X be non empty TopSpace;
  func C_Normed_Space_of_C_0_Functions X -> CNORMSTR equals

  CNORMSTR (# CC_0_Functions X,
    Zero_(CC_0_Functions X, ComplexVectSpace(the carrier of X)),
    Add_(CC_0_Functions X, ComplexVectSpace(the carrier of X)),
    Mult_(CC_0_Functions X, ComplexVectSpace(the carrier of X)),
          CC_0_FunctionsNorm X #);
end;

registration
  let X be non empty TopSpace;
  cluster C_Normed_Space_of_C_0_Functions X -> strict non empty;
end;

theorem 
  for X be non empty TopSpace
  for x be set st x in CC_0_Functions(X) holds
    x in CContinuousFunctions X;

theorem 
  for X be non empty TopSpace holds
  0.C_VectorSpace_of_C_0_Functions X = X --> 0;

theorem 
  for X be non empty TopSpace holds
  0.C_Normed_Space_of_C_0_Functions X = X --> 0;

theorem 
  for a be Complex
  for X be non empty TopSpace
  for F,G be Point of C_Normed_Space_of_C_0_Functions(X) holds
  (||.F.|| = 0 iff F = 0.C_Normed_Space_of_C_0_Functions(X) ) &
  ||.a*F.|| = abs a * ||.F.|| & ||.F+G.|| <= ||.F.|| + ||.G.||;

registration
  let X be non empty TopSpace;
  cluster C_Normed_Space_of_C_0_Functions(X) -> reflexive discerning
  ComplexNormSpace-like vector-distributive scalar-distributive
  scalar-associative scalar-unital Abelian add-associative right_zeroed
  right_complementable;
end;

theorem 
  for X be non empty TopSpace holds
  C_Normed_Space_of_C_0_Functions(X) is ComplexNormSpace;














begin 

reserve x,X for set,
        r,r1,r2,s for real number,
        i,j,k,m,n for Nat;

theorem 
  for K be Field,M be Matrix of n,K
    for P be Permutation of Seg n holds
      Det((M*P)@*P)@ = Det M &
      for i,j st [i,j] in Indices M holds ((M*P)@*P)@*(i,j) = M*(P.i,P.j);

theorem 
  for K be Field for M be diagonal Matrix of n,K holds M@ = M;

theorem 
  for f be real-valued FinSequence
    for i st i in dom f holds Sum sqr(f+*(i,r)) = (Sum sqr f)-(f.i)^2+r^2;

definition
  let X;
  let F be Function-yielding Function;
  attr F is X -support-yielding means

    for f be Function,x st f in dom F & F.f.x <> f.x holds x in X;
end;

registration
  let X;
  cluster X-support-yielding for Function-yielding Function;
end;

registration
  let X;
  let Y be Subset of X;
  cluster Y-support-yielding -> X-support-yielding
    for Function-yielding Function;
end;

registration
  let X,Y be set;
  cluster X-support-yielding Y-support-yielding ->
             X/\Y-support-yielding for Function-yielding Function;
  let f be X-support-yielding Function-yielding Function;
  let g be Y-support-yielding Function-yielding Function;
  cluster f*g -> (X\/Y)-support-yielding;
end;

registration
  let n;
  cluster homogeneous for Function of TOP-REAL n,TOP-REAL n;
end;

registration
  let n,m;
  cluster -> FinSequence-yielding for Function of TOP-REAL n,TOP-REAL m;
end;

registration
  let n,m;
  let A be Matrix of n,m,F_Real;
  cluster Mx2Tran A -> additive;
end;

registration
  let n;
  let A be Matrix of n,F_Real;
  cluster Mx2Tran A -> homogeneous;
end;

registration
  let n;
  let f,g be homogeneous Function of TOP-REAL n,TOP-REAL n;
  cluster f*g -> homogeneous for Function of TOP-REAL n,TOP-REAL n;
end;

begin 

reserve p,q for Point of TOP-REAL n;

definition
  let n,i such that
   i in Seg n;
  func AxialSymmetry(i,n) -> invertible Matrix of n,F_Real means

   it*(i,i) = -1.F_Real &
   for k,m st[k,m] in Indices it holds
    (k = m & k <> i implies it*(k,k) = 1.F_Real) &
    (k <> m         implies it*(k,m) = 0.F_Real);
end;

theorem 
  i in Seg n implies Det AxialSymmetry(i,n) = -1.F_Real;

theorem 
  i in Seg n & j in Seg n & i<>j implies @p"*"Col(AxialSymmetry(i,n),j)=p.j;

theorem 
  i in Seg n implies @p"*"Col(AxialSymmetry(i,n),i) = -p.i;

theorem 
 i in Seg n implies AxialSymmetry(i,n) is diagonal &
   AxialSymmetry(i,n)~ = AxialSymmetry(i,n);

theorem 
  i in Seg n & i <> j implies (Mx2Tran AxialSymmetry(i,n)).p.j = p.j;

theorem 
  i in Seg n implies (Mx2Tran AxialSymmetry(i,n)).p.i = -p.i;

theorem 
  i in Seg n implies (Mx2Tran AxialSymmetry(i,n)).p = p+*(i,-p.i);

theorem 
  i in Seg n implies Mx2Tran AxialSymmetry(i,n) is {i}-support-yielding;

theorem 
  for a,b be Element of F_Real st a = cos r & b = sin r holds
    Det block_diagonal(<*(a,b)][(-b,a),1.(F_Real,n)*>,0.F_Real) = 1.F_Real;

begin 

definition
  let n,r;
  let i,j such that
   1 <= i & i < j & j <= n;
  func Rotation(i,j,n,r) -> invertible Matrix of n,F_Real means

    it*(i,i) = cos r & it*(j,j) = cos r &
    it*(i,j) = sin r & it*(j,i) =-sin r &
    for k,m st [k,m] in Indices it holds
       (k = m & k <> i & k <> j implies it*(k,k) = 1.F_Real) &
       (k <> m & {k,m} <> {i,j} implies it*(k,m) = 0.F_Real);
end;

theorem 
  1 <= i & i < j & j <= n implies Det Rotation(i,j,n,r)=1.F_Real;

theorem 
  1 <= i & i < j & j <= n & k in Seg n & k <> i & k <> j implies
    @p"*"Col(Rotation(i,j,n,r),k) = p.k;

theorem 
  1 <= i & i < j & j <= n implies
    @p"*"Col(Rotation(i,j,n,r),i) = p.i*(cos r)+p.j*(-sin r);

theorem 
  1 <= i & i < j & j <= n implies
    @p"*"Col(Rotation(i,j,n,r),j) = p.i*(sin r)+p.j*(cos r);

theorem 
 1 <= i & i < j & j <= n implies
   Rotation(i,j,n,r1)*Rotation(i,j,n,r2) = Rotation(i,j,n,r1+r2);

theorem 
 1 <= i & i < j & j <= n implies Rotation(i,j,n,0) = 1.(F_Real,n);

theorem 
  1 <= i & i < j & j <= n implies
    Rotation(i,j,n,r) is Orthogonal &
    Rotation(i,j,n,r)~ = Rotation(i,j,n,-r);

theorem 
  1 <= i & i < j & j <= n & k <> i & k <> j implies
   (Mx2Tran Rotation(i,j,n,r)).p.k=p.k;

theorem 
  1 <= i & i < j & j <= n implies
    (Mx2Tran Rotation(i,j,n,r)).p.i=p.i*(cos r)+p.j*(-sin r);

theorem 
  1 <= i & i < j & j <= n implies
    (Mx2Tran Rotation(i,j,n,r)).p.j=p.i*(sin r)+p.j*(cos r);

theorem 
 1 <= i & i < j & j <= n implies
   (Mx2Tran Rotation(i,j,n,r)).p=
     (p| (i-' 1)) ^ <*p.i*(cos r)+p.j*(-sin r)*> ^
     ((p/^i) | (j-' i-' 1)) ^ <*p.i*(sin r)+p.j*(cos r)*> ^ (p/^j);

theorem 
  1 <= i & i < j & j <= n & s^2 <= (p.i)^2+(p.j)^2 implies
    ex r st (Mx2Tran Rotation(i,j,n,r)).p.i = s;

theorem 
  1 <= i & i < j & j <= n & s^2 <= (p.i)^2+(p.j)^2 implies
    ex r st (Mx2Tran Rotation(i,j,n,r)).p.j = s;

theorem 
 1 <= i & i < j & j <= n implies
   Mx2Tran Rotation(i,j,n,r) is {i,j}-support-yielding;

begin 

definition
  let n;
  let f be Function of TOP-REAL n,TOP-REAL n;
  attr f is rotation means

    |.p.| = |.f.p.|;
end;

theorem 
  i in Seg n implies Mx2Tran AxialSymmetry(i,n) is rotation;

definition
  let n;
  let f be Function of TOP-REAL n,TOP-REAL n;
  attr f is base_rotation means

    ex F be FinSequence of GFuncs the carrier of TOP-REAL n st
    f = Product F &
    for k st k in dom F ex i,j,r st
      1 <= i & i < j & j <= n & F.k = Mx2Tran Rotation(i,j,n,r);
end;

registration
  let n;
  cluster id TOP-REAL n -> base_rotation;
end;

registration
  let n;
  cluster base_rotation for Function of TOP-REAL n,TOP-REAL n;
end;

registration
  let n;
  let f,g be base_rotation Function of TOP-REAL n,TOP-REAL n;
  cluster f*g -> base_rotation for Function of TOP-REAL n,TOP-REAL n;
end;

theorem 
 1 <= i & i < j & j <= n implies Mx2Tran Rotation(i,j,n,r) is base_rotation;

registration
  let n;
  cluster base_rotation -> homogeneous additive rotation being_homeomorphism
                             for Function of TOP-REAL n,TOP-REAL n;
end;

registration
  let n;
  let f be base_rotation Function of TOP-REAL n,TOP-REAL n;
  cluster f" -> base_rotation;
end;

registration
  let n;
  let f,g be rotation Function of TOP-REAL n,TOP-REAL n;
  cluster f*g -> rotation for Function of TOP-REAL n,TOP-REAL n;
end;

reserve f,f1,f2 for homogeneous additive Function of TOP-REAL n,TOP-REAL n;

definition
  let n;
  let f;
  func AutMt f -> Matrix of n,F_Real means

    f = Mx2Tran it;
end;

theorem 
  AutMt (f1*f2) = (AutMt f2) * (AutMt f1);

theorem 
  k in X & k in Seg n implies
    ex f st f is X-support-yielding base_rotation &
           (card (X/\Seg n) > 1 implies f.p.k>=0) &
           for i st i in X/\Seg n & i <> k holds f.p.i = 0;

theorem 
  for A be Subset of TOP-REAL n st f|A = id A holds f|Lin A = id Lin A;

theorem 
  for A be Subset of TOP-REAL n st f is rotation & f|A = id A
    for i st i in Seg n & Base_FinSeq(n,i) in Lin A holds f.p.i = p.i;

theorem 
  for f be rotation Function of TOP-REAL n,TOP-REAL n st
      f is X-support-yielding &
      for i st i in X/\Seg n holds p.i = 0
    holds f.p = p;

theorem 
  i in Seg n & n >= 2 implies ex f st f is base_rotation & f.p = p+*(i,-p.i);

theorem 
  f is {i}-support-yielding rotation implies
    AutMt f = AxialSymmetry(i,n) or AutMt f = 1.(F_Real,n);

theorem 
  f1 is rotation implies
    ex f2 st f2 is base_rotation & f2*f1 is {n}-support-yielding;

begin 

theorem 
  f is rotation implies
   (Det AutMt f = 1.F_Real iff f is base_rotation);

theorem 
  f is rotation implies
   (Det AutMt f = 1.F_Real or Det AutMt f = -1.F_Real);

theorem 
  f1 is rotation & Det AutMt f1 = -1.F_Real & i in Seg n &
  AutMt f2 = AxialSymmetry(i,n) implies f1*f2 is base_rotation;

registration
  let n;
  let f be rotation homogeneous additive Function of TOP-REAL n,TOP-REAL n;
  cluster AutMt f -> Orthogonal;
end;

registration
  let n;
  cluster homogeneous additive rotation -> being_homeomorphism for
    Function of TOP-REAL n,TOP-REAL n;
end;

begin 

theorem 
  n = 1 & |.p.| = |.q.| implies
    ex f st f is rotation & f.p=q &
           (AutMt f = AxialSymmetry(n,n) or AutMt f = 1.(F_Real,n));

theorem 
  n <> 1 & |.p.| = |.q.| implies ex f st f is base_rotation & f.p = q;















begin 

 reserve j for set;
 reserve p,r for Real;
 reserve S,T,F for non trivial RealNormSpace;
 reserve x0 for Point of S;
 reserve g for PartFunc of S,T;
 reserve c for constant sequence of S;
 reserve R for RestFunc of S,T;
 reserve G for RealNormSpace-Sequence;
 reserve i for Element of dom G;
 reserve f for PartFunc of product G,F;
 reserve x for Element of product G;

theorem 
for R be Function of REAL,S
  holds R is RestFunc-like
   iff for r be Real st r > 0 ex d be Real st d > 0 & for z be Real
         st z <> 0 & |. z .| < d holds |.z.|"* ||. R/.z .|| < r;

theorem 
  for R be RestFunc of S st R/.0=0.S
  for e be Real st e > 0 ex d be Real st
    d > 0 & for h be Real st |.h.| < d holds ||.R/.h.|| <= e*|.h.|;

theorem 
  for R be RestFunc of S
  for L be Lipschitzian LinearOperator of S,T holds
    L*R is RestFunc of T;

theorem 
  for R1 be RestFunc of S st R1/.0 = 0.S
  for R2 be RestFunc of S,T st R2/.(0.S) = 0.T
  for L be LinearFunc of S holds
    R2*(L+R1) is RestFunc of T;

theorem 
  for R1 be RestFunc of S st R1/.0=0.S
  for R2 be RestFunc of S,T st R2/.(0.S)=0.T
  for L1 be LinearFunc of S
  for L2 be Lipschitzian LinearOperator of S,T holds
    L2*R1 + R2*(L1+R1) is RestFunc of T;

theorem 
  for x0 be Element of REAL
  for g be PartFunc of REAL,the carrier of S st
    g is_differentiable_in x0
  for f be PartFunc of the carrier of S,the carrier of T st
    f is_differentiable_in (g/.x0) holds
  f*g is_differentiable_in x0 & diff(f*g,x0) = diff(f,g/.x0).diff(g,x0);

theorem 
for S be RealNormSpace,
    xseq be FinSequence of S,
    yseq be FinSequence of REAL st
 len xseq = len yseq &
 ( for i be Element of NAT st i in dom xseq holds
    yseq.i = ||. xseq/.i .|| )
  holds ||.Sum xseq.|| <= Sum yseq;

theorem 
for S be RealNormSpace, x be Point of S, N1,N2 be Neighbourhood of x holds
    N1/\ N2 is Neighbourhood of x;

theorem 
for X be non-empty FinSequence,
    x be set st x in product X holds x is FinSequence;

registration
  let G be RealNormSpace-Sequence;
  cluster product G -> constituted-FinSeqs;
end;

definition
  let G be RealLinearSpace-Sequence;
  let z be Element of product carr G;
  let j be Element of dom G;
  redefine func z.j -> Element of G.j;
end;

theorem 
  the carrier of product G = product carr G;

theorem 
for i be Element of dom G, r be set, x be Function
  st r in the carrier of (G.i) & x in product carr G
holds x +* (i,r) in the carrier of product G;

definition
  let G be RealNormSpace-Sequence;
  attr G is non-trivial means

  for j be Element of dom G holds G.j is non trivial;
end;

registration
  cluster non-trivial for RealNormSpace-Sequence;
end;

registration
  let G be non-trivial RealNormSpace-Sequence;
  let i be Element of dom G;
  cluster G.i -> non trivial for RealNormSpace;
end;

registration
  let G be non-trivial RealNormSpace-Sequence;
  cluster product G -> non trivial;
end;

theorem 
for G be RealNormSpace-Sequence, p,q be Point of product G,
    r0,p0,q0 be Element of product carr G st p=p0 & q=q0
holds p+q = r0
  iff for i be Element of dom G holds r0.i = p0.i + q0.i;

theorem 
for G be RealNormSpace-Sequence, p be Point of product G,
    r be Real, r0,p0 be Element of product carr G
  st p=p0
holds r*p = r0
  iff for i be Element of dom G holds r0.i = r*(p0.i);

theorem 
for G be RealNormSpace-Sequence, p0 be Element of product carr G
holds 0.(product G)=p0
  iff for i be Element of dom G holds p0.i = 0.(G.i);

theorem 
for G be RealNormSpace-Sequence, p,q be Point of product G,
    r0,p0,q0 be Element of product carr G
  st p=p0 & q=q0
holds p-q = r0
  iff for i be Element of dom G holds r0.i = p0.i - q0.i;

begin 

definition
  let S be RealLinearSpace;
  let p,q be Point of S;
  func ]. p,q .[ -> Subset of S equals

    { p+t*(q-p) where t is Real : 0 < t & t < 1};
end;

notation
  let S be RealLinearSpace;
  let p,q be Point of S;
  synonym [.p,q.] for LSeg(p,q);
end;

theorem 
for S be RealLinearSpace, p,q be Point of S
  holds ].p,q.[ c= [. p,q .];

theorem 
  for T be non trivial RealNormSpace, R be PartFunc of REAL,T
   st R is total holds
     R is RestFunc-like
  iff for r be Real st r > 0
      ex d be Real st d > 0 & for z be Real
        st z <> 0 & abs z < d holds ( ||. R/.z .||/ abs z ) < r;

theorem 
  for R be Function of REAL,REAL holds R is RestFunc-like iff
  for r be Real st r > 0 ex d be Real st d > 0 & for z be Real
     st z <> 0 & abs(z) < d holds (abs(R.z)/ abs(z)) < r;

theorem 
for S,T be non trivial RealNormSpace,
    f be PartFunc of S,T, p,q be Point of S, M be Real
  st [.p,q.] c= dom f
   & (for x be Point of S st x in [.p,q.] holds f is_continuous_in x)
   & (for x be Point of S st x in ].p,q.[ holds f is_differentiable_in x)
   & (for x be Point of S st x in ].p,q.[ holds ||. diff(f,x) .|| <= M)
holds ||. f/.q - f/.p .|| <= M*||. q-p .||;

theorem 
for S,T be non trivial RealNormSpace, f be PartFunc of S,T,
    p,q be Point of S, M be Real,
    L be Point of R_NormSpace_of_BoundedLinearOperators(S,T)
  st [.p,q.] c= dom f
   & (for x be Point of S st x in [.p,q.] holds f is_continuous_in x)
   & (for x be Point of S st x in ].p,q.[ holds f is_differentiable_in x)
   & (for x be Point of S st x in ].p,q.[ holds ||. diff(f,x) - L .|| <= M)
holds ||. f/.q - f/.p -L.(q-p).|| <= M*||. q-p .||;

begin 

definition
  let G be RealNormSpace-Sequence;
  let i be Element of dom G;
  func proj i -> Function of product G,G.i means

 for x be Element of product carr G holds it.x = x.i;
end;

definition
  let G be RealNormSpace-Sequence;
  let i be Element of dom G;
  let x be Element of product G;
  func reproj(i,x) -> Function of G.i,product G means

  for r be Element of G.i holds it.r = x +* (i,r);
end;

definition
  let G be non-trivial RealNormSpace-Sequence;
  let j be set;
  assume  j in dom G;
  func modetrans(G,j) -> Element of dom G equals

   j;
end;

definition
  let G be non-trivial RealNormSpace-Sequence;
  let F be non trivial RealNormSpace;
  let i be set;
  let f be PartFunc of product G,F;
  let x being Element of product G;
  pred f is_partial_differentiable_in x,i means

  f*reproj(modetrans(G,i),x) is_differentiable_in proj(modetrans(G,i)).x;
end;

definition
  let G be non-trivial RealNormSpace-Sequence;
  let F be non trivial RealNormSpace;
  let i be set;
  let f be PartFunc of product G,F;
  let x be Point of product G;
 func partdiff(f,x,i)
       -> Point of R_NormSpace_of_BoundedLinearOperators(G.modetrans(G,i),F)
    equals

 diff(f*reproj(modetrans(G,i),x),proj(modetrans(G,i)).x);
end;

begin 

reserve G for non-trivial RealNormSpace-Sequence;
reserve F for non trivial RealNormSpace;
reserve i for Element of dom G;
reserve f,f1,f2 for PartFunc of product G, F;
reserve x for Point of product G;
reserve X for set;

definition
  let G be non-trivial RealNormSpace-Sequence;
  let F be non trivial RealNormSpace;
  let i be set;
  let f be PartFunc of product G,F;
  let X be set;
  pred f is_partial_differentiable_on X,i means

  X c= dom f & for x be Point of product G st x in X
    holds f|X is_partial_differentiable_in x,i;
end;

theorem 
for xi be Element of G.i
  holds ||. reproj(i,0.(product G)).xi .|| = ||.xi.||;

theorem 
for G be non-trivial RealNormSpace-Sequence,
    i be Element of dom G,
    x be Point of product G,
    r be Point of G.i holds
  reproj(i,x).r - x = reproj(i,0.(product G)).(r - proj(i).x) &
  x - reproj(i,x).r = reproj(i,0.(product G)).(proj(i).x - r);

theorem 
for G be non-trivial RealNormSpace-Sequence,
    i be Element of dom G,
    x be Point of product G,
    Z be Subset of product G
      st Z is open & x in Z holds
ex N be Neighbourhood of proj(i).x st
  for z be Point of G.i st z in N holds (reproj(i,x)).z in Z;

theorem 
 for G be non-trivial RealNormSpace-Sequence,
     T be non trivial RealNormSpace,
     i be set,
     f be PartFunc of product G, T,
     Z be Subset of product G
       st Z is open holds
   f is_partial_differentiable_on Z,i
iff
   Z c=dom f &
   for x be Point of product G st x in Z holds
     f is_partial_differentiable_in x,i;

theorem 
for i be set st i in dom G & f is_partial_differentiable_on X,i
  holds X is Subset of product G;

definition
  let G be non-trivial RealNormSpace-Sequence;
  let S be non trivial RealNormSpace;
  let i be set;
  assume  i in dom G;
  let f be PartFunc of product G, S;
  let X be set;
  assume  f is_partial_differentiable_on X,i;
 func f `partial|(X,i) -> PartFunc of product G,
  R_NormSpace_of_BoundedLinearOperators(G.modetrans(G,i),S) means


  dom it = X &
  for x be Point of product G st x in X holds it/.x = partdiff(f,x,i);
end;

theorem 
for i be set st i in dom G holds
  (f1+f2)*reproj(modetrans(G,i),x) = f1*reproj(modetrans(G,i),x)
                                    +f2*reproj(modetrans(G,i),x)
& (f1-f2)*reproj(modetrans(G,i),x) = f1*reproj(modetrans(G,i),x)
                            -f2*reproj(modetrans(G,i),x);

theorem 
for i be set st i in dom G holds
  r(#)(f*reproj(modetrans(G,i),x)) = (r(#)f)*reproj(modetrans(G,i),x);

theorem 
for i be set st i in dom G
  & f1 is_partial_differentiable_in x,i
  & f2 is_partial_differentiable_in x,i
  holds f1+f2 is_partial_differentiable_in x,i
   & partdiff(f1+f2,x,i)=partdiff(f1,x,i)+partdiff(f2,x,i);

theorem 
for i be set st i in dom G
  & f1 is_partial_differentiable_in x,i
  & f2 is_partial_differentiable_in x,i
 holds f1-f2 is_partial_differentiable_in x,i
     & partdiff(f1-f2,x,i)=partdiff(f1,x,i)-partdiff(f2,x,i);

theorem 
for i be set st i in dom G
  & f is_partial_differentiable_in x,i
 holds r(#)f is_partial_differentiable_in x,i & partdiff((r(#)f),x,i)
          = r*partdiff(f,x,i);

begin 

theorem 
 ||. proj(i).x .|| <= ||.x.||;

registration
  let G be non-trivial RealNormSpace-Sequence;
  cluster -> (len G)-element for Point of product G;
end;

theorem 
for G be non-trivial RealNormSpace-Sequence,
    T be non trivial RealNormSpace,
    i be set,
    Z be Subset of product G,
    f be PartFunc of product G,T
      st Z is open holds
  f is_partial_differentiable_on Z,i
      iff
  Z c=dom f &
  for x be Point of product G st x in Z holds
    f is_partial_differentiable_in x,i;

theorem 
 for i,j be Element of dom G,
     x be Point of G.i,
     z be Element of product carr G
      st z= reproj(i,0.(product G)).x
holds
  (i = j implies z.j = x) & (i <> j implies z.j = 0.(G.j));

theorem 
for x,y be Point of G.i
 holds reproj(i,0.(product G)).(x+y)
   = reproj(i,0.(product G)).x + reproj(i,0.(product G)).y;

theorem 
for x,y be Point of product G
 holds proj(i).(x+y) = proj(i).x + proj(i).y;

theorem 
for x,y be Point of G.i
 holds reproj(i,0.(product G)).(x-y)
   = reproj(i,0.(product G)).x - reproj(i,0.(product G)).y;

theorem 
for x,y be Point of product G
 holds proj(i).(x-y) = proj(i).x - proj(i).y;

theorem 
for x be Point of G.i st x <> 0.(G.i)
 holds reproj(i,0.(product G)).x <> 0.(product G);

theorem 
for x be Point of G.i, a be Element of REAL
 holds reproj(i,0.(product G)).(a*x)
   = a*(reproj(i,0.(product G)).x);

theorem 
for x be Point of product G,a be Element of REAL
 holds proj(i).(a*x) = a*(proj(i).x);

theorem 
 for G be non-trivial RealNormSpace-Sequence,
      S be non trivial RealNormSpace,
      f be PartFunc of product G, S,
      x be Point of product G,
      i be set
  st f is_differentiable_in x holds
    f is_partial_differentiable_in x,i
  & partdiff(f,x,i) = diff(f,x) * reproj(modetrans(G,i),0.(product G));

theorem 
for S be RealNormSpace, h,g be FinSequence of S
    st  len h = len g + 1 &
       (for i be Nat st i in dom g holds g/.i = h /.i - h/.(i+1)) holds
   h /.1 - h/.(len h) = Sum g;

theorem 
for G be non-trivial RealNormSpace-Sequence,
    x,y be Element of product carr G, Z be set
 holds x +* (y|Z) is Element of product carr G;

theorem 
for G be non-trivial RealNormSpace-Sequence,
    x,y be Point of product G,
    Z,x0 be Element of product carr G,
    X be set
  st Z=0.(product G) & x0=x & y= Z +* (x0|X)
 holds ||.y.|| <= ||.x.||;

theorem 
for G be non-trivial RealNormSpace-Sequence,
      S be non trivial RealNormSpace,
      f be PartFunc of product G, S,
      x,y be Point of product G
ex h be FinSequence of product G, g be FinSequence of S,
    Z,y0 be Element of product carr G st
    y0=y & Z = 0.(product G)
   & len h = len G + 1 & len g = len G  &
  (for i be Nat st i in dom h holds h/.i = Z +* (y0| Seg (len G + 1-'i))) &
  (for i be Nat st i in dom g holds g/.i = f/.(x+h/.i) - f/.(x+h/.(i+1))) &
  (for i be Nat, hi be Point of product G st
    i in dom h & h/.i= hi holds ||. hi .|| <=||. y .||) &
  f /.(x+y) - f/.x = Sum g;

theorem 
for G be non-trivial RealNormSpace-Sequence,
    i be Element of dom G,
    x,y be Point of product G,
    xi be Point of G.i
  st y = reproj(i,x).xi holds proj(i).y = xi;

theorem 
for G be non-trivial RealNormSpace-Sequence, i be Element of dom G,
    y be Point of product G, q be Point of G.i
  st q = proj(i).y holds y = reproj(i,y).q;

theorem 
for G be non-trivial RealNormSpace-Sequence,
    i be Element of dom G, x,y be Point of product G,
    xi be Point of G.i
  st y = reproj(i,x).xi holds reproj(i,x)=reproj(i,y);

theorem 
for G be non-trivial RealNormSpace-Sequence,
    i,j be Element of dom G, x,y be Point of product G,
    xi be Point of G.i
  st y = reproj(i,x).xi & i <> j holds proj(j).x = proj(j).y;

theorem 
for  G be non-trivial RealNormSpace-Sequence,
     F be non trivial RealNormSpace,
     i be Element of dom G,
     x be Point of product G,
     xi be Point of G.i,
     f be PartFunc of product G,F,
     g be PartFunc of G.i,F
      st proj(i).x=xi & g=f*reproj(i,x)
 holds
    diff(g,xi) = partdiff(f,x,i);

theorem 
for G be non-trivial RealNormSpace-Sequence,
    F be non trivial RealNormSpace,
    f be PartFunc of product G,F,
    x be Point of product G,
    i be set,
    M be Real,
    L be Point of R_NormSpace_of_BoundedLinearOperators
             (G.(modetrans(G,i)),F),
    p,q be Point of G.(modetrans(G,i))
 st i in dom G
  & (for h be Point of G.(modetrans(G,i)) st h in ]. p,q .[ holds
       ||. partdiff(f,reproj(modetrans(G,i),x).h,i) - L  .|| <= M)
  & (for h be Point of G.(modetrans(G,i)) st h in [. p,q .] holds
       reproj(modetrans(G,i),x).h in dom f)
  & (for h be Point of G.(modetrans(G,i)) st h in [. p,q .] holds
       f is_partial_differentiable_in (reproj(modetrans(G,i),x).h),i)
holds
 ||.f/.(reproj(modetrans(G,i),x).q) - f/.(reproj(modetrans(G,i),x).p)
     - L.(q-p) .|| <= M * ||.q-p.||;

theorem 
for G be non-trivial RealNormSpace-Sequence,
    x,y,z,w be Point of product G,
    i be Element of dom G,
    d be Real,
    p,q,r be Point of G.i
  st ||. y-x .|| < d & ||. z-x .|| < d & p= proj(i).y & z=reproj(i,y).q
   & r in [. p,q .] & w= reproj(i,y).r
holds ||. w-x .|| < d;

theorem 
for G be non-trivial RealNormSpace-Sequence,
    S be non trivial RealNormSpace,
    f be PartFunc of product G,S,
    X be Subset of product G,
    x,y,z be Point of product G,
    i be set,
    p,q be Point of G.(modetrans(G,i)),
    d,r be Real
 st i in dom G & X is open & x in X &
    ||. y-x .|| < d & ||. z-x .|| < d & X c= dom f &
    (for x be Point of product G st x in X holds
      f is_partial_differentiable_in x,i) &
    (for z be Point of product G st ||. z-x .|| < d holds z in X) &
    (for z be Point of product G st ||. z-x .|| < d
        holds ||. partdiff(f,z,i) - partdiff(f,x,i).|| <=r) &
    z = reproj(modetrans(G,i),y).p & q = proj(modetrans(G,i)).y
holds
   ||. f/.z - f/.y - ((partdiff(f,x,i)).(p-q)) .|| <= ||. p-q .||*r;

theorem 
for G be non-trivial RealNormSpace-Sequence,
    h be FinSequence of product G,
    y,x be Point of product G,
    y0,Z be Element of product carr G,
     j be Element of NAT
  st y=y0 & Z=0.(product G)
    & len h = (len G)+1 & 1 <= j & j <= len G &
  (for i be Nat st i in dom h holds h/.i=Z +* (y0| Seg (len G + 1-'i)))
  holds x + h/.j = reproj(modetrans(G,(len G)+1-'j),(x+h/.(j+1)))
         .(proj(modetrans(G,(len G)+1-'j)).(x+y));

theorem 
for G be non-trivial RealNormSpace-Sequence,
    h be FinSequence of product G,
    y,x be Point of product G,
    y0,Z be Element of product carr G,
    j be Element of NAT
  st y=y0 & Z=0.(product G)
    & len h = (len G)+1 & 1 <= j & j <= len G &
  (for i be Nat st i in dom h holds h/.i=Z +* (y0| Seg (len G + 1-'i)))
  holds
 (proj(modetrans(G,(len G)+1-'j)).(x+y))
- proj(modetrans(G,(len G)+1-'j)).(x+h/.(j+1))
 = (proj(modetrans(G,(len G)+1-'j)).y);

theorem 
for G be non-trivial RealNormSpace-Sequence,
    S be non trivial RealNormSpace,
    f be PartFunc of product G, S,
    X be Subset of product G,
    x be Point of product G
 st X is open & x in X &
    (for i be set st i in dom G holds
      f is_partial_differentiable_on X,i & f`partial|(X,i) is_continuous_on X)
 holds
  f is_differentiable_in x & for h be Point of product G
   ex w be FinSequence of S st
    dom w = dom G &
    (for i be set st i in dom G holds
          w.i = partdiff(f,x,i).(proj(modetrans(G,i)).h))
  & diff(f,x).h = Sum w;

theorem 
for G be non-trivial RealNormSpace-Sequence,
    F be non trivial RealNormSpace,
    f be PartFunc of product G, F,
    X be Subset of product G
 st X is open holds
  (for i be set st i in dom G holds
     f is_partial_differentiable_on X,i & f`partial|(X,i) is_continuous_on X)
iff
  f is_differentiable_on X & f`|X is_continuous_on X;














begin 

registration
  cluster {} -> {}-valued;
  cluster {} -> onto;
end;

theorem 
  for f being Function, Y being set holds dom(Y|`f) = f"Y;

theorem 
  for f being Function, Y1,Y2 being set st Y2 c= Y1 holds (Y1|`f)"Y2 = f"Y2;



theorem 
  for S,T being TopStruct, f being Function of S,T holds
  f is being_homeomorphism implies f" is being_homeomorphism;

definition
  let S,T be TopStruct;
  redefine pred S,T are_homeomorphic;
  symmetry;
end;

reserve T1,T2,T3 for TopSpace,
  A1 for Subset of T1, A2 for Subset of T2, A3 for Subset of T3;



theorem 
  for f be Function of T1,T2 st f is being_homeomorphism
  for g be Function of T1|f"A2,T2|A2 st g = A2|`f
  holds g is being_homeomorphism;

theorem 
  for f be Function of T1,T2 st f is being_homeomorphism holds
  f"A2,A2 are_homeomorphic;

theorem 
  A1,A2 are_homeomorphic implies A2,A1 are_homeomorphic;

theorem 
  A1,A2 are_homeomorphic implies (A1 is empty iff A2 is empty);

theorem 
  A1,A2 are_homeomorphic & A2,A3 are_homeomorphic
  implies A1,A3 are_homeomorphic;

theorem 
  T1 is second-countable & T1,T2 are_homeomorphic
  implies T2 is second-countable;

reserve n,k for Nat;
reserve M,N for non empty TopSpace;

theorem 
  M is Hausdorff & M,N are_homeomorphic implies N is Hausdorff;

theorem 
  M is n-locally_euclidean & M,N are_homeomorphic implies
  N is n-locally_euclidean;

theorem 
  M is n-manifold & M,N are_homeomorphic implies N is n-manifold;



theorem 
  for x1,x2 being FinSequence of REAL,i being Element of NAT
  st i in dom mlt(x1,x2)
  holds mlt(x1,x2).i = (x1/.i)*(x2/.i) & (mlt(x1,x2))/.i=(x1/.i)*(x2/.i);

theorem 
  for x1,x2,y1,y2 being FinSequence of REAL st len x1=len x2 & len y1=len y2
  holds mlt(x1^y1,x2^y2)=(mlt(x1,x2))^(mlt(y1,y2));

theorem 
  for x1,x2,y1,y2 being FinSequence of REAL st len x1=len x2 & len y1=len y2
  holds |( x1^y1, x2^y2 )| = |(x1,x2)| + |(y1,y2)|;

reserve p,q,p1,p2 for Point of TOP-REAL n;
reserve r for real number;

theorem 
  k in Seg n implies (p1+p2).k = p1.k + p2.k;



theorem 
  for X being set holds
  X is Linear_Combination of RealVectSpace(Seg n)
iff
  X is Linear_Combination of TOP-REAL n;

theorem 
  for F be FinSequence of TOP-REAL n,
      fr be Function of TOP-REAL n,REAL,
      Fv be FinSequence of RealVectSpace(Seg n),
      fv be Function of RealVectSpace(Seg n),REAL st fr = fv & F = Fv
  holds fr(#)F = fv(#)Fv;

theorem 
  for F be FinSequence of TOP-REAL n,
      Fv be FinSequence of RealVectSpace(Seg n) st Fv = F
  holds Sum F = Sum Fv;

theorem 
  for Lv be Linear_Combination of RealVectSpace(Seg n),
      Lr be Linear_Combination of TOP-REAL n st Lr = Lv
  holds Sum Lr = Sum Lv;

theorem 
  for Af be Subset of RealVectSpace(Seg n),
      Ar be Subset of TOP-REAL n st Af = Ar
  holds Af is linearly-independent iff Ar is linearly-independent;

theorem 
  for V being Subset of TOP-REAL n st V = RN_Base n holds
  ex l being Linear_Combination of V st p = Sum l;

theorem 
  RN_Base n is Basis of TOP-REAL n;

theorem 
  for V being Subset of TOP-REAL n holds
  V in the topology of TOP-REAL n iff
  for p st p in V ex r st r > 0 & Ball(p,r) c= V;

definition
  let n be Nat;
  let p be Point of TOP-REAL n;
  func InnerProduct(p) -> Function of TOP-REAL n,R^1 means

  for q being Point of TOP-REAL n holds it.q = |(p,q)|;
end;

registration
  let n,p;
  cluster InnerProduct(p) -> continuous;
end;

begin 

definition
  let n;
  let p,q;
  func Plane(p,q) -> Subset of TOP-REAL n equals

  {y where y is Point of TOP-REAL n: |( p,y-q )| = 0 };
end;

theorem 
  transl(p1,TOP-REAL n) .: Plane(p,p2) = Plane(p,p1+p2);

theorem 
  p <> 0.TOP-REAL n implies
  ex A being linearly-independent Subset of TOP-REAL n
  st card A = n - 1 & [#]Lin(A) = Plane(p,0.TOP-REAL n);

theorem 
  p1<>0.TOP-REAL n & p2<>0.TOP-REAL n implies
  ex R being Function of TOP-REAL n, TOP-REAL n st R is being_homeomorphism &
  R .: Plane(p1,0.TOP-REAL n) = Plane(p2,0.TOP-REAL n);

definition
  let n;
  let p,q;
  func TPlane(p,q) -> non empty SubSpace of TOP-REAL n equals

   (TOP-REAL n) | Plane(p,q);
end;

theorem 
  Base_FinSeq(n+1,n+1) = (0.TOP-REAL n) ^ <* 1 *>;

theorem 
  for p,q being Point of TOP-REAL(n+1) st p<>0.TOP-REAL(n+1)
  holds TOP-REAL n, TPlane(p,q) are_homeomorphic;

theorem 
  for p,q being Point of TOP-REAL(n+1) st p<>0.TOP-REAL(n+1)
  holds TPlane(p,q) is n-manifold;

begin 

definition
  let n;
  func TUnitSphere(n) -> TopSpace equals

  Tunit_circle(n+1);
end;

registration
  let n;
  cluster TUnitSphere(n) -> non empty;
end;


definition
  let n,p;
  let S be SubSpace of TOP-REAL n;
  assume  p in Sphere(0.TOP-REAL n,1);
  func stereographic_projection(S,p) ->
    Function of S, TPlane(p,0.TOP-REAL n) means

    for q st q in S holds it.q = 1/(1-|(q,p)|)*(q - |(q,p)|*p);
end;

theorem 
  for S being SubSpace of TOP-REAL n
  st [#]S = Sphere(0.TOP-REAL n,1) \ {p} & p in Sphere(0.TOP-REAL n,1)
  holds stereographic_projection(S,p) is being_homeomorphism;

registration
  let n;
  cluster TUnitSphere(n) -> second-countable;
  cluster TUnitSphere(n) -> n-locally_euclidean;
  cluster TUnitSphere(n) -> n-manifold;
end;














begin 

definition
  struct (addLoopStr) Z_ModuleStruct
    (# carrier -> set,
         ZeroF -> Element of the carrier,
          addF -> BinOp of the carrier,
          Mult -> Function of [:INT, the carrier :], the carrier #);
end;

registration
  cluster non empty for Z_ModuleStruct;
end;

definition
  let V be Z_ModuleStruct;
  mode VECTOR of V is Element of V;
end;

reserve V for non empty Z_ModuleStruct;
reserve x, y, y1 for set;
reserve a, b for integer number;
reserve v for VECTOR of V;

definition
  let V,v;
  let a be integer number;
  func a * v -> Element of V equals

  (the Mult of V).(a,v);
end;

registration
  let ZS be non empty set, O be Element of ZS, F be BinOp of ZS,
      G be Function of [:INT,ZS:],ZS;
  cluster Z_ModuleStruct (# ZS,O,F,G #) -> non empty;
end;

definition
  let IT be non empty Z_ModuleStruct;
  attr IT is vector-distributive means

  for a for v,w being VECTOR of IT holds a * (v + w) = a * v + a * w;
  attr IT is scalar-distributive means

  for a,b for v being VECTOR of IT holds (a + b) * v = a * v + b * v;
  attr IT is scalar-associative means

  for a,b for v being VECTOR of IT holds (a * b) * v = a * (b * v);
  attr IT is scalar-unital means

  for v being VECTOR of IT holds 1 * v = v;
end;

definition
  func Trivial-Z_ModuleStruct -> strict Z_ModuleStruct equals

  Z_ModuleStruct(#1,op0,op2,pr2(INT,1)#);
end;

registration
  cluster Trivial-Z_ModuleStruct -> trivial non empty;
end;

registration
  cluster strict Abelian add-associative right_zeroed right_complementable
  scalar-distributive vector-distributive scalar-associative scalar-unital
  for non empty Z_ModuleStruct;
end;

definition
  mode Z_Module is Abelian add-associative right_zeroed
    right_complementable scalar-distributive vector-distributive
    scalar-associative scalar-unital non empty Z_ModuleStruct;
end;

reserve V for Z_Module;
reserve v, w for VECTOR of V;

definition
  let IT be non empty Z_ModuleStruct;
  attr IT is Mult-cancelable means

  for a for v being VECTOR of IT st a * v = 0.IT
  holds a = 0 or v = 0.IT;
end;

theorem 
  a = 0 or v = 0.V implies a * v = 0.V;

theorem 
  - v = (- 1) * v;

theorem 
  V is Mult-cancelable & v = - v implies v = 0.V;

theorem 
  V is Mult-cancelable & v + v = 0.V implies v = 0.V;

theorem 
  a * (- v) = (- a) * v;

theorem 
  a * (- v) = - (a * v);

theorem 
  (- a) * (- v) = a * v;

theorem 
  a * (v - w) = a * v - a * w;

theorem 
  (a - b) * v = a * v - b * v;

theorem 
  V is Mult-cancelable &
  a <> 0 & a * v = a * w implies v = w;

theorem 
  V is Mult-cancelable & v <> 0.V & a * v = b * v implies a = b;

reserve V for Z_Module;
reserve u,v,w for VECTOR of V;
reserve F,G,H,I for FinSequence of V;
reserve j,k,n for Element of NAT;
reserve f,f9,g for Function of NAT, the carrier of V;

theorem 
  len F = len G & (for k,v st k in dom F & v = G.k holds F.k = a * v)
  implies Sum(F) = a * Sum(G);

theorem 
  for V being Z_Module, a being Integer holds
  a * Sum(<*>(the carrier of V)) = 0.V;

theorem 
  for V being Z_Module, a being Integer, v, u being VECTOR of V holds
  a * Sum<* v,u *> = a * v + a * u;

theorem 
  for V being Z_Module, a being Integer, v, u, w being VECTOR of V
  holds a * Sum<* v,u,w *> = a * v + a * u + a * w;

theorem 
  (- a) * v = - a * v;

theorem 
  len F = len G & (for k st k in dom F holds G.k = a * F/.k )
  implies Sum(G) = a * Sum(F);

begin 

reserve V, X, Y for Z_Module;
reserve u, u1, u2, v, v1, v2 for VECTOR of V;
reserve a for integer number;
reserve V1, V2, V3 for Subset of V;
reserve x for set;

definition
  let V,V1;
  attr V1 is linearly-closed means

  (for v, u st v in V1 & u in V1 holds v + u in V1) &
  for a, v st v in V1 holds a * v in V1;
end;

theorem 
  V1 <> {} & V1 is linearly-closed implies 0.V in V1;

theorem 
  V1 is linearly-closed implies for v st v in V1 holds - v in V1;

theorem 
  V1 is linearly-closed implies for v, u st v in V1 & u in V1 holds v - u in V1
;

theorem 
  the carrier of V = V1 implies V1 is linearly-closed;

theorem 
  V1 is linearly-closed & V2 is linearly-closed &
  V3 = {v + u : v in V1 & u in V2} implies V3 is linearly-closed;

registration let V;
 cluster {0.V} -> linearly-closed for Subset of V;
end;

registration let V;
 cluster linearly-closed for Subset of V;
end;

registration let V;
 let V1,V2 be linearly-closed Subset of V;
 cluster V1 /\ V2 -> linearly-closed for Subset of V;
end;

definition
  let V;
  mode Submodule of V -> Z_Module means

  the carrier of it c= the carrier of V & 0.it = 0.V
  & the addF of it = (the addF of V) ||the carrier of it
  & the Mult of it = (the Mult of V) | [:INT, the carrier of it:];
end;

reserve W, W1, W2 for Submodule of V;
reserve w, w1, w2 for VECTOR of W;

theorem 
  x in W1 & W1 is Submodule of W2 implies x in W2;

theorem 
  x in W implies x in V;

theorem 
  w is VECTOR of V;

theorem 
  0.W = 0.V;

theorem 
  0.W1 = 0.W2;

theorem 
  w1 = v & w2 = u implies w1 + w2 = v + u;

theorem 
  w = v implies a * w = a * v;

theorem 
  w = v implies - v = - w;

theorem 
  w1 = v & w2 = u implies w1 - w2 = v - u;

theorem 
  V is Submodule of V;

theorem 
  0.V in W;

theorem 
  0.W1 in W2;

theorem 
  0.W in V;

theorem 
  u in W & v in W implies u + v in W;

theorem 
  v in W implies a * v in W;

theorem 
  v in W implies - v in W;

theorem 
  u in W & v in W implies u - v in W;

reserve D for non empty set;
reserve d1 for Element of D;
reserve A for BinOp of D;
reserve M for Function of [:INT,D:],D;

theorem 
  V1 = D & d1 = 0.V & A = (the addF of V) ||V1 &
  M = (the Mult of V) | [:INT,V1:] implies Z_ModuleStruct (# D,d1,A,M #)
  is Submodule of V;

theorem 
  for V,X being strict Z_Module st V is Submodule of X &
  X is Submodule of V holds V = X;

theorem 
  V is Submodule of X & X is Submodule of Y implies V is Submodule of Y;

theorem 
  the carrier of W1 c= the carrier of W2 implies W1 is Submodule of W2;

theorem 
  (for v st v in W1 holds v in W2) implies W1 is Submodule of W2;

registration
  let V;
  cluster strict for Submodule of V;
end;

theorem 
  for W1, W2 being strict Submodule of V holds
  the carrier of W1 = the carrier of W2 implies W1 = W2;

theorem 
  for W1, W2 being strict Submodule of V holds
  (for v holds v in W1 iff v in W2) implies W1 = W2;

theorem 
  for V being strict Z_Module, W being strict Submodule of V holds
  the carrier of W = the carrier of V implies W = V;

theorem 
  for V being strict Z_Module, W being strict Submodule of V holds
  (for v being VECTOR of V holds v in W iff v in V) implies W = V;

theorem 
  the carrier of W = V1 implies V1 is linearly-closed;

theorem 
  V1 <> {} & V1 is linearly-closed implies ex W being strict
  Submodule of V st V1 = the carrier of W;

definition
  let V;
  func (0).V -> strict Submodule of V means

  the carrier of it = {0.V};
end;

definition
  let V;
  func (Omega).V -> strict Submodule of V equals

  the Z_ModuleStruct of V;
end;

theorem 
  (0).W = (0).V;

theorem 
  (0).W1 = (0).W2;

theorem 
  (0).W is Submodule of V;

theorem 
  (0).V is Submodule of W;

theorem 
  (0).W1 is Submodule of W2;

theorem 
  for V being strict Z_Module holds V is Submodule of (Omega).V;

definition
  let V,v,W;
  func v + W -> Subset of V equals

  {v + u : u in W};
end;

definition
  let V,W;
  mode Coset of W -> Subset of V means

  ex v st it = v + W;
end;

reserve B,C for Coset of W;

theorem 
  0.V in v + W iff v in W;

theorem 
  v in v + W;

theorem 
  0.V + W = the carrier of W;

theorem 
  v + (0).V = {v};

theorem 
  v + (Omega).V = the carrier of V;

theorem 
  0.V in v + W iff v + W = the carrier of W;

theorem 
  v in W iff v + W = the carrier of W;

theorem 
  v in W implies (a * v) + W = the carrier of W;

theorem 
  u in W iff v + W = (v + u) + W;

theorem 
  u in W iff v + W = (v - u) + W;

theorem 
  v in u + W iff u + W = v + W;

theorem 
  u in v1 + W & u in v2 + W implies v1 + W = v2 + W;

theorem 
  v in W implies a * v in v + W;

theorem 
  u + v in v + W iff u in W;

theorem 
  v - u in v + W iff u in W;

theorem 
  u in v + W iff ex v1 st v1 in W & u = v + v1;

theorem 
  u in v + W iff ex v1 st v1 in W & u = v - v1;

theorem 
  (ex v st v1 in v + W & v2 in v + W) iff v1 - v2 in W;

theorem 
  v + W = u + W implies ex v1 st v1 in W & v + v1 = u;

theorem 
  v + W = u + W implies ex v1 st v1 in W & v - v1 = u;

theorem 
  for W1, W2 being strict Submodule of V st v + W1 = v + W2 holds W1 = W2;

theorem 
  for W1, W2 being strict Submodule of V st v + W1 = u + W2 holds W1 = W2;

theorem 
  C is linearly-closed iff C = the carrier of W;

theorem 
  for W1, W2 being strict Submodule of V, C1 being Coset of W1,
  C2 being Coset of W2 st C1 = C2 holds W1 = W2;

theorem 
  {v} is Coset of (0).V;

theorem 
  V1 is Coset of (0).V implies ex v st V1 = {v};

theorem 
  the carrier of W is Coset of W;

theorem 
  the carrier of V is Coset of (Omega).V;

theorem 
  V1 is Coset of (Omega).V implies V1 = the carrier of V;

theorem 
  0.V in C iff C = the carrier of W;

theorem 
  u in C iff C = u + W;

theorem 
  u in C & v in C implies ex v1 st v1 in W & u + v1 = v;

theorem 
  u in C & v in C implies ex v1 st v1 in W & u - v1 = v;

theorem 
  (ex C st v1 in C & v2 in C) iff v1 - v2 in W;

theorem 
  u in B & u in C implies B = C;

begin 

reserve V for Z_Module;
reserve W, W1, W2, W3 for Submodule of V;
reserve u, u1, u2, v, v1, v2 for VECTOR of V;
reserve a, a1, a2 for integer number;
reserve X, Y, y, y1, y2 for set;

definition
  let V,W1,W2;
  func W1 + W2 -> strict Submodule of V means

  the carrier of it = {v + u : v in W1 & u in W2};
  commutativity;
end;

definition
  let V,W1,W2;
  func W1 /\ W2 -> strict Submodule of V means

  the carrier of it = (the carrier of W1) /\ (the carrier of W2);
  commutativity;
end;

theorem 
  x in W1 + W2 iff ex v1, v2 st v1 in W1 & v2 in W2 & x = v1 + v2;

theorem 
  v in W1 or v in W2 implies v in W1 + W2;

theorem 
  x in W1 /\ W2 iff x in W1 & x in W2;

theorem 
  for W being strict Submodule of V holds W + W = W;

theorem 
  W1 + (W2 + W3) = (W1 + W2) + W3;

theorem 
  W1 is Submodule of W1 + W2;

theorem 
  for W2 being strict Submodule of V holds
  W1 is Submodule of W2 iff W1 + W2 = W2;

theorem 
  for W being strict Submodule of V holds (0).V + W = W;

theorem 
  (0).V + (Omega).V = the Z_ModuleStruct of V;

theorem 
  (Omega).V + W = the Z_ModuleStruct of V;

theorem 
  for V being strict Z_Module holds (Omega).V + (Omega).V = V;

theorem 
  for W being strict Submodule of V holds W /\ W = W;

theorem 
  W1 /\ (W2 /\ W3) = (W1 /\ W2) /\ W3;

theorem 
  W1 /\ W2 is Submodule of W1;

theorem 
  for W1 being strict Submodule of V holds W1 is Submodule of W2 iff
  W1 /\ W2 = W1;

theorem 
  (0).V /\ W = (0).V;

theorem 
  (0).V /\ (Omega).V = (0).V;

theorem 
  for W being strict Submodule of V holds (Omega).V /\ W = W;

theorem 
  for V being strict Z_Module holds (Omega).V /\ (Omega).V = V;

theorem 
  W1 /\ W2 is Submodule of W1 + W2;

theorem 
  for W2 being strict Submodule of V
  holds (W1 /\ W2) + W2 = W2;

theorem 
  for W1 being strict Submodule of V
  holds W1 /\ (W1 + W2) = W1;

theorem 
  (W1 /\ W2) + (W2 /\ W3) is Submodule of W2 /\ (W1 + W3);

theorem 
  W1 is Submodule of W2 implies W2 /\ (W1 + W3) = (W1 /\ W2) + (W2 /\ W3);

theorem 
  W2 + (W1 /\ W3) is Submodule of (W1 + W2) /\ (W2 + W3);

theorem 
  W1 is Submodule of W2 implies W2 + (W1 /\ W3) = (W1 + W2) /\ (W2 + W3);

theorem 
  W1 is strict Submodule of W3 implies W1 + (W2 /\ W3) = (W1 + W2) /\ W3;

theorem 
  for W1,W2 being strict Submodule of V holds W1 + W2 = W2 iff W1 /\ W2 = W1;

theorem 
  for W2,W3 being strict Submodule of V holds W1 is Submodule of W2
  implies W1 + W3 is Submodule of W2 + W3;

theorem 
  (ex W st the carrier of W = (the carrier of W1) \/ (the carrier of W2))
  iff W1 is Submodule of W2 or W2 is Submodule of W1;

definition
  let V;
  func Submodules(V) -> set means

  for x holds x in it iff x is strict Submodule of V;
end;

registration
  let V;
  cluster Submodules(V) -> non empty;
end;

theorem 
  for V being strict Z_Module holds V in Submodules(V);

definition
  let V,W1,W2;
  pred V is_the_direct_sum_of W1,W2 means

  the Z_ModuleStruct of V = W1 + W2 & W1 /\ W2 = (0).V;
end;

definition
  let V be Z_Module;
  let W be Submodule of V;
  attr W is with_Linear_Compl means

  ex C being Submodule of V st V is_the_direct_sum_of C,W;
end;

registration
  let V be Z_Module;
  cluster with_Linear_Compl for Submodule of V;
end;

definition
  let V be Z_Module;
  let W be Submodule of V;
  assume  W is with_Linear_Compl;
  mode Linear_Compl of W -> Submodule of V means

  V is_the_direct_sum_of it,W;
end;

theorem 
  for V being Z_Module, W1, W2 being Submodule of V holds V
  is_the_direct_sum_of W1,W2 implies W2 is Linear_Compl of W1;

theorem 
  for V being Z_Module, W being with_Linear_Compl Submodule of V,
  L being Linear_Compl of W holds
  V is_the_direct_sum_of L,W & V is_the_direct_sum_of W,L;

theorem 
  for V being Z_Module, W being with_Linear_Compl Submodule of V, L being
  Linear_Compl of W holds W + L = the Z_ModuleStruct of V;

theorem 
  for V being Z_Module, W being with_Linear_Compl Submodule of V,
  L being Linear_Compl of W holds W /\ L = (0).V;

theorem 
  V is_the_direct_sum_of W1,W2
  implies V is_the_direct_sum_of W2,W1;

theorem 
  for V being Z_Module, W being with_Linear_Compl Submodule of V,
  L being Linear_Compl of W holds W is Linear_Compl of L;

theorem 
  for V being Z_Module holds V is_the_direct_sum_of (0).V,
  (Omega).V & V is_the_direct_sum_of (Omega).V,(0).V;

theorem 
  for V being Z_Module holds (0).V is Linear_Compl of (Omega).V &
  (Omega).V is Linear_Compl of (0).V;

reserve C for Coset of W;
reserve C1 for Coset of W1;
reserve C2 for Coset of W2;

theorem 
  C1 meets C2 implies C1 /\ C2 is Coset of W1 /\ W2;

theorem 
  for V being Z_Module, W1, W2 being Submodule of V holds V
  is_the_direct_sum_of W1,W2 iff for C1 being Coset of W1, C2 being Coset of W2
  ex v being VECTOR of V st C1 /\ C2 = {v};

theorem 
  for V being Z_Module, W1,W2 being Submodule of V holds
  W1 + W2 = the Z_ModuleStruct of V
  iff for v being VECTOR of V ex v1, v2 being VECTOR of V
  st v1 in W1 & v2 in W2 & v = v1 + v2;

theorem 
  V is_the_direct_sum_of W1,W2 & v1 + v2 = u1 + u2 & v1 in
  W1 & u1 in W1 & v2 in W2 & u2 in W2 implies v1 = u1 & v2 = u2;

theorem 
  V = W1 + W2 & (ex v st for v1,v2,u1,u2 st v1 + v2 = u1 + u2 &
  v1 in W1 & u1 in W1 & v2 in W2 & u2 in W2 holds v1 = u1 & v2 = u2) implies
  V is_the_direct_sum_of W1,W2;

definition
  let V,v,W1,W2;
  assume
   V is_the_direct_sum_of W1,W2;
  func v |-- (W1,W2) -> Element of [:the carrier of V, the carrier of V:]
  means

  v = it`1 + it`2 & it`1 in W1 & it`2 in W2;
end;

theorem 
  V is_the_direct_sum_of W1,W2 implies (v |-- (W1,W2))`1 = (v |-- (W2,W1))`2;

theorem 
  V is_the_direct_sum_of W1,W2 implies (v |-- (W1,W2))`2 = (v |-- (W2,W1))`1;

theorem 
  for V being Z_Module,  W being with_Linear_Compl Submodule of V,
  L being Linear_Compl of W, v being VECTOR of V,
  t being Element of [:the carrier of V, the carrier of V:]
  holds t`1 + t`2 = v & t`1 in W & t`2 in L implies t = v |-- (W,L);

theorem 
  for V being Z_Module, W being with_Linear_Compl Submodule of V,
  L being Linear_Compl of W, v being VECTOR of V holds
  (v |-- (W,L))`1 + (v |-- (W,L))`2 = v;

theorem 
  for V being Z_Module, W being with_Linear_Compl Submodule of V,
  L being Linear_Compl of W, v being VECTOR of V holds
  (v |-- (W,L))`1 in W & (v |-- (W,L))`2 in L;

theorem 
  for V being Z_Module, W being with_Linear_Compl Submodule of V,
  L being Linear_Compl of W, v being VECTOR of V holds
  (v |-- (W,L))`1 = (v |-- (L,W))`2;

theorem 
  for V being Z_Module, W being with_Linear_Compl Submodule of V,
  L being Linear_Compl of W, v being VECTOR of V holds
  (v |-- (W,L))`2 = (v |-- (L,W))`1;

reserve A1,A2,B for Element of Submodules(V);

definition
  let V;
  func SubJoin(V) -> BinOp of Submodules(V) means

  for A1, A2, W1, W2 st A1 = W1 & A2 = W2 holds it.(A1,A2) = W1 + W2;
end;

definition
  let V;
  func SubMeet(V) -> BinOp of Submodules(V) means

  for A1, A2, W1, W2 st A1 = W1 & A2 = W2 holds it.(A1,A2) = W1 /\ W2;
end;

theorem 
  LattStr (# Submodules(V), SubJoin(V), SubMeet(V) #) is Lattice;

registration
  let V;
  cluster LattStr (# Submodules(V), SubJoin(V), SubMeet(V) #)
  -> Lattice-like;
end;

theorem 
  for V being Z_Module holds LattStr (# Submodules(V),
  SubJoin(V), SubMeet(V) #) is lower-bounded;

theorem 
  for V being Z_Module holds LattStr (# Submodules(V),
  SubJoin(V), SubMeet(V) #) is upper-bounded;

theorem 
  for V being Z_Module holds LattStr (# Submodules(V),
  SubJoin(V), SubMeet(V) #) is 01_Lattice;

theorem 
  for V being Z_Module holds LattStr (# Submodules(V),
  SubJoin(V), SubMeet(V) #) is modular;

theorem 
  for V being Z_Module, W1,W2,W3 being strict Submodule of V holds
  W1 is Submodule of W2 implies W1 /\ W3 is Submodule of W2 /\ W3;

theorem 
  for V being Z_Module, W being strict Submodule of V holds
  (for v being VECTOR of V holds v in W) implies
  W = the Z_ModuleStruct of V;

theorem 
  ex C st v in C;

begin 

definition
  let AG be non empty addLoopStr;
  func Int-mult-left(AG) -> Function of
  [:INT,the carrier of AG:], the carrier of AG means

  for i being Element of INT, a being Element of AG holds
  (i >= 0 implies it.(i,a) = (Nat-mult-left(AG)).(i,a)) &
  (i < 0 implies it.(i,a) = (Nat-mult-left(AG)).(-i,-a));
end;

theorem 
  for R being non empty addLoopStr, a being Element of R,
  i be Element of INT, i1 be Element of NAT st i=i1 holds
  (Int-mult-left(R)).(i,a) = i1 * a;

theorem 
  for R being non empty addLoopStr, a being Element of R,
  i be Element of INT st i=0 holds
  (Int-mult-left(R)).(i,a) = 0.R;

theorem 
  for R being add-associative right_zeroed right_complementable
  non empty addLoopStr,
  i be Element of NAT holds
  (Nat-mult-left(R)).(i,0.R) = 0.R;

theorem 
  for R being add-associative right_zeroed right_complementable
  non empty addLoopStr,
  i be Element of INT holds
  (Int-mult-left(R)).(i,0.R) = 0.R;

theorem 
  for R being right_zeroed non empty addLoopStr, a being Element of R,
  i be Element of INT st i = 1
  holds (Int-mult-left(R)).(i,a) = a;

theorem 
  for R being Abelian right_zeroed add-associative right_complementable
  non empty addLoopStr,
  a being Element of R, i, j, k being Element of NAT
  st i <= j & k = j-i holds
  (Nat-mult-left(R)).(k,a)
  = (Nat-mult-left(R)).(j,a) - (Nat-mult-left(R)).(i,a);

theorem 
  for R being Abelian right_zeroed add-associative right_complementable
  non empty addLoopStr,
  a being Element of R, i being Element of NAT
  holds -(Nat-mult-left(R)).(i,a) = (Nat-mult-left(R)).(i,-a);

theorem 
  for R being Abelian right_zeroed add-associative right_complementable
  non empty addLoopStr,
  a being Element of R, i, j being Element of INT
  st i in NAT & not j in NAT
  holds (Int-mult-left(R)).(i+j,a)
  = (Int-mult-left(R)).(i,a) + (Int-mult-left(R)).(j,a);

theorem 
  for R being Abelian right_zeroed add-associative
  right_complementable non empty addLoopStr,
  a being Element of R, i, j being Element of INT
  holds (Int-mult-left(R)).(i+j,a)
  = (Int-mult-left(R)).(i,a) + (Int-mult-left(R)).(j,a);

theorem 
  for R being Abelian right_zeroed add-associative
  right_complementable non empty addLoopStr,
  a, b being Element of R, i being Element of NAT
  holds (Nat-mult-left(R)).(i,a+b)
  = (Nat-mult-left(R)).(i,a) + (Nat-mult-left(R)).(i,b);

theorem 
  for R being Abelian right_zeroed add-associative
  right_complementable non empty addLoopStr,
  a, b being Element of R, i being Element of INT
  holds (Int-mult-left(R)).(i,a+b)
  = (Int-mult-left(R)).(i,a) + (Int-mult-left(R)).(i,b);

theorem 
  for R being Abelian right_zeroed add-associative
  right_complementable non empty addLoopStr,
  a being Element of R, i, j being Element of NAT holds
  (Nat-mult-left(R)).(i*j,a) = (Nat-mult-left(R)).(i,(Nat-mult-left(R)).(j,a));

theorem 
  for R being Abelian right_zeroed add-associative right_complementable
  non empty addLoopStr,
  a being Element of R, i, j being Element of INT holds
  (Int-mult-left(R)).(i*j,a) = (Int-mult-left(R)).(i,(Int-mult-left(R)).(j,a));

theorem 
  for AG be non empty Abelian add-associative right_zeroed
  right_complementable addLoopStr holds
  Z_ModuleStruct(# the carrier of AG, the ZeroF of AG, the addF of AG,
  Int-mult-left(AG) #) is Z_Module;















begin 

definition let E be non empty RLSStruct;
  mode binary-image of E is Subset of E;
end;

reserve E for RealLinearSpace;
reserve A, B, C for binary-image of E;
reserve a, b, v for Element of E;

definition
  let E be RealLinearSpace;
  let A, B be binary-image of E;
  func A(-)B -> binary-image of E equals

  { z where z is Element of E :
     for b be Element of E st b in B holds z - b in A };
end;

notation
  let a be Real, E be RealLinearSpace,
      A be Subset of E;
  synonym a * A for a (.) A;
end;

theorem 
  for E be RealLinearSpace, A, B be Subset of E st B = {}
  holds A(+)B = B & B(+)A = B & A(-)B = the carrier of E;

theorem 
  for E be RealLinearSpace, A, B be Subset of E st A <> {} & B = {}
  holds B(-)A = B;

theorem 
  for E be RealLinearSpace,
  A, B be Subset of E st B = the carrier of E & A <> {}
  holds A(+)B = B & B(+)A = B;

theorem 
  for E be RealLinearSpace,
  A, B be Subset of E st B = the carrier of E
  holds B(-)A = B;

theorem 
  A(+)B = union {b + A where b is Element of E: b in B};

definition
  let E be non empty RLSStruct;
  mode binary-image-family of E is Subset-Family of the carrier of E;
end;

reserve F, G for binary-image-family of E;
reserve A, B, C for non empty binary-image of E;

theorem 
  A(-)B = meet {b + A where b is Element of E: b in B};

theorem 
  A(+)B = {v where v is Element of E: (v + (-1)*B) /\ A <> {}};

theorem 
  A(-)B = {v where v is Element of E: v + (-1)*B c= A};

theorem 
  ((the carrier of E) \ A)(+)B = (the carrier of E) \ (A(-)B)
  & ((the carrier of E) \ A)(-)B = (the carrier of E) \ (A(+)B);

definition let E be non empty Abelian addLoopStr, A, B be Subset of E;
  redefine func A(+)B;
  commutativity;
end;

theorem 
  for E be non empty add-associative addLoopStr, A, B, C be Subset of E
  holds A + B + C = A + (B + C);

theorem 
  A(+)B(+)C = A(+)(B(+)C);

theorem 
  (union F)(+)B = union {X(+)B where X is binary-image of E: X in F};

theorem 
  A(+)(union F) = union {A(+)X where X is binary-image of E: X in F};

theorem 
  (meet F)(+)B c= meet {X(+)B where X is binary-image of E: X in F };

theorem 
  A(+)(meet F) c= meet { A(+)X where X is binary-image of E: X in F};

theorem 
  for E be non empty addLoopStr, A, B, C be Subset of E
  holds B c= C implies A + B c= A + C;

theorem 
  (v + A)(+)B = A(+)(v+B) & (v+A)(+)B = v+ (A(+)B);

theorem 
  (meet F)(-)B = meet { X(-)B where X is binary-image of E: X in F};

theorem 
  meet {B (-)X where X is binary-image of E: X in F} c= B(-)(meet F);

theorem 
  union {X(-)B where X is binary-image of E: X in F} c= (union F)(-)B;

theorem 
  F <> {}
  implies B(-) (union F) = meet {B(-)X where X is binary-image of E: X in F};

theorem 
  A c= B implies A(-)C c= B(-)C;

theorem 
  A c= B implies C(-)B c= C(-)A;

theorem 
  (v+A)(-)B = A(-)(v+B) & (v+A)(-)B = v+(A(-)B);

theorem 
  (A(-)B)(-)C = A(-)(B(+)C);

begin 

definition
  let E be RealLinearSpace;
  let B be binary-image of E;
  func dilation(B)
  -> Function of bool the carrier of E, bool the carrier of E means


  for A be binary-image of E holds it.A = A(+)B;
end;

definition
  let E be RealLinearSpace;
  let B be binary-image of E;
  func erosion (B)
  -> Function of bool the carrier of E, bool the carrier of E means


  for A be binary-image of E holds it.A = A(-)B;
end;

theorem 
  (dilation(B)).(union F)
  = union {(dilation(B)).X where X is binary-image of E: X in F};

theorem 
  A c= B implies (dilation(C)).A c= (dilation(C)).B;

theorem 
  (dilation(C)).(v+A) = v+((dilation(C)).A);

theorem 
  (erosion(B)).(meet F)
  = meet {(erosion(B)).X where X is binary-image of E: X in F};

theorem 
  A c= B implies (erosion(C)).A c= (erosion(C)).B;

theorem 
  (erosion(C)).(v+A) = v+((erosion(C)).A);

theorem 
  (dilation(C)).((the carrier of E) \ A)
  = (the carrier of E) \ ((erosion(C)).A)
  & (erosion(C)).( (the carrier of E) \ A)
  = (the carrier of E) \ ((dilation(C)).A );

theorem 
  (dilation(C)).((dilation(B)).A) = (dilation((dilation(C)).B)).A
  & (erosion(C)).((erosion(B)).A) = (erosion((dilation(C)).B)).A;














begin 

reserve F for non trivial RealNormSpace;
reserve G for RealNormSpace;
reserve y,X for set;
reserve x,x0,x1,x2,g,g1,g2,r,r1,s,p,p1,p2 for Real;
reserve i,m,k for Element of NAT;
reserve n,k for non empty Element of NAT;
reserve Y for Subset of REAL;
reserve Z for open Subset of REAL;
reserve s1,s3 for Real_Sequence;
reserve seq,seq1 for sequence of G;
reserve f,f1,f2 for PartFunc of REAL,REAL n;
reserve g,g1,g2 for PartFunc of REAL,REAL-NS n;
reserve h for 0-convergent non-zero Real_Sequence;
reserve c for constant Real_Sequence;

theorem 
  for f1, f2 being PartFunc of REAL, REAL m holds
  f1-f2 = f1+-f2;

definition
  let n be non empty Element of NAT;
  let f be PartFunc of REAL,REAL n;
  let x be real number;
  pred f is_differentiable_in x means

  ex g be PartFunc of REAL,REAL-NS n st f=g & g is_differentiable_in x;
end;

theorem 
  for n be non empty Element of NAT,
      f be PartFunc of REAL,REAL n,
      h be PartFunc of REAL,REAL-NS n,
      x be real number st h=f
  holds f is_differentiable_in x iff h is_differentiable_in x;

definition
  let n be non empty Element of NAT;
  let f be PartFunc of REAL,REAL n;
  let x be real number;
  func diff(f,x) -> Element of REAL n means

  ex g be PartFunc of REAL,REAL-NS n st f=g & it = diff(g,x);
end;

theorem 
  for n be non empty Element of NAT,
      f be PartFunc of REAL,REAL n,
      h be PartFunc of REAL,REAL-NS n,
      x be real number st h=f
holds diff(f,x) = diff(h,x);

definition
  let n,f,X;
  pred f is_differentiable_on X means


  X c= dom f & for x st x in X holds f|X is_differentiable_in x;
end;

theorem 
  f is_differentiable_on X implies X is Subset of REAL;

theorem 
  f is_differentiable_on Z iff Z c= dom f & for x st x in Z holds
  f is_differentiable_in x;

theorem 
  f is_differentiable_on Y implies Y is open;

definition
  let n,f,X;
  assume
 f is_differentiable_on X;
  func f`|X -> PartFunc of REAL,REAL n means


  dom it = X & for x st x in X holds it.x = diff(f,x);
end;

theorem 
  (Z c= dom f & ex r be Element of REAL n st rng f = {r})
  implies f is_differentiable_on Z &
  for x st x in Z holds (f`|Z)/.x = 0*n;

theorem 
  for x0 being real number,f be PartFunc of REAL,REAL n,
  g be PartFunc of REAL,REAL-NS n, N being Neighbourhood of x0
st f=g & f is_differentiable_in x0 & N c= dom f
for h,c st rng c = {x0} & rng (h+c)c= N
holds h"(#)((g/*(h+c)) - g/*c) is convergent
& diff(f,x0) = lim (h"(#)((g/*(h+c)) - g/*c));

theorem 
  f is_differentiable_in x0 implies r(#)f is_differentiable_in x0
  & diff((r(#)f),x0) = r*diff(f,x0);

theorem 
  f is_differentiable_in x0 implies
  -f is_differentiable_in x0 & diff(-f,x0) = -diff(f,x0);

theorem 
  f1 is_differentiable_in x0 & f2 is_differentiable_in x0 implies
  f1+f2 is_differentiable_in x0 & diff(f1+f2,x0) = diff(f1,x0)+diff(f2,x0);

theorem 
  f1 is_differentiable_in x0 & f2 is_differentiable_in x0 implies
  f1-f2 is_differentiable_in x0 & diff(f1-f2,x0) = diff(f1,x0)-diff(f2,x0);

theorem 
  Z c= dom f & f is_differentiable_on Z implies
  r(#)f is_differentiable_on Z &
  for x st x in Z holds ((r(#)f)`|Z).x =r*diff(f,x);

theorem 
  Z c= dom f & f is_differentiable_on Z implies
  -f is_differentiable_on Z & for x st x in Z holds ((-f)`|Z).x = -diff(f,x);

theorem 
  Z c= dom (f1+f2) & f1 is_differentiable_on Z & f2 is_differentiable_on Z
  implies f1+f2 is_differentiable_on Z &
  for x st x in Z holds ((f1+f2)`|Z).x = diff(f1,x) + diff(f2,x);

theorem 
  Z c= dom (f1-f2) & f1 is_differentiable_on Z & f2 is_differentiable_on Z
  implies f1-f2 is_differentiable_on Z &
  for x st x in Z holds ((f1-f2)`|Z).x = diff(f1,x) - diff(f2,x);

theorem 
  Z c= dom f & f|Z is constant implies f is_differentiable_on Z &
  for x st x in Z holds (f`|Z).x = 0*n;

theorem 
  for r,p be Element of REAL n st Z c= dom f &
  (for x st x in Z holds f/.x = x*r + p)
  holds f is_differentiable_on Z & for x st x in Z holds (f`|Z).x = r;

theorem 
  for x0 being Real holds f is_differentiable_in x0 implies
  f is_continuous_in x0;

theorem 
  f is_differentiable_on X implies f|X is continuous;

theorem 
  f is_differentiable_on X & Z c= X implies f is_differentiable_on Z;

definition
  let n be non empty Element of NAT;
  let f be PartFunc of REAL, REAL n;
  attr f is differentiable means


  f is_differentiable_on dom f;
end;

registration
 let n;
 cluster REAL --> 0*n -> differentiable for Function of REAL,REAL n;
end;

registration
 let n;
 cluster differentiable for Function of REAL, REAL n;
end;

theorem 
  for f being differentiable PartFunc of REAL, REAL n
   st Z c= dom f holds
  f is_differentiable_on Z;

reserve GR,R for RestFunc of REAL-NS n;
reserve DFG,L for LinearFunc of REAL-NS n;

theorem 
  for R be PartFunc of REAL,REAL-NS n
    st R is total holds R is RestFunc-like iff for r be Real st r > 0
    ex d be Real st d > 0 & for z be Real
    st z <> 0 & |. z .| < d holds |.z.|"* ||. R/.z .|| < r;

theorem 
for g be PartFunc of REAL,REAL-NS n,
    x0 be real number st
 1 <= i & i <= n & g is_differentiable_in x0 holds
   (Proj(i,n)*g) is_differentiable_in x0 &
   Proj(i,n).(diff(g,x0)) = diff((Proj(i,n)*g),x0);

theorem 
for g be PartFunc of REAL,REAL-NS n,
    x0 be real number holds
g is_differentiable_in x0 iff
(for i be Element of NAT st 1<=i & i <=n holds
      Proj(i,n)*g is_differentiable_in x0);

theorem 
for f be PartFunc of REAL,REAL n,
    x0 be real number st
 1 <= i & i <= n & f is_differentiable_in x0 holds
   (Proj(i,n)*f) is_differentiable_in x0 &
   Proj(i,n).(diff(f,x0)) = diff((Proj(i,n)*f),x0);

theorem 
for f be PartFunc of REAL,REAL n,
    x0 be real number holds
f is_differentiable_in x0 iff
(for i be Element of NAT st 1<=i & i <=n holds
      Proj(i,n)*f is_differentiable_in x0);

theorem 
for g be PartFunc of REAL,REAL-NS n st
 1 <= i & i <= n & g is_differentiable_on X holds
   (Proj(i,n)*g) is_differentiable_on X &
   Proj(i,n)*(g`|X) = (Proj(i,n)*g)`|X;

theorem 
for f be PartFunc of REAL,REAL n st
 1 <= i & i <= n & f is_differentiable_on X holds
   (Proj(i,n)*f) is_differentiable_on X &
   Proj(i,n)*(f`|X) = (Proj(i,n)*f)`|X;

theorem 
for g be PartFunc of REAL,REAL-NS n holds
g is_differentiable_on X iff
(for i be Element of NAT st 1<=i & i <=n holds
      Proj(i,n)*g is_differentiable_on X);

theorem 
for f be PartFunc of REAL,REAL n holds
f is_differentiable_on X iff
(for i be Element of NAT st 1<=i & i <=n holds
      Proj(i,n)*f is_differentiable_on X);

theorem 
for J be Function of REAL-NS 1,REAL,
      x0 be Point of REAL-NS 1 st J=proj(1,1)
 holds J is_continuous_in x0;

theorem 
for I be Function of REAL,REAL-NS 1 st I=proj(1,1) qua Function"
 holds I is_continuous_in x0;

theorem 
for S,T be RealNormSpace,
    f1 be PartFunc of S,REAL,
    f2 be PartFunc of REAL,T,
    x0 be Point of S
     st x0 in dom (f2*f1) & f1 is_continuous_in x0
      & f2 is_continuous_in f1/.x0
 holds f2*f1 is_continuous_in x0;

theorem 
for J be Function of REAL-NS 1,REAL,
      x0 be Point of REAL-NS 1,
      y0 be Element of REAL,
      g be PartFunc of REAL,REAL-NS n,
      f be PartFunc of REAL-NS 1,REAL-NS n
   st J=proj(1,1)
  & x0 in dom f & y0 in dom g & x0=<*y0*> & f = g*J
 holds f is_continuous_in x0 iff g is_continuous_in y0;

theorem 
for I be Function of REAL,REAL-NS 1,
      x0 be Point of REAL-NS 1,
      y0 be Element of REAL,
      g be PartFunc of REAL,REAL-NS n,
      f be PartFunc of REAL-NS 1,REAL-NS n
   st I=proj(1,1) qua Function" &
      x0 in dom f & y0 in dom g & x0=<*y0*> & f*I = g
 holds f is_continuous_in x0 iff g is_continuous_in y0;

theorem 
for I be Function of REAL,REAL-NS 1 st I = proj(1,1) qua Function"
 holds I is_differentiable_in x0 & diff(I,x0) = <*1*>;

definition
  let n be non empty Element of NAT;
  let f be PartFunc of REAL-NS n,REAL;
  let x be Point of REAL-NS n;
  pred f is_differentiable_in x means


  ex g be PartFunc of REAL n,REAL, y be Element of REAL n
  st f=g & x=y & g is_differentiable_in y;
end;

definition
  let n be non empty Element of NAT;
  let f be PartFunc of REAL-NS n,REAL;
  let x be Point of REAL-NS n;
  func diff(f,x) -> Function of REAL-NS n,REAL means


  ex g be PartFunc of REAL n,REAL, y be Element of REAL n
   st f=g & x=y & it = diff(g,y);
end;

theorem 
for J be Function of REAL 1,REAL,
      x0 be Element of REAL 1
   st J=proj(1,1)
 holds J is_differentiable_in x0 & diff(J,x0) = J;

theorem 
for J be Function of REAL-NS 1,REAL,
      x0 be Point of REAL-NS 1
   st J=proj(1,1)
 holds J is_differentiable_in x0 & diff(J,x0) = J;

theorem 
  for I be Function of REAL,REAL-NS 1 st
  I=proj(1,1) qua Function" holds
  (for R being RestFunc of REAL-NS 1,REAL-NS n holds
      R*I is RestFunc of REAL-NS n) &
  for L being LinearOperator of REAL-NS 1,REAL-NS n holds
     L*I is LinearFunc of REAL-NS n;

theorem 
  for J be Function of REAL-NS 1,REAL st J = proj(1,1) holds
  (for R being RestFunc of REAL-NS n holds
      R*J is RestFunc of REAL-NS 1,REAL-NS n) &
  for L being LinearFunc of REAL-NS n holds
     L*J is Lipschitzian LinearOperator of REAL-NS 1,REAL-NS n;

theorem 
for I be Function of REAL,REAL-NS 1,
    x0 be Point of REAL-NS 1,
    y0 be Element of REAL,
    g be PartFunc of REAL,REAL-NS n,
    f be PartFunc of REAL-NS 1,REAL-NS n
   st I=proj(1,1) qua Function" & x0 in dom f & y0 in dom g
   & x0=<*y0*> & f*I = g & f is_differentiable_in x0
   holds g is_differentiable_in y0
     & diff(g,y0)=diff(f,x0).<*1*>
     & for r be Element of REAL holds diff(f,x0).<*r*> = r*diff(g,y0);

theorem 
for I be Function of REAL,REAL-NS 1,
      x0 be Point of REAL-NS 1,
      y0 be Element of REAL,
      g be PartFunc of REAL,REAL-NS n,
      f be PartFunc of REAL-NS 1,REAL-NS n
   st I=proj(1,1) qua Function" & x0 in dom f & y0 in dom g
   & x0=<*y0*> & f*I = g
 holds f is_differentiable_in x0 iff g is_differentiable_in y0;

theorem 
for J be Function of REAL-NS 1,REAL,
      x0 be Point of REAL-NS 1,
      y0 be Element of REAL,
      g be PartFunc of REAL,REAL-NS n,
      f be PartFunc of REAL-NS 1,REAL-NS n
   st J=proj(1,1) & x0 in dom f & y0 in dom g
   & x0=<*y0*> & f = g*J
 holds f is_differentiable_in x0 iff g is_differentiable_in y0;

theorem 
for J be Function of REAL-NS 1,REAL,
      x0 be Point of REAL-NS 1,
      y0 be Element of REAL,
      g be PartFunc of REAL,REAL-NS n,
      f be PartFunc of REAL-NS 1,REAL-NS n
   st J=proj(1,1) & x0 in dom f & y0 in dom g
   & x0=<*y0*> & f = g*J & g is_differentiable_in y0
  holds
   f is_differentiable_in x0
   & diff(g,y0)=diff(f,x0).<*1*>
   & for r be Element of REAL holds diff(f,x0).<*r*> = r*diff(g,y0);

theorem 
  for R be RestFunc of REAL-NS n st R/.0=0.(REAL-NS n)
  for e be Real st e > 0 ex d be Real st
    d > 0 & for h be Real st |.h.| < d holds ||.R/.h.|| <= e*|.h.|;

reserve m for non empty Element of NAT;

theorem 
  for R be RestFunc of REAL-NS n
  for L be Lipschitzian LinearOperator of REAL-NS n,REAL-NS m holds
  L*R is RestFunc of REAL-NS m;

theorem 
  for R1 be RestFunc of REAL-NS n st R1/.0=0.(REAL-NS n)
  for R2 be RestFunc of REAL-NS n,REAL-NS m st R2/.0.(REAL-NS n)=0.(REAL-NS m)
  for L be LinearFunc of REAL-NS n holds R2*(L+R1) is RestFunc of REAL-NS m;

theorem 
  for R1 be RestFunc of REAL-NS n st R1/.0=0.(REAL-NS n)
  for R2 be RestFunc of REAL-NS n,REAL-NS m st R2/.0.(REAL-NS n)=0.(REAL-NS m)
  for L1 be LinearFunc of REAL-NS n
  for L2 be Lipschitzian LinearOperator of REAL-NS n,REAL-NS m holds
    L2*R1+ R2*(L1+R1) is RestFunc of REAL-NS m;

theorem 
  for x0 be Element of REAL
  for g be PartFunc of REAL,REAL-NS n st
    g is_differentiable_in x0
  for f be PartFunc of REAL-NS n,REAL-NS m st
    f is_differentiable_in (g/.x0) holds
  f*g is_differentiable_in x0 & diff(f*g,x0) = diff(f,g/.x0).diff(g,x0);














begin

reserve x,A for set,
  i,j,k,m,n, l, l1, l2 for Nat;
reserve D for non empty set,
  z for Nat;

definition
  let S be set;
  attr S is standard-ins means


   ex X being non empty set
    st S c= [: NAT,NAT*,X*:];
end;

registration
 cluster {[0,{},{}]} -> standard-ins;
 cluster {[1,{},{}]} -> standard-ins;
end;

notation
  let x;
  synonym InsCode x for x`1_3;
  synonym JumpPart x for x`2_3;
  synonym AddressPart x for x`3_3;
end;

registration
 cluster non empty standard-ins for set;
end;

registration
  let S be non empty standard-ins set;
  let I be Element of S;
  cluster AddressPart I -> Function-like Relation-like;
  cluster JumpPart I -> Function-like Relation-like;
end;

registration
  let S be non empty standard-ins set;
  let I be Element of S;
  cluster AddressPart I -> FinSequence-like;
  cluster JumpPart I -> FinSequence-like;
end;

registration
  let S be non empty standard-ins set;
 let x be Element of S;
 cluster InsCode x -> natural;
end;

registration
  cluster standard-ins -> Relation-like for set;
end;

definition
  let S be standard-ins set;
  func InsCodes S equals

   proj1_3 S;
end;

registration
  let S be non empty standard-ins set;
  cluster InsCodes S ->non empty;
end;

definition
  let S be non empty standard-ins set;
  mode InsType of S is Element of InsCodes S;
end;

definition
  let S be non empty standard-ins set;
  let I be Element of S;
  redefine func InsCode I -> InsType of S;
end;

definition
  let S be non empty standard-ins set;
  let T be InsType of S;
  func JumpParts T equals

  { JumpPart I where I is Element of S: InsCode I = T };
  func AddressParts T equals

  { AddressPart I where I is Element of S: InsCode I = T };
end;

registration
  let S be non empty standard-ins set;
  let T be InsType of S;
  cluster AddressParts T -> functional;
  cluster JumpParts T -> non empty functional;
end;

definition
  let S be non empty standard-ins set;
  attr S is homogeneous means


  for I, J being Element of S st InsCode I = InsCode J holds
  dom JumpPart I = dom JumpPart J;
  canceled;
  attr S is J/A-independent means


 for T being InsType of S,
     f1,f2 being natural-valued Function st
      f1 in JumpParts T & dom f1 = dom f2
    for p being set st [T,f1,p] in S holds [T,f2,p] in S;
end;

registration
 cluster {[0,{},{}]} -> J/A-independent homogeneous;
end;

registration
 cluster J/A-independent homogeneous for non empty standard-ins set;
end;

registration
  let S be homogeneous non empty standard-ins set;
  let T be InsType of S;
  cluster JumpParts T -> with_common_domain;
end;

registration
 let S be non empty standard-ins set;
 let I be Element of S;
 cluster JumpPart I -> NAT-valued for Function;
end;

theorem 
 for S be standard-ins non empty set
 for I,J being Element of S
  st InsCode I = InsCode J & JumpPart I = JumpPart J &
   AddressPart I = AddressPart J
 holds I = J;

reserve y for set;

registration
  let S be homogeneous J/A-independent standard-ins non empty set;
  let T be InsType of S;
  cluster JumpParts T -> product-like;
end;

definition
  let S be standard-ins set;
  let I be Element of S;
  attr I is ins-loc-free means

 JumpPart I is empty;
end;

registration
  let S be standard-ins non empty set;
  let I be Element of S;
 cluster JumpPart I -> natural-valued for Function;
end;

definition
  let S be homogeneous J/A-independent standard-ins non empty set;
  let I be Element of S;
  let k be Nat;
  func IncAddr(I,k) -> Element of S means


  InsCode it = InsCode I &
  AddressPart it = AddressPart I &
  JumpPart it = k + JumpPart I;
end;

canceled;

theorem 
  for S being homogeneous J/A-independent standard-ins non empty set,
  I being Element of S holds IncAddr(I, 0) = I;

theorem 
  for S being homogeneous J/A-independent standard-ins non empty set,
  I being Element of S st I is ins-loc-free holds IncAddr(I, k) = I;

theorem 
  for S being homogeneous J/A-independent standard-ins non empty set,
      I being Element of S
  holds JumpParts InsCode I = JumpParts InsCode IncAddr(I,k);

theorem 
  for S being homogeneous J/A-independent standard-ins non empty set,
  I, J being Element of S st
  ex k being Nat st IncAddr(I,k) = IncAddr(J,k) holds I = J;

theorem 
  for S being homogeneous J/A-independent standard-ins non empty set,
      I being Element of S
  holds IncAddr(IncAddr(I,k),m) = IncAddr(I,k+m);

theorem 
  for S being homogeneous J/A-independent standard-ins non empty set,
  I being Element of S, x being set st x in dom JumpPart I holds
  (JumpPart I).x in (product" JumpParts InsCode I).x;

registration
 cluster {[0,{},{}],[1,{},{}]} -> standard-ins;
end;

theorem 
  for x being Element of {[0,{},{}],[1,{},{}]}
    holds JumpPart x = {};

registration
 cluster {[0,{},{}],[1,{},{}]} -> J/A-independent homogeneous;
end;

theorem 
 for S being standard-ins non empty set
 for T being InsType of S
  ex I being Element of S st InsCode I = T;

theorem 
 for S being homogeneous standard-ins non empty set
 for I being Element of S st JumpPart I = {}
  holds JumpParts InsCode I = {0};

begin 







definition let X be set;
 attr X is with_halt means

 [0,{},{}] in X;
end;

registration
 cluster with_halt -> non empty for set;
end;

registration
 cluster {[0,{},{}]} -> with_halt;
 cluster {[0,{},{}],[1,{},{}]} -> with_halt;
end;

registration
 cluster with_halt standard-ins for set;
end;

registration
 cluster J/A-independent homogeneous for with_halt standard-ins set;
end;

definition
  let S be with_halt set;
  func halt S -> Element of S equals

   [0,{},{}];
end;

registration
  let S be with_halt standard-ins set;
  cluster halt S -> ins-loc-free;
end;

registration
  let S be with_halt standard-ins set;
 cluster ins-loc-free for Element of S;
end;

registration let S be with_halt standard-ins set;
 let I be ins-loc-free Element of S;
 cluster JumpPart I -> empty;
end;

theorem 
  for S being homogeneous J/A-independent standard-ins non empty
     with_halt set,
  I being Element of S st IncAddr(I,k) = halt S holds I = halt S;

definition
  let S be homogeneous J/A-independent standard-ins non empty
     with_halt set;
  let i be Element of S;
  attr i is No-StopCode means

  i <> halt S;
end;

begin 

definition
 mode Instructions is J/A-independent homogeneous
        with_halt standard-ins set;
end;

registration
 cluster non trivial for Instructions;
end;














begin 

reserve x,A for set,
  i,j,k,m,n, l, l1, l2 for Nat;
reserve D for non empty set,
  z for Nat;

definition
  struct COM-Struct(#
    InstructionsF -> Instructions
     #);
end;

definition
 canceled 7;
  func Trivial-COM -> strict COM-Struct means


  the InstructionsF of it = {[0,{},{}]};
end;

definition
  let S be COM-Struct;
  mode Instruction of S is Element of the InstructionsF of S;
end;

definition
 canceled;
  let S be COM-Struct;
  func halt S -> Instruction of S equals

  halt the InstructionsF of S;
end;





definition
  let S be COM-Struct;
  let I be (the InstructionsF of S)-valued Function;
  attr I is halt-free means

  not halt S in rng I;
end;

begin 

reserve S for COM-Struct;
reserve ins for Element of the InstructionsF of S;

definition
 let S be COM-Struct;
 mode Instruction-Sequence of S is
    (the InstructionsF of S)-valued ManySortedSet of NAT;
end;

definition
 let S be COM-Struct;
 let P be Instruction-Sequence of S, k be Nat;
 redefine func P.k -> Instruction of S;
end;

begin

definition
  let S be (COM-Struct);
  let p be NAT-defined (the InstructionsF of S)-valued Function, l be set;
  pred p halts_at l means

 l in dom p & p.l = halt S;
end;

definition
  let S be COM-Struct;
  let s be Instruction-Sequence of S, l be Nat;
  redefine pred s halts_at l means

  s.l = halt S;
end;

begin 

notation
  let S be COM-Struct;
  let i be Instruction of S;
  synonym Load i for <%i%>;
end;

registration
  let S;
  cluster initial 1-element NAT-defined
    (the InstructionsF of S)-valued for Function;
end;

definition
  let S be COM-Struct;
  mode preProgram of S is finite
   NAT-defined (the InstructionsF of S)-valued Function;
end;

definition
  let S be COM-Struct,
  F be non empty preProgram of S;
  attr F is halt-ending means


  F.(LastLoc F) = halt S;
  attr F is unique-halt means


  for f being Nat st
  F.f = halt S & f in dom F holds f = LastLoc F;
end;

registration
  let S be COM-Struct;
  cluster trivial initial non empty for preProgram of S;
end;

definition
  let S be  COM-Struct;
  mode Program of S is initial non empty preProgram of S;
end;

canceled;

theorem 
  for ins being Element of the InstructionsF of Trivial-COM holds
  InsCode ins = 0;

begin 

reserve i, j, k for Nat;

definition
  let S be  COM-Struct;
  func Stop S -> finite preProgram of S equals

   Load halt S;
end;

registration
  let S be  COM-Struct;
  cluster Stop S -> initial non empty;
end;

registration
  let S be COM-Struct;
  cluster Stop S ->
   initial non empty NAT-defined (the InstructionsF of S)-valued trivial;
end;

registration
  let S be COM-Struct;
  cluster Stop S -> halt-ending unique-halt;
end;

registration let S;
  cluster halt-ending unique-halt trivial
   for initial non empty preProgram of S;
end;

definition let S;
  mode MacroInstruction of S is halt-ending unique-halt Program of S;
end;

registration
  let S be  COM-Struct;
  cluster initial non empty for preProgram of S;
end;

theorem 
  0 in dom Stop S;

theorem 
  card Stop S = 1;

reserve k, m for Nat,
  x, x1, x2, x3, y, y1, y2, y3, X,Y,Z for set;

begin  

theorem 
  for I being Instruction of Trivial-COM holds JumpPart I = 0;

theorem 
  for T being InsType of the InstructionsF of Trivial-COM
   holds JumpParts T = {0};

registration
  let S be COM-Struct;
  cluster trivial -> unique-halt for non empty finite preProgram of S;
end;

canceled;

theorem 
  for F being MacroInstruction of S st card F = 1 holds F = Stop S;

theorem 
 for S being COM-Struct holds LastLoc Stop S = 0;

begin  

definition
 canceled 4;
  let S be COM-Struct,
  p be NAT-defined (the InstructionsF of S)-valued finite Function,
  k be Nat;
  func IncAddr(p,k) ->
   NAT-defined (the InstructionsF of S)-valued finite Function
  means


  dom it = dom p &
  for m being Nat st m in dom p holds it.m = IncAddr(p/.m,k);
end;

registration
  let S be COM-Struct,
  F be NAT-defined (the InstructionsF of S)-valued finite Function,
  k be Nat;
  cluster IncAddr(F,k) -> NAT-defined (the InstructionsF of S)-valued;
end;

registration
  let S be COM-Struct,
  F be empty (the InstructionsF of S)-valued NAT-defined finite Function,
  k be Nat;
  cluster IncAddr(F,k) -> empty;
end;

registration
  let S be COM-Struct,
  F be non empty (the InstructionsF of S)-valued NAT-defined finite Function,
  k be Nat;
  cluster IncAddr(F,k) -> non empty;
end;

registration
  let S be COM-Struct,
  F be initial NAT-defined (the InstructionsF of S)-valued finite Function,
  k be Nat;
  cluster IncAddr(F,k) -> initial;
end;

canceled 6;

registration let S be COM-Struct;
 let F be NAT-defined (the InstructionsF of S)-valued finite Function;
 reduce IncAddr(F,0) to F;
end;

theorem 
  for S being COM-Struct,
  F being NAT-defined (the InstructionsF of S)-valued finite Function
   holds IncAddr(F,0) = F;

theorem 
  for S being COM-Struct,
  F being NAT-defined (the InstructionsF of S)-valued finite Function
  holds IncAddr(IncAddr(F,k),m) = IncAddr(F,k+m);

definition
  let S be COM-Struct;
  let p be finite NAT-defined (the InstructionsF of S)-valued Function,
     k be Nat;
 func Reloc(p,k) ->
   finite NAT-defined (the InstructionsF of S)-valued Function
     equals

Shift(IncAddr(p,k),k);
end;

theorem 
  for S being COM-Struct,
  F being initial non empty finite preProgram of S,
  G being non empty
   NAT-defined (the InstructionsF of S)-valued finite Function
  holds dom CutLastLoc F misses dom Reloc(G,card F -' 1);

theorem 
  for F being unique-halt initial non empty finite preProgram of S,
  I being Nat st I in dom CutLastLoc F
  holds (CutLastLoc F).I <> halt S;

definition
  let S be COM-Struct;
  let F, G be non empty finite preProgram of S;
  func F ';' G -> finite preProgram of S equals

  CutLastLoc F +* Reloc(G,card F -' 1);
end;

registration
  let S be COM-Struct,
  F, G be non empty
  (the InstructionsF of S)-valued NAT-defined finite Function;
  cluster F ';' G -> non empty
  (the InstructionsF of S)-valued NAT-defined;
end;

theorem 
  for S being COM-Struct,
  F being initial non empty finite preProgram of S,
  G being non empty
  (the InstructionsF of S)-valued NAT-defined finite Function
  holds card (F ';' G) = card F + card G - 1 &
  card (F ';' G) = card F + card G -' 1;

registration
  let S be COM-Struct;
  let F, G be initial non empty finite preProgram of S;
  cluster F ';' G -> initial;
end;

theorem 
  for S being COM-Struct,
  F, G being initial non empty finite preProgram of S
  holds dom F c= dom (F ';' G);

registration
 let S being COM-Struct,
  F, G being initial non empty finite preProgram of S;
 cluster F ';' G -> initial non empty;
end;

theorem 
  for S being COM-Struct,
  F, G being initial non empty finite preProgram of S
  holds CutLastLoc F c= CutLastLoc (F ';' G);

theorem 
  for S being COM-Struct,
  F, G being initial non empty finite preProgram of S
  holds (F ';' G).LastLoc F = IncAddr(G,card F -' 1).0;

theorem 
  for S being COM-Struct,
  F, G being initial non empty finite preProgram of S,
  f being Nat st f < card F - 1
  holds IncAddr(F,card F -' 1).f = IncAddr(F ';' G, card F -' 1).f;

registration
  let S be COM-Struct;
  let F be initial non empty NAT-defined
  (the InstructionsF of S)-valued finite Function;
  let G be halt-ending initial non empty NAT-defined
  (the InstructionsF of S)-valued finite Function;
  cluster F ';' G -> halt-ending;
end;

registration
  let S be COM-Struct;
  let F, G be halt-ending unique-halt
  initial non empty NAT-defined
  (the InstructionsF of S)-valued finite Function;
  cluster F ';' G -> unique-halt;
end;

definition
  let S be COM-Struct;
  let F, G be MacroInstruction of S;
  redefine func F ';' G -> MacroInstruction of S;
end;

registration let S be COM-Struct, k;
 reduce IncAddr(Stop S, k) to Stop S;
end;

theorem 
  for S being COM-Struct
  holds IncAddr(Stop S, k) = Stop S;

theorem 
  for k being Nat
  for S being COM-Struct
  holds Shift(Stop S, k) = k .--> halt S;

registration let S be COM-Struct, F being MacroInstruction of S;
 reduce F ';' Stop S to F;
end;

theorem 
  for S being COM-Struct,
      F being MacroInstruction of S
  holds F ';' Stop S = F;

registration let S be COM-Struct, F be MacroInstruction of S;
 reduce Stop S ';' F to F;
end;

theorem 
  for S being COM-Struct,
      F being MacroInstruction of S
  holds Stop S ';' F = F;

theorem 
  for S being COM-Struct, F, G, H being MacroInstruction of S
   holds F ';' G ';' H = F ';' (G ';' H);

canceled;

theorem 
  for I being Instruction of Trivial-COM holds JumpPart I = 0;

begin 

reserve i, j, k for Nat,
  n for Nat,
  l,il for Nat;

reserve S for COM-Struct;

theorem 
 for k being Nat holds
  for p being finite NAT-defined (the InstructionsF of S)-valued Function
   holds dom Reloc(p,k) = dom Shift(p,k);

theorem 
  for k being Nat holds
  for p being finite NAT-defined (the InstructionsF of S)-valued Function
   holds dom Reloc(p,k) = { j+k where j is Element of NAT:j in dom p };

theorem 
  for i,j being Nat holds
  for p being NAT-defined (the InstructionsF of S)-valued finite Function
  holds Shift(IncAddr(p,i),j) = IncAddr(Shift(p,j),i);

theorem 
  for g being NAT-defined (the InstructionsF of S)-valued finite Function
  for k being Nat holds
  for I being Instruction of S holds
  il in dom g & I = g.il implies
  IncAddr(I, k) = Reloc(g, k).(il + k);

reserve S for COM-Struct;

reserve
  i,j,k for Instruction of S,
  I,J,K for Program of S;

definition
  let S be COM-Struct;
  let i be Instruction of S;
  redefine func Load i -> preProgram of S;
end;

reserve k1,k2 for Integer;

reserve l,l1,loc for Nat;

definition
  let S be COM-Struct;
  let I be initial preProgram of S;
  func stop I -> preProgram of S equals

  I ^ Stop S;
end;

registration let S be COM-Struct;
 let I be initial preProgram of S;
 cluster stop I -> initial non empty;
end;

reserve i1,i2 for Instruction of S;

theorem 
   0 in dom stop  I;

begin 

reserve
  i,j,k for Instruction of S,
  I,J,K for Program of S;

definition
  let S be COM-Struct;
  let i be Instruction of S;
  func Macro i -> preProgram of S equals

   stop Load i;
end;

registration let S;
  let i;
  cluster Macro i -> initial non empty;
end;

begin 

reserve m for Nat;

registration
  let S be  COM-Struct;
  cluster Stop S -> non halt-free;
end;

registration
  let S be COM-Struct;
  cluster non halt-free finite for Program of S;
end;

registration
  let S be  COM-Struct;
  let p be NAT-defined (the InstructionsF of S)-valued Function,
      q be non halt-free
       NAT-defined (the InstructionsF of S)-valued Function;
  cluster p +* q -> non halt-free;
end;

registration
  let S be COM-Struct;
  let p be finite non halt-free
    NAT-defined (the InstructionsF of S)-valued Function,
     k be Nat;
 cluster Reloc(p,k) -> non halt-free;
end;

registration
  let S be  COM-Struct;
  cluster non halt-free non empty for Program of S;
end;

canceled 4;

theorem 
 for S being COM-Struct
  for p,q being
   finite NAT-defined (the InstructionsF of S)-valued Function
    holds IncAddr(p +* q, n) = IncAddr(p,n) +* IncAddr(q,n);

theorem 
 for S being COM-Struct
 for p,q being finite NAT-defined (the InstructionsF of S)-valued Function,
     k be Nat
  holds Reloc(p+*q,k) = Reloc(p,k)+*Reloc(q,k);

theorem 
 for S being COM-Struct
 for p being finite NAT-defined (the InstructionsF of S)-valued Function,
     m,n be Nat
 holds Reloc(Reloc(p,m), n) = Reloc(p, m + n);

theorem 
 for S being COM-Struct
  for P,Q being NAT-defined (the InstructionsF of S)-valued finite Function,
   k being Nat st
  P c= Q holds Reloc(P,k) c= Reloc(Q,k);

registration let S be COM-Struct;
 let P be preProgram of S;
 reduce Reloc(P,0) to P;
end;

theorem 
 for S being COM-Struct
  for P being preProgram of S holds Reloc(P,0) = P;

theorem 
 for S being COM-Struct
  for k being Nat holds
    for P being preProgram of S holds
    il in dom P iff il + k in dom Reloc(P,k);

theorem 
  for S be COM-Struct
  for i being Instruction of S
  for f being Function of the InstructionsF of S, the InstructionsF of S
   st f = (id the InstructionsF of S) +* (halt S .--> i)
  for s being finite NAT-defined (the InstructionsF of S)-valued Function
  holds IncAddr(f*s,n)
   = ((id the InstructionsF of S) +* (halt S .--> IncAddr(i,n)))* IncAddr(s,n);

reserve S for COM-Struct;
reserve I,J for Program of S;

theorem 
  dom I misses dom Reloc(J, card I);

theorem 
 for I being preProgram of S holds card Reloc(I, m) = card I;



reserve S for COM-Struct;
reserve i for Instruction of S,
        I for Program of S;

theorem 
  x in dom Load i iff x =  0;

reserve loc for Nat;

theorem 
  loc in dom stop I & (stop I).loc <> halt S implies loc in dom I;

theorem 
  dom Load i = { 0} & (Load i).0 = i;

theorem 
   0 in dom Load i;

theorem 
  card Load i = 1;

theorem 
  card stop I = card I + 1;

theorem 
  card Macro i = 2;

theorem 
   0 in dom Macro i &  1 in dom Macro i;

theorem 
  (Macro i).0 = i;

theorem 
  (Macro i).1 = halt S;

theorem 
  x in dom Macro i iff x= 0 or x= 1;

theorem 
  dom Macro i = {0,1};

theorem 
  loc in dom I implies loc in dom stop I;

theorem 
 for I being initial preProgram of S st loc in dom I
  holds (stop I).loc=I.loc;

theorem 
  card I in dom stop I & (stop I).card I = halt S;



theorem 
  loc in dom I implies Shift(stop I,n).(loc+n)=Shift(I,n).(loc+n);

theorem 
  Shift(stop I,n). n=Shift(I,n). n;



registration let S be COM-Struct;
 cluster empty for preProgram of S;
end;

registration let S be COM-Struct;
 cluster empty -> halt-free for preProgram of S;
end;

definition
 canceled;
  let S be COM-Struct;
  let IT be NAT-defined (the InstructionsF of S)-valued Function;
  redefine attr IT is halt-free means

 for x being Nat st x in dom IT holds IT.x <> halt S;
end;

registration let S be COM-Struct;
 cluster halt-free -> unique-halt for non empty preProgram of S;
end;

theorem 
 rng Macro i = {i, halt S};

registration let S;
 let p be initial preProgram of S;
 reduce CutLastLoc stop p to p;
end;

theorem 
 for p being initial preProgram of S
  holds CutLastLoc stop p = p;

registration let S be COM-Struct;
 let p be halt-free initial preProgram of S;
 cluster stop p -> unique-halt;
end;

registration let S;
 let I be Program of S, J be non halt-free Program of S;
  cluster I ';' J -> non halt-free;
end;

theorem 
 for I being Program of S
  holds CutLastLoc stop I = I;

theorem 
 InsCode halt S = 0;














begin 

reserve x,y,z for set;

notation
  synonym SCM-Halt for {};
end;

definition
  redefine func SCM-Halt -> Element of Segm 9;
end;

definition
  func SCM-Data-Loc equals

  [:{1},NAT:];
end;

registration
  cluster SCM-Data-Loc -> non empty;
end;

reserve I,J,K for Element of Segm 9,
  i,a,a1,a2 for Element of NAT,
  b,b1,b2,c,c1 for Element of SCM-Data-Loc;

definition
  func SCM-Instr -> non empty set equals

  {[SCM-Halt,{},{}] } \/ { [J,<*a*>,{}] : J = 6 }
   \/ { [K,<*a1*>,<*b1*>] : K in { 7,8 } }
   \/ { [I,{},<*b,c*>] : I in { 1,2,3,4,5} };
end;

theorem 
  [0,{},{}] in SCM-Instr;

registration
  cluster SCM-Instr -> non empty;
end;

theorem 
  [6,<*a2*>,{}] in SCM-Instr;

theorem 
  x in { 7, 8 } implies [x,<*a2*>,<*b2*>] in SCM-Instr;

theorem 
  x in { 1,2,3,4,5} implies [x,{},<*b1,c1*>] in SCM-Instr;

definition
  let x be Element of SCM-Instr;
  given mk, ml being Element of SCM-Data-Loc, I such that
 x = [ I, {}, <*mk, ml*>];
  func x address_1 -> Element of SCM-Data-Loc means


  ex f being FinSequence of SCM-Data-Loc st f = x`3_3 & it = f/.1;
  func x address_2 -> Element of SCM-Data-Loc means


  ex f being FinSequence of SCM-Data-Loc st f = x`3_3 & it = f/.2;
end;

theorem 
  for x being Element of SCM-Instr, mk, ml being Element of SCM-Data-Loc, I
   st x = [ I, {}, <*mk, ml*>] holds x address_1 = mk & x address_2 = ml;

definition
  let x be Element of SCM-Instr;
  given mk being Element of NAT, I such that
 x = [ I, <*mk*>, {}];
  func x jump_address -> Element of NAT means

 ex f being FinSequence of NAT st f = x`2_3 & it = f/.1;
end;

theorem 
  for x being Element of SCM-Instr, mk being Element of NAT, I st x = [
  I, <*mk*>, {}] holds x jump_address = mk;

definition
  let x be Element of SCM-Instr;
  given mk being Element of NAT, ml being Element of SCM-Data-Loc, I such that
 x = [ I, <*mk*>, <*ml*>];
  func x cjump_address -> Element of NAT means


  ex mk being Element of NAT st <*mk*> = x`2_3 & it = <*mk*>/.1;
  func x cond_address -> Element of SCM-Data-Loc means


  ex ml being Element of SCM-Data-Loc st <*ml*> = x`3_3 & it = <*ml*>/.1;
end;

theorem 
  for x being Element of SCM-Instr, mk being Element of NAT, ml being
Element of SCM-Data-Loc, I
 st x = [ I, <*mk*>, <*ml*>] holds x cjump_address = mk &
  x cond_address = ml;

theorem 
 SCM-Instr c= [:NAT,NAT*,proj2 SCM-Instr:];

registration
 cluster proj2 SCM-Instr -> FinSequence-membered;
end;

theorem 
 for x being Element of SCM-Instr holds
  x in {[SCM-Halt,{},{}] } & InsCode x = 0 or
  x in { [J,<*a*>,{}] : J = 6 } & InsCode x = 6 or
  x in { [K,<*a1*>,<*b1*>] : K in { 7,8 } }
        & (InsCode x = 7 or InsCode x = 8) or
  x in { [I,{},<*b,c*>] : I in { 1,2,3,4,5} }
    & (InsCode x = 1 or InsCode x = 2 or InsCode x = 3
      or InsCode x = 4 or InsCode x = 5);

begin 

reserve i,j,k for Element of NAT;

registration
 cluster SCM-Instr -> standard-ins;
end;

reserve I,J,K for Element of Segm 9,
  a,a1,a2 for Element of NAT,
  b,b1,b2,c,c1 for Element of SCM-Data-Loc;

theorem 
  for l being Element of SCM-Instr holds InsCode l <= 8;

registration
 cluster SCM-Instr -> homogeneous;
end;

reserve T for InsType of SCM-Instr,
        I for Element of SCM-Instr;

registration
 cluster SCM-Instr -> J/A-independent;
 end;

registration
 cluster SCM-Instr -> with_halt;
end;














begin 

reserve x,y,z for set;








definition
  func SCM-Memory equals

  {NAT} \/ SCM-Data-Loc;
end;

registration
  cluster SCM-Memory -> non empty;
end;

definition
  redefine func SCM-Data-Loc -> Subset of SCM-Memory;
end;






reserve I,J,K for Element of Segm 9,
  i,a,a1,a2 for Element of NAT,
  b,b1,b2,c,c1 for Element of SCM-Data-Loc;

definition
 canceled 2;
  func SCM-OK -> Function of SCM-Memory, 2 means

 for k being Element of SCM-Memory
   holds (k = NAT implies it.k = 0) &
         (k in SCM-Data-Loc implies it.k = 1);
end;

canceled;

definition
 func SCM-VAL -> ManySortedSet of 2 equals

  <%NAT,INT%>;
end;

canceled 4;

theorem 
   (SCM-VAL*SCM-OK).NAT = NAT;

theorem 
  for i being Element of SCM-Memory
   holds i in SCM-Data-Loc implies (SCM-VAL*SCM-OK).i = INT;

registration
 cluster SCM-VAL*SCM-OK -> non-empty;
end;

definition
  mode SCM-State is Element of product(SCM-VAL*SCM-OK);
end;

theorem 
  for a being Element of SCM-Data-Loc
      holds (SCM-VAL*SCM-OK).a = INT;

theorem 
  pi(product(SCM-VAL*SCM-OK),NAT) = NAT;

theorem 
  for a being Element of SCM-Data-Loc
   holds pi(product(SCM-VAL*SCM-OK),a) = INT;

definition
  let s be SCM-State;
  func IC(s) -> Element of NAT equals

  s.NAT;
end;

definition
  let s be SCM-State, u be Nat;
  func SCM-Chg(s,u) -> SCM-State equals

  s +* (NAT .--> u);
end;

theorem 
  for s being SCM-State, u being Nat holds SCM-Chg(s,u).NAT = u;

theorem 
  for s being SCM-State, u being Nat, mk being Element of SCM-Data-Loc
  holds SCM-Chg(s,u).mk = s.mk;

theorem 
  for s being SCM-State, u,v being Nat holds SCM-Chg(s,u).v = s.v;

definition
  let s be SCM-State, t be Element of SCM-Data-Loc, u be Integer;
  func SCM-Chg(s,t,u) -> SCM-State equals

  s +* (t .--> u);
end;

theorem 
  for s being SCM-State, t being Element of SCM-Data-Loc, u being
  Integer holds SCM-Chg(s,t,u).NAT = s.NAT;

theorem 
  for s being SCM-State, t being Element of SCM-Data-Loc, u being
  Integer holds SCM-Chg(s,t,u).t = u;

theorem 
  for s being SCM-State, t being Element of SCM-Data-Loc, u being
Integer, mk being Element of SCM-Data-Loc st mk <> t holds SCM-Chg(s,t,u).mk =
  s.mk;

registration
  let s be SCM-State, a be Element of SCM-Data-Loc;
  cluster s.a -> integer;
end;

definition
 canceled 5;
  let x be Element of SCM-Instr, s be SCM-State;
  func SCM-Exec-Res(x,s) -> SCM-State equals

  SCM-Chg(SCM-Chg(s, x address_1,s.(x address_2)), succ IC s)
   if ex mk, ml being Element of SCM-Data-Loc st x = [1, {}, <*mk, ml*>],
  SCM-Chg(SCM-Chg(s,x address_1, s.(x address_1)+s.(x address_2)),succ IC s)
   if ex mk, ml being Element of SCM-Data-Loc st x = [ 2, {}, <*mk, ml*>],
  SCM-Chg(SCM-Chg(s,x address_1, s.(x address_1)-s.(x address_2)),succ IC s)
  if ex mk, ml being Element of SCM-Data-Loc st x = [ 3, {}, <*mk, ml*>],
  SCM-Chg(SCM-Chg(s,x address_1, s.(x address_1)*s.(x address_2)),succ IC s)
  if ex mk, ml being Element of SCM-Data-Loc st x = [ 4, {}, <*mk, ml*>],
  SCM-Chg(SCM-Chg( SCM-Chg(s,
    x address_1, s.(x address_1) div s.(x address_2)),
    x address_2, s.(x address_1) mod s.(x address_2)),succ IC s)
  if ex mk, ml being Element of SCM-Data-Loc st x = [ 5, {}, <*mk, ml*>],
  SCM-Chg(s,x jump_address)
  if ex mk being Element of NAT st x = [ 6, <*mk*>, {}],
  SCM-Chg(s,IFEQ(s.(x cond_address),0,x cjump_address,succ IC s))
  if ex mk being Element of NAT, ml being Element of SCM-Data-Loc st
   x = [7, <*mk*>, <*ml*>],
  SCM-Chg(s,IFGT(s.(x cond_address),0,x cjump_address,succ IC s))
  if ex mk being Element of NAT, ml being Element of SCM-Data-Loc st
   x = [ 8, <*mk*>, <*ml*>]
  otherwise s;
end;

definition
  func SCM-Exec -> Action of SCM-Instr, product(SCM-VAL*SCM-OK) means

  for x being Element of SCM-Instr, y being SCM-State holds (it.x).y =
  SCM-Exec-Res(x,y);
end;

begin 


canceled 3;

theorem 
  not NAT in SCM-Data-Loc;

canceled;

theorem 
  NAT in SCM-Memory;

theorem 
  x in SCM-Data-Loc implies ex k being Element of NAT st x = [1,k];

theorem 
  for k being Nat holds [1,k] in SCM-Data-Loc;

canceled;

theorem 
  for k being Element of SCM-Memory
   holds k = NAT or k in SCM-Data-Loc;

theorem 
  dom(SCM-VAL*SCM-OK) = SCM-Memory;

theorem 
 for s being SCM-State holds dom s = SCM-Memory;

definition let x be set;
 attr x is Int-like means

  x in SCM-Data-Loc;
end;















begin 

reserve x,N for set,
        k for Nat;

definition let N;
  struct (ZeroStr) Mem-Struct over N (# carrier -> set,
    ZeroF -> Element of the carrier,
    Object-Kind -> Function of the carrier, N,
    ValuesF -> ManySortedSet of N
     #);
end;

reserve N for with_zero set;







definition let N;
  func Trivial-Mem N -> strict Mem-Struct over N means


  the carrier of it = {0} & the ZeroF of it = 0 &
  the Object-Kind of it = 0 .--> 0 &
  the ValuesF of it = N --> NAT;
end;

registration let N;
  cluster Trivial-Mem N -> 1-element;
end;

registration let N;
  cluster 1-element for Mem-Struct over N;
end;

notation let N;
 let S be Mem-Struct over N;
  synonym IC S for 0.S;
  synonym Data-Locations S for NonZero S;
end;

registration
 
 cluster with_zero -> non empty for set;
end;

definition let N;
  let S be Mem-Struct over N;
  func the_Values_of S -> ManySortedSet of the carrier of S equals

  (the ValuesF of S)*(the Object-Kind of S);
end;

definition let N;
  let S be Mem-Struct over N;
  mode PartState of S is (the carrier of S)-defined
           (the_Values_of S)-compatible Function;
end;








definition let N;
  let S be Mem-Struct over N;
 attr S is with_non-empty_values means

 the_Values_of S is non-empty;
end;

registration let N;
 cluster Trivial-Mem N ->with_non-empty_values;
end;

registration let N;
 cluster with_non-empty_values for Mem-Struct over N;
end;

registration let N;
  let S be with_non-empty_values Mem-Struct over N;
 cluster the_Values_of S -> non-empty;
end;

definition let N;
  let S be with_non-empty_values Mem-Struct over N;
  mode State of S is total PartState of S;
end;

definition let N;
  let S be Mem-Struct over N;
  mode Object of S is Element of S;
end;

begin 

definition let N;
  let S be non empty Mem-Struct over N;
  let o be Object of S;
  func ObjectKind o -> Element of N equals

  (the Object-Kind of S).o;
end;

definition let N;
  let S be non empty Mem-Struct over N;
  let o be Object of S;
  func Values o equals

  (the_Values_of S).o;
end;









definition let N;
  let IT be non empty Mem-Struct over N;
  attr IT is IC-Ins-separated means

 Values IC IT = NAT;
end;

registration let N;
  cluster Trivial-Mem N -> IC-Ins-separated;
end;

registration let N;
  cluster IC-Ins-separated with_non-empty_values strict
    for 1-element Mem-Struct over N;
end;

definition
  let N;
  let S be IC-Ins-separated non empty with_non-empty_values Mem-Struct over N;
  let p be PartState of S;
  func IC p -> Element of NAT equals

  p.IC S;
end;

theorem 
 for S being IC-Ins-separated 1-element with_non-empty_values Mem-Struct over N
  for s1, s2 being State of S st IC s1 = IC s2 holds s1= s2;

registration
  let N;
  let S be non empty with_non-empty_values Mem-Struct over N,
      o be Object of S;
  cluster Values o -> non empty;
end;

registration
  let N;
  let S be IC-Ins-separated non empty
       with_non-empty_values Mem-Struct over N;
  let la be Object of S;
  let a be Element of Values la;
  cluster la .--> a -> (the_Values_of S)-compatible;
  let lb be Object of S;
  let b be Element of Values lb;
  cluster (la,lb) --> (a,b) -> (the_Values_of S)-compatible;
end;

theorem 
  for S being non empty with_non-empty_values Mem-Struct over N
  for s being State of S holds IC S in dom s;

reserve S for IC-Ins-separated non empty with_non-empty_values
     Mem-Struct over N;

definition
  let N;
  let S be Mem-Struct over N;
  let p be PartState of S;
  func DataPart p -> PartState of S equals

  p | Data-Locations S;
  projectivity;
end;

definition
  let N; let S be Mem-Struct over N;
  let p be PartState of S;
  attr p is data-only means


  dom p misses {IC S};
end;

registration
  let N; let S be Mem-Struct over N;
  cluster empty -> data-only for PartState of S;
end;

registration
  let N; let S be Mem-Struct over N;
  cluster empty for PartState of S;
end;

theorem 
  for N for S being Mem-Struct over N
  for p being PartState of S holds not IC S in dom DataPart p;

theorem 
  for N for S being Mem-Struct over N for p being
  PartState of S holds {IC S} misses dom DataPart p;

theorem 
  for p being data-only PartState of S, q being PartState of S
  holds p c= q iff p c= DataPart q;

registration
  let N;
  let S be Mem-Struct over N;
  let p be PartState of S;
  cluster DataPart p -> data-only;
end;

theorem 
  for S being Mem-Struct over N, p being PartState
  of S holds p is data-only iff dom p c= Data-Locations S;

theorem 
  for S being Mem-Struct over N, p being data-only PartState of S
   holds DataPart p = p;

reserve s for State of S;

theorem 
  Data-Locations S c= dom s;

theorem 
  dom DataPart s = Data-Locations S;

theorem 
  for d being data-only PartState of S holds not IC S in dom d;

theorem 
  for p being PartState of S, d being data-only PartState of S
  holds IC(p+*d) = IC p;

reserve p for PartState of S;

theorem 
  for p being PartState of S holds DataPart p c=  p;

theorem 
 dom s = {IC S} \/ Data-Locations S;

theorem 
 dom  p /\ Data-Locations S = dom DataPart p;

registration let N;
  let S be IC-Ins-separated non empty with_non-empty_values Mem-Struct over N,
      l be Element of NAT, s be State of S;
  cluster s+*(IC S,l) -> (the_Values_of S)-compatible;
end;

begin 

definition
  let N;
  let S be IC-Ins-separated non empty
    with_non-empty_values Mem-Struct over N;
  let l be Nat;
  func Start-At(l,S) -> PartState of S equals

   IC S .--> l;
end;

definition
  let N;
  let S be IC-Ins-separated non empty with_non-empty_values Mem-Struct over N,
      l be Nat;
  let p be PartState of S;
  attr p is l-started means

 IC S in dom p & IC p = l;
end;

registration
 let N;
 let S be IC-Ins-separated non empty with_non-empty_values Mem-Struct over N,
     l be Nat;
  cluster Start-At(l,S) -> l-started non empty;
end;

theorem 
 for l being Nat holds IC S in dom Start-At(l,S);

theorem 
 for n being Nat
 holds IC(p +* Start-At( n,S)) =  n;

registration
  let N;
  let S be IC-Ins-separated non empty with_non-empty_values Mem-Struct over N,
      l be Nat;
  cluster l-started for State of S;
end;

registration
  let N;
  let S be IC-Ins-separated non empty with_non-empty_values Mem-Struct over N,
      l be Nat,
      p being PartState of S,
      q be l-started PartState of S;
  cluster p +* q -> l-started;
end;

definition
  let N;
  let S be IC-Ins-separated non empty with_non-empty_values Mem-Struct over N,
      l be Nat;
  let s be State of S;
  redefine attr s is l-started means

  IC s = l;
end;

theorem 
  for S being IC-Ins-separated non empty with_non-empty_values
               Mem-Struct over N,
      l being Nat,
      p being l-started PartState of S
  for s being PartState of S st p c= s holds s is l-started;

theorem 
  for s being State of S holds Start-At(IC s,S) = s | {IC S};

theorem 
  for S being IC-Ins-separated non empty with_non-empty_values
         Mem-Struct over N
  for p being PartState of S st IC S in
  dom p holds p = Start-At(IC p,S) +* DataPart p;

theorem 
 for S be IC-Ins-separated non empty
 with_non-empty_values Mem-Struct over N, l be Nat
  holds DataPart Start-At(l,S) = {};

theorem 
  for l1,l2,k being Nat holds Start-At(l1+k,S) =
  Start-At(l2+k,S) iff Start-At(l1,S) = Start-At(l2,S);

theorem 
  for l1,l2,k being Nat st Start-At(l1,S) = Start-At(l2,S)
  holds Start-At(l1 -' k,S) = Start-At(l2 -' k,S);

theorem 
  for d being data-only PartState of S, k being Nat
  holds d tolerates Start-At(k,S);

theorem 
 for S being IC-Ins-separated non empty with_non-empty_values Mem-Struct over N
 for p being PartState of S st IC S in dom p
  holds dom  p = {IC S} \/ dom DataPart p;

theorem 
 for S being IC-Ins-separated non empty with_non-empty_values
       Mem-Struct over N
 for s being State of S
  holds dom  s = {IC S} \/ dom DataPart s;

theorem 
 for p being PartState of S st IC S in dom p
  holds p = DataPart p +* Start-At (IC p,S);

theorem 
  IC S in dom (p +* Start-At( k,S));

theorem 
  p +* Start-At( k,S) c= s implies IC s =  k;

theorem 
  for S be IC-Ins-separated non empty with_non-empty_values Mem-Struct over N,
      l be Nat
  for p be PartState of S
  holds p is l-started iff Start-At(l,S) c= p;

registration let N,S; let k be Nat;
 let p be k-started PartState of S, d be data-only PartState of S;
 cluster p +* d -> k-started;
end;

theorem 
  Start-At(IC s,S) c= s;

theorem 
 for s being State of S
  holds s +* Start-At(IC s,S) = s;

theorem 
 dom  p c= {IC S} \/ dom DataPart p;

theorem 
 for S being IC-Ins-separated non empty with_non-empty_values
         Mem-Struct over N
 for s be State of S holds s = s|(Data-Locations S \/ {IC S});

theorem 
 for S being IC-Ins-separated non empty with_non-empty_values
        Mem-Struct over N
 for s1,s2 be State of S
  st s1|(Data-Locations S \/ {IC S}) = s2|(Data-Locations S \/ {IC S})
 holds s1 =  s2;

theorem 
 IC S in dom p implies  p = Start-At(IC p,S) +* DataPart p;

theorem 
 for p being PartState of S, k,l being Nat
  holds p +* Start-At(k,S) +* Start-At(l,S)  = p +* Start-At(l,S);

theorem 
 for p being PartState of S st IC S in dom p
  holds p +* Start-At(IC p,S) = p;

theorem 
  p +* Start-At(k,S) c= s implies IC s = k;

theorem 
 for p being PartState of S holds Start-At(0,S) c= p implies IC p = 0;

theorem 
 for p being PartState of S st Start-At(k,S) c= p holds IC p = k;

registration let N;
 let S be IC-Ins-separated non empty
 with_non-empty_values Mem-Struct over N;
 cluster non empty for PartState of S;
end;

theorem 
 for S being IC-Ins-separated non empty with_non-empty_values
    Mem-Struct over N
 for p being non empty PartState of S
 holds dom p meets {IC S} \/ Data-Locations S;

begin 

definition let N;
  let S be IC-Ins-separated non empty
  with_non-empty_values Mem-Struct over N;
  let p be PartState of S;
  func Initialize p -> PartState of S equals

  p +* Start-At(0,S);
  projectivity;
end;

registration let N,S;
  let p be PartState of S;
 cluster Initialize p -> 0-started;
end;

theorem 
  for S being IC-Ins-separated non empty
  with_non-empty_values Mem-Struct over N,
      p being PartState of S
  holds dom Initialize p = dom p \/ {IC S};

theorem 
  for x being set st x in dom Initialize p holds x in dom p or x = IC S;

theorem 
 for p being 0-started PartState of S
  holds Initialize p = p;

theorem 
 for p being PartState of S
  holds DataPart Initialize p = DataPart p;

theorem 
 for s being State of S st IC s =  0 holds Initialize s = s;

registration let N,S;
  let s be State of S;
  cluster Initialize s -> total;
end;

theorem 
 for p being PartState of S
 holds Initialize p c= s implies IC s = 0;

theorem 
 for p being PartState of S holds IC S in dom Initialize p;

theorem 
 for p,q being PartState of S holds IC S in dom(p +* Initialize q);

theorem 
 for S being IC-Ins-separated non empty
 with_non-empty_values Mem-Struct over N
 for p,q being PartState of S
 holds Initialize p c= q implies Start-At(0,S) c= q;

begin 

definition let N,S;
 let p be PartState of S, k be Nat;
  func IncIC(p,k) -> PartState of S equals

  p +* Start-At(IC p+k,S);
end;

theorem 
  for p being PartState of S, k being Nat
  holds DataPart IncIC(p,k) = DataPart p;

theorem 
 for p being PartState of S, k being Nat holds IC S in dom IncIC(p,k);

theorem 
  for p being PartState of S, k being Nat
   holds IC IncIC (p,k) = IC p + k;

theorem 
  for d being data-only PartState of S, k being Nat
  holds IncIC(p+*d,k) = IncIC(p,k) +* d;

theorem 
  for p being PartState of S, k being Nat holds
  Start-At(IC p+k,S) c= IncIC (p,k);

theorem 
 for p being PartState of S st IC S in dom p
  holds IncIC( p,k) = DataPart p +* Start-At ((IC p) +k,S);

registration
  let N,S;
  let s be State of S, k be Nat;
  cluster IncIC(s,k) -> total;
end;

theorem 
 for p being PartState of S, i,j being Nat
 holds IncIC(IncIC(p,i),j) = IncIC(p,i+j);

theorem 
 for p being PartState of S, j,k being Nat
 holds IncIC(p +* Start-At(j,S),k) = p +* Start-At(j+k,S);

theorem 
 for k being Nat
 holds IC IncIC(s,k) -' k = IC s;

theorem 
 for p,q being PartState of S, k being Nat st IC S in dom q
  holds IncIC(p+*q,k) = p +* IncIC(q,k);

theorem 
 for S being IC-Ins-separated non empty with_non-empty_values Mem-Struct over N
  for k being Nat, p being PartState of S,
      s1, s2 being State of S st p c= s1 & IncIC(p,k) c= s2
   holds p c= s1 +* DataPart s2;

theorem 
 for S being IC-Ins-separated non empty with_non-empty_values Mem-Struct over N
 for p being PartState of S, k being Element of NAT
 holds DataPart p c= IncIC(p,k);

definition let N,S;
  let p be PartState of S, k be Nat;
  func DecIC(p,k) -> PartState of S equals

  p +* Start-At(IC p-'k,S);
end;

theorem 
  for p being PartState of S, k being Nat
  holds DataPart DecIC(p,k) = DataPart p;

theorem 
 for k being Nat holds IC S in dom DecIC(p,k);

theorem 
  for p being PartState of S, k being Nat
   holds IC DecIC (p,k) = IC p -' k;

theorem 
  for p being PartState of S,
   d being data-only PartState of S, k being Nat
  holds DecIC(p+*d,k) = DecIC(p,k) +* d;

theorem 
  for p being PartState of S,k being Nat holds
  Start-At(IC p-'k,S) c= DecIC (p,k);

theorem 
 for p being PartState of S, k being Nat st IC S in dom p
  holds DecIC( p,k) = DataPart p +* Start-At ((IC p) -'k,S);

registration
  let N,S;
  let s be State of S, k be Nat;
  cluster DecIC(s,k) -> total;
end;

theorem 
 for p being PartState of S, i,j being Nat
 holds DecIC(DecIC(p,i),j) = DecIC(p,i+j);

theorem 
 for p being PartState of S, j,k being Nat
 holds DecIC(p +* Start-At(j,S),k) = p +* Start-At(j-'k,S);

theorem 
 for s being State of S, k being Nat st k <= IC s
 holds IC DecIC(s,k) + k = IC s;

theorem 
 for p,q being PartState of S, k being Nat st IC S in dom q
  holds DecIC(p+*q,k) = p +* DecIC(q,k);

theorem 
 for p being PartState of S, k being Nat st IC S in dom p
  holds DecIC(IncIC(p,k),k) = p;

theorem 
 for p,q being PartState of S, k being Nat st IC S in dom q
  holds DecIC(p+*IncIC(q,k),k) = p +* q;

registration let N,S; let k be Nat;
 let p be k-started PartState of S;
 cluster DecIC(p,k) -> 0-started;
end;

begin 

registration
  let N;
  let S be IC-Ins-separated non empty
    with_non-empty_values Mem-Struct over N;
  let l be Nat;
  cluster Start-At(l,S) -> finite;
end;

definition let N;
  let S be Mem-Struct over N;
  mode FinPartState of S is finite PartState of S;
end;

registration
  let N;
  let S be IC-Ins-separated non empty with_non-empty_values Mem-Struct over N,
      l be Nat;
  cluster l-started for FinPartState of S;
end;

registration
  let N;
  let S be Mem-Struct over N;
  let p be FinPartState of S;
  cluster DataPart p -> finite;
end;

registration let N,S;
  let p be FinPartState of S;
  cluster Initialize p -> finite;
end;

registration let N,S;
  let p be FinPartState of S, k be Nat;
  cluster IncIC(p,k) -> finite;
end;

registration let N,S;
  let p be FinPartState of S, k be Nat;
  cluster DecIC(p,k) -> finite;
end;

definition
  let N;
  let S be with_non-empty_values Mem-Struct over N;
  func FinPartSt S -> Subset of sproduct the_Values_of S equals

  { p where p is Element of sproduct the_Values_of S: p is finite };
end;

theorem 
 for S be with_non-empty_values Mem-Struct over N
 for p being FinPartState of S holds p in FinPartSt S;

registration
  let N;
  let S be with_non-empty_values Mem-Struct over N;
  cluster FinPartSt S -> non empty;
end;

theorem 
  for S being with_non-empty_values Mem-Struct over N,
      p being Element of FinPartSt S holds
  p is FinPartState of S;

definition
  let N,S;
  let IT be PartFunc of FinPartSt S,FinPartSt S;
  attr IT is data-only means

  for p being PartState of S st p in dom IT holds p is data-only &
   for q being PartState of S st q = IT.p holds q is data-only;
end;

registration let N,S;
 cluster data-only for PartFunc of FinPartSt S, FinPartSt S;
end;

begin 

theorem 
  for A being non empty with_non-empty_values Mem-Struct over N, s
  being State of A, o being Object of A holds s.o in Values o;

theorem 
  for A being IC-Ins-separated non empty with_non-empty_values
        Mem-Struct over N
  for s1,s2 being State of A st IC s1= IC s2 & DataPart s1 =
  DataPart s2 holds s1=s2;

theorem 
  for s being State of S, l being Element of NAT
  holds DataPart s = DataPart(s +* Start-At(l,S));

theorem 
  for s1,s2 be State of S holds
  DataPart s1 = DataPart s2 implies
    Initialize s1 =  Initialize s2;

theorem 
  the_Values_of Trivial-Mem N = 0 .--> NAT;



definition let N,S;
  let f be Function of product the_Values_of S, NAT;
  attr f is on_data_only means

  for s1, s2 being State of S st DataPart s1 = DataPart s2
  holds f.s1 = f.s2;
end;















begin 

definition
  let N be set;
  struct (Mem-Struct over N, COM-Struct) AMI-Struct over N
  (# carrier -> set,
    ZeroF -> Element of the carrier,
    InstructionsF -> Instructions,
    Object-Kind -> Function of the carrier, N,
    ValuesF -> ManySortedSet of N,
    Execution -> Action of the InstructionsF,
        product((the ValuesF)*the Object-Kind)
     #);
end;

reserve N for with_zero set;

definition
  let N;
  func Trivial-AMI N -> strict AMI-Struct over N means


  the carrier of it = {0} & the ZeroF of it = 0 &
  the InstructionsF of it = {[0,{},{}]} &
  the Object-Kind of it = 0 .--> 0 &
  the ValuesF of it = N --> NAT &
  the Execution of it = [0,{},{}] .--> id product((N --> NAT)*(0 .--> 0));
end;

registration
  let N;
  cluster Trivial-AMI N -> 1-element;
end;

registration
  let N;
  cluster non empty for AMI-Struct over N;
end;

registration let N;
 cluster Trivial-AMI N ->with_non-empty_values;
end;

registration let N;
 cluster with_non-empty_values 1-element for AMI-Struct over N;
end;

definition
  let N;
  let S be with_non-empty_values AMI-Struct over N;
  let I be Instruction of S, s be State of S;
  func Exec(I,s) -> State of S equals

  ((the Execution of S).I).s;
end;

reserve N for with_zero set;

definition
  let N;
  let S be with_non-empty_values AMI-Struct over N;
  let I be Instruction of S;
  attr I is halting means


  for s being State of S holds Exec(I,s) = s;
end;

definition
  let N;
  let S be with_non-empty_values AMI-Struct over N;
  attr S is halting means

 halt S is halting;
end;

registration
  let N;
  cluster Trivial-AMI N -> halting;
end;

registration
  let N;
  cluster halting
    for with_non-empty_values non empty AMI-Struct over N;
end;

registration
  let N;
  let S be halting with_non-empty_values AMI-Struct over N;
  cluster halt S -> halting;
end;

registration
  let N;
  let S be halting with_non-empty_values AMI-Struct over N;
  cluster halting for Instruction of S;
end;

theorem 
  for s being State of Trivial-AMI N, i being Instruction of
  Trivial-AMI N holds Exec(i,s) = s;

registration
  let E be with_zero set;
  cluster Trivial-AMI E -> IC-Ins-separated;
end;

registration
  let M be with_zero set;
  cluster IC-Ins-separated strict trivial
    for non empty with_non-empty_values AMI-Struct over M;
end;

registration
  let N;
  cluster IC-Ins-separated halting strict
     for 1-element with_non-empty_values AMI-Struct over N;
end;

begin 

reserve x,y,z,A,B for set,
  f,g,h for Function,
  i,j,k for Element of NAT;

reserve S for IC-Ins-separated non empty
     with_non-empty_values AMI-Struct over N,
  s for State of S;

definition
  let N,S;
  let p be (the InstructionsF of S)-valued Function;
  let s be State of S;
  func CurInstr(p,s) -> Instruction of S equals

  p/.IC s;
end;

definition
  let N,S;
  let s be State of S;
  let p be (the InstructionsF of S)-valued Function;
  func Following(p,s) -> State of S equals

  Exec(CurInstr(p,s),s);
end;

definition
  let N,S;
  let p be NAT-defined (the InstructionsF of S)-valued Function;
  let s be State of S, k be Nat;
  func Comput(p,s,k) -> State of S means


  ex f being Function of NAT, product the_Values_of S st
  it = f.k & f.0 = s & for i being Nat holds f.(i+1) = Following(p,f.i);
end;

definition
  let N;
  let S be halting IC-Ins-separated non empty
         with_non-empty_values AMI-Struct over N;
  let p be NAT-defined (the InstructionsF of S)-valued Function;
  let s be State of S;
  pred p halts_on s means


  ex k being Nat
   st IC Comput(p,s,k) in dom p & CurInstr(p,Comput(p,s,k)) = halt S;
end;

registration
  let N be non empty with_zero set;
  let S be IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N,
  p be NAT-defined (the InstructionsF of S)-valued Function,
  s be State of S;
 reduce Comput(p,s,0) to s;
end;

theorem 
  for N be non empty with_zero set
  for S be IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N,
  p be NAT-defined (the InstructionsF of S)-valued Function,
  s be State of S holds Comput(p,s,0) = s;

theorem 
  for N be non empty with_zero set
  for S be IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N,
  p be NAT-defined (the InstructionsF of S)-valued Function,
  s be State of S, k be Nat holds
  Comput(p,s,k+1) = Following(p,Comput(p,s,k));

reserve N for non empty with_zero set,
 S for IC-Ins-separated non empty with_non-empty_values AMI-Struct over N,
  s for State of S;

theorem 
  for p being NAT-defined (the InstructionsF of S)-valued Function
  for k holds Comput(p,s,i+k) = Comput(p,Comput(p,s,i),k);

theorem 
  i <= j implies
 for N for S being halting IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N
  for p being NAT-defined (the InstructionsF of S)-valued Function
  for s being State of S st CurInstr(p,Comput(p,s,i)) = halt S
 holds Comput(p,s,j) = Comput(p,s,i);

reserve n for Element of NAT;

definition
  let N;
  let S be halting IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N;
   let p be NAT-defined (the InstructionsF of S)-valued Function;
  let s be State of S such that
 p halts_on s;
  func Result(p,s) -> State of S means


  ex k st it = Comput(p,s,k) & CurInstr(p,it) = halt S;
end;

theorem 
  for S being  IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N
  for P being Instruction-Sequence of S
  for s being State of S
 holds Comput(P,s,k+1) = Exec(P.IC Comput(P,s,k),Comput(P,s,k));

theorem 
  for S being IC-Ins-separated halting
non empty with_non-empty_values AMI-Struct over N
  for P being Instruction-Sequence of S
  for s being State of S, k st P.IC Comput(P,s,k) = halt S
  holds Result(P,s) = Comput(P,s,k);

theorem 
  for S being IC-Ins-separated halting
non empty with_non-empty_values AMI-Struct over N
  for P being Instruction-Sequence of S
  for s being State of S st ex k st P.IC Comput(P,s,k) = halt S
 for i holds Result(P,s) = Result(P,Comput(P,s,i));

definition
  let N;
  let S be IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N;
  let p be (the InstructionsF of S)-valued NAT-defined Function;
  let IT be PartState of S;
  attr IT is p-autonomic means


  for P,Q being Instruction-Sequence of S
   st p c= P & p c= Q
  for s1,s2 being State of S st  IT c= s1 &  IT c= s2
  for i holds Comput(P,s1,i)|dom  IT = Comput(Q,s2,i)|dom  IT;
end;

definition
  let N;
  let S be halting IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N;
  let p be (the InstructionsF of S)-valued NAT-defined Function;
  let IT be PartState of S;
  attr IT is p-halted means


  for s being State of S st  IT c= s
  for P being Instruction-Sequence of S
   st p c= P
  holds P halts_on s;
end;

registration
  let N;
  cluster halting strict
   for IC-Ins-separated non empty with_non-empty_values AMI-Struct over N;
end;

begin 

theorem 
  for S being IC-Ins-separated non empty with_non-empty_values
       AMI-Struct over N
  for l being Element of NAT, I being Instruction of S
  for P being NAT-defined (the InstructionsF of S)-valued Function
   st l .--> I c= P
  for s being State of S st IC S .--> l c= s
   holds CurInstr(P,s) = I;

theorem 
  for S being halting IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N
  for l being Element of NAT
  for P being NAT-defined (the InstructionsF of S)-valued Function
   st l .--> halt S c= P
  for p being l-started PartState of S
   holds p is P-halted;

theorem 
  for S being halting IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N
  for l being Element of NAT
  for P being NAT-defined (the InstructionsF of S)-valued Function
   st l .--> halt S c= P
  for p being l-started PartState of S
  for s being State of S st p c= s
   for i holds Comput(P,s,i) = s;

theorem 
  for S be halting IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N
  for l being Element of NAT
  for P being NAT-defined (the InstructionsF of S)-valued Function
   st l .--> halt S c= P
  for p being l-started PartState of S
   holds p is P-autonomic;

registration
  let N;
  let S be halting IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N;
  let P be non halt-free (the InstructionsF of S)-valued NAT-defined Function;
  cluster P-autonomic P-halted non empty for FinPartState of S;
end;

definition
  let N;
  let S be halting IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N;
  let P be non halt-free
   NAT-defined (the InstructionsF of S)-valued Function;
  mode Autonomy of P -> FinPartState of S means

 it is P-autonomic P-halted;
end;

definition
  let N;
  let S be halting IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N;
  let p be non halt-free
   NAT-defined (the InstructionsF of S)-valued Function;
  let d be FinPartState of S;
  assume
 d is Autonomy of p;
  func Result(p,d) -> FinPartState of S means

  for P being Instruction-Sequence of S
   st p c= P
  for s being State of S st d c= s
  holds it = Result(P,s)|dom d;
end;

begin 

definition
  let N;
  let S be halting IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N;
  let p be non halt-free
   NAT-defined (the InstructionsF of S)-valued Function;
  let d be FinPartState of S, F be Function;
  pred p,d computes F means


  for x being set st x in dom F
   ex s being FinPartState of S
    st x = s & d +* s is Autonomy of p & F.s c= Result(p,d+* s);
end;

theorem 
  for S being halting IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N
 for p being non halt-free
  NAT-defined (the InstructionsF of S)-valued Function
 for d being FinPartState of S holds
  p,d computes {};

theorem 
  for S being halting IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N
  for p being non halt-free
   NAT-defined (the InstructionsF of S)-valued Function
  for d being FinPartState of S
  holds d is Autonomy of p iff p,d computes {} .--> Result(p,d);

theorem 
  for S being halting IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N
  for p being non halt-free
   NAT-defined (the InstructionsF of S)-valued Function
  for d being FinPartState of S
    holds d is Autonomy of p iff p,d computes {} .--> {};

begin 

registration
  let N;
  cluster IC-Ins-separated for non empty AMI-Struct over N;
end;

begin 

reserve N for with_zero non empty set;

theorem 
  for S being IC-Ins-separated halting
non empty with_non-empty_values AMI-Struct over N,
  p be NAT-defined (the InstructionsF of S)-valued Function,
    s being State of S holds p halts_on s
   iff ex i st p halts_at IC Comput(p,s,i);

theorem 
  for S being halting IC-Ins-separated
non empty with_non-empty_values AMI-Struct over N,
  p be NAT-defined (the InstructionsF of S)-valued Function,
  s being State of S,
    k being Nat st p halts_on s
  holds Result(p,s) = Comput(p,s,k) iff p halts_at IC Comput(p,s,k);

theorem 
  for S being halting IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N
 for P being (the InstructionsF of S)-valued NAT-defined Function,
  s being State of S, k st P halts_at IC Comput(P,s,k)
   holds Result(P,s) = Comput(P,s,k);

theorem 
  i <= j implies for S being halting
IC-Ins-separated non empty with_non-empty_values AMI-Struct over N
 for P being (the InstructionsF of S)-valued NAT-defined Function
 for s being State of S st P halts_at IC Comput(P,s,i)
  holds P halts_at IC Comput(P,s,j);

theorem 
  i <= j implies for S being halting IC-Ins-separated
non empty with_non-empty_values AMI-Struct over N
 for P being (the InstructionsF of S)-valued NAT-defined Function
 for s being State of S st P halts_at IC Comput(P,s,i)
   holds Comput(P,s,j) = Comput(P,s,i);

theorem 
  for S being IC-Ins-separated halting non empty with_non-empty_values
     AMI-Struct over N
 for P being Instruction-Sequence of S
 for s being State of S st ex k st P halts_at IC Comput(P,s,k)
   for i holds Result(P,s) = Result(P,Comput(P,s,i));

definition
  let N;
  let S be halting IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N;
  let p be NAT-defined (the InstructionsF of S)-valued Function;
  let s be State of S such that
 p halts_on s;
  func LifeSpan(p,s) -> Element of NAT means


  CurInstr(p,Comput(p,s,it)) = halt S &
  for k being Element of NAT st
   CurInstr(p,Comput(p,s,k)) = halt S
  holds it <= k;
end;

theorem 
  for N be non empty with_zero set,
      S be IC-Ins-separated halting
       non empty with_non-empty_values AMI-Struct over N,
      p being NAT-defined (the InstructionsF of S)-valued Function,
      s being State of S, m being Element of NAT
   holds p halts_on s iff p halts_on Comput(p,s,m);

reserve N for with_zero non empty set,
  S for IC-Ins-separated non empty AMI-Struct over N;

reserve m,n for Element of NAT;

theorem 
  for S being halting IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N,
   p being NAT-defined (the InstructionsF of S)-valued Function,
   s being State of S
  st p halts_on s
 holds Result(p,s) = Comput(p,s,LifeSpan(p,s));

theorem 
  for N be non empty with_zero set,
  S being halting IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N,
  P being Instruction-Sequence of S,
  s being State of S, k being Element of NAT
   st CurInstr(P,Comput(P,s,k)) = halt S
 holds Comput(P,s,LifeSpan(P,s)) = Comput(P,s,k);

theorem 
 for N be non empty with_zero set
 for S being halting IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N
  for p being NAT-defined (the InstructionsF of S)-valued Function
 for s being State of S st LifeSpan(p,s) <= j & p halts_on s
   holds Comput(p,s,j) = Comput(p,s,LifeSpan(p,s));

theorem 
  for N being with_zero non empty set,
      S being IC-Ins-separated non empty with_non-empty_values
            AMI-Struct over N,
      e being Nat,
      I being Instruction of S,
      t being e-started State of S,
      u being Instruction-Sequence of S
      st e .--> I c= u
    holds Following(u,t) = Exec(I, t);

theorem 
  for S being halting IC-Ins-separated non empty with_non-empty_values
       AMI-Struct over N,
  P being Instruction-Sequence of S,
  s being State of S st s = Following(P,s)
  holds for n holds Comput(P,s,n) = s;

theorem 
  for N being with_zero non empty set,
      S being IC-Ins-separated
           non empty with_non-empty_values AMI-Struct over N,
      P being Instruction-Sequence of S,
      s being State of S, i being Instruction of S
   holds Exec(P.IC s,s).IC S = IC Following(P,s);

theorem 
 for S being  IC-Ins-separated halting
  non empty with_non-empty_values AMI-Struct over N
   for P being Instruction-Sequence of S
   for s being State of S holds P halts_on s
   iff ex k st CurInstr(P,Comput(P,s,k)) = halt S;

reserve S for IC-Ins-separated halting
  non empty with_non-empty_values AMI-Struct over N;

theorem 
  for F being Instruction-Sequence of S
  for s being State of S st ex k being Element of NAT st F.(IC
  Comput(F,s,k)) = halt S holds F halts_on s;

theorem 
  for F being Instruction-Sequence of S
  for s being State of S, k being Element of NAT st F.(IC
  Comput(F,s,k)) = halt S holds Result(F,s) = Comput(F,s,k);

theorem 
  for F being Instruction-Sequence of S
  for s being State of S, k being Element of NAT
   holds F.(IC Comput(F,s,k)) <> halt S &
   F.(IC Comput(F,s,k+1)) = halt S iff LifeSpan(F,s) = k+1 & F halts_on s;

theorem 
  for F being Instruction-Sequence of S
  for s being State of S, k being Element of NAT st IC
  Comput(F,s,k) <> IC Comput(F,s,k+1) & F.(IC Comput(F,s,k+1)) = halt S
   holds LifeSpan(F,s) = k+1;

theorem 
  for F being Instruction-Sequence of S
  for s being State of S, k being Element of NAT st
    F halts_on Comput(F,s,k) & 0 < LifeSpan(F,Comput(F,s,k))
  holds LifeSpan(F,s) = k+LifeSpan(F,Comput(F,s,k));

theorem 
  for F being Instruction-Sequence of S
  for s being State of S, k being Element of NAT
   st F halts_on Comput(F,s,k)
   holds Result(F,Comput(F,s,k)) = Result(F,s);

reserve S for halting IC-Ins-separated non empty
   with_non-empty_values AMI-Struct over N;
reserve P for Instruction-Sequence of S;

theorem 
  for s being State of S st P halts_on s for k being Element
  of NAT st LifeSpan(P,s) <= k
   holds CurInstr(P, Comput(P,s,k)) = halt S;














begin 

reserve i,j,k for Element of NAT;

registration
 cluster -> with_zero for non zero Nat;
end;

reserve I,J,K for Element of Segm 9,
  a,a1,a2 for Element of NAT,
  b,b1,b2,c,c1 for Element of SCM-Data-Loc;

reserve T for InsType of SCM-Instr,
        I for Element of SCM-Instr;

definition
  func SCM -> strict AMI-Struct over 2 equals

  AMI-Struct(#
    SCM-Memory,In(NAT,SCM-Memory),SCM-Instr,SCM-OK,SCM-VAL,SCM-Exec#);
end;

registration
  cluster SCM -> non empty;
end;

registration
  cluster SCM -> with_non-empty_values;
end;

registration
  cluster SCM -> IC-Ins-separated;
end;

registration
 cluster Int-like for Object of SCM;
end;

definition
  mode Data-Location is Int-like Object of SCM;
end;

registration
  let s be State of SCM, d be Data-Location;
  cluster s.d -> integer;
end;

reserve a,b,c for Data-Location,
  loc for Nat,
  I for Instruction of SCM;

definition
  canceled;
  let a,b;
  func a := b -> Instruction of SCM equals

  [ 1, {}, <*a, b*>];
  func AddTo(a,b) -> Instruction of SCM equals

  [ 2, {}, <*a, b*>];
  func SubFrom(a,b) -> Instruction of SCM equals

  [ 3, {}, <*a, b*>];
  func MultBy(a,b) -> Instruction of SCM equals

  [ 4, {}, <*a, b*>];
  func Divide(a,b) -> Instruction of SCM equals

  [ 5, {}, <*a, b*>];
end;

definition
  let loc;
  func SCM-goto loc -> Instruction of SCM equals

  [ 6, <*loc*>, {} ];
  let a;
  func a=0_goto loc -> Instruction of SCM equals

  [ 7, <*loc*>, <*a*>];
  func a>0_goto loc -> Instruction of SCM equals

  [ 8, <*loc*>, <*a*>];
end;

reserve s for State of SCM;

theorem 
  IC SCM = NAT;

begin 

theorem 
  Exec(a:=b, s).IC SCM = succ IC s & Exec(a:=b, s).a = s.b & for c
  st c <> a holds Exec(a:=b, s).c = s.c;

theorem 
  Exec(AddTo(a,b), s).IC SCM = succ IC s & Exec(AddTo(a,b), s).a =
  s.a + s.b & for c st c <> a holds Exec(AddTo(a,b), s).c = s.c;

theorem 
  Exec(SubFrom(a,b), s).IC SCM = succ IC s & Exec(SubFrom(a,b), s)
  .a = s.a - s.b & for c st c <> a holds Exec(SubFrom(a,b), s).c = s.c;

theorem 
  Exec(MultBy(a,b), s).IC SCM = succ IC s & Exec(MultBy(a,b), s).a
  = s.a * s.b & for c st c <> a holds Exec(MultBy(a,b), s).c = s.c;

theorem 
  Exec(Divide(a,b), s).IC SCM = succ IC s & (a <> b implies Exec(
Divide(a,b), s).a = s.a div s.b) & Exec(Divide(a,b), s).b = s.a mod s.b & for c
  st c <> a & c <> b holds Exec(Divide(a,b), s).c = s.c;

theorem 
  Exec(SCM-goto loc, s).IC SCM = loc & Exec(SCM-goto loc, s).c = s.c;

theorem 
  (s.a = 0 implies Exec(a =0_goto loc, s).IC SCM = loc) & (s.a <>
0 implies Exec(a=0_goto loc, s).IC SCM = succ IC s) & Exec(a=0_goto loc, s).c =
  s.c;

theorem 
  (s.a > 0 implies Exec(a >0_goto loc, s).IC SCM = loc) & (s.a <=
0 implies Exec(a>0_goto loc, s).IC SCM = succ IC s) & Exec(a>0_goto loc, s).c =
  s.c;

reserve Y,K,T for Element of Segm 9,
  a1,a2,a3 for Element of NAT,
  b1,b2,c1,c2,
  c3 for Element of SCM-Data-Loc;

registration
  cluster SCM -> halting;
end;

begin 

definition
  let k be Nat;

  func dl.k -> Data-Location equals

  [1,k];

end;

reserve i,j,k for Nat;

theorem 
  i <> j implies dl.i <> dl.j;

theorem 
  for l being Data-Location holds Values l = INT;

definition
  let la be Data-Location;
  let a be Integer;
  redefine func la .--> a -> PartState of SCM;
end;

definition
  let la,lb be Data-Location;
  let a, b be Integer;
  redefine func (la,lb) --> (a,b) -> PartState of SCM;
end;

theorem 
  dl.i <> j;

theorem 
  IC SCM <> dl.i & IC SCM <> i;

begin  

theorem 
  for I being Instruction of SCM st ex s st Exec(I,s).IC SCM = succ IC s
  holds I is non halting;

theorem 
  for I being Instruction of SCM st I = [0,{},{}] holds I is halting;

theorem 
  a := b is non halting;

theorem 
  AddTo(a,b) is non halting;

theorem 
  SubFrom(a,b) is non halting;

theorem 
  MultBy(a,b) is non halting;

theorem 
  Divide(a,b) is non halting;

theorem 
  SCM-goto loc is non halting;

theorem 
  a=0_goto loc is non halting;

theorem 
  a>0_goto loc is non halting;



theorem 
  for I being set holds I is Instruction of SCM iff I = [0,{},{}] or (ex a,
b st I = a:=b) or (ex a,b st I = AddTo(a,b)) or (ex a,b st I = SubFrom(a,b)) or
  (ex a,b st I = MultBy(a,b)) or (ex a,b st I = Divide(a,b)) or (ex loc st I =
SCM-goto loc) or (ex a,loc st I = a=0_goto loc) or
 ex a,loc st I = a>0_goto loc;

theorem 
  for I being Instruction of SCM st I is halting holds I = halt SCM
;

theorem 
  halt SCM = [0,{},{}];

theorem 
  Data-Locations SCM = SCM-Data-Loc;

theorem 
 for d being Data-Location holds d in Data-Locations SCM;

theorem 
 for s being SCM-State holds s is State of SCM;

theorem 
  for l being Element of SCM-Instr holds InsCode l <= 8;














begin

reserve x,y,z for set,
  k for Element of NAT;

definition
  func SCM+FSA-Data*-Loc equals

  INT \ NAT;
end;

registration
  cluster SCM+FSA-Data*-Loc -> non empty;
end;

reserve J,J1,K for Element of Segm 13,
  a for Element of NAT,
  b,b1,b2,c,c1,c2 for Element of SCM-Data-Loc,
  f,f1,f2 for Element of SCM+FSA-Data*-Loc;

definition
  func SCM+FSA-Instr -> non empty set equals

  SCM-Instr \/ { [J,{},<*c,f,b*>] : J in {9,10} }
   \/ { [K,{},<*c1,f1*>] : K in {11,12} };
end;

theorem 
  SCM-Instr c= SCM+FSA-Instr;

registration
 cluster proj2 SCM+FSA-Instr -> FinSequence-membered;
end;

registration
  cluster SCM+FSA-Instr -> standard-ins non empty;
end;

theorem 
  for I being Element of SCM+FSA-Instr st I`1_3 <= 8 holds I in SCM-Instr;

theorem 
  [0,{},{}] in SCM+FSA-Instr;

theorem 
  x in {9,10} implies [x,{},<*c,f,b*>] in SCM+FSA-Instr;

theorem 
  x in {11,12} implies [x,{},<*c,f*>] in SCM+FSA-Instr;

definition
  let x be Element of SCM+FSA-Instr;
  given c,f,b,J such that
 x = [J,{},<*c,f,b*>];
  func x int_addr1 -> Element of SCM-Data-Loc means

  ex c,f,b st <*c,f,b*> = x`3_3 & it = c;
  func x int_addr2 -> Element of SCM-Data-Loc means

  ex c,f,b st <*c,f,b*> = x`3_3 & it = b;
  func x coll_addr1 -> Element of SCM+FSA-Data*-Loc means

  ex c,f,b st <*c,f,b*> = x`3_3 & it = f;
end;

definition
  let x be Element of SCM+FSA-Instr;
  given c such that
 x = [ 13,{}, <*c*>];
  func x int_addr -> Element of SCM-Data-Loc means

  ex c st <*c*> = x`3_3 & it = c;
end;

definition
  let x be Element of SCM+FSA-Instr;
  given c,f,J such that
 x = [ J,{}, <*c,f*>];
  func x int_addr3 -> Element of SCM-Data-Loc means

  ex c,f st <*c,f*> = x`3_3 & it = c;
  func x coll_addr2 -> Element of SCM+FSA-Data*-Loc means

  ex c,f st <*c,f*> = x`3_3 & it = f;

end;

theorem 
 SCM+FSA-Instr c= [:NAT,NAT*,proj2 SCM+FSA-Instr:];

theorem 
 for x being Element of SCM+FSA-Instr holds
  x in SCM-Instr &
   (InsCode x = 0 or InsCode x = 1 or InsCode x = 2 or InsCode x = 3 or
    InsCode x = 4 or InsCode x = 5 or InsCode x = 6 or InsCode x = 7 or
      InsCode x = 8) or
  x in { [J,{},<*c,f,b*>] : J in {9,10} }
        & (InsCode x = 9 or InsCode x = 10) or
  x in { [K,{},<*c1,f1*>] : K in {11,12} }
    & (InsCode x = 11 or InsCode x = 12);

registration
 cluster SCM+FSA-Instr -> homogeneous;
end;

reserve T for InsType of SCM+FSA-Instr;

theorem 
  T = 9 or T =10 implies JumpParts T = {{}};

theorem 
  T = 11 or T = 12 implies JumpParts T = {{}};

registration
 cluster SCM+FSA-Instr -> J/A-independent;
end;

registration
 cluster SCM+FSA-Instr -> with_halt;
end;














begin  

reserve i, j, k for Element of NAT,
  I for Element of Segm 8,
  i1, i2 for Element of NAT,
  d1, d2, d3, d4 for Element of SCM-Data-Loc,
  S for non empty 1-sorted;

registration
  cluster SCM-Instr -> non trivial;
end;

definition
  let S be non empty 1-sorted;
  func SCM-Instr S -> non empty set equals

  { [0,{},{}] }
   \/ { [I,{},<*a,b*>] where I is Element of Segm 8,
    a, b is Element of SCM-Data-Loc: I in { 1,2,3,4 } }
   \/ { [6,<*i*>,{}] where i is Element of NAT: not contradiction }
   \/ { [7,<*i*>,<*a*>] where i is Element of NAT,a is Element of SCM-Data-Loc:
        not contradiction }
   \/ { [5,{},<*a,r*>] where a is
  Element of SCM-Data-Loc, r is Element of S: not contradiction };
end;

registration
  let S be non empty 1-sorted;
  cluster SCM-Instr S -> non trivial;
end;

reserve G for non empty 1-sorted;

definition
  let S be non empty 1-sorted, x be Element of SCM-Instr S;
  given mk, ml being Element of SCM-Data-Loc, I such that
 x = [I,{},<*mk,ml*>];
  func x address_1 -> Element of SCM-Data-Loc means


  ex f being
  FinSequence of SCM-Data-Loc st f = x`3_3 & it = f/.1;
  func x address_2 -> Element of SCM-Data-Loc means


  ex f being
  FinSequence of SCM-Data-Loc st f = x`3_3 & it = f/.2;
end;

theorem 
  for x being Element of SCM-Instr S, mk, ml being Element of
SCM-Data-Loc st x = [I,{},<*mk,ml*>] holds x address_1 = mk & x address_2 = ml;

definition
  let R be non empty 1-sorted, x be Element of SCM-Instr R;
  given mk being Element of NAT, I such that
 x = [I,<*mk*>,{}];
  func x jump_address -> Element of NAT means


  ex f being FinSequence of
  NAT st f = x`2_3 & it = f/.1;
end;

theorem 
  for x being Element of SCM-Instr S, mk being Element of NAT
   st x = [ I,<*mk*>,{}] holds x jump_address = mk;

definition
  let S be non empty 1-sorted, x be Element of SCM-Instr S;
  given mk being Element of NAT, ml being Element of SCM-Data-Loc, I such that
 x = [I,<*mk*>,<*ml*>];
  func x cjump_address -> Element of NAT means


  ex mk being Element of NAT st <*mk*> = x`2_3 & it = <*mk*>/.1;
  func x cond_address -> Element of SCM-Data-Loc means


  ex ml being Element of SCM-Data-Loc st <*ml*> = x`3_3 & it = <*ml*>/.1;
end;

theorem 
  for x being Element of SCM-Instr S, mk being Element of NAT, ml being
  Element of SCM-Data-Loc st x = [I,<*mk*>,<*ml*>]
   holds x cjump_address = mk & x
  cond_address = ml;

definition
  let S be non empty 1-sorted, d be Element of SCM-Data-Loc, s be Element of S;
  redefine func <*d,s*> -> FinSequence of SCM-Data-Loc \/ the carrier of S;
end;

definition
  let S be non empty 1-sorted, x be Element of SCM-Instr S;
  given mk being Element of SCM-Data-Loc, r being Element of S, I such that
 x = [I,{},<*mk,r*>];
  func x const_address -> Element of SCM-Data-Loc means


  ex f being
  FinSequence of SCM-Data-Loc \/ the carrier of S st f = x`3_3 & it = f/.1;
  func x const_value -> Element of S means


  ex f being FinSequence of
  SCM-Data-Loc \/ the carrier of S st f = x`3_3 & it = f/.2;
end;

theorem 
  for x being Element of SCM-Instr S, mk being Element of SCM-Data-Loc,
  r being Element of S st x = [I,{},<*mk,r*>] holds x const_address = mk & x
  const_value = r;

theorem 
 for S being non empty 1-sorted
  holds  SCM-Instr S c= [:NAT,NAT*,proj2 SCM-Instr S:];

registration let S be non empty 1-sorted;
 cluster proj2 SCM-Instr S -> FinSequence-membered;
end;

theorem 
  [0,{},{}] in SCM-Instr S;

theorem 
  for S being non empty 1-sorted
  for x being Element of SCM-Instr S holds
  x in { [0,{},{}] } & InsCode x = 0 or
  x in { [I,{},<*a,b*>] where I is Element of Segm 8,
    a, b is Element of SCM-Data-Loc: I in { 1,2,3,4 } }
     & (InsCode x = 1 or InsCode x = 2 or InsCode x = 3
         or InsCode x = 4) or
  x in { [6,<*i*>,{}] where i is Element of NAT: not contradiction }
        & InsCode x = 6 or
  x in { [7,<*i*>,<*a*>]
       where i is Element of NAT,a is Element of SCM-Data-Loc:
        not contradiction }
    & InsCode x = 7 or
  x in { [5,{},<*a,r*>] where a is
  Element of SCM-Data-Loc, r is Element of S: not contradiction }
    & InsCode x = 5;

begin 

reserve I for Element of Segm 8,
  S for non empty 1-sorted,
  t for Element of S,
  x for set,
  k for Element of NAT;

registration
  cluster strict trivial for Ring;
end;

registration
  let R be Ring;
 cluster SCM-Instr R -> standard-ins;
end;

registration
  let R be Ring;
 cluster SCM-Instr R -> homogeneous;
end;

 reserve R for Ring, T for InsType of SCM-Instr R;

registration
  let R be Ring;
  cluster SCM-Instr R -> J/A-independent;
end;

reserve R for Ring,
  r for Element of R,
  a, b, c, d1, d2 for Element of SCM-Data-Loc;
reserve i1 for Element of NAT;

theorem 
  x in {1,2,3,4} implies [x,{},<*d1,d2*>] in SCM-Instr S;

theorem 
  [5,{},<*d1,t*>] in SCM-Instr S;

theorem 
  [6,<*i1*>,{}] in SCM-Instr S;

theorem 
  [7,<*i1*>,<*d1*>] in SCM-Instr S;

registration let S;
 cluster SCM-Instr S -> with_halt;
end;














begin

reserve x,y,z for set,
  k for Element of NAT;

notation
  synonym SCM+FSA-Data-Loc for SCM-Data-Loc;
end;

definition
 canceled;
  func SCM+FSA-Memory equals

  SCM-Memory \/ SCM+FSA-Data*-Loc;
end;

registration
  cluster SCM+FSA-Memory -> non empty;
end;

theorem 
  SCM-Memory c= SCM+FSA-Memory;

definition
  redefine func SCM+FSA-Data-Loc -> Subset of SCM+FSA-Memory;
end;

definition
  redefine func SCM+FSA-Data*-Loc -> Subset of SCM+FSA-Memory;
end;

registration
  cluster SCM+FSA-Data*-Loc -> non empty;
end;

reserve J,J1,K for Element of Segm 13,
  a for Element of NAT,
  b,b1,b2,c,c1,c2 for Element of SCM+FSA-Data-Loc,
  f,f1,f2 for Element of SCM+FSA-Data*-Loc;

definition
 canceled;
  func SCM+FSA-OK -> Function of SCM+FSA-Memory, 3 equals

   (SCM+FSA-Memory --> 2) +* SCM-OK;
end;

canceled 3;

theorem 
  NAT in SCM+FSA-Memory;

canceled 2;

theorem 
  SCM+FSA-Memory = {NAT} \/ SCM+FSA-Data-Loc \/ SCM+FSA-Data*-Loc;

definition
 func SCM*-VAL -> ManySortedSet of 3 equals

  <%NAT,INT,INT*%>;
end;

theorem 
  (SCM*-VAL*SCM+FSA-OK).NAT = NAT;

theorem 
  (SCM*-VAL*SCM+FSA-OK).b = INT;

theorem 
  (SCM*-VAL*SCM+FSA-OK).f = INT*;

registration
 cluster (SCM*-VAL*SCM+FSA-OK) -> non-empty;
end;

definition
  mode SCM+FSA-State is Element of product(SCM*-VAL*SCM+FSA-OK);
end;

canceled 5;

theorem 
  for s being SCM+FSA-State, I being Element of SCM-Instr holds s|
  SCM-Memory is SCM-State;

theorem 
  for s being SCM+FSA-State, s1 being SCM-State
   holds s +* s1 is SCM+FSA-State;

definition
  let s be SCM+FSA-State, u be Nat;
  func SCM+FSA-Chg(s,u) -> SCM+FSA-State equals

  s +* (NAT .--> u);
end;

definition
  let s be SCM+FSA-State, t be Element of SCM+FSA-Data-Loc, u be Integer;
  func SCM+FSA-Chg(s,t,u) -> SCM+FSA-State equals

  s +* (t .--> u);
end;

definition
  let s be SCM+FSA-State, t be Element of SCM+FSA-Data*-Loc, u be FinSequence
  of INT;
  func SCM+FSA-Chg(s,t,u) -> SCM+FSA-State equals

  s +* (t .--> u);
end;

registration
  let s be SCM+FSA-State, a be Element of SCM+FSA-Data-Loc;
  cluster s.a -> integer;
end;

definition
  let s be SCM+FSA-State, a be Element of SCM+FSA-Data*-Loc;
  redefine func s.a -> FinSequence of INT;
end;

definition
 canceled 6;
  let s be SCM+FSA-State;
  func IC(s) -> Element of NAT equals

  s.NAT;
end;

definition
  let x be Element of SCM+FSA-Instr, s be SCM+FSA-State;
  func SCM+FSA-Exec-Res(x,s) -> SCM+FSA-State means

    ex x9 being Element of SCM-Instr, s9 being SCM-State st
     x = x9 & s9 = s|SCM-Memory &
     it = s +* SCM-Exec-Res(x9,s9)
              if x`1_3 <= 8,
    ex i being Integer, k st
     k = abs(s.(x int_addr2)) & i = (s.(x coll_addr1))/.k &
        it = SCM+FSA-Chg(SCM+FSA-Chg(s,x int_addr1,i),succ IC s)
              if x`1_3 = 9,
    ex f being FinSequence of INT,k st
     k = abs(s.(x int_addr2)) & f = s.(x coll_addr1)+*(k,s.(x int_addr1)) &
      it = SCM+FSA-Chg(SCM+FSA-Chg(s,x coll_addr1,f),succ IC s)
              if x`1_3 = 10,
    it =
     SCM+FSA-Chg(SCM+FSA-Chg(s,x int_addr3,len(s.(x coll_addr2))),succ IC s)
              if x`1_3 = 11,
    ex f being FinSequence of INT,k st
     k = abs(s.(x int_addr3)) & f = k |-> 0 &
     it = SCM+FSA-Chg(SCM+FSA-Chg(s,x coll_addr2,f),succ IC s)
              if x`1_3 = 12,
    ex i being Integer st
     i = 1 &
     it = SCM+FSA-Chg(SCM+FSA-Chg(s,x int_addr,i),succ IC s)
              if x`1_3 = 13
    otherwise it = s;
end;

definition
  func SCM+FSA-Exec -> Action of SCM+FSA-Instr,
   product(SCM*-VAL*SCM+FSA-OK) means

  for x being Element of SCM+FSA-Instr, y being
  SCM+FSA-State holds (it.x).y = SCM+FSA-Exec-Res(x,y);
end;

theorem 
  for s being SCM+FSA-State, u being Element of NAT holds SCM+FSA-Chg(s,
  u).NAT = u;

theorem 
  for s being SCM+FSA-State, u being Element of NAT, mk being Element of
  SCM+FSA-Data-Loc holds SCM+FSA-Chg(s,u).mk = s.mk;

theorem 
  for s being SCM+FSA-State, u being Element of NAT, p being Element of
  SCM+FSA-Data*-Loc holds SCM+FSA-Chg(s,u).p = s.p;

theorem 
  for s being SCM+FSA-State, u,v being Element of NAT
   holds SCM+FSA-Chg(s,u).v = s.v;

theorem 
  for s being SCM+FSA-State, t being Element of SCM+FSA-Data-Loc, u
  being Integer holds SCM+FSA-Chg(s,t,u).NAT = s.NAT;

theorem 
  for s being SCM+FSA-State, t being Element of SCM+FSA-Data-Loc, u
  being Integer holds SCM+FSA-Chg(s,t,u).t = u;

theorem 
  for s being SCM+FSA-State, t being Element of SCM+FSA-Data-Loc, u
  being Integer, mk being Element of SCM+FSA-Data-Loc st mk <> t holds
  SCM+FSA-Chg(s,t,u).mk = s.mk;

theorem 
  for s being SCM+FSA-State, t being Element of SCM+FSA-Data-Loc, u
being Integer, f being Element of SCM+FSA-Data*-Loc holds SCM+FSA-Chg(s,t,u).f
  = s.f;

theorem 
  for s being SCM+FSA-State, t being Element of SCM+FSA-Data*-Loc, u
  being FinSequence of INT holds SCM+FSA-Chg(s,t,u).t = u;

theorem 
  for s being SCM+FSA-State, t being Element of SCM+FSA-Data*-Loc, u
  being FinSequence of INT, mk being Element of SCM+FSA-Data*-Loc st mk <> t
  holds SCM+FSA-Chg(s,t,u).mk = s.mk;

theorem 
  for s being SCM+FSA-State, t being Element of SCM+FSA-Data*-Loc, u
being FinSequence of INT, a being Element of SCM+FSA-Data-Loc holds SCM+FSA-Chg
  (s,t,u).a = s.a;

theorem 
  SCM+FSA-Data*-Loc misses SCM-Memory;

canceled;

theorem 
  dom(SCM*-VAL*SCM+FSA-OK) = SCM+FSA-Memory;

theorem 
 for s being SCM+FSA-State holds dom s = SCM+FSA-Memory;
















begin 

reserve
  i, j, k for Element of NAT,
  I,I2,I3,I4 for Element of Segm 15,
  i1 for Element of NAT,
  d1,d2,d3,d4,d5 for Element of SCM-Data-Loc,
  k1,k2 for Integer;

theorem 
  for k be Integer holds k in SCM-Data-Loc \/ INT;

begin  















definition
  func SCMPDS-Instr
  equals

{[0,{},{}]}
   \/ { [14,{},<*l*>] where l is Element of INT: not contradiction}
   \/ { [1,{},<*sp*> ] where sp is Element of SCM-Data-Loc:not contradiction}
   \/ { [I,{},<*v,c*>]
    where I is Element of Segm 15,v is Element of SCM-Data-Loc,
      c is Element of INT: I in {2,3} }
   \/ { [I,{},<*v,c1,c2*>] where I is Element of Segm 15,
      v is Element of SCM-Data-Loc, c1,c2 is Element of INT: I in {4,5,6,7,8} }
   \/ { [I,{},<*v1,v2,c1,c2*>]
    where I is Element of Segm 15, v1,v2 is Element of SCM-Data-Loc, c1,c2 is
  Element of INT: I in {9,10,11,12,13} };
end;

theorem 
  [14,{},<*0*>] in SCMPDS-Instr;

registration
  cluster SCMPDS-Instr -> non empty;
end;

definition
  let d be Element of SCM-Data-Loc, s be Integer;
  redefine func <*d,s*> -> FinSequence of SCM-Data-Loc \/ INT;
end;

definition
  let x be Element of SCMPDS-Instr;
  given mk be Element of SCM-Data-Loc, I such that
 x = [I,{},<*mk*>];
  func x address_1 -> Element of SCM-Data-Loc means


  ex f being FinSequence of SCM-Data-Loc st f = x`3_3 & it = f/.1;
end;

theorem 
  for x being Element of SCMPDS-Instr, mk being Element of SCM-Data-Loc
  st x = [I,{},<*mk*>] holds x address_1 = mk;

definition
  let x be Element of SCMPDS-Instr;
  given r being Integer, I such that
 x = [I,{},<*r*>];
  func x const_INT -> Integer means


  ex f being FinSequence of INT st f = x`3_3 & it = f/.1;
end;

theorem 
  for x being Element of SCMPDS-Instr, k being Integer st x = [ I,{}, <*k*>
  ] holds x const_INT = k;

definition
  let x be Element of SCMPDS-Instr;
  given mk being Element of SCM-Data-Loc, r being Integer, I such that
 x = [I,{},<*mk,r*>];
  func x P21address -> Element of SCM-Data-Loc means


  ex f being FinSequence of SCM-Data-Loc \/ INT st f = x`3_3 & it = f/.1;
  func x P22const -> Integer means


  ex f being FinSequence of SCM-Data-Loc \/ INT st f = x`3_3 & it = f/.2;
end;

theorem 
  for x being Element of SCMPDS-Instr, mk being Element of SCM-Data-Loc,
r being Integer st x = [I,{},<*mk,r*>] holds x P21address = mk & x P22const = r
;

definition
  let x be Element of SCMPDS-Instr;
  given m1 being Element of SCM-Data-Loc,k1,k2 be Integer,I such that
 x = [I,{},<*m1,k1,k2*>];
  func x P31address -> Element of SCM-Data-Loc means


  ex f being FinSequence of (SCM-Data-Loc \/ INT) st f = x`3_3 & it = f/.1;
  func x P32const -> Integer means


  ex f being FinSequence of SCM-Data-Loc \/ INT st f = x`3_3 & it = f/.2;
  func x P33const -> Integer means


  ex f being FinSequence of ( SCM-Data-Loc \/ INT) st f = x`3_3 & it = f/.3;
end;

theorem 
  for x being Element of SCMPDS-Instr, d1 being Element of SCM-Data-Loc,
  k1,k2 being Integer st x = [I,{}, <*d1,k1,k2*>] holds x P31address = d1 & x
  P32const = k1 & x P33const = k2;

definition
  let x be Element of SCMPDS-Instr;
  given m1,m2 being Element of SCM-Data-Loc,k1,k2 be Integer,I such that
 x = [I,{},<*m1,m2,k1,k2*>];
  func x P41address -> Element of SCM-Data-Loc means


  ex f being FinSequence of (SCM-Data-Loc \/ INT) st f = x`3_3 & it = f/.1;
  func x P42address -> Element of SCM-Data-Loc means


  ex f being FinSequence of (SCM-Data-Loc \/ INT) st f = x`3_3 & it = f/.2;
  func x P43const -> Integer means


  ex f being FinSequence of ( SCM-Data-Loc \/ INT) st f = x`3_3 & it = f/.3;
  func x P44const -> Integer means


  ex f being FinSequence of ( SCM-Data-Loc \/ INT) st f = x`3_3 & it = f/.4;
end;

theorem 
  for x being Element of SCMPDS-Instr, d1,d2 being Element of
  SCM-Data-Loc, k1,k2 being Integer st x = [I,{}, <*d1,d2,k1,k2*>] holds x
  P41address = d1 & x P42address = d2 & x P43const = k1 & x P44const = k2;




definition
  func RetSP -> Element of NAT equals

  0;
  func RetIC -> Element of NAT equals

  1;
end;

theorem 
 for x being Element of SCMPDS-Instr holds
  x in {[0,{},{}]} & InsCode x = 0 or
  x in { [14,{},<*l*>] where l is Element of INT: not contradiction} &
   InsCode x = 14 or
  x in { [1,{},<*sp*> ] where sp is Element of SCM-Data-Loc:not contradiction}
    & InsCode x = 1 or
  x in { [I,{},<*v,c*>]
    where I is Element of Segm 15,v is Element of SCM-Data-Loc,
      c is Element of INT: I in {2,3} }
   & (InsCode x = 2 or InsCode x = 3) or
  x in { [I,{},<*v,c1,c2*>] where I is Element of Segm 15,
      v is Element of SCM-Data-Loc, c1,c2 is Element of INT: I in {4,5,6,7,8} }
      & (InsCode x = 4 or InsCode x = 5 or
       InsCode x = 6 or InsCode x = 7 or InsCode x = 8) or
  x in { [I,{},<*v1,v2,c1,c2*>]
    where I is Element of Segm 15, v1,v2 is Element of SCM-Data-Loc, c1,c2 is
  Element of INT: I in {9,10,11,12,13} }
    & (InsCode x = 9 or InsCode x = 10 or InsCode x = 11
      or InsCode x = 12 or InsCode x = 13);

begin

reserve x for set,
  k for Element of NAT;

registration
 cluster proj2 SCMPDS-Instr -> FinSequence-membered;
end;

registration
 cluster SCMPDS-Instr -> standard-ins;
end;

registration
 cluster SCMPDS-Instr -> homogeneous;
end;

registration
 cluster SCMPDS-Instr -> J/A-independent;
end;

registration
 cluster SCMPDS-Instr -> with_halt;
end;

















begin 

reserve
  i, j, k for Element of NAT,
  I,I2,I3,I4 for Element of Segm 15,
  i1 for Element of NAT,
  d1,d2,d3,d4,d5 for Element of SCM-Data-Loc,
  k1,k2 for Integer;

canceled 2;

theorem 
  for d be Element of SCM-Data-Loc holds d in SCM-Data-Loc \/ INT;

begin  















definition
 canceled 5;
  let s be SCM-State, a be Element of SCM-Data-Loc, n be Integer;
  func Address_Add(s,a,n) -> Element of SCM-Data-Loc equals

  [1,abs(s.a+n)];
end;

definition
  let s be SCM-State, n be Integer;
  func jump_address(s,n) -> Element of NAT equals

  abs((IC s qua Element of NAT)+n);
end;

definition
  let d be Element of SCM-Data-Loc, s be Integer;
  redefine func <*d,s*> -> FinSequence of SCM-Data-Loc \/ INT;
end;

definition
 canceled 11;
  let s be SCM-State, a be Element of SCM-Data-Loc;
  func PopInstrLoc(s,a) -> Element of NAT equals

  abs(s.a)+2;
end;




definition
 canceled 2;
end;

definition
  let x be Element of SCMPDS-Instr, s be SCM-State;
  func SCM-Exec-Res (x,s) -> SCM-State equals

  SCM-Chg(s, jump_address(s,x const_INT ))
   if InsCode x = 14,
  SCM-Chg(SCM-Chg(s, x P21address, x P22const), succ IC s)
   if InsCode x = 2,
  SCM-Chg(SCM-Chg(s,Address_Add(s,x P21address,x P22const),
   IC s qua Element of NAT),succ IC s)
   if InsCode x = 3,
  SCM-Chg(SCM-Chg(s, x address_1,s.Address_Add(s,x address_1,RetSP)),
    PopInstrLoc(s,Address_Add(s,x address_1,RetIC)) )
   if InsCode x = 1,
  SCM-Chg(s,IFEQ(s.Address_Add(s,x P31address,x P32const), 0, succ IC s,
        jump_address(s,x P33const )))
   if InsCode x = 4,
  SCM-Chg(s,IFGT(s.Address_Add(s,x P31address,x P32const), 0, succ IC
      s,jump_address(s,x P33const )))
   if InsCode x = 5,
  SCM-Chg(s, IFGT(0, s.Address_Add(s,x P31address,x P32const), succ IC s,
         jump_address(s,x P33const )))
   if InsCode x = 6,
  SCM-Chg(SCM-Chg(s,
    Address_Add(s,x P31address,x P32const), x P33const), succ IC s)
   if InsCode x = 7,
  SCM-Chg(SCM-Chg(s,Address_Add(s,x P31address,x P32const),
      s.Address_Add(s,x P31address,x P32const)+ (x P33const)), succ IC s)
   if InsCode x = 8,
  SCM-Chg(SCM-Chg(s,Address_Add(s,x P41address,x P43const),
      s.Address_Add(s,x P41address,x P43const)+
      s.Address_Add(s,x P42address,x P44const)),succ IC s)
   if InsCode x = 9,
  SCM-Chg(SCM-Chg(s, Address_Add(s,x P41address,x P43const),
    s.Address_Add(s,x P41address,x P43const) - s.Address_Add(s,x
    P42address,x P44const)),succ IC s)
   if InsCode x = 10,
  SCM-Chg(SCM-Chg(s, Address_Add(s,x P41address,x P43const),
      s.Address_Add(s,x P41address,x P43const) *
      s.Address_Add(s,x P42address,x P44const)),succ IC s)
   if InsCode x = 11,
  SCM-Chg(SCM-Chg(s,Address_Add(s,x P41address,x P43const),
      s.Address_Add(s,x P42address,x P44const)), succ IC s)
   if InsCode x = 13,
  SCM-Chg(SCM-Chg(SCM-Chg(s,Address_Add(s,x P41address,x P43const),
    s.Address_Add(s,x P41address,x P43const) div
    s.Address_Add(s,x P42address,x P44const)),
      Address_Add(s,x P42address,x P44const),
    s.Address_Add(s,x P41address,x P43const) mod
    s.Address_Add(s,x P42address,x P44const)), succ IC s)
   if InsCode x = 12
  otherwise s;
end;

definition
  func SCMPDS-Exec -> Action of SCMPDS-Instr,
     product(SCM-VAL*SCM-OK) means

  for x being Element of SCMPDS-Instr, y being
  SCM-State holds (it.x).y = SCM-Exec-Res (x,y);
end;















begin  

reserve i, j, k for Element of NAT,
  I for Element of Segm 8,
  i1, i2 for Element of NAT,
  d1, d2, d3, d4 for Element of SCM-Data-Loc,
  S for non empty 1-sorted;

reserve G for non empty 1-sorted;

definition
 canceled 2;
  let S be non empty 1-sorted;
 func SCM-VAL S -> ManySortedSet of 2 equals

  <%NAT,the carrier of S%>;
end;

canceled;

theorem 
 ((SCM-VAL G)*SCM-OK).NAT = NAT;

theorem 
  for i being Element of SCM-Memory st i in SCM-Data-Loc
   holds ((SCM-VAL G)*SCM-OK).i = the carrier of G;

registration let G;
 cluster ((SCM-VAL G)*SCM-OK) -> non-empty;
end;

definition
  let S be non empty 1-sorted;
  mode SCM-State of S is Element of product((SCM-VAL S)*SCM-OK);
end;

theorem 
  ((SCM-VAL G)*SCM-OK).d1 = the carrier of G;

theorem 
  pi(product((SCM-VAL G)*SCM-OK),NAT) = NAT;

theorem 
  for a being Element of SCM-Data-Loc
   holds pi(product((SCM-VAL G)*SCM-OK),a) = the carrier of G;

definition
  let G; let s be SCM-State of G;
  func IC s -> Element of NAT equals

  s.NAT;
end;

definition
  let R be non empty 1-sorted, s be SCM-State of R, u be Nat;
  func SCM-Chg(s,u) -> SCM-State of R equals

  s +* (NAT .--> u);
end;

theorem 
  for s being SCM-State of G, u being Nat holds SCM-Chg(s,u).NAT = u;

theorem 
  for s being SCM-State of G, u being Nat, mk being Element of
  SCM-Data-Loc holds SCM-Chg(s,u).mk = s.mk;

theorem 
  for s being SCM-State of G, u, v being Nat holds SCM-Chg(s,u).v = s.v;

definition
  let R be non empty 1-sorted, s be SCM-State of R, t be Element of
  SCM-Data-Loc, u be Element of R;
  func SCM-Chg(s,t,u) -> SCM-State of R equals

  s +* (t .--> u);
end;

theorem 
  for s being SCM-State of G, t being Element of SCM-Data-Loc, u being
  Element of G holds SCM-Chg(s,t,u).NAT = s.NAT;

theorem 
  for s being SCM-State of G, t being Element of SCM-Data-Loc, u being
  Element of G holds SCM-Chg(s,t,u).t = u;

theorem 
  for s being SCM-State of G, t being Element of SCM-Data-Loc, u being
Element of G, mk being Element of SCM-Data-Loc st mk <> t holds SCM-Chg(s,t,u).
  mk = s.mk;

definition
  let R be non empty 1-sorted, s be SCM-State of R, a be Element of
  SCM-Data-Loc;
  redefine func s.a -> Element of R;
end;

definition
  let S be non empty 1-sorted, d be Element of SCM-Data-Loc, s be Element of S;
  redefine func <*d,s*> -> FinSequence of SCM-Data-Loc \/ the carrier of S;
end;

definition
 canceled 7;
  let R be Ring, x be Element of SCM-Instr R, s be SCM-State of R;
  func SCM-Exec-Res (x,s) -> SCM-State of R equals

  SCM-Chg(SCM-Chg(s, x address_1, s.(x address_2)), succ IC s)
   if ex mk, ml being Element of SCM-Data-Loc st x = [1,{},<*mk,ml*>],
  SCM-Chg(SCM-Chg(s, x address_1, s.(x address_1)+s.(x address_2)), succ IC s)
   if ex mk, ml being Element of SCM-Data-Loc st x = [2,{},<*mk,ml*>],
  SCM-Chg(SCM-Chg(s, x address_1, s.(x address_1)-s.(x address_2)), succ IC s)
   if ex mk, ml being Element of SCM-Data-Loc st x = [3,{},<*mk,ml*>],
  SCM-Chg(SCM-Chg(s, x address_1, s.(x address_1)*s.(x address_2)), succ IC s)
   if ex mk, ml being Element of SCM-Data-Loc st x = [4,{},<*mk,ml*>],
  SCM-Chg(s, x jump_address)
   if ex mk being Element of NAT st x = [6,<*mk*>,{}],
  SCM-Chg(s, IFEQ(s.(x cond_address), 0.R, x cjump_address, succ IC s))
   if ex mk being Element of NAT, ml being Element of SCM-Data-Loc
    st x = [7,<*mk*>,<*ml*>],
  SCM-Chg(SCM-Chg(s, x const_address, x const_value), succ IC s)
   if ex mk being Element of SCM-Data-Loc, r being Element of R
    st x = [5,{},<*mk,r*>]
  otherwise s;
end;

definition
  let R be Ring;
  func SCM-Exec R -> Action of SCM-Instr R,
    product((SCM-VAL R)*SCM-OK) means

  for x being Element of SCM-Instr R, y being SCM-State of R
  holds (it.x).y = SCM-Exec-Res (x,y);
end;

canceled 6;

theorem 
 for s being SCM-State of S holds dom s = SCM-Memory;















begin 

reserve x for set,
  D for non empty set,
  k, n for Element of NAT,
  z for Nat;

reserve
  N for with_zero set,
  S for IC-Ins-separated non empty
          with_non-empty_values AMI-Struct over N,
  i for Element of the InstructionsF of S,
  l, l1, l2, l3 for Element of NAT,
  s for State of S;

registration
  let N be with_zero set, S be
   with_non-empty_values AMI-Struct over N,
      i be Element of the InstructionsF of S, s be State of S;
  cluster ((the Execution of S).i).s -> Function-like Relation-like;
end;

registration let N;
 cluster non empty with_non-empty_values for AMI-Struct over N;
end;

definition
  let N be with_zero set;
  let S be non empty with_non-empty_values AMI-Struct over N;
  let T be InsType of the InstructionsF of S;
  attr T is jump-only means

  for s being State of S, o being Object of S, I
  being Instruction of S st InsCode I = T &
   o in Data-Locations S
  holds Exec(I, s).o = s.o;
end;

definition
  let N be with_zero set;
  let S be non empty with_non-empty_values AMI-Struct over N;
  let I be Instruction of S;
  attr I is jump-only means

  InsCode I is jump-only;
end;

reserve ss for Element of product the_Values_of S;

definition
  let N,S; let l be Nat;
  let i be Element of the InstructionsF of S;
  func NIC(i,l) -> Subset of NAT equals

   { IC Exec(i,ss) : IC ss = l };
end;

registration
  let N be with_zero set,
  S be IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N, i be Element of the
  InstructionsF of S, l be Element of NAT;
  cluster NIC(i,l) -> non empty;
end;

definition
  let N,S,i;
  func JUMP i -> Subset of NAT equals

  meet { NIC(i,l) : not contradiction };
end;

definition
  let N,S; let l be Nat;
  func SUCC(l,S) -> Subset of NAT equals

  union { NIC(i,l) \ JUMP i : not
  contradiction };
end;



theorem 
  for i being Element of the InstructionsF of S
   st for l being Element of NAT holds NIC(i,l)={l}
  holds JUMP i is empty;

theorem 
  for S being IC-Ins-separated non empty with_non-empty_values
         AMI-Struct over N,
      il being Element of NAT, i being Instruction of S st i is halting
  holds NIC(i,il) = {il};

begin 

definition

  let N, S;
  attr S is standard means


  for m, n being Element of NAT holds m <= n iff
   ex f being non empty FinSequence of NAT st f/.1 = m & f/.len f = n &
    for n st 1 <= n & n < len f holds f/.(n+1) in SUCC(f/.n,S);
end;



theorem 
   S is standard iff
   for k being Element of NAT holds k+1 in SUCC(k,S) &
    for j being Element of NAT st j in SUCC(k,S) holds k <= j;

begin 

definition
  let N be with_zero set;
  func STC N -> strict AMI-Struct over N means


  the carrier of it = {0} & the ZeroF of it = 0 &
  the InstructionsF of it = {[0,0,0],[1,0,0]} &

  the Object-Kind of it = (0 .--> 0) &
  the ValuesF of it = N --> NAT &
  ex f being Function of product the_Values_of it,
                         product the_Values_of it st
  (for s being Element of product the_Values_of it holds
   f.s = s+*(0 .-->succ(s.0))) &
  the Execution of it = ([1,0,0] .--> f) +*
    ([0,0,0] .--> id product the_Values_of it);
end;

registration
  let N be with_zero set;
  cluster STC N -> finite non empty;
end;

registration
  let N be with_zero set;
  cluster STC N -> with_non-empty_values;
end;

registration
  let N be with_zero set;
  cluster STC N -> IC-Ins-separated;
end;

theorem 
  for i being Instruction of STC N st InsCode i = 0 holds i is halting;

theorem 
  for i being Instruction of STC N st InsCode i = 1 holds i is non halting;

theorem 
  for i being Element of the InstructionsF of STC N
    holds InsCode i = 1 or InsCode i = 0;

theorem 
  for i being Instruction of STC N holds i is jump-only;

registration let N;
 cluster -> ins-loc-free for Instruction of STC N;
end;

theorem 
  for l being Element of NAT st l = z holds SUCC(l,STC N) = {z, z+1};

registration
  let N be with_zero set;
  cluster STC N -> standard;
end;

registration
  let N be with_zero set;
  cluster STC N -> halting;
end;

registration
  let N be with_zero set;
  cluster standard halting for IC-Ins-separated
      non empty with_non-empty_values AMI-Struct over N;
end;

reserve T for standard IC-Ins-separated non empty
     with_non-empty_values AMI-Struct over N;

theorem 
  for i being Instruction of STC N, s being State of STC N st InsCode i = 1
   holds Exec(i,s).IC STC N = succ IC s;

theorem 
  for l being Element of NAT, i being Element of the
  InstructionsF of STC N st InsCode i = 1 holds NIC(i, l) = {succ l};

theorem 
  for l being Element of NAT holds SUCC(l,STC N) = {l, succ l};

definition
  let N be with_zero set,
  S be IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N,
  i be Instruction of S;
  attr i is sequential means

  for s being State of S holds Exec(i, s).IC S = succ IC s;
end;

theorem 
  for S being IC-Ins-separated non empty with_non-empty_values
         AMI-Struct over N,
      il being Element of NAT, i being Instruction of S st i is sequential
       holds NIC(i,il) = {succ il};

registration
  let N;
  let S be IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N;
  cluster sequential -> non halting for Instruction of S;
  cluster halting -> non sequential for Instruction of S;
end;

theorem 
 for T being IC-Ins-separated non empty with_non-empty_values AMI-Struct over N
  for i being Instruction of T st JUMP i is non empty holds i is non
  sequential;

begin 

definition
  let N be with_zero set;
  let S be IC-Ins-separated non empty
  with_non-empty_values AMI-Struct over N;
  let F be finite preProgram of S;
  attr F is really-closed means


  for l being Element of NAT st l in dom F holds NIC (F/.l, l) c= dom F;
end;

definition
  let N be with_zero set;
  let S be IC-Ins-separated non empty with_non-empty_values AMI-Struct over N;
  let F be NAT-defined (the InstructionsF of S)-valued Function;
  attr F is paraclosed means

  for s being 0-started State of S
  for P being Instruction-Sequence of S st F c= P
   for k being Element of NAT holds IC Comput(P,s,k) in dom F;
end;

definition
  let N be with_zero set;
  let S be halting IC-Ins-separated non empty with_non-empty_values
         AMI-Struct over N;
  let F be NAT-defined (the InstructionsF of S)-valued Function;
  attr F is parahalting means

  for s being 0-started State of S
  for P being Instruction-Sequence of S st F c= P
   holds P halts_on s;
end;

theorem 
 for N being with_zero set
 for S being IC-Ins-separated non empty with_non-empty_values AMI-Struct over N
 for F being finite preProgram of S
  holds F is really-closed iff
  for s being State of S st IC s in dom F
   for k being Element of NAT holds IC Comput(F,s,k) in dom F;

theorem 
  for S being standard IC-Ins-separated non empty
        with_non-empty_values AMI-Struct over N,
   F being NAT-defined (the InstructionsF of S)-valued
  finite Function st F is really-closed & 0 in dom F holds F is
  paraclosed;

theorem 
  for S being standard halting IC-Ins-separated
 non empty with_non-empty_values AMI-Struct over N holds 0 .-->
  halt S qua NAT-defined (the InstructionsF of S)-valued
   finite Function is really-closed;

registration
  let N be with_zero set,
  S be standard IC-Ins-separated non empty
     with_non-empty_values AMI-Struct over N;
  cluster really-closed initial non empty -> paraclosed for NAT-defined
    (the InstructionsF of S)-valued finite Function;
end;

registration
  let N be with_zero set;
  let S be standard halting IC-Ins-separated non empty
  with_non-empty_values AMI-Struct over N;
  cluster trivial really-closed initial non empty
   for NAT-defined (the InstructionsF of S)-valued finite Function;
end;

registration
  let N be with_zero set;
  let S be standard halting IC-Ins-separated non empty
  with_non-empty_values AMI-Struct over N;
  cluster halt-ending unique-halt trivial really-closed
   for initial non empty NAT-defined
    (the InstructionsF of S)-valued finite Function;
end;

registration
  let N be with_zero set;
  let S be standard halting IC-Ins-separated non empty
  with_non-empty_values AMI-Struct over N;
  cluster really-closed for MacroInstruction of S;
end;

theorem 
  for i being Instruction of Trivial-AMI(N) holds i is halting;

theorem 
  for i being Element of the InstructionsF of Trivial-AMI N holds InsCode i = 0
;

begin 



theorem 
  for N being with_zero set, S
being IC-Ins-separated non empty with_non-empty_values AMI-Struct over N,
 i being Instruction of S, l being Element of NAT
 holds JUMP(i) c= NIC(i,l);

theorem 
 for i being Instruction of STC N, s being State of STC N st InsCode i = 1
  holds Exec(i,s) = IncIC(s,1);

registration let N; let p be PartState of STC N;
 cluster DataPart p -> empty;
end;

theorem 
 for N being with_zero set
 for S being IC-Ins-separated non empty with_non-empty_values AMI-Struct over N
 for F being finite preProgram of S
  holds F is really-closed iff
  for s being State of S st IC s in dom F
  for P being Instruction-Sequence of S st F c= P
   for k being Element of NAT holds IC Comput(P,s,k) in dom F;

registration
  let N be with_zero set;
  let S be halting IC-Ins-separated non empty with_non-empty_values
         AMI-Struct over N;
 cluster parahalting
    for finite non halt-free non empty
       NAT-defined (the InstructionsF of S)-valued Function;
end;














begin  

reserve k, m for Nat,
  x, x1, x2, x3, y, y1, y2, y3, X,Y,Z for set,
  N for with_zero set;

theorem 
  for I being Instruction of STC N holds JumpPart I = 0;

definition
  let N be with_zero set,
  S be IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N, I be Instruction of S;
  attr I is with_explicit_jumps means

 JUMP I = rng JumpPart I;
end;

definition
  let N be with_zero set,
  S be IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N;
  attr S is with_explicit_jumps means

 for I being Instruction of S holds I is with_explicit_jumps;

end;

registration
  let N be with_zero set;
  cluster standard for IC-Ins-separated
    non empty with_non-empty_values AMI-Struct over N;
end;

theorem 
  for S being standard IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N, I being Instruction of S
  st for f being Element of NAT holds NIC(I,f)={succ f}
  holds JUMP I is empty;

registration
  let N be with_zero set,
  I be Instruction of STC N;
  cluster JUMP I -> empty;
end;

theorem 
  for T being InsType of the InstructionsF of STC N holds JumpParts T = {0};

registration
  let N be with_zero set;
  cluster STC N -> with_explicit_jumps;
end;

registration
  let N be with_zero set;
  cluster standard
   halting with_explicit_jumps for IC-Ins-separated
    non empty with_non-empty_values AMI-Struct over N;
end;

registration
  let N be with_zero set,
  I be Instruction of Trivial-AMI N;
  cluster JUMP I -> empty;
end;

registration
  let N be with_zero set;
  cluster Trivial-AMI N -> with_explicit_jumps;
end;

registration
  let N be with_zero set;
  cluster with_explicit_jumps halting
    for IC-Ins-separated non empty with_non-empty_values AMI-Struct over N;
end;

registration
  let N be with_zero set;
  let S be with_explicit_jumps IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N;
  cluster -> with_explicit_jumps for Instruction of S;
end;

theorem 
  for S being IC-Ins-separated non empty with_non-empty_values
  AMI-Struct over N,
  I being Instruction of S st I is halting holds JUMP I is empty;

registration

  let N be with_zero set,
  S be halting
  IC-Ins-separated non empty with_non-empty_values AMI-Struct over N,
  I be halting Instruction of S;
  cluster JUMP I -> empty;
end;

theorem 
  for S being halting with_explicit_jumps
  IC-Ins-separated non empty
  with_non-empty_values AMI-Struct over N,
  I being Instruction of S st I is ins-loc-free holds JUMP I is empty;

registration

  let N be with_zero set,
  S be with_explicit_jumps
   IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N;
  cluster halting -> ins-loc-free for Instruction of S;
end;

registration
  let N be with_zero set,
  S be with_explicit_jumps
    IC-Ins-separated non empty with_non-empty_values AMI-Struct over N;
  cluster sequential -> ins-loc-free for Instruction of S;
end;

registration
  let N be with_zero set,
  S be standard halting
  IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N;
  cluster Stop S -> really-closed;
end;

begin  

registration
  let N be with_zero set,
  S be halting with_explicit_jumps IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N,
  I be halting Instruction of S, k be Nat;
  cluster IncAddr(I,k) -> halting;
end;

theorem 
  for S being standard halting
  with_explicit_jumps IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N,
  I being Instruction of S st I is sequential
  holds IncAddr(I,k) is sequential;

definition

  let N be with_zero set,
  S be halting
   IC-Ins-separated non empty with_non-empty_values AMI-Struct over N,
   I be Instruction of S;
  attr I is IC-relocable means


  for j,k being Nat, s being State of S
  holds IC Exec(IncAddr(I,j),s) + k = IC Exec(IncAddr(I,j+k),IncIC(s,k));
end;

definition
  let N be with_zero set,
  S be halting IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N;
  attr S is IC-relocable means


  for I being Instruction of S holds I is IC-relocable;
end;

registration
  let N be with_zero set,
  S be with_explicit_jumps IC-Ins-separated halting
  non empty with_non-empty_values AMI-Struct over N;
  cluster sequential -> IC-relocable for Instruction of S;
end;

registration
  let N be with_zero set,
  S be with_explicit_jumps IC-Ins-separated halting
  non empty with_non-empty_values AMI-Struct over N;
  cluster halting -> IC-relocable for Instruction of S;
end;

registration
  let N be with_zero set;
  cluster STC N -> IC-relocable;
end;

registration
  let N be with_zero set;
  cluster halting with_explicit_jumps
    for standard IC-Ins-separated
    non empty with_non-empty_values AMI-Struct over N;
end;

registration
  let N be with_zero set;
  cluster IC-relocable for
    with_explicit_jumps halting
    standard IC-Ins-separated
    non empty with_non-empty_values AMI-Struct over N;
end;

registration
  let N be with_zero set,
  S be IC-relocable IC-Ins-separated halting
  non empty with_non-empty_values AMI-Struct over N;
  cluster -> IC-relocable for Instruction of S;
end;

registration
  let N be with_zero set,
  S be with_explicit_jumps IC-Ins-separated halting
  non empty with_non-empty_values AMI-Struct over N;
 cluster IC-relocable for Instruction of S;
end;

theorem 
  for S be halting
  with_explicit_jumps
   IC-Ins-separated non empty with_non-empty_values
   AMI-Struct over N,
  I being IC-relocable Instruction of S
  for k being Nat, s being State of S
  holds IC Exec(I,s) + k = IC Exec(IncAddr(I,k),IncIC(s,k));

registration
  let N be with_zero set,
  S be IC-relocable standard with_explicit_jumps
  halting IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N,
  F, G be really-closed initial non empty NAT-defined
  (the InstructionsF of S)-valued finite Function;
  cluster F ';' G -> really-closed;
end;

theorem 
  for I being Instruction of Trivial-AMI N holds JumpPart I = 0;

theorem 
  for T being InsType of the InstructionsF of Trivial-AMI N
    holds JumpParts T = {0};

reserve n,m for Element of NAT;

theorem 
 for S being IC-Ins-separated non empty with_non-empty_values AMI-Struct over N
 for s being State of S, I being Program of S
 for P1,P2 being Instruction-Sequence of S
  st I c= P1 & I c= P2 &
     for m st m < n holds IC Comput(P2,s,m) in dom I
 for m st m <= n holds Comput(P1,s,m) =  Comput(P2,s,m);

theorem 
 for S being IC-Ins-separated halting non empty with_non-empty_values
  AMI-Struct over N,
  P being Instruction-Sequence of S,
  s being State of S st  s =  Following(P,s)
  holds for n holds Comput(P,s,n) =  s;















begin 

reserve N for with_zero set;

definition
  let N be with_zero set,
  A be IC-Ins-separated non
empty with_non-empty_values AMI-Struct over N, s be State of A,
o be Object of A,
  a be Element of Values o;
  redefine func s+*(o,a) -> State of A;
end;

theorem 
  for A being standard IC-Ins-separated non empty
with_non-empty_values AMI-Struct over N, I being Instruction of A,
s being State
of A, o being Object of A, w being Element of Values o st I is sequential &
  o <> IC A holds IC Exec(I,s) = IC Exec(I,s+*(o,w));

theorem 
  for A being standard IC-Ins-separated non empty
with_non-empty_values AMI-Struct over N, I being Instruction of A,
s being State
of A, o being Object of A, w being Element of Values o st I is sequential &
  o <> IC A holds IC Exec(I,s+*(o,w)) = IC (Exec(I,s) +* (o,w));

begin 

definition
  let A be COM-Struct;
  attr A is with_non_trivial_Instructions means


  the InstructionsF of A is non trivial;
end;

definition
  let N be with_zero set, A be non empty with_non-empty_values
  AMI-Struct over N;
  attr A is with_non_trivial_ObjectKinds means


  for o being Object of A
  holds Values o is non trivial;
end;

registration
  let N be with_zero set;
  cluster STC N -> with_non_trivial_ObjectKinds;
end;

registration
  let N be with_zero set;
  cluster with_explicit_jumps
    IC-relocable with_non_trivial_ObjectKinds with_non_trivial_Instructions
 for standard halting
  IC-Ins-separated non empty with_non-empty_values AMI-Struct over N;
end;

registration
  let N be with_zero set;
  cluster STC N -> with_non_trivial_Instructions;
end;

registration
  let N be with_zero set;
  cluster with_non_trivial_ObjectKinds with_non_trivial_Instructions
    IC-Ins-separated for non empty with_non-empty_values AMI-Struct over N;
end;

registration
  let N be with_zero set,
   A be with_non_trivial_ObjectKinds non
  empty with_non-empty_values AMI-Struct over N, o be Object of A;
  cluster Values o -> non trivial;
end;

registration
  let N be with_zero set,
  A be with_non_trivial_Instructions
  with_non-empty_values AMI-Struct over N;
  cluster the InstructionsF of A -> non trivial;
end;

registration
  let N be with_zero set,
  A be IC-Ins-separated non empty
  with_non-empty_values AMI-Struct over N;
  cluster Values IC A -> non trivial;
end;

definition

  let N be with_zero set, A be non empty
  with_non-empty_values AMI-Struct over N, I be Instruction of A;
  func Output I -> Subset of A means


  for o being Object of A holds o in
  it iff ex s being State of A st s.o <> Exec(I,s).o;
end;

definition

  let N be with_zero set,
  A be IC-Ins-separated non
  empty with_non-empty_values AMI-Struct over N, I be Instruction of A;
  func Out_\_Inp I -> Subset of A means


  for o being Object of A holds o
in it iff for s being State of A, a being Element of Values o holds Exec(I,
  s) = Exec(I,s+*(o,a));
  func Out_U_Inp I -> Subset of A means


  for o being Object of A holds o
in it iff ex s being State of A, a being Element of Values o st Exec(I,s+*(
  o,a)) <> Exec(I,s) +* (o,a);
end;

definition

  let N be with_zero set,
  A be IC-Ins-separated non
  empty with_non-empty_values AMI-Struct over N, I be Instruction of A;
  func Input I -> Subset of A equals

  Out_U_Inp I \ Out_\_Inp I;
end;

theorem 
  for A being with_non_trivial_ObjectKinds IC-Ins-separated
non empty with_non-empty_values AMI-Struct over N, I being Instruction
  of A holds Out_\_Inp I c= Output I;

theorem 
  for A being IC-Ins-separated non empty
  with_non-empty_values AMI-Struct over N,
  I being Instruction of A holds Output I c= Out_U_Inp I;

theorem 
  for A being with_non_trivial_ObjectKinds IC-Ins-separated
non empty with_non-empty_values AMI-Struct over N, I being Instruction of A
 holds
  Out_\_Inp I = Output I \ Input I;

theorem 
  for A being with_non_trivial_ObjectKinds IC-Ins-separated
non empty with_non-empty_values AMI-Struct over N, I being Instruction of A
 holds
  Out_U_Inp I = Output I \/ Input I;

theorem 
  for A being IC-Ins-separated non empty
  with_non-empty_values AMI-Struct over N, I being Instruction of A,
  o being Object of A st
  Values o is trivial holds not o in Out_U_Inp I;

theorem 
  for A being IC-Ins-separated non empty
  with_non-empty_values AMI-Struct over N , I being Instruction of A,
  o being Object of A st
  Values o is trivial holds not o in Input I;

theorem 
  for A being IC-Ins-separated non empty
  with_non-empty_values AMI-Struct over N , I being Instruction of A,
  o being Object of A st
  Values o is trivial holds not o in Output I;

theorem 
  for A being IC-Ins-separated non empty
with_non-empty_values AMI-Struct over N, I being Instruction of A
 holds I is halting iff Output I
  is empty;

theorem 
  for A being with_non_trivial_ObjectKinds IC-Ins-separated
non empty with_non-empty_values AMI-Struct over N, I being Instruction
  of A st I is halting holds Out_\_Inp I is empty;

theorem 
  for A being IC-Ins-separated non empty
with_non-empty_values AMI-Struct over N, I being Instruction of A
 st I is halting holds Out_U_Inp
  I is empty;

theorem 
  for A being IC-Ins-separated non empty
  with_non-empty_values AMI-Struct over N, I being Instruction of A
   st I is halting holds Input I
  is empty;

registration

  let N be with_zero set,
  A be halting IC-Ins-separated
non empty with_non-empty_values AMI-Struct over N,
I be halting Instruction of A;
  cluster Input I -> empty;
  cluster Output I -> empty;
  cluster Out_U_Inp I -> empty;
end;

registration
  let N be with_zero set;
  cluster halting with_non_trivial_ObjectKinds IC-Ins-separated for non
    empty with_non-empty_values AMI-Struct over N;
end;

registration
  let N be with_zero set,
  A be halting
  with_non_trivial_ObjectKinds IC-Ins-separated non empty
  with_non-empty_values AMI-Struct over N, I be halting Instruction of A;
  cluster Out_\_Inp I -> empty;
end;

registration
  let N;
  cluster with_non_trivial_Instructions
  IC-Ins-separated
    for non empty with_non-empty_values AMI-Struct over N;
end;

theorem 
  for A being standard IC-Ins-separated non empty
  with_non-empty_values AMI-Struct over N, I being Instruction of A st I is
  sequential holds not IC A in Out_\_Inp I;

theorem 
  for A being IC-Ins-separated non empty
  with_non-empty_values AMI-Struct over N, I being Instruction of A st
   ex s being State of A st
  Exec(I,s).IC A <> IC s holds IC A in Output I;

registration
  let N;
  cluster standard for IC-Ins-separated non empty
    with_non-empty_values AMI-Struct over N;
end;

theorem 
  for A being standard IC-Ins-separated non empty
  with_non-empty_values AMI-Struct over N, I being Instruction of A st I is
  sequential holds IC A in Output I;

theorem 
  for A being IC-Ins-separated non empty
  with_non-empty_values AMI-Struct over N, I being Instruction of A st
   ex s being State of A st
  Exec(I,s).IC A <> IC s holds IC A in Out_U_Inp I;

theorem 
  for A being standard IC-Ins-separated non empty
  with_non-empty_values AMI-Struct over N, I being Instruction of A st I is
  sequential holds IC A in Out_U_Inp I;

theorem 
  for A being IC-Ins-separated non empty
   with_non-empty_values AMI-Struct over N, I being Instruction of A,
   o being Object
  of A st I is jump-only holds o in Output I implies o = IC A;















begin

registration
 cluster with_non_trivial_Instructions for COM-Struct;
end;

reserve S for with_non_trivial_Instructions COM-Struct;

registration let S;
 cluster No-StopCode for Instruction of S;
end;

registration let S;
 let i be No-StopCode Instruction of S;
 cluster Macro i -> halt-ending unique-halt;
end;

definition let S;
  let i be No-StopCode Instruction of S, J be MacroInstruction of S;
  func i ';' J -> MacroInstruction of S equals

  Macro i ';' J;
end;

definition let S;
  let I be MacroInstruction of S, j be No-StopCode Instruction of S;
  func I ';' j -> MacroInstruction of S equals

  I ';' Macro j;
end;

definition let S;
  let i,j be No-StopCode Instruction of S;
  func i ';' j -> MacroInstruction of S equals

  Macro i ';' Macro j;
end;

reserve i,j,k for No-StopCode Instruction of S,
        I,J,K for MacroInstruction of S;

theorem 
  I ';' J ';' k = I ';' (J ';' k);

theorem 
  I ';' j ';' K = I ';' (j ';' K);

theorem 
  I ';' j ';' k = I ';' (j ';' k);

theorem 
  i ';' J ';' K = i ';' (J ';' K);

theorem 
  i ';' J ';' k = i ';' (J ';' k);

theorem 
  i ';' j ';' K = i ';' (j ';' K);

theorem 
  i ';' j ';' k = i ';' (j ';' k);

theorem 
  i ';' j = Macro i ';' j;

theorem 
  i ';' j = i ';' Macro j;

theorem 
 card(i ';' J) = card J + 1;

theorem 
 card(I ';' j) = card I + 1;

theorem 
 card(i ';' j) = 3;

theorem 
 card(i ';' j ';' k) = 4;

reserve i1,i2,i3,i4,i5,i6 for No-StopCode Instruction of S;

theorem 
 card(i1 ';' i2 ';' i3 ';' i4) = 5;

theorem 
 card(i1 ';' i2 ';' i3 ';' i4 ';' i5) = 6;

theorem 
 card(i1 ';' i2 ';' i3 ';' i4 ';' i5 ';' i6) = 7;

reserve I,J for non empty NAT-defined finite Function;

definition
 let I; let J be set;
 pred I <= J means

  CutLastLoc I c= J;
end;

definition
 let I,J;
 redefine pred I <= J;
 reflexivity;
end;

theorem 
 for F being non empty NAT-defined finite Function
  holds not LastLoc F in dom CutLastLoc F;

registration let S;
 let I be unique-halt non empty preProgram of S;
 cluster CutLastLoc I -> halt-free;
end;

theorem 
 for I being unique-halt Program of S,
     J being halt-ending Program of S
  st CutLastLoc I c= J
 holds CutLastLoc I c= CutLastLoc J;

reserve I,J for MacroInstruction of S;

theorem 
 for K be set st I <= J & J <= K
  holds I <= K;

theorem 
 I = CutLastLoc I +* (LastLoc I .--> halt S);

theorem 
 CutLastLoc I = CutLastLoc J implies I = J;

theorem 
  I <= J & J <= I implies I = J;

theorem 
  I <= I ';' J;



theorem 
 for X being set st I c= X
  holds I <= X;

theorem 
 I <= J implies
 for X being set st J c= X
 holds I <= X;

theorem 
 for k being Nat holds
   k < LastLoc I iff k in dom CutLastLoc I;

theorem 
 for k being Nat st k < LastLoc I
  holds (CutLastLoc I).k = I.k;

theorem 
 for k being Nat st k < LastLoc I & I <= J
  holds I.k = J.k;

theorem 
 LastLoc I = card I - 1;

theorem 
 LastLoc Macro i = 1;

theorem 
 LastLoc(i ';' j) = 2;

theorem 
 LastLoc(i ';' j ';' k) = 3;

theorem 
 LastLoc(i1 ';' i2 ';' i3 ';' i4) = 4;

theorem 
 LastLoc(i1 ';' i2 ';' i3 ';' i4 ';' i5) = 5;

theorem 
 LastLoc(i1 ';' i2 ';' i3 ';' i4 ';' i5 ';' i6) = 6;



theorem 
  (i ';' J).0 = i;

theorem 
  (i ';' j ';' K).0 = i;

theorem 
  (i ';' j ';' k ';' K).0 = i;

theorem 
  (i1 ';' i2 ';' i3 ';' i4 ';' K).0 = i1;

theorem 
  (i1 ';' i2 ';' i3 ';' i4 ';' i5 ';' K).0 = i1;

theorem 
  (i1 ';' i2 ';' i3 ';' i4 ';' i5 ';' i6 ';' K).0 = i1;













theorem 
 for k being Nat st k < LastLoc I
  holds (I ';' J).k = I.k;

theorem 
 LastLoc(I ';' J) = LastLoc I + LastLoc J;

theorem 
 for j being Nat st j <= LastLoc J
  holds (I ';' J).(LastLoc I + j) = IncAddr(J/.j,LastLoc I);

theorem 
 (i ';' j).1 = IncAddr(j,1);

theorem 
  (i ';' j ';' k).1 = IncAddr(j,1);

theorem 
  (i1 ';' i2 ';' i3 ';' i4).1 = IncAddr(i2,1);

theorem 
  (i1 ';' i2 ';' i3 ';' i4 ';' i5).1 = IncAddr(i2,1);

theorem 
  (i1 ';' i2 ';' i3 ';' i4 ';' i5 ';' i6).1 = IncAddr(i2,1);

theorem 
 (I ';' j).(LastLoc I) = IncAddr(j,LastLoc I);

theorem 
  (i1 ';' i2 ';' i3).2 = IncAddr(i3,2);

theorem 
  (i1 ';' i2 ';' i3 ';' i4).2 = IncAddr(i3,2);

theorem 
  (i1 ';' i2 ';' i3 ';' i4 ';' i5).2 = IncAddr(i3,2);

theorem 
  (i1 ';' i2 ';' i3 ';' i4 ';' i5 ';' i6).2 = IncAddr(i3,2);

theorem 
  (i1 ';' i2 ';' i3 ';' i4).3 = IncAddr(i4,3);

theorem 
  (i1 ';' i2 ';' i3 ';' i4 ';' i5).3 = IncAddr(i4,3);

theorem 
  (i1 ';' i2 ';' i3 ';' i4 ';' i5 ';' i6).3 = IncAddr(i4,3);

theorem 
  (i1 ';' i2 ';' i3 ';' i4 ';' i5).4 = IncAddr(i5,4);

theorem 
  (i1 ';' i2 ';' i3 ';' i4 ';' i5 ';' i6).4 = IncAddr(i5,4);

theorem 
  (i1 ';' i2 ';' i3 ';' i4 ';' i5 ';' i6).5 = IncAddr(i6,5);










definition let S;
 let I be preProgram of S;
 attr I is closed means

 for i being Instruction of S st i in rng I
  holds rng JumpPart i c= dom I;
end;

registration let S;
 cluster Stop S -> closed;
end;

registration let S;
 cluster closed for MacroInstruction of S;
end;





theorem 
 for i being No-StopCode Instruction of S st i is ins-loc-free
  holds Macro i is closed;

registration let S;
 let I be closed MacroInstruction of S, k be Nat;
 cluster Reloc(I,k) -> closed;
end;

registration let S;
 let I,J be closed MacroInstruction of S;
 cluster I ';' J -> closed;
end;














begin

reserve x, y, z, X for set,
  m, n for Nat,
  O for Ordinal,
  R, S for Relation;

reserve
  N for with_zero set,
  S for
  standard IC-Ins-separated non empty with_non-empty_values AMI-Struct over
  N,
  L, l1 for Element of NAT,
  J for Instruction of S,
  F for Subset of NAT;



definition
  let N be with_zero set,
  S be standard IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N, M be Subset of NAT;
  func LocSeq(M,S) -> T-Sequence of NAT means


  dom it = card M & for m
being set st m in card M holds it.m = (canonical_isomorphism_of (RelIncl
  order_type_of RelIncl M, RelIncl M).m);
end;

theorem 
  F = {n} implies LocSeq(F,S) = 0 .--> n;

registration
  let N be with_zero set,
  S be standard IC-Ins-separated
 non empty with_non-empty_values AMI-Struct over N, M be Subset of NAT;
  cluster LocSeq(M,S) -> one-to-one;
end;



definition
  let N be with_zero set,
  S be standard IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N,
  M be non empty preProgram of S;
  func ExecTree(M) -> DecoratedTree of NAT means


  it.{} = FirstLoc(M) &
  for t being Element of dom it holds
  succ t = { t^<*k*> where k is Element of NAT: k in card NIC(M/.(it.t),it.t) }
   & for m being Element of NAT st m in card
  NIC(M/.(it.t),it.t) holds it.(t^<*m*>) = (LocSeq(NIC(M/.(it.t),it.t),S)).m;
end;

theorem 
  for S being standard halting IC-Ins-separated
    non empty with_non-empty_values AMI-Struct over N holds ExecTree Stop S =
  TrivialInfiniteTree --> 0;














begin  

theorem 
  for N be with_zero set
  for S be IC-Ins-separated non empty with_non-empty_values AMI-Struct over N
  for I be Instruction of S st I is jump-only
  for k be Element of NAT holds IncAddr(I,k) is jump-only;

registration
  let N be with_zero set,
  S be with_explicit_jumps IC-Ins-separated halting
  non empty with_non-empty_values AMI-Struct over N,
  I be IC-relocable Instruction of S, k be Element of NAT;
 cluster IncAddr(I,k) -> IC-relocable;
end;

definition
  let N be with_zero set,
  S be halting
    IC-Ins-separated non empty with_non-empty_values AMI-Struct over N,
  I be Instruction of S;
  attr I is relocable means

  for j,k being Nat, s being State of S holds
    Exec(IncAddr(I,j+k),IncIC(s,k)) =  IncIC(Exec(IncAddr(I,j),s),k);
end;

registration
  let N be with_zero set,
  S be halting IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N;
 cluster relocable -> IC-relocable for Instruction of S;
end;

definition
  let N be with_zero set,
  S be halting
   IC-Ins-separated non empty with_non-empty_values AMI-Struct over N;
  attr S is relocable means

 for I being Instruction of S holds I is relocable;
end;

theorem 
 for N being with_zero set,
  I being Instruction of STC N, s be State of STC N,
  k being Nat
 holds Exec(I,IncIC(s,k)) = IncIC(Exec(I,s),k);

definition
 let N be with_zero set;
 let S be halting IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N;
 attr S is IC-recognized means


 for q be non halt-free finite
   (the InstructionsF of S)-valued NAT-defined Function
 for p being q-autonomic
  FinPartState of S st  p is non empty
   holds IC S in dom p;
end;

theorem 
 for N being with_zero set
 for S being halting IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N
 holds S is IC-recognized iff
  for q be non halt-free finite
   (the InstructionsF of S)-valued NAT-defined Function
  for p being q-autonomic
  FinPartState of S st DataPart p <> {}
   holds IC S in dom p;

registration
 let N be with_zero set;
 cluster Data-Locations STC N -> empty;
end;

registration
 let N be with_zero set;
 let p be PartState of STC N;
 cluster DataPart p -> empty;
end;

registration
 let N be with_zero set;
 cluster STC N -> IC-recognized relocable;
end;

registration
  let N be with_zero set;
  cluster relocable IC-recognized
   for standard halting
   IC-Ins-separated non empty with_non-empty_values AMI-Struct over N;
end;

registration
  let N be with_zero set;
  let S be relocable halting IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N;
 cluster -> relocable for Instruction of S;
end;

reserve k for Nat;

theorem 
  for N be with_zero set
  for S be relocable halting IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N
  for INS being Instruction of S, s being State of S
   holds  Exec(IncAddr(INS,k),IncIC(s,k)) =  IncIC(Exec(INS,s),k);

theorem 
  for N be with_zero set
  for S be relocable halting IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N
  for INS being Instruction of S, s being State of S,
      j, k being Element of NAT st IC s = j+k
 holds  Exec(INS, DecIC(s,k)) =  DecIC(Exec(IncAddr(INS, k), s),k);

registration let N be with_zero set;
 cluster relocable IC-recognized
  for halting IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N;
end;

reserve N for with_zero set,
   S for IC-recognized
    halting IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N;

theorem 
  for q be non halt-free finite
   (the InstructionsF of S)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of S
   holds IC S in dom p;

definition let N;
 let S be halting IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N;
 attr S is CurIns-recognized means


 for q be non halt-free finite
  (the InstructionsF of S)-valued NAT-defined Function
 for p being q-autonomic non empty FinPartState of S
  for s being State of S st  p c= s
 for P being Instruction-Sequence of S
       st q c= P
  for i being Element of NAT holds IC Comput(P,s,i) in dom q;
end;

registration let N;
 cluster STC N -> CurIns-recognized;
end;

registration let N be with_zero set;
 cluster relocable IC-recognized CurIns-recognized
  for halting IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N;
end;

reserve
   S for IC-recognized CurIns-recognized
    halting IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N;


theorem 
 for q be non halt-free finite
  (the InstructionsF of S)-valued NAT-defined Function
 for p being q-autonomic non empty FinPartState of S,
     s1,s2 being State of S st  p c= s1 &  p c= s2
 for P1,P2 being Instruction-Sequence of S
    st q c= P1 & q c= P2
 for i being Element of NAT
 holds IC Comput(P1,s1,i) = IC Comput(P2,s2,i) &
   CurInstr(P1,Comput(P1,s1,i)) = CurInstr(P2,Comput(P2,s2,i));

reserve S for relocable IC-recognized CurIns-recognized
     halting IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N;

theorem 
  for k being Element of NAT
 for q be non halt-free finite
  (the InstructionsF of S)-valued NAT-defined Function
   for p being q-autonomic FinPartState of S
  st IC S in dom p
 for s being State of S st  p c= s
 for P being Instruction-Sequence of S
   st q c= P
  for i being Element of NAT
   holds  Comput(P +* Reloc(q,k),s +* IncIC( p,k),i) =
     IncIC(Comput(P,s,i),k);

theorem 
  for k being Element of NAT
 for q be non halt-free finite
  (the InstructionsF of S)-valued NAT-defined Function
  for p being q-autonomic FinPartState of S st IC S in dom p
  for s being State of S st IncIC(p,k) c= s holds
  for P being Instruction-Sequence of S
   st Reloc(q,k) c= P
  for i being Element of NAT holds  Comput(P,s,i) =
     IncIC(Comput(P+*q,s+* p,i),k);

reserve m,j for Element of NAT;

theorem 
  for k being Element of NAT
 for q be non halt-free finite
  (the InstructionsF of S)-valued NAT-defined Function
  for p being non empty FinPartState of S st IC
  S in dom p
   for s being State of S st  p c= s &
     IncIC(p,k) is Reloc(q,k)-autonomic
   for P being Instruction-Sequence of S
    st q c= P
   for i being Element of NAT holds  Comput(P,s,i)
   =  DecIC(Comput(P+*Reloc(q,k),s+*IncIC(p,k),i),k);

theorem 
 for q be non halt-free finite
  (the InstructionsF of S)-valued NAT-defined Function
  for p being non empty FinPartState of S st IC S in dom p
  for k being Element of NAT holds
   p is q-autonomic iff IncIC(p,k) is Reloc(q,k)-autonomic;

definition let N,S;
 attr S is relocable1 means

 for k being Element of NAT
 for q be non halt-free finite
  (the InstructionsF of S)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of S,
      s1, s2 being State of S st p c= s1 & IncIC( p,k) c= s2
  for P1,P2 being Instruction-Sequence of S
   st q c= P1 & Reloc(q,k) c= P2
  for i being Element of NAT
   holds IncAddr(CurInstr(P1,Comput(P1,s1,i)),k)
       = CurInstr(P2,Comput(P2,s2,i));
 attr S is relocable2 means

 for k being Element of NAT
 for q be non halt-free finite
  (the InstructionsF of S)-valued NAT-defined Function
   for p being q-autonomic non empty FinPartState of S,
      s1, s2 being State of S st p c= s1 & IncIC( p,k) c= s2
  for P1,P2 being Instruction-Sequence of S
   st q c= P1 & Reloc(q,k) c= P2
  for i being Element of NAT holds
   Comput(P1,s1,i)|dom DataPart p = Comput(P2,s2,i)|dom DataPart p;
end;

registration let N;
 cluster STC N -> relocable1 relocable2;
end;

registration let N be with_zero set;
 cluster relocable1 relocable2
   for relocable IC-recognized CurIns-recognized
     halting IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N;
end;

reserve S for relocable1 relocable2
  relocable IC-recognized CurIns-recognized halting IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N;

theorem 
 for q be non halt-free finite
  (the InstructionsF of S)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of S,
      k being Element of NAT st IC S in dom p
   holds p is q-halted iff IncIC(p,k) is Reloc(q,k)-halted;

theorem 
 for q be non halt-free finite
  (the InstructionsF of S)-valued NAT-defined Function
  for p being q-halted q-autonomic non empty FinPartState of S
   st IC S in dom p
  for k being Element of NAT holds DataPart(Result(q, p)) =
   DataPart Result(Reloc(q,k),IncIC( p,k));

registration let N,S;
  let q be non halt-free finite
   (the InstructionsF of S)-valued NAT-defined Function;
  let p be q-autonomic q-halted non empty FinPartState of S,
    k be Element of NAT;
  cluster IncIC(p,k) -> Reloc(q,k)-halted;
end;

theorem 
  for F being data-only PartFunc of FinPartSt S, FinPartSt S,
      l being Element of NAT
 for q be non halt-free finite
  (the InstructionsF of S)-valued NAT-defined Function,
      p being q-autonomic q-halted non empty FinPartState of S
        st IC S in dom p
  for k being Element of
   NAT holds q,  p computes F
    iff Reloc(q,k), IncIC( p,k) computes F;

reserve S for IC-recognized CurIns-recognized halting IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N;

theorem 
 for q be non halt-free finite
  (the InstructionsF of S)-valued NAT-defined Function
  for p being q-autonomic
   FinPartState of S st IC S in dom p holds IC p in dom q;

definition
  let N be with_zero set;
  let S be halting IC-Ins-separated non empty with_non-empty_values
         AMI-Struct over N;
  let k be Nat;
  let F be NAT-defined (the InstructionsF of S)-valued Function;
  attr F is k-halting means

 for s being k-started State of S
  for P being Instruction-Sequence of S st F c= P
   holds P halts_on s;
end;

registration
  let N be with_zero set;
  let S be halting IC-Ins-separated non empty with_non-empty_values
         AMI-Struct over N;
 cluster parahalting -> 0-halting for
        NAT-defined (the InstructionsF of S)-valued Function;
 cluster 0-halting -> parahalting for
         NAT-defined (the InstructionsF of S)-valued Function;
end;















begin

definition
  let i be Integer;
  redefine func <*i*> -> FinSequence of INT;
end;

registration let i1 be Integer;
 cluster <%i1%> -> INT-valued;
 let i2 be Integer;
 cluster <%i1,i2%> -> INT-valued;
 let i3 be Integer;
 cluster <%i1,i2,i3%> -> INT-valued;
 let i4 be Integer;
 cluster <%i1,i2,i3,i4%> -> INT-valued;
end;

definition
  let D be XFinSequence of INT;
  mode State-consisting of D -> State of SCM means


   for k being Element of NAT st k < len D holds it.dl.k = D.k;
end;

registration
  let D be XFinSequence of INT, il be Element of NAT;
 cluster il-started for State-consisting of D;
end;

theorem 
  for i1, i2, i3, i4 being Integer, il being Element of NAT,
 s being il-started State-consisting of <%i1,i2,i3,i4%>
holds
  s.dl.0 = i1 & s.dl.1 = i2 & s.dl.2 = i3 & s.dl.3 = i4;

theorem 
  for i1, i2 being Integer, il being Element of NAT,
  s being il-started State-consisting of <%i1,i2%> holds
   s.dl.0 = i1 & s.dl.1 = i2;

theorem 
  for I1, I2 being Instruction of SCM
  for F being total
   NAT-defined (the InstructionsF of SCM)-valued Function
   st <%I1%>^<%I2%> c= F
   holds F.0 = I1 & F.1 = I2;

reserve F for total
  NAT-defined (the InstructionsF of SCM)-valued Function;

theorem 
  for k, n being Element of NAT, s being State of SCM,
    a, b being Data-Location st
  IC Comput(F,s,k) = n & F.n = a := b
 holds IC Comput(F,s,k+1) = n+1 &
  Comput(F,s,k+1).a = Comput(F,s,k).b &
  for d being Data-Location st d <> a
   holds Comput(F,s,k+1).d = Comput(F,s,k).d;

theorem 
  for k, n being Element of NAT, s being State of SCM, a, b being
  Data-Location st IC Comput(F,s,k) = n & F.n = AddTo(a,b)
  holds IC Comput(F,s,k+1) = n+1 &
    Comput(F,s,k+1).a = Comput(F,s,k).a+
Comput(F,s,k).b & for d being Data-Location st d <> a holds Comput
(F,s,k+
  1).d = Comput(F,s,k).d;

theorem 
  for k, n being Element of NAT, s being State of SCM, a, b being
  Data-Location st IC Comput(F,s,k) = n & F.n = SubFrom(a,b)
   holds IC Comput(F,s,k+1) = n+1 &
   Comput(F,s,k+1).a =
Comput(F,s,k).a-
Comput(F,s,k).b & for d being Data-Location st d <> a holds Comput
(F,s,k+
  1).d = Comput(F,s,k).d;

theorem 
  for k, n being Element of NAT, s being State of SCM, a, b being
  Data-Location st IC Comput(F,s,k) = n & F.n = MultBy(a,b) holds
IC
  Comput(F,s,k+1) = (n+1) & Comput(F,s,k+1).a =
Comput(F,s,k).a*
Comput(F,s,k).b & for d being Data-Location st d <> a holds Comput
(F,s,k+
  1).d = Comput(F,s,k).d;

theorem 
  for k, n being Element of NAT, s being State of SCM, a, b being
Data-Location st IC Comput(F,s,k) = n & F.n = Divide(a,b) & a<>b
holds
  IC Comput(F,s,k+1) = (n+1) & Comput(F,s,k+1).a =
Comput(F,s,k).a
  div Comput(F,s,k).b & Comput(F,s,k+1).b = Comput(
F,s,k).a mod
  Comput(F,s,k).b & for d being Data-Location st d <> a & d <> b
holds
  Comput(F,s,k+1).d = Comput(F,s,k).d;

theorem 
  for k, n being Element of NAT, s being State of SCM, il being
  Element of NAT st IC Comput(F,s,k) = n &
   F.n = SCM-goto il
holds IC Comput(F,s,k+1) = il & for d being Data-Location holds
   Comput(F,s,k+1).d = Comput(F,s,k).d;

theorem 
  for k, n being Element of NAT, s being State of SCM, a being
  Data-Location, il being Element of NAT st IC Comput(F,s,k) =
  n & F.n = a =0_goto il holds ( Comput(F,s,k).a = 0 implies IC
Comput(F,s,k+1) = il) & ( Comput(F,s,k).a <>0 implies
IC Comput(F,s,k+
  1) = (n+1)) & for d being Data-Location holds Comput(F,s,k+1).d
=
  Comput(F,s,k).d;

theorem 
  for k, n being Element of NAT, s being State of SCM, a being
  Data-Location, il being Element of NAT st IC Comput(F,s,k) =
  n & F.n = a >0_goto il holds ( Comput(F,s,k).a > 0 implies IC
Comput(F,s,k+1) = il) & ( Comput(F,s,k).a <= 0
implies IC Comput(F,s,k
  +1) = (n+1)) & for d being Data-Location holds Comput(F,s,k+1).d
=
  Comput(F,s,k).d;

theorem 
  (halt SCM)`1_3 = 0 &
  (for a, b being Data-Location holds (a := b)`1_3 = 1) &
  (for a, b being Data-Location holds (AddTo(a,b))`1_3 = 2) &
  (for a, b being Data-Location holds (SubFrom(a,b))`1_3 = 3) &
  (for a, b being Data-Location holds (MultBy(a,b))`1_3 = 4) &
  (for a, b being Data-Location holds (Divide(a,b))`1_3 = 5) &
  (for i being Element of NAT holds (SCM-goto i)`1_3 = 6) &
  (for a being Data-Location, i being Element of NAT
   holds (a =0_goto i)`1_3 = 7) &
  for a being Data-Location, i being Element of NAT holds
   (a >0_goto i)`1_3 = 8;

theorem 
  for i1, i2, i3, i4 being Integer,
  s being State of SCM st s.dl.0 = i1 & s.dl.1 = i2 & s.dl.2 = i3 & s.dl.3 = i4
   holds s is State-consisting of <%i1,i2,i3,i4%>;



theorem 
  for F being total
   NAT-defined (the InstructionsF of SCM)-valued Function
    st <%halt SCM%> c= F
  for s being 0-started State-consisting of <*>INT
   holds F halts_on s & LifeSpan(F,s) = 0 & Result(F,s) = s;



theorem 
  for F being total
   NAT-defined (the InstructionsF of SCM)-valued Function
    st <%dl.0 := dl.1%>^<%halt SCM%> c= F
  for i1, i2 being Integer,
      s being 0-started State-consisting of <%i1,i2%>
   holds F halts_on s & LifeSpan(F,s) = 1 & (Result(F,s)).dl.0 = i2 &
  for d being Data-Location st d<>dl.0
   holds (Result(F,s)).d = s.d;



theorem 
  for F being total
   NAT-defined (the InstructionsF of SCM)-valued Function
    st <%AddTo(dl.0,dl.1)%>^<%halt SCM%> c= F
  for i1, i2 being Integer,
      s being 0-started State-consisting of <%i1,i2%>
  holds F halts_on s & LifeSpan(F,s) = 1 & (Result(F,s)).dl.0 = i1 + i2 &
  for d being Data-Location st d<>dl.0 holds Result(F,s).d = s.d;



theorem 
  for F being total
   NAT-defined (the InstructionsF of SCM)-valued Function
    st <%SubFrom(dl.0,dl.1)%>^<%halt SCM%> c= F
  for i1, i2 being Integer,
      s being 0-started State-consisting of <%i1,i2%>
    holds F halts_on s
 & LifeSpan(F,s) = 1 &
 (Result(F,s)).dl.0 = i1 - i2 & for d being Data-Location
st d<>dl.0 holds
  (Result(F,s)).d = s.d;



theorem 
  for F being total
   NAT-defined (the InstructionsF of SCM)-valued Function
    st <%MultBy(dl.0,dl.1)%>^<%halt SCM%> c= F
  for i1, i2 being Integer,
     s being 0-started State-consisting of <%i1,i2%>
  holds F halts_on s & LifeSpan(F,s) = 1 & (Result(F,s)).dl.0 = i1 * i2 &
   for d being Data-Location st d<>dl.0 holds (Result(F,s)).d = s.d;



theorem 
  for F being total
   NAT-defined (the InstructionsF of SCM)-valued Function
    st <%Divide(dl.0,dl.1)%>^<%halt SCM%> c= F
  for i1, i2 being Integer,
    s being 0-started State-consisting of  <%i1,i2%>
   holds F halts_on s
 & LifeSpan(F,s)
  = 1 & (Result(F,s)).dl.0 = i1 div i2 & (Result(F,s)
).dl.1 = i1 mod i2 & for d being
  Data-Location st d<>dl.0 & d<>dl.1 holds (Result(F,s)).d = s.d;



theorem 
  for F being total
   NAT-defined (the InstructionsF of SCM)-valued Function
    st <%SCM-goto 1%>^<%halt SCM%> c= F
  for i1, i2 being Integer,
      s being 0-started State-consisting of <%i1,i2%>
    holds F halts_on s &
 LifeSpan(F,s) = 1 & for d
  being Data-Location holds (Result(F,s)).d = s.d;



theorem 
  for F being total
   NAT-defined (the InstructionsF of SCM)-valued Function
    st <%dl.0=0_goto 1%>^<%halt SCM%> c= F
  for i1, i2 being Integer,
      s being 0-started State-consisting of <%i1,i2%>
    holds F halts_on s
 & LifeSpan(F,s) = 1
  & for d being Data-Location holds (Result(F,s)).d = s.d;



theorem 
  for F being total
   NAT-defined (the InstructionsF of SCM)-valued Function
    st <%dl.0>0_goto 1%>^<%halt SCM%> c= F
  for i1, i2 being Integer,
      s being 0-started State-consisting of <%i1,i2%>
    holds F halts_on s
 & LifeSpan(F,s) = 1
  & for d being Data-Location holds (Result(F,s)).d = s.d;

theorem 
 for s being State of SCM
 holds s is State-consisting of <*>INT;














begin

definition
  func Fib_Program -> XFinSequence of the InstructionsF of SCM equals

  <% dl.1>0_goto 2 %> ^ <% halt SCM %> ^ <% dl.3 := dl.0 %> ^
  <% SubFrom(dl.1, dl.0) %> ^ <% dl.1 =0_goto 1 %> ^
  <% dl.4 := dl.2 %> ^ <% dl.2 := dl.3 %> ^ <% AddTo(dl.3,dl.4) %> ^
  <% SCM-goto 3 %>;
end;

reserve F for total
 NAT-defined (the InstructionsF of SCM)-valued Function;

theorem 
  Fib_Program c= F implies
  for N being Element of NAT,
      s being 0-started State-consisting of <%1,N,0,0%>
   holds F halts_on s &
   (N = 0 implies LifeSpan(F,s) = 1) &
   (N > 0 implies LifeSpan(F,s) = 6 * N - 2) &
   (Result(F,s)).dl.3 = Fib N;



definition
  let i be Integer;
  func Fusc' i -> Element of NAT means


  (ex n being Element of NAT st i = n & it = Fusc n) or
  i is not Element of NAT & it = 0;
end;

definition
  func Fusc_Program -> XFinSequence of the InstructionsF of SCM equals

  <% dl.1 =0_goto 8 %> ^
  <% dl.4 := dl.0 %> ^
  <% Divide(dl.1, dl.4) %> ^
  <% dl.4 =0_goto 6 %> ^
  <% AddTo(dl.3, dl.2) %> ^
  <% SCM-goto 0 %> ^
  <% AddTo(dl.2, dl.3) %> ^
  <% SCM-goto 0 %> ^
  <% halt SCM %>;
end;

theorem 
  Fusc_Program c= F implies
  for N being Element of NAT st N > 0
  for s being 0-started State-consisting of <%2,N,1,0%>

   holds F halts_on s &
  (Result(F,s)).dl.3 = Fusc N &
  LifeSpan(F,s) = 6 * ([\ log(2, N) /] + 1) + 1;

theorem 
  Fib_Program c= F implies
  for N being Element of NAT, k, Fk, Fk1 being Element of NAT,
      s being 3-started State-consisting of
      <% 1, N, Fk, Fk1 %> st N > 0 & Fk = Fib k &
      Fk1 = Fib (k+1) holds F halts_on s &
      LifeSpan(F,s) = 6 * N - 4 &
      ex m being Element of NAT st m = k+N-1 &
      (Result(F,s)).dl.2 = Fib m &
      Result(F, s).dl.3 = Fib (m+1);

theorem 
 Fusc_Program c= F implies
  for n being Element of NAT, N, A, B being Element of NAT,
      s being 0-started State-consisting of <%2,n,A,B%>

   st N > 0 &
  Fusc N = A * Fusc n + B * Fusc (n+1)
  holds F halts_on s &
  (Result(F,s)).dl.3 = Fusc N &
  (n = 0 implies LifeSpan(F,s) = 1) &
  (n > 0 implies LifeSpan(F,s) = 6 * ([\log(2, n) /] + 1) + 1);

theorem 
 Fusc_Program c= F implies
  for N being Element of NAT st N > 0
  for s being 0-started State-consisting of <%2,N,1,0%>

   holds F halts_on s &
  Result(F ,s).dl.3 = Fusc N &
  (N = 0 implies LifeSpan(F,s) = 1) &
  (N > 0 implies LifeSpan(F,s) = 6 * ([\ log(2, N) /] + 1)+1);















begin

definition
  func SCM-AE -> binary with_terminals with_nonterminals
  with_useful_nonterminals strict non empty DTConstrStr means


  Terminals
it = SCM-Data-Loc & NonTerminals it = [:1, 5:] & for x, y, z being Symbol of it
  holds x ==> <*y, z*> iff x in [:1, 5:];
end;

definition
  mode bin-term is Element of TS SCM-AE;
end;

definition
  let nt be NonTerminal of SCM-AE;
  let tl, tr be bin-term;
  redefine func nt-tree (tl, tr) -> bin-term;
end;

definition
  let t be Terminal of SCM-AE;
  redefine func root-tree t -> bin-term;
end;

definition
  let t be Terminal of SCM-AE;
  func @t -> Data-Location equals

  t;
end;

theorem 
  for nt being NonTerminal of SCM-AE holds nt = [0,0] or nt = [0,1]
  or nt = [0,2] or nt = [0,3] or nt = [0,4];

theorem 
  [0,0] is NonTerminal of SCM-AE & [0,1] is NonTerminal of SCM-AE &
  [0,2] is NonTerminal of SCM-AE & [0,3] is NonTerminal of SCM-AE & [0,4] is
  NonTerminal of SCM-AE;

definition
  let t1, t2 be bin-term;
  func t1+t2 -> bin-term equals

  [0,0]-tree(t1, t2);
  func t1-t2 -> bin-term equals

  [0,1]-tree(t1, t2);
  func t1*t2 -> bin-term equals

  [0,2]-tree(t1, t2);
  func t1 div t2 -> bin-term equals

  [0,3]-tree(t1, t2);
  func t1 mod t2 -> bin-term equals

  [0,4]-tree(t1, t2);
end;

theorem 
  for term being bin-term holds (ex t being Terminal of SCM-AE st term =
  root-tree t) or ex tl, tr being bin-term st term = tl+tr or term = tl-tr or
  term = tl*tr or term = tl div tr or term = tl mod tr;

definition
  let o be NonTerminal of SCM-AE, i, j be Integer;
  func o-Meaning_on (i, j) -> Integer equals


  i+j if o = [0,0], i-j if o
  = [0,1], i*j if o = [0,2], i div j if o = [0,3], i mod j if o = [0,4];
end;

registration
  let s be State of SCM;
  let t be Terminal of SCM-AE;
  cluster s.t -> integer;
end;

definition
  let D be non empty set;
  let f be Function of INT, D;
  let x be Integer;
  redefine func f.x -> Element of D;
end;

definition
  let s be State of SCM;
  let term be bin-term;
  func term @ s -> Integer means


  ex f being Function of TS SCM-AE, INT
  st it = f.term &
  (for t being Terminal of SCM-AE holds f.(root-tree t) = s.t) &
  for nt being NonTerminal of SCM-AE, tl, tr being bin-term, rtl,
      rtr being Symbol of SCM-AE st
    rtl = root-label tl & rtr = root-label tr & nt ==> <* rtl, rtr *>
    for xl, xr being Element of INT st xl = f.tl & xr = f.tr holds
    f.(nt-tree (tl, tr)) = nt-Meaning_on (xl, xr);
end;

theorem 
  for s being State of SCM, t being Terminal of SCM-AE holds
  (root-tree t)@s = s.t;

theorem 
  for s being State of SCM, nt being NonTerminal of SCM-AE, tl, tr
  being bin-term holds (nt-tree(tl, tr))@s = nt-Meaning_on(tl@s, tr@s);

theorem 
  for s being State of SCM, tl, tr being bin-term holds
  (tl+tr)@s = (tl@s)+(tr@s) & (tl-tr)@s = (tl@s)-(tr@s) &
  (tl*tr)@s = (tl@s)*(tr@s) & (tl div tr)@s = (tl@s) div (tr@s) &
  (tl mod tr)@s = (tl@s) mod (tr@s);

definition
  let nt be NonTerminal of SCM-AE, n be Element of NAT;
  func Selfwork(nt, n) -> XFinSequence of the InstructionsF of SCM equals


  <%AddTo(dl.n, dl.(n+1))%> if nt = [0,0],
  <%SubFrom(dl.n, dl.(n+1))%> if nt = [0,1],
  <%MultBy(dl.n, dl.(n+1))%> if nt = [0,2],
  <%Divide(dl.n,dl.(n+1))%> if nt = [0,3],
  <%Divide(dl.n, dl.(n+1)), dl.n:=dl.(n+1)%> if nt = [0,4];
end;

definition
  func SCM-Compile ->
   Function of TS SCM-AE, Funcs(NAT, (the InstructionsF of SCM)^omega)
    means


    (for t being Terminal of SCM-AE
    ex g being Function of NAT, (the InstructionsF of SCM)^omega
     st g = it.(root-tree t) & for n being
Element of NAT holds g.n = <%dl.n:=@t%>) & for nt being NonTerminal of SCM-AE,
t1, t2 being bin-term, rtl, rtr being Symbol of SCM-AE st rtl = root-label t1 &
rtr = root-label t2 & nt ==> <*rtl, rtr*>
      ex g, f1, f2 being Function of NAT, (the InstructionsF of SCM)^omega
 st g = it.(nt-tree (t1, t2)) & f1 = it.t1 &
f2 = it.t2 & for n being Element of NAT
  holds g.n = (f1.n)^(f2.(n+1))^Selfwork(nt, n);
end;

definition
  let term be bin-term, aux be Element of NAT;
  func SCM-Compile(term, aux) ->
      XFinSequence of the InstructionsF of SCM equals

   (SCM-Compile.term).aux;
end;

theorem 
  for t being Terminal of SCM-AE, n being Element of NAT holds
  SCM-Compile(root-tree t, n) = <% dl.n:=@t %>;

theorem 
  for nt being NonTerminal of SCM-AE, t1, t2 being bin-term, n
being Element of NAT, rtl, rtr being Symbol of SCM-AE st rtl = root-label t1 &
rtr = root-label t2 & nt ==> <*rtl, rtr*> holds SCM-Compile(nt-tree(t1,t2), n)
  = SCM-Compile(t1, n)^SCM-Compile(t2, n+1)^Selfwork(nt, n);

definition
  let t be Terminal of SCM-AE;
  func d".t -> Element of NAT means


  dl.it = t;
end;

definition
  let term be bin-term;
  func max_Data-Loc_in term -> Element of NAT means


  ex f being
  Function of TS SCM-AE, NAT st it = f.term & (for t being Terminal of SCM-AE
  holds f.(root-tree t) = d".t) & for nt being NonTerminal of SCM-AE, tl, tr
being bin-term, rtl, rtr being Symbol of SCM-AE st rtl = root-label tl & rtr =
root-label tr & nt ==> <* rtl, rtr *> for xl, xr being Element of NAT st xl = f
  .tl & xr = f.tr holds f.(nt-tree (tl, tr)) = max(xl, xr);
end;

theorem 
  for t being Terminal of SCM-AE holds max_Data-Loc_in root-tree t = d".t;

theorem 
  for nt being NonTerminal of SCM-AE, tl, tr being bin-term holds
max_Data-Loc_in(nt-tree(tl, tr)) = max(max_Data-Loc_in tl, max_Data-Loc_in tr);

theorem 
  for term being bin-term, s1, s2 being State of SCM st for dn
  being Element of NAT st dn <= max_Data-Loc_in term holds s1.dl.dn = s2.dl.dn
  holds term @ s1 = term @ s2;

reserve F for Instruction-Sequence of SCM;

theorem 
  for F for term being bin-term for aux, n being Element of NAT
    st Shift(SCM-Compile(term, aux),n) c= F
  for s being n-started State of SCM
   st aux > max_Data-Loc_in term
 ex i being Element of NAT, u being State of SCM st u =
  Comput(F,s,i+1) & i+1 = len SCM-Compile(term, aux) & IC Comput(
F,s,i) =
  (n+i) & IC u = (n+(i+1)) & u.dl.aux = term@s & for dn being Element of
  NAT st dn < aux holds s.dl.dn = u.dl.dn;

theorem 
  for F for term being bin-term, aux, n being Element of NAT
   st Shift(SCM-Compile(term, aux)^<%halt SCM%>,n) c= F
  for s being n-started State of SCM
   st aux
  > max_Data-Loc_in term holds F halts_on s &
   (Result(F,s)).dl.aux = term@s &
  LifeSpan(F,s) = len SCM-Compile(term, aux);















begin 

reserve i,j,k for Element of NAT;

begin 

definition
  func Euclide-Algorithm -> NAT-defined
   (the InstructionsF of SCM)-valued finite Function
    equals

  (0 .--> (dl.2 := dl.1)) +* ((1 .--> Divide(dl.0,dl.1)) +*
  ((2 .--> (dl.0 := dl.2)) +* ((3 .--> (dl.1 >0_goto 0)) +*
  (4 .--> halt SCM))));
end;



theorem 
  dom (Euclide-Algorithm qua Function) = 5;

begin 

theorem 
  for s being State of SCM
  for P being Instruction-Sequence of SCM
   st Euclide-Algorithm c= P
  for k st IC Comput(P,s,k) = 0 holds IC Comput(P,s,k+1) = 1 &
  Comput(P,s,k+1).dl.0 = Comput(P,s,k).dl.0 &
  Comput(P,s,k+1).dl.1 = Comput(P,s,k).dl.1 &
  Comput(P,s,k+1).dl.2 = Comput(P,s,k).dl.1;

theorem 
  for s being State of SCM
  for P being Instruction-Sequence of SCM
   st Euclide-Algorithm c= P
  for k st IC
Comput(P,s,k) = 1 holds IC Comput(P,s,k+1) = 2 &
Comput(P,s,k+1).dl.0
  = Comput(P,s,k).dl.0 div Comput(P,s,k).dl.1 &
Comput(P,s,k+1).dl.1 =
  Comput(P,s,k).dl.0 mod Comput(P,s,k).dl.1 & Comput(P,s,k+1).dl.2 =
  Comput(P,s,k).dl.2;

theorem 
  for s being State of SCM
  for P being Instruction-Sequence of SCM
   st Euclide-Algorithm c= P
  for k st IC
Comput(P,s,k) = 2 holds IC Comput(P,s,k+1) = 3 &
Comput(P,s,k+1).dl.0
  = Comput(P,s,k).dl.2 & Comput(P,s,k+1).dl.1 =
Comput(P,s,k).dl.1 &
  Comput(P,s,k+1).dl.2 = Comput(P,s,k).dl.2;

theorem 
 for s being State of SCM
  for P being Instruction-Sequence of SCM
   st Euclide-Algorithm c= P
   for k st IC
Comput(P,s,k) = 3 holds ( Comput(P,s,k).dl.1 > 0
implies IC Comput(P,s,k+1) = 0) &
( Comput(P,s,k).dl.1 <= 0 implies IC Comput(P,s,k+1) = 4) &
  Comput(P,s,k+1).dl.0 = Comput(P,s,k).dl.0 & Comput(P,s,k+1).dl.1 =
  Comput(P,s,k).dl.1;

theorem 
  for s being State of SCM
  for P being Instruction-Sequence of SCM
  st Euclide-Algorithm c= P
  for k,i st IC
  Comput(P,s,k) = 4 holds Comput(P,s,k+i) = Comput(P,s,k);

theorem 
  for s being 0-started State of SCM
  for P being Instruction-Sequence of SCM
   st Euclide-Algorithm c= P
   for x, y being Integer st s.dl.0 = x & s.dl.1 = y & x > 0 & y > 0 holds (
  Result(P,s)).dl.0 = x gcd y;

definition
  func Euclide-Function -> PartFunc of FinPartSt SCM, FinPartSt SCM means

  for p,q being FinPartState of SCM holds [p,q] in it iff ex x,y being
Integer st x > 0 & y > 0 & p = (dl.0,dl.1) --> (x,y) & q = dl.0 .--> (x gcd y);
end;

theorem 
  for p being set holds p in dom Euclide-Function iff ex x,y being
  Integer st x > 0 & y > 0 & p = (dl.0,dl.1) --> (x,y);

theorem 
  for i,j being Integer st i > 0 & j > 0 holds Euclide-Function.((
  dl.0,dl.1) --> (i,j)) = dl.0 .--> (i gcd j);

registration
 cluster Euclide-Algorithm -> (the InstructionsF of SCM)-valued;
end;

registration
 cluster Euclide-Algorithm -> non halt-free;
end;

theorem 
  Euclide-Algorithm, Start-At(0,SCM) computes Euclide-Function;















begin

reserve x,y for set;

theorem 
  for dl being Data-Location ex i being Element of NAT st dl = dl.i;

theorem 
  for dl being Data-Location holds dl <> IC SCM;

theorem 
  for il being Element of NAT, dl being Data-Location
  holds il <> dl;

reserve i, j, k for Element of NAT;

theorem 
  for s being State of SCM, d being Data-Location
   holds d in dom s;

registration
  cluster Data-Locations SCM -> infinite;
end;

reserve I,J,K for Element of Segm 9,
  a,a1 for Element of NAT,
  b,b1,c for Element of Data-Locations SCM;

theorem 
  for l being Instruction of SCM holds InsCode(l) <= 8;

reserve a, b for Data-Location,
  loc for Element of NAT;

reserve I,J,K for Element of Segm 9,
  a,a1 for Element of NAT,
  b,b1,c for Element of Data-Locations SCM,
  da,db for Data-Location;

canceled;

theorem 
  for ins being Instruction of SCM st InsCode ins = 0 holds ins = halt SCM;

theorem 
  for ins being Instruction of SCM st InsCode ins = 1 holds ex da,
  db st ins = da:=db;

theorem 
  for ins being Instruction of SCM st InsCode ins = 2 holds ex da,
  db st ins = AddTo(da,db);

theorem 
  for ins being Instruction of SCM st InsCode ins = 3 holds ex da,
  db st ins = SubFrom(da,db);

theorem 
  for ins being Instruction of SCM st InsCode ins = 4 holds ex da,
  db st ins = MultBy(da,db);

theorem 
  for ins being Instruction of SCM st InsCode ins = 5 holds ex da,
  db st ins = Divide(da,db);

theorem 
  for ins being Instruction of SCM st InsCode ins = 6 holds ex loc
  st ins = SCM-goto loc;

theorem 
  for ins being Instruction of SCM st InsCode ins = 7 holds ex loc
  ,da st ins = da=0_goto loc;

theorem 
  for ins being Instruction of SCM st InsCode ins = 8 holds ex loc
  ,da st ins = da>0_goto loc;

begin 

theorem 
  for s being State of SCM, iloc being Element of NAT, a
  being Data-Location holds s.a = (s +* Start-At(iloc,SCM)).a;

begin 

registration
 cluster SCM -> IC-recognized;
end;

registration
 cluster SCM -> CurIns-recognized;
end;

theorem 
   for q being non halt-free finite
      (the InstructionsF of SCM)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCM,
      s1, s2 being State of SCM st  p c= s1 &  p c= s2
  for P1,P2 being Instruction-Sequence of SCM
      st q c= P1 & q c= P2
  for i being Element of NAT, da, db being Data-Location,
      I being Instruction of SCM
       st I = CurInstr(P1,Comput(P1,s1,i))
   holds I = da := db & da in dom p implies
    Comput(P1,s1,i).db = Comput(P2,s2,i).db;

theorem 
  for q being non halt-free finite
      (the InstructionsF of SCM)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCM, s1, s2
  being State of SCM st  p c= s1 &  p c= s2
  for P1,P2 being Instruction-Sequence of SCM
      st q c= P1 & q c= P2
  for i being Element of NAT, da, db
being Data-Location, I being Instruction of SCM st
 I = CurInstr(P1,Comput(P1,
s1,i))
  holds I = AddTo(da, db) & da in dom p implies Comput(P1,s1,i).da
+
  Comput(P1,s1,i).db = Comput(P2,s2,i).da + Comput(
P2,s2,i).db;

theorem 
  for q being non halt-free finite
      (the InstructionsF of SCM)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCM, s1, s2
  being State of SCM st  p c= s1 &  p c= s2
  for P1,P2 being Instruction-Sequence of SCM
      st q c= P1 & q c= P2
  for i being Element of NAT, da, db
being Data-Location, I being Instruction of SCM st
 I = CurInstr(P1,Comput(P1,
s1,i))
  holds I = SubFrom(da, db) & da in dom p implies Comput(P1,s1,i).
da -
  Comput(P1,s1,i).db = Comput(P2,s2,i).da - Comput(
P2,s2,i).db;

theorem 
  for q being non halt-free finite
      (the InstructionsF of SCM)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCM, s1, s2
  being State of SCM st  p c= s1 &  p c= s2
  for P1,P2 being Instruction-Sequence of SCM
      st q c= P1 & q c= P2
  for i being Element of NAT, da, db
being Data-Location, I being Instruction of SCM
 st I = CurInstr(P1,Comput(P1,s1,i))
  holds I = MultBy(da, db) & da in dom p implies Comput(P1,s1,i).
da *
  Comput(P1,s1,i).db = Comput(P2,s2,i).da * Comput(P2,s2,i).db;

theorem 
  for q being non halt-free finite
      (the InstructionsF of SCM)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCM, s1, s2
  being State of SCM st  p c= s1 &  p c= s2
  for P1,P2 being Instruction-Sequence of SCM
      st q c= P1 & q c= P2
  for i being Element of NAT, da, db
being Data-Location, I being Instruction of SCM
 st I = CurInstr(P1,Comput(P1,s1,i))
  holds I = Divide(da, db) & da in dom p & da <> db implies
   Comput(P1,s1
,i).da div Comput(P1,s1,i).db = Comput(P2,s2,i).da
div Comput(P2,s2,i).db;

theorem 
  for q being non halt-free finite
      (the InstructionsF of SCM)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCM, s1, s2
  being State of SCM st  p c= s1 &  p c= s2
  for P1,P2 being Instruction-Sequence of SCM
      st q c= P1 & q c= P2
  for i being Element of NAT, da, db
being Data-Location, I being Instruction of SCM st
 I = CurInstr(P1,Comput(P1,s1,i))
  holds I = Divide(da, db) & db in dom p implies Comput(P1,s1,i).
da mod
  Comput(P1,s1,i).db = Comput(P2,s2,i).da mod Comput(P2,s2,i).db;

theorem 
  for q being non halt-free finite
      (the InstructionsF of SCM)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCM, s1, s2
  being State of SCM st  p c= s1 &  p c= s2
  for P1,P2 being Instruction-Sequence of SCM
      st q c= P1 & q c= P2
  for i being Element of NAT, da being
  Data-Location, loc being Element of NAT, I being Instruction of
SCM st I = CurInstr(P1,Comput(P1,s1,i))
 holds I = da=0_goto loc & loc <> succ
(IC Comput(P1,s1,i)) implies ( Comput(P1,s1,i).da = 0
iff Comput(P2,s2,i)
  .da = 0);

theorem 
  for q being non halt-free finite
      (the InstructionsF of SCM)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCM, s1, s2
  being State of SCM st  p c= s1 &  p c= s2
  for P1,P2 being Instruction-Sequence of SCM
      st q c= P1 & q c= P2
  for i being Element of NAT, da being
  Data-Location, loc being Element of NAT, I being Instruction of
SCM st I = CurInstr(P1,Comput(P1,s1,i))
 holds I = da>0_goto loc & loc <> succ
(IC Comput(P1,s1,i)) implies ( Comput(P1,s1,i).da > 0
iff Comput(P2,s2,i)
  .da > 0);

theorem 
  for s1,s2 being State of SCM st IC(s1) = IC(s2) &
  (for a being Data-Location holds s1.a = s2.a)
    holds  s1 =  s2;















begin

reserve a, b, d1, d2 for Data-Location,
  il, i1, i2 for Element of NAT,
  I for Instruction of SCM,
  s, s1, s2 for State of SCM,
  T for InsType of the InstructionsF of SCM,
  k,k1 for Nat;

theorem 
 T = 0 or T = 1 or T = 2 or T = 3 or T = 4 or T = 5 or T = 6 or T = 7 or T
= 8;

theorem 
  JumpPart halt SCM = {};

theorem 
  T = 0 implies JumpParts T = {0};

theorem 
  T = 1 implies JumpParts T = {{}};

theorem 
  T = 2 implies JumpParts T = {{}};

theorem 
  T = 3 implies JumpParts T = {{}};

theorem 
  T = 4 implies JumpParts T = {{}};

theorem 
  T = 5 implies JumpParts T = {{}};

theorem 
  T = 6 implies dom product" JumpParts T = {1};

theorem 
  T = 7 implies dom product" JumpParts T = {1};

theorem 
  T = 8 implies dom product" JumpParts T = {1};

theorem 
  (product" JumpParts InsCode SCM-goto k1).1 = NAT;

theorem 
  (product" JumpParts InsCode (a =0_goto k1)).1 = NAT;

theorem 
  (product" JumpParts InsCode (a >0_goto k1)).1 = NAT;

registration
  cluster JUMP halt SCM -> empty;
end;

registration
  let a, b;
  cluster a:=b -> sequential;
  cluster AddTo(a,b) -> sequential;
  cluster SubFrom(a,b) -> sequential;
  cluster MultBy(a,b) -> sequential;
  cluster Divide(a,b) -> sequential;
end;

registration
  let a, b;
  cluster JUMP (a := b) -> empty;
end;

registration
  let a, b;
  cluster JUMP AddTo(a, b) -> empty;
end;

registration
  let a, b;
  cluster JUMP SubFrom(a, b) -> empty;
end;

registration
  let a, b;
  cluster JUMP MultBy(a,b) -> empty;
end;

registration
  let a, b;
  cluster JUMP Divide(a,b) -> empty;
end;

theorem 
  NIC(SCM-goto k, il) = {k};

theorem 
  JUMP SCM-goto k = {k};

registration
  let i1;
  cluster JUMP SCM-goto i1 -> 1-element;
end;

theorem 
  NIC(a=0_goto k, il) = {k, succ il};

theorem 
  JUMP (a=0_goto k) = {k};

registration
  let a, i1;
  cluster JUMP (a =0_goto i1) -> 1-element;
end;

theorem 
  NIC(a>0_goto k, il) = {k, succ il};

theorem 
  JUMP (a>0_goto k) = {k};

registration
  let a, i1;
  cluster JUMP (a >0_goto i1) -> 1-element;
end;

theorem 
  SUCC(il,SCM) = {il, succ il};

theorem 
for k being Element of NAT holds k+1 in SUCC(k,SCM) &
 for j being Element of NAT st j in SUCC(k,SCM) holds k <= j;

registration
  cluster SCM -> standard;
end;

registration
  cluster InsCode halt SCM -> jump-only
   for InsType of the InstructionsF of SCM;
end;

registration
  cluster halt SCM -> jump-only;
end;

registration
  let i1;
  cluster InsCode SCM-goto i1 -> jump-only
  for InsType of the InstructionsF of SCM;
end;

registration
  let i1;
  cluster SCM-goto i1 -> jump-only non sequential non ins-loc-free;
end;

registration
  let a, i1;
  cluster InsCode (a =0_goto i1) -> jump-only
  for InsType of the InstructionsF of SCM;
  cluster InsCode (a >0_goto i1) -> jump-only
  for InsType of the InstructionsF of SCM;
end;

registration
  let a, i1;
  cluster a =0_goto i1 -> jump-only non sequential non ins-loc-free;
  cluster a >0_goto i1 -> jump-only non sequential non ins-loc-free;
end;

registration
  let a, b;
  cluster InsCode (a:=b) -> non jump-only
  for InsType of the InstructionsF of SCM;
  cluster InsCode AddTo(a,b) -> non jump-only
  for InsType of the InstructionsF of SCM;
  cluster InsCode SubFrom(a,b) -> non jump-only
  for InsType of the InstructionsF of SCM;
  cluster InsCode MultBy(a,b) -> non jump-only
  for InsType of the InstructionsF of SCM;
  cluster InsCode Divide(a,b) -> non jump-only
  for InsType of the InstructionsF of SCM;
end;

registration
  let a, b;
  cluster a:=b -> non jump-only;
  cluster AddTo(a,b) -> non jump-only;
  cluster SubFrom(a,b) -> non jump-only;
  cluster MultBy(a,b) -> non jump-only;
  cluster Divide(a,b) -> non jump-only;
end;

registration
  cluster SCM -> with_explicit_jumps;
end;

theorem 
  IncAddr(SCM-goto i1,k) = SCM-goto(i1+k);

theorem 
  IncAddr(a=0_goto i1,k) = a=0_goto(i1+k);

theorem 
  IncAddr(a>0_goto i1,k) = a>0_goto(i1+k);

registration
  cluster SCM -> IC-relocable;
end;















begin  

reserve j, k, m for Element of NAT;

registration
 let a,b be Data-Location;
 cluster a:=b -> ins-loc-free;
 cluster AddTo(a,b) -> ins-loc-free;
 cluster SubFrom(a,b) -> ins-loc-free;
 cluster MultBy(a,b) -> ins-loc-free;
 cluster Divide(a,b) -> ins-loc-free;
end;

theorem 
  for k,loc being Nat
  holds IncAddr(SCM-goto loc,k) = SCM-goto (loc + k);

theorem 
  for k,loc being Nat, a being Data-Location
   holds IncAddr(a=0_goto loc,k) = a=0_goto (loc + k);

theorem 
  for k,loc being Nat, a being Data-Location
   holds IncAddr(a>0_goto loc,k) = a>0_goto (loc + k);

theorem 
  for I being Instruction of SCM, k being Element of NAT st
InsCode I = 0 or InsCode I = 1 or InsCode I = 2 or InsCode I = 3 or InsCode I =
  4 or InsCode I = 5 holds IncAddr (I, k) = I;

theorem 
  for II, I being Instruction of SCM, k being Element of NAT st (
InsCode I = 0 or InsCode I = 1 or InsCode I = 2 or InsCode I = 3 or InsCode I =
  4 or InsCode I = 5) & IncAddr (II, k) = I holds II = I;

registration
 cluster SCM -> relocable;
end;

begin

theorem 
  for k being Element of NAT
   for q being non halt-free finite
      (the InstructionsF of SCM)-valued NAT-defined Function,
      p being q-autonomic non empty FinPartState of SCM , s1
  , s2 being State of SCM
  st IC SCM in dom p &  p c= s1 & IncIC( p,k) c= s2
for P1,P2 being Instruction-Sequence of SCM
  st q c= P1 & Reloc(q,k) c= P2
for i being Element of NAT holds IC Comput(P1,s1,i) + k = IC
Comput(P2,s2,i);

registration
 cluster SCM -> relocable1 relocable2;
end;

theorem 
  for k being Element of NAT
   for q being non halt-free finite
      (the InstructionsF of SCM)-valued NAT-defined Function,
      p being q-autonomic non empty FinPartState of SCM , s1
  , s2, s3 being State of SCM st IC SCM in dom p &
   p c= s1 & IncIC(p,k) c=
  s2 & s3 = s1 +* DataPart s2 holds
  for P1,P2 being Instruction-Sequence of SCM
  st q c= P1 & Reloc(q,k) c= P2
  for i being Element of NAT holds DataPart
  Comput(P1,s3,i) = DataPart Comput(P2,s2,i);














begin 

reserve J,J1,K for Element of Segm 13,
  b,b1,b2,c,c1,c2 for Element of SCM+FSA-Data-Loc,
  f,f1,f2 for Element of SCM+FSA-Data*-Loc;

definition
  func SCM+FSA -> strict AMI-Struct over 3 equals

  AMI-Struct(# SCM+FSA-Memory,In (NAT,SCM+FSA-Memory),
     SCM+FSA-Instr,
     SCM+FSA-OK,SCM*-VAL,SCM+FSA-Exec#);
end;

registration
  cluster SCM+FSA -> non empty with_non-empty_values;
end;

registration
  cluster SCM+FSA -> with_non_trivial_Instructions;
end;

theorem 
  IC SCM+FSA = NAT;

begin 

reserve k for Element of NAT,
  J,K,L for Element of Segm 13,
  O,P,R for Element of Segm 9;

notation
 synonym Int-Locations for SCM+FSA-Data-Loc;
end;

definition
  redefine func Int-Locations -> Subset of SCM+FSA;
  canceled;
  func FinSeq-Locations -> Subset of SCM+FSA equals

  SCM+FSA-Data*-Loc;
end;

registration
 cluster Int-like for Object of SCM+FSA;
end;

definition
  mode Int-Location is Int-like Object of SCM+FSA;
  canceled;
  mode FinSeq-Location -> Object of SCM+FSA means


   it in SCM+FSA-Data*-Loc;
end;

reserve da for Int-Location,
  fa for FinSeq-Location,
  x,y for set;

canceled 5;

definition
  let k be Nat;
  func intloc k -> Int-Location equals

  dl.k;

  func fsloc k -> FinSeq-Location equals

  -(k+1);
end;

theorem 
  for k1,k2 being Nat st k1 <> k2 holds fsloc k1 <> fsloc k2;

theorem 
  for dl being Int-Location ex i being Element of NAT st dl = intloc i;

theorem 
  for fl being FinSeq-Location ex i being Element of NAT st fl =
  fsloc i;

registration
 cluster FinSeq-Locations -> infinite;
end;

theorem 
  for I being Int-Location holds I is Data-Location;

theorem 
  for l being Int-Location holds Values l = INT;

theorem 
  for l being FinSeq-Location holds Values l = INT*;

reserve la,lb for Element of NAT,
  La for Element of NAT,
  i for Instruction of SCM+FSA,
  I for Instruction of SCM,
  l for Element of NAT,
  LA,LB for Element of NAT,
  dA,dB,dC,dD for Element of SCM+FSA-Data-Loc,
  DA,DB,DC for Element of SCM-Data-Loc,
  fA,fB,fC for Element of SCM+FSA-Data*-Loc,
  f,g for FinSeq-Location,
  A,B for Data-Location,
  a,b,c,db for Int-Location;

begin 

canceled 2;

theorem 
  for I being Instruction of SCM+FSA st InsCode I <= 8 holds I is
  Instruction of SCM;

theorem 
  for I being Instruction of SCM+FSA holds InsCode I <= 12;

theorem 
  for I being Instruction of SCM holds I is Instruction of SCM+FSA;

definition
  let a,b;
  func a := b -> Instruction of SCM+FSA means


  ex A,B st a = A & b = B & it = A:=B;
  func AddTo(a,b) -> Instruction of SCM+FSA means


  ex A,B st a = A & b = B & it = AddTo(A,B);
  func SubFrom(a,b) -> Instruction of SCM+FSA means


  ex A,B st a = A & b = B & it = SubFrom(A,B);
  func MultBy(a,b) -> Instruction of SCM+FSA means


  ex A,B st a = A & b = B & it = MultBy(A,B);
  func Divide(a,b) -> Instruction of SCM+FSA means


  ex A,B st a = A & b = B & it = Divide(A,B);
end;

definition
  let la;
  func goto la -> Instruction of SCM+FSA equals

   SCM-goto la;
  let a;
  func a=0_goto la -> Instruction of SCM+FSA means


  ex A st a = A & it = A=0_goto la;
  func a>0_goto la -> Instruction of SCM+FSA means


  ex A st a = A & it = A>0_goto la;
end;

definition
  let c,i be Int-Location;
  let a be FinSeq-Location;
  func c:=(a,i) -> Instruction of SCM+FSA equals

  [9,{},<*c,a,i*>];
  func (a,i):=c -> Instruction of SCM+FSA equals

  [10,{},<*c,a,i*>];
end;

definition
  let i be Int-Location;
  let a be FinSeq-Location;
  func i:=len a -> Instruction of SCM+FSA equals

  [11,{},<*i,a*>];
  func a:=<0,...,0>i -> Instruction of SCM+FSA equals

  [12,{},<*i,a*>];
end;

theorem 
  InsCode (a:=b) = 1;

theorem 
  InsCode (AddTo(a,b)) = 2;

theorem 
  InsCode (SubFrom(a,b)) = 3;

theorem 
  InsCode (MultBy(a,b)) = 4;

theorem 
  InsCode (Divide(a,b)) = 5;

theorem 
  InsCode (goto lb) = 6;

theorem 
  InsCode (a=0_goto lb) = 7;

theorem 
  InsCode (a>0_goto lb) = 8;

theorem 
  InsCode (c:=(fa,a)) = 9;

theorem 
  InsCode ((fa,a):=c) = 10;

theorem 
  InsCode (a:=len fa) = 11;

theorem 
  InsCode (fa:=<0,...,0>a) = 12;

theorem 
  for ins being Instruction of SCM+FSA st InsCode ins = 1 holds ex
  da,db st ins = da:=db;

theorem 
  for ins being Instruction of SCM+FSA st InsCode ins = 2 holds ex
  da,db st ins = AddTo(da,db);

theorem 
  for ins being Instruction of SCM+FSA st InsCode ins = 3 holds ex
  da,db st ins = SubFrom(da,db);

theorem 
  for ins being Instruction of SCM+FSA st InsCode ins = 4 holds ex
  da,db st ins = MultBy(da,db);

theorem 
  for ins being Instruction of SCM+FSA st InsCode ins = 5 holds ex
  da,db st ins = Divide(da,db);

theorem 
  for ins being Instruction of SCM+FSA st InsCode ins = 6 holds ex
  lb st ins = goto lb;

theorem 
  for ins being Instruction of SCM+FSA st InsCode ins = 7 holds ex
  lb,da st ins = da=0_goto lb;

theorem 
  for ins being Instruction of SCM+FSA st InsCode ins = 8 holds ex
  lb,da st ins = da>0_goto lb;

theorem 
  for ins being Instruction of SCM+FSA st InsCode ins = 9 holds ex
  a,b,fa st ins = b:=(fa,a);

theorem 
  for ins being Instruction of SCM+FSA st InsCode ins = 10 holds
  ex a,b,fa st ins = (fa,a):=b;

theorem 
  for ins being Instruction of SCM+FSA st InsCode ins = 11 holds
  ex a,fa st ins = a:=len fa;

theorem 
  for ins being Instruction of SCM+FSA st InsCode ins = 12 holds
  ex a,fa st ins = fa:=<0,...,0>a;

begin 

reserve S for State of SCM,
  s,s1 for State of SCM+FSA;

theorem 
  for s being State of SCM+FSA, d being Int-Location holds d in dom s;

theorem 
  f in dom s;

theorem 
  not f in dom S;

theorem 
  for s being State of SCM+FSA holds Int-Locations c= dom s;

theorem 
  for s being State of SCM+FSA holds FinSeq-Locations c= dom s;

theorem 
  for s being State of SCM+FSA holds dom (s|Int-Locations) =
  Int-Locations;

theorem 
  for s being State of SCM+FSA holds dom (s|FinSeq-Locations) =
  FinSeq-Locations;

theorem 
  for s being State of SCM+FSA, i being Instruction of SCM
   holds s|SCM-Memory is State of SCM;

theorem 
  for s being State of SCM+FSA, s9 being State of SCM
   holds s +* s9  is State of SCM+FSA;

theorem 
  for i being Instruction of SCM, ii being Instruction of SCM+FSA,
  s being State of SCM, ss being State of SCM+FSA st i = ii & s = ss|SCM-Memory
   holds Exec(ii,ss) = ss +* Exec(i,s);

registration
  let s be State of SCM+FSA, d be Int-Location;
  cluster s.d -> integer;
end;

definition
  let s be State of SCM+FSA, d be FinSeq-Location;
  redefine func s.d -> FinSequence of INT;
end;

theorem 
  S = s|SCM-Memory implies s = s +* S;

theorem 
  s1 = s +* S implies s1.IC SCM+FSA = S.IC SCM;

theorem 
  s1 = s +* S & A = a implies S.A = s1.a;

theorem 
  S = s|SCM-Memory & A = a implies S.A = s.a;

registration
  cluster SCM+FSA -> IC-Ins-separated;
end;

theorem 
  for dl being Int-Location holds dl <> IC SCM+FSA;

theorem 
  for dl being FinSeq-Location holds dl <> IC SCM+FSA;

theorem 
  for il being Int-Location, dl being FinSeq-Location holds il <> dl;

theorem 
  for il being Element of NAT, dl being Int-Location
  holds il <> dl;

theorem 
  for il being Element of NAT, dl being FinSeq-Location
  holds il <> dl;

theorem 
  for s1,s2 being State of SCM+FSA st IC s1 = IC s2 &
  (for a being Int-Location holds s1.a = s2.a) &
  (for f being FinSeq-Location holds s1.f = s2.f)
   holds s1 = s2;

theorem 
  S = s|SCM-Memory implies IC s = IC S;

begin 

theorem 
  Exec(a:=b, s).IC SCM+FSA = succ IC s & Exec(a:=b, s).a = s.b & (
for c st c <> a holds Exec(a:=b, s).c = s.c) & for f holds Exec(a:=b, s).f = s.
  f;

theorem 
  Exec(AddTo(a,b), s).IC SCM+FSA = succ IC s & Exec(AddTo(a,b), s)
  .a = s.a + s.b & (for c st c <> a holds Exec(AddTo(a,b), s).c = s.c) & for f
  holds Exec(AddTo(a,b), s).f = s.f;

theorem 
  Exec(SubFrom(a,b), s).IC SCM+FSA = succ IC s & Exec(SubFrom(a,b)
  , s).a = s.a - s.b & (for c st c <> a holds Exec(SubFrom(a,b), s).c = s.c) &
  for f holds Exec(SubFrom(a,b), s).f = s.f;

theorem 
  Exec(MultBy(a,b), s).IC SCM+FSA = succ IC s & Exec(MultBy(a,b),
s).a = s.a * s.b & (for c st c <> a holds Exec(MultBy(a,b), s).c = s.c) & for f
  holds Exec(MultBy(a,b), s).f = s.f;

theorem 
  Exec(Divide(a,b), s).IC SCM+FSA = succ IC s & (a <> b implies
Exec(Divide(a,b), s).a = s.a div s.b) & Exec(Divide(a,b), s).b = s.a mod s.b &
  (for c st c <> a & c <> b holds Exec(Divide(a,b), s).c = s.c) & for f holds
  Exec(Divide(a,b), s).f = s.f;

theorem 
  Exec(Divide(a,a), s).IC SCM+FSA = succ IC s & Exec(Divide(a,a), s).a =
  s.a mod s.a & (for c st c <> a holds Exec(Divide(a,a), s).c = s.c) & for f
  holds Exec(Divide(a,a), s).f = s.f;

theorem 
  Exec(goto l, s).IC SCM+FSA = l & (for c holds Exec(goto l, s).c
  = s.c) & for f holds Exec(goto l, s).f = s.f;

theorem 
  (s.a = 0 implies Exec(a =0_goto l, s).IC SCM+FSA = l) & (s.a <>
  0 implies Exec(a=0_goto l, s).IC SCM+FSA = succ IC s) & (for c holds Exec(a
  =0_goto l, s).c = s.c) & for f holds Exec(a=0_goto l, s).f = s.f;

theorem 
  (s.a > 0 implies Exec(a >0_goto l, s).IC SCM+FSA = l) & (s.a <=
  0 implies Exec(a>0_goto l, s).IC SCM+FSA = succ IC s) & (for c holds Exec(a
  >0_goto l, s).c = s.c) & for f holds Exec(a>0_goto l, s).f = s.f;

theorem 
  Exec(c:=(g,a), s).IC SCM+FSA = succ IC s & (ex k st k = abs(s.a)
& Exec(c:=(g,a), s).c = (s.g)/.k) & (for b st b <> c holds Exec(c:=(g,a), s).b
  = s.b) & for f holds Exec(c:=(g,a), s).f = s.f;

theorem 
  Exec((g,a):=c, s).IC SCM+FSA = succ IC s & (ex k st k = abs(s.a)
& Exec((g,a):=c, s).g = s.g+*(k,s.c)) & (for b holds Exec((g,a):=c, s).b = s.b)
  & for f st f <> g holds Exec((g,a):=c, s).f = s.f;

theorem 
  Exec(c:=len g, s).IC SCM+FSA = succ IC s & Exec(c:=len g, s).c
  = len(s.g) & (for b st b <> c holds Exec(c:=len g, s).b = s.b) & for f holds
  Exec(c:=len g, s).f = s.f;

theorem 
  Exec(g:=<0,...,0>c, s).IC SCM+FSA = succ IC s & (ex k st k =
abs(s.c) & Exec(g:=<0,...,0>c, s).g = k |-> 0) & (for b holds Exec(g:=<0,...,0>
  c, s).b = s.b) & for f st f <> g holds Exec(g:=<0,...,0>c, s).f = s.f;

begin 

theorem 
  for S being SCM+FSA-State st S = s holds IC s = IC S;

theorem 
  for i being Instruction of SCM, I being Instruction of SCM+FSA
  st i = I & i is halting holds I is halting;

theorem 
  for I being Instruction of SCM+FSA st ex s st Exec(I,s).IC
  SCM+FSA = succ IC s holds I is non halting;

registration let a,b;
 cluster a := b -> non halting;
 cluster AddTo(a,b) -> non halting;
 cluster SubFrom(a,b) -> non halting;
 cluster MultBy(a,b) -> non halting;
 cluster Divide(a,b) -> non halting;
end;

theorem 
  a := b is non halting;

theorem 
  AddTo(a,b) is non halting;

theorem 
  SubFrom(a,b) is non halting;

theorem 
  MultBy(a,b) is non halting;

theorem 
  Divide(a,b) is non halting;

registration let la;
 cluster goto la -> non halting;
end;

theorem 
  goto la is non halting;

registration let a,la;
 cluster a=0_goto la -> non halting;
 cluster a>0_goto la -> non halting;
end;

theorem 
  a=0_goto la is non halting;

theorem 
  a>0_goto la is non halting;

registration let c,f,a;
 cluster c:=(f,a) -> non halting;
 cluster (f,a):=c -> non halting;
end;

theorem 
  c:=(f,a) is non halting;

theorem 
  (f,a):=c is non halting;

registration let c,f;
 cluster  c:=len f -> non halting;
 cluster f:=<0,...,0>c -> non halting;
end;

theorem 
  c:=len f is non halting;

theorem 
  f:=<0,...,0>c is non halting;



theorem 
  for I being Instruction of SCM+FSA
   st I = [0,{},{}] holds I is halting;

theorem 
  for I be Instruction of SCM+FSA st InsCode I = 0 holds I = [0,{},{}];

theorem 
  for I being set holds I is Instruction of SCM+FSA iff
   I = [0,{},{}]
   or (ex a,b st I = a:=b) or (ex a,b st I = AddTo(a,b))
   or (ex a,b st I = SubFrom(a,b)) or
   (ex a,b st I = MultBy(a,b)) or (ex a,b st I = Divide(a,b)) or
   (ex la st I = goto la) or (ex lb,da st I = da=0_goto lb) or
   (ex lb,da st I = da>0_goto lb) or (ex b,a,fa st I = a:=(fa,b)) or
   (ex a,b,fa st I = (fa,a):=b) or
   (ex a,f st I = a:=len f) or ex a,f st I = f:=<0,...,0>a;

registration
  cluster SCM+FSA -> halting;
end;

theorem 
  for I being Instruction of SCM+FSA st I is halting holds I = halt SCM+FSA;

theorem 
  for I being Instruction of SCM+FSA st InsCode I = 0 holds I =
  halt SCM+FSA;

theorem 
  halt SCM = halt SCM+FSA;

canceled;

theorem 
  for i being Instruction of SCM, I being Instruction of SCM+FSA st i =
  I & i is non halting holds I is non halting;

theorem 
  for i,j being Nat holds fsloc i <> intloc j;

theorem 
  Data-Locations SCM+FSA = Int-Locations \/ FinSeq-Locations;

theorem 
 for i,j being Nat st i <> j
  holds intloc i <> intloc j;

reserve n for  Element of NAT,
        I for  Program of SCM+FSA;



theorem 
  not a in dom Start-At(l,SCM+FSA);

theorem 
  not f in dom Start-At(l,SCM+FSA);

theorem 
  for s1,s2 being State of SCM+FSA st IC s1 = IC s2 &
  (for a being Int-Location holds s1.a = s2.a) &
  (for f being FinSeq-Location holds s1.f = s2.f)
    holds s1 = s2;

registration let f be FinSeq-Location, w be FinSequence of INT;
 cluster f .--> w -> data-only for PartState of SCM+FSA;
end;

registration let x be Int-Location, i be Integer;
 cluster x .--> i -> data-only for PartState of SCM+FSA;
end;

registration let a,b;
 cluster a:=b -> No-StopCode;
end;

registration let a,b;
 cluster AddTo(a,b) -> No-StopCode;
end;

registration let a,b;
 cluster SubFrom(a,b) -> No-StopCode;
end;

registration let a,b;
 cluster MultBy(a,b) -> No-StopCode;
end;

registration let a,b;
 cluster Divide(a,b) -> No-StopCode;
end;

registration let lb;
 cluster goto lb -> No-StopCode;
end;

registration let lb,a;
 cluster a=0_goto lb -> No-StopCode;
end;

registration let lb,a;
 cluster a>0_goto lb -> No-StopCode;
end;

registration let fa,a,c;
 cluster c:= (fa,a) -> No-StopCode;
end;

registration let fa,a,c;
 cluster (fa,a):=c -> No-StopCode;
end;

registration let fa,a;
 cluster a:=len fa -> No-StopCode;
end;

registration let fa,a;
 cluster fa:=<0,...,0>a -> No-StopCode;
end;















begin 

canceled 2;

reserve k for Element of NAT,
  da,db for Int-Location,
  fa for FinSeq-Location;

theorem 
  for s being State of SCM+FSA, iloc being Element of NAT
  , a being Int-Location holds s.a = (s +* Start-At(iloc,SCM+FSA)).a;

theorem 
  for s being State of SCM+FSA, iloc being Element of NAT
  , a being FinSeq-Location holds s.a = (s +* Start-At(iloc,SCM+FSA)).a;

begin 

definition
  let la be Int-Location;
  let a be Integer;
  redefine func la .--> a -> FinPartState of SCM+FSA;
end;

registration
 cluster SCM+FSA -> IC-recognized;
end;

registration
 cluster SCM+FSA -> CurIns-recognized;
end;

theorem 
   for q being non halt-free finite
      (the InstructionsF of SCM+FSA)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCM+FSA,
      s1, s2
being State of SCM+FSA st  p c= s1 &  p c= s2
  for P1,P2 being Instruction-Sequence of SCM+FSA
   st q c= P1 & q c= P2
   for i being Element of NAT, da, db
  being Int-Location st
   CurInstr(P1,Comput(P1,s1,i)) = da := db & da in dom p
  holds Comput(P1,s1,i).db = Comput(P2,s2,i).db;

theorem 
   for q being non halt-free finite
      (the InstructionsF of SCM+FSA)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCM+FSA,
      s1, s2
being State of SCM+FSA st  p c= s1 &  p c= s2
  for P1,P2 being Instruction-Sequence of SCM+FSA
   st q c= P1 & q c= P2
for i being Element of NAT, da, db
being Int-Location st
 CurInstr(P1,Comput(P1,s1,i)
) = AddTo(da, db)
  & da in dom
  p holds Comput(P1,s1,i).da + Comput(P1,s1,i).db =
Comput(P2,s2,i).da + Comput(P2,s2,i).db;

theorem 
   for q being non halt-free finite
      (the InstructionsF of SCM+FSA)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCM+FSA,
      s1, s2
being State of SCM+FSA st  p c= s1 &  p c= s2
  for P1,P2 being Instruction-Sequence of SCM+FSA
   st q c= P1 & q c= P2
for i being Element of NAT, da, db
  being Int-Location st
   CurInstr(P1,Comput(P1,s1,
i)) = SubFrom(da, db)
    & da in
dom p holds Comput(P1,s1,i).da - Comput(P1,s1,i).db =
Comput(P2,s2,i).da
  - Comput(P2,s2,i).db;

theorem 
   for q being non halt-free finite
      (the InstructionsF of SCM+FSA)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCM+FSA,
      s1, s2
being State of SCM+FSA st  p c= s1 &  p c= s2
  for P1,P2 being Instruction-Sequence of SCM+FSA
   st q c= P1 & q c= P2
for i being Element of NAT, da, db
  being Int-Location st
   CurInstr(P1,Comput(P1,s1,
i)) = MultBy(da, db)
    & da in
dom p holds Comput(P1,s1,i).da * Comput(P1,s1,i).db =
Comput(P2,s2,i).da
  * Comput(P2,s2,i).db;

theorem 
   for q being non halt-free finite
      (the InstructionsF of SCM+FSA)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCM+FSA,
      s1, s2
being State of SCM+FSA st  p c= s1 &  p c= s2
  for P1,P2 being Instruction-Sequence of SCM+FSA
   st q c= P1 & q c= P2
for i being Element of NAT, da, db
  being Int-Location st
   CurInstr(P1,Comput(P1,s1,
i)) = Divide(da, db)
    & da in
  dom p & da <> db holds Comput(P1,s1,i).da div
  Comput(P1,s1,i).db =
  Comput(P2,s2,i).da div Comput(P2,s2,i).db;

theorem 
   for q being non halt-free finite
      (the InstructionsF of SCM+FSA)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCM+FSA,
      s1, s2
being State of SCM+FSA st  p c= s1 &  p c= s2
  for P1,P2 being Instruction-Sequence of SCM+FSA
   st q c= P1 & q c= P2
for i being Element of NAT, da, db
  being Int-Location st
   CurInstr(P1,Comput(P1,s1,i)) = Divide(da, db)
    & db in
dom p holds Comput(P1,s1,i).da mod Comput(P1,s1,i).db
= Comput(P2,s2,i).
  da mod Comput(P2,s2,i).db;

theorem 
   for q being non halt-free finite
      (the InstructionsF of SCM+FSA)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCM+FSA,
      s1, s2
  being State of SCM+FSA st  p c= s1 &  p c= s2
  for P1,P2 being Instruction-Sequence of SCM+FSA
   st q c= P1 & q c= P2
  for i being Element of NAT, da
  being Int-Location, loc being Element of NAT st
   CurInstr(P1,Comput(P1,s1,i)) = da=0_goto loc &
    loc <> succ (IC Comput(P1,s1,i)) holds (
  Comput(P1,s1,i).da = 0 iff Comput(P2,s2,i).da = 0);

theorem 
   for q being non halt-free finite
      (the InstructionsF of SCM+FSA)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCM+FSA,
      s1, s2
  being State of SCM+FSA st  p c= s1 &  p c= s2
  for P1,P2 being Instruction-Sequence of SCM+FSA
   st q c= P1 & q c= P2
  for i being Element of NAT, da
  being Int-Location, loc being Element of NAT st
   CurInstr(P1,Comput(P1,s1,i)) = da>0_goto loc &
    loc <> succ (IC Comput(P1,s1,i)) holds
  Comput(P1,s1,i).da > 0 iff Comput(P2,s2,i).da > 0;

theorem 
   for q being non halt-free finite
      (the InstructionsF of SCM+FSA)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCM+FSA,
      s1, s2
being State of SCM+FSA st  p c= s1 &  p c= s2
  for P1,P2 being Instruction-Sequence of SCM+FSA
   st q c= P1 & q c= P2
for i being Element of NAT, da, db
being Int-Location, f being FinSeq-Location st
 CurInstr(P1,Comput(P1,s1,i)
) =
  da := (f,db) & da in dom p for k1,k2 being Element of NAT st k1 = abs(
Comput(P1,s1,i).db) & k2 = abs( Comput(P2,s2,i).db)
holds ( Comput(P1,s1,
  i).f)/.k1 = ( Comput(P2,s2,i).f)/.k2;

theorem 
   for q being non halt-free finite
      (the InstructionsF of SCM+FSA)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCM+FSA,
      s1, s2
being State of SCM+FSA st  p c= s1 &  p c= s2
  for P1,P2 being Instruction-Sequence of SCM+FSA
   st q c= P1 & q c= P2
for i being Element of NAT, da, db
being Int-Location, f being FinSeq-Location st
 CurInstr(P1,Comput(P1,s1,i)
) =
(f,db):=da & f in dom p for k1,k2 being Element of NAT st k1 = abs( Comput(
P1,s1,i).db) & k2 = abs( Comput(P2,s2,i).db) holds
Comput(P1,s1,i).f+*(k1,
  Comput(P1,s1,i).da) = Comput(P2,s2,i).f+*(k2,
Comput(P2,s2,i).da);

theorem 
   for q being non halt-free finite
      (the InstructionsF of SCM+FSA)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCM+FSA,
      s1, s2
  being State of SCM+FSA st  p c= s1 &  p c= s2
  for P1,P2 being Instruction-Sequence of SCM+FSA
   st q c= P1 & q c= P2
  for i being Element of NAT, da
being Int-Location, f being FinSeq-Location st
 CurInstr(P1,Comput(P1,s1,i)) =
da :=len f & da in dom p holds len( Comput(P1,s1,i).f)
 = len(Comput(P2,s2,i).f);

theorem 
   for q being non halt-free finite
      (the InstructionsF of SCM+FSA)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCM+FSA,
      s1, s2
  being State of SCM+FSA st  p c= s1 &  p c= s2
  for P1,P2 being Instruction-Sequence of SCM+FSA
   st q c= P1 & q c= P2
  for i being Element of NAT, da
being Int-Location, f being FinSeq-Location st
 CurInstr(P1,Comput(P1,s1,i)) =
  f:=<0,...,0>da & f in dom p for k1,k2 being Element of NAT st k1 = abs(
Comput(P1,s1,i).da) & k2 = abs( Comput(P2,s2,i).da)
holds k1 |-> 0 = k2 |-> 0;















begin

reserve a, b, d1, d2, d3, d4 for Int-Location,
  A, B for Data-Location,
  f, f1, f2, f3 for FinSeq-Location,
  il, i1, i2 for Element of NAT,
  L for Element of NAT,
  I for Instruction of SCM+FSA,
  s,s1,s2 for State of SCM+FSA,
  T for InsType of the InstructionsF of SCM+FSA,
  k for Nat;

definition
  let la, lb be Int-Location, a, b be Integer;
  redefine func (la,lb) --> (a,b) -> PartState of SCM+FSA;
end;

theorem 
  for o being Object of SCM+FSA st o in Data-Locations SCM+FSA
   holds o is Int-Location or o is FinSeq-Location;

theorem 
  a := b = [1,{},<*a,b*>];

theorem 
  AddTo(a,b) = [2,{},<*a,b*>];

theorem 
  SubFrom(a,b) = [3,{},<* a,b *>];

theorem 
  MultBy(a,b) = [4,{},<* a,b *>];

theorem 
  Divide(a,b) = [5,{},<* a,b *>];

theorem 
  a=0_goto il = [7, <* il*>,<*a *>];

theorem 
  a>0_goto il = [8, <* il*>,<*a *>];

reserve J,K for Element of Segm 13,
  b,b1,c,c1 for Element of SCM-Data-Loc,
  f,f1 for Element of SCM+FSA-Data*-Loc;

theorem 
  JumpPart halt SCM+FSA = {};

reserve a, b, d1, d2, d3, d4 for Int-Location,
  A, B for Data-Location,
  f, f1,
  f2, f3 for FinSeq-Location;

theorem 
  JumpPart (a:=b) = {};

theorem 
  JumpPart AddTo(a,b) = {};

theorem 
  JumpPart SubFrom(a,b) = {};

theorem 
  JumpPart MultBy(a,b) = {};

theorem 
  JumpPart Divide(a,b) = {};

theorem 
  JumpPart (a=0_goto i1) = <*i1*>;

theorem 
  JumpPart (a>0_goto i1) = <*i1*>;

theorem 
  T = 0 implies JumpParts T = {0};

theorem 
  T = 1 implies JumpParts T = {{}};

theorem 
  T = 2 implies JumpParts T = {{}};

theorem 
  T = 3 implies JumpParts T = {{}};

theorem 
  T = 4 implies JumpParts T = {{}};

theorem 
  T = 5 implies JumpParts T = {{}};

theorem 
  T = 6 implies dom product" JumpParts T = {1};

theorem 
  T = 7 implies dom product" JumpParts T = {1};

theorem 
  T = 8 implies dom product" JumpParts T = {1};

theorem 
  T = 9 implies JumpParts T = {{}};

theorem 
  T = 10 implies JumpParts T = {{}};

theorem 
  T = 11 implies JumpParts T = {{}};

theorem 
  T = 12 implies JumpParts T = {{}};

theorem 
  (product" JumpParts InsCode goto i1).1 = NAT;

theorem 
  (product" JumpParts InsCode (a =0_goto i1)).1 = NAT;

theorem 
  (product" JumpParts InsCode (a >0_goto i1)).1 = NAT;

registration
  cluster JUMP halt SCM+FSA -> empty;
end;

registration
  let a, b;
  cluster a:=b -> sequential;
  cluster AddTo(a,b) -> sequential;
  cluster SubFrom(a,b) -> sequential;
  cluster MultBy(a,b) -> sequential;
  cluster Divide(a,b) -> sequential;
end;

registration
  let a, b;
  cluster JUMP (a := b) -> empty;
  cluster JUMP AddTo(a, b) -> empty;
  cluster JUMP SubFrom(a, b) -> empty;
  cluster JUMP MultBy(a,b) -> empty;
  cluster JUMP Divide(a,b) -> empty;
end;

theorem 
  NIC(goto i1, il) = {i1};

theorem 
  JUMP goto i1 = {i1};

registration
  let i1;
  cluster JUMP goto i1 -> 1-element;
end;

theorem 
  NIC(a=0_goto i1, il) = {i1, succ il};

theorem 
  JUMP (a=0_goto i1) = {i1};

registration
  let a, i1;
  cluster JUMP (a =0_goto i1) -> 1-element;
end;

theorem 
  NIC(a>0_goto i1, il) = {i1, succ il};

theorem 
  JUMP (a>0_goto i1) = {i1};

registration
  let a, i1;
  cluster JUMP (a >0_goto i1) -> 1-element;
end;

registration
  let a, b, f;
  cluster a:=(f,b) -> sequential;
end;

registration
  let a, b, f;
  cluster JUMP (a:=(f,b)) -> empty;
end;

registration
  let a, b, f;
  cluster (f,b):=a -> sequential;
end;

registration
  let a, b, f;
  cluster JUMP ((f,b):=a) -> empty;
end;

registration
  let a, f;
  cluster a:=len f -> sequential;
end;

registration
  let a, f;
  cluster JUMP (a:=len f) -> empty;
end;

registration
  let a, f;
  cluster f:=<0,...,0>a -> sequential;
end;

registration
  let a, f;
  cluster JUMP (f:=<0,...,0>a) -> empty;
end;

theorem 
  SUCC(il,SCM+FSA) = {il, succ il};

theorem 
  for k being Element of NAT holds k+1 in SUCC(k,SCM+FSA) &
   for j being Element of NAT st j in SUCC(k,SCM+FSA) holds k <= j;

registration
  cluster SCM+FSA -> standard;
end;

registration
  cluster InsCode halt SCM+FSA -> jump-only
  for InsType of the InstructionsF of SCM+FSA;
end;

registration
  cluster halt SCM+FSA -> jump-only;
end;

registration
  let i1;
  cluster InsCode goto i1 -> jump-only
  for InsType of the InstructionsF of SCM+FSA;
end;

registration
  let i1;
  cluster goto i1 -> jump-only non sequential non ins-loc-free;
end;

registration
  let a, i1;
  cluster InsCode (a =0_goto i1) -> jump-only
  for InsType of the InstructionsF of SCM+FSA;
  cluster InsCode (a >0_goto i1) -> jump-only
  for InsType of the InstructionsF of SCM+FSA;
end;

registration
  let a, i1;
  cluster a =0_goto i1 -> jump-only non sequential non ins-loc-free;
  cluster a >0_goto i1 -> jump-only non sequential non ins-loc-free;
end;

registration
  let a, b;
  cluster InsCode (a:=b) -> non jump-only
  for InsType of the InstructionsF of SCM+FSA;
  cluster InsCode AddTo(a,b) -> non jump-only
  for InsType of the InstructionsF of SCM+FSA;
  cluster InsCode SubFrom(a,b) -> non jump-only
  for InsType of the InstructionsF of SCM+FSA;
  cluster InsCode MultBy(a,b) -> non jump-only
  for InsType of the InstructionsF of SCM+FSA;
  cluster InsCode Divide(a,b) -> non jump-only
  for InsType of the InstructionsF of SCM+FSA;
end;

registration
  let a, b, f;
  cluster InsCode (b:=(f,a)) -> non jump-only
  for InsType of the InstructionsF of SCM+FSA;
  cluster InsCode ((f,a):=b) -> non jump-only
  for InsType of the InstructionsF of SCM+FSA;
end;

registration
  let a, b, f;
  cluster b:=(f,a) -> non jump-only;
  cluster (f,a):=b -> non jump-only;
end;

registration
  let a, f;
  cluster InsCode (a:=len f) -> non jump-only
  for InsType of the InstructionsF of SCM+FSA;
  cluster InsCode (f:=<0,...,0>a) -> non jump-only
  for InsType of the InstructionsF of SCM+FSA;
end;

registration
  let a, f;
  cluster a:=len f -> non jump-only;
  cluster f:=<0,...,0>a -> non jump-only;
end;

registration
  cluster SCM+FSA -> with_explicit_jumps;
end;

theorem 
  IncAddr(goto i1,k) = goto (i1+ k);

theorem 
  IncAddr(a=0_goto i1,k) = a=0_goto (i1+k);

theorem 
  IncAddr(a>0_goto i1,k) = a>0_goto (i1+k);

registration
  cluster SCM+FSA -> IC-relocable;
end;















begin 

reserve L, j, k, l, m, n, p, q for Element of NAT,
  A for Data-Location,
  I for Instruction of SCM;

registration
 let a,b be Int-Location;
 cluster a:=b -> ins-loc-free;
 cluster AddTo(a,b) -> ins-loc-free;
 cluster SubFrom(a,b) -> ins-loc-free;
 cluster MultBy(a,b) -> ins-loc-free;
 cluster Divide(a,b) -> ins-loc-free;
end;

theorem 
  for k,loc being Element of NAT
  holds IncAddr(goto loc,k) = goto (loc + k);

theorem 
  for k,loc being Element of NAT, a being Int-Location
   holds IncAddr(a=0_goto loc,k) = a=0_goto (loc + k);

theorem 
  for k,loc being Element of NAT, a being Int-Location
       holds IncAddr(a>0_goto loc,k) = a>0_goto (loc + k);

registration
 let a,b be Int-Location; let f be FinSeq-Location;
 cluster b:=(f,a) -> ins-loc-free;
 cluster (f,a):=b -> ins-loc-free;
end;

registration
 let a be Int-Location; let f be FinSeq-Location;
 cluster a:=len f -> ins-loc-free;
 cluster f:=<0,...,0>a -> ins-loc-free;
end;

reserve i for Instruction of SCM+FSA;

begin 

registration
 cluster SCM+FSA -> relocable;
end;

theorem 
 not InsCode i in {6,7,8} implies IncAddr(i,k) = i;














begin  

reserve j, k, m for Element of NAT;

begin 

theorem 
  for k being Element of NAT
   for q being non halt-free finite
      (the InstructionsF of SCM+FSA)-valued NAT-defined Function,
   p being q-autonomic non empty FinPartState of
  SCM+FSA, s1, s2 being State of SCM+FSA st p c= s1 & IncIC( p,k) c= s2
for P1,P2 being Instruction-Sequence of SCM+FSA
  st q c= P1 & Reloc(q,k) c= P2
 for i being Element of NAT holds
  IC Comput(P1,s1,i) + k = IC Comput(P2,s2,i) &
  IncAddr(CurInstr(P1,Comput(P1,s1,i)), k) = CurInstr(P2,Comput(P2,s2,i)) &
  Comput(P1,s1,i)|dom DataPart p = Comput(P2,s2,i)|dom DataPart p &
  DataPart Comput(P1,s1 +* DataPart s2,i) = DataPart Comput(P2,s2,i);

registration
 cluster SCM+FSA -> relocable1 relocable2;
end;















begin

reserve m for Element of NAT;
reserve P for (the InstructionsF of SCM+FSA)-valued ManySortedSet of NAT;

definition

  let a be Int-Location;
  let k be Integer;
  func a := k -> (the InstructionsF of SCM+FSA)-valued NAT-defined
          finite Function
   means


  ex k1 being Element of NAT st
    k1 + 1 = k & it = <% a:= intloc 0 %> ^ ( k1 --> AddTo(a,intloc 0) )
^ <% halt SCM+FSA %> if k > 0
  otherwise ex k1 being Element of NAT st k1 + k
  = 1 & it = <% a:= intloc 0 %> ^ ( k1 --> SubFrom(a,intloc 0) ) ^
   <% halt SCM+FSA %>;
end;

definition
  let a be Int-Location;
  let k be Integer;
  func aSeq(a,k) -> XFinSequence of the InstructionsF of SCM+FSA means


  ex k1 being Element of NAT st k1 + 1 = k &
  it = <% a:= intloc 0 %> ^ (k1 --> AddTo (a,intloc 0)) if k > 0
   otherwise ex k1 being Element of NAT st k1 + k = 1 & it
     = <% a:= intloc 0 %> ^ (k1 --> SubFrom(a,intloc 0));
end;

theorem 
  for a being Int-Location, k being Integer holds a:=k = aSeq(a,k)
  ^ <% halt SCM+FSA %>;

definition
  let f be FinSeq-Location;
  let p be FinSequence of INT;
  func aSeq(f,p) -> XFinSequence of the InstructionsF of SCM+FSA means


  ex pp being XFinSequence of (the InstructionsF of SCM+FSA)^omega
    st len pp = len p &
    (for k being Element of NAT st k < len pp
     ex i being Integer st i = p.(k+1) &
      pp.k = (aSeq(intloc 1,k+1) ^ aSeq(intloc 2,i) ^
       <% (f,intloc 1):=intloc 2 %>))
    & it = FlattenSeq pp;
end;

definition
  let f be FinSeq-Location;
  let p be FinSequence of INT;
  func f := p -> (the InstructionsF of SCM+FSA)-valued NAT-defined
          finite Function equals

  aSeq(intloc 1,len p) ^ <% f:=<0,...,0>intloc 1 %> ^
   aSeq(f,p) ^ <% halt SCM+FSA %>;
end;

theorem 
  for a being Int-Location holds a:=1 =  <% a:= intloc 0 %> ^ <%
  halt SCM+FSA %>;

theorem 
  for a being Int-Location holds a:=0 = <% a:= intloc 0 %>^<%
  SubFrom(a,intloc 0)%>^<%halt SCM+FSA%>;

theorem 
  for c0 being Element of NAT
  for s being c0-started State of SCM+FSA st s.intloc 0 = 1
  for a being Int-Location, k being Integer st a <> intloc 0 &
   (for c being Element of NAT st c in dom aSeq(a,k)
     holds aSeq(a,k).c = P.(c0 + c))
   holds
  (for i being Element of NAT st i <= len aSeq(a,k)
   holds IC Comput(P,s,i) = c0 + i &
  (for b being Int-Location st b <> a
     holds Comput(P,s,i).b = s.b) &
  (for f being FinSeq-Location holds Comput(P,s,i).f = s.f)) &
  Comput(P,s,len aSeq(a,k)).a = k;

theorem 
  for s being 0-started State of SCM+FSA st s.intloc 0 = 1
   for a being Int-Location
   for k being Integer st  aSeq(a,k) c= P & a<>intloc 0
    holds
  (for i being Element of NAT st i <= len aSeq(a,k)
      holds IC Comput(P,s,i) =  i &
  (for b being Int-Location st b <> a
    holds Comput(P,s,i).b = s.b) &
  (for f being FinSeq-Location holds Comput(P,s,i).f = s.f)) &
      Comput(P,s,len aSeq(a,k)).a = k;



theorem 
  for s being 0-started State of SCM+FSA st s.intloc 0 = 1 for a
  being Int-Location, k being Integer st a:=k c= P & a<>intloc 0
   holds P halts_on s &
    (Result(P,s)).a = k & (for b being Int-Location st b <> a
holds Result(P,
  s).b = s.b) & for f being FinSeq-Location holds (Result(P,s)).f
= s.f;

theorem 
  for s being 0-started State of SCM+FSA st s.intloc 0 = 1 for f
  being FinSeq-Location, p being FinSequence of INT st f:=p c= P
   holds P halts_on s &
    (Result(P,s)).f = p &
 (for b being Int-Location st b <> intloc 1 & b <> intloc 2
  holds (Result(P,s)).b = s.b) &
 for g being FinSeq-Location st g <> f
  holds (Result(P,s)).g = s.g;















begin

reserve l, m, n for Element of NAT;

reserve a,b for Int-Location,
  f for FinSeq-Location,
  s,s1,s2 for State of SCM+FSA;

registration
  let n be Nat;
  let i be Integer;
  cluster (intloc n) .--> i -> (the_Values_of SCM+FSA)-compatible;
end;

definition
  let I be PartState of SCM+FSA;
  func Initialized I -> PartState of SCM+FSA equals

  I +* Initialize ((intloc 0) .--> 1);
 projectivity;
end;

registration
  let I be PartState of SCM+FSA;
 cluster Initialized I -> 0-started;
end;

registration
  let I be FinPartState of SCM+FSA;
 cluster Initialized I -> finite;
end;

scheme 

  SCMFSAEx{ G(set) -> Integer, H(set) -> FinSequence of INT,
        I() -> Element of NAT }:
 ex S being State of SCM+FSA st IC S = I() &
   for i being Element of NAT holds S.intloc i = G(i) & S.fsloc i = H(i);

theorem 
  for s being State of SCM+FSA, x being set st x in dom s holds x is
  Int-Location or x is FinSeq-Location or x = IC SCM+FSA;

theorem 
  for s1,s2 being State of SCM+FSA holds ((for a being
Int-Location holds s1.a = s2.a) & for f being FinSeq-Location
 holds s1.f = s2.f) iff DataPart s1 = DataPart s2;

theorem 
  for p being PartState of SCM+FSA holds dom Initialized p = dom p
  \/ {intloc 0} \/ {IC SCM+FSA};

registration
  let s be State of SCM+FSA;
  cluster Initialized s -> total;
end;

theorem 
  for p being PartState of SCM+FSA holds intloc 0 in dom Initialized p;

theorem 
  for p being PartState of SCM+FSA holds (Initialized p).intloc 0 =
  1 & (Initialized p).IC SCM+FSA =  0;

theorem 
  for p being PartState of SCM+FSA, a being Int-Location
   st  a <> intloc 0 & not a in dom p
  holds not a in dom Initialized p;

theorem 
  for p being PartState of SCM+FSA, f being FinSeq-Location
     st not f in dom p
    holds not f in dom Initialized p;

theorem 
  for s being State of SCM+FSA st s.intloc 0 = 1 & IC s =  0
  holds Initialized s = s;

theorem 
 for p being PartState of SCM+FSA holds
   (Initialized p).intloc 0 = 1;

theorem 
 intloc 0 in dom Initialize ((intloc 0).-->1);

theorem 
  dom Initialize ((intloc 0) .--> 1) = {intloc 0,IC SCM+FSA};

theorem 
 (Initialize((intloc 0).-->1)).intloc 0 = 1;

theorem 
 for p being PartState of SCM+FSA holds
 Initialize((intloc 0).-->1) c= Initialized p;

begin 

registration
  cluster Int-Locations -> non empty;
end;

definition
  let IT be Int-Location;
  attr IT is read-only means

 IT = intloc 0;
end;

notation
  let IT be Int-Location;
  antonym IT is read-write for IT is read-only;
end;

registration
  cluster intloc 0 -> read-only;
end;

registration
  cluster read-write for Int-Location;
end;

reserve L for finite Subset of Int-Locations;

definition
  let L be finite Subset of Int-Locations;
  func FirstNotIn L -> Int-Location means


  ex sn being non empty Subset
of NAT st it = intloc min sn & sn = {k where k is Element of NAT : not intloc k
  in L};
end;

theorem 
  not FirstNotIn L in L;

theorem 
  FirstNotIn L = intloc m & not intloc n in L implies m <= n;

reserve L for finite Subset of FinSeq-Locations;

definition
  let L be finite Subset of FinSeq-Locations;
  func First*NotIn L -> FinSeq-Location means


  ex sn being non empty
  Subset of NAT st it = fsloc min sn & sn = {k where k is Element of NAT : not
  fsloc k in L};
end;

theorem 
  not First*NotIn L in L;

theorem 
  First*NotIn L = fsloc m & not fsloc n in L implies m <= n;

registration
  let s be State of SCM+FSA, li be Int-Location, k be Integer;
  cluster s+*(li,k) -> (the_Values_of SCM+FSA)-compatible;
end;

begin 

registration let a be Int-Location, n be Nat;
 cluster a .--> n -> data-only for PartState of SCM+FSA;
end;

theorem 
  for s being State of SCM+FSA st s.intloc 0 = 1
  holds Initialize s = Initialized s;

theorem 
  for s being State of SCM+FSA st s.intloc 0 = 1
   holds DataPart Initialized s = DataPart s;

theorem 
  for s1,s2 being State of SCM+FSA st s1.intloc 0 = s2.intloc 0 &
  ((for a being read-write Int-Location holds s1.a = s2.a) & for f being
  FinSeq-Location holds s1.f = s2.f) holds DataPart s1 = DataPart s2;

theorem 
  for s being State of SCM+FSA, a being Int-Location,
      l being Element of NAT holds
  (s +* Start-At(l,SCM+FSA)).a = s.a;

begin 

definition
  let d be Int-Location;
  redefine func { d } -> Subset of Int-Locations;
  let e be Int-Location;
  redefine func { d, e } -> Subset of Int-Locations;
  let f be Int-Location;
  redefine func { d, e, f } -> Subset of Int-Locations;
  let g be Int-Location;
  redefine func { d, e, f, g } -> Subset of Int-Locations;
end;

definition
  let L be finite Subset of Int-Locations;
  func RWNotIn-seq L -> Function of NAT, bool NAT means


  it.0 = {k where k is Element of NAT : not intloc k in L & k <> 0} &
  (for i being Element of NAT,
     sn being non empty Subset of NAT st it.i = sn
    holds it.(i+1) = sn \ {min sn})
  & for i being Element of NAT holds it.i is infinite;
end;

registration
  let L be finite Subset of Int-Locations, n be Element of NAT;
  cluster (RWNotIn-seq L).n -> non empty;
end;

reserve L for finite Subset of Int-Locations;

theorem 
  not 0 in (RWNotIn-seq L).n & for m st m in (RWNotIn-seq L).n
  holds not intloc m in L;

theorem 
  min ((RWNotIn-seq L).n) < min ((RWNotIn-seq L).(n+1));

theorem 
  n < m implies min ((RWNotIn-seq L).n) < min ((RWNotIn-seq L).m);

definition
  let n be Element of NAT, L be finite Subset of Int-Locations;
  func n-thRWNotIn L -> Int-Location equals

  intloc min ((RWNotIn-seq L).n);
end;

notation
  let n be Element of NAT, L be finite Subset of Int-Locations;
  synonym n-stRWNotIn L for n-thRWNotIn L;
  synonym n-ndRWNotIn L for n-thRWNotIn L;
  synonym n-rdRWNotIn L for n-thRWNotIn L;
end;

registration
  let n be Element of NAT, L be finite Subset of Int-Locations;
  cluster n-thRWNotIn L -> read-write;
end;

theorem 
  not n-thRWNotIn L in L;

theorem 
  n <> m implies n-thRWNotIn L <> m-thRWNotIn L;

begin 

theorem 
  for Iloc being Subset of Int-Locations, Floc being Subset of
  FinSeq-Locations holds s1 | (Iloc \/ Floc) = s2 | (Iloc \/ Floc) iff (for x
  being Int-Location st x in Iloc holds s1.x = s2.x) & for x being
  FinSeq-Location st x in Floc holds s1.x = s2.x;

theorem 
  for Iloc being Subset of Int-Locations holds s1 | (Iloc \/
  FinSeq-Locations) = s2 | (Iloc \/ FinSeq-Locations) iff (for x being
  Int-Location st x in Iloc holds s1.x = s2.x) & for x being FinSeq-Location
  holds s1.x = s2.x;

begin 

theorem 
  for x being set,i,m,n being Element of NAT
   st x in dom (((intloc i) .--> m) +* Start-At(n,SCM+FSA))
    holds x=intloc i or x=IC SCM+FSA;

theorem 
  for s being State of SCM+FSA st
  Initialize ((intloc 0) .--> 1) c= s holds s.intloc 0 =1;

registration
  let n be Element of NAT;
  cluster intloc (n+1) -> read-write;
end;

begin 

registration
  let f be FinSeq-Location,t be FinSequence of INT;
  cluster f .--> t ->  (the_Values_of SCM+FSA)-compatible;
end;

theorem 
  for w being FinSequence of INT,f be FinSeq-Location
  holds dom (Initialized (f.--> w)) = {intloc 0,IC SCM+FSA,f};

theorem 
  for t be FinSequence of INT,f be FinSeq-Location
  holds dom Initialize((intloc 0) .--> 1) misses dom (f .--> t);

theorem 
  for w being FinSequence of INT,f be FinSeq-Location,s be State of SCM+FSA
   st  Initialized(f .--> w) c= s
  holds s.f = w & s.(intloc 0) = 1;

theorem 
  for f being FinSeq-Location,a being Int-Location,s being State of SCM+FSA
  holds {a,IC SCM+FSA,f} c= dom s;

definition
  func Sorting-Function -> PartFunc of FinPartSt SCM+FSA,FinPartSt SCM+FSA
  means


  for p,q being FinPartState of SCM+FSA holds [p,q] in it
  iff ex t being FinSequence of INT,u being FinSequence of REAL
  st t,u are_fiberwise_equipotent & u is FinSequence of INT &
  u is non-increasing & p = fsloc 0 .--> t & q = fsloc 0 .--> u;
end;

theorem 
  for p being set holds p in dom Sorting-Function iff
  ex t being FinSequence of INT st p = fsloc 0 .--> t;

theorem 
  for t being FinSequence of INT holds
  ex u being FinSequence of REAL st t,u are_fiberwise_equipotent &
  u is non-increasing & u is FinSequence of INT &
  Sorting-Function.(fsloc 0 .--> t ) = fsloc 0 .--> u;



theorem 
  (for a being read-write Int-Location holds (Initialized s).a = s.a) &
  (for f holds (Initialized s).f = s.f);















begin

reserve l, m, n for Element of NAT,
  i,j,k for Instruction of SCM+FSA,
  I,J,K for Program of SCM+FSA;

definition
  let P be NAT-defined (the InstructionsF of SCM+FSA)-valued finite Function;
  let l be Element of NAT;
  func Directed(P,l) -> preProgram of SCM+FSA equals

  P +~ (halt SCM+FSA,goto l);
end;

definition
  let P be NAT-defined (the InstructionsF of SCM+FSA)-valued finite Function;
  func Directed P -> preProgram of SCM+FSA equals

  Directed(P, card P);
end;

registration
  let I be Program of SCM+FSA;
  cluster Directed I -> initial non empty;
end;

theorem 
  not halt SCM+FSA in rng Directed I;

theorem 
  Reloc(Directed I, m) = ((id the InstructionsF of
SCM+FSA) +* (halt SCM+FSA .--> goto (m + card I)))* Reloc(I, m);

reserve a,b for Int-Location,
  f for FinSeq-Location,
  s,s1,s2 for State of SCM+FSA;

theorem 
  InsCode i in {0,6,7,8} or Exec(i,s).IC SCM+FSA = succ IC s;

canceled 4;

theorem 
  for s1,s2 being State of SCM+FSA, n being Element of NAT, i being
  Instruction of SCM+FSA holds IC s1 + n = IC s2 & DataPart s1 = DataPart s2
  implies IC Exec(i,s1) + n = IC Exec(IncAddr(i,n),s2) & DataPart Exec(i,s1) =
  DataPart Exec(IncAddr(i,n),s2);

canceled 6;

begin 

definition
 canceled;
  let I,J be Program of SCM+FSA;
  func I ";" J -> Program of SCM+FSA equals

  Directed CutLastLoc stop I +* Reloc(J, card I);
end;

registration
 let I be Program of SCM+FSA, J be non halt-free Program of SCM+FSA;
  cluster I ";" J -> non halt-free;
end;

theorem 
  for I,J being Program of SCM+FSA, l being Element of NAT
   st l in dom I & I.l <> halt SCM+FSA holds (I ";" J).l = I.l;

theorem 
  for I,J being Program of SCM+FSA holds Directed I c= I ";" J;

theorem 
  for I,J being Program of SCM+FSA holds dom I c= dom (I ";" J);

theorem 
  for I,J being Program of SCM+FSA holds I +* (I ";" J) = (I ";" J);

begin 

definition
  let i, J;
  func i ";" J -> Program of SCM+FSA equals

  Macro i ";" J;
end;

definition
  let I, j;
  func I ";" j -> Program of SCM+FSA equals

  I ";" Macro j;
end;

definition
  let i,j;
  func i ";" j -> Program of SCM+FSA equals

  Macro i ";" Macro j;
end;

theorem 
  i ";" j = Macro i ";" j;

theorem 
  i ";" j = i ";" Macro j;

theorem 
  card(I ";" J) = card I + card J;

registration
  let P be preProgram of SCM+FSA;
  let l be Element of NAT;
  cluster Directed(P,l) -> halt-free;
end;

registration
  let P be preProgram of SCM+FSA;
  cluster Directed P -> halt-free;
end;

theorem 
  for I being preProgram of SCM+FSA, l being Element of NAT
   holds I is halt-free implies Directed(I,l) = I;

theorem 
  for I being preProgram of SCM+FSA, k being Element of NAT holds
  Reloc(Directed I,k) = Directed(Reloc(I,k),(card I + k));

theorem 
  for I,J being Program of SCM+FSA holds Directed (I ";" J) = I
  ";" Directed J;

theorem 
  I ";" J ";" K = I ";" (J ";" K);

theorem 
  I ";" J ";" k = I ";" (J ";" k);

theorem 
  I ";" j ";" K = I ";" (j ";" K);

theorem 
  I ";" j ";" k = I ";" (j ";" k);

theorem 
  i ";" J ";" K = i ";" (J ";" K);

theorem 
  i ";" J ";" k = i ";" (J ";" k);

theorem 
  i ";" j ";" K = i ";" (j ";" K);

theorem 
  i ";" j ";" k = i ";" (j ";" k);

theorem 
 card(i ";" J) = card J + 2;

theorem 
 card(I ";" j) = card I + 2;

theorem 
 card(i ";" j) = 4;














begin 

reserve a, b, c, a1, a2, b1, b2 for Int-Location,
  l, l1, l2 for Element of NAT,
  f, g, f1, f2 for FinSeq-Location,
  i, j for Instruction of SCM+FSA;

theorem 
  a1:=b1 = a2:=b2 implies a1 = a2 & b1 = b2;

theorem 
  AddTo(a1,b1) = AddTo(a2,b2) implies a1 = a2 & b1 = b2;

theorem 
  SubFrom(a1,b1) = SubFrom(a2,b2) implies a1 = a2 & b1 = b2;

theorem 
  MultBy(a1,b1) = MultBy(a2,b2) implies a1 = a2 & b1 = b2;

theorem 
  Divide(a1,b1) = Divide(a2,b2) implies a1 = a2 & b1 = b2;

theorem 
  goto l1 = goto l2 implies l1 = l2;

theorem 
  a1=0_goto l1 = a2=0_goto l2 implies a1 = a2 & l1 = l2;

theorem 
  a1>0_goto l1 = a2>0_goto l2 implies a1 = a2 & l1 = l2;

theorem 
  b1:=(f1, a1) = b2:=(f2, a2) implies a1 = a2 & b1 = b2 & f1 = f2;

theorem 
  (f1, a1):=b1 = (f2, a2):=b2 implies a1 = a2 & b1 = b2 & f1 = f2;

theorem 
  a1:=len f1 = a2:=len f2 implies a1 = a2 & f1 = f2;

theorem 
  f1:=<0,...,0>a1 = f2:=<0,...,0>a2 implies a1 = a2 & f1 = f2;

begin 

definition
  let i be Instruction of SCM+FSA;
  func UsedIntLoc i -> Element of Fin Int-Locations means


  ex a, b being
  Int-Location st (i = (a := b) or i = AddTo(a, b) or i = SubFrom(a, b) or i =
MultBy(a, b) or i = Divide(a, b)) & it = {a, b} if InsCode i in {1, 2, 3, 4, 5}
  , ex a being Int-Location, l being Element of NAT st (i = a
=0_goto l or i = a>0_goto l) & it = {a} if InsCode i = 7 or InsCode i = 8, ex a
, b being Int-Location, f being FinSeq-Location st (i = b := (f, a) or i = (f,
  a) := b) & it = {a, b} if InsCode i = 9 or InsCode i = 10,
    ex a being Int-Location, f being FinSeq-Location st
     (i = a :=len f or i = f :=<0,...,0>a) & it = {a}
      if InsCode i = 11 or InsCode i = 12
    otherwise it = {};
end;

theorem 
  UsedIntLoc halt SCM+FSA = {};

theorem 
  i = a:=b or i = AddTo(a, b) or i = SubFrom(a, b) or i = MultBy(a
  , b) or i = Divide(a, b) implies UsedIntLoc i = {a, b};

theorem 
  UsedIntLoc goto l = {};

theorem 
  i = a=0_goto l or i = a>0_goto l implies UsedIntLoc i = {a};

theorem 
  i = b := (f, a) or i = (f, a) := b implies UsedIntLoc i = {a, b};

theorem 
  i = a :=len f or i = f :=<0,...,0>a implies UsedIntLoc i = {a};

definition
  let p be Function;
  func UsedIntLoc p -> Subset of Int-Locations means


  ex UIL being
  Function of the InstructionsF of SCM+FSA, Fin Int-Locations st (for i being
  Instruction of SCM+FSA holds UIL.i = UsedIntLoc i) & it = Union (UIL * p);
end;

registration
  let p be preProgram of SCM+FSA;
  cluster UsedIntLoc p -> finite;
end;

reserve p, r for preProgram of SCM+FSA,
  I, J for Program of SCM+FSA,
  k, m, n for Element of NAT;

theorem 
  i in rng p implies UsedIntLoc i c= UsedIntLoc p;

theorem 
  UsedIntLoc (p +* r) c= (UsedIntLoc p) \/ (UsedIntLoc r);

theorem 
  dom p misses dom r implies UsedIntLoc (p +* r) = (UsedIntLoc p)
  \/ (UsedIntLoc r);

theorem 
  UsedIntLoc p = UsedIntLoc Shift(p, k);

theorem 
  UsedIntLoc i = UsedIntLoc IncAddr(i, k);

theorem 
  UsedIntLoc p = UsedIntLoc IncAddr(p, k);

theorem 
  UsedIntLoc I = UsedIntLoc Reloc(I, k);

theorem 
  UsedIntLoc I = UsedIntLoc Directed I;

theorem 
  UsedIntLoc (I ";" J) = (UsedIntLoc I) \/ (UsedIntLoc J);

theorem 
  UsedIntLoc Macro i = UsedIntLoc i;

theorem 
  UsedIntLoc (i ";" J) = (UsedIntLoc i) \/ UsedIntLoc J;

theorem 
  UsedIntLoc (I ";" j) = (UsedIntLoc I) \/ UsedIntLoc j;

theorem 
  UsedIntLoc (i ";" j) = (UsedIntLoc i) \/ UsedIntLoc j;

begin 

definition
  let i be Instruction of SCM+FSA;
  func UsedInt*Loc i -> Element of Fin FinSeq-Locations means


  ex a, b
  being Int-Location, f being FinSeq-Location st (i = b := (f, a) or i = (f, a)
:= b) & it = {f} if InsCode i = 9 or InsCode i = 10, ex a being Int-Location, f
  being FinSeq-Location st (i = a :=len f or i = f :=<0,...,0>a) & it = {f} if
  InsCode i = 11 or InsCode i = 12 otherwise it = {};
end;

theorem 
  i = halt SCM+FSA or i = a:=b or i = AddTo(a, b) or i = SubFrom(a
, b) or i = MultBy(a, b) or i = Divide(a, b) or i = goto l or i = a=0_goto l or
  i = a>0_goto l implies UsedInt*Loc i = {};

theorem 
  i = b := (f, a) or i = (f, a) := b implies UsedInt*Loc i = {f};

theorem 
  i = a :=len f or i = f :=<0,...,0>a implies UsedInt*Loc i = {f};

definition
  let p be Function;
  func UsedInt*Loc p -> Subset of FinSeq-Locations means


  ex UIL being
  Function of the InstructionsF of SCM+FSA, Fin FinSeq-Locations
   st (for i being
  Instruction of SCM+FSA holds UIL.i = UsedInt*Loc i) & it = Union (UIL * p);
end;

registration
  let p be preProgram of SCM+FSA;
  cluster UsedInt*Loc p -> finite;
end;

theorem 
  i in rng p implies UsedInt*Loc i c= UsedInt*Loc p;

theorem 
  UsedInt*Loc (p +* r) c= (UsedInt*Loc p) \/ (UsedInt*Loc r);

theorem 
  dom p misses dom r implies UsedInt*Loc (p +* r) = (UsedInt*Loc p
  ) \/ (UsedInt*Loc r);

theorem 
  UsedInt*Loc p = UsedInt*Loc Shift(p, k);

theorem 
  UsedInt*Loc i = UsedInt*Loc IncAddr(i, k);

theorem 
  UsedInt*Loc p = UsedInt*Loc IncAddr(p, k);

theorem 
  UsedInt*Loc I = UsedInt*Loc Reloc(I, k);

theorem 
  UsedInt*Loc I = UsedInt*Loc Directed I;

theorem 
  UsedInt*Loc (I ";" J) = (UsedInt*Loc I) \/ (UsedInt*Loc J);

theorem 
  UsedInt*Loc Macro i = UsedInt*Loc i;

theorem 
  UsedInt*Loc (i ";" J) = (UsedInt*Loc i) \/ UsedInt*Loc J;

theorem 
  UsedInt*Loc (I ";" j) = (UsedInt*Loc I) \/ UsedInt*Loc j;

theorem 
  UsedInt*Loc (i ";" j) = (UsedInt*Loc i) \/ UsedInt*Loc j;

begin 

reserve L for finite Subset of Int-Locations;

definition
 canceled;
end;

theorem 
  not FirstNotIn L in L;

theorem 
  FirstNotIn L = intloc m & not intloc n in L implies m <= n;

definition
  let p be preProgram of SCM+FSA;
  func FirstNotUsed p -> Int-Location means


  ex sil being finite Subset
  of Int-Locations st sil = UsedIntLoc p \/ {intloc 0} & it = FirstNotIn sil;
end;

registration
  let p be preProgram of SCM+FSA;
  cluster FirstNotUsed p -> read-write;
end;

theorem 
  not FirstNotUsed p in UsedIntLoc p;

theorem 
  a:=b in rng p or AddTo(a, b) in rng p or SubFrom(a, b) in rng p or
  MultBy(a, b) in rng p or Divide(a, b) in rng p implies FirstNotUsed p <> a &
  FirstNotUsed p <> b;

theorem 
  a=0_goto l in rng p or a>0_goto l in rng p implies FirstNotUsed p <> a;

theorem 
  b := (f, a) in rng p or (f, a) := b in rng p implies FirstNotUsed p <>
  a & FirstNotUsed p <> b;

theorem 
  a :=len f in rng p or f :=<0,...,0>a in rng p implies FirstNotUsed p
  <> a;

begin 

reserve L for finite Subset of FinSeq-Locations;

definition
 canceled;
end;

theorem 
  not First*NotIn L in L;

theorem 
  First*NotIn L = fsloc m & not fsloc n in L implies m <= n;

definition
  let p be preProgram of SCM+FSA;
  func First*NotUsed p -> FinSeq-Location means


  ex sil being finite
  Subset of FinSeq-Locations st sil = UsedInt*Loc p & it = First*NotIn sil;
end;

theorem 
  not First*NotUsed p in UsedInt*Loc p;

theorem 
  b := (f, a) in rng p or (f, a) := b in rng p implies First*NotUsed p
  <> f;

theorem 
  a :=len f in rng p or f :=<0,...,0>a in rng p implies First*NotUsed p
  <> f;

begin 

reserve s, t for State of SCM+FSA;
reserve P for Instruction-Sequence of SCM+FSA;



theorem 
  not c in UsedIntLoc i implies Exec(i, s).c = s.c;

theorem 
  I c= P &
   (for m st m < n holds IC Comput(P,s,m) in dom I) &
    not a in UsedIntLoc I implies Comput(P,s,n).a = s.a;

theorem 
  not f in UsedInt*Loc i implies Exec(i, s).f = s.f;

theorem 
   I c= P &
   (for m st m < n holds IC Comput(P,s,m) in dom I) &
    not f in UsedInt*Loc I implies Comput(P,s,n).f = s.f;

theorem 
  s | UsedIntLoc i = t | UsedIntLoc i & s | UsedInt*Loc i = t |
UsedInt*Loc i & IC s = IC t implies IC Exec(i, s) = IC Exec(i, t) & Exec(i, s)
| UsedIntLoc i = Exec(i, t) | UsedIntLoc i & Exec(i, s) | UsedInt*Loc i = Exec(
  i, t) | UsedInt*Loc i;

theorem 
 for P,Q being Instruction-Sequence of SCM+FSA
  st I c= P & I c= Q &
   Start-At(0,SCM+FSA) c= s & Start-At(0,SCM+FSA) c= t &
   s | UsedIntLoc I = t | UsedIntLoc I &
   s | UsedInt*Loc I = t | UsedInt*Loc I &
   (for m st m < n holds IC Comput(P,s,m) in dom I)
  holds
   (for m st m < n holds IC Comput(Q,t,m) in dom I) &
   for m st m <= n holds IC Comput(P,s,m) = IC Comput(Q,t,m) &
    (for a st a in UsedIntLoc I holds Comput(P,s,m).a = Comput(Q,t,m).a) &
     for f st f in UsedInt*Loc I holds Comput(P,s,m).f = Comput(Q,t,m).f;















begin 

reserve m, n for Element of NAT,
  x for set,
  i for Instruction of SCM+FSA,
  I for Program of SCM+FSA,
  a for Int-Location,
  f for FinSeq-Location,
  l, l1 for Element of NAT,
  s,s1,s2 for State of SCM+FSA,
  P,P1,P2 for Instruction-Sequence of SCM+FSA;

definition
  let I be Program of SCM+FSA, s be State of SCM+FSA;
  let P be Instruction-Sequence of SCM+FSA;
  func IExec(I,P,s) -> State of SCM+FSA equals

  Result(P+*I,Initialized s);
end;

definition
  let I be Program of SCM+FSA;
  canceled 2;
  attr I is keeping_0 means


  for s being 0-started State of SCM+FSA
  for P being Instruction-Sequence of SCM+FSA
   st I c= P
  for k being Element of NAT holds Comput(P,s,k).intloc 0 = s.intloc 0;
end;

registration
  cluster parahalting keeping_0 for Program of SCM+FSA;
end;

theorem 
  for s being 0-started State of SCM+FSA
  for I being parahalting Program of SCM+FSA
  for P being Instruction-Sequence of SCM+FSA
   st I c= P
  holds P halts_on s;

theorem 
  for s being State of SCM+FSA
  for I being parahalting Program of SCM+FSA
   st Initialize((intloc 0).-->1) c= s
  for P being Instruction-Sequence of SCM+FSA
   st I c= P
  holds P halts_on s;

registration
  cluster parahalting -> paraclosed for Program of SCM+FSA;
  cluster keeping_0 -> paraclosed for Program of SCM+FSA;
end;

theorem 
  for I being parahalting Program of SCM+FSA, a being read-write
  Int-Location holds not a in UsedIntLoc I implies IExec(I,P,s).a = s.a;

theorem 
  for I being parahalting Program of SCM+FSA holds not f in UsedInt*Loc
  I implies (IExec(I,P,s)).f = s.f;

theorem 
  IC s = l & P.l = goto l implies not P halts_on s;

registration
  cluster parahalting -> non empty for Program of SCM+FSA;
end;

theorem 
 for s1 being 0-started State of SCM+FSA
 for P,Q being Instruction-Sequence of SCM+FSA
for J being parahalting Program of SCM+FSA st J c= P
 for n being Element of NAT st Reloc(J,n) c= Q
  & IC s2 = n & DataPart s1 = DataPart s2
 for i being Element of NAT holds
  IC Comput(P,s1,i) + n = IC Comput(Q,s2,i) &
  IncAddr(CurInstr(P,Comput(P,s1,i)),n) = CurInstr(Q,Comput(Q,s2,i)) &
  DataPart Comput(P,s1,i) = DataPart Comput(Q,s2,i);

theorem 
  for s being 0-started State of SCM+FSA
  for I being parahalting Program of SCM+FSA st I c= P1 & I c= P2
  for k being Element of NAT holds
    Comput(P1,s,k) = Comput(P2,s,k) &
   CurInstr(P1,Comput(P1,s,k)) = CurInstr(P2,Comput(P2,s,k));

theorem 
  for s being 0-started State of SCM+FSA
  for I being parahalting Program of SCM+FSA st I c= P1 & I c= P2
  holds LifeSpan(P1,s) = LifeSpan(P2,s) & Result(P1,s) =  Result(P2,s);

canceled 2;

theorem 
  for I being keeping_0 parahalting Program of SCM+FSA
   holds IExec(I,P,s).intloc 0 = 1;

begin 

registration
 cluster paraclosed for Program of SCM+FSA;
end;

theorem 
  for s being 0-started State of SCM+FSA
  for I being paraclosed Program of SCM+FSA, J being Program of SCM+FSA
  for P being Instruction-Sequence of SCM+FSA
   st I c= P & P halts_on s
 for m st m <= LifeSpan(P,s)
  holds  Comput(P,s,m) =  Comput(P+*(I ";" J),s,m);

theorem 
 for s being 0-started State of SCM+FSA
 for P being Instruction-Sequence of SCM+FSA
  for I being paraclosed Program of SCM+FSA
   st P+*I halts_on s & Directed I c= P
 holds IC Comput(P,s,LifeSpan(P+*I,s) + 1) =  card I;

theorem 
 for s being 0-started State of SCM+FSA
  for P being Instruction-Sequence of SCM+FSA
  for I being paraclosed Program of SCM+FSA
   st P+*I halts_on s & Directed I c= P
 holds DataPart Comput(P,s,LifeSpan(P+*I,s))
   = DataPart Comput(P,s,LifeSpan(P+*I,s)+ 1);

theorem 
  for I being parahalting Program of SCM+FSA st
   I c= P & Initialize((intloc 0).-->1) c= s
holds for k being Element of NAT st k <= LifeSpan(P,s)
 holds CurInstr(P+*Directed I,
 Comput(P+*Directed I,s,k)) <> halt SCM+FSA;

theorem 
 for s being 0-started State of SCM+FSA
 for P being Instruction-Sequence of SCM+FSA
 for I being paraclosed Program of SCM+FSA st P+*I halts_on s
 for J being Program of SCM+FSA, k being Element of NAT
     st k <= LifeSpan(P+*I,s)
   holds Comput(P+*I,s,k) = Comput(P+*(I ";" J), s,k);

registration
  let I, J be parahalting Program of SCM+FSA;
  cluster I ";" J -> parahalting;
end;

theorem 
  for s being 0-started State of SCM+FSA
  for I being keeping_0 Program of SCM+FSA
   st not P+* I halts_on s
   for J being Program of SCM+FSA, k being Element of NAT holds
    Comput(P+*I,s,k) =  Comput(P+*(I ";" J),s,k);

theorem 
 for s being 0-started State of SCM+FSA
  for I being keeping_0 Program of SCM+FSA st P+*I halts_on s
for J being paraclosed Program of SCM+FSA st I ";" J c= P
 for k being Element of NAT holds
   IncIC(Comput(P+*I+*J, Initialize Result(P+*I,s),k),card I)
  = Comput(P+*(I ";" J),s,(LifeSpan(P+*I,s)+1+k));

registration
  let I, J be keeping_0 Program of SCM+FSA;
  cluster I ";" J -> keeping_0;
end;

theorem 
  for I being keeping_0 parahalting Program of SCM+FSA, J being
  parahalting Program of SCM+FSA holds
   LifeSpan(P+*(I ";" J),s +* Initialize((intloc 0).-->1)) =
  LifeSpan(P+*I,s +* Initialize((intloc 0).-->1)) + 1 + LifeSpan(P+*I+*J,
   Result(P+*I,s +* Initialize((intloc 0).-->1)) +*
    Initialize((intloc 0).-->1));

theorem 
  for I being keeping_0 parahalting Program of SCM+FSA,
      J being parahalting Program of SCM+FSA
 holds IExec(I ";" J,P,s) = IncIC(IExec(J,P,IExec(I,P,s)),card I);

theorem 
 for P being Instruction-Sequence of SCM+FSA
   holds not P +*(IC s, goto IC s) halts_on s;















begin 

reserve x for set,
  i for Instruction of SCM+FSA,
  a,b for Int-Location,
  f for FinSeq-Location,
  l, l1 for Element of NAT,
  s,s1,s2 for State of SCM+FSA,
  P,P1,P2 for Instruction-Sequence of SCM+FSA;

theorem 
  for I being keeping_0 parahalting Program of SCM+FSA, J being
parahalting Program of SCM+FSA holds IExec(I ";" J,P,s).a
 = IExec(J,P,IExec(I,P,s)).a;

theorem 
  for I being keeping_0 parahalting Program of SCM+FSA, J being
parahalting Program of SCM+FSA
 holds IExec(I ";" J,P,s).f = IExec(J,P,IExec(I,P,s)).f;

begin 

definition
  let i be Instruction of SCM+FSA;
  attr i is parahalting means


  Macro i is parahalting;
  attr i is keeping_0 means


  Macro i is keeping_0;
end;

registration
  cluster halt SCM+FSA -> keeping_0 parahalting;
end;

registration
  cluster keeping_0 parahalting for Instruction of SCM+FSA;
end;

registration
  let i be parahalting Instruction of SCM+FSA;
  cluster Macro i -> parahalting;
end;

registration
  let i be keeping_0 Instruction of SCM+FSA;
  cluster Macro i -> keeping_0;
end;

registration
  let a, b be Int-Location;
  cluster a := b -> parahalting;
  cluster AddTo(a,b) -> parahalting;
  cluster SubFrom(a,b) -> parahalting;
  cluster MultBy(a,b) -> parahalting;
  cluster Divide(a,b) -> parahalting;
  let f be FinSeq-Location;
  cluster b := (f,a) -> parahalting;
  cluster (f,a) := b -> parahalting keeping_0;
end;

registration
  let a be Int-Location, f be FinSeq-Location;
  cluster a :=len f -> parahalting;
  cluster f :=<0,...,0> a -> parahalting keeping_0;
end;

registration
  let a be read-write Int-Location, b be Int-Location;
  cluster a := b -> keeping_0;
  cluster AddTo(a, b) -> keeping_0;
  cluster SubFrom(a, b) -> keeping_0;
  cluster MultBy(a, b) -> keeping_0;
end;

registration
  let a, b be read-write Int-Location;
  cluster Divide(a, b) -> keeping_0;
end;

registration
  let a be Int-Location, f be FinSeq-Location, b be read-write Int-Location;
  cluster b := (f,a) -> keeping_0;
end;

registration
  let f be FinSeq-Location, b be read-write Int-Location;
  cluster b :=len f -> keeping_0;
end;

registration
  let i be parahalting Instruction of SCM+FSA, J be parahalting Program of
  SCM+FSA;
  cluster i ";" J -> parahalting;
end;

registration
  let I be parahalting Program of SCM+FSA, j be parahalting Instruction of
  SCM+FSA;
  cluster I ";" j -> parahalting;
end;

registration
  let i be parahalting Instruction of SCM+FSA, j be parahalting Instruction of
  SCM+FSA;
  cluster i ";" j -> parahalting;
end;

registration
  let i be keeping_0 Instruction of SCM+FSA, J be keeping_0 Program of SCM+FSA;
  cluster i ";" J -> keeping_0;
end;

registration
  let I be keeping_0 Program of SCM+FSA, j be keeping_0 Instruction of SCM+FSA;
  cluster I ";" j -> keeping_0;
end;

registration
  let i, j be keeping_0 Instruction of SCM+FSA;
  cluster i ";" j -> keeping_0;
end;

begin 

canceled;

theorem 
  DataPart s1 = DataPart s2 implies DataPart Exec (i, s1) =
  DataPart Exec (i, s2);

theorem 
  for i being parahalting Instruction of SCM+FSA
   holds  Exec(i,Initialized s) =  IExec(Macro i,P,s);

theorem 
  for I being keeping_0 parahalting Program of SCM+FSA, j being
parahalting Instruction of SCM+FSA holds IExec(I ";" j,P,s).a
 = Exec(j,IExec(I,P,s)).a;

theorem 
  for I being keeping_0 parahalting Program of SCM+FSA, j being
parahalting Instruction of SCM+FSA holds IExec(I ";" j,P,s).f
 = Exec(j,IExec(I,P,s)).f;

theorem 
  for i being keeping_0 parahalting Instruction of SCM+FSA, j being
parahalting Instruction of SCM+FSA holds IExec(i ";" j,P,s).a
 = Exec(j, Exec(i,Initialized s)).a;

theorem 
  for i being keeping_0 parahalting Instruction of SCM+FSA, j being
parahalting Instruction of SCM+FSA holds IExec(i ";" j,P,s).f = Exec(j, Exec(i,
  Initialized s)).f;

begin 

definition
  let a, b be Int-Location;
  func swap (a, b) -> Program of SCM+FSA equals

  FirstNotUsed Macro (a := b) :=
  a ";" (a := b) ";" (b := FirstNotUsed Macro (a := b));
end;

registration
  let a, b be Int-Location;
  cluster swap(a,b) -> parahalting;
end;

registration
  let a, b be read-write Int-Location;
  cluster swap(a,b) -> keeping_0;
end;

theorem 
  for a, b being read-write Int-Location holds IExec(swap(a,b),P,s).a =
  s.b & IExec(swap(a,b),P,s).b = s.a;

theorem 
  UsedInt*Loc swap(a, b) = {};














begin

reserve m for Element of NAT;
reserve P for Instruction-Sequence of SCM+FSA;



theorem 
  for i being Instruction of SCM+FSA holds (i = halt SCM+FSA implies (
  Directed Macro i). 0 = goto  2) & (i <> halt SCM+FSA implies (
  Directed Macro i). 0 = i);

theorem 
  for i being Instruction of SCM+FSA holds (Directed Macro i). 1 = goto  2;

registration
  let a be Int-Location, k be Integer;
  cluster a := k -> initial non empty
    NAT-defined (the InstructionsF of SCM+FSA)-valued;
end;

registration
  let a be Int-Location, k be Integer;
  cluster a := k -> parahalting;
end;

theorem 
  for s being State of SCM+FSA for a being read-write Int-Location, k
  being Integer holds IExec(a := k,P,s).a = k & (for b being read-write
  Int-Location st b <> a holds IExec(a := k,P,s).b = s.b) & for f being
  FinSeq-Location holds IExec(a := k,P,s).f = s.f;

registration
  let f be FinSeq-Location, p be FinSequence of INT;
  cluster f := p -> initial non empty
  NAT-defined (the InstructionsF of SCM+FSA)-valued;
end;

registration
  let f be FinSeq-Location, p be FinSequence of INT;
  cluster f := p -> parahalting;
end;

theorem 
  for s being State of SCM+FSA, f being FinSeq-Location, p being
  FinSequence of INT holds IExec(f := p,P,s).f = p &
  (for a being read-write Int-Location st a <> intloc 1 & a <> intloc 2
  holds IExec(f := p,P,s).a = s.a) &
  for g being FinSeq-Location st g <> f holds IExec(f := p,P,s).g = s.g;

definition
  let i be Instruction of SCM+FSA;
  let a be Int-Location;
  pred i refers a means

  not for b being Int-Location, l being Element of NAT
   for f being FinSeq-Location holds b := a <> i &
  AddTo(b,a) <> i & SubFrom(b,a) <> i & MultBy(b,a) <> i & Divide(b,a) <> i &
  Divide(a,b) <> i & a =0_goto l <> i & a >0_goto l <> i & b :=(f,a) <> i &
  (f,b) := a <> i & (f,a):= b <> i & f :=<0,...,0> a <> i;
end;

definition
  let I be preProgram of SCM+FSA;
  let a be Int-Location;
  pred I refers a means

  ex i being Instruction of SCM+FSA st i in rng I & i refers a;
end;

definition
  let i be Instruction of SCM+FSA;
  let a be Int-Location;
  pred i destroys a means


  not for b being Int-Location for f being
  FinSeq-Location holds a := b <> i & AddTo(a,b) <> i & SubFrom(a,b) <> i &
  MultBy(a,b) <> i & Divide(a,b) <> i & Divide(b,a) <> i & a :=(f,b) <> i &
  a :=len f <> i;
end;

definition
  let I be NAT-defined (the InstructionsF of SCM+FSA)-valued Function;
  let a be Int-Location;
  pred I destroys a means


  ex i being Instruction of SCM+FSA st i in rng I & i destroys a;
end;

definition
  let I be NAT-defined (the InstructionsF of SCM+FSA)-valued Function;
  attr I is good means


  I does not destroy intloc 0;
end;

theorem 
  for a being Int-Location holds halt SCM+FSA does not destroy a;

theorem 
  for a,b,c being Int-Location holds a <> b implies
   b := c does not destroy a;

theorem 
  for a,b,c being Int-Location holds a <> b implies
   AddTo(b,c) does not destroy  a;

theorem 
  for a,b,c being Int-Location holds a <> b implies
   SubFrom(b,c) does not destroy  a;

theorem 
  for a,b,c being Int-Location holds a <> b implies
   MultBy(b,c) does not destroy  a;

theorem 
  for a,b,c being Int-Location holds a <> b & a <> c implies
   Divide(b,c) does not destroy  a;

theorem 
  for a being Int-Location, l being Element of NAT
  holds goto l does not destroy  a;

theorem 
  for a,b being Int-Location, l being Element of NAT
  holds b =0_goto l does not destroy  a;

theorem 
  for a,b being Int-Location, l being Element of NAT
  holds b >0_goto l does not destroy  a;

theorem 
  for a,b,c being Int-Location, f being FinSeq-Location holds a <> b
  implies b := (f,c) does not destroy a;

theorem 
  for a,b,c being Int-Location, f being FinSeq-Location holds
   (f,c):= b does not destroy a;

theorem 
  for a,b being Int-Location, f being FinSeq-Location holds a <> b
  implies b :=len f does not destroy a;

theorem 
  for a,b being Int-Location, f being FinSeq-Location holds
    f:=<0,...,0> b does not destroy a;

definition

  let I be Program of SCM+FSA;
  let s be State of SCM+FSA;
  let P be Instruction-Sequence of SCM+FSA;
  pred I is_closed_on s,P means


  for k being Element of NAT holds
   IC Comput(P+*I,Initialize s,k) in dom I;
  pred I is_halting_on s,P means


   P +* I halts_on Initialize s;
end;

theorem 
  for I being Program of SCM+FSA holds I is paraclosed iff
   for s being State of SCM+FSA
   for P being Instruction-Sequence of SCM+FSA
    holds I is_closed_on s,P;

theorem 
  for I being Program of SCM+FSA
   holds I is parahalting iff
  for s being State of SCM+FSA
  for P being Instruction-Sequence of SCM+FSA
   holds I is_halting_on s,P;

theorem 
  for i being Instruction of SCM+FSA, a being Int-Location, s
  being State of SCM+FSA st i does not destroy  a holds Exec(i,s).a = s.a;

theorem 
  for s being State of SCM+FSA,
      P being Instruction-Sequence of SCM+FSA,
      I being Program of SCM+FSA, a being Int-Location
       st I does not destroy  a & I is_closed_on s,P
    for k being
  Element of NAT holds Comput(P +* I,Initialize s,k).a
        = s.a;

registration
  cluster Stop SCM+FSA -> parahalting good;
end;

registration
  cluster parahalting good for Program of SCM+FSA;
end;

registration
  cluster paraclosed good -> keeping_0 for Program of SCM+FSA;
end;



theorem 
  for a being Int-Location, k being Integer holds rng aSeq(a,k) c=
  {a := intloc 0,AddTo(a,intloc 0),SubFrom(a,intloc 0)};

theorem 
  for a being Int-Location, k being Integer holds rng (a := k) c=
  {halt SCM+FSA,a := intloc 0,AddTo(a,intloc 0),SubFrom(a,intloc 0)};

registration
  let a be read-write Int-Location, k be Integer;
  cluster a := k -> good;
end;

registration
  let a be read-write Int-Location, k be Integer;
  cluster a := k -> keeping_0;
end;















begin

reserve m for Element of NAT;
reserve P for Instruction-Sequence of SCM+FSA;

canceled 6;

theorem 
  for P being preProgram of SCM+FSA, l being Element of NAT
, x being set st x in dom P holds (P.x = halt SCM+FSA implies Directed(P
  ,l).x = goto l) & (P.x <> halt SCM+FSA implies Directed(P,l).x = P.x);

theorem 
  for i being Instruction of SCM+FSA, a being Int-Location, n
  being Element of NAT holds i does not destroy a implies IncAddr(i,n)
  does not destroy a;

theorem 
  for P being preProgram of SCM+FSA, n being Element of NAT, a
being Int-Location holds P does not destroy a implies Reloc(P,
  n) does not destroy a;

theorem 
  for P being good preProgram of SCM+FSA, n being Element of NAT
  holds Reloc(P,n) is good;

theorem 
  for I,J being preProgram of SCM+FSA, a being Int-Location holds
  I does not destroy a & J does not destroy a implies I +* J does not destroy a
;

theorem 
  for I,J being good preProgram of SCM+FSA holds I +* J is good;

theorem 
  for I being preProgram of SCM+FSA, l being Element of NAT
, a being Int-Location holds I does not destroy a implies Directed(I,
  l) does not destroy a;

registration
  let I be good preProgram of SCM+FSA;
  let l be Element of NAT;
  cluster Directed(I,l) -> good;
end;

registration
  let I be good Program of SCM+FSA;
  cluster Directed I -> good;
end;

registration
  let I be Program of SCM+FSA, l be Element of NAT;
  cluster Directed(I,l) -> initial;
end;

registration
  let I,J be good Program of SCM+FSA;
  cluster I ";" J -> good;
end;

definition
  let l be Element of NAT;
  func Goto l -> Program of SCM+FSA equals

   0 .--> goto l;
end;

registration
  let l be Element of NAT;
  cluster Goto l -> halt-free good;
end;

registration
 cluster halt-free good for Program of SCM+FSA;
end;

definition
  let s be State of SCM+FSA;
  let P be Instruction-Sequence of SCM+FSA;
  let I be initial Program of SCM+FSA;
  pred I is_pseudo-closed_on s,P means


  ex k being Element of NAT st
   IC Comput(P +* I, Initialize s,k) = card I &
  for n being Element of NAT st n < k
   holds IC Comput(P +* I,Initialize s,n) in dom I;
end;

registration
 cluster sequential for Instruction of SCM+FSA;
end;

definition
 canceled;
  let s be State of SCM+FSA,
      P be Instruction-Sequence of SCM+FSA,
      I be initial Program of SCM+FSA such that
 I is_pseudo-closed_on s,P;
  func pseudo-LifeSpan(s,P,I) -> Element of NAT means


  IC Comput(P +* I,Initialize s,it) =  card I &
   for n being Element of NAT
    st not IC Comput(P +* I, Initialize s,n) in dom I
     holds it <= n;
end;

theorem 
  for I,J being Program of SCM+FSA, x being set holds x in dom I
  implies (I ";" J).x = (Directed I).x;

theorem 
  for l being Element of NAT holds card Goto l = 1;

theorem 
  for P being preProgram of SCM+FSA, x being set st x in dom P holds (P.
  x = halt SCM+FSA implies (Directed P).x = goto  card P) & (P.x <> halt
  SCM+FSA implies (Directed P).x = P.x);

theorem 
  for s being State of SCM+FSA,
  P being Instruction-Sequence of SCM+FSA,
  I being initial Program of
  SCM+FSA st I is_pseudo-closed_on s,P
   holds for n being Element of NAT st n < pseudo-LifeSpan(s,P,I)
    holds IC ( Comput(P+* I,
       Initialize s,n)) in dom I &
  CurInstr(P+*I,Comput(P+*I,
     Initialize s,n)) <>
          halt SCM+FSA;

theorem 
  for s being State of SCM+FSA,
  P being Instruction-Sequence of SCM+FSA,
  I,J being Program of SCM+FSA st I
  is_pseudo-closed_on s,P for k being Element of NAT st
   k <= pseudo-LifeSpan(s,P,I)
  holds  Comput(P+*I, Initialize s,k)
   =  Comput(P+*(I ";" J), Initialize s,k);

theorem 
  for I being preProgram of SCM+FSA, l being Element of NAT
  holds card Directed(I,l) = card I;

theorem 
  for I being Program of SCM+FSA holds card Directed I = card I;

theorem 
  for s being State of SCM+FSA
  for P being Instruction-Sequence of SCM+FSA,
  I being Program of SCM+FSA st I
  is_closed_on s,P & I is_halting_on s,P
  for k being Element of NAT
  st k <= LifeSpan(P+*I,Initialize s)
   holds  Comput(P+*I, (Initialize s),k)
    =  Comput(P+*Directed I, (Initialize s),k) &
   CurInstr(P+*Directed I,
     Comput(P+*Directed I, (Initialize s),k))
      <> halt SCM+FSA;

theorem 
  for s being State of SCM+FSA
  for P being Instruction-Sequence of SCM+FSA,
  I being Program of SCM+FSA
   st I is_closed_on s,P & I is_halting_on s,P
  holds
   IC Comput(P+*Directed I, Initialize s,
    (LifeSpan(P+*I,Initialize s) + 1)) = card I &
    DataPart Comput(P+*I, (Initialize s),
   (LifeSpan(P+*I,Initialize s))) =
   DataPart Comput(P+*Directed I, Initialize s,
   (LifeSpan(P+*I,Initialize s) + 1));

theorem 
  for s being State of SCM+FSA
  for P being Instruction-Sequence of SCM+FSA,
  I being Program of SCM+FSA st I is_closed_on s,P & I is_halting_on s,P
   holds Directed I is_pseudo-closed_on s,P;

theorem 
  for s being State of SCM+FSA
  for P being Instruction-Sequence of SCM+FSA,
  I being Program of SCM+FSA st I is_closed_on s,P & I is_halting_on s,P
  holds pseudo-LifeSpan(s,P,Directed I) =
   LifeSpan(P +* I,Initialize s) + 1;



theorem 
  for I,J being Program of SCM+FSA holds Directed I ";" J = I ";" J;

theorem 
  for s being State of SCM+FSA
  for P being Instruction-Sequence of SCM+FSA,
  I,J being Program of SCM+FSA st I
  is_closed_on s,P & I is_halting_on s,P holds
  (for k being Element of NAT st
    k <= LifeSpan(P+*I,Initialize s)
 holds IC Comput(P+*Directed I, Initialize s,k)
  = IC Comput(P+*(I ";" J), Initialize s,k) &
   CurInstr(P+*Directed I,
      Comput(P+*Directed I, Initialize s,k))
= CurInstr(P+*(I ";" J),
    Comput(P+*(I ";" J), Initialize s,k))) &
DataPart Comput(P+*Directed I, Initialize s,
 (LifeSpan(P+*I,Initialize s) + 1)) =
   DataPart Comput(P+*(I ";" J), Initialize s,
     (LifeSpan(P+*I,Initialize s) + 1)) &
   IC Comput(P+*Directed I, Initialize s,
   (LifeSpan(P+*I,Initialize s) + 1))
 = IC Comput(P+*(I ";" J), Initialize s,
     (LifeSpan(P+*I,Initialize s) + 1));

theorem 
  for s being State of SCM+FSA
  for P being Instruction-Sequence of SCM+FSA,
  I,J being Program of SCM+FSA st I
  is_closed_on Initialized s,P & I is_halting_on Initialized s,P
   holds (for k being
  Element of NAT st k <= LifeSpan(P+*I,s +* Initialize((intloc 0).-->1))
 holds IC Comput(P+*Directed I, s +* Initialize((intloc 0).-->1),k)
 = IC Comput(P+*(I ";" J),s +* Initialize((intloc 0).-->1),k) &
    CurInstr(P+*Directed I,Comput(P+*Directed I,
         s +* Initialize((intloc 0).-->1),k))
 = CurInstr(P+*(I ";" J),
        Comput(P+*(I ";" J),
       s +* Initialize((intloc 0).-->1),k)))
&
  DataPart Comput(P+*Directed I,
         s +* Initialize((intloc 0).-->1),
         LifeSpan(P+*I,s +* Initialize((intloc 0).-->1)) + 1)
  = DataPart Comput(P+*(I ";" J),
         s +* Initialize((intloc 0).-->1),
          LifeSpan(P+*I,s +* Initialize((intloc 0).-->1)) + 1)
&
 IC Comput(P+*Directed I,
           s +* Initialize((intloc 0).-->1),
           LifeSpan(P+*I,s +* Initialize((intloc 0).-->1)) + 1)
 = IC Comput(P+*(I ";" J),
          s +* Initialize((intloc 0).-->1),
           LifeSpan(P+*I,s +* Initialize((intloc 0).-->1)) + 1);

theorem 
  for s being State of SCM+FSA
  for P being Instruction-Sequence of SCM+FSA,
  I being Program of SCM+FSA st I
  is_closed_on Initialized s,P & I is_halting_on Initialized s,P
   holds for k being
  Element of NAT st k <= LifeSpan(P+*I,s +* Initialize((intloc 0).-->1)) holds
      Comput(P+*I,s +* Initialize((intloc 0).-->1),k)
     =  Comput(P+*Directed I, s +* Initialize((intloc 0).-->1),k)
&
  CurInstr(P+*Directed I,
  Comput(P+*Directed I,s +* Initialize((intloc 0).-->1),k))
   <> halt SCM+FSA;

theorem 
  for s being State of SCM+FSA
  for P being Instruction-Sequence of SCM+FSA,
  I being Program of SCM+FSA st I
is_closed_on Initialized s,P & I is_halting_on Initialized s,P
 holds IC Comput(P+*Directed I,
  (s +* Initialize((intloc 0).-->1)),
   (LifeSpan(P+*I,s +* Initialize((intloc 0).-->1)) + 1)) =
card I & DataPart Comput(P+*I, s +* Initialize((intloc 0).-->1),
    LifeSpan(P+*I,s +* Initialize((intloc 0).-->1)))
     = DataPart Comput(P+*Directed I, s +* Initialize((intloc 0).-->1),
      (LifeSpan(P+*I,s +* Initialize((intloc 0).-->1)) + 1));

theorem 
  for I being Program of SCM+FSA
  for P being Instruction-Sequence of SCM+FSA,
  s being State of SCM+FSA st I
is_closed_on s,P & I is_halting_on s,P
holds I ";" Stop SCM+FSA is_closed_on s,P & I
  ";" Stop SCM+FSA is_halting_on s,P;

theorem 
  for l being Element of NAT holds  0 in dom Goto
  l & (Goto l). 0 = goto l;



theorem 
  for I being Program of SCM+FSA, s being State of SCM+FSA
  for P being Instruction-Sequence of SCM+FSA
  st I
is_closed_on Initialized s,P & I is_halting_on Initialized s,P
holds IC Comput(P +* (I ";" Stop SCM+FSA),
(s +* Initialize((intloc 0).-->1)),
  (LifeSpan(P+*I,s +* Initialize((intloc 0).-->1)) + 1)) = card I;

theorem 
  for I being Program of SCM+FSA, s being State of SCM+FSA
  for P being Instruction-Sequence of SCM+FSA
  st I is_closed_on Initialized s,P & I is_halting_on Initialized s,P
   holds DataPart Comput(P+*I, (s +* Initialize((intloc 0).-->1)),
   LifeSpan(P+*I,s
+* Initialize((intloc 0).-->1))) = DataPart
  Comput(P +* (I ";" Stop SCM+FSA), (s +*
Initialize((intloc 0).-->1)),
(LifeSpan(P+*I,s +* Initialize((intloc 0).-->1)) + 1));

theorem 
  for I being Program of SCM+FSA, s being State of SCM+FSA
  for P being Instruction-Sequence of SCM+FSA
  st I is_closed_on Initialized s,P & I is_halting_on Initialized s,P
 holds P+*(I ";" Stop SCM+FSA)
  halts_on s +* Initialize((intloc 0).-->1);

theorem 
  for I being Program of SCM+FSA, s being State of SCM+FSA
  for P being Instruction-Sequence of SCM+FSA
  st I is_closed_on Initialized s,P & I is_halting_on Initialized s,P
   holds LifeSpan(P+*(I ";" Stop SCM+FSA),
   s +* Initialize((intloc 0).-->1)) = LifeSpan(P+*I,
s +* Initialize((intloc 0).-->1)) + 1;

theorem 
  for s being State of SCM+FSA
  for P being Instruction-Sequence of SCM+FSA,
  I being Program of SCM+FSA st I
is_closed_on Initialized s,P & I is_halting_on Initialized s,P
holds IExec(I ";" Stop SCM+FSA,P,s) = IExec(I,P,s) +* Start-At(card I,SCM+FSA);

theorem 
  for I,J being Program of SCM+FSA,s being State of SCM+FSA
   st I is_closed_on s,P & I is_halting_on s,P
   holds I ";" Goto  (card J + 1) ";" J ";" Stop SCM+FSA is_closed_on s,P &
     I ";" Goto  (card J + 1) ";" J ";" Stop SCM+FSA is_halting_on s,P;

theorem 
  for I,J being Program of SCM+FSA, s being State of SCM+FSA
  for P being Instruction-Sequence of SCM+FSA
  st I is_closed_on s,P & I is_halting_on s,P
   holds
    P+*(I ";" Goto  (card J + 1) ";" J ";" Stop SCM+FSA)
   halts_on Initialize s;

theorem 
  for I,J being Program of SCM+FSA, s being State of SCM+FSA st I
is_closed_on Initialized s,P & I is_halting_on Initialized s,P
 holds P +* (I ";" Goto  (card J + 1) ";" J ";" Stop SCM+FSA)
   halts_on s +* Initialize((intloc 0).-->1);

theorem 
  for I,J being Program of SCM+FSA, s being State of SCM+FSA st I
  is_closed_on Initialized s,P & I is_halting_on Initialized s,P
  holds IC IExec(I ";"
Goto  (card J + 1) ";" J ";" Stop SCM+FSA,P,s) =  (card I + card J +
  1);

theorem 
  for I,J being Program of SCM+FSA, s being State of SCM+FSA st I
is_closed_on Initialized s,P & I is_halting_on Initialized s,P
holds IExec(I ";" Goto(card J + 1) ";" J ";" Stop SCM+FSA,P,s)
 = IExec(I,P,s) +* Start-At(card I + card J + 1,SCM+FSA);















begin

reserve P,P1,P2 for Instruction-Sequence of SCM+FSA;



theorem 
  for I being Program of SCM+FSA, s being State of SCM+FSA st I
  is_closed_on s,P holds 0 in dom I;

canceled;

theorem 
  for s1,s2 being State of SCM+FSA, I being Program of SCM+FSA st
  DataPart s1 = DataPart s2 holds I is_closed_on s1,P1
    implies I is_closed_on s2,P2;

theorem 
  for s1,s2 being State of SCM+FSA, I,J being Program of SCM+FSA
holds DataPart s1 = DataPart s2
 implies (Initialize s1)
  = (Initialize s2);

theorem 
  for s1,s2 being State of SCM+FSA, I being Program of SCM+FSA
   st DataPart s1 = DataPart s2
 holds I is_closed_on s1,P1 & I is_halting_on s1,P1
 implies
  I is_closed_on s2,P2 & I is_halting_on s2,P2;

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA holds
  I is_closed_on Initialized s,P iff
   I is_closed_on s +* Initialize((intloc 0).-->1),P+*J;

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, l
being Element of NAT holds I is_closed_on s,P iff I is_closed_on
  s +* (Start-At(0,SCM+FSA)),P+*I;

theorem 
  for s1 being 0-started State of SCM+FSA,
      s2 being State of SCM+FSA, I being Program of SCM+FSA
   st I is_closed_on s1,P1 & I c= P1
 for n being Element of NAT st
   IC s2 =  n & DataPart s1 = DataPart s2 & Reloc(I,n) c= P2
for i being Element of NAT holds
   IC Comput(P1, s1,i) + n = IC Comput(P2, s2,i) &
   IncAddr(CurInstr(P1,Comput( P1,s1,i)),n)
      = CurInstr(P2,Comput(P2,s2,i)) &
   DataPart Comput(P1, s1,i) = DataPart Comput(P2,s2,i);

theorem 
  for s being State of SCM+FSA, i being keeping_0 parahalting
  Instruction of SCM+FSA, J being parahalting Program of SCM+FSA, a being
  Int-Location
   holds IExec(i ";" J,P,s).a = IExec(J,P,Exec(i,Initialized s)).a;

theorem 
  for s being State of SCM+FSA, i being keeping_0 parahalting
  Instruction of SCM+FSA, J being parahalting Program of SCM+FSA, f being
  FinSeq-Location holds IExec(i ";" J,P,s).f
   = IExec(J,P,Exec(i,Initialized s)).f;

definition
  let a be Int-Location;
  let I,J be Program of SCM+FSA;
  func if=0(a,I,J) -> Program of SCM+FSA equals

  a =0_goto  (card J + 3)
  ";" J ";" Goto  (card I + 1) ";" I ";" Stop SCM+FSA;
  func if>0(a,I,J) -> Program of SCM+FSA equals

  a >0_goto  (card J + 3)
  ";" J ";" Goto  (card I + 1) ";" I ";" Stop SCM+FSA;
end;

definition
  let a be Int-Location;
  let I,J be Program of SCM+FSA;
  func if<0(a,I,J) -> Program of SCM+FSA equals

  if=0(a,J,if>0(a,J,I));
end;

theorem 
  for I,J being Program of SCM+FSA, a being Int-Location holds
  card if=0(a,I,J) = card I + card J + 4;

theorem 
  for I,J being Program of SCM+FSA, a being Int-Location holds
  card if>0(a,I,J) = card I + card J + 4;

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a
being read-write Int-Location
    st s.a = 0 & I is_closed_on s,P & I is_halting_on s,P
  holds if=0(a,I,J) is_closed_on s,P & if=0(a,I,J) is_halting_on s,P;

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a
  being read-write Int-Location st s.a = 0
   & I is_closed_on Initialized s,P & I is_halting_on Initialized s,P
   holds IExec(if=0(a,I,J),P,s)
     = IExec(I,P,s) +* Start-At((card I + card J + 3),SCM+FSA);

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a
being read-write Int-Location st s.a <> 0 & J is_closed_on s,P &
    J is_halting_on s,P
  holds if=0(a,I,J) is_closed_on s,P & if=0(a,I,J) is_halting_on s,P;

theorem 
  for I,J being Program of SCM+FSA, a being read-write
  Int-Location holds for s being State of SCM+FSA st s.a <> 0 &
    J is_closed_on Initialized s,P & J is_halting_on Initialized s,P
holds IExec(if=0(a,I,J),P,s)
 = IExec(J,P,s) +* Start-At((card I+card J+3),SCM+FSA);

theorem 
 for s being State of SCM+FSA, I,J being parahalting Program of SCM+FSA,
  a being read-write Int-Location
 holds if=0(a,I,J) is parahalting &
    (s.a = 0 implies
      IExec(if=0(a,I,J),P,s)
       = IExec(I,P,s) +* Start-At( (card I + card J + 3),SCM+FSA)) &
    (s.a <> 0 implies
      IExec(if=0(a,I,J),P,s)
       = IExec(J,P,s) +* Start-At((card I + card J + 3),SCM+FSA));

theorem 
  for s being State of SCM+FSA, I,J being parahalting Program of
SCM+FSA, a being read-write Int-Location holds IC IExec(if=0(a,I,J),P,s) =
(card I + card J + 3) & (s.a = 0 implies ((for d being Int-Location
 holds IExec(if=0(a,I,J),P,s).d = IExec(I,P,s).d) &
   for f being FinSeq-Location
    holds IExec(if=0(a,I,J),P,s).f = IExec(I,P,s).f)) &
    (s.a <> 0 implies ((for d being
  Int-Location holds IExec(if=0(a,I,J),P,s).d = IExec(J,P,s).d) & for f being
  FinSeq-Location holds IExec(if=0(a,I,J),P,s).f = IExec(J,P,s).f));

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a
being read-write Int-Location st s.a > 0 &
     I is_closed_on s,P & I is_halting_on s,P
  holds if>0(a,I,J) is_closed_on s,P & if>0(a,I,J) is_halting_on s,P;

theorem 
  for I,J being Program of SCM+FSA, a being read-write
  Int-Location holds for s being State of SCM+FSA st s.a > 0 &
   I is_closed_on Initialized s,P & I is_halting_on Initialized s,P
holds IExec(if>0(a,I,J),P,s)
 = IExec(I,P,s) +* Start-At((card I+card J+3),SCM+FSA);

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a
being read-write Int-Location st s.a <= 0 & J is_closed_on s,P &
    J is_halting_on s,P
  holds if>0(a,I,J) is_closed_on s,P & if>0(a,I,J) is_halting_on s,P;

theorem 
  for I,J being Program of SCM+FSA, a being read-write
  Int-Location holds for s being State of SCM+FSA st s.a <= 0 &
    J is_closed_on Initialized s,P & J is_halting_on Initialized s,P
holds IExec(if>0(a,I,J),P,s)
 = IExec(J,P,s) +* Start-At((card I+card J+3),SCM+FSA);

theorem 
  for s being State of SCM+FSA, I,J being parahalting Program of
SCM+FSA, a being read-write Int-Location holds if>0(a,I,J) is parahalting & (s.
  a > 0 implies IExec(if>0(a,I,J),P,s) = IExec(I,P,s) +* Start-At( (card I +
card J + 3),SCM+FSA)) & (s.a <= 0 implies IExec(if>0(a,I,J),P,s) =
 IExec(J,P,s) +* Start-At((card I + card J + 3),SCM+FSA));

theorem 
  for s being State of SCM+FSA, I,J being parahalting Program of
SCM+FSA, a being read-write Int-Location holds IC IExec(if>0(a,I,J),P,s) =
(card I + card J + 3) & (s.a > 0 implies
 ((for d being Int-Location holds IExec(if>0(a,I,J),P,s).d = IExec(I,P,s).d) &
   for f being FinSeq-Location
    holds IExec(if>0(a,I,J),P,s).f = IExec(I,P,s).f)) &
   (s.a <= 0 implies ((for d being
  Int-Location holds IExec(if>0(a,I,J),P,s).d = IExec(J,P,s).d) & for f being
  FinSeq-Location holds IExec(if>0(a,I,J),P,s).f = IExec(J,P,s).f));

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a being
read-write Int-Location st s.a < 0 & I is_closed_on s,P & I is_halting_on s,P
   holds
  if<0(a,I,J) is_closed_on s,P & if<0(a,I,J) is_halting_on s,P;

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a
  being read-write Int-Location st s.a < 0 & I is_closed_on Initialized s,P & I
is_halting_on Initialized s,P
holds IExec(if<0(a,I,J),P,s) = IExec(I,P,s) +* Start-At(
   (card I + card J + card J + 7),SCM+FSA);

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a being
read-write Int-Location st s.a = 0 & J is_closed_on s,P & J is_halting_on s,P
   holds
  if<0(a,I,J) is_closed_on s,P & if<0(a,I,J) is_halting_on s,P;

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a
  being read-write Int-Location st s.a = 0 & J is_closed_on Initialized s,P & J
is_halting_on Initialized s,P
holds IExec(if<0(a,I,J),P,s) = IExec(J,P,s) +* Start-At(
   (card I + card J + card J + 7),SCM+FSA);

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a being
read-write Int-Location st s.a > 0 & J is_closed_on s,P & J is_halting_on s,P
 holds
  if<0(a,I,J) is_closed_on s,P & if<0(a,I,J) is_halting_on s,P;

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a
  being read-write Int-Location st s.a > 0 & J is_closed_on Initialized s,P & J
is_halting_on Initialized s,P
holds IExec(if<0(a,I,J),P,s) = IExec(J,P,s) +* Start-At(
   (card I + card J + card J + 7),SCM+FSA);

theorem 
  for s being State of SCM+FSA, I,J being parahalting Program of SCM+FSA
  , a being read-write Int-Location holds if<0(a,I,J) is parahalting & (s.a < 0
implies IExec(if<0(a,I,J),P,s) = IExec(I,P,s) +* Start-At( (card I + card J +
card J + 7),SCM+FSA)) & (s.a >= 0 implies IExec(if<0(a,I,J),P,s) =
 IExec(J,P,s) +* Start-At((card I + card J + card J + 7),SCM+FSA));

registration
  let I,J be parahalting Program of SCM+FSA;
  let a be read-write Int-Location;
  cluster if=0(a,I,J) -> parahalting;
  cluster if>0(a,I,J) -> parahalting;
end;

definition
  let a,b be Int-Location;
  let I,J be Program of SCM+FSA;
  func if=0(a,b,I,J) -> Program of SCM+FSA equals

  SubFrom(a,b) ";" if=0(a,I,J);
  func if>0(a,b,I,J) -> Program of SCM+FSA equals

  SubFrom(a,b) ";" if>0(a,I,J);
end;

registration
  let a be Int-Location;
  let I,J be Program of SCM+FSA;
 cluster if=0(a,I,J) -> non halt-free;
 cluster  if>0(a,I,J) -> non halt-free;
 cluster if<0(a,I,J) -> non halt-free;
end;

registration
  let a,b be Int-Location;
  let I,J be Program of SCM+FSA;
 cluster if=0(a,b,I,J) -> non halt-free;
 cluster if>0(a,b,I,J) -> non halt-free;
end;

notation
  let a,b be Int-Location;
  let I,J be Program of SCM+FSA;
  synonym if<0(b,a,I,J) for if>0(a,b,I,J);
end;

registration
  let I,J be parahalting Program of SCM+FSA;
  let a,b be read-write Int-Location;
  cluster if=0(a,b,I,J) -> parahalting;
  cluster if>0(a,b,I,J) -> parahalting;
end;

theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA holds
  DataPart Result(P+*I,Initialized s) = DataPart IExec(I,P,s);

theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA
   holds  Result(P+*I,Initialized s) =  IExec(I,P,s);

theorem 
  for s1,s2 being State of SCM+FSA, i being Instruction of SCM+FSA
  , a being Int-Location holds (for b being Int-Location st a <> b holds s1.b =
s2.b) & (for f being FinSeq-Location holds s1.f = s2.f) & i does not refer a &
IC s1 = IC s2 implies (for b being Int-Location st a <> b holds Exec(i,s1).b =
Exec(i,s2).b) & (for f being FinSeq-Location holds Exec(i,s1).f = Exec(i,s2).f)
  & IC Exec(i,s1) = IC Exec(i,s2);

theorem 
  for s1,s2 being State of SCM+FSA, I being Program of SCM+FSA,
      a being Int-Location
   st I does not refer a &
     (for b being Int-Location st a <> b holds s1.b = s2.b) &
     (for f being FinSeq-Location holds s1.f = s2.f) &
     I is_closed_on s1,P1 holds
  for k being Element of NAT holds
   (for b being Int-Location st a <> b
    holds Comput(P1+*I,(Initialize s1),k).b
     = Comput(P2+*I, (Initialize s2),k).b) &
  (for f being FinSeq-Location holds
   Comput(P1+*I,(Initialize s1),k).f
    = Comput(P2+*I, (Initialize s2),k).f) &
 IC Comput(P1+*I, (Initialize s1),k)
  = IC Comput(P2+*I, (Initialize s2),k) &
  CurInstr(P1+*I,Comput(P1+*I, (Initialize s1),k))
   = CurInstr(P2+*I,Comput(P2+*I, (Initialize s2),k));

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, l
being Element of NAT holds I is_closed_on s,P & I is_halting_on s,P
   iff I is_closed_on s +* Start-At(l,SCM+FSA),P+*I &
     I is_halting_on s +* Start-At(l,SCM+FSA),P+*I;

theorem 
  for s1,s2 being State of SCM+FSA, I being Program of SCM+FSA, a
being Int-Location st I does not refer a & (for b being Int-Location st a <> b
  holds s1.b = s2.b) & (for f being FinSeq-Location holds s1.f = s2.f) & I
is_closed_on s1,P1 & I is_halting_on s1,P1
 holds I is_closed_on s2,P2 & I is_halting_on s2,P2;

theorem 
  for s1,s2 being State of SCM+FSA, I being Program of SCM+FSA, a
  being Int-Location holds (for d being read-write Int-Location st a <> d holds
  s1.d = s2.d) & (for f being FinSeq-Location holds s1.f = s2.f) & I
does not refer a & I is_closed_on Initialized s1,P1 &
    I is_halting_on Initialized s1,P1
implies (for d being Int-Location st a <> d
 holds IExec(I,P1,s1).d = IExec(I,P2,s2).d) &
   (for f being FinSeq-Location holds IExec(I,P1,s1).f = IExec(I,P2,s2).f) & IC
  IExec(I,P1,s1) = IC IExec(I,P2,s2);

theorem 
  for s being State of SCM+FSA, I,J being parahalting Program of SCM+FSA,
      a,b being read-write Int-Location
    st I does not refer a & J does not refer a
  holds IC IExec(if=0(a,b,I,J),P,s) =  (card I + card J + 5) & (s.a = s.b
  implies ((for d being Int-Location st a <> d
   holds IExec(if=0(a,b,I,J),P,s).d =
  IExec(I,P,s).d) & for f being FinSeq-Location
   holds IExec(if=0(a,b,I,J),P,s).f =
IExec(I,P,s).f)) & (s.a <> s.b implies
 ((for d being Int-Location st a <> d holds
  IExec(if=0(a,b,I,J),P,s).d = IExec(J,P,s).d) &
  for f being FinSeq-Location holds
  IExec(if=0(a,b,I,J),P,s).f = IExec(J,P,s).f));

theorem 
  for s being State of SCM+FSA, I,J being parahalting Program of SCM+FSA
, a,b being read-write Int-Location st I does not refer a & J does not refer a
  holds IC IExec(if>0(a,b,I,J),P,s) =  (card I + card J + 5) & (s.a > s.b
  implies (for d being Int-Location st a <> d
   holds IExec(if>0(a,b,I,J),P,s).d =
  IExec(I,P,s).d) & for f being FinSeq-Location
   holds IExec(if>0(a,b,I,J),P,s).f =
  IExec(I,P,s).f) & (s.a <= s.b implies
   (for d being Int-Location st a <> d holds
  IExec(if>0(a,b,I,J),P,s).d = IExec(J,P,s).d) &
  for f being FinSeq-Location holds
  IExec(if>0(a,b,I,J),P,s).f = IExec(J,P,s).f);















begin

reserve P,Q for Instruction-Sequence of SCM+FSA;

theorem 
  for I being Program of SCM+FSA, a being Int-Location holds card
  if=0(a, I ";" Goto  0, Stop SCM+FSA) = card I + 6;

theorem 
  for I being Program of SCM+FSA, a being Int-Location holds card
  if>0(a, I ";" Goto  0, Stop SCM+FSA) = card I + 6;



reserve m, n for Element of NAT;

definition
  let a be Int-Location;
  let I be Program of SCM+FSA;
  func while=0(a,I) -> Program of SCM+FSA equals

  if=0(a, I ";" Goto  0,
  Stop SCM+FSA) +* (  (card I +4) .--> goto  0 );
  func while>0(a,I) -> Program of SCM+FSA equals

  if>0(a, I ";" Goto  0,
  Stop SCM+FSA) +* (  (card I +4) .--> goto  0 );
end;

theorem 
  for I being Program of SCM+FSA, a being Int-Location holds card
  if=0(a,Stop SCM+FSA,if>0(a,Stop SCM+FSA,I ";" Goto  0)) = card I + 11;

definition
  let a be Int-Location;
  let I be Program of SCM+FSA;
  func while<0(a,I) -> Program of SCM+FSA equals

  if=0(a,Stop SCM+FSA,if>0(a,
Stop SCM+FSA,I ";" Goto  0)) +* (  (card I +4) .--> goto  0 )
  ;
end;

theorem 
  for I being Program of SCM+FSA, a being Int-Location holds card
  while=0(a,I) = card I + 6;

theorem 
  for I being Program of SCM+FSA, a being Int-Location holds card
  while>0(a,I) = card I + 6;

theorem 
  for I being Program of SCM+FSA, a being Int-Location holds card
  while<0(a,I) = card I + 11;

canceled 3;

theorem 
  for a being Int-Location, I being Program of SCM+FSA holds
   0 in dom while=0(a,I) &  1 in dom while=0(a,I) &  0 in dom
  while>0(a,I) &  1 in dom while>0(a,I);

theorem 
  for a being Int-Location, I being Program of SCM+FSA holds
  while=0(a,I). 0 = a =0_goto  4 & while=0(a,I). 1 = goto
 2 & while>0(a,I). 0 = a >0_goto  4 & while>0(a,I). 1 =
  goto  2;

theorem 
  for a being Int-Location, I being Program of SCM+FSA, k being
  Element of NAT st k < 6 holds  k in dom while=0(a,I);

theorem 
  for a being Int-Location, I being Program of SCM+FSA, k being
  Element of NAT st k < 6 holds card I +k in dom while=0(a,I);

theorem 
  for a being Int-Location, I being Program of SCM+FSA holds
  while=0(a,I).(card I +5) = halt SCM+FSA;

theorem 
  for a being Int-Location, I being Program of SCM+FSA holds
  while=0(a,I). 3 = goto  (card I +5);

theorem 
  for a being Int-Location, I being Program of SCM+FSA holds
  while=0(a,I). 2 = goto  3;

theorem 
  for a being Int-Location, I being Program of SCM+FSA,k being Element
  of NAT st k < card I +6 holds  k in dom while=0(a,I);

theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA, a
being read-write Int-Location st s.a <> 0
 holds while=0(a,I) is_halting_on s,P &
  while=0(a,I) is_closed_on s,P;

theorem 
  for a being Int-Location, I being Program of SCM+FSA, s being
State of SCM+FSA,k being Element of NAT
 st I is_closed_on s,P & I is_halting_on s,P
& k < LifeSpan(P +* I,Initialize s) &
  IC Comput(P +* while=0(a,I),(Initialize s),1+k)
   = IC Comput(P +* I, (Initialize s),k) + 4 &
   DataPart Comput(P +* while=0(a,I),(Initialize s),1+k)
    = DataPart Comput(P +* I,(Initialize s),k)
  holds IC Comput(P +* while=0(a,I),(Initialize s),1+k+1) = IC
Comput(P +* I, (Initialize s),k+1) + 4 &
  DataPart Comput(P +* while=0(a,I),(Initialize s),1+k+1) =
  DataPart Comput(P +* I, (Initialize s),k+1);

theorem 
  for a being Int-Location, I being Program of SCM+FSA, s being
  State of SCM+FSA st I is_closed_on s,P & I is_halting_on s,P &
  IC Comput(P +* while=0(a,I), Initialize s,
   1 + LifeSpan(P +* I,Initialize s) ) = IC Comput(P +* I,Initialize s,
       LifeSpan(P +* I,Initialize s) ) + 4
 holds CurInstr(P +* while=0(a,I),
   Comput(P +* while=0(a,I),Initialize s,
  (1 + LifeSpan(P +* I,Initialize s)))) = goto  (card I +4);

theorem 
  for a being Int-Location, I being Program of SCM+FSA holds
  while=0(a,I). (card I +4) = goto  0;

reserve f for FinSeq-Location,
  c for Int-Location;

theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA, a
being read-write Int-Location
 st I is_closed_on s,P & I is_halting_on s,P & s.a =0
holds IC Comput(P +* while=0(a,I), (Initialize s),
(LifeSpan(P +* I,Initialize s) + 3)) =  0 &
for k being Element of NAT st k
  <= LifeSpan(P +* I,Initialize s) + 3
  holds IC Comput(P +* while=0(a,I),
   (Initialize s),k) in dom while=0(a,I);

reserve s for State of SCM+FSA,
  I for Program of SCM+FSA,
  a for read-write
  Int-Location;

definition
  let s,I,a,P;
  func StepWhile=0(a,I,P,s) ->
    Function of NAT,product the_Values_of SCM+FSA means


  it.0 = s &
  for i being Nat holds
   it.(i+1)= Comput(P +* while=0(a,I),
       it.i +* Start-At(0,SCM+FSA),
       LifeSpan(P +* while=0(a,I) +* I,
        it.i +* Start-At(0,SCM+FSA)) + 3);
end;

reserve i,k,m,n for Element of NAT;

theorem 
  StepWhile=0(a,I,P,s).(k+1)=StepWhile=0(a,I,P,StepWhile=0(a,I,P,s).k).1;

canceled;

theorem 
  for I being Program of SCM+FSA,a being read-write Int-Location,
  s being State of SCM+FSA holds StepWhile=0(a,I,P,s).(0+1)
   = Comput(P +* while=0(a,I),Initialize s,
        LifeSpan(P +* while=0(a,I)+* I,Initialize s) + 3);

theorem 
  for I being Program of SCM+FSA,a being read-write Int-Location,
s being State of SCM+FSA,k,n being Element of NAT
st IC StepWhile=0(a,I,P,s).k = 0 &
   StepWhile=0(a,I,P,s).k= Comput(P +* while=0(a,I),
       (Initialize s),n)
   holds StepWhile=0(a,I,P,s).k = Initialize(StepWhile=0(a,I,P,s).k) &
   StepWhile=0(a,I,P,s).(k+1)=Comput(P +* while=0(a,I), Initialize s,
     (n +(LifeSpan(P +* while=0(a,I) +* I,
       Initialize(StepWhile=0(a,I,P,s).k)) + 3)));

theorem 
  for I being Program of SCM+FSA,a being read-write Int-Location,
s being State of SCM+FSA st
 (for k being Nat holds
  I is_closed_on StepWhile=0(a,I,P,s).k,P+*while=0(a,I) &
  I is_halting_on StepWhile=0(a,I,P,s).k,P+*while=0(a,I)) &
   ex f being Function of
  product the_Values_of SCM+FSA,NAT st
   for k being Nat holds
    ((f.(StepWhile=0(a,I,P,s).(k+1)) < f.(StepWhile=0(a,I,P,s).k) or
     f.(StepWhile=0(a,I,P,s).k) = 0) &
    (f.(StepWhile=0(a,I,P,s).k)=0 iff (StepWhile=0(a,I,P,s).k).a <> 0))
  holds while=0(a,I) is_halting_on s,P & while=0(a,I) is_closed_on s,P;

theorem 
  for I being parahalting Program of SCM+FSA, a being read-write
  Int-Location, s being State of SCM+FSA st
   ex f being Function of product the_Values_of SCM+FSA,NAT st
  for k being Nat
   holds (f.(StepWhile=0(a,I,P,s).(k+1)) < f.(StepWhile=0(a,I,P,s).k)
    or f.(StepWhile=0(a,I,P,s).k) = 0) &
     (f.(StepWhile=0(a,I,P,s).k)=0 iff (StepWhile=0(a,I,P,s).k).a <> 0 )
 holds while=0(a,I) is_halting_on s,P & while=0(a,I) is_closed_on s,P;

theorem 
  for I being parahalting Program of SCM+FSA, a being read-write
  Int-Location st ex f being Function of product the_Values_of SCM+FSA,NAT
st (for s being State of SCM+FSA,P
 holds (f.(StepWhile=0(a,I,P,s).1) < f.s
 or f.s =
  0) & ( f.s =0 iff s.a <> 0 )) holds while=0(a,I) is parahalting;

theorem 
  for l1,l2 being Element of NAT,a being
  Int-Location holds (l1 .--> goto l2) does not destroy a;

theorem 
  for i being Instruction of SCM+FSA st i does not destroy intloc
  0 holds Macro i is good;

registration
  let I,J be good Program of SCM+FSA,a be Int-Location;
  cluster if=0(a,I,J) -> good;
end;

registration
  let I be good Program of SCM+FSA,a be Int-Location;
  cluster while=0(a,I) -> good;
end;




theorem 
  for a being Int-Location, I being Program of SCM+FSA, k being
  Element of NAT st k < 6 holds  k in dom while>0(a,I);

theorem 
  for a being Int-Location, I being Program of SCM+FSA, k being
  Element of NAT st k < 6 holds card I +k in dom while>0(a,I);

theorem 
  for a being Int-Location, I being Program of SCM+FSA holds
  while>0(a,I).(card I+5) = halt SCM+FSA;

theorem 
  for a being Int-Location, I being Program of SCM+FSA holds
  while>0(a,I). 3 = goto  (card I +5);

theorem 
  for a being Int-Location, I being Program of SCM+FSA holds
  while>0(a,I). 2 = goto  3;

theorem 
  for a being Int-Location, I being Program of SCM+FSA, k being Element
  of NAT st k < card I +6 holds  k in dom while>0(a,I);

theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA, a
being read-write Int-Location
 st s.a <= 0 holds while>0(a,I) is_halting_on s,P &
  while>0(a,I) is_closed_on s,P;

theorem 
  for a being Int-Location, I being Program of SCM+FSA, s being
State of SCM+FSA,k being Element of NAT
 st I is_closed_on s,P & I is_halting_on s,P
& k < LifeSpan(P +* I,Initialize s) &
IC Comput(P +* while>0(a,I), (Initialize s),1+k)
   = IC Comput(P +* I, (Initialize s),k) + 4 &
   DataPart Comput(P +* while>0(a,I),
    (Initialize s),1+k) =
   DataPart Comput(P +* I, (Initialize s),k)
  holds IC Comput(P +* while>0(a,I),
    (Initialize s),1+k+1)
  = IC
Comput(P +* I, (Initialize s),k+1) + 4 &
DataPart Comput(P +* while>0(a,I), (
Initialize s),1+k+1) =
DataPart Comput(P +* I, (s +*
  Start-At(0,SCM+FSA)),k+1);

theorem 
  for a being Int-Location, I being Program of SCM+FSA, s being
  State of SCM+FSA st I is_closed_on s,P & I is_halting_on s,P & IC Comput(
        P +* while>0(a,I), (Initialize s),
  1 + LifeSpan(P +* I,Initialize s ) ) =
IC Comput(P +* I, (Initialize s),
LifeSpan(P +* I,Initialize s)) + 4
holds CurInstr(P +* while>0(a,I),
   Comput(P +* while>0(a,I), (Initialize s),
  1 + LifeSpan(P +* I,Initialize s) )) =
  goto  (card I +4);

theorem 
  for a being Int-Location, I being Program of SCM+FSA holds
  while>0(a,I). (card I +4) = goto  0;

theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA, a
being read-write Int-Location
 st I is_closed_on s,P & I is_halting_on s,P & s.a >0
holds IC Comput(P +* while>0(a,I), (Initialize s),
(LifeSpan(P +* I,Initialize s) + 3)) =  0 &
for k being Element of NAT st k <= LifeSpan(P +* I,Initialize s) + 3
  holds IC Comput(P +* while>0(a,I), Initialize s,k) in dom while>0(a,I);

reserve s for State of SCM+FSA,
  I for Program of SCM+FSA,
  a for read-write
  Int-Location;

definition
  let s,I,a,P;
  func StepWhile>0(a,I,P,s) -> Function of NAT,product the_Values_of
  SCM+FSA means


  it.0 = s & for i being Nat
   holds it.(i+1)= Comput(P +* while>0(a,I),
    it.i +* Start-At(0,SCM+FSA),
    LifeSpan(P +* while>0(a,I) +* I,
       it.i +* Start-At(0,SCM+FSA)) + 3);
end;

theorem 
  StepWhile>0(a,I,P,s).(k+1)=StepWhile>0(a,I,P,StepWhile>0(a,I,P,s).k).1;

theorem 
  for I being Program of SCM+FSA,a being read-write Int-Location,
  s being State of SCM+FSA holds StepWhile>0(a,I,P,s).(0+1)
  = Comput(P +* while>0(a,I),
       Initialize s,
       LifeSpan(P +* while>0(a,I)+* I,Initialize s) + 3);

theorem 
  for I being Program of SCM+FSA,a being read-write Int-Location,
s being State of SCM+FSA,k,n being Element of NAT
 st IC StepWhile>0(a,I,P,s).k =
   0 & StepWhile>0(a,I,P,s).k= Comput(P +* while>0(a,I),
   (Initialize s),n)
 holds StepWhile>0(a,I,P,s).k = Initialize(StepWhile>0(a,I,P,s).k)
  & StepWhile>0(a,I,P,s).(k+1)=
Comput(P +* while>0(a,I), Initialize s,
   n +(LifeSpan(P +* while>0(a,I) +* I,Initialize(StepWhile>0(a,I,P,s).k)
  ) + 3));

theorem 
  for I being Program of SCM+FSA,a being read-write Int-Location,
s being State of SCM+FSA st (for k being Nat
 holds I is_closed_on StepWhile>0(a,I,P,s).k,P+*while>0(a,I) &
  I is_halting_on StepWhile>0(a,I,P,s).k,P+*while>0(a,I)) &
  ex f being Function of
  product the_Values_of SCM+FSA,NAT st (for k being Nat holds (f.(
StepWhile>0(a,I,P,s).(k+1)) < f.(StepWhile>0(a,I,P,s).k) or
 f.(StepWhile>0(a,I,P,s).k
  ) = 0) & ( f.(StepWhile>0(a,I,P,s).k)=0 iff
   (StepWhile>0(a,I,P,s).k).a <= 0 ))
  holds while>0(a,I) is_halting_on s,P & while>0(a,I) is_closed_on s,P;

theorem 
  for I being parahalting Program of SCM+FSA, a being read-write
  Int-Location, s being State of SCM+FSA st
  ex f being Function of product the_Values_of SCM+FSA,NAT st (for k being Nat
 holds (f.(StepWhile>0(a,I,P,s).(k+
  1)) < f.(StepWhile>0(a,I,P,s).k) or f.(StepWhile>0(a,I,P,s).k) = 0) & ( f.(
StepWhile>0(a,I,P,s).k)=0 iff (StepWhile>0(a,I,P,s).k).a <= 0 ) )
 holds while>0(a,I
  ) is_halting_on s,P & while>0(a,I) is_closed_on s,P;

theorem 
  for I being parahalting Program of SCM+FSA, a being read-write
  Int-Location st ex f being Function of product the_Values_of SCM+FSA,NAT
st (for s being State of SCM+FSA,P holds (f.(StepWhile>0(a,I,P,s).1) < f.s
 or f.s =
  0) & ( f.s =0 iff s.a <= 0 )) holds while>0(a,I) is parahalting;

registration
  let I,J be good Program of SCM+FSA,a be Int-Location;
  cluster if>0(a,I,J) -> good;
end;

registration
  let I be good Program of SCM+FSA,a be Int-Location;
  cluster while>0(a,I) -> good;
end;















begin 

reserve m for Element of NAT;
reserve P,PP,P1,P2
 for Instruction-Sequence of SCM+FSA;

theorem 
  for s being State of SCM+FSA,I being initial Program of SCM+FSA
   st I is_pseudo-closed_on s,P
  for k being Element of NAT st
    for n being Element of NAT st n <= k
     holds IC Comput(P +* I,Initialize s,n) in dom I
  holds k < pseudo-LifeSpan(s,P,I);

theorem 
  for I,J being Program of SCM+FSA, k being Element of NAT
     st card I <= k & k < card I + card J
  for i being Instruction of SCM+FSA st i = J.(k -' card I)
   holds (I ";" J). k = IncAddr(i,card I);

theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA holds
  IExec(I,P,s) = IExec(I,P,Initialized s);

canceled;

theorem 
  for I being Program of SCM+FSA st
   for s being State of SCM+FSA, P holds I is_halting_on Initialized s,P
  holds Initialize((intloc 0).-->1) is I-halted;

theorem 
  for I being Program of SCM+FSA holds (for s being State of
  SCM+FSA, P holds I is_halting_on Initialized s,P)
   implies Initialize((intloc 0).-->1) is I-halted;

canceled 5;

theorem 
  for s being State of SCM+FSA, i being Instruction of SCM+FSA st
  InsCode i in {0,6,7,8} holds DataPart Exec(i,s) = DataPart s;

canceled;

theorem 
  for s being State of SCM+FSA holds IExec(Stop SCM+FSA,P,s) = Initialized s;

theorem 
  for s being State of SCM+FSA,I being Program of SCM+FSA st I
  is_closed_on s,P holds  0 in dom I;

theorem 
  for s1 being 0-started State of SCM+FSA,
      s2 being State of SCM+FSA,I being Program of SCM+FSA
   st I is_closed_on s1,P1 & I c= P1
  for n being Element of NAT st
   Reloc(I,n) c= P2 & IC s2 =  n & DataPart s1 = DataPart s2
  for i being Element of NAT holds
   IC Comput(P1, s1,i) + n = IC Comput(P2, s2,i) &
   IncAddr(CurInstr(P1,Comput(P1,s1,i)),n)
        = CurInstr(P2,Comput(P2,s2,i)) &
  DataPart Comput(P1, s1,i) = DataPart Comput(P2,s2,i);

theorem 
  for s1,s2 being 0-started State of SCM+FSA,I being Program of SCM+FSA
   st I is_closed_on s1,P1 & I c= P1 & I c= P2 & DataPart s1 = DataPart s2
  for i being Element of NAT
  holds IC Comput(P1, s1,i) = IC Comput(P2, s2,i) &
  CurInstr(P1,Comput(P1,s1,i)) = CurInstr(P2,Comput(P2,s2,i)) &
  DataPart Comput(P1, s1,i) = DataPart Comput(P2,s2,i);

theorem 
  for s1,s2 being 0-started State of SCM+FSA,I being Program of SCM+FSA
    st I is_closed_on s1,P1 & I is_halting_on s1,P1 & I c= P1 & I c= P2 &
       DataPart s1 = DataPart s2
  holds LifeSpan(P1,s1) = LifeSpan(P2,s2);

theorem 
  for s1,s2 being State of SCM+FSA,I being Program of SCM+FSA st
  s1.intloc 0 = 1 & I is_closed_on s1,P1 & I is_halting_on s1,P1 &
   ((for a being read-write Int-Location holds s1.a = s2.a) &
  for f being FinSeq-Location holds s1.f = s2.f)
  holds DataPart IExec(I,P1,s1) = DataPart IExec(I,P2,s2);

theorem 
  for s1,s2 being State of SCM+FSA,I being Program of SCM+FSA
   st s1.intloc 0 = 1 & I is_closed_on s1,P1 & I is_halting_on s1,P1 &
      DataPart s1 = DataPart s2
  holds DataPart IExec(I,P1,s1) = DataPart IExec(I,P2,s2);

theorem 
  for s being State of SCM+FSA,
      I being Program of SCM+FSA
       st I is_pseudo-closed_on s,P
 holds I is_pseudo-closed_on Initialize s,P+*I &
   pseudo-LifeSpan(s,P,I) = pseudo-LifeSpan(Initialize s,P+*I,I);

theorem 
  for s1 being 0-started State of SCM+FSA,
      s2 being State of SCM+FSA, I being Program of SCM+FSA st
   I c= P1 & I is_pseudo-closed_on s1,P1
   for n being Element of NAT st Reloc(I,n) c= P2 &
    IC s2 =  n & DataPart s1 =
  DataPart s2 holds ((for i being Element of NAT
   st i < pseudo-LifeSpan(s1,P1,I)
  holds IncAddr(CurInstr(P1,Comput(P1,s1,i)),n)
   = CurInstr(P2,Comput(P2,s2,i))) &
for i being Element of NAT st i <= pseudo-LifeSpan(s1,P1,I)
holds IC Comput(P1, s1,i) + n = IC Comput(P2, s2,i) &
  DataPart Comput(P1, s1,i) = DataPart Comput(P2, s2,i));

theorem 
  for s1,s2 being State of SCM+FSA, I being Program of SCM+FSA st
  DataPart s1 = DataPart s2 holds I is_pseudo-closed_on s1,P1 implies I
  is_pseudo-closed_on s2,P2;

theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA st s.
intloc 0 = 1 holds I is_pseudo-closed_on s,P iff
I is_pseudo-closed_on Initialized s,P;

theorem 
  for a being Int-Location, I,J being Program of SCM+FSA holds
   0 in dom if=0(a,I,J) &  1 in dom if=0(a,I,J) &  0 in dom
  if>0(a,I,J) &  1 in dom if>0(a,I,J);

theorem 
  for a being Int-Location, I,J being Program of SCM+FSA holds
  if=0(a,I,J). 0 = a =0_goto  (card J + 3) & if=0(a,I,J). 1 =
goto  2 & if>0(a,I,J). 0 = a >0_goto  (card J + 3) & if>0(a,I
  ,J). 1 = goto  2;

theorem 
  for a being Int-Location, I,J being Program of SCM+FSA, n being
Element of NAT st n < card I + card J + 3 holds n in dom if=0(a,I,J) & if=0(a,I
  ,J).n <> halt SCM+FSA;

theorem 
  for a being Int-Location, I,J being Program of SCM+FSA, n being
Element of NAT st n < card I + card J + 3 holds n in dom if>0(a,I,J) & if>0(a,I
  ,J).n <> halt SCM+FSA;

theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA st
  Directed I is_pseudo-closed_on s,P
   holds I ";" Stop SCM+FSA is_closed_on s,P &
    I ";" Stop SCM+FSA is_halting_on s,P &
   LifeSpan(P +* (I ";" Stop SCM+FSA),
         Initialize s) =
   pseudo-LifeSpan(s,P,Directed I) &
  (for n being Element of
  NAT st n < pseudo-LifeSpan(s,P,Directed I) holds
   IC Comput(P +* I, (Initialize s),n)
     = IC Comput(P +* (I ";" Stop SCM+FSA),
     (Initialize s),n)) &
for n being Element of NAT st n <= pseudo-LifeSpan(s,P,Directed I)
 holds DataPart Comput(P +* I, (Initialize s),n)
   = DataPart Comput(P+* (I ";" Stop SCM+FSA),
    Initialize s,n);

theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA st
  Directed I is_pseudo-closed_on s,P holds
   DataPart Result(P +* (I ";" Stop SCM+FSA),
   Initialize s) =
  DataPart Comput(P +* I, (Initialize s),
  pseudo-LifeSpan(s,P,Directed I));

theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA st s.intloc 0
= 1 & Directed I is_pseudo-closed_on s,P
 holds DataPart IExec(I ";" Stop SCM+FSA,P,s)
  = DataPart Comput(P +* I, (Initialize s),
pseudo-LifeSpan(s,P,Directed I));

theorem 
  for I,J being Program of SCM+FSA,a being Int-Location holds if=0
  (a,I,J). (card I + card J + 3) = halt SCM+FSA;

theorem 
  for I,J being Program of SCM+FSA,a being Int-Location holds if>0
  (a,I,J). (card I + card J + 3) = halt SCM+FSA;

theorem 
  for I,J being Program of SCM+FSA,a being Int-Location holds if=0
  (a,I,J). (card J + 2) = goto  (card I + card J + 3);

theorem 
  for I,J being Program of SCM+FSA,a being Int-Location holds if>0
  (a,I,J). (card J + 2) = goto  (card I + card J + 3);

theorem 
  for J being Program of SCM+FSA,a being Int-Location holds if=0(a
  ,Goto  2,J). (card J + 3) = goto  (card J + 5);

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA,
      a being read-write Int-Location st
  s.a = 0 & Directed I is_pseudo-closed_on s,P
    holds if=0(a,I,J) is_halting_on s,P &
    if=0(a,I,J) is_closed_on s,P &
    LifeSpan(P +* if=0(a,I,J),Initialize s)
   = LifeSpan(P +* (I ";" Stop SCM+FSA),
       Initialize s) + 1;

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a being
  read-write Int-Location st s.intloc 0 = 1 & s.a = 0 & Directed I
  is_pseudo-closed_on s,P holds DataPart IExec(if=0(a,I,J),P,s)
   = DataPart IExec(I ";" Stop SCM+FSA,P,s);

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a
  being read-write Int-Location
   st s.a > 0 & Directed I is_pseudo-closed_on s,P
holds if>0(a,I,J) is_halting_on s,P & if>0(a,I,J) is_closed_on s,P &
 LifeSpan(P+* if>0(a,I,J),Initialize s)
   = LifeSpan(P +* (I ";" Stop SCM+FSA),
   Initialize s) + 1;

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a
  being read-write Int-Location st s.intloc 0 = 1 & s.a > 0 & Directed I
  is_pseudo-closed_on s,P holds DataPart IExec(if>0(a,I,J),P,s)
   = DataPart IExec(I ";" Stop SCM+FSA,P,s);

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a
  being read-write Int-Location st s.a <> 0 &
   Directed J is_pseudo-closed_on s,P
holds if=0(a,I,J) is_halting_on s,P & if=0(a,I,J) is_closed_on s,P &
    LifeSpan(P +* if=0(a,I,J),Initialize s)
    = LifeSpan(P +* (J ";" Stop SCM+FSA),
      Initialize s) + 3;

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a being
  read-write Int-Location st s.intloc 0 = 1 & s.a <> 0 & Directed J
  is_pseudo-closed_on s,P holds
   DataPart IExec(if=0(a,I,J),P,s) = DataPart IExec(J ";" Stop SCM+FSA,P,s);

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a
  being read-write Int-Location st s.a <= 0 &
   Directed J is_pseudo-closed_on s,P
holds if>0(a,I,J) is_halting_on s,P & if>0(a,I,J) is_closed_on s,P &
  LifeSpan(P +* if>0(a,I,J),s +* (Start-At(0,SCM+FSA))) =
  LifeSpan(P +* (J ";" Stop SCM+FSA),
  Initialize s) + 3;

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a
  being read-write Int-Location st s.intloc 0 = 1 & s.a <= 0 & Directed J
  is_pseudo-closed_on s,P holds
   DataPart IExec(if>0(a,I,J),P,s) = DataPart IExec(J
  ";" Stop SCM+FSA,P,s);

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a being
  read-write Int-Location st Directed I is_pseudo-closed_on s,P & Directed J
  is_pseudo-closed_on s,P holds if=0(a,I,J) is_closed_on s,P & if=0(a,I,J)
  is_halting_on s,P;

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a being
  read-write Int-Location st Directed I is_pseudo-closed_on s,P & Directed J
  is_pseudo-closed_on s,P holds if>0(a,I,J) is_closed_on s,P & if>0(a,I,J)
  is_halting_on s,P;

theorem 
  for I being Program of SCM+FSA, a being Int-Location holds I
  does not destroy a implies Directed I does not destroy a;

theorem 
  for i being Instruction of SCM+FSA, a being Int-Location holds i
  does not destroy a implies Macro i does not destroy a;

theorem 
  for a being Int-Location holds halt SCM+FSA does not refer a;

theorem 
  for a,b,c being Int-Location holds a <> b implies AddTo(c,b)
  does not refer a;

theorem 
  for i being Instruction of SCM+FSA, a being Int-Location holds i
  does not refer a implies Macro i does not refer a;

theorem 
  for I,J being Program of SCM+FSA, a being Int-Location holds I
  does not destroy a & J does not destroy a implies I ";" J does not destroy a;

theorem 
  for J being Program of SCM+FSA, i being Instruction of SCM+FSA,
a being Int-Location st i does not destroy a & J does not destroy a holds i ";"
  J does not destroy a;

theorem 
  for I being Program of SCM+FSA, j being Instruction of SCM+FSA, a
being Int-Location st I does not destroy a & j does not destroy a holds I ";" j
  does not destroy a;

theorem 
  for i,j being Instruction of SCM+FSA, a being Int-Location st i
  does not destroy a & j does not destroy a holds i ";" j does not destroy a;

theorem 
  for a being Int-Location holds Stop SCM+FSA does not destroy a;

theorem 
  for a being Int-Location, l being Element of NAT
   holds Goto l does not destroy a;

theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA st I
  is_halting_on Initialized s,P holds
   (for a being read-write Int-Location holds
IExec(I,P,s).a = Comput(P +* I,Initialize Initialized s,
 (LifeSpan(P +* I, Initialize Initialized s))).a) &
  for f being FinSeq-Location
  holds IExec(I,P,s).f = Comput(P +* I,Initialize Initialized s,
  LifeSpan(P +* I,Initialize Initialized s)).f;

theorem 
  for s being State of SCM+FSA, I being parahalting Program of
  SCM+FSA, a being read-write Int-Location holds IExec(I,P,s).a = Comput(
P +* I,
  Initialize Initialized s,
  (LifeSpan(P +* I,Initialize Initialized s))).a;

theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA, a
  being Int-Location,k being Element of NAT
   st I is_closed_on Initialized s,P & I
  is_halting_on Initialized s,P & I does not destroy a holds IExec(I,P,s).a =
  Comput(P +* I, (Initialize Initialized s),k).a;

theorem 
  for s being State of SCM+FSA, I being parahalting Program of
  SCM+FSA, a being Int-Location,k being Element of NAT st I does not destroy a
holds IExec(I,P,s).a = Comput(P +* I,(Initialize Initialized s),k).a;

theorem 
  for s being State of SCM+FSA, I being parahalting Program of
  SCM+FSA, a being Int-Location st I does not destroy a
   holds IExec(I,P,s).a = (Initialized s).a;

theorem 
  for s being State of SCM+FSA, I being keeping_0 Program of
  SCM+FSA st I is_halting_on Initialized s,P
   holds IExec(I,P,s).intloc 0 = 1 & for k
being Element of NAT holds Comput(P +* I,
(Initialize Initialized s),k).intloc 0 = 1;

theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA, a
being Int-Location st I does not destroy a holds for k being Element of NAT st
IC Comput(P +* I, (Initialize s),k) in dom I
holds Comput(P +* I,
  (Initialize s),k + 1).a =
   Comput(P +* I, (Initialize s),k).a;

theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA, a
being Int-Location st I does not destroy a holds for m being Element of NAT st
(for n being Element of NAT st n < m
 holds IC Comput(P +* I, (Initialize s),n) in dom I)
 for n being Element of NAT st n <= m holds
  Comput(P +* I, (Initialize s),n).a = s.a;

theorem 
  for s being State of SCM+FSA, I being good Program of SCM+FSA
  for m being Element of NAT st (for n being Element of NAT st n < m holds IC
  Comput(P +* I, (Initialize s),n) in dom I) holds
  for n being
Element of NAT st n <= m holds Comput(P +* I, (Initialize s),n).
  intloc 0 = s.intloc 0;

theorem 
  for s being State of SCM+FSA, I being good Program of SCM+FSA st
  I is_halting_on Initialized s,P & I is_closed_on Initialized s,P
   holds IExec(I,P,s).intloc 0 = 1 & for k being Element of NAT
  holds Comput(P +* I, (Initialize Initialized s),k).intloc 0 = 1;

theorem 
  for s being State of SCM+FSA, I being good Program of SCM+FSA st I
is_closed_on s,P holds for k being Element of NAT
 holds Comput(P +* I, (Initialize s),k).intloc 0 = s.intloc 0;

theorem 
  for P
  for s being State of SCM+FSA, I being keeping_0 parahalting
  Program of SCM+FSA, a being read-write Int-Location st I does not destroy a
  holds Comput(P +* (I ";" SubFrom(a,intloc 0)),
   Initialize Initialized s,
   LifeSpan(P +* (I ";" SubFrom(a,intloc 0)),
  Initialize Initialized s)).a = s.a - 1;

theorem 
  for i being Instruction of SCM+FSA st i does not destroy intloc
  0 holds Macro i is good;

theorem 
  for s1,s2 being State of SCM+FSA,I being Program of SCM+FSA st
I is_closed_on s1,P1 & I is_halting_on s1,P1 & DataPart s1 = DataPart s2
  for k being Element of NAT holds
    Comput(P1 +* I,Initialize s1,k)
   =  Comput(P2 +* I,Initialize s2,k)
   & CurInstr(P1 +* I,Comput(P1 +* I,Initialize s1,k))
    = CurInstr(P2 +* I,Comput(P2 +* I,Initialize s2,k));

theorem 
  for s1,s2 being State of SCM+FSA,I being Program of SCM+FSA st
  I is_closed_on s1,P1 & I is_halting_on s1,P1 & DataPart s1 = DataPart s2
   holds
  LifeSpan(P1 +* I,Initialize s1) =
  LifeSpan(P2 +* I,Initialize s2) &
   Result(P1 +* I,Initialize s1)
  =  Result(P2 +* I,Initialize s2);



theorem 
  for s1,s2 being 0-started State of SCM+FSA,I being Program of SCM+FSA st
  I is_closed_on s1,P1 & I is_halting_on s1,P1 &
  I c= P1 & I c= P2 &
   ex k being Element of NAT st  Comput(P1, s1,k) =  s2
  holds  Result(P1,s1) =  Result(P2,s2);

begin 

definition
  let I be Program of SCM+FSA;
  func loop I -> halt-free Program of SCM+FSA equals

  Directed(I, 0);
end;



theorem 
  for I being Program of SCM+FSA, a being Int-Location holds
   loop I destroys a implies I destroys a;

registration
  let I be good Program of SCM+FSA;
  cluster loop I -> good;
end;



theorem 
  for I being Program of SCM+FSA holds not halt SCM+FSA in rng
  loop I;



theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA st I
is_closed_on s,P & I is_halting_on s,P
 for m being Element of NAT st m <= LifeSpan(
P +* I,Initialize s)
holds  Comput(P +* I, (Initialize s),m)
   =  Comput(P +* loop I,(Initialize s),m);

theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA st I
is_closed_on s,P & I is_halting_on s,P
 for m being Element of NAT st m < LifeSpan(
P +* I,
Initialize s)
holds CurInstr(P +* I,
   Comput(P +* I, (Initialize s),m))
 = CurInstr(P +* loop I,
   Comput(P +* loop I,(Initialize s),m));

theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA st I
is_closed_on s,P & I is_halting_on s,P
 for m being Element of NAT st m <= LifeSpan(
P +* I,Initialize s)
  holds CurInstr(P +* loop I,
  Comput(P +* loop I,Initialize s,m)) <> halt SCM+FSA;

theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA st I
is_closed_on s,P & I is_halting_on s,P holds
 CurInstr(P +* loop I,
  Comput(P +* loop I, (Initialize s),
LifeSpan(P +* I,Initialize s)))
 = goto  0;

theorem 
  for s being 0-started State of SCM+FSA, I being paraclosed Program of
  SCM+FSA st I c= P & P halts_on s
   for m being Element of
  NAT st m <= LifeSpan(P,s) holds
    Comput(P, s,m) =  Comput(P +* loop I, s,m);

theorem 
  for s being State of SCM+FSA, I being parahalting Program of SCM+FSA
st Initialize((intloc 0).-->1) c= s & I c= P
 holds for k being Element of NAT st k <= LifeSpan(P,s) holds
  CurInstr(P +* loop I,
   Comput(P+*loop I, s,k)) <> halt SCM+FSA;

begin 

definition
  let a be Int-Location;
  let I be Program of SCM+FSA;
  func Times(a,I) -> Program of SCM+FSA equals

  if>0(a,loop if=0(a,Goto 2,I ";" SubFrom(a,intloc 0)), Stop SCM+FSA);
end;

registration
  let a be Int-Location;
  let I be Program of SCM+FSA;
  cluster Times(a,I) -> non halt-free;
end;

theorem 
  for I being good Program of SCM+FSA, a being read-write
  Int-Location holds if=0(a,Goto  2,I ";" SubFrom(a,intloc 0)) is good;

theorem 
  for I,J being Program of SCM+FSA,a being Int-Location holds
if=0(a,Goto  2,I ";" SubFrom(a,intloc 0)).  (card (I ";" SubFrom(a,
  intloc 0)) + 3) = goto  (card (I ";" SubFrom(a,intloc 0)) + 5);

theorem 
  for s being State of SCM+FSA, I being good parahalting Program
of SCM+FSA, a being read-write Int-Location st I does not destroy a & s.intloc
  0 = 1 & s.a > 0 holds loop if=0(a,Goto  2,I ";" SubFrom(a,intloc 0))
  is_pseudo-closed_on s,P;

theorem 
  for s being State of SCM+FSA, I being good parahalting Program of
  SCM+FSA, a being read-write Int-Location st I does not destroy a & s.a > 0
  holds loop if=0(a,Goto  2,I ";" SubFrom(a,intloc 0))
  is_pseudo-closed_on Initialized s,P;

theorem 
  for s being State of SCM+FSA, I being good parahalting Program of
SCM+FSA, a being read-write Int-Location st I does not destroy a & s.intloc 0 =
  1 holds Times(a,I) is_closed_on s,P & Times(a,I) is_halting_on s,P;

theorem 
  for I being good parahalting Program of SCM+FSA, a being read-write
  Int-Location st I does not destroy a
   holds Initialize((intloc 0).-->1)  is Times(a,I)-halted;

theorem 
  for I,J being Program of SCM+FSA, a,c being Int-Location st I
does not destroy c & J does not destroy c holds if=0(a,I,J) does not destroy c
  & if>0(a,I,J) does not destroy c;

theorem 
  for s being State of SCM+FSA, I being good parahalting Program of SCM+FSA,
      a being read-write Int-Location
       st I does not destroy a & s.intloc 0 = 1 & s.a > 0
 ex s2 being State of SCM+FSA,
    P2 being  Instruction-Sequence of SCM+FSA,
    k being Element of NAT st
  s2 = s +* Start-At(0,SCM+FSA) &
  P2 = P +* (loop if=0(a,Goto  2, I ";" SubFrom(a,intloc 0))) &
  k = LifeSpan(P +* (if=0(a,Goto  2, I ";" SubFrom(a,intloc 0))),
  s +* Start-At(0,SCM+FSA)) + 1 &
  Comput(P2, s2,k).a = s.a - 1 &
  Comput(P2, s2,k).intloc 0 = 1 &
  (for b being read-write Int-Location st b <> a holds
   Comput(P2, s2,k).b = IExec(I,P,s).b) &
  (for f being FinSeq-Location holds Comput(P2, s2,k).f = IExec(I,P,s).f) &
    IC Comput(P2,s2,k) =  0 &
  for n being Element of NAT st n <= k
   holds IC Comput(P2, s2,n)
    in dom loop if=0(a,Goto  2,I ";" SubFrom(a,intloc 0));

theorem 
  for s being State of SCM+FSA, I being good parahalting Program
of SCM+FSA, a being read-write Int-Location st s.intloc 0 = 1 & s.a <= 0 holds
  DataPart IExec(Times(a,I),P,s) = DataPart s;

theorem 
  for s being State of SCM+FSA, I being good parahalting Program
  of SCM+FSA, a being read-write Int-Location st I does not destroy a & s.a > 0
holds IExec(I ";" SubFrom(a,intloc 0),P,s).a = s.a - 1 &
   DataPart IExec(Times(a,I),P,s)
    = DataPart IExec(Times(a,I),P,IExec(I ";" SubFrom(a,intloc 0),P,s));

begin 

theorem 
  for s being State of SCM+FSA, a,b,c being read-write Int-Location st a
<> b & a <> c & b <> c & s.a >= 0
 holds IExec(Times(a,Macro AddTo(b,c)),P,s).b =
  s.b + s.c * s.a;















begin 

reserve p,P,P1,P2 for Instruction-Sequence of SCM+FSA;

definition
  let i be Instruction of SCM+FSA;
  attr i is good means


  Macro i is good;
end;

registration
  let a be read-write Int-Location, b be Int-Location;
  cluster a := b -> good;
  cluster AddTo(a, b) -> good;
  cluster SubFrom(a, b) -> good;
  cluster MultBy(a, b) -> good;
end;

registration
  cluster good parahalting for Instruction of SCM+FSA;
end;

registration
  let a, b be read-write Int-Location;
  cluster Divide(a, b) -> good;
end;

registration
  let l be Element of NAT;
  cluster goto l -> good;
end;

registration
  let a be Int-Location, l be Element of NAT;
  cluster a =0_goto l -> good;
  cluster a >0_goto l -> good;
end;

registration
  let a be Int-Location, f be FinSeq-Location, b be read-write Int-Location;
  cluster b := (f,a) -> good;
end;

registration
  let f be FinSeq-Location, b be read-write Int-Location;
  cluster b :=len f -> good;
end;

registration
  let f be FinSeq-Location, a be Int-Location;
  cluster f :=<0,...,0> a -> good;
  let b be Int-Location;
  cluster (f,a) := b -> good;
end;

registration
  let i be good Instruction of SCM+FSA;
  cluster Macro i -> good;
end;

registration
  let i, j be good Instruction of SCM+FSA;
  cluster i ";" j -> good;
end;

registration
  let i be good Instruction of SCM+FSA, I be good Program of SCM+FSA;
  cluster i ";" I -> good;
  cluster I ";" i -> good;
end;

registration
  let a, b be read-write Int-Location;
  cluster swap(a, b) -> good;
end;

registration
  let I be good Program of SCM+FSA, a be read-write Int-Location;
  cluster Times(a, I) -> good;
end;

theorem 
  for a being Int-Location, I being Program of SCM+FSA st not a in
  UsedIntLoc I holds I does not destroy a;

begin 

reserve s, S for State of SCM+FSA,
  I, J for Program of SCM+FSA,
  Ig for good Program of SCM+FSA,
  i for good parahalting Instruction of SCM+FSA,
  j for parahalting Instruction of SCM+FSA,
  a, b for Int-Location,
  f for FinSeq-Location;


theorem 
  I is_halting_on Initialized S,P & I is_closed_on Initialized S,P &
  J is_closed_on IExec(I,P,S),P implies
  I ";" J is_closed_on Initialized S,P;

theorem 
  I is_halting_on Initialized S,P & J is_halting_on IExec(I,P,S),P & I
  is_closed_on Initialized S,P & J is_closed_on IExec(I,P,S),P implies
   I ";" J is_halting_on Initialized S,P;

theorem 
 for s being 0-started State of SCM+FSA
  st I is_closed_on s,p & I c= p & p halts_on s
 for m being Element of NAT st m <= LifeSpan(p,s) holds
   Comput(p, s,m) =  Comput(p+*(I ";" J),s,m);

theorem 
  Ig is_halting_on Initialized s,p & J is_halting_on IExec(Ig,p,s),p &
  Ig is_closed_on Initialized s,p & J is_closed_on IExec(Ig,p,s),p
 implies LifeSpan(p +* (Ig ";" J),Initialized s)
 = LifeSpan(p +* Ig,Initialized s) + 1 +
   LifeSpan(p +* Ig +* J,Initialized Result(p +* Ig,Initialized s));

theorem 
  Ig is_halting_on Initialized s,p & J is_halting_on IExec(Ig,p,s),p & Ig
is_closed_on Initialized s,p & J is_closed_on IExec(Ig,p,s),p
implies IExec(Ig ";" J,p,s) = IExec(J,p,IExec(Ig,p,s))+*
  Start-At(IC IExec(J,p,IExec(Ig,p,s))+card Ig,SCM+FSA);

theorem 
  (Ig is parahalting or Ig is_halting_on Initialized s,p & Ig
is_closed_on Initialized s,p) & (J is parahalting or
    J is_halting_on IExec(Ig,p,s),p
& J is_closed_on IExec(Ig,p,s),p) implies IExec(Ig ";" J,p,s).a
 = IExec(J,p,IExec(Ig,p,s)).a;

theorem 
  (Ig is parahalting or Ig is_halting_on Initialized s,p & Ig
is_closed_on Initialized s,p) & (J is parahalting or
 J is_halting_on IExec(Ig,p,s),p
& J is_closed_on IExec(Ig,p,s),p) implies IExec(Ig ";" J,p,s).f
 = IExec(J,p,IExec(Ig,p,s)).f;

theorem 
  (Ig is parahalting or Ig is_halting_on Initialized s,p & Ig is_closed_on
  Initialized s,p) & (J is parahalting or J is_halting_on IExec(Ig,p,s),p
   & J
is_closed_on IExec(Ig,p,s),p) implies DataPart IExec(Ig ";" J,p,s)
 = DataPart IExec
  (J,p,IExec(Ig,p,s));

theorem 
  Ig is parahalting or Ig is_closed_on Initialized s,p & Ig
is_halting_on Initialized s,p implies
DataPart Initialized IExec(Ig,p,s)
= DataPart IExec(Ig,p,s);

theorem 
  Ig is parahalting or Ig is_halting_on Initialized s,p & Ig
is_closed_on Initialized s,p implies IExec(Ig ";" j,p,s).a
= Exec(j, IExec(Ig,p,s)).a;

theorem 
  Ig is parahalting or Ig is_halting_on Initialized s,p & Ig
is_closed_on Initialized s,p implies IExec(Ig ";" j,p,s).f
= Exec(j, IExec(Ig,p,s)).f;

theorem 
  Ig is parahalting or Ig is_halting_on Initialized s,p & Ig is_closed_on
Initialized s,p implies DataPart IExec(Ig ";" j,p,s) =
DataPart Exec(j, IExec(Ig,p,s));

theorem 
  J is parahalting or J is_halting_on Exec(i, Initialized s),p & J
is_closed_on Exec(i, Initialized s),p implies IExec(i ";" J,p,s).a
= IExec(J,p,Exec(i,Initialized s)).a;

theorem 
  J is parahalting or J is_halting_on Exec(i, Initialized s),p & J
is_closed_on Exec(i, Initialized s),p implies IExec(i ";" J,p,s).f
= IExec(J,p,Exec(i,Initialized s)).f;

theorem 
  J is parahalting or J is_halting_on Exec(i, Initialized s),p & J
  is_closed_on Exec(i, Initialized s),p implies
  DataPart IExec(i ";" J,p,s) =
  DataPart IExec(J,p,Exec(i,Initialized s));

begin 

reserve L for finite Subset of Int-Locations,
  m, n for Element of NAT;

definition
 canceled 2;
  let n be Element of NAT, p be preProgram of SCM+FSA;
  func n-thNotUsed p -> Int-Location equals

  n-thRWNotIn UsedIntLoc p;
end;

notation
  let n be Element of NAT, p be preProgram of SCM+FSA;
  synonym n-stNotUsed p for n-thNotUsed p;
  synonym n-ndNotUsed p for n-thNotUsed p;
  synonym n-rdNotUsed p for n-thNotUsed p;
end;

registration
  let n be Element of NAT, p be preProgram of SCM+FSA;
  cluster n-thNotUsed p -> read-write;
end;

begin 

canceled 5;

theorem 
  a in UsedIntLoc swap(a, b) & b in UsedIntLoc swap(a, b);

definition
  let N, result be Int-Location;
  func Fib_macro (N, result) -> Program of SCM+FSA equals

  2-ndRWNotIn
  UsedIntLoc swap(result, 1-stRWNotIn {N, result}) := N ";" (SubFrom(result,
result)) ";" (1-stRWNotIn {N, result} := intloc 0) ";" ((1-stRWNotIn UsedIntLoc
swap(result, 1-stRWNotIn {N, result})) := (2-ndRWNotIn UsedIntLoc swap(result,
  1-stRWNotIn {N, result}))) ";" Times(1-stRWNotIn UsedIntLoc swap(result, 1
-stRWNotIn {N, result}), AddTo(result, 1-stRWNotIn {N, result}) ";" swap(result
  , 1-stRWNotIn {N, result}) ) ";" (N := (2-ndRWNotIn UsedIntLoc swap(result, 1
  -stRWNotIn {N, result})));
end;










theorem 
  for N, result being read-write Int-Location st N <> result for n being
Element of NAT
 st n = s.N holds IExec(Fib_macro(N, result),p,s).result = Fib n &
  IExec(Fib_macro(N, result),p,s).N = s.N;















begin 

reserve p,p1,p2,h for Instruction-Sequence of SCM+FSA;

reserve k, l, n for Element of NAT,
  j for Integer,
  i for Instruction of SCM+FSA;

theorem 
  UsedIntLoc (l .--> i) = UsedIntLoc i;

theorem 
  UsedInt*Loc (l .--> i) = UsedInt*Loc i;

theorem 
  UsedIntLoc Stop SCM+FSA = {};

theorem 
  UsedInt*Loc Stop SCM+FSA = {};

theorem 
  UsedIntLoc Goto l = {};

theorem 
  UsedInt*Loc Goto l = {};

reserve s, s1, s2 for State of SCM+FSA,
  a for read-write Int-Location,
  b for Int-Location,
  I, J for Program of SCM+FSA,
  Ig for good Program of SCM+FSA,
  i, j, k, m, n for Element of NAT;

theorem 
  UsedIntLoc if=0(b, I, J) = {b} \/ UsedIntLoc I \/ UsedIntLoc J;

theorem 
  for a being Int-Location holds UsedInt*Loc if=0(a, I, J) =
  UsedInt*Loc I \/ UsedInt*Loc J;

theorem 
  UsedIntLoc if>0(b, I, J) = {b} \/ UsedIntLoc I \/ UsedIntLoc J;

theorem 
  UsedInt*Loc if>0(b, I, J) = UsedInt*Loc I \/ UsedInt*Loc J;

begin

theorem 
  UsedIntLoc while=0(b, I) = {b} \/ UsedIntLoc I;

theorem 
  UsedInt*Loc while=0(b, I) = UsedInt*Loc I;

definition let p;
  let s be State of SCM+FSA, a be read-write Int-Location, I be Program of
  SCM+FSA;
  pred ProperBodyWhile=0 a, I, s, p means


  for k being Element of NAT st StepWhile=0(a,I,p,s).k.a = 0 holds
   I is_closed_on StepWhile=0(a,I,p,s).k, p+*while=0(a,I) &
   I is_halting_on StepWhile=0(a,I,p,s).k, p+*while=0(a,I);
  pred WithVariantWhile=0 a, I, s, p means


  ex f being Function of product the_Values_of SCM+FSA, NAT
   st for k being Element of NAT
    holds f.(StepWhile=0(a,I,p,s).(k+1)) < f.(StepWhile=0(a,I,p,s).k)
      or StepWhile=0(a,I,p,s).k.a <> 0;
end;

theorem 
  for I being parahalting Program of SCM+FSA holds
  ProperBodyWhile=0 a,I,s,p;

theorem 
  ProperBodyWhile=0 a,I,s,p & WithVariantWhile=0 a,I,s,p implies
  while=0(a,I) is_halting_on s,p & while=0(a,I) is_closed_on s,p;

theorem 
  for I being parahalting Program of SCM+FSA
   st WithVariantWhile=0 a, I, s, p
    holds while=0(a,I) is_halting_on s,p & while=0(a,I) is_closed_on s,p;

theorem 
  for s being 0-started State of SCM+FSA
   st while=0(a, I) c= p & s.a <> 0
  holds LifeSpan(p,s) = 4 & for k being Element of NAT
   holds DataPart Comput(p,s,k) = DataPart s;

theorem 
  I is_closed_on s,p & I is_halting_on s,p & s.a = 0 implies DataPart
  Comput(p +* while=0(a,I),(Initialize s),
  (LifeSpan(p+* I,Initialize s) + 3)) =
DataPart Comput(p +* I,
   (Initialize s), (LifeSpan(p+* I,Initialize s)));

theorem 
  (StepWhile=0(a,I,p,s).k).a <> 0 implies
   DataPart StepWhile=0(a,I,p,s).(k+1) = DataPart StepWhile=0(a,I,p,s).k;

theorem 
  ( I is_halting_on Initialized StepWhile=0(a,I,p,s).k ,p+*while=0(a,I) & I
  is_closed_on Initialized StepWhile=0(a,I,p,s).k ,p+*while=0(a,I) or
    I is parahalting) & (
  StepWhile=0(a,I,p,s).k).a = 0 & (StepWhile=0(a,I,p,s).k).intloc 0 = 1 implies
DataPart StepWhile=0(a,I,p,s).(k+1) =
 DataPart IExec(I,p+*while=0(a,I),StepWhile=0(a,I,p,s).k);

theorem 
  (ProperBodyWhile=0 a,Ig,s,p or Ig is parahalting) & s.intloc 0 = 1
  implies for k holds StepWhile=0(a,Ig,p,s).k.intloc 0 = 1;

theorem 
  ProperBodyWhile=0 a,I,s1,p1 & DataPart s1 = DataPart s2 implies for k
  holds DataPart StepWhile=0(a,I,p1,s1).k = DataPart StepWhile=0(a,I,p2,s2).k;

definition let p;
  let s be State of SCM+FSA, a be read-write Int-Location,
      I be Program of SCM+FSA;
  assume that
 ProperBodyWhile=0 a,I,s,p or I is parahalting and
 WithVariantWhile=0 a,I,s,p;
  func ExitsAtWhile=0(a, I, p, s) -> Element of NAT means


  ex k being Element of NAT
   st it = k & (StepWhile=0(a,I,p,s).k).a <> 0 &
    (for i being Element of NAT
     st (StepWhile=0(a,I,p,s).i).a <> 0 holds k <= i) &
    DataPart Comput(p +* while=0(a, I),
      Initialize s,
       (LifeSpan(p +* while=0(a, I),
       Initialize s)))
     = DataPart StepWhile=0(a,I,p,s).k;
end;

theorem 
  s.intloc 0 = 1 & s.a <> 0 implies DataPart IExec(while=0(a,I),p,s) =
  DataPart s;

theorem 
  (ProperBodyWhile=0 a,I,Initialized s,p or I is parahalting) &
WithVariantWhile=0 a,I,Initialized s,p
 implies
  DataPart IExec(while=0(a,I),p,s)
  = DataPart
   StepWhile=0(a,I,p,Initialized s).ExitsAtWhile=0(a,I,p,Initialized s);

begin

theorem 
  UsedIntLoc while>0(b, I) = {b} \/ UsedIntLoc I;

theorem 
  UsedInt*Loc while>0(b, I) = UsedInt*Loc I;

definition let p;
  let s be State of SCM+FSA, a be read-write Int-Location, I be Program of
  SCM+FSA;
  pred ProperBodyWhile>0 a,I,s,p means


  for k being Element of NAT st StepWhile>0(a,I,p,s).k.a > 0
   holds I is_closed_on StepWhile>0(a,I,p,s).k, p+*while>0(a,I) &
   I is_halting_on StepWhile>0(a,I,p,s).k, p+*while>0(a,I);
  pred WithVariantWhile>0 a,I,s,p means


  ex f being Function of product the_Values_of SCM+FSA, NAT
   st for k being Element of NAT holds ( f.(
   StepWhile>0(a,I,p,s).(k+1)) < f.(StepWhile>0(a,I,p,s).k) or
   StepWhile>0(a,I,p,s).k.a <= 0 );
end;

theorem 
  for I being parahalting Program of SCM+FSA holds
  ProperBodyWhile>0 a,I,s,p;

theorem 
  ProperBodyWhile>0 a,I,s,p & WithVariantWhile>0 a,I,s,p implies
  while>0(a,I) is_halting_on s,p & while>0(a,I) is_closed_on s,p;

theorem 
  for I being parahalting Program of SCM+FSA
   st WithVariantWhile>0 a, I, s, p
    holds while>0(a,I) is_halting_on s,p & while>0(a,I) is_closed_on s,p;

theorem 
  for s being 0-started State of SCM+FSA
   st while>0(a, I) c= p & s.a <= 0
  holds LifeSpan(p,s) = 4 & for k being Element of NAT
   holds DataPart Comput(p,s,k) = DataPart s;

theorem 
  I is_closed_on s,p & I is_halting_on s,p & s.a > 0 implies DataPart
  Comput(p +* while>0(a,I),Initialize s,LifeSpan(p +* I,Initialize s) + 3)
     = DataPart Comput(p +* I,Initialize s,LifeSpan(p +* I,Initialize s));

theorem 
  (StepWhile>0(a,I,p,s).k).a <= 0 implies
   DataPart StepWhile>0(a,I,p,s).(k+1) = DataPart StepWhile>0(a,I,p,s).k;

theorem 
  ( I is_halting_on Initialized StepWhile>0(a,I,p,s).k ,p+*while>0(a,I) & I
  is_closed_on Initialized StepWhile>0(a,I,p,s).k ,p+*while>0(a,I) or
  I is parahalting) & (
  StepWhile>0(a,I,p,s).k).a > 0 & (StepWhile>0(a,I,p,s).k).intloc 0 = 1 implies
DataPart StepWhile>0(a,I,p,s).(k+1)
 = DataPart IExec(I,p+*while>0(a,I),StepWhile>0(a,I,p,s).k);

theorem 
  (ProperBodyWhile>0 a,Ig,s,p or Ig is parahalting) & s.intloc 0 =
  1 implies for k holds StepWhile>0(a,Ig,p,s).k.intloc 0 = 1;

theorem 
  ProperBodyWhile>0 a,I,s1,p1 & DataPart s1 = DataPart s2 implies
for k holds DataPart StepWhile>0(a,I,p1,s1).k
 = DataPart StepWhile>0(a,I,p2,s2).k;

definition let p;
  let s be State of SCM+FSA, a be read-write Int-Location, I be Program of
  SCM+FSA;
  assume that
 ProperBodyWhile>0 a,I,s,p or I is parahalting and
 WithVariantWhile>0 a,I,s,p;
  func ExitsAtWhile>0(a, I, p, s) -> Element of NAT means


  ex k being Element of NAT st it = k &
    (StepWhile>0(a,I,p,s).k).a <= 0 &
    (for i being Element of NAT st (StepWhile>0(a,I,p,s).i).a <= 0
     holds k <= i) &
    DataPart Comput(p +* while>0(a, I),
        Initialize s,
       (LifeSpan(p +* while>0(a, I),
        Initialize s)))
     = DataPart StepWhile>0(a,I,p,s).k;
end;

theorem 
  s.intloc 0 = 1 & s.a <= 0 implies DataPart IExec(while>0(a,I),p,s) =
  DataPart s;

theorem 
  (ProperBodyWhile>0 a,I,Initialized s,p or I is parahalting) &
WithVariantWhile>0 a,I,Initialized s,p implies DataPart IExec(while>0(a,I),p,s)
  = DataPart
  StepWhile>0(a,I,p,Initialized s).ExitsAtWhile>0(a,I,p,Initialized s);

theorem 
  StepWhile>0(a,I,p,s).k.a <= 0 implies for n being Element of NAT
     st k <= n
    holds DataPart StepWhile>0(a,I,p,s).n = DataPart StepWhile>0(a,I,p,s).k;

theorem 
  DataPart s1 = DataPart s2 & ProperBodyWhile>0 a,I,s1,p1 implies
  ProperBodyWhile>0 a,I,s2,p2;

theorem 
  s.intloc 0 = 1 & ProperBodyWhile>0 a,Ig,s,p &
   WithVariantWhile>0 a, Ig, s, p
    implies for i, j st i <> j & i <= ExitsAtWhile>0(a,Ig,p,s) & j <=
ExitsAtWhile>0(a,Ig,p,s) holds StepWhile>0(a,Ig,p,s).i <> StepWhile>0(a,Ig,p,s)
  .j & DataPart StepWhile>0(a,Ig,p,s).i <> DataPart StepWhile>0(a,Ig,p,s).j;

definition
 canceled;
end;

theorem 
  s.intloc 0 = 1 & ProperBodyWhile>0 a,Ig,s,p &
   WithVariantWhile>0 a, Ig, s, p
    implies ex f being Function of product the_Values_of SCM+FSA, NAT
st f is on_data_only & for k being Element of NAT
 holds f.(StepWhile>0(a,Ig,p,s).(k+1)) < f.(StepWhile>0(a,Ig,p,s).k) or
 StepWhile>0(a,Ig,p,s).k.a <= 0;

theorem 
  s1.intloc 0 = 1 & DataPart s1 = DataPart s2 &
   ProperBodyWhile>0 a,Ig,s1,p1 & WithVariantWhile>0 a,Ig,s1,p1
    implies WithVariantWhile>0 a,Ig,s2,p2;

begin 

definition
  let N, result be Int-Location;
  func Fusc_macro ( N, result ) -> Program of SCM+FSA equals

  SubFrom(result,
  result) ";" ((1-stRWNotIn {N, result}) := intloc 0) ";" ((2-ndRWNotIn {N,
result}) := N) ";" while>0 ( 2-ndRWNotIn {N, result}, (3-rdRWNotIn {N, result})
:= 2 ";" Divide(2-ndRWNotIn {N, result}, 3-rdRWNotIn {N, result}) ";" if=0 ( 3
  -rdRWNotIn {N, result}, Macro AddTo(1-stRWNotIn {N, result}, result), Macro
  AddTo(result, 1-stRWNotIn {N, result}) ) );
end;





theorem 
  for N, result being read-write Int-Location st N <> result for n being
Element of NAT st n = s.N
 holds IExec(Fusc_macro(N,result),p,s).result = Fusc n
  & IExec(Fusc_macro(N,result),p,s).N = n;















begin 

reserve s, s1, s2 for State of SCM+FSA,
  p, p1 for Instruction-Sequence of SCM+FSA,
  a, b for Int-Location,
  d for read-write Int-Location,
  f for FinSeq-Location,
  I for Program of SCM+FSA,
  J for good Program of SCM+FSA,
  k, m for Element of NAT;

theorem 
  I is_closed_on Initialized s,p & I is_halting_on Initialized s,p & not
  b in UsedIntLoc I implies IExec(I,p,s).b = (Initialized s).b;

theorem 
  I is_closed_on Initialized s,p & I is_halting_on Initialized s,p & not f in
  UsedInt*Loc I implies IExec(I,p,s).f = (Initialized s).f;

theorem 
  ( I is_closed_on Initialized s,p & I is_halting_on Initialized s,p or I
is parahalting ) & (s.intloc 0 = 1 or a is read-write) & not a in UsedIntLoc I
  implies IExec(I,p,s).a = s.a;

theorem 
  s.intloc 0 = 1 implies (I is_closed_on s,p iff I is_closed_on
  Initialized s,p);

theorem 
  s.intloc 0 = 1 implies ( I is_closed_on s,p & I is_halting_on s,p iff
  I is_closed_on Initialized s,p & I is_halting_on Initialized s,p);

begin 

definition
  let a be Int-Location, I be Program of SCM+FSA;
  func times*(a, I) -> Program of SCM+FSA equals

  while>0 ( 1-stRWNotIn ({a} \/ UsedIntLoc I),
      I ";" SubFrom(1-stRWNotIn ({a} \/ UsedIntLoc I), intloc 0) );
end;

definition
  let a be Int-Location, I be Program of SCM+FSA;
  func times(a, I) -> Program of SCM+FSA equals

  (1-stRWNotIn ({a} \/ UsedIntLoc I)) := a ";" times*(a, I);
end;

notation
  let a be Int-Location, I be Program of SCM+FSA;
  synonym a times I for times(a, I);
end;

canceled 2;

theorem 
  {b} \/ UsedIntLoc I c= UsedIntLoc times(b, I);

theorem 
  UsedInt*Loc times(b, I) = UsedInt*Loc I;

registration
  let I be good Program of SCM+FSA, a be Int-Location;
  cluster times(a, I) -> good;
end;

definition let p;
  let s be State of SCM+FSA, I be Program of SCM+FSA, a be Int-Location;
  func StepTimes(a, I, p, s) ->
   Function of NAT, product the_Values_of SCM+FSA equals

  StepWhile>0(1-stRWNotIn ({a} \/ UsedIntLoc I),
    I ";" SubFrom(1-stRWNotIn ({a} \/ UsedIntLoc I), intloc 0), p,
  Exec(1-stRWNotIn ({a} \/ UsedIntLoc I) := a, Initialized s));
end;

theorem 
  StepTimes(a,J,p,s).0.intloc 0 = 1;

theorem 
  s.intloc 0 = 1 or a is read-write implies StepTimes(a,J,p,s).0.(
  1-stRWNotIn ({a} \/ UsedIntLoc J)) = s.a;

theorem 
  StepTimes(a,J,p,s).k.intloc 0 = 1 &
  J is_closed_on StepTimes(a,J,p,s).k, p+*times*(a,J) &
  J is_halting_on StepTimes(a,J,p,s).k, p+*times*(a,J) implies
   StepTimes(a,J,p,s).(k+1).intloc 0 = 1 &
  (StepTimes(a,J,p,s).k.(1-stRWNotIn ({a} \/ UsedIntLoc J)) > 0
  implies StepTimes(a,J,p,s).(k+1).(1-stRWNotIn ({a} \/ UsedIntLoc J)) =
  StepTimes(a,J,p,s).k.(1-stRWNotIn ({a} \/ UsedIntLoc J)) - 1);

theorem 
  s.intloc 0 = 1 or a is read-write implies StepTimes(a,I,p,s).0.a
  = s.a;

theorem 
  StepTimes(a,I,p,s).0.f = s.f;

definition let p;
  let s be State of SCM+FSA, a be Int-Location, I be Program of SCM+FSA;
  pred ProperTimesBody a, I, s, p means


  for k being Element of NAT st k < s.a
   holds I is_closed_on StepTimes(a,I,p,s).k,p+*times*(a,I) &
    I is_halting_on StepTimes(a,I,p,s).k,p+*times*(a,I);
end;

theorem 
  I is parahalting implies ProperTimesBody a,I,s,p;

theorem 
  ProperTimesBody a,J,s,p implies for k st k <= s.a holds
  StepTimes(a,J,p,s).k.intloc 0 = 1;

theorem 
  (s.intloc 0 = 1 or a is read-write) & ProperTimesBody a,J,s,p
  implies for k st k <= s.a holds StepTimes(a,J,p,s).k.(1-stRWNotIn({a} \/
  UsedIntLoc J))+k = s.a;

theorem 
  ProperTimesBody a,J,s,p & 0 <= s.a & (s.intloc 0 = 1 or a is
read-write) implies for k st k >= s.a holds StepTimes(a,J,p,s).k.(1-stRWNotIn({
  a} \/ UsedIntLoc J)) = 0 & StepTimes(a,J,p,s).k.intloc 0 = 1;

theorem 
  s.intloc 0 = 1 implies StepTimes(a,I,p,s).0 | ((UsedIntLoc I) \/
  FinSeq-Locations) = s | ((UsedIntLoc I) \/ FinSeq-Locations);

theorem 
  StepTimes(a,J,p,s).k.intloc 0 = 1 &
  J is_halting_on Initialized StepTimes(a,J,p,s).k,p+*times*(a,J) &
  J is_closed_on Initialized StepTimes(a,J,p,s).k,p+*times*(a,J) &
StepTimes(a,J,p,s).k.(1-stRWNotIn ({a} \/ UsedIntLoc J)) > 0
 implies StepTimes(a,J,p,s).(k+1) | ((UsedIntLoc J) \/ FinSeq-Locations)
  = IExec(J,p+*times*(a,J),StepTimes(a,J,p,s).k)
       | ((UsedIntLoc J) \/ FinSeq-Locations);

theorem 
  (ProperTimesBody a,J,s,p or J is parahalting) & k < s.a & (s.
  intloc 0 = 1 or a is read-write) implies StepTimes(a,J,p,s).(k+1) | ((
  UsedIntLoc J) \/ FinSeq-Locations)
   = IExec(J,p+*times*(a,J),StepTimes(a,J,p,s).k) | ((
  UsedIntLoc J) \/ FinSeq-Locations);



theorem 
  s.a <= 0 & s.intloc 0 = 1 implies IExec(times(a, I),p,s) | ((UsedIntLoc
  I) \/ FinSeq-Locations) = s | ((UsedIntLoc I) \/ FinSeq-Locations);

theorem 
  s.a = k & (ProperTimesBody a,J,s,p or J is parahalting) & (s.
  intloc 0 = 1 or a is read-write) implies
   DataPart IExec(times(a,J),p,s) =
  DataPart StepTimes(a,J,p,s).k;

theorem 
  s.intloc 0 = 1 & (ProperTimesBody a,J,s,p or J is parahalting)
  implies times(a, J) is_closed_on s,p & times(a, J) is_halting_on s,p;

begin  

definition
  let d be read-write Int-Location;
  func triv-times(d) -> Program of SCM+FSA equals

  times( d, while=0(d, Macro(d:= d)) ";" SubFrom(d, intloc 0) );
end;

theorem 
  s.d <= 0 implies IExec(triv-times(d),p,s).d = s.d;

theorem 
  0 <= s.d implies IExec(triv-times(d),p,s).d = 0;

begin  

definition
  let N, result be Int-Location;
  func Fib-macro (N, result) -> Program of SCM+FSA equals

  (1-stNotUsed times(N
  , AddTo(result, (1-stRWNotIn {N, result}))";" swap(result, 1-stRWNotIn {N,
result}))) := N ";" (SubFrom(result, result)) ";" ((1-stRWNotIn {N, result}) :=
intloc 0) ";" times(N, AddTo(result, (1-stRWNotIn {N, result})) ";" swap(result
, (1-stRWNotIn {N, result})) ) ";" (N := (1-stNotUsed times(N, AddTo(result, 1
  -stRWNotIn {N, result})";" swap(result, 1-stRWNotIn {N, result}))));
end;

theorem 
  for N, result being read-write Int-Location st N <> result for n being
Element of NAT st n = s.N holds IExec(Fib-macro(N,result),p,s).result = Fib n &
  IExec(Fib-macro(N,result),p,s).N = s.N;















begin 

reserve s for State of SCM+FSA,
  a, c for read-write Int-Location,
  aa, bb, cc,
  dd, x for Int-Location,
  f for FinSeq-Location,
  I, J for Program of SCM+FSA,
  Ig for good Program of SCM+FSA,
  i, k for Element of NAT,
  p for Instruction-Sequence of SCM+FSA;



theorem 
  I is_closed_on Initialized s,p & I is_halting_on Initialized s,p & I
  does not destroy aa implies IExec(I,p,s).aa = (Initialized s).aa;

theorem 
  s.intloc 0 = 1 implies DataPart IExec(Stop SCM+FSA,p,s) = DataPart s;

theorem 
  Stop SCM+FSA does not refer aa;

theorem 
  aa <> bb implies cc := bb does not refer aa;

theorem 
  Exec(a := (f, bb), s).a = (s.f)/.abs(s.bb);

theorem 
  Exec((f, aa) := bb, s).f = s.f+*(abs(s.aa), s.bb);

registration
  let a be read-write Int-Location, b be Int-Location, I, J be good Program of
  SCM+FSA;
  cluster if>0(a, b, I, J) -> good;
end;

theorem 
  UsedIntLoc if>0(aa, bb, I, J) = {aa, bb} \/ (UsedIntLoc I) \/
  UsedIntLoc J;

theorem 
  I does not destroy aa implies while>0(bb, I) does not destroy aa;

theorem 
  cc <> aa & I does not destroy cc & J does not destroy cc implies
  if>0(aa, bb, I, J) does not destroy cc;

begin 

definition  let p;
  let a, b, c be Int-Location, I be Program of SCM+FSA, s be State of SCM+FSA;

  func StepForUp(a, b, c, I, p,s) ->
   Function of NAT, product the_Values_of
  SCM+FSA equals

  StepWhile>0(1-stRWNotIn ({a, b, c} \/ UsedIntLoc I),
     I ";" AddTo(a, intloc 0) ";"
      SubFrom(1-stRWNotIn ({a, b, c} \/ UsedIntLoc I), intloc 0), p,
    s+*(1-stRWNotIn ({a, b, c} \/ UsedIntLoc I), s.c-s.b+1)+*(a, s.b));
end;

theorem 
  s.intloc 0 = 1 implies StepForUp(a,bb,cc,I,p,s).0.intloc 0 = 1;

theorem 
  StepForUp(a,bb,cc,I,p,s).0.a = s.bb;

theorem 
  a <> bb implies StepForUp(a,bb,cc,I,p,s).0.bb = s.bb;

theorem 
  a <> cc implies StepForUp(a,bb,cc,I,p,s).0.cc = s.cc;

theorem 
  a <> dd & dd in UsedIntLoc I implies StepForUp(a,bb,cc,I,p,s).
  0.dd = s.dd;

theorem 
  StepForUp(a,bb,cc,I,p,s).0.f = s.f;

theorem 
  s.intloc 0 = 1 implies for aux being read-write Int-Location st
aux = 1-stRWNotIn ({a, bb, cc} \/ UsedIntLoc I)
 holds DataPart IExec( aux := cc
";" SubFrom(aux, bb) ";" AddTo(aux, intloc 0) ";" (a := bb),p,s)
 = DataPart(s+*(aux, s.cc-s.bb+1)+*(a, s.bb));

definition let p;
  let a, b, c be Int-Location, I be Program of SCM+FSA, s be State of SCM+FSA;
  pred ProperForUpBody a, b, c, I, s, p means


  for i being Element of NAT
  st i < s.c-s.b+1 holds
  I is_closed_on StepForUp(a, b, c, I,p,s).i,
   p +* while>0(1-stRWNotIn ({a, b, c} \/ UsedIntLoc I),
     I ";" AddTo(a, intloc 0) ";"
      SubFrom(1-stRWNotIn ({a, b, c} \/ UsedIntLoc I), intloc 0)) &
  I is_halting_on StepForUp(a, b, c, I,p,s).i,
   p +* while>0(1-stRWNotIn ({a, b, c} \/ UsedIntLoc I),
     I ";" AddTo(a, intloc 0) ";"
      SubFrom(1-stRWNotIn ({a, b, c} \/ UsedIntLoc I), intloc 0));
end;

theorem 
  for I being parahalting Program of SCM+FSA holds ProperForUpBody
  aa, bb, cc, I, s, p;

theorem 
  StepForUp(a,bb,cc,Ig,p,s).k.intloc 0 = 1 &
  Ig is_closed_on StepForUp(a,bb,cc,Ig,p,s).k,
   p +* while>0(1-stRWNotIn ({a, bb, cc} \/ UsedIntLoc Ig),
     Ig ";" AddTo(a, intloc 0) ";"
      SubFrom(1-stRWNotIn ({a, bb, cc} \/ UsedIntLoc Ig), intloc 0)) &
  Ig is_halting_on StepForUp(a,bb,cc,Ig,p,s).k,
   p +* while>0(1-stRWNotIn ({a, bb, cc} \/ UsedIntLoc Ig),
     Ig ";" AddTo(a, intloc 0) ";"
      SubFrom(1-stRWNotIn ({a, bb, cc} \/ UsedIntLoc Ig), intloc 0))
  implies StepForUp(a,bb,cc,Ig,p,s).(k+1).intloc 0 = 1;

theorem 
  s.intloc 0 = 1 & ProperForUpBody a,bb,cc,Ig,s,p implies for k
  st k <= s.cc-s.bb+1 holds StepForUp(a,bb,cc,Ig,p,s).k.intloc 0 = 1 & (Ig
does not destroy a implies StepForUp(a,bb,cc,Ig,p,s).k.a = k+s.bb &
 StepForUp(a, bb, cc, Ig,p, s).k.a <= s.cc+1) &
 StepForUp(a,bb,cc,Ig,p,s).k.(1-stRWNotIn
  ({a, bb, cc} \/ UsedIntLoc Ig)) + k = s.cc-s.bb+1;

theorem 
  s.intloc 0 = 1 & ProperForUpBody a,bb,cc,Ig,s,p implies for k
holds StepForUp(a,bb,cc,Ig,p,s).k.(1-stRWNotIn({a, bb, cc} \/ UsedIntLoc Ig))
  > 0 iff k < s.cc-s.bb+1;

theorem 
  s.intloc 0 = 1 & ProperForUpBody a,bb,cc,Ig,s,p & k < s.cc-s.
bb+1 implies
  StepForUp(a,bb,cc,Ig,p,s).(k+1) |
    ({a, bb, cc} \/ UsedIntLoc Ig \/ FinSeq-Locations)
 = IExec(Ig ";" AddTo(a, intloc 0),
   p +* while>0(1-stRWNotIn ({a, bb, cc} \/ UsedIntLoc Ig),
     Ig ";" AddTo(a, intloc 0) ";"
      SubFrom(1-stRWNotIn ({a, bb, cc} \/ UsedIntLoc Ig), intloc 0)),
   StepForUp(a, bb, cc, Ig, p, s).k) |
     ({a, bb, cc} \/ UsedIntLoc Ig \/ FinSeq-Locations);

definition
  let a, b, c be Int-Location, I be Program of SCM+FSA;
  func for-up(a, b, c, I) -> Program of SCM+FSA equals

  (1-stRWNotIn ({a, b, c}
\/ UsedIntLoc I)) := c ";" SubFrom(1-stRWNotIn ({a, b, c} \/ UsedIntLoc I), b)
  ";" AddTo(1-stRWNotIn ({a, b, c} \/ UsedIntLoc I), intloc 0) ";" (a := b) ";"
while>0( 1-stRWNotIn ({a, b, c} \/ UsedIntLoc I), I ";" AddTo(a, intloc 0) ";"
  SubFrom(1-stRWNotIn ({a, b, c} \/ UsedIntLoc I), intloc 0) );
end;

theorem 
  {aa, bb, cc} \/ UsedIntLoc I c= UsedIntLoc for-up(aa, bb, cc, I);

registration
  let a be read-write Int-Location, b, c be Int-Location, I be good Program of
  SCM+FSA;
  cluster for-up(a, b, c, I) -> good;
end;

theorem 
  a <> aa & aa <> 1-stRWNotIn ({a, bb, cc} \/ UsedIntLoc I) & I
  does not destroy aa implies for-up(a, bb, cc, I) does not destroy aa;

theorem 
  s.intloc 0 = 1 & s.bb > s.cc implies (for x st x <> a & x in {bb
  , cc} \/ UsedIntLoc I holds IExec(for-up(a, bb, cc, I),p,s).x = s.x) &
  for f
  holds IExec(for-up(a, bb, cc, I),p,s).f = s.f;

theorem 
  s.intloc 0 = 1 & k = s.cc-s.bb+1 & (ProperForUpBody a, bb, cc,
Ig, s,p or Ig is parahalting)
 implies DataPart IExec(for-up(a, bb, cc, Ig),p, s) =
  DataPart StepForUp(a,bb,cc,Ig,p,s).k;

theorem 
  s.intloc 0 = 1 & (ProperForUpBody a,bb,cc,Ig,s,p or Ig is
  parahalting) implies
   for-up(a, bb, cc, Ig) is_closed_on s,p &
   for-up(a, bb, cc, Ig) is_halting_on s,p;

begin 

definition
  let start, finish, minpos be Int-Location, f be FinSeq-Location;
  func FinSeqMin(f, start, finish, minpos) -> Program of SCM+FSA equals

  minpos
  := start ";" for-up ( 3-rdRWNotIn {start, finish, minpos}, start, finish, (1
-stRWNotIn {start, finish, minpos}) := (f, 3-rdRWNotIn {start, finish, minpos})
  ";" ((2-ndRWNotIn {start, finish, minpos}) := (f, minpos)) ";" if>0((2
  -ndRWNotIn {start, finish, minpos}), (1-stRWNotIn {start, finish, minpos}),
  Macro (minpos := (3-rdRWNotIn {start, finish, minpos})), Stop SCM+FSA) );
end;




registration
  let start, finish be Int-Location, minpos be read-write Int-Location, f be
  FinSeq-Location;
  cluster FinSeqMin(f, start, finish, minpos) -> good;
end;

theorem 
  c <> aa implies FinSeqMin(f, aa, bb, c) does not destroy aa;

theorem 
  {aa, bb, c} c= UsedIntLoc FinSeqMin(f, aa, bb, c);

theorem 
  s.intloc 0 = 1 implies FinSeqMin(f, aa, bb, c) is_closed_on s,p &
  FinSeqMin(f, aa, bb, c) is_halting_on s,p;

theorem 
  aa <> c & bb <> c & s.intloc 0 = 1 implies
   IExec(FinSeqMin(f, aa, bb, c),p, s).f = s.f &
   IExec(FinSeqMin(f, aa, bb, c),p, s).aa = s.aa &
   IExec(FinSeqMin(f, aa, bb, c),p, s).bb = s.bb;

theorem 
  1 <= s.aa & s.aa <= s.bb & s.bb <= len (s.f) & aa <> c & bb <> c
& s.intloc 0 = 1 implies IExec(FinSeqMin(f, aa, bb, c),p,s).c
 = min_at(s.f, abs(s.aa), abs(s.bb));

begin  

definition
  let f be FinSeq-Location, a, b be Int-Location;
  func swap(f, a, b) -> Program of SCM+FSA equals

  1-stRWNotIn {a, b} := (f,a)
";" (2-ndRWNotIn {a, b} := (f,b)) ";" ((f,a) := (2-ndRWNotIn {a, b})) ";" ((f,b
  ) := (1-stRWNotIn {a, b}));
end;

registration
  let f be FinSeq-Location, a, b be Int-Location;
  cluster swap(f, a, b) -> good parahalting;
end;

theorem 
  cc <> 1-stRWNotIn {aa, bb} & cc <> 2-ndRWNotIn {aa, bb} implies
  swap(f, aa, bb) does not destroy cc;

theorem 
  1 <= s.aa & s.aa <= len (s.f) & 1 <= s.bb & s.bb <= len (s.f) &
s.intloc 0 = 1
 implies IExec(swap(f,aa,bb),p,s).f = s.f+*(s.aa, s.f.(s.bb))+*(
  s.bb, s.f.(s.aa));

theorem 
  1 <= s.aa & s.aa <= len (s.f) & 1 <= s.bb & s.bb <= len (s.f) & s.
  intloc 0 = 1 implies IExec(swap(f,aa,bb),p,s).f.(s.aa) = s.f.(s.bb) &
  IExec(swap(f,aa,bb),p,s).f.(s.bb) = s.f.(s.aa);

theorem 
  {aa, bb} c= UsedIntLoc swap(f, aa, bb);

theorem 
  UsedInt*Loc swap(f, aa, bb) = {f};

begin  

definition
  let f be FinSeq-Location;
  func Selection-sort f -> Program of SCM+FSA equals

  (1-stNotUsed swap(f, 1
-stRWNotIn {} Int-Locations, 2-ndRWNotIn {} Int-Locations)) :=len f ";" for-up
  ( 1-stRWNotIn {} Int-Locations, intloc 0, (1-stNotUsed swap(f, 1-stRWNotIn {}
  Int-Locations, 2-ndRWNotIn {} Int-Locations)), FinSeqMin(f, 1-stRWNotIn {}
  Int-Locations, (1-stNotUsed swap(f, 1-stRWNotIn {} Int-Locations, 2-ndRWNotIn
  {} Int-Locations)), 2-ndRWNotIn {} Int-Locations) ";" swap(f, 1-stRWNotIn {}
  Int-Locations, 2-ndRWNotIn {} Int-Locations) );
end;

theorem 
  for S being State of SCM+FSA st S = IExec(Selection-sort f,p,s)
   holds S.f is_non_decreasing_on 1, len (S.f) &
   ex p being Permutation of dom(s.f) st S.f = (s.f) * p;

















begin

reserve m,n for Element of NAT,
  I for Program of SCM+FSA,
  s,s1,s2 for State of SCM+FSA,
  a for Int-Location,
  f for FinSeq-Location,
  p,p1,p2 for Instruction-Sequence of SCM+FSA;

definition
  let I be Program of SCM+FSA;
  attr I is InitClosed means


  for s being State of SCM+FSA,
      P being Instruction-Sequence of SCM+FSA
       st I c= P
   for n being Element of NAT st Initialize ((intloc 0) .--> 1) c= s
   holds IC Comput(P,s,n) in dom I;
  attr I is InitHalting means


  for s being State of SCM+FSA st Initialize ((intloc 0) .--> 1) c= s
  for P being Instruction-Sequence of SCM+FSA
   st I c= P
  holds P halts_on s;
  attr I is keepInt0_1 means


  for s being State of SCM+FSA st Initialize ((intloc 0) .--> 1) c= s
  for p st I c= p
  for k being Element of NAT holds (Comput(p,s,k)).intloc 0 = 1;
end;

canceled;

theorem 
  Macro halt SCM+FSA is InitHalting;

registration
  cluster InitHalting for Program of SCM+FSA;
end;

registration
  cluster paraclosed -> InitClosed for Program of SCM+FSA;
end;

registration
  cluster parahalting -> InitHalting for Program of SCM+FSA;
end;

registration
  cluster InitHalting -> InitClosed for Program of SCM+FSA;
  cluster keepInt0_1 -> InitClosed for Program of SCM+FSA;
  cluster keeping_0 -> keepInt0_1 for Program of SCM+FSA;
end;

canceled;

theorem 
  for I being InitHalting Program of SCM+FSA, a being read-write
  Int-Location holds not a in UsedIntLoc I implies (IExec(I,p,s)).a = s.a;

theorem 
  for I being InitHalting Program of SCM+FSA,f being FinSeq-Location
  holds not f in UsedInt*Loc I implies (IExec(I,p,s)).f = s.f;

registration
  cluster InitHalting -> non empty for Program of SCM+FSA;
end;

theorem 
  for J being InitHalting Program of SCM+FSA
   st Initialize ((intloc 0) .--> 1) c= s1 & J c= p1
  for n being Element of NAT st
  Reloc(J,n) c= p2 &
   IC s2 = n & DataPart s1 = DataPart s2
  for i being Element of NAT holds
   IC Comput(p1,s1,i) + n = IC Comput(p2,s2,i) &
   IncAddr(CurInstr(p1,Comput(p1,s1,i)),n) = CurInstr(p2,Comput(p2,s2,i)) &
   DataPart Comput(p1,s1,i) = DataPart Comput(p2,s2,i);



theorem 
  for I being InitHalting Program of SCM+FSA st
   Initialize ((intloc 0) .--> 1) c= s1 &
   Initialize ((intloc 0) .--> 1) c= s2 &
   I c= p1 & I c= p2 &
    s1 =  s2
 for k being Element of NAT holds
   Comput(p1,s1,k) =  Comput(p2,s2,k) &
  CurInstr(p1,Comput(p1,s1,k)) = CurInstr(p2,Comput(p2,s2,k));

theorem 
  for I being InitHalting Program of SCM+FSA
   st Initialize ((intloc 0) .--> 1) c= s1 &
     Initialize ((intloc 0) .--> 1) c= s2 & I c= p1 & I c= p2 &
    s1 =  s2
 holds LifeSpan(p1,s1) = LifeSpan(p2,
  s2) &  Result(p1,s1) =  Result(p2,s2);

registration
  cluster keeping_0 InitHalting for Program of SCM+FSA;
end;

registration
  cluster keepInt0_1 InitHalting for Program of SCM+FSA;
end;



theorem 
  for I being keepInt0_1 InitHalting Program of SCM+FSA holds
  IExec(I,p,s).intloc 0 = 1;

registration
 cluster InitClosed for Program of SCM+FSA;
end;

theorem 
  for I being InitClosed Program of SCM+FSA, J being Program of
  SCM+FSA st Initialize ((intloc 0) .--> 1) c= s & I c= p &
   p halts_on s
   for m st m <= LifeSpan(p,s) holds
   Comput(p,s,m) =  Comput(p+*(I ";" J),s,m);



theorem 
  for I being InitClosed Program of SCM+FSA
   st p+*I halts_on s &
   Directed I c= p &
   Initialize ((intloc 0) .--> 1) c= s
   holds IC Comput(p, s,LifeSpan(p +* I,s) + 1) =  card I;

theorem 
  for I being InitClosed Program of SCM+FSA
   st p+*I halts_on s & Directed I c= p &
 Initialize ((intloc 0) .--> 1) c= s
 holds DataPart Comput(p, s,LifeSpan(p +* I,s))
  = DataPart Comput(p,s,LifeSpan(p +* I,s) + 1);

theorem 
  for I being InitHalting Program of SCM+FSA st
    Initialize ((intloc 0) .--> 1) c= s & I c= p
  for k being Element of NAT st k <= LifeSpan(p,s)
   holds CurInstr(p +* Directed I,
    Comput(p +* Directed I, s,k)) <> halt SCM+FSA;

theorem 
  for I being InitClosed Program of SCM+FSA
   st p+*I halts_on Initialized s
   for J being Program of SCM+FSA, k being Element of NAT
    st k <= LifeSpan(p +* I,Initialized s )
   holds  Comput(p +* I, (Initialized s),k)
    =  Comput(p +* (I ";" J), (Initialized s),k);

theorem 
  for I being keepInt0_1 InitHalting Program of SCM+FSA, J being
InitHalting Program of SCM+FSA, s being State of SCM+FSA st
 Initialize ((intloc 0) .--> 1) c= s & I ";" J c= p
  holds IC Comput(p, s,LifeSpan(p +* I,s) + 1) =  card I &
   DataPart Comput(p, s,LifeSpan(p +* I,s) + 1) =
    DataPart(Comput(p +* I, s,LifeSpan(p +* I,s))
       +* Initialize ((intloc 0) .--> 1)) &
  Reloc(J,card I) c= p &
  Comput(p, s,LifeSpan(p +* I,s) + 1).intloc 0 = 1 & p halts_on s &
   LifeSpan(p,s) = LifeSpan(p +* I,s) + 1 +
 LifeSpan(p +* I +* J,
Result(p +* I,s) +*Initialize ((intloc 0) .--> 1)) & (J is keeping_0 implies
(Result(p,s)).intloc 0 = 1);

registration
  let I be keepInt0_1 InitHalting Program of SCM+FSA, J be InitHalting Program
  of SCM+FSA;
  cluster I ";" J -> InitHalting;
end;

theorem 
  for I being keepInt0_1 Program of SCM+FSA st p+*I halts_on s
  for J being InitClosed Program of SCM+FSA st
   Initialize ((intloc 0) .--> 1) c= s & I ";" J c= p
for k being Element of NAT holds (Comput(p +* I +* J,
(Result(p +* I,s) +* Initialize ((intloc 0) .--> 1)),k) +*
  Start-At (IC Comput(p +* I +* J, (
  Result(p +* I,s) +* Initialize ((intloc 0) .--> 1)),k) + card I,SCM+FSA))
  =  Comput(p +* (I ";" J), s,LifeSpan(p +* I,s)+1+k);

theorem 
  for I being keepInt0_1 Program of SCM+FSA
   st not p+*I halts_on Initialized s
 for J being Program of SCM+FSA, k being Element of NAT
  holds  Comput(p +* I, Initialized s,k)
   =  Comput(p +* (I ";" J), Initialized s,k);

theorem 
  for I being keepInt0_1 InitHalting Program of SCM+FSA, J being
  InitHalting Program of SCM+FSA holds
   LifeSpan(p +* (I ";" J),Initialized s)
     = LifeSpan(p+*I,Initialized s) + 1 +
       LifeSpan(p +* I +* J,
           Result(p+*I,Initialized s)
            +*Initialize ((intloc 0) .--> 1));

theorem 
  for I being keepInt0_1 InitHalting Program of SCM+FSA, J being
InitHalting Program of SCM+FSA holds
 IExec(I ";" J,p,s) = IncIC(IExec(J,p,IExec(I,p,s)),card I);

registration
  let i be parahalting Instruction of SCM+FSA;
  cluster Macro i -> InitHalting;
end;

registration
  let i be parahalting Instruction of SCM+FSA, J be parahalting Program of
  SCM+FSA;
  cluster i ";" J -> InitHalting;
end;

registration
  let i be keeping_0 parahalting Instruction of SCM+FSA, J be InitHalting
  Program of SCM+FSA;
  cluster i ";" J -> InitHalting;
end;

registration
  let I, J be keepInt0_1 Program of SCM+FSA;
  cluster I ";" J -> keepInt0_1;
end;

registration
  let j be keeping_0 parahalting Instruction of SCM+FSA, I be keepInt0_1
  InitHalting Program of SCM+FSA;
  cluster I ";" j -> InitHalting keepInt0_1;
end;

registration
  let i be keeping_0 parahalting Instruction of SCM+FSA, J be keepInt0_1
  InitHalting Program of SCM+FSA;
  cluster i ";" J -> InitHalting keepInt0_1;
end;

registration
  let j be parahalting Instruction of SCM+FSA, I be parahalting Program of
  SCM+FSA;
  cluster I ";" j -> InitHalting;
end;

registration
  let i,j be parahalting Instruction of SCM+FSA;
  cluster i ";" j -> InitHalting;
end;

theorem 
  for I being keepInt0_1 InitHalting Program of SCM+FSA, J being
InitHalting Program of SCM+FSA holds IExec(I ";" J,p,s).a
 = IExec(J,p,IExec(I,p,s)).a;

theorem 
  for I being keepInt0_1 InitHalting Program of SCM+FSA, J being
InitHalting Program of SCM+FSA holds IExec(I ";" J,p,s).f
 = IExec(J,p,IExec(I,p,s)).f;

theorem 
  for I be keepInt0_1 InitHalting Program of SCM+FSA, s be State
  of SCM+FSA holds DataPart(Initialized IExec(I,p,s)) = DataPart IExec(I,p,s);

theorem 
  for I being keepInt0_1 InitHalting Program of SCM+FSA, j being
parahalting Instruction of SCM+FSA holds IExec(I ";" j,p,s).a
 = Exec(j,IExec(I,p,s)).a;

theorem 
  for I being keepInt0_1 InitHalting Program of SCM+FSA, j being
parahalting Instruction of SCM+FSA holds IExec(I ";" j,p,s).f
 = Exec(j,IExec(I,p,s)).f;

definition
  let I be Program of SCM+FSA;
  let s be State of SCM+FSA;
  let p;
  pred I is_closed_onInit s,p means


  for k being Element of NAT holds IC
  Comput(p +* I,Initialized s,k) in dom I;
  pred I is_halting_onInit s,p means


  p+*I halts_on Initialized s;
end;

theorem 
  for I being Program of SCM+FSA holds I is InitClosed iff for s
  being State of SCM+FSA,p holds I is_closed_onInit s,p;

theorem 
  for I being Program of SCM+FSA holds I is InitHalting iff for s
  being State of SCM+FSA,p holds I is_halting_onInit s,p;

theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA, a
being Int-Location st I does not destroy a & I is_closed_onInit s,p &
 Initialize ((intloc 0) .--> 1) c= s & I c= p
   holds for k being Element of NAT holds Comput(p,s,k).a = s.a;

registration
  cluster InitHalting good for Program of SCM+FSA;
end;

registration
  cluster InitClosed good -> keepInt0_1 for Program of SCM+FSA;
end;

registration
  cluster Stop SCM+FSA -> InitHalting good;
end;

theorem 
  for s being State of SCM+FSA, i being keeping_0 parahalting
  Instruction of SCM+FSA, J being InitHalting Program of SCM+FSA, a being
  Int-Location holds IExec(i ";" J,p,s).a
   = IExec(J,p,Exec(i,Initialized s)).a;

theorem 
  for s being State of SCM+FSA, i being keeping_0 parahalting
  Instruction of SCM+FSA, J being InitHalting Program of SCM+FSA, f being
  FinSeq-Location holds IExec(i ";" J,p,s).f
   = IExec(J,p,Exec(i,Initialized s)).f;

theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA holds I
  is_closed_onInit s,p iff I is_closed_on Initialized s,p;

theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA holds I
  is_halting_onInit s,p iff I is_halting_on Initialized s,p;

theorem 
  for I be Program of SCM+FSA, s be State of SCM+FSA holds IExec(I,p,s) =
  IExec(I,p,Initialized s);

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a
  being read-write Int-Location st s.a = 0 & I is_closed_onInit s,p & I
  is_halting_onInit s,p holds if=0(a,I,J) is_closed_onInit s,p & if=0(a,I,J)
  is_halting_onInit s,p;

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a
  being read-write Int-Location st s.a = 0 & I is_closed_onInit s,p & I
is_halting_onInit s,p holds IExec(if=0(a,I,J),p,s)
 = IExec(I,p,s) +* Start-At( (card I + card J + 3),SCM+FSA);

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a
  being read-write Int-Location st s.a <> 0 & J is_closed_onInit s,p & J
  is_halting_onInit s,p holds if=0(a,I,J) is_closed_onInit s,p & if=0(a,I,J)
  is_halting_onInit s,p;

theorem 
  for I,J being Program of SCM+FSA, a being read-write
  Int-Location holds for s being State of SCM+FSA st s.a <> 0 & J
is_closed_onInit s,p & J is_halting_onInit s,p
 holds IExec(if=0(a,I,J),p,s)
  = IExec(J,p,s) +* Start-At((card I + card J + 3),SCM+FSA);

theorem 
  for s being State of SCM+FSA, I,J being InitHalting Program of
SCM+FSA, a being read-write Int-Location holds if=0(a,I,J) is InitHalting & (s.
  a = 0 implies IExec(if=0(a,I,J),p,s) = IExec(I,p,s) +* Start-At((card I +
card J + 3),SCM+FSA)) &
 (s.a <> 0 implies IExec(if=0(a,I,J),p,s) = IExec(J,p,s) +* Start-At(
   (card I + card J + 3),SCM+FSA));

theorem 
  for s being State of SCM+FSA, I,J being InitHalting Program of SCM+FSA
, a being read-write Int-Location holds IC IExec(if=0(a,I,J),p,s) =  (card
I + card J + 3) & (s.a = 0 implies ((for d being Int-Location
 holds IExec(if=0(a,I,J),p,s).d = IExec(I,p,s).d) &
  for f being FinSeq-Location
 holds IExec(if=0(a,I,J),p,s).f = IExec(I,p,s).f)) & (s.a <> 0 implies
   ((for d being Int-Location holds
  IExec(if=0(a,I,J),p,s).d = IExec(J,p,s).d) &
  for f being FinSeq-Location holds
  IExec(if=0(a,I,J),p,s).f = IExec(J,p,s).f));

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a
  being read-write Int-Location st s.a > 0 & I is_closed_onInit s,p & I
  is_halting_onInit s,p holds if>0(a,I,J) is_closed_onInit s,p & if>0(a,I,J)
  is_halting_onInit s,p;

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a
  being read-write Int-Location st s.a > 0 & I is_closed_onInit s,p & I
is_halting_onInit s,p holds IExec(if>0(a,I,J),p,s)
 = IExec(I,p,s) +* Start-At((card I + card J + 3),SCM+FSA);

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a
  being read-write Int-Location st s.a <= 0 & J is_closed_onInit s,p & J
  is_halting_onInit s,p holds if>0(a,I,J) is_closed_onInit s,p & if>0(a,I,J)
  is_halting_onInit s,p;

theorem 
  for I,J being Program of SCM+FSA, a being read-write
  Int-Location holds for s being State of SCM+FSA st s.a <= 0 & J
is_closed_onInit s,p & J is_halting_onInit s,p
 holds IExec(if>0(a,I,J),p,s)
  = IExec(J,p,s) +* Start-At((card I + card J + 3),SCM+FSA);

theorem 
  for s being State of SCM+FSA, I,J being InitHalting Program of
SCM+FSA, a being read-write Int-Location holds if>0(a,I,J) is InitHalting & (s.
  a > 0 implies IExec(if>0(a,I,J),p,s) = IExec(I,p,s) +* Start-At((card I +
card J + 3),SCM+FSA)) &
 (s.a <= 0 implies IExec(if>0(a,I,J),p,s) = IExec(J,p,s) +* Start-At(
   (card I + card J + 3),SCM+FSA));

theorem 
  for s being State of SCM+FSA, I,J being InitHalting Program of SCM+FSA
, a being read-write Int-Location holds IC IExec(if>0(a,I,J),p,s) =  (card
I + card J + 3) & (s.a > 0 implies ((for d being Int-Location
 holds IExec(if>0(a,I,J),p,s).d = IExec(I,p,s).d) &
  for f being FinSeq-Location
 holds IExec(if>0(a,I,J),p,s).f
  = IExec(I,p,s).f)) & (s.a <= 0 implies ((for d being Int-Location
   holds
  IExec(if>0(a,I,J),p,s).d = IExec(J,p,s).d) & for f being FinSeq-Location
   holds
  IExec(if>0(a,I,J),p,s).f = IExec(J,p,s).f));

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a
  being read-write Int-Location st s.a < 0 & I is_closed_onInit s,p & I
is_halting_onInit s,p holds IExec(if<0(a,I,J),p,s)
 = IExec(I,p,s) +* Start-At((card I + card J + card J + 7),SCM+FSA);

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a
  being read-write Int-Location st s.a = 0 & J is_closed_onInit s,p & J
is_halting_onInit s,p holds IExec(if<0(a,I,J),p,s) = IExec(J,p,s) +* Start-At(
  (card I + card J + card J + 7),SCM+FSA);

theorem 
  for s being State of SCM+FSA, I,J being Program of SCM+FSA, a
  being read-write Int-Location st s.a > 0 & J is_closed_onInit s,p & J
is_halting_onInit s,p holds IExec(if<0(a,I,J),p,s) = IExec(J,p,s) +* Start-At(
  (card I + card J + card J + 7),SCM+FSA);

theorem 
  for s being State of SCM+FSA, I,J being InitHalting Program of
SCM+FSA, a being read-write Int-Location holds if<0(a,I,J) is InitHalting & (s.
  a < 0 implies IExec(if<0(a,I,J),p,s) = IExec(I,p,s) +* Start-At((card I +
card J + card J + 7),SCM+FSA)) &
 (s.a >= 0 implies IExec(if<0(a,I,J),p,s) = IExec(J,p,s) +*
  Start-At((card I + card J + card J + 7),SCM+FSA));

registration
  let I,J be InitHalting Program of SCM+FSA;
  let a be read-write Int-Location;
  cluster if=0(a,I,J) -> InitHalting;
  cluster if>0(a,I,J) -> InitHalting;
  cluster if<0(a,I,J) -> InitHalting;
end;

theorem 
  for I being Program of SCM+FSA holds I is InitHalting iff for s
  being State of SCM+FSA,p holds I is_halting_on Initialized s,p;

theorem 
  for I being Program of SCM+FSA holds I is InitClosed iff for s
  being State of SCM+FSA,p holds I is_closed_on Initialized s,p;

theorem 
  for s being State of SCM+FSA, I being InitHalting Program of
  SCM+FSA, a being read-write Int-Location holds IExec(I,p,s).a
   = Comput(p +* I, Initialize Initialized s,
  LifeSpan(p +* I,Initialize Initialized s)).a;

theorem 
  for s being State of SCM+FSA, I being InitHalting Program of
  SCM+FSA, a being Int-Location,k being Element of NAT st I does not destroy a
holds IExec(I,p,s).a = Comput(p +* I,
 Initialize Initialized s,k).a;

theorem 
  for s being State of SCM+FSA, I being InitHalting Program of
  SCM+FSA, a being Int-Location st I does not destroy a
   holds IExec(I,p,s).a = (Initialized s).a;

theorem 
  for s be State of SCM+FSA,I be keepInt0_1 InitHalting Program of
  SCM+FSA, a being read-write Int-Location st I does not destroy a holds
Comput(p +* (I ";" SubFrom(a,intloc 0)),
 Initialize Initialized s,
 LifeSpan(p +* (I ";" SubFrom(a,intloc 0)),
 Initialize Initialized s)).a
  = s.a - 1;

theorem 
  for s being State of SCM+FSA, I being InitClosed Program of
SCM+FSA st Initialize ((intloc 0) .--> 1) c= s & I c= p &
   p halts_on s
 for m being Element of NAT st m <=
     LifeSpan(p,s)
  holds  Comput(p,s,m) =  Comput(p +* loop I, s,m);

theorem 
  for s being State of SCM+FSA, I being InitHalting Program of SCM+FSA
st Initialize ((intloc 0) .--> 1) c= s & I c= p
 holds for k being Element of NAT st k <= LifeSpan(p,s) holds
  CurInstr(p +* loop I,Comput(p +* loop I, s,k)) <> halt SCM+FSA;



theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA st I
  is_closed_onInit s,p & I is_halting_onInit s,p
  for m being Element of NAT st m <=
  LifeSpan(p+*I,Initialized s)
   holds  Comput(p +* I, Initialized s,m)
     =  Comput(p +* loop I,(Initialized s),m);

theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA st I
  is_closed_onInit s,p & I is_halting_onInit s,p
  for m being Element of NAT st m <
LifeSpan(p+*I,Initialized s) holds
 CurInstr(p +* I,
  Comput(p +* I, (Initialized s),m))
  = CurInstr(p +* loop I,
   Comput(p +* loop I,(Initialized s),m));



theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA st I
  is_closed_onInit s,p & I is_halting_onInit s,p
   holds CurInstr(p +* loop I,
   Comput(p +* loop I, Initialized s, LifeSpan(p+*I,Initialized s)))
    = goto  0 & for m
  being Element of NAT st
   m <= LifeSpan(p+*I,Initialized s)
   holds CurInstr(p +* loop I,Comput(p +* loop I, Initialized s,m))
   <> halt SCM+FSA;

theorem 
  for s being State of SCM+FSA,p
  for I being good InitHalting Program
of SCM+FSA, a being read-write Int-Location st
   I does not destroy a & s.intloc 0 = 1 &
   s.a > 0 holds loop if=0(a,Goto  2,I ";" SubFrom(a,intloc 0))
  is_pseudo-closed_on s,p;

theorem 
  for s being State of SCM+FSA, I being good InitHalting Program of
  SCM+FSA, a being read-write Int-Location st I does not destroy a & s.a > 0
  holds loop if=0(a,Goto  2,I ";" SubFrom(a,intloc 0))
  is_pseudo-closed_on Initialized s,p;

theorem 
  for s being State of SCM+FSA, I being good InitHalting Program of
SCM+FSA, a being read-write Int-Location st I does not destroy a & s.intloc 0 =
  1 holds Times(a,I) is_closed_on s,p & Times(a,I) is_halting_on s,p;

theorem 
  for I being good InitHalting Program of SCM+FSA, a being read-write
  Int-Location st I does not destroy a holds
     Initialize ((intloc 0) .--> 1) is Times(a,I)-halted;

registration
  let a be read-write Int-Location,I be good Program of SCM+FSA;
  cluster Times(a,I) -> good;
end;

theorem 
  for s being State of SCM+FSA, I being good InitHalting Program
  of SCM+FSA, a being read-write Int-Location st I does not destroy a & s.a > 0
  ex s2 being State of SCM+FSA,
   p2 being Instruction-Sequence of SCM+FSA,
   k being Element of NAT st
   s2 = Initialized s &
   p2 = p +* loop if=0(a,Goto 2, I ";" SubFrom(a,intloc 0)) &
   k =
LifeSpan(p +* (if=0(a,Goto 2, I ";" SubFrom(a,intloc 0))),Initialized s)
  + 1 & Comput(p2,s2,k).a = s.a - 1 & Comput(p2,s2,k)
.intloc 0 = 1 & (for b
being read-write Int-Location st b <> a holds Comput(p2,s2,k).b =
IExec(I,p,s).
  b) & (for f being FinSeq-Location holds Comput(p2,s2,k).f =
IExec(I,p,s).f) &
IC Comput(p2,s2,k) =  0 & for n being Element of NAT st n <= k
holds IC
Comput(p2, s2,n) in dom loop if=0(a,Goto 2,I ";" SubFrom(a,
intloc 0));

theorem 
  for s being State of SCM+FSA, I being good InitHalting Program
of SCM+FSA, a being read-write Int-Location st s.intloc 0 = 1 & s.a <= 0 holds
  DataPart IExec(Times(a,I),p,s) = DataPart s;

theorem 
  for s being State of SCM+FSA, I being good InitHalting Program
  of SCM+FSA, a being read-write Int-Location st I does not destroy a & s.a > 0
holds IExec(I ";" SubFrom(a,intloc 0),p,s).a = s.a - 1 &
 DataPart IExec(Times(a,I),p,s)
  = DataPart IExec(Times(a,I),p,IExec(I ";" SubFrom(a,intloc 0),p,s));

theorem 
  for s be State of SCM+FSA, I be good InitHalting Program of SCM+FSA, f
be FinSeq-Location,a be read-write Int-Location st s.a <= 0
 holds IExec(Times(a,I),p,s).f=s.f;

theorem 
  for s be State of SCM+FSA, I be good InitHalting Program of SCM+FSA, b
be Int-Location,a be read-write Int-Location st s.a <= 0
 holds IExec(Times(a,I),p,s).b=(Initialized s).b;

theorem 
  for s be State of SCM+FSA, I be good InitHalting Program of SCM+FSA, f
be FinSeq-Location,a be read-write Int-Location st I does not destroy a & s.a >
0 holds IExec(Times(a,I),p,s).f
 =IExec(Times(a,I),p,IExec(I ";" SubFrom(a,intloc 0),p,s)).f;

theorem 
  for s be State of SCM+FSA, I be good InitHalting Program of SCM+FSA, b
be Int-Location,a be read-write Int-Location st I does not destroy a & s.a > 0
holds IExec(Times(a,I),p,s).b
 =IExec(Times(a,I),p,IExec(I ";" SubFrom(a,intloc 0),p,s)).b;

definition
  let i be Instruction of SCM+FSA;
  redefine attr i is good means


  i does not destroy intloc 0;
end;
















begin 

reserve p for preProgram of SCM+FSA,
  ic for Instruction of SCM+FSA,
  i,j,k for Element of NAT,
  fa,f for FinSeq-Location,
  a,b,da,db for Int-Location,
  la,lb for Element of NAT;
reserve p1,p2,q for Instruction-Sequence of SCM+FSA;

theorem 
  for I being Program of SCM+FSA,a,b being Int-Location st
  I does not destroy b & a<>b holds Times(a,I) does not destroy b;

theorem 
  for s be State of SCM+FSA,f be FinSeq-Location,a,b be Int-Location
  holds Exec(b:=(f,a), s).b = (s.f)/.abs(s.a);

theorem 
  for s be State of SCM+FSA,f be FinSeq-Location,a,b be Int-Location
  holds Exec((f,a):=b, s).f = s.f+*(abs(s.a),s.b);

theorem 
  for s be State of SCM+FSA,f be FinSeq-Location,m,n be Element of NAT,
  a be Int-Location
  st m<>n+1 holds Exec(intloc m:=(f,a), Initialized s).intloc (n+1)
  =s.intloc (n+1);

theorem 
  for s be State of SCM+FSA,m,n be Element of NAT,a be Int-Location
  st m<>n+1 holds Exec(intloc m:=a, Initialized s).intloc (n+1) =s.intloc (n+1)
;

theorem 
  for p being Instruction-Sequence of SCM+FSA
  for s be State of SCM+FSA, f be FinSeq-Location, a be read-write Int-Location
  holds IExec(Stop SCM+FSA,p,s).a =s.a &
     IExec(Stop SCM+FSA,p,s).f =s.f;

reserve n for Nat;

theorem 
  ic in rng p & (ic = a:=b or ic = AddTo(a, b) or ic = SubFrom(a, b) or
  ic = MultBy(a, b) or ic = Divide(a, b))
  implies a in UsedIntLoc p & b in UsedIntLoc p;

theorem 
  ic in rng p & (ic = a=0_goto la or ic = a>0_goto la)
  implies a in UsedIntLoc p;

theorem 
  ic in rng p & ( ic = b := (fa, a) or ic = (fa, a) := b)
  implies a in UsedIntLoc p & b in UsedIntLoc p;

theorem 
  ic in rng p & ( ic = b := (fa, a) or ic = (fa, a) := b)
  implies fa in UsedInt*Loc p;

theorem 
  ic in rng p & (ic = a :=len fa or ic = fa :=<0,...,0>a)
  implies a in UsedIntLoc p;

theorem 
  ic in rng p & (ic = a :=len fa or ic = fa :=<0,...,0>a)
  implies fa in UsedInt*Loc p;

theorem 
  for t being FinPartState of SCM+FSA,p being Program of SCM+FSA,
  x being set st dom t c= Int-Locations \/ FinSeq-Locations &
  x in dom t \/ UsedInt*Loc p \/ UsedIntLoc p
  holds x is Int-Location or x is FinSeq-Location;

theorem 
  for i,k being Element of NAT,t being FinPartState of SCM+FSA,
  p being Program of SCM+FSA, s1,s2 being State of SCM+FSA
  st k <= i & p c= p1 & p c= p2 & dom t c= Int-Locations \/ FinSeq-Locations &
  (for j holds IC Comput(p1,s1,j) in dom p &
  IC Comput(p2,s2,j) in dom p) &
  Comput(p1,s1,k).IC SCM+FSA = Comput(p2,s2,k).IC SCM+FSA &
  Comput(p1,s1,k) |(dom t \/ UsedInt*Loc p \/ UsedIntLoc p) =
  Comput(p2,s2,k) |(dom t \/ UsedInt*Loc p \/ UsedIntLoc p) holds
  Comput(p1,s1,i).IC SCM+FSA = Comput(p2,s2,i).IC SCM+FSA &
  Comput(p1,s1,i) |(dom t \/ UsedInt*Loc p \/ UsedIntLoc p) =
  Comput(p2,s2,i) |(dom t \/ UsedInt*Loc p \/ UsedIntLoc p);

theorem 
  for i,k being Element of NAT,p being Program of SCM+FSA,
  s1,s2 being State of SCM+FSA st k <= i & p c= p1 & p c= p2 &
  (for j holds IC Comput(p1,s1,j) in dom p &
  IC Comput(p2,s2,j) in dom p) &
  Comput(p1,s1,k).IC SCM+FSA = Comput(p2,s2,k).IC
SCM+FSA &
  Comput(p1,s1,k) | (UsedInt*Loc p \/ UsedIntLoc p) =
  Comput(p2,s2,k) | (UsedInt*Loc p \/ UsedIntLoc p) holds
  Comput(p1,s1,i).IC SCM+FSA = Comput(p2,s2,i).IC
SCM+FSA &
  Comput(p1,s1,i) |(UsedInt*Loc p \/ UsedIntLoc p) =
  Comput(p2,s2,i) |(UsedInt*Loc p \/ UsedIntLoc p);



theorem 
  for I,J being Program of SCM+FSA, a being Int-Location holds
  UsedIntLoc if=0(a,I,J) = {a} \/ UsedIntLoc I \/ UsedIntLoc J &
  UsedIntLoc if>0(a,I,J) = {a} \/ UsedIntLoc I \/ UsedIntLoc J;

theorem 
  for I be Program of SCM+FSA,l be Element of NAT holds
  UsedIntLoc (Directed(I,l)) = UsedIntLoc I;

theorem 
  for a being Int-Location,I being Program of SCM+FSA holds
  UsedIntLoc Times(a,I) = UsedIntLoc I \/ {a,intloc 0};



theorem 
  for I be Program of SCM+FSA,l be Element of NAT holds
  UsedInt*Loc (Directed(I,l)) = UsedInt*Loc I;

theorem 
  for a being Int-Location,I being Program of SCM+FSA holds
  UsedInt*Loc Times(a,I) = UsedInt*Loc I;

canceled;

theorem 
  for a being Int-Location,I being Program of SCM+FSA holds
  card Times(a,I) = card I + 12;

theorem 
  for i1,i2,i3 be Instruction of SCM+FSA holds card (i1 ";" i2 ";" i3)=6;

canceled 2;

theorem 
  for I,J being Program of SCM+FSA, k being Element of NAT,
  i being Instruction of SCM+FSA st k< card J & i = J. k holds
  (I ";" J).(card I +k) =IncAddr( i, card I );

theorem 
  for I,J be Program of SCM+FSA,
      i be ins-loc-free Instruction of SCM+FSA st i <> halt SCM+FSA
  holds (I ";" i ";" J).card I = i;

theorem 
  for I,J be Program of SCM+FSA, i be Instruction of SCM+FSA
  holds (I ";" i ";" J).(card I+1) = goto(card I+2);

canceled 3;

theorem 
  for p being Program of SCM+FSA,s being State of SCM+FSA holds
  UsedInt*Loc p \/ UsedIntLoc p c= dom s;

theorem 
  for p being Instruction-Sequence of SCM+FSA
  for s be State of SCM+FSA,I be Program of SCM+FSA,f be FinSeq-Location
  holds Result(p +* I,Initialized s).f = IExec(I,p,s).f;











definition
  let f be FinSeq-Location;
  func bubble-sort f -> Program of SCM+FSA equals

  ( ((intloc 2):= (intloc 0)) ";" ((intloc 3):= (intloc 0)) ";"
  ((intloc 4):= (intloc 0)) ";" ((intloc 5):= (intloc 0)) ";"
  ((intloc 6):= (intloc 0)) ) ";" ((intloc 1):=len f) ";" Times((intloc 1),
  (intloc 2) := (intloc 1) ";" SubFrom(intloc 2,intloc 0) ";"
  ((intloc 3):=len f) ";" Times(intloc 2, (intloc 4):=(intloc 3) ";"
  SubFrom(intloc 3,intloc 0) ";" ((intloc 5):=(f,intloc 3)) ";"
  ((intloc 6):=(f,(intloc 4))) ";" SubFrom(intloc 6,intloc 5) ";"
  if>0(intloc 6,((intloc 6):=(f,intloc 4)) ";" ((f,intloc 3):=(intloc 6)) ";"
  ((f,intloc 4):=(intloc 5)),Stop SCM+FSA) ) );
end;

definition
  func Bubble-Sort-Algorithm -> Program of SCM+FSA equals

  bubble-sort fsloc 0;
end;

theorem 
  for f being FinSeq-Location holds
  UsedIntLoc (bubble-sort f) = {intloc 0,intloc 1,intloc 2,intloc 3, intloc 4,
  intloc 5,intloc 6};

theorem 
  for f being FinSeq-Location holds UsedInt*Loc (bubble-sort f) = {f};

canceled 2;

theorem 
  for f being FinSeq-Location holds card (bubble-sort f) = 63;

theorem 
  for P being Instruction-Sequence of SCM+FSA
   st Bubble-Sort-Algorithm c= P
  for f being FinSeq-Location, k being Element of NAT st
  k < 63 holds Bubble-Sort-Algorithm.k= P.k;

theorem 
  bubble-sort (fsloc 0) is keepInt0_1 InitHalting;

theorem 
  for p be Instruction-Sequence of SCM+FSA
  for s be State of SCM+FSA holds
  s.(fsloc 0), IExec(bubble-sort (fsloc 0),p,s).(fsloc 0)
  are_fiberwise_equipotent &
  for i,j be Element of NAT st i>=1 & j<=len (s.(fsloc 0)) & i<j
  for x1,x2 be Integer st x1 =IExec(bubble-sort (fsloc 0),p,s).(fsloc 0).i &
  x2=IExec(bubble-sort (fsloc 0),p,s).(fsloc 0).j holds x1 >= x2;

theorem 
  for i being Element of NAT, s being State of SCM+FSA,
  P being Instruction-Sequence of SCM+FSA
   st Bubble-Sort-Algorithm c= P
  for w being FinSequence of INT
  st (Initialized ((fsloc 0) .--> w)) c= s
  holds IC Comput(P,s,i) in dom Bubble-Sort-Algorithm;

theorem 
  for p being Instruction-Sequence of SCM+FSA
  for s be State of SCM+FSA,t be FinSequence of INT st
  Initialize((intloc 0).-->1) +*(fsloc 0 .--> t) c= s &
  Bubble-Sort-Algorithm c= p
  ex u being FinSequence of REAL
  st t,u are_fiberwise_equipotent & u is non-increasing &
  u is FinSequence of INT & (Result(p,s)).(fsloc 0) = u;

theorem 
  for w being FinSequence of INT holds
  Initialized ((fsloc 0) .--> w) is Bubble-Sort-Algorithm-autonomic;

registration
 cluster Bubble-Sort-Algorithm -> non halt-free;
end;

theorem 
  Bubble-Sort-Algorithm, Initialize((intloc 0).-->1)
      computes Sorting-Function;
















begin 

theorem 
  for p be preProgram of SCM+FSA,l be Element of NAT,
  ic be Instruction of SCM+FSA st l in dom p &
  (ex pc be Instruction of SCM+FSA st pc=p.l & UsedIntLoc pc=UsedIntLoc ic)
   holds UsedIntLoc p = UsedIntLoc (p+*(l.-->ic));

theorem 
  for a being Int-Location,I being Program of SCM+FSA
   holds if>0(a, I";" Goto  0,Stop SCM+FSA).(card I +4) = goto  (card I +4);

theorem 
  for p be preProgram of SCM+FSA,l be Element of NAT,
  ic be Instruction of SCM+FSA st l in dom p & (ex pc be Instruction of SCM+FSA
st pc=p.l & UsedInt*Loc pc=UsedInt*Loc ic) holds UsedInt*Loc p = UsedInt*Loc (p
  +*(l.-->ic));

reserve s for State of SCM+FSA,
  I for Program of SCM+FSA,
  a for read-write
  Int-Location;

reserve i,j,k,n for Element of NAT;

theorem 
  for I being Program of SCM+FSA,a,b being Int-Location st I
  does not destroy b holds while>0(a,I) does not destroy b;

reserve P,P1,P2,Q
 for Instruction-Sequence of SCM+FSA;

theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA st I
  is_halting_on Initialized s,P holds for a be Int-Location
   holds IExec(I,P,s).a =
    Comput(P +* I,(Initialize Initialized s),
      LifeSpan(P +* I,Initialize Initialized s)).a;

theorem 
  for s be State of SCM+FSA,I be InitHalting Program of
SCM+FSA st
  Initialize ((intloc 0) .--> 1) c= s & I c= P1 & I c= P2
 for k be Element of NAT
  holds  Comput(P1, s,k) =  Comput(P2, s,k) &
   CurInstr(P1,Comput(P1,s,k))
   = CurInstr(P2,Comput(P2,s,k));

theorem 
  for s be State of SCM+FSA,I be InitHalting Program of SCM+FSA
    st Initialize ((intloc 0) .--> 1) c= s &
    I c= P1 & I c= P2
  holds LifeSpan(P1,s) = LifeSpan(P2,s) &
    Result(P1,s) =  Result(P2,s);

begin  

theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA, a
being read-write Int-Location st s.a <= 0
 holds while>0(a,I) is_halting_onInit s,P &
     while>0(a,I) is_closed_onInit s,P;

theorem 
  for a being Int-Location, I being Program of SCM+FSA, s being State of
SCM+FSA,k being Element of NAT
 st I is_closed_onInit s,P & I is_halting_onInit s,P &
  k < LifeSpan(P +* I,Initialized s) &
 IC Comput(P +* while>0(a,I), Initialized s,1 + k)
  = IC Comput(P +* I, Initialized s,k) + 4 &
 DataPart Comput(P +* while>0(a,I), Initialized s,1 + k)
 = DataPart Comput(P +* I, Initialized s,k)
 holds IC Comput(P +* while>0(a,I), Initialized s,1 + k+1)
  = IC Comput(P +* I, Initialized s,k+1) + 4 &
  DataPart Comput(P +* while>0(a,I), Initialized s,1 + k+1)
 = DataPart Comput(P +* I, Initialized s,k+1);

theorem 
  for a being Int-Location, I being Program of SCM+FSA, s being State of
SCM+FSA st I is_closed_onInit s,P & I is_halting_onInit s,P &
 IC Comput(P +* while>0(a,I), Initialized s,1 + LifeSpan(P +* I,Initialized s))
  = IC Comput(P +* I, Initialized s, LifeSpan(P +* I,Initialized s)) + 4
   holds CurInstr(P +* while>0(a,I),
    Comput(P +* while>0(a,I),Initialized s,1 + LifeSpan(P +* I,Initialized s)))
  = goto (card I +4);

theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA, a
being read-write Int-Location st I is_closed_onInit s,P &
I is_halting_onInit s,P & s.a >0 holds
   IC Comput(P +* while>0(a,I),Initialized s,
    LifeSpan(P +* I,Initialized s) + 3) =  0 &
for k being Element of NAT
 st k <= LifeSpan(P +* I,Initialized s) + 3
 holds IC Comput(P +* while>0(a,I),Initialized s,k) in dom while>0(a,I);

theorem 
  for s being State of SCM+FSA, I being Program of SCM+FSA,a be
read-write Int-Location st I is_closed_onInit s,P &
I is_halting_onInit s,P & s.a >
  0 holds for k being Element of NAT st
   k <= LifeSpan(P +* I,Initialized s) + 3
  holds IC Comput(P +* while>0(a,I), Initialized s,k) in dom while>0(a,I);

theorem 
  for s being State of SCM+FSA, I be Program of SCM+FSA,a be
read-write Int-Location st I is_closed_onInit s,P &
I is_halting_onInit s,P & s.a >
  0 holds IC Comput(P +* while>0(a,I), Initialized s,
     LifeSpan(P +* I,Initialized s) + 3) =  0 &
   DataPart Comput(P +* while>0(a,I), Initialized s,
    LifeSpan(P +* I,Initialized s) + 3)
     = DataPart Comput(P +* I, Initialized s,LifeSpan(P +* I,Initialized s));

theorem 
  for s be State of SCM+FSA, I be InitHalting Program of SCM+FSA, a be
  read-write Int-Location st s.a > 0 holds ex s2 be State of SCM+FSA, k be
  Element of NAT st s2 = Initialized s &
   k =LifeSpan(P +* I,Initialized s) + 3 &
   IC Comput(P +* while>0(a,I), s2,k) =  0 &
    (for b be Int-Location
  holds Comput(P +* while>0(a,I), s2,k).b = IExec(I,P,s).b) &
   for f be FinSeq-Location holds
    Comput(P +* while>0(a,I), s2,k).f = IExec(I,P,s).f;

definition
  let s,I,a,P;
  func StepWhile>0(a,P,s,I) -> Function of NAT,product the_Values_of
  SCM+FSA means


  it.0 = s &
   for i being Nat
    holds it.(i+1)
    = Comput(P +* while>0(a,I), Initialized it.i,
     LifeSpan(P +* while>0(a,I) +* I,Initialized it.i) + 3);
end;

theorem 
  StepWhile>0(a,P,s,I).(k+1) =StepWhile>0(a,P,StepWhile>0(a,P,s,I).k,I).1;

theorem 
  for I being Program of SCM+FSA,a being read-write Int-Location,
  s being State of SCM+FSA holds StepWhile>0(a,P,s,I).(0+1)
  = Comput(P +* while>0(a,I), Initialized s,
   LifeSpan(P +* while>0(a,I) +* I,Initialized s) + 3);

theorem 
  for I be Program of SCM+FSA,a be read-write Int-Location, s be
  State of SCM+FSA,k,n be Element of NAT st
   IC StepWhile>0(a,P,s,I).k = 0 &
   StepWhile>0(a,P,s,I).k
    = Comput(P +* while>0(a,I),Initialized s,n) &
    StepWhile>0(a,P,s,I).k.intloc 0=1
  holds
   StepWhile>0(a,P,s,I).k
    = Initialized StepWhile>0(a,P,s,I).k &
   StepWhile>0(a,P,s,I).(k+1)
    = Comput(P +* while>0(a,I), Initialized s,
           n +(LifeSpan(P +* while>0(a,I) +* I,
       Initialized StepWhile>0(a,P,s,I).k) + 3));

theorem 
  for I be Program of SCM+FSA,a be read-write Int-Location, s be State
of SCM+FSA st ex f being Function of product the_Values_of SCM+FSA,NAT st
  (for k being Element of NAT holds ( f.(StepWhile>0(a,P,s,I).k) <> 0
   implies f.(StepWhile>0(a,P,s,I).(k+1)) < f.(StepWhile>0(a,P,s,I).k) &
  I is_closed_onInit StepWhile>0(a,P,s,I).k,P+*while>0(a,I) &
  I is_halting_onInit StepWhile>0(a,P,s,I).k,P+*while>0(a,I)) &
  (StepWhile>0(a,P,s,I).(k+1)).intloc 0=1 &
   ( f.(StepWhile>0(a,P,s,I).k)=0 iff (StepWhile>0(a,P,s,I).k).a <= 0 ) )
    holds while>0(a,I) is_halting_onInit s,P & while>0(a,I)
  is_closed_onInit s,P;

theorem 
  for I be good InitHalting Program of SCM+FSA,a be read-write
Int-Location st (for s be State of SCM+FSA,P holds (s.a > 0
 implies IExec(I,P,s).a < s.a )) holds while>0(a,I) is InitHalting;

theorem 
  for I be good InitHalting Program of SCM+FSA,a be read-write
Int-Location st (for s be State of SCM+FSA,P holds IExec(I,P,s).a < s.a or
IExec(I,P,s).a <= 0) holds while>0(a,I) is InitHalting;

theorem 
  for I be good InitHalting Program of SCM+FSA,a be read-write
Int-Location st ex f being Function of (product the_Values_of SCM+FSA),INT
st (for s,t be State of SCM+FSA,P
 holds (f.s > 0 implies f.IExec(I,P,s) < f.s ) &
  (DataPart s = DataPart t implies f.s=f.t) & ( f.s <= 0 iff s.a <= 0 ) ) holds
  while>0(a,I) is InitHalting;

theorem 
  for s be State of SCM+FSA, I be Program of SCM+FSA, a be
  read-write Int-Location st s.a <= 0
   holds DataPart IExec(while>0(a,I),P,s) =
  DataPart Initialized s;

theorem 
  for s be State of SCM+FSA, I be good InitHalting Program of
SCM+FSA, a be read-write Int-Location st s.a > 0 & while>0(a,I) is InitHalting
holds DataPart IExec(while>0(a,I),P,s) =
 DataPart IExec(while>0(a,I),P,IExec(I,P,s));

theorem 
  for s be State of SCM+FSA, I be Program of SCM+FSA, f be
FinSeq-Location,a be read-write Int-Location st s.a <= 0
 holds IExec(while>0(a,I),P,s).f=s.f;

theorem 
  for s be State of SCM+FSA, I be Program of SCM+FSA, b be
Int-Location,a be read-write Int-Location st s.a <= 0
 holds IExec(while>0(a,I),P,s).b=(Initialized s).b;

theorem 
  for s be State of SCM+FSA, I be good InitHalting Program of
SCM+FSA, f be FinSeq-Location,a be read-write Int-Location st s.a > 0 & while>0
(a,I) is InitHalting
 holds IExec(while>0(a,I),P,s).f =IExec(while>0(a,I),P,IExec(I,P,
  s)).f;

theorem 
  for s be State of SCM+FSA, I be good InitHalting Program of
SCM+FSA, b be Int-Location,a be read-write Int-Location st s.a > 0 & while>0(a,
I) is InitHalting holds IExec(while>0(a,I),P,s).b
 =IExec(while>0(a,I),P,IExec(I,P,s))
  .b;

begin

definition
  let f be FinSeq-Location;
  func insert-sort f -> Program of SCM+FSA equals

   (((intloc 2):= intloc 0) ";"
    ((intloc 3):= intloc 0) ";"
    ((intloc 4):= intloc 0) ";"
    ((intloc 5):= intloc 0) ";"
    ((intloc 6):= intloc 0)) ";"
    ((intloc 1):=len f) ";"
    SubFrom(intloc 1,intloc 0) ";"
    Times(intloc 1, (((intloc 2):=len f) ";"
    SubFrom(intloc 2,intloc 1) ";"
    ((intloc 3) := intloc 2) ";"
    AddTo(intloc 3,intloc 0) ";"
    ((intloc 6):=(f,intloc 3)) ";"
    SubFrom(intloc 4,intloc 4)) ";"
    while>0(intloc 2, ((intloc 5):=(f,intloc 2)) ";"
    SubFrom(intloc 5,intloc 6) ";"
    if>0(intloc 5,
       Macro SubFrom(intloc 2,intloc 2), AddTo(intloc 4,intloc 0) ";"
    SubFrom(intloc 2,intloc 0)) ) ";"
    Times(intloc 4, ((intloc 2):=intloc 3) ";"
    SubFrom(intloc 3,intloc 0) ";"
    ((intloc 5):=(f,intloc 2)) ";"
    ((intloc 6):=(f,intloc 3)) ";"
    ((f,intloc 2):= intloc 6) ";"
    ((f,intloc 3):=intloc 5) ) );
end;

definition
  func Insert-Sort-Algorithm -> Program of SCM+FSA equals

  insert-sort fsloc 0;
end;

theorem 
  for f being FinSeq-Location holds UsedIntLoc (insert-sort f) = {
  intloc 0,intloc 1,intloc 2,intloc 3,intloc 4,intloc 5,intloc 6};

theorem 
  for f being FinSeq-Location holds UsedInt*Loc (insert-sort f) =
  {f};

theorem 
  for k1,k2,k3,k4 being Instruction of SCM+FSA holds card( k1 ";"
  k2 ";" k3 ";" k4) =8;

theorem 
  for k1,k2,k3,k4,k5 being Instruction of SCM+FSA holds card( k1
  ";" k2 ";" k3 ";" k4 ";"k5) =10;

theorem 
  for f being FinSeq-Location holds card insert-sort f = 82;

theorem 
  for f being FinSeq-Location, k being Element of NAT st k < 82
  holds  k in dom (insert-sort f);

theorem 
  insert-sort (fsloc 0) is keepInt0_1 InitHalting;

theorem 
  for s be State of SCM+FSA
   holds s.(fsloc 0), IExec(insert-sort (fsloc 0),P,s).(fsloc 0)
    are_fiberwise_equipotent &
 for i,j be Element of NAT st i >=1 & j<=len (s.(fsloc 0)) & i<j
 for x1,x2 be Integer st x1 =IExec(insert-sort (fsloc 0),P,s).(fsloc 0).i &
     x2=IExec(insert-sort (fsloc 0),P,s).(fsloc 0).j
  holds x1 >= x2;

theorem 
  for i being Element of NAT, s being State of SCM+FSA,
  P being Instruction-Sequence of SCM+FSA
   st Insert-Sort-Algorithm c= P
  for w being FinSequence of INT
  st (Initialized ((fsloc 0) .--> w)) c= s
  holds IC Comput(P,s,i) in dom Insert-Sort-Algorithm;

theorem 
  for s be State of SCM+FSA,t be FinSequence of INT, P st
  Initialize((intloc 0).-->1) +*(fsloc 0 .--> t) c= s &
  Insert-Sort-Algorithm c= P
   ex u being FinSequence of
  REAL st t,u are_fiberwise_equipotent & u is non-increasing & u is FinSequence
  of INT & (Result(P,s)).(fsloc 0) = u;

theorem 
  for w being FinSequence of INT holds Initialized
   ((fsloc 0) .--> w) is Insert-Sort-Algorithm-autonomic;

registration
 cluster Insert-Sort-Algorithm -> non halt-free;
end;

theorem 
  Insert-Sort-Algorithm, Initialize((intloc 0).-->1)
     computes Sorting-Function;















begin  

reserve I for Element of Segm 8,
  S for non empty 1-sorted,
  t for Element of S,
  x for set,
  k for Element of NAT;

 reserve R for Ring, T for InsType of SCM-Instr R;

definition
  let R be Ring;
  func SCM R -> strict AMI-Struct over 2 means


  the carrier of it = SCM-Memory & the ZeroF of it = NAT &
  the InstructionsF of it = SCM-Instr R &
  the Object-Kind of it = SCM-OK &
  the ValuesF of it = SCM-VAL R &
  the Execution of it = SCM-Exec R;
end;

registration
  let R be Ring;
  cluster SCM R -> non empty;
end;

registration
  let R be Ring;
  cluster SCM R -> with_non-empty_values;
end;

registration
 let R be Ring;
 cluster Int-like for Object of SCM R;
end;

definition
  let R be Ring;
  mode Data-Location of R is Int-like Object of SCM R;
  canceled;
end;

reserve R for Ring,
  r for Element of R,
  a, b, c, d1, d2 for Data-Location of R,
  i1 for Element of NAT;

theorem 
  x is Data-Location of R iff x in Data-Locations SCM;

definition
  let R be Ring, s be State of SCM R, a be Data-Location of R;
  redefine func s.a -> Element of R;
end;

theorem 
  [0,{},{}] is Instruction of SCM R;

theorem 
  x in {1,2,3,4} implies [x,{},<*d1,d2*>] in SCM-Instr S;

theorem 
  [5,{},<*d1,t*>] in SCM-Instr S;

theorem 
  [6,<*i1*>,{}] in SCM-Instr S;

theorem 
  [7,<*i1*>,<*d1*>] in SCM-Instr S;

definition
  let R be Ring, a, b be Data-Location of R;
  func a := b -> Instruction of SCM R equals

  [1,{},<*a,b*>];
  func AddTo(a,b) -> Instruction of SCM R equals

  [2,{},<*a,b*>];
  func SubFrom(a,b) -> Instruction of SCM R equals

  [3,{},<*a,b*>];
  func MultBy(a,b) -> Instruction of SCM R equals

  [4,{},<*a,b*>];
end;

definition
  let R be Ring, a be Data-Location of R, r be Element of R;
  func a := r -> Instruction of SCM R equals

  [5,{},<*a,r*>];
end;

definition
  let R be Ring, l be Element of NAT;
  func goto(l,R) -> Instruction of SCM R equals

  [6,<*l*>,{}];
end;

definition
  let R be Ring, l be Element of NAT, a be Data-Location
  of R;
  func a=0_goto l -> Instruction of SCM R equals

  [7,<*l*>,<*a*>];
end;

theorem 
  for I being set holds I is Instruction of SCM R iff I = [0,{},{}] or
(ex a,b st I = a:=b) or (ex a,b st I = AddTo(a,b)) or (ex a,b st I = SubFrom(a,
b)) or (ex a,b st I = MultBy(a,b)) or (ex i1 st I = goto(i1,R)) or
 (ex a,i1 st I =
  a=0_goto i1) or ex a,r st I = a:=r;

reserve s for State of SCM R;

registration
  let R be non empty Ring;
  cluster SCM R -> IC-Ins-separated;
end;

theorem 
  IC SCM R = NAT;

theorem 
  for S being SCM-State of R st S = s holds IC s = IC S;



theorem 
  for I being Instruction of SCM R for i being Element of
  SCM-Instr R st i = I for S being SCM-State of R st S = s holds Exec(I,s) =
  SCM-Exec-Res(i,S);

begin 

theorem 
  Exec(a := b, s).IC SCM R = succ IC s & Exec(a := b, s).a = s.b &
  for c st c <> a holds Exec(a := b, s).c = s.c;

theorem 
  Exec(AddTo(a,b), s).IC SCM R = succ IC s & Exec(AddTo(a,b), s).a
  = s.a + s.b & for c st c <> a holds Exec(AddTo(a,b), s).c = s.c;

theorem 
  Exec(SubFrom(a,b), s).IC SCM R = succ IC s & Exec(SubFrom(a,b),
  s).a = s.a - s.b & for c st c <> a holds Exec(SubFrom(a,b), s).c = s.c;

theorem 
  Exec(MultBy(a,b), s).IC SCM R = succ IC s & Exec(MultBy(a,b), s)
  .a = s.a * s.b & for c st c <> a holds Exec(MultBy(a,b), s).c = s.c;

theorem 
  Exec(goto(i1,R), s).IC SCM R = i1 & Exec(goto(i1,R), s).c = s.c;

theorem 
  (s.a = 0.R implies Exec(a =0_goto i1, s).IC SCM R = i1) & (s.a
<> 0.R implies Exec(a =0_goto i1, s).IC SCM R = succ IC s) & Exec(a =0_goto i1,
  s).c = s.c;

theorem 
  Exec(a := r, s).IC SCM R = succ IC s & Exec(a := r, s).a = r &
  for c st c <> a holds Exec(a := r, s).c = s.c;

begin  

theorem 
  for I being Instruction of SCM R st ex s st Exec(I,s).IC SCM R =
  succ IC s holds I is non halting;

theorem 
  for I being Instruction of SCM R st I = [0,{},{}] holds I is
  halting;

registration
  let R, a, b;
  cluster a:=b -> non halting;
  cluster AddTo(a,b) -> non halting;
  cluster SubFrom(a,b) -> non halting;
  cluster MultBy(a,b) -> non halting;
end;

registration
  let R, i1;
  cluster goto(i1,R) -> non halting;
end;

registration
  let R, a, i1;
  cluster a =0_goto i1 -> non halting;
end;

registration
  let R, a, r;
  cluster a:=r -> non halting;
end;

registration
  let R;
  cluster SCM R -> halting;
end;

theorem 
  for I being Instruction of SCM R st I is halting holds I = halt
  SCM R;

theorem 
  halt SCM R = [0,{},{}];

theorem 
  Data-Locations SCM R = Data-Locations SCM;

theorem 
  x is Data-Location of R iff x in Data-Locations SCM R;

theorem 
 for R being Ring
  holds the_Values_of SCM R = (SCM-VAL R)*SCM-OK;

theorem 
 for R being Ring holds
 (the carrier of SCM R) \ {NAT} = SCM-Data-Loc;














begin

reserve R for Ring,
  r for Element of R,
  a, b, d1, d2 for Data-Location of R,
  il, i1, i2 for Element of NAT,
  I for Instruction of SCM R,
  s,s1, s2 for State of SCM R,
  T for InsType of the InstructionsF of SCM R,
  k for Nat;

theorem 
  Values a = the carrier of R;

definition
  let R be Ring;
  let la, lb be Data-Location of R;
  let a, b be Element of R;
  redefine func (la,lb) --> (a,b) -> FinPartState of SCM R;
end;

theorem 
  a <> IC SCM R;

theorem 
  for o being Object of SCM R
   holds o = IC SCM R or o is Data-Location of R;

canceled;

theorem 
  InsCode (a:=b) = 1;

theorem 
  InsCode AddTo(a,b) = 2;

theorem 
  InsCode SubFrom(a,b) = 3;

theorem 
  InsCode MultBy(a,b) = 4;

theorem 
  InsCode (a:=r) = 5;

theorem 
  InsCode goto(i1,R) = 6;

theorem 
  InsCode (a=0_goto i1) = 7;

theorem 
  InsCode I = 0 implies I = halt SCM R;

theorem 
  InsCode I = 1 implies ex a, b st I = a:=b;

theorem 
  InsCode I = 2 implies ex a, b st I = AddTo(a,b);

theorem 
  InsCode I = 3 implies ex a, b st I = SubFrom(a,b);

theorem 
  InsCode I = 4 implies ex a, b st I = MultBy(a,b);

theorem 
  InsCode I = 5 implies ex a, r st I = a:=r;

theorem 
  InsCode I = 6 implies ex i2 st I = goto(i2,R);

theorem 
  InsCode I = 7 implies ex a, i1 st I = a=0_goto i1;

theorem 
  T = 0 implies JumpParts T = {0};

theorem 
  T = 1 implies JumpParts T = {{}};

theorem 
  T = 2 implies JumpParts T = {{}};

theorem 
  T = 3 implies JumpParts T = {{}};

theorem 
  T = 4 implies JumpParts T = {{}};

theorem 
  T = 5 implies JumpParts T = {{}};

theorem 
  T = 6 implies dom product" JumpParts T = {1};

theorem 
  T = 7 implies dom product" JumpParts T = {1};

theorem 
  (product" JumpParts InsCode goto(i1,R)).1 = NAT;

theorem 
  (product" JumpParts InsCode (a =0_goto i1)).1 = NAT;

registration
  let R;
  cluster JUMP halt SCM R -> empty;
end;

registration
  let R, a, b;
  cluster a:=b -> sequential;
  cluster AddTo(a,b) -> sequential;
  cluster SubFrom(a,b) -> sequential;
  cluster MultBy(a,b) -> sequential;
end;

registration
  let R, a, r;
  cluster a:=r -> sequential;
end;

registration
  let R, a, b;
  cluster JUMP (a := b) -> empty;
end;

registration
  let R, a, b;
  cluster JUMP AddTo(a, b) -> empty;
end;

registration
  let R, a, b;
  cluster JUMP SubFrom(a, b) -> empty;
end;

registration
  let R, a, b;
  cluster JUMP MultBy(a,b) -> empty;
end;

registration
  let R, a, r;
  cluster JUMP (a := r) -> empty;
end;

theorem 
  NIC(goto(i1,R), il) = {i1};

theorem 
  JUMP goto(i1,R) = {i1};

registration
  let R, i1;
  cluster JUMP goto(i1,R) -> 1-element;
end;

theorem 
  i1 in NIC(a=0_goto i1, il) & NIC(a=0_goto i1, il) c= {i1, succ il};

theorem 
  for R being non trivial Ring, a being Data-Location of R, il, i1
being Element of NAT holds NIC(a=0_goto i1, il) = {i1, succ il};

theorem 
  JUMP (a=0_goto i1) = {i1};

registration
  let R, a, i1;
  cluster JUMP (a =0_goto i1) -> 1-element;
end;

theorem 
  SUCC(il,SCM R) = {il, succ il};

theorem 
for k being Element of NAT holds k+1 in SUCC(k,SCM R) &
 for j being Element of NAT st j in SUCC(k,SCM R) holds k <= j;

registration
  let R;
  cluster SCM R -> standard;
end;

definition
  let R be Ring, k be Element of NAT;
  func dl.(R,k) -> Data-Location of R equals

  dl.k;
end;

registration
  let R;
  cluster InsCode halt SCM R -> jump-only
  for InsType of the InstructionsF of SCM R;
end;

registration
  let R;
  cluster halt SCM R -> jump-only;
end;

registration
  let R, i1;
  cluster InsCode goto(i1,R) -> jump-only
  for InsType of the InstructionsF of SCM R;
end;

registration
  let R, i1;
  cluster goto(i1,R) -> jump-only;
end;

registration
  let R, a, i1;
  cluster InsCode (a =0_goto i1) -> jump-only
  for InsType of the InstructionsF of SCM R;
end;

registration
  let R, a, i1;
  cluster a =0_goto i1 -> jump-only;
end;

reserve S for non trivial Ring,
  p, q for Data-Location of S,
  w for Element of S;

registration
  let S, p, q;
  cluster InsCode (p:=q) -> non jump-only
  for InsType of the InstructionsF of SCM S;
end;

registration
  let S, p, q;
  cluster p:=q -> non jump-only;
end;

registration
  let S, p, q;
  cluster InsCode AddTo(p,q) -> non jump-only
  for InsType of the InstructionsF of SCM S;
end;

registration
  let S, p, q;
  cluster AddTo(p, q) -> non jump-only;
end;

registration
  let S, p, q;
  cluster InsCode SubFrom(p,q) -> non jump-only
  for InsType of the InstructionsF of SCM S;
end;

registration
  let S, p, q;
  cluster SubFrom(p, q) -> non jump-only;
end;

registration
  let S, p, q;
  cluster InsCode MultBy(p,q) -> non jump-only
  for InsType of the InstructionsF of SCM S;
end;

registration
  let S, p, q;
  cluster MultBy(p, q) -> non jump-only;
end;

registration
  let S, p, w;
  cluster InsCode (p:=w) -> non jump-only
  for InsType of the InstructionsF of SCM S;
end;

registration
  let S, p, w;
  cluster p:=w -> non jump-only;
end;

registration
  let R, i1;
  cluster goto(i1,R) -> non sequential;
end;

registration
  let R, a, i1;
  cluster a =0_goto i1 -> non sequential;
end;

registration
  let R, i1;
  cluster goto(i1,R) -> non ins-loc-free;
end;

registration
  let R, a, i1;
  cluster a =0_goto i1 -> non ins-loc-free;
end;

registration
  let R;
  cluster SCM R -> with_explicit_jumps;
end;

theorem 
  IncAddr(goto(i1,R),k) = goto(i1 + k,R);

theorem 
  IncAddr(a=0_goto i1,k) = a=0_goto (i1 + k);

registration
  let R;
  cluster SCM R -> IC-relocable;
end;

theorem 
  InsCode I <= 7;















begin 

reserve i, j, k for Element of NAT,
  n for Element of NAT,
  IL for non empty set,
  N for with_non-empty_elements set;

reserve R for non trivial Ring,
  a, b for Data-Location of R,
  loc for Element of NAT,
  I for Instruction of SCM R,
  p for FinPartState of SCM R,
  s, s1, s2 for State of SCM R,
  P,P1,P2 for Instruction-Sequence of SCM R,
  q for FinPartState of SCM;

theorem 
  dl.(R,n) = [1,n];

theorem 
  for dl being Data-Location of R ex i being Element of NAT st dl = dl.(
  R,i);

theorem 
  for i,j being Element of NAT holds i <> j implies dl.(R,i) <> dl.(R,j);

theorem 
  Data-Locations SCM c= dom s;

theorem 
  s.a = (s +* Start-At(loc,SCM R)).a;

theorem 
  for s1,s2 being State of SCM R st IC(s1) = IC(s2) &
  (for a being Data-Location of R holds s1.a = s2.a)
    holds  s1 =  s2;

registration let R;
 cluster SCM R -> relocable;
end;

definition
  let R;
  let a be Data-Location of R;
  let r be Element of R;
  redefine func a .--> r -> FinPartState of SCM R;
end;

registration let R be non trivial Ring;
 cluster SCM R -> IC-recognized;
end;

registration let R be non trivial Ring;
 cluster SCM R -> CurIns-recognized;
end;

theorem 
  for q being non halt-free finite
   (the InstructionsF of SCM R)-valued NAT-defined Function
  for p being q-autonomic non empty
  FinPartState of SCM R st  p c= s1 &  p c= s2 &
  q c= P1 & q c= P2 &
  CurInstr(P1,Comput(P1,s1,n)) = a := b &
  a in dom p
   holds Comput(P1,s1,n).b = Comput(P2,s2,n).b;

theorem 
  for q being non halt-free finite
   (the InstructionsF of SCM R)-valued NAT-defined Function
  for p being q-autonomic non empty
  FinPartState of SCM R st  p c= s1 &  p c= s2 &
  q c= P1 & q c= P2 &
  CurInstr(P1,Comput(P1,s1,n)) =
  AddTo(a,b) & a in dom p holds Comput(P1,s1,n).a + Comput(P1,s1,n).b =
     Comput(P2,s2,n).a + Comput(P2,s2,n).b;

theorem 
  for q being non halt-free finite
   (the InstructionsF of SCM R)-valued NAT-defined Function
  for p being q-autonomic non empty
  FinPartState of SCM R st  p c= s1 &  p c= s2 &
  q c= P1 & q c= P2 &
  CurInstr(P1,Comput(P1,s1,n)) =
  SubFrom(a, b) & a in dom p holds Comput(P1,s1,n).a - Comput(
P1,s1,n).b =
  Comput(P2,s2,n).a - Comput(P2,s2,n).b;

theorem 
  for q being non halt-free finite
   (the InstructionsF of SCM R)-valued NAT-defined Function
  for p being q-autonomic non empty
  FinPartState of SCM R st  p c= s1 &  p c= s2 &
  q c= P1 & q c= P2 &
  CurInstr(P1,Comput(P1,s1,n)) =
  MultBy(a, b) & a in dom p holds Comput(P1,s1,n).a * Comput(
P1,s1,n).b =
  Comput(P2,s2,n).a * Comput(P2,s2,n).b;

theorem 
  for q being non halt-free finite
   (the InstructionsF of SCM R)-valued NAT-defined Function
  for p being q-autonomic non empty
  FinPartState of SCM R st  p c= s1 &  p c= s2 &
  q c= P1 & q c= P2 &
  CurInstr(P1,Comput(P1,s1,n)) = a
=0_goto loc & loc <> succ (IC Comput(P1,s1,n)) holds Comput(
P1,s1,n).a = 0.
  R iff Comput(P2,s2,n).a = 0.R;

begin 

theorem 
 for q being non halt-free finite
   (the InstructionsF of SCM R)-valued NAT-defined Function
 for p being non empty q-autonomic FinPartState of
  SCM R st p c= s1 & IncIC( p,k) c= s2
 for P1,P2 being Instruction-Sequence of SCM R
  st q c= P1 & Reloc(q,k) c= P2
  for i being Element of NAT
   holds IC Comput(P1,s1,i) + k = IC Comput(P2,s2,i) &
  IncAddr(CurInstr(P1,Comput(P1,s1,i)), k) = CurInstr(P2,Comput(P2,s2,i)) &
  Comput(P1,s1,i)|dom (DataPart p) = Comput(P2,s2,i)|dom DataPart p &
  DataPart Comput(P1,s1 +* DataPart s2,i) = DataPart Comput(P2,s2,i);

registration let R be non trivial Ring;
 cluster SCM R -> relocable1 relocable2;
end;















begin 

reserve x for set,
  k for Element of NAT;

definition
  func SCMPDS -> strict AMI-Struct over 2 equals

  AMI-Struct(#
    SCM-Memory,In(NAT,SCM-Memory),
    SCMPDS-Instr,
    SCM-OK,SCM-VAL,SCMPDS-Exec#);
end;

registration
  cluster SCMPDS -> non empty;
end;

registration
  cluster SCMPDS -> with_non-empty_values IC-Ins-separated;
end;

reserve s for State of SCMPDS;

canceled;

theorem 
  IC SCMPDS = NAT;

begin 

registration
 cluster Int-like for Object of SCMPDS;
end;

definition
  mode Int_position is Int-like Object of SCMPDS;
 canceled;
end;

canceled 2;

theorem 
  for l being Int_position holds Values l = INT;

begin 

reserve d1,d2,d3,d4,d5 for Element of SCM-Data-Loc,
  k1,k2,k3,k4,k5,k6 for
  Integer;

reserve I for Instruction of SCMPDS;

theorem 
  for I being Instruction of SCMPDS holds InsCode I <= 14;

registration
  let s be State of SCMPDS, d be Int_position;
  cluster s.d -> integer;
end;

definition
  let m,n be Integer;
  func DataLoc(m,n) -> Int_position equals

  [1,abs(m+n)];
end;

theorem 
  [14,{},<*k1*>] in SCMPDS-Instr;

theorem 
  [1,{},<*d1*>] in SCMPDS-Instr;

theorem 
  x in { 2,3 } implies [x,{},<*d2,k2*>] in SCMPDS-Instr;

theorem 
  x in { 4,5,6,7,8 } implies [x,{},<*d2,k3,k4*>] in SCMPDS-Instr;

theorem 
  x in { 9,10,11,12,13 } implies [x,{},<*d4,d5,k5,k6*>] in
  SCMPDS-Instr;

reserve a,b,c for Int_position;

definition
  let k1;
  func goto k1 -> Instruction of SCMPDS equals

  [14,{},<*k1*>];
end;

definition
  let a;
  func return a -> Instruction of SCMPDS equals

  [1,{},<*a*>];
end;

definition
  let a,k1;
  func a := k1 -> Instruction of SCMPDS equals

  [2,{},<*a,k1*>];
  func saveIC(a,k1) -> Instruction of SCMPDS equals

  [3,{},<*a,k1*>];
end;

definition
  let a,k1,k2;
  func (a,k1)<>0_goto k2 -> Instruction of SCMPDS equals

  [4,{},<*a,k1,k2*>];
  func (a,k1)<=0_goto k2 -> Instruction of SCMPDS equals

  [5,{},<*a,k1,k2*>];
  func (a,k1)>=0_goto k2 -> Instruction of SCMPDS equals

  [6,{},<*a,k1,k2*>];
  func (a,k1) := k2 -> Instruction of SCMPDS equals

  [7,{},<*a,k1,k2*>];
  func AddTo(a,k1,k2) -> Instruction of SCMPDS equals

  [8,{},<*a,k1,k2*>];
end;

definition
  let a,b,k1,k2;
  func AddTo(a,k1,b,k2) -> Instruction of SCMPDS equals

  [9,{},<*a,b,k1,k2*>];
  func SubFrom(a,k1,b,k2) -> Instruction of SCMPDS equals

  [10,{},<*a,b,k1,k2*>];
  func MultBy(a,k1,b,k2) -> Instruction of SCMPDS equals

  [11,{},<*a,b,k1,k2*>];
  func Divide(a,k1,b,k2) -> Instruction of SCMPDS equals

  [12,{},<*a,b,k1,k2*>];
  func (a,k1) := (b,k2) -> Instruction of SCMPDS equals

  [13,{},<*a,b,k1,k2*>];
end;

theorem 
  InsCode (goto k1) = 14;

theorem 
  InsCode (return a) = 1;

theorem 
  InsCode (a := k1) = 2;

theorem 
  InsCode (saveIC(a,k1)) = 3;

theorem 
  InsCode ((a,k1)<>0_goto k2) = 4;

theorem 
  InsCode ((a,k1)<=0_goto k2) = 5;

theorem 
  InsCode ((a,k1)>=0_goto k2) = 6;

theorem 
  InsCode ((a,k1) := k2) = 7;

theorem 
  InsCode (AddTo(a,k1,k2)) = 8;

theorem 
  InsCode (AddTo(a,k1,b,k2)) = 9;

theorem 
  InsCode (SubFrom(a,k1,b,k2)) = 10;

theorem 
  InsCode (MultBy(a,k1,b,k2)) = 11;

theorem 
  InsCode (Divide(a,k1,b,k2)) = 12;

theorem 
  InsCode ((a,k1) := (b,k2)) = 13;

theorem 
  for ins being Instruction of SCMPDS st InsCode ins = 14 holds ex k1 st
  ins = goto k1;

theorem 
  for ins being Instruction of SCMPDS st InsCode ins = 1 holds ex a st
  ins = return a;

theorem 
  for ins being Instruction of SCMPDS st InsCode ins = 2 holds ex a,k1
  st ins = a := k1;

theorem 
  for ins being Instruction of SCMPDS st InsCode ins = 3 holds ex a,k1
  st ins = saveIC(a,k1);

theorem 
  for ins being Instruction of SCMPDS st InsCode ins = 4 holds ex a,k1,
  k2 st ins = (a,k1)<>0_goto k2;

theorem 
  for ins being Instruction of SCMPDS st InsCode ins = 5 holds ex a,k1,
  k2 st ins = (a,k1)<=0_goto k2;

theorem 
  for ins being Instruction of SCMPDS st InsCode ins = 6 holds ex a,k1,
  k2 st ins = (a,k1)>=0_goto k2;

theorem 
  for ins being Instruction of SCMPDS st InsCode ins = 7 holds ex a,k1,
  k2 st ins = (a,k1) := k2;

theorem 
  for ins being Instruction of SCMPDS st InsCode ins = 8 holds ex a,k1,
  k2 st ins = AddTo(a,k1,k2);

theorem 
  for ins being Instruction of SCMPDS st InsCode ins = 9 holds ex a,b,k1
  ,k2 st ins = AddTo(a,k1,b,k2);

theorem 
  for ins being Instruction of SCMPDS st InsCode ins = 10 holds ex a,b,
  k1,k2 st ins = SubFrom(a,k1,b,k2);

theorem 
  for ins being Instruction of SCMPDS st InsCode ins = 11 holds ex a,b,
  k1,k2 st ins = MultBy(a,k1,b,k2);

theorem 
  for ins being Instruction of SCMPDS st InsCode ins = 12 holds ex a,b,
  k1,k2 st ins = Divide(a,k1,b,k2);

theorem 
  for ins being Instruction of SCMPDS st InsCode ins = 13 holds ex a,b,
  k1,k2 st ins = (a,k1) := (b,k2);

theorem 
  for s being State of SCMPDS, d being Int_position holds d in dom s;

theorem 
  for s being State of SCMPDS holds SCM-Data-Loc c= dom s;

theorem 
  for s being State of SCMPDS holds dom DataPart s = SCM-Data-Loc;

theorem 
  for dl being Int_position holds dl <> IC SCMPDS;

theorem 
  for s1,s2 being State of SCMPDS st IC s1 = IC s2
   & (for a being Int_position holds s1.a = s2.a)
   holds s1 = s2;

begin 

theorem 
  Exec( a:=k1, s).IC SCMPDS = succ IC s & Exec( a:=k1, s).a = k1 &
  for b st b <> a holds Exec( a:=k1, s).b = s.b;

theorem 
  Exec((a,k1):=k2, s).IC SCMPDS = succ IC s & Exec((a,k1):=k2, s).
DataLoc(s.a,k1) = k2 & for b st b <> DataLoc(s.a,k1) holds Exec((a,k1):=k2, s).
  b = s.b;

theorem 
  Exec((a,k1):=(b,k2), s).IC SCMPDS = succ IC s & Exec((a,k1):=(b,
  k2), s).DataLoc(s.a,k1) = s.DataLoc(s.b,k2) & for c st c <> DataLoc(s.a,k1)
  holds Exec((a,k1):=(b,k2),s).c = s.c;

theorem 
  Exec(AddTo(a,k1,k2), s).IC SCMPDS = succ IC s & Exec(AddTo(a,k1,
  k2), s).DataLoc(s.a,k1)=s.DataLoc(s.a,k1)+k2 & for b st b <>DataLoc(s.a,k1)
  holds Exec(AddTo(a,k1,k2), s).b = s.b;

theorem 
  Exec(AddTo(a,k1,b,k2), s).IC SCMPDS = succ IC s & Exec(AddTo(a,
k1,b,k2), s).DataLoc(s.a,k1) = s.DataLoc(s.a,k1) + s.DataLoc(s.b,k2) & for c st
  c <> DataLoc(s.a,k1) holds Exec(AddTo(a,k1,b,k2),s).c = s.c;

theorem 
  Exec(SubFrom(a,k1,b,k2), s).IC SCMPDS = succ IC s & Exec(SubFrom
(a,k1,b,k2), s).DataLoc(s.a,k1) = s.DataLoc(s.a,k1) - s.DataLoc(s.b,k2) & for c
  st c <> DataLoc(s.a,k1) holds Exec(SubFrom(a,k1,b,k2),s).c = s.c;

theorem 
  Exec(MultBy(a,k1,b,k2), s).IC SCMPDS = succ IC s & Exec(MultBy(a
  ,k1,b,k2), s).DataLoc(s.a,k1) = s.DataLoc(s.a,k1) * s.DataLoc(s.b,k2) & for c
  st c <> DataLoc(s.a,k1) holds Exec(MultBy(a,k1,b,k2),s).c = s.c;

theorem 
  Exec(Divide(a,k1,b,k2), s).IC SCMPDS = succ IC s & (DataLoc(s.a,
k1) <> DataLoc(s.b,k2) implies Exec(Divide(a,k1,b,k2), s).DataLoc(s.a,k1) = s.
DataLoc(s.a,k1) div s.DataLoc(s.b,k2)) & Exec(Divide(a,k1,b,k2), s).DataLoc(s.b
,k2) = s.DataLoc(s.a,k1) mod s.DataLoc(s.b,k2) & for c st c <> DataLoc(s.a,k1)
  & c <> DataLoc(s.b,k2) holds Exec(Divide(a,k1,b,k2),s).c = s.c;

theorem 
  Exec(Divide(a,k1,a,k1), s).IC SCMPDS = succ IC s & Exec(Divide(a,k1,a,
k1), s).DataLoc(s.a,k1) = s.DataLoc(s.a,k1) mod s.DataLoc(s.a,k1) & for c st c
  <> DataLoc(s.a,k1) holds Exec(Divide(a,k1,a,k1),s).c = s.c;

definition

  let s be State of SCMPDS,c be Integer;
  func ICplusConst(s,c) -> Element of NAT means


  ex m
  be Element of NAT st m = IC s & it = abs(m+c);
end;

theorem 
  Exec(goto k1, s).IC SCMPDS = ICplusConst(s,k1) & for a holds
  Exec(goto k1, s).a = s.a;

theorem 
  ( s.DataLoc(s.a,k1) <> 0 implies Exec((a,k1)<>0_goto k2, s).IC
  SCMPDS = ICplusConst(s,k2)) & ( s.DataLoc(s.a,k1) = 0 implies Exec((a,k1)
  <>0_goto k2, s).IC SCMPDS = succ IC s ) & Exec((a,k1)<>0_goto k2, s).b = s.b;

theorem 
  ( s.DataLoc(s.a,k1) <= 0 implies Exec((a,k1)<=0_goto k2, s).IC
  SCMPDS = ICplusConst(s,k2)) & ( s.DataLoc(s.a,k1) > 0 implies Exec((a,k1)
  <=0_goto k2, s).IC SCMPDS = succ IC s ) & Exec((a,k1)<=0_goto k2, s).b = s.b;

theorem 
  ( s.DataLoc(s.a,k1) >= 0 implies Exec((a,k1)>=0_goto k2, s).IC
  SCMPDS = ICplusConst(s,k2)) & ( s.DataLoc(s.a,k1) < 0 implies Exec((a,k1)
  >=0_goto k2, s).IC SCMPDS = succ IC s ) & Exec((a,k1)>=0_goto k2, s).b = s.b;

theorem 
  Exec(return a, s).IC SCMPDS = (abs(s.DataLoc(s.a,RetIC)))+2 &
Exec(return a, s).a = s.DataLoc(s.a,RetSP) & for b st a <> b holds Exec(return
  a, s).b = s.b;

theorem 
  Exec(saveIC(a,k1),s).IC SCMPDS = succ IC s & Exec(saveIC(a,k1),
s).DataLoc(s.a,k1) = IC s & for b st DataLoc(s.a,k1) <> b holds Exec(saveIC(a,
  k1), s).b = s.b;

canceled;

theorem 
  for k be Integer holds ex s be State of SCMPDS st for d being
  Int_position holds s.d = k;

theorem 
  for k be Integer,loc be Element of NAT holds ex
  s be State of SCMPDS st s.NAT=loc & for d being Int_position holds s.d = k;

theorem 
  for I being Instruction of SCMPDS st I = [0,{},{}]
  holds I is halting;

theorem 
  for I being Instruction of SCMPDS st ex s st Exec(I,s).IC SCMPDS
  = succ IC s holds I is non halting;

theorem 
  a:=k1 is non halting;

theorem 
  (a,k1):=k2 is non halting;

theorem 
  (a,k1):=(b,k2) is non halting;

theorem 
  AddTo(a,k1,k2) is non halting;

theorem 
  AddTo(a,k1,b,k2) is non halting;

theorem 
  SubFrom(a,k1,b,k2) is non halting;

theorem 
  MultBy(a,k1,b,k2) is non halting;

theorem 
  Divide(a,k1,b,k2) is non halting;

theorem 
  k1 <> 0 implies goto k1 is non halting;

theorem 
  (a,k1)<>0_goto k2 is non halting;

theorem 
  (a,k1)<=0_goto k2 is non halting;

theorem 
  (a,k1)>=0_goto k2 is non halting;

theorem 
  return a is non halting;

theorem 
  saveIC(a,k1) is non halting;

theorem 
  for I being set holds I is Instruction of SCMPDS implies
   I = [0,{},{}] or
   (ex k1 st I
= goto k1) or (ex a st I = return a) or (ex a,k1 st I = saveIC(a,k1)) or (ex a,
k1 st I = a:=k1) or (ex a,k1,k2 st I = (a,k1):=k2) or (ex a,k1,k2 st I = (a,k1)
<>0_goto k2) or (ex a,k1,k2 st I = (a,k1)<=0_goto k2) or (ex a,k1,k2 st I = (a,
k1)>=0_goto k2) or (ex a,b,k1,k2 st I = AddTo(a,k1,k2)) or (ex a,b,k1,k2 st I =
AddTo(a,k1,b,k2)) or (ex a,b,k1,k2 st I = SubFrom(a,k1,b,k2)) or (ex a,b,k1,k2
st I = MultBy(a,k1,b,k2)) or (ex a,b,k1,k2 st I = Divide(a,k1,b,k2)) or ex a,b,
  k1,k2 st I = (a,k1):=(b,k2);





































































registration
  cluster SCMPDS -> halting;
end;













theorem 
  halt SCMPDS = [0,{},{}];

canceled;

theorem 
  for i being Element of NAT holds IC SCMPDS <> dl.i;

canceled;

theorem 
  Data-Locations SCMPDS = SCM-Data-Loc;

canceled;

theorem 
 InsCode I = 0 implies Exec(I,s) = s;














begin 

reserve j, k, m, n for Element of NAT,
  a,b for Int_position,
  k1,k2 for Integer;

reserve P,P1,P2 for Instruction-Sequence of SCMPDS;

theorem 
  for k1 be Integer,s1,s2 being State of SCMPDS st IC s1 = IC s2
  holds ICplusConst(s1,k1)=ICplusConst(s2,k1);

theorem 
  for k1 be Integer,a be Int_position,s1,s2 being State of SCMPDS
  st DataPart s1 = DataPart s2 holds s1.DataLoc(s1.a,k1)=s2.DataLoc(s2.a,k1);

theorem 
  for a be Int_position,s1,s2 being State of SCMPDS st DataPart s1
  = DataPart s2 holds s1.a=s2.a;

theorem 
  not IC SCMPDS in SCM-Data-Loc;

begin 

canceled;

theorem 
  for s being State of SCMPDS ,iloc being Element of NAT
  , a being Int_position holds s.a = (s +* Start-At(iloc,SCMPDS)).a;

theorem 
  for s, t being State of SCMPDS holds s +* t|(SCM-Data-Loc ) is State
  of SCMPDS;

begin 

definition
  let la be Int_position;
  let a be Integer;
  redefine func la .--> a -> FinPartState of SCMPDS;
end;

registration
 cluster SCMPDS -> IC-recognized;
end;

theorem 
  for s1,s2 being State of SCMPDS,k1,k2,m be Integer st IC s1= IC
  s2 & k1 <> k2 & m=IC s1 & m+k1 >= 0 & m+k2 >= 0 holds ICplusConst(s1,k1) <>
  ICplusConst(s2,k2);

theorem 
  for s1,s2 being State of SCMPDS,k1,k2 be Element of NAT st IC s1
  = IC s2 & k1 <> k2 holds ICplusConst(s1,k1) <> ICplusConst(s2,k2);

theorem 
  for s being State of SCMPDS holds succ IC s= ICplusConst(s,1);

registration
 cluster SCMPDS -> CurIns-recognized;
end;

theorem 
  for q be non halt-free finite
   (the InstructionsF of SCMPDS)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCMPDS, s1, s2
being State of SCMPDS st  p c= s1 &  p c= s2 &
 q c= P1 & q c= P2
 for i being Element of NAT,k1,k2 be
Integer,a,b be Int_position st CurInstr(P1,
Comput(P1,s1,i)) = (a,k1) := (b,k2)
& a in dom p & DataLoc(Comput(P1,s1,i).a,k1) in dom p holds Comput
(P1,s1,i)
.DataLoc(Comput(P1,s1,i).b,k2) = Comput(P2,s2,i).
DataLoc(Comput(P2,s2,i).b,k2);

theorem 
  for q be non halt-free finite
   (the InstructionsF of SCMPDS)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCMPDS, s1, s2
being State of SCMPDS st  p c= s1 &  p c= s2  &
 q c= P1 & q c= P2
for i being Element of NAT,k1,k2 be
Integer,a,b be Int_position st CurInstr(P1,
Comput(P1,s1,i)) = AddTo(a,k1,b,k2)
& a in dom p & DataLoc(Comput(P1,s1,i).a,k1) in dom p holds Comput
(P1,s1,i)
.DataLoc(Comput(P1,s1,i).b,k2) = Comput(P2,s2,i).
DataLoc(Comput(P2,s2,i).
  b,k2);

theorem 
  for q be non halt-free finite
   (the InstructionsF of SCMPDS)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCMPDS, s1, s2
being State of SCMPDS st  p c= s1 &  p c= s2 &
 q c= P1 & q c= P2
for i being Element of NAT,k1,k2 be
Integer,a,b be Int_position st CurInstr(P1,
Comput(P1,s1,i)) = SubFrom(a,k1,b,k2
) & a in dom p & DataLoc(Comput(P1,s1,i).a,k1) in dom p holds
Comput(P1,s1,
i).DataLoc(Comput(P1,s1,i).b,k2) = Comput(P2,s2,i).
DataLoc(Comput(P2,s2,i
  ).b,k2);

theorem 
  for q be non halt-free finite
   (the InstructionsF of SCMPDS)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCMPDS, s1, s2
being State of SCMPDS st  p c= s1 &  p c= s2 &
 q c= P1 & q c= P2
for i being Element of NAT,k1,k2 be
Integer,a,b be Int_position st CurInstr(P1,
Comput(P1,s1,i)) = MultBy(a,k1,b,k2)
& a in dom p & DataLoc(Comput(P1,s1,i).a,k1) in dom p holds Comput
(P1,s1,i)
.DataLoc(Comput(P1,s1,i).a,k1) * Comput(P1,s1,i).
DataLoc(Comput(P1,s1,i).
b,k2) = Comput(P2,s2,i).DataLoc(Comput(P2,s2,i).a,k1)
* Comput(P2,s2,i).
  DataLoc(Comput(P2,s2,i).b,k2);

theorem 
  for q be non halt-free finite
   (the InstructionsF of SCMPDS)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCMPDS, s1, s2
being State of SCMPDS st  p c= s1 &  p c= s2  &
 q c= P1 & q c= P2
for i,m being Element of NAT,a being
Int_position,k1,k2 be Integer st CurInstr(P1,
Comput(P1,s1,i)) = (a,k1)<>0_goto
  k2 & m= IC Comput(P1,s1,i) & m+k2 >= 0 & k2 <> 1 holds (Comput(
P1,s1,i).
DataLoc(Comput(P1,s1,i).a,k1) = 0 iff Comput(P2,s2,i)
.DataLoc(Comput(P2,s2,i).a,k1) = 0 );

theorem 
  for q be non halt-free finite
   (the InstructionsF of SCMPDS)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCMPDS, s1, s2
being State of SCMPDS st  p c= s1 &  p c= s2 &
 q c= P1 & q c= P2
for i,m being Element of NAT,a being
Int_position,k1,k2 be Integer st CurInstr(P1,
Comput(P1,s1,i)) = (a,k1)<=0_goto
  k2 & m= IC Comput(P1,s1,i) & m+k2 >= 0 & k2 <> 1 holds (Comput(
P1,s1,i).
DataLoc(Comput(P1,s1,i).a,k1) > 0 iff Comput(P2,s2,i)
.DataLoc(Comput(P2,
  s2,i).a,k1) > 0 );

theorem 
  for q be non halt-free finite
   (the InstructionsF of SCMPDS)-valued NAT-defined Function
  for p being q-autonomic non empty FinPartState of SCMPDS, s1, s2
being State of SCMPDS st  p c= s1 &  p c= s2  &
 q c= P1 & q c= P2
for i,m being Element of NAT,a being
Int_position,k1,k2 be Integer st CurInstr(P1,
Comput(P1,s1,i)) = (a,k1)>=0_goto
  k2 & m= IC Comput(P1,s1,i) & m+k2 >= 0 & k2 <> 1 holds (Comput(
P1,s1,i).
DataLoc(Comput(P1,s1,i).a,k1) < 0 iff Comput(P2,s2,i)
.DataLoc(Comput(P2,
  s2,i).a,k1) < 0 );















begin 

reserve l, m, n for Element of NAT,
  i,j,k for Instruction of SCMPDS,
  I,J,K for Program of SCMPDS,
  p,q,r for PartState of SCMPDS;

reserve a,b,c for Int_position,
  s,s1,s2 for State of SCMPDS,
  k1,k2 for Integer;



theorem 
  InsCode i in {0,1,4,5,6,14} or Exec(i,s).IC SCMPDS = succ IC s;

theorem 
  for s1,s2 being State of SCMPDS st IC s1 = IC s2 & for a being
  Int_position holds s1.a = s2.a holds  s1 =  s2;



theorem 
  for k1,k2 be Element of NAT st k1 <> k2 holds DataLoc(k1,0) <>
  DataLoc(k2,0);

theorem 
  for dl being Int_position ex i being Element of NAT st dl =
  DataLoc(i,0);

scheme 

  SCMPDSEx{ G(set) -> Integer, I() ->
  Element of NAT }: ex S being State of SCMPDS st IC S = I() &
  for i being Element of NAT holds S.DataLoc(i,0) = G(i);

theorem 
  for s being State of SCMPDS holds dom s = {IC SCMPDS} \/ SCM-Data-Loc;

theorem 
  for s being State of SCMPDS, x being set st x in dom s holds x is
  Int_position or x = IC SCMPDS;

canceled;

theorem 
  for s1,s2 being State of SCMPDS holds (for a being Int_position
  holds s1.a = s2.a) iff DataPart s1 = DataPart s2;



reserve x for set;

begin 

notation
  let I,J be Program of SCMPDS;
  synonym I ';' J for I ^ J;
end;

definition

  let I,J be Program of SCMPDS;
  redefine func I ';' J -> Program of SCMPDS equals

  I +* Shift(J, card I);
end;

begin 

definition
  let i, J;
  func i ';' J -> Program of SCMPDS equals

  Load i ';' J;
end;

definition
  let I, j;
  func I ';' j -> Program of SCMPDS equals

  I ';' Load j;
end;

definition
  let i,j;
  func i ';' j -> Program of SCMPDS equals

  Load i ';' Load j;
end;



theorem 
  i ';' j = Load i ';' j;

theorem 
  i ';' j = i ';' Load j;



theorem 
  I ';' J ';' k = I ';' (J ';' k);

theorem 
  I ';' j ';' K = I ';' (j ';' K);

theorem 
  I ';' j ';' k = I ';' (j ';' k);

theorem 
  i ';' J ';' K = i ';' (J ';' K);

theorem 
  i ';' J ';' k = i ';' (J ';' k);

theorem 
  i ';' j ';' K = i ';' (j ';' K);

theorem 
  i ';' j ';' k = i ';' (j ';' k);



reserve l,l1,loc for Element of NAT;

theorem 
  not a in dom Start-At(l,SCMPDS);

definition
  let s be State of SCMPDS, li be Int_position, k be Integer;
  redefine func s+*(li,k) -> PartState of SCMPDS;
end;

begin 

definition

  let I be Program of SCMPDS, s be State of SCMPDS;
  let P be Instruction-Sequence of SCMPDS;
  func IExec(I,P,s) -> State of SCMPDS equals

  Result(P+*stop I,s);
end;

definition
  let I be Program of SCMPDS;
  attr I is paraclosed means


  for s being 0-started State of SCMPDS, n being Element of NAT,
      P being Instruction-Sequence of SCMPDS
    st stop I c= P
   holds IC Comput(P,s,n) in dom stop(I);
  attr I is parahalting means


  for s being 0-started State of SCMPDS,
      P being Instruction-Sequence of SCMPDS
    st stop I c= P
    holds P halts_on s;
end;

registration
  cluster parahalting for Program of SCMPDS;
end;

canceled;

theorem 
 for P,Q being Instruction-Sequence of SCMPDS
  st Q = P +*((IC s,succ IC s) --> (goto 1, goto -1))
 holds
  not Q halts_on s;

theorem 
 for P1,P2 being Instruction-Sequence of SCMPDS
  st  s1 =  s2 & I c= P1 & I c= P2 & (for m st m < n
  holds IC (Comput(P2,s2,m)) in dom I)
 for m st m <= n
holds
   Comput(P1,s1,m) =  Comput(P2,s2,m);

reserve l1,l2 for Element of NAT,
  i1,i2 for Instruction of SCMPDS;

registration
  cluster parahalting -> paraclosed for Program of SCMPDS;
end;

begin 

definition
  let i be Instruction of SCMPDS;
  let n be Element of NAT;
  pred i valid_at n means


  (InsCode i= 14 implies ex k1 st i = goto k1 &
  n+k1 >= 0) & (InsCode i= 4 implies ex a,k1,k2 st i = (a,k1)<>0_goto k2 & n+k2
>= 0 ) & (InsCode i= 5 implies ex a,k1,k2 st i = (a,k1)<=0_goto k2 & n+k2 >= 0
  ) & (InsCode i= 6 implies ex a,k1,k2 st i = (a,k1)>=0_goto k2 & n+k2 >= 0);
end;

reserve l for Element of NAT;

definition
  let IT be finite (the InstructionsF of SCMPDS)-valued NAT-defined Function;
  attr IT is shiftable means


  for n,i st  n in dom IT & i=IT.(n)
   holds InsCode i <> 1 & InsCode i <> 3 & i valid_at n;
end;

theorem 
  for i be Instruction of SCMPDS,m,n be Element of NAT st i
  valid_at m & m <= n holds i valid_at n;

registration
  cluster parahalting shiftable for Program of SCMPDS;
end;

definition
  let i be Instruction of SCMPDS;
  attr i is shiftable means


  InsCode i = 2 or InsCode i <> 14 & InsCode i > 6;
end;

registration
  cluster shiftable for Instruction of SCMPDS;
end;

registration
  let a,k1;
  cluster a := k1 -> shiftable;
end;

registration
  let a,k1,k2;
  cluster (a,k1) := k2 -> shiftable;
end;

registration
  let a,k1,k2;
  cluster AddTo(a,k1,k2) -> shiftable;
end;

registration
  let a,b,k1,k2;
  cluster AddTo(a,k1,b,k2) -> shiftable;
  cluster SubFrom(a,k1,b,k2) -> shiftable;
  cluster MultBy(a,k1,b,k2) -> shiftable;
  cluster Divide(a,k1,b,k2) -> shiftable;
  cluster (a,k1) := (b,k2) -> shiftable;
end;

registration
  let I,J be shiftable Program of SCMPDS;
  cluster I ';' J -> shiftable for Program of SCMPDS;
end;

registration
  let i be shiftable Instruction of SCMPDS;
  cluster Load i -> shiftable for Program of SCMPDS;
end;

registration
  let i be shiftable Instruction of SCMPDS, J be shiftable Program of SCMPDS;
  cluster i ';' J -> shiftable;
end;

registration
  let I be shiftable Program of SCMPDS, j be shiftable Instruction of SCMPDS;
  cluster I ';' j -> shiftable;
end;

registration
  let i,j be shiftable Instruction of SCMPDS;
  cluster i ';' j -> shiftable;
end;

registration
  cluster Stop SCMPDS -> parahalting shiftable;
end;

registration
  let I be shiftable Program of SCMPDS;
  cluster stop I -> shiftable;
end;

theorem 
  for I being shiftable Program of SCMPDS,k1 be Integer st card I + k1
  >= 0 holds I ';' goto k1 is shiftable;

registration
  let n be Element of NAT;
  cluster Load goto n -> shiftable for Program of SCMPDS;
end;

theorem 
  for I being shiftable Program of SCMPDS,k1,k2 be Integer,a be
  Int_position st card I + k2 >= 0 holds I ';' (a,k1)<>0_goto k2 is shiftable;

registration
  let k1 be Integer,a be Int_position,n be Element of NAT;
  cluster Load (a,k1)<>0_goto n -> shiftable for Program of SCMPDS;
end;

theorem 
  for I being shiftable Program of SCMPDS,k1,k2 be Integer,a be
  Int_position st card I + k2 >= 0 holds I ';' (a,k1)<=0_goto k2 is shiftable;

registration
  let k1 be Integer,a be Int_position,n be Element of NAT;
  cluster Load (a,k1)<=0_goto n -> shiftable for Program of SCMPDS;
end;

theorem 
  for I being shiftable Program of SCMPDS,k1,k2 be Integer,a be
  Int_position st card I + k2 >= 0 holds I ';' (a,k1)>=0_goto k2 is shiftable;

registration
  let k1 be Integer,a be Int_position,n be Element of NAT;
  cluster Load (a,k1)>=0_goto n -> shiftable for Program of SCMPDS;
end;

theorem 
  for s1,s2 being State of SCMPDS, n,m being Element of NAT,k1 be
Integer st IC s1= m & m+k1>=0 & IC s1 + n = IC s2
 holds ICplusConst(s1,k1) +n = ICplusConst(s2,k1);

theorem 
  for s1,s2 being State of SCMPDS, n,m being Element of NAT, i
being Instruction of SCMPDS holds IC s1= m & i valid_at m & InsCode i <>
  1 & InsCode i <> 3 & IC s1 + n = IC s2 & DataPart s1 = DataPart s2 implies
  IC Exec(i,s1) + n = IC Exec(i,s2) & DataPart Exec(i,s1) = DataPart Exec(i,s2)
;

theorem 
  for P1,P2 being Instruction-Sequence of SCMPDS
  for s1 being 0-started State of SCMPDS
  for J being parahalting shiftable Program of SCMPDS st stop J c= P1
  for n being Element of NAT st Shift(stop J,n) c= P2 &
    IC s2 = n & DataPart s1 = DataPart s2
  for i being Element of NAT holds
   IC Comput(P1,s1,i) + n = IC Comput(P2,s2,i) &
    CurInstr(P1,Comput(P1,s1,i)) =
     CurInstr(P2,Comput(P2,s2,i)) &
    DataPart Comput(P1,s1,i) = DataPart
       Comput(P2,s2,i);















begin 

reserve x for set,
  m,n for Element of NAT,
  a,b,c for Int_position,
  i for Instruction of SCMPDS,
  s,s1,s2 for State of SCMPDS,
  k1,k2 for Integer,
  loc,l1 for Element of NAT,
  I,J for Program of SCMPDS,
  N for with_non-empty_elements set;

canceled 11;

theorem 
  for I,J being Program of SCMPDS holds I c= stop (I ';' J);

theorem 
  dom stop I c= dom stop (I ';' J);

theorem 
  for I,J being Program of SCMPDS holds
   stop I +* stop (I ';' J) = stop (I ';' J);

theorem 
  (Initialize s).a = s.a;

reserve P,P1,P2,Q for Instruction-Sequence of SCMPDS;

theorem 
  for s being 0-started State of SCMPDS
  for I being parahalting Program of SCMPDS
    st stop I c= P1 & stop I c= P2
  for k being Element of NAT holds
    Comput(P1,s,k) =  Comput(P2,s,k) &
   CurInstr(P1,Comput(P1,s,k)) = CurInstr(P2,Comput(P2,s,k));

theorem 
  for s being 0-started State of SCMPDS
  for I being parahalting Program of SCMPDS
   st stop I c= P1 & stop I c= P2
  holds LifeSpan(P1,s) = LifeSpan(P2,s) &
   Result(P1,s) =  Result(P2,s);

canceled;

theorem 
  for s being 0-started State of SCMPDS
  for I being parahalting Program of SCMPDS, J being Program of SCMPDS
   st stop I c= P
  for m st m <= LifeSpan(P,s)
   holds  Comput(P,s,m) =  Comput(P+*(I ';' J),s,m);

theorem 
 for s being 0-started State of SCMPDS
 for I being parahalting Program of SCMPDS, J being Program of SCMPDS
   st stop I c= P
 for m st m <= LifeSpan(P,s)
 holds  Comput(P,s,m) =  Comput(P+*stop(I ';' J), s,m);

begin 

definition
 canceled;
  let i be Instruction of SCMPDS;
  attr i is parahalting means


  Load i is parahalting;
end;

registration
  cluster No-StopCode shiftable parahalting for Instruction of SCMPDS;
end;

theorem 
  goto k1 is No-StopCode;

registration
  let a;
  cluster return a -> No-StopCode;
end;

registration
  let a,k1;
  cluster a := k1 -> No-StopCode;
  cluster saveIC(a,k1) -> No-StopCode;
end;

registration
  let a,k1,k2;
  cluster (a,k1)<>0_goto k2 -> No-StopCode;
  cluster (a,k1)<=0_goto k2 -> No-StopCode;
  cluster (a,k1)>=0_goto k2 -> No-StopCode;
  cluster (a,k1) := k2 -> No-StopCode;
end;

registration
  let a,k1,k2;
  cluster AddTo(a,k1,k2) -> No-StopCode;
end;

registration
  let a,b,k1,k2;
  cluster AddTo(a,k1,b,k2) -> No-StopCode;
  cluster SubFrom(a,k1,b,k2) -> No-StopCode;
  cluster MultBy(a,k1,b,k2) -> No-StopCode;
  cluster Divide(a,k1,b,k2) -> No-StopCode;
  cluster (a,k1) := (b,k2) -> No-StopCode;
end;

registration
  cluster halt SCMPDS -> parahalting;
end;

registration
  let i be parahalting Instruction of SCMPDS;
  cluster Load i -> parahalting for Program of SCMPDS;
end;

registration
  let a,k1;
  cluster a := k1 -> parahalting;
end;

registration
  let a,k1,k2;
  cluster (a,k1) := k2 -> parahalting;
  cluster AddTo(a,k1,k2) -> parahalting;
end;

registration
  let a,b,k1,k2;
  cluster AddTo(a,k1,b,k2) -> parahalting;
  cluster SubFrom(a,k1,b,k2) -> parahalting;
  cluster MultBy(a,k1,b,k2) -> parahalting;
  cluster Divide(a,k1,b,k2) -> parahalting;
  cluster (a,k1) := (b,k2) -> parahalting;
end;

theorem 
  InsCode i =1 implies i is not parahalting;

registration
  cluster parahalting shiftable halt-free for Program of SCMPDS;
end;

registration
  let I,J be halt-free Program of SCMPDS;
  cluster I ';' J -> halt-free;
end;

registration 

  let i be No-StopCode Instruction of SCMPDS;
  cluster Load i -> halt-free;
end;

registration
  let i be No-StopCode Instruction of SCMPDS, J be halt-free Program of
  SCMPDS;
  cluster i ';' J -> halt-free;
end;

registration
  let I be halt-free Program of SCMPDS, j be No-StopCode Instruction of
  SCMPDS;
  cluster I ';' j -> halt-free;
end;

registration
  let i,j be No-StopCode Instruction of SCMPDS;
  cluster i ';' j -> halt-free;
end;

theorem 
  for s being 0-started State of SCMPDS
  for I being parahalting halt-free Program of SCMPDS st stop I c= P
   holds IC Comput(P, s,LifeSpan(P +* stop I,s)) =  card I;

theorem 
 for s being 0-started State of SCMPDS
  for I being parahalting Program of SCMPDS,k be Element of NAT st
     k < LifeSpan(P +* stop I,s)
 holds IC Comput(P +* stop I,s,k) in dom I;

theorem 
  for s being 0-started State of SCMPDS
  for I being parahalting Program of SCMPDS,k be Element of NAT st
    I c= P & k <= LifeSpan(P +* stop I,s)
   holds Comput(P, s,k) = Comput(P +* stop I,s,k);

theorem 
  for s being 0-started State of SCMPDS
  for I being parahalting halt-free Program of SCMPDS st I c= P
   holds IC Comput(P,s,LifeSpan(P +* stop I,s)) =  card I;

theorem 
  for s being 0-started State of SCMPDS
  for I being parahalting Program of SCMPDS st I c= P
  holds CurInstr(P,Comput(P, s,LifeSpan(P +* stop I,s))) = halt SCMPDS
    or IC Comput(P, s,LifeSpan(P +* stop I,s)) = card I;

theorem 
  for s being 0-started State of SCMPDS
  for I being parahalting halt-free Program of SCMPDS,k being Element of NAT
   st I c= P & k < LifeSpan(P +* stop I,s)
  holds CurInstr(P,Comput(P,s,k)) <> halt SCMPDS;

theorem 
 for s being 0-started State of SCMPDS
  for I being parahalting Program of SCMPDS,
      J being Program of SCMPDS, k being Element of NAT
   st k <= LifeSpan(P +* stop I,s)
 holds Comput(P +* stop I,s,k) = Comput(P+*(I ';' J),s,k);

theorem 
  for s being 0-started State of SCMPDS
  for I being parahalting Program of SCMPDS,J being Program of SCMPDS,
      k being Element of NAT st k <= LifeSpan(P +* stop I,s)
  holds  Comput(P +* stop I, s,k) =  Comput(P+*stop(I ';' J),s,k);

registration
  let I be parahalting Program of SCMPDS,
      J be parahalting shiftable Program of SCMPDS;
  cluster I ';' J -> parahalting for Program of SCMPDS;
end;

registration
  let i be parahalting Instruction of SCMPDS, J be parahalting shiftable
  Program of SCMPDS;
  cluster i ';' J -> parahalting;
end;

registration
  let I be parahalting Program of SCMPDS, j be parahalting shiftable
  Instruction of SCMPDS;
  cluster I ';' j -> parahalting;
end;

registration
  let i be parahalting Instruction of SCMPDS, j be parahalting shiftable
  Instruction of SCMPDS;
  cluster i ';' j -> parahalting;
end;

theorem 
  for s being State of SCMPDS, s1 being 0-started State of SCMPDS,
      J being parahalting shiftable Program of SCMPDS
    st stop J c= P & s = Comput(P1 +* stop J, s1,m)
  holds Exec(CurInstr(P,s),IncIC(s,n)) = IncIC(Following(P,s),n);

begin 

theorem 
  for s being 0-started State of SCMPDS
  for I being parahalting halt-free Program of SCMPDS,J being
  parahalting shiftable Program of SCMPDS,k being Element of NAT st
  stop (I ';' J) c= P holds
   IncIC(Comput(P +* stop I +* stop J,
     Initialize Result(P +* stop I,s),k),card I)
  =  Comput(P+*stop(I ';' J),s,LifeSpan(P +* stop I,s)+k);

theorem 
  for s being 0-started State of SCMPDS
  for I being parahalting halt-free Program of SCMPDS,
      J being parahalting shiftable Program of SCMPDS holds
  LifeSpan(P+*stop(I ';' J), s)
   = LifeSpan(P +* stop I,s) +
     LifeSpan(P +* stop I +* stop J,Initialize Result(P +* stop I,s));

theorem 
  for s being 0-started State of SCMPDS
  for I being parahalting halt-free Program of SCMPDS,J being
parahalting shiftable Program of SCMPDS holds IExec(I ';' J,P,s)
 = IncIC(IExec(J,P,Initialize IExec(I,P,s)),card I);

theorem 
 for s being 0-started State of SCMPDS
 for I being parahalting halt-free Program of SCMPDS,J being
  parahalting shiftable Program of SCMPDS holds IExec(I ';' J,P,s).a
   = IExec(J,P,Initialize IExec(I,P,s)).a;

begin 

canceled;

theorem 
 s1 | (SCM-Data-Loc \/ {IC SCMPDS})
  = s2 | (SCM-Data-Loc \/ {IC SCMPDS}) implies s1 =  s2;

theorem 
  DataPart s1 = DataPart s2 & InsCode i <> 3 implies
   DataPart Exec(i,s1) = DataPart Exec(i,s2);

theorem 
  for i being shiftable Instruction of SCMPDS holds (DataPart s1 =
  DataPart s2 implies DataPart Exec(i,s1) = DataPart Exec(i,s2));

theorem 
 for s being 0-started State of SCMPDS
  for i being parahalting Instruction of SCMPDS
   holds Exec(i,s) = IExec(Load i,P,s);

theorem 
 for s being 0-started State of SCMPDS
  for I being parahalting halt-free Program of SCMPDS,
      j being parahalting shiftable Instruction of SCMPDS
 holds IExec(I ';' j,P,s).a = Exec(j,IExec(I,P,s)).a;

theorem 
  for s being 0-started State of SCMPDS
  for i being No-StopCode parahalting Instruction of SCMPDS,
      j being shiftable parahalting Instruction of SCMPDS
 holds IExec(i ';' j,P,s).a = Exec(j,Exec(i, s)).a;















begin 

reserve m,n for Element of NAT,
  a for Int_position,
  i,j for Instruction of SCMPDS,
  s,s1,s2 for State of SCMPDS,
  k1 for Integer,
  loc for Element of NAT,
  I,J,K for Program of SCMPDS;

reserve P,P1,P2 for Instruction-Sequence of SCMPDS;

canceled 5;

theorem 
  card (i ';' I)= card I + 1;

theorem 
  (i ';' I). 0=i;

canceled 3;

theorem 
  CurInstr(P +* stop(i ';' I),Initialize s) = i;

theorem 
  for s being State of SCMPDS,m1,m2 being Element of NAT st IC s=
   m1 holds ICplusConst(s,m2)= m1+m2;

theorem 
  for I,J being Program of SCMPDS holds Shift(stop J,card I) c=
  stop(I ';' J);

canceled;

theorem 
  for s being 0-started State of SCMPDS, i being No-StopCode parahalting
Instruction of SCMPDS,J being parahalting shiftable Program of SCMPDS, a being
  Int_position
     holds IExec(i ';' J,P,s).a = IExec(J,P,Initialize Exec(i,s)).a;

theorem 
  for a being Int_position,k1,k2 being Integer holds (a,k1)
  <>0_goto k2 <> halt SCMPDS;

theorem 
  for a being Int_position,k1,k2 being Integer
   holds (a,k1) <=0_goto k2 <> halt SCMPDS;

theorem 
  for a being Int_position,k1,k2 being Integer
   holds (a,k1) >=0_goto k2 <> halt SCMPDS;

definition
  let k1;
  func Goto k1 -> Program of SCMPDS equals

  Load goto k1;
end;

registration
  let n be Element of NAT;
  cluster goto (n+1) -> No-StopCode;
  cluster goto -(n+1) -> No-StopCode;
end;

registration
  let n be Element of NAT;
  cluster Goto (n+1) -> halt-free;
  cluster Goto -(n+1) -> halt-free;
end;



theorem 
   0 in dom Goto k1 & (Goto k1). 0 = goto k1;

begin 

definition
  let I be Program of SCMPDS;
  let s be State of SCMPDS;
  let P;
  pred I is_closed_on s,P means


  for k being Element of NAT holds
   IC Comput(P+*stop I,Initialize s,k) in dom stop I;
  pred I is_halting_on s,P means


  P+*stop I halts_on Initialize s;
end;

theorem 
  for I being Program of SCMPDS holds I is paraclosed iff
  for s being State of SCMPDS, P holds I is_closed_on s,P;

theorem 
  for I being Program of SCMPDS holds I is parahalting iff
   for s being State of SCMPDS,P holds I is_halting_on s,P;

theorem 
  for s1,s2 being State of SCMPDS, I being Program of SCMPDS st
  DataPart s1 = DataPart s2 holds I is_closed_on s1,P1
   implies I is_closed_on s2,P2;

theorem 
  for s1,s2 being State of SCMPDS,I being Program of SCMPDS st DataPart
  s1 = DataPart s2 holds I is_closed_on s1,P1 & I is_halting_on s1,P1
   implies I is_closed_on s2,P2 & I is_halting_on s2,P2;

theorem 
  for s being State of SCMPDS, I,J being Program of SCMPDS holds I
  is_closed_on s,P iff I is_closed_on Initialize s,P+*J;

theorem 
 for s being 0-started State of SCMPDS
  for I,J being Program of SCMPDS
   st I is_closed_on s,P & I is_halting_on s,P
  holds (for k being Element of NAT
    st k <= LifeSpan(P +* stop I,s) holds
     IC Comput(P +* stop I,s,k) = IC Comput(P +* stop(I ';' J),s,k)) &
      DataPart Comput(P +* stop I,s,LifeSpan(P +* stop I,s)) =
    DataPart Comput(P +* stop(I ';' J),s,LifeSpan(P +* stop I,s));

theorem 
  for I being Program of SCMPDS,k be Element of NAT st I
  is_closed_on s,P & I is_halting_on s,P &
    k < LifeSpan(P +* stop I,Initialize s)
  holds IC Comput(P +* stop I,Initialize s,k) in dom I;

theorem 
  for I,J being Program of SCMPDS,
      s being 0-started State of SCMPDS, k being
  Element of NAT st I is_closed_on s,P & I is_halting_on s,P &
   k < LifeSpan(P +* stop I,s)
 holds CurInstr(P +* stop I, Comput(P +* stop I, s,k)) =
  CurInstr(P +* stop(I ';' J),Comput(P +* stop(I ';' J),s,k));

theorem 
  for I being halt-free Program of SCMPDS,s being State of
  SCMPDS, k being Element of NAT st I is_closed_on s,P &
  I is_halting_on s,P & k <
  LifeSpan(P +* stop I,Initialize s)
   holds
  CurInstr(P +* stop I,Comput(P +* stop I,Initialize s,k)) <> halt SCMPDS;

theorem 
  for I being halt-free Program of SCMPDS,s being State of
  SCMPDS st I is_closed_on s,P & I is_halting_on s,P
  holds IC Comput(P +* stop I, Initialize s,
    LifeSpan(P +* stop I,Initialize s)) =  card I;

theorem 
  for I,J being Program of SCMPDS,
      s being 0-started State of SCMPDS st I
  is_closed_on s,P & I is_halting_on s,P holds I ';' Goto (card J + 1) ';' J
  is_halting_on s,P & I ';' Goto (card J + 1) ';' J is_closed_on s,P;

theorem 
 for s1 being 0-started State of SCMPDS
  for I being shiftable Program of SCMPDS
    st stop I c= P1 & I is_closed_on s1,P1
  for n being Element of NAT st
   Shift(stop I,n) c= P2 & IC
  s2 =  n & DataPart s1 = DataPart s2 for i being Element of NAT holds IC
Comput(P1, s1,i) + n = IC Comput(P2, s2,i) &
 CurInstr(P1,Comput(P1,s1,i)) = CurInstr(P2,Comput(P2,s2,i)) &
  DataPart Comput(P1, s1,i) = DataPart Comput(P2, s2,i);

theorem 
  for s being 0-started State of SCMPDS,I being halt-free Program of SCMPDS,
      J being Program of SCMPDS st I is_closed_on s,P & I is_halting_on s,P
  holds IC IExec(I ';' Goto (card J + 1) ';' J,P,s)
   = card I + card J + 1;

theorem 
  for s being 0-started State of SCMPDS,I being halt-free Program of
SCMPDS, J being Program of SCMPDS st I is_closed_on s,P & I is_halting_on s,P
 holds
  IExec(I ';' Goto (card J + 1) ';' J,P,s)
   = IExec(I,P,s) +* Start-At((card I + card J + 1),SCMPDS);

theorem 
  for s being State of SCMPDS,I being halt-free Program of
  SCMPDS st I is_closed_on s,P & I is_halting_on s,P
   holds IC IExec(I,P,Initialize s) = card I;

begin 

definition
  let a be Int_position,k be Integer;
  let I,J be Program of SCMPDS;
  func if=0(a,k,I,J) -> Program of SCMPDS equals

  (a,k)<>0_goto (card I +2) ';' I ';' Goto (card J+1) ';' J;
  func if>0(a,k,I,J) -> Program of SCMPDS equals

  (a,k)<=0_goto (card I +2) ';'
  I ';' Goto (card J+1) ';' J;
  func if<0(a,k,I,J) -> Program of SCMPDS equals

  (a,k)>=0_goto (card I +2) ';'
  I ';' Goto (card J+1) ';' J;
end;

definition
  let a be Int_position,k be Integer;
  let I be Program of SCMPDS;
  func if=0(a,k,I) -> Program of SCMPDS equals

  (a,k)<>0_goto (card I +1) ';' I;
  func if<>0(a,k,I) -> Program of SCMPDS equals

  (a,k)<>0_goto 2 ';' goto (card
  I+1) ';' I;
  func if>0(a,k,I) -> Program of SCMPDS equals

  (a,k)<=0_goto (card I +1) ';' I;
  func if<=0(a,k,I) -> Program of SCMPDS equals

  (a,k)<=0_goto 2 ';' goto (card
  I+1) ';' I;
  func if<0(a,k,I) -> Program of SCMPDS equals

  (a,k)>=0_goto (card I +1) ';' I;
  func if>=0(a,k,I) -> Program of SCMPDS equals

  (a,k)>=0_goto 2 ';' goto (card
  I+1) ';' I;
end;

begin 

theorem 
  card if=0(a,k1,I,J) = card I + card J + 2;

theorem 
   0 in dom if=0(a,k1,I,J) &  1 in dom if=0(a,k1,I,J);

theorem 
  if=0(a,k1,I,J). 0 = (a,k1)<>0_goto (card I + 2);

theorem 
  for s being 0-started State of SCMPDS, I,J being shiftable Program of
  SCMPDS, a being Int_position,k1 being Integer st s.DataLoc(s.a,k1)= 0 & I
is_closed_on s,P & I is_halting_on s,P holds if=0(a,k1,I,J) is_closed_on s,P
 & if=0(a,k1,I,J) is_halting_on s,P;

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,J being
shiftable Program of SCMPDS,a being Int_position,k1 being Integer st s.DataLoc(
  s.a,k1)<> 0 & J is_closed_on s,P & J is_halting_on s,P holds if=0(a,k1,I,J)
  is_closed_on s,P & if=0(a,k1,I,J) is_halting_on s,P;

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable
Program of SCMPDS, J being shiftable Program of SCMPDS,a being Int_position,k1
  being Integer st s.DataLoc(s.a,k1)= 0 & I is_closed_on s,P &
  I is_halting_on s,P
holds IExec(if=0(a,k1,I,J),P,s)
 = IExec(I,P,s) +* Start-At((card I + card J+ 2),SCMPDS);

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,J being
  halt-free shiftable Program of SCMPDS,a being Int_position,k1 being Integer
  st s.DataLoc(s.a,k1)<> 0 & J is_closed_on s,P & J is_halting_on s,P
   holds IExec(if=0(a,k1,I,J),P,Initialize s) = IExec(J,P,Initialize s) +*
  Start-At((card I + card J + 2),SCMPDS);

registration
  let I,J be shiftable parahalting Program of SCMPDS, a be Int_position,k1 be
  Integer;
  cluster if=0(a,k1,I,J) -> shiftable parahalting;
end;

registration
  let I,J be halt-free Program of SCMPDS, a be Int_position,k1 be Integer;
  cluster if=0(a,k1,I,J) -> halt-free;
end;

theorem 
  for s being 0-started State of SCMPDS,I,J being halt-free shiftable
  parahalting Program of SCMPDS,a being Int_position,k1 being Integer holds IC
  IExec(if=0(a,k1,I,J),P,s) = card I + card J + 2;

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable parahalting
  Program of SCMPDS,J being shiftable Program of SCMPDS,a,b being Int_position,
  k1 being Integer st s.DataLoc(s.a,k1)= 0 holds
   IExec(if=0(a,k1,I,J),P,s).b = IExec(I,P,s).b;

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,J being
  halt-free parahalting shiftable Program of SCMPDS,a,b being Int_position,k1
being Integer st s.DataLoc(s.a,k1)<> 0 holds
 IExec(if=0(a,k1,I,J),P,Initialize s).b = IExec(J,P,Initialize s).b;

begin 

theorem 
  card if=0(a,k1,I) = card I + 1;

theorem 
   0 in dom if=0(a,k1,I);

theorem 
  if=0(a,k1,I). 0 = (a,k1)<>0_goto (card I + 1);

theorem 
  for s being State of SCMPDS, I being shiftable Program of SCMPDS
  , a being Int_position,k1 being Integer st s.DataLoc(s.a,k1)= 0 & I
is_closed_on s,P & I is_halting_on s,P holds if=0(a,k1,I) is_closed_on s,P
 & if=0(a,k1,I) is_halting_on s,P;

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS, a being
  Int_position, k1 being Integer st s.DataLoc(s.a,k1)<> 0 holds if=0(a,k1,I)
  is_closed_on s,P & if=0(a,k1,I) is_halting_on s,P;

theorem 
  for s being State of SCMPDS,I being halt-free shiftable
Program of SCMPDS, a being Int_position,k1 being Integer st s.DataLoc(s.a,k1)=
0 & I is_closed_on s,P & I is_halting_on s,P holds
 IExec(if=0(a,k1,I),P,Initialize s) = IExec(I,P,Initialize s)
  +* Start-At((card I+1),SCMPDS);

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,a being
Int_position, k1 being Integer st s.DataLoc(s.a,k1)<> 0
 holds IExec(if=0(a,k1,I),P,Initialize s) = s +* Start-At((card I+1),SCMPDS);

registration
  let I be shiftable parahalting Program of SCMPDS, a be Int_position,k1 be
  Integer;
  cluster if=0(a,k1,I) -> shiftable parahalting;
end;

registration
  let I be halt-free Program of SCMPDS, a be Int_position,k1 be Integer;
  cluster if=0(a,k1,I) -> halt-free;
end;

theorem 
  for s being 0-started State of SCMPDS,
     I being halt-free shiftable parahalting Program of SCMPDS,
     a being Int_position,k1 being Integer
 holds IC IExec(if=0(a,k1,I),P,s) = card I + 1;

theorem 
  for s being State of SCMPDS,
      I being halt-free shiftable parahalting
Program of SCMPDS,a,b being Int_position,k1 being Integer st s.DataLoc(s.a,k1)=
  0 holds IExec(if=0(a,k1,I),P,Initialize s).b = IExec(I,P,Initialize s).b;

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,a,b being
Int_position, k1 being Integer st s.DataLoc(s.a,k1)<> 0
 holds IExec(if=0(a,k1,I),P,Initialize s).b = s.b;

begin 

theorem 
  card if<>0(a,k1,I) = card I + 2;

theorem 
   0 in dom if<>0(a,k1,I) &  1 in dom if<>0(a,k1,I);

theorem 
  if<>0(a,k1,I). 0 = (a,k1)<>0_goto 2 & if<>0(a,k1,I). 1 =
  goto (card I + 1);

theorem 
  for s being State of SCMPDS, I being shiftable Program of SCMPDS
  , a being Int_position,k1 being Integer st s.DataLoc(s.a,k1)<>0 & I
is_closed_on s,P & I is_halting_on s,P holds if<>0(a,k1,I) is_closed_on s,P
 & if<>0(a
  ,k1,I) is_halting_on s,P;

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS, a being
  Int_position, k1 being Integer st s.DataLoc(s.a,k1)= 0 holds if<>0(a,k1,I)
  is_closed_on s,P & if<>0(a,k1,I) is_halting_on s,P;

theorem 
  for s being State of SCMPDS,I being halt-free shiftable
  Program of SCMPDS, a being Int_position,k1 being Integer st s.DataLoc(s.a,k1)
  <> 0 & I is_closed_on s,P & I is_halting_on s,P
   holds IExec(if<>0(a,k1,I),P,Initialize s) =
  IExec(I,P,Initialize s) +* Start-At((card I+2),SCMPDS);

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,a being
Int_position, k1 being Integer st s.DataLoc(s.a,k1)= 0
 holds IExec(if<>0(a,k1,I),P,Initialize s) = s +* Start-At((card I+2),SCMPDS);

registration
  let I be shiftable parahalting Program of SCMPDS, a be Int_position,k1 be
  Integer;
  cluster if<>0(a,k1,I) -> shiftable parahalting;
end;

registration
  let I be halt-free Program of SCMPDS, a be Int_position,k1 be Integer;
  cluster if<>0(a,k1,I) -> halt-free;
end;

theorem 
  for s being State of SCMPDS,I being halt-free shiftable parahalting
Program of SCMPDS,a being Int_position,k1 being Integer
 holds IC IExec(if<>0(a,k1,I),P,Initialize s) = card I + 2;

theorem 
  for s being State of SCMPDS,I being halt-free shiftable parahalting
Program of SCMPDS,a,b being Int_position,k1 being Integer st s.DataLoc(s.a,k1)
  <> 0 holds IExec(if<>0(a,k1,I),P,Initialize s).b
   = IExec(I,P,Initialize s).b;

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,a,b being
Int_position, k1 being Integer st s.DataLoc(s.a,k1)= 0
 holds IExec(if<>0(a,k1,I),P,Initialize s).b = s.b;

begin 

theorem 
  card if>0(a,k1,I,J) = card I + card J + 2;

theorem 
   0 in dom if>0(a,k1,I,J) &  1 in dom if>0(a,k1,I,J);

theorem 
  if>0(a,k1,I,J). 0 = (a,k1)<=0_goto (card I + 2);

theorem 
  for s being 0-started State of SCMPDS, I,J being shiftable Program of
  SCMPDS, a being Int_position,k1 being Integer st s.DataLoc(s.a,k1)>0 & I
is_closed_on s,P & I is_halting_on s,P holds if>0(a,k1,I,J) is_closed_on s,P
 & if>0(a,k1,I,J) is_halting_on s,P;

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,J being
shiftable Program of SCMPDS,a being Int_position,k1 being Integer st s.DataLoc(
  s.a,k1) <= 0 & J is_closed_on s,P & J is_halting_on s,P holds if>0(a,k1,I,J)
  is_closed_on s,P & if>0(a,k1,I,J) is_halting_on s,P;

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable
Program of SCMPDS, J being shiftable Program of SCMPDS,a being Int_position,k1
  being Integer st s.DataLoc(s.a,k1) > 0 & I is_closed_on s,P &
  I is_halting_on s,P
holds IExec(if>0(a,k1,I,J),P,s) = IExec(I,P,s)
 +* Start-At((card I + card J + 2),SCMPDS);

theorem 
  for s being 0-started State of SCMPDS,I being Program of SCMPDS,J being
  halt-free shiftable Program of SCMPDS,a being Int_position,k1 being Integer
  st s.DataLoc(s.a,k1) <= 0 & J is_closed_on s,P & J is_halting_on s,P
   holds IExec(if>0(a,k1,I,J),P,s)
    = IExec(J,P,s) +* Start-At((card I+card J+2),SCMPDS);

registration
  let I,J be shiftable parahalting Program of SCMPDS, a be Int_position,k1 be
  Integer;
  cluster if>0(a,k1,I,J) -> shiftable parahalting;
end;

registration
  let I,J be halt-free Program of SCMPDS, a be Int_position,k1 be Integer;
  cluster if>0(a,k1,I,J) -> halt-free;
end;

theorem 
  for s being 0-started State of SCMPDS,I,J being halt-free shiftable
  parahalting Program of SCMPDS,a being Int_position,k1 being Integer holds IC
  IExec(if>0(a,k1,I,J),P,s) = card I + card J + 2;

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable parahalting
  Program of SCMPDS,J being shiftable Program of SCMPDS,a,b being Int_position,
k1 being Integer st s.DataLoc(s.a,k1)>0 holds
 IExec(if>0(a,k1,I,J),P,s).b = IExec(I,P,s).b;

theorem 
  for s being 0-started State of SCMPDS,I being Program of SCMPDS,J being
  halt-free parahalting shiftable Program of SCMPDS,a,b being Int_position,k1
being Integer st s.DataLoc(s.a,k1) <= 0 holds
 IExec(if>0(a,k1,I,J),P,s).b = IExec(J,P,s).b;

begin 

theorem 
  card if>0(a,k1,I) = card I + 1;

theorem 
   0 in dom if>0(a,k1,I);

theorem 
  if>0(a,k1,I). 0 = (a,k1)<=0_goto (card I + 1);

theorem 
  for s being State of SCMPDS, I being shiftable Program of SCMPDS
  , a being Int_position,k1 being Integer st s.DataLoc(s.a,k1)> 0 & I
is_closed_on s,P & I is_halting_on s,P holds if>0(a,k1,I) is_closed_on s,P
 & if>0(a,
  k1,I) is_halting_on s,P;

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS, a being
  Int_position, k1 being Integer st s.DataLoc(s.a,k1) <= 0 holds if>0(a,k1,I)
  is_closed_on s,P & if>0(a,k1,I) is_halting_on s,P;

theorem 
  for s being State of SCMPDS,I being halt-free shiftable
Program of SCMPDS, a being Int_position,k1 being Integer st s.DataLoc(s.a,k1)>
0 & I is_closed_on s,P & I is_halting_on s,P
 holds IExec(if>0(a,k1,I),P,Initialize s) = IExec(I,P,Initialize s)
  +* Start-At((card I+1),SCMPDS);

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,a being
Int_position, k1 being Integer st s.DataLoc(s.a,k1) <= 0
 holds IExec(if>0(a,k1,I),P,Initialize s) = s +* Start-At((card I+1),SCMPDS);

registration
  let I be shiftable parahalting Program of SCMPDS, a be Int_position,k1 be
  Integer;
  cluster if>0(a,k1,I) -> shiftable parahalting;
end;

registration
  let I be halt-free Program of SCMPDS, a be Int_position,k1 be Integer;
  cluster if>0(a,k1,I) -> halt-free;
end;

theorem 
  for s being 0-started State of SCMPDS,
      I being halt-free shiftable parahalting Program of SCMPDS,
      a being Int_position,k1 being Integer
 holds IC IExec(if>0(a,k1,I),P,s) = card I + 1;

theorem 
  for s being State of SCMPDS,I being halt-free shiftable parahalting
Program of SCMPDS,a,b being Int_position,k1 being Integer st s.DataLoc(s.a,k1)>
  0 holds IExec(if>0(a,k1,I),P,Initialize s).b = IExec(I,P,Initialize s).b;

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,a,b being
Int_position, k1 being Integer st s.DataLoc(s.a,k1) <= 0
 holds IExec(if>0(a,k1,I),P,Initialize s).b = s.b;

begin 

theorem 
  card if<=0(a,k1,I) = card I + 2;

theorem 
   0 in dom if<=0(a,k1,I) &  1 in dom if<=0(a,k1,I);

theorem 
  if<=0(a,k1,I). 0 = (a,k1)<=0_goto 2 & if<=0(a,k1,I). 1 =
  goto (card I + 1);

theorem 
  for s being State of SCMPDS, I being shiftable Program of
  SCMPDS, a being Int_position,k1 being Integer st s.DataLoc(s.a,k1) <= 0 & I
is_closed_on s,P & I is_halting_on s,P holds if<=0(a,k1,I) is_closed_on s,P
 & if<=0(a
  ,k1,I) is_halting_on s,P;

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS, a being
  Int_position, k1 being Integer st s.DataLoc(s.a,k1) > 0 holds if<=0(a,k1,I)
  is_closed_on s,P & if<=0(a,k1,I) is_halting_on s,P;

theorem 
  for s being State of SCMPDS,I being halt-free shiftable
  Program of SCMPDS, a being Int_position,k1 being Integer st s.DataLoc(s.a,k1)
  <= 0 & I is_closed_on s,P & I is_halting_on s,P
   holds IExec(if<=0(a,k1,I),P,Initialize s) =
  IExec(I,P,Initialize s) +* Start-At((card I+2),SCMPDS);

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,a being
Int_position, k1 being Integer st s.DataLoc(s.a,k1) > 0
 holds IExec(if<=0(a,k1,I),P,Initialize s)
  = s +* Start-At((card I+2),SCMPDS);

registration
  let I be shiftable parahalting Program of SCMPDS, a be Int_position,k1 be
  Integer;
  cluster if<=0(a,k1,I) -> shiftable parahalting;
end;

registration
  let I be halt-free Program of SCMPDS, a be Int_position,k1 be Integer;
  cluster if<=0(a,k1,I) -> halt-free;
end;

theorem 
  for s being 0-started State of SCMPDS,
      I being halt-free shiftable parahalting
Program of SCMPDS,a being Int_position,k1 being Integer
 holds IC IExec(if<=0(a,k1,I),P,s) = card I + 2;

theorem 
  for s being State of SCMPDS,I being halt-free shiftable parahalting
Program of SCMPDS,a,b being Int_position,k1 being Integer st s.DataLoc(s.a,k1)
  <= 0 holds IExec(if<=0(a,k1,I),P,Initialize s).b = IExec(I,P,Initialize s).b;

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,a,b being
Int_position, k1 being Integer st s.DataLoc(s.a,k1) > 0
 holds IExec(if<=0(a,k1,I),P,Initialize s).b = s.b;

begin 

theorem 
  card if<0(a,k1,I,J) = card I + card J + 2;

theorem 
   0 in dom if<0(a,k1,I,J) &  1 in dom if<0(a,k1,I,J);

theorem 
  if<0(a,k1,I,J). 0 = (a,k1)>=0_goto (card I + 2);

theorem 
  for s being 0-started State of SCMPDS, I,J being shiftable Program of
  SCMPDS, a being Int_position,k1 being Integer st s.DataLoc(s.a,k1)<0 & I
is_closed_on s,P & I is_halting_on s,P holds if<0(a,k1,I,J) is_closed_on s,P
 & if<0(a
  ,k1,I,J) is_halting_on s,P;

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,J being
shiftable Program of SCMPDS,a being Int_position,k1 being Integer st s.DataLoc(
  s.a,k1) >= 0 & J is_closed_on s,P & J is_halting_on s,P holds if<0(a,k1,I,J)
  is_closed_on s,P & if<0(a,k1,I,J) is_halting_on s,P;

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable
Program of SCMPDS, J being shiftable Program of SCMPDS,a being Int_position,k1
  being Integer st s.DataLoc(s.a,k1) < 0 & I is_closed_on s,P
   & I is_halting_on s,P
holds IExec(if<0(a,k1,I,J),P,s) = IExec(I,P,s)
 +* Start-At((card I + card J+ 2),SCMPDS);

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,J being
  halt-free shiftable Program of SCMPDS,a being Int_position,k1 being Integer
  st s.DataLoc(s.a,k1) >= 0 & J is_closed_on s,P & J is_halting_on s,P
   holds IExec(if<0(a,k1,I,J),P,Initialize s)
    = IExec(J,P,Initialize s) +* Start-At((card I+card J+2),SCMPDS);

registration
  let I,J be shiftable parahalting Program of SCMPDS, a be Int_position,k1 be
  Integer;
  cluster if<0(a,k1,I,J) -> shiftable parahalting;
end;

registration
  let I,J be halt-free Program of SCMPDS, a be Int_position,k1 be Integer;
  cluster if<0(a,k1,I,J) -> halt-free;
end;

theorem 
  for s being 0-started State of SCMPDS,I,J being halt-free shiftable
  parahalting Program of SCMPDS,a being Int_position,k1 being Integer holds IC
  IExec(if<0(a,k1,I,J),P,s) = card I + card J + 2;

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable parahalting
  Program of SCMPDS,J being shiftable Program of SCMPDS,a,b being Int_position,
k1 being Integer st s.DataLoc(s.a,k1)<0
 holds IExec(if<0(a,k1,I,J),P,s).b
 = IExec(I,P,s).b;

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,J being
  halt-free parahalting shiftable Program of SCMPDS,a,b being Int_position,k1
being Integer st s.DataLoc(s.a,k1) >= 0
 holds IExec(if<0(a,k1,I,J),P,Initialize s).b = IExec(J,P,Initialize s).b;

begin 

theorem 
  card if<0(a,k1,I) = card I + 1;

theorem 
   0 in dom if<0(a,k1,I);

theorem 
  if<0(a,k1,I). 0 = (a,k1)>=0_goto (card I + 1);

theorem 
  for s being State of SCMPDS, I being shiftable Program of
  SCMPDS, a being Int_position,k1 being Integer st s.DataLoc(s.a,k1) < 0 & I
is_closed_on s,P & I is_halting_on s,P holds if<0(a,k1,I) is_closed_on s,P
 & if<0(a,
  k1,I) is_halting_on s,P;

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS, a being
  Int_position, k1 being Integer st s.DataLoc(s.a,k1) >= 0 holds if<0(a,k1,I)
  is_closed_on s,P & if<0(a,k1,I) is_halting_on s,P;

theorem 
  for s being State of SCMPDS,I being halt-free shiftable
Program of SCMPDS, a being Int_position,k1 being Integer st s.DataLoc(s.a,k1) <
0 & I is_closed_on s,P & I is_halting_on s,P
 holds IExec(if<0(a,k1,I),P,Initialize s) = IExec(I,P,Initialize s)
  +* Start-At((card I+1),SCMPDS);

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,a being
Int_position, k1 being Integer st s.DataLoc(s.a,k1) >= 0
 holds IExec(if<0(a,k1,I),P,Initialize s) = s +* Start-At((card I+1),SCMPDS);

registration
  let I be shiftable parahalting Program of SCMPDS, a be Int_position,k1 be
  Integer;
  cluster if<0(a,k1,I) -> shiftable parahalting;
end;

registration
  let I be halt-free Program of SCMPDS, a be Int_position,k1 be Integer;
  cluster if<0(a,k1,I) -> halt-free;
end;

theorem 
  for s being State of SCMPDS,I being halt-free shiftable parahalting
Program of SCMPDS,a being Int_position,k1 being Integer
 holds IC IExec(if<0(a,k1,I),P,Initialize s) = card I + 1;

theorem 
  for s being State of SCMPDS,I being halt-free shiftable parahalting
Program of SCMPDS,a,b being Int_position,k1 being Integer st s.DataLoc(s.a,k1)
  < 0 holds IExec(if<0(a,k1,I),P,Initialize s).b = IExec(I,P,Initialize s).b;

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,a,b being
Int_position, k1 being Integer st s.DataLoc(s.a,k1) >= 0
 holds IExec(if<0(a,k1,I),P,Initialize s).b = s.b;

begin 

theorem 
  card if>=0(a,k1,I) = card I + 2;

theorem 
   0 in dom if>=0(a,k1,I) &  1 in dom if>=0(a,k1,I);

theorem 
  if>=0(a,k1,I). 0 = (a,k1)>=0_goto 2 & if>=0(a,k1,I). 1 =
  goto (card I + 1);

theorem 
  for s being State of SCMPDS, I being shiftable Program of
  SCMPDS, a being Int_position,k1 being Integer st s.DataLoc(s.a,k1) >= 0 & I
is_closed_on s,P & I is_halting_on s,P holds if>=0(a,k1,I) is_closed_on s,P
 & if>=0(a
  ,k1,I) is_halting_on s,P;

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS, a being
  Int_position, k1 being Integer st s.DataLoc(s.a,k1) < 0 holds if>=0(a,k1,I)
  is_closed_on s,P & if>=0(a,k1,I) is_halting_on s,P;

theorem 
  for s being State of SCMPDS,I being halt-free shiftable
  Program of SCMPDS, a being Int_position,k1 being Integer st s.DataLoc(s.a,k1)
  >= 0 & I is_closed_on s,P & I is_halting_on s,P
   holds IExec(if>=0(a,k1,I),P,Initialize s) =
  IExec(I,P,Initialize s) +* Start-At((card I+2),SCMPDS);

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,a being
Int_position, k1 being Integer st s.DataLoc(s.a,k1) < 0
 holds IExec(if>=0(a,k1,I),P,Initialize s) = s +* Start-At((card I+2),SCMPDS);

registration
  let I be shiftable parahalting Program of SCMPDS, a be Int_position,k1 be
  Integer;
  cluster if>=0(a,k1,I) -> shiftable parahalting;
end;

registration
  let I be halt-free Program of SCMPDS, a be Int_position,k1 be Integer;
  cluster if>=0(a,k1,I) -> halt-free;
end;

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable parahalting
Program of SCMPDS,a being Int_position,k1 being Integer
 holds IC IExec(if>=0(a,k1,I),P,s) = card I + 2;

theorem 
  for s being State of SCMPDS,I being halt-free shiftable parahalting
Program of SCMPDS,a,b being Int_position,k1 being Integer st s.DataLoc(s.a,k1)
  >= 0 holds IExec(if>=0(a,k1,I),P,Initialize s).b = IExec(I,P,Initialize s).b;

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,a,b being
Int_position, k1 being Integer st s.DataLoc(s.a,k1) < 0
 holds IExec(if>=0(a,k1,I),P,Initialize s).b = s.b;

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS
   holds I is_closed_on s,P iff I is_closed_on Initialize s,P;

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS
   holds I is_halting_on s,P iff I is_halting_on Initialize s,P;















begin 

reserve m,n for Element of NAT,
  a,b for Int_position,
  i,j for Instruction of SCMPDS,
  s,s1,s2 for State of SCMPDS,
  I,J for Program of SCMPDS;

definition
  let k be Nat;
  func intpos k -> Int_position equals

  dl.k;
end;

theorem 
  for n1,n2 be Element of NAT holds DataLoc(n1,n2) = intpos(n1+n2);

theorem 
  for s being State of SCMPDS,m1,m2 being Element of NAT st IC s= (m1+m2)
  holds ICplusConst(s,-m2)= m1;



definition
  func GBP -> Int_position equals

  intpos 0;

  func SBP -> Int_position equals

  intpos 1;
end;

theorem 
  GBP <> SBP;

theorem 
  card (I ';' i)= card I + 1;

theorem 
  card (i ';' j)= 2;

theorem 
  (I ';' i). card I =i &  card I in dom (I ';' i);

theorem 
  (I ';' i ';' J). card I =i;

begin 








definition
  func GCD-Algorithm -> Program of SCMPDS equals


  (((GBP:=0) ';' (SBP := 7) ';' saveIC(SBP,RetIC) ';'
  goto 2 ';' halt SCMPDS ) ';' (SBP,3)<=0_goto 9 ';'
  ((SBP,6):=(SBP,3)) ';' Divide(SBP,2,SBP,3) ';'
  ((SBP,7):=(SBP,3)) ';' ((SBP,4+RetSP):=(GBP,1))) ';'
  AddTo(GBP,1,4) ';' saveIC(SBP,RetIC) ';'
  (goto -7) ';' ((SBP,2):=(SBP,6)) ';' return SBP;
end;

begin 

theorem 
  card GCD-Algorithm = 15;

theorem 
  n < 15 iff  n in dom GCD-Algorithm;

theorem 
  GCD-Algorithm. 0=GBP:=0 & GCD-Algorithm. 1=SBP:= 7 &
  GCD-Algorithm. 2=saveIC(SBP,RetIC) & GCD-Algorithm. 3=goto 2 &
  GCD-Algorithm. 4=halt SCMPDS &
  GCD-Algorithm. 5=(SBP,3)<=0_goto 9 &
  GCD-Algorithm. 6=(SBP,6):=(SBP,3) &
  GCD-Algorithm. 7=Divide(SBP,2,SBP,3) &
  GCD-Algorithm. 8=(SBP,7):=(SBP,3) &
  GCD-Algorithm. 9=(SBP,4+RetSP):=(GBP,1) &
  GCD-Algorithm. 10=AddTo(GBP,1,4) &
  GCD-Algorithm. 11=saveIC(SBP,RetIC) &
  GCD-Algorithm. 12=goto -7 & GCD-Algorithm. 13=(SBP,2):=(SBP,6) &
  GCD-Algorithm. 14=return SBP;

reserve P,P1,P2 for Instruction-Sequence of SCMPDS;

theorem 
  for P being Instruction-Sequence of SCMPDS
   st GCD-Algorithm c= P
  for s being 0-started State of SCMPDS
  holds IC Comput(P,s,4) =  5 & Comput(P,s,4).GBP = 0 &
  Comput(P,s,4).SBP = 7 & Comput(P,s,4).intpos(7+RetIC) =  2 &
  Comput(P,s,4).intpos 9 = s.intpos 9 &
  Comput(P,s,4).intpos 10 = s.intpos 10;

theorem 
  for s being State of SCMPDS st GCD-Algorithm c= P
  & IC s =  5 & s.SBP >0 & s.GBP=0 &
  s.DataLoc(s.SBP,3) >= 0 & s.DataLoc(s.SBP,2) >= s.DataLoc(s.SBP,3) holds
  ex n st CurInstr(P,Comput(P,s,n)) =
  return SBP &
  s.SBP=Comput(P,s,n).SBP & Comput(P,s,n).DataLoc(s.SBP,2)
  =s.DataLoc(s.SBP,2) gcd s.DataLoc(s.SBP,3) &
  for j be Element of NAT st 1<j & j <= s.SBP+1 holds
  s.intpos j=Comput(P,s,n).intpos j;

theorem 
  for s being State of SCMPDS st GCD-Algorithm c= P
  & IC s =  5 & s.SBP >0 & s.GBP=0 &
  s.DataLoc(s.SBP,3) >= 0 & s.DataLoc(s.SBP,2) >= 0 holds
  ex n st CurInstr(P,Comput(P,s,n)) =
  return SBP &
  s.SBP=Comput(P,s,n).SBP & Comput(P,s,n).DataLoc(s.SBP,2)
  =s.DataLoc(s.SBP,2) gcd s.DataLoc(s.SBP,3) &
  for j be Element of NAT st 1<j & j <= s.SBP+1 holds
  s.intpos j=Comput(P,s,n).intpos j;

begin 

theorem 
  for s being 0-started State of SCMPDS
   st GCD-Algorithm c= P
  for x, y being Integer st s.intpos 9 = x & s.intpos 10 = y
  & x >= 0 & y >= 0 holds (Result(P,s)).intpos 9 = x gcd y;

begin 

theorem 
  for p being FinPartState of SCMPDS,
     x,y being Integer st y >= 0 & x >= y
  & p=(intpos 9,intpos 10) --> (x,y)
  holds Initialize p is GCD-Algorithm-autonomic;















begin 

reserve x for set,
  m,n for Element of NAT,
  a,b for Int_position,
  i,j,k for Instruction of SCMPDS,
  s,s1,s2 for State of SCMPDS,
  k1,k2 for Integer,
  loc,l for Element of NAT,
  I,J,K for Program of SCMPDS;

theorem 
  for s being State of SCMPDS,m,n being Element of NAT st IC s=
   m holds ICplusConst(s,n-m)= n;

theorem 
  i ';' I ';' j ';' k = i ';' (I ';' j ';' k);

theorem 
  Shift(J,card I) c= I ';' J ';' K;

theorem 
  I c= stop (I ';' J);

canceled 2;

theorem 
  for s being State of SCMPDS, i being Instruction of SCMPDS st InsCode
  i in {0,4,5,6,14} holds DataPart Exec(i,s) = DataPart s;

reserve P,P1,P2,Q for Instruction-Sequence of SCMPDS;



theorem 
  for s1,s2 being State of SCMPDS,I being Program of SCMPDS
   st I is_closed_on s1,P1 & DataPart s1 = DataPart s2
 for k being Element of NAT
  holds
   Comput(P1 +* stop I,Initialize s1,k)
  =  Comput(P2 +* stop I,Initialize s2,k) &
  CurInstr(P1 +* stop I,Comput(P1 +* stop I,Initialize s1,k)) =
  CurInstr(P2 +* stop I,Comput(P2 +* stop I,Initialize s2,k));

theorem 
  for s being 0-started State of SCMPDS
  for I being Program of SCMPDS st I is_closed_on s,P1 &
   stop I c= P1 & stop I c= P2
  for k being Element of NAT holds  Comput(P1,s,k)
   =  Comput(P2,s,k)
   & CurInstr(P1,Comput(P1,s,k)) = CurInstr(P2,Comput(P2,s,k));



theorem 
  for s being 0-started State of SCMPDS
  for I being Program of SCMPDS
   st I is_closed_on s,P1 & I is_halting_on s,P1 &
    stop I c= P1 & stop I c= P2
  holds LifeSpan(P1,s) = LifeSpan(P2,s)
   &  Result(P1,s) =  Result(P2,s);

theorem 
  for s1,s2 being State of SCMPDS,I being Program of SCMPDS st I
is_closed_on s1,P1 & I is_halting_on s1,P1 & DataPart s1 = DataPart s2
 holds LifeSpan(P1 +* stop I,Initialize s1)
  = LifeSpan(P2 +* stop I,Initialize s2) &
  Result(P1 +* stop I,Initialize s1)
 =  Result(P2 +* stop I,Initialize s2);

theorem 
  for s1,s2 being 0-started State of SCMPDS,I being Program of SCMPDS st I
  is_closed_on s1,P1 & I is_halting_on s1,P1 &
  stop I c= P1 & stop I c= P2 &
   ex k being Element of NAT st
  Comput(P1,s1,k) =  s2
  holds  Result(P1,s1) =  Result(P2,s2);

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS, a being
  Int_position st I is_halting_on s,P holds IExec(I,P,Initialize s).a =
  Comput(P +* stop I,Initialize s, (LifeSpan(P +* stop I,Initialize s))).a;

theorem 
  for s being State of SCMPDS,I being parahalting Program of SCMPDS, a
being Int_position holds IExec(I,P,Initialize s).a =
 Comput(P +* stop I,Initialize s, (LifeSpan(P +* stop I,Initialize s))).a;

theorem 
for s being 0-started State of SCMPDS
  for I being Program of SCMPDS,i being Element of NAT st
   stop I c= P &
I is_closed_on s,P & I is_halting_on s,P
 & i < LifeSpan(P,s)
  holds IC Comput(P,s,i) in dom I;

theorem 
  for s1 being 0-started State of SCMPDS
  for I being shiftable Program of SCMPDS st
   stop I c= P1 &
   I is_closed_on s1,P1 & I is_halting_on s1,P1
 for n being Element of NAT
 st Shift(I,n) c= P2 & IC s2 =  n & DataPart s1 = DataPart s2
  for i being Element of NAT holds i < LifeSpan(P1,s1) implies
   IC Comput(P1,s1,i) + n = IC Comput(P2,s2,i) &
   CurInstr(P1,Comput(P1,s1,i)) = CurInstr(P2,Comput(P2,s2,i))
 & DataPart Comput(P1,s1,i) = DataPart Comput(P2,s2,i);

theorem 
  for s being 0-started State of SCMPDS
  for I being halt-free Program of SCMPDS st
   stop I c= P &
    I is_halting_on s,P holds LifeSpan(P,s) > 0;

theorem 
  for s1 being 0-started State of SCMPDS
  for I being halt-free shiftable Program of SCMPDS st
   stop I c= P1 &
   I is_closed_on s1,P1 & I is_halting_on s1,P1
  for n being
  Element of NAT st Shift(I,n) c= P2 & IC s2 =  n & DataPart
  s1 = DataPart s2 holds IC Comput(P2,s2,LifeSpan(P1,s1)) = card I + n &
  DataPart Comput(P1,s1,LifeSpan(P1,s1)) = DataPart
       Comput(P2,s2,LifeSpan(P1,s1));



theorem 
  for I being Program of SCMPDS,J being Program of SCMPDS, k being
  Element of NAT st I is_closed_on s,P & I is_halting_on s,P &
   k <= LifeSpan(P +* stop I,Initialize s)
    holds  Comput(P +* stop I,Initialize s,k)
   =  Comput(P+*(I ';' J), Initialize s,k);

theorem 
  for I,J being Program of SCMPDS,k be Element of NAT st I c= J &
I is_closed_on s,P & I is_halting_on s,P &
 k <= LifeSpan(P +* stop I,Initialize s)
holds  Comput(P +* J, Initialize s,k)
 =  Comput(P +* stop I,Initialize s,k);

theorem 
  for I,J being Program of SCMPDS,k be Element of NAT st k <=
  LifeSpan(P +* stop I,Initialize s) & I c= J &
   I is_closed_on s,P & I is_halting_on s,P
   holds IC Comput(P +* J,Initialize s,k) in dom stop I;

theorem 
  for I,J being Program of SCMPDS st I c= J & I is_closed_on s,P & I
is_halting_on s,P
 holds CurInstr(P +* J,Comput(P +* J, Initialize s,
 LifeSpan(P +* stop I,Initialize s))) = halt SCMPDS
  or IC Comput(P +* J,Initialize s,
   LifeSpan(P +* stop I,Initialize s)) = card I;

theorem 
  for I,J being Program of SCMPDS st I is_halting_on s,P & J
  is_closed_on IExec(I,P,Initialize s),P &
  J is_halting_on IExec(I,P,Initialize s),P
   holds J is_closed_on Comput(P +* stop I, Initialize s,
   LifeSpan(P +* stop I,Initialize s)), P +* stop I & J
  is_halting_on Comput(P +* stop I,
    Initialize s,
     LifeSpan(P +* stop I,Initialize s)), P +* stop I;

theorem 
  for I being Program of SCMPDS,J being shiftable Program of
SCMPDS st I is_closed_on s,P & I is_halting_on s,P
 & J is_closed_on IExec(I,P,Initialize s),P
 & J is_halting_on IExec(I,P,Initialize s),P
  holds I ';'J is_closed_on s,P & I ';' J is_halting_on s,P;

theorem 
  for I be halt-free Program of SCMPDS,J be Program of SCMPDS st
  I c= J & I is_closed_on s,P & I is_halting_on s,P
   holds IC Comput(P+*J, Initialize s,
    LifeSpan(P +* stop I,Initialize s)) =  card I;

theorem 
  for I being Program of SCMPDS,s being State of SCMPDS, k being Element
  of NAT st I is_halting_on s,P
   & k < LifeSpan(P+*stop I,Initialize s) holds
  CurInstr(P+*stop I,Comput(P +* stop I,Initialize s,k)) <> halt SCMPDS;

theorem 
  for I,J being Program of SCMPDS,s being 0-started State of SCMPDS, k being
  Element of NAT st I is_closed_on s,P & I is_halting_on s,P
     & k < LifeSpan(P +* stop I,s) holds
 CurInstr(P+*stop(I ';' J),Comput(P+*stop(I ';' J),s,k))
   <> halt SCMPDS;

theorem 
  for s being 0-started State of SCMPDS
  for I being halt-free Program of SCMPDS,J being shiftable Program of
SCMPDS st I is_closed_on s,P & I is_halting_on s,P
 & J is_closed_on IExec(I,P,s),P & J
  is_halting_on IExec(I,P,s),P
holds LifeSpan(P+*stop(I ';' J),s) =
 LifeSpan(P +* stop I,s) +
  LifeSpan(P +* stop I +* stop J,
  Initialize Result(P +* stop I,s));

theorem 
 for s being 0-started State of SCMPDS
  for I being halt-free Program of SCMPDS, J being shiftable
  Program of SCMPDS st I is_closed_on s,P & I is_halting_on s,P
   & J is_closed_on IExec(I,P,s),P & J is_halting_on IExec(I,P,s),P
 holds IExec(I ';' J,P,s)
  = IncIC(IExec(J,P,Initialize IExec(I,P,s)), card I);

theorem 
  for s being 0-started State of SCMPDS
  for I being halt-free Program of SCMPDS, J being shiftable
  Program of SCMPDS st I is_closed_on s,P & I is_halting_on s,P
   & J is_closed_on
  IExec(I,P,s),P & J is_halting_on IExec(I,P,s),P
   holds IExec(I ';' J,P,s).a
   = IExec(J,P,Initialize IExec(I,P,s)).a;

theorem 
  for s being 0-started State of SCMPDS
  for I being halt-free Program of SCMPDS,j being parahalting
  shiftable Instruction of SCMPDS st I is_closed_on s,P & I is_halting_on s,P
   holds
  IExec(I ';' j,P,s).a = Exec(j, IExec(I,P,s)).a;

begin 



definition
  let a be Int_position, i be Integer,n be Element of NAT;
  let I be Program of SCMPDS;
  func for-up(a,i,n,I) -> Program of SCMPDS equals

  (a,i)>=0_goto (card I +3)
  ';' I ';' AddTo(a,i,n) ';' goto -(card I+2);
end;

begin 

theorem 
  for a be Int_position,i be Integer,n be Element of NAT,I be
  Program of SCMPDS holds card for-up(a,i,n,I)= card I +3;

theorem 
  for a be Int_position,i be Integer,n,m be Element of NAT, I be
  Program of SCMPDS holds m < card I+3 iff  m in dom for-up(a,i,n,I);

theorem 
  for a be Int_position,i be Integer,n be Element of NAT, I be
  Program of SCMPDS holds for-up(a,i,n,I). 0=(a,i)>=0_goto (card I +3) &
for-up(a,i,n,I). (card I+1)=AddTo(a,i,n) & for-up(a,i,n,I). (card I
  +2)=goto -(card I+2);

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,a being
  Int_position, i being Integer,n be Element of NAT st s.DataLoc(s.a,i) >= 0
  holds for-up(a,i,n,I) is_closed_on s,P & for-up(a,i,n,I) is_halting_on s,P;

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,a,c being
  Int_position, i being Integer,n be Element of NAT st s.DataLoc(s.a,i) >= 0
  holds IExec(for-up(a,i,n,I),P,Initialize s)
     = s +* Start-At((card I+3),SCMPDS);

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,a being
  Int_position, i being Integer,n be Element of NAT st s.DataLoc(s.a,i) >= 0
  holds IC IExec(for-up(a,i,n,I),P,Initialize s) = card I + 3;

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,a,b being
  Int_position, i being Integer,n be Element of NAT st s.DataLoc(s.a,i) >= 0
  holds IExec(for-up(a,i,n,I),P,Initialize s).b = s.b;

theorem 
  for s being State of SCMPDS,I being halt-free shiftable
Program of SCMPDS, a be Int_position, i be Integer,n be Element of NAT,X be set
  st s.DataLoc(s.a,i) < 0 & not DataLoc(s.a,i) in X & n > 0 &
  a <> DataLoc(s.a,i) &
(for t be State of SCMPDS,Q st (for x be Int_position st x in X
holds t.x=s.x) & t.a=s.a holds IExec(I,Q,Initialize t).a=t.a &
IExec(I,Q,Initialize t).DataLoc(s.a,i)=t.DataLoc(s.a,i) &
 I is_closed_on t,Q & I is_halting_on t,Q &
   for y be Int_position
st y in X holds IExec(I,Q,Initialize t).y=t.y)
 holds for-up(a,i,n,I) is_closed_on s,P
 & for-up(a,i,n,I) is_halting_on s,P;

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable Program of
  SCMPDS, a be Int_position, i be Integer,n be Element of NAT,X be set st s.
  DataLoc(s.a,i) < 0 & not DataLoc(s.a,i) in X & n > 0 & a <>
       DataLoc(s.a,i) &
  (for t be State of SCMPDS,Q
 st (for x be Int_position st x in X
holds t.x=s.x) & t.a=s.a holds IExec(I,Q,Initialize t).a=t.a
 & IExec(I,Q,Initialize t).DataLoc(s.a,i)=t.
  DataLoc(s.a,i) & I is_closed_on t,Q & I is_halting_on t,Q &
   for y be Int_position
st y in X holds IExec(I,Q,Initialize t).y=t.y)
 holds IExec(for-up(a,i,n,I),P,s)
 = IExec(for-up(a,i,n,I),P,
      Initialize IExec(I ';' AddTo(a,i,n),P,s));

registration
  let I be shiftable Program of SCMPDS, a be Int_position,i be Integer,n be
  Element of NAT;
  cluster for-up(a,i,n,I) -> shiftable;
end;

registration
  let I be halt-free Program of SCMPDS, a be Int_position,i be Integer,n be
  Element of NAT;
  cluster for-up(a,i,n,I) -> halt-free;
end;

begin 



definition
  let a be Int_position, i be Integer,n be Element of NAT;
  let I be Program of SCMPDS;
  func for-down(a,i,n,I) -> Program of SCMPDS equals

  (a,i)<=0_goto (card I +3)
  ';' I ';' AddTo(a,i,-n) ';' goto -(card I+2);
end;

begin 

theorem 
  for a be Int_position,i be Integer,n be Element of NAT,I be
  Program of SCMPDS holds card for-down(a,i,n,I)= card I +3;

theorem 
  for a be Int_position,i be Integer,n,m be Element of NAT, I be
  Program of SCMPDS holds m < card I+3 iff  m in dom for-down(a,i,n,I);

theorem 
  for a be Int_position,i be Integer,n be Element of NAT, I be
Program of SCMPDS holds for-down(a,i,n,I). 0=(a,i)<=0_goto (card I +3) &
for-down(a,i,n,I). (card I+1)=AddTo(a,i,-n) & for-down(a,i,n,I). (
  card I+2)=goto -(card I+2);

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,a being
  Int_position, i being Integer,n be Element of NAT st s.DataLoc(s.a,i) <= 0
  holds for-down(a,i,n,I) is_closed_on s,P
   & for-down(a,i,n,I) is_halting_on s,P;

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,a,c being
  Int_position, i being Integer,n be Element of NAT st s.DataLoc(s.a,i) <= 0
  holds IExec(for-down(a,i,n,I),P,Initialize s)
       = s +* Start-At((card I+3),SCMPDS);

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,a being
  Int_position, i being Integer,n be Element of NAT st s.DataLoc(s.a,i) <= 0
  holds IC IExec(for-down(a,i,n,I),P,Initialize s) = card I + 3;

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,a,b being
  Int_position, i being Integer,n be Element of NAT st s.DataLoc(s.a,i) <= 0
  holds IExec(for-down(a,i,n,I),P,Initialize s).b = s.b;

theorem 
  for s being State of SCMPDS,I being halt-free shiftable
Program of SCMPDS, a be Int_position, i be Integer,n be Element of NAT,X be set
  st s.DataLoc(s.a,i) > 0 & not DataLoc(s.a,i) in X & n > 0 & a <>
DataLoc(s.a,i) &
 (for t be 0-started State of SCMPDS,Q st (for x be Int_position st x in X
   holds t.x=s.x) & t.a=s.a holds IExec(I,Q,t).a=t.a &
     IExec(I,Q,t).DataLoc(s.a,i)=t.DataLoc(s.a,i) &
     I is_closed_on t,Q & I is_halting_on t,Q &
     for y be Int_position st y in X holds IExec(I,Q,t).y=t.y)
 holds for-down(a,i,n,I) is_closed_on s,P &
       for-down(a,i,n,I) is_halting_on s,P;

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable
Program of SCMPDS, a be Int_position, i be Integer,n be Element of NAT,X be set
  st s.DataLoc(s.a,i) > 0 & not DataLoc(s.a,i) in X & n > 0 & a <>
DataLoc(s.a,i) &
  (for t be 0-started State of SCMPDS,Q st (for x be Int_position st x in X
holds t.x=s.x) & t.a=s.a holds IExec(I,Q,t).a=t.a
 & IExec(I,Q,t).DataLoc(s.a,i)=t.
  DataLoc(s.a,i) & I is_closed_on t,Q & I is_halting_on t,Q &
   for y be Int_position
  st y in X holds IExec(I,Q,t).y=t.y)
   holds IExec(for-down(a,i,n,I),P,s)
    = IExec(for-down(a,i,n,I),P,Initialize IExec(I ';' AddTo(a,i,-n),P,s));

registration
  let I be shiftable Program of SCMPDS, a be Int_position,i be Integer,n be
  Element of NAT;
  cluster for-down(a,i,n,I) -> shiftable;
end;

registration
  let I be halt-free Program of SCMPDS, a be Int_position,i be Integer,n be
  Element of NAT;
  cluster for-down(a,i,n,I) -> halt-free;
end;

begin 



definition
  let n be Element of NAT;
  func sum(n) -> Program of SCMPDS equals

  (GBP:=0) ';' ((GBP,2):=n) ';' ((GBP,
  3):=0) ';' for-down(GBP,2,1, Load AddTo(GBP,3,1));
end;

theorem 
  for s being 0-started State of SCMPDS st s.GBP=0 holds for-down(GBP,2,1,
  Load AddTo(GBP,3,1)) is_closed_on s,P
   & for-down(GBP,2,1, Load AddTo(GBP,3,1)) is_halting_on s,P;

theorem 
  for s being 0-started State of SCMPDS,n be Element of NAT
   st s.GBP=0 & s.intpos 2=n & s.intpos 3=0
   holds IExec(for-down(GBP,2,1, Load AddTo(GBP,3,1)),P,s).intpos 3
       =n;

theorem 
  for s being 0-started State of SCMPDS,n be Element of NAT
   holds IExec(sum(n),P,s).intpos 3 =n;



definition
  let sp,control,result,pp,pData be Element of NAT;
  func sum(sp,control,result,pp,pData) -> Program of SCMPDS equals

  ((intpos sp
  ,result):=0) ';' (intpos pp:=pData) ';' for-down(intpos sp,control,1, AddTo(
  intpos sp,result,intpos pData,0) ';' AddTo(intpos pp,0,1));
end;

theorem 
  for s being 0-started State of SCMPDS,sp,cv,result,pp,pD be Element of NAT
st s.intpos sp > sp & cv < result & s.intpos pp=pD & s.intpos sp+result < pp &
pp <pD & pD < s.intpos pD
 holds for-down(intpos sp,cv,1, AddTo(intpos sp,result,intpos pD,0) ';'
  AddTo(intpos pp,0,1)) is_closed_on s,P &
   for-down(intpos sp,cv,1, AddTo(intpos sp,result,intpos pD,0) ';'
  AddTo(intpos pp,0,1)) is_halting_on s,P;

theorem 
  for s being 0-started State of SCMPDS,sp,cv,result,pp,pD be Element of NAT,
  f be FinSequence of NAT st s.intpos sp > sp & cv < result & s.intpos pp=pD &
  s.intpos sp+result < pp & pp <pD & pD < s.intpos pD & s.DataLoc(s.intpos sp,
result)=0 & len f = s.DataLoc(s.intpos sp,cv) & for k be Element of NAT st k <
len f holds f.(k+1)=s.DataLoc(s.intpos pD,k)
 holds IExec(for-down(intpos sp,cv,
1, AddTo(intpos sp,result,intpos pD,0) ';'
AddTo(intpos pp,0,1)),P,s).DataLoc(s.
  intpos sp,result)=Sum f;

theorem 
  for s being 0-started State of SCMPDS,
   sp,cv,result,pp,pD be Element of NAT, f be
FinSequence of NAT st s.intpos sp > sp & cv < result & s.intpos sp+result < pp
  & pp <pD & pD < s.intpos pD & len f = s.DataLoc(s.intpos sp,cv) & for k be
Element of NAT st k < len f holds f.(k+1)=s.DataLoc(s.intpos pD,k)
 holds IExec(
  sum(sp,cv,result,pp,pD),P,s).DataLoc(s.intpos sp,result)=Sum f;















begin 

reserve x,a for Int_position,
  s for State of SCMPDS;

theorem 
  for a be Int_position ex i being Element of NAT st a = intpos i;

canceled;

theorem 
  for t being State of SCMPDS,i being Instruction of SCMPDS st
  InsCode i in {0,4,5,6,14} holds Initialize(t)=Initialize(Exec(i,t));

canceled;

theorem 
  for a be Int_position holds
   ex f be Function of product the_Values_of SCMPDS,NAT
    st for s being State of SCMPDS holds (s.a <= 0
  implies f.s =0) & (s.a > 0 implies f.s=s.a);

begin 



definition
 canceled;
  let a be Int_position, i be Integer,I be Program of SCMPDS;
  func while<0(a,i,I) -> Program of SCMPDS equals

  (a,i)>=0_goto (card I +2)
  ';' I ';' goto -(card I+1);
end;

registration
  let I be shiftable Program of SCMPDS,a be Int_position,i be Integer;
  cluster while<0(a,i,I) -> shiftable;
end;

registration
  let I be halt-free Program of SCMPDS, a be Int_position,i be Integer;
  cluster while<0(a,i,I) -> halt-free;
end;

theorem 
  for a be Int_position,i be Integer,I be Program of SCMPDS holds
  card while<0(a,i,I)= card I +2;

theorem 
  for a be Int_position,i be Integer,m be Element of NAT,I be
  Program of SCMPDS holds m < card I+2 iff  m in dom while<0(a,i,I);

theorem 
  for a be Int_position,i be Integer,I be Program of SCMPDS holds
while<0(a,i,I). 0=(a,i)>=0_goto (card I +2) & while<0(a,i,I). (card
  I+1)=goto -(card I+1);

reserve P,Q for Instruction-Sequence of SCMPDS;

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,a being
  Int_position, i being Integer st s.DataLoc(s.a,i) >= 0 holds while<0(a,i,I)
  is_closed_on s,P & while<0(a,i,I) is_halting_on s,P;

theorem 
  for s being 0-started State of SCMPDS,I being Program of SCMPDS,a,c being
Int_position, i being Integer st s.DataLoc(s.a,i) >= 0
 holds IExec(while<0(a,i,I),P,s) = s +* Start-At((card I+2),SCMPDS);

theorem 
  for s being 0-started State of SCMPDS,I being Program of SCMPDS,a being
Int_position, i being Integer st s.DataLoc(s.a,i) >= 0
 holds IC IExec(while<0(a,i,I),P,s) = card I + 2;

theorem 
  for s being 0-started State of SCMPDS,I being Program of SCMPDS, a,b being
Int_position , i being Integer st s.DataLoc(s.a,i) >= 0
 holds IExec(while<0(a,i,I),P,s).b = s.b;

scheme 

  WhileLHalt { F(State of SCMPDS)-> Element of NAT,
    s() -> 0-started State of SCMPDS,
    P() -> Instruction-Sequence of SCMPDS,
    I() -> halt-free shiftable Program of SCMPDS,
    a() -> Int_position,i() -> Integer, P[State of SCMPDS]}:
   while<0(a(),i(),I()) is_closed_on s(),P() &
   while<0(a(),i(),I()) is_halting_on s(), P()
provided
 for t be 0-started State of SCMPDS st P[t] & F(t)=0
    holds t.DataLoc(s().a(),i()) >= 0 and
 P[s()] and
 for t be 0-started State of SCMPDS, Q
    st P[t] & t.a()=s().a() & t.DataLoc(s().a(),i()) < 0
     holds IExec(I(),Q,t).a()=t.a() &
       I() is_closed_on t,Q & I() is_halting_on t,Q &
   F(Initialize IExec(I(),Q,t)) < F(t) &
   P[Initialize(IExec(I(),Q,t))];

scheme 

  WhileLExec { F(State of SCMPDS)-> Element of NAT,
    s() -> 0-started State of SCMPDS,
    P() -> Instruction-Sequence of SCMPDS,
    I() -> halt-free shiftable Program of SCMPDS,
    a() -> Int_position,i() -> Integer, P[State of SCMPDS]}:
   IExec(while<0(a(),i(),I()),P(),s())
    = IExec(while<0(a(),i(),I()),P(),Initialize IExec(I(),P(),s()))
provided
 s().DataLoc(s().a(),i()) < 0 and
 for t be 0-started State of SCMPDS st P[t] & F(t)=0
     holds t.DataLoc(s().a(),i()) >= 0 and
 P[s()] and
 for t be 0-started State of SCMPDS,Q
   st P[t] & t.a()=s().a() & t.DataLoc(s().a(),i()) < 0
  holds IExec(I(),Q,t).a()=t.a() &
    I() is_closed_on t,Q & I() is_halting_on t,Q &
    F(Initialize IExec(I(),Q,t)) < F(t) & P[Initialize(IExec(I(),Q,t))];

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable Program of
SCMPDS , a be Int_position, i be Integer,X be set,
    f being Function of product the_Values_of SCMPDS,NAT st
 (for t being 0-started State of SCMPDS st f.t=0 holds t.DataLoc(s.a,i) >= 0) &
(for t be 0-started State of SCMPDS,Q st (for x
be Int_position st x in X holds t.x=s.x) & t.a=s.a & t.DataLoc(s.a,i) < 0 holds
  IExec(I,Q,t).a=t.a & f.Initialize(IExec(I,Q,t)) < f.t
   & I is_closed_on t,Q & I
is_halting_on t,Q & for x be Int_position st x in X holds IExec(I,Q,t).x=t.x)
 holds
  while<0(a,i,I) is_closed_on s, P & while<0(a,i,I) is_halting_on s, P;

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable Program of
  SCMPDS, a be Int_position, i be Integer,X be set,
    f being Function of product the_Values_of SCMPDS,NAT
     st s.DataLoc(s.a,i) < 0 &
 (for t be 0-started State of SCMPDS st f.t=0 holds t.DataLoc(s.a,i) >= 0 ) &
   (for t be 0-started State of SCMPDS,Q
    st (for x be Int_position st x in X holds t.x=s.x) & t.a=s.a &
  t.DataLoc(s.a,i) < 0 holds IExec(I,Q,t).a=t.a &
  I is_closed_on t,Q & I
is_halting_on t,Q & f.Initialize(IExec(I,Q,t)) < f.t
 & for x be Int_position st
x in X holds IExec(I,Q,t).x=t.x) holds IExec(while<0(a,i,I),P,s)
 =IExec(while<0(a,i,I),P,Initialize IExec(I,P,s));

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable
  Program of SCMPDS, a be Int_position, i be Integer,X be set st
   (for t be 0-started State of SCMPDS,Q st
   (for x be Int_position st x in X holds t.x=s.x) & t .a=s.a
     & t.DataLoc(s.a,i) < 0
   holds IExec(I,Q,t).a=t.a & IExec(I,Q,t).DataLoc(s.a,i) > t.DataLoc(s.a,i)
     & I is_closed_on t,Q & I is_halting_on t,Q & for x be
  Int_position st x in X holds IExec(I,Q,t).x=t.x)
  holds while<0(a,i,I) is_closed_on s, P & while<0(a,i,I) is_halting_on s, P;

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable Program of
SCMPDS , a be Int_position,i be Integer,X be set st s.DataLoc(s.a,i) < 0
 & (for t be 0-started State of SCMPDS,Q
 st (for x be Int_position st x in X holds t.x
  =s.x) & t.a=s.a & t.DataLoc(s.a,i) < 0 holds
  IExec(I,Q,t).a=t.a & IExec(I,Q,t).
DataLoc(s.a,i) > t.DataLoc(s.a,i) & I is_closed_on t,Q & I is_halting_on t,Q
 & for x be Int_position st x in X holds IExec(I,Q,t).x=t.x)
 holds IExec(while<0(a,i,I),P,s)
      =IExec(while<0(a,i,I),P,Initialize IExec(I,P,s));

begin 



definition
  let a be Int_position, i be Integer,I be Program of SCMPDS;
  func while>0(a,i,I) -> Program of SCMPDS equals

  (a,i)<=0_goto (card I +2) ';' I ';' goto -(card I+1);
end;

registration
  let I be shiftable Program of SCMPDS,a be Int_position,i be Integer;
  cluster while>0(a,i,I) -> shiftable;
end;

registration
  let I be halt-free Program of SCMPDS,a be Int_position,i be Integer;
  cluster while>0(a,i,I) -> halt-free;
end;

theorem 
  for a be Int_position,i be Integer,I be Program of SCMPDS holds
  card while>0(a,i,I)= card I +2;

theorem 
  for a be Int_position,i be Integer,m be Element of NAT,I be
  Program of SCMPDS holds m < card I+2 iff  m in dom while>0(a,i,I);

theorem 
  for a be Int_position,i be Integer,I be Program of SCMPDS holds
   while>0(a,i,I). 0=(a,i)<=0_goto (card I +2) &
   while>0(a,i,I). (card I+1)=goto -(card I+1);

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,a being
  Int_position, i being Integer st s.DataLoc(s.a,i) <= 0 holds while>0(a,i,I)
  is_closed_on s, P & while>0(a,i,I) is_halting_on s, P;

theorem 
  for s being 0-started State of SCMPDS,I being Program of SCMPDS,a,c being
Int_position, i being Integer st s.DataLoc(s.a,i) <= 0
 holds IExec(while>0(a,i,I),P,s) = s +* Start-At((card I+2),SCMPDS);

theorem 
  for s being 0-started State of SCMPDS,I being Program of SCMPDS,a being
Int_position, i being Integer st s.DataLoc(s.a,i) <= 0
 holds IC IExec(while>0(a,i,I),P,s) =  (card I + 2);

theorem 
  for s being 0-started State of SCMPDS,I being Program of SCMPDS, a,b being
Int_position , i being Integer st s.DataLoc(s.a,i) <= 0
 holds IExec(while>0(a,i,I),P,s).b = s.b;

scheme 

  WhileGHalt { F(State of SCMPDS)-> Element of NAT,
    s() -> 0-started State of SCMPDS,
    P() -> Instruction-Sequence of SCMPDS,
    I() -> halt-free shiftable Program of SCMPDS,
    a() -> Int_position,i() -> Integer, P[State of SCMPDS]}:
  while>0(a(),i(),I()) is_closed_on s(), P() &
  while>0(a(),i(),I()) is_halting_on s(), P()
provided
 for t be 0-started State of SCMPDS st P[t] & F(t)=0
    holds t.DataLoc(s().a(),i()) <= 0 and
 P[s()] and
 for t be 0-started State of SCMPDS,Q
 st P[t] & t.a()=s().a() & t.DataLoc(s().a(),i()) > 0
  holds IExec(I(),Q,t).a()=t.a() &
 I() is_closed_on t,Q & I() is_halting_on t,Q &
 F(Initialize IExec(I(),Q,t)) < F(t)
 & P[Initialize(IExec(I(),Q,t))];

scheme 

  WhileGExec { F(State of SCMPDS)-> Element of NAT,
    s() -> 0-started State of SCMPDS,
    P() -> Instruction-Sequence of SCMPDS,
    I() -> halt-free shiftable Program of SCMPDS,
    a() -> Int_position,i() -> Integer,P[State of SCMPDS]}:
 IExec(while>0(a(),i(),I()),P(),s()) =
   IExec(while>0(a(),i(),I()),P(),Initialize IExec(I(),P(),s()))
provided
 s().DataLoc(s().a(),i()) > 0 and
 for t be 0-started State of SCMPDS st P[t] & F(t)=0
   holds t.DataLoc(s().a(),i()) <= 0 and
 P[s()] and
 for t be 0-started State of SCMPDS,Q
 st P[t] & t.a()=s().a() & t.DataLoc(s().a(),i()) > 0
  holds IExec(I(),Q,t).a()=t.a() &
    I() is_closed_on t,Q & I() is_halting_on t,Q &
    F(Initialize IExec(I(),Q,t)) < F(t) & P[Initialize(IExec(I(),Q,t))];

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable
  Program of SCMPDS, a be Int_position,i,c be Integer,X,Y be set, f being
  Function of product the_Values_of SCMPDS,NAT st
  (for t be 0-started State of SCMPDS st f.t=0 holds t.DataLoc(s.a,i) <= 0) &
  (for x st x in X holds s.x >= c+s.DataLoc(s.a,i)) &
  (for t be 0-started State of SCMPDS,Q st
   (for x st x in X holds t.x >= c+t.DataLoc(s.a,i)) &
   (for x st x in Y holds t.x=s.x) & t.a=s.a & t.DataLoc(s.a,i) > 0
    holds IExec(I,Q,t).a=t.a &
     I is_closed_on t,Q & I is_halting_on t,Q &
     f.Initialize(IExec(I,Q,t)) < f.t
   & (for x st x in X holds IExec(I,Q,t).x >= c+IExec(I,Q,t).DataLoc(s.a,i))
 & for x st x in Y holds IExec(I,Q,t).x=t.x)
  holds while>0(a,i,I) is_closed_on s, P &
     while>0(a,i,I) is_halting_on s, P;

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable
  Program of SCMPDS, a be Int_position, i,c be Integer,X,Y be set,f being
  Function of product the_Values_of SCMPDS,NAT st s.DataLoc(s.a,i) > 0 &
 (for t be 0-started State of SCMPDS st f.t=0 holds t.DataLoc(s.a,i) <= 0) &
 (for x st x in X holds s.x >= c+s.DataLoc(s.a,i)) &
 (for t be 0-started State of SCMPDS,Q
  st (for x st x in X holds t.x >= c+t.DataLoc(s.a,i)) &
  (for x st x in Y holds t.x=s.x) & t.a=s.a & t.DataLoc(s.a,i) > 0
  holds IExec(I,Q,t).a=t.a & I is_closed_on t,Q & I is_halting_on t,Q &
   f.Initialize(IExec(I,Q,t)) < f.t
 & (for x st x in X holds IExec(I,Q,t).x >= c+IExec(I,Q,t).DataLoc(s.a,i))
 & for x st x in Y holds IExec(I,Q,t).x=t.x)
 holds IExec(while>0(a,i,I),P,s)
  =IExec(while>0(a,i,I),P,Initialize IExec(I,P,s));

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable Program of
SCMPDS , a be Int_position, i be Integer,X be set,
  f being Function of product the_Values_of SCMPDS,NAT st
 (for t be 0-started State of SCMPDS st f.t=0 holds t.DataLoc(s.a,i) <= 0) &
 (for t be 0-started State of SCMPDS,Q st (for x
st x in X holds t.x=s.x) & t.a=s.a & t.DataLoc(s.a,i) > 0
 holds IExec(I,Q,t).a=t.
a & I is_closed_on t,Q & I is_halting_on t,Q
 & f.Initialize(IExec(I,Q,t)) < f.t &
  for x st x in X holds IExec(I,Q,t).x=t.x)
   holds while>0(a,i,I) is_closed_on s, P &
while>0(a,i,I) is_halting_on s, P & (s.DataLoc(s.a,i) > 0 implies
IExec(while>0(a,i,I),P,s)
 =IExec(while>0(a,i,I),P,Initialize IExec(I,P,s)));

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable
Program of SCMPDS, a be Int_position, i,c be Integer,X,Y be set st
  (for x st x in X holds s.x >= c+s.DataLoc(s.a,i)) &
   (for t be 0-started State of SCMPDS,Q
st (for x st x in X holds t.x >= c+t.DataLoc(s.a,i)) &
  (for x st x in Y holds t.x=s.x) & t.a=s.a & t.DataLoc(s.a,i) > 0
   holds IExec(I,Q,t).a=t.a & I
is_closed_on t,Q & I is_halting_on t,Q
 & IExec(I,Q,t).DataLoc(s.a,i) < t.DataLoc(s.a,
i) & (for x st x in X holds IExec(I,Q,t).x >=
c+IExec(I,Q,t).DataLoc(s.a,i))
 & for x st x in Y holds IExec(I,Q,t).x=t.x)
   holds while>0(a,i,I) is_closed_on s, P &
while>0(a,i,I) is_halting_on s, P &
 (s.DataLoc(s.a,i) > 0 implies IExec(while>0(a,i,I),P,s)
   =IExec(while>0(a,i,I),P,Initialize IExec(I,P,s)));

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable Program of
  SCMPDS , a be Int_position, i be Integer,X be set st
   (for t be 0-started State of SCMPDS,Q
    st (for x st x in X holds t.x=s.x) &
    t.a=s.a & t.DataLoc(s.a,i)
> 0 holds IExec(I,Q,t).a=t.a & I is_closed_on t,Q &
I is_halting_on t,Q
 & IExec(I,Q,t).DataLoc(s.a,i) < t.DataLoc(s.a,i) & for x st x in X
   holds IExec(I,Q,t).x=t.x)
  holds while>0(a,i,I) is_closed_on s, P & while>0(a,i,I) is_halting_on s, P
   & (s.DataLoc(s.a,i) > 0 implies IExec(while>0(a,i,I),P,s)
 =IExec(while>0(a,i,I),P,Initialize IExec(I,P,s)));

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable Program of
SCMPDS , a be Int_position, i,c be Integer,X be set st
 (for x st x in X holds s.x >= c+s.DataLoc(s.a,i)) &
 (for t be 0-started State of SCMPDS,Q st (for x st
x in X holds t.x >= c+t.DataLoc(s.a,i)) & t.a=s.a & t.DataLoc(s.a,i) > 0 holds
IExec(I,Q,t).a=t.a & I is_closed_on t,Q & I is_halting_on t,Q
 & IExec(I,Q,t).DataLoc(s.
  a,i) < t.DataLoc(s.a,i) & for x st x in X
   holds IExec(I,Q,t).x >= c+IExec(I,Q,t).DataLoc(s.a,i))
    holds while>0(a,i,I) is_closed_on s, P & while>0(a,i,I)
is_halting_on s, P & (s.DataLoc(s.a,i) > 0
 implies
  IExec(while>0(a,i,I),P,s) =IExec(while>0(a,i,I),P,Initialize IExec(I,P,s)));















begin 

reserve x for Int_position,
  n,p0 for Element of NAT;

definition
  let f be FinSequence of INT,s be State of SCMPDS,m be Element of NAT;
  pred f is_FinSequence_on s,m means


  for i be Element of NAT st 1 <= i
  & i <= len f holds f.i=s.intpos(m+i);
end;

theorem 
  for s being State of SCMPDS,n,m be Element of NAT holds ex f be
  FinSequence of INT st len f=n & for i be Element of NAT st 1<=i & i <= len f
  holds f.i=s.intpos(m+i);

theorem 
  for s being State of SCMPDS,n,m be Element of NAT holds ex f be
  FinSequence of INT st len f=n & f is_FinSequence_on s,m;

theorem 
  for f,g be FinSequence of INT,m,n be Element of NAT st 1<=n & n
  <= len f & 1<=m & m <= len f & len f=len g & f.m=g.n & f.n=g.m & (for k be
  Element of NAT st k<>m & k<>n & 1<=k & k <= len f holds f.k=g.k) holds f,g
  are_fiberwise_equipotent;

theorem 
  for s1,s2 being State of SCMPDS st (for a being Int_position
  holds s1.a = s2.a) holds Initialize (s1)=Initialize (s2);

reserve P,Q,U,V for Instruction-Sequence of SCMPDS;

theorem 
  for s being State of SCMPDS, I being halt-free Program of
SCMPDS, j being parahalting shiftable Instruction of SCMPDS
 st I is_closed_on s,P
& I is_halting_on s,P holds (I ';' j) is_closed_on s,P
 & (I ';' j) is_halting_on s,P;

theorem 
  for s being 0-started State of SCMPDS, I being halt-free Program of SCMPDS, J
  being shiftable parahalting Program of SCMPDS,a be Int_position st I
is_closed_on s,P & I is_halting_on s,P holds IExec(I ';' J,P,s).a
 = IExec(J,P,Initialize IExec(I,P,s)).a;

theorem 
  for s being 0-started State of SCMPDS, I being halt-free parahalting Program
  of SCMPDS , J being shiftable Program of SCMPDS,a be Int_position
   st J is_closed_on IExec(I,P,s),P & J is_halting_on IExec(I,P,s),P
 holds IExec(I ';' J,P,s).a = IExec(J,P,Initialize IExec(I,P,s)).a;

theorem 
  for s being State of SCMPDS, I being Program of SCMPDS,J being
shiftable parahalting Program of SCMPDS st I is_closed_on s,P
 & I is_halting_on s,P
  holds I ';' J is_closed_on s,P & I ';' J is_halting_on s,P;

theorem 
  for s being State of SCMPDS, I being parahalting Program of SCMPDS,J
  being shiftable Program of SCMPDS st
  J is_closed_on IExec(I,P,Initialize s),P & J
is_halting_on IExec(I,P,Initialize s),P holds I ';' J is_closed_on s,P
 & I ';' J is_halting_on s,P;

theorem 
  for s being State of SCMPDS, I being Program of SCMPDS, j being
  parahalting shiftable Instruction of SCMPDS st I is_closed_on s,P & I
  is_halting_on s,P holds I ';' j is_closed_on s,P & I ';' j is_halting_on s,P;

begin 

scheme 

  ForDownHalt { P[set],
  s() -> 0-started State of SCMPDS,
  P() -> Instruction-Sequence of SCMPDS,
  I() -> halt-free shiftable
Program of SCMPDS, a() -> Int_position,i() -> Integer,n() -> Element of NAT}:
for-down(a(),i(),n(),I()) is_closed_on s(), P()
 & for-down(a(),i(),n(),I()) is_halting_on s(), P()
provided
 n() > 0 and
 P[s()] and
 for t be 0-started State of SCMPDS,Q
  st P[t] & t.a()=s().a() & t.DataLoc(s().a(),i()) > 0
 holds IExec(I() ';' AddTo(a(),i(),-n()),Q,t).a()=t.a()
 & IExec(I() ';' AddTo(a(),i(),-n()),Q,t).DataLoc(s().a(),i())
 =t.DataLoc(s().a(),i())-n()
& I() is_closed_on t,Q & I() is_halting_on t,Q
 & P[Initialize (IExec(I() ';' AddTo(a(),i(),-n()),Q,t))];

scheme 

  ForDownExec { P[set], s() -> 0-started State of SCMPDS,
  P() -> Instruction-Sequence of SCMPDS,
  I() -> halt-free shiftable
Program of SCMPDS, a() -> Int_position,i() -> Integer,n() -> Element of NAT}:
 IExec(for-down(a(),i(),n(),I()),P(),s())
 = IExec(for-down(a(),i(),n(),I()),P(),
     Initialize IExec(I() ';' AddTo(a(),i(),-n()),P(), s()))
provided
 n() > 0 and
 s().DataLoc(s().a(),i()) > 0 and
 P[s()] and
 for t be 0-started State of SCMPDS,Q
 st P[t] & t.a()=s().a() & t.DataLoc(s().a(),i()) > 0
 holds IExec(I() ';' AddTo(a(),i(),-n()),Q,t).a()=t.a() &
IExec(I
() ';' AddTo(a(),i(),-n()),Q,t).DataLoc(s().a(),i())
 =t.DataLoc(s().a(),i())-n()
& I() is_closed_on t,Q & I() is_halting_on t,Q
 & P[Initialize IExec(I() ';' AddTo(a(),i(),-n()),Q,t)];

scheme 

  ForDownEnd { P[set], s() -> 0-started State of SCMPDS,
    I() -> halt-free shiftable Program of SCMPDS,
  P() -> Instruction-Sequence of SCMPDS,
a() -> Int_position,i() -> Integer,n() -> Element of NAT}:
 IExec(for-down(a(),i(),n(),I()),P(),s()).DataLoc(s().a(),i(
  )) <= 0 & P[Initialize  IExec(for-down(a(),i(),n(),I()),P(),s())]
provided
 n() > 0 and
 P[s()] and
 for t be 0-started State of SCMPDS st P[t] &
 t.a()=s().a() & t.DataLoc(s().a(),i()) > 0 holds
 IExec(I() ';' AddTo(a(),i(),-n()),Q,t).a()=t.a() & IExec(I
() ';' AddTo(a(),i(),-n()),Q,t).DataLoc(s().a(),i())
 =t.DataLoc(s().a(),i())-n()
& I() is_closed_on t,Q & I() is_halting_on t,Q
 & P[Initialize (IExec(I() ';' AddTo(a(),i(),-n()),Q,t))];

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable
Program of SCMPDS, a,x,y be Int_position, i,c be Integer,n be Element of NAT st
n > 0 & s.x >= s.y +c &
 for t be 0-started State of SCMPDS,Q st t.x >= t.y +c & t.a=s.a & t
  .DataLoc(s.a,i) > 0 holds
   IExec(I ';' AddTo(a,i,-n),Q,t).a=t.a & IExec(I ';'
  AddTo(a,i,-n),Q,t).DataLoc(s.a,i)=t.DataLoc(s.a,i)-n
   & I is_closed_on t,Q & I
is_halting_on t,Q
 & IExec(I ';' AddTo(a,i,-n),Q,t).x >=IExec(I ';' AddTo(a,i,-n),Q,t).y+c
  holds for-down(a,i,n,I) is_closed_on s,P &
        for-down(a,i,n,I) is_halting_on s,P;

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable
Program of SCMPDS, a,x,y be Int_position, i,c be Integer,n be Element of NAT st
n > 0 & s.x >= s.y +c & s.DataLoc(s.a,i) > 0 &
for t be 0-started State of SCMPDS,Q st t.x
>= t.y +c & t.a=s.a & t.DataLoc(s.a,i) > 0
 holds IExec(I ';' AddTo(a,i,-n),Q,t).a
  =t.a & IExec(I ';' AddTo(a,i,-n),Q,t).DataLoc(s.a,i)
  =t.DataLoc(s.a,i)-n & I
  is_closed_on t,Q & I is_halting_on t,Q
   & IExec(I ';' AddTo(a,i,-n),Q,t).x>=IExec(I
';' AddTo(a,i,-n),Q,t).y+c
holds IExec(for-down(a,i,n,I),P,s) = IExec(for-down(a,i,
  n,I),P,Initialize IExec(I ';' AddTo(a,i,-n),P,s));

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable Program of
SCMPDS , a be Int_position, i be Integer,n be Element of NAT
 st s.DataLoc(s.a,i) > 0 & n > 0 & a <> DataLoc(s.a,i) &
 (for t be 0-started State of SCMPDS,Q st t.a=s.a
 holds IExec(I,Q,t).a=t.a
 & IExec(I,Q,t).DataLoc(s.a,i)=t.DataLoc(s.a,i) & I
  is_closed_on t,Q & I is_halting_on t,Q) holds
   for-down(a,i,n,I) is_closed_on s,P &
  for-down(a,i,n,I) is_halting_on s,P;

begin 



definition
  let n,p0 be Element of NAT;
  func insert-sort(n,p0) -> Program of SCMPDS equals

  ((GBP:=0) ';' ((GBP,1):=0
) ';' ((GBP,2):=(n-1)) ';' ((GBP,3):=p0)) ';' for-down(GBP,2,1, AddTo(GBP,3,1)
  ';' ((GBP,4):=(GBP,3)) ';' AddTo(GBP,1,1) ';' ((GBP,6):=(GBP,1)) ';' while>0(
GBP,6, ((GBP,5):=(intpos 4,-1)) ';' SubFrom(GBP,5,intpos 4,0) ';' if>0(GBP,5, (
(GBP,5):=(intpos 4,-1)) ';' ((intpos 4,-1):=(intpos 4,0)) ';' ((intpos 4,0 ):=(
  GBP,5)) ';' AddTo(GBP,4,-1) ';' AddTo(GBP,6,-1), Load ((GBP,6):=0) ) ) );
end;

begin 

theorem 
  card insert-sort (n,p0) = 23;

theorem 
  p0 >= 7 implies insert-sort (n,p0) is parahalting;

theorem 
  for s being 0-started State of SCMPDS,
  f,g be FinSequence of INT, k0,k
being Element of NAT st s.(intpos 4) >= 7+s.(intpos 6) & s.GBP=0 & k=s.(intpos
  6) & k0=s.(intpos 4)-s.(intpos 6)-1 & f is_FinSequence_on s,k0 & g
is_FinSequence_on IExec(while>0(GBP,6,((GBP,5):=(intpos 4,-1)) ';' (SubFrom(GBP
,5,intpos 4,0)) ';' (if>0(GBP,5, ((GBP,5):=(intpos 4,-1)) ';' ((intpos 4,-1):=(
intpos 4,0)) ';' ((intpos 4,0 ):=(GBP,5)) ';' (AddTo(GBP,4,-1)) ';' (AddTo(GBP,
  6,-1)),Load ((GBP,6):=0)))),P,s),k0 &
   len f=len g & len f > k & f
  is_non_decreasing_on 1,k holds f,g are_fiberwise_equipotent & g
  is_non_decreasing_on 1,k+1 & (for i be Element of NAT st i>k+1 & i <= len f
  holds f.i=g.i) & for i be Element of NAT st 1 <= i & i <= k+1 holds ex j be
  Element of NAT st 1 <= j & j <= k+1 & g.i=f.j;

theorem 
  for s being 0-started State of SCMPDS,f,g be FinSequence of INT,p0,
      n being Element of NAT
     st p0 >= 6 & len f=n & len g = n & f is_FinSequence_on s,p0 &
     g is_FinSequence_on IExec(insert-sort(n,p0+1),P,s),p0
      holds f,g are_fiberwise_equipotent & g is_non_decreasing_on 1,n;















begin 

reserve x for Int_position,
  n,p0 for Element of NAT;

registration
  let I,J be shiftable Program of SCMPDS, a be Int_position,k1 be Integer;
  cluster if>0(a,k1,I,J) -> shiftable;
end;

reserve P,Q,V for Instruction-Sequence of SCMPDS;

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable Program
  of SCMPDS, J being shiftable Program of SCMPDS,a,b be Int_position,k1 being
  Integer st s.DataLoc(s.a,k1) > 0 & I is_closed_on s,P & I is_halting_on s,P
   holds
  IExec(if>0(a,k1,I,J),P,s).b = IExec(I,P,s).b;

theorem 
  for s,sm be State of SCMPDS,I be halt-free shiftable Program of
  SCMPDS, a be Int_position,i be Integer, m be Element of NAT st
  I is_closed_on s,P & I is_halting_on s,P & s.DataLoc(s.a,i) > 0 &
   m=LifeSpan(P +* stop I,Initialize s)+2 &
 sm=Comput(P +* stop while>0(a,i,I),Initialize s,m)
 holds DataPart sm = DataPart IExec(I,P,Initialize s) &
   Initialize sm=sm;

theorem 
  for s be State of SCMPDS,I be Program of SCMPDS st
   for t be 0-started State of SCMPDS, Q st DataPart t = DataPart s
    holds I is_halting_on t,Q
  holds I is_closed_on s,P;

theorem 
  for i1,i2,i3,i4 be Instruction of SCMPDS holds
  card (i1 ';' i2 ';' i3 ';' i4) = 4;

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable Program
  of SCMPDS, a,x,y be Int_position, i,c be Integer st s.x >= c+s.
DataLoc(s.a,i) &
(for t be 0-started State of SCMPDS,Q st t.x >= c+t.DataLoc(s.a,i) & t.y=s
.y & t.a=s.a & t.DataLoc(s.a,i) > 0
 holds IExec(I,Q,t).a=t.a & I is_closed_on t,Q &
I is_halting_on t,Q & IExec(I,Q,t).DataLoc(s.a,i) < t.DataLoc(s.a,i)
 & IExec(I,Q,t).x
  >= c+IExec(I,Q,t).DataLoc(s.a,i) & IExec(I,Q,t).y=t.y)
 holds while>0(a,i,I) is_closed_on s,P & while>0(a,i,I) is_halting_on s,P &
 (s.DataLoc(s.a,i) > 0 implies
  IExec(while>0(a,i,I),P,s)
   =IExec(while>0(a,i,I),P,Initialize IExec(I,P,s)));

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable Program
  of SCMPDS, a,x,y be Int_position, i,c be Integer st s.x >= c & (
for t be 0-started State of SCMPDS,Q
 st t.x >= c & t.y=s.y & t.a=s.a & t.DataLoc(s.a,i) > 0
  holds IExec(I,Q,t).a=t.a & I is_closed_on t,Q
   & I is_halting_on t,Q & IExec(I,Q,t).
DataLoc(s.a,i) < t.DataLoc(s.a,i) & IExec(I,Q,t).x >= c
 & IExec(I,Q,t).y=t.y) holds
while>0(a,i,I) is_closed_on s,P & while>0(a,i,I) is_halting_on s,P
 & ( s.DataLoc(s.a,i) > 0
   implies IExec(while>0(a,i,I),P,s)
   =IExec(while>0(a,i,I),P,Initialize IExec(I,P,s)));

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable Program
of SCMPDS, a,x1,x2,x3,x4 be Int_position, i,c,md be Integer st s.
x4=s.x3-c+s.x1 & md <= s.x3-c &
 (for t be 0-started State of SCMPDS,Q st t.x4=t.x3-c+t.x1 &
md <= t.x3-c & t.x2=s.x2 & t.a=s.a & t.DataLoc(s.a,i) > 0
 holds IExec(I,Q,t).a=t.
  a & I is_closed_on t,Q & I is_halting_on t,Q
   & IExec(I,Q,t).DataLoc(s.a,i) < t.
DataLoc(s.a,i) & IExec(I,Q,t).x4=
IExec(I,Q,t).x3-c+IExec(I,Q,t).x1
 & md <= IExec(I,Q,t)
.x3-c & IExec(I,Q,t).x2=t.x2) holds while>0(a,i,I) is_closed_on s,P
 & while>0(a,i,I) is_halting_on s,P & ( s.DataLoc(s.a,i) > 0
   implies IExec(while>0(a,i,I),P,s) =
  IExec(while>0(a,i,I),P,Initialize IExec(I,P,s)) );

theorem 
  for f being FinSequence of INT,m,k1,k,n be Element of NAT st k1=k
  -1 & f is_non_decreasing_on m,k1 & f is_non_decreasing_on k+1,n & (for i be
  Element of NAT st m <= i & i < k holds f.i <= f.k) & (for i be Element of NAT
  st k < i & i <= n holds f.k <= f.i) holds f is_non_decreasing_on m,n;

begin 




definition
  func Partition -> Program of SCMPDS equals

  ((GBP,5):=(GBP,4) ';' SubFrom(GBP
,5,GBP,2) ';' (GBP,3):=(GBP,2) ';' AddTo(GBP,3,1)) ';' while>0(GBP,5, while>0(
  GBP,5, (GBP,7):=(GBP,5) ';' AddTo(GBP,5,-1) ';' (GBP,6):=(intpos 4,0) ';'
SubFrom(GBP,6,intpos 2,0) ';' if>0(GBP,6, AddTo(GBP,4,-1) ';' AddTo(GBP,7,-1),
Load (GBP,5):=0 ) ) ';' while>0(GBP,7, (GBP,5):=(GBP,7) ';' AddTo(GBP,7,-1) ';'
(GBP,6):=(intpos 2,0) ';' SubFrom(GBP,6,intpos 3,0) ';' if>0(GBP,6, AddTo(GBP,3
,1) ';' AddTo(GBP,5,-1), Load (GBP,7):=0 ) ) ';' if>0(GBP,5,((GBP,6):=(intpos 4
,0) ';' (intpos 4,0):=(intpos 3,0) ';' (intpos 3,0):=(GBP,6) ';' AddTo(GBP,5,-2
  ) ';' AddTo(GBP,3,1)) ';' AddTo(GBP,4,-1) ) ) ';' (GBP,6):=(intpos 4,0) ';' (
  intpos 4,0):=(intpos 2,0) ';' (intpos 2,0):=(GBP,6);
end;

begin 



definition
  let n,p0 be Element of NAT;
  func QuickSort(n,p0) -> Program of SCMPDS equals

  ((GBP:=0) ';' (SBP:=1) ';'
(SBP,p0+n):=(p0+1) ';' (SBP,p0+n+1):=(p0+n)) ';' while>0(GBP,1, (GBP,2):=(SBP,
  p0+n+1) ';' SubFrom(GBP,2,SBP,p0+n) ';' if>0(GBP,2, (GBP,2):=(SBP,p0+n) ';' (
GBP,4):=(SBP,p0+n+1) ';' Partition ';' (((SBP,p0+n+3):=(SBP,p0+n+1) ';' (SBP,p0
  +n+1):=(GBP,4) ';' (SBP,p0+n+2):=(GBP,4) ';' AddTo(SBP,p0+n+1,-1)) ';' AddTo(
  SBP,p0+n+2,1) ';' AddTo(GBP,1,2)), Load AddTo(GBP,1,-2) ) );
end;

begin 



theorem 
  card Partition=38;

theorem 
  for s be 0-started State of SCMPDS,
  md,p0 be Element of NAT st s.GBP=0 & s.
  intpos 2=md & md >= p0+1 & p0 >= 7 holds Partition is_closed_on s,P
   & Partition
  is_halting_on s,P;

theorem 
  for s be 0-started State of SCMPDS,
  md,p0,n be Element of NAT,f,f1 be
FinSequence of INT st s.GBP=0 & s.intpos 4-s.intpos 2 > 0 & s.intpos 2=md & md
  >= p0+1 & s.intpos 4 <= p0+n & p0 >= 7 & f is_FinSequence_on s,p0 & len f=n &
f1 is_FinSequence_on IExec(Partition,P,s),p0 & len f1=n holds
IExec(Partition,P,s).GBP=0 &
IExec(Partition,P,s).intpos 1=s.intpos 1 &
 f,f1 are_fiberwise_equipotent
& ex m4 be Element of NAT
   st m4=IExec(Partition,P,s).intpos 4 &
      md <= m4 & m4 <= s.intpos 4 &
  (for i be Element of NAT st md<=i & i < m4
    holds IExec(Partition,P,s).intpos m4 >=
    IExec(Partition,P,s).intpos i) &
  (for i be Element of NAT st m4 < i & i <= s.intpos 4
    holds IExec(Partition,P,s).intpos m4 <=
    IExec(Partition,P,s).intpos i) &
  for i be Element of NAT st i >= p0+1 & (i < s.intpos 2 or i > s.
    intpos 4) holds IExec(Partition,P,s).intpos i = s.intpos i;

theorem 
  Partition is halt-free shiftable;

begin 

theorem 
  card QuickSort(n,p0)=57;

theorem 
  for p0,n being Element of NAT st p0 >= 7 holds QuickSort(n,p0) is
  parahalting;

theorem 
  for s being 0-started State of SCMPDS,p0,n being Element of NAT st p0 >= 7
ex f,g be FinSequence of INT st len f=n & f is_FinSequence_on s,p0 & len g = n
  & g is_FinSequence_on IExec(QuickSort(n,p0),P,s),p0 & f,g
  are_fiberwise_equipotent & g is_non_decreasing_on 1,n;
















begin 

reserve m,n for Element of NAT,
  i,j for Instruction of SCMPDS,
  I for Program
  of SCMPDS,
  a for Int_position;

theorem 
  (i ';' j ';' I). 0=i & (i ';' j ';' I). 1=j;

theorem 
  for a,b be Int_position holds
   ex f be Function of product the_Values_of SCMPDS,NAT
    st for s being State of SCMPDS holds (s.a = s.b
  implies f.s =0) & (s.a <> s.b implies f.s=max(abs(s.a),abs(s.b)));

theorem 
  ex f be Function of product the_Values_of SCMPDS,NAT
   st for s being State of SCMPDS holds (s.a >= 0 implies f.s =0) &
  (s.a < 0 implies f.s= -s.a);

begin 

reserve Q,U,P for Instruction-Sequence of SCMPDS;

scheme 

  WhileLEnd { F(State of SCMPDS)-> Element of NAT,
  s() -> 0-started State of SCMPDS,
  P() -> Instruction-Sequence of SCMPDS,
  I() -> halt-free shiftable Program of SCMPDS,
  a() -> Int_position,i() -> Integer,
P[set]}: F(Initialize IExec(while<0(a(),i(),I()),P(),s()))=0
 & P[Initialize IExec(while<0(a(),i(),I()),P(),s())]
provided
 for t be 0-started State of SCMPDS st P[t] holds F(t)=0
   iff t.DataLoc(s().a(),i()) >= 0 and
 P[s()] and
 for t be 0-started State of SCMPDS,Q st P[t] & t.a()=s().a() &
   t.DataLoc(s().a(),i()) < 0
 holds IExec(I(),Q,t).a()=t.a() & I() is_closed_on t,Q & I()
is_halting_on t,Q & F(Initialize IExec(I(),Q,t)) < F(t)
 & P[Initialize(IExec(I(),Q,t))];

begin 



definition
  let n, p0 be Element of NAT;
  func sum(n,p0) -> Program of SCMPDS equals

  (GBP:=0) ';' (intpos 1:=0) ';' (
intpos 2:=-n) ';' (intpos 3:=(p0+1)) ';' while<0(GBP,2,AddTo(GBP,1,intpos 3,0)
  ';' AddTo(GBP,2,1) ';' AddTo(GBP,3,1));
end;

definition
 let ff be Function of product the_Values_of SCMPDS,NAT,
     s be State of SCMPDS;
 redefine func ff.s -> Element of NAT;
end;

theorem 
  for s being 0-started State of SCMPDS,
    I being halt-free shiftable Program
  of SCMPDS, a,b,c being Int_position,n,i,p0 be Element of NAT,f be FinSequence
  of INT st f is_FinSequence_on s,p0 & len f=n & s.b=0 & s.a=0 & s.
intpos i=-n & s.c = p0+1 &
 (for t be 0-started State of SCMPDS, Q
    st (ex g be FinSequence of
INT st g is_FinSequence_on s,p0 & len g=t.intpos i+n & t.b=Sum g & t.c = p0+1+
  len g) & t.a=0 & t.intpos i < 0 & for i be Element of NAT st i > p0 holds t.
intpos i=s.intpos i holds IExec(I,Q,t).a=0 & I is_closed_on t,Q
 & I is_halting_on t,Q
  & IExec(I,Q,t).intpos i=t.intpos i+1 &
  (ex g be FinSequence of INT st g
  is_FinSequence_on s,p0 & len g=t.intpos i+n+1 &
  IExec(I,Q,t).c = p0+1+len g &
IExec(I,Q,t).b=Sum g) & for i be Element of NAT st i > p0
 holds IExec(I,Q,t).intpos
  i=s.intpos i)
   holds IExec(while<0(a,i,I),P,s).b=Sum f &
   while<0(a,i,I) is_closed_on s,P & while<0(a,i,I) is_halting_on s,P;

theorem 
  for s being 0-started State of SCMPDS,n,
    p0 be Element of NAT, f be FinSequence
of INT st p0 >= 3 & f is_FinSequence_on s,p0 & len f=n
 holds IExec(sum(n,p0),P,s).intpos 1=Sum f & sum(n,p0) is parahalting;

begin 

scheme 

  WhileGEnd { F(State of SCMPDS)-> Element of NAT,
  s() -> 0-started State of SCMPDS,
  P() -> Instruction-Sequence of SCMPDS,
  I() -> halt-free shiftable Program of SCMPDS,
  a() -> Int_position,i() -> Integer, P[set]}:
   F(Initialize IExec(while>0(a(),i(),I()),P(),s()))=0
 & P[Initialize IExec(while>0(a(),i(),I()),P(),s())]
provided
 for t be 0-started State of SCMPDS st P[t]
 holds F(t)=0 iff t.DataLoc(s().a(),i()) <= 0 and
 P[s()] and
 for t be 0-started State of SCMPDS,Q
    st P[t] & t.a()=s().a() & t.DataLoc(
s().a(),i()) > 0 holds IExec(I(),Q,t).a()=t.a() &
I() is_closed_on t,Q & I()
is_halting_on t,Q & F(Initialize IExec(I(),Q,t)) < F(t)
 & P[Initialize(IExec(I(),Q,t))];

begin 

definition
  let n be Element of NAT;
  func Fib-macro(n) -> Program of SCMPDS equals

  (GBP:=0) ';' (intpos 1:=0) ';'
(intpos 2:=1) ';' (intpos 3:=n) ';' while>0(GBP,3,((GBP,4):=(GBP,2)) ';' AddTo(
  GBP,2,GBP,1) ';' ((GBP,1):=(GBP,4)) ';' AddTo(GBP,3,-1));
end;

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable
Program of SCMPDS, a,f0,f1 being Int_position,n,i be Element of NAT
 st s.a=0 & s.f0=0 & s.f1=1 & s.intpos i=n &
  (for t be 0-started State of SCMPDS,Q
  for k be
  Element of NAT st n=t.intpos i+k & t.f0=Fib k & t.f1 = Fib (k+1) & t.a=0 & t.
  intpos i > 0 holds IExec(I,Q,t).a=0 & I is_closed_on t,Q
   & I is_halting_on t,Q &
  IExec(I,Q,t).intpos i=t.intpos i-1
   & IExec(I,Q,t).f0=Fib (k+1) &
   IExec(I,Q,t).f1 = Fib (k+1+1))
 holds IExec(while>0(a,i,I),P,s).f0=Fib n
 & IExec(while>0(a,i,I),P,s).
  f1=Fib (n+1) & while>0(a,i,I) is_closed_on s,P
   & while>0(a,i,I) is_halting_on s,P;

theorem 
  for s being 0-started State of SCMPDS,
  n be Element of NAT
  holds IExec(Fib-macro(n),P,s).intpos 1=Fib n &
IExec(Fib-macro(n),P,s).intpos 2=Fib (n+1) & Fib-macro(n)
  is parahalting;

begin 



definition
  let a be Int_position, i be Integer;
  let I be Program of SCMPDS;
  func while<>0(a,i,I) -> Program of SCMPDS equals

  (a,i)<>0_goto 2 ';' goto (
  card I+2) ';' I ';' goto -(card I+2);
end;

begin 

theorem 
  for a be Int_position,i be Integer,I be Program of SCMPDS holds
  card while<>0(a,i,I)= card I +3;

theorem 
  for a be Int_position,i be Integer,m be Element of NAT,I be
  Program of SCMPDS holds m < card I+3 iff  m in dom while<>0(a,i,I);

theorem 
  for a be Int_position,i be Integer,I be Program of SCMPDS holds
   0 in dom while<>0(a,i,I) &  1 in dom while<>0(a,i,I);

theorem 
  for a be Int_position,i be Integer,I be Program of SCMPDS holds
while<>0(a,i,I). 0=(a,i)<>0_goto 2 & while<>0(a,i,I). 1= goto (card
  I +2) & while<>0(a,i,I). (card I+2)=goto -(card I+2);

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,a being
  Int_position, i being Integer st s.DataLoc(s.a,i) = 0 holds while<>0(a,i,I)
  is_closed_on s,P & while<>0(a,i,I) is_halting_on s,P;

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,a,c being
Int_position, i being Integer st s.DataLoc(s.a,i) = 0
 holds IExec(while<>0(a,i,I),P,Initialize s) = s +* Start-At((card I+3),SCMPDS)
;

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,a being
Int_position, i being Integer st s.DataLoc(s.a,i) = 0
 holds IC IExec(while<>0(a,i,I),P,Initialize s) =  (card I + 3);

theorem 
  for s being State of SCMPDS,I being Program of SCMPDS,a,b being
Int_position, i being Integer st s.DataLoc(s.a,i) = 0
 holds IExec(while<>0(a,i,I),P,Initialize s).b = s.b;

registration
  let I be shiftable Program of SCMPDS, a be Int_position,i be Integer;
  cluster while<>0(a,i,I) -> shiftable;
end;

registration
  let I be halt-free Program of SCMPDS, a be Int_position,i be Integer;
  cluster while<>0(a,i,I) -> halt-free;
end;

begin 

scheme 

  WhileNHalt { F(State of SCMPDS)-> Element of NAT,
  s() -> 0-started State of SCMPDS,
  P() -> Instruction-Sequence of SCMPDS,
  I() -> halt-free shiftable Program of SCMPDS,
  a() -> Int_position,i() -> Integer, P[set]}:
  while<>0(a(),i(),I()) is_closed_on s(),P() &
  while<>0(a(),i(),I()) is_halting_on s(),P()
provided
 for t be 0-started State of SCMPDS st P[t] & F(t)=0
    holds t.DataLoc(s().a(),i()) = 0 and
 P[s()] and
 for t be 0-started State of SCMPDS,Q
   st P[t] & t.a()=s().a() & t.DataLoc(s().a(),i()) <> 0
    holds IExec(I(),Q,t).a()=t.a() & I() is_closed_on t,Q &
    I() is_halting_on t,Q & F(Initialize IExec(I(),Q,t)) < F(t)
 & P[Initialize(IExec(I(),Q,t))];

scheme 

  WhileNExec { F(State of SCMPDS)-> Element of NAT,
  s() -> 0-started State of SCMPDS,
  P() -> Instruction-Sequence of SCMPDS,
  I() -> halt-free shiftable Program of SCMPDS,
  a() -> Int_position,i() -> Integer,
P[set]}: IExec(while<>0(a(),i(),I()),P(),s())
 = IExec(while<>0(a(),i(),I()),P(),Initialize IExec(I(),P(),s()))
provided
 s().DataLoc(s().a(),i()) <> 0 and
 for t be 0-started State of SCMPDS st P[t] & F(t)=0
 holds t.DataLoc(s().a(),i()) = 0 and
 P[s()] and
 for t be 0-started State of SCMPDS,Q
   st P[t] & t.a()=s().a() & t.DataLoc(
s().a(),i()) <> 0 holds IExec(I(),Q,t).a()=t.a() &
I() is_closed_on t,Q & I()
is_halting_on t,Q & F(Initialize IExec(I(),Q,t)) < F(t)
 & P[Initialize(IExec(I(),Q,t))];

scheme 

  WhileNEnd { F(State of SCMPDS)-> Element of NAT,
  s() -> 0-started State of SCMPDS,
  P() -> Instruction-Sequence of SCMPDS,
  I() -> halt-free shiftable Program of SCMPDS,
  a() -> Int_position,i() -> Integer,
P[set]}: F(Initialize IExec(while<>0(a(),i(),I()),P(),s()))=0
 & P[Initialize IExec(while<>0(a(),i(),I()),P(),s())]
provided
 for t be 0-started State of SCMPDS
 st P[t] holds F(t)=0 iff t.
DataLoc(s().a(),i()) = 0 and
 P[s()] and
 for t be 0-started State of SCMPDS,Q
  st P[t] & t.a()=s().a() & t.DataLoc(
s().a(),i()) <> 0 holds IExec(I(),Q,t).a()=t.a() &
I() is_closed_on t,Q & I()
is_halting_on t,Q & F(Initialize IExec(I(),Q,t)) < F(t)
 & P[Initialize(IExec(I(),Q,t))];

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable
Program of SCMPDS, a,b,c be Int_position,i,d be Integer st card I > 0 & s.a=d &
s.b > 0 & s.c > 0 & s.DataLoc(d,i)=s.b-s.c &
 (for t be 0-started State of SCMPDS,Q st t.b >
0 & t.c > 0 & t.a=d & t.DataLoc(d,i)=t.b-t.c & t.b<>t.c
 holds IExec(I,Q,t).a=d &
I is_closed_on t,Q & I is_halting_on t,Q
 & (t.b > t.c implies IExec(I,Q,t).b=t.b-t.c
& IExec(I,Q,t).c = t.c) & (t.b <= t.c
 implies IExec(I,Q,t).c = t.c-t.b & IExec(I,Q,t)
.b=t.b) & IExec(I,Q,t).DataLoc(d,i)=
IExec(I,Q,t).b-IExec(I,Q,t).c)
 holds while<>0(a,i,I) is_closed_on s,P & while<>0(a,i,I) is_halting_on s,P
   & (s.DataLoc(s.a,i) <> 0
  implies IExec(while<>0(a,i,I),P,s) =
  IExec(while<>0(a,i,I),P,Initialize IExec(I,P,s)));

begin 







definition
  func GCD-Algorithm -> Program of SCMPDS equals

  (GBP:=0) ';' (GBP,3):=(GBP,1)
';' SubFrom(GBP,3,GBP,2) ';' while<>0(GBP,3, if>0(GBP,3,Load SubFrom(GBP,1,GBP,
2), Load SubFrom(GBP,2,GBP,1)) ';' (GBP,3):=(GBP,1) ';' SubFrom(GBP,3,GBP,2) );
end;

theorem 
  for s being 0-started State of SCMPDS,I being halt-free shiftable
Program of SCMPDS, a,b,c be Int_position,i,d be Integer st
s.a=d &
s.b > 0 & s.c > 0 & s.DataLoc(d,i)=s.b-s.c &
 (for t be 0-started State of SCMPDS,Q st t.b >
0 & t.c > 0 & t.a=d & t.DataLoc(d,i)=t.b-t.c & t.b<>t.c
 holds IExec(I,Q,t).a=d &
I is_closed_on t,Q & I is_halting_on t,Q
 & (t.b > t.c implies IExec(I,Q,t).b=t.b-t.c
& IExec(I,Q,t).c = t.c) & (t.b <= t.c
 implies IExec(I,Q,t).c = t.c-t.b & IExec(I,Q,t)
  .b=t.b) & IExec(I,Q,t).DataLoc(d,i)=
  IExec(I,Q,t).b-IExec(I,Q,t).c)
   holds IExec(while<>0(a,i,I),P,s).b = s.b gcd s.c
   & IExec(while<>0(a,i,I),P,s).c = s.b gcd s.c;

theorem 
  card GCD-Algorithm=12;

theorem 
  for s being 0-started State of SCMPDS,x, y being Integer
   st s.intpos 1 = x & s.intpos 2 = y & x > 0 & y > 0
 holds IExec(GCD-Algorithm,P,s).intpos 1 = x gcd y &
  IExec(GCD-Algorithm,P,s).intpos 2 = x gcd y
   & GCD-Algorithm is_closed_on s,P &
  GCD-Algorithm is_halting_on s,P;















begin 

reserve x for set,
  D for non empty set,
  k, n for Element of NAT,
  z for Nat;
reserve N for with_zero set,
  S for
    IC-Ins-separated non empty with_non-empty_values AMI-Struct over N,
  i for Element of the InstructionsF of S,
  l, l1, l2, l3 for Element of NAT,
  s for State of S;
reserve ss for Element of product the_Values_of S;

begin 

definition

  let N,S; let l1,l2 be Nat;
  pred l1 <= l2, S means


  ex f being non empty FinSequence of NAT st f/.1
= l1 & f/.len f = l2 & for n st 1 <= n & n < len f
 holds f/.(n+1) in SUCC(f/.n,S);
end;

theorem 
 for N,S for l1,l2 being Nat holds
  l1 <= l2,S & l2 <= l3, S implies l1 <= l3, S;

definition
  let N, S;
  attr S is InsLoc-antisymmetric means

  for l1, l2 st l1 <= l2, S & l2 <= l1, S holds
  l1 = l2;
end;

definition
  let N, S;
  attr S is weakly_standard means


  ex f being Function of NAT, NAT st f is
  bijective & for m, n being Element of NAT holds m <= n iff f.m <= f.n, S;
end;

theorem 
  for f1, f2 being Function of NAT, NAT st f1 is bijective & (for
m, n being Element of NAT holds m <= n iff f1.m <= f1.n,S) & f2 is bijective &
 (for m, n being Element of NAT holds m <= n iff f2.m <= f2.n, S) holds f1 = f2
;

theorem 
  for f being Function of NAT, NAT st f is bijective holds
  (for m, n being Element of NAT holds m <= n iff f.m <= f.n, S)
   iff for k being Element of NAT holds f.(k+1) in SUCC(f.k,S) &
    for j being Element of NAT st f.j in SUCC(f.k,S) holds k <= j;

theorem 
  S is weakly_standard iff ex f being Function of NAT, NAT st f is
  bijective & for k being Element of NAT holds f.(k+1) in SUCC(f.k,S) & for j
  being Element of NAT st f.j in SUCC(f.k,S) holds k <= j;

begin

registration
  let N be with_zero set;
  cluster STC N -> weakly_standard;
end;

registration
  let N be with_zero set;
  cluster weakly_standard halting
    for IC-Ins-separated non empty with_non-empty_values AMI-Struct
    over N;
end;

reserve T for weakly_standard
 IC-Ins-separated non empty
  with_non-empty_values AMI-Struct over N;

definition

  let N be with_zero set,
  S be weakly_standard IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N, k be Nat;
  func il.(S,k) -> Element of NAT means


  ex f being
Function of NAT, NAT st f is bijective & (for m, n being Element of NAT holds
  m <= n iff f.m <= f.n, S) & it = f.k;
end;

theorem 
  for N,T
  for k1, k2 being Nat st il.(T,k1) = il.(T,k2) holds
  k1 = k2;

theorem 
  for l being Nat ex k being Nat st l = il.(T,k);

definition
  let N be with_zero set,
  S be weakly_standard IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N, l be Nat;
  func locnum(l,S) -> Nat means


  il.(S,it) = l;
end;

definition
  let N be with_zero set,
  S be weakly_standard IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N, l be Nat;
  redefine func locnum(l,S) -> Element of NAT;
end;

theorem 
  for l1, l2 being Element of NAT holds locnum(l1,T) =
  locnum(l2,T) implies l1 = l2;

theorem 
  for N,T
  for k1, k2 being Nat holds il.(T,k1) <= il.(T,k2), T iff
  k1 <= k2;

theorem 
  for N,T
  for l1, l2 being Element of NAT holds locnum(l1,T) <=
  locnum(l2,T) iff l1 <= l2, T;

theorem 
  for N,T holds T is InsLoc-antisymmetric;

registration
  let N;
  cluster weakly_standard -> InsLoc-antisymmetric
   for IC-Ins-separated non
    empty with_non-empty_values AMI-Struct over N;
end;

definition
  let N be with_zero set,
  S be weakly_standard IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N, f be
  Element of NAT, k be Nat;
  func f +(k,S) -> Element of NAT equals

  il.(S,locnum(f,S) + k);
end;

theorem 
  for f being Element of NAT holds f + (0,T) = f;

theorem 
  for f, g being Element of NAT st f + (z,T) = g + (z,T)
   holds f = g;

theorem 
  for f being Element of NAT
   holds locnum(f,T) + z = locnum(f+(z,T),T);

definition
  let N be with_zero set,
  S be weakly_standard IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N, f be
  Element of NAT;
  func NextLoc(f,S) -> Element of NAT equals

  f + (1,S);
end;

theorem 
  for f being Element of NAT
   holds NextLoc(f,T) = il.(T,locnum(f,T)+ 1);

theorem 
  for f being Element of NAT holds f <> NextLoc(f,T);

theorem 
  for f, g being Element of NAT st NextLoc(f,T) = NextLoc(g,T)
  holds f = g;

theorem 
  il.(STC N, z) = z;

theorem 
  for i being Instruction of STC N, s being State of STC N st InsCode i
  = 1 holds IC Exec(i,s) = NextLoc(IC s,STC N);

theorem 
  for l being Element of NAT, i being Element of the
  InstructionsF of STC N st InsCode i = 1 holds NIC(i, l) = {NextLoc(l,STC N)};

theorem 
  for l being Element of NAT holds SUCC(l,STC N) = {l, NextLoc(l,STC N)};

definition
  let N be with_zero set,
  S be weakly_standard IC-Ins-separated
non empty with_non-empty_values AMI-Struct over N, i be Instruction of
  S;
  attr i is sequential means

  for s being State of S holds Exec(i, s).IC S = NextLoc(IC s,S);
end;

theorem 
  for S being weakly_standard IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N, il being Element of NAT,
  i being Instruction of S st i is sequential holds NIC(i,il)
   = {NextLoc(il,S)};

theorem 
  for S being weakly_standard IC-Ins-separated
    non empty with_non-empty_values AMI-Struct over N,
    i being Instruction of S st i is sequential
   holds i is non halting;

registration
  let N;
  let S be weakly_standard IC-Ins-separated
    non empty with_non-empty_values AMI-Struct over N;
  cluster sequential -> non halting for Instruction of S;
  cluster halting -> non sequential for Instruction of S;
end;

begin 

definition
  let N be with_zero set;
  let S be weakly_standard IC-Ins-separated non empty
  with_non-empty_values AMI-Struct over N;
  let F be NAT-defined (the InstructionsF of S)-valued Function;
  attr F is para-closed means

  for s being State of S st IC s = il.(S,0)
   for k being Element of NAT holds IC Comput(F,s,k) in dom F;
end;

theorem 
  for S being weakly_standard IC-Ins-separated non empty
  with_non-empty_values AMI-Struct over N,
   F being NAT-defined (the InstructionsF of S)-valued
 finite Function st F is really-closed & il.(S,0) in dom F holds F is
  para-closed;

theorem 
  for S being weakly_standard halting IC-Ins-separated
 non empty with_non-empty_values AMI-Struct over N holds il.(S,0) .-->
  halt S qua NAT-defined (the InstructionsF of S)-valued
   finite Function is really-closed;

definition
  let N be with_zero set;
  let S be IC-Ins-separated non empty with_non-empty_values AMI-Struct over
  N;
  let F be (the InstructionsF of S)-valued NAT-defined finite Function;
  attr F is lower means


  for l being Element of NAT st l in
  dom F holds for m being Element of NAT st m <= l, S
   holds m in dom F;
end;

registration
  let N be with_zero set,
  S be IC-Ins-separated non
  empty with_non-empty_values AMI-Struct over N;
  cluster empty -> lower
    for finite (the InstructionsF of S)-valued NAT-defined Function;
end;

theorem 
  for i being Element of the InstructionsF of T
   holds il.(T,0) .--> i is lower;

registration
  let N be with_zero set;
  let S be weakly_standard IC-Ins-separated non empty
  with_non-empty_values AMI-Struct over N;
  cluster lower 1-element for NAT-defined
     (the InstructionsF of S)-valued finite Function;
end;

theorem 
  for F being lower non empty
   NAT-defined (the InstructionsF of T)-valued finite Function
   holds il.(T,0) in dom F;

theorem 
  for P being lower
  NAT-defined (the InstructionsF of T)-valued finite Function
   holds z < card P iff il.(T,z) in dom P;

definition
  let N be with_zero set;
  let S be weakly_standard IC-Ins-separated non empty
  with_non-empty_values AMI-Struct over N;
  let F be non empty
   NAT-defined (the InstructionsF of S)-valued finite Function;
  func LastLoc F -> Element of NAT means


  ex M being finite
  non empty natural-membered set st M = { locnum(l,S) where l is
  Element of NAT : l in dom F } & it = il.(S, max M);
end;

theorem 
  for F being non empty
   NAT-defined (the InstructionsF of T)-valued finite Function
   holds LastLoc F in dom F;

theorem 
  for F, G being non empty
   NAT-defined (the InstructionsF of T)-valued finite Function
    st F c= G
  holds LastLoc F <= LastLoc G, T;

theorem 
  for F being non empty
  NAT-defined (the InstructionsF of T)-valued finite Function,
      l being
  Element of NAT st l in dom F holds l <= LastLoc F, T;

theorem 
  for F being lower non empty
   NAT-defined (the InstructionsF of T)-valued finite Function,
  G being non empty NAT-defined
   NAT-defined (the InstructionsF of T)-valued finite Function
    holds F c= G & LastLoc F = LastLoc G
  implies F = G;

theorem 
  for F being lower non empty
   NAT-defined (the InstructionsF of T)-valued finite Function
  holds LastLoc F = il.(T, card F -' 1);

registration
  let N be with_zero set,
  S be weakly_standard
  IC-Ins-separated non empty with_non-empty_values AMI-Struct over N;
  cluster really-closed lower non empty -> para-closed for NAT-defined
    (the InstructionsF of S)-valued finite Function;
end;

definition
  let N be with_zero set,
  S be weakly_standard halting
IC-Ins-separated non empty with_non-empty_values AMI-Struct over N, F
  be non empty NAT-defined (the InstructionsF of S)-valued finite Function;
  attr F is halt-ending means


  F.(LastLoc F) = halt S;
  attr F is unique-halt means


  for f being Element of NAT st
  F.f = halt S & f in dom F holds f = LastLoc F;
end;

registration
  let N be with_zero set;
  let S be weakly_standard halting IC-Ins-separated non empty
  with_non-empty_values AMI-Struct over N;
  cluster halt-ending unique-halt trivial
   for lower non empty
    NAT-defined (the InstructionsF of S)-valued finite Function;
end;

registration
  let N be with_zero set;
  let S be weakly_standard halting IC-Ins-separated
    non empty
  with_non-empty_values AMI-Struct over N;
  cluster trivial really-closed lower non empty
  for NAT-defined (the InstructionsF of S)-valued finite Function;
end;

registration
  let N be with_zero set;
  let S be weakly_standard halting IC-Ins-separated
    non empty
  with_non-empty_values AMI-Struct over N;
  cluster halt-ending unique-halt trivial really-closed
  for lower non empty
   NAT-defined (the InstructionsF of S)-valued finite Function;
end;

definition
  let N be with_zero set;
  let S be weakly_standard halting IC-Ins-separated non empty
  with_non-empty_values AMI-Struct over N;
  mode pre-Macro of S is halt-ending unique-halt
   lower non empty
   NAT-defined (the InstructionsF of S)-valued finite Function;
end;

registration
  let N be with_zero set;
  let S be weakly_standard halting IC-Ins-separated
   non empty with_non-empty_values AMI-Struct over N;
  cluster really-closed for pre-Macro of S;
end;

theorem 
  for N being with_zero set,
      S being IC-Ins-separated
       non empty with_non-empty_values AMI-Struct over N,
  l1, l2 being Element of NAT st SUCC(l1,S) = NAT
   holds l1 <= l2, S;



reserve i, j, k for Nat,
  n for Element of NAT,
  N for with_zero set,
  S for weakly_standard IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N,
  l for Element of NAT,
  f for FinPartState of S;

definition
  let N be with_zero set,
  S be weakly_standard IC-Ins-separated
  non empty with_non-empty_values AMI-Struct over N, loc be
  Element of NAT, k be Nat;
  func loc -' (k,S) -> Element of NAT equals

  il.(S, (locnum(loc,S)) -' k);
end;

theorem 
  l -' (0,S) = l;

theorem 
  l + (k,S) -' (k,S) = l;















begin

reserve a, b for Int_position,
  i for Instruction of SCMPDS,
  l for Element of NAT,
  k, k1, k2 for Integer;

definition
  let la, lb be Int_position, a, b be Integer;
  redefine func (la,lb) --> (a,b) -> PartState of SCMPDS;
end;

registration
  let k;
  cluster JUMP (goto k) -> empty;
end;

theorem 
  (for s being State of SCMPDS st IC s = l
   holds Exec(i,s).IC SCMPDS = succ IC s) implies NIC(i, l) = {succ l};

theorem 
  (for l being Element of NAT holds NIC(i,l)={succ l}) implies JUMP i is empty;

theorem 
  NIC(goto k,l) = { abs(k+ l) };

theorem 
  NIC(return a,l) = {k where k is Element of NAT: k > 1};

theorem 
  NIC(saveIC(a,k1), l) = {succ l};

theorem 
  NIC(a:=k1, l) = {succ l};

theorem 
  NIC((a,k1):=k2, l) = {succ l};

theorem 
  NIC((a,k1):=(b,k2), l) = {succ l};

theorem 
  NIC(AddTo(a,k1,k2), l) = {succ l};

theorem 
  NIC(AddTo(a,k1,b,k2), l) = {succ l};

theorem 
  NIC(SubFrom(a,k1,b,k2), l) = {succ l};

theorem 
  NIC(MultBy(a,k1,b,k2), l) = {succ l};

theorem 
  NIC(Divide(a,k1,b,k2), l) = {succ l};

theorem 
  NIC((a,k1)<>0_goto k2,l) = { succ l, abs( (k2+ l) ) };

theorem 
  NIC((a,k1)<=0_goto k2,l) = { succ l, abs( (k2+ l) ) };

theorem 
  NIC((a,k1)>=0_goto k2,l) = { succ l, abs( (k2+ l) ) };

theorem 
  JUMP (return a) = {k where k is Element of NAT: k > 1};

registration
  let a;
  cluster JUMP (return a) -> infinite;
end;

registration
  let a,k1;
  cluster JUMP (saveIC(a,k1)) -> empty;
end;

registration
  let a,k1;
  cluster JUMP (a:=k1) -> empty;
end;

registration
  let a,k1,k2;
  cluster JUMP ((a,k1):=k2) -> empty;
end;

registration
  let a,b,k1,k2;
  cluster JUMP ((a,k1):=(b,k2)) -> empty;
end;

registration
  let a,k1,k2;
  cluster JUMP (AddTo(a,k1,k2)) -> empty;
end;

registration
  let a,b,k1,k2;
  cluster JUMP (AddTo(a,k1,b,k2)) -> empty;
  cluster JUMP (SubFrom(a,k1,b,k2)) -> empty;
  cluster JUMP (MultBy(a,k1,b,k2)) -> empty;
  cluster JUMP (Divide(a,k1,b,k2)) -> empty;
end;

registration
  let a,k1,k2;
  cluster JUMP ((a,k1)<>0_goto k2) -> empty;
  cluster JUMP ((a,k1)<=0_goto k2) -> empty;
  cluster JUMP ((a,k1)>=0_goto k2) -> empty;
end;

theorem 
  SUCC(l,SCMPDS) = NAT;

registration
  cluster SCMPDS -> non InsLoc-antisymmetric;
end;

registration
  cluster SCMPDS -> non weakly_standard;
end;















begin 

reserve i,j,k,n,l for Nat,
  K for Field,
  a,b,c for Element of K,
  p,q for FinSequence of K,
  M1,M2,M3 for Matrix of n,K;

definition
  let K be Field, n be Nat, M be Matrix of n,K;
  attr M is subsymmetric means

  for i,j,k,l being Nat st [i,j] in Indices M & k=n+1-j & l=n+1-i holds
  M*(i,j) = M*(k,l);
end;

registration
  let n,K,a;
  cluster (n,n)-->a -> subsymmetric for Matrix of n,K;
end;

registration
  let n,K;
  cluster subsymmetric for Matrix of n,K;
end;

registration
  let n,K;
  let M be subsymmetric Matrix of n,K;
  cluster -M -> subsymmetric for Matrix of n,K;
  end;

registration
  let n,K;
  let M1,M2 be subsymmetric Matrix of n,K;
  cluster M1+M2 -> subsymmetric for Matrix of n,K;
end;

registration
  let n,K,a;
  let M be subsymmetric Matrix of n,K;
  cluster a*M -> subsymmetric for Matrix of n,K;
end;

registration
  let n,K;
  let M1,M2 be subsymmetric Matrix of n,K;
  cluster M1-M2 -> subsymmetric for Matrix of n,K;
end;

registration
  let n,K;
  let M be subsymmetric Matrix of n,K;
  cluster M@ -> subsymmetric for Matrix of n,K;
end;

registration
  let n,K;
  cluster line_circulant -> subsymmetric for Matrix of n,K;
  cluster col_circulant -> subsymmetric for Matrix of n,K;
end;

definition
  let K be Field, n be Nat, M be Matrix of n,K;
  attr M is Anti-subsymmetric means

  for i,j,k,l being Nat st [i,j] in Indices M & k=n+1-j & l=n+1-i holds
  M*(i,j) = -(M*(k,l));
end;

registration
  let n,K;
  cluster Anti-subsymmetric for Matrix of n,K;
end;

theorem 
  for K being Fanoian Field,n,i,j,k,l being Nat,M1 being Matrix of n,K st
  [i,j] in Indices M1 & i+j=n+1 & k=n+1-j & l=n+1-i &
  M1 is Anti-subsymmetric holds M1*(i,j)=0.K;

registration
  let n,K;
  let M be Anti-subsymmetric Matrix of n,K;
  cluster -M -> Anti-subsymmetric for Matrix of n,K;
  end;

registration
  let n,K;
  let M1,M2 be Anti-subsymmetric Matrix of n,K;
  cluster M1+M2 -> Anti-subsymmetric for Matrix of n,K;
end;

registration
  let n,K,a;
  let M be Anti-subsymmetric Matrix of n,K;
  cluster a*M -> Anti-subsymmetric for Matrix of n,K;
end;

registration
  let n,K;
  let M1,M2 be Anti-subsymmetric Matrix of n,K;
  cluster M1-M2 -> Anti-subsymmetric for Matrix of n,K;
end;

registration
  let n,K;
  let M be Anti-subsymmetric Matrix of n,K;
  cluster M@ -> Anti-subsymmetric for Matrix of n,K;
end;

begin 

definition
  let K be Field;
  let n be Nat;
  let M be Matrix of n,K;
  attr M is central_symmetric means

  for i,j,k,l being Nat st [i,j] in Indices M & k=n+1-i & l=n+1-j holds
  M*(i,j) = M*(k,l);
end;

registration
  let n,K,a;
  cluster (n,n)-->a -> central_symmetric for Matrix of n,K;
end;

registration
  let n,K;
  cluster central_symmetric for Matrix of n,K;
end;

registration
  let n,K;
  let M be central_symmetric Matrix of n,K;
  cluster -M -> central_symmetric for Matrix of n,K;
  end;

registration
  let n,K;
  let M1,M2 be central_symmetric Matrix of n,K;
  cluster M1+M2 -> central_symmetric for Matrix of n,K;
end;

registration
  let n,K,a;
  let M be central_symmetric Matrix of n,K;
  cluster a*M -> central_symmetric for Matrix of n,K;
end;

registration
  let n,K;
  let M1,M2 be central_symmetric Matrix of n,K;
  cluster M1-M2 -> central_symmetric for Matrix of n,K;
end;

registration
  let n,K;
  let M be central_symmetric Matrix of n,K;
  cluster M@ -> central_symmetric for Matrix of n,K;
end;

registration
  let n,K;
  cluster symmetric subsymmetric -> central_symmetric for Matrix of n,K;
end;

begin

definition
  let K be set, M be (Matrix of K), p be FinSequence;
  pred M is_symmetry_circulant_about p means

  len p = width M &
  (for i,j be Nat st [i,j] in Indices M & i+j<>len p+1 holds M*(i,j) =
  p.(i+j-1 mod len p)) &
  for i,j be Nat st [i,j] in Indices M & i+j=len p+1 holds M*(i,j) = p.(len p);
end;

theorem 
  (n,n)-->a is_symmetry_circulant_about n|->a;

theorem 
  M1 is_symmetry_circulant_about p implies a*M1 is_symmetry_circulant_about a*p
;

theorem 
  M1 is_symmetry_circulant_about p implies -M1 is_symmetry_circulant_about -p;

theorem 
  M1 is_symmetry_circulant_about p & M2 is_symmetry_circulant_about q
  implies M1+M2 is_symmetry_circulant_about p+q;

definition
  let K be set, M be Matrix of K;
  attr M is symmetry_circulant means

  ex p being FinSequence of K st len p = width M &
  M is_symmetry_circulant_about p;
end;

definition
  let K be non empty set;
  let p be FinSequence of K;
  attr p is first-symmetry-of-circulant means

  ex M being Matrix of len p,K st M is_symmetry_circulant_about p;
end;

definition
  let K be non empty set, p be FinSequence of K;
  assume
 p is first-symmetry-of-circulant;
  func SCirc(p) -> Matrix of len p,K means

  it is_symmetry_circulant_about p;
  end;

registration
  let n,K,a;
  cluster (n,n)-->a -> symmetry_circulant for Matrix of n,K;
end;

registration
  let n,K;
  cluster symmetry_circulant for Matrix of n,K;
end;

reserve D for non empty set,
  t for FinSequence of D,
  A for Matrix of n,D;

theorem 
  for p being FinSequence of D holds
  0 < n & A is_symmetry_circulant_about p implies
  A@ is_symmetry_circulant_about p;

registration
  let n,K,a;
  let M1 be symmetry_circulant Matrix of n,K;
  cluster a*M1 -> symmetry_circulant for Matrix of n,K;
end;

registration
  let n,K;
  let M1,M2 be symmetry_circulant Matrix of n,K;
  cluster M1+M2 -> symmetry_circulant for Matrix of n,K;
end;

registration
  let n,K;
  let M1 be symmetry_circulant Matrix of n,K;
  cluster -M1 -> symmetry_circulant for Matrix of n,K;
end;

registration
  let n,K;
  let M1,M2 be symmetry_circulant Matrix of n,K;
  cluster M1-M2 -> symmetry_circulant for Matrix of n,K;
end;

theorem 
  A is symmetry_circulant & n>0 implies A@ is symmetry_circulant;

theorem 
  p is first-symmetry-of-circulant implies -p is first-symmetry-of-circulant;

theorem 
  p is first-symmetry-of-circulant implies SCirc(-p) = -(SCirc p);

theorem 
  p is first-symmetry-of-circulant & q is first-symmetry-of-circulant &
  len p=len q implies p+q is first-symmetry-of-circulant;

theorem 
  len p=len q & p is first-symmetry-of-circulant &
  q is first-symmetry-of-circulant implies SCirc(p+q) = SCirc(p)+SCirc(q);

theorem 
  p is first-symmetry-of-circulant implies a*p is first-symmetry-of-circulant;

theorem 
  p is first-symmetry-of-circulant implies SCirc(a*p) =a*(SCirc p);

theorem 
  p is first-symmetry-of-circulant implies
  a*(SCirc p)+b*(SCirc p) = SCirc((a+ b)*p);

theorem 
  p is first-symmetry-of-circulant & q is first-symmetry-of-circulant & len p =
  len q implies a*(SCirc p)+a*(SCirc q)=SCirc(a*(p+q));

theorem 
  p is first-symmetry-of-circulant & q is first-symmetry-of-circulant & len p =
  len q implies a*(SCirc p)+b*(SCirc q)=SCirc(a*p+b*q);

theorem 
  M1 is symmetry_circulant implies M1@ = M1;

registration
  let n,K;
  cluster symmetry_circulant -> symmetric for Matrix of n,K;
end;















begin 

reserve X for set;
reserve n,i for Element of NAT;
reserve a,b,c,d,e,r,x0 for real number;
reserve A for non empty closed_interval Subset of REAL;
reserve f,g,h for PartFunc of REAL,REAL n;
reserve E for Element of REAL n;

theorem 
  a <= c & c <= b
  implies c in ['a,b'] & ['a,c'] c= ['a,b'] & ['c,b'] c= ['a,b'];

theorem 
  a <= c & c <= d & d <= b & ['a,b'] c= X implies ['c,d'] c= X;

theorem 
  a <= b & c in ['a,b'] & d in ['a,b'] & ['a,b'] c= X
  implies ['min(c,d),max(c,d)'] c= X;

theorem 
  a <= c & c <= d & d <= b & ['a,b'] c= dom f & ['a,b'] c= dom g
  implies ['c,d'] c= dom (f+g);

theorem 
  a <= c & c <= d & d <= b & ['a,b'] c= dom f & ['a,b'] c= dom g
  implies ['c,d'] c= dom (f-g);

theorem 
  for f be PartFunc of REAL,REAL holds
  a <= c & c <= d & d <= b & f is_integrable_on ['a,b'] &
  f | [' a,b '] is bounded & ['a,b'] c= dom f
  implies r(#)f is_integrable_on ['c,d'] & (r(#)f) | ['c,d'] is bounded;

theorem 
  for f,g be PartFunc of REAL,REAL
  st a <= c & c <= d & d <= b & f is_integrable_on ['a,b'] &
  g is_integrable_on ['a,b'] & f| ['a,b'] is bounded &
  g| ['a,b'] is bounded & ['a,b'] c= dom f & ['a,b'] c= dom g
  holds f-g is_integrable_on ['c,d'] & (f-g) | ['c,d'] is bounded;

theorem 
  a <= b & f is_integrable_on ['a,b'] & f| ['a,b'] is bounded &
  ['a,b'] c= dom f & c in ['a,b']
  implies f is_integrable_on ['a,c'] & f is_integrable_on ['c,b'] &
  integral(f,a,b) = integral(f,a,c) + integral(f,c,b);

theorem 
  a <= c & c <= d & d <= b & f is_integrable_on ['a,b'] &
  f| ['a,b'] is bounded & ['a,b'] c= dom f
  implies f is_integrable_on ['c,d'] & f| ['c,d'] is bounded;

theorem 
  a <= c & c <= d & d <= b &
  f is_integrable_on ['a,b'] & g is_integrable_on ['a,b'] &
  f| ['a,b'] is bounded & g| ['a,b'] is bounded &
  ['a,b'] c= dom f & ['a,b'] c= dom g
  implies
  f + g is_integrable_on ['c,d'] & (f + g) | ['c,d'] is bounded;

theorem 
  a <= c & c <= d & d <= b &
  f is_integrable_on ['a,b'] & f| ['a,b'] is bounded & ['a,b'] c= dom f
  implies
  r(#)f is_integrable_on ['c,d'] & (r(#)f) | ['c,d'] is bounded;

theorem 
  a <= c & c <= d & d <= b &
  f is_integrable_on ['a,b'] & f| ['a,b'] is bounded & ['a,b'] c= dom f
  implies
  -f is_integrable_on ['c,d'] & (-f) | ['c,d'] is bounded;

theorem 
  a <= c & c <= d & d <= b &
  f is_integrable_on ['a,b'] & g is_integrable_on ['a,b'] &
  f| ['a,b'] is bounded & g| ['a,b'] is bounded &
  ['a,b'] c= dom f & ['a,b'] c= dom g
  implies
  f - g is_integrable_on ['c,d'] & (f - g) | ['c,d'] is bounded;

theorem 
  for n be non empty Element of NAT,
      f be Function of A,REAL n holds
  f is bounded iff |.f.| is bounded;

theorem 
  f is bounded & A c= dom f implies f|A is bounded;

theorem 
  for f be PartFunc of REAL,REAL n, g be Function of A,REAL n
  st f is bounded & f = g holds g is bounded;

theorem 
  for f be PartFunc of REAL,REAL n, g be Function of A,REAL n
  st f = g holds |. f .| = |. g .|;

theorem 
  A c= dom h implies |. h|A .| = (|.h.|) |A;

theorem 
  for n be non empty Element of NAT, h be PartFunc of REAL,REAL n
   st A c= dom h & h|A is bounded
   holds (|.h.|) |A is bounded;

theorem 
  for n be non empty Element of NAT, h be PartFunc of REAL,REAL n
  st A c= dom h & h|A is bounded &
  h is_integrable_on A & |. h .| is_integrable_on A
  holds |.integral(h,A) .| <= integral(|. h .|,A);

theorem 
  for n be non empty Element of NAT, h be PartFunc of REAL,REAL n
  st a<=b & ['a,b'] c= dom h & h is_integrable_on ['a,b']
  & |.h.| is_integrable_on ['a,b'] & h| ['a ,b'] is bounded
  holds |. integral(h,a,b).| <= integral(|.h.|,a,b);

theorem 
  for n be non empty Element of NAT, f be PartFunc of REAL,REAL n
  st a <= b & f is_integrable_on ['a,b'] & |. f .| is_integrable_on ['a,b']
    & f| ['a,b'] is bounded & ['a,b'] c= dom f & c in ['a,b'] & d in ['a,b']
  holds |. f .| is_integrable_on ['min(c,d),max(c,d)'] &
    (|. f .|) | ['min(c,d),max(c,d)'] is bounded &
    |. integral(f,c,d) .| <= integral((|. f .|),min(c,d),max(c,d));

theorem 
  for n be non empty Element of NAT
  for f be PartFunc of REAL,REAL n
  st a <= b & c <= d & f is_integrable_on ['a,b'] &
  |.f.| is_integrable_on ['a,b'] & f| ['a,b'] is bounded &
  ['a,b'] c= dom f & c in ['a,b'] & d in ['a,b']
  holds |.f.| is_integrable_on ['c,d'] &
  |.f.| | ['c,d'] is bounded & |.integral(f,c,d).| <= integral(|.f.|,c,d) &
  |.integral(f,d,c).| <= integral(|.f.|,c,d);

theorem 
  for n be non empty Element of NAT
  for f be PartFunc of REAL,REAL n
  st (a<=b & c <= d & f is_integrable_on ['a,b']
  & |. f .| is_integrable_on ['a,b'] & f| ['a,b'] is bounded &
  ['a,b'] c= dom f & c in ['a,b'] & d in ['a,b'] &
  for x be real number st x in ['c,d'] holds |. f/.x .| <= e)
  holds |. integral(f,c,d) .| <= e * (d-c) &
  |. integral(f,d,c).| <= e * (d-c);

theorem 
  a <= b & f is_integrable_on ['a,b'] & f| ['a,b'] is bounded &
  ['a,b'] c= dom f & c in ['a,b'] & d in ['a,b']
  implies integral(r(#)f,c,d) = r*integral(f,c,d);

theorem 
  a <= b & f is_integrable_on ['a,b'] & f| ['a,b'] is bounded &
  ['a,b'] c= dom f & c in ['a,b'] & d in ['a,b']
  implies integral(-f,c,d) = -integral(f,c,d);

theorem 
  a <= b & f is_integrable_on ['a,b'] & g is_integrable_on ['a,b'] &
  f| ['a,b'] is bounded & g| ['a,b'] is bounded & ['a,b'] c= dom f &
  ['a,b'] c= dom g & c in ['a,b'] & d in ['a,b']
  implies integral(f+g,c,d) = integral(f,c,d) + integral(g,c,d);

theorem 
  a <= b & f is_integrable_on ['a,b'] & g is_integrable_on ['a,b'] &
  f| ['a,b'] is bounded & g| ['a,b'] is bounded & ['a,b'] c= dom f &
  ['a,b'] c= dom g & c in ['a,b'] & d in ['a,b']
  implies integral(f-g,c,d) = integral(f,c,d) - integral(g,c,d);

theorem 
  (a <= b & ['a,b'] c= dom f &
  for x be real number st x in ['a,b'] holds f.x = E)
  implies f is_integrable_on ['a,b'] & f| ['a,b'] is bounded &
  integral(f,a,b) = (b-a)*E;

theorem 
  a <= b & (for x be real number st x in ['a,b'] holds f.x = E) &
  ['a,b'] c= dom f & c in ['a,b'] & d in ['a,b']
  implies integral(f,c,d) = (d-c)*E;

theorem 
  a <= b & f is_integrable_on ['a,b'] & f| ['a,b'] is bounded &
  ['a,b'] c= dom f & c in ['a,b'] & d in ['a,b']
  implies integral(f,a,d) = integral(f,a,c) + integral(f,c,d);

theorem 
  (a<=b & f is_integrable_on ['a,b'] &
  f| ['a,b'] is bounded & ['a,b'] c= dom f & c in ['a,b'] &
  d in ['a,b'] & for x be real number st x in ['min(c,d),max(c,d)']
  holds |. f/.x .| <= e)
  implies |. integral(f,c,d) .| <= n*e * abs(d-c);

theorem 
  integral(f,b,a) = - integral(f,a,b);

begin

definition
  let R be RealNormSpace, X be non empty set, g be PartFunc of X,R;
  attr g is bounded means


  ex r be real number
  st for y be set st y in dom g holds ||. g/.y .|| < r;
end;

theorem 
  for f be PartFunc of REAL,REAL n, g be PartFunc of REAL,REAL-NS n st f=g
  holds f is bounded iff g is bounded;

theorem 
  for X,Y be set, f1,f2 be PartFunc of REAL,REAL-NS n
  st f1|X is bounded & f2|Y is bounded
  holds (f1+f2) | (X /\ Y) is bounded & (f1-f2) | (X /\ Y) is bounded;

theorem 
  for f be Function of A,REAL n, g be Function of A,REAL-NS n,
      D be Division of A, p be FinSequence of REAL n,
      q be FinSequence of REAL-NS n st f=g & p=q
  holds p is middle_volume of f,D iff q is middle_volume of g,D;

theorem 
  for f be Function of A,REAL n, g be Function of A,REAL-NS n,
  D be Division of A,
  p be middle_volume of f,D,
  q be middle_volume of g,D
  st f=g & p=q
  holds middle_sum(f,p) = middle_sum(g,q);

theorem 
  for f be Function of A,REAL n,
  g be Function of A,REAL-NS n,
  T be DivSequence of A,
  p be Function of NAT,(REAL n)*,
  q be Function of NAT,(the carrier of REAL-NS n)*
  st f=g & p=q
  holds p is middle_volume_Sequence of f,T
  iff  q is middle_volume_Sequence of g,T;

theorem 
  for f be Function of A,REAL n,
  g be Function of A,REAL-NS n,
  T be DivSequence of A,
  S be middle_volume_Sequence of f,T,
  U be middle_volume_Sequence of g,T
  st f=g & S=U
  holds middle_sum(f,S) = middle_sum(g,U);

theorem 
  for f be Function of A,REAL n, g be Function of A,REAL-NS n,
  I be Element of REAL n, J be Point of REAL-NS n
  st f=g & I = J holds
  (for T be DivSequence of A, S be middle_volume_Sequence of f,T
  st delta(T) is convergent & lim delta(T)=0
  holds middle_sum(f,S) is convergent
  & lim (middle_sum(f,S))=I)
  iff
  (for T be DivSequence of A, S be middle_volume_Sequence of g,T
  st delta(T) is convergent & lim delta(T)=0
  holds middle_sum(g,S) is convergent & lim (middle_sum(g,S))=J);

theorem 
  for f be Function of A,REAL n, g be Function of A,REAL-NS n
  st f=g & f is bounded
  holds f is integrable iff g is integrable;

theorem 
  for f be Function of A,REAL n, g be Function of A,REAL-NS n
  st f=g & f is bounded & f is integrable
  holds g is integrable & integral(f) = integral(g);

theorem 
  for f be PartFunc of REAL,REAL n, g be PartFunc of REAL,REAL-NS n
  st f=g & f |A is bounded & A c= dom f
  holds f is_integrable_on A iff g is_integrable_on A;

theorem 
  for f be PartFunc of REAL,REAL n, g be PartFunc of REAL,REAL-NS n
  st f=g & f|A is bounded & A c= dom f & f is_integrable_on A
  holds g is_integrable_on A & integral(f,A) = integral(g,A);

theorem 
  for f be PartFunc of REAL,REAL n, g be PartFunc of REAL,REAL-NS n
  st f=g & a <= b & f| ['a,b'] is bounded & ['a,b'] c= dom f
  & f is_integrable_on ['a,b']
  holds integral(f,a,b) = integral(g,a,b);

theorem 
  for f,g be PartFunc of REAL,REAL-NS n
  st a <= b & f is_integrable_on ['a,b'] & g is_integrable_on ['a,b']
  & ['a,b'] c= dom f & ['a,b'] c= dom g
  holds integral(f+g,a,b) = integral(f,a,b) + integral(g,a,b) &
  integral(f-g,a,b) = integral(f,a,b) - integral(g,a,b);

theorem 
  for f be PartFunc of REAL,REAL-NS n st a <= b & ['a,b'] c= dom f
  holds integral(f,b,a) = - integral(f,a,b);

theorem 
  for f be PartFunc of REAL,REAL-NS n, g be PartFunc of REAL,REAL n
  st f=g & a <= b & ['a,b'] c= dom f & f | ['a,b'] is bounded
  & f is_integrable_on ['a,b'] & c in ['a,b'] & d in ['a,b']
  holds integral(f,c,d) = integral(g,c,d);

theorem 
  for f,g be PartFunc of REAL,REAL-NS n
  st a <= b & f is_integrable_on ['a,b'] & g is_integrable_on ['a,b'] &
  f| ['a,b'] is bounded & g| ['a,b'] is bounded & ['a,b'] c= dom f &
  ['a,b'] c= dom g & c in ['a,b'] & d in ['a,b']
  holds integral(f+g,c,d) = integral(f,c,d) + integral(g,c,d);

theorem 
  for f,g be PartFunc of REAL,REAL-NS n
  st a <= b & f is_integrable_on ['a,b'] & g is_integrable_on ['a,b'] &
  f| ['a,b'] is bounded & g| ['a,b'] is bounded & ['a,b'] c= dom f &
  ['a,b'] c= dom g & c in ['a,b'] & d in ['a,b']
  holds integral(f-g,c,d) = integral(f,c,d) - integral(g,c,d);

theorem 
  for E be Point of REAL-NS n, f be PartFunc of REAL,REAL-NS n
  st (a <= b & ['a,b'] c= dom f &
  for x be real number st x in ['a,b'] holds f.x = E)
  holds f is_integrable_on ['a,b'] & f| ['a,b'] is bounded &
  integral(f,a,b) = (b-a)*E;

theorem 
  for E be Point of REAL-NS n, f be PartFunc of REAL,REAL-NS n
  st a <= b & ['a,b'] c= dom f &
  (for x be real number st x in ['a,b'] holds f.x = E)
  & c in ['a,b'] & d in ['a,b']
  holds integral(f,c,d) = (d-c)*E;

theorem 
  for f be PartFunc of REAL,REAL-NS n
  st a<=b & f is_integrable_on ['a,b'] & f| ['a,b'] is bounded &
  ['a,b'] c= dom f & c in ['a,b'] & d in ['a,b']
  holds integral(f,a,d) = integral(f,a,c) + integral(f,c,d);

theorem 
  for f be PartFunc of REAL,REAL-NS n
  st (a<=b & f is_integrable_on ['a,b']
  & f| ['a,b'] is bounded & ['a,b'] c= dom f & c in ['a,b'] &
  d in ['a,b'] & for x be real number st x in ['min(c,d),max(c,d)']
  holds ||. f/.x .|| <= e)
  holds ||. integral(f,c,d) .||<= (n*e)* abs(d-c);

begin

theorem 
  for n be non empty Element of NAT, F,f be PartFunc of REAL,REAL-NS n
  st a <= b & f is_integrable_on ['a,b']
  & f| ['a,b'] is bounded & ['a,b'] c= dom f & ].a,b.[ c= dom F &
  (for x be real number st x in ].a,b.[ holds F.x = integral(f,a,x)) &
  x0 in ].a,b.[ & f is_continuous_in x0 holds F is_differentiable_in x0 &
  diff(F,x0)=f/.x0;

theorem 
  for n be non empty Element of NAT,
      f be PartFunc of REAL,REAL-NS n
  st a <= b & f is_integrable_on ['a,b'] & f| ['a,b'] is bounded &
  ['a,b'] c= dom f & x0 in ].a,b.[ & f is_continuous_in x0
  ex F be PartFunc of REAL,REAL-NS n st ].a,b.[ c= dom F &
  (for x be real number st x in ].a,b.[ holds F.x = integral(f,a,x))
  & F is_differentiable_in x0 & diff(F,x0)=f/.x0;















begin 

reserve x for set;
reserve i,j for Integer;
reserve n,n1,n2,n3 for Nat;
reserve K for Field;
reserve p for Prime;
reserve a,b,c,d for Element of GF(p);
reserve a1,a2,a3,a4,a5,a6 for Element of K;

theorem 
  a1 = -a2 implies a1|^2 = a2|^2;

theorem 
  (1.K)" = 1.K;

theorem 
  a2 <> 0.K & a4 <> 0.K & a1*a2" = a3*a4" implies a1*a4 = a2*a3;

theorem 
  a2 <> 0.K & a4 <> 0.K & a1*a4 = a2*a3 implies a1*a2" = a3*a4";

theorem 
  a1 = 0.K & n > 1 implies a1 |^ n = 0.K;

theorem 
  a1 = -a2 implies -a1 = a2;

theorem 
  a1 + a2 + a3 + a4 = a4 + a2 + a3 + a1 &
  a1 + a2 + a3 + a4 = a1 + a4 + a3 + a2;

theorem 
  a1 + a2 + a3 + a4 = a1 + (a2 + a3 + a4) &
  a1 + a2 + a3 + a4 + a5 = a1 + (a2 + a3 + a4 + a5);

theorem 
  a1 + a2 + a3 + a4 + a5 + a6 = a1 + (a2 + a3 + a4 + a5 + a6);

theorem 
  a1 * a2 * a3 * a4 = a4 * a2 * a3 * a1 &
  a1 * a2 * a3 * a4 = a1 * a4 * a3 * a2;

theorem 
  a1 * a2 * a3 * a4 = a1 * (a2 * a3 * a4) &
  a1 * a2 * a3 * a4 * a5 = a1 * (a2 * a3 * a4 * a5);

theorem 
  a1 * a2 * a3 * a4 * a5 * a6 = a1 * (a2 * a3 * a4 * a5 * a6) &
  a1 * a2 * a3 * a4 * a5 * a6 = a1 * (a2 * a3 * a4) * a5 * a6;

theorem 
  (a1*a2*a3) |^n = (a1 |^n)*(a2 |^n)*(a3 |^n);

theorem 
  a1*(a2+a3+a4) = a1*a2+a1*a3+a1*a4
  & a1*(a2+a3-a4) = a1*a2+a1*a3-a1*a4
  & a1*(a2-a3+a4) = a1*a2-a1*a3+a1*a4
  & a1*(a2-a3-a4) = a1*a2-a1*a3-a1*a4
  & a1*(-a2+a3+a4) = -a1*a2+a1*a3+a1*a4
  & a1*(-a2+a3-a4) = -a1*a2+a1*a3-a1*a4
  & a1*(-a2-a3+a4) = -a1*a2-a1*a3+a1*a4
  & a1*(-a2-a3-a4) = -a1*a2-a1*a3-a1*a4;

theorem 
  (a1 + a2)*(a1 - a2) = a1 |^2 - a2 |^2;

theorem 
  (a1 + a2)*(a1 |^2 - a1*a2 + a2 |^2) = a1 |^3 + a2 |^3;

theorem 
  (a1 - a2)*(a1 |^2 + a1*a2 + a2 |^2) = a1 |^3 - a2 |^3;

definition
  let n, p be natural number;
  attr p is n_or_greater means

  n <= p;
end;

registration
  cluster 5_or_greater prime for natural number;
end;

theorem 
  for gi, gj, gij, a be Element of GF(p) st
  gi = i mod p & gj = j mod p & gij = (i+j) mod p holds
  gi*a + gj*a = gij*a;

theorem 
  for gi, gj, a be Element of GF(p) st
  gi = i mod p & gj = j mod p & j = i + 1 holds
  gi*a + a = gj*a;

theorem 
  for g2, a be Element of GF(p) st g2 = 2 mod p holds a + a = g2 * a;

theorem 
  for gi, gj, gij, a be Element of GF(p) st
  gi = i mod p & gj = j mod p & gij = (i-j) mod p holds
  gi*a - gj*a = gij*a;

theorem 
  for gi, gj, a be Element of GF(p) st
  gi = i mod p & gj = j mod p & i = j + 1 holds
  gi*a - gj*a = a;

theorem 
  for gi, gj, a be Element of GF(p) st
  gi = i mod p & gj = j mod p & i = j + 1 holds
  gi*a - a = gj*a;

theorem 
  for g2, a be Element of GF(p) st g2 = 2 mod p holds g2*a - a = a;

theorem 
  for g2, a, b be Element of GF(p) st g2 = 2 mod p
  holds (a + b) |^2 = a |^2 + g2*a*b + b |^2;

theorem 
  for g2, a, b be Element of GF(p) st g2 = 2 mod p
  holds (a - b) |^2 = a |^2 - g2*a*b + b |^2;

theorem 
  for g2, a, b, c, d be Element of GF(p) st g2 = 2 mod p holds
  (a*c+b*d) |^2 = (a |^2)*(c |^2) + g2*a*b*c*d + (b |^2)*(d |^2);

theorem 
  for p be Prime, n be Nat, g2 be Element of GF(p) st p > 2 & g2 = 2 mod p
  holds g2 <> 0.GF(p) & g2 |^n <> 0.GF(p);

theorem 
  for p be Prime, n be Nat, g2, g3 be Element of GF(p) st p > 3 &
  g3 = 3 mod p holds g3 <> 0.GF(p) & g3 |^n <> 0.GF(p);

begin 

definition
  let p be 5_or_greater Prime;
  func EC_WParam p -> Subset of
  [:the carrier of GF(p),the carrier of GF(p):] equals

  {[a,b] where a,b is Element of GF(p) : Disc(a,b,p) <> 0.GF(p) };
end;

registration
  let p be 5_or_greater Prime;
  cluster EC_WParam p -> non empty;
end;

definition
  let p be 5_or_greater Prime;
  let z be Element of EC_WParam p;
  redefine func z`1 -> Element of GF(p);
  redefine func z`2 -> Element of GF(p);
end;

theorem 
  for p be 5_or_greater Prime,
  z be Element of EC_WParam p holds
  p > 3 & Disc(z`1,z`2,p) <> 0.GF(p);

reserve px,py,pz for set;
reserve Px,Py,Pz for Element of GF(p);
reserve P for Element of ProjCo(GF(p));
reserve O for Element of EC_SetProjCo(a,b,p);

definition
  let p be Prime;
  let a, b be Element of GF(p);
  let P be Element of EC_SetProjCo(a,b,p);
  func P`1_3 -> Element of GF(p) means


  P = [px,py,pz] implies it = px;
  func P`2_3 -> Element of GF(p) means


  P = [px,py,pz] implies it = py;
  func P`3_3 -> Element of GF(p) means


  P = [px,py,pz] implies it = pz;
end;

theorem 
  for p be Prime, a, b be Element of GF(p),
  P be Element of EC_SetProjCo(a,b,p)
  holds P = [P`1_3,P`2_3,P`3_3];

theorem 
  for p be Prime, a, b be Element of GF(p),
  P be Element of EC_SetProjCo(a,b,p),
  Q be Element of ProjCo(GF(p))
  holds P = Q iff P`1_3 = Q`1_3 & P`2_3 = Q`2_3 & P`3_3 = Q`3_3;

theorem 
  for p be Prime, a, b, Px, Py, Pz be Element of GF(p),
  P be Element of EC_SetProjCo(a,b,p) st P = [Px, Py, Pz]
  holds P`1_3 = Px & P`2_3 = Py & P`3_3 = Pz;

definition
  let p be Prime;
  let P be Element of ProjCo(GF(p));
  let CEQ be Function of
  [:the carrier of GF(p), the carrier of GF(p), the carrier of GF(p):], GF(p);
  pred P is_on_curve CEQ means

  CEQ.P = 0.GF(p);
end;

theorem 
  P is_on_curve EC_WEqProjCo(a,b,p) iff P is Element of EC_SetProjCo(a,b,p);

theorem 
  for p be Prime, a, b be Element of GF(p),
  P be Element of EC_SetProjCo(a,b,p) holds
  ((P`2_3) |^2)*(P`3_3) - ((P`1_3) |^3 +
    a*(P`1_3)*(P`3_3) |^2 + b*(P`3_3) |^3) = 0.GF(p);

definition
  let p be Prime;
  let P be Element of ProjCo(GF(p));
  func rep_pt(P) -> Element of ProjCo(GF(p)) equals


  [P`1_3*(P`3_3)",P`2_3*(P`3_3)",1] if P`3_3 <> 0,
  [0, 1, 0] if P`3_3 = 0;
end;

theorem 
  for p be 5_or_greater Prime, z be Element of EC_WParam p,
  P be Element of EC_SetProjCo(z`1,z`2,p)
  holds rep_pt(P) _EQ_ P & rep_pt(P) in EC_SetProjCo(z`1,z`2,p);

theorem 
  for p be Prime, a, b be Element of GF(p),
  P be Element of ProjCo(GF(p))
  holds (rep_pt(P))`3_3 = 0 implies rep_pt(P) = [0, 1, 0] & P`3_3 = 0;

theorem 
  for p be Prime, a, b be Element of GF(p),
  P be Element of ProjCo(GF(p))
  holds (rep_pt(P))`3_3 <> 0 implies
  rep_pt(P) = [(P`1_3)*(P`3_3)", (P`2_3)*(P`3_3)", 1] & P`3_3 <> 0;

theorem 
  for p be 5_or_greater Prime, z be Element of EC_WParam p,
  P, Q be Element of EC_SetProjCo(z`1,z`2,p)
  holds P _EQ_ Q iff rep_pt(P) = rep_pt(Q);

begin

definition
  let p be 5_or_greater Prime;
  let z be Element of EC_WParam p;
  func compell_ProjCo(z,p) ->
  Function of EC_SetProjCo(z`1,z`2,p), EC_SetProjCo(z`1,z`2,p) means


  for P be Element of EC_SetProjCo(z`1,z`2,p)
  holds it.P = [P`1_3,-P`2_3,P`3_3];
end;

definition
  let p be 5_or_greater Prime, z be Element of EC_WParam p;
  let F be Function of EC_SetProjCo(z`1,z`2,p), EC_SetProjCo(z`1,z`2,p);
  let P be Element of EC_SetProjCo(z`1,z`2,p);
  redefine func F.P -> Element of EC_SetProjCo(z`1,z`2,p);
end;

theorem 
  for p be 5_or_greater Prime, z be Element of EC_WParam p,
  O be Element of EC_SetProjCo(z`1,z`2,p) st O = [0, 1, 0] holds
  (compell_ProjCo(z,p)).O _EQ_ O;

theorem 
  for p be 5_or_greater Prime, z be Element of EC_WParam p,
  P be Element of EC_SetProjCo(z`1,z`2,p)
  holds compell_ProjCo(z,p).(compell_ProjCo(z,p).P) = P;

theorem 
  for p be 5_or_greater Prime, z be Element of EC_WParam p,
  P be Element of EC_SetProjCo(z`1,z`2,p) st P`3_3 <> 0
  holds rep_pt(compell_ProjCo(z,p).P) = compell_ProjCo(z,p).(rep_pt(P));

theorem 
  for p be 5_or_greater Prime, z be Element of EC_WParam p,
  P, Q be Element of EC_SetProjCo(z`1,z`2,p) holds
  P = Q iff compell_ProjCo(z,p).P = compell_ProjCo(z,p).Q;

theorem 
  for p be 5_or_greater Prime, z be Element of EC_WParam p,
  P be Element of EC_SetProjCo(z`1,z`2,p) st P`3_3 <> 0 holds
  P _EQ_ compell_ProjCo(z,p).P iff P`2_3 = 0;

theorem 
  for p be 5_or_greater Prime, z be Element of EC_WParam p,
  P, Q be Element of EC_SetProjCo(z`1,z`2,p) st P`3_3 <> 0 holds
  (P`1_3 = Q`1_3 & P`3_3 = Q`3_3) iff P = Q or P = compell_ProjCo(z,p).Q;

theorem 
  for p be 5_or_greater Prime, z be Element of EC_WParam p,
  P, Q be Element of EC_SetProjCo(z`1,z`2,p)
  holds P _EQ_ Q iff compell_ProjCo(z,p).P _EQ_ compell_ProjCo(z,p).Q;

theorem 
  for p be 5_or_greater Prime, z be Element of EC_WParam p,
  P, Q be Element of EC_SetProjCo(z`1,z`2,p)
  holds P _EQ_ compell_ProjCo(z,p).Q iff compell_ProjCo(z,p).P _EQ_ Q;

theorem 
  for p be 5_or_greater Prime, z be Element of EC_WParam p,
  P, Q be Element of EC_SetProjCo(z`1,z`2,p)
  st P`3_3 <> 0 & Q`3_3 <> 0 holds
  rep_pt(P) = compell_ProjCo(z,p).(rep_pt(Q)) iff
  P _EQ_ compell_ProjCo(z,p).Q;

theorem 
  for p be 5_or_greater Prime, z be Element of EC_WParam p,
  P, Q be Element of EC_SetProjCo(z`1,z`2,p) holds
  P _EQ_ Q implies P`2_3*(Q`3_3) = Q`2_3*(P`3_3);

theorem 
  for p be 5_or_greater Prime, z be Element of EC_WParam p,
  P, Q be Element of EC_SetProjCo(z`1,z`2,p)
  st P`3_3 <> 0 & Q`3_3 <> 0 holds
  P _EQ_ Q or P _EQ_ compell_ProjCo(z,p).Q iff P`1_3*(Q`3_3) = Q`1_3*(P`3_3);

theorem 
  for p be 5_or_greater Prime, z be Element of EC_WParam p,
  P, Q be Element of EC_SetProjCo(z`1,z`2,p)
  st P`3_3 <> 0 & Q`3_3 <> 0 & P`2_3 <> 0 holds
  P _EQ_ compell_ProjCo(z,p).Q implies P`2_3*(Q`3_3) <> Q`2_3*(P`3_3);

theorem 
  for p be 5_or_greater Prime, z be Element of EC_WParam p,
  P, Q be Element of EC_SetProjCo(z`1,z`2,p) holds
  (not P _EQ_ Q) & P _EQ_ compell_ProjCo(z,p).Q
    implies P`2_3*(Q`3_3) <> Q`2_3*(P`3_3);

theorem 
  for p be 5_or_greater Prime, z be Element of EC_WParam p,
  g3 be Element of GF(p), P be Element of EC_SetProjCo(z`1,z`2,p)
  st g3 = 3 mod p & P`2_3 = 0 & P`3_3 <> 0 holds
  (z`1)*(P`3_3 |^2) + g3*(P`1_3 |^2) <> 0;

theorem 
  for p be 5_or_greater Prime, z be Element of EC_WParam p,
  g2, gf1, gf2, gf3 be Element of GF(p),
  P, Q be Element of EC_SetProjCo(z`1,z`2,p),
  R be Element of
  [:the carrier of GF(p), the carrier of GF(p), the carrier of GF(p):]
  st g2 = 2 mod p & gf1 = Q`2_3*(P`3_3) - P`2_3*(Q`3_3) &
    gf2 = Q`1_3*(P`3_3) - P`1_3*(Q`3_3) &
  gf3 = (gf1 |^2)*(P`3_3)*(Q`3_3) - (gf2 |^3) - g2*(gf2 |^2)*(P`1_3)*(Q`3_3) &
  R = [gf2*gf3, gf1 * ((gf2 |^2)*(P`1_3)*(Q`3_3)-gf3)
         - (gf2 |^3)*(P`2_3)*(Q`3_3),
  (gf2 |^3)*(P`3_3)*(Q`3_3)]
  holds gf2*(P`3_3)*(R`2_3)
     = - (gf1*(R`1_3*(P`3_3) - P`1_3*(R`3_3)) + gf2*(P`2_3)*(R`3_3));

theorem 
  for p be 5_or_greater Prime, z be Element of EC_WParam p,
  g2, gf1, gf2, gf3 be Element of GF(p),
  P, Q be Element of EC_SetProjCo(z`1,z`2,p),
  R be Element of
  [:the carrier of GF(p), the carrier of GF(p), the carrier of GF(p):]
  st g2 = 2 mod p & gf1 = Q`2_3*(P`3_3) - P`2_3*(Q`3_3) &
         gf2 = Q`1_3*(P`3_3) - P`1_3*(Q`3_3) &
  gf3 = (gf1 |^2)*(P`3_3)*(Q`3_3) - (gf2 |^3) - g2*(gf2 |^2)*(P`1_3)*(Q`3_3) &
  R = [gf2*gf3, gf1 * ((gf2 |^2)*(P`1_3)*(Q`3_3)-gf3)
        - (gf2 |^3)*(P`2_3)*(Q`3_3),
  (gf2 |^3)*(P`3_3)*(Q`3_3)]
  holds -(gf2 |^2)*(P`3_3*(Q`3_3)*(R`1_3)
    +P`3_3*(Q`1_3)*(R`3_3)+P`1_3*(Q`3_3)*(R`3_3))
  + P`3_3*(Q`3_3)*(R`3_3)*(gf1 |^2) = 0.GF(p);

theorem 
  for p be 5_or_greater Prime, z be Element of EC_WParam p,
  g2, gf1, gf2, gf3 be Element of GF(p),
  P, Q be Element of EC_SetProjCo(z`1,z`2,p),
  R be Element of
  [:the carrier of GF(p), the carrier of GF(p), the carrier of GF(p):]
  st g2 = 2 mod p & gf1 = Q`2_3*(P`3_3) - P`2_3*(Q`3_3) &
          gf2 = Q`1_3*(P`3_3) - P`1_3*(Q`3_3) &
  gf3 = (gf1 |^2)*(P`3_3)*(Q`3_3) - (gf2 |^3) - g2*(gf2 |^2)*(P`1_3)*(Q`3_3) &
  R = [gf2*gf3,
       gf1 * ((gf2 |^2)*(P`1_3)*(Q`3_3)-gf3) - (gf2 |^3)*(P`2_3)*(Q`3_3),
  (gf2 |^3)*(P`3_3)*(Q`3_3)]
  holds z`2*(gf2 |^2)*(P`3_3 |^2)*(Q`3_3)*(R`3_3)
    = -(gf2 |^2)*(P`3_3)*(P`1_3)*(Q`1_3)*(R`1_3)
  + ((gf2*(P`2_3) - gf1*(P`1_3)) |^2)*(Q`3_3)*(R`3_3);

theorem 
  for p be 5_or_greater Prime, z be Element of EC_WParam p,
  g2, gf1, gf2, gf3 be Element of GF(p),
  P, Q be Element of EC_SetProjCo(z`1,z`2,p),
  R be Element of
  [:the carrier of GF(p), the carrier of GF(p), the carrier of GF(p):]
  st g2 = 2 mod p & gf1 = Q`2_3*(P`3_3) - P`2_3*(Q`3_3) &
    gf2 = Q`1_3*(P`3_3) - P`1_3*(Q`3_3) &
  gf3 = (gf1 |^2)*(P`3_3)*(Q`3_3) - (gf2 |^3) - g2*(gf2 |^2)*(P`1_3)*(Q`3_3) &
  R = [gf2*gf3,
     gf1 * ((gf2 |^2)*(P`1_3)*(Q`3_3)-gf3) - (gf2 |^3)*(P`2_3)*(Q`3_3),
  (gf2 |^3)*(P`3_3)*(Q`3_3)]
  holds z`1*(gf2 |^2)*(P`3_3)*(Q`3_3)*(R`3_3) =
  (gf2 |^2)*(P`1_3*(Q`1_3)*(R`3_3)+P`3_3*(Q`1_3)*(R`1_3)+P`1_3*(Q`3_3)*(R`1_3))
  + g2*gf1*(Q`3_3)*(R`3_3)*(gf2*(P`2_3) - gf1*(P`1_3));

theorem 
  for p be 5_or_greater Prime, z be Element of EC_WParam p,
  g2, gf1, gf2, gf3 be Element of GF(p),
  P, Q be Element of EC_SetProjCo(z`1,z`2,p),
  R be Element of
  [:the carrier of GF(p), the carrier of GF(p), the carrier of GF(p):]
  st g2 = 2 mod p & gf1 = Q`2_3*(P`3_3) - P`2_3*(Q`3_3) &
         gf2 = Q`1_3*(P`3_3) - P`1_3*(Q`3_3) &
  gf3 = (gf1 |^2)*(P`3_3)*(Q`3_3) - (gf2 |^3) - g2*(gf2 |^2)*(P`1_3)*(Q`3_3) &
  R = [gf2*gf3,
       gf1 * ((gf2 |^2)*(P`1_3)*(Q`3_3)-gf3) - (gf2 |^3)*(P`2_3)*(Q`3_3),
  (gf2 |^3)*(P`3_3)*(Q`3_3)]
  holds (gf2 |^2)*(P`3_3 |^2)*(Q`3_3)*
  ((R`2_3 |^2)*(R`3_3) - ((R`1_3 |^3)
    + z`1*(R`1_3)*(R`3_3 |^2) + z`2*(R`3_3 |^3))) = 0.GF(p);

theorem 
  for p be 5_or_greater Prime, z be Element of EC_WParam p,
  g2, g3, g4, g8, gf1, gf2, gf3, gf4 be Element of GF(p),
  P be Element of EC_SetProjCo(z`1,z`2,p),
  R be Element of
  [:the carrier of GF(p), the carrier of GF(p), the carrier of GF(p):]
  st g2 = 2 mod p & g3 = 3 mod p & g4 = 4 mod p & g8 = 8 mod p &
  gf1 = z`1*(P`3_3 |^2) + g3*(P`1_3 |^2) & gf2 = P`2_3*(P`3_3) &
  gf3 = P`1_3*(P`2_3)*gf2 & gf4 = (gf1 |^2) - g8*gf3 &
  R = [g2*gf4*gf2, gf1*(g4*gf3-gf4) - g8*(P`2_3 |^2)*(gf2 |^2), g8*(gf2 |^3)]
  holds g2*gf2*(P`3_3)*(R`2_3)
   = -(gf1*(P`3_3*(R`1_3) - P`1_3*(R`3_3)) + g2*gf2*(P`2_3)*(R`3_3));

theorem 
  for p be 5_or_greater Prime, z be Element of EC_WParam p,
  g2, g3, g4, g8, gf1, gf2, gf3, gf4 be Element of GF(p),
  P be Element of EC_SetProjCo(z`1,z`2,p),
  R be Element of
  [:the carrier of GF(p), the carrier of GF(p), the carrier of GF(p):]
  st g2 = 2 mod p & g3 = 3 mod p & g4 = 4 mod p & g8 = 8 mod p &
  gf1 = z`1*(P`3_3 |^2) + g3*(P`1_3 |^2) & gf2 = P`2_3*(P`3_3) &
  gf3 = P`1_3*(P`2_3)*gf2 & gf4 = (gf1 |^2) - g8*gf3 &
  R = [g2*gf4*gf2, gf1*(g4*gf3-gf4) - g8*(P`2_3 |^2)*(gf2 |^2), g8*(gf2 |^3)]
  holds g4*(gf2 |^2)*(P`3_3)*(R`1_3)
   = R`3_3*((gf1 |^2)*(P`3_3) - g8*(gf2 |^2)*(P`1_3));

theorem 
  for p be 5_or_greater Prime, z be Element of EC_WParam p,
  g2, g3, g4, g8, gf1, gf2, gf3, gf4 be Element of GF(p),
  P be Element of EC_SetProjCo(z`1,z`2,p),
  R be Element of
  [:the carrier of GF(p), the carrier of GF(p), the carrier of GF(p):]
  st g2 = 2 mod p & g3 = 3 mod p & g4 = 4 mod p & g8 = 8 mod p &
  gf1 = z`1*(P`3_3 |^2) + g3*(P`1_3 |^2) & gf2 = P`2_3*(P`3_3) &
  gf3 = P`1_3*(P`2_3)*gf2 & gf4 = (gf1 |^2) - g8*gf3 &
  R = [g2*gf4*gf2, gf1*(g4*gf3-gf4) - g8*(P`2_3 |^2)*(gf2 |^2), g8*(gf2 |^3)]
  holds g4*(gf2 |^2)*(P`3_3 |^2)*(z`2*(R`3_3))
         = R`3_3*((g2*gf2*(P`2_3)-gf1*(P`1_3)) |^2)
  - g4*(gf2 |^2)*(P`1_3 |^2)*(R`1_3);

theorem 
  for p be 5_or_greater Prime, z be Element of EC_WParam p,
  g2, g3, g4, g8, gf1, gf2, gf3, gf4 be Element of GF(p),
  P be Element of EC_SetProjCo(z`1,z`2,p),
  R be Element of
  [:the carrier of GF(p), the carrier of GF(p), the carrier of GF(p):]
  st g2 = 2 mod p & g3 = 3 mod p & g4 = 4 mod p & g8 = 8 mod p &
  gf1 = z`1*(P`3_3 |^2) + g3*(P`1_3 |^2) & gf2 = P`2_3*(P`3_3) &
  gf3 = P`1_3*(P`2_3)*gf2 & gf4 = (gf1 |^2) - g8*gf3 &
  R = [g2*gf4*gf2, gf1*(g4*gf3-gf4) - g8*(P`2_3 |^2)*(gf2 |^2), g8*(gf2 |^3)]
  holds g2*(gf2 |^2)*(P`3_3 |^2)*(z`1*(R`3_3))
    = gf1*(P`3_3)*(R`3_3)*(g2*gf2*(P`2_3)-gf1*(P`1_3))
  + (gf2 |^2)*(g4*(P`1_3)*(P`3_3)*(R`1_3)+g2*(P`1_3 |^2)*(R`3_3));

theorem 
  for p be 5_or_greater Prime, z be Element of EC_WParam p,
  g2, g3, g4, g8, gf1, gf2, gf3, gf4 be Element of GF(p),
  P be Element of EC_SetProjCo(z`1,z`2,p),
  R be Element of
  [:the carrier of GF(p), the carrier of GF(p), the carrier of GF(p):]
  st g2 = 2 mod p & g3 = 3 mod p & g4 = 4 mod p & g8 = 8 mod p &
  gf1 = z`1*(P`3_3 |^2) + g3*(P`1_3 |^2) & gf2 = P`2_3*(P`3_3) &
  gf3 = P`1_3*(P`2_3)*gf2 & gf4 = (gf1 |^2) - g8*gf3 &
  R = [g2*gf4*gf2, gf1*(g4*gf3-gf4) - g8*(P`2_3 |^2)*(gf2 |^2), g8*(gf2 |^3)]
  holds g4*(gf2 |^2)*(P`3_3 |^2)*
  ((R`2_3 |^2)*(R`3_3) - ((R`1_3 |^3) +
    z`1*(R`1_3)*(R`3_3 |^2) + z`2*(R`3_3 |^3))) = 0.GF(p);

definition
  let p be 5_or_greater Prime,
      z be Element of EC_WParam p;
  func addell_ProjCo(z,p) -> Function of
  [:EC_SetProjCo(z`1,z`2,p),EC_SetProjCo(z`1,z`2,p):],
  EC_SetProjCo(z`1,z`2,p) means

  for P, Q, O being Element of EC_SetProjCo(z`1,z`2,p) st
  O = [0,1,0]
  holds
  (P _EQ_ O implies it.(P,Q) = Q) &
  ((Q _EQ_ O & not P _EQ_ O) implies it.(P,Q) = P) &
  ((not P _EQ_ O & not Q _EQ_ O & not P _EQ_ Q) implies
  for g2, gf1, gf2, gf3 being Element of GF(p) st g2 = 2 mod p &
  gf1 = Q`2_3*(P`3_3) - P`2_3*(Q`3_3) &
  gf2 = Q`1_3*(P`3_3) - P`1_3*(Q`3_3) &
  gf3 = (gf1 |^2)*(P`3_3)*(Q`3_3) - (gf2 |^3) - g2*(gf2 |^2)*(P`1_3)*(Q`3_3)
  holds it.(P,Q) = [gf2*gf3,
  gf1 * ((gf2 |^2)*(P`1_3)*(Q`3_3)-gf3)
   - (gf2 |^3)*(P`2_3)*(Q`3_3), (gf2 |^3)*(P`3_3)*(Q`3_3)]) &
  ((not P _EQ_ O & not Q _EQ_ O & P _EQ_ Q) implies
  for g2, g3, g4, g8, gf1, gf2, gf3, gf4 being Element of GF(p) st
  g2 = 2 mod p & g3 = 3 mod p & g4 = 4 mod p & g8 = 8 mod p &
  gf1 = (z`1)*(P`3_3 |^2) + g3*(P`1_3 |^2) &
  gf2 = P`2_3*(P`3_3) &
  gf3 = P`1_3*(P`2_3)*gf2 &
  gf4 = (gf1 |^2) - g8*gf3
  holds it.(P,Q) = [g2*gf4*gf2,
  gf1*(g4 * gf3-gf4) - g8*(P`2_3 |^2)*(gf2 |^2),
  g8*(gf2 |^3)]);
end;

definition
  let p be 5_or_greater Prime, z be Element of EC_WParam p;
  let F be Function of
  [:EC_SetProjCo(z`1,z`2,p),EC_SetProjCo(z`1,z`2,p):],
  EC_SetProjCo(z`1,z`2,p);
  let Q,R be Element of EC_SetProjCo(z`1,z`2,p);
  redefine func F.(Q,R) -> Element of EC_SetProjCo(z`1,z`2,p);
end;














begin 

reserve T,U for non empty TopSpace;
reserve t for Point of T;
reserve n for Nat;

registration
  let S be TopSpace, T be non empty TopSpace;
  cluster constant -> continuous for Function of S,T;
end;

theorem 
  L[01](0,1,0,1) = id Closed-Interval-TSpace(0,1);

theorem 
  for r1,r2,r3,r4,r5,r6 being real number
  st r1 < r2 & r3 <= r4 & r5 < r6
  holds L[01](r1,r2,r3,r4)*L[01](r5,r6,r1,r2) = L[01](r5,r6,r3,r4);

registration
  let n be positive Nat;
  cluster TOP-REAL n -> infinite;
  cluster n-locally_euclidean -> infinite for non empty TopSpace;
end;

theorem 
  for p being Point of TOP-REAL n st p in Sphere(0.TOP-REAL n,1)
  holds -p in Sphere(0.TOP-REAL n,1) \ {p};

theorem 
  for T being non empty TopStruct, t1,t2 being Point of T
  for p being Path of t1,t2
  holds inf dom p = 0 & sup dom p = 1;

theorem 
  for C1,C2 being constant Loop of t holds
  C1, C2 are_homotopic;

theorem 
  for S being non empty SubSpace of T,
      t1,t2 being Point of T, s1,s2 being Point of S,
      A,B being Path of t1,t2, C,D being Path of s1,s2 st
  s1,s2 are_connected & t1,t2 are_connected & A = C & B = D & C,D are_homotopic
  holds A,B are_homotopic;

theorem 
  for S being non empty SubSpace of T,
      t1,t2 being Point of T, s1,s2 being Point of S,
      A,B being Path of t1,t2, C,D being Path of s1,s2 st
  s1,s2 are_connected & t1,t2 are_connected & A = C & B = D &
  Class(EqRel(S,s1,s2),C) = Class(EqRel(S,s1,s2),D) holds
  Class(EqRel(T,t1,t2),A) = Class(EqRel(T,t1,t2),B);

theorem 
  for T being trivial non empty TopSpace
  for t being Point of T, L being Loop of t holds
  the carrier of pi_1(T,t) = { Class(EqRel(T,t),L) };

theorem 
  for p being Point of TOP-REAL n, S being Subset of TOP-REAL n
  st n >= 2 & S = ([#]TOP-REAL n) \ {p}
  holds (TOP-REAL n) | S is pathwise_connected;

theorem 
  for S being non empty Subset of T
  st n >= 2 & S = ([#]T) \ {t} & TOP-REAL n, T are_homeomorphic
  holds T | S is pathwise_connected;

registration
  let n be Element of NAT;
  let p,q be Point of TOP-REAL n;
  cluster TPlane(p,q) -> convex;
end;

begin 

definition
  let T;
  attr T is having_trivial_Fundamental_Group means

  for t being Point of T holds pi_1(T,t) is trivial;
end;

definition
  let T;
  attr T is simply_connected means

  T is having_trivial_Fundamental_Group pathwise_connected;
end;

registration
  cluster simply_connected ->
          having_trivial_Fundamental_Group pathwise_connected
          for non empty TopSpace;
  cluster having_trivial_Fundamental_Group pathwise_connected ->
          simply_connected for non empty TopSpace;
end;

theorem 
  T is having_trivial_Fundamental_Group implies
  for t being Point of T, P,Q being Loop of t holds
  P,Q are_homotopic;

registration
  let n be Nat;
  cluster TOP-REAL n -> having_trivial_Fundamental_Group;
end;

registration
  cluster trivial -> having_trivial_Fundamental_Group for non empty TopSpace;
end;

theorem 
  T is simply_connected iff
  for t1,t2 being Point of T holds t1,t2 are_connected &
  for P, Q being Path of t1,t2 holds
  Class(EqRel(T,t1,t2),P) = Class(EqRel(T,t1,t2),Q);

registration
  let T be having_trivial_Fundamental_Group non empty TopSpace;
  let t be Point of T;
  cluster pi_1(T,t) -> trivial;
end;

theorem 
  for S, T being non empty TopSpace st S,T are_homeomorphic holds
  S is having_trivial_Fundamental_Group implies
  T is having_trivial_Fundamental_Group;

theorem 
  for S, T being non empty TopSpace st S,T are_homeomorphic holds
  S is simply_connected implies T is simply_connected;

theorem 
  for T being having_trivial_Fundamental_Group non empty TopSpace,
      t being Point of T, P1,P2 being Loop of t
  holds P1,P2 are_homotopic;

definition
  let T, t;
  let l be Loop of t;
  attr l is nullhomotopic means

  ex c being constant Loop of t st l,c are_homotopic;
end;

registration
  let T, t;
  cluster constant -> nullhomotopic for Loop of t;
end;

registration
  let T, t;
  cluster constant for Loop of t;
end;

theorem 
  for f being Loop of t, g being continuous Function of T,U st
   f is nullhomotopic holds g*f is nullhomotopic;

registration
  let T, U be non empty TopSpace,
      t be Point of T,
      f be nullhomotopic Loop of t,
      g be continuous Function of T,U;
  cluster g*f -> nullhomotopic for Loop of g.t;
end;

registration
  let T be having_trivial_Fundamental_Group non empty TopSpace;
  let t be Point of T;
  cluster -> nullhomotopic for Loop of t;
end;

theorem 
  (for t being Point of T, f being Loop of t holds f is nullhomotopic)
  implies T is having_trivial_Fundamental_Group;

registration
  let n be Element of NAT;
  let p,q be Point of TOP-REAL n;
  cluster TPlane(p,q) -> having_trivial_Fundamental_Group;
end;

theorem 
  for S being non empty SubSpace of T, s being Point of S,
      f being Loop of t, g being Loop of s st
   t = s & f = g & g is nullhomotopic
  holds f is nullhomotopic;

begin 

reserve T for TopStruct;
reserve f for PartFunc of R^1, T;

definition
  let T,f;
  attr f is parametrized-curve means

  dom f is interval Subset of REAL &
  ex S being SubSpace of R^1, g being Function of S, T
  st f = g & S = R^1|dom f & g is continuous;
end;

registration
  let T;
  cluster parametrized-curve for PartFunc of R^1, T;
end;

theorem 
  {} is parametrized-curve PartFunc of R^1, T;

definition
  let T;
  func Curves T -> Subset of PFuncs(REAL, [#]T) equals

  {f where f is Element of PFuncs(REAL, [#]T) :
     f is parametrized-curve PartFunc of R^1, T};
end;

registration
  let T;
  cluster Curves T -> non empty;
end;

definition
  let T;
  mode Curve of T is Element of Curves T;
end;

reserve c for Curve of T;

theorem 
  for f being parametrized-curve PartFunc of R^1, T holds f is Curve of T;

theorem 
  {} is Curve of T;

theorem 
  for t1,t2 being Point of T
  for p being Path of t1,t2 st t1,t2 are_connected holds p is Curve of T;

theorem 
  c is parametrized-curve PartFunc of R^1, T;

theorem 
  dom c c= REAL & rng c c= [#]T;

registration
  let T,c;
  cluster dom c -> real-membered;
end;

definition
  let T,c;
  attr c is with_first_point means

  dom c is left_end;
  attr c is with_last_point means

  dom c is right_end;
end;

definition
  let T,c;
  attr c is with_endpoints means

  c is with_first_point with_last_point;
end;

registration
  let T;
  cluster with_first_point with_last_point -> with_endpoints for Curve of T;
  cluster with_endpoints -> with_first_point with_last_point for Curve of T;
end;

reserve T for non empty TopStruct;

registration
  let T;
  cluster with_endpoints for Curve of T;
end;

registration
  let T;
  let c be with_first_point Curve of T;
  cluster dom c -> non empty;
  cluster inf dom c -> real;
end;

registration
  let T;
  let c be with_last_point Curve of T;
  cluster dom c -> non empty;
  cluster sup dom c -> real;
end;

registration
  let T;
  cluster with_first_point -> non empty for Curve of T;
  cluster with_last_point -> non empty for Curve of T;
end;

definition
  let T;
  let c be with_first_point Curve of T;
  func the_first_point_of c -> Point of T equals

  c.(inf dom c);
end;

definition
  let T;
  let c be with_last_point Curve of T;
  func the_last_point_of c -> Point of T equals

  c.(sup dom c);
end;

theorem 
  for t1,t2 being Point of T
  for p being Path of t1,t2 st t1,t2 are_connected
  holds p is with_endpoints Curve of T;

theorem 
  for c being Curve of T
  for r1,r2 being real number
  holds c | [.r1, r2.] is Curve of T;

theorem 
  for c being with_endpoints Curve of T holds
  dom c = [.inf dom c, sup dom c.];

theorem 
  for c being with_endpoints Curve of T st dom c = [.0,1.]
  holds c is Path of the_first_point_of c,the_last_point_of c;

theorem 
  for c being with_endpoints Curve of T holds
  c*L[01](0,1,inf dom c,sup dom c)
  is Path of the_first_point_of c,the_last_point_of c;

theorem 
  for c being with_endpoints Curve of T,
      t1,t2 being Point of T
  st c*L[01](0,1,inf dom c,sup dom c) is Path of t1,t2 & t1,t2 are_connected
  holds t1 = the_first_point_of c & t2 = the_last_point_of c;

theorem 
  for c being with_endpoints Curve of T
  holds the_first_point_of c in rng c & the_last_point_of c in rng c;

theorem 
  for r1,r2 being real number
  for t1,t2 being Point of T
  for p1 being Path of t1,t2
  st t1,t2 are_connected & r1 < r2
  holds p1*L[01](r1,r2,0,1) is with_endpoints Curve of T;

theorem 
  for c being with_endpoints Curve of T
  holds the_first_point_of c, the_last_point_of c are_connected;

definition
  let T be non empty TopStruct;
  let c1,c2 be with_endpoints Curve of T;
  pred c1,c2 are_homotopic means

  ex a,b being Point of T, p1,p2 being Path of a,b st
  p1 = c1*L[01](0,1,inf dom c1,sup dom c1) &
  p2 = c2*L[01](0,1,inf dom c2,sup dom c2) &
  p1,p2 are_homotopic;
  symmetry;
end;

definition
  let T be non empty TopSpace;
  let c1,c2 be with_endpoints Curve of T;
  redefine pred c1,c2 are_homotopic;
  reflexivity;
  symmetry;
end;

theorem 
  for T being non empty TopStruct,
      c1,c2 being with_endpoints Curve of T,
      a,b being Point of T,
      p1,p2 being Path of a,b
  st c1 = p1 & c2 = p2 & a,b are_connected
  holds c1,c2 are_homotopic iff p1,p2 are_homotopic;

theorem 
  for c1,c2 being with_endpoints Curve of T
  st c1, c2 are_homotopic
  holds the_first_point_of c1 = the_first_point_of c2 &
  the_last_point_of c1 = the_last_point_of c2;

theorem 
  for T being non empty TopSpace
  for c1,c2 being with_endpoints Curve of T
  for S being Subset of R^1
  st dom c1 = dom c2 & S = dom c1 holds c1,c2 are_homotopic iff
   ex f being Function of [:R^1|S,I[01]:], T, a,b being Point of T
   st f is continuous &
   (for t being Point of R^1|S holds f.(t,0) = c1.t & f.(t,1) = c2.t) &
   (for t being Point of I[01] holds f.(inf S,t) = a & f.(sup S,t) = b);

definition
  let T be TopStruct;
  let c1, c2 be Curve of T;
  func c1 + c2 -> Curve of T equals

  c1 \/ c2 if c1 \/ c2 is Curve of T otherwise {};
end;

theorem 
  for c being with_endpoints Curve of T
  for r being real number holds
  ex c1,c2 being Element of Curves T
  st c = c1 + c2 & c1 = c | [.inf dom c, r.] & c2 = c | [.r, sup dom c.];

theorem 
  for T being non empty TopSpace
  for c1,c2 being with_endpoints Curve of T
  st sup dom c1 = inf dom c2 & the_last_point_of c1 = the_first_point_of c2
  holds c1 + c2 is with_endpoints &
         dom(c1 + c2) = [.inf dom c1, sup dom c2.] &
         (c1+c2).inf dom c1 = the_first_point_of c1 &
         (c1+c2).sup dom c2 = the_last_point_of c2;

theorem 
  for T being non empty TopSpace
  for c1,c2,c3,c4,c5,c6 being with_endpoints Curve of T
  st c1,c2 are_homotopic & dom c1 = dom c2 &
     c3,c4 are_homotopic & dom c3 = dom c4 &
     c5 = c1 + c3 & c6 = c2 + c4
  & the_last_point_of c1 = the_first_point_of c3
  & sup dom c1 = inf dom c3
  holds c5,c6 are_homotopic;

definition
  let T be TopStruct;
  let f be FinSequence of Curves T;
  func Partial_Sums f -> FinSequence of Curves T means

  len f = len it & f.1 = it.1 & for i being Nat
  st 1<=i & i<len f holds it.(i+1) = (it/.i) + (f/.(i+1));
end;

definition
  let T be TopStruct;
  let f be FinSequence of Curves T;
  func Sum f -> Curve of T equals

    (Partial_Sums f).len f if len f > 0 otherwise {};
end;

theorem 
  for c being Curve of T holds Sum <*c*> = c;

theorem 
  for c being Curve of T,
      f being FinSequence of Curves T holds Sum(f ^ <*c*>) = Sum f + c;

theorem 
  for X being set, f being FinSequence of Curves T
  st (for i being Nat st 1 <= i & i <= len f holds rng(f/.i) c= X)
  holds rng Sum f c= X;

theorem 
  for T being non empty TopSpace
  for f being FinSequence of Curves T
  st len f > 0 &
     (for i being Nat st 1 <= i & i < len f
       holds (f/.i).sup dom(f/.i) = (f/.(i+1)).inf dom(f/.(i+1))
       & sup dom(f/.i) = inf dom(f/.(i+1))) &
     (for i being Nat st 1 <= i & i <= len f
       holds f/.i is with_endpoints)
  holds ex c being with_endpoints Curve of T st
    Sum f = c & dom c = [.inf dom(f/.1), sup dom(f/.(len f)).] &
    the_first_point_of c = (f/.1).(inf dom(f/.1)) &
    the_last_point_of c = (f/.(len f)).(sup dom(f/.(len f)));

theorem 
  for T being non empty TopSpace
  for f1,f2 being FinSequence of Curves T
  for c1,c2 being with_endpoints Curve of T
  st len f1 > 0 & len f1 = len f2 & Sum f1 = c1 & Sum f2 = c2 &
     (for i being Nat st 1 <= i & i < len f1
       holds (f1/.i).sup dom(f1/.i) = (f1/.(i+1)).inf dom(f1/.(i+1))
       & sup dom(f1/.i) = inf dom(f1/.(i+1))) &
     (for i being Nat st 1 <= i & i < len f2
       holds (f2/.i).sup dom(f2/.i) = (f2/.(i+1)).inf dom(f2/.(i+1))
       & sup dom(f2/.i) = inf dom(f2/.(i+1)) ) &
     (for i being Nat st 1 <= i & i <= len f1 holds
       ex c3,c4 being with_endpoints Curve of T st c3 = f1/.i & c4 = f2/.i
        & c3,c4 are_homotopic & dom c3 = dom c4)
  holds c1,c2 are_homotopic;

theorem 
  for c being with_endpoints Curve of T
  for h being FinSequence of REAL
  st len h >= 2 & h.1 = inf dom c & h.len h = sup dom c & h is increasing
  holds
    ex f being FinSequence of Curves T
    st len f = len h - 1 & c = Sum f &
    (for i being Nat st 1 <= i & i <= len f
      holds f/.i = c | ([.h/.i,h/.(i+1).]));

theorem 
  n >= 2 implies TUnitSphere(n) is having_trivial_Fundamental_Group;

theorem 
  for n being non empty Nat, r being positive real number,
      x being Point of TOP-REAL n st n >= 3 holds
  Tcircle(x,r) is having_trivial_Fundamental_Group;














begin 

reserve a,b,c,x,y,z,X,Y,Z for set,
  n for Nat,
  i,j for Integer,
  r,r1,r2,r3,s for real number,
  c,c1,c2 for complex number,
  p for Point of TOP-REAL n;

registration
  cluster -> irrational for Element of IRRAT;
end;

theorem 
  0 <= r & 0 <= s & r^2 = s^2 implies r = s;

theorem 
  frac(r) >= frac(s) implies frac(r-s) = frac(r) - frac(s);

theorem 
  frac(r) < frac(s) implies frac(r-s) = frac(r) - frac(s) + 1;

theorem 
  ex i st frac(r-s) = frac(r) - frac(s) + i & (i = 0 or i = 1);

theorem 
  sin(r) = 0 implies r = 2*PI*[\r/(2*PI)/] or r = PI+2*PI*[\r/(2*PI)/];

theorem 
  cos(r) = 0 implies r = PI/2+2*PI*[\r/(2*PI)/] or r = 3*PI/2+2*PI*[\r/(2*PI)/]
;

theorem 
  sin(r) = 0 implies ex i st r = PI*i;

theorem 
  cos(r) = 0 implies ex i st r = PI/2+PI*i;

theorem 
  sin(r) = sin(s) implies ex i st r = s + 2*PI*i or r = PI-s + 2*PI*i;

theorem 
  cos(r) = cos(s) implies ex i st r = s + 2*PI*i or r = -s + 2*PI*i;

theorem 
  sin(r) = sin(s) & cos(r) = cos(s) implies ex i st r = s + 2*PI*i;

theorem 
  |.c1.| = |.c2.| & Arg c1 = Arg c2 + 2*PI*i implies c1 = c2;

registration
  let f be one-to-one complex-valued Function;
  let c;
  cluster f+c -> one-to-one;
end;

registration
  let f be one-to-one complex-valued Function;
  let c;
  cluster f-c -> one-to-one;
end;

theorem 
  for f being complex-valued FinSequence holds len -f = len f;

theorem 
  -(0*n) = 0*n;

theorem 
  for f being complex-valued Function holds
  f <> 0*n implies -f <> 0*n;

theorem 
  sqr <*r1,r2,r3*> = <* r1^2, r2^2, r3^2 *>;

theorem 
  Sum sqr <*r1,r2,r3*> = r1^2+r2^2+r3^2;

theorem 
  for f being complex-valued FinSequence holds (c(#)f)^2 = (c^2) (#) (f^2);

theorem 
  for f being complex-valued FinSequence holds (f(/)c)^2 = (f^2) (/) (c^2);

theorem 
  for f being real-valued FinSequence st Sum f <> 0 holds Sum (f (/) Sum f) = 1
;

definition
  let a,b,c,x,y,z be set;
  func (a,b,c) --> (x,y,z) equals

  ((a,b) --> (x,y)) +* (c .--> z);
end;

registration
  let a,b,c,x,y,z be set;
  cluster (a,b,c) --> (x,y,z) -> Function-like Relation-like;
end;

theorem 
  dom((a,b,c) --> (x,y,z)) = {a,b,c};

theorem 
  rng((a,b,c) --> (x,y,z)) c= {x,y,z};

theorem 
  (a,a,a) --> (x,y,z) = a .--> z;

theorem 
  (a,a,b) --> (x,y,z) = (a,b) --> (y,z);

theorem 
  a <> b implies (a,b,a) --> (x,y,z) = (a,b) --> (z,y);

theorem 
  (a,b,b) --> (x,y,z) = (a,b) --> (x,z);

theorem 
  a <> b & a <> c implies ((a,b,c) --> (x,y,z)).a = x;

theorem 
  a,b,c are_mutually_different implies
  ((a,b,c) --> (x,y,z)).a = x & ((a,b,c) --> (x,y,z)).b = y &
  ((a,b,c) --> (x,y,z)).c = z;

theorem 
  for f being Function st dom f = {a,b,c} & f.a = x & f.b = y & f.c = z holds
  f = (a,b,c) --> (x,y,z);

theorem 
  <*a,b,c*> = (1,2,3) --> (a,b,c);

theorem 
  a,b,c are_mutually_different implies
  product (a,b,c) --> ({x},{y},{z}) = { (a,b,c) --> (x,y,z) };

theorem 
  for A, B, C, D, E, F being set st A c= B & C c= D & E c= F holds
  product ((a,b,c) --> (A,C,E)) c= product ((a,b,c) --> (B,D,F));

theorem 
  a,b,c are_mutually_different & x in X & y in Y & z in Z implies
  (a,b,c) --> (x,y,z) in product((a,b,c) --> (X,Y,Z));

definition
  let f be Function;
  attr f is odd means


  for x, y being complex-valued Function st x in dom f & -x in dom f & y = f.x
  holds f.-x = -y;
end;

registration
  cluster {} -> odd;
end;

registration
  cluster odd for complex-functions-valued Function;
end;

theorem 
  for p being Point of TOP-REAL 3 holds
  sqr p = <* p`1^2, p`2^2, p`3^2 *>;

theorem 
  for p being Point of TOP-REAL 3 holds
  Sum sqr p = p`1^2+p`2^2+p`3^2;

theorem 
  for S being Subset of R^1 st S = RAT holds
  RAT /\ ]. -infty,r .[ is open Subset of R^1 | S;

theorem 
  for S being Subset of R^1 st S = RAT holds
  RAT /\ ]. r,+infty .[ is open Subset of R^1 | S;

registration
  let X be connected non empty TopSpace, Y be non empty TopSpace;
  let f be continuous Function of X,Y;
  cluster Image f -> connected;
end;

theorem 
  for S being Subset of R^1 st S = RAT
  for T being connected TopSpace, f being Function of T, R^1 | S
  st f is continuous holds f is constant;

theorem 
  for a, b being real number,
  f being continuous Function of Closed-Interval-TSpace(a,b), R^1,
  g being PartFunc of REAL, REAL st a <= b & f = g holds
  g is continuous;

definition
  let s be Point of R^1;
  let r be real number;
  redefine func s+r -> Point of R^1;
end;

definition
  let s be Point of R^1;
  let r be real number;
  redefine func s-r -> Point of R^1;
end;

definition
  let X be set;
  let f be Function of X,R^1;
  let r;
  redefine func f+r -> Function of X,R^1;
end;

definition
  let X be set;
  let f be Function of X,R^1;
  let r;
  redefine func f-r -> Function of X,R^1;
end;

definition
  let s, t be Point of R^1;
  let f be Path of s,t;
  let r be real number;
  redefine func f+r -> Path of s+r,t+r;
  redefine func f-r -> Path of s-r,t-r;
end;

definition
  func c[100] -> Point of Tunit_circle(3) equals

  |[1,0,0]|;
end;

definition
  func c[-100] -> Point of Tunit_circle(3) equals

  |[-1,0,0]|;
end;

theorem 
  -c[100] = c[-100];

theorem 
  -c[-100] = c[100];

theorem 
  c[100] - c[-100] = |[2,0,0]|;

theorem 
  for p being Point of TOP-REAL 2 holds
  p`1 = |.p.|*cos(Arg p) & p`2 = |.p.|*sin(Arg p);

theorem 
  for p being Point of TOP-REAL 2 holds
  p = cpx2euc(|.p.|*cos(Arg p) + |.p.|*sin(Arg p)*<i>);

theorem 
  for p1, p2 being Point of TOP-REAL 2 holds
  |.p1.| = |.p2.| & Arg p1 = Arg p2 + 2*PI*i implies p1 = p2;

theorem 
  for p being Point of TOP-REAL 2 st p = CircleMap.r holds
  Arg(p) = 2*PI*frac(r);

theorem 
  for p1, p2 being Point of TOP-REAL 3, u1, u2 being Point of Euclid 3 holds
  u1 = p1 & u2 = p2 implies
  (Pitag_dist 3).(u1,u2) =
  sqrt ((p1`1 - p2`1)^2 + (p1`2 - p2`2)^2 + (p1`3 - p2`3)^2);

theorem 
  for p being Point of TOP-REAL 3, e being Point of Euclid 3 holds
  p = e & p`3 = 0 implies product ((1,2,3) --> (].p`1-r/sqrt 2,p`1+r/sqrt 2.[,
  ].p`2-r/sqrt 2,p`2+r/sqrt 2.[,{0})) c= Ball(e,r);

theorem 
  for s being Real holds Rotate(c,s) = Rotate(c,s+2*PI*i);

theorem 
  for s being Real holds Rotate(s) = Rotate(s+2*PI*i);

theorem 
  for s being Real, p being Point of TOP-REAL 2 holds
  |.(Rotate(s)).p.| = |.p.|;

theorem 
  for s being Real, p being Point of TOP-REAL 2 holds
  Arg((Rotate(s)).p) = Arg Rotate(euc2cpx(p),s);

theorem 
  for s being Real, p being Point of TOP-REAL 2 st p <> 0.TOP-REAL 2
  ex i st Arg((Rotate(s)).p) = s+(Arg p)+2*PI*i;

theorem 
  for s being Real holds (Rotate(s)).(0.TOP-REAL 2) = 0.TOP-REAL 2;

theorem 
  for s being Real, p being Point of TOP-REAL 2 holds
  (Rotate(s)).p = 0.TOP-REAL 2 implies p = 0.TOP-REAL 2;

theorem 
  for s being Real, p being Point of TOP-REAL 2 holds
  (Rotate(s)).((Rotate(-s)).p) = p;

theorem 
  for s being Real holds (Rotate(s)) * (Rotate(-s)) = id TOP-REAL 2;

theorem 
  for s being Real, p being Point of TOP-REAL 2 holds
  p in Sphere(0.TOP-REAL 2,r) iff (Rotate(s)).p in Sphere(0.TOP-REAL 2,r);

theorem 
  for r being non negative real number, s being Real holds
  (Rotate(s)).:Sphere(0.TOP-REAL 2,r) = Sphere(0.TOP-REAL 2,r);

definition
  let r be non negative real number;
  let s be Real;
  func RotateCircle(r,s) ->
       Function of Tcircle(0.TOP-REAL 2,r),Tcircle(0.TOP-REAL 2,r) equals

  (Rotate(s)) | Tcircle(0.TOP-REAL 2,r);
end;

registration
  let r be non negative real number, s be Real;
  cluster RotateCircle(r,s) -> being_homeomorphism;
end;

theorem 
  for p being Point of TOP-REAL 2 st p = CircleMap.r2 holds
  RotateCircle(1,-Arg(p)).(CircleMap.r1) = CircleMap.(r1-r2);

begin 

definition
  let n be non empty Nat;
  let p be Point of TOP-REAL n;
  let r be non negative real number;
  func CircleIso(p,r) -> Function of Tunit_circle(n), Tcircle(p,r) means


  for a being Point of Tunit_circle(n),
      b being Point of TOP-REAL n st a = b holds it.a = r*b+p;
end;

registration
  let n be non empty Nat, p be Point of TOP-REAL n,
      r be positive real number;
  cluster CircleIso(p,r) -> being_homeomorphism;
end;

definition
  func SphereMap -> Function of R^1, Tunit_circle(3) means


  for x being real number holds it.x = |[ cos(2*PI*x), sin(2*PI*x), 0 ]|;
end;

theorem 
  SphereMap.i = c[100];

registration
  cluster SphereMap -> continuous;
end;

definition
  let r be real number;
  func eLoop(r) -> Function of I[01], Tunit_circle(3) means


  for x being Point of I[01] holds it.x = |[cos(2*PI*r*x), sin(2*PI*r*x), 0]|;
end;

theorem 
  eLoop(r) = SphereMap * ExtendInt(r);

definition
  let i;
  redefine func eLoop(i) -> Loop of c[100];
end;

registration
  let i;
  cluster eLoop(i) -> nullhomotopic for Loop of c[100];
end;

theorem 
  p <> 0.TOP-REAL n implies |. p (/) |. p .| .| = 1;

definition
  let n be Nat;
  let p be Point of TOP-REAL n;
  assume
 p <> 0.TOP-REAL n;
  func Rn->S1(p) -> Point of Tcircle(0.TOP-REAL n,1) equals


  p (/) |. p .|;
end;

reserve n for non zero Nat;

definition
  let n be non zero Nat;
  let f be Function of Tcircle(0.TOP-REAL(n+1),1),TOP-REAL n;
  func Sn1->Sn(f) ->
       Function of Tunit_circle(n+1),Tunit_circle(n)
  means


  for x, y being Point of Tcircle(0.TOP-REAL(n+1),1) st y = -x holds
  it.x = Rn->S1(f.x-f.y);
end;

definition
  let x0, y0 be Point of Tunit_circle(2),
      xt be set,
      f be Path of x0,y0 such that
   xt in (CircleMap)"{x0};
  func liftPath(f,xt) -> Function of I[01], R^1 means


  it.0 = xt & f = CircleMap*it & it is continuous &
  for f1 being Function of I[01], R^1 st f1 is continuous & f = CircleMap*f1 &
  f1.0 = xt holds it = f1;
end;

definition
  let n be Nat,
      p, x, y be Point of TOP-REAL n,
      r be real number;
  pred x,y are_antipodals_of p,r means


  x is Point of Tcircle(p,r) & y is Point of Tcircle(p,r) & p in LSeg(x,y);
end;

definition
  let n be Nat,
      p, x, y be Point of TOP-REAL n,
      r be real number,
      f be Function;
  pred x,y are_antipodals_of p,r,f means


  x,y are_antipodals_of p,r & x in dom f & y in dom f & f.x = f.y;
end;

definition
  let m,n be Nat,
      p be Point of TOP-REAL m,
      r be real number,
      f be Function of Tcircle(p,r), TOP-REAL n;
  attr f is with_antipodals means

  ex x, y being Point of TOP-REAL m st x,y are_antipodals_of p,r,f;
end;

notation
  let m,n be Nat,
      p be Point of TOP-REAL m,
      r be real number,
      f be Function of Tcircle(p,r), TOP-REAL n;
  antonym f is without_antipodals for f is with_antipodals;
end;

theorem 
  for n being non empty Nat,
      r being non negative real number,
      x being Point of TOP-REAL n st x is Point of Tcircle(0.TOP-REAL n,r)
  holds x,-x are_antipodals_of 0.TOP-REAL n,r;

theorem 
  for n being non empty Nat,
      p, x, y, x1, y1 being Point of TOP-REAL n,
      r being positive real number
  st x,y are_antipodals_of 0.TOP-REAL n,1 &
     x1 = CircleIso(p,r).x & y1 = CircleIso(p,r).y
  holds x1,y1 are_antipodals_of p,r;

theorem 
  for f being Function of Tcircle(0.TOP-REAL(n+1),1),TOP-REAL n
  for x being Point of Tcircle(0.TOP-REAL(n+1),1) st
  f is without_antipodals holds f.x - f.-x <> 0.TOP-REAL n;

theorem 
  for f being Function of Tcircle(0.TOP-REAL(n+1),1),TOP-REAL n holds
  f is without_antipodals implies Sn1->Sn(f) is odd;

theorem 
  for f being Function of Tcircle(0.TOP-REAL(n+1),1),TOP-REAL n
  for g, B1 being Function of Tcircle(0.TOP-REAL(n+1),1),TOP-REAL n
  st g = f(-) & B1 = f<-->g & f is without_antipodals holds
  Sn1->Sn(f) = B1 </> (n NormF * B1);

registration
  let n;
  let r be negative real number, p be Point of TOP-REAL(n+1);
  cluster -> without_antipodals for Function of Tcircle(p,r),TOP-REAL n;
end;


registration
  let r be non negative real number, p be Point of TOP-REAL 3;
  cluster continuous -> with_antipodals for
          Function of Tcircle(p,r),TOP-REAL 2;
end;














begin 

reserve m,n for non empty Element of NAT;
reserve i,j,k for Element of NAT;
reserve Z for set;

theorem 
for S,T be RealNormSpace,
    f be Point of R_NormSpace_of_BoundedLinearOperators(S,T),
    r be Real st
  0 <= r &
  for x be Point of S st ||.x.|| <= 1 holds ||. f.x .|| <= r * ||.x.||
 holds ||.f.|| <= r;

theorem 
for S be RealNormSpace, f be PartFunc of S,REAL
  holds
    f is_continuous_on Z
 iff
    Z c= dom f
  & for s1 be sequence of S
     st rng s1 c= Z & s1 is convergent & lim s1 in Z
     holds f/*s1 is convergent & f/.(lim s1) = lim (f/*s1);

theorem 
for f be PartFunc of REAL i,REAL holds dom <>*f = dom f;

theorem 
for f be PartFunc of REAL i,REAL st Z c= dom f holds dom ((<>*f) |Z) = Z;

theorem 
for f be PartFunc of REAL i,REAL holds <>*(f|Z) = (<>*f) |Z;

theorem 
for f be PartFunc of REAL i,REAL, x be Element of REAL i st
  x in dom f holds (<>*f).x = <* f.x *> & (<>*f)/.x = <* f/.x *>;

theorem 
for f,g be PartFunc of REAL i,REAL
 holds <>*(f+g) = <>*f + <>*g & <>*(f-g) = <>*f - <>*g;

theorem 
for f be PartFunc of REAL i,REAL, r be real number
 holds <>*(r(#)f) = r(#)(<>*f);

theorem 
for f be PartFunc of REAL i,REAL, g be PartFunc of REAL i,REAL 1
 st <>*f = g holds |.f.| = |.g.|;

theorem 
for X be Subset of REAL m, Y be Subset of REAL-NS m st
  X = Y holds X is open iff Y is open;

theorem 
for q be Element of REAL
 st 1 <= i & i <= j holds |. reproj(i,0*j).q .| = |.q.|;

theorem 
for x be Element of REAL j holds x = reproj(i,x).(proj(i,j).x);

begin  

theorem 
for X be Subset of REAL m, f be PartFunc of REAL m,REAL n st
 f is_differentiable_on X holds X is open;

theorem 
for X be Subset of REAL m, f be PartFunc of REAL m,REAL n st X is open holds
  ( f is_differentiable_on X
 iff
    X c=dom f &
    for x be Element of REAL m st x in X holds f is_differentiable_in x );

definition
  let m,n be non empty Element of NAT, Z be set,
      f be PartFunc of REAL m,REAL n;
  assume  Z c= dom f;
  func f`|Z -> PartFunc of REAL m, Funcs(REAL m,REAL n) means

  dom it = Z &
  for x be Element of REAL m st x in Z holds it/.x = diff(f,x);
end;

theorem 
for X be Subset of REAL m, f,g be PartFunc of REAL m,REAL n st
  f is_differentiable_on X & g is_differentiable_on X
 holds
   f+g is_differentiable_on X
 & for x be Element of REAL m st x in X
     holds ((f+g)`|X)/.x = diff(f,x) + diff(g,x);

theorem 
for X be Subset of REAL m, f,g be PartFunc of REAL m,REAL n st
 f is_differentiable_on X & g is_differentiable_on X
 holds
    f-g is_differentiable_on X
  & for x be Element of REAL m st x in X
      holds ((f-g)`|X)/.x = diff(f,x)- diff(g,x);

theorem 
for X be Subset of REAL m, f be PartFunc of REAL m,REAL n, r be Real
 st f is_differentiable_on X
 holds
    r(#)f is_differentiable_on X
  & for x be Element of REAL m st x in X holds ((r(#)f)`|X)/.x = r(#)diff(f,x);

theorem 
for f be Point of R_NormSpace_of_BoundedLinearOperators(REAL-NS 1,REAL-NS j)
  ex p be Point of REAL-NS j st
   p = f.<*1*>
 & (for r be Real, x be Point of REAL-NS 1 st x = <*r*> holds f.x = r*p)
 & (for x be Point of REAL-NS 1 holds ||. f.x .|| =  ||.p.|| * ||.x.||);

theorem 
for f be Point of R_NormSpace_of_BoundedLinearOperators(REAL-NS 1,REAL-NS j)
  ex p be Point of REAL-NS j st p = f.<*1*> & ||.p.|| = ||.f.||;

theorem 
for f be Point of R_NormSpace_of_BoundedLinearOperators(REAL-NS 1,REAL-NS j),
    x be Point of REAL-NS 1 holds
  ||. f.x .|| = ||.f.|| * ||.x.||;

theorem 
for f be PartFunc of REAL m,REAL n, g be PartFunc of REAL-NS m,REAL-NS n,
    X be Subset of REAL m, Y be Subset of REAL-NS m st
  1 <= i & i <= m & X is open & g = f & X = Y &
  f is_partial_differentiable_on X,i
holds
   for x be Element of REAL m, y be Point of REAL-NS m st x in X & x = y
     holds partdiff(f,x,i) = partdiff(g,y,i).<*1*>;

theorem 
for f be PartFunc of REAL m,REAL n, g be PartFunc of REAL-NS m,REAL-NS n,
    X be Subset of REAL m, Y be Subset of REAL-NS m st
  1 <= i & i <= m & X is open & g = f & X = Y &
  f is_partial_differentiable_on X,i
holds
   for x0,x1 be Element of REAL m, y0,y1 be Point of REAL-NS m st
     x0 = y0 & x1 = y1 & x0 in X & x1 in X
     holds
       |. f`partial|(X,i)/.x1 - f`partial|(X,i)/.x0 .|
         = ||. (g`partial|(Y,i))/.y1 - (g`partial|(Y,i))/.y0 .||;

theorem 
for f be PartFunc of REAL m,REAL n, g be PartFunc of REAL-NS m,REAL-NS n,
    X be Subset of REAL m, Y be Subset of REAL-NS m
  st 1 <=i & i <= m & X is open & g = f & X = Y
 holds
   (f is_partial_differentiable_on X,i & f`partial|(X,i) is_continuous_on X)
     iff
   (g is_partial_differentiable_on Y,i & g`partial|(Y,i) is_continuous_on Y);

theorem 
for f be PartFunc of REAL m,REAL n, g be PartFunc of REAL-NS m,REAL-NS n,
    X be Subset of REAL m, Y be Subset of REAL-NS m
 st X = Y & X is open & f = g
 holds
  (for i st 1 <= i & i <= m holds
    f is_partial_differentiable_on X,i & f`partial|(X,i) is_continuous_on X)
 iff
  g is_differentiable_on Y & g`|Y is_continuous_on Y;

theorem 
for f be PartFunc of REAL m,REAL n, g be PartFunc of REAL-NS m,REAL-NS n,
    X be Subset of REAL m, Y be Subset of REAL-NS m st
  X is open & X c= dom f & g = f & X = Y
 holds
  (g is_differentiable_on Y & g`|Y is_continuous_on Y)
    iff
  (f is_differentiable_on X &
   for x0 be Element of REAL m,r be Real
    st x0 in X & 0 < r
     ex s be Real
      st 0 < s & for x1 be Element of REAL m
       st x1 in X & |. x1- x0 .| < s
        holds for v be Element of REAL m
         holds |. diff(f,x1).v - diff(f,x0).v.| <= r * |.v.|);

theorem 
for X be Subset of REAL m, f be PartFunc of REAL m,REAL n st
 X is open & X c= dom f holds
   (for i be Element of NAT st 1 <= i & i <= m holds
     f is_partial_differentiable_on X,i & f`partial|(X,i) is_continuous_on X)
  iff
   (f is_differentiable_on X &
    for x0 be Element of REAL m,r be Real st x0 in X & 0 < r
     ex s be Real st
      0 < s
      & for x1 be Element of REAL m st x1 in X & |. x1-x0 .| < s
         holds for v be Element of REAL m
          holds |. diff(f,x1).v  - diff(f,x0).v.| <= r * |.v.|);

theorem 
for f be PartFunc of REAL m,REAL n, g be PartFunc of REAL-NS m,REAL-NS n
  st f = g & f is_differentiable_on Z
    holds f`|Z = g`|Z;

theorem 
for f be PartFunc of REAL m,REAL n, g be PartFunc of REAL-NS m,REAL-NS n,
    X be Subset of REAL m, Y be Subset of REAL-NS m
 st X = Y & X is open & f = g
 holds
  (for i be Element of NAT st 1 <= i & i <= m holds
     f is_partial_differentiable_on X,i & f`partial|(X,i) is_continuous_on X )
 iff
  f is_differentiable_on X & g`|Y is_continuous_on Y;

theorem 
for f,g be PartFunc of REAL m,REAL n, x be Element of REAL m
 st f is_continuous_in x & g is_continuous_in x
 holds f+g is_continuous_in x & f-g is_continuous_in x;

theorem 
for f be PartFunc of REAL m,REAL n, x be Element of REAL m, r be Real
 st f is_continuous_in x holds r(#)f is_continuous_in x;

theorem 
for f be PartFunc of REAL m,REAL n, x be Element of REAL m
  st f is_continuous_in x holds -f is_continuous_in x;

theorem 
for f be PartFunc of REAL m,REAL n, x be Element of REAL m
  st f is_continuous_in x holds |.f.| is_continuous_in x;

theorem 
for Z be set, f,g be PartFunc of REAL m,REAL n
  st f is_continuous_on Z & g is_continuous_on Z
  holds f+g is_continuous_on Z & f-g is_continuous_on Z;

theorem 
for r be Real, f,g be PartFunc of REAL m,REAL n
  st f is_continuous_on Z holds r(#)f is_continuous_on Z;

theorem 
for f,g be PartFunc of REAL m,REAL n st
  f is_continuous_on Z holds -f is_continuous_on Z;

theorem 
for f be PartFunc of REAL i,REAL, x0 be Element of REAL i holds
  f is_continuous_in x0
    iff
 ( x0 in dom f &
   for r be Real st 0 < r
     ex s be Real st
       0 < s
     & for x be Element of REAL i st x in dom f & |. x-x0 .| < s
         holds |. f/.x - f/.x0 .| < r );

theorem 
for f be PartFunc of REAL m,REAL, x0 be Element of REAL m holds
  f is_continuous_in x0 iff <>*f is_continuous_in x0;

theorem 
for f,g be PartFunc of REAL m,REAL, x0 be Element of REAL m
 st f is_continuous_in x0 & g is_continuous_in x0
 holds f+g is_continuous_in x0 & f-g is_continuous_in x0;

theorem 
for f be PartFunc of REAL m,REAL, x0 be Element of REAL m, r be Real
 st f is_continuous_in x0 holds r(#)f is_continuous_in x0;

theorem 
for f be PartFunc of REAL m,REAL, x0 be Element of REAL m
 st f is_continuous_in x0 holds |.f.| is_continuous_in x0;

theorem 
for f,g be PartFunc of REAL i,REAL, x be Element of REAL i
 st f is_continuous_in x & g is_continuous_in x holds f(#)g is_continuous_in x;

definition
  let m be non empty Element of NAT;
  let Z be set;
  let f be PartFunc of REAL m,REAL;
  pred f is_continuous_on Z means

  for x0 be Element of REAL m st x0 in Z holds f|Z is_continuous_in x0;
end;

theorem 
for f be PartFunc of REAL m,REAL,
    g be PartFunc of REAL-NS m,REAL
 st f = g holds Z c= dom f & f is_continuous_on Z iff g is_continuous_on Z;

theorem 
for f be PartFunc of REAL m,REAL,
    g be PartFunc of REAL-NS m,REAL
 st f = g & Z c= dom f holds
   f is_continuous_on Z
 iff
   for s be sequence of REAL-NS m st rng s c= Z & s is convergent & lim s in Z
      holds g/*s is convergent & g/.(lim s) = lim (g/*s);

theorem 
for f be PartFunc of REAL m,REAL, g be PartFunc of REAL m,REAL 1
 st <>*f = g holds Z c= dom f & f is_continuous_on Z iff g is_continuous_on Z;

theorem 
for f be PartFunc of REAL m,REAL st Z c= dom f holds
   f is_continuous_on Z
 iff
  for x0 be Element of REAL m, r be Real st x0 in Z & 0 < r
     ex s be Real st 0 < s
     & for x1 be Element of REAL m st x1 in Z & |. x1- x0 .| < s
          holds |. f/.x1 - f/.x0 .| < r;

theorem 
for f,g be PartFunc of REAL m,REAL
  st f is_continuous_on Z & g is_continuous_on Z & Z c= dom f & Z c= dom g
  holds f+g is_continuous_on Z & f-g is_continuous_on Z;

theorem 
for f be PartFunc of REAL m,REAL, r be Real
  st Z c= dom f & f is_continuous_on Z holds r(#)f is_continuous_on Z;

theorem 
for f,g be PartFunc of REAL m,REAL
 st f is_continuous_on Z & g is_continuous_on Z & Z c= dom f & Z c= dom g
 holds f(#)g is_continuous_on Z;

theorem 
for f be PartFunc of REAL m,REAL, g be PartFunc of REAL-NS m,REAL
  st f=g holds Z c= dom f & f is_continuous_on Z iff g is_continuous_on Z;

theorem 
for f,g be PartFunc of REAL m,REAL n st
  f is_continuous_on Z holds |.f.| is_continuous_on Z;

theorem 
for f,g be PartFunc of REAL m,REAL, x be Element of REAL m
  st f is_differentiable_in x & g is_differentiable_in x
holds
  f+g is_differentiable_in x & diff(f+g,x) = diff(f,x) + diff(g,x)
& f-g is_differentiable_in x & diff(f-g,x) = diff(f,x) - diff(g,x);

theorem 
for f be PartFunc of REAL m,REAL, r be Real, x be Element of REAL m st
  f is_differentiable_in x holds
   r(#)f is_differentiable_in x & diff(r(#)f,x) = r(#)diff(f,x);

definition
  let Z be set;
  let m be non empty Element of NAT;
  let f be PartFunc of REAL m,REAL;
  pred f is_differentiable_on Z means

  for x be Element of REAL m st x in Z holds f|Z is_differentiable_in x;
end;

theorem 
for f be PartFunc of REAL m,REAL,
    g be PartFunc of REAL m,REAL 1 st <>*f = g holds
  Z c= dom f & f is_differentiable_on Z iff g is_differentiable_on Z;

theorem 
  for X be Subset of REAL m, f be PartFunc of REAL m,REAL st
  X c= dom f & X is open
holds
   f is_differentiable_on X
 iff
   for x be Element of REAL m st x in X holds f is_differentiable_in x;

theorem 
for X be Subset of REAL m, f be PartFunc of REAL m,REAL st
 X c= dom f & f is_differentiable_on X holds X is open;

definition
  let m be non empty Element of NAT;
  let Z be set;
  let f be PartFunc of REAL m,REAL;
  assume  Z c= dom f;
  func f`|Z -> PartFunc of REAL m, Funcs(REAL m,REAL) means

  dom it = Z & for x be Element of REAL m st x in Z holds it/.x = diff(f,x);
end;

theorem 
for X be Subset of REAL m,
  f be PartFunc of REAL m,REAL, g be PartFunc of REAL m,REAL 1 st
 <>*f = g & X c= dom f & f is_differentiable_on X
  holds g is_differentiable_on X
    & for x be Element of REAL m st x in X
        holds ((f`|X)/.x) = proj(1,1)*((g`|X)/.x);

theorem 
for X be Subset of REAL m, f,g be PartFunc of REAL m,REAL
  st X c= dom f & X c= dom g &
  f is_differentiable_on X & g is_differentiable_on X
 holds
  f+g is_differentiable_on X
& for x be Element of REAL m st x in X
    holds ((f+g)`|X)/.x = (f`|X)/.x + (g`|X)/.x;

theorem 
for X be Subset of REAL m, f,g be PartFunc of REAL m,REAL st
  X c= dom f & X c= dom g &
  f is_differentiable_on X & g is_differentiable_on X
holds
  f-g is_differentiable_on X
& for x be Element of REAL m st x in X
    holds ((f-g)`|X)/.x = (f`|X)/.x - (g`|X)/.x;

theorem 
for X be Subset of REAL m, f be PartFunc of REAL m,REAL, r be Real st
  X c= dom f & f is_differentiable_on X
holds
  r(#)f is_differentiable_on X
& for x be Element of REAL m st x in X
    holds ((r(#)f)`|X)/.x = r(#)((f`|X)/.x);

definition
  let m be non empty Element of NAT;
  let Z be set;
  let i be Element of NAT;
  let f be PartFunc of REAL m,REAL;
pred f is_partial_differentiable_on Z,i means

  Z c=dom f
& for x be Element of REAL m st x in Z
    holds f|Z is_partial_differentiable_in x,i;
end;

definition
  let m be non empty Element of NAT;
  let Z be set;
  let i be Element of NAT;
  let f be PartFunc of REAL m,REAL;
  assume f is_partial_differentiable_on Z,i;
func f `partial|(Z,i) -> PartFunc of REAL m,REAL means

  dom it = Z
& for x be Element of REAL m st x in Z holds it/.x = partdiff(f,x,i);
end;

theorem 
for X be Subset of REAL m, f be PartFunc of REAL m,REAL st
 X is open & 1 <= i & i <= m holds
  ( f is_partial_differentiable_on X,i
     iff
    X c=dom f &
    for x be Element of REAL m st x in X holds
     f is_partial_differentiable_in x,i );

theorem 
for X be Subset of REAL m,
    f be PartFunc of REAL m,REAL, g be PartFunc of REAL m,REAL 1 st
 <>*f = g & X is open & 1 <= i & i <= m holds
  f is_partial_differentiable_on X,i iff g is_partial_differentiable_on X,i;

theorem 
for X be Subset of REAL m,
    f be PartFunc of REAL m,REAL, g be PartFunc of REAL m,REAL 1 st
<>*f = g & X is open & 1<=i & i<=m & f is_partial_differentiable_on X,i holds
  f`partial|(X,i) is_continuous_on X iff g`partial|(X,i) is_continuous_on X;

theorem 
for X be Subset of REAL m, f be PartFunc of REAL m,REAL st
 X is open & X c= dom f holds
  ( ( for i be Element of NAT st 1 <= i & i <= m holds
     f is_partial_differentiable_on X,i &
     f`partial|(X,i) is_continuous_on X )
        iff
    ( f is_differentiable_on X
    & for x0 be Element of REAL m,r be Real st x0 in X & 0 < r
       ex s be Real st
         0 < s
       & for x1 be Element of REAL m st x1 in X & |. x1- x0 .| < s holds
          for v be Element of REAL m
            holds |. diff(f,x1).v - diff(f,x0).v.| <= r * |.v.| ) );

theorem 
for f,g be PartFunc of REAL m,REAL, x be Element of REAL m
 st f is_partial_differentiable_in x,i
  & g is_partial_differentiable_in x,i
holds
   f(#)g is_partial_differentiable_in x,i
 & partdiff(f(#)g,x,i) = partdiff(f,x,i)*(g.x) +(f.x)*partdiff(g,x,i);

theorem 
for X be Subset of REAL m, f,g be PartFunc of REAL m,REAL st
 X is open & 1 <= i & i <= m
  & f is_partial_differentiable_on X,i & g is_partial_differentiable_on X,i
 holds
   (f+g) is_partial_differentiable_on X,i
 & (f+g)`partial|(X,i) = f`partial|(X,i) + g`partial|(X,i)
 & for x be Element of REAL m st x in X holds
     (f+g)`partial|(X,i)/.x = partdiff(f,x,i) + partdiff(g,x,i);

theorem 
for X be Subset of REAL m, f,g be PartFunc of REAL m,REAL st
   X is open & 1 <= i & i <= m
 & f is_partial_differentiable_on X,i
 & g is_partial_differentiable_on X,i
holds
   f-g is_partial_differentiable_on X,i
 & (f-g)`partial|(X,i) = f`partial|(X,i) - g`partial|(X,i)
 & for x be Element of REAL m st x in X holds
    (f-g)`partial|(X,i)/.x = partdiff(f,x,i) - partdiff(g,x,i);

theorem 
for X be Subset of REAL m, r be Real, f be PartFunc of REAL m,REAL st
  X is open & 1 <= i & i <= m & f is_partial_differentiable_on X,i
holds
   r(#)f is_partial_differentiable_on X,i
 & (r(#)f) `partial|(X,i) = r(#)(f`partial|(X,i))
 & for x be Element of REAL m st x in X holds
    (r(#)f)`partial|(X,i)/.x = r*partdiff(f,x,i);

theorem 
for X be Subset of REAL m, f,g be PartFunc of REAL m,REAL st
  X is open & 1 <= i & i <= m
  & f is_partial_differentiable_on X,i & g is_partial_differentiable_on X,i
holds
    f(#)g is_partial_differentiable_on X,i
  & (f(#)g)`partial|(X,i) =(f`partial|(X,i))(#)g + f(#)(g`partial|(X,i))
  & for x be Element of REAL m st x in X holds
     (f(#)g)`partial|(X,i)/.x = partdiff(f,x,i)*(g.x) + (f.x)* partdiff(g,x,i);

begin 

definition
 let m be non empty Element of NAT, Z be set, I be FinSequence of NAT,
     f be PartFunc of REAL m,REAL;
func PartDiffSeq(f,Z,I) -> Functional_Sequence of REAL m,REAL means

   it.0 = f
 & for i be natural number holds it.(i+1) = (it.i)`partial|(Z,I/.(i+1));
end;

definition
  let m be non empty Element of NAT;
  let Z be set, I be FinSequence of NAT;
  let f be PartFunc of REAL m,REAL;
pred f is_partial_differentiable_on Z,I means

  for i be Element of NAT st i <= (len I)-1
    holds (PartDiffSeq(f,Z,I)).i is_partial_differentiable_on Z,I/.(i+1);
end;

definition
  let m be non empty Element of NAT;
  let Z be set, I be FinSequence of NAT;
  let f be PartFunc of REAL m,REAL;
func f`partial|(Z,I) -> PartFunc of REAL m,REAL equals

   (PartDiffSeq(f,Z,I)).(len I);
end;

theorem 
for X be Subset of REAL m, I be non empty FinSequence of NAT,
    f,g be PartFunc of REAL m,REAL st
  X is open & rng I c= Seg m & f is_partial_differentiable_on X,I
  & g is_partial_differentiable_on X,I
holds
 for i st i <= (len I) - 1 holds
   (PartDiffSeq(f+g,X,I)).i is_partial_differentiable_on X,I/.(i+1)
 & (PartDiffSeq(f+g,X,I)).i = PartDiffSeq(f,X,I).i + PartDiffSeq(g,X,I).i;

theorem 
for X be Subset of REAL m, I be non empty FinSequence of NAT,
    f,g be PartFunc of REAL m,REAL st
  X is open & rng I c= Seg m
  & f is_partial_differentiable_on X,I
  & g is_partial_differentiable_on X,I
holds
    f+g is_partial_differentiable_on X,I
  & (f+g)`partial|(X,I) = f`partial|(X,I) + g`partial|(X,I);

theorem 
for X be Subset of REAL m, I be non empty FinSequence of NAT,
    f,g be PartFunc of REAL m,REAL st
  X is open & rng I c= Seg m
  & f is_partial_differentiable_on X,I
  & g is_partial_differentiable_on X,I
holds
  for i st i <= (len I)-1 holds
   (PartDiffSeq(f-g,X,I)).i is_partial_differentiable_on X,I/.(i+1)
 & (PartDiffSeq(f-g,X,I)).i = (PartDiffSeq(f,X,I).i)-(PartDiffSeq(g,X,I).i);

theorem 
for X be Subset of REAL m, I be non empty FinSequence of NAT,
    f,g be PartFunc of REAL m,REAL st
   X is open & rng I c= Seg m
   & f is_partial_differentiable_on X,I
   & g is_partial_differentiable_on X,I
holds
    f-g is_partial_differentiable_on X,I
  & (f-g)`partial|(X,I) = f`partial|(X,I) - g`partial|(X,I);

theorem 
for X be Subset of REAL m, r be Real, I be non empty FinSequence of NAT,
    f be PartFunc of REAL m,REAL st
  X is open & rng I c= Seg m & f is_partial_differentiable_on X,I
holds
   for i st i <= (len I)-1 holds
     (PartDiffSeq(r(#)f,X,I)).i is_partial_differentiable_on X,I/.(i+1)
   & (PartDiffSeq(r(#)f,X,I)).i = r(#)(PartDiffSeq(f,X,I).i);

theorem 
for X be Subset of REAL m, r be Real, I be non empty FinSequence of NAT,
    f be PartFunc of REAL m,REAL st
  X is open & rng I c= Seg m & f is_partial_differentiable_on X,I
holds
   r(#)f is_partial_differentiable_on X,I
 & (r(#)f)`partial|(X,I) = r(#)(f`partial|(X,I));

definition
  let m be non empty Element of NAT;
  let f be PartFunc of REAL m,REAL;
  let k be Element of NAT;
  let Z be set;
  pred f is_partial_differentiable_up_to_order k,Z means

  for I be non empty FinSequence of NAT st len I <= k & rng I c= Seg m
  holds f is_partial_differentiable_on Z,I;
end;

theorem 
for f be PartFunc of REAL m,REAL,
    I,G be non empty FinSequence of NAT
 holds f is_partial_differentiable_on Z,G^I
   iff f is_partial_differentiable_on Z,G
     & f`partial|(Z,G) is_partial_differentiable_on Z,I;

theorem 
for f be PartFunc of REAL m,REAL holds
 f is_partial_differentiable_on Z,<*i*> iff f is_partial_differentiable_on Z,i;

theorem 
for f be PartFunc of REAL m,REAL holds f`partial|(Z,<*i*>) = f`partial|(Z,i);

theorem 
for f be PartFunc of REAL m,REAL,
    I be non empty FinSequence of NAT
 st f is_partial_differentiable_up_to_order (i+j),Z
  & rng I c= Seg m & len I = j
holds
  f`partial|(Z,I) is_partial_differentiable_up_to_order i,Z;

theorem 
for f be PartFunc of REAL m,REAL
  st f is_partial_differentiable_up_to_order i,Z & j <= i
holds f is_partial_differentiable_up_to_order j,Z;

theorem 
for X be Subset of REAL m, f,g be PartFunc of REAL m,REAL
 st X is open & f is_partial_differentiable_up_to_order i,X
  & g is_partial_differentiable_up_to_order i,X
holds f+g is_partial_differentiable_up_to_order i,X
    & f-g is_partial_differentiable_up_to_order i,X;

theorem 
for X be Subset of REAL m, f be PartFunc of REAL m,REAL, r be Real
  st X is open & f is_partial_differentiable_up_to_order i,X
 holds r(#)f is_partial_differentiable_up_to_order i,X;

theorem 
for X be Subset of REAL m st X is open holds
 for i be Element of NAT, f,g be PartFunc of REAL m,REAL
  st f is_partial_differentiable_up_to_order i,X
   & g is_partial_differentiable_up_to_order i,X
 holds f(#)g is_partial_differentiable_up_to_order i,X;














begin 

reserve D for non empty set;
reserve s for FinSequence of D;
reserve m,n for Element of NAT;

registration
  let n be Nat, f be n-element FinSequence;
  cluster Rev f -> n-element;
end;

definition
  let D be non empty set, n be Nat, f be Element of n-tuples_on D;
  redefine func Rev f -> Element of n-tuples_on D;
end;

notation
  let n be Nat, f be FinSequence;
  synonym Op-Left(f,n) for f|n;
  synonym Op-Right(f,n) for f/^n;
end;

definition
  let D be non empty set, n be Nat, f be FinSequence of D;
  redefine func Op-Left(f,n) -> FinSequence of D;
  redefine func Op-Right(f,n) -> FinSequence of D;
end;

notation
  let D be non empty set, n be Nat, s be Element of (2*n)-tuples_on D;
  synonym SP-Left(s) for Op-Left(s,n);
  synonym SP-Right(s) for Op-Right(s,n);
end;

definition
  let D be non empty set, n be Nat, s be Element of (2*n)-tuples_on D;
  redefine func SP-Left(s) -> Element of n-tuples_on D;
end;

theorem 
  for m,n be non empty Element of NAT, s be Element of n-tuples_on D
  st m <= n
  holds Op-Left(s,m) is Element of m-tuples_on D;

theorem 
  for m,n,l be non empty Element of NAT,
  s be Element of n-tuples_on D
  st m <= n & l= n - m
  holds (Op-Right(s,m)) is Element of l-tuples_on D;

definition
  let D be non empty set,n be non empty Element of NAT,
  s be Element of (2*n)-tuples_on D;
  redefine func SP-Right(s) -> Element of n-tuples_on D;
end;

theorem 
  for n be non empty Element of NAT,
  s be Element of (2*n)-tuples_on D holds
  (SP-Left(s))^( SP-Right(s)) = s;

definition
  let s be FinSequence;
  func Op-LeftShift(s) -> FinSequence equals

  (s /^1) ^ <* s.1 *>;
end;

theorem 
  for s be FinSequence st 1 <= len s
  holds len (Op-LeftShift(s)) = len s;

theorem 
  1 <= len s implies
  Op-LeftShift(s) is FinSequence of D &
  len (Op-LeftShift(s)) = len s;

theorem 
  for n be non empty Element of NAT,
  s be Element of n-tuples_on D
  holds (Op-LeftShift(s)) is Element of n-tuples_on D;

definition
  let s be FinSequence;
  func Op-RightShift(s) -> FinSequence equals

  (<* s.(len s) *> ^ s )| len s;
end;

theorem 
  for s be FinSequence holds len (Op-RightShift(s)) = len s;

theorem 
  1 <= len s implies
  Op-RightShift(s) is FinSequence of D &
  len (Op-RightShift(s)) = len s;

theorem 
  for n be non empty Element of NAT,
  s be Element of n-tuples_on D
  holds (Op-RightShift(s)) is Element of n-tuples_on D;

definition
  let D be non empty set;
  let s be FinSequence of D,n be Integer;
  assume  1 <= len s;
  func Op-Shift(s,n) -> FinSequence of D means


  len it = len s &
  for i be Nat st i in Seg (len s)
  holds it.i = s.(( (i-1+n) mod (len s) ) + 1);
end;

theorem 
  for n,m be Integer
  st 1 <= len s holds
  Op-Shift(Op-Shift(s,n),m)= Op-Shift(s,n+m);

theorem 
  1 <= len s implies Op-Shift(s,0)= s;

theorem 
  1 <= len s implies Op-Shift(s,len s)= s;

theorem 
  1 <= len s implies Op-Shift(s,-(len s ))= s;

theorem 
  for n be non empty Element of NAT,
  m be Integer,
  s be Element of n-tuples_on D
  holds Op-Shift(s,m) is Element of n-tuples_on D;

theorem 
  1 <= len s implies Op-Shift(s,-1)= Op-RightShift(s);

theorem 
  1 <= len s implies Op-Shift(s,1)= Op-LeftShift(s);

definition
  let x,y be Element of 28-tuples_on BOOLEAN;
  redefine func x^y -> Element of 56-tuples_on BOOLEAN;
end;

definition
  let n be non empty Element of NAT;
  let s be Element of n-tuples_on BOOLEAN;
  let i be Nat;
  redefine func s.i -> Element of BOOLEAN;
end;

definition
  let n be non empty Element of NAT;
  let s be Element of n-tuples_on NAT;
  let i be Nat;
  redefine func s.i -> Element of NAT;
end;

registration
  let n be Nat;
  cluster -> boolean-valued for Element of n-tuples_on BOOLEAN;
end;

notation
  let n be Element of NAT;
  let s,t be Element of n-tuples_on BOOLEAN;
  synonym Op-XOR(s,t) for s 'xor' t;
end;

definition
  let n be non empty Element of NAT;
  let s,t be Element of n-tuples_on BOOLEAN;
  redefine func Op-XOR(s,t) -> Element of n-tuples_on BOOLEAN means


  for i be Nat st i in Seg n holds it.i = s.i 'xor' t.i;
  commutativity;
end;

definition
  let n,k be non empty Element of NAT,
  RK be Element of k-tuples_on (n-tuples_on BOOLEAN);
  let i be Element of Seg k;
  redefine func RK.i -> Element of n-tuples_on BOOLEAN;
end;

theorem 
  for n be non empty Element of NAT,
  s,t be Element of n-tuples_on BOOLEAN
  holds Op-XOR(Op-XOR(s,t),t) = s;

definition
  let m be non empty Element of NAT;
  let D be non empty set;
  let L be sequence of (m-tuples_on D );
  let i be Nat;
  redefine func L.i -> Element of m-tuples_on D;
end;

definition
  let f be Function of 64,16;
  let i be set;
  redefine func f.i -> Element of 16;
end;

theorem 
  for n,m be Nat st n+m <= len s holds
  (s|n)^((s/^n)|m) = s|(n+m);

scheme 

  QuadChoiceRec { A, B,C,D() -> non empty set,
  A0() -> Element of A(), B0() -> Element of B(),
  C0() -> Element of C(), D0() -> Element of D(),
  P[set,set,set,set,set,set,set,set,set] }:
  ex f being Function of NAT, A(), g being Function of NAT, B(),
  h being Function of NAT, C(), i being Function of NAT, D()
  st f.0 = A0() & g.0 = B0() &h.0 = C0() & i.0 = D0()
  & for n being Element of
  NAT holds P[n,f.n,g.n,h.n,i.n,f.(n+1),g.(n+1),h.(n+1),i.(n+1)]
  provided
   for n being Element of NAT, x being Element of A(), y being Element
  of B() , z being Element of C(),w being Element of D()
  ex x1 being Element of A(), y1 being Element of B(),
  z1 being Element of C(), w1 being Element of D()
  st P[n,x,y,z,w,x1,y1,z1,w1];

theorem 
  for x be set st x in Seg 16 holds
  x=1 or x=2 or x=3 or x=4 or x=5 or x=6 or x=7 or x=8
  or x=9 or x=10 or x=11 or x=12 or x=13 or x=14 or x=15 or x=16;

theorem 
  for x be set st x in Seg 32 holds
  x=1 or x=2 or x=3 or x=4 or x=5 or x=6 or x=7 or x=8
  or x=9 or x=10 or x=11 or x=12 or x=13 or x=14 or x=15 or x=16
  or x=17 or x=18 or x=19 or x=20 or x=21 or x=22 or x=23 or x=24
  or x=25 or x=26 or x=27 or x=28 or x=29 or x=30 or x=31 or x=32;

theorem 
  for x be set st x in Seg 48 holds
  x=1 or x=2 or x=3 or x=4 or x=5 or x=6 or x=7 or x=8
  or x=9 or x=10 or x=11 or x=12 or x=13 or x=14 or x=15 or x=16
  or x=17 or x=18 or x=19 or x=20 or x=21 or x=22 or x=23 or x=24
  or x=25 or x=26 or x=27 or x=28 or x=29 or x=30 or x=31 or x=32
  or x=33 or x=34 or x=35 or x=36 or x=37 or x=38 or x=39 or x=40
  or x=41 or x=42 or x=43 or x=44 or x=45 or x=46 or x=47 or x=48;

theorem 
  for x be set st x in Seg 56 holds
  x=1 or x=2 or x=3 or x=4 or x=5 or x=6 or x=7 or x=8
  or x=9 or x=10 or x=11 or x=12 or x=13 or x=14 or x=15 or x=16
  or x=17 or x=18 or x=19 or x=20 or x=21 or x=22 or x=23 or x=24
  or x=25 or x=26 or x=27 or x=28 or x=29 or x=30 or x=31 or x=32
  or x=33 or x=34 or x=35 or x=36 or x=37 or x=38 or x=39 or x=40
  or x=41 or x=42 or x=43 or x=44 or x=45 or x=46 or x=47 or x=48
  or x=49 or x=50 or x=51 or x=52 or x=53 or x=54 or x=55 or x=56;

theorem 
  for x be set st x in Seg 64 holds
  x=1 or x=2 or x=3 or x=4 or x=5 or x=6 or x=7 or x=8
  or x=9 or x=10 or x=11 or x=12 or x=13 or x=14 or x=15 or x=16
  or x=17 or x=18 or x=19 or x=20 or x=21 or x=22 or x=23 or x=24
  or x=25 or x=26 or x=27 or x=28 or x=29 or x=30 or x=31 or x=32
  or x=33 or x=34 or x=35 or x=36 or x=37 or x=38 or x=39 or x=40
  or x=41 or x=42 or x=43 or x=44 or x=45 or x=46 or x=47 or x=48
  or x=49 or x=50 or x=51 or x=52 or x=53 or x=54 or x=55 or x=56
  or x=57 or x=58 or x=59 or x=60 or x=61 or x=62 or x=63 or x=64;

theorem 
  for n be non empty Nat holds n = {0} \/ ((Seg n) \ {n});

theorem 
  for n be non empty Nat,x be set st x in n holds
  x = 0 or x in Seg n & x <> n;

theorem 
  for x be set st x in 16 holds
  x=0 or x=1 or x=2 or x=3 or x=4 or x=5 or x=6 or x=7 or
  x=8 or x=9 or x=10 or x=11 or x=12 or x=13 or x=14 or x=15;

theorem 
  for x be set st x in 64 holds
  x=0 or x=1 or x=2 or x=3 or x=4 or x=5 or x=6 or
  x=7 or x=8 or x=9 or x=10 or x=11 or x=12 or
  x=13 or x=14 or x=15 or x=16 or x=17 or x=18 or
  x=19 or x=20 or x=21 or x=22 or x=23 or x=24 or
  x=25 or x=26 or x=27 or x=28 or x=29 or x=30 or
  x=31 or x=32 or x=33 or x=34 or x=35 or x=36 or
  x=37 or x=38 or x=39 or x=40 or x=41 or x=42 or
  x=43 or x=44 or x=45 or x=46 or x=47 or x=48 or
  x=49 or x=50 or x=51 or x=52 or x=53 or x=54 or
  x=55 or x=56 or x=57 or x=58 or x=59 or x=60 or
  x=61 or x=62 or x=63;

theorem 
  for S be non empty set,
  x1,x2,x3,x4,x5,x6,x7,x8 be Element of S holds
  ex s be FinSequence of S st
  s is 8-element &
  s.1=x1&s.2=x2&s.3=x3&s.4=x4&
  s.5=x5&s.6=x6&s.7=x7&s.8=x8;

theorem 
  for S be non empty set,
  x1,x2,x3,x4,x5,x6,x7,x8,
  x9,x10,x11,x12,x13,x14,x15,x16
  be Element of S holds
  ex s be FinSequence of S st
  s is 16-element &
  s.1=x1&s.2=x2&s.3=x3&s.4=x4&
  s.5=x5&s.6=x6&s.7=x7&s.8=x8&
  s.9=x9&s.10=x10&s.11=x11&s.12=x12&
  s.13=x13&s.14=x14&s.15=x15&s.16=x16;

theorem 
  for S be non empty set,
  x1,x2,x3,x4,x5,x6,x7,x8,
  x9,x10,x11,x12,x13,x14,x15,x16,
  x17,x18,x19,x20,x21,x22,x23,x24,
  x25,x26,x27,x28,x29,x30,x31,x32
  be Element of S holds
  ex s be FinSequence of S st
  s is 32-element &
  s.1=x1&s.2=x2&s.3=x3&s.4=x4&
  s.5=x5&s.6=x6&s.7=x7&s.8=x8&
  s.9=x9&s.10=x10&s.11=x11&s.12=x12&
  s.13=x13&s.14=x14&s.15=x15&s.16=x16 &
  s.17=x17&s.18=x18&s.19=x19&s.20=x20&
  s.21=x21&s.22=x22&s.23=x23&s.24=x24&
  s.25=x25&s.26=x26&s.27=x27&s.28=x28&
  s.29=x29&s.30=x30&s.31=x31&s.32=x32;

theorem 
  for S be non empty set,
  x1,x2,x3,x4,x5,x6,x7,x8,
  x9,x10,x11,x12,x13,x14,x15,x16,
  x17,x18,x19,x20,x21,x22,x23,x24,
  x25,x26,x27,x28,x29,x30,x31,x32,
  x33,x34,x35,x36,x37,x38,x39,x40,
  x41,x42,x43,x44,x45,x46,x47,x48
  be Element of S holds
  ex s be FinSequence of S st
  s is 48-element &
  s.1=x1&s.2=x2&s.3=x3&s.4=x4&
  s.5=x5&s.6=x6&s.7=x7&s.8=x8&
  s.9=x9&s.10=x10&s.11=x11&s.12=x12&
  s.13=x13&s.14=x14&s.15=x15&s.16=x16 &
  s.17=x17&s.18=x18&s.19=x19&s.20=x20&
  s.21=x21&s.22=x22&s.23=x23&s.24=x24&
  s.25=x25&s.26=x26&s.27=x27&s.28=x28&
  s.29=x29&s.30=x30&s.31=x31&s.32=x32&
  s.33=x33&s.34=x34&s.35=x35&s.36=x36&
  s.37=x37&s.38=x38&s.39=x39&s.40=x40&
  s.41=x41&s.42=x42&s.43=x43&s.44=x44&
  s.45=x45&s.46=x46&s.47=x47&s.48=x48;

theorem 
  for S be non empty set,
  x1,x2,x3,x4,x5,x6,x7,x8,
  x9,x10,x11,x12,x13,x14,x15,x16,
  x17,x18,x19,x20,x21,x22,x23,x24,
  x25,x26,x27,x28,x29,x30,x31,x32,
  x33,x34,x35,x36,x37,x38,x39,x40,
  x41,x42,x43,x44,x45,x46,x47,x48,
  x49,x50,x51,x52,x53,x54,x55,x56 be Element of S holds
  ex s be FinSequence of S st
  s is 56-element &
  s.1=x1&s.2=x2&s.3=x3&s.4=x4&
  s.5=x5&s.6=x6&s.7=x7&s.8=x8&
  s.9=x9&s.10=x10&s.11=x11&s.12=x12&
  s.13=x13&s.14=x14&s.15=x15&s.16=x16 &
  s.17=x17&s.18=x18&s.19=x19&s.20=x20&
  s.21=x21&s.22=x22&s.23=x23&s.24=x24&
  s.25=x25&s.26=x26&s.27=x27&s.28=x28&
  s.29=x29&s.30=x30&s.31=x31&s.32=x32&
  s.33=x33&s.34=x34&s.35=x35&s.36=x36&
  s.37=x37&s.38=x38&s.39=x39&s.40=x40&
  s.41=x41&s.42=x42&s.43=x43&s.44=x44&
  s.45=x45&s.46=x46&s.47=x47&s.48=x48&
  s.49=x49&s.50=x50&s.51=x51&s.52=x52&
  s.53=x53&s.54=x54&s.55=x55&s.56=x56;

theorem 
  for S be non empty set,
  x1,x2,x3,x4,x5,x6,x7,x8,
  x9,x10,x11,x12,x13,x14,x15,x16,
  x17,x18,x19,x20,x21,x22,x23,x24,
  x25,x26,x27,x28,x29,x30,x31,x32,
  x33,x34,x35,x36,x37,x38,x39,x40,
  x41,x42,x43,x44,x45,x46,x47,x48,
  x49,x50,x51,x52,x53,x54,x55,x56,
  x57,x58,x59,x60,x61,x62,x63,x64 be Element of S holds
  ex s be FinSequence of S st
  s is 64-element &
  s.1=x1&s.2=x2&s.3=x3&s.4=x4&
  s.5=x5&s.6=x6&s.7=x7&s.8=x8&
  s.9=x9&s.10=x10&s.11=x11&s.12=x12&
  s.13=x13&s.14=x14&s.15=x15&s.16=x16 &
  s.17=x17&s.18=x18&s.19=x19&s.20=x20&
  s.21=x21&s.22=x22&s.23=x23&s.24=x24&
  s.25=x25&s.26=x26&s.27=x27&s.28=x28&
  s.29=x29&s.30=x30&s.31=x31&s.32=x32&
  s.33=x33&s.34=x34&s.35=x35&s.36=x36&
  s.37=x37&s.38=x38&s.39=x39&s.40=x40&
  s.41=x41&s.42=x42&s.43=x43&s.44=x44&
  s.45=x45&s.46=x46&s.47=x47&s.48=x48&
  s.49=x49&s.50=x50&s.51=x51&s.52=x52&
  s.53=x53&s.54=x54&s.55=x55&s.56=x56&
  s.57=x57&s.58=x58&s.59=x59&s.60=x60&
  s.61=x61&s.62=x62&s.63=x63&s.64=x64;

notation
  let n be non empty Nat, i be Element of n;
  synonym ntoSeg(i) for succ(i);
end;

definition
  let n be non empty Nat,
  i be Element of n;
  redefine func ntoSeg(i) -> Element of Seg n;
end;

definition
  let n be non empty Nat,
  f be Function of n, Seg n;
  attr f is NtoSEG means


  for i be Element of n holds f.i=ntoSeg(i);
end;

registration
  let n be non empty Nat;
  cluster NtoSEG for Function of n, Seg n;
end;

registration
  let n be non empty Nat;
  cluster -> bijective for NtoSEG Function of n, Seg n;
end;

theorem 
  for n be non empty Nat,
  f be NtoSEG Function of n, Seg n,
  i be Nat st i < n holds f.i=i+1 & i in dom f;

theorem 
  for S be non empty set,
  x1,x2,x3,x4,x5,x6,x7,x8,
  x9,x10,x11,x12,x13,x14,x15,x16,
  x17,x18,x19,x20,x21,x22,x23,x24,
  x25,x26,x27,x28,x29,x30,x31,x32,
  x33,x34,x35,x36,x37,x38,x39,x40,
  x41,x42,x43,x44,x45,x46,x47,x48,
  x49,x50,x51,x52,x53,x54,x55,x56,
  x57,x58,x59,x60,x61,x62,x63,x64 be Element of S holds
  ex f be Function of 64, S st
  f.0=x1&f.1=x2&f.2=x3&f.3=x4&
  f.4=x5&f.5=x6&f.6=x7&f.7=x8&
  f.8=x9&f.9=x10&f.10=x11&f.11=x12&
  f.12=x13&f.13=x14&f.14=x15&f.15=x16&
  f.16=x17&f.17=x18&f.18=x19&f.19=x20&
  f.20=x21&f.21=x22&f.22=x23&f.23=x24&
  f.24=x25&f.25=x26&f.26=x27&f.27=x28&
  f.28=x29&f.29=x30&f.30=x31&f.31=x32&
  f.32=x33&f.33=x34&f.34=x35&f.35=x36&
  f.36=x37&f.37=x38&f.38=x39&f.39=x40&
  f.40=x41&f.41=x42&f.42=x43&f.43=x44&
  f.44=x45&f.45=x46&f.46=x47&f.47=x48&
  f.48=x49&f.49=x50&f.50=x51&f.51=x52&
  f.52=x53&f.53=x54&f.54=x55&f.55=x56&
  f.56=x57&f.57=x58&f.58=x59&f.59=x60&
  f.60=x61&f.61=x62&f.62=x63&f.63=x64;

begin 

definition
  func DES-SBOX1 -> Function of 64,16 means

  it.0 = 14 & it.1 = 4 & it.2 = 13 & it.3 = 1 & it.4 = 2 &
  it.5 = 15 & it.6 = 11 & it.7 = 8 & it.8 = 3 & it.9 = 10 &
  it.10 = 6 & it.11 = 12 & it.12 = 5 & it.13 = 9 & it.14 = 0 &
  it.15 = 7 & it.16 = 0 & it.17 = 15 & it.18 = 7 & it.19 = 4 &
  it.20 = 14 & it.21 = 2 & it.22 = 13 & it.23 = 1 & it.24 = 10 &
  it.25 = 6 & it.26 = 12 & it.27 = 11 & it.28 = 9 & it.29 = 5 &
  it.30 = 3 & it.31 = 8 & it.32 = 4 & it.33 = 1 & it.34 = 14 &
  it.35 = 8 & it.36 = 13 & it.37 = 6 & it.38 = 2 & it.39 = 11 &
  it.40 = 15 & it.41 = 12 & it.42 = 9 & it.43 = 7 & it.44 = 3 &
  it.45 = 10 & it.46 = 5 & it.47 = 0 & it.48 = 15 & it.49 = 12 &
  it.50 = 8 & it.51 = 2 & it.52 = 4 & it.53 = 9 & it.54 = 1 &
  it.55 = 7 & it.56 = 5 & it.57 = 11 & it.58 = 3 & it.59 = 14 &
  it.60 = 10 & it.61 = 0 & it.62 = 6 & it.63 = 13;
end;

definition
  func DES-SBOX2 -> Function of 64,16 means

  it.0 = 15 & it.1 = 1 & it.2 = 8 & it.3 = 14 & it.4 = 6 &
  it.5 = 11 & it.6 = 3 & it.7 = 4 & it.8 = 9 & it.9 = 7 &
  it.10 = 2 & it.11 = 13 & it.12 = 12 & it.13 = 0 & it.14 = 5 &
  it.15 = 10 & it.16 = 3 & it.17 = 13 & it.18 = 4 & it.19 = 7 &
  it.20 = 15 & it.21 = 2 & it.22 = 8 & it.23 = 14 & it.24 = 12 &
  it.25 = 0 & it.26 = 1 & it.27 = 10 & it.28 = 6 & it.29 = 9 &
  it.30 = 11 & it.31 = 5 & it.32 = 0 & it.33 = 14 & it.34 = 7 &
  it.35 = 11 & it.36 = 10 & it.37 = 4 & it.38 = 13 & it.39 = 1 &
  it.40 = 5 & it.41 = 8 & it.42 = 12 & it.43 = 6 & it.44 = 9 &
  it.45 = 3 & it.46 = 2 & it.47 = 15 & it.48 = 13 & it.49 = 8 &
  it.50 = 10 & it.51 = 1 & it.52 = 3 & it.53 = 15 & it.54 = 4 &
  it.55 = 2 & it.56 = 11 & it.57 = 6 & it.58 = 7 & it.59 = 12 &
  it.60 = 0 & it.61 = 5 & it.62 = 14 & it.63 = 9;
end;

definition
  func DES-SBOX3 -> Function of 64,16 means

  it.0 = 10 & it.1 = 0 & it.2 = 9 & it.3 = 14 & it.4 = 6 &
  it.5 = 3 & it.6 = 15 & it.7 = 5 & it.8 = 1 & it.9 = 13 &
  it.10 = 12 & it.11 = 7 & it.12 = 11 & it.13 = 4 & it.14 = 2 &
  it.15 = 8 & it.16 = 13 & it.17 = 7 & it.18 = 0 & it.19 = 9 &
  it.20 = 3 & it.21 = 4 & it.22 = 6 & it.23 = 10 & it.24 = 2 &
  it.25 = 8 & it.26 = 5 & it.27 = 14 & it.28 = 12 & it.29 = 11 &
  it.30 = 15 & it.31 = 1 & it.32 = 13 & it.33 = 6 & it.34 = 4 &
  it.35 = 9 & it.36 = 8 & it.37 = 15 & it.38 = 3 & it.39 = 0 &
  it.40 = 11 & it.41 = 1 & it.42 = 2 & it.43 = 12 & it.44 = 5 &
  it.45 = 10 & it.46 = 14 & it.47 = 7 & it.48 = 1 & it.49 = 10 &
  it.50 = 13 & it.51 = 0 & it.52 = 6 & it.53 = 9 & it.54 = 8 &
  it.55 = 7 & it.56 = 4 & it.57 = 15 & it.58 = 14 & it.59 = 3 &
  it.60 = 11 & it.61 = 5 & it.62 = 2 & it.63 = 12;
end;

definition
  func DES-SBOX4 -> Function of 64,16 means

  it.0 = 7 & it.1 = 13 & it.2 = 14 & it.3 = 3 & it.4 = 0 &
  it.5 = 6 & it.6 = 9 & it.7 = 10 & it.8 = 1 & it.9 = 2 &
  it.10 = 8 & it.11 = 5 & it.12 = 11 & it.13 = 12 & it.14 = 4 &
  it.15 = 15 & it.16 = 13 & it.17 = 8 & it.18 = 11 & it.19 = 5 &
  it.20 = 6 & it.21 = 15 & it.22 = 0 & it.23 = 3 & it.24 = 4 &
  it.25 = 7 & it.26 = 2 & it.27 = 12 & it.28 = 1 & it.29 = 10 &
  it.30 = 14 & it.31 = 9 & it.32 = 10 & it.33 = 6 & it.34 = 9 &
  it.35 = 0 & it.36 = 12 & it.37 = 11 & it.38 = 7 & it.39 = 13 &
  it.40 = 15 & it.41 = 1 & it.42 = 3 & it.43 = 14 & it.44 = 5 &
  it.45 = 2 & it.46 = 8 & it.47 = 4 & it.48 = 3 & it.49 = 15 &
  it.50 = 0 & it.51 = 6 & it.52 = 10 & it.53 = 1 & it.54 = 13 &
  it.55 = 8 & it.56 = 9 & it.57 = 4 & it.58 = 5 & it.59 = 11 &
  it.60 = 12 & it.61 = 7 & it.62 = 2 & it.63 = 14;
end;

definition
  func DES-SBOX5 -> Function of 64,16 means

  it.0 = 2 & it.1 = 12 & it.2 = 4 & it.3 = 1 & it.4 = 7 &
  it.5 = 10 & it.6 = 11 & it.7 = 6 & it.8 = 8 & it.9 = 5 &
  it.10 = 3 & it.11 = 15 &it.12 = 13 & it.13 = 0 & it.14 = 14 &
  it.15 = 9 & it.16 = 14 & it.17 = 11 & it.18 = 2 & it.19 = 12 &
  it.20 = 4 & it.21 = 7 & it.22 = 13 & it.23 = 1 & it.24 = 5 &
  it.25 = 0 & it.26 = 15 & it.27 = 10 & it.28 = 3 & it.29 = 9 &
  it.30 = 8 & it.31 = 6 & it.32 = 4 & it.33 = 2 & it.34 = 1 &
  it.35 = 11 & it.36 = 10 & it.37 = 13 & it.38 = 7 & it.39 = 8 &
  it.40 = 15 & it.41 = 9 & it.42 = 12 & it.43 = 5 & it.44 = 6 &
  it.45 = 3 & it.46 = 0 & it.47 = 14 & it.48 = 11 & it.49 = 8 &
  it.50 = 12 & it.51 = 7 & it.52 = 1 & it.53 = 14 & it.54 = 2 &
  it.55 = 13 & it.56 = 6 & it.57 = 15 & it.58 = 0 & it.59 = 9 &
  it.60 = 10 & it.61 = 4 & it.62 = 5 & it.63 = 3;
end;

definition
  func DES-SBOX6 -> Function of 64,16 means

  it.0 = 12 & it.1 = 1 & it.2 = 10 & it.3 = 15 & it.4 = 9 &
  it.5 = 2 & it.6 = 6 & it.7 = 8 & it.8 = 0 & it.9 = 13 &
  it.10 = 3 & it.11 = 4 & it.12 = 14 & it.13 = 7 & it.14 = 5 &
  it.15 = 11 & it.16 = 10 & it.17 = 15 & it.18 = 4 & it.19 = 2 &
  it.20 = 7 & it.21 = 12 & it.22 = 9 & it.23 = 5 & it.24 = 6 &
  it.25 = 1 & it.26 = 13 & it.27 = 14 & it.28 = 0 & it.29 = 11 &
  it.30 = 3 & it.31 = 8 & it.32 = 9 & it.33 = 14 & it.34 = 15 &
  it.35 = 5 & it.36 = 2 & it.37 = 8 & it.38 = 12 & it.39 = 3 &
  it.40 = 7 & it.41 = 0 & it.42 = 4 & it.43 = 10 & it.44 = 1 &
  it.45 = 13 & it.46 = 11 & it.47 = 6 & it.48 = 4 & it.49 = 3 &
  it.50 = 2 & it.51 = 12 & it.52 = 9 & it.53 = 5 & it.54 = 15 &
  it.55 = 10 & it.56 = 11 & it.57 = 14 & it.58 = 1 & it.59 = 7 &
  it.60 = 6 & it.61 = 0 & it.62 = 8 & it.63 = 13;
end;

definition
  func DES-SBOX7 -> Function of 64,16 means

  it.0 = 4 & it.1 = 11 & it.2 = 2 & it.3 = 14 & it.4 = 15 &
  it.5 = 0 & it.6 = 8 & it.7 = 13 & it.8 = 3 & it.9 = 12 &
  it.10 = 9 & it.11 = 7 & it.12 = 5 & it.13 = 10 & it.14 = 6 &
  it.15 = 1 & it.16 = 13 & it.17 = 0 & it.18 = 11 & it.19 = 7 &
  it.20 = 4 & it.21 = 9 & it.22 = 1 & it.23 = 10 & it.24 = 14 &
  it.25 = 3 & it.26 = 5 & it.27 = 12 & it.28 = 2 & it.29 = 15 &
  it.30 = 8 & it.31 = 6 & it.32 = 1 & it.33 = 4 & it.34 = 11 &
  it.35 = 13 & it.36 = 12 & it.37 = 3 & it.38 = 7 & it.39 = 14 &
  it.40 = 10 & it.41 = 15 & it.42 = 6 & it.43 = 8 & it.44 = 0 &
  it.45 = 5 & it.46 = 9 & it.47 = 2 & it.48 = 6 & it.49 = 11 &
  it.50 = 13 & it.51 = 8 & it.52 = 1 & it.53 = 4 & it.54 = 10 &
  it.55 = 7 & it.56 = 9 & it.57 = 5 & it.58 = 0 & it.59 = 15 &
  it.60 = 14 & it.61 = 2 & it.62 = 3 & it.63 = 12;
end;

definition
  func DES-SBOX8 -> Function of 64,16 means

  it.0 = 13 & it.1 = 2 & it.2 = 8 & it.3 = 4 & it.4 = 6 &
  it.5 = 15 & it.6 = 11 & it.7 = 1 & it.8 = 10 & it.9 = 9 &
  it.10 = 3 & it.11 = 14 & it.12 = 5 & it.13 = 0 & it.14 = 12 &
  it.15 = 7 & it.16 = 1 & it.17 = 15 & it.18 = 13 & it.19 = 8 &
  it.20 = 10 & it.21 = 3 & it.22 = 7 & it.23 = 4 & it.24 = 12 &
  it.25 = 5 & it.26 = 5 & it.27 = 11 & it.28 = 0 & it.29 = 14 &
  it.30 = 9 & it.31 = 2 & it.32 = 7 & it.33 = 11 & it.34 = 4 &
  it.35 = 1 & it.36 = 9 & it.37 = 12 & it.38 = 14 & it.39 = 2 &
  it.40 = 0 & it.41 = 6 & it.42 = 10 & it.43 = 13 & it.44 = 15 &
  it.45 = 3 & it.46 = 5 & it.47 = 8 & it.48 = 2 & it.49 = 1 &
  it.50 = 14 & it.51 = 7 & it.52 = 4 & it.53 = 10 & it.54 = 8 &
  it.55 = 13 & it.56 = 15 & it.57 = 12 & it.58 = 9 & it.59 = 0 &
  it.60 = 3 & it.61 = 5 & it.62 = 6 & it.63 = 11;
end;

begin 

definition
  let r be Element of 64-tuples_on BOOLEAN;
  func DES-IP(r) -> Element of 64-tuples_on BOOLEAN
  means

  it.1=r.58 & it.2=r.50 & it.3=r.42 & it.4=r.34 & it.5=r.26 &
  it.6=r.18 & it.7=r.10 & it.8=r.2 & it.9=r.60 & it.10=r.52 &
  it.11=r.44 & it.12=r.36 & it.13=r.28 & it.14=r.20 & it.15=r.12 &
  it.16=r.4 & it.17=r.62 & it.18=r.54 & it.19=r.46 & it.20=r.38 &
  it.21=r.30 & it.22=r.22 & it.23=r.14 & it.24=r.6 & it.25=r.64 &
  it.26=r.56 & it.27=r.48 & it.28=r.40 & it.29=r.32 & it.30=r.24 &
  it.31=r.16 & it.32=r.8 & it.33=r.57 & it.34=r.49 & it.35=r.41 &
  it.36=r.33 & it.37=r.25 & it.38=r.17 & it.39=r.9 & it.40=r.1 &
  it.41=r.59 & it.42=r.51 & it.43=r.43 & it.44=r.35 & it.45=r.27 &
  it.46=r.19 & it.47=r.11 & it.48=r.3 & it.49=r.61 & it.50=r.53 &
  it.51=r.45 & it.52=r.37 & it.53=r.29 & it.54=r.21 & it.55=r.13 &
  it.56=r.5 & it.57=r.63 & it.58=r.55 & it.59=r.47 & it.60=r.39 &
  it.61=r.31 & it.62=r.23 & it.63=r.15 & it.64=r.7;
end;

definition
  func DES-PIP ->
  Function of 64-tuples_on BOOLEAN,64-tuples_on BOOLEAN
  means

  for i be Element of 64-tuples_on BOOLEAN holds it.i = DES-IP(i);
end;

definition
  let r be Element of 64-tuples_on BOOLEAN;
  func DES-IPINV(r) -> Element of 64-tuples_on BOOLEAN means

  it.1=r.40 & it.2=r.8 & it.3=r.48 & it.4=r.16 &
  it.5=r.56 &it.6=r.24 & it.7=r.64 & it.8=r.32 &
  it.9=r.39 & it.10=r.7 &it.11=r.47 & it.12=r.15 &
  it.13=r.55 & it.14=r.23 & it.15=r.63 &it.16=r.31 &
  it.17=r.38 & it.18=r.6 & it.19=r.46 & it.20=r.14 &
  it.21=r.54 & it.22=r.22 & it.23=r.62 & it.24=r.30 &
  it.25=r.37 &it.26=r.5 & it.27=r.45 & it.28=r.13 &
  it.29=r.53 & it.30=r.21 &it.31=r.61 & it.32=r.29 &
  it.33=r.36 & it.34=r.4 & it.35=r.44 &it.36=r.12 &
  it.37=r.52 & it.38=r.20 & it.39=r.60 & it.40=r.28 &
  it.41=r.35 & it.42=r.3 & it.43=r.43 & it.44=r.11 &
  it.45=r.51 &it.46=r.19 & it.47=r.59 & it.48=r.27 &
  it.49=r.34 & it.50=r.2 &it.51=r.42 & it.52=r.10 &
  it.53=r.50 & it.54=r.18 & it.55=r.58 &it.56=r.26 &
  it.57=r.33 & it.58=r.1 & it.59=r.41 & it.60=r.9 &
  it.61=r.49 & it.62=r.17 & it.63=r.57 & it.64=r.25;
end;

definition
  func DES-PIPINV ->
  Function of 64-tuples_on BOOLEAN,64-tuples_on BOOLEAN means

  for i be Element of 64-tuples_on BOOLEAN holds it.i = DES-IPINV(i);
end;

registration
  cluster DES-PIP -> bijective;
end;

registration
  cluster DES-PIPINV -> bijective;
end;

theorem 
  DES-PIPINV=DES-PIP";

begin 

definition
  let r be Element of 32-tuples_on BOOLEAN;
  func DES-E(r) -> Element of 48-tuples_on BOOLEAN means

  it.1=r.32 & it.2=r.1 & it.3=r.2& it.4=r.3& it.5=r.4&
  it.6=r.5& it.7=r.4 & it.8=r.5 & it.9=r.6 & it.10=r.7 &
  it.11=r.8 & it.12=r.9& it.13=r.8 & it.14=r.9 & it.15=r.10 &
  it.16=r.11 & it.17=r.12 & it.18=r.13& it.19=r.12 & it.20=r.13 &
  it.21=r.14 & it.22=r.15 & it.23=r.16 & it.24=r.17& it.25=r.16 &
  it.26=r.17 & it.27=r.18 & it.28=r.19 & it.29=r.20 & it.30=r.21&
  it.31=r.20 & it.32=r.21 & it.33=r.22 & it.34=r.23 & it.35=r.24 &
  it.36=r.25& it.37=r.24 & it.38=r.25 & it.39=r.26 & it.40=r.27 &
  it.41=r.28 & it.42=r.29& it.43=r.28 & it.44=r.29 & it.45=r.30 &
  it.46=r.31 & it.47=r.32 & it.48=r.1;
end;

definition
  let r be Element of 32-tuples_on BOOLEAN;
  func DES-P(r) -> Element of 32-tuples_on BOOLEAN
  means

  it.1=r.16 &it.2=r.7 &it.3=r.20 &it.4=r.21&
  it.5=r.29 &it.6=r.12 &it.7=r.28 &it.8=r.17&
  it.9=r.1 &it.10=r.15 &it.11=r.23 &it.12=r.26&
  it.13=r.5 &it.14=r.18 &it.15=r.31 &it.16=r.10&
  it.17=r.2 &it.18=r.8 &it.19=r.24 &it.20=r.14&
  it.21=r.32 &it.22=r.27 &it.23=r.3 &it.24=r.9&
  it.25=r.19 &it.26=r.13 &it.27=r.30 &it.28=r.6&
  it.29=r.22 &it.30=r.11 &it.31=r.4 &it.32=r.25;
end;

definition
  let r be Element of 48-tuples_on BOOLEAN;
  func DES-DIV8(r) -> Element of 8-tuples_on (6-tuples_on BOOLEAN) means


  it.1 =Op-Left(r,6) &
  it.2 =Op-Left(Op-Right(r,6),6) &
  it.3 =Op-Left(Op-Right(r,12),6) &
  it.4 =Op-Left(Op-Right(r,18),6) &
  it.5 =Op-Left(Op-Right(r,24),6) &
  it.6 =Op-Left(Op-Right(r,30),6) &
  it.7 =Op-Left(Op-Right(r,36),6) &
  it.8 =Op-Right(r,42);
end;

theorem 
  for r be Element of 48-tuples_on BOOLEAN
  ex s1,s2,s3,s4,s5,s6,s7,s8
  be Element of 6-tuples_on BOOLEAN st
  s1=(DES-DIV8(r)).1&
  s2=(DES-DIV8(r)).2&
  s3=(DES-DIV8(r)).3&
  s4=(DES-DIV8(r)).4&
  s5=(DES-DIV8(r)).5&
  s6=(DES-DIV8(r)).6&
  s7=(DES-DIV8(r)).7&
  s8=(DES-DIV8(r)).8&
  r=s1^s2^s3^s4^s5^s6^s7^s8;

definition
  let t be Element of 6-tuples_on BOOLEAN;
  func B6toN64(t) -> Element of 64 equals

  32*(t.1) + 16*(t.6) + 8*(t.2) + 4*(t.3) + 2*(t.4) + 1*(t.5);
end;

definition
  func N16toB4 -> Function of 16,4-tuples_on BOOLEAN
  means

  it.0=<*0,0,0,0*>&
  it.1=<*0,0,0,1*>&
  it.2=<*0,0,1,0*>&
  it.3=<*0,0,1,1*>&
  it.4=<*0,1,0,0*>&
  it.5=<*0,1,0,1*>&
  it.6=<*0,1,1,0*>&
  it.7=<*0,1,1,1*>&
  it.8=<*1,0,0,0*>&
  it.9=<*1,0,0,1*>&
  it.10=<*1,0,1,0*>&
  it.11=<*1,0,1,1*>&
  it.12=<*1,1,0,0*>&
  it.13=<*1,1,0,1*>&
  it.14=<*1,1,1,0*>&
  it.15=<*1,1,1,1*>;
end;

definition
  let R be Element of 32-tuples_on BOOLEAN,
  RKey be Element of 48-tuples_on BOOLEAN;
  func DES-F(R,RKey) -> Element of 32-tuples_on BOOLEAN means

  ex D1,D2,D3,D4,D5,D6,D7,D8 be Element of 6-tuples_on BOOLEAN,
  x1,x2,x3,x4,x5,x6,x7,x8 be Element of 4-tuples_on BOOLEAN,
  C32 be Element of 32-tuples_on BOOLEAN
  st
  D1=(DES-DIV8(Op-XOR(DES-E(R),RKey))).1 &
  D2=(DES-DIV8(Op-XOR(DES-E(R),RKey))).2 &
  D3=(DES-DIV8(Op-XOR(DES-E(R),RKey))).3 &
  D4=(DES-DIV8(Op-XOR(DES-E(R),RKey))).4 &
  D5=(DES-DIV8(Op-XOR(DES-E(R),RKey))).5 &
  D6=(DES-DIV8(Op-XOR(DES-E(R),RKey))).6 &
  D7=(DES-DIV8(Op-XOR(DES-E(R),RKey))).7 &
  D8=(DES-DIV8(Op-XOR(DES-E(R),RKey))).8 &
  Op-XOR(DES-E(R),RKey) =D1^D2^D3^D4^D5^D6^D7^D8&
  x1=N16toB4.(DES-SBOX1.(B6toN64(D1)))&
  x2=N16toB4.(DES-SBOX2.(B6toN64(D2)))&
  x3=N16toB4.(DES-SBOX3.(B6toN64(D3)))&
  x4=N16toB4.(DES-SBOX4.(B6toN64(D4)))&
  x5=N16toB4.(DES-SBOX5.(B6toN64(D5)))&
  x6=N16toB4.(DES-SBOX6.(B6toN64(D6)))&
  x7=N16toB4.(DES-SBOX7.(B6toN64(D7)))&
  x8=N16toB4.(DES-SBOX8.(B6toN64(D8)))&
  C32=x1^x2^x3^x4^x5^x6^x7^x8&
  it=DES-P(C32);
end;

definition
  func DES-FFUNC ->
  Function of [:32-tuples_on BOOLEAN,48-tuples_on BOOLEAN:],
  32-tuples_on BOOLEAN
  means

  for z be Element of [:32-tuples_on BOOLEAN,48-tuples_on BOOLEAN:]
  holds it.z = DES-F(z`1 ,z`2);
end;

begin 

definition
  let r be Element of 64-tuples_on BOOLEAN;
  func DES-PC1(r) -> Element of 56-tuples_on BOOLEAN
  means

  it.1=r.57&it.2=r.49&it.3=r.41&it.4=r.33&it.5=r.25&
  it.6=r.17&it.7=r.9&it.8=r.1&it.9=r.58&it.10=r.50&
  it.11=r.42&it.12=r.34&it.13=r.26&it.14=r.18&it.15=r.10&
  it.16=r.2&it.17=r.59&it.18=r.51&it.19=r.43&it.20=r.35&
  it.21=r.27&it.22=r.19&it.23=r.11&it.24=r.3&it.25=r.60&
  it.26=r.52&it.27=r.44&it.28=r.36&it.29=r.63&it.30=r.55&
  it.31=r.47&it.32=r.39&it.33=r.31&it.34=r.23&it.35=r.15&
  it.36=r.7&it.37=r.62&it.38=r.54&it.39=r.46&it.40=r.38&
  it.41=r.30&it.42=r.22&it.43=r.14&it.44=r.6&it.45=r.61&
  it.46=r.53&it.47=r.45&it.48=r.37&it.49=r.29&it.50=r.21&
  it.51=r.13&it.52=r.5&it.53=r.28&it.54=r.20&it.55=r.12&
  it.56=r.4;
end;

definition
  let r be Element of 56-tuples_on BOOLEAN;
  func DES-PC2(r) -> Element of 48-tuples_on BOOLEAN
  means

  it.1=r.14&it.2=r.17&it.3=r.11&it.4=r.24&it.5=r.1&
  it.6=r.5&it.7=r.3&it.8=r.28&it.9=r.15&it.10=r.6&
  it.11=r.21&it.12=r.10&it.13=r.23&it.14=r.19&
  it.15=r.12&it.16=r.4&it.17=r.26&it.18=r.8&
  it.19=r.16&it.20=r.7&it.21=r.27&it.22=r.20&
  it.23=r.13&it.24=r.2&it.25=r.41&it.26=r.52&
  it.27=r.31&it.28=r.37&it.29=r.47&it.30=r.55&
  it.31=r.30&it.32=r.40&it.33=r.51&it.34=r.45&
  it.35=r.33&it.36=r.48&it.37=r.44&it.38=r.49&
  it.39=r.39&it.40=r.56&it.41=r.34&it.42=r.53&
  it.43=r.46&it.44=r.42&it.45=r.50&it.46=r.36&
  it.47=r.29&it.48=r.32;
end;

definition
  func bitshift_DES -> FinSequence of NAT means

  it is 16-element &
  it.1=1&it.2=1&it.3=2&it.4=2&
  it.5=2&it.6=2&it.7=2&it.8=2&
  it.9=1&it.10=2&it.11=2&it.12=2&
  it.13=2&it.14=2&it.15=2&it.16=1;
 end;

definition
  let Key be Element of 64-tuples_on BOOLEAN;
  func DES-KS(Key) -> Element of (16-tuples_on (48-tuples_on BOOLEAN)) means

  ex C,D be sequence of (28-tuples_on BOOLEAN) st
  C.0= Op-Left(DES-PC1(Key),28) & D.0= Op-Right(DES-PC1(Key),28)
  & (for i be Element of NAT st 0<=i & i <=15
  holds
  it.(i+1)=DES-PC2((C.(i+1))^(D.(i+1)))
  &
  C.(i+1) = Op-Shift(C.i,bitshift_DES.i)
  &
  D.(i+1) = Op-Shift(D.i,bitshift_DES.i));
end;

begin

definition
  let n,m,k be non empty Element of NAT,
  RK be Element of (k-tuples_on (m-tuples_on BOOLEAN)),
  F be Function of [:n-tuples_on BOOLEAN,m-tuples_on BOOLEAN:],
  n-tuples_on BOOLEAN,
  IP be Permutation of (2*n)-tuples_on BOOLEAN,
  M be Element of (2*n)-tuples_on BOOLEAN;
  func DES-like-CoDec(M,F,IP,RK) -> Element of (2*n)-tuples_on BOOLEAN means


  ex L,R be sequence of (n-tuples_on BOOLEAN)
  st
  L.0= SP-Left(IP.M) & R.0= SP-Right(IP.M)
  & (for i be Element of NAT st 0<=i & i <=k-1 holds L.(i+1)= R.i
  &
  R.(i+1)=Op-XOR(L.i,F.(R.i,RK/.(i+1))))
  &
  it=IP".((R.k )^(L.k));
end;

theorem 
  for n,m,k be non empty Element of NAT,
  RK be Element of k-tuples_on (m-tuples_on BOOLEAN),
  F be Function of [:n-tuples_on BOOLEAN,m-tuples_on BOOLEAN:],
  n-tuples_on BOOLEAN,
  IP be Permutation of (2*n)-tuples_on BOOLEAN,
  M be Element of (2*n)-tuples_on BOOLEAN holds
  DES-like-CoDec(DES-like-CoDec(M,F,IP,RK),F,IP,Rev(RK))=M;

definition
  let RK be Element of (16-tuples_on (48-tuples_on BOOLEAN)),
  F be Function of [:32-tuples_on BOOLEAN,48-tuples_on BOOLEAN:],
  32-tuples_on BOOLEAN,
  IP be Permutation of 64-tuples_on BOOLEAN,
  M be Element of 64-tuples_on BOOLEAN;
  func DES-CoDec(M,F,IP,RK) -> Element of 64-tuples_on BOOLEAN
  means

  ex IPX be Permutation of (2*32)-tuples_on BOOLEAN,
  MX be Element of (2*32)-tuples_on BOOLEAN st
  IPX=IP & MX =M & it =DES-like-CoDec(MX,F,IPX,RK);
end;

theorem 
  for RK be Element of 16-tuples_on (48-tuples_on BOOLEAN),
  F be Function of [:32-tuples_on BOOLEAN,48-tuples_on BOOLEAN:],
  32-tuples_on BOOLEAN,
  IP be Permutation of 64-tuples_on BOOLEAN,
  M be Element of 64-tuples_on BOOLEAN holds
  DES-CoDec(DES-CoDec(M,F,IP,RK),F,IP,Rev(RK))=M;

definition
  let plaintext,secretkey be Element of 64-tuples_on BOOLEAN;
  func DES-ENC(plaintext,secretkey) -> Element of 64-tuples_on BOOLEAN
  equals

  DES-CoDec (plaintext,DES-FFUNC,DES-PIP,DES-KS(secretkey));
end;

definition
  let ciphertext,secretkey be Element of 64-tuples_on BOOLEAN;
  func DES-DEC(ciphertext,secretkey) -> Element of 64-tuples_on BOOLEAN
  equals

  DES-CoDec (ciphertext,DES-FFUNC,DES-PIP,Rev(DES-KS(secretkey)));
end;

theorem 
  for message,secretkey be Element of 64-tuples_on BOOLEAN
  holds DES-DEC(DES-ENC(message,secretkey),secretkey) = message;














begin 

definition
  let X be set;
  mode List of X is Subset of X;
  mode Operation of X is Relation of X;
end;

definition
  let x,y,R be set;
  pred x,y in R means

[x,y] in R;
end;

notation
  let x,y,R be set;
  antonym x,y nin R for x,y in R;
end;

reserve X,Y,z,s for set, L,L1,L2,A,B for List of X, x for Element of X,
  O,O1,O2,O3 for Operation of X, a,b,y for Element of X, n,m for Nat;

theorem 
  for R1,R2 be Relation holds R1 c= R2 iff for z holds Im(R1,z) c= Im(R2,z);

notation
  let X,O,x;
  synonym x.O for Im(O,x);
end;

definition
  let X,O,x;
  redefine func x.O -> List of X;
end;

theorem 
  x,y in O iff y in x.O;

notation
  let X,O,L;
  synonym L | O for O.:L;
end;

definition
  let X,O,L;
  redefine func L | O -> List of X equals

union {x.O: x in L};
  func L \& O -> List of X equals

meet {x.O: x in L};
  func L WHERE O -> List of X equals

{x: ex y st x,y in O & x in L};
  let O2 be Operation of X;
  func L WHEREeq(O,O2) -> List of X equals

  {x: card(x.O) = card(x.O2) & x in L};
  func L WHEREle(O,O2) -> List of X equals

  {x: card(x.O) c= card(x.O2) & x in L};
  func L WHEREge(O,O2) -> List of X equals

  {x: card(x.O2) c= card(x.O) & x in L};
  func L WHERElt(O,O2) -> List of X equals

  {x: card(x.O) in card(x.O2) & x in L};
  func L WHEREgt(O,O2) -> List of X equals

  {x: card(x.O2) in card(x.O) & x in L};
end;

definition
  let X,L,O,n;
  func L WHEREeq(O,n) -> List of X equals

{x: card(x.O) = n & x in L};
  func L WHEREle(O,n) -> List of X equals

{x: card(x.O) c= n & x in L};
  func L WHEREge(O,n) -> List of X equals

{x: n c= card(x.O) & x in L};
  func L WHERElt(O,n) -> List of X equals

{x: card(x.O) in n & x in L};
  func L WHEREgt(O,n) -> List of X equals

{x: n in card(x.O) & x in L};
end;

theorem 
  x in L WHERE O iff x in L & x.O <> {};

theorem 
  L WHERE O c= L;

theorem 
  L c= dom O implies L WHERE O = L;

theorem 
  n <> 0 & L1 c= L2 implies L1 WHEREge(O,n) c= L2 WHERE O;

theorem 
  L WHEREge(O,1) = L WHERE O;

theorem 
  L1 c= L2 implies L1 WHEREgt(O,n) c= L2 WHERE O;

theorem 
  L WHEREgt(O,0) = L WHERE O;

theorem 
  n <> 0 & L1 c= L2 implies L1 WHEREeq(O,n) c= L2 WHERE O;

theorem 
  L WHEREge(O,n+1) = L WHEREgt(O,n);

theorem 
  L WHEREle(O,n) = L WHERElt(O,n+1);

theorem 
  n <= m & L1 c= L2 & O1 c= O2 implies L1 WHEREge(O1,m) c= L2 WHEREge(O2,n);

theorem 
  n <= m & L1 c= L2 & O1 c= O2 implies L1 WHEREgt(O1,m) c= L2 WHEREgt(O2,n);

theorem 
  n <= m & L1 c= L2 & O1 c= O2 implies L1 WHEREle(O2,n) c= L2 WHEREle(O1,m);

theorem 
  n <= m & L1 c= L2 & O1 c= O2 implies L1 WHERElt(O2,n) c= L2 WHERElt(O1,m);

theorem 
  O1 c= O2 & L1 c= L2 & O c= O3 implies L1 WHEREge(O,O2) c= L2 WHEREge(O3,O1);

theorem 
  O1 c= O2 & L1 c= L2 & O c= O3 implies L1 WHEREgt(O,O2) c= L2 WHEREgt(O3,O1);

theorem 
  O1 c= O2 & L1 c= L2 & O c= O3 implies L1 WHEREle(O3,O1) c= L2 WHEREle(O,O2);

theorem 
  O1 c= O2 & L1 c= L2 & O c= O3 implies L1 WHERElt(O3,O1) c= L2 WHERElt(O,O2);

theorem 
  L WHEREgt(O,O1) c= L WHERE O;

theorem 
  O1 c= O2 & L1 c= L2 implies L1 WHERE O1 c= L2 WHERE O2;

theorem 
  a in L|O iff ex b st a in b.O & b in L;

notation
  let X,A,B;
  synonym A AND B for A /\ B;
  synonym A OR B for A \/ B;
  synonym A BUTNOT B for A \ B;
end;

definition
  let X,A,B;
  redefine func A AND B -> List of X;
  redefine func A OR B -> List of X;
  redefine func A BUTNOT B -> List of X;
end;

theorem 
  L1 <> {} & L2 <> {} implies (L1 OR L2)\& O = (L1 \& O)AND(L2 \& O);

theorem 
  L1 c= L2 & O1 c= O2 implies L1|O1 c= L2|O2;

theorem 
  O1 c= O2 implies L\&O1 c= L\&O2;

theorem 
  L\&(O1 AND O2) = (L \& O1)AND(L \& O2);

theorem 
  L1 <> {} & L1 c= L2 implies L2 \& O c= L1 \& O;

begin 

theorem 
  for O1,O2 being Operation of X st for x holds x.O1 = x.O2 holds O1 = O2;

theorem 
  for O1,O2 being Operation of X st for L holds L|O1 = L|O2 holds O1 = O2;

definition
  let X,O;
  func NOT O -> Operation of X means

  for L holds L|it = union {IFEQ(x.O, {}, {x}, {}): x in L};
end;

notation
  let X;
  let O1,O2 be Operation of X;
  synonym O1 AND O2 for O1 /\ O2;
  synonym O1 OR O2 for O1 \/ O2;
  synonym O1 BUTNOT O2 for O1 \ O2;
  synonym O1 | O2 for O1 * O2;
end;

definition
  let X;
  let O1,O2 be Operation of X;
  redefine func O1 AND O2 -> Operation of X means

  for L holds L|it = union {x.O1 AND x.O2: x in L};
  redefine func O1 OR O2 -> Operation of X means

  for L holds L|it = union {x.O1 OR x.O2: x in L};
  redefine func O1 BUTNOT O2 -> Operation of X means

  for L holds L|it = union {x.O1 BUTNOT x.O2: x in L};
  redefine func O1 | O2 -> Operation of X means

  for L holds L|it = L|O1|O2;
  func O1 \& O2 -> Operation of X means

  for L holds L|it = union {x.O1\&O2: x in L};
end;

theorem 
  x.(O1 AND O2) = (x.O1)AND(x.O2);
theorem 
  x.(O1 OR O2) = (x.O1)OR(x.O2);
theorem 
  x.(O1 BUTNOT O2) = (x.O1)BUTNOT(x.O2);
theorem 
  x.(O1|O2) = (x.O1)|O2;

theorem 
  x.(O1\&O2) = (x.O1)\&O2;

theorem 
  [z,s] in NOT O iff z = s & z in X & z nin dom O;

theorem 
  NOT O = id(X\dom O);

theorem 
  dom NOT NOT O = dom O;

theorem 
  L WHERE NOT NOT O = L WHERE O;

theorem 
  L WHEREeq(O,0) = L WHERE NOT O;

theorem 
  NOT NOT NOT O = NOT O;

theorem 
  (NOT O1) OR NOT O2 c= NOT (O1 AND O2);

theorem 
  NOT (O1 OR O2) = (NOT O1) AND NOT O2;

theorem 
  dom O1 = X & dom O2 = X implies (O1 OR O2)\& O = (O1 \& O) AND (O2 \& O);

definition
  let X,O;
  attr O is filtering means

O c= id X;
end;

theorem 
  O is filtering iff O = id dom O;

registration
  let X,O;
  cluster NOT O -> filtering;
end;

registration
  let X;
  cluster filtering for Operation of X;
end;

reserve F,F1,F2 for filtering Operation of X;

registration
  let X,F,O;
  cluster F AND O -> filtering for Operation of X;
  cluster O AND F -> filtering for Operation of X;
  cluster F BUTNOT O -> filtering for Operation of X;
end;

registration
  let X,F1,F2;
  cluster F1 OR F2 -> filtering for Operation of X;
end;

theorem 
  z in x.F implies z = x;

theorem 
  L|F = L WHERE F;

theorem 
  NOT NOT F = F;

theorem 
  NOT (F1 AND F2) = (NOT F1) OR (NOT F2);

theorem 
  dom(O OR NOT O) = X;

theorem 
  F OR NOT F = id X;

theorem 
  O AND NOT O = {};

theorem 
  (O1 OR O2) AND NOT O1 c= O2;

begin 

reserve i for Element of NAT;

definition
  let A be FinSequence;
  let a be set;
  func #occurrences(a,A) -> Nat equals

card {i: i in dom A & a in A.i};
end;

theorem 
  for A being FinSequence, a being set holds #occurrences(a,A) <= len A;

theorem 
  for A being FinSequence, a being set holds
  A <> {} & #occurrences(a,A) = len A iff a in meet rng A;

definition
  let A be FinSequence;
  func max# A -> Nat means

  (for a being set holds #occurrences(a,A) <= it) &
  (for n st for a being set holds #occurrences(a,A) <= n holds it <= n);
end;

theorem 
  for A being FinSequence holds max# A <= len A;

theorem 
  for A being FinSequence, a being set st #occurrences(a,A) = len A holds
  max# A = len A;

definition
  let X;
  let A be FinSequence of bool X;
  let n be Nat;
  func ROUGH(A,n) -> List of X equals

  {x: n <= #occurrences(x,A)} if X <> {};
  let m be Nat;
  func ROUGH(A,n,m) -> List of X equals

  {x: n <= #occurrences(x,A) & #occurrences(x,A) <= m} if X <> {};
end;

definition
  let X;
  let A be FinSequence of bool X;
  func ROUGH(A) -> List of X equals

ROUGH(A, max# A);
end;

theorem 
  for A being FinSequence of bool X holds
  ROUGH(A, n, len A) = ROUGH(A, n);

theorem 
  for A being FinSequence of bool X holds
  n <= m implies ROUGH(A,m) c= ROUGH(A,n);

theorem 
  for A being FinSequence of bool X holds
  for n1,n2,m1,m2 being Nat st n1 <= m1 & n2 <= m2 holds
  ROUGH(A,m1,n2) c= ROUGH(A,n1,m2);

theorem 
  for A being FinSequence of bool X holds
  ROUGH(A,n,m) c= ROUGH(A,n);

theorem 
  for A being FinSequence of bool X st A <> {} holds
  ROUGH(A, len A) = meet rng A;

theorem 
  for A being FinSequence of bool X holds
  ROUGH(A, 1) = Union A;

theorem 
  for L1,L2 being List of X holds
  ROUGH(<*L1,L2*>,2) = L1 AND L2;

theorem 
  for L1,L2 being List of X holds
  ROUGH(<*L1,L2*>,1) = L1 OR L2;

begin 

definition
  struct(1-sorted) ConstructorDB(#
     carrier -> set,
     Constrs -> List of the carrier,
     ref-operation -> Relation of the carrier, the Constrs
  #);
end;

definition
  let X be 1-sorted;
  mode List of X is List of the carrier of X;
  mode Operation of X is Operation of the carrier of X;
end;

definition
  let X;
  let S be Subset of X;
  let R be Relation of X,S;
  func @R -> Relation of X equals

R;
end;

definition
  let X be ConstructorDB;
  let a be Element of X;
  func a ref -> List of X equals

a.@the ref-operation of X;
  func a occur -> List of X equals

a.((@the ref-operation of X)~);
end;

theorem 
  for X being ConstructorDB
  for x,y being Element of X holds x in y ref iff y in x occur;

definition
  let X be ConstructorDB;
  attr X is ref-finite means

  for x being Element of X holds x ref is finite;
end;

registration
  cluster finite -> ref-finite for ConstructorDB;
end;

registration
  cluster finite non empty for ConstructorDB;
end;

registration
  let X be ref-finite ConstructorDB;
  let x be Element of X;
  cluster x ref -> finite;
end;

definition
  let X be ConstructorDB;
  let A be FinSequence of the Constrs of X;
  func ATLEAST(A) -> List of X equals

  {x where x is Element of X: rng A c= x ref}
  if the carrier of X <> {};
  func ATMOST(A) -> List of X equals

  {x where x is Element of X: x ref c= rng A}
  if the carrier of X <> {};
  func EXACTLY(A) -> List of X equals

  {x where x is Element of X: x ref = rng A}
  if the carrier of X <> {};

  let n be Nat;
  func ATLEAST-(A,n) -> List of X equals

  {x where x is Element of X: card((rng A) \ x ref) <= n}
  if the carrier of X <> {};
end;

definition
  let X be ref-finite ConstructorDB;
  let A be FinSequence of the Constrs of X;
  let n be Nat;
  func ATMOST+(A,n) -> List of X equals

  {x where x is Element of X: card((x ref) \ rng A) <= n}
  if the carrier of X <> {};
  let m be Nat;
  func EXACTLY+-(A,n,m) -> List of X equals

  {x where x is Element of X: card((x ref) \ rng A) <= n &
                              card((rng A) \ x ref) <= m}
  if the carrier of X <> {};
end;

reserve X for ConstructorDB, A for FinSequence of the Constrs of X,
  x for Element of X;
reserve Y for ref-finite ConstructorDB,
  B for FinSequence of the Constrs of Y,
  y for Element of Y;

theorem 
  ATLEAST-(A,0) = ATLEAST(A);

theorem 
  ATMOST+(B,0) = ATMOST(B);

theorem 
  EXACTLY+-(B,0,0) = EXACTLY(B);

theorem 
  n <= m implies ATLEAST-(A,n) c= ATLEAST-(A,m);

theorem 
  n <= m implies ATMOST+(B,n) c= ATMOST+(B,m);

theorem 
  for n1,n2,m1,m2 being Nat st n1 <= m1 & n2 <= m2 holds
  EXACTLY+-(B,n1,n2) c= EXACTLY+-(B,m1,m2);

theorem 
  ATLEAST(A) c= ATLEAST-(A,n);

theorem 
  ATMOST(B) c= ATMOST+(B,n);

theorem 
  EXACTLY(B) c= EXACTLY+-(B,n,m);

theorem 
  EXACTLY A = ATLEAST A AND ATMOST A;

theorem 
  EXACTLY+-(B,n,m) = ATLEAST-(B,m) AND ATMOST+(B,n);

theorem 
  A <> {} implies ATLEAST A = meet {x occur: x in rng A};

theorem 
  for c1,c2 being Element of X holds
  A = <*c1,c2*> implies ATLEAST A = (c1 occur) AND (c2 occur);















begin 

 reserve A, B, C, A1, B1, C1, A2, B2, C2, C3 for Point of TOP-REAL 2,
  lambda, mu, nu, alpha, beta, gamma for Real,
  X, Y, Z for Subset of TOP-REAL 2;

notation
 let X,Y;
 synonym X is_parallel_to Y for X misses Y;
end;

definition
  let X, Y, Z;
  pred X, Y, Z are_concurrent means

  ((X is_parallel_to Y & Y is_parallel_to Z & Z is_parallel_to X) or
  ex A st (A in X & A in Y & A in Z));
end;

theorem 
   (A + B) `1 = A `1 + B `1 & (A + B) `2 = A `2 + B `2;

theorem 
   (lambda * A) `1 = lambda * A `1 & (lambda * A) `2 = lambda * A `2;

theorem 
   (- A) `1 = - A `1 & (- A) `2 = - A `2;

theorem 
   (lambda * A + mu * B) `1 = lambda * A `1 + mu * B `1 &
  (lambda * A + mu * B) `2 = lambda * A `2 + mu * B `2;

theorem 
  ((- lambda) * A) `1 = - lambda * A `1 &
  ((- lambda) * A) `2 = - lambda * A `2;

theorem 
  (lambda * A - mu * B) `1 = lambda * A `1 - mu * B `1 &
  (lambda * A - mu * B) `2 = lambda * A `2 - mu * B `2;

theorem 
   the_area_of_polygon3((1 - lambda) * A + lambda * A1, B, C) =
  (1 - lambda) * the_area_of_polygon3(A, B, C) +
  lambda * the_area_of_polygon3(A1, B, C);

theorem 
   (angle(A, B, C) = 0 & A, B, C are_mutually_different) implies
  (angle(B, C, A) = PI or angle(B, A, C) = PI);

theorem 
   A, B, C is_collinear iff the_area_of_polygon3(A, B, C) = 0;

theorem 
   the_area_of_polygon3(0. (TOP-REAL 2), B, C) =
  (B `1 * C `2 - C `1 * B `2) / 2;

theorem 
  the_area_of_polygon3(A + A1, B, C) = the_area_of_polygon3(A, B, C) +
  the_area_of_polygon3(A1, B, C) - the_area_of_polygon3(0. (TOP-REAL 2), B, C);

theorem 
   A in LSeg(B, C) implies A in Line(B, C);

theorem 
   B <> C implies (A, B, C is_collinear iff A in Line(B, C));

theorem 
   A, B, C is_a_triangle & A1 = (1 - lambda) * B + lambda * C implies
  A <> A1;

theorem 
   A, B, C is_a_triangle implies A, C, B is_a_triangle &
  B, A, C is_a_triangle & B, C, A is_a_triangle & C, A, B is_a_triangle &
  C, B, A is_a_triangle;

theorem 
   (A, B, C is_a_triangle & A1 = (1 - lambda) * B + lambda * C &
  B1 = (1 - mu) * C + mu * A  & mu <> 1) implies ((1 - mu) + lambda * mu <> 0
  iff not Line(A, A1) is_parallel_to Line(B, B1));

begin 


theorem 
   (A1 = (1 - lambda) * B + lambda * C &
  B1 = (1 - mu) * C + mu * A & C1 = (1 - nu) * A + nu * B) implies
  the_area_of_polygon3(A1, B1, C1) = ((1 - lambda) * (1 - mu) * (1 - nu) +
  lambda * mu * nu) * the_area_of_polygon3(A, B, C);


theorem 
  (A, B, C is_a_triangle & A1 = (1 - lambda) * B + lambda * C &
  B1 = (1 - mu) * C + mu * A & C1 = (1 - nu) * A + nu * B & lambda <> 1 &
  mu <> 1 & nu <> 1) implies (A1, B1, C1 is_collinear iff
  (lambda / (1 - lambda)) * (mu / (1 - mu)) * (nu / (1 - nu)) = -1);


theorem 
   (A, B, C is_a_triangle & A1 = (1 - lambda) * B + lambda * C &
  B1 = (1 - mu) * C + mu * A & C1 = (1 - nu) * A + nu * B & lambda <> 1 &
  mu <> 1 & nu <> 1 & A, A1, C2 is_collinear & B, B1, C2 is_collinear &
  B, B1, A2 is_collinear & C, C1, A2 is_collinear & A, A1, B2 is_collinear &
  C, C1, B2 is_collinear) implies (((1 - mu) + lambda * mu) * ((1 - lambda) +
  nu * lambda) * ((1 - nu) + mu * nu)) <> 0 & the_area_of_polygon3(A2, B2, C2)
  = ((mu * nu * lambda - (1 - mu) * (1 - nu) * (1 - lambda)) ^2 / (((1 - mu) +
  lambda * mu) * ((1 - lambda) + nu * lambda) * ((1 - nu) + mu * nu))) *
  the_area_of_polygon3(A, B, C);


theorem 
  (A, B, C is_a_triangle & A1 = (2 / 3) * B + (1 / 3) * C &
  B1 = (2 / 3) * C + (1 / 3) * A & C1 = (2 / 3) * A + (1 / 3) * B &
  A, A1, C2 is_collinear & B, B1, C2 is_collinear & B, B1, A2 is_collinear &
  C, C1, A2 is_collinear & A, A1, B2 is_collinear & C, C1, B2 is_collinear)
  implies the_area_of_polygon3(A2, B2, C2) = the_area_of_polygon3(A, B, C) / 7;


theorem 
   (A, B, C is_a_triangle & A1 = (1 - lambda) * B + lambda * C & B1 = (1
  - mu) * C + mu * A & C1 = (1 - nu) * A + nu * B & lambda <> 1 & mu <> 1 &
  nu <> 1 & ((1 - mu) + lambda * mu) <> 0 & ((1 - lambda) + nu * lambda) <> 0
  & ((1 - nu) + mu * nu) <> 0) implies ((lambda / (1 - lambda)) * (mu / (1 -
  mu)) * (nu / (1 - nu)) = 1 iff (ex A2 st A, A1, A2 is_collinear & B, B1, A2
  is_collinear & C, C1, A2 is_collinear));


theorem 
  (A, B, C is_a_triangle & A1 = (1 - lambda) * B + lambda * C & B1 = (1 - mu)
  * C + mu * A & C1 = (1 - nu) * A + nu * B & lambda <> 1 & mu <> 1 & nu <> 1)
  implies ((lambda / (1 - lambda)) * (mu / (1 - mu)) * (nu / (1 - nu)) = 1 iff
  Line(A, A1), Line(B, B1), Line(C, C1) are_concurrent);














begin  
       

theorem 
for x, X being set holds not [x,X] in X;

theorem 
for x, X being set holds [x,X] <> X;

theorem 
for x, X being set holds [x,X] <> x;

theorem 
for x1,y1,x2,y2,X being set
 st x1 in X & x2 in X & {x1,[y1,X]} = {x2,[y2,X]}
  holds x1 = x2 & y1 = y2;

theorem 
for X, v being set st 3 c= card X
  ex v1, v2 being set st v1 in X & v2 in X & v1<>v & v2<>v & v1<>v2;

theorem 
for x being set holds singletons {x} = { {x} };

registration
 cluster finite-yielding for FinSequence;
end;

theorem 
for X being non empty finite set, P being a_partition of X
 st card P < card X
  ex p, x, y being set st p in P & x in p & y in p & x <> y;

registration
 cluster union {{}} -> empty;
end;

theorem 
for x being set holds union { {}, {x} } = {x};

theorem 
for X being set, s being Subset of X
 st s is 1-element
  ex x being set st x in X & s = {x};

theorem 
for X being set holds
 card { {X,[x,X]} where x is Element of X : x in X } = card X;

definition
  let G be set;
  func PairsOf G -> Subset of G means

    for e being set holds e in it iff e in G & card e = 2 ;
end;

theorem 
for X being set, e being set
 st e in PairsOf X
  ex x, y being set st x <> y & x in union X & y in union X & e = {x, y};

theorem 
for X, x, y being set st x <> y & {x, y} in X holds {x, y} in PairsOf X;

theorem 
for X, x, y being set
 st {x, y} in PairsOf X holds x <> y & x in union X & y in union X;

theorem 
for G, H being set st G c= H holds PairsOf G c= PairsOf H;

theorem 
for X being finite set holds
 card { {x,[y, union X]} where x, y is Element of union X
                         : {x,y} in PairsOf X } = 2 * card PairsOf X;

theorem 
for X being finite set holds
 card {[x, y] where x, y is Element of union X
                         : {x,y} in PairsOf X } = 2 * card PairsOf X;

registration
  let X be finite set;
  cluster PairsOf X -> finite;
end;

definition
  let X be set;
  attr X is void means

    X = {{}};
end;

registration
  cluster void for set;
end;

registration
 cluster void -> finite for set;
end;

registration
  let G be void set;
  cluster union G -> empty;
end;

theorem 
for X being set st X is void holds PairsOf X = {};

theorem 
for X being set st union X = {} holds X = {} or X = {{}};

definition
  let X be set;
  attr X is pairfree means

    PairsOf X is empty;
end;

theorem 
for X, x being set st card union X = 1 holds X is pairfree;

registration
 cluster finite-membered non empty for set;
end;

registration
  let X be finite-membered set, Y be set;
  cluster X /\ Y -> finite-membered;
  cluster X \ Y -> finite-membered;
end;

begin  

definition
  let n be Nat;
  let X be set;
  attr X is n-at_most_dimensional means

  for x being set st x in X holds card x c= n+1;
end;

registration
  let n be Nat;
  cluster n-at_most_dimensional -> finite-membered for set;
end;

registration
  let n be Nat;
  cluster n-at_most_dimensional subset-closed non empty for set;
end;

theorem 
for G being subset-closed non empty set holds {} in G;

theorem 
for n being natural number, X being n-at_most_dimensional set,
    x being Element of X
 st x in X holds card x <= n+1;

registration
  let n be Nat;
  let X, Y be n-at_most_dimensional set;
  cluster X \/ Y -> n-at_most_dimensional;
end;

registration
  let n be Nat;
  let X be n-at_most_dimensional set, Y be set;
  cluster X /\ Y -> n-at_most_dimensional;
  cluster X \ Y -> n-at_most_dimensional;
end;

registration
  let n be Nat, X be n-at_most_dimensional set;
  cluster -> n-at_most_dimensional for Subset of X;
end;

definition
  let s be set;
  attr s is SimpleGraph-like means

       s is 1-at_most_dimensional subset-closed non empty;
end;

registration
 cluster SimpleGraph-like ->
         1-at_most_dimensional subset-closed non empty for set;
 cluster 1-at_most_dimensional subset-closed non empty
         -> SimpleGraph-like for set;
end;

theorem 
{{}} is SimpleGraph-like;

registration
  cluster {{}} -> SimpleGraph-like;
end;

registration
  cluster SimpleGraph-like for set;
end;

definition
 mode SimpleGraph is SimpleGraph-like set;
end;

registration
  cluster void for SimpleGraph;
  cluster finite for SimpleGraph;
end;

notation  
  let G be set;
  synonym Vertices G for union G;
  synonym Edges G for PairsOf G;
end;

notation
  let X be set;
  synonym X is edgeless for X is pairfree;
end;

theorem 
for G being SimpleGraph st Vertices G is finite holds G is finite;

theorem 
for G being SimpleGraph, x being set holds x in Vertices G iff {x} in G;

theorem 
for x being set holds { {}, {x} } is SimpleGraph;

definition  
  let X be finite finite-membered set;
  func order X -> Nat equals

   card union X;
end;

definition  
  let X be finite set;
  func size X -> Nat equals

card PairsOf X;
end;

theorem 
for G being finite SimpleGraph holds order G <= card G;

definition
  let G be SimpleGraph;
  mode Vertex of G is Element of Vertices G;
  mode Edge of G is Element of Edges G;
end;

theorem 
for G being SimpleGraph holds G = { {} } \/ singletons Vertices G \/ Edges G;

theorem 
for G being SimpleGraph st Vertices G = {} holds G is void;

theorem 
for G being SimpleGraph, x being set
 st x in G & x <> {}
  holds (ex y being set st x = {y} & y in Vertices G) or x in Edges G;

theorem 
for G being SimpleGraph, x being set st Vertices G = {x} holds G = { {}, {x} };

theorem 
for X being set ex G being SimpleGraph st G is edgeless & Vertices G = X;

definition
 let G be SimpleGraph, v be Element of Vertices G;
 func Adjacent v -> Subset of Vertices G  means

  for x being Element of Vertices G holds x in it iff {v, x} in Edges G;
end;

definition
  let X be set;
  mode SimpleGraph of X -> SimpleGraph means

    Vertices it = X;
end;

definition
 let X be set;
 func CompleteSGraph X -> SimpleGraph of X equals

   { V where V is finite Subset of X : card V <= 2};
end;

theorem 
for G being SimpleGraph
  st (for x, y being set st x in Vertices G & y in Vertices G
        holds {x, y} in G)
   holds G = CompleteSGraph Vertices G;

registration
 let X be finite set;
 cluster CompleteSGraph X -> finite;
end;

theorem 
for X being set, x being set st x in X holds {x} in CompleteSGraph X;

theorem 
for X being set, x, y being set st x in X & y in X
  holds {x,y} in CompleteSGraph X;

theorem 
CompleteSGraph {} = {{}};

theorem 
for  x being set holds CompleteSGraph {x} = {{},{x}};

theorem 
for  x, y being set holds CompleteSGraph {x,y} = {{},{x},{y},{x,y}};

theorem 
for X, Y being set st X c= Y holds CompleteSGraph X c= CompleteSGraph Y;

theorem 
for G being SimpleGraph, x being set st x in Vertices G
  holds CompleteSGraph {x} c= G;

registration
  let G be SimpleGraph;
  cluster SimpleGraph-like for Subset of G;
end;

definition
  let G be SimpleGraph;
  mode Subgraph of G is SimpleGraph-like Subset of G;
end;

definition
 let G be SimpleGraph;
 func Complement G -> SimpleGraph equals

  (CompleteSGraph Vertices G) \ Edges G;
 involutiveness;
end;

theorem 
 for G being SimpleGraph holds Vertices G = Vertices Complement G;

theorem 
for G being SimpleGraph, x, y being set
 st x <> y & x in Vertices G & y in Vertices G
  holds {x,y} in Edges G iff {x,y} nin Edges Complement G;

begin 

definition
 let G be SimpleGraph, L be set;
 func G SubgraphInducedBy L -> Subset of G equals

   G /\ bool L;
end;

registration
 let G be SimpleGraph, L be set;
 cluster G SubgraphInducedBy L -> SimpleGraph-like;
end;

theorem 
for G being SimpleGraph holds G = G SubgraphInducedBy Vertices G;

theorem 
for G being SimpleGraph, L being set
 holds G SubgraphInducedBy L = G SubgraphInducedBy (L /\ Vertices G);

registration
 let G be finite SimpleGraph, L be set;
 cluster G SubgraphInducedBy L -> finite;
end;

registration
 let G be SimpleGraph, L be finite set;
 cluster G SubgraphInducedBy L -> finite;
end;

theorem 
for G, H being SimpleGraph
 st G c= H holds G c= H SubgraphInducedBy Vertices G;

theorem 
for G being SimpleGraph, L being set
 holds Vertices (G SubgraphInducedBy L) = (Vertices G) /\ L;

theorem 
for G being SimpleGraph, x being set
 st x in Vertices G holds G SubgraphInducedBy {x} = { {}, {x} };

begin 

definition
  let G be SimpleGraph;
  attr G is clique means

    G = CompleteSGraph Vertices G;
end;

theorem 
for G being SimpleGraph
 st for x, y being set st x <> y & x in Vertices G & y in Vertices G
      holds {x,y} in Edges G
  holds G is clique;

theorem 
{{}} is clique;

registration
  cluster clique for SimpleGraph;

  let G be SimpleGraph;
  cluster clique for Subgraph of G;
end;

definition
  let G be SimpleGraph;
  mode Clique of G is clique Subgraph of G;
end;

theorem 
for X being set holds (CompleteSGraph X) is clique;

registration
 let X be set;
 cluster CompleteSGraph X -> clique;
end;

theorem 
for G being SimpleGraph, x being set st x in Vertices G
 holds { {}, {x} } is Clique of G;

theorem 
for G being SimpleGraph, x, y being set
 st x in Vertices G & y in Vertices G & {x,y} in G
  holds { {}, {x}, {y}, {x,y} } is Clique of G;

registration
 let G be SimpleGraph;
 cluster finite for Clique of G;
end;

theorem 
for G being SimpleGraph, x being set st x in union G
 ex C being finite Clique of G st Vertices C = {x};

theorem 
for C being clique SimpleGraph, u, v being set
 st u in Vertices C & v in Vertices C holds {u, v} in C;

definition
  let G be SimpleGraph;
  attr G is with_finite_clique# means

   ex C being finite Clique of G
    st for D being finite Clique of G holds order D <= order C;
end;

registration
  cluster with_finite_clique# for SimpleGraph;
end;

registration
  cluster finite -> with_finite_clique# for SimpleGraph;
end;

definition
  let G be with_finite_clique# SimpleGraph;
  func clique# G -> Nat means

  (ex C being finite Clique of G st order C = it)
    & for T being finite Clique of G holds order T <= it;
end;

theorem 
for G being with_finite_clique# SimpleGraph
  st clique# G = 0 holds Vertices G = {};

theorem 
for G being void SimpleGraph holds clique# G = 0;

theorem 
for G being SimpleGraph, x, y being set
 st {x,y} in G holds G SubgraphInducedBy {x,y} is Clique of G;

theorem 
for G being with_finite_clique# SimpleGraph
  st Edges G <> {} holds clique# G >= 2;

theorem 
for G, H being with_finite_clique# SimpleGraph
 st G c= H holds clique# G <= clique# H;

theorem 
for X being finite set holds clique# CompleteSGraph X = card X;

definition
  let G be SimpleGraph, P be a_partition of Vertices G;
  attr P is Clique-wise means

    for x being set st x in P holds G SubgraphInducedBy x is Clique of G;
end;

registration
 let G be SimpleGraph;
 cluster Clique-wise for a_partition of Vertices G;
end;

definition
  let G be SimpleGraph;
  mode Clique-partition of G is Clique-wise a_partition of Vertices G;
end;

registration
 let G be void SimpleGraph;
 cluster empty -> Clique-wise for a_partition of Vertices G;
end;

definition
  let G be SimpleGraph;
  attr G is with_finite_cliquecover# means

  ex C being Clique-partition of G st C is finite;
end;

registration
  cluster finite -> with_finite_cliquecover# for SimpleGraph;
end;

registration
  let G be with_finite_cliquecover# SimpleGraph;
  cluster finite for Clique-partition of G;
end;

registration
  let G be with_finite_cliquecover# SimpleGraph, S be Subset of Vertices G;
  cluster G SubgraphInducedBy S -> with_finite_cliquecover#;
end;

definition
  let G be with_finite_cliquecover# SimpleGraph;
  func cliquecover# G -> Nat means

  (ex C being finite Clique-partition of G st card C = it)
   & for C being finite Clique-partition of G holds it <= card C;
end;

begin 

definition
 let G be SimpleGraph, S be Subset of Vertices G;
 attr S is stable means

  for x, y being set st x <> y & x in S & y in S holds {x,y} nin G;
end;

theorem 
for G being SimpleGraph holds {}(Vertices G) is stable;

theorem 
for G being SimpleGraph, S being Subset of Vertices G, v being set
 st S = {v} holds S is stable;

registration
  let G be SimpleGraph;
  cluster trivial -> stable for Subset of Vertices G;
end;

registration
  let G be SimpleGraph;
  cluster stable for Subset of Vertices G;
end;

definition
  let G be SimpleGraph;
  mode StableSet of G is stable Subset of Vertices G;
    
end;

theorem 
for G being SimpleGraph, x, y being set
 st x in Vertices G & y in Vertices G & {x,y} nin G
  holds {x, y} is StableSet of G;

theorem 
for G being with_finite_clique# SimpleGraph st clique# G = 1
  holds Vertices G is StableSet of G;

registration
  let G be SimpleGraph;
  cluster finite for StableSet of G;
end;

theorem 
for G being SimpleGraph, A being StableSet of G, B being Subset of A
 holds B is StableSet of G;

definition
  let G be SimpleGraph, P be a_partition of Vertices G;
  attr P is StableSet-wise means

    for x being set st x in P holds x is StableSet of G;
end;

theorem 
for G being SimpleGraph holds SmallestPartition Vertices G is StableSet-wise;

registration
  let G be SimpleGraph;
  cluster StableSet-wise for a_partition of Vertices G;
end;

definition
  let G be SimpleGraph;
  mode Coloring of G is StableSet-wise a_partition of Vertices G;
end;

definition
  let G be SimpleGraph;
  attr G is finitely_colorable means

   ex C being Coloring of G st C is finite;
end;

registration
  cluster finitely_colorable for SimpleGraph;
end;

registration
  cluster finite -> finitely_colorable for SimpleGraph;
end;

registration
  let G be finitely_colorable SimpleGraph;
  cluster finite for Coloring of G;
end;

theorem 
for G being SimpleGraph, S being Clique of G, L being set
 st L c= Vertices S holds G SubgraphInducedBy L is Clique of G;

theorem 
for G being SimpleGraph, C being Coloring of G, S being Subset of Vertices G
  holds C | S is Coloring of (G SubgraphInducedBy S);

registration
 let G be finitely_colorable SimpleGraph, S be set;
 cluster G SubgraphInducedBy S -> finitely_colorable;
end;

definition
  let G be finitely_colorable SimpleGraph;
  func chromatic# G -> Nat means

  (ex C being finite Coloring of G st card C = it)
   & for C being finite Coloring of G holds it <= card C;
end;

theorem 
for G, H being finitely_colorable SimpleGraph
 st G c= H holds chromatic# G <= chromatic# H;

theorem 
for X being finite set holds chromatic# CompleteSGraph X = card X;

theorem 
for G being finitely_colorable SimpleGraph,
    C being finite Coloring of G, c being set
 st c in C & card C = chromatic# G
  ex v being Element of Vertices G st v in c &
   for d being Element of C st d <> c
    ex w being Element of Vertices G st w in Adjacent(v) & w in d;

definition
  let G be SimpleGraph;
  attr G is with_finite_stability# means

   ex A being finite StableSet of G
    st for B being finite StableSet of G holds card B <= card A;
end;

registration
  cluster finite -> with_finite_stability# for SimpleGraph;
end;

registration
  let G be with_finite_stability# SimpleGraph;
  cluster -> finite for StableSet of G;
end;

registration
  cluster with_finite_stability# non void for SimpleGraph;
end;

definition
  let G be with_finite_stability# SimpleGraph;
  func stability# G -> Nat means

   (ex A being finite StableSet of G st card(A) = it)
     & for T being finite StableSet of G holds card T <= it;
end;

registration
  let G be with_finite_stability# non void SimpleGraph;
  cluster stability# G -> positive;
end;

theorem 
for G being with_finite_stability# SimpleGraph
  st stability# G = 1 holds G is clique;

registration  


 cluster with_finite_clique# with_finite_stability# -> finite for SimpleGraph;
end;

theorem 
for G being SimpleGraph, C being Clique of G
  holds Vertices C is StableSet of Complement G;

theorem 
for G being SimpleGraph, C being Clique of Complement G
  holds Vertices C is StableSet of G;

theorem 
for G being SimpleGraph, C being StableSet of G
  holds (Complement G) SubgraphInducedBy C is Clique of Complement G;

theorem 
for G being SimpleGraph, C being StableSet of Complement G
  holds G SubgraphInducedBy C is Clique of G;

registration
  let G be with_finite_clique# SimpleGraph;
  cluster Complement G -> with_finite_stability#;
end;

registration
  let G be with_finite_stability# SimpleGraph;
  cluster Complement G -> with_finite_clique#;
end;

theorem 
for G being with_finite_clique# SimpleGraph
  holds clique# G = stability# Complement G;

theorem 
for G being with_finite_stability# SimpleGraph
 holds stability# G = clique# Complement G;

theorem 
for G being SimpleGraph, C being Clique-partition of Complement G
  holds C is Coloring of G;

theorem 
for G being SimpleGraph, C being Clique-partition of G
  holds C is Coloring of Complement G;

theorem 
for G being SimpleGraph, C being Coloring of G
  holds C is Clique-partition of Complement G;

theorem 
for G being SimpleGraph, C being Coloring of Complement G
  holds C is Clique-partition of G;

registration
  let G be finitely_colorable SimpleGraph;
  cluster Complement G -> with_finite_cliquecover#;
end;

registration
  let G be with_finite_cliquecover# SimpleGraph;
  cluster Complement G -> finitely_colorable;
end;

theorem 
for G being finitely_colorable SimpleGraph
 holds chromatic# G = cliquecover# Complement G;

theorem 
for G being with_finite_cliquecover# SimpleGraph
  holds cliquecover# G = chromatic# Complement G;

begin  

definition
  let G be SimpleGraph;
  func Mycielskian G -> SimpleGraph equals

   { {} } \/
   { {x} where x is Element of (union G) \/ [:union G,{union G}:] \/ {union G}
             : not contradiction } \/
   (Edges G) \/
   { {x,[y,union G]} where x, y is Element of union G : {x,y} in Edges G } \/
   { {union G,[x,union G]} where x is Element of union G : x in Vertices G };
end;

theorem 
for G being SimpleGraph holds G c= Mycielskian G;

theorem 
for G being SimpleGraph, v being set
 holds v in Vertices Mycielskian G
   iff v in union G or (ex x being set st x in union G & v = [x,union G])
       or v = union G;

theorem 
for G being SimpleGraph
 holds Vertices Mycielskian G = union G \/ [:union G,{union G}:] \/ {union G};

theorem 
for G being SimpleGraph holds union G in union Mycielskian G;

theorem 
for G being void SimpleGraph holds Mycielskian G = {{},{union G}};

registration
 let G be finite SimpleGraph;
 cluster Mycielskian G -> finite;
end;

theorem 
for G being finite SimpleGraph holds order Mycielskian G = 2*(order G) + 1;

theorem 
for G being SimpleGraph, e being set
 holds e in Edges Mycielskian G iff
  e in Edges G or
  (ex x, y being Element of union G st e = {x,[y,union G]} & {x,y} in Edges G)
or (ex y being Element of union G st e = {union G,[y,union G]} & y in union G);

theorem 
for G being SimpleGraph
 holds Edges Mycielskian G = (Edges G)
  \/ { {x,[y,union G]} where x, y is Element of union G : {x,y} in Edges G }
  \/ { {union G,[y,union G]} where y is Element of union G : y in union G };

theorem 
for G being finite SimpleGraph holds size Mycielskian G = 3*(size G) + order G;

theorem 
for G being SimpleGraph, s, t being set
 st {s, t} in Edges Mycielskian G
  holds {s, t} in Edges G or
        (s in union G or s = union G)
           & (ex y being set st y in union G & t = [y,union G]) or
        (t in union G or t = union G)
           & (ex y being set st y in union G & s = [y,union G]);

theorem 
for G being SimpleGraph, u being set
 st { union G, u } in Edges Mycielskian G
  holds ex x being set st x in union G & u = [x, union G];

theorem 
for G being SimpleGraph, u being set
 st u in Vertices G holds { [u, union G] } in Mycielskian G;

theorem 
for G being SimpleGraph, u being set
 st u in Vertices G holds { [u, union G], union G} in Mycielskian G;

theorem 
for G being SimpleGraph, x, y being set
 holds not {[x,union G],[y,union G]} in Edges Mycielskian G;

theorem 
for G being SimpleGraph, x, y being set
 st x <> y holds not {[x,union G],[y,union G]} in Mycielskian G;

theorem 
for G being SimpleGraph, x, y being set
 st {[x,union G], y} in Edges Mycielskian G
  holds x <> y & x in union G &  (y in union G or y = union G);

theorem 
for G being SimpleGraph, x, y being set
 st {[x,union G], y} in Mycielskian G holds x <> y;

theorem 
for G being SimpleGraph, x, y being set
 st y in union G & {[x,union G], y} in Mycielskian G holds {x, y} in G;

theorem 
for G being SimpleGraph, x, y being set
 st {x, y} in Edges G holds {[x,union G], y} in Mycielskian G;

theorem 
for G being SimpleGraph, x, y being set
 st x in Vertices G & y in Vertices G & {x, y} in Mycielskian G
  holds {x, y} in G;

theorem 
for G being SimpleGraph holds G = (Mycielskian G) SubgraphInducedBy Vertices G;

theorem 
for G being SimpleGraph, C being finite Clique of Mycielskian G
 st 3 <= order C for v being Vertex of C holds v <> union G;

theorem 
for G being with_finite_clique# SimpleGraph st clique# G = 0
for D being finite Clique of Mycielskian G holds order D <= 1;

theorem 
for G being SimpleGraph, x being set st Vertices G = {x}
holds Mycielskian G = {{},{x},{[x,union G]}, {union G}, {[x,union G],union G}};

theorem 
for G being with_finite_clique# SimpleGraph st clique# G = 1
for D being finite Clique of Mycielskian G holds order D <= 2;

theorem 
for G being with_finite_clique# SimpleGraph st 2 <= clique# G
for D being finite Clique of Mycielskian G holds order D <= clique# G;

registration
  let G be with_finite_clique# SimpleGraph;
  cluster Mycielskian G -> with_finite_clique#;
end;

theorem 
for G being with_finite_clique# SimpleGraph
 st 2 <= clique# G holds clique# Mycielskian G = clique# G;

theorem 
for G being finitely_colorable SimpleGraph
 ex E being Coloring of Mycielskian G st card E = 1 + chromatic# G;

registration
 let G be finitely_colorable SimpleGraph;
 cluster Mycielskian G -> finitely_colorable;
end;

theorem 
for G being finitely_colorable SimpleGraph
 holds chromatic# Mycielskian G = 1 + chromatic# G;

definition
  let G be SimpleGraph;
  func MycielskianSeq G -> ManySortedSet of NAT means

  ex myc being Function
   st it = myc & myc.0 = G &
     for k being Nat, G being SimpleGraph
       st G = myc.k holds myc.(k+1) = Mycielskian G;
end;

theorem 
for G being SimpleGraph holds (MycielskianSeq G).0 = G;

theorem 
for G being SimpleGraph, n be Nat holds (MycielskianSeq G).n is SimpleGraph;

registration
  let G be SimpleGraph, n be Nat;
  cluster (MycielskianSeq G).n -> SimpleGraph-like;
end;

theorem 
for G, H being SimpleGraph, n be Nat
  holds (MycielskianSeq G).(n+1) = Mycielskian (MycielskianSeq G).n;

registration
  let G be with_finite_clique# SimpleGraph, n be Nat;
  cluster (MycielskianSeq G).n -> with_finite_clique#;
end;

registration
  let G be finitely_colorable SimpleGraph, n be Nat;
  cluster (MycielskianSeq G).n -> finitely_colorable;
end;

registration
  let G be finite SimpleGraph, n be Nat;
  cluster (MycielskianSeq G).n -> finite;
end;

theorem 
for G being finite SimpleGraph, n being Nat
 holds order ((MycielskianSeq G).n) = 2|^n*(order G) + 2|^n - 1;

theorem 
for G being finite SimpleGraph, n being Nat
 holds size (MycielskianSeq G).n
     = 3|^n*(size G) + (3|^n - 2|^n)*(order G) + (n+1) block 3;

theorem 
for n being Nat
 holds clique# ((MycielskianSeq CompleteSGraph 2).n) = 2 &
       chromatic# ((MycielskianSeq CompleteSGraph 2).n) = n+2;

theorem 
for n being Nat
 ex G being finite SimpleGraph st clique# G = 2 & chromatic# G > n;

theorem 
for n being Nat
 ex G being finite SimpleGraph st stability# G = 2 & cliquecover# G > n;















begin 

theorem 
for x,p be Integer holds (x mod p) mod p = x mod p;

definition
  let a,b be Element of INT;
  func ALGO_GCD(a,b) -> Element of NAT means


  ex A,B be sequence of NAT st
  A.0 = abs(a) & B.0 = abs(b) &
  (for i be Element of NAT holds
  A.(i+1) = B.i &
  B.(i+1) = A.i mod B.i) &
  it = A. (min*{i where i is Element of NAT: B.i = 0} );
end;

theorem 
  for a,b be Element of INT
  holds
  ALGO_GCD(a,b) = a gcd b;

begin 



















scheme 

  QuadChoiceRec { A,B,C,D() -> non empty set,
  A0() -> Element of A(),B0() -> Element of B(),
  C0() -> Element of C(),D0() -> Element of D(),
  P[set,set,set,set,set,set,set,set,set] }:
  ex f being Function of NAT,A(),g being Function of NAT,B(),
  h being Function of NAT,C(),i being Function of NAT,D()
  st f.0 = A0() & g.0 = B0() &h.0 = C0() & i.0 = D0()
  & for n being Element of
  NAT holds P[n,f.n,g.n,h.n,i.n,f.(n+1),g.(n+1),h.(n+1),i.(n+1)]
  provided
   for n being Element of NAT,x being Element of A(),y being Element
  of B(),z being Element of C(),w being Element of D()
  ex x1 being Element of A(),y1 being Element of B(),
  z1 being Element of C(),w1 being Element of D()
  st P[n,x,y,z,w,x1,y1,z1,w1];

definition
  let x,y be Element of INT;
  func ALGO_EXGCD(x,y) -> Element of [:INT,INT,INT:] means


  ex g,w,q,t be sequence of INT,
  a,b,v,u be sequence of INT,
  istop be Element of NAT
  st
  a.0 = 1 & b.0 = 0 & g.0 = x & q.0 =0
  & u.0 = 0 & v.0 = 1 & w.0 = y & t.0 =0
  &
  (for i be Element of NAT
  holds
  q.(i+1) = g.i div w.i & t.(i+1) = g.i mod w.i
  &
  a.(i+1) = u.i & b.(i+1) = v.i & g.(i+1) = w.i
  &
  u.(i+1) = a.i - q.(i+1)*u.i & v.(i+1) = b.i - q.(i+1)*v.i
  &
  w.(i+1) = t.(i+1))
  & istop = min*{i where i is Element of NAT: w.i = 0}
  & (0 <= g.istop implies it =[a.istop,b.istop,g.istop] )
  & (g.istop < 0 implies it =[-(a.istop),-(b.istop),-(g.istop)] );
end;

theorem 
  for i2,i1 being Integer st i2 <= 0 holds
  i1 mod i2 <= 0;

theorem 
  for i2,i1 being Integer st i2 < 0 holds
  -(i1 mod i2) < -i2;

theorem 
  for x,y be Element of INT
  st abs(y) <> 0 holds
  abs(x mod y) < abs(y);

theorem 
  for x,y be Element of INT
  holds
  ALGO_EXGCD(x,y)`3_3 = x gcd y
  &
  ALGO_EXGCD(x,y)`1_3 * x + ALGO_EXGCD(x,y)`2_3 * y
  = x gcd y;


















definition
  let x,p be Element of INT;
  func ALGO_INVERSE(x,p) -> Element of INT means


  for y be Element of INT st y = (x mod p) holds
  ( ALGO_EXGCD(p,y)`3_3 = 1 implies
  ( ( ALGO_EXGCD(p,y)`2_3 < 0) implies
  (ex z be Element of INT st z = ALGO_EXGCD(p,y)`2_3
  & it = p + z ))
  &
  ( (0 <= ALGO_EXGCD(p,y)`2_3) implies it = ALGO_EXGCD(p,y)`2_3)
  )
  &
  ( ALGO_EXGCD(p,y)`3_3 <> 1 implies it = {} );
end;

theorem 
  for x,p,y be Element of INT
  st y = x mod p & ALGO_EXGCD(p,y)`3_3 = 1
  holds
  ( ALGO_INVERSE(x,p) * x ) mod p = 1 mod p;

begin 






























definition
  let nlist be non empty FinSequence of [:INT,INT:];
  func ALGO_CRT(nlist) -> Element of INT means


  ( len nlist = 1 implies it = (nlist.1)`1)
  &
  ( len nlist <> 1 implies
  ex m,n,prodc,prodi be FinSequence of INT,
  M0,M be Element of INT
  st len m = len nlist
  & len n = len nlist
  & len prodc = len nlist - 1
  & len prodi = len nlist - 1
  & m.1 =1
  & (for i be Nat
  st 1<=i & i<=(len m) - 1
  holds
  ex d,x,y be Element of INT
  st x = (nlist.i)`2
  &
  m.(i+1) = m.i * x
  &
  y = m.(i+1)
  &
  d = (nlist.(i+1))`2
  &
  prodi.i = ALGO_INVERSE(y,d)
  &
  prodc.i = y
  )

  & M0 = (nlist.(len m))`2
  & M = (prodc.((len m)-1))*M0
  & n.1 = (nlist.1)`1
  & (for i be Nat st 1<=i & i<=len m - 1 holds
  ex u,u0,u1 be Element of INT
  st
  u0 = ( nlist.(i+1))`1&
  u1 = ( nlist.(i+1))`2 &
  u = ( (u0-n.i)*(prodi.i)) mod u1 &
  n.(i+1) = n.i + u*(prodc.i)) &
  it = n.(len m) mod M );
end;

theorem 
  for a,b be Element of INT st b <> 0 holds (a mod b),a are_congruent_mod b;

theorem 
  for a,b be Element of INT st b <>0 holds
  (a mod b ) gcd b = a gcd b;

theorem 
  for a,b,c be Element of INT
  st c <>0 & a = b mod c
  &
  b,c are_relative_prime
  holds a,c are_relative_prime;

theorem 
  for nlist be non empty FinSequence of [:INT,INT:],
  a,b be FinSequence of INT
  st len a = len b & len a = len nlist
  &
  (for i be Nat st i in Seg (len nlist)
  holds b.i <> 0 )
  &
  (for i be Nat st i in Seg (len nlist)
  holds
  (nlist.i)`1 = a.i & (nlist.i)`2 = b.i )
  &
  (for i,j be Nat st i in Seg (len nlist)
  & j in Seg (len nlist)
  & i <> j
  holds b.i,b.j are_relative_prime )
  holds
  for i be Nat st i in Seg (len nlist)
  holds ALGO_CRT(nlist) mod b.i = a.i mod b.i;

theorem 
  for x,y be Element of INT,
  b,m be non empty FinSequence of INT
  st
  2 <=len b
  &
  (for i,j be Nat st i in Seg (len b)
  & j in Seg (len b)
  & i <> j
  holds b.i,b.j are_relative_prime )
  &
  (for i be Nat
  st i in Seg len b
  holds x mod b.i = y mod b.i )
  &
  m.1 = 1 holds
  for k be Element of NAT
  st
  1<= k & k <= len b
  &
  (for i be Nat st 1<=i & i <=k
  holds
  m.(i+1) = m.i * b.i )
  holds
  x mod m.(k+1) = y mod m.(k+1);

theorem 
  for b be FinSequence of INT
  st len b = 1 holds Product b = b.1;

theorem 
  for b be FinSequence of INT
  ex m be non empty FinSequence of INT
  st
  len m = len b + 1
  &
  m.1 = 1
  &
  (for i be Nat st 1<=i & i <=len b
  holds
  m.(i+1) = m.i * b.i )
  &
  Product b = m.(len b + 1 );

theorem 
  for nlist be non empty FinSequence of [:INT,INT:],
  a,b be non empty FinSequence of INT,
  x,y be Element of INT
  st len a = len b & len a = len nlist
  &
  (for i be Nat st i in Seg (len nlist)
  holds b.i <> 0 )

  &
  (for i be Nat st i in Seg (len nlist)
  holds
  (nlist.i)`1 = a.i & (nlist.i)`2 =b.i )
  &
  (for i,j be Nat st i in Seg (len nlist)
  & j in Seg (len nlist)
  & i <> j
  holds b.i,b.j are_relative_prime )
  &
  (for i be Nat st i in Seg (len nlist)
  holds x mod b.i = a.i mod b.i )
  & y = Product b
  holds ALGO_CRT(nlist) mod y = x mod y;














begin 

theorem 
for L being add-associative right_zeroed right_complementable
            right-distributive non empty doubleLoopStr
for a being Element of L
for p,q being FinSequence of L
st len p = len q &
   for i being Element of NAT st i in dom p holds q/.i = a * (p/.i)
holds Sum q = a * Sum p;

theorem 
for L being add-associative right_zeroed right_complementable
            right-distributive non empty doubleLoopStr
for f being FinSequence of L
for i,j being Element of NAT
st i in dom f & j = i-1 holds Ins(Del(f,i),j,f/.i) = f;

theorem 
for L being add-associative right_zeroed right_complementable
            associative unital right-distributive commutative
            non empty doubleLoopStr
for f being FinSequence of L
for i being Element of NAT st i in dom f
holds Product f = (f/.i) * Product Del(f,i);

registration
let L be add-associative right_zeroed right_complementable
         well-unital associative left-distributive commutative
         almost_left_invertible domRing-like non trivial doubleLoopStr;
let x,y be non zero Element of L;
cluster x / y -> non zero;
end;

registration
cluster domRing-like -> almost_left_cancelable
        for add-associative right_zeroed right_complementable
            right-distributive non empty doubleLoopStr;
cluster domRing-like -> almost_right_cancelable
        for add-associative right_zeroed right_complementable
            left-distributive non empty doubleLoopStr;
end;

registration
let x,y be Integer;
cluster max(x,y) -> integer;
cluster min(x,y) -> integer;
end;

theorem 
for x,y,z being Integer holds max(x+y,x+z) = x + max(y,z);


begin 

definition
let L be non empty ZeroStr;
let p be Polynomial of L;
attr p is zero means

  p = 0_.(L);
attr p is constant means

  deg p <= 0;
end;

registration
let L be non trivial ZeroStr;
cluster non zero for Polynomial of L;
end;

registration
let L be non empty ZeroStr;
cluster 0_.(L) -> zero constant;
end;

registration
let L be non degenerated multLoopStr_0;
cluster 1_.(L) -> non zero;
end;

registration
let L be non empty multLoopStr_0;
cluster 1_.(L) -> constant;
end;

registration
let L be non empty ZeroStr;
cluster zero -> constant for Polynomial of L;
end;

registration
let L be non empty ZeroStr;
cluster non constant -> non zero for Polynomial of L;
end;

registration
let L be non trivial ZeroStr;
cluster non constant for Polynomial of L;
end;

registration
let L be well-unital non degenerated non empty doubleLoopStr;
let z be Element of L;
let k be Element of NAT;
cluster rpoly(k,z) -> non zero;
end;

registration
let L be add-associative right_zeroed right_complementable distributive
         non degenerated doubleLoopStr;
cluster Polynom-Ring(L) -> non degenerated;
end;

registration
let L be domRing-like add-associative right_zeroed right_complementable
         distributive non trivial doubleLoopStr;
cluster Polynom-Ring(L) -> domRing-like;
end;

theorem 
for L being add-associative right_zeroed right_complementable
            right-distributive associative non empty doubleLoopStr
for p,q being Polynomial of L
for a being Element of L
holds (a * p) *' q = a * (p *' q);

theorem 
for L being add-associative right_zeroed right_complementable
            right-distributive commutative associative
            non empty doubleLoopStr
for p,q being Polynomial of L
for a being Element of L
holds p *' (a * q) = a * (p *' q);

registration
let L be add-associative right_zeroed right_complementable
         well-unital commutative associative distributive
         almost_left_invertible non trivial doubleLoopStr;
let p be non zero Polynomial of L;
let a be non zero Element of L;
cluster a * p -> non zero;
end;

registration
let L be domRing-like add-associative right_zeroed right_complementable
         distributive non trivial doubleLoopStr;
let p1,p2 be non zero Polynomial of L;
cluster p1 *' p2 -> non zero;
end;

theorem 
for L being add-associative right_zeroed right_complementable distributive
            Abelian domRing-like non trivial doubleLoopStr
for p1,p2 being Polynomial of L
for p3 being non zero Polynomial of L
st p1 *' p3 = p2 *' p3 holds p1 = p2;

registration
let L be non trivial ZeroStr;
let p be non zero Polynomial of L;
cluster degree p -> natural;
end;

theorem 
for L being add-associative right_zeroed right_complementable
            unital right-distributive non empty doubleLoopStr
for p being Polynomial of L st deg p = 0
for x being Element of L holds eval(p,x) <> 0.L;

theorem 
for L being Abelian add-associative right_zeroed right_complementable
            well-unital associative commutative distributive
            almost_left_invertible non degenerated doubleLoopStr
for p being Polynomial of L
for x being Element of L
holds eval(p,x) = 0.L iff rpoly(1,x) divides p;

theorem 
for L being Abelian add-associative right_zeroed right_complementable
            well-unital associative commutative distributive
            almost_left_invertible domRing-like
            non degenerated doubleLoopStr
for p,q being Polynomial of L
for x being Element of L st rpoly(1,x) divides (p*'q)
holds rpoly(1,x) divides p or rpoly(1,x) divides q;

theorem 
for L being Abelian add-associative right_zeroed right_complementable
            well-unital associative commutative distributive
            almost_left_invertible non degenerated doubleLoopStr
for f being FinSequence of Polynom-Ring(L)
st for i being Nat st i in dom f ex z being Element of L st f.i = rpoly(1,z)
for p being Polynomial of L st p = Product f
holds p <> 0_.(L);

theorem 
for L being Abelian add-associative right_zeroed right_complementable
            well-unital associative commutative distributive
            almost_left_invertible domRing-like
            non degenerated doubleLoopStr
for f being FinSequence of Polynom-Ring(L)
st for i being Nat st i in dom f ex z being Element of L st f.i = rpoly(1,z)
for p being Polynomial of L st p = Product f
for x being Element of L
holds eval(p,x) = 0.L iff
      ex i being Nat st i in dom f & f.i = rpoly(1,x);


begin 

definition
let L be unital non empty doubleLoopStr;
let p1,p2 be Polynomial of L;
let x be Element of L;
pred x is_a_common_root_of p1,p2 means

  x is_a_root_of p1 & x is_a_root_of p2;
end;

definition
let L be unital non empty doubleLoopStr;
let p1,p2 be Polynomial of L;
pred p1,p2 have_a_common_root means

ex x being Element of L st x is_a_common_root_of p1,p2;
end;

notation
let L be unital non empty doubleLoopStr;
let p1,p2 be Polynomial of L;
synonym p1,p2 have_common_roots for p1,p2 have_a_common_root;
antonym p1,p2 have_no_common_roots for p1,p2 have_a_common_root;
end;

theorem 
for L being Abelian add-associative right_zeroed right_complementable
            unital distributive non empty doubleLoopStr
for p being Polynomial of L
for x being Element of L
st x is_a_root_of p holds x is_a_root_of (-p);

theorem 
for L being Abelian add-associative right_zeroed right_complementable
            unital left-distributive non empty doubleLoopStr
for p1,p2 being Polynomial of L
for x being Element of L
st x is_a_common_root_of p1,p2 holds x is_a_root_of p1 + p2;

theorem 
for L being Abelian add-associative right_zeroed right_complementable
            unital distributive non empty doubleLoopStr
for p1,p2 being Polynomial of L
for x being Element of L
st x is_a_common_root_of p1,p2 holds x is_a_root_of -(p1 + p2);

theorem 
for L being Abelian add-associative right_zeroed right_complementable
            unital distributive non empty doubleLoopStr
for p,q being Polynomial of L
for x being Element of L
st x is_a_common_root_of p,q holds x is_a_root_of p+q;

theorem 
for L being Abelian add-associative right_zeroed right_complementable
            well-unital associative commutative distributive
            almost_left_invertible non trivial doubleLoopStr
for p1,p2 being Polynomial of L
st p1 divides p2 & p1 is with_roots holds p1,p2 have_common_roots;

definition
let L be unital non empty doubleLoopStr;
let p,q be Polynomial of L;
func Common_Roots(p,q) -> Subset of L equals

  { x where x is Element of L : x is_a_common_root_of p,q };
end;


begin 

definition
let L be non empty ZeroStr;
let p be Polynomial of L;
func Leading-Coefficient(p) -> Element of L equals

  p.(len p-'1);
end;

notation
let L be non empty ZeroStr;
let p be Polynomial of L;
synonym LC p for Leading-Coefficient(p);
end;

registration
let L be non trivial doubleLoopStr;
let p be non zero Polynomial of L;
cluster LC p -> non zero;
end;

theorem 
for L being add-associative right_zeroed right_complementable
            well-unital commutative associative distributive
            almost_left_invertible non empty doubleLoopStr
for p being Polynomial of L
for a being Element of L holds LC(a * p) = a * LC(p);

definition
let L be non empty doubleLoopStr;
let p be Polynomial of L;
attr p is normalized means

  LC p = 1.L;
end;

registration
let L be add-associative right_zeroed right_complementable
         well-unital commutative associative distributive
         almost_left_invertible non trivial doubleLoopStr;
let p be non zero Polynomial of L;
cluster (1.L / LC p) * p -> normalized;
end;

registration
let L be Field;
let p be non zero Polynomial of L;
cluster NormPolynomial(p) -> normalized;
end;


begin 

definition
let L be non trivial multLoopStr_0;
mode rational_function of L means

  ex p1 being Polynomial of L st
  ex p2 being non zero Polynomial of L st it = [p1,p2];
end;

definition
let L be non trivial multLoopStr_0;
let p1 be Polynomial of L;
let p2 be non zero Polynomial of L;
redefine func [p1,p2] -> rational_function of L;
end;

definition
let L be non trivial multLoopStr_0;
let z be rational_function of L;
redefine func z`1 -> Polynomial of L;
redefine func z`2 -> non zero Polynomial of L;
end;

definition
let L be non trivial multLoopStr_0;
let z be rational_function of L;
attr z is zero means

  z`1 = 0_.(L);
end;

registration
let L be non trivial multLoopStr_0;
cluster non zero for rational_function of L;
end;

theorem 
for L being non trivial multLoopStr_0
for z being rational_function of L holds z = [z`1,z`2];

definition
let L be add-associative right_zeroed right_complementable distributive
         unital non trivial doubleLoopStr;
let z be rational_function of L;
attr z is irreducible means

   z`1, z`2 have_no_common_roots;
end;

notation
let L be add-associative right_zeroed right_complementable distributive
         unital non trivial doubleLoopStr;
let z be rational_function of L;
antonym z is reducible for z is irreducible;
end;

definition
let L be add-associative right_zeroed right_complementable distributive
         unital non trivial doubleLoopStr;
let z be rational_function of L;
attr z is normalized means

  z is irreducible & z`2 is normalized;
end;

registration
let L be add-associative right_zeroed right_complementable distributive
         unital non trivial doubleLoopStr;
cluster normalized -> irreducible for rational_function of L;
end;

registration
let L be Abelian add-associative right_zeroed right_complementable
         well-unital associative distributive commutative
         almost_left_invertible domRing-like non trivial doubleLoopStr;
let z be rational_function of L;
cluster LC(z`2) -> non zero;
end;

definition
let L be Abelian add-associative right_zeroed right_complementable
         well-unital associative distributive commutative
         almost_left_invertible domRing-like non trivial doubleLoopStr;
let z be rational_function of L;
func NormRationalFunction z -> rational_function of L equals

 [(1.L / LC(z`2)) * z`1, (1.L / LC(z`2)) * z`2];
end;

notation
let L be Abelian add-associative right_zeroed right_complementable
         well-unital associative distributive commutative
         almost_left_invertible domRing-like non trivial doubleLoopStr;
let z be rational_function of L;
synonym NormRatF z for NormRationalFunction z;
end;

registration
let L be Abelian add-associative right_zeroed right_complementable
         well-unital associative distributive commutative
         almost_left_invertible domRing-like non trivial doubleLoopStr;
let z be non zero rational_function of L;
cluster NormRationalFunction z -> non zero;
end;

definition
let L be non degenerated multLoopStr_0;
func 0._(L) -> rational_function of L equals

  [ 0_.(L), 1_.(L) ];
func 1._(L) -> rational_function of L equals

  [ 1_.(L), 1_.(L) ];
end;

registration
  let L be add-associative right_zeroed right_complementable distributive
           associative well-unital non degenerated doubleLoopStr;
 cluster 0._(L) -> normalized;
end;

registration
let L be non degenerated multLoopStr_0;
cluster 1._(L) -> non zero;
end;

registration
let L be add-associative right_zeroed right_complementable distributive
         associative well-unital non degenerated doubleLoopStr;
cluster 1._(L) -> irreducible;
end;

registration
let L be add-associative right_zeroed right_complementable distributive
         associative well-unital non degenerated doubleLoopStr;
cluster irreducible non zero for rational_function of L;
end;

registration
let L be add-associative right_zeroed right_complementable distributive
         Abelian associative well-unital non degenerated doubleLoopStr;
let x be Element of L;
cluster [ rpoly(1,x), rpoly(1,x) ] -> reducible non zero
        for rational_function of L;
end;

registration
let L be add-associative right_zeroed right_complementable distributive
         Abelian associative well-unital non degenerated doubleLoopStr;
cluster reducible non zero for rational_function of L;
end;

registration
let L be add-associative right_zeroed right_complementable distributive
         associative well-unital non degenerated doubleLoopStr;
cluster normalized for rational_function of L;
end;

registration
let L be non degenerated multLoopStr_0;
cluster 0._(L) -> zero;
end;

registration
let L be add-associative right_zeroed right_complementable distributive
         associative well-unital non degenerated doubleLoopStr;
cluster 1._(L) -> normalized;
end;

definition
let L be domRing-like add-associative right_zeroed right_complementable
         distributive non trivial doubleLoopStr;
let p,q be rational_function of L;
func p + q -> rational_function of L equals

  [ p`1 *' q`2 + p`2 *' q`1, p`2 *' q`2];
end;

definition
let L be domRing-like add-associative right_zeroed right_complementable
         distributive non trivial doubleLoopStr;
let p,q be rational_function of L;
func p *' q -> rational_function of L equals

  [ p`1 *' q`1, p`2  *' q`2];
end;

theorem 
for L being add-associative right_zeroed right_complementable
            well-unital commutative associative distributive
            almost_left_invertible non trivial doubleLoopStr
for p being rational_function of L
for a being non zero Element of L
holds [a * p`1, a * p`2] is irreducible iff p is irreducible;


begin

theorem 
for L being Abelian add-associative right_zeroed right_complementable
            well-unital associative distributive commutative
            domRing-like non trivial doubleLoopStr
for z being rational_function of L
ex z1 being rational_function of L,
   z2 being non zero Polynomial of L
st z = [z2 *' z1`1, z2 *' z1`2] & z1 is irreducible &
   ex f being FinSequence of Polynom-Ring(L)
   st z2 = Product f &
      for i being Element of NAT st i in dom f
      ex x being Element of L st x is_a_common_root_of z`1,z`2 &
                                 f.i = rpoly(1,x);

definition
let L be Abelian add-associative right_zeroed right_complementable
         well-unital associative distributive commutative
         almost_left_invertible domRing-like non trivial doubleLoopStr;
let z be rational_function of L;
func NF z -> rational_function of L means

  ex z1 being rational_function of L,
     z2 being non zero Polynomial of L
  st z = [z2 *' z1`1, z2 *' z1`2] & z1 is irreducible &
     it = NormRationalFunction z1 &
     ex f being FinSequence of Polynom-Ring(L)
     st z2 = Product f &
        for i being Element of NAT st i in dom f
        ex x being Element of L st x is_a_common_root_of z`1,z`2 &
                                   f.i = rpoly(1,x)
  if z is non zero otherwise it = 0._(L);
end;

registration
let L be Abelian add-associative right_zeroed right_complementable
         well-unital associative distributive commutative
         almost_left_invertible domRing-like non trivial doubleLoopStr;
let z be rational_function of L;
cluster NF z -> normalized irreducible;
end;

registration
let L be Abelian add-associative right_zeroed right_complementable
         well-unital associative distributive commutative
         almost_left_invertible domRing-like non trivial doubleLoopStr;
let z be non zero rational_function of L;
cluster NF z -> non zero;
end;

theorem 
for L be Abelian add-associative right_zeroed right_complementable
         well-unital associative distributive commutative
         almost_left_invertible domRing-like non trivial doubleLoopStr
for z be non zero rational_function of L
for z1 being rational_function of L,
    z2 being non zero Polynomial of L
st z = [z2 *' z1`1, z2 *' z1`2] & z1 is irreducible &
   ex f being FinSequence of Polynom-Ring(L)
   st z2 = Product f &
      for i being Element of NAT st i in dom f
      ex x being Element of L st x is_a_common_root_of z`1,z`2 &
                                 f.i = rpoly(1,x)
holds NF z = NormRationalFunction z1;

theorem 
for L be Abelian add-associative right_zeroed right_complementable
         well-unital associative distributive commutative
         almost_left_invertible domRing-like non trivial doubleLoopStr
holds NF 0._(L) = 0._(L);

theorem 
for L be Abelian add-associative right_zeroed right_complementable
         well-unital associative distributive commutative
         almost_left_invertible domRing-like non trivial doubleLoopStr
holds NF 1._(L) = 1._(L);

theorem 
for L being Abelian add-associative right_zeroed right_complementable
            well-unital associative distributive commutative
            almost_left_invertible domRing-like non trivial doubleLoopStr
for z being irreducible non zero rational_function of L
holds NF z = NormRationalFunction z;

theorem 
for L be Abelian add-associative right_zeroed right_complementable
         well-unital associative distributive commutative
         almost_left_invertible domRing-like non trivial doubleLoopStr
for z be rational_function of L
for x being Element of L
holds NF [rpoly(1,x) *' z`1, rpoly(1,x) *' z`2] = NF z;

theorem 
for L being Abelian add-associative right_zeroed right_complementable
         well-unital associative distributive commutative
         almost_left_invertible domRing-like non trivial doubleLoopStr
for z being rational_function of L
holds NF (NF z) = NF z;

theorem 
for L being Abelian add-associative right_zeroed right_complementable
         well-unital associative distributive commutative
         almost_left_invertible domRing-like non degenerated doubleLoopStr
for z being non zero rational_function of L
holds z is irreducible iff
ex a being Element of L st a <> 0.L & [a * (z`1), a * (z`2)] = NF(z);


begin  

definition
let L be Abelian add-associative right_zeroed right_complementable
         well-unital associative distributive commutative
         almost_left_invertible domRing-like non trivial doubleLoopStr;
let z be rational_function of L;
func degree z -> Integer equals

  max(degree((NF z)`1),degree((NF z)`2));
end;

notation
let L be Abelian add-associative right_zeroed right_complementable
         well-unital associative distributive commutative
         almost_left_invertible domRing-like non trivial doubleLoopStr;
let z be rational_function of L;
synonym deg z for degree z;
end;

theorem 
for L being Abelian add-associative right_zeroed right_complementable
         well-unital associative distributive commutative
         almost_left_invertible domRing-like non trivial doubleLoopStr
for z being rational_function of L
holds degree(z) <= max(degree(z`1),degree(z`2));

theorem 
for L being Abelian add-associative right_zeroed right_complementable
         well-unital associative distributive commutative
         almost_left_invertible domRing-like non trivial doubleLoopStr
for z being non zero rational_function of L
holds z is irreducible iff degree z = max( degree(z`1), degree(z`2) );


begin 

definition
let L be Field;
let z be rational_function of L;
let x be Element of L;
func eval(z,x) -> Element of L equals

  eval(z`1,x) / eval(z`2,x);
end;

theorem 
for L being Field
for x being Element of L holds eval(0._(L),x) = 0.L;

theorem 
for L being Field
for x being Element of L holds eval(1._(L),x) = 1.L;

theorem 
for L being Field
for p,q being rational_function of L
for x being Element of L st eval(p`2,x) <> 0.L & eval(q`2,x) <> 0.L
holds eval(p+q,x) = eval(p,x) + eval(q,x);

theorem 
for L being Field
for p,q being rational_function of L
for x being Element of L st eval(p`2,x) <> 0.L & eval(q`2,x) <> 0.L
holds eval(p*'q,x) = eval(p,x) * eval(q,x);

theorem 
for L being Field
for p being rational_function of L
for x being Element of L st eval(p`2,x) <> 0.L
holds eval(NormRationalFunction p,x) = eval(p,x);

theorem 
for L being Field
for p being rational_function of L
for x being Element of L st eval(p`2,x) <> 0.L
holds x is_a_common_root_of p`1,p`2 or eval(NF p,x) = eval(p,x);